diff -uNr a/adaclock/MANIFEST b/adaclock/MANIFEST --- a/adaclock/MANIFEST false +++ b/adaclock/MANIFEST ae69740a32358607bf6ac5839d606ff72fc87b9fec5469df50e1f345a68ada135089c740e8275734bbabc8b5eefb315c88cf29f94bb3e9ce6fdcd3c592962630 @@ -0,0 +1 @@ + 850294 adaclock_genesis "Genesis." diff -uNr a/adaclock/adaclock.adb b/adaclock/adaclock.adb --- a/adaclock/adaclock.adb false +++ b/adaclock/adaclock.adb 947f4bac02fcf9a97ba478f4deaec7672c5094f90b9c2ccac65e4a7d620cab64bf25cc2d60e95ab820959736bd601154534a537177c9a02b6a39ec78d70198f2 @@ -0,0 +1,21 @@ +with Weightless.DPMI; use Weightless.DPMI; +with Weightless.DPMI.Process_Control; use Weightless.DPMI.Process_Control; +with Weightless.DPMI.DPMI_API; use Weightless.DPMI.DPMI_API; +with Clock; use Clock; + +procedure AdaClock is + Unused_Error : DPMI_Error; +begin + Disable_Interrupts; + Proper_Selector := Get_Data_Selector; + Unused_Error := + Get_Protected_Mode_Interrupt_Vector(IRQ_0, + Old_Handler.Selector, + Old_Handler.Address); + Unused_Error := + Set_Protected_Mode_Interrupt_Vector(IRQ_0, + Get_Code_Selector, + Display_Clock_Wrapper'Address); + Enable_Interrupts; + Terminate_And_Stay_Resident(0); +end AdaClock; diff -uNr a/adaclock/adaclock.gpr b/adaclock/adaclock.gpr --- a/adaclock/adaclock.gpr false +++ b/adaclock/adaclock.gpr 7ac17c5e889a69820d2ed2b56f15bbfe8a17710e9088593f91c74dfc4c92d89826d9005bef932442e880292bda85d39a5b6a7807a817480051aed835f958a338 @@ -0,0 +1,25 @@ +project AdaClock is + for Languages use ("Ada"); + for Source_Dirs use ("."); + for Exec_Dir use "bin"; + for Object_Dir use "obj"; + for Main use ("adaclock.adb"); + + package Compiler is + for Switches ("Ada") + use ("-O2", "-gnatg", "-gnatyN", + "-fstack-check", + "-fdata-sections", "-ffunction-sections", + "-gnatec=" & AdaClock'Project_Dir & "restrict.adc"); + end Compiler; + + package Binder is + for Switches ("Ada") + use ("-static"); + end Binder; + + package Linker is + for Switches ("Ada") + use ("-Wl,--gc-sections"); + end Linker; +end AdaClock; diff -uNr a/adaclock/bin/README b/adaclock/bin/README --- a/adaclock/bin/README false +++ b/adaclock/bin/README 5fdbae897eb301a711bf95707f329517db540e34c182a5beec96e93d5d0d856cec2ed6b01c1191f865e8d1c45709a462c70c3005d4aa3676eb445d1479edf2e5 @@ -0,0 +1 @@ +Placeholder. diff -uNr a/adaclock/clock.adb b/adaclock/clock.adb --- a/adaclock/clock.adb false +++ b/adaclock/clock.adb 269439489b51ddac5d2f3371ffc7105cf9b9a26c8946fa87a0f6019f09f08030053296465c7b1c4d7ca7b9ade0bfde8ec95ef023d36336157e53ba1283c21aaf @@ -0,0 +1,88 @@ +with Interfaces; use Interfaces; +with System.Machine_Code; use System.Machine_Code; +with System.Storage_Elements; use System.Storage_Elements; +with Weightless.DPMI.System_Time; use Weightless.DPMI.System_Time; + +package body Clock is + + procedure Disable_Interrupts is + begin + Asm("cli", Volatile => True); + end Disable_Interrupts; + + procedure Enable_Interrupts is + begin + Asm("sti", Volatile => True); + end Enable_Interrupts; + + function Get_Code_Selector return Selector_Type is + Code_Selector : Selector_Type; + begin + Asm("mov %%cs,%0", + Outputs => Selector_Type'Asm_Output("=g", Code_Selector), + Volatile => True); + return Code_Selector; + end Get_Code_Selector; + + function Get_Data_Selector return Selector_Type is + Data_Selector : Selector_Type; + begin + Asm("mov %%ds,%0", + Outputs => Selector_Type'Asm_Output("=g", Data_Selector), + Volatile => True); + return Data_Selector; + end Get_Data_Selector; + + procedure Display(Item : String) is + Addr : System.Address := To_Address(16#b8000#); + Addr1 : System.Address := To_Address(16#b8001#); + begin + for i in Item'Range loop + declare + Char : Character with Address => Addr, Alignment => 1; + Color : Unsigned_8 with Address => Addr1, Alignment => 1; + begin + Char := Item(i); + Color := 16#07#; + end; + Addr := Addr + 2; + Addr1 := Addr1 + 2; + end loop; + end Display; + + procedure Display_Clock is + Unused_H : Hour; + Unused_M : Minutes; + S : Seconds; + Unused_SS : Centiseconds; + begin + Get_System_Time(Unused_H, + Unused_M, + S, + Unused_SS); + + if S mod 2 = 1 then + Display("TIC"); + else + Display("TAC"); + end if; + end Display_Clock; + + procedure Display_Clock_Wrapper is + begin + Asm("pushal" & ASCII.LF & ASCII.HT & + "push %%ds" & ASCII.LF & ASCII.HT & + "mov %%cs:%P0, %%ds" & ASCII.LF & ASCII.HT & + "call %P1" & ASCII.LF & ASCII.HT & + "pushfl" & ASCII.LF & ASCII.HT & + "lcall %2" & ASCII.LF & ASCII.HT & + "pop %%ds" & ASCII.LF & ASCII.HT & + "popal" & ASCII.LF & ASCII.HT & + "iret", + Inputs => (System.Address'Asm_Input("i", Proper_Selector'Address), + System.Address'Asm_Input("i", Display_Clock'Address), + Exception_Handler'Asm_Input("m", Old_Handler)), + Volatile => True); + end Display_Clock_Wrapper; + +end Clock; diff -uNr a/adaclock/clock.ads b/adaclock/clock.ads --- a/adaclock/clock.ads false +++ b/adaclock/clock.ads da69c8d0dbada4ff77117495addb0f942bbc10cef501df4ef05c0f5f53a5ce86fea24e9caf88ee81a97e91ad96a7b515b8c0e79f79279b79b1e3a15470556341 @@ -0,0 +1,36 @@ +with System; +with Weightless.DPMI; use Weightless.DPMI; +with Weightless.DPMI.DPMI_API; use Weightless.DPMI.DPMI_API; + +package Clock is + + type Exception_Handler is record + Selector : Selector_Type; + Address : System.Address; + end record; + + for Exception_Handler use record + Address at 0 range 0 .. 31; + Selector at 0 range 32 .. 47; + end record; + + Proper_Selector : aliased Selector_Type; + Old_Handler : aliased Exception_Handler; + + procedure Disable_Interrupts; + procedure Enable_Interrupts; + + IRQ_0 : constant := 8; + + function Get_Code_Selector return Selector_Type; + function Get_Data_Selector return Selector_Type; + + procedure Display_Clock; + procedure Display_Clock_Wrapper; + +private + pragma Inline_Always(Disable_Interrupts); + pragma Inline_Always(Enable_Interrupts); + pragma Inline_Always(Get_Code_Selector); + pragma Inline_Always(Get_Data_Selector); +end Clock; diff -uNr a/adaclock/obj/README b/adaclock/obj/README --- a/adaclock/obj/README false +++ b/adaclock/obj/README 5fdbae897eb301a711bf95707f329517db540e34c182a5beec96e93d5d0d856cec2ed6b01c1191f865e8d1c45709a462c70c3005d4aa3676eb445d1479edf2e5 @@ -0,0 +1 @@ +Placeholder. diff -uNr a/adaclock/restrict.adc b/adaclock/restrict.adc --- a/adaclock/restrict.adc false +++ b/adaclock/restrict.adc 870e06c671b6049b73a1ddff5208981292c4ac848c9311b92d2cbe84d72b3a939918bb2381892b173d5235e4b14b17c63627de362b7ef872baa982999a86c43b @@ -0,0 +1,65 @@ +pragma Restrictions(Immediate_Reclamation); +pragma Restrictions(Max_Asynchronous_Select_Nesting => 0); +pragma Restrictions(Max_Protected_Entries => 0); +pragma Restrictions(Max_Select_Alternatives => 0); +pragma Restrictions(Max_Task_Entries => 0); +pragma Restrictions(Max_Tasks => 0); +pragma Restrictions(No_Abort_Statements); +pragma Restrictions(No_Access_Parameter_Allocators); +pragma Restrictions(No_Allocators); +pragma Restrictions(No_Asynchronous_Control); +pragma Restrictions(No_Calendar); +pragma Restrictions(No_Coextensions); +pragma Restrictions(No_Default_Stream_Attributes); +pragma Restrictions(No_Delay); +pragma Restrictions(No_Dispatch); +pragma Restrictions(No_Dispatching_Calls); +pragma Restrictions(No_Dynamic_Attachment); +pragma Restrictions(No_Dynamic_Priorities); +pragma Restrictions(No_Entry_Calls_In_Elaboration_Code); +pragma Restrictions(No_Entry_Queue); +pragma Restrictions(No_Enumeration_Maps); +pragma Restrictions(No_Exception_Propagation); +pragma Restrictions(No_Exception_Registration); +pragma Restrictions(No_Finalization); +--pragma Restrictions(No_Fixed_Io); +pragma Restrictions(No_Floating_Point); +pragma Restrictions(No_Implementation_Aspect_Specifications); +pragma Restrictions(No_Implementation_Units); +pragma Restrictions(No_Implicit_Aliasing); +pragma Restrictions(No_Implicit_Conditionals); +pragma Restrictions(No_Implicit_Dynamic_Code); +pragma Restrictions(No_Implicit_Heap_Allocations); +--pragma Restrictions(No_Implicit_Protected_Object_Allocations); +--pragma Restrictions(No_Implicit_Task_Allocations); +pragma Restrictions(No_Initialize_Scalars); +pragma Restrictions(No_Local_Protected_Objects); +pragma Restrictions(No_Local_Timing_Events); +--pragma Restrictions(No_Multiple_Elaboration); +pragma Restrictions(No_Nested_Finalization); +pragma Restrictions(No_Protected_Type_Allocators); +pragma Restrictions(No_Protected_Types); +pragma Restrictions(No_Relative_Delay); +pragma Restrictions(No_Requeue_Statements); +pragma Restrictions(No_Secondary_Stack); +pragma Restrictions(No_Select_Statements); +pragma Restrictions(No_Specific_Termination_Handlers); +pragma Restrictions(No_Standard_Allocators_After_Elaboration); +pragma Restrictions(No_Stream_Optimizations); +pragma Restrictions(No_Streams); +pragma Restrictions(No_Task_Allocators); +--pragma Restrictions(No_Task_At_Interrupt_Priority); +pragma Restrictions(No_Task_Attributes_Package); +pragma Restrictions(No_Task_Hierarchy); +pragma Restrictions(No_Tasking); +pragma Restrictions(No_Task_Termination); +pragma Restrictions(No_Terminate_Alternatives); +pragma Restrictions(No_Unchecked_Access); +pragma Restrictions(No_Unchecked_Conversion); +pragma Restrictions(No_Unchecked_Deallocation); +pragma Restrictions(No_Wide_Characters); +--pragma Restrictions(Pure_Barriers); +pragma Restrictions(Simple_Barriers); +pragma Restrictions(Static_Priorities); +pragma Restrictions(Static_Storage_Size); +pragma Validity_Checks(ALL_CHECKS);