open Instr;; open Memory;; open Machine;; type process_state = Ready | Waitpid of int | Zombi of int;; type process = { mutable pcode : int; mutable preg : int array; mutable quantum : int; pid : int; mutable ppid : int; mutable state : process_state; mutable ptable_size : int };; type state = { processes : (int, process) Hashtbl.t ; mutable active_processes : process list ; mutable current : process; codes : instr array array; new_pid : unit -> int; };; let init_state i codes = let process = { pcode = i; preg = Array.make register_number 0; quantum = 0; pid = 1; ppid = 0; state = Ready; ptable_size = ptable_size } in let pids = Hashtbl.create 13 in Hashtbl.add pids 1 process; let last_pid = ref 1 in let rec new_pid() = incr last_pid; try ignore (Hashtbl.find pids !last_pid); new_pid() with Not_found -> !last_pid in { processes = pids; active_processes = [ process ]; current = process; codes = codes; new_pid = new_pid };; let max_quantum = 4;; exception Not_implemented of int;; exception Halt;; exception Invalid_code;; let system_traps = let not_implemented i state = if i < 0 then () else raise (Not_implemented i) in Array.init 10 not_implemented;; let syscall system_state = if !verbose then Printf.eprintf "pid=%d: Syscall %d (a0=%d, a1=%d): %!" system_state.current.pid machine.reg.(v0) machine.reg.(a0) machine.reg.(a1); system_traps.(machine.reg.(v0)) system_state;; let time = ref 0;; let update_frequency = 13;; let update_quantum process1 pid process2 = match process2.state with | Zombi i -> () | _ -> if process1 <> process2 then process2.quantum <- process2.quantum / 2;; let elect_process system_state = let cmp p1 p2 = compare p1.quantum p2.quantum in system_state.active_processes <- List.sort cmp system_state.active_processes; match system_state.active_processes with | [] -> raise Halt | h :: t -> h.quantum <- 0; h;; (** exit avec en argument le registre a0 *) let sys_Exit = 0;; (** crée un nouveau processus, place la valeur de retour dans v0 *) let sys_Fork = 2;; (** écrit la valeur du registre a0 sur le sortie standard et place le nombre d'entiers écrits (1) dans v0 *) let sys_Write = 1;; (** récupère le pid du processus et le place dans v0 *) let sys_Getpid = 3;; (** récupère le pid du père et le place dans v0 *) let sys_Getppid = 4;; (** demande l'exécution d'un nouveau code dont le numéro est dans a0 la valeur de retour est placée dans v0 *) let sys_Exec = 5;; (** attend la fin d'un processus particulier dont le numéro est placé dans a0. La valeur de retour (0 ou -1) est placée dans v0 et celle (exit) du processus attendu dans v1 *) let sys_Waitpid = 6;; (** réserve une zone mémoire dont la taille est placée dans le registre a0 pour le tas. L'appel sytème retourne 0 ou -1 en cas d'erreur dans v0 *) let sys_Brk = 7;; let remove_process process processes = let update_ppid ppid pid pid2 process2 = if process2.ppid == pid then if ppid = 0 then match process2.state with | Zombi i -> Hashtbl.remove processes process2.pid | _ -> process2.ppid <- ppid else process2.ppid <- ppid in Hashtbl.iter (update_ppid process.ppid process.pid) processes; Hashtbl.remove processes process.pid;; exception No_waiting_parent;; let rec run system_state = if !verbose then Printf.eprintf "pid=%d code=%d starts running\n%!" system_state.current.pid system_state.current.pcode; let code = system_state.current.pcode in try process system_state.codes.(code) with Trap -> syscall system_state | Signal -> signal system_state | Invalid_argument _ -> raise Invalid_code | Segmentation_fault -> segmentation_fault system_state | Page_fault page_nb -> page_fault system_state page_nb and signal system_state = incr time; if !time mod update_frequency = 0 then Hashtbl.iter (update_quantum system_state.current) system_state.processes; let p = system_state.current in p.quantum <- p.quantum + 1; if p.quantum == max_quantum then begin if !verbose then Printf.eprintf "pid=%d preempted\n%!" system_state.current.pid; schedule system_state end else run system_state and schedule system_state = let p = elect_process system_state in if !verbose then Printf.eprintf "resuming=%d\n%!" p.pid; system_state.current <- p; machine.reg <- p.preg; run system_state and page_fault system_state page_nb = run system_state and segmentation_fault system_state = print_endline "Segmentation fault"; system_state.current.preg.(a0) <- 1; system_traps.(sys_Exit) system_state;; let exit system_state = if !verbose then Printf.eprintf "Exit\n%!"; let pid = system_state.current.pid in let rec waiting_parents process parents = if process.ppid == 0 then if parents = [] then raise No_waiting_parent else parents else let parent = Hashtbl.find system_state.processes process.ppid in match parent.state with | Waitpid i -> if i == pid then waiting_parents parent (parent :: parents) else waiting_parents parent parents | _ -> waiting_parents parent parents in let p = system_state.current in system_state.active_processes <- List.filter ((<>) p) system_state.active_processes; try let parents = waiting_parents system_state.current [] in let update parent = parent.state <- Ready; system_state.active_processes <- parent :: system_state.active_processes in List.iter update parents; remove_process p system_state.processes; schedule system_state with No_waiting_parent -> if system_state.current.ppid <> 0 then system_state.current.state <- Zombi p.preg.(a0) else remove_process p system_state.processes; schedule system_state in system_traps.(sys_Exit) <- exit;; let fork system_state = if !verbose then Printf.eprintf "Fork\n%!"; let p = system_state.current in let pid = system_state.new_pid () in if !verbose then Printf.eprintf "Son pid %d\n%!" pid; let son = { preg = Array.copy p.preg; pcode = system_state.current.pcode; quantum = 0; pid = pid; ppid = system_state.current.pid; state = Ready; ptable_size = p.ptable_size } in Hashtbl.add system_state.processes pid son; son.preg.(v0) <- 0; system_state.active_processes <- son :: system_state.active_processes; p.preg.(v0) <- pid; run system_state in system_traps.(sys_Fork) <- fork;; let rec write system_state = let p = system_state.current in if !verbose then Printf.eprintf "Write (%d)\n%!" p.preg.(a0); let p = system_state.current in let v = p.preg.(a0) in Printf.printf "%d\n%!" v; run system_state in system_traps.(sys_Write) <- write;; let getpid system_state = let p = system_state.current in if !verbose then Printf.eprintf "Getpid\n%!"; p.preg.(v0) <- system_state.current.pid; run system_state in system_traps.(sys_Getpid) <- getpid;; let getppid system_state = let p = system_state.current in if !verbose then Printf.eprintf "Getppid\n%!"; p.preg.(v0) <- system_state.current.ppid; run system_state in system_traps.(sys_Getppid) <- getppid;; let exec system_state = let p = system_state.current in begin let pcode = p.preg.(a0) in try ignore system_state.codes.(pcode); if !verbose then Printf.eprintf "Exec %d\n%!" pcode; system_state.current.pcode <- pcode; p.preg.(pc) <- 0; with Invalid_argument s -> if !verbose then Printf.eprintf "Exec error %d\n%!" pcode; p.preg.(v0) <- -1 end; run system_state in system_traps.(sys_Exec) <- exec;; let waitpid system_state = let p = system_state.current in if !verbose then Printf.eprintf "Waitpid\n%!"; let rec is_child process = process.ppid = p.pid || process.ppid <> 0 && is_child (Hashtbl.find system_state.processes process.ppid) in let error () = p.preg.(v0) <- -1; run system_state in let pid = p.preg.(a0) in try let process = Hashtbl.find system_state.processes pid in if is_child process then begin p.preg.(v0) <- 0; match process.state with | Zombi ret -> p.preg.(v1) <- ret; remove_process process system_state.processes; run system_state | _ -> p.state <- Waitpid p.preg.(a0); system_state.active_processes <- List.filter ((<>) p) system_state.active_processes; schedule system_state end else error () with Not_found -> error () in system_traps.(sys_Waitpid) <- waitpid;;