svd2ada_0.1.0_6eb0b591/src/descriptors-device.adb

------------------------------------------------------------------------------
--                                                                          --
--                          SVD Binding Generator                           --
--                                                                          --
--                    Copyright (C) 2015-2020, AdaCore                      --
--                                                                          --
-- SVD2Ada is free software;  you can  redistribute it  and/or modify it    --
-- under terms of the  GNU General Public License as published  by the Free --
-- Software  Foundation;  either version 3,  or (at your option) any later  --
-- version.  SVD2Ada is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY;  without even the  implied warranty of MERCHANTA-  --
-- BILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public  --
-- License for  more details.  You should have  received  a copy of the GNU --
-- General Public License  distributed with SVD2Ada; see file COPYING3.  If --
-- not, go to http://www.gnu.org/licenses for a complete copy of the        --
-- license.                                                                 --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO;           use Ada.Text_IO;
with GNAT.OS_Lib;

with DOM.Core;
with DOM.Core.Elements;     use DOM.Core.Elements;
with DOM.Core.Nodes;        use DOM.Core.Nodes;

with Ada_Gen;               use Ada_Gen;
with SVD2Ada_Utils;
with Ada.Containers;

package body Descriptors.Device is

   use type Ada.Containers.Count_Type;

   package Interrupt_Sort is new Interrupt_Vectors.Generic_Sorting
     (Base_Types."<");

   procedure Dump_Handler_ASM
     (Device     : Device_T;
      Ints       : Interrupt_Vectors.Vector;
      Output_Dir : String);

   procedure Dump_IRQ_Support
     (Device : Device_T;
      Output_Dir : String);
   --  Dump the IRQ names and trap handlers

   procedure Gather_Peripheral_Group
     (Group_Name  : Unbounded_String;
      Peripherals : in out Peripheral_Vectors.Vector;
      Group       : in out Peripheral_Vectors.Vector)
     --  Gather into Group each peripheral in Peripherals that is defined in
     --  the SVD file to be in the same group, as specified by having the same
     --  Group_Name. When finished, all peripherals now in Group are no longer
     --  in Peripherals.
     with
       Pre  => Group_Name /= "" and
               Group.Length = 1,  -- the first member has been inserted
       Post => Group.Length >= 1  -- perhaps only the initial member is in group
               and
               --  all members of Peripherals in the same group are in Group
               (for all P of Peripherals'Old =>
                  (if P.Group_Name = Group_Name then Group.Contains (P)))
               and
               --  all members of Group are in the same group and are no longer
               --  in Peripherals
               (for all P of Group =>
                  P.Group_Name = Group_Name and not Peripherals.Contains (P));

   function Is_Group_Member (P : Peripheral_Access) return Boolean is
     (Length (P.Group_Name) /= 0);
   --  a convenience function for readability

   -----------------
   -- Read_Device --
   -----------------

   function Read_Device
     (Elt      : DOM.Core.Element;
      Pkg_Name : String)
      return Device_T
   is
      use type DOM.Core.Node_Types;
      List   : constant DOM.Core.Node_List := DOM.Core.Nodes.Child_Nodes (Elt);
      Result : Device_T;

   begin
      if Pkg_Name'Length > 0 then
         Result.Name := Ada.Strings.Unbounded.To_Unbounded_String (Pkg_Name);
      end if;

      for J in 0 .. DOM.Core.Nodes.Length (List) - 1 loop
         if Node_Type (Item (List, J)) = DOM.Core.Element_Node then
            declare
               Child : constant DOM.Core.Element :=
                         DOM.Core.Element (Item (List, J));
               Tag   : String renames DOM.Core.Elements.Get_Tag_Name (Child);
            begin
               if Tag = "name" then
                  if Ada.Strings.Unbounded.Length (Result.Name) = 0 then
                     Result.Name := Get_Value (Child);
                  end if;

                  SVD2Ada_Utils.Set_Root_Package
                    (Ada.Strings.Unbounded.To_String (Result.Name));

               elsif Tag = "version" then
                  Result.Version := Get_Value (Child);

               elsif Tag = "description" then
                  Result.Description := Get_Value (Child);
                  Result.Short_Desc  := Result.Description;

                  for J in 1 .. Length (Result.Description) loop
                     if Element (Result.Description, J) = ASCII.CR
                       or else Element (Result.Description, J) = ASCII.LF
                     then
                        Result.Short_Desc := To_Unbounded_String
                          (Slice (Result.Description, 1, J - 1));
                        exit;
                     end if;
                  end loop;

               elsif Tag = "licenseText" then
                  Ada_Gen.Set_License_Text (Get_Value (Child));

               elsif Tag = "addressUnitBits" then
                  Result.Address_Unit_Bits := Get_Value (Child);

               elsif Tag = "width" then
                  Result.Width := Get_Value (Child);

               elsif Register_Properties.Is_Register_Property (Tag) then
                  Register_Properties.Read_Register_Property
                    (Child, Result.Reg_Properties);

               elsif Tag = "vendor" then
                  null; --  No need to decode, at least for now

               elsif Tag = "series" then
                  null; --  No need to decode, at least for now

               elsif Tag = "cpu" then
                  null; --  No need to decode, at least for now

               elsif Tag = "peripherals" then
                  declare
                     Child_List : constant DOM.Core.Node_List := Child_Nodes (Child);
                     Peripheral : Peripheral_T;
                  begin
                     for K in 0 .. Length (Child_List) - 1 loop
                        if Node_Type (Item (Child_List, K)) = DOM.Core.Element_Node then
                           Peripheral :=
                             Read_Peripheral
                               (DOM.Core.Element (Item (Child_List, K)),
                                Result.Reg_Properties,
                                Result);
                           Result.Peripherals.Append
                             (new Peripheral_T'(Peripheral));
                        end if;
                     end loop;
                  end;

               else
                  Ada.Text_IO.Put_Line
                    ("*** WARNING: ignoring device element " & Tag & " at " & Full_Name (Child));
               end if;
            end;
         end if;
      end loop;

      return Result;
   end Read_Device;

   --------------------
   -- Get_Peripheral --
   --------------------

   overriding function Get_Peripheral
     (Db     : Device_T;
      XML_Id : String) return Peripheral_Access
   is
   begin
      for P of Db.Peripherals loop
         if Ada.Strings.Unbounded.To_String (P.Name) = XML_Id then
            return P;
         end if;
      end loop;

      return null;
   end Get_Peripheral;

   ----------------------
   -- Dump_Handler_ASM --
   ----------------------

   procedure Dump_Handler_ASM
     (Device     : Device_T;
      Ints       : Interrupt_Vectors.Vector;
      Output_Dir : String)
   is
      ASM      : File_Type;
      F_Name   : constant String :=
                   GNAT.OS_Lib.Normalize_Pathname ("handler.S", Output_Dir);
      Tab_Size : Natural;
      Curs     : Interrupt_Vectors.Cursor;

      procedure Dump_Stub (Name : String);
      --  Dumps a weak empty function. To be overwritten by the run-time

      ---------------
      -- Dump_Stub --
      ---------------

      procedure Dump_Stub (Name : String) is
      begin
         Put_Line (ASM, ASCII.HT & ".thumb_func");
         Put_Line (ASM, ".weak " & Name);
         Put_Line (ASM, ".type " & Name & ", %function");
         Put_Line (ASM, Name & ":");
         Put_Line (ASM, "0:" & ASCII.HT & "b 0b");
         Put_Line (ASM, ASCII.HT & ".size " & Name & ", . - " & Name);
         New_Line (ASM);
      end Dump_Stub;

   begin
      Create (ASM, Out_File, F_Name);
      Put_Line (ASM, "## -*- asm -*- #############################");
      Put_Line (ASM, "# Automatically generated by SVD2Ada");
      Put_Line (ASM, "# For the " &
                  Ada.Strings.Unbounded.To_String (Device.Short_Desc) &
                  " target");
      Put_Line (ASM, "############################################");
      New_Line (ASM);
      Put_Line (ASM, ASCII.HT & ".syntax unified");
      --  ??? target is m4/m7, but what about previous versions?
      Put_Line (ASM, ASCII.HT & ".cpu cortex-m4");
      Put_Line (ASM, ASCII.HT & ".thumb");
      New_Line (ASM);

      --  Calculate the vector size to properly align it as requested.
      --  The vector consists on 16 reserved values for RESET, Hard float and
      --  so on, + the IRQs
      --  Removing 2 from the GNAT IRQ IDs to obtain the actual number of
      --  IRQs (the GNAT ID includes Systick, 0 being reserved).
      Tab_Size := (16 + Natural (Ints.Last_Element.Value) - 2) * 4;
      --  Now essie the proper alignment directive: the table needs to be
      --  aligned on a power of 2.
      Put_Line (ASM, ASCII.HT & ".text");
      Put_Line (ASM, ASCII.HT & ".globl __vectors");

      for J in 5 .. 16 loop
         if 2 ** J >= Tab_Size then
            Put_Line (ASM, ASCII.HT & ".p2align" & J'Img);
            exit;
         end if;
      end loop;

      Put_Line (ASM, "__vectors:");
      --  Cortex ARMv7-m defined 16 first values
      Put_Line
        (ASM,
         ASCII.HT & "/* Cortex-M core interrupts */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   0                    /* stack top address */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   fault                /* 1 Reset.  */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   fault                /* 2 NMI. */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   fault                /* 3 Hard fault. */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   fault                /* 4 Mem manage. */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   fault                /* 5 Bus fault. */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   fault                /* 6 Usage fault. */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   fault                /* 7 reserved. */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   fault                /* 8 reserved. */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   fault                /* 9 reserved. */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   fault                /* 10 reserved. */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   __gnat_sv_call_trap  /* 11 SVCall. */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   __gnat_bkpt_trap     /* 12 Breakpoint. */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   fault                /* 13 reserved. */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   __gnat_pend_sv_trap  /* 14 PendSV. */");
      Put_Line
        (ASM,
         ASCII.HT & ".word   __gnat_sys_tick_trap /* 15 Systick. */");

      Put_Line
        (ASM,
         ASCII.HT & "/* MCU interrupts */");

      Curs := Ints.First;

      for J in 0 .. Ints.Last_Element.Value loop
         while Interrupt_Vectors.Element (Curs).Value < J loop
            Interrupt_Vectors.Next (Curs);
         end loop;

         Put
           (ASM, ASCII.HT & ".word __gnat_irq_trap        /*" &
              Integer'Image (J + 16) & " ");
         if Interrupt_Vectors.Element (Curs).Value = J then
            Put_Line
              (ASM,
               Ada.Strings.Unbounded.To_String
                 (Interrupt_Vectors.Element (Curs).Name) &
                 " */");
         else
            Put_Line
              (ASM, "IRQ" & Integer'Image (J) & ". */");
         end if;
      end loop;

      New_Line (ASM);
      Put_Line (ASM, ASCII.HT & ".text");
      New_Line (ASM);
      --  Add weak symbols for the functions denoted by the Vector
      Dump_Stub ("__gnat_irq_trap");
      Dump_Stub ("__gnat_sv_call_trap");
      Dump_Stub ("__gnat_pend_sv_trap");
      Dump_Stub ("__gnat_sys_tick_trap");

      --  Add the never-ending 'fault' function
      Put_Line (ASM, ASCII.HT & ".thumb_func");
      Put_Line (ASM, "fault:" & ASCII.HT & "b fault");
      Close (ASM);
   end Dump_Handler_ASM;

   ----------------------
   -- Dump_IRQ_Support --
   ----------------------

   procedure Dump_IRQ_Support
     (Device : Device_T;
      Output_Dir : String)
   is
      Spec       : Ada_Gen.Ada_Spec;
      Interrupts : Interrupt_Vectors.Vector;
      Max_Len    : Natural := 0;

   begin
      if SVD2Ada_Utils.In_Runtime then
         --  When generating stubs for the Interfaces run-time hierarchy, also
         --  generate the Ada.Exceptions.Name file from the interrupts list
         Spec := New_Spec ("Ada.Interrupts.Names",
                           "This is a version for the " &
                             To_String (Device.Description) & " MCU",
                           False);

         Add (Spec,
              New_Pragma
                ("Implementation_Defined",
                 "All identifiers in this unit are implementation defined"));

         --  Add core interrupts
         Interrupts.Append
           ((Name        => To_Unbounded_String ("Sys_Tick"),
             Description => To_Unbounded_String
               ("System tick"),
             Value       => -1));

         if Length (Device.Description) >= 5 and then Slice (Device.Description, 1, 5) = "STM32"
           and then Slice (Device.Description, 6, 7) /= "F0"
         then
            --  ??? Workaround for the STM32F* svd files that do not define the
            --  FPU Interrupt. The STM32F0 series do not have an FPU.
            Interrupts.Append
              ((Name        => To_Unbounded_String ("FPU"),
                Description => To_Unbounded_String
                  ("FPU global interrupt"),
                Value       => 81));
         end if;

      else
         Spec := New_Child_Spec ("Interrupts",
                                 To_String (Device.Name),
                                 "Definition of the device's interrupts",
                                 False);
      end if;

      Add (Spec, New_Comment_Box ("Interrupts"));

      for Periph of Device.Peripherals loop
         for Int of Periph.Interrupts loop
            if not Interrupts.Contains (Int) then
               Interrupts.Append (Int);
               Max_Len := Natural'Max (Length (Int.Name), Max_Len);
            end if;
         end loop;
      end loop;

      Interrupt_Sort.Sort (Interrupts);

      declare
         Typ : constant String :=
                 (if SVD2Ada_Utils.In_Runtime then "Interrupt_ID" else "");
         --  When generating code for the run-time, we use the
         --  Ada.Interrupts.Interrupt_ID type. Otherwise, the interrupts are
         --  declared as named number to avoid dependency on Ada.Interrupts
         --  that may not be available, for instance when using ZFP
         --  run-time.
      begin
         for Int of Interrupts loop
            declare
               Id : constant String :=
                      (if Ends_With (To_String (Int.Name), "_IRQ")
                       then Slice (Int.Name, 1, Length (Int.Name) - 4)
                       else To_String (Int.Name));
               --  Remove the trailing _IRQ of the interrupt name, if any
            begin
               Add (Spec,
                    New_Constant_Value
                      (Id        => Id & "_Interrupt",
                       Align_Id  => Max_Len + 11,
                       Type_Name => Typ,
                       Value     => To_String (Int.Value),
                       Comment   => To_String (Int.Description)));
            end;
         end loop;
      end;

      Ada_Gen.Write_Spec (Spec, Output_Dir);

      Dump_Handler_ASM (Device, Interrupts, Output_Dir);
   end Dump_IRQ_Support;

   ----------
   -- Dump --
   ----------

   procedure Dump
     (Device     : Device_T;
      Output_Dir : String)
   is
      Peripherals : Peripheral_Vectors.Vector;
      Spec        : Ada_Gen.Ada_Spec :=
                      New_Spec (To_String (Device.Name),
                                To_String (Device.Description),
                                True);

   begin
      ----------------
      -- Interrupts --
      ----------------

      if SVD2Ada_Utils.Gen_IRQ_Support then
         Dump_IRQ_Support (Device, Output_Dir);
      end if;

      ----------------------------
      --  Base types definition --
      ----------------------------

      if SVD2Ada_Utils.External_Base_Types_Package then
         --  From GNAT GPL 2016 and GNAT Pro 17, Interfaces.Bit_Types is
         --  defined
         Ada_Gen.Add_Global_With (SVD2Ada_Utils.Base_Types_Package);

      else
         Add (Spec, New_Comment_Box ("Base type"));
         Add_No_Check (Spec, New_Type_Scalar (Target_Type (32, False), 32));
         Add_No_Check (Spec, New_Type_Scalar (Target_Type (16, False), 16));
         Add_No_Check (Spec, New_Type_Scalar (Target_Type (8, False), 8));
         Add_No_Check (Spec, New_Type_Scalar (Target_Type (1, False), 1));

         for J in 2 .. Device.Width loop
            if J not in 8 | 16 | 32 then
               Add_No_Check (Spec, New_Type_Scalar (Target_Type (J, False), J));
            end if;
         end loop;
      end if;

      -----------------------------------------
      --  Base addresses for the peripherals --
      -----------------------------------------

      Add (Spec, New_Comment_Box ("Base addresses"));
      Add (Spec, New_With_Clause ("System", False));

      for Periph of Device.Peripherals loop
         Add (Spec,
              New_Constant_Value
                (Id        => To_String (Periph.Name) & "_Base",
                 Align_Id  => 0,
                 Type_Name => "System.Address",
                 Value     => "System'To_Address (" & To_Hex (Periph.Base_Address) & ")"));
      end loop;

      ----------------------------------
      --  Root package for the device --
      ----------------------------------

      Ada.Text_IO.Put_Line ("Generating package " & To_String (Id (Spec)));

      Write_Spec (Spec, Output_Dir);

      ---------------------------------------------------
      --  Child packages for the device's peripherals  --
      ---------------------------------------------------

      Peripherals := Device.Peripherals;

      while not Peripherals.Is_Empty loop
         declare
            P     : constant Peripheral_Access := Peripherals.First_Element;
            Group : Peripheral_Vectors.Vector;
         begin
            Peripherals.Delete_First;

            if not Is_Group_Member (P) then
               Dump (P.all,
                     To_String (Device.Name),
                     Output_Dir);
            else
               Group.Append (P);
               Gather_Peripheral_Group (P.Group_Name, Peripherals, Group);
               Dump (Group,
                     To_String (Device.Name),
                     Output_Dir);
            end if;
         end;
      end loop;
   end Dump;

   -----------------------------
   -- Gather_Peripheral_Group --
   -----------------------------

   procedure Gather_Peripheral_Group
     (Group_Name  : Unbounded_String;
      Peripherals : in out Peripheral_Vectors.Vector;
      Group       : in out Peripheral_Vectors.Vector)
   is
      Index : Natural;
   begin
      Index := Peripherals.First_Index;

      while Index <= Peripherals.Last_Index loop
         if Peripherals (Index).Group_Name = Group_Name then
            Group.Append (Peripherals (Index));
            Peripherals.Delete (Index);
         else
            Index := Index + 1;
         end if;
      end loop;
   end Gather_Peripheral_Group;

end Descriptors.Device;