(**************************************************)
(*                                                *)
(*                Projet de OCAML                 *)
(*               Christophe Devaux                *)
(*                Adrien Taieb                    *)
(*                                                *)
(**************************************************)

(**************************************************)
(*            début des définitions               *)
(**************************************************)

type pile_a = {
    mutable pointeur : int;
    mutable liste : int list;
  };;

type instr_asm =
   CONST of int | ADD | SUB | MUL | DIV | EQU | NEQ
 | ALLOC of int | FREE of int
 | LOAD of int | STORE of int | PUSH
 | JNZ | JMP of int
 | CALL of int | RET
 | STOP
;;

mutable fonctionne : bool;;

let create()={pointeur=-1;liste=[||]};;
let pile_arithmétique=create();;
let pile_appel=create();;
let pile_retour=create();;

let PC=ref 0;;                      
let SP=ref (-1);;                      
let BP=ref (-1);; 

(*fin des définitions*)

(**************************************************)
(*        début des fonctions sur les piles       *)
(**************************************************)

let estVide p = (p.pointeur = -1);;

let empiler x p = ( p.pointeur <- (p.pointeur + 1) ; p.liste <- x::p.liste );;

let depiler p = p.pointeur <- (p.pointeur - 1) ; p.liste <- (List.tl p.liste);;

let taille p = p.pointeur+1 ;;

let afficher p=
  for i=0 to p.pointeur do print_int (List.nth p.liste i);
    print_newline()
    done;;

(*fin des fonctions sur les piles*)

(**************************************************)
(*             début des exceptions               *)
(**************************************************)

exception INSTRUCTION_NON_VALIDE ;;
exception PILE_VIDE ;;
exception PB_ARGS ;;
exception DIVISE_PAR_ZERO;;
exception IMPOSSIBLE;;
(*fin des exceptions*)


(**************************************************)
(*           début des instructions               *)
(**************************************************)

let add p =
    if estVide p
    then raise (PILE_VIDE)
    else
         if (taille p = 1)
         then raise (PB_ARGS)
         else match p.liste with
              a::b::l -> let res = a+b in (depiler p ; ( p.liste <- res::l ))
		PC:=!PC+1;
              |_ -> raise (PB_ARGS)
;;


let sub p =
    if estVide p
    then raise (PILE_VIDE)
    else
         if (taille p = 1)
         then raise (PB_ARGS)
         else match p.liste with
              a::b::l -> let res = a-b in (depiler p ; ( p.liste <- res::l ))
		PC:=!PC+1;
              |_ -> raise (PB_ARGS)
;;


let mul p =
    if estVide p
    then raise (PILE_VIDE)
    else
         if (taille p = 1)
         then raise (PB_ARGS)
         else match p.liste with
              a::b::l -> let res = a*b in (depiler p ; ( p.liste <- res::l ))
		PC:=!PC+1;
              |_ -> raise (PB_ARGS)
;;

let div p =
    if estVide p
    then raise (PILE_VIDE)
    else
         if (taille p = 1)
         then raise (PB_ARGS)
         else match p.liste with
              a::b::l -> if b != 0
                         then let res = a/b in (depiler p ; ( p.liste <- res::l ))
				PC:=!PC+1;
                         else raise (DIVISE_PAR_ZERO)
              |_ -> raise (PB_ARGS)
;;

let equ p =
    if estVide p
    then raise (PILE_VIDE)
    else
         if (taille p = 1)
         then raise (PB_ARGS)
         else match p.liste with
              a::b::l -> if a = b
                         then (depiler p ; p.liste <- 1::l)
				PC:=!PC+1;
                         else (depiler p ; p.liste <- 0::l)
				PC:=!PC+1;
              |_ -> raise (PB_ARGS)
;;

let neq p =
    if estVide p
    then raise (PILE_VIDE)
    else
         if (taille p = 1)
         then raise (PB_ARGS)
         else match p.liste with
              a::b::l -> if a <> b
                         then (depiler p ; p.liste <- 1::l)
				PC:=!PC+1;
                         else (depiler p ; p.liste <- 0::l)
				PC:=!PC+1;
              |_ -> raise (PB_ARGS)
