with System.Machine_Code; use System.Machine_Code;
with System.Memory;
with System.Soft_Links; use System.Soft_Links;
with Unchecked_Conversion;
package body System.Machine_State_Operations is
use System.Storage_Elements;
use System.Exceptions;
type Uns32 is mod 2 ** 32;
type Uns64 is mod 2 ** 64;
type Uns32_Ptr is access all Uns32;
type Uns64_Array is array (Integer range <>) of Uns64;
type Reg_Array is array (0 .. 31) of Uns64;
type Sigcontext is record
SC_Regmask : Uns32; SC_Status : Uns32; SC_PC : Uns64; SC_Regs : Reg_Array; SC_Fpregs : Reg_Array; SC_Ownedfp : Uns32; SC_Fpc_Csr : Uns32; SC_Fpc_Eir : Uns32; SC_Ssflags : Uns32; SC_Mdhi : Uns64; SC_Mdlo : Uns64; SC_Cause : Uns64; SC_Badvaddr : Uns64; SC_Triggersave : Uns64; SC_Sigset : Uns64; SC_Fp_Rounded_Result : Uns64; SC_Pancake : Uns64_Array (0 .. 5);
SC_Pad : Uns64_Array (0 .. 26);
end record;
type Sigcontext_Ptr is access all Sigcontext;
SC_Regs_Pos : constant String := "16";
SC_Fpregs_Pos : constant String := "272";
function To_Sigcontext_Ptr is
new Unchecked_Conversion (Machine_State, Sigcontext_Ptr);
type Addr_Int is mod 2 ** Long_Integer'Size;
function To_Code_Loc is new Unchecked_Conversion (Addr_Int, Code_Loc);
function To_Addr_Int is new Unchecked_Conversion (System.Address, Addr_Int);
function To_Uns32_Ptr is new Unchecked_Conversion (Addr_Int, Uns32_Ptr);
o32 : constant Boolean := System.Word_Size = 32;
n32 : constant Boolean := System.Word_Size = 64;
o32n : constant Natural := Boolean'Pos (o32);
n32n : constant Natural := Boolean'Pos (n32);
LSC : constant Character := Character'Val (o32n * Character'Pos ('w') +
n32n * Character'Pos ('d'));
Roff : constant Character := Character'Val (o32n * Character'Pos ('4') +
n32n * Character'Pos ('0'));
procedure Update_GP (Scp : Sigcontext_Ptr);
procedure Update_GP (Scp : Sigcontext_Ptr) is
type F_op is mod 2 ** 6;
type F_reg is mod 2 ** 5;
type F_imm is new Short_Integer;
type I_Type is record
op : F_op;
rs : F_reg;
rt : F_reg;
imm : F_imm;
end record;
pragma Pack (I_Type);
for I_Type'Size use 32;
type I_Type_Ptr is access all I_Type;
LW : constant F_op := 2#100011#;
Reg_GP : constant := 28;
type Address_Int is mod 2 ** Standard'Address_Size;
function To_I_Type_Ptr is new
Unchecked_Conversion (Address_Int, I_Type_Ptr);
Ret_Ins : constant I_Type_Ptr := To_I_Type_Ptr (Address_Int (Scp.SC_PC));
GP_Ptr : Uns32_Ptr;
begin
if Ret_Ins.op = LW and then Ret_Ins.rt = Reg_GP then
GP_Ptr := To_Uns32_Ptr
(Addr_Int (Scp.SC_Regs (Integer (Ret_Ins.rs)))
+ Addr_Int (Ret_Ins.imm));
Scp.SC_Regs (Reg_GP) := Uns64 (GP_Ptr.all);
end if;
end Update_GP;
function Allocate_Machine_State return Machine_State is
begin
return Machine_State
(Memory.Alloc (Sigcontext'Max_Size_In_Storage_Elements));
end Allocate_Machine_State;
procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
pragma Warnings (Off, M);
pragma Warnings (Off, Handler);
LOADI : constant String (1 .. 2) := 'l' & LSC;
LOADF : constant String (1 .. 4) := 'l' & LSC & "c1";
begin
Asm (LOADI & " $16, 16*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADI & " $17, 17*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADI & " $18, 18*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADI & " $19, 19*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADI & " $20, 20*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADI & " $21, 21*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADI & " $22, 22*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADI & " $23, 23*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADI & " $24, 24*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADI & " $25, 25*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADI & " $26, 26*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADI & " $27, 27*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADI & " $28, 28*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADI & " $29, 29*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADI & " $30, 30*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADI & " $31, 31*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (LOADF & " $f16, 16*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (LOADF & " $f17, 17*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (LOADF & " $f18, 18*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (LOADF & " $f19, 19*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (LOADF & " $f20, 20*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (LOADF & " $f21, 21*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (LOADF & " $f22, 22*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (LOADF & " $f23, 23*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (LOADF & " $f24, 24*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (LOADF & " $f25, 25*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (LOADF & " $f26, 26*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (LOADF & " $f27, 27*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (LOADF & " $f28, 28*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (LOADF & " $f29, 29*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (LOADF & " $f30, 30*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (LOADF & " $f31, 31*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm ("jr $5");
end Enter_Handler;
function Fetch_Code (Loc : Code_Loc) return Code_Loc is
begin
return Loc;
end Fetch_Code;
procedure Free_Machine_State (M : in out Machine_State) is
begin
Memory.Free (Address (M));
M := Machine_State (Null_Address);
end Free_Machine_State;
function Get_Code_Loc (M : Machine_State) return Code_Loc is
SC : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M);
begin
return To_Code_Loc (Addr_Int (SC.SC_PC));
end Get_Code_Loc;
function Machine_State_Length return Storage_Offset is
begin
return Sigcontext'Max_Size_In_Storage_Elements;
end Machine_State_Length;
procedure Pop_Frame
(M : Machine_State;
Info : Subprogram_Info_Type)
is
pragma Warnings (Off, Info);
Scp : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M);
procedure Exc_Unwind (Scp : Sigcontext_Ptr; Fde : Long_Integer := 0);
pragma Import (C, Exc_Unwind, "exc_unwind");
begin
Lock_Task.all;
if False then
Exc_Unwind (Scp);
else
Scp.SC_PC := 0;
end if;
Unlock_Task.all;
if Scp.SC_PC = 0 or else Scp.SC_PC = 1 then
Scp.SC_PC := 0;
else
if o32 then
Update_GP (Scp);
end if;
Scp.SC_PC := Scp.SC_PC - 8;
end if;
end Pop_Frame;
procedure Set_Machine_State (M : Machine_State) is
STOREI : constant String (1 .. 2) := 's' & LSC;
STOREF : constant String (1 .. 4) := 's' & LSC & "c1";
Scp : Sigcontext_Ptr;
begin
<<Past_Prolog>>
Asm (STOREI & " $16, 16*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREI & " $17, 17*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREI & " $18, 18*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREI & " $19, 19*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREI & " $20, 20*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREI & " $21, 21*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREI & " $22, 22*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREI & " $23, 23*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREI & " $24, 24*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREI & " $25, 25*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREI & " $26, 26*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREI & " $27, 27*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREI & " $28, 28*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREI & " $29, 29*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREI & " $30, 30*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREI & " $31, 31*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
Asm (STOREF & " $f16, 16*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (STOREF & " $f17, 17*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (STOREF & " $f18, 18*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (STOREF & " $f19, 19*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (STOREF & " $f20, 20*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (STOREF & " $f21, 21*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (STOREF & " $f22, 22*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (STOREF & " $f23, 23*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (STOREF & " $f24, 24*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (STOREF & " $f25, 25*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (STOREF & " $f26, 26*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (STOREF & " $f27, 27*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (STOREF & " $f28, 28*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (STOREF & " $f29, 29*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (STOREF & " $f30, 30*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Asm (STOREF & " $f31, 31*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
Scp := To_Sigcontext_Ptr (M);
Scp.SC_PC := Uns64 (To_Addr_Int (Past_Prolog'Address));
Pop_Frame (M, Set_Machine_State'Address);
end Set_Machine_State;
procedure Set_Signal_Machine_State
(M : Machine_State;
Context : System.Address)
is
pragma Warnings (Off, M);
pragma Warnings (Off, Context);
begin
null;
end Set_Signal_Machine_State;
end System.Machine_State_Operations;