#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/dassm2.scm,v 4.14 1989/10/26 07:37:31 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/dassm2.scm,v 4.15 1989/11/30 16:06:49 jinx Exp $
Copyright (c) 1988, 1989 Massachusetts Institute of Technology
(arity (read-unsigned-integer (+ offset 6) 16)))
(case opcode
((#x4ef9) ; JMP <value>.L
+ ;; *** This should learn how to decode
+ ;; the new trampolines. ***
(vector 'COMPILED
(read-procedure (+ offset 2))
arity))
+ #|
((#x4eb9) ; JSR <value>.L
(let* ((new-block
(compiled-code-address->block
(error
"disassembler/read-procedure-cache: Unknown offset"
offset block index)))))
+ |#
(else
(error "disassembler/read-procedure-cache: Unknown opcode"
opcode block index))))))))
(define make-address-register)
(define make-address-offset)
(define interpreter-register?)
+
(let ()
#|
-
(define (register-maker assignments)
(lambda (mode register)
(list mode
(if disassembler/symbolize-output?
(cdr (assq register assignments))
register))))
-
|#
+
(set! make-data-register
(lambda (mode register)
(list mode
6)
(define interpreter-register-assignments
- (let ()
+ (let* ((first-entry (* 4 16))
+ (first-temp (+ first-entry (* 8 40))))
(define (make-entries index names)
(if (null? names)
'()
(cons `(,index . (ENTRY ,(car names)))
- (make-entries (+ index 6) (cdr names)))))
+ (make-entries (+ index 8) (cdr names)))))
`(;; Interpreter registers
(0 . (REGISTER MEMORY-TOP))
(4 . (REGISTER STACK-GUARD))
(8 . (REGISTER VALUE))
(12 . (REGISTER ENVIRONMENT))
(16 . (REGISTER TEMPORARY))
- ;; Old compiled code temporaries
- ;; Retained for compatibility with old compiled code and should
- ;; eventually be flushed.
- ,@(let loop ((index 40) (i 0))
- (if (= i 50)
- '()
- (cons `(,index . (OLD TEMPORARY ,i))
- (loop (+ index 4) (1+ i)))))
;; Interpreter entry points
,@(make-entries
- #x012c
- '(link error apply
- lexpr-apply primitive-apply primitive-lexpr-apply
- cache-reference-apply lookup-apply
- interrupt-continuation interrupt-ic-procedure
- interrupt-procedure interrupt-closure
- lookup safe-lookup set! access unassigned? unbound? define
- reference-trap safe-reference-trap assignment-trap
- unassigned?-trap
- &+ &- &* &/ &= &< &> 1+ -1+ zero? positive? negative?))
+ first-entry
+ '(scheme-to-interface
+ scheme-to-interface-jsr
+ trampoline-to-interface
+ shortcircuit-apply))
;; Compiled code temporaries
- ,@(let loop ((index 720) (i 0))
- (if (= i 300)
+ ,@(let loop ((i 0) (index first-temp))
+ (if (= i 256)
'()
(cons `(,index . (TEMPORARY ,i))
- (loop (+ index 12) (1+ i))))))))
+ (loop (1+ i) (+ index 12))))))))
)
\f
(define (make-pc-relative thunk)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 4.22 1989/10/26 07:37:46 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 4.23 1989/11/30 16:05:44 jinx Exp $
Copyright (c) 1988, 1989 Massachusetts Institute of Technology
(machine-register->memory source (pseudo-register-home target)))
(define-integrable (pseudo-register-offset register)
- (+ 180 (* 3 (register-renumber register))))
+ ;; Offset into register block for temporary registers
+ (+ (+ (* 16 4) (* 40 8))
+ (* 3 (register-renumber register))))
(define-integrable (pseudo-register-home register)
(offset-reference regnum:regs-pointer
)
\f
+(define (load-dnl n d)
+ (cond ((zero? n)
+ (INST (CLR L (D ,d))))
+ ((<= -128 n 127)
+ (INST (MOVEQ (& ,n) (D ,d))))
+ (else
+ (INST (MOV L (& ,n) (D ,d))))))
+
(define (load-dnw n d)
(cond ((zero? n)
(INST (CLR W (D ,d))))
block-start-label
(LAP (ENTRY-POINT ,label)
,@(make-external-label expression-code-word label)))
+\f
+(define-integrable reg:compiled-memtop (INST-EA (@A 6)))
+(define-integrable reg:environment (INST-EA (@AO 6 #x000C)))
+(define-integrable reg:temp (INST-EA (@AO 6 #x0010)))
+(define-integrable reg:lexpr-primitive-arity (INST-EA (@AO 6 #x001C)))
+(let-syntax ((define-codes
+ (macro (start . names)
+ (define (loop names index)
+ (if (null? names)
+ '()
+ (cons `(DEFINE-INTEGRABLE
+ ,(symbol-append 'CODE:COMPILER-
+ (car names))
+ ,index)
+ (loop (cdr names) (1+ index)))))
+ `(BEGIN ,@(loop names start)))))
+ (define-codes #x012
+ primitive-apply primitive-lexpr-apply
+ apply error lexpr-apply link
+ interrupt-closure interrupt-dlink interrupt-procedure
+ interrupt-continuation interrupt-ic-procedure
+ assignment-trap cache-reference-apply
+ reference-trap safe-reference-trap unassigned?-trap
+ -1+ &/ &= &> 1+ &< &- &* negative? &+ positive? zero?
+ access lookup safe-lookup unassigned? unbound?
+ set! define lookup-apply))
+\f
(let-syntax ((define-entries
(macro (start . names)
(define (loop names index)
,(symbol-append 'ENTRY:COMPILER-
(car names))
(INST-EA (@AO 6 ,index)))
- (loop (cdr names) (+ index 6)))))
+ (loop (cdr names) (+ index 8)))))
`(BEGIN ,@(loop names start)))))
- (define-entries #x012c
- link error apply
- lexpr-apply primitive-apply primitive-lexpr-apply
- cache-reference-apply lookup-apply
- interrupt-continuation interrupt-ic-procedure
- interrupt-procedure interrupt-closure
- lookup safe-lookup set! access unassigned? unbound? define
- reference-trap safe-reference-trap assignment-trap unassigned?-trap
- &+ &- &* &/ &= &< &> 1+ -1+ zero? positive? negative?))
-
-(define-integrable reg:compiled-memtop (INST-EA (@A 6)))
-(define-integrable reg:environment (INST-EA (@AO 6 #x000C)))
-(define-integrable reg:temp (INST-EA (@AO 6 #x0010)))
-(define-integrable reg:enclose-result (INST-EA (@AO 6 #x0014)))
-(define-integrable reg:lexpr-primitive-arity (INST-EA (@AO 6 #x001C)))
-
-(define-integrable popper:apply-closure (INST-EA (@AO 6 #x0168)))
-(define-integrable popper:apply-stack (INST-EA (@AO 6 #x01A8)))
-(define-integrable popper:value (INST-EA (@AO 6 #x01E8)))
\ No newline at end of file
+ (define-entries #x40
+ scheme-to-interface ; Main entry point (only one necessary)
+ scheme-to-interface-jsr ; Used by rules4, for convenience
+ trampoline-to-interface ; Used by trampolines, for convenience
+ shortcircuit-apply ; Used by rules3, for speed
+ ))
+
+(define-integrable (invoke-interface code)
+ (LAP ,(load-dnw code 0)
+ (JMP ,entry:compiler-scheme-to-interface)))
+
+#|
+;; If the entry point scheme-to-interface-jsr were not available,
+;; this code should replace the definition below.
+;; The others can be handled similarly.
+
+(define-integrable (invoke-interface-jsr code)
+ (LAP ,(load-dnw code 0)
+ (LEA (@PCO 12) (A 0))
+ (MOV L (A 0) (D 1))
+ (JMP ,entry:compiler-scheme-to-interface)))
+|#
+
+(define-integrable (invoke-interface-jsr code)
+ (LAP ,(load-dnw code 0)
+ (JSR ,entry:compiler-scheme-to-interface-jsr)))
\ No newline at end of file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/machin.scm,v 4.17 1989/09/05 22:34:16 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/machin.scm,v 4.18 1989/11/30 16:07:41 jinx Exp $
Copyright (c) 1988, 1989 Massachusetts Institute of Technology
(define-integrable fp6 22)
(define-integrable fp7 23)
(define-integrable number-of-machine-registers 24)
-(define-integrable number-of-temporary-registers 50)
+(define-integrable number-of-temporary-registers 256)
(define-integrable regnum:dynamic-link a4)
(define-integrable regnum:free-pointer a5)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 4.18 1989/10/26 07:38:00 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 4.19 1989/11/30 16:06:05 jinx Exp $
Copyright (c) 1988, 1989 Massachusetts Institute of Technology
(INVOCATION:APPLY (? frame-size) (? continuation))
continuation
(LAP ,@(clear-map!)
- ,(load-dnw frame-size 0)
- (JMP ,entry:compiler-apply)))
+ ,(load-dnl frame-size 2)
+ (JMP ,entry:compiler-shortcircuit-apply)))
(define-rule statement
(INVOCATION:JUMP (? frame-size) (? continuation) (? label))
(INVOCATION:LEXPR (? number-pushed) (? continuation) (? label))
continuation
(LAP ,@(clear-map!)
- ,(load-dnw number-pushed 0)
+ ,(load-dnl number-pushed 2)
(LEA (@PCR ,label) (A 0))
- (JMP ,entry:compiler-lexpr-apply)))
+ (MOV L (A 0) (D 1))
+ ,@(invoke-interface code:compiler-lexpr-apply)))
(define-rule statement
(INVOCATION:COMPUTED-LEXPR (? number-pushed) (? continuation))
continuation
;; It expects the procedure at the top of the stack
(LAP ,@(clear-map!)
- ,(load-dnw number-pushed 0)
+ ,(load-dnl number-pushed 2)
,(clear-continuation-type-code)
- (MOV L (@A+ 7) (A 0))
- (JMP ,entry:compiler-lexpr-apply)))
+ (MOV L (@A+ 7) (D 1))
+ ,@(invoke-interface code:compiler-lexpr-apply)))
(define-rule statement
(INVOCATION:UUO-LINK (? frame-size) (? continuation) (? name))
(define-rule statement
(INVOCATION:CACHE-REFERENCE (? frame-size) (? continuation) (? extension))
continuation
- (let ((set-extension (expression->machine-register! extension a3)))
+ (let ((set-extension (expression->machine-register! extension d1)))
(delete-dead-registers!)
(LAP ,@set-extension
,@(clear-map!)
- ,(load-dnw frame-size 0)
+ ,(load-dnl frame-size 3)
(LEA (@PCR ,*block-label*) (A 1))
- (JMP ,entry:compiler-cache-reference-apply))))
+ (MOV L (A 1) (D 2))
+ ,@(invoke-interface code:compiler-cache-reference-apply))))
(define-rule statement
(INVOCATION:LOOKUP (? frame-size) (? continuation) (? environment) (? name))
continuation
- (let ((set-environment (expression->machine-register! environment d4)))
+ (let ((set-environment (expression->machine-register! environment d1)))
(delete-dead-registers!)
(LAP ,@set-environment
,@(clear-map!)
- ,(load-constant name (INST-EA (D 5)))
- ,(load-dnw frame-size 0)
- (JMP ,entry:compiler-lookup-apply))))
+ ,(load-constant name (INST-EA (D 2)))
+ ,(load-dnl frame-size 3)
+ ,@(invoke-interface code:compiler-lookup-apply))))
\f
(define-rule statement
(INVOCATION:PRIMITIVE (? frame-size) (? continuation) (? primitive))
continuation
(LAP ,@(clear-map!)
,@(if (eq? primitive compiled-error-procedure)
- (LAP ,(load-dnw frame-size 0)
- (JMP ,entry:compiler-error))
+ (LAP ,(load-dnl frame-size 1)
+ ,@(invoke-interface code:compiler-error))
(let ((arity (primitive-procedure-arity primitive)))
(cond ((not (negative? arity))
- (LAP (MOV L (@PCR ,(constant->label primitive)) (D 6))
- (JMP ,entry:compiler-primitive-apply)))
+ (LAP (MOV L (@PCR ,(constant->label primitive)) (D 1))
+ ,@(invoke-interface code:compiler-primitive-apply)))
((= arity -1)
(LAP (MOV L (& ,(-1+ frame-size))
,reg:lexpr-primitive-arity)
- (MOV L (@PCR ,(constant->label primitive)) (D 6))
- (JMP ,entry:compiler-primitive-lexpr-apply)))
+ (MOV L (@PCR ,(constant->label primitive)) (D 1))
+ ,@(invoke-interface
+ code:compiler-primitive-lexr-apply)))
(else
;; Unknown primitive arity. Go through apply.
- (LAP ,(load-dnw frame-size 0)
- (MOV L (@PCR ,(constant->label primitive)) (@-A 7))
- (JMP ,entry:compiler-apply))))))))
+ (LAP ,(load-dnl frame-size 2)
+ (MOV L (@PCR ,(constant->label primitive)) (D 1))
+ ,@(invoke-interface code:compiler-apply))))))))
(let-syntax
((define-special-primitive-invocation
frame-size continuation
,(list 'LAP
(list 'UNQUOTE-SPLICING '(clear-map!))
- (list 'JMP
- (list 'UNQUOTE
- (symbol-append 'ENTRY:COMPILER- name))))))))
+ (list 'UNQUOTE-SPLICING
+ `(INVOKE-INTERFACE ,(symbol-append 'CODE:COMPILER-
+ name))))))))
(define-special-primitive-invocation &+)
(define-special-primitive-invocation &-)
(define-special-primitive-invocation &*)
;;; contain a valid dynamic link, but the gc handler determines that
;;; and saves it as appropriate.
-(define-integrable (simple-procedure-header code-word label
- entry:compiler-interrupt)
- (let ((gc-label (generate-label)))
+(define-integrable (simple-procedure-header code-word label code)
+ (let ((gc-label (generate-label)))
(LAP (LABEL ,gc-label)
- (JSR ,entry:compiler-interrupt)
+ ,@(invoke-interface-jsr code)
+ ,@(make-external-label code-word label)
+ (CMP L ,reg:compiled-memtop (A 5))
+ (B GE B (@PCR ,gc-label)))))
+
+(define-integrable (dlink-procedure-header code-word label)
+ (let ((gc-label (generate-label)))
+ (LAP (LABEL ,gc-label)
+ (MOV L (A 4) (D 2)) ; Dynamic link -> D2
+ ,@(invoke-interface-jsr code:compiler-interrupt-dlink)
,@(make-external-label code-word label)
(CMP L ,reg:compiled-memtop (A 5))
(B GE B (@PCR ,gc-label)))))
(CONTINUATION-HEADER (? internal-label))
(simple-procedure-header (continuation-code-word internal-label)
internal-label
- entry:compiler-interrupt-continuation))
+ code:compiler-interrupt-continuation))
(define-rule statement
(IC-PROCEDURE-HEADER (? internal-label))
(EQUATE ,external-label ,internal-label)
,@(simple-procedure-header expression-code-word
internal-label
- entry:compiler-interrupt-ic-procedure)))))
+ code:compiler-interrupt-ic-procedure)))))
(define-rule statement
(OPEN-PROCEDURE-HEADER (? internal-label))
- (LAP (EQUATE ,(rtl-procedure/external-label
- (label->object internal-label))
- ,internal-label)
- ,@(simple-procedure-header internal-entry-code-word
- internal-label
- entry:compiler-interrupt-procedure)))
+ (let ((rtl-proc (label->object internal-label)))
+ (LAP
+ (EQUATE ,(rtl-procedure/external-label rtl-proc) ,internal-label)
+ ,@((if (rtl-procedure/dynamic-link? rtl-proc)
+ dlink-procedure-header
+ (lambda (code-word label)
+ (simple-procedure-header code-word label
+ code:compiler-interrupt-procedure)))
+ internal-entry-code-word
+ internal-label))))
(define-rule statement
(PROCEDURE-HEADER (? internal-label) (? min) (? max))
,internal-label)
,@(simple-procedure-header (make-procedure-code-word min max)
internal-label
- entry:compiler-interrupt-procedure)))
+ code:compiler-interrupt-procedure)))
\f
;;;; Closures. These two statements are intertwined:
(let ((gc-label (generate-label))
(external-label (rtl-procedure/external-label procedure)))
(LAP (LABEL ,gc-label)
- (JMP ,entry:compiler-interrupt-closure)
+ ,@(invoke-interface code:compiler-interrupt-closure)
,@(make-external-label internal-entry-code-word external-label)
(ADD UL (& ,magic-closure-constant) (@A 7))
(LABEL ,internal-label)
(LAP (LEA (@PCR ,environment-label) (A 0))
(MOV L ,reg:environment (@A 0))
(LEA (@PCR ,*block-label*) (A 0))
- (LEA (@PCR ,free-ref-label) (A 1))
- ,(load-dnw n-sections 0)
- (JSR ,entry:compiler-link)
+ (MOV L (A 0) (D 2))
+ (LEA (@PCR ,free-ref-label) (A 0))
+ (MOV L (A 0) (D 3))
+ ,(load-dnl n-sections 4)
+ ,@(invoke-interface-jsr code:compiler-link)
,@(make-external-label (continuation-code-word false)
(generate-label))))
((D 0) L 1) Z
(0 N))
(A 1)))))))
- (LAP (MOV L (@PCR ,code-block-label) (D 0))
- (AND L ,mask-reference (D 0))
- (MOV L (D 0) (A 0))
+ (LAP (MOV L (@PCR ,code-block-label) (D 2))
+ (AND L ,mask-reference (D 2))
+ (MOV L (D 2) (A 0))
,(load-offset environment-offset)
(MOV L ,reg:environment (@A 1))
,(load-offset free-ref-offset)
- ,(load-dnw n-sections 0)
- (JSR ,entry:compiler-link)
+ (MOV L (A 1) (D 3))
+ ,(load-dnl n-sections 4)
+ ,@(invoke-interface-jsr code:compiler-link)
,@(make-external-label (continuation-code-word false)
(generate-label)))))
\f
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules4.scm,v 4.7 1989/10/26 07:38:05 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules4.scm,v 4.8 1989/11/30 16:06:28 jinx Exp $
Copyright (c) 1988, 1989 Massachusetts Institute of Technology
(define-rule statement
(INTERPRETER-CALL:ACCESS (? environment) (? name))
- (lookup-call entry:compiler-access environment name))
+ (lookup-call code:compiler-access environment name))
(define-rule statement
(INTERPRETER-CALL:LOOKUP (? environment) (? name) (? safe?))
- (lookup-call (if safe? entry:compiler-safe-lookup entry:compiler-lookup)
+ (lookup-call (if safe? code:compiler-safe-lookup code:compiler-lookup)
environment name))
(define-rule statement
(INTERPRETER-CALL:UNASSIGNED? (? environment) (? name))
- (lookup-call entry:compiler-unassigned? environment name))
+ (lookup-call code:compiler-unassigned? environment name))
(define-rule statement
(INTERPRETER-CALL:UNBOUND? (? environment) (? name))
- (lookup-call entry:compiler-unbound? environment name))
+ (lookup-call code:compiler-unbound? environment name))
-(define (lookup-call entry environment name)
- (let ((set-environment (expression->machine-register! environment a0)))
+(define (lookup-call code environment name)
+ (let ((set-environment (expression->machine-register! environment d2)))
(let ((clear-map (clear-map!)))
(LAP ,@set-environment
,@clear-map
- ,(load-constant name (INST-EA (A 1)))
- (JSR ,entry)))))
+ ,(load-constant name (INST-EA (D 3)))
+ ,@(invoke-interface-jsr code)))))
\f
(define-rule statement
(INTERPRETER-CALL:DEFINE (? environment) (? name) (? value))
(QUALIFIER (not (eq? 'CONS-POINTER (car value))))
- (assignment-call:default entry:compiler-define environment name value))
+ (assignment-call:default code:compiler-define environment name value))
(define-rule statement
(INTERPRETER-CALL:SET! (? environment) (? name) (? value))
(QUALIFIER (not (eq? 'CONS-POINTER (car value))))
- (assignment-call:default entry:compiler-set! environment name value))
+ (assignment-call:default code:compiler-set! environment name value))
-(define (assignment-call:default entry environment name value)
- (let ((set-environment (expression->machine-register! environment a0)))
- (let ((set-value (expression->machine-register! value a2)))
+(define (assignment-call:default code environment name value)
+ (let ((set-environment (expression->machine-register! environment d2)))
+ (let ((set-value (expression->machine-register! value d4)))
(let ((clear-map (clear-map!)))
(LAP ,@set-environment
,@set-value
,@clear-map
- ,(load-constant name (INST-EA (A 1)))
- (JSR ,entry))))))
+ ,(load-constant name (INST-EA (D 3)))
+ ,@(invoke-interface-jsr code))))))
(define-rule statement
(INTERPRETER-CALL:DEFINE (? environment) (? name)
(CONS-POINTER (CONSTANT (? type))
(REGISTER (? datum))))
- (assignment-call:cons-pointer entry:compiler-define environment name type
+ (assignment-call:cons-pointer code:compiler-define environment name type
datum))
(define-rule statement
(INTERPRETER-CALL:SET! (? environment) (? name)
(CONS-POINTER (CONSTANT (? type))
(REGISTER (? datum))))
- (assignment-call:cons-pointer entry:compiler-set! environment name type
+ (assignment-call:cons-pointer code:compiler-set! environment name type
datum))
-(define (assignment-call:cons-pointer entry environment name type datum)
- (let ((set-environment (expression->machine-register! environment a0)))
+(define (assignment-call:cons-pointer code environment name type datum)
+ (let ((set-environment (expression->machine-register! environment d2)))
(let ((datum (standard-register-reference datum false true)))
(let ((clear-map (clear-map!)))
(LAP ,@set-environment
(MOV L ,datum ,reg:temp)
,(memory-set-type type reg:temp)
,@clear-map
- (MOV L ,reg:temp (A 2))
- ,(load-constant name (INST-EA (A 1)))
- (JSR ,entry))))))
+ (MOV L ,reg:temp (D 4))
+ ,(load-constant name (INST-EA (D 3)))
+ ,@(invoke-interface-jsr code))))))
(define-rule statement
(INTERPRETER-CALL:DEFINE (? environment) (? name)
(CONS-POINTER (CONSTANT (? type))
(ENTRY:PROCEDURE (? label))))
- (assignment-call:cons-procedure entry:compiler-define environment name type
+ (assignment-call:cons-procedure code:compiler-define environment name type
label))
(define-rule statement
(INTERPRETER-CALL:SET! (? environment) (? name)
(CONS-POINTER (CONSTANT (? type))
(ENTRY:PROCEDURE (? label))))
- (assignment-call:cons-procedure entry:compiler-set! environment name type
+ (assignment-call:cons-procedure code:compiler-set! environment name type
label))
-(define (assignment-call:cons-procedure entry environment name type label)
- (let ((set-environment (expression->machine-register! environment a0)))
+(define (assignment-call:cons-procedure code environment name type label)
+ (let ((set-environment (expression->machine-register! environment d2)))
(LAP ,@set-environment
,@(clear-map!)
(PEA (@PCR ,(rtl-procedure/external-label (label->object label))))
,(memory-set-type type (INST-EA (@A 7)))
- (MOV L (@A+ 7) (A 2))
- ,(load-constant name (INST-EA (A 1)))
- (JSR ,entry))))
+ (MOV L (@A+ 7) (D 4))
+ ,@(invoke-interface-jsr code))))
\f
(define-rule statement
(INTERPRETER-CALL:CACHE-REFERENCE (? extension) (? safe?))
- (let ((set-extension (expression->machine-register! extension a0)))
+ (let ((set-extension (expression->machine-register! extension d2)))
(let ((clear-map (clear-map!)))
(LAP ,@set-extension
,@clear-map
- (JSR ,(if safe?
- entry:compiler-safe-reference-trap
- entry:compiler-reference-trap))))))
+ ,@(invoke-interface-jsr
+ (if safe?
+ code:compiler-safe-reference-trap
+ code:compiler-reference-trap))))))
(define-rule statement
(INTERPRETER-CALL:CACHE-ASSIGNMENT (? extension) (? value))
(QUALIFIER (not (eq? 'CONS-POINTER (car value))))
- (let ((set-extension (expression->machine-register! extension a0)))
- (let ((set-value (expression->machine-register! value a1)))
+ (let ((set-extension (expression->machine-register! extension d2)))
+ (let ((set-value (expression->machine-register! value d3)))
(let ((clear-map (clear-map!)))
(LAP ,@set-extension
,@set-value
,@clear-map
- (JSR ,entry:compiler-assignment-trap))))))
+ ,@(invoke-interface-jsr code:compiler-assignment-trap))))))
(define-rule statement
(INTERPRETER-CALL:CACHE-ASSIGNMENT (? extension)
(CONS-POINTER (CONSTANT (? type))
(REGISTER (? datum))))
- (let ((set-extension (expression->machine-register! extension a0)))
+ (let ((set-extension (expression->machine-register! extension d2)))
(let ((datum (standard-register-reference datum false true)))
(let ((clear-map (clear-map!)))
(LAP ,@set-extension
(MOV L ,datum ,reg:temp)
,(memory-set-type type reg:temp)
,@clear-map
- (MOV L ,reg:temp (A 1))
- (JSR ,entry:compiler-assignment-trap))))))
+ (MOV L ,reg:temp (D 3))
+ ,@(invoke-interface-jsr code:compiler-assignment-trap))))))
(define-rule statement
(INTERPRETER-CALL:CACHE-ASSIGNMENT
(? extension)
(CONS-POINTER (CONSTANT (? type))
(ENTRY:PROCEDURE (? label))))
- (let ((set-extension (expression->machine-register! extension a0)))
+ (let ((set-extension (expression->machine-register! extension d2)))
(LAP ,@set-extension
,@(clear-map!)
(PEA (@PCR ,(rtl-procedure/external-label (label->object label))))
,(memory-set-type type (INST-EA (@A 7)))
- (MOV L (@A+ 7) (A 1))
- (JSR ,entry:compiler-assignment-trap))))
+ (MOV L (@A+ 7) (D 3))
+ ,@(invoke-interface-jsr code:compiler-assignment-trap))))
(define-rule statement
(INTERPRETER-CALL:CACHE-UNASSIGNED? (? extension))
- (let ((set-extension (expression->machine-register! extension a0)))
+ (let ((set-extension (expression->machine-register! extension d2)))
(let ((clear-map (clear-map!)))
(LAP ,@set-extension
,@clear-map
- (JSR ,entry:compiler-unassigned?-trap)))))
\ No newline at end of file
+ ,@(invoke-interface-jsr code:compiler-unassigned?-trap)))))
\ No newline at end of file
projects / mit-scheme.git / commitdiff