├── tests ├── system │ ├── minimal │ │ ├── test.adb │ │ └── test.gpr │ ├── exception │ │ ├── test.adb │ │ └── test.gpr │ ├── stand-alone-library │ │ ├── test.c │ │ ├── sal │ │ │ ├── test_interface.adb │ │ │ ├── test_interface.ads │ │ │ └── sal.gpr │ │ └── test.gpr │ ├── tagged_type │ │ ├── parent.ads │ │ ├── child.ads │ │ ├── child.adb │ │ ├── parent.adb │ │ ├── test.gpr │ │ └── test.adb │ ├── arit64 │ │ ├── test.gpr │ │ └── test.adb │ └── secondary-stack │ │ ├── test.gpr │ │ └── test.adb ├── unit │ ├── rts_suite.ads │ ├── test.gpr │ ├── componolit-runtime-strings-tests.ads │ ├── componolit-runtime-conversions-tests.ads │ ├── test.adb │ ├── rts_suite.adb │ └── componolit-runtime-strings-tests.adb ├── esp8266.sh ├── arm.sh ├── platform │ ├── stm32f0 │ │ ├── main.adb │ │ ├── test.gpr │ │ ├── link.ld │ │ └── crt0.S │ └── nrf52 │ │ ├── main.adb │ │ ├── test.gpr │ │ ├── link.ld │ │ └── crt0.S └── genode.sh ├── src ├── lib │ ├── argv.c │ ├── exit.c │ ├── componolit.ads │ ├── componolit-runtime.ads │ ├── init.c │ ├── componolit-runtime-debug.ads │ ├── componolit-runtime-debug.adb │ ├── componolit-runtime-platform.adb │ ├── componolit-runtime-platform.ads │ ├── componolit-runtime-conversions.ads │ ├── componolit-runtime-strings.ads │ ├── componolit-runtime-exceptions.ads │ └── componolit-runtime-strings.adb ├── componolit_runtime.gpr ├── minimal │ ├── a-nbnbin.adb │ ├── a-nubinu.ads │ ├── s-exctab.ads │ ├── a-numeri.ads │ ├── s-parame.adb │ ├── i-c.adb │ ├── a-tags.adb │ ├── s-stalib.adb │ ├── s-exctab.adb │ ├── s-soflin.adb │ ├── s-soflin.ads │ ├── s-parame.ads │ ├── a-except.ads │ ├── s-secsta.adb │ ├── a-tags.ads │ ├── a-tags-gcc_10.ads │ ├── a-tags-gcc_11.ads │ ├── a-tags-gcc_12.ads │ ├── a-tags-gcc_8.ads │ ├── a-tags-gcc_9.ads │ ├── a-tags-gnat_llvm_10.ads │ ├── s-stalib.ads │ ├── i-c.ads │ ├── s-secsta.ads │ ├── s-arit64.ads │ └── a-nbnbin.ads └── common │ ├── s-init.adb │ └── s-init.ads ├── platform ├── nrf52 │ ├── drivers.gpr │ ├── componolit-runtime-board.ads │ ├── drivers │ │ ├── componolit-runtime-drivers.ads │ │ ├── componolit-runtime-drivers-power.adb │ │ ├── componolit-runtime-drivers-power.ads │ │ ├── componolit-runtime-drivers-gpio.adb │ │ └── componolit-runtime-drivers-gpio.ads │ ├── default │ │ └── componolit-runtime-board.adb │ ├── nrf52.gpr │ ├── sparkfun │ │ └── componolit-runtime-board.adb │ ├── bluefruit_feather │ │ └── componolit-runtime-board.adb │ └── componolit_runtime.adb ├── stm32f0 │ ├── drivers.gpr │ ├── drivers │ │ ├── componolit-runtime-drivers.ads │ │ ├── componolit-runtime-drivers-rcc.adb │ │ └── componolit-runtime-drivers-rcc.ads │ ├── stm32f0.gpr │ └── componolit_runtime.adb ├── gnat_helpers.h ├── componolit_runtime.h ├── gnat_helpers.ads ├── componolit_runtime-c.ads ├── componolit_runtime.ads ├── linux │ ├── posix_fat.c │ ├── posix_minimal.c │ └── posix_common.c ├── componolit_runtime-c.adb ├── esp8266 │ └── arduino_esp8266.c └── ada_exceptions.h ├── .gitignore ├── restrictions.adc ├── contrib ├── gcc-8.3.0 │ ├── ada.ads │ ├── a-unccon.ads │ └── s-maccod.ads └── gcc-9.3.1 │ ├── s-memset.ads │ ├── s-memcom.ads │ ├── s-memcop.ads │ ├── s-memmov.ads │ ├── s-memcop.adb │ ├── s-memcom.adb │ ├── s-memset.adb │ ├── s-memtyp.ads │ └── s-memmov.adb ├── README.md ├── doc ├── exceptions.md └── Platform-interface.md ├── tools └── generate_exceptions.py ├── LICENSE.RUNTIME ├── Makefile └── .github └── workflows └── ci.yml /tests/system/minimal/test.adb: -------------------------------------------------------------------------------- 1 | procedure Test is 2 | begin 3 | null; 4 | end Test; 5 | -------------------------------------------------------------------------------- /tests/system/exception/test.adb: -------------------------------------------------------------------------------- 1 | procedure Test is 2 | begin 3 | raise Constraint_Error; 4 | end Test; 5 | -------------------------------------------------------------------------------- /tests/system/stand-alone-library/test.c: -------------------------------------------------------------------------------- 1 | void test_main(); 2 | 3 | int main() { 4 | test_main(); 5 | return 0; 6 | } 7 | -------------------------------------------------------------------------------- /src/lib/argv.c: -------------------------------------------------------------------------------- 1 | int gnat_argc = 0; 2 | const char **gnat_argv = (const char **) 0; 3 | const char **gnat_envp = (const char **) 0; 4 | -------------------------------------------------------------------------------- /src/componolit_runtime.gpr: -------------------------------------------------------------------------------- 1 | project Componolit_Runtime is 2 | 3 | for Source_Dirs use ("lib", "minimal"); 4 | 5 | end Componolit_Runtime; 6 | -------------------------------------------------------------------------------- /tests/unit/rts_suite.ads: -------------------------------------------------------------------------------- 1 | 2 | with AUnit.Test_Suites; 3 | 4 | package Rts_Suite is 5 | 6 | function Suite return AUnit.Test_Suites.Access_Test_Suite; 7 | 8 | end Rts_Suite; 9 | -------------------------------------------------------------------------------- /tests/system/stand-alone-library/sal/test_interface.adb: -------------------------------------------------------------------------------- 1 | package body Test_Interface is 2 | 3 | procedure Test_Main is 4 | begin 5 | null; 6 | end Test_Main; 7 | 8 | end Test_Interface; 9 | -------------------------------------------------------------------------------- /platform/nrf52/drivers.gpr: -------------------------------------------------------------------------------- 1 | 2 | project Drivers is 3 | 4 | for Source_Dirs use ("drivers", "../../src/lib"); 5 | for Object_Dir use "../../build/nrf52/obj"; 6 | for Create_Missing_Dirs use "True"; 7 | 8 | end Drivers; 9 | -------------------------------------------------------------------------------- /tests/system/tagged_type/parent.ads: -------------------------------------------------------------------------------- 1 | 2 | package Parent is 3 | 4 | type Object is tagged record 5 | null; 6 | end record; 7 | 8 | function Is_Parent (O : Object) return Boolean; 9 | 10 | end Parent; 11 | -------------------------------------------------------------------------------- /platform/stm32f0/drivers.gpr: -------------------------------------------------------------------------------- 1 | 2 | project Drivers is 3 | 4 | for Source_Dirs use ("drivers", "../../src/lib"); 5 | for Object_Dir use "../../build/stm32f0/obj"; 6 | for Create_Missing_Dirs use "True"; 7 | 8 | end Drivers; 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.ali 2 | *.bexch 3 | *.o 4 | *.stderr 5 | *.stdout 6 | b__*.ad[bs] 7 | *.a 8 | *.d 9 | *.lexch 10 | *.deps 11 | obj/ 12 | tests/system 13 | tests/unit 14 | tests/exception 15 | tests/minimal 16 | tests/secondary-stack 17 | tests/stand-alone-library 18 | -------------------------------------------------------------------------------- /platform/stm32f0/drivers/componolit-runtime-drivers.ads: -------------------------------------------------------------------------------- 1 | 2 | with System.Storage_Elements; 3 | 4 | package Componolit.Runtime.Drivers with 5 | SPARK_Mode 6 | is 7 | 8 | package SSE renames System.Storage_Elements; 9 | 10 | end Componolit.Runtime.Drivers; 11 | -------------------------------------------------------------------------------- /tests/system/tagged_type/child.ads: -------------------------------------------------------------------------------- 1 | 2 | with Parent; 3 | 4 | package Child is 5 | 6 | type Object is new Parent.Object with record 7 | null; 8 | end record; 9 | 10 | overriding function Is_Parent (O : Object) return Boolean; 11 | 12 | end Child; 13 | -------------------------------------------------------------------------------- /platform/nrf52/componolit-runtime-board.ads: -------------------------------------------------------------------------------- 1 | 2 | package Componolit.Runtime.Board is 3 | 4 | procedure Initialize; 5 | 6 | procedure Log (S : String); 7 | 8 | procedure Halt_On_Error; 9 | 10 | procedure Poweroff; 11 | 12 | end Componolit.Runtime.Board; 13 | -------------------------------------------------------------------------------- /tests/unit/test.gpr: -------------------------------------------------------------------------------- 1 | with "aunit"; 2 | 3 | project test is 4 | 5 | for Source_Dirs use (".", "../../src/lib/"); 6 | for Main use ("test.adb"); 7 | 8 | package Binder is 9 | for Switches ("Ada") use ("-static"); 10 | end Binder; 11 | 12 | end test; 13 | -------------------------------------------------------------------------------- /tests/system/tagged_type/child.adb: -------------------------------------------------------------------------------- 1 | 2 | with Componolit.Runtime.Debug; 3 | 4 | package body Child is 5 | 6 | function Is_Parent (O : Object) return Boolean 7 | is 8 | pragma Unreferenced (O); 9 | begin 10 | return False; 11 | end Is_Parent; 12 | 13 | end Child; 14 | -------------------------------------------------------------------------------- /tests/esp8266.sh: -------------------------------------------------------------------------------- 1 | 2 | set -e 3 | 4 | apt update && apt install xz-utils 5 | wget -q https://github.com/jklmnn/gnat-llvm-xtensa/releases/download/20.2-20200228/gnat-llvm-xtensa.tar.xz 6 | tar xvf gnat-llvm-xtensa.tar.xz 7 | export PATH=/gnat-llvm-xtensa/bin:$PATH 8 | cd /app 9 | make esp8266 10 | -------------------------------------------------------------------------------- /tests/system/stand-alone-library/sal/test_interface.ads: -------------------------------------------------------------------------------- 1 | package Test_Interface is 2 | 3 | procedure Test_Main 4 | with Global => null, 5 | Export => True, 6 | Convention => C, 7 | External_Name => "test_main"; 8 | 9 | end Test_Interface; 10 | -------------------------------------------------------------------------------- /tests/system/tagged_type/parent.adb: -------------------------------------------------------------------------------- 1 | 2 | with Componolit.Runtime.Debug; 3 | 4 | package body Parent is 5 | 6 | function Is_Parent (O : Object) return Boolean 7 | is 8 | pragma Unreferenced (O); 9 | begin 10 | return True; 11 | end Is_Parent; 12 | 13 | end Parent; 14 | -------------------------------------------------------------------------------- /tests/system/stand-alone-library/sal/sal.gpr: -------------------------------------------------------------------------------- 1 | library project SAL is 2 | 3 | for Library_Dir use "lib"; 4 | for Library_Name use "test"; 5 | for Library_Kind use "static"; 6 | 7 | package Binder is 8 | for Switches ("Ada") use ("-static"); 9 | end Binder; 10 | 11 | end SAL; 12 | -------------------------------------------------------------------------------- /tests/system/arit64/test.gpr: -------------------------------------------------------------------------------- 1 | project Test is 2 | 3 | for Main use ("test.adb"); 4 | 5 | package Binder is 6 | for Switches ("Ada") use ("-static"); 7 | end Binder; 8 | 9 | package Linker is 10 | for Required_Switches use ("-lpthread"); 11 | end Linker; 12 | 13 | end Test; 14 | -------------------------------------------------------------------------------- /tests/system/minimal/test.gpr: -------------------------------------------------------------------------------- 1 | project Test is 2 | 3 | for Main use ("test.adb"); 4 | 5 | package Binder is 6 | for Switches ("Ada") use ("-static"); 7 | end Binder; 8 | 9 | package Linker is 10 | for Required_Switches use ("-lpthread"); 11 | end Linker; 12 | 13 | end Test; 14 | -------------------------------------------------------------------------------- /tests/system/exception/test.gpr: -------------------------------------------------------------------------------- 1 | project Test is 2 | 3 | for Main use ("test.adb"); 4 | 5 | package Binder is 6 | for Switches ("Ada") use ("-static"); 7 | end Binder; 8 | 9 | package Linker is 10 | for Required_Switches use ("-lpthread"); 11 | end Linker; 12 | 13 | end Test; 14 | -------------------------------------------------------------------------------- /tests/system/tagged_type/test.gpr: -------------------------------------------------------------------------------- 1 | 2 | project Test is 3 | 4 | for Main use ("test.adb"); 5 | 6 | package Binder is 7 | for Switches ("Ada") use ("-static"); 8 | end Binder; 9 | 10 | package Linker is 11 | for Required_Switches use ("-lpthread"); 12 | end Linker; 13 | 14 | end Test; 15 | -------------------------------------------------------------------------------- /tests/system/secondary-stack/test.gpr: -------------------------------------------------------------------------------- 1 | project Test is 2 | 3 | for Main use ("test.adb"); 4 | 5 | package Binder is 6 | for Switches ("Ada") use ("-static", "-D100k"); 7 | end Binder; 8 | 9 | package Linker is 10 | for Required_Switches use ("-lpthread"); 11 | end Linker; 12 | 13 | end Test; 14 | -------------------------------------------------------------------------------- /src/lib/exit.c: -------------------------------------------------------------------------------- 1 | /* this symbol is required/expected by the binder */ 2 | int gnat_exit_status = 0; 3 | 4 | /* this symbol is required/expected by the runtime */ 5 | int __ada_runtime_exit_status = 0; 6 | 7 | void __gnat_set_exit_status (int value) 8 | { 9 | gnat_exit_status = value; 10 | __ada_runtime_exit_status = value; 11 | }; 12 | -------------------------------------------------------------------------------- /tests/arm.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | make stm32f0 5 | gprbuild -P tests/platform/stm32f0/test.gpr 6 | gprclean -P tests/platform/stm32f0/test.gpr 7 | make clean 8 | for board in default bluefruit_feather sparkfun 9 | do 10 | make nrf52 BOARD=$board 11 | gprbuild -P tests/platform/nrf52/test.gpr 12 | gprclean -P tests/platform/nrf52/test.gpr 13 | make clean 14 | done 15 | -------------------------------------------------------------------------------- /tests/unit/componolit-runtime-strings-tests.ads: -------------------------------------------------------------------------------- 1 | with Aunit; 2 | with Aunit.Test_Cases; 3 | 4 | package Componolit.Runtime.Strings.Tests is 5 | 6 | type Test_Case is new Aunit.Test_Cases.Test_Case with null record; 7 | 8 | procedure Register_Tests (T : in out Test_Case); 9 | 10 | function Name (T : Test_Case) return Aunit.Message_String; 11 | 12 | end Componolit.Runtime.Strings.Tests; 13 | -------------------------------------------------------------------------------- /tests/system/stand-alone-library/test.gpr: -------------------------------------------------------------------------------- 1 | with "sal/sal.gpr"; 2 | 3 | project Test is 4 | 5 | for Main use ("test.c"); 6 | for Languages use ("C"); 7 | 8 | package Binder is 9 | for Switches ("C") use ("-static"); 10 | end Binder; 11 | 12 | package Linker is 13 | for Required_Switches use ("-L../../../obj/adalib", "-lgnat", "-lpthread"); 14 | end Linker; 15 | 16 | end Test; 17 | -------------------------------------------------------------------------------- /platform/nrf52/drivers/componolit-runtime-drivers.ads: -------------------------------------------------------------------------------- 1 | 2 | with System.Storage_Elements; 3 | 4 | package Componolit.Runtime.Drivers with 5 | SPARK_Mode 6 | is 7 | 8 | package SSE renames System.Storage_Elements; 9 | 10 | private 11 | 12 | APB_Base : constant SSE.Integer_Address := 16#4000_0000#; 13 | AHB_Base : constant SSE.Integer_Address := 16#5000_0000#; 14 | 15 | end Componolit.Runtime.Drivers; 16 | -------------------------------------------------------------------------------- /tests/unit/componolit-runtime-conversions-tests.ads: -------------------------------------------------------------------------------- 1 | 2 | with Aunit; 3 | with Aunit.Test_Cases; 4 | 5 | package Componolit.Runtime.Conversions.Tests is 6 | 7 | type Test_Case is new Aunit.Test_Cases.Test_Case with null record; 8 | 9 | procedure Register_Tests (T : in out Test_Case); 10 | 11 | function Name (T : Test_Case) return Aunit.Message_String; 12 | 13 | end Componolit.Runtime.Conversions.Tests; 14 | -------------------------------------------------------------------------------- /src/minimal/a-nbnbin.adb: -------------------------------------------------------------------------------- 1 | package body Ada.Numerics.Big_Numbers.Big_Integers 2 | is 3 | -- We enforce a body in the spec, as the orignial version in the runtime 4 | -- has one. If the contrib directory is in our search path, we get an error 5 | -- that the body contained therein must not exist. With this dummy body, 6 | -- earlier in the search path, this problem is solved. 7 | end Ada.Numerics.Big_Numbers.Big_Integers; 8 | -------------------------------------------------------------------------------- /platform/gnat_helpers.h: -------------------------------------------------------------------------------- 1 | 2 | #ifndef _GNAT_HELPERS_H_ 3 | #define _GNAT_HELPERS_H_ 4 | 5 | typedef enum 6 | { 7 | _US_VIRTUAL_UNWIND_FRAME = 0 8 | } _Unwind_State; 9 | 10 | typedef enum 11 | { 12 | _URC_FOREIGN_EXCEPTION_CAUGHT = 1, 13 | _URC_CONTINUE_UNWIND = 8, 14 | _URC_FAILURE = 9 15 | } _Unwind_Reason_Code; 16 | 17 | typedef unsigned _Unwind_Exception_Class __attribute__((__mode__(__DI__))); 18 | 19 | 20 | #endif /* ifndef _GNAT_HELPERS_H_ */ 21 | -------------------------------------------------------------------------------- /tests/platform/stm32f0/main.adb: -------------------------------------------------------------------------------- 1 | with Componolit.Runtime.Drivers.GPIO; 2 | 3 | procedure Main with 4 | SPARK_Mode 5 | is 6 | package GPIO renames Componolit.Runtime.Drivers.GPIO; 7 | use type GPIO.Mode; 8 | begin 9 | GPIO.Initialize; 10 | GPIO.Configure (GPIO.PC8, GPIO.Port_Out); 11 | GPIO.Configure (GPIO.PC9, GPIO.Port_Out); 12 | pragma Assert (GPIO.Pin_Mode (GPIO.PC8) = GPIO.Port_Out); 13 | pragma Assert (GPIO.Pin_Mode (GPIO.PC9) = GPIO.Port_Out); 14 | end Main; 15 | -------------------------------------------------------------------------------- /tests/platform/nrf52/main.adb: -------------------------------------------------------------------------------- 1 | with Componolit.Runtime.Drivers.GPIO; 2 | 3 | procedure Main with 4 | SPARK_Mode 5 | is 6 | package GPIO renames Componolit.Runtime.Drivers.GPIO; 7 | use type GPIO.Mode; 8 | begin 9 | GPIO.Configure (15, GPIO.Port_In); 10 | pragma Assert (GPIO.Pin_Mode (15) = GPIO.Port_In); 11 | GPIO.Configure (16, GPIO.Port_In); 12 | pragma Assert (GPIO.Pin_Mode (15) = GPIO.Port_In); 13 | pragma Assert (GPIO.Pin_Mode (16) = GPIO.Port_In); 14 | end Main; 15 | -------------------------------------------------------------------------------- /platform/nrf52/default/componolit-runtime-board.adb: -------------------------------------------------------------------------------- 1 | 2 | with Componolit.Runtime.Drivers.Power; 3 | 4 | package body Componolit.Runtime.Board is 5 | 6 | procedure Initialize is null; 7 | 8 | procedure Log (S : String) is null; 9 | 10 | procedure Halt_On_Error 11 | is 12 | begin 13 | Drivers.Power.Off; 14 | end Halt_On_Error; 15 | 16 | procedure Poweroff 17 | is 18 | begin 19 | Drivers.Power.Off; 20 | end Poweroff; 21 | 22 | end Componolit.Runtime.Board; 23 | -------------------------------------------------------------------------------- /restrictions.adc: -------------------------------------------------------------------------------- 1 | pragma Restrictions (No_Allocators); 2 | pragma Restrictions (No_Calendar); 3 | pragma Restrictions (No_Enumeration_Maps); 4 | pragma Restrictions (No_Exception_Handlers); 5 | pragma Restrictions (No_Implicit_Dynamic_Code); 6 | pragma Restrictions (No_Initialize_Scalars); 7 | pragma Restrictions (No_IO); 8 | pragma Restrictions (No_Streams); 9 | pragma Restrictions (No_Tasking); 10 | pragma Restrictions (No_Unchecked_Access); 11 | pragma Restrictions (Static_Storage_Size); 12 | pragma SPARK_Mode (On); 13 | -------------------------------------------------------------------------------- /platform/componolit_runtime.h: -------------------------------------------------------------------------------- 1 | 2 | #ifndef _COMPONOLIT_RUNTIME_H_ 3 | #define _COMPONOLIT_RUNTIME_H_ 4 | 5 | #include 6 | 7 | #ifdef __cplusplus 8 | extern "C" { 9 | #endif 10 | 11 | void componolit_runtime_log(const char *); 12 | 13 | void componolit_runtime_raise_ada_exception(exception_t, char *, char *); 14 | 15 | void componolit_runtime_initialize(void); 16 | 17 | void componolit_runtime_finalize(void); 18 | 19 | #ifdef __cplusplus 20 | } 21 | #endif 22 | 23 | #endif /* ifndef _COMPONOLIT_RUNTIME_H_ */ 24 | -------------------------------------------------------------------------------- /src/lib/componolit.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2019 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | package Componolit with 11 | SPARK_Mode 12 | is 13 | pragma Pure; 14 | pragma Preelaborate; 15 | end Componolit; 16 | -------------------------------------------------------------------------------- /platform/gnat_helpers.ads: -------------------------------------------------------------------------------- 1 | 2 | package Gnat_Helpers 3 | is 4 | 5 | -- _Unwind_Reason_Code 6 | type URC is (Foreign_Exception_Caught, 7 | Continue_Unwind, 8 | Failure); 9 | 10 | for URC use (Foreign_Exception_Caught => 1, 11 | Continue_Unwind => 8, 12 | Failure => 9); 13 | 14 | -- _Unwind_State 15 | type US is (Virtual_Unwind_Frame); 16 | for US use (Virtual_Unwind_Frame => 0); 17 | 18 | -- _Unwind_Exception_Class 19 | type UEC is mod 2 ** 64; 20 | 21 | end Gnat_Helpers; 22 | -------------------------------------------------------------------------------- /tests/unit/test.adb: -------------------------------------------------------------------------------- 1 | with Ada.Command_Line; 2 | with Aunit; 3 | with Aunit.Reporter.Text; 4 | with Aunit.Run; 5 | use all type Aunit.Status; 6 | 7 | with Rts_Suite; 8 | 9 | procedure Test 10 | is 11 | function Run is new Aunit.Run.Test_Runner_With_Status (Rts_Suite.Suite); 12 | Reporter : AUnit.Reporter.Text.Text_Reporter; 13 | S : Aunit.Status := Run (Reporter); 14 | begin 15 | if S = Aunit.Success then 16 | Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Success); 17 | else 18 | Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure); 19 | end if; 20 | end Test; 21 | -------------------------------------------------------------------------------- /platform/nrf52/drivers/componolit-runtime-drivers-power.adb: -------------------------------------------------------------------------------- 1 | 2 | package body Componolit.Runtime.Drivers.Power with 3 | SPARK_Mode, 4 | Refined_State => (Power_State => Reg) 5 | is 6 | 7 | use type SSE.Integer_Address; 8 | 9 | Reg : Systemoff_Register with 10 | Import, 11 | Address => SSE.To_Address (APB_Base + Systemoff_Reg), 12 | Volatile, 13 | Async_Readers, 14 | Effective_Writes; 15 | 16 | procedure Off 17 | is 18 | begin 19 | Reg := (S => Systemoff'(1), 20 | P => 0); 21 | end Off; 22 | 23 | end Componolit.Runtime.Drivers.Power; 24 | -------------------------------------------------------------------------------- /src/lib/componolit-runtime.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2019 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | package Componolit.Runtime with 11 | SPARK_Mode 12 | is 13 | pragma Pure; 14 | pragma Preelaborate; 15 | end Componolit.Runtime; 16 | -------------------------------------------------------------------------------- /platform/nrf52/nrf52.gpr: -------------------------------------------------------------------------------- 1 | 2 | project nRF52 is 3 | 4 | package Device_Configuration is 5 | for CPU_Name use "cortex-m4f"; 6 | for Number_Of_Interrupts use "37"; 7 | for Memories use ("flash", "sram"); 8 | for Boot_Memory use "flash"; 9 | 10 | for Mem_Kind ("flash") use "ROM"; 11 | for Address ("flash") use "16#0000_0000#"; 12 | for Size ("flash") use "16#0008_0000#"; 13 | 14 | for Mem_Kind ("sram") use "RAM"; 15 | for Address ("sram") use "16#2000_0000#"; 16 | for Size ("sram") use "16#0001_0000#"; 17 | 18 | end Device_Configuration; 19 | 20 | end nRF52; 21 | -------------------------------------------------------------------------------- /platform/stm32f0/stm32f0.gpr: -------------------------------------------------------------------------------- 1 | 2 | project STM32F0 is 3 | 4 | package Device_Configuration is 5 | for CPU_Name use "cortex-m0"; 6 | for Number_Of_Interrupts use "32"; 7 | for Memories use ("flash", "sram"); 8 | for Boot_Memory use "flash"; 9 | 10 | for Mem_Kind ("flash") use "ROM"; 11 | for Address ("flash") use "16#0800_0000#"; 12 | for Size ("flash") use "16#0001_0000#"; 13 | 14 | for Mem_Kind ("sram") use "RAM"; 15 | for Address ("sram") use "16#2000_0000#"; 16 | for Size ("sram") use "16#0000_2000#"; 17 | 18 | end Device_Configuration; 19 | 20 | end STM32F0; 21 | -------------------------------------------------------------------------------- /tests/system/arit64/test.adb: -------------------------------------------------------------------------------- 1 | 2 | procedure Test is 3 | procedure Init (V1 : Long_Integer; 4 | V2 : out Long_Integer) 5 | is 6 | begin 7 | V2 := V1; 8 | end Init; 9 | U1 : Long_Integer; 10 | U2 : Long_Integer; 11 | L1 : Long_Integer; 12 | I1 : Long_Integer; 13 | begin 14 | -- Init via procedure to keep compiler from optimizing 15 | Init (42, U1); 16 | Init (24, U2); 17 | -- Test Add_With_Ovflo_Check 18 | L1 := U1 + U2; 19 | -- Test Multiply_With_Ovflo_Check 20 | I1 := L1 * U2; 21 | -- Test Subtract_With_Ovflo_Check 22 | U1 := U1 - U2; 23 | U2 := U2 / U1; 24 | end Test; 25 | -------------------------------------------------------------------------------- /src/minimal/a-nubinu.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2020 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | package Ada.Numerics.Big_Numbers with 11 | Pure 12 | is 13 | 14 | subtype Field is Integer range 0 .. 255; 15 | subtype Number_Base is Integer range 2 .. 16; 16 | 17 | end Ada.Numerics.Big_Numbers; 18 | -------------------------------------------------------------------------------- /tests/system/tagged_type/test.adb: -------------------------------------------------------------------------------- 1 | 2 | with Parent; 3 | with Child; 4 | 5 | procedure Test 6 | is 7 | function Is_Parent (O : Parent.Object'Class) return Boolean 8 | is 9 | begin 10 | return O.Is_Parent; 11 | end Is_Parent; 12 | O_P : Parent.Object; 13 | O_C : Child.Object; 14 | begin 15 | if 16 | not O_P.Is_Parent 17 | or else O_C.Is_Parent 18 | or else not Is_Parent (O_P) 19 | or else Is_Parent (O_C) 20 | or else O_P not in Parent.Object'Class 21 | or else O_C not in Parent.Object'Class 22 | or else O_C not in Child.Object'Class 23 | then 24 | raise Program_Error; 25 | end if; 26 | end Test; 27 | -------------------------------------------------------------------------------- /platform/componolit_runtime-c.ads: -------------------------------------------------------------------------------- 1 | 2 | with System; 3 | with Componolit.Runtime.Exceptions; 4 | 5 | package Componolit_Runtime.C 6 | is 7 | package CRE renames Componolit.Runtime.Exceptions; 8 | 9 | procedure C_Log (S : System.Address) with 10 | Export, 11 | Convention => C, 12 | External_Name => "componolit_runtime_log"; 13 | 14 | procedure C_Raise_Exception (E : CRE.Exception_Type; 15 | N : System.Address; 16 | M : System.Address) with 17 | Export, 18 | Convention => C, 19 | External_Name => "componolit_runtime_raise_ada_exception"; 20 | 21 | end Componolit_Runtime.C; 22 | -------------------------------------------------------------------------------- /platform/componolit_runtime.ads: -------------------------------------------------------------------------------- 1 | 2 | with Componolit.Runtime.Exceptions; 3 | 4 | package Componolit_Runtime 5 | is 6 | package CRE renames Componolit.Runtime.Exceptions; 7 | 8 | procedure Log (S : String); 9 | 10 | procedure Raise_Ada_Exception (E : CRE.Exception_Type; 11 | N : String; 12 | M : String); 13 | 14 | procedure Initialize with 15 | Export, 16 | Convention => C, 17 | External_Name => "componolit_runtime_initialize"; 18 | 19 | procedure Finalize with 20 | Export, 21 | Convention => C, 22 | External_Name => "componolit_runtime_finalize"; 23 | 24 | end Componolit_Runtime; 25 | -------------------------------------------------------------------------------- /tests/unit/rts_suite.adb: -------------------------------------------------------------------------------- 1 | with Componolit.Runtime.Strings.Tests; 2 | with Componolit.Runtime.Conversions.Tests; 3 | 4 | package body Rts_Suite is 5 | use Aunit.Test_Suites; 6 | 7 | Result : aliased Test_Suite; 8 | 9 | Strings_Case : aliased Componolit.Runtime.Strings.Tests.Test_Case; 10 | Conversions_Case : aliased Componolit.Runtime.Conversions.Tests.Test_Case; 11 | 12 | ----------- 13 | -- Suite -- 14 | ----------- 15 | 16 | function Suite return AUnit.Test_Suites.Access_Test_Suite is 17 | begin 18 | Result.Add_Test (Strings_Case'Access); 19 | Result.Add_Test (Conversions_Case'Access); 20 | return Result'Access; 21 | end Suite; 22 | 23 | end Rts_Suite; 24 | -------------------------------------------------------------------------------- /platform/stm32f0/drivers/componolit-runtime-drivers-rcc.adb: -------------------------------------------------------------------------------- 1 | 2 | package body Componolit.Runtime.Drivers.RCC with 3 | SPARK_Mode, 4 | Refined_State => (RCC_State => Reg) 5 | is 6 | 7 | use type SSE.Integer_Address; 8 | 9 | Reg : Register with 10 | Address => SSE.To_Address (RCC_Base + AHB_EN_Offset), 11 | Import; 12 | 13 | procedure Set (Clk : Clock; 14 | Enable : Boolean) 15 | is 16 | begin 17 | Reg (Clock_Bit (Clk)) := (if Enable then 1 else 0); 18 | end Set; 19 | 20 | function Enabled (Clk : Clock) return Boolean 21 | is 22 | begin 23 | return Reg (Clock_Bit (Clk)) = 1; 24 | end Enabled; 25 | 26 | end Componolit.Runtime.Drivers.RCC; 27 | -------------------------------------------------------------------------------- /platform/nrf52/sparkfun/componolit-runtime-board.adb: -------------------------------------------------------------------------------- 1 | 2 | with Componolit.Runtime.Drivers.GPIO; 3 | with Componolit.Runtime.Drivers.Power; 4 | 5 | package body Componolit.Runtime.Board is 6 | 7 | LED : constant Drivers.GPIO.Pin := 7; 8 | 9 | procedure Initialize is 10 | begin 11 | Drivers.GPIO.Configure (LED, Drivers.GPIO.Port_Out); 12 | Drivers.GPIO.Write (LED, Drivers.GPIO.Low); 13 | end Initialize; 14 | 15 | procedure Log (S : String) is null; 16 | 17 | procedure Halt_On_Error 18 | is 19 | begin 20 | Drivers.Power.Off; 21 | end Halt_On_Error; 22 | 23 | procedure Poweroff 24 | is 25 | begin 26 | Drivers.Power.Off; 27 | end Poweroff; 28 | 29 | end Componolit.Runtime.Board; 30 | -------------------------------------------------------------------------------- /src/minimal/s-exctab.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | with System.Standard_Library; 11 | 12 | package System.Exception_Table with 13 | SPARK_Mode => Off 14 | is 15 | 16 | package SSL renames System.Standard_Library; 17 | 18 | procedure Register_Exception (X : SSL.Exception_Data_Ptr); 19 | 20 | end System.Exception_Table; 21 | -------------------------------------------------------------------------------- /src/minimal/a-numeri.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2020 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | package Ada.Numerics with 11 | Pure 12 | is 13 | 14 | Pi : constant := 15 | 3.14159_26535_89793_23846_26433_83279_50288_41971_69399_37511; 16 | 17 | e : constant := 18 | 2.71828_18284_59045_23536_02874_71352_66249_77572_47093_69996; 19 | 20 | end Ada.Numerics; 21 | -------------------------------------------------------------------------------- /platform/linux/posix_fat.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (C) 2018 Componolit GmbH 3 | * 4 | * This file is part of the Componolit Ada runtime, which is distributed 5 | * under the terms of the GNU Affero General Public License version 3. 6 | * 7 | * As a special exception under Section 7 of GPL version 3, you are granted 8 | * additional permissions described in the GCC Runtime Library Exception, 9 | * version 3.1, as published by the Free Software Foundation. 10 | */ 11 | 12 | #include 13 | #include 14 | 15 | void _gnat_builtin_longjmp(jmp_buf *env, int val) { 16 | longjmp(*env, val); 17 | } 18 | 19 | void __gnat_timeval_to_duration (struct timeval *tv, time_t *sec, suseconds_t *usec) 20 | { 21 | *sec = tv->tv_sec; 22 | *usec = tv->tv_usec; 23 | } 24 | -------------------------------------------------------------------------------- /tests/system/secondary-stack/test.adb: -------------------------------------------------------------------------------- 1 | procedure Test is 2 | 3 | S99 : String (1 .. 99 * 1024) := (others => Character'First); 4 | S49 : String (1 .. 49 * 1024) := (others => Character'First); 5 | S01 : String (1 .. 1024) := (others => Character'First); 6 | 7 | function Str (I : String) return String is 8 | begin 9 | return I; 10 | end Str; 11 | 12 | S : String := Str ("Test"); 13 | 14 | begin 15 | declare 16 | S : String := Str (S99); 17 | begin 18 | null; 19 | end; 20 | declare 21 | S1 : String := Str (S49); 22 | S2 : String := Str (S49); 23 | S3 : String := Str (S01); 24 | begin 25 | null; 26 | end; 27 | declare 28 | S : String := Str (S01); 29 | begin 30 | null; 31 | end; 32 | end Test; 33 | -------------------------------------------------------------------------------- /src/lib/init.c: -------------------------------------------------------------------------------- 1 | int __gl_main_priority = -1; 2 | int __gl_main_cpu = -1; 3 | int __gl_time_slice_val = -1; 4 | char __gl_wc_encoding = 'n'; 5 | char __gl_locking_policy = ' '; 6 | char __gl_queuing_policy = ' '; 7 | char __gl_task_dispatching_policy = ' '; 8 | char *__gl_priority_specific_dispatching = 0; 9 | int __gl_num_specific_dispatching = 0; 10 | char *__gl_interrupt_states = 0; 11 | int __gl_num_interrupt_states = 0; 12 | int __gl_unreserve_all_interrupts = 0; 13 | int __gl_detect_blocking = 0; 14 | int __gl_default_stack_size = -1; 15 | int __gl_leap_seconds_support = 0; 16 | int __gl_exception_tracebacks = 0; 17 | -------------------------------------------------------------------------------- /src/minimal/s-parame.adb: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | package body System.Parameters 11 | is 12 | -- We enforce a body in the spec, as the orignial version in the runtime 13 | -- has one. If the contrib directory is in our search path, we get an error 14 | -- that the body contained therein must not exist. With this dummy body, 15 | -- earlier in the search path, this problem is solved. 16 | end System.Parameters; 17 | -------------------------------------------------------------------------------- /src/minimal/i-c.adb: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2019 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | package body Interfaces.C with 11 | SPARK_Mode 12 | is 13 | -- We enforce a body in the spec, as the orignial version in the runtime 14 | -- has one. If the contrib directory is in our search path, we get an error 15 | -- that the body contained therein must not exist. With this dummy body, 16 | -- earlier in the search path, this problem is solved. 17 | end Interfaces.C; 18 | -------------------------------------------------------------------------------- /src/minimal/a-tags.adb: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2019 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | -- with Componolit.Runtime.Debug; 11 | 12 | package body Ada.Tags 13 | is 14 | -- We enforce a body in the spec, as the orignial version in the runtime 15 | -- has one. If the contrib directory is in our search path, we get an error 16 | -- that the body contained therein must not exist. With this dummy body, 17 | -- earlier in the search path, this problem is solved. 18 | end Ada.Tags; 19 | -------------------------------------------------------------------------------- /platform/componolit_runtime-c.adb: -------------------------------------------------------------------------------- 1 | 2 | with Componolit.Runtime.Strings; 3 | 4 | package body Componolit_Runtime.C 5 | is 6 | 7 | procedure C_Log (S : System.Address) 8 | is 9 | begin 10 | Log (Componolit.Runtime.Strings.Convert_To_Ada 11 | (S, "Invalid string.")); 12 | end C_Log; 13 | 14 | procedure C_Raise_Exception (E : CRE.Exception_Type; 15 | N : System.Address; 16 | M : System.Address) 17 | is 18 | begin 19 | Raise_Ada_Exception (E, 20 | Componolit.Runtime.Strings.Convert_To_Ada 21 | (N, "Unknown exception"), 22 | Componolit.Runtime.Strings.Convert_To_Ada 23 | (M, "Invalid message")); 24 | end C_Raise_Exception; 25 | 26 | end Componolit_Runtime.C; 27 | -------------------------------------------------------------------------------- /src/minimal/s-stalib.adb: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2019 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | package body System.Standard_Library with 11 | SPARK_Mode => Off 12 | is 13 | -- We enforce a body in the spec, as the orignial version in the runtime 14 | -- has one. If the contrib directory is in our search path, we get an error 15 | -- that the body contained therein must not exist. With this dummy body, 16 | -- earlier in the search path, this problem is solved. 17 | end System.Standard_Library; 18 | -------------------------------------------------------------------------------- /platform/nrf52/drivers/componolit-runtime-drivers-power.ads: -------------------------------------------------------------------------------- 1 | 2 | package Componolit.Runtime.Drivers.Power with 3 | SPARK_Mode, 4 | Abstract_State => (Power_State with External => (Async_Readers, 5 | Effective_Writes)) 6 | is 7 | 8 | procedure Off with 9 | Global => (Output => Power_State); 10 | 11 | private 12 | 13 | Systemoff_Reg : constant SSE.Integer_Address := 16#500#; 14 | type Systemoff is range 0 .. 1 with 15 | Size => 1, 16 | Object_Size => 8; 17 | 18 | type Padding is mod 2 ** 31 with 19 | Size => 31; 20 | 21 | type Systemoff_Register is record 22 | S : Systemoff; 23 | P : Padding; 24 | end record with 25 | Size => 32, 26 | Object_Size => 32; 27 | 28 | for Systemoff_Register use record 29 | S at 0 range 0 .. 0; 30 | P at 0 range 1 .. 31; 31 | end record; 32 | 33 | end Componolit.Runtime.Drivers.Power; 34 | -------------------------------------------------------------------------------- /src/minimal/s-exctab.adb: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | with Componolit.Runtime.Debug; 11 | 12 | package body System.Exception_Table with 13 | SPARK_Mode => Off 14 | -- Exception_Data_Ptr is an access type 15 | is 16 | 17 | use System.Standard_Library; 18 | 19 | procedure Register_Exception (X : Exception_Data_Ptr) is 20 | pragma Unreferenced (X); 21 | begin 22 | Componolit.Runtime.Debug.Log_Warning 23 | ("Register_Exception not implemented"); 24 | end Register_Exception; 25 | 26 | end System.Exception_Table; 27 | -------------------------------------------------------------------------------- /platform/linux/posix_minimal.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (C) 2018 Componolit GmbH 3 | * 4 | * This file is part of the Componolit Ada runtime, which is distributed 5 | * under the terms of the GNU Affero General Public License version 3. 6 | * 7 | * As a special exception under Section 7 of GPL version 3, you are granted 8 | * additional permissions described in the GCC Runtime Library Exception, 9 | * version 3.1, as published by the Free Software Foundation. 10 | */ 11 | 12 | #include 13 | #include 14 | #include 15 | #include 16 | 17 | _Unwind_Reason_Code __gnat_personality_v0(int version, 18 | unsigned long phases, 19 | _Unwind_Exception_Class class, 20 | void *exception, 21 | void *context) 22 | { 23 | fprintf(stderr, "%s not implemented\n", __func__); 24 | exit(1); 25 | } 26 | -------------------------------------------------------------------------------- /src/common/s-init.adb: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | package body System.Init is 11 | 12 | procedure Initialize (Addr : System.Address) is 13 | pragma Unreferenced (Addr); 14 | begin 15 | null; 16 | end Initialize; 17 | 18 | procedure Finalize is 19 | begin 20 | null; 21 | end Finalize; 22 | 23 | procedure Runtime_Initialize (Handler : Integer) is 24 | pragma Unreferenced (Handler); 25 | begin 26 | C_Runtime_Initialize; 27 | end Runtime_Initialize; 28 | 29 | procedure Runtime_Finalize is 30 | begin 31 | C_Runtime_Finalize; 32 | end Runtime_Finalize; 33 | 34 | end System.Init; 35 | -------------------------------------------------------------------------------- /src/lib/componolit-runtime-debug.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2019 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | with System; 11 | 12 | package Componolit.Runtime.Debug with 13 | SPARK_Mode 14 | is 15 | pragma Pure; 16 | pragma Preelaborate; 17 | 18 | procedure Log_Debug (Msg : String); 19 | procedure Log_Warning (Msg : String); 20 | procedure Log_Error (Msg : String); 21 | 22 | private 23 | 24 | generic 25 | Prefix : String; 26 | procedure Log (Msg : String); 27 | 28 | procedure C_Log (Str : System.Address) 29 | with 30 | Import, 31 | Convention => C, 32 | External_Name => "componolit_runtime_log"; 33 | 34 | end Componolit.Runtime.Debug; 35 | -------------------------------------------------------------------------------- /platform/esp8266/arduino_esp8266.c: -------------------------------------------------------------------------------- 1 | 2 | #include 3 | 4 | extern void exit(int); 5 | extern void Serial; 6 | extern unsigned strlen(const char *); 7 | extern unsigned _ZN14HardwareSerial5writeEPKhj(void *, const unsigned char *, unsigned); 8 | 9 | void __gnat_unhandled_terminate() 10 | { 11 | exit(0); 12 | } 13 | 14 | void componolit_runtime_raise_ada_exception(int exception, char *name, char *message) 15 | { 16 | exit(0); 17 | } 18 | 19 | void componolit_runtime_log(const char *message) { 20 | const unsigned char newline[] = "\r\n\0"; 21 | _ZN14HardwareSerial5writeEPKhj(&Serial, (const unsigned char *)message, strlen(message)); 22 | _ZN14HardwareSerial5writeEPKhj(&Serial, newline, sizeof(newline)); 23 | } 24 | 25 | _Unwind_Reason_Code __gnat_personality_v0(_Unwind_State state, 26 | void *header, 27 | void *context) 28 | { 29 | exit(0); 30 | } 31 | 32 | void componolit_runtime_initialize(void) 33 | { } 34 | 35 | void componolit_runtime_finalize(void) 36 | { } 37 | -------------------------------------------------------------------------------- /platform/stm32f0/drivers/componolit-runtime-drivers-rcc.ads: -------------------------------------------------------------------------------- 1 | 2 | package Componolit.Runtime.Drivers.RCC with 3 | SPARK_Mode, 4 | Abstract_State => RCC_State, 5 | Initializes => RCC_State 6 | is 7 | 8 | type Clock is (IOPA, IOPB, IOPC, IOPD, IOPF); 9 | 10 | procedure Set (Clk : Clock; 11 | Enable : Boolean) with 12 | Global => (In_Out => RCC_State); 13 | 14 | function Enabled (Clk : Clock) return Boolean with 15 | Global => (Input => RCC_State); 16 | 17 | private 18 | 19 | RCC_Base : constant SSE.Integer_Address := 16#4002_1000#; 20 | AHB_EN_Offset : constant SSE.Integer_Address := 16#14#; 21 | 22 | for Clock use (IOPA => 17, IOPB => 18, IOPC => 19, IOPD => 20, IOPF => 22); 23 | 24 | function Clock_Bit (C : Clock) return Natural is 25 | (case C is 26 | when IOPA => 17, 27 | when IOPB => 18, 28 | when IOPC => 19, 29 | when IOPD => 20, 30 | when IOPF => 22); 31 | 32 | type Bit is range 0 .. 1 with 33 | Size => 1; 34 | 35 | type Register is array (0 .. 31) of Bit with 36 | Size => 32, 37 | Pack; 38 | 39 | end Componolit.Runtime.Drivers.RCC; 40 | -------------------------------------------------------------------------------- /src/lib/componolit-runtime-debug.adb: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2019 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | package body Componolit.Runtime.Debug with 11 | SPARK_Mode 12 | is 13 | 14 | procedure Log (Msg : String) 15 | is 16 | pragma SPARK_Mode (Off); 17 | C_Msg : String := Prefix & Msg & Character'Val (0); 18 | begin 19 | C_Log (C_Msg'Address); 20 | end Log; 21 | 22 | procedure Log_Debug_Private is new Log (""); 23 | procedure Log_Debug (Msg : String) renames Log_Debug_Private; 24 | 25 | procedure Log_Warning_Private is new Log ("Warning: "); 26 | procedure Log_Warning (Msg : String) renames Log_Warning_Private; 27 | 28 | procedure Log_Error_Private is new Log ("Error: "); 29 | procedure Log_Error (Msg : String) renames Log_Error_Private; 30 | 31 | end Componolit.Runtime.Debug; 32 | -------------------------------------------------------------------------------- /platform/linux/posix_common.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (C) 2018 Componolit GmbH 3 | * 4 | * This file is part of the Componolit Ada runtime, which is distributed 5 | * under the terms of the GNU Affero General Public License version 3. 6 | * 7 | * As a special exception under Section 7 of GPL version 3, you are granted 8 | * additional permissions described in the GCC Runtime Library Exception, 9 | * version 3.1, as published by the Free Software Foundation. 10 | */ 11 | 12 | #include 13 | #include 14 | #include 15 | #include 16 | #include 17 | #include 18 | #include 19 | 20 | void __gnat_unhandled_terminate() { 21 | printf("error: unhandled exception\n"); 22 | exit(1); 23 | } 24 | 25 | void componolit_runtime_raise_ada_exception(exception_t exception, char *name, char *message) { 26 | printf("Exception raised (%d): %s: %s\n", (int)exception, name, message); 27 | exit(1); 28 | } 29 | 30 | void componolit_runtime_log(const char *message) { 31 | fprintf(stderr, "%s\n", message); 32 | } 33 | 34 | void componolit_runtime_initialize(void) 35 | { } 36 | 37 | void componolit_runtime_finalize(void) 38 | { } 39 | -------------------------------------------------------------------------------- /tests/platform/stm32f0/test.gpr: -------------------------------------------------------------------------------- 1 | 2 | project Test is 3 | 4 | for Source_Dirs use ("."); 5 | for Object_Dir use "obj"; 6 | for Create_Missing_Dirs use "True"; 7 | for Languages use ("Ada", "Asm_CPP"); 8 | for Target use "arm-eabi"; 9 | for Main use ("main.adb"); 10 | 11 | for Runtime ("Ada") use "../../../build/stm32f0/obj"; 12 | 13 | package Compiler is 14 | for Default_Switches ("Ada") use ("-gnatg", "-g", "-mthumb", "-ffunction-sections", "-fdata-sections"); 15 | for Default_Switches ("Asm_CPP") use ("-g", "-mthumb", "-ffunction-sections", "-fdata-sections"); 16 | end Compiler; 17 | 18 | package Linker is 19 | for Default_Switches ("Ada") use ("-Wl,--gc-sections", "-Wl,--print-memory-usage", "-T", "link.ld"); 20 | end Linker; 21 | 22 | package Binder is 23 | for Default_Switches ("Ada") use ("-D1k"); 24 | end Binder; 25 | 26 | package Ide is 27 | for Gnat use "arm-eabi-gnat"; 28 | for Gnatlist use "arm-eabi-gnatls"; 29 | for Debugger_Command use "arm-eabi-gdb"; 30 | for Program_Host use "localhost:4242"; 31 | for Communication_Protocol use "remote"; 32 | for Connection_Tool use "st-util"; 33 | end Ide; 34 | 35 | end Test; 36 | -------------------------------------------------------------------------------- /src/lib/componolit-runtime-platform.adb: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | with Componolit.Runtime.Debug; 11 | 12 | package body Componolit.Runtime.Platform 13 | with SPARK_Mode => Off 14 | is 15 | 16 | procedure Raise_Ada_Exception (T : Exceptions.Exception_Type; 17 | Name : String; 18 | Msg : String) 19 | is 20 | C_Name : String := Name & Character'Val (0); 21 | C_Msg : String := Msg & Character'Val (0); 22 | begin 23 | C_Raise_Exception (T, C_Name'Address, C_Msg'Address); 24 | end Raise_Ada_Exception; 25 | 26 | procedure Terminate_Message (Msg : String) 27 | is 28 | begin 29 | Componolit.Runtime.Debug.Log_Error (Msg); 30 | C_Unhandled_Terminate; 31 | end Terminate_Message; 32 | 33 | end Componolit.Runtime.Platform; 34 | -------------------------------------------------------------------------------- /tests/platform/nrf52/test.gpr: -------------------------------------------------------------------------------- 1 | 2 | project Test is 3 | 4 | for Source_Dirs use ("."); 5 | for Object_Dir use "obj"; 6 | for Create_Missing_Dirs use "True"; 7 | for Languages use ("Ada", "Asm_CPP"); 8 | for Target use "arm-eabi"; 9 | for Main use ("main.adb"); 10 | 11 | for Runtime ("Ada") use "../../../build/nrf52/obj"; 12 | 13 | package Compiler is 14 | for Default_Switches ("Ada") use ("-gnatg", "-g", "-mthumb", "-ffunction-sections", "-fdata-sections"); 15 | for Default_Switches ("Asm_CPP") use ("-g", "-mthumb", "-ffunction-sections", "-fdata-sections"); 16 | end Compiler; 17 | 18 | package Linker is 19 | for Default_Switches ("Ada") use ("-Wl,--gc-sections", "-Wl,--print-memory-usage", "-T", "link.ld"); 20 | end Linker; 21 | 22 | package Binder is 23 | for Default_Switches ("Ada") use ("-D1k"); 24 | end Binder; 25 | 26 | package Ide is 27 | for Gnat use "arm-eabi-gnat"; 28 | for Gnatlist use "arm-eabi-gnatls"; 29 | for Debugger_Command use "arm-eabi-gdb"; 30 | for Program_Host use ":3333"; 31 | for Communication_Protocol use "remote"; 32 | for Connection_Tool use ""; 33 | for Connection_Config_File use ""; 34 | end Ide; 35 | 36 | end Test; 37 | -------------------------------------------------------------------------------- /platform/nrf52/bluefruit_feather/componolit-runtime-board.adb: -------------------------------------------------------------------------------- 1 | 2 | with Componolit.Runtime.Drivers.Power; 3 | with Componolit.Runtime.Drivers.GPIO; 4 | 5 | package body Componolit.Runtime.Board is 6 | 7 | Red : constant Drivers.GPIO.Pin := 17; 8 | Blue : constant Drivers.GPIO.Pin := 19; 9 | 10 | procedure Initialize 11 | is 12 | begin 13 | Drivers.GPIO.Configure (Blue, Drivers.GPIO.Port_Out); 14 | Drivers.GPIO.Write (Blue, Drivers.GPIO.High); 15 | end Initialize; 16 | 17 | procedure Log (S : String) is null; 18 | 19 | procedure Halt_On_Error 20 | is 21 | procedure Wait; 22 | procedure Wait 23 | is 24 | begin 25 | for I in Integer range 0 .. 1000000 loop 26 | pragma Inspection_Point (I); 27 | end loop; 28 | end Wait; 29 | begin 30 | Drivers.GPIO.Configure (Red, Drivers.GPIO.Port_Out); 31 | loop 32 | Drivers.GPIO.Write (Red, Drivers.GPIO.High); 33 | Wait; 34 | Drivers.GPIO.Write (Red, Drivers.GPIO.Low); 35 | Wait; 36 | end loop; 37 | end Halt_On_Error; 38 | 39 | procedure Poweroff 40 | is 41 | begin 42 | Drivers.Power.Off; 43 | end Poweroff; 44 | 45 | end Componolit.Runtime.Board; 46 | -------------------------------------------------------------------------------- /contrib/gcc-8.3.0/ada.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT RUN-TIME COMPONENTS -- 4 | -- -- 5 | -- A D A -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- This specification is derived from the Ada Reference Manual for use with -- 10 | -- GNAT. In accordance with the copyright of that document, you can freely -- 11 | -- copy and modify this specification, provided that if you redistribute a -- 12 | -- modified version, any changes that you have made are clearly indicated. -- 13 | -- -- 14 | ------------------------------------------------------------------------------ 15 | 16 | package Ada is 17 | pragma No_Elaboration_Code_All; 18 | pragma Pure; 19 | 20 | end Ada; 21 | -------------------------------------------------------------------------------- /src/minimal/s-soflin.adb: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | with Componolit.Runtime.Debug; 11 | 12 | package body System.Soft_Links with 13 | SPARK_Mode => Off 14 | is 15 | 16 | function Get_Current_Excep_NT return EOA is 17 | begin 18 | Componolit.Runtime.Debug.Log_Warning 19 | ("Get_Current_Excep_NT not implemented"); 20 | return null; 21 | end Get_Current_Excep_NT; 22 | 23 | function Get_GNAT_Exception return Ada.Exceptions.Exception_Id is 24 | begin 25 | Componolit.Runtime.Debug.Log_Warning 26 | ("Set_Jmpbuf_Address_Soft not implemented"); 27 | return Ada.Exceptions.Null_Exception_Id; 28 | end Get_GNAT_Exception; 29 | 30 | function Get_Jmpbuf_Address_Soft return Address is 31 | begin 32 | return Address (0); 33 | end Get_Jmpbuf_Address_Soft; 34 | 35 | procedure Set_Jmpbuf_Address_Soft (Addr : Address) is 36 | pragma Unreferenced (Addr); 37 | begin 38 | null; 39 | end Set_Jmpbuf_Address_Soft; 40 | 41 | end System.Soft_Links; 42 | -------------------------------------------------------------------------------- /src/common/s-init.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | package System.Init is 11 | pragma Preelaborate; 12 | 13 | procedure Initialize (Addr : System.Address) with 14 | Export, 15 | Convention => C, 16 | External_Name => "__gnat_initialize"; 17 | 18 | procedure Finalize with 19 | Export, 20 | Convention => C, 21 | External_Name => "__gnat_finalize"; 22 | 23 | procedure Runtime_Initialize (Handler : Integer) with 24 | Export, 25 | Convention => C, 26 | External_Name => "__gnat_runtime_initialize"; 27 | 28 | procedure Runtime_Finalize with 29 | Export, 30 | Convention => C, 31 | External_Name => "__gnat_runtime_finalize"; 32 | 33 | private 34 | 35 | procedure C_Runtime_Initialize with 36 | Import, 37 | Convention => C, 38 | External_Name => "componolit_runtime_initialize"; 39 | 40 | procedure C_Runtime_Finalize with 41 | Import, 42 | Convention => C, 43 | External_Name => "componolit_runtime_finalize"; 44 | 45 | end System.Init; 46 | -------------------------------------------------------------------------------- /contrib/gcc-8.3.0/a-unccon.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT COMPILER COMPONENTS -- 4 | -- -- 5 | -- A D A . U N C H E C K E D _ C O N V E R S I O N -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- This specification is derived from the Ada Reference Manual for use with -- 10 | -- GNAT. In accordance with the copyright of that document, you can freely -- 11 | -- copy and modify this specification, provided that if you redistribute a -- 12 | -- modified version, any changes that you have made are clearly indicated. -- 13 | -- -- 14 | ------------------------------------------------------------------------------ 15 | 16 | generic 17 | type Source (<>) is limited private; 18 | type Target (<>) is limited private; 19 | 20 | function Ada.Unchecked_Conversion (S : Source) return Target; 21 | 22 | pragma No_Elaboration_Code_All (Ada.Unchecked_Conversion); 23 | pragma Pure (Ada.Unchecked_Conversion); 24 | pragma Import (Intrinsic, Ada.Unchecked_Conversion); 25 | -------------------------------------------------------------------------------- /src/lib/componolit-runtime-platform.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | with System; 11 | with Componolit.Runtime.Exceptions; 12 | 13 | package Componolit.Runtime.Platform with 14 | SPARK_Mode 15 | is 16 | pragma Pure; 17 | pragma Preelaborate; 18 | 19 | procedure Raise_Ada_Exception (T : Exceptions.Exception_Type; 20 | Name : String; 21 | Msg : String); 22 | 23 | procedure Terminate_Message (Msg : String); 24 | pragma No_Return (Terminate_Message); 25 | 26 | private 27 | 28 | procedure C_Raise_Exception (T : Exceptions.Exception_Type; 29 | Name : System.Address; 30 | Msg : System.Address) 31 | with 32 | Import, 33 | Convention => C, 34 | External_Name => "componolit_runtime_raise_ada_exception"; 35 | 36 | procedure C_Unhandled_Terminate with 37 | Import, 38 | Convention => C, 39 | External_Name => "__gnat_unhandled_terminate"; 40 | pragma No_Return (C_Unhandled_Terminate); 41 | 42 | end Componolit.Runtime.Platform; 43 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Generic Ada Runtime [![CI](https://github.com/Componolit/ada-runtime/workflows/CI/badge.svg)](https://github.com/Componolit/ada-runtime/actions) 2 | 3 | The generic Ada runtime is a downsized Ada runtime which can be adapted to different platforms. 4 | The offered feature set is a tradeoff between complexity and useful features. 5 | 6 | ## Features 7 | 8 | The runtime includes a variety of specs providing types and compiler intrinsics. 9 | It furthermore adds a small selection of more complex features: 10 | 11 | - Secondary stack 12 | - SPARK proof: 13 | no runtime errors, 14 | safe program abort in case of stack overflow, stack underflow or invalid stack count 15 | - 64bit arithmetic 16 | - SPARK proof: 17 | addition and subtraction with overflow check have no runtime errors, 18 | both functions perform a correct addition/subtraction 19 | - Exception support 20 | - Exceptions can only be thrown but not catched, there is only a last chance handler available 21 | 22 | ## Platforms 23 | 24 | - Posix/Linux 25 | - [Genode](https://genode.org/) 26 | - nRF52832 27 | - STM32F051 28 | - ESP8266 on Arduino 29 | 30 | ## Directory Structure 31 | 32 | - `contrib/`: external sources (GCC 8.3) 33 | - `platform/`: platform-specific sources of Ada runtime 34 | - `src/`: Ada runtime sources 35 | - `tests/`: test sources 36 | - `build`: platform specific build directories 37 | 38 | ## Platform-specific Symbols 39 | 40 | To enable a new platform for this runtime the platform needs to provide a set of linker symbols. 41 | Please have a look into the [platform interface](doc/Platform-interface.md) description. 42 | -------------------------------------------------------------------------------- /src/minimal/s-soflin.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | with Ada.Exceptions; 11 | 12 | package System.Soft_Links with 13 | SPARK_Mode => Off 14 | -- Use of unallowed access types 15 | -- pragma Favor_Top_Level is not yet supported 16 | is 17 | 18 | pragma Preelaborate; 19 | 20 | subtype EOA is Ada.Exceptions.Exception_Occurrence_Access; 21 | 22 | type Get_EOA_Call is access function return EOA; 23 | pragma Favor_Top_Level (Get_EOA_Call); 24 | 25 | function Get_Current_Excep_NT return EOA; 26 | 27 | Get_Current_Excep : Get_EOA_Call := Get_Current_Excep_NT'Access; 28 | 29 | function Get_GNAT_Exception return Ada.Exceptions.Exception_Id; 30 | 31 | function Get_Jmpbuf_Address_Soft return Address; 32 | procedure Set_Jmpbuf_Address_Soft (Addr : Address); 33 | pragma Inline (Get_Jmpbuf_Address_Soft); 34 | pragma Inline (Set_Jmpbuf_Address_Soft); 35 | 36 | type No_Param_Proc is access procedure; 37 | pragma Favor_Top_Level (No_Param_Proc); 38 | pragma Suppress_Initialization (No_Param_Proc); 39 | 40 | Finalize_Library_Objects : No_Param_Proc 41 | with Export, 42 | Convention => C, 43 | External_Name => "__gnat_finalize_library_objects"; 44 | 45 | end System.Soft_Links; 46 | -------------------------------------------------------------------------------- /doc/exceptions.md: -------------------------------------------------------------------------------- 1 | | Name | Value | 2 | | --- | --- | 3 | | `Undefined_Exception` | `0x0` | 4 | | `CE_Explicit_Raise` | `0x100` | 5 | | `CE_Access_Check` | `0x101` | 6 | | `CE_Null_Access_Parameter` | `0x102` | 7 | | `CE_Discriminant_Check` | `0x103` | 8 | | `CE_Divide_By_Zero` | `0x104` | 9 | | `CE_Index_Check` | `0x105` | 10 | | `CE_Invalid_Data` | `0x106` | 11 | | `CE_Length_Check` | `0x107` | 12 | | `CE_Null_Exception_Id` | `0x108` | 13 | | `CE_Null_Not_Allowed` | `0x109` | 14 | | `CE_Overflow_Check` | `0x10a` | 15 | | `CE_Partition_Check` | `0x10b` | 16 | | `CE_Range_Check` | `0x10c` | 17 | | `CE_Tag_Check` | `0x10d` | 18 | | `PE_Explicit_Raise` | `0x200` | 19 | | `PE_Access_Before_Elaboration` | `0x201` | 20 | | `PE_Accessibility_Check` | `0x202` | 21 | | `PE_Address_Of_Intrinsic` | `0x203` | 22 | | `PE_Aliased_Parameters` | `0x204` | 23 | | `PE_All_Guards_Closed` | `0x205` | 24 | | `PE_Bad_Predicated_Generic_Type` | `0x206` | 25 | | `PE_Current_Task_In_Entry_Body` | `0x207` | 26 | | `PE_Duplicated_Entry_Address` | `0x208` | 27 | | `PE_Implicit_Return` | `0x209` | 28 | | `PE_Misaligned_Address_Value` | `0x20a` | 29 | | `PE_Missing_Return` | `0x20b` | 30 | | `PE_Overlaid_Controlled_Object` | `0x20c` | 31 | | `PE_Non_Transportable_Actual` | `0x20d` | 32 | | `PE_Potentially_Blocking_Operation` | `0x20e` | 33 | | `PE_Stream_Operation_Not_Allowed` | `0x20f` | 34 | | `PE_Stubbed_Subprogram_Called` | `0x210` | 35 | | `PE_Unchecked_Union_Restriction` | `0x211` | 36 | | `PE_Finalize_Raised_Exception` | `0x212` | 37 | | `SE_Explicit_Raise` | `0x300` | 38 | | `SE_Empty_Storage_Pool` | `0x301` | 39 | | `SE_Infinite_Recursion` | `0x302` | 40 | | `SE_Object_Too_Large` | `0x303` | 41 | -------------------------------------------------------------------------------- /platform/ada_exceptions.h: -------------------------------------------------------------------------------- 1 | // AUTOGENERATED, edit doc/exceptions.md 2 | 3 | #ifndef _ADA_EXCEPTIONS_H_ 4 | #define _ADA_EXCEPTIONS_H_ 5 | 6 | typedef enum { 7 | UNDEFINED_EXCEPTION = 0x0, 8 | CE_EXPLICIT_RAISE = 0x100, 9 | CE_ACCESS_CHECK = 0x101, 10 | CE_NULL_ACCESS_PARAMETER = 0x102, 11 | CE_DISCRIMINANT_CHECK = 0x103, 12 | CE_DIVIDE_BY_ZERO = 0x104, 13 | CE_INDEX_CHECK = 0x105, 14 | CE_INVALID_DATA = 0x106, 15 | CE_LENGTH_CHECK = 0x107, 16 | CE_NULL_EXCEPTION_ID = 0x108, 17 | CE_NULL_NOT_ALLOWED = 0x109, 18 | CE_OVERFLOW_CHECK = 0x10a, 19 | CE_PARTITION_CHECK = 0x10b, 20 | CE_RANGE_CHECK = 0x10c, 21 | CE_TAG_CHECK = 0x10d, 22 | PE_EXPLICIT_RAISE = 0x200, 23 | PE_ACCESS_BEFORE_ELABORATION = 0x201, 24 | PE_ACCESSIBILITY_CHECK = 0x202, 25 | PE_ADDRESS_OF_INTRINSIC = 0x203, 26 | PE_ALIASED_PARAMETERS = 0x204, 27 | PE_ALL_GUARDS_CLOSED = 0x205, 28 | PE_BAD_PREDICATED_GENERIC_TYPE = 0x206, 29 | PE_CURRENT_TASK_IN_ENTRY_BODY = 0x207, 30 | PE_DUPLICATED_ENTRY_ADDRESS = 0x208, 31 | PE_IMPLICIT_RETURN = 0x209, 32 | PE_MISALIGNED_ADDRESS_VALUE = 0x20a, 33 | PE_MISSING_RETURN = 0x20b, 34 | PE_OVERLAID_CONTROLLED_OBJECT = 0x20c, 35 | PE_NON_TRANSPORTABLE_ACTUAL = 0x20d, 36 | PE_POTENTIALLY_BLOCKING_OPERATION = 0x20e, 37 | PE_STREAM_OPERATION_NOT_ALLOWED = 0x20f, 38 | PE_STUBBED_SUBPROGRAM_CALLED = 0x210, 39 | PE_UNCHECKED_UNION_RESTRICTION = 0x211, 40 | PE_FINALIZE_RAISED_EXCEPTION = 0x212, 41 | SE_EXPLICIT_RAISE = 0x300, 42 | SE_EMPTY_STORAGE_POOL = 0x301, 43 | SE_INFINITE_RECURSION = 0x302, 44 | SE_OBJECT_TOO_LARGE = 0x303 45 | } exception_t; 46 | 47 | #endif /* ifndef _ADA_EXCEPTIONS_H_ */ 48 | -------------------------------------------------------------------------------- /tests/genode.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | mkdir /genode/contrib/ada-runtime-test 5 | ln -sf /app /genode/contrib/ada-runtime-test/ada-runtime 6 | cd /genode 7 | git remote add jklmnn https://github.com/jklmnn/genode.git 8 | git fetch --all 9 | git checkout cf9827f313b912245b149406e54095a4c2c3843c 10 | ./tool/create_builddir x86_64 11 | ./tool/ports/prepare_port ada-runtime gcov 12 | ln -sf /genode/contrib/ada-runtime-$(cat /genode/repos/libports/ports/ada-runtime.hash)/ada-runtime-alis /genode/contrib/ada-runtime-test/ 13 | echo "test" > /genode/repos/libports/ports/ada-runtime.hash 14 | cd build/x86_64 15 | sed -i "s/^#REPOS/REPOS/g;s/^#MAKE.*$/MAKE += -j$(nproc)/g" etc/build.conf 16 | make run/test KERNEL=linux BOARD=linux PKG=test-spark 17 | make run/test KERNEL=linux BOARD=linux PKG=test-spark_exception 18 | make run/test KERNEL=linux BOARD=linux PKG=test-spark_secondary_stack 19 | make run/test KERNEL=linux BOARD=linux PKG=test-spark_dispatching 20 | /genode/tool/depot/create -j$(nproc) UPDATE_VERSIONS=1 FORCE_BUILD=1 REBUILD=1 \ 21 | genodelabs/pkg/x86_64/test-spark genodelabs/pkg/x86_64/test-spark_exception \ 22 | genodelabs/pkg/x86_64/test-spark_secondary_stack \ 23 | genodelabs/pkg/x86_64/test-spark_dispatching \ 24 | genodelabs/bin/x86_64/depot_query \ 25 | genodelabs/bin/x86_64/fs_rom \ 26 | genodelabs/bin/x86_64/loader \ 27 | genodelabs/bin/x86_64/test-xml_generator \ 28 | genodelabs/bin/x86_64/vfs \ 29 | genodelabs/raw/test-lx_block \ 30 | genodelabs/bin/x86_64/base-linux \ 31 | genodelabs/bin/x86_64/report_rom \ 32 | CROSS_DEV_PREFIX=/usr/local/genode/tool/19.05/bin/genode-x86- 33 | make KERNEL=linux BOARD=linux run/depot_autopilot TEST_PKGS="test-spark test-spark_secondary_stack test-spark_exception test-spark_dispatching" 34 | -------------------------------------------------------------------------------- /src/minimal/s-parame.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | package System.Parameters 11 | is 12 | 13 | pragma Pure; 14 | pragma Elaborate_Body; 15 | 16 | ------------------------------ 17 | -- Stack Allocation Control -- 18 | ------------------------------ 19 | 20 | type Task_Storage_Size is new Integer; 21 | -- Type used in tasking units for task storage size 22 | 23 | type Size_Type is new Task_Storage_Size; 24 | -- Type used to provide task storage size to runtime 25 | 26 | Runtime_Default_Sec_Stack_Size : constant Size_Type := 10 * 1024; 27 | -- The run-time chosen default size for secondary stacks that may be 28 | -- overriden by the user with the use of binder -D switch. 29 | 30 | ---------------------------------------------- 31 | -- Characteristics of types in Interfaces.C -- 32 | ---------------------------------------------- 33 | 34 | long_bits : constant := Long_Integer'Size; 35 | -- Number of bits in type long and unsigned_long. The normal convention 36 | -- is that this is the same as type Long_Integer, but this may not be true 37 | -- of all targets. 38 | 39 | ptr_bits : constant := Standard'Address_Size; 40 | subtype C_Address is System.Address; 41 | -- Number of bits in Interfaces.C pointers, normally a standard address 42 | 43 | C_Malloc_Linkname : constant String := "__gnat_malloc"; 44 | -- Name of runtime function used to allocate such a pointer 45 | 46 | end System.Parameters; 47 | -------------------------------------------------------------------------------- /tools/generate_exceptions.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | 3 | # Copyright (C) 2018 Componolit GmbH 4 | # 5 | # This file is part of the Componolit Ada runtime, which is distributed 6 | # under the terms of the GNU Affero General Public License version 3. 7 | # 8 | # As a special exception under Section 7 of GPL version 3, you are granted 9 | # additional permissions described in the GCC Runtime Library Exception, 10 | # version 3.1, as published by the Free Software Foundation. 11 | 12 | import sys 13 | 14 | exceptions = {} 15 | 16 | def gen_header(): 17 | return """// AUTOGENERATED, edit doc/exceptions.md 18 | 19 | typedef enum {{ 20 | {} 21 | }} exception_t; 22 | 23 | """.format("\n".join([" {} = {},".format(exceptions[name].upper(), hex(name)) for name in sorted(list(exceptions))]).strip(",")) 24 | 25 | def gen_spec(): 26 | return """-- AUTOGENERATED, edit doc/exceptions.md 27 | 28 | package Ada_Exceptions is 29 | pragma Pure; 30 | pragma Preelaborate; 31 | 32 | type Exception_Type is ( 33 | {} 34 | ); 35 | 36 | for Exception_Type use ( 37 | {} 38 | ); 39 | 40 | end Ada_Exceptions; 41 | """.format( 42 | "\n".join([" {},".format(exceptions[name]) for name in sorted(list(exceptions))]).strip(","), 43 | "\n".join([" {} => 16#{}#,".format(exceptions[name], hex(name)[2:]) for name in sorted(list(exceptions))]).strip(",") 44 | ) 45 | 46 | with open(sys.argv[1], "r") as md: 47 | for line in md.readlines(): 48 | try: 49 | exception = line.split("|")[1].strip(" `") 50 | excid = line.split("|")[2].strip(" `") 51 | if not excid.startswith("0x"): 52 | raise ValueError 53 | exceptions[int(excid, 16)] = exception 54 | except: 55 | print("IGNORE: " + line.strip("\n")) 56 | 57 | with open("ada_exceptions.h", "w") as header: 58 | header.write(gen_header()) 59 | 60 | with open("ada_exceptions.ads", "w") as spec: 61 | spec.write(gen_spec()) 62 | -------------------------------------------------------------------------------- /src/minimal/a-except.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | pragma Compiler_Unit_Warning; 11 | 12 | with System; 13 | with System.Standard_Library; 14 | 15 | package Ada.Exceptions with 16 | SPARK_Mode => Off 17 | -- Ada.Exceptions needs access types 18 | is 19 | 20 | pragma Preelaborate; 21 | -- We make this preelaborable. If we did not do this, then run time units 22 | -- used by the compiler (e.g. s-soflin.ads) would run into trouble. 23 | -- Conformance with Ada 95 is not an issue, since this version is used 24 | -- only by the compiler. 25 | 26 | type Exception_Id is private; 27 | type Exception_Occurrence is limited private; 28 | type Exception_Occurrence_Access is access all Exception_Occurrence; 29 | 30 | Null_Exception_Id : constant Exception_Id; 31 | 32 | procedure Raise_Exception_Always (E : Exception_Id; 33 | Message : String := "") 34 | with 35 | Export, 36 | Convention => Ada, 37 | External_Name => "__gnat_raise_exception"; 38 | 39 | procedure Raise_Exception (E : Exception_Id; 40 | Message : String := ""); 41 | 42 | procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence); 43 | 44 | procedure Save_Occurrence (Target : out Exception_Occurrence; 45 | Source : Exception_Occurrence); 46 | 47 | procedure Last_Chance_Handler (Except : Exception_Occurrence) 48 | with 49 | Export, 50 | Convention => Ada, 51 | External_Name => "__gnat_last_chance_handler"; 52 | 53 | private 54 | 55 | type Exception_Id is new System.Standard_Library.Exception_Data_Ptr; 56 | type Exception_Occurrence is record 57 | null; 58 | end record; 59 | 60 | Null_Exception_Id : constant Exception_Id := null; 61 | 62 | end Ada.Exceptions; 63 | -------------------------------------------------------------------------------- /src/minimal/s-secsta.adb: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | with Componolit.Runtime.Platform; 11 | 12 | package body System.Secondary_Stack with 13 | SPARK_Mode, 14 | Refined_State => (Stack_State => Stack, 15 | Binder_State => (Stack_Size, 16 | Stack_Count, 17 | Stack_Pool_Address, 18 | SS_Pool)) 19 | is 20 | 21 | procedure SS_Allocate (Address : out SSE.Integer_Address; 22 | Storage_Size : SSE.Storage_Count) 23 | is 24 | begin 25 | if Sufficient_Stack_Space (Storage_Size) then 26 | Stack.Top := Stack.Top + Storage_Size; 27 | Address := Stack.Base - SSE.Integer_Address (Stack.Top); 28 | else 29 | Componolit.Runtime.Platform.Terminate_Message 30 | ("Secondary stack overflowed"); 31 | end if; 32 | end SS_Allocate; 33 | 34 | function SS_Mark return Mark_Id 35 | is 36 | begin 37 | return Mark_Id'(Sstk => Stack.Base, 38 | Sptr => SSE.Integer_Address (Stack.Top)); 39 | end SS_Mark; 40 | 41 | procedure SS_Release (M : Mark_Id) 42 | is 43 | begin 44 | if SSE.Storage_Count (M.Sptr) > Stack.Top or M.Sstk /= Stack.Base 45 | then 46 | Componolit.Runtime.Platform.Terminate_Message 47 | ("Secondary stack underflowed"); 48 | end if; 49 | Stack.Top := SSE.Storage_Count (M.Sptr); 50 | end SS_Release; 51 | 52 | begin 53 | if Stack_Count = 1 then 54 | Stack.Base := 55 | SSE.To_Integer (Stack_Pool_Address) 56 | + SSE.Integer_Address (Stack_Size); 57 | else 58 | Componolit.Runtime.Platform.Terminate_Message 59 | ("Invalid secondary stack count"); 60 | end if; 61 | end System.Secondary_Stack; 62 | -------------------------------------------------------------------------------- /platform/stm32f0/componolit_runtime.adb: -------------------------------------------------------------------------------- 1 | 2 | with System; 3 | with Gnat_Helpers; 4 | 5 | package body Componolit_Runtime is 6 | 7 | procedure Log (S : String) 8 | is 9 | begin 10 | null; 11 | end Log; 12 | 13 | procedure Raise_Ada_Exception (E : CRE.Exception_Type; 14 | N : String; 15 | M : String) 16 | is 17 | begin 18 | null; 19 | end Raise_Ada_Exception; 20 | 21 | procedure Initialize 22 | is 23 | begin 24 | null; 25 | end Initialize; 26 | 27 | procedure Finalize 28 | is 29 | begin 30 | null; 31 | end Finalize; 32 | 33 | function Personality (State : Gnat_Helpers.US; 34 | Header : System.Address; 35 | Context : System.Address) return Gnat_Helpers.URC with 36 | Export, 37 | Convention => C, 38 | External_Name => "__gnat_personality_v0"; 39 | 40 | function Personality (State : Gnat_Helpers.US; 41 | Header : System.Address; 42 | Context : System.Address) return Gnat_Helpers.URC 43 | is 44 | pragma Unreferenced (State); 45 | pragma Unreferenced (Header); 46 | pragma Unreferenced (Context); 47 | begin 48 | return Gnat_Helpers.Failure; 49 | end Personality; 50 | 51 | procedure Unhandled_Terminate with 52 | Export, 53 | Convention => C, 54 | External_Name => "__gnat_unhandled_terminate"; 55 | 56 | procedure Unhandled_Terminate 57 | is 58 | begin 59 | null; 60 | end Unhandled_Terminate; 61 | 62 | procedure System_Abort with 63 | Export, 64 | Convention => C, 65 | External_Name => "abort"; 66 | 67 | procedure System_Abort 68 | is 69 | begin 70 | null; 71 | end System_Abort; 72 | 73 | procedure System_Exit with 74 | Export, 75 | Convention => C, 76 | External_Name => "_exit"; 77 | 78 | procedure System_Exit 79 | is 80 | begin 81 | null; 82 | end System_Exit; 83 | 84 | procedure Breakpoint with 85 | Export, 86 | Convention => C, 87 | External_Name => "__gnat_bkpt_trap"; 88 | 89 | procedure Breakpoint is null; 90 | 91 | end Componolit_Runtime; 92 | -------------------------------------------------------------------------------- /platform/nrf52/componolit_runtime.adb: -------------------------------------------------------------------------------- 1 | 2 | with System; 3 | with Componolit.Runtime.Board; 4 | with Gnat_Helpers; 5 | 6 | package body Componolit_Runtime is 7 | 8 | procedure Log (S : String) 9 | is 10 | begin 11 | Componolit.Runtime.Board.Log (S); 12 | end Log; 13 | 14 | procedure Raise_Ada_Exception (E : CRE.Exception_Type; 15 | N : String; 16 | M : String) 17 | is 18 | pragma Unreferenced (E); 19 | begin 20 | Componolit.Runtime.Board.Log (N & ": " & M); 21 | Componolit.Runtime.Board.Halt_On_Error; 22 | end Raise_Ada_Exception; 23 | 24 | procedure Initialize 25 | is 26 | begin 27 | Componolit.Runtime.Board.Initialize; 28 | end Initialize; 29 | 30 | procedure Finalize 31 | is 32 | begin 33 | null; 34 | end Finalize; 35 | 36 | function Personality (State : Gnat_Helpers.US; 37 | Header : System.Address; 38 | Context : System.Address) return Gnat_Helpers.URC with 39 | Export, 40 | Convention => C, 41 | External_Name => "__gnat_personality_v0"; 42 | 43 | function Personality (State : Gnat_Helpers.US; 44 | Header : System.Address; 45 | Context : System.Address) return Gnat_Helpers.URC 46 | is 47 | pragma Unreferenced (State); 48 | pragma Unreferenced (Header); 49 | pragma Unreferenced (Context); 50 | begin 51 | return Gnat_Helpers.Failure; 52 | end Personality; 53 | 54 | procedure Unhandled_Terminate with 55 | Export, 56 | Convention => C, 57 | External_Name => "__gnat_unhandled_terminate"; 58 | 59 | procedure Unhandled_Terminate 60 | is 61 | begin 62 | Componolit.Runtime.Board.Halt_On_Error; 63 | end Unhandled_Terminate; 64 | 65 | procedure System_Abort with 66 | Export, 67 | Convention => C, 68 | External_Name => "abort"; 69 | 70 | procedure System_Abort 71 | is 72 | begin 73 | Componolit.Runtime.Board.Halt_On_Error; 74 | end System_Abort; 75 | 76 | procedure System_Exit with 77 | Export, 78 | Convention => C, 79 | External_Name => "_exit"; 80 | 81 | procedure System_Exit 82 | is 83 | begin 84 | Componolit.Runtime.Board.Poweroff; 85 | end System_Exit; 86 | 87 | procedure Breakpoint with 88 | Export, 89 | Convention => C, 90 | External_Name => "__gnat_bkpt_trap"; 91 | 92 | procedure Breakpoint is null; 93 | 94 | end Componolit_Runtime; 95 | -------------------------------------------------------------------------------- /src/lib/componolit-runtime-conversions.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2019 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | with Interfaces; 11 | 12 | package Componolit.Runtime.Conversions with 13 | SPARK_Mode 14 | is 15 | pragma Pure; 16 | 17 | use type Interfaces.Integer_64; 18 | use type Interfaces.Unsigned_64; 19 | 20 | subtype Int64 is Interfaces.Integer_64; 21 | subtype Uns64 is Interfaces.Unsigned_64; 22 | 23 | function "abs" (X : Int64) return Uns64 is 24 | (if X = Int64'First then 2**63 else Uns64 (Int64'(abs X))); 25 | -- Convert absolute value of X to unsigned. Note that we can't just use 26 | -- the expression of the Else, because it overflows for X = Int64'First. 27 | 28 | function To_Int (U : Uns64) return Int64 with 29 | Inline, 30 | Annotate => (GNATprove, Terminating), 31 | Contract_Cases => (U <= Uns64 (Int64'Last) => 32 | To_Int'Result = Int64 (U), 33 | U > Uns64 (Int64'Last) => 34 | To_Int'Result = -Int64 (Uns64'Last - U) - 1); 35 | 36 | function To_Uns (I : Int64) return Uns64 with 37 | Inline, 38 | Annotate => (GNATprove, Terminating), 39 | Contract_Cases => (I >= 0 => To_Uns'Result = Uns64 (I), 40 | I < 0 => To_Uns'Result = 41 | Uns64'Last - (abs (I) - Uns64'(1))); 42 | 43 | procedure Lemma_Identity (I : Int64; U : Uns64) with 44 | -- Ghost, -- This should be Ghost but the FSF GNAT crashes here 45 | Post => I = To_Int (To_Uns (I)) 46 | and U = To_Uns (To_Int (U)); 47 | 48 | procedure Lemma_Uns_Associativity_Add (X, Y : Int64) with 49 | -- Ghost, -- This should be Ghost but the FSF GNAT crashes here 50 | Pre => (if X < 0 and Y <= 0 then Int64'First - X < Y) 51 | and (if X >= 0 and Y >= 0 then Int64'Last - X >= Y), 52 | Post => X + Y = To_Int (To_Uns (X) + To_Uns (Y)); 53 | 54 | procedure Lemma_Uns_Associativity_Sub (X, Y : Int64) with 55 | -- Ghost, -- This should be Ghost but the FSF GNAT crashes here 56 | Pre => (if X >= 0 and Y <= 0 then Y > Int64'First 57 | and then Int64'Last - X >= abs (Y)) 58 | and (if X < 0 and Y > 0 then Y < Int64'First - X), 59 | Post => X - Y = To_Int (To_Uns (X) - To_Uns (Y)); 60 | 61 | end Componolit.Runtime.Conversions; 62 | -------------------------------------------------------------------------------- /contrib/gcc-9.3.1/s-memset.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT RUN-TIME COMPONENTS -- 4 | -- -- 5 | -- S Y S T E M . M E M O R Y _ S E T -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- Copyright (C) 2006-2020, Free Software Foundation, Inc. -- 10 | -- -- 11 | -- GNAT is free software; you can redistribute it and/or modify it under -- 12 | -- terms of the GNU General Public License as published by the Free Soft- -- 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- 17 | -- -- 18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 19 | -- additional permissions described in the GCC Runtime Library Exception, -- 20 | -- version 3.1, as published by the Free Software Foundation. -- 21 | -- -- 22 | -- You should have received a copy of the GNU General Public License and -- 23 | -- a copy of the GCC Runtime Library Exception along with this program; -- 24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25 | -- . -- 26 | -- -- 27 | -- GNAT was originally developed by the GNAT team at New York University. -- 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with System.Memory_Types; 33 | 34 | package System.Memory_Set is 35 | pragma No_Elaboration_Code_All; 36 | 37 | function memset 38 | (M : Address; C : Integer; Size : Memory_Types.size_t) return Address; 39 | pragma Export (C, memset, "memset"); 40 | -- This function stores C converted to a Character in each of the elements 41 | -- of the array of Characters beginning at M, with size Size. It returns a 42 | -- pointer to M. 43 | 44 | end System.Memory_Set; 45 | -------------------------------------------------------------------------------- /platform/nrf52/drivers/componolit-runtime-drivers-gpio.adb: -------------------------------------------------------------------------------- 1 | 2 | package body Componolit.Runtime.Drivers.GPIO with 3 | SPARK_Mode, 4 | Refined_State => (Shadow_GPIO_Configuration => (Shadow_DIR_Reg, Pins), 5 | GPIO_Configuration => DIR_Reg, 6 | GPIO_State => (OUTSET_Reg, 7 | OUTCLR_Reg, 8 | OUT_Reg, 9 | IN_Reg)) 10 | is 11 | use type SSE.Integer_Address; 12 | 13 | DIR_Reg : Pin_Modes with 14 | Address => SSE.To_Address (AHB_Base + DIR_Offset), 15 | Import, 16 | Volatile, 17 | Async_Readers, 18 | Effective_Writes; 19 | 20 | OUTSET_Reg : Pin_Values with 21 | Address => SSE.To_Address (AHB_Base + OUTSET_Offset), 22 | Import, 23 | Volatile, 24 | Async_Readers, 25 | Effective_Writes; 26 | 27 | OUTCLR_Reg : Pin_Values with 28 | Address => SSE.To_Address (AHB_Base + OUTCLR_Offset), 29 | Import, 30 | Volatile, 31 | Async_Readers, 32 | Effective_Writes; 33 | 34 | OUT_Reg : Pin_Values with 35 | Address => SSE.To_Address (AHB_Base + OUT_Offset), 36 | Import, 37 | Volatile, 38 | Async_Writers; 39 | 40 | IN_Reg : Pin_Values with 41 | Address => SSE.To_Address (AHB_Base + IN_Offset), 42 | Import, 43 | Volatile, 44 | Async_Writers; 45 | 46 | Shadow_DIR_Reg : Pin_Modes := DIR_Reg; 47 | 48 | Pins : Configured_Pins := (others => False); 49 | 50 | function Pins_Configured return Configured_Pins is (Pins); 51 | 52 | function Configured (P : Pin) return Boolean is (Pins (P)); 53 | 54 | function Convert (P : Pin_Value) return Value is 55 | (case P is 56 | when 0 => Low, 57 | when 1 => High); 58 | 59 | procedure Configure (P : Pin; M : Mode) 60 | is 61 | begin 62 | Shadow_DIR_Reg (P) := M; 63 | DIR_Reg := Shadow_DIR_Reg; 64 | Pins (P) := True; 65 | end Configure; 66 | 67 | function Pin_Mode (P : Pin) return Mode is 68 | (Shadow_DIR_Reg (P)); 69 | 70 | procedure Write (P : Pin; V : Value) 71 | is 72 | Enable : Pin_Values := (others => 0); 73 | begin 74 | Enable (P) := 1; 75 | case V is 76 | when Low => 77 | OUTCLR_Reg := Enable; 78 | when High => 79 | OUTSET_Reg := Enable; 80 | end case; 81 | end Write; 82 | 83 | procedure Read (P : Pin; V : out Value) 84 | is 85 | In_Value : constant Pin_Value := IN_Reg (P); 86 | Out_Value : constant Pin_Value := OUT_Reg (P); 87 | begin 88 | case DIR_Reg (P) is 89 | when Port_In => 90 | V := Convert (In_Value); 91 | when Port_Out => 92 | V := Convert (Out_Value); 93 | end case; 94 | end Read; 95 | 96 | function Proof_Modes return Pin_Modes is (Shadow_DIR_Reg); 97 | 98 | end Componolit.Runtime.Drivers.GPIO; 99 | -------------------------------------------------------------------------------- /src/minimal/a-tags.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2019 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | private with System; 11 | private with System.Storage_Elements; 12 | 13 | package Ada.Tags with 14 | Preelaborate, 15 | Elaborate_Body 16 | is 17 | 18 | type Tag is private with 19 | Preelaborable_Initialization; 20 | 21 | No_Tag : constant Tag; 22 | 23 | private 24 | 25 | package SSE renames System.Storage_Elements; 26 | use type SSE.Storage_Offset; 27 | 28 | subtype Cstring is String (Positive); 29 | type Cstring_Ptr is access all Cstring; 30 | pragma No_Strict_Aliasing (Cstring_Ptr); 31 | type Tag_Table is array (Natural range <>) of Tag; 32 | type Prim_Ptr is access procedure; 33 | type Address_Array is array (Positive range <>) of Prim_Ptr; 34 | subtype Dispatch_Table is Address_Array (1 .. 1); 35 | 36 | type Tag is access all Dispatch_Table; 37 | pragma No_Strict_Aliasing (Tag); 38 | 39 | No_Tag : constant Tag := null; 40 | 41 | type Type_Specific_Data (Depth : Natural) is record 42 | Access_Level : Natural; 43 | Alignment : Natural; 44 | Expanded_Name : Cstring_Ptr; 45 | External_Tag : Cstring_Ptr; 46 | Transportable : Boolean; 47 | Needs_Finalization : Boolean; 48 | Tags_Table : Tag_Table (0 .. Depth); 49 | end record; 50 | 51 | type Dispatch_Table_Wrapper (Procedure_Count : Natural) is record 52 | Predef_Prims : System.Address; 53 | Offset_To_Top : SSE.Storage_Offset; 54 | TSD : System.Address; 55 | Prims_Ptr : Address_Array (1 .. Procedure_Count); 56 | end record; 57 | 58 | Max_Predef_Prims : constant Positive := 9; 59 | subtype Predef_Prims_Table is Address_Array (1 .. Max_Predef_Prims); 60 | type Predef_Prims_Table_Ptr is access Predef_Prims_Table; 61 | pragma No_Strict_Aliasing (Predef_Prims_Table_Ptr); 62 | 63 | DT_Predef_Prims_Size : constant SSE.Storage_Count := 64 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 65 | DT_Offset_To_Top_Size : constant SSE.Storage_Count := 66 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 67 | DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count := 68 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 69 | DT_Offset_To_Top_Offset : constant SSE.Storage_Count := 70 | DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size; 71 | DT_Predef_Prims_Offset : constant SSE.Storage_Count := 72 | DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size + DT_Predef_Prims_Size; 73 | 74 | type Addr_Ptr is access System.Address; 75 | pragma No_Strict_Aliasing (Addr_Ptr); 76 | 77 | end Ada.Tags; 78 | -------------------------------------------------------------------------------- /src/minimal/a-tags-gcc_10.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2019 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | private with System; 11 | private with System.Storage_Elements; 12 | 13 | package Ada.Tags with 14 | Preelaborate, 15 | Elaborate_Body 16 | is 17 | 18 | type Tag is private with 19 | Preelaborable_Initialization; 20 | 21 | No_Tag : constant Tag; 22 | 23 | private 24 | 25 | package SSE renames System.Storage_Elements; 26 | use type SSE.Storage_Offset; 27 | 28 | subtype Cstring is String (Positive); 29 | type Cstring_Ptr is access all Cstring; 30 | pragma No_Strict_Aliasing (Cstring_Ptr); 31 | type Tag_Table is array (Natural range <>) of Tag; 32 | type Prim_Ptr is access procedure; 33 | type Address_Array is array (Positive range <>) of Prim_Ptr; 34 | subtype Dispatch_Table is Address_Array (1 .. 1); 35 | 36 | type Tag is access all Dispatch_Table; 37 | pragma No_Strict_Aliasing (Tag); 38 | 39 | No_Tag : constant Tag := null; 40 | 41 | type Type_Specific_Data (Depth : Natural) is record 42 | Access_Level : Natural; 43 | Alignment : Natural; 44 | Expanded_Name : Cstring_Ptr; 45 | External_Tag : Cstring_Ptr; 46 | Transportable : Boolean; 47 | Needs_Finalization : Boolean; 48 | Tags_Table : Tag_Table (0 .. Depth); 49 | end record; 50 | 51 | type Dispatch_Table_Wrapper (Procedure_Count : Natural) is record 52 | Predef_Prims : System.Address; 53 | Offset_To_Top : SSE.Storage_Offset; 54 | TSD : System.Address; 55 | Prims_Ptr : Address_Array (1 .. Procedure_Count); 56 | end record; 57 | 58 | Max_Predef_Prims : constant Positive := 10; 59 | subtype Predef_Prims_Table is Address_Array (1 .. Max_Predef_Prims); 60 | type Predef_Prims_Table_Ptr is access Predef_Prims_Table; 61 | pragma No_Strict_Aliasing (Predef_Prims_Table_Ptr); 62 | 63 | DT_Predef_Prims_Size : constant SSE.Storage_Count := 64 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 65 | DT_Offset_To_Top_Size : constant SSE.Storage_Count := 66 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 67 | DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count := 68 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 69 | DT_Offset_To_Top_Offset : constant SSE.Storage_Count := 70 | DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size; 71 | DT_Predef_Prims_Offset : constant SSE.Storage_Count := 72 | DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size + DT_Predef_Prims_Size; 73 | 74 | type Addr_Ptr is access System.Address; 75 | pragma No_Strict_Aliasing (Addr_Ptr); 76 | 77 | end Ada.Tags; 78 | -------------------------------------------------------------------------------- /src/minimal/a-tags-gcc_11.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2021 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | private with System; 11 | private with System.Storage_Elements; 12 | 13 | package Ada.Tags with 14 | Preelaborate, 15 | Elaborate_Body 16 | is 17 | 18 | type Tag is private with 19 | Preelaborable_Initialization; 20 | 21 | No_Tag : constant Tag; 22 | 23 | private 24 | 25 | package SSE renames System.Storage_Elements; 26 | use type SSE.Storage_Offset; 27 | 28 | subtype Cstring is String (Positive); 29 | type Cstring_Ptr is access all Cstring; 30 | pragma No_Strict_Aliasing (Cstring_Ptr); 31 | type Tag_Table is array (Natural range <>) of Tag; 32 | type Prim_Ptr is access procedure; 33 | type Address_Array is array (Positive range <>) of Prim_Ptr; 34 | subtype Dispatch_Table is Address_Array (1 .. 1); 35 | 36 | type Tag is access all Dispatch_Table; 37 | pragma No_Strict_Aliasing (Tag); 38 | 39 | No_Tag : constant Tag := null; 40 | 41 | type Type_Specific_Data (Depth : Natural) is record 42 | Access_Level : Natural; 43 | Alignment : Natural; 44 | Expanded_Name : Cstring_Ptr; 45 | External_Tag : Cstring_Ptr; 46 | Transportable : Boolean; 47 | Needs_Finalization : Boolean; 48 | Tags_Table : Tag_Table (0 .. Depth); 49 | end record; 50 | 51 | type Dispatch_Table_Wrapper (Procedure_Count : Natural) is record 52 | Predef_Prims : System.Address; 53 | Offset_To_Top : SSE.Storage_Offset; 54 | TSD : System.Address; 55 | Prims_Ptr : Address_Array (1 .. Procedure_Count); 56 | end record; 57 | 58 | Max_Predef_Prims : constant Positive := 10; 59 | subtype Predef_Prims_Table is Address_Array (1 .. Max_Predef_Prims); 60 | type Predef_Prims_Table_Ptr is access Predef_Prims_Table; 61 | pragma No_Strict_Aliasing (Predef_Prims_Table_Ptr); 62 | 63 | DT_Predef_Prims_Size : constant SSE.Storage_Count := 64 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 65 | DT_Offset_To_Top_Size : constant SSE.Storage_Count := 66 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 67 | DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count := 68 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 69 | DT_Offset_To_Top_Offset : constant SSE.Storage_Count := 70 | DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size; 71 | DT_Predef_Prims_Offset : constant SSE.Storage_Count := 72 | DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size + DT_Predef_Prims_Size; 73 | 74 | type Addr_Ptr is access System.Address; 75 | pragma No_Strict_Aliasing (Addr_Ptr); 76 | 77 | end Ada.Tags; 78 | -------------------------------------------------------------------------------- /src/minimal/a-tags-gcc_12.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2021 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | private with System; 11 | private with System.Storage_Elements; 12 | 13 | package Ada.Tags with 14 | Preelaborate, 15 | Elaborate_Body 16 | is 17 | 18 | type Tag is private with 19 | Preelaborable_Initialization; 20 | 21 | No_Tag : constant Tag; 22 | 23 | private 24 | 25 | package SSE renames System.Storage_Elements; 26 | use type SSE.Storage_Offset; 27 | 28 | subtype Cstring is String (Positive); 29 | type Cstring_Ptr is access all Cstring; 30 | pragma No_Strict_Aliasing (Cstring_Ptr); 31 | type Tag_Table is array (Natural range <>) of Tag; 32 | type Prim_Ptr is access procedure; 33 | type Address_Array is array (Positive range <>) of Prim_Ptr; 34 | subtype Dispatch_Table is Address_Array (1 .. 1); 35 | 36 | type Tag is access all Dispatch_Table; 37 | pragma No_Strict_Aliasing (Tag); 38 | 39 | No_Tag : constant Tag := null; 40 | 41 | type Type_Specific_Data (Depth : Natural) is record 42 | Access_Level : Natural; 43 | Alignment : Natural; 44 | Expanded_Name : Cstring_Ptr; 45 | External_Tag : Cstring_Ptr; 46 | Transportable : Boolean; 47 | Needs_Finalization : Boolean; 48 | Tags_Table : Tag_Table (0 .. Depth); 49 | end record; 50 | 51 | type Dispatch_Table_Wrapper (Procedure_Count : Natural) is record 52 | Predef_Prims : System.Address; 53 | Offset_To_Top : SSE.Storage_Offset; 54 | TSD : System.Address; 55 | Prims_Ptr : Address_Array (1 .. Procedure_Count); 56 | end record; 57 | 58 | Max_Predef_Prims : constant Positive := 10; 59 | subtype Predef_Prims_Table is Address_Array (1 .. Max_Predef_Prims); 60 | type Predef_Prims_Table_Ptr is access Predef_Prims_Table; 61 | pragma No_Strict_Aliasing (Predef_Prims_Table_Ptr); 62 | 63 | DT_Predef_Prims_Size : constant SSE.Storage_Count := 64 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 65 | DT_Offset_To_Top_Size : constant SSE.Storage_Count := 66 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 67 | DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count := 68 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 69 | DT_Offset_To_Top_Offset : constant SSE.Storage_Count := 70 | DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size; 71 | DT_Predef_Prims_Offset : constant SSE.Storage_Count := 72 | DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size + DT_Predef_Prims_Size; 73 | 74 | type Addr_Ptr is access System.Address; 75 | pragma No_Strict_Aliasing (Addr_Ptr); 76 | 77 | end Ada.Tags; 78 | -------------------------------------------------------------------------------- /src/minimal/a-tags-gcc_8.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2019 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | private with System; 11 | private with System.Storage_Elements; 12 | 13 | package Ada.Tags with 14 | Preelaborate, 15 | Elaborate_Body 16 | is 17 | 18 | type Tag is private with 19 | Preelaborable_Initialization; 20 | 21 | No_Tag : constant Tag; 22 | 23 | private 24 | 25 | package SSE renames System.Storage_Elements; 26 | use type SSE.Storage_Offset; 27 | 28 | subtype Cstring is String (Positive); 29 | type Cstring_Ptr is access all Cstring; 30 | pragma No_Strict_Aliasing (Cstring_Ptr); 31 | type Tag_Table is array (Natural range <>) of Tag; 32 | type Prim_Ptr is access procedure; 33 | type Address_Array is array (Positive range <>) of Prim_Ptr; 34 | subtype Dispatch_Table is Address_Array (1 .. 1); 35 | 36 | type Tag is access all Dispatch_Table; 37 | pragma No_Strict_Aliasing (Tag); 38 | 39 | No_Tag : constant Tag := null; 40 | 41 | type Type_Specific_Data (Depth : Natural) is record 42 | Access_Level : Natural; 43 | Alignment : Natural; 44 | Expanded_Name : Cstring_Ptr; 45 | External_Tag : Cstring_Ptr; 46 | Transportable : Boolean; 47 | Needs_Finalization : Boolean; 48 | Tags_Table : Tag_Table (0 .. Depth); 49 | end record; 50 | 51 | type Dispatch_Table_Wrapper (Procedure_Count : Natural) is record 52 | Predef_Prims : System.Address; 53 | Offset_To_Top : SSE.Storage_Offset; 54 | TSD : System.Address; 55 | Prims_Ptr : Address_Array (1 .. Procedure_Count); 56 | end record; 57 | 58 | Max_Predef_Prims : constant Positive := 9; 59 | subtype Predef_Prims_Table is Address_Array (1 .. Max_Predef_Prims); 60 | type Predef_Prims_Table_Ptr is access Predef_Prims_Table; 61 | pragma No_Strict_Aliasing (Predef_Prims_Table_Ptr); 62 | 63 | DT_Predef_Prims_Size : constant SSE.Storage_Count := 64 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 65 | DT_Offset_To_Top_Size : constant SSE.Storage_Count := 66 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 67 | DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count := 68 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 69 | DT_Offset_To_Top_Offset : constant SSE.Storage_Count := 70 | DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size; 71 | DT_Predef_Prims_Offset : constant SSE.Storage_Count := 72 | DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size + DT_Predef_Prims_Size; 73 | 74 | type Addr_Ptr is access System.Address; 75 | pragma No_Strict_Aliasing (Addr_Ptr); 76 | 77 | end Ada.Tags; 78 | -------------------------------------------------------------------------------- /src/minimal/a-tags-gcc_9.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2019 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | private with System; 11 | private with System.Storage_Elements; 12 | 13 | package Ada.Tags with 14 | Preelaborate, 15 | Elaborate_Body 16 | is 17 | 18 | type Tag is private with 19 | Preelaborable_Initialization; 20 | 21 | No_Tag : constant Tag; 22 | 23 | private 24 | 25 | package SSE renames System.Storage_Elements; 26 | use type SSE.Storage_Offset; 27 | 28 | subtype Cstring is String (Positive); 29 | type Cstring_Ptr is access all Cstring; 30 | pragma No_Strict_Aliasing (Cstring_Ptr); 31 | type Tag_Table is array (Natural range <>) of Tag; 32 | type Prim_Ptr is access procedure; 33 | type Address_Array is array (Positive range <>) of Prim_Ptr; 34 | subtype Dispatch_Table is Address_Array (1 .. 1); 35 | 36 | type Tag is access all Dispatch_Table; 37 | pragma No_Strict_Aliasing (Tag); 38 | 39 | No_Tag : constant Tag := null; 40 | 41 | type Type_Specific_Data (Depth : Natural) is record 42 | Access_Level : Natural; 43 | Alignment : Natural; 44 | Expanded_Name : Cstring_Ptr; 45 | External_Tag : Cstring_Ptr; 46 | Transportable : Boolean; 47 | Needs_Finalization : Boolean; 48 | Tags_Table : Tag_Table (0 .. Depth); 49 | end record; 50 | 51 | type Dispatch_Table_Wrapper (Procedure_Count : Natural) is record 52 | Predef_Prims : System.Address; 53 | Offset_To_Top : SSE.Storage_Offset; 54 | TSD : System.Address; 55 | Prims_Ptr : Address_Array (1 .. Procedure_Count); 56 | end record; 57 | 58 | Max_Predef_Prims : constant Positive := 10; 59 | subtype Predef_Prims_Table is Address_Array (1 .. Max_Predef_Prims); 60 | type Predef_Prims_Table_Ptr is access Predef_Prims_Table; 61 | pragma No_Strict_Aliasing (Predef_Prims_Table_Ptr); 62 | 63 | DT_Predef_Prims_Size : constant SSE.Storage_Count := 64 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 65 | DT_Offset_To_Top_Size : constant SSE.Storage_Count := 66 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 67 | DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count := 68 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 69 | DT_Offset_To_Top_Offset : constant SSE.Storage_Count := 70 | DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size; 71 | DT_Predef_Prims_Offset : constant SSE.Storage_Count := 72 | DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size + DT_Predef_Prims_Size; 73 | 74 | type Addr_Ptr is access System.Address; 75 | pragma No_Strict_Aliasing (Addr_Ptr); 76 | 77 | end Ada.Tags; 78 | -------------------------------------------------------------------------------- /contrib/gcc-9.3.1/s-memcom.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT RUN-TIME COMPONENTS -- 4 | -- -- 5 | -- S Y S T E M . M E M O R Y _ C O M P A R E -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- Copyright (C) 2006-2020, Free Software Foundation, Inc. -- 10 | -- -- 11 | -- GNAT is free software; you can redistribute it and/or modify it under -- 12 | -- terms of the GNU General Public License as published by the Free Soft- -- 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- 17 | -- -- 18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 19 | -- additional permissions described in the GCC Runtime Library Exception, -- 20 | -- version 3.1, as published by the Free Software Foundation. -- 21 | -- -- 22 | -- You should have received a copy of the GNU General Public License and -- 23 | -- a copy of the GCC Runtime Library Exception along with this program; -- 24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25 | -- . -- 26 | -- -- 27 | -- GNAT was originally developed by the GNAT team at New York University. -- 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with System.Memory_Types; 33 | 34 | package System.Memory_Compare is 35 | pragma No_Elaboration_Code_All; 36 | pragma Preelaborate; 37 | 38 | function memcmp 39 | (S1 : Address; 40 | S2 : Address; 41 | N : Memory_Types.size_t) return Integer; 42 | pragma Export (C, memcmp, "memcmp"); 43 | -- Compares the first n bytes of the memory areas s1 and s2. It returns 44 | -- an integer less than, equal to, or greater than zero if s1 is 45 | -- found, respectively, to be less than, to match, or be greater than s2. 46 | 47 | end System.Memory_Compare; 48 | -------------------------------------------------------------------------------- /src/minimal/a-tags-gnat_llvm_10.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2019 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | private with System; 11 | private with System.Storage_Elements; 12 | 13 | package Ada.Tags with 14 | Preelaborate, 15 | Elaborate_Body 16 | is 17 | 18 | type Tag is private with 19 | Preelaborable_Initialization; 20 | 21 | No_Tag : constant Tag; 22 | 23 | private 24 | 25 | package SSE renames System.Storage_Elements; 26 | use type SSE.Storage_Offset; 27 | 28 | subtype Cstring is String (Positive); 29 | type Cstring_Ptr is access all Cstring; 30 | pragma No_Strict_Aliasing (Cstring_Ptr); 31 | type Tag_Table is array (Natural range <>) of Tag; 32 | type Prim_Ptr is access procedure; 33 | type Address_Array is array (Positive range <>) of Prim_Ptr; 34 | subtype Dispatch_Table is Address_Array (1 .. 1); 35 | 36 | type Tag is access all Dispatch_Table; 37 | pragma No_Strict_Aliasing (Tag); 38 | 39 | No_Tag : constant Tag := null; 40 | 41 | type Type_Specific_Data (Depth : Natural) is record 42 | Access_Level : Natural; 43 | Alignment : Natural; 44 | Expanded_Name : Cstring_Ptr; 45 | External_Tag : Cstring_Ptr; 46 | Transportable : Boolean; 47 | Needs_Finalization : Boolean; 48 | Tags_Table : Tag_Table (0 .. Depth); 49 | end record; 50 | 51 | type Dispatch_Table_Wrapper (Procedure_Count : Natural) is record 52 | Predef_Prims : System.Address; 53 | Offset_To_Top : SSE.Storage_Offset; 54 | TSD : System.Address; 55 | Prims_Ptr : Address_Array (1 .. Procedure_Count); 56 | end record; 57 | 58 | Max_Predef_Prims : constant Positive := 15; 59 | subtype Predef_Prims_Table is Address_Array (1 .. Max_Predef_Prims); 60 | type Predef_Prims_Table_Ptr is access Predef_Prims_Table; 61 | pragma No_Strict_Aliasing (Predef_Prims_Table_Ptr); 62 | 63 | DT_Predef_Prims_Size : constant SSE.Storage_Count := 64 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 65 | DT_Offset_To_Top_Size : constant SSE.Storage_Count := 66 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 67 | DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count := 68 | SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); 69 | DT_Offset_To_Top_Offset : constant SSE.Storage_Count := 70 | DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size; 71 | DT_Predef_Prims_Offset : constant SSE.Storage_Count := 72 | DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size + DT_Predef_Prims_Size; 73 | 74 | type Addr_Ptr is access System.Address; 75 | pragma No_Strict_Aliasing (Addr_Ptr); 76 | 77 | end Ada.Tags; 78 | -------------------------------------------------------------------------------- /contrib/gcc-9.3.1/s-memcop.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT RUN-TIME COMPONENTS -- 4 | -- -- 5 | -- S Y S T E M . M E M O R Y _ C O P Y -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- Copyright (C) 2006-2020, Free Software Foundation, Inc. -- 10 | -- -- 11 | -- GNAT is free software; you can redistribute it and/or modify it under -- 12 | -- terms of the GNU General Public License as published by the Free Soft- -- 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- 17 | -- -- 18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 19 | -- additional permissions described in the GCC Runtime Library Exception, -- 20 | -- version 3.1, as published by the Free Software Foundation. -- 21 | -- -- 22 | -- You should have received a copy of the GNU General Public License and -- 23 | -- a copy of the GCC Runtime Library Exception along with this program; -- 24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25 | -- . -- 26 | -- -- 27 | -- GNAT was originally developed by the GNAT team at New York University. -- 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides a general block copy mechanisms analogous to that 33 | -- provided by the C routine memcpy allowing for copies without overlap. 34 | 35 | with System.Memory_Types; 36 | 37 | package System.Memory_Copy is 38 | pragma No_Elaboration_Code_All; 39 | 40 | function memcpy 41 | (Dest : Address; Src : Address; N : Memory_Types.size_t) return Address; 42 | pragma Export (C, memcpy, "memcpy"); 43 | -- Copies N storage units from area starting at Src to area starting 44 | -- at Dest without any check for buffer overflow. The memory areas 45 | -- must not overlap, or the result of this call is undefined. 46 | 47 | end System.Memory_Copy; 48 | -------------------------------------------------------------------------------- /src/lib/componolit-runtime-strings.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | with System; 11 | with System.Storage_Elements; 12 | use all type System.Address; 13 | use all type System.Storage_Elements.Integer_Address; 14 | 15 | package Componolit.Runtime.Strings with 16 | SPARK_Mode 17 | is 18 | 19 | pragma Preelaborate; 20 | 21 | function Length (C_Str : System.Address; 22 | Max_Length : Natural := Natural'Last) return Integer with 23 | Post => Length'Result <= Max_Length, 24 | Contract_Cases => 25 | (C_Str = System.Null_Address => Length'Result <= 0, 26 | C_Str /= System.Null_Address => Length'Result >= 0); 27 | pragma Annotate (GNATprove, Terminating, Length); 28 | 29 | function Convert_To_Ada (C_Str : System.Address; 30 | Default : String; 31 | Max_Length : Natural := Natural'Last) 32 | return String with 33 | Contract_Cases => 34 | (C_Str = System.Null_Address => Convert_To_Ada'Result = Default, 35 | C_Str /= System.Null_Address => 36 | Convert_To_Ada'Result'Length <= Max_Length 37 | or Convert_To_Ada'Result = Default); 38 | pragma Annotate (GNATprove, Terminating, Convert_To_Ada); 39 | 40 | function Image (J : Integer) return String with 41 | Post => Image'Result'Length <= 11; 42 | 43 | private 44 | 45 | package SSE renames System.Storage_Elements; 46 | 47 | subtype Pointer is SSE.Integer_Address; 48 | 49 | Null_Pointer : constant Pointer := 0; 50 | 51 | subtype Valid_Pointer is Pointer 52 | with 53 | Static_Predicate => Valid_Pointer /= Null_Pointer; 54 | 55 | function Get_Char (Ptr : Valid_Pointer) return Character; 56 | pragma Annotate (GNATprove, Terminating, Get_Char); 57 | 58 | function Incr (Ptr : Valid_Pointer) return Valid_Pointer with 59 | Pre => Ptr < Pointer'Last, 60 | Post => Incr'Result = Ptr + 1; 61 | pragma Annotate (GNATprove, Terminating, Incr); 62 | 63 | function To_Address (Value : Pointer) return System.Address with 64 | Inline, 65 | Contract_Cases => 66 | (Value = Null_Pointer => To_Address'Result = System.Null_Address, 67 | Value /= Null_Pointer => To_Address'Result /= System.Null_Address); 68 | pragma Annotate (GNATprove, Terminating, To_Address); 69 | 70 | function To_Pointer (Addr : System.Address) return Pointer with 71 | Inline, 72 | Contract_Cases => 73 | (Addr = System.Null_Address => To_Pointer'Result = Null_Pointer, 74 | Addr /= System.Null_Address => To_Pointer'Result /= Null_Pointer); 75 | pragma Annotate (GNATprove, Terminating, To_Pointer); 76 | 77 | end Componolit.Runtime.Strings; 78 | -------------------------------------------------------------------------------- /src/minimal/s-stalib.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- Copyright (C) 1992-2015, Free Software Foundation, Inc. 3 | -- 4 | -- This file is part of the Componolit Ada runtime, which is distributed 5 | -- under the terms of the GNU Affero General Public License version 3. 6 | -- 7 | -- As a special exception under Section 7 of GPL version 3, you are granted 8 | -- additional permissions described in the GCC Runtime Library Exception, 9 | -- version 3.1, as published by the Free Software Foundation. 10 | 11 | with Ada.Unchecked_Conversion; 12 | 13 | package System.Standard_Library with 14 | SPARK_Mode => Off 15 | -- Use of access types 16 | is 17 | 18 | pragma Preelaborate; 19 | pragma Elaborate_Body; 20 | 21 | subtype Big_String is String (1 .. Positive'Last); 22 | pragma Suppress_Initialization (Big_String); 23 | -- Type used to obtain string access to given address. Initialization is 24 | -- suppressed, since we never want to have variables of this type, and 25 | -- we never want to attempt initialiazation of virtual variables of this 26 | -- type (e.g. when pragma Normalize_Scalars is used). 27 | 28 | type Big_String_Ptr is access all Big_String; 29 | for Big_String_Ptr'Storage_Size use 0; 30 | -- We use this access type to pass a pointer to an area of storage to be 31 | -- accessed as a string. Of course when this pointer is used, it is the 32 | -- responsibility of the accessor to ensure proper bounds. The storage 33 | -- size clause ensures we do not allocate variables of this type. 34 | 35 | function To_Ptr is 36 | new Ada.Unchecked_Conversion (System.Address, Big_String_Ptr); 37 | 38 | type Exception_Data; 39 | type Exception_Data_Ptr is access all Exception_Data; 40 | type Raise_Action is access procedure; 41 | 42 | type Exception_Data is record 43 | Not_Handled_By_Others : Boolean; 44 | Lang : Character; 45 | Name_Length : Natural; 46 | Full_Name : System.Address; 47 | HTable_Ptr : Exception_Data_Ptr; 48 | Foreign_Data : System.Address; 49 | Raise_Hook : Raise_Action; 50 | end record; 51 | 52 | Constraint_Error_Name : constant String := "CONSTRAINT_ERROR" & ASCII.NUL; 53 | Constraint_Error_Def : aliased Exception_Data := 54 | (Not_Handled_By_Others => False, 55 | Lang => 'A', 56 | Name_Length => Constraint_Error_Name'Length, 57 | Full_Name => Constraint_Error_Name'Address, 58 | HTable_Ptr => null, 59 | Foreign_Data => Null_Address, 60 | Raise_Hook => null); 61 | pragma Export (C, Constraint_Error_Def, "constraint_error"); 62 | 63 | procedure Adafinal is null; 64 | 65 | -- Workaround for GNATBIND 8.1 / Pro 18.1: 66 | -- Enforce usage of secondary stack as GNATBIND generates binder 67 | -- output files which refer to System.Parameters for declaring 68 | -- Default_Secondary_Stack_Size even if no secondary stack is used, 69 | -- but only adds necessary withs when secondary stack is used 70 | function Dummy (S : String) return String is (S); 71 | 72 | end System.Standard_Library; 73 | -------------------------------------------------------------------------------- /src/lib/componolit-runtime-exceptions.ads: -------------------------------------------------------------------------------- 1 | -- AUTOGENERATED, edit doc/exceptions.md 2 | 3 | package Componolit.Runtime.Exceptions is 4 | pragma Pure; 5 | pragma Preelaborate; 6 | 7 | type Exception_Type is ( 8 | Undefined_Exception, 9 | CE_Explicit_Raise, 10 | CE_Access_Check, 11 | CE_Null_Access_Parameter, 12 | CE_Discriminant_Check, 13 | CE_Divide_By_Zero, 14 | CE_Index_Check, 15 | CE_Invalid_Data, 16 | CE_Length_Check, 17 | CE_Null_Exception_Id, 18 | CE_Null_Not_Allowed, 19 | CE_Overflow_Check, 20 | CE_Partition_Check, 21 | CE_Range_Check, 22 | CE_Tag_Check, 23 | PE_Explicit_Raise, 24 | PE_Access_Before_Elaboration, 25 | PE_Accessibility_Check, 26 | PE_Address_Of_Intrinsic, 27 | PE_Aliased_Parameters, 28 | PE_All_Guards_Closed, 29 | PE_Bad_Predicated_Generic_Type, 30 | PE_Current_Task_In_Entry_Body, 31 | PE_Duplicated_Entry_Address, 32 | PE_Implicit_Return, 33 | PE_Misaligned_Address_Value, 34 | PE_Missing_Return, 35 | PE_Overlaid_Controlled_Object, 36 | PE_Non_Transportable_Actual, 37 | PE_Potentially_Blocking_Operation, 38 | PE_Stream_Operation_Not_Allowed, 39 | PE_Stubbed_Subprogram_Called, 40 | PE_Unchecked_Union_Restriction, 41 | PE_Finalize_Raised_Exception, 42 | SE_Explicit_Raise, 43 | SE_Empty_Storage_Pool, 44 | SE_Infinite_Recursion, 45 | SE_Object_Too_Large 46 | ); 47 | 48 | for Exception_Type use ( 49 | Undefined_Exception => 16#0#, 50 | CE_Explicit_Raise => 16#100#, 51 | CE_Access_Check => 16#101#, 52 | CE_Null_Access_Parameter => 16#102#, 53 | CE_Discriminant_Check => 16#103#, 54 | CE_Divide_By_Zero => 16#104#, 55 | CE_Index_Check => 16#105#, 56 | CE_Invalid_Data => 16#106#, 57 | CE_Length_Check => 16#107#, 58 | CE_Null_Exception_Id => 16#108#, 59 | CE_Null_Not_Allowed => 16#109#, 60 | CE_Overflow_Check => 16#10a#, 61 | CE_Partition_Check => 16#10b#, 62 | CE_Range_Check => 16#10c#, 63 | CE_Tag_Check => 16#10d#, 64 | PE_Explicit_Raise => 16#200#, 65 | PE_Access_Before_Elaboration => 16#201#, 66 | PE_Accessibility_Check => 16#202#, 67 | PE_Address_Of_Intrinsic => 16#203#, 68 | PE_Aliased_Parameters => 16#204#, 69 | PE_All_Guards_Closed => 16#205#, 70 | PE_Bad_Predicated_Generic_Type => 16#206#, 71 | PE_Current_Task_In_Entry_Body => 16#207#, 72 | PE_Duplicated_Entry_Address => 16#208#, 73 | PE_Implicit_Return => 16#209#, 74 | PE_Misaligned_Address_Value => 16#20a#, 75 | PE_Missing_Return => 16#20b#, 76 | PE_Overlaid_Controlled_Object => 16#20c#, 77 | PE_Non_Transportable_Actual => 16#20d#, 78 | PE_Potentially_Blocking_Operation => 16#20e#, 79 | PE_Stream_Operation_Not_Allowed => 16#20f#, 80 | PE_Stubbed_Subprogram_Called => 16#210#, 81 | PE_Unchecked_Union_Restriction => 16#211#, 82 | PE_Finalize_Raised_Exception => 16#212#, 83 | SE_Explicit_Raise => 16#300#, 84 | SE_Empty_Storage_Pool => 16#301#, 85 | SE_Infinite_Recursion => 16#302#, 86 | SE_Object_Too_Large => 16#303# 87 | ); 88 | 89 | end Componolit.Runtime.Exceptions; 90 | -------------------------------------------------------------------------------- /contrib/gcc-9.3.1/s-memmov.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT RUN-TIME COMPONENTS -- 4 | -- -- 5 | -- S Y S T E M . M E M O R Y _ M O V E -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- Copyright (C) 2006-2020, Free Software Foundation, Inc. -- 10 | -- -- 11 | -- GNAT is free software; you can redistribute it and/or modify it under -- 12 | -- terms of the GNU General Public License as published by the Free Soft- -- 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- 17 | -- -- 18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 19 | -- additional permissions described in the GCC Runtime Library Exception, -- 20 | -- version 3.1, as published by the Free Software Foundation. -- 21 | -- -- 22 | -- You should have received a copy of the GNU General Public License and -- 23 | -- a copy of the GCC Runtime Library Exception along with this program; -- 24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25 | -- . -- 26 | -- -- 27 | -- GNAT was originally developed by the GNAT team at New York University. -- 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides a general block copy mechanism analogous to that 33 | -- provided by the C routine memmove allowing for copies with overlap. 34 | 35 | with System.Memory_Types; 36 | 37 | package System.Memory_Move is 38 | pragma No_Elaboration_Code_All; 39 | pragma Preelaborate; 40 | 41 | function memmove 42 | (Dest : Address; Src : Address; N : Memory_Types.size_t) return Address; 43 | pragma Export (C, memmove, "memmove"); 44 | -- Copies N storage units from area starting at Src to area starting 45 | -- at Dest without any check for buffer overflow. The difference between 46 | -- this memmove and memcpy is that with memmove, the storage areas may 47 | -- overlap (forwards or backwards) and the result is correct (i.e. it 48 | -- is as if Src is first moved to a temporary area, and then this area 49 | -- is copied to Dst in a separate step). 50 | 51 | end System.Memory_Move; 52 | -------------------------------------------------------------------------------- /platform/nrf52/drivers/componolit-runtime-drivers-gpio.ads: -------------------------------------------------------------------------------- 1 | 2 | package Componolit.Runtime.Drivers.GPIO with 3 | SPARK_Mode, 4 | Abstract_State => (Shadow_GPIO_Configuration, 5 | (GPIO_Configuration with External => (Async_Readers, 6 | Effective_Writes)), 7 | (GPIO_State with External => (Async_Readers, 8 | Async_Writers, 9 | Effective_Writes))), 10 | Initializes => (Shadow_GPIO_Configuration, 11 | GPIO_Configuration, 12 | GPIO_State) 13 | is 14 | 15 | pragma Unevaluated_Use_Of_Old (Allow); 16 | 17 | type Pin is range 0 .. 31; 18 | 19 | type Mode is (Port_In, Port_Out) with 20 | Size => 1; 21 | 22 | type Value is (Low, High); 23 | 24 | type Pin_Modes is array (Pin'Range) of Mode with 25 | Size => 32, 26 | Pack; 27 | 28 | type Configured_Pins is array (Pin'Range) of Boolean; 29 | 30 | function Pins_Configured return Configured_Pins with 31 | Ghost, 32 | Global => (Input => Shadow_GPIO_Configuration); 33 | 34 | function Configured (P : Pin) return Boolean with 35 | Ghost, 36 | Post => Configured'Result = Pins_Configured (P), 37 | Global => (Input => Shadow_GPIO_Configuration); 38 | 39 | function Proof_Modes return Pin_Modes with 40 | Ghost, 41 | Global => (Input => Shadow_GPIO_Configuration); 42 | 43 | procedure Configure (P : Pin; M : Mode) with 44 | Post => Configured (P) 45 | and then Pin_Mode (P) = M 46 | and then (for all Pn in Pin => 47 | (if Pn /= P then Proof_Modes (Pn) = 48 | Proof_Modes'Old (Pn))) 49 | and then (for all Pn in Pin => 50 | (if Pn /= P then Pins_Configured (Pn) = 51 | Pins_Configured'Old (Pn))), 52 | Global => (In_Out => Shadow_GPIO_Configuration, 53 | Output => GPIO_Configuration); 54 | 55 | function Pin_Mode (P : Pin) return Mode with 56 | Pre => Configured (P), 57 | Post => Pin_Mode'Result = Proof_Modes (P), 58 | Global => (Input => Shadow_GPIO_Configuration), 59 | Ghost; 60 | 61 | procedure Write (P : Pin; V : Value) with 62 | Pre => Configured (P) 63 | and then Pin_Mode (P) = Port_Out, 64 | Global => (In_Out => GPIO_State, 65 | Proof_In => Shadow_GPIO_Configuration); 66 | 67 | procedure Read (P : Pin; V : out Value) with 68 | Pre => Configured (P) 69 | and then Pin_Mode (P) in Port_In | Port_Out, 70 | Global => (Input => (GPIO_Configuration, GPIO_State), 71 | Proof_In => Shadow_GPIO_Configuration); 72 | 73 | private 74 | 75 | for Mode use (Port_In => 0, Port_Out => 1); 76 | 77 | type Pin_Value is range 0 .. 1 with 78 | Size => 1; 79 | 80 | type Pin_Values is array (Pin'Range) of Pin_Value with 81 | Size => 32, 82 | Pack; 83 | 84 | OUT_Offset : constant SSE.Integer_Address := 16#504#; 85 | OUTSET_Offset : constant SSE.Integer_Address := 16#508#; 86 | OUTCLR_Offset : constant SSE.Integer_Address := 16#50C#; 87 | IN_Offset : constant SSE.Integer_Address := 16#510#; 88 | DIR_Offset : constant SSE.Integer_Address := 16#514#; 89 | 90 | end Componolit.Runtime.Drivers.GPIO; 91 | -------------------------------------------------------------------------------- /LICENSE.RUNTIME: -------------------------------------------------------------------------------- 1 | GCC RUNTIME LIBRARY EXCEPTION 2 | 3 | Version 3.1, 31 March 2009 4 | 5 | Copyright (c) 2009 Free Software Foundation, Inc. 6 | 7 | Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. 8 | 9 | This GCC Runtime Library Exception ("Exception") is an additional permission under section 7 of the GNU General Public License, 10 | version 3 ("GPLv3"). It applies to a given file (the "Runtime Library") that bears a notice placed by the copyright holder of 11 | the file stating that the file is governed by GPLv3 along with this Exception. 12 | 13 | When you use GCC to compile a program, GCC may combine portions of certain GCC header files and runtime libraries with the 14 | compiled program. The purpose of this Exception is to allow compilation of non-GPL (including proprietary) programs to 15 | use, in this way, the header files and runtime libraries covered by this Exception. 16 | 17 | 0. Definitions. 18 | 19 | A file is an "Independent Module" if it either requires the Runtime Library for execution after a Compilation 20 | Process, or makes use of an interface provided by the Runtime Library, but is not otherwise based on the Runtime Library. 21 | 22 | "GCC" means a version of the GNU Compiler Collection, with or without modifications, governed by version 3 23 | (or a specified later version) of the GNU General Public License (GPL) with the option of using any subsequent 24 | versions published by the FSF. 25 | 26 | "GPL-compatible Software" is software whose conditions of propagation, modification and use would permit combination 27 | with GCC in accord with the license of GCC. 28 | 29 | "Target Code" refers to output from any compiler for a real or virtual target processor architecture, in executable 30 | form or suitable for input to an assembler, loader, linker and/or execution phase. Notwithstanding that, Target Code 31 | does not include data in any format that is used as a compiler intermediate representation, or used for producing a 32 | compiler intermediate representation. 33 | 34 | The "Compilation Process" transforms code entirely represented in non-intermediate languages designed for human-written 35 | code, and/or in Java Virtual Machine byte code, into Target Code. Thus, for example, use of source code generators and 36 | preprocessors need not be considered part of the Compilation Process, since the Compilation Process can be understood as 37 | starting with the output of the generators or preprocessors. 38 | 39 | A Compilation Process is "Eligible" if it is done using GCC, alone or with other GPL-compatible software, or if it is 40 | done without using any work based on GCC. For example, using non-GPL-compatible Software to optimize any GCC 41 | intermediate representations would not qualify as an Eligible Compilation Process. 42 | 43 | 1. Grant of Additional Permission. 44 | 45 | You have permission to propagate a work of Target Code formed by combining the Runtime Library with Independent Modules, 46 | even if such propagation would otherwise violate the terms of GPLv3, provided that all Target Code was generated by 47 | Eligible Compilation Processes. You may then convey such a combination under terms of your choice, consistent with the 48 | licensing of the Independent Modules. 49 | 50 | 2. No Weakening of GCC Copyleft. 51 | 52 | The availability of this Exception does not imply any general presumption that third-party software is unaffected by 53 | the copyleft requirements of the license of GCC. 54 | -------------------------------------------------------------------------------- /tests/unit/componolit-runtime-strings-tests.adb: -------------------------------------------------------------------------------- 1 | with System; 2 | with Aunit.Assertions; 3 | 4 | package body Componolit.Runtime.Strings.Tests is 5 | 6 | ------------------- 7 | -- Test routines -- 8 | ------------------- 9 | 10 | procedure Test_Length (T : in out Aunit.Test_Cases.Test_Case'Class) 11 | is 12 | pragma Unreferenced (T); 13 | Ada_String : String := "Hello world!"; 14 | C_String : String := Ada_String & Character'Val (0); 15 | Null_String : System.Address := System.Null_Address; 16 | begin 17 | Aunit.Assertions.Assert (Length (C_String'Address) = Ada_String'Length, 18 | "Length test failed"); 19 | Aunit.Assertions.Assert (Length (C_String'Address, 5) = 5, 20 | "Maximum length test failed"); 21 | Aunit.Assertions.Assert (Length (Null_String) = 0, 22 | "Null pointer length test failed"); 23 | end Test_Length; 24 | 25 | procedure Test_Convert_To_Ada (T : in out Aunit.Test_Cases.Test_Case'Class) 26 | is 27 | pragma Unreferenced (T); 28 | Ada_String : String := "Hello world!"; 29 | C_String : String := Ada_String & Character'Val (0); 30 | Null_String : System.Address := System.Null_Address; 31 | Default_String : String := "Default"; 32 | begin 33 | Aunit.Assertions.Assert (Convert_To_Ada (C_String'Address, "") = Ada_String, 34 | "String conversion test failed"); 35 | Aunit.Assertions.Assert (Convert_To_Ada (C_String'Address, "", 5) = "Hello", 36 | "String conversion with maximum length test failed"); 37 | Aunit.Assertions.Assert (Convert_To_Ada (Null_String, Default_String) = 38 | Default_String, 39 | "String conversion with null pointer test failed"); 40 | end Test_Convert_To_Ada; 41 | 42 | procedure Test_Image (T : in out Aunit.Test_Cases.Test_Case'Class) 43 | is 44 | pragma Unreferenced (T); 45 | S_Null : constant String := "0"; 46 | S_Minus : constant String := "-1"; 47 | S_First : constant String := "-2147483648"; 48 | S_Last : constant String := "2147483647"; 49 | I_Null : constant String := Image (0); 50 | I_Minus : constant String := Image (-1); 51 | I_First : constant String := Image (Integer'First); 52 | I_Last : constant String := Image (Integer'Last); 53 | begin 54 | Aunit.Assertions.Assert (I_Null, S_Null, "Image S_Null failed"); 55 | Aunit.Assertions.Assert (I_Minus, S_Minus, "Image S_Minus failed"); 56 | Aunit.Assertions.Assert (I_First, S_First, "Image S_First failed"); 57 | Aunit.Assertions.Assert (I_Last, S_Last, "Image S_Last failed"); 58 | end Test_Image; 59 | 60 | -------------------- 61 | -- Register_Tests -- 62 | -------------------- 63 | 64 | procedure Register_Tests (T : in out Test_Case) is 65 | use AUnit.Test_Cases.Registration; 66 | begin 67 | Register_Routine (T, Test_Length'Access, "Test Length"); 68 | Register_Routine (T, Test_Convert_To_Ada'Access, 69 | "Test Convert_To_Ada"); 70 | Register_Routine (T, Test_Image'Access, "Test Image"); 71 | end Register_Tests; 72 | 73 | ---------- 74 | -- Name -- 75 | ---------- 76 | 77 | function Name (T : Test_Case) return Aunit.Message_String is 78 | begin 79 | return Aunit.Format ("Componolit.Runtime.Strings"); 80 | end Name; 81 | 82 | end Componolit.Runtime.Strings.Tests; 83 | -------------------------------------------------------------------------------- /contrib/gcc-9.3.1/s-memcop.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT RUN-TIME COMPONENTS -- 4 | -- -- 5 | -- S Y S T E M . M E M O R Y _ C O P Y -- 6 | -- -- 7 | -- B o d y -- 8 | -- -- 9 | -- Copyright (C) 2006-2020, Free Software Foundation, Inc. -- 10 | -- -- 11 | -- GNAT is free software; you can redistribute it and/or modify it under -- 12 | -- terms of the GNU General Public License as published by the Free Soft- -- 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- 17 | -- -- 18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 19 | -- additional permissions described in the GCC Runtime Library Exception, -- 20 | -- version 3.1, as published by the Free Software Foundation. -- 21 | -- -- 22 | -- You should have received a copy of the GNU General Public License and -- 23 | -- a copy of the GCC Runtime Library Exception along with this program; -- 24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25 | -- . -- 26 | -- -- 27 | -- GNAT was originally developed by the GNAT team at New York University. -- 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with System.Memory_Types; use System.Memory_Types; 33 | 34 | package body System.Memory_Copy is 35 | 36 | ------------ 37 | -- memcpy -- 38 | ------------ 39 | 40 | function memcpy 41 | (Dest : Address; Src : Address; N : size_t) return Address 42 | is 43 | D : IA := To_IA (Dest); 44 | S : IA := To_IA (Src); 45 | C : size_t := N; 46 | 47 | begin 48 | -- Try to copy per word, if alignment constraints are respected 49 | 50 | if ((D or S) and (Word'Alignment - 1)) = 0 then 51 | while C >= Word_Unit loop 52 | To_Word_Ptr (D).all := To_Word_Ptr (S).all; 53 | D := D + Word_Unit; 54 | S := S + Word_Unit; 55 | C := C - Word_Unit; 56 | end loop; 57 | end if; 58 | 59 | -- Copy the remaining byte per byte 60 | 61 | while C > 0 loop 62 | To_Byte_Ptr (D).all := To_Byte_Ptr (S).all; 63 | D := D + Byte_Unit; 64 | S := S + Byte_Unit; 65 | C := C - Byte_Unit; 66 | end loop; 67 | 68 | return Dest; 69 | end memcpy; 70 | 71 | end System.Memory_Copy; 72 | -------------------------------------------------------------------------------- /tests/platform/nrf52/link.ld: -------------------------------------------------------------------------------- 1 | 2 | 3 | /* This is a ARM specific version of this file */ 4 | 5 | /* This script replaces ld's default linker script, providing the 6 | appropriate memory map and output format. */ 7 | 8 | SEARCH_DIR(.) 9 | __DYNAMIC = 0; 10 | 11 | _DEFAULT_STACK_SIZE = 2048; 12 | 13 | ENTRY(_start); 14 | 15 | MEMORY 16 | { 17 | flash (rx) : ORIGIN = 0x0, LENGTH = 0x80000 18 | sram (rwx) : ORIGIN = 0x20000000, LENGTH = 0x10000 19 | } 20 | 21 | /* 22 | * Boot memory (.text, .ro_data, interrupt vector): flash 23 | * Main RAM memory (.data, .bss, stacks, interrupt stacks): flash 24 | */ 25 | 26 | SECTIONS 27 | { 28 | 29 | .text : 30 | { 31 | KEEP (*(.vectors)) 32 | *(.text .text.* .gnu.linkonce.t*) 33 | *(.gnu.warning) 34 | } > flash 35 | 36 | .ARM.extab : { *(.ARM.extab* .gnu.linkonce.armextab.*) } > flash 37 | PROVIDE_HIDDEN (__exidx_start = .); 38 | .ARM.exidx : { *(.ARM.exidx* .gnu.linkonce.armexidx.*) } > flash 39 | PROVIDE_HIDDEN (__exidx_end = .); 40 | 41 | .rodata : 42 | { 43 | *(.lit) 44 | *(.rodata .rodata.* .gnu.linkonce.r*) 45 | . = ALIGN(0x4); 46 | __rom_end = .; 47 | } > flash 48 | 49 | __data_load = LOADADDR(.data); 50 | .data : 51 | { 52 | __data_start = .; 53 | *(.data .data.* .gnu.linkonce.d*) 54 | 55 | /* Ensure that the end of the data section is always word aligned. 56 | Initial values are stored in 4-bytes blocks so we must guarantee 57 | that these blocks do not fall out the section (otherwise they are 58 | truncated and the initial data for the last block are lost). */ 59 | 60 | . = ALIGN(0x4); 61 | __data_end = .; 62 | } > sram AT> flash 63 | __data_words = (__data_end - __data_start) >> 2; 64 | 65 | 66 | 67 | .bss (NOLOAD): { 68 | . = ALIGN(0x8); 69 | __bss_start = .; 70 | 71 | *(.bss .bss.*) 72 | *(COMMON) 73 | 74 | . = ALIGN(0x8); /* Align the stack to 64 bits */ 75 | __bss_end = .; 76 | 77 | __interrupt_stack_start = .; 78 | *(.interrupt_stacks) 79 | . = ALIGN(0x8); 80 | __interrupt_stack_end = .; 81 | 82 | __stack_start = .; 83 | . += DEFINED (__stack_size) ? __stack_size : _DEFAULT_STACK_SIZE; 84 | . = ALIGN(0x8); 85 | __stack_end = .; 86 | 87 | _end = .; 88 | __heap_start = .; 89 | __heap_end = ORIGIN(sram) + LENGTH(sram); 90 | } > sram 91 | __bss_words = (__bss_end - __bss_start) >> 2; 92 | 93 | 94 | /* DWARF debug sections. 95 | Symbols in the DWARF debugging sections are relative to the beginning 96 | of the section so we begin them at 0. */ 97 | /* DWARF 1 */ 98 | .debug 0 : { *(.debug) } 99 | .line 0 : { *(.line) } 100 | /* GNU DWARF 1 extensions */ 101 | .debug_srcinfo 0 : { *(.debug_srcinfo) } 102 | .debug_sfnames 0 : { *(.debug_sfnames) } 103 | /* DWARF 1.1 and DWARF 2 */ 104 | .debug_aranges 0 : { *(.debug_aranges) } 105 | .debug_pubnames 0 : { *(.debug_pubnames) } 106 | /* DWARF 2 */ 107 | .debug_info 0 : { *(.debug_info .gnu.linkonce.wi.*) } 108 | .debug_abbrev 0 : { *(.debug_abbrev) } 109 | .debug_line 0 : { *(.debug_line) } 110 | .debug_frame 0 : { *(.debug_frame) } 111 | .debug_str 0 : { *(.debug_str) } 112 | .debug_loc 0 : { *(.debug_loc) } 113 | .debug_macinfo 0 : { *(.debug_macinfo) } 114 | /* DWARF 3 */ 115 | .debug_pubtypes 0 : { *(.debug_pubtypes) } 116 | .debug_ranges 0 : { *(.debug_ranges) } 117 | .gnu.attributes 0 : { KEEP (*(.gnu.attributes)) } 118 | /DISCARD/ : { *(.note.GNU-stack) *(.gnu_debuglink) *(.gnu.lto_*) } 119 | } -------------------------------------------------------------------------------- /tests/platform/stm32f0/link.ld: -------------------------------------------------------------------------------- 1 | 2 | 3 | /* This is a ARM specific version of this file */ 4 | 5 | /* This script replaces ld's default linker script, providing the 6 | appropriate memory map and output format. */ 7 | 8 | SEARCH_DIR(.) 9 | __DYNAMIC = 0; 10 | 11 | _DEFAULT_STACK_SIZE = 2048; 12 | 13 | ENTRY(_start); 14 | 15 | MEMORY 16 | { 17 | flash (rx) : ORIGIN = 0x8000000, LENGTH = 0x10000 18 | sram (rwx) : ORIGIN = 0x20000000, LENGTH = 0x2000 19 | } 20 | 21 | /* 22 | * Boot memory (.text, .ro_data, interrupt vector): flash 23 | * Main RAM memory (.data, .bss, stacks, interrupt stacks): flash 24 | */ 25 | 26 | SECTIONS 27 | { 28 | 29 | .text : 30 | { 31 | KEEP (*(.vectors)) 32 | *(.text .text.* .gnu.linkonce.t*) 33 | *(.gnu.warning) 34 | } > flash 35 | 36 | .ARM.extab : { *(.ARM.extab* .gnu.linkonce.armextab.*) } > flash 37 | PROVIDE_HIDDEN (__exidx_start = .); 38 | .ARM.exidx : { *(.ARM.exidx* .gnu.linkonce.armexidx.*) } > flash 39 | PROVIDE_HIDDEN (__exidx_end = .); 40 | 41 | .rodata : 42 | { 43 | *(.lit) 44 | *(.rodata .rodata.* .gnu.linkonce.r*) 45 | . = ALIGN(0x4); 46 | __rom_end = .; 47 | } > flash 48 | 49 | __data_load = LOADADDR(.data); 50 | .data : 51 | { 52 | __data_start = .; 53 | *(.data .data.* .gnu.linkonce.d*) 54 | 55 | /* Ensure that the end of the data section is always word aligned. 56 | Initial values are stored in 4-bytes blocks so we must guarantee 57 | that these blocks do not fall out the section (otherwise they are 58 | truncated and the initial data for the last block are lost). */ 59 | 60 | . = ALIGN(0x4); 61 | __data_end = .; 62 | } > sram AT> flash 63 | __data_words = (__data_end - __data_start) >> 2; 64 | 65 | 66 | 67 | .bss (NOLOAD): { 68 | . = ALIGN(0x8); 69 | __bss_start = .; 70 | 71 | *(.bss .bss.*) 72 | *(COMMON) 73 | 74 | . = ALIGN(0x8); /* Align the stack to 64 bits */ 75 | __bss_end = .; 76 | 77 | __interrupt_stack_start = .; 78 | *(.interrupt_stacks) 79 | . = ALIGN(0x8); 80 | __interrupt_stack_end = .; 81 | 82 | __stack_start = .; 83 | . += DEFINED (__stack_size) ? __stack_size : _DEFAULT_STACK_SIZE; 84 | . = ALIGN(0x8); 85 | __stack_end = .; 86 | 87 | _end = .; 88 | __heap_start = .; 89 | __heap_end = ORIGIN(sram) + LENGTH(sram); 90 | } > sram 91 | __bss_words = (__bss_end - __bss_start) >> 2; 92 | 93 | 94 | /* DWARF debug sections. 95 | Symbols in the DWARF debugging sections are relative to the beginning 96 | of the section so we begin them at 0. */ 97 | /* DWARF 1 */ 98 | .debug 0 : { *(.debug) } 99 | .line 0 : { *(.line) } 100 | /* GNU DWARF 1 extensions */ 101 | .debug_srcinfo 0 : { *(.debug_srcinfo) } 102 | .debug_sfnames 0 : { *(.debug_sfnames) } 103 | /* DWARF 1.1 and DWARF 2 */ 104 | .debug_aranges 0 : { *(.debug_aranges) } 105 | .debug_pubnames 0 : { *(.debug_pubnames) } 106 | /* DWARF 2 */ 107 | .debug_info 0 : { *(.debug_info .gnu.linkonce.wi.*) } 108 | .debug_abbrev 0 : { *(.debug_abbrev) } 109 | .debug_line 0 : { *(.debug_line) } 110 | .debug_frame 0 : { *(.debug_frame) } 111 | .debug_str 0 : { *(.debug_str) } 112 | .debug_loc 0 : { *(.debug_loc) } 113 | .debug_macinfo 0 : { *(.debug_macinfo) } 114 | /* DWARF 3 */ 115 | .debug_pubtypes 0 : { *(.debug_pubtypes) } 116 | .debug_ranges 0 : { *(.debug_ranges) } 117 | .gnu.attributes 0 : { KEEP (*(.gnu.attributes)) } 118 | /DISCARD/ : { *(.note.GNU-stack) *(.gnu_debuglink) *(.gnu.lto_*) } 119 | } -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | VERBOSE ?= @ 2 | BOARD ?= default 3 | GNAT_VERSION ?= 12.1.2 4 | GNAT_ESCAPED_VERSION := $(subst .,_,$(GNAT_VERSION)) 5 | 6 | TEST_DIR = tests/system 7 | UNIT_DIR = tests/unit 8 | 9 | SRC_COMMON = a-except.adb \ 10 | a-unccon.ads \ 11 | ada.ads \ 12 | a-tags.ads \ 13 | a-tags.adb \ 14 | a-numeri.ads \ 15 | a-nubinu.ads \ 16 | a-nbnbin.adb \ 17 | i-c.adb \ 18 | i-cexten.ads \ 19 | interfac.ads \ 20 | componolit.ads \ 21 | componolit-runtime.ads \ 22 | componolit-runtime-strings.adb \ 23 | componolit-runtime-debug.adb \ 24 | componolit-runtime-platform.adb \ 25 | componolit-runtime-exceptions.ads \ 26 | componolit-runtime-conversions.adb \ 27 | s-exctab.adb \ 28 | s-init.adb \ 29 | s-parame.adb \ 30 | s-unstyp.ads \ 31 | s-secsta.adb \ 32 | s-soflin.adb \ 33 | s-stalib.adb \ 34 | s-stoele.adb \ 35 | s-arit64.adb \ 36 | s-maccod.ads \ 37 | system.ads \ 38 | argv.c \ 39 | exit.c \ 40 | init.c \ 41 | componolit_runtime.h \ 42 | ada_exceptions.h \ 43 | gnat_helpers.h 44 | 45 | .PHONY: posix esp8266 46 | 47 | posix: 48 | make SRC_COMMON="$(SRC_COMMON)" -C build/posix 49 | 50 | esp8266: 51 | make SRC_COMMON="$(SRC_COMMON)" -C build/arduino_esp8266 52 | 53 | nrf52: 54 | make BOARD=$(BOARD) SRC_COMMON="$(SRC_COMMON)" -C build/nrf52 55 | 56 | stm32f0: 57 | make BOARD=$(BOARD) SRC_COMMON="$(SRC_COMMON)" -C build/stm32f0 58 | 59 | TEST_DIRS = $(addprefix $(TEST_DIR)/,$(shell ls tests/system)) 60 | TEST_BINS = $(addsuffix /test,$(TEST_DIRS)) 61 | 62 | $(TEST_DIR)/%/test: 63 | @echo "TEST $(dir $@)" 64 | $(VERBOSE)cd $(dir $@) && gprbuild -p -q --RTS=../../../build/posix/obj -p && ./test 65 | 66 | $(TEST_DIR)/exception/test: 67 | @echo "TEST $(dir $@)" 68 | $(VERBOSE)cd $(dir $@) && gprbuild -p -q --RTS=../../../build/posix/obj -p && ./test; test $$? -gt 0 69 | 70 | $(UNIT_DIR)/test: 71 | @echo "UNITTEST $(dir $@)" 72 | $(VERBOSE)cd $(dir $@) && gprbuild -p -q -P test && ./test 73 | 74 | test: posix clean_test $(TEST_BINS) $(UNIT_DIR)/test 75 | 76 | REPORT ?= fail 77 | 78 | proof: stm32f0 nrf52 79 | $(VERBOSE)gnatprove --level=3 --checks-as-errors -j0 -Psrc/componolit_runtime.gpr -XOBJECT_DIR=$(OBJ_DIR) --info --report=$(REPORT) 80 | $(VERBOSE)gnatprove --level=4 --checks-as-errors -j0 -Pplatform/stm32f0/drivers.gpr -XOBJECT_DIR=$(OBJ_DIR) --info --report=$(REPORT) 81 | $(VERBOSE)gnatprove --level=3 --checks-as-errors -j0 -Pplatform/nrf52/drivers.gpr -XOBJECT_DIR=$(OBJ_DIR) --info --report=$(REPORT) 82 | $(VERBOSE)gnatprove --level=3 --checks-as-errors -j0 -Ptests/platform/stm32f0/test.gpr -XOBJECT_DIR=$(OBJ_DIR) --info --report=$(REPORT) 83 | $(VERBOSE)gnatprove --level=3 --checks-as-errors -j0 -Ptests/platform/nrf52/test.gpr -XOBJECT_DIR=$(OBJ_DIR) --info --report=$(REPORT) 84 | 85 | install_gnat: 86 | alr toolchain --install gnat_native=$(GNAT_VERSION) && \ 87 | alr toolchain --select gnat_native=$(GNAT_VERSION) && \ 88 | mkdir -p build && \ 89 | cd build && \ 90 | alr -n init --lib gnat_$(GNAT_ESCAPED_VERSION) && \ 91 | cd gnat_$(GNAT_ESCAPED_VERSION) && \ 92 | alr -n with aunit 93 | 94 | printenv_gnat: 95 | @test -d build/gnat_$(GNAT_ESCAPED_VERSION) && \ 96 | cd build/gnat_$(GNAT_ESCAPED_VERSION) && \ 97 | alr printenv 98 | 99 | clean: clean_test 100 | make -C build/posix clean 101 | make -C build/arduino_esp8266 clean 102 | make -C build/nrf52 clean 103 | make -C build/stm32f0 clean 104 | 105 | clean_test: 106 | $(VERBOSE)$(foreach DIR,$(TEST_DIRS) $(UNIT_DIR),cd $(DIR) && gprclean -q -Ptest -r; cd -;) 107 | -------------------------------------------------------------------------------- /doc/Platform-interface.md: -------------------------------------------------------------------------------- 1 | # Componolit runtime platform interface 2 | 3 | The Componolit runtime platform interface defines a linker interface the platform must provide. 4 | That interface can either be implemented in C using [`componolit_runtime.h`](../platform/componolit_runtime.h) or in Ada using [`componolit_runtime.ads`](../platform/componolit_runtime.ads). 5 | The table below shows the symbol names and language signatures to implement. 6 | Note that the Ada signatures are not ABI compatible to the C signatures. 7 | This has been done to simplify the support of native Ada platforms. 8 | The package [`Componolit_Runtime.C`](../platform/componolit_runtime-c.ads) does the required conversions. 9 | 10 | | Symbol | C signature | Ada signature | 11 | |------------------------------------------|---------------------------------------------------------------------------|-----------------------------------------------------------------------------------| 12 | | `componolit_runtime_log` | `void componolit_runtime_log(char *)` | `procedure Log (Msg : String)` | 13 | | `componolit_runtime_raise_ada_exception` | `void componolit_runtime_raise_ada_exception(exception_t, char *, char*)` | `procedure Raise_Ada_Exception (T : Exception_Type; Name : String; Msg : String)` | 14 | | `componolit_runtime_initialize` | `void componolit_runtime_initialize(void)` | `procedure Initialize` | 15 | | `componolit_runtime_finalize` | `void componolit_runtime_finalize(void)` | `procedure Finalize` | 16 | 17 | 18 | ## Symbol definitions 19 | 20 | ### `componolit_runtime_log` 21 | 22 | #### Signature 23 | 24 | - C: `void componolit_runtime_log(const char *)` 25 | - Ada: `procedure Log (Msg : String)` 26 | 27 | * Msg: Log message 28 | 29 | #### Semantics 30 | 31 | Prints log message. Intended for debugging. 32 | 33 | ### `componolit_runtime_raise_ada_exception` 34 | 35 | #### Signature 36 | 37 | - C: `void componolit_runtime_raise_ada_exception(exception_t, char *, char*)` 38 | - Ada: `procedure Raise_Ada_Exception(T : Exception_Type; Name : String; Msg : String)` 39 | 40 | * T: Type of the exception (enum) 41 | * Name: Name of the raised exception (or short description) 42 | * Msg: Exception message 43 | 44 | #### Semantics 45 | 46 | Called when any exception is raised. The Name is usually the name of the Ada exception or a short description of it. In this runtime Msg consists of the file name and line number of the exception occurrence. 47 | 48 | ### `componolit_runtime_initialize` 49 | 50 | #### Signature 51 | 52 | - C: `void componolit_runtime_initialize(void)` 53 | - Ada: `procedure Initialize` 54 | 55 | #### Semantics 56 | 57 | Called in `adainit` when the runtime gets initialized by the binder. 58 | Implementation can be empty. 59 | 60 | ### `componolit_runtime_finalize` 61 | 62 | #### Signature 63 | 64 | - C: `void componolit_runtime_finalize(void)` 65 | - Ada: `procedure Finalize` 66 | 67 | #### Semantics 68 | 69 | Called in `adafinal` when the runtime is finalized by the binder. 70 | Implementation can be empty. 71 | 72 | ## Other symbols 73 | 74 | When porting the runtime to a platform ther can be other missing symbols, often starting with `__gnat_`. 75 | These are functions inserted by the compiler for memory management and exception handling. 76 | As they are highly platform dependent and are not required by the runtime code to work they are not listed here. 77 | -------------------------------------------------------------------------------- /contrib/gcc-9.3.1/s-memcom.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT RUN-TIME COMPONENTS -- 4 | -- -- 5 | -- S Y S T E M . M E M O R Y _ C O M P A R E -- 6 | -- -- 7 | -- B o d y -- 8 | -- -- 9 | -- Copyright (C) 2006-2020, Free Software Foundation, Inc. -- 10 | -- -- 11 | -- GNAT is free software; you can redistribute it and/or modify it under -- 12 | -- terms of the GNU General Public License as published by the Free Soft- -- 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- 17 | -- -- 18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 19 | -- additional permissions described in the GCC Runtime Library Exception, -- 20 | -- version 3.1, as published by the Free Software Foundation. -- 21 | -- -- 22 | -- You should have received a copy of the GNU General Public License and -- 23 | -- a copy of the GCC Runtime Library Exception along with this program; -- 24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25 | -- . -- 26 | -- -- 27 | -- GNAT was originally developed by the GNAT team at New York University. -- 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with System.Memory_Types; use System.Memory_Types; 33 | 34 | package body System.Memory_Compare is 35 | 36 | ------------ 37 | -- memcmp -- 38 | ------------ 39 | 40 | function memcmp (S1 : Address; S2 : Address; N : size_t) return Integer is 41 | S1_A : IA := To_IA (S1); 42 | S2_A : IA := To_IA (S2); 43 | C : size_t := N; 44 | V1, V2 : Byte; 45 | 46 | begin 47 | -- Try to compare word by word if alignment constraints are respected. 48 | -- Compare as long as words are equal. 49 | 50 | if ((S1_A or S2_A) and (Word'Alignment - 1)) = 0 then 51 | while C >= Word_Unit loop 52 | exit when To_Word_Ptr (S1_A).all /= To_Word_Ptr (S2_A).all; 53 | S1_A := S1_A + Word_Unit; 54 | S2_A := S2_A + Word_Unit; 55 | C := C - Word_Unit; 56 | end loop; 57 | end if; 58 | 59 | -- Finish byte per byte 60 | 61 | while C > 0 loop 62 | V1 := To_Byte_Ptr (S1_A).all; 63 | V2 := To_Byte_Ptr (S2_A).all; 64 | if V1 < V2 then 65 | return -1; 66 | elsif V1 > V2 then 67 | return 1; 68 | end if; 69 | 70 | S1_A := S1_A + Byte_Unit; 71 | S2_A := S2_A + Byte_Unit; 72 | C := C - Byte_Unit; 73 | end loop; 74 | 75 | return 0; 76 | end memcmp; 77 | 78 | end System.Memory_Compare; 79 | -------------------------------------------------------------------------------- /contrib/gcc-9.3.1/s-memset.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT RUN-TIME COMPONENTS -- 4 | -- -- 5 | -- S Y S T E M . M E M O R Y _ S E T -- 6 | -- -- 7 | -- B o d y -- 8 | -- -- 9 | -- Copyright (C) 2006-2020, Free Software Foundation, Inc. -- 10 | -- -- 11 | -- GNAT is free software; you can redistribute it and/or modify it under -- 12 | -- terms of the GNU General Public License as published by the Free Soft- -- 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- 17 | -- -- 18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 19 | -- additional permissions described in the GCC Runtime Library Exception, -- 20 | -- version 3.1, as published by the Free Software Foundation. -- 21 | -- -- 22 | -- You should have received a copy of the GNU General Public License and -- 23 | -- a copy of the GCC Runtime Library Exception along with this program; -- 24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25 | -- . -- 26 | -- -- 27 | -- GNAT was originally developed by the GNAT team at New York University. -- 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with System; use System; 33 | with System.Memory_Types; use System.Memory_Types; 34 | 35 | package body System.Memory_Set is 36 | 37 | function Shift_Left (V : Word; Amount : Natural) return Word; 38 | pragma Import (Intrinsic, Shift_Left); 39 | 40 | ------------ 41 | -- memset -- 42 | ------------ 43 | 44 | function memset (M : Address; C : Integer; Size : size_t) return Address is 45 | B : constant Byte := Byte (C mod 256); 46 | D : IA := To_IA (M); 47 | N : size_t := Size; 48 | CW : Word; 49 | 50 | begin 51 | -- Try to set per word, if alignment constraints are respected 52 | 53 | if (D and (Word'Alignment - 1)) = 0 then 54 | CW := Word (B); 55 | CW := Shift_Left (CW, 8) or CW; 56 | CW := Shift_Left (CW, 16) or CW; 57 | 58 | -- For 64 bit machine (condition is always true/false) 59 | pragma Warnings (Off); 60 | if Word_Unit > 4 then 61 | CW := Shift_Left (CW, 32) or CW; 62 | end if; 63 | pragma Warnings (On); 64 | 65 | while N >= Word_Unit loop 66 | To_Word_Ptr (D).all := CW; 67 | N := N - Word_Unit; 68 | D := D + Word_Unit; 69 | end loop; 70 | end if; 71 | 72 | -- Set the remaining byte per byte 73 | 74 | while N > 0 loop 75 | To_Byte_Ptr (D).all := B; 76 | N := N - Byte_Unit; 77 | D := D + Byte_Unit; 78 | end loop; 79 | 80 | return M; 81 | end memset; 82 | 83 | end System.Memory_Set; 84 | -------------------------------------------------------------------------------- /contrib/gcc-9.3.1/s-memtyp.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT RUN-TIME COMPONENTS -- 4 | -- -- 5 | -- S Y S T E M . M E M O R Y _ T Y P E S -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- Copyright (C) 2017-2020, Free Software Foundation, Inc. -- 10 | -- -- 11 | -- GNAT is free software; you can redistribute it and/or modify it under -- 12 | -- terms of the GNU General Public License as published by the Free Soft- -- 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- 17 | -- -- 18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 19 | -- additional permissions described in the GCC Runtime Library Exception, -- 20 | -- version 3.1, as published by the Free Software Foundation. -- 21 | -- -- 22 | -- You should have received a copy of the GNU General Public License and -- 23 | -- a copy of the GCC Runtime Library Exception along with this program; -- 24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25 | -- . -- 26 | -- -- 27 | -- GNAT was originally developed by the GNAT team at New York University. -- 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with Ada.Unchecked_Conversion; 33 | 34 | package System.Memory_Types is 35 | pragma No_Elaboration_Code_All; 36 | pragma Preelaborate; 37 | 38 | type size_t is mod 2 ** Standard'Address_Size; 39 | -- The type corresponding to size_t in C. We cannot reuse the one defined 40 | -- in Interfaces.C as we want this package not to have any elaboration 41 | -- code. 42 | 43 | type IA is mod System.Memory_Size; 44 | -- The type used to provide the actual desired operations 45 | 46 | function To_IA is new Ada.Unchecked_Conversion (Address, IA); 47 | -- The operations are implemented by unchecked conversion to type IA, 48 | -- followed by doing the intrinsic operation on the IA values, followed 49 | -- by converting the result back to type Address. 50 | 51 | type Byte is mod 2 ** 8; 52 | for Byte'Size use 8; 53 | -- Byte is the storage unit 54 | 55 | type Byte_Ptr is access Byte; 56 | -- Access to a byte 57 | 58 | function To_Byte_Ptr is new Ada.Unchecked_Conversion (IA, Byte_Ptr); 59 | -- Conversion between an integer address and access to byte 60 | 61 | Byte_Unit : constant := 1; 62 | -- Number of storage unit in a byte 63 | 64 | type Word is mod 2 ** System.Word_Size; 65 | for Word'Size use System.Word_Size; 66 | -- Word is efficiently loaded and stored by the processor, but has 67 | -- alignment constraints. 68 | 69 | type Word_Ptr is access Word; 70 | -- Access to a word. 71 | 72 | function To_Word_Ptr is new Ada.Unchecked_Conversion (IA, Word_Ptr); 73 | -- Conversion from an integer address to word access 74 | 75 | Word_Unit : constant := Word'Size / Storage_Unit; 76 | -- Number of storage unit per word 77 | end System.Memory_Types; 78 | -------------------------------------------------------------------------------- /src/lib/componolit-runtime-strings.adb: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | package body Componolit.Runtime.Strings with 11 | SPARK_Mode 12 | is 13 | 14 | ------------ 15 | -- Length -- 16 | ------------ 17 | 18 | function Length (C_Str : System.Address; 19 | Max_Length : Natural := Natural'Last) return Integer 20 | is 21 | L : Integer := 0; 22 | Ptr : Valid_Pointer; 23 | Char : Character; 24 | begin 25 | if 26 | To_Pointer (C_Str) /= Null_Pointer 27 | and To_Pointer (C_Str) < Pointer'Last 28 | then 29 | Ptr := To_Pointer (C_Str); 30 | Char := Get_Char (Ptr); 31 | while 32 | Char /= Character'Val (0) and 33 | L < Max_Length and 34 | Ptr + 1 < Pointer'Last and 35 | Ptr < Pointer'Last 36 | loop 37 | pragma Loop_Invariant (L >= 0); 38 | pragma Loop_Variant (Increases => L); 39 | Ptr := Incr (Ptr); 40 | Char := Get_Char (Ptr); 41 | L := L + 1; 42 | end loop; 43 | end if; 44 | return L; 45 | end Length; 46 | 47 | -------------------- 48 | -- Convert_To_Ada -- 49 | -------------------- 50 | 51 | function Convert_To_Ada (C_Str : System.Address; 52 | Default : String; 53 | Max_Length : Natural := Natural'Last) return String 54 | is 55 | L : constant Integer := Length (C_Str, Max_Length); 56 | Str : String (1 .. L) := (others => ' '); 57 | Cursor : Valid_Pointer; 58 | begin 59 | if L > 0 then 60 | Cursor := To_Pointer (C_Str); 61 | for C in Str'Range loop 62 | Str (C) := Get_Char (Cursor); 63 | exit when Cursor = Pointer'Last; 64 | Cursor := Incr (Cursor); 65 | end loop; 66 | return Str; 67 | else 68 | return Default; 69 | end if; 70 | end Convert_To_Ada; 71 | 72 | ----------- 73 | -- Image -- 74 | ----------- 75 | 76 | function Image (J : Integer) return String 77 | is 78 | S : String (1 .. 11) := (others => '_'); 79 | V : Integer := J; 80 | begin 81 | for I in reverse S'First + 1 .. S'Last loop 82 | S (I) := Character'Val (48 + abs (V rem 10)); 83 | V := V / 10; 84 | if V = 0 then 85 | if J < 0 then 86 | S (I - 1) := '-'; 87 | return S (I - 1 .. S'Last); 88 | end if; 89 | return S (I .. S'Last); 90 | end if; 91 | end loop; 92 | return S; 93 | end Image; 94 | 95 | -------------- 96 | -- Get_Char -- 97 | -------------- 98 | 99 | function Get_Char (Ptr : Valid_Pointer) return Character 100 | with SPARK_Mode => Off 101 | is 102 | Char : Character 103 | with Address => To_Address (Ptr); 104 | begin 105 | return Char; 106 | end Get_Char; 107 | 108 | ---------- 109 | -- Incr -- 110 | ---------- 111 | 112 | function Incr (Ptr : Valid_Pointer) return Valid_Pointer 113 | is 114 | begin 115 | return Ptr + 1; 116 | end Incr; 117 | 118 | ---------------- 119 | -- To_Address -- 120 | ---------------- 121 | 122 | function To_Address (Value : Pointer) return System.Address 123 | with SPARK_Mode => Off 124 | is 125 | begin 126 | return SSE.To_Address (Value); 127 | end To_Address; 128 | 129 | ---------------- 130 | -- To_Pointer -- 131 | ---------------- 132 | 133 | function To_Pointer (Addr : System.Address) return Pointer 134 | with SPARK_Mode => Off 135 | is 136 | begin 137 | return SSE.To_Integer (Addr); 138 | end To_Pointer; 139 | 140 | end Componolit.Runtime.Strings; 141 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: push 4 | 5 | jobs: 6 | gnat_8_3: 7 | name: gnat-8.3 8 | runs-on: ubuntu-latest 9 | steps: 10 | - uses: actions/checkout@v1 11 | - name: GNAT 8.3 on Posix 12 | run: docker run -v $PWD:/app -w /app componolit/ci:gnat-fsf-8.3 /bin/sh -c "make && make test" 13 | gnat_11_2: 14 | name: gnat-11.2 15 | runs-on: ubuntu-latest 16 | steps: 17 | - uses: actions/checkout@v1 18 | - name: Install Alire 19 | uses: alire-project/setup-alire@v1 20 | - name: Install FSF GNAT 21 | run: | 22 | make GNAT_VERSION=11.2.1 install_gnat 23 | - name: GNAT 11.2 on Posix 24 | run: | 25 | eval `make GNAT_VERSION=11.2.1 printenv_gnat` 26 | make && make test 27 | gnat_12_1: 28 | name: gnat-12.1 29 | runs-on: ubuntu-latest 30 | steps: 31 | - uses: actions/checkout@v1 32 | - name: Install Alire 33 | uses: alire-project/setup-alire@v1 34 | - name: Install FSF GNAT 35 | run: | 36 | make GNAT_VERSION=12.1.2 install_gnat 37 | - name: GNAT 12.1 on Posix 38 | run: | 39 | eval `make GNAT_VERSION=12.1.2 printenv_gnat` 40 | make && make test 41 | gnat_community_2019: 42 | name: gnat-community-2019 43 | runs-on: ubuntu-latest 44 | steps: 45 | - uses: actions/checkout@v1 46 | - uses: ada-actions/toolchain@ce2021 47 | with: 48 | distrib: community 49 | community_year: 2019 50 | target: native 51 | - uses: ada-actions/toolchain@ce2021 52 | with: 53 | distrib: community 54 | community_year: 2019 55 | target: arm-elf 56 | - name: GNAT Community 2019 57 | run: make test && make REPORT=all proof 58 | - name: GNAT Community 2019 ARM 59 | run: $PWD/tests/arm.sh 60 | gnat_community_2020: 61 | name: gnat-community-2020 62 | runs-on: ubuntu-latest 63 | steps: 64 | - uses: actions/checkout@v1 65 | - uses: ada-actions/toolchain@ce2021 66 | with: 67 | distrib: community 68 | community_year: 2020 69 | target: native 70 | - uses: ada-actions/toolchain@ce2021 71 | with: 72 | distrib: community 73 | community_year: 2020 74 | target: arm-elf 75 | - name: GNAT Community 2020 76 | run: make test && make REPORT=all proof 77 | - name: GNAT Community 2020 ARM 78 | run: $PWD/tests/arm.sh 79 | gnat_community_2021: 80 | name: gnat-community-2021 81 | runs-on: ubuntu-latest 82 | steps: 83 | - uses: actions/checkout@v1 84 | - uses: ada-actions/toolchain@ce2021 85 | with: 86 | distrib: community 87 | community_year: 2021 88 | target: native 89 | - uses: ada-actions/toolchain@ce2021 90 | with: 91 | distrib: community 92 | community_year: 2021 93 | target: arm-elf 94 | - name: GNAT Community 2021 95 | run: make test && make REPORT=all proof 96 | - name: GNAT Community 2021 ARM 97 | run: $PWD/tests/arm.sh 98 | genode: 99 | name: Genode 100 | runs-on: ubuntu-latest 101 | steps: 102 | - uses: actions/checkout@v1 103 | - name: Genode 104 | run: docker run -v $PWD:/app componolit/ci:genode /bin/sh -c "/app/tests/genode.sh" 105 | esp8266: 106 | name: ESP8266 107 | runs-on: ubuntu-latest 108 | steps: 109 | - uses: actions/checkout@v1 110 | - name: ESP8266 111 | run: docker run -v $PWD:/app componolit/ci:gnat-community-2019 /bin/sh -c "/app/tests/esp8266.sh" 112 | 113 | -------------------------------------------------------------------------------- /tests/platform/stm32f0/crt0.S: -------------------------------------------------------------------------------- 1 | .syntax unified 2 | .cpu cortex-m0 3 | .thumb 4 | 5 | .text 6 | .globl __vectors 7 | .p2align 9 8 | .section .vectors,"a" 9 | __vectors: 10 | /* Cortex-M core interrupts */ 11 | .word __stack_end /* stack top address */ 12 | .word _start /* 1 Reset */ 13 | .word fault /* 2 NMI. */ 14 | .word fault /* 3 Hard fault. */ 15 | .word fault /* 4 Mem manage. */ 16 | .word fault /* 5 Bus fault. */ 17 | .word fault /* 6 Usage fault. */ 18 | .word fault /* 7 reserved. */ 19 | .word fault /* 8 reserved. */ 20 | .word fault /* 9 reserved. */ 21 | .word fault /* 10 reserved. */ 22 | .word __gnat_sv_call_trap /* 11 SVCall. */ 23 | .word __gnat_bkpt_trap /* 12 Breakpoint. */ 24 | .word fault /* 13 reserved. */ 25 | .word __gnat_pend_sv_trap /* 14 PendSV. */ 26 | .word __gnat_sys_tick_trap /* 15 Systick. */ 27 | /* MCU interrupts */ 28 | .word __unknown_interrupt_handler /* 0 */ 29 | .word __unknown_interrupt_handler /* 1 */ 30 | .word __unknown_interrupt_handler /* 2 */ 31 | .word __unknown_interrupt_handler /* 3 */ 32 | .word __unknown_interrupt_handler /* 4 */ 33 | .word __unknown_interrupt_handler /* 5 */ 34 | .word __unknown_interrupt_handler /* 6 */ 35 | .word __unknown_interrupt_handler /* 7 */ 36 | .word __unknown_interrupt_handler /* 8 */ 37 | .word __unknown_interrupt_handler /* 9 */ 38 | .word __unknown_interrupt_handler /* 10 */ 39 | .word __unknown_interrupt_handler /* 11 */ 40 | .word __unknown_interrupt_handler /* 12 */ 41 | .word __unknown_interrupt_handler /* 13 */ 42 | .word __unknown_interrupt_handler /* 14 */ 43 | .word __unknown_interrupt_handler /* 15 */ 44 | .word __unknown_interrupt_handler /* 16 */ 45 | .word __unknown_interrupt_handler /* 17 */ 46 | .word __unknown_interrupt_handler /* 18 */ 47 | .word __unknown_interrupt_handler /* 19 */ 48 | .word __unknown_interrupt_handler /* 20 */ 49 | .word __unknown_interrupt_handler /* 21 */ 50 | .word __unknown_interrupt_handler /* 22 */ 51 | .word __unknown_interrupt_handler /* 23 */ 52 | .word __unknown_interrupt_handler /* 24 */ 53 | .word __unknown_interrupt_handler /* 25 */ 54 | .word __unknown_interrupt_handler /* 26 */ 55 | .word __unknown_interrupt_handler /* 27 */ 56 | .word __unknown_interrupt_handler /* 28 */ 57 | .word __unknown_interrupt_handler /* 29 */ 58 | .word __unknown_interrupt_handler /* 30 */ 59 | .word __unknown_interrupt_handler /* 31 */ 60 | 61 | 62 | .text 63 | 64 | .weak __unknown_interrupt_handler 65 | .thumb_set __unknown_interrupt_handler,__gnat_irq_trap 66 | 67 | .thumb_func 68 | .weak __gnat_irq_trap 69 | .type __gnat_irq_trap, %function 70 | __gnat_irq_trap: 71 | 0: b 0b 72 | .size __gnat_irq_trap, . - __gnat_irq_trap 73 | 74 | .thumb_func 75 | .weak __gnat_sv_call_trap 76 | .type __gnat_sv_call_trap, %function 77 | __gnat_sv_call_trap: 78 | 0: b 0b 79 | .size __gnat_sv_call_trap, . - __gnat_sv_call_trap 80 | 81 | .thumb_func 82 | .weak __gnat_pend_sv_trap 83 | .type __gnat_pend_sv_trap, %function 84 | __gnat_pend_sv_trap: 85 | 0: b 0b 86 | .size __gnat_pend_sv_trap, . - __gnat_pend_sv_trap 87 | 88 | .thumb_func 89 | .weak __gnat_sys_tick_trap 90 | .type __gnat_sys_tick_trap, %function 91 | __gnat_sys_tick_trap: 92 | 0: b 0b 93 | .size __gnat_sys_tick_trap, . - __gnat_sys_tick_trap 94 | 95 | .thumb_func 96 | fault: b fault 97 | 98 | 99 | .text 100 | .thumb_func 101 | .globl _start 102 | 103 | _start: 104 | 105 | /* Set the stack pointer */ 106 | ldr r1,=__stack_end 107 | mov sp, r1 108 | 109 | /* Copy .data */ 110 | .thumb_func 111 | _startup_copy_data: 112 | ldr r0,=__data_start 113 | ldr r1,=__data_words 114 | ldr r2,=__data_load 115 | cmp r1,#0 116 | beq 1f 117 | 0: ldr r4,[r2] 118 | str r4,[r0] 119 | adds r2,#4 120 | adds r0,#4 121 | subs r1,r1,#1 122 | bne 0b 123 | 1: 124 | .size _startup_copy_data, . - _startup_copy_data 125 | 126 | /* Clear .bss */ 127 | .thumb_func 128 | _startup_clear_bss: 129 | ldr r0,=__bss_start 130 | ldr r1,=__bss_words 131 | movs r2,#0 132 | cmp r1,#0 133 | beq 1f 134 | 0: str r2,[r0] 135 | adds r0,#4 136 | subs r1,r1,#1 137 | bne 0b 138 | 1: 139 | .size _startup_clear_bss, . - _startup_clear_bss 140 | 141 | bl main 142 | 143 | bl _exit 144 | 145 | hang: b . 146 | -------------------------------------------------------------------------------- /tests/platform/nrf52/crt0.S: -------------------------------------------------------------------------------- 1 | .syntax unified 2 | .cpu cortex-m0 3 | .thumb 4 | 5 | .text 6 | .globl __vectors 7 | .p2align 9 8 | .section .vectors,"a" 9 | __vectors: 10 | /* Cortex-M core interrupts */ 11 | .word __stack_end /* stack top address */ 12 | .word _start /* 1 Reset */ 13 | .word fault /* 2 NMI. */ 14 | .word fault /* 3 Hard fault. */ 15 | .word fault /* 4 Mem manage. */ 16 | .word fault /* 5 Bus fault. */ 17 | .word fault /* 6 Usage fault. */ 18 | .word fault /* 7 reserved. */ 19 | .word fault /* 8 reserved. */ 20 | .word fault /* 9 reserved. */ 21 | .word fault /* 10 reserved. */ 22 | .word __gnat_sv_call_trap /* 11 SVCall. */ 23 | .word __gnat_bkpt_trap /* 12 Breakpoint. */ 24 | .word fault /* 13 reserved. */ 25 | .word __gnat_pend_sv_trap /* 14 PendSV. */ 26 | .word __gnat_sys_tick_trap /* 15 Systick. */ 27 | /* MCU interrupts */ 28 | .word __unknown_interrupt_handler /* 0 */ 29 | .word __unknown_interrupt_handler /* 1 */ 30 | .word __unknown_interrupt_handler /* 2 */ 31 | .word __unknown_interrupt_handler /* 3 */ 32 | .word __unknown_interrupt_handler /* 4 */ 33 | .word __unknown_interrupt_handler /* 5 */ 34 | .word __unknown_interrupt_handler /* 6 */ 35 | .word __unknown_interrupt_handler /* 7 */ 36 | .word __unknown_interrupt_handler /* 8 */ 37 | .word __unknown_interrupt_handler /* 9 */ 38 | .word __unknown_interrupt_handler /* 10 */ 39 | .word __unknown_interrupt_handler /* 11 */ 40 | .word __unknown_interrupt_handler /* 12 */ 41 | .word __unknown_interrupt_handler /* 13 */ 42 | .word __unknown_interrupt_handler /* 14 */ 43 | .word __unknown_interrupt_handler /* 15 */ 44 | .word __unknown_interrupt_handler /* 16 */ 45 | .word __unknown_interrupt_handler /* 17 */ 46 | .word __unknown_interrupt_handler /* 18 */ 47 | .word __unknown_interrupt_handler /* 19 */ 48 | .word __unknown_interrupt_handler /* 20 */ 49 | .word __unknown_interrupt_handler /* 21 */ 50 | .word __unknown_interrupt_handler /* 22 */ 51 | .word __unknown_interrupt_handler /* 23 */ 52 | .word __unknown_interrupt_handler /* 24 */ 53 | .word __unknown_interrupt_handler /* 25 */ 54 | .word __unknown_interrupt_handler /* 26 */ 55 | .word __unknown_interrupt_handler /* 27 */ 56 | .word __unknown_interrupt_handler /* 28 */ 57 | .word __unknown_interrupt_handler /* 29 */ 58 | .word __unknown_interrupt_handler /* 30 */ 59 | .word __unknown_interrupt_handler /* 31 */ 60 | .word __unknown_interrupt_handler /* 32 */ 61 | .word __unknown_interrupt_handler /* 33 */ 62 | .word __unknown_interrupt_handler /* 34 */ 63 | .word __unknown_interrupt_handler /* 35 */ 64 | .word __unknown_interrupt_handler /* 36 */ 65 | 66 | 67 | .text 68 | 69 | .weak __unknown_interrupt_handler 70 | .thumb_set __unknown_interrupt_handler,__gnat_irq_trap 71 | 72 | .thumb_func 73 | .weak __gnat_irq_trap 74 | .type __gnat_irq_trap, %function 75 | __gnat_irq_trap: 76 | 0: b 0b 77 | .size __gnat_irq_trap, . - __gnat_irq_trap 78 | 79 | .thumb_func 80 | .weak __gnat_sv_call_trap 81 | .type __gnat_sv_call_trap, %function 82 | __gnat_sv_call_trap: 83 | 0: b 0b 84 | .size __gnat_sv_call_trap, . - __gnat_sv_call_trap 85 | 86 | .thumb_func 87 | .weak __gnat_pend_sv_trap 88 | .type __gnat_pend_sv_trap, %function 89 | __gnat_pend_sv_trap: 90 | 0: b 0b 91 | .size __gnat_pend_sv_trap, . - __gnat_pend_sv_trap 92 | 93 | .thumb_func 94 | .weak __gnat_sys_tick_trap 95 | .type __gnat_sys_tick_trap, %function 96 | __gnat_sys_tick_trap: 97 | 0: b 0b 98 | .size __gnat_sys_tick_trap, . - __gnat_sys_tick_trap 99 | 100 | .thumb_func 101 | fault: b fault 102 | 103 | 104 | .text 105 | .thumb_func 106 | .globl _start 107 | 108 | _start: 109 | 110 | /* Set the stack pointer */ 111 | ldr r1,=__stack_end 112 | mov sp, r1 113 | 114 | /* Copy .data */ 115 | .thumb_func 116 | _startup_copy_data: 117 | ldr r0,=__data_start 118 | ldr r1,=__data_words 119 | ldr r2,=__data_load 120 | cmp r1,#0 121 | beq 1f 122 | 0: ldr r4,[r2] 123 | str r4,[r0] 124 | adds r2,#4 125 | adds r0,#4 126 | subs r1,r1,#1 127 | bne 0b 128 | 1: 129 | .size _startup_copy_data, . - _startup_copy_data 130 | 131 | /* Clear .bss */ 132 | .thumb_func 133 | _startup_clear_bss: 134 | ldr r0,=__bss_start 135 | ldr r1,=__bss_words 136 | movs r2,#0 137 | cmp r1,#0 138 | beq 1f 139 | 0: str r2,[r0] 140 | adds r0,#4 141 | subs r1,r1,#1 142 | bne 0b 143 | 1: 144 | .size _startup_clear_bss, . - _startup_clear_bss 145 | 146 | bl main 147 | 148 | bl _exit 149 | 150 | hang: b . 151 | -------------------------------------------------------------------------------- /contrib/gcc-9.3.1/s-memmov.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT RUN-TIME COMPONENTS -- 4 | -- -- 5 | -- S Y S T E M . M E M O R Y _ M O V E -- 6 | -- -- 7 | -- B o d y -- 8 | -- -- 9 | -- Copyright (C) 2006-2020, Free Software Foundation, Inc. -- 10 | -- -- 11 | -- GNAT is free software; you can redistribute it and/or modify it under -- 12 | -- terms of the GNU General Public License as published by the Free Soft- -- 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- 17 | -- -- 18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 19 | -- additional permissions described in the GCC Runtime Library Exception, -- 20 | -- version 3.1, as published by the Free Software Foundation. -- 21 | -- -- 22 | -- You should have received a copy of the GNU General Public License and -- 23 | -- a copy of the GCC Runtime Library Exception along with this program; -- 24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25 | -- . -- 26 | -- -- 27 | -- GNAT was originally developed by the GNAT team at New York University. -- 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with System.Memory_Types; use System.Memory_Types; 33 | 34 | package body System.Memory_Move is 35 | 36 | ------------- 37 | -- memmove -- 38 | ------------- 39 | 40 | function memmove 41 | (Dest : Address; Src : Address; N : size_t) return Address is 42 | D : IA := To_IA (Dest); 43 | S : IA := To_IA (Src); 44 | C : IA := IA (N); 45 | begin 46 | -- There was an early exit if there are no bytes to copy. There are no 47 | -- reasons to handle this very rare case specially, as it is handled 48 | -- correctly by the common path. 49 | 50 | -- This function must handle overlapping memory regions for the source 51 | -- and destination. If the Dest buffer is located past the Src buffer 52 | -- then we use backward copying, and forward copying otherwise. 53 | 54 | if D > S and then D < S + C then 55 | 56 | -- Backward copy 57 | 58 | D := D + C; 59 | S := S + C; 60 | 61 | -- Try to copy per word, if alignment constraints are respected 62 | 63 | if ((D or S) and (Word'Alignment - 1)) = 0 then 64 | while C >= Word_Unit loop 65 | D := D - Word_Unit; 66 | S := S - Word_Unit; 67 | To_Word_Ptr (D).all := To_Word_Ptr (S).all; 68 | 69 | C := C - Word_Unit; 70 | end loop; 71 | end if; 72 | 73 | -- Copy the remainder byte by byte 74 | 75 | while C /= 0 loop 76 | D := D - Byte_Unit; 77 | S := S - Byte_Unit; 78 | To_Byte_Ptr (D).all := To_Byte_Ptr (S).all; 79 | 80 | C := C - Byte_Unit; 81 | end loop; 82 | else 83 | -- Try to copy per word, if alignment constraints are respected 84 | 85 | if ((D or S) and (Word'Alignment - 1)) = 0 then 86 | while C >= Word_Unit loop 87 | To_Word_Ptr (D).all := To_Word_Ptr (S).all; 88 | D := D + Word_Unit; 89 | S := S + Word_Unit; 90 | C := C - Word_Unit; 91 | end loop; 92 | end if; 93 | 94 | -- Copy the remainder byte by byte 95 | 96 | while C /= 0 loop 97 | To_Byte_Ptr (D).all := To_Byte_Ptr (S).all; 98 | D := D + Byte_Unit; 99 | S := S + Byte_Unit; 100 | C := C - Byte_Unit; 101 | end loop; 102 | end if; 103 | 104 | return Dest; 105 | end memmove; 106 | 107 | end System.Memory_Move; 108 | -------------------------------------------------------------------------------- /src/minimal/i-c.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT COMPILER COMPONENTS -- 4 | -- -- 5 | -- I N T E R F A C E S . C -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- This specification is derived from the Ada Reference Manual for use with -- 10 | -- GNAT. In accordance with the copyright of that document, you can freely -- 11 | -- copy and modify this specification, provided that if you redistribute a -- 12 | -- modified version, any changes that you have made are clearly indicated. -- 13 | -- -- 14 | ------------------------------------------------------------------------------ 15 | 16 | -- Copyright (C) 2019 Componolit GmbH 17 | -- Copyright (C) 1992-2015, Free Software Foundation, Inc. 18 | -- 19 | -- This file is part of the Componolit Ada runtime, which is distributed 20 | -- under the terms of the GNU Affero General Public License version 3. 21 | -- 22 | -- As a special exception under Section 7 of GPL version 3, you are granted 23 | -- additional permissions described in the GCC Runtime Library Exception, 24 | -- version 3.1, as published by the Free Software Foundation. 25 | 26 | with System.Parameters; 27 | 28 | package Interfaces.C with 29 | SPARK_Mode 30 | is 31 | 32 | pragma Pure; 33 | pragma Elaborate_Body; 34 | 35 | -- Declaration's based on C's 36 | 37 | CHAR_BIT : constant := 8; 38 | SCHAR_MIN : constant := -128; 39 | SCHAR_MAX : constant := 127; 40 | UCHAR_MAX : constant := 255; 41 | 42 | -- Signed and Unsigned Integers. Note that in GNAT, we have ensured that 43 | -- the standard predefined Ada types correspond to the standard C types 44 | 45 | -- Note: the Integer qualifications used in the declaration of type long 46 | -- avoid ambiguities when compiling in the presence of s-auxdec.ads and 47 | -- a non-private system.address type. 48 | 49 | type int is new Integer; 50 | type short is new Short_Integer; 51 | type long is range -(2 ** (System.Parameters.long_bits - Integer'(1))) 52 | .. +(2 ** (System.Parameters.long_bits - Integer'(1))) - 1; 53 | 54 | type signed_char is range SCHAR_MIN .. SCHAR_MAX; 55 | for signed_char'Size use CHAR_BIT; 56 | 57 | type unsigned is mod 2 ** int'Size; 58 | type unsigned_short is mod 2 ** short'Size; 59 | type unsigned_long is mod 2 ** long'Size; 60 | 61 | type unsigned_char is mod (UCHAR_MAX + 1); 62 | for unsigned_char'Size use CHAR_BIT; 63 | 64 | subtype plain_char is unsigned_char; -- ??? should be parameterized 65 | 66 | -- Note: the Integer qualifications used in the declaration of ptrdiff_t 67 | -- avoid ambiguities when compiling in the presence of s-auxdec.ads and 68 | -- a non-private system.address type. 69 | 70 | type ptrdiff_t is 71 | range -(2 ** (System.Parameters.ptr_bits - Integer'(1))) .. 72 | +(2 ** (System.Parameters.ptr_bits - Integer'(1)) - 1); 73 | 74 | type size_t is mod 2 ** System.Parameters.ptr_bits; 75 | 76 | -- Floating-Point 77 | 78 | type C_float is new Float; 79 | type double is new Standard.Long_Float; 80 | -- type long_double is new Standard.Long_Long_Float; 81 | -- extended precision floating point type is not yet supported 82 | 83 | ---------------------------- 84 | -- Characters and Strings -- 85 | ---------------------------- 86 | 87 | type char is new Character; 88 | 89 | nul : constant char := char'First; 90 | 91 | type char_array is array (size_t range <>) of aliased char; 92 | for char_array'Component_Size use CHAR_BIT; 93 | 94 | ------------------------------------ 95 | -- Wide Character and Wide String -- 96 | ------------------------------------ 97 | 98 | type wchar_t is new Wide_Character; 99 | for wchar_t'Size use Standard'Wchar_T_Size; 100 | 101 | wide_nul : constant wchar_t := wchar_t'First; 102 | 103 | type wchar_array is array (size_t range <>) of aliased wchar_t; 104 | 105 | -- The remaining declarations are for Ada 2005 (AI-285) 106 | 107 | -- ISO/IEC 10646:2003 compatible types defined by SC22/WG14 document N1010 108 | 109 | type char16_t is new Wide_Character; 110 | pragma Ada_05 (char16_t); 111 | 112 | char16_nul : constant char16_t := char16_t'Val (0); 113 | pragma Ada_05 (char16_nul); 114 | 115 | type char16_array is array (size_t range <>) of aliased char16_t; 116 | pragma Ada_05 (char16_array); 117 | 118 | type char32_t is new Wide_Wide_Character; 119 | pragma Ada_05 (char32_t); 120 | 121 | char32_nul : constant char32_t := char32_t'Val (0); 122 | pragma Ada_05 (char32_nul); 123 | 124 | type char32_array is array (size_t range <>) of aliased char32_t; 125 | pragma Ada_05 (char32_array); 126 | 127 | end Interfaces.C; 128 | -------------------------------------------------------------------------------- /src/minimal/s-secsta.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2018 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | with System.Parameters; 11 | with System.Storage_Elements; 12 | 13 | package System.Secondary_Stack with 14 | SPARK_Mode, 15 | Abstract_State => (Stack_State, Binder_State), 16 | Initializes => (Stack_State, Binder_State) 17 | is 18 | 19 | package SP renames System.Parameters; 20 | package SSE renames System.Storage_Elements; 21 | 22 | type SS_Stack (Size : SP.Size_Type) is private; 23 | 24 | type Mark_Id is private; 25 | 26 | function Valid_Address (A : SSE.Integer_Address) return Boolean with 27 | Ghost, 28 | Global => null, 29 | Depends => (Valid_Address'Result => A); 30 | 31 | function Valid_Stack return Boolean with 32 | Ghost, 33 | Global => (Input => Stack_State), 34 | Depends => (Valid_Stack'Result => Stack_State); 35 | 36 | function Valid_Mark_Id (M : Mark_Id) return Boolean with 37 | Ghost, 38 | Global => null, 39 | Depends => (Valid_Mark_Id'Result => M); 40 | 41 | function Consistent_Mark_Id (M : Mark_Id) return Boolean with 42 | Ghost, 43 | Global => (Input => Stack_State), 44 | Depends => (Consistent_Mark_Id'Result => (M, Stack_State)); 45 | 46 | function Sufficient_Stack_Space (S : SSE.Storage_Count) return Boolean with 47 | Global => (Input => (Stack_State, Binder_State)), 48 | Depends => (Sufficient_Stack_Space'Result => 49 | (S, Stack_State, Binder_State)); 50 | 51 | function Valid_Lower_Mark_Id (M : Mark_Id) return Boolean with 52 | Ghost, 53 | Global => (Input => Stack_State), 54 | Depends => (Valid_Lower_Mark_Id'Result => 55 | (M, Stack_State)); 56 | 57 | procedure SS_Allocate (Address : out SSE.Integer_Address; 58 | Storage_Size : SSE.Storage_Count) with 59 | Pre => Sufficient_Stack_Space (Storage_Size) and Valid_Stack, 60 | Post => Valid_Address (Address) and Valid_Stack, 61 | Global => (Input => Binder_State, 62 | In_Out => Stack_State), 63 | Depends => (Stack_State =>+ Storage_Size, 64 | Address => (Stack_State, Storage_Size), 65 | null => Binder_State); 66 | 67 | function SS_Mark return Mark_Id with 68 | Pre => Valid_Stack, 69 | Post => Valid_Mark_Id (SS_Mark'Result) and Valid_Stack, 70 | Global => (Input => Stack_State), 71 | Depends => (SS_Mark'Result => Stack_State); 72 | 73 | procedure SS_Release (M : Mark_Id) with 74 | Pre => Consistent_Mark_Id (M) 75 | and Valid_Lower_Mark_Id (M) 76 | and Valid_Stack, 77 | Post => Valid_Stack, 78 | Global => (In_Out => Stack_State), 79 | Depends => (Stack_State =>+ M); 80 | 81 | private 82 | 83 | SS_Pool : Integer with 84 | Part_Of => Binder_State; 85 | 86 | subtype SS_Ptr is SP.Size_Type; 87 | 88 | type Memory is array (SS_Ptr range <>) of SSE.Storage_Element; 89 | for Memory'Alignment use Standard'Maximum_Alignment; 90 | 91 | type SS_Stack (Size : SP.Size_Type) is record 92 | Stack_Space : Memory (1 .. Size); 93 | end record; 94 | 95 | type Stack_Meta_Data is record 96 | Base : SSE.Integer_Address; 97 | Top : SSE.Storage_Count; 98 | end record; 99 | 100 | type Mark_Id is record 101 | Sstk : SSE.Integer_Address; 102 | Sptr : SSE.Integer_Address; 103 | end record; 104 | 105 | Stack_Size : Natural with 106 | Export, 107 | Convention => Ada, 108 | External_Name => "__gnat_default_ss_size", 109 | Part_Of => Binder_State; 110 | 111 | Stack_Count : Natural := 1 with 112 | Export, 113 | Convention => Ada, 114 | External_Name => "__gnat_binder_ss_count", 115 | Part_Of => Binder_State; 116 | 117 | Stack_Pool_Address : System.Address with 118 | Export, 119 | Convention => Ada, 120 | External_Name => "__gnat_default_ss_pool", 121 | Part_Of => Binder_State; 122 | 123 | Stack : Stack_Meta_Data := (Base => 0, 124 | Top => 0) with 125 | Part_Of => Stack_State; 126 | 127 | use type SSE.Integer_Address; 128 | use type SSE.Storage_Offset; 129 | 130 | function Valid_Address (A : SSE.Integer_Address) return Boolean 131 | is 132 | (A /= 0); 133 | 134 | function Valid_Mark_Id (M : Mark_Id) return Boolean 135 | is 136 | (M.Sstk /= 0); 137 | 138 | function Valid_Stack return Boolean 139 | is 140 | (Stack.Base /= 0); 141 | 142 | function Sufficient_Stack_Space (S : SSE.Storage_Count) return Boolean 143 | is 144 | (Stack.Top < SSE.Storage_Count (Stack_Size) 145 | and then S < SSE.Storage_Count (Stack_Size) 146 | and then S + Stack.Top < SSE.Storage_Count (Stack_Size) 147 | and then SSE.Integer_Address (S + Stack.Top) < Stack.Base); 148 | 149 | function Consistent_Mark_Id (M : Mark_Id) return Boolean 150 | is 151 | (Stack.Base = M.Sstk); 152 | 153 | function Valid_Lower_Mark_Id (M : Mark_Id) return Boolean 154 | is 155 | (M.Sptr < SSE.Integer_Address (Integer'Last) 156 | and then SSE.Storage_Count (M.Sptr) <= Stack.Top); 157 | 158 | end System.Secondary_Stack; 159 | -------------------------------------------------------------------------------- /contrib/gcc-8.3.0/s-maccod.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT COMPILER COMPONENTS -- 4 | -- -- 5 | -- S Y S T E M . M A C H I N E _ C O D E -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- 10 | -- -- 11 | -- GNAT is free software; you can redistribute it and/or modify it under -- 12 | -- terms of the GNU General Public License as published by the Free Soft- -- 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- 17 | -- -- 18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 19 | -- additional permissions described in the GCC Runtime Library Exception, -- 20 | -- version 3.1, as published by the Free Software Foundation. -- 21 | -- -- 22 | -- You should have received a copy of the GNU General Public License and -- 23 | -- a copy of the GCC Runtime Library Exception along with this program; -- 24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25 | -- . -- 26 | -- -- 27 | -- GNAT was originally developed by the GNAT team at New York University. -- 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides machine code support, both for intrinsic machine 33 | -- operations, and also for machine code statements. See GNAT documentation 34 | -- for full details. 35 | 36 | package System.Machine_Code is 37 | pragma No_Elaboration_Code_All; 38 | pragma Pure; 39 | 40 | -- All identifiers in this unit are implementation defined 41 | 42 | pragma Implementation_Defined; 43 | 44 | type Asm_Input_Operand is private; 45 | type Asm_Output_Operand is private; 46 | -- These types are never used directly, they are declared only so that 47 | -- the calls to Asm are type correct according to Ada semantic rules. 48 | 49 | No_Input_Operands : constant Asm_Input_Operand; 50 | No_Output_Operands : constant Asm_Output_Operand; 51 | 52 | type Asm_Input_Operand_List is 53 | array (Integer range <>) of Asm_Input_Operand; 54 | 55 | type Asm_Output_Operand_List is 56 | array (Integer range <>) of Asm_Output_Operand; 57 | 58 | type Asm_Insn is private; 59 | -- This type is not used directly. It is declared only so that the 60 | -- aggregates used in code statements are type correct by Ada rules. 61 | 62 | procedure Asm ( 63 | Template : String; 64 | Outputs : Asm_Output_Operand_List; 65 | Inputs : Asm_Input_Operand_List; 66 | Clobber : String := ""; 67 | Volatile : Boolean := False); 68 | 69 | procedure Asm ( 70 | Template : String; 71 | Outputs : Asm_Output_Operand := No_Output_Operands; 72 | Inputs : Asm_Input_Operand_List; 73 | Clobber : String := ""; 74 | Volatile : Boolean := False); 75 | 76 | procedure Asm ( 77 | Template : String; 78 | Outputs : Asm_Output_Operand_List; 79 | Inputs : Asm_Input_Operand := No_Input_Operands; 80 | Clobber : String := ""; 81 | Volatile : Boolean := False); 82 | 83 | procedure Asm ( 84 | Template : String; 85 | Outputs : Asm_Output_Operand := No_Output_Operands; 86 | Inputs : Asm_Input_Operand := No_Input_Operands; 87 | Clobber : String := ""; 88 | Volatile : Boolean := False); 89 | 90 | function Asm ( 91 | Template : String; 92 | Outputs : Asm_Output_Operand_List; 93 | Inputs : Asm_Input_Operand_List; 94 | Clobber : String := ""; 95 | Volatile : Boolean := False) return Asm_Insn; 96 | 97 | function Asm ( 98 | Template : String; 99 | Outputs : Asm_Output_Operand := No_Output_Operands; 100 | Inputs : Asm_Input_Operand_List; 101 | Clobber : String := ""; 102 | Volatile : Boolean := False) return Asm_Insn; 103 | 104 | function Asm ( 105 | Template : String; 106 | Outputs : Asm_Output_Operand_List; 107 | Inputs : Asm_Input_Operand := No_Input_Operands; 108 | Clobber : String := ""; 109 | Volatile : Boolean := False) return Asm_Insn; 110 | 111 | function Asm ( 112 | Template : String; 113 | Outputs : Asm_Output_Operand := No_Output_Operands; 114 | Inputs : Asm_Input_Operand := No_Input_Operands; 115 | Clobber : String := ""; 116 | Volatile : Boolean := False) return Asm_Insn; 117 | 118 | pragma Import (Intrinsic, Asm); 119 | 120 | private 121 | 122 | type Asm_Input_Operand is new Integer; 123 | type Asm_Output_Operand is new Integer; 124 | type Asm_Insn is new Integer; 125 | -- All three of these types are dummy types, to meet the requirements of 126 | -- type consistency. No values of these types are ever referenced. 127 | 128 | No_Input_Operands : constant Asm_Input_Operand := 0; 129 | No_Output_Operands : constant Asm_Output_Operand := 0; 130 | 131 | end System.Machine_Code; 132 | -------------------------------------------------------------------------------- /src/minimal/s-arit64.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT COMPILER COMPONENTS -- 4 | -- -- 5 | -- S Y S T E M . A R I T H _ 6 4 -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- 10 | -- -- 11 | -- GNAT is free software; you can redistribute it and/or modify it under -- 12 | -- terms of the GNU General Public License as published by the Free Soft- -- 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- 17 | -- -- 18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 19 | -- additional permissions described in the GCC Runtime Library Exception, -- 20 | -- version 3.1, as published by the Free Software Foundation. -- 21 | -- -- 22 | -- You should have received a copy of the GNU General Public License and -- 23 | -- a copy of the GCC Runtime Library Exception along with this program; -- 24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25 | -- . -- 26 | -- -- 27 | -- GNAT was originally developed by the GNAT team at New York University. -- 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- Copyright (C) 2019 Componolit GmbH 33 | -- Copyright (C) 1992-2015, Free Software Foundation, Inc. 34 | -- 35 | -- This file is part of the Componolit Ada runtime, which is distributed 36 | -- under the terms of the GNU Affero General Public License version 3. 37 | -- 38 | -- As a special exception under Section 7 of GPL version 3, you are granted 39 | -- additional permissions described in the GCC Runtime Library Exception, 40 | -- version 3.1, as published by the Free Software Foundation. 41 | 42 | -- This unit provides software routines for doing arithmetic on 64-bit 43 | -- signed integer values in cases where either overflow checking is 44 | -- required, or intermediate results are longer than 64 bits. 45 | 46 | pragma Restrictions (No_Elaboration_Code); 47 | -- Allow direct call from gigi generated code 48 | 49 | with Interfaces; 50 | 51 | package System.Arith_64 with 52 | SPARK_Mode, 53 | Pure 54 | is 55 | 56 | subtype Int64 is Interfaces.Integer_64; 57 | use type Interfaces.Integer_64; 58 | 59 | function Add_With_Ovflo_Check (X, Y : Int64) return Int64 with 60 | Pre => (if X < 0 and Y <= 0 then Int64'First - X < Y) 61 | and (if X >= 0 and Y >= 0 then Int64'Last - X >= Y), 62 | Post => Add_With_Ovflo_Check'Result = X + Y, 63 | Global => null, 64 | Depends => (Add_With_Ovflo_Check'Result => (X, Y)); 65 | -- Raises Constraint_Error if sum of operands overflows 64 bits, 66 | -- otherwise returns the 64-bit signed integer sum. 67 | 68 | function Subtract_With_Ovflo_Check (X, Y : Int64) return Int64 with 69 | Pre => (if X >= 0 and Y <= 0 then Y > Int64'First 70 | and then Int64'Last - X >= abs (Y)) 71 | and (if X < 0 and Y > 0 then Y < Int64'First - X), 72 | Post => Subtract_With_Ovflo_Check'Result = X - Y, 73 | Global => null, 74 | Depends => (Subtract_With_Ovflo_Check'Result => (X, Y)); 75 | -- Raises Constraint_Error if difference of operands overflows 64 76 | -- bits, otherwise returns the 64-bit signed integer difference. 77 | 78 | function Multiply_With_Ovflo_Check (X, Y : Int64) return Int64; 79 | pragma Export (C, Multiply_With_Ovflo_Check, "__gnat_mulv64"); 80 | -- Raises Constraint_Error if product of operands overflows 64 81 | -- bits, otherwise returns the 64-bit signed integer product. 82 | -- GIGI may also call this routine directly. 83 | 84 | procedure Scaled_Divide 85 | (X, Y, Z : Int64; 86 | Q, R : out Int64; 87 | Round : Boolean); 88 | -- Performs the division of (X * Y) / Z, storing the quotient in Q 89 | -- and the remainder in R. Constraint_Error is raised if Z is zero, 90 | -- or if the quotient does not fit in 64-bits. Round indicates if 91 | -- the result should be rounded. If Round is False, then Q, R are 92 | -- the normal quotient and remainder from a truncating division. 93 | -- If Round is True, then Q is the rounded quotient. The remainder 94 | -- R is not affected by the setting of the Round flag. 95 | 96 | procedure Double_Divide 97 | (X, Y, Z : Int64; 98 | Q, R : out Int64; 99 | Round : Boolean); 100 | -- Performs the division X / (Y * Z), storing the quotient in Q and 101 | -- the remainder in R. Constraint_Error is raised if Y or Z is zero, 102 | -- or if the quotient does not fit in 64-bits. Round indicates if the 103 | -- result should be rounded. If Round is False, then Q, R are the normal 104 | -- quotient and remainder from a truncating division. If Round is True, 105 | -- then Q is the rounded quotient. The remainder R is not affected by the 106 | -- setting of the Round flag. 107 | 108 | end System.Arith_64; 109 | -------------------------------------------------------------------------------- /src/minimal/a-nbnbin.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2020 Componolit GmbH 2 | -- 3 | -- This file is part of the Componolit Ada runtime, which is distributed 4 | -- under the terms of the GNU Affero General Public License version 3. 5 | -- 6 | -- As a special exception under Section 7 of GPL version 3, you are granted 7 | -- additional permissions described in the GCC Runtime Library Exception, 8 | -- version 3.1, as published by the Free Software Foundation. 9 | 10 | package Ada.Numerics.Big_Numbers.Big_Integers with 11 | Preelaborate, 12 | Elaborate_Body 13 | is 14 | 15 | type Big_Integer is private with 16 | Ghost; 17 | 18 | function Is_Valid (Arg : Big_Integer) return Boolean with 19 | Ghost, 20 | Import, 21 | Global => null; 22 | 23 | function "=" (L, R : Big_Integer) return Boolean with 24 | Ghost, 25 | Import, 26 | Global => null; 27 | 28 | function "<" (L, R : Big_Integer) return Boolean with 29 | Ghost, 30 | Import, 31 | Global => null; 32 | 33 | function "<=" (L, R : Big_Integer) return Boolean with 34 | Ghost, 35 | Import, 36 | Global => null; 37 | 38 | function ">" (L, R : Big_Integer) return Boolean with 39 | Ghost, 40 | Import, 41 | Global => null; 42 | 43 | function ">=" (L, R : Big_Integer) return Boolean with 44 | Ghost, 45 | Import, 46 | Global => null; 47 | 48 | function To_Big_Integer (Arg : Integer) return Big_Integer with 49 | Ghost, 50 | Import, 51 | Global => null; 52 | 53 | subtype Big_Positive is Big_Integer with 54 | Ghost, 55 | Dynamic_Predicate => (if Is_Valid (Big_Positive) 56 | then Big_Positive > To_Big_Integer (0)); 57 | 58 | subtype Big_Natural is Big_Integer with 59 | Ghost, 60 | Dynamic_Predicate => (if Is_Valid (Big_Natural) 61 | then Big_Natural >= To_Big_Integer (0)); 62 | 63 | function In_Range (Arg, Low, High : Big_Integer) return Boolean is 64 | ((Low <= Arg) and then (Arg <= High)) with 65 | Ghost, 66 | Global => null; 67 | 68 | function To_Integer (Arg : Big_Integer) return Integer with 69 | Pre => In_Range (Arg, 70 | To_Big_Integer (Integer'First), 71 | To_Big_Integer (Integer'Last)), 72 | Global => null, 73 | Ghost, 74 | Import; 75 | 76 | generic 77 | type Int is range <>; 78 | package Signed_Conversions is 79 | 80 | -- This use clause is required to instantiate Signed_Conversions 81 | pragma Warnings 82 | (Off, "use clause for package ""Big_Integers"" has no effect"); 83 | use Big_Integers; 84 | pragma Warnings 85 | (On, "use clause for package ""Big_Integers"" has no effect"); 86 | 87 | function To_Big_Integer (Arg : Int) return Big_Integer with 88 | Ghost, 89 | Import, 90 | Global => null; 91 | 92 | function From_Big_Integer (Arg : Big_Integer) return Int with 93 | Pre => In_Range (Arg, 94 | To_Big_Integer (Int'First), 95 | To_Big_Integer (Int'Last)), 96 | Global => null, 97 | Ghost, 98 | Import; 99 | 100 | end Signed_Conversions; 101 | 102 | generic 103 | type Int is mod <>; 104 | package Unsigned_Conversions is 105 | 106 | -- This use clause is required to instantiate Unsigned_Conversions 107 | pragma Warnings 108 | (Off, "use clause for package ""Big_Integers"" has no effect"); 109 | use Big_Integers; 110 | pragma Warnings 111 | (On, "use clause for package ""Big_Integers"" has no effect"); 112 | 113 | function To_Big_Integer (Arg : Int) return Big_Integer with 114 | Ghost, 115 | Import, 116 | Global => null; 117 | 118 | function From_Big_Integer (Arg : Big_Integer) return Int with 119 | Pre => In_Range (Arg, 120 | To_Big_Integer (Int'First), 121 | To_Big_Integer (Int'Last)), 122 | Global => null, 123 | Ghost, 124 | Import; 125 | 126 | end Unsigned_Conversions; 127 | 128 | function "+" (L : Big_Integer) return Big_Integer with 129 | Ghost, 130 | Import, 131 | Global => null; 132 | 133 | function "-" (L : Big_Integer) return Big_Integer with 134 | Ghost, 135 | Import, 136 | Global => null; 137 | 138 | function "abs" (L : Big_Integer) return Big_Integer with 139 | Ghost, 140 | Import, 141 | Global => null; 142 | 143 | function "+" (L, R : Big_Integer) return Big_Integer with 144 | Ghost, 145 | Import, 146 | Global => null; 147 | 148 | function "-" (L, R : Big_Integer) return Big_Integer with 149 | Ghost, 150 | Import, 151 | Global => null; 152 | 153 | function "*" (L, R : Big_Integer) return Big_Integer with 154 | Ghost, 155 | Import, 156 | Global => null; 157 | 158 | function "/" (L, R : Big_Integer) return Big_Integer with 159 | Ghost, 160 | Import, 161 | Global => null; 162 | 163 | function "mod" (L, R : Big_Integer) return Big_Integer with 164 | Ghost, 165 | Import, 166 | Global => null; 167 | 168 | function "rem" (L, R : Big_Integer) return Big_Integer with 169 | Ghost, 170 | Import, 171 | Global => null; 172 | 173 | function "**" (L : Big_Integer; 174 | R : Natural) return Big_Integer with 175 | Ghost, 176 | Import, 177 | Global => null; 178 | 179 | function Min (L, R : Big_Integer) return Big_Integer with 180 | Ghost, 181 | Import, 182 | Global => null; 183 | 184 | function Max (L, R : Big_Integer) return Big_Integer with 185 | Ghost, 186 | Import, 187 | Global => null; 188 | 189 | function Greates_Common_Divisor (L, R : Big_Integer) 190 | return Big_Positive with 191 | Pre => (L /= To_Big_Integer (0) and then R /= To_Big_Integer (0)), 192 | Global => null, 193 | Ghost, 194 | Import; 195 | 196 | private 197 | 198 | type Big_Integer is null record; 199 | 200 | end Ada.Numerics.Big_Numbers.Big_Integers; 201 | --------------------------------------------------------------------------------