blob: 0dd0d840e547a34cdcd731c1f8ff8043fa209b2a (
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
151
152
|
-- Main procedure of ortho debug back-end.
-- Copyright (C) 2005 Tristan Gingold
--
-- This program 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 of the License, or
-- (at your option) any later version.
--
-- This program 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 this program. If not, see <gnu.org/licenses>.
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)'Length >= 2 and then Argument (I)(2) = 'O' then
-- Skip -O[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;
pragma Unreferenced (Status);
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;
|
