type action = PP | Interpret | AST | IC | ASS | SPIM | Liveness | Compile let the_action = ref Compile;; let action() = !the_action;; let do_action s = !the_action = s;; let set a = Arg.Unit (fun () -> the_action := a);; let all_files = ref [];; let files() = !all_files;; let talloc = ref false;; let _ = Misc.option "-talloc" (Arg.Set talloc) "Utilise l'algorithme d'allocation trivial"; Misc.option "-liveness" (set Liveness) "Montre le résultat de liveness"; Misc.option "-ass" (set ASS) "Montre le code spim avant allocation de registres (sans son prélude)"; Misc.option "-ast" (set AST) "Montre l'arbre de syntaxte asbtraite"; Misc.option "-pp" (set PP) "Imprime joliement le programme source"; Misc.option "-ic" (set IC) "interprète le code intermediaire"; Misc.option "-i" (set Interpret) "Interprète le programme"; Misc.option "-spim" (set SPIM) "Produit le code spim (option par defaut)"; Arg.parse (Misc.options()) (fun s -> all_files := s :: !all_files) "Usage: Prend le nom du fichier source en argument, et deux types d'options. * les options capitalisées tracent une partie de l'exécution dans stderr. * les autres indiquent le comportement du programme, et contrôle la sortie dans stdin, comme suit: " ;; let print p = let show f = let g (_,_,c) = f c in g p.Spim.main; List.iter g (p.Spim.procedures) in if do_action SPIM || do_action ASS then show (List.iter (fun i -> Ass.nformat Spim.namer i; print_newline())); if do_action Liveness then show (fun c -> Liveness.print stdout Spim.namer (Liveness.flow c)); p;; let ( ** ) f g x = f (g x) let spim = print ** Spim.program ** Canon.program ** Trans.program let alloc = if !talloc then Talloc.program else Alloc.program let compile = alloc ** spim let print_code = List.iter (fun i -> Ass.nformat Spim.namer i; print_newline());; exception Error of string;; let error s = raise (Error s);; let parse_program error_prefix parseur lexer lexbuf = let orig = lexbuf.Lexing.lex_abs_pos + lexbuf.Lexing.lex_curr_pos in let orig = if orig > 0 then orig+1 else orig in try let program = parseur lexer lexbuf in Parsing.clear_parser(); program with Parsing.Parse_error -> let pos1 = Lexing.lexeme_start lexbuf - orig in let pos2 = Lexing.lexeme_end lexbuf - orig in if Lexing.lexeme lexbuf <> ";;" then while lexer lexbuf <> Parser.SEMISEMI do () done; error (String.concat "" [ error_prefix; string_of_int pos1; "-"; string_of_int pos2; ":\nSyntax error";]) | Lexer.Illegal -> let pos1 = Lexing.lexeme_start lexbuf - orig in let pos2 = Lexing.lexeme_end lexbuf - orig in error (String.concat "" [ error_prefix; string_of_int pos1; "-"; string_of_int pos2; ":\nLexical error "; Lexing.lexeme lexbuf]) ;; let main() = try let chan, error_prefix = match files() with | s:: _ -> open_in s, String.concat "" [ "File \""; s; "\", line 1, characters ";] | [] -> stdin, "Characters " in let lexbuf = Lexing.from_channel chan in while true do begin try let p = parse_program error_prefix Parser.main Lexer.token lexbuf in match action() with | PP -> Print.program p | AST -> Ast.program p | Interpret -> Interpret.eval p | IC -> Simul.program (Trans.program p) | ASS -> ignore (spim p) | _ -> print_code (compile p) with Error s -> Parsing.clear_parser(); prerr_string s; prerr_newline(); exit 1 end; done; with | Lexer.Eof -> () | Sys_error s -> Printf.fprintf stderr "Erreur: %s" s; prerr_newline(); exit 1; ;; Printexc.print main ();;