From c55cf10eaeadf28e9515fa6143ed926cf93a22c0 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 22 Feb 2002 04:38:10 +0000 Subject: [PATCH] Eliminate non-hygienic macros. --- v7/src/compiler/machines/spectrum/assmd.scm | 10 ++++-- v7/src/compiler/machines/spectrum/dassm1.scm | 9 ++++-- v7/src/compiler/machines/spectrum/dassm2.scm | 26 ++++++++++----- v7/src/compiler/machines/spectrum/instr1.scm | 33 +++++++++++--------- 4 files changed, 49 insertions(+), 29 deletions(-) diff --git a/v7/src/compiler/machines/spectrum/assmd.scm b/v7/src/compiler/machines/spectrum/assmd.scm index ded9e1219..b1f885d1e 100644 --- a/v7/src/compiler/machines/spectrum/assmd.scm +++ b/v7/src/compiler/machines/spectrum/assmd.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: assmd.scm,v 1.32 2001/12/20 21:45:25 cph Exp $ +$Id: assmd.scm,v 1.33 2002/02/22 04:34:05 cph Exp $ -Copyright (c) 1988, 1989, 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/spectrum/dassm1.scm b/v7/src/compiler/machines/spectrum/dassm1.scm index 40107a40d..494aa2ff6 100644 --- a/v7/src/compiler/machines/spectrum/dassm1.scm +++ b/v7/src/compiler/machines/spectrum/dassm1.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: dassm1.scm,v 4.21 2001/12/20 21:45:25 cph Exp $ +$Id: dassm1.scm,v 4.22 2002/02/22 04:34:49 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/spectrum/dassm2.scm b/v7/src/compiler/machines/spectrum/dassm2.scm index 52d4ed065..96ceb6cef 100644 --- a/v7/src/compiler/machines/spectrum/dassm2.scm +++ b/v7/src/compiler/machines/spectrum/dassm2.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: dassm2.scm,v 4.22 2001/12/20 21:45:25 cph Exp $ +$Id: dassm2.scm,v 4.23 2002/02/22 04:35:48 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)))) @@ -233,10 +238,15 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (unsigned-integer->bit-string 32 address) #*11111100000000000000000000000000))) (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) diff --git a/v7/src/compiler/machines/spectrum/instr1.scm b/v7/src/compiler/machines/spectrum/instr1.scm index 78e7d72db..463e64133 100644 --- a/v7/src/compiler/machines/spectrum/instr1.scm +++ b/v7/src/compiler/machines/spectrum/instr1.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: instr1.scm,v 1.5 2001/12/20 21:45:25 cph Exp $ +$Id: instr1.scm,v 1.6 2002/02/22 04:38:10 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 @@ -264,16 +264,19 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA `(,name ,value)))) (let-syntax ((define-operator - (lambda (name handler) - `(define ,name - (make-operator ',name ,handler))))) - -(define-operator LEFT - (lambda (number) - (bit-string->signed-integer - (bit-substring (signed-integer->bit-string 32 number) 11 32)))) - -(define-operator RIGHT - (lambda (number) - (bit-string->unsigned-integer - (bit-substring (signed-integer->bit-string 32 number) 0 11))))) \ No newline at end of file + (sc-macro-transformer + (lambda (form environment) + `(DEFINE ,(cadr form) + (MAKE-operator ',(cadr form) + ,(close-syntax (caddr form) + environment))))))) + + (define-operator LEFT + (lambda (number) + (bit-string->signed-integer + (bit-substring (signed-integer->bit-string 32 number) 11 32)))) + + (define-operator RIGHT + (lambda (number) + (bit-string->unsigned-integer + (bit-substring (signed-integer->bit-string 32 number) 0 11))))) \ No newline at end of file -- 2.25.1