(* ci.ml, Caml Light version 0.73 *) 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" ;; (* 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 TaillePile = 1000;; let Pile = make_vect 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 () = (vect_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 L = "****************************************" in (print_string L; 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 L;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 () ;; let executer leCode = code := leCode; (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 () ;;