File : s-textio-stm32f4.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                       S Y S T E M . T E X T _ I O                        --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 --                                                                          --
  19 --                                                                          --
  20 --                                                                          --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31 
  32 --  Minimal version of Text_IO body for use on STM32F4xxx, using USART1
  33 
  34 with Interfaces; use Interfaces;
  35 
  36 with Interfaces.Bit_Types;   use Interfaces.Bit_Types;
  37 with Interfaces.STM32.RCC;   use Interfaces.STM32.RCC;
  38 with Interfaces.STM32.GPIO;  use Interfaces.STM32.GPIO;
  39 with Interfaces.STM32.USART; use Interfaces.STM32.USART;
  40 with System.STM32;           use System.STM32;
  41 with System.BB.Parameters;
  42 
  43 package body System.Text_IO is
  44 
  45    Baudrate : constant := 115_200;
  46    --  Bitrate to use
  47 
  48    ----------------
  49    -- Initialize --
  50    ----------------
  51 
  52    procedure Initialize is
  53       use System.BB.Parameters;
  54 
  55       APB_Clock    : constant Positive := Positive (STM32.System_Clocks.PCLK2);
  56       Int_Divider  : constant Positive := (25 * APB_Clock) / (4 * Baudrate);
  57       Frac_Divider : constant Natural := Int_Divider rem 100;
  58 
  59    begin
  60       Initialized := True;
  61 
  62       RCC_Periph.APB2ENR.USART1EN := 1;
  63       RCC_Periph.AHB1ENR.GPIOBEN  := 1;
  64 
  65       GPIOB_Periph.MODER.Arr     (6 .. 7) := (Mode_AF,     Mode_AF);
  66       GPIOB_Periph.OSPEEDR.Arr   (6 .. 7) := (Speed_50MHz, Speed_50MHz);
  67       GPIOB_Periph.OTYPER.OT.Arr (6 .. 7) := (Push_Pull,   Push_Pull);
  68       GPIOB_Periph.PUPDR.Arr     (6 .. 7) := (Pull_Up,     Pull_Up);
  69       GPIOB_Periph.AFRL.Arr      (6 .. 7) := (AF_USART1,   AF_USART1);
  70 
  71       USART1_Periph.BRR :=
  72         (DIV_Fraction => UInt4  (((Frac_Divider * 16 + 50) / 100) mod 16),
  73          DIV_Mantissa => UInt12 (Int_Divider / 100),
  74          others => <>);
  75       USART1_Periph.CR1 :=
  76         (UE => 1,
  77          RE => 1,
  78          TE => 1,
  79          others => <>);
  80       USART1_Periph.CR2 := (others => <>);
  81       USART1_Periph.CR3 := (others => <>);
  82    end Initialize;
  83 
  84    -----------------
  85    -- Is_Tx_Ready --
  86    -----------------
  87 
  88    function Is_Tx_Ready return Boolean is
  89      (USART1_Periph.SR.TC = 1);
  90 
  91    -----------------
  92    -- Is_Rx_Ready --
  93    -----------------
  94 
  95    function Is_Rx_Ready return Boolean is
  96      (USART1_Periph.SR.RXNE = 1);
  97 
  98    ---------
  99    -- Get --
 100    ---------
 101 
 102    function Get return Character is (Character'Val (USART1_Periph.DR.DR));
 103 
 104    ---------
 105    -- Put --
 106    ---------
 107 
 108    procedure Put (C : Character) is
 109    begin
 110       USART1_Periph.DR.DR := Character'Pos (C);
 111    end Put;
 112 
 113    ----------------------------
 114    -- Use_Cr_Lf_For_New_Line --
 115    ----------------------------
 116 
 117    function Use_Cr_Lf_For_New_Line return Boolean is (True);
 118 end System.Text_IO;