File : s-textio-lm3s.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-2015, 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 with System;
  33 with Interfaces;
  34 
  35 package body System.Text_IO is
  36    use Interfaces;
  37 
  38    UARTDR : Unsigned_32;
  39    for UARTDR'Address use 16#4000_C000#;
  40    pragma Import (Ada, UARTDR);
  41    pragma Volatile (UARTDR);
  42 
  43    UARTFR : Unsigned_32;
  44    for UARTFR'Address use 16#4000_C018#;
  45    pragma Import (Ada, UARTFR);
  46    pragma Volatile (UARTFR);
  47 
  48    --  TXFE : constant := 2#1000_0000#;
  49    --  RXFF : constant := 2#0100_0000#;
  50    --  Why are the above present commented out???
  51 
  52    TXFF : constant := 2#0010_0000#;
  53    RXFE : constant := 2#0001_0000#;
  54    --  UARTFR bits
  55 
  56    ---------
  57    -- Get --
  58    ---------
  59 
  60    function Get return Character is
  61    begin
  62       return Character'Val (UARTDR and 16#FF#);
  63    end Get;
  64 
  65    ----------------
  66    -- Initialize --
  67    ----------------
  68 
  69    procedure Initialize is
  70       RCGC1 : Unsigned_32;
  71       for RCGC1'Address use 16#400F_E000# + 16#104#;
  72       pragma Import (Ada, RCGC1);
  73       pragma Volatile (RCGC1);
  74 
  75       RCGC2 : Unsigned_32;
  76       for RCGC2'Address use 16#400F_E000# + 16#108#;
  77       pragma Import (Ada, RCGC2);
  78       pragma Volatile (RCGC2);
  79 
  80       GPIOA_AFSEL : Unsigned_32;
  81       for GPIOA_AFSEL'Address use 16#4000_4000# + 16#420#;
  82       pragma Import (Ada, GPIOA_AFSEL);
  83       pragma Volatile (GPIOA_AFSEL);
  84 
  85       GPIOA_DEN : Unsigned_32;
  86       for GPIOA_DEN'Address use 16#4000_4000# + 16#51C#;
  87       pragma Import (Ada, GPIOA_DEN);
  88       pragma Volatile (GPIOA_DEN);
  89 
  90       UART0_IBRD : Unsigned_32;
  91       for UART0_IBRD'Address use 16#4000_C000# + 16#24#;
  92       pragma Import (Ada, UART0_IBRD);
  93       pragma Volatile (UART0_IBRD);
  94 
  95       UART0_FBRD : Unsigned_32;
  96       for UART0_FBRD'Address use 16#4000_C000# + 16#28#;
  97       pragma Import (Ada, UART0_FBRD);
  98       pragma Volatile (UART0_FBRD);
  99 
 100       UART0_LCRH : Unsigned_32;
 101       for UART0_LCRH'Address use 16#4000_C000# + 16#2C#;
 102       pragma Import (Ada, UART0_LCRH);
 103       pragma Volatile (UART0_LCRH);
 104 
 105       UART0_CTL : Unsigned_32;
 106       for UART0_CTL'Address use 16#4000_C000# + 16#30#;
 107       pragma Import (Ada, UART0_CTL);
 108       pragma Volatile (UART0_CTL);
 109 
 110       Freq : constant := 50_000_000;
 111       Baud : constant := 115_200;
 112       Brate : constant := (64 * Freq / 16 + Baud / 2) / Baud;
 113 
 114    begin
 115       --  Enable the clocks to the UART and GPIO modules
 116 
 117       RCGC2 := RCGC2 or 16#1#;
 118       RCGC1 := RCGC1 or 16#1#;
 119 
 120       --  Wait a little bit so that the modules are clocked
 121 
 122       for I in 1 .. 1024 loop
 123          null;
 124       end loop;
 125 
 126       --  Set GPIO A0 and A1 as UART pins
 127 
 128       GPIOA_AFSEL := GPIOA_AFSEL or 3;
 129 
 130       --  Set the pin type
 131 
 132       GPIOA_DEN := GPIOA_DEN or 3;
 133 
 134       --  Set the bit rate
 135 
 136       UART0_IBRD := Brate / 64;
 137       UART0_FBRD := Brate mod 64;
 138 
 139       --  8N1, FIFO enabled
 140 
 141       UART0_LCRH := 16#70#;
 142 
 143       --  Enable RX, TX, and the UART
 144 
 145       UART0_CTL := 16#301#;
 146 
 147       Initialized := True;
 148    end Initialize;
 149 
 150    -----------------
 151    -- Is_Rx_Ready --
 152    -----------------
 153 
 154    function Is_Rx_Ready return Boolean is
 155    begin
 156       return (UARTFR and RXFE) = 0;
 157    end Is_Rx_Ready;
 158 
 159    -----------------
 160    -- Is_Tx_Ready --
 161    -----------------
 162 
 163    function Is_Tx_Ready return Boolean is
 164    begin
 165       return (UARTFR and TXFF) = 0;
 166    end Is_Tx_Ready;
 167 
 168    ---------
 169    -- Put --
 170    ---------
 171 
 172    procedure Put (C : Character) is
 173    begin
 174       --  Send the character
 175 
 176       UARTDR := Character'Pos (C);
 177    end Put;
 178 
 179    ----------------------------
 180    -- Use_Cr_Lf_For_New_Line --
 181    ----------------------------
 182 
 183    function Use_Cr_Lf_For_New_Line return Boolean is
 184    begin
 185       return True;
 186    end Use_Cr_Lf_For_New_Line;
 187 
 188 end System.Text_IO;