diff options
Diffstat (limited to 'build.scm')
| -rw-r--r-- | build.scm | 477 |
1 files changed, 357 insertions, 120 deletions
@@ -1,18 +1,36 @@ -;;; "build.scm" Build database and program -*-scheme-*- -;;; Copyright (C) 1994-2002 Aubrey Jaffer. -;;; See the file `COPYING' for terms applying to this program. +;; "build.scm" Build database and program -*-scheme-*- +;; Copyright (C) 1994-2003 Aubrey Jaffer. +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or (at +;; your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (require 'parameters) (require 'databases) (require 'database-commands) +(require 'alist) +(require 'common-list-functions) +(require 'object->string) +(require 'glob) +(require 'batch) +(require-if 'compiling 'posix-time) +;@ (set! OPEN_WRITE "w") ; Because MS-DOS scripts need ^M - +;@ (define build (add-command-tables (create-database #f 'alist-table))) -(require 'glob) -(require 'batch) (batch:initialize! build) -((((build 'open-table) 'batch-dialect #t) 'row:insert) +(((open-table! build 'batch-dialect) 'row:insert) '(default-for-platform 0)) ;;;; This first part is about SCM files and features. @@ -98,6 +116,7 @@ ("ramap.c" c-source optional "array mapping") ("dynl.c" c-source optional "dynamically load object files.") ("sc2.c" c-source linkable "procedures from R2RS and R3RS not in R4RS.") + ("byte.c" c-source linkable "strings as bytes.") ("rgx.c" c-source linkable "string regular expression match.") ("crs.c" c-source linkable "interactive terminal control.") ("split.scm" Scheme test "example use of crs.c. Input, output, and diagnostic output directed to separate windows.") @@ -142,14 +161,14 @@ (documentation string)) ((none () "No features")))) -(for-each (build 'add-domain) - '((optstring #f (lambda (x) (or (not x) (string? x))) string #f) - (filename #f #f string #f) - (features features #f symbol #f) - (build-whats build-whats #f symbol #f))) +(define-domains build + '(optstring #f (lambda (x) (or (not x) (string? x))) string #f) + '(filename #f #f string #f) + '(features features #f symbol #f) + '(build-whats build-whats #f symbol #f)) (define define-build-feature - (let ((defeature (((build 'open-table) 'features #t) 'row:insert))) + (let ((defeature ((open-table! build 'features) 'row:insert))) (lambda args (defeature (append args (list (comment))))))) @@ -222,7 +241,7 @@ #;array-map! and array-for-each (arrays must also be featured). (define-build-feature 'array-for-each - '((c-file "ramap.c") (init "init_ramap"))) + '((c-file "ramap.c") (compiled-init "init_ramap"))) #;Use if you want floating point numbers. (define-build-feature @@ -268,11 +287,16 @@ 'rev2-procedures '((c-file "sc2.c") (init "init_sc2"))) +#;Treating strings as byte-vectors. +(define-build-feature + 'byte + '((c-file "byte.c") (init "init_byte"))) + #;The Record package provides a facility for user to define their own #;record data types. See SLIB for documentation. (define-build-feature 'record - '((define "CCLO") (c-file "record.c") (init "init_record"))) + '((define "CCLO") (c-file "record.c") (compiled-init "init_record"))) #;Use if you want to use compiled closures. (define-build-feature @@ -282,7 +306,7 @@ #;@code{make_gsubr} for arbitrary (< 11) arguments to C functions. (define-build-feature 'generalized-c-arguments - '((c-file "gsubr.c") (init "init_gsubr"))) + '((c-file "gsubr.c") (compiled-init "init_gsubr"))) #;Use if you want the ticks and ticks-interrupt functions. (define-build-feature @@ -315,7 +339,7 @@ #;For the @dfn{curses} screen management package. (define-build-feature 'curses - '((c-file "crs.c") (c-lib curses) (init "init_crs"))) + '((c-file "crs.c") (c-lib curses) (compiled-init "init_crs"))) #;interface to the editline or GNU readline library. (define-build-feature @@ -330,25 +354,25 @@ #;String regular expression matching. (define-build-feature 'regex - '((c-file "rgx.c") (c-lib regex) (init "init_rgx"))) + '((c-file "rgx.c") (c-lib regex) (compiled-init "init_rgx"))) #;BSD @dfn{socket} interface. (define-build-feature 'socket - '((c-lib socket) (c-file "socket.c") (init "init_socket"))) + '((c-lib socket) (c-file "socket.c") (compiled-init "init_socket"))) #;Posix functions available on all @dfn{Unix-like} systems. fork and #;process functions, user and group IDs, file permissions, and #;@dfn{link}. (define-build-feature 'posix - '((c-file "posix.c") (init "init_posix"))) + '((c-file "posix.c") (compiled-init "init_posix"))) #;Those unix features which have not made it into the Posix specs: #;nice, acct, lstat, readlink, symlink, mknod and sync. (define-build-feature 'unix - '((c-file "unix.c") (init "init_unix"))) + '((c-file "unix.c") (compiled-init "init_unix"))) #;Microsoft Windows executable. (define-build-feature @@ -396,15 +420,15 @@ (define-tables build '(processor-family - ((family atom)) + ((family symbol)) ((also-runs processor-family)) ((*unknown* #f) - (8086 #f) + (i8086 #f) (acorn #f) (alpha #f) (cray #f) (hp-risc #f) - (i386 8086) + (i386 i8086) (m68000 #f) (m68030 m68000) (mips #f) @@ -430,7 +454,7 @@ ((*unknown* *unknown* unix cc ) ;ld (acorn-unixlib acorn *unknown* cc ) ;link (aix powerpc aix cc ) ;cc - (alpha alpha osf1 cc ) ;cc + (osf1 alpha unix cc ) ;cc (alpha-elf alpha unix cc ) ;cc (alpha-linux alpha linux gcc ) ;gcc (amiga-aztec m68000 amiga cc ) ;cc @@ -439,8 +463,8 @@ (amiga-sas m68000 amiga lc ) ;link (atari-st-gcc m68000 atari.st gcc ) ;gcc (atari-st-turbo-c m68000 atari.st tcc ) ;tlink - (borland-c 8086 ms-dos bcc ) ;bcc - (cygwin32 i386 unix gcc ) ;gcc + (borland-c i8086 ms-dos bcc ) ;bcc + (gnu-win32 i386 unix gcc ) ;gcc (djgpp i386 ms-dos gcc ) ;gcc (freebsd i386 unix cc ) ;cc (gcc *unknown* unix gcc ) ;gcc @@ -450,10 +474,11 @@ (linux i386 linux gcc ) ;gcc (linux-aout i386 linux gcc ) ;gcc (darwin powerpc unix cc ) ;gcc - (microsoft-c 8086 ms-dos cl ) ;link + (microsoft-c i8086 ms-dos cl ) ;link (microsoft-c-nt i386 ms-dos cl ) ;link - (microsoft-quick-c 8086 ms-dos qcl ) ;qlink - (ms-dos 8086 ms-dos cc ) ;link + (microsoft-quick-c i8086 ms-dos qcl ) ;qlink + (ms-dos i8086 ms-dos cc ) ;link + (netbsd *unknown* unix gcc ) ;gcc (openbsd *unknown* unix gcc ) ;gcc (os/2-cset i386 os/2 icc ) ;link386 (os/2-emx i386 os/2 gcc ) ;gcc @@ -461,7 +486,7 @@ (svr4-gcc-sun-ld sparc sunos gcc ) ;ld (sunos sparc sunos cc ) ;ld (svr4 *unknown* unix cc ) ;ld - (turbo-c 8086 ms-dos tcc ) ;tcc + (turbo-c i8086 ms-dos tcc ) ;tcc (unicos cray unicos cc ) ;cc (unix *unknown* unix cc ) ;cc (vms vax vms cc ) ;link @@ -492,8 +517,9 @@ (mysql *unknown* "-I/usr/include/mysql" "-L/usr/lib/mysql -lmysqlclient" "/usr/lib/mysql/libmysqlclient.a" () ()) - (m cygwin32 "" "" "" () ()) - (c cygwin32 "" "" "" () ()) + (m gnu-win32 "" "" "" () ()) + (c gnu-win32 "" "" "" () ()) + (dlll gnu-win32 "-DSCM_DLL" "" #f () ("posix.c" "unix.c" "socket.c")) (m linux-aout "" "-lm" "/usr/lib/libm.sa" () ()) (c linux-aout "" "-lc" "/usr/lib/libc.sa" () ()) (dlll linux-aout "-DDLD -DDLD_DYNCM" "-ldld" #f () ("findexec.c")) @@ -506,6 +532,7 @@ (m linux "" "-lm" "/lib/libm.so" () ()) (c linux "" "-lc" "/lib/libc.so" () ()) (dlll linux "-DSUN_DL" "-ldl" #f () ()) + (regex linux "" "" "" () ()) (graphics linux "-I/usr/include/X11 -DX11" "-L/usr/X11R6/lib -lX11" "/usr/X11R6/lib/libX11.so" () ()) (curses linux "" "-lcurses" "/lib/libncurses.so" () ()) @@ -516,8 +543,12 @@ (m acorn-unixlib "" "" #f () ()) - (nostart alpha "" "-non_shared" #f ("pre-crt0.c") ()) - (dump alpha "" "" #f ("unexalpha.c") ()) + (nostart osf1 "" "" #f ("pre-crt0.c") ()) + (dlll osf1 "-DSUN_DL" "" #f () ()) + (dump osf1 "" "" #f ("unexalpha.c" "gmalloc.c") ()) + (regex osf1 "" "" #f () ()) + (graphics osf1 "-I/usr/include/X11 -DX11" "-lX11" + #f () ()) (m amiga-dice-c "" "-lm" #f () ()) (m amiga-sas "" "lcmieee.lib" #f () ()) @@ -564,13 +595,14 @@ ;;; (nostart djgpp "" "-e __start -nostartfiles -static" #f ("ecrt0.c") ()) ;;; (dump djgpp "" "" #f ("unexelf.c" "gmalloc.c") ()) - (c Microsoft-C "" "" #f () ("findexec.c")) - (m Microsoft-C "" "" #f () ()) - (c Microsoft-C-nt "" "" #f () ("findexec.c")) - (m Microsoft-C-nt "" "" #f () ()) - (debug Microsoft-C-nt "-Zi" "/debug" #f () ()) - (c Microsoft-Quick-C "" "" #f () ("findexec.c")) - (m Microsoft-Quick-C "" "" #f () ()) + (c microsoft-c "" "" #f () ("findexec.c")) + (m microsoft-c "" "" #f () ()) + (c microsoft-c-nt "" "" #f () ("findexec.c")) + (m microsoft-c-nt "" "" #f () ()) + (dlll microsoft-c-nt "-DSCM_DLL -MD" "" #f () ("posix.c" "unix.c" "socket.c")) + (debug microsoft-c-nt "-Zi" "/debug" #f () ()) + (c microsoft-quick-c "" "" #f () ("findexec.c")) + (m microsoft-quick-c "" "" #f () ()) (c turbo-c "" "" #f () ("findexec.c")) (m turbo-c "" "" #f () ()) @@ -590,13 +622,18 @@ (curses darwin "" "" #f () ()) (regex darwin "" "" #f () ()) + (c freebsd "" "-export-dynamic" #f () ()) (m freebsd "" "-lm" #f () ()) (curses freebsd "" "-lncurses" "/usr/lib/libncurses.a" () ()) (regex freebsd "" "-lgnuregex" "" () ()) (editline freebsd "" "-lreadline" "" () ()) - (dlll freebsd "-DSUN_DL" "" "" () ()) + (dlll freebsd "-DSUN_DL" "-export-dynamic" "" () ()) (nostart freebsd "" "-e start -dc -dp -Bstatic -lgnumalloc" #f ("pre-crt0.c") ()) (dump freebsd "" "/usr/lib/crt0.o" "" ("unexsunos4.c") ()) + (curses netbsd "-I/usr/pkg/include" "-lncurses" "-Wl,-rpath -Wl,/usr/pkg/lib -L/usr/pkg/lib" () ()) + (editline netbsd "-I/usr/pkg/include" "-lreadline" "-Wl,-rpath -Wl,/usr/pkg/lib -L/usr/pkg/lib" () ()) + (graphics netbsd "-I/usr/X11R6/include -DX11" "-lX11" "-Wl,-rpath -Wl,/usr/X11R6/lib -L/usr/X11R6/lib" () ()) + (m netbsd "" "-lm" #f () ()) (m openbsd "" "-lm" #f () ()) (curses openbsd "" "-lcurses" "/usr/lib/libcurses.a" () ()) )) @@ -612,7 +649,7 @@ objects)))))) (define define-compile-commands - (let ((defcomms (((build 'open-table) 'compile-commands #t) 'row:insert))) + (let ((defcomms ((open-table! build 'compile-commands) 'row:insert))) (lambda args (defcomms args)))) ;(append args (list (comment))) (defmacro defcommand (name platform procedure) @@ -624,7 +661,7 @@ (apply batch:lines->file parms rsp-name files) (and (batch:try-command parms - "bcc" "-d" "-O" "-Z" "-G" "-w-pro" "-ml" "-c" + "bcc" "-d" "-Z" "-G" "-w-pro" "-ml" "-c" (if (member '(define "FLOATS" #t) (c-defines parms)) "" "-f-") @@ -648,7 +685,7 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "tcc" "-c" "-d" "-O" "-Z" "-G" "-ml" "-c" + "tcc" "-c" "-d" "-Z" "-G" "-ml" "-c" "-Ic:\\turboc\\include" (include-spec "-I" parms) (c-includes parms) @@ -667,7 +704,7 @@ (batch:rename-file parms exe oexe)) oexe)))) -(defcommand compile-c-files Microsoft-C +(defcommand compile-c-files microsoft-c (lambda (files parms) (and (batch:try-chopped-command parms "cl" "-c" "Oxp" "-AH" @@ -676,7 +713,7 @@ (c-flags parms) files) (truncate-up-to (map c->obj files) #\\)))) -(defcommand link-c-program Microsoft-C +(defcommand link-c-program microsoft-c (lambda (oname objects libs parms) (let ((exe (truncate-up-to (obj->exe (car objects)) #\\)) (oexe (string-append oname ".exe"))) @@ -689,7 +726,8 @@ (or (string-ci=? exe oexe) (batch:rename-file parms exe oexe)) oexe)))) -(defcommand compile-c-files Microsoft-C-nt + +(defcommand compile-c-files microsoft-c-nt (lambda (files parms) (and (batch:try-chopped-command parms @@ -701,7 +739,47 @@ (c-flags parms) files) (truncate-up-to (map c->obj files) #\\)))) -(defcommand link-c-program Microsoft-C-nt +(defcommand compile-dll-c-files microsoft-c-nt + (lambda (files parms) + (define platform (car (parameter-list-ref parms 'platform))) + (let ((suppressors (build:c-suppress 'dlll platform))) + (define c-files (remove-if (lambda (file) (member file suppressors)) + files)) + (and (batch:try-chopped-command + parms + "cl" "-c" "-nologo" + (if (memq 'stack-limit (parameter-list-ref parms 'features)) + "-Oityb1" "-Ox") + (include-spec "-I" parms) + (c-includes parms) + (c-flags parms) + c-files) + (let ((results + (map + (lambda (fname) + (and (batch:try-command + parms "link" "/dll" "/nologo" + (string-append "/out:" fname ".dll") + (string-append "/implib:" fname ".lib") + fname + (map (lambda (l) (build:lib-ld-flag l platform)) + (parameter-list-ref parms 'c-lib)) + "scm.lib") + (string-append fname ".dll"))) + (map c-> c-files)))) + (and (apply and? results) results)))))) +(defcommand make-dll-archive microsoft-c-nt + (lambda (oname objects libs parms) objects)) +(defcommand make-archive microsoft-c-nt + (lambda (oname objects libs parms) + (let ((aname (string-append oname ".dll"))) + (and (batch:try-command parms + "link" "/dll" "/nologo" + (string-append "/out:" aname) + (string-append "/implib:" oname ".lib") + libs (map obj-> objects)) + aname)))) +(defcommand link-c-program microsoft-c-nt (lambda (oname objects libs parms) (let ((exe (truncate-up-to (obj->exe (car objects)) #\\)) (oexe (string-append oname ".exe"))) @@ -712,7 +790,7 @@ libs) oexe)))) -(defcommand compile-c-files Microsoft-Quick-C +(defcommand compile-c-files microsoft-quick-c (lambda (files parms) (and (batch:try-chopped-command parms @@ -721,7 +799,7 @@ (c-flags parms) files) (truncate-up-to (map c->obj files) #\\)))) -(defcommand link-c-program Microsoft-Quick-C +(defcommand link-c-program microsoft-quick-c (lambda (oname objects libs parms) (define crf-name (string-append oname ".crf")) (apply batch:lines->file parms @@ -738,7 +816,7 @@ crf-name) (string-append oname ".exe")))) -(defcommand compile-c-files Watcom-9.0 +(defcommand compile-c-files watcom-9.0 (lambda (files parms) (and (batch:try-chopped-command parms @@ -748,7 +826,7 @@ (c-flags parms) files) (truncate-up-to (map c->obj files) #\\)))) -(defcommand link-c-program Watcom-9.0 +(defcommand link-c-program watcom-9.0 (lambda (oname objects libs parms) (let ((exe (truncate-up-to (obj->exe (car objects)) #\\)) (oexe (string-append oname ".exe"))) @@ -796,7 +874,7 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-Wall" "-O2" "-c" + "gcc" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) @@ -835,7 +913,7 @@ (defcommand compile-c-files os/2-emx (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-O" "-m386" "-c" + "gcc" "-m386" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -905,7 +983,7 @@ (defcommand compile-c-files linux-aout (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-Wall" "-O2" "-c" + "gcc" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -915,7 +993,7 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-Wall" "-O2" "-c" + "gcc" "-c" (c-includes parms) (c-flags parms) files) @@ -929,7 +1007,7 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-O2" + "gcc" ;;(if (member "-g" (c-includes parms)) "" "-O2") "-c" (c-includes parms) (include-spec "-I" parms) @@ -941,8 +1019,7 @@ (and (batch:try-chopped-command parms - "gcc" "-O2" - "-fpic" "-c" (c-includes parms) + "gcc" "-fpic" "-c" (c-includes parms) (c-flags parms) files) (let* ((platform (car (parameter-list-ref parms 'platform))) @@ -1036,7 +1113,7 @@ (defcommand compile-c-files gcc (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-O2" "-c" ; "-Wall" + "gcc" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1057,7 +1134,7 @@ (defcommand compile-dll-c-files gcc (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-O" "-c" + "gcc" "-c" (c-includes parms) (c-flags parms) files) @@ -1076,16 +1153,56 @@ (car (parameter-list-ref parms 'implvic)) oname ".so.1.0")))) -(defcommand compile-c-files cygwin32 +(defcommand compile-dll-c-files gnu-win32 + (lambda (files parms) + (define platform (car (parameter-list-ref parms 'platform))) + (let ((suppressors (build:c-suppress 'dlll platform))) + (define c-files (remove-if (lambda (file) (member file suppressors)) + files)) + (and (batch:try-chopped-command + parms + "gcc" "-c" + (include-spec "-I" parms) + (c-includes parms) + (c-flags parms) + c-files) + (let ((results + (map + (lambda (fname) + (and (batch:try-command + parms "dllwrap" + "--output-lib" (string-append fname ".lib") + "-dllname" (string-append fname ".dll") + "--output-def" (string-append fname ".def") + (string-append fname ".o") + (map (lambda (l) (build:lib-ld-flag l platform)) + (parameter-list-ref parms 'c-lib)) + "scm.lib") + (string-append fname ".dll"))) + (map c-> c-files)))) + (and (apply and? results) results)))))) +(defcommand make-dll-archive gnu-win32 + (lambda (oname objects libs parms) objects)) +(defcommand make-archive gnu-win32 + (lambda (oname objects libs parms) + (let ((aname (string-append oname ".dll"))) + (and (batch:try-command parms + "dllwrap" + "--output-lib" (string-append oname ".lib") + "-dllname" aname + "--output-def" (string-append oname ".def") + libs objects) + aname)))) +(defcommand compile-c-files gnu-win32 (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-Wall" "-O2" "-c" + "gcc" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) (truncate-up-to (map c->o files) #\/)))) -(defcommand link-c-program cygwin32 +(defcommand link-c-program gnu-win32 (lambda (oname objects libs parms) (batch:rename-file parms (string-append oname ".exe") @@ -1099,10 +1216,62 @@ (append objects libs))) oname))) +(defcommand compile-c-files osf1 + (lambda (files parms) + (and (batch:try-chopped-command + parms + "cc" "-std1" + ;;(if (member "-g" (c-includes parms)) "" "-O") + "-c" (c-includes parms) + (include-spec "-I" parms) + (c-flags parms) + files) + (truncate-up-to (map c->o files) #\/)))) +(defcommand compile-dll-c-files osf1 + (lambda (files parms) + (and + (batch:try-chopped-command + parms "cc" "-std1" "-c" (c-includes parms) (c-flags parms) files) + (let* ((platform (car (parameter-list-ref parms 'platform))) + (ld-opts + (map (lambda (l) (build:lib-ld-flag l platform)) + (parameter-list-ref parms 'c-lib))) + (results + (map + (lambda (fname) + (and (batch:try-command + parms + "cc" "-shared" "-o" + (string-append fname ".so") + (string-append fname ".o") + ld-opts) + (batch:delete-file + parms (string-append fname ".o")) + (string-append fname ".so"))) + (truncate-up-to (map c-> files) #\/)))) + (and (apply and? results) results))))) +(defcommand make-dll-archive osf1 + (lambda (oname objects libs parms) + (let ((platform (car (parameter-list-ref + parms 'platform)))) + (and (batch:try-command + parms + "cc" "-shared" "-o" + (string-append + (car (parameter-list-ref parms 'implvic)) + oname ".so") + objects + (map (lambda (l) (build:lib-ld-flag l platform)) + (parameter-list-ref parms 'c-lib))) + (batch:rebuild-catalog parms) + (string-append + (car (parameter-list-ref parms 'implvic)) + oname ".so"))))) + (defcommand compile-c-files svr4-gcc-sun-ld (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-O2" "-c" ; "-Wall" + "gcc" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1125,7 +1294,7 @@ (and (batch:try-chopped-command parms - "gcc" "-O2" + "gcc" "-fpic" "-c" (c-includes parms) (c-flags parms) files) @@ -1151,7 +1320,7 @@ (defcommand compile-c-files svr4 (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-O" "-DSVR4" "-c" + "cc" "-DSVR4" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1161,7 +1330,7 @@ (defcommand compile-c-files aix (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-O" "-Dunix" "-c" + "cc" "-Dunix" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1192,7 +1361,7 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "lc" "-d3" "-M" "-fi" "-O" + "lc" "-d3" "-M" "-fi" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1239,7 +1408,7 @@ (defcommand compile-c-files amiga-gcc (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-Wall" "-O2" "-c" + "gcc" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1261,7 +1430,7 @@ (defcommand compile-c-files atari-st-gcc (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-v" "-O" "-c" + "gcc" "-v" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1372,7 +1541,7 @@ (lambda (files parms) (batch:try-chopped-command parms - "cc" "-O" "-c" + "cc" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1399,7 +1568,7 @@ (defcommand compile-dll-c-files *unknown* (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-O" "-c" + "cc" "-c" (c-includes parms) (c-flags parms) files) @@ -1419,7 +1588,7 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-O" "-c" + "cc" "-O3 -pipe " "-c" (c-includes parms) (c-flags parms) files) @@ -1440,27 +1609,33 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-O" "-fpic" "-c" - (string-append - "-I" (parameter-list-ref parms 'scm-srcdir)) - (c-includes parms) + "cc" "-O3 -pipe " + "-fPIC" "-c" (c-includes parms) (c-flags parms) files) - (let ((objs (map c->o files))) - (every - (lambda (f) - (and (batch:try-command - parms "ld" "-Bshareable" f) - (batch:try-command - parms "mv" "a.out" f))) - objs) - objs)))) - + (let ((results + (map + (lambda (fname) + (and (batch:try-command + parms + "cc" "-shared" + (cond + ((equal? fname "edline") "-lreadline") + ((equal? fname "x") "-L/usr/X11R6/lib -lSM -lICE -lXext -lX11 -lxpg4") + (else "")) + "-o" + (string-append fname ".so") + (string-append fname ".o")) + (batch:delete-file + parms (string-append fname ".o")) + (string-append fname ".so"))) + (truncate-up-to (map c-> files) #\/)))) + (and (apply and? results) results))))) (defcommand make-dll-archive freebsd (lambda (oname objects libs parms) (and (batch:try-command parms - "ld" "-Bshareable" "-o" + "cc" "-shared" "-o" (string-append (car (parameter-list-ref parms 'implvic)) oname ".so") @@ -1488,11 +1663,66 @@ (append objects libs)) oname))) +(defcommand compile-c-files netbsd + (lambda (files parms) + (and (batch:try-chopped-command + parms + "cc" "-c" + (c-includes parms) + (c-flags parms) + files) + (map c->o files)))) +(defcommand link-c-program netbsd + (lambda (oname objects libs parms) + (batch:rename-file parms + oname (string-append oname "~")) + (and (batch:try-command parms + "cc" "-o" oname + (must-be-first + '("-nostartfiles" + "pre-crt0.o" "crt0.o" + "/usr/lib/crt0.o") + (append libs objects))) + oname))) +(defcommand compile-dll-c-files netbsd + (lambda (files parms) + (and (batch:try-chopped-command + parms + "cc" "-fPIC" "-c" + (string-append + "-I" (parameter-list-ref parms 'scm-srcdir)) + (c-includes parms) + (c-flags parms) + files) + (let ((objs (map c->o files))) + (every + (lambda (f) + (and (batch:try-command + parms "gcc" "-shared" "-fPIC" f) + (batch:try-command + parms "mv" "a.out" f))) + objs) + objs)))) + +(defcommand make-dll-archive netbsd + (lambda (oname objects libs parms) + (and (batch:try-command + parms + "gcc" "-shared" "-fPIC" "-o" + (string-append + (car (parameter-list-ref parms 'implvic)) + oname ".so") + objects) + (batch:rebuild-catalog parms) + (string-append + (car (parameter-list-ref parms 'implvic)) + oname ".so")))) + (defcommand compile-c-files openbsd (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-O2" "-Wall" "-c" + "cc" "-c" (c-includes parms) (c-flags parms) files) @@ -1513,7 +1743,7 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-O2" "-Wall" "-fPIC" "-c" + "cc" "-fPIC" "-c" (string-append "-I" (parameter-list-ref parms 'scm-srcdir)) (c-includes parms) @@ -1543,8 +1773,8 @@ (car (parameter-list-ref parms 'implvic)) oname ".so")))) -(for-each (build 'add-domain) - '((C-libraries C-libraries #f symbol #f))) +(define-domains build + '(C-libraries C-libraries #f symbol #f)) (define-tables build @@ -1568,15 +1798,15 @@ (9 compiled-init nary string #f #f "later initialization calls") (10 features nary features (lambda (pl) '(arrays inexact bignums)) - (lambda (rdb) (((rdb 'open-table) 'features #f) 'get 'spec)) + (lambda (rdb) ((open-table rdb 'features) 'get 'spec)) "features to include") (11 what single build-whats (lambda (pl) '(exe)) (lambda (rdb) - (let* ((bwt ((rdb 'open-table) 'build-whats #f)) + (let* ((bwt (open-table rdb 'build-whats)) (getclass (bwt 'get 'class)) (getspec (bwt 'get 'spec)) - (getfile (((rdb 'open-table) 'manifest #f) 'get* 'file))) + (getfile ((open-table rdb 'manifest) 'get* 'file))) (lambda (what) `((c-file ,@(getfile #f 'c-source (getclass what))) ,@(or (getspec what) '()))))) @@ -1596,6 +1826,10 @@ (18 c-includes nary expression #f #f "library induced defines for C") (19 batch-port nary expression #f #f "port batch file will be written to.") + ;; The options file is read by a fluid-let getopt-- in "build". + ;; This is here so the usage message will include -f <filename>. + (20 options-file nary filename #f #f + "file containing more build options.") )) '(build-pnames ((name string)) @@ -1616,6 +1850,7 @@ ("compiler options" 14) ("linker options" 15) ("scm srcdir" 16) + ("f" 20) )) '(*commands* @@ -1627,7 +1862,7 @@ ((build build-params build-pnames - build:build + build:command "compile and link SCM programs.") (*initialize* no-parameters @@ -1658,22 +1893,18 @@ (else (look '*unknown*))))) (look plat))) -(require 'alist) -(require 'common-list-functions) -(require 'object->string) - -(define (build:build rdb) +(define (build:command rdb) (lambda (parms) (let ((expanders (map (lambda (e) (and e (lambda (s) (e s)))) (map (lambda (f) (if f ((slib:eval f) rdb) f)) - ((((rdb 'open-table) 'build-params #f) + (((open-table rdb 'build-params) 'get* 'expander)))))) (parameter-list-expand expanders parms) (set! parms (fill-empty-parameters (map slib:eval - ((((rdb 'open-table) 'build-params #f) + (((open-table rdb 'build-params) 'get* 'defaulter))) parms)) (parameter-list-expand expanders parms)) @@ -1713,14 +1944,14 @@ (map (lambda (l) (build:lib-cc-flag l platform)) (parameter-list-ref parms 'c-lib))) (what (car (parameter-list-ref parms 'what))) - (c-proc (plan-command ((((rdb 'open-table) 'build-whats #f) + (c-proc (plan-command (((open-table rdb 'build-whats) 'get 'c-proc) what) platform))) (case (car (parameter-list-ref parms 'batch-dialect)) ((default-for-platform) - (let ((os ((((build 'open-table) 'platform #f) + (let ((os (((open-table build 'platform) 'get 'operating-system) platform))) (if (not os) (build:error "OS corresponding to " platform " unknown")) @@ -1736,7 +1967,7 @@ (cons 'operating-system (map platform->os (parameter-list-ref parms 'platform))) parms)) - + (let ((name (parameter-list-ref parms 'who))) (set! name (if (null? name) (current-output-port) (car name))) (batch:call-with-output-script @@ -1748,6 +1979,11 @@ parms (list 'batch-port batch-port)) + (let ((options-file (parameter-list-ref parms 'options-file))) + (and (not (null? options-file)) + (batch:comment + parms + (apply string-join " " "used options from:" options-file)))) (batch:comment parms "================ Write file with C defines") (cond ((not (apply batch:lines->file parms @@ -1780,7 +2016,7 @@ (batch:comment parms "================ Link C object files") (let ((ans ((plan-command - ((((rdb 'open-table) 'build-whats #f) 'get 'o-proc) what) + (((open-table rdb 'build-whats) 'get 'o-proc) what) platform) (car (parameter-list-ref parms 'target-name)) (append o-files (parameter-list-ref parms 'o-file)) @@ -1849,16 +2085,17 @@ (define (logger . args) (define cep (current-error-port)) - (cond ((provided? 'bignum) - (require 'posix-time) - (let ((ct (ctime (current-time)))) - (string-set! ct (+ -1 (string-length ct)) #\:) - (for-each (lambda (x) (display x cep)) - (cons ct (cons #\ args))))) - (else (for-each (lambda (x) (display x cep)) args))) + (for-each (lambda (x) (display #\ cep) (display x cep)) + (cond ((provided? 'bignum) + (require 'posix-time) + (let ((ct (ctime (current-time)))) + (string-set! ct (+ -1 (string-length ct)) #\:) + (cons ct args))) + (else args))) (newline cep)) (define build:qacs #f) +;@ (define (build:serve request-line query-string header) (define query-alist (and query-string (uri:decode-query query-string))) (if (not build:qacs) @@ -1889,7 +2126,7 @@ (define build:initializer (lambda (rdb) - (set! build:c-libraries ((rdb 'open-table) 'c-libraries #f)) + (set! build:c-libraries (open-table rdb 'c-libraries)) (set! build:lib-cc-flag (make-defaulting-platform-lookup (build:c-libraries 'get 'compiler-flags))) @@ -1902,11 +2139,11 @@ (set! build:c-suppress (make-defaulting-platform-lookup (build:c-libraries 'get 'suppress-files))) - (set! platform->os (((rdb 'open-table) 'platform #f) + (set! platform->os ((open-table rdb 'platform) 'get 'operating-system)) (set! plan-command (let ((lookup (make-defaulting-platform-lookup - (((rdb 'open-table) 'compile-commands #f) + ((open-table rdb 'compile-commands) 'get 'procedure)))) (lambda (thing plat) ;;(print 'thing thing 'plat plat) |