summaryrefslogtreecommitdiffstats
path: root/build.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:23 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:23 -0800
commit5ca6e8e6a4e5c022a6fb5d28f30219c22c99eda8 (patch)
tree9b744b9dbf39e716e56daa620e2f3041968caf19 /build.scm
downloadscm-5ca6e8e6a4e5c022a6fb5d28f30219c22c99eda8.tar.gz
scm-5ca6e8e6a4e5c022a6fb5d28f30219c22c99eda8.zip
Import Upstream version 4e6upstream/4e6
Diffstat (limited to 'build.scm')
-rwxr-xr-xbuild.scm1393
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)))