home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / compiler / machines / spectrum / decls.scm < prev    next >
Encoding:
Text File  |  1999-01-02  |  21.5 KB  |  614 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: decls.scm,v 4.35 1999/01/02 06:06:43 cph Exp $
  4.  
  5. Copyright (c) 1988-1999 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. |#
  21.  
  22. ;;;; Compiler File Dependencies
  23. ;;; package: (compiler declarations)
  24.  
  25. (declare (usual-integrations))
  26.  
  27. (define (initialize-package!)
  28.   (add-event-receiver! event:after-restore reset-source-nodes!)
  29.   (reset-source-nodes!))
  30.  
  31. (define (reset-source-nodes!)
  32.   (set! source-filenames '())
  33.   (set! source-hash)
  34.   (set! source-nodes)
  35.   (set! source-nodes/by-rank)
  36.   unspecific)
  37.  
  38. (define (maybe-setup-source-nodes!)
  39.   (if (null? source-filenames)
  40.       (setup-source-nodes!)))
  41.  
  42. (define (setup-source-nodes!)
  43.   (let ((filenames
  44.      (append-map!
  45.       (lambda (subdirectory)
  46.         (map (lambda (pathname)
  47.            (string-append subdirectory
  48.                   "/"
  49.                   (pathname-name pathname)))
  50.          (directory-read
  51.           (string-append subdirectory
  52.                  "/"
  53.                  source-file-expression))))
  54.       '("back" "base" "fggen" "fgopt" "rtlbase" "rtlgen" "rtlopt"
  55.            "machines/spectrum"))))
  56.     (if (null? filenames)
  57.     (error "Can't find source files of compiler"))
  58.     (set! source-filenames filenames))
  59.   (set! source-hash (make-string-hash-table))
  60.   (set! source-nodes
  61.     (map (lambda (filename)
  62.            (let ((node (make/source-node filename)))
  63.          (hash-table/put! source-hash filename node)
  64.          node))
  65.          source-filenames))
  66.   (initialize/syntax-dependencies!)
  67.   (initialize/integration-dependencies!)
  68.   (initialize/expansion-dependencies!)
  69.   (source-nodes/rank!))
  70.  
  71. (define source-file-expression "*.scm")
  72. (define source-filenames)
  73. (define source-hash)
  74. (define source-nodes)
  75. (define source-nodes/by-rank)
  76.  
  77. (define (filename/append directory . names)
  78.   (map (lambda (name) (string-append directory "/" name)) names))
  79.  
  80. (define-structure (source-node
  81.            (conc-name source-node/)
  82.            (constructor make/source-node (filename)))
  83.   (filename false read-only true)
  84.   (pathname (->pathname filename) read-only true)
  85.   (forward-links '())
  86.   (backward-links '())
  87.   (forward-closure '())
  88.   (backward-closure '())
  89.   (dependencies '())
  90.   (dependents '())
  91.   (rank false)
  92.   (syntax-table false)
  93.   (declarations '())
  94.   (modification-time false))
  95.  
  96. (define (filename->source-node filename)
  97.   (let ((node (hash-table/get source-hash filename #f)))
  98.     (if (not node)
  99.     (error "Unknown source file:" filename))
  100.     node))
  101.  
  102. (define (source-node/circular? node)
  103.   (memq node (source-node/backward-closure node)))
  104.  
  105. (define (source-node/link! node dependency)
  106.   (if (not (memq dependency (source-node/backward-links node)))
  107.       (begin
  108.     (set-source-node/backward-links!
  109.      node
  110.      (cons dependency (source-node/backward-links node)))
  111.     (set-source-node/forward-links!
  112.      dependency
  113.      (cons node (source-node/forward-links dependency)))
  114.     (source-node/close! node dependency))))
  115.  
  116. (define (source-node/close! node dependency)
  117.   (if (not (memq dependency (source-node/backward-closure node)))
  118.       (begin
  119.     (set-source-node/backward-closure!
  120.      node
  121.      (cons dependency (source-node/backward-closure node)))
  122.     (set-source-node/forward-closure!
  123.      dependency
  124.      (cons node (source-node/forward-closure dependency)))
  125.     (for-each (lambda (dependency)
  126.             (source-node/close! node dependency))
  127.           (source-node/backward-closure dependency))
  128.     (for-each (lambda (node)
  129.             (source-node/close! node dependency))
  130.           (source-node/forward-closure node)))))
  131.  
  132. ;;;; Rank
  133.  
  134. (define (source-nodes/rank!)
  135.   (compute-dependencies! source-nodes)
  136.   (compute-ranks! source-nodes)
  137.   (set! source-nodes/by-rank (source-nodes/sort-by-rank source-nodes))
  138.   unspecific)
  139.  
  140. (define (compute-dependencies! nodes)
  141.   (for-each (lambda (node)
  142.           (set-source-node/dependencies!
  143.            node
  144.            (list-transform-negative (source-node/backward-closure node)
  145.          (lambda (node*)
  146.            (memq node (source-node/backward-closure node*)))))
  147.           (set-source-node/dependents!
  148.            node
  149.            (list-transform-negative (source-node/forward-closure node)
  150.          (lambda (node*)
  151.            (memq node (source-node/forward-closure node*))))))
  152.         nodes))
  153.  
  154. (define (compute-ranks! nodes)
  155.   (let loop ((nodes nodes) (unranked-nodes '()))
  156.     (if (null? nodes)
  157.     (if (not (null? unranked-nodes))
  158.         (loop unranked-nodes '()))
  159.     (loop (cdr nodes)
  160.           (let ((node (car nodes)))
  161.         (let ((rank (source-node/rank* node)))
  162.           (if rank
  163.               (begin
  164.             (set-source-node/rank! node rank)
  165.             unranked-nodes)
  166.               (cons node unranked-nodes))))))))
  167.  
  168. (define (source-node/rank* node)
  169.   (let loop ((nodes (source-node/dependencies node)) (rank -1))
  170.     (if (null? nodes)
  171.     (1+ rank)
  172.     (let ((rank* (source-node/rank (car nodes))))
  173.       (and rank*
  174.            (loop (cdr nodes) (max rank rank*)))))))
  175.  
  176. (define (source-nodes/sort-by-rank nodes)
  177.   (sort nodes (lambda (x y) (< (source-node/rank x) (source-node/rank y)))))
  178.  
  179. ;;;; File Syntaxer
  180.  
  181. (define (syntax-files!)
  182.   (maybe-setup-source-nodes!)
  183.   (for-each
  184.    (lambda (node)
  185.      (let ((modification-time
  186.         (let ((source (modification-time node "scm"))
  187.           (binary (modification-time node "bin")))
  188.           (if (not source)
  189.           (error "Missing source file" (source-node/filename node)))
  190.           (and binary (< source binary) binary))))
  191.      (set-source-node/modification-time! node modification-time)
  192.      (if (not modification-time)
  193.      (begin (write-string "\nSource file newer than binary: ")
  194.         (write (source-node/filename node))))))
  195.    source-nodes)
  196.   (if compiler:enable-integration-declarations?
  197.       (begin
  198.     (for-each
  199.      (lambda (node)
  200.        (let ((time (source-node/modification-time node)))
  201.          (if (and time
  202.               (there-exists? (source-node/dependencies node)
  203.             (lambda (node*)
  204.               (let ((newer?
  205.                  (let ((time*
  206.                     (source-node/modification-time node*)))
  207.                    (or (not time*)
  208.                        (> time* time)))))
  209.                 (if newer?
  210.                 (begin
  211.                   (write-string "\nBinary file ")
  212.                   (write (source-node/filename node))
  213.                   (write-string " newer than dependency ")
  214.                   (write (source-node/filename node*))))
  215.                 newer?))))
  216.          (set-source-node/modification-time! node false))))
  217.      source-nodes)
  218.     (for-each
  219.      (lambda (node)
  220.        (if (not (source-node/modification-time node))
  221.            (for-each (lambda (node*)
  222.                (if (source-node/modification-time node*)
  223.                    (begin
  224.                  (write-string "\nBinary file ")
  225.                  (write (source-node/filename node*))
  226.                  (write-string " depends on ")
  227.                  (write (source-node/filename node))))
  228.                (set-source-node/modification-time! node* false))
  229.              (source-node/forward-closure node))))
  230.      source-nodes)))
  231.   (for-each (lambda (node)
  232.           (if (not (source-node/modification-time node))
  233.           (pathname-delete!
  234.            (pathname-new-type (source-node/pathname node) "ext"))))
  235.         source-nodes/by-rank)
  236.   (write-string "\n\nBegin pass 1:")
  237.   (for-each (lambda (node)
  238.           (if (not (source-node/modification-time node))
  239.           (source-node/syntax! node)))
  240.         source-nodes/by-rank)
  241.   (if (there-exists? source-nodes/by-rank
  242.     (lambda (node)
  243.       (and (not (source-node/modification-time node))
  244.            (source-node/circular? node))))
  245.       (begin
  246.     (write-string "\n\nBegin pass 2:")
  247.     (for-each (lambda (node)
  248.             (if (not (source-node/modification-time node))
  249.             (if (source-node/circular? node)
  250.                 (source-node/syntax! node)
  251.                 (source-node/touch! node))))
  252.           source-nodes/by-rank))))
  253.  
  254. (define (source-node/touch! node)
  255.   (with-values
  256.       (lambda ()
  257.     (sf/pathname-defaulting (source-node/pathname node) "" false))
  258.     (lambda (input-pathname bin-pathname spec-pathname)
  259.       input-pathname
  260.       (pathname-touch! bin-pathname)
  261.       (pathname-touch! (pathname-new-type bin-pathname "ext"))
  262.       (if spec-pathname (pathname-touch! spec-pathname)))))
  263.  
  264. (define (pathname-touch! pathname)
  265.   (if (file-exists? pathname)
  266.       (begin
  267.     (write-string "\nTouch file: ")
  268.     (write (enough-namestring pathname))
  269.     (file-touch pathname))))
  270.  
  271. (define (pathname-delete! pathname)
  272.   (if (file-exists? pathname)
  273.       (begin
  274.     (write-string "\nDelete file: ")
  275.     (write (enough-namestring pathname))
  276.     (delete-file pathname))))
  277.  
  278. (define (sc filename)
  279.   (maybe-setup-source-nodes!)
  280.   (source-node/syntax! (filename->source-node filename)))
  281.  
  282. (define (source-node/syntax! node)
  283.   (with-values
  284.       (lambda ()
  285.     (sf/pathname-defaulting (source-node/pathname node) "" false))
  286.     (lambda (input-pathname bin-pathname spec-pathname)
  287.       (sf/internal
  288.        input-pathname bin-pathname spec-pathname
  289.        (source-node/syntax-table node)
  290.        ((if compiler:enable-integration-declarations?
  291.         identity-procedure
  292.         (lambda (declarations)
  293.           (list-transform-negative declarations
  294.         integration-declaration?)))
  295.     ((if compiler:enable-expansion-declarations?
  296.          identity-procedure
  297.          (lambda (declarations)
  298.            (list-transform-negative declarations
  299.          expansion-declaration?)))
  300.      (source-node/declarations node)))))))
  301.  
  302. (define-integrable (modification-time node type)
  303.   (file-modification-time
  304.    (pathname-new-type (source-node/pathname node) type)))
  305.  
  306. ;;;; Syntax dependencies
  307.  
  308. (define (initialize/syntax-dependencies!)
  309.   (let ((file-dependency/syntax/join
  310.      (lambda (filenames syntax-table)
  311.        (for-each (lambda (filename)
  312.                (set-source-node/syntax-table!
  313.             (filename->source-node filename)
  314.             syntax-table))
  315.              filenames))))
  316.     (file-dependency/syntax/join
  317.      (append (filename/append "base"
  318.                   "toplev" "asstop" "crstop"
  319.                   "blocks" "cfg1" "cfg2" "cfg3" "constr"
  320.                   "contin" "ctypes" "debug" "enumer"
  321.                   "infnew" "lvalue" "object" "pmerly" "proced"
  322.                   "refctx" "rvalue" "scode" "sets" "subprb"
  323.                   "switch" "utils")
  324.          (filename/append "back"
  325.                   "asmmac" "bittop" "bitutl" "insseq" "lapgn1"
  326.                   "lapgn2" "lapgn3" "linear" "regmap" "symtab"
  327.                   "syntax")
  328.          (filename/append "machines/spectrum"
  329.                   "dassm1" "insmac" "lapopt" "machin" "rgspcm"
  330.                   "rulrew")
  331.          (filename/append "fggen"
  332.                   "declar" "fggen" "canon")
  333.          (filename/append "fgopt"
  334.                   "blktyp" "closan" "conect" "contan" "delint"
  335.                   "desenv" "envopt" "folcon" "offset" "operan"
  336.                   "order" "outer" "param" "reord" "reteqv" "reuse"
  337.                   "sideff" "simapp" "simple" "subfre" "varind")
  338.          (filename/append "rtlbase"
  339.                   "regset" "rgraph" "rtlcfg" "rtlcon" "rtlexp"
  340.                   "rtline" "rtlobj" "rtlreg" "rtlty1" "rtlty2"
  341.                   "valclass")
  342.          (filename/append "rtlgen"
  343.                   "fndblk" "fndvar" "opncod" "rgcomb" "rgproc"
  344.                   "rgretn" "rgrval" "rgstmt" "rtlgen")
  345.          (filename/append "rtlopt"
  346.                   "ralloc" "rcompr" "rcse1" "rcse2" "rcseep"
  347.                   "rcseht" "rcserq" "rcsesr" "rdebug" "rdflow"
  348.                   "rerite" "rinvex" "rlife" "rtlcsm"))
  349.      compiler-syntax-table)
  350.     (file-dependency/syntax/join
  351.      (filename/append "machines/spectrum"
  352.               "lapgen"
  353.               "rules1" "rules2" "rules3" "rules4" "rulfix" "rulflo")
  354.      lap-generator-syntax-table)
  355.     (file-dependency/syntax/join
  356.      (filename/append "machines/spectrum" "instr1" "instr2" "instr3")
  357.      assembler-syntax-table)))
  358.  
  359. ;;;; Integration Dependencies
  360.  
  361. (define (initialize/integration-dependencies!)
  362.   (define (add-declaration! declaration filenames)
  363.     (for-each (lambda (filenames)
  364.         (let ((node (filename->source-node filenames)))
  365.           (set-source-node/declarations!
  366.            node
  367.            (cons declaration
  368.              (source-node/declarations node)))))
  369.           filenames))
  370.  
  371.   (let* ((front-end-base
  372.       (filename/append "base"
  373.                "blocks" "cfg1" "cfg2" "cfg3"
  374.                "contin" "ctypes" "enumer" "lvalue"
  375.                "object" "proced" "rvalue"
  376.                "scode" "subprb" "utils"))
  377.      (spectrum-base
  378.       (append (filename/append "machines/spectrum" "machin")
  379.           (filename/append "back" "asutl")))
  380.      (rtl-base
  381.       (filename/append "rtlbase"
  382.                "rgraph" "rtlcfg" "rtlobj" "rtlreg" "rtlty1"
  383.                "rtlty2"))
  384.      (cse-base
  385.       (filename/append "rtlopt"
  386.                "rcse1" "rcseht" "rcserq" "rcsesr"))
  387.      (cse-all
  388.       (append (filename/append "rtlopt"
  389.                    "rcse2" "rcseep")
  390.           cse-base))
  391.      (instruction-base
  392.       (filename/append "machines/spectrum" "assmd" "machin"))
  393.      (lapgen-base
  394.       (append (filename/append "back" "linear" "regmap")
  395.           (filename/append "machines/spectrum" "lapgen")))
  396.      (assembler-base
  397.       (append (filename/append "back" "symtab")
  398.           (filename/append "machines/spectrum" "instr1")))
  399.      (lapgen-body
  400.       (append
  401.        (filename/append "back" "lapgn1" "lapgn2" "syntax")
  402.        (filename/append "machines/spectrum"
  403.                 "rules1" "rules2" "rules3" "rules4"
  404.                 "rulfix" "rulflo")))
  405.      (assembler-body
  406.       (append
  407.        (filename/append "back" "bittop")
  408.        (filename/append "machines/spectrum"
  409.                 "instr1" "instr2" "instr3"))))
  410.  
  411.     (define (file-dependency/integration/join filenames dependencies)
  412.       (for-each (lambda (filename)
  413.           (file-dependency/integration/make filename dependencies))
  414.         filenames))
  415.  
  416.     (define (file-dependency/integration/make filename dependencies)
  417.       (let ((node (filename->source-node filename)))
  418.     (for-each (lambda (dependency)
  419.             (let ((node* (filename->source-node dependency)))
  420.               (if (not (eq? node node*))
  421.               (source-node/link! node node*))))
  422.           dependencies)))
  423.  
  424.     (define (define-integration-dependencies directory name directory* . names)
  425.       (file-dependency/integration/make
  426.        (string-append directory "/" name)
  427.        (apply filename/append directory* names)))
  428.  
  429.     (define-integration-dependencies "machines/spectrum" "machin" "back" "asutl")
  430.     (define-integration-dependencies "base" "object" "base" "enumer")
  431.     (define-integration-dependencies "base" "enumer" "base" "object")
  432.     (define-integration-dependencies "base" "utils" "base" "scode")
  433.     (define-integration-dependencies "base" "cfg1" "base" "object")
  434.     (define-integration-dependencies "base" "cfg2" "base"
  435.       "cfg1" "cfg3" "object")
  436.     (define-integration-dependencies "base" "cfg3" "base" "cfg1" "cfg2")
  437.     (define-integration-dependencies "base" "ctypes" "base"
  438.       "blocks" "cfg1" "cfg2" "cfg3" "contin" "lvalue" "object" "subprb")
  439.     (define-integration-dependencies "base" "rvalue" "base"
  440.       "blocks" "cfg1" "cfg2" "cfg3" "enumer" "lvalue" "object" "utils")
  441.     (define-integration-dependencies "base" "lvalue" "base"
  442.       "blocks" "object" "proced" "rvalue" "utils")
  443.     (define-integration-dependencies "base" "blocks" "base"
  444.       "enumer" "lvalue" "object" "proced" "rvalue" "scode")
  445.     (define-integration-dependencies "base" "proced" "base"
  446.       "blocks" "cfg1" "cfg2" "cfg3" "contin" "enumer" "lvalue" "object"
  447.       "rvalue" "utils")
  448.     (define-integration-dependencies "base" "contin" "base"
  449.       "blocks" "cfg3" "ctypes")
  450.     (define-integration-dependencies "base" "subprb" "base"
  451.       "cfg3" "contin" "enumer" "object" "proced")
  452.  
  453.     (define-integration-dependencies "machines/spectrum" "machin" "rtlbase"
  454.       "rtlreg" "rtlty1" "rtlty2")
  455.  
  456.     (define-integration-dependencies "rtlbase" "rgraph" "base" "cfg1" "cfg2")
  457.     (define-integration-dependencies "rtlbase" "rgraph" "machines/spectrum"
  458.       "machin")
  459.     (define-integration-dependencies "rtlbase" "rtlcfg" "base"
  460.       "cfg1" "cfg2" "cfg3")
  461.     (define-integration-dependencies "rtlbase" "rtlcon" "base" "cfg3" "utils")
  462.     (define-integration-dependencies "rtlbase" "rtlcon" "machines/spectrum"
  463.       "machin")
  464.     (define-integration-dependencies "rtlbase" "rtlexp" "rtlbase"
  465.       "rtlreg" "rtlty1")
  466.     (define-integration-dependencies "rtlbase" "rtline" "base" "cfg1" "cfg2")
  467.     (define-integration-dependencies "rtlbase" "rtline" "rtlbase"
  468.       "rtlcfg" "rtlty2")
  469.     (define-integration-dependencies "rtlbase" "rtlobj" "base"
  470.       "cfg1" "object" "utils")
  471.     (define-integration-dependencies "rtlbase" "rtlreg" "machines/spectrum"
  472.       "machin")
  473.     (define-integration-dependencies "rtlbase" "rtlreg" "rtlbase"
  474.       "rgraph" "rtlty1")
  475.     (define-integration-dependencies "rtlbase" "rtlty1" "rtlbase" "rtlcfg")
  476.     (define-integration-dependencies "rtlbase" "rtlty2" "base" "scode")
  477.     (define-integration-dependencies "rtlbase" "rtlty2" "machines/spectrum"
  478.       "machin")
  479.     (define-integration-dependencies "rtlbase" "rtlty2" "rtlbase" "rtlty1")
  480.  
  481.     (file-dependency/integration/join
  482.      (append
  483.       (filename/append "base" "refctx")
  484.       (filename/append "fggen"
  485.                "declar" "fggen") ; "canon" needs no integrations
  486.       (filename/append "fgopt"
  487.                "blktyp" "closan" "conect" "contan" "delint" "desenv"
  488.                "envopt" "folcon" "offset" "operan" "order" "param"
  489.                "outer" "reuse" "reteqv" "sideff" "simapp" "simple"
  490.                "subfre" "varind"))
  491.      (append spectrum-base front-end-base))
  492.  
  493.     (define-integration-dependencies "fgopt" "reuse" "fgopt" "reord")
  494.  
  495.     (file-dependency/integration/join
  496.      (filename/append "rtlgen"
  497.               "fndblk" "fndvar" "opncod" "rgcomb" "rgproc" "rgretn"
  498.               "rgrval" "rgstmt" "rtlgen")
  499.      (append spectrum-base front-end-base rtl-base))
  500.  
  501.     (file-dependency/integration/join
  502.      (append cse-all
  503.          (filename/append "rtlopt" "ralloc" "rcompr" "rdebug" "rdflow"
  504.                   "rerite" "rinvex" "rlife" "rtlcsm")
  505.          (filename/append "machines/spectrum" "rulrew"))
  506.      (append spectrum-base rtl-base))
  507.  
  508.     (file-dependency/integration/join cse-all cse-base)
  509.  
  510.     (file-dependency/integration/join
  511.      (filename/append "rtlopt" "ralloc" "rcompr" "rdebug" "rlife")
  512.      (filename/append "rtlbase" "regset"))
  513.  
  514.     (file-dependency/integration/join
  515.      (filename/append "rtlopt" "rcseht" "rcserq")
  516.      (filename/append "base" "object"))
  517.  
  518.     (define-integration-dependencies "rtlopt" "rlife"  "base" "cfg2")
  519.  
  520.     (let ((dependents
  521.        (append instruction-base
  522.            lapgen-base
  523.            lapgen-body
  524.            assembler-base
  525.            assembler-body
  526.            (filename/append "back" "linear" "syerly"))))
  527.       (add-declaration! '(USUAL-DEFINITION (SET EXPT)) dependents)
  528.       (file-dependency/integration/join dependents instruction-base))
  529.  
  530.     (file-dependency/integration/join (append lapgen-base lapgen-body)
  531.                       lapgen-base)
  532.  
  533.     (file-dependency/integration/join (append assembler-base assembler-body)
  534.                       assembler-base)
  535.  
  536.     (define-integration-dependencies "back" "lapgn1" "base"
  537.       "cfg1" "cfg2" "utils")
  538.     (define-integration-dependencies "back" "lapgn1" "rtlbase"
  539.       "rgraph" "rtlcfg")
  540.     (define-integration-dependencies "back" "lapgn2" "rtlbase" "rtlreg")
  541.     (define-integration-dependencies "back" "linear" "base" "cfg1" "cfg2")
  542.     (define-integration-dependencies "back" "linear" "rtlbase" "rtlcfg")
  543.     (define-integration-dependencies "back" "mermap" "back" "regmap")
  544.     (define-integration-dependencies "back" "regmap" "base" "utils")
  545.     (define-integration-dependencies "back" "symtab" "base" "utils"))
  546.  
  547.   (for-each (lambda (node)
  548.           (let ((links (source-node/backward-links node)))
  549.         (if (not (null? links))
  550.             (set-source-node/declarations!
  551.              node
  552.              (cons (make-integration-declaration
  553.                 (source-node/pathname node)
  554.                 (map source-node/pathname links))
  555.                (source-node/declarations node))))))
  556.         source-nodes))
  557.  
  558. (define (make-integration-declaration pathname integration-dependencies)
  559.   `(INTEGRATE-EXTERNAL
  560.     ,@(map (let ((default
  561.           (make-pathname
  562.            false
  563.            false
  564.            (cons 'RELATIVE
  565.              (make-list
  566.               (length (cdr (pathname-directory pathname)))
  567.               'UP))
  568.            false
  569.            false
  570.            false)))
  571.          (lambda (pathname)
  572.            (merge-pathnames pathname default)))
  573.        integration-dependencies)))
  574.  
  575. (define-integrable (integration-declaration? declaration)
  576.   (eq? (car declaration) 'INTEGRATE-EXTERNAL))
  577.  
  578. ;;;; Expansion Dependencies
  579.  
  580. (define (initialize/expansion-dependencies!)
  581.   (let ((file-dependency/expansion/join
  582.      (lambda (filenames expansions)
  583.        (for-each (lambda (filename)
  584.                (let ((node (filename->source-node filename)))
  585.              (set-source-node/declarations!
  586.               node
  587.               (cons (make-expansion-declaration expansions)
  588.                 (source-node/declarations node)))))
  589.              filenames))))
  590.     (file-dependency/expansion/join
  591.      (filename/append "machines/spectrum"
  592.               "lapgen" "rules1" "rules2" "rules3" "rules4"
  593.               "rulfix" "rulflo")
  594.      (map (lambda (entry)
  595.         `(,(car entry)
  596.           (PACKAGE/REFERENCE (FIND-PACKAGE '(COMPILER LAP-SYNTAXER))
  597.                  ',(cadr entry))))
  598.       '((LAP:SYNTAX-INSTRUCTION LAP:SYNTAX-INSTRUCTION-EXPANDER)
  599.         (INSTRUCTION->INSTRUCTION-SEQUENCE
  600.          INSTRUCTION->INSTRUCTION-SEQUENCE-EXPANDER)
  601.         (SYNTAX-EVALUATION SYNTAX-EVALUATION-EXPANDER)
  602.         (CONS-SYNTAX CONS-SYNTAX-EXPANDER)
  603.         (OPTIMIZE-GROUP-EARLY OPTIMIZE-GROUP-EXPANDER)
  604.         (EA-KEYWORD-EARLY EA-KEYWORD-EXPANDER)
  605.         (EA-MODE-EARLY EA-MODE-EXPANDER)
  606.         (EA-REGISTER-EARLY EA-REGISTER-EXPANDER)
  607.         (EA-EXTENSION-EARLY EA-EXTENSION-EXPANDER)
  608.         (EA-CATEGORIES-EARLY EA-CATEGORIES-EXPANDER))))))
  609.  
  610. (define-integrable (make-expansion-declaration expansions)
  611.   `(EXPAND-OPERATOR ,@expansions))
  612.  
  613. (define-integrable (expansion-declaration? declaration)
  614.   (eq? (car declaration) 'EXPAND-OPERATOR))