(* ci.ml, Objective Caml version 3.08.1 *)

(* Type des instructions de la machine *)

open Entrent;;

type typeInstruction =
   Void          (* Passer a l'instruction suivante *)
|  Stop          (* Imprimer le sommet de pile et   *)
                 (* arreter l'execution             *)
|  Add           (* Depiler le sommet et le sous-   *)
                 (* sommet de pile, les ajouter et  *)
                 (* ranger le resultat au sommet de *)
                 (* pile                            *)
|  Sub           (* Depiler le sommet et le sous-   *)
                 (* sommet de pile, les soustraire  *)
                 (* et ranger le resultat au sommet *)
                 (* de pile                         *)
|  Mult          (* Depiler le sommet et le sous-   *)
                 (* sommet de pile, les multiplier  *)
                 (* et ranger le resultat au sommet *)
                 (* de pile                         *)
|  Div           (* Depiler le sommet et le sous-   *)
                 (* sommet de pile, les diviser     *)
                 (* et ranger le resultat au sommet *)
                 (* de pile                         *)
|  Ifless        (* Depiler le sommet b et le sous- *)
                 (* sommet a de pile, et ranger le  *)
                 (* resultat 1 si a<b et 0 si a>=b  *)
                 (* au sommet de pile               *)
|  Ifeq          (* Depiler le sommet b et le sous- *)
                 (* sommet a de pile, et ranger le  *)
                 (* resultat 1 si a=b et 0 si a<>b  *)
                 (* au sommet de pile               *)
|  BrZero        (* Branchement a l'instruction     *)
                 (* dont l'adresse est au sommet    *)
                 (* de pile si le sous sommet est   *)
                 (* nul, les depiler                *)
|  Goto          (* Branchement a l'instruction in- *)
                 (* diquee au sommet de pile, le    *)
                 (* le depiler                      *)
|  EmpilerSP     (* Empiler le pointeur de sommet   *)
                 (* de pile au sommet de pile       *)
|  DepilerSP     (* Depiler la valeur au sommet de  *)
                 (* la pile dans le pointeur        *)
                 (* de sommet de pile SP            *)
|  EmpilerLD     (* Empiler le registre LD (lien    *)
                 (* dynamique) au sommet de pile    *)
|  DepilerLD     (* Depiler la valeur au sommet de  *)
                 (* la pile dans le registre de     *)
                 (* lien dynamique LD               *)
|  EmpilerCO     (* Empiler le compteur ordinal CO  *)
                 (* au sommet de pile               *)
|  Charger       (* Remplacer le sommet de la pile  *)
                 (* par la valeur de l'element de   *)
                 (* pile dont l'adresse dans la pi- *)
                 (* le est au sommet de pile        *)
|  Ranger        (* Ranger la valeur du sous-sommet *)
                 (* de pile dans la pile a l'adres- *)
                 (* se indiquee au sommet de pile   *)
                 (* et les depiler                  *)
|  Valeur of int (* Valeur immediate                *)
|  EmpilerSuiv   (* Remplacer le sommet de la pile  *)
                 (* par le contenu de la memoire    *)
                 (* suivante dans le code           *)
|  EmpilerCode   (* Remplacer le sommet de la pile  *)
                 (* par le contenu de la memoire du *)
                 (* code dont l'adresse est au som- *)
                 (* met de pile                     *)
|  Fin           (* Fin du code (a dumper)          *)
|  DumpCode      (* Imprimer le code a executer     *)
|  DumpPile      (* Imprimer la pile d'execution    *)

|  EmpilerRand   (* Empiler un random en fonction du sommet de pile *)
|  EmpilerInput  (* Empiler une entrée *)
|  DumpSP        (* Afficher le sommet de pile *)
;;

type typeCode = typeInstruction array;;

exception ErreurExecution of string;;

let echo_instruction = function
   Void          -> print_string "Void"
|  Stop          -> print_string "Stop"
|  Add           -> print_string "Add"
|  Sub           -> print_string "Sub"
|  Mult          -> print_string "Mult"
|  Div           -> print_string "Div"
|  Ifless        -> print_string "Ifless"
|  Ifeq          -> print_string "Ifeq"
|  BrZero        -> print_string "BrZero"
|  Goto          -> print_string "goto"
|  EmpilerSP     -> print_string "EmpilerSP"
|  DepilerSP     -> print_string "DepilerSP"
|  EmpilerLD     -> print_string "EmpilerLD"
|  DepilerLD     -> print_string "DepilerLD"
|  EmpilerCO     -> print_string "EmpilerCO"
|  Charger       -> print_string "Charger"
|  Ranger        -> print_string "Ranger"
|  Valeur(v)     -> print_int v
|  EmpilerSuiv   -> print_string "EmpilerSuiv"
|  EmpilerCode   -> print_string "EmpilerCode"
|  Fin           -> print_string "Fin"
|  DumpCode      -> print_string "DumpCode"
|  DumpPile      -> print_string "DumpPile"

|  EmpilerRand   -> print_string "EmpilerRand"
|  EmpilerInput  -> print_string "EmpilerInput"
|  DumpSP        -> print_string "DumpSP" 
;;


(* Pointeur nul dans le code *)

let nul = -1;;

(* Interpreteur du code *)

let faireTraceExe = ref false;;

let traceExe () = faireTraceExe := true;;

let unTraceExe () = faireTraceExe := false;;

(* 'code' est un tableau contenant le code a execu- *)
(* ter. La machine charge sur la pile le contenu de *)
(* code[0] puis execute l'instruction en code[1]    *)

let code = ref
[|
Valeur 0;
Stop;
Fin
|];;

let ref_taillepile = ref 1024;;

let taillePile () = !ref_taillepile ;;
let pile = Array.make (taillePile())  0;;
let co   = ref 1   (* Compteur Ordinal *);;
let sp   = ref 0   (* Sommet de Pile   *);;
let ld   = ref nul (* Lien Dynamique   *);;

(* Taille du tableau contenant le code a executer *)
let taillecode () = (Array.length (!code));; 

let checkCO n = (* 0 <= co <= taillecode *)
 if (n < 0) or (n > (taillecode ())) then
   raise (ErreurExecution "compteur Ordinal Incorrect");
 n;;

let assignCO n = (* co := n *)
 co := (checkCO n);
 ();;

let incrCO () = (* co := !co + 1 *)
 co := (checkCO (!co + 1));
 ();;

let faireDumpCode () =
 print_newline ();
 print_string "co = "; print_int !co; print_newline ();
 let i = ref 0 in
   while (!i <= (taillecode ())) 
         & (((!code).(!i)) <> Fin) do
     (print_int !i);
     (print_string " : ");
     (echo_instruction ((!code).(!i)));
     i := !i + 1;
     print_newline ()
   done;
 print_newline ();
 (incrCO ());;

let checkSP n = (* 0 <= n < taillePile *)
 if n > (taillePile() - 1) then
   raise (ErreurExecution "Debordement superieur du pointeur de pile")
 else if n < 0 then
   raise (ErreurExecution "Debordement inferieur du pointeur de pile");
 n;;

let valSP n = (* valeur de sp + n *)
 (checkSP (!sp + n));;

let incrSP n = (* sp := sp + n *)
 sp := !sp + n;
 if !sp > taillePile() then
   raise (ErreurExecution "Debordement superieur de la pile d'execution")
 else if !sp < -1 then
   raise (ErreurExecution "Debordement inferieur de la pile d'execution");
 ()
(* and faireEmpiler n = () *) ;;

let  faireEmpiler n =
 (incrSP 1);
 pile.(valSP 0) <- n;
 (incrCO ());;

let faireDepiler () =
 (incrSP (-1));
 (incrCO ());
 pile.((valSP 1));;

let faireDumpPile () =
 print_newline ();
 print_string "co = "; print_int !co; print_newline ();
 print_string "sp = "; print_int !sp; print_newline ();
 print_string "ld = "; print_int !ld; print_newline ();
 let line = "****************************************" in
   (print_string line; print_newline ();
      let i = ref 0 in
        while !i <= !sp do
          (print_int !i;
           print_string " : ";
           print_int pile.(!i);
           print_newline ();
           i := !i + 1)
         done;
         print_string line;print_newline ()
   );
 (incrCO ());;
      
let executerInstruction () =
 if !faireTraceExe then
   (print_int !co; print_string ":: ";
    echo_instruction ((!code).(!co)); print_newline ());
 match (!code).(!co) with
    Void       
      -> (incrCO ())
 |  Stop   
      -> ()
 |  Add    
      -> let v1 = pile.(valSP (-1))
         and v2 = pile.(valSP 0) in
           pile.(valSP (-1)) <- (v1 + v2);
         incrSP(-1);
         (incrCO ())
 |  Sub    
    -> let v1 = pile.(valSP (-1))
       and v2 = pile.(valSP 0) in
         pile.(valSP (-1)) <- (v1 - v2);
       incrSP(-1);
       (incrCO ())
 |  Mult   
    -> let v1 = pile.(valSP (-1))
       and v2 = pile.(valSP 0) in
         pile.(valSP (-1)) <- (v1 * v2);
       incrSP(-1);
       (incrCO ())
 |  Div   
    -> let v1 = pile.(valSP (-1))
       and v2 = pile.(valSP 0) in
         pile.(valSP (-1)) <- (v1 / v2);
       incrSP(-1);
       (incrCO ())
 |  Ifless  
    -> let v1 = pile.(valSP (-1))
       and v2 = pile.(valSP 0) in
         if (v1 < v2) then
           pile.(valSP (-1)) <- 1
         else
           pile.(valSP (-1)) <- 0;
       incrSP(-1);
       (incrCO ())
 |  Ifeq    
     -> let v1 = pile.(valSP (-1))
        and v2 = pile.(valSP 0) in
          if (v1 = v2) then
            pile.(valSP (-1)) <- 1
          else
            pile.(valSP (-1)) <- 0;
          incrSP(-1);
          (incrCO ())
 |  BrZero  
     -> if (pile.(valSP (-1)) = 0) then
          (assignCO pile.(valSP 0))
        else
          (incrCO ());
        (incrSP (-2))
 |  Goto  
     -> (assignCO pile.(valSP 0));
        (incrSP (-1))
 |  EmpilerSP
     -> faireEmpiler (!sp)
 |  DepilerSP
     -> sp := faireDepiler(); ()
 |  EmpilerLD
     -> faireEmpiler(!ld)
 |  DepilerLD 
     -> ld := faireDepiler(); ()
 |  EmpilerCO
     -> faireEmpiler(!co)
 |  Charger 
     -> let a = pile.(valSP 0) in
          let v = pile.((checkSP a)) in
             pile.(valSP 0) <- v;
        (incrCO ()) 
 |  Ranger  
     -> let v = pile.((valSP (-1))) in
          let a = pile.(valSP 0) in
             pile.(a) <- v;
        (incrSP (-2));
        (incrCO ()) 
 |  EmpilerSuiv
    -> (match (!code).(checkCO (!co + 1)) with
        (Valeur n) -> 
           (incrSP 1);
           pile.(valSP 0) <- n;
           (assignCO (!co + 2))
         | _        -> 
          raise (ErreurExecution "Valeur immediate incorrecte")
       )
 |  EmpilerCode ->
     (match (!code).(checkCO pile.(valSP 0)) with
      (Valeur n) -> 
          pile.(valSP 0) <- n;
          (incrCO ())
       | _            -> 
         raise (ErreurExecution "Valeur immediate incorrecte")
     )
 |  (Valeur v)
     -> raise (ErreurExecution "Valeur non executable")
 |  Fin     
     -> raise (ErreurExecution "Instruction de fin non executable")
 |  DumpCode
     -> faireDumpCode ()
 |  DumpPile
     -> faireDumpPile ()

 | EmpilerRand -> 
       let v2 = pile.(valSP 0) in
       pile.(valSP (0)) <- (Random.int v2);
       (incrCO ())

 | EmpilerInput -> faireEmpiler ( entree_entier () )

 | DumpSP -> print_int pile.(valSP (0)); print_newline (); incrCO()

;;

let executer lecode =
    code := lecode;
    print_string "Execution begins..."; print_newline ();
    (match (!code).(0) with
       (Valeur n) ->  pile.(0) <- n;
                      if !faireTraceExe then
                       (print_newline ();
                        print_string "Trace d'execution:";
                        print_newline ();
                        print_string "0:: ";
                        print_int n;
                        print_newline ())
       |_         -> 
         raise (ErreurExecution "1ere instruction incorrecte")
    );
    sp := 0; co := 1; ld := nul;
    while ((!code).(checkCO !co) <> Stop) do
      executerInstruction ()
    done;
    if !faireTraceExe then
      (print_int !co; print_string ":: ";
       echo_instruction ((!code).(!co)); print_newline ());
    print_int pile.(valSP 0);
    print_newline ()
;;