// icode-s.txt
//   public release som-v2  30 December 2004
//   public release som-v24 10 January 2007
//   public release som v3.0 5 March 2007 (Maka-bucha day)
//   xop[] xarg[] for som v3.1  15 Aug 2007

to outa code arg =
    XOP[CP] = code
    XARG[CP] = arg
    CP = CP + 1
    if (CP > MAXCS)
        seterror "CS area overflow"

// change arg, perserve code
: patch ads v = XARG[ads] = v

to reName fn | i j d lvar ref end =
    lvar = getLv fn
    ref = getRef fn
    end = getEnd fn
    j = 1
    for i 1 lvar
        d = vrec[i]
        if d == i		// no pair
            lv2[j] = i
            j = j + 1
        else if d != 0
            lv2[j] = i
            lv2[j+1] = d
            j = j + 2
    for i 1 lvar
        vrec[lv2[i]] = 0-(lvar-i+1)	// -lv

    for i ref+1 end-1
        d = XOP[i]
        if isV d
            XARG[i] = vrec[XARG[i]]
        else if isJmp d
            addlis jplis i			// collect jmp ads

// now at one after "ret"
// check tail-call convert to jump
to tailCall2 fn | i end ref ref2 arg =
    end = CP-1
    ref = CP-2				// before ret
    ref2 = getRef fn
    if and (XOP[ref] == icCall) (XARG[ref] == fn)
//		prints "tail call" nl
        arg = getArity fn
        CP = ref
        for i 1 arg			// pass param
            outa icPut arg-i+1
        outa icJmp ref2+1
        outa icRet XARG[end]	// necessary !
        // correct jump to end
        for i ref2 ref
            if and (isJmp XOP[i]) (XARG[i] == end)
                XARG[i] = CP-1

// short cut jump to ret, jmp to jmp
to improv3 | i a1 c1 a2 c2 d2 c3 =
    for i 1 (sizeoflis jplis)
        a1 = jplis[i]
        c1 = XOP[a1]
        if isJmp c1
            a2 = XARG[a1]
            c2 = XOP[a2]
            d2 = XARG[a2]
            // jmp to ret => ret
            if and (c1 == icJmp) (c2 == icRet)
                XOP[a1] = icRet
                XARG[a1] = d2
            // jx to jmp.y => jx.y
            else if c2 == icJmp
                XARG[a1] = d2
            // jx to lit 1, jt.y => jx.y  for macro and/or
            else if and (c2 == icLit) (d2 == 1)
                if XOP[a2+1] == icJt
                    XARG[a1] = XARG[a2+1]
            // jx to lit 0, jf.y => jx.y
            else if and (c2 == icLit) (d2 == 0)
                c3 = XOP[a2+1]
                if c3 == icJf
                    XARG[a1] = XARG[a2+1]
                // jx to lit 0, jt.y $z => jx.z
                else if c3 == icJt
                    XARG[a1] = a2 + 2

// skip over the jump table, to the last entry
to skipCase ref | lo hi =
    lo = XARG[ref+1]
    hi = XARG[ref+2]
    ref + (hi-lo+4)

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

// op type: isCommute, isLogic, isV, isJmp isGlobal
op_type = array
    0 xCM 0 xCM 0 xCM xCM xCM 0
    xCM xCM xLG xLG xLG xLG 0 0
    0 0 0 0
    // addv ...
    xLV xLV xLV xLV xLV xLV xLV xLV
    xLV xLV xLV xLV xLV xLV xLV xLV
    0 0 0 0
    // addi ...
    0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0
    0 0 0 0
    // one arg
    xLV xLV xGV xGV xLV xLV xGV xGV
    xJP xJP xJP 0 0 0 xLV
    xLV xLV 0 xGV 0 0 0
    // zero arg
    0 0 0
    // special: get0 put0 ld0 lit0 ads0 call0 sys0
    xLV xLV xGV 0 xGV 0 0

// 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
    "Mod" 0 "Eq" 0 "Ne" 0 "Lt" 0 "Le" 0 "Ge" 0 "Gt" 0 "Shl" 0 "Shr" 0
    "Undef" "Undef" "Undef" "Undef"
    "Addv" 0 "Subv" 0 "Mulv" 0 "Divv" 0 "Bandv" "Borv" 0 "Bxorv"
    "Modv" 0 "Eqv" 0 "Nev" 0 "Ltv" 0 "Lev" 0 "Gev" 0 "Gtv" 0 "Shlv" 0 "Shrv" 0
    "Undef" "Undef" "Undef" "Undef"
    "Addi" 0 "Subi" 0 "Muli" 0 "Divi" 0 "Bandi" "Bori" 0 "Bxori"
    "Modi" 0 "Eqi" 0 "Nei" 0 "Lti" 0 "Lei" 0 "Gei" 0 "Gti" 0 "Shli" 0 "Shri" 0
    "Undef" "Undef" "Undef" "Undef"
    // one arg
    "Get" 0 "Put" 0 "Ld" 0 "St" 0 "Ldx" 0 "Stx" 0 "Ldy" 0 "Sty" 0
    "Jmp" 0 "Jt" 0 "Jf" 0 "Call" 0 "Ret" 0 "Undef" "Efor" 0
    "Inc" 0 "Dec" 0 "Lit" 0 "Ads" 0 "Sys" 0 "Fun" 0 "Calli"
    // zero arg
    "Not" 0 "Case" 0 "End" 0

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

to pr2 a =
    fspace prInt a

// search symbol table for name with idx
to prNm idx | nm =
    fspace
    nm = getName idx
    if nm == 0
        prInt idx
    else if (strlen nm) > 10
        prInt idx
    else
        prStr nm

: prCode2 op = prStr op_str+(op*3)

to prCode a | op arg =
    op = XOP[a]
    arg = XARG[a]
    if op >= EOC op = 0		// set to undef
    prCode2 op
    if or (op <= icShr) (op >= icNot) break	// zero arg
    if isV op
        arg = 0-arg			// convert -lv to lv
    case op
        icLd: prNm arg
        icSt: prNm arg
        icLdy: prNm arg
        icSty: prNm arg
        icCall: prNm arg
        icFun: prNm arg
        else: pr2 arg

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

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

to outhead start end =
    prInt start fspace
    prInt end fnl

to outOp start end | i =
    for i start end
        prInt XOP[i] fspace
        prInt XARG[i] fspace
        if (i % 8) == 0 fnl
    fnl

// End

