From 34d01ac9cc10f257e6262731dcedd02e58faa7a3 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 22 Feb 2002 03:42:52 +0000 Subject: [PATCH] Eliminate non-hygienic macros. --- v7/src/compiler/machines/bobcat/instr3.scm | 132 +++++++------- v7/src/compiler/machines/bobcat/instr4.scm | 202 +++++++++++---------- v7/src/compiler/machines/bobcat/lapgen.scm | 100 +++++----- v7/src/compiler/machines/bobcat/machin.scm | 29 +-- v7/src/compiler/machines/bobcat/rules3.scm | 67 +++---- v7/src/compiler/machines/mips/assmd.scm | 10 +- v7/src/compiler/machines/mips/dassm1.scm | 9 +- v7/src/compiler/machines/mips/dassm2.scm | 26 ++- 8 files changed, 311 insertions(+), 264 deletions(-) diff --git a/v7/src/compiler/machines/bobcat/instr3.scm b/v7/src/compiler/machines/bobcat/instr3.scm index db2e73f0f..3e5a904c1 100644 --- a/v7/src/compiler/machines/bobcat/instr3.scm +++ b/v7/src/compiler/machines/bobcat/instr3.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: instr3.scm,v 1.19 2001/12/20 21:45:24 cph Exp $ +$Id: instr3.scm,v 1.20 2002/02/22 03:27:42 cph Exp $ -Copyright (c) 1988, 1990, 1999, 2001 Massachusetts Institute of Technology +Copyright (c) 1988, 1990, 1999, 2001, 2002 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -46,69 +46,71 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (let-syntax ((define-branch-instruction - (lambda (opcode prefix field . fall-through) - `(define-instruction ,opcode - ((,@prefix B (@PCO (? o))) - (WORD ,@field - (8 o SIGNED))) - - ((,@prefix B (@PCR (? l))) - (WORD ,@field - (8 l SHORT-LABEL))) - - ((,@prefix W (@PCO (? o))) - (WORD ,@field - (8 #b00000000)) - (immediate-word o)) - - ((,@prefix W (@PCR (? l))) - (WORD ,@field - (8 #b00000000)) - (relative-word l)) - - ;; 68020 only - - ((,@prefix L (@PCO (? o))) - (WORD ,@field - (8 #b11111111)) - (immediate-long o)) - - ((,@prefix L (@PCR (? l))) - (WORD ,@field - (8 #b11111111)) - (relative-long l)) - - ((,@prefix (@PCO (? o))) - (GROWING-WORD (disp o) - ((0 0) - ,@fall-through) - ((-128 127) - (WORD ,@field - (8 disp SIGNED))) - ((-32768 32767) - (WORD ,@field - (8 #b00000000) - (16 disp SIGNED))) - ((() ()) - (WORD ,@field - (8 #b11111111) - (32 disp SIGNED))))) - - ((,@prefix (@PCR (? l))) - (GROWING-WORD (disp `(- ,l (+ *PC* 2))) - ((0 0) - ,@fall-through) - ((-128 127) - (WORD ,@field - (8 disp SIGNED))) - ((-32768 32767) - (WORD ,@field - (8 #b00000000) - (16 disp SIGNED))) - ((() ()) - (WORD ,@field - (8 #b11111111) - (32 disp SIGNED))))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + ((,@(caddr form) B (@PCO (? o))) + (WORD ,@(cadddr form) + (8 o SIGNED))) + + ((,@(caddr form) B (@PCR (? l))) + (WORD ,@(cadddr form) + (8 l SHORT-LABEL))) + + ((,@(caddr form) W (@PCO (? o))) + (WORD ,@(cadddr form) + (8 #b00000000)) + (immediate-word o)) + + ((,@(caddr form) W (@PCR (? l))) + (WORD ,@(cadddr form) + (8 #b00000000)) + (relative-word l)) + + ;; 68020 only + + ((,@(caddr form) L (@PCO (? o))) + (WORD ,@(cadddr form) + (8 #b11111111)) + (immediate-long o)) + + ((,@(caddr form) L (@PCR (? l))) + (WORD ,@(cadddr form) + (8 #b11111111)) + (relative-long l)) + + ((,@(caddr form) (@PCO (? o))) + (GROWING-WORD (disp o) + ((0 0) + ,@(cddddr form)) + ((-128 127) + (WORD ,@(cadddr form) + (8 disp SIGNED))) + ((-32768 32767) + (WORD ,@(cadddr form) + (8 #b00000000) + (16 disp SIGNED))) + ((() ()) + (WORD ,@(cadddr form) + (8 #b11111111) + (32 disp SIGNED))))) + + ((,@(caddr form) (@PCR (? l))) + (GROWING-WORD (disp `(- ,l (+ *PC* 2))) + ((0 0) + ,@(cddddr form)) + ((-128 127) + (WORD ,@(cadddr form) + (8 disp SIGNED))) + ((-32768 32767) + (WORD ,@(cadddr form) + (8 #b00000000) + (16 disp SIGNED))) + ((() ()) + (WORD ,@(cadddr form) + (8 #b11111111) + (32 disp SIGNED)))))))))) (define-branch-instruction B ((? c cc)) ((4 #b0110) (4 c)) (WORD (16 #b0100111001110001))) diff --git a/v7/src/compiler/machines/bobcat/instr4.scm b/v7/src/compiler/machines/bobcat/instr4.scm index 32e15e1d1..f0c53c3c7 100644 --- a/v7/src/compiler/machines/bobcat/instr4.scm +++ b/v7/src/compiler/machines/bobcat/instr4.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: instr4.scm,v 1.5 2001/12/20 21:45:24 cph Exp $ +$Id: instr4.scm,v 1.6 2002/02/22 03:30:17 cph Exp $ -Copyright (c) 1987, 1999, 2001 Massachusetts Institute of Technology +Copyright (c) 1987, 1999, 2001, 2002 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -29,55 +29,63 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (let-syntax ((define-bitfield-manipulation-1 - (lambda (keyword bits ea-mode) - `(define-instruction ,keyword - (((? ea ,ea-mode) (& (? offset)) (& (? width)) (D (? reg))) - (WORD (4 #b1110) - (4 ,bits) - (2 #b11) - (6 ea DESTINATION-EA)) - (EXTENSION-WORD (1 #b0) - (3 reg) - (1 #b0) - (5 offset) - (1 #b0) - (5 width BFWIDTH))) - - (((? ea ,ea-mode) (& (? offset)) (D (? r-width)) (D (? reg))) - (WORD (4 #b1110) - (4 ,bits) - (2 #b11) - (6 ea DESTINATION-EA)) - (EXTENSION-WORD (1 #b0) - (3 reg) - (1 #b0) - (5 offset) - (3 #b100) - (3 r-width))) - - (((? ea ,ea-mode) (D (? r-offset)) (& (? width)) (D (? reg))) - (WORD (4 #b1110) - (4 ,bits) - (2 #b11) - (6 ea DESTINATION-EA)) - (EXTENSION-WORD (1 #b0) - (3 reg) - (3 #b100) - (3 r-offset) - (1 #b0) - (5 width BFWIDTH))) - - (((? ea ,ea-mode) (D (? r-offset)) (D (? r-width)) (D (? reg))) - (WORD (4 #b1110) - (4 ,bits) - (2 #b11) - (6 ea DESTINATION-EA)) - (EXTENSION-WORD (1 #b0) - (3 reg) - (3 #b100) - (3 r-offset) - (3 #b100) - (3 r-width))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? ea ,(cadddr form)) (& (? offset)) (& (? width)) (D (? reg))) + (WORD (4 #b1110) + (4 ,(caddr form)) + (2 #b11) + (6 ea DESTINATION-EA)) + (EXTENSION-WORD (1 #b0) + (3 reg) + (1 #b0) + (5 offset) + (1 #b0) + (5 width BFWIDTH))) + + (((? ea ,(cadddr form)) (& (? offset)) + (D (? r-width)) + (D (? reg))) + (WORD (4 #b1110) + (4 ,(caddr form)) + (2 #b11) + (6 ea DESTINATION-EA)) + (EXTENSION-WORD (1 #b0) + (3 reg) + (1 #b0) + (5 offset) + (3 #b100) + (3 r-width))) + + (((? ea ,(cadddr form)) (D (? r-offset)) + (& (? width)) + (D (? reg))) + (WORD (4 #b1110) + (4 ,(caddr form)) + (2 #b11) + (6 ea DESTINATION-EA)) + (EXTENSION-WORD (1 #b0) + (3 reg) + (3 #b100) + (3 r-offset) + (1 #b0) + (5 width BFWIDTH))) + + (((? ea ,(cadddr form)) (D (? r-offset)) + (D (? r-width)) + (D (? reg))) + (WORD (4 #b1110) + (4 ,(caddr form)) + (2 #b11) + (6 ea DESTINATION-EA)) + (EXTENSION-WORD (1 #b0) + (3 reg) + (3 #b100) + (3 r-offset) + (3 #b100) + (3 r-width)))))))) (define-bitfield-manipulation-1 BFEXTS #b1011 ea-d/c) (define-bitfield-manipulation-1 BFEXTU #b1001 ea-d/c) @@ -88,51 +96,53 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (let-syntax ((define-bitfield-manipulation-2 - (lambda (keyword bits ea-mode) - `(define-instruction ,keyword - (((? ea ,ea-mode) (& (? offset)) (& (? width))) - (WORD (4 #b1110) - (4 ,bits) - (2 #b11) - (6 ea DESTINATION-EA)) - (EXTENSION-WORD (4 #b0000) - (1 #b0) - (5 offset) - (1 #b0) - (5 width BFWIDTH))) - - (((? ea ,ea-mode) (& (? offset)) (D (? r-width))) - (WORD (4 #b1110) - (4 ,bits) - (2 #b11) - (6 ea DESTINATION-EA)) - (EXTENSION-WORD (4 #b0000) - (1 #b0) - (5 offset) - (3 #b100) - (3 r-width))) - - (((? ea ,ea-mode) (D (? r-offset)) (& (? width))) - (WORD (4 #b1110) - (4 ,bits) - (2 #b11) - (6 ea DESTINATION-EA)) - (EXTENSION-WORD (4 #b0000) - (3 #b100) - (3 r-offset) - (1 #b0) - (5 width BFWIDTH))) - - (((? ea ,ea-mode) (D (? r-offset)) (D (? r-width))) - (WORD (4 #b1110) - (4 ,bits) - (2 #b11) - (6 ea DESTINATION-EA)) - (EXTENSION-WORD (4 #b0000) - (3 #b100) - (3 r-offset) - (3 #b100) - (3 r-width))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? ea ,(cadddr form)) (& (? offset)) (& (? width))) + (WORD (4 #b1110) + (4 ,(caddr form)) + (2 #b11) + (6 ea DESTINATION-EA)) + (EXTENSION-WORD (4 #b0000) + (1 #b0) + (5 offset) + (1 #b0) + (5 width BFWIDTH))) + + (((? ea ,(cadddr form)) (& (? offset)) (D (? r-width))) + (WORD (4 #b1110) + (4 ,(caddr form)) + (2 #b11) + (6 ea DESTINATION-EA)) + (EXTENSION-WORD (4 #b0000) + (1 #b0) + (5 offset) + (3 #b100) + (3 r-width))) + + (((? ea ,(cadddr form)) (D (? r-offset)) (& (? width))) + (WORD (4 #b1110) + (4 ,(caddr form)) + (2 #b11) + (6 ea DESTINATION-EA)) + (EXTENSION-WORD (4 #b0000) + (3 #b100) + (3 r-offset) + (1 #b0) + (5 width BFWIDTH))) + + (((? ea ,(cadddr form)) (D (? r-offset)) (D (? r-width))) + (WORD (4 #b1110) + (4 ,(caddr form)) + (2 #b11) + (6 ea DESTINATION-EA)) + (EXTENSION-WORD (4 #b0000) + (3 #b100) + (3 r-offset) + (3 #b100) + (3 r-width)))))))) (define-bitfield-manipulation-2 BFCHG #b1010 ea-d/c&a) (define-bitfield-manipulation-2 BFCLR #b1100 ea-d/c&a) diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm index fffb5eb0b..d2f5d6605 100644 --- a/v7/src/compiler/machines/bobcat/lapgen.scm +++ b/v7/src/compiler/machines/bobcat/lapgen.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: lapgen.scm,v 4.52 2001/12/20 21:45:24 cph Exp $ +$Id: lapgen.scm,v 4.53 2002/02/22 03:35:12 cph Exp $ -Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology +Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -745,16 +745,20 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (let-syntax ((binary-fixnum - (lambda (name instr identity?) - `(begin - (define-fixnum-method ',name fixnum-methods/2-args - (lambda (target source) - (LAP (,instr L ,',source ,',target)))) - (define-fixnum-method ',name fixnum-methods/2-args-constant - (lambda (target n) - (if (,identity? n) - (LAP) - (LAP (,instr L (& ,',(* n fixnum-1)) ,',target))))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(BEGIN + (DEFINE-FIXNUM-METHOD ',(cadr form) FIXNUM-METHODS/2-ARGS + (LAMBDA (TARGET SOURCE) + (LAP (,(caddr form) L ,',SOURCE ,',TARGET)))) + (DEFINE-FIXNUM-METHOD ',(cadr form) FIXNUM-METHODS/2-ARGS-CONSTANT + (LAMBDA (TARGET N) + (IF (,(cadddr form) N) + (LAP) + (LAP (,(caddr form) L + (& ,',(* N FIXNUM-1)) + ,',TARGET)))))))))) (binary-fixnum PLUS-FIXNUM ADD zero?) (binary-fixnum FIXNUM-OR OR zero?) @@ -981,12 +985,14 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (let-syntax ((define-flonum-operation - (lambda (primitive-name instruction-name) - `(DEFINE-FLONUM-METHOD ',primitive-name FLONUM-METHODS/1-ARG - (LAMBDA (SOURCE TARGET) - (IF (EFFECTIVE-ADDRESS/FLOAT-REGISTER? SOURCE) - (LAP (,instruction-name ,',source ,',target)) - (LAP (,instruction-name D ,',source ,',target)))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-FLONUM-METHOD ',(cadr form) FLONUM-METHODS/1-ARG + (LAMBDA (SOURCE TARGET) + (IF (EFFECTIVE-ADDRESS/FLOAT-REGISTER? SOURCE) + (LAP (,(caddr form) ,',SOURCE ,',TARGET)) + (LAP (,(caddr form) D ,',SOURCE ,',TARGET))))))))) (define-flonum-operation flonum-negate fneg) (define-flonum-operation flonum-abs fabs) (define-flonum-operation flonum-sin fsin) @@ -1009,12 +1015,14 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (let-syntax ((define-flonum-operation - (lambda (primitive-name instruction-name) - `(DEFINE-FLONUM-METHOD ',primitive-name FLONUM-METHODS/2-ARGS - (LAMBDA (TARGET SOURCE) - (IF (EFFECTIVE-ADDRESS/FLOAT-REGISTER? SOURCE) - (LAP (,instruction-name ,',source ,',target)) - (LAP (,instruction-name D ,',source ,',target)))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-FLONUM-METHOD ',(cadr form) FLONUM-METHODS/2-ARGS + (LAMBDA (TARGET SOURCE) + (IF (EFFECTIVE-ADDRESS/FLOAT-REGISTER? SOURCE) + (LAP (,(caddr form) ,',SOURCE ,',TARGET)) + (LAP (,(caddr form) D ,',SOURCE ,',TARGET))))))))) (define-flonum-operation flonum-add fadd) (define-flonum-operation flonum-subtract fsub) (define-flonum-operation flonum-multiply fmul) @@ -1172,16 +1180,18 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (define-integrable reg:stack-guard (INST-EA (@AO 6 #X002C))) (let-syntax ((define-codes - (lambda (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))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(BEGIN + ,@(let loop ((names (cddr form)) (index (cadr form))) + (if (pair? names) + (cons `(DEFINE-INTEGRABLE + ,(symbol-append 'CODE:COMPILER- + (car names)) + ,index) + (loop (cdr names) (+ index 1))) + '()))))))) (define-codes #x012 primitive-apply primitive-lexpr-apply apply error lexpr-apply link @@ -1195,16 +1205,18 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA quotient remainder modulo)) (let-syntax ((define-entries - (lambda (start . names) - (define (loop names index) - (if (null? names) - '() - (cons `(DEFINE-INTEGRABLE - ,(symbol-append 'ENTRY:COMPILER- - (car names)) - (INST-EA (@AO 6 ,index))) - (loop (cdr names) (+ index 8))))) - `(BEGIN ,@(loop names start))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(BEGIN + ,@(let loop ((names (cddr form)) (index (cadr form))) + (if (pair? names) + (cons `(DEFINE-INTEGRABLE + ,(symbol-append 'ENTRY:COMPILER- + (car names)) + (INST-EA (@AO 6 ,index))) + (loop (cdr names) (+ index 8))) + '()))))))) (define-entries #x40 scheme-to-interface ; Main entry point (only one necessary) scheme-to-interface-jsr ; Used by rules3&4, for convenience. diff --git a/v7/src/compiler/machines/bobcat/machin.scm b/v7/src/compiler/machines/bobcat/machin.scm index 492f0f4f9..db17848d9 100644 --- a/v7/src/compiler/machines/bobcat/machin.scm +++ b/v7/src/compiler/machines/bobcat/machin.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: machin.scm,v 4.33 2001/12/20 21:45:24 cph Exp $ +$Id: machin.scm,v 4.34 2002/02/22 03:36:54 cph Exp $ -Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology +Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -170,18 +170,19 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (define-integrable MC68K/closure-format 'MC68040) ; or MC68020 -(let-syntax ((define/format-dependent - (lambda (name) - `(define ,name - (case MC68K/closure-format - ((MC68020) - ,(intern - (string-append "MC68020/" (symbol->string name)))) - ((MC68040) - ,(intern - (string-append "MC68040/" (symbol->string name)))) - (else - (error "Unknown closure format" closure-format))))))) +(let-syntax + ((define/format-dependent + (sc-macro-transformer + (lambda (form environment) + (let ((name (cadr form))) + `(DEFINE ,name + (CASE MC68K/CLOSURE-FORMAT + ((MC68020) + ,(close-syntax (symbol-append 'MC68020/ name) environment)) + ((MC68040) + ,(close-syntax (symbol-append 'MC68040/ name) environment)) + (ELSE + (ERROR "Unknown closure format" CLOSURE-FORMAT))))))))) ;; Given: the number of entry points in a closure, and a particular ;; entry point number, compute the distance from that entry point to diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm index 6ad2ebe15..372bb7c25 100644 --- a/v7/src/compiler/machines/bobcat/rules3.scm +++ b/v7/src/compiler/machines/bobcat/rules3.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: rules3.scm,v 4.42 2001/12/20 21:45:24 cph Exp $ +$Id: rules3.scm,v 4.43 2002/02/22 03:40:24 cph Exp $ -Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology +Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -164,26 +164,30 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (let-syntax ((define-special-primitive-invocation - (lambda (name) - `(define-rule statement - (INVOCATION:SPECIAL-PRIMITIVE - (? frame-size) - (? continuation) - ,(make-primitive-procedure name true)) - frame-size continuation - (special-primitive-invocation - ,(symbol-append 'CODE:COMPILER- name))))) + (sc-macro-transformer + (lambda (form environment) + `(DEFINE-RULE STATEMENT + (INVOCATION:SPECIAL-PRIMITIVE + (? frame-size) + (? continuation) + ,(make-primitive-procedure (cadr form) #t)) + FRAME-SIZE CONTINUATION + (SPECIAL-PRIMITIVE-INVOCATION + ,(close-syntax (symbol-append 'CODE:COMPILER- (cadr form)) + environment)))))) (define-optimized-primitive-invocation - (lambda (name) - `(define-rule statement - (INVOCATION:SPECIAL-PRIMITIVE - (? frame-size) - (? continuation) - ,(make-primitive-procedure name true)) - frame-size continuation - (optimized-primitive-invocation - ,(symbol-append 'ENTRY:COMPILER- name)))))) + (sc-macro-transformer + (lambda (form environment) + `(DEFINE-RULE STATEMENT + (INVOCATION:SPECIAL-PRIMITIVE + (? frame-size) + (? continuation) + ,(make-primitive-procedure (cadr form) #t)) + FRAME-SIZE CONTINUATION + (OPTIMIZED-PRIMITIVE-INVOCATION + ,(close-syntax (symbol-append 'ENTRY:COMPILER- (cadr form)) + environment))))))) (define-optimized-primitive-invocation &+) (define-optimized-primitive-invocation &-) @@ -752,17 +756,18 @@ long-word aligned and there is no need for shuffling. (vector->list entries))))) (let-syntax ((define/format-dependent - (lambda (name1 name2) - `(define ,name1 - (case MC68K/closure-format - ((MC68020) - ,(intern - (string-append "MC68020/" (symbol->string name2)))) - ((MC68040) - ,(intern - (string-append "MC68040/" (symbol->string name2)))) - (else - (error "Unknown closure format" closure-format))))))) + (sc-macro-transformer + (lambda (form environment) + `(DEFINE ,(cadr form) + (CASE MC68K/CLOSURE-FORMAT + ((MC68020) + ,(close-syntax (symbol-append 'MC68020/ (caddr form)) + environment)) + ((MC68040) + ,(close-syntax (symbol-append 'MC68040/ (caddr form)) + environment)) + (ELSE + (ERROR "Unknown closure format:" CLOSURE-FORMAT)))))))) (define/format-dependent generate/closure-header closure-header) (define/format-dependent generate/cons-closure cons-closure) diff --git a/v7/src/compiler/machines/mips/assmd.scm b/v7/src/compiler/machines/mips/assmd.scm index 6ae62d596..5228ea08b 100644 --- a/v7/src/compiler/machines/mips/assmd.scm +++ b/v7/src/compiler/machines/mips/assmd.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: assmd.scm,v 1.4 2001/12/20 21:45:25 cph Exp $ +$Id: assmd.scm,v 1.5 2002/02/22 03:41:32 cph Exp $ -Copyright (c) 1988-1990, 1999, 2001 Massachusetts Institute of Technology +Copyright (c) 1988-1990, 1999, 2001, 2002 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -24,7 +24,11 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (declare (usual-integrations)) -(let-syntax ((ucode-type (lambda (name) `',(microcode-type name)))) +(let-syntax ((ucode-type + (sc-macro-transformer + (lambda (form environment) + environment + (apply microcode-type (cdr form)))))) (define-integrable maximum-padding-length ;; Instruction length is always a multiple of 32 bits diff --git a/v7/src/compiler/machines/mips/dassm1.scm b/v7/src/compiler/machines/mips/dassm1.scm index e704f67be..55f5d0bc2 100644 --- a/v7/src/compiler/machines/mips/dassm1.scm +++ b/v7/src/compiler/machines/mips/dassm1.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: dassm1.scm,v 1.6 2001/12/20 21:45:25 cph Exp $ +$Id: dassm1.scm,v 1.7 2002/02/22 03:42:37 cph Exp $ -Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology +Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -135,7 +135,10 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (cond ((not (< index end)) 'DONE) ((object-type? (let-syntax ((ucode-type - (lambda (name) (microcode-type name)))) + (sc-macro-transformer + (lambda (form environment) + environment + (apply microcode-type (cdr form)))))) (ucode-type linkage-section)) (system-vector-ref block index)) (loop (disassembler/write-linkage-section block diff --git a/v7/src/compiler/machines/mips/dassm2.scm b/v7/src/compiler/machines/mips/dassm2.scm index 058f6c05c..98b51e8b1 100644 --- a/v7/src/compiler/machines/mips/dassm2.scm +++ b/v7/src/compiler/machines/mips/dassm2.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: dassm2.scm,v 1.6 2001/12/20 21:45:25 cph Exp $ +$Id: dassm2.scm,v 1.7 2002/02/22 03:42:52 cph Exp $ -Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology +Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -27,10 +27,15 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (define (disassembler/read-variable-cache block index) (let-syntax ((ucode-type - (lambda (name) (microcode-type name))) + (sc-macro-transformer + (lambda (form environment) + environment + (apply microcode-type (cdr form))))) (ucode-primitive - (lambda (name arity) - (make-primitive-procedure name arity)))) + (sc-macro-transformer + (lambda (form environment) + environment + (apply make-primitive-procedure (cdr form)))))) ((ucode-primitive primitive-object-set-type 2) (ucode-type quad) (system-vector-ref block index)))) @@ -193,10 +198,15 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (with-absolutely-no-interrupts (lambda () (let-syntax ((ucode-type - (lambda (name) (microcode-type name))) + (sc-macro-transformer + (lambda (form environment) + environment + (apply microcode-type (cdr form))))) (ucode-primitive - (lambda (name arity) - (make-primitive-procedure name arity)))) + (sc-macro-transformer + (lambda (form environment) + environment + (apply make-primitive-procedure (cdr form)))))) ((ucode-primitive primitive-object-set-type 2) (ucode-type compiled-entry) ((ucode-primitive make-non-pointer-object 1) -- 2.25.1