$Debug off$
$UCSD ON$
$SYSPROG$
$SEARCH '*IO.', '*INTERFACE.'$

MODULE ascii_defs;      { Defines ASCII character set as decimal numbers }

export
   const
     { ASCII character set in decimal }
   
     SOH        = 1;                  { ascii SOH character }
     CTRLC      = 3;
     BACKSPACE  = 8;
     TAB        = 9;
     NEWLINE    = 10;
     LF         = 10;
     FORMFEED   = 12;
     CR         = 13;                 { CR }
     RETURN     = 13;
     
     CTRLY      = 25;
     CONTROLBAR = 28;
     
     BLANK     = 32;
     EXCLAM    = 33;                  { ! }
     DQUOTE    = 34;                  { " }
     SHARP     = 35;                  { # }
     DOLLAR    = 36;                  { $ }
     PERCENT   = 37;                  { % }
     AMPER     = 38;                  { & }
     SQUOTE    = 39;                  { ' }
     ACUTE     = SQUOTE;
     LPAREN    = 40;                  { ( }
     RPAREN    = 41;                  { ) }
     STAR      = 42;                  { * }
     PLUS      = 43;                  { + }
     COMMA     = 44;                  { , }
     MINUS     = 45;                  { - }
     DASH      = MINUS;
     PERIOD    = 46;                  { . }
     SLASH     = 47;                  { / }
     COLON     = 58;                  { : }
     SEMICOL   = 59;                  { ; }
     LESS      = 60;                  { < }
     EQUALS    = 61;                  { = }
     GREATER   = 62;                  { > }
     QUESTION  = 63;                  { ? }
     ATSIGN    = 64;                  { @ }
     LBRACK    = 91;                  { [ }
     BACKSLASH = 92;                  { \ }
     RBRACK    = 93;                  { ] }
     CARET     = 94;                  { ^ }
     UNDERLINE = 95;                  { _ }
     GRAVE = 96;                      { ` }
     LETA = 97;                       { lower case ... }
     LETB = 98;
     LETC = 99;
     LETD = 100;
     LETE = 101;
     LETF = 102;
     LETG = 103;
     LETH = 104;
     LETI = 105;
     LETJ = 106;
     LETK = 107;
     LETL = 108;
     LETM = 109;
     LETN = 110;
     LETO = 111;
     LETP = 112;
     LETQ = 113;
     LETR = 114;
     LETS = 115;
     LETT = 116;
     LETU = 117;
     LETV = 118;
     LETW = 119;
     LETX = 120;
     LETY = 121;
     LETZ = 122;
     LBRACE = 123;                    { left brace }       
     BAR = 124;                       { | }
     RBRACE = 125;                    { right brace }
     TILDE = 126;                     { ~ }
   
     DEL = 127;                       { rubout }      

implement

end;  { Module ascii_defs }


$PAGE$
{

Module BYTE_STR defines data structures for storing 8-bit
"characters", and provides routines for manipulating them.

}
MODULE byte_str;
import  ascii_defs;

export

const
  ENDSTR = 0;     { null-terminated ByteStrings }
  MAXSTR = 100;   { longest possible ByteString }
  CONLENGTH = 20; { length of constant string }

type
  byte = -1..255;                        { byte-sized ascii + other stuff }
  ByteString = ARRAY [1..MAXSTR] OF byte;
  cstring = PACKED ARRAY [1..CONLENGTH] OF char;
   
FUNCTION  length (VAR s : ByteString) : integer;
FUNCTION  index (VAR s : ByteString; c : byte) : integer;
PROCEDURE scopy (VAR src : ByteString; i : integer;
                   VAR dest : ByteString; j : integer);
PROCEDURE CtoB ( cs : cstring; VAR bs : ByteString );
PROCEDURE StoB ( VAR s : string;  VAR bs : ByteString );
PROCEDURE BtoS ( bs : ByteString; var s : string );
FUNCTION  ItoC (n : integer; VAR s : ByteString; i : integer)
                : integer;      { returns index of end of s }
FUNCTION  IsUpper (c : byte) : boolean;
FUNCTION  IsControl (c : byte) : boolean;
FUNCTION  IsPrintable (c : byte) : boolean;


implement
$PAGE$
  { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }

FUNCTION length (VAR s : ByteString) : integer;
{

Computes length of string, not counting the end delimiter (ENDSTR).

}

  VAR
    n : integer;
   BEGIN
     n := 1;
     WHILE (s[n] <> ENDSTR) DO
     n := n + 1;
     length := n - 1
   END;

$PAGE$
  { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }

FUNCTION index (VAR s : ByteString; c : byte) : integer;
{

Find position of character c in ByteString s

}
  VAR
    i : integer;
   BEGIN
     i := 1;
     WHILE (s[i] <> c) AND (s[i] <> ENDSTR) DO
       i := i + 1;
       IF (s[i] = ENDSTR)
        THEN index := 0
        ELSE index := i
   END;

$PAGE$
  { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }

PROCEDURE scopy (VAR src : ByteString; i : integer;
                   VAR dest : ByteString; j : integer);
{

Copy ByteString at src[i] to dest[j].

}
   BEGIN
     WHILE (src[i] <> ENDSTR) DO
      BEGIN
        dest[j] := src[i];
        i := i + 1;
        j := j + 1
      END;
     dest[j] := ENDSTR
   END;

$PAGE$
PROCEDURE CtoB ( cs : cstring; VAR bs : ByteString );
{
        where cs = packed array of char (PAC) to be converted
              bs = packed array of byte (ByteString) to receive the
                   converted string

Convert PAC constant to ByteString.

Called by       PutCon
                ParmInit
                SendNAK
                GetFile
                ReceiveData
                Main prog
}

  VAR
    i : integer;
   BEGIN
     FOR i:=1 TO CONLENGTH DO
     bs[i] := ord(cs[i]);
     bs[CONLENGTH+1] := ENDSTR;
   END;

$PAGE$
PROCEDURE StoB ( VAR s : string;  VAR bs : ByteString );
{
        where  s = string to be converted
              bs = packed array of byte (ByteString) to receive the
                   converted string

Converts string to ByteString.

Called by       GetNextFile
}

  VAR
    i : integer;
   BEGIN
     FOR i:=1 TO strlen(s) DO
       bs[i] := ord(s[i]);
     bs[strlen(s)+1] := ENDSTR;
   END;

$PAGE$
PROCEDURE BtoS ( bs : ByteString; var s : string );
  var i : integer;
     CH : CHAR;
  begin
  TRY
  i := 1;
  s := '';
  while bs[i] <> ENDSTR do begin
    setstrlen(s, strlen(s)+1);
    s[i] := chr(bs[i]);
    i := i + 1;
    end;  { while }
  setstrlen(s,i-1);
  
  RECOVER BEGIN
    if escapecode = -8
       then begin  { value range error }
         writeln('Value range error in BtoS :  i = ',i:1,
                 '  bs[i] = ',CHR(bs[i]));
         writeln('Type any char to continue');
         READ(CH);
         end  { value range error }
       else escape(escapecode);
    END;  { RECOVER }
    
  end;  { procedure BtoS }
  
$PAGE$
  { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }

FUNCTION ItoC (n : integer; VAR s : ByteString; i : integer)
    : integer;      { returns index of end of s }
{

        where   n = integer to be converted
                s = ByteString in which to return the converted integer
                i = starting index within s at which to store the 
                    first character of converted integer

Converts integer n to char ByteString in s[i].  Returns index in s of the
character after the last one written.

Called by       PutNum
                GetFile
                ReceiveData
}

   BEGIN
     IF (n < 0)
      THEN
       BEGIN
         s[i] := ord('-');
         ItoC := ItoC(-n, s, i+1)
       END
      ELSE
       BEGIN
         IF (n >= 10)
          THEN
          i := ItoC(n DIV 10, s, i);
         s[i] := n MOD 10 + ord('0');
         s[i+1] := ENDSTR;
         ItoC := i + 1
       END
   END;

$PAGE$
  { copyright (c) 1981 university of toronto computing services }

FUNCTION IsUpper ( c : byte ) : boolean;
{

True if c is upper case letter.

}
   BEGIN
     IsUpper := (c >= ord('A')) AND (c <= ord('Z'))
   END;

$PAGE$
FUNCTION IsControl ( c : byte ) : boolean;
{

True if character is a control character (ie, if c < 32.).

}
   BEGIN
     IsControl := (c=DEL ) OR (c < BLANK );
   END;

$PAGE$
FUNCTION IsPrintable ( c : byte ) : boolean;
{

True if character is not a control character (ie, if c >= 32.).

}
   BEGIN
     IsPrintable := NOT IsControl(c);
   END;

end; { module byte_str }


$PAGE$
MODULE terminal;   

{ Module terminal provides low level character i/o to the console
  keyboard (non-echoing), CRT screen, and the datacomm interface.
  A terminal emulator procedure is also provided which implements
  a rudimentary (glass TTY) terminal over the datacomm interface.
}
import  ascii_defs,
        byte_str,
        iodeclarations,
        iocomasm,
        general_0,
        general_1,
        general_2,
        general_3,
        general_4,
        serial_0,
        serial_3;

export
  var
      { Datacomm interface parameters }

        comm_bits_per_char : 5..8;
        comm_stop_bits : real;
        comm_parity : type_parity;
        comm_speed : integer;


  procedure init_data_comm;             { sets up serial port }
  procedure check_data_comm;            { maintains serial input buffer }
  
  function SerialStatus : boolean;      { returns true if serial char ready }
  function SerialIn : byte;             { returns char from serial port }
  procedure SerialOut( c : byte );      { sends char to serial port }
  procedure SerialFlush;                { flushes serial input buffer }
  function SerialData : integer;        { returns number of chars in buffer }
  
  function ConsoleStatus : boolean;     { returns true if kybd char typed }
  function ConsoleIn : char;            { returns char typed on console }
  procedure ConsoleOut ( c : char );    { sends character to console }
  
  procedure Emulator ( breakchar : char ;
                       function break_func ( c : char ) : boolean );
                                        { provides glass tty }

$PAGE$
implement
   const
      comm = 20;           { Datacomm select code }
      bufsize = 5000;      { buffer size for datacomm transfers }
      kbdunit = 2;         { Unit number for keyboard }
   
   var
     termbuf : buf_info_type;   { buffer for serial input }

{
init_data_comm must be called before any of the SerialXxx routines.
It sets the physical transmission parameters for the datacomm
interface, initializes a transfer buffer for incoming characters
(termbuf), and starts a transfer into that buffer.  For some reason
the serial port seems to ignore any incoming characters until it has
sent one itself, so NUL is sent to the serial port. 
}
procedure init_data_comm;
   
   procedure init_comm_parms;
      begin
      comm_bits_per_char := 8;
      comm_stop_bits := 1;
      comm_speed := 9600;
      comm_parity := no_parity;
      end;

   begin
   ioreset(comm);            { reset the datacomm card }
   init_comm_parms;          { initialize transmission parameters }
   iocontrol(comm,22,0);     { no flow control protocol }
   iocontrol(comm,23,0);     { no handshake }
   iocontrol(comm,24,127);   { pass all characters }
   iocontrol(comm,28,0);     { card EOL = none }

   set_baud_rate(comm,comm_speed);
   set_parity(comm,comm_parity);
   set_char_length(comm,comm_bits_per_char);
   set_stop_bits(comm,comm_stop_bits);

   iobuffer(termbuf,bufsize);           { get a ring buffer for datacomm }
                                        { incoming characters }
   transfer(comm,overlap,to_memory,termbuf,bufsize); { initial transfer }
   writechar(comm, chr(0));   { send null to allow incoming chars }
                              { don't know why... }
   end;  { procedure init_data_comm }
   
$PAGE$
{
check_data_comm makes sure that there is an active transfer in
progress from the serial port to its buffer (termbuf).  It is called
automatically by SerialStatus.
}
procedure check_data_comm;   { maintains datacomm input buffers }
  begin
  if (termbuf.active_isc = no_isc) and (buffer_data(termbuf)=0)
     then begin             { if buffer is empty and no transfer occurring }
       transfer(comm,overlap,to_memory,termbuf,bufsize);
     end;  { if buffer empty and no transfer occurring }
  end;  { procedure check_data_comm }

{
SerialStatus returns true if a character is ready from the serial
port.  It calls check_data_comm to ensure the buffer is being filled.
}
function SerialStatus : boolean;
  begin
  check_data_comm;                      { make sure buffer is being filled }
  SerialStatus := buffer_data (termbuf) <> 0;
  end;  { function SerialStatus }
  
function SerialIn : byte;
  var ch : char;
  begin
  if SerialStatus
     then begin                         { character ready }
          readbuffer(termbuf,ch);       { get the character from the buffer }
          SerialIn := ord( ch );
          end
     else begin                         { no character ready }
          SerialIn := ENDSTR;
          end;
  end;  { function SerialIn }

{
SerialOut writes the given byte to the serial port.
}
procedure SerialOut ( c : byte );
  begin
  writechar(comm, chr(c));
  end;  { procedure SerialOut }
  
{
SerialFlush empties the serial input buffer.
}
procedure SerialFlush;
  var c : char;
  begin
  while (buffer_data(termbuf) <> 0) do
    readbuffer(termbuf,c);
  end;  { procedure SerialFlush }

function SerialData : integer;        { returns number of chars. in buffer }
  begin
  SerialData := buffer_data(termbuf);
  end;  { function SerialData }
  
$PAGE$
function ConsoleStatus : boolean;    { returns true if char available }
  begin
  ConsoleStatus := not unitbusy(kbdunit);
  end;  { function ConsoleStatus }

function ConsoleIn : char;      { returns byte read from keyboard (no echo) }
  var ch : char;
  begin
  if eoln(keyboard)
     then begin
       readln(keyboard);
       ch := chr(NEWLINE);           { return NEWLINE if eoln }
       end
     else read(keyboard,ch);
  ConsoleIn := ch;     { return of char }
  end;  { function ConsoleIn }
  
procedure ConsoleOut ( c : char );
  var c7 : char;
  begin
  c7 := chr(binand(ord(c), 127));         { mask off bit 7 }
  if c7 <> #0                    { if not null }
     then write( c7 );
  end;  { procedure ConsoleOut }
  

$PAGE$
procedure Emulator ( breakchar : char ;
                     function break_func ( c : char ) : boolean );
                                          { implements terminal emulator }

{ When the user types the break character, the next character is read
  (but not sent to the datacomm port).  If the second character is also
  the break character, the break character will be sent to the datacomm
  port.  If it is not, the break_func action routine will be called with
  that character as the parameter.  Note that break_func must be declared
  in a program block, as must all functions and procedures passed as
  parameters.  If the break_func returns TRUE, the emulator will return
  to the caller.
  
  The datacomm interface is assumed to have been previously initialized
  via a previous call to init_data_comm.
}
   var  serchar : byte;
        kbdchar : char;
        done : boolean;
        
   
   begin { procedure Emulator }
   
   writeln( 'Entering terminal emulator' );
   write  ( 'Escape character is ');
   if breakchar < #32
      then writeln('^',chr( ord(breakchar) + 64))
      else writeln('''',breakchar,'''');
   writeln;
   
   done := false;
   repeat
      if consolestatus                  { if keyboard char available }
         then begin             
           kbdchar := ConsoleIn;
           if kbdchar = breakchar       { if break character typed }
              then begin
                   kbdchar := ConsoleIn;
                   if kbdchar <> breakchar
                      then begin
                        if break_func ( kbdchar )  { then call break_func }
                          then done := true;
                        end
                      else SerialOut(ord(breakchar)); { else send breakchar }
                   end   { if break character typed }
              else SerialOut(ord(kbdchar))         { send char to datacomm }
           end;  { if keyboard char available }
         
      if serialstatus                   { if data ready from datacomm }
         then begin
         serchar := SerialIn;
         ConsoleOut( chr(serchar) );
         end;       { if data ready from datacomm }
   
   until done;
   
end;   { procedure Emulator }

end;  { End MODULE terminal }

$PAGE$
MODULE byte_io;
import  ascii_defs,
        byte_str,
        terminal;

export

const
  
  FLEN1 = 10;   { length of file name only (without extension) }
  FLEN2 = 15;   { length of filespec (with extension) }
  FILENAME_LENGTH = 30;
  
  LP =       'PRINTER:            ';
  TTYNAME =  'CONSOLE:';        { ByteString name of console (local)
                                  terminal that can be given to RESET,
                                  REWRITE, etc. }

  { standard file descriptors. subscripts in open, etc. }

  STDIN = 1;              { these are not to be changed }
  STDOUT = 2;
  STDERR = 3;
  LINEOUT = 4;
  LINEIN = 5;

  { other io-related stuff }

  IOERROR = 0;                  { status values for open files }
  IOAVAIL = 1;
  IOREAD = 2;
  IOWRITE = 3;
  MAXOPEN = 15;                 { maximum number of open files }
  ENDFILE = -1;

type

  filedesc = IOERROR..MAXOPEN;  { file descriptor values }
  filename = string [FILENAME_LENGTH];

PROCEDURE initio;
FUNCTION  Getcf ( VAR c: byte;   fd : filedesc ) : byte;
FUNCTION  GetLine ( VAR s : ByteString; fd : filedesc;
                                   maxsize : integer ) : boolean;
PROCEDURE Putc ( c : byte );
PROCEDURE Putcf ( c : byte;  fd : filedesc );
PROCEDURE PutStr (VAR s : ByteString; fd : filedesc);
FUNCTION  Sopen (name : filename; mode :   integer) : filedesc;
PROCEDURE Sclose (fd : filedesc);
FUNCTION  Exists (s : filename) : boolean;
PROCEDURE PutNum ( n : integer;    fd : filedesc );
PROCEDURE PutCon( x : cstring;  fd : filedesc );

implement

type

  ioblock = RECORD        { to keep track of open files }
              filevar : text;
              mode : IOERROR..IOWRITE;
              linepos : integer;           { character position within line }
            END;
var
  opencount : integer;
  openlist : ARRAY [1..MAXOPEN] OF ioblock;        {  open files }

$PAGE$
PROCEDURE initio;
{

Initializes open file list.

Calls           Rewrite

Called by       Main program
}

  VAR
    i :     filedesc;
   BEGIN
     openlist[STDIN].mode := IOREAD;
     openlist[STDOUT].mode := IOWRITE;
     openlist[STDOUT].linepos := 0;
     openlist[STDERR].mode := IOWRITE;
     openlist[STDERR].linepos := 0;
     openlist[lineout].mode := IOWRITE;
     openlist[linein].mode := IOREAD;

     { connect STDERR to user's terminal }
     rewrite(openlist[STDERR].filevar, TTYNAME);

     { initialize rest of files  }
     FOR i := linein+1 TO MAXOPEN DO
     openlist[i].mode := IOAVAIL;

   END;  { procedure initio }

$PAGE$
  { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }

FUNCTION Getcf ( VAR c: byte;   fd : filedesc ) : byte;
{
  Reads a character from the given file into the character variable c,
  and also returns the same character as its value.  Can also return
  ENDFILE or NEWLINE upon end of file or end of line, respectively.

  If the mode of the file is not IOREAD, Getcf will print an error
  message on the console and exit the main program.


Calls           Halt

Called by       GetLine
                Exists          (but commented out there)
                DataFromFile
}
  VAR
    ch : char;
   BEGIN
     IF (openlist[fd].mode <> IOREAD)
       THEN begin
          writeln('Called Getcf without file.mode=IOREAD'); halt;
          end;
     IF (fd = STDIN)
        THEN IF eoln
                THEN begin
                     readln;
                     c:= NEWLINE;
                     end
                ELSE begin
                     read(ch);
                     c := ord(ch);
                     end
        ELSE IF eof(openlist[fd].filevar)
                THEN c := ENDFILE
                ELSE IF eoln(openlist[fd].filevar)
                     THEN BEGIN
                       readln(openlist[fd].filevar);
                       c := NEWLINE
                       END
                     ELSE BEGIN
                       read(openlist[fd].filevar, ch);
                       c := ord(ch)
                       END;
     Getcf := c
   END;


$PAGE$
  { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  { GetLine (UCB) -- get a line from file }

FUNCTION GetLine ( VAR s : ByteString; fd : filedesc;
                                   maxsize : integer ) : boolean;
{
  Reads a line from the given file into the given string, up to the
  maximum number of characters given.  Stops reading after ENDFILE or
  NEWLINE, or when maxsize characters have been read.  NEWLINE will be
  included in the string, but ENDFILE will not be.  String is always
  terminated by ENDSTR.  Note that the string must be able to hold
  maxsize+1 characters, to accomodate the ENDSTR terminator.

Calls           Getcf

Called by       InitCmd
                ReadParm
}
  VAR
    i : integer;
    c : byte;
   BEGIN
     i := 1;
      REPEAT
       s[i] := Getcf(c, fd);
       i := i + 1
      UNTIL (c = ENDFILE) OR (c = NEWLINE) OR (i >= maxsize);
     IF (c = ENDFILE) 
      THEN   { went one too far }
      i := i - 1;
     s[i] := ENDSTR;
     GetLine := (c <> ENDFILE)
   END;

$PAGE$
PROCEDURE Putc ( c : byte );
{

Puts one Byte on standard output.

Calls           Write
                Writeln

Called by       Putcf
}
   BEGIN
     IF c = NEWLINE
      THEN writeln
      ELSE write(chr(c))
   END;


$PAGE$
  { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }

PROCEDURE Putcf ( c : byte;  fd : filedesc );
{

Writes a single character to the file given by fd.


Calls           Putc
                SerialOut
                Writeln
                Write

Called by       PutStr
                PutOut
                DisplayStatistics
                DisplayPacket
                DataToFile
}
  BEGIN
  with openlist[fd] do begin
    IF (fd = STDOUT)
      THEN Putc(c)
      ELSE if (fd = lineout)
             then SerialOut(c)
             else IF c = NEWLINE
                    THEN begin
                      writeln(filevar);
                      linepos := 0;
                      end
                    ELSE begin          { char not newline }
                      if c = TAB
                        then begin       { expand tab to spaces }
                          repeat
                            write(filevar,' ');
                            linepos := linepos + 1;
                          until (linepos mod 8) = 0;
                          end  { expand tab to spaces }
                        else if IsPrintable(c)
                               then begin       { write char to file }
                                 write(filevar, chr(c));
                                 linepos := linepos + 1;
                                 end;  { write char to file }
                      end;  { char not newline }
    end;  { with }
  END;  { procedure PutCf }

$PAGE$
  { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }

PROCEDURE PutStr (VAR s : ByteString; fd : filedesc);
{

Put out string on file given by f.

Calls           Putcf

Called by       PutCon
                PutNum
                PutOut
                DisplayPacket
                BuildPacket
                GetNextFile
                SendFile
                GetFile
                DataToFile
                ReceiveData
                ReceiveFile
                Main Program
}
  VAR
    i : integer;
   BEGIN
     i := 1;
     WHILE (s[i] <> ENDSTR) DO
      BEGIN
        Putcf(s[i], fd);
        i := i + 1
      END
   END;


$PAGE$
FUNCTION Sopen (name : FileName; mode :   integer) : filedesc;
{

Opens a file for reading or writing.

Calls           

Called by       Exists
                ReadParm
                GetNextFile
                GetFile
                Main program
}

  VAR
    i :     integer;
    found : boolean;
  BEGIN
      
  { find a free slot in openlist }
  Sopen := IOERROR;
  found := false;
  i := 1;
  WHILE (i <= MAXOPEN) AND (NOT found) DO BEGIN
    IF (openlist[i].mode = IOAVAIL)
      THEN BEGIN
        openlist[i].mode := mode;
        IF (mode = IOREAD)
          THEN begin
               reset(openlist[i].filevar, name);
               end
          ELSE begin
               rewrite(openlist[i].filevar, name); 
               openlist[i].linepos := 0;
               end;
        Sopen:=i;
        found := true
        END;
     i := i + 1;
     END;  { while }
  END;  { procedure Sopen }

$PAGE$
PROCEDURE Sclose (fd : filedesc);
{
Called by       Exists
                ReadParm
                DisplayStatistics
                DataFromFile
                DoEOF
}

   BEGIN
     IF      (fd > STDERR) AND (fd <= MAXOPEN)
      THEN
       BEGIN
         openlist[fd].mode := IOAVAIL;
         close(openlist[fd].filevar,'LOCK');
       END
   END;  { procedure Sclose }

$PAGE$
FUNCTION Exists (s : FileName) : boolean;
{

Returns true if file exists.


Calls           Sopen
                Sclose
                Getcf

Called by       ReadParm
                GetNextFile
                GetFile
                Main prog
}


   VAR
     fd :     filedesc;
     ior : integer;                   { saves io result }
   BEGIN
     try
     Exists := false;
     fd := Sopen(s,IOREAD);
     Sclose(fd);
     Exists := true;

     recover
     if escapecode = -10                { if IO error occurred }
        then begin
             ior := ioresult;
             if not (ior in [9,10])
                then writeln('Error in file operation - #',ior:4)
             end  { if IO error occurred }
        else escape(escapecode);
   END;  { procedure Exists }

$PAGE$
PROCEDURE PutNum ( n : integer;    fd : filedesc );
{

Ouputs number n to the file given by fd preceded by a leading blank.
Uses ItoC to convert the number.

Calls           ItoC

Called by       PutOut
                DisplayStatistics
                DisplayPacket
                SendData
                ReceiveData
                ReceiveFile
}
  VAR
    s: ByteString;
    dummy: integer;
   BEGIN
     s[1] := BLANK;
     dummy := ItoC(n,s,2);
     PutStr(s,fd);
   END;

$PAGE$
PROCEDURE PutCon( x : cstring;  fd : filedesc);
{

Outputs a literal string preceded by a NEWLINE.

Calls           PutStr
                CtoB

Called by       InitCmd
                PutOut
                DisplayStatistics
                DisplayPacket
                ErrorPack
                Verbose
                PutErr
                BuildPacket
                SendData
                GetFile
                ReceiveInit
                ReceiveData
                ReceiveFile
}
  VAR
    i: integer;
    s: ByteString;
   BEGIN
     s[1] := NEWLINE;
     s[2] := ENDSTR;
     PutStr(s,fd);
     CtoB(x,s);
     PutStr(s,fd);
   END;

end. { module byte_io }