source: project/chicken/branches/prerelease/csc.scm @ 15921

Last change on this file since 15921 was 15921, checked in by Ivan Raikov, 10 years ago

merged -setup-mode support into prerelease branch

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