Mes C Library: stdlib/qsort.c: Fix qswap segfault.
[mes.git] / module / mescc.scm
1 ;;; GNU Mes --- Maxwell Equations of Software
2 ;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
3 ;;;
4 ;;; This file is part of GNU Mes.
5 ;;;
6 ;;; GNU Mes is free software; you can redistribute it and/or modify it
7 ;;; under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 3 of the License, or (at
9 ;;; your option) any later version.
10 ;;;
11 ;;; GNU Mes is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 ;;; GNU General Public License for more details.
15 ;;;
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
18
19 (define-module (mescc)
20   #:use-module (srfi srfi-1)
21   #:use-module (ice-9 getopt-long)
22   #:use-module (mes guile)
23   #:use-module (mes misc)
24   #:use-module (mescc mescc)
25   #:export (mescc:main))
26
27 (cond-expand
28  (mes
29   (define (set-port-encoding! port encoding) #t)
30   (mes-use-module (mes guile))
31   (mes-use-module (mes misc))
32   (mes-use-module (mes getopt-long))
33   (mes-use-module (mes display))
34   (mes-use-module (mescc mescc))
35   )
36  (guile
37   (define-macro (mes-use-module . rest) #t)))
38
39 (define %host-arch (or (getenv "%arch") %arch))
40 (define %host-kernel (or (getenv "%kernel") "linux")) ;; FIXME
41 (define %prefix (or (getenv "%prefix") "mes"))
42 (define %includedir (or (getenv "%includedir") "include"))
43 (define %libdir (or (getenv "%libdir") "."))
44 (define %version (or (getenv "%version") "0.0"))
45 (define %numbered-arch? (and=> (getenv "%numbered_arch") (lambda (x) (equal? x "true"))))
46
47 (when (and=> (getenv "V") (lambda (v) (and (= (string-length v) 1) (> (string->number v) 1))))
48   (format (current-error-port) "mescc[~a]...\n" %scheme))
49
50 (define (unclump-single o)
51   (cond ((string-prefix? "--" o) (list o))
52         ((and (string-prefix? "-" o)
53               (> (string-length o) 2)
54               (not (eq? (string-ref o 2) #\space)))
55          (list (substring o 0 2)
56                (substring o 2)))
57         (else (list o))))
58
59 (define (parse-opts args)
60   (let* ((option-spec
61           '((align)
62             (arch (value #t))
63             (assemble (single-char #\c))
64             (base-address (value #t))
65             (compile (single-char #\S))
66             (define (single-char #\D) (value #t))
67             (debug-info (single-char #\g))
68             (dumpmachine)
69             (print-libgcc-file-name)
70             (fno-builtin)
71             (fno-stack-protector)
72             (help (single-char #\h))
73             (include (single-char #\I) (value #t))
74             (library-dir (single-char #\L) (value #t))
75             (library (single-char #\l) (value #t))
76             (machine (single-char #\m) (value #t))
77             (nodefaultlibs)
78             (nostartfiles)
79             (nostdinc)
80             (nostdlib)
81             (numbered-arch?)
82             (preprocess (single-char #\E))
83             (static)
84             (std (value #t))
85             (output (single-char #\o) (value #t))
86             (optimize (single-char #\O) (value #t))
87             (version (single-char #\V))
88             (verbose (single-char #\v))
89             (write (single-char #\w) (value #t))
90             (language (single-char #\x) (value #t))))
91          (options (getopt-long args option-spec))
92          (help? (option-ref options 'help #f))
93          (files (option-ref options '() '()))
94          (dumpmachine? (option-ref options 'dumpmachine #f))
95          (print-libgcc-file-name? (option-ref options 'print-libgcc-file-name #f))
96          (version? (option-ref options 'version #f))
97          (usage? (and (not dumpmachine?) (not print-libgcc-file-name?) (not help?) (not version?) (null? files))))
98     (cond (version? (format #t "mescc (GNU Mes) ~a\n" %version) (exit 0))
99           (else
100            (and (or help? usage?)
101                 (format (or (and usage? (current-error-port)) (current-output-port)) "\
102 Usage: mescc [OPTION]... FILE...
103 C99 compiler in Scheme for bootstrapping the GNU system.
104
105 Options:
106   --align             align globals
107   --arch=ARCH         compile for ARCH [~a]
108   --kernel=ARCH       compile for KERNEL [~a]
109   -dumpmachine        display the compiler's target machine
110   --base-address=ADRRESS
111                       use BaseAddress ADDRESS [0x1000000]
112   --numbered-arch     mescc-tools use numbered arch
113   -D DEFINE[=VALUE]   define DEFINE [VALUE=1]
114   -E                  preprocess only; do not compile, assemble or link
115   -g                  add debug info [GDB, objdump] TODO: hex2 footer
116   -h, --help          display this help and exit
117   -I DIR              append DIR to include path
118   -L DIR              append DIR to library path
119   -l LIBNAME          link with LIBNAME
120   -m BITS             compile for BITS bits [32]
121   -nodefaultlibs      do not use libc.o nor libmescc.a when linking
122   -nostartfiles       do not use crt1.o when linking
123   -nostdlib           do not use crt1.o or libc.o or libmescc.a when linking
124   -o FILE             write output to FILE
125   -O LEVEL            use optimizing LEVEL
126   -S                  preprocess and compile only; do not assemble or link
127   --std=STANDARD      assume that the input sources are for STANDARD
128   -V,--version        display version and exit
129   -w,--write=TYPE     dump Nyacc AST using TYPE {pretty-print,write}
130   -x LANGUAGE         specify LANGUAGE of the following input files
131
132 Ignored for GCC compatibility
133   -fno-builtin
134   -fno-stack-protector
135   -no-pie
136   -nostdinc
137   -static
138
139 Environment variables:
140
141   MES=BINARY          run on mes-executable BINARY {mes,guile}
142   MES_DEBUG=LEVEL     show debug output with verbosity LEVEL {0..5}
143   NYACC_TRACE=1       show Nyacc progress
144
145 Report bugs to: bug-mes@gnu.org
146 GNU Mes home page: <http://gnu.org/software/mes/>
147 General help using GNU software: <http://gnu.org/gethelp/>
148 " %host-arch %host-kernel)
149                 (exit (or (and usage? 2) 0)))
150            options))))
151
152 (define (mescc:main args)
153   (let* ((single-dash-options '("-dumpmachine"
154                                 "-fno-builtin"
155                                 "-fno-stack-protector"
156                                 "-no-pie"
157                                 "-nodefaultlibs"
158                                 "-nostartfiles"
159                                 "-nostdinc"
160                                 "-nostdlib"
161                                 "-static"
162                                 "-std"))
163          (args (map (lambda (o)
164                       (if (member o single-dash-options) (string-append "-" o)
165                           o))
166                     args))
167          (args (append-map unclump-single args))
168          (options (parse-opts args))
169          (options (acons 'prefix %prefix options))
170          (options (acons 'includedir %includedir options))
171          (options (acons 'libdir %libdir options))
172          (arch (option-ref options 'arch %host-arch))
173          (options (if arch (acons 'arch arch options) options))
174          (kernel (option-ref options 'kernel %host-kernel))
175          (options (acons 'kernel kernel options))
176          (numbered-arch? (option-ref options 'numbered-arch? %numbered-arch?))
177          (options (acons 'numbered-arch? numbered-arch? options))
178          (dumpmachine? (option-ref options 'dumpmachine #f))
179          (preprocess? (option-ref options 'preprocess #f))
180          (print-libgcc-file-name? (option-ref options 'print-libgcc-file-name #f))
181          (compile? (option-ref options 'compile #f))
182          (assemble? (option-ref options 'assemble #f))
183          (verbose? (count-opt options 'verbose)))
184     (when verbose?
185       (setenv "NYACC_TRACE" "yes")
186       (when (> verbose? 1)
187         (format (current-error-port) "options=~s\n" options)))
188     (cond (dumpmachine? (display (mescc:get-host options)))
189           (print-libgcc-file-name? (display "-lmescc\n"))
190           (preprocess? (mescc:preprocess options))
191           (compile? (mescc:compile options))
192           (assemble? (mescc:assemble options))
193           (else (mescc:link options)))))
194
195 (define main mescc:main)