Mercurial > repos > tabletprog
diff modules/llcompile.tp @ 315:f987bb2a1911
WIP native compiler work
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Sat, 14 Mar 2015 12:10:51 -0700 |
parents | 2308336790d4 |
children | f74ce841fd1e |
line wrap: on
line diff
--- a/modules/llcompile.tp Sat Mar 14 12:10:40 2015 -0700 +++ b/modules/llcompile.tp Sat Mar 14 12:10:51 2015 -0700 @@ -8,16 +8,19 @@ } _notError <- :vals ifnoterr { - maybeErr <- vals find: :val { - (object does: val understand?: "isError?") && val isError? - } - maybErr value: :err { - err - } none: ifnoterr + if: (object does: vals understand?: "find") { + maybeErr <- vals find: :val { + (object does: val understand?: "isError?") && val isError? + } + maybeErr value: :err { + err + } none: ifnoterr + } else: ifnoterr } _ilFun <- :_name { _buff <- #[] + _blockStack <- [] _nextReg <- 0 #{ name <- { _name } @@ -27,10 +30,21 @@ _nextReg <- _nextReg + 1 r } + startBlock <- { + _blockStack <- _buff | _blockStack + _buff <- #[] + } + popBlock <- { + res <- _buff + _buff <- _blockStack value + _blockStack <- _blockStack tail + res + } + buffer <- { _buff } } } - _exprHandlers <- dict hash + _exprHandlers <- false _compileExpr:syms:ilfun:dest <- :expr :syms :ilf :dst { _exprHandlers ifget: (expr nodeType) :handler { handler: expr syms ilf dst @@ -38,27 +52,9 @@ _compileError: "Expression with node type " . (expr nodeType) . " not implemented yet" } } - _opMap <- dict hash - mapOp <- macro: :op ilfun { - quote: (opMap set: op :ina inb out size { - il ilfun: ina inb out size - }) - } - mapOp: "+" add - mapOp: "-" sub - mapOp: "*" mul - mapOp: "/" div - mapOp: "and" and - mapOp: "or" or - mapOp: "xor" xor + _opMap <- false - _compOps <- dict hash - _compOps set: "=" :signed? { il eq } - _compOps set: "!=" :signed? { il ne } - _compOps set: ">" :signed? { if: signed? { il gr } else: { il ugr } } - _compOps set: "<" :signed? { if: signed? { il ls } else: { il uls } } - _compOps set: ">=" :signed? { if: signed? { il ge } else: { il uge } } - _compOps set: "<=" :signed? { if: signed? { il le } else: { il ule } } + _compOps <- false _compileBinary <- :expr syms ilf assignTo { _assignSize? <- false @@ -113,9 +109,92 @@ _compileError: "Symbol " . (expr name) . " is not defined in " . (ilf name) } } + _compileIf <- :expr syms ilf assignTo { + if: ((expr args) length) != 2 { + _compileError: "if takes exactly 2 arguments" 0 + } else: { + condArg <- (expr args) value + blockArg <- ((expr args) tail) value + cond <- _compileExpr: condArg syms: syms ilfun: ilf dest: (option none) + _notError: [cond] { + if: (blockArg nodeType) != (ast lambda) { + _compileError: "second argument to if must be a lambda" + } else: { + ilf add: (il cmp: condArg 0 (condArg size)) + //TODO: Deal with if in return position + ilf startBlock + foreach: (blockArg expressions) :idx expr{ + _compileExpr: expr syms: syms ilfun: ilf dest: (option none) + } + block <- ilf popBlock + ilf add: (il skipIf: (il neq) block) + } + } + } + } + _compileIfElse <- :expr syms ilf assignTo { + if: ((expr args) length) != 2 { + _compileError: "if takes exactly 2 arguments" 0 + } else: { + condArg <- (expr args) value + blockArg <- ((expr args) tail) value + elseArg <- (((expr args) tail) tail) value + cond <- _compileExpr: condArg syms: syms ilfun: ilf dest: (option none) + _notError: [cond] { + if: (blockArg nodeType) != (ast lambda) { + _compileError: "second argument to if:else must be a lambda" + } else: { + if: (elseArg nodeType) != (ast lambda) { + _compileError: "third argument to if:else must be a lambda" + } else: { + ilf add: (il cmp: condArg 0 (condArg size)) + //TODO: Deal with if:else in return position + ilf startBlock + foreach: (blockArg expressions) :idx expr { + _compileExpr: expr syms: syms ilfun: ilf dest: (option none) + } + block <- ilf popBlock + ilf startBlock + foreach: (elseArg expressions) :idx expr { + _compileExpr: expr syms: syms ilfun: ilf dest: (option none) + } + elseblock <- ilf popBlock + ilf add: (il skipIf: (il neq) block else: elseblock) + } + } + } + } + } + _funMap <- false + _compileCall <- :expr syms ilf assignTo { + if: ((expr tocall) nodeType) = (ast sym) && (_funMap contains?: ((expr tocall) name)) { + handler <- _funMap get: ((expr tocall) name) else: { false } + handler: expr syms ilf assignTo + } else: { + ctocall <- _compileExpr: (expr tocall) syms: syms ilfuN: ilf dest: (option none) + cargs <- (expr args) map: :arg { + _compileExpr: arg syms: syms ilfun: ilf dest: (option none) + } + _notError: ctocall | cargs { + ilf add: (il call: ctocall withArgs: cargs) + il retr + } + } + } - _exprHandlers set: binary _compileBinary - _exprHandlers set: stringlit _compileString + _compileAssign <- :expr syms ilf assignTo { + dest <- _compileExpr: (expr to) syms: syms ilfun: ilf dest: (option none) + _notError: [dest] { + value <- _compileExpr: (expr assign) syms: syms ilfun: ilf dest: dest + _notError: [value] { + //TODO: adjust size of value if necessary + ilf add: (il mov: (value val) (dest val) (dest size)) + value + } + } + } + + _initDone? <- false #{ import: [ binary @@ -128,8 +207,160 @@ assignment lambda ] from: ast - llFun <- :{ + _initHandlers <- { + if: (not: _initDone?) { + _exprHandlers <- dict hash + _exprHandlers set: binary _compileBinary + _exprHandlers set: stringlit _compileString + _exprHandlers set: intlit _compileInt + _exprHandlers set: sym _compileSym + _exprHandlers set: assignment _compileAssign + _exprHandlers set: call _compileCall + + _opMap <- dict hash + mapOp <- macro: :op ilfun { + quote: (_opMap set: op :ina inb out size { + il ilfun: ina inb out size + }) + } + mapOp: "+" add + mapOp: "-" sub + mapOp: "*" mul + mapOp: "/" div + mapOp: "and" band + mapOp: "or" bor + mapOp: "xor" bxor + + _compOps <- dict hash + _compOps set: "=" :signed? { il eq } + _compOps set: "!=" :signed? { il ne } + _compOps set: ">" :signed? { if: signed? { il gr } else: { il ugr } } + _compOps set: "<" :signed? { if: signed? { il ls } else: { il uls } } + _compOps set: ">=" :signed? { if: signed? { il ge } else: { il uge } } + _compOps set: "<=" :signed? { if: signed? { il le } else: { il ule } } + + _funMap <- dict hash + _funMap set: "if" _compileIf + _funMap set: "if:else" _compileIfElse + //_funMap set: "while:do" _compileWhileDo + } + } + llFun:syms:vars:code <- :name :syms :vars :code{ + _initHandlers: + syms <- symbols tableWithParent: syms + argnames <- dict hash + foreach: (code args) :idx arg { + if: (arg startsWith?: ":") { + arg <- arg from: 1 + } + argnames set: arg true + } + ilf <- _ilFun: name + _nextReg <- 0 + foreach: vars :idx var { + type <- _parseType: (var assign) + varname <- ((var to) name) + v <- argnames ifget: varname :argnum { + il arg: argnum + } else: { + ilf getReg + } + syms define: varname #{ + val <- v + size <- (type size) + } + } + last <- option none + numexprs <- code length + foreach: code :idx expr { + asn <- option none + if: idx = numexprs - 1 { + option value: (il retr) + } + last <- option value: (_compileExpr: expr syms: syms ilfun: ilf dest: asn) + } + last value: :v { + ilf add: (il return: (v val) (v size)) + } none: { + ilf add: (il return: 0 (il l)) + } + ilf + } + + compileText <- :text { + res <- parser top: text + if: res { + tree <- res yield + if: (tree nodeType) = obj { + errors <- [] + syms <- symbols table + functions <- tree messages fold: [] :curfuncs msg { + if: (msg nodeType) = call { + if: ((msg tocall) name) = "llFun:withVars:andCode" { + if: ((msg args) length) = 3 { + fname <- ((msg args) get: 0) name + syms define: fname #{ + type <- "topfun" + } + #{ + name <- fname + vars <- (msg args) get: 1 + body <- (msg args) get: 2 + } | curfuncs + } else: { + errors <- ( + _compileError: "llFun:withVars:andCode takes exactly 3 arguments" 0 + ) | errors + curfuncs + } + } else: { + errors <- ( + _compileError: "Only llFun:withVars:andCode expressions are allowed in top level object" 0 + ) | errors + curfuncs + } + } else: { + errors <- ( + _compileError: "Only call expresions are allowed in top level object" 0 + ) | errors + curfuncs + } + } + if: (errors empty?) { + fmap <- functions fold: (dict hash) with: :acc func { + _notError: acc { + ilf <- llFun: (func name) syms: syms vars: (func vars) code: (func body) + _notError: ilf { + acc set: (func name) (ilf buffer) + } + } + } + fmap toBackend: x86 + } else: { + errors + } + } else: { + [(_compileError: "Top level must be an object in llcompile dialect" 1)] + } + } else: { + [(_compileError: "Failed to parse file" 0)] + } + } + + main <- :args { + if: (length: args) > 1 { + text <- (file open: (args get: 1)) readAll + mcode <- compileText: text + _notError: mcode { + ba <- bytearray executableFromBytes: mcode + arg <- if: (length: args) > 2 { int32: (args get: 2) } else: {0} + ba runWithArg: (arg i64) + } + } else: { + (file stderr) write: "Usage: llcompile FILE\n" + 1 + } } } }