1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
#!/run/current-system/profile/bin/guile \
-L ./src -e main -s
!#
(use-modules (ice-9 getopt-long)
(ice-9 popen)
(ice-9 pretty-print)
(frontend driver)
(backend tacky driver)
(backend generator driver)
(backend emitter driver))
(define version "v0.1.1")
(define (error-with-message message)
(display message)
(exit #f))
(define (error-cli message)
(error-with-message
(format #f
"~a\nUsage:
ull [OPTIONS] file
Options:
--version, -v: print version information
--debug, -d: turn on verbose output
--lex, -l: run the lexer, but stop before assembly generation
--parse, -p: run the lexer and parser, but stop before assembly generation
--tacky, -t: run the tacky generation stage, but stop before assembly generation
--codegen, -c: perform lexing, parsing, tacky, and assembly generation, but stop before code emission\n"
message)))
(define (pp-step ast caption)
(pretty-print ast)
(display (format #f "^-==~a==-^\n" caption)))
(define (c-extension? file)
(let ((extension (string-drop file (- (string-length file) 2))))
(string=? extension ".c")))
(define (cleanup-file file)
(when (file-exists? file)
(delete-file file)))
(define (preprocess src dst)
"Preprocesses SRC with gcc and write it to DST."
(system (string-concatenate `("gcc -E -P " ,src " -o " ,dst)))
(display (format #f "Preprocess reported success (wrote ~a).\n" dst)))
(define (frontend file parse?)
"Wrapper for lexing and parsing. Returns an AST representing FILE."
(let ((c-ast (file->ast file parse?)))
(cleanup-file file)
(or c-ast
(error-with-message
(format #f "~aer reported FAILURE\n" (or (and parse? "Pars") "Lex"))))))
(define (backend ast tack? generate? write?)
"Driver for tacky and assembly generation, code emission.
Returns an string representing the generated assembly."
(pp-step ast "file->ast")
(when tack?
(let ((ast (ast->tacky ast)))
(pp-step ast "ast->tacky")
(when generate?
(let ((ast (tacky->assembly ast)))
(pp-step ast "tacky->assembly")
(when write?
(assembly->string ast)))))))
(define (postprocess src dest)
"Assembles and links SRC, producing executable DEST.
Returns #f on a failure, #t on a success."
(when (zero? (system (string-concatenate `("gcc " ,src " -o " ,dest))))
(display (format #f "Postprocess reported success (wrote ~a).\n" dst))))
(define (write str dst)
"Writes STR to the file at DST."
(cleanup-file dst)
(let ((port (open-output-file dst)))
(display str port)
(close-port port))
(display (format #f "Assembly generation reported success (wrote ~a).\n" dst)))
(define (main args)
"Entry point for ull. Handles user args and performs initial validity check."
(let* ((option-spec
'((version (single-char #\v) (value #f))
(debug (single-char #\d) (value #f))
(lex (single-char #\l) (value #f))
(parse (single-char #\p) (value #f))
(tacky (single-char #\t) (value #f))
(codegen (single-char #\c) (value #f))))
(options (getopt-long args option-spec))
(rest (option-ref options '() #f))
(file-name (if (null? rest) #f (car rest))) )
(cond
;; display version number
((option-ref options 'version #f)
(display (format #f "ull (~a)\n" version)))
;; complain about usage
((not (equal? 1 (length rest))) (error-cli "Wrong number of arguments."))
((or (not file-name)
(not (access? file-name R_OK))
(not (equal? 'regular (stat:type (stat file-name))))
(not (c-extension? file-name))) (error-cli "The file could not be read, or it is not a C source code file."))
(#t
(let* ((parse? (not (option-ref options 'lex #f)))
(tack? (not (option-ref options 'parse #f)))
(generate? (not (option-ref options 'tacky #f)))
(write? (not (option-ref options 'codegen #f)))
(executable-file-name
(string-drop-right file-name 2))
(preprocessed-file-name
(string-concatenate `(,executable-file-name ".i")))
(assembly-file-name
(string-concatenate `(,executable-file-name ".s"))))
;; preprocess the file
(preprocess file-name preprocessed-file-name)
;; call the frontend
(let ((c-ast (frontend preprocessed-file-name parse?)))
(if (and parse? c-ast)
;; call the backend
(begin (display "Parser reported success\n")
(let ((program (backend c-ast tack? generate? write?)))
(when (and write? (not tack?) (not generate?))
(write program assembly-file-name)
;; call postprocessing
(postprocess assembly-file-name executable-file-name))))
(display "Tokenizer reported success\n"))))))))
|
