structure W32 = Word32
structure A = Array

val zpad = StringCvt.padLeft #"0"
val i2s = Int.toString
fun w2s w = "0wx"^zpad 8 (W32.toString w)
val w2i = W32.toInt
val i2w = W32.fromInt

infix 5 << >> ~>>

fun readFilePack filename =
    let val dev = BinIO.openIn filename
        val all = BinIO.inputAll dev before BinIO.closeIn dev
        val words = A.tabulate(Word8Vector.length all div 4, 
                            fn i => W32.fromLarge(PackWord32Big.subVec(all,i)))
    in  words
    end

fun interp prog =
    let infix 9 sub 
        infix <-
        val op sub = A.sub

        val regs = A.array(8, 0w0)
        fun $ reg = regs sub reg
        fun reg <- x = A.update(regs, reg, x)
                    
        val finger = ref 0
        val prog = ref prog
        fun spin () = let val w = !prog sub (!finger)
                      in  finger := !finger + 1
                        ; w
                      end
        fun load arr =
            prog := A.tabulate(A.length arr, fn i => arr sub i)
       
        val null = A.array(0, 0w0)
        val arrays = ref(A.array(16, null))
        val freelist = ref(List.tabulate(15, fn i => W32.fromInt(i+1)))
                       
        fun $$ reg = if $reg = 0w0 then !prog 
                     else !arrays sub (w2i($reg))
                                                   
        fun next () =
            case !freelist of
                [] =>
                let val current = A.length(!arrays)
                    val new = A.array(current * 2, null)
                in  freelist := List.tabulate(current - 1,
                                           fn i => W32.fromInt(i+current+1))
                  ; A.copy{src = !arrays, dst = new, di = 0}
                  ; arrays := new
                  ; W32.fromInt current
                end
              | w :: ws => ( freelist := ws
                           ; w
                           ) 
        fun alloc size =
            let val new = A.array(size, 0w0)
                val id  = next()
            in  A.update(!arrays, w2i id, new)
              ; id
            end
        fun free id = ( A.update(!arrays, w2i id, null)
                      ; freelist := id :: !freelist
                      )
                      
        fun loop() =
            let val w = spin() 
                open W32
                val A = toInt((w << 0w23) >> 0w29)
                val B = toInt((w << 0w26) >> 0w29)
                val C = toInt(andb(w, 0w7))
            in  case w >> 0w28 of
                    0w0  => if $C = 0w0 then ()
                            else A <- $B
                  | 0w1  => A <- $$B sub (w2i($C))
                  | 0w2  => A.update($$A, w2i($B), $C)
                  | 0w3  => A <- $B + $C
                  | 0w4  => A <- $B * $C
                  | 0w5  => A <- $B div $C
                  | 0w6  => A <- W32.notb(W32.andb($B, $C))
                  | 0w7  => OS.Process.exit OS.Process.success
                  | 0w8  => B <- alloc (w2i($C))
                  | 0w9  => free ($C)
                  | 0w10 => ( TextIO.output1(TextIO.stdOut, 
                                             Char.chr(w2i($C)))
                            ; TextIO.flushOut TextIO.stdOut
                            )
                  | 0w11 => C <- (case TextIO.input1 TextIO.stdIn of
                                      SOME c => W32.fromInt(Char.ord c)
                                    | NONE   => 0wxFFFFFFFF) 
                  | 0w12 => ( if $B = 0w0 then ()
                              else load($$B)
                            ; finger := w2i($C)
                            )
                  | 0w13 => let val A = toInt((w << 0w4) >> 0w29)
                                val value = (w << 0w7) >> 0w7
                            in  A <- value
                            end
                  | _ => raise Fail("Invalid instruction: "^w2s w
                                    ^" ("^zpad 32 
                                          (Word32.fmt StringCvt.BIN w)^")")
              ; loop()
            end
                  
    in  loop()
        handle ?? => ( A.appi (fn(i,w) => 
                                 print("reg["^i2s i^"] = "^w2s w^"\n")) 
                              regs
                     ; raise ??
                     )
    end

val _ = let val args = CommandLine.arguments()
        in  interp (readFilePack (hd(args)))
        end