// icode-s.txt
//   public release som-v2  30 December 2004
//   public release som-v24 10 January 2007

to outa code arg =
	CS[CP] = (arg << 8) | (code & 255)
	CP = CP + 1
	if (CP >= MAXCS) | (CP < 0)
		seterror "CS area overflow"

: outs code = outa code 0

// change arg, perserve code
to patch ads v =
	CS[ads] = (v << 8) | (CS[ads] & 255)

to putcode ip code data =
	CS[ip] = (data << 8) | (code & 255)

to isJmp op =
	(op == icJmp) | (op == icJt) | (op == icJf)

to reName fn | i c d lvar ref =
	lvar = getLv fn
	ref = getRef fn
	for i ref+1 CP-1
		c = CS[i] & 255
		d = CS[i] >> 8
		if (c==icGet) | (c==icPut) | (c==icInc) | (c==icDec)
			patch i lvar-d+1

// do small improvement, short cut jmp to jmp, jmp to ret
// presently, it is not used
//to improve2 ref | i c1 d1 c2 d2 =
//	// replace jmp to ret, jmp to jmp
//	for i ref+1 CP-1
//		c1 = CS[i] & 255
//		d1 = CS[i] >> 8
//		if isJmp c1
//			c2 = CS[i+d1] & 255
//			d2 = CS[i+d1] >> 8
//			if (c1==icJmp) & (c2==icRet)
//				putcode i icRet d2
//			else
//				if c2 == icJmp
//					patch i d1+d2

// ref at "ret"
to tailCall2 ref | i ref2 c d c1 d1 arg =
	ref2 = getRef currentf
	d = CS[ref] >> 8		// ret d
	c1 = CS[ref-1] & 255	// call
	d1 = CS[ref-1] >> 8
	if (c1 == icCall) & (d1 == ref2)
		prints "tail call" nl
		arg = getArity currentf
		CP = ref - 1
		for i 1 arg			// pass param
			outa icPut (arg-i+1)
		outa icJmp (ref2-CP+1)
		outa icRet d		// necessary !
		// correct jump to ref
		for i ref2 ref-1
			c = CS[i] & 255
			d = CS[i] >> 8
			if (isJmp c) & ((d+i) == ref)
				patch i (CP-1-i)

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

// find name by ref, must getExportSym first
// return name
to findName2 ref | i a k =
	a = 0
	for i 0 nxsym-1
		k = exsym[i]
		if (getRef k) == ref
			a = getName k
			break
	a

// print string of opcode, len 3 each
op_str = array
	"Undef" "Add" 0 "Sub" 0 "Mul" 0 "Div" 0 "Band" 0 "Bor" 0
	"Bxor" 0 "Not" 0 "Eq" 0 "Ne" 0 "Lt" 0 "Le" 0 "Ge" 0 "Gt" 0
	"Shl" 0 "Shr" 0 "Mod" 0 "Ldx" 0 "Stx" 0 "Ret" 0 "Undef" "Array"
	"End" 0 "Get" 0 "Put" 0 "Ld" 0 "St" 0 "Jmp" 0 "Jt" 0 "Jf" 0
	"Lit" 0 "Call" 0 "Undef" "Inc" 0 "Dec" 0 "Sys" 0 "Case" 0
	"Fun" 0 "Calli" "Ads" 0

: prStr s1 = fprints FO s1
: prInt x = fprint FO x

to pr2 a =
	fspace prInt a

// search symbol table for name with ref
to prNm ref | nm =
	fspace
	nm = findName2 ref
	if nm == 0
		prInt ref
	else
		prStr nm

to prCode a | op arg =
	op = CS[a] & 255
	arg = CS[a] >> 8
	if op >= EOC op = 0		// set to undef
	prStr op_str+(op*3)
	case op
		icRet: pr2 arg
		icGet: pr2 arg
		icPut: pr2 arg
		icLd: prNm arg
		icSt: prNm arg
		icJmp: pr2 a+arg
		icJt: pr2 a+arg
		icJf: pr2 a+arg
		icLit: pr2 arg
		icCall: prNm arg
		icInc: pr2 arg
		icDec: pr2 arg
		icSys: pr2 arg
		icFun: prNm a
		icCalli: pr2 arg
		icAds: pr2 arg

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

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

to outhead start end =
	prInt start fspace
	prInt end fnl

// End
