Add the INTERNAL-APPLY-VAL return code.
authorGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Mon, 29 Jan 1990 21:30:36 +0000 (21:30 +0000)
committerGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Mon, 29 Jan 1990 21:30:36 +0000 (21:30 +0000)
v7/src/compiler/machines/spectrum/compiler.pkg [new file with mode: 0644]
v7/src/compiler/machines/spectrum/compiler.sf [new file with mode: 0644]

diff --git a/v7/src/compiler/machines/spectrum/compiler.pkg b/v7/src/compiler/machines/spectrum/compiler.pkg
new file mode 100644 (file)
index 0000000..25ea2ea
--- /dev/null
@@ -0,0 +1,641 @@
+#| -*-Scheme-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/compiler.pkg,v 1.27 1990/01/29 21:30:36 jinx Exp $
+$MC68020-Header: comp.pkg,v 1.27 90/01/22 23:45:02 GMT cph Exp $
+
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. |#
+
+;;;; Compiler Packaging
+\f
+(global-definitions "../runtime/runtim")
+
+(define-package (compiler)
+  (files "machines/spectrum/switch"
+        "base/hashtb"
+        "base/object"                  ;tagged object support
+        "base/enumer"                  ;enumerations
+        "base/sets"                    ;set abstraction
+        "base/mvalue"                  ;multiple-value support
+        "base/scode"                   ;SCode abstraction
+        "machines/spectrum/machin"     ;machine dependent stuff
+        "base/utils"                   ;odds and ends
+
+        "base/cfg1"                    ;control flow graph
+        "base/cfg2"
+        "base/cfg3"
+
+        "base/ctypes"                  ;CFG datatypes
+
+        "base/rvalue"                  ;Right hand values
+        "base/lvalue"                  ;Left hand values
+        "base/blocks"                  ;rvalue: blocks
+        "base/proced"                  ;rvalue: procedures
+        "base/contin"                  ;rvalue: continuations
+
+        "base/subprb"                  ;subproblem datatype
+
+        "rtlbase/rgraph"               ;program graph abstraction
+        "rtlbase/rtlty1"               ;RTL: type definitions
+        "rtlbase/rtlty2"               ;RTL: type definitions
+        "rtlbase/rtlexp"               ;RTL: expression operations
+        "rtlbase/rtlcon"               ;RTL: complex constructors
+        "rtlbase/rtlreg"               ;RTL: registers
+        "rtlbase/rtlcfg"               ;RTL: CFG types
+        "rtlbase/rtlobj"               ;RTL: CFG objects
+        "rtlbase/regset"               ;RTL: register sets
+        "rtlbase/valclass"             ;RTL: value classes
+
+        "back/insseq"                  ;LAP instruction sequences
+        )
+  (parent ())
+  (export ()
+         compiler:analyze-side-effects?
+         compiler:cache-free-variables?
+         compiler:code-compression?
+         compiler:compile-by-procedures?
+         compiler:cse?
+         compiler:default-top-level-declarations
+         compiler:enable-expansion-declarations?
+         compiler:enable-integration-declarations?
+         compiler:generate-lap-files?
+         compiler:generate-range-checks?
+         compiler:generate-rtl-files?
+         compiler:generate-type-checks?
+         compiler:implicit-self-static?
+         compiler:open-code-flonum-checks?
+         compiler:open-code-primitives?
+         compiler:optimize-environments?
+         compiler:package-optimization-level
+         compiler:preserve-data-structures?
+         compiler:show-phases?
+         compiler:show-procedures?
+         compiler:show-subphases?
+         compiler:show-time-reports?))
+\f
+(define-package (compiler reference-contexts)
+  (files "base/refctx")
+  (parent (compiler))
+  (export (compiler)
+         add-reference-context/adjacent-parents!
+         initialize-reference-contexts!
+         make-reference-context
+         modify-reference-contexts!
+         reference-context/adjacent-parent?
+         reference-context/block
+         reference-context/offset
+         reference-context/procedure
+         reference-context?
+         set-reference-context/offset!))
+
+(define-package (compiler balanced-binary-tree)
+  (files "base/btree")
+  (parent (compiler))
+  (export (compiler)
+         btree-delete!
+         btree-fringe
+         btree-insert!
+         btree-lookup
+         make-btree))
+
+(define-package (compiler macros)
+  (files "base/macros")
+  (parent ())
+  (export (compiler)
+         assembler-syntax-table
+         compiler-syntax-table
+         early-syntax-table
+         lap-generator-syntax-table)
+  (import (runtime macros)
+         parse-define-syntax)
+  (initialization (initialize-package!)))
+
+(define-package (compiler declarations)
+  (files "machines/spectrum/decls")
+  (parent (compiler))
+  (export (compiler)
+         sc
+         syntax-files!)
+  (import (scode-optimizer top-level)
+         sf/internal)
+  (initialization (initialize-package!)))
+
+(define-package (compiler top-level)
+  (files "base/toplev"
+        "base/crstop")
+  (parent (compiler))
+  (export ()
+         cf
+         compile-bin-file
+         compile-procedure
+         compiler:reset!
+         cross-compile-bin-file
+         cross-compile-bin-file-end)
+  (export (compiler fg-generator)
+         compile-recursively)
+  (export (compiler rtl-generator)
+         *ic-procedure-headers*
+         *rtl-continuations*
+         *rtl-expression*
+         *rtl-graphs*
+         *rtl-procedures*)
+  (export (compiler lap-syntaxer)
+         *block-label*
+         *external-labels*
+         label->object)
+  (export (compiler debug)
+         *root-expression*
+         *rtl-procedures*
+         *rtl-graphs*)
+  (import (runtime compiler-info)
+         make-dbg-info-vector)
+  (import (runtime unparser)
+         *unparse-uninterned-symbols-by-name?*))
+\f
+(define-package (compiler debug)
+  (files "base/debug")
+  (parent (compiler))
+  (export ()
+         debug/find-continuation
+         debug/find-entry-node
+         debug/find-procedure
+         debug/where
+         dump-rtl
+         po
+         show-bblock-rtl
+         show-fg
+         show-fg-node
+         show-rtl
+         write-rtl-instructions)
+  (import (runtime pretty-printer)
+         *pp-primitives-by-name*))
+
+(define-package (compiler pattern-matcher/lookup)
+  (files "base/pmlook")
+  (parent (compiler))
+  (export (compiler)
+         make-pattern-variable
+         pattern-lookup
+         pattern-variable-name
+         pattern-variable?
+         pattern-variables))
+
+(define-package (compiler pattern-matcher/parser)
+  (files "base/pmpars")
+  (parent (compiler))
+  (export (compiler)
+         parse-rule
+         rule-result-expression)
+  (export (compiler macros)
+         parse-rule
+         rule-result-expression))
+
+(define-package (compiler pattern-matcher/early)
+  (files  "base/pmerly")
+  (parent (compiler))
+  (export (compiler)
+         early-parse-rule
+         early-pattern-lookup
+         early-make-rule
+         make-database-transformer
+         make-symbol-transformer
+         make-bit-mask-transformer))
+\f
+(define-package (compiler debugging-information)
+  (files "base/infnew")
+  (parent (compiler))
+  (export (compiler top-level)
+         info-generation-phase-1
+         info-generation-phase-2
+         info-generation-phase-3)
+  (export (compiler rtl-generator)
+         generated-dbg-continuation)
+  (import (runtime compiler-info)
+         make-dbg-info
+
+         make-dbg-expression
+         dbg-expression/block
+         dbg-expression/label
+         set-dbg-expression/label!
+
+         make-dbg-procedure
+         dbg-procedure/block
+         dbg-procedure/label
+         set-dbg-procedure/label!
+         dbg-procedure/name
+         dbg-procedure/required
+         dbg-procedure/optional
+         dbg-procedure/rest
+         dbg-procedure/auxiliary
+         dbg-procedure/external-label
+         set-dbg-procedure/external-label!
+         dbg-procedure<?
+
+         make-dbg-continuation
+         dbg-continuation/block
+         dbg-continuation/label
+         set-dbg-continuation/label!
+         dbg-continuation<?
+
+         make-dbg-block
+         dbg-block/parent
+         dbg-block/layout
+         dbg-block/stack-link
+         set-dbg-block/procedure!
+
+         make-dbg-variable
+         dbg-variable/value
+         set-dbg-variable/value!
+
+         dbg-block-name/dynamic-link
+         dbg-block-name/ic-parent
+         dbg-block-name/normal-closure
+         dbg-block-name/return-address
+         dbg-block-name/static-link
+
+         make-dbg-label-2
+         dbg-label/offset
+         set-dbg-label/external?!))
+
+(define-package (compiler constraints)
+   (files "base/constr")
+   (parent (compiler))
+   (export (compiler)
+          make-constraint
+          constraint/element
+          constraint/graph-head
+          constraint/afters
+          constraint/closed?
+          constraint-add!
+          add-constraint-element!
+          add-constraint-set!
+          make-constraint-graph
+          constraint-graph/entry-nodes
+          constraint-graph/closed?
+          close-constraint-graph!
+          close-constraint-node!
+          order-per-constraints
+          order-per-constraints/extracted
+          legal-ordering-per-constraints?
+          with-new-constraint-marks
+          constraint-marked?
+          constraint-mark!
+          transitively-close-dag!
+          reverse-postorder))
+\f
+(define-package (compiler fg-generator)
+  (files "fggen/canon"                 ;SCode canonicalizer
+        "fggen/fggen"                  ;SCode->flow-graph converter
+        "fggen/declar"                 ;Declaration handling
+        )
+  (parent (compiler))
+  (export (compiler top-level)
+         canonicalize/top-level
+         construct-graph)
+  (import (runtime scode-data)
+         &pair-car
+         &pair-cdr
+         &triple-first
+         &triple-second
+         &triple-third))
+
+(define-package (compiler fg-optimizer)
+  (files "fgopt/outer"                 ;outer analysis
+        "fgopt/sideff"                 ;side effect analysis
+        )
+  (parent (compiler))
+  (export (compiler top-level)
+         clear-call-graph!
+         compute-call-graph!
+         outer-analysis
+         side-effect-analysis))
+
+(define-package (compiler fg-optimizer fold-constants)
+  (files "fgopt/folcon")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level) fold-constants))
+
+(define-package (compiler fg-optimizer operator-analysis)
+  (files "fgopt/operan")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level) operator-analysis))
+
+(define-package (compiler fg-optimizer variable-indirection)
+  (files "fgopt/varind")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level) initialize-variable-indirections!))
+
+(define-package (compiler fg-optimizer environment-optimization)
+  (files "fgopt/envopt")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level) optimize-environments!))
+
+(define-package (compiler fg-optimizer closure-analysis)
+  (files "fgopt/closan")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level) identify-closure-limits!))
+
+(define-package (compiler fg-optimizer continuation-analysis)
+  (files "fgopt/contan")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level)
+         continuation-analysis
+         setup-block-static-links!))
+
+(define-package (compiler fg-optimizer compute-node-offsets)
+  (files "fgopt/offset")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level) compute-node-offsets))
+\f
+(define-package (compiler fg-optimizer connectivity-analysis)
+  (files "fgopt/conect")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level) connectivity-analysis))
+
+(define-package (compiler fg-optimizer delete-integrated-parameters)
+  (files "fgopt/delint")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level) delete-integrated-parameters))
+
+(define-package (compiler fg-optimizer design-environment-frames)
+  (files "fgopt/desenv")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level) design-environment-frames!))
+
+(define-package (compiler fg-optimizer setup-block-types)
+  (files "fgopt/blktyp")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level)
+         setup-block-types!
+         setup-closure-contexts!))
+
+(define-package (compiler fg-optimizer simplicity-analysis)
+  (files "fgopt/simple")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level) simplicity-analysis)
+  (export (compiler fg-optimizer subproblem-ordering)
+         new-subproblem/compute-simplicity!))
+
+(define-package (compiler fg-optimizer simulate-application)
+  (files "fgopt/simapp")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level) simulate-application))
+
+(define-package (compiler fg-optimizer subproblem-free-variables)
+  (files "fgopt/subfre")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level) compute-subproblem-free-variables)
+  (export (compiler fg-optimizer) map-union)
+  (export (compiler fg-optimizer subproblem-ordering)
+         new-subproblem/compute-free-variables!))
+
+(define-package (compiler fg-optimizer subproblem-ordering)
+  (files "fgopt/order")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level) subproblem-ordering))
+
+(define-package (compiler fg-optimizer subproblem-ordering reuse-frames)
+  (files "fgopt/reord" "fgopt/reuse")
+  (parent (compiler fg-optimizer subproblem-ordering))
+  (export (compiler top-level) setup-frame-adjustments)
+  (export (compiler fg-optimizer subproblem-ordering)
+         order-subproblems/maybe-overwrite-block))
+
+(define-package (compiler fg-optimizer subproblem-ordering parameter-analysis)
+   (files "fgopt/param")
+   (parent (compiler fg-optimizer subproblem-ordering))
+   (export (compiler fg-optimizer subproblem-ordering)
+          parameter-analysis))
+
+(define-package (compiler fg-optimizer return-equivalencing)
+  (files "fgopt/reteqv")
+  (parent (compiler fg-optimizer))
+  (export (compiler top-level) find-equivalent-returns!))
+\f
+(define-package (compiler rtl-generator)
+  (files "rtlgen/rtlgen"               ;RTL generator
+        "rtlgen/rgstmt"                ;statements
+        "rtlgen/fndvar"                ;find variables
+        "machines/spectrum/rgspcm"     ;special close-coded primitives
+        "rtlbase/rtline"               ;linearizer
+        )
+  (parent (compiler))
+  (export (compiler)
+         make-linearizer)
+  (export (compiler top-level)
+         generate/top-level
+         linearize-rtl
+         setup-bblock-continuations!)
+  (export (compiler debug)
+         linearize-rtl)
+  (import (compiler top-level)
+         label->object))
+
+(define-package (compiler rtl-generator generate/procedure-header)
+  (files "rtlgen/rgproc")
+  (parent (compiler rtl-generator))
+  (export (compiler rtl-generator) generate/procedure-header))
+
+(define-package (compiler rtl-generator combination/inline)
+  (files "rtlgen/opncod")
+  (parent (compiler rtl-generator))
+  (export (compiler rtl-generator) combination/inline)
+  (export (compiler top-level) open-coding-analysis))
+
+(define-package (compiler rtl-generator find-block)
+  (files "rtlgen/fndblk")
+  (parent (compiler rtl-generator))
+  (export (compiler rtl-generator) find-block))
+
+(define-package (compiler rtl-generator generate/rvalue)
+  (files "rtlgen/rgrval")
+  (parent (compiler rtl-generator))
+  (export (compiler rtl-generator)
+         generate/rvalue
+         load-closure-environment
+         make-ic-cons
+         make-non-trivial-closure-cons
+         make-trivial-closure-cons))
+
+(define-package (compiler rtl-generator generate/combination)
+  (files "rtlgen/rgcomb")
+  (parent (compiler rtl-generator))
+  (export (compiler rtl-generator)
+         generate/combination)
+  (export (compiler rtl-generator combination/inline)
+         generate/invocation-prefix))
+
+(define-package (compiler rtl-generator generate/return)
+  (files "rtlgen/rgretn")
+  (parent (compiler rtl-generator))
+  (export (compiler rtl-generator)
+         make-return-operand
+         generate/return
+         generate/return*
+         generate/trivial-return))
+\f
+(define-package (compiler rtl-cse)
+  (files "rtlopt/rcse1"                        ;RTL common subexpression eliminator
+        "rtlopt/rcse2"
+        "rtlopt/rcseep"                ;CSE expression predicates
+        "rtlopt/rcseht"                ;CSE hash table
+        "rtlopt/rcserq"                ;CSE register/quantity abstractions
+        "rtlopt/rcsesr"                ;CSE stack references
+        )
+  (parent (compiler))
+  (export (compiler top-level) common-subexpression-elimination))
+
+(define-package (compiler rtl-optimizer)
+  (files "rtlopt/rdebug")
+  (parent (compiler)))
+
+(define-package (compiler rtl-optimizer invertible-expression-elimination)
+  (files "rtlopt/rinvex")
+  (parent (compiler rtl-optimizer))
+  (export (compiler top-level) invertible-expression-elimination))
+
+(define-package (compiler rtl-optimizer common-suffix-merging)
+  (files "rtlopt/rtlcsm")
+  (parent (compiler rtl-optimizer))
+  (export (compiler top-level) merge-common-suffixes!))
+
+(define-package (compiler rtl-optimizer rtl-dataflow-analysis)
+  (files "rtlopt/rdflow")
+  (parent (compiler rtl-optimizer))
+  (export (compiler top-level) rtl-dataflow-analysis))
+
+(define-package (compiler rtl-optimizer rtl-rewriting)
+  (files "rtlopt/rerite")
+  (parent (compiler rtl-optimizer))
+  (export (compiler top-level)
+         rtl-rewriting:post-cse
+         rtl-rewriting:pre-cse)
+  (export (compiler lap-syntaxer) add-rewriting-rule!))
+
+(define-package (compiler rtl-optimizer lifetime-analysis)
+  (files "rtlopt/rlife")
+  (parent (compiler rtl-optimizer))
+  (export (compiler top-level) lifetime-analysis)
+  (export (compiler rtl-optimizer code-compression) mark-set-registers!))
+
+(define-package (compiler rtl-optimizer code-compression)
+  (files "rtlopt/rcompr")
+  (parent (compiler rtl-optimizer))
+  (export (compiler top-level) code-compression))
+
+(define-package (compiler rtl-optimizer register-allocation)
+  (files "rtlopt/ralloc")
+  (parent (compiler rtl-optimizer))
+  (export (compiler top-level) register-allocation))
+\f
+(define-package (compiler lap-syntaxer)
+  (files "back/lapgn1"                 ;LAP generator
+        "back/lapgn2"                  ; "      "
+        "back/lapgn3"                  ; "      "
+        "back/regmap"                  ;Hardware register allocator
+        "machines/spectrum/lapgen"     ;code generation rules
+        "machines/spectrum/rules1"     ;  "      "        "
+        "machines/spectrum/rules2"     ;  "      "        "
+        "machines/spectrum/rules3"     ;  "      "        "
+        "machines/spectrum/rules4"     ;  "      "        "
+        "machines/spectrum/rulfix"     ;  "      "        "
+        "machines/spectrum/rulflo"     ;  "      "        "
+        "machines/spectrum/rulrew"     ;code rewriting rules
+        "back/syntax"                  ;Generic syntax phase
+        "back/syerly"                  ;Early binding version
+        "machines/spectrum/coerce"     ;Coercions: integer -> bit string
+        "back/asmmac"                  ;Macros for hairy syntax
+        "machines/spectrum/insmac"     ;Macros for hairy syntax
+        "machines/spectrum/inerly"     ;Early binding version
+        "machines/spectrum/instr1"     ;Spectrum instruction utilities
+        "machines/spectrum/instr2"     ;Spectrum instructions
+        "machines/spectrum/instr3"     ;  "        "
+        )
+  (parent (compiler))
+  (export (compiler)
+         fits-in-5-bits-signed?
+         lap-generator/match-rtl-instruction
+         lap:make-entry-point
+         lap:make-label-statement
+         lap:make-unconditional-branch
+         lap:syntax-instruction)
+  (export (compiler top-level)
+         *interned-assignments*
+         *interned-constants*
+         *interned-uuo-links*
+         *interned-variables*
+         *next-constant*
+         generate-lap)
+  (import (scode-optimizer expansion)
+         scode->scode-expander))
+
+(define-package (compiler lap-syntaxer map-merger)
+  (files "back/mermap")
+  (parent (compiler lap-syntaxer))
+  (export (compiler lap-syntaxer)
+         merge-register-maps))
+
+(define-package (compiler lap-syntaxer linearizer)
+  (files "back/linear")
+  (parent (compiler lap-syntaxer))
+  (export (compiler lap-syntaxer)
+         linearize-lap
+         bblock-linearize-lap)
+  (export (compiler top-level)
+         linearize-lap))
+
+(define-package (compiler assembler)
+  (files "machines/spectrum/assmd"     ;Machine dependent
+        "back/symtab"                  ;Symbol tables
+        "back/bitutl"                  ;Assembly blocks
+        "back/bittop"                  ;Assembler top level
+        )
+  (parent (compiler))
+  (export (compiler)
+         instruction-append)
+  (export (compiler top-level)
+         assemble))
+
+(define-package (compiler disassembler)
+  (files "machines/spectrum/dassm1"
+        "machines/spectrum/dassm2"
+        "machines/spectrum/dassm3")
+  (parent (compiler))
+  (export ()
+         compiler:write-lap-file
+         compiler:disassemble)
+  (import (runtime compiler-info)
+         compiled-code-block/dbg-info
+         dbg-info-vector/blocks-vector
+         dbg-info-vector?
+         dbg-info/labels
+         dbg-label/external?
+         dbg-label/name
+         dbg-labels/find-offset))
\ No newline at end of file
diff --git a/v7/src/compiler/machines/spectrum/compiler.sf b/v7/src/compiler/machines/spectrum/compiler.sf
new file mode 100644 (file)
index 0000000..80729c8
--- /dev/null
@@ -0,0 +1,110 @@
+#| -*-Scheme-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/compiler.sf,v 1.11 1990/01/29 21:29:59 jinx Exp $
+$MC68020-Header: comp.sf,v 1.11 89/08/28 18:33:37 GMT cph Exp $
+
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. |#
+
+;;;; Script to incrementally syntax the compiler
+\f
+;; Guarantee that the package modeller is loaded.
+(if (not (name->package '(CROSS-REFERENCE)))
+    (with-working-directory-pathname "../cref" (lambda () (load "make"))))
+
+;; Guarantee that the compiler's package structure exists.
+(if (not (name->package '(COMPILER)))
+    (begin
+      ;; If there is no existing package constructor, generate one.
+      (if (not (file-exists? "comp.bcon"))
+         (begin
+           ((access cref/generate-trivial-constructor
+                    (->environment '(CROSS-REFERENCE)))
+            "comp")
+           (sf "comp.con" "comp.bcon")))
+      (load "comp.bcon")))
+
+;; Guarantee that the necessary syntactic transforms and optimizers
+;; are loaded.
+(if (lexical-unreferenceable? (->environment '(COMPILER)) 'SYNTAX-FILES!)
+    (let ((sf-and-load
+          (lambda (files package)
+            (sf-conditionally files)
+            (for-each (lambda (file)
+                        (load (string-append file ".bin") package))
+                      files))))
+      (write-string "\n\n---- Loading compile-time files ----")
+      (sf-and-load '("machines/spectrum/switch" "base/hashtb") '(COMPILER))
+      (sf-and-load '("base/macros") '(COMPILER MACROS))
+      ((access initialize-package! (->environment '(COMPILER MACROS))))
+      (sf-and-load '("machines/spectrum/decls") '(COMPILER DECLARATIONS))
+      (let ((environment (->environment '(COMPILER DECLARATIONS))))
+       (set! (access source-file-expression environment) "*.scm")
+       ((access initialize-package! environment)))
+      (sf-and-load '("base/pmlook") '(COMPILER PATTERN-MATCHER/LOOKUP))
+      (sf-and-load '("base/pmpars") '(COMPILER PATTERN-MATCHER/PARSER))
+      (fluid-let ((sf/default-syntax-table
+                  (access compiler-syntax-table
+                          (->environment '(COMPILER MACROS)))))
+       (sf-and-load '("machines/spectrum/machin") '(COMPILER)))
+      (fluid-let ((sf/default-declarations
+                  '((integrate-external "insseq")
+                    (integrate-external "machin")
+                    (usual-definition (set expt)))))
+       (sf-and-load '("machines/spectrum/assmd") '(COMPILER ASSEMBLER)))
+      (sf-and-load '("back/syntax") '(COMPILER LAP-SYNTAXER))
+      (sf-and-load '("machines/spectrum/coerce" "back/asmmac"
+                                             "machines/spectrum/insmac")
+                  '(COMPILER LAP-SYNTAXER))
+      (sf-and-load '("base/scode") '(COMPILER))
+      (sf-and-load '("base/pmerly") '(COMPILER PATTERN-MATCHER/EARLY))
+      (sf-and-load '("machines/spectrum/inerly" "back/syerly")
+                  '(COMPILER LAP-SYNTAXER))))
+
+;; Load the assembler instruction database.
+(in-package (->environment '(COMPILER LAP-SYNTAXER))
+  (if (and compiler:enable-expansion-declarations?
+          (null? early-instructions))
+      (fluid-let ((load-noisily? false)
+                 (load/suppress-loading-message? false))
+       (write-string "\n\n---- Pre-loading instruction sets ----")
+       (for-each (lambda (name)
+                   (load (string-append "machines/spectrum/" name ".scm")
+                         '(COMPILER LAP-SYNTAXER)
+                         early-syntax-table))
+                 '("instr1" "instr2" "instr3")))))
+
+;; Resyntax any files that need it.
+((access syntax-files! (->environment '(COMPILER))))
+
+;; Rebuild the package constructors and cref.
+(cref/generate-all "comp")
+(sf "comp.con" "comp.bcon")
+(sf "comp.ldr" "comp.bldr")
\ No newline at end of file