summaryrefslogtreecommitdiffstats
path: root/build.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:26 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:26 -0800
commitdeda2c0fd8689349fea2a900199a76ff7ecb319e (patch)
treec9726d54a0806a9b0c75e6c82db8692aea0053cf /build.scm
parent3278b75942bdbe706f7a0fba87729bb1e935b68b (diff)
downloadscm-deda2c0fd8689349fea2a900199a76ff7ecb319e.tar.gz
scm-deda2c0fd8689349fea2a900199a76ff7ecb319e.zip
Import Upstream version 5d6upstream/5d6
Diffstat (limited to 'build.scm')
-rw-r--r--build.scm293
1 files changed, 241 insertions, 52 deletions
diff --git a/build.scm b/build.scm
index 4c4d88d..7f896d4 100644
--- a/build.scm
+++ b/build.scm
@@ -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
@@ -323,7 +325,7 @@
#;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
@@ -484,9 +489,10 @@
(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" () ())
@@ -523,13 +529,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 +568,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 +585,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 +691,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 +901,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 +945,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 +974,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 +989,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 +1005,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 +1062,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 +1120,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 +1470,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 +1552,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 +1592,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 +1616,6 @@
("compiler options" 14)
("linker options" 15)
("scm srcdir" 16)
- ("scm libdir" 17)
))
'(*commands*
@@ -1493,9 +1635,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 +1642,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 +1728,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 +1823,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 +1847,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 +1902,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)