// 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)
//   public release som v5.0 5 Dec 2009    (Long live the King)

// print string of opcode, each entry 4
//   type (1), string (len 3)
//   keeping all attributes in one table for consistency
op_str = array
    mG "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  mV "Mov" 0  mV "Ldx" 0  mV "Stx" 0
    mG "nop" 0  mV "Push" 0 mC "Call" 0 mC "Calt" 0 mF "Fun" 0
    mG "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

: enc2 a1 a2 = (a1 << 8) | a2

to outc op a1 a2 a3 =
    lastCP = CP
    CS[CP] = enc2 a1 op
    CS[CP+1] = a2
    CS[CP+2] = a3
    CP = CP + 3
    if CP > MAXCS
        seterror "CS area overflow"

: patch ads v = CS[ads] = v
: argAt ads = CS[ads] >> 8
: opAt ads = CS[ads] & 255

to patchArg ads v =
    CS[ads] = enc2 v (opAt ads)

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

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 v =
    for i 1 (sizeoflis jplis)
        a = jplis[i]
        if a != 0
            c1 = opAt a		// here
            a1 = argAt a
            c2 = opAt a1	// target
            a2 = argAt 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
                patchArg 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+3		// next inst.
                a3 = argAt a1+3
                if and c3 == tJf  a2 == CS[a1+4]  // same arg
                    patchArg a a3
                else if and c3 == tJt  a2 == CS[a1+4]
                    patchArg a a1+6

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

            // logic jmp to jf.y $ -> jinvlog.y jmp.$
            // macro or
            // rule6: mov rv x, jmp to jf.y,$ -> jf.y x, jmp.$
            // rule5: if x is #1 -> jf.y #1 -> jmp.$
            else if and (c1 == tJmp) (c2 == tJf)
                c3 = opAt a-3
                a3 = argAt a-3
                v = CS[a1+1]			// Jf.y v
                if and (isLogic c3) (v == a3)
                    patch a-3 (enc2 a2 condJmp[c3-9])
                    patchArg a a1+3
                    addlis jplis a-3
                if and (c3 == tMov) (v == a3)
                    if isLit1 a-3		// mov v #1
                        patch a-3 (enc2 a1+3 tJmp)  // rule5
                        addlis jplis a-3
                    else
                        patch a-3 (enc2 a2 tJf)
                        patchArg a a1+3				// rule6
                        addlis jplis a-3

// 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

to pr2 a1 a2 =
    prI a1  prI a2

// 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

to prV2 a1 a2 =
    prV a1  prV a2

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

to sizeJtab a = CS[a+2] - CS[a+1] + 1	// hi-lo+1

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

to prCode a | op arg a1 a2 =
    op = opAt a
    if op > EOC op = 0		 // set to nop
    prCode2 op
    arg = argAt a
    a1 = CS[a+1]
    a2 = CS[a+2]
    case op_str[op*4]		 		// op type
        mV:							// bop
            prV arg  prV2 a1 a2
        mG:							// generic
            prI arg  pr2 a1 a2
        mC:							// call
            prV2 arg a1
            prNm a2 tyFUNC
        mF:							// fun
            pr2 arg a1  			// arity fs
            prNm a tyFUNC
        mJ:							// jmp
            prI a+arg  prV2 a1 a2
        mY:
            prV arg					// case
            prIm a1  prIm a2
            prJtab a
        mW:							// sys
            prIm arg  prV2 a1 a2

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

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 arg i k n =
    for i start end
        prInt i fspace
        op = opAt i
        prInt op fspace
        prInt (argAt i) fspace
        prInt CS[i+1] fspace
        prInt CS[i+2]
        if op == tCase		// print jump table
            n = sizeJtab i
            for k i+3 i+3+n-1
                fnl prInt k fspace  prInt CS[k]
            i = i + n
        fnl
        i = i + 2
    fnl

to outhead start end =
    prInt start fspace
    prInt end fnl

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

to reloc1 a disp | arg =	// reloc arg
    arg = argAt a
    if arg >= userDS
        patchArg a arg+disp

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

to reloc2 a disp =			// reloc a1 a2
    reloca a+1 disp
    reloca a+2 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
            reloc1 a disp
            reloc2 a disp
        mC: 				// call
            reloc1 a disp
            reloca a+1 disp
        mJ: reloc2 a disp	// jump
        mY: reloc1 a disp	// case
        mW: reloc2 a disp	// sys

// End

