diff -uNr -uN a/zfp/Makefile b/zfp/Makefile --- a/zfp/Makefile 84fa5516bb938ec76b4f99ed2e1bd1beb122abd3796a20175df7b120638601950214f5fbddeb654ad4636c4ea8e7554b4191621d97680e4e97f17ac0c3cd75da +++ b/zfp/Makefile bc8fcf6826493f674ac1143406d08dc51d761a42a32c36f5ce55fc4a6142c99a990bf88d095b48096a0ae33cc70fdcb73eb82a658cb23b56dbb6b361de9b1755 @@ -1,13 +1,20 @@ PROJECT_FILE=gnat_runtime.gpr +PLATFORM?=x86_64-asm +PREFIX?=ZFP -all: adalib/libgnat.a adalib/start.o +all: adalib/libgnat.a obj/start.o -adalib/start.o:adainclude/start.S +obj/start.o:adainclude/start.S as -c $< -o $@ adalib/libgnat.a:adainclude/*.ads - gnatmake -P $(PROJECT_FILE) + gprbuild -Xplatform=$(PLATFORM) -P $(PROJECT_FILE) + +install:adalib/libgnat.a + cp runtime-$(PLATFORM).xml runtime.xml + gprinstall -Xplatform=$(PLATFORM) -P $(PROJECT_FILE) -f -p --prefix=$(PREFIX) clean: - gprclean -P $(PROJECT_FILE) - -rm -Rf adalib/start.o + gprclean -Xplatform=$(PLATFORM) -P $(PROJECT_FILE) + -rm -Rf obj/start.o + -rm -f runtime.xml diff -uNr -uN a/zfp/adainclude/a-textio.adb b/zfp/adainclude/a-textio.adb --- a/zfp/adainclude/a-textio.adb e493b72dc9f010949aeafc3c54c7a420fa7c26289a0e276ae819cf04111040a11603232f51e79cfd5fd389f7d0be17dc528718c2014d8152b69f234d1ec7c9a4 +++ b/zfp/adainclude/a-textio.adb false @@ -1,59 +0,0 @@ ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- --- You do not have, nor can you ever acquire the right to use, copy or -- --- distribute this software ; Should you use this software for any purpose, -- --- or copy and distribute it to anyone or in any manner, you are breaking -- --- the laws of whatever soi-disant jurisdiction, and you promise to -- --- continue doing so for the indefinite future. In any case, please -- --- always : read and understand any software ; verify any PGP signatures -- --- that you use - for any purpose. -- --- -- --- See also http://trilema.com/2015/a-new-software-licensing-paradigm . -- ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- - --- Version for use with C run time -with System.Syscall; use System.Syscall; - -package body Ada.Text_IO is - -- STDIN : constant := 0; - STDOUT : constant := 1; - -- STDERR : constant := 2; - - -------------- - -- New_Line -- - -------------- - - procedure New_Line is - begin - Put (ASCII.LF); - end New_Line; - - --------- - -- Put -- - --------- - - procedure Put (Item : Character) is - begin - Put ("" & Item); - end Put; - - procedure Put (Item : String) is - Ignore : Int; - E : ErrorCode; - begin - Ignore := Write (STDOUT, Item, E); - pragma Unused (E); - end Put; - - -------------- - -- Put_Line -- - -------------- - - procedure Put_Line (Item : String) is - begin - Put (Item); - New_Line; - end Put_Line; - -end Ada.Text_IO; diff -uNr -uN a/zfp/adainclude/i-c.adb b/zfp/adainclude/i-c.adb --- a/zfp/adainclude/i-c.adb false +++ b/zfp/adainclude/i-c.adb 4f9c6f20ea0e86a1ee2087dfe3ff5afadde65c40bf5e74dccbf687695d603c7ad353bb245a0b7c081022d7355819ae9b9607c8850ba4a99fdb65a1fb302510bf @@ -0,0 +1,154 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- I N T E R F A C E S . C -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- -- +-- -- +-- -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +package body Interfaces.C is + + ----------------------- + -- Is_Nul_Terminated -- + ----------------------- + + -- Case of char_array + + function Is_Nul_Terminated (Item : char_array) return Boolean is + begin + for J in Item'Range loop + if Item (J) = nul then + return True; + end if; + end loop; + + return False; + end Is_Nul_Terminated; + + ------------ + -- To_Ada -- + ------------ + + -- Convert char to Character + + function To_Ada (Item : char) return Character is + begin + return Character'Val (char'Pos (Item)); + end To_Ada; + + -- Convert char_array to String (procedure form) + + procedure To_Ada + (Item : char_array; + Target : out String; + Count : out Natural; + Trim_Nul : Boolean := True) + is + From : size_t; + To : Positive; + + begin + if Trim_Nul then + From := Item'First; + loop + if From > Item'Last then + raise Program_Error; + elsif Item (From) = nul then + exit; + else + From := From + 1; + end if; + end loop; + + Count := Natural (From - Item'First); + + else + Count := Item'Length; + end if; + + if Count > Target'Length then + raise Constraint_Error; + + else + From := Item'First; + To := Target'First; + + for J in 1 .. Count loop + Target (To) := Character (Item (From)); + From := From + 1; + To := To + 1; + end loop; + end if; + + end To_Ada; + + ---------- + -- To_C -- + ---------- + + -- Convert Character to char + + function To_C (Item : Character) return char is + begin + return char'Val (Character'Pos (Item)); + end To_C; + + -- Convert String to char_array (procedure form) + + procedure To_C + (Item : String; + Target : out char_array; + Count : out size_t; + Append_Nul : Boolean := True) + is + To : size_t; + + begin + if Target'Length < Item'Length then + raise Constraint_Error; + + else + To := Target'First; + for From in Item'Range loop + Target (To) := char (Item (From)); + To := To + 1; + end loop; + + if Append_Nul then + if To > Target'Last then + raise Constraint_Error; + else + Target (To) := nul; + Count := Item'Length + 1; + end if; + + else + Count := Item'Length; + end if; + end if; + end To_C; + +end Interfaces.C; diff -uNr -uN a/zfp/adainclude/i-c.ads b/zfp/adainclude/i-c.ads --- a/zfp/adainclude/i-c.ads false +++ b/zfp/adainclude/i-c.ads 38b5aa2c5d93385a4ecd045ebe84c6b50a1b530da89be5226576021b022bc8b5e45ac0d91afaf25ff7074a4b275f5ffdf1fad648be48e1949d6f750705fc5672 @@ -0,0 +1,99 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- I N T E R F A C E S . C -- +-- -- +-- S p e c -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. In accordance with the copyright of that document, you can freely -- +-- copy and modify this specification, provided that if you redistribute a -- +-- modified version, any changes that you have made are clearly indicated. -- +-- -- +------------------------------------------------------------------------------ + +with System.Parameters; + +package Interfaces.C is + pragma Pure; + + -- Declaration's based on C's + + CHAR_BIT : constant := 8; + SCHAR_MIN : constant := -128; + SCHAR_MAX : constant := 127; + UCHAR_MAX : constant := 255; + + -- Signed and Unsigned Integers. Note that in GNAT, we have ensured that + -- the standard predefined Ada types correspond to the standard C types + + -- Note: the Integer qualifications used in the declaration of type long + -- avoid ambiguities when compiling in the presence of s-auxdec.ads and + -- a non-private system.address type. + + type int is new Integer; + type short is new Short_Integer; + type long is + range + -(2**(System.Parameters.long_bits - Integer'(1))) .. + +(2**(System.Parameters.long_bits - Integer'(1))) - 1; + + type signed_char is range SCHAR_MIN .. SCHAR_MAX; + for signed_char'Size use CHAR_BIT; + + type unsigned is mod 2**int'Size; + type unsigned_short is mod 2**short'Size; + type unsigned_long is mod 2**long'Size; + + type unsigned_char is mod (UCHAR_MAX + 1); + for unsigned_char'Size use CHAR_BIT; + + subtype plain_char is unsigned_char; -- ??? should be parameterized + + -- Note: the Integer qualifications used in the declaration of ptrdiff_t + -- avoid ambiguities when compiling in the presence of s-auxdec.ads and + -- a non-private system.address type. + + type ptrdiff_t is + range + -(2**(System.Parameters.ptr_bits - Integer'(1))) .. + +(2**(System.Parameters.ptr_bits - Integer'(1)) - 1); + + type size_t is mod 2**System.Parameters.ptr_bits; + + -- Floating-Point + + type C_float is new Float; + type double is new Standard.Long_Float; + type long_double is new Standard.Long_Long_Float; + + ---------------------------- + -- Characters and Strings -- + ---------------------------- + + type char is new Character; + + nul : constant char := char'First; + + function To_C (Item : Character) return char; + function To_Ada (Item : char) return Character; + + type char_array is array (size_t range <>) of aliased char; + for char_array'Component_Size use CHAR_BIT; + + function Is_Nul_Terminated (Item : char_array) return Boolean; + + procedure To_C + (Item : String; + Target : out char_array; + Count : out size_t; + Append_Nul : Boolean := True); + + procedure To_Ada + (Item : char_array; + Target : out String; + Count : out Natural; + Trim_Nul : Boolean := True); + +end Interfaces.C; diff -uNr -uN a/zfp/adainclude/last_chance_handler.adb b/zfp/adainclude/last_chance_handler.adb --- a/zfp/adainclude/last_chance_handler.adb ec06f5d03656946c1d7f682fa5192ef8bd3c8d460e5bd8b9f0dc1de36b6aa549f1b8fe1e0525d3a660c8a8ab1928aa05868359ec4b838d2d951c5ff672b2d93e +++ b/zfp/adainclude/last_chance_handler.adb false @@ -1,38 +0,0 @@ ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- --- You do not have, nor can you ever acquire the right to use, copy or -- --- distribute this software ; Should you use this software for any purpose, -- --- or copy and distribute it to anyone or in any manner, you are breaking -- --- the laws of whatever soi-disant jurisdiction, and you promise to -- --- continue doing so for the indefinite future. In any case, please -- --- always : read and understand any software ; verify any PGP signatures -- --- that you use - for any purpose. -- --- -- --- See also http://trilema.com/2015/a-new-software-licensing-paradigm . -- ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- - -with Ada.Text_IO; use Ada.Text_IO; -with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; -with System.Storage_Elements; use System.Storage_Elements; -with System.Syscall; use System.Syscall; - -procedure Last_Chance_Handler (Msg : System.Address; Line : Integer) is - function Peek (Addr : System.Address) return Character is - C : Character with - Address => Addr; - begin - return C; - end Peek; - A : System.Address := Msg; -begin - Put ("GNAT Exception!:"); - Put (Line); - Put (":"); - while Peek (A) /= ASCII.NUL loop - Put (Peek (A)); - A := A + 1; - end loop; - New_Line; - Sys_Exit (1); -end Last_Chance_Handler; diff -uNr -uN a/zfp/adainclude/s-syscal.adb b/zfp/adainclude/s-syscal.adb --- a/zfp/adainclude/s-syscal.adb 602e857b2c3724b907ca3d6f4b1587d375c7e35f90ac7a23253edaff29187862d6fc2b2c104da14706b16db2f984eb335b4389c40e87407068d853cdbc0e6210 +++ b/zfp/adainclude/s-syscal.adb false @@ -1,74 +0,0 @@ -with System.Machine_Code; use System.Machine_Code; - -package body System.Syscall is - SYSCALL_WRITE : constant := 1; - SYSCALL_READ : constant := 0; - -- SYSCALL_EXIT : constant := 60; - - function Write (fd : in Int; S : in String; E : out ErrorCode) return Int is - type byte is mod 2**8; - B : array (S'Range) of byte; - R : Int := 0; - begin - for I in S'Range loop - B (I) := Character'Pos (S (I)); - end loop; - Asm - ("syscall", - Outputs => (Int'Asm_Output ("=a", R)), - Inputs => - (Int'Asm_Input ("a", SYSCALL_WRITE), - Int'Asm_Input ("D", fd), - System.Address'Asm_Input ("S", B'Address), - Int'Asm_Input ("d", B'Length)), - Volatile => True); - if R < 0 and R >= -(2**12) then - E := ErrorCode'Val (-R); - R := -1; - else - E := OK; - end if; - return R; - end Write; - - function Read (fd : in Int; s : out String; E : out ErrorCode) return Int is - type byte is mod 2**8; - B : array (S'Range) of byte; - R : Int := 0; - begin - Asm - ("syscall", - Outputs => (Int'Asm_Output ("=a", R)), - Inputs => - (Int'Asm_Input ("a", SYSCALL_READ), - Int'Asm_Input ("D", fd), - System.Address'Asm_Input ("S", B'Address), - Int'Asm_Input ("d", B'Length))); - for I in S'Range loop - S (I) := Character'Val (B (I)); - end loop; - if R < 0 and R >= -(2**12) then - E := ErrorCode'Val (-R); - R := -1; - else - E := OK; - end if; - return R; - end Read; - - procedure Sys_Exit (C : in Integer) is - begin - Asm - ("mov $60, %%rax" & - ASCII.LF & - ASCII.HT & -- EXIT - "mov %0, %%rdi" & - ASCII.LF & - ASCII.HT & -- CODE - "syscall", - Inputs => (Int'Asm_Input ("g", Int (C))), - Clobber => "rax, rdi", - Volatile => True); - raise Program_Error; - end Sys_Exit; -end System.Syscall; diff -uNr -uN a/zfp/adainclude/s-syscal.ads b/zfp/adainclude/s-syscal.ads --- a/zfp/adainclude/s-syscal.ads e87d5d4ecc1a2a9bed07371e36f4ca73c34e5781cfa4e3c5d159027f7c9468acddfadf8e59e8357a24cf22b1e8ff1148c660c6a09aac40e43614c62137b822b8 +++ b/zfp/adainclude/s-syscal.ads false @@ -1,17 +0,0 @@ -package System.Syscall is - -- All interaction with system calls use 4 64bit registers - -- These registers are interpreted as integers or pointers - type Int is range -2**63 .. (2**63 - 1); - -- The return code will be an integer - -- On error, an errocode is returned, values are between 0 and 4096 - type ErrorCode is range 0 .. 2**12; - - OK : constant ErrorCode := 0; - - function Write (fd : in Int; S : in String; E : out ErrorCode) return Int; - function Read (fd : in Int; S : out String; E : out ErrorCode) return Int; - - procedure Sys_Exit (C : in Integer) with - No_Return; - -end System.Syscall; diff -uNr -uN a/zfp/adainclude/system.ads b/zfp/adainclude/system.ads --- a/zfp/adainclude/system.ads 829aa035034216a965a6fdb18cc9039d873575b8f4cb592178928a830ee2f35ae58210349277ecea5ecf70d1ba615f61f3443322fb7e650c5ea39954288358ac +++ b/zfp/adainclude/system.ads false @@ -1,135 +0,0 @@ ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- --- You do not have, nor can you ever acquire the right to use, copy or -- --- distribute this software ; Should you use this software for any purpose, -- --- or copy and distribute it to anyone or in any manner, you are breaking -- --- the laws of whatever soi-disant jurisdiction, and you promise to -- --- continue doing so for the indefinite future. In any case, please -- --- always : read and understand any software ; verify any PGP signatures -- --- that you use - for any purpose. -- --- -- --- See also http://trilema.com/2015/a-new-software-licensing-paradigm . -- ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- - -package System is - pragma Pure; - -- Note that we take advantage of the implementation permission to make - -- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada - -- 2005, this is Pure in any case (AI-362). - - pragma No_Elaboration_Code_All; - -- Allow the use of that restriction in units that WITH this unit - - type Name is (SYSTEM_NAME_GNAT); - System_Name : constant Name := SYSTEM_NAME_GNAT; - - -- System-Dependent Named Numbers - - Min_Int : constant := Long_Long_Integer'First; - Max_Int : constant := Long_Long_Integer'Last; - - Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size; - Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1; - - Max_Base_Digits : constant := Long_Long_Float'Digits; - Max_Digits : constant := Long_Long_Float'Digits; - - Max_Mantissa : constant := 63; - Fine_Delta : constant := 2.0 ** (-Max_Mantissa); - - Tick : constant := 0.000_001; - - -- Storage-related Declarations - - type Address is private; - pragma Preelaborable_Initialization (Address); - Null_Address : constant Address; - - Storage_Unit : constant := 8; - Word_Size : constant := Standard'Word_Size; - Memory_Size : constant := 2 ** Word_Size; - - -- Address comparison - - function "<" (Left, Right : Address) return Boolean; - function "<=" (Left, Right : Address) return Boolean; - function ">" (Left, Right : Address) return Boolean; - function ">=" (Left, Right : Address) return Boolean; - function "=" (Left, Right : Address) return Boolean; - - pragma Import (Intrinsic, "<"); - pragma Import (Intrinsic, "<="); - pragma Import (Intrinsic, ">"); - pragma Import (Intrinsic, ">="); - pragma Import (Intrinsic, "="); - - -- Other System-Dependent Declarations - - type Bit_Order is (High_Order_First, Low_Order_First); - Default_Bit_Order : constant Bit_Order := Low_Order_First; - pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning - - -- Priority-related Declarations (RM D.1) - - -- 0 .. 98 corresponds to the system priority range 1 .. 99. - -- - -- If the scheduling policy is SCHED_FIFO or SCHED_RR the runtime makes use - -- of the entire range provided by the system. - -- - -- If the scheduling policy is SCHED_OTHER the only valid system priority - -- is 1 and other values are simply ignored. - - Max_Priority : constant Positive := 97; - Max_Interrupt_Priority : constant Positive := 98; - - subtype Any_Priority is Integer range 0 .. 98; - subtype Priority is Any_Priority range 0 .. 97; - subtype Interrupt_Priority is Any_Priority range 98 .. 98; - - Default_Priority : constant Priority := 48; - -private - - type Address is mod Memory_Size; - Null_Address : constant Address := 0; - - -------------------------------------- - -- System Implementation Parameters -- - -------------------------------------- - - -- These parameters provide information about the target that is used - -- by the compiler. They are in the private part of System, where they - -- can be accessed using the special circuitry in the Targparm unit - -- whose source should be consulted for more detailed descriptions - -- of the individual switch values. - - Backend_Divide_Checks : constant Boolean := False; - Backend_Overflow_Checks : constant Boolean := True; - Command_Line_Args : constant Boolean := False; - Configurable_Run_Time : constant Boolean := True; - Denorm : constant Boolean := True; - Duration_32_Bits : constant Boolean := False; - Exit_Status_Supported : constant Boolean := True; - Fractional_Fixed_Ops : constant Boolean := False; - Frontend_Layout : constant Boolean := False; - Machine_Overflows : constant Boolean := False; - Machine_Rounds : constant Boolean := True; - Preallocated_Stacks : constant Boolean := False; - Signed_Zeros : constant Boolean := True; - Stack_Check_Default : constant Boolean := False; - Stack_Check_Probes : constant Boolean := True; - Stack_Check_Limits : constant Boolean := False; - Support_Aggregates : constant Boolean := True; - Support_Atomic_Primitives : constant Boolean := True; - Support_Composite_Assign : constant Boolean := True; - Support_Composite_Compare : constant Boolean := True; - Support_Long_Shifts : constant Boolean := True; - Always_Compatible_Rep : constant Boolean := False; - Suppress_Standard_Library : constant Boolean := True; - Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; - ZCX_By_Default : constant Boolean := True; - Run_Time_Name : constant String := "FFA Run Time"; - -end System; diff -uNr -uN a/zfp/examples/Makefile b/zfp/examples/Makefile --- a/zfp/examples/Makefile d89fab93e12d5f7211cf3c3133e4e4ec50f657d57f7d49c2fb9ef9cc9a4b4c7998ec9ae237d8c7e277dc91d59680d1c54339eb615c4bea5fff26e14144dc9f1c +++ b/zfp/examples/Makefile db1bb3a5b5c3179e5c3cebd1fd37ed9c1099e6abedfae82c61efdb055046b96efb7891b475487fb6a425814d245fec9390f70e645dbce09c990ed8c54e4bec5e @@ -1,10 +1,10 @@ -PROJECT_FILE=gnat_runtime.gpr +PROJECT_FILE=examples.gpr +RTS?=../ZFP all: bin/hello -bin/hello:helloworld/hello.adb ../adalib/libgnat.a ../adalib/start.o - gprbuild --RTS=.. +bin/hello:helloworld/hello.adb + gprbuild -P $(PROJECT_FILE) --RTS=$(RTS) clean: gprclean -P $(PROJECT_FILE) - -rm -Rf adalib/start.o diff -uNr -uN a/zfp/gnat_runtime.gpr b/zfp/gnat_runtime.gpr --- a/zfp/gnat_runtime.gpr 333021e0854dd34f16f0f42540dd1ab89940fde79d8283ef965e9bed288de0174d5b69c91e465afe6fa2147f7d597b0a9424fe95c04e3ad0c866acdc058b6443 +++ b/zfp/gnat_runtime.gpr 8579e0cd9c35112b60301c07b6d344b676dab80dbdbcd5a0ca98e3ac56a1f7459db85694925f1d616def0aa7dbb68a1dd575178eca98166c6d1af480cd546c88 @@ -15,7 +15,16 @@ library project Gnat_Runtime is for Languages use ("Ada"); - for Source_Dirs use ("adainclude"); + type Platform_Type is ("x86_64-asm", "x86_64-c"); + Platform : Platform_Type := external ("platform", "x86_64-asm"); + + case Platform is + when "x86_64-asm" => + for Source_Dirs use ("adainclude", "platform/linux-x86_64", "platform/linux-x86_64-asm"); + when "x86_64-c" => + for Source_Dirs use ("adainclude", "platform/linux-x86_64", "platform/linux-c"); + end case; + for Object_Dir use "obj"; for Library_Kind use "static"; for Library_Name use "gnat"; @@ -41,6 +50,12 @@ for Lib_Subdir use "adalib"; for Required_Artifacts (".") use ("runtime.xml"); for Install_Project use "false"; + case Platform is + when "x86_64-asm" => + for Artifacts ("adalib") use ("obj/start.o"); + when others => + null; + end case; end Install; end Gnat_Runtime; diff -uNr -uN a/zfp/manifest b/zfp/manifest --- a/zfp/manifest 69c0cf97b057d92731f3a70d4cf346752478727fecab43d10314ddde83421301aeb82e2a4c51f74f2eedd42f064c44bb208853dad5d408f25816cdea41f5eade +++ b/zfp/manifest de5208294e7c0f2df2b9c2d671ca16e799885c1c92720251db4576257e14240b778104caf5bb5e86fc2bbc985d8f4b6a03713dc5c8f86cb9ad0bcf569def0a6b @@ -1,3 +1,4 @@ 535595 zfp_genesis ave1 a minimal gnat runtime library 535611 zfp_1_examples ave1 two examples for the minimal runtime 535612 zfp_2_noc ave1 zfp no dependency on the C library +536580 zfp_3_platform ave1 added platform types to the compilation so that C, asm and also different processors can be supported diff -uNr -uN a/zfp/platform/linux-c/a-textio.adb b/zfp/platform/linux-c/a-textio.adb --- a/zfp/platform/linux-c/a-textio.adb false +++ b/zfp/platform/linux-c/a-textio.adb 64ade4f4343cead30b2019d7bbcffc66b461de9abdef5aa744f674b2da2c433d54a5678c11ef2d48522727c57ac407119109972b0c6afbf915a748b2b9d9e23c @@ -0,0 +1,59 @@ +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- You do not have, nor can you ever acquire the right to use, copy or -- +-- distribute this software ; Should you use this software for any purpose, -- +-- or copy and distribute it to anyone or in any manner, you are breaking -- +-- the laws of whatever soi-disant jurisdiction, and you promise to -- +-- continue doing so for the indefinite future. In any case, please -- +-- always : read and understand any software ; verify any PGP signatures -- +-- that you use - for any purpose. -- +-- -- +-- See also http://trilema.com/2015/a-new-software-licensing-paradigm . -- +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ + +-- Version for use with C run time + +package body Ada.Text_IO is + + -------------- + -- New_Line -- + -------------- + + procedure New_Line is + begin + Put (ASCII.LF); + end New_Line; + + --------- + -- Put -- + --------- + + procedure Put (Item : Character) is + function Putchar (C : Integer) return Integer; + pragma Import (C, Putchar); + + Ignore : Integer; + + begin + Ignore := Putchar (Character'Pos (Item)); + end Put; + + procedure Put (Item : String) is + begin + for J in Item'Range loop + Put (Item (J)); + end loop; + end Put; + + -------------- + -- Put_Line -- + -------------- + + procedure Put_Line (Item : String) is + begin + Put (Item); + New_Line; + end Put_Line; + +end Ada.Text_IO; diff -uNr -uN a/zfp/platform/linux-c/last_chance_handler.adb b/zfp/platform/linux-c/last_chance_handler.adb --- a/zfp/platform/linux-c/last_chance_handler.adb false +++ b/zfp/platform/linux-c/last_chance_handler.adb 845a46a9c033614286cb30a1f6a0786ae2a7c0ca8ecb973b248173d8512662bb97dd02e91ef63cd129fb78aa9f3df23dd93576122d743882e7c72c93cfed5cd4 @@ -0,0 +1,45 @@ +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- You do not have, nor can you ever acquire the right to use, copy or -- +-- distribute this software ; Should you use this software for any purpose, -- +-- or copy and distribute it to anyone or in any manner, you are breaking -- +-- the laws of whatever soi-disant jurisdiction, and you promise to -- +-- continue doing so for the indefinite future. In any case, please -- +-- always : read and understand any software ; verify any PGP signatures -- +-- that you use - for any purpose. -- +-- -- +-- See also http://trilema.com/2015/a-new-software-licensing-paradigm . -- +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ + +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; +with System.Storage_Elements; use System.Storage_Elements; + +procedure Last_Chance_Handler + (Msg : System.Address; Line : Integer) +is + procedure Exit_Now(status: Integer); + pragma Import + (Convention => C, + Entity => Exit_Now, + External_Name => "exit"); + + function Peek (Addr : System.Address) return Character + is + C : Character with Address => Addr; + begin + return C; + end Peek; + A : System.Address := Msg; +begin + Put ("GNAT Exception!:"); + Put (Line); + Put (":"); + while Peek(A) /= ASCII.NUL loop + Put (Peek(A)); + A := A + 1; + end loop; + New_Line; + Exit_Now(-1); +end Last_Chance_Handler; diff -uNr -uN a/zfp/platform/linux-x86_64/system.ads b/zfp/platform/linux-x86_64/system.ads --- a/zfp/platform/linux-x86_64/system.ads false +++ b/zfp/platform/linux-x86_64/system.ads 829aa035034216a965a6fdb18cc9039d873575b8f4cb592178928a830ee2f35ae58210349277ecea5ecf70d1ba615f61f3443322fb7e650c5ea39954288358ac @@ -0,0 +1,135 @@ +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- You do not have, nor can you ever acquire the right to use, copy or -- +-- distribute this software ; Should you use this software for any purpose, -- +-- or copy and distribute it to anyone or in any manner, you are breaking -- +-- the laws of whatever soi-disant jurisdiction, and you promise to -- +-- continue doing so for the indefinite future. In any case, please -- +-- always : read and understand any software ; verify any PGP signatures -- +-- that you use - for any purpose. -- +-- -- +-- See also http://trilema.com/2015/a-new-software-licensing-paradigm . -- +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ + +package System is + pragma Pure; + -- Note that we take advantage of the implementation permission to make + -- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada + -- 2005, this is Pure in any case (AI-362). + + pragma No_Elaboration_Code_All; + -- Allow the use of that restriction in units that WITH this unit + + type Name is (SYSTEM_NAME_GNAT); + System_Name : constant Name := SYSTEM_NAME_GNAT; + + -- System-Dependent Named Numbers + + Min_Int : constant := Long_Long_Integer'First; + Max_Int : constant := Long_Long_Integer'Last; + + Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size; + Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1; + + Max_Base_Digits : constant := Long_Long_Float'Digits; + Max_Digits : constant := Long_Long_Float'Digits; + + Max_Mantissa : constant := 63; + Fine_Delta : constant := 2.0 ** (-Max_Mantissa); + + Tick : constant := 0.000_001; + + -- Storage-related Declarations + + type Address is private; + pragma Preelaborable_Initialization (Address); + Null_Address : constant Address; + + Storage_Unit : constant := 8; + Word_Size : constant := Standard'Word_Size; + Memory_Size : constant := 2 ** Word_Size; + + -- Address comparison + + function "<" (Left, Right : Address) return Boolean; + function "<=" (Left, Right : Address) return Boolean; + function ">" (Left, Right : Address) return Boolean; + function ">=" (Left, Right : Address) return Boolean; + function "=" (Left, Right : Address) return Boolean; + + pragma Import (Intrinsic, "<"); + pragma Import (Intrinsic, "<="); + pragma Import (Intrinsic, ">"); + pragma Import (Intrinsic, ">="); + pragma Import (Intrinsic, "="); + + -- Other System-Dependent Declarations + + type Bit_Order is (High_Order_First, Low_Order_First); + Default_Bit_Order : constant Bit_Order := Low_Order_First; + pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning + + -- Priority-related Declarations (RM D.1) + + -- 0 .. 98 corresponds to the system priority range 1 .. 99. + -- + -- If the scheduling policy is SCHED_FIFO or SCHED_RR the runtime makes use + -- of the entire range provided by the system. + -- + -- If the scheduling policy is SCHED_OTHER the only valid system priority + -- is 1 and other values are simply ignored. + + Max_Priority : constant Positive := 97; + Max_Interrupt_Priority : constant Positive := 98; + + subtype Any_Priority is Integer range 0 .. 98; + subtype Priority is Any_Priority range 0 .. 97; + subtype Interrupt_Priority is Any_Priority range 98 .. 98; + + Default_Priority : constant Priority := 48; + +private + + type Address is mod Memory_Size; + Null_Address : constant Address := 0; + + -------------------------------------- + -- System Implementation Parameters -- + -------------------------------------- + + -- These parameters provide information about the target that is used + -- by the compiler. They are in the private part of System, where they + -- can be accessed using the special circuitry in the Targparm unit + -- whose source should be consulted for more detailed descriptions + -- of the individual switch values. + + Backend_Divide_Checks : constant Boolean := False; + Backend_Overflow_Checks : constant Boolean := True; + Command_Line_Args : constant Boolean := False; + Configurable_Run_Time : constant Boolean := True; + Denorm : constant Boolean := True; + Duration_32_Bits : constant Boolean := False; + Exit_Status_Supported : constant Boolean := True; + Fractional_Fixed_Ops : constant Boolean := False; + Frontend_Layout : constant Boolean := False; + Machine_Overflows : constant Boolean := False; + Machine_Rounds : constant Boolean := True; + Preallocated_Stacks : constant Boolean := False; + Signed_Zeros : constant Boolean := True; + Stack_Check_Default : constant Boolean := False; + Stack_Check_Probes : constant Boolean := True; + Stack_Check_Limits : constant Boolean := False; + Support_Aggregates : constant Boolean := True; + Support_Atomic_Primitives : constant Boolean := True; + Support_Composite_Assign : constant Boolean := True; + Support_Composite_Compare : constant Boolean := True; + Support_Long_Shifts : constant Boolean := True; + Always_Compatible_Rep : constant Boolean := False; + Suppress_Standard_Library : constant Boolean := True; + Use_Ada_Main_Program_Name : constant Boolean := False; + Frontend_Exceptions : constant Boolean := False; + ZCX_By_Default : constant Boolean := True; + Run_Time_Name : constant String := "FFA Run Time"; + +end System; diff -uNr -uN a/zfp/platform/linux-x86_64-asm/a-textio.adb b/zfp/platform/linux-x86_64-asm/a-textio.adb --- a/zfp/platform/linux-x86_64-asm/a-textio.adb false +++ b/zfp/platform/linux-x86_64-asm/a-textio.adb e493b72dc9f010949aeafc3c54c7a420fa7c26289a0e276ae819cf04111040a11603232f51e79cfd5fd389f7d0be17dc528718c2014d8152b69f234d1ec7c9a4 @@ -0,0 +1,59 @@ +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- You do not have, nor can you ever acquire the right to use, copy or -- +-- distribute this software ; Should you use this software for any purpose, -- +-- or copy and distribute it to anyone or in any manner, you are breaking -- +-- the laws of whatever soi-disant jurisdiction, and you promise to -- +-- continue doing so for the indefinite future. In any case, please -- +-- always : read and understand any software ; verify any PGP signatures -- +-- that you use - for any purpose. -- +-- -- +-- See also http://trilema.com/2015/a-new-software-licensing-paradigm . -- +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ + +-- Version for use with C run time +with System.Syscall; use System.Syscall; + +package body Ada.Text_IO is + -- STDIN : constant := 0; + STDOUT : constant := 1; + -- STDERR : constant := 2; + + -------------- + -- New_Line -- + -------------- + + procedure New_Line is + begin + Put (ASCII.LF); + end New_Line; + + --------- + -- Put -- + --------- + + procedure Put (Item : Character) is + begin + Put ("" & Item); + end Put; + + procedure Put (Item : String) is + Ignore : Int; + E : ErrorCode; + begin + Ignore := Write (STDOUT, Item, E); + pragma Unused (E); + end Put; + + -------------- + -- Put_Line -- + -------------- + + procedure Put_Line (Item : String) is + begin + Put (Item); + New_Line; + end Put_Line; + +end Ada.Text_IO; diff -uNr -uN a/zfp/platform/linux-x86_64-asm/last_chance_handler.adb b/zfp/platform/linux-x86_64-asm/last_chance_handler.adb --- a/zfp/platform/linux-x86_64-asm/last_chance_handler.adb false +++ b/zfp/platform/linux-x86_64-asm/last_chance_handler.adb ec06f5d03656946c1d7f682fa5192ef8bd3c8d460e5bd8b9f0dc1de36b6aa549f1b8fe1e0525d3a660c8a8ab1928aa05868359ec4b838d2d951c5ff672b2d93e @@ -0,0 +1,38 @@ +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- You do not have, nor can you ever acquire the right to use, copy or -- +-- distribute this software ; Should you use this software for any purpose, -- +-- or copy and distribute it to anyone or in any manner, you are breaking -- +-- the laws of whatever soi-disant jurisdiction, and you promise to -- +-- continue doing so for the indefinite future. In any case, please -- +-- always : read and understand any software ; verify any PGP signatures -- +-- that you use - for any purpose. -- +-- -- +-- See also http://trilema.com/2015/a-new-software-licensing-paradigm . -- +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ + +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; +with System.Storage_Elements; use System.Storage_Elements; +with System.Syscall; use System.Syscall; + +procedure Last_Chance_Handler (Msg : System.Address; Line : Integer) is + function Peek (Addr : System.Address) return Character is + C : Character with + Address => Addr; + begin + return C; + end Peek; + A : System.Address := Msg; +begin + Put ("GNAT Exception!:"); + Put (Line); + Put (":"); + while Peek (A) /= ASCII.NUL loop + Put (Peek (A)); + A := A + 1; + end loop; + New_Line; + Sys_Exit (1); +end Last_Chance_Handler; diff -uNr -uN a/zfp/platform/linux-x86_64-asm/s-syscal.adb b/zfp/platform/linux-x86_64-asm/s-syscal.adb --- a/zfp/platform/linux-x86_64-asm/s-syscal.adb false +++ b/zfp/platform/linux-x86_64-asm/s-syscal.adb 602e857b2c3724b907ca3d6f4b1587d375c7e35f90ac7a23253edaff29187862d6fc2b2c104da14706b16db2f984eb335b4389c40e87407068d853cdbc0e6210 @@ -0,0 +1,74 @@ +with System.Machine_Code; use System.Machine_Code; + +package body System.Syscall is + SYSCALL_WRITE : constant := 1; + SYSCALL_READ : constant := 0; + -- SYSCALL_EXIT : constant := 60; + + function Write (fd : in Int; S : in String; E : out ErrorCode) return Int is + type byte is mod 2**8; + B : array (S'Range) of byte; + R : Int := 0; + begin + for I in S'Range loop + B (I) := Character'Pos (S (I)); + end loop; + Asm + ("syscall", + Outputs => (Int'Asm_Output ("=a", R)), + Inputs => + (Int'Asm_Input ("a", SYSCALL_WRITE), + Int'Asm_Input ("D", fd), + System.Address'Asm_Input ("S", B'Address), + Int'Asm_Input ("d", B'Length)), + Volatile => True); + if R < 0 and R >= -(2**12) then + E := ErrorCode'Val (-R); + R := -1; + else + E := OK; + end if; + return R; + end Write; + + function Read (fd : in Int; s : out String; E : out ErrorCode) return Int is + type byte is mod 2**8; + B : array (S'Range) of byte; + R : Int := 0; + begin + Asm + ("syscall", + Outputs => (Int'Asm_Output ("=a", R)), + Inputs => + (Int'Asm_Input ("a", SYSCALL_READ), + Int'Asm_Input ("D", fd), + System.Address'Asm_Input ("S", B'Address), + Int'Asm_Input ("d", B'Length))); + for I in S'Range loop + S (I) := Character'Val (B (I)); + end loop; + if R < 0 and R >= -(2**12) then + E := ErrorCode'Val (-R); + R := -1; + else + E := OK; + end if; + return R; + end Read; + + procedure Sys_Exit (C : in Integer) is + begin + Asm + ("mov $60, %%rax" & + ASCII.LF & + ASCII.HT & -- EXIT + "mov %0, %%rdi" & + ASCII.LF & + ASCII.HT & -- CODE + "syscall", + Inputs => (Int'Asm_Input ("g", Int (C))), + Clobber => "rax, rdi", + Volatile => True); + raise Program_Error; + end Sys_Exit; +end System.Syscall; diff -uNr -uN a/zfp/platform/linux-x86_64-asm/s-syscal.ads b/zfp/platform/linux-x86_64-asm/s-syscal.ads --- a/zfp/platform/linux-x86_64-asm/s-syscal.ads false +++ b/zfp/platform/linux-x86_64-asm/s-syscal.ads e87d5d4ecc1a2a9bed07371e36f4ca73c34e5781cfa4e3c5d159027f7c9468acddfadf8e59e8357a24cf22b1e8ff1148c660c6a09aac40e43614c62137b822b8 @@ -0,0 +1,17 @@ +package System.Syscall is + -- All interaction with system calls use 4 64bit registers + -- These registers are interpreted as integers or pointers + type Int is range -2**63 .. (2**63 - 1); + -- The return code will be an integer + -- On error, an errocode is returned, values are between 0 and 4096 + type ErrorCode is range 0 .. 2**12; + + OK : constant ErrorCode := 0; + + function Write (fd : in Int; S : in String; E : out ErrorCode) return Int; + function Read (fd : in Int; S : out String; E : out ErrorCode) return Int; + + procedure Sys_Exit (C : in Integer) with + No_Return; + +end System.Syscall; diff -uNr -uN a/zfp/runtime-x86_64-asm.xml b/zfp/runtime-x86_64-asm.xml --- a/zfp/runtime-x86_64-asm.xml false +++ b/zfp/runtime-x86_64-asm.xml 88a32de9b9a0db4bc57e5039c996474ecc4206ed5654bd159401adacd63a381d9472516489dc399b6a0a166972b762b62cbf68ec81ba072b37af6c053cffcc63 @@ -0,0 +1,21 @@ + + + + + + package Linker is + for Required_Switches use Linker'Required_Switches & + ("${RUNTIME_DIR(ada)}/adalib/libgnat.a") & + ("-nostdlib", "-nodefaultlibs", "-lgcc"); + + for Required_Switches use Linker'Required_Switches & + ("${RUNTIME_DIR(ada)}/adalib/start.o"); + end Linker; + + package Binder is + for Required_Switches ("Ada") use Binder'Required_Switches ("Ada") & + ("-nostdlib") ; + end Binder; + + + diff -uNr -uN a/zfp/runtime-x86_64-c.xml b/zfp/runtime-x86_64-c.xml --- a/zfp/runtime-x86_64-c.xml false +++ b/zfp/runtime-x86_64-c.xml b4843f10b3fbf8a25b54b00a45600d9b83914dbf230484aa8b4348c484492445b3b94da58e629a368de8c057f28448ca7fb7d378b9ee0a122a506d00ed65fcd2 @@ -0,0 +1,13 @@ + + + + + + package Linker is + for Required_Switches use Linker'Required_Switches & + ("${RUNTIME_DIR(ada)}/adalib/libgnat.a") & + ("-lgcc"); + end Linker; + + + diff -uNr -uN a/zfp/runtime.xml b/zfp/runtime.xml --- a/zfp/runtime.xml f1f4017587e31f70c8936356b09fb73710ac7fca3a6fd7577ba480d7ae49ed786d17d622802b84de311fdbf32994be887c035b8bca292298be9ee958489b8c6f +++ b/zfp/runtime.xml false @@ -1,21 +0,0 @@ - - - - - - package Linker is - for Required_Switches use Linker'Required_Switches & - ("${RUNTIME_DIR(ada)}/adalib/libgnat.a") & - ("-nostdlib", "-nodefaultlibs", "-lgcc"); - - for Required_Switches use Linker'Required_Switches & - ("${RUNTIME_DIR(ada)}/adalib/start.o"); - end Linker; - - package Binder is - for Required_Switches ("Ada") use Binder'Required_Switches ("Ada") & - ("-nostdlib") ; - end Binder; - - -