summaryrefslogtreecommitdiff
path: root/ortho/debug/ortho_debug-main.adb
blob: 714b85332a666ae4074c4987706ef044f16f4d16 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
--  Main procedure of ortho debug back-end.
--  Copyright (C) 2005 Tristan Gingold
--
--  GHDL is free software; you can redistribute it and/or modify it under
--  the terms of the GNU General Public License as published by the Free
--  Software Foundation; either version 2, or (at your option) any later
--  version.
--
--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
--  for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with GCC; see the file COPYING.  If not, write to the Free
--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
--  02111-1307, USA.
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Unchecked_Deallocation;
with Ada.Text_IO; use Ada.Text_IO;
with Ortho_Debug; use Ortho_Debug;
with Ortho_Debug_Front; use Ortho_Debug_Front;
with Ortho_Debug.Disp;
with System; use System;
with Interfaces.C_Streams; use Interfaces.C_Streams;

procedure Ortho_Debug.Main is
   --  Do not output the ortho code.
   Flag_Silent : Boolean := False;

   --  Force output, even in case of crash.
   Flag_Force : Boolean := False;

   I : Natural;
   Argc : Natural;
   Arg : String_Acc;
   Opt : String_Acc;
   Res : Natural;
   File : String_Acc;
   Output : FILEs;
   R : Boolean;

   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
     (Name => String_Acc, Object => String);
begin
   Ortho_Debug_Front.Init;
   Output := NULL_Stream;

   Set_Exit_Status (Failure);

   --  Decode options.
   Argc := Argument_Count;
   I := 1;
   loop
      exit when I > Argc;
      exit when Argument (I) (1) /= '-';
      if Argument (I) = "--silent" or else Argument (I) = "-quiet" then
         Flag_Silent := True;
         I := I + 1;
      elsif Argument (I) = "--force" then
         Flag_Force := True;
         I := I + 1;
      elsif Argument (I)'Length >= 2 and then Argument (I)(2) = 'g' then
         --  Skip -g[XXX] flags.
         I := I + 1;
      elsif Argument (I) = "-o" and then I + 1 <= Argc then
         --  TODO: write the output to the file ?
         if Output /= NULL_Stream then
            Put_Line (Command_Name & ": only one output allowed");
            return;
         end if;
         declare
            Name : String := Argument (I + 1) & ASCII.Nul;
            Mode : String := 'w' & ASCII.Nul;
         begin
            Output := fopen (Name'Address, Mode'Address);
            if Output = NULL_Stream then
               Put_Line (Command_Name & ": cannot open " & Argument (I + 1));
               return;
            end if;
         end;
         I := I + 2;
      else
         Opt := new String'(Argument (I));
         if I < Argc then
            Arg := new String'(Argument (I + 1));
         else
            Arg := null;
         end if;
         Res := Ortho_Debug_Front.Decode_Option (Opt, Arg);
         Unchecked_Deallocation (Opt);
         Unchecked_Deallocation (Arg);
         if Res = 0 then
            Put_Line (Argument (I) & ": unknown option");
            return;
         else
            I := I + Res;
         end if;
      end if;
   end loop;

   --  Initialize tree.
   begin
      Ortho_Debug.Init;

      if I <= Argc then
         R := True;
         for J in I .. Argc loop
            File := new String'(Argument (J));
            R := R and Ortho_Debug_Front.Parse (File);
            Unchecked_Deallocation (File);
         end loop;
      else
         R := Ortho_Debug_Front.Parse (null);
      end if;
      Ortho_Debug.Finish;
   exception
      when others =>
         if not Flag_Force then
            raise;
         else
            R := False;
         end if;
   end;

   --  Write down the result.
   if (R and (Output /= NULL_Stream or not Flag_Silent))
     or Flag_Force
   then
      if Output = NULL_Stream then
         Ortho_Debug.Disp.Init_Context (stdout);
      else
         Ortho_Debug.Disp.Init_Context (Output);
      end if;
      Ortho_Debug.Disp.Disp_Ortho (Ortho_Debug.Top);
      if Output /= NULL_Stream then
         declare
            Status : int;
         begin
            Status := fclose (Output);
         end;
      end if;
   end if;

   if R then
      Set_Exit_Status (Success);
   else
      Set_Exit_Status (Failure);
   end if;
end Ortho_Debug.Main;