#| -*-Scheme-*-
-$Id: asmmac.scm,v 1.16 2002/02/14 15:56:53 cph Exp $
+$Id: asmmac.scm,v 1.17 2002/02/14 22:03:32 cph Exp $
Copyright (c) 1988, 1990, 1999, 2001, 2002 Massachusetts Institute of Technology
environment)))))
cases)))
-(define optimize-group-syntax
- (let ()
- (define (find-constant components)
- (cond ((null? components)
- '())
- ((car-constant? components)
- (compact (car-constant-value components)
- (cdr components)))
- (else
- (cons (car components)
- (find-constant (cdr components))))))
+(define (optimize-group-syntax components early? environment)
+ (define (find-constant components)
+ (cond ((null? components)
+ '())
+ ((car-constant? components)
+ (compact (car-constant-value components)
+ (cdr components)))
+ (else
+ (cons (car components)
+ (find-constant (cdr components))))))
- (define (compact bit-string components)
- (cond ((null? components)
- (cons (make-constant bit-string) '()))
- ((car-constant? components)
- (compact (instruction-append bit-string
- (car-constant-value components))
- (cdr components)))
- (else
- (cons (make-constant bit-string)
- (cons (car components)
- (find-constant (cdr components)))))))
+ (define (compact bit-string components)
+ (cond ((null? components)
+ (cons (make-constant bit-string) '()))
+ ((car-constant? components)
+ (compact (instruction-append bit-string
+ (car-constant-value components))
+ (cdr components)))
+ (else
+ (cons (make-constant bit-string)
+ (cons (car components)
+ (find-constant (cdr components)))))))
- (define-integrable (car-constant? expression)
- (and (eq? (caar expression) 'QUOTE)
- (bit-string? (cadar expression))))
+ (define (car-constant? components)
+ (and (identifier=? environment (caar components)
+ system-global-environment 'QUOTE)
+ (bit-string? (cadar components))))
- (define-integrable (car-constant-value constant)
- (cadar constant))
+ (define-integrable (car-constant-value constant)
+ (cadar constant))
- (define-integrable (make-constant bit-string)
- `',bit-string)
+ (define-integrable (make-constant bit-string)
+ `',bit-string)
- (lambda (components early?)
- (let ((components (find-constant components)))
- (cond ((null? components)
- (error "OPTIMIZE-GROUP-SYNTAX: No components in group!"))
- ((null? (cdr components))
- (car components))
- (else
- `(,(if early?
- 'OPTIMIZE-GROUP-EARLY
- 'OPTIMIZE-GROUP)
- ,@components)))))))
\ No newline at end of file
+ (let ((components (find-constant components)))
+ (if (not (pair? components))
+ (error "No components in group!"))
+ (if (pair? (cdr components))
+ `(,(close-syntax (if early?
+ 'OPTIMIZE-GROUP-EARLY
+ 'OPTIMIZE-GROUP)
+ environment)
+ ,@components)
+ (car components))))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: syntax.scm,v 1.28 2001/12/20 18:47:01 cph Exp $
+$Id: syntax.scm,v 1.29 2002/02/14 22:03:32 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
(define instructions
'())
\f
-(define (integer-syntaxer expression coercion-type size)
+(define (integer-syntaxer expression environment coercion-type size)
(let ((name (make-coercion-name coercion-type size)))
(if (exact-integer? expression)
`',((lookup-coercion name) expression)
- `(SYNTAX-EVALUATION ,expression ,name))))
+ `(,(close-syntax 'SYNTAX-EVALUATION environment) ,expression ,name))))
(define (syntax-evaluation expression coercion)
(if (exact-integer? expression)
\f
;;;; Variable width expression processing
-(define (choose-clause value clauses)
- (if (null? clauses)
- (error "CHOOSE-CLAUSE: value out of range" value))
- (if (let ((low (caddr (car clauses)))
- (high (cadddr (car clauses))))
- (and (or (null? low)
- (<= low value))
- (or (null? high)
- (<= value high))))
- (car clauses)
- (choose-clause value (cdr clauses))))
-
-(define (variable-width-expression-syntaxer name expression clauses)
+(define (variable-width-expression-syntaxer name expression environment
+ clauses)
(if (exact-integer? expression)
(let ((chosen (choose-clause expression clauses)))
- `(LET ((,name ,expression))
- (DECLARE (INTEGRATE ,name))
- ,name ;ignore if not referenced
- (CAR ,(car chosen))))
- `(SYNTAX-VARIABLE-WIDTH-EXPRESSION
+ `(,(close-syntax 'LET environment)
+ ((,name ,expression))
+ (,(close-syntax 'DECLARE environment) (INTEGRATE ,name))
+ ,name ;ignore if not referenced
+ (,(close-syntax 'CAR environment) ,(car chosen))))
+ `(,(close-syntax 'SYNTAX-VARIABLE-WIDTH-EXPRESSION environment)
,expression
- (LIST
- ,@(map (LAMBDA (clause)
- `(CONS (LAMBDA (,name)
- ,name ;ignore if not referenced
- ,(car clause))
- ',(cdr clause)))
+ (,(close-syntax 'LIST environment)
+ ,@(map (lambda (clause)
+ `(,(close-syntax 'CONS environment)
+ (,(close-syntax 'LAMBDA environment)
+ (,name)
+ ,name ;ignore if not referenced
+ ,(car clause))
+ ',(cdr clause)))
clauses)))))
(define (syntax-variable-width-expression expression clauses)
`(VARIABLE-WIDTH-EXPRESSION
,expression
,@clauses)))
+
+(define (choose-clause value clauses)
+ (if (not (pair? clauses))
+ (error "Value out of range:" value))
+ (if (let ((low (caddr (car clauses)))
+ (high (cadddr (car clauses))))
+ (and (or (null? low)
+ (<= low value))
+ (or (null? high)
+ (<= value high))))
+ (car clauses)
+ (choose-clause value (cdr clauses))))
\f
;;;; Coercion Machinery
#| -*-Scheme-*-
-$Id: insmac.scm,v 1.5 2002/02/13 05:56:24 cph Exp $
+$Id: insmac.scm,v 1.6 2002/02/14 22:03:32 cph Exp $
Copyright (c) 1992-1999, 2001, 2002 Massachusetts Institute of Technology
#F))))))
(define-syntax define-transformer
- (sc-macro-transformer
+ (rsc-macro-transformer
(lambda (form environment)
- `(DEFINE ,(cadr form) ,(close-syntax (caddr form) environment)))))
+ `(,(close-syntax 'DEFINE environment) ,@(cdr form)))))
;;;; Fixed width instruction parsing
-(define (parse-instruction first-word tail early?)
+(define (parse-instruction first-word tail early? environment)
(if (not (null? tail))
- (error "parse-instruction: Unknown format" (cons first-word tail)))
+ (error "Unknown format:" (cons first-word tail)))
(let loop ((first-word first-word))
(case (car first-word)
((LONG)
- (process-fields (cdr first-word) early?))
+ (process-fields (cdr first-word) early? environment))
((VARIABLE-WIDTH)
- (process-variable-width first-word early?))
+ (process-variable-width first-word early? environment))
((IF)
- `(IF ,(cadr first-word)
- ,(loop (caddr first-word))
- ,(loop (cadddr first-word))))
+ `(,(close-syntax 'IF environment)
+ ,(cadr first-word)
+ ,(loop (caddr first-word))
+ ,(loop (cadddr first-word))))
(else
- (error "parse-instruction: Unknown format" first-word)))))
+ (error "Unknown format:" first-word)))))
-(define (process-variable-width descriptor early?)
+(define (process-variable-width descriptor early? environment)
(let ((binding (cadr descriptor))
(clauses (cddr descriptor)))
- `(LIST
+ `(,(close-syntax 'LIST environment)
,(variable-width-expression-syntaxer
(car binding) ; name
(cadr binding) ; expression
+ environment
(map (lambda (clause)
- (expand-fields
- (cdadr clause)
- early?
- (lambda (code size)
- (if (not (zero? (remainder size 32)))
- (error "process-variable-width: bad clause size" size))
- `((LIST ,(optimize-group-syntax code early?))
- ,size
- ,@(car clause)))))
- clauses)))))
-\f
-(define (process-fields fields early?)
- (expand-fields fields
- early?
+ (call-with-values
+ (lambda ()
+ (expand-fields (cdadr clause) early? environment))
(lambda (code size)
(if (not (zero? (remainder size 32)))
- (error "process-fields: bad syllable size" size))
- `(LIST ,(optimize-group-syntax code early?)))))
-
-(define (expand-fields fields early? receiver)
- (define (expand first-word word-size fields receiver)
- (if (null? fields)
- (receiver '() 0)
- (expand-field
- (car fields) early?
- (lambda (car-field car-size)
- (if (= 32 (+ word-size car-size))
- (expand '() 0 (cdr fields)
- (lambda (tail tail-size)
- (receiver
- (append (cons car-field first-word) tail)
- (+ car-size tail-size))))
- (expand (cons car-field first-word)
- (+ car-size word-size)
- (cdr fields)
- (lambda (tail tail-size)
- (receiver
- (if (zero? car-size)
- (cons car-field tail)
- tail)
- (+ car-size tail-size)))))))))
- (expand '() 0 fields receiver))
-
-(define (expand-field field early? receiver)
+ (error "Bad clause size:" size))
+ `((,(close-syntax 'LIST environment)
+ ,(optimize-group-syntax code early? environment))
+ ,size
+ ,@(car clause)))))
+ clauses)))))
+\f
+(define (process-fields fields early? environment)
+ (call-with-values (lambda () (expand-fields fields early? environment))
+ (lambda (code size)
+ (if (not (zero? (remainder size 32)))
+ (error "process-fields: bad syllable size" size))
+ `(,(close-syntax 'LIST environment)
+ ,(optimize-group-syntax code early? environment)))))
+
+(define (expand-fields fields early? environment)
+ (let expand ((first-word '()) (word-size 0) (fields fields))
+ (if (pair? fields)
+ (call-with-values
+ (lambda () (expand-field (car fields) early? environment))
+ (lambda (car-field car-size)
+ (if (= 32 (+ word-size car-size))
+ (call-with-values (lambda () (expand '() 0 (cdr fields)))
+ (lambda (tail tail-size)
+ (values (append (cons car-field first-word) tail)
+ (+ car-size tail-size))))
+ (call-with-values
+ (lambda ()
+ (expand (cons car-field first-word)
+ (+ car-size word-size)
+ (cdr fields)))
+ (lambda (tail tail-size)
+ (values (if (zero? car-size)
+ (cons car-field tail)
+ tail)
+ (+ car-size tail-size)))))))
+ (values '() 0))))
+
+(define (expand-field field early? environment)
early? ; ignored for now
(let ((size (car field))
(expression (cadr field)))
(define (default type)
- (receiver (integer-syntaxer expression type size)
- size))
+ (values (integer-syntaxer expression environment type size)
+ size))
- (if (null? (cddr field))
- (default 'UNSIGNED)
+ (if (pair? (cddr field))
(case (caddr field)
((PC-REL)
- (receiver
- (integer-syntaxer ``(- ,,expression (+ *PC* 4))
- (cadddr field)
- size)
- size))
+ (values (integer-syntaxer ``(,',(close-syntax '- environment)
+ ,,expression
+ (,',(close-syntax '+ environment)
+ ,',(close-syntax '*PC* environment)
+ 4))
+ environment
+ (cadddr field)
+ size)
+ size))
((BLOCK-OFFSET)
- (receiver (list 'list ''BLOCK-OFFSET expression)
- size))
+ (values `(,(close-syntax 'LIST environment)
+ 'BLOCK-OFFSET
+ ,expression)
+ size))
(else
- (default (caddr field)))))))
\ No newline at end of file
+ (default (caddr field))))
+ (default 'UNSIGNED))))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: insmac.scm,v 1.131 2002/02/14 15:58:56 cph Exp $
+$Id: insmac.scm,v 1.132 2002/02/14 22:03:32 cph Exp $
Copyright (c) 1988, 1990, 1999, 2001, 2002 Massachusetts Institute of Technology
(make-position-independent pattern actions environment))))))))
(define-syntax extension-word
- (sc-macro-transformer
+ (rsc-macro-transformer
(lambda (form environment)
environment
(call-with-values (lambda () (expand-descriptors (cdr form) environment))
(lambda (instruction size source destination)
(if (or source destination)
- (error "Source or destination used" 'EXTENSION-WORD))
+ (error "Source or destination used:" form))
(if (not (zero? (remainder size 16)))
- (error "EXTENSION-WORD: Extensions must be 16 bit multiples"
- size))
- (optimize-group-syntax instruction #f))))))
+ (error "Extensions must be 16 bit multiples:" size))
+ (optimize-group-syntax instruction #f environment))))))
(define-syntax variable-extension
- (sc-macro-transformer
+ (rsc-macro-transformer
(lambda (form environment)
(let ((binding (cadr form))
(clauses (cddr form)))
(variable-width-expression-syntaxer
(car binding)
- (close-syntax (cadr binding) environment)
+ (cadr binding)
+ environment
(map (lambda (clause)
- `((LIST ,(make-syntactic-closure environment
- (list (car binding))
- (caddr clause)))
+ `((,(close-syntax 'LIST environment)
+ ,(caddr clause))
,(cadr clause)
,@(car clause)))
clauses))))))
(extension (cdddr actions)))
`(,(close-syntax 'MAKE-EFFECTIVE-ADDRESS environment)
',keyword
- ,(integer-syntaxer mode 'UNSIGNED 3)
- ,(integer-syntaxer register 'UNSIGNED 3)
+ ,(integer-syntaxer mode environment 'UNSIGNED 3)
+ ,(integer-syntaxer register environment 'UNSIGNED 3)
(,(close-syntax 'LAMBDA environment)
(IMMEDIATE-SIZE INSTRUCTION-TAIL)
IMMEDIATE-SIZE ;ignore if not referenced
(define (process-ea-field field environment)
(if (exact-integer? field)
- (integer-syntaxer field 'UNSIGNED 3)
+ (integer-syntaxer field environment 'UNSIGNED 3)
(let ((binding (cadr field))
(clauses (cddr field)))
(variable-width-expression-syntaxer
(car binding)
(cadr binding)
+ environment
(map (lambda (clause)
`((,(close-syntax 'LIST environment)
- ,(integer-syntaxer (cadr clause) 'UNSIGNED 3))
+ ,(integer-syntaxer (cadr clause) environment 'UNSIGNED 3))
3
,@(car clause)))
clauses)))))
`(LIST
,(variable-width-expression-syntaxer
(car binding)
- (close-syntax (cadr binding) environment)
+ (cadr binding)
+ environment
(map (lambda (clause)
(if (pair? (cddr clause))
(error "Extension found in clause:" clause))
,code))
(else
(error "PARSE-WORD: multiple tail elements" tail))))))
- (if (not (null? instruction))
+ (if (pair? instruction)
`(,(if (null? code) 'CONS 'CONS-SYNTAX)
- ,(optimize-group-syntax instruction early-instruction-parsing?)
+ ,(optimize-group-syntax instruction
+ early-instruction-parsing?
+ environment)
,code)
code)))
\f
(handle)))
(define (with-early-selectors handle)
- (fluid-let ((early-instruction-parsing? true)
+ (fluid-let ((early-instruction-parsing? #t)
(ea-keyword-selector 'EA-KEYWORD-EARLY)
(ea-categories-selector 'EA-CATEGORIES-EARLY)
(ea-mode-selector 'EA-MODE-EARLY)
(if (pair? (cddr descriptor)) (caddr descriptor) 'UNSIGNED)))
(case coercion-type
((UNSIGNED SIGNED SHIFT-NUMBER QUICK BFWIDTH SCALE-FACTOR)
- (values `(,(integer-syntaxer expression coercion-type size))
+ (values `(,(integer-syntaxer expression environment coercion-type size))
size #f #f))
((SHORT-LABEL)
- (values `(,(integer-syntaxer ``(- ,,expression (+ *PC* 2))
+ (values `(,(integer-syntaxer ``(,',(close-syntax '- environment)
+ ,,expression
+ (,',(close-syntax '+ environment)
+ ,',(close-syntax '*PC* environment)
+ 2))
+ environment
'SHORT-LABEL
size))
size #f #f))
((SOURCE-EA)
- (values `((,ea-mode-selector ,expression)
- (,ea-register-selector ,expression))
+ (values `((,(close-syntax ea-mode-selector environment) ,expression)
+ (,(close-syntax ea-register-selector environment)
+ ,expression))
size
- `((,ea-extension-selector ,expression) ,(cadddr descriptor))
+ `((,(close-syntax ea-extension-selector environment)
+ ,expression)
+ ,(cadddr descriptor))
#f))
((DESTINATION-EA)
- (values `((,ea-mode-selector ,expression)
- (,ea-register-selector ,expression))
+ (values `((,(close-syntax ea-mode-selector environment) ,expression)
+ (,(close-syntax ea-register-selector environment)
+ ,expression))
size
#f
- `((,ea-extension-selector ,expression) '())))
+ `((,(close-syntax ea-extension-selector environment)
+ ,expression)
+ '())))
((DESTINATION-EA-REVERSED)
- (values `((,ea-register-selector ,expression)
- (,ea-mode-selector ,expression))
+ (values `((,(close-syntax ea-register-selector environment) ,expression)
+ (,(close-syntax ea-mode-selector environment) ,expression))
size
#f
- `((,ea-extension-selector ,expression) '())))
+ `((,(close-syntax ea-extension-selector environment)
+ ,expression)
+ '())))
(else
(error "Badly-formed descriptor:" descriptor)))))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: insmac.scm,v 1.16 2002/02/14 15:58:08 cph Exp $
+$Id: insmac.scm,v 1.17 2002/02/14 22:03:32 cph Exp $
Copyright (c) 1992, 1999, 2001, 2002 Massachusetts Institute of Technology
`(,(close-syntax 'MAKE-EFFECTIVE-ADDRESS environment)
',keyword
',categories
- ,(integer-syntaxer mode 'UNSIGNED 2)
- ,(integer-syntaxer register 'UNSIGNED 3)
+ ,(integer-syntaxer mode environment 'UNSIGNED 2)
+ ,(integer-syntaxer register environment 'UNSIGNED 3)
,(if (null? tail)
`()
(process-fields tail #f environment))))))))))
,(variable-width-expression-syntaxer
(car binding)
(cadr binding)
+ environment
(map (lambda (clause)
(call-with-values
(lambda () (expand-fields (cdr clause) early? environment))
(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)
+ ,(integer-syntaxer digit-or-reg environment
+ 'UNSIGNED 3)
(,(close-syntax 'CONS-SYNTAX environment)
(,(close-syntax 'EA/MODE environment) ,r/m)
(,(close-syntax 'APPEND-SYNTAX! environment)
`(,(close-syntax 'CONS-SYNTAX environment)
,(integer-syntaxer
value
+ environment
domain
(case mode
((OPERAND) *operand-size*)
(caddar components)
'UNSIGNED)))
(values `(,(close-syntax 'CONS-SYNTAX environment)
- ,(integer-syntaxer expression type size)
+ ,(integer-syntaxer expression environment type size)
,byte-tail)
(+ size byte-size)))))
(values tail 0))))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: insmac.scm,v 1.5 2001/12/23 17:20:58 cph Exp $
+$Id: insmac.scm,v 1.6 2002/02/14 22:03:32 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
;;;; Definition macros
(define-syntax define-symbol-transformer
- (non-hygienic-macro-transformer
- (lambda (name . alist)
- `(DEFINE-INTEGRABLE (,name SYMBOL)
- (LET ((PLACE (ASSQ SYMBOL ',alist)))
- (IF (PAIR? PLACE)
- (CDR PLACE)
- #F))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (if (syntax-match? '(IDENTIFIER * SYMBOL) (cdr form))
+ `(DEFINE-INTEGRABLE (,(cadr form) SYMBOL)
+ (LET ((PLACE (ASSQ SYMBOL ',(cddr form))))
+ (IF (PAIR? PLACE)
+ (CDR PLACE)
+ #F)))
+ (ill-formed-syntax form)))))
(define-syntax define-transformer
- (non-hygienic-macro-transformer
- (lambda (name value)
- `(DEFINE ,name ,value))))
+ (rsc-macro-transformer
+ (lambda (form environment)
+ `(,(close-syntax 'DEFINE environment) ,@(cdr form)))))
;;;; Fixed width instruction parsing
-(define (parse-instruction first-word tail early?)
+(define (parse-instruction first-word tail early? environment)
(if (not (null? tail))
- (error "parse-instruction: Unknown format" (cons first-word tail)))
+ (error "Unknown format:" (cons first-word tail)))
(let loop ((first-word first-word))
(case (car first-word)
((LONG)
- (process-fields (cdr first-word) early?))
+ (process-fields (cdr first-word) early? environment))
((VARIABLE-WIDTH)
- (process-variable-width first-word early?))
+ (process-variable-width first-word early? environment))
((IF)
- `(IF ,(cadr first-word)
- ,(loop (caddr first-word))
- ,(loop (cadddr first-word))))
+ `(,(close-syntax 'IF environment)
+ ,(cadr first-word)
+ ,(loop (caddr first-word))
+ ,(loop (cadddr first-word))))
(else
- (error "parse-instruction: Unknown format" first-word)))))
+ (error "Unknown format:" first-word)))))
-(define (process-variable-width descriptor early?)
+(define (process-variable-width descriptor early? environment)
(let ((binding (cadr descriptor))
(clauses (cddr descriptor)))
- `(LIST
+ `(,(close-syntax 'LIST environment)
,(variable-width-expression-syntaxer
(car binding) ; name
(cadr binding) ; expression
+ environment
(map (lambda (clause)
- (expand-fields
- (cdadr clause)
- early?
- (lambda (code size)
- (if (not (zero? (remainder size 32)))
- (error "process-variable-width: bad clause size" size))
- `((LIST ,(optimize-group-syntax code early?))
- ,size
- ,@(car clause)))))
- clauses)))))
-\f
-(define (process-fields fields early?)
- (expand-fields fields
- early?
+ (call-with-values
+ (lambda ()
+ (expand-fields (cdadr clause) early? environment))
(lambda (code size)
(if (not (zero? (remainder size 32)))
- (error "process-fields: bad syllable size" size))
- `(LIST ,(optimize-group-syntax code early?)))))
-
-(define (expand-fields fields early? receiver)
- (define (expand first-word word-size fields receiver)
- (if (null? fields)
- (receiver '() 0)
- (expand-field
- (car fields) early?
- (lambda (car-field car-size)
- (if (and (eq? endianness 'LITTLE)
- (= 32 (+ word-size car-size)))
- (expand '() 0 (cdr fields)
- (lambda (tail tail-size)
- (receiver
- (append (cons car-field first-word) tail)
- (+ car-size tail-size))))
- (expand (cons car-field first-word)
- (+ car-size word-size)
- (cdr fields)
- (lambda (tail tail-size)
- (receiver
- (if (or (zero? car-size)
- (not (eq? endianness 'LITTLE)))
- (cons car-field tail)
- tail)
- (+ car-size tail-size)))))))))
- (expand '() 0 fields receiver))
-
-(define (expand-field field early? receiver)
+ (error "Bad clause size:" size))
+ `((,(close-syntax 'LIST environment)
+ ,(optimize-group-syntax code early? environment))
+ ,size
+ ,@(car clause)))))
+ clauses)))))
+\f
+(define (process-fields fields early? environment)
+ (call-with-values (lambda () (expand-fields fields early? environment))
+ (lambda (code size)
+ (if (not (zero? (remainder size 32)))
+ (error "Bad syllable size:" size))
+ `(,(close-syntax 'LIST environment)
+ ,(optimize-group-syntax code early? environment)))))
+
+(define (expand-fields fields early? environment)
+ (let expand ((first-word '()) (word-size 0) (fields fields))
+ (if (pair? fields)
+ (call-with-values
+ (lambda () (expand-field (car fields) early? environment))
+ (lambda (car-field car-size)
+ (if (and (eq? endianness 'LITTLE)
+ (= 32 (+ word-size car-size)))
+ (call-with-values (lambda () (expand '() 0 (cdr fields)))
+ (lambda (tail tail-size)
+ (values (append (cons car-field first-word) tail)
+ (+ car-size tail-size))))
+ (call-with-values
+ (lambda ()
+ (expand (cons car-field first-word)
+ (+ car-size word-size)
+ (cdr fields)))
+ (lambda (tail tail-size)
+ (values (if (or (zero? car-size)
+ (not (eq? endianness 'LITTLE)))
+ (cons car-field tail)
+ tail)
+ (+ car-size tail-size)))))))
+ (values '() 0))))
+
+(define (expand-field field early? environment)
early? ; ignored for now
(let ((size (car field))
(expression (cadr field)))
(define (default type)
- (receiver (integer-syntaxer expression type size)
- size))
+ (values (integer-syntaxer expression environment type size)
+ size))
- (if (null? (cddr field))
- (default 'UNSIGNED)
+ (if (pair? (cddr field))
(case (caddr field)
((PC-REL)
- (receiver
- (integer-syntaxer ``(- ,,expression (+ *PC* 4))
- (cadddr field)
- size)
- size))
+ (values (integer-syntaxer ``(,',(close-syntax '- environment)
+ ,,expression
+ (,',(close-syntax '+ environment)
+ ,',(close-syntax '*PC* environment)
+ 4))
+ environment
+ (cadddr field)
+ size)
+ size))
((BLOCK-OFFSET)
- (receiver (list 'list ''BLOCK-OFFSET expression)
- size))
+ (values `(,(close-syntax 'LIST environment)
+ 'BLOCK-OFFSET
+ ,expression)
+ size))
(else
- (default (caddr field)))))))
\ No newline at end of file
+ (default (caddr field))))
+ (default 'UNSIGNED))))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: insmac.scm,v 1.4 2001/12/23 17:20:58 cph Exp $
+$Id: insmac.scm,v 1.5 2002/02/14 22:03:32 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
;;;; Definition macros
(define-syntax define-symbol-transformer
- (non-hygienic-macro-transformer
- (lambda (name . alist)
- `(DEFINE-INTEGRABLE (,name SYMBOL)
- (LET ((PLACE (ASSQ SYMBOL ',alist)))
- (IF (PAIR? PLACE)
- (CDR PLACE)
- #F))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (if (syntax-match? '(IDENTIFIER * SYMBOL) (cdr form))
+ `(DEFINE-INTEGRABLE (,(cadr form) SYMBOL)
+ (LET ((PLACE (ASSQ SYMBOL ',(cddr form))))
+ (IF (PAIR? PLACE)
+ (CDR PLACE)
+ #F)))
+ (ill-formed-syntax form)))))
(define-syntax define-transformer
- (non-hygienic-macro-transformer
- (lambda (name value)
- `(DEFINE ,name ,value))))
+ (rsc-macro-transformer
+ (lambda (form environment)
+ `(,(close-syntax 'DEFINE environment) ,@(cdr form)))))
;;;; Fixed width instruction parsing
-(define (parse-instruction first-word tail early?)
+(define (parse-instruction first-word tail early? environment)
(if (not (null? tail))
- (error "parse-instruction: Unknown format" (cons first-word tail)))
+ (error "Unknown format:" (cons first-word tail)))
(let loop ((first-word first-word))
(case (car first-word)
((LONG)
- (process-fields (cdr first-word) early?))
+ (process-fields (cdr first-word) early? environment))
((VARIABLE-WIDTH)
- (process-variable-width first-word early?))
+ (process-variable-width first-word early? environment))
((IF)
- `(IF ,(cadr first-word)
- ,(loop (caddr first-word))
- ,(loop (cadddr first-word))))
+ `(,(close-syntax 'IF environment)
+ ,(cadr first-word)
+ ,(loop (caddr first-word))
+ ,(loop (cadddr first-word))))
(else
- (error "parse-instruction: Unknown format" first-word)))))
+ (error "Unknown format:" first-word)))))
-(define (process-variable-width descriptor early?)
+(define (process-variable-width descriptor early? environment)
(let ((binding (cadr descriptor))
(clauses (cddr descriptor)))
- `(LIST
+ `(,(close-syntax 'LIST environment)
,(variable-width-expression-syntaxer
(car binding) ; name
(cadr binding) ; expression
+ environment
(map (lambda (clause)
- (expand-fields
- (cdadr clause)
- early?
- (lambda (code size)
- (if (not (zero? (remainder size 32)))
- (error "process-variable-width: bad clause size" size))
- `((LIST ,(optimize-group-syntax code early?))
- ,size
- ,@(car clause)))))
- clauses)))))
-\f
-(define (process-fields fields early?)
- (expand-fields fields
- early?
+ (call-with-values
+ (lambda ()
+ (expand-fields (cdadr clause) early? environment))
(lambda (code size)
(if (not (zero? (remainder size 32)))
- (error "process-fields: bad syllable size" size))
- `(LIST ,(optimize-group-syntax code early?)))))
-
-(define (expand-fields fields early? receiver)
- (define (expand first-word word-size fields receiver)
- (if (null? fields)
- (receiver '() 0)
- (expand-field
- (car fields) early?
- (lambda (car-field car-size)
- (if (and (eq? endianness 'LITTLE)
- (= 32 (+ word-size car-size)))
- (expand '() 0 (cdr fields)
- (lambda (tail tail-size)
- (receiver
- (append (cons car-field first-word) tail)
- (+ car-size tail-size))))
- (expand (cons car-field first-word)
- (+ car-size word-size)
- (cdr fields)
- (lambda (tail tail-size)
- (receiver
- (if (or (zero? car-size)
- (not (eq? endianness 'LITTLE)))
- (cons car-field tail)
- tail)
- (+ car-size tail-size)))))))))
- (expand '() 0 fields receiver))
-
-(define (expand-field field early? receiver)
+ (error "Bad clause size:" size))
+ `((,(close-syntax 'LIST environment)
+ ,(optimize-group-syntax code early? environment))
+ ,size
+ ,@(car clause)))))
+ clauses)))))
+\f
+(define (process-fields fields early? environment)
+ (call-with-values (lambda () (expand-fields fields early? environment))
+ (lambda (code size)
+ (if (not (zero? (remainder size 32)))
+ (error "Bad syllable size:" size))
+ `(,(close-syntax 'LIST environment)
+ ,(optimize-group-syntax code early? environment)))))
+
+(define (expand-fields fields early? environment)
+ (let expand ((first-word '()) (word-size 0) (fields fields))
+ (if (pair? fields)
+ (call-with-values
+ (lambda () (expand-field (car fields) early? environment))
+ (lambda (car-field car-size)
+ (if (and (eq? endianness 'LITTLE)
+ (= 32 (+ word-size car-size)))
+ (call-with-values (lambda () (expand '() 0 (cdr fields)))
+ (lambda (tail tail-size)
+ (values (append (cons car-field first-word) tail)
+ (+ car-size tail-size))))
+ (call-with-values
+ (lambda ()
+ (expand (cons car-field first-word)
+ (+ car-size word-size)
+ (cdr fields)))
+ (lambda (tail tail-size)
+ (values (if (or (zero? car-size)
+ (not (eq? endianness 'LITTLE)))
+ (cons car-field tail)
+ tail)
+ (+ car-size tail-size)))))))
+ (values '() 0))))
+
+(define (expand-field field early? environment)
early? ; ignored for now
(let ((size (car field))
(expression (cadr field)))
(define (default type)
- (receiver (integer-syntaxer expression type size)
- size))
+ (values (integer-syntaxer expression environment type size)
+ size))
- (if (null? (cddr field))
- (default 'UNSIGNED)
+ (if (pair? (cddr field))
(case (caddr field)
((PC-REL)
- (receiver
- (integer-syntaxer ``(- ,,expression (+ *PC* 4))
- (cadddr field)
- size)
- size))
+ (values (integer-syntaxer ``(,',(close-syntax '- environment)
+ ,,expression
+ (,',(close-syntax '+ environment)
+ ,',(close-syntax '*PC* environment)
+ 4))
+ environment
+ (cadddr field)
+ size)
+ size))
((BLOCK-OFFSET)
- (receiver (list 'list ''BLOCK-OFFSET expression)
- size))
+ (values `(,(close-syntax 'LIST environment)
+ 'BLOCK-OFFSET
+ ,expression)
+ size))
(else
- (default (caddr field)))))))
\ No newline at end of file
+ (default (caddr field))))
+ (default 'UNSIGNED))))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: insmac.scm,v 1.5 2001/12/23 17:20:58 cph Exp $
+$Id: insmac.scm,v 1.6 2002/02/14 22:03:32 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
;;;; Definition macros
(define-syntax define-symbol-transformer
- (non-hygienic-macro-transformer
- (lambda (name . alist)
- `(DEFINE-INTEGRABLE (,name SYMBOL)
- (LET ((PLACE (ASSQ SYMBOL ',alist)))
- (IF (PAIR? PLACE)
- (CDR PLACE)
- #F))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (if (syntax-match? '(IDENTIFIER * SYMBOL) (cdr form))
+ `(DEFINE-INTEGRABLE (,(cadr form) SYMBOL)
+ (LET ((PLACE (ASSQ SYMBOL ',(cddr form))))
+ (IF (PAIR? PLACE)
+ (CDR PLACE)
+ #F)))
+ (ill-formed-syntax form)))))
(define-syntax define-transformer
- (non-hygienic-macro-transformer
- (lambda (name value)
- `(DEFINE ,name ,value))))
+ (rsc-macro-transformer
+ (lambda (form environment)
+ `(,(close-syntax 'DEFINE environment) ,@(cdr form)))))
\f
;;;; Fixed width instruction parsing
-(define (parse-instruction first-word tail early?)
- (cond ((not (null? tail))
- (error "parse-instruction: Unknown format" (cons first-word tail)))
- ((eq? (car first-word) 'LONG)
- (process-fields (cdr first-word) early?))
- ((eq? (car first-word) 'VARIABLE-WIDTH)
- (process-variable-width first-word early?))
- (else
- (error "parse-instruction: Unknown format" first-word))))
-
-(define (process-variable-width descriptor early?)
+(define (parse-instruction first-word tail early? environment)
+ (if (not (null? tail))
+ (error "Unknown format:" (cons first-word tail)))
+ (case (car first-word)
+ ((LONG) (process-fields (cdr first-word) early? environment))
+ ((VARIABLE-WIDTH) (process-variable-width first-word early? environment))
+ (else (error "Unknown format:" first-word))))
+
+(define (process-variable-width descriptor early? environment)
(let ((binding (cadr descriptor))
(clauses (cddr descriptor)))
- `(LIST
+ `(,(close-syntax 'LIST environment)
,(variable-width-expression-syntaxer
(car binding) ; name
(cadr binding) ; expression
+ environment
(map (lambda (clause)
- (expand-fields
- (cdadr clause)
- early?
- (lambda (code size)
- (if (not (zero? (remainder size 32)))
- (error "process-variable-width: bad clause size" size))
- `((LIST ,(optimize-group-syntax code early?))
- ,size
- ,@(car clause)))))
- clauses)))))
-
-(define (process-fields fields early?)
- (expand-fields fields
- early?
+ (call-with-values
+ (lambda ()
+ (expand-fields (cdadr clause) early? environment))
(lambda (code size)
(if (not (zero? (remainder size 32)))
- (error "process-fields: bad syllable size" size))
- `(LIST ,(optimize-group-syntax code early?)))))
-
-(define (expand-fields fields early? receiver)
- (define (expand first-word word-size fields receiver)
- (if (null? fields)
- (receiver '() 0)
- (expand-field
- (car fields) early?
- (lambda (car-field car-size)
- (if (and (eq? endianness 'LITTLE)
- (= 32 (+ word-size car-size)))
- (expand '() 0 (cdr fields)
- (lambda (tail tail-size)
- (receiver
- (append (cons car-field first-word) tail)
- (+ car-size tail-size))))
- (expand (cons car-field first-word)
- (+ car-size word-size)
- (cdr fields)
- (lambda (tail tail-size)
- (receiver
- (if (or (zero? car-size)
- (not (eq? endianness 'LITTLE)))
- (cons car-field tail)
- tail)
- (+ car-size tail-size)))))))))
- (expand '() 0 fields receiver))
-
-(define (expand-field field early? receiver)
+ (error "Bad clause size:" size))
+ `((,(close-syntax 'LIST environment)
+ ,(optimize-group-syntax code early? environment))
+ ,size
+ ,@(car clause)))))
+ clauses)))))
+
+(define (process-fields fields early? environment)
+ (call-with-values (lambda () (expand-fields fields early? environment))
+ (lambda (code size)
+ (if (not (zero? (remainder size 32)))
+ (error "Bad syllable size:" size))
+ `(,(close-syntax 'LIST environment)
+ ,(optimize-group-syntax code early? environment)))))
+
+(define (expand-fields fields early? environment)
+ (let expand ((first-word '()) (word-size 0) (fields fields))
+ (if (pair? fields)
+ (call-with-values
+ (lambda () (expand-field (car fields) early? environment))
+ (lambda (car-field car-size)
+ (if (and (eq? endianness 'LITTLE)
+ (= 32 (+ word-size car-size)))
+ (call-with-values (lambda () (expand '() 0 (cdr fields)))
+ (lambda (tail tail-size)
+ (values (append (cons car-field first-word) tail)
+ (+ car-size tail-size))))
+ (call-with-values
+ (lambda ()
+ (expand (cons car-field first-word)
+ (+ car-size word-size)
+ (cdr fields)))
+ (lambda (tail tail-size)
+ (values (if (or (zero? car-size)
+ (not (eq? endianness 'LITTLE)))
+ (cons car-field tail)
+ tail)
+ (+ car-size tail-size)))))))
+ (values '() 0))))
+
+(define (expand-field field early? environment)
early? ; ignored for now
(let ((size (car field))
(expression (cadr field)))
(define (default type)
- (receiver (integer-syntaxer expression type size)
- size))
+ (values (integer-syntaxer expression environment type size)
+ size))
- (if (null? (cddr field))
- (default 'UNSIGNED)
+ (if (pair? (cddr field))
(case (caddr field)
((PC-REL)
- (receiver
- (integer-syntaxer ``(- ,,expression (+ *PC* 8))
- (cadddr field)
- size)
- size))
+ (values (integer-syntaxer ``(,',(close-syntax '- environment)
+ ,,expression
+ (,',(close-syntax '+ environment)
+ ,',(close-syntax '*PC* environment)
+ 8))
+ environment
+ (cadddr field)
+ size)
+ size))
((BLOCK-OFFSET)
- (receiver (list 'list ''BLOCK-OFFSET expression)
- size))
+ (values `(,(close-syntax 'LIST environment)
+ 'BLOCK-OFFSET
+ ,expression)
+ size))
(else
- (default (caddr field)))))))
\ No newline at end of file
+ (default (caddr field))))
+ (default 'UNSIGNED))))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: insmac.scm,v 1.15 2001/12/23 17:20:58 cph Exp $
+$Id: insmac.scm,v 1.16 2002/02/14 22:03:32 cph Exp $
-Copyright (c) 1987, 1989, 1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1987, 1989, 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
'EA-DATABASE)
(define-syntax define-ea-database
- (non-hygienic-macro-transformer
- (lambda rules
- `(DEFINE ,ea-database-name
- ,(compile-database rules
+ (rsc-macro-transformer
+ (lambda (form environment)
+ `(,(close-syntax 'DEFINE environment)
+ ,ea-database-name
+ ,(compile-database (cdr form) environment
(lambda (pattern actions)
(let ((keyword (car pattern))
(categories (car actions))
(value (cdr actions)))
- (declare (integrate keyword categories value))
- `(MAKE-EFFECTIVE-ADDRESS
+ `(,(close-syntax 'MAKE-EFFECTIVE-ADDRESS environment)
',keyword
',categories
- ,(process-fields value false)))))))))
+ ,(process-fields value #f environment)))))))))
(define-syntax define-ea-transformer
- (non-hygienic-macro-transformer
- (lambda (name category type)
- `(DEFINE (,name EXPRESSION)
- (LET ((EA (PROCESS-EA EXPRESSION ',type)))
- (AND EA
- (MEMQ ',category (EA-CATEGORIES EA))
- EA))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (if (syntax-match? '(IDENTIFIER DATUM DATUM) (cdr form))
+ `(DEFINE (,(cadr form) EXPRESSION)
+ (LET ((EA (PROCESS-EA EXPRESSION ',(cadddr form))))
+ (AND EA
+ (MEMQ ',(caddr form) (EA-CATEGORIES EA))
+ EA)))
+ (ill-formed-syntax form)))))
(define-syntax define-symbol-transformer
- (non-hygienic-macro-transformer
- (lambda (name . alist)
- `(DEFINE-INTEGRABLE (,name SYMBOL)
- (LET ((PLACE (ASSQ SYMBOL ',alist)))
- (IF (PAIR? PLACE)
- (CDR PLACE)
- #F))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (if (syntax-match? '(IDENTIFIER * SYMBOL) (cdr form))
+ `(DEFINE-INTEGRABLE (,(cadr form) SYMBOL)
+ (LET ((PLACE (ASSQ SYMBOL ',(cddr form))))
+ (IF (PAIR? PLACE)
+ (CDR PLACE)
+ #F)))
+ (ill-formed-syntax form)))))
(define-syntax define-transformer
- (non-hygienic-macro-transformer
- (lambda (name value)
- `(DEFINE ,name ,value))))
+ (rsc-macro-transformer
+ (lambda (form environment)
+ `(,(close-syntax 'DEFINE environment) ,@(cdr form)))))
\f
-(define (parse-instruction opcode tail early?)
- (process-fields (cons opcode tail) early?))
+(define (parse-instruction opcode tail early? environment)
+ (process-fields (cons opcode tail) early? environment))
-(define (process-fields fields early?)
+(define (process-fields fields early? environment)
(if (and (null? (cdr fields))
(eq? (caar fields) 'VARIABLE-WIDTH))
- (expand-variable-width (car fields) early?)
- (expand-fields fields
- early?
- (lambda (code size)
- (if (not (zero? (remainder size 8)))
- (error "process-fields: bad syllable size" size))
- code))))
+ (expand-variable-width (car fields) early? environment)
+ (call-with-values (lambda () (expand-fields fields early? environment))
+ (lambda (code size)
+ (if (not (zero? (remainder size 8)))
+ (error "Bad syllable size:" size))
+ code))))
-(define (expand-variable-width field early?)
+(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
(cadr binding) ; expression
+ environment
(map (lambda (clause)
- (expand-fields
- (cdr clause)
- early?
- (lambda (code size)
- (if (not (zero? (remainder size 8)))
- (error "expand-variable-width: bad clause size" size))
- `(,code ,size ,@(car clause)))))
+ (call-with-values
+ (lambda () (expand-fields (cdr clause) early? environment))
+ (lambda (code size)
+ (if (not (zero? (remainder size 8)))
+ (error "Bad clause size:" size))
+ `(,code ,size ,@(car clause)))))
clauses)))))
\f
-(define (expand-fields fields early? receiver)
- (if (null? fields)
- (receiver ''() 0)
- (expand-fields (cdr fields) early?
- (lambda (tail tail-size)
- (case (caar fields)
- ((BYTE)
- (collect-byte (cdar fields)
- tail
- (lambda (code size)
- (receiver code (+ size tail-size)))))
- ((OPERAND)
- (receiver
- `(APPEND-SYNTAX!
- ,(if early?
- `(EA-VALUE-EARLY ',(cadar fields) ,(caddar fields))
- `(EA-VALUE ,(caddar fields)))
- ,tail)
- tail-size))
- ;; Displacements are like signed bytes. They are a different
- ;; keyword to allow the disassembler to do its thing correctly.
- ((DISPLACEMENT)
- (let* ((desc (cadar fields))
- (size (car desc)))
- (receiver
- `(CONS-SYNTAX ,(integer-syntaxer (cadr desc) 'SIGNED size)
- ,tail)
- (+ size tail-size))))
- ((IMMEDIATE)
- (receiver
- `(CONS-SYNTAX
- (COERCE-TO-TYPE ,(cadar fields)
- *IMMEDIATE-TYPE*
- ,(and (cddar fields)
- (eq? (caddar fields)
- 'UNSIGNED)))
- ,tail)
- tail-size))
- (else
- (error "expand-fields: Unknown field kind" (caar fields))))))))
-\f
-(define (collect-byte components tail receiver)
- (define (inner components receiver)
- (if (null? components)
- (receiver tail 0)
- (inner (cdr components)
- (lambda (byte-tail byte-size)
- (let ((size (caar components))
- (expression (cadar components))
- (type (if (null? (cddar components))
- 'UNSIGNED
- (caddar components))))
- (receiver
- `(CONS-SYNTAX
- ,(integer-syntaxer expression type size)
- ,byte-tail)
- (+ size byte-size)))))))
- (inner components receiver))
-
-
+(define (expand-fields fields early? environment)
+ (if (pair? fields)
+ (call-with-values
+ (lambda () (expand-fields (cdr fields) early? environment))
+ (lambda (tail tail-size)
+ (case (caar fields)
+ ((BYTE)
+ (call-with-values
+ (lambda () (collect-byte (cdar fields) tail environment))
+ (lambda (code size)
+ (values code (+ size tail-size)))))
+ ((OPERAND)
+ (values `(,(close-syntax 'APPEND-SYNTAX! environment)
+ ,(if early?
+ `(,(close-syntax 'EA-VALUE-EARLY environment)
+ ',(cadar fields)
+ ,(caddar fields))
+ `(,(close-syntax 'EA-VALUE environment)
+ ,(caddar fields)))
+ ,tail)
+ tail-size))
+ ;; Displacements are like signed bytes. They are a
+ ;; different keyword to allow the disassembler to do its
+ ;; thing correctly.
+ ((DISPLACEMENT)
+ (let* ((desc (cadar fields))
+ (size (car desc)))
+ (values `(,(close-syntax 'CONS-SYNTAX environment)
+ ,(integer-syntaxer (cadr desc)
+ environment
+ 'SIGNED
+ size)
+ ,tail)
+ (+ size tail-size))))
+ ((IMMEDIATE)
+ (values `(,(close-syntax 'CONS-SYNTAX environment)
+ (,(close-syntax 'COERCE-TO-TYPE environment)
+ ,(cadar fields)
+ ,(close-syntax '*IMMEDIATE-TYPE* environment)
+ ,(and (cddar fields)
+ (eq? (caddar fields) 'UNSIGNED)))
+ ,tail)
+ tail-size))
+ (else
+ (error "Unknown field kind:" (caar fields))))))
+ (values `'() 0)))
+(define (collect-byte components tail environment)
+ (let inner ((components components))
+ (if (pair? components)
+ (call-with-values (lambda () (inner (cdr components)))
+ (lambda (byte-tail byte-size)
+ (let ((size (caar components))
+ (expression (cadar components))
+ (type (if (pair? (cddar components))
+ (caddar components)
+ 'UNSIGNED)))
+ (values `(,(close-syntax 'CONS-SYNTAX environment)
+ ,(integer-syntaxer expression environment type size)
+ ,byte-tail)
+ (+ size byte-size)))))
+ (values tail 0))))
\ No newline at end of file
projects / mit-scheme.git / commitdiff