diff -uNr a/ada_c.gpr b/ada_c.gpr --- a/ada_c.gpr false +++ b/ada_c.gpr 840b51d0af97c08a96a7aaf1588f646826ab3c1690f38c41f0f57fcd19402c4cf1f8f4649d78c36ba0288dd8d54ed751ead686e8b212c10378baa367356f7498 @@ -0,0 +1,38 @@ +project Ada_C is + + for Object_Dir use "obj"; + + for Languages use ("Ada", "C"); + for Source_Dirs use ("src"); + for Exec_Dir use "bin"; + for Main use ("array_main.adb"); + + package Compiler is + for Switches ("Ada") + use ("-O2", "-g", + "-fstack-check", "-fno-inline", + "-fdump-tree-original", + "-fdata-sections", "-ffunction-sections", + "-gnatec=" & Ada_C'Project_Dir & "restrict.adc"); + for Switches ("C") + use ("-O2", "-g", + "-fstack-check", "-fno-inline", + "-fdump-tree-original", + "-fdata-sections", "-ffunction-sections"); + end Compiler; + + package Binder is + for Switches ("Ada") + use ("-static","-r"); + end Binder; + + package Linker is + for Switches ("Ada") + use ("-Wl,--gc-sections", "-static"); + end Linker; + + package Clean is + for Artifacts_In_Object_Dir use ("*.003t.original"); + end clean; + +end Ada_C; diff -uNr a/bin/README b/bin/README --- a/bin/README false +++ b/bin/README 86525f2c7086039d79e5bf92869d02934a44716812433ca3a90e18a8d03745785c5ca54fe8c39e681b3b13c00c33a5128884a28c8cbaccbc65d0b401d901ec2e @@ -0,0 +1 @@ +Placeholder. diff -uNr a/obj/README b/obj/README --- a/obj/README false +++ b/obj/README 86525f2c7086039d79e5bf92869d02934a44716812433ca3a90e18a8d03745785c5ca54fe8c39e681b3b13c00c33a5128884a28c8cbaccbc65d0b401d901ec2e @@ -0,0 +1 @@ +Placeholder. diff -uNr a/restrict.adc b/restrict.adc --- a/restrict.adc false +++ b/restrict.adc 29bb0a871d564ba49171b6e3bc753c053ab1ff19818fa697751e12756b9dbfed46725a173b9e60dd2b205d48cba740a247743f87acf7463185473b660a678f22 @@ -0,0 +1,87 @@ +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- This file is part of 'Finite Field Arithmetic', aka 'FFA'. -- +-- -- +-- (C) 2017 Stanislav Datskovskiy ( www.loper-os.org ) -- +-- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html -- +-- -- +-- 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 . -- +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ + +pragma Restrictions(Immediate_Reclamation); +pragma Restrictions(Max_Asynchronous_Select_Nesting => 0); +pragma Restrictions(Max_Protected_Entries => 0); +pragma Restrictions(Max_Select_Alternatives => 0); +pragma Restrictions(Max_Task_Entries => 0); +pragma Restrictions(Max_Tasks => 0); +pragma Restrictions(No_Abort_Statements); +pragma Restrictions(No_Access_Parameter_Allocators); +pragma Restrictions(No_Allocators); +pragma Restrictions(No_Asynchronous_Control); +pragma Restrictions(No_Calendar); +pragma Restrictions(No_Coextensions); +pragma Restrictions(No_Default_Stream_Attributes); +pragma Restrictions(No_Delay); +pragma Restrictions(No_Dispatch); +pragma Restrictions(No_Dispatching_Calls); +pragma Restrictions(No_Dynamic_Attachment); +pragma Restrictions(No_Dynamic_Priorities); +pragma Restrictions(No_Entry_Calls_In_Elaboration_Code); +pragma Restrictions(No_Entry_Queue); +pragma Restrictions(No_Enumeration_Maps); +pragma Restrictions(No_Exception_Propagation); +pragma Restrictions(No_Exception_Registration); +pragma Restrictions(No_Finalization); +pragma Restrictions(No_Fixed_Io); +pragma Restrictions(No_Implementation_Aspect_Specifications); +pragma Restrictions(No_Implementation_Units); +pragma Restrictions(No_Implicit_Aliasing); +pragma Restrictions(No_Implicit_Conditionals); +pragma Restrictions(No_Implicit_Dynamic_Code); +pragma Restrictions(No_Implicit_Heap_Allocations); +pragma Restrictions(No_Implicit_Protected_Object_Allocations); +pragma Restrictions(No_Implicit_Task_Allocations); +pragma Restrictions(No_Initialize_Scalars); +pragma Restrictions(No_Local_Protected_Objects); +pragma Restrictions(No_Local_Timing_Events); +pragma Restrictions(No_Multiple_Elaboration); +pragma Restrictions(No_Nested_Finalization); +pragma Restrictions(No_Protected_Type_Allocators); +pragma Restrictions(No_Protected_Types); +pragma Restrictions(No_Relative_Delay); +pragma Restrictions(No_Requeue_Statements); +pragma Restrictions(No_Secondary_Stack); +pragma Restrictions(No_Select_Statements); +pragma Restrictions(No_Specific_Termination_Handlers); +pragma Restrictions(No_Standard_Allocators_After_Elaboration); +pragma Restrictions(No_Stream_Optimizations); +pragma Restrictions(No_Streams); +pragma Restrictions(No_Task_Allocators); +pragma Restrictions(No_Task_At_Interrupt_Priority); +pragma Restrictions(No_Task_Attributes_Package); +pragma Restrictions(No_Task_Hierarchy); +pragma Restrictions(No_Tasking); +pragma Restrictions(No_Task_Termination); +pragma Restrictions(No_Terminate_Alternatives); +pragma Restrictions(No_Unchecked_Access); +pragma Restrictions(No_Unchecked_Deallocation); +pragma Restrictions(No_Wide_Characters); +pragma Restrictions(Pure_Barriers); +pragma Restrictions(Simple_Barriers); +pragma Restrictions(Static_Priorities); +pragma Restrictions(Static_Storage_Size); +pragma Validity_Checks(ALL_CHECKS); +pragma Discard_Names; +pragma Restrictions (No_Enumeration_Maps); +--pragma Restrictions (No_Exceptions); +pragma Restrictions (No_Exception_Propagation); +--pragma Normalize_Scalars; diff -uNr a/src/array_main.adb b/src/array_main.adb --- a/src/array_main.adb false +++ b/src/array_main.adb beaa125032c5fb19a59526049be7b7f2172726e4c3880fbe391017c02d65c866f84d9b36798be5ff3ddface03f7289d2e2a37693e3caffd6e7a5aad402c0e256 @@ -0,0 +1,38 @@ +with C_Array; use C_Array; +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; + +with Interfaces.C; use Interfaces.C; + +procedure Array_Main is + work_array : char_array(0 .. 100); + output_string : String(1 .. 101) := (others => ' '); + C : Integer := 0; +begin + Put("start"); + New_Line; + C_fill_1(work_array,100); + To_Ada(work_array, output_string, C, False); + Put("c_fill_1 output ="); Put(output_string); + New_Line; + + C_fill_2(work_array,100); + To_Ada(work_array, output_string, C, False); + Put("c_fill_2 output ="); Put(output_string); + New_Line; + + C_fill_3(work_array,100); + To_Ada(work_array, output_string, C, False); + Put("c_fill_4 output ="); Put(output_string); + New_Line; + + C_fill_4(work_array); + To_Ada(work_array, output_string, C, False); + Put("c_fill_4 output ="); Put(output_string); + New_Line; + + C_fill_5(work_array,100); + To_Ada(work_array, output_string, C, False); + Put("c_fill_5 output ="); Put(output_string); + New_Line; +end; diff -uNr a/src/array_support.c b/src/array_support.c --- a/src/array_support.c false +++ b/src/array_support.c 00ea22931017f25d2636549b4e1b28c1327c237937f9667c14e756b3bc1e1e161428956ac11c3bfaefb4ac1fc6b01812b9f1577b5bee563225dc0ab11b6b2202 @@ -0,0 +1,62 @@ +#include +#include + +typedef struct B { + size_t LB0; + size_t UB0; +} B_t; + +typedef struct U { + char * P_ARRAY; + B_t * P_BOUNDS; +} U_t; + +void ada_fill_2(char * buffer); +void ada_fill_3(U_t array, int count); +void ada_fill_5(char * buffer, int count); + +void c_fill_1(char * buffer, int count) { + int i; + + printf("c_fill_1; buffer = %p, count = %d\n", buffer, count); + + for(i = 0; i < count; i++) { + buffer[i] = '1'; + } +} + + +void c_fill_2(char * buffer, int count) { + printf("c_fill_2; buffer = %p, count = %d\n", buffer, count); + ada_fill_2(buffer); +} + +void c_fill_3(char * buffer, int count) { + B_t b; + U_t a; + b.LB0 = 0; + b.UB0 = count; + a.P_ARRAY = buffer; + a.P_BOUNDS = &b; + + printf("c_fill_3; buffer = %p, count = %d\n", buffer, count); + + ada_fill_3(a, count); +} + +void c_fill_4(U_t array) { + int i = 0; + char * buffer = array.P_ARRAY; + + printf("c_fill_4; buffer = %p, count = %d\n", array.P_ARRAY, array.P_BOUNDS->UB0 - array.P_BOUNDS->LB0); + + for(i = array.P_BOUNDS->LB0; i <= array.P_BOUNDS->UB0; i++) { + buffer[i] = '4'; + } +} + +void c_fill_5(char * buffer, int count) { + printf("c_fill_5; buffer = %p, count = %d\n", buffer, count); + ada_fill_5(buffer, count); +} + diff -uNr a/src/c_array.adb b/src/c_array.adb --- a/src/c_array.adb false +++ b/src/c_array.adb b16d733d83d272d4f2dd97c7a4c2a381b8c978831d1a276d7000dd99285e570f1cb8ce680f1190ead901568ec7f9f69d84253a3a10c5c78da40c622002b709df @@ -0,0 +1,47 @@ +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; +with Ada.Long_Integer_Text_IO; use Ada.Long_Integer_Text_IO; + +package body C_Array is + + -- We have a statically defined length so the range will be fine. + -- The call in C code to this procedure must use a buffer with at least the constrained range. + procedure ADA_Fill_2(CH : in out constrained_char_array) is + begin + Put("ada_fill_2;"); + Put(" lb=" & size_t'Image(CH'First)); + Put(" ub=" & size_t'Image(CH'Last)); + New_line; + + for I in CH'Range loop + CH(I) := To_C('2'); + end loop; + end Ada_Fill_2; + + -- The call in the C code needs to send an Ada array. + procedure ADA_Fill_3(CH : in out char_array) is + begin + Put("ada_fill_3;"); + Put(" lb=" & size_t'Image(CH'First)); + Put(" ub=" & size_t'Image(CH'Last)); + New_line; + + for I in CH'Range loop + CH(I) := To_C('3'); + end loop; + end Ada_Fill_3; + + -- For calls from C without a constained type or ada array, an extra count parameter is needed. + procedure ADA_Fill_5(CH : in out char_array; Count: Integer) is + begin + Put("ada_fill_5; count="); Put(Count); + Put(" lb=" & size_t'Image(CH'First)); + Put(" ub=" & size_t'Image(CH'Last)); + New_line; + + -- the Range cannot be used, the 'Last index is wrong. + for I in ch'First .. size_t(Count) loop + CH(I) := To_C('5'); + end loop; + end Ada_Fill_5; +end C_Array; diff -uNr a/src/c_array.ads b/src/c_array.ads --- a/src/c_array.ads false +++ b/src/c_array.ads 37625f28b666a5dfa00f833f7cd3c2c9f2cb20e5e3f5249f3c36fc9cd236b7d5ca53cb3a1d03e843ce1ca2eef2f7e0b4e6c89094f863386637ab101a767dbad5 @@ -0,0 +1,30 @@ +with Interfaces.C; use Interfaces.C; + +package C_Array is + + procedure C_Fill_1(CH : in out char_array; Count : Integer); + pragma Import(C, C_Fill_1, "c_fill_1"); + + procedure C_Fill_2(CH : in out char_array; Count : Integer); + pragma Import(C, C_Fill_2, "c_fill_2"); + + procedure C_Fill_3(CH : in out char_array; Count : Integer); + pragma Import(C, C_Fill_3, "c_fill_3"); + + procedure C_Fill_4(CH : in out char_array); + pragma Import(Ada, C_Fill_4, "c_fill_4"); + + procedure C_Fill_5(CH : in out char_array; Count : Integer); + pragma Import(C, C_Fill_5, "c_fill_5"); + + subtype constrained_char_array is char_array(0 .. 100); + procedure ADA_Fill_2(CH : in out constrained_char_array); + pragma Export(C, ADA_Fill_2, "ada_fill_2"); + + procedure ADA_Fill_3(CH : in out char_array); + pragma Export(Ada, ADA_Fill_3, "ada_fill_3"); + + procedure ADA_Fill_5(CH : in out char_array; Count: Integer); + pragma Export(C, ADA_Fill_5, "ada_fill_5"); + +end C_Array;