#| -*-Scheme-*-
-$Id: dassm2.scm,v 1.11 2001/12/23 17:20:58 cph Exp $
+$Id: dassm2.scm,v 1.12 2002/02/12 00:26:37 cph Exp $
-Copyright (c) 1992-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1992-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
\f
(define (disassembler/read-variable-cache block index)
(let-syntax ((ucode-type
- (non-hygienic-macro-transformer
- (lambda (name) (microcode-type name))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (apply microcode-type (cdr form)))))
(ucode-primitive
- (non-hygienic-macro-transformer
- (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))))
(with-absolutely-no-interrupts
(lambda ()
(let-syntax ((ucode-type
- (non-hygienic-macro-transformer
- (lambda (name) (microcode-type name))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (apply microcode-type (cdr form)))))
(ucode-primitive
- (non-hygienic-macro-transformer
- (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)
#| -*-Scheme-*-
-$Id: dassm3.scm,v 1.9 2001/12/23 17:20:58 cph Exp $
+$Id: dassm3.scm,v 1.10 2002/02/12 00:26:42 cph Exp $
-Copyright (c) 1992, 1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1992, 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
(define decode-fp
(let-syntax
((IN
- (non-hygienic-macro-transformer
- (lambda (body . bindings)
- `(LET ,bindings ,body)))))
+ (rsc-macro-transformer
+ (lambda (form environment)
+ `(,(close-syntax 'LET environment)
+ ,(cddr form)
+ ,(cadr form))))))
(IN
(lambda (opcode-byte)
(let* ((next (next-unsigned-byte))
#| -*-Scheme-*-
-$Id: insmac.scm,v 1.13 2001/12/23 17:20:58 cph Exp $
+$Id: insmac.scm,v 1.14 2002/02/12 00:26:46 cph Exp $
-Copyright (c) 1992, 1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1992, 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
(declare (usual-integrations))
\f
(define-syntax define-trivial-instruction
- (non-hygienic-macro-transformer
- (lambda (mnemonic opcode . extra)
- `(DEFINE-INSTRUCTION ,mnemonic
- (()
- (BYTE (8 ,opcode))
- ,@(map (lambda (extra)
- `(BYTE (8 ,extra)))
- extra))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ (if (syntax-match? '(IDENTIFIER DATUM * DATUM) (cdr form))
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (()
+ (BYTE (8 ,(close-syntax (caddr form) environment)))
+ ,@(map (lambda (extra)
+ `(BYTE (8 ,(close-syntax extra environment))))
+ (cdddr form))))
+ (ill-formed-syntax form)))))
;;;; Effective addressing
'EA-DATABASE)
(define-syntax define-ea-database
- (non-hygienic-macro-transformer
- (lambda rules
+ (sc-macro-transformer
+ (lambda (form environment)
`(DEFINE ,ea-database-name
- ,(compile-database rules
- (lambda (pattern actions)
- (let ((keyword (car pattern))
- (categories (car actions))
- (mode (cadr actions))
- (register (caddr actions))
- (tail (cdddr actions)))
- (declare (integrate keyword value))
- `(MAKE-EFFECTIVE-ADDRESS
- ',keyword
- ',categories
- ,(integer-syntaxer mode 'UNSIGNED 2)
- ,(integer-syntaxer register 'UNSIGNED 3)
- ,(process-tail tail false)))))))))
+ ,(compile-database (cdr form) environment
+ (lambda (pattern actions)
+ (let ((keyword (car pattern))
+ (categories (car actions))
+ (mode (cadr actions))
+ (register (caddr actions))
+ (tail (cdddr actions)))
+ `(MAKE-EFFECTIVE-ADDRESS
+ ',keyword
+ ',categories
+ ,(integer-syntaxer mode 'UNSIGNED 2)
+ ,(integer-syntaxer register 'UNSIGNED 3)
+ ,(process-tail tail #f)))))))))
(define (process-tail tail early?)
(if (null? tail)
;; This one is necessary to distinguish between r/mW mW, etc.
(define-syntax define-ea-transformer
- (non-hygienic-macro-transformer
- (lambda (name #!optional restriction)
- (if (default-object? restriction)
- `(DEFINE (,name EXPRESSION)
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (if (syntax-match? '(IDENTIFIER ? SYMBOL) (cdr form))
+ `(DEFINE (,(cadr form) EXPRESSION)
(LET ((MATCH-RESULT (PATTERN-LOOKUP ,ea-database-name EXPRESSION)))
(AND MATCH-RESULT
- (MATCH-RESULT))))
- `(DEFINE (,name EXPRESSION)
- (LET ((MATCH-RESULT (PATTERN-LOOKUP ,ea-database-name EXPRESSION)))
- (AND MATCH-RESULT
- (LET ((EA (MATCH-RESULT)))
- (AND (MEMQ ',restriction (EA/CATEGORIES EA))
- EA)))))))))
+ ,(if (pair? (cddr form))
+ `(LET ((EA (MATCH-RESULT)))
+ (AND (MEMQ ',(caddr form) (EA/CATEGORIES EA))
+ EA))
+ `(MATCH-RESULT)))))
+ (ill-formed-syntax form)))))
\f
;; *** We can't really handle switching these right now. ***