Mercurial > repos > tabletprog
diff modules/llcompile.tp @ 310:2308336790d4
WIP compiler module for low-level dialect
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Fri, 01 Aug 2014 18:56:39 -0700 |
parents | |
children | f987bb2a1911 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/modules/llcompile.tp Fri Aug 01 18:56:39 2014 -0700 @@ -0,0 +1,135 @@ +{ + _compileError <- :_msg _line { + #{ + isError? <- { true } + msg <- { _msg } + line <- { _line } + } + } + + _notError <- :vals ifnoterr { + maybeErr <- vals find: :val { + (object does: val understand?: "isError?") && val isError? + } + maybErr value: :err { + err + } none: ifnoterr + } + + _ilFun <- :_name { + _buff <- #[] + _nextReg <- 0 + #{ + name <- { _name } + add <- :inst { _buff append: inst } + getReg <- { + r <- il reg: _nextReg + _nextReg <- _nextReg + 1 + r + } + } + } + + _exprHandlers <- dict hash + _compileExpr:syms:ilfun:dest <- :expr :syms :ilf :dst { + _exprHandlers ifget: (expr nodeType) :handler { + handler: expr syms ilf dst + } else: { + _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 + + _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 } } + + _compileBinary <- :expr syms ilf assignTo { + _assignSize? <- false + _asize <- 0 + dest <- option value: assignTo :asn { + _assignSize? <- true + _asize <- asn size + asn + } none: { + ilf getReg + } + l <- _compileExpr: (expr left) syms: syms ilfun: ilf assign: (option value: dest) + r <- _compileExpr: (expr right) syms: syms ilfun: ilf assign: (option none) + _notError: [(l) (r)] { + lv <- l val + ls <- l size + rv <- r val + rs <- r size + _size <- if: ls > rs { ls } else: { rs } + _signed <- (ls signed?) || (rs signed?) + _opMap ifget: (expr op) :ingen { + ilf add: (ingen: lv rv (dest val) _size) + #{ + val <- dest + size <- _size + signed? <- _signed + } + } else: { + _compOps ifget: (expr op) :cond { + ilf add: (il bool: cond dest) + #{ + val <- dest + size <- il b + signed? <- false + } + } else: { + _compileError: "Operator " . (expr op) . " is not supported yet\n" 0 + } + } + } + } + _compileString <- :expr syms ilf assignTo { + + } + _compileInt <- :expr syms ilf assignTo { + expr + } + _compileSym <- :expr syms ilf assignTo { + syms ifDefined: (expr name) :def { + def + } else: { + _compileError: "Symbol " . (expr name) . " is not defined in " . (ilf name) + } + } + + _exprHandlers set: binary _compileBinary + _exprHandlers set: stringlit _compileString + #{ + import: [ + binary + stringlit + intlit + sym + call + obj + sequence + assignment + lambda + ] from: ast + llFun <- :{ + + } + } +}