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
|
-- GCC back-end for ortho.
-- Copyright (C) 2002-1014 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_Deallocation;
with Ortho_Gcc_Front; use Ortho_Gcc_Front;
package body Ortho_Gcc is
function New_Lit (Lit : O_Cnode) return O_Enode is
begin
return O_Enode (Lit);
end New_Lit;
function New_Obj (Obj : O_Dnode) return O_Lnode is
begin
return O_Lnode (Obj);
end New_Obj;
function New_Global (Decl : O_Dnode) return O_Gnode is
begin
return O_Gnode (Decl);
end New_Global;
function New_Global_Selected_Element (Rec : O_Gnode; El : O_Fnode)
return O_Gnode is
begin
return O_Gnode (New_Selected_Element (O_Lnode (Rec), El));
end New_Global_Selected_Element;
function New_Obj_Value (Obj : O_Dnode) return O_Enode is
begin
return O_Enode (Obj);
end New_Obj_Value;
procedure New_Debug_Filename_Decl (Filename : String) is
begin
null;
end New_Debug_Filename_Decl;
procedure New_Debug_Comment_Decl (Comment : String)
is
pragma Unreferenced (Comment);
begin
null;
end New_Debug_Comment_Decl;
procedure New_Debug_Comment_Stmt (Comment : String)
is
pragma Unreferenced (Comment);
begin
null;
end New_Debug_Comment_Stmt;
-- Representation of a C String: this is an access to a bounded string.
-- Therefore, with GNAT, such an access is a thin pointer.
subtype Fat_C_String is String (Positive);
type C_String is access all Fat_C_String;
pragma Convention (C, C_String);
C_String_Null : constant C_String := null;
-- Return the length of a C String (ie, the number of characters before
-- the Nul).
function C_String_Len (Str : C_String) return Natural;
pragma Import (C, C_String_Len, "strlen");
function Lang_Handle_Option (Opt : C_String; Arg : C_String)
return Integer;
pragma Export (C, Lang_Handle_Option);
function Lang_Parse_File (Filename : C_String) return Integer;
pragma Export (C, Lang_Parse_File);
function Lang_Handle_Option (Opt : C_String; Arg : C_String)
return Integer
is
procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
(Name => String_Acc, Object => String);
Res : Natural;
Ada_Opt : String_Acc;
Ada_Arg : String_Acc;
Len : Natural;
begin
Len := C_String_Len (Opt);
Ada_Opt := new String'(Opt (1 .. Len));
if Arg /= C_String_Null then
Len := C_String_Len (Arg);
Ada_Arg := new String'(Arg (1 .. Len));
else
Ada_Arg := null;
end if;
Res := Ortho_Gcc_Front.Decode_Option (Ada_Opt, Ada_Arg);
Unchecked_Deallocation (Ada_Opt);
Unchecked_Deallocation (Ada_Arg);
return Res;
end Lang_Handle_Option;
function Lang_Parse_File (Filename : C_String) return Integer
is
Len : Natural;
File : String_Acc;
begin
if Filename = C_String_Null then
File := null;
else
Len := C_String_Len (Filename);
File := new String'(Filename.all (1 .. Len));
end if;
if Ortho_Gcc_Front.Parse (File) then
return 1;
else
return 0;
end if;
end Lang_Parse_File;
end Ortho_Gcc;
|
