OpenAADL / ocarina
1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--    O C A R I N A . B A C K E N D S . A S N 1 _ T R E E . N U T I L S     --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--         Copyright (C) 2010-2019 ESA & ISAE, 2019-2020 OpenAADL           --
10
--                                                                          --
11
-- Ocarina  is free software; you can redistribute it and/or modify under   --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
15
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
16
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 3.1, as published by the Free Software Foundation.               --
21
--                                                                          --
22
-- You should have received a copy of the GNU General Public License and    --
23
-- a copy of the GCC Runtime Library Exception along with this program;     --
24
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
27
--                    Ocarina is maintained by OpenAADL team                --
28
--                              (info@openaadl.org)                         --
29
--                                                                          --
30
------------------------------------------------------------------------------
31

32
with GNAT.Table;
33

34
with Ocarina.Namet; use Ocarina.Namet;
35
with Charset;       use Charset;
36
with Locations;     use Locations;
37

38
with Ocarina.Backends.ASN1_Tree.Nodes;
39
with Ocarina.ME_AADL.AADL_Instances.Nodes;
40

41
use Ocarina.Backends.ASN1_Tree.Nodes;
42

43 1
package body Ocarina.Backends.ASN1_Tree.Nutils is
44

45
   package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
46

47
   Initialized : Boolean := False;
48

49
   Keyword_Suffix : constant String := "%C";
50
   --  Used to mark C keywords and avoid collision with other languages
51

52
   type Entity_Stack_Entry is record
53
      Current_File   : Node_Id;
54
      Current_Entity : Node_Id;
55
   end record;
56

57
   No_Depth : constant Int := -1;
58
   package Entity_Stack is new GNAT.Table
59
     (Entity_Stack_Entry,
60
      Int,
61
      No_Depth + 1,
62
      10,
63
      10);
64

65
   procedure New_Operator (O : Operator_Type; I : String := "");
66

67
   ------------------------
68
   -- Add_Prefix_To_Name --
69
   ------------------------
70

71 0
   function Add_Prefix_To_Name
72
     (Prefix : String;
73
      Name   : Name_Id) return Name_Id
74
   is
75
   begin
76 0
      Set_Str_To_Name_Buffer (Prefix);
77 0
      Get_Name_String_And_Append (Name);
78 0
      return Name_Find;
79
   end Add_Prefix_To_Name;
80

81
   ------------------------
82
   -- Add_Suffix_To_Name --
83
   ------------------------
84

85 1
   function Add_Suffix_To_Name
86
     (Suffix : String;
87
      Name   : Name_Id) return Name_Id
88
   is
89
   begin
90 1
      Get_Name_String (Name);
91 1
      Add_Str_To_Name_Buffer (Suffix);
92 1
      return Name_Find;
93
   end Add_Suffix_To_Name;
94

95
   -----------------------------
96
   -- Remove_Suffix_From_Name --
97
   -----------------------------
98

99 0
   function Remove_Suffix_From_Name
100
     (Suffix : String;
101
      Name   : Name_Id) return Name_Id
102
   is
103 0
      Length   : Natural;
