(* Finalisation *)
#open "am";;
#open "divers";;
#open "printexc";;
#open "gen";;

let link () =
  let labelpos  = make_vect !nblabel 0 in
  let add_instr pos = function
    | Label k -> labelpos.(k)<-pos; pos 
    | Dummy -> pos 
    | _ -> (pos+1)
  in
  let trad = function
  | MakeClosure (nbloc,adr) -> MakeClosure (nbloc, labelpos.(adr))
  | Jump adr -> Jump labelpos.(adr)
  | JumpTrue adr -> JumpTrue labelpos.(adr)
  | PushMakeCouple adr -> PushMakeCouple labelpos.(adr)
  | TestConstr (n,j) -> TestConstr (n, labelpos.(j))
  | TestConstConstr (n,j) -> TestConstConstr (n, labelpos.(j))
  | i -> i
  in
  maincode:=rev ([Stop 0]::!maincode);
  let longmain  = it_list (it_list add_instr) 0 !maincode in
  let longtotal = it_list add_instr longmain !funccode in
  let code=make_vect longtotal (Stop 0) in
  let trad_instr pos = function
    | Label _ | Dummy -> pos
    | i -> code.(pos)<-(trad i); pos+1
  in
  let _ = it_list (it_list trad_instr) 0 !maincode in
  let _ = it_list trad_instr longmain !funccode in
  code;;
  


let linkcode pgm =
  let labelpos = make_vect !nblabel 0 in
  let trad = function
  | MakeClosure (nbloc,adr) -> MakeClosure (nbloc, labelpos.(adr))
  | Jump adr -> Jump labelpos.(adr)
  | JumpTrue adr -> JumpTrue labelpos.(adr)
  | PushMakeCouple adr -> PushMakeCouple labelpos.(adr)
  | i -> i
  in
  let nbinstr = it_list (fun pos i -> match i with Label k -> labelpos.(k)<-pos; pos | Dummy -> pos | _ -> (pos+1)) 0 pgm in
  let code=make_vect nbinstr (Stop 0) in
  let _=it_list (fun pos i -> match i with Label _|Dummy -> pos | _ -> code.(pos)<-(trad i); pos+1) 0 pgm in
  code;;


let print_code code = do_list (fun i -> print_aminstr i; pr "\n") code;;

let print_code_vect code = 
  for i=0 to (vect_length code)-1 do
   print_int i; pr "  "; print_aminstr code.(i); pr "\n"
  done;;

(*
let pgm1 =
[
MakeInt 10;
Push;

MakeInt 5;
Push;
MakeClosure (1,0);

Call;
Stop;

Label 0;
Get 2;
Push;
EnvGet 0;
TestLt;
Not;
Neg;
Return;
];;

let run () = nblabel:=1; runpgm (linkcode pgm1); flush std_out;;

printexc__f run ();;
*)