From 4efd9394e0a3f737d0f538fe2dfb8351e72a179b Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Thu, 30 Nov 1989 16:07:41 +0000 Subject: [PATCH] New compiled code interface written in C. Old hooks have been removed and the register block has been restructured. --- v7/src/compiler/machines/bobcat/dassm2.scm | 44 ++++---- v7/src/compiler/machines/bobcat/lapgen.scm | 88 ++++++++++++---- v7/src/compiler/machines/bobcat/machin.scm | 4 +- v7/src/compiler/machines/bobcat/rules3.scm | 116 ++++++++++++--------- v7/src/compiler/machines/bobcat/rules4.scm | 90 ++++++++-------- 5 files changed, 198 insertions(+), 144 deletions(-) diff --git a/v7/src/compiler/machines/bobcat/dassm2.scm b/v7/src/compiler/machines/bobcat/dassm2.scm index 0317bc4e7..561db0d70 100644 --- a/v7/src/compiler/machines/bobcat/dassm2.scm +++ b/v7/src/compiler/machines/bobcat/dassm2.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -59,9 +59,12 @@ MIT in each case. |# (arity (read-unsigned-integer (+ offset 6) 16))) (case opcode ((#x4ef9) ; JMP .L + ;; *** This should learn how to decode + ;; the new trampolines. *** (vector 'COMPILED (read-procedure (+ offset 2)) arity)) + #| ((#x4eb9) ; JSR .L (let* ((new-block (compiled-code-address->block @@ -92,6 +95,7 @@ MIT in each case. |# (error "disassembler/read-procedure-cache: Unknown offset" offset block index))))) + |# (else (error "disassembler/read-procedure-cache: Unknown opcode" opcode block index)))))))) @@ -230,18 +234,18 @@ MIT in each case. |# (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 @@ -318,44 +322,32 @@ MIT in each case. |# 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)))))))) ) (define (make-pc-relative thunk) diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm index 7a55de45a..29eda59b4 100644 --- a/v7/src/compiler/machines/bobcat/lapgen.scm +++ b/v7/src/compiler/machines/bobcat/lapgen.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -62,7 +62,9 @@ MIT in each case. |# (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 @@ -109,6 +111,14 @@ MIT in each case. |# ) +(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)))) @@ -822,7 +832,34 @@ MIT in each case. |# block-start-label (LAP (ENTRY-POINT ,label) ,@(make-external-label expression-code-word label))) + +(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)) + (let-syntax ((define-entries (macro (start . names) (define (loop names index) @@ -832,24 +869,31 @@ MIT in each case. |# ,(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 diff --git a/v7/src/compiler/machines/bobcat/machin.scm b/v7/src/compiler/machines/bobcat/machin.scm index e62b7b391..16fc0f631 100644 --- a/v7/src/compiler/machines/bobcat/machin.scm +++ b/v7/src/compiler/machines/bobcat/machin.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -139,7 +139,7 @@ MIT in each case. |# (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) diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm index 7276fd103..981119062 100644 --- a/v7/src/compiler/machines/bobcat/rules3.scm +++ b/v7/src/compiler/machines/bobcat/rules3.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -53,8 +53,8 @@ MIT in each case. |# (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)) @@ -74,19 +74,20 @@ MIT in each case. |# (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)) @@ -102,46 +103,48 @@ MIT in each case. |# (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)))) (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 @@ -154,9 +157,9 @@ MIT in each case. |# 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 &*) @@ -337,11 +340,19 @@ MIT in each case. |# ;;; 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))))) @@ -355,7 +366,7 @@ MIT in each case. |# (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)) @@ -366,16 +377,20 @@ MIT in each case. |# (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)) @@ -384,7 +399,7 @@ MIT in each case. |# ,internal-label) ,@(simple-procedure-header (make-procedure-code-word min max) internal-label - entry:compiler-interrupt-procedure))) + code:compiler-interrupt-procedure))) ;;;; Closures. These two statements are intertwined: @@ -397,7 +412,7 @@ MIT in each case. |# (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) @@ -448,9 +463,11 @@ MIT in each case. |# (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)))) @@ -466,14 +483,15 @@ MIT in each case. |# ((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))))) diff --git a/v7/src/compiler/machines/bobcat/rules4.scm b/v7/src/compiler/machines/bobcat/rules4.scm index 4b06957cb..55de1d8aa 100644 --- a/v7/src/compiler/machines/bobcat/rules4.scm +++ b/v7/src/compiler/machines/bobcat/rules4.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -40,151 +40,151 @@ MIT in each case. |# (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))))) (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)))) (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 -- 2.25.1