tree checksum vpatch file split hunks
all signers: ave1
antecedents: zfp_genesis zfp_3_platform zfp_2_noc
press order:
| zfp_genesis | ave1 |
| zfp_1_examples | ave1 |
patch:
(1 . 13)(1 . 20)
5 PROJECT_FILE=gnat_runtime.gpr
6 PLATFORM?=x86_64-asm
7 PREFIX?=ZFP
8
9 all: adalib/libgnat.a adalib/start.o
10 all: adalib/libgnat.a obj/start.o
11
12 adalib/start.o:adainclude/start.S
13 obj/start.o:adainclude/start.S
14 as -c $< -o $@
15
16 adalib/libgnat.a:adainclude/*.ads
17 gnatmake -P $(PROJECT_FILE)
18 gprbuild -Xplatform=$(PLATFORM) -P $(PROJECT_FILE)
19
20 install:adalib/libgnat.a
21 cp runtime-$(PLATFORM).xml runtime.xml
22 gprinstall -Xplatform=$(PLATFORM) -P $(PROJECT_FILE) -f -p --prefix=$(PREFIX)
23
24 clean:
25 gprclean -P $(PROJECT_FILE)
26 -rm -Rf adalib/start.o
27 gprclean -Xplatform=$(PLATFORM) -P $(PROJECT_FILE)
28 -rm -Rf obj/start.o
29 -rm -f runtime.xml
- E493B72DC9F010949AEAFC3C54C7A420FA7C26289A0E276AE819CF04111040A11603232F51E79CFD5FD389F7D0BE17DC528718C2014D8152B69F234D1EC7C9A4(1 . 59)(0 . 0)
34 ------------------------------------------------------------------------------
35 ------------------------------------------------------------------------------
36 -- You do not have, nor can you ever acquire the right to use, copy or --
37 -- distribute this software ; Should you use this software for any purpose, --
38 -- or copy and distribute it to anyone or in any manner, you are breaking --
39 -- the laws of whatever soi-disant jurisdiction, and you promise to --
40 -- continue doing so for the indefinite future. In any case, please --
41 -- always : read and understand any software ; verify any PGP signatures --
42 -- that you use - for any purpose. --
43 -- --
44 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
45 ------------------------------------------------------------------------------
46 ------------------------------------------------------------------------------
47
48 -- Version for use with C run time
49 with System.Syscall; use System.Syscall;
50
51 package body Ada.Text_IO is
52 -- STDIN : constant := 0;
53 STDOUT : constant := 1;
54 -- STDERR : constant := 2;
55
56 --------------
57 -- New_Line --
58 --------------
59
60 procedure New_Line is
61 begin
62 Put (ASCII.LF);
63 end New_Line;
64
65 ---------
66 -- Put --
67 ---------
68
69 procedure Put (Item : Character) is
70 begin
71 Put ("" & Item);
72 end Put;
73
74 procedure Put (Item : String) is
75 Ignore : Int;
76 E : ErrorCode;
77 begin
78 Ignore := Write (STDOUT, Item, E);
79 pragma Unused (E);
80 end Put;
81
82 --------------
83 -- Put_Line --
84 --------------
85
86 procedure Put_Line (Item : String) is
87 begin
88 Put (Item);
89 New_Line;
90 end Put_Line;
91
92 end Ada.Text_IO;
-(0 . 0)(1 . 154)
97 ------------------------------------------------------------------------------
98 -- --
99 -- GNAT COMPILER COMPONENTS --
100 -- --
101 -- I N T E R F A C E S . C --
102 -- --
103 -- B o d y --
104 -- --
105 -- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
106 -- --
107 -- GNAT is free software; you can redistribute it and/or modify it under --
108 -- terms of the GNU General Public License as published by the Free Soft- --
109 -- ware Foundation; either version 3, or (at your option) any later ver- --
110 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
111 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
112 -- or FITNESS FOR A PARTICULAR PURPOSE. --
113 -- --
114 -- --
115 -- --
116 -- --
117 -- --
118 -- You should have received a copy of the GNU General Public License and --
119 -- a copy of the GCC Runtime Library Exception along with this program; --
120 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
121 -- <http://www.gnu.org/licenses/>. --
122 -- --
123 -- GNAT was originally developed by the GNAT team at New York University. --
124 -- Extensive contributions were provided by Ada Core Technologies Inc. --
125 -- --
126 ------------------------------------------------------------------------------
127
128 package body Interfaces.C is
129
130 -----------------------
131 -- Is_Nul_Terminated --
132 -----------------------
133
134 -- Case of char_array
135
136 function Is_Nul_Terminated (Item : char_array) return Boolean is
137 begin
138 for J in Item'Range loop
139 if Item (J) = nul then
140 return True;
141 end if;
142 end loop;
143
144 return False;
145 end Is_Nul_Terminated;
146
147 ------------
148 -- To_Ada --
149 ------------
150
151 -- Convert char to Character
152
153 function To_Ada (Item : char) return Character is
154 begin
155 return Character'Val (char'Pos (Item));
156 end To_Ada;
157
158 -- Convert char_array to String (procedure form)
159
160 procedure To_Ada
161 (Item : char_array;
162 Target : out String;
163 Count : out Natural;
164 Trim_Nul : Boolean := True)
165 is
166 From : size_t;
167 To : Positive;
168
169 begin
170 if Trim_Nul then
171 From := Item'First;
172 loop
173 if From > Item'Last then
174 raise Program_Error;
175 elsif Item (From) = nul then
176 exit;
177 else
178 From := From + 1;
179 end if;
180 end loop;
181
182 Count := Natural (From - Item'First);
183
184 else
185 Count := Item'Length;
186 end if;
187
188 if Count > Target'Length then
189 raise Constraint_Error;
190
191 else
192 From := Item'First;
193 To := Target'First;
194
195 for J in 1 .. Count loop
196 Target (To) := Character (Item (From));
197 From := From + 1;
198 To := To + 1;
199 end loop;
200 end if;
201
202 end To_Ada;
203
204 ----------
205 -- To_C --
206 ----------
207
208 -- Convert Character to char
209
210 function To_C (Item : Character) return char is
211 begin
212 return char'Val (Character'Pos (Item));
213 end To_C;
214
215 -- Convert String to char_array (procedure form)
216
217 procedure To_C
218 (Item : String;
219 Target : out char_array;
220 Count : out size_t;
221 Append_Nul : Boolean := True)
222 is
223 To : size_t;
224
225 begin
226 if Target'Length < Item'Length then
227 raise Constraint_Error;
228
229 else
230 To := Target'First;
231 for From in Item'Range loop
232 Target (To) := char (Item (From));
233 To := To + 1;
234 end loop;
235
236 if Append_Nul then
237 if To > Target'Last then
238 raise Constraint_Error;
239 else
240 Target (To) := nul;
241 Count := Item'Length + 1;
242 end if;
243
244 else
245 Count := Item'Length;
246 end if;
247 end if;
248 end To_C;
249
250 end Interfaces.C;
-(0 . 0)(1 . 99)
255 ------------------------------------------------------------------------------
256 -- --
257 -- GNAT COMPILER COMPONENTS --
258 -- --
259 -- I N T E R F A C E S . C --
260 -- --
261 -- S p e c --
262 -- --
263 -- This specification is derived from the Ada Reference Manual for use with --
264 -- GNAT. In accordance with the copyright of that document, you can freely --
265 -- copy and modify this specification, provided that if you redistribute a --
266 -- modified version, any changes that you have made are clearly indicated. --
267 -- --
268 ------------------------------------------------------------------------------
269
270 with System.Parameters;
271
272 package Interfaces.C is
273 pragma Pure;
274
275 -- Declaration's based on C's <limits.h>
276
277 CHAR_BIT : constant := 8;
278 SCHAR_MIN : constant := -128;
279 SCHAR_MAX : constant := 127;
280 UCHAR_MAX : constant := 255;
281
282 -- Signed and Unsigned Integers. Note that in GNAT, we have ensured that
283 -- the standard predefined Ada types correspond to the standard C types
284
285 -- Note: the Integer qualifications used in the declaration of type long
286 -- avoid ambiguities when compiling in the presence of s-auxdec.ads and
287 -- a non-private system.address type.
288
289 type int is new Integer;
290 type short is new Short_Integer;
291 type long is
292 range
293 -(2**(System.Parameters.long_bits - Integer'(1))) ..
294 +(2**(System.Parameters.long_bits - Integer'(1))) - 1;
295
296 type signed_char is range SCHAR_MIN .. SCHAR_MAX;
297 for signed_char'Size use CHAR_BIT;
298
299 type unsigned is mod 2**int'Size;
300 type unsigned_short is mod 2**short'Size;
301 type unsigned_long is mod 2**long'Size;
302
303 type unsigned_char is mod (UCHAR_MAX + 1);
304 for unsigned_char'Size use CHAR_BIT;
305
306 subtype plain_char is unsigned_char; -- ??? should be parameterized
307
308 -- Note: the Integer qualifications used in the declaration of ptrdiff_t
309 -- avoid ambiguities when compiling in the presence of s-auxdec.ads and
310 -- a non-private system.address type.
311
312 type ptrdiff_t is
313 range
314 -(2**(System.Parameters.ptr_bits - Integer'(1))) ..
315 +(2**(System.Parameters.ptr_bits - Integer'(1)) - 1);
316
317 type size_t is mod 2**System.Parameters.ptr_bits;
318
319 -- Floating-Point
320
321 type C_float is new Float;
322 type double is new Standard.Long_Float;
323 type long_double is new Standard.Long_Long_Float;
324
325 ----------------------------
326 -- Characters and Strings --
327 ----------------------------
328
329 type char is new Character;
330
331 nul : constant char := char'First;
332
333 function To_C (Item : Character) return char;
334 function To_Ada (Item : char) return Character;
335
336 type char_array is array (size_t range <>) of aliased char;
337 for char_array'Component_Size use CHAR_BIT;
338
339 function Is_Nul_Terminated (Item : char_array) return Boolean;
340
341 procedure To_C
342 (Item : String;
343 Target : out char_array;
344 Count : out size_t;
345 Append_Nul : Boolean := True);
346
347 procedure To_Ada
348 (Item : char_array;
349 Target : out String;
350 Count : out Natural;
351 Trim_Nul : Boolean := True);
352
353 end Interfaces.C;
- EC06F5D03656946C1D7F682FA5192EF8BD3C8D460E5BD8B9F0DC1DE36B6AA549F1B8FE1E0525D3A660C8A8AB1928AA05868359EC4B838D2D951C5FF672B2D93E(1 . 38)(0 . 0)
358 ------------------------------------------------------------------------------
359 ------------------------------------------------------------------------------
360 -- You do not have, nor can you ever acquire the right to use, copy or --
361 -- distribute this software ; Should you use this software for any purpose, --
362 -- or copy and distribute it to anyone or in any manner, you are breaking --
363 -- the laws of whatever soi-disant jurisdiction, and you promise to --
364 -- continue doing so for the indefinite future. In any case, please --
365 -- always : read and understand any software ; verify any PGP signatures --
366 -- that you use - for any purpose. --
367 -- --
368 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
369 ------------------------------------------------------------------------------
370 ------------------------------------------------------------------------------
371
372 with Ada.Text_IO; use Ada.Text_IO;
373 with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
374 with System.Storage_Elements; use System.Storage_Elements;
375 with System.Syscall; use System.Syscall;
376
377 procedure Last_Chance_Handler (Msg : System.Address; Line : Integer) is
378 function Peek (Addr : System.Address) return Character is
379 C : Character with
380 Address => Addr;
381 begin
382 return C;
383 end Peek;
384 A : System.Address := Msg;
385 begin
386 Put ("GNAT Exception!:");
387 Put (Line);
388 Put (":");
389 while Peek (A) /= ASCII.NUL loop
390 Put (Peek (A));
391 A := A + 1;
392 end loop;
393 New_Line;
394 Sys_Exit (1);
395 end Last_Chance_Handler;
- 602E857B2C3724B907CA3D6F4B1587D375C7E35F90AC7A23253EDAFF29187862D6FC2B2C104DA14706B16DB2F984EB335B4389C40E87407068D853CDBC0E6210(1 . 74)(0 . 0)
400 with System.Machine_Code; use System.Machine_Code;
401
402 package body System.Syscall is
403 SYSCALL_WRITE : constant := 1;
404 SYSCALL_READ : constant := 0;
405 -- SYSCALL_EXIT : constant := 60;
406
407 function Write (fd : in Int; S : in String; E : out ErrorCode) return Int is
408 type byte is mod 2**8;
409 B : array (S'Range) of byte;
410 R : Int := 0;
411 begin
412 for I in S'Range loop
413 B (I) := Character'Pos (S (I));
414 end loop;
415 Asm
416 ("syscall",
417 Outputs => (Int'Asm_Output ("=a", R)),
418 Inputs =>
419 (Int'Asm_Input ("a", SYSCALL_WRITE),
420 Int'Asm_Input ("D", fd),
421 System.Address'Asm_Input ("S", B'Address),
422 Int'Asm_Input ("d", B'Length)),
423 Volatile => True);
424 if R < 0 and R >= -(2**12) then
425 E := ErrorCode'Val (-R);
426 R := -1;
427 else
428 E := OK;
429 end if;
430 return R;
431 end Write;
432
433 function Read (fd : in Int; s : out String; E : out ErrorCode) return Int is
434 type byte is mod 2**8;
435 B : array (S'Range) of byte;
436 R : Int := 0;
437 begin
438 Asm
439 ("syscall",
440 Outputs => (Int'Asm_Output ("=a", R)),
441 Inputs =>
442 (Int'Asm_Input ("a", SYSCALL_READ),
443 Int'Asm_Input ("D", fd),
444 System.Address'Asm_Input ("S", B'Address),
445 Int'Asm_Input ("d", B'Length)));
446 for I in S'Range loop
447 S (I) := Character'Val (B (I));
448 end loop;
449 if R < 0 and R >= -(2**12) then
450 E := ErrorCode'Val (-R);
451 R := -1;
452 else
453 E := OK;
454 end if;
455 return R;
456 end Read;
457
458 procedure Sys_Exit (C : in Integer) is
459 begin
460 Asm
461 ("mov $60, %%rax" &
462 ASCII.LF &
463 ASCII.HT & -- EXIT
464 "mov %0, %%rdi" &
465 ASCII.LF &
466 ASCII.HT & -- CODE
467 "syscall",
468 Inputs => (Int'Asm_Input ("g", Int (C))),
469 Clobber => "rax, rdi",
470 Volatile => True);
471 raise Program_Error;
472 end Sys_Exit;
473 end System.Syscall;
- E87D5D4ECC1A2A9BED07371E36F4CA73C34E5781CFA4E3C5D159027F7C9468ACDDFADF8E59E8357A24CF22B1E8FF1148C660C6A09AAC40E43614C62137B822B8(1 . 17)(0 . 0)
478 package System.Syscall is
479 -- All interaction with system calls use 4 64bit registers
480 -- These registers are interpreted as integers or pointers
481 type Int is range -2**63 .. (2**63 - 1);
482 -- The return code will be an integer
483 -- On error, an errocode is returned, values are between 0 and 4096
484 type ErrorCode is range 0 .. 2**12;
485
486 OK : constant ErrorCode := 0;
487
488 function Write (fd : in Int; S : in String; E : out ErrorCode) return Int;
489 function Read (fd : in Int; S : out String; E : out ErrorCode) return Int;
490
491 procedure Sys_Exit (C : in Integer) with
492 No_Return;
493
494 end System.Syscall;
- 829AA035034216A965A6FDB18CC9039D873575B8F4CB592178928A830EE2F35AE58210349277ECEA5ECF70D1BA615F61F3443322FB7E650C5EA39954288358AC(1 . 135)(0 . 0)
499 ------------------------------------------------------------------------------
500 ------------------------------------------------------------------------------
501 -- You do not have, nor can you ever acquire the right to use, copy or --
502 -- distribute this software ; Should you use this software for any purpose, --
503 -- or copy and distribute it to anyone or in any manner, you are breaking --
504 -- the laws of whatever soi-disant jurisdiction, and you promise to --
505 -- continue doing so for the indefinite future. In any case, please --
506 -- always : read and understand any software ; verify any PGP signatures --
507 -- that you use - for any purpose. --
508 -- --
509 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
510 ------------------------------------------------------------------------------
511 ------------------------------------------------------------------------------
512
513 package System is
514 pragma Pure;
515 -- Note that we take advantage of the implementation permission to make
516 -- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
517 -- 2005, this is Pure in any case (AI-362).
518
519 pragma No_Elaboration_Code_All;
520 -- Allow the use of that restriction in units that WITH this unit
521
522 type Name is (SYSTEM_NAME_GNAT);
523 System_Name : constant Name := SYSTEM_NAME_GNAT;
524
525 -- System-Dependent Named Numbers
526
527 Min_Int : constant := Long_Long_Integer'First;
528 Max_Int : constant := Long_Long_Integer'Last;
529
530 Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size;
531 Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1;
532
533 Max_Base_Digits : constant := Long_Long_Float'Digits;
534 Max_Digits : constant := Long_Long_Float'Digits;
535
536 Max_Mantissa : constant := 63;
537 Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
538
539 Tick : constant := 0.000_001;
540
541 -- Storage-related Declarations
542
543 type Address is private;
544 pragma Preelaborable_Initialization (Address);
545 Null_Address : constant Address;
546
547 Storage_Unit : constant := 8;
548 Word_Size : constant := Standard'Word_Size;
549 Memory_Size : constant := 2 ** Word_Size;
550
551 -- Address comparison
552
553 function "<" (Left, Right : Address) return Boolean;
554 function "<=" (Left, Right : Address) return Boolean;
555 function ">" (Left, Right : Address) return Boolean;
556 function ">=" (Left, Right : Address) return Boolean;
557 function "=" (Left, Right : Address) return Boolean;
558
559 pragma Import (Intrinsic, "<");
560 pragma Import (Intrinsic, "<=");
561 pragma Import (Intrinsic, ">");
562 pragma Import (Intrinsic, ">=");
563 pragma Import (Intrinsic, "=");
564
565 -- Other System-Dependent Declarations
566
567 type Bit_Order is (High_Order_First, Low_Order_First);
568 Default_Bit_Order : constant Bit_Order := Low_Order_First;
569 pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning
570
571 -- Priority-related Declarations (RM D.1)
572
573 -- 0 .. 98 corresponds to the system priority range 1 .. 99.
574 --
575 -- If the scheduling policy is SCHED_FIFO or SCHED_RR the runtime makes use
576 -- of the entire range provided by the system.
577 --
578 -- If the scheduling policy is SCHED_OTHER the only valid system priority
579 -- is 1 and other values are simply ignored.
580
581 Max_Priority : constant Positive := 97;
582 Max_Interrupt_Priority : constant Positive := 98;
583
584 subtype Any_Priority is Integer range 0 .. 98;
585 subtype Priority is Any_Priority range 0 .. 97;
586 subtype Interrupt_Priority is Any_Priority range 98 .. 98;
587
588 Default_Priority : constant Priority := 48;
589
590 private
591
592 type Address is mod Memory_Size;
593 Null_Address : constant Address := 0;
594
595 --------------------------------------
596 -- System Implementation Parameters --
597 --------------------------------------
598
599 -- These parameters provide information about the target that is used
600 -- by the compiler. They are in the private part of System, where they
601 -- can be accessed using the special circuitry in the Targparm unit
602 -- whose source should be consulted for more detailed descriptions
603 -- of the individual switch values.
604
605 Backend_Divide_Checks : constant Boolean := False;
606 Backend_Overflow_Checks : constant Boolean := True;
607 Command_Line_Args : constant Boolean := False;
608 Configurable_Run_Time : constant Boolean := True;
609 Denorm : constant Boolean := True;
610 Duration_32_Bits : constant Boolean := False;
611 Exit_Status_Supported : constant Boolean := True;
612 Fractional_Fixed_Ops : constant Boolean := False;
613 Frontend_Layout : constant Boolean := False;
614 Machine_Overflows : constant Boolean := False;
615 Machine_Rounds : constant Boolean := True;
616 Preallocated_Stacks : constant Boolean := False;
617 Signed_Zeros : constant Boolean := True;
618 Stack_Check_Default : constant Boolean := False;
619 Stack_Check_Probes : constant Boolean := True;
620 Stack_Check_Limits : constant Boolean := False;
621 Support_Aggregates : constant Boolean := True;
622 Support_Atomic_Primitives : constant Boolean := True;
623 Support_Composite_Assign : constant Boolean := True;
624 Support_Composite_Compare : constant Boolean := True;
625 Support_Long_Shifts : constant Boolean := True;
626 Always_Compatible_Rep : constant Boolean := False;
627 Suppress_Standard_Library : constant Boolean := True;
628 Use_Ada_Main_Program_Name : constant Boolean := False;
629 Frontend_Exceptions : constant Boolean := False;
630 ZCX_By_Default : constant Boolean := True;
631 Run_Time_Name : constant String := "FFA Run Time";
632
633 end System;
- D89FAB93E12D5F7211CF3C3133E4E4EC50F657D57F7D49C2FB9EF9CC9A4B4C7998EC9AE237D8C7E277DC91D59680D1C54339EB615C4BEA5FFF26E14144DC9F1C(1 . 10)(1 . 10)
638 PROJECT_FILE=gnat_runtime.gpr
639 PROJECT_FILE=examples.gpr
640 RTS?=../ZFP
641
642 all: bin/hello
643
644 bin/hello:helloworld/hello.adb ../adalib/libgnat.a ../adalib/start.o
645 gprbuild --RTS=..
646 bin/hello:helloworld/hello.adb
647 gprbuild -P $(PROJECT_FILE) --RTS=$(RTS)
648
649 clean:
650 gprclean -P $(PROJECT_FILE)
651 -rm -Rf adalib/start.o
- 333021E0854DD34F16F0F42540DD1AB89940FDE79D8283EF965E9BED288DE0174D5B69C91E465AFE6FA2147F7D597B0A9424FE95C04E3AD0C866ACDC058B6443(15 . 7)(15 . 16)- 69C0CF97B057D92731F3A70D4CF346752478727FECAB43D10314DDDE83421301AEB82E2A4C51F74F2EEDD42F064C44BB208853DAD5D408F25816CDEA41F5EADE
656 library project Gnat_Runtime is
657 for Languages use ("Ada");
658
659 for Source_Dirs use ("adainclude");
660 type Platform_Type is ("x86_64-asm", "x86_64-c");
661 Platform : Platform_Type := external ("platform", "x86_64-asm");
662
663 case Platform is
664 when "x86_64-asm" =>
665 for Source_Dirs use ("adainclude", "platform/linux-x86_64", "platform/linux-x86_64-asm");
666 when "x86_64-c" =>
667 for Source_Dirs use ("adainclude", "platform/linux-x86_64", "platform/linux-c");
668 end case;
669
670 for Object_Dir use "obj";
671 for Library_Kind use "static";
672 for Library_Name use "gnat";
(41 . 6)(50 . 12)
674 for Lib_Subdir use "adalib";
675 for Required_Artifacts (".") use ("runtime.xml");
676 for Install_Project use "false";
677 case Platform is
678 when "x86_64-asm" =>
679 for Artifacts ("adalib") use ("obj/start.o");
680 when others =>
681 null;
682 end case;
683 end Install;
684
685 end Gnat_Runtime;
(1 . 3)(1 . 4)
690 535595 zfp_genesis ave1 a minimal gnat runtime library
691 535611 zfp_1_examples ave1 two examples for the minimal runtime
692 535612 zfp_2_noc ave1 zfp no dependency on the C library
693 536580 zfp_3_platform ave1 added platform types to the compilation so that C, asm and also different processors can be supported
-(0 . 0)(1 . 59)
698 ------------------------------------------------------------------------------
699 ------------------------------------------------------------------------------
700 -- You do not have, nor can you ever acquire the right to use, copy or --
701 -- distribute this software ; Should you use this software for any purpose, --
702 -- or copy and distribute it to anyone or in any manner, you are breaking --
703 -- the laws of whatever soi-disant jurisdiction, and you promise to --
704 -- continue doing so for the indefinite future. In any case, please --
705 -- always : read and understand any software ; verify any PGP signatures --
706 -- that you use - for any purpose. --
707 -- --
708 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
709 ------------------------------------------------------------------------------
710 ------------------------------------------------------------------------------
711
712 -- Version for use with C run time
713
714 package body Ada.Text_IO is
715
716 --------------
717 -- New_Line --
718 --------------
719
720 procedure New_Line is
721 begin
722 Put (ASCII.LF);
723 end New_Line;
724
725 ---------
726 -- Put --
727 ---------
728
729 procedure Put (Item : Character) is
730 function Putchar (C : Integer) return Integer;
731 pragma Import (C, Putchar);
732
733 Ignore : Integer;
734
735 begin
736 Ignore := Putchar (Character'Pos (Item));
737 end Put;
738
739 procedure Put (Item : String) is
740 begin
741 for J in Item'Range loop
742 Put (Item (J));
743 end loop;
744 end Put;
745
746 --------------
747 -- Put_Line --
748 --------------
749
750 procedure Put_Line (Item : String) is
751 begin
752 Put (Item);
753 New_Line;
754 end Put_Line;
755
756 end Ada.Text_IO;
-(0 . 0)(1 . 45)
761 ------------------------------------------------------------------------------
762 ------------------------------------------------------------------------------
763 -- You do not have, nor can you ever acquire the right to use, copy or --
764 -- distribute this software ; Should you use this software for any purpose, --
765 -- or copy and distribute it to anyone or in any manner, you are breaking --
766 -- the laws of whatever soi-disant jurisdiction, and you promise to --
767 -- continue doing so for the indefinite future. In any case, please --
768 -- always : read and understand any software ; verify any PGP signatures --
769 -- that you use - for any purpose. --
770 -- --
771 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
772 ------------------------------------------------------------------------------
773 ------------------------------------------------------------------------------
774
775 with Ada.Text_IO; use Ada.Text_IO;
776 with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
777 with System.Storage_Elements; use System.Storage_Elements;
778
779 procedure Last_Chance_Handler
780 (Msg : System.Address; Line : Integer)
781 is
782 procedure Exit_Now(status: Integer);
783 pragma Import
784 (Convention => C,
785 Entity => Exit_Now,
786 External_Name => "exit");
787
788 function Peek (Addr : System.Address) return Character
789 is
790 C : Character with Address => Addr;
791 begin
792 return C;
793 end Peek;
794 A : System.Address := Msg;
795 begin
796 Put ("GNAT Exception!:");
797 Put (Line);
798 Put (":");
799 while Peek(A) /= ASCII.NUL loop
800 Put (Peek(A));
801 A := A + 1;
802 end loop;
803 New_Line;
804 Exit_Now(-1);
805 end Last_Chance_Handler;
-(0 . 0)(1 . 135)
810 ------------------------------------------------------------------------------
811 ------------------------------------------------------------------------------
812 -- You do not have, nor can you ever acquire the right to use, copy or --
813 -- distribute this software ; Should you use this software for any purpose, --
814 -- or copy and distribute it to anyone or in any manner, you are breaking --
815 -- the laws of whatever soi-disant jurisdiction, and you promise to --
816 -- continue doing so for the indefinite future. In any case, please --
817 -- always : read and understand any software ; verify any PGP signatures --
818 -- that you use - for any purpose. --
819 -- --
820 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
821 ------------------------------------------------------------------------------
822 ------------------------------------------------------------------------------
823
824 package System is
825 pragma Pure;
826 -- Note that we take advantage of the implementation permission to make
827 -- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
828 -- 2005, this is Pure in any case (AI-362).
829
830 pragma No_Elaboration_Code_All;
831 -- Allow the use of that restriction in units that WITH this unit
832
833 type Name is (SYSTEM_NAME_GNAT);
834 System_Name : constant Name := SYSTEM_NAME_GNAT;
835
836 -- System-Dependent Named Numbers
837
838 Min_Int : constant := Long_Long_Integer'First;
839 Max_Int : constant := Long_Long_Integer'Last;
840
841 Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size;
842 Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1;
843
844 Max_Base_Digits : constant := Long_Long_Float'Digits;
845 Max_Digits : constant := Long_Long_Float'Digits;
846
847 Max_Mantissa : constant := 63;
848 Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
849
850 Tick : constant := 0.000_001;
851
852 -- Storage-related Declarations
853
854 type Address is private;
855 pragma Preelaborable_Initialization (Address);
856 Null_Address : constant Address;
857
858 Storage_Unit : constant := 8;
859 Word_Size : constant := Standard'Word_Size;
860 Memory_Size : constant := 2 ** Word_Size;
861
862 -- Address comparison
863
864 function "<" (Left, Right : Address) return Boolean;
865 function "<=" (Left, Right : Address) return Boolean;
866 function ">" (Left, Right : Address) return Boolean;
867 function ">=" (Left, Right : Address) return Boolean;
868 function "=" (Left, Right : Address) return Boolean;
869
870 pragma Import (Intrinsic, "<");
871 pragma Import (Intrinsic, "<=");
872 pragma Import (Intrinsic, ">");
873 pragma Import (Intrinsic, ">=");
874 pragma Import (Intrinsic, "=");
875
876 -- Other System-Dependent Declarations
877
878 type Bit_Order is (High_Order_First, Low_Order_First);
879 Default_Bit_Order : constant Bit_Order := Low_Order_First;
880 pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning
881
882 -- Priority-related Declarations (RM D.1)
883
884 -- 0 .. 98 corresponds to the system priority range 1 .. 99.
885 --
886 -- If the scheduling policy is SCHED_FIFO or SCHED_RR the runtime makes use
887 -- of the entire range provided by the system.
888 --
889 -- If the scheduling policy is SCHED_OTHER the only valid system priority
890 -- is 1 and other values are simply ignored.
891
892 Max_Priority : constant Positive := 97;
893 Max_Interrupt_Priority : constant Positive := 98;
894
895 subtype Any_Priority is Integer range 0 .. 98;
896 subtype Priority is Any_Priority range 0 .. 97;
897 subtype Interrupt_Priority is Any_Priority range 98 .. 98;
898
899 Default_Priority : constant Priority := 48;
900
901 private
902
903 type Address is mod Memory_Size;
904 Null_Address : constant Address := 0;
905
906 --------------------------------------
907 -- System Implementation Parameters --
908 --------------------------------------
909
910 -- These parameters provide information about the target that is used
911 -- by the compiler. They are in the private part of System, where they
912 -- can be accessed using the special circuitry in the Targparm unit
913 -- whose source should be consulted for more detailed descriptions
914 -- of the individual switch values.
915
916 Backend_Divide_Checks : constant Boolean := False;
917 Backend_Overflow_Checks : constant Boolean := True;
918 Command_Line_Args : constant Boolean := False;
919 Configurable_Run_Time : constant Boolean := True;
920 Denorm : constant Boolean := True;
921 Duration_32_Bits : constant Boolean := False;
922 Exit_Status_Supported : constant Boolean := True;
923 Fractional_Fixed_Ops : constant Boolean := False;
924 Frontend_Layout : constant Boolean := False;
925 Machine_Overflows : constant Boolean := False;
926 Machine_Rounds : constant Boolean := True;
927 Preallocated_Stacks : constant Boolean := False;
928 Signed_Zeros : constant Boolean := True;
929 Stack_Check_Default : constant Boolean := False;
930 Stack_Check_Probes : constant Boolean := True;
931 Stack_Check_Limits : constant Boolean := False;
932 Support_Aggregates : constant Boolean := True;
933 Support_Atomic_Primitives : constant Boolean := True;
934 Support_Composite_Assign : constant Boolean := True;
935 Support_Composite_Compare : constant Boolean := True;
936 Support_Long_Shifts : constant Boolean := True;
937 Always_Compatible_Rep : constant Boolean := False;
938 Suppress_Standard_Library : constant Boolean := True;
939 Use_Ada_Main_Program_Name : constant Boolean := False;
940 Frontend_Exceptions : constant Boolean := False;
941 ZCX_By_Default : constant Boolean := True;
942 Run_Time_Name : constant String := "FFA Run Time";
943
944 end System;
-(0 . 0)(1 . 59)
949 ------------------------------------------------------------------------------
950 ------------------------------------------------------------------------------
951 -- You do not have, nor can you ever acquire the right to use, copy or --
952 -- distribute this software ; Should you use this software for any purpose, --
953 -- or copy and distribute it to anyone or in any manner, you are breaking --
954 -- the laws of whatever soi-disant jurisdiction, and you promise to --
955 -- continue doing so for the indefinite future. In any case, please --
956 -- always : read and understand any software ; verify any PGP signatures --
957 -- that you use - for any purpose. --
958 -- --
959 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
960 ------------------------------------------------------------------------------
961 ------------------------------------------------------------------------------
962
963 -- Version for use with C run time
964 with System.Syscall; use System.Syscall;
965
966 package body Ada.Text_IO is
967 -- STDIN : constant := 0;
968 STDOUT : constant := 1;
969 -- STDERR : constant := 2;
970
971 --------------
972 -- New_Line --
973 --------------
974
975 procedure New_Line is
976 begin
977 Put (ASCII.LF);
978 end New_Line;
979
980 ---------
981 -- Put --
982 ---------
983
984 procedure Put (Item : Character) is
985 begin
986 Put ("" & Item);
987 end Put;
988
989 procedure Put (Item : String) is
990 Ignore : Int;
991 E : ErrorCode;
992 begin
993 Ignore := Write (STDOUT, Item, E);
994 pragma Unused (E);
995 end Put;
996
997 --------------
998 -- Put_Line --
999 --------------
1000
1001 procedure Put_Line (Item : String) is
1002 begin
1003 Put (Item);
1004 New_Line;
1005 end Put_Line;
1006
1007 end Ada.Text_IO;
-(0 . 0)(1 . 38)
1012 ------------------------------------------------------------------------------
1013 ------------------------------------------------------------------------------
1014 -- You do not have, nor can you ever acquire the right to use, copy or --
1015 -- distribute this software ; Should you use this software for any purpose, --
1016 -- or copy and distribute it to anyone or in any manner, you are breaking --
1017 -- the laws of whatever soi-disant jurisdiction, and you promise to --
1018 -- continue doing so for the indefinite future. In any case, please --
1019 -- always : read and understand any software ; verify any PGP signatures --
1020 -- that you use - for any purpose. --
1021 -- --
1022 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
1023 ------------------------------------------------------------------------------
1024 ------------------------------------------------------------------------------
1025
1026 with Ada.Text_IO; use Ada.Text_IO;
1027 with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
1028 with System.Storage_Elements; use System.Storage_Elements;
1029 with System.Syscall; use System.Syscall;
1030
1031 procedure Last_Chance_Handler (Msg : System.Address; Line : Integer) is
1032 function Peek (Addr : System.Address) return Character is
1033 C : Character with
1034 Address => Addr;
1035 begin
1036 return C;
1037 end Peek;
1038 A : System.Address := Msg;
1039 begin
1040 Put ("GNAT Exception!:");
1041 Put (Line);
1042 Put (":");
1043 while Peek (A) /= ASCII.NUL loop
1044 Put (Peek (A));
1045 A := A + 1;
1046 end loop;
1047 New_Line;
1048 Sys_Exit (1);
1049 end Last_Chance_Handler;
-(0 . 0)(1 . 74)
1054 with System.Machine_Code; use System.Machine_Code;
1055
1056 package body System.Syscall is
1057 SYSCALL_WRITE : constant := 1;
1058 SYSCALL_READ : constant := 0;
1059 -- SYSCALL_EXIT : constant := 60;
1060
1061 function Write (fd : in Int; S : in String; E : out ErrorCode) return Int is
1062 type byte is mod 2**8;
1063 B : array (S'Range) of byte;
1064 R : Int := 0;
1065 begin
1066 for I in S'Range loop
1067 B (I) := Character'Pos (S (I));
1068 end loop;
1069 Asm
1070 ("syscall",
1071 Outputs => (Int'Asm_Output ("=a", R)),
1072 Inputs =>
1073 (Int'Asm_Input ("a", SYSCALL_WRITE),
1074 Int'Asm_Input ("D", fd),
1075 System.Address'Asm_Input ("S", B'Address),
1076 Int'Asm_Input ("d", B'Length)),
1077 Volatile => True);
1078 if R < 0 and R >= -(2**12) then
1079 E := ErrorCode'Val (-R);
1080 R := -1;
1081 else
1082 E := OK;
1083 end if;
1084 return R;
1085 end Write;
1086
1087 function Read (fd : in Int; s : out String; E : out ErrorCode) return Int is
1088 type byte is mod 2**8;
1089 B : array (S'Range) of byte;
1090 R : Int := 0;
1091 begin
1092 Asm
1093 ("syscall",
1094 Outputs => (Int'Asm_Output ("=a", R)),
1095 Inputs =>
1096 (Int'Asm_Input ("a", SYSCALL_READ),
1097 Int'Asm_Input ("D", fd),
1098 System.Address'Asm_Input ("S", B'Address),
1099 Int'Asm_Input ("d", B'Length)));
1100 for I in S'Range loop
1101 S (I) := Character'Val (B (I));
1102 end loop;
1103 if R < 0 and R >= -(2**12) then
1104 E := ErrorCode'Val (-R);
1105 R := -1;
1106 else
1107 E := OK;
1108 end if;
1109 return R;
1110 end Read;
1111
1112 procedure Sys_Exit (C : in Integer) is
1113 begin
1114 Asm
1115 ("mov $60, %%rax" &
1116 ASCII.LF &
1117 ASCII.HT & -- EXIT
1118 "mov %0, %%rdi" &
1119 ASCII.LF &
1120 ASCII.HT & -- CODE
1121 "syscall",
1122 Inputs => (Int'Asm_Input ("g", Int (C))),
1123 Clobber => "rax, rdi",
1124 Volatile => True);
1125 raise Program_Error;
1126 end Sys_Exit;
1127 end System.Syscall;
-(0 . 0)(1 . 17)
1132 package System.Syscall is
1133 -- All interaction with system calls use 4 64bit registers
1134 -- These registers are interpreted as integers or pointers
1135 type Int is range -2**63 .. (2**63 - 1);
1136 -- The return code will be an integer
1137 -- On error, an errocode is returned, values are between 0 and 4096
1138 type ErrorCode is range 0 .. 2**12;
1139
1140 OK : constant ErrorCode := 0;
1141
1142 function Write (fd : in Int; S : in String; E : out ErrorCode) return Int;
1143 function Read (fd : in Int; S : out String; E : out ErrorCode) return Int;
1144
1145 procedure Sys_Exit (C : in Integer) with
1146 No_Return;
1147
1148 end System.Syscall;
-(0 . 0)(1 . 21)
1153 <?xml version="1.0" ?>
1154
1155 <gprconfig>
1156 <configuration>
1157 <config>
1158 package Linker is
1159 for Required_Switches use Linker'Required_Switches &
1160 ("${RUNTIME_DIR(ada)}/adalib/libgnat.a") &
1161 ("-nostdlib", "-nodefaultlibs", "-lgcc");
1162
1163 for Required_Switches use Linker'Required_Switches &
1164 ("${RUNTIME_DIR(ada)}/adalib/start.o");
1165 end Linker;
1166
1167 package Binder is
1168 for Required_Switches ("Ada") use Binder'Required_Switches ("Ada") &
1169 ("-nostdlib") ;
1170 end Binder;
1171 </config>
1172 </configuration>
1173 </gprconfig>
-(0 . 0)(1 . 13)
1178 <?xml version="1.0" ?>
1179
1180 <gprconfig>
1181 <configuration>
1182 <config>
1183 package Linker is
1184 for Required_Switches use Linker'Required_Switches &
1185 ("${RUNTIME_DIR(ada)}/adalib/libgnat.a") &
1186 ("-lgcc");
1187 end Linker;
1188 </config>
1189 </configuration>
1190 </gprconfig>
- F1F4017587E31F70C8936356B09FB73710AC7FCA3A6FD7577BA480D7AE49ED786D17D622802B84DE311FDBF32994BE887C035B8BCA292298BE9EE958489B8C6F(1 . 21)(0 . 0)
1195 <?xml version="1.0" ?>
1196
1197 <gprconfig>
1198 <configuration>
1199 <config>
1200 package Linker is
1201 for Required_Switches use Linker'Required_Switches &
1202 ("${RUNTIME_DIR(ada)}/adalib/libgnat.a") &
1203 ("-nostdlib", "-nodefaultlibs", "-lgcc");
1204
1205 for Required_Switches use Linker'Required_Switches &
1206 ("${RUNTIME_DIR(ada)}/adalib/start.o");
1207 end Linker;
1208
1209 package Binder is
1210 for Required_Switches ("Ada") use Binder'Required_Switches ("Ada") &
1211 ("-nostdlib") ;
1212 end Binder;
1213 </config>
1214 </configuration>
1215 </gprconfig>