view modules/il.tp @ 251:2557ce4e671f

Fix a couple of compiler bugs. topenv was getting initialized in multiple places. This resulted in multiple copies of modules getting created which caused problems for macro expansion. Additionally, arguments were not being marked as declared during code generation so assigning to an argument that was not closed over generated invalid C code.
author Michael Pavone <pavone@retrodev.com>
date Fri, 11 Apr 2014 22:29:32 -0700
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
		}
	}
}