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

// 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 "Addi" 0
  mV "Subi" 0 mV "Shli" 0 mV "Shri" 0 mV "Inc" 0 mV "Dec" 0
  mV "Lit" 0  mV "Ads" 0  mV "Sys" 0  mV "Not" 0 mV "Push" 0
  mV "Pusha"  mV "Get" 0  mV "Put" 0  mG "Ld" 0  mG "St" 0
  mC "Call" 0 mV "Ret" 0  mC "Callt"  mJ "Jmp" 0 mJ "Jt" 0
  mJ "Jf" 0   mW "Jle" 0  mW "Case" 0 mW "Ldx" 0 mW "Stx" 0
  mY "Ldy" 0  mY "Sty" 0  mF "Fun" 0

: out x =
    CS[CP] = x
    CP = CP + 1

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

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

to outa op arg =
    lastCP = CP
    out op  out arg  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 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
            else if and (isLit0 a2) (CS[a2+2] == icJf)
                patch a (argAt a2+2)
            // for macro or
            // 1) cascade
            // lit 1, jmp.x to jf, lit 1, $z => lit 1, jmp.z
            // 2) or with other
            // lit 1, jmp.x to jf, $z ... => jmp.z, jmp.x
            //   check lit 1
            else if isLit1 a3
                if and (c1 == icJmp) (c2 == icJf)
                    // 1) cascade or
                    if isLit1 a2+2
                        patch a 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

to prCode a | op arg a1 a2 =
    op = CS[a]
    if op > EOC op = 0		 // set to nop
    prCode2 op
    arg = CS[a+1]
    a1 = arg >> 8
    a2 = arg & 255
    case op_str[op*4]		 // op type
        mG: prNm arg tyGVAR
        mC: prNm arg tyFUNC
        mF:
            prNm a tyFUNC  pr2 a1  // arity
        mY:
            prNm a1 tyGVAR  pr2 a2
        mW:
            pr2 a1  pr2 a2
        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

