Category : Miscellaneous Language Source Code
Archive   : ADAXREF.ZIP
Filename : CHRSTRM.PKG

--======================================================================

-- 21 DEC 84
-- Last Modified: 23 DEC 84
-- Rewritten 11/5/86 for newer I/O - RLB - RRS

with BASIC_IO, IO_EXCEPTIONS, UNCHECKED_DEALLOCATION;

package body CHRSTRM is

-- A facility that provides serial stream input with character push
-- back capability. See CHRSTRM.LIB, the library unit for this
-- package, for further details.

type FILE_REC is record
CHAR_SAVED : BOOLEAN;
-- TRUE if a character saved by UNGET_CHAR is waiting for
-- GET_CHAR to pick it up
SAVED_CHAR : CHARACTER;
-- this is where characters saved by UNGET_CHAR are held
FILE : BASIC_IO.FILE_PTR;
end record;

--------------------------------------------------------------------

procedure OPEN_FILE(INFILE : in out FILE; NAME : in out STRING) is
-- Opens INFILE with name for serial stream input. Raises the
-- same exceptions as Sequential_IO.Open.
begin
INFILE := new FILE_REC;
INFILE.CHAR_SAVED := FALSE;
BASIC_IO.OPEN(INFILE.FILE, NAME, BASIC_IO.READ_ONLY);
-- If an exception is raised, space is not recovered.
end OPEN_FILE;

--------------------------------------------------------------------

procedure CLOSE_FILE(INFILE : in out FILE) is
-- Close INFILE. Raises the same exceptions as Sequential_IO.Close.
procedure DISPOSE is new UNCHECKED_DEALLOCATION(FILE_REC, FILE);
begin
if INFILE = NULL then
raise IO_EXCEPTIONS.STATUS_ERROR;
end if;
BASIC_IO.CLOSE(INFILE.FILE);
-- If an exception is raised, space is not recovered.
Dispose(INFILE);
end CLOSE_FILE;

--------------------------------------------------------------------

procedure GET_CHAR(INFILE : in FILE;
CHR : out CHARACTER;
EOFP : out BOOLEAN) is
-- sets CHR to the next available character from the serial
-- stream if there is one and to ASCII.NUL otherwise; sets EOFP
-- to TRUE if an end-of-file is encountered, FALSE otherwise;
-- INFILE is the source of the serial stream, raises IO_EXCEPTIONS.
-- STATUS_ERROR if it is not open.

begin

if INFILE = NULL then
raise IO_EXCEPTIONS.STATUS_ERROR;
elsif INFILE.CHAR_SAVED then
CHR := INFILE.SAVED_CHAR;
INFILE.CHAR_SAVED := FALSE;
EOFP := FALSE;
else
BASIC_IO.READ_MEM(INFILE.FILE, CHR'ADDRESS, 1);
EOFP := FALSE;
end if;

exception
when IO_EXCEPTIONS.END_ERROR =>
EOFP := TRUE;
CHR := ASCII.NUL;
end GET_CHAR;

--------------------------------------------------------------------

procedure UNGET_CHAR(INFILE : in FILE; CHR : CHARACTER) is
-- pushes CHR back into the serial stream where it can be
-- retrieved by a subsequent call to GET_CHAR. Raises CONSTRAINT_ERROR
-- if it fails; only one character at a time can be pushed back,
-- so UNGET_CHAR will fail if you make two successive calls to it
-- without making an intervening call to GET_CHAR; raises IO_EXCEPTIONS.
-- STATUC_ERROR if INFILE is not open.

begin

if INFILE = NULL then
raise IO_EXCEPTIONS.STATUS_ERROR;
elsif INFILE.CHAR_SAVED then
raise CONSTRAINT_ERROR;
else
INFILE.SAVED_CHAR := CHR;
INFILE.CHAR_SAVED := TRUE;
end if;

end UNGET_CHAR;

end CHRSTRM;

--======================================================================