// 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)
//   som v5 starts           7 Oct 2009
//   som v5.1 starts         12 Dec 2010
//   public release som v5.1   24 Dec 2010 (Christmas)

// 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 "Mod" 0
	mV "And" 0  mV "Or" 0   mV "Xor" 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 "Not" 0  m2 "Mov" 0  mV "Ldx" 0  mV "Stx" 0
	mV "nop" 0  mV "Push" 0 mC "Call" 0 mC "Calt" 0 mF "Fun" 0
	mV "Ret" 0  mJ "Efor" 0 mY "Case" 0 mJ "Jmp" 0  mJ "Jt" 0
	mJ "Jf" 0   mJ "Jeq" 0  mJ "Jne" 0  mJ "Jlt" 0  mJ "Jle" 0
	mJ "Jgt" 0  mJ "Jge" 0  mW "Sys" 0

// format
//   3-arg   a:16 c:10 op:6, b:32
//   2-arg   d:26 op:6, b:32

: enc2 op d = (d << 6) | op
: enc3 op a c = (a << 16) | ((c & #3ff) << 6) | op

to newv | v = {}
to freev v = {}

to outx a1 a2 =
	lastCP = CP
	CS[CP] = a1
	CS[CP+1] = a2
	CP = CP + 2
	if CP > MAXCS
		seterror "CS area overflow"

to out2 op d b = outx (enc2 op d) b
to outi op a c b = outx (enc3 op a c) b

// check size of arguments and use new reg as necessary
// always use sequence: op a c b (arg as appear in field)

// bop: add..ldx,  ->  mov, op, mov
to outb op a c b | t d =
	t = a
	if a > #0ffff
//		prints "argument is too big > 16 bits" nl
		t = newv
		out2 tMov t a
	if c > #03ff
//		prints "argument is too big > 10 bits" nl
		d = newv
		outx (enc3 op t d) b
		out2 tMov c d
		freev d
	else
		outx (enc3 op t c) b
	if t != a  freev t

// stx, call  ->  mov, mov, op
// jop,jt,jf,jmp,efor,case  chk c
// ret,push,sys  chk a
to outc op a c b | t d =
	t = a
	if a > #0ffff
//		prints "argument is too big > 16 bits" nl
		t = newv
		out2 tMov t a
	if c > #03ff
//		prints "argument is too big > 10 bits" nl
		d = newv
		out2 tMov d c
		outx (enc3 op t d) b
		freev d
	else
		outx (enc3 op t c) b
	if t != a  freev t

: patch ads v = CS[ads] = v
: argAt ads = CS[ads] >> 6
: opAt ads = CS[ads] & 63
: dispAt ads = CS[ads] >> 16
: destAt ads = (CS[ads] >> 6) & #03ff

// pathc field (a), a:16 c:10 op:6
to patchA ads v =
	CS[ads] = (CS[ads] & #0ffff) | (v << 16)

// patch field (d), d:26 op:6
to patchArg ads v =
	CS[ads] = (CS[ads] & #3f) | (v << 6)

// patch field dest (c), a:16 c:10 op:6
to patchC ads v =
	CS[ads] = (CS[ads] & #ffff003f) | (v << 6)

to copyCS a b =		// copy code a <- b
	CS[a] = CS[b]
	CS[a+1] = CS[b+1]

to isLit1 i = and ((opAt i )== tMov) (CS[i+1] == 401)
to isLit0 i = and ((opAt i )== tMov) (CS[i+1] == 400)
to isLogic op =	and (op >= tEq) (op <= tGe)

// short cut jump to ret, jmp to jmp
// cascade macro and/or
to improv | i a c1 c2 a1 a2 c3 a3 d s =
	for i 1 (sizeoflis jplis)
		a = jplis[i]
		if a != 0
			// inst field: (a) op.a.c, (a+1) b   from op c a b
			// ads: (a)c1.a1, to (a1)c2.[a2,d],(a1+2)c3.a3.s
			//      (a-2)c3.a3.d,(a)c1.a1 to (a1)c2.a2.s
			c1 = opAt a		// here (a)
			a1 = dispAt a
			c2 = opAt a1	// target (a1)
			a2 = dispAt a1
			// jmp to ret => ret
			if and (c1 == tJmp) (c2 == tRet)
				copyCS a a1			// code[a] <- code[a1]
				jplis[i] = 0		// delete entry
			// jx to jmp.y => jx.y
			else if c2 == tJmp
				patchA a a2

			// for macro and  (and (and x y) z)
			// jx to lit 0, jf.y => jx.y
			// jx to lit 0, jt.y, $z => jx.z
			else if isLit0 a1
				c3 = opAt a1+2		// jf
				a3 = dispAt a1+2	// y
				s = destAt a1+2		// src of jf
				d = argAt a1		// dest of mov0
				if and (c3 == tJf) (d == s)
					patchA a a3
				else if and (c3 == tJt) (d == s)
					patchA a a1+4

			// to make redundant jmp a nop will be risky
			// in case someone jump there

			// lop.a.d, jmp to jf.y.d, $ -> jinvlog.y.a, jmp.$
			// macro or
			// rule5: mov.d #1, jmp to jf.y.d, $ -> jmp.$
			// rule6: mov.d x,  jmp to jf.y.d, $ -> jf.y.x, jmp.$
			else if and (c1 == tJmp) (c2 == tJf)
				c3 = opAt a-2
				a3 = dispAt a-2
				d = destAt a-2			// dest of lop.a3.d
				s = destAt a1			// src of jf.a2.s
//				if and (isLogic c3) (d == s)
//					patch a-2 (enc3 condJmp[c3-9] a3 a2)
//					patchA a a1+2		// jmp.$
//					addlis jplis a-2
				if and (c3 == tMov) ((argAt a-2) == s)
					if isLit1 a-2		// rule5
						patch a-2 (enc3 tJmp a1+2 0)
						patch a-1 0     // second arg of tJmp
						addlis jplis a-2
					else
						// rule6, src of mov is CS[a-1]
						patch a-2 (enc3 tJf a2 CS[a-1])
						patchA a a1+2	// jmp.$
						patch a+1 0     // second arg of jmp
						addlis jplis a-2

// end of improv

// ---- 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
: prI a = 				// pr integer
	fspace prInt a
: prIm a =				// pr immediate
	prStr " #" 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 ref
	else
		prStr nm

to prV a =
	if and (a >= 390) (a <= 700)	// small constant
		prIm a-400
	else if a >= userDS				// gvar
		prNm a tyGVAR
	else
		prI a

: prCode2 op = prStr op_str+(op*4)+1

// make n to be even
to even n = ((n+1)/2) * 2

// even(hi-lo)
//to sizeJtab a =  even (CS[a+1] - (dispAt a))
to sizeJtab a = CS[a+2]

to prJtab a | n k =
	n = sizeJtab a
	for k a+2 a+n-1
		fnl prInt k fspace  prInt a+CS[k]

to prCode ads | op c a b d =
	op = opAt ads
	if op > EOC op = 0		 // set to nop
	prCode2 op
	d = argAt ads
	b = CS[ads+1]
	c = d & #03ff
	a = d >> 10
	case op_str[op*4]		 		// op type
		mV:							// bop
			prV c  prV a  prV b
		m2:							// 2-arg mov
			prV d  prV b
		mC:							// call
			prNm b tyFUNC
			prV a  prV c
		mF:							// fun
			prNm ads tyFUNC
			prI a  prI c  			// arity fs
		mJ:							// jmp
			prI ads+a  prV c  prV b
		mY:
			prV c  prIm a  prIm b	// case
			prJtab ads
		mW:							// sys
			prIm c  prV b  prV a

to showCode a b | i =
	for i a b
		prInt i fspace
		prCode i fnl
		if (opAt i) == tCase	// skip
			i = i + (sizeJtab i) - 2
		i = i + 1

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

to outCS start end | op i k n =
	for i start end
		prInt i fspace
		op = opAt i
		prInt op fspace
		prInt (destAt i) fspace
		prInt (dispAt i) fspace
		prInt CS[i+1]
		if op == tCase		// print jump table
			n = sizeJtab i
			for k i+2 i+n-1
				fnl prInt k fspace  prInt CS[k]
			i = i + n - 2
		fnl
		i = i + 1
	fnl

to outhead start end =
	prInt start fspace
	prInt end fnl

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

to relocC a disp | v =
	v = destAt a
	if v >= userDS   patchC a v+disp

to relocA a disp | v =
	v = dispAt a
	if v >= userDS   patchA a v+disp

to relocB a disp | v =
	v = CS[a]
	if v >= userDS   patch a v+disp

to relocArg a disp | v =
	v = argAt a
	if v >= userDS   patchArg a v+disp

to relocCode a disp | op a1 =
	op = opAt a
	if op > EOC op = 0		// set to nop
	case op_str[op*4]		// op type
		mV: 				// bop
			relocC a disp
			relocA a disp
			relocB a+1 disp
		mC: 				// call
			relocC a disp
			relocA a disp
		mJ: 				// jump
			relocC a disp
			relocB a+1 disp
		mW: 				// sys
			relocA a disp
			relocB a+1 disp
		m2:					// mov
			relocArg a disp
			relocB a+1 disp
		mY: relocC a disp	// case

// End

