-- -- Author: Brent Seidel -- Date: 9-Aug-2024 -- -- This file is part of bbs_embed. -- Bbs_embed 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 3 of the License, or (at your -- option) any later version. -- -- bbs_embed 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. -- -- You should have received a copy of the GNU General Public License along -- with bbs_embed. If not, see .-- -- package body BBS.embed.due.serial.int is -- -- Enhanced transmission to work on all channels. If no channel is -- specified, default to channel 0. -- -- Function to initialize and return a serial port object -- function init(c : port_id; baud : SAM3x8e.UInt32) return serial_port is port : serial_port := port_list(c); begin -- -- Initialize the hardware -- init(c, baud); -- -- Initialize the object data structures -- port.b := buff(c); port.hardware := channel(c); port.b.init(port); if c = 0 then port.rx_echo := True; port.rx_del_enable := True; end if; return port; end; -- -- Function to return an object for a specific serial port -- function get_port(c : port_id) return serial_port is begin return port_list(c); end; -- -- Procedure to transmit a character on a serial port. -- procedure put(c : Character) is begin put(0, c); end; -- procedure put(chan : port_id; c : Character) is begin buff(chan).tx_write(c); end; -- procedure put(self : not null access serial_port_record'class; c : Character) is begin self.b.tx_write(c); end; -- -- Procedure to put a string to the serial port -- procedure put(s : string) is begin put(0, s); end; -- procedure put(chan : port_id; s : string) is begin for i in s'Range loop buff(chan).tx_write(s(i)); end loop; end; -- procedure put(self : not null access serial_port_record'class; s : String) is begin for i in s'Range loop self.b.tx_write(s(i)); end loop; end; -- -- Procedure to put a string to the serial port followed by a CR/LF -- procedure put_line(s : string) is begin put_line(0, s); end; -- procedure put_line(chan : port_id; s : string) is begin for i in s'Range loop buff(chan).tx_write(s(i)); end loop; for i in tx_eol'Range loop buff(chan).tx_write(tx_eol(i)); end loop; end; -- procedure put_line(self : not null access serial_port_record'class; s : String) is begin for i in s'Range loop self.b.tx_write(s(i)); end loop; for i in tx_eol'Range loop self.b.tx_write(tx_eol(i)); end loop; end; -- -- Procedure to write a new line to the serial port -- procedure new_line is begin new_line(0); end; -- procedure new_line(chan : port_id) is begin for i in tx_eol'Range loop buff(chan).tx_write(tx_eol(i)); end loop; end; -- procedure new_line(self : not null access serial_port_record'class) is begin for i in tx_eol'Range loop self.b.tx_write(tx_eol(i)); end loop; end; -- -- Enables RS-485 driver control via the specified pin. -- procedure enable_rs485(chan : port_id; d : BBS.embed.GPIO.Due.Due_GPIO_ptr) is begin buff(chan).enable_rs485(d); end; -- procedure enable_rs485(self : not null access serial_port_record'class; d : BBS.embed.GPIO.Due.Due_GPIO_ptr) is begin self.b.enable_rs485(d); end; -- -- Wait until transmit buffer is empty. -- procedure flush(chan : port_id) is begin Ada.Synchronous_Task_Control.Suspend_Until_True(port_list(chan).tx_empty); end; -- procedure flush(self : not null access serial_port_record'class) is begin Ada.Synchronous_Task_Control.Suspend_Until_True(self.tx_empty); end; -- -- Enable or disable rx interrupt. -- procedure rx_enable(chan : port_id; b : Boolean) is begin buff(chan).set_rx_int(b); end; -- procedure rx_enable(self : not null access serial_port_record'class; b : Boolean) is begin self.b.set_rx_int(b); end; -- -- Check to see if characters are available in the buffer -- function rx_ready return Boolean is begin return rx_ready(0); end; -- function rx_ready(chan : port_id) return Boolean is begin return Ada.Synchronous_Task_Control.Current_State(port_list(chan).rx_not_empty); end; -- function rx_ready(self : not null access serial_port_record'class) return Boolean is begin return Ada.Synchronous_Task_Control.Current_State(self.rx_not_empty); end; -- -- Read a character from the buffer. -- function get return Character is begin return get(0); end; -- function get(chan : port_id) return Character is c : Character; begin Ada.Synchronous_Task_Control.Suspend_Until_True(port_list(chan).rx_not_empty); buff(chan).rx_read(c); if port_list(chan).rx_echo then if c = CR then new_line(chan); else buff(chan).tx_write(c); end if; end if; return c; end; -- function get(self : not null access serial_port_record'class) return Character is c : Character; begin Ada.Synchronous_Task_Control.Suspend_Until_True(self.rx_not_empty); self.b.rx_read(c); if self.rx_echo then if c = CR then self.new_line; else self.b.tx_write(c); end if; end if; return c; end; -- -- Return the next character in the receive buffer without removing it -- function peek return Character is begin return peek(0); end; -- function peek(chan : port_id) return Character is c : Character; begin Ada.Synchronous_Task_Control.Suspend_Until_True(port_list(chan).rx_not_empty); buff(chan).rx_peek(c); return c; end; -- function peek(self : not null access serial_port_record'class) return Character is c : Character; begin Ada.Synchronous_Task_Control.Suspend_Until_True(self.rx_not_empty); self.b.rx_peek(c); return c; end; -- -- Return a line of text. -- procedure get_line(s : out String; l : out Natural) is begin get_line(0, s, l); end; -- procedure get_line(chan : port_id; s : in out String; l : out Natural) is i : Natural := s'First; c : Character; begin loop c := get(chan); if ((c = BS) or (c = DEL)) and port_list(chan).rx_echo and port_list(chan).rx_del_enable then if i > s'First then if c = BS then put(chan, ' ' & BS); else put(chan, BS & ' ' & BS); end if; i := i - 1; end if; else exit when c = CR; exit when c = LF; s(i) := c; i := i + 1; exit when i > s'Last; end if; end loop; l := i - s'First; end; -- procedure get_line(self : not null access serial_port_record'class; s : in out String; l : out Natural) is i : Natural := s'First; c : Character; begin loop c := self.get; if ((c = BS) or (c = DEL)) and self.rx_echo and self.rx_del_enable then if i > s'First then if c = BS then self.put(' ' & BS); else self.put(BS & ' ' & BS); end if; i := i - 1; end if; else exit when c = CR; exit when c = LF; s(i) := c; i := i + 1; exit when i > s'Last; end if; end loop; l := i - s'First; end; -- -- Procedures to control configuration settings -- procedure set_echo(chan : port_id; b : Boolean) is begin port_list(chan).rx_echo := b; end; -- procedure set_del(chan : port_id; b : Boolean) is begin port_list(chan).rx_del_enable := b; end; -- procedure set_echo(self : not null access serial_port_record'class; b : Boolean) is begin self.rx_echo := b; end; -- procedure set_del(self : not null access serial_port_record'class; b : Boolean) is begin self.rx_del_enable := b; end; -- -- ----------------------------------------------------------------------- -- Protected buffer. This handles the low level details of transmitting -- characters on the serial port. -- protected body buffer is -- -- Functions to return status about the buffer -- function tx_buffer_full return Boolean is begin return not tx_buff_not_full; end; -- function tx_complete return Boolean is begin return tx_buff_empty and (s.hardware.port.SR.TXEMPTY = 1); end; -- -- Add a character to the buffer. Note that if the buffer is empty and -- the transmitter is ready, the character is written directly to the -- transmitter. The transmit interrupt is only enabled when transmitter -- is not ready and a character is written to the buffer. -- entry tx_write(c : Character) when tx_buff_not_full is begin if rs485_mode then rs485_pin.set(1); end if; s.hardware.port.IDR.TXRDY := 1; if (s.hardware.port.SR.TXRDY = 1) and tx_buff_empty then s.hardware.port.THR.TXCHR := Character'Pos(c); else tx_buff(tx_fill_ptr) := Character'Pos(c); tx_fill_ptr := tx_fill_ptr + 1; tx_buff_not_full := (tx_fill_ptr + 1) /= tx_empty_ptr; s.hardware.port.IER.TXRDY := 1; tx_buff_empty := False; Ada.Synchronous_Task_Control.Set_False(s.tx_empty); end if; if rs485_mode then s.hardware.port.IER.TXEMPTY := 1; end if; end; -- -- Procedure to read a character from the receive buffer. Calls to this -- procedure need to be synchronized using susp_rx_buff_not_empty. -- procedure rx_read(c : out Character) is begin c := Character'Val(rx_buff(rx_empty_ptr)); rx_empty_ptr := rx_empty_ptr + 1; if rx_empty_ptr = rx_fill_ptr then Ada.Synchronous_Task_Control.Set_False(s.rx_not_empty); else Ada.Synchronous_Task_Control.Set_True(s.rx_not_empty); end if; end; -- -- Return the next character from the buffer, but don;t remove it from -- the buffer. This also needs to be synchronized using -- susp_rx_buff_not_empty. -- procedure rx_peek(c : out Character) is begin c := Character'Val(rx_buff(rx_empty_ptr)); Ada.Synchronous_Task_Control.Set_True(s.rx_not_empty); end; -- -- Procedure to reset the receive buffer. Set pointers and flags to -- their initial conditions. -- procedure rx_clear is begin rx_fill_ptr := 0; rx_empty_ptr := 0; end; -- -- Enable or disable the RX interrupt -- procedure set_rx_int(b : Boolean) is begin if b then s.hardware.port.IER.RXRDY := 1; else s.hardware.port.IDR.RXRDY := 1; end if; end; -- -- Procedure to enable RS-485 mode. -- procedure enable_rs485(d : BBS.embed.GPIO.Due.Due_GPIO_ptr) is begin rs485_pin := d; rs485_pin.set(0); rs485_mode := True; end; -- -- Procedure to initialize some things -- procedure init(p : serial_port) is begin s := p; end; -- -- This is the interrupt handler. There are three different things that -- may cause an interrupt: -- Transmitter ready: If the buffer is not empty, then pull the next -- character out of the buffer and write it to the transmitter. Update -- pointers and check if that was the last character. -- -- Receiver ready: Add characters to the receive buffer. If buffer is -- full, the oldest character is discarded. -- -- Transmitter empty: This is triggered when the UART is finished sending -- data and there is no more data ready. This is used in RS-485 mode -- to clear the pin used to enable the drivers. -- procedure int_handler is begin -- -- Check for transmitter ready. If so, send the next character(s). -- while (s.hardware.port.SR.TXRDY = 1) and not tx_buff_empty loop s.hardware.port.THR.TXCHR := tx_buff(tx_empty_ptr); tx_empty_ptr := tx_empty_ptr + 1; if tx_empty_ptr = tx_fill_ptr then tx_buff_empty := True; Ada.Synchronous_Task_Control.Set_True(s.tx_empty); else tx_buff_empty := False; Ada.Synchronous_Task_Control.Set_False(s.tx_empty); end if; if tx_buff_empty then s.hardware.port.IDR.TXRDY := 1; end if; tx_buff_not_full := True; end loop; -- -- Check for receiver ready. If the buffer is full, discard the oldest -- character in the buffer. -- while s.hardware.port.SR.RXRDY = 1 loop rx_buff(rx_fill_ptr) := s.hardware.port.RHR.RXCHR; rx_fill_ptr := rx_fill_ptr + 1; -- -- Check if buffer is full. If so, increment the rx_empty_ptr, -- thus discarding the oldest entry in the buffer. -- if (rx_fill_ptr + 1) = rx_empty_ptr then rx_empty_ptr := rx_empty_ptr + 1; end if; Ada.Synchronous_Task_Control.Set_True(s.rx_not_empty); end loop; -- -- Check for transmitter empty -- if (s.hardware.port.SR.TXEMPTY = 1) and rs485_mode then rs485_pin.set(0); s.hardware.port.IDR.TXEMPTY := 1; end if; end int_handler; end buffer; -- end BBS.embed.due.serial.int;