;;

let alloc n p = p.liste <- Array.append p.liste(Array.create n 0);
			PC:=!PC+1; SP:=!SP+n
;;

let free n p = p.liste <-Array.sub p.liste 0 ((Array.length p.liste) -n);
			PC:=!PC+1;SP:=!SP-n
;;

let load i p1 p2 = if (!BP+i)<0 
                	then raise (PILE_VIDE);
	       	   if(!BP+i)>p1.pointeur
			then raise(IMPOSSIBLE);
				let var=p1.liste.(!BP+i) in
				empiler var p2;
				PC:=!PC+1
;;

let store i p1 p2= if (!BP+i)<0 
                	then raise (PILE_VIDE);
                   if ((!BP+i)>((p1.ind)+1)) 
			then raise(IMPOSSIBLE);
	      		let var=p2.liste.(p.pointeur) in                            (*ou pointeur -1  position du  sommet de la liste *) 
			depiler p2; 
			p1.liste.(!BP+i)<- var ; 
			PC:=!PC+1
;;

let push p1 p2= let var=p2.liste.(p.pointeur) in                                  (*ou pointeur -1  position du  sommet de la liste *)
			depiler p2; 
			empiler var p1;
			PC:=!PC+1;
			SP:=!SP+1
;;

let jnz p = let var = p.liste.(p.pointeur) in                                 (*ou pointeur -1  position du  sommet de la liste *)
		 depiler p;
	       if (var != 0) 
		then PC:=!PC+2 
		else PC:=!PC+1
;;

let jmp i = PC:=!PC+i
;;

let call a p1 p2 = empiler (!PC+1) p2;
			empiler !BP p1;
			SP:=!SP+1;
			BP:=!SP;
			PC:=a
;;

let ret p1 p2 = SP:=!BP;
		let var = p1.liste.(!SP) in 
		depiler p1;
	 	BP:=var;
		let var2 = p2.liste.(p2.pointeur) in                             (*ou pointeur -1  position du  sommet de la liste *)
		depiler p2;
	 	PC:=var2
;;

let stop  = fonctionne<-false
;;

let executer instr p =
    match instr with
          CONST a -> empiler a p
          | ADD -> add pile_arithmétique
          | SUB -> sub pile_arithmétique
          | MUL -> mul pile_arithmétique
          | DIV -> div pile_arithmétique
          | EQU -> equ pile_arithmétique
          | NEQ -> neq pile_arithmétique
	  | ALLOC n -> alloc n pile_appel
          | FREE n -> free n pile_appel
	  | LOAD i -> load i  pile_appel pile_arithmétique
          | STORE i -> store i pile_appel pile_arithmétique
	  | PUSH -> push pile_appel pile_arithmétique
          | JNZ -> jnz pile_arithmétique
          | JMP i-> jmp i 
          | CALL a -> call a pile_appel pile_retour
          | RET -> ret pile_appel pile_retour
          | STOP -> stop 
          |_ -> raise (INSTRUCTION_NON_VALIDE)
;;

(*fin des instructions*)

(**************************************************)
(*                    les tests                   *)
(**************************************************)

let x = 7;;
let l = [];;
let p = { pointeur = (List.length l)-1 ; liste = l } ;;

executer (CONST 3) p;;
executer (CONST 2) p;;

print_string "\naffichage\n" ;;
afficher p;;

print_string "\ntaille\n" ;;
print_int (taille p);;

print_string "\naddition\n" ;;
executer ADD p;;

print_string "\naffichage\n" ;;
afficher p;;

print_string "\non empile 6\n" ;;
executer (CONST 6) p;;

print_string "\naffichage\n" ;;
afficher p;;

print_string "\nequ\n" ;;
executer EQU p;;

print_string "\naffichage\n" ;;
afficher p;;

print_string "\non empile 7\n" ;;
executer (CONST 7) p;;

print_string "\ndivision\n" ;;
executer DIV p;;

print_string "\naffichage\n" ;;
afficher p;;