// vm-s.txt
//    som virtual machine v5.1 in Som
//    27 Dec 2010
//    revive  1 Nov 2012

// when started, read object code and run it

enum	// t-code
    1 tAdd tSub tMul tDiv tMod tAnd tOr tXor tEq tNe
    tLt tLe tGt tGe tShl tShr tNot tMov tLdx tStx
    tNop tPush tCall tCallt tFun tRet tEfor tCase
    tJmp tJt tJf tJeq tJne tJlt tJle tJgt tJge
    tSys // 38

enum {64 RETVAL}
enum {5000 MAXDS}
enum {5000 MAXSS}
enum {2000 MAXCS}

// system memory
//
//  101  mode
//  102  tokvalue
//  103  tokcol
//  104  line
//  250..299 tokstring

enum {5678951 OBJ_SOM51}

: prints s = syscall {11 1 s}
: print a = syscall {1 a}
: printc c = syscall {2 c}
: space = syscall {2 32}
: nl = syscall {2 10}
: fopenr fn = syscall {5 fn 0}  // fopen-read filename
: fclose fp = syscall {6 fp}	// fclose filep
: exit = syscall {13}

to initVm | i a =
    M = 0			// to fix M address
    CS = 0			// to fix CS address
    SS = 0
    CP = 2
    DS = 1000
    fp = 1
    sp = 3
    noi = 0
    M = array MAXDS
    CS = array MAXCS
    SS = array MAXSS
    FI = 0			// input file
    a = 390
    i = 0-10
    for i i 300		// init small const
        M[a] = i
        a = a + 1

to error m =
    prints "error: "
    prints m nl
    exit

to readNum =
    syscall {17 FI}	// extra syscall

to xalloc a | b =
    b = DS
    if DS + a >= MAXDS
        error "alloc: out of memory"
    DS = DS + a
    b

to xsys n a b =
    case n
        1:
            syscall {2 34}
            syscall {1 a}
        2: syscall {2 a}
        14: M[RETVAL] = xalloc a
        else: error "undefined syscall"

// instruction format t2-code   op c a b : c = a op b

to eval ip | runflag i op a b c d a2 arity nlocal =
    runflag = 1
    while runflag
        if noi > 10000 break
        noi = noi + 1
        op = CS[ip] & #03f	// d:26 op:6 b:32
        d = CS[ip] >> 6
        c = d & #03ff		// a:16 c:10
        a = d >> 10
        b = CS[ip+1]
        case op
            tAdd: {M[c] = M[a] + M[b]  ip = ip+2}
            tSub: {M[c] = M[a] - M[b]  ip = ip+2}
            tMul: {M[c] = M[a] * M[b]  ip = ip+2}
            tDiv: {M[c] = M[a] / M[b]  ip = ip+2}
            tMod: {M[c] = M[a] % M[b]  ip = ip+2}
            tAnd: {M[c] = M[a] & M[b]  ip = ip+2}
            tOr:  {M[c] = M[a] | M[b]  ip = ip+2}
            tXor: {M[c] = M[a] ^ M[b]  ip = ip+2}
            tShl: {M[c] = M[a] << M[b] ip = ip+2}
            tShr: {M[c] = M[a] >> M[b] ip = ip+2}
            tEq:  {M[c] = M[a] == M[b] ip = ip+2}
            tNe:  {M[c] = M[a] != M[b] ip = ip+2}
            tLt:  {M[c] = M[a] < M[b]  ip = ip+2}
            tLe:  {M[c] = M[a] <= M[b] ip = ip+2}
            tGt:  {M[c] = M[a] > M[b]  ip = ip+2}
            tGe:  {M[c] = M[a] >= M[b] ip = ip+2}

            tLdx: {M[c] = M[M[a] + M[b]]  ip = ip+2}
            tStx: {M[M[a] + M[b]] = M[c]  ip = ip+2}

            tJmp: ip = ip + a
            tJf:  if M[c] == 0  ip = ip+a else ip = ip+2
            tJf:  if M[c] == 0  ip = ip+a else ip = ip+2
            tJeq: if M[c] == M[b] ip = ip+a else ip = ip+2
            tJne: if M[c] != M[b] ip = ip+a else ip = ip+2
            tJlt: if M[c] < M[b]  ip = ip+a else ip = ip+2
            tJle: if M[c] <= M[b] ip = ip+a else ip = ip+2
            tJgt: if M[c] > M[b]  ip = ip+a else ip = ip+2
            tJge: if M[c] >= M[b] ip = ip+a else ip = ip+2

            tCall:
                arity = CS[b] >> 16
                nlocal = (CS[b] >> 6) & #03f
                if(fp + nlocal > MAXSS)
                    error "call stack overflow"

