diff options
Diffstat (limited to 'build.scm')
| -rw-r--r-- | build.scm | 303 |
1 files changed, 247 insertions, 56 deletions
@@ -1,13 +1,13 @@ ;;; "build.scm" Build database and program -*-scheme-*- -;;; Copyright (C) 1994-1999 Aubrey Jaffer. +;;; Copyright (C) 1994-2002 Aubrey Jaffer. ;;; See the file `COPYING' for terms applying to this program. (require 'parameters) -(require 'database-utilities) +(require 'databases) +(require 'database-commands) (set! OPEN_WRITE "w") ; Because MS-DOS scripts need ^M -;;;(define build (create-database "buildscm.scm" 'alist-table)) -(define build (create-database #f 'alist-table)) +(define build (add-command-tables (create-database #f 'alist-table))) (require 'glob) (require 'batch) @@ -73,7 +73,8 @@ ("setjump.s" Cray-asm platform-specific "provides setjump and longjump for the Cray YMP.") ("Init.scm" Scheme required "Scheme initialization.") ("Transcen.scm" Scheme required "inexact builtin procedures.") - ("Link.scm" Scheme required "compiles and dynamically links.") + ("Link.scm" Scheme required "Dynamic link/loading.") + ("compile.scm" Scheme required "Hobbit compilation to C.") ("Macro.scm" Scheme required "Supports Syntax-Rules Macros.") ("scmfig.h" c-header required "contains system dependent definitions.") ("patchlvl.h" c-header required "patchlevel of this release.") @@ -91,6 +92,7 @@ ("eval.c" c-source required "evaluator, apply, map, and foreach.") ("sys.c" c-source required "call-with-current-continuation, opening and closing files, storage allocation and garbage collection.") ("subr.c" c-source required "the rest of IEEE functions.") + ("debug.c" c-source required "debugging, printing code.") ("unif.c" c-source required "uniform vectors.") ("rope.c" c-source required "C interface functions.") ("ramap.c" c-source optional "array mapping") @@ -215,7 +217,7 @@ #;Alias for ARRAYS (define-build-feature 'array - '((define "ARRAYS"))) + '((features arrays))) #;array-map! and array-for-each (arrays must also be featured). (define-build-feature @@ -298,7 +300,7 @@ (define-build-feature 'turtlegr '((c-file "turtlegr.c") (c-lib graphics) (features inexact) - (init "init_turtlegr"))) + (compiled-init "init_turtlegr"))) #;Interface to Xlib graphics routines. (define-build-feature @@ -318,12 +320,12 @@ #;interface to the editline or GNU readline library. (define-build-feature 'edit-line - '((c-file "edline.c") (c-lib terminfo editline) (compiled-init "init_edline"))) + '((c-file "edline.c") (c-lib termcap editline) (compiled-init "init_edline"))) #;Client connections to the mysql databases. (define-build-feature 'mysql - '((c-file "database.c") (c-lib mysql) (init "init_database"))) + '((c-file "database.c") (c-lib mysql) (compiled-init "init_database"))) #;String regular expression matching. (define-build-feature @@ -447,12 +449,15 @@ (irix mips irix gcc ) ;gcc (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-nt i386 ms-dos cl ) ;link (microsoft-quick-c 8086 ms-dos qcl ) ;qlink (ms-dos 8086 ms-dos cc ) ;link + (openbsd *unknown* unix gcc ) ;gcc (os/2-cset i386 os/2 icc ) ;link386 (os/2-emx i386 os/2 gcc ) ;gcc +;; (plan9-8 i386 plan9 8c ) ;8l (svr4-gcc-sun-ld sparc sunos gcc ) ;ld (sunos sparc sunos cc ) ;ld (svr4 *unknown* unix cc ) ;ld @@ -475,18 +480,19 @@ ((m *unknown* "" "-lm" "/usr/lib/libm.a" () ()) (c *unknown* "" "-lc" "/usr/lib/libc.a" () ()) - (regex *unknown* "" "-lrx" "/usr/lib/librx.a" () ()) + (regex *unknown* "" "-lregex" "/usr/lib/libregex.a" () ()) (curses *unknown* "" "-lcurses" "/usr/lib/libcurses.a" () ()) (graphics *unknown* "-I/usr/X11/include -DX11" "-lX11" "/usr/X11/lib/libX11.sa" () ()) (editline *unknown* "" "-lreadline" "/usr/lib/libreadline.a" () ()) - (termcap *unknown* "" "-lncurses" "/usr/lib/libncurses.a" () ()) + (termcap *unknown* "" "-ltermcap" "/usr/lib/libtermcap.a" () ()) (debug *unknown* "-g" "-g" #f () ()) (socket *unknown* "" "" #f () ()) (lib *unknown* "" "" #f () ("scmmain.c")) - (mysql *unknown* "" - "-lmysqlclient" "/usr/lib/mysql/libmysqlclient.la" () ()) + (mysql *unknown* "-I/usr/include/mysql" "-L/usr/lib/mysql -lmysqlclient" + "/usr/lib/mysql/libmysqlclient.a" () ()) + (m cygwin32 "" "" "" () ()) (c cygwin32 "" "" "" () ()) (m linux-aout "" "-lm" "/usr/lib/libm.sa" () ()) (c linux-aout "" "-lc" "/usr/lib/libc.sa" () ()) @@ -499,10 +505,12 @@ (m linux "" "-lm" "/lib/libm.so" () ()) (c linux "" "-lc" "/lib/libc.so" () ()) + (regex linux "" "" "" () ()) + (termcap linux "" "-lncurses" "/usr/lib/libncurses.a" () ()) (dlll linux "-DSUN_DL" "-ldl" #f () ()) (graphics linux "-I/usr/include/X11 -DX11" "-L/usr/X11R6/lib -lX11" "/usr/X11R6/lib/libX11.so" () ()) - (curses linux "" "-lcurses" "/lib/libncurses.so" () ()) + (curses linux "" "-lncurses" "/usr/lib/libncurses.so" () ()) (nostart linux "" "" #f () ()) (dump linux "" "" #f ("unexelf.c" "gmalloc.c") ()) @@ -523,13 +531,16 @@ (m atari-st-gcc "" "-lpml" #f () ()) (m atari-st-turbo-c "" "" #f () ()) +;; (c plan9-8 "" "" #f () ()) +;; (m plan9-8 "" "" #f () ()) + (m sunos "" "-lm" #f () ()) (dlll sunos "-DSUN_DL" "-ldl" #f () ()) (nostart sunos "" "-e __start -nostartfiles -static" #f ("ecrt0.c") ()) (dump sunos "" "" #f ("unexelf.c" "gmalloc.c") ()) (m svr4-gcc-sun-ld "" "-lm" #f () ()) - (dlll svr4-gcc-sun-ld "-DSUN_DL" "-Wl,-ldl" #f () ()) + (dlll svr4-gcc-sun-ld "-DSUN_DL" "-Wl,-ldl -export-dynamic" #f () ()) (nostart svr4-gcc-sun-ld "" "-e __start -nostartfiles" #f ("ecrt0.c") ()) (dump svr4-gcc-sun-ld "" "" #f ("unexelf.c" "gmalloc.c") ()) (socket svr4-gcc-sun-ld "" "-lsocket -lnsl" #f () ()) @@ -559,6 +570,7 @@ (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 () ()) @@ -575,12 +587,20 @@ (m highc "" "" #f () ()) (windows highc "-Hwin" "-Hwin" #f () ()) + (m darwin "" "" #f () ()) + (c darwin "" "" #f () ()) + (curses darwin "" "" #f () ()) + (regex darwin "" "" #f () ()) + (m freebsd "" "-lm" #f () ()) + (curses freebsd "" "-lncurses" "/usr/lib/libncurses.a" () ()) (regex freebsd "" "-lgnuregex" "" () ()) (editline freebsd "" "-lreadline" "" () ()) (dlll freebsd "-DSUN_DL" "" "" () ()) (nostart freebsd "" "-e start -dc -dp -Bstatic -lgnumalloc" #f ("pre-crt0.c") ()) (dump freebsd "" "/usr/lib/crt0.o" "" ("unexsunos4.c") ()) + (m openbsd "" "-lm" #f () ()) + (curses openbsd "" "-lcurses" "/usr/lib/libcurses.a" () ()) )) '(compile-commands @@ -673,12 +693,15 @@ oexe)))) (defcommand compile-c-files Microsoft-C-nt (lambda (files parms) - (and (batch:try-chopped-command parms - "cl" "-c" "-nologo" "-O2" - (include-spec "-I" parms) - (c-includes parms) - (c-flags parms) - 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) + files) (truncate-up-to (map c->obj files) #\\)))) (defcommand link-c-program Microsoft-C-nt (lambda (oname objects libs parms) @@ -880,19 +903,6 @@ ; objects) ; (batch:rebuild-catalog parms) ; (string-append oname ".sl")))) -(defcommand make-dll-archive sunos - (lambda (oname objects libs parms) - (and (batch:try-command - parms - "ld" "-assert" "pure-text" "-o" - (string-append - (car (parameter-list-ref parms 'implvic)) - oname ".so.1.0") - objects) - (batch:rebuild-catalog parms) - (string-append - (car (parameter-list-ref parms 'implvic)) - oname ".so.1.0")))) (defcommand compile-c-files linux-aout (lambda (files parms) @@ -937,11 +947,9 @@ "-fpic" "-c" (c-includes parms) (c-flags parms) files) - (let* ((platform (car (parameter-list-ref - parms 'platform))) + (let* ((platform (car (parameter-list-ref parms 'platform))) (ld-opts - (map (lambda (l) - (build:lib-ld-flag l platform)) + (map (lambda (l) (build:lib-ld-flag l platform)) (parameter-list-ref parms 'c-lib))) (results (map @@ -968,8 +976,7 @@ (car (parameter-list-ref parms 'implvic)) oname ".so") objects - (map (lambda (l) - (build:lib-ld-flag l platform)) + (map (lambda (l) (build:lib-ld-flag l platform)) (parameter-list-ref parms 'c-lib))) (batch:rebuild-catalog parms) (string-append @@ -984,7 +991,7 @@ (append objects libs))) oname))) -(defcommand compile-c-files Unicos +(defcommand compile-c-files unicos (lambda (files parms) (and (batch:try-chopped-command parms @@ -1000,6 +1007,34 @@ parms "cc" "setjump.o" "-o" oname objects libs) oname))) +;; George Bronnikov <goga@rubinstein.mccme.ru> describes options for the +;; PLAN9 native C compiler `8c': +;; +;; -F Enable type-checking of calls to print(2) and other +;; formatted print routines. +;; -V By default, the compilers are non-standardly lax about +;; type equality between void* values and other pointers. +;; This flag requires ANSI C conformance. +;; -w Print warning messages about unused variables etc. (It +;; does print a lot of them, indeed.) +;; -p Invoke a standard ANSI C preprocessor before compiling +;; (instead of a rudimentary builtin one used by default). +;;(defcommand compile-c-files plan9-8 +;; (lambda (files parms) +;; (and (batch:try-chopped-command +;; parms +;; "8c" "-Fwp" "-DPLAN9" ;"-V" +;; ;;(include-spec "-i" parms) +;; (c-includes parms) +;; (c-flags parms) +;; files) +;; (truncate-up-to (map c->8 files) #\/)))) +;;(defcommand link-c-program plan9-8 +;; (lambda (oname objects libs parms) +;; (and (batch:try-command +;; parms "8l" "-o" oname objects libs) +;; oname))) + (defcommand compile-c-files gcc (lambda (files parms) (and (batch:try-chopped-command parms @@ -1029,6 +1064,19 @@ (c-flags parms) files) (truncate-up-to (map c->o files) "\\/]")))) +(defcommand make-dll-archive gcc + (lambda (oname objects libs parms) + (and (batch:try-command + parms + "ld" "-assert" "pure-text" "-o" + (string-append + (car (parameter-list-ref parms 'implvic)) + oname ".so.1.0") + objects) + (batch:rebuild-catalog parms) + (string-append + (car (parameter-list-ref parms 'implvic)) + oname ".so.1.0")))) (defcommand compile-c-files cygwin32 (lambda (files parms) @@ -1074,6 +1122,33 @@ "/usr/lib/crt0.o") (append objects libs))) oname))) +(defcommand compile-dll-c-files svr4-gcc-sun-ld + (lambda (files parms) + (and + (batch:try-chopped-command + parms + "gcc" "-O2" + "-fpic" "-c" (c-includes parms) + (c-flags parms) + files) + (let* ((platform (car (parameter-list-ref parms 'platform))) + (ld-opts + (map (lambda (l) (build:lib-ld-flag l platform)) + (parameter-list-ref parms 'c-lib))) + (results + (map + (lambda (fname) + (and (batch:try-command + parms + "ld" "-G" "-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 compile-c-files svr4 (lambda (files parms) @@ -1397,6 +1472,79 @@ (car (parameter-list-ref parms 'implvic)) oname ".so")))) +(defcommand compile-c-files darwin + (lambda (files parms) + (and (batch:try-chopped-command + parms + "cc" "-O3" "-c" + (c-includes parms) + (c-flags parms) + files) + (map c->o files)))) +(defcommand link-c-program darwin + (lambda (oname objects libs parms) + (batch:rename-file parms + oname (string-append oname "~")) + (and (batch:try-command parms + "cc" "-o" oname + (append objects libs)) + oname))) + +(defcommand compile-c-files openbsd + (lambda (files parms) + (and (batch:try-chopped-command + parms + "cc" "-O2" "-Wall" "-c" + (c-includes parms) + (c-flags parms) + files) + (map c->o files)))) +(defcommand link-c-program openbsd + (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 openbsd + (lambda (files parms) + (and (batch:try-chopped-command + parms + "cc" "-O2" "-Wall" "-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 openbsd + (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")))) + (for-each (build 'add-domain) '((C-libraries C-libraries #f symbol #f))) @@ -1406,7 +1554,7 @@ *parameter-columns* *parameter-columns* ((1 platform single platform - (lambda (pl) (list batch:platform)) + (lambda (pl) (list *operating-system*)) #f "what to build it for") (2 target-name single string (lambda (pl) '("scm")) #f @@ -1446,12 +1594,9 @@ (16 scm-srcdir single filename (lambda (pl) (list (user-vicinity))) #f "directory path for files in the manifest") - (17 scm-libdir single filename - (lambda (pl) (list (implementation-vicinity))) #f - "directory path for files in the manifest") - (18 c-defines nary expression #f #f "#defines for C") - (19 c-includes nary expression #f #f "library induced defines for C") - (20 batch-port nary expression #f #f + (17 c-defines nary expression #f #f "#defines for C") + (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.") )) '(build-pnames @@ -1473,7 +1618,6 @@ ("compiler options" 14) ("linker options" 15) ("scm srcdir" 16) - ("scm libdir" 17) )) '(*commands* @@ -1493,9 +1637,6 @@ #f "SCM Build Database")))) -;;;((build 'close-database)) -;;;(define build (open-database! "buildscm.scm" 'alist-table)) - (define build:error slib:error) (define build:c-libraries #f) (define build:lib-cc-flag #f) @@ -1503,6 +1644,7 @@ (define build:c-lib-support #f) (define build:c-suppress #f) (define plan-command #f) +(define platform->os #f) ;;; Look up command on a platform, but default to '*unknown* if not ;;; initially found. @@ -1588,10 +1730,15 @@ parms (cons 'batch-dialect (list (os->batch-dialect os))))))) (adjoin-parameters! - parms - (cons 'c-defines c-defines) - (cons 'c-includes c-includes)) - + parms + (cons 'c-defines c-defines) + (cons 'c-includes c-includes)) + (set! parms + (cons + (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 @@ -1678,6 +1825,7 @@ (define c-> (filename:substitute?? "*.c" "*")) (define c->o (filename:substitute?? "*.c" "*.o")) +(define c->8 (filename:substitute?? "*.c" "*.8")) (define c->obj (filename:substitute?? "*.c" "*.obj")) (define obj-> (filename:substitute?? "*.obj" "*")) (define obj->exe (filename:substitute?? "*.obj" "*.exe")) @@ -1701,6 +1849,46 @@ "slibcat")) #t) +(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))) + (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) + (set! build:qacs (make-query-alist-command-server build '*commands* #t))) + (call-with-outputs + (lambda () (build:qacs query-alist)) + (lambda (stdout stderr . status) + (cond ((or (substring? ": ERROR: " stderr) + (substring? ": WARN: " stderr)) + => (lambda (idx) + (set! stderr (substring stderr (+ 2 idx) + (string-length stderr)))))) + (cond ((null? status) + (logger "Aborting query") + (pretty-print query-alist) + (display stderr) + (list "buildscm Abort" (html:pre stdout) + "<B>" (html:pre stderr) "</B>")) + (else + (display stderr) ;query is already logged + (if (car status) + (http:content '(("Content-Type" . "text/plain")) ;application/x-sh + stdout) + (list "buildscm Error" "<B>" (html:pre stderr) "</B>" + "<HR>" + (html:pre stdout)))))))) +;;; (print 'request-line '= (cgi:request-line)) (print 'header '=) (for-each print (cgi:query-header)) + (define build:initializer (lambda (rdb) (set! build:c-libraries ((rdb 'open-table) 'c-libraries #f)) @@ -1716,10 +1904,13 @@ (set! build:c-suppress (make-defaulting-platform-lookup (build:c-libraries 'get 'suppress-files))) + (set! platform->os (((rdb 'open-table) 'platform #f) + 'get 'operating-system)) (set! plan-command (let ((lookup (make-defaulting-platform-lookup (((rdb 'open-table) 'compile-commands #f) 'get 'procedure)))) (lambda (thing plat) + ;;(print 'thing thing 'plat plat) (slib:eval (lookup thing plat))))))) (build:initializer build) |