From f85c101a121741f224f9c6306c794a8b785b8a3e Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 11 Dec 1989 06:17:06 +0000 Subject: [PATCH] * Take advantage of new entry points in compiled code interface. These changes require microcode 11.16 or later. * Use BFEXTU instruction to extract type field. This instruction is both faster and smaller than the previous sequence, for both 6 and 8 bit types. Use BFTST instruction to test for zero types. Conditionalize use of the bit-field instructions on the new flag `use-68020-instructions?'; I don't believe that we're using any other 68020-specific instructions besides these. * Add rule for 1-arg fixnum predicates that tries to take advantage of the preceding LSL.L instruction to test the number, rather than emitting a redundant TST.L; this new rule is always used in generic arithmetic expansions. --- v7/src/compiler/machines/bobcat/dassm2.scm | 36 ++++++++- v7/src/compiler/machines/bobcat/lapgen.scm | 60 ++++++++++++-- v7/src/compiler/machines/bobcat/rules1.scm | 36 ++++++--- v7/src/compiler/machines/bobcat/rules2.scm | 91 +++++++++++++++------- v7/src/compiler/machines/bobcat/rules3.scm | 68 +++++++++------- v7/src/compiler/machines/bobcat/rules4.scm | 16 ++-- 6 files changed, 220 insertions(+), 87 deletions(-) diff --git a/v7/src/compiler/machines/bobcat/dassm2.scm b/v7/src/compiler/machines/bobcat/dassm2.scm index 561db0d70..28fd16f34 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.15 1989/11/30 16:06:49 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/dassm2.scm,v 4.16 1989/12/11 06:16:42 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -341,7 +341,39 @@ MIT in each case. |# '(scheme-to-interface scheme-to-interface-jsr trampoline-to-interface - shortcircuit-apply)) + shortcircuit-apply + shortcircuit-apply-size-1 + shortcircuit-apply-size-2 + shortcircuit-apply-size-3 + shortcircuit-apply-size-4 + shortcircuit-apply-size-5 + shortcircuit-apply-size-6 + shortcircuit-apply-size-7 + shortcircuit-apply-size-8 + primitive-apply + primitive-lexpr-apply + error + link + interrupt-closure + interrupt-dlink + interrupt-procedure + interrupt-continuation + assignment-trap + reference-trap + safe-reference-trap + &+ + &- + &* + &/ + &= + &< + &> + 1+ + -1+ + zero? + positive? + negative? + )) ;; Compiled code temporaries ,@(let loop ((i 0) (index first-temp)) (if (= i 256) diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm index 9284832fa..e83067c69 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.24 1989/12/05 20:39:58 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 4.25 1989/12/11 06:16:46 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -182,7 +182,8 @@ MIT in each case. |# target)) (define (test-non-pointer type datum effective-address) - (if (and (zero? type) (zero? datum) + (if (and (zero? type) + (zero? datum) (effective-address/data&alterable? effective-address)) (INST (TST L ,effective-address)) (INST (CMPI L @@ -750,11 +751,27 @@ MIT in each case. |# (define scheme-type-mask (-1+ (expt 2 scheme-type-width))) -(define (object->type register-reference) +(define use-68020-instructions? true) + +(define (object->type source target) + ;; `Source' must be a data register or non-volatile memory reference. + ;; `Target' must be a data register reference. + ;; Guarantees that the condition codes are set for a zero-compare. (if (= scheme-type-width 8) - (LAP (RO L L (& 8) ,register-reference)) - (LAP (RO L L (& ,scheme-type-width) ,register-reference) - (AND B (& ,scheme-type-mask) ,register-reference)))) + (cond ((equal? source target) + (LAP (RO L L (& ,scheme-type-width) ,target))) + (use-68020-instructions? + (LAP (BFEXTU ,source (& 0) (& ,scheme-type-width) ,target))) + (else + (LAP (MOVE L ,source ,target) + (RO L L (& ,scheme-type-width) ,target)))) + (if use-68020-instructions? + (LAP (BFEXTU ,source (& 0) (& ,scheme-type-width) ,target)) + (LAP ,@(if (equal? source target) + (LAP) + (LAP (MOVE L ,source ,target))) + (RO L L (& ,scheme-type-width) ,target) + (AND B (& ,scheme-type-mask) ,target))))) ;;;; CHAR->ASCII rules @@ -869,6 +886,37 @@ MIT in each case. |# scheme-to-interface-jsr ; Used by rules4, for convenience trampoline-to-interface ; Used by trampolines, for convenience shortcircuit-apply ; Used by rules3, for speed + shortcircuit-apply-size-1 ; Small frames, save time and space + shortcircuit-apply-size-2 + shortcircuit-apply-size-3 + shortcircuit-apply-size-4 + shortcircuit-apply-size-5 + shortcircuit-apply-size-6 + shortcircuit-apply-size-7 + shortcircuit-apply-size-8 + primitive-apply ; Common entries to save space + primitive-lexpr-apply + error + link + interrupt-closure + interrupt-dlink + interrupt-procedure + interrupt-continuation + assignment-trap + reference-trap + safe-reference-trap + &+ + &- + &* + &/ + &= + &< + &> + 1+ + -1+ + zero? + positive? + negative? )) (define-integrable (invoke-interface code) diff --git a/v7/src/compiler/machines/bobcat/rules1.scm b/v7/src/compiler/machines/bobcat/rules1.scm index 7ab505a6f..778cc9e11 100644 --- a/v7/src/compiler/machines/bobcat/rules1.scm +++ b/v7/src/compiler/machines/bobcat/rules1.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.30 1989/12/05 20:52:00 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.31 1989/12/11 06:16:54 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -180,16 +180,28 @@ MIT in each case. |# (QUALIFIER (pseudo-register? target)) (convert-object/constant->register target constant address->fixnum)) +(define-rule statement + (ASSIGN (REGISTER (? target)) (OBJECT->TYPE (REGISTER (? source)))) + (QUALIFIER (pseudo-register? target) (pseudo-register? source)) + ;; See if we can reuse a source alias, because `object->type' can + ;; sometimes do a slightly better job when the source and target are + ;; the same register. + (reuse-pseudo-register-alias! source 'DATA + (lambda (source) + (delete-dead-registers!) + (add-pseudo-register-alias! target source) + (let ((source (register-reference source))) + (object->type source source))) + (lambda () + (let ((source (standard-register-reference source 'DATA false))) + (delete-dead-registers!) + (object->type source (reference-target-alias! target 'DATA)))))) + (define-integrable (convert-object/register->register target source conversion) ;; `conversion' often expands into multiple references to `target'. (let ((target (move-to-alias-register! source 'DATA target))) (conversion target))) -(define-rule statement - (ASSIGN (REGISTER (? target)) (OBJECT->TYPE (REGISTER (? source)))) - (QUALIFIER (pseudo-register? target)) - (convert-object/register->register target source object->type)) - (define-rule statement (ASSIGN (REGISTER (? target)) (OBJECT->DATUM (REGISTER (? source)))) (QUALIFIER (pseudo-register? target)) @@ -487,7 +499,8 @@ MIT in each case. |# ;;;; Fixnum Operations (define-rule statement - (ASSIGN (? target) (FIXNUM-1-ARG (? operator) (REGISTER (? source)) (? overflow?))) + (ASSIGN (? target) + (FIXNUM-1-ARG (? operator) (REGISTER (? source)) (? overflow?))) (QUALIFIER (and (machine-operation-target? target) (pseudo-register? source))) overflow? ; ignored @@ -692,8 +705,8 @@ MIT in each case. |# ;;;; CHAR->ASCII/BYTE-OFFSET (define (load-char-into-register type source target) + (delete-dead-registers!) (let ((target (reference-target-alias! target 'DATA))) - (delete-dead-registers!) (LAP ,(load-non-pointer type 0 target) (MOV B ,source ,target)))) @@ -709,10 +722,9 @@ MIT in each case. |# (ASSIGN (REGISTER (? target)) (CHAR->ASCII (REGISTER (? source)))) (QUALIFIER (pseudo-register? target)) - (let ((source (machine-register-reference source 'DATA))) - (delete-dead-registers!) - (LAP (BFEXTU ,source (& 24) (& 8) - ,(reference-target-alias! target 'DATA))))) + (load-char-into-register 0 + (machine-register-reference source 'DATA) + target)) (define-rule statement (ASSIGN (REGISTER (? target)) diff --git a/v7/src/compiler/machines/bobcat/rules2.scm b/v7/src/compiler/machines/bobcat/rules2.scm index cac365733..00ce44c71 100644 --- a/v7/src/compiler/machines/bobcat/rules2.scm +++ b/v7/src/compiler/machines/bobcat/rules2.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules2.scm,v 4.10 1989/10/26 07:37:56 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules2.scm,v 4.11 1989/12/11 06:16:59 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -109,37 +109,12 @@ MIT in each case. |# 0 (predicate/memory-operand-reference memory)))) -(define-rule predicate - (TYPE-TEST (REGISTER (? register)) (? type)) - (QUALIFIER (pseudo-register? register)) - (set-standard-branches! 'EQ) - (LAP ,(test-byte type (reference-alias-register! register 'DATA)))) - -(define-rule predicate - (TYPE-TEST (OBJECT->TYPE (REGISTER (? register))) (? type)) - (QUALIFIER (pseudo-register? register)) - (set-standard-branches! 'EQ) - (let ((reference (move-to-temporary-register! register 'DATA))) - (LAP ,@(object->type reference) - ,(test-byte type reference)))) - -(define-rule predicate - (TYPE-TEST (OBJECT->TYPE (? memory)) (? type)) - (QUALIFIER (predicate/memory-operand? memory)) - (set-standard-branches! 'EQ) - (if (= scheme-type-width 8) - (LAP ,(test-byte type (predicate/memory-operand-reference memory))) - (let ((temp (reference-temporary-register! 'DATA))) - (LAP (MOV L ,(predicate/memory-operand-reference memory) ,temp) - ,@(object->type temp) - ,(test-byte type temp))))) - (define-rule predicate (UNASSIGNED-TEST (REGISTER (? register))) (set-standard-branches! 'EQ) (LAP ,(test-non-pointer (ucode-type unassigned) 0 - (standard-register-reference register 'DATA true)))) + (standard-register-reference register false true)))) (define-rule predicate (UNASSIGNED-TEST (? memory)) @@ -150,9 +125,54 @@ MIT in each case. |# (predicate/memory-operand-reference memory)))) (define-rule predicate - (OVERFLOW-TEST) - (set-standard-branches! 'VS) - (LAP)) + (TYPE-TEST (REGISTER (? register)) (? type)) + (QUALIFIER (pseudo-register? register)) + (set-standard-branches! 'EQ) + (LAP ,(test-byte type (reference-alias-register! register 'DATA)))) + +(define-rule predicate + (TYPE-TEST (OBJECT->TYPE (REGISTER (? register))) (? type)) + (QUALIFIER (pseudo-register? register)) + (set-standard-branches! 'EQ) + (if (and (zero? type) use-68020-instructions?) + (LAP (BFTST ,(standard-register-reference register 'DATA false) + (& 0) + (& ,scheme-type-width))) + ;; See if we can reuse a source alias, because `object->type' + ;; can sometimes do a slightly better job when the source and + ;; temp are the same register. + (reuse-pseudo-register-alias! register 'DATA + (lambda (source) + (delete-dead-registers!) + (need-register! source) + (let ((source (register-reference source))) + (normal-type-test source source type))) + (lambda () + (let ((source (standard-register-reference register 'DATA false))) + (delete-dead-registers!) + (normal-type-test source + (reference-temporary-register! 'DATA) + type)))))) + +(define-rule predicate + (TYPE-TEST (OBJECT->TYPE (OFFSET (REGISTER (? address)) (? offset))) + (? type)) + (set-standard-branches! 'EQ) + (let ((source (indirect-reference! address offset))) + (cond ((= scheme-type-width 8) + (LAP ,(test-byte type source))) + ((and (zero? type) use-68020-instructions?) + (LAP (BFTST ,source (& 0) (& ,scheme-type-width)))) + (else + (normal-type-test source + (reference-temporary-register! 'DATA) + type))))) + +(define (normal-type-test source target type) + (LAP ,@(object->type source target) + ,@(if (zero? type) + (LAP) + (LAP ,(test-byte type target))))) (define-rule predicate (EQ-TEST (REGISTER (? register-1)) (REGISTER (? register-2))) @@ -228,12 +248,23 @@ MIT in each case. |# ;;;; Fixnum/Flonum Predicates +(define-rule predicate + (OVERFLOW-TEST) + (set-standard-branches! 'VS) + (LAP)) + (define-rule predicate (FIXNUM-PRED-1-ARG (? predicate) (REGISTER (? register))) (QUALIFIER (pseudo-register? register)) (set-standard-branches! (fixnum-predicate->cc predicate)) (test-fixnum (standard-register-reference register 'DATA true))) +(define-rule predicate + (FIXNUM-PRED-1-ARG (? predicate) (OBJECT->FIXNUM (REGISTER (? register)))) + (QUALIFIER (pseudo-register? register)) + (set-standard-branches! (fixnum-predicate->cc predicate)) + (object->fixnum (move-to-temporary-register! register 'DATA))) + (define-rule predicate (FIXNUM-PRED-1-ARG (? predicate) (? memory)) (QUALIFIER (predicate/memory-operand? memory)) diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm index 4450a1834..79d4de2bb 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.21 1989/12/05 21:01:21 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 4.22 1989/12/11 06:17:02 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -53,8 +53,18 @@ MIT in each case. |# (INVOCATION:APPLY (? frame-size) (? continuation)) continuation (LAP ,@(clear-map!) - ,(load-dnl frame-size 2) - (JMP ,entry:compiler-shortcircuit-apply))) + ,@(case frame-size + ((1) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-1))) + ((2) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-2))) + ((3) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-3))) + ((4) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-4))) + ((5) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-5))) + ((6) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-6))) + ((7) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-7))) + ((8) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-8))) + (else + (LAP ,(load-dnl frame-size 2) + (JMP ,entry:compiler-shortcircuit-apply)))))) (define-rule statement (INVOCATION:JUMP (? frame-size) (? continuation) (? label)) @@ -99,7 +109,7 @@ MIT in each case. |# ;; (JMP (@@PCR ,(free-uuo-link-label name frame-size))) ;; and to have at label, but it is longer and slower. (BRA (@PCR ,(free-uuo-link-label name frame-size))))) - + (define-rule statement (INVOCATION:CACHE-REFERENCE (? frame-size) (? continuation) (? extension)) continuation @@ -122,24 +132,23 @@ MIT in each case. |# ,(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-dnl frame-size 1) - ,@(invoke-interface code:compiler-error)) + (JMP ,entry:compiler-error)) (let ((arity (primitive-procedure-arity primitive))) (cond ((not (negative? arity)) (LAP (MOV L (@PCR ,(constant->label primitive)) (D 1)) - ,@(invoke-interface code:compiler-primitive-apply))) + (JMP ,entry:compiler-primitive-apply))) ((= arity -1) (LAP (MOV L (& ,(-1+ frame-size)) ,reg:lexpr-primitive-arity) (MOV L (@PCR ,(constant->label primitive)) (D 1)) - ,@(invoke-interface - code:compiler-primitive-lexpr-apply))) + (JMP ,entry:compiler-primitive-lexpr-apply))) (else ;; Unknown primitive arity. Go through apply. (LAP ,(load-dnl frame-size 2) @@ -157,9 +166,9 @@ MIT in each case. |# frame-size continuation ,(list 'LAP (list 'UNQUOTE-SPLICING '(clear-map!)) - (list 'UNQUOTE-SPLICING - `(INVOKE-INTERFACE ,(symbol-append 'CODE:COMPILER- - name)))))))) + (list 'JMP + (list 'UNQUOTE + (symbol-append 'ENTRY:COMPILER- name)))))))) (define-special-primitive-invocation &+) (define-special-primitive-invocation &-) (define-special-primitive-invocation &*) @@ -342,10 +351,10 @@ 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 code) +(define-integrable (simple-procedure-header code-word label entry) (let ((gc-label (generate-label))) (LAP (LABEL ,gc-label) - ,@(invoke-interface-jsr code) + (JSR ,entry) ,@(make-external-label code-word label) (CMP L ,reg:compiled-memtop (A 5)) (B GE B (@PCR ,gc-label))))) @@ -353,8 +362,7 @@ MIT in each case. |# (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) + (JSR ,entry:compiler-interrupt-dlink) ,@(make-external-label code-word label) (CMP L ,reg:compiled-memtop (A 5)) (B GE B (@PCR ,gc-label))))) @@ -368,18 +376,20 @@ MIT in each case. |# (CONTINUATION-HEADER (? internal-label)) (simple-procedure-header (continuation-code-word internal-label) internal-label - code:compiler-interrupt-continuation)) + entry:compiler-interrupt-continuation)) (define-rule statement (IC-PROCEDURE-HEADER (? internal-label)) (let ((procedure (label->object internal-label))) - (let ((external-label (rtl-procedure/external-label procedure))) - (LAP - (ENTRY-POINT ,external-label) - (EQUATE ,external-label ,internal-label) - ,@(simple-procedure-header expression-code-word - internal-label - code:compiler-interrupt-ic-procedure))))) + (let ((external-label (rtl-procedure/external-label procedure)) + (gc-label (generate-label))) + (LAP (ENTRY-POINT ,external-label) + (EQUATE ,external-label ,internal-label) + (LABEL ,gc-label) + ,@(invoke-interface-jsr code:compiler-interrupt-ic-procedure) + ,@(make-external-label expression-code-word internal-label) + (CMP L ,reg:compiled-memtop (A 5)) + (B GE B (@PCR ,gc-label)))))) (define-rule statement (OPEN-PROCEDURE-HEADER (? internal-label)) @@ -390,7 +400,7 @@ MIT in each case. |# dlink-procedure-header (lambda (code-word label) (simple-procedure-header code-word label - code:compiler-interrupt-procedure))) + entry:compiler-interrupt-procedure))) internal-entry-code-word internal-label)))) @@ -401,7 +411,7 @@ MIT in each case. |# ,internal-label) ,@(simple-procedure-header (make-procedure-code-word min max) internal-label - code:compiler-interrupt-procedure))) + entry:compiler-interrupt-procedure))) ;;;; Closures. These two statements are intertwined: @@ -414,7 +424,7 @@ MIT in each case. |# (let ((gc-label (generate-label)) (external-label (rtl-procedure/external-label procedure))) (LAP (LABEL ,gc-label) - ,@(invoke-interface code:compiler-interrupt-closure) + (JMP ,entry:compiler-interrupt-closure) ,@(make-external-label internal-entry-code-word external-label) (ADD UL (& ,magic-closure-constant) (@A 7)) (LABEL ,internal-label) @@ -469,7 +479,7 @@ MIT in each case. |# (LEA (@PCR ,free-ref-label) (A 0)) (MOV L (A 0) (D 3)) ,(load-dnl n-sections 4) - ,@(invoke-interface-jsr code:compiler-link) + (JSR ,entry:compiler-link) ,@(make-external-label (continuation-code-word false) (generate-label)))) @@ -493,7 +503,7 @@ MIT in each case. |# ,(load-offset free-ref-offset) (MOV L (A 1) (D 3)) ,(load-dnl n-sections 4) - ,@(invoke-interface-jsr code:compiler-link) + (JSR ,entry: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 55de1d8aa..61821e6a6 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.8 1989/11/30 16:06:28 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules4.scm,v 4.9 1989/12/11 06:17:06 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -130,6 +130,7 @@ MIT in each case. |# (PEA (@PCR ,(rtl-procedure/external-label (label->object label)))) ,(memory-set-type type (INST-EA (@A 7))) (MOV L (@A+ 7) (D 4)) + ,(load-constant name (INST-EA (D 3))) ,@(invoke-interface-jsr code)))) (define-rule statement @@ -138,10 +139,9 @@ MIT in each case. |# (let ((clear-map (clear-map!))) (LAP ,@set-extension ,@clear-map - ,@(invoke-interface-jsr - (if safe? - code:compiler-safe-reference-trap - code:compiler-reference-trap)))))) + (JSR ,(if safe? + entry:compiler-safe-reference-trap + entry:compiler-reference-trap)))))) (define-rule statement (INTERPRETER-CALL:CACHE-ASSIGNMENT (? extension) (? value)) @@ -152,7 +152,7 @@ MIT in each case. |# (LAP ,@set-extension ,@set-value ,@clear-map - ,@(invoke-interface-jsr code:compiler-assignment-trap)))))) + (JSR ,entry:compiler-assignment-trap)))))) (define-rule statement (INTERPRETER-CALL:CACHE-ASSIGNMENT (? extension) @@ -166,7 +166,7 @@ MIT in each case. |# ,(memory-set-type type reg:temp) ,@clear-map (MOV L ,reg:temp (D 3)) - ,@(invoke-interface-jsr code:compiler-assignment-trap)))))) + (JSR ,entry:compiler-assignment-trap)))))) (define-rule statement (INTERPRETER-CALL:CACHE-ASSIGNMENT @@ -179,7 +179,7 @@ MIT in each case. |# (PEA (@PCR ,(rtl-procedure/external-label (label->object label)))) ,(memory-set-type type (INST-EA (@A 7))) (MOV L (@A+ 7) (D 3)) - ,@(invoke-interface-jsr code:compiler-assignment-trap)))) + (JSR ,entry:compiler-assignment-trap)))) (define-rule statement (INTERPRETER-CALL:CACHE-UNASSIGNED? (? extension)) -- 2.25.1