1c13c82ed282b43a5fba9d18fcc877ee4f4778e1
[mes.git] / module / mescc.scm
1 ;;; GNU Mes --- Maxwell Equations of Software
2 ;;; Copyright © 2016,2017,2018 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 misc)
23   #:use-module (mescc mescc)
24   #:export (mescc:main))
25
26 (cond-expand
27  (mes
28   (define (set-port-encoding! port encoding) #t)
29   (mes-use-module (mes guile))
30   (mes-use-module (mes misc))
31   (mes-use-module (mes getopt-long))
32   (mes-use-module (mes display))
33   (mes-use-module (mescc mescc))
34   )
35  (guile
36   (define-macro (mes-use-module . rest) #t)))
37
38 (define %prefix (getenv "%prefix"))
39 (define %version (getenv "%version"))
40
41 (when (and=> (getenv "V") (lambda (v) (and (= (string-length v) 1) (> (string->number v) 1))))
42   (format (current-error-port) "mescc[~a]...\n" %scheme))
43
44 (define (unclump-single o)
45   (cond ((string-prefix? "--" o) (list o))
46         ((and (string-prefix? "-" o)
47               (> (string-length o) 2)
48               (not (eq? (string-ref o 2) #\space)))
49          (list (substring o 0 2)
50                (substring o 2)))
51         (else (list o))))
52
53 (define (parse-opts args)
54   (let* ((option-spec
55           '((align)
56             (assemble (single-char #\c))
57             (base-address (value #t))
58             (compile (single-char #\S))
59             (define (single-char #\D) (value #t))
60             (debug-info (single-char #\g))
61             (dumpmachine)
62             (fno-builtin)
63             (help (single-char #\h))
64             (include (single-char #\I) (value #t))
65             (library-dir (single-char #\L) (value #t))
66             (library (single-char #\l) (value #t))
67             (machine (single-char #\m) (value #t))
68             (nodefaultlibs)
69             (nostartfiles)
70             (nostdinc)
71             (nostdlib)
72             (preprocess (single-char #\E))
73             (std (value #t))
74             (output (single-char #\o) (value #t))
75             (optimize (single-char #\O) (value #t))
76             (version (single-char #\V))
77             (verbose (single-char #\v))
78             (write (single-char #\w) (value #t))
79             (language (single-char #\x) (value #t))))
80          (options (getopt-long args option-spec))
81          (help? (option-ref options 'help #f))
82          (machine (option-ref options 'machine "32"))
83          (files (option-ref options '() '()))
84          (usage? (and (not help?) (null? files)))
85          (version? (option-ref options 'version #f)))
86     (cond ((option-ref options 'dumpmachine #f)
87            (cond ((equal? machine "32") (display "x86-linux-mes\n"))
88                  (else (display "x86_64-linux-mes\n")))
89            (exit 0))
90           (version? (format #t "mescc (GNU Mes) ~a\n" %version) (exit 0))
91           (else
92            (and (or help? usage?)
93                 (format (or (and usage? (current-error-port)) (current-output-port)) "\
94 Usage: mescc [OPTION]... FILE...
95   --align             align globals
96   -dumpmachine        display the compiler's target machine
97   --base-address=ADRRESS
98                       use BaseAddress ADDRESS [0x1000000]
99   -D DEFINE[=VALUE]   define DEFINE [VALUE=1]
100   -E                  preprocess only; do not compile, assemble or link
101   -g                  add debug info [GDB, objdump] TODO: hex2 footer
102   -h, --help          display this help and exit
103   -I DIR              append DIR to include path
104   -L DIR              append DIR to library path
105   -l LIBNAME          link with LIBNAME
106   -m BITS             compile for BITS bits [32]
107   -nodefaultlibs      do not use libc.o when linking
108   -nostartfiles       do not use crt1.o when linking
109   -nostdlib           do not use crt1.o or libc.o when linking
110   -o FILE             write output to FILE
111   -O LEVEL            use optimizing LEVEL
112   -S                  preprocess and compile only; do not assemble or link
113   --std=STANDARD      assume that the input sources are for STANDARD
114   -v, --version       display version and exit
115   -w,--write=TYPE     dump Nyacc AST using TYPE {pretty-print,write}
116   -x LANGUAGE         specify LANGUAGE of the following input files
117
118 Ignored for GCC compatibility
119   -fno-builtin
120   -nostdinc
121
122 Environment variables:
123
124   MES=BINARY          run on mes-executable BINARY {mes,guile}
125   MES_DEBUG=LEVEL     show debug output with verbosity LEVEL {0..5}
126   NYACC_TRACE=1       show Nyacc progress
127
128 Report bugs to: bug-mes@gnu.org
129 GNU Mes home page: <http://gnu.org/software/mes/>
130 General help using GNU software: <http://gnu.org/gethelp/>
131 ")
132                 (exit (or (and usage? 2) 0)))
133            options))))
134
135 (define (mescc:main args)
136   (let* ((single-dash-options '("-dumpmachine"
137                                 "-fno-builtin"
138                                 "-nodefaultlibs"
139                                 "-nostartfiles"
140                                 "-nostdinc"
141                                 "-nostdlib"
142                                 "-std"))
143          (args (map (lambda (o)
144                       (if (member o single-dash-options) (string-append "-" o)
145                           o))
146                     args))
147          (args (append-map unclump-single args))
148          (options (parse-opts args))
149          (options (acons 'prefix %prefix options))
150          (preprocess? (option-ref options 'preprocess #f))
151          (compile? (option-ref options 'compile #f))
152          (assemble? (option-ref options 'assemble #f))
153          (verbose? (option-ref options 'verbose (getenv "MES_DEBUG"))))
154     (when verbose?
155       (setenv "NYACC_TRACE" "yes")
156       (format (current-error-port) "options=~s\n" options))
157     (cond (preprocess? (mescc:preprocess options))
158           (compile? (mescc:compile options))
159           (assemble? (mescc:assemble options))
160           (else (mescc:link options)))))