view modules/il.tp @ 243:5b830147c1cd

Use a lightweight substring object in a few places in the parser to improve performance for large files.
author Mike Pavone <pavone@retrodev.com>
date Sun, 05 Jan 2014 23:07:26 -0800
parents 56b2100d9fff
children 2308336790d4
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
	_save   <- 16

	_names <- #[
		"add"
		"and"
		"or"
		"xor"
		"sub"
		"cmp"
		"not"
		"sl"
		"asr"
		"lsr"
		"rol"
		"ror"
		"mov"
		"call"
		"ret"
		"skipIf"
		"save"
	]

	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) }
			recordUsage:at <- :tracker :address {
				if: (not: (_ina isInteger?)) {
					_ina recordUsage: tracker at: 0 | address withSize: _size
				}
				_inb recordUsage: tracker at: 0 | address withSize: _size
				_out recordUsage: tracker at: 1 | address withSize: _size
			}
			assignRegs:at:withSource:andUsage <- :assignments :at :regSrc :usage {
				newa <- if: (not: (_ina isInteger?)) {
					_ina assign: assignments withSource: regSrc
				} else: { _ina }
				newb <- _inb assign: assignments withSource: regSrc
				newout <- _out assign: assignments withSource: regSrc
				op3: _opcode a: newa b: newb out: newout size: _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) }
			recordUsage:at <- :tracker :address {
				if: (not: (_in isInteger?)) {
					_in recordUsage: tracker at: 0 | address withSize: _size
				}
				_out recordUsage: tracker at: 1 | address withSize: _size
			}
			assignRegs:at:withSource:andUsage <- :assignments :at :regSrc :usage {
				newin <- if: (not: (_in isInteger?)) {
					_in assign: assignments withSource: regSrc
				} else: { _in }
				newout <- _out assign: assignments withSource: regSrc
				op2: _opcode in: newin out: newout size: _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) }
			recordUsage:at <- :tracker :address {
				if: (not: (_arg isInteger?)) {
					_arg recordUsage: tracker at: address withSize: _size
				}
			}
			assignRegs:at:withSource:andUsage <- :assignments :at :regSrc :usage {
				newarg <- if: (not: (_arg isInteger?)) {
					_arg assign: assignments withSource: regSrc
				} else: { _arg }
				op1: _opcode arg: newarg size: _size
			}
		}
	}

	_sizenames <- #["b" "w" "l" "q"]
	_size <- :_bytes {
		#{
			bytes <- { _bytes }
			string <- {
				idx <- if: _bytes = 8 { 3 } else: { _bytes / 2}
				_sizenames get: idx
			}
			= <- :other {
				_bytes = (other bytes)
			}
			<= <- :other {
				_bytes <= (other bytes)
			}
			>= <- :other {
				_bytes >= (other bytes)
			}
			> <- :other {
				_bytes > (other bytes)
			}
			< <- :other {
				_bytes < (other bytes)
			}
		}
	}
	byte <- _size: 1
	word <- _size: 2
	long <- _size: 4
	quad <- _size: 8

	_retr <- #{
		isInteger? <- { false }
		register? <- { true }
		argument? <- { false }
		return? <- { true }
		string <- { "retr" }
		= <- :other {
			(not: (other isInteger?)) && (other register?) && (other return?)
		}
		!= <- :other {
			not: self = other
		}
		recordUsage:at:withSize <- :tracker :address :size {
			//TODO: Figure out what tracking is necessary here
		}
		assign:withSource <- :assignments :regSrc {
			regSrc allocRet
		}
	}

	_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)
				}
				!= <- :other {
					not: self = other
				}
				recordUsage:at:withSize <- :tracker :address :size {
					tracker reg: self usedAt: address withSize: size
				}
				assign:withSource <- :assignments :regSrc {
					assignments get: self
				}
			}
		}
		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)
				}
				!= <- :other {
					not: self = other
				}
				recordUsage:at:withSize <- :tracker :address :size {
					tracker arg: self usedAt: address withSize: size
				}
				assign:withSource <- :assignments :regSrc {
					regSrc allocArg: num
				}
			}
		}
		retr <- { _retr }

		base:offset <- :_base :_offset {
			#{
				base <- { _base }
				offset <- { _offset }
				string <- {
					start <- if: _offset = 0 { "" } else: { (string: _offset) }
					start . "[" . (string: _base) . "]"
				}
				recordUsage:at:withSize <- :tracker :address :size {
					_base recordUsage: tracker at: address withSize: size
				}
			}
		}

		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: " ")
				}
				recordUsage:at <- :tracker :address {
					if: (not: (_target isString?)) {
						//TODO: use size l for 32-bit targets or an abstract pointer size
						_target recordUsage: tracker at: address withSize: q
					}
					foreach: _args :_ arg {
						//TODO: have some mechanism for properly expressing sizes of arguments
						arg recordUsage: tracker at: address withSize: q
					}
				}
				assignRegs:at:withSource:andUsage <- :assignments :address :regSrc :usage {
					newtarget <- if: (_target isString?) { _target } else: {
						_target assign: assignments withSource: regSrc
					}
					newargs <- _args map: :arg {
						if: (arg isInteger?) { arg } else: {
							arg assign: assignments withSource: regSrc
						}
					}
					newcall <- call: newtarget withArgs: newargs
					regSrc returnAll
					raddress <- address reverse
					foreach: (usage liveArgsAt: raddress) :_ arg {
						regSrc allocArg: (arg num)
					}
					foreach: (usage liveRegsAt: raddress) :_ reg {
						regSrc allocSpecific: (assignments get: reg)
					}
					tosave <- regSrc needSaveForCall
					if: (tosave length) > 0 {
						save: tosave #[newcall]
					} else: {
						newcall
					}
				}
			}
		}

		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 .  "}"
				}
				recordUsage:at <- :tracker :address {
					foreach: _toskip :idx inst {
						inst recordUsage: tracker at: idx | address
					}
				}
				assignRegs:at:withSource:andUsage <- :assignments :address :regSrc :usage {
					newskip <- #[]
					foreach: _toskip :idx inst {
						newskip append: (inst assignRegs: assignments at: idx | address  withSource: regSrc andUsage: usage)
					}
					skipIf: _cond newskip
				}
				to2OpInst <- {
					skipIf: _cond (to2Op: _toskip)
				}
			}
		}
		save <- :regs :_scope{
			#{
				opcode <- { _save }
				numops <- { 0 }
				name <- { _names get: _save }
				tosave <- { regs }
				scope <- { _scope }
				string <- {
					block <- _scope join: "\n\t"
					if: (_scope length) > 0 {
						block <- "\n\t" . block . "\n"
					}
					name . " " . (regs join: " ") . " {" . block . "}"
				}
				to2OpInst <- {
					save: regs (to2Op: _scope)
				}
			}
		}

		allocRegs:withSource <- :instarr:regSrc {
			_regMap <- dict linear
			_argMap <- dict linear

			_usageTracker <- :_firstUsage {
				#{
					firstUsage <- _firstUsage
					lastUsage <- _firstUsage
					useCount <- 0
					maxSize <- byte
					usedAt:withSize <- :address :size {
						useCount <- useCount + 1
						lastUsage <- address
						if: size > maxSize {
							maxSize <- size
						}
					}
					string <- {
						"Uses: " . useCount . ", FirstUse: " . (firstUsage join: ":") . ", Last Use: " . (lastUsage join: ":") . ", Max Size: " . maxSize
					}
				}
			}

			_maxUses <- 0
			liveFrom:to <- :regs :from :to {
				live <- #[]
				foreach: regs :reg usage {
					if: ((usage lastUsage) addrGreatEq: from) && ((usage firstUsage) addrLessEq: to) {
						live append: reg
					}
				}
				live
			}
			regUsage <- #{
				reg:usedAt:withSize <- :reg :address :size {
					raddress <- address reverse
					usage <- _regMap get: reg elseSet: {
						_usageTracker: raddress
					}
					usage usedAt: raddress withSize: size
					if: (usage useCount) > _maxUses {
						_maxUses <- usage useCount
					}
				}
				arg:usedAt:withSize <- :arg :address :size {
					raddress <- address reverse
					usage <- _argMap get: arg elseSet: {
						_usageTracker: [0 0]
					}
					usage usedAt: raddress withSize: size
				}

				liveRegsAt <- :address {
					_regMap liveFrom: address to: address
				}
				liveArgsAt <- :address {
					_argMap liveFrom: address to: address
				}

				print <- {
					foreach: _regMap :reg usage {
						print: (string: reg) . " | " . (string: usage) . "\n"
					}
					foreach: _argMap :arg usage {
						print: (string: arg) . " | " . (string: usage) . "\n"
					}
				}
			}
			foreach: instarr :idx inst {
				inst recordUsage: regUsage at: [idx]
			}
			print: regUsage

			addrLessEq <- :left :right {
				lesseq <- true
				while: { lesseq && (not: (left empty?)) && (not: (right empty?)) } do: {
					if: (left value) > (right value) {
						lesseq <- false
					} else: {
						if:  (left value) < (right value) {
							left <- []
						} else: {
							left <- left tail
							right <- right tail
						}
					}
				}
				lesseq
			}

			addrGreatEq <- :left :right {
				greateq <- true
				while: { greateq && (not: (left empty?)) && (not: (right empty?)) } do: {
					if: (left value) < (right value) {
						greateq <- false
					} else: {
						if:  (left value) > (right value) {
							left <- []
						} else: {
							left <- left tail
							right <- right tail
						}
					}
				}
				greateq
			}

			_assignments <- dict linear
			curuses <- _maxUses
			while: { curuses > 0 && (_assignments length) < (_regMap length) } do: {
				foreach: _regMap  :reg usage {
					if: (usage useCount) = curuses {
						liveArgs <- _argMap liveFrom: (usage firstUsage) to: (usage lastUsage)
						foreach: liveArgs :_ arg {
							regSrc allocArg: (arg num)
						}

						liveRegs <- _regMap liveFrom: (usage firstUsage) to: (usage lastUsage)
						print: (string: reg) . " | Live: " . (liveRegs join: ", ") . ", Live Args: " . (liveArgs join: ", ") . "\n"
						foreach: liveRegs :_ reg {
							if: (_assignments contains?: reg) {
								regSrc allocSpecific: (_assignments get: reg)
							}
						}
						_assignments set: reg (regSrc alloc: (usage maxSize))

						regSrc returnAll
					}
				}
				curuses <- curuses - 1
			}
			print: "\n\nAssignments:\n\n"
			foreach: _assignments :reg assign {
				print: (string: reg) . " = " . assign . "\n"
			}

			withassign <- #[]
			foreach: instarr :idx inst {
				withassign append: (inst assignRegs: _assignments at: [idx] withSource: regSrc andUsage: regUsage)
			}
			psave <- regSrc needSaveProlog
			if: (psave length) > 0 {
				withassign <- #[save: psave withassign]
			}
			withassign
		}

		//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: {
						if: (inst opcode) = _skipif || (inst opcode) = _save {
							newarr append: (inst to2OpInst)
						} else: {
							newarr append: inst
						}
					}
				}
			}
		}

		toBackend <- :program :backend {
			prepped <- program map: :fun {
				backend adjustIL: fun
			}
			labels <- prepped map: :_ {
				backend label
			}
			outprog <- #[]
			foreach: prepped :name instarr {
				outprog append: (labels get: name)
				foreach: instarr :_ inst {
					backend convertIL: inst to: outprog withLabels: labels
				}
			}
			outprog
		}

		main <- {
			prog <- dict linear

			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"
			}
			prog set: "fib" fib

			mprog <- prog toBackend: x86
			ba <- bytearray executableFromBytes: mprog
			res <- ba runWithArg: 30u64
			print: (string: res) . "\n"
			0
		}
	}
}