From: Chris Hanson Date: Thu, 3 Nov 1988 03:09:00 +0000 (+0000) Subject: Reset the set of source nodes whenever the compiler band is reloaded. X-Git-Tag: 20090517-FFI~12457 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=729c1ef6ec7107caeb3587aaa54fd346a2565d3a;p=mit-scheme.git Reset the set of source nodes whenever the compiler band is reloaded. This should help prevent problems with non-existent files. Also, during second pass to resyntax files that have circular dependencies, touch the dependents that have been syntaxed in the first pass, so that they have the proper time relationships to the resyntaxed files. --- diff --git a/v7/src/compiler/machines/bobcat/decls.scm b/v7/src/compiler/machines/bobcat/decls.scm index 9ba2ca1f8..5b7bf5b78 100644 --- a/v7/src/compiler/machines/bobcat/decls.scm +++ b/v7/src/compiler/machines/bobcat/decls.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/decls.scm,v 4.9 1988/11/01 04:57:13 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/decls.scm,v 4.10 1988/11/03 03:09:00 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -37,18 +37,35 @@ MIT in each case. |# (declare (usual-integrations)) (define (initialize-package!) - (set! source-filenames - (mapcan (lambda (subdirectory) - (map (lambda (pathname) + (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 + (mapcan (lambda (subdirectory) + (map (lambda (pathname) + (string-append subdirectory + "/" + (pathname-name pathname))) + (directory-read (string-append subdirectory "/" - (pathname-name pathname))) - (directory-read - (string-append subdirectory - "/" - source-file-expression)))) - '("back" "base" "fggen" "fgopt" "rtlbase" "rtlgen" "rtlopt" - "machines/bobcat"))) + source-file-expression)))) + '("back" "base" "fggen" "fgopt" "rtlbase" "rtlgen" "rtlopt" + "machines/bobcat")))) + (if (null? filenames) + (error "Can't find source files of compiler")) + (set! source-filenames filenames)) (set! source-hash (make/hash-table 101 @@ -68,12 +85,11 @@ MIT in each case. |# (initialize/expansion-dependencies!) (source-nodes/rank!)) -(define source-file-expression "*.bin") +(define source-file-expression "*.scm") (define source-filenames) (define source-hash) (define source-nodes) (define source-nodes/by-rank) -(define source-nodes/circular-dependencies) (define (filename/append directory . names) (map (lambda (name) (string-append directory "/" name)) names)) @@ -100,6 +116,9 @@ MIT in each case. |# 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 @@ -132,11 +151,7 @@ MIT in each case. |# (define (source-nodes/rank!) (compute-dependencies! source-nodes) (compute-ranks! source-nodes) - (set! source-nodes/by-rank (source-nodes/sort-by-rank source-nodes)) - (set! source-nodes/circular-dependencies - (list-transform-positive source-nodes/by-rank - (lambda (node) - (memq node (source-node/backward-closure node)))))) + (set! source-nodes/by-rank (source-nodes/sort-by-rank source-nodes))) (define (compute-dependencies! nodes) (for-each (lambda (node) @@ -180,6 +195,7 @@ MIT in each case. |# ;;;; File Syntaxer (define (syntax-files!) + (maybe-setup-source-nodes!) (for-each (lambda (node) (let ((modification-time @@ -239,14 +255,19 @@ MIT in each case. |# (if (file-exists? pathname) (delete-file pathname))))) source-nodes/by-rank) - (for-each source-node/maybe-syntax! source-nodes/by-rank) - (for-each source-node/maybe-syntax! source-nodes/circular-dependencies)) + (for-each (lambda (node) + (if (not (source-node/modification-time node)) + (source-node/syntax! node))) + source-nodes/by-rank) + (for-each (lambda (node) + (if (not (source-node/modification-time node)) + (if (source-node/circular? node) + (source-node/syntax! node) + (file-touch (source-node/pathname node))))) + source-nodes/by-rank)) -(define (source-node/maybe-syntax! node) - (if (not (source-node/modification-time node)) - (source-node/syntax! node))) - (define (sc filename) + (maybe-setup-source-nodes!) (source-node/syntax! (filename->source-node filename))) (define (source-node/syntax! node)