//		1..arity..nlocal     p1..pn,1..arity..nlocal,ip',fp'
//		  M                 ^     ^      SS               ^
//		  reg              fp    sp                    new fp

                // first two parameters to stack
                a2 = sp - arity		// at first param
                SS[a2+1] = M[a]
                SS[a2+2] = M[c]
                // create a new frame
                d = sp + nlocal + 2	// new fp
                SS[d] = fp			// save fp
                SS[d-1] = ip + 2	// ret ads
                for i 1 nlocal		// save reg
                    SS[sp+i] = M[i]
                for i 1 arity		// pass param
                    M[i] = SS[a2+i]
                fp = d;
                sp = fp + 2		// spare first two slots
                ip = b + 2

            tRet:			// ret src (a) fs (c)
                M[RETVAL] = M[a]
                sp = fp - c - 2
                for i 1 c		// restore reg
                    M[i] = SS[sp+i]
                ip = SS[fp-1]		// restore ip
                fp = SS[fp]		// restore fp

            tCallt:
                arity = CS[b] >> 16
                // first two param to stack
                a2 = sp - arity		// at first param
                SS[a2+1] = M[a]
                SS[a2+2] = M[c]
                // pass param
                for i 1 arity
                    M[i] = SS[a2+i]
                sp = fp + 2
                ip = b + 2

            tNot: {M[c] = (M[a] == 0)  ip = ip+2}
            tMov: {M[d] = M[b]  ip = ip+2}
            tPush:
                sp = sp + 1
                SS[sp] = M[a]
                ip = ip + 2
            tEfor:
                M[c] = M[c] + 1
                if M[c] <= M[b] ip = ip+a else ip = ip+2
            tCase:
                d = M[c]
                if (d >= a) & (d <= b)		// a lo, b hi
                    ip = ip + CS[ip+3+d-a]	// jump vector
                else
                    ip = ip + CS[ip+2]		// end of table
            tSys:
                if c == 13 runflag = 0
                else xsys c M[b] M[a]
                ip = ip + 2
            else: error "undefined opcode"

    //	print noi nl

// end eval

to encode op c a = (a << 16) | (c << 6) | op

to readCS | i start end op c a b k n =
    start = readNum
    end = readNum
    i = start
    while i <= end
        k = readNum		// ads, throwaway
        op = readNum
        c = readNum
        a = readNum
        b = readNum
        CS[i] = encode op c a
        CS[i+1]= b
        if op == tCase
            a = readNum
            n = readNum		// size of jtab
            CS[i+2] = n
            for k 0 n-2
                a = readNum
                b = readNum
                CS[i+3+k] = b
            i = i + n - 2
        i = i + 2
    end				// return end

to readData | i start end =
    start = readNum
    end = readNum
    for i start end
        M[i] = readNum
    end				// return end

to loadObj | n =
    FI = fopenr "bubble.obj"
    n = readNum
    if n != OBJ_SOM51
        error "not som 5.1 object"
    n = readCS
    CP = n + 1
    n = readData
    DS = n + 1
    fclose FI

//to dumpDS | i =
//    for i 1000 1010
//        print M[i] space

//to testreadnum | i =
//    FI = fopenr "tiny.obj"
//    for i 1 10
//        print readNum space
//    fclose FI

//to main =
//    initVm
//	testreadnum
//    loadObj
//	dumpDS
//    eval 2

// End