view modules/il.tp @ 185:181d8754a2ae

Initial work on IL module
author Mike Pavone <pavone@retrodev.com>
date Sun, 25 Aug 2013 14:45:00 -0700
parents
children a45e535f7742
line wrap: on
line source

{
	//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"
			}
		}
	}
}