(* Machine.sml -- Instructions and code emission for a stack-based
   abstract machine * sestoft@dina.kvl.dk 2001-03-20, 2002-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        *)
  | 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 CODESTOP   = 24;

(* Handle one instruction instr:
   out       outputs a number
   outlabel  converts a label to a number (used in GOTO, IFZERO, CALL, etc)
   deflabel  defines a label (used in the pseudo-instruction Label)
 *)

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

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

fun code2ints first (code : instr list) : int list =
    let (* Pass 1: build label environment, mapping a label to an address *)
        val labenv = ref Env.empty : (label, int) Env.env ref
        val addr = ref first                    (* First instruction address *)
        fun outinstr1 _ = addr := !addr + 1
        fun outlabel1 _ = outinstr1 0
        fun deflabel1 lab = (labenv := Env.bind1 (!labenv) (lab, !addr))
        val _ = List.app (instr2int outinstr1 outlabel1 deflabel1) code
        (* Pass 2: generate code, using label environment *)
        val bytecode = ref []
        fun outinstr2 i   = (bytecode := i :: !bytecode)
        fun outlabel2 lab = outinstr2 (Env.lookup (!labenv) lab)
        fun deflabel2 _   = ()
        val _ = List.app (instr2int outinstr2 outlabel2 deflabel2) code
    in 
        List.rev(!bytecode)
    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;