l4/pkg/ocaml/contrib/asmcomp/codegen.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id: codegen.ml 3123 2000-04-21 08:13:22Z weis $ *)
  14
  15 (* From C-- to assembly code *)
  16
  17 open Format
  18 open Cmm
  19
  20 let dump_cmm = ref false
  21 let dump_selection = ref false
  22 let dump_live = ref false
  23 let dump_spill = ref false
  24 let dump_split = ref false
  25 let dump_interf = ref false
  26 let dump_prefer = ref false
  27 let dump_regalloc = ref false
  28 let dump_reload = ref false
  29 let dump_linear = ref false
  30
  31 let rec regalloc fd =
  32   if !dump_live then Printmach.phase "Liveness analysis" fd;
  33   Interf.build_graph fd;
  34   if !dump_interf then Printmach.interferences();
  35   if !dump_prefer then Printmach.preferences();
  36   Coloring.allocate_registers();
  37   if !dump_regalloc then
  38     Printmach.phase "After register allocation" fd;
  39   let (newfd, redo_regalloc) = Reload.fundecl fd in
  40   if !dump_reload then
  41     Printmach.phase "After insertion of reloading code" newfd;
  42   if redo_regalloc
  43   then begin Reg.reinit(); Liveness.fundecl newfd; regalloc newfd end
  44   else newfd
  45
  46 let fundecl ppf fd_cmm =
  47   if !dump_cmm then begin
  48     fprintf ppf "*** C-- code@.";
  49     fprintf ppf "%a@." Printcmm.fundecl fd_cmm
  50   end;
  51   Reg.reset();
  52   let fd_sel = Sequence.fundecl fd_cmm in
  53   if !dump_selection then
  54     Printmach.phase "After instruction selection" fd_sel;
  55   Liveness.fundecl fd_sel;
  56   if !dump_live then Printmach.phase "Liveness analysis" fd_sel;
  57   let fd_spill = Spill.fundecl fd_sel in
  58   Liveness.fundecl fd_spill;
  59   if !dump_spill then
  60     Printmach.phase "After spilling" fd_spill;
  61   let fd_split = Split.fundecl fd_spill in
  62   Liveness.fundecl fd_split;
  63   if !dump_split then
  64     Printmach.phase "After live range splitting" fd_split;
  65   let fd_reload = regalloc fd_split in
  66   let fd_linear = Linearize.fundecl fd_reload in
  67   if !dump_linear then begin
  68     printf "*** Linearized code@.";
  69     Printlinear.fundecl fd_linear; print_newline()
  70   end;
  71   Emit.fundecl fd_linear
  72
  73 let phrase = function
  74     Cfunction fd -> fundecl fd
  75   | Cdata dl -> Emit.data dl
  76
  77 let file filename =
  78   let ic = open_in filename in
  79   let lb = Lexing.from_channel ic in
  80   try
  81     while true do
  82       phrase(Parsecmm.phrase Lexcmm.token lb)
  83     done
  84   with
  85       End_of_file ->
  86         close_in ic
  87     | Lexcmm.Error msg ->
  88         close_in ic; Lexcmm.report_error lb msg
  89     | Parsing.Parse_error ->
  90         close_in ic;
  91         prerr_string "Syntax error near character ";
  92         prerr_int (Lexing.lexeme_start lb);
  93         prerr_newline()
  94     | Parsecmmaux.Error msg ->
  95         close_in ic; Parsecmmaux.report_error msg
  96     | x ->
  97         close_in ic; raise x
  98
  99
 100
 101