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

33
with GNAT.OS_Lib; use GNAT.OS_Lib;
34
with GNAT.Case_Util;
35

36
with Utils; use Utils;
37

38
with Charset;       use Charset;
39
with Ocarina.Namet; use Ocarina.Namet;
40

41
with Ocarina.Backends.C_Tree.Nodes;
42
with Ocarina.Backends.C_Tree.Nutils;
43

44 1
package body Ocarina.Backends.POK_C.Runtime is
45

46
   use Ocarina.Backends.C_Tree.Nodes;
47
   use Ocarina.Backends.C_Tree.Nutils;
48

49
   Initialized : Boolean := False;
50

51 1
   Current_Kernel_Unit : Node_Id;
52

53
   RED : array (RE_Id) of Node_Id := (RE_Id'Range => No_Node);
54
   RHD : array (RH_Id) of Node_Id := (RH_Id'Range => No_Node);
55

56
   --  Arrays of run-time entity and unit designators
57

58
   type Casing_Rule is record
59
      Size : Natural;
60
      From : String_Access;
61
      Into : String_Access;
62
   end record;
63

64 1
   Rules      : array (1 .. 64) of Casing_Rule;
65
   Rules_Last : Natural := 0;
66

67
   procedure Apply_Casing_Rules (S : in out String);
68
   --  Apply the registered casing rules on the string S
69

70
   procedure Register_Casing_Rule (S : String);
71
   --  Register a custom casing rule
72

73
   ------------------------
74
   -- Apply_Casing_Rules --
75
   ------------------------
76

77 1
   procedure Apply_Casing_Rules (S : in out String) is
78 1
      New_Word : Boolean         := True;
79
      Length   : Natural         := S'Length;
80
      S1       : constant String := To_Lower (S);
81
   begin
82 1
      GNAT.Case_Util.To_Mixed (S);
83

84 1
      for I in S'Range loop
85 1
         if New_Word then
86 1
            New_Word := False;
87 1
            for J in 1 .. Rules_Last loop
88
               if Rules (J).Size <= Length
89
                 and then S1 (I .. I + Rules (J).Size - 1) = Rules (J).From.all
90
               then
91
                  S (I .. I + Rules (J).Size - 1) := Rules (J).Into.all;
92
               end if;
93 1
            end loop;
94
         end if;
95 1
         if S (I) = '_' then
96 1
            New_Word := True;
97 1
            for J in 1 .. Rules_Last loop
98
               if Rules (J).Size <= Length
99
                 and then S1 (I .. I + Rules (J).Size - 1) = Rules (J).From.all
100
               then
101 0
                  S (I .. I + Rules (J).Size - 1) := Rules (J).Into.all;
102
               end if;
103 1
            end loop;
104
         end if;
105
         Length := Length - 1;
106 1
      end loop;
107 1
   end Apply_Casing_Rules;
108

109
   ----------------
110
   -- Initialize --
111
   ----------------
112

113 1
   procedure Initialize is
114 1
      Name     : Name_Id;
115 1
      N        : Node_Id;
116 1
      Is_Local : Boolean;
117
   begin
118
      --  Initialize the runtime only once
119

120 1
      if Initialized then
121 0
         return;
122
      end if;
123

124 1
      Initialized := True;
125

126
      --
127
      --  If we use DeOS, all the types and functions
128
      --  related to ARINC are associated to the file apex.h
129
      --
130

131 1
      if POK_Flavor = DEOS then
132

133 1
         for E in ART_Id loop
134 1
            RE_Header_Table (E) := RH_Apex;
135 1
         end loop;
136

137 1
         RE_Header_Table (RE_Fifo)                   := RH_Apex;
138 1
         RE_Header_Table (RE_Pok_Port_Kind_Sampling) := RH_Apex;
139 1
         RE_Header_Table (RE_Pok_Port_Kind_Queueing) := RH_Apex;
140 1
         RE_Header_Table (RE_Source)                 := RH_Apex;
141 1
         RE_Header_Table (RE_Destination)            := RH_Apex;
142 1
         RE_Header_Table (RE_Pok_Errno_Empty)        := RH_Apex;
143 1
         RE_Header_Table (RE_Null)                   := RH_Apex;
144 1
         RE_Header_Table (RE_Normal)                 := RH_Apex;
145 1
         RE_Header_Table (RE_Bool_T)                 := RH_Apex;
146 1
         RE_Header_Table (RE_Uint8_T)                := RH_Apex;
147 1
         RE_Header_Table (RE_Uint16_T)               := RH_Apex;
148 1
         RE_Header_Table (RE_Uint32_T)               := RH_Apex;
149 1
         RE_Header_Table (RE_Uint64_T)               := RH_Apex;
150 1
         RE_Header_Table (RE_Int8_T)                 := RH_Apex;
151 1
         RE_Header_Table (RE_Int16_T)                := RH_Apex;
152 1
         RE_Header_Table (RE_Int32_T)                := RH_Apex;
153 1
         RE_Header_Table (RE_Int64_T)                := RH_Apex;
154

155 1
         for E in ARF_Id loop
156 1
            RE_Header_Table (E) := RH_Apex;
157 1
         end loop;
158

159 1
         for E in ART_Id loop
160 1
            RE_Header_Table (E) := RH_Apex;
161 1
         end loop;
162
      end if;
163

164 1
      if POK_Flavor = VXWORKS then
165 1
         for E in ART_Id loop
166 1
            RE_Header_Table (E) := RH_ApexType;
167 1
         end loop;
168

169 1
         RE_Header_Table (RE_Periodic_Wait) := RH_ApexTime;
170

171 1
         RE_Header_Table (RE_Create_Process) := RH_ApexProcess;
172 1
         RE_Header_Table (RE_Start)          := RH_ApexProcess;
173

174 1
         RE_Header_Table (RE_Create_Process) := RH_ApexProcess;
175

176 1
         RE_Header_Table (RE_Set_Partition_Mode) := RH_ApexPartition;
177

178 1
         RE_Header_Table (RE_Create_Blackboard)  := RH_ApexBlackboard;
179 1
         RE_Header_Table (RE_Display_Blackboard) := RH_ApexBlackboard;
180 1
         RE_Header_Table (RE_Read_Blackboard)    := RH_ApexBlackboard;
181 1
         RE_Header_Table (RE_Clear_Blackboard)   := RH_ApexBlackboard;
182 1
         RE_Header_Table (RE_Blackboard_Id_Type) := RH_ApexBlackboard;
183

184 1
         RE_Header_Table (RE_Queuing_Port_Id_Type)    := RH_ApexQueuing;
185 1
         RE_Header_Table (RE_Create_Queuing_Port)     := RH_ApexQueuing;
186 1
         RE_Header_Table (RE_Send_Queuing_Message)    := RH_ApexQueuing;
187 1
         RE_Header_Table (RE_Receive_Queuing_Message) := RH_ApexQueuing;
188 1
         RE_Header_Table (RE_Get_Queuing_Port_Id)     := RH_ApexQueuing;
189

190 1
         RE_Header_Table (RE_Sampling_Port_Id_Type)  := RH_ApexSampling;
191 1
         RE_Header_Table (RE_Create_Sampling_Port)   := RH_ApexSampling;
192 1
         RE_Header_Table (RE_Write_Sampling_Message) := RH_ApexSampling;
193 1
         RE_Header_Table (RE_Read_Sampling_Message)  := RH_ApexSampling;
194 1
         RE_Header_Table (RE_Get_Sampling_Port_Id)   := RH_ApexSampling;
195

196 1
         RE_Header_Table (RE_Create_Buffer)  := RH_ApexBuffer;
197 1
         RE_Header_Table (RE_Send_Buffer)    := RH_ApexBuffer;
198 1
         RE_Header_Table (RE_Receive_Buffer) := RH_ApexBuffer;
199 1
         RE_Header_Table (RE_Buffer_Id_Type) := RH_ApexBuffer;
200

201 1
         RE_Header_Table (RE_Normal)                 := RH_ApexType;
202 1
         RE_Header_Table (RE_Process_Attribute_Type) := RH_ApexType;
203 1
         RE_Header_Table (RE_Fifo)                   := RH_ApexType;
204 1
         RE_Header_Table (RE_Pok_Port_Kind_Sampling) := RH_ApexType;
205 1
         RE_Header_Table (RE_Infinite_Time_Value)    := RH_ApexType;
206 1
         RE_Header_Table (RE_Pok_Port_Kind_Queueing) := RH_ApexType;
207 1
         RE_Header_Table (RE_Source)                 := RH_ApexType;
208 1
         RE_Header_Table (RE_Destination)            := RH_ApexType;
209 1
         RE_Header_Table (RE_Pok_Errno_Empty)        := RH_ApexType;
210 1
         RE_Header_Table (RE_Null)                   := RH_ApexType;
211 1
         RE_Header_Table (RE_Normal)                 := RH_ApexType;
212 1
         RE_Header_Table (RE_Bool_T)                 := RH_ApexType;
213 1
         RE_Header_Table (RE_Uint8_T)                := RH_ApexType;
214 1
         RE_Header_Table (RE_Uint16_T)               := RH_ApexType;
215 1
         RE_Header_Table (RE_Uint32_T)               := RH_ApexType;
216 1
         RE_Header_Table (RE_Uint64_T)               := RH_ApexType;
217 1
         RE_Header_Table (RE_Int8_T)                 := RH_ApexType;
218 1
         RE_Header_Table (RE_Int16_T)                := RH_ApexType;
219 1
         RE_Header_Table (RE_Int32_T)                := RH_ApexType;
220 1
         RE_Header_Table (RE_Int64_T)                := RH_ApexType;
221
      end if;
222

223 1
      if POK_Flavor = ARINC653 then
224 0
         RH_Service_Table (RH_Assert)     := RHS_Null;
225 0
         RH_Service_Table (RH_Thread)     := RHS_Core;
226 0
         RH_Service_Table (RH_Error)      := RHS_ARINC653;
227 0
         RH_Service_Table (RH_Blackboard) := RHS_ARINC653;
228 0
         RH_Service_Table (RH_Buffer)     := RHS_ARINC653;
229 0
         RH_Service_Table (RH_Queueing)   := RHS_ARINC653;
230 0
         RH_Service_Table (RH_Semaphore)  := RHS_ARINC653;
231 0
         RH_Service_Table (RH_Event)      := RHS_ARINC653;
232 0
         RH_Service_Table (RH_Sampling)   := RHS_ARINC653;
233 0
         RH_Service_Table (RH_Types)      := RHS_ARINC653;
234 0
         RH_Service_Table (RH_Time)       := RHS_ARINC653;
235 0
         RH_Service_Table (RH_Partition)  := RHS_ARINC653;
236
      end if;
237

238
      --  When we use the ARINC653 API, we change the include/
239
      --  directory for headers files. So, we change the following
240
      --  table that indicates the directory of each include file.
241

242 1
      Register_Casing_Rule ("AADL");
243 1
      Register_Casing_Rule ("char_array");
244 1
      Register_Casing_Rule ("nul");
245

246
      --  Apply casing rule for POK functions.
247
      --  All types are in lower case.
248

249 1
      for E in PRF_Id loop
250 1
         Set_Str_To_Name_Buffer (RE_Id'Image (E));
251
         Set_Str_To_Name_Buffer (Name_Buffer (4 .. Name_Len));
252

253
         Apply_Casing_Rules (Name_Buffer (1 .. Name_Len));
254

255
         while Name_Buffer (Name_Len) = '_' loop
256 0
            Name_Len := Name_Len - 1;
257 0
         end loop;
258

259 1
         Name := Name_Find;
260

261 1
         Name    := Utils.To_Lower (Name);
262 1
         RED (E) := New_Node (K_Defining_Identifier);
263 1
         Set_Name (RED (E), Name);
264 1
      end loop;
265

266
      --  Apply casing rule for ARINC653 functions.
267
      --  All functions are in upper case.
268

269 1
      for E in ARF_Id loop
270 1
         Set_Str_To_Name_Buffer (RE_Id'Image (E));
271
         Set_Str_To_Name_Buffer (Name_Buffer (4 .. Name_Len));
272

273
         Apply_Casing_Rules (Name_Buffer (1 .. Name_Len));
274

275
         while Name_Buffer (Name_Len) = '_' loop
276 0
            Name_Len := Name_Len - 1;
277 0
         end loop;
278

279 1
         Name := Name_Find;
280

281 1
         Name    := Utils.To_Upper (Name);
282 1
         RED (E) := New_Node (K_Defining_Identifier);
283 1
         Set_Name (RED (E), Name);
284 1
      end loop;
285

286
      --  Apply casing rule for POK types.
287
      --  All types are in lower case.
288

289 1
      for E in PRT_Id loop
290 1
         Set_Str_To_Name_Buffer (RE_Id'Image (E));
291
         Set_Str_To_Name_Buffer (Name_Buffer (4 .. Name_Len));
292

293
         Apply_Casing_Rules (Name_Buffer (1 .. Name_Len));
294

295
         while Name_Buffer (Name_Len) = '_' loop
296 0
            Name_Len := Name_Len - 1;
297 0
         end loop;
298

299 1
         Name := Name_Find;
300

301 1
         Name    := Utils.To_Lower (Name);
302 1
         RED (E) := New_Node (K_Defining_Identifier);
303 1
         Set_Name (RED (E), Name);
304 1
      end loop;
305

306
      --  Apply casing rule for ARINC653 types.
307
      --  All types are in upper case.
308

309 1
      for E in ART_Id loop
310 1
         Set_Str_To_Name_Buffer (RE_Id'Image (E));
311
         Set_Str_To_Name_Buffer (Name_Buffer (4 .. Name_Len));
312

313
         Apply_Casing_Rules (Name_Buffer (1 .. Name_Len));
314

315
         while Name_Buffer (Name_Len) = '_' loop
316 0
            Name_Len := Name_Len - 1;
317 0
         end loop;
318

319 1
         Name := Name_Find;
320

321 1
         Name    := Utils.To_Upper (Name);
322 1
         RED (E) := New_Node (K_Defining_Identifier);
323 1
         Set_Name (RED (E), Name);
324 1
      end loop;
325

326
      --  Apply casing rule for headers, there is no difference
327
      --  between POK and ARINC653 headers casing rules, so, we
328
      --  use the same.
329

330 1
      for E in RH_Id loop
331 1
         Set_Str_To_Name_Buffer (RH_Id'Image (E));
332
         Set_Str_To_Name_Buffer (Name_Buffer (4 .. Name_Len));
333
         Apply_Casing_Rules (Name_Buffer (1 .. Name_Len));
334

335
         while Name_Buffer (Name_Len) = '_' loop
336 0
            Name_Len := Name_Len - 1;
337 0
         end loop;
338

339 1
         if RH_Service_Table (E) = RHS_Generated then
340 1
            Is_Local := True;
341 1
         elsif RH_Service_Table (E) /= RHS_Null then
342 1
            Is_Local := False;
343 1
            Name     := Name_Find;
344
            Set_Str_To_Name_Buffer (RHS_Id'Image (RH_Service_Table (E)));
345
            Set_Str_To_Name_Buffer (Name_Buffer (5 .. Name_Len));
346 1
            Add_Str_To_Name_Buffer ("/");
347
            Apply_Casing_Rules (Name_Buffer (1 .. Name_Len));
348 1
            Get_Name_String_And_Append (Name);
349
         else
350 1
            Is_Local := False;
351
         end if;
352

353 1
         Name := Name_Find;
354

355 1
         Name := Utils.To_Lower (Name);
356

357 1
         N := New_Node (K_Defining_Identifier);
358 1
         Set_Name (N, Name);
359 1
         RHD (E) := Make_Include_Clause (N, Is_Local);
360 1
      end loop;
361

362
      --  Apply casing rule for constants, there is no difference
363
      --  between POK and ARINC653 constants casing rules, so, we
364
      --  use the same.
365

366 1
      for E in RC_Id loop
367 1
         Set_Str_To_Name_Buffer (RC_Id'Image (E));
368
         Set_Str_To_Name_Buffer (Name_Buffer (4 .. Name_Len));
369
         Apply_Casing_Rules (Name_Buffer (1 .. Name_Len));
370

371
         while Name_Buffer (Name_Len) in '0' .. '9'
372
           or else Name_Buffer (Name_Len) = '_'
373
         loop
374
            Name_Len := Name_Len - 1;
375 1
         end loop;
376

377 1
         Name := Name_Find;
378

379 1
         Name    := To_Upper (Name);
380 1
         RED (E) := New_Node (K_Defining_Identifier);
381 1
         Set_Name (RED (E), Name);
382 1
      end loop;
383

384
      --  Apply casing rule for variables, there is no difference
385
      --  between POK and ARINC653 variables casing rules, so, we
386
      --  use the same.
387

388 1
      for E in RV_Id loop
389 1
         Set_Str_To_Name_Buffer (RV_Id'Image (E));
390
         Set_Str_To_Name_Buffer (Name_Buffer (4 .. Name_Len));
391
         Apply_Casing_Rules (Name_Buffer (1 .. Name_Len));
392

393
         while Name_Buffer (Name_Len) in '0' .. '9'
394
           or else Name_Buffer (Name_Len) = '_'
395
         loop
396 0
            Name_Len := Name_Len - 1;
397 0
         end loop;
398

399 1
         Name := Name_Find;
400

401 1
         Name    := To_Lower (Name);
402 1
         RED (E) := New_Node (K_Defining_Identifier);
403 1
         Set_Name (RED (E), Name);
404 1
      end loop;
405

406
      --  Apply casing rule for members. The difference
407
      --  between POK and ARINC653 is made inside the loop.
408

409 1
      for E in MR_Id loop
410 1
         Set_Str_To_Name_Buffer (RC_Id'Image (E));
411
         Set_Str_To_Name_Buffer (Name_Buffer (4 .. Name_Len));
412
         Apply_Casing_Rules (Name_Buffer (1 .. Name_Len));
413

414
         while Name_Buffer (Name_Len) in '0' .. '9'
415
           or else Name_Buffer (Name_Len) = '_'
416
         loop
417 0
            Name_Len := Name_Len - 1;
418 0
         end loop;
419

420 1
         Name := Name_Find;
421

422
         --  If we use the ARINC653 backend flavor, the
423
         --  members are in upper case. Otherwise, we use
424
         --  lower case.
425

426 1
         if POK_Flavor = ARINC653
427 1
           or else POK_Flavor = DEOS
428 1
           or else POK_Flavor = VXWORKS
429
         then
430 1
            Name := To_Upper (Name);
431
         else
432 1
            Name := To_Lower (Name);
433
         end if;
434 1
         RED (E) := New_Node (K_Defining_Identifier);
435 1
         Set_Name (RED (E), Name);
436 1
      end loop;
437

438
   end Initialize;
439

440
   -----------
441
   -- Reset --
442
   -----------
443

444 1
   procedure Reset is
445
   begin
446 1
      RED        := (RE_Id'Range => No_Node);
447 1
      RHD        := (RH_Id'Range => No_Node);
448 1
      Rules_Last := 0;
449

450 1
      Initialized := False;
451 1
   end Reset;
452

453
   --------
454
   -- RE --
455
   --------
456

457 1
   function RE (Id : RE_Id) return Node_Id is
458
   begin
459 1
      if RE_Header_Table (Id) /= RH_Null then
460 1
         Add_Include (RH (RE_Header_Table (Id)));
461
      end if;
462

463 1
      return Copy_Node (RED (Id));
464
   end RE;
465

466
   --------
467
   -- RF --
468
   --------
469

470 1
   function RF (Id : RF_Id) return Node_Id is
471 1
      N : Node_Id;
472 1
      R : RE_Id;
473
   begin
474 1
      N := RE (Id);
475 1
      R := RF_Define_Table (Id);
476 1
      if R /= RE_Null then
477 1
         Add_Define_Deployment (RE (R));
478
      end if;
479

480
      --  Add functionnality in the kernel
481
      --  according to model needs.
482
      --  WiP functionnality at this time, needs to describe
483
      --  each function needs.
484 1
      if Id = RE_Pok_Blackboard_Read then
485 0
         Push_Entity (Entity (Current_Kernel_Unit));
486 0
         Push_Entity (Current_Kernel_Unit);
487

488 0
         Add_Define_Deployment (RE (RE_Pok_Needs_Gettick));
489

490 0
         Pop_Entity;
491 0
         Pop_Entity;
492
      end if;
493

494 1
      return N;
495
   end RF;
496

497
   --------
498
   -- RH --
499
   --------
500

501 1
   function RH (Id : RH_Id) return Node_Id is
502
   begin
503 1
      return Copy_Node (RHD (Id));
504
   end RH;
505

506
   --------------------------
507
   -- Register_Casing_Rule --
508
   --------------------------
509

510
   procedure Register_Casing_Rule (S : String) is
511
   begin
512
      Rules_Last              := Rules_Last + 1;
513
      Rules (Rules_Last).Size := S'Length;
514
      Rules (Rules_Last).Into := new String'(S);
515
      Rules (Rules_Last).From := new String'(S);
516
      To_Lower (Rules (Rules_Last).From.all);
517 1
   end Register_Casing_Rule;
518

519
   --------------------------
520
   -- Update_Headers_Names --
521
   --------------------------
522

523 1
   procedure Update_Headers_Names is
524 1
      Name : Name_Id;
525
   begin
526 1
      for E in RH_Id loop
527 1
         Set_Str_To_Name_Buffer (RH_Id'Image (E));
528
         Set_Str_To_Name_Buffer (Name_Buffer (4 .. Name_Len));
529
         Apply_Casing_Rules (Name_Buffer (1 .. Name_Len));
530

531
         while Name_Buffer (Name_Len) = '_' loop
532 0
            Name_Len := Name_Len - 1;
533 0
         end loop;
534

535 1
         if RH_Service_Table (E) /= RHS_Generated
536 1
           and then RH_Service_Table (E) /= RHS_Null
537
         then
538 1
            Name := Name_Find;
539
            Set_Str_To_Name_Buffer (RHS_Id'Image (RH_Service_Table (E)));
540
            Set_Str_To_Name_Buffer (Name_Buffer (5 .. Name_Len));
541 1
            Add_Str_To_Name_Buffer ("/");
542
            Apply_Casing_Rules (Name_Buffer (1 .. Name_Len));
543 1
            Get_Name_String_And_Append (Name);
544
         end if;
545

546 1
         Name := Name_Find;
547

548 1
         Name := Utils.To_Lower (Name);
549

550 1
         Set_Name (Header_Name (RHD (E)), Name);
551 1
      end loop;
552 1
   end Update_Headers_Names;
553

554
   -----------------
555
   -- Normal_Mode --
556
   -----------------
557

558 1
   procedure Normal_Mode is
559
   begin
560 1
      if POK_Flavor = ARINC653 then
561 0
         ARINC653_Mode;
562
      else
563 1
         POK_Mode;
564
      end if;
565 1
   end Normal_Mode;
566

567
   --------------
568
   -- POK_Mode --
569
   --------------
570

571 1
   procedure POK_Mode is
572
   begin
573 1
      RH_Service_Table (RH_Assert)     := RHS_Null;
574 1
      RH_Service_Table (RH_Thread)     := RHS_Core;
575 1
      RH_Service_Table (RH_Blackboard) := RHS_Middleware;
576 1
      RH_Service_Table (RH_Buffer)     := RHS_Middleware;
577 1
      RH_Service_Table (RH_Queueing)   := RHS_Middleware;
578 1
      RH_Service_Table (RH_Semaphore)  := RHS_Core;
579 1
      RH_Service_Table (RH_Event)      := RHS_Core;
580 1
      RH_Service_Table (RH_Sampling)   := RHS_Middleware;
581 1
      RH_Service_Table (RH_Types)      := RHS_Null;
582 1
      RH_Service_Table (RH_Time)       := RHS_Core;
583 1
      RH_Service_Table (RH_Partition)  := RHS_Core;
584

585 1
      Update_Headers_Names;
586 1
   end POK_Mode;
587

588
   -------------------
589
   -- ARINC653_Mode --
590
   -------------------
591

592 0
   procedure ARINC653_Mode is
593
   begin
594 0
      RH_Service_Table (RH_Assert)     := RHS_Null;
595 0
      RH_Service_Table (RH_Thread)     := RHS_Core;
596 0
      RH_Service_Table (RH_Blackboard) := RHS_ARINC653;
597 0
      RH_Service_Table (RH_Buffer)     := RHS_ARINC653;
598 0
      RH_Service_Table (RH_Queueing)   := RHS_ARINC653;
599 0
      RH_Service_Table (RH_Semaphore)  := RHS_ARINC653;
600 0
      RH_Service_Table (RH_Event)      := RHS_ARINC653;
601 0
      RH_Service_Table (RH_Sampling)   := RHS_ARINC653;
602 0
      RH_Service_Table (RH_Types)      := RHS_ARINC653;
603 0
      RH_Service_Table (RH_Time)       := RHS_ARINC653;
604 0
      RH_Service_Table (RH_Partition)  := RHS_ARINC653;
605

606 0
      Update_Headers_Names;
607 0
   end ARINC653_Mode;
608

609
   -----------------
610
   -- Kernel_Mode --
611
   -----------------
612

613 1
   procedure Kernel_Mode is
614
   begin
615
      --  Same as User_Mode but for the kernel
616 1
      RH_Service_Table (RH_Types)     := RHS_Null;
617 1
      RH_Service_Table (RH_Partition) := RHS_Core;
618 1
      RH_Service_Table (RH_Error)     := RHS_Core;
619

620 1
      Update_Headers_Names;
621 1
   end Kernel_Mode;
622

623
   ---------------
624
   -- User_Mode --
625
   ---------------
626

627 1
   procedure User_Mode is
628
   begin
629
      --  Switch to user mode, change header name
630
      --  locations, change their containing directories.
631 1
      if POK_Flavor = ARINC653 then
632 0
         RH_Service_Table (RH_Assert)     := RHS_Null;
633 0
         RH_Service_Table (RH_Thread)     := RHS_Core;
634 0
         RH_Service_Table (RH_Blackboard) := RHS_ARINC653;
635 0
         RH_Service_Table (RH_Error)      := RHS_ARINC653;
636 0
         RH_Service_Table (RH_Buffer)     := RHS_ARINC653;
637 0
         RH_Service_Table (RH_Queueing)   := RHS_ARINC653;
638 0
         RH_Service_Table (RH_Sampling)   := RHS_ARINC653;
639 0
         RH_Service_Table (RH_Types)      := RHS_ARINC653;
640 0
         RH_Service_Table (RH_Time)       := RHS_ARINC653;
641 0
         RH_Service_Table (RH_Partition)  := RHS_ARINC653;
642
      else
643 1
         RH_Service_Table (RH_Assert)     := RHS_Null;
644 1
         RH_Service_Table (RH_Thread)     := RHS_Core;
645 1
         RH_Service_Table (RH_Blackboard) := RHS_Middleware;
646 1
         RH_Service_Table (RH_Buffer)     := RHS_Middleware;
647 1
         RH_Service_Table (RH_Queueing)   := RHS_Middleware;
648 1
         RH_Service_Table (RH_Sampling)   := RHS_Middleware;
649 1
         RH_Service_Table (RH_Types)      := RHS_Null;
650 1
         RH_Service_Table (RH_Time)       := RHS_Core;
651 1
         RH_Service_Table (RH_Partition)  := RHS_Core;
652
      end if;
653

654 1
      Update_Headers_Names;
655 1
   end User_Mode;
656

657 1
   procedure Register_Kernel_Unit (Unit : Node_Id) is
658
   begin
659 1
      Current_Kernel_Unit := Unit;
660 1
   end Register_Kernel_Unit;
661

662 0
   function Get_Errcode_OK return Node_Id is
663
   begin
664 0
      if POK_Flavor = ARINC653 or else POK_Flavor = DEOS then
665 0
         return RE (RE_No_Error);
666
      else
667 0
         return RE (RE_Pok_Errno_Ok);
668
      end if;
669
   end Get_Errcode_OK;
670

671 1
end Ocarina.Backends.POK_C.Runtime;

Read our documentation on viewing source code .

Loading