From: Guillermo J. Rozas Date: Tue, 25 Feb 1992 16:43:10 +0000 (+0000) Subject: Use assembly language hooks to reduce code size. X-Git-Tag: 20090517-FFI~9660 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=981fb6d65178d3ecd41c733e6b4110c0b12e8dea;p=mit-scheme.git Use assembly language hooks to reduce code size. --- diff --git a/v7/src/compiler/machines/i386/lapgen.scm b/v7/src/compiler/machines/i386/lapgen.scm index a5f3f8853..9e4296366 100644 --- a/v7/src/compiler/machines/i386/lapgen.scm +++ b/v7/src/compiler/machines/i386/lapgen.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.17 1992/02/17 22:34:19 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.18 1992/02/25 16:42:55 jinx Exp $ $MC68020-Header: /scheme/compiler/bobcat/RCS/lapgen.scm,v 4.42 1991/05/28 19:14:26 jinx Exp $ Copyright (c) 1992 Massachusetts Institute of Technology @@ -458,13 +458,17 @@ MIT in each case. |# interrupt-continuation interrupt-closure interrupt-dlink - #| - ;; Not yet available primitive-apply primitive-lexpr-apply assignment-trap reference-trap safe-reference-trap + link + error + primitive-error + short-primitive-apply) + + (define-entries #x-80 &+ &- &* @@ -488,12 +492,7 @@ MIT in each case. |# shortcircuit-apply-size-5 shortcircuit-apply-size-6 shortcircuit-apply-size-7 - shortcircuit-apply-size-8 - link - error - primitive-error - |# - )) + shortcircuit-apply-size-8)) ;; Operation tables diff --git a/v7/src/compiler/machines/i386/rules3.scm b/v7/src/compiler/machines/i386/rules3.scm index 49057e3f0..01423da3c 100644 --- a/v7/src/compiler/machines/i386/rules3.scm +++ b/v7/src/compiler/machines/i386/rules3.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.20 1992/02/19 23:56:32 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.21 1992/02/25 16:42:38 jinx Exp $ $MC68020-Header: /scheme/compiler/bobcat/RCS/rules3.scm,v 4.31 1991/05/28 19:14:55 jinx Exp $ Copyright (c) 1992 Massachusetts Institute of Technology @@ -55,6 +55,9 @@ MIT in each case. |# (LAP ,@(clear-map!) (POP (R ,ecx)) #| + (MOV W (R ,edx) (& ,frame-size)) + ,@(invoke-interface code:compiler-apply) + |# ,@(case frame-size ((1) (invoke-hook entry:compiler-shortcircuit-apply-size-1)) ((2) (invoke-hook entry:compiler-shortcircuit-apply-size-2)) @@ -66,10 +69,7 @@ MIT in each case. |# ((8) (invoke-hook entry:compiler-shortcircuit-apply-size-8)) (else (LAP (MOV W (R ,edx) (& ,frame-size)) - ,@(invoke-hook entry:compiler-shortcircuit-apply)))) - |# - (MOV W (R ,edx) (& ,frame-size)) - ,@(invoke-interface code:compiler-apply))) + ,@(invoke-hook entry:compiler-shortcircuit-apply)))))) (define-rule statement (INVOCATION:JUMP (? frame-size) (? continuation) (? label)) @@ -148,37 +148,58 @@ MIT in each case. |# ,@(clear-map!) (MOV W (R ,ebx) (& ,frame-size)) ,@(invoke-interface code:compiler-lookup-apply)))) - + (define-rule statement (INVOCATION:PRIMITIVE (? frame-size) (? continuation) (? primitive)) continuation ; ignored (let-syntax ((invoke + #| (macro (code entry) entry ; ignored (for now) - `(invoke-interface ,code)))) + `(invoke-interface ,code)) + |# + (macro (code entry) + code ; ignored + `(invoke-hook ,entry)))) + (if (eq? primitive compiled-error-procedure) (LAP ,@(clear-map!) (MOV W (R ,ecx) (& ,frame-size)) ,@(invoke code:compiler-error entry:compiler-error)) - (let ((arity (primitive-procedure-arity primitive)) - (get-code (object->machine-register! primitive ecx))) + (let ((arity (primitive-procedure-arity primitive))) (cond ((not (negative? arity)) - (LAP ,@get-code - ,@(clear-map!) - ,@(invoke code:compiler-primitive-apply - entry:compiler-primitive-apply))) + (with-values (lambda () (get-cached-label)) + (lambda (pc-label pc-reg) + pc-reg ; ignored + (if pc-label + (let ((get-code + (object->machine-register! primitive ecx))) + (LAP ,@get-code + ,@(clear-map!) + ,@(invoke code:compiler-primitive-apply + entry:compiler-primitive-apply))) + (let ((prim-label (constant->label primitive)) + (offset-label (generate-label 'PRIMOFF))) + (LAP ,@(clear-map!) + ,@(invoke-hook/call + entry:compiler-short-primitive-apply) + (LABEL ,offset-label) + (LONG S (- ,prim-label ,offset-label)))))))) ((= arity -1) - (LAP ,@get-code - ,@(clear-map!) - (MOV W ,reg:lexpr-primitive-arity (& ,(-1+ frame-size))) - ,@(invoke code:compiler-primitive-lexpr-apply - entry:compiler-primitive-lexpr-apply))) + (let ((get-code (object->machine-register! primitive ecx))) + (LAP ,@get-code + ,@(clear-map!) + (MOV W ,reg:lexpr-primitive-arity + (& ,(-1+ frame-size))) + ,@(invoke code:compiler-primitive-lexpr-apply + entry:compiler-primitive-lexpr-apply)))) (else ;; Unknown primitive arity. Go through apply. - (LAP ,@get-code - ,@(clear-map!) - (MOV W (R ,edx) (& ,frame-size)) - ,@(invoke-interface code:compiler-apply)))))))) + (let ((get-code (object->machine-register! primitive ecx))) + (LAP ,@get-code + ,@(clear-map!) + (MOV W (R ,edx) (& ,frame-size)) + ,@(invoke-interface code:compiler-apply))))))))) (let-syntax ((define-special-primitive-invocation @@ -205,8 +226,10 @@ MIT in each case. |# (let-syntax ((define-primitive-invocation (macro (name) - ;; For now. - `(define-special-primitive-invocation ,name)))) + #| + `(define-special-primitive-invocation ,name) + |# + `(define-optimized-primitive-invocation ,name)))) (define-primitive-invocation &+) (define-primitive-invocation &-) @@ -568,9 +591,9 @@ MIT in each case. |# (LEA (R ,ebx) (@RO W ,eax (- ,free-ref-label ,pc-label))) (MOV W ,reg:utility-arg-4 (& ,n-sections)) #| - ,@(invoke-hook/call entry:compiler-link) - |# ,@(invoke-interface/call code:compiler-link) + |# + ,@(invoke-hook/call entry:compiler-link) ,@(make-external-label (continuation-code-word false) (generate-label)))))) @@ -588,9 +611,9 @@ MIT in each case. |# (MOV W (@RO W ,edx ,environment-offset) (R ,ecx)) (MOV W ,reg:utility-arg-4 (& ,n-sections)) #| - ,@(invoke-hook/call entry:compiler-link) - |# ,@(invoke-interface/call code:compiler-link) + |# + ,@(invoke-hook/call entry:compiler-link) ,@(make-external-label (continuation-code-word false) (generate-label)))))) diff --git a/v7/src/compiler/machines/i386/rules4.scm b/v7/src/compiler/machines/i386/rules4.scm index f9a0b5356..b20f439cc 100644 --- a/v7/src/compiler/machines/i386/rules4.scm +++ b/v7/src/compiler/machines/i386/rules4.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules4.scm,v 1.4 1992/02/16 02:06:50 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules4.scm,v 1.5 1992/02/25 16:43:10 jinx Exp $ $mc68020-Header: rules4.scm,v 4.12 90/05/03 15:17:38 GMT jinx Exp $ Copyright (c) 1992 Massachusetts Institute of Technology @@ -100,14 +100,14 @@ MIT in each case. |# (LAP ,@set-extension ,@(clear-map!) #| - ,@(invoke-hook/call (if safe? - entry:compiler-safe-reference-trap - entry:compiler-reference-trap)) - |# ,@(invoke-interface/call (if safe? code:compiler-safe-reference-trap - code:compiler-reference-trap))))) + code:compiler-reference-trap)) + |# + ,@(invoke-hook/call (if safe? + entry:compiler-safe-reference-trap + entry:compiler-reference-trap))))) (define-rule statement (INTERPRETER-CALL:CACHE-ASSIGNMENT (? extension) (? value)) @@ -120,9 +120,9 @@ MIT in each case. |# ,@set-value ,@(clear-map!) #| - ,@(invoke-hook/call entry:compiler-assignment-trap) + ,@(invoke-interface/call code:compiler-assignment-trap) |# - ,@(invoke-interface/call code:compiler-assignment-trap)))) + ,@(invoke-hook/call entry:compiler-assignment-trap)))) (define-rule statement (INTERPRETER-CALL:CACHE-UNASSIGNED? (? extension))