From: Guillermo J. Rozas Date: Wed, 15 Jul 1987 03:00:15 +0000 (+0000) Subject: Add branch tensioning assembler. X-Git-Tag: 20090517-FFI~13257 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=36a34c541d3ace9345a5728b85befccc880c0d42;p=mit-scheme.git Add branch tensioning assembler. --- diff --git a/v7/src/compiler/back/symtab.scm b/v7/src/compiler/back/symtab.scm index d039705ce..5822b95d2 100644 --- a/v7/src/compiler/back/symtab.scm +++ b/v7/src/compiler/back/symtab.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -39,29 +39,15 @@ MIT in each case. |# (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) @@ -70,24 +56,19 @@ MIT in each case. |# (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)) diff --git a/v7/src/compiler/back/syntax.scm b/v7/src/compiler/back/syntax.scm index 9eb1bbb13..d83f58f14 100644 --- a/v7/src/compiler/back/syntax.scm +++ b/v7/src/compiler/back/syntax.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -45,20 +45,6 @@ MIT in each case. |# 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) @@ -93,7 +79,7 @@ MIT in each case. |# (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 diff --git a/v7/src/compiler/machines/bobcat/decls.scm b/v7/src/compiler/machines/bobcat/decls.scm index 90a81efc2..bb97bacbe 100644 --- a/v7/src/compiler/machines/bobcat/decls.scm +++ b/v7/src/compiler/machines/bobcat/decls.scm @@ -1,6 +1,6 @@ #| -*-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 @@ -92,14 +92,16 @@ MIT in each case. |# "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) @@ -180,8 +182,8 @@ MIT in each case. |# "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) diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040 index 5617ec5a1..f3c7d117e 100644 --- a/v7/src/compiler/machines/bobcat/make.scm-68040 +++ b/v7/src/compiler/machines/bobcat/make.scm-68040 @@ -1,6 +1,6 @@ #| -*-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 @@ -46,11 +46,11 @@ MIT in each case. |# (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)))) @@ -163,8 +163,8 @@ MIT in each case. |# (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 )) ))