#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/symtab.scm,v 1.42 1987/06/24 04:53:40 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/symtab.scm,v 1.43 1987/07/15 02:59:21 jinx Rel $
Copyright (c) 1987 Massachusetts Institute of Technology
(define-integrable (make-symbol-table)
(symbol-hash-table/make 271))
-(define-integrable (symbol-table-bindings table)
- (map (lambda (entry)
- (cons (car entry)
- (or (binding-value (cdr entry))
- (error "Missing binding value" entry))))
- (symbol-hash-table/bindings table)))
-
(define (symbol-table-define! table key value)
(symbol-hash-table/modify! table key
(lambda (binding)
+ (error "symbol-table-define!: Redefining" key)
(set-binding-value! binding value)
binding)
(lambda ()
(make-binding value))))
-(define (symbol-table-binding table key)
- (symbol-hash-table/lookup* table key
- identity-procedure
- (lambda ()
- (let ((nothing (make-binding #F)))
- (symbol-hash-table/insert! table key nothing)
- nothing))))
-
(define (symbol-table-value table key)
(symbol-hash-table/lookup* table key
(lambda (binding)
(lambda ()
(error "SYMBOL-TABLE-VALUE: Undefined key" key))))
-(define-integrable (symbol-table-undefined-names table)
- (map car (symbol-hash-table/negative-bindings table binding-value)))
+(define (symbol-table->assq-list table)
+ (map (lambda (pair)
+ (cons (car pair) (binding-value (cdr pair))))
+ (symbol-table-bindings table)))
+
+(define-integrable (symbol-table-bindings table)
+ (symbol-hash-table/bindings table))
(define-integrable (make-binding initial-value)
- (vector initial-value '()))
+ (cons initial-value '()))
(define-integrable (binding-value binding)
- (vector-ref binding 0))
+ (car binding))
(define (set-binding-value! binding value)
- (if (vector-ref binding 0)
- (error "Attempt to redefine variable" binding))
- (vector-set! binding 0 value)
- (for-each (lambda (daemon) (daemon binding))
- (vector-ref binding 1)))
-
-(define (add-binding-daemon! binding daemon)
- (vector-set! binding 1 (cons daemon (vector-ref binding 1))))
-
-(define (remove-binding-daemon! binding daemon)
- (vector-set! binding 1 (delq! daemon (vector-ref binding 1))))
\ No newline at end of file
+ (set-car! binding value))
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syntax.scm,v 1.15 1987/07/08 22:03:07 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syntax.scm,v 1.16 1987/07/15 02:57:43 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
directives)
(cons directive directives)))
-(define (convert-output directives)
- (define (internal directives)
- (map (lambda (directive)
- (cond ((bit-string? directive) (vector 'CONSTANT directive))
- ((pair? directive)
- (if (eq? (car directive) 'GROUP)
- (vector 'GROUP (internal (cdr directive)))
- (list->vector directive)))
- ((vector? directive) directive)
- (else
- (error "CONVERT-OUTPUT: Unknown directive" directive))))
- directives))
- (internal (instruction-sequence->directives directives)))
-
(define-export (lap:syntax-instruction instruction)
(if (memq (car instruction) '(EQUATE SCHEME-OBJECT ENTRY-POINT LABEL))
(directive->instruction-sequence instruction)
(define (syntax-evaluation expression coercion)
(if (integer? expression)
(coercion expression)
- (vector 'EVALUATION expression (coercion-size coercion) coercion)))
+ (list 'EVALUATION expression (coercion-size coercion) coercion)))
(define (optimize-group . components)
(optimize-group-internal components
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/decls.scm,v 1.17 1987/07/10 20:33:23 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/decls.scm,v 1.18 1987/07/15 02:59:48 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
"rgstmt" "rlife" "rtlgen")
(filename/append "back-end" "lapgn1" "lapgn2" "lapgn3")))
+(define filenames/dependency-chain/bits
+ (filename/append "back-end" "symtab" "bitutl" "bittop"))
+
(file-dependency/integration/chain
(reverse
(append filenames/dependency-chain/base
filenames/dependency-chain/rcse)))
-(file-dependency/integration/join
- (filename/append "back-end" "laptop")
- (filename/append "back-end" "symtab" "block"))
+(file-dependency/integration/chain
+ (reverse filenames/dependency-chain/bits))
(file-dependency/integration/join filenames/dependency-group/base
filenames/dependency-chain/base)
"rcsesa" "rdeath" "rdebug" "rgcomb" "rgpcom" "rgpred"
"rgproc" "rgrval" "rgstmt" "rlife" "rtlgen")
(filename/append "back-end"
- "asmmac" "block" "insseq" "lapgn1" "lapgn2" "lapgn3"
- "laptop" "regmap" "symtab" "syntax")
+ "asmmac" "bittop" "bitutl" "insseq" "lapgn1" "lapgn2"
+ "lapgn3" "regmap" "symtab" "syntax")
(filename/append "machines/bobcat" "insmac" "machin"))
compiler-syntax-table)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.30 1987/07/08 22:10:08 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.31 1987/07/15 03:00:15 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
(make-environment
(define :name "Liar (Bobcat 68020)")
(define :version 1)
- (define :modification 30)
+ (define :modification 31)
(define :files)
; (parse-rcs-header
-; "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.30 1987/07/08 22:10:08 jinx Exp $"
+; "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.31 1987/07/15 03:00:15 jinx Exp $"
; (lambda (filename version date time zone author state)
; (set! :version (car version))
; (set! :modification (cadr version))))
(cons bit-package
'("machines/bobcat/assmd.bin" ;Machine dependent
"back-end/symtab.bin" ;Symbol tables
- "back-end/block.bin" ;Assembly blocks
- "back-end/laptop.bin" ;Assembler top level
+ "back-end/bitutl.bin" ;Assembly blocks
+ "back-end/bittop.bin" ;Assembler top level
))
))
projects / mit-scheme.git / commitdiff