From: Guillermo J. Rozas Date: Thu, 13 Feb 1992 03:49:04 +0000 (+0000) Subject: Initial revision X-Git-Tag: 20090517-FFI~9775 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=423fe5e41542a4d37f4c5a18a8d8cfb45db6fdc0;p=mit-scheme.git Initial revision --- diff --git a/v7/src/compiler/machines/i386/compiler.cbf b/v7/src/compiler/machines/i386/compiler.cbf new file mode 100644 index 000000000..ecd1f2dec --- /dev/null +++ b/v7/src/compiler/machines/i386/compiler.cbf @@ -0,0 +1,45 @@ +#| -*-Scheme-*- + +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/compiler.cbf,v 1.1 1992/02/13 03:44:01 jinx Exp $ + +Copyright (c) 1992 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 compile the compiler (from .bins) + +(for-each compile-directory + '("back" + "base" + "fggen" + "fgopt" + "machines/i386" + "rtlbase" + "rtlgen" + "rtlopt")) \ No newline at end of file diff --git a/v7/src/compiler/machines/i386/compiler.pkg b/v7/src/compiler/machines/i386/compiler.pkg new file mode 100644 index 000000000..ad88f83cd --- /dev/null +++ b/v7/src/compiler/machines/i386/compiler.pkg @@ -0,0 +1,661 @@ +#| -*-Scheme-*- + +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/compiler.pkg,v 1.1 1992/02/13 03:42:37 jinx Exp $ +$MC68020-Header: /scheme/compiler/bobcat/RCS/comp.pkg,v 1.32 1991/05/06 23:09:24 jinx Exp $ + +Copyright (c) 1992 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 + +(global-definitions "../runtime/runtim") + +(define-package (compiler) + (files "base/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/i386/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:intersperse-rtl-in-lap? + compiler:noisy? + 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? + compiler:use-multiclosures?)) + +(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/i386/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 + compile-scode + 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?*)) + +(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*) + (import (runtime unparser) + *unparse-uninterned-symbols-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)) + +(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-procedureflow-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)) + +(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!) + (export (compiler) + indirection-block-procedure)) + +(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!)) + +(define-package (compiler rtl-generator) + (files "rtlgen/rtlgen" ;RTL generator + "rtlgen/rgstmt" ;statements + "rtlgen/fndvar" ;find variables + "machines/i386/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-cons-closure-indirection + make-cons-closure-redirection + make-closure-redirection + make-ic-cons + make-non-trivial-closure-cons + make-trivial-closure-cons + redirect-closure)) + +(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)) + +(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)) + +(define-package (compiler lap-syntaxer) + (files "back/lapgn1" ;LAP generator + "back/lapgn2" ; " " + "back/lapgn3" ; " " + "back/regmap" ;Hardware register allocator + "machines/i386/lapgen" ;code generation rules + "machines/i386/rules1" ; " " " + "machines/i386/rules2" ; " " " + "machines/i386/rules3" ; " " " + "machines/i386/rules4" ; " " " + "machines/i386/rulfix" ; " " " + "machines/i386/rulflo" ; " " " + "machines/i386/rulrew" ;code rewriting rules + "back/syntax" ;Generic syntax phase + "back/syerly" ;Early binding version + "machines/i386/coerce" ;Coercions: integer -> bit string + "back/asmmac" ;Macros for hairy syntax + "machines/i386/insmac" ;Macros for hairy syntax + "machines/i386/inerly" ;Early binding version + "machines/i386/instr1" ;i386 instruction utilities + "machines/i386/instr2" ;i386 instructions + "machines/i386/instrf" ; " " + ) + (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-global-links* + *interned-uuo-links* + *interned-static-variables* + *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 lap-optimizer) + (files "machines/i386/lapopt") + (parent (compiler)) + (export (compiler top-level) + optimize-linear-lap)) + +(define-package (compiler assembler) + (files "machines/i386/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/i386/dassm1" + "machines/i386/dassm2" + "machines/i386/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/i386/compiler.sf b/v7/src/compiler/machines/i386/compiler.sf new file mode 100644 index 000000000..7f7ebdf2e --- /dev/null +++ b/v7/src/compiler/machines/i386/compiler.sf @@ -0,0 +1,109 @@ +#| -*-Scheme-*- + +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/compiler.sf,v 1.1 1992/02/13 03:45:13 jinx Exp $ + +Copyright (c) 1992 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 + +;; 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 '("base/switch" "base/hashtb") '(COMPILER)) + (sf-and-load '("base/macros") '(COMPILER MACROS)) + ((access initialize-package! (->environment '(COMPILER MACROS)))) + (sf-and-load '("machines/i386/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/i386/machin") '(COMPILER))) + (fluid-let ((sf/default-declarations + '((integrate-external "insseq") + (integrate-external "machin") + (usual-definition (set expt))))) + (sf-and-load '("machines/i386/assmd") '(COMPILER ASSEMBLER))) + (sf-and-load '("back/syntax") '(COMPILER LAP-SYNTAXER)) + (sf-and-load '("machines/i386/coerce" "back/asmmac" + "machines/i386/insmac") + '(COMPILER LAP-SYNTAXER)) + (sf-and-load '("base/scode") '(COMPILER)) + (sf-and-load '("base/pmerly") '(COMPILER PATTERN-MATCHER/EARLY)) + (sf-and-load '("machines/i386/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/i386/" name ".scm") + '(COMPILER LAP-SYNTAXER) + early-syntax-table)) + '("instr1" "instr2" "instrf"))))) + +;; Resyntax any files that need it. +((access syntax-files! (->environment '(COMPILER)))) + +;; Rebuild the package constructors and cref. +(cref/generate-constructors "comp") +(sf "comp.con" "comp.bcon") +(sf "comp.ldr" "comp.bldr") \ No newline at end of file diff --git a/v7/src/compiler/machines/i386/dassm2.scm b/v7/src/compiler/machines/i386/dassm2.scm new file mode 100644 index 000000000..6fd719696 --- /dev/null +++ b/v7/src/compiler/machines/i386/dassm2.scm @@ -0,0 +1,146 @@ +#| -*-Scheme-*- + +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/dassm2.scm,v 1.1 1992/02/13 03:36:26 jinx Exp $ +$MC68020-Header: /scheme/compiler/bobcat/RCS/dassm2.scm,v 4.18 1991/05/07 13:46:04 jinx Exp $ + +Copyright (c) 1992 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. |# + +;;;; Intel i386 Disassembler: Top Level +;;; package: (compiler disassembler) + +(declare (usual-integrations)) + +(define-integrable compiled-code-block/bytes-per-object 4) +(define-integrable compiled-code-block/objects-per-procedure-cache 2) +(define-integrable compiled-code-block/objects-per-variable-cache 1) +(define-integrable compiled-code-block/procedure-cache-offset 1) + +(define (disassembler/read-variable-cache block index) + (let-syntax ((ucode-type + (macro (name) (microcode-type name))) + (ucode-primitive + (macro (name arity) + (make-primitive-procedure name arity)))) + ((ucode-primitive primitive-object-set-type 2) + (ucode-type quad) + (system-vector-ref block index)))) + +(define (disassembler/read-procedure-cache block index) + block index ; ignored + (error "disassembler/read-procedure-cache: Not yet written")) + +(define (disassembler/instructions block start-offset end-offset symbol-table) + (let loop ((offset start-offset) (state (disassembler/initial-state))) + (if (and end-offset (< offset end-offset)) + (disassemble-one-instruction block offset symbol-table state + (lambda (offset* instruction state) + (make-instruction offset + instruction + (lambda () (loop offset* state))))) + '()))) + +(define-integrable (disassembler/instructions/null? obj) + (null? obj)) + +(define (disassembler/instructions/read instruction-stream receiver) + (receiver (instruction-offset instruction-stream) + (instruction-instruction instruction-stream) + (instruction-next instruction-stream)))) + +(define-structure (instruction (type vector)) + (offset false read-only true) + (instruction false read-only true) + (next false read-only true)) + +(define *block) +(define *current-offset) +(define *symbol-table) +(define *ir) +(define *valid?) + +(define (disassemble-one-instruction block offset symbol-table state receiver) + block offset symbol-table state receiver ; ignored + (error "disassemble-one-instruction: Not yet written")) + +(define (disassembler/initial-state) + 'INSTRUCTION-NEXT) + +(define (disassembler/next-state instruction state) + instruction state ; ignored + (error "disassembler/next-state: Not yet written")) + +(define (disassembler/lookup-symbol symbol-table offset) + (and symbol-table + (let ((label (dbg-labels/find-offset symbol-table offset))) + (and label + (dbg-label/name label))))) + +(define (external-label-marker? symbol-table offset state) + (if symbol-table + (let ((label (dbg-labels/find-offset symbol-table (+ offset 4)))) + (and label + (dbg-label/external? label))) + (and *block + (not (eq? state 'INSTRUCTION)) + (let loop ((offset (+ offset 4))) + (let ((contents (read-bits (- offset 2) 16))) + (if (bit-string-clear! contents 0) + (let ((offset + (- offset (bit-string->unsigned-integer contents)))) + (and (positive? offset) + (loop offset))) + (= offset (bit-string->unsigned-integer contents)))))))) + +(define (read-procedure offset) + (with-absolutely-no-interrupts + (lambda () + (let-syntax ((ucode-type + (macro (name) (microcode-type name))) + (ucode-primitive + (macro (name arity) + (make-primitive-procedure name arity)))) + ((ucode-primitive primitive-object-set-type 2) + (ucode-type compiled-entry) + ((ucode-primitive make-non-pointer-object 1) + (read-unsigned-integer offset 32))))))) + +(define (read-unsigned-integer offset size) + (bit-string->unsigned-integer (read-bits offset size))) + +(define (read-bits offset size-in-bits) + (let ((word (bit-string-allocate size-in-bits)) + (bit-offset (* offset addressing-granularity))) + (with-absolutely-no-interrupts + (lambda () + (if *block + (read-bits! *block bit-offset word) + (read-bits! offset 0 word)))) + word)) \ No newline at end of file diff --git a/v7/src/compiler/machines/i386/dassm3.scm b/v7/src/compiler/machines/i386/dassm3.scm new file mode 100644 index 000000000..2892c94a8 --- /dev/null +++ b/v7/src/compiler/machines/i386/dassm3.scm @@ -0,0 +1,40 @@ +#| -*-Scheme-*- + +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/dassm3.scm,v 1.1 1992/02/13 03:38:52 jinx Exp $ + +Copyright (c) 1992 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. |# + +;;;; Intel i386 Disassembler: Internals +;;; package: (compiler disassembler) + +(declare (usual-integrations)) + +'NOT-YET-WRITTEN \ No newline at end of file diff --git a/v7/src/compiler/machines/i386/decls.scm b/v7/src/compiler/machines/i386/decls.scm new file mode 100644 index 000000000..f61823b42 --- /dev/null +++ b/v7/src/compiler/machines/i386/decls.scm @@ -0,0 +1,631 @@ +#| -*-Scheme-*- + +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/decls.scm,v 1.1 1992/02/13 03:49:04 jinx Exp $ +$MC68020-Header: decls.scm,v 4.27 90/05/03 15:17:08 GMT jinx Exp $ + +Copyright (c) 1992 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 File Dependencies + +(declare (usual-integrations)) + +(define (initialize-package!) + (add-event-receiver! event:after-restore reset-source-nodes!) + (reset-source-nodes!)) + +(define (reset-source-nodes!) + (set! source-filenames '()) + (set! source-hash) + (set! source-nodes) + (set! source-nodes/by-rank)) + +(define (maybe-setup-source-nodes!) + (if (null? source-filenames) + (setup-source-nodes!))) + +(define (setup-source-nodes!) + (let ((filenames + (append-map! + (lambda (subdirectory) + (map (lambda (pathname) + (string-append subdirectory + "/" + (pathname-name pathname))) + (directory-read + (string-append subdirectory + "/" + source-file-expression)))) + '("back" "base" "fggen" "fgopt" "rtlbase" "rtlgen" "rtlopt" + "machines/i386")))) + (if (null? filenames) + (error "Can't find source files of compiler")) + (set! source-filenames filenames)) + (set! source-hash + (make/hash-table + 101 + string-hash-mod + (lambda (filename source-node) + (string=? filename (source-node/filename source-node))) + make/source-node)) + (set! source-nodes + (map (lambda (filename) + (hash-table/intern! source-hash + filename + identity-procedure + identity-procedure)) + source-filenames)) + (initialize/syntax-dependencies!) + (initialize/integration-dependencies!) + (initialize/expansion-dependencies!) + (source-nodes/rank!)) + +(define source-file-expression "*.scm") +(define source-filenames) +(define source-hash) +(define source-nodes) +(define source-nodes/by-rank) + +(define (filename/append directory . names) + (map (lambda (name) (string-append directory "/" name)) names)) + +(define-structure (source-node + (conc-name source-node/) + (constructor make/source-node (filename))) + (filename false read-only true) + (pathname (->pathname filename) read-only true) + (forward-links '()) + (backward-links '()) + (forward-closure '()) + (backward-closure '()) + (dependencies '()) + (dependents '()) + (rank false) + (syntax-table false) + (declarations '()) + (modification-time false)) + +(define (filename->source-node filename) + (hash-table/lookup source-hash + filename + identity-procedure + (lambda () (error "Unknown source file" filename)))) + +(define (source-node/circular? node) + (memq node (source-node/backward-closure node))) + +(define (source-node/link! node dependency) + (if (not (memq dependency (source-node/backward-links node))) + (begin + (set-source-node/backward-links! + node + (cons dependency (source-node/backward-links node))) + (set-source-node/forward-links! + dependency + (cons node (source-node/forward-links dependency))) + (source-node/close! node dependency)))) + +(define (source-node/close! node dependency) + (if (not (memq dependency (source-node/backward-closure node))) + (begin + (set-source-node/backward-closure! + node + (cons dependency (source-node/backward-closure node))) + (set-source-node/forward-closure! + dependency + (cons node (source-node/forward-closure dependency))) + (for-each (lambda (dependency) + (source-node/close! node dependency)) + (source-node/backward-closure dependency)) + (for-each (lambda (node) + (source-node/close! node dependency)) + (source-node/forward-closure node))))) + +;;;; Rank + +(define (source-nodes/rank!) + (compute-dependencies! source-nodes) + (compute-ranks! source-nodes) + (set! source-nodes/by-rank (source-nodes/sort-by-rank source-nodes))) + +(define (compute-dependencies! nodes) + (for-each (lambda (node) + (set-source-node/dependencies! + node + (list-transform-negative (source-node/backward-closure node) + (lambda (node*) + (memq node (source-node/backward-closure node*))))) + (set-source-node/dependents! + node + (list-transform-negative (source-node/forward-closure node) + (lambda (node*) + (memq node (source-node/forward-closure node*)))))) + nodes)) + +(define (compute-ranks! nodes) + (let loop ((nodes nodes) (unranked-nodes '())) + (if (null? nodes) + (if (not (null? unranked-nodes)) + (loop unranked-nodes '())) + (loop (cdr nodes) + (let ((node (car nodes))) + (let ((rank (source-node/rank* node))) + (if rank + (begin + (set-source-node/rank! node rank) + unranked-nodes) + (cons node unranked-nodes)))))))) + +(define (source-node/rank* node) + (let loop ((nodes (source-node/dependencies node)) (rank -1)) + (if (null? nodes) + (1+ rank) + (let ((rank* (source-node/rank (car nodes)))) + (and rank* + (loop (cdr nodes) (max rank rank*))))))) + +(define (source-nodes/sort-by-rank nodes) + (sort nodes (lambda (x y) (< (source-node/rank x) (source-node/rank y))))) + +;;;; File Syntaxer + +(define (syntax-files!) + (maybe-setup-source-nodes!) + (for-each + (lambda (node) + (let ((modification-time + (let ((source (modification-time node "scm")) + (binary (modification-time node "bin"))) + (if (not source) + (error "Missing source file" (source-node/filename node))) + (and binary (< source binary) binary)))) + (set-source-node/modification-time! node modification-time) + (if (not modification-time) + (begin (write-string "\nSource file newer than binary: ") + (write (source-node/filename node)))))) + source-nodes) + (if compiler:enable-integration-declarations? + (begin + (for-each + (lambda (node) + (let ((time (source-node/modification-time node))) + (if (and time + (there-exists? (source-node/dependencies node) + (lambda (node*) + (let ((newer? + (let ((time* + (source-node/modification-time node*))) + (or (not time*) + (> time* time))))) + (if newer? + (begin + (write-string "\nBinary file ") + (write (source-node/filename node)) + (write-string " newer than dependency ") + (write (source-node/filename node*)))) + newer?)))) + (set-source-node/modification-time! node false)))) + source-nodes) + (for-each + (lambda (node) + (if (not (source-node/modification-time node)) + (for-each (lambda (node*) + (if (source-node/modification-time node*) + (begin + (write-string "\nBinary file ") + (write (source-node/filename node*)) + (write-string " depends on ") + (write (source-node/filename node)))) + (set-source-node/modification-time! node* false)) + (source-node/forward-closure node)))) + source-nodes))) + (for-each (lambda (node) + (if (not (source-node/modification-time node)) + (pathname-delete! + (pathname-new-type (source-node/pathname node) "ext")))) + source-nodes/by-rank) + (write-string "\n\nBegin pass 1:") + (for-each (lambda (node) + (if (not (source-node/modification-time node)) + (source-node/syntax! node))) + source-nodes/by-rank) + (if (there-exists? source-nodes/by-rank + (lambda (node) + (and (not (source-node/modification-time node)) + (source-node/circular? node)))) + (begin + (write-string "\n\nBegin pass 2:") + (for-each (lambda (node) + (if (not (source-node/modification-time node)) + (if (source-node/circular? node) + (source-node/syntax! node) + (source-node/touch! node)))) + source-nodes/by-rank)))) + +(define (source-node/touch! node) + (with-values + (lambda () + (sf/pathname-defaulting (source-node/pathname node) "" false)) + (lambda (input-pathname bin-pathname spec-pathname) + input-pathname + (pathname-touch! bin-pathname) + (pathname-touch! (pathname-new-type bin-pathname "ext")) + (if spec-pathname (pathname-touch! spec-pathname))))) + +(define (pathname-touch! pathname) + (if (file-exists? pathname) + (begin + (write-string "\nTouch file: ") + (write (enough-namestring pathname)) + (file-touch pathname)))) + +(define (pathname-delete! pathname) + (if (file-exists? pathname) + (begin + (write-string "\nDelete file: ") + (write (enough-namestring pathname)) + (delete-file pathname)))) + +(define (sc filename) + (maybe-setup-source-nodes!) + (source-node/syntax! (filename->source-node filename))) + +(define (source-node/syntax! node) + (with-values + (lambda () + (sf/pathname-defaulting (source-node/pathname node) "" false)) + (lambda (input-pathname bin-pathname spec-pathname) + (sf/internal + input-pathname bin-pathname spec-pathname + (source-node/syntax-table node) + ((if compiler:enable-integration-declarations? + identity-procedure + (lambda (declarations) + (list-transform-negative declarations + integration-declaration?))) + ((if compiler:enable-expansion-declarations? + identity-procedure + (lambda (declarations) + (list-transform-negative declarations + expansion-declaration?))) + (source-node/declarations node))))))) + +(define-integrable (modification-time node type) + (file-modification-time + (pathname-new-type (source-node/pathname node) type))) + +;;;; Syntax dependencies + +(define (initialize/syntax-dependencies!) + (let ((file-dependency/syntax/join + (lambda (filenames syntax-table) + (for-each (lambda (filename) + (set-source-node/syntax-table! + (filename->source-node filename) + syntax-table)) + filenames)))) + (file-dependency/syntax/join + (append (filename/append "base" + "blocks" "cfg1" "cfg2" "cfg3" "constr" + "contin" "crstop" "ctypes" "debug" "enumer" + "infnew" "lvalue" "object" "pmerly" "proced" + "refctx" "rvalue" "scode" "sets" "subprb" + "switch" "toplev" "utils") + (filename/append "back" + "asmmac" "bittop" "bitutl" "insseq" "lapgn1" + "lapgn2" "lapgn3" "linear" "regmap" "symtab" + "syntax") + (filename/append "machines/i386" + "dassm1" "insmac" "lapopt" "machin" "rgspcm" + "rulrew") + (filename/append "fggen" + "declar" "fggen" "canon") + (filename/append "fgopt" + "blktyp" "closan" "conect" "contan" "delint" + "desenv" "envopt" "folcon" "offset" "operan" + "order" "outer" "param" "reord" "reteqv" "reuse" + "sideff" "simapp" "simple" "subfre" "varind") + (filename/append "rtlbase" + "regset" "rgraph" "rtlcfg" "rtlcon" "rtlexp" + "rtline" "rtlobj" "rtlreg" "rtlty1" "rtlty2" + "valclass") + (filename/append "rtlgen" + "fndblk" "fndvar" "opncod" "rgcomb" "rgproc" + "rgretn" "rgrval" "rgstmt" "rtlgen") + (filename/append "rtlopt" + "ralloc" "rcompr" "rcse1" "rcse2" "rcseep" + "rcseht" "rcserq" "rcsesr" "rdebug" "rdflow" + "rerite" "rinvex" "rlife" "rtlcsm")) + compiler-syntax-table) + (file-dependency/syntax/join + (filename/append "machines/i386" + "lapgen" + "rules1" "rules2" "rules3" "rules4" "rulfix" "rulflo") + lap-generator-syntax-table) + (file-dependency/syntax/join + (filename/append "machines/i386" "insutl" "instr1" "instr2" "instrf") + assembler-syntax-table))) + +;;;; Integration Dependencies + +(define (initialize/integration-dependencies!) + + (define (add-declaration! declaration filenames) + (for-each (lambda (filenames) + (let ((node (filename->source-node filenames))) + (set-source-node/declarations! + node + (cons declaration + (source-node/declarations node))))) + filenames)) + + (let* ((front-end-base + (filename/append "base" + "blocks" "cfg1" "cfg2" "cfg3" + "contin" "ctypes" "enumer" "lvalue" + "object" "proced" "rvalue" + "scode" "subprb" "utils")) + (i386-base + (filename/append "machines/i386" "machin")) + (rtl-base + (filename/append "rtlbase" + "rgraph" "rtlcfg" "rtlobj" "rtlreg" "rtlty1" + "rtlty2")) + (cse-base + (filename/append "rtlopt" + "rcse1" "rcseht" "rcserq" "rcsesr")) + (cse-all + (append (filename/append "rtlopt" + "rcse2" "rcseep") + cse-base)) + (instruction-base + (filename/append "machines/i386" "assmd" "machin")) + (lapgen-base + (append (filename/append "back" "lapgn3" "regmap") + (filename/append "machines/i386" "lapgen"))) + (assembler-base + (append (filename/append "back" "symtab") + (filename/append "machines/i386" "insutl"))) + (lapgen-body + (append + (filename/append "back" "lapgn1" "lapgn2" "syntax") + (filename/append "machines/i386" + "rules1" "rules2" "rules3" "rules4" + "rulfix" "rulflo"))) + (assembler-body + (append + (filename/append "back" "bittop") + (filename/append "machines/i386" + "instr1" "instr2" "instrf")))) + + (define (file-dependency/integration/join filenames dependencies) + (for-each (lambda (filename) + (file-dependency/integration/make filename dependencies)) + filenames)) + + (define (file-dependency/integration/make filename dependencies) + (let ((node (filename->source-node filename))) + (for-each (lambda (dependency) + (let ((node* (filename->source-node dependency))) + (if (not (eq? node node*)) + (source-node/link! node node*)))) + dependencies))) + + (define (define-integration-dependencies directory name directory* . names) + (file-dependency/integration/make + (string-append directory "/" name) + (apply filename/append directory* names))) + + (define-integration-dependencies "base" "object" "base" "enumer") + (define-integration-dependencies "base" "enumer" "base" "object") + (define-integration-dependencies "base" "utils" "base" "scode") + (define-integration-dependencies "base" "cfg1" "base" "object") + (define-integration-dependencies "base" "cfg2" "base" + "cfg1" "cfg3" "object") + (define-integration-dependencies "base" "cfg3" "base" "cfg1" "cfg2") + (define-integration-dependencies "base" "ctypes" "base" + "blocks" "cfg1" "cfg2" "cfg3" "contin" "lvalue" "object" "subprb") + (define-integration-dependencies "base" "rvalue" "base" + "blocks" "cfg1" "cfg2" "cfg3" "enumer" "lvalue" "object" "utils") + (define-integration-dependencies "base" "lvalue" "base" + "blocks" "object" "proced" "rvalue" "utils") + (define-integration-dependencies "base" "blocks" "base" + "enumer" "lvalue" "object" "proced" "rvalue" "scode") + (define-integration-dependencies "base" "proced" "base" + "blocks" "cfg1" "cfg2" "cfg3" "contin" "enumer" "lvalue" "object" + "rvalue" "utils") + (define-integration-dependencies "base" "contin" "base" + "blocks" "cfg3" "ctypes") + (define-integration-dependencies "base" "subprb" "base" + "cfg3" "contin" "enumer" "object" "proced") + + (define-integration-dependencies "machines/i386" "machin" "rtlbase" + "rtlreg" "rtlty1" "rtlty2") + + (define-integration-dependencies "rtlbase" "rgraph" "base" "cfg1" "cfg2") + (define-integration-dependencies "rtlbase" "rgraph" "machines/i386" + "machin") + (define-integration-dependencies "rtlbase" "rtlcfg" "base" + "cfg1" "cfg2" "cfg3") + (define-integration-dependencies "rtlbase" "rtlcon" "base" "cfg3" "utils") + (define-integration-dependencies "rtlbase" "rtlcon" "machines/i386" + "machin") + (define-integration-dependencies "rtlbase" "rtlexp" "rtlbase" + "rtlreg" "rtlty1") + (define-integration-dependencies "rtlbase" "rtline" "base" "cfg1" "cfg2") + (define-integration-dependencies "rtlbase" "rtline" "rtlbase" + "rtlcfg" "rtlty2") + (define-integration-dependencies "rtlbase" "rtlobj" "base" + "cfg1" "object" "utils") + (define-integration-dependencies "rtlbase" "rtlreg" "machines/i386" + "machin") + (define-integration-dependencies "rtlbase" "rtlreg" "rtlbase" + "rgraph" "rtlty1") + (define-integration-dependencies "rtlbase" "rtlty1" "rtlbase" "rtlcfg") + (define-integration-dependencies "rtlbase" "rtlty2" "base" "scode") + (define-integration-dependencies "rtlbase" "rtlty2" "machines/i386" + "machin") + (define-integration-dependencies "rtlbase" "rtlty2" "rtlbase" "rtlty1") + + (file-dependency/integration/join + (append + (filename/append "base" "refctx") + (filename/append "fggen" + "declar" "fggen") ; "canon" needs no integrations + (filename/append "fgopt" + "blktyp" "closan" "conect" "contan" "delint" "desenv" + "envopt" "folcon" "offset" "operan" "order" "param" + "outer" "reuse" "reteqv" "sideff" "simapp" "simple" + "subfre" "varind")) + (append i386-base front-end-base)) + + (define-integration-dependencies "fgopt" "reuse" "fgopt" "reord") + + (file-dependency/integration/join + (filename/append "rtlgen" + "fndblk" "fndvar" "opncod" "rgcomb" "rgproc" "rgretn" + "rgrval" "rgstmt" "rtlgen") + (append i386-base front-end-base rtl-base)) + + (file-dependency/integration/join + (append cse-all + (filename/append "rtlopt" "ralloc" "rcompr" "rdebug" "rdflow" + "rerite" "rinvex" "rlife" "rtlcsm") + (filename/append "machines/i386" "rulrew")) + (append i386-base rtl-base)) + + (file-dependency/integration/join cse-all cse-base) + + (file-dependency/integration/join + (filename/append "rtlopt" "ralloc" "rcompr" "rdebug" "rlife") + (filename/append "rtlbase" "regset")) + + (file-dependency/integration/join + (filename/append "rtlopt" "rcseht" "rcserq") + (filename/append "base" "object")) + + (define-integration-dependencies "rtlopt" "rlife" "base" "cfg2") + + (let ((dependents + (append instruction-base + lapgen-base + lapgen-body + assembler-base + assembler-body + (filename/append "back" "linear" "syerly")))) + (add-declaration! '(USUAL-DEFINITION (SET EXPT)) dependents) + (file-dependency/integration/join dependents instruction-base)) + + (file-dependency/integration/join (append lapgen-base lapgen-body) + lapgen-base) + + (file-dependency/integration/join (append assembler-base assembler-body) + assembler-base) + + (define-integration-dependencies "back" "lapgn1" "base" + "cfg1" "cfg2" "utils") + (define-integration-dependencies "back" "lapgn1" "rtlbase" + "rgraph" "rtlcfg") + (define-integration-dependencies "back" "lapgn2" "rtlbase" "rtlreg") + (define-integration-dependencies "back" "lapgn3" "rtlbase" "rtlcfg") + (define-integration-dependencies "back" "linear" "base" "cfg1" "cfg2") + (define-integration-dependencies "back" "linear" "rtlbase" "rtlcfg") + (define-integration-dependencies "back" "mermap" "back" "regmap") + (define-integration-dependencies "back" "regmap" "base" "utils") + (define-integration-dependencies "back" "symtab" "base" "utils")) + + (for-each (lambda (node) + (let ((links (source-node/backward-links node))) + (if (not (null? links)) + (set-source-node/declarations! + node + (cons (make-integration-declaration + (source-node/pathname node) + (map source-node/pathname links)) + (source-node/declarations node)))))) + source-nodes)) + +(define (make-integration-declaration pathname integration-dependencies) + `(INTEGRATE-EXTERNAL + ,@(map (let ((default + (make-pathname + false + false + (cons 'RELATIVE + (make-list + (length (cdr (pathname-directory pathname))) + 'UP)) + false + false + false))) + (lambda (pathname) + (merge-pathnames pathname default))) + integration-dependencies))) + +(define-integrable (integration-declaration? declaration) + (eq? (car declaration) 'INTEGRATE-EXTERNAL)) + +;;;; Expansion Dependencies + +(define (initialize/expansion-dependencies!) + (let ((file-dependency/expansion/join + (lambda (filenames expansions) + (for-each (lambda (filename) + (let ((node (filename->source-node filename))) + (set-source-node/declarations! + node + (cons (make-expansion-declaration expansions) + (source-node/declarations node))))) + filenames)))) + (file-dependency/expansion/join + (filename/append "machines/i386" + "lapgen" "rules1" "rules2" "rules3" "rules4" + "rulfix" "rulflo") + (map (lambda (entry) + `(,(car entry) + (PACKAGE/REFERENCE (FIND-PACKAGE '(COMPILER LAP-SYNTAXER)) + ',(cadr entry)))) + '((LAP:SYNTAX-INSTRUCTION LAP:SYNTAX-INSTRUCTION-EXPANDER) + (INSTRUCTION->INSTRUCTION-SEQUENCE + INSTRUCTION->INSTRUCTION-SEQUENCE-EXPANDER) + (SYNTAX-EVALUATION SYNTAX-EVALUATION-EXPANDER) + (CONS-SYNTAX CONS-SYNTAX-EXPANDER) + (OPTIMIZE-GROUP-EARLY OPTIMIZE-GROUP-EXPANDER) + (EA-KEYWORD-EARLY EA-KEYWORD-EXPANDER) + (EA-MODE-EARLY EA-MODE-EXPANDER) + (EA-REGISTER-EARLY EA-REGISTER-EXPANDER) + (EA-EXTENSION-EARLY EA-EXTENSION-EXPANDER) + (EA-CATEGORIES-EARLY EA-CATEGORIES-EXPANDER)))))) + +(define-integrable (make-expansion-declaration expansions) + `(EXPAND-OPERATOR ,@expansions)) + +(define-integrable (expansion-declaration? declaration) + (eq? (car declaration) 'EXPAND-OPERATOR)) \ No newline at end of file