From d0e16045f142ca6a1ecc375d5a9bf9feb380d767 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Thu, 13 Feb 1992 19:04:16 +0000 Subject: [PATCH] More changes. --- v7/src/compiler/machines/i386/insmac.scm | 20 +++++--- v7/src/compiler/machines/i386/lapgen.scm | 6 +-- v7/src/compiler/machines/i386/rules1.scm | 17 +++++-- v7/src/compiler/machines/i386/rules2.scm | 4 +- v7/src/compiler/machines/i386/rules3.scm | 64 +++++++++++------------- 5 files changed, 58 insertions(+), 53 deletions(-) diff --git a/v7/src/compiler/machines/i386/insmac.scm b/v7/src/compiler/machines/i386/insmac.scm index a55492196..2219fa409 100644 --- a/v7/src/compiler/machines/i386/insmac.scm +++ b/v7/src/compiler/machines/i386/insmac.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/insmac.scm,v 1.7 1992/02/13 07:47:07 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/insmac.scm,v 1.8 1992/02/13 19:03:31 jinx Exp $ $Vax-Header: insmac.scm,v 1.12 89/05/17 20:29:15 GMT jinx Exp $ Copyright (c) 1992 Massachusetts Institute of Technology @@ -157,13 +157,17 @@ MIT in each case. |# (let ((field (car fields))) (let ((digit-or-reg (cadr field)) (r/m (caddr field))) - (collect-byte `((2 (EA/MODE ,r/m)) - (3 ,digit-or-reg) - (3 (EA/REGISTER ,r/m))) - `(APPEND-SYNTAX! (EA/EXTRA ,r/m) ,tail) - (lambda (code byte-size) - (receiver code - (+ byte-size tail-size)))))))) + (receiver + `(CONS-SYNTAX + ,(integer-syntaxer `(EA/MODE ,r/m) 'UNSIGNED 2) + (CONS-SYNTAX + ,(integer-syntaxer digit-or-reg 'UNSIGNED 3) + (CONS-SYNTAX + ,(integer-syntaxer `(EA/REGISTER ,r/m) 'UNSIGNED 3) + (APPEND-SYNTAX + (EA/EXTRA ,r/m) + ,tail)))) + (+ 8 tail-size)))))) ;; For immediate operands whose size depends on the operand ;; size for the instruction (halfword vs. longword) ((IMMEDIATE) diff --git a/v7/src/compiler/machines/i386/lapgen.scm b/v7/src/compiler/machines/i386/lapgen.scm index f19245ca0..5be3f5887 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.10 1992/02/13 07:46:53 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.11 1992/02/13 19:03: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 @@ -113,7 +113,7 @@ MIT in each case. |# (define (make-external-label code label) (set! *external-labels* (cons label *external-labels*)) - (LAP (DC UW ,code) + (LAP (WORD U ,code) (BLOCK-OFFSET ,label) (LABEL ,label))) @@ -418,7 +418,7 @@ MIT in each case. |# (define-integrable (invoke-interface/call code) (LAP (MOV W (R ,eax) (& ,code)) - (JSR ,entry:compiler-scheme-to-interface/call))) + (CALL ,entry:compiler-scheme-to-interface/call))) (let-syntax ((define-entries (macro (start . names) diff --git a/v7/src/compiler/machines/i386/rules1.scm b/v7/src/compiler/machines/i386/rules1.scm index 4654fe1f1..483c2dbf7 100644 --- a/v7/src/compiler/machines/i386/rules1.scm +++ b/v7/src/compiler/machines/i386/rules1.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules1.scm,v 1.8 1992/02/13 07:46:35 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules1.scm,v 1.9 1992/02/13 19:04:16 jinx Exp $ $MC68020-Header: /scheme/src/compiler/machines/bobcat/RCS/rules1.scm,v 4.36 1991/10/25 06:49:58 cph Exp $ Copyright (c) 1992 Massachusetts Institute of Technology @@ -179,9 +179,16 @@ MIT in each case. |# (define-rule statement (ASSIGN (OFFSET (REGISTER (? a)) (? n)) (REGISTER (? r))) (QUALIFIER (register-value-class=word? r)) - (LAP (MOV W - ,(target-indirect-reference! a n) - ,(source-register-reference r)))) + (let ((source (source-register-reference r))) + (LAP (MOV W + ,(target-indirect-reference! a n) + ,source)))) + +(define-rule statement + (ASSIGN (OFFSET (REGISTER (? a)) (? n)) (CONSTANT (? value))) + (QUALIFIER (non-pointer-object? value)) + (LAP (MOV W ,(target-indirect-reference! a n) + (&U ,(non-pointer->literal value))))) (define-rule statement (ASSIGN (OFFSET (REGISTER (? address)) (? offset)) @@ -204,7 +211,7 @@ MIT in each case. |# (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 4) -1) (REGISTER (? r))) (QUALIFIER (register-value-class=word? r)) - (LAP (PUSH W ,(source-register-reference r)))) + (LAP (PUSH ,(source-register-reference r)))) (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 4) -1) diff --git a/v7/src/compiler/machines/i386/rules2.scm b/v7/src/compiler/machines/i386/rules2.scm index f2f291d2c..d3ca5c3ad 100644 --- a/v7/src/compiler/machines/i386/rules2.scm +++ b/v7/src/compiler/machines/i386/rules2.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules2.scm,v 1.3 1992/02/13 07:48:34 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules2.scm,v 1.4 1992/02/13 19:04:05 jinx Exp $ $MC68020-Header: rules2.scm,v 4.12 90/01/18 22:44:04 GMT cph Exp $ Copyright (c) 1992 Massachusetts Institute of Technology @@ -47,7 +47,7 @@ MIT in each case. |# (define-rule predicate (TYPE-TEST (REGISTER (? register)) (? type)) (set-equal-branches!) - (LAP (CMP B ,(reference-alias-register! register) (&U ,type)))) + (LAP (CMP B ,(reference-alias-register! register 'GENERAL) (&U ,type)))) (define-rule predicate (EQ-TEST (REGISTER (? register-1)) (REGISTER (? register-2))) diff --git a/v7/src/compiler/machines/i386/rules3.scm b/v7/src/compiler/machines/i386/rules3.scm index 5d2d0c0a3..04674379e 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.10 1992/02/13 06:37:24 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.11 1992/02/13 19:03:46 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 @@ -150,39 +150,35 @@ MIT in each case. |# (define-rule statement (INVOCATION:PRIMITIVE (? frame-size) (? continuation) (? primitive)) - #| - (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)) - ,@(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!) - ,@(invoke code:compiler-apply - entry:compiler-primitive-apply))) - ((= 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))) - (else - ;; Unknown primitive arity. Go through apply. - (LAP ,@get-code - ,@(clear-map!) - (MOV W (R ,edx) (& ,frame-size)) - ,@(invoke-interface code:compiler-apply))))))) + (define-integrable (invoke-entry entry) + (LAP (JMP ,entry))) + (let-syntax ((invoke + (macro (code entry) + `(invoke-interface ,code)))) + (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))) + (cond ((not (negative? arity)) + (LAP ,@get-code + ,@(clear-map!) + ,@(invoke code:compiler-apply + entry:compiler-primitive-apply))) + ((= 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))) + (else + ;; Unknown primitive arity. Go through apply. + (LAP ,@get-code + ,@(clear-map!) + (MOV W (R ,edx) (& ,frame-size)) + ,@(invoke-interface code:compiler-apply)))))))) (let-syntax ((define-special-primitive-invocation @@ -596,8 +592,6 @@ MIT in each case. |# ,@(make-external-label (continuation-code-word false) (generate-label)))))) -;;; **** here **** - (define (generate/constants-block constants references assignments uuo-links global-links static-vars) (let ((constant-info -- 2.25.1