dos_compilers/Artek Ada v125/TEXTIOB.ADA

--
-- T E X T   I N P U T / O U T P U T
--
-- Body of the Package Text_IO
--
-- According to ANSI/MIL-STD 1815A (1983)
-- Implemented for Artek Ada
--
-- Copyright (C) 1986, 1987 Artek Corporation
-- Authors : O. Karlsson & V. Thorsteinsson
--
--
-- Version: 1.00  February 1986
--                Deviations from the standard:
--
--                ENUMERATION_IO not implemented
--                FIXED_IO not implemented
--                CHARACTER PUT and GET accept 8 bit characters
--                GET and PUT floating point to/from string not implemented
--
-- Version: 1.01  June 1986
--                PUT and GET floating point to/from string implemented
--                GET_LINE for console input corrected
--
-- Version: 1.02  November 1986
--                ENUMERATION_IO implemented
--

with DOS_INTERFACE, SYSTEM;
use DOS_INTERFACE, SYSTEM, ASCII;

package body TEXT_IO is

   -- Data types and objects

   R : REG_8086;

   EOF : constant CHARACTER := CHARACTER (26);

   IN_CONSOLE_HANDLE  : constant INTEGER := 0;  -- DOS Handle for STDIN
   OUT_CONSOLE_HANDLE : constant INTEGER := 1;  -- DOS Handle for STDOUT

   DOS_INPUT, DOS_OUTPUT : FILE_TYPE;

   CURR_INPUT, CURR_OUTPUT : FILE_TYPE;

   DOS_IO_NAME : FILE_NAME_STRING :=
      (1 => 'C', 2 => 'O', 3 => 'N', others => ' ');  -- CON file

   PREV_CHAR : CHARACTER;
   UNGET_RAISED : BOOLEAN := FALSE;

--
-- Utility procedure to skip last character read from a file
-- Same as " lseek (file, -1) " relative from the file position
--

   procedure UNGET (FILE : in FILE_TYPE) is

   begin
      if FILE . HANDLE = 0 then -- Can't do UNGET on console input
         UNGET_RAISED := TRUE;
      else
         R . AX := 16#4201#;    -- DOS function 42, lseek
         R . BX := WORD (FILE . HANDLE);
         R . CX := -1;          -- Desired location from current position
         R . DX := -1;
         CALL_DOS (R);
         if R . FLAGS mod 2 = 1 then -- Carry was set
            raise USE_ERROR;         -- There should never be error here
         end if;
      end if;
   end UNGET;

--
-- procedures READ and WRITE are used internally
--

   procedure READ (FILE : in FILE_TYPE; ITEM : out CHARACTER) is

   begin
