(* Machine.sml -- Instructions and code emission for a stack-based
   abstract machine * sestoft@dina.kvl.dk 2001-03-20, 2003-03-19

   An implementation of the machine is found in Machine.java.
 *)

datatype label = 
    Lab of string

datatype instr =
    Label of label                     (* symbolic label; pseudo-instruc. *)
  | CSTI of int                        (* constant                        *)
  | ADD                                (* addition                        *)
  | SUB                                (* subtraction                     *)
  | MUL                                (* multiplication                  *)
  | DIV                                (* division                        *)
  | MOD                                (* modulus                         *)
  | EQ                                 (* equality: s[sp-1] == s[sp]      *)
  | LT                                 (* less than: s[sp-1] < s[sp]      *)
  | NOT                                (* logical negation:  s[sp] != 0   *)
  | DUP                                (* duplicate stack top             *)
  | SWAP                               (* swap s[sp-1] and s[sp]          *)
  | LDI                                (* get s[s[sp]]                    *)
  | STI                                (* set s[s[sp-1]]                  *)
  | GETBP                              (* get bp                          *)
  | GETSP                              (* get sp                          *)
  | INCSP of int                       (* increase stack top by m         *)
  | GOTO of label                      (* go to label                     *)
  | IFZERO of label                    (* go to label if s[sp] == 0       *)
  | IFNZRO of label                    (* go to label if s[sp] != 0       *)
  | CALL of int * label                (* move m args up 1, push pc, jump *)
  | TCALL of int * int * label         (* move m args down n, jump        *)
  | RET of int                         (* pop m and return to s[sp]       *)
  | PRINTI                             (* print s[sp] as integer          *)
  | PRINTC                             (* print s[sp] as character        *)
  | LDARGS                             (* load command line args on stack *)
  | STOP                               (* halt the abstract machine       *)

(* Generate new distinct labels *)

local 
    val nextlab = ref 0
in      
    fun resetLabels () = nextlab := 0

    fun newLabel () = 
	(nextlab := 1 + !nextlab; Lab("L" ^ Int.toString (!nextlab)))
end;

(* An instruction list is emitted in two phases:
   * pass 1 builds an environment labenv mapping labels to addresses 
   * pass 2 emits the code to file, using the environment labenv to 
     resolve labels
 *)

(* These numeric instruction codes must agree with Machine.java: *)

val CODECST    = 0 
and CODEADD    = 1 
and CODESUB    = 2 
and CODEMUL    = 3 
and CODEDIV    = 4 
and CODEMOD    = 5 
and CODEEQ     = 6 
and CODELT     = 7 
and CODENOT    = 8 
and CODEDUP    = 9 
and CODESWAP   = 10 
and CODELDI    = 11 
and CODESTI    = 12 
and CODEGETBP  = 13 
and CODEGETSP  = 14 
and CODEINCSP  = 15 
and CODEGOTO   = 16
and CODEIFZERO = 17
and CODEIFNZRO = 18 
and CODECALL   = 19
and CODETCALL  = 20
and CODERET    = 21
and CODEPRINTI = 22 
and CODEPRINTC = 23
and CODELDARGS = 24
and CODESTOP   = 25;

(* Bytecode emission, first pass: build environment that maps 
   each label to an integer address in the bytecode.
 *)

fun makelabenv(instr, (addr, labenv)) = 
    case instr of
        Label lab      => (addr, Env.bind1 labenv (lab, addr))
      | CSTI i         => (addr+2, labenv)
      | ADD            => (addr+1, labenv)
      | SUB            => (addr+1, labenv)
      | MUL            => (addr+1, labenv)
      | DIV            => (addr+1, labenv)
      | MOD            => (addr+1, labenv)
      | EQ             => (addr+1, labenv)
      | LT             => (addr+1, labenv)
      | NOT            => (addr+1, labenv)
      | DUP            => (addr+1, labenv)
      | SWAP           => (addr+1, labenv)
      | LDI            => (addr+1, labenv)
      | STI            => (addr+1, labenv)
      | GETBP          => (addr+1, labenv)
      | GETSP          => (addr+1, labenv)
      | INCSP m        => (addr+2, labenv)
      | GOTO lab       => (addr+2, labenv)
      | IFZERO lab     => (addr+2, labenv)
      | IFNZRO lab     => (addr+2, labenv)
      | CALL(m,lab)    => (addr+3, labenv)
      | TCALL(m,n,lab) => (addr+4, labenv)
      | RET m          => (addr+2, labenv)
      | PRINTI         => (addr+1, labenv)
      | PRINTC         => (addr+1, labenv)
      | LDARGS         => (addr+1, labenv)
      | STOP           => (addr+1, labenv)

(* Bytecode emission, second pass: output bytecode as integers *)

fun emitints getlab (instr, ints) = 
    case instr of
        Label lab      => ints
      | CSTI i         => CODECST    :: i :: ints
      | ADD            => CODEADD    :: ints
      | SUB            => CODESUB    :: ints
      | MUL            => CODEMUL    :: ints
      | DIV            => CODEDIV    :: ints
      | MOD            => CODEMOD    :: ints
      | EQ             => CODEEQ     :: ints
      | LT             => CODELT     :: ints
      | NOT            => CODENOT    :: ints
      | DUP            => CODEDUP    :: ints
      | SWAP           => CODESWAP   :: ints
      | LDI            => CODELDI    :: ints
      | STI            => CODESTI    :: ints
      | GETBP          => CODEGETBP  :: ints
      | GETSP          => CODEGETSP  :: ints
      | INCSP m        => CODEINCSP  :: m :: ints
      | GOTO lab       => CODEGOTO   :: getlab lab :: ints
      | IFZERO lab     => CODEIFZERO :: getlab lab :: ints
      | IFNZRO lab     => CODEIFNZRO :: getlab lab :: ints
      | CALL(m,lab)    => CODECALL   :: m :: getlab lab :: ints
      | TCALL(m,n,lab) => CODETCALL  :: m :: n :: getlab lab :: ints
      | RET m          => CODERET    :: m :: ints
      | PRINTI         => CODEPRINTI :: ints
      | PRINTC         => CODEPRINTC :: ints
      | LDARGS         => CODELDARGS :: ints
      | STOP           => CODESTOP   :: ints

(* Convert instruction list to int list in two passes:
   Pass 1: build label environment
   Pass 2: output instructions using label environment
 *)

fun code2ints (code : instr list) : int list =
    let val (_, labenv) = foldl makelabenv (0, Env.empty) code
	fun getlab lab = Env.lookup labenv lab
    in 
	foldr (emitints getlab) [] code
    end

fun intstofile (is : int list) (fname : string) : unit = 
    let open TextIO
        val os = openOut fname
        (* To turn "~1" into "-1" etc: *)
        fun fixminus s = String.map (fn #"~" => #"-" | c => c) s
        fun outn n = output(os, " " ^ fixminus (Int.toString n));
    in
        List.app outn is; 
        output(os, "\n");
        closeOut os
    end;