#| -*-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
(declare (usual-integrations))
\f
-(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
#| -*-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
(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
#| -*-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
\f
(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))))
(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)
#| -*-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
`(,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