changeset 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 ed908b7fcec6
children dfd204c82849
files modules/ast.tp modules/il.tp modules/llcompile.tp
diffstat 3 files changed, 175 insertions(+), 13 deletions(-) [+]
line wrap: on
line diff
--- a/modules/ast.tp	Fri Aug 01 18:55:01 2014 -0700
+++ b/modules/ast.tp	Fri Aug 01 18:56:39 2014 -0700
@@ -66,6 +66,7 @@
 				val <- _val
 				base <- _base
 				bits <- _bits
+				size <- { _bits / 8 }
 				signed? <- _signed?
 				stringIndent <- :indent {
 					suffix <- ""
--- a/modules/il.tp	Fri Aug 01 18:55:01 2014 -0700
+++ b/modules/il.tp	Fri Aug 01 18:56:39 2014 -0700
@@ -4,26 +4,31 @@
 	_and    <- 1
 	_or     <- 2
 	_xor    <- 3
+	_mul    <- 4
 	//non-commutative ops
-	_sub    <- 4
-	_cmp    <- 5
-	_not    <- 6
-	_sl     <- 7
-	_asr    <- 8
-	_lsr    <- 9
-	_rol    <- 10
-	_ror    <- 11
-	_mov    <- 12
-	_call   <- 13
-	_ret    <- 14
-	_skipif <- 15
-	_save   <- 16
+	_div    <- 5
+	_sub    <- 6
+	_cmp    <- 7
+	_not    <- 8
+	_sl     <- 9
+	_asr    <- 10
+	_lsr    <- 11
+	_rol    <- 12
+	_ror    <- 13
+	_mov    <- 14
+	_call   <- 15
+	_ret    <- 16
+	_skipif <- 17
+	_save   <- 18
+	_bool   <- 19
 
 	_names <- #[
 		"add"
 		"and"
 		"or"
 		"xor"
+		"mul"
+		"div"
 		"sub"
 		"cmp"
 		"not"
@@ -37,6 +42,7 @@
 		"ret"
 		"skipIf"
 		"save"
+		"bool"
 	]
 
 	op3:a:b:out:size <- :_opcode :_ina :_inb :_out :_size {
@@ -299,6 +305,14 @@
 			op3: _xor a: ina b: inb out: out size: size
 		}
 
+		mul <- :ina inb out size {
+			op3: _mul a: ina b: inb out: out size: size
+		}
+
+		div <- :ina inb out size {
+			op3: _div a: ina b: inb out: out size: size
+		}
+
 		bnot <- :in out size {
 			op2: _not in: in out: out size: size
 		}
@@ -432,6 +446,18 @@
 			}
 		}
 
+		//produces a non-zero value or zero based on condition code flags
+		bool <- :_cond _out {
+			#{
+				opcode <- { _bool }
+				cond <- { _cond }
+				out <- { _code }
+				name <- { _names get: _save }
+				numops <- { 0 }
+
+			}
+		}
+
 		allocRegs:withSource <- :instarr:regSrc {
 			_regMap <- dict linear
 			_argMap <- dict linear
--- /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 <- :{
+
+		}
+	}
+}