104 0
      Temp_Str : String (1 .. Suffix'Length);
105
   begin
106 0
      Set_Str_To_Name_Buffer (Suffix);
107 0
      Length := Name_Len;
108 0
      Get_Name_String (Name);
109 0
      if Name_Len > Length then
110 0
         Temp_Str := Name_Buffer (Name_Len - Length + 1 .. Name_Len);
111 0
         if Suffix = Temp_Str then
112 0
            Set_Str_To_Name_Buffer (Name_Buffer (1 .. Name_Len - Length));
113 0
            return Name_Find;
114
         end if;
115
      end if;
116 0
      return Name;
117
   end Remove_Suffix_From_Name;
118

119
   --------------
120
   -- New_List --
121
   --------------
122

123 1
   function New_List
124
     (Kind : ASN1_Nodes.Node_Kind;
125
      From : Node_Id := No_Node) return List_Id
126
   is
127 1
      N : Node_Id;
128
   begin
129 1
      ASN1_Nodes.Entries.Increment_Last;
130 1
      N                            := ASN1_Nodes.Entries.Last;
131 1
      ASN1_Nodes.Entries.Table (N) := ASN1_Nodes.Default_Node;
132 1
      Set_Kind (N, Kind);
133 1
      if Present (From) then
134 0
         ASN1_Nodes.Set_Loc (N, ASN1_Nodes.Loc (From));
135
      else
136 1
         ASN1_Nodes.Set_Loc (N, No_Location);
137
      end if;
138 1
      return List_Id (N);
139
   end New_List;
140

141
   -------------------------
142
   -- Append_Node_To_List --
143
   -------------------------
144

145 1
   procedure Append_Node_To_List (E : Node_Id; L : List_Id) is
146 1
      Last : Node_Id;
147

148
   begin
149 1
      Last := ASN1_Nodes.Last_Node (L);
150 1
      if No (Last) then
151 1
         ASN1_Nodes.Set_First_Node (L, E);
152
      else
153 1
         ASN1_Nodes.Set_Next_Node (Last, E);
154
      end if;
155 1
      Last := E;
156 1
      while Present (Last) loop
157 1
         ASN1_Nodes.Set_Last_Node (L, Last);
158 1
         Last := ASN1_Nodes.Next_Node (Last);
159 1
      end loop;
160 1
   end Append_Node_To_List;
161

162
   -----------------------
163
   -- Insert_After_Node --
164
   -----------------------
165

166 0
   procedure Insert_After_Node (E : Node_Id; N : Node_Id) is
167 0
      Next : constant Node_Id := ASN1_Nodes.Next_Node (N);
168
   begin
169 0
      ASN1_Nodes.Set_Next_Node (N, E);
170 0
      ASN1_Nodes.Set_Next_Node (E, Next);
171 0
   end Insert_After_Node;
172

173
   ------------------------
174
   -- Insert_Before_Node --
175
   ------------------------
176

177 0
   procedure Insert_Before_Node (E : Node_Id; N : Node_Id; L : List_Id) is
178 0
      Entity : Node_Id;
179
   begin
180 0
      Entity := ASN1_Nodes.First_Node (L);
181 0
      if Entity = N then
182 0
         ASN1_Nodes.Set_Next_Node (E, Entity);
183 0
         ASN1_Nodes.Set_First_Node (L, E);
184
      else
185 0
         while Present (Entity) loop
186 0
            exit when ASN1_Nodes.Next_Node (Entity) = N;
187 0
            Entity := ASN1_Nodes.Next_Node (Entity);
188 0
         end loop;
189

190 0
         Insert_After_Node (E, Entity);
191
      end if;
192 0
   end Insert_Before_Node;
193

194
   ---------------
195
   -- Copy_Node --
196
   ---------------
197

198 0
   function Copy_Node (N : Node_Id) return Node_Id is
199 0
      C : Node_Id;
200
   begin
201 0
      case ASN1_Nodes.Kind (N) is
202
         when ASN1_Nodes.K_Defining_Identifier =>
203 0
            C := New_Node (ASN1_Nodes.K_Defining_Identifier);
204 0
            ASN1_Nodes.Set_Name (C, ASN1_Nodes.Name (N));
205 0
            ASN1_Nodes.Set_Corresponding_Node
206
              (C,
207 0
               ASN1_Nodes.Corresponding_Node (N));
208

209
         when others =>
210 0
            raise Program_Error;
211
      end case;
212 0
      return C;
213
   end Copy_Node;
214

215
   -----------
216
   -- Image --
217
   -----------
218

219 1
   function Image (T : Token_Type) return String is
220 1
      S : String := Token_Type'Image (T);
221
   begin
222 1
      To_Lower (S);
223 1
      return S (5 .. S'Last);
224 1
   end Image;
225

226
   -----------
227
   -- Image --
228
   -----------
229

230 1
   function Image (O : Operator_Type) return String is
231 1
      S : String := Operator_Type'Image (O);
232
   begin
233 1
      To_Lower (S);
234 1
      for I in S'First .. S'Last loop
235 1
         if S (I) = '_' then
236 1
            S (I) := ' ';
237
         end if;
238 1
      end loop;
239 1
      return S (4 .. S'Last);
240 1
   end Image;
241

242
   ----------------
243
   -- Initialize --
244
   ----------------
245

246 1
   procedure Initialize is
247
   begin
248
      --  Initialize Nutils only once
249

250 1
      if Initialized then
251 1
         return;
252
      end if;
253

254 1
      Initialized := True;
255

256
      --  Keywords.
257 1
      for I in Keyword_Type loop
258 1
         New_Token (I);
259 1
      end loop;
260

261
      --  Graphic Characters
262 1
      New_Token (Tok_Module, "MODULE");
263 1
      New_Token (Tok_And, "&&");
264 1
      New_Token (Tok_Xor, "^");
265 1
      New_Token (Tok_Sharp, "#");
266 1
      New_Token (Tok_Or, "||");
267 1
      New_Token (Tok_Left_Brace, "{");
268 1
      New_Token (Tok_Right_Brace, "}");
269 1
      New_Token (Tok_Mod, "%");
270 1
      New_Token (Tok_Not, "!");
271 1
      New_Token (Tok_Ampersand, "&");
272 1
      New_Token (Tok_Minus, "-");
273 1
      New_Token (Tok_Underscore, "_");
274 1
      New_Token (Tok_Plus, "+");
275 1
      New_Token (Tok_Asterisk, "*");
276 1
      New_Token (Tok_Slash, "/");
277 1
      New_Token (Tok_Dot, ".");
278 1
      New_Token (Tok_Apostrophe, "'");
279 1
      New_Token (Tok_Left_Paren, "(");
280 1
      New_Token (Tok_Right_Paren, ")");
281 1
      New_Token (Tok_Left_Hook, "[");
282 1
      New_Token (Tok_Right_Hook, "]");
283 1
      New_Token (Tok_Comma, ",");
284 1
      New_Token (Tok_Less, "<");
285 1
      New_Token (Tok_Equal, "=");
286 1
      New_Token (Tok_Equal_Equal, "==");
287 1
      New_Token (Tok_Greater, ">");
288 1
      New_Token (Tok_Not_Equal, "!=");
289 1
      New_Token (Tok_Greater_Equal, ">=");
290 1
      New_Token (Tok_Less_Equal, "<=");
291 1
      New_Token (Tok_Colon, ":");
292 1
      New_Token (Tok_Greater_Greater, ">>");
293 1
      New_Token (Tok_Less_Less, "<<");
294 1
      New_Token (Tok_Quote, """");
295 1
      New_Token (Tok_Semicolon, ";");
296 1
      New_Token (Tok_Arrow, "->");
297 1
      New_Token (Tok_Vertical_Bar, "|");
298

299 1
      for O in Op_And .. Op_Or_Else loop
300 1
         New_Operator (O);
301 1
      end loop;
302 1
      New_Operator (Op_And_Symbol, "&");
303 1
      New_Operator (Op_Double_Asterisk, "**");
304 1
      New_Operator (Op_Asterisk, "**");
305 1
      New_Operator (Op_Minus, "-");
306 1
      New_Operator (Op_Plus, "+");
307 1
      New_Operator (Op_Asterisk, "*");
308 1
      New_Operator (Op_Slash, "/");
309 1
      New_Operator (Op_Less, "<");
310 1
      New_Operator (Op_Equal, "=");
311 1
      New_Operator (Op_Equal_Equal, "==");
312 1
      New_Operator (Op_Greater, ">");
313 1
      New_Operator (Op_Not_Equal, "!=");
314 1
      New_Operator (Op_Greater_Equal, ">=");
315 1
      New_Operator (Op_Less_Equal, "<=");
316 1
      New_Operator (Op_Greater_Greater, ">>");
317 1
      New_Operator (Op_Less_Less, "<<");
318 1
      New_Operator (Op_Semicolon, ";");
319 1
      New_Operator (Op_Arrow, "=>");
320 1
      New_Operator (Op_Vertical_Bar, "|");
321
   end Initialize;
322

323
   -----------
324
   -- Reset --
325
   -----------
326

327 1
   procedure Reset is
328
   begin
329 1
      Entity_Stack.Init;
330

331 1
      Initialized := False;
332 1
   end Reset;
333

334
   --------------
335
   -- Is_Empty --
336
   --------------
337

338 1
   function Is_Empty (L : List_Id) return Boolean is
339
   begin
340 1
      return L = No_List or else No (ASN1_Nodes.First_Node (L));
341
   end Is_Empty;
342

343
   ------------
344
   -- Length --
345
   ------------
346

347 1
   function Length (L : List_Id) return Natural is
348 1
      N : Node_Id;
349 1
      C : Natural := 0;
350
   begin
351 1
      if not Is_Empty (L) then
352 1
         N := ASN1_Nodes.First_Node (L);
353

354 1
         while Present (N) loop
355 1
            C := C + 1;
356 1
            N := ASN1_Nodes.Next_Node (N);
357 1
         end loop;
358
      end if;
359

360 1
      return C;
361
   end Length;
362

363
   --------------
364
   -- New_Node --
365
   --------------
366

367 1
   function New_Node
368
     (Kind : ASN1_Nodes.Node_Kind;
369
      From : Node_Id := No_Node) return Node_Id
370
   is
371 1
      N : Node_Id;
372
   begin
373 1
      ASN1_Nodes.Entries.Increment_Last;
374 1
      N                            := ASN1_Nodes.Entries.Last;
375 1
      ASN1_Nodes.Entries.Table (N) := ASN1_Nodes.Default_Node;
376 1
      ASN1_Nodes.Set_Kind (N, Kind);
377

378 1
      if Present (From) then
379 0
         ASN1_Nodes.Set_Loc (N, AIN.Loc (From));
380
      else
381 1
         ASN1_Nodes.Set_Loc (N, No_Location);
382
      end if;
383

384 1
      return N;
385
   end New_Node;
386

387
   ---------------
388
   -- New_Token --
389
   ---------------
390

391 1
   procedure New_Token (T : Token_Type; I : String := "") is
392 1
      Name : Name_Id;
393
   begin
394 1
      if T in Keyword_Type then
395
         --  Marking the token image as a keyword for fas searching
396
         --  purpose, we add the prefix to avoir collision with other
397
         --  languages keywords
398

399 1
         Set_Str_To_Name_Buffer (Image (T));
400 1
         Name := Name_Find;
401 1
         Name := Add_Suffix_To_Name (Keyword_Suffix, Name);
402 1
         Set_Name_Table_Byte
403
           (Name,
404 1
            Ocarina.Types.Byte (Token_Type'Pos (T) + 1));
405

406 1
         Set_Str_To_Name_Buffer (Image (T));
407
      else
408 1
         Set_Str_To_Name_Buffer (I);
409
      end if;
410 1
      Token_Image (T) := Name_Find;
411 1
   end New_Token;
412

413
   ------------------
414
   -- New_Operator --
415
   ------------------
416

417 1
   procedure New_Operator (O : Operator_Type; I : String := "") is
418
   begin
419 1
      if O in Keyword_Operator then
420 1
         Set_Str_To_Name_Buffer (Image (O));
421
      else
422 1
         Set_Str_To_Name_Buffer (I);
423
      end if;
424 1
      Operator_Image (Operator_Type'Pos (O)) := Name_Find;
425 1
   end New_Operator;
426

427
   --------------------
428
   -- Make_ASN1_File --
429
   --------------------
430

431 1
   function Make_ASN1_File (Identifier : Node_Id) return Node_Id is
432 1
      File : Node_Id;
433
   begin
434 1
      File := New_Node (K_ASN1_File);
435 1
      Set_Defining_Identifier (File, Identifier);
436 1
      Set_Corresponding_Node (Identifier, File);
437

438 1
      Set_Module_Node (File, New_Node (K_ASN1_Module));
439 1
      Set_Name (Module_Node (File), Get_String_Name ("unknownmodule"));
440 1
      Set_Definitions (Module_Node (File), New_List (K_List_Id));
441 1
      return File;
442
   end Make_ASN1_File;
443

444
   ------------------------------
445
   -- Make_Defining_Identifier --
446
   ------------------------------
447

448 1
   function Make_Defining_Identifier (Name : Name_Id) return Node_Id is
449 1
      N : Node_Id;
450
   begin
451 1
      N := New_Node (K_Defining_Identifier);
452 1
      Set_Name (N, Name);
453 1
      return N;
454
   end Make_Defining_Identifier;
455

456
   ---------------------------
457
   -- Make_Enumerated_Value --
458
   ---------------------------
459

460 1
   function Make_Enumerated_Value (Name : Name_Id) return Node_Id is
461 1
      N : Node_Id;
462
   begin
463 1
      N := New_Node (K_Enumerated_Value);
464 1
      Set_Name (N, Name);
465 1
      Set_Value (N, No_Value);
466 1
      return N;
467
   end Make_Enumerated_Value;
468

469
   ---------------------------
470
   -- Make_Enumerated_Value --
471
   ---------------------------
472

473 1
   function Make_Enumerated_Value
474
     (Name : Name_Id;
475
      V    : Unsigned_Long_Long) return Node_Id
476
   is
477 1
      N : Node_Id;
478
   begin
479 1
      N := Make_Enumerated_Value (Name);
480 1
      Set_Value (N, ASN1_Values.New_Int_Value (V, 1, 10));
481 1
      return N;
482
   end Make_Enumerated_Value;
483

484
   --------------------------
485
   -- Make_Type_Definition --
486
   --------------------------
487

488 1
   function Make_Type_Definition
489
     (Name : Name_Id;
490
      Decl : Node_Id) return Node_Id
491
   is
492 1
      N : Node_Id;
493
   begin
494 1
      N := New_Node (K_Type_Definition);
495 1
      Set_Name (N, Name);
496 1
      Set_Declaration (N, Decl);
497 1
      return N;
498
   end Make_Type_Definition;
499

500
   ---------------------
501
   -- Make_Enumerated --
502
   ---------------------
503

504 0
   function Make_Enumerated return Node_Id is
505 0
      N : Node_Id;
506
   begin
507 0
      N := New_Node (K_Enumerated);
508 0
      Set_Values (N, New_List (K_Enumerated_Value));
509 0
      return N;
510
   end Make_Enumerated;
511

512
   ---------------------
513
   -- Make_Enumerated --
514
   ---------------------
515

516 1
   function Make_Enumerated (L : List_Id) return Node_Id is
517 1
      N : Node_Id;
518
   begin
519 1
      N := New_Node (K_Enumerated);
520 1
      Set_Values (N, L);
521 1
      return N;
522
   end Make_Enumerated;
523

524
   -------------------
525
   -- Make_Sequence --
526
   -------------------
527

528 1
   function Make_Sequence (Sequence_Members : List_Id) return Node_Id is
529 1
      N : Node_Id;
530
   begin
531 1
      N := New_Node (K_Sequence);
532 1
      Set_Values (N, Sequence_Members);
533 1
      return N;
534
   end Make_Sequence;
535

536
   --------------------------
537
   -- Make_Sequence_Member --
538
   --------------------------
539

540 1
   function Make_Sequence_Member
541
     (Member_Name : Name_Id;
542
      Member_Type : Node_Id) return Node_Id
543
   is
544 1
      N : Node_Id;
545
   begin
546 1
      N := New_Node (K_Sequence_Member);
547 1
      Set_Member_Name (N, Member_Name);
548 1
      Set_Member_Type (N, Member_Type);
549 1
      return N;
550
   end Make_Sequence_Member;
551

552
   -----------------
553
   -- Make_Choice --
554
   -----------------
555

556 1
   function Make_Choice (Choice_Members : List_Id) return Node_Id is
557 1
      N : Node_Id;
558
   begin
559 1
      N := New_Node (K_Choice);
560 1
      Set_Values (N, Choice_Members);
561 1
      return N;
562
   end Make_Choice;
563

564
   ------------------------
565
   -- Make_Choice_Member --
566
   ------------------------
567

568 1
   function Make_Choice_Member
569
     (Member_Name : Name_Id;
570
      Member_Type : Node_Id) return Node_Id
571
   is
572 1
      N : Node_Id;
573
   begin
574 1
      N := New_Node (K_Choice_Member);
575 1
      Set_Member_Name (N, Member_Name);
576 1
      Set_Member_Type (N, Member_Type);
577 1
      return N;
578
   end Make_Choice_Member;
579

580
   ------------------
581
   -- Make_Literal --
582
   ------------------
583

584 0
   function Make_Literal (Value : Value_Id) return Node_Id is
585 0
      N : Node_Id;
586
   begin
587 0
      N := New_Node (K_Literal);
588 0
      ASN1_Nodes.Set_Value (N, Value);
589 0
      return N;
590
   end Make_Literal;
591

592
   ---------------------------
593
   -- Make_Type_Constraints --
594
   ---------------------------
595

596 1
   function Make_Type_Constraints
597
     (Size_Up   : Value_Id := No_Value;
598
      Size_Down : Value_Id := No_Value) return Node_Id
599
   is
600 1
      N : Node_Id;
601
   begin
602 1
      N := New_Node (K_Type_Constraints);
603 1
      ASN1_Nodes.Set_Size_Up (N, Size_Up);
604 1
      ASN1_Nodes.Set_Size_Down (N, Size_Down);
605 1
      return N;
606
   end Make_Type_Constraints;
607

608
   --------------------------
609
   -- Make_Type_Designator --
610
   --------------------------
611

612 1
   function Make_Type_Designator
613
     (Type_Name        : Node_Id;
614
      Type_Constraints : Node_Id := No_Node) return Node_Id
615
   is
616 1
      N : Node_Id;
617
   begin
618 1
      N := New_Node (K_Type_Designator);
619 1
      ASN1_Nodes.Set_Type_Name (N, Type_Name);
620 1
      ASN1_Nodes.Set_Constraints (N, Type_Constraints);
621 1
      return N;
622
   end Make_Type_Designator;
623

624 1
end Ocarina.Backends.ASN1_Tree.Nutils;

Read our documentation on viewing source code .

Loading