diff --git a/repos/libports/include/ada/exception.h b/repos/libports/include/ada/exception.h new file mode 100644 index 0000000000..8d0b9ecf45 --- /dev/null +++ b/repos/libports/include/ada/exception.h @@ -0,0 +1,18 @@ + +#include + +namespace Ada { + namespace Exception { + class Program_Error : Genode::Exception {}; + class Constraint_Error : Genode::Exception {}; + class Storage_Error : Genode::Exception {}; + + class Length_Check : Constraint_Error {}; + class Overflow_Check : Constraint_Error {}; + class Invalid_Data : Constraint_Error {}; + class Range_Check : Constraint_Error {}; + class Index_Check : Constraint_Error {}; + class Discriminant_Check : Constraint_Error {}; + class Divide_By_Zero : Constraint_Error {}; + }; +}; diff --git a/repos/libports/lib/mk/ada.mk b/repos/libports/lib/mk/ada.mk index b11cf89abb..ee819678ad 100644 --- a/repos/libports/lib/mk/ada.mk +++ b/repos/libports/lib/mk/ada.mk @@ -3,7 +3,7 @@ include $(REP_DIR)/lib/import/import-ada.mk ADALIB = $(ADA_RTS)/adalib ADAINCLUDE = $(ADA_RTS)/adainclude -PACKAGES = system s-stoele s-secsta +PACKAGES = system s-stoele s-secsta a-except s-conca2 body_exists := $(filter $1.adb,$(shell if [ -e $2/$1.adb ]; then echo $1.adb; fi)) @@ -18,10 +18,10 @@ CUSTOM_ADA_OPT = $(CC_ADA_OPT) CUSTOM_ADA_INCLUDE = -I- -I$(REP_DIR)/src/lib/ada/runtime -I$(ADA_RTS_SOURCE) -I$(REP_DIR)/src/lib/ada/runtimelib # pure C runtime implementations -SRC_CC += a-except_c.cc s-soflin_c.cc +SRC_CC += a-except_c.cc s-soflin_c.cc a-exctab_c.cc # C runtime glue code -SRC_CC += s-secsta_c.cc gnat_except.cc +SRC_CC += s-secsta_c.cc # Ada packages that implement runtime functionality SRC_ADB += ss_utils.adb diff --git a/repos/libports/run/ada_exception.run b/repos/libports/run/ada_exception.run new file mode 100644 index 0000000000..837e8ddd3f --- /dev/null +++ b/repos/libports/run/ada_exception.run @@ -0,0 +1,33 @@ +build "core init test/ada_exception" + +create_boot_directory + +install_config { + + + + + + + + + + + + + + + +} + +build_boot_image "core ld.lib.so ada.lib.so init test-ada_exception" + +append qemu_args "-nographic " + +run_genode_until {child "test-ada_secondary_stack" exited with exit value 0.*} 20 + +grep_output {successful} + +compare_output_to { + [init -> test-ada_secondary_stack] secondary stack test successful +} diff --git a/repos/libports/src/lib/ada/runtime/a-except.adb b/repos/libports/src/lib/ada/runtime/a-except.adb new file mode 100644 index 0000000000..e60cecf39a --- /dev/null +++ b/repos/libports/src/lib/ada/runtime/a-except.adb @@ -0,0 +1,70 @@ +package body Ada.Exceptions is + + ---------------------------- + -- Raise_Exception_Always -- + ---------------------------- + + procedure Raise_Exception_Always ( + E : Exception_Id; + Message : String := "" + ) + is + procedure Raise_Ada_Exception ( + Name : System.Address; + Msg : System.Address + ) + with + Import, + Convention => C, + External_Name => "raise_ada_exception"; + C_Msg : String := Message & Character'Val (0); + begin + Warn_Not_Implemented ("Raise_Exception_Always"); + Raise_Ada_Exception (E.Full_Name, C_Msg'Address); + end Raise_Exception_Always; + + procedure Raise_Exception ( + E : Exception_Id; + Message : String := "" + ) + is + begin + Raise_Exception_Always (E, Message); + end Raise_Exception; + + procedure Reraise_Occurrence_No_Defer ( + X : Exception_Occurrence + ) + is + pragma Unreferenced (X); + begin + Warn_Not_Implemented ("Reraise_Occurrence_No_Defer"); + end Reraise_Occurrence_No_Defer; + + procedure Save_Occurrence ( + Target : out Exception_Occurrence; + Source : Exception_Occurrence + ) + is + begin + Warn_Not_Implemented ("Save_Occurrence"); + Target := Source; + end Save_Occurrence; + + procedure Warn_Not_Implemented ( + Name : String + ) + is + procedure C_Warn_Unimplemented_Function ( + Func : System.Address + ) + with + Import, + Convention => C, + External_Name => "warn_unimplemented_function"; + C_Name : String := Name & Character'Val (0); + begin + C_Warn_Unimplemented_Function (C_Name'Address); + end Warn_Not_Implemented; + +end Ada.Exceptions; diff --git a/repos/libports/src/lib/ada/runtime/a-except.ads b/repos/libports/src/lib/ada/runtime/a-except.ads new file mode 100644 index 0000000000..1f183d1a88 --- /dev/null +++ b/repos/libports/src/lib/ada/runtime/a-except.ads @@ -0,0 +1,60 @@ +with System; + +package Ada.Exceptions is + + type Exception_Id is private; + type Exception_Occurrence is limited private; + type Exception_Occurrence_Access is access all Exception_Occurrence; + + procedure Raise_Exception_Always ( + E : Exception_Id; + Message : String := "" + ) + with + Export, + Convention => Ada, + External_Name => "__gnat_raise_exception"; + + procedure Raise_Exception ( + E : Exception_Id; + Message : String := "" + ); + + procedure Reraise_Occurrence_No_Defer ( + X : Exception_Occurrence + ); + + procedure Save_Occurrence ( + Target : out Exception_Occurrence; + Source : Exception_Occurrence + ); + +private + + -- the following declarations belong to s-stalib.ads + -- begin s-stalib.ads + type Exception_Data; + type Exception_Data_Ptr is access all Exception_Data; + type Raise_Action is access procedure; + + type Exception_Data is record + Not_Handled_By_Others : Boolean; + Lang : Character; + Name_Length : Natural; + Full_Name : System.Address; + HTable_Ptr : Exception_Data_Ptr; + Foreign_Data : System.Address; + Raise_Hook : Raise_Action; + end record; + -- end s-stalib.ads + + type Exception_Id is new Exception_Data_Ptr; + type Exception_Occurrence is record + null; + end record; + + procedure Warn_Not_Implemented ( + Name : String + ); + +end Ada.Exceptions; diff --git a/repos/libports/src/lib/ada/runtime/s-secsta.ads b/repos/libports/src/lib/ada/runtime/s-secsta.ads index 49e36d2dd1..c073d7ee42 100644 --- a/repos/libports/src/lib/ada/runtime/s-secsta.ads +++ b/repos/libports/src/lib/ada/runtime/s-secsta.ads @@ -21,6 +21,9 @@ package System.Secondary_Stack is private + SS_Pool : Integer; + -- This is not used but needed since the build will fail otherwise + type Mark_Id is record Sstk : System.Address; Sptr : SSE.Integer_Address; diff --git a/repos/libports/src/lib/ada/runtimelib/a-except.h b/repos/libports/src/lib/ada/runtimelib/a-except.h deleted file mode 100644 index 09802235f2..0000000000 --- a/repos/libports/src/lib/ada/runtimelib/a-except.h +++ /dev/null @@ -1,7 +0,0 @@ - -extern "C" { - - void ada__exceptions__reraise_occurrence_no_defer(); - void ada__exceptions__save_occurrence(); - -} diff --git a/repos/libports/src/lib/ada/runtimelib/a-except_c.cc b/repos/libports/src/lib/ada/runtimelib/a-except_c.cc index a7eaf0daee..7f40dda94f 100644 --- a/repos/libports/src/lib/ada/runtimelib/a-except_c.cc +++ b/repos/libports/src/lib/ada/runtimelib/a-except_c.cc @@ -1,16 +1,97 @@ #include +#include +#include extern "C" { - void ada__exceptions__reraise_occurrence_no_defer() + /* Program Error */ + void __gnat_rcheck_PE_Explicit_Raise(char *file, int line) { - Genode::warning(__func__, " not implemented"); + Genode::error("Program Error in ", Genode::Cstring(file), " at line ", line); + throw Ada::Exception::Program_Error(); } - void ada__exceptions__save_occurrence() + /* Constraint Error */ + void __gnat_rcheck_CE_Explicit_Raise(char *file, int line) { - Genode::warning(__func__, " not implemented"); + Genode::error("Constraint Error in ", Genode::Cstring(file), " at line ", line); + throw Ada::Exception::Constraint_Error(); + } + + /* Storage Error */ + void __gnat_rcheck_SE_Explicit_Raise(char *file, int line) + { + Genode::error("Storage Error in ", Genode::Cstring(file), " at line ", line); + throw Ada::Exception::Storage_Error(); + } + + /* Constraint Error subtypes */ + + /* Length check failed */ + void __gnat_rcheck_CE_Length_Check(char *file, int line) + { + Genode::error("Constraint Error: Length check failed in ", + Genode::Cstring(file), " at line ", line); + throw Ada::Exception::Length_Check(); + } + + /* Overflow check failed */ + void __gnat_rcheck_CE_Overflow_Check(char *file, int line) + { + Genode::error("Constraint Error: Overflow check failed in ", + Genode::Cstring(file), " at line ", line); + throw Ada::Exception::Overflow_Check(); + } + + /* Invalid data */ + void __gnat_rcheck_CE_Invalid_Data(char *file, int line) + { + Genode::error("Constraint Error: Invalid data in ", + Genode::Cstring(file), " at line ", line); + throw Ada::Exception::Invalid_Data(); + } + + /* Range check failed */ + void __gnat_rcheck_CE_Range_Check(char *file, int line) + { + Genode::error("Constraint Error: Range check failed in ", + Genode::Cstring(file), " at line ", line); + throw Ada::Exception::Range_Check(); + } + + /* Index check failed */ + void __gnat_rcheck_CE_Index_Check(char *file, int line) + { + Genode::error("Constraint Error: Index check failed in ", + Genode::Cstring(file), " at line ", line); + throw Ada::Exception::Index_Check(); + } + + /* Discriminant check failed */ + void __gnat_rcheck_CE_Discriminant_Check(char *file, int line) + { + Genode::error("Constraint Error: Discriminant check failed in ", + Genode::Cstring(file), " at line ", line); + throw Ada::Exception::Discriminant_Check(); + } + + /* Divide by 0 */ + void __gnat_rcheck_CE_Divide_By_Zero (char *file, int line) + { + Genode::error("Constraint Error: Divide by zero in ", + Genode::Cstring(file), " at line ", line); + throw Ada::Exception::Divide_By_Zero(); + } + + void raise_ada_exception(char *name, char *message) + { + Genode::error(Genode::Cstring(name), " raised: ", Genode::Cstring(message)); + } + + void warn_unimplemented_function(char *func) + { + Genode::warning(Genode::Cstring(func), " unimplemented"); } } diff --git a/repos/libports/src/lib/ada/runtimelib/a-exctab_c.cc b/repos/libports/src/lib/ada/runtimelib/a-exctab_c.cc new file mode 100644 index 0000000000..292caaf1d0 --- /dev/null +++ b/repos/libports/src/lib/ada/runtimelib/a-exctab_c.cc @@ -0,0 +1,11 @@ + +#include + +extern "C" { + + void system__exception_table__register() + { + Genode::warning(__func__, " not implemented"); + } + +} diff --git a/repos/libports/src/lib/ada/runtimelib/gnat_except.cc b/repos/libports/src/lib/ada/runtimelib/gnat_except.cc deleted file mode 100644 index 14a9fac826..0000000000 --- a/repos/libports/src/lib/ada/runtimelib/gnat_except.cc +++ /dev/null @@ -1,21 +0,0 @@ - -#include - -extern "C" { - - void __gnat_rcheck_CE_Explicit_Raise() - { - Genode::warning("Unhandled Ada exception: Constraint_Error"); - } - - void __gnat_rcheck_SE_Explicit_Raise() - { - Genode::warning("Unhandled Ada exception: Storage_Error"); - } - - void __gnat_rcheck_PE_Explicit_Raise() - { - Genode::warning("Unhandled Ada exception: Program_Error"); - } - -} diff --git a/repos/libports/src/lib/ada/runtimelib/s-soflin.h b/repos/libports/src/lib/ada/runtimelib/s-soflin.h deleted file mode 100644 index fec085f916..0000000000 --- a/repos/libports/src/lib/ada/runtimelib/s-soflin.h +++ /dev/null @@ -1,9 +0,0 @@ - -extern "C" { - - void system__soft_links__get_current_excep(); - void system__soft_links__get_gnat_exception(); - void system__soft_links__get_jmpbuf_address_soft(); - void system__soft_links__set_jmpbuf_address_soft(); - -} diff --git a/repos/libports/src/lib/ada/runtimelib/s-soflin_c.cc b/repos/libports/src/lib/ada/runtimelib/s-soflin_c.cc index 998f008345..18ecd34631 100644 --- a/repos/libports/src/lib/ada/runtimelib/s-soflin_c.cc +++ b/repos/libports/src/lib/ada/runtimelib/s-soflin_c.cc @@ -23,4 +23,14 @@ extern "C" { Genode::warning(__func__, " not implemented"); } + void system__soft_links__lock_task() + { + Genode::warning(__func__, " not implemented"); + } + + void system__soft_links__unlock_task() + { + Genode::warning(__func__, " not implemented"); + } + } diff --git a/repos/libports/src/test/ada_exception/except.adb b/repos/libports/src/test/ada_exception/except.adb new file mode 100644 index 0000000000..ecc9a6157b --- /dev/null +++ b/repos/libports/src/test/ada_exception/except.adb @@ -0,0 +1,9 @@ +package body Except is + + procedure Raise_Task + is + begin + raise Program_Error; + end Raise_Task; + +end Except; diff --git a/repos/libports/src/test/ada_exception/except.ads b/repos/libports/src/test/ada_exception/except.ads new file mode 100644 index 0000000000..0234d6ba0d --- /dev/null +++ b/repos/libports/src/test/ada_exception/except.ads @@ -0,0 +1,5 @@ +package Except is + + procedure Raise_Task; + +end Except; diff --git a/repos/libports/src/test/ada_exception/main.cc b/repos/libports/src/test/ada_exception/main.cc new file mode 100644 index 0000000000..10543c1b58 --- /dev/null +++ b/repos/libports/src/test/ada_exception/main.cc @@ -0,0 +1,14 @@ + +#include +#include + +extern "C" void except__raise_task(); + +void Component::construct(Genode::Env &env) +{ + Genode::log("Ada exception test"); + + except__raise_task(); + + env.parent().exit(0); +} diff --git a/repos/libports/src/test/ada_exception/target.mk b/repos/libports/src/test/ada_exception/target.mk new file mode 100644 index 0000000000..34d19273ed --- /dev/null +++ b/repos/libports/src/test/ada_exception/target.mk @@ -0,0 +1,5 @@ +TARGET = test-ada_exception +SRC_ADB = except.adb +SRC_CC = main.cc +LIBS = base ada +INC_DIR += $(PRG_DIR)