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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
-- Mcode back-end for ortho - Main subprogram.
-- Copyright (C) 2006 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.Unchecked_Conversion;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Unchecked_Deallocation;
with Ada.Text_IO; use Ada.Text_IO;
with Binary_File; use Binary_File;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Ortho_Code.Debug;
with Ortho_Mcode; use Ortho_Mcode;
with Ortho_Front; use Ortho_Front;
with Ortho_Code.Flags; use Ortho_Code.Flags;
with Binary_File;
with Binary_File.Elf;
with Binary_File.Coff;
with Binary_File.Memory;
with Interfaces;
procedure Ortho_Code_Main
is
Output : String_Acc := null;
type Format_Type is (Format_Coff, Format_Elf);
Format : Format_Type := Format_Elf;
Fd : File_Descriptor;
First_File : Natural;
Opt : String_Acc;
Opt_Arg : String_Acc;
Filename : String_Acc;
Exec_Func : String_Acc;
Res : Natural;
I : Natural;
Argc : Natural;
procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
(Name => String_Acc, Object => String);
begin
First_File := Natural'Last;
Exec_Func := null;
Ortho_Front.Init;
Argc := Argument_Count;
I := 1;
while I <= Argc loop
declare
Arg : String := Argument (I);
begin
if Arg (1) = '-' then
if Arg'Length > 5 and then Arg (1 .. 5) = "--be-" then
Ortho_Code.Debug.Set_Be_Flag (Arg);
I := I + 1;
elsif Arg = "-o" then
if I = Argc then
Put_Line (Standard_Error, "error: missing filename to '-o'");
return;
end if;
Output := new String'(Argument (I + 1));
I := I + 2;
elsif Arg = "-quiet" then
-- Skip silently.
I := I + 1;
elsif Arg = "--exec" then
if I = Argc then
Put_Line (Standard_Error,
"error: missing function name to '--exec'");
return;
end if;
Exec_Func := new String'(Argument (I + 1));
I := I + 2;
elsif Arg = "-g" then
Flag_Debug := Debug_Dwarf;
I := I + 1;
elsif Arg = "-p" or Arg = "-pg" then
Flag_Profile := True;
I := I + 1;
else
-- This is really an argument.
Opt := new String'(Arg);
if I < Argument_Count then
Opt_Arg := new String'(Argument (I + 1));
else
Opt_Arg := null;
end if;
Res := Ortho_Front.Decode_Option (Opt, Opt_Arg);
case Res is
when 0 =>
Put_Line (Standard_Error, "unknown option '" & Arg & "'");
return;
when 1 =>
I := I + 1;
when 2 =>
I := I + 2;
when others =>
raise Program_Error;
end case;
Unchecked_Deallocation (Opt);
Unchecked_Deallocation (Opt_Arg);
end if;
else
First_File := I;
exit;
end if;
end;
end loop;
Ortho_Mcode.Init;
Set_Exit_Status (Failure);
if First_File > Argument_Count then
begin
if not Parse (null) then
return;
end if;
exception
when others =>
return;
end;
else
for I in First_File .. Argument_Count loop
Filename := new String'(Argument (First_File));
begin
if not Parse (Filename) then
return;
end if;
exception
when others =>
return;
end;
end loop;
end if;
Ortho_Mcode.Finish;
if Ortho_Code.Debug.Flag_Debug_Hli then
Set_Exit_Status (Success);
return;
end if;
if Output /= null then
Fd := Create_File (Output.all, Binary);
if Fd /= Invalid_FD then
case Format is
when Format_Elf =>
Binary_File.Elf.Write_Elf (Fd);
when Format_Coff =>
Binary_File.Coff.Write_Coff (Fd);
end case;
Close (Fd);
end if;
elsif Exec_Func /= null then
declare
use Binary_File;
use Interfaces;
use Ada.Text_IO;
Sym : Symbol;
type Func_Acc is access function return Integer;
function Conv is new Ada.Unchecked_Conversion
(Source => Unsigned_32, Target => Func_Acc);
F : Func_Acc;
V : Integer;
Err : Boolean;
begin
Binary_File.Memory.Write_Memory_Init;
Binary_File.Memory.Write_Memory_Relocate (Err);
if Err then
return;
end if;
Sym := Binary_File.Get_Symbol (Exec_Func.all);
if Sym = Null_Symbol then
Put_Line (Standard_Error, "no '" & Exec_Func.all & "' symbol");
else
F := Conv (Get_Symbol_Vaddr (Sym));
V := F.all;
Put_Line ("Result is " & Integer'Image (V));
end if;
end;
end if;
Set_Exit_Status (Success);
exception
when others =>
Set_Exit_Status (2);
raise;
end Ortho_Code_Main;
|
