#| -*-Scheme-*-
-$Id: asmmac.scm,v 1.15 2002/02/14 01:24:24 cph Exp $
+$Id: asmmac.scm,v 1.16 2002/02/14 15:56:53 cph Exp $
Copyright (c) 1988, 1990, 1999, 2001, 2002 Massachusetts Institute of Technology
(declare (usual-integrations))
\f
(define-syntax define-instruction
- (sc-macro-transformer
+ (rsc-macro-transformer
(lambda (form environment)
(if (syntax-match? '(SYMBOL * (DATUM + DATUM)) (cdr form))
- `(ADD-INSTRUCTION!
+ `(,(close-syntax 'ADD-INSTRUCTION! environment)
',(cadr form)
,(compile-database (cddr form) environment
(lambda (pattern actions)
(ill-formed-syntax form)))))
(define (compile-database cases environment procedure)
- `(LIST
+ `(,(close-syntax 'LIST environment)
,@(map (lambda (rule)
(call-with-values (lambda () (parse-rule (car rule) (cdr rule)))
(lambda (pattern variables qualifiers actions)
- `(CONS ',pattern
- ,(rule-result-expression variables
- qualifiers
- (procedure pattern actions)
- environment)))))
+ `(,(close-syntax 'CONS environment)
+ ',pattern
+ ,(rule-result-expression variables
+ qualifiers
+ (procedure pattern actions)
+ environment)))))
cases)))
(define optimize-group-syntax
#| -*-Scheme-*-
-$Id: macros.scm,v 4.27 2002/02/12 00:25:26 cph Exp $
+$Id: macros.scm,v 4.28 2002/02/14 15:57:10 cph Exp $
Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
(ill-formed-syntax form)))
\f
(define-syntax define-rule
- (sc-macro-transformer
+ (rsc-macro-transformer
(lambda (form environment)
(if (syntax-match? '(IDENTIFIER DATUM + DATUM) (cdr form))
(let ((type (cadr form))
(call-with-values (lambda () (parse-rule pattern body))
(lambda (pattern variables qualifiers actions)
`(,(case type
- ((STATEMENT) 'ADD-STATEMENT-RULE!)
- ((PREDICATE) 'ADD-STATEMENT-RULE!)
- ((REWRITING) 'ADD-REWRITING-RULE!)
- (else (close-syntax type environment)))
+ ((STATEMENT PREDICATE)
+ (close-syntax 'ADD-STATEMENT-RULE! environment))
+ ((REWRITING)
+ (close-syntax 'ADD-REWRITING-RULE! environment))
+ (else type))
',pattern
,(rule-result-expression variables
qualifiers
#| -*-Scheme-*-
-$Id: pmpars.scm,v 1.6 2002/02/12 00:29:16 cph Exp $
+$Id: pmpars.scm,v 1.7 2002/02/14 15:57:00 cph Exp $
Copyright (c) 1988, 1999, 2002 Massachusetts Institute of Technology
names))
\f
(define (rule-result-expression variables qualifiers body environment)
- (reverse-syntactic-environments environment
- (lambda (environment)
- (call-with-values
- (lambda () (process-transformations variables environment))
- (lambda (outer-vars inner-vars xforms xqualifiers)
- (let ((r-lambda (close-syntax 'LAMBDA environment))
- (r-let (close-syntax 'LET environment))
- (r-and (close-syntax 'AND environment)))
- `(,r-lambda ,outer-vars
- (,r-let ,(map list inner-vars xforms)
- (,r-and ,@xqualifiers
- ,@qualifiers
- (,r-lambda () ,body))))))))))
+ (call-with-values (lambda () (process-transformations variables environment))
+ (lambda (outer-vars inner-vars xforms xqualifiers)
+ (let ((r-lambda (close-syntax 'LAMBDA environment))
+ (r-let (close-syntax 'LET environment))
+ (r-and (close-syntax 'AND environment)))
+ `(,r-lambda ,outer-vars
+ (,r-let ,(map list inner-vars xforms)
+ (,r-and ,@xqualifiers
+ ,@qualifiers
+ (,r-lambda () ,body))))))))
(define (process-transformations variables environment)
(let ((r-map (close-syntax 'MAP environment))
#| -*-Scheme-*-
-$Id: insmac.scm,v 1.130 2002/02/13 18:45:24 cph Exp $
+$Id: insmac.scm,v 1.131 2002/02/14 15:58:56 cph Exp $
Copyright (c) 1988, 1990, 1999, 2001, 2002 Massachusetts Institute of Technology
'EA-DATABASE)
(define-syntax define-ea-database
- (sc-macro-transformer
+ (rsc-macro-transformer
(lambda (form environment)
- `(DEFINE ,ea-database-name
- ,(compile-database (cdr form) environment
+ `(,(close-syntax 'DEFINE environment)
+ ,ea-database-name
+ ,(compile-database (cdr form) environment
(lambda (pattern actions)
(if (null? (cddr actions))
(make-position-dependent pattern actions environment)
(mode (cadr actions))
(register (caddr actions))
(extension (cdddr actions)))
- `(MAKE-EFFECTIVE-ADDRESS
+ `(,(close-syntax 'MAKE-EFFECTIVE-ADDRESS environment)
',keyword
- ,(integer-syntaxer (close-syntax mode environment) 'UNSIGNED 3)
- ,(integer-syntaxer (close-syntax register environment) 'UNSIGNED 3)
- (LAMBDA (IMMEDIATE-SIZE INSTRUCTION-TAIL)
- IMMEDIATE-SIZE ;ignore if not referenced
- ,(if (pair? extension)
- `(CONS-SYNTAX ,(close-syntax (car extension) environment)
- INSTRUCTION-TAIL)
- 'INSTRUCTION-TAIL))
+ ,(integer-syntaxer mode 'UNSIGNED 3)
+ ,(integer-syntaxer register 'UNSIGNED 3)
+ (,(close-syntax 'LAMBDA environment)
+ (IMMEDIATE-SIZE INSTRUCTION-TAIL)
+ IMMEDIATE-SIZE ;ignore if not referenced
+ ,(if (pair? extension)
+ `(,(close-syntax 'CONS-SYNTAX environment)
+ ,(car extension)
+ INSTRUCTION-TAIL)
+ `INSTRUCTION-TAIL))
',categories)))
(define (make-position-dependent pattern actions environment)
(mode (cadr code))
(register (caddr code))
(extension (cadddr code)))
- `(LET ((,name (GENERATE-LABEL 'MARK)))
- (make-effective-address
- ',keyword
- ,(process-ea-field mode environment)
- ,(process-ea-field register environment)
- (LAMBDA (IMMEDIATE-SIZE INSTRUCTION-TAIL)
- IMMEDIATE-SIZE ;ignore if not referenced
- ,(if (pair? extension)
- `(CONS (LIST 'LABEL ,(close-syntax name environment))
- (CONS-SYNTAX ,(close-syntax extension environment)
- INSTRUCTION-TAIL))
- `INSTRUCTION-TAIL))
- ',categories)))))
+ `(,(close-syntax 'LET environment)
+ ((,name (,(close-syntax 'GENERATE-LABEL environment) 'MARK)))
+ (,(close-syntax 'MAKE-EFFECTIVE-ADDRESS environment)
+ ',keyword
+ ,(process-ea-field mode environment)
+ ,(process-ea-field register environment)
+ (,(close-syntax 'LAMBDA environment)
+ (IMMEDIATE-SIZE INSTRUCTION-TAIL)
+ IMMEDIATE-SIZE ;ignore if not referenced
+ ,(if (pair? extension)
+ `(,(close-syntax 'CONS environment)
+ (,(close-syntax 'LIST environment) 'LABEL ,name)
+ (,(close-syntax 'CONS-SYNTAX environment)
+ ,extension
+ INSTRUCTION-TAIL))
+ `INSTRUCTION-TAIL))
+ ',categories)))))
(define (process-ea-field field environment)
(if (exact-integer? field)
(clauses (cddr field)))
(variable-width-expression-syntaxer
(car binding)
- (close-syntax (cadr binding) environment)
+ (cadr binding)
(map (lambda (clause)
- `((LIST
- ,(integer-syntaxer (close-syntax (cadr clause) environment)
- 'UNSIGNED 3))
+ `((,(close-syntax 'LIST environment)
+ ,(integer-syntaxer (cadr clause) 'UNSIGNED 3))
3
,@(car clause)))
clauses)))))
#| -*-Scheme-*-
-$Id: insmac.scm,v 1.15 2002/02/13 18:46:04 cph Exp $
+$Id: insmac.scm,v 1.16 2002/02/14 15:58:08 cph Exp $
Copyright (c) 1992, 1999, 2001, 2002 Massachusetts Institute of Technology
'EA-DATABASE)
(define-syntax define-ea-database
- (sc-macro-transformer
+ (rsc-macro-transformer
(lambda (form environment)
- `(DEFINE ,ea-database-name
- ,(compile-database (cdr form) environment
- (lambda (pattern actions)
- (let ((keyword (car pattern))
- (categories (car actions))
- (mode (close-syntax (cadr actions) environment))
- (register (close-syntax (caddr actions) environment))
- (tail (cdddr actions)))
- `(MAKE-EFFECTIVE-ADDRESS
- ',keyword
- ',categories
- ,(integer-syntaxer mode 'UNSIGNED 2)
- ,(integer-syntaxer register 'UNSIGNED 3)
- ,(process-tail tail #f environment)))))))))
-
-(define (process-tail tail early? environment)
- (if (null? tail)
- `()
- (process-fields tail early? environment)))
+ `(,(close-syntax 'DEFINE environment)
+ ,ea-database-name
+ ,(compile-database (cdr form) environment
+ (lambda (pattern actions)
+ (let ((keyword (car pattern))
+ (categories (car actions))
+ (mode (cadr actions))
+ (register (caddr actions))
+ (tail (cdddr actions)))
+ `(,(close-syntax 'MAKE-EFFECTIVE-ADDRESS environment)
+ ',keyword
+ ',categories
+ ,(integer-syntaxer mode 'UNSIGNED 2)
+ ,(integer-syntaxer register 'UNSIGNED 3)
+ ,(if (null? tail)
+ `()
+ (process-fields tail #f environment))))))))))
;; This one is necessary to distinguish between r/mW mW, etc.
(call-with-values (lambda () (expand-fields fields early? environment))
(lambda (code size)
(if (not (zero? (remainder size 8)))
- (error "process-fields: bad syllable size" size))
+ (error "Bad syllable size:" size))
code))))
(define (expand-variable-width field early? environment)
(let ((binding (cadr field))
(clauses (cddr field)))
- `(LIST
+ `(,(close-syntax 'LIST environment)
,(variable-width-expression-syntaxer
- (car binding) ; name
- (close-syntax (cadr binding) environment) ; expression
+ (car binding)
+ (cadr binding)
(map (lambda (clause)
(call-with-values
(lambda () (expand-fields (cdr clause) early? environment))
;; (BYTE (8 #xff))
;; (BYTE (16 (+ foo #x23) SIGNED))
(call-with-values
- (lambda () (collect-byte (cdar fields) tail environment))
+ (lambda ()
+ (collect-byte (cdar fields) tail environment))
(lambda (code size)
(values code (+ size tail-size)))))
((ModR/M)
;; (ModR/M 2 source) = /2 r/m(source)
;; (ModR/M r target) = /r r/m(target)
(if early?
- (error "No early support for ModR/M -- Fix i386/insmac.scm")
- (let ((field (car fields)))
- (let ((digit-or-reg (close-syntax (cadr field) environment))
- (r/m (close-syntax (caddr field) environment)))
- (values
- `(CONS-SYNTAX
- (EA/REGISTER ,r/m)
- (CONS-SYNTAX
- ,(integer-syntaxer digit-or-reg 'UNSIGNED 3)
- (CONS-SYNTAX
- (EA/MODE ,r/m)
- (APPEND-SYNTAX! (EA/EXTRA ,r/m)
- ,tail))))
- (+ 8 tail-size))))))
+ (error "No early support for ModR/M -- Fix i386/insmac.scm"))
+ (let ((field (car fields)))
+ (let ((digit-or-reg (cadr field))
+ (r/m (caddr field)))
+ (values `(,(close-syntax 'CONS-SYNTAX environment)
+ (,(close-syntax 'EA/REGISTER environment) ,r/m)
+ (,(close-syntax 'CONS-SYNTAX environment)
+ ,(integer-syntaxer digit-or-reg 'UNSIGNED 3)
+ (,(close-syntax 'CONS-SYNTAX environment)
+ (,(close-syntax 'EA/MODE environment) ,r/m)
+ (,(close-syntax 'APPEND-SYNTAX! environment)
+ (,(close-syntax 'EA/EXTRA environment) ,r/m)
+ ,tail))))
+ (+ 8 tail-size)))))
;; For immediate operands whose size depends on the operand
;; size for the instruction (halfword vs. longword)
((IMMEDIATE)
(values
(let ((field (car fields)))
- (let ((value (close-syntax (cadr field) environment))
+ (let ((value (cadr field))
(mode (if (pair? (cddr field)) (caddr field) 'OPERAND))
(domain
- (if (and (pair? (cddr field))
- (pair? (cdddr field)))
+ (if (and (pair? (cddr field)) (pair? (cdddr field)))
(cadddr field)
'SIGNED)))
- `(CONS-SYNTAX
+ `(,(close-syntax 'CONS-SYNTAX environment)
,(integer-syntaxer
value
domain
tail-size))
(else
(error "Unknown field kind:" (caar fields))))))
- (values ''() 0)))
+ (values `'() 0)))
(define (collect-byte components tail environment)
(let loop ((components components))
(call-with-values (lambda () (loop (cdr components)))
(lambda (byte-tail byte-size)
(let ((size (caar components))
- (expression (close-syntax (cadar components) environment))
+ (expression (cadar components))
(type (if (pair? (cddar components))
(caddar components)
'UNSIGNED)))
- (values `(CONS-SYNTAX ,(integer-syntaxer expression type size)
- ,byte-tail)
+ (values `(,(close-syntax 'CONS-SYNTAX environment)
+ ,(integer-syntaxer expression type size)
+ ,byte-tail)
(+ size byte-size)))))
(values tail 0))))
\ No newline at end of file
projects / mit-scheme.git / commitdiff