source: project/chicken/branches/hygienic/csc.scm @ 10922

Last change on this file since 10922 was 10922, checked in by felix winkelmann, 13 years ago

added import-for-syntax; fix for -sx; -j as abbrev. for -emit-import-library; meta-macro-env. use when loading import lib

File size: 35.0 KB
Line 
1;;;; csc.scm - Driver program for the CHICKEN compiler - felix -*- Hen -*-
2;
3; Copyright (c) 2000-2007, Felix L. Winkelmann
4; Copyright (c) 2008, The Chicken Team
5; All rights reserved.
6;
7; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
8; conditions are met:
9;
10;   Redistributions of source code must retain the above copyright notice, this list of conditions and the following
11;     disclaimer.
12;   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
13;     disclaimer in the documentation and/or other materials provided with the distribution.
14;   Neither the name of the author nor the names of its contributors may be used to endorse or promote
15;     products derived from this software without specific prior written permission.
16;
17; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
18; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
19; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
20; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
21; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
22; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
23; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
24; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
25; POSSIBILITY OF SUCH DAMAGE.
26
27
28(declare
29  (block)
30  (uses data-structures srfi-1 srfi-13 utils extras ))
31
32#>
33#ifndef C_TARGET_CC
34# define C_TARGET_CC  C_INSTALL_CC
35#endif
36
37#ifndef C_TARGET_CXX
38# define C_TARGET_CXX  C_INSTALL_CXX
39#endif
40
41#ifndef C_TARGET_CFLAGS
42# define C_TARGET_CFLAGS  C_INSTALL_CFLAGS
43#endif
44
45#ifndef C_TARGET_LDFLAGS
46# define C_TARGET_LDFLAGS  C_INSTALL_LDFLAGS
47#endif
48
49#ifndef C_TARGET_BIN_HOME
50# define C_TARGET_BIN_HOME  C_INSTALL_BIN_HOME
51#endif
52
53#ifndef C_TARGET_LIB_HOME
54# define C_TARGET_LIB_HOME  C_INSTALL_LIB_HOME
55#endif
56
57#ifndef C_TARGET_STATIC_LIB_HOME
58# define C_TARGET_STATIC_LIB_HOME  C_INSTALL_STATIC_LIB_HOME
59#endif
60
61#ifndef C_TARGET_INCLUDE_HOME
62# define C_TARGET_INCLUDE_HOME  C_INSTALL_INCLUDE_HOME
63#endif
64
65#ifndef C_TARGET_SHARE_HOME
66# define C_TARGET_SHARE_HOME  C_INSTALL_SHARE_HOME
67#endif
68
69#ifndef C_TARGET_RUN_LIB_HOME
70# define C_TARGET_RUN_LIB_HOME    C_TARGET_LIB_HOME
71#endif
72
73#ifndef C_CHICKEN_PROGRAM
74# define C_CHICKEN_PROGRAM     "chicken"
75#endif
76<#
77
78(define-foreign-variable INSTALL_BIN_HOME c-string "C_INSTALL_BIN_HOME")
79(define-foreign-variable INSTALL_CC c-string "C_INSTALL_CC")
80(define-foreign-variable INSTALL_CXX c-string "C_INSTALL_CXX")
81(define-foreign-variable TARGET_CC c-string "C_TARGET_CC")
82(define-foreign-variable TARGET_CXX c-string "C_TARGET_CXX")
83(define-foreign-variable TARGET_CFLAGS c-string "C_TARGET_CFLAGS")
84(define-foreign-variable INSTALL_CFLAGS c-string "C_INSTALL_CFLAGS")
85(define-foreign-variable TARGET_LDFLAGS c-string "C_TARGET_LDFLAGS")
86(define-foreign-variable INSTALL_LDFLAGS c-string "C_INSTALL_LDFLAGS")
87(define-foreign-variable INSTALL_MORE_LIBS c-string "C_INSTALL_MORE_LIBS")
88(define-foreign-variable INSTALL_MORE_STATIC_LIBS c-string "C_INSTALL_MORE_STATIC_LIBS")
89(define-foreign-variable INSTALL_SHARE_HOME c-string "C_INSTALL_SHARE_HOME")
90(define-foreign-variable INSTALL_LIB_HOME c-string "C_INSTALL_LIB_HOME")
91(define-foreign-variable INSTALL_INCLUDE_HOME c-string "C_INSTALL_INCLUDE_HOME")
92(define-foreign-variable INSTALL_STATIC_LIB_HOME c-string "C_INSTALL_STATIC_LIB_HOME")
93(define-foreign-variable TARGET_MORE_LIBS c-string "C_TARGET_MORE_LIBS")
94(define-foreign-variable TARGET_MORE_STATIC_LIBS c-string "C_TARGET_MORE_STATIC_LIBS")
95(define-foreign-variable TARGET_BIN_HOME c-string "C_TARGET_BIN_HOME")
96(define-foreign-variable TARGET_SHARE_HOME c-string "C_TARGET_SHARE_HOME")
97(define-foreign-variable TARGET_LIB_HOME c-string "C_TARGET_LIB_HOME")
98(define-foreign-variable TARGET_INCLUDE_HOME c-string "C_TARGET_INCLUDE_HOME")
99(define-foreign-variable TARGET_STATIC_LIB_HOME c-string "C_TARGET_STATIC_LIB_HOME")
100(define-foreign-variable TARGET_RUN_LIB_HOME c-string "C_TARGET_RUN_LIB_HOME")
101(define-foreign-variable CHICKEN_PROGRAM c-string "C_CHICKEN_PROGRAM")
102
103
104;;; Parameters:
105
106(define mingw (eq? (build-platform) 'mingw32))
107(define msvc (eq? (build-platform) 'msvc))
108(define osx (eq? (software-version) 'macosx))
109(define hpux-hppa (and (eq? (software-version) 'hpux)
110                       (eq? (machine-type) 'hppa)))
111
112(define (quit msg . args)
113  (fprintf (current-error-port) "csc: ~?~%" msg args)
114  (exit 64) )
115
116(define chicken-prefix (getenv "CHICKEN_PREFIX"))
117(define arguments (command-line-arguments))
118(define host-mode (member "-host" arguments))
119(define cross-chicken (##sys#fudge 39))
120
121(define (prefix str dir default)
122  (if chicken-prefix
123      (make-pathname (list chicken-prefix dir) str)
124      default) )
125
126(define (quotewrap str)
127  (if (string-any char-whitespace? str)
128      (string-append "\"" str "\"") 
129      str) )
130
131(define home
132  (quotewrap 
133   (prefix "" "share" (if host-mode INSTALL_SHARE_HOME TARGET_SHARE_HOME))))
134
135(define translator
136  (quotewrap 
137   (prefix "chicken" "bin"
138           (make-pathname
139            (if host-mode INSTALL_BIN_HOME TARGET_BIN_HOME)
140            CHICKEN_PROGRAM))))
141
142(define compiler (quotewrap (if host-mode INSTALL_CC TARGET_CC)))
143(define c++-compiler (quotewrap (if host-mode INSTALL_CXX TARGET_CXX)))
144(define linker (quotewrap (if msvc "link" (if host-mode INSTALL_CC TARGET_CC))))
145(define c++-linker (quotewrap (if msvc "link" (if host-mode INSTALL_CXX TARGET_CXX))))
146(define object-extension (if msvc "obj" "o"))
147(define library-extension (if msvc "lib" "a"))
148(define link-output-flag (if msvc "-out:" "-o "))
149(define executable-extension (if msvc "exe" ""))
150(define compile-output-flag (if msvc "-Fo" "-o "))
151(define nonstatic-compilation-options '())
152(define shared-library-extension ##sys#load-dynamic-extension)
153(define default-translation-optimization-options '())
154(define pic-options (if (or mingw msvc) '("-DPIC") '("-fPIC" "-DPIC")))
155
156(define default-library (string-append
157                         (if msvc "libchicken-static." "libchicken.")
158                         library-extension))
159(define default-unsafe-library (string-append
160                                (if msvc "libuchicken-static." "libuchicken.")
161                                library-extension))
162
163(define cleanup-filename
164  (if (not mingw)
165      (lambda (s) (quotewrap s)) ; allow filenames w/ whitespace
166      (lambda (s) s)))
167
168(define default-compilation-optimization-options (string-split (if host-mode INSTALL_CFLAGS TARGET_CFLAGS)))
169(define best-compilation-optimization-options default-compilation-optimization-options)
170(define default-linking-optimization-options (string-split (if host-mode INSTALL_LDFLAGS TARGET_LDFLAGS)))
171(define best-linking-optimization-options default-linking-optimization-options)
172
173(define-constant simple-options
174  '(-explicit-use -no-trace -no-warnings -no-usual-integrations -optimize-leaf-routines -unsafe
175    -block -disable-interrupts -fixnum-arithmetic -to-stdout -profile -raw -accumulate-profile
176    -check-syntax -case-insensitive -benchmark-mode -shared -compile-syntax -no-lambda-info
177    -lambda-lift -dynamic -disable-stack-overflow-checks -emit-debug-info 
178    -check-imports                      ; DEPRECATED
179    -emit-external-prototypes-first -inline -extension -release -static-extensions
180    -analyze-only -keep-shadowed-macros -disable-compiler-macros))
181
182(define-constant complex-options
183  '(-debug -output-file -heap-size -nursery -stack-size -compiler -unit -uses -keyword-style
184    -optimize-level -include-path -database-size -extend -prelude -postlude -prologue -epilogue 
185    -inline-limit -profile-name -disable-warning 
186    -import                             ; DEPRECATED
187    -require-static-extension
188    -feature -debug-level -heap-growth -heap-shrinkage -heap-initial-size 
189    -emit-exports -compress-literals            ; DEPRECATED
190    -emit-import-library))
191
192(define-constant shortcuts
193  '((-h "-help")
194    (-s "-shared")
195    (|-E| "-extension")
196    (|-P| "-check-syntax")
197    (|-V| "-version")
198    (|-Ob| "-benchmark-mode")
199    (-f "-fixnum-arithmetic")
200    (|-D| "-feature")
201    (-i "-case-insensitive")
202    (|-K| "-keyword-style")
203    (|-X| "-extend")
204    (|-N| "-no-usual-integrations")
205    (|-G| "-check-imports")             ; DEPRECATED
206    (-x "-explicit-use")
207    (-u "-unsafe")
208    (-j "-emit-import-library")
209    (-b "-block") ) )
210
211(define short-options
212  (string->list "PHhsfiENxubvwAOeWkctgG") )
213
214
215;;; Variables:
216
217(define scheme-files '())
218(define generated-scheme-files '())
219(define c-files '())
220(define generated-c-files '())
221(define object-files '())
222(define generated-object-files '())
223(define cpp-mode #f)
224(define objc-mode #f)
225(define embedded #f)
226(define inquiry-only #f)
227(define show-cflags #f)
228(define show-ldflags #f)
229(define show-libs #f)
230(define dry-run #f)
231
232(define extra-libraries
233  (if host-mode
234      INSTALL_MORE_STATIC_LIBS
235      TARGET_MORE_STATIC_LIBS))
236(define extra-shared-libraries 
237  (if host-mode 
238      INSTALL_MORE_LIBS
239      TARGET_MORE_LIBS))
240(define default-library-files 
241  (list
242   (quotewrap
243    (prefix default-library "lib"
244            (string-append
245             (if host-mode INSTALL_LIB_HOME TARGET_LIB_HOME)
246             (string-append "/" default-library)))) ))
247(define default-shared-library-files (if msvc
248                                         (list (string-append "libchicken." library-extension))
249                                         '("-lchicken")))
250(define unsafe-library-files
251  (list
252   (quotewrap 
253    (prefix default-unsafe-library "lib"
254            (string-append
255             (if host-mode INSTALL_LIB_HOME TARGET_LIB_HOME)
256             (string-append "/" default-unsafe-library)))) ))
257(define unsafe-shared-library-files (if msvc
258                                        (list (string-append "libuchicken." library-extension))
259                                        '("-luchicken")))
260(define gui-library-files default-library-files)
261(define gui-shared-library-files default-shared-library-files)
262(define library-files default-library-files)
263(define shared-library-files default-shared-library-files)
264
265(define translate-options '("-quiet"))
266
267(define include-dir
268  (let ((id (prefix "" "include" 
269                    (if host-mode INSTALL_INCLUDE_HOME TARGET_INCLUDE_HOME))))
270    (and (not (member id '("/usr/include" "")))
271         id) ) )
272
273(define compile-options
274  (if include-dir (list "-I" include-dir) '()))
275
276(define compile-only-flag "-c")
277(define translation-optimization-options default-translation-optimization-options)
278(define compilation-optimization-options default-compilation-optimization-options)
279(define linking-optimization-options default-linking-optimization-options)
280
281(define link-options
282  (cond ((or osx hpux-hppa mingw)
283         (list (conc "-L" (quotewrap
284                           (prefix "" "lib"
285                                   (if host-mode 
286                                       INSTALL_LIB_HOME
287                                       TARGET_LIB_HOME)) ))))
288        (msvc
289         (list (conc "-LIBPATH:" (quotewrap
290                                  (prefix "" "lib"
291                                          (if host-mode 
292                                              INSTALL_LIB_HOME
293                                              TARGET_LIB_HOME)) ))))
294        (else
295         (list
296          (conc "-L" (quotewrap (prefix "" "lib"
297                                        (if host-mode
298                                            INSTALL_LIB_HOME
299                                            TARGET_LIB_HOME))))
300          (conc " -Wl,-R" (quotewrap (prefix "" "lib"
301                                             (if host-mode
302                                                 INSTALL_LIB_HOME
303                                                 TARGET_RUN_LIB_HOME)))) ) ) ) )
304
305(define target-filename #f)
306(define verbose #f)
307(define keep-files #f)
308(define translate-only #f)
309(define compile-only #f)
310(define to-stdout #f)
311(define shared #f)
312(define static #f)
313(define static-libs #f)
314(define static-extensions #f)
315(define required-extensions '())
316(define gui #f)
317
318
319;;; Display usage information:
320
321(define (usage)
322  (display
323"Usage: csc FILENAME | OPTION ...
324
325  `csc' is a driver program for the CHICKEN compiler. Any Scheme, C or object
326  files and all libraries given on the command line are translated, compiled or
327  linked as needed.
328
329  General options:
330
331    -h  -help                   display this text and exit
332    -v                          show intermediate compilation stages
333    -v2  -verbose               display information about translation progress
334    -v3                         display information about all compilation stages
335    -V  -version                display Scheme compiler version and exit
336    -release                    display release number and exit
337
338  File and pathname options:
339
340    -o -output-file FILENAME    specifies target executable name
341    -I -include-path PATHNAME   specifies alternative path for included files
342    -to-stdout                  write compiler to stdout (implies -t)
343    -s -shared -dynamic         generate dynamically loadable shared object file
344
345  Language options:
346
347    -D  -DSYMBOL  -feature SYMBOL
348                                register feature identifier
349    -c++                        Compile via a C++ source file (.cpp)
350    -objc                       Compile via Objective-C source file (.m)
351
352  Syntax related options:
353
354    -i -case-insensitive        don't preserve case of read symbols   
355    -K -keyword-style STYLE     allow alternative keyword syntax (prefix, suffix or none)
356    -compile-syntax             macros are made available at run-time
357    -j -emit-import-library MODULE
358                                write compile-time module information into separate file
359
360  Translation options:
361
362    -x  -explicit-use           do not use units `library' and `eval' by default
363    -P  -check-syntax           stop compilation after macro-expansion
364    -A  -analyze-only           stop compilation after first analysis pass
365
366  Debugging options:
367
368    -w  -no-warnings            disable warnings
369    -disable-warning CLASS      disable specific class of warnings
370    -d0 -d1 -d2 -debug-level NUMBER
371                                set level of available debugging information
372    -no-trace                   disable rudimentary debugging information
373    -profile                    executable emits profiling information
374    -accumulate-profile         executable emits profiling information in append mode
375    -profile-name FILENAME      name of the generated profile information file
376    -emit-debug-info            emit additional debug-information
377
378  Optimization options:
379
380    -O -O1 -O2 -O3 -optimize-level NUMBER
381                                enable certain sets of optimization options
382    -optimize-leaf-routines     enable leaf routine optimization
383    -N  -no-usual-integrations  standard procedures may be redefined
384    -u  -unsafe                 disable safety checks
385    -b  -block                  enable block-compilation
386    -disable-interrupts         disable interrupts in compiled code
387    -f  -fixnum-arithmetic      assume all numbers are fixnums
388    -Ob  -benchmark-mode        equivalent to '-block -optimize-level 3
389                                 -debug-level 0 -fixnum-arithmetic -lambda-lift
390                                 -disable-interrupts'
391    -lambda-lift                perform lambda-lifting
392    -unsafe-libraries           link with unsafe runtime system
393    -disable-stack-overflow-checks  disables detection of stack-overflows
394    -inline                     enable inlining
395    -inline-limit               set inlining threshold
396    -disable-compiler-macros    disable expansion of compiler macros
397
398  Configuration options:
399
400    -unit NAME                  compile file as a library unit
401    -uses NAME                  declare library unit as used.
402    -heap-size NUMBER           specifies heap-size of compiled executable
403    -heap-initial-size NUMBER   specifies heap-size at startup time
404    -heap-growth PERCENTAGE     specifies growth-rate of expanding heap
405    -heap-shrinkage PERCENTAGE  specifies shrink-rate of contracting heap
406    -nursery NUMBER  -stack-size NUMBER
407                                specifies nursery size of compiled executable
408    -X -extend FILENAME         load file before compilation commences
409    -prelude EXPRESSION         add expression to beginning of source file
410    -postlude EXPRESSION        add expression to end of source file
411    -prologue FILENAME          include file before main source file
412    -epilogue FILENAME          include file after main source file
413
414    -e  -embedded               compile as embedded (don't generate `main()')
415    -W  -windows                compile as Windows GUI application (MSVC only)
416    -R  -require-extension NAME require extension in compiled code
417    -E  -extension              compile as extension (dynamic or static)
418    -dll -library               compile multiple units into a dynamic library
419
420  Options to other passes:
421
422    -C OPTION                   pass option to C compiler
423    -L OPTION                   pass option to linker
424    -I<DIR>                     pass \"-I<DIR>\" to C compiler (add include path)
425    -L<DIR>                     pass \"-L<DIR>\" to linker (add library path)
426    -k                          keep intermediate files
427    -c                          stop after compilation to object files
428    -t                          stop after translation to C
429    -cc COMPILER                select other C compiler than the default one
430    -cxx COMPILER               select other C++ compiler than the default one
431    -ld COMPILER                select other linker than the default one
432    -lLIBNAME                   link with given library (`libLIBNAME' on UNIX,
433                                 `LIBNAME.lib' on Windows)                               
434    -static-libs                link with static CHICKEN libraries
435    -static                     generate completely statically linked executable
436    -static-extensions          link with static extensions (if available)
437    -F<DIR>                     pass \"-F<DIR>\" to C compiler (add framework
438                                 header path on Mac OS X)
439    -framework NAME             passed to linker on Mac OS X
440    -rpath PATHNAME             add directory to runtime library search path
441    -Wl,...                     pass linker options
442    -strip                      strip resulting binary
443
444  Inquiry options:
445
446    -home                       show home-directory (where support files go)
447    -cflags                     show required C-compiler flags and exit
448    -ldflags                    show required linker flags and exit
449    -libs                       show required libraries and exit
450    -cc-name                    show name of default C compiler used
451    -cxx-name                   show name of default C++ compiler used
452    -ld-name                    show name of default linker used
453    -dry-run                    just show commands executed, don't run them
454                                 (implies `-v')
455
456  Obscure options:
457
458    -debug MODES                display debugging output for the given modes
459    -compiler PATHNAME          use other compiler than default `chicken'
460    -disable-c-syntax-checks    disable syntax checks of C code fragments
461    -raw                        do not generate implicit init- and exit code                           
462    -emit-external-prototypes-first  emit protoypes for callbacks before foreign
463                                 declarations
464    -keep-shadowed-macros       do not remove shadowed macro
465    -host                       compile for host when configured for cross-compiling
466
467  Options can be collapsed if unambiguous, so
468
469    -vkfO
470
471  is the same as
472
473    -v -k -fixnum-arithmetic -optimize
474
475  The contents of the environment variable CSC_OPTIONS are implicitly
476  passed to every invocation of `csc'.
477"
478) )
479
480
481;;; Parse arguments:
482
483(define (run args)
484
485  (define (t-options . os)
486    (set! translate-options (append translate-options os)) )
487
488  (define (check o r . n)
489    (unless (>= (length r) (optional n 1))
490      (quit "not enough arguments to option `~A'" o) ) )
491
492  (define (shared-build lib)
493    (set! translate-options (cons* "-feature" "chicken-compile-shared" translate-options))
494    (set! compile-options (append pic-options '("-DC_SHARED") compile-options))
495    (set! link-options
496      (cons (cond
497             (osx (if lib "-dynamiclib" "-bundle"))
498             (msvc "-dll")
499             (else "-shared")) link-options))
500    (set! shared #t) )
501
502  (let loop ([args args])
503    (cond [(null? args)
504           (when inquiry-only
505             (when show-cflags (print* (compiler-options) #\space))
506             (when show-ldflags (print* (linker-options) #\space))
507             (when show-libs (print* (linker-libraries #t) #\space))
508             (newline)
509             (exit) )
510           #;(when (null? scheme-files)
511             (set! scheme-files c-files)
512             (set! c-files '()) )
513           (cond [(null? scheme-files)
514                  (when (and (null? c-files) (null? object-files))
515                    (quit "no source files specified") )
516                  (let ((f0 (last (if (null? c-files) object-files c-files))))
517                    (unless target-filename
518                      (set! target-filename 
519                        (if shared
520                            (pathname-replace-extension f0 shared-library-extension)
521                            (pathname-replace-extension f0 executable-extension) ) ) ) ) ]
522                 [else
523                  (when (and shared (not embedded))
524                    (set! translate-options (cons "-dynamic" translate-options)) )
525                  (unless target-filename
526                    (set! target-filename
527                      (if shared
528                          (pathname-replace-extension (first scheme-files) shared-library-extension)
529                          (pathname-replace-extension (first scheme-files) executable-extension) ) ) )
530                  (run-translation) ] )
531           (unless translate-only 
532             (run-compilation)
533             (unless compile-only
534               (when (member target-filename scheme-files)
535                 (printf "Warning: output file will overwrite source file `~A' - renaming source to `~A.old'~%"
536                         target-filename target-filename)
537                 (unless (zero? ($system (sprintf "mv ~A ~A.old" target-filename target-filename)))
538                   (exit last-exit-code) ) )
539               (run-linking)) ) ]
540          [else
541           (let* ([arg (car args)]
542                  [rest (cdr args)]
543                  [s (string->symbol arg)] )
544             (case s
545               [(-help --help)
546                (usage)
547                (exit) ]
548               [(-release)
549                (print (chicken-version))
550                (exit) ]
551               [(-version)
552                (system (sprintf translator " -version"))
553                (exit) ]
554               [(-c++) 
555                (set! cpp-mode #t)
556                (when osx (set! compile-options (cons "-no-cpp-precomp" compile-options))) ]
557               [(-objc) 
558                (set! objc-mode #t) ]
559               [(-static) 
560                (set! translate-options (cons* "-feature" "chicken-compile-static" translate-options))
561                (set! static #t) ]
562               [(-static-libs) 
563                (set! translate-options (cons* "-feature" "chicken-compile-static" translate-options))
564                (set! static-libs #t) ]
565               [(-static-extensions)
566                (set! static-extensions #t) ]
567               [(-cflags)
568                (set! inquiry-only #t) 
569                (set! show-cflags #t) ]
570               [(-ldflags)
571                (set! inquiry-only #t)
572                (set! show-ldflags #t) ]
573               [(-cc-name) (print compiler) (exit 0)]
574               [(-cxx-name) (print c++-compiler) (exit 0)]
575               [(-ld-name) (print linker) (exit 0)]
576               [(-home) (print home) (exit 0)]
577               [(-libs)
578                (set! inquiry-only #t)
579                (set! show-libs #t) ]
580               [(-v)
581                (set! verbose #t) ]
582               [(-v2 -verbose)
583                (set! verbose #t)
584                (t-options "-verbose") ]
585               [(-w -no-warnings)
586                (set! compile-options (cons "-w" compile-options))
587                (t-options "-no-warnings") ]
588               [(-v3)
589                (set! verbose #t)
590                (t-options "-verbose")
591                (if (not msvc)
592                    (set! compile-options (cons* "-v" "-Q" compile-options)))
593                (set! link-options (cons (if msvc "-VERBOSE" "-v") link-options)) ]
594               [(|-A| -analyze-only)
595                (set! translate-only #t)
596                (t-options "-analyze-only") ]
597               [(|-P| -check-syntax)
598                (set! translate-only #t)
599                (t-options "-check-syntax") ]
600               [(-k) (set! keep-files #t)]
601               [(-c) (set! compile-only #t)]
602               [(-t) (set! translate-only #t)]
603               [(-e -embedded)
604                (set! embedded #t)
605                (set! compile-options (cons "-DC_EMBEDDED" compile-options)) ]
606               [(-require-extension -R)
607                (check s rest)
608                (set! required-extensions (append required-extensions (list (car rest))))
609                (t-options "-require-extension" (car rest))
610                (set! rest (cdr rest)) ]
611               [(-windows |-W|)
612                (set! gui #t)
613                (cond
614                 (mingw
615                  (set! link-options
616                    (cons* "-lkernel32" "-luser32" "-lgdi32" "-mwindows"
617                           link-options))
618                  (set! compile-options (cons "-DC_WINDOWS_GUI" compile-options)))
619                 (msvc
620                  (set! link-options
621                    (cons* "kernel32.lib" "user32.lib" "gdi32.lib" link-options))
622                  (set! compile-options (cons "-DC_WINDOWS_GUI" compile-options)))) ]
623               [(-framework)
624                (check s rest)
625                (when osx 
626                  (set! link-options (cons* "-framework" (car rest) link-options)) )
627                (set! rest (cdr rest)) ]
628               [(-o)
629                (check s rest)
630                (let ([fn (car rest)])
631                  (set! rest (cdr rest))
632                  (set! target-filename fn) ) ]
633               [(|-O| |-O1|) (set! rest (cons* "-optimize-level" "1" rest))]
634               [(|-O2|) (set! rest (cons* "-optimize-level" "2" rest))]
635               [(|-O3|) (set! rest (cons* "-optimize-level" "3" rest))]
636               [(-d0) (set! rest (cons* "-debug-level" "0" rest))]
637               [(-d1) (set! rest (cons* "-debug-level" "1" rest))]
638               [(-d2) (set! rest (cons* "-debug-level" "2" rest))]
639               [(-dry-run) 
640                (set! verbose #t)
641                (set! dry-run #t)]
642               [(-s -shared -dynamic)
643                (shared-build #f) ]
644               [(-dll -library)
645                (shared-build #t) ]
646               [(-compiler)
647                (check s rest)
648                (set! translator (car rest))
649                (set! rest (cdr rest)) ]
650               [(-cc)
651                (check s rest)
652                (set! compiler (car rest))
653                (set! rest (cdr rest)) ]
654               [(-cxx)
655                (check s rest)
656                (set! c++-compiler (car rest))
657                (set! rest (cdr rest)) ]
658               [(-ld)
659                (check s rest)
660                (set! linker (car rest))
661                (set! rest (cdr rest)) ]
662               [(|-I|)
663                (check s rest)
664                (set! rest (cons* "-include-path" (car rest) (cdr rest))) ]
665               [(|-C|)
666                (check s rest)
667                (set! compile-options (append compile-options (string-split (car rest))))
668                (set! rest (cdr rest)) ]
669               [(-strip)
670                (set! link-options (append link-options (list "-s")))]
671               [(|-L|)
672                (check s rest)
673                (set! link-options (append link-options (string-split (car rest))))
674                (set! rest (cdr rest)) ]
675               [(-unsafe-libraries)
676                (t-options arg)
677                (set! library-files unsafe-library-files)
678                (set! shared-library-files unsafe-shared-library-files) ]
679               [(-rpath)
680                (check s rest)
681                (when (eq? 'gnu (build-platform))
682                  (set! link-options (append link-options (list (string-append "-Wl,-R" (car rest)))))
683                  (set! rest (cdr rest)) ) ]
684               [(-host) #f]
685               [(-) 
686                (set! target-filename (make-pathname #f "a" executable-extension))
687                (set! scheme-files (append scheme-files '("-")))]
688               [else
689                (when (memq s '(-unsafe -benchmark-mode))
690                  (when (eq? s '-benchmark-mode)
691                    (set! library-files unsafe-library-files)
692                    (set! shared-library-files unsafe-shared-library-files) ) )
693                (when (eq? s '-to-stdout) 
694                  (set! to-stdout #t)
695                  (set! translate-only #t) )
696                (when (memq s '(-optimize-level -benchmark-mode))
697                  (set! compilation-optimization-options best-compilation-optimization-options)
698                  (set! linking-optimization-options best-linking-optimization-options) )
699                (cond [(assq s shortcuts) => (lambda (a) (set! rest (cons (cadr a) rest)))]
700                      [(memq s simple-options) (t-options arg)]
701                      [(memq s complex-options) 
702                       (check s rest)
703                       (let* ([n (car rest)]
704                              [ns (string->number n)] )
705                         (t-options arg n)
706                         (set! rest (cdr rest)) ) ]
707                      [(and (> (string-length arg) 2) (string=? "-:" (substring arg 0 2)))
708                       (t-options arg) ]
709                      [(and (> (string-length arg) 1)
710                            (char=? #\- (string-ref arg 0)) )
711                       (cond [(char=? #\l (string-ref arg 1))
712                              (set! link-options (append link-options (list arg))) ]
713                             [(char=? #\L (string-ref arg 1))
714                              (set! link-options (append link-options (list arg))) ]
715                             [(char=? #\I (string-ref arg 1))
716                              (set! compile-options (append compile-options (list arg))) ]
717                             [(char=? #\D (string-ref arg 1))
718                              (t-options "-feature" (substring arg 2)) ]
719                             [(char=? #\F (string-ref arg 1))
720                              (when osx
721                                (set! compile-options (append compile-options (list arg))) ) ]
722                             [(and (> (string-length arg) 3) (string=? "-Wl," (substring arg 0 4)))
723                              (set! link-options (append link-options (list arg))) ]
724                             [(> (string-length arg) 2)
725                              (let ([opts (cdr (string->list arg))])
726                                (if (null? (lset-difference char=? opts short-options))
727                                    (set! rest
728                                      (append (map (lambda (o) (string-append "-" (string o))) opts) rest) )
729                                    (quit "invalid option `~A'" arg) ) ) ]
730                             [else (quit "invalid option `~A'" s)] ) ]
731                      [(file-exists? arg)
732                       (let-values ([(dirs name ext) (decompose-pathname arg)])
733                         (cond [(not ext) (set! scheme-files (append scheme-files (list arg)))]
734                               [(member ext '("h" "c"))
735                                (set! c-files (append c-files (list arg))) ]
736                               [(member ext '("cpp" "C" "cc" "cxx" "hpp"))
737                                (when osx (set! compile-options (cons "-no-cpp-precomp" compile-options)))
738                                (set! cpp-mode #t)
739                                (set! c-files (append c-files (list arg))) ]
740                               [(member ext '("m" "M" "mm"))
741                                (set! objc-mode #t)
742                                (set! c-files (append c-files (list arg))) ]
743                               [(or (string=? ext object-extension)
744                                    (string=? ext library-extension) )
745                                (set! object-files (append object-files (list arg))) ]
746                               [else (set! scheme-files (append scheme-files (list arg)))] ) ) ]
747                      [else
748                       (let ([f2 (string-append arg ".scm")])
749                         (if (file-exists? f2)
750                             (set! rest (cons f2 rest))
751                             (quit "file `~A' does not exist" arg) ) ) ] ) ] )
752             (loop rest) ) ] ) ) )
753
754
755;;; Translate all Scheme files:
756
757(define (run-translation)
758  (for-each
759   (lambda (f)
760     (let ([cscf (pathname-replace-extension f "csc")])
761       (when (and (file-exists? cscf)
762                  (let ([x (with-input-from-file cscf read-line)])
763                    (or (eof-object? x) (string=? "#%eof" x)) ) )
764         ($delete-file cscf) )
765       (let ([fc (pathname-replace-extension
766                  (if (= 1 (length scheme-files))
767                      target-filename
768                      f)
769                  (cond (cpp-mode "cpp")
770                        (objc-mode "m")
771                        (else "c") ) ) ] )
772         (unless (zero?
773                  ($system 
774                   (string-intersperse 
775                    (cons* translator (cleanup-filename f) 
776                           (append
777                            (if to-stdout 
778                                '("-to-stdout")
779                                `("-output-file" ,(cleanup-filename fc)) )
780                            (if (or static static-libs static-extensions)
781                                (map (lambda (e) (conc "-uses " e)) required-extensions)
782                                '() )
783                            (map quote-option (append translate-options translation-optimization-options)) ) )
784                    " ") ) )
785           (exit last-exit-code) )
786         (set! c-files (append (list fc) c-files))
787         (set! generated-c-files (append (list fc) generated-c-files))
788         (when (file-exists? cscf)
789           (with-input-from-file cscf
790             (lambda ()
791               (read-line)
792               (for-each
793                (lambda (cmd)
794                  (unless (list? cmd)
795                    (error "invalid entry in csc control file" cmd))
796                  (case (car cmd)
797                    ((post-process)
798                     (for-each $system (cdr cmd)))
799                    ((c-options)
800                     (set! compile-options (append compile-options (cdr cmd))))
801                    ((link-options)
802                     (set! link-options (append link-options (cdr cmd))))
803                    (else (error "invalid entry in csc control file" cmd))))
804                (read-file) ) ) )
805           ($delete-file cscf) ) ) ) )
806   scheme-files)
807  (unless keep-files (for-each $delete-file generated-scheme-files)) )
808
809
810;;; Compile all C files:
811
812(define (run-compilation)
813  (let ((ofiles '()))
814    (for-each
815     (lambda (f)
816       (let ([fo (pathname-replace-extension f object-extension)])
817         (unless (zero?
818                  ($system
819                   (string-intersperse
820                    (list (cond (cpp-mode c++-compiler)
821                                (else compiler) )
822                          (cleanup-filename f)
823                          (string-append compile-output-flag (cleanup-filename fo)) 
824                          compile-only-flag
825                          (compiler-options) ) ) ) )
826           (exit last-exit-code) )
827         (set! generated-object-files (cons fo generated-object-files))
828         (set! ofiles (cons fo ofiles))))
829     c-files)
830    (set! object-files (append (reverse ofiles) object-files)) ; put generated object files first
831    (unless keep-files (for-each $delete-file generated-c-files)) ) )
832
833(define (compiler-options)
834  (string-intersperse
835   (map quote-option
836        (append
837         (if (or static static-libs) '() nonstatic-compilation-options)
838         compilation-optimization-options
839         compile-options) ) ) )
840
841
842;;; Link object files and libraries:
843
844(define (run-linking)
845  (let ((files (map cleanup-filename
846                    (append object-files
847                            (nth-value 0 (static-extension-info)) ) ) )
848        (target (cleanup-filename target-filename)))
849    (unless (zero?
850             ($system
851              (string-intersperse 
852               (cons* (cond (cpp-mode c++-linker)
853                            (else linker) )
854                      (append
855                       files
856                       (list (string-append link-output-flag target)
857                             (linker-options)
858                             (linker-libraries #f) ) ) ) ) ) )
859      (exit last-exit-code) )
860    (when (and osx (or (not cross-chicken) host-mode))
861      (unless (zero? ($system 
862                      (string-append
863                       "install_name_tool -change libchicken.dylib "
864                       (quotewrap 
865                        (make-pathname
866                         (prefix "" "lib"
867                                 (if host-mode
868                                     INSTALL_LIB_HOME
869                                     TARGET_RUN_LIB_HOME))
870                         "libchicken.dylib") )
871                       " " 
872                       target) ) )
873        (exit last-exit-code) ) )
874    (unless keep-files (for-each $delete-file generated-object-files)) ) )
875
876(define (static-extension-info)
877  (let ((rpath (repository-path)))
878    (if (or static static-libs static-extensions)
879        (let loop ((exts required-extensions) (libs '()) (opts '()))
880          (if (null? exts)
881              (values (reverse libs) (reverse opts))
882              (let ((info (extension-information (car exts))))
883                (if info
884                    (let ((a (assq 'static info)) 
885                          (o (assq 'static-options info)) )
886                      (loop (cdr exts) 
887                        (if a (cons (make-pathname rpath (cadr a)) libs) libs)
888                        (if o (cons (cadr o) opts) opts) ) ) 
889                    (loop (cdr exts) libs opts)) ) ) )
890        (values '() '()) ) ) )
891
892(define (linker-options)
893  (string-append
894   (string-intersperse
895    (append linking-optimization-options link-options
896            (nth-value 1 (static-extension-info)) ) )
897   (if (and static (not mingw) (not msvc) (not osx)) " -static" "") ) )
898
899(define (linker-libraries #!optional staticexts)
900  (string-intersperse
901   (append
902    (if staticexts (nth-value 0 (static-extension-info)) '())
903    (if (or static static-libs)
904        (if gui gui-library-files library-files)
905        (if gui gui-shared-library-files shared-library-files))
906    (if (or static static-libs)
907        (list extra-libraries)
908        (list extra-shared-libraries)))))
909
910
911;;; Helper procedures:
912
913(define-constant +hairy-chars+ '(#\\ #\#))
914
915(define (cleanup s)
916  (let* ((q #f)
917         (s (list->string
918             (let fold ([s (string->list s)])
919               (if (null? s) 
920                   '()
921                   (let ([c (car s)])
922                     (cond ((memq c +hairy-chars+) (cons* #\\ c (fold (cdr s))))
923                           (else
924                            (when (char-whitespace? c) (set! q #t))
925                            (cons c (fold (cdr s))) ) ) ) ) ) ) ) )
926    (if q 
927        (string-append "\"" (string-translate* s '(("\"" . "\\\""))) "\"")
928        s) ) )
929
930(define (quote-option x)
931  (if (any (lambda (c)
932             (or (char-whitespace? c) (memq c +hairy-chars+)) )
933           (string->list x) )
934      (cleanup x)
935      x) )
936
937(define last-exit-code #f)
938
939(define ($system str)
940  (when verbose (print str))
941  (set! last-exit-code
942    (if dry-run 
943        0
944        (if (zero? (system str))
945            0
946            1)))
947  (unless (zero? last-exit-code)
948    (printf "*** Shell command terminated with exit status ~S: ~A~%" last-exit-code str) )
949  last-exit-code)
950
951(define ($delete-file str)
952  (when verbose 
953    (print "rm " str) )
954  (unless dry-run (delete-file str) ))
955
956
957;;; Run it:
958
959(run (append (string-split (or (getenv "CSC_OPTIONS") "")) arguments))
Note: See TracBrowser for help on using the repository browser.