-- -- Copyright (C) 2015-2016 secunet Security Networks AG -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- with HW.Time; with HW.MMIO_Range; pragma Elaborate_All (HW.MMIO_Range); with HW.Debug; with GNAT.Source_Info; use type HW.Word64; package body HW.GFX.GMA.Registers with Refined_State => (Address_State => (Regs.Base_Address, GTT_32.Base_Address, GTT_64.Base_Address), Register_State => Regs.State, GTT_State => (GTT_32.State, GTT_64.State)) is pragma Disable_Atomic_Synchronization; type Registers_Range is new Natural range 0 .. 16#0020_0000# / Register_Width - 1; type Registers_Type is array (Registers_Range) of Word32 with Atomic_Components, Size => 16#20_0000# * 8; package Regs is new MMIO_Range (Base_Addr => Config.Default_MMIO_Base, Element_T => Word32, Index_T => Registers_Range, Array_T => Registers_Type); ---------------------------------------------------------------------------- type GTT_PTE_32 is mod 2 ** 32; type GTT_Registers_32 is array (GTT_Range) of GTT_PTE_32 with Volatile_Components, Size => MMIO_GTT_32_Size * 8; package GTT_32 is new MMIO_Range (Base_Addr => Config.Default_MMIO_Base + MMIO_GTT_32_Offset, Element_T => GTT_PTE_32, Index_T => GTT_Range, Array_T => GTT_Registers_32); type GTT_PTE_64 is mod 2 ** 64; type GTT_Registers_64 is array (GTT_Range) of GTT_PTE_64 with Volatile_Components, Size => MMIO_GTT_64_Size * 8; package GTT_64 is new MMIO_Range (Base_Addr => Config.Default_MMIO_Base + MMIO_GTT_64_Offset, Element_T => GTT_PTE_64, Index_T => GTT_Range, Array_T => GTT_Registers_64); GTT_PTE_Valid : constant := 1; ---------------------------------------------------------------------------- subtype Fence_Range is Natural range 0 .. 31; FENCE_PAGE_SHIFT : constant := 12; FENCE_PAGE_MASK : constant := 16#ffff_f000#; FENCE_TILE_WALK_YMAJOR : constant := 1 * 2 ** 1; FENCE_VALID : constant := 1 * 2 ** 0; function Fence_Lower_Idx (Fence : Fence_Range) return Registers_Range is (Registers_Range (Config.Fence_Base / Register_Width + 2 * Fence)); function Fence_Upper_Idx (Fence : Fence_Range) return Registers_Range is (Fence_Lower_Idx (Fence) + 1); procedure Clear_Fences is begin for Fence in Fence_Range range 0 .. Config.Fence_Count - 1 loop Regs.Write (Fence_Lower_Idx (Fence), 0); end loop; end Clear_Fences; procedure Add_Fence (First_Page : in GTT_Range; Last_Page : in GTT_Range; Tiling : in XY_Tiling; Pitch : in Natural; Success : out Boolean) is Y_Tiles : constant Boolean := Tiling = Y_Tiled; Reg32 : Word32; begin pragma Debug (Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": ")); pragma Debug (Debug.Put_Word32 (Shift_Left (Word32 (First_Page), 12))); pragma Debug (Debug.Put (":")); pragma Debug (Debug.Put_Word32 (Shift_Left (Word32 (Last_Page), 12))); pragma Debug (not Y_Tiles, Debug.Put (" X tiled in ")); pragma Debug ( Y_Tiles, Debug.Put (" Y tiled in ")); pragma Debug (Debug.Put_Int32 (Int32 (Pitch))); pragma Debug (Debug.Put_Line (" tiles per row.")); Success := False; for Fence in Fence_Range range 0 .. Config.Fence_Count - 1 loop Regs.Read (Reg32, Fence_Lower_Idx (Fence)); if (Reg32 and FENCE_VALID) = 0 then Regs.Write (Index => Fence_Lower_Idx (Fence), Value => Shift_Left (Word32 (First_Page), FENCE_PAGE_SHIFT) or (if Y_Tiles then FENCE_TILE_WALK_YMAJOR else 0) or FENCE_VALID); Regs.Write (Index => Fence_Upper_Idx (Fence), Value => Shift_Left (Word32 (Last_Page), FENCE_PAGE_SHIFT) or Word32 (Pitch) * (if Y_Tiles then 1 else 4) - 1); Success := True; exit; end if; end loop; end Add_Fence; procedure Remove_Fence (First_Page, Last_Page : GTT_Range) is Page_Lower : constant Word32 := Shift_Left (Word32 (First_Page), FENCE_PAGE_SHIFT); Page_Upper : constant Word32 := Shift_Left (Word32 (Last_Page), FENCE_PAGE_SHIFT); Fence_Upper, Fence_Lower : Word32; begin for Fence in Fence_Range range 0 .. Config.Fence_Count - 1 loop Regs.Read (Fence_Lower, Fence_Lower_Idx (Fence)); Regs.Read (Fence_Upper, Fence_Upper_Idx (Fence)); if (Fence_Lower and FENCE_PAGE_MASK) = Page_Lower and (Fence_Upper and FENCE_PAGE_MASK) = Page_Upper then Regs.Write (Fence_Lower_Idx (Fence), 0); exit; end if; end loop; end Remove_Fence; ---------------------------------------------------------------------------- procedure Write_GTT (GTT_Page : GTT_Range; Device_Address : GTT_Address_Type; Valid : Boolean) is begin if not Config.Has_64bit_GTT then GTT_32.Write (Index => GTT_Page, Value => GTT_PTE_32 (Device_Address and 16#ffff_f000#) or GTT_PTE_32 (Shift_Right (Word64 (Device_Address), 32 - 4) and 16#0000_07f0#) or Boolean'Pos (Valid)); else GTT_64.Write (Index => GTT_Page, Value => GTT_PTE_64 (Device_Address and 16#7f_ffff_f000#) or Boolean'Pos (Valid)); end if; end Write_GTT; procedure Read_GTT (Device_Address : out GTT_Address_Type; Valid : out Boolean; GTT_Page : in GTT_Range) is begin if not Config.Has_64bit_GTT then declare PTE : GTT_PTE_32; begin GTT_32.Read (PTE, GTT_Page); Valid := (PTE and GTT_PTE_Valid) /= 0; Device_Address := GTT_Address_Type (Shift_Left (Word64 (PTE and 16#07f0#), 32 - 4) or Word64 (PTE and 16#ffff_f000#)); end; else declare PTE : GTT_PTE_64; begin GTT_64.Read (PTE, GTT_Page); Valid := (PTE and GTT_PTE_Valid) /= 0; Device_Address := GTT_Address_Type (PTE and 16#7f_ffff_f000#); end; end if; end Read_GTT; ---------------------------------------------------------------------------- package Rep is function Index (Reg : Registers_Index) return Registers_Range; end Rep; package body Rep is function Index (Reg : Registers_Index) return Registers_Range with SPARK_Mode => Off is begin return Reg'Enum_Rep; end Index; end Rep; -- Read a specific register procedure Read (Register : in Registers_Index; Value : out Word32; Verbose : in Boolean := True) is begin Regs.Read (Value, Rep.Index (Register)); pragma Debug (Verbose, Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": ")); pragma Debug (Verbose, Debug.Put_Word32 (Value)); pragma Debug (Verbose, Debug.Put (" <- ")); pragma Debug (Verbose, Debug.Put_Word32 (Register'Enum_Rep * Register_Width)); pragma Debug (Verbose, Debug.Put (":")); pragma Debug (Verbose, Debug.Put_Line (Registers_Index'Image (Register))); end Read; ---------------------------------------------------------------------------- -- Read a specific register to post a previous write procedure Posting_Read (Register : Registers_Index) is Discard_Value : Word32; begin pragma Warnings (Off, "unused assignment to ""Discard_Value""", Reason => "Intentional dummy read to affect hardware."); Read (Register, Discard_Value); pragma Warnings (On, "unused assignment to ""Discard_Value"""); end Posting_Read; ---------------------------------------------------------------------------- -- Write a specific register procedure Write (Register : Registers_Index; Value : Word32) is begin pragma Debug (Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": ")); pragma Debug (Debug.Put_Word32 (Value)); pragma Debug (Debug.Put (" -> ")); pragma Debug (Debug.Put_Word32 (Register'Enum_Rep * Register_Width)); pragma Debug (Debug.Put (":")); pragma Debug (Debug.Put_Line (Registers_Index'Image (Register))); Regs.Write (Rep.Index (Register), Value); pragma Debug (Debug.Register_Write_Wait); end Write; ---------------------------------------------------------------------------- -- Check whether all bits in @Register@ indicated by @Mask@ are set procedure Is_Set_Mask (Register : in Registers_Index; Mask : in Word32; Result : out Boolean) is Value : Word32; begin pragma Debug (Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": ")); pragma Debug (Debug.Put_Line (Registers_Index'Image (Register))); Read (Register, Value); Result := (Value and Mask) = Mask; end Is_Set_Mask; ---------------------------------------------------------------------------- pragma Warnings (GNATprove, Off, "unused assignment to ""Ignored_Success"""); -- Wait for the bits in @Register@ indicated by @Mask@ to be of @Value@ procedure Wait (Register : in Registers_Index; Mask : in Word32; Value : in Word32; TOut_MS : in Natural := Default_Timeout_MS; Verbose : in Boolean := False; Success : out Boolean) is Current : Word32; Timeout : Time.T; Timed_Out : Boolean := False; begin pragma Debug (Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": ")); pragma Debug (Debug.Put_Word32 (Value)); pragma Debug (Debug.Put (" <- ")); pragma Debug (Debug.Put_Word32 (Mask)); pragma Debug (Debug.Put (" & ")); pragma Debug (Debug.Put_Word32 (Register'Enum_Rep * Register_Width)); pragma Debug (Debug.Put (":")); pragma Debug (Debug.Put_Line (Registers_Index'Image (Register))); Timeout := Time.MS_From_Now (TOut_MS); loop Read (Register, Current, Verbose); if (Current and Mask) = Value then -- Ignore timeout if we succeeded anyway. Timed_Out := False; exit; end if; pragma Debug (Timed_Out, Debug.Put (GNAT.Source_Info.Enclosing_Entity)); pragma Debug (Timed_Out, Debug.Put_Line (": Timed Out!")); exit when Timed_Out; Timed_Out := Time.Timed_Out (Timeout); end loop; Success := not Timed_Out; end Wait; procedure Wait (Register : Registers_Index; Mask : Word32; Value : Word32; TOut_MS : Natural := Default_Timeout_MS; Verbose : Boolean := False) is Ignored_Success : Boolean; begin Wait (Register, Mask, Value, TOut_MS, Verbose, Ignored_Success); end Wait; ---------------------------------------------------------------------------- -- Wait for all bits in @Register@ indicated by @Mask@ to be set procedure Wait_Set_Mask (Register : in Registers_Index; Mask : in Word32; TOut_MS : in Natural := Default_Timeout_MS; Verbose : in Boolean := False; Success : out Boolean) is begin Wait (Register, Mask, Mask, TOut_MS, Verbose, Success); end Wait_Set_Mask; procedure Wait_Set_Mask (Register : Registers_Index; Mask : Word32; TOut_MS : Natural := Default_Timeout_MS; Verbose : Boolean := False) is Ignored_Success : Boolean; begin Wait (Register, Mask, Mask, TOut_MS, Verbose, Ignored_Success); end Wait_Set_Mask; ---------------------------------------------------------------------------- -- Wait for bits in @Register@ indicated by @Mask@ to be clear procedure Wait_Unset_Mask (Register : in Registers_Index; Mask : in Word32; TOut_MS : in Natural := Default_Timeout_MS; Verbose : in Boolean := False; Success : out Boolean) is begin Wait (Register, Mask, 0, TOut_MS, Verbose, Success); end; procedure Wait_Unset_Mask (Register : Registers_Index; Mask : Word32; TOut_MS : Natural := Default_Timeout_MS; Verbose : Boolean := False) is Ignored_Success : Boolean; begin Wait (Register, Mask, 0, TOut_MS, Verbose, Ignored_Success); end Wait_Unset_Mask; ---------------------------------------------------------------------------- -- Set bits from @Mask@ in @Register@ procedure Set_Mask (Register : Registers_Index; Mask : Word32) is Value : Word32; begin pragma Debug (Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": ")); pragma Debug (Debug.Put_Word32 (Mask)); pragma Debug (Debug.Put (" .S ")); pragma Debug (Debug.Put_Line (Registers_Index'Image (Register))); Read (Register, Value); Value := Value or Mask; Write (Register, Value); end Set_Mask; ---------------------------------------------------------------------------- -- Mask out @Mask@ in @Register@ procedure Unset_Mask (Register : Registers_Index; Mask : Word32) is Value : Word32; begin pragma Debug (Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": ")); pragma Debug (Debug.Put_Word32 (Mask)); pragma Debug (Debug.Put (" !S ")); pragma Debug (Debug.Put_Line (Registers_Index'Image (Register))); Read (Register, Value); Value := Value and not Mask; Write (Register, Value); end Unset_Mask; ---------------------------------------------------------------------------- -- Mask out @Unset_Mask@ and set @Set_Mask@ in @Register@ procedure Unset_And_Set_Mask (Register : Registers_Index; Mask_Unset : Word32; Mask_Set : Word32) is Value : Word32; begin pragma Debug (Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": ")); pragma Debug (Debug.Put_Line (Registers_Index'Image (Register))); Read (Register, Value); Value := (Value and not Mask_Unset) or Mask_Set; Write (Register, Value); end Unset_And_Set_Mask; ---------------------------------------------------------------------------- procedure Set_Register_Base (Base : Word64; GTT_Base : Word64 := 0) is begin Regs.Set_Base_Address (Base); if GTT_Base = 0 then GTT_32.Set_Base_Address (Base + MMIO_GTT_32_Offset); GTT_64.Set_Base_Address (Base + MMIO_GTT_64_Offset); else GTT_32.Set_Base_Address (GTT_Base); GTT_64.Set_Base_Address (GTT_Base); end if; end Set_Register_Base; end HW.GFX.GMA.Registers;