From 2748d5817b23abeb0391facccc5753006dbc96a7 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 14 Feb 2002 15:58:56 +0000 Subject: [PATCH] Make sure that all expressions are properly closed. --- v7/src/compiler/back/asmmac.scm | 19 +++-- v7/src/compiler/base/macros.scm | 13 +-- v7/src/compiler/base/pmpars.scm | 25 +++--- v7/src/compiler/machines/bobcat/insmac.scm | 66 ++++++++------- v7/src/compiler/machines/i386/insmac.scm | 95 +++++++++++----------- 5 files changed, 111 insertions(+), 107 deletions(-) diff --git a/v7/src/compiler/back/asmmac.scm b/v7/src/compiler/back/asmmac.scm index 4f15182b8..59d5e5eb3 100644 --- a/v7/src/compiler/back/asmmac.scm +++ b/v7/src/compiler/back/asmmac.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -25,10 +25,10 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (declare (usual-integrations)) (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) @@ -40,15 +40,16 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (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 diff --git a/v7/src/compiler/base/macros.scm b/v7/src/compiler/base/macros.scm index 90f5b737c..1e8566807 100644 --- a/v7/src/compiler/base/macros.scm +++ b/v7/src/compiler/base/macros.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -306,7 +306,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (ill-formed-syntax form))) (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)) @@ -315,10 +315,11 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (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 diff --git a/v7/src/compiler/base/pmpars.scm b/v7/src/compiler/base/pmpars.scm index 40456e2b9..c28d534a7 100644 --- a/v7/src/compiler/base/pmpars.scm +++ b/v7/src/compiler/base/pmpars.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -91,19 +91,16 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. names)) (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)) diff --git a/v7/src/compiler/machines/bobcat/insmac.scm b/v7/src/compiler/machines/bobcat/insmac.scm index d5ebbf515..7ae872281 100644 --- a/v7/src/compiler/machines/bobcat/insmac.scm +++ b/v7/src/compiler/machines/bobcat/insmac.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -30,10 +30,11 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA '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) @@ -74,16 +75,18 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (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) @@ -94,19 +97,23 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (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) @@ -115,11 +122,10 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (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))))) diff --git a/v7/src/compiler/machines/i386/insmac.scm b/v7/src/compiler/machines/i386/insmac.scm index 07ba1be92..808562682 100644 --- a/v7/src/compiler/machines/i386/insmac.scm +++ b/v7/src/compiler/machines/i386/insmac.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -42,27 +42,25 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA '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. @@ -96,16 +94,16 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (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)) @@ -126,40 +124,40 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; (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 @@ -171,7 +169,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA tail-size)) (else (error "Unknown field kind:" (caar fields)))))) - (values ''() 0))) + (values `'() 0))) (define (collect-byte components tail environment) (let loop ((components components)) @@ -179,11 +177,12 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (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 -- 2.25.1