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
|
-- Back-end specialization
-- Copyright (C) 2023 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 Types; use Types;
with Str_Table;
with Std_Names;
with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Sem_Specs;
package body Vhdl.Back_End is
function Get_String_As_String (Expr : Iir) return String is
begin
case Get_Kind (Expr) is
when Iir_Kind_String_Literal8 =>
declare
Len : constant Natural := Natural (Get_String_Length (Expr));
Id : constant String8_Id := Get_String8_Id (Expr);
Res : String (1 .. Len);
begin
for I in 1 .. Len loop
Res (I) := Str_Table.Char_String8 (Id, Pos32 (I));
end loop;
return Res;
end;
when Iir_Kind_Simple_Aggregate =>
declare
List : constant Iir_Flist := Get_Simple_Aggregate_List (Expr);
Len : constant Natural := Get_Nbr_Elements (List);
Res : String (1 .. Len);
El : Iir;
begin
for I in Flist_First .. Flist_Last (List) loop
El := Get_Nth_Element (List, I);
pragma Assert (Get_Kind (El) = Iir_Kind_Enumeration_Literal);
Res (I - Flist_First + 1) :=
Character'Val (Get_Enum_Pos (El));
end loop;
return Res;
end;
when others =>
if Get_Expr_Staticness (Expr) /= Locally then
Error_Msg_Sem
(+Expr, "value of FOREIGN attribute must be locally static");
return "";
else
raise Internal_Error;
end if;
end case;
end Get_String_As_String;
function Translate_Foreign_Id (Decl : Iir) return Foreign_Info_Type
is
-- Look for 'FOREIGN.
Attr : constant Iir_Attribute_Value :=
Vhdl.Sem_Specs.Find_Attribute_Value (Decl, Std_Names.Name_Foreign);
pragma Assert (Attr /= Null_Iir);
Spec : constant Iir_Attribute_Specification :=
Get_Attribute_Specification (Attr);
Name : constant String := Get_String_As_String (Get_Expression (Spec));
Length : constant Natural := Name'Length;
begin
if Length = 0 then
return Foreign_Bad;
end if;
pragma Assert (Name'First = 1);
-- Only 'VHPIDIRECT' is recognized.
if Length >= 10 and then Name (1 .. 10) = "VHPIDIRECT" then
declare
Info : Foreign_Info_Type (Foreign_Vhpidirect);
P : Natural;
Sf, Sl : Natural;
Lf, Ll : Natural;
begin
P := 11;
-- Skip spaces.
while P <= Length and then Name (P) = ' ' loop
P := P + 1;
end loop;
if P > Length then
Error_Msg_Sem
(+Spec, "missing subprogram/library name after VHPIDIRECT");
Info.Lib_Len := 0;
Info.Subprg_Len := 0;
return Info;
end if;
-- Extract library.
Lf := P;
while P <= Length and then Name (P) /= ' ' loop
P := P + 1;
end loop;
Ll := P - 1;
-- Extract subprogram.
while P <= Length and then Name (P) = ' ' loop
P := P + 1;
end loop;
Sf := P;
while P <= Length and then Name (P) /= ' ' loop
P := P + 1;
end loop;
Sl := P - 1;
if P <= Length then
Error_Msg_Sem (+Spec, "garbage at end of VHPIDIRECT");
end if;
-- Accept empty library.
if Sf > Length then
Sf := Lf;
Sl := Ll;
Lf := 1;
Ll := 0;
end if;
Info.Lib_Len := Ll - Lf + 1;
Info.Lib_Name (1 .. Info.Lib_Len) := Name (Lf .. Ll);
Info.Subprg_Len := Sl - Sf + 1;
Info.Subprg_Name (1 .. Info.Subprg_Len) := Name (Sf .. Sl);
return Info;
end;
elsif Length = 14
and then Name (1 .. 14) = "GHDL intrinsic"
then
return Foreign_Info_Type'(Kind => Foreign_Intrinsic);
else
Error_Msg_Sem
(+Spec,
"value of 'FOREIGN attribute does not begin with VHPIDIRECT");
return Foreign_Bad;
end if;
end Translate_Foreign_Id;
procedure Sem_Foreign_Wrapper (Decl : Iir)
is
Fi : Foreign_Info_Type;
begin
case Get_Kind (Decl) is
when Iir_Kind_Architecture_Body =>
Error_Msg_Sem (+Decl, "FOREIGN architectures are not yet handled");
when Iir_Kind_Procedure_Declaration
| Iir_Kind_Function_Declaration =>
null;
when others =>
Error_Kind ("sem_foreign", Decl);
end case;
-- Let it generate error messages.
Fi := Translate_Foreign_Id (Decl);
if Sem_Foreign_Hook /= null then
Sem_Foreign_Hook.all (Decl, Fi);
end if;
end Sem_Foreign_Wrapper;
end Vhdl.Back_End;
|
