# HG changeset patch
# User Mike Pavone <pavone@retrodev.com>
# Date 1377467100 25200
# Node ID 181d8754a2ae02d1c6b93cba121b1905cf7f1b13
# Parent  ca249978ae96b5f7a69895f5cdfe2c9555d78e32
Initial work on IL module

diff -r ca249978ae96 -r 181d8754a2ae modules/il.tp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/modules/il.tp	Sun Aug 25 14:45:00 2013 -0700
@@ -0,0 +1,333 @@
+{
+	//commutative ops
+	_add    <- 0
+	_and    <- 1
+	_or     <- 2
+	_xor    <- 3
+	//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
+
+	_names <- #[
+		"add"
+		"and"
+		"or"
+		"xor"
+		"sub"
+		"cmp"
+		"not"
+		"sl"
+		"asr"
+		"lsr"
+		"rol"
+		"ror"
+		"mov"
+		"call"
+		"ret"
+		"skipIf"
+	]
+
+	op3:a:b:out:size <- :_opcode :_ina :_inb :_out :_size {
+		#{
+			opcode <- { _opcode }
+			ina <- { _ina }
+			inb <- { _inb }
+			commutative? <- { _opcode < _sub }
+			out <- { _out }
+			size <- { _size }
+			numops <- { 3 }
+			name <- { _names get: _opcode }
+			string <- { name . " " . (string: _ina) . " " . (string: _inb) . " " . (string: _out) . " " . (string: _size) }
+		}
+	}
+	op2:in:out:size <- :_opcode :_in :_out :_size {
+		#{
+			opcode <- { _opcode }
+			in <- { _in }
+			out <- { _out }
+			size <- { _size }
+			numops <- { 2 }
+			name <- { _names get: _opcode }
+			string <- { name . " " . (string: _in) . " " . (string: _out) . " " . (string: _size) }
+		}
+	}
+	op1:arg:size <- :_opcode :_arg :_size {
+		#{
+			opcode <- { _opcode }
+			arg <- { _arg }
+			size <- { _size }
+			numops <- { 1 }
+			name <- { _names get: _opcode }
+			string <- { name . " " . (string: _arg) . " " . (string: _size) }
+		}
+	}
+
+	_sizenames <- #["b" "w" "l" "q"]
+	_size <- :_num {
+		#{
+			num <- { _num }
+			string <- { _sizenames get: _num }
+			= <- :other {
+				_num = (other num)
+			}
+			<= <- :other {
+				_num <= (other num)
+			}
+			>= <- :other {
+				_num >= (other num)
+			}
+			> <- :other {
+				_num > (other num)
+			}
+			< <- :other {
+				_num < (other num)
+			}
+		}
+	}
+	byte <- _size: 0
+	word <- _size: 1
+	long <- _size: 2
+	quad <- _size: 3
+
+	_retr <- #{
+		isInteger? <- { false }
+		register? <- { true }
+		argument? <- { false }
+		return? <- { true }
+		string <- { "retr" }
+		= <- :other {
+			(not: (other isInteger?)) && (other register?) && (other return?)
+		}
+	}
+
+	_condnames <- #[
+		"eq"
+		"neq"
+		"ge"
+		"le"
+		"gr"
+		"ls"
+		"uge"
+		"ule"
+		"ugr"
+		"uls"
+	]
+	condition <- :num {
+		#{
+			cc <- { num }
+			string <- { _condnames get: num }
+			= <- :other { num = (other cc) }
+		}
+	}
+	_eq <- condition: 0
+	_neq <- condition: 1
+	_ge <- condition: 2
+	_le <- condition: 3
+	_gr <- condition: 4
+	_ls <- condition: 5
+	_uge <- condition: 6
+	_ule <- condition: 7
+	_ugr <- condition: 8
+	_uls <- condition: 9
+
+	#{
+		b <- { byte }
+		w <- { word }
+		l <- { long }
+		q <- { quad }
+
+		eq <- { _eq }
+		neq <- { _neq }
+
+		//signed conditions
+		ge <- { _ge }
+		le <- { _le }
+		gr <- { _gr }
+		ls <- { _ls }
+
+		//unsigned conditions
+		uge <- { _uge }
+		ule <- { _ule }
+		ugr <- { _ugr }
+		uls <- { _uls }
+
+
+		reg <- :num {
+			#{
+				isInteger? <- { false }
+				register? <- { true }
+				argument? <- { false }
+				return? <- { false }
+				regnum <- { num }
+				string <- { "r" . (string: num) }
+				= <- :other {
+					(not: (other isInteger?)) && (other register?) && (not: (other argument?)) && (not: (other return?)) && num = (other regnum)
+				}
+			}
+		}
+		arg <- :num {
+			#{
+				isInteger? <- { false }
+				register? <- { true }
+				argument? <- { true }
+				return? <- { false }
+				argnum <- { num }
+				string <- { "a" . (string: num) }
+				= <- :other {
+					(not: (other isInteger?)) && (other register?) && (other argument?)  && num = (other regnum)
+				}
+			}
+		}
+		retr <- { _retr }
+
+		add <- :ina inb out size {
+			op3: _add a: ina b: inb out: out size: size
+		}
+
+		sub <- :ina inb out size {
+			op3: _sub a: ina b: inb out: out size: size
+		}
+
+		cmp <- :ina inb out size {
+			op3: _cmp a: ina b: inb out: out size: size
+		}
+
+		and <- :ina inb out size {
+			op3: _and a: ina b: inb out: out size: size
+		}
+
+		or <- :ina inb out size {
+			op3: _or a: ina b: inb out: out size: size
+		}
+
+		xor <- :ina inb out size {
+			op3: _xor a: ina b: inb out: out size: size
+		}
+
+		bnot <- :in out size {
+			op2: _not in: in out: out size: size
+		}
+
+		sl <- :shift in out size {
+			op3: _sl a: shift b: in out: out size: size
+		}
+
+		asr <- :shift in out size {
+			op3: _asr a: shift b: in out: out size: size
+		}
+
+		lsr <- :shift in out size {
+			op3: _lsr a: shift b: in out: out size: size
+		}
+
+		rol <- :rot in out size {
+			op3: _rol a: rot b: in out: out size: size
+		}
+
+		ror <- :rot in out size {
+			op3: _ror a: rot b: in out: out size: size
+		}
+
+		mov <- :in out size {
+			op2: _mov in: in out: out size: size
+		}
+
+		call:withArgs <- :_target :_args {
+			#{
+				opcode <- { _call }
+				target <- { _target }
+				args <- { _args }
+				numops <- { 0 }
+				name <- { _names get: _call }
+				string <- {
+					argstr <- _args map: :el {
+						string: el
+					}
+					name . " " . (string: _target) . " " . (argstr join: " ")
+				}
+			}
+		}
+
+		return <- :val size {
+			op1: _ret arg: val size: size
+		}
+		skipIf <- :_cond _toskip {
+			#{
+				opcode <- { _skipif }
+				toskip <- { _toskip }
+				cond <- { _cond }
+				numops <- { 0 }
+				name <- { _names get: _skipif }
+				string <- {
+					block <- (_toskip map: :el { string: el }) join: "\n\t"
+					if: (_toskip length) > 0 {
+						block <- "\n\t" . block . "\n"
+					}
+					name . " " . (string: _cond) . " {" . block .  "}"
+				}
+			}
+		}
+
+		//used to convert IL to a format suitable for a 2-operand architecture
+		//should be run after register allocation (I think....)
+		to2Op <- :instarr {
+			instarr fold: #[] with: :newarr inst {
+				if: (inst numops) = 3 {
+					if: (inst inb) = (inst out) {
+						newarr append: (op2: (inst opcode) in: (inst ina) out: (inst out) size: (inst size))
+					} else: {
+						if: (inst commutative?) && (inst ina) = (inst out) {
+							newarr append: (op2: (inst opcode) in: (inst inb) out: (inst out) size: (inst size))
+						} else: {
+							newarr append: (mov: (inst inb) (inst out) (inst size))
+							newarr append: (op2: (inst opcode) in: (inst ina) out: (inst out) size: (inst size))
+						}
+					}
+				} else: {
+					if: (inst numops) = 2 && (inst opcode) != _mov {
+						if: (inst in) != (inst out) {
+							newarr append: (mov: (inst in) (inst out) (inst size))
+						}
+						newarr append: (op1: (inst opcode) val: (inst out) size: (inst size))
+					} else: {
+						newarr append: inst
+					}
+				}
+			}
+		}
+
+		main <- {
+			fib <- #[
+				sub: 2 (arg: 0) (reg: 0) q
+				skipIf: ge #[
+					return: 1 q
+				]
+				call: "fib" withArgs: #[reg: 0]
+				mov: retr (reg: 1) q
+				add: 1 (reg: 0) (reg: 2) q
+				call: "fib" withArgs: #[reg: 2]
+				add: retr (reg: 1) (reg: 3) q
+				return: (reg: 3) q
+			]
+			print: "Original:\n\n"
+			foreach: fib :idx inst {
+				print: (string: inst) . "\n"
+			}
+			fib2 <- to2Op: fib
+			print: "\n\n2-Operand:\n\n"
+			foreach: fib2 :idx inst {
+				print: (string: inst) . "\n"
+			}
+		}
+	}
+}