home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / compiler / machines / vax / insutl.scm < prev    next >
Encoding:
Text File  |  1999-01-02  |  8.0 KB  |  334 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: insutl.scm,v 4.4 1999/01/02 06:06:43 cph Exp $
  4.  
  5. Copyright (c) 1987, 1989, 1991, 1999 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. |#
  21.  
  22. ;;;; VAX utility procedures
  23. ;;; package: (compiler lap-syntaxer)
  24.  
  25. (declare (usual-integrations))
  26.  
  27. ;;;; Effective Addressing
  28.  
  29. ;;; *** NOTE: If this format changes, inerly.scm must also be changed! ***
  30.  
  31. (define ea-tag
  32.   "Effective-Address")
  33.  
  34. (define (make-effective-address keyword categories value)
  35.   (vector ea-tag keyword categories value))
  36.  
  37. (define (effective-address? object)
  38.   (and (vector? object)
  39.        (not (zero? (vector-length object)))
  40.        (eq? (vector-ref object 0) ea-tag)))
  41.  
  42. (define-integrable (ea-keyword ea)
  43.   (vector-ref ea 1))
  44.  
  45. (define-integrable (ea-categories ea)
  46.   (vector-ref ea 2))
  47.  
  48. (define-integrable (ea-value ea)
  49.   (vector-ref ea 3))
  50.  
  51. ;; For completeness
  52.  
  53. (define (ea-keyword-early ea)
  54.   (vector-ref ea 1))
  55.  
  56. (define (ea-categories-early ea)
  57.   (vector-ref ea 2))
  58.  
  59. (define (ea-value-early ea)
  60.   (vector-ref ea 3))
  61.  
  62. ;;;; Addressing modes
  63.  
  64. (define-ea-database
  65.   ((S (? value))
  66.    (R)
  67.    (BYTE (6 value)
  68.      (2 0)))
  69.  
  70.   ((X (? n) (? base ea-i-?))
  71.    (R M W V)
  72.    (BYTE (4 n)
  73.      (4 4))
  74.    (OPERAND ? base))
  75.  
  76.   ((R (? n))
  77.    (R M W V)
  78.    (BYTE (4 n)
  79.      (4 5)))
  80.  
  81.   ((@R (? n))
  82.    (R M W A V I)
  83.    (BYTE (4 n)
  84.      (4 6)))
  85.  
  86.   ((@-R (? n))
  87.    (R M W A V I)
  88.    (BYTE (4 n)
  89.      (4 7)))
  90.  
  91.   ((@R+ (? n))
  92.    (R M W A V I)
  93.    (BYTE (4 n)
  94.      (4 8)))
  95.  
  96.   ((@@R+ (? n))
  97.    (R M W A V I)
  98.    (BYTE (4 n)
  99.      (4 9)))
  100.  
  101.   ((@RO B (? n) (? off))
  102.    (R M W A V I)
  103.    (BYTE (4 n)
  104.      (4 10))
  105.    (BYTE (8 off SIGNED)))
  106.  
  107.   ((@@RO B (? n) (? off))
  108.    (R M W A V I)
  109.    (BYTE (4 n)
  110.      (4 11))
  111.    (BYTE (8 off SIGNED)))
  112.  
  113.   ((@RO W (? n) (? off))
  114.    (R M W A V I)
  115.    (BYTE (4 n)
  116.      (4 12))
  117.    (BYTE (16 off SIGNED)))
  118.  
  119.   ((@@RO W (? n) (? off))
  120.    (R M W A V I)
  121.    (BYTE (4 n)
  122.      (4 13))
  123.    (BYTE (16 off SIGNED)))
  124.  
  125.   ((@RO L (? n) (? off))
  126.    (R M W A V I)
  127.    (BYTE (4 n)
  128.      (4 14))
  129.    (BYTE (32 off SIGNED)))
  130.  
  131.   ((@RO UL (? n) (? off))        ; Kludge
  132.    (R M W A V I)
  133.    (BYTE (4 n)
  134.      (4 14))
  135.    (BYTE (32 off UNSIGNED)))
  136.  
  137.   ((@@RO L (? n) (? off))
  138.    (R M W A V I)
  139.    (BYTE (4 n)
  140.      (4 15))
  141.    (BYTE (32 off SIGNED)))
  142.  
  143.   ((& (? value))
  144.    (R M W A V I)
  145.    (BYTE (4 15)
  146.      (4 8))
  147.    (IMMEDIATE value SIGNED))
  148.  
  149.   ((&U (? value))            ; Kludge
  150.    (R M W A V I)
  151.    (BYTE (4 15)
  152.      (4 8))
  153.    (IMMEDIATE value UNSIGNED))
  154.  
  155.   ((@& (? value))            ; Absolute
  156.    (R M W A V I)
  157.    (BYTE (4 15)
  158.      (4 9))
  159.    (BYTE (32 value)))
  160.  
  161.   ((@PCO B (? off))
  162.    (R M W A V I)
  163.    (BYTE (4 15)
  164.      (4 10))
  165.    (BYTE (8 off SIGNED)))
  166.  
  167.   ((@@PCO B (? off))
  168.    (R M W A V I)
  169.    (BYTE (4 15)
  170.      (4 11))
  171.    (BYTE (8 off SIGNED)))
  172.  
  173.   ((@PCO W (? off))
  174.    (R M W A V I)
  175.    (BYTE (4 15)
  176.      (4 12))
  177.    (BYTE (16 off SIGNED)))
  178.  
  179.   ((@@PCO W (? off))
  180.    (R M W A V I)
  181.    (BYTE (4 15)
  182.      (4 13))
  183.    (BYTE (16 off SIGNED)))
  184.  
  185.   ((@PCO L (? off))
  186.    (R M W A V I)
  187.    (BYTE (4 15)
  188.      (4 14))
  189.    (BYTE (32 off SIGNED)))
  190.  
  191.   ((@@PCO L (? off))
  192.    (R M W A V I)
  193.    (BYTE (4 15)
  194.      (4 15))
  195.    (BYTE (32 off SIGNED)))
  196.  
  197.   ;; Self adjusting modes
  198.   ;; The ranges seem wrong, but are correct given that disp
  199.   ;; must be adjusted for the longer modes.  
  200.  
  201.   ((@PCR (? label))
  202.    (R M W A V I)
  203.    (VARIABLE-WIDTH
  204.     (disp `(- ,label (+ *PC* 2)))
  205.     ((-128 127)                ; (@PCO B label)
  206.      (BYTE (4 15)
  207.        (4 10))
  208.      (BYTE (8 disp SIGNED)))
  209.     ((-32767 32768)            ; (@PCO W label)
  210.      (BYTE (4 15)
  211.        (4 12))
  212.      (BYTE (16 (- disp 1) SIGNED)))
  213.     ((() ())                ; (@PCO L label)
  214.      (BYTE (4 15)
  215.        (4 14))
  216.      (BYTE (32 (- disp 3) SIGNED)))))
  217.  
  218.   ((@@PCR (? label))
  219.    (R M W A V I)
  220.    (VARIABLE-WIDTH
  221.     (disp `(- ,label (+ *PC* 2)))
  222.     ((-128 127)                ; (@@PCO B label)
  223.      (BYTE (4 15)
  224.        (4 11))
  225.      (BYTE (8 disp SIGNED)))
  226.     ((-32767 32768)            ; (@@PCO W label)
  227.      (BYTE (4 15)
  228.        (4 13))
  229.      (BYTE (16 (- disp 1) SIGNED)))
  230.     ((() ())                ; (@@PCO L label)
  231.      (BYTE (4 15)
  232.        (4 15))
  233.      (BYTE (32 (- disp 3) SIGNED)))))
  234.  
  235.   ((@PCRO (? label) (? offset))    ; Kludge
  236.    (R M W A V I)
  237.    (VARIABLE-WIDTH
  238.     (disp `(+ ,offset (- ,label (+ *PC* 2))))
  239.     ((-128 127)                ; (@PCO B label)
  240.      (BYTE (4 15)
  241.        (4 10))
  242.      (BYTE (8 disp UNSIGNED)))
  243.     ((-32767 32768)            ; (@PCO W label)
  244.      (BYTE (4 15)
  245.        (4 12))
  246.      (BYTE (16 (- disp 1) UNSIGNED)))
  247.     ((() ())                ; (@PCO L label)
  248.      (BYTE (4 15)
  249.        (4 14))
  250.      (BYTE (32 (- disp 3) UNSIGNED))))))
  251.  
  252. ;;;; Effective address processing
  253.  
  254. (define *immediate-type*)
  255.  
  256. (define (process-ea expression type)
  257.   (fluid-let ((*immediate-type*
  258.            (if (eq? '? type) *immediate-type* type)))
  259.     (let ((match (pattern-lookup ea-database expression)))
  260.       (cond (match (match))
  261.         ;; Guarantee idempotency for early instruction processing.
  262.         ((effective-address? expression) expression)
  263.         (else #F)))))
  264.  
  265. (define (coerce-to-type expression type #!optional unsigned?)
  266.   (let ((unsigned? (and (not (default-object? unsigned?))
  267.             unsigned?)))
  268.     (syntax-evaluation
  269.      expression
  270.      (case type
  271.        ((B) (if unsigned? coerce-8-bit-unsigned coerce-8-bit-signed))
  272.        ((W) (if unsigned? coerce-16-bit-unsigned coerce-16-bit-signed))
  273.        ((L) (if unsigned? coerce-32-bit-unsigned coerce-32-bit-signed))
  274.        ((D F G H L O Q)
  275.     (error "coerce-to-type: Unimplemented type" type))
  276.        (else (error "coerce-to-type: Unknown type" type))))))
  277.  
  278. ;;; Transformers
  279.  
  280. (define-symbol-transformer cc
  281.   (NEQ . #x2) (NEQU . #x2) (EQL . #x3) (EQLU . #x3)
  282.   (GTR . #x4) (LEQ . #x5) (GEQ . #x8) (LSS . #x9) (GTRU . #xA) (LEQU . #xB)
  283.   (VC . #xC) (VS . #xD) (GEQU . #xE) (CC . #xE) (LSSU . #xF) (CS . #xF))
  284.  
  285. (define-symbol-transformer inverse-cc
  286.   (NEQ . #x3) (NEQU . #x3) (EQL . #x2) (EQLU . #x2)
  287.   (GTR . #x5) (LEQ . #x4) (GEQ . #x9) (LSS . #x8) (GTRU . #xB) (LEQU . #xA)
  288.   (VC . #xD) (VS . #xC) (GEQU . #xF) (CC . #xF) (LSSU . #xE) (CS . #xE))
  289.  
  290. (define-transformer displacement
  291.   (lambda (expression)
  292.     (and (pair? expression)
  293.      (or (eq? (car expression) '@PCR)
  294.          (eq? (car expression) '@PCO))
  295.      expression)))
  296.  
  297. ;;;; Effective address transformers
  298.  
  299. (define-ea-transformer ea-a-b a b)
  300. (define-ea-transformer ea-a-d a d)
  301. (define-ea-transformer ea-a-f a f)
  302. (define-ea-transformer ea-a-g a g)
  303. (define-ea-transformer ea-a-h a h)
  304. (define-ea-transformer ea-a-l a l)
  305. (define-ea-transformer ea-a-o a o)
  306. (define-ea-transformer ea-a-q a q)
  307. (define-ea-transformer ea-a-w a w)
  308. (define-ea-transformer ea-m-b m b)
  309. (define-ea-transformer ea-m-d m d)
  310. (define-ea-transformer ea-m-f m f)
  311. (define-ea-transformer ea-m-g m g)
  312. (define-ea-transformer ea-m-h m h)
  313. (define-ea-transformer ea-m-l m l)
  314. (define-ea-transformer ea-m-w m w)
  315. (define-ea-transformer ea-r-b r b)
  316. (define-ea-transformer ea-r-d r d)
  317. (define-ea-transformer ea-r-f r f)
  318. (define-ea-transformer ea-r-g r g)
  319. (define-ea-transformer ea-r-h r h)
  320. (define-ea-transformer ea-r-l r l)
  321. (define-ea-transformer ea-r-o r o)
  322. (define-ea-transformer ea-r-q r q)
  323. (define-ea-transformer ea-r-w r w)
  324. (define-ea-transformer ea-v-b v b)
  325. (define-ea-transformer ea-w-b w b)
  326. (define-ea-transformer ea-w-d w d)
  327. (define-ea-transformer ea-w-f w f)
  328. (define-ea-transformer ea-w-g w g)
  329. (define-ea-transformer ea-w-h w h)
  330. (define-ea-transformer ea-w-l w l)
  331. (define-ea-transformer ea-w-o w o)
  332. (define-ea-transformer ea-w-q w q)
  333. (define-ea-transformer ea-w-w w w)
  334. (define-ea-transformer ea-i-? i ?)