arch/x86/moogle/moogleize.ml

   1 (*
   2    Main program for the moogle/kupo language
   3    Copyright (C) 2002,2001 Justin David Smith, Caltech
   4
   5    This program is free software; you can redistribute it and/or
   6    modify it under the terms of the GNU General Public License
   7    as published by the Free Software Foundation; either version 2
   8    of the License, or (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful,
  11    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13    GNU General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18  *)
  19 open Format
  20 open Moogle_ast_exn
  21
  22
  23 (***  Generic program options  ***)
  24
  25
  26 let output_file = ref None       (* Name of .ml file (None = stdout) *)
  27 let output_ifile = ref None      (* Name of .mli file (None = no interface) *)
  28 let output_file_ro = ref false   (* If true, make output file read-only *)
  29 let print_insts = ref false      (* Print instruction/transform tables? *)
  30 let print_rules = ref false      (* Print rewrite rules? *)
  31 let print_inline = ref false     (* Print inlined Kupo code? *)
  32
  33
  34 (* As input files are read, the kupo program we are building
  35    is stored here, in a single AST prog data structure.  *)
  36 let main_prog = ref Moogle_prog_ast.new_prog
  37
  38
  39 (***  Compilation  ***)
  40
  41
  42 (* parse_prog inx
  43    Parses a program that is read from the indicated input channel.
  44    The program data structure for this file only is returned.  *)
  45 let parse_prog inx =
  46    try
  47       let () = Moogle_ast_lex.reset_pos () in
  48       let lexbuf = Lexing.from_channel inx in
  49       let prog = Moogle_ast_parse.prog Moogle_ast_lex.main lexbuf in
  50          prog
  51    with
  52       Parsing.Parse_error ->
  53          raise (ASTException (exp_pos (!Moogle_state.current_pos), ParseError))
  54     | Sys_error s ->
  55          raise (ASTException (exp_pos (!Moogle_state.current_pos), SysError s))
  56
  57
  58 (* compile
  59    Compile the kupo file named into an AST program structure.
  60    After compilation, the AST structure will be concatenated to
  61    the end of the main_prog structure, defined above.  *)
  62 let compile file =
  63    Moogle_state.current_file := file;
  64    let inx =
  65       try open_in file with
  66          Sys_error s ->
  67             raise (ASTException (exp_pos (!Moogle_state.current_pos), SysError s))
  68    in
  69       try
  70          let prog = parse_prog inx in
  71          let () = close_in inx in
  72             main_prog := Moogle_prog_ast.prog_of_expr !main_prog file prog
  73       with
  74          Sys_error s ->
  75             close_in inx;
  76             raise (ASTException (exp_pos (!Moogle_state.current_pos), SysError s))
  77        | ASTException (pos, msg) as e ->
  78             close_in inx;
  79             raise e
  80
  81
  82 (* compile
  83    Similar to above function, but this version catches moogle
  84    error exceptions and prints the exception out, then exits
  85    with an abnormal return code.  *)
  86 let compile file =
  87    try
  88       compile file
  89    with
  90       ASTException (pos, msg) ->
  91          print_exn pos msg;
  92          exit 1
  93
  94
  95 (***  File Permission/Access Code  ***)
  96
  97
  98 (* get_file_permissions
  99    Get the current permissions on a named file.  *)
 100 let get_file_permissions file =
 101    let stats = Unix.stat file in
 102       stats.Unix.st_perm
 103
 104
 105 (* clear_write_bits
 106    Clear all write bits (user, group, and world) on a named file.
 107    This call only has an effect if the output_file_ro flag is true.  *)
 108 let clear_write_bits file =
 109    if !output_file_ro then begin
 110          let perm = get_file_permissions file in
 111          let perm = perm land (lnot 0o222) in
 112             Unix.chmod file perm
 113    end
 114
 115
 116 (* set_write_bit
 117    Set the user write bit on a named file, so it can be modified.
 118    This call only has an effect if the output_file_ro flag is true.  *)
 119 let set_write_bit file =
 120    if !output_file_ro then begin
 121       try
 122          let perm = get_file_permissions file in
 123          let perm = perm land 0o200 in
 124             Unix.chmod file perm
 125       with
 126          (* If the file doesn't exist here, it's not a big deal. *)
 127          Unix.Unix_error (Unix.ENOENT, _, _) ->
 128             ()
 129    end
 130
 131
 132 (* close_nonstdout_channel
 133    Closes the indicated output channel, *if* it is not stdout.  *)
 134 let close_nonstdout_channel out =
 135    if out <> stdout then
 136       close_out out
 137
 138
 139 (***  Parse Options  ***)
 140
 141
 142 (* version_info
 143    Print version information about moogleize.  *)
 144 let version_info () =
 145    Printf.printf "Moogleize for MCC (Mojave Compiler)\n";
 146    Printf.printf "Using Kupo Language Specification version %s\n" Moogle_state.kupo_language_specification;
 147    exit 1
 148
 149
 150 (* Define the program's options *)
 151 let usage = "usage: moogleize [options] [files...]"
 152
 153 let spec =
 154   ["Basic options",
 155      ["-o",             Mc_arg.String (fun s -> output_file := Some s),
 156                         "name of .ml file to write to (default: stdout)";
 157       "-oi",            Mc_arg.String (fun s -> output_ifile := Some s),
 158                         "name of .mli file to write to (default: no interface)";
 159       "-insts",         Mc_arg.Set print_insts,
 160                         "print instruction tables";
 161       "-rules",         Mc_arg.Set print_rules,
 162                         "print pattern-match rules";
 163       "-inline",        Mc_arg.Set print_inline,
 164                         "print inlined Kupo code blocks";
 165       "-version",       Mc_arg.Unit version_info,
 166                         "print version information"];
 167    "Advanced options (use with caution)",
 168      ["-max-star",      Mc_arg.Int (fun i -> Moogle_state.rule_max_star := i),
 169                         "set maximum number of instructions a * wildcard can match in an input pattern" ^
 170                         " (default: " ^ (string_of_int !Moogle_state.rule_max_star) ^ ")";
 171       "-long-match",    Mc_arg.Set Moogle_state.rule_wildcard_long,
 172                         "wildcards match the longest possible instruction sequence (may weaken peephole optimizations)" ^
 173                         (if !Moogle_state.rule_wildcard_long then " (default)" else "");
 174       "-short-match",   Mc_arg.Clear Moogle_state.rule_wildcard_long,
 175                         "wildcards match the shortest possible instruction sequence (recommended)" ^
 176                         (if not !Moogle_state.rule_wildcard_long then " (default)" else "");
 177       "-no-mangle",     Mc_arg.Clear Moogle_state.mangle_position_info,
 178                         "if specified, do not mangle position information in emitted ML files.";
 179       "-rdonly",        Mc_arg.Set output_file_ro,
 180                         "if specified, the output ML file is set as a read-only file, preventing" ^
 181                         " accidental modifications to the generated file.  If this is set, then" ^
 182                         " moogleize will be allowed to delete read-only output files as well."]]
 183
 184
 185 (***  Compile the Program  ***)
 186
 187
 188 (* run
 189    Take the main_prog expression (generated by the front-end compile above)
 190    and attempt to produce a real ML file as output.  Output is either sent
 191    to stdout, or to a named file.  The write bits on the file may be cleared
 192    if the -rdonly flag was specified.  *)
 193 let run () =
 194    (* Get the main_prog. *)
 195    Mc_arg.parse spec compile usage;
 196
 197    (* Make sure at least one interesting option was specified *)
 198    let () =
 199       if not (!print_insts || !print_rules || !print_inline) then
 200          raise (ASTException (exp_pos (!Moogle_state.current_pos),
 201             StringError "Neither -insts, -rules, nor -inline were specified on the command-line"))
 202    in
 203
 204    (* Compile the prog into an ML program *)
 205    let mlp, mlpi = Moogle_mlp_prog.mlp_of_prog_header !main_prog in
 206    let mlp, mlpi =
 207       if !print_insts then
 208          Moogle_mlp_prog.mlp_of_prog_insts mlp mlpi !main_prog
 209       else
 210          mlp, mlpi
 211    in
 212    let mlp, mlpi =
 213       if !print_rules then
 214          Moogle_mlp_prog.mlp_of_prog_rules mlp mlpi !main_prog
 215       else
 216          mlp, mlpi
 217    in
 218    let mlp, mlpi =
 219       if !print_inline then
 220          Moogle_mlp_prog.mlp_of_prog_inline_kupo mlp mlpi !main_prog
 221       else
 222          mlp, mlpi
 223    in
 224
 225    (* Create the output channel for the final ML file. *)
 226    let out =
 227       try
 228          match !output_file with
 229             Some file ->
 230                set_write_bit file;
 231                open_out file
 232           | None ->
 233                stdout
 234       with
 235          Sys_error s ->
 236             raise (ASTException (exp_pos (!Moogle_state.current_pos), SysError s))
 237        | Unix.Unix_error (err, fn, _) ->
 238             raise (ASTException (exp_pos (!Moogle_state.current_pos), SysError (sprintf "%s: %s" fn (Unix.error_message err))))
 239    in
 240    let outf = formatter_of_out_channel out in
 241    let () = pp_set_margin outf 128 in
 242    let pos () = exp_pos (!Moogle_state.current_pos) in
 243    let () =
 244       try
 245          Moogle_mlp_print.pp_print_program outf mlp;
 246          pp_print_newline outf ();
 247          close_nonstdout_channel out;
 248          match !output_file with
 249             Some file ->
 250                clear_write_bits file
 251           | None ->
 252                ()
 253       with
 254          Sys_error s ->
 255             pp_print_newline outf ();
 256             close_nonstdout_channel out;
 257             raise (ASTException (pos (), SysError s))
 258        | Unix.Unix_error (err, fn, _) ->
 259             close_nonstdout_channel out;
 260             raise (ASTException (pos (), SysError (sprintf "%s: %s" fn (Unix.error_message err))))
 261        | ASTException (pos, msg) as e ->
 262             close_nonstdout_channel out;
 263             raise e
 264    in
 265
 266    (* Now, attempt to emit the MLI file *)
 267    let () =
 268       match !output_ifile with
 269          Some file ->
 270             begin
 271             let () = set_write_bit file in
 272             let out = open_out file in
 273             let outf = formatter_of_out_channel out in
 274             let () = pp_set_margin outf 128 in
 275                try
 276                   Moogle_mlp_print.pp_print_interface outf mlpi;
 277                   pp_print_newline outf ();
 278                   close_out out;
 279                   clear_write_bits file
 280                with
 281                   Sys_error s ->
 282                      pp_print_newline outf ();
 283                      close_out out;
 284                      raise (ASTException (pos (), SysError s))
 285                 | Unix.Unix_error (err, fn, _) ->
 286                      close_out out;
 287                      raise (ASTException (pos (), SysError (sprintf "%s: %s" fn (Unix.error_message err))))
 288                 | ASTException (pos, msg) as e ->
 289                      close_out out;
 290                      raise e
 291             end
 292        | None ->
 293             ()
 294    in
 295       ()
 296
 297
 298 let () =
 299    try run () with
 300       ASTException (pos, msg) ->
 301          print_exn pos msg;
 302          exit 1
 303     | Moogle_prog_exn.ProgException (pos, msg) ->
 304          Moogle_prog_exn.print_exn pos msg;
 305          exit 1