suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

run mats configurations in parallel

Browse Source 
* refactor mats to allow different configurations to run in parallel.

The {partial,all,bully}x targets now support being run in parallel should
make decide to do so (e.g., via the -j flag)

* fix mats ignoring "rmg" parameter

* Update travis-ci build scripts to use new partialx target and run multiple
jobs in parallel, based on the number of processors available.

* Add a way to only run particular machines in travis-ci by including
a line that starts with "travis:only:" and lists the machine types in the
commit message.
This commit is contained in:
Jamie Taylor 2021-05-04 09:33:44 -06:00 committed by Matthew Flatt
parent 68d8c8acc2
commit 88cb6aae10
20 changed files with 325 additions and 266 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
racket/src/ChezScheme/LOG
View File

@ -2195,3 +2195,15 @@
foreign.stex foreign.stex
- New spellings #true and #false for #t and #f are recognized - New spellings #true and #false for #t and #f are recognized
read.ss 6.ms read.ss 6.ms
- refactor mats to allow different configurations to run in parallel.
The {partial,all,bully}x targets in Mats/Mf-base now support running
in parallel if make chooses to do so (e.g., if instructed via -j).
Update travis-ci build scripts to use new partialx target and run
jobs in parallel (based on the number of cores available). Also
add the ability to "skip" (i.e., error before building) travis targets
by using a line (or lines) beginning with "travis:only:" and listing
the desired target machine type(s) in the commit message.
.travis.yml .travis/{build,test,maybe-skip-build}.sh
mats/{5_4,6,7,8,bytevector,examples,foreign}.ms
mats/{ftype,hash,io,misc,primvars,profile,record}.ms
mats/Mf-base mats/Mf-*nt mats/mat.ss mats/patch-interpret*

4
racket/src/ChezScheme/mats/5_4.ms
View File

