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 / i386 / decls.scm < prev    next >
Text File  |  2000-01-09  |  22KB  |  634 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: decls.scm,v 1.9 2000/01/10 03:54:25 cph Exp $
  4.  
  5. Copyright (c) 1992-2000 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/i386"))))
  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
  194.        (fresh-line)
  195.        (write-string "Source file newer than binary: ")
  196.        (write (source-node/filename node))
  197.        (newline)))))
  198.    source-nodes)
  199.   (if compiler:enable-integration-declarations?
  200.       (begin
  201.     (for-each
  202.      (lambda (node)
  203.        (let ((time (source-node/modification-time node)))
  204.          (if (and time
  205.               (there-exists? (source-node/dependencies node)
  206.             (lambda (node*)
  207.               (let ((newer?
  208.                  (let ((time*
  209.                     (source-node/modification-time node*)))
  210.                    (or (not time*)
  211.                        (> time* time)))))
  212.                 (if newer?
  213.                 (begin
  214.                   (fresh-line)
  215.                   (write-string "Binary file ")
  216.                   (write (source-node/filename node))
  217.                   (write-string " newer than dependency ")
  218.                   (write (source-node/filename node*))
  219.                   (newline)))
  220.                 newer?))))
  221.          (set-source-node/modification-time! node false))))
  222.      source-nodes)
  223.     (for-each
  224.      (lambda (node)
  225.        (if (not (source-node/modification-time node))
  226.            (for-each (lambda (node*)
  227.                (if (source-node/modification-time node*)
  228.                    (begin
  229.                  (fresh-line)
  230.                  (write-string "Binary file ")
  231.                  (write (source-node/filename node*))
  232.                  (write-string " depends on ")
  233.                  (write (source-node/filename node))
  234.                  (newline)))
  235.                (set-source-node/modification-time! node* false))
  236.              (source-node/forward-closure node))))
  237.      source-nodes)))
  238.   (for-each (lambda (node)
  239.           (if (not (source-node/modification-time node))
  240.           (pathname-delete!
  241.            (pathname-new-type (source-node/pathname node) "ext"))))
  242.         source-nodes/by-rank)
  243.   (fresh-line)
  244.   (newline)
  245.   (write-string "Begin pass 1:")
  246.   (newline)
  247.   (for-each (lambda (node)
  248.           (if (not (source-node/modification-time node))
  249.           (source-node/syntax! node)))
  250.         source-nodes/by-rank)
  251.   (if (there-exists? source-nodes/by-rank
  252.     (lambda (node)
  253.       (and (not (source-node/modification-time node))
  254.            (source-node/circular? node))))
  255.       (begin
  256.     (fresh-line)
  257.     (newline)
  258.     (write-string "Begin pass 2:")
  259.     (newline)
  260.     (for-each (lambda (node)
  261.             (if (not (source-node/modification-time node))
  262.             (if (source-node/circular? node)
  263.                 (source-node/syntax! node)
  264.                 (source-node/touch! node))))
  265.           source-nodes/by-rank))))
  266.  
  267. (define (source-node/touch! node)
  268.   (with-values
  269.       (lambda ()
  270.     (sf/pathname-defaulting (source-node/pathname node) "" false))
  271.     (lambda (input-pathname bin-pathname spec-pathname)
  272.       input-pathname
  273.       (pathname-touch! bin-pathname)
  274.       (pathname-touch! (pathname-new-type bin-pathname "ext"))
  275.       (if spec-pathname (pathname-touch! spec-pathname)))))
  276.  
  277. (define (pathname-touch! pathname)
  278.   (if (file-exists? pathname)
  279.       (begin
  280.     (fresh-line)
  281.     (write-string "Touch file: ")
  282.     (write (enough-namestring pathname))
  283.     (newline)
  284.     (file-touch pathname))))
  285.  
  286. (define (pathname-delete! pathname)
  287.   (if (file-exists? pathname)
  288.       (begin
  289.     (fresh-line)
  290.     (write-string "Delete file: ")
  291.     (write (enough-namestring pathname))
  292.     (newline)
  293.     (delete-file pathname))))
  294.  
  295. (define (sc filename)
  296.   (maybe-setup-source-nodes!)
  297.   (source-node/syntax! (filename->source-node filename)))
  298.  
  299. (define (source-node/syntax! node)
  300.   (with-values
  301.       (lambda ()
  302.     (sf/pathname-defaulting (source-node/pathname node) "" false))
  303.     (lambda (input-pathname bin-pathname spec-pathname)
  304.       (sf/internal
  305.        input-pathname bin-pathname spec-pathname
  306.        (source-node/syntax-table node)
  307.        ((if compiler:enable-integration-declarations?
  308.         identity-procedure
  309.         (lambda (declarations)
  310.           (list-transform-negative declarations
  311.         integration-declaration?)))
  312.     ((if compiler:enable-expansion-declarations?
  313.          identity-procedure
  314.          (lambda (declarations)
  315.            (list-transform-negative declarations
  316.          expansion-declaration?)))
  317.      (source-node/declarations node)))))))
  318.  
  319. (define-integrable (modification-time node type)
  320.   (file-modification-time
  321.    (pathname-new-type (source-node/pathname node) type)))
  322.  
  323. ;;;; Syntax dependencies
  324.  
  325. (define (initialize/syntax-dependencies!)
  326.   (let ((file-dependency/syntax/join
  327.      (lambda (filenames syntax-table)
  328.        (for-each (lambda (filename)
  329.                (set-source-node/syntax-table!
  330.             (filename->source-node filename)
  331.             syntax-table))
  332.              filenames))))
  333.     (file-dependency/syntax/join
  334.      (append (filename/append "base"
  335.                   "toplev" "asstop" "crstop"
  336.                   "blocks" "cfg1" "cfg2" "cfg3" "constr"
  337.                   "contin" "ctypes" "debug" "enumer"
  338.                   "infnew" "lvalue" "object" "pmerly" "proced"
  339.                   "refctx" "rvalue" "scode" "sets" "subprb"
  340.                   "switch" "utils")
  341.          (filename/append "back"
  342.                   "asmmac" "bittop" "bitutl" "insseq" "lapgn1"
  343.                   "lapgn2" "lapgn3" "linear" "regmap" "symtab"
  344.                   "syntax")
  345.          (filename/append "machines/i386"
  346.                   "dassm1" "insmac" "lapopt" "machin" "rgspcm"
  347.                   "rulrew")
  348.          (filename/append "fggen"
  349.                   "declar" "fggen" "canon")
  350.          (filename/append "fgopt"
  351.                   "blktyp" "closan" "conect" "contan" "delint"
  352.                   "desenv" "envopt" "folcon" "offset" "operan"
  353.                   "order" "outer" "param" "reord" "reteqv" "reuse"
  354.                   "sideff" "simapp" "simple" "subfre" "varind")
  355.          (filename/append "rtlbase"
  356.                   "regset" "rgraph" "rtlcfg" "rtlcon" "rtlexp"
  357.                   "rtline" "rtlobj" "rtlreg" "rtlty1" "rtlty2"
  358.                   "valclass")
  359.          (filename/append "rtlgen"
  360.                   "fndblk" "fndvar" "opncod" "rgcomb" "rgproc"
  361.                   "rgretn" "rgrval" "rgstmt" "rtlgen")
  362.          (filename/append "rtlopt"
  363.                   "ralloc" "rcompr" "rcse1" "rcse2" "rcseep"
  364.                   "rcseht" "rcserq" "rcsesr" "rdebug" "rdflow"
  365.                   "rerite" "rinvex" "rlife" "rtlcsm"))
  366.      compiler-syntax-table)
  367.     (file-dependency/syntax/join
  368.      (filename/append "machines/i386"
  369.               "lapgen"
  370.               "rules1" "rules2" "rules3" "rules4" "rulfix" "rulflo")
  371.      lap-generator-syntax-table)
  372.     (file-dependency/syntax/join
  373.      (filename/append "machines/i386" "insutl" "instr1" "instr2" "instrf")
  374.      assembler-syntax-table)))
  375.  
  376. ;;;; Integration Dependencies
  377.  
  378. (define (initialize/integration-dependencies!)
  379.  
  380.   (define (add-declaration! declaration filenames)
  381.     (for-each (lambda (filenames)
  382.         (let ((node (filename->source-node filenames)))
  383.           (set-source-node/declarations!
  384.            node
  385.            (cons declaration
  386.              (source-node/declarations node)))))
  387.           filenames))
  388.  
  389.   (let* ((front-end-base
  390.       (filename/append "base"
  391.                "blocks" "cfg1" "cfg2" "cfg3"
  392.                "contin" "ctypes" "enumer" "lvalue"
  393.                "object" "proced" "rvalue"
  394.                "scode" "subprb" "utils"))
  395.      (i386-base
  396.       (append (filename/append "machines/i386" "machin")
  397.           (filename/append "back" "asutl")))
  398.      (rtl-base
  399.       (filename/append "rtlbase"
  400.                "rgraph" "rtlcfg" "rtlobj" "rtlreg" "rtlty1"
  401.                "rtlty2"))
  402.      (cse-base
  403.       (filename/append "rtlopt"
  404.                "rcse1" "rcseht" "rcserq" "rcsesr"))
  405.      (cse-all
  406.       (append (filename/append "rtlopt"
  407.                    "rcse2" "rcseep")
  408.           cse-base))
  409.      (instruction-base
  410.       (filename/append "machines/i386" "assmd" "machin"))
  411.      (lapgen-base
  412.       (append (filename/append "back" "linear" "regmap")
  413.           (filename/append "machines/i386" "lapgen")))
  414.      (assembler-base
  415.       (append (filename/append "back" "symtab")
  416.           (filename/append "machines/i386" "insutl")))
  417.      (lapgen-body
  418.       (append
  419.        (filename/append "back" "lapgn1" "lapgn2" "syntax")
  420.        (filename/append "machines/i386"
  421.                 "rules1" "rules2" "rules3" "rules4"
  422.                 "rulfix" "rulflo")))
  423.      (assembler-body
  424.       (append
  425.        (filename/append "back" "bittop")
  426.        (filename/append "machines/i386"
  427.                 "instr1" "instr2" "instrf"))))
  428.  
  429.     (define (file-dependency/integration/join filenames dependencies)
  430.       (for-each (lambda (filename)
  431.           (file-dependency/integration/make filename dependencies))
  432.         filenames))
  433.  
  434.     (define (file-dependency/integration/make filename dependencies)
  435.       (let ((node (filename->source-node filename)))
  436.     (for-each (lambda (dependency)
  437.             (let ((node* (filename->source-node dependency)))
  438.               (if (not (eq? node node*))
  439.               (source-node/link! node node*))))
  440.           dependencies)))
  441.  
  442.     (define (define-integration-dependencies directory name directory* . names)
  443.       (file-dependency/integration/make
  444.        (string-append directory "/" name)
  445.        (apply filename/append directory* names)))
  446.  
  447.     (define-integration-dependencies "machines/i386" "machin" "back" "asutl")
  448.     (define-integration-dependencies "base" "object" "base" "enumer")
  449.     (define-integration-dependencies "base" "enumer" "base" "object")
  450.     (define-integration-dependencies "base" "utils" "base" "scode")
  451.     (define-integration-dependencies "base" "cfg1" "base" "object")
  452.     (define-integration-dependencies "base" "cfg2" "base"
  453.       "cfg1" "cfg3" "object")
  454.     (define-integration-dependencies "base" "cfg3" "base" "cfg1" "cfg2")
  455.     (define-integration-dependencies "base" "ctypes" "base"
  456.       "blocks" "cfg1" "cfg2" "cfg3" "contin" "lvalue" "object" "subprb")
  457.     (define-integration-dependencies "base" "rvalue" "base"
  458.       "blocks" "cfg1" "cfg2" "cfg3" "enumer" "lvalue" "object" "utils")
  459.     (define-integration-dependencies "base" "lvalue" "base"
  460.       "blocks" "object" "proced" "rvalue" "utils")
  461.     (define-integration-dependencies "base" "blocks" "base"
  462.       "enumer" "lvalue" "object" "proced" "rvalue" "scode")
  463.     (define-integration-dependencies "base" "proced" "base"
  464.       "blocks" "cfg1" "cfg2" "cfg3" "contin" "enumer" "lvalue" "object"
  465.       "rvalue" "utils")
  466.     (define-integration-dependencies "base" "contin" "base"
  467.       "blocks" "cfg3" "ctypes")
  468.     (define-integration-dependencies "base" "subprb" "base"
  469.       "cfg3" "contin" "enumer" "object" "proced")
  470.  
  471.     (define-integration-dependencies "machines/i386" "machin" "rtlbase"
  472.       "rtlreg" "rtlty1" "rtlty2")
  473.  
  474.     (define-integration-dependencies "rtlbase" "rgraph" "base" "cfg1" "cfg2")
  475.     (define-integration-dependencies "rtlbase" "rgraph" "machines/i386"
  476.       "machin")
  477.     (define-integration-dependencies "rtlbase" "rtlcfg" "base"
  478.       "cfg1" "cfg2" "cfg3")
  479.     (define-integration-dependencies "rtlbase" "rtlcon" "base" "cfg3" "utils")
  480.     (define-integration-dependencies "rtlbase" "rtlcon" "machines/i386"
  481.       "machin")
  482.     (file-dependency/integration/join (filename/append "rtlbase" "rtlcon")
  483.                       rtl-base)
  484.     (define-integration-dependencies "rtlbase" "rtlexp" "rtlbase"
  485.       "rtlreg" "rtlty1")
  486.     (define-integration-dependencies "rtlbase" "rtline" "base" "cfg1" "cfg2")
  487.     (define-integration-dependencies "rtlbase" "rtline" "rtlbase"
  488.       "rtlcfg" "rtlty2")
  489.     (define-integration-dependencies "rtlbase" "rtlobj" "base"
  490.       "cfg1" "object" "utils")
  491.     (define-integration-dependencies "rtlbase" "rtlreg" "machines/i386"
  492.       "machin")
  493.     (define-integration-dependencies "rtlbase" "rtlreg" "rtlbase"
  494.       "rgraph" "rtlty1")
  495.     (define-integration-dependencies "rtlbase" "rtlty1" "rtlbase" "rtlcfg")
  496.     (define-integration-dependencies "rtlbase" "rtlty2" "base" "scode")
  497.     (define-integration-dependencies "rtlbase" "rtlty2" "machines/i386"
  498.       "machin")
  499.     (define-integration-dependencies "rtlbase" "rtlty2" "rtlbase" "rtlty1")
  500.  
  501.     (file-dependency/integration/join
  502.      (append
  503.       (filename/append "base" "refctx")
  504.       (filename/append "fggen"
  505.                "declar" "fggen") ; "canon" needs no integrations
  506.       (filename/append "fgopt"
  507.                "blktyp" "closan" "conect" "contan" "delint" "desenv"
  508.                "envopt" "folcon" "offset" "operan" "order" "param"
  509.                "outer" "reuse" "reteqv" "sideff" "simapp" "simple"
  510.                "subfre" "varind"))
  511.      (append i386-base front-end-base))
  512.  
  513.     (define-integration-dependencies "fgopt" "reuse" "fgopt" "reord")
  514.  
  515.     (file-dependency/integration/join
  516.      (filename/append "rtlgen"
  517.               "fndblk" "fndvar" "opncod" "rgcomb" "rgproc" "rgretn"
  518.               "rgrval" "rgstmt" "rtlgen")
  519.      (append i386-base front-end-base rtl-base))
  520.  
  521.     (file-dependency/integration/join
  522.      (append cse-all
  523.          (filename/append "rtlopt" "ralloc" "rcompr" "rdebug" "rdflow"
  524.                   "rerite" "rinvex" "rlife" "rtlcsm")
  525.          (filename/append "machines/i386" "rulrew"))
  526.      (append i386-base rtl-base))
  527.  
  528.     (file-dependency/integration/join cse-all cse-base)
  529.  
  530.     (file-dependency/integration/join
  531.      (filename/append "rtlopt" "ralloc" "rcompr" "rdebug" "rlife")
  532.      (filename/append "rtlbase" "regset"))
  533.  
  534.     (file-dependency/integration/join
  535.      (filename/append "rtlopt" "rcseht" "rcserq")
  536.      (filename/append "base" "object"))
  537.  
  538.     (define-integration-dependencies "rtlopt" "rlife"  "base" "cfg2")
  539.  
  540.     (let ((dependents
  541.        (append instruction-base
  542.            lapgen-base
  543.            lapgen-body
  544.            assembler-base
  545.            assembler-body
  546.            (filename/append "back" "linear" "syerly"))))
  547.       (add-declaration! '(USUAL-DEFINITION (SET EXPT)) dependents)
  548.       (file-dependency/integration/join dependents instruction-base))
  549.  
  550.     (file-dependency/integration/join (append lapgen-base lapgen-body)
  551.                       lapgen-base)
  552.  
  553.     (file-dependency/integration/join (append assembler-base assembler-body)
  554.                       assembler-base)
  555.  
  556.     (define-integration-dependencies "back" "lapgn1" "base"
  557.       "cfg1" "cfg2" "utils")
  558.     (define-integration-dependencies "back" "lapgn1" "rtlbase"
  559.       "rgraph" "rtlcfg")
  560.     (define-integration-dependencies "back" "lapgn2" "rtlbase" "rtlreg")
  561.     (define-integration-dependencies "back" "linear" "base" "cfg1" "cfg2")
  562.     (define-integration-dependencies "back" "linear" "rtlbase" "rtlcfg")
  563.     (define-integration-dependencies "back" "mermap" "back" "regmap")
  564.     (define-integration-dependencies "back" "regmap" "base" "utils")
  565.     (define-integration-dependencies "back" "symtab" "base" "utils"))
  566.  
  567.   (for-each (lambda (node)
  568.           (let ((links (source-node/backward-links node)))
  569.         (if (not (null? links))
  570.             (set-source-node/declarations!
  571.              node
  572.              (cons (make-integration-declaration
  573.                 (source-node/pathname node)
  574.                 (map source-node/pathname links))
  575.                (source-node/declarations node))))))
  576.         source-nodes))
  577.  
  578. (define (make-integration-declaration pathname integration-dependencies)
  579.   `(INTEGRATE-EXTERNAL
  580.     ,@(map (let ((default
  581.           (make-pathname
  582.            false
  583.            false
  584.            (cons 'RELATIVE
  585.              (make-list
  586.               (length (cdr (pathname-directory pathname)))
  587.               'UP))
  588.            false
  589.            false
  590.            false)))
  591.          (lambda (pathname)
  592.            (merge-pathnames pathname default)))
  593.        integration-dependencies)))
  594.  
  595. (define-integrable (integration-declaration? declaration)
  596.   (eq? (car declaration) 'INTEGRATE-EXTERNAL))
  597.  
  598. ;;;; Expansion Dependencies
  599.  
  600. (define (initialize/expansion-dependencies!)
  601.   (let ((file-dependency/expansion/join
  602.      (lambda (filenames expansions)
  603.        (for-each (lambda (filename)
  604.                (let ((node (filename->source-node filename)))
  605.              (set-source-node/declarations!
  606.               node
  607.               (cons (make-expansion-declaration expansions)
  608.                 (source-node/declarations node)))))
  609.              filenames))))
  610.     (file-dependency/expansion/join
  611.      (filename/append "machines/i386"
  612.               "lapgen" "rules1" "rules2" "rules3" "rules4"
  613.               "rulfix" "rulflo")
  614.      (map (lambda (entry)
  615.         `(,(car entry)
  616.           (PACKAGE/REFERENCE (FIND-PACKAGE '(COMPILER LAP-SYNTAXER))
  617.                  ',(cadr entry))))
  618.       '((LAP:SYNTAX-INSTRUCTION LAP:SYNTAX-INSTRUCTION-EXPANDER)
  619.         (INSTRUCTION->INSTRUCTION-SEQUENCE
  620.          INSTRUCTION->INSTRUCTION-SEQUENCE-EXPANDER)
  621.         (SYNTAX-EVALUATION SYNTAX-EVALUATION-EXPANDER)
  622.         (CONS-SYNTAX CONS-SYNTAX-EXPANDER)
  623.         (OPTIMIZE-GROUP-EARLY OPTIMIZE-GROUP-EXPANDER)
  624.         (EA-KEYWORD-EARLY EA-KEYWORD-EXPANDER)
  625.         (EA-MODE-EARLY EA-MODE-EXPANDER)
  626.         (EA-REGISTER-EARLY EA-REGISTER-EXPANDER)
  627.         (EA-EXTENSION-EARLY EA-EXTENSION-EXPANDER)
  628.         (EA-CATEGORIES-EARLY EA-CATEGORIES-EXPANDER))))))
  629.  
  630. (define-integrable (make-expansion-declaration expansions)
  631.   `(EXPAND-OPERATOR ,@expansions))
  632.  
  633. (define-integrable (expansion-declaration? declaration)
  634.   (eq? (car declaration) 'EXPAND-OPERATOR))