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 / lapgen.scm < prev    next >
Encoding:
Text File  |  1999-01-02  |  19.1 KB  |  598 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: lapgen.scm,v 4.16 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. ;;;; RTL Rules for DEC VAX.
  23. ;;; Shared utilities and exports to the rest of the compiler.
  24. ;;; package: (compiler lap-syntaxer)
  25.  
  26. (declare (usual-integrations))
  27.  
  28. ;;;; Register-Allocator Interface
  29.  
  30. (define (reference->register-transfer source target)
  31.   (if (and (effective-address/register? source)
  32.        (= (lap:ea-R-register source) target))
  33.       (LAP)
  34.       (LAP (MOV L ,source ,(register-reference target)))))
  35.  
  36. (define (register->register-transfer source target)
  37.   (LAP ,@(machine->machine-register source target)))
  38.  
  39. (define (home->register-transfer source target)
  40.   (LAP ,@(pseudo->machine-register source target)))
  41.  
  42. (define (register->home-transfer source target)
  43.   (LAP ,@(machine->pseudo-register source target)))
  44.  
  45. (define-integrable (pseudo-register-home register)
  46.   (offset-reference regnum:regs-pointer
  47.             (pseudo-register-offset register)))
  48.  
  49. (define-integrable (sort-machine-registers registers)
  50.   registers)
  51.  
  52. (define available-machine-registers
  53.   ;; r9 is value register.
  54.   ;; r10 - r13 are taken up by Scheme.
  55.   ;; r14 is sp and r15 is pc.
  56.   (list r0 r1 r2 r3 r4 r5 r6 r7 r8))
  57.  
  58. (define (register-types-compatible? type1 type2)
  59.   (boolean=? (eq? type1 'FLOAT) (eq? type2 'FLOAT)))
  60.  
  61. (define (register-type register)
  62.   ;; This will have to be changed when floating point support is added.
  63.   (if (or (machine-register? register)
  64.       (register-value-class=word? register))
  65.       'GENERAL
  66.       (error "unable to determine register type" register)))
  67.  
  68. (define register-reference
  69.   (let ((references (make-vector number-of-machine-registers)))
  70.     (let loop ((i 0))
  71.       (if (< i number-of-machine-registers)
  72.       (begin
  73.         (vector-set! references i (INST-EA (R ,i)))
  74.         (loop (1+ i)))))
  75.     (lambda (register)
  76.       (vector-ref references register))))
  77.  
  78. (define mask-reference
  79.   (register-reference regnum:pointer-mask))
  80.  
  81. (define (lap:make-label-statement label)
  82.   (LAP (LABEL ,label)))
  83.  
  84. (define (lap:make-unconditional-branch label)
  85.   (LAP (BR (@PCR ,label))))        ; Unsized
  86.  
  87. (define (lap:make-entry-point label block-start-label)
  88.   block-start-label
  89.   (LAP (ENTRY-POINT ,label)
  90.        ,@(make-external-label expression-code-word label)))
  91.  
  92. ;;;; Basic Machine Instructions
  93.  
  94. (define-integrable (pseudo->machine-register source target)
  95.   (memory->machine-register (pseudo-register-home source) target))
  96.  
  97. (define-integrable (machine->pseudo-register source target)
  98.   (machine-register->memory source (pseudo-register-home target)))
  99.  
  100. (define (pseudo-float? register)
  101.   (and (pseudo-register? register)
  102.        (value-class=float? (pseudo-register-value-class register))))
  103.  
  104. (define (pseudo-word? register)
  105.   (and (pseudo-register? register)
  106.        (value-class=word? (pseudo-register-value-class register))))
  107.  
  108. (define-integrable (machine->machine-register source target)
  109.   (LAP (MOV L
  110.         ,(register-reference source)
  111.         ,(register-reference target))))
  112.  
  113. (define-integrable (machine-register->memory source target)
  114.   (LAP (MOV L
  115.         ,(register-reference source)
  116.         ,target)))
  117.  
  118. (define-integrable (memory->machine-register source target)
  119.   (LAP (MOV L
  120.         ,source
  121.         ,(register-reference target))))
  122.  
  123. (define (byte-offset-reference register offset)
  124.   (if (zero? offset)
  125.       (INST-EA (@R ,register))
  126.       (INST-EA (@RO ,(datum-size offset) ,register ,offset))))
  127.  
  128. (define-integrable (offset-reference register offset)
  129.   (byte-offset-reference register (* 4 offset)))
  130.  
  131. (define-integrable (pseudo-register-offset register)
  132.   ;; Offset into register block for temporary registers
  133.   (+ (+ (* 16 4) (* 40 8))
  134.      (* 2 (register-renumber register))))
  135.  
  136. (define (datum-size datum)
  137.   (cond ((<= -128 datum 127) 'B)
  138.     ((<= -32768 datum 32767) 'W)
  139.     (else 'L)))
  140.  
  141. ;;;; Utilities needed by the rules files.
  142.  
  143. (define-integrable (standard-target-reference target)
  144.   (delete-dead-registers!)
  145.   (reference-target-alias! target 'GENERAL))
  146.  
  147. (define-integrable (any-register-reference register)
  148.   (standard-register-reference register false true))
  149.  
  150. (define-integrable (standard-temporary-reference)
  151.   (reference-temporary-register! 'GENERAL))
  152.  
  153. ;;; Assignments
  154.  
  155. (define-integrable (convert-object/constant->register target constant
  156.                               rtconversion
  157.                               ctconversion)
  158.   (let ((target (standard-target-reference target)))
  159.     (if (non-pointer-object? constant)
  160.     (ctconversion constant target)
  161.     (rtconversion (constant->ea constant) target))))
  162.  
  163. (define-integrable (convert-object/register->register target source conversion)
  164.   ;; `conversion' often expands into multiple references to `target'.
  165.   (with-register-copy-alias! source 'GENERAL target
  166.     (lambda (target)
  167.       (conversion target target))
  168.     conversion))
  169.  
  170. (define-integrable (convert-object/offset->register target address
  171.                             offset conversion)
  172.   (let ((source (indirect-reference! address offset)))
  173.     (conversion source 
  174.         (standard-target-reference target))))
  175.  
  176. ;;; Predicates
  177.  
  178. (define (predicate/memory-operand? expression)
  179.   (or (rtl:offset? expression)
  180.       (and (rtl:post-increment? expression)
  181.        (interpreter-stack-pointer?
  182.         (rtl:post-increment-register expression)))))
  183.  
  184. (define (predicate/memory-operand-reference expression)
  185.   (case (rtl:expression-type expression)
  186.     ((OFFSET) (offset->indirect-reference! expression))
  187.     ((POST-INCREMENT) (INST-EA (@R+ 14)))
  188.     (else (error "Illegal memory operand" expression))))
  189.  
  190. (define (compare/register*register register-1 register-2 cc)
  191.   (set-standard-branches! cc)
  192.   (LAP (CMP L ,(any-register-reference register-1)
  193.         ,(any-register-reference register-2))))
  194.  
  195. (define (compare/register*memory register memory cc)
  196.   (set-standard-branches! cc)
  197.   (LAP (CMP L ,(any-register-reference register) ,memory)))
  198.  
  199. (define (compare/memory*memory memory-1 memory-2 cc)
  200.   (set-standard-branches! cc)
  201.   (LAP (CMP L ,memory-1 ,memory-2)))
  202.  
  203. ;;;; Utilities needed by the rules files (contd.)
  204.  
  205. ;;; Interpreter and interface calls
  206.  
  207. (define (interpreter-call-argument? expression)
  208.   (or (rtl:register? expression)
  209.       (rtl:constant? expression)
  210.       (and (rtl:cons-pointer? expression)
  211.        (rtl:machine-constant? (rtl:cons-pointer-type expression))
  212.        (rtl:machine-constant? (rtl:cons-pointer-datum expression)))
  213.       (and (rtl:offset? expression)
  214.        (rtl:register? (rtl:offset-base expression)))))
  215.  
  216. (define (interpreter-call-argument->machine-register! expression register)
  217.   (let ((target (register-reference register)))
  218.     (case (car expression)
  219.       ((REGISTER)
  220.        (load-machine-register! (rtl:register-number expression) register))
  221.       ((CONSTANT)
  222.        (LAP ,@(clear-registers! register)
  223.         ,@(load-constant (rtl:constant-value expression) target)))
  224.       ((CONS-POINTER)
  225.        (LAP ,@(clear-registers! register)
  226.         ,@(load-non-pointer (rtl:machine-constant-value
  227.                  (rtl:cons-pointer-type expression))
  228.                 (rtl:machine-constant-value
  229.                  (rtl:cons-pointer-datum expression))
  230.                 target)))
  231.       ((OFFSET)
  232.        (let ((source-reference (offset->indirect-reference! expression)))
  233.      (LAP ,@(clear-registers! register)
  234.           (MOV L ,source-reference ,target))))
  235.       (else
  236.        (error "Unknown expression type" (car expression))))))
  237.  
  238. ;;;; Utilities needed by the rules files (contd.)
  239.  
  240. ;;; Object structure.
  241.  
  242. (define (cons-pointer/ea type-ea datum target)
  243.   (LAP (ROTL (S ,scheme-datum-width) ,type-ea ,target)
  244.        (BIS L ,datum ,target)))
  245.  
  246. (define (cons-pointer/constant type datum target)
  247.   (if (ea/same? datum target)
  248.       (LAP (BIS L (&U ,(make-non-pointer-literal type 0)) ,target))
  249.       (cons-pointer/ea (INST-EA (S ,type)) datum target)))
  250.  
  251. (define (set-type/ea type-ea target)
  252.   (LAP (INSV ,type-ea (S ,scheme-datum-width) (S ,scheme-type-width)
  253.          ,target)))
  254.  
  255. (define-integrable (set-type/constant type target)
  256.   (set-type/ea (INST-EA (S ,type)) target))
  257.  
  258. (define-integrable (extract-type source target)
  259.   (LAP (EXTV Z (S ,scheme-datum-width) (S ,scheme-type-width)
  260.          ,source ,target)))
  261.  
  262. (define (object->type source target)
  263.   (extract-type source target))
  264.  
  265. (define-integrable (ct/object->type object target)
  266.   (load-immediate (object-type object) target))
  267.  
  268. (define (object->datum source target)
  269.   (if (eq? source target)
  270.       (LAP (BIC L ,mask-reference ,target))
  271.       (LAP (BIC L ,mask-reference ,source ,target))))
  272.  
  273. (define-integrable (ct/object->datum object target)
  274.   (load-immediate (object-datum object) target))
  275.  
  276. (define (object->address source target)
  277.   (declare (integrate-operator object->datum))
  278.   (object->datum source target))
  279.  
  280. (define-integrable (ct/object->address object target)
  281.   (declare (integrate-operator ct/object->datum))
  282.   (ct/object->datum object target))
  283.  
  284. (define (compare-type type ea)
  285.   (set-standard-branches! 'EQL)
  286.   (LAP (CMPV Z (S ,scheme-datum-width) (S ,scheme-type-width)
  287.          ,ea ,(make-immediate type))))
  288.  
  289. ;;;; Utilities needed by the rules files (contd.)
  290.  
  291. (define-integrable (ea/same? ea1 ea2)
  292.   (equal? ea1 ea2))
  293.  
  294. (define (ea/copy source target)
  295.   (if (ea/same? source target)
  296.       (LAP)
  297.       (LAP (MOV L ,source ,target))))
  298.  
  299. (define (increment/ea ea offset)
  300.   (cond ((zero? offset)
  301.      (LAP))
  302.     ((= offset 1)
  303.      (LAP (INC L ,ea)))
  304.     ((= offset -1)
  305.      (LAP (DEC L ,ea)))
  306.     ((<= 0 offset 63)
  307.      (LAP (ADD L (S ,offset) ,ea)))
  308.     ((<= -63 offset 0)
  309.      (LAP (SUB L (S ,(- 0 offset)) ,ea)))
  310.     ((effective-address/register? ea)
  311.      (let ((size (datum-size offset)))
  312.        (if (not (eq? size 'L))
  313.            (LAP (MOVA L (@RO ,size ,(lap:ea-R-register ea) ,offset)
  314.               ,ea))
  315.            (LAP (ADD L (& ,offset) ,ea)))))
  316.     (else
  317.      (LAP (ADD L (& ,offset) ,ea)))))
  318.  
  319. (define (add-constant/ea source offset target)
  320.   (if (ea/same? source target)
  321.       (increment/ea target offset)
  322.       (cond ((zero? offset)
  323.          (LAP (MOV L ,source ,target)))
  324.         ((<= 0 offset 63)
  325.          (LAP (ADD L (S ,offset) ,source ,target)))
  326.         ((<= -63 offset 0)
  327.          (LAP (SUB L (S ,(- 0 offset)) ,source ,target)))
  328.         ((effective-address/register? source)
  329.          (let ((size (datum-size offset)))
  330.            (if (not (eq? size 'L))
  331.            (LAP (MOVA L (@RO ,size ,(lap:ea-R-register source) ,offset)
  332.                   ,target))
  333.            (LAP (ADD L (& ,offset) ,source ,target)))))
  334.         (else
  335.          (LAP (ADD L (& ,offset) ,source ,target))))))
  336.  
  337. (define-integrable (increment-rn rn value)
  338.   (increment/ea (INST-EA (R ,rn)) value))
  339.  
  340. ;;;; Utilities needed by the rules files (contd.)
  341.  
  342. ;;; Constants
  343.  
  344. (define (make-immediate value)
  345.   (if (<= 0 value 63)
  346.       (INST-EA (S ,value))
  347.       (INST-EA (& ,value))))
  348.  
  349. (define (constant->ea constant)
  350.   (if (non-pointer-object? constant)
  351.       (non-pointer->ea (object-type constant)
  352.                (careful-object-datum constant))
  353.       (INST-EA (@PCR ,(constant->label constant)))))
  354.  
  355. (define (non-pointer->ea type datum)
  356.   (if (and (zero? type)
  357.        (<= 0 datum 63))
  358.       (INST-EA (S ,datum))
  359.       (INST-EA (&U ,(make-non-pointer-literal type datum)))))
  360.  
  361. (define (load-constant constant target)
  362.   (if (non-pointer-object? constant)
  363.       (load-non-pointer (object-type constant)
  364.             (object-datum constant)
  365.             target)
  366.       (LAP (MOV L (@PCR ,(constant->label constant)) ,target))))
  367.  
  368. (define (load-non-pointer type datum target)
  369.   (if (not (zero? type))
  370.       (LAP (MOV L (&U ,(make-non-pointer-literal type datum)) ,target))
  371.       (load-immediate datum target)))
  372.  
  373. (define (load-immediate value target)
  374.   (cond ((zero? value)
  375.      (LAP (CLR L ,target)))
  376.     ((<= 0 value 63)
  377.      (LAP (MOV L (S ,value) ,target)))
  378.     (else
  379.      (let ((size (datum-size value)))
  380.        (if (not (eq? size 'L))
  381.            (LAP (CVT ,size L (& ,value) ,target))
  382.            (LAP (MOV L (& ,value) ,target)))))))
  383.  
  384. (define-integrable (load-rn value rn)
  385.   (load-immediate value (INST-EA (R ,rn))))
  386.  
  387. ;;;; Utilities needed by the rules files (contd.)
  388.  
  389. ;;; Predicate utilities
  390.  
  391. (define (set-standard-branches! condition-code)
  392.   (set-current-branches!
  393.    (lambda (label)
  394.      (LAP (B ,condition-code (@PCR ,label))))
  395.    (lambda (label)
  396.      (LAP (B ,(invert-cc condition-code) (@PCR ,label))))))
  397.  
  398. (define (test-byte n effective-address)
  399.   (cond ((zero? n)
  400.      (LAP (TST B ,effective-address)))
  401.     ((<= 0 n 63)
  402.      (LAP (CMP B ,effective-address (S ,n))))
  403.     (else
  404.      (LAP (CMP B ,effective-address (& ,n))))))
  405.  
  406. (define (test-non-pointer type datum effective-address)
  407.   (cond ((not (zero? type))
  408.      (LAP (CMP L
  409.            ,effective-address
  410.            (&U ,(make-non-pointer-literal type datum)))))
  411.     ((zero? datum)
  412.      (LAP (TST L ,effective-address)))
  413.     ((<= 0 datum 63)
  414.      (LAP (CMP L ,effective-address (S ,datum))))
  415.     (else
  416.      (LAP (CMP L
  417.            ,effective-address
  418.            (&U ,(make-non-pointer-literal type datum)))))))
  419.  
  420. (define (invert-cc condition-code)
  421.   (cdr (or (assq condition-code
  422.          '((NEQU . EQLU) (EQLU . NEQU)
  423.            (NEQ . EQL) (EQL . NEQ)
  424.            (GTR . LEQ) (LEQ . GTR)
  425.            (GEQ . LSS) (LSS . GEQ)
  426.            (VC . VS) (VS . VC)
  427.            (CC . CS) (CS . CC)
  428.            (GTRU . LEQU) (LEQU . GTRU)
  429.            (GEQU . LSSU) (LSSU . GEQU)))
  430.        (error "INVERT-CC: Not a known CC" condition-code))))
  431.  
  432. (define (invert-cc-noncommutative condition-code)
  433.   ;; Despite the fact that the name of this procedure is similar to
  434.   ;; that of `invert-cc', it is quite different.  `invert-cc' is used
  435.   ;; when the branches of a conditional are being exchanged, while
  436.   ;; this is used when the arguments are being exchanged.
  437.   (cdr (or (assq condition-code
  438.          '((NEQU . NEQU) (EQLU . EQLU)
  439.                 (NEQ . NEQ) (EQL . EQL)
  440.            (GTR . LSS) (LSS . GTR)
  441.            (GEQ . LEQ) (LEQ . GEQ)
  442.            ;; *** Are these two really correct? ***
  443.            (VC . VC) (VS . VS)
  444.            (CC . CC) (CS . CS)
  445.            (GTRU . LSSU) (LSSU . GTRU)
  446.            (GEQU . LEQU) (LEQU . GEQU)))
  447.        (error "INVERT-CC-NONCOMMUTATIVE: Not a known CC" condition-code))))
  448.  
  449. ;;;; Utilities needed by the rules files (contd.)
  450.  
  451. (define-integrable (effective-address/register? ea)
  452.   (eq? (lap:ea-keyword ea) 'R))
  453.  
  454. (define-integrable (effective-address/register-indirect? ea)
  455.   (eq? (lap:ea-keyword ea) '@R))
  456.  
  457. (define-integrable (effective-address/register-offset? ea)
  458.   (eq? (lap:ea-keyword ea) '@RO))
  459.  
  460. (define (offset->indirect-reference! offset)
  461.   (indirect-reference! (rtl:register-number (rtl:offset-base offset))
  462.                (rtl:offset-number offset)))
  463.  
  464. (define-integrable (indirect-reference! register offset)
  465.   (offset-reference (allocate-indirection-register! register) offset))
  466.  
  467. (define-integrable (indirect-byte-reference! register offset)
  468.   (byte-offset-reference (allocate-indirection-register! register) offset))
  469.  
  470. (define (allocate-indirection-register! register)
  471.   (load-alias-register! register 'GENERAL))
  472.  
  473. (define (generate-n-times n limit instruction-gen with-counter)
  474.   (if (> n limit)
  475.       (let ((loop (generate-label 'LOOP)))
  476.     (with-counter
  477.       (lambda (counter)
  478.         (LAP ,@(load-rn (-1+ n) counter)
  479.          (LABEL ,loop)
  480.          ,@(instruction-gen)
  481.          (SOB GEQ (R ,counter) (@PCR ,loop))))))
  482.       (let loop ((n n))
  483.     (if (zero? n)
  484.         (LAP)
  485.         (LAP ,@(instruction-gen)
  486.          ,@(loop (-1+ n)))))))
  487.  
  488. ;;;; Utilities needed by the rules files (contd.)
  489.  
  490. ;;; CHAR->ASCII utilities
  491.  
  492. (define (coerce->any/byte-reference register)
  493.   (if (machine-register? register)
  494.       (register-reference register)
  495.       (let ((alias (register-alias register false)))
  496.     (if alias
  497.         (register-reference alias)
  498.         (indirect-char/ascii-reference!
  499.          regnum:regs-pointer
  500.          (pseudo-register-offset register))))))
  501.  
  502. (define-integrable (indirect-char/ascii-reference! register offset)
  503.   (indirect-byte-reference! register (* offset 4)))
  504.  
  505. (define (char->signed-8-bit-immediate character)
  506.   (let ((ascii (char->ascii character)))
  507.     (if (< ascii 128)
  508.     ascii
  509.     (- ascii 256))))
  510.  
  511. (define-integrable (lap:ea-keyword expression)
  512.   (car expression))
  513.  
  514. (define-integrable (lap:ea-R-register expression)
  515.   (cadr expression))
  516.  
  517. (define-integrable (lap:ea-@R-register expression)
  518.   (cadr expression))
  519.  
  520. (define-integrable (lap:ea-@RO-register expression)
  521.   (caddr expression))
  522.  
  523. (define-integrable (lap:ea-@RO-offset expression)
  524.   (cadddr expression))
  525.  
  526. ;;;; Utilities needed by the rules files (contd.)
  527.  
  528. ;;; Layout of the Scheme register array.
  529.  
  530. (define-integrable reg:compiled-memtop        (INST-EA (@R 10)))
  531. (define-integrable reg:environment        (INST-EA (@RO B 10 #x000C)))
  532. (define-integrable reg:temp            (INST-EA (@RO B 10 #x0010)))
  533. (define-integrable reg:lexpr-primitive-arity    (INST-EA (@RO B 10 #x001C)))
  534. (define-integrable reg:stack-guard        (INST-EA (@RO B 10 #x002C)))
  535.  
  536. (let-syntax ((define-codes
  537.            (macro (start . names)
  538.          (define (loop names index)
  539.            (if (null? names)
  540.                '()
  541.                (cons `(DEFINE-INTEGRABLE
  542.                 ,(symbol-append 'CODE:COMPILER-
  543.                         (car names))
  544.                 ,index)
  545.                  (loop (cdr names) (1+ index)))))
  546.          `(BEGIN ,@(loop names start)))))
  547.   (define-codes #x012
  548.     primitive-apply primitive-lexpr-apply
  549.     apply error lexpr-apply link
  550.     interrupt-closure interrupt-dlink interrupt-procedure 
  551.     interrupt-continuation interrupt-ic-procedure
  552.     assignment-trap cache-reference-apply
  553.     reference-trap safe-reference-trap unassigned?-trap
  554.     -1+ &/ &= &> 1+ &< &- &* negative? &+ positive? zero?
  555.     access lookup safe-lookup unassigned? unbound?
  556.     set! define lookup-apply))
  557.  
  558. (let-syntax ((define-entries
  559.            (macro (start . names)
  560.          (define (loop names index)
  561.            (if (null? names)
  562.                '()
  563.                (cons `(DEFINE-INTEGRABLE
  564.                 ,(symbol-append 'ENTRY:COMPILER-
  565.                         (car names))
  566.                 (INST-EA (@RO B 10 ,index)))
  567.                  (loop (cdr names) (+ index 8)))))
  568.          `(BEGIN ,@(loop names start)))))
  569.   (define-entries #x40
  570.     scheme-to-interface            ; Main entry point (only one necessary)
  571.     scheme-to-interface-jsb        ; Used by rules3&4, for convenience.
  572.     trampoline-to-interface        ; Used by trampolines, for convenience.
  573.     ;; If more are added, the size of the addressing mode must be changed.
  574.     ))
  575.  
  576. (define-integrable (invoke-interface code)
  577.   (LAP ,@(load-rn code 0)
  578.        (JMP ,entry:compiler-scheme-to-interface)))
  579.  
  580. #|
  581. ;; If the entry point scheme-to-interface-jsb were not available,
  582. ;; this code should replace the definition below.
  583. ;; The others can be handled similarly.
  584.  
  585. (define-integrable (invoke-interface-jsb code)
  586.   (LAP ,@(load-rn code 0)
  587.        (MOVA B (@PCO B 10) (R 1))
  588.        (JMP ,entry:compiler-scheme-to-interface)))
  589. |#
  590.  
  591. (define-integrable (invoke-interface-jsb code)
  592.   (LAP ,@(load-rn code 0)
  593.        (JSB ,entry:compiler-scheme-to-interface-jsb)))
  594.  
  595.  
  596. (define (pre-lapgen-analysis rgraphs)
  597.   rgraphs
  598.   unspecific)