From: Guillermo J. Rozas Date: Wed, 5 Feb 1992 17:22:24 +0000 (+0000) Subject: More changes. X-Git-Tag: 20090517-FFI~9855 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8797dcc294ad35c3f1796a0c2d59e9114bb63184;p=mit-scheme.git More changes. --- diff --git a/v7/src/compiler/machines/i386/lapgen.scm b/v7/src/compiler/machines/i386/lapgen.scm index fdd58ab2e..d46df9db3 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.3 1992/02/05 14:57:12 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.4 1992/02/05 17:21:48 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 @@ -356,6 +356,117 @@ MIT in each case. |# (else (error "Unknown expression type" (car expression)))))) +;;;; Named registers, codes, and entries + +(define reg:compiled-memtop + #| + (INST-EA (@RO ,regnum:regs-pointer ,(* 4 register-block/memtop-offset))) + |# + (INST-EA (@R ,regnum:regs-pointer))) + +(define reg:environment + (INST-EA (@RO ,regnum:regs-pointer + ,(* 4 register-block/environment-offset)))) + +(define reg:dynamic-link + (INST-EA (@RO ,regnum:regs-pointer + ,(* 4 register-block/dynamic-link-offset)))) + +(define reg:lexpr-primitive-arity + (INST-EA (@RO ,regnum:regs-pointer + ,(* 4 register-block/lexpr-primitive-arity-offset)))) + +(define reg:utility-arg-4 + (INST-EA (@RO ,regnum:regs-pointer + ,(* 4 register-block/utility-arg4-offset)))) + +(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 primitive-error + quotient remainder modulo)) + +(define-integrable (invoke-interface code) + (LAP (MOV W (R ,eax) (& ,code)) + (JMP ,entry:compiler-scheme-to-interface))) + +(define-integrable (invoke-interface/call code) + (LAP (MOV W (R ,eax) (& ,code)) + (JSR ,entry:compiler-scheme-to-interface/call))) + +(let-syntax ((define-entries + (macro (start . names) + (define (loop names index) + (if (null? names) + '() + (cons `(DEFINE-INTEGRABLE + ,(symbol-append 'ENTRY:COMPILER- + (car names)) + (INST-EA (@RO ,regnum:regs-pointer ,index))) + (loop (cdr names) (+ index 4))))) + `(BEGIN ,@(loop names start))))) + (define-entries (* 16 4) + scheme-to-interface ; Main entry point (only one necessary) + scheme-to-interface/call ; Used by rules3&4, for convenience. + trampoline-to-interface ; Used by trampolines, for convenience. + interrupt-procedure + interrupt-continuation + interrupt-closure + interrupt-dlink + #| + ;; Not yet available + primitive-apply + primitive-lexpr-apply + assignment-trap + reference-trap + safe-reference-trap + &+ + &- + &* + &/ + &= + &< + &> + 1+ + -1+ + zero? + positive? + negative? + quotient + remainder + modulo + 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 + link + error + primitive-error + |# + )) + ;;; *** Here *** ;;;; Register-Allocator Interface diff --git a/v7/src/compiler/machines/i386/machin.scm b/v7/src/compiler/machines/i386/machin.scm index 5f027a630..2f0ea0c1f 100644 --- a/v7/src/compiler/machines/i386/machin.scm +++ b/v7/src/compiler/machines/i386/machin.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/machin.scm,v 1.5 1992/02/05 14:57:32 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/machin.scm,v 1.6 1992/02/05 17:22:24 jinx Exp $ $MC68020-Header: /scheme/src/compiler/machines/bobcat/RCS/machin.scm,v 4.26 1991/10/25 06:49:34 cph Exp $ Copyright (c) 1992 Massachusetts Institute of Technology @@ -176,6 +176,7 @@ MIT in each case. |# (define-integrable register-block/environment-offset 3) (define-integrable register-block/dynamic-link-offset 4) ; compiler temp (define-integrable register-block/utility-arg4-offset 9) ; closure free +(define-integrable register-block/lexpr-primitive-arity-offset 7) ;;;; RTL Generator Interface diff --git a/v7/src/compiler/machines/i386/rules3.scm b/v7/src/compiler/machines/i386/rules3.scm index 34b684f58..62a669575 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.6 1992/02/05 14:56:45 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.7 1992/02/05 17:18:36 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 @@ -53,6 +53,7 @@ MIT in each case. |# (INVOCATION:APPLY (? frame-size) (? continuation)) continuation (LAP ,@(clear-map!) + #| ,@(case frame-size ((1) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-1))) ((2) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-2))) @@ -64,7 +65,10 @@ MIT in each case. |# ((8) (LAP (JMP ,entry:compiler-shortcircuit-apply-size-8))) (else (LAP (MOV W (R ,ecx) (& ,frame-size)) - (JMP ,entry:compiler-shortcircuit-apply)))))) + (JMP ,entry:compiler-shortcircuit-apply)))) + |# + (MOV W (R ,ecx) (& ,frame-size)) + ,@(invoke-interface code:compiler-apply))) (define-rule statement (INVOCATION:JUMP (? frame-size) (? continuation) (? label)) @@ -146,22 +150,33 @@ MIT in each case. |# (define-rule statement (INVOCATION:PRIMITIVE (? frame-size) (? continuation) (? primitive)) - continuation + #| + (define-integrable (invoke code entry) + code ; ignored + (LAP (JMP ,entry))) + |# + (define-integrable (invoke code entry) + entry ; ignored + (invoke-interface code)) + + continuation ; ignored (if (eq? primitive compiled-error-procedure) (LAP ,@(clear-map!) (MOV W (R ,ecx) (& ,frame-size)) - (JMP ,entry:compiler-error)) + ,@(invoke code:compiler-error entry:compiler-error)) (let ((arity (primitive-procedure-arity primitive)) (get-code (object->machine-register! primitive ecx))) (cond ((not (negative? arity)) (LAP ,@get-code ,@(clear-map!) - (JMP ,entry:compiler-primitive-apply))) + ,@(invoke code:compiler-apply + entry:compiler-primitive-apply))) ((= arity -1) (LAP ,@get-code ,@(clear-map!) (MOV W ,reg:lexpr-primitive-arity (& ,(-1+ frame-size))) - (JMP ,entry:compiler-primitive-lexpr-apply))) + ,@(invoke code:compiler-primitive-lexpr-apply + entry:compiler-primitive-lexpr-apply))) (else ;; Unknown primitive arity. Go through apply. (LAP ,@get-code @@ -192,28 +207,33 @@ MIT in each case. |# (optimized-primitive-invocation ,(symbol-append 'ENTRY:COMPILER- name)))))) - (define-optimized-primitive-invocation &+) - (define-optimized-primitive-invocation &-) - (define-optimized-primitive-invocation &*) - (define-optimized-primitive-invocation &/) - (define-optimized-primitive-invocation &=) - (define-optimized-primitive-invocation &<) - (define-optimized-primitive-invocation &>) - (define-optimized-primitive-invocation 1+) - (define-optimized-primitive-invocation -1+) - (define-optimized-primitive-invocation zero?) - (define-optimized-primitive-invocation positive?) - (define-optimized-primitive-invocation negative?) - (define-optimized-primitive-invocation quotient) - (define-optimized-primitive-invocation remainder)) + (let-syntax ((define-primitive-invocation + (macro (name) + ;; For now. + `(define-special-primitive-invocation ,name)))) + + (define-primitive-invocation &+) + (define-primitive-invocation &-) + (define-primitive-invocation &*) + (define-primitive-invocation &/) + (define-primitive-invocation &=) + (define-primitive-invocation &<) + (define-primitive-invocation &>) + (define-primitive-invocation 1+) + (define-primitive-invocation -1+) + (define-primitive-invocation zero?) + (define-primitive-invocation positive?) + (define-primitive-invocation negative?) + (define-primitive-invocation quotient) + (define-primitive-invocation remainder))) (define (special-primitive-invocation code) (LAP ,@(clear-map!) ,@(invoke-interface code))) -(define (optimized-primitive-invocation hook) +(define (optimized-primitive-invocation entry) (LAP ,@(clear-map!) - (JMP ,hook))) + (JMP ,entry))) ;;; Invocation Prefixes @@ -541,7 +561,10 @@ MIT in each case. |# (LEA (R ,edx) (@RO ,eax (- ,*block-label* ,pc-label))) (LEA (R ,ebx) (@RO ,eax (- ,free-ref-label ,pc-label))) (MOV W ,reg:utility-arg-4 (& ,n-sections)) + #| (CALL ,entry:compiler-link) + |# + ,@(invoke-interface/call code:compiler-link) ,@(make-external-label (continuation-code-word false) (generate-label)))))) @@ -558,7 +581,10 @@ MIT in each case. |# (MOV W (R ,ecx) ,reg:environment) (MOV W (@RO ,edx ,environment-offset) (R ,ecx)) (MOV W ,reg:utility-arg-4 (& ,n-sections)) + #| (CALL ,entry:compiler-link) + |# + ,@(invoke-interface/call code: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 fa2521dd3..57c528ee2 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.1 1992/02/01 14:44:23 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules4.scm,v 1.2 1992/02/05 17:20:37 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 @@ -99,9 +99,15 @@ MIT in each case. |# (interpreter-call-argument->machine-register! extension edx))) (LAP ,@set-extension ,@(clear-map!) + #| (CALL ,(if safe? entry:compiler-safe-reference-trap - entry:compiler-reference-trap))))) + entry:compiler-reference-trap)) + |# + ,@(invoke-interface/call + (if safe? + code:compiler-safe-reference-trap + code:compiler-reference-trap))))) (define-rule statement (INTERPRETER-CALL:CACHE-ASSIGNMENT (? extension) (? value)) @@ -113,7 +119,10 @@ MIT in each case. |# (LAP ,@set-extension ,@set-value ,@(clear-map!) - (CALL ,entry:compiler-assignment-trap)))) + #| + (CALL ,entry:compiler-assignment-trap) + |# + ,@(invoke-interface/call code:compiler-assignment-trap)))) (define-rule statement (INTERPRETER-CALL:CACHE-UNASSIGNED? (? extension))