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 / spectrum / instr2.scm < prev    next >
Encoding:
Text File  |  1999-01-02  |  19.9 KB  |  785 lines

  1. #| -*-Scheme-*-
  2.  
  3. $Id: instr2.scm,v 1.7 1999/01/02 06:06:43 cph Exp $
  4.  
  5. Copyright (c) 1987-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. ;;;; HP Spectrum Instruction Set Description
  23. ;;; Originally from Walt Hill, who did the hard part.
  24. ;;; package: (compiler lap-syntaxer)
  25.  
  26. (declare (usual-integrations))
  27.  
  28. ;;;; Memory and offset operations
  29.  
  30. ;;; The long forms of many of the following instructions use register
  31. ;;; 1 -- this may be inappropriate for assembly-language programs, but
  32. ;;; is OK for the output of the compiler.
  33. (let-syntax ((long-load
  34.           (macro (keyword opcode)
  35.         `(define-instruction ,keyword
  36.            ((() (OFFSET (? offset) (? space) (? base)) (? reg))
  37.             (VARIABLE-WIDTH (disp offset)
  38.               ((#x-2000 #x1FFF)
  39.                (LONG (6 ,opcode)
  40.                  (5 base)
  41.                  (5 reg)
  42.                  (2 space)
  43.                  (14 disp RIGHT-SIGNED)))
  44.               ((() ())
  45.                (LONG
  46.             ;; (ADDIL () L$,offset ,base)
  47.             (6 #x0A)
  48.             (5 base)
  49.             (21 (quotient disp #x800) ASSEMBLE21:X)
  50.             ;; (LDW () (OFFSET R$,offset ,space 1) ,reg)
  51.             (6 ,opcode)
  52.             (5 1)
  53.             (5 reg)
  54.             (2 space)
  55.             (14 (remainder disp #x800) RIGHT-SIGNED))))))))
  56.  
  57.          (long-store
  58.           (macro (keyword opcode)
  59.         `(define-instruction ,keyword
  60.            ((() (? reg) (OFFSET (? offset) (? space) (? base)))
  61.             (VARIABLE-WIDTH (disp offset)
  62.               ((#x-2000 #x1FFF)
  63.                (LONG (6 ,opcode)
  64.                  (5 base)
  65.                  (5 reg)
  66.                  (2 space)
  67.                  (14 disp RIGHT-SIGNED)))
  68.               ((() ())
  69.                (LONG
  70.             ;; (ADDIL () L$,offset ,base)
  71.             (6 #x0A)
  72.             (5 base)
  73.             (21 (quotient disp #x800) ASSEMBLE21:X)
  74.             ;; (STW () ,reg (OFFSET R$,offset ,space 1))
  75.             (6 ,opcode)
  76.             (5 1)
  77.             (5 reg)
  78.             (2 space)
  79.             (14 (remainder disp #x800) RIGHT-SIGNED))))))))
  80.  
  81.          (load-offset
  82.           (macro (keyword opcode)
  83.         `(define-instruction ,keyword
  84.            ((() (OFFSET (? offset) 0 (? base)) (? reg))
  85.             (VARIABLE-WIDTH (disp offset)
  86.               ((#x-2000 #x1FFF)
  87.                (LONG (6 ,opcode)
  88.                  (5 base)
  89.                  (5 reg)
  90.                  (2 #b00)
  91.                  (14 disp RIGHT-SIGNED)))
  92.               ((() ())
  93.                (LONG
  94.             ;; (ADDIL () L$,offset ,base)
  95.             (6 #x0A)
  96.             (5 base)
  97.             (21 (quotient disp #x800) ASSEMBLE21:X)
  98.             ;; (LDO () (OFFSET R$,offset 0 1) ,reg)
  99.             (6 ,opcode)
  100.             (5 1)
  101.             (5 reg)
  102.             (2 #b00)
  103.             (14 (remainder disp #x800) RIGHT-SIGNED))))))))
  104.  
  105.          (load-immediate
  106.           (macro (keyword opcode)
  107.         `(define-instruction ,keyword
  108.            ((() (? offset) (? reg))
  109.             (VARIABLE-WIDTH (disp offset)
  110.               ((#x-2000 #x1FFF)
  111.                (LONG (6 ,opcode)
  112.                  (5 0)
  113.                  (5 reg)
  114.                  (2 #b00)
  115.                  (14 disp RIGHT-SIGNED)))
  116.               ((() ())
  117.                (LONG
  118.             ;; (LDIL () L$,offset ,base)
  119.             (6 #x08)
  120.             (5 reg)
  121.             (21 (quotient disp #x800) ASSEMBLE21:X)
  122.             ;; (LDO () (OFFSET R$,offset 0 ,reg) ,reg)
  123.             (6 ,opcode)
  124.             (5 reg)
  125.             (5 reg)
  126.             (2 #b00)
  127.             (14 (remainder disp #x800) RIGHT-SIGNED))))))))
  128.  
  129.          (left-immediate
  130.           (macro (keyword opcode)
  131.         `(define-instruction ,keyword
  132.            ((() (? immed-21) (? reg))
  133.             (LONG (6 ,opcode)
  134.               (5 reg)
  135.               (21 immed-21 ASSEMBLE21:X)))))))
  136.  
  137.   (long-load      LDW   #x12)
  138.   (long-load      LDWM  #x13)
  139.   (long-load      LDH   #x11)
  140.   (long-load      LDB   #x10)
  141.  
  142.   (long-store     STW   #x1a)
  143.   (long-store     STWM  #x1b)
  144.   (long-store     STH   #x19)
  145.   (long-store     STB   #x18)
  146.  
  147.   (load-offset    LDO   #x0d)
  148.   (load-immediate LDI   #x0d)    ; pseudo-op (LDO complt (OFFSET displ 0) reg)
  149.  
  150.   (left-immediate LDIL  #x08)
  151.   (left-immediate ADDIL #x0a))
  152.  
  153. ;; In the following, the middle completer field (2 bits) appears to be zero,
  154. ;; according to the hardware.  Also, the u-bit seems not to exist in the
  155. ;; cache instructions.
  156.  
  157. (let-syntax ((indexed-load
  158.           (macro (keyword opcode extn)
  159.         `(define-instruction ,keyword
  160.            (((? compl complx) (INDEX (? index-reg) (? space) (? base))
  161.                       (? reg))
  162.             (LONG (6 ,opcode)
  163.               (5 base)
  164.               (5 index-reg)
  165.               (2 space)
  166.               (1 (vector-ref compl 0))
  167.               (1 #b0)
  168.               (2 (vector-ref compl 1))
  169.               (4 ,extn)
  170.               (1 (vector-ref compl 2))
  171.               (5 reg))))))
  172.  
  173.          (indexed-store
  174.           (macro (keyword opcode extn)
  175.         `(define-instruction ,keyword
  176.            (((? compl complx) (? reg)
  177.                       (INDEX (? index-reg) (? space) (? base)))
  178.             (LONG (6 ,opcode)
  179.               (5 base)
  180.               (5 index-reg)
  181.               (2 space)
  182.               (1 (vector-ref compl 0))
  183.               (1 #b0)
  184.               (2 (vector-ref compl 1))
  185.               (4 ,extn)
  186.               (1 (vector-ref compl 2))
  187.               (5 reg))))))
  188.  
  189.          (indexed-d-cache
  190.           (macro (keyword extn)
  191.         `(define-instruction ,keyword
  192.            (((? compl m-val) (INDEX (? index-reg) (? space) (? base)))
  193.             (LONG (6 #x01)
  194.               (5 base)
  195.               (5 index-reg)
  196.               (2 space)
  197.               (8 ,extn)
  198.               (1 compl)
  199.               (5 #x0))))))
  200.  
  201.          (indexed-i-cache
  202.           (macro (keyword extn)
  203.         `(define-instruction ,keyword
  204.            (((? compl m-val)
  205.              (INDEX (? index-reg) (? space sr3) (? base)))
  206.             (LONG (6 #x01)
  207.               (5 base)
  208.               (5 index-reg)
  209.               (3 space)
  210.               (7 ,extn)
  211.               (1 compl)
  212.               (5 #x0)))))))
  213.   
  214.   (indexed-load  LDWX  #x03 #x2)
  215.   (indexed-load  LDHX  #x03 #x1)
  216.   (indexed-load  LDBX  #x03 #x0)
  217.   (indexed-load  LDCWX #x03 #x7)
  218.   (indexed-load  FLDWX #x09 #x0)
  219.   (indexed-load  FLDDX #x0B #x0)
  220.  
  221.   (indexed-store FSTWX #x09 #x8)
  222.   (indexed-store FSTDX #x0b #x8)
  223.  
  224.   (indexed-d-cache PDC  #x4e)
  225.   (indexed-d-cache FDC  #x4a)
  226.   (indexed-i-cache FIC  #x0a)
  227.   (indexed-d-cache FDCE #x4b)
  228.   (indexed-i-cache FICE #x0b))
  229.  
  230. (let-syntax ((scalr-short-load
  231.           (macro (keyword extn)
  232.         `(define-instruction ,keyword
  233.            (((? compl compls) (OFFSET (? offset) (? space) (? base))
  234.                       (? reg))
  235.             (LONG (6 #x03)
  236.               (5 base)
  237.               (5 offset RIGHT-SIGNED)
  238.               (2 space)
  239.               (1 (vector-ref compl 0))
  240.               (1 #b1)
  241.               (2 (vector-ref compl 1))
  242.               (4 ,extn)
  243.               (1 (vector-ref compl 2))
  244.               (5 reg))))))
  245.  
  246.          (scalr-short-store
  247.           (macro (keyword extn)
  248.         `(define-instruction ,keyword
  249.            (((? compl compls) (? reg)
  250.                       (OFFSET (? offset) (? space) (? base)))
  251.             (LONG (6 #x03)
  252.               (5 base)
  253.               (5 reg)
  254.               (2 space)
  255.               (1 (vector-ref compl 0))
  256.               (1 #b1)
  257.               (2 (vector-ref compl 1))
  258.               (4 ,extn)
  259.               (1 (vector-ref compl 2))
  260.               (5 offset RIGHT-SIGNED))))))
  261.  
  262.          (float-short-load
  263.           (macro (keyword opcode extn)
  264.         `(define-instruction ,keyword
  265.            (((? compl compls) (OFFSET (? offset) (? space) (? base))
  266.                       (? reg))
  267.             (LONG (6 ,opcode)
  268.               (5 base)
  269.               (5 offset RIGHT-SIGNED)
  270.               (2 space)
  271.               (1 (vector-ref compl 0))
  272.               (1 #b1)
  273.               (2 (vector-ref compl 1))
  274.               (4 ,extn)
  275.               (1 (vector-ref compl 2))
  276.               (5 reg))))))
  277.  
  278.          (float-short-store
  279.           (macro (keyword opcode extn)
  280.         `(define-instruction ,keyword
  281.            (((? compl compls) (? reg)
  282.                       (OFFSET (? offset) (? space) (? base)))
  283.             (LONG (6 ,opcode)
  284.               (5 base)
  285.               (5 offset RIGHT-SIGNED)
  286.               (2 space)
  287.               (1 (vector-ref compl 0))
  288.               (1 #b1)
  289.               (2 (vector-ref compl 1))
  290.               (4 ,extn)
  291.               (1 (vector-ref compl 2))
  292.               (5 reg)))))))
  293.  
  294.   (scalr-short-load  LDWS   #x02)
  295.   (scalr-short-load  LDHS   #x01)
  296.   (scalr-short-load  LDBS   #x00)
  297.   (scalr-short-load  LDCWS  #x07)
  298.  
  299.   (scalr-short-store STWS   #x0a)
  300.   (scalr-short-store STHS   #x09)
  301.   (scalr-short-store STBS   #x08)
  302.   (scalr-short-store STBYS  #x0c)
  303.  
  304.   (float-short-load  FLDWS  #x09 #x00)
  305.   (float-short-load  FLDDS  #x0b #x00)
  306.  
  307.   (float-short-store FSTWS  #x09 #x08)
  308.   (float-short-store FSTDS  #x0b #x08))
  309.  
  310. ;;;; Control transfer instructions
  311.  
  312. ;;; Note: For the time being the unconditionaly branch instructions are not
  313. ;;; branch tensioned since their range is pretty large (1/2 Mbyte).
  314. ;;; They should be eventually (by using an LDIL,LDI,BLR sequence, for example).
  315.  
  316. (let-syntax ((branch&link
  317.           (macro (keyword extn)
  318.         `(define-instruction ,keyword
  319.            ((() (? reg) (@PCR (? label)))
  320.             (LONG (6 #x3a)
  321.               (5 reg)
  322.               (5 label PC-REL ASSEMBLE17:X)
  323.               (3 ,extn)
  324.               (11 label PC-REL ASSEMBLE17:Y)
  325.               (1 0)
  326.               (1 label PC-REL ASSEMBLE17:Z)))
  327.  
  328.            (((N) (? reg) (@PCR (? label)))
  329.             (LONG (6 #x3a)
  330.               (5 reg)
  331.               (5 label PC-REL ASSEMBLE17:X)
  332.               (3 ,extn)
  333.               (11 label PC-REL ASSEMBLE17:Y)
  334.               (1 1)
  335.               (1 label PC-REL ASSEMBLE17:Z)))
  336.  
  337.            ((() (? reg) (@PCO (? offset)))
  338.             (LONG (6 #x3a)
  339.               (5 reg)
  340.               (5 offset ASSEMBLE17:X)
  341.               (3 ,extn)
  342.               (11 offset ASSEMBLE17:Y)
  343.               (1 0)
  344.               (1 offset ASSEMBLE17:Z)))
  345.  
  346.            (((N) (? reg) (@PCO (? offset)))
  347.             (LONG (6 #x3a)
  348.               (5 reg)
  349.               (5 offset ASSEMBLE17:X)
  350.               (3 ,extn)
  351.               (11 offset ASSEMBLE17:Y)
  352.               (1 1)
  353.               (1 offset ASSEMBLE17:Z))))))
  354.           
  355.          (branch
  356.           (macro (keyword extn)
  357.         `(define-instruction ,keyword
  358.            ((() (@PCR (? l)))
  359.             (LONG (6 #x3a)
  360.               (5 #b00000)
  361.               (5 l PC-REL ASSEMBLE17:X)
  362.               (3 #b000)
  363.               (11 l PC-REL ASSEMBLE17:Y)
  364.               (1 0)
  365.               (1 l PC-REL ASSEMBLE17:Z)))
  366.  
  367.            (((N) (@PCR (? l)))
  368.             (LONG (6 #x3a)
  369.               (5 #b00000)
  370.               (5 l PC-REL ASSEMBLE17:X)
  371.               (3 #b000)
  372.               (11 l PC-REL ASSEMBLE17:Y)
  373.               (1 1)
  374.               (1 l PC-REL ASSEMBLE17:Z)))
  375.  
  376.            ((() (@PCO (? offset)))
  377.             (LONG (6 #x3a)
  378.               (5 #b00000)
  379.               (5 offset ASSEMBLE17:X)
  380.               (3 #b000)
  381.               (11 offset ASSEMBLE17:Y)
  382.               (1 0)
  383.               (1 offset ASSEMBLE17:Z)))
  384.  
  385.            (((N) (@PCO (? offset)))
  386.             (LONG (6 #x3a)
  387.               (5 #b00000)
  388.               (5 offset ASSEMBLE17:X)
  389.               (3 #b000)
  390.               (11 offset ASSEMBLE17:Y)
  391.               (1 1)
  392.               (1 offset ASSEMBLE17:Z)))))))
  393.  
  394.   (branch      B    0)        ; pseudo-op (BL complt 0 displ)
  395.   (branch&link BL   0)
  396.   (branch&link GATE 1))
  397.  
  398. (let-syntax ((BV&BLR
  399.           (macro (keyword extn)
  400.         `(define-instruction ,keyword
  401.            ((() (? offset-reg) (? reg))
  402.             (LONG (6 #x3a)
  403.               (5 reg)
  404.               (5 offset-reg)
  405.               (3 ,extn)
  406.               (11 #b00000000000)
  407.               (1 0)
  408.               (1 #b0)))
  409.  
  410.            (((N) (? offset-reg) (? reg))
  411.             (LONG (6 #x3a)
  412.               (5 reg)
  413.               (5 offset-reg)
  414.               (3 ,extn)
  415.               (11 #b00000000000)
  416.               (1 1)
  417.               (1 #b0))))))
  418.  
  419.          (BE&BLE
  420.           (macro (keyword opcode)
  421.         `(define-instruction ,keyword
  422.            ((() (OFFSET (? offset) (? space sr3) (? base)))
  423.             (LONG (6 ,opcode)
  424.               (5 base)
  425.               (5 offset ASSEMBLE17:X)
  426.               (3 space)
  427.               (11 offset ASSEMBLE17:Y)
  428.               (1 0)
  429.               (1 offset ASSEMBLE17:Z)))
  430.  
  431.            (((N) (OFFSET (? offset) (? space sr3) (? base)))
  432.             (LONG (6 ,opcode)
  433.               (5 base)
  434.               (5 offset ASSEMBLE17:X)
  435.               (3 space)
  436.               (11 offset ASSEMBLE17:Y)
  437.               (1 1)
  438.               (1 offset ASSEMBLE17:Z)))))))
  439.   (BV&BLR BLR 2)
  440.   (BV&BLR BV  6)
  441.   (BE&BLE BE  #x38)
  442.   (BE&BLE BLE #x39))
  443.  
  444. ;;;; Conditional branch instructions
  445.  
  446. #|
  447.  
  448. Branch tensioning notes for the conditional branch instructions:
  449.  
  450. The sequence
  451.  
  452.     combt,cc    r1,r2,label
  453.     instr1
  454.     instr2
  455.  
  456. becomes
  457.  
  458.     combf,cc,n    r1,r2,tlabel        ; pco = 0
  459.     b        label            ; no nullification
  460. tlabel    instr1
  461.     instr2
  462.  
  463. The sequence
  464.  
  465.     combt,cc,n    r1,r2,label
  466.     instr1
  467.     instr2
  468.  
  469. becomes either
  470.  
  471.     combf,cc,n    r1,r2,tlabel        ; pco = 0
  472.     b,n        label            ; nullification
  473. tlabel    instr1
  474.     instr2
  475.  
  476. when label is downstream (a forwards branch)
  477.  
  478. or
  479.  
  480.     combf,cc,n    r1,r2,tlabel        ; pco = 4
  481.     b        label            ; no nullification
  482.     instr1
  483. tlabel    instr2
  484.  
  485. when label is upstream (a backwards branch).
  486.  
  487. This adjusting of the nullify bits, the pc offset, etc. for tlabel are
  488. performed by the utilities branch-extend-pco, branch-extend-disp, and
  489. branch-extend-nullify in instr1.
  490. |#
  491.  
  492. ;;;; Compare/compute and branch.
  493.  
  494. (let-syntax
  495.     ((defccbranch
  496.        (macro (keyword completer opcode1 opcode2 opr1)
  497.      `(define-instruction ,keyword
  498.         (((? compl ,completer) (? ,(car opr1)) (? reg-2) (@PCO (? offset)))
  499.          (LONG (6  ,opcode1)
  500.            (5  reg-2)
  501.            (5  ,@opr1)
  502.            (3  (cadr compl))
  503.            (11 offset ASSEMBLE12:X)
  504.            (1  (car compl))
  505.            (1  offset ASSEMBLE12:Y)))
  506.  
  507.         (((? compl ,completer) (? ,(car opr1)) (? reg-2) (@PCR (? l)))
  508.          (VARIABLE-WIDTH
  509.           (disp `(- ,l (+ *PC* 8)))
  510.           ((#x-2000 #x1FFF)
  511.            (LONG (6  ,opcode1)
  512.              (5  reg-2)
  513.              (5  ,@opr1)
  514.              (3  (cadr compl))
  515.              (11 disp ASSEMBLE12:X)
  516.              (1  (car compl))
  517.              (1  disp ASSEMBLE12:Y)))
  518.  
  519.           ((() ())
  520.            ;; See page comment above.
  521.            (LONG (6  ,opcode2)        ; COMBF
  522.              (5  reg-2)
  523.              (5  ,@opr1)
  524.              (3  (cadr compl))
  525.              (11 (branch-extend-pco disp (car compl)) ASSEMBLE12:X)
  526.              (1  1)
  527.              (1  (branch-extend-pco disp (car compl)) ASSEMBLE12:Y)
  528.  
  529.              (6  #x3a)            ; B
  530.              (5  0)
  531.              (5  (branch-extend-disp disp) ASSEMBLE17:X)
  532.              (3  0)
  533.              (11 (branch-extend-disp disp) ASSEMBLE17:Y)
  534.              (1  (branch-extend-nullify disp (car compl)))
  535.              (1  (branch-extend-disp disp) ASSEMBLE17:Z)))))))))
  536.  
  537.   (define-macro (defcond name opcode1 opcode2 opr1)
  538.     `(defccbranch ,name complaltfb ,opcode1 ,opcode2 ,opr1))
  539.  
  540.   (define-macro (defpseudo name opcode opr1)
  541.     `(defccbranch ,name complalb
  542.        (TF-adjust ,opcode (cdr compl))
  543.        (TF-adjust-inverted ,opcode (cdr compl))
  544.        ,opr1))
  545.  
  546.   (defcond COMBT #x20 #x22 (reg-1))
  547.   (defcond COMBF #x22 #x20 (reg-1))
  548.   (defcond ADDBT #x28 #x2a (reg-1))
  549.   (defcond ADDBF #x2a #x28 (reg-1))
  550.  
  551.   (defcond COMIBT #X21 #x23 (immed-5 right-signed))
  552.   (defcond COMIBF #X23 #x21 (immed-5 right-signed))
  553.   (defcond ADDIBT #X29 #x2b (immed-5 right-signed))
  554.   (defcond ADDIBF #X2b #x29 (immed-5 right-signed))
  555.  
  556.   (defpseudo COMB  #X20 (reg-1))
  557.   (defpseudo ADDB  #X28 (reg-1))
  558.   (defpseudo COMIB #X21 (immed-5 right-signed))
  559.   (defpseudo ADDIB #x29 (immed-5 right-signed)))
  560.  
  561. ;;;; Pseudo branch instructions.
  562.  
  563. #|
  564.  
  565. These nullify the following instruction when the branch is taken.
  566. irrelevant of the sign of the displacement (unlike the real instructions).
  567. If the displacement is positive, they use the nullify bit.
  568. If the displacement is negative, they use a NOP.
  569.  
  570.     combn,cc    r1,r2,label
  571.     
  572. becomes either
  573.     
  574.     comb,cc,n    r1,r2,label
  575.  
  576. if label is downstream (forward branch)
  577.  
  578. or
  579.  
  580.     comb,cc        r1,r2,label
  581.     nop
  582.  
  583. if label is upstream (backward branch)
  584.  
  585. If the displacement is too large, it becomes
  586.  
  587.     comb,!cc,n    r1,r2,tlabel    ; pco = 0
  588.     b,n        label
  589. tlabel
  590.  
  591. Note: Only those currently used by the code generator are implemented.
  592. |#
  593.  
  594. (let-syntax
  595.     ((defccbranch
  596.        (macro (keyword completer opcode1 opcode2 opr1)
  597.      `(define-instruction ,keyword
  598.         ;; No @PCO form.
  599.         ;; This is a pseudo-instruction used by the code-generator
  600.         (((? compl ,completer) (? ,(car opr1)) (? reg-2) (@PCR (? l)))
  601.          (VARIABLE-WIDTH
  602.           (disp `(- ,l (+ *PC* 8)))
  603.           ((0 #x1FFF)
  604.            ;; Forward branch.  Nullify.
  605.            (LONG (6  ,opcode1)         ; COMB,cc,n
  606.              (5  reg-2)
  607.              (5  ,@opr1)
  608.              (3  (car compl))
  609.              (11 disp ASSEMBLE12:X)
  610.              (1  1)
  611.              (1  disp ASSEMBLE12:Y)))
  612.  
  613.           ((#x-2000 -1)
  614.            ;; Backward branch.  No nullification, insert NOP.
  615.            (LONG (6  ,opcode1)        ; COMB,cc
  616.              (5  reg-2)
  617.              (5  ,@opr1)
  618.              (3  (car compl))
  619.              (11 disp ASSEMBLE12:X)
  620.              (1  0)
  621.              (1  disp ASSEMBLE12:Y)
  622.  
  623.              (6 #x02)             ; NOP (OR 0 0 0)
  624.              (10 #b0000000000)
  625.              (3 0)
  626.              (1 0)
  627.              (7 #x12)
  628.              (5 #b00000)))
  629.  
  630.           ((() ())
  631.            (LONG (6  ,opcode2)        ; COMB!,n
  632.              (5  reg-2)
  633.              (5  ,@opr1)
  634.              (3  (car compl))
  635.              (11 0 ASSEMBLE12:X)
  636.              (1  1)
  637.              (1  0 ASSEMBLE12:Y)
  638.  
  639.              (6  #x3a)            ; B,n
  640.              (5  0)
  641.              (5  (branch-extend-disp disp) ASSEMBLE17:X)
  642.              (3  0)
  643.              (11 (branch-extend-disp disp) ASSEMBLE17:Y)
  644.              (1  1)
  645.              (1  (branch-extend-disp disp) ASSEMBLE17:Z)))))))))
  646.  
  647.   (define-macro (defcond name opcode1 opcode2 opr1)
  648.     `(defccbranch ,name complaltf ,opcode1 ,opcode2 ,opr1))
  649.  
  650.   (define-macro (defpseudo name opcode opr1)
  651.     `(defccbranch ,name complal
  652.        (TF-adjust ,opcode compl)
  653.        (TF-adjust-inverted ,opcode compl)
  654.        ,opr1))
  655.  
  656.   (defcond COMIBTN #X21 #x23 (immed-5 right-signed))
  657.   (defcond COMIBFN #X23 #x21 (immed-5 right-signed))
  658.  
  659.   (defpseudo COMBN #X20 (reg-1)))
  660.  
  661. ;;;; Miscellaneous control
  662.  
  663. (let-syntax
  664.     ((defmovb&bb
  665.        (macro (name opcode opr1 opr2 field2)
  666.      `(define-instruction ,name
  667.         (((? compl compledb) (? ,(car opr1)) ,@opr2 (@PCO (? offset)))
  668.          (LONG (6  ,opcode)
  669.            (5  ,field2)
  670.            (5  ,@opr1)
  671.            (3  (cdr compl))
  672.            (11 offset ASSEMBLE12:X)
  673.            (1  (car compl))
  674.            (1  offset ASSEMBLE12:Y)))
  675.  
  676.         (((? compl compledb) (? ,(car opr1)) ,@opr2 (@PCR (? l)))
  677.          (VARIABLE-WIDTH
  678.           (disp `(- ,l (+ *PC* 8)))
  679.           ((#x-2000 #x1FFF)
  680.            (LONG (6  ,opcode)
  681.              (5  ,field2)
  682.              (5  ,@opr1)
  683.              (3  (cdr compl))
  684.              (11 l PC-REL ASSEMBLE12:X)
  685.              (1  (car compl))
  686.              (1  l PC-REL ASSEMBLE12:Y)))
  687.  
  688.           ((() ())
  689.            ;; See page comment above.
  690.            (LONG (6  ,opcode)        ; MOVB
  691.              (5  ,field2)
  692.              (5  ,@opr1)
  693.              (3  (branch-extend-edcc (cdr compl)))
  694.              (11 (branch-extend-pco disp (car compl)) ASSEMBLE12:X)
  695.              (1  1)
  696.              (1  (branch-extend-pco disp (car compl)) ASSEMBLE12:Y)
  697.              
  698.              (6  #x3a)            ; B
  699.              (5  0)
  700.              (5  (branch-extend-disp disp) ASSEMBLE17:X)
  701.              (3  0)
  702.              (11 (branch-extend-disp disp) ASSEMBLE17:Y)
  703.              (1  (branch-extend-nullify disp (car compl)))
  704.              (1  (branch-extend-disp disp) ASSEMBLE17:Z)))))))))
  705.  
  706.  
  707.   (defmovb&bb BVB    #x30 (reg)            ()         #b00000)
  708.   (defmovb&bb BB    #x31 (reg)            ((? pos))    pos)
  709.   (defmovb&bb MOVB    #x32 (reg-1)            ((? reg-2))    reg-2)
  710.   (defmovb&bb MOVIB    #x33 (immed-5 right-signed) ((? reg-2))    reg-2))
  711.  
  712. ;;;; Assembler pseudo-ops
  713.  
  714. (define-instruction USHORT
  715.   ((() (? high) (? low))
  716.    (LONG (16 high UNSIGNED)
  717.      (16 low UNSIGNED))))
  718.  
  719. (define-instruction WORD
  720.   ((() (? expression))
  721.    (LONG (32 expression SIGNED))))
  722.  
  723. (define-instruction UWORD
  724.   ((() (? expression))
  725.    (LONG (32 expression UNSIGNED))))
  726.  
  727. (define-instruction EXTERNAL-LABEL
  728.   ((() (? format-word) (@PCR (? label)))
  729.    (LONG (16 format-word UNSIGNED)
  730.      (16 label BLOCK-OFFSET)))
  731.  
  732.   ((() (? format-word) (@PCO (? offset)))
  733.    (LONG (16 format-word UNSIGNED)
  734.      (16 offset UNSIGNED))))
  735.  
  736. (define-instruction PCR-HOOK
  737.   ((() (? target)
  738.        (OFFSET (? offset) (? space sr3) (? base))
  739.        (@PCR (? label)))
  740.    (VARIABLE-WIDTH
  741.     (disp `(- ,label (+ *PC* 8)))
  742.     ((#x-2000 #x1FFF)
  743.      (LONG
  744.       ;; (BLE () (OFFSET ,offset ,space ,base))
  745.       (6 #x39)
  746.       (5 base)
  747.       (5 offset ASSEMBLE17:X)
  748.       (3 space)
  749.       (11 offset ASSEMBLE17:Y)
  750.       (1 0)
  751.       (1 offset ASSEMBLE17:Z)
  752.       ;; (LDO () (OFFSET ,disp 0 31) ,target)
  753.       (6 #x0D)
  754.       (5 31)
  755.       (5 target)
  756.       (2 #b00)
  757.       (14 disp RIGHT-SIGNED)))
  758.     ((() ())
  759.      (LONG
  760.       ;; (LDIL () L$disp-8 target)
  761.       (6 #x08)
  762.       (5 1)
  763.       (21 (quotient (- disp 8) #x800) ASSEMBLE21:X)
  764.       ;; (LDO () (OFFSET R$disp-4 0 1) target)
  765.       (6 #x0D)
  766.       (5 1)
  767.       (5 1)
  768.       (2 #b00)
  769.       (14 (remainder (- disp 8) #x800) RIGHT-SIGNED)
  770.       ;; (BLE () (OFFSET ,offset ,space ,base))
  771.       (6 #x39)
  772.       (5 base)
  773.       (5 offset ASSEMBLE17:X)
  774.       (3 space)
  775.       (11 offset ASSEMBLE17:Y)
  776.       (1 0)
  777.       (1 offset ASSEMBLE17:Z)
  778.       ;; (ADD () 31 1 target)
  779.       (6 #x02)
  780.       (5 31)
  781.       (5 1)
  782.       (3 0)
  783.       (1 0)
  784.       (7 #x30)
  785.       (5 target))))))