// icode-s.txt
//   public release som v3.0 5 March 2007 (Maka-bucha day)
//   public release som v4.0 2 July 2008
//   public release som v4.1 9 Aug 2008 (Birthday)

// print string of opcode, each entry 4
//   type (1), string (len 3)
//   keeping all attributes in one table for consistency
op_str = array
  mV "nop" 0
  mV "Add" 0  mV "Sub" 0  mV "Mul" 0  mV "Div" 0  mV "Band" 0
  mV "Bor" 0  mV "Bxor" 0 mV "Mod" 0  mV "Eq" 0   mV "Ne" 0
  mV "Lt" 0   mV "Le" 0   mV "Gt" 0   mV "Ge" 0   mV "Shl" 0
  mV "Shr" 0  mV "Addi" 0 mV "Subi" 0 mV "Bandi"  mV "Bori" 0
  mV "Eqi" 0  mV "Lti" 0  mV "Lei" 0  mV "Shli" 0 mV "Shri" 0
  mV "Inc" 0  mV "Dec" 0  mV "Lit" 0  mV "Sys" 0  mV "Not" 0
  mV "Push" 0 mV "Get" 0  mV "Put" 0  mG "Ld" 0   mG "St" 0
  mV "Ldxa" 0 mG "Ldya" 0 mC "Call" 0 mV "Ret" 0  mC "Callt"
  mJ "Jmp" 0  mJ "Jt" 0   mJ "Jf" 0   mV "Case" 0 mW "Ldx" 0
  mW "Stx" 0  mY "Ldy" 0  mY "Sty" 0  mW "Jle" 0  mF "Fun" 0

: chkCS =
	if CP > MAXCS
		seterror "CS area overflow"

to enc2 a1 a2 = (a1 << 8) + a2

to outa op arg =
	lastCP = CP
	CS[CP] = op
	CS[CP+1] = arg
	CP = CP + 2
	chkCS

to out3 op a1 a2 =
	outa op (enc2 a1 a2)

// change arg, perserve code
: patch ads v = CS[ads+1] = v
: argAt ads = CS[ads+1]

to isLit1 i =
	and (CS[i] == icLit) (CS[i+1] == 1)

to isLit0 i =
	and (CS[i] == icLit) (CS[i+1] == 0)

// short cut jump to ret, jmp to jmp
// cascade macro and/or, while 1
to improv | i a c1 a2 c2 d2 c3 a3 =
	for i 1 (sizeoflis jplis)
		a = jplis[i]
		if a != 0
			c1 = CS[a]
			a2 = argAt a
			c2 = CS[a2]
			d2 = argAt a2
			a3 = a-2		// at previous op
			// jmp to ret => ret
			if and (c1 == icJmp) (c2 == icRet)
				CS[a] = icRet
				patch a d2
				jplis[i] = 0		// delete entry
			// jx to jmp.y => jx.y
			else if c2 == icJmp
				patch a d2

			// for macro and
			// jx to lit 0, jf.y => jx.y
			// jx to lit 0, jt.y, $z => jx.z
			else if isLit0 a2
				c3 = CS[a2+2]
				if c3 == icJf
					patch a (argAt a2+2)
				else if c3 == icJt
					patch a a2+4

			// for macro or
			// 1) cascade
			// lit 1, jmp.x to jf, lit 1, jf, $z => lit 1, jmp.z
			// 2) or with other
			// lit 1, jmp.x to jf, $z ... => jmp.z
			//   check lit 1
			else if isLit1 a3
				if and (c1 == icJmp) (c2 == icJf)
					// 1) cascade or
					if and (isLit1 a2+2) (CS[a2+4] == icJmp)
						patch a (argAt a2+4)
					// 2) or with other
					else
						CS[a3] = icJmp
						patch a3 a2+2
						addlis jplis a3
						jplis[i] = 0	// delete entry
				// while 1
				// lit 1, jt.y => jmp.y, jt.y
				else if c1 == icJt
					CS[a3] = icJmp
					patch a3 a2
					addlis jplis a3
					jplis[i] = 0		// delete entry
				// to make redundant jmp a nop will be risky
				// in case someone jump there

// ---- listing functions -------

// Use a hash table to store exsym by ref/type
// do hashSym first

enum
	599  hSymsize

// find Sym by ref/type, hash with linear probe
to findSym ref ty | idx i key =
	idx = ref % hSymsize
	i = idx
	while 1
		key = hSym[i]
		if key == 0 	// new
			break
		if and (ref == (getRef key)) (ty == (getType key))
			break
		i = (i+1) % hSymsize
		if i == idx		// wrap around
			seterror "h-table full" // impossible case
	i

// initialise
to hashSym | i idx k =
	nxsym = getExportSym exsym
	for i 0 nxsym-1
		k = exsym[i]
		idx = findSym (getRef k) (getType k)
		hSym[idx] = k  // insert, duplicate if found

// find name by ref and type
// return name, 0 if not found
to findName2 ref ty | i idx =
	i = findSym ref ty
	idx = hSym[i]
	if idx != 0
		getName idx
	else
		0

// -------------------

: prInt a =	fprint FO a
: prStr s = fprints FO s
: pr2 a =
	fspace prInt a

// search symbol table for name with idx
to prNm ref ty | nm =
	fspace
	nm = findName2 ref ty
	if or (nm == 0) ((strlen nm) > 5)
		prInt nm
	else
		prStr nm

: prCode2 op = prStr op_str+(op*4)+1
: first a = a >> 8
: second a = a & 255

to prCode a | op arg =
	op = CS[a]
	if op > EOC op = 0		 // set to nop
	prCode2 op
	arg = CS[a+1]
	case op_str[op*4]		 // op type
		mG: prNm arg tyGVAR
		mC: prNm arg tyFUNC
		mF:
			prNm a tyFUNC
			pr2 (first arg)  // arity
		mY:
			prNm (first arg) tyGVAR
			pr2 (second arg)
		mW:
			pr2 (first arg)
			pr2 (second arg)
		else:
			pr2 arg

to showCode a b | i op =
	for i a b
		prInt i fspace
		prCode i fnl
		i = i + 1

to outM mem start end | i =
	for i start end
		prInt mem[i] fspace
		if (i % 10) == 0 fnl
	fnl

to outhead start end =
	prInt start fspace
	prInt end fnl

// End

