Mercurial > repos > tabletprog

comparison modules/llcompile.tp @ 315:f987bb2a1911

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
WIP native compiler work
author Michael Pavone <pavone@retrodev.com>
date Sat, 14 Mar 2015 12:10:51 -0700
parents 2308336790d4
children f74ce841fd1e
comparison
equal deleted inserted replaced
314:d4df33596e7d 315:f987bb2a1911
6 line <- { _line } 6 line <- { _line }
7 } 7 }
8 } 8 }
9 9
10 _notError <- :vals ifnoterr { 10 _notError <- :vals ifnoterr {
11 maybeErr <- vals find: :val { 11 if: (object does: vals understand?: "find") {
12 (object does: val understand?: "isError?") && val isError? 12 maybeErr <- vals find: :val {
13 } 13 (object does: val understand?: "isError?") && val isError?
14 maybErr value: :err { 14 }
15 err 15 maybeErr value: :err {
16 } none: ifnoterr 16 err
17 } none: ifnoterr
18 } else: ifnoterr
17 } 19 }
18 20
19 _ilFun <- :_name { 21 _ilFun <- :_name {
20 _buff <- #[] 22 _buff <- #[]
23 _blockStack <- []
21 _nextReg <- 0 24 _nextReg <- 0
22 #{ 25 #{
23 name <- { _name } 26 name <- { _name }
24 add <- :inst { _buff append: inst } 27 add <- :inst { _buff append: inst }
25 getReg <- { 28 getReg <- {
26 r <- il reg: _nextReg 29 r <- il reg: _nextReg
27 _nextReg <- _nextReg + 1 30 _nextReg <- _nextReg + 1
28 r 31 r
29 } 32 }
30 } 33 startBlock <- {
31 } 34 _blockStack <- _buff | _blockStack
32 35 _buff <- #[]
33 _exprHandlers <- dict hash 36 }
37 popBlock <- {
38 res <- _buff
39 _buff <- _blockStack value
40 _blockStack <- _blockStack tail
41 res
42 }
43 buffer <- { _buff }
44 }
45 }
46
47 _exprHandlers <- false
34 _compileExpr:syms:ilfun:dest <- :expr :syms :ilf :dst { 48 _compileExpr:syms:ilfun:dest <- :expr :syms :ilf :dst {
35 _exprHandlers ifget: (expr nodeType) :handler { 49 _exprHandlers ifget: (expr nodeType) :handler {
36 handler: expr syms ilf dst 50 handler: expr syms ilf dst
37 } else: { 51 } else: {
38 _compileError: "Expression with node type " . (expr nodeType) . " not implemented yet" 52 _compileError: "Expression with node type " . (expr nodeType) . " not implemented yet"
39 } 53 }
40 } 54 }
41 _opMap <- dict hash 55 _opMap <- false
42 mapOp <- macro: :op ilfun { 56
43 quote: (opMap set: op :ina inb out size { 57 _compOps <- false
44 il ilfun: ina inb out size
45 })
46 }
47 mapOp: "+" add
48 mapOp: "-" sub
49 mapOp: "*" mul
50 mapOp: "/" div
51 mapOp: "and" and
52 mapOp: "or" or
53 mapOp: "xor" xor
54
55 _compOps <- dict hash
56 _compOps set: "=" :signed? { il eq }
57 _compOps set: "!=" :signed? { il ne }
58 _compOps set: ">" :signed? { if: signed? { il gr } else: { il ugr } }
59 _compOps set: "<" :signed? { if: signed? { il ls } else: { il uls } }
60 _compOps set: ">=" :signed? { if: signed? { il ge } else: { il uge } }
61 _compOps set: "<=" :signed? { if: signed? { il le } else: { il ule } }
62 58
63 _compileBinary <- :expr syms ilf assignTo { 59 _compileBinary <- :expr syms ilf assignTo {
64 _assignSize? <- false 60 _assignSize? <- false
65 _asize <- 0 61 _asize <- 0
66 dest <- option value: assignTo :asn { 62 dest <- option value: assignTo :asn {
111 def 107 def
112 } else: { 108 } else: {
113 _compileError: "Symbol " . (expr name) . " is not defined in " . (ilf name) 109 _compileError: "Symbol " . (expr name) . " is not defined in " . (ilf name)
114 } 110 }
115 } 111 }
116 112 _compileIf <- :expr syms ilf assignTo {
117 _exprHandlers set: binary _compileBinary 113 if: ((expr args) length) != 2 {
118 _exprHandlers set: stringlit _compileString 114 _compileError: "if takes exactly 2 arguments" 0
115 } else: {
116 condArg <- (expr args) value
117 blockArg <- ((expr args) tail) value
118 cond <- _compileExpr: condArg syms: syms ilfun: ilf dest: (option none)
119 _notError: [cond] {
120 if: (blockArg nodeType) != (ast lambda) {
121 _compileError: "second argument to if must be a lambda"
122 } else: {
123 ilf add: (il cmp: condArg 0 (condArg size))
124 //TODO: Deal with if in return position
125 ilf startBlock
126 foreach: (blockArg expressions) :idx expr{
127 _compileExpr: expr syms: syms ilfun: ilf dest: (option none)
128 }
129 block <- ilf popBlock
130 ilf add: (il skipIf: (il neq) block)
131 }
132 }
133 }
134 }
135 _compileIfElse <- :expr syms ilf assignTo {
136 if: ((expr args) length) != 2 {
137 _compileError: "if takes exactly 2 arguments" 0
138 } else: {
139 condArg <- (expr args) value
140 blockArg <- ((expr args) tail) value
141 elseArg <- (((expr args) tail) tail) value
142 cond <- _compileExpr: condArg syms: syms ilfun: ilf dest: (option none)
143 _notError: [cond] {
144 if: (blockArg nodeType) != (ast lambda) {
145 _compileError: "second argument to if:else must be a lambda"
146 } else: {
147 if: (elseArg nodeType) != (ast lambda) {
148 _compileError: "third argument to if:else must be a lambda"
149 } else: {
150 ilf add: (il cmp: condArg 0 (condArg size))
151 //TODO: Deal with if:else in return position
152 ilf startBlock
153 foreach: (blockArg expressions) :idx expr {
154 _compileExpr: expr syms: syms ilfun: ilf dest: (option none)
155 }
156 block <- ilf popBlock
157 ilf startBlock
158 foreach: (elseArg expressions) :idx expr {
159 _compileExpr: expr syms: syms ilfun: ilf dest: (option none)
160 }
161 elseblock <- ilf popBlock
162 ilf add: (il skipIf: (il neq) block else: elseblock)
163 }
164 }
165 }
166 }
167 }
168 _funMap <- false
169 _compileCall <- :expr syms ilf assignTo {
170 if: ((expr tocall) nodeType) = (ast sym) && (_funMap contains?: ((expr tocall) name)) {
171 handler <- _funMap get: ((expr tocall) name) else: { false }
172 handler: expr syms ilf assignTo
173 } else: {
174 ctocall <- _compileExpr: (expr tocall) syms: syms ilfuN: ilf dest: (option none)
175 cargs <- (expr args) map: :arg {
176 _compileExpr: arg syms: syms ilfun: ilf dest: (option none)
177 }
178 _notError: ctocall | cargs {
179 ilf add: (il call: ctocall withArgs: cargs)
180 il retr
181 }
182 }
183 }
184
185 _compileAssign <- :expr syms ilf assignTo {
186 dest <- _compileExpr: (expr to) syms: syms ilfun: ilf dest: (option none)
187 _notError: [dest] {
188 value <- _compileExpr: (expr assign) syms: syms ilfun: ilf dest: dest
189 _notError: [value] {
190 //TODO: adjust size of value if necessary
191 ilf add: (il mov: (value val) (dest val) (dest size))
192 value
193 }
194 }
195 }
196
197 _initDone? <- false
119 #{ 198 #{
120 import: [ 199 import: [
121 binary 200 binary
122 stringlit 201 stringlit
123 intlit 202 intlit
126 obj 205 obj
127 sequence 206 sequence
128 assignment 207 assignment
129 lambda 208 lambda
130 ] from: ast 209 ] from: ast
131 llFun <- :{ 210 _initHandlers <- {
132 211 if: (not: _initDone?) {
212 _exprHandlers <- dict hash
213 _exprHandlers set: binary _compileBinary
214 _exprHandlers set: stringlit _compileString
215 _exprHandlers set: intlit _compileInt
216 _exprHandlers set: sym _compileSym
217 _exprHandlers set: assignment _compileAssign
218 _exprHandlers set: call _compileCall
219
220 _opMap <- dict hash
221 mapOp <- macro: :op ilfun {
222 quote: (_opMap set: op :ina inb out size {
223 il ilfun: ina inb out size
224 })
225 }
226 mapOp: "+" add
227 mapOp: "-" sub
228 mapOp: "*" mul
229 mapOp: "/" div
230 mapOp: "and" band
231 mapOp: "or" bor
232 mapOp: "xor" bxor
233
234 _compOps <- dict hash
235 _compOps set: "=" :signed? { il eq }
236 _compOps set: "!=" :signed? { il ne }
237 _compOps set: ">" :signed? { if: signed? { il gr } else: { il ugr } }
238 _compOps set: "<" :signed? { if: signed? { il ls } else: { il uls } }
239 _compOps set: ">=" :signed? { if: signed? { il ge } else: { il uge } }
240 _compOps set: "<=" :signed? { if: signed? { il le } else: { il ule } }
241
242 _funMap <- dict hash
243 _funMap set: "if" _compileIf
244 _funMap set: "if:else" _compileIfElse
245 //_funMap set: "while:do" _compileWhileDo
246 }
247 }
248
249 llFun:syms:vars:code <- :name :syms :vars :code{
250 _initHandlers:
251 syms <- symbols tableWithParent: syms
252 argnames <- dict hash
253 foreach: (code args) :idx arg {
254 if: (arg startsWith?: ":") {
255 arg <- arg from: 1
256 }
257 argnames set: arg true
258 }
259 ilf <- _ilFun: name
260 _nextReg <- 0
261 foreach: vars :idx var {
262 type <- _parseType: (var assign)
263 varname <- ((var to) name)
264 v <- argnames ifget: varname :argnum {
265 il arg: argnum
266 } else: {
267 ilf getReg
268 }
269 syms define: varname #{
270 val <- v
271 size <- (type size)
272 }
273 }
274 last <- option none
275 numexprs <- code length
276 foreach: code :idx expr {
277 asn <- option none
278 if: idx = numexprs - 1 {
279 option value: (il retr)
280 }
281 last <- option value: (_compileExpr: expr syms: syms ilfun: ilf dest: asn)
282 }
283 last value: :v {
284 ilf add: (il return: (v val) (v size))
285 } none: {
286 ilf add: (il return: 0 (il l))
287 }
288 ilf
289 }
290
291 compileText <- :text {
292 res <- parser top: text
293 if: res {
294 tree <- res yield
295 if: (tree nodeType) = obj {
296 errors <- []
297 syms <- symbols table
298 functions <- tree messages fold: [] :curfuncs msg {
299 if: (msg nodeType) = call {
300 if: ((msg tocall) name) = "llFun:withVars:andCode" {
301 if: ((msg args) length) = 3 {
302 fname <- ((msg args) get: 0) name
303 syms define: fname #{
304 type <- "topfun"
305 }
306 #{
307 name <- fname
308 vars <- (msg args) get: 1
309 body <- (msg args) get: 2
310 } | curfuncs
311 } else: {
312 errors <- (
313 _compileError: "llFun:withVars:andCode takes exactly 3 arguments" 0
314 ) | errors
315 curfuncs
316 }
317 } else: {
318 errors <- (
319 _compileError: "Only llFun:withVars:andCode expressions are allowed in top level object" 0
320 ) | errors
321 curfuncs
322 }
323 } else: {
324 errors <- (
325 _compileError: "Only call expresions are allowed in top level object" 0
326 ) | errors
327 curfuncs
328 }
329 }
330 if: (errors empty?) {
331 fmap <- functions fold: (dict hash) with: :acc func {
332 _notError: acc {
333 ilf <- llFun: (func name) syms: syms vars: (func vars) code: (func body)
334 _notError: ilf {
335 acc set: (func name) (ilf buffer)
336 }
337 }
338 }
339 fmap toBackend: x86
340 } else: {
341 errors
342 }
343 } else: {
344 [(_compileError: "Top level must be an object in llcompile dialect" 1)]
345 }
346 } else: {
347 [(_compileError: "Failed to parse file" 0)]
348 }
349 }
350
351 main <- :args {
352 if: (length: args) > 1 {
353 text <- (file open: (args get: 1)) readAll
354 mcode <- compileText: text
355 _notError: mcode {
356 ba <- bytearray executableFromBytes: mcode
357 arg <- if: (length: args) > 2 { int32: (args get: 2) } else: {0}
358 ba runWithArg: (arg i64)
359 }
360 } else: {
361 (file stderr) write: "Usage: llcompile FILE\n"
362 1
363 }
133 } 364 }
134 } 365 }
135 } 366 }