(*        CSC 7B/FC Sample Program and Assignment Base
   
   Abstract Machine AM7B is a simple computer with 4K memory that can
   only be used as a stack.  The machine's CPU contains four general
   purpose registers ax, bx, cx and dx, and special purpose register
   sp (top of stack).  There is also a program counter register (pc).
   However, since this is a virtual machine we can assume that program
   instructions are stored externally.  Word size is 32 bits. The ALU
   can perform operations add, sub, imul and idiv.  The semantics of
   an instruction such as sub ax bx is bx -= ax: the second operand is
   also the destination.

   The only other operations are push and pop. Operands can be register or
   immediate, and only the push operation can take an immediate operand.

   For example, the following program calculates 5+4*3:

   push 3
   push 4
   pop ax
   pop bx
   imul bx ax
   push 5
   pop bx
   add bx ax
   push ax    

AM7B programs should always leave the result on top of the stack

Following program simulates AM7B in F#, including assembler
*)

open System;
open Microsoft.FSharp.Math;;
open System.Text.RegularExpressions;;

// operands are either immediate or register  (no direct mem access, yet)
type operand = Imm of int | Reg of string;;

type operation = ALU of (string*operand*operand) | PUSH of operand | POP of operand;;

// an operation such as 'add ax bx' is represented internally as 
// ALU("add",Reg("ax"),Reg("bx"))

////////////////////// Machine Simulation //////////////////////

let RAM:int[] = Array.zeroCreate 1024;  // 4K memory, only used for stack
let REGS = [|0;0;0;0|];              // general purpose registers ax,bx,cx,dx
let mutable sp = 0;;                 // top of stack register (addresses RAM)
// sp points to next empty slot on stack, so 0 means empty stack
let mutable pc = 0;;                 // program counter (instruction pointer)
let mutable fault = false;           // machine fault flag

let regi = function   // maps register to REGS array index
  | "ax"-> 0
  | "bx" -> 1
  | "cx" -> 2
  | "dx" -> 3
  | x -> raise(Exception("illegal operand "+string(x)));;

let aluop = function   // ALU operations dispatch to lambda terms:
  | "add" -> fun (x,y) -> y+x
  | "sub" -> fun (x,y) -> y-x
  | "imul" -> fun (x,y) -> y*x
  | "idiv" -> fun (x,y) -> y/x
  | x   -> raise(Exception("illegal operation "+string(x)));;

let coredump() =  // called on machine fault
  printfn "SEGMENTAION FAULT, CORE DUMPED, HA HA YOU SUCK!!"
  printfn "ax=%d, bx=%d, cx=%d, dx=%d" (REGS.[0]) (REGS.[1]) (REGS.[2]) (REGS.[3])
  printfn "sp=%d,  top portion of stack:\n" sp
  let mutable i = sp-1
  while (i>=0 && i>sp-8) do
     printfn "%d" (RAM.[i])
     i <- i-1;;


// Execute a single instruction
let execute = function
  | ALU(op,Reg(a),Reg(b)) -> 
      let i,j,f = regi(a),regi(b),aluop(op)
      REGS.[j] <- f(REGS.[i],REGS.[j])
  | PUSH(Imm(x)) when sp<RAM.Length ->
      RAM.[sp] <- x
      sp <- sp+1
  | PUSH(Reg(r)) when sp<RAM.Length ->
      let i = regi(r) in RAM.[sp] <- REGS.[i]
      sp <- sp+1
  | POP(Reg(r)) when sp>0 ->
      sp <- sp - 1
      let i = regi(r) in REGS.[i] <- RAM.[sp]
  | x -> 
    Console.WriteLine("illegal instruction "+string(x))
    fault <- true
    coredump();;   // fault

// execute a program as a list of instructions:
let executeProg (program:operation list) =
  pc <- 0
  fault <- false
  while not(fault) && pc<program.Length do
    let instruction = program.[pc];
    Console.WriteLine("executing instruction: "+string(instruction)) //trace
    execute instruction
    pc <- pc+1
    printfn "ax=%d bx=%d cx=%d dx=%d sp=%d pc=%d" (REGS.[0]) (REGS.[1]) (REGS.[2]) (REGS.[3]) sp pc   //trace
  // end of while by indentation
  if not(fault) then printfn "top of stack holds value %d" (RAM.[sp-1]);;


// sample program for 3+5
let code1 = [PUSH(Imm(5));PUSH(Imm(3));POP(Reg "bx");POP(Reg "ax");ALU("+",Reg("bx"),Reg("ax"));PUSH(Reg "ax")];

//  executeProg code1;;   // UNCOMMENT TO TEST

let code2 = [POP(Reg "ax")];
sp <- 0; // reset stack pointer
// executeProg code2;;    // UNCOMMENT TO TEST


///////////////////////////// ASSEMBLER  /////////////////////////

//let ins = Console.ReadLine(); // read instruction into string format
let ins = "add ax bx"
let tokens = Regex.Split(ins,"\s"); // split string by white spaces
// tokens is of type string[], a .Net array of Strings

// translate a string into an operand:
let transoperand x = 
  try Imm(int(x))        // try-with (catch) : exce is exception object
  with
  | exce -> Reg(x);;
// can also look at individual string chars: x.[0] is first char
// look at .net string class documentation for substring function, etc.

// translate a string token array into an AM7B instruction
let translate = function
 | [| "push"; x |] -> PUSH(transoperand x)
 | [| "pop"; x |] -> POP(transoperand x)
 | [| op; x; y |] -> ALU(op, transoperand x, transoperand y)
 | x -> raise(Exception("Unrecognized instruction "+string(x)));

let assemble i = translate (Regex.Split(i,"\s"));;

// test that it works
let i1 = assemble "add ax bx";
let i2 = assemble "push 3";
let i3 = assemble "pop cx";
//Console.WriteLine("---");
//printcode [i1;i2;i3];; // should print strings as expected.

// read am7b program from stdin, assemble and execute, skips blank
// lines and lines that begin with # (comments)
let rec readprog ax (ins:string) =
  match ins with
    | null -> ax
    | n when n.Length=0 || n.[0] = '#'  -> // skip blank or comment line
       readprog ax (Console.ReadLine())
    | inst -> readprog (assemble(inst)::ax) (Console.ReadLine());;
let rec reverse ax = function
  | [] -> ax
  | (a::b) -> reverse (a::ax) b;;

let run() = 
  let firstline = Console.ReadLine();
  let instructions = reverse [] (readprog [] firstline);
  executeProg instructions;;  

run();    // RUN THE PROGRAM!

// Run with (mono) machine.exe < test1.7b


(* ////////////// CLASS EXERCISE /////////////// 


1. Write an AM7B assembly language program that calculates the value of
    53+(3*21)-19.  Each integer need to be pushed on to the stack
    as a separate value somewhere in your program (don't do the math
    externally).

    Hint: write out the expression as a TREE and perform a post-order
    traversal.  Post-order means that we evaluate the innermost expression
    first.  
*)