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
|
-- 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_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;
|
