stm32f0x2_hal_0.1.0_85eaea48/src/drivers/stm32-gpio.adb

------------------------------------------------------------------------------
--                                                                          --
--                 Copyright (C) 2015-2021, AdaCore                         --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of STMicroelectronics nor the names of its       --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
------------------------------------------------------------------------------
--
--  Copyright 2022 (C) Marc Poulhiès
--  This file has been adapted for the STM32F0 (ARM Cortex M4)
--  Beware that most of this has been reused from Ada Drivers Library
--  (https://github.com/AdaCore/Ada_Drivers_Library) and has been
--  tested (as of this writing) in only one very restricted scenario.
--
--  SPDX-License-Identifier: BSD-3-Clause

with System;         use System;
with STM32_SVD.GPIO; use STM32_SVD.GPIO;

with System.Machine_Code;

package body STM32.GPIO is

   procedure Lock_The_Pin (This : in out GPIO_Port; Pin : GPIO_Pin);
   --  This is the routine that actually locks the pin for the port. It is an
   --  internal routine and has no preconditions. We use it to avoid redundant
   --  calls to the precondition that checks that the pin is not already
   --  locked. The redundancy would otherwise occur because the routine that
   --  locks an array of pins is implemented by calling the routine that locks
   --  a single pin: both those Lock routines have a precondition that checks
   --  that the pin(s) is not already being locked.

   subtype GPIO_Pin_Index is Natural range 0 .. GPIO_Pin'Pos (GPIO_Pin'Last);

   -------------
   -- Any_Set --
   -------------

   function Any_Set (Pins : GPIO_Points) return Boolean is
   begin
      for Pin of Pins loop
         if Pin.Set then
            return True;
         end if;
      end loop;

      return False;
   end Any_Set;

   ----------
   -- Mode --
   ----------

   overriding function Mode (This : GPIO_Point) return HAL.GPIO.GPIO_Mode is
   begin
      case Pin_IO_Mode (This) is
         when Mode_Out =>
            return HAL.GPIO.Output;
         when Mode_In =>
            return HAL.GPIO.Input;
         when others =>
            return HAL.GPIO.Unknown_Mode;
      end case;
   end Mode;

   -----------------
   -- Pin_IO_Mode --
   -----------------

   function Pin_IO_Mode (This : GPIO_Point) return Pin_IO_Modes is
      Index : constant GPIO_Pin_Index := GPIO_Pin'Pos (This.Pin);
   begin
      return Pin_IO_Modes'Val (This.Periph.MODER.Arr (Index));
   end Pin_IO_Mode;

   --------------
   -- Set_Mode --
   --------------

   overriding procedure Set_Mode
     (This : in out GPIO_Point; Mode : HAL.GPIO.GPIO_Config_Mode)
   is
      Index : constant GPIO_Pin_Index := GPIO_Pin'Pos (This.Pin);
   begin
      case Mode is
         when HAL.GPIO.Output =>
            This.Periph.MODER.Arr (Index) := Pin_IO_Modes'Enum_Rep (Mode_Out);
         when HAL.GPIO.Input =>
            This.Periph.MODER.Arr (Index) := Pin_IO_Modes'Enum_Rep (Mode_In);
      end case;
   end Set_Mode;

   -------------------
   -- Pull_Resistor --
   -------------------

   overriding function Pull_Resistor
     (This : GPIO_Point) return HAL.GPIO.GPIO_Pull_Resistor
   is
      Index : constant GPIO_Pin_Index := GPIO_Pin'Pos (This.Pin);
   begin
      if This.Periph.PUPDR.Arr (Index) = 0 then
         return HAL.GPIO.Floating;
      elsif This.Periph.PUPDR.Arr (Index) = 1 then
         return HAL.GPIO.Pull_Up;
      else
         return HAL.GPIO.Pull_Down;
      end if;
   end Pull_Resistor;

   -----------------------
   -- Set_Pull_Resistor --
   -----------------------

   overriding procedure Set_Pull_Resistor
     (This : in out GPIO_Point; Pull : HAL.GPIO.GPIO_Pull_Resistor)
   is
      Index : constant GPIO_Pin_Index := GPIO_Pin'Pos (This.Pin);
   begin
      case Pull is
         when HAL.GPIO.Floating =>
            This.Periph.PUPDR.Arr (Index) := 0;
         when HAL.GPIO.Pull_Up =>
            This.Periph.PUPDR.Arr (Index) := 1;
         when HAL.GPIO.Pull_Down =>
            This.Periph.PUPDR.Arr (Index) := 2;
      end case;
   end Set_Pull_Resistor;

   ---------
   -- Set --
   ---------

   overriding function Set (This : GPIO_Point) return Boolean is
      Pin_Mask : constant UInt16 := GPIO_Pin'Enum_Rep (This.Pin);
   begin
      return (This.Periph.IDR.IDR.Val and Pin_Mask) = Pin_Mask;
   end Set;

   -------------
   -- All_Set --
   -------------

   function All_Set (Pins : GPIO_Points) return Boolean is
   begin
      for Pin of Pins loop
         if not Pin.Set then
            return False;
         end if;
      end loop;

      return True;
   end All_Set;

   ---------
   -- Set --
   ---------

   overriding procedure Set (This : in out GPIO_Point) is
   begin
      This.Periph.BSRR.BS.Val := GPIO_Pin'Enum_Rep (This.Pin);
      --  The bit-set and bit-reset registers ignore writes of zeros so we
      --  don't need to preserve the existing bit values in those registers.
   end Set;

   ---------
   -- Set --
   ---------

   procedure Set (Pins : in out GPIO_Points) is
   begin
      for Pin of Pins loop
         Pin.Set;
      end loop;
   end Set;

   -----------
   -- Clear --
   -----------

   overriding procedure Clear (This : in out GPIO_Point) is
   begin
      This.Periph.BSRR.BR.Val := GPIO_Pin'Enum_Rep (This.Pin);
      --  The bit-set and bit-reset registers ignore writes of zeros so we
      --  don't need to preserve the existing bit values in those registers.
   end Clear;

   -----------
   -- Clear --
   -----------

   procedure Clear (Pins : in out GPIO_Points) is
   begin
      for Pin of Pins loop
         Pin.Clear;
      end loop;
   end Clear;

   ------------
   -- Toggle --
   ------------

   overriding procedure Toggle (This : in out GPIO_Point) is
   begin
      This.Periph.ODR.ODR.Val :=
        This.Periph.ODR.ODR.Val xor GPIO_Pin'Enum_Rep (This.Pin);
   end Toggle;

   ------------
   -- Toggle --
   ------------

   procedure Toggle (Points : in out GPIO_Points) is
   begin
      for Point of Points loop
         Point.Toggle;
      end loop;
   end Toggle;

   -----------
   -- Drive --
   -----------

   procedure Drive (This : in out GPIO_Point; Condition : Boolean) is
   begin
      if Condition then
         This.Set;
      else
         This.Clear;
      end if;
   end Drive;

   ------------
   -- Locked --
   ------------

   function Locked (This : GPIO_Point) return Boolean is
      Mask : constant UInt16 := GPIO_Pin'Enum_Rep (This.Pin);
   begin
      return (This.Periph.LCKR.LCK.Val and Mask) = Mask;
   end Locked;

   ------------------
   -- Lock_The_Pin --
   ------------------

   procedure Lock_The_Pin (This : in out GPIO_Port; Pin : GPIO_Pin) is
      use System.Machine_Code;
      use ASCII;
      LCKK_Val : constant Positive := 16#6_5536#;
   begin
      --  As per the Reference Manual (RM0091;  Doc ID 018940 Rev 9) pg 160, a
      --  specific sequence is required to set a pin's lock bit. The sequence
      --  writes and reads values from the port's LCKR register. Remember that
      --  this 32-bit register has 16 bits for the pin mask (0 .. 15), with bit
      --  #16 used as the "lock control bit".
      --
      --  1) write a 1 to the lock control bit with a 1 in the pin bit mask for the pin to be locked
      --  2) write a 0 to the lock control bit with a 1 in the pin bit mask for the pin to be locked
      --  3) do step 1 again
      --  4) read the entire LCKR register
      --  5) read the entire LCKR register again (optional)

      --  Throughout the sequence the same value for the lower 16 bits of the
      --  word must be maintained (i.e., the pin mask), including when clearing
      --  the LCCK bit in the upper half.

      --  Expressed in Ada the sequence would be as follows:
      --        Temp := LCCK or Pin'Enum_Rep;
      --
      --        --  set the lock bit and pin bit, others will be unchanged
      --        Port.LCKR := Temp;
      --
      --        --  clear the lock bit but keep the pin mask unchanged
      --        Port.LCKR := Pin'Enum_Rep;
      --
      --        --  set the lock bit again, with both lock bit and pin mask set as before
      --        Port.LCKR := Temp;
      --
      --        --  read the lock bit to complete key lock sequence
      --        Temp := Port.LCKR;
      --
      --        --  read the lock bit again (optional)
      --        Temp := Port.LCKR;

      --  We use the following assembly language sequence because the above
      --  high-level version in Ada works only if the optimizer is enabled.
      --  This is not an issue specific to Ada. If you need a specific sequence
      --  of instructions you should really specify those instructions.
      --  We don't want the functionality to depend on the switches, and we
      --  don't want to preclude debugging, hence the following:

      Asm
        ("mov  r3, %2" &
         LF &
         HT &  -- Temp := LCCK or Pin, ie both set

         "orr  r3, %1" & LF & HT &  -- Temp := LCCK or Pin, ie both set

         "str  r3, [%0, #28]" &
         LF &
         HT &  -- Port.LCKR := Temp

         "str  %1, [%0, #28]" & LF &
         HT &  -- Port.LCKR := Pin alone, LCCK bit cleared

         "str  r3, [%0, #28]" &
         LF &
         HT &  -- Port.LCKR := Temp

         "ldr  r3, [%0, #28]" & LF & HT &  -- Temp := Port.LCKR

         "ldr  r3, [%0, #28]" & LF & HT,   -- Temp := Port.LCKR

         Inputs =>
           [Address'Asm_Input ("r", This'Address), -- %0
            (GPIO_Pin'Asm_Input ("r", Pin)),
            (Positive'Asm_Input ("r", LCKK_Val))],       -- %1
         Volatile => True, Clobber => ("r3"));
   end Lock_The_Pin;

   ----------
   -- Lock --
   ----------

   procedure Lock (This : GPIO_Point) is
   begin
      Lock_The_Pin (This.Periph.all, This.Pin);
   end Lock;

   ----------
   -- Lock --
   ----------

   procedure Lock (Points : GPIO_Points) is
   begin
      for Point of Points loop
         if not Locked (Point) then
            Point.Lock;
         end if;
      end loop;
   end Lock;

   ------------------
   -- Configure_IO --
   ------------------

   procedure Configure_IO (This : GPIO_Point; Config : GPIO_Port_Configuration)
   is
      Index : constant GPIO_Pin_Index := GPIO_Pin'Pos (This.Pin);
   begin
      This.Periph.MODER.Arr (Index) := Pin_IO_Modes'Enum_Rep (Config.Mode);
      This.Periph.PUPDR.Arr (Index) :=
        Internal_Pin_Resistors'Enum_Rep (Config.Resistors);

      case Config.Mode is
         when Mode_In | Mode_Analog =>
            null;
         when Mode_Out =>
            This.Periph.OTYPER.OT.Arr (Index) :=
              Config.Output_Type = Open_Drain;
            This.Periph.OSPEEDR.Arr (Index) :=
              Pin_Output_Speeds'Enum_Rep (Config.Speed);
         when Mode_AF =>
            This.Periph.OTYPER.OT.Arr (Index) :=
              Config.AF_Output_Type = Open_Drain;
            This.Periph.OSPEEDR.Arr (Index) :=
              Pin_Output_Speeds'Enum_Rep (Config.AF_Speed);
            Configure_Alternate_Function (This, Config.AF);
      end case;
   end Configure_IO;

   ------------------
   -- Configure_IO --
   ------------------

   procedure Configure_IO
     (Points : GPIO_Points; Config : GPIO_Port_Configuration)
   is
   begin
      for Point of Points loop
         Point.Configure_IO (Config);
      end loop;
   end Configure_IO;

   ----------------------------------
   -- Configure_Alternate_Function --
   ----------------------------------

   procedure Configure_Alternate_Function
     (This : GPIO_Point; AF : GPIO_Alternate_Function)
   is
      Index : constant GPIO_Pin_Index := GPIO_Pin'Pos (This.Pin);
   begin
      if Index < 8 then
         This.Periph.AFRL.Arr (Index) := UInt4 (AF);
      else
         This.Periph.AFRH.Arr (Index) := UInt4 (AF);
      end if;
   end Configure_Alternate_Function;

   ----------------------------------
   -- Configure_Alternate_Function --
   ----------------------------------

   procedure Configure_Alternate_Function
     (Points : GPIO_Points; AF : GPIO_Alternate_Function)
   is
   begin
      for Point of Points loop
         Point.Configure_Alternate_Function (AF);
      end loop;
   end Configure_Alternate_Function;

   ---------------------------
   -- Interrupt_Line_Number --
   ---------------------------

   --  function Interrupt_Line_Number
   --    (This : GPIO_Point) return EXTI.External_Line_Number
   --  is
   --  begin
   --     return EXTI.External_Line_Number'Val (GPIO_Pin'Pos (This.Pin));
   --  end Interrupt_Line_Number;

   -----------------------
   -- Configure_Trigger --
   -----------------------

   --  procedure Configure_Trigger
   --    (This    : GPIO_Point;
   --     Trigger : EXTI.External_Triggers)
   --  is
   --     use STM32.EXTI;
   --     Line : constant External_Line_Number := External_Line_Number'Val (GPIO_Pin'Pos (This.Pin));
   --     use STM32.SYSCFG, STM32.RCC;
   --  begin
   --     SYSCFG_Clock_Enable;
   --
   --     Connect_External_Interrupt (This);
   --     if Trigger in Interrupt_Triggers then
   --        Enable_External_Interrupt (Line, Trigger);
   --     else
   --        Enable_External_Event (Line, Trigger);
   --     end if;
   --  end Configure_Trigger;

   -----------------------
   -- Configure_Trigger --
   -----------------------

   --  procedure Configure_Trigger
   --    (Points  : GPIO_Points;
   --     Trigger : EXTI.External_Triggers)
   --  is
   --  begin
   --     for Point of Points loop
   --        Point.Configure_Trigger (Trigger);
   --     end loop;
   --  end Configure_Trigger;

end STM32.GPIO;