The unified diff between revisions [3ec63748..] and [26f89b6c..] is displayed below. It can also be downloaded as a raw diff.
#
#
# add_file "src/core/lovelace-cpu_context.adb"
# content [e7d4367e6717520c4fb279a858e783c950657ebd]
#
# add_file "src/core/lovelace-cpu_context.ads"
# content [3c0d1efcbe412dde803090d3563ca1a64e0a8aca]
#
# add_file "src/core/lovelace-signals.adb"
# content [3d294b5da2326da2691ea7ec8759ea105f2bda2f]
#
# add_file "src/core/lovelace-signals.ads"
# content [f26c304e7b99b5ca70e67348e70bfedc5c139d63]
#
# add_file "src/core/lovelace-strings.adb"
# content [22715563ede0b0903a7ad66857dbd373cbdf62fb]
#
# add_file "src/core/lovelace-strings.ads"
# content [771f343fbb9933cacba81a5851e4e8d2095e27d5]
#
# add_file "src/core/lovelace-tasking-scheduler.adb"
# content [2d0b4d1189a62f5ffae8c5f0330846c43b730200]
#
# add_file "src/core/lovelace-tasking-scheduler.ads"
# content [cc509d536489e1d9315af056cad97a32bdd7103d]
#
# add_file "src/core/lovelace-tasking-threads.adb"
# content [8c79d813e2a1b3343b2feb6aaf1a5a01ca658ed6]
#
# add_file "src/core/lovelace-tasking-threads.ads"
# content [d20cedc048fc86ae3769ea9c0ad804436b09eb99]
#
# add_file "src/core/lovelace-tasking.ads"
# content [4b1bd326b1dff23e79c4a5dbe1be393a78b3a45a]
#
# add_file "src/core/lovelace-time.adb"
# content [850de3b3dfdcb15d1f0db786c7b8d057e9366694]
#
# add_file "src/core/lovelace-time.ads"
# content [8d5807dcf495eb90e5d25fb4d133b143f1608558]
#
# patch "GNUmakefile"
# from [ccd66c32dc82b88c3b7e5bd212b57099357fd16d]
# to [916e64c0992411d23a40f365da6c27e397b63c6d]
#
# patch "config/adactl_rules"
# from [954d4c36ad992f0d039793723702a24f745afc9e]
# to [2e6ef6f7aa841710ccf95c7868f6d795d1a8528c]
#
# patch "config/boards/qemu_x86.mk"
# from [fc52fba3e85cf14f35efaccf2e383c875c16e1cc]
# to [32b6bcf67b1264e9d272a87465e7ae617716fc5e]
#
# patch "runtime_kernel/GNUmakefile"
# from [13cb210e8185b28316d1feea10120ca1b0668367]
# to [bd08153776a006bbf32a9f43c6eeaee87ec45127]
#
# patch "src/boards/qemu_x86/bootstrap_common.adb"
# from [8e68eb61ef33f8896261df826a22b2125f61068c]
# to [c949b0ae464b4115b73b0c1d2aba86d6284e8645]
#
# patch "src/boards/qemu_x86/lovelace-stage1-console.adb"
# from [b03da1fc3dfa81764306ac38a13193ad71ac3f7c]
# to [d6f54507200ecaa8bcc4666244360bb23e24378b]
#
# patch "src/boards/qemu_x86/lovelace-stage1-i8259.adb"
# from [596682c0f8ed488abcad1b9af892c0cbb63fd61a]
# to [5b7a29267daed403e75b4846066ed906c83c67b1]
#
# patch "src/boards/qemu_x86/lovelace-stage1-idt.adb"
# from [ecc4909ccdff927bb9369843966846a1556bdd39]
# to [ed485b4833f5cf149c283e5d436c973be2beac66]
#
# patch "src/boards/qemu_x86/lovelace-stage1-idt.ads"
# from [e33243d8142a1db678c43f197d24c7d7b34e1807]
# to [632da2fc6678a8c3e66d65c9ddcb243f51a82cdf]
#
# patch "src/boards/qemu_x86/lovelace-stage1-interrupts.adb"
# from [332c129988698a57a0dfe1c7445b2b815360fd11]
# to [0938e42e6d33e10ace5279df59d0029adcfc7b31]
#
# patch "src/boards/qemu_x86/lovelace-stage1-interrupts.ads"
# from [74750edc4f672aae6778d56ce4101db8ca6c0ffc]
# to [5c26577fd3457fccaa7d3f70a42509becc68fb79]
#
# patch "src/boards/qemu_x86/lovelace-stage1-segmentation.adb"
# from [3f9cb2c556255db36a52cc8917de6379912ff226]
# to [af289ea760f3803bd13a0a5fcf21f3a653a7ea25]
#
# patch "src/boards/qemu_x86/lovelace-stage1-segmentation.ads"
# from [fd7f4d5dfd4845c070e47afb9465a82f6b475784]
# to [4fc5081b89a7c492c80a608e3eaadd35a58d970c]
#
# patch "src/core/lovelace-stage1-console.ads"
# from [57a5aa0c640017fe16eea7291c443256fd17dcb0]
# to [2096e265f7af8bce0a30f1507ba4e46d8b076686]
#
# patch "src/core/lovelace-stage1-memory-allocation.adb"
# from [c6573dcf0ea4dca105ec02fc736c8c70df3864c2]
# to [b36861bffe496afd297e07902efcae9d709d7801]
#
# patch "src/core/lovelace.ads"
# from [1c0b25eadcb86aa2334572bb08274a8d12ea26d2]
# to [32ae14a6985b0448795b60808c9b9a32c774bf9d]
#
============================================================
--- src/core/lovelace-cpu_context.adb e7d4367e6717520c4fb279a858e783c950657ebd
+++ src/core/lovelace-cpu_context.adb e7d4367e6717520c4fb279a858e783c950657ebd
@@ -0,0 +1,241 @@
+with System.Machine_Code;
+
+with Lovelace.Stage1.Console;
+with Lovelace.Stage1.Idt;
+with Lovelace.Stage1.Memory;
+with Lovelace.Stage1.Segmentation;
+with Lovelace.Strings;
+
+package body Lovelace.Cpu_Context is
+ package body Switch is
+ type Core_Routine_Ptr is access procedure
+ (Start_Func : Cpu_Kstate_Function_Arg1_T_Ptr;
+ Start_Arg : in out Item;
+ Exit_Func : Cpu_Kstate_Function_Arg1_T_Ptr;
+ Exit_Arg : in out Item);
+ function To_Virtual_Address is new Ada.Unchecked_Conversion
+ (Core_Routine_Ptr, Virtual_Address_Type);
+ procedure Core_Routine (Start_Func : Cpu_Kstate_Function_Arg1_T_Ptr;
+ Start_Arg : in out Item;
+ Exit_Func : Cpu_Kstate_Function_Arg1_T_Ptr;
+ Exit_Arg : in out Item);
+ pragma No_Return (Core_Routine);
+ procedure Core_Routine (Start_Func : Cpu_Kstate_Function_Arg1_T_Ptr;
+ Start_Arg : in out Item;
+ Exit_Func : Cpu_Kstate_Function_Arg1_T_Ptr;
+ Exit_Arg : in out Item) is
+ begin
+ Start_Func (Start_Arg);
+ Exit_Func (Exit_Arg);
+ raise Not_Executable_Code with
+ "The exit function of the thread should NOT return !";
+ end Core_Routine;
+
+ -----------------
+ -- Kstate_Init --
+ -----------------
+
+ procedure Kstate_Init
+ (Ctxt : in out Cpu_Kstate_Ptr;
+ Start_Func : Cpu_Kstate_Function_Arg1_T_Ptr;
+ Start_Arg : Item;
+ Stack_Bottom : Virtual_Address_Type;
+ Stack_Size : Unsigned_32;
+ Exit_Func : Cpu_Kstate_Function_Arg1_T_Ptr;
+ Exit_Arg : Item)
+ is
+ Tmp_Vaddr : Virtual_Address_Type := Stack_Bottom +
+ Virtual_Address_Type (Stack_Size);
+ type Type_Stack is record
+ Null_Value : Unsigned_32 := 0;
+ Start_Func : Cpu_Kstate_Function_Arg1_T_Ptr := null;
+ Start_Arg : Item;
+ Exit_Func : Cpu_Kstate_Function_Arg1_T_Ptr := null;
+ Exit_Arg : Item;
+ end record;
+ type Type_Stack_Ptr is access Type_Stack;
+ function To_Type_Stack_Ptr is new Ada.Unchecked_Conversion
+ (Virtual_Address_Type, Type_Stack_Ptr);
+ Tmp_Vaddr_Stack : constant Virtual_Address_Type :=
+ Tmp_Vaddr - Type_Stack'Size/8;
+ Stack : Type_Stack_Ptr;
+ begin
+ Stage1.Memory.Memset (Stage1.To_Address (Stack_Bottom),
+ CPU_KSTATE_STACK_POISON,
+ size_t (Stack_Size));
+ Stack := To_Type_Stack_Ptr (Tmp_Vaddr_Stack);
+ Stack.Null_Value := 0;
+ Stack.Start_Func := Start_Func;
+ Stack.Start_Arg := Start_Arg;
+ Stack.Exit_Func := Exit_Func;
+ Stack.Exit_Arg := Exit_Arg;
+
+ Tmp_Vaddr := Tmp_Vaddr_Stack - Cpu_Kstate'Size/8;
+ Ctxt := To_Cpu_Kstate_Ptr (Tmp_Vaddr);
+
+ Stage1.Memory.Memset (To_Address (Ctxt), 0, Cpu_Kstate'Size / 8);
+
+ Ctxt.Eip := To_Virtual_Address (Core_Routine'Access);
+
+ Ctxt.Cs := Unsigned_32 (Stage1.Idt.BUILD_SEGMENT_REG_VALUE
+ (0, False, Stage1.Segmentation.SEG_KCODE));
+ Ctxt.Ds := Unsigned_16 (Stage1.Idt.BUILD_SEGMENT_REG_VALUE
+ (0, False, Stage1.Segmentation.SEG_KDATA));
+ Ctxt.Es := Unsigned_16 (Stage1.Idt.BUILD_SEGMENT_REG_VALUE
+ (0, False, Stage1.Segmentation.SEG_KDATA));
+ Ctxt.Ss := Unsigned_16 (Stage1.Idt.BUILD_SEGMENT_REG_VALUE
+ (0, False, Stage1.Segmentation.SEG_KDATA));
+ Ctxt.Eflags := Shift_Left (1, 9);
+ end Kstate_Init;
+ end Switch;
+
+ -------------------
+ -- Kstate_Get_PC --
+ -------------------
+
+ function Kstate_Get_PC (Ctxt : Cpu_Kstate_Ptr)
+ return Virtual_Address_Type is
+ begin
+ if Ctxt = null then
+ raise Assertion_Failed with "Kstate_Get_PC Ctct null";
+ end if;
+ return Ctxt.Eip;
+ end Kstate_Get_PC;
+
+ -------------------
+ -- Kstate_Get_SP --
+ -------------------
+
+ function Kstate_Get_SP (Ctxt : Cpu_Kstate_Ptr)
+ return Virtual_Address_Type is
+ begin
+ if Ctxt = null then
+ raise Assertion_Failed with "Kstate_Get_SP Ctct null";
+ end if;
+ return To_Virtual_Address (Ctxt);
+ end Kstate_Get_SP;
+
+ procedure Kstate_Dump (Ctxt : Cpu_Kstate_Ptr) is
+ function Str_Virt is new
+ Strings.Modular_To_String (Virtual_Address_Type);
+ function Str_16 is new Strings.Modular_To_String (Unsigned_16);
+ function Str_32 is new Strings.Modular_To_String (Unsigned_32);
+ String_To_Dump : constant String :=
+ "CPU: eip=" & Str_Virt (Ctxt.Eip, Hexadecimal) &
+ " esp=" & Str_32 (To_Unsigned_32 (Ctxt), Hexadecimal) &
+ " eflags=" & Str_32 (Ctxt.Eflags, Hexadecimal) &
+ " cs=" & Str_32 (Ctxt.Cs, Hexadecimal) &
+ " ds=" & Str_16 (Ctxt.Ds, Hexadecimal) &
+ " ss=" & Str_16 (Ctxt.Ss, Hexadecimal) &
+ " err=" & Str_32 (Ctxt.Error_Code, Hexadecimal);
+ begin
+ Stage1.Console.Put_Line (String_To_Dump);
+ end Kstate_Dump;
+
+ function Kstate_Get_EX_Info (Ctxt : Cpu_Kstate_Ptr) return Unsigned_32 is
+ begin
+ if Ctxt = null then
+ raise Assertion_Failed with "Kstate_Get_EX_Info Ctct null";
+ end if;
+ return Ctxt.Error_Code;
+ end Kstate_Get_EX_Info;
+
+ function Kstate_Get_EX_Faulting_Vaddr (Ctxt : Cpu_Kstate_Ptr)
+ return Virtual_Address_Type is
+ pragma Unreferenced (Ctxt);
+ Cr2 : Virtual_Address_Type;
+ begin
+ System.Machine_Code.Asm ("movl %%cr2, %0",
+ Virtual_Address_Type'Asm_Output ("=r", Cr2),
+ Volatile => True);
+ return Cr2;
+ end Kstate_Get_EX_Faulting_Vaddr;
+
+ procedure Cpu_Kstate_Prepare_Detect_Stack_Overflow
+ (Ctxt : Cpu_Kstate_Ptr;
+ Stack_Bottom : Virtual_Address_Type;
+ Stack_Size : Unsigned_32) is
+ pragma Unreferenced (Ctxt);
+ Poison_Size : Unsigned_32 := CPU_KSTATE_DETECT_STACK_OVERFLOW_CST;
+ begin
+ if Poison_Size > Stack_Size then
+ Poison_Size := Stack_Size;
+ end if;
+ Stage1.Memory.Memset (Stage1.To_Address (Stack_Bottom),
+ CPU_KSTATE_STACK_POISON,
+ size_t (Poison_Size));
+ end Cpu_Kstate_Prepare_Detect_Stack_Overflow;
+
+ procedure Cpu_Kstate_Detect_Stack_Overflow
+ (Ctxt : Cpu_Kstate_Ptr;
+ Stack_Bottom : Virtual_Address_Type;
+ Stack_Size : Unsigned_32) is
+ Poison_Size : Unsigned_32 := CPU_KSTATE_DETECT_STACK_OVERFLOW_CST;
+ begin
+ if To_Virtual_Address (Ctxt) < Stack_Bottom then
+ raise Assertion_Failed with "ctxt >= stack_bottom";
+ end if;
+ if To_Virtual_Address (Ctxt) + Cpu_Kstate'Size / 8 >
+ Stack_Bottom + Virtual_Address_Type (Stack_Size) then
+ raise Assertion_Failed with
+ "Ctxt + Cpu_Kstate'Size/8 <= Stack_Bottom + Stack_Size";
+ end if;
+ if Poison_Size > Stack_Size then
+ Poison_Size := Stack_Size;
+ end if;
+ declare
+ type Verification_Vector is array (1 .. Poison_Size) of Unsigned_8;
+ The_Vector : Verification_Vector;
+ for The_Vector'Address use Stage1.To_Address (Stack_Bottom);
+ begin
+ for I in The_Vector'Range loop
+ if CPU_KSTATE_STACK_POISON /= The_Vector (I) then
+ raise Assertion_Failed with
+ "CPU_KSTATE_STACK_POISON = The_Vector (I)";
+ end if;
+ end loop;
+ end;
+ end Cpu_Kstate_Detect_Stack_Overflow;
+
+ function Backtrace (Cpu_Kstate : Cpu_Kstate_Ptr;
+ Max_Depth : Unsigned_32;
+ Stack_Bottom : Virtual_Address_Type;
+ Stack_Size : Unsigned_32;
+ Backtracer : Bactracer_Type;
+ Custom_Arg : Unsigned_32) return Unsigned_32 is
+ Callee_PC, Caller_Frame : Virtual_Address_Type;
+ Depth : Unsigned_32;
+ begin
+ if Cpu_Kstate /= null then
+ Callee_PC := Cpu_Kstate.Eip;
+ Caller_Frame := Virtual_Address_Type (Cpu_Kstate.Ebp);
+ else
+ return 0;
+ -- Callee_PC = (sos_vaddr_t)__builtin_return_address(0);
+ -- Caller_Frame = (sos_vaddr_t)__builtin_frame_address(1);
+ end if;
+ Depth := 0;
+ loop
+ exit when Depth = Max_Depth - 1;
+ Backtracer (Callee_PC, Caller_Frame + 8, Depth, Custom_Arg);
+
+ if Caller_Frame < Stack_Bottom or
+ Caller_Frame + 4 >=
+ Stack_Bottom + Virtual_Address_Type (Stack_Size) then
+ return Depth;
+ end if;
+ declare
+ Value1 : Virtual_Address_Type;
+ for Value1'Address use Stage1.To_Address (Caller_Frame + 4);
+ Value2 : Virtual_Address_Type;
+ for Value2'Address use Stage1.To_Address (Caller_Frame);
+ begin
+ Callee_PC := Value1;
+ Caller_Frame := Value2;
+ end;
+ Depth := Depth + 1;
+ end loop;
+ return Depth;
+ end Backtrace;
+
+end Lovelace.Cpu_Context;
============================================================
--- src/core/lovelace-cpu_context.ads 3c0d1efcbe412dde803090d3563ca1a64e0a8aca
+++ src/core/lovelace-cpu_context.ads 3c0d1efcbe412dde803090d3563ca1a64e0a8aca
@@ -0,0 +1,97 @@
+with Ada.Unchecked_Conversion;
+with System;
+
+package Lovelace.Cpu_Context is
+ pragma Preelaborate;
+
+ type Cpu_Kstate is private;
+ type Cpu_Kstate_Ptr is access Cpu_Kstate;
+ function To_Unsigned_32 is new Ada.Unchecked_Conversion
+ (Cpu_Kstate_Ptr, Unsigned_32);
+ function To_Virtual_Address is new Ada.Unchecked_Conversion
+ (Cpu_Kstate_Ptr, Virtual_Address_Type);
+ function To_Address is new Ada.Unchecked_Conversion
+ (Cpu_Kstate_Ptr, System.Address);
+ function To_Cpu_Kstate_Ptr is new Ada.Unchecked_Conversion
+ (Virtual_Address_Type, Cpu_Kstate_Ptr);
+
+ generic
+ type Item is private;
+ package Switch is
+ type Cpu_Kstate_Function_Arg1_T_Ptr is access
+ procedure (Arg1 : in out Item);
+ procedure Kstate_Init
+ (Ctxt : in out Cpu_Kstate_Ptr;
+ Start_Func : Cpu_Kstate_Function_Arg1_T_Ptr;
+ Start_Arg : Item;
+ Stack_Bottom : Virtual_Address_Type;
+ Stack_Size : Unsigned_32;
+ Exit_Func : Cpu_Kstate_Function_Arg1_T_Ptr;
+ Exit_Arg : Item);
+ procedure Kstate_Exit_To
+ (Switch_To_Ctxt : in Cpu_Kstate_Ptr;
+ Reclaiming_Func : in Cpu_Kstate_Function_Arg1_T_Ptr;
+ Reclaiming_Arg : in Item);
+ pragma No_Return (Kstate_Exit_To);
+ pragma Import (C, Kstate_Exit_To, "sos_cpu_kstate_exit_to");
+ end Switch;
+ procedure Kstate_Switch (From_Ctxt : in out Cpu_Kstate_Ptr;
+ To_Ctxt : in Cpu_Kstate_Ptr);
+ pragma Import (C, Kstate_Switch, "sos_cpu_kstate_switch");
+ function Kstate_Get_PC (Ctxt : Cpu_Kstate_Ptr) return Virtual_Address_Type;
+ function Kstate_Get_SP (Ctxt : Cpu_Kstate_Ptr) return Virtual_Address_Type;
+ procedure Kstate_Dump (Ctxt : Cpu_Kstate_Ptr);
+ function Kstate_Get_EX_Info (Ctxt : Cpu_Kstate_Ptr) return Unsigned_32;
+ function Kstate_Get_EX_Faulting_Vaddr (Ctxt : Cpu_Kstate_Ptr)
+ return Virtual_Address_Type;
+
+ CPU_KSTATE_STACK_POISON : constant := 16#a5#;
+
+ type Bactracer_Type is access procedure (Pc : Virtual_Address_Type;
+ Params : Virtual_Address_Type;
+ Depth : Unsigned_32;
+ Custom_Arg : Unsigned_32);
+ function Backtrace (Cpu_Kstate : Cpu_Kstate_Ptr;
+ Max_Depth : Unsigned_32;
+ Stack_Bottom : Virtual_Address_Type;
+ Stack_Size : Unsigned_32;
+ Backtracer : Bactracer_Type;
+ Custom_Arg : Unsigned_32) return Unsigned_32;
+
+ CPU_KSTATE_DETECT_STACK_OVERFLOW_CST : constant := 64;
+
+ procedure Cpu_Kstate_Prepare_Detect_Stack_Overflow
+ (Ctxt : Cpu_Kstate_Ptr;
+ Stack_Bottom : Virtual_Address_Type;
+ Stack_Size : Unsigned_32);
+
+ procedure Cpu_Kstate_Detect_Stack_Overflow
+ (Ctxt : Cpu_Kstate_Ptr;
+ Stack_Bottom : Virtual_Address_Type;
+ Stack_Size : Unsigned_32);
+
+private
+ type Cpu_Kstate is record
+ -- These are SOS convention
+ Gs : Unsigned_16;
+ Fs : Unsigned_16;
+ Es : Unsigned_16;
+ Ds : Unsigned_16;
+ Ss : Unsigned_16;
+ Alignment_Padding : Unsigned_16; -- unused
+ Eax : Unsigned_32;
+ Ebx : Unsigned_32;
+ Ecx : Unsigned_32;
+ Edx : Unsigned_32;
+ Esi : Unsigned_32;
+ Edi : Unsigned_32;
+ Ebp : Unsigned_32;
+ -- MUST NEVER CHANGE (dependent on the IA32 iret instruction)
+ Error_Code : Unsigned_32;
+ Eip : Virtual_Address_Type;
+ Cs : Unsigned_32;
+ Eflags : Unsigned_32;
+ end record;
+ pragma Pack (Cpu_Kstate);
+
+end Lovelace.Cpu_Context;
============================================================
--- src/core/lovelace-signals.adb 3d294b5da2326da2691ea7ec8759ea105f2bda2f
+++ src/core/lovelace-signals.adb 3d294b5da2326da2691ea7ec8759ea105f2bda2f
@@ -0,0 +1,124 @@
+with Lovelace.Tasking.Threads;
+
+package body Lovelace.Signals is
+
+ Full_Set : constant sigset_t := (others => True);
+ Null_Set : constant sigset_t := (others => False);
+
+ function sigaddset (set : access sigset_t; sig : Signal)
+ return Interfaces.C.int is
+ use type Interfaces.C.int;
+ begin
+ set (sig) := True;
+ return 0;
+ exception
+ when others =>
+ return -1;
+ end sigaddset;
+
+ function sigdelset (set : access sigset_t; sig : Signal)
+ return Interfaces.C.int is
+ use type Interfaces.C.int;
+ begin
+ set (sig) := False;
+ return 0;
+ exception
+ when others =>
+ return -1;
+ end sigdelset;
+
+ function sigfillset (set : access sigset_t) return Interfaces.C.int is
+ use type Interfaces.C.int;
+ begin
+ set.all := Full_Set;
+ return 0;
+ exception
+ when others =>
+ return -1;
+ end sigfillset;
+
+ function sigismember (set : access sigset_t; sig : Signal)
+ return Interfaces.C.int is
+ begin
+ if set (sig) then
+ return 1;
+ else
+ return 0;
+ end if;
+ end sigismember;
+
+ function sigemptyset (set : access sigset_t) return Interfaces.C.int is
+ use type Interfaces.C.int;
+ begin
+ set.all := Null_Set;
+ return 0;
+ exception
+ when others =>
+ return -1;
+ end sigemptyset;
+
+ function sigaction
+ (sig : Signal;
+ act : struct_sigaction_ptr;
+ oact : struct_sigaction_ptr) return Interfaces.C.int is
+ Local_Thread : constant Tasking.Kthread_Ptr :=
+ Tasking.Threads.Get_Current;
+ use type System.OS_Interface.struct_sigaction_ptr;
+ begin
+ if oact /= null then
+ oact.all := Local_Thread.Sigaction_Array (sig);
+ end if;
+ if act /= null then
+ Local_Thread.Sigaction_Array (sig) := act.all;
+ end if;
+ return 0;
+ end sigaction;
+
+ function sigwait (set : access sigset_t; sig : access Signal)
+ return Interfaces.C.int is
+ Local_Thread : constant Tasking.Kthread_Ptr :=
+ Tasking.Threads.Get_Current;
+ begin
+ loop
+ Local_Thread.One_Signal_Was_Present := False;
+ Tasking.Threads.Yield;
+ if Local_Thread.One_Signal_Was_Present then
+ exit when set (Local_Thread.Last_Signal_Handler_Executed);
+ end if;
+ end loop;
+ sig.all := Local_Thread.Last_Signal_Handler_Executed;
+ return 0;
+ end sigwait;
+ function pthread_sigmask
+ (how : Interfaces.C.int;
+ set : sigset_t_ptr;
+ oset : sigset_t_ptr) return Interfaces.C.int is
+ Local_Thread : constant Tasking.Kthread_Ptr :=
+ Tasking.Threads.Get_Current;
+ use type Interfaces.C.int;
+ use type Tasking.Kthread_Ptr;
+ begin
+ if oset /= null then
+ oset.all := Local_Thread.Blocked_Signals;
+ end if;
+ if how = System.OS_Interface.SIG_BLOCK then
+ for I in Local_Thread.Blocked_Signals'Range loop
+ if set.all (I) then
+ Local_Thread.Blocked_Signals (I) := True;
+ end if;
+ end loop;
+ elsif how = System.OS_Interface.SIG_UNBLOCK then
+ for I in Local_Thread.Blocked_Signals'Range loop
+ if set.all (I) then
+ Local_Thread.Blocked_Signals (I) := False;
+ end if;
+ end loop;
+ elsif how = System.OS_Interface.SIG_SETMASK then
+ if set /= null then
+ Local_Thread.Blocked_Signals := set.all;
+ end if;
+ end if;
+ return 0;
+ end pthread_sigmask;
+
+end Lovelace.Signals;
============================================================
--- src/core/lovelace-signals.ads f26c304e7b99b5ca70e67348e70bfedc5c139d63
+++ src/core/lovelace-signals.ads f26c304e7b99b5ca70e67348e70bfedc5c139d63
@@ -0,0 +1,50 @@
+with Interfaces.C;
+pragma Warnings (Off);
+with System.OS_Interface;
+pragma Warnings (On);
+
+package Lovelace.Signals is
+ pragma Preelaborate;
+
+ subtype unsigned_char is Interfaces.C.unsigned_char;
+ subtype Signal is System.OS_Interface.Signal;
+ subtype struct_sigaction_ptr is System.OS_Interface.struct_sigaction_ptr;
+ type sigset_t is array (System.OS_Interface.Signal) of Boolean;
+ pragma Pack (sigset_t);
+ pragma Convention (C, sigset_t);
+ type sigset_t_ptr is access all sigset_t;
+
+ function sigaddset (set : access sigset_t; sig : Signal)
+ return Interfaces.C.int;
+ pragma Export (C, sigaddset, "sigaddset");
+
+ function sigdelset (set : access sigset_t; sig : Signal)
+ return Interfaces.C.int;
+ pragma Export (C, sigdelset, "sigdelset");
+
+ function sigfillset (set : access sigset_t) return Interfaces.C.int;
+ pragma Export (C, sigfillset, "sigfillset");
+
+ function sigismember (set : access sigset_t; sig : Signal)
+ return Interfaces.C.int;
+ pragma Export (C, sigismember, "sigismember");
+
+ function sigemptyset (set : access sigset_t) return Interfaces.C.int;
+ pragma Export (C, sigemptyset, "sigemptyset");
+
+ function sigaction
+ (sig : Signal;
+ act : struct_sigaction_ptr;
+ oact : struct_sigaction_ptr) return Interfaces.C.int;
+ pragma Export (C, sigaction, "sigaction");
+ function sigwait (set : access sigset_t; sig : access Signal)
+ return Interfaces.C.int;
+ pragma Export (C, sigwait, "sigwait");
+ type Sigaction_Array_Type is array (Signal) of
+ System.OS_Interface.struct_sigaction;
+ function pthread_sigmask
+ (how : Interfaces.C.int;
+ set : sigset_t_ptr;
+ oset : sigset_t_ptr) return Interfaces.C.int;
+ pragma Export (C, pthread_sigmask, "pthread_sigmask");
+end Lovelace.Signals;
============================================================
--- src/core/lovelace-strings.adb 22715563ede0b0903a7ad66857dbd373cbdf62fb
+++ src/core/lovelace-strings.adb 22715563ede0b0903a7ad66857dbd373cbdf62fb
@@ -0,0 +1,33 @@
+pragma Warnings (Off);
+with System.Img_BIU;
+with System.Unsigned_Types;
+pragma Warnings (On);
+
+package body Lovelace.Strings is
+ function Modular_To_String (Value : Modular_Integer;
+ Display_Base : Base) return String is
+ -- 36 = 32 + base + # + # maximum string needed
+ String_To_Return : String (1 .. 36);
+ Position : Natural := 0;
+ Base_In_Integer : Natural;
+ begin
+ case Display_Base is
+ when Binary =>
+ Base_In_Integer := 2;
+ when Octal =>
+ Base_In_Integer := 8;
+ when Decimal =>
+ Base_In_Integer := 10;
+ when Hexadecimal =>
+ Base_In_Integer := 16;
+ end case;
+ System.Img_BIU.Set_Image_Based_Unsigned
+ (V => System.Unsigned_Types.Unsigned (Value),
+ B => Base_In_Integer,
+ W => 0,
+ S => String_To_Return,
+ P => Position);
+ return String_To_Return (1 .. Position);
+ end Modular_To_String;
+
+end Lovelace.Strings;
============================================================
--- src/core/lovelace-strings.ads 771f343fbb9933cacba81a5851e4e8d2095e27d5
+++ src/core/lovelace-strings.ads 771f343fbb9933cacba81a5851e4e8d2095e27d5
@@ -0,0 +1,7 @@
+package Lovelace.Strings is
+ pragma Preelaborate;
+ generic
+ type Modular_Integer is mod <>;
+ function Modular_To_String (Value : Modular_Integer;
+ Display_Base : Base) return String;
+end Lovelace.Strings;
============================================================
--- src/core/lovelace-tasking-scheduler.adb 2d0b4d1189a62f5ffae8c5f0330846c43b730200
+++ src/core/lovelace-tasking-scheduler.adb 2d0b4d1189a62f5ffae8c5f0330846c43b730200
@@ -0,0 +1,73 @@
+package body Lovelace.Tasking.Scheduler is
+
+ type Ready_Queue_Type is record
+ Nr_Threads : Unsigned_32;
+ Kthread_List : Thread_Vectors.Vector;
+ end record;
+
+ Ready_Queue : Ready_Queue_Type;
+
+ -----------
+ -- Setup --
+ -----------
+
+ procedure Setup is
+ begin
+ Ready_Queue.Nr_Threads := 0;
+ end Setup;
+
+ procedure Add_In_Ready_Queue (Thr : Kthread_Ptr;
+ Insert_At_Tail : Boolean);
+ procedure Add_In_Ready_Queue (Thr : Kthread_Ptr;
+ Insert_At_Tail : Boolean) is
+ begin
+ pragma Assert (KTHR_CREATED = Thr.State or
+ KTHR_RUNNING = Thr.State or
+ KTHR_BLOCKED = Thr.State,
+ "not good state");
+ if Insert_At_Tail then
+ Thread_Vectors.Append (Ready_Queue.Kthread_List, Thr);
+ else
+ Thread_Vectors.Prepend (Ready_Queue.Kthread_List, Thr);
+ end if;
+ Ready_Queue.Nr_Threads := Ready_Queue.Nr_Threads + 1;
+ Thr.State := KTHR_READY;
+ end Add_In_Ready_Queue;
+
+ procedure Set_Ready (Thr : Kthread_Ptr) is
+ begin
+ if Thr.State = KTHR_READY then
+ return;
+ end if;
+ Add_In_Ready_Queue (Thr, True);
+ end Set_Ready;
+
+ function Reschedule (Current_Kthread : Kthread_Ptr;
+ Do_Yield : Boolean) return Kthread_Ptr is
+ begin
+ if KTHR_ZOMBIE = Current_Kthread.State then
+ null;
+ -- Don't think of returning to this thread since it is
+ -- terminated
+ elsif KTHR_BLOCKED /= Current_Kthread.State then
+ if Do_Yield then
+ Add_In_Ready_Queue (Current_Kthread, True);
+ else
+ Add_In_Ready_Queue (Current_Kthread, False);
+ end if;
+ end if;
+ if Ready_Queue.Nr_Threads > 0 then
+ declare
+ Next_Thr : Kthread_Ptr;
+ begin
+ Next_Thr := Thread_Vectors.First_Element
+ (Ready_Queue.Kthread_List);
+ Thread_Vectors.Delete_First (Ready_Queue.Kthread_List);
+ Ready_Queue.Nr_Threads := Ready_Queue.Nr_Threads - 1;
+ return Next_Thr;
+ end;
+ end if;
+ raise Fatal_Error with "No kernel thread ready ?!";
+ end Reschedule;
+
+end Lovelace.Tasking.Scheduler;
============================================================
--- src/core/lovelace-tasking-scheduler.ads cc509d536489e1d9315af056cad97a32bdd7103d
+++ src/core/lovelace-tasking-scheduler.ads cc509d536489e1d9315af056cad97a32bdd7103d
@@ -0,0 +1,7 @@
+package Lovelace.Tasking.Scheduler is
+ pragma Preelaborate;
+ procedure Setup;
+ procedure Set_Ready (Thr : Kthread_Ptr);
+ function Reschedule (Current_Kthread : Kthread_Ptr;
+ Do_Yield : Boolean) return Kthread_Ptr;
+end Lovelace.Tasking.Scheduler;
============================================================
--- src/core/lovelace-tasking-threads.adb 8c79d813e2a1b3343b2feb6aaf1a5a01ca658ed6
+++ src/core/lovelace-tasking-threads.adb 8c79d813e2a1b3343b2feb6aaf1a5a01ca658ed6
@@ -0,0 +1,335 @@
+with Ada.Unchecked_Conversion;
+
+with Lovelace.Stage1.Interrupts;
+with Lovelace.Stage1.Memory.Paging;
+with Lovelace.Stage1.Memory.Physical;
+with Lovelace.Tasking.Scheduler;
+
+package body Lovelace.Tasking.Threads is
+
+ KTHREAD_STACK_SIZE : constant := Stage1.Memory.PAGE_SIZE;
+ Kthread_List_Global : Thread_Vectors.Vector;
+ Current_Kthread : Kthread_Ptr := null;
+ pragma Volatile (Current_Kthread);
+
+ type Switch_Type is (YIELD_MYSELF, BLOCK_MYSELF);
+ type Sleep_Timeout_Params_Type is record
+ Thread_To_Wakeup : Kthread_Ptr;
+ Timeout_Triggered : Boolean;
+ end record;
+ package Switch_Kthread_Ptr is new Cpu_Context.Switch (Kthread_Ptr);
+
+ procedure Set_Current (Thr : Kthread_Ptr);
+ procedure Switch_To_Next_Thread (Operation : Switch_Type);
+ procedure Delete_Thread (Thr : in out Kthread_Ptr);
+ procedure Sleep_Timeout (Act : Time.Timeout_Action_Ptr);
+
+ procedure Set_Current (Thr : Kthread_Ptr) is
+ begin
+ if Thr.State /= KTHR_READY then
+ raise Assertion_Failed with "Thr.state = KTHR_READY";
+ end if;
+ Current_Kthread := Thr;
+ Current_Kthread.State := KTHR_RUNNING;
+ end Set_Current;
+
+ -----------
+ -- Setup --
+ -----------
+
+ procedure Setup
+ (Init_Thread_Stack_Base_Addr : Virtual_Address_Type;
+ Init_Thread_Stack_Size : Unsigned_32)
+ is
+ Myself : Kthread_Ptr := null;
+ begin
+
+ Myself := new Kthread_Type;
+
+ Myself.Name := (others => ' ');
+ Myself.Name (1 .. 7) := "[kinit]";
+
+ Myself.State := KTHR_CREATED;
+ Myself.Stack_Base_Addr := Init_Thread_Stack_Base_Addr;
+ Myself.Stack_Size := Init_Thread_Stack_Size;
+
+ Cpu_Context.Cpu_Kstate_Prepare_Detect_Stack_Overflow
+ (Myself.Cpu_Kstate, Myself.Stack_Base_Addr, Myself.Stack_Size);
+
+ Thread_Vectors.Append (Kthread_List_Global, Myself);
+
+ Myself.Keys := (others => System.Null_Address);
+ Myself.Key_Available := (others => False);
+ Myself.State := KTHR_READY;
+ Set_Current (Myself);
+ end Setup;
+
+ ------------
+ -- Create --
+ ------------
+
+ function Create
+ (Name : String;
+ Start_Func : Start_Routine;
+ Start_Arg : System.Address)
+ return Kthread_Ptr
+ is
+ New_Thread : Kthread_Ptr;
+ Name_Length : constant Natural := Name'Length;
+ use type Start_Routine;
+ begin
+ if Start_Func = null then
+ return null;
+ end if;
+
+ New_Thread := new Kthread_Type;
+
+ if Name_Length >= New_Thread.Name'Length then
+ New_Thread.Name := Name (Name'First .. Name_Length);
+ else
+ New_Thread.Name (1 .. Name_Length) := Name;
+ New_Thread.Name (Name_Length + 1 .. KTHR_MAX_NAMELEN) :=
+ (others => ' ');
+ end if;
+ New_Thread.State := KTHR_CREATED;
+
+ declare
+ Temporary_Physical_Address : constant Physical_Address_Type :=
+ Stage1.Memory.Physical.Get_New_Page;
+ begin
+ New_Thread.Stack_Base_Addr := Virtual_Address_Type
+ (Temporary_Physical_Address);
+ Stage1.Memory.Paging.Map (Ppage_Paddr => Temporary_Physical_Address,
+ Vpage_Vaddr => New_Thread.Stack_Base_Addr,
+ Is_User_Page => False,
+ Atomic => False,
+ Prot_Read => False,
+ Prot_Write => True);
+ end;
+ New_Thread.Stack_Size := KTHREAD_STACK_SIZE;
+ Switch_System_Address.Kstate_Init (New_Thread.Cpu_Kstate,
+ Start_Func,
+ Start_Arg,
+ New_Thread.Stack_Base_Addr,
+ New_Thread.Stack_Size,
+ Exit_Thread'Access,
+ System.Null_Address);
+
+ Thread_Vectors.Append (Kthread_List_Global, New_Thread);
+
+ for I in New_Thread.Key_Available'Range loop
+ New_Thread.Key_Available (I) := False;
+ New_Thread.Keys (I) := System.Null_Address;
+ end loop;
+
+ Scheduler.Set_Ready (New_Thread);
+
+ return New_Thread;
+ exception
+ when others =>
+ Free (New_Thread);
+ return null;
+ end Create;
+
+ ----------
+ -- Yeld --
+ ----------
+
+ type Handler_Access is access
+ procedure (A_Signal : Signals.Signal);
+ function To_Handler is new Ada.Unchecked_Conversion (System.Address,
+ Handler_Access);
+ procedure Yield is
+ Flags : Unsigned_32 := 0;
+ Myself : Kthread_Ptr;
+ Handler : Handler_Access;
+ begin
+ Myself := Current_Kthread;
+ Stage1.Interrupts.Disable_IRQs (Flags);
+ Switch_To_Next_Thread (YIELD_MYSELF);
+ Stage1.Interrupts.Restore_IRQs (Flags);
+ if Myself.Signal_Present then
+ for I in Myself.Presents_Signals'Range loop
+ if Myself.Presents_Signals (I) and
+ not Myself.Blocked_Signals (I) then
+ Handler := To_Handler (Myself.Sigaction_Array (I).sa_handler);
+ Handler.all (I);
+ Myself.Blocked_Signals (I) := False;
+ end if;
+ end loop;
+ end if;
+ end Yield;
+
+ procedure Switch_To_Next_Thread (Operation : Switch_Type) is
+ Myself, Next_Thread : Kthread_Ptr;
+ begin
+ pragma Assert (Current_Kthread.State = KTHR_RUNNING,
+ "Current_Kthread.State = KTHR_RUNNING 2");
+ pragma Assert (not Stage1.Interrupts.Servicing_Irq, "not servicing_irq");
+ Myself := Current_Kthread;
+ if BLOCK_MYSELF = Operation then
+ Myself.State := KTHR_BLOCKED;
+ end if;
+ Next_Thread := Scheduler.Reschedule (Myself, YIELD_MYSELF = Operation);
+ if Myself /= Next_Thread then
+ Cpu_Context.Cpu_Kstate_Detect_Stack_Overflow
+ (Next_Thread.Cpu_Kstate,
+ Next_Thread.Stack_Base_Addr,
+ Next_Thread.Stack_Size);
+ Set_Current (Next_Thread);
+ Cpu_Context.Kstate_Switch (Myself.Cpu_Kstate,
+ Next_Thread.Cpu_Kstate);
+ pragma Assert (Current_Kthread = Myself,
+ "Current_Kthread = Myself");
+ pragma Assert (Current_Kthread.State = KTHR_RUNNING,
+ "Current_Kthread.State = KTHR_RUNNING 3");
+ else
+ Set_Current (Next_Thread);
+ end if;
+ end Switch_To_Next_Thread;
+
+ -----------------
+ -- Exit_Thread --
+ -----------------
+
+ procedure Exit_Thread (Dummy_Arg : in out System.Address) is
+ pragma Unreferenced (Dummy_Arg);
+ Flags : Unsigned_32 := 0;
+ Myself, Next_Thread : Kthread_Ptr;
+ begin
+ Myself := Get_Current;
+ pragma Assert (Kwaitq_Entry_Vectors.Is_Empty
+ (Myself.Kwaitq_List),
+ "Kwaitq_Entry_List.Is_Empty failed");
+ Kwaitq_Entry_Vectors.Clear (Myself.Kwaitq_List);
+ Stage1.Interrupts.Disable_IRQs (Flags);
+ Myself.State := KTHR_ZOMBIE;
+ Next_Thread := Scheduler.Reschedule (Myself, False);
+ Set_Current (Next_Thread);
+ Switch_Kthread_Ptr.Kstate_Exit_To (Next_Thread.Cpu_Kstate,
+ Delete_Thread'Access,
+ Myself);
+ end Exit_Thread;
+
+ procedure Delete_Thread (Thr : in out Kthread_Ptr) is
+ Reference_Count_Null : Boolean;
+ use type Thread_Vectors.Cursor;
+ A_Cursor : Thread_Vectors.Cursor;
+ begin
+ A_Cursor := Thread_Vectors.First (Kthread_List_Global);
+ while A_Cursor /= Thread_Vectors.No_Element loop
+ if Thread_Vectors.Element (A_Cursor) = Thr then
+ Thread_Vectors.Delete (Kthread_List_Global, A_Cursor);
+ exit;
+ end if;
+ A_Cursor := Thread_Vectors.Next (A_Cursor);
+ end loop;
+ Cpu_Context.Cpu_Kstate_Detect_Stack_Overflow (Thr.Cpu_Kstate,
+ Thr.Stack_Base_Addr,
+ Thr.Stack_Size);
+ Stage1.Memory.Paging.Unmap (Thr.Stack_Base_Addr);
+ Stage1.Memory.Physical.Unreference_Page_At
+ (Physical_Address_Type (Thr.Stack_Base_Addr), Reference_Count_Null);
+ pragma Assert (Reference_Count_Null, "Reference_Count_Null = True");
+ Stage1.Memory.Memset (Thr.Name (1)'Address,
+ 16#0#,
+ Kthread_Type'Size / 8);
+ Free (Thr);
+ end Delete_Thread;
+
+ procedure Sleep (Delay_Arg : in out Time.Time_Type) is
+ Flags : Unsigned_32 := 0;
+ Sleep_Timeout_Params : Sleep_Timeout_Params_Type;
+ Timeout_Action : Time.Timeout_Action_Ptr;
+ use type Time.Time_Ptr;
+ EINTR : exception;
+ begin
+ if Delay_Arg.No_Delay then
+ Stage1.Interrupts.Disable_IRQs (Flags);
+ Switch_To_Next_Thread (BLOCK_MYSELF);
+ Stage1.Interrupts.Restore_IRQs (Flags);
+ return;
+ end if;
+ -- time_init_action non necessaire dans toy lovelace
+ Sleep_Timeout_Params.Thread_To_Wakeup := Current_Kthread;
+ Sleep_Timeout_Params.Timeout_Triggered := False;
+ Stage1.Interrupts.Disable_IRQs (Flags);
+ Timeout_Action := new Time.Timeout_Action_Type;
+ Time.Register_Action_Relative
+ (Timeout_Action,
+ Delay_Arg,
+ Sleep_Timeout'Access,
+ Sleep_Timeout_Params.Thread_To_Wakeup'Address);
+ Switch_To_Next_Thread (BLOCK_MYSELF);
+ -- Unblocked by something
+
+ -- Unblocked by timeout ?
+ if Sleep_Timeout_Params.Timeout_Triggered then
+ -- Yes
+ pragma Assert (Time.Time_Is_Zero (Timeout_Action.Timeout),
+ "Time_Is_Zero (timeout_action.Timeout)");
+ null;
+ else
+ -- No: We have probably been woken up while in some other kwaitq
+ Time.Unregister_Action (Timeout_Action);
+ Time.Free (Timeout_Action);
+ raise EINTR;
+ end if;
+ Stage1.Interrupts.Restore_IRQs (Flags);
+ Delay_Arg := Timeout_Action.Timeout;
+ Time.Free (Timeout_Action);
+ end Sleep;
+
+ procedure Sleep_Timeout (Act : Time.Timeout_Action_Ptr) is
+ Sleep_Timeout_Params : Sleep_Timeout_Params_Type;
+ for Sleep_Timeout_Params'Address use Act.Routine_Data;
+ pragma Import (C, Sleep_Timeout_Params);
+ begin
+ Sleep_Timeout_Params.Timeout_Triggered := True;
+ Force_Unblock (Sleep_Timeout_Params.Thread_To_Wakeup);
+ end Sleep_Timeout;
+
+ procedure Force_Unblock (Kthread : in out Kthread_Ptr) is
+ Flags : Unsigned_32 := 0;
+ EINVAL, EFATAL : exception;
+ begin
+ if Kthread = null then
+ raise EINVAL;
+ end if;
+ Stage1.Interrupts.Disable_IRQs (Flags);
+ case Get_State (Kthread) is
+ when KTHR_RUNNING | KTHR_READY =>
+ null;
+ when KTHR_ZOMBIE =>
+ raise EFATAL;
+ when others =>
+ Scheduler.Set_Ready (Kthread);
+ end case;
+ Stage1.Interrupts.Restore_IRQs (Flags);
+ exception
+ when EFATAL =>
+ Stage1.Interrupts.Restore_IRQs (Flags);
+ raise;
+ end Force_Unblock;
+
+ function Get_State (Kthread : Kthread_Ptr) return Kthread_State is
+ begin
+ if Kthread = null then
+ return Current_Kthread.State;
+ end if;
+ return Kthread.State;
+ end Get_State;
+
+ function Get_Current return Kthread_Ptr is
+ begin
+ pragma Assert (Current_Kthread.State = KTHR_RUNNING,
+ "Current_Kthread.State = KTHR_RUNNING 1");
+ return Current_Kthread;
+ end Get_Current;
+
+ function Get_Current_Without_Test return Kthread_Ptr is
+ begin
+ return Current_Kthread;
+ end Get_Current_Without_Test;
+
+end Lovelace.Tasking.Threads;
============================================================
--- src/core/lovelace-tasking-threads.ads d20cedc048fc86ae3769ea9c0ad804436b09eb99
+++ src/core/lovelace-tasking-threads.ads d20cedc048fc86ae3769ea9c0ad804436b09eb99
@@ -0,0 +1,28 @@
+with System;
+with Lovelace.Time;
+with Lovelace.Cpu_Context;
+
+package Lovelace.Tasking.Threads is
+ pragma Preelaborate;
+ procedure Setup (Init_Thread_Stack_Base_Addr : Virtual_Address_Type;
+ Init_Thread_Stack_Size : Unsigned_32);
+ package Switch_System_Address is new Cpu_Context.Switch (System.Address);
+
+ subtype Start_Routine is
+ Switch_System_Address.Cpu_Kstate_Function_Arg1_T_Ptr;
+
+ function Create (Name : String;
+ Start_Func : Start_Routine;
+ Start_Arg : System.Address) return Kthread_Ptr;
+ procedure Yield;
+ procedure Exit_Thread (Dummy_Arg : in out System.Address);
+ pragma No_Return (Exit_Thread);
+
+ procedure Sleep (Delay_Arg : in out Time.Time_Type);
+
+ procedure Force_Unblock (Kthread : in out Kthread_Ptr);
+ function Get_State (Kthread : Kthread_Ptr) return Kthread_State;
+ function Get_Current return Kthread_Ptr;
+ function Get_Current_Without_Test return Kthread_Ptr;
+
+end Lovelace.Tasking.Threads;
============================================================
--- src/core/lovelace-tasking.ads 4b1bd326b1dff23e79c4a5dbe1be393a78b3a45a
+++ src/core/lovelace-tasking.ads 4b1bd326b1dff23e79c4a5dbe1be393a78b3a45a
@@ -0,0 +1,71 @@
+pragma Profile (Ravenscar);
+with Ada.Containers.Vectors;
+with Ada.Unchecked_Deallocation;
+with System;
+
+with Lovelace.Cpu_Context;
+with Lovelace.Signals;
+
+package Lovelace.Tasking is
+ pragma Preelaborate;
+
+ type Kthread_Type;
+ type Kthread_Ptr is access Kthread_Type;
+ package Thread_Vectors is new Ada.Containers.Vectors
+ (Positive, Kthread_Ptr);
+ type Kwaitq_Entry;
+ type Kwaitq_Entry_Ptr is access Kwaitq_Entry;
+ package Kwaitq_Entry_Vectors is new Ada.Containers.Vectors
+ (Positive, Kwaitq_Entry_Ptr);
+ type Kwaitq_Type;
+ type Kwaitq_Ptr is access all Kwaitq_Type;
+ type Kthread_State is (KTHR_CREATED,
+ KTHR_READY,
+ KTHR_RUNNING,
+ KTHR_BLOCKED,
+ KTHR_ZOMBIE);
+ KTHR_MAX_NAMELEN : constant := 32;
+ type Keys_Array is array (0 .. 15) of System.Address;
+ type Availability_Array is array (0 .. 15) of Boolean;
+ type Kthread_Type is record
+ Name : String (1 .. KTHR_MAX_NAMELEN);
+ State : Kthread_State;
+ Cpu_Kstate : Cpu_Context.Cpu_Kstate_Ptr;
+ Stack_Base_Addr : Virtual_Address_Type;
+ Stack_Size : Unsigned_32;
+ Kwaitq_List : Kwaitq_Entry_Vectors.Vector;
+ Signal_Present : Boolean;
+ Presents_Signals : Signals.sigset_t;
+ Blocked_Signals : Signals.sigset_t;
+ Sigaction_Array : Signals.Sigaction_Array_Type;
+ One_Signal_Was_Present : Boolean;
+ Last_Signal_Handler_Executed : Signals.Signal;
+ Keys : Keys_Array;
+ Key_Available : Availability_Array;
+ end record;
+ procedure Free is new Ada.Unchecked_Deallocation (Kthread_Type,
+ Kthread_Ptr);
+
+ KWQ_DEBUG_MAX_NAMELEN : constant := 32;
+ type Kwaitq_Type is record
+ Name : String (1 .. KWQ_DEBUG_MAX_NAMELEN);
+ Waiting_List : Kwaitq_Entry_Vectors.Vector;
+ end record;
+ procedure Free is new Ada.Unchecked_Deallocation (Kwaitq_Type,
+ Kwaitq_Ptr);
+ type Wakeup_Status_Type is (OK);
+ type Kwaitq_Entry is record
+ Kthread : Kthread_Ptr;
+ Kwaitq : Kwaitq_Ptr;
+ Wakeup_Triggered : Boolean;
+ Wakeup_Status : Wakeup_Status_Type;
+ end record;
+ procedure Free is new Ada.Unchecked_Deallocation (Kwaitq_Entry,
+ Kwaitq_Entry_Ptr);
+ type Ksema_Type is record
+ Value : Integer;
+ Kwaitq : Kwaitq_Ptr;
+ end record;
+ type Ksema_Ptr is access Ksema_Type;
+
+end Lovelace.Tasking;
============================================================
--- src/core/lovelace-time.adb 850de3b3dfdcb15d1f0db786c7b8d057e9366694
+++ src/core/lovelace-time.adb 850de3b3dfdcb15d1f0db786c7b8d057e9366694
@@ -0,0 +1,257 @@
+with Lovelace.Stage1.Interrupts;
+
+package body Lovelace.Time is
+
+ NS_IN_SEC : constant := 1000000000;
+
+ Last_Tick_Time : Time_Type;
+ Tick_Resolution : Time_Type;
+
+ Timeout_Action_List : Timeout_Action_Vectors.Vector;
+
+ -------------
+ -- Get_Now --
+ -------------
+
+ function Get_Now return Time_Type is
+ Flags : Unsigned_32 := 0;
+ Fct_Return : Time_Type;
+ begin
+ Stage1.Interrupts.Disable_IRQs (Flags);
+ Fct_Return := Last_Tick_Time;
+ Stage1.Interrupts.Restore_IRQs (Flags);
+ return Fct_Return;
+ end Get_Now;
+
+ -------------------------
+ -- Get_Tick_Resolution --
+ -------------------------
+
+ function Get_Tick_Resolution return Time_Type is
+ Flags : Unsigned_32 := 0;
+ Fct_Return : Time_Type;
+ begin
+ Stage1.Interrupts.Disable_IRQs (Flags);
+ Fct_Return := Tick_Resolution;
+ Stage1.Interrupts.Restore_IRQs (Flags);
+ return Fct_Return;
+ end Get_Tick_Resolution;
+
+ -------------------------
+ -- Set_Tick_Resolution --
+ -------------------------
+
+ procedure Set_Tick_Resolution (Resolution : Time_Type) is
+ Flags : Unsigned_32 := 0;
+ begin
+ Stage1.Interrupts.Disable_IRQs (Flags);
+ Tick_Resolution := Resolution;
+ Stage1.Interrupts.Restore_IRQs (Flags);
+ end Set_Tick_Resolution;
+
+ -----------
+ -- Setup --
+ -----------
+
+ procedure Setup (Initial_Resolution : Time_Type) is
+ begin
+ Last_Tick_Time := (Sec => 0, Nanoseconds => 0, No_Delay => False);
+ Tick_Resolution := Initial_Resolution;
+ end Setup;
+
+ --------------
+ -- Time_Cmp --
+ --------------
+
+ function Time_Cmp (T1, T2 : Time_Type) return Integer is
+ begin
+ if T1.Sec < T2.Sec then
+ return -1;
+ elsif T1.Sec > T2.Sec then
+ return 1;
+ elsif T1.Nanoseconds < T2.Nanoseconds then
+ return -1;
+ elsif T1.Nanoseconds > T2.Nanoseconds then
+ return 1;
+ end if;
+ return 0;
+ end Time_Cmp;
+
+ --------------
+ -- Time_Dec --
+ --------------
+
+ procedure Time_Dec
+ (Dest : in out Time_Type;
+ To_Dec : in Time_Type)
+ is
+ Diff_Ns : constant Integer := Integer (Dest.Nanoseconds) -
+ Integer (To_Dec.Nanoseconds);
+ begin
+ pragma Assert (Dest.Sec >= To_Dec.Sec, "Dest.sec >= To_Dec.Sec");
+ if Dest.Sec = To_Dec.Sec then
+ null;
+ pragma Assert (Dest.Nanoseconds >= To_Dec.Nanoseconds,
+ "Dest.Nanoseconds >= To_Dec.Nanoseconds");
+ end if;
+ Dest.Sec := Dest.Sec - To_Dec.Sec;
+ if Diff_Ns > 0 then
+ Dest.Sec := Dest.Sec + Unsigned_32 (Diff_Ns) / NS_IN_SEC;
+ else
+ Dest.Sec := Dest.Sec - Unsigned_32 (-1 * Diff_Ns) / NS_IN_SEC;
+ end if;
+ Dest.Nanoseconds := Unsigned_32 (NS_IN_SEC + Diff_Ns) mod NS_IN_SEC;
+ if Diff_Ns < 0 then
+ Dest.Sec := Dest.Sec - 1;
+ end if;
+ end Time_Dec;
+
+ --------------
+ -- Time_Inc --
+ --------------
+
+ procedure Time_Inc
+ (Dest : in out Time_Type;
+ To_Add : in Time_Type)
+ is
+ Sigma_Ns : constant Unsigned_32 :=
+ Dest.Nanoseconds + To_Add.Nanoseconds;
+ begin
+ Dest.Sec := Dest.Sec + To_Add.Sec;
+ Dest.Sec := Dest.Sec + Sigma_Ns / NS_IN_SEC;
+ Dest.Nanoseconds := Sigma_Ns mod NS_IN_SEC;
+ end Time_Inc;
+
+ ------------------
+ -- Time_Is_Zero --
+ ------------------
+
+ function Time_Is_Zero (Tm : Time_Type) return Boolean is
+ begin
+ return Tm.Sec = 0 and Tm.Nanoseconds = 0;
+ end Time_Is_Zero;
+
+ procedure Remove_Action (Act : in out Timeout_Action_Ptr);
+ procedure Remove_Action (Act : in out Timeout_Action_Ptr) is
+ EINVAL : exception;
+ begin
+ if not Act.In_List then
+ raise EINVAL;
+ end if;
+ if Time_Cmp (Act.Timeout, Last_Tick_Time) <= 0 then
+ Act.Timeout := (Sec => 0, Nanoseconds => 0, No_Delay => False);
+ else
+ Time_Dec (Act.Timeout, Last_Tick_Time);
+ end if;
+ declare
+ use type Timeout_Action_Vectors.Cursor;
+ A_Cursor : Timeout_Action_Vectors.Cursor;
+ begin
+ A_Cursor := Timeout_Action_Vectors.First (Timeout_Action_List);
+ while A_Cursor /= Timeout_Action_Vectors.No_Element loop
+ if Timeout_Action_Vectors.Element (A_Cursor) = Act then
+ Timeout_Action_Vectors.Delete (Timeout_Action_List, A_Cursor);
+ exit;
+ end if;
+ A_Cursor := Timeout_Action_Vectors.Next (A_Cursor);
+ end loop;
+ end;
+ Act.In_List := False;
+ end Remove_Action;
+
+ procedure Add_Action (Act : in out Timeout_Action_Ptr;
+ Due_Date : Time_Type;
+ Is_Relative_Due_Date : Boolean;
+ Routine : Timeout_Routine;
+ Routine_Data : System.Address);
+ procedure Add_Action (Act : in out Timeout_Action_Ptr;
+ Due_Date : Time_Type;
+ Is_Relative_Due_Date : Boolean;
+ Routine : Timeout_Routine;
+ Routine_Data : System.Address) is
+ use type Timeout_Action_Vectors.Cursor;
+ A_Cursor : Timeout_Action_Vectors.Cursor;
+ Current_Element : Timeout_Action_Ptr;
+ begin
+ if Act = null then
+ raise EINVAL;
+ end if;
+ if Routine = null then
+ raise EINVAL;
+ end if;
+ if Act.In_List then
+ raise EBUSY;
+ end if;
+
+ if Is_Relative_Due_Date then
+ Act.Timeout := Last_Tick_Time;
+ Time_Inc (Act.Timeout, Due_Date);
+ else
+ if Time_Cmp (Due_Date, Last_Tick_Time) < 0 then
+ raise EINVAL;
+ end if;
+ Act.Timeout := Due_Date;
+ end if;
+
+ Act.Routine := Routine;
+ Act.Routine_Data := Routine_Data;
+
+ A_Cursor := Timeout_Action_Vectors.First (Timeout_Action_List);
+ while A_Cursor /= Timeout_Action_Vectors.No_Element loop
+ Current_Element := Timeout_Action_Vectors.Element (A_Cursor);
+ if Time_Cmp (Act.Timeout, Current_Element.Timeout) < 0 then
+ exit;
+ end if;
+ A_Cursor := Timeout_Action_Vectors.Next (A_Cursor);
+ end loop;
+ Timeout_Action_Vectors.Insert (Container => Timeout_Action_List,
+ Before => A_Cursor,
+ New_Item => Act);
+ end Add_Action;
+
+ procedure Register_Action_Relative (Act : in out Timeout_Action_Ptr;
+ Delay_Arg : Time_Type;
+ Routine : Timeout_Routine;
+ Routine_Data : System.Address) is
+ Flags : Unsigned_32 := 0;
+ begin
+ Stage1.Interrupts.Disable_IRQs (Flags);
+ Add_Action (Act, Delay_Arg, True, Routine, Routine_Data);
+ Act.In_List := True;
+ Stage1.Interrupts.Restore_IRQs (Flags);
+ end Register_Action_Relative;
+
+ procedure Unregister_Action (Act : in out Timeout_Action_Ptr) is
+ Flags : Unsigned_32 := 0;
+ begin
+ Stage1.Interrupts.Disable_IRQs (Flags);
+ Remove_Action (Act);
+ Stage1.Interrupts.Restore_IRQs (Flags);
+ end Unregister_Action;
+
+ procedure Do_Tick is
+ Flags : Unsigned_32 := 0;
+ Act : Timeout_Action_Ptr;
+ begin
+ Stage1.Interrupts.Disable_IRQs (Flags);
+ -- Update kernel time
+ Time_Inc (Last_Tick_Time, Tick_Resolution);
+ -- if not Timeout_Action_Lists.Is_Empty (Timeout_Action_List) then
+ while not Timeout_Action_Vectors.Is_Empty (Timeout_Action_List) loop
+ Act := Timeout_Action_Vectors.First_Element (Timeout_Action_List);
+ -- Did we go too far in the actions' list ?
+ if Time_Cmp (Last_Tick_Time, Act.Timeout) < 0 then
+ -- Yes: No need to look further.
+ Stage1.Interrupts.Restore_IRQs (Flags);
+ return;
+ end if;
+ -- Remove the action from the list
+ Remove_Action (Act);
+ -- Call the action's routine
+ Act.Routine (Act);
+ -- End if;
+ end loop;
+ Stage1.Interrupts.Restore_IRQs (Flags);
+ end Do_Tick;
+
+end Lovelace.Time;
============================================================
--- src/core/lovelace-time.ads 8d5807dcf495eb90e5d25fb4d133b143f1608558
+++ src/core/lovelace-time.ads 8d5807dcf495eb90e5d25fb4d133b143f1608558
@@ -0,0 +1,47 @@
+pragma Profile (Ravenscar);
+with Ada.Containers.Vectors;
+with Ada.Unchecked_Deallocation;
+with System;
+
+package Lovelace.Time is
+ pragma Preelaborate;
+ type Time_Type is record
+ Sec : Unsigned_32;
+ Nanoseconds : Unsigned_32;
+ No_Delay : Boolean := False;
+ end record;
+ type Time_Ptr is access all Time_Type;
+ procedure Free is new Ada.Unchecked_Deallocation (Time_Type, Time_Ptr);
+ type Timeout_Action_Type;
+ type Timeout_Action_Ptr is access all Timeout_Action_Type;
+ type Timeout_Routine is access procedure
+ (Timeout_Action : Timeout_Action_Ptr);
+ type Timeout_Action_Type is record
+ Routine : Timeout_Routine;
+ Routine_Data : System.Address;
+ Timeout : Time_Type;
+ In_List : Boolean := False;
+ end record;
+ procedure Free is new Ada.Unchecked_Deallocation (Timeout_Action_Type,
+ Timeout_Action_Ptr);
+ package Timeout_Action_Vectors is new Ada.Containers.Vectors
+ (Positive, Timeout_Action_Ptr);
+
+ procedure Time_Inc (Dest : in out Time_Type;
+ To_Add : in Time_Type);
+ procedure Time_Dec (Dest : in out Time_Type;
+ To_Dec : in Time_Type);
+ function Time_Cmp (T1, T2 : Time_Type) return Integer;
+ function Time_Is_Zero (Tm : Time_Type) return Boolean;
+ procedure Setup (Initial_Resolution : Time_Type);
+
+ function Get_Tick_Resolution return Time_Type;
+ procedure Set_Tick_Resolution (Resolution : Time_Type);
+ function Get_Now return Time_Type;
+ procedure Register_Action_Relative (Act : in out Timeout_Action_Ptr;
+ Delay_Arg : Time_Type;
+ Routine : Timeout_Routine;
+ Routine_Data : System.Address);
+ procedure Unregister_Action (Act : in out Timeout_Action_Ptr);
+ procedure Do_Tick;
+end Lovelace.Time;
============================================================
--- GNUmakefile ccd66c32dc82b88c3b7e5bd212b57099357fd16d
+++ GNUmakefile 916e64c0992411d23a40f365da6c27e397b63c6d
@@ -6,8 +6,25 @@ LIBGCC2_DEFINES=-DIN_GCC -DIN_LIBGCC2 -D
LIBGCC2_INCLUDES=-I. -I../../src/include -I../../src/gcc
LIBGCC2_FLAGS=-O2 -B. -m32 -fexceptions -fnon-call-exceptions
LIBGCC2_DEFINES=-DIN_GCC -DIN_LIBGCC2 -D__GCC_FLOAT_NOT_NEEDED \
--DLIBGCC2_UNITS_PER_WORD=4 -DL_udivdi3 -DL_clz -DIN_LIBGCC2 \
+-DLIBGCC2_UNITS_PER_WORD=4 -DL_divdi3 -DL_udivdi3 -DL_clz -DIN_LIBGCC2 \
-D__GCC_FLOAT_NOT_NEEDED -DL_umoddi3
+ADACTL_UNITS_TO_TEST=lovelace.main \
+lovelace.stage1.memory.physical \
+lovelace.stage1.console \
+lovelace.stage1.memory.generic_allocation \
+lovelace.stage1.memory.paging \
+lovelace.stage1.console.put_modular \
+lovelace.stage1.console.general_modular_io \
+lovelace.stage1.memory.allocation \
+lovelace.stage1.memory \
+lovelace.stage1 \
+lovelace.stage1.i8259 \
+lovelace.stage1.interrupts \
+lovelace.stage1.segmentation \
+lovelace.stage1.exceptions \
+lovelace.stage1.handlers \
+lovelace.stage1.idt \
+lovelace.stage1.memory.x86
include $(CONFIG_FILES)
@@ -50,7 +67,8 @@ clean:board_clean
clean:board_clean
rm -f `find . -name "*~"` setup_done
rm -Rf $(CLEAN) obj runtime_files obj_user
- rm -f *.ali *.adt
+ rm -f `find -name "*.ali"`
+ rm -f `find -name "*.adt"`
make -C $(RUNTIME_KERNEL_DIR) clean
make -C $(RUNTIME_USER_DIR) clean
@@ -94,5 +112,7 @@ adactl:
ifdef ADACTL
adactl:
- adactl -r -p $(ADACTL) -f config/adactl_rules lovelace.main
+ for i in $(ADACTL_UNITS_TO_TEST); \
+ do adactl -r -p $(ADACTL) -f config/adactl_rules $$i; \
+ done
endif
============================================================
--- config/adactl_rules 954d4c36ad992f0d039793723702a24f745afc9e
+++ config/adactl_rules 2e6ef6f7aa841710ccf95c7868f6d795d1a8528c
@@ -1 +1,18 @@ check Unnecessary_Use_Clause;
check Unnecessary_Use_Clause;
+-- thanks to adacontrol/verif.aru file and so to Jean-Pierre
+check style (no_closing_name);
+check style (casing_identifier, original);
+check style (negative_condition);
+check style (multiple_elements);
+check style (compound_statement);
+check style (casing_keyword, lowercase);
+check max_nesting (6);
+check parameter_aliasing (certain);
+check simplifiable_expressions;
+check simplifiable_statements;
+check with_clauses (reduceable);
+
+-- Acceptable, but should be looked at:
+search parameter_aliasing (possible);
+search max_nesting (4);
+search local_hiding;
============================================================
--- config/boards/qemu_x86.mk fc52fba3e85cf14f35efaccf2e383c875c16e1cc
+++ config/boards/qemu_x86.mk 32b6bcf67b1264e9d272a87465e7ae617716fc5e
@@ -1,7 +1,7 @@ BASE_OBJ=$(OBJ_DIR)/asm_multiboot.o $(OB
GCC=gcc
KERNEL_INCLUDES+=-Isrc/boards/qemu_x86 -Isrc/boards/x86/
BASE_OBJ=$(OBJ_DIR)/asm_multiboot.o $(OBJ_DIR)/irq_wrappers.o \
-$(OBJ_DIR)/exception_wrappers.o
+$(OBJ_DIR)/exception_wrappers.o $(OBJ_DIR)/cpu_context_switch.o
OBJS=$(OBJ_DIR)/b~bootstrap.o $(BASE_OBJ)
OBJS_ALTERNATIVES=$(OBJ_DIR)/b~bootstrap_alternative.o $(BASE_OBJ)
SOS=http://sos.enix.org/wiki-fr/upload/SOSDownload/sos-code-art6.5-lm69.tgz
@@ -66,6 +66,11 @@ $(OBJ_DIR)/exception_wrappers.o:sos_sour
$(SRC_DIST)/exception_wrappers.S -I$(SRC_DIST) -DASM_SOURCE=1 \
-o $(OBJ_DIR)/exception_wrappers.o
+$(OBJ_DIR)/cpu_context_switch.o:sos_sources
+ $(GCC) -Wall -nostdlib -nostdinc -ffreestanding -c \
+ $(SRC_DIST)/cpu_context_switch.S -I$(SRC_DIST) -DASM_SOURCE=1 \
+ -o $(OBJ_DIR)/cpu_context_switch.o
+
sos_sources:$(SRC_DIST)
ifndef LOCAL_SOS
wget -O $(SRC_DIST)/sos.tgz $(SOS)
@@ -78,6 +83,7 @@ endif
ln -s $(SOS_DIR)/hwcore/irq_wrappers.S; \
ln -s $(SOS_DIR)/hwcore/exception_wrappers.S; \
ln -s $(SOS_DIR)/hwcore/exception.h; \
+ ln -s $(SOS_DIR)/hwcore/cpu_context_switch.S; \
sed -e s/0x200000/0X100000/ \
$(SOS_DIR)/support/sos.lds > sos.lds; \
sed -e s/sos_main/bootstrap/ \
============================================================
--- runtime_kernel/GNUmakefile 13cb210e8185b28316d1feea10120ca1b0668367
+++ runtime_kernel/GNUmakefile bd08153776a006bbf32a9f43c6eeaee87ec45127
@@ -4,13 +4,13 @@ a-tags s-valuns s-finroo a-filico a-fina
s-stache s-secsta s-wchcon s-wchstw s-exctab a-elchha s-htable \
s-wchcnv s-wchjis s-traceb s-except s-strops s-sopco3 s-sopco4 s-sopco5 \
a-tags s-valuns s-finroo a-filico a-finali s-finimp s-stratt s-valuti \
-s-casuti i-c a-convec s-addima a-cgarso a-cgcaso s-arit64
+s-casuti i-c a-convec s-addima a-cgarso a-cgcaso s-arit64 s-osinte s-imgbiu
ADS_FILES=$(addsuffix .ads,$(FILES))
ADB_FILES=$(addsuffix .adb,$(FILES))
ADB_FILES_TO_COMPILE=$(ADB_FILES)
ADS_FILES_TO_COMPILE=system.ads interfac.ads unchconv.ads ada.ads \
s-rident.ads a-unccon.ads unchdeal.ads a-uncdea.ads s-purexc.ads \
-s-maccod.ads s-unstyp.ads a-stream.ads a-ioexce.ads a-contai.ads
+s-maccod.ads s-unstyp.ads a-stream.ads a-ioexce.ads a-contai.ads s-unstyp.ads
ADS_FILES+=$(ADS_FILES_TO_COMPILE)
FULL_ADS_FILES=$(addprefix $(GNAT_FILES)/,$(ADS_FILES))
FULL_ADB_FILES=$(addprefix $(GNAT_FILES)/,$(ADB_FILES) a-excpol.adb \
============================================================
--- src/boards/qemu_x86/bootstrap_common.adb 8e68eb61ef33f8896261df826a22b2125f61068c
+++ src/boards/qemu_x86/bootstrap_common.adb c949b0ae464b4115b73b0c1d2aba86d6284e8645
@@ -11,6 +11,7 @@ with Lovelace.Stage1.Memory.Allocation;
with Lovelace.I8254_Timer;
with Lovelace.Stage1.Segmentation;
with Lovelace.Stage1.Memory.Allocation;
+with Lovelace.Tasking.Threads;
with Multiboot;
pragma Warnings (Off);
@@ -51,5 +52,7 @@ begin
Lovelace.Stage1.Memory.Paging.Setup (Top_Kernel_Address);
Adainit;
Lovelace.Stage1.Memory.Allocation.Setup (Top_Kernel_Address);
+ Lovelace.Tasking.Threads.Setup (Multiboot.Bootstrap_Stack_Bottom,
+ Multiboot.Bootstrap_Stack_Size);
Main (Memory_Size);
end Bootstrap_Common;
============================================================
--- src/boards/qemu_x86/lovelace-stage1-console.adb b03da1fc3dfa81764306ac38a13193ad71ac3f7c
+++ src/boards/qemu_x86/lovelace-stage1-console.adb d6f54507200ecaa8bcc4666244360bb23e24378b
@@ -1,14 +1,8 @@
-with System;
-with Ada.Unchecked_Conversion;
-
with Lovelace.Outb;
package body Lovelace.Stage1.Console is
pragma Suppress (All_Checks);
- function To_Address is new Ada.Unchecked_Conversion (Unsigned_32,
- System.Address);
-
LINES : constant := 25;
COLUMNS : constant := 80;
@@ -66,9 +60,9 @@ package body Lovelace.Stage1.Console is
-- Put --
---------
- procedure Put (C : Character) is
- Video_Offs : constant Integer := Integer (Current_Line - 1) * COLUMNS +
- Integer (Current_Colum);
+ procedure Put (A_Character : Character) is
+ Video_Offs : constant Integer := (Current_Line - 1) * COLUMNS +
+ Current_Colum;
Video : X86_Video_Mem;
for Video'Address use To_Address (VIDEO_ADDRESS);
pragma Volatile (Video);
@@ -77,7 +71,7 @@ package body Lovelace.Stage1.Console is
return;
end if;
Video (Video_Offs).Attribute := Default_Attribute;
- Video (Video_Offs).Character := Character'Pos (C);
+ Video (Video_Offs).Character := Character'Pos (A_Character);
Current_Colum := Current_Colum + 1;
if Current_Colum = COLUMNS + 1 then
Current_Colum := 1;
============================================================
--- src/boards/qemu_x86/lovelace-stage1-i8259.adb 596682c0f8ed488abcad1b9af892c0cbb63fd61a
+++ src/boards/qemu_x86/lovelace-stage1-i8259.adb 5b7a29267daed403e75b4846066ed906c83c67b1
@@ -14,11 +14,11 @@ package body Lovelace.Stage1.I8259 is
begin
if Level < 8 then
Outb (Inb (PIC_MASTER + 1) and
- (not Shift_Left (1, Integer (Level))),
+ not Shift_Left (1, Integer (Level)),
PIC_MASTER + 1);
else
Outb (Inb (PIC_SLAVE + 1) and
- (not Shift_Left (1, Integer (Level - 8))),
+ not Shift_Left (1, Integer (Level - 8)),
PIC_SLAVE + 1);
end if;
end Enable_Irq_Line;
============================================================
--- src/boards/qemu_x86/lovelace-stage1-idt.adb ecc4909ccdff927bb9369843966846a1556bdd39
+++ src/boards/qemu_x86/lovelace-stage1-idt.adb ed485b4833f5cf149c283e5d436c973be2beac66
@@ -42,7 +42,7 @@ package body Lovelace.Stage1.Idt is
type Idt_Array is array (Unsigned_8) of Idt_Entry;
pragma Pack (Idt_Array);
pragma Convention (C, Idt_Array);
- Idt : Idt_Array;
+ Idts : Idt_Array;
-----------------
-- Set_Handler --
@@ -54,42 +54,57 @@ package body Lovelace.Stage1.Idt is
Privilege : X86_Types.Lowest_Priviledge)
is
begin
- if Handler_Address /= 0 then
- Idt (Index).Offset_Low := Unsigned_16
+ if Handler_Address = 0 then
+ Idts (Index).Offset_Low := 0;
+ Idts (Index).Offset_High := 0;
+ Idts (Index).Dpl := 0;
+ Idts (Index).Present := 0;
+ else
+ Idts (Index).Offset_Low := Unsigned_16
(16#Ffff# and Handler_Address);
- Idt (Index).Offset_High := Unsigned_16
+ Idts (Index).Offset_High := Unsigned_16
(16#Ffff# and Shift_Right (Handler_Address, 16));
- Idt (Index).Dpl := Unsigned_8 (Privilege);
- Idt (Index).Present := 1;
- else
- Idt (Index).Offset_Low := 0;
- Idt (Index).Offset_High := 0;
- Idt (Index).Dpl := 0;
- Idt (Index).Present := 0;
+ Idts (Index).Dpl := Privilege;
+ Idts (Index).Present := 1;
end if;
end Set_Handler;
procedure Setup is
Idtr : Idt_Register;
- function To_Unsigned_32 is new Ada.Unchecked_Conversion
- (System.Address, Unsigned_32);
begin
- for I in Idt'Range loop
- Idt (I).Seg_Sel := Shift_Left (SEG_KCODE, 3);
+ for I in Idts'Range loop
+ Idts (I).Seg_Sel := Shift_Left (SEG_KCODE, 3);
-- SOS_BUILD_SEGMENT_REG_VALUE (0, FALSE, SOS_SEG_KCODE);
- Idt (I).Reserved := 0;
- Idt (I).Flags := 0;
- Idt (I).Type_Idt := 16#6#;
- Idt (I).Op_Size := 1;
- Idt (I).Zero := 0;
+ Idts (I).Reserved := 0;
+ Idts (I).Flags := 0;
+ Idts (I).Type_Idt := 16#6#;
+ Idts (I).Op_Size := 1;
+ Idts (I).Zero := 0;
Set_Handler (I, 0, 0);
end loop;
- Idtr.Base_Addr := To_Unsigned_32 (Idt (0)'Address);
- Idtr.Limit := Idt'Size / 8 - 1;
- System.Machine_Code.Asm ("lidt %0" & ASCII.Lf,
+ Idtr.Base_Addr := To_Unsigned_32 (Idts (0)'Address);
+ Idtr.Limit := Idts'Size / 8 - 1;
+ System.Machine_Code.Asm ("lidt %0" & ASCII.LF,
Inputs => Idt_Register'Asm_Input ("m", Idtr),
Clobber => "memory",
Volatile => True);
end Setup;
-
+ function BUILD_SEGMENT_REG_VALUE (Desc_Privilege : Unsigned_8;
+ In_Ldt : Boolean;
+ Seg_Index : Segmentation.SEGMENT)
+ return Unsigned_8 is
+ Res_Tmp : Unsigned_8 := 0;
+ function To_Unsigned_8 is new Ada.Unchecked_Conversion
+ (Segmentation.SEGMENT, Unsigned_8);
+ Seg_Index_8 : constant Unsigned_8 :=
+ To_Unsigned_8 (Seg_Index);
+ begin
+ if In_Ldt then
+ Res_Tmp := 1;
+ end if;
+ return
+ (Desc_Privilege and 16#3#) or
+ Shift_Left (Res_Tmp, 2) or
+ Shift_Left (Seg_Index_8, 3);
+ end BUILD_SEGMENT_REG_VALUE;
end Lovelace.Stage1.Idt;
============================================================
--- src/boards/qemu_x86/lovelace-stage1-idt.ads e33243d8142a1db678c43f197d24c7d7b34e1807
+++ src/boards/qemu_x86/lovelace-stage1-idt.ads 632da2fc6678a8c3e66d65c9ddcb243f51a82cdf
@@ -1,4 +1,5 @@ with Lovelace.X86_Types;
with Lovelace.X86_Types;
+with Lovelace.Stage1.Segmentation;
package Lovelace.Stage1.Idt is
pragma Preelaborate;
@@ -6,4 +7,9 @@ package Lovelace.Stage1.Idt is
procedure Set_Handler (Index : Unsigned_8;
Handler_Address : Unsigned_32;
Privilege : X86_Types.Lowest_Priviledge);
+ function BUILD_SEGMENT_REG_VALUE (Desc_Privilege : Unsigned_8;
+ In_Ldt : Boolean;
+ Seg_Index : Segmentation.SEGMENT)
+ return Unsigned_8;
+ pragma Inline (BUILD_SEGMENT_REG_VALUE);
end Lovelace.Stage1.Idt;
============================================================
--- src/boards/qemu_x86/lovelace-stage1-interrupts.adb 332c129988698a57a0dfe1c7445b2b815360fd11
+++ src/boards/qemu_x86/lovelace-stage1-interrupts.adb 0938e42e6d33e10ace5279df59d0029adcfc7b31
@@ -32,15 +32,15 @@ package body Lovelace.Stage1.Interrupts
begin
Disable_IRQs (Flags);
Irq_Handler_Array (Level) := To_Unsigned_32 (Interrupt_Handler);
- if Interrupt_Handler /= null then
- Idt.Set_Handler (IRQ_BASE + Level, Irq_Wrapper_Array (Level), 0);
+ if Interrupt_Handler = null then
+ Idt.Set_Handler (IRQ_BASE + Level, 0, 0);
else
- Idt.Set_Handler (IRQ_BASE + Level, 0, 0);
+ Idt.Set_Handler (IRQ_BASE + Level, Irq_Wrapper_Array (Level), 0);
end if;
- if Irq_Handler_Array (Level) /= 0 then
- I8259.Enable_Irq_Line (Level);
+ if Irq_Handler_Array (Level) = 0 then
+ I8259.Disable_Irq_Line (Level);
else
- I8259.Disable_Irq_Line (Level);
+ I8259.Enable_Irq_Line (Level);
end if;
Restore_IRQs (Flags);
end Set_Handler;
@@ -68,7 +68,7 @@ package body Lovelace.Stage1.Interrupts
procedure Disable_IRQs (Flags : in out Unsigned_32) is
begin
Save_Flags (Flags);
- System.Machine_Code.Asm ("cli" & ASCII.Lf, Volatile => True);
+ System.Machine_Code.Asm ("cli" & ASCII.LF, Volatile => True);
end Disable_IRQs;
procedure Restore_IRQs (Flags : in out Unsigned_32) is
@@ -83,8 +83,18 @@ package body Lovelace.Stage1.Interrupts
procedure Start is
begin
- System.Machine_Code.Asm (Template => "sti" & ASCII.Lf,
+ System.Machine_Code.Asm (Template => "sti" & ASCII.LF,
Volatile => True);
end Start;
+ function Servicing_Irq return Boolean is
+ begin
+ return Irq_Get_Nested_Level > 10;
+ end Servicing_Irq;
+
+ function Irq_Get_Nested_Level return Unsigned_32 is
+ begin
+ return Sos_Irq_Nested_Level_Counter;
+ end Irq_Get_Nested_Level;
+
end Lovelace.Stage1.Interrupts;
============================================================
--- src/boards/qemu_x86/lovelace-stage1-interrupts.ads 74750edc4f672aae6778d56ce4101db8ca6c0ffc
+++ src/boards/qemu_x86/lovelace-stage1-interrupts.ads 5c26577fd3457fccaa7d3f70a42509becc68fb79
@@ -14,4 +14,7 @@ package Lovelace.Stage1.Interrupts is
pragma Inline (Restore_Flags);
procedure Setup;
procedure Start;
+ function Irq_Get_Nested_Level return Unsigned_32;
+ function Servicing_Irq return Boolean;
+ pragma Inline (Servicing_Irq);
end Lovelace.Stage1.Interrupts;
============================================================
--- src/boards/qemu_x86/lovelace-stage1-segmentation.adb 3f9cb2c556255db36a52cc8917de6379912ff226
+++ src/boards/qemu_x86/lovelace-stage1-segmentation.adb af289ea760f3803bd13a0a5fcf21f3a653a7ea25
@@ -40,9 +40,6 @@ package body Lovelace.Stage1.Segmentatio
pragma Pack (X86_Gdt_Register);
for X86_Gdt_Register'Alignment use 8;
- type SEGMENT is (SEG_NULL, SEG_KCODE, SEG_KDATA);
- for SEGMENT use
- (SEG_NULL => 0, SEG_KCODE => 1, SEG_KDATA => 2);
Gdt : array (SEGMENT) of X86_Segment_Descriptor :=
(SEG_NULL => (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
SEG_KCODE => (Limit_15_0 => 16#Ffff#,
@@ -80,14 +77,14 @@ package body Lovelace.Stage1.Segmentatio
begin
Gdtr.Base_Addr := To_Unsigned_32 (Gdt (SEG_NULL).Limit_15_0'Address);
Gdtr.Limit := Gdt'Size / 8 - 1;
- System.Machine_Code.Asm ("lgdt %0" & ASCII.Lf &
- "ljmp %1,$1f" & ASCII.Lf &
- "1:" & ASCII.Lf &
- "movw %2, %%ax" & ASCII.Lf &
- "movw %%ax, %%ss" & ASCII.Lf &
- "movw %%ax, %%ds" & ASCII.Lf &
- "movw %%ax, %%es" & ASCII.Lf &
- "movw %%ax, %%fs" & ASCII.Lf &
+ System.Machine_Code.Asm ("lgdt %0" & ASCII.LF &
+ "ljmp %1,$1f" & ASCII.LF &
+ "1:" & ASCII.LF &
+ "movw %2, %%ax" & ASCII.LF &
+ "movw %%ax, %%ss" & ASCII.LF &
+ "movw %%ax, %%ds" & ASCII.LF &
+ "movw %%ax, %%es" & ASCII.LF &
+ "movw %%ax, %%fs" & ASCII.LF &
"movw %%ax, %%gs",
Inputs =>
(X86_Gdt_Register'Asm_Input ("m", Gdtr),
============================================================
--- src/boards/qemu_x86/lovelace-stage1-segmentation.ads fd7f4d5dfd4845c070e47afb9465a82f6b475784
+++ src/boards/qemu_x86/lovelace-stage1-segmentation.ads 4fc5081b89a7c492c80a608e3eaadd35a58d970c
@@ -1,4 +1,11 @@ package Lovelace.Stage1.Segmentation is
package Lovelace.Stage1.Segmentation is
pragma Preelaborate;
+
+ type SEGMENT is (SEG_NULL, SEG_KCODE, SEG_KDATA);
+ for SEGMENT use
+ (SEG_NULL => 0, SEG_KCODE => 1, SEG_KDATA => 2);
+ for SEGMENT'Size use 8;
+
procedure Setup;
+
end Lovelace.Stage1.Segmentation;
============================================================
--- src/core/lovelace-stage1-console.ads 57a5aa0c640017fe16eea7291c443256fd17dcb0
+++ src/core/lovelace-stage1-console.ads 2096e265f7af8bce0a30f1507ba4e46d8b076686
@@ -27,7 +27,7 @@ package Lovelace.Stage1.Console is
function Get_Console_Width return Positive;
-- display procedures
- procedure Put (C : Character);
+ procedure Put (A_Character : Character);
procedure Put (Item : String);
procedure Put_Line (Item : String);
procedure New_Line;
============================================================
--- src/core/lovelace-stage1-memory-allocation.adb c6573dcf0ea4dca105ec02fc736c8c70df3864c2
+++ src/core/lovelace-stage1-memory-allocation.adb b36861bffe496afd297e07902efcae9d709d7801
@@ -42,7 +42,7 @@ package body Lovelace.Stage1.Memory.Allo
elsif Size <= 256 then
return Alloction_256_Bytes_Package.Allocate;
else
- Console.Put ("requested size : ");
+ Console.Put ("requested size too high : ");
Put (Size, Decimal);
Console.New_Line;
Os_Exit (4);
============================================================
--- src/core/lovelace.ads 1c0b25eadcb86aa2334572bb08274a8d12ea26d2
+++ src/core/lovelace.ads 32ae14a6985b0448795b60808c9b9a32c774bf9d
@@ -44,4 +44,8 @@ package Lovelace is
pragma Pack (Boolean_Array);
ENOMEM : exception;
EINVAL : exception;
+ EBUSY : exception;
+ Not_Executable_Code : exception;
+ Assertion_Failed : exception;
+ Fatal_Error : exception;
end Lovelace;