diff options
Diffstat (limited to 'build.scm')
| -rwxr-xr-x | build.scm | 1393 |
1 files changed, 1393 insertions, 0 deletions
diff --git a/build.scm b/build.scm new file mode 100755 index 0000000..557a5ab --- /dev/null +++ b/build.scm @@ -0,0 +1,1393 @@ +#!/bin/sh +type;exec scmlit -f $0 -e"(bi)" build $* +;;; "build.scm" Build database and program -*-scheme-*- +;;; Copyright (C) 1994, 1995, 1996 Aubrey Jaffer. +;;; See the file `COPYING' for terms applying to this program. + +(require 'getopt) +(require 'parameters) +(require 'database-utilities) + +;;;(define build (create-database "buildscm.scm" 'alist-table)) +(define build (create-database #f 'alist-table)) + +(require 'batch) +(batch:initialize! build) + +(define-tables build + + '(file-formats + ((format symbol)) + () + ((plaintext) + (c-source) + (c-header) + (scheme) + (vax-asm) + (cray-asm) + (makefile) + (MS-DOS-batch) + (nroff) + (texinfo))) + + '(file-categories + ((category symbol)) + ((documentation string)) + ((documentation "Documentation file (or source for)") + (required "File required for building executable SCM") + (optional "File required for some feature") + (linkable "File whose object can be dynamically linked") + (test "File to test SCM") + (none "No files"))) + + '(build-whats + ((name symbol)) + ((class file-categories) + (c-proc symbol) + (o-proc symbol) + (spec expression) + (documentation string)) + ((exe required compile-c-files link-c-program #f + "executable program") + (lib required compile-c-files make-archive ((define "RTL")) + "library module") + (dlls linkable compile-dll-c-files make-dll-archive ((define "RTL")) + "archived dynamically linked library object files") + (dll none compile-dll-c-files make-nothing #f + "dynamically linked library object file"))) + + '(manifest + ((file string)) + ((format file-formats) + (category file-categories) + (documentation string)) + (("README" plaintext documentation "contains a MANIFEST, INSTALLATION INSTRUCTIONS, hints for EDITING SCHEME CODE, and a TROUBLE SHOOTING GUIDE.") + ("COPYING" plaintext documentation "details the LACK OF WARRANTY for SCM and the conditions for distributing SCM.") + ("scm.1" nroff documentation "unix style man page.") + ("scm.doc" plaintext documentation "man page generated from scm.1.") + ("QUICKREF" plaintext documentation "Quick Reference card for R4RS and IEEE Scheme.") + ("scm.texi" Texinfo documentation "SCM installation and use.") + ("ChangeLog" plaintext documentation "changes to SCM.") + ("r4rstest.scm" Scheme test "tests conformance with Scheme specifications.") + ("example.scm" Scheme test "example from R4RS which uses inexact numbers.") + ("pi.scm" Scheme test "computes digits of pi [type (pi 100 5)]. Test performance against pi.c.") + ("pi.c" c-source test "computes digits of pi [cc -o pi pi.c;time pi 100 5].") + ("bench.scm" Scheme test "computes and records performance statistics of pi.scm.") + ("Makefile" Makefile required "builds SCMLIT using the `make' program.") + ("build.scm" Scheme required "database for compiling and linking new SCM programs.") + ("build.bat" MS-DOS-batch optional "invokes build.scm for MS-DOS") + ("setjump.mar" Vax-asm optional "provides setjmp and longjmp which do not use $unwind utility on VMS.") + ("setjump.s" Cray-asm optional "provides setjmp and longjmp for the Cray YMP.") + ("Init.scm" Scheme required "Scheme initialization.") + ("Transcen.scm" Scheme required "inexact builtin procedures.") + ("Link.scm" Scheme required "compiles and dynamically links.") + ("scmfig.h" c-header required "contains system dependent definitions.") + ("patchlvl.h" c-header required "patchlevel of this release.") + ("setjump.h" c-header required "continuations, stacks, and memory allocation.") + ("continue.h" c-header required "continuations.") + ("continue.c" c-source required "continuations.") + ("scm.h" c-header required "data type and external definitions of SCM.") + ("scm.c" c-source required "top level, interrupts, and non-IEEE utility functions.") + ("findexec.c" c-source required "find the executable file function.") + ("time.c" c-source required "functions dealing with time.") + ("repl.c" c-source required "error, read-eval-print loop, read, write and load.") + ("scl.c" c-source required "inexact arithmetic") + ("eval.c" c-source required "evaluator, apply, map, and foreach.") + ("sys.c" c-source required "call-with-current-continuation, opening and closing files, storage allocation and garbage collection.") + ("subr.c" c-source required "the rest of IEEE functions.") + ("unif.c" c-source required "uniform vectors.") + ("rope.c" c-source required "C interface functions.") + ("ramap.c" c-source optional "array mapping") + ("dynl.c" c-source optional "dynamically load object files.") + ("sc2.c" c-source linkable "procedures from R2RS and R3RS not in R4RS.") + ("rgx.c" c-source linkable "string regular expression match.") + ("crs.c" c-source linkable "interactive terminal control.") + ("split.scm" Scheme test "example use of crs.c. Input, output, and diagnostic output directed to separate windows.") + ("edline.c" c-source linkable "Gnu readline input editing (get ftp.sys.toronto.edu:/pub/rc/editline.shar).") + ("Iedline.scm" Scheme optional "Gnu readline input editing.") + ("record.c" c-source linkable "proposed `Record' user definable datatypes.") + ("gsubr.c" c-source linkable "make_gsubr for arbitrary (< 11) arguments to C functions.") + ("ioext.c" c-source linkable "system calls in common between PC compilers and unix.") + ("posix.c" c-source linkable "posix library interface.") + ("unix.c" c-source linkable "non-posix system calls on unix systems.") + ("socket.c" c-source linkable "BSD socket interface.") + ("pre-crt0.c" c-source optional "loaded before crt0.o on machines which do not remap part of the data space into text space in unexec.") + ("ecrt0.c" c-source optional "standard Vax 4.2 Unix crt0.c cannot be used because it makes `envron' an initialized variable.") + ("gmalloc.c" c-source optional "Gnu malloc().") + ("unexec.c" c-source optional "Convert a running program into an a.out file.") + ("unexelf.c" c-source optional "Convert a running ELF program into an a.out file.") + ))) + +(for-each (build 'add-domain) + '((optstring #f (lambda (x) (or (not x) (string? x))) string #f) + (filename #f #f string #f) + (build-whats #f #f symbol #f))) + +(define-tables build + + '(processor-family + ((family atom)) + ((also-runs processor-family)) + ((*unknown* #f) + (8086 #f) + (acorn #f) + (cray #f) + (hp-risc #f) + (i386 8086) + (m68000 #f) + (m68030 m68000) + (mips #f) + (nos/ve #f) + (pdp-10 #f) + (pdp-11 #f) + (pdp-8 #f) + (powerpc #f) + (pyramid #f) + (sequent #f) + (sparc #f) + (tahoe #f) + (vax pdp-11) + )) + + '(platform + ((name symbol)) + ((processor processor-family) + (operating-system operating-system) + (compiler symbol)) + ((*unknown* *unknown* unix *unknown*) + (acorn-unixlib acorn *unknown* *unknown*) + (aix powerpc aix *unknown*) + (amiga-aztec m68000 amiga aztec) + (amiga-dice-c m68000 amiga dice-c) + (amiga-sas/c-5.10 m68000 amiga sas/c) + (atari-st-gcc m68000 atari.st gcc) + (atari-st-turbo-c m68000 atari.st turbo-c) + (borland-c-3.1 8086 ms-dos borland-c) + (djgpp i386 ms-dos gcc) + (gcc *unknown* unix gcc) + (highc.31 i386 ms-dos highc) + (hp-ux hp-risc hp-ux *unknown*) + (linux-aout i386 linux gcc) + (linux i386 linux gcc) + (microsoft-c 8086 ms-dos microsoft-c) + (microsoft-c-nt i386 ms-dos microsoft-c) + (microsoft-quick-c 8086 ms-dos microsoft-quick-c) + (ms-dos 8086 ms-dos *unknown*) + (os/2-cset i386 os/2 C-Set++) + (os/2-emx i386 os/2 gcc) + (sun sparc sun-os *unknown*) + (svr4 *unknown* unix *unknown*) + (turbo-c-2 8086 ms-dos turbo-c) + (unicos cray unicos *unknown*) + (unix *unknown* unix *unknown*) + (vms vax vms *unknown*) + (vms-gcc vax vms gcc) + (watcom-9.0 i386 ms-dos watcom) + )) + + '(C-libraries + ((library symbol) + (platform platform)) + ((compiler-flags string) + (link-lib-flag string) + (lib-path optstring) + (supress-files expression)) + + ((m *unknown* "" "-lm" "/usr/lib/libm.a" ()) + (c *unknown* "" "-lc" "/usr/lib/libc.a" ()) + (regex *unknown* "" "-lrgx" "/usr/lib/librgx.a" ()) + (curses *unknown* "" "-lcurses" "/usr/lib/libcurses.a" ()) + (graphics *unknown* "-I/usr/X11/include -DX11" "-lX11" + "/usr/X11/lib/libX11.sa" ()) + (editline *unknown* "" "-ledit" "/usr/lib/libedit.a" ()) + (termcap *unknown* "" "-ltermcap" "/usr/lib/libtermcap.a" ()) + (debug *unknown* "-g" "-g" #f ()) + + (m linux-aout "" "-lm" "/usr/lib/libm.sa" ()) + (c linux-aout "" "-lc" "/usr/lib/libc.sa" ()) + (dlll linux-aout "-DDLD -DDLD_DYNCM" "-ldld" #f ("findexec.c")) + (regex linux-aout "" "" "" ()) + (curses linux-aout "-I/usr/include/ncurses" "-lncurses" + "/usr/lib/libncurses.a" ()) + (nostart linux-aout "" "-nostartfiles" #f ("ecrt0.c")) + (dump linux-aout "" "/usr/lib/crt0.o" #f ("unexelf.c")) + + (m linux "" "-lm" "/lib/libm.so" ()) + (c linux "" "-lc" "/lib/libc.so" ()) + (dlll linux "-DSUN_DL" "-ldl" #f ()) + (graphics linux "-I/usr/include/X11 -DX11" "-L/usr/X11R6/lib -lX11" + "/usr/X11R6/lib/libX11.so" ()) + (curses linux "" "-lcurses" "/lib/libncurses.so" ()) + (nostart linux "" "" #f ("pre-crt0.c" "ecrt0.c")) + (dump linux "" "" #f ("unexec.c")) + + (m acorn-unixlib "" "" #f ()) + + (m amiga-dice-c "" "-lm" #f ()) + (m amiga-SAS/C-5.10 "" "lcmieee.lib" #f ()) + (c amiga-SAS/C-5.10 "" "lc.lib" #f ()) + + (m vms-gcc "" "" #f ()) + (m vms "" "" #f ()) + + (m atari-st-gcc "" "-lpml" #f ()) + (m atari-st-turbo-c "" "" #f ()) + + (m sun "" "-lm" #f ()) + (dlll sun "-DSUN_DL" "-ldl" #f ()) + (nostart sun "" "-e __start -nostartfiles -static" #f ("pre-crt0.c")) + (dump sun "" "" #f ("unexec.c")) + + (m hp-ux "" "-lm" #f ()) + (dlll hp-ux "-DHAVE_DYNL" "-Wl,-E -ldld" #f ()) + (graphics hp-ux "-DX11" "-lX" "/usr/lib/X11R5/libX11.sl" ()) + + (c djgpp "" "-lc" #f ("findexec.c")) + (curses djgpp "-I/djgpp/contrib/pdcurses/include/" + "-L/djgpp/contrib/pdcurses/lib/ -lcurses" + "\\djgpp\\contrib\\pdcurses\\lib\\libcurse.a" ()) + (nostart djgpp "" "-nostartfiles" #f ("ecrt0.c")) + (dump djgpp "" "c:/djgpp/lib/crt0.o" #f ("unexelf.c")) + + (c Microsoft-C "" "" #f ("findexec.c")) + (m Microsoft-C "" "" #f ()) + (c Microsoft-C-nt "" "" #f ("findexec.c")) + (m Microsoft-C-nt "" "" #f ()) + (c Microsoft-Quick-C "" "" #f ("findexec.c")) + (m Microsoft-Quick-C "" "" #f ()) + + (c Turbo-C-2 "" "" #f ("findexec.c")) + (m Turbo-C-2 "" "" #f ()) + (graphics Turbo-C-2 "" "graphics.lib" #f ()) + + (c Borland-C-3.1 "" "" #f ("findexec.c")) + (m Borland-C-3.1 "" "" #f ()) + (graphics Borland-C-3.1 "" "graphics.lib" #f ()) + (windows Borland-C-3.1 "-N -W" "-W" #f ()) + + (c highc.31 "" "" #f ("findexec.c")) + (m highc.31 "" "" #f ()) + (windows highc.31 "-Hwin" "-Hwin" #f ()) + )) + + '(compile-commands + ((name symbol) + (platform platform)) + ((procedure expression)) + + ((compile-c-files Borland-C-3.1 + (lambda (files parms) + (define rsp-name "temp.rsp") + (apply batch:lines->file parms rsp-name files) + (batch:system parms + "bcc" "-d" "-O" "-Z" "-G" "-w-pro" "-ml" "-c" + (if (member '(define "FLOATS" #t) + (c-defines parms)) + "" "-f-") + (c-includes parms) + (c-flags parms) + (string-append "@" rsp-name)) + (replace-suffix files ".c" ".obj"))) + (link-c-program Borland-C-3.1 + (lambda (oname objects libs parms) + (define lnk-name (string-append oname ".lnk")) + (apply batch:lines->file parms + lnk-name + (append libs objects)) + (batch:system parms "bcc" + (string-append "-e" oname) + "-ml" + (string-append "@" lnk-name)) + (string-append oname ".exe"))) + + (compile-c-files Turbo-C-2 + (lambda (files parms) + (batch:system parms + "tcc" "-c" "-d" "-O" "-Z" "-G" "-ml" "-c" + "-Ic:\\turboc\\include" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".obj"))) + (link-c-program Turbo-C-2 + (lambda (oname objects libs parms) + (let ((exe (replace-suffix (car objects) ".obj" ".exe")) + (oexe (string-append oname ".exe"))) + (if (not (string-ci=? exe oexe)) + (batch:delete-file parms oexe)) + (batch:system parms + "tcc" "-Lc:\\turboc\\lib" libs objects) + (if (not (string-ci=? exe oexe)) + (batch:rename-file parms exe oexe)) + oexe))) + + (compile-c-files Microsoft-C + (lambda (files parms) + (batch:system parms + "cl" "-c" "Oxp" "-AH" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".obj"))) + (link-c-program Microsoft-C + (lambda (oname objects libs parms) + (let ((exe (replace-suffix (car objects) ".obj" ".exe")) + (oexe (string-append oname ".exe"))) + (if (not (string-ci=? exe oexe)) + (batch:delete-file parms oexe)) + (batch:system parms + "link" "/noe" "/ST:40000" + (apply string-join "+" + (map (lambda (o) + (replace-suffix o ".obj" "")) + objects)) + libs) + (if (not (string-ci=? exe oexe)) + (batch:rename-file parms exe oexe)) + oexe))) + (compile-c-files Microsoft-C-nt + (lambda (files parms) + (batch:system parms + "cl" "-c" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".obj"))) + (link-c-program Microsoft-C-nt + (lambda (oname objects libs parms) + (let ((exe (replace-suffix (car objects) ".obj" ".exe")) + (oexe (string-append oname ".exe"))) + (if (not (string-ci=? exe oexe)) + (batch:delete-file parms oexe)) + (batch:system parms + "link" + (apply string-join " " + (map (lambda (o) + (replace-suffix o ".obj" "")) + objects)) + libs) + (if (not (string-ci=? exe oexe)) + (batch:rename-file parms exe oexe)) + oexe))) + + (compile-c-files Microsoft-Quick-C + (lambda (files parms) + (batch:system parms + "qcl" "/AH" "/W1" "/Ze" "/O" "/Ot" "/DNDEBUG" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".obj"))) + (link-c-program Microsoft-Quick-C + (lambda (oname objects libs parms) + (define crf-name (string-append oname ".crf")) + (apply batch:lines->file parms + crf-name + `(,@(map (lambda (f) (string-append f " +")) + objects) + "" + ,(string-append oname ".exe") + ,(apply string-join " " libs) + ";")) + (batch:system parms + "qlink" + "/CP:0xffff" "/NOI" "/SE:0x80" "/ST:0x9c40" + crf-name) + (string-append oname ".exe"))) + + (compile-c-files Watcom-9.0 + (lambda (files parms) + (batch:system parms + "wcc386p" "/mf" "/d2" "/ze" "/oxt" "/3s" + "/zq" "/w3" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".obj"))) + (link-c-program Watcom-9.0 + (lambda (oname objects libs parms) + (let ((exe (replace-suffix (car objects) + ".obj" ".exe")) + (oexe (string-append oname ".exe"))) + (if (not (string-ci=? exe oexe)) + (batch:delete-file parms oexe)) + (batch:system parms + "wlinkp" "option" "quiet" "option" + "stack=40000" "FILE" + (apply string-join "," + (map (lambda (o) + (replace-suffix o ".obj" "")) + objects)) + libs) + (if (not (string-ci=? exe oexe)) + (batch:rename-file parms exe oexe)) + oexe))) + (compile-c-files highc.31 + (lambda (files parms) + (define hcc-name "temp.hcc") + (apply batch:lines->file parms hcc-name files) + (batch:system parms + "\\hi_c\\hc386.31\\bin\\hc386" + (c-includes parms) + (c-flags parms) + "-c" (string-append "@" hcc-name)) + (replace-suffix files ".c" ".obj"))) + (link-c-program highc.31 + (lambda (oname objects libs parms) + (let ((oexe (string-append oname ".exe"))) + (define lnk-name (string-append oname ".lnk")) + (apply batch:lines->file parms + lnk-name (append libs objects)) + (batch:system parms + "\\hi_c\\hc386.31\\bin\\hc386" "-o" oname + (string-append "@" lnk-name)) + (batch:system parms + "bind386" "/hi_c/pharlap.51/run386b.exe" oname + "-exe" oexe) + oexe))) + + (compile-c-files djgpp + (lambda (files parms) + (batch:apply-chop-to-fit + batch:try-system parms + "gcc" "-Wall" "-O2" "-c" + (c-includes parms) (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + (link-c-program djgpp + (lambda (oname objects libs parms) + (let ((exe (string-append oname ".exe"))) + (or + (batch:try-system parms + "gcc" "-o" oname + (must-be-first + '("-nostartfiles" + "pre-crt0.o" "ecrt0.o" + "c:/djgpp/lib/crt0.o") + (append objects libs))) + (let ((arname (string-append oname ".a"))) + (batch:delete-file parms arname) + (batch:apply-chop-to-fit + batch:try-system parms + "ar" "r" arname objects) + (batch:system + parms "gcc" "-o" oname + (must-be-first + '("-nostartfiles" + "pre-crt0.o" "ecrt0.o" + "c:/djgpp/lib/crt0.o") + (cons arname libs)))) + (slib:error 'build "couldn't build archive")) + (batch:system parms "strip" oname) + (batch:delete-file parms exe) + (batch:system parms + "coff2exe" "-s" + "c:\\djgpp\\bin\\go32.exe" + oname) + exe))) + + (compile-c-files os/2-emx + (lambda (files parms) + (batch:system parms + "gcc" "-O" "-m386" "-c" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + (link-c-program os/2-emx + (lambda (oname objects libs parms) + (batch:system parms + "gcc" "-o" (string-append oname ".exe") + objects libs) + (string-append oname ".exe"))) + + (compile-c-files os/2-cset + (lambda (files parms) + (batch:system parms + "icc.exe" "/Gd-" "/Ge+" "/Gm+" "/Q" "-c" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".obj"))) + (link-c-program os/2-cset + (lambda (oname objects libs parms) + (batch:system parms + "link386.exe" objects libs + (string-append "," oname ".exe,,,;")) + (string-append oname ".exe"))) + + (compile-c-files HP-UX + (lambda (files parms) + (batch:system parms + "cc" "+O1" "-c" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + (compile-dll-c-files HP-UX + (lambda (files parms) + (batch:system parms + "cc" "+O1" "-Wl,-E" "+z" "-c" + (c-includes parms) + (c-flags parms) + files) + (for-each + (lambda (fname) + (batch:rename-file parms + (string-append fname ".sl") + (string-append fname ".sl~")) + (batch:system parms + "ld" "-b" "-o" + (string-append fname ".sl") + (string-append fname ".o"))) + (replace-suffix files ".c" "")) + (replace-suffix files ".c" ".sl"))) +; (make-dll-archive HP-UX +; (lambda (oname objects libs parms) +; (batch:system parms +; "ld" "-b" "-o" (string-append oname ".sl") +; objects) +; (string-append oname ".sl"))) + + (make-dll-archive sun + (lambda (oname objects libs parms) + (batch:system parms + "ld" "-assert" "pure-text" "-o" + (string-append oname ".so.1.0") + objects) + (string-append oname ".so.1.0"))) + + (compile-c-files linux-aout + (lambda (files parms) + (batch:system parms + "gcc" "-Wall" "-O2" "-c" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + (compile-dll-c-files linux-aout + (lambda (files parms) + (batch:system parms + "gcc" "-Wall" "-O2" "-c" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) +;;; (make-dll-archive linux-aout +;;; (lambda (oname objects libs parms) #t +;;; oname)) + + (compile-c-files linux + (lambda (files parms) + (batch:system parms + "gcc" "-O2" "-c" (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + (compile-dll-c-files linux + (lambda (files parms) + (batch:system parms + "gcc" "-O2" "-fpic" "-c" (c-includes parms) + (c-flags parms) + files) + (let* ((platform (car (parameter-list-ref + parms 'platform))) + (ld-opts + (map (lambda (l) + (build:lib-ld-flag l platform)) + (parameter-list-ref parms 'c-lib)))) + (for-each + (lambda (fname) + (batch:system parms + "gcc" "-shared" "-o" + (string-append fname ".so") + (string-append fname ".o") + ld-opts)) + (replace-suffix files ".c" ""))) + (replace-suffix files ".c" ".so"))) + (make-dll-archive linux + (lambda (oname objects libs parms) + (let ((platform (car (parameter-list-ref + parms 'platform)))) + (batch:system + parms + "gcc" "-shared" "-o" + (string-append oname ".so") + objects + (map (lambda (l) (build:lib-ld-flag l platform)) + (parameter-list-ref parms 'c-lib)))) + (string-append oname ".so"))) + (link-c-program linux + (lambda (oname objects libs parms) + (batch:system parms + "gcc" "-rdynamic" "-o" oname + (must-be-first + '("pre-crt0.o" "ecrt0.o" "/usr/lib/crt0.o") + (append objects libs))) + oname)) + + (compile-c-files Unicos + (lambda (files parms) + (batch:system parms + "cc" "-hvector2" "-hscalar2" "-c" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + (link-c-program Unicos + (lambda (oname objects libs parms) + (batch:system parms + "cc" "setjump.o" "-o" oname objects libs) + oname)) + + (compile-c-files gcc + (lambda (files parms) + (batch:system parms + "gcc" "-Wall" "-O2" "-c" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + + (link-c-program gcc + (lambda (oname objects libs parms) + (batch:rename-file parms + oname (string-append oname "~")) + (batch:system parms + "gcc" "-o" oname + (must-be-first + '("-nostartfiles" + "pre-crt0.o" "ecrt0.o" + "/usr/lib/crt0.o") + (append objects libs))) + oname)) + + (compile-c-files svr4 + (lambda (files parms) + (batch:system parms + "cc" "-O" "-DSVR4" "-c" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + + (compile-c-files aix + (lambda (files parms) + (batch:system parms + "cc" "-O" "-Dunix" "-c" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + (link-c-program aix + (lambda (oname objects libs parms) + (batch:system parms + "cc" "-lansi" "-o" oname objects libs) + oname)) + + (compile-c-files amiga-aztec + (lambda (files parms) + (batch:system parms + "cc" "-dAMIGA" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + (link-c-program amiga-aztec + (lambda (oname objects libs parms) + (batch:system parms + "cc" "-o" oname objects libs "-lma") + oname)) + + (compile-c-files amiga-SAS/C-5.10 + (lambda (files parms) + (batch:system parms + "lc" "-d3" "-M" "-fi" "-O" + (c-includes parms) + (c-flags parms) + files) + (batch:system parms "blink with link.amiga NODEBUG") + (replace-suffix files ".c" ".o"))) + (link-c-program amiga-SAS/C-5.10 + (lambda (oname objects libs parms) + (define lnk-name "link.amiga") + (apply batch:lines->file parms + lnk-name + (apply string-join "+" ">FROM LIB:c.o" + (map object->string objects)) + (string-append + "TO " (object->string (string-append "/" oname))) + (append + (cond + ((pair? libs) + (cons (string-append "LIB LIB:" (car libs)) + (map (lambda (s) + (string-append " LIB:" s)) + (cdr libs)))) + (else '())) + '("VERBOSE" "SC" "SD"))) + oname)) + + (compile-c-files amiga-dice-c + (lambda (files parms) + (batch:system parms + "dcc" "-r" "-gs" "-c" + (c-includes parms) + (c-flags parms) + files "-o" (replace-suffix files ".c" ".o")) + (replace-suffix files ".c" ".o"))) + (link-c-program amiga-dice-c + (lambda (oname objects libs parms) + (batch:system parms + "dcc" "-r" "-gs" "-o" oname objects libs) + oname)) + + (compile-c-files atari-st-gcc + (lambda (files parms) + (batch:system parms + "gcc" "-v" "-O" "-c" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + (link-c-program atari-st-gcc + (lambda (oname objects libs parms) + (batch:system parms + "gcc" "-v" "-o" (string-append oname ".ttp") + objects libs) + (string-append oname ".ttp"))) + + (compile-c-files atari-st-turbo-c + (lambda (files parms) + (batch:system parms + "tcc" "-P" "-W-" "-Datarist" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + (link-c-program atari-st-turbo-c + (lambda (oname objects libs parms) + (batch:system parms + "tlink" "-o" (string-append oname ".ttp") + objects libs "mintlib.lib" "osbind.lib" + "pcstdlib.lib" "pcfltlib.lib") + (string-append oname ".ttp"))) + + (compile-c-files acorn-unixlib + (lambda (files parms) + (batch:system parms + "cc" "-c" "-depend" "!Depend" "-IUnixLib:" + "-pcc" "-Dunix" "-DSVR3" "-DARM_ULIB" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + (link-c-program acorn-unixlib + (lambda (oname objects libs parms) + (batch:system parms + "link" "-o" oname objects libs + ":5.$.dev.gcc.unixlib36d.clib.o.unixlib") + (batch:system parms + "squeeze" oname) + oname)) + + (compile-c-files vms + (lambda (files parms) + (batch:system parms + "cc" + (c-includes parms) + (c-flags parms) + (replace-suffix files ".c" "")) + (replace-suffix files ".c" ".obj"))) + (link-c-program vms + (lambda (oname objects libs parms) + (let ((exe (replace-suffix (car objects) + ".obj" ".exe")) + (oexe (string-append oname ".exe"))) + (batch:system parms + "macro" "setjump") + (batch:system parms + "link" + (apply string-join "," + (append (map (lambda (f) + (replace-suffix f ".obj" "")) + objects) + '("setjump" "sys$input/opt\n "))) + (apply string-join + "," (append (remove "" libs) + '("sys$share:vaxcrtl/share")))) + (if (not (string-ci=? exe oexe)) + (batch:rename-file parms exe oexe)) + oexe))) + + (compile-c-files vms-gcc + (lambda (files parms) + (batch:system parms + "gcc" + (c-includes parms) + (c-flags parms) + (replace-suffix files ".c" "")) + (replace-suffix files ".c" ".obj"))) + (link-c-program vms-gcc + (lambda (oname objects libs parms) + (let ((exe (replace-suffix (car objects) + ".obj" ".exe")) + (oexe (string-append oname ".exe"))) + (batch:system parms + "macro" "setjump") + (batch:system parms + "link" + (apply string-join "," + (append objects + '("setjump.obj" + "sys$input/opt\n "))) + (apply string-join + "," (append (remove "" libs) + '("gnu_cc:[000000]gcclib/lib" + "sys$share:vaxcrtl/share")))) + (if (not (string-ci=? exe oexe)) + (batch:rename-file parms exe oexe)) + oexe))) + + (compile-c-files *unknown* + (lambda (files parms) + (batch:system parms + "cc" "-O" "-c" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + (link-c-program *unknown* + (lambda (oname objects libs parms) + (batch:rename-file parms + oname (string-append oname "~")) + (batch:system parms + "cc" "-o" oname + (must-be-first + '("-nostartfiles" + "pre-crt0.o" "ecrt0.o" + "/usr/lib/crt0.o") + (append objects libs))) + oname)) + (make-archive *unknown* + (lambda (oname objects libs parms) + (let ((aname (string-append oname ".a"))) + (batch:system parms + "ar rc" aname objects) + (batch:system parms + "ranlib" aname) + aname))) + (compile-dll-c-files *unknown* + (lambda (files parms) + (batch:system parms + "cc" "-O" "-c" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + (make-dll-archive *unknown* + (lambda (oname objects libs parms) + (let ((aname (string-append oname ".a"))) + (batch:system parms + "ar rc" aname objects) + (batch:system parms + "ranlib" aname) + aname))) + (make-nothing *unknown* + (lambda (oname objects libs parms) + (if (= 1 (length objects)) (car objects) + objects))) + )) + + '(features + ((name symbol)) + ((spec expression) + (documentation string)) + ((lit () "Light - no features") + (none () "No features") + + (cautious ((define "CAUTIOUS")) + "\ +Normally, the number of arguments arguments to interpreted closures + (from LAMBDA) are checked if the function part of a form is not a +symbol or only the first time the form is executed if the function +part is a symbol. defining RECKLESS disables any checking. If you +want to have SCM always check the number of arguments to interpreted +closures #define CAUTIOUS.") + + (careful-interrupt-masking ((define "CAREFUL_INTS")) + "\ +Define CAREFUL_INTS for extra checking of interrupt masking. This is +for debugging C code in sys.c and repl.c.") + + (debug ((c-lib debug) + (features cautious careful-interrupt-masking stack-limit)) + "Debugging") + + (reckless ((define "RECKLESS")) + "\ +If your scheme code runs without any errors you can disable almost all +error checking by compiling all files with RECKLESS.") + + (stack-limit ((define ("STACK_LIMIT" "(HEAP_SEG_SIZE/2)"))) + "\ +Define STACK_LIMIT to enable checking for stack overflow. Define +value of STACK_LIMIT to be the size to which SCM should allow the +stack to grow. STACK_LIMIT should be less than the maximum size the +hardware can support, as not every routine checks the stack.") + + (bignums ((define "BIGNUMS")) + "\ +Large precision integers.") + + (arrays ((define "ARRAYS")) + "\ +Define ARRAYS if you want arrays, uniform-arrays and uniform-vectors.") + + (array-for-each ((c-file "ramap.c") (init "init_ramap")) + "\ +array-map! and array-for-each (ARRAYS must also be defined).") + + (inexact ((define "FLOATS") (c-lib m)) + "\ +Define FLOATS if you want floating point numbers.") + + (engineering-notation ((define "ENGNOT")) + "\ +Define ENGNOT if you want floats to display in engineering notation + (exponents always multiples of 3) instead of scientific notation.") + + (single-precision-only ((define "SINGLESONLY")) + "\ +Define SINGLESONLY if you want all inexact real numbers to be single +precision. This only has an effect if SINGLES is also defined (which +is the default). This does not affect complex numbers.") + + (sicp ((define "SICP")) + "\ +Define SICP if you want to run code from: + + H. Abelson, G. J. Sussman, and J. Sussman, + Structure and Interpretation of Computer Programs, + The MIT Press, Cambridge, Massachusetts, USA + + (eq? '() '#f) is the major difference.") + + (rev2-procedures ((c-file "sc2.c") (init "init_sc2")) + "\ +These procedures were specified in the `Revised^2 Report on Scheme' +but not in `R4RS'.") + + (record ((c-file "record.c") (init "init_record")) + "\ +The Record package provides a facility for user to define their own +record data types. See SLIB for documentation.") + + (compiled-closure ((define "CCLO")) + "\ +Define CCLO if you want to use compiled closures.") + + (generalized-c-arguments ((c-file "gsubr.c") (init "init_gsubr")) + "\ +make_gsubr for arbitrary (< 11) arguments to C functions.") + + (tick-interrupts ((define "TICKS")) + "\ +Define TICKS if you want the ticks and ticks-interrupt functions.") + + (i/o-extensions ((c-file "ioext.c") (init "init_ioext")) + "\ +Commonly available I/O extensions: `Exec', line I/O, file positioning, +file delete and rename, and directory functions.") + + (turtlegr + ((c-file "turtlegr.c") (c-lib graphics) (features inexact) + (init "init_turtlegr")) + "\ +`Turtle' graphics calls for both Borland-C and X11.") + + (curses ((c-file "crs.c") (c-lib curses) (init "init_crs")) + "\ +`Curses' screen management package.") + + (edit-line + ((c-file "edline.c") (c-lib termcap editline) (compiled-init "init_edline")) + "\ +interface to the editline or GNU readline library") + + (regex ((c-file "rgx.c") (c-lib regex) (init "init_rgx")) + "\ +String regular expression matching.") + + (socket ((c-file "socket.c") (init "init_socket")) + "\ +BSD socket interface.") + + (posix ((c-file "posix.c") (init "init_posix")) + "\ +Posix functions available on all `Unix-like' systems. fork and +process functions, user and group IDs, file permissions, and `link'.") + + (unix ((c-file "unix.c") (init "init_unix")) + "\ +Those unix features which have not made it into the Posix specs: nice, +acct, lstat, readlink, symlink, mknod and sync.") + + (windows ((c-lib windows)) ; (define "NON_PREEMPTIVE") + "\ +Microsoft Windows executable.") + + (dynamic-linking ((c-file "dynl.c") (c-lib dlll)) + "\ +Load compiled files while running.") + + (dump ((define "CAN_DUMP") + (c-lib dump) + (c-lib nostart) + (c-file "unexec.c") + (c-file "unexelf.c") + (c-file "gmalloc.c") + (c-file "ecrt0.c") + (c-file "pre-crt0.c")) + "\ +Convert a running scheme program into an executable file.") + +;;;; Descriptions of these parameters is in "setjump.h". +;;; (initial-heap-size ((define "INIT_HEAP_SIZE" (* 25000 sizeof-cell)))) +;;; (heap-segment-size ((define "HEAP_SEG_SIZE" (* 8100 sizeof-cell)))) +;;; (short-aligned-stack ((define "SHORT_ALIGN"))) +;;; (initial-malloc-limit ((define "INIT_MALLOC_LIMIT" 100000))) +;;; (number-of-hash-buckets ((define "NUM_HASH_BUCKETS" 137))) +;;; (minimum-gc-yield ((define "MIN_GC_YIELD" "(heap_size/4)"))) + + (heap-can-shrink ((define "DONT_GC_FREE_SEGMENTS")) + "\ +Define DONT_GC_FREE_SEGMENTS if you want segments of unused heap to +not be freed up after garbage collection. This may reduce time in GC +for *very* large working sets.") + + (cheap-continuations ((define "CHEAP_CONTINUATIONS")) + "\ +If you only need straight stack continuations CHEAP_CONTINUATIONS will +run faster and use less storage than not having it. Machines with +unusual stacks need this. Also, if you incorporate new C code into +scm which uses VMS system services or library routines (which need to +unwind the stack in an ordrly manner) you may need to define +CHEAP_CONTINUATIONS.") + + (memoize-local-bindings ((define "MEMOIZE_LOCALS")) + "\ +Saves the interpeter from having to look up local bindings for every +identifier reference") + )) + '(build-params + *parameter-columns* + *parameter-columns* + ((1 platform single platform + (lambda (pl) (list batch:platform)) + #f + "what to build it for") + (2 target-name single string (lambda (pl) '("scm")) #f + "base name of target") + (3 c-lib nary symbol (lambda (pl) '(c)) #f + "C library (and include files)") + (4 define nary string #f #f "#define FLAG") + (5 implinit single string + (lambda (pl) (list (object->string + (in-vicinity (implementation-vicinity) "Init.scm")))) + #f "implementation vicinity") + (6 c-file nary filename #f #f "C source files") + (7 o-file nary filename #f #f "other object files") + (8 init nary string #f #f "initialization calls") + (9 compiled-init nary string #f #f "later initialization calls") + (10 features nary symbol + (lambda (pl) '(arrays inexact bignums)) + (lambda (rdb) (((rdb 'open-table) 'features #f) 'get 'spec)) + "features to include") + (11 what single build-whats + (lambda (pl) '(exe)) + (lambda (rdb) + (define tab (((rdb 'open-table) 'build-whats #f) 'get 'class)) + (define manifest ((((rdb 'open-table) 'manifest #f) + 'row:retrieve*))) + (lambda (what) + (define catgry (tab what)) + `((c-file + ,@(map car + (remove-if-not + (lambda (row) (and (eq? 'c-source (cadr row)) + (eq? catgry (caddr row)))) + manifest))) + ,@(or ((((rdb 'open-table) 'build-whats #f) 'get 'spec) what) + '())))) + "what to build") + (12 batch-dialect single batch-dialect + guess-how + #f + "How to build") + (13 who single expression (lambda (pl) (list (current-output-port))) #f + "name of buildfile or port") + (14 compiler-options nary string #f #f "command-line compiler options") + (15 linker-options nary string #f #f "command-line linker options") + + (17 batch-port nary expression #f #f + "port batch file will be written to.") + (18 c-defines nary expression #f #f "#defines for C") + (19 c-includes nary expression #f #f "library induced defines for C") + )) + '(build-pnames + ((name string)) + ((parameter-index uint)) + ( + ("p" 1) ("platform" 1) + ("o" 2) ("outname" 2) + ("l" 3) ("libraries" 3) + ("D" 4) ("defines" 4) + ("s" 5) ("scheme initialization file" 5) + ("c" 6) ("c source files" 6) + ("j" 7) ("object files" 7) + ("i" 9) ("initialization calls" 9) + ("F" 10) ("features" 10) + ("t" 11) ("type" 11) + ("h" 12) ("batch dialect" 12) + ("w" 13) ("script name" 13) + ("compiler options" 14) + ("linker options" 15) + )) + + '(*commands* + ((name symbol)) ;or just desc:*commands* + ((parameters parameter-list) + (parameter-names parameter-name-translation) + (procedure expression) + (documentation string)) + ((build + build-params + build-pnames + build:build + "build program.") + (*initialize* + no-parameters + no-parameters + build:init + "SCM Build Database")))) + +;;;((build 'close-database)) +;;;(define build (open-database! "buildscm.scm" 'alist-table)) + +(define build:error slib:error) +(define build:c-libraries #f) +(define build:lib-cc-flag #f) +(define build:lib-ld-flag #f) +(define build:c-supress #f) +(define plan-command #f) + +;;; Look up command on a platform, but default to '*unknown* if not +;;; initially found. + +(define (make-defaulting-platform-lookup getter) + (lambda (thing plat) + (define (look platform) + (let ((ans (getter thing platform))) + (cond (ans ans) + ((eq? '*unknown* platform) + (build:error "Couldn't find: " thing)) + (else (look '*unknown*))))) + (look plat))) + +(define system:success? zero?) + +(require 'alist) +(require 'common-list-functions) +(require 'object->string) + +(define build:build + (lambda (rdb) + (lambda (parms) + (let ((expanders + (map (lambda (e) (and e (lambda (s) (e s)))) + (map (lambda (f) (if f ((slib:eval f) rdb) f)) + ((((rdb 'open-table) 'build-params #f) + 'get* 'expander)))))) + (parameter-list-expand expanders parms) + (set! parms + (fill-empty-parameters + (map slib:eval + ((((rdb 'open-table) 'build-params #f) + 'get* 'default))) + parms)) + (parameter-list-expand expanders parms)) + (let* ((platform (car (parameter-list-ref parms 'platform))) + (init= (apply string-append + (map (lambda (c) + (string-append c "();")) + (parameter-list-ref parms 'init)))) + (compiled-init= + (apply string-append + (map (lambda (c) + (string-append c "();")) + (parameter-list-ref parms 'compiled-init)))) + (c-defines + `((define "IMPLINIT" + ,(car (parameter-list-ref parms 'implinit))) + ,@(if (string=? "" init=) '() + `((define "INITS" ,init=))) + ,@(if (string=? "" compiled-init=) '() + `((define "COMPILED_INITS" ,compiled-init=))) + ,@(map (lambda (d) (if (pair? d) + `(define ,@d) + `(define ,d #t))) + (parameter-list-ref parms 'define)))) + (c-includes + (map (lambda (l) (build:lib-cc-flag l platform)) + (parameter-list-ref parms 'c-lib))) + (batch-dialect (car (parameter-list-ref parms 'batch-dialect))) + (what (car (parameter-list-ref parms 'what))) + (c-proc (plan-command ((((rdb 'open-table) 'build-whats #f) + 'get 'c-proc) + what) + platform))) + (adjoin-parameters! + parms + (cons 'c-defines c-defines) + (cons 'c-includes c-includes) + ) + + (let ((name (car (parameter-list-ref parms 'who)))) + (batch:call-with-output-script + parms + name + (lambda (batch-port) + (define o-files '()) + (adjoin-parameters! + parms + (list 'batch-port batch-port)) + + ;; ================ Write file with C defines + (apply batch:lines->file parms + "scmflags.h" + (defines->c-defines c-defines)) + + ;; ================ Compile C source files + (set! o-files + (let ((supressors + (apply append + (map (lambda (l) (build:c-supress l platform)) + (parameter-list-ref parms 'c-lib))))) + (c-proc (remove-if (lambda (file) (member file supressors)) + (parameter-list-ref parms 'c-file)) + parms))) + + ;; ================ Link C object files + ((plan-command + ((((rdb 'open-table) 'build-whats #f) 'get 'o-proc) what) + platform) + (car (parameter-list-ref parms 'target-name)) + (append o-files (parameter-list-ref parms 'o-file)) + (append + (parameter-list-ref parms 'linker-options) + (map (lambda (l) (build:lib-ld-flag l platform)) + (parameter-list-ref parms 'c-lib))) + parms)))))))) + +(define (c-defines parms) + (parameter-list-ref parms 'c-defines)) +(define (c-includes parms) + (parameter-list-ref parms 'c-includes)) +(define (c-flags parms) + (parameter-list-ref parms 'compiler-options)) + +(define (defines->c-defines defines) + (map + (lambda (d) + (case (caddr d) + ((#t) (string-join " " "#define" (cadr d))) + ((#f) (string-join " " "#undef" (cadr d))) + (else (apply string-join " " "#define" (cdr d))))) + defines)) + +(define (defines->flags defines) + (map + (lambda (d) + (case (caddr d) + ((#t) (string-append "-D" (cadr d))) + ((#f) (string-append "-U" (cadr d))) + (else (string-append "-D" (cadr d) "=" (object->string (caddr d)))))) + defines)) + +(define (guess-how pl) + (let* ((plat (parameter-list-ref pl 'platform)) + (platform (if (pair? plat) (car plat) batch:platform))) + (let ((os (or ((((build 'open-table) 'platform #f) + 'get 'operating-system) platform) batch:platform))) + (cond ((not os) (slib:error "OS corresponding to " platform " unknown")) + (else (list (os->batch-dialect os))))))) + +(define build:initializer + (lambda (rdb) + (set! build:c-libraries ((rdb 'open-table) 'c-libraries #f)) + (set! build:lib-cc-flag + (make-defaulting-platform-lookup + (build:c-libraries 'get 'compiler-flags))) + (set! build:lib-ld-flag + (make-defaulting-platform-lookup + (build:c-libraries 'get 'link-lib-flag))) + (set! build:c-supress + (make-defaulting-platform-lookup + (build:c-libraries 'get 'supress-files))) + (set! plan-command + (let ((lookup (make-defaulting-platform-lookup + (((rdb 'open-table) 'compile-commands #f) + 'get 'procedure)))) + (lambda (thing plat) + (slib:eval (lookup thing plat))))))) +(build:initializer build) + +(define (build-from-argv argv) + (cond ((string? argv) + (require 'read-command) + (set! argv (call-with-input-string argv read-command)))) + (let () + (define command (string->symbol (list-ref argv *optind*))) + (define argc (length argv)) + (cond + ((pair? argv) + (set! *optind* (+ 1 *optind*)) + ((make-command-server build '*commands*) + command + (lambda (comname comval options positions arities types + defaults checks aliases) + (let* ((params (getopt->parameter-list + argc argv options arities types aliases)) + (fparams (fill-empty-parameters defaults params))) + (cond ((not (list? params)) #f) + ((not (check-parameters checks fparams)) #f) + ((not (check-arities (map arity->arity-spec arities) fparams)) + (slib:error 'build-from-argv "arity error" fparams) #f) + (else (comval fparams)))))))))) + +(define (build-from-whole-argv argv) + (set! *optind* 0) + (set! *optarg* #f) + (build-from-argv argv)) + +(define b build-from-whole-argv) + +(define (b*) + (require 'read-command) + (do ((e (read-command) (read-command))) + ((eof-object? e)) + (cond ((null? e)) + (else + (cond ((not (string-ci=? (car e) "build")) + (set! e (cons "build" e)))) + (write (build-from-whole-argv e)) + (newline))) + (display "build> ") + (force-output))) + +(define (bi) (build-from-argv *argv*)) + +(cond (*interactive* + (display "type (b \"build <command-line>\") to build") (newline) + (display "type (b*) to enter build command loop") (newline))) |