"Fossies" - the Fresh Open Source Software Archive

Member "scm/build.scm" (6 Nov 2016, 74792 Bytes) of package /linux/privat/scm-5f3.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Lisp source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "build.scm": 5f2_vs_5f3.

    1 ;; "build.scm" Build database and program   -*-scheme-*-
    2 ;; Copyright (C) 1994-2006 Free Software Foundation, Inc.
    3 ;;
    4 ;; This program is free software: you can redistribute it and/or modify
    5 ;; it under the terms of the GNU General Public License as
    6 ;; published by the Free Software Foundation, either version 3 of the
    7 ;; License, or (at your option) any later version.
    8 ;;
    9 ;; This program is distributed in the hope that it will be useful, but
   10 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
   11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   12 ;; General Public License for more details.
   13 ;;
   14 ;; You should have received a copy of the GNU General Public
   15 ;; License along with this program.  If not, see
   16 ;; <http://www.gnu.org/licenses/>.
   17 
   18 (require 'parameters)
   19 (require 'databases)
   20 (require 'database-commands)
   21 (require 'alist)
   22 (require 'common-list-functions)
   23 (require 'object->string)
   24 (require 'filename)
   25 (require 'batch)
   26 (require-if 'compiling 'alist-table)
   27 (require-if 'compiling 'posix-time)
   28 ;@
   29 (define OPEN_WRITE "w")         ; Because MS-DOS scripts need ^M
   30 ;@
   31 (define build (add-command-tables (create-database #f 'alist-table)))
   32 
   33 (batch:initialize! build)
   34 (((open-table! build 'batch-dialect) 'row:insert)
   35  '(default-for-platform 0))
   36 
   37 ;;;; This first part is about SCM files and features.
   38 
   39 (define-tables build
   40 
   41   '(file-formats
   42     ((format symbol))
   43     ()
   44     ((plaintext)
   45      (c-source)
   46      (c-header)
   47      (scheme)
   48      (vax-asm)
   49      (gnu-as)
   50      (gdb-init)
   51      (cray-asm)
   52      (makefile)
   53      (MS-DOS-batch)
   54      (nroff)
   55      (texinfo)))
   56 
   57   '(file-categories
   58     ((category symbol))
   59     ((documentation string))
   60     ((documentation "documentation")
   61      (platform-specific "required for certain platforms")
   62      (core "core for building executable SCM")
   63      (optional "required for some feature")
   64      (linkable "can be statically or dynamically linked for some feature")
   65      (test "test SCM")
   66      (none "no files")))
   67 
   68   '(manifest
   69     ((file string)
   70      (format file-formats)
   71      (category file-categories))
   72     ((documentation string))
   73     (("README"  plaintext   documentation   "contains a MANIFEST, INSTALLATION INSTRUCTIONS, hints for EDITING SCHEME CODE, and a TROUBLE SHOOTING GUIDE.")
   74      ("COPYING" plaintext   documentation   "GNU GENERAL PUBLIC LICENSE")
   75      ("COPYING.LESSER"  plaintext   documentation   "GNU LESSER GENERAL PUBLIC LICENSE")
   76      ("scm.1"   nroff   documentation   "unix style man page.")
   77      ("scm.doc" plaintext   documentation   "man page generated from scm.1.")
   78      ("QUICKREF"    plaintext   documentation   "Quick Reference card for R4RS and IEEE Scheme.")
   79      ("scm.texi"    Texinfo documentation   "SCM installation and use.")
   80      ("fdl.texi"    Texinfo documentation   "GNU Free Documentation License.")
   81      ("ChangeLog"   plaintext   documentation   "changes to SCM.")
   82      ("r4rstest.scm"    Scheme  test    "tests conformance with Scheme specifications.")
   83      ("example.scm" Scheme  test    "example from R4RS which uses inexact numbers.")
   84      ("pi.scm"  Scheme  test    "computes digits of pi [type (pi 100 5)].  Test performance against pi.c.")
   85      ("pi.c"    c-source    test    "computes digits of pi [cc -o pi pi.c;time pi 100 5].")
   86      ("bench.scm"   Scheme  test    "computes and records performance statistics of pi.scm.")
   87      ("Makefile"    Makefile    core    "builds SCMLIT using the `make' program.")
   88      ("build.scm"   Scheme  core    "database for compiling and linking new SCM programs.")
   89      ("build.bat"   MS-DOS-batch    platform-specific   "invokes build.scm for MS-DOS")
   90      ("mkimpcat.scm"    Scheme  core    "build SCM-specific catalog for SLIB.")
   91      (".gdbinit"    gdb-init    optional "provides commands for debugging SCM with GDB")
   92      ("setjump.mar" Vax-asm platform-specific   "provides setjump and longjump which do not use $unwind utility on VMS.")
   93      ("ugsetjump.s" gnu-as  platform-specific   "provides setjump and longjump which work on Ultrix VAX.")
   94      ("setjump.s"   Cray-asm    platform-specific   "provides setjump and longjump for the Cray YMP.")
   95      ("continue-ia64.S" gnu-as  platform-specific "replaces make_root_continuation(), make_continuation(), and dynthrow() in continue.c")
   96      ("get-contoffset-ia64.c"   c-source    platform-specific   "makes contoffset-ia64.S for inclusion by continue-ia64.S")
   97      ("Init.scm"    Scheme  core    "Scheme initialization.")
   98      ("Transcen.scm"    Scheme  core    "inexact builtin procedures.")
   99      ("Link.scm"    Scheme  core    "Dynamic link/loading.")
  100      ("compile.scm" Scheme  core    "Hobbit compilation to C.")
  101      ("Macro.scm"   Scheme  core    "Supports Syntax-Rules Macros.")
  102      ("scmfig.h"    c-header    core    "contains system dependent definitions.")
  103      ("patchlvl.h"  c-header    core    "patchlevel of this release.")
  104      ("setjump.h"   c-header    core    "continuations, stacks, and memory allocation.")
  105      ("continue.h"  c-header    core    "continuations.")
  106      ("continue.c"  c-source    core    "continuations.")
  107      ("scm.h"   c-header    core    "data type and external definitions of SCM.")
  108      ("scm.c"   c-source    core    "initialization, interrupts, and non-IEEE utility functions.")
  109      ("scmmain.c"   c-source    core    "initialization, interrupts, and non-IEEE utility functions.")
  110      ("findexec.c"  c-source    core    "find the executable file function.")
  111      ("script.c"    c-source    core    "utilities for running as `#!' script.")
  112      ("time.c"  c-source    core    "functions dealing with time.")
  113      ("repl.c"  c-source    core    "error, read-eval-print loop, read, write and load.")
  114      ("scl.c"   c-source    core    "inexact arithmetic")
  115      ("eval.c"  c-source    core    "evaluator, apply, map, and foreach.")
  116      ("sys.c"   c-source    core    "call-with-current-continuation, opening and closing files, storage allocation and garbage collection.")
  117      ("subr.c"  c-source    core    "the rest of IEEE functions.")
  118      ("debug.c" c-source    core    "debugging, printing code.")
  119      ("unif.c"  c-source    core    "uniform vectors.")
  120      ("rope.c"  c-source    core    "C interface functions.")
  121      ("ramap.c" c-source    optional    "array mapping")
  122      ("dynl.c"  c-source    optional    "dynamically load object files.")
  123      ("sc2.c"   c-source    linkable    "procedures from R2RS and R3RS not in R4RS.")
  124      ("byte.c"  c-source    linkable    "strings as bytes.")
  125      ("rgx.c"   c-source    linkable    "string regular expression match.")
  126      ("crs.c"   c-source    linkable    "interactive terminal control.")
  127      ("split.scm"   Scheme  test    "example use of crs.c.  Input, output, and diagnostic output directed to separate windows.")
  128      ("edline.c"    c-source    linkable    "Gnu readline input editing (get ftp.sys.toronto.edu:/pub/rc/editline.shar).")
  129      ("Iedline.scm" Scheme  optional    "Gnu readline input editing.")
  130      ("bytenumb.c"  c-source    linkable    "Byte-number conversions.")
  131      ("differ.c"    c-source    linkable    "Linear-space O(PN) sequence comparison.")
  132      ("Idiffer.scm" Scheme  optional    "Linear-space O(PN) sequence comparison.")
  133      ("record.c"    c-source    linkable    "proposed `Record' user definable datatypes.")
  134      ("gsubr.c" c-source    linkable    "make_gsubr for arbitrary (< 11) arguments to C functions.")
  135      ("ioext.c" c-source    linkable    "system calls in common between PC compilers and unix.")
  136      ("posix.c" c-source    linkable    "posix library interface.")
  137      ("unix.c"  c-source    linkable    "non-posix system calls on unix systems.")
  138      ("socket.c"    c-source    linkable    "BSD socket interface.")
  139      ("pre-crt0.c"  c-source    platform-specific   "loaded before crt0.o on machines which do not remap part of the data space into text space in unexec.")
  140      ("ecrt0.c" c-source    platform-specific   "discover the start of initialized data space dynamically at runtime.")
  141      ("gmalloc.c"   c-source    platform-specific   "Gnu malloc(); used for unexec.")
  142      ("unexec.c"    c-source    platform-specific   "Convert a running program into an executable file.")
  143      ("unexhp9k800.c"   c-source    platform-specific   "Convert a running HP-UX program into an executable file.")
  144      ("unexelf.c"   c-source    platform-specific   "Convert a running ELF program into an executable file.")
  145      ("unexalpha.c" c-source    platform-specific   "Convert a running program into an Alpha executable file.")
  146      ("unexsgi.c"   c-source    platform-specific   "Convert a running program into an IRIX executable file.")
  147      ("unexsunos4.c"    c-source    platform-specific   "Convert a running program into an executable file.")
  148      ("macosx-config.h" c-header    platform-specific   "Included by unexmacosx.c and lastfile.c.")
  149      ("unexmacosx.c"    c-source    platform-specific   "Convert a running program into an executable file under MacOS X.")
  150      ("lastfile.c"  c-source    platform-specific   "find the point in data space between data and libraries.")
  151      ))
  152 
  153   '(build-whats
  154     ((name symbol))
  155     ((class file-categories)
  156      (c-proc symbol)
  157      (o-proc symbol)
  158      (spec expression)
  159      (documentation string))
  160     ((exe core compile-c-files link-c-program #f
  161       "executable program")
  162      (lib core compile-c-files make-archive ((c-lib lib))
  163       "library module")
  164      (dlls linkable compile-dll-c-files make-dll-archive ((define "DLL"))
  165        "archived dynamically linked library object files")
  166      (dll none compile-dll-c-files update-catalog ((define "DLL"))
  167       "dynamically linked library object file")))
  168 
  169   '(features
  170     ((name symbol))
  171     ((spec expression)
  172      (documentation string))
  173     ((none () "No features"))))
  174 
  175 (define-domains build
  176   '(optstring #f (lambda (x) (or (not x) (string? x))) string #f)
  177   '(filename #f #f string #f)
  178   '(features features #f symbol #f)
  179   '(build-whats build-whats #f symbol #f))
  180 
  181 (define define-build-feature
  182   (let ((defeature ((open-table! build 'features) 'row:insert)))
  183     (lambda args
  184       (defeature (append args (list (comment)))))))
  185 
  186 #;Lightweight -- no features
  187 (define-build-feature
  188   'lit
  189   '())
  190 
  191 #;Normally, the number of arguments arguments to interpreted closures
  192 #;(from LAMBDA) are checked if the function part of a form is not a
  193 #;symbol or only the first time the form is executed if the function
  194 #;part is a symbol.  defining @samp{reckless} disables any checking.
  195 #;If you want to have SCM always check the number of arguments to
  196 #;interpreted closures define feature @samp{cautious}.
  197 (define-build-feature
  198  'cautious
  199  '((define "CAUTIOUS")))
  200 
  201 #;Define this for extra checking of interrupt masking and some simple
  202 #;checks for proper use of malloc and free.  This is for debugging C
  203 #;code in @file{sys.c}, @file{eval.c}, @file{repl.c} and makes the
  204 #;interpreter several times slower than usual.
  205 (define-build-feature
  206  'careful-interrupt-masking
  207  '((define "CAREFUL_INTS")))
  208 
  209 #;Turns on the features @samp{cautious} and
  210 #;@samp{careful-interrupt-masking}; uses
  211 #;@code{-g} flags for debugging SCM source code.
  212 (define-build-feature
  213  'debug
  214  '((c-lib debug) (features cautious careful-interrupt-masking)))
  215 
  216 #;If your scheme code runs without any errors you can disable almost
  217 #;all error checking by compiling all files with @samp{reckless}.
  218 (define-build-feature
  219  'reckless
  220  '((define "RECKLESS")))
  221 
  222 #;C level support for hygienic and referentially transparent macros
  223 #;(syntax-rules macros).
  224 (define-build-feature
  225  'macro
  226  '((define "MACRO") (features rev2-procedures record)))
  227 
  228 #;Large precision integers.
  229 (define-build-feature
  230  'bignums
  231  '((define "BIGNUMS")))
  232 
  233 #;Use if you want arrays, uniform-arrays and uniform-vectors.
  234 (define-build-feature
  235  'arrays
  236  '((define "ARRAYS")))
  237 
  238 #;Alias for ARRAYS
  239 (define-build-feature
  240  'array
  241  '((features arrays)))
  242 
  243 #;array-map! and array-for-each (arrays must also be featured).
  244 (define-build-feature
  245  'array-for-each
  246  '((c-file "ramap.c") (compiled-init "init_ramap")))
  247 
  248 #;Use if you want floating point numbers.
  249 (define-build-feature
  250  'inexact
  251  '((features bignums) (define "FLOATS") (c-lib m)))
  252 
  253 #;Use if you want floats to display in engineering notation (exponents
  254 #;always multiples of 3) instead of scientific notation.
  255 (define-build-feature
  256  'engineering-notation
  257  '((define "ENGNOT")))
  258 
  259 #;Use if you want all inexact real numbers to be single precision.  This
  260 #;only has an effect if SINGLES is also defined (which is the default).
  261 #;This does not affect complex numbers.
  262 (define-build-feature
  263  'single-precision-only
  264  '((define "SINGLESONLY")))
  265 
  266 #;Use if you want to run code from:
  267 #;
  268 #;@cindex SICP
  269 #;Harold Abelson and Gerald Jay Sussman with Julie Sussman.
  270 #;@cite{Structure and Interpretation of Computer Programs.}
  271 #;The MIT Press, Cambridge, Massachusetts, USA, 1985.
  272 #;
  273 #;Differences from R5RS are:
  274 #;@itemize @bullet
  275 #;@item
  276 #;(eq? '() '#f)
  277 #;@item
  278 #;(define a 25) returns the symbol a.
  279 #;@item
  280 #;(set! a 36) returns 36.
  281 #;@end itemize
  282 (define-build-feature
  283  'sicp
  284  '((define "SICP")))
  285 
  286 #;These procedures were specified in the @cite{Revised^2 Report on Scheme}
  287 #;but not in @cite{R4RS}.
  288 (define-build-feature
  289  'rev2-procedures
  290  '((c-file "sc2.c") (init "init_sc2")))
  291 
  292 #;Treating strings as byte-vectors.
  293 (define-build-feature
  294  'byte
  295  '((c-file "byte.c") (init "init_byte")))
  296 
  297 #;The Record package provides a facility for user to define their own
  298 #;record data types.  See SLIB for documentation.
  299 (define-build-feature
  300  'record
  301  '((define "CCLO") (c-file "record.c") (compiled-init "init_record")))
  302 
  303 #;Use if you want to use compiled closures.
  304 (define-build-feature
  305  'compiled-closure
  306  '((define "CCLO")))
  307 
  308 #;@code{make_gsubr} for arbitrary (< 11) arguments to C functions.
  309 (define-build-feature
  310  'generalized-c-arguments
  311  '((c-file "gsubr.c") (compiled-init "init_gsubr")))
  312 
  313 #;Use if you want the ticks and ticks-interrupt functions.
  314 (define-build-feature
  315  'tick-interrupts
  316  '((define "TICKS")))
  317 
  318 #;Commonly available I/O extensions: @dfn{exec}, line I/O, file
  319 #;positioning, file delete and rename, and directory functions.
  320 (define-build-feature
  321  'i/o-extensions
  322  '((c-file "ioext.c") (init "init_ioext")))
  323 
  324 #;@dfn{Turtle} graphics calls for both Borland-C and X11 from
  325 #;sjm@@ee.tut.fi.
  326 (define-build-feature
  327  'turtlegr
  328  '((c-file "turtlegr.c") (c-lib graphics) (features inexact)
  329    (compiled-init "init_turtlegr")))
  330 
  331 #;Interface to Xlib graphics routines.
  332 (define-build-feature
  333  'Xlib
  334  '((c-file "x.c") (c-lib graphics) (compiled-init "init_x") (features arrays)))
  335 
  336 #;Alias for Xlib feature.
  337 (define-build-feature
  338  'X
  339  '((features Xlib)))
  340 
  341 #;For the @dfn{curses} screen management package.
  342 (define-build-feature
  343  'curses
  344  '((c-file "crs.c") (c-lib curses) (compiled-init "init_crs")))
  345 
  346 #;interface to the editline or GNU readline library.
  347 (define-build-feature
  348  'edit-line
  349  '((c-file "edline.c") (c-lib termcap editline) (compiled-init "init_edline")))
  350 
  351 #;Client connections to the mysql databases.
  352 (define-build-feature
  353  'mysql
  354  '((c-file "database.c") (c-lib mysql) (compiled-init "init_database")))
  355 
  356 #;String regular expression matching.
  357 (define-build-feature
  358  'regex
  359  '((c-file "rgx.c") (c-lib regex) (compiled-init "init_rgx")))
  360 
  361 #;BSD @dfn{socket} interface.  Socket addr functions require
  362 #;inexacts or bignums for 32-bit precision.
  363 (define-build-feature
  364  'socket
  365  '((c-lib socket) (c-file "socket.c") (compiled-init "init_socket")))
  366 
  367 #;Posix functions available on all @dfn{Unix-like} systems.  fork and
  368 #;process functions, user and group IDs, file permissions, and
  369 #;@dfn{link}.
  370 (define-build-feature
  371  'posix
  372  '((c-file "posix.c") (compiled-init "init_posix")))
  373 
  374 #;Those unix features which have not made it into the Posix specs:
  375 #;nice, acct, lstat, readlink, symlink, mknod and sync.
  376 (define-build-feature
  377  'unix
  378  '((c-file "unix.c") (compiled-init "init_unix")))
  379 
  380 #;Sequence comparison
  381 (define-build-feature
  382  'differ
  383  '((c-file "differ.c") (compiled-init "init_differ")))
  384 
  385 #;Byte/number conversions
  386 (define-build-feature
  387  'byte-number
  388  '((c-file "bytenumb.c") (compiled-init "init_bytenumb")))
  389 
  390 #;Microsoft Windows executable.
  391 (define-build-feature
  392  'windows
  393  '((c-lib windows)))            ; (define "NON_PREEMPTIVE")
  394 
  395 #;Be able to load compiled files while running.
  396 (define-build-feature
  397  'dynamic-linking
  398  '((c-file "dynl.c") (c-lib dlll)))
  399 
  400 #;Convert a running scheme program into an executable file.
  401 (define-build-feature
  402  'dump
  403  '((define "CAN_DUMP") (c-lib dump) (c-lib nostart)))
  404 
  405 ;;; Descriptions of these parameters is in "setjump.h".
  406 ;;  (initial-heap-size ((define "INIT_HEAP_SIZE" (* 25000 sizeof-cell))))
  407 ;;  (heap-segment-size ((define "HEAP_SEG_SIZE" (* 8100 sizeof-cell))))
  408 ;;  (short-aligned-stack ((define "SHORT_ALIGN")))
  409 ;;  (initial-malloc-limit ((define "INIT_MALLOC_LIMIT" 100000)))
  410 ;;  (number-of-hash-buckets ((define "NUM_HASH_BUCKETS" 137)))
  411 ;;  (minimum-gc-yield ((define "MIN_GC_YIELD" "(heap_cells/4)")))
  412 
  413 #;Use if you want segments of unused heap to not be freed up after
  414 #;garbage collection.  This may increase time in GC for *very* large
  415 #;working sets.
  416 (define-build-feature
  417  'no-heap-shrink
  418  '((define "DONT_GC_FREE_SEGMENTS")))
  419 
  420 #;SCM normally converts references to local variables to ILOCs, which
  421 #;make programs run faster.  If SCM is badly broken, try using this
  422 #;option to disable the MEMOIZE_LOCALS feature.
  423 (define-build-feature
  424  'dont-memoize-locals
  425  '((define "DONT_MEMOIZE_LOCALS")))
  426 
  427 #;If you only need straight stack continuations, executables compile with
  428 #;this feature will run faster and use less storage than not having it.
  429 #;Machines with unusual stacks @emph{need} this.  Also, if you incorporate
  430 #;new C code into scm which uses VMS system services or library routines
  431 #;(which need to unwind the stack in an ordrly manner) you may need to
  432 #;use this feature.
  433 (define-build-feature
  434  'cheap-continuations
  435  '((define "CHEAP_CONTINUATIONS")))
  436 
  437 #;WB database with relational wrapper.
  438 (define-build-feature
  439   'wb
  440   '((c-file
  441      "../wb/c/blink.c" "../wb/c/blkio.c" "../wb/c/del.c" "../wb/c/ents.c"
  442      "../wb/c/handle.c" "../wb/c/prev.c" "../wb/c/scan.c" "../wb/c/segs.c"
  443      "../wb/c/stats.c" "../wb/c/wbsys.c" "../wb/c/wbscm.c")
  444     (c-lib pthread)
  445     (scm-srcdir "../scm")
  446     (compiled-init "init_db")))
  447 (define-build-feature
  448   'wb-no-threads
  449   '((c-file
  450      "../wb/c/blink.c" "../wb/c/blkio.c" "../wb/c/del.c" "../wb/c/ents.c"
  451      "../wb/c/handle.c" "../wb/c/prev.c" "../wb/c/scan.c" "../wb/c/segs.c"
  452      "../wb/c/stats.c" "../wb/c/wbsys.c" "../wb/c/wbscm.c")
  453     (scm-srcdir "../scm")
  454     (compiled-init "init_db")))
  455 
  456 ;;;; The rest is about building on specific platforms.
  457 
  458 (define-tables build
  459 
  460   '(processor-family
  461     ((family symbol))
  462     ((also-runs processor-family))
  463     ((*unknown* #f)
  464      (i8086 #f)
  465      (ia64 #f)
  466      (acorn #f)
  467      (alpha #f)
  468      (cray #f)
  469      (hp-risc #f)
  470      (i386 i8086)
  471      (m68000 #f)
  472      (m68030 m68000)
  473      (mips #f)
  474      (nos/ve #f)
  475      (pdp-10 #f)
  476      (pdp-11 #f)
  477      (pdp-8 #f)
  478      (powerpc #f)
  479      (pyramid #f)
  480      (sequent #f)
  481      (sparc #f)
  482      (tahoe #f)
  483      (vax pdp-11)
  484      ))
  485 
  486   '(platform
  487     ((name symbol))
  488     ((processor processor-family)
  489      (operating-system operating-system)
  490      (compiler symbol)
  491      ;;(linker symbol)
  492      )
  493     ((*unknown*      *unknown* unix      cc        ) ;ld
  494      (acorn-unixlib  acorn     *unknown* cc        ) ;link
  495      (aix        powerpc   aix       cc        ) ;cc
  496      (osf1       alpha     unix      cc        ) ;cc
  497      (alpha-elf      alpha     unix      cc        ) ;cc
  498      (alpha-linux    alpha     linux     gcc       ) ;gcc
  499      (amiga-aztec    m68000    amiga     cc        ) ;cc
  500      (amiga-dice-c   m68000    amiga     dcc       ) ;dcc
  501      (amiga-gcc      m68000    amiga     gcc       ) ;gcc
  502      (amiga-sas      m68000    amiga     lc        ) ;link
  503      (atari-st-gcc   m68000    atari-st  gcc       ) ;gcc
  504      (atari-st-turbo-c   m68000    atari-st  tcc       ) ;tlink
  505      (borland-c      i8086     ms-dos    bcc       ) ;bcc
  506      (gnu-win32      i386      unix      gcc       ) ;gcc
  507      (djgpp      i386      ms-dos    gcc       ) ;gcc
  508      (freebsd        *unknown*     unix      cc        ) ;cc
  509      (gcc        *unknown* unix      gcc       ) ;gcc
  510      (highc      i386      ms-dos    hc386     ) ;bind386
  511      (hp-ux      hp-risc   hp-ux     cc        ) ;cc
  512      (irix       mips      irix      gcc       ) ;gcc
  513      (linux      *unknown*     linux     gcc       ) ;gcc
  514      (linux-aout     i386      linux     gcc       ) ;gcc
  515      (linux-ia64     ia64      linux     gcc       ) ;gcc
  516      (darwin         powerpc   unix      cc        ) ;gcc
  517      (microsoft-c    i8086     ms-dos    cl        ) ;link
  518      (microsoft-c-nt     i386      ms-dos    cl        ) ;link
  519      (microsoft-quick-c  i8086     ms-dos    qcl       ) ;qlink
  520      (ms-dos         i8086     ms-dos    cc        ) ;link
  521      (netbsd         *unknown* unix      gcc       ) ;gcc
  522      (openbsd        *unknown* unix      gcc       ) ;gcc
  523      (os/2-cset      i386      os/2      icc       ) ;link386
  524      (os/2-emx       i386      os/2      gcc       ) ;gcc
  525      (plan9-8        i386      plan9     8c        ) ;8l
  526      (svr4-gcc-sun-ld    sparc     sunos     gcc       ) ;ld
  527      (sunos      sparc     sunos     cc        ) ;ld
  528      (svr4       *unknown* unix      cc        ) ;ld
  529      (turbo-c        i8086     ms-dos    tcc       ) ;tcc
  530      (unicos         cray      unicos    cc        ) ;cc
  531      (unix       *unknown* unix      cc        ) ;cc
  532      (vms        vax       vms       cc        ) ;link
  533      (vms-gcc        vax       vms       gcc       ) ;link
  534      (watcom-9.0     i386      ms-dos    wcc386p   ) ;wlinkp
  535      ))
  536 
  537   '(C-libraries
  538     ((library symbol)
  539      (platform platform))
  540     ((compiler-flags string)
  541      (link-lib-flag string)
  542      (lib-path optstring)
  543      (lib-support expression)
  544      (suppress-files expression))
  545 
  546     ((m *unknown* "" "-lm" "/usr/lib/libm.a" () ())
  547      (c *unknown* "" "-lc" "/usr/lib/libc.a" () ())
  548      (regex *unknown* "" "-lregex" "/usr/lib/libregex.a" () ())
  549      (curses *unknown* "" "-lcurses" "/usr/lib/libcurses.a" () ())
  550      (graphics *unknown* "-I/usr/X11/include -DX11" "-lX11"
  551            "/usr/X11/lib/libX11.sa" () ())
  552      (editline *unknown* "" "-lreadline" "/usr/lib/libreadline.a" () ())
  553      (termcap *unknown* "" "-ltermcap" "/usr/lib/libtermcap.a" () ())
  554      (debug *unknown* "-g" "-g" #f () ())
  555      (socket *unknown* "" "" #f () ())
  556      (lib *unknown* "" "" #f () ("scmmain.c"))
  557      (mysql *unknown* "-I/usr/include/mysql" "-L/usr/lib/mysql -lmysqlclient"
  558         "/usr/lib/mysql/libmysqlclient.a" () ())
  559      (pthread *unknown* "" "-lpthread" #f () ())
  560 
  561      (m gnu-win32 "" "" #f () ())
  562      (c gnu-win32 "" "" #f () ())
  563      (dlll gnu-win32 "-DSCM_WIN_DLL" "" #f () ("posix.c" "unix.c" "socket.c"))
  564 
  565      (m linux-aout "" "-lm" "/usr/lib/libm.sa" () ())
  566      (c linux-aout "" "-lc" "/usr/lib/libc.sa" () ())
  567      (dlll linux-aout "-DDLD -DDLD_DYNCM" "-ldld" #f () ("findexec.c"))
  568      (curses linux-aout "-I/usr/include/ncurses" "-lncurses"
  569          "/usr/lib/libncurses.a" () ())
  570      (nostart linux-aout "" "-nostartfiles" #f ("pre-crt0.c") ())
  571      (dump linux-aout "" "/usr/lib/crt0.o" #f ("unexec.c" "gmalloc.c") ())
  572 
  573      (m linux "" "-lm" "/lib/libm.so" () ())
  574      (c linux "" "-lc" "/lib/libc.so" () ())
  575      (dlll linux "-DSUN_DL" "-ldl" #f () ())
  576      (regex linux "" "" #f () ())
  577      (graphics linux "-I/usr/include/X11 -DX11" "-L/usr/X11R6/lib -lX11"
  578            "/usr/X11R6/lib/libX11.so" () ())
  579      (curses linux "" "-lcurses" "/lib/libncurses.so" () ())
  580      (nostart linux "" "" #f () ())
  581      (dump linux "" "" #f ("unexelf.c" "gmalloc.c") ())
  582 
  583      (dump irix "" "-G 0" #f () ())
  584 
  585      (m acorn-unixlib "" "" #f () ())
  586 
  587      (nostart osf1 "" "" #f ("pre-crt0.c") ())
  588      (dlll osf1 "-DSUN_DL" "" #f () ())
  589      (dump osf1 "" "" #f ("unexalpha.c" "gmalloc.c") ())
  590      (regex osf1 "" "" #f () ())
  591      (graphics osf1 "-I/usr/include/X11 -DX11" "-lX11"
  592            #f () ())
  593 
  594      (m amiga-dice-c "" "-lm" #f () ())
  595      (m amiga-sas "" "lcmieee.lib" #f () ())
  596      (c amiga-sas "" "lc.lib" #f () ())
  597 
  598      (m vms-gcc "" "" #f () ())
  599      (m vms "" "" #f () ())
  600 
  601      (m atari-st-gcc "" "-lpml" #f () ())
  602      (m atari-st-turbo-c "" "" #f () ())
  603 
  604      (c plan9-8 "" "" #f () ())
  605      (m plan9-8 "" "" #f () ())
  606 
  607      (m sunos "" "-lm" #f () ())
  608      (dlll sunos "-DSUN_DL" "-ldl" #f () ())
  609      (nostart sunos "" "-e __start -nostartfiles -static" #f ("ecrt0.c") ())
  610      (dump sunos "" "" #f ("unexelf.c" "gmalloc.c") ())
  611 
  612      (m svr4-gcc-sun-ld "" "-lm" #f () ())
  613      (dlll svr4-gcc-sun-ld "-DSUN_DL" "-Wl,-ldl -export-dynamic" #f () ())
  614      (nostart svr4-gcc-sun-ld "" "-e __start -nostartfiles" #f ("ecrt0.c") ())
  615      (dump svr4-gcc-sun-ld "" "" #f ("unexelf.c" "gmalloc.c") ())
  616      (socket svr4-gcc-sun-ld "" "-lsocket -lnsl" #f () ())
  617      (regex svr4-gcc-sun-ld "" "" #f () ())
  618 
  619      (nostart gcc "" "-e __start -nostartfiles" #f ("ecrt0.c") ())
  620      (dump gcc "" "" #f ("unexelf.c" "gmalloc.c") ())
  621 
  622      (m hp-ux "" "-lm" #f () ())
  623      (dlll hp-ux "-DHAVE_DYNL" "-Wl,-E -ldld" #f () ())
  624      (graphics hp-ux "-DX11" "-lX" "/usr/lib/X11R5/libX11.sl" () ())
  625      (nostart hp-ux "" "" #f ("ecrt0.c") ())
  626      (dump hp-ux "" "" #f ("unexhp9k800.c" "gmalloc.c") ())
  627 
  628      (c djgpp "" "-lc" #f () ("findexec.c"))
  629      (curses djgpp "-I/djgpp/contrib/pdcurses/include/"
  630          "-L/djgpp/contrib/pdcurses/lib/ -lcurses"
  631          "\\djgpp\\contrib\\pdcurses\\lib\\libcurse.a" () ())
  632      (nostart djgpp "" "-nostartfiles" #f ("pre-crt0.c") ())
  633      (dump djgpp "" "c:/djgpp/lib/crt0.o" #f ("unexec.c" "gmalloc.c") ())
  634 ;;;     (nostart djgpp "" "" #f ("ecrt0.c") ())
  635 ;;;     (dump djgpp "" "" #f ("unexelf.c" "gmalloc.c") ())
  636 ;;;     (nostart djgpp "" "-e __start -nostartfiles -static" #f ("ecrt0.c") ())
  637 ;;;     (dump djgpp "" "" #f ("unexelf.c" "gmalloc.c") ())
  638 
  639      (c microsoft-c "" "" #f () ("findexec.c"))
  640      (m microsoft-c "" "" #f () ())
  641      (c microsoft-c-nt "" "" #f () ("findexec.c"))
  642      (m microsoft-c-nt "" "" #f () ())
  643      (dlll microsoft-c-nt "-DSCM_WIN_DLL -MD" "" #f () ("posix.c" "unix.c" "socket.c"))
  644      (debug microsoft-c-nt "-Zi" "/debug" #f () ())
  645      (c microsoft-quick-c "" "" #f () ("findexec.c"))
  646      (m microsoft-quick-c "" "" #f () ())
  647 
  648      (c turbo-c "" "" #f () ("findexec.c"))
  649      (m turbo-c "" "" #f () ())
  650      (graphics turbo-c "" "graphics.lib" #f () ())
  651 
  652      (c borland-c "" "" #f () ("findexec.c"))
  653      (m borland-c "" "" #f () ())
  654      (graphics borland-c "" "graphics.lib" #f () ())
  655      (windows borland-c "-N -W" "-W" #f () ())
  656 
  657      (c highc "" "" #f () ("findexec.c"))
  658      (m highc "" "" #f () ())
  659      (windows highc "-Hwin" "-Hwin" #f () ())
  660 
  661      (m darwin "" "" #f () ())
  662      (c darwin "" "" #f () ())
  663      (curses darwin "" "" #f () ())
  664      (regex darwin "" "" #f () ())
  665      (dump darwin "" "" #f ("unexmacosx.c" "lastfile.c") ())
  666      (dlll darwin "-DSUN_DL" "-ldl" "" () ())
  667 
  668      (c freebsd "" "-export-dynamic" #f () ())
  669      (m freebsd "" "-lm" #f () ())
  670      (curses freebsd "" "-lncurses" "/usr/lib/libncurses.a" () ())
  671      (regex freebsd "-I/usr/include/gnu" "-lgnuregex" "" () ())
  672      (editline freebsd "" "-lreadline" "" () ())
  673      (dlll freebsd "-DSUN_DL" "-export-dynamic" "" () ())
  674      (nostart freebsd "" "-e start -dc -dp -Bstatic -lgnumalloc" #f ("pre-crt0.c") ())
  675      (dump freebsd "" "/usr/lib/crt0.o" "" ("unexsunos4.c") ())
  676      (curses netbsd "-I/usr/pkg/include" "-lncurses" "-Wl,-rpath -Wl,/usr/pkg/lib -L/usr/pkg/lib" () ())
  677      (editline netbsd "-I/usr/pkg/include" "-lreadline" "-Wl,-rpath -Wl,/usr/pkg/lib -L/usr/pkg/lib" () ())
  678      (graphics netbsd "-I/usr/X11R6/include -DX11" "-lX11" "-Wl,-rpath -Wl,/usr/X11R6/lib -L/usr/X11R6/lib" () ())
  679      (m netbsd "" "-lm" #f () ())
  680      (m openbsd "" "-lm" #f () ())
  681      (dlll openbsd "-DSUN_DL" "" "" () ())
  682      (curses openbsd "" "-lcurses" "/usr/lib/libcurses.a" () ())
  683      (regex openbsd "" "" #f () ())
  684      ))
  685 
  686   '(compile-commands
  687     ((name symbol)
  688      (platform platform))
  689     ((procedure expression))
  690     ((update-catalog *unknown*
  691              (lambda (oname objects libs parms)
  692                (batch:rebuild-catalog parms)
  693                (if (= 1 (length objects)) (car objects)
  694                objects))))))
  695 
  696 (define define-compile-commands
  697   (let ((defcomms ((open-table! build 'compile-commands) 'row:insert)))
  698     (lambda args
  699       (defcomms args))))        ;(append args (list (comment)))
  700 (defmacro defcommand (name platform procedure)
  701   `(define-compile-commands ',name ',platform ',procedure))
  702 
  703 (defcommand compile-c-files borland-c
  704   (lambda (files parms)
  705     (define rsp-name "temp.rsp")
  706     (apply batch:lines->file parms rsp-name files)
  707     (and (batch:try-command
  708       parms
  709       "bcc" "-d" "-Z" "-G" "-w-pro" "-ml" "-c"
  710       (if (member '(define "FLOATS" #t)
  711               (c-defines parms))
  712           "" "-f-")
  713       (include-spec "-I" parms)
  714       (c-includes parms)
  715       (c-flags parms)
  716       (string-append "@" rsp-name))
  717      (truncate-up-to (map c->obj files) #\\))))
  718 (defcommand link-c-program borland-c
  719   (lambda (oname objects libs parms)
  720     (define lnk-name (string-append oname ".lnk"))
  721     (apply batch:lines->file parms
  722        lnk-name
  723        (append libs objects))
  724     (and (batch:try-command
  725       parms "bcc" (string-append "-e" oname)
  726       "-ml" (string-append "@" lnk-name))
  727      (string-append oname ".exe"))))
  728 
  729 (defcommand compile-c-files turbo-c
  730   (lambda (files parms)
  731     (and (batch:try-chopped-command
  732       parms
  733       "tcc" "-c" "-d" "-Z" "-G" "-ml" "-c"
  734       "-Ic:\\turboc\\include"
  735       (include-spec "-I" parms)
  736       (c-includes parms)
  737       (c-flags parms)
  738       files)
  739      (truncate-up-to (map c->obj files) #\\))))
  740 (defcommand link-c-program turbo-c
  741   (lambda (oname objects libs parms)
  742     (let ((exe (truncate-up-to (obj->exe (car objects)) #\\))
  743       (oexe (string-append oname ".exe")))
  744       (and (or (string-ci=? exe oexe)
  745            (batch:delete-file parms oexe))
  746        (batch:try-command
  747         parms "tcc" "-Lc:\\turboc\\lib" libs objects)
  748        (or (string-ci=? exe oexe)
  749            (batch:rename-file parms exe oexe))
  750        oexe))))
  751 
  752 (defcommand compile-c-files microsoft-c
  753   (lambda (files parms)
  754     (and (batch:try-chopped-command
  755       parms "cl" "-c" "Oxp" "-AH"
  756       (include-spec "-I" parms)
  757       (c-includes parms)
  758       (c-flags parms)
  759       files)
  760      (truncate-up-to (map c->obj files) #\\))))
  761 (defcommand link-c-program microsoft-c
  762   (lambda (oname objects libs parms)
  763     (let ((exe (truncate-up-to (obj->exe (car objects)) #\\))
  764       (oexe (string-append oname ".exe")))
  765       (and (or (string-ci=? exe oexe)
  766            (batch:delete-file parms oexe))
  767        (batch:try-command
  768         parms "link" "/noe" "/ST:40000"
  769         (apply string-join "+" (map obj-> objects))
  770         libs)
  771        (or (string-ci=? exe oexe)
  772            (batch:rename-file parms exe oexe))
  773        oexe))))
  774 
  775 (defcommand compile-c-files microsoft-c-nt
  776   (lambda (files parms)
  777     (and (batch:try-chopped-command
  778       parms
  779       "cl" "-c" "-nologo"
  780       (if (memq 'stack-limit (parameter-list-ref parms 'features))
  781           "-Oityb1" "-Ox")
  782       (include-spec "-I" parms)
  783       (c-includes parms)
  784       (c-flags parms)
  785       files)
  786      (truncate-up-to (map c->obj files) #\\))))
  787 (defcommand compile-dll-c-files microsoft-c-nt
  788   (lambda (files parms)
  789     (define platform (car (parameter-list-ref parms 'platform)))
  790     (let ((suppressors (build:c-suppress 'dlll platform)))
  791       (define c-files (remove-if (lambda (file) (member file suppressors))
  792                  files))
  793       (and (batch:try-chopped-command
  794         parms
  795         "cl" "-c" "-nologo"
  796         (if (memq 'stack-limit (parameter-list-ref parms 'features))
  797         "-Oityb1" "-Ox")
  798         (include-spec "-I" parms)
  799         (c-includes parms)
  800         (c-flags parms)
  801         c-files)
  802        (let ((fnames (map c-> c-files)))
  803          (and (batch:try-command
  804            parms "link" "/dll" "/nologo"
  805            (string-append "/out:" (car fnames) ".dll")
  806            (string-append "/implib:" (car fnames) ".lib")
  807            fnames
  808            (map (lambda (l) (build:lib-ld-flag l platform))
  809             (parameter-list-ref parms 'c-lib))
  810            "scm.lib")
  811           (list (string-append (car fnames) ".dll"))))))))
  812 (defcommand make-dll-archive microsoft-c-nt
  813   (lambda (oname objects libs parms) objects))
  814 (defcommand make-archive microsoft-c-nt
  815   (lambda (oname objects libs parms)
  816     (let ((aname (string-append oname ".dll")))
  817       (and (batch:try-command parms
  818                   "link" "/dll" "/nologo"
  819                   (string-append "/out:" aname)
  820                   (string-append "/implib:" oname ".lib")
  821                   libs (map obj-> objects))
  822        aname))))
  823 (defcommand link-c-program microsoft-c-nt
  824   (lambda (oname objects libs parms)
  825     (let ((exe (truncate-up-to (obj->exe (car objects)) #\\))
  826       (oexe (string-append oname ".exe")))
  827       (and (batch:try-command
  828         parms "link" "/nologo"
  829         (string-append "/out:" oexe)
  830         (apply string-join " " (map obj-> objects))
  831         libs)
  832        oexe))))
  833 
  834 (defcommand compile-c-files microsoft-quick-c
  835   (lambda (files parms)
  836     (and (batch:try-chopped-command
  837       parms
  838       "qcl" "/AH" "/W1" "/Ze" "/O" "/Ot" "/DNDEBUG"
  839       (include-spec "-I" parms)
  840       (c-includes parms)
  841       (c-flags parms)
  842       files)
  843      (truncate-up-to (map c->obj files) #\\))))
  844 (defcommand link-c-program microsoft-quick-c
  845   (lambda (oname objects libs parms)
  846     (define crf-name (string-append oname ".crf"))
  847     (apply batch:lines->file parms
  848        crf-name
  849        `(,@(map (lambda (f) (string-append f " +"))
  850             objects)
  851          ""
  852          ,(string-append oname ".exe")
  853          ,(apply string-join " " libs)
  854          ";"))
  855     (and (batch:try-command
  856       parms "qlink"
  857       "/CP:0xffff" "/NOI" "/SE:0x80" "/ST:0x9c40"
  858       crf-name)
  859      (string-append oname ".exe"))))
  860 
  861 (defcommand compile-c-files watcom-9.0
  862   (lambda (files parms)
  863     (and (batch:try-chopped-command
  864       parms
  865       "wcc386p" "/mf" "/d2" "/ze" "/oxt" "/3s"
  866       "/zq" "/w3"
  867       (include-spec "-I" parms)
  868       (c-includes parms)
  869       (c-flags parms)
  870       files)
  871      (truncate-up-to (map c->obj files) #\\))))
  872 (defcommand link-c-program watcom-9.0
  873   (lambda (oname objects libs parms)
  874     (let ((exe (truncate-up-to (obj->exe (car objects)) #\\))
  875       (oexe (string-append oname ".exe")))
  876       (and (or (string-ci=? exe oexe)
  877            (batch:delete-file parms oexe))
  878        (batch:try-command
  879         parms
  880         "wlinkp" "option" "quiet" "option"
  881         "stack=40000" "FILE"
  882         (apply string-join "," (map obj-> objects))
  883         libs)
  884        (if (not (string-ci=? exe oexe))
  885            (batch:rename-file parms exe oexe))
  886        oexe))))
  887 (defcommand compile-c-files highc
  888   (lambda (files parms)
  889     (define hcc-name "temp.hcc")
  890     (apply batch:lines->file parms hcc-name files)
  891     (and (batch:try-command
  892       parms
  893       "d:\\hi_c\\hc386.31\\bin\\hc386"
  894       (include-spec "-I" parms)
  895       (c-includes parms)
  896       (c-flags parms)
  897       "-c" (string-append "@" hcc-name))
  898      (truncate-up-to (map c->obj files) #\\))))
  899 (defcommand link-c-program highc
  900   (lambda (oname objects libs parms)
  901     (let ((oexe (string-append oname ".exe")))
  902       (define lnk-name (string-append oname ".lnk"))
  903       (apply batch:lines->file parms
  904          lnk-name (append libs objects))
  905       (and (batch:try-command
  906         parms
  907         "d:\\hi_c\\hc386.31\\bin\\hc386" "-o" oname
  908         "-stack 65000"
  909         (string-append "@" lnk-name))
  910        (batch:try-command
  911         parms
  912         "bind386" "d:/hi_c/pharlap.51/run386b.exe" oname
  913         "-exe" oexe)
  914        oexe))))
  915 
  916 (defcommand compile-c-files djgpp
  917   (lambda (files parms)
  918     (and (batch:try-chopped-command
  919       parms
  920       "gcc" "-c"
  921       (include-spec "-I" parms)
  922       (c-includes parms)
  923       (c-flags parms)
  924       files)
  925      (truncate-up-to (map c->o files) "\\/"))))
  926 (defcommand link-c-program djgpp
  927   (lambda (oname objects libs parms)
  928     (let ((exe (string-append oname ".exe")))
  929       (and (or (batch:try-command parms
  930                   "gcc" "-o" oname
  931                   (must-be-first
  932                    '("-nostartfiles"
  933                      "pre-crt0.o" "ecrt0.o"
  934                      "c:/djgpp/lib/crt0.o")
  935                    (append objects libs)))
  936            (let ((arname (string-append oname ".a")))
  937          (batch:delete-file parms arname)
  938          (and (batch:try-chopped-command
  939                parms
  940                "ar" "r" arname objects)
  941               (batch:try-command
  942                parms "gcc" "-o" oname
  943                (must-be-first
  944             '("-nostartfiles"
  945               "pre-crt0.o" "ecrt0.o"
  946               "c:/djgpp/lib/crt0.o")
  947             (cons arname libs)))
  948               (batch:delete-file parms arname)))
  949            ;;(build:error 'build "couldn't build archive")
  950            )
  951        (batch:try-command parms "strip" exe)
  952        (batch:delete-file parms oname)
  953        ;;(batch:delete-file parms exe)
  954        ;;(batch:try-command parms "coff2exe" "-s" "c:\\djgpp\\bin\\go32.exe" oname)
  955        exe))))
  956 
  957 (defcommand compile-c-files os/2-emx
  958   (lambda (files parms)
  959     (and (batch:try-chopped-command parms
  960                     "gcc" "-m386" "-c"
  961                     (include-spec "-I" parms)
  962                     (c-includes parms)
  963                     (c-flags parms)
  964                     files)
  965      (truncate-up-to (map c->o files) #\\))))
  966 (defcommand link-c-program os/2-emx
  967   (lambda (oname objects libs parms)
  968     (and (batch:try-command
  969       parms "gcc" "-o" (string-append oname ".exe")
  970       objects libs)
  971      (string-append oname ".exe"))))
  972 
  973 (defcommand compile-c-files os/2-cset
  974   (lambda (files parms)
  975     (and (batch:try-chopped-command
  976       parms "icc" "/Gd-" "/Ge+" "/Gm+" "/Q" "-c"
  977       (include-spec "-I" parms)
  978       (c-includes parms)
  979       (c-flags parms)
  980       files)
  981      (truncate-up-to (map c->obj files) #\\))))
  982 (defcommand link-c-program os/2-cset
  983   (lambda (oname objects libs parms)
  984     (and (batch:try-command
  985       parms "link386" objects libs
  986       (string-append "," oname ".exe,,,;"))
  987      (string-append oname ".exe"))))
  988 
  989 (defcommand compile-c-files HP-UX
  990   (lambda (files parms)
  991     (and (batch:try-chopped-command parms
  992                     "cc" "+O1" "-c"
  993                     (include-spec "-I" parms)
  994                     (c-includes parms)
  995                     (c-flags parms)
  996                     files)
  997      (truncate-up-to (map c->o files) #\/))))
  998 (defcommand compile-dll-c-files HP-UX
  999   (lambda (files parms)
 1000     (and (batch:try-chopped-command
 1001       parms "cc" "+O1" "-Wl,-E" "+z" "-c"
 1002       (include-spec "-I" parms)
 1003       (c-includes parms)
 1004       (c-flags parms)
 1005       files)
 1006      (let ((fnames (truncate-up-to (map c-> files) #\/)))
 1007        (define fname.sl (string-append (car fnames) ".sl"))
 1008        (batch:rename-file parms fname.sl (string-append fname.sl "~"))
 1009        (and (batch:try-command
 1010          parms "ld" "-b" "-o"
 1011          fname.sl
 1012          (map (lambda (fname) (string-append fname ".o")) fnames))
 1013         (list fname.sl))))))
 1014 ;    (make-dll-archive HP-UX
 1015 ;              (lambda (oname objects libs parms)
 1016 ;            (and (batch:try-command
 1017 ;                  parms "ld" "-b" "-o" (string-append oname ".sl")
 1018 ;                  objects)
 1019 ;                 (batch:rebuild-catalog parms)
 1020 ;                 (string-append oname ".sl"))))
 1021 
 1022 (defcommand compile-dll-c-files linux-aout
 1023   (lambda (files parms)
 1024     (and (batch:try-chopped-command
 1025       parms
 1026       "gcc" "-c"
 1027       (include-spec "-I" parms)
 1028       (c-includes parms)
 1029       (c-flags parms)
 1030       files)
 1031      (truncate-up-to (map c->o files) #\/))))
 1032 ;;;     (make-dll-archive linux-aout
 1033 ;;;            (lambda (oname objects libs parms) #t
 1034 ;;;                (batch:rebuild-catalog parms)
 1035 ;;;                oname))
 1036 
 1037 (defcommand compile-c-files linux
 1038   (lambda (files parms)
 1039     (and (batch:try-chopped-command parms
 1040                     "gcc" "-c"
 1041                     (include-spec "-I" parms)
 1042                     (c-includes parms)
 1043                     (c-flags parms)
 1044                     files)
 1045      (truncate-up-to (map c->o files) #\/))))
 1046 (defcommand compile-dll-c-files linux
 1047   (lambda (files parms)
 1048     (and
 1049      (batch:try-chopped-command parms "gcc" "-fpic" "-c"
 1050                 (include-spec "-I" parms)
 1051                 (c-includes parms)
 1052                 (c-flags parms)
 1053                 files)
 1054      (let* ((platform (car (parameter-list-ref parms 'platform)))
 1055         (fnames (truncate-up-to (map c-> files) #\/))
 1056         (fname.so (string-append (car fnames) ".so"))
 1057         (result
 1058          (and (batch:try-command
 1059            parms
 1060            "gcc" "-shared" "-o" fname.so
 1061            (map (lambda (fname) (string-append fname ".o")) fnames)
 1062            (map (lambda (l) (build:lib-ld-flag l platform))
 1063             (parameter-list-ref parms 'c-lib)))
 1064           (list fname.so))))
 1065        (for-each (lambda (fname)
 1066            (batch:delete-file
 1067             parms (string-append fname ".o")))
 1068          fnames)
 1069        result))))
 1070 (defcommand make-dll-archive linux
 1071   (lambda (oname objects libs parms)
 1072     (let ((platform (car (parameter-list-ref parms 'platform))))
 1073       (and (batch:try-command
 1074         parms
 1075         "gcc" "-shared" "-o"
 1076         (string-append
 1077          (car (parameter-list-ref parms 'implvic))
 1078          oname ".so")
 1079         objects
 1080         (map (lambda (l) (build:lib-ld-flag l platform))
 1081          (parameter-list-ref parms 'c-lib)))
 1082        (batch:rebuild-catalog parms)
 1083        (string-append
 1084         (car (parameter-list-ref parms 'implvic))
 1085         oname ".so")))))
 1086 (defcommand link-c-program linux
 1087   (lambda (oname objects libs parms)
 1088     (and (batch:try-command
 1089       parms "gcc" "-rdynamic" "-o" oname
 1090       (must-be-first
 1091        '("pre-crt0.o" "ecrt0.o" "/usr/lib/crt0.o")
 1092        (append objects libs)))
 1093      oname)))
 1094 
 1095 (define (build-continue-ia64 parms)
 1096   (and (batch:try-command
 1097     parms "gcc -o get-contoffset-ia64 get-contoffset-ia64.c")
 1098        (batch:try-command
 1099     parms "./get-contoffset-ia64 contoffset-ia64.S")
 1100        (batch:try-command
 1101     parms "gcc -c continue-ia64.S")))
 1102 
 1103 (defcommand link-c-program linux-ia64
 1104   (lambda (oname objects libs parms)
 1105     (and (build-continue-ia64 parms)
 1106      (batch:try-command
 1107       parms "gcc" "-rdynamic" "-o" oname "continue-ia64.o"
 1108       (must-be-first
 1109        '("pre-crt0.o" "ecrt0.o" "/usr/lib/crt0.o")
 1110        (append objects libs)))
 1111      oname)))
 1112 
 1113 (defcommand compile-c-files unicos
 1114   (lambda (files parms)
 1115     (and (batch:try-chopped-command
 1116       parms
 1117       "cc" "-hvector2" "-hscalar2" "-c"
 1118       (include-spec "-i" parms)
 1119       (c-includes parms)
 1120       (c-flags parms)
 1121       files)
 1122      (truncate-up-to (map c->o files) #\/))))
 1123 (defcommand link-c-program unicos
 1124   (lambda (oname objects libs parms)
 1125     (and (batch:try-command
 1126       parms "cc" "setjump.o" "-o" oname objects libs)
 1127      oname)))
 1128 
 1129 ;; George Bronnikov <goga@rubinstein.mccme.ru> describes options for the
 1130 ;; PLAN9 native C compiler `8c':
 1131 ;;
 1132 ;; -F Enable type-checking of calls to print(2) and other
 1133 ;;    formatted print routines.
 1134 ;; -V By default, the compilers are non-standardly lax about
 1135 ;;    type equality between void* values and other pointers.
 1136 ;;    This flag requires ANSI C conformance.
 1137 ;; -w Print warning messages about unused variables etc. (It
 1138 ;;    does print a lot of them, indeed.)
 1139 ;; -p Invoke a standard ANSI C preprocessor before compiling
 1140 ;;    (instead of a rudimentary builtin one used by default).
 1141 (defcommand compile-c-files plan9-8
 1142   (lambda (files parms)
 1143     (and (batch:try-chopped-command
 1144       parms
 1145       "8c" "-Fwp" "-DPLAN9"     ;"-V"
 1146       ;;(include-spec "-i" parms)
 1147       (c-includes parms)
 1148       (c-flags parms)
 1149       files)
 1150      (truncate-up-to (map c->8 files) #\/))))
 1151 (defcommand link-c-program plan9-8
 1152   (lambda (oname objects libs parms)
 1153     (and (batch:try-command
 1154       parms "8l" "-o" oname objects libs)
 1155      oname)))
 1156 
 1157 (defcommand compile-c-files gcc
 1158   (lambda (files parms)
 1159     (and (batch:try-chopped-command parms
 1160                     "gcc" "-c"
 1161                     (include-spec "-I" parms)
 1162                     (c-includes parms)
 1163                     (c-flags parms)
 1164                     files)
 1165      (truncate-up-to (map c->o files) #\/))))
 1166 (defcommand link-c-program gcc
 1167   (lambda (oname objects libs parms)
 1168     (batch:rename-file parms
 1169                oname (string-append oname "~"))
 1170     (and (batch:try-command parms
 1171                 "gcc" "-o" oname
 1172                 (must-be-first
 1173                  '("-nostartfiles"
 1174                    "pre-crt0.o" "ecrt0.o"
 1175                    "/usr/lib/crt0.o")
 1176                  (append objects libs)))
 1177      oname)))
 1178 (defcommand compile-dll-c-files gcc
 1179   (lambda (files parms)
 1180     (and (batch:try-chopped-command parms
 1181                     "gcc" "-c"
 1182                     (include-spec "-I" parms)
 1183                     (c-includes parms)
 1184                     (c-flags parms)
 1185                     files)
 1186      (truncate-up-to (map c->o files) "\\/]"))))
 1187 (defcommand make-dll-archive gcc
 1188   (lambda (oname objects libs parms)
 1189     (and (batch:try-command
 1190       parms
 1191       "ld" "-assert" "pure-text" "-o"
 1192       (string-append
 1193        (car (parameter-list-ref parms 'implvic))
 1194        oname ".so.1.0")
 1195       objects)
 1196      (batch:rebuild-catalog parms)
 1197      (string-append
 1198       (car (parameter-list-ref parms 'implvic))
 1199       oname ".so.1.0"))))
 1200 
 1201 (defcommand compile-dll-c-files gnu-win32
 1202   (lambda (files parms)
 1203     (define platform (car (parameter-list-ref parms 'platform)))
 1204     (let ((suppressors (build:c-suppress 'dlll platform)))
 1205       (define c-files (remove-if (lambda (file) (member file suppressors))
 1206                  files))
 1207       (and (batch:try-chopped-command
 1208         parms "gcc" "-c"
 1209         (include-spec "-I" parms)
 1210         (c-includes parms)
 1211         (c-flags parms)
 1212         c-files)
 1213        (let ((fnames (map c-> c-files)))
 1214          (and (batch:try-command
 1215            parms "dllwrap"
 1216            "--output-lib" (string-append (car fnames) ".lib")
 1217            "-dllname" (string-append (car fnames) ".dll")
 1218            "--output-def" (string-append (car fnames) ".def")
 1219            (map (lambda (fname) (string-append fname ".o"))
 1220             fnames)
 1221            (map (lambda (l) (build:lib-ld-flag l platform))
 1222             (parameter-list-ref parms 'c-lib))
 1223            "scm.lib")
 1224           (list (string-append (car fnames) ".dll"))))))))
 1225 (defcommand make-dll-archive gnu-win32
 1226   (lambda (oname objects libs parms) objects))
 1227 (defcommand make-archive gnu-win32
 1228   (lambda (oname objects libs parms)
 1229     (let ((aname (string-append oname ".dll")))
 1230       (and (batch:try-command parms
 1231                   "dllwrap"
 1232                   "--output-lib" (string-append oname ".lib")
 1233                   "-dllname" aname
 1234                   "--output-def" (string-append oname ".def")
 1235                   libs objects)
 1236        aname))))
 1237 (defcommand compile-c-files gnu-win32
 1238   (lambda (files parms)
 1239     (and (batch:try-chopped-command parms
 1240                     "gcc" "-c"
 1241                     (include-spec "-I" parms)
 1242                     (c-includes parms)
 1243                     (c-flags parms)
 1244                     files)
 1245      (truncate-up-to (map c->o files) #\/))))
 1246 (defcommand link-c-program gnu-win32
 1247   (lambda (oname objects libs parms)
 1248     (batch:rename-file parms
 1249                (string-append oname ".exe")
 1250                (string-append oname "~"))
 1251     (and (batch:try-command parms
 1252                 "gcc" "-o" oname
 1253                 (must-be-first
 1254                  '("-nostartfiles"
 1255                    "pre-crt0.o" "ecrt0.o"
 1256                    "/usr/lib/crt0.o")
 1257                  (append objects libs)))
 1258      oname)))
 1259 
 1260 (defcommand compile-c-files osf1
 1261   (lambda (files parms)
 1262     (and (batch:try-chopped-command
 1263       parms
 1264       "cc" "-std1" "-c"
 1265       ;;(if (member "-g" (c-includes parms)) "" "-O")
 1266       (include-spec "-I" parms)
 1267       (c-includes parms)
 1268       (c-flags parms)
 1269       files)
 1270      (truncate-up-to (map c->o files) #\/))))
 1271 (defcommand compile-dll-c-files osf1
 1272   (lambda (files parms)
 1273     (and
 1274      (batch:try-chopped-command
 1275       parms "cc" "-std1" "-c"
 1276       (include-spec "-I" parms)
 1277       (c-includes parms)
 1278       (c-flags parms)
 1279       files)
 1280      (let* ((platform (car (parameter-list-ref parms 'platform)))
 1281         (fnames (truncate-up-to (map c-> files) #\/)))
 1282        (and (batch:try-command
 1283          parms "cc" "-shared" "-o" (string-append (car fnames) ".so")
 1284          (map (lambda (fname) (string-append fname ".o")) fnames)
 1285          (map (lambda (l) (build:lib-ld-flag l platform))
 1286           (parameter-list-ref parms 'c-lib)))
 1287         (for-each (lambda (fname)
 1288             (batch:delete-file parms (string-append fname ".o")))
 1289               fnames)
 1290         (list (string-append (car fnames) ".so")))))))
 1291 (defcommand make-dll-archive osf1
 1292   (lambda (oname objects libs parms)
 1293     (let ((platform (car (parameter-list-ref parms 'platform))))
 1294       (and (batch:try-command
 1295         parms
 1296         "cc" "-shared" "-o"
 1297         (string-append
 1298          (car (parameter-list-ref parms 'implvic))
 1299          oname ".so")
 1300         objects
 1301         (map (lambda (l) (build:lib-ld-flag l platform))
 1302          (parameter-list-ref parms 'c-lib)))
 1303        (batch:rebuild-catalog parms)
 1304        (string-append
 1305         (car (parameter-list-ref parms 'implvic))
 1306         oname ".so")))))
 1307 
 1308 (defcommand compile-c-files svr4-gcc-sun-ld
 1309   (lambda (files parms)
 1310     (and (batch:try-chopped-command parms
 1311                     "gcc" "-c"
 1312                     (include-spec "-I" parms)
 1313                     (c-includes parms)
 1314                     (c-flags parms)
 1315                     files)
 1316      (truncate-up-to (map c->o files) #\/))))
 1317 (defcommand link-c-program svr4-gcc-sun-ld
 1318   (lambda (oname objects libs parms)
 1319     (batch:rename-file parms
 1320                oname (string-append oname "~"))
 1321     (and (batch:try-command parms
 1322                 "gcc" "-o" oname
 1323                 (must-be-first
 1324                  '("-nostartfiles"
 1325                    "pre-crt0.o" "ecrt0.o"
 1326                    "/usr/lib/crt0.o")
 1327                  (append objects libs)))
 1328      oname)))
 1329 (defcommand compile-dll-c-files svr4-gcc-sun-ld
 1330   (lambda (files parms)
 1331     (and
 1332      (batch:try-chopped-command parms "gcc" "-fpic" "-c"
 1333                 (include-spec "-I" parms)
 1334                 (c-includes parms)
 1335                 (c-flags parms)
 1336                 files)
 1337      (let* ((platform (car (parameter-list-ref parms 'platform)))
 1338         (fnames (truncate-up-to (map c-> files) #\/)))
 1339        (and (batch:try-command
 1340          parms "ld" "-G" "-o" (string-append (car fnames) ".so")
 1341          (map (lambda (fname) (string-append fname ".o")) fnames)
 1342          (map (lambda (l) (build:lib-ld-flag l platform))
 1343           (parameter-list-ref parms 'c-lib)))
 1344         (for-each (lambda (fname)
 1345             (batch:delete-file parms (string-append fname ".o")))
 1346               fnames)
 1347         (list (string-append (car fnames) ".so")))))))
 1348 
 1349 (defcommand compile-c-files svr4
 1350   (lambda (files parms)
 1351     (and (batch:try-chopped-command parms
 1352                     "cc" "-DSVR4" "-c"
 1353                     (include-spec "-I" parms)
 1354                     (c-includes parms)
 1355                     (c-flags parms)
 1356                     files)
 1357      (truncate-up-to (map c->o files) #\/))))
 1358 
 1359 (defcommand compile-c-files aix
 1360   (lambda (files parms)
 1361     (and (batch:try-chopped-command parms
 1362                     "cc" "-Dunix" "-c"
 1363                     (include-spec "-I" parms)
 1364                     (c-includes parms)
 1365                     (c-flags parms)
 1366                     files)
 1367      (truncate-up-to (map c->o files) #\/))))
 1368 (defcommand link-c-program aix
 1369   (lambda (oname objects libs parms)
 1370     (and (batch:try-command
 1371       parms "cc" "-lansi" "-o" oname objects libs)
 1372      oname)))
 1373 
 1374 (defcommand compile-c-files amiga-aztec
 1375   (lambda (files parms)
 1376     (and (batch:try-chopped-command parms
 1377                     "cc" "-dAMIGA"
 1378                     (include-spec "-I" parms)
 1379                     (c-includes parms)
 1380                     (c-flags parms)
 1381                     files)
 1382      (truncate-up-to (map c->o files) #\/))))
 1383 (defcommand link-c-program amiga-aztec
 1384   (lambda (oname objects libs parms)
 1385     (and (batch:try-command
 1386       parms "cc" "-o" oname objects libs "-lma")
 1387      oname)))
 1388 
 1389 (defcommand compile-c-files amiga-sas
 1390   (lambda (files parms)
 1391     (and (batch:try-chopped-command
 1392       parms
 1393       "lc" "-d3" "-M" "-fi"
 1394       (include-spec "-I" parms)
 1395       (c-includes parms)
 1396       (c-flags parms)
 1397       files)
 1398      (batch:try-command
 1399       parms "blink with link.amiga NODEBUG")
 1400      (truncate-up-to (map c->o files) #\/))))
 1401 (defcommand link-c-program amiga-sas
 1402   (lambda (oname objects libs parms)
 1403     (define lnk-name "link.amiga")
 1404     (apply batch:lines->file parms
 1405        lnk-name
 1406        (apply string-join "+" ">FROM LIB:c.o"
 1407           (map object->string objects))
 1408        (string-append
 1409         "TO " (object->string (string-append "/" oname)))
 1410        (append
 1411         (cond
 1412          ((pair? libs)
 1413           (cons (string-append "LIB LIB:" (car libs))
 1414             (map (lambda (s)
 1415                (string-append "    LIB:" s))
 1416              (cdr libs))))
 1417          (else '()))
 1418         '("VERBOSE" "SC" "SD")))
 1419     oname))
 1420 
 1421 (defcommand compile-c-files amiga-dice-c
 1422   (lambda (files parms)
 1423     (and (batch:try-command
 1424       parms
 1425       "dcc" "-r" "-gs" "-c"
 1426       (include-spec "-I" parms)
 1427       (c-includes parms)
 1428       (c-flags parms)
 1429       files "-o" (truncate-up-to (map c->o files) #\/))
 1430      (truncate-up-to (map c->o files) #\/))))
 1431 (defcommand link-c-program amiga-dice-c
 1432   (lambda (oname objects libs parms)
 1433     (and (batch:try-command
 1434       parms "dcc" "-r" "-gs" "-o" oname objects libs)
 1435      oname)))
 1436 
 1437 (defcommand compile-c-files amiga-gcc
 1438   (lambda (files parms)
 1439     (and (batch:try-chopped-command parms
 1440                     "gcc" "-c"
 1441                     (include-spec "-I" parms)
 1442                     (c-includes parms)
 1443                     (c-flags parms)
 1444                     files)
 1445      (truncate-up-to (map c->o files) #\/))))
 1446 (defcommand link-c-program amiga-gcc
 1447   (lambda (oname objects libs parms)
 1448     (batch:rename-file parms
 1449                oname (string-append oname "~"))
 1450     (and (batch:try-command parms
 1451                 "gcc" "-o" oname
 1452                 (must-be-first
 1453                  '("-nostartfiles"
 1454                    "pre-crt0.o" "ecrt0.o"
 1455                    "/usr/lib/crt0.o")
 1456                  (append objects libs)))
 1457      oname)))
 1458 
 1459 (defcommand compile-c-files atari-st-gcc
 1460   (lambda (files parms)
 1461     (and (batch:try-chopped-command parms
 1462                     "gcc" "-v" "-c"
 1463                     (include-spec "-I" parms)
 1464                     (c-includes parms)
 1465                     (c-flags parms)
 1466                     files)
 1467      (truncate-up-to (map c->o files) #\/))))
 1468 (defcommand link-c-program atari-st-gcc
 1469   (lambda (oname objects libs parms)
 1470     (and (batch:try-command
 1471       parms "gcc" "-v" "-o" (string-append oname ".ttp")
 1472       objects libs)
 1473      (string-append oname ".ttp"))))
 1474 
 1475 (defcommand compile-c-files atari-st-turbo-c
 1476   (lambda (files parms)
 1477     (and (batch:try-chopped-command
 1478       parms
 1479       "tcc" "-P" "-W-" "-Datarist"
 1480       (include-spec "-I" parms)
 1481       (c-includes parms)
 1482       (c-flags parms)
 1483       files)
 1484      (truncate-up-to (map c->o files) #\/))))
 1485 (defcommand link-c-program atari-st-turbo-c
 1486   (lambda (oname objects libs parms)
 1487     (and (batch:try-command
 1488       parms "tlink" "-o" (string-append oname ".ttp")
 1489       objects libs "mintlib.lib" "osbind.lib"
 1490       "pcstdlib.lib" "pcfltlib.lib")
 1491      (string-append oname ".ttp"))))
 1492 
 1493 (defcommand compile-c-files acorn-unixlib
 1494   (lambda (files parms)
 1495     (and (batch:try-chopped-command
 1496       parms
 1497       "cc" "-c" "-depend" "!Depend" "-IUnixLib:"
 1498       "-pcc" "-Dunix" "-DSVR3" "-DARM_ULIB"
 1499       (include-spec "-I" parms)
 1500       (c-includes parms)
 1501       (c-flags parms)
 1502       files)
 1503      (truncate-up-to (map c->o files) #\/))))
 1504 (defcommand link-c-program acorn-unixlib
 1505   (lambda (oname objects libs parms)
 1506     (and (batch:try-command
 1507       parms "link" "-o" oname objects libs
 1508       ":5.$.dev.gcc.unixlib36d.clib.o.unixlib")
 1509      (batch:try-command parms "squeeze" oname)
 1510      oname)))
 1511 
 1512 (defcommand compile-c-files vms
 1513   (lambda (files parms)
 1514     (and (batch:try-chopped-command
 1515       parms
 1516       "cc"
 1517       (include-spec "-I" parms)
 1518       (c-includes parms)
 1519       (c-flags parms)
 1520       (map c-> files))
 1521      (truncate-up-to (map c->obj files) "/]"))))
 1522 (defcommand link-c-program vms
 1523   (lambda (oname objects libs parms)
 1524     (let ((exe (truncate-up-to (obj->exe (car objects)) "/]"))
 1525       (oexe (string-append oname ".exe")))
 1526       (and (batch:try-command parms "macro" "setjump")
 1527        (batch:try-command
 1528         parms
 1529         "link"
 1530         (apply string-join ","
 1531            (append (map obj-> objects)
 1532                '("setjump" "sys$input/opt\n   ")))
 1533         (apply string-join
 1534            "," (append (remove "" libs)
 1535                    '("sys$share:vaxcrtl/share"))))
 1536        (or (string-ci=? exe oexe)
 1537            (batch:rename-file parms exe oexe))
 1538        oexe))))
 1539 
 1540 (defcommand compile-c-files vms-gcc
 1541   (lambda (files parms)
 1542     (and (batch:try-chopped-command
 1543       parms
 1544       "gcc"
 1545       (include-spec "-I" parms)
 1546       (c-includes parms)
 1547       (c-flags parms)
 1548       (map c-> files))
 1549      (truncate-up-to (map c->obj files) "/]"))))
 1550 (defcommand link-c-program vms-gcc
 1551   (lambda (oname objects libs parms)
 1552     (let ((exe (truncate-up-to (obj->exe (car objects)) "/]"))
 1553       (oexe (string-append oname ".exe")))
 1554       (and (batch:try-command parms "macro" "setjump")
 1555        (batch:try-command
 1556         parms
 1557         "link"
 1558         (apply string-join ","
 1559            (append objects
 1560                '("setjump.obj"
 1561                  "sys$input/opt\n   ")))
 1562         (apply string-join
 1563            "," (append (remove "" libs)
 1564                    '("gnu_cc:[000000]gcclib/lib"
 1565                  "sys$share:vaxcrtl/share"))))
 1566        (or (string-ci=? exe oexe)
 1567            (batch:rename-file parms exe oexe))
 1568        oexe))))
 1569 
 1570 (defcommand compile-c-files *unknown*
 1571   (lambda (files parms)
 1572     (batch:try-chopped-command
 1573      parms
 1574      "cc" "-c"
 1575      (include-spec "-I" parms)
 1576      (c-includes parms)
 1577      (c-flags parms)
 1578      files)
 1579     (truncate-up-to (map c->o files) "\\/]")))
 1580 (defcommand link-c-program *unknown*
 1581   (lambda (oname objects libs parms)
 1582     (batch:rename-file parms
 1583                oname (string-append oname "~"))
 1584     (and (batch:try-command parms
 1585                 "cc" "-o" oname
 1586                 (must-be-first
 1587                  '("-nostartfiles"
 1588                    "pre-crt0.o" "ecrt0.o"
 1589                    "/usr/lib/crt0.o")
 1590                  (append objects libs)))
 1591      oname)))
 1592 (defcommand make-archive *unknown*
 1593   (lambda (oname objects libs parms)
 1594     (let ((aname (string-append "lib" oname ".a")))
 1595       (and (batch:try-command parms "ar rc" aname objects)
 1596        (batch:try-command parms "ranlib" aname)
 1597        aname))))
 1598 
 1599 (defcommand make-archive linux-ia64
 1600   (lambda (oname objects libs parms)
 1601     (let ((aname (string-append "lib" oname ".a")))
 1602       (and (build-continue-ia64 parms)
 1603        (batch:try-command parms "ar rc" aname objects "continue-ia64.o")
 1604        (batch:try-command parms "ranlib" aname)
 1605        aname))))
 1606 
 1607 (defcommand compile-dll-c-files *unknown*
 1608   (lambda (files parms)
 1609     (and (batch:try-chopped-command parms
 1610                     "cc" "-c"
 1611                     (include-spec "-I" parms)
 1612                     (c-includes parms)
 1613                     (c-flags parms)
 1614                     files)
 1615      (truncate-up-to (map c->o files) "\\/]"))))
 1616 (defcommand make-dll-archive *unknown*
 1617   (lambda (oname objects libs parms)
 1618     (let ((aname
 1619        (string-append
 1620         (car (parameter-list-ref parms 'implvic))
 1621         oname ".a")))
 1622       (and (batch:try-command parms "ar rc" aname objects)
 1623        (batch:try-command parms "ranlib" aname)
 1624        (batch:rebuild-catalog parms)
 1625        aname))))
 1626 
 1627 (defcommand compile-c-files freebsd
 1628   (lambda (files parms)
 1629     (and (batch:try-chopped-command
 1630       parms
 1631 ;;; gcc 3.4.2 for FreeBSD does not allow options other than default i.e. -O0 if NO -DGCC_SPARC_BUG - dai 2004-10-30
 1632       ;;"cc" "-O3 -pipe -DGCC_SPARC_BUG " "-c"
 1633       "cc" "-O3 -pipe " "-c"
 1634       (include-spec "-I" parms)
 1635       (c-includes parms)
 1636       (c-flags parms)
 1637       files)
 1638      (map c->o files))))
 1639 (defcommand link-c-program freebsd
 1640   (lambda (oname objects libs parms)
 1641     (batch:rename-file parms
 1642                oname (string-append oname "~"))
 1643     (and (batch:try-command parms
 1644                 "cc" "-o" oname
 1645                 (must-be-first
 1646                  '("-nostartfiles"
 1647                    "pre-crt0.o" "crt0.o"
 1648                    "/usr/lib/crt0.o")
 1649                  (append objects libs)))
 1650      oname)))
 1651 (defcommand compile-dll-c-files freebsd
 1652   (lambda (files parms)
 1653     (and (batch:try-chopped-command
 1654       parms "cc" "-O3 -pipe " "-fPIC" "-c"
 1655       (include-spec "-I" parms)
 1656       (c-includes parms)
 1657       (c-flags parms)
 1658       files)
 1659      (let ((fnames (truncate-up-to (map c-> files) #\/)))
 1660        (and (batch:try-command
 1661          parms "cc" "-shared"
 1662          (cond
 1663           ((equal? (car fnames) "edline") "-lreadline")
 1664           ((equal? (car fnames) "x") "-L/usr/X11R6/lib -lSM -lICE -lXext -lX11 -lxpg4")
 1665           (else ""))
 1666          "-o" (string-append (car fnames) ".so")
 1667          (map (lambda (fname) (string-append fname ".o")) fnames))
 1668         (for-each (lambda (fname)
 1669                 (batch:delete-file
 1670                  parms (string-append fname ".o")))
 1671               fnames)
 1672         (list (string-append (car fnames) ".so")))))))
 1673 (defcommand make-dll-archive freebsd
 1674   (lambda (oname objects libs parms)
 1675     (and (batch:try-command
 1676       parms
 1677       "cc" "-shared" "-o"
 1678       (string-append
 1679        (car (parameter-list-ref parms 'implvic))
 1680        oname ".so")
 1681       objects)
 1682      (batch:rebuild-catalog parms)
 1683      (string-append
 1684       (car (parameter-list-ref parms 'implvic))
 1685       oname ".so"))))
 1686 
 1687 (defcommand compile-c-files darwin
 1688   (lambda (files parms)
 1689     (and (batch:try-chopped-command
 1690       parms
 1691       "cc" "-O3" "-c"
 1692       (include-spec "-I" parms)
 1693       (c-includes parms)
 1694       (c-flags parms)
 1695       files)
 1696      (map c->o files))))
 1697 (defcommand link-c-program darwin
 1698   (lambda (oname objects libs parms)
 1699     (batch:rename-file parms
 1700                oname (string-append oname "~"))
 1701     (and (batch:try-command parms
 1702                 "cc" "-o" oname
 1703                 (append objects libs))
 1704      oname)))
 1705 (defcommand compile-dll-c-files darwin
 1706   (lambda (files parms)
 1707     (and (batch:try-chopped-command
 1708       parms
 1709       "env MACOSX_DEPLOYMENT_TARGET=10.3"
 1710       "gcc" "-c"
 1711       (include-spec "-I" parms)
 1712       (c-includes parms)
 1713       (c-flags parms)
 1714       files)
 1715      (let ((fnames (truncate-up-to (map c-> files) #\/)))
 1716        (and (batch:try-command
 1717          parms
 1718          "env MACOSX_DEPLOYMENT_TARGET=10.3"
 1719          "gcc" "-dynamiclib" "-single_module" "-L." "-undefined" "dynamic_lookup"
 1720          "-o" (string-append (car fnames) ".so")
 1721          (map (lambda (fname) (string-append fname ".o")) fnames))
 1722         (for-each (lambda (fname)
 1723                 (batch:delete-file
 1724                  parms (string-append fname ".o")))
 1725               fnames)
 1726         (list (string-append (car fnames) ".so")))))))
 1727 (defcommand make-dll-archive darwin
 1728   (lambda (oname objects libs parms)
 1729     (let ((platform (car (parameter-list-ref parms 'platform))))
 1730       (and (batch:try-command
 1731         parms
 1732         "env MACOSX_DEPLOYMENT_TARGET=10.3"
 1733         "gcc" "-dynamiclib" "-L." "-undefined" "dynamic_lookup" "-o"
 1734         (string-append
 1735          (car (parameter-list-ref parms 'implvic))
 1736          oname ".so")
 1737         objects
 1738         (map (lambda (l) (build:lib-ld-flag l platform))
 1739          (parameter-list-ref parms 'c-lib)))
 1740        (batch:rebuild-catalog parms)
 1741        (string-append
 1742         (car (parameter-list-ref parms 'implvic))
 1743         oname ".so")))))
 1744 
 1745 (defcommand compile-c-files netbsd
 1746   (lambda (files parms)
 1747     (and (batch:try-chopped-command
 1748       parms
 1749       "cc" "-c" (include-spec "-I" parms)
 1750       (include-spec "-I" parms)
 1751       (c-includes parms)
 1752       (c-flags parms)
 1753       files)
 1754      (map c->o files))))
 1755 (defcommand link-c-program netbsd
 1756   (lambda (oname objects libs parms)
 1757     (batch:rename-file parms
 1758                oname (string-append oname "~"))
 1759     (and (batch:try-command parms
 1760                 "cc" "-o" oname
 1761                 (must-be-first
 1762                  '("-nostartfiles"
 1763                    "pre-crt0.o" "crt0.o"
 1764                    "/usr/lib/crt0.o")
 1765                  (append libs objects)))
 1766      oname)))
 1767 (defcommand compile-dll-c-files netbsd
 1768   (lambda (files parms)
 1769     (and (batch:try-chopped-command
 1770       parms "cc" "-fPIC" "-c"
 1771       (include-spec "-I" parms)
 1772       (c-includes parms)
 1773       (c-flags parms)
 1774       files)
 1775      (let ((objs (map c->o files)))
 1776        (and (batch:try-command parms "gcc" "-shared" "-fPIC" objs)
 1777         (batch:try-command parms "mv" "a.out" (car objs))
 1778         (list (car objs)))))))
 1779 (defcommand make-dll-archive netbsd
 1780   (lambda (oname objects libs parms)
 1781     (and (batch:try-command
 1782       parms
 1783       "gcc" "-shared" "-fPIC" "-o"
 1784       (string-append
 1785        (car (parameter-list-ref parms 'implvic))
 1786        oname ".so")
 1787       objects)
 1788      (batch:rebuild-catalog parms)
 1789      (string-append
 1790       (car (parameter-list-ref parms 'implvic))
 1791       oname ".so"))))
 1792 
 1793 (defcommand compile-c-files openbsd
 1794   (lambda (files parms)
 1795     (and (batch:try-chopped-command
 1796       parms
 1797       "cc" "-c"
 1798       (include-spec "-I" parms)
 1799       (c-includes parms)
 1800       (c-flags parms)
 1801       files)
 1802      (map c->o files))))
 1803 (defcommand link-c-program openbsd
 1804   (lambda (oname objects libs parms)
 1805     (batch:rename-file parms
 1806                oname (string-append oname "~"))
 1807     (and (batch:try-command parms
 1808                 "cc" "-o" oname
 1809                 (must-be-first
 1810                  '("-nostartfiles"
 1811                    "pre-crt0.o" "crt0.o"
 1812                    "/usr/lib/crt0.o")
 1813                  (append objects libs)))
 1814      oname)))
 1815 (defcommand compile-dll-c-files openbsd
 1816   (lambda (files parms)
 1817     (and (batch:try-chopped-command
 1818       parms "cc" "-fPIC" "-c"
 1819       (include-spec "-I" parms)
 1820       (c-includes parms)
 1821       (c-flags parms)
 1822       files)
 1823      (let ((objs (map c->o files)))
 1824        (and (batch:try-command parms "gcc" "-shared" "-fPIC" objs)
 1825         (batch:try-command parms "mv" "a.out" (car objs))
 1826         (list (car objs)))))))
 1827 
 1828 (defcommand make-dll-archive openbsd
 1829   (lambda (oname objects libs parms)
 1830     (and (batch:try-command
 1831       parms
 1832       "gcc" "-shared" "-fPIC" "-o"
 1833       (string-append
 1834        (car (parameter-list-ref parms 'implvic))
 1835        oname ".so")
 1836       objects)
 1837      (batch:rebuild-catalog parms)
 1838      (string-append
 1839       (car (parameter-list-ref parms 'implvic))
 1840       oname ".so"))))
 1841 
 1842 (define-domains build
 1843   '(C-libraries C-libraries #f symbol #f))
 1844 
 1845 (define-tables build
 1846 
 1847   '(build-params
 1848     *parameter-columns*
 1849     *parameter-columns*
 1850     ((1 platform single platform
 1851     (lambda (pl) (list *operating-system*))
 1852     #f
 1853     "what to build it for")
 1854      (2 target-name single string (lambda (pl) '("scm")) #f
 1855     "base name of target")
 1856      (3 c-lib nary C-libraries (lambda (pl) '(c)) #f
 1857     "C library (and include files)")
 1858      (4 define nary string #f #f "#define FLAG")
 1859      (5 implvic single string (lambda (pl) (list ""))
 1860     #f "implementation vicinity")
 1861      (6 c-file nary filename #f #f "C source files")
 1862      (7 o-file nary filename #f #f "other object files")
 1863      (8 init nary string #f #f "initialization calls")
 1864      (9 compiled-init nary string #f #f "later initialization calls")
 1865      (10 features nary features
 1866      (lambda (pl) '(arrays inexact bignums))
 1867      (lambda (rdb) ((open-table rdb 'features) 'get 'spec))
 1868      "features to include")
 1869      (11 what single build-whats
 1870      (lambda (pl) '(exe))
 1871      (lambda (rdb)
 1872        (let* ((bwt (open-table rdb 'build-whats))
 1873           (getclass (bwt 'get 'class))
 1874           (getspec (bwt 'get 'spec))
 1875           (getfile ((open-table rdb 'manifest) 'get* 'file)))
 1876          (lambda (what)
 1877            `((c-file ,@(getfile #f 'c-source (getclass what)))
 1878          ,@(or (getspec what) '())))))
 1879      "what to build")
 1880      (12 batch-dialect single batch-dialect
 1881      (lambda (pl) '(default-for-platform)) ;;guess-how
 1882      #f
 1883      "scripting language")
 1884      (13 who optional expression #f #f "name of buildfile")
 1885      (14 compiler-options nary string #f #f "command-line compiler options")
 1886      (15 linker-options nary string #f #f "command-line linker options")
 1887 
 1888      (16 scm-srcdir single filename
 1889      (lambda (pl) (list (user-vicinity))) #f
 1890      "directory path for files in the manifest")
 1891      (17 c-defines nary expression #f #f "#defines for C")
 1892      (18 c-includes nary expression #f #f "library induced defines for C")
 1893      (19 batch-port nary expression #f #f
 1894      "port batch file will be written to.")
 1895      ;; The options file is read by a fluid-let getopt-- in "build".
 1896      ;; This is here so the usage message will include -f <filename>.
 1897      (20 options-file nary filename #f #f
 1898      "file containing more build options.")
 1899      ))
 1900   '(build-pnames
 1901     ((name string))
 1902     ((parameter-index uint))        ;should be build-params
 1903     (
 1904      ("p" 1) ("platform" 1)
 1905      ("o" 2) ("outname" 2)
 1906      ("l" 3) ("libraries" 3)
 1907      ("D" 4) ("defines" 4)
 1908      ("s" 5) ("scheme initialization file" 5)
 1909      ("c" 6) ("c source files" 6)
 1910      ("j" 7) ("object files" 7)
 1911      ("i" 9) ("initialization calls" 9)
 1912      ("F" 10) ("features" 10)
 1913      ("t" 11) ("type" 11)
 1914      ("h" 12) ("batch dialect" 12)
 1915      ("w" 13) ("script name" 13)
 1916      ("compiler options" 14)
 1917      ("linker options" 15)
 1918      ("scm srcdir" 16)
 1919      ("f" 20)
 1920      ))
 1921 
 1922   '(*commands*
 1923     ((name symbol))         ;or just desc:*commands*
 1924     ((parameters parameter-list)
 1925      (parameter-names parameter-name-translation)
 1926      (procedure expression)
 1927      (documentation string))
 1928     ((build
 1929       build-params
 1930       build-pnames
 1931       build:command
 1932       "compile and link SCM programs.")
 1933      (*initialize*
 1934       no-parameters
 1935       no-parameters
 1936       #f
 1937       "SCM Build Database"))))
 1938 
 1939 (define build:error slib:error)
 1940 (define build:c-libraries #f)
 1941 (define build:lib-cc-flag #f)
 1942 (define build:lib-ld-flag #f)
 1943 (define build:c-lib-support #f)
 1944 (define build:c-suppress #f)
 1945 (define plan-command #f)
 1946 (define platform->os #f)
 1947 
 1948 ;;; Look up command on a platform, but default to '*unknown* if not
 1949 ;;; initially found.
 1950 
 1951 (define (make-defaulting-platform-lookup getter)
 1952   (lambda (thing plat)
 1953     (define (look platform)
 1954       (let ((ans (getter thing platform)))
 1955     (cond (ans ans)
 1956           (else (let ((os (platform->os platform)))
 1957               (cond ((eq? os platform) (look '*unknown*))
 1958                 ((eq? platform '*unknown*) '())
 1959                 (else (look os))))))))
 1960     (look plat)))
 1961 
 1962 (define (build:command rdb)
 1963   (lambda (parms)
 1964     (let ((expanders
 1965        (map (lambda (e) (and e (lambda (s) (e s))))
 1966         (map (lambda (f) (if f ((slib:eval f) rdb) f))
 1967              (((open-table rdb 'build-params)
 1968                'get* 'expander))))))
 1969       (parameter-list-expand expanders parms)
 1970       (set! parms
 1971         (fill-empty-parameters
 1972          (map slib:eval
 1973           (((open-table rdb 'build-params)
 1974             'get* 'defaulter)))
 1975          parms))
 1976       (parameter-list-expand expanders parms))
 1977     (let* ((platform (car (parameter-list-ref parms 'platform)))
 1978        (init= (apply string-append
 1979              (map (lambda (c)
 1980                 (string-append c "();"))
 1981                   (parameter-list-ref parms 'init))))
 1982        (compiled-init=
 1983         (apply string-append
 1984            (map (lambda (c)
 1985               (string-append c "();"))
 1986             (parameter-list-ref parms 'compiled-init))))
 1987        (implvic (let ((impl (car (parameter-list-ref parms 'implvic))))
 1988               (if (equal? "" impl)
 1989               (car (parameter-list-ref parms 'scm-srcdir))
 1990               impl)))
 1991        (c-defines
 1992         `((define "IMPLINIT"
 1993         ,(object->string
 1994           (string-append
 1995            implvic "Init"
 1996            (read-version
 1997             (in-vicinity (car (parameter-list-ref parms 'scm-srcdir))
 1998                  "patchlvl.h"))
 1999            ".scm")))
 2000           ,@(if (string=? "" init=) '()
 2001             `((define "INITS" ,init=)))
 2002           ,@(if (string=? "" compiled-init=) '()
 2003             `((define "COMPILED_INITS" ,compiled-init=)))
 2004           ,@(map (lambda (d) (if (pair? d)
 2005                      `(define ,@d)
 2006                      `(define ,d #t)))
 2007              (parameter-list-ref parms 'define))))
 2008        (c-includes
 2009         (map (lambda (l) (build:lib-cc-flag l platform))
 2010          (parameter-list-ref parms 'c-lib)))
 2011        (what (car (parameter-list-ref parms 'what)))
 2012        (c-proc (plan-command (((open-table rdb 'build-whats)
 2013                    'get 'c-proc)
 2014                   what)
 2015                  platform)))
 2016 
 2017       (case (car (parameter-list-ref parms 'batch-dialect))
 2018     ((default-for-platform)
 2019      (let ((os (((open-table build 'platform)
 2020              'get 'operating-system) platform)))
 2021        (if (not os)
 2022            (build:error "OS corresponding to " platform " unknown"))
 2023        (adjoin-parameters!
 2024         parms (cons 'batch-dialect (list (os->batch-dialect os)))))))
 2025 
 2026       (adjoin-parameters!
 2027        parms (cons 'c-defines c-defines) (cons 'c-includes c-includes))
 2028       (set! parms
 2029         (cons
 2030          (cons 'operating-system
 2031            (map platform->os (parameter-list-ref parms 'platform)))
 2032          parms))
 2033 
 2034       (let ((name (parameter-list-ref parms 'who)))
 2035     (set! name (if (null? name) (current-output-port) (car name)))
 2036     (batch:call-with-output-script
 2037      parms
 2038      name
 2039      (lambda (batch-port)
 2040        (define o-files #f)
 2041        (adjoin-parameters! parms (list 'batch-port batch-port))
 2042        (batch:comment
 2043            parms
 2044            (string-append "[-p " (symbol->string platform) "]"))
 2045        (let ((options-file (parameter-list-ref parms 'options-file)))
 2046          (and (not (null? options-file))
 2047           (batch:comment
 2048            parms
 2049            (apply string-join " " "used options from:" options-file))))
 2050        (batch:comment parms "================ Write file with C defines")
 2051        (cond
 2052         ((not (apply batch:lines->file parms
 2053              "scmflags.h"
 2054              (defines->c-defines c-defines)))
 2055          (batch:comment parms "================ Write failed!") #f)
 2056         (else
 2057          (batch:comment parms "================ Compile C source files")
 2058          (set! o-files
 2059            (let ((suppressors
 2060               (apply append
 2061                  (map (lambda (l) (build:c-suppress l platform))
 2062                       (parameter-list-ref parms 'c-lib)))))
 2063              (c-proc
 2064               (apply
 2065                append
 2066                (remove-if (lambda (file) (member file suppressors))
 2067                   (parameter-list-ref parms 'c-file))
 2068                (map (lambda (l) (build:c-lib-support l platform))
 2069                 (parameter-list-ref parms 'c-lib)))
 2070               parms)))
 2071          (cond
 2072           ((not o-files)
 2073            (batch:comment parms "================ Compilation failed!") #f)
 2074           (else
 2075 
 2076            (batch:comment parms "================ Link C object files")
 2077            (let ((ans
 2078               ((plan-command
 2079             (((open-table rdb 'build-whats) 'get 'o-proc) what)
 2080             platform)
 2081                (car (parameter-list-ref parms 'target-name))
 2082                (append o-files (parameter-list-ref parms 'o-file))
 2083                (append
 2084             (parameter-list-ref parms 'linker-options)
 2085             (map (lambda (l) (build:lib-ld-flag l platform))
 2086                  (parameter-list-ref parms 'c-lib)))
 2087                parms)))
 2088          (cond ((not ans)
 2089             (batch:comment parms "================ Link failed!") #f)
 2090                (else ans)))))))))))))
 2091 
 2092 (define (include-spec str parms)
 2093   (let ((path (car (parameter-list-ref parms 'scm-srcdir))))
 2094     (if (eqv? "" path) () (list str path))))
 2095 (define (c-defines parms)
 2096   (parameter-list-ref parms 'c-defines))
 2097 (define (c-includes parms)
 2098   (parameter-list-ref parms 'c-includes))
 2099 (define (c-flags parms)
 2100   (parameter-list-ref parms 'compiler-options))
 2101 
 2102 (define (defines->c-defines defines)
 2103   (map
 2104    (lambda (d)
 2105      (case (caddr d)
 2106        ((#t) (string-join " " "#define" (cadr d)))
 2107        ((#f) (string-join " " "#undef" (cadr d)))
 2108        (else (apply string-join " " "#define" (cdr d)))))
 2109    defines))
 2110 
 2111 (define (defines->flags defines)
 2112   (map
 2113    (lambda (d)
 2114      (case (caddr d)
 2115        ((#t) (string-append "-D" (cadr d)))
 2116        ((#f) (string-append "-U" (cadr d)))
 2117        (else (string-append "-D" (cadr d) "=" (object->string (caddr d))))))
 2118    defines))
 2119 
 2120 (define c-> (filename:substitute?? "*.c" "*"))
 2121 (define c->o (filename:substitute?? "*.c" "*.o"))
 2122 (define c->8 (filename:substitute?? "*.c" "*.8"))
 2123 (define c->obj (filename:substitute?? "*.c" "*.obj"))
 2124 (define obj-> (filename:substitute?? "*.obj" "*"))
 2125 (define obj->exe (filename:substitute?? "*.obj" "*.exe"))
 2126 
 2127 (define (read-version revfile)
 2128   (call-with-input-file
 2129       (if (file-exists? revfile)
 2130       revfile
 2131       (in-vicinity (implementation-vicinity) "patchlvl.h"))
 2132     (lambda (port)
 2133       (do ((c (read-char port) (read-char port)))
 2134       ((or (eof-object? c) (eqv? #\= c))
 2135        (do ((c (read-char port) (read-char port))
 2136         (lst '() (cons c lst)))
 2137            ((or (eof-object? c) (char-whitespace? c))
 2138         (list->string (reverse lst)))))))))
 2139 
 2140 (define (batch:rebuild-catalog parms)
 2141   (batch:delete-file parms
 2142              (in-vicinity (car (parameter-list-ref parms 'implvic))
 2143                   "slibcat"))
 2144   #t)
 2145 
 2146 (define (logger . args)
 2147   (define cep (current-error-port))
 2148   (for-each (lambda (x) (display #\space cep) (display x cep))
 2149         (cond ((provided? 'bignum)
 2150            (require 'posix-time)
 2151            (let ((ct (ctime (current-time))))
 2152              (string-set! ct (+ -1 (string-length ct)) #\:)
 2153              (cons ct args)))
 2154           (else args)))
 2155   (newline cep))
 2156 
 2157 (define build:qacs #f)
 2158 ;@
 2159 (define (build:serve request-line query-string header)
 2160   (define query-alist (and query-string (uri:decode-query query-string)))
 2161   (if (not build:qacs)
 2162       (set! build:qacs (make-query-alist-command-server build '*commands* #t)))
 2163   (call-with-outputs
 2164    (lambda () (build:qacs query-alist))
 2165    (lambda (stdout stderr . status)
 2166      (cond ((or (substring? ": ERROR: " stderr)
 2167         (substring? ": WARN: " stderr))
 2168         => (lambda (idx)
 2169          (set! stderr (substring stderr (+ 2 idx)
 2170                      (string-length stderr))))))
 2171      (cond ((null? status)
 2172         (logger "Aborting query")
 2173         (pretty-print query-alist)
 2174         (display stderr)
 2175         (list "buildscm Abort" (html:pre stdout)
 2176           "<B>" (html:pre stderr) "</B>"))
 2177        (else
 2178         (display stderr)        ;query is already logged
 2179         (if (car status)
 2180         (http:content '(("Content-Type" . "text/plain")) ;application/x-sh
 2181                   stdout)
 2182         (list "buildscm Error" "<B>" (html:pre stderr) "</B>"
 2183               "<HR>"
 2184               (html:pre stdout))))))))
 2185 ;;; (print 'request-line '= (cgi:request-line)) (print 'header '=) (for-each print (cgi:query-header))
 2186 
 2187 (define build:initializer
 2188   (lambda (rdb)
 2189     (set! build:c-libraries
 2190       (open-table rdb 'c-libraries))
 2191     (set! build:lib-cc-flag
 2192       (make-defaulting-platform-lookup
 2193        (build:c-libraries 'get 'compiler-flags)))
 2194     (set! build:lib-ld-flag
 2195       (make-defaulting-platform-lookup
 2196        (build:c-libraries 'get 'link-lib-flag)))
 2197     (set! build:c-lib-support
 2198       (make-defaulting-platform-lookup
 2199        (build:c-libraries 'get 'lib-support)))
 2200     (set! build:c-suppress
 2201       (make-defaulting-platform-lookup
 2202        (build:c-libraries 'get 'suppress-files)))
 2203     (set! platform->os
 2204       ((open-table rdb 'platform) 'get 'operating-system))
 2205     (set! plan-command
 2206       (let ((lookup (make-defaulting-platform-lookup
 2207              ((open-table rdb 'compile-commands)
 2208               'get 'procedure))))
 2209         (lambda (thing plat)
 2210           ;;(print 'thing thing 'plat plat)
 2211           (slib:eval (lookup thing plat)))))))
 2212 (build:initializer build)