-- See comment at start of WRITE regarding checks on FILE
      if FILE . HANDLE = 0 and UNGET_RAISED then -- Called UNGET on console
         ITEM := PREV_CHAR;
         UNGET_RAISED := FALSE;
      elsif FILE . HANDLE = 0 then -- Input from console
         R . AX := 16#0100#;     -- DOS function 01, keyboard input
         CALL_DOS (R);
         PREV_CHAR := CHARACTER (R . AX mod 256);
         ITEM := PREV_CHAR;
      else
         R . AX := 16#3F00#;     -- DOS function 3F, read from a file or device
         R . BX := WORD (FILE . HANDLE);
         R . CX := 1;            -- Read one byte
         R . DX := WORD (ITEM'ADDRESS); -- Address of ITEM
         CALL_DOS (R);
         if R . AX = 0 then -- Read past EOF
            raise END_ERROR;
         end if;
         if R . FLAGS mod 2 = 1 then -- Carry set
            raise USE_ERROR;  -- Access denied or invalid file handle
         end if;
      end if;
   end READ;

   procedure WRITE (FILE : in FILE_TYPE; ITEM : in CHARACTER) is

   begin
-- The following checks are not needed since WRITE is never called
-- if one of the conditions is true
--      if FILE = null then
--         raise STATUS_ERROR;
--      elsif FILE . MODE /= OUT_FILE then
--         raise MODE_ERROR;
--      end if;
      R . AX := 16#4000#;    -- DOS function 40, write to a file or device
      R . BX := WORD (FILE . HANDLE);
      R . CX := 1;           -- Write one byte
      R . DX := WORD (ITEM'ADDRESS); -- Address of ITEM
      CALL_DOS (R);
      if R . AX = 0 then -- No output made, probably disk full error
         raise USE_ERROR;
      end if;
      if R . FLAGS mod 2 = 1 then -- Carry set
         raise USE_ERROR;  -- Access denied or invalid file handle
      end if;
   end WRITE;

   procedure WRITE_STRING (FILE : in FILE_TYPE; ITEM : in STRING) is

   begin
      R . AX := 16#4000#;    -- DOS function 40, write to a file or device
      R . BX := WORD (FILE . HANDLE);
      R . CX := WORD (ITEM'LENGTH);  -- Write LENGTH bytes
      R . DX := WORD (ITEM'ADDRESS); -- Address of ITEM
      CALL_DOS (R);
      if R . AX /= WORD (ITEM'LENGTH) then -- Probably disk full error
         raise USE_ERROR;
      end if;
      if R . FLAGS mod 2 = 1 then -- Carry set
         raise USE_ERROR;  -- Access denied or invalid file handle
      end if;
   end WRITE_STRING;

--
-- File management
--

   procedure CREATE (
      FILE : in out FILE_TYPE;
      MODE : in FILE_MODE := OUT_FILE;
      NAME : in STRING := "";
      FORM : in STRING := "") is

      ASCIIZ_NAME : FILE_NAME_STRING;
      BLANK_NAME : FILE_NAME_STRING := (others => ' ');
      BLANK_FORM : FORM_NAME_STRING := (others => ' ');

-- See chapter 14.3.1

   begin -- Concatenate a null character
      if FILE /= null then   -- Already open
         raise STATUS_ERROR;
      end if;
      ASCIIZ_NAME (1..NAME'LENGTH) := NAME;
      ASCIIZ_NAME (NAME'LENGTH + 1) := NUL;
      R . AX := 16#3C00#; -- Function 3C, Create a file
      R . DX := WORD (ASCIIZ_NAME'ADDRESS); -- Address of the filename
      R . CX := 16#0000#; -- No attributes
      CALL_DOS (R);
      if R . FLAGS mod 2 = 1 then -- Carry was set
         if R . AX > 3 then       -- 4 = Too many open files, 5 = access denied
            raise USE_ERROR;
         else
            raise NAME_ERROR;     -- 3 = Path not found
         end if;
      end if;
      FILE := new FILE_DESCR'
         (NAMELEN => NAME'LENGTH, NAME => BLANK_NAME,
          FORMLEN => FORM'LENGTH, FORM => BLANK_FORM,
          MODE => MODE,
          COL => 1, LINE => 1, PAGE => 1,
          LINE_LENGTH => UNBOUNDED, PAGE_LENGTH => UNBOUNDED,
          HANDLE => INTEGER (R . AX));
      FILE . NAME (1..NAME'LENGTH) := NAME;
      FILE . FORM (1..FORM'LENGTH) := FORM;
   end CREATE;

   procedure OPEN (
      FILE : in out FILE_TYPE;
      MODE : in FILE_MODE;
      NAME : in STRING;
      FORM : in STRING := "") is

      ASCIIZ_NAME : FILE_NAME_STRING;
      BLANK_NAME : FILE_NAME_STRING := (others => ' ');
      BLANK_FORM : FORM_NAME_STRING := (others => ' ');

-- See chapter 14.3.1

   begin
      if FILE /= null then    -- File already open
         raise STATUS_ERROR;
      end if;
      ASCIIZ_NAME (1..NAME'LENGTH) := NAME;
      ASCIIZ_NAME (NAME'LENGTH + 1) := NUL;
      case MODE is
         when IN_FILE => R . AX := 16#3D00#;  -- AH = 3D, Open a file
         when OUT_FILE => R . AX := 16#3D01#; -- AL = 00, Open for input
      end case;                               -- AL = 01, Open for output
      R . DX := WORD (ASCIIZ_NAME'ADDRESS);
      CALL_DOS (R);
      if R . FLAGS mod 2 = 1 then -- Carry was set
         if R . AX > 3 then
            raise USE_ERROR; -- Access denied and to many files open
         else
            raise NAME_ERROR; -- File not found
         end if;
      end if;
      FILE := new FILE_DESCR'
         (NAMELEN => NAME'LENGTH, NAME => BLANK_NAME,
          FORMLEN => FORM'LENGTH, FORM => BLANK_FORM,
          COL => 1, LINE => 1, PAGE => 1,
          LINE_LENGTH => UNBOUNDED, PAGE_LENGTH => UNBOUNDED,
          MODE => MODE,
          HANDLE => INTEGER (R . AX));
      FILE . NAME (1..NAME'LENGTH) := NAME;
      FILE . FORM (1..FORM'LENGTH) := FORM;
   end OPEN;

   procedure CLOSE (FILE : in out FILE_TYPE) is

-- See chapter 14.3.1

   begin
      if FILE = null then
         raise STATUS_ERROR;
      end if;
      if FILE . MODE = OUT_FILE then
         NEW_PAGE (FILE);
         WRITE (FILE, EOF);
      end if;
      R . AX := 16#3E00#;    -- DOS function 3E, Close a file handle
      R . BX := WORD (FILE . HANDLE);
      CALL_DOS (R);
      if R . FLAGS mod 2 = 1 then -- Carry was set
         raise USE_ERROR; -- Invalid handle.  This error should never
      end if;             -- occur.  Something is wrong in the file system.
      FILE := null;
   end CLOSE;

   procedure DELETE (FILE : in out FILE_TYPE) is

      ASCIIZ_NAME : FILE_NAME_STRING;

-- See chapter 14.3.1

   begin
      CLOSE (FILE);
      ASCIIZ_NAME (1..FILE . NAMELEN) := FILE . NAME (1..FILE . NAMELEN);
      ASCIIZ_NAME (FILE . NAMELEN + 1) := NUL;
      R . AX := 16#4100#; -- DOS function 41, delete a file
      R . DX := WORD (ASCIIZ_NAME'ADDRESS);
      CALL_DOS (R);
      if R . FLAGS mod 2 = 1 then -- Carry was set
         raise USE_ERROR;         -- Access denied
      end if;
   end DELETE;

   procedure RESET (FILE : in out FILE_TYPE; MODE : in FILE_MODE) is

      TL, TP : COUNT;

-- See chapter 14.3.1

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif (FILE = CURR_INPUT and MODE /= IN_FILE) or
         (FILE = CURR_OUTPUT and MODE /= OUT_FILE) then
         raise MODE_ERROR;
      end if;
      TL := FILE . LINE_LENGTH;
      TP := FILE . PAGE_LENGTH;
      CLOSE (FILE); -- Must close and reopen since MODE changes
      OPEN (FILE, MODE, FILE . NAME, FILE . FORM);
      if FILE . MODE = IN_FILE then  -- Restore line and page lengths
         FILE . LINE_LENGTH := TL;
         FILE . PAGE_LENGTH := TP;
      end if;
   end RESET;

   procedure RESET (FILE : in out FILE_TYPE) is

-- See chapter 14.3.1

   begin
      if FILE = null then
         raise STATUS_ERROR;
      end if;
      if FILE . MODE = OUT_FILE then
         NEW_PAGE (FILE);
         WRITE (FILE, EOF);
      end if;
      -- Do an LSEEK (FILE, 0);
      R . AX := 16#4200#;    -- DOS function 42, lseek
      R . BX := WORD (FILE . HANDLE);
      R . CX := 0;           -- Desired location from BOF
      R . DX := 0;
      CALL_DOS (R);
      if R . FLAGS mod 2 = 1 then -- Carry was set
         raise USE_ERROR;
      end if;
      FILE . COL := 1;
      FILE . LINE := 1;
      FILE . PAGE := 1;
   end RESET;

   function MODE (FILE : in FILE_TYPE) return FILE_MODE is

-- See chapter 14.3.1

   begin
      if FILE = null then
         raise STATUS_ERROR;
      end if;
      return FILE . MODE;
   end MODE;

   function NAME (FILE : in FILE_TYPE) return STRING is

-- See chapter 14.3.1

   begin
      if FILE = null then
         raise STATUS_ERROR;
      end if;
      return FILE . NAME;
   end NAME;

   function FORM (FILE : in FILE_TYPE) return STRING is

-- See chapter 14.3.1

   begin
      if FILE = null then
         raise STATUS_ERROR;
      end if;
      return FILE . FORM;
   end FORM;

   function IS_OPEN (FILE : in FILE_TYPE) return BOOLEAN is

-- See chapter 14.3.1

   begin
      return FILE /= null;
   end IS_OPEN;

--
-- Control of default input and output files
--

   procedure SET_INPUT (FILE : in FILE_TYPE) is

-- See chapter 14.3.2

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= IN_FILE then
         raise MODE_ERROR;
      end if;
      CURR_INPUT := FILE;
   end SET_INPUT;

   procedure SET_OUTPUT (FILE : in FILE_TYPE) is

-- See chapter 14.3.2

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= OUT_FILE then
         raise MODE_ERROR;
      end if;
      CURR_OUTPUT := FILE;
   end SET_OUTPUT;

   function STANDARD_INPUT return FILE_TYPE is

-- See chapter 14.3.2

   begin
      return DOS_INPUT;
   end STANDARD_INPUT;

   function STANDARD_OUTPUT return FILE_TYPE is

-- See chapter 14.3.2

   begin
      return DOS_OUTPUT;
   end STANDARD_OUTPUT;

   function CURRENT_INPUT return FILE_TYPE is

-- See chapter 14.3.2

   begin
      return CURR_INPUT;
   end CURRENT_INPUT;

   function CURRENT_OUTPUT return FILE_TYPE is

-- See chapter 14.3.2

   begin
      return CURR_OUTPUT;
   end CURRENT_OUTPUT;

--
-- Specification of line and page lengths
--

   procedure SET_LINE_LENGTH (FILE : in FILE_TYPE; TO : in COUNT) is

-- See chapter 14.3.3

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= OUT_FILE then
         raise MODE_ERROR;
      end if;
      FILE . LINE_LENGTH := TO;
   end SET_LINE_LENGTH;

   procedure SET_LINE_LENGTH (TO : in COUNT) is

-- See chapter 14.3.3

   begin
      SET_LINE_LENGTH (CURR_OUTPUT, TO);
   end SET_LINE_LENGTH;

   procedure SET_PAGE_LENGTH (FILE : in FILE_TYPE; TO : in COUNT) is

-- See chapter 14.3.3

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= OUT_FILE then
         raise MODE_ERROR;
      end if;
      FILE . PAGE_LENGTH := TO;
   end SET_PAGE_LENGTH;

   procedure SET_PAGE_LENGTH (TO : in COUNT) is

-- See chapter 14.3.3

   begin
      SET_PAGE_LENGTH (CURR_OUTPUT, TO);
   end SET_PAGE_LENGTH;

   function LINE_LENGTH (FILE : in FILE_TYPE) return COUNT is

-- See chapter 14.3.3

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= OUT_FILE then
         raise MODE_ERROR;
      end if;
      return FILE . LINE_LENGTH;
   end LINE_LENGTH;

   function LINE_LENGTH return COUNT is

-- See chapter 14.3.3

   begin
      return LINE_LENGTH (CURR_OUTPUT);
   end LINE_LENGTH;

   function PAGE_LENGTH (FILE : in FILE_TYPE) return COUNT is

-- See chapter 14.3.3

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= OUT_FILE then
         raise MODE_ERROR;
      end if;
      return FILE . PAGE_LENGTH;
   end PAGE_LENGTH;

   function PAGE_LENGTH return COUNT is

-- See chapter 14.3.3

   begin
      return PAGE_LENGTH (CURR_OUTPUT);
   end PAGE_LENGTH;

--
-- Column, Line, and Page Contril
--

   procedure NEW_LINE (FILE : in FILE_TYPE;
      SPACING : in POSITIVE_COUNT := 1) is

-- See chapter 14.3.4

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= OUT_FILE then
         raise MODE_ERROR;
      else
         for I in 1 .. SPACING loop
            WRITE (FILE, CR);
            WRITE (FILE, LF);
            FILE . LINE := FILE . LINE + 1;
            if (FILE . PAGE_LENGTH /= UNBOUNDED) and
               (FILE . LINE >= FILE . PAGE_LENGTH) then
               WRITE (FILE, FF);
               FILE . PAGE := FILE . PAGE + 1;
            end if;
         end loop;
         FILE . COL := 1;
      end if;
   end NEW_LINE;

   procedure NEW_LINE (SPACING : in POSITIVE_COUNT := 1) is

-- See chapter 14.3.4

   begin
      NEW_LINE (CURR_OUTPUT, SPACING);
   end NEW_LINE;

   procedure SKIP_LINE (FILE : in FILE_TYPE;
      SPACING : in POSITIVE_COUNT := 1) is

      PREVCH, CH : CHARACTER;

-- See chapter 14.3.4

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= IN_FILE then
         raise MODE_ERROR;
      end if;
      for I in 1..SPACING loop
         PREVCH := ' ';
         loop
            READ (FILE, CH);
            case CH is
               when CR =>
                  FILE . COL := 1;
                  if FILE . HANDLE = 0 then -- Input from console
                     FILE . LINE := FILE . LINE + 1;
                     if (FILE . PAGE_LENGTH /= UNBOUNDED) and
                        (FILE . LINE >= FILE . PAGE_LENGTH) then
                        FILE . PAGE := FILE . PAGE + 1;
                        FILE . LINE := 1;
                     end if;
                     exit;
                  end if;
               when LF =>
                  FILE . LINE := FILE . LINE + 1;
                  if (FILE . PAGE_LENGTH /= UNBOUNDED) and
                     (FILE . LINE >= FILE . PAGE_LENGTH) then
                     FILE . PAGE := FILE . PAGE + 1;
                     FILE . LINE := 1;
                  end if;
               when FF =>
                  FILE . PAGE := FILE . PAGE + 1;
                  FILE . COL := 1;
                  FILE . LINE := 1;
               when EOF =>
                  if (PREVCH = CR) or (PREVCH = LF) or (PREVCH = FF) then
                     UNGET (FILE);
                     exit;
                  else
                     raise END_ERROR;
                  end if;
               when others =>
                  if (PREVCH = CR) or (PREVCH = LF) or (PREVCH = FF) then
                     UNGET (FILE);
                     exit;
                  end if;
            end case;
            PREVCH := CH;
         end loop;
      end loop;
   end SKIP_LINE;

   procedure SKIP_LINE (SPACING : in POSITIVE_COUNT := 1) is

-- See chapter 14.3.4

   begin
      SKIP_LINE (CURR_INPUT, SPACING);
   end SKIP_LINE;

   function END_OF_LINE (FILE : in FILE_TYPE) return BOOLEAN is

      CH : CHARACTER;

-- See chapter 14.3.4

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= IN_FILE then
         raise MODE_ERROR;
      end if;
      READ (FILE, CH);
      UNGET (FILE);
      return (CH = CR) or (CH = LF) or (CH = EOF);
   exception
      when END_ERROR => -- If already EOF return TRUE
         UNGET (FILE);
         return TRUE;
   end END_OF_LINE;

   function END_OF_LINE return BOOLEAN is

-- See chapter 14.3.4

   begin
      return END_OF_LINE (CURR_INPUT);
   end END_OF_LINE;

   procedure NEW_PAGE (FILE : in FILE_TYPE) is

-- See chapter 14.3.4

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= OUT_FILE then
         raise MODE_ERROR;
      end if;
      if (FILE . COL > 1) or (FILE . COL = 1 and FILE . LINE = 1) then
         NEW_LINE (FILE); -- Sets FILE . COL := 1
      end if;
      WRITE (FILE, FF); -- Form Feed
      FILE . LINE := 1;
      FILE . PAGE := FILE . PAGE + 1;
   end NEW_PAGE;

   procedure NEW_PAGE is

-- See chapter 14.3.4

   begin
      NEW_PAGE (CURR_OUTPUT);
   end NEW_PAGE;

   procedure SKIP_PAGE (FILE : in FILE_TYPE) is

      CH : CHARACTER;

-- See chapter 14.3.4

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= IN_FILE then
         raise MODE_ERROR;
      end if;
      loop
         READ (FILE, CH);
         if CH = EOF then
            raise END_ERROR;
         end if;
         exit when CH = FF;
      end loop;
      FILE . LINE := 1;
      FILE . COL := 1;
      FILE . PAGE := FILE . PAGE + 1;
   end SKIP_PAGE;

   procedure SKIP_PAGE is

-- See chapter 14.3.4

   begin
      SKIP_PAGE (CURR_INPUT);
   end SKIP_PAGE;

   function END_OF_PAGE (FILE : in FILE_TYPE) return BOOLEAN is

      CH : CHARACTER;

-- See chapter 14.3.4

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= IN_FILE then
         raise MODE_ERROR;
      end if;
      READ (FILE, CH);  -- returns TRUE if (CR LF FF), (FF) or (EOF)
      if CH = CR or CH = LF then
         READ (FILE, CH);
         if CH = CR or CH = LF then
            READ (FILE, CH);
            UNGET (FILE);
         end if;
         UNGET (FILE);
      end if;
      UNGET (FILE);
      return CH = FF or CH = EOF;
   exception
      when END_ERROR =>
         UNGET (FILE);
         return TRUE;
   end END_OF_PAGE;

   function END_OF_PAGE return BOOLEAN is

-- See chapter 14.3.4

   begin
      return END_OF_PAGE (CURR_INPUT);
   end END_OF_PAGE;

   function END_OF_FILE (FILE : in FILE_TYPE) return BOOLEAN is

      CH : CHARACTER;

-- See chapter 14.3.4

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= IN_FILE then
         raise MODE_ERROR;
      end if;
      READ (FILE, CH);  -- returns TRUE if (CR LF FF EOF), (FF EOF)
                        -- or (CR LF EOF) or (EOF)
      if CH = CR or CH = LF or CH = FF then
         READ (FILE, CH);
         if CH = CR or CH = LF or CH = FF then
            READ (FILE, CH);
            if CH = CR or CH = LF or CH = FF then
               READ (FILE, CH);
               UNGET (FILE);
            end if;
            UNGET (FILE);
         end if;
         UNGET (FILE);
      end if;
      UNGET (FILE);
      return CH = EOF;
   exception
      when END_ERROR =>
         UNGET (FILE);
         return TRUE;
   end END_OF_FILE;

   function END_OF_FILE return BOOLEAN is

-- See chapter 14.3.4

   begin
      return END_OF_FILE (CURR_INPUT);
   end;

   procedure SET_COL (FILE : in FILE_TYPE; TO : in POSITIVE_COUNT) is

      CH : CHARACTER;

-- See chapter 14.3.4

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE = OUT_FILE and FILE . LINE_LENGTH /= UNBOUNDED
         and TO > FILE . LINE_LENGTH then
         raise LAYOUT_ERROR;
      end if;
      if FILE . MODE = IN_FILE then
         if FILE . COL /= TO then
            loop
               READ (FILE, CH);      -- Read until (FILE . COL = TO) or EOF
               case CH is
                  when CR =>
                     FILE . COL := 1;
                  when LF =>
                     FILE . LINE := FILE . LINE + 1;
                     if (FILE . PAGE_LENGTH /= UNBOUNDED) and
                        (FILE . LINE >= FILE . PAGE_LENGTH) then
                        FILE . PAGE := FILE . PAGE + 1;
                        FILE . LINE := 1;
                     end if;
                  when FF =>
                     FILE . PAGE := FILE . PAGE + 1;
                     FILE . COL := 1;
                     FILE . LINE := 1;
                  when EOF =>
                     raise END_ERROR;
                  when others =>
                     FILE . COL := FILE . COL + 1;
               end case;
               exit when FILE . COL = TO;
            end loop;
         end if;
      else                             -- For file in OUT_MODE
         if FILE . COL > TO then
            NEW_LINE (FILE);
         end if;
         if FILE . COL < TO then
            for I in FILE . COL .. TO - 1 loop
               WRITE (FILE, ' ');
               FILE . COL := FILE . COL + 1;
            end loop;
         end if;
      end if;
   end SET_COL;

   procedure SET_COL (TO : in POSITIVE_COUNT) is

-- See chapter 14.3.4

   begin
      SET_COL (CURR_OUTPUT, TO); -- Default output file, see page 14-15
   end SET_COL;

   procedure SET_LINE (FILE : in FILE_TYPE; TO : in POSITIVE_COUNT) is

-- See chapter 14.3.4

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE = OUT_FILE and FILE . PAGE_LENGTH /= UNBOUNDED
         and TO > FILE . PAGE_LENGTH then
         raise LAYOUT_ERROR;
      end if;
      if FILE . MODE = IN_FILE then
         if FILE . LINE /= TO then
            loop
               SKIP_LINE (FILE);        -- This raises END_ERROR if EOF
               exit when FILE . LINE = TO;
            end loop;
         end if;
      else                              -- FILE . MODE = OUT_FILE
         if FILE . LINE < TO then
            loop
               NEW_LINE (FILE);         -- Spacing 1, see page 14-16
               exit when FILE . LINE = TO;
            end loop;
         elsif FILE . LINE > TO then
            NEW_PAGE (FILE);
            NEW_LINE (FILE, TO - 1);
         end if;
      end if;
   end SET_LINE;

   procedure SET_LINE (TO : in POSITIVE_COUNT) is

-- See chapter 14.3.4

   begin
      SET_LINE (CURR_OUTPUT, TO);
   end SET_LINE;

   function COL (FILE : in FILE_TYPE) return POSITIVE_COUNT is

-- See chapter 14.3.4

   begin
      if FILE = null then
         raise STATUS_ERROR;
      end if;
      return FILE . COL;
   end COL;

   function COL return POSITIVE_COUNT is

-- See chapter 14.3.4

   begin
      return COL (CURR_OUTPUT);  -- Def. current output file, see page 14-15
   end COL;

   function LINE (FILE : in FILE_TYPE) return POSITIVE_COUNT is

-- See chapter 14.3.4

   begin
      if FILE = null then
         raise STATUS_ERROR;
      end if;
      return FILE . LINE;
   end LINE;

   function LINE return POSITIVE_COUNT is

-- See chapter 14.3.4


   begin
      return LINE (CURR_OUTPUT);  -- Def. current output file, see page 14-15
   end LINE;

   function PAGE (FILE : in FILE_TYPE) return POSITIVE_COUNT is

-- See chapter 14.3.4

   begin
      if FILE = null then
         raise STATUS_ERROR;
      end if;
      return FILE . PAGE;
   end PAGE;

   function PAGE return POSITIVE_COUNT is

-- See chapter 14.3.4

   begin
      return PAGE (CURR_OUTPUT);  -- Def. curr. output file, see page 14-15
   end PAGE;

--
-- Character input/output
--

   procedure GET (FILE : in FILE_TYPE; ITEM : out CHARACTER) is

      INCHAR : CHARACTER;

-- See chapter 14.3.6

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= IN_FILE then
         raise MODE_ERROR;
      end if;
      loop
         READ (FILE, INCHAR); -- There is no DATA_ERROR eight bit characters
         case INCHAR is
            when CR =>
               FILE . COL := 1;
            when LF =>
               FILE . LINE := FILE . LINE + 1;
               if (FILE . PAGE_LENGTH /= UNBOUNDED) and
                  (FILE . LINE >= FILE . PAGE_LENGTH) then
                  FILE . PAGE := FILE . PAGE + 1;
                  FILE . LINE := 1;
               end if;
            when FF =>
               FILE . PAGE := FILE . PAGE + 1;
               FILE . COL := 1;
               FILE . LINE := 1;
            when EOF =>
               raise END_ERROR;
            when others =>
               FILE . COL := FILE . COL + 1;
               exit; -- This is a legal character
         end case;
      end loop;
      ITEM := INCHAR;
   end GET;

   procedure GET (ITEM : out CHARACTER) is

-- See chapter 14.3.6

   begin
      GET (CURR_INPUT, ITEM);
   end GET;

   procedure PUT (FILE : in FILE_TYPE; ITEM : in CHARACTER) is

-- See chapter 14.3.6

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE = IN_FILE then
         raise MODE_ERROR;
      end if;
      if FILE . LINE_LENGTH /= UNBOUNDED and
         FILE . COL >= FILE . LINE_LENGTH then
         if FILE . PAGE_LENGTH /= UNBOUNDED and
            FILE . PAGE_LENGTH >= FILE . PAGE then
            NEW_PAGE (FILE);
         else
            NEW_LINE (FILE);
         end if;
      end if;
      WRITE (FILE, ITEM);
      FILE . COL := FILE . COL + 1;
   end PUT;

   procedure PUT (ITEM : in CHARACTER) is

-- See chapter 14.3.6

   begin
      PUT (CURR_OUTPUT, ITEM);
   end PUT;

--
-- String input/output
--

   procedure GET (FILE : in FILE_TYPE; ITEM : out STRING) is

-- See chapter 14.3.6

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= IN_FILE then
         raise MODE_ERROR;
      end if;
      for I in ITEM'RANGE loop
         GET (FILE, ITEM (I));
      end loop;
   end GET;

   procedure GET (ITEM : out STRING) is

-- See chapter 14.3.6

   begin
      GET (CURR_INPUT, ITEM);
   end GET;

   procedure PUT (FILE : in FILE_TYPE; ITEM : in STRING) is

-- See chapter 14.3.6

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= OUT_FILE then
         raise MODE_ERROR;
      end if;
      if FILE . LINE_LENGTH /= UNBOUNDED and
         FILE . COL >= FILE . LINE_LENGTH then
         if FILE . PAGE_LENGTH /= UNBOUNDED and
            FILE . PAGE_LENGTH >= FILE . PAGE then
            NEW_PAGE (FILE);
         else
            NEW_LINE (FILE);
         end if;
      end if;
      WRITE_STRING (FILE, ITEM);
      FILE . COL := FILE . COL + COUNT (ITEM'LENGTH);
   end PUT;

   procedure PUT (ITEM : in STRING) is

-- See chapter 14.3.6

   begin
      PUT (CURR_OUTPUT, ITEM);
   end;

   procedure GET_LINE (FILE : in FILE_TYPE;
      ITEM : out STRING; LAST : out NATURAL) is

      INCHAR : CHARACTER;
      POINTER : NATURAL := ITEM'FIRST - 1;

-- See chapter 14.3.6

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= IN_FILE then
         raise MODE_ERROR;
      end if;
      loop
         READ (FILE, INCHAR);
         case INCHAR is
            when CR | LF =>
               UNGET (FILE);
               SKIP_LINE (FILE);
               if FILE . HANDLE = 0 then -- Input from console
                  if INCHAR = CR then
                     PUT (DOS_OUTPUT, LF);
                  else
                     PUT (DOS_OUTPUT, CR);
                  end if;
               end if;
               exit;
            when FF =>
               UNGET (FILE);
               SKIP_PAGE (FILE);
               exit;
            when EOF =>
               exit;
            when others =>
               FILE . COL := FILE . COL + 1;
               POINTER := POINTER + 1;
               ITEM (POINTER) := INCHAR;
               exit when POINTER = ITEM'LAST;
         end case;
      end loop;
      LAST := POINTER;
   end GET_LINE;

   procedure GET_LINE (ITEM : out STRING; LAST : out NATURAL) is

-- See chapter 14.3.6

   begin
      GET_LINE (CURR_INPUT, ITEM, LAST);
   end GET_LINE;

   procedure PUT_LINE (FILE : in FILE_TYPE; ITEM : in STRING) is

-- See chapter 14.3.6

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= OUT_FILE then
         raise MODE_ERROR;
      end if;
      PUT (FILE, ITEM);
      NEW_LINE (FILE);
   end PUT_LINE;

   procedure PUT_LINE (ITEM : in STRING) is

-- See chapter 14.3.6

   begin
      PUT_LINE (CURR_OUTPUT, ITEM);
   end PUT_LINE;

--
-- Integer I/O
--
-- The following utility procedures are not included in
-- the INTEGER_IO package in order to decrease instantiation overhead.
--

   function VALID_INT (BASE : in NUMBER_BASE;
                       CH : in CHARACTER) return INTEGER is

      N : INTEGER;

   begin
      if CH >= 'a' then
         N := INTEGER (CH) - INTEGER ('a') + 10;
      elsif CH >= 'A' then
         N := INTEGER (CH) - INTEGER ('A') + 10;
      else
         N := INTEGER (CH) - INTEGER ('0');
      end if;
      if N > BASE - 1 then -- illegal digit for base
         return -1;
      else
         return N;
      end if;
   end VALID_INT;

   procedure READ_INT (FILE      : in FILE_TYPE;
                       MAX_WIDTH : in FIELD;
                       INT       : out INTEGER;
                       BASE      : in out NUMBER_BASE;
                       HAS_EXP   : in BOOLEAN := FALSE) is

      COUNTER      : INTEGER := 0;
      BASE_CHANGED : BOOLEAN := FALSE;
      INCHAR       : CHARACTER;
      TEMP         : INTEGER;
      MINUS        : BOOLEAN := FALSE;
      ONUM         : INTEGER;

   begin
      ONUM := 0;
      loop
         READ (FILE, INCHAR);
         COUNTER := COUNTER + 1;
         case INCHAR is
            when '0'..'9' | 'a'..'f' | 'A'..'F' =>
               if not BASE_CHANGED and (INCHAR = 'e' or INCHAR = 'E') then
                  UNGET (FILE);
                  exit;
               else
                  TEMP := VALID_INT (BASE, INCHAR);
                  if TEMP > -1 then
                     ONUM := BASE * ONUM + TEMP;
                     FILE . COL := FILE . COL + 1;
                  else                     -- Illegal character
                     raise DATA_ERROR;
                  end if;
               end if;
            when '#' | ':' =>
               FILE . COL := FILE . COL + 1;
               if not BASE_CHANGED and not HAS_EXP and
                  (ONUM > 1 and ONUM < 17) then -- We have read the base
                  BASE := ONUM;
                  ONUM := 0;
                  BASE_CHANGED := TRUE;
               elsif BASE_CHANGED and not HAS_EXP then
                  exit;
               elsif MAX_WIDTH = 0 or
                  (MAX_WIDTH > 0 and COUNTER = MAX_WIDTH) then
                  exit;
               else
                  raise DATA_ERROR;
               end if;
            when '-' =>
               FILE . COL := FILE . COL + 1;
               if HAS_EXP then
                  MINUS := TRUE;
               else
                  exit;
               end if;
            when '+' =>
               FILE . COL := FILE . COL + 1;
               if not HAS_EXP then
                  exit;
               end if;
            when CR | LF | FF | EOF =>
               UNGET (FILE);
               exit;
            when others =>
               if MAX_WIDTH = 0 then
                  UNGET (FILE);
                  exit;
               else
                  raise DATA_ERROR;
               end if;
         end case;
         exit when COUNTER = MAX_WIDTH and MAX_WIDTH > 0;
      end loop;
      if MINUS then
         ONUM := - ONUM;
      end if;
      INT := ONUM;
   end READ_INT;

   procedure GET (FILE : in FILE_TYPE;
                  ITEM : out INTEGER;
                  WIDTH : in FIELD;
                  INBASE : NUMBER_BASE) is

      COUNTER  : INTEGER := 0;
      INCHAR   : CHARACTER;
      BASE     : NUMBER_BASE := INBASE;
      INT      : INTEGER;
      ONUM     : INTEGER;
      ALREADY_SOMETHING : BOOLEAN := FALSE;

-- See chapter 14.3.7

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= IN_FILE then
         raise MODE_ERROR;
      end if;
      ONUM:= 0;
      loop
         READ (FILE, INCHAR);
         case INCHAR is
            when FF | CR | LF =>
               if WIDTH /= 0 or ALREADY_SOMETHING then
                  UNGET (FILE);
                  exit;
               end if;
            when EOF =>
               UNGET (FILE);
               exit;
            when ' ' =>
               FILE . COL := FILE . COL + 1;
               if WIDTH > 0 then
                  COUNTER := COUNTER + 1;
               end if;
            when '-' =>
               if ALREADY_SOMETHING then
                  raise DATA_ERROR;
               end if;
               FILE . COL := FILE . COL + 1;
               if WIDTH > 0 then
                  COUNTER := COUNTER + 1;
               end if;
               READ_INT (FILE, WIDTH - COUNTER, ONUM, BASE);
               ONUM := - ONUM;
               ALREADY_SOMETHING := TRUE;
            when '+' =>
               if ALREADY_SOMETHING then
                  raise DATA_ERROR;
               end if;
               FILE . COL := FILE . COL + 1;
               if WIDTH > 0 then
                  COUNTER := COUNTER + 1;
               end if;
               READ_INT (FILE, WIDTH - COUNTER, ONUM, BASE);
               ALREADY_SOMETHING := TRUE;
            when '0' .. '9' =>
               UNGET (FILE);
               READ_INT (FILE, WIDTH - COUNTER, ONUM, BASE);
               ALREADY_SOMETHING := TRUE;
            when 'e' | 'E' =>
               if not ALREADY_SOMETHING then
                  raise DATA_ERROR;
               end if;
               FILE . COL := FILE . COL + 1;
               if WIDTH > 0 then
                  COUNTER := COUNTER + 1;
               end if;
               READ_INT (FILE, WIDTH - COUNTER, INT, BASE, TRUE);
               ONUM := ONUM * BASE ** INT;
               exit;
            when others =>
               raise DATA_ERROR;
         end case;
         exit when COUNTER = WIDTH and WIDTH > 0;
      end loop;
      ITEM := ONUM;
   exception
      when NUMERIC_ERROR =>
         raise DATA_ERROR;
   end GET;

   procedure PUT (
      FILE : in FILE_TYPE;
      ITEM : in INTEGER;
      WIDTH : in FIELD;
      BASE : in NUMBER_BASE) is

      IMAGE : STRING (1..19); -- Max possible is "-2#[15 bits]#"
      DIGIT : constant STRING (1..16) := "0123456789ABCDEF";
      POINTER : POSITIVE := IMAGE'LAST;
      REST : INTEGER := abs ITEM;

-- See chapter 14.3.7

   begin
      if BASE /= 10 then -- Make Ada standard based literal syntax
         IMAGE (POINTER) := '#';
         POINTER := POINTER - 1;
      end if;
      if REST = 0 then
         IMAGE (POINTER) := '0';
         POINTER := POINTER - 1;
      end if;
      while REST /= 0 loop -- Code the digits
         IMAGE (POINTER) := DIGIT ((REST mod BASE) + 1);
         POINTER := POINTER - 1;
         REST := REST / BASE;
      end loop;
      if BASE /= 10 then
         IMAGE (POINTER) := '#';
         POINTER := POINTER - 1;
         REST := BASE; -- Code the base itself
         while REST /= 0 loop
            IMAGE (POINTER) := DIGIT ((REST mod 10) + 1);
            POINTER := POINTER - 1;
            REST := REST / 10;
         end loop;
      end if;
      if ITEM < 0 then -- Put minus sign
         IMAGE (POINTER) := '-';
         POINTER := POINTER - 1;
      end if;
      for I in IMAGE'LAST - POINTER + 1 .. WIDTH loop -- Put preceding spaces
         PUT (FILE, ' ');
      end loop;
      PUT (FILE, IMAGE (POINTER + 1 .. IMAGE'LAST)); -- Put the slice
   end PUT;

   procedure GET_INT (FROM  : in STRING;
                      INDEX : in out POSITIVE;
                      INT   : out INTEGER;
                      BASE  : in out NUMBER_BASE;
                      HAS_EXP : in BOOLEAN := FALSE) is

      BASE_CHANGED : BOOLEAN := FALSE;
      INCHAR       : CHARACTER;
      TEMP         : INTEGER;
      MINUS        : BOOLEAN := FALSE;
      ONUM         : INTEGER;

   begin
      ONUM := 0;
      loop
         INCHAR := FROM (INDEX);
         case INCHAR is
            when '0'..'9' | 'a'..'f' | 'A'..'F' =>
               if not BASE_CHANGED and (INCHAR = 'e' or INCHAR = 'E') then
                  exit;
               else
                  TEMP := VALID_INT (BASE, INCHAR);
                  if TEMP > -1 then
                     ONUM := BASE * ONUM + TEMP;
                  else
                     raise DATA_ERROR;
                  end if;
               end if;
            when '#' | ':' =>
               if not BASE_CHANGED and not HAS_EXP and
                  (ONUM > 1 and ONUM < 17) then -- We have read the base
                  BASE := ONUM;
                  ONUM := 0;
                  BASE_CHANGED := TRUE;
               else
                  INDEX := INDEX + 1;
                  exit;
               end if;
            when '-' =>
               if HAS_EXP then
                  MINUS := TRUE;
               else
                  exit;
               end if;
            when '+' =>
               if not HAS_EXP then
                  exit;
               end if;
            when others =>
               exit;
         end case;
         exit when INDEX = FROM'LAST;
         INDEX := INDEX + 1;
      end loop;
      if MINUS then
         ONUM := - ONUM;
      end if;
      INT := ONUM;
   end GET_INT;

   procedure GET (
      FROM : in STRING;
      ITEM : out INTEGER;
      LAST : out POSITIVE;
      INBASE : in NUMBER_BASE) is

      INT : INTEGER;
      BASE : NUMBER_BASE := INBASE;
      L : POSITIVE;
      ONUM : INTEGER;
      ALREADY_SOMETHING : BOOLEAN := FALSE;

-- See chapter 14.3.7

   begin
      L := FROM'FIRST;
      loop
         case FROM (L) is
            when ' ' =>
               L := L + 1;
               if ALREADY_SOMETHING then
                  exit;
               end if;
            when '-' =>
               if ALREADY_SOMETHING then
                  raise DATA_ERROR;
               end if;
               L := L + 1;
               GET_INT (FROM, L, ONUM, BASE);
               ONUM := - ONUM;
               ALREADY_SOMETHING := TRUE;
            when '+' =>
               if ALREADY_SOMETHING then
                  raise DATA_ERROR;
               end if;
               L := L + 1;
               GET_INT (FROM, L, ONUM, BASE);
               ALREADY_SOMETHING := TRUE;
            when '0' .. '9' =>
               GET_INT (FROM, L, ONUM, BASE);
               ALREADY_SOMETHING := TRUE;
            when 'e' | 'E' =>
               if not ALREADY_SOMETHING then
                  raise DATA_ERROR;
               end if;
               L := L + 1;
               GET_INT (FROM, L, INT, BASE, TRUE);
               ONUM := ONUM * BASE ** INT;
               exit;
            when others =>
               raise DATA_ERROR;
         end case;
         exit when L = FROM'LAST;
      end loop;
      LAST := L;
      ITEM := ONUM;
   exception
      when NUMERIC_ERROR =>
         raise DATA_ERROR;
   end GET;

   procedure PUT (
      TO : out STRING;
      ITEM : in INTEGER;
      BASE : in NUMBER_BASE) is

      DIGIT : constant STRING (1..16) := "0123456789ABCDEF";
      POINTER : POSITIVE := TO'LAST;
      REST : INTEGER := abs ITEM;

-- See chapter 14.3.7

   begin
      if BASE /= 10 then -- Make Ada standard based literal syntax
         TO (POINTER) := '#';
         POINTER := POINTER - 1;
      end if;
      if REST = 0 then
         TO (POINTER) := '0';
         POINTER := POINTER - 1;
      end if;
      while REST /= 0 loop -- Code the digits
         TO (POINTER) := DIGIT ((REST mod BASE) + 1);
         POINTER := POINTER - 1;
         REST := REST / BASE;
      end loop;
      if BASE /= 10 then
         TO (POINTER) := '#';
         POINTER := POINTER - 1;
         REST := BASE; -- Code the base itself
         while REST /= 0 loop
            TO (POINTER) := DIGIT ((REST mod 10) + 1);
            POINTER := POINTER - 1;
            REST := REST / 10;
         end loop;
      end if;
      if ITEM < 0 then -- Put minus sign
         TO (POINTER) := '-';
         POINTER := POINTER - 1;
      end if;
      TO (TO'FIRST .. POINTER) := (others => ' ');
   end PUT;

   package body INTEGER_IO is

      procedure GET (FILE : in FILE_TYPE;
                     ITEM : out NUM;
                     WIDTH : in FIELD := DEFAULT_WIDTH) is

         ONUM : INTEGER;

      begin
         GET (FILE, ONUM, WIDTH, DEFAULT_BASE);
         ITEM := NUM (ONUM);
      end GET;

      procedure GET (ITEM : out NUM; WIDTH : in FIELD := 0) is

         ONUM : INTEGER;

      begin
         GET (CURR_INPUT, ONUM, WIDTH, DEFAULT_BASE);
         ITEM := NUM (ONUM);
      end GET;

      procedure PUT (
         FILE : in FILE_TYPE;
         ITEM : in NUM;
         WIDTH : in FIELD := DEFAULT_WIDTH;
         BASE : in NUMBER_BASE := DEFAULT_BASE) is
      begin
         PUT (FILE, INTEGER (ITEM), WIDTH, BASE);
      end PUT;

      procedure PUT (
         ITEM : in NUM;
         WIDTH : in FIELD := DEFAULT_WIDTH;
         BASE : in NUMBER_BASE := DEFAULT_BASE) is

      begin
         PUT (CURR_OUTPUT, INTEGER (ITEM), WIDTH, BASE);
      end PUT;

      procedure GET (
         FROM : in STRING;
         ITEM : out NUM;
         LAST : out POSITIVE) is

         ONUM : INTEGER;

      begin
         GET (FROM, ONUM, LAST, DEFAULT_BASE);
         ITEM := NUM (ONUM);
      end GET;

      procedure PUT (
         TO : out STRING;
         ITEM : in NUM;
         BASE : in NUMBER_BASE := DEFAULT_BASE) is

      begin
         PUT (TO, INTEGER (ITEM), BASE);
      end PUT;

   end INTEGER_IO;

--
-- Floating point I/O
--
-- The following utility procedures are not included in the body
-- of FLOAT_IO to decrease instantiation overhead.

   type SUCCESS_TYPE is
      (NOTHING, BEFORE_PERIOD, AFTER_PERIOD, EXPONENT);

   procedure READ_INT (FILE      : in FILE_TYPE;
                       MAX_WIDTH : in FIELD;
                       BASE      : in out NUMBER_BASE;
                       NUMBER    : in out FLOAT;
                       WHERE     : in SUCCESS_TYPE;
                       COUNTER   : out INTEGER;
                       STR       : in STRING;
                       STR_INDEX : in out INTEGER;
                       USE_STRING: in BOOLEAN) is

      BASE_CHANGED : BOOLEAN := FALSE;
      INCHAR       : CHARACTER;
      INT          : INTEGER := 0;
      TEMP         : INTEGER;
      MINUS        : BOOLEAN := FALSE;
      CTR          : INTEGER;

   begin
      CTR := 0;
      STR_INDEX := STR_INDEX - 1;
      loop
         STR_INDEX := STR_INDEX + 1;
         if USE_STRING then
            INCHAR := STR (STR_INDEX);
         else
            READ (FILE, INCHAR);
         end if;
         CTR := CTR + 1;
         case INCHAR is
            when '0'..'9' | 'a'..'f' | 'A'..'F' =>
               if not BASE_CHANGED and (INCHAR = 'e' or INCHAR = 'E') then
                  if USE_STRING then
                     STR_INDEX := STR_INDEX - 1;
                  else
                     UNGET (FILE);
                  end if;
                  exit;
               else
                  TEMP := VALID_INT (BASE, INCHAR);
                  if TEMP > -1 then
                     case WHERE is
                        when BEFORE_PERIOD =>
                           NUMBER := BASE * NUMBER + FLOAT (TEMP);
                        when AFTER_PERIOD =>
                           NUMBER := NUMBER + TEMP * FLOAT (BASE)
                              **(- CTR);
                        when EXPONENT =>
                           INT := INT * 10 + TEMP; -- Get the exponent
                        when NOTHING => -- This should not happen
                           raise DATA_ERROR;
                     end case;
                     if not USE_STRING then
                        FILE . COL := FILE . COL + 1;
                     end if;
                  else                     -- Illegal character
                     raise DATA_ERROR;
                  end if;
               end if;
            when '#' | ':' =>
               if not USE_STRING then
                  FILE . COL := FILE . COL + 1;
               end if;
               if not BASE_CHANGED and WHERE = BEFORE_PERIOD and
                  (INT > 1 and INT < 17) then -- We have read the base
                  BASE := INT;
                  INT := 0;
                  BASE_CHANGED := TRUE;
               elsif WHERE = AFTER_PERIOD then
                  exit;
               else
                  raise DATA_ERROR;
               end if;
            when '-' =>
               if WHERE = EXPONENT then
                  MINUS := TRUE;
                  if not USE_STRING then
                     FILE . COL := FILE . COL + 1;
                  end if;
               else
                  raise DATA_ERROR;
               end if;
            when '+' =>
               if WHERE /= EXPONENT then
                  raise DATA_ERROR;
               end if;
               if not USE_STRING then
                  FILE . COL := FILE . COL + 1;
               end if;
            when '.' =>
               if WHERE = BEFORE_PERIOD or MAX_WIDTH = 0 then
                  if USE_STRING then
                     STR_INDEX := STR_INDEX - 1;
                  else
                     UNGET (FILE);
                  end if;
                  exit;
               else
                  raise DATA_ERROR;
               end if;
            when CR | LF | FF | EOF => -- Termination of input
               if WHERE = BEFORE_PERIOD then
                  raise DATA_ERROR;
               else
                  if USE_STRING then
                     STR_INDEX := STR_INDEX - 1;
                  else
                     UNGET (FILE);
                  end if;
                  exit;
               end if;
            when others =>
               if MAX_WIDTH = 0 then -- Termination of input
                  if USE_STRING then
                     STR_INDEX := STR_INDEX - 1;
                  else
                     UNGET (FILE);
                  end if;
                  exit;
               else
                  raise DATA_ERROR;
               end if;
         end case;
         exit when (CTR = MAX_WIDTH and MAX_WIDTH > 0) or
            (USE_STRING and STR_INDEX = STR'LAST);
      end loop;
      if WHERE = EXPONENT then
         if MINUS then
            INT := - INT;
         end if;
         NUMBER := NUMBER * FLOAT (BASE) ** INT;
      end if;
      COUNTER := CTR;
   end READ_INT;

   function EXPO (F : in FLOAT) return INTEGER is

   -- Returns the binary exponent of an IEEE floating-point
   -- number.  The bias (1023) is subtracted.

      E : INTEGER;

   begin
      pragma NATIVE (
         16#8B#, 16#44#, 16#06#, 16#25#, 16#F0#, 16#7F#, 16#D1#, 16#E8#,
         16#D1#, 16#E8#, 16#D1#, 16#E8#, 16#D1#, 16#E8#, 16#2D#, 16#FF#,
         16#03#, 16#89#, 16#05#);
      return E;
   end EXPO;

   procedure GET_STR_FILE (FILE       : in FILE_TYPE;
                           ITEM       : out FLOAT;
                           WIDTH      : in FIELD := 0;
                           STR        : in STRING;
                           STR_INDEX  : in out INTEGER;
                           USE_STRING : in BOOLEAN) is

      SUCCESS : SUCCESS_TYPE := NOTHING;
      INDEX   : INTEGER;
      COUNTER : INTEGER := 0;
      INCHAR  : CHARACTER;
      BASE    : NUMBER_BASE := 10;
      ONUM    : FLOAT;
      MINUS   : BOOLEAN := FALSE;

-- See chapter 14.3.8

   begin
      if FILE = null then
         raise STATUS_ERROR;
      elsif FILE . MODE /= IN_FILE then
         raise MODE_ERROR;
      end if;
      STR_INDEX := STR'FIRST - 1;
      ONUM := 0.0;
      loop
         STR_INDEX := STR_INDEX + 1;
         if USE_STRING then
            INCHAR := STR (STR_INDEX);
         else
            READ (FILE, INCHAR);
         end if;
         case INCHAR is
            when FF | CR | LF =>
               if WIDTH /= 0 or SUCCESS = AFTER_PERIOD or
                  SUCCESS = EXPONENT then
                  if USE_STRING then
                     STR_INDEX := STR_INDEX - 1;
                  else
                     UNGET (FILE);
                  end if;
                  exit;
               end if;
            when EOF =>
               if USE_STRING then
                  STR_INDEX := STR_INDEX - 1;
               else
                  UNGET (FILE);
               end if;
               exit;
            when ' ' =>
               if SUCCESS = NOTHING then
                  if not USE_STRING then
                     FILE . COL := FILE . COL + 1;
                  end if;
                  if WIDTH > 0 then
                     COUNTER := COUNTER + 1;
                  end if;
               elsif SUCCESS = AFTER_PERIOD then
                  if USE_STRING then
                     STR_INDEX := STR_INDEX - 1;
                  else
                     UNGET (FILE);
                  end if;
                  exit;
               else
                  raise DATA_ERROR;
               end if;
            when '-' =>
               if SUCCESS = NOTHING then
                  SUCCESS := BEFORE_PERIOD;
               else
                  raise DATA_ERROR;
               end if;
               if USE_STRING then
                  STR_INDEX := STR_INDEX + 1;
               else
                  FILE . COL := FILE . COL + 1;
               end if;
               if WIDTH > 0 then
                  COUNTER := COUNTER + 1;
               end if;
               READ_INT (FILE, WIDTH - COUNTER, BASE, ONUM,
                  SUCCESS, INDEX, STR, STR_INDEX, USE_STRING);
               if WIDTH > 0 then
                  COUNTER := COUNTER + INDEX;
               end if;
               MINUS := TRUE;
            when '+' =>
               if SUCCESS = NOTHING then
                  SUCCESS := BEFORE_PERIOD;
               else
                  raise DATA_ERROR;
               end if;
               if USE_STRING then
                  STR_INDEX := STR_INDEX + 1;
               else
                  FILE . COL := FILE . COL + 1;
               end if;
               if WIDTH > 0 then
                  COUNTER := COUNTER + 1;
               end if;
               READ_INT (FILE, WIDTH - COUNTER, BASE, ONUM,
                  SUCCESS, INDEX, STR, STR_INDEX, USE_STRING);
               if WIDTH > 0 then
                  COUNTER := COUNTER + INDEX;
               end if;
            when '0' .. '9' =>
               if SUCCESS = NOTHING then
                  SUCCESS := BEFORE_PERIOD;
               end if;
               if not USE_STRING then
                  UNGET (FILE);
               end if;
               READ_INT (FILE, WIDTH - COUNTER, BASE, ONUM,
                  SUCCESS, INDEX, STR, STR_INDEX, USE_STRING);
               if WIDTH > 0 then
                  COUNTER := COUNTER + INDEX;
               end if;
            when '.' =>
               if USE_STRING then
                  STR_INDEX := STR_INDEX + 1;
               else
                  FILE . COL := FILE . COL + 1;
               end if;
               if WIDTH > 0 then
                  COUNTER := COUNTER + 1;
               end if;
               if SUCCESS = BEFORE_PERIOD then
                  SUCCESS := AFTER_PERIOD;
                  READ_INT (FILE, WIDTH - COUNTER, BASE, ONUM,
                     SUCCESS, INDEX, STR, STR_INDEX, USE_STRING);
                  if WIDTH > 0 then
                     COUNTER := COUNTER + INDEX;
                  end if;
               else
                  raise DATA_ERROR;
               end if;
            when 'e' | 'E' =>
               if USE_STRING then
                  STR_INDEX := STR_INDEX + 1;
               else
                  FILE . COL := FILE . COL + 1;
               end if;
               if WIDTH > 0 then
                  COUNTER := COUNTER + 1;
               end if;
               if SUCCESS = AFTER_PERIOD then
                  SUCCESS := EXPONENT;
                  READ_INT (FILE, WIDTH - COUNTER, BASE, ONUM,
                     SUCCESS, INDEX, STR, STR_INDEX, USE_STRING);
                  if WIDTH > 0 then
                     COUNTER := COUNTER + INDEX;
                  end if;
               else
                  raise DATA_ERROR;
               end if;
            when others =>
               raise DATA_ERROR;
         end case;
         exit when (COUNTER >= WIDTH and WIDTH > 0) or (SUCCESS = EXPONENT) or
            (USE_STRING and STR_INDEX = STR'LAST);
      end loop;
      if MINUS then
         ONUM := - ONUM;
      end if;
      ITEM := ONUM;
   exception
      when NUMERIC_ERROR =>
         raise DATA_ERROR;
   end GET_STR_FILE;

   INDEX : INTEGER;             -- Index for FLOAT_STR
   FLOAT_STR : STRING (1..30);  -- Temporary string for PUT FLOAT to
                                -- a file or a string

   procedure PUT_STR
      (ITEM : in FLOAT;
      FORE, AFT, EXP : in FIELD) is

      X : FLOAT := ITEM;
      T : FLOAT;
      E, TEMP_INDEX : INTEGER;
      D : INTEGER range 0..9;
      MINUS_NUM : BOOLEAN;
      AFTER : FIELD := AFT;

-- See chapter 14.3.8

      function TEN (EX : in INTEGER) return FLOAT is

      begin
         return 10.0 ** EX;
      end TEN;

      function CUT_SPACE (S : in STRING) return STRING is

      begin
         return S (2..S'LAST);
      end CUT_SPACE;

      function LENGTH (S : in STRING) return INTEGER is

      begin
         return S'LENGTH;
      end;

   begin -- PUT for FLOAT
      FLOAT_STR (FLOAT_STR'FIRST .. FLOAT_STR'LAST) := (others => ' ');
      INDEX := 1;
      if AFTER = 0 then
         AFTER := 1;
      end if;
      MINUS_NUM := X < 0.0;
      X := abs X;
      if X = 0.0 then -- Avoid peculiar exponent if zero
         E := 0;
      else
         E := EXPO (FLOAT (X)); -- Process exponent
      end if;
      if X /= 0.0 then
         E := ((E + 1) * 77) / 256; -- Convert to base 10 exponent
      end if;
      if TEN (E) > X then
         E := E - 1; -- Correct integer arithmetic error
      end if;
      if EXP > 0 then
         X := X / TEN (E);
      end if;
      if X /= 0.0 then
         X := X + 0.5 * TEN (- AFTER); -- Rounding
      end if;
      if EXP > 0 and X >= 10.0 then
         X := X / 10.0;
         E := E + 1;
      elsif EXP = 0 and X >= TEN (E + 1) then
         E := E + 1;
      end if;
      -- Handle FORE
      if X = 0.0 then               -- X = 0: Special case
         for I in 2 .. FORE loop
            FLOAT_STR (INDEX) := ' ';
            INDEX := INDEX + 1;
         end loop;
         FLOAT_STR (INDEX) := '0';
         INDEX := INDEX + 1;
      elsif EXP > 0 then            -- EXP > 0: Only one digit in FORE
         if MINUS_NUM then
            for I in 3 .. FORE loop
               FLOAT_STR (INDEX) := ' ';
               INDEX := INDEX + 1;
            end loop;
            FLOAT_STR (INDEX) := '-';
            INDEX := INDEX + 1;
         else
            for I in 2 .. FORE loop
               FLOAT_STR (INDEX) := ' ';
               INDEX := INDEX + 1;
            end loop;
         end if;
         D := INTEGER (X - 0.5); -- Convert to TRUNC
         if X - FLOAT (D) >= 1.0 then -- Rounded too much
            D := D + 1; -- Add one to digit
         end if;
         FLOAT_STR (INDEX) := CHARACTER (D + 48);
         INDEX := INDEX + 1;
         X := (X - FLOAT (D)) * 10.0;
      else                         -- EXP = 0: Put all digits in FORE
         if E < 0 then
            if MINUS_NUM then
               for I in 3 .. FORE loop
                  FLOAT_STR (INDEX) := ' ';
                  INDEX := INDEX + 1;
               end loop;
               FLOAT_STR (INDEX) := '-';
               INDEX := INDEX + 1;
               FLOAT_STR (INDEX) := '0';
               INDEX := INDEX + 1;
            else
               for I in 2 .. FORE loop
                  FLOAT_STR (INDEX) := ' ';
                  INDEX := INDEX + 1;
               end loop;
               FLOAT_STR (INDEX) := '0';
               INDEX := INDEX + 1;
            end if;
         elsif MINUS_NUM then -- E > 0
            for I in E + 3 .. FORE loop
               FLOAT_STR (INDEX) := ' ';
               INDEX := INDEX + 1;
            end loop;
            FLOAT_STR (INDEX) := '-';
            INDEX := INDEX + 1;
         else -- E > 0
            for I in E + 2 .. FORE loop
               FLOAT_STR (INDEX) := ' ';
               INDEX := INDEX + 1;
            end loop;
         end if;
         for I in reverse 0 .. E loop -- Take all the digits
            T := TEN (I);
            D := INTEGER (X / T - 0.5); -- Convert to TRUNC
            X := X - D * T;
            if X >= T then -- Rounded too much
               D := D + 1;
               X := X - T;
            end if;
            FLOAT_STR (INDEX) := CHARACTER (D + 48);
            INDEX := INDEX + 1;
         end loop;
         X := X * 10.0; -- Prepare for AFT
      end if;
      -- Handle AFT
      FLOAT_STR (INDEX) := '.';
      INDEX := INDEX + 1;
      for I in 1..AFTER loop -- Put the mantissa
         D := INTEGER (X - 0.5); -- Convert to TRUNC
         if X - FLOAT (D) >= 1.0 then -- Rounded too much
            D := D + 1; -- Add one to digit
         end if;
         FLOAT_STR (INDEX) := CHARACTER (D + 48);
         INDEX := INDEX + 1;
         X := (X - FLOAT (D)) * 10.0;
      end loop;
   -- Handle EXP
      if EXP > 0 then
         FLOAT_STR (INDEX) := 'E';
         INDEX := INDEX + 1;
         if E >= 0 then
            FLOAT_STR (INDEX) := '+';
            INDEX := INDEX + 1;
         else
            FLOAT_STR (INDEX) := '-';
            INDEX := INDEX + 1;
         end if;
         if E > 99 then
            for I in 5 .. EXP loop
               FLOAT_STR (INDEX) := '0';
               INDEX := INDEX + 1;
            end loop;
         elsif E > 9 then
            for I in 4 .. EXP loop
               FLOAT_STR (INDEX) := '0';
               INDEX := INDEX + 1;
            end loop;
         else
            for I in 3 .. EXP loop
               FLOAT_STR (INDEX) := '0';
               INDEX := INDEX + 1;
            end loop;
         end if;
         TEMP_INDEX := INDEX + LENGTH (INTEGER'IMAGE (abs E)) - 2;
         FLOAT_STR (INDEX..TEMP_INDEX) := CUT_SPACE (INTEGER'IMAGE (abs E));
         INDEX := TEMP_INDEX + 1;
      end if;
      INDEX := INDEX - 1;
   end PUT_STR;

   package body FLOAT_IO is

      procedure GET (FILE : in FILE_TYPE;
                     ITEM : out NUM;
                     WIDTH : in FIELD := 0) is

         ONUM : FLOAT;
         DUMMY: INTEGER;

      begin
         GET_STR_FILE (FILE, ONUM, WIDTH, "", DUMMY, FALSE);
         ITEM := NUM (ONUM);
      end GET;

      procedure GET (ITEM : out NUM; WIDTH : in FIELD := 0) is

-- See chapter 14.3.8

         ONUM  : FLOAT;
         DUMMY : INTEGER;

      begin
         GET_STR_FILE (CURR_INPUT, ONUM, WIDTH, "", DUMMY, FALSE);
         ITEM := NUM (ONUM);
      end GET;

      procedure PUT
         (FILE : in FILE_TYPE;
         ITEM : in NUM;
         FORE : in FIELD := DEFAULT_FORE;
         AFT : in FIELD := DEFAULT_AFT;
         EXP : in FIELD := DEFAULT_EXP) is

      begin
         PUT_STR (FLOAT (ITEM), FORE, AFT, EXP);
         PUT (FILE, FLOAT_STR (FLOAT_STR'FIRST..INDEX));
      end PUT;

      procedure PUT (ITEM : in NUM;
                     FORE : in FIELD := DEFAULT_FORE;
                     AFT : in FIELD := DEFAULT_AFT;
                     EXP : in FIELD := DEFAULT_EXP) is

-- See chapter 14.3.8

      begin
         PUT_STR (FLOAT (ITEM), FORE, AFT, EXP);
         PUT (CURR_OUTPUT, FLOAT_STR (FLOAT_STR'FIRST..INDEX));
      end PUT;

      procedure GET (FROM : in STRING;
                    ITEM  : out NUM;
                    LAST  : out POSITIVE) is

-- See chapter 14.3.8

         ONUM : FLOAT;
         LEN  : INTEGER;

      begin
         GET_STR_FILE (CURR_INPUT, ONUM, 0, FROM, LEN, TRUE);
         ITEM := NUM (ONUM);
         LAST := POSITIVE (LEN);
      end GET;

      procedure PUT (TO   : out STRING;
                     ITEM : in NUM;
                     AFT  : in FIELD := DEFAULT_AFT;
                     EXP  : in FIELD := DEFAULT_EXP) is

-- See chapter 14.3.8

         LEN : INTEGER;

      begin
         LEN := FLOAT_STR'LENGTH - AFT - EXP - 3; -- 3 is for . E sign of E
         if EXP = 0 then
            LEN := LEN + 2;
         end if;
         PUT_STR (FLOAT (ITEM), LEN, AFT, EXP);
         if TO'LENGTH = FLOAT_STR'LENGTH then
            TO := FLOAT_STR;
         elsif TO'LENGTH < FLOAT_STR'LENGTH then
            TO := FLOAT_STR (FLOAT_STR'LAST - TO'LENGTH + 1..FLOAT_STR'LAST);
         else
            TO (TO'FIRST .. TO'LAST - FLOAT_STR'LENGTH) := (others => ' ');
            TO (TO'LAST - FLOAT_STR'LENGTH + 1 .. TO'LAST) := FLOAT_STR;
         end if;
      end PUT;

   end FLOAT_IO;

--
-- Input / Output for Enumeration Types
--

-- The following utility subprograms are not included
-- in the body of ENUMERATION_IO to decrease instantiation overhead

   function LEGAL_ID_CHAR
      (CH : in CHARACTER; FIRST : in BOOLEAN) return BOOLEAN is

   begin
      if FIRST and CH in '0'..'9' then -- Id cannot begin with digit
         return FALSE;
      end if;
      case CH is
         when 'a'..'z' | 'A'..'Z' | '0'..'9' | '_' =>
            return TRUE;
         when others =>
            return FALSE;
      end case;
   end LEGAL_ID_CHAR;

   procedure ASSIGN_STR
      (S1 : out STRING; S2 : in STRING; L : out INTEGER) is

   begin
      L := S2'LENGTH;
      S1 (S2'RANGE) := S2;
   end ASSIGN_STR;

   package body ENUMERATION_IO is

      MAX_IDENT_LENGTH : constant := 132;

      procedure GET (FILE : in FILE_TYPE; ITEM : out ENUM) is

-- See chapter 14.3.9

         CH : CHARACTER;
         STR : STRING (1..MAX_IDENT_LENGTH);
         I : INTEGER := 0;

      begin
         GET (FILE, CH); -- Skipped leading garbage
         if CH = ''' then   -- Special case: Character literal, f.ex 'A'
            STR (1) := CH;  -- if TEXT_IO . ENUMERATION (CHARACTER)
            READ (FILE, STR (2));  -- has been instantiated
            READ (FILE, STR (3));
            FILE . COL := FILE . COL + 2;
            I := 3;
         else -- Input an identifier
            while LEGAL_ID_CHAR (CH, I = 0) loop
               I := I + 1;
               STR (I) := CH;
               READ (FILE, CH);
               FILE . COL := FILE . COL + 2;
            end loop; -- The identifier is now in STR (1..I)
            UNGET (FILE);
         end if;
         ITEM := ENUM'VALUE (STR (1..I));
      exception
         when CONSTRAINT_ERROR => -- Raised by ENUM'VALUE
            raise DATA_ERROR;     -- This was an illegal enum identifier
      end;

      procedure GET (ITEM : out ENUM) is

-- See chapter 14.3.9

      begin
         GET (CURR_INPUT, ITEM);
      end GET;

      procedure PUT (FILE  : in FILE_TYPE;
                     ITEM  : in ENUM;
                     WIDTH : in FIELD := DEFAULT_WIDTH;
                     SET   : in TYPE_SET := DEFAULT_SETTING) is

-- See chapter 14.3.9

         STR : STRING (1..MAX_IDENT_LENGTH);
         LENGTH : INTEGER;

      begin
         ASSIGN_STR (STR, ENUM'IMAGE (ITEM), LENGTH);
         if (SET = LOWER_CASE) AND (STR (1) /= ''') then
            for J in 1..LENGTH loop
               if STR (J) in 'A'..'Z' then -- Convert to lower case
                  STR (J) := CHARACTER (INTEGER (STR (J)) + 32);
               end if;
            end loop;
         end if;
         PUT (FILE, STR (1..LENGTH));
         for I in LENGTH + 1..WIDTH loop
            PUT (FILE, ' ');
         end loop;
      end PUT;

      procedure PUT (ITEM  : in ENUM;
                     WIDTH : in FIELD := DEFAULT_WIDTH;
                     SET   : in TYPE_SET := DEFAULT_SETTING) is

-- See chapter 14.3.9

      begin
         PUT (CURR_OUTPUT, ITEM, WIDTH, SET);
      end PUT;

      procedure GET (FROM : in STRING;
                     ITEM : out ENUM;
                     LAST : out POSITIVE) is

-- See chapter 14.3.9

         CH : CHARACTER;
         I : INTEGER := FROM'FIRST;
         FI : INTEGER;
         L : POSITIVE;

      begin
         loop
            CH := FROM (I);
            exit when (CH /= LF) or (CH /= CR) or (CH /= FF) or
               (CH /= ' ') or (I = FROM'LAST);
            I := I + 1;
         end loop; -- Skipped leading blanks and line and page terminators
         FI := I;
         if CH = ''' then   -- Special case: Character literal, for example 'A'
            L := FI + 3;
            ITEM := ENUM'VALUE (FROM (FI..L));
         else -- Input an identifier
            while LEGAL_ID_CHAR (FROM (I), I = FI) AND (I < FROM'LAST) loop
               I := I + 1;
            end loop;
            if I = FROM'LAST then
               L := I;
            else
               L := I - 1;
            end if;
            ITEM := ENUM'VALUE (FROM (FI..L));
         end if;
         LAST := L;
      exception
         when CONSTRAINT_ERROR => -- Raised by ENUM'VALUE
            raise DATA_ERROR;     -- This was an illegal enum identifier
      end GET;

      procedure PUT (
         TO   : out STRING;
         ITEM : in ENUM;
         SET  : in TYPE_SET := DEFAULT_SETTING) is

-- See chapter 14.3.9

         LENGTH : INTEGER;
         STR : STRING (1..MAX_IDENT_LENGTH);

      begin
         ASSIGN_STR (STR, ENUM'IMAGE (ITEM), LENGTH);
         if LENGTH > TO'LENGTH then
            raise LAYOUT_ERROR;
         end if;
         if (SET = LOWER_CASE) AND (STR (1) /= ''') then
            for J in 1..LENGTH loop
               if STR (J) in 'A'..'Z' then -- Convert to lower case
                  STR (J) := CHARACTER (INTEGER (STR (J)) + 32);
               end if;
            end loop;
         end if;
         TO (TO'FIRST..TO'FIRST + LENGTH - 1) := STR (1..LENGTH);
         for I in TO'FIRST + LENGTH..TO'LAST loop
            TO (I) := ' ';
         end loop;
      end PUT;

   end ENUMERATION_IO;

begin
   -- Pre-opened files
   DOS_INPUT := new FILE_DESCR'(
       NAMELEN => 3, NAME => DOS_IO_NAME,
       FORMLEN => 0, FORM => (others => ' '),
       MODE => IN_FILE,
       COL => 1,
       LINE => 1, LINE_LENGTH => UNBOUNDED,
       PAGE => 1, PAGE_LENGTH => UNBOUNDED,
       HANDLE => IN_CONSOLE_HANDLE);
   DOS_OUTPUT := new FILE_DESCR'(
       NAMELEN => 3, NAME => DOS_IO_NAME,
       FORMLEN => 0, FORM => (others => ' '),
       MODE => OUT_FILE,
       COL => 1,
       LINE => 1, LINE_LENGTH => UNBOUNDED,
       PAGE => 1, PAGE_LENGTH => UNBOUNDED,
       HANDLE => OUT_CONSOLE_HANDLE);
   CURR_INPUT := DOS_INPUT;
   CURR_OUTPUT := DOS_OUTPUT;
end TEXT_IO;