From 1c6afe70fcb648c8153d20a1ba1e4214646864ec Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 28 Aug 1989 18:34:25 +0000 Subject: [PATCH] * Add Jinx's changes to support 6 bit type codes. --- v7/src/compiler/base/utils.scm | 11 +- v7/src/compiler/machines/bobcat/assmd.scm | 43 ++++---- v7/src/compiler/machines/bobcat/compiler.sf | 15 ++- v7/src/compiler/machines/bobcat/decls.scm | 30 +++-- v7/src/compiler/machines/bobcat/instr1.scm | 9 +- v7/src/compiler/machines/bobcat/instr2.scm | 16 +-- v7/src/compiler/machines/bobcat/insutl.scm | 43 +++++--- v7/src/compiler/machines/bobcat/lapgen.scm | 104 ++++++++++-------- v7/src/compiler/machines/bobcat/machin.scm | 59 +++++----- .../compiler/machines/bobcat/make.scm-68040 | 4 +- v7/src/compiler/machines/bobcat/rules1.scm | 59 +++++----- v7/src/compiler/machines/bobcat/rules2.scm | 28 +++-- v7/src/compiler/machines/bobcat/rules3.scm | 30 +++-- v7/src/compiler/machines/bobcat/rules4.scm | 13 ++- 14 files changed, 269 insertions(+), 195 deletions(-) diff --git a/v7/src/compiler/base/utils.scm b/v7/src/compiler/base/utils.scm index fdf1004e4..20ff3b2cb 100644 --- a/v7/src/compiler/base/utils.scm +++ b/v7/src/compiler/base/utils.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/utils.scm,v 4.12 1989/05/31 20:01:36 jinx Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/utils.scm,v 4.13 1989/08/28 18:33:09 cph Exp $ Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology @@ -305,4 +305,11 @@ MIT in each case. |# (define (side-effect-free-primitive? operator) (memq operator side-effect-free-primitives)) (define procedure-object? - (lexical-reference system-global-environment 'PROCEDURE?)) \ No newline at end of file + (lexical-reference system-global-environment 'PROCEDURE?)) + +(define (careful-object-datum object) + ;; This works correctly when cross-compiling. + (if (and (object-type? (ucode-type fixnum) object) + (negative? object)) + (+ object unsigned-fixnum/upper-limit) + (object-datum object))) \ No newline at end of file diff --git a/v7/src/compiler/machines/bobcat/assmd.scm b/v7/src/compiler/machines/bobcat/assmd.scm index da16fff8b..19739abad 100644 --- a/v7/src/compiler/machines/bobcat/assmd.scm +++ b/v7/src/compiler/machines/bobcat/assmd.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/assmd.scm,v 1.35 1988/08/31 05:55:31 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/assmd.scm,v 1.36 1989/08/28 18:33:33 cph Rel $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -36,55 +36,50 @@ MIT in each case. |# (declare (usual-integrations)) -(let-syntax ((fold - (macro (expression) - (eval expression system-global-environment)))) - -(define-integrable addressing-granularity 8) -(define-integrable scheme-object-width 32) -(define-integrable endianness 'BIG) +(let-syntax ((ucode-type (macro (name) `',(microcode-type name)))) (define-integrable maximum-padding-length ;; Instruction length is always a multiple of 16 bits 16) -(define-integrable padding-string +(define padding-string ;; Pad with ILLEGAL instructions - (fold (unsigned-integer->bit-string 16 #b0100101011111100))) + (unsigned-integer->bit-string maximum-padding-length #b0100101011111100)) (define-integrable block-offset-width ;; Block offsets are always 16 bit words 16) (define-integrable maximum-block-offset - (fold (- (expt 2 16) 2))) + (- (expt 2 block-offset-width) 2)) -(define-integrable (block-offset->bit-string offset start?) +(define (block-offset->bit-string offset start?) (unsigned-integer->bit-string block-offset-width (+ offset (if start? 0 1)))) -(define-integrable nmv-type-string - (fold (unsigned-integer->bit-string 8 (microcode-type 'MANIFEST-NM-VECTOR)))) - (define (make-nmv-header n) - (bit-string-append (unsigned-integer->bit-string 24 n) nmv-type-string)) + (bit-string-append (unsigned-integer->bit-string scheme-datum-width n) + nmv-type-string)) + +(define nmv-type-string + (unsigned-integer->bit-string scheme-type-width + (ucode-type manifest-nm-vector))) (define (object->bit-string object) (bit-string-append - (unsigned-integer->bit-string 24 (object-datum object)) - (unsigned-integer->bit-string 8 (object-type object)))) + (unsigned-integer->bit-string scheme-datum-width + (careful-object-datum object)) + (unsigned-integer->bit-string scheme-type-width (object-type object)))) ;;; Machine dependent instruction order -(define-integrable (instruction-initial-position block) - (bit-string-length block)) - (define (instruction-insert! bits block position receiver) (let* ((l (bit-string-length bits)) (new-position (- position l))) (bit-substring-move-right! bits 0 l block new-position) (receiver new-position))) -(define-integrable instruction-append - bit-string-append-reversed) +(define instruction-initial-position bit-string-length) +(define-integrable instruction-append bit-string-append-reversed) + ;;; end let-syntax ) \ No newline at end of file diff --git a/v7/src/compiler/machines/bobcat/compiler.sf b/v7/src/compiler/machines/bobcat/compiler.sf index 74d7ac683..c620afec7 100644 --- a/v7/src/compiler/machines/bobcat/compiler.sf +++ b/v7/src/compiler/machines/bobcat/compiler.sf @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/compiler.sf,v 1.10 1989/08/21 19:33:37 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/compiler.sf,v 1.11 1989/08/28 18:33:37 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -36,7 +36,7 @@ MIT in each case. |# ;; Guarantee that the package modeller is loaded. (if (not (name->package '(CROSS-REFERENCE))) - (with-working-directory-pathname "/scheme/cref" (lambda () (load "make")))) + (with-working-directory-pathname "../cref" (lambda () (load "make")))) ;; Guarantee that the compiler's package structure exists. (if (not (name->package '(COMPILER))) @@ -69,7 +69,16 @@ MIT in each case. |# ((access initialize-package! environment))) (sf-and-load '("base/pmlook") '(COMPILER PATTERN-MATCHER/LOOKUP)) (sf-and-load '("base/pmpars") '(COMPILER PATTERN-MATCHER/PARSER)) - (sf-and-load '("machines/bobcat/assmd") '(COMPILER ASSEMBLER)) (sf-and-load '("back/syntax") '(COMPILER LAP-SYNTAXER)) + (fluid-let ((sf/default-syntax-table + (access compiler-syntax-table + (->environment '(COMPILER MACROS))))) + (sf-and-load '("machines/bobcat/machin") '(COMPILER))) + (fluid-let ((sf/default-declarations + '((integrate-external "insseq") + (integrate-external "machin") + (usual-definition (set expt))))) + (sf-and-load '("machines/bobcat/assmd") '(COMPILER ASSEMBLER))) + (sf-and-load '("back/syntax") '(COMPILER LAP-SYNTAXER)) (sf-and-load '("machines/bobcat/coerce" "back/asmmac" "machines/bobcat/insmac") '(COMPILER LAP-SYNTAXER)) diff --git a/v7/src/compiler/machines/bobcat/decls.scm b/v7/src/compiler/machines/bobcat/decls.scm index 8e53c3629..c5f553e49 100644 --- a/v7/src/compiler/machines/bobcat/decls.scm +++ b/v7/src/compiler/machines/bobcat/decls.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/decls.scm,v 4.22 1989/07/25 12:40:16 arthur Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/decls.scm,v 4.23 1989/08/28 18:33:41 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -374,6 +374,16 @@ MIT in each case. |# ;;;; Integration Dependencies (define (initialize/integration-dependencies!) + + (define (add-declaration! declaration filenames) + (for-each (lambda (filenames) + (let ((node (filename->source-node filenames))) + (set-source-node/declarations! + node + (cons declaration + (source-node/declarations node))))) + filenames)) + (let ((front-end-base (filename/append "base" "blocks" "cfg1" "cfg2" "cfg3" @@ -512,14 +522,16 @@ MIT in each case. |# (define-integration-dependencies "rtlopt" "rcserq" "base" "object") (define-integration-dependencies "rtlopt" "rlife" "base" "cfg2") - (file-dependency/integration/join - (append instruction-base - lapgen-base - lapgen-body - assembler-base - assembler-body - (filename/append "back" "linear" "syerly")) - instruction-base) + (let ((dependents + (append instruction-base + lapgen-base + lapgen-body + assembler-base + assembler-body + (filename/append "back" "linear" "syerly")))) + (add-declaration! '(USUAL-DEFINITION (SET EXPT)) dependents) + (file-dependency/integration/join dependents instruction-base)) + (file-dependency/integration/join (append lapgen-base lapgen-body) lapgen-base) diff --git a/v7/src/compiler/machines/bobcat/instr1.scm b/v7/src/compiler/machines/bobcat/instr1.scm index 0652753e6..199017d1f 100644 --- a/v7/src/compiler/machines/bobcat/instr1.scm +++ b/v7/src/compiler/machines/bobcat/instr1.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr1.scm,v 1.66 1988/06/14 08:47:12 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr1.scm,v 1.67 1989/08/28 18:33:49 cph Rel $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -209,10 +209,11 @@ MIT in each case. |# (define-symbol-transformer nwl (N . 1) (W . 2) (L . 3)) (define-symbol-transformer bwlq (B . 0) (W . 1) (L . 2) (Q . 3)) (define-symbol-transformer bwl-b (W . 1) (L . 2)) -(define-symbol-transformer bwl (B . 0) (W . 1) (L . 2)) +(define-symbol-transformer bwl + (B . 0) (W . 1) (L . 2) (UB . 0) (UW . 1) (UL . 2)) (define-symbol-transformer bw (B . 0) (W . 1)) (define-symbol-transformer wl (W . 0) (L . 1)) -(define-symbol-transformer lw (W . 1) (L . 0)) +(define-symbol-transformer lw (W . 1) (L . 0) (UW . 1) (UL . 0)) (define-symbol-transformer rl (R . 0) (L . 1)) (define-symbol-transformer us (U . 0) (S . 1)) (define-symbol-transformer chkwl (W . 6) (L . 4)) diff --git a/v7/src/compiler/machines/bobcat/instr2.scm b/v7/src/compiler/machines/bobcat/instr2.scm index d73f483c9..21eea7273 100644 --- a/v7/src/compiler/machines/bobcat/instr2.scm +++ b/v7/src/compiler/machines/bobcat/instr2.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr2.scm,v 1.16 1988/10/20 16:11:07 markf Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr2.scm,v 1.17 1989/08/28 18:33:52 cph Rel $ -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -269,7 +269,7 @@ MIT in each case. |# (WORD (8 #b00001100) (2 s) (6 ea DESTINATION-EA)) - (immediate-words data ssym)) + (immediate-unsigned-words data ssym)) (((? s bwl) (@A+ (? ry)) (@A+ (? rx))) ;CMPM (WORD (4 #b1011) @@ -286,7 +286,7 @@ MIT in each case. |# (WORD (8 #b00001100) (2 s) (6 ea DESTINATION-EA)) - (immediate-words data ssym))) + (immediate-unsigned-words data ssym))) (define-instruction TST (((? s bwl) (? dea ea-d&a)) @@ -318,14 +318,14 @@ MIT in each case. |# (4 ,Iopcode) (2 s) (6 ea DESTINATION-EA)) - (immediate-words data ssym)) + (immediate-unsigned-words data ssym)) (((? s bwl ssym) (& (? data)) (SR)) ;fooI to CCR/SR (WORD (4 #b0000) (4 ,Iopcode) (2 s) (6 #b111100)) - (immediate-words data ssym)))))) + (immediate-unsigned-words data ssym)))))) (define-bitwise-logical AND #b1100 #b0010) ; and ANDI (define-bitwise-logical OR #b1000 #b0000)) ; and ORI @@ -341,13 +341,13 @@ MIT in each case. |# (WORD (8 #b00001010) (2 s) (6 ea DESTINATION-EA)) - (immediate-words data ssym)) + (immediate-unsigned-words data ssym)) (((? s bw ssym) (& (? data)) (SR)) ;EORI to CCR/SR (WORD (8 #b00001010) (2 s) (6 #b111100)) - (immediate-words data ssym))) + (immediate-unsigned-words data ssym))) (define-instruction NOT (((? s bwl) (? dea ea-d&a)) diff --git a/v7/src/compiler/machines/bobcat/insutl.scm b/v7/src/compiler/machines/bobcat/insutl.scm index 923cecd4c..60ce82293 100644 --- a/v7/src/compiler/machines/bobcat/insutl.scm +++ b/v7/src/compiler/machines/bobcat/insutl.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/insutl.scm,v 1.6 1988/06/14 08:47:30 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/insutl.scm,v 1.7 1989/08/28 18:33:55 cph Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -120,16 +120,13 @@ MIT in each case. |# (define (output-immediate-data immediate-size i) (case immediate-size - ((B) - (EXTENSION-WORD (8 #b00000000) - (8 i SIGNED))) - ((W) - (EXTENSION-WORD (16 i SIGNED))) - ((L) - (EXTENSION-WORD (32 i SIGNED))) - (else - (error "OUTPUT-IMMEDIATE-DATA: illegal immediate size" - immediate-size)))) + ((B) (EXTENSION-WORD (8 #b00000000) (8 i SIGNED))) + ((UB) (EXTENSION-WORD (8 #b00000000) (8 i UNSIGNED))) + ((W) (EXTENSION-WORD (16 i SIGNED))) + ((UW) (EXTENSION-WORD (16 i UNSIGNED))) + ((L) (EXTENSION-WORD (32 i SIGNED))) + ((UL) (EXTENSION-WORD (32 i UNSIGNED))) + (else (error "illegal immediate size" immediate-size)))) ;;; Support for 68020 addressing modes @@ -230,18 +227,38 @@ MIT in each case. |# ((B) (immediate-byte data)) ((W) (immediate-word data)) ((L) (immediate-long data)) - (else (error "IMMEDIATE-WORD: Illegal size" size)))) + ((UB) (immediate-unsigned-byte data)) + ((UW) (immediate-unsigned-word data)) + ((UL) (immediate-unsigned-long data)) + (else (error "Illegal size" size)))) + +(define (immediate-unsigned-words data size) + (case size + ((B UB) (immediate-unsigned-byte data)) + ((W UW) (immediate-unsigned-word data)) + ((L UL) (immediate-unsigned-long data)) + (else (error "Illegal size" size)))) (define-integrable (immediate-byte data) `(GROUP ,(make-bit-string 8 0) ,(syntax-evaluation data coerce-8-bit-signed))) +(define-integrable (immediate-unsigned-byte data) + `(GROUP ,(make-bit-string 8 0) + ,(syntax-evaluation data coerce-8-bit-unsigned))) + (define-integrable (immediate-word data) (syntax-evaluation data coerce-16-bit-signed)) +(define-integrable (immediate-unsigned-word data) + (syntax-evaluation data coerce-16-bit-unsigned)) + (define-integrable (immediate-long data) (syntax-evaluation data coerce-32-bit-signed)) +(define-integrable (immediate-unsigned-long data) + (syntax-evaluation data coerce-32-bit-unsigned)) + (define-integrable (relative-word address) (syntax-evaluation `(- ,address *PC*) coerce-16-bit-signed)) diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm index 9af7dc743..5106e91eb 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.20 1989/07/25 12:40:04 arthur Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 4.21 1989/08/28 18:33:59 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -68,7 +68,7 @@ MIT in each case. |# (offset-reference regnum:regs-pointer (pseudo-register-offset register))) -(define-integrable (machine->machine-register source target) +(define (machine->machine-register source target) (cond ((float-register? source) (if (float-register? target) (INST (FMOVE ,source ,target)) @@ -79,12 +79,12 @@ MIT in each case. |# ,(register-reference source) ,(register-reference target)))))) -(define-integrable (machine-register->memory source target) +(define (machine-register->memory source target) (if (float-register? source) (INST (FMOVE X ,(register-reference source) ,target)) (INST (MOV L ,(register-reference source) ,target)))) -(define-integrable (memory->machine-register source target) +(define (memory->machine-register source target) (if (float-register? target) (INST (FMOVE X ,source ,(register-reference target))) (INST (MOV L ,source ,(register-reference target))))) @@ -136,16 +136,19 @@ MIT in each case. |# (define (load-constant constant target) (if (non-pointer-object? constant) - (load-non-pointer (object-type constant) - (object-datum constant) - target) + (load-non-pointer-constant constant target) (INST (MOV L (@PCR ,(constant->label constant)) ,target)))) +(define (load-non-pointer-constant constant target) + (load-non-pointer (object-type constant) + (careful-object-datum constant) + target)) + (define (load-non-pointer type datum target) (cond ((not (zero? type)) - (INST (MOV L + (INST (MOV UL (& ,(make-non-pointer-literal type datum)) ,target))) ((and (zero? datum) @@ -155,13 +158,20 @@ MIT in each case. |# (effective-address/data-register? target)) (INST (MOVEQ (& ,datum) ,target))) (else - (INST (MOV L (& ,datum) ,target))))) - + (INST (MOV UL (& ,datum) ,target))))) + (define (test-byte n effective-address) + ;; This is used to test actual bytes. + ;; Type codes are "preprocessed" by the pertinent rule. (if (and (zero? n) (effective-address/data&alterable? effective-address)) (INST (TST B ,effective-address)) (INST (CMPI B (& ,n) ,effective-address)))) +(define (test-non-pointer-constant constant target) + (test-non-pointer (object-type constant) + (careful-object-datum constant) + target)) + (define (test-non-pointer type datum effective-address) (if (and (zero? type) (zero? datum) (effective-address/data&alterable? effective-address)) @@ -171,11 +181,11 @@ MIT in each case. |# ,effective-address)))) (define make-non-pointer-literal - (let ((type-scale-factor (expt 2 24))) + (let ((type-scale-factor (expt 2 scheme-datum-width))) (lambda (type datum) - (+ (* (if (negative? datum) (1+ type) type) - type-scale-factor) - datum)))) + (if (negative? datum) + (error "Non-pointer datum must be nonnegative" datum)) + (+ (* type type-scale-factor) datum)))) (define (set-standard-branches! cc) (set-current-branches! @@ -311,14 +321,10 @@ MIT in each case. |# (delete-machine-register! register) result))) -(define (put-type-in-ea type-code ea) - (cond ((effective-address/data-register? ea) - (LAP (AND L ,mask-reference ,ea) - (OR L (& ,(make-non-pointer-literal type-code 0)) ,ea))) - ((effective-address/data&alterable? ea) - (LAP (MOV B (& ,type-code) ,ea))) - (else - (error "PUT-TYPE-IN-EA: Illegal effective-address" ea)))) +(define (memory-set-type type target) + (if (= 8 scheme-type-width) + (INST (MOV B (& ,type) ,target)) + (INST (OR B (& ,(* type-scale-factor type)) ,target)))) (define (standard-target-expression? target) (or (rtl:offset? target) @@ -361,23 +367,24 @@ MIT in each case. |# (if (not (unsigned-fixnum? n)) (error "Not a unsigned fixnum" n)) n) -(define-integrable (load-fixnum-constant constant register-reference) - (LAP (MOV L (& ,(* #x100 constant)) ,register-reference))) +(define fixnum-1 + (expt 2 scheme-type-width)) + +(define (load-fixnum-constant constant register-reference) + (LAP (MOV L (& ,(* constant fixnum-1)) ,register-reference))) -(define-integrable (object->fixnum reg-ref) - (LAP (LS L L (& 8) ,reg-ref))) +(define (object->fixnum reg-ref) + (LAP (LS L L (& ,scheme-type-width) ,reg-ref))) -(define-integrable (address->fixnum reg-ref) - (LAP (LS L L (& 8) ,reg-ref))) +(define (address->fixnum reg-ref) + (LAP (LS L L (& ,scheme-type-width) ,reg-ref))) (define (fixnum->object reg-ref) - (LAP - (MOV B (& ,(ucode-type fixnum)) ,reg-ref) - (RO R L (& 8) ,reg-ref))) + (LAP (OR B (& ,(ucode-type fixnum)) ,reg-ref) + (RO R L (& ,scheme-type-width) ,reg-ref))) -(define-integrable (fixnum->address reg-ref) - (LAP - (LS R L (& 8) ,reg-ref))) +(define (fixnum->address reg-ref) + (LAP (LS R L (& ,scheme-type-width) ,reg-ref))) (define (test-fixnum effective-address) (if (effective-address/data&alterable? effective-address) @@ -459,11 +466,11 @@ MIT in each case. |# (define-fixnum-method 'ONE-PLUS-FIXNUM fixnum-methods/1-arg (lambda (reference) - (LAP (ADD L (& #x100) ,reference)))) + (LAP (ADD L (& ,fixnum-1) ,reference)))) (define-fixnum-method 'MINUS-ONE-PLUS-FIXNUM fixnum-methods/1-arg (lambda (reference) - (LAP (SUB L (& #x100) ,reference)))) + (LAP (SUB L (& ,fixnum-1) ,reference)))) (define-fixnum-method 'PLUS-FIXNUM fixnum-methods/2-args (lambda (target source) @@ -472,7 +479,7 @@ MIT in each case. |# (define-fixnum-method 'PLUS-FIXNUM fixnum-methods/2-args-constant (lambda (target n) (cond ((zero? n) (LAP)) - (else (LAP (ADD L (& ,(* n #x100)) ,target)))))) + (else (LAP (ADD L (& ,(* n fixnum-1)) ,target)))))) (define-fixnum-method 'MULTIPLY-FIXNUM fixnum-methods/2-args (lambda (target source) @@ -484,10 +491,10 @@ MIT in each case. |# ;;; moved into the rules. (LAP (MOV L ,source ,new-source) - (AS R L (& 8) ,target) + (AS R L (& ,scheme-type-width) ,target) (MUL S L ,new-source ,target))) (LAP - (AS R L (& 8) ,target) + (AS R L (& ,scheme-type-width) ,target) (MUL S L ,source ,target))))) (define-fixnum-method 'MULTIPLY-FIXNUM fixnum-methods/2-args-constant @@ -518,7 +525,7 @@ MIT in each case. |# (define-fixnum-method 'MINUS-FIXNUM fixnum-methods/2-args-constant (lambda (target n) (cond ((zero? n) (LAP)) - (else (LAP (SUB L (& ,(* n #x100)) ,target)))))) + (else (LAP (SUB L (& ,(* n fixnum-1)) ,target)))))) ;;;; Flonum Operators @@ -609,20 +616,27 @@ MIT in each case. |# (define (load-constant-datum constant register-ref) (if (non-pointer-object? constant) - (LAP (MOV L (& ,(object-datum constant)) ,register-ref)) + (LAP (MOV L (& ,(careful-object-datum constant)) ,register-ref)) (LAP (MOV L (@PCR ,(constant->label constant)) ,register-ref) ,@(object->address register-ref)))) -(define-integrable (object->address register-reference) +(define (object->address register-reference) (LAP (AND L ,mask-reference ,register-reference))) -(define-integrable (object->datum register-reference) +(define (object->datum register-reference) (LAP (AND L ,mask-reference ,register-reference))) -(define-integrable (object->type register-reference) - (LAP (RO L L (& 8) ,register-reference))) +(define scheme-type-mask + (-1+ (expt 2 scheme-type-width))) + +(define (object->type register-reference) + (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)))) + ;;;; CHAR->ASCII rules (define (coerce->any/byte-reference register) diff --git a/v7/src/compiler/machines/bobcat/machin.scm b/v7/src/compiler/machines/bobcat/machin.scm index 3c459dfd8..455b79c9c 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.15 1989/07/25 12:39:50 arthur Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/machin.scm,v 4.16 1989/08/28 18:34:05 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -38,10 +38,17 @@ MIT in each case. |# ;;; Size of words. Some of the stuff in "assmd.scm" might want to ;;; come here. +(define-integrable endianness 'BIG) (define-integrable addressing-granularity 8) (define-integrable scheme-object-width 32) -(define-integrable scheme-datum-width 24) -(define-integrable scheme-type-width 8) +(define-integrable scheme-type-width 6) ;or 8 + +(define-integrable scheme-datum-width + (- scheme-object-width scheme-type-width)) + +(define-integrable type-scale-factor + (expt 2 (- 8 scheme-type-width))) + (define-integrable flonum-size 2) (define-integrable float-alignment 32) @@ -51,24 +58,24 @@ MIT in each case. |# ;; of address units per character. This will cause problems on a ;; machine that is word addressed, in which case we will have to ;; rethink the character addressing strategy. -(define-integrable address-units-per-object 4) + +(define address-units-per-object + (quotient scheme-object-width addressing-granularity)) + (define-integrable address-units-per-packed-char 1) -(let-syntax ((fold - (macro (expression) - (eval expression system-global-environment)))) - (define-integrable unsigned-fixnum/upper-limit (fold (expt 2 24))) - (define-integrable signed-fixnum/upper-limit (fold (expt 2 23))) - (define-integrable signed-fixnum/lower-limit (fold (- (expt 2 23))))) +(define-integrable signed-fixnum/upper-limit + (expt 2 (-1+ scheme-datum-width))) -(define-integrable (stack->memory-offset offset) - offset) +(define-integrable signed-fixnum/lower-limit + (- signed-fixnum/upper-limit)) -(define ic-block-first-parameter-offset - 2) +(define-integrable unsigned-fixnum/upper-limit + (* 2 signed-fixnum/upper-limit)) -(define closure-block-first-offset - 2) +(define-integrable (stack->memory-offset offset) offset) +(define-integrable ic-block-first-parameter-offset 2) +(define-integrable closure-block-first-offset 2) (define (rtl:machine-register? rtl-register) (case rtl-register @@ -128,16 +135,14 @@ MIT in each case. |# (define-integrable fp5 21) (define-integrable fp6 22) (define-integrable fp7 23) -(define number-of-machine-registers 24) -(define number-of-temporary-registers 50) +(define-integrable number-of-machine-registers 24) +(define-integrable number-of-temporary-registers 50) (define-integrable regnum:dynamic-link a4) (define-integrable regnum:free-pointer a5) (define-integrable regnum:regs-pointer a6) (define-integrable regnum:stack-pointer a7) - -(define-integrable (sort-machine-registers registers) - registers) +(define-integrable (sort-machine-registers registers) registers) (define available-machine-registers (list d0 d1 d2 d3 d4 d5 d6 @@ -148,16 +153,16 @@ MIT in each case. |# (list d7 a4 a5 a6 a7)) (define (float-register? register) - (if (machine-register? register) - (eq? (register-type register) 'FLOAT) - (error "FLOAT-REGISTER? valid only for machine registers" register))) + (if (not (machine-register? register)) + (error "Not a machine-register" register)) + (eq? (register-type register) 'FLOAT)) (define (word-register? register) (if (machine-register? register) - (memq (register-type register) - '(DATA ADDRESS)))) + (memq (register-type register) '(DATA ADDRESS)))) -(define (register-types-compatible? type1 type2) (eq? (eq? type1 'FLOAT) (eq? type2 'FLOAT))) +(define-integrable (register-types-compatible? type1 type2) + (eq? (eq? type1 'FLOAT) (eq? type2 'FLOAT))) (define register-type (let ((types (make-vector number-of-machine-registers))) diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040 index 1867daa99..d0e85541a 100644 --- a/v7/src/compiler/machines/bobcat/make.scm-68040 +++ b/v7/src/compiler/machines/bobcat/make.scm-68040 @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.49 1989/08/21 19:33:43 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.50 1989/08/28 18:34:09 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -41,4 +41,4 @@ MIT in each case. |# ((package/reference (find-package name) 'INITIALIZE-PACKAGE!))) '((COMPILER MACROS) (COMPILER DECLARATIONS))) -(add-system! (make-system "Liar (Motorola MC68020)" 4 49 '())) \ No newline at end of file +(add-system! (make-system "Liar (Motorola MC68020)" 4 50 '())) \ No newline at end of file diff --git a/v7/src/compiler/machines/bobcat/rules1.scm b/v7/src/compiler/machines/bobcat/rules1.scm index 462f0971d..6f3c4699a 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.24 1989/08/13 09:57:21 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.25 1989/08/28 18:34:13 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -141,7 +141,7 @@ MIT in each case. |# (delete-dead-registers!) (let ((target (reference-target-alias! target 'DATA))) (if (non-pointer-object? constant) - (LAP ,(load-non-pointer 0 (object-datum constant) target)) + (LAP ,(load-non-pointer 0 (careful-object-datum constant) target)) (LAP ,(load-constant constant target) ,@(conversion target))))) @@ -230,15 +230,14 @@ MIT in each case. |# (QUALIFIER (and (pseudo-register? target) (machine-register? datum))) (let ((target (reference-target-alias! target 'DATA))) (LAP (MOV L ,(register-reference datum) ,target) - (OR L (& ,(make-non-pointer-literal type 0)) ,target)))) + (OR UL (& ,(make-non-pointer-literal type 0)) ,target)))) (define-rule statement (ASSIGN (REGISTER (? target)) (CONS-POINTER (CONSTANT (? type)) (REGISTER (? datum)))) (QUALIFIER (and (pseudo-register? target) (pseudo-register? datum))) (let ((target (move-to-alias-register! datum 'DATA target))) - (LAP (OR L (& ,(make-non-pointer-literal type 0)) ,target)))) - + (LAP (OR UL (& ,(make-non-pointer-literal type 0)) ,target)))) (define-rule statement (ASSIGN (REGISTER (? target)) (CONS-POINTER (CONSTANT (? type)) (CONSTANT (? datum)))) @@ -255,7 +254,7 @@ MIT in each case. |# (LAP (LEA (@PCR ,(rtl-procedure/external-label (label->object label))) ,temp) (MOV L ,temp ,target) - (OR L (& ,(make-non-pointer-literal type 0)) ,target))))) + (OR UL (& ,(make-non-pointer-literal type 0)) ,target))))) (define-rule statement (ASSIGN (REGISTER (? target)) (OBJECT->FIXNUM (CONSTANT (? constant)))) @@ -320,7 +319,7 @@ MIT in each case. |# (CONS-POINTER (CONSTANT (? type)) (REGISTER (? datum)))) (let ((target (indirect-reference! address offset))) (LAP (MOV L ,(standard-register-reference datum 'DATA) ,target) - (MOV B (& ,type) ,target)))) + ,(memory-set-type type target)))) (define-rule statement (ASSIGN (OFFSET (REGISTER (? address)) (? offset)) @@ -330,7 +329,7 @@ MIT in each case. |# (LAP (LEA (@PCR ,(rtl-procedure/external-label (label->object label))) ,temp) (MOV L ,temp ,target) - (MOV B (& ,type) ,target)))) + ,(memory-set-type type target)))) (define-rule statement (ASSIGN (OFFSET (REGISTER (? a0)) (? n0)) @@ -405,13 +404,13 @@ MIT in each case. |# (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (CONS-POINTER (CONSTANT (? type)) (REGISTER (? datum)))) (LAP (MOV L ,(standard-register-reference datum 'DATA) (@-A 7)) - (MOV B (& ,type) (@A 7)))) + ,(memory-set-type type (INST-EA (@A 7))))) (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (CONS-POINTER (CONSTANT (? type)) (ENTRY:PROCEDURE (? label)))) (LAP (PEA (@PCR ,(rtl-procedure/external-label (label->object label)))) - (MOV B (& ,type) (@A 7)))) + ,(memory-set-type type (INST-EA (@A 7))))) (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (OFFSET (REGISTER (? r)) (? n))) @@ -420,8 +419,7 @@ MIT in each case. |# (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (ENTRY:CONTINUATION (? label))) (LAP (PEA (@PCR ,label)) - (MOV B (& ,(ucode-type compiled-entry)) (@A 7)))) - + ,(memory-set-type (ucode-type compiled-entry) (INST-EA (@A 7))))) (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (FIXNUM->OBJECT (REGISTER (? r)))) @@ -477,15 +475,11 @@ MIT in each case. |# (operate-on-target (reference-target-alias! target 'DATA))) operate-on-target)) -#| - -;;; This code would have been a nice idea except that 10 is not a -;;; valid value as a shift constant. +;;; The maximum value for a shift constant is 8, so these rules can +;;; only be used when the type width is 6 bits or less. -(define (convert-index->fixnum/register target source) - (reuse-and-load-fixnum-target! target source - (lambda (target) - (LAP (LS L L (& 10) ,target))))) +(if (<= scheme-type-width 6) + (begin (define-rule statement (ASSIGN (? target) @@ -503,13 +497,6 @@ MIT in each case. |# (QUALIFIER (and (fixnum-operation-target? target) (pseudo-register? source))) (convert-index->fixnum/register target source)) -(define (convert-index->fixnum/offset target address offset) - (let ((source (indirect-reference! address offset))) - (reuse-and-operate-on-fixnum-target! target - (lambda (target) - (LAP (MOV L ,source ,target) - (LS L L (& 10) ,target)))))) - (define-rule statement (ASSIGN (? target) (FIXNUM-2-ARGS MULTIPLY-FIXNUM @@ -526,7 +513,23 @@ MIT in each case. |# (QUALIFIER (fixnum-operation-target? target)) (convert-index->fixnum/offset target r n)) -|# +;;; end (IF (<= SCHEME-TYPE-WIDTH 6) ...) +)) + +;;; It doesn't hurt for these to be defined when the above rules are +;;; not in use. + +(define (convert-index->fixnum/register target source) + (reuse-and-load-fixnum-target! target source + (lambda (target) + (LAP (LS L L (& ,(+ scheme-type-width 2)) ,target))))) + +(define (convert-index->fixnum/offset target address offset) + (let ((source (indirect-reference! address offset))) + (reuse-and-operate-on-fixnum-target! target + (lambda (target) + (LAP (MOV L ,source ,target) + (LS L L (& ,(+ scheme-type-width 2)) ,target)))))) (define-rule statement (ASSIGN (? target) (FIXNUM-2-ARGS (? operator) diff --git a/v7/src/compiler/machines/bobcat/rules2.scm b/v7/src/compiler/machines/bobcat/rules2.scm index 83d7d4c51..854e80a91 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.8 1989/07/25 12:38:07 arthur Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules2.scm,v 4.9 1989/08/28 18:34:18 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -120,14 +120,19 @@ MIT in each case. |# (QUALIFIER (pseudo-register? register)) (set-standard-branches! 'EQ) (let ((reference (move-to-temporary-register! register 'DATA))) - (LAP (RO L L (& 8) ,reference) + (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) - (LAP ,(test-byte type (predicate/memory-operand-reference memory)))) + (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))) @@ -183,9 +188,9 @@ MIT in each case. |# (if (non-pointer-object? constant) (begin (set-standard-branches! 'EQ) - (LAP ,(test-non-pointer (object-type constant) - (object-datum constant) - (standard-register-reference register 'DATA)))) + (LAP ,(test-non-pointer-constant + constant + (standard-register-reference register 'DATA)))) (compare/register*memory register (INST-EA (@PCR ,(constant->label constant))) 'EQ))) @@ -194,9 +199,7 @@ MIT in each case. |# (if (non-pointer-object? constant) (begin (set-standard-branches! 'EQ) - (LAP ,(test-non-pointer (object-type constant) - (object-datum constant) - memory))) + (LAP ,(test-non-pointer-constant constant memory))) (compare/memory*memory memory (INST-EA (@PCR ,(constant->label constant))) 'EQ))) @@ -277,8 +280,8 @@ MIT in each case. |# (guarantee-signed-fixnum constant) (let ((reference (standard-register-reference register 'DATA))) (if (effective-address/register? reference) - (LAP (CMP L (& ,(* constant #x100)) ,reference)) - (LAP (CMPI L (& ,(* constant #x100)) ,reference))))) + (LAP (CMP L (& ,(* constant fixnum-1)) ,reference)) + (LAP (CMPI L (& ,(* constant fixnum-1)) ,reference))))) (define-rule predicate (FIXNUM-PRED-2-ARGS (? predicate) @@ -302,7 +305,8 @@ MIT in each case. |# (define (fixnum-predicate/memory*constant memory constant cc) (set-standard-branches! cc) (guarantee-signed-fixnum constant) - (LAP (CMPI L (& ,(* constant #x100)) ,memory))) + (LAP (CMPI L (& ,(* constant fixnum-1)) ,memory))) + (define-rule predicate (FIXNUM-PRED-2-ARGS (? predicate) (? memory) diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm index 7fd4c7cce..1974b4b8a 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.16 1989/08/21 19:33:47 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 4.17 1989/08/28 18:34:21 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -38,10 +38,15 @@ MIT in each case. |# ;;;; Invocations +(define-integrable (clear-continuation-type-code) + (if (= scheme-type-width 8) + (INST (CLR B (@A 7))) + (INST (AND L ,mask-reference (@A 7))))) + (define-rule statement (POP-RETURN) (LAP ,@(clear-map!) - (CLR B (@A 7)) + ,(clear-continuation-type-code) (RTS))) (define-rule statement @@ -62,7 +67,7 @@ MIT in each case. |# frame-size continuation ;; It expects the procedure at the top of the stack (LAP ,@(clear-map!) - (CLR B (@A 7)) + ,(clear-continuation-type-code) (RTS))) (define-rule statement @@ -79,7 +84,7 @@ MIT in each case. |# ;; It expects the procedure at the top of the stack (LAP ,@(clear-map!) ,(load-dnw number-pushed 0) - (CLR B (@A 7)) + ,(clear-continuation-type-code) (MOV L (@A+ 7) (A 0)) (JMP ,entry:compiler-lexpr-apply))) @@ -384,7 +389,7 @@ MIT in each case. |# ;;;; Closures. These two statements are intertwined: (define magic-closure-constant - (- (* #x1000000 (ucode-type compiled-entry)) 6)) + (- (make-non-pointer-literal (ucode-type compiled-entry) 0) 6)) (define-rule statement (CLOSURE-HEADER (? internal-label)) @@ -394,7 +399,7 @@ MIT in each case. |# (LAP (LABEL ,gc-label) (JMP ,entry:compiler-interrupt-closure) ,@(make-external-label internal-entry-code-word external-label) - (ADD L (& ,magic-closure-constant) (@A 7)) + (ADD UL (& ,magic-closure-constant) (@A 7)) (LABEL ,internal-label) (CMP L ,reg:compiled-memtop (A 5)) (B GE B (@PCR ,gc-label)))))) @@ -426,12 +431,13 @@ MIT in each case. |# ,(load-non-pointer (ucode-type manifest-closure) (+ 3 size) (INST-EA (@A+ 5))) - (MOVE L (& ,(+ (* (make-procedure-code-word min max) #x10000) 8)) - (@A+ 5)) - (MOVE L (A 5) ,target) - (OR L (& ,(make-non-pointer-literal type 0)) ,target) - (MOVE W (& #x4eb9) (@A+ 5)) ; (JSR (L )) - (MOVE L ,temporary (@A+ 5)) + (MOV UL + (& ,(+ (* (make-procedure-code-word min max) #x10000) 8)) + (@A+ 5)) + (MOV L (A 5) ,target) + (OR UL (& ,(make-non-pointer-literal type 0)) ,target) + (MOV UW (& #x4eb9) (@A+ 5)) ; (JSR (L )) + (MOV L ,temporary (@A+ 5)) (CLR W (@A+ 5)) ,@(increment-machine-register 13 size)))) diff --git a/v7/src/compiler/machines/bobcat/rules4.scm b/v7/src/compiler/machines/bobcat/rules4.scm index 5d2b23e95..604e39db5 100644 --- a/v7/src/compiler/machines/bobcat/rules4.scm +++ b/v7/src/compiler/machines/bobcat/rules4.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules4.scm,v 4.5 1988/12/30 07:05:28 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules4.scm,v 4.6 1989/08/28 18:34:25 cph Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -103,7 +103,7 @@ MIT in each case. |# (let ((clear-map (clear-map!))) (LAP ,@set-environment (MOV L ,datum ,reg:temp) - (MOV B (& ,type) ,reg:temp) + ,(memory-set-type type reg:temp) ,@clear-map (MOV L ,reg:temp (A 2)) ,(load-constant name (INST-EA (A 1))) @@ -128,7 +128,7 @@ MIT in each case. |# (LAP ,@set-environment ,@(clear-map!) (PEA (@PCR ,(rtl-procedure/external-label (label->object label)))) - (MOV B (& ,type) (@A 7)) + ,(memory-set-type type (INST-EA (@A 7))) (MOV L (@A+ 7) (A 2)) ,(load-constant name (INST-EA (A 1))) (JSR ,entry)))) @@ -162,7 +162,7 @@ MIT in each case. |# (let ((datum (standard-register-reference datum false))) (let ((clear-map (clear-map!))) (LAP ,@set-extension (MOV L ,datum ,reg:temp) - (MOV B (& ,type) ,reg:temp) + ,(memory-set-type type reg:temp) ,@clear-map (MOV L ,reg:temp (A 1)) (JSR ,entry:compiler-assignment-trap)))))) @@ -176,7 +176,8 @@ MIT in each case. |# (LAP ,@set-extension ,@(clear-map!) (PEA (@PCR ,(rtl-procedure/external-label (label->object label)))) - (MOV B (& ,type) (@A 7)) (MOV L (@A+ 7) (A 1)) + ,(memory-set-type type (INST-EA (@A 7))) + (MOV L (@A+ 7) (A 1)) (JSR ,entry:compiler-assignment-trap)))) (define-rule statement -- 2.25.1