3
$Id: comfiles.scm,v 1.6 1999/01/02 06:06:43 cph Exp $
5
Copyright (c) 1989-1999 Massachusetts Institute of Technology
7
This program is free software; you can redistribute it and/or modify
3
$Id: comfiles.scm,v 1.9 2003/02/14 18:28:01 cph Exp $
5
Copyright 1989,1991,1993,2003 Massachusetts Institute of Technology
7
This file is part of MIT/GNU Scheme.
9
MIT/GNU Scheme is free software; you can redistribute it and/or modify
8
10
it under the terms of the GNU General Public License as published by
9
11
the Free Software Foundation; either version 2 of the License, or (at
10
12
your option) any later version.
12
This program is distributed in the hope that it will be useful, but
14
MIT/GNU Scheme is distributed in the hope that it will be useful, but
13
15
WITHOUT ANY WARRANTY; without even the implied warranty of
14
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15
17
General Public License for more details.
17
19
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
along with MIT/GNU Scheme; if not, write to the Free Software
21
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
22
26
;;;; Stage recompilation checks
26
30
(define compiler-directories
27
31
`("back" "base" "fggen" "fgopt" "rtlbase" "rtlgen" "rtlopt"
28
,(if (equal? microcode-id/operating-system-name "unix")
32
,(if (eq? 'UNIX microcode-id/operating-system)
32
36
(define runtime-directories
33
37
'("runtime" "sf" "cref"))
76
80
(define (check-compiler #!optional stage)
77
81
(check-stage compiler-directories
78
(if (default-object? stage) "STAGE2" stage)))
b'\\ No newline at end of file'
82
(if (default-object? stage) "STAGE2" stage)))
84
(define (compare-trees root1 root2)
87
(pathname-as-directory (merge-pathnames d root1))
88
(pathname-as-directory (merge-pathnames d root2))))
89
(append runtime-directories
90
(map (lambda (d) (string-append "compiler/" d))
91
compiler-directories))))
93
(define (compare-directory d1 d2)
94
(for-each (lambda (p1)
95
(let ((p2 (merge-pathnames (file-pathname p1) d2)))
97
(show-differences p1 p2)
98
(warn "Directory mismatch" `(,p1 exists ,p2 does not)))))
99
(directory-read (merge-pathnames "*.com" d1))))
b'\\ No newline at end of file'