@ -992,7 +992,7 @@
(error? (string-normalize-nfkc "hello" "goodbye")) (error? (string-normalize-nfkc "hello" "goodbye"))
(error? (string-normalize-nfkc 'ouch)) (error? (string-normalize-nfkc 'ouch))
(begin (begin
(load "../unicode/unicode-data.ss") (load (format "~a/../unicode/unicode-data.ss" *mats-dir*))
#t) #t)
(let () (let ()
(import (unicode-data)) (import (unicode-data))
@ -1014,7 +1014,7 @@
(let ([data (map (lambda (x) (map conv (list-head x 5))) (let ([data (map (lambda (x) (map conv (list-head x 5)))
(filter (lambda (x) (>= (length x) 5)) (filter (lambda (x) (>= (length x) 5))
(get-unicode-data (get-unicode-data
"../unicode/UNIDATA/NormalizationTest.txt")))]) (format "~a/../unicode/UNIDATA/NormalizationTest.txt" *mats-dir*))))])
(define NFD string-normalize-nfd) (define NFD string-normalize-nfd)
(define NFKD string-normalize-nfkd) (define NFKD string-normalize-nfkd)
(define NFC string-normalize-nfc) (define NFC string-normalize-nfc)

61
racket/src/ChezScheme/mats/6.ms
View File

@ -15,6 +15,8 @@
;;; sections 6-1 and 6-2: ;;; sections 6-1 and 6-2:
(define prettytest.ss (format "~a/prettytest.ss" *mats-dir*))
(mat current-input-port (mat current-input-port
(port? (current-input-port)) (port? (current-input-port))
(input-port? (current-input-port)) (input-port? (current-input-port))
@ -422,21 +424,21 @@
mode2)) mode2))
mode1)))) mode1))))
(and (and
(cmp '() "prettytest.ss" '() "prettytest.ss") (cmp '() prettytest.ss '() prettytest.ss)
(cmp '(compressed) "prettytest.ss" '() "prettytest.ss") (cmp '(compressed) prettytest.ss '() prettytest.ss)
(cmp '() "prettytest.ss" '(compressed) "prettytest.ss") (cmp '() prettytest.ss '(compressed) prettytest.ss)
(cmp '(compressed) "prettytest.ss" '(compressed) "prettytest.ss") (cmp '(compressed) prettytest.ss '(compressed) prettytest.ss)
(begin (begin
(cp '(replace compressed) "prettytest.ss" "testfile.ss") (cp '(replace compressed) prettytest.ss "testfile.ss")
#t) #t)
(cmp '(compressed) "testfile.ss" '() "prettytest.ss") (cmp '(compressed) "testfile.ss" '() prettytest.ss)
(not (= (call-with-input-file "testfile.ss" file-length) (call-with-input-file "prettytest.ss" file-length))) (not (= (call-with-input-file "testfile.ss" file-length) (call-with-input-file prettytest.ss file-length)))
; the following test could cause an error with anything but latin-1 codec ; the following test could cause an error with anything but latin-1 codec
#;(not (cmp '() "testfile.ss" '() "prettytest.ss")) #;(not (cmp '() "testfile.ss" '() prettytest.ss))
(begin (begin
(cp '(compressed append) "prettytest.ss" "testfile.ss") (cp '(compressed append) prettytest.ss "testfile.ss")
#t) #t)
(not (cmp '(compressed) "testfile.ss" '() "prettytest.ss")) (not (cmp '(compressed) "testfile.ss" '() prettytest.ss))
)) ))
(error? (open-output-file "testfile.ss" '(replace append))) (error? (open-output-file "testfile.ss" '(replace append)))
(error? (open-output-file "testfile.ss" '(append truncate))) (error? (open-output-file "testfile.ss" '(append truncate)))
@ -819,8 +821,8 @@
(lambda () (lambda ()
(close-input-port ip) (close-input-port ip)
(close-output-port op)))))]) (close-output-port op)))))])
(pretty-copy "prettytest.ss" "testfile.ss")) (pretty-copy prettytest.ss "testfile.ss"))
(let ([p1 (open-input-file "prettytest.ss")] (let ([p1 (open-input-file prettytest.ss)]
[p2 (open-input-file "testfile.ss")]) [p2 (open-input-file "testfile.ss")])
(dynamic-wind (dynamic-wind
(lambda () #f) (lambda () #f)
@ -877,8 +879,8 @@
(lambda () (lambda ()
(close-input-port ip) (close-input-port ip)
(close-output-port op)))))]) (close-output-port op)))))])
(unpretty-copy "prettytest.ss" "testfile.ss")) (unpretty-copy prettytest.ss "testfile.ss"))
(let ([p1 (open-input-file "prettytest.ss")] (let ([p1 (open-input-file prettytest.ss)]
[p2 (open-input-file "testfile.ss")]) [p2 (open-input-file "testfile.ss")])
(dynamic-wind (dynamic-wind
(lambda () #f) (lambda () #f)
@ -921,7 +923,7 @@
(lambda (p) (fasl-write +nan.0 p))) (lambda (p) (fasl-write +nan.0 p)))
(call-with-port (open-file-input-port "testfile.ss") fasl-read)) (call-with-port (open-file-input-port "testfile.ss") fasl-read))
(/ 0.0 0.0)) (/ 0.0 0.0))
(let ([ls (with-input-from-file "prettytest.ss" (let ([ls (with-input-from-file prettytest.ss
(rec f (rec f
(lambda () (lambda ()
(let ([x (read)]) (let ([x (read)])
@ -971,8 +973,8 @@
(open-bytevector-input-port (open-bytevector-input-port
(call-with-bytevector-output-port put-stuff)) (call-with-bytevector-output-port put-stuff))
(get-stuff fasl-read))))) (get-stuff fasl-read)))))
(eqv? (fasl-file "prettytest.ss" "testfile.ss") (void)) (eqv? (fasl-file prettytest.ss "testfile.ss") (void))
(let ([ls (with-input-from-file "prettytest.ss" (let ([ls (with-input-from-file prettytest.ss
(rec f (rec f
(lambda () (lambda ()
(let ([x (read)]) (let ([x (read)])
@ -2693,8 +2695,8 @@
(eq? '\x23;foo\x7C;bar '\#foo\|bar) (eq? '\x23;foo\x7C;bar '\#foo\|bar)
) )
(mat with-source-path (mat with-source-path (parameters [current-directory *mats-dir*] [source-directories '(".")] [library-directories '(".")])
(equal? (source-directories) '(".")) (equal? (separate-eval '(source-directories)) "(\".\")\n")
(equal? (equal?
(with-source-path 'test "I should not be here" list) (with-source-path 'test "I should not be here" list)
'("I should not be here")) '("I should not be here"))
@ -3029,6 +3031,18 @@
(error? (get-mode "probably/not/there")) (error? (get-mode "probably/not/there"))
(error? (get-mode "probably/not/there" #f)) (error? (get-mode "probably/not/there" #f))
(error? (get-mode "probably/not/there" #t)) (error? (get-mode "probably/not/there" #t))
(error? (file-access-time "probably/not/there"))
(error? (file-access-time "probably/not/there" #f))
(error? (file-access-time "probably/not/there" #t))
(error? (file-change-time "probably/not/there"))
(error? (file-change-time "probably/not/there" #f))
(error? (file-change-time "probably/not/there" #t))
(error? (file-modification-time "probably/not/there"))
(error? (file-modification-time "probably/not/there" #f))
(error? (file-modification-time "probably/not/there" #t))
)
(mat filesystem-operations2 (parameters [current-directory *mats-dir*])
(if (or (windows?) (embedded?)) (if (or (windows?) (embedded?))
(fixnum? (get-mode "mat.ss")) (fixnum? (get-mode "mat.ss"))
(let ([m (get-mode "mat.ss")]) (let ([m (get-mode "mat.ss")])
@ -3079,15 +3093,6 @@
(time=? (file-change-time "Makefile") (file-change-time "Mf-unix"))) (time=? (file-change-time "Makefile") (file-change-time "Mf-unix")))
(or (windows?) (embedded?) (or (windows?) (embedded?)
(time=? (file-modification-time "Makefile") (file-modification-time "Mf-unix"))) (time=? (file-modification-time "Makefile") (file-modification-time "Mf-unix")))
(error? (file-access-time "probably/not/there"))
(error? (file-access-time "probably/not/there" #f))
(error? (file-access-time "probably/not/there" #t))
(error? (file-change-time "probably/not/there"))
(error? (file-change-time "probably/not/there" #f))
(error? (file-change-time "probably/not/there" #t))
(error? (file-modification-time "probably/not/there"))
(error? (file-modification-time "probably/not/there" #f))
(error? (file-modification-time "probably/not/there" #t))
) )
(mat unicode-filesystem-operations (mat unicode-filesystem-operations

6
racket/src/ChezScheme/mats/7.ms
View File

@ -1121,12 +1121,12 @@
"(aye captain)\n") "(aye captain)\n")
(equal? (equal?
(begin (begin
(unless (or (embedded?) (equal? *scheme* (format "../bin/~a/scheme~a" (machine-type) (if (windows?) ".exe" "")))) (unless (or (embedded?) (equal? *scheme* (format "~a/bin/~a/scheme~a" (path-parent *mats-dir*) (machine-type) (if (windows?) ".exe" ""))))
(errorf #f "not testing boot file based on ../boot/~a/petite.boot, since *scheme* isn't ../bin/~a/scheme~a" (errorf #f "not testing boot file based on ../boot/~a/petite.boot, since *scheme* isn't ../bin/~a/scheme~a"
(machine-type) (machine-type) (if (windows?) ".exe" ""))) (machine-type) (machine-type) (if (windows?) ".exe" "")))
(parameterize ([optimize-level 2]) (parameterize ([optimize-level 2])
(make-boot-file "testfile.boot" '() (make-boot-file "testfile.boot" '()
(format "../boot/~a/petite.boot" (machine-type)) (format "~a/boot/~a/petite.boot" (path-parent *mats-dir*) (machine-type))
"testfile-1.so" "testfile-1.so"
"testfile-2.so" "testfile-2.so"
"testfile-3.ss" "testfile-3.ss"
@ -1152,7 +1152,7 @@
(case (machine-type) [(pb) #t] [else #f]) ; no callables in pb (case (machine-type) [(pb) #t] [else #f]) ; no callables in pb
(equal? (equal?
(begin (begin
(unless (or (embedded?) (equal? *scheme* (format "../bin/~a/scheme~a" (machine-type) (if (windows?) ".exe" "")))) (unless (or (embedded?) (equal? *scheme* (format "~a/bin/~a/scheme~a" (path-parent *mats-dir*) (machine-type) (if (windows?) ".exe" ""))))
(errorf #f "not testing boot file based on ../boot/~a/petite.boot, since *scheme* isn't ../bin/~a/scheme~a" (errorf #f "not testing boot file based on ../boot/~a/petite.boot, since *scheme* isn't ../bin/~a/scheme~a"
(machine-type) (machine-type) (if (windows?) ".exe" ""))) (machine-type) (machine-type) (if (windows?) ".exe" "")))
(mkfile "testfile.ss" (mkfile "testfile.ss"

4
racket/src/ChezScheme/mats/8.ms
View File

@ -10606,7 +10606,9 @@
(separate-compile 'imno1) (separate-compile 'imno1)
#t) #t)
(equal? (equal?
(parameterize ([console-output-port (open-output-string)]) (parameterize ([source-directories '(".")]
[library-directories '(".")]
[console-output-port (open-output-string)])
(eval '(lambda () (import (testfile-imno2)) y)) (eval '(lambda () (import (testfile-imno2)) y))
(get-output-string (console-output-port))) (get-output-string (console-output-port)))
"import: did not find source file \"testfile-imno2.chezscheme.sls\"\nimport: found source file \"testfile-imno2.ss\"\nimport: did not find corresponding object file \"testfile-imno2.so\"\nimport: loading source file \"testfile-imno2.ss\"\nimport: did not find source file \"testfile-imno1.chezscheme.sls\"\nimport: found source file \"testfile-imno1.ss\"\nimport: found corresponding object file \"testfile-imno1.so\"\nimport: object file is not older\nimport: visiting object file \"testfile-imno1.so\"\nattempting to 'revisit' previously 'visited' \"testfile-imno1.so\" for library (testfile-imno1) run-time info\n") "import: did not find source file \"testfile-imno2.chezscheme.sls\"\nimport: found source file \"testfile-imno2.ss\"\nimport: did not find corresponding object file \"testfile-imno2.so\"\nimport: loading source file \"testfile-imno2.ss\"\nimport: did not find source file \"testfile-imno1.chezscheme.sls\"\nimport: found source file \"testfile-imno1.ss\"\nimport: found corresponding object file \"testfile-imno1.so\"\nimport: object file is not older\nimport: visiting object file \"testfile-imno1.so\"\nattempting to 'revisit' previously 'visited' \"testfile-imno1.so\" for library (testfile-imno1) run-time info\n")

4
racket/src/ChezScheme/mats/Mf-a6nt
View File

@ -1,5 +1,5 @@
# Mf-a6nt # Mf-a6nt
# Copyright 1984-2017 Cisco Systems, Inc. # Copyright 1984-2021 Cisco Systems, Inc.
# #
# Licensed under the Apache License, Version 2.0 (the "License"); # Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License. # you may not use this file except in compliance with the License.
@ -25,5 +25,5 @@ export MSYS_NO_PATHCONV=1
foreign1.so: $(fsrc) foreign1.so: $(fsrc)
cmd.exe /c "vs.bat amd64 && cl /DWIN32 /DX86_64 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv955.lib $(fsrc)" cmd.exe /c "vs.bat amd64 && cl /DWIN32 /DX86_64 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv955.lib $(fsrc)"
cat_flush: cat_flush.c cat_flush.exe: cat_flush.c
cmd.exe /c "vs.bat amd64 && cl /DWIN32 /DX86_64 /MD /nologo $<" cmd.exe /c "vs.bat amd64 && cl /DWIN32 /DX86_64 /MD /nologo $<"

256
racket/src/ChezScheme/mats/Mf-base
View File

@ -1,5 +1,5 @@
# Mf-base # Mf-base
# Copyright 1984-2017 Cisco Systems, Inc. # Copyright 1984-2021 Cisco Systems, Inc.
# #
# Licensed under the Apache License, Version 2.0 (the "License"); # Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License. # you may not use this file except in compliance with the License.
@ -18,14 +18,20 @@
# Running "make" or "make all" in this directory runs the mats (test # Running "make" or "make all" in this directory runs the mats (test
# programs) and produces a report of bugs and errors. Unless you make # programs) and produces a report of bugs and errors. Unless you make
# changes to the mats or to the system, the report file report-$(conf) # changes to the mats or to the system, the report file report-$(conf)
# (where $(conf) is set below) # (where $(conf) is set below) will be output in the $(outdir) directory.
# If an error or bug report occurs, refer to the offending ".mo" file # If an error or bug report occurs, refer to the offending ".mo" file
# produced by the mats and mentioned in the bug or error report to # produced by the mats and mentioned in the bug or error report to
# determine what failed. # determine what failed.
# Running "make allx" runs a set of mats with various settings. # Running "make allx" runs a set of mats with various settings. "make
# "make bullyx" runs a different, more stressful set. # bullyx" runs a different, more stressful set. These targets allow make
# to run the various configurations in parallel (if so configured, e.g.
# with the -j flag). Most output from each parallel execution is directed
# to (separate) files, with status printed to stdout when testing of each
# different configuration begins and ends. In addition, each target
# concatenates the summary file from all configurations run into "summary"
# in the current directory.
# Running make with the argument "clean" removes the .so files, .mo # Running make with the argument "clean" removes the .so files, .mo
# files, report files, and temporary files generated by the mats. # files, report files, and temporary files generated by the mats.
@ -36,6 +42,8 @@
include Mf-config include Mf-config
MatsDir = $(abspath .)
ifeq (${OS},Windows_NT) ifeq (${OS},Windows_NT)
dirsep = ; dirsep = ;
else else
@ -52,8 +60,8 @@ endif
# Scheme is the scheme executable to test, SCHEMEHEAPDIRS tells # Scheme is the scheme executable to test, SCHEMEHEAPDIRS tells
# it where to find its boot files, and CHEZSCHEMELIBDIRS tells # it where to find its boot files, and CHEZSCHEMELIBDIRS tells
# it where to find libraries. # it where to find libraries.
Scheme = ../bin/$m/scheme${ExeSuffix} Scheme = $(abspath ../bin/$m/scheme${ExeSuffix})
export SCHEMEHEAPDIRS=.${dirsep}../boot/%m export SCHEMEHEAPDIRS=.${dirsep}$(abspath ../boot)/%m
export CHEZSCHEMELIBDIRS=. export CHEZSCHEMELIBDIRS=.
# Include is the directory holding scheme.h. # Include is the directory holding scheme.h.
@ -138,17 +146,20 @@ defaultc = f
c = $(defaultc) c = $(defaultc)
# set of coverage files to load # set of coverage files to load
coverage-files = ../boot/$m/petite.covin ../boot/$m/scheme.covin coverage-files = $(abspath ../boot/$m/petite.covin ../boot/$m/scheme.covin)
# set of mats to run # set of mats to run
mats = primvars 3 4 5_1 5_2 5_3 5_4 5_5 bytevector thread profile\ mats = primvars 3 4 5_1 5_2 5_3 5_4 5_5 bytevector thread profile\
misc cp0 cptypes 5_6 5_7 5_8 6 io format 7 record hash enum 8 fx fl cfl foreign\ misc cp0 cptypes 5_6 5_7 5_8 6 io format 7 record hash enum 8 fx fl cfl foreign\
ftype unix windows examples ieee date exceptions oop ftype unix windows examples ieee date exceptions oop
Examples = ../examples Examples = $(abspath ../examples)
MAKEFLAGS += --no-print-directory MAKEFLAGS += --no-print-directory
# directory where (most) output for this run will be written
outdir=output
conf = $(eval)-$o-$(spi)-$(cp0)-$(cis) conf = $(eval)-$o-$(spi)-$(cp0)-$(cis)
objdir=output-$(conf) objdir=output-$(conf)
objname = $(mats:%=%.mo) objname = $(mats:%=%.mo)
@ -162,8 +173,8 @@ prettysrc = 3.ms 5_3.ms 5_4.ms 5_5.ms bytevector.ms thread.ms profile.ms\
fx.ms fl.ms cfl.ms foreign.ms unix.ms windows.ms examples.ms ieee.ms date.ms\ fx.ms fl.ms cfl.ms foreign.ms unix.ms windows.ms examples.ms ieee.ms date.ms\
exceptions.ms exceptions.ms
$(objdir)/%.mo : %.ms mat.so define conf-scheme-code
echo '(optimize-level $o)'\ '(optimize-level $o)'\
'(#%$$suppress-primitive-inlining #${spi})'\ '(#%$$suppress-primitive-inlining #${spi})'\
'(heap-check-interval ${hci})'\ '(heap-check-interval ${hci})'\
'(#%$$enable-check-prelex-flags #${ecpf})'\ '(#%$$enable-check-prelex-flags #${ecpf})'\
@ -175,12 +186,19 @@ $(objdir)/%.mo : %.ms mat.so
'(in-place-minimum-generation ${ipmg})'\ '(in-place-minimum-generation ${ipmg})'\
'(enable-object-counts #${eoc})'\ '(enable-object-counts #${eoc})'\
'(commonization-level ${cl})'\ '(commonization-level ${cl})'\
'(release-minimum-generation ${rmg})'\
'(compile-interpret-simple #${cis})'\ '(compile-interpret-simple #${cis})'\
'(set! *examples-directory* "${Examples}")'\ '(set! *examples-directory* "${Examples}")'\
'(enable-cp0 #${cp0})'\ '(enable-cp0 #${cp0})'\
'(set! *scheme* "${Scheme}")'\ '(set! *scheme* "${Scheme}")'\
'(set! *mats-dir* "${MatsDir}")'\
'(set! $$cat_flush "${MatsDir}/cat_flush${ExeSuffix}")'\
'(current-eval ${eval})'\ '(current-eval ${eval})'\
'(when #$c (coverage-table (load-coverage-files ${coverage-files:%="%"})))'\ '(when #$c (coverage-table (load-coverage-files ${coverage-files:%="%"})))'
endef
$(objdir)/%.mo : %.ms mat.so
echo $(conf-scheme-code)\
'(time ((mat-file "$(objdir)") "$*"))'\ '(time ((mat-file "$(objdir)") "$*"))'\
'(unless (= (#%$$check-heap-errors) 0)'\ '(unless (= (#%$$check-heap-errors) 0)'\
' (fprintf (console-error-port) "check heap detected errors---grep standard output for !!!\n")'\ ' (fprintf (console-error-port) "check heap detected errors---grep standard output for !!!\n")'\
@ -189,24 +207,7 @@ $(objdir)/%.mo : %.ms mat.so
# same as above except puts the .mo file in . # same as above except puts the .mo file in .
%.mo : %.ms mat.so %.mo : %.ms mat.so
echo '(optimize-level $o)'\ echo $(conf-scheme-code)\
'(#%$$suppress-primitive-inlining #${spi})'\
'(heap-check-interval ${hci})'\
'(#%$$enable-check-prelex-flags #${ecpf})'\
'(compile-profile #$p)'\
'(collect-notify #${cn})'\
'(collect-trip-bytes ${ctb})'\
'(collect-generation-radix ${cgr})'\
'(collect-maximum-generation ${cmg})'\
'(in-place-minimum-generation ${ipmg})'\
'(enable-object-counts #${eoc})'\
'(commonization-level ${cl})'\
'(compile-interpret-simple #${cis})'\
'(set! *examples-directory* "${Examples}")'\
'(enable-cp0 #${cp0})'\
'(set! *scheme* "${Scheme}")'\
'(current-eval ${eval})'\
'(when #$c (coverage-table (load-coverage-files ${coverage-files:%="%"})))'\
'(time ((mat-file ".") "$*"))'\ '(time ((mat-file ".") "$*"))'\
'(parameterize ([source-directories (quote ("." "../s"))]) (when #${pdhtml} (profile-dump-html)))'\ '(parameterize ([source-directories (quote ("." "../s"))]) (when #${pdhtml} (profile-dump-html)))'\
'(unless (= (#%$$check-heap-errors) 0)'\ '(unless (= (#%$$check-heap-errors) 0)'\
@ -217,32 +218,32 @@ $(objdir)/%.mo : %.ms mat.so
%.so : %.ss %.so : %.ss
echo '(reset-handler abort) (time (compile-file "$*"))' | ${Scheme} -q ${patchfile} echo '(reset-handler abort) (time (compile-file "$*"))' | ${Scheme} -q ${patchfile}
report: report-$(conf) report: $(outdir)/report-$(conf)
experr: experr-$(conf) experr: experr-$(conf)
report-$(conf): errors-$(conf) $(outdir)/report-$(conf): $(outdir)/errors-$(conf)
$(MAKE) doreport $(MAKE) doreport
doreport: experr-$(conf) doreport: experr-$(conf)
rm -f report-$(conf) rm -f $(outdir)/report-$(conf)
-diff experr-$(conf) errors-$(conf) > report-$(conf) 2>&1 -diff experr-$(conf) $(outdir)/errors-$(conf) > $(outdir)/report-$(conf) 2>&1
maybe-doreport: maybe-doreport:
-if [ -f errors-$(conf) ] ; then\ -if [ -f $(outdir)/errors-$(conf) ] ; then\
$(MAKE) doreport ;\ $(MAKE) doreport ;\
fi fi
errors-$(conf): ${obj} $(outdir)/errors-$(conf): ${obj}
$(MAKE) doerrors $(MAKE) doerrors
doerrors: doerrors:
rm -f errors-$(conf) rm -f $(outdir)/errors-$(conf)
-(cd $(objdir); grep '^Error' $(objname)) > errors-$(conf) -(cd $(objdir); grep '^Error' $(objname)) > $(outdir)/errors-$(conf)
-(cd $(objdir); grep '^Bug' $(objname)) >> errors-$(conf) -(cd $(objdir); grep '^Bug' $(objname)) >> $(outdir)/errors-$(conf)
-(cd $(objdir); grep '^Warning' $(objname)) >> errors-$(conf) -(cd $(objdir); grep '^Warning' $(objname)) >> $(outdir)/errors-$(conf)
-(cd $(objdir); grep '^Expected' $(objname))\ -(cd $(objdir); grep '^Expected' $(objname))\
>> errors-$(conf) >> $(outdir)/errors-$(conf)
fastreport: fastreport:
$(MAKE) doerrors $(MAKE) doerrors
@ -263,26 +264,56 @@ doallcoverage: mat.so
echo '(reset-handler abort) (coverage-percent "run.covout" ${coverage-files:%="%"})' | ${Scheme} -q ${patchfile} mat.so ;\ echo '(reset-handler abort) (coverage-percent "run.covout" ${coverage-files:%="%"})' | ${Scheme} -q ${patchfile} mat.so ;\
fi fi
partialx: define parallel-config-template
$(MAKE) allxhelp o=0 parallel$(1)-0:
$(MAKE) allxhelp o=3 -@$(MAKE) allxphelp outdir=output-$(1)-0 objdir=output-$(1)-0 o=0 $(2)
$(MAKE) allxhelp o=3 cp0=t parallel$(1)-3:
$(MAKE) allxhelp o=3 eval=interpret cp0=t rmg=2 -@$(MAKE) allxphelp outdir=output-$(1)-3 objdir=output-$(1)-3 o=3 $(2)
endef
allx: prettyclean #configs from partialx and allx
$(MAKE) allxhelp o=0 eoc=f $(eval $(call parallel-config-template,1,eoc=f))
$(MAKE) allxhelp o=3 eoc=f $(eval $(call parallel-config-template,2,cp0=t))
$(MAKE) allxhelp o=0 cp0=t cl=3 $(eval $(call parallel-config-template,3,cp0=t cl=3))
$(MAKE) allxhelp o=3 cp0=t cl=3 $(eval $(call parallel-config-template,4,spi=t rmg=2 p=t))
$(MAKE) allxhelp o=0 spi=t rmg=2 p=t $(eval $(call parallel-config-template,5,eval=interpret cl=6))
$(MAKE) allxhelp o=3 spi=t rmg=2 p=t $(eval $(call parallel-config-template,6,eval=interpret cp0=t rmg=2))
$(MAKE) allxhelp o=0 eval=interpret cl=6 $(eval $(call parallel-config-template,7,eoc=f hci=101 cl=9))
$(MAKE) allxhelp o=3 eval=interpret cl=6 $(eval $(call parallel-config-template,8,eval=interpret hci=101 rmg=2))
$(MAKE) allxhelp o=0 eval=interpret cp0=t rmg=2
$(MAKE) allxhelp o=3 eval=interpret cp0=t rmg=2 #configs from bullyx
$(MAKE) allxhelp o=0 eoc=f hci=101 cl=9 $(eval $(call parallel-config-template,b1,allxphelp-target=allxhelpnotall spi=t cp0=f))
$(MAKE) allxhelp o=3 eval=interpret hci=101 rmg=2 $(eval $(call parallel-config-template,b2,spi=f cp0=f cl=9 ctb='(/ (collect-trip-bytes) 64)' hci=503))
$(MAKE) doallcoverage $(eval $(call parallel-config-template,b3,spi=t cp0=f cis=t cmg=1))
$(eval $(call parallel-config-template,b4,spi=f cp0=f cis=t cmg=6 hci=101))
$(eval $(call parallel-config-template,b5,spi=t cp0=t ctb='(/ (collect-trip-bytes) 64)' cgr=6))
$(eval $(call parallel-config-template,b6,spi=t cp0=f p=t eoc=f hci=101))
$(eval $(call parallel-config-template,b7,spi=f cp0=t cl=9 p=t hci=101))
$(eval $(call parallel-config-template,b8,eval=interpret spi=f cp0=f))
$(eval $(call parallel-config-template,b9,eval=interpret spi=f cp0=t))
$(eval $(call parallel-config-template,b10,eval=interpret spi=t cp0=f ctb='(/ (collect-trip-bytes) 64)' hci=503))
$(eval $(call parallel-config-template,b11,eval=interpret spi=t cp0=t cgr=2 hci=101 p=t))
partialx-confs = 1-0 1-3 2-3 6-3
allx-confs = 1-0 1-3 3-0 3-3 4-0 4-3 5-0 5-3 6-0 6-3 7-0 8-3
bullyx-confs = $(foreach n,1 2 3 4 5 6 7 8 9 10 11,b$(n)-0 b$(n)-3)
define parallel-target-template
$(1)-targets: $($(1)-confs:%=parallel%)
$(1): prettyclean
@echo building prereqs with output to Make.out
@$(MAKE) parallel-prereqs > Make.out 2>&1
@$(MAKE) $(1)-targets
$(if $(2),@$(MAKE) $(2))
cat $($(1)-confs:%=output-%/summary) > summary && cat summary
endef
$(eval $(call parallel-target-template,partialx))
$(eval $(call parallel-target-template,allx,doallcoverage))
$(eval $(call parallel-target-template,bullyx,doallcoverage))
just-reports: just-reports:
for EVAL in compile interpret ; do\ for EVAL in compile interpret ; do\
@ -297,51 +328,49 @@ just-reports:
done\ done\
done done
bullyx:
-$(MAKE) bully o=0
-$(MAKE) bully o=3
bully:
-$(MAKE) allxhelpnotall spi=t cp0=f
-$(MAKE) allxhelp spi=f cp0=f cl=9 ctb='(/ (collect-trip-bytes) 64)' hci=503
-$(MAKE) allxhelp spi=t cp0=f cis=t cmg=1
-$(MAKE) allxhelp spi=f cp0=f cis=t cmg=6 hci=101
-$(MAKE) allxhelp spi=t cp0=t ctb='(/ (collect-trip-bytes) 64)' cgr=6
-$(MAKE) allxhelp spi=t cp0=f p=t eoc=f hci=101
-$(MAKE) allxhelp spi=f cp0=t cl=9 p=t hci=101
-$(MAKE) allxhelp eval=interpret spi=f cp0=f
-$(MAKE) allxhelp eval=interpret spi=f cp0=t
-$(MAKE) allxhelp eval=interpret spi=t cp0=f ctb='(/ (collect-trip-bytes) 64)' hci=503
-$(MAKE) allxhelp eval=interpret spi=t cp0=t cgr=2 hci=101 p=t
$(MAKE) doallcoverage
allxhelp: allxhelp:
$(MAKE) doheader $(MAKE) doheader
-$(MAKE) all -$(MAKE) all
$(MAKE) dosummary $(MAKE) dosummary
doheader: config-vars = spi hci ecpf cp0 cis p eval ctb cgr cmg eoc cl rmg
printf "%s" "-------- o=$o" >> summary full-config-str = $(strip o=$(o) $(foreach var, $(config-vars),$(if $(filter-out $($(var:%=default%)),$($(var))),$(var)=$($(var)))) $(hdrmsg))
if [ "$(spi)" != "$(defaultspi)" ] ; then printf " spi=$(spi)" >> summary ; fi
if [ "$(hci)" != "$(defaulthci)" ] ; then printf " hci=$(hci)" >> summary ; fi allxphelp-target = allxhelp
if [ "$(ecpf)" != "$(defaultecpf)" ] ; then printf " ecpf(ecpf)" >> summary ; fi allxphelp: $(outdir)
if [ "$(cp0)" != "$(defaultcp0)" ] ; then printf " cp0=$(cp0)" >> summary ; fi @echo "matting configuration ($(full-config-str)) with output to $(outdir)/Make.out"
if [ "$(cis)" != "$(defaultcis)" ] ; then printf " cis=$(cis)" >> summary ; fi @$(MAKE) $(allxphelp-target) > "$(outdir)/Make.out" 2>&1
if [ "$p" != "$(defaultp)" ] ; then printf " p=$p" >> summary ; fi @echo "finished matting configuration $(full-config-str)"
if [ "$(eval)" != "$(defaulteval)" ] ; then printf " eval=$(eval)" >> summary ; fi
if [ "$(ctb)" != "$(defaultctb)" ] ; then printf " ctb=$(ctb)" >> summary ; fi summary-file=$(outdir)/summary
if [ "$(cgr)" != "$(defaultcgr)" ] ; then printf " cgr=$(cgr)" >> summary ; fi
if [ "$(cmg)" != "$(defaultcmg)" ] ; then printf " cmg=$(cmg)" >> summary ; fi $(outdir):
if [ "$(eoc)" != "$(defaulteoc)" ] ; then printf " eoc=$(eoc)" >> summary ; fi @mkdir -p "$(outdir)"
if [ "$(cl)" != "$(defaultcl)" ] ; then printf " cl=$(cl)" >> summary ; fi
if [ "$(hdrmsg)" != "" ] ; then printf " $(hdrmsg)" >> summary ; fi doheader: $(outdir)
printf "%s" "-------- o=$o" >> $(summary-file)
if [ "$(spi)" != "$(defaultspi)" ] ; then printf " spi=$(spi)" >> $(summary-file) ; fi
if [ "$(hci)" != "$(defaulthci)" ] ; then printf " hci=$(hci)" >> $(summary-file) ; fi
if [ "$(ecpf)" != "$(defaultecpf)" ] ; then printf " ecpf(ecpf)" >> $(summary-file) ; fi
if [ "$(cp0)" != "$(defaultcp0)" ] ; then printf " cp0=$(cp0)" >> $(summary-file) ; fi
if [ "$(cis)" != "$(defaultcis)" ] ; then printf " cis=$(cis)" >> $(summary-file) ; fi
if [ "$p" != "$(defaultp)" ] ; then printf " p=$p" >> $(summary-file) ; fi
if [ "$(eval)" != "$(defaulteval)" ] ; then printf " eval=$(eval)" >> $(summary-file) ; fi
if [ "$(ctb)" != "$(defaultctb)" ] ; then printf " ctb=$(ctb)" >> $(summary-file) ; fi
if [ "$(cgr)" != "$(defaultcgr)" ] ; then printf " cgr=$(cgr)" >> $(summary-file) ; fi
if [ "$(cmg)" != "$(defaultcmg)" ] ; then printf " cmg=$(cmg)" >> $(summary-file) ; fi
if [ "$(eoc)" != "$(defaulteoc)" ] ; then printf " eoc=$(eoc)" >> $(summary-file) ; fi
if [ "$(cl)" != "$(defaultcl)" ] ; then printf " cl=$(cl)" >> $(summary-file) ; fi
if [ "$(rmg)" != "$(defaultrmg)" ] ; then printf " rmg=$(rmg)" >> $(summary-file) ; fi
if [ "$(hdrmsg)" != "" ] ; then printf " $(hdrmsg)" >> $(summary-file) ; fi
dosummary: dosummary:
printf " --------\n" >> summary printf " --------\n" >> $(summary-file)
if [ -f report-$(conf) ] ; then\ if [ -f $(outdir)/report-$(conf) ] ; then\
cat report-$(conf) >> summary ;\ cat $(outdir)/report-$(conf) >> $(summary-file) ;\
else \ else \
printf 'NO REPORT\n' >> summary ;\ printf 'NO REPORT\n' >> $(summary-file) ;\
fi fi
allxhelpnotall: allxhelpnotall:
@ -356,33 +385,18 @@ all1: ; $(MAKE) all o=1
all2: ; $(MAKE) all o=2 all2: ; $(MAKE) all o=2
all3: ; $(MAKE) all o=3 all3: ; $(MAKE) all o=3
all: makescript$o $(src) oop.ss ht.ss mat.so cat_flush ${fobj} m4test.in m4test.out prettytest.ss ftype.h freq.in freq.out ${patchfile} build-examples parallel-prereqs: $(src) oop.ss ht.ss mat.so cat_flush${ExeSuffix} ${fobj} m4test.in m4test.out prettytest.ss ftype.h freq.in freq.out ${patchfile} build-examples
${Scheme} --verbose -q mat.so ${patchfile} < script.all$o
all: $(outdir) $(outdir)/script.all $(src) oop.ss ht.ss mat.so cat_flush${ExeSuffix} ${fobj} m4test.in m4test.out prettytest.ss ftype.h freq.in freq.out ${patchfile} build-examples
${Scheme} --verbose -q mat.so ${patchfile} < $(outdir)/script.all
$(MAKE) doerrors $(MAKE) doerrors
$(MAKE) doreport $(MAKE) doreport
$(MAKE) docoverage $(MAKE) docoverage
script.all$o: Mf-base $(outdir)/script.all: Mf-base $(outdir)
script.all$o makescript$o: $(outdir)/script.all makescript$o:
echo '(optimize-level $o)'\ echo $(conf-scheme-code)\
'(#%$$suppress-primitive-inlining #${spi})'\
'(heap-check-interval ${hci})'\
'(#%$$enable-check-prelex-flags #${ecpf})'\
'(compile-profile #$p)'\
'(collect-notify #${cn})'\
'(collect-trip-bytes ${ctb})'\
'(collect-generation-radix ${cgr})'\
'(collect-maximum-generation ${cmg})'\
'(in-place-minimum-generation ${ipmg})'\
'(enable-object-counts #${eoc})'\
'(commonization-level ${cl})'\
'(compile-interpret-simple #${cis})'\
'(set! *examples-directory* "${Examples}")'\
'(enable-cp0 #${cp0})'\
'(set! *scheme* "${Scheme}")'\
'(current-eval ${eval})'\
'(when #$c (coverage-table (load-coverage-files ${coverage-files:%="%"})))'\
'(record-run-coverage "$(objdir)/run.covout"'\ '(record-run-coverage "$(objdir)/run.covout"'\
' (lambda ()'\ ' (lambda ()'\
' (time (for-each (lambda (x) (time ((mat-file "$(objdir)") x)))'\ ' (time (for-each (lambda (x) (time ((mat-file "$(objdir)") x)))'\
@ -391,14 +405,14 @@ script.all$o makescript$o:
' (unless (= (#%$$check-heap-errors) 0)'\ ' (unless (= (#%$$check-heap-errors) 0)'\
' (fprintf (console-error-port) "check heap detected errors---grep standard output for !!!\n")'\ ' (fprintf (console-error-port) "check heap detected errors---grep standard output for !!!\n")'\
' (abort))))'\ ' (abort))))'\
> script.all$o > $(outdir)/script.all
source: source:
$(MAKE) source0 o=0 $(MAKE) source0 o=0
$(MAKE) source2 o=2 $(MAKE) source2 o=2
$(MAKE) source3 o=3 $(MAKE) source3 o=3
source$o: ${src} mat.ss oop.ss ht.ss cat_flush.c ${fsrc} freq.in freq.out m4test.in m4test.out script.all$o prettytest.ss ftype.h source$o: ${src} mat.ss oop.ss ht.ss cat_flush.c ${fsrc} freq.in freq.out m4test.in m4test.out $(outdir)/script.all prettytest.ss ftype.h
rootsrc = $(shell cd ${upupsrcdir}/mats; echo *) rootsrc = $(shell cd ${upupsrcdir}/mats; echo *)
${rootsrc}: ${rootsrc}:
@ -424,7 +438,7 @@ examples.mo ${objdir}/examples.mo: m4test.in m4test.out freq.in freq.out build-e
6.mo ${objdir}/6.mo: prettytest.ss 6.mo ${objdir}/6.mo: prettytest.ss
bytevector.mo ${objdir}/bytevector.mo: prettytest.ss bytevector.mo ${objdir}/bytevector.mo: prettytest.ss
io.mo ${objdir}/io.mo: prettytest.ss io.mo ${objdir}/io.mo: prettytest.ss
unix.mo ${objdir}/unix.mo io.mo ${objdir}/io.mo 6.mo ${objdir}/6.mo: cat_flush unix.mo ${objdir}/unix.mo io.mo ${objdir}/io.mo 6.mo ${objdir}/6.mo: cat_flush${ExeSuffix}
oop.mo ${objdir}/oop.mo: oop.ss oop.mo ${objdir}/oop.mo: oop.ss
ftype.mo ${objdir}/ftype.mo: ftype.h ftype.mo ${objdir}/ftype.mo: ftype.h
hash.mo ${objdir}/hash.mo: ht.ss hash.mo ${objdir}/hash.mo: ht.ss
@ -435,7 +449,7 @@ build-examples:
prettyclean: prettyclean:
rm -f *.o ${mdclean} *.so *.mo *.covout experr* errors* report* summary testfile* testscript\ rm -f *.o ${mdclean} *.so *.mo *.covout experr* errors* report* summary testfile* testscript\
${fobj} prettytest.ss cat_flush so_locations\ ${fobj} prettytest.ss cat_flush${ExeSuffix} so_locations\
build-examples script.all? *.html experr*.rej experr*.orig build-examples script.all? *.html experr*.rej experr*.orig
rm -rf testdir* rm -rf testdir*
rm -rf output-* rm -rf output-*

4
racket/src/ChezScheme/mats/Mf-i3nt
View File

@ -1,5 +1,5 @@
# Mf-i3nt # Mf-i3nt
# Copyright 1984-2017 Cisco Systems, Inc. # Copyright 1984-2021 Cisco Systems, Inc.
# #
# Licensed under the Apache License, Version 2.0 (the "License"); # Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License. # you may not use this file except in compliance with the License.
@ -25,5 +25,5 @@ export MSYS_NO_PATHCONV=1
foreign1.so: $(fsrc) foreign1.so: $(fsrc)
cmd.exe /c "vs.bat x86 && cl /DWIN32 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv955.lib $(fsrc)" cmd.exe /c "vs.bat x86 && cl /DWIN32 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv955.lib $(fsrc)"
cat_flush: cat_flush.c cat_flush.exe: cat_flush.c
cmd.exe /c "vs.bat x86 && cl /DWIN32 /MD /nologo $<" cmd.exe /c "vs.bat x86 && cl /DWIN32 /MD /nologo $<"

2
racket/src/ChezScheme/mats/bytevector.ms
View File

@ -11321,7 +11321,7 @@
(cons (bitwise-and i 255) (cons (bitwise-and i 255)
(loop (+ i 1))))))) (loop (+ i 1)))))))
(round-trip-bytevector-compress (round-trip-bytevector-compress
(call-with-port (open-file-input-port "prettytest.ss") get-bytevector-all)) (call-with-port (open-file-input-port (format "~a/prettytest.ss" *mats-dir*)) get-bytevector-all))
(error? (error?
;; Need at least 8 bytes for result size ;; Need at least 8 bytes for result size
(bytevector-uncompress '#vu8())) (bytevector-uncompress '#vu8()))

10
racket/src/ChezScheme/mats/examples.ms
View File

@ -42,6 +42,8 @@
(load (format "~a/~a.ss" *examples-directory* str) eval) (load (format "~a/~a.ss" *examples-directory* str) eval)
#t])) #t]))
(define (example-file file) (format "~a/~a" *mats-dir* file))
(define file=? (define file=?
(lambda (fn1 fn2) (lambda (fn1 fn2)
(let ([p1 (open-input-file fn1)] [p2 (open-input-file fn2)]) (let ([p1 (open-input-file fn1)] [p2 (open-input-file fn2)])
@ -96,8 +98,8 @@ edit>
(examples-mat freq ("freq") (examples-mat freq ("freq")
;; freq.in and freq.out come from example in TSPL ;; freq.in and freq.out come from example in TSPL
(begin (delete-file "testfile.freq" #f) #t) (begin (delete-file "testfile.freq" #f) #t)
(begin (frequency "freq.in" "testfile.freq") (begin (frequency (example-file "freq.in") "testfile.freq")
(file=? "testfile.freq" "freq.out")) (file=? "testfile.freq" (example-file "freq.out")))
) )
;-------- freq.in: -------- ;-------- freq.in: --------
@ -133,8 +135,8 @@ edit>
; ) ; )
(examples-mat m4 ("m4") (examples-mat m4 ("m4")
(begin (m4 "testfile.m4" "m4test.in") (begin (m4 "testfile.m4" (example-file "m4test.in"))
(file=? "m4test.out" "testfile.m4")) (file=? (example-file "m4test.out") "testfile.m4"))
) )
(examples-mat macro ("macro") (examples-mat macro ("macro")

28
racket/src/ChezScheme/mats/foreign.ms
View File

@ -179,43 +179,45 @@
(x v ...)) (x v ...))
(+ v ...))))))))) (+ v ...)))))))))
(define foreign1.so (format "~a/foreign1.so" *mats-dir*))
(machine-case (machine-case
[(i3ob ti3ob a6ob ta6ob a6s2 ta6s2 i3s2 ti3s2 i3qnx ti3qnx) [(i3ob ti3ob a6ob ta6ob a6s2 ta6s2 i3s2 ti3s2 i3qnx ti3qnx)
(mat load-shared-object (mat load-shared-object
(file-exists? "foreign1.so") (file-exists? foreign1.so)
(begin (load-shared-object "./foreign1.so") #t) (begin (load-shared-object foreign1.so) #t)
(begin (load-shared-object "libc.so") #t) (begin (load-shared-object "libc.so") #t)
(error? (load-shared-object 3)) (error? (load-shared-object 3))
) )
] ]
[(i3le ti3le a6le ta6le arm32le tarm32le arm64le tarm64le ppc32le tppc32le) [(i3le ti3le a6le ta6le arm32le tarm32le arm64le tarm64le ppc32le tppc32le)
(mat load-shared-object (mat load-shared-object
(file-exists? "foreign1.so") (file-exists? foreign1.so)
(begin (load-shared-object "./foreign1.so") #t) (begin (load-shared-object foreign1.so) #t)
(begin (load-shared-object "libc.so.6") #t) (begin (load-shared-object "libc.so.6") #t)
(error? (load-shared-object 3)) (error? (load-shared-object 3))
) )
] ]
[(i3fb ti3fb a6fb ta6fb) [(i3fb ti3fb a6fb ta6fb)
(mat load-shared-object (mat load-shared-object
(file-exists? "foreign1.so") (file-exists? foreign1.so)
(begin (load-shared-object "./foreign1.so") #t) (begin (load-shared-object foreign1.so) #t)
(begin (load-shared-object "libc.so.7") #t) (begin (load-shared-object "libc.so.7") #t)
(error? (load-shared-object 3)) (error? (load-shared-object 3))
) )
] ]
[(i3nb ti3nb a6nb ta6nb) [(i3nb ti3nb a6nb ta6nb)
(mat load-shared-object (mat load-shared-object
(file-exists? "foreign1.so") (file-exists? foreign1.so)
(begin (load-shared-object "./foreign1.so") #t) (begin (load-shared-object foreign1.so) #t)
(begin (load-shared-object "libc.so") #t) (begin (load-shared-object "libc.so") #t)
(error? (load-shared-object 3)) (error? (load-shared-object 3))
) )
] ]
[(i3nt ti3nt a6nt ta6nt) [(i3nt ti3nt a6nt ta6nt)
(mat load-shared-object (mat load-shared-object
(file-exists? "foreign1.so") (file-exists? foreign1.so)
(begin (load-shared-object "foreign1.so") #t) (begin (load-shared-object foreign1.so) #t)
(begin (load-shared-object "msvcrt.dll") #t) (begin (load-shared-object "msvcrt.dll") #t)
(begin (load-shared-object "kernel32.dll") #t) (begin (load-shared-object "kernel32.dll") #t)
(error? (load-shared-object 3)) (error? (load-shared-object 3))
@ -223,8 +225,8 @@
] ]
[(i3osx ti3osx a6osx ta6osx ppc32osx tppc32osx arm64osx tarm64osx) [(i3osx ti3osx a6osx ta6osx ppc32osx tppc32osx arm64osx tarm64osx)
(mat load-shared-object (mat load-shared-object
(file-exists? "foreign1.so") (file-exists? foreign1.so)
(begin (load-shared-object "./foreign1.so") #t) (begin (load-shared-object foreign1.so) #t)
(begin (load-shared-object "libc.dylib") #t) (begin (load-shared-object "libc.dylib") #t)
#t #t
(error? (load-shared-object 3)) (error? (load-shared-object 3))
@ -2531,7 +2533,7 @@
(let () (let ()
(define *m*) (define *m*)
(define *k*) (define *k*)
(define ip (open-file-input-port "mat.ss")) (define ip (open-file-input-port (format "~a/mat.ss" *mats-dir*)))
(define-ftype foo (function (fixnum fixnum) fixnum)) (define-ftype foo (function (fixnum fixnum) fixnum))
(define f (define f
(lambda (n m) (lambda (n m)

9
racket/src/ChezScheme/mats/ftype.ms
View File

@ -511,7 +511,7 @@
(define C-test-code (define C-test-code
(lambda (ftype-defn* path* ndefs npaths i* j*) (lambda (ftype-defn* path* ndefs npaths i* j*)
(let ([ndefs (length ftype-defn*)]) (let ([ndefs (length ftype-defn*)])
(printf "#include \"ftype.h\"\n\ (printf "#include \"~a/ftype.h\"\n\
#define offset(x, y) (int)((char *)&y - (char *)&x)\n\ #define offset(x, y) (int)((char *)&y - (char *)&x)\n\
EXPORT int *foo() {\n\ EXPORT int *foo() {\n\
~{~a\n~}\ ~{~a\n~}\
@ -520,6 +520,7 @@
~{~a\n~}\ ~{~a\n~}\
return a;\ return a;\
}\n" }\n"
*mats-dir*
(map (map
(lambda (ftype-defn) (lambda (ftype-defn)
(format "typedef ~a typedef_~a ~a;" (format "typedef ~a typedef_~a ~a;"
@ -557,9 +558,11 @@
[(a6osx a6osx) [(a6osx a6osx)
(system (format "cc -m64 -dynamiclib -o ~a ~a" testfile.so testfile.c))] (system (format "cc -m64 -dynamiclib -o ~a ~a" testfile.so testfile.c))]
[(a6nt ta6nt) [(a6nt ta6nt)
(system (format "set cl= && ..\\c\\vs.bat amd64 && cl /DWIN32 /Fe~a /LD /MD /nologo ~a" testfile.so testfile.c))] (system (format "set cl= && ~a\\..\\c\\vs.bat amd64 && cl /DWIN32 /Fe~a /LD /MD /nologo ~a"
(patch-exec-path *mats-dir*) testfile.so testfile.c))]
[(i3nt ti3nt) [(i3nt ti3nt)
(system (format "set cl= && ..\\c\\vs.bat x86 && cl /DWIN32 /Fe~a /LD /MD /nologo ~a" testfile.so testfile.c))] (system (format "set cl= && ~a\\..\\c\\vs.bat x86 && cl /DWIN32 /Fe~a /LD /MD /nologo ~a"
(patch-exec-path *mats-dir*) testfile.so testfile.c))]
[(arm32le tarm32le arm64le tarm64le) [(arm32le tarm32le arm64le tarm64le)
(system (format "cc -fPIC -shared -o ~a ~a" testfile.so testfile.c))] (system (format "cc -fPIC -shared -o ~a ~a" testfile.so testfile.c))]
[else ; this should work for most intel-based systems that use gcc... [else ; this should work for most intel-based systems that use gcc...

7
racket/src/ChezScheme/mats/hash.ms
View File

@ -4594,6 +4594,11 @@
(mat ht (mat ht
(begin (begin
(display-string (separate-eval '(parameterize ([source-directories '("." "../s" "../../s")]) (load "ht.ss")))) (display-string (separate-eval `(parameterize ([source-directories
(list
,*mats-dir*
,(format "~a/../s" *mats-dir*)
,(format "~a/../../s" *mats-dir*))])
(load "ht.ss"))))
#t) #t)
) )

88
racket/src/ChezScheme/mats/io.ms
View File

@ -20,6 +20,8 @@
; are enabled in io.ss ; are enabled in io.ss
(define (custom-port-warning? x) #t) (define (custom-port-warning? x) #t)
(define prettytest.ss (format "~a/prettytest.ss" *mats-dir*))
(mat port-operations (mat port-operations
(error? (close-port cons)) (error? (close-port cons))
; the following several clauses test various open-file-output-port options ; the following several clauses test various open-file-output-port options
@ -510,12 +512,12 @@
(not (file-port? (open-input-string "hello"))) (not (file-port? (open-input-string "hello")))
(or (threaded?) (= (port-file-descriptor (console-input-port)) 0)) (or (threaded?) (= (port-file-descriptor (console-input-port)) 0))
(or (threaded?) (= (port-file-descriptor (console-output-port)) 1)) (or (threaded?) (= (port-file-descriptor (console-output-port)) 1))
(> (let ([ip (open-input-file "mat.ss")]) (> (let ([ip (open-input-file prettytest.ss)])
(let ([n (and (file-port? ip) (port-file-descriptor ip))]) (let ([n (and (file-port? ip) (port-file-descriptor ip))])
(close-port ip) (close-port ip)
n)) n))
1) 1)
(> (let ([ip (open-input-file "mat.ss" 'compressed)]) (> (let ([ip (open-input-file prettytest.ss 'compressed)])
(let ([n (and (file-port? ip) (port-file-descriptor ip))]) (let ([n (and (file-port? ip) (port-file-descriptor ip))])
(close-port ip) (close-port ip)
n)) n))
@ -2111,7 +2113,7 @@
(error? (file-buffer-size (+ (most-positive-fixnum) 1))) (error? (file-buffer-size (+ (most-positive-fixnum) 1)))
(error? (file-buffer-size 1024.0)) (error? (file-buffer-size 1024.0))
(parameterize ([file-buffer-size (* (file-buffer-size) 2)]) (parameterize ([file-buffer-size (* (file-buffer-size) 2)])
(let ([ip (open-file-input-port "prettytest.ss")]) (let ([ip (open-file-input-port prettytest.ss)])
(let ([n (bytevector-length (binary-port-input-buffer ip))]) (let ([n (bytevector-length (binary-port-input-buffer ip))])
(close-input-port ip) (close-input-port ip)
(eqv? n (file-buffer-size))))) (eqv? n (file-buffer-size)))))
@ -2162,11 +2164,11 @@
(lambda (op) (put-bytevector op (get-bytevector-all ip)))))) (lambda (op) (put-bytevector op (get-bytevector-all ip))))))
(fnlength ofn)) (fnlength ofn))
(define (compress-file-test fmt) (define (compress-file-test fmt)
(let ([orig (fnlength "prettytest.ss")] (let ([orig (fnlength prettytest.ss)]
[low (compress-file "prettytest.ss" "testfile.ss" fmt 'low)] [low (compress-file prettytest.ss "testfile.ss" fmt 'low)]
[medium (compress-file "prettytest.ss" "testfile.ss" fmt 'medium)] [medium (compress-file prettytest.ss "testfile.ss" fmt 'medium)]
[high (compress-file "prettytest.ss" "testfile.ss" fmt 'high)] [high (compress-file prettytest.ss "testfile.ss" fmt 'high)]
[maximum (compress-file "prettytest.ss" "testfile.ss" fmt 'maximum)]) [maximum (compress-file prettytest.ss "testfile.ss" fmt 'maximum)])
(define-syntax test1 (define-syntax test1
(syntax-rules () (syntax-rules ()
[(_ level) [(_ level)
@ -2229,28 +2231,28 @@
(test (+ 1 i))))) (test (+ 1 i)))))
(loop)))))))))))) (loop))))))))))))
(and (and
(cmp (open-file-input-port "prettytest.ss") (cmp (open-file-input-port prettytest.ss)
(open-file-input-port "prettytest.ss")) (open-file-input-port prettytest.ss))
(cmp (open-file-input-port "prettytest.ss" (file-options compressed)) (cmp (open-file-input-port prettytest.ss (file-options compressed))
(open-file-input-port "prettytest.ss")) (open-file-input-port prettytest.ss))
(cmp (open-file-input-port "prettytest.ss") (cmp (open-file-input-port prettytest.ss)
(open-file-input-port "prettytest.ss" (file-options compressed))) (open-file-input-port prettytest.ss (file-options compressed)))
(cmp (open-file-input-port "prettytest.ss" (file-options compressed)) (cmp (open-file-input-port prettytest.ss (file-options compressed))
(open-file-input-port "prettytest.ss" (file-options compressed))) (open-file-input-port prettytest.ss (file-options compressed)))
(begin (begin
(cp (open-file-input-port "prettytest.ss") (cp (open-file-input-port prettytest.ss)
(open-file-output-port "testfile.ss" (file-options replace compressed))) (open-file-output-port "testfile.ss" (file-options replace compressed)))
#t) #t)
(cmp (open-file-input-port "testfile.ss" (file-options compressed)) (cmp (open-file-input-port "testfile.ss" (file-options compressed))
(open-file-input-port "prettytest.ss")) (open-file-input-port prettytest.ss))
(not (cmp (open-file-input-port "testfile.ss") (not (cmp (open-file-input-port "testfile.ss")
(open-file-input-port "prettytest.ss"))) (open-file-input-port prettytest.ss)))
(begin (begin
(cp (open-file-input-port "prettytest.ss") (cp (open-file-input-port prettytest.ss)
(open-file-output-port "testfile.ss" (file-options no-fail no-truncate append compressed))) (open-file-output-port "testfile.ss" (file-options no-fail no-truncate append compressed)))
#t) #t)
(not (cmp (open-file-input-port "testfile.ss" (file-options compressed)) (not (cmp (open-file-input-port "testfile.ss" (file-options compressed))
(open-file-input-port "prettytest.ss"))))) (open-file-input-port prettytest.ss)))))
; test workaround for bogus gzclose error return for empty input files ; test workaround for bogus gzclose error return for empty input files
(and (and
(eqv? (call-with-port (eqv? (call-with-port
@ -3186,24 +3188,24 @@
(if compressed? (file-options compressed replace) (file-options replace)) (if compressed? (file-options compressed replace) (file-options replace))
(buffer-mode block) (buffer-mode block)
(make-transcoder codec))) (make-transcoder codec)))
(time (cmp (in "prettytest.ss" #f (latin-1-codec)) (in "prettytest.ss" #f (latin-1-codec)))) (time (cmp (in prettytest.ss #f (latin-1-codec)) (in prettytest.ss #f (latin-1-codec))))
(time (cmp (in "prettytest.ss" #t (latin-1-codec)) (in "prettytest.ss" #f (latin-1-codec)))) (time (cmp (in prettytest.ss #t (latin-1-codec)) (in prettytest.ss #f (latin-1-codec))))
(time (cmp (in "prettytest.ss" #f (latin-1-codec)) (in "prettytest.ss" #t (latin-1-codec)))) (time (cmp (in prettytest.ss #f (latin-1-codec)) (in prettytest.ss #t (latin-1-codec))))
(time (cmp (in "prettytest.ss" #t (latin-1-codec)) (in "prettytest.ss" #t (latin-1-codec)))) (time (cmp (in prettytest.ss #t (latin-1-codec)) (in prettytest.ss #t (latin-1-codec))))
(time (cmp (in "prettytest.ss" #f (utf-8-codec)) (in "prettytest.ss" #f (utf-8-codec)))) (time (cmp (in prettytest.ss #f (utf-8-codec)) (in prettytest.ss #f (utf-8-codec))))
(time (cmp (in "prettytest.ss" #t (utf-8-codec)) (in "prettytest.ss" #f (utf-8-codec)))) (time (cmp (in prettytest.ss #t (utf-8-codec)) (in prettytest.ss #f (utf-8-codec))))
(time (cmp (in "prettytest.ss" #f (utf-8-codec)) (in "prettytest.ss" #t (utf-8-codec)))) (time (cmp (in prettytest.ss #f (utf-8-codec)) (in prettytest.ss #t (utf-8-codec))))
(time (cmp (in "prettytest.ss" #t (utf-8-codec)) (in "prettytest.ss" #t (utf-8-codec)))) (time (cmp (in prettytest.ss #t (utf-8-codec)) (in prettytest.ss #t (utf-8-codec))))
(cp (in "prettytest.ss" #f (latin-1-codec)) (out "testfile.ss" #t (latin-1-codec))) (cp (in prettytest.ss #f (latin-1-codec)) (out "testfile.ss" #t (latin-1-codec)))
(cmp (in "prettytest.ss" #f (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec))) (cmp (in prettytest.ss #f (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec)))
(cmp (in "prettytest.ss" #t (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec))) (cmp (in prettytest.ss #t (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec)))
(cmp (in "prettytest.ss" #f (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec))) (cmp (in prettytest.ss #f (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec)))
(cmp (in "prettytest.ss" #t (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec))) (cmp (in prettytest.ss #t (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec)))
(cp (in "prettytest.ss" #f (utf-8-codec)) (out "testfile.ss" #t (utf-8-codec))) (cp (in prettytest.ss #f (utf-8-codec)) (out "testfile.ss" #t (utf-8-codec)))
(cmp (in "prettytest.ss" #f (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec))) (cmp (in prettytest.ss #f (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec)))
(cmp (in "prettytest.ss" #t (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec))) (cmp (in prettytest.ss #t (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec)))
(cmp (in "prettytest.ss" #f (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec))) (cmp (in prettytest.ss #f (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec)))
(cmp (in "prettytest.ss" #t (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec))) (cmp (in prettytest.ss #t (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec)))
#t) #t)
; test workaround for bogus gzclose error return for empty input files ; test workaround for bogus gzclose error return for empty input files
(and (and
@ -3222,7 +3224,7 @@
(let () (let ()
(define pretty-test-string (define pretty-test-string
(call-with-port (call-with-port
(open-file-input-port "prettytest.ss" (open-file-input-port prettytest.ss
(file-options) (buffer-mode none) (native-transcoder)) (file-options) (buffer-mode none) (native-transcoder))
get-string-all)) get-string-all))
(define cp ; doesn't close the ports (define cp ; doesn't close the ports
@ -3269,11 +3271,11 @@
(if compressed? (file-options compressed replace) (file-options replace)) (if compressed? (file-options compressed replace) (file-options replace))
(buffer-mode block) (buffer-mode block)
(make-transcoder codec))) (make-transcoder codec)))
(time (cmp (in "prettytest.ss" #f (latin-1-codec)) (open-string-input-port pretty-test-string))) (time (cmp (in prettytest.ss #f (latin-1-codec)) (open-string-input-port pretty-test-string)))
(time (cmp (open-string-input-port pretty-test-string) (in "prettytest.ss" #f (latin-1-codec)))) (time (cmp (open-string-input-port pretty-test-string) (in prettytest.ss #f (latin-1-codec))))
(let-values ([(op retrieve) (open-string-output-port)]) (let-values ([(op retrieve) (open-string-output-port)])
(cp (open-string-input-port pretty-test-string) op) (cp (open-string-input-port pretty-test-string) op)
(cmp (in "prettytest.ss" #f (latin-1-codec)) (open-string-input-port (retrieve)))) (cmp (in prettytest.ss #f (latin-1-codec)) (open-string-input-port (retrieve))))
#t) #t)
) )

11
racket/src/ChezScheme/mats/mat.ss
View File

@ -230,8 +230,11 @@
(lambda (mat) (lambda (mat)
(unless (string? mat) (unless (string? mat)
(errorf 'mat-file "~s is not a string" mat)) (errorf 'mat-file "~s is not a string" mat))
(let ([ifn (format "~a.ms" mat)] [ofn (format "~a/~a.mo" dir mat)]) (let ([ifn (format "~a.ms" mat)] [ofn (format "~a.mo" mat)])
(printf "matting ~a with output to ~a~%" ifn ofn) (parameterize ([current-directory dir]
[source-directories (cons ".." (source-directories))]
[library-directories (cons ".." (library-directories))])
(printf "matting ~a with output to ~a/~a~%" ifn dir ofn)
(delete-file ofn #f) (delete-file ofn #f)
(parameterize ([mat-output (open-output-file ofn)]) (parameterize ([mat-output (open-output-file ofn)])
(dynamic-wind (dynamic-wind
@ -240,9 +243,9 @@
(let ([go (lambda () (mat-load ifn))] [universe-ct (coverage-table)]) (let ([go (lambda () (mat-load ifn))] [universe-ct (coverage-table)])
(if universe-ct (if universe-ct
(let-values ([(ct . ignore) (with-profile-tracker go)]) (let-values ([(ct . ignore) (with-profile-tracker go)])
(store-coverage universe-ct ct (format "~a/~a.covout" dir mat))) (store-coverage universe-ct ct (format "~a.covout" mat)))
(go)))) (go))))
(lambda () (close-output-port (mat-output))))))))) (lambda () (close-output-port (mat-output))))))))))
(set! record-run-coverage (set! record-run-coverage
(lambda (covout th) (lambda (covout th)

14
racket/src/ChezScheme/mats/misc.ms
View File

@ -1514,8 +1514,8 @@
) )
(mat source-directories (mat source-directories
(equal? (source-directories) '(".")) (equal? (separate-eval '(source-directories)) "(\".\")\n")
(equal? (parameterize ((source-directories (cons "/a" (source-directories)))) (equal? (parameterize ((source-directories (list "/a" ".")))
(source-directories)) (source-directories))
'("/a" ".")) '("/a" "."))
(error? (source-directories 'a)) (error? (source-directories 'a))
@ -1866,7 +1866,7 @@
(begin (begin
(with-output-to-file "testfile-sff.ss" (with-output-to-file "testfile-sff.ss"
(lambda () (lambda ()
(printf "#! ../bin/~a/scheme --script\n" (machine-type)) (printf "#! ~a --script\n" *scheme*)
(pretty-print '(define (hello) (import (chezscheme)) (printf "hello\n"))) (pretty-print '(define (hello) (import (chezscheme)) (printf "hello\n")))
(pretty-print '(hello))) (pretty-print '(hello)))
'replace) 'replace)
@ -1971,13 +1971,13 @@
) )
(mat $fasl-file-equal? (mat $fasl-file-equal?
(begin (let ([fn (format "~a/fatfib.ss" *examples-directory*)])
(parameterize ([generate-inspector-information #t]) (parameterize ([generate-inspector-information #t])
(compile-file "../examples/fatfib.ss" "testfile-fatfib1.so")) (compile-file fn "testfile-fatfib1.so"))
(parameterize ([generate-inspector-information #t]) (parameterize ([generate-inspector-information #t])
(compile-file "../examples/fatfib.ss" "testfile-fatfib2.so")) (compile-file fn "testfile-fatfib2.so"))
(parameterize ([generate-inspector-information #f]) (parameterize ([generate-inspector-information #f])
(compile-file "../examples/fatfib.ss" "testfile-fatfib3.so")) (compile-file fn "testfile-fatfib3.so"))
#t) #t)
(error? ; not a string (error? ; not a string
(#%$fasl-file-equal? 'testfile-fatfib1.so "testfile-fatfib2.so")) (#%$fasl-file-equal? 'testfile-fatfib1.so "testfile-fatfib2.so"))

12
racket/src/ChezScheme/mats/primvars.ms
View File

@ -19,7 +19,7 @@
(memq x (memq x
'(equivalent-expansion? mat-run mat mat/cf '(equivalent-expansion? mat-run mat mat/cf
mat-file mat-output enable-cp0 windows? embedded? mat-file mat-output enable-cp0 windows? embedded?
*examples-directory* *scheme* *examples-directory* *scheme* *mats-dir*
*fuzz* ~= fl~= cfl~= == nan pi +pi +pi/2 +pi/4 -pi -pi/2 -pi/4 +e -e *fuzz* ~= fl~= cfl~= == nan pi +pi +pi/2 +pi/4 -pi -pi/2 -pi/4 +e -e
separate-eval-tools separate-compile separate-eval run-script patch-exec-path $record->vector separate-eval-tools separate-compile separate-eval run-script patch-exec-path $record->vector
$cat_flush $cat_flush
@ -162,7 +162,15 @@
0 a*)) 0 a*))
(define prim-arity (define prim-arity
(lambda (x) (lambda (x)
(module (primref-arity) (include "../s/primref.ss")) (module (primref-arity)
(define-syntax include-from-s
(lambda (x)
(syntax-case x ()
[(k ?path)
(string? (datum ?path))
(let ([s-path (format "~a/../s/~a" *mats-dir* (datum ?path))])
(datum->syntax #'k `(include ,s-path)))])))
(include-from-s "primref.ss"))
(let ([primref2 (#%$sgetprop x '*prim2* #f)] [primref3 (#%$sgetprop x '*prim3* #f)]) (let ([primref2 (#%$sgetprop x '*prim2* #f)] [primref3 (#%$sgetprop x '*prim3* #f)])
(if primref2 (if primref2
(if primref3 (if primref3

5
racket/src/ChezScheme/mats/profile.ms
View File

@ -174,8 +174,9 @@
(eqv? ($qw 0 0) 0.0) ; bfp, efp combination not in database (eqv? ($qw 0 0) 0.0) ; bfp, efp combination not in database
(eqv? ; file not in database (eqv? ; file not in database
(let* ([ip (open-file-input-port "Mf-base")] (let* ([fn (format "~a/Mf-base" *mats-dir*)]
[sfd (make-source-file-descriptor "Mf-base" ip)]) [ip (open-file-input-port fn)]
[sfd (make-source-file-descriptor fn ip)])
(close-port ip) (close-port ip)
(profile-query-weight (make-source-object sfd 0 0))) (profile-query-weight (make-source-object sfd 0 0)))
#f) #f)

4
racket/src/ChezScheme/mats/record.ms
View File

@ -755,11 +755,11 @@
... ...
[else (syntax-error const [else (syntax-error const
(format "unhandled value ~s" (constant const)))])])) (format "unhandled value ~s" (constant const)))])]))
(define-syntax include (define-syntax include ; defining `include` so that a ".def" can `include` other ".def"s
(lambda (stx) (lambda (stx)
(syntax-case stx () (syntax-case stx ()
[(k path) [(k path)
#`(#,(datum->syntax #'k 'orig-include) #,(format "../s/~a" (datum path)))]))) #`(#,(datum->syntax #'k 'orig-include) #,(format "~a/../s/~a" *mats-dir* (datum path)))])))
(include "machine.def") (include "machine.def")
; all this work for two constants: ; all this work for two constants:
(define $fd-unaligned-integers (constant unaligned-integers)) (define $fd-unaligned-integers (constant unaligned-integers))

2
racket/src/ChezScheme/mats/thread.ms
View File

@ -1356,7 +1356,7 @@
'(3.4 -4)) '(3.4 -4))
($thread-check) ($thread-check)
(begin (begin
(load-shared-object "./foreign1.so") (load-shared-object (format "~a/foreign1.so" *mats-dir*))
#t) #t)
(equal? (equal?
(let () (let ()