home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / apollo / apollo.pas < prev    next >
Pascal/Delphi Source File  |  2020-01-01  |  234KB  |  5,613 lines
  1. PROGRAM KERMIT(INPUT,OUTPUT);
  2.  
  3. (******************************************************************************)
  4. (*                                                                            *)
  5. (*                        KERMIT File Transfer Utility                        *)
  6. (*                        ============================                        *)
  7. (*                                                                            *)
  8. (* The following program implements the Kermit file transfer protocol.  The   *)
  9. (* protocol was designed at the Columbia University Center for Computing      *)
  10. (* Activities (CUCCA) in 1981-1982 by Bill Catchings and Frank da Cruz.       *)
  11. (*                                                                            *)
  12. (* This particular implementation of Kermit was developed at Control Data     *)
  13. (* Corporation to run on the Apollo computer systems.  It implements the      *)
  14. (* protocol as outlined in the Kermit Protocol Manual, Fifth Edition.  This   *)
  15. (* implementation of Kermit was originally designed to run as a "remote"      *)
  16. (* Kermit. The "local" Kermit commands were added later.  This Kermit is      *)
  17. (* particularly suited for running in 'server' mode.                          *)
  18. (*                                                                            *)
  19. (******************************************************************************)
  20. (*                                                                            *)
  21. (*                             RECORD OF CHANGES                              *)
  22. (*                             =================                              *)
  23. (*                                                                            *)
  24. (* VERSION NUMBER                    DESCRIPTION OF CHANGES                   *)
  25. (* --------------   --------------------------------------------------------- *)
  26. (*                                                                            *)
  27. (* Version 1.0      This is the first version of Kermit to run on the Apollo. *)
  28. (*                  This version only operated in server mode, recognizing    *)
  29. (*                  the send initiate, receive initiate, and the finish       *)
  30. (*                  commands. Completed 5-27-84.                              *)
  31. (*                                                                            *)
  32. (* Version 1.1      This version added several corrections to Version 1.1,    *)
  33. (*                  the debug file for a session was placed into the current  *)
  34. (*                  directory, added a header to the log-in, and added        *)
  35. (*                  timeouts to the program. Completed 6-2-84.                *)
  36. (*                                                                            *)
  37. (* Version 1.2      This version corrected a few bugs found in Version 1.1.   *)
  38. (*                  which occurred when the connected Kermit attempted to     *)
  39. (*                  send multiple files to this Kermit.  There are some very  *)
  40. (*                  minor changes in this version which are included in       *)
  41. (*                  preparation for Version 2.0, which will implement the     *)
  42. (*                  Kermit Protocol 5th Edition. Completed 6-8-84.            *)
  43. (*                                                                            *)
  44. (* Version 2.0      This version implemented the Kermit commands and ideas    *)
  45. (*                  which are outlined in the Kermit Protocol 5th Edition.    *)
  46. (*                  There are still minor commands not implemented in this    *)
  47. (*                  version and the local Kermit commands are not yet         *)
  48. (*                  implemented. Completed 7-27-84.                           *)
  49. (*                                                                            *)
  50. (* Version 2.1      This version added a local mode to Kermit.  This includes *)
  51. (*                  the implementation of a dumb terminal emulator for the    *)
  52. (*                  connect command, modification of the send and receive     *)
  53. (*                  commands to support local mode, the addition of a get     *)
  54. (*                  command, and the addition of a finish command.  Completed *)
  55. (*                  8-6-84.                                                   *)
  56. (*                                                                            *)
  57. (* Version 2.2      This version added the set noecho command to the local    *)
  58. (*                  mode of Kermit.  This particular version also cleaned up  *)
  59. (*                  some bugs discovered in versions 2.0 and 2.1.  Completed  *)
  60. (*                  8-10-84.                                                  *)
  61. (*                                                                            *)
  62. (* Version 2.3      This version added a display during file transmissions,   *)
  63. (*                  if in local mode, to show the number of packets           *)
  64. (*                  successfully transmitted and to show the number of        *)
  65. (*                  retries.  Completed 8-17-84.                              *)
  66. (*                                                                            *)
  67. (* Version 2.4      This version implements a Cyber-722 terminal emulation    *)
  68. (*                  when in connect mode.  Completed 9-19-84.                 *)
  69. (*                                                                            *)
  70. (* Version 2.5      This version corrected some bugs discovered which were    *)
  71. (*                  related to the logging of transactions.  Completed        *)
  72. (*                  9-20-84.                                                  *)
  73. (*                                                                            *)
  74. (* Version 2.6      This version corrected some bugs discovered which were    *)
  75. (*                  related to the processing of checksum errors.  Completed  *)
  76. (*                  10-18-84.                                                 *)
  77. (*                                                                            *)
  78. (* Version 2.7      This version will not insert extra eoln characters when   *)
  79. (*                  a line is >256 bytes long.  Completed 11/14/86.           *)
  80. (*                                                                            *)
  81. (* Version 2.8      This version implements QBIN partially.  8-bit quoting is *)
  82. (*                  always done in this version; it is not optional.  See the *)
  83. (*                  Kermit protocol description where it describes the use of *)
  84. (*                  'N' and 'Y' in the QBIN field of the initialization       *)
  85. (*                  packet.                                                   *)
  86. (*                                                 Completed 1/12/87.         *)
  87. (*                                                                            *)
  88. (* VERSION 2.8a     - beware: don't use -opt AND -cpu 3000 when compiling !!  *)
  89. (*                  !!^^^^^^!! this is a BUG in Apollos's PASCAL Compiler !!  *)
  90. (*                  - function EXISTF replaced with STREAM_$INQUIRE           *)
  91. (*                  - FILE NOT FOUND when SENDing indicated                   *)
  92. (*                  - SEND (file_type=ascii) now correctly uses CR/LF         *)
  93. (*                  - TRANSMIT dto.                                           *)
  94. (*                  - GET procedure: OPEN(rcvfile, ... ), WRITE(rcvfile, ... )*)
  95. (*                    repl. with:  OPENO(rcvid, ... ), PUTBUF(rcvid, ... )    *)
  96. (*                    Files will be treated correctly in type (ascii/binary)  *)
  97. (*                  N. Schmidt, B. Hochstein, K. Schmitt   Completed 18.09.87 *)
  98. (*      XBR4D715@DDATHD21.BITNET (KLaus D. Schmitt THD Inst. f. EEV FB17)     *)
  99. (*                                                                            *)
  100. (* APX Version 2.7  G.J.Sands,Marconi Space Systems (U.K). This version       *)
  101. (*                  implements: repeated character processing, filename       *)
  102. (*                  hashing, RECEIVE followed by filename, drives non-GPR     *)
  103. (*                  displays - attached terminals and remote nodes. TIME,     *)
  104. (*                  TIMEOUT,NORMAL,GRAPHICS and CVT_NL added to SET & SHOW.   *)
  105. (*                  Error messages displayed on screen (if local). Status     *)
  106. (*                  tested after OPENing receive file. Repetition of packet   *)
  107. (*                  count display suppressed. Success or failure reported     *)
  108. (*                  after each transfer. Sio input discarded before sending a *)
  109. (*                  file and before a retry. No delay before send if local.   *)
  110. (*                  Xmitted charas are reduced mod 128 earlier otherwise      *)
  111. (*                  controls could be sent.                                   *)
  112. (*                  Completed 3-2-87.                                         *)
  113. (*                                                                            *)
  114. (* APX Version 2.8  APX 2.7 changes added to CDC 2.8. Initialise interrogates *)
  115. (*                  line to find out what type of device stdin is and sets    *)
  116. (*                  GRAPHICS and CVT_NL accordingly.      Inter_node          *)
  117. (*                  mailboxes are driven in raw mode when CONNECTed.          *)
  118. (*                  Outstanding problem - what to do if being driven by sio   *)
  119. (*                  line on same node as RS232 port. Don't send escape_chara. *)
  120. (*                  to connected machine until we know what next is. 8 bit    *)
  121. (*                  quoting can be switched off by SET - parameters exchange  *)
  122. (*                  handles 'Y' and 'N' in the qbin field.                    *)
  123. (*                                                                            *)
  124. (* APX Version 2.9  2.8a changes added to APX 2.8.   "cvt_NL" becomes         *)
  125. (*                  "raw[mode]".  If in server or receiving a second or       *)
  126. (*                  subsequent file, set rcvname blank to ensure that other   *)
  127. (*                  Kermit's names are used.  If normalising, received names  *)
  128. (*                  converted to lower case. Fileheader packets handle (some) *)
  129. (*                  encoding. Reinstate wait for activity section in CONNECT  *)
  130. (*                  unless graphics (to avoid a remote node's CPU getting     *)
  131. (*                  hammered  -  but it doesn't work properly if using GPR).  *)
  132. (*                  > becomes <> and discard "procedure" used s.t. compiles   *)
  133. (*                  without warnings.                                         *)
  134. (*                  Completed 24/4/89.                                        *)
  135. (*                                                                            *)
  136. (******************************************************************************)
  137.  
  138.  
  139. %nolist;
  140. %include '/sys/ins/base.ins.pas';
  141. %include '/sys/ins/sio.ins.pas';
  142. %include '/sys/ins/pgm.ins.pas';
  143. %include '/sys/ins/pfm.ins.pas' ;
  144. %include '/sys/ins/pad.ins.pas';
  145. %include '/sys/ins/streams.ins.pas';
  146. %include '/sys/ins/error.ins.pas';
  147. %include '/sys/ins/cal.ins.pas';
  148. %include '/sys/ins/time.ins.pas';
  149. %include '/sys/ins/vfmt.ins.pas';
  150. %include '/sys/ins/rws.ins.pas';
  151. %include '/sys/ins/ec2.ins.pas';
  152. %include '/sys/ins/smdu.ins.pas';
  153. %include '/sys/ins/name.ins.pas';
  154. %include '/sys/ins/gpr.ins.pas';
  155. %include '/sys/ins/kbd.ins.pas';
  156. %include '/sys/ins/type_uids.ins.pas';
  157.  
  158. %list;
  159.  
  160. CONST
  161.  
  162.    (* The following constants are to default streams assigned by the system *)
  163.  
  164.    ERRIN  = STREAM_$ERRIN;
  165.    ERROUT = STREAM_$ERROUT;
  166.    STDIN  = STREAM_$STDIN;
  167.    STDOUT = STREAM_$STDOUT;
  168.  
  169.    (* The following constants are ascii codes for usefull characters *)
  170.  
  171.    NUL = CHR(0);
  172.    SOH = CHR(1);
  173.    BEL = CHR(7);
  174.    BS  = CHR(8);
  175.    LF  = CHR(10);
  176.    CR  = CHR(13);
  177.    ESC = CHR(27);
  178.    RS  = CHR(30);
  179.    SP  = CHR(32);
  180.    DEL = CHR(127);
  181.  
  182.    (* The following constants are restrictions placed on packets *)
  183.  
  184.    MAXPACKETLENGTH    = 94;
  185.    MAXNUMBEROFPACKETS = 64;
  186.    MAXSEQUENCENUMBER  = 63;  { max number of packets - 1 }
  187.    MAXDATALENGTH      = 91;
  188.  
  189.    DEFAULT_maxtries    = 5;
  190.    DEFAULT_send_delay  = 10;
  191.    DEFAULT_escape_char = CHR(29); { ctrl ] }
  192.    DEFAULT_alt_escape_char = CHR(33); { ! }    (* node-node mailbox won't accept
  193.                                                   non-printing *)
  194.    DEFAULT_mytimeout   = 15;
  195.    DEFAULT_theirtimeout= 60;
  196.  
  197.    (* The following constants are used for handling event counters *)
  198.  
  199.    NUMBER_OF_ECS = 3;
  200.    TIME_INDEX    = 1;
  201.    STRIN_INDEX   = 2;
  202.    KEYBD_INDEX   = 3;
  203.  
  204.    (* The following are miscellaneous constants for readability *)
  205.  
  206.    MAX_BUFFER_SIZE = 256;
  207.    FOREVER         = FALSE;
  208.    VERSION         = 'Version 2.9';
  209.    VERSIONLENGTH   = 11;
  210.    header_freq     = 20; (* # of lines between headers when reporting to screen
  211.                             in non-graphics mode *)
  212.    packet_interval = 10; (* frequency of packet reports in non-graphics mode *)
  213.  
  214. TYPE
  215.  
  216.    cmdtyps       = (NULLCMD, EXITCMD, SENDCMD, RECEIVECMD, LOCALCMD, HELPCMD,
  217.                     BYECMD, SETCMD, SERVERCMD, TAKECMD, DEFINECMD, SHOWCMD,
  218.                     STATISTICSCMD, LOGCMD, TRANSMITCMD, CONNECTCMD, GETCMD,
  219.                     FINISHCMD);
  220.  
  221.    kermitstates  = (ABORT, SEND_INIT, SEND_FILE, SEND_DATA, SEND_EOF,
  222.                     SEND_BREAK, COMPLETE, REC_INIT, REC_FILE, REC_DATA,
  223.                     START, REC_SERVER_IDLE, SEND_SERVER_INIT, SEND_GEN_CMD);
  224.  
  225.    datalengthtyp = 1 .. MAXDATALENGTH;     (* +2.8a *)
  226.    databuffer    = PACKED ARRAY[datalengthtyp] OF CHAR;
  227.  
  228.    packettyp     = (D, Y, N, S, B, F, Z, E, R, G, Timeout, Checksum_error);
  229.  
  230.    packetrec     = RECORD
  231.                       mark  : CHAR;
  232.                       len   : 0 .. MAXPACKETLENGTH;
  233.                       seq   : 0 .. MAXSEQUENCENUMBER;
  234.                       typ   : packettyp;
  235.                       data  : databuffer;
  236.                       check : CHAR;
  237.                    END; (* of packet *)
  238.  
  239.    packetstrtyp  = PACKED ARRAY[1 .. MAXPACKETLENGTH+2] OF CHAR;
  240.  
  241.    filetyp       = (ascii, binary);
  242.  
  243.    buffer_typ    = ARRAY[1 .. MAX_BUFFER_SIZE] OF CHAR;
  244.    stream_io_typ = RECORD
  245.                       buffer   : buffer_typ;  { buffer for storing I/O }
  246.                       size     : INTEGER32;   { how much is in the buffer }
  247.                       index    : INTEGER;     { points to last char processed }
  248.                       ptr      : ^buffer_typ; { returned by streams }
  249.                       currchar : CHAR;        { character just received }
  250.                       prevchar : CHAR;        { previous character received }
  251.                       rcvdchar : BOOLEAN;     { flag for character received }
  252.                       timedout : BOOLEAN;     { flag for timeout while waiting }
  253.                    END; (* of stream_io_typ *)
  254.  
  255.    (* The following are possible line types from stream_$inquire *)
  256.  
  257.    line_type     = (display,mbx_line (* inter-node mailbox *),
  258.                      sio_line_type,other_line);
  259.  
  260. VAR
  261.    mode           : (host, local);
  262.    display_type   : line_type;
  263.  
  264.    command        : cmdtyps;
  265.  
  266.    state          : kermitstates;
  267.  
  268.    server_mode    : BOOLEAN;       (* boolean flag signifying whether server  *)
  269.                                    (* mode has been toggled                   *)
  270.    take_mode      : BOOLEAN;
  271.  
  272.    receivedpacket : packetrec;
  273.    currentpacket  : 0 .. MAXSEQUENCENUMBER;
  274.    packet         : ARRAY[0 .. MAXSEQUENCENUMBER] OF packetrec;
  275.  
  276.    numberoftries  : INTEGER;       (* number of times current packet has been *)
  277.                                    (* sent or received                        *)
  278.    maxtries       : INTEGER;       (* maximum number of times current packet  *)
  279.                                    (* can be sent or received                 *)
  280.    send_delay     : INTEGER;       (* the number of seconds to delay before   *)
  281.                                    (* beginning to send a file, this will     *)
  282.                                    (* the user to get back to their local     *)
  283.                                    (* machine to issue a receive command      *)
  284.    escape_char    : CHAR;          (* the escape character to be used to      *)
  285.                                    (* delimit commands in connect mode        *)
  286.    local_echo     : BOOLEAN;       (* boolean flag signifying whether local   *)
  287.                                    (* keystrokes should be echoed in connect  *)
  288.                                    (* mode                                    *)
  289.  
  290.    debugfile      : TEXT;
  291.    takefile       : TEXT;
  292.  
  293.    file_type      : filetyp;       (* specifies whether full 8-bit bytes      *)
  294.                                    (* should be sent, or just 7 of the 8 bits *)
  295.  
  296.    xmtid          : integer16;   { stream id }
  297.    xmtname        : databuffer;
  298.    xmtlength      : datalengthtyp;
  299.    xmt_eof        : BOOLEAN;
  300.    xmt_eoln       : BOOLEAN;
  301.    xmtbuffer      : RECORD
  302.                        data : databuffer;
  303.                        len  : 0 .. MAXDATALENGTH;
  304.                     END; (* of xmtbuffer *)
  305.  
  306.    rcvfile        : TEXT;
  307.    rcvid          : integer16;   { stream id }    (* +2.8a *)
  308.    rcvname        : databuffer;
  309.    rcvlength      : datalengthtyp;
  310.    rcvbuffer      : RECORD
  311.                        data : PACKED ARRAY[1 .. MAX_BUFFER_SIZE] OF CHAR;
  312.                        len  : 0 .. MAX_BUFFER_SIZE;
  313.                     END; (* of rcvbuffer *)
  314.    kermitname     : databuffer;          (* filename in F or R packet *)
  315.    kermitlength   : datalengthtyp;
  316.  
  317.    transactfile   : TEXT;                (* file for LOGging transactions     *)
  318.    transactname   : databuffer;          (* name of LOG file                  *)
  319.    transactlength : datalengthtyp;       (* length of LOG file name           *)
  320.  
  321.    sessionfile    : TEXT;                (* file for LOGging sessions         *)
  322.    sessionname    : databuffer;          (* name of LOG file                  *)
  323.    sessionlength  : datalengthtyp;       (* length of LOG file name           *)
  324.  
  325.    transmitfile   : TEXT;
  326.  
  327.    statistics     : RECORD
  328.                        filename      : databuffer;          (* name of file   *)
  329.                                                             (* being sent or  *)
  330.                                                             (* received       *)
  331.                        namelength    : datalengthtyp;       (* length of name *)
  332.                        totalpkts     : INTEGER32;           (* total number   *)
  333.                                                             (* packets sent   *)
  334.                        numretries    : INTEGER32;           (* total number   *)
  335.                                                             (* of retries     *)
  336.                        charssent     : INTEGER32;           (* total char's   *)
  337.                                                             (* sent           *)
  338.                        charsrcvd     : INTEGER32;           (* total char's   *)
  339.                                                             (* received       *)
  340.                        maxcharsinpkt : INTEGER;             (* size of larg-  *)
  341.                                                             (* est packet     *)
  342.                        starttime     : TIME_$CLOCK_T;       (* time that the  *)
  343.                                                             (* transfer began *)
  344.                        stoptime      : TIME_$CLOCK_T;       (* time that the  *)
  345.                                                             (* transfer ended *)
  346.                        ovhdsent      : INTEGER32;           (* number of over *)
  347.                                                             (* head char's    *)
  348.                                                             (* sent           *)
  349.                        ovhdrcvd      : INTEGER32;           (* number of over *)
  350.                                                             (* head char's    *)
  351.                                                             (* received       *)
  352.                        collecting    : BOOLEAN;             (* signifies if   *)
  353.                                                             (* statistics     *)
  354.                                                             (* should be      *)
  355.                                                             (* collected      *)
  356.                        completed     : BOOLEAN;             (* signifies if   *)
  357.                                                             (* the transfer   *)
  358.                                                             (* was successful *)
  359.                        lastpktrep    : INTEGER32;           (* only update    *)
  360.                        lastretryrep  : INTEGER32;           (* display if     *)
  361.                                                             (* changed        *)
  362.                        sincelast     : INTEGER;             (* lines since last header *)
  363.                                                             (* (non-graphics) *)
  364.                     END; (* of statistics *)
  365.  
  366.    (* The following variables are all used for setting parameters which are
  367.       exchanged in the initial connection. For more information please refer
  368.       to the KERMIT PROTOCOL MANUAL *)
  369.  
  370.    markchar     : CHAR;                 (* character to delimit the beginning
  371.                                            of a packet *)
  372.    mymaxl       : 0 .. MAXPACKETLENGTH; (* maximum length of packet to
  373.                                            receive *)
  374.    theirmaxl    : 0 .. MAXPACKETLENGTH; (* maximum length of packet to send *)
  375.    mytimeout    : INTEGER;              (* how long they should wait for a
  376.                                            packet from me *)
  377.    theirtimeout : INTEGER;              (* how long I should wait for a packet
  378.                                            from them *)
  379.    mynpad       : INTEGER;              (* the number of padding characters I
  380.                                            want to precede each incoming
  381.                                            packet *)
  382.    theirnpad    : INTEGER;              (* the number of padding characters
  383.                                            they want to precede each incoming
  384.                                            packet *)
  385.    mypadc       : CHAR;                 (* the control character I need for
  386.                                            padding, if any *)
  387.    theirpadc    : CHAR;                 (* the control character they need for
  388.                                            padding, if any *)
  389.    myeol        : CHAR;                 (* the character I need to terminate
  390.                                            any incoming packet, if any *)
  391.    theireol     : CHAR;                 (* the character they need to terminate
  392.                                            any incoming packet, if any *)
  393.    myqctl       : CHAR;                 (* the printable ASCII character I will
  394.                                            use to quote control characters *)
  395.    theirqctl    : CHAR;                 (* the printable ASCII character they
  396.                                            will use to quote control
  397.                                            characters *)
  398.    myqbin       : CHAR;   {[2.8]}       (* the printable ASCII character I will
  399.                                            use to quote binary characters *)
  400.    theirqbin    : CHAR;   {[2.8]}       (* the printable ASCII character they
  401.                                            will use to quote binary
  402.                                            characters *)
  403.    eight_bit    : BOOLEAN;              (* whether I want 8 bit quoting *)
  404.    quoting8     : BOOLEAN;              (* whether quoting has been agreed *)
  405.    strip_parity : BOOLEAN;              (* if true, assume parity bit is needed by
  406.                                            comms. *)
  407.    chkt         : INTEGER;              (* CHECK TYPE, the method used for
  408.                                            detecting errors :
  409.                                               1 = SINGLE-CHARACTER CHECKSUM
  410.                                               2 = TWO-CHARACTER CHECKSUM
  411.                                               3 = THREE-CHARACTER CRC-CCITT
  412.                                            only type 1 is implemented. *)
  413.    rept         : CHAR;                 (* the agreed prefix character to be used
  414.                                            to indicate a repeated character *)
  415.    myrept       : CHAR;
  416.    repeating    : BOOLEAN;
  417.    capabilities : INTEGER;              (* A bit mask, in which each bit
  418.                                            position corresponds to a capability
  419.                                            of KERMIT, and is set to 1 if that
  420.                                            capability is present, or 0 if it is
  421.                                            not. The following capability bits
  422.                                            are defined :
  423.                                               1 : ABILITY TO TIME OUT
  424.                                               2 : ABILITY TO ACCEPT SERVER CMDS
  425.                                               3 : ABILITY TO ACCEPT "A" PACKETS
  426.                                            This is a 6-BIT field with BIT5
  427.                                            representing capability 1, BIT4
  428.                                            representing capability 2, and so
  429.                                            forth *)
  430.    normal       : BOOLEAN;              (* "filenames are to be normalised" *)
  431.  
  432.    (* DEFAULTS FOR THE ABOVE FIELDS ARE SPECIFICALLY DEFINED IN THE KERMIT
  433.       PROTOCOL MANUAL. THEY ARE AS FOLLOWS :
  434.  
  435.          MAXL: 80
  436.          NPAD: 0, NO PADDING
  437.          PADC: 0 (NUL)
  438.          EOL : CR (CARRIAGE RETURN)
  439.          QCTL: THE CHARACTER "#"
  440.          QBIN: THE CHARACTER '&'
  441.          CHKT: "1", SIGNLE-CHARACTER CHECKSUM
  442.          REPT: NO REPEAT COUNT PROCESSING
  443.          MASK: ALL ZEROS (NO SPECIAL CAPABILITIES)
  444.          NORMAL: ON  *)
  445.  
  446.    graphics      : BOOLEAN;
  447.    rawmode       : BOOLEAN; (* Does connect drive display/mailbox/sio/ raw or
  448.                                cooked *)
  449.  
  450.    sentence      : STRING;  (* used for input from user.                      *)
  451.    sentenceindex : INTEGER;
  452.    logging       : RECORD
  453.                       transactions : BOOLEAN; (* indeicates whether logging   *)
  454.                       session      : BOOLEAN; (* transactions or session      *)
  455.                    END;
  456.    debug         : BOOLEAN; (* indicates whether debug mode is on or off.     *)
  457.    sendservNAKs  : BOOLEAN; (* indicates whether periodic NAK's should be     *)
  458.                             (* sent when the server is waiting for commands.  *)
  459.  
  460.    lcase,ucase   : SET OF CHAR;
  461.    alpha,alphanum: SET OF CHAR;
  462.  
  463.    (* The following variables are used for monitoring event counters *)
  464.  
  465.    waitptrs   : ARRAY[1 .. NUMBER_OF_ECS] OF ec2_$ptr_t;
  466.    waitvalues : ARRAY[1 .. NUMBER_OF_ECS] OF INTEGER32;
  467.  
  468.    (* The following variables are used for maintaining I/O to the
  469.       connected KERMIT *)
  470.  
  471.    sio_line        : INTEGER;
  472.    sio_line_opened : BOOLEAN;
  473.  
  474.    sio_stream   : STREAM_$ID_T;
  475.    strin_rec    : stream_io_typ;
  476.    strout_rec   : stream_io_typ;
  477.    keybdin_rec  : stream_io_typ;
  478.    keybdout_rec : stream_io_typ;
  479.  
  480.    status       : STATUS_$T;
  481.  
  482.    str_raw     : BOOLEAN;
  483.    str_no_echo : BOOLEAN;
  484.  
  485.    handler_rec : PFM_$CLEANUP_REC;
  486.    subsys_t    : ERROR_$STRING_T;
  487.    subsys_l    : INTEGER;
  488.    module_t    : ERROR_$STRING_T;
  489.    module_l    : INTEGER;
  490.    code_t      : ERROR_$STRING_T;
  491.    code_l      : INTEGER;
  492.  
  493.    procedure openi  (fn: databuffer;
  494.                      fnlen: integer16;
  495.                      text: boolean;
  496.                      sid: integer16);extern;
  497.    procedure openo  (fn: databuffer;              (* +2.8a *)
  498.                      fnlen: integer16;            (* +2.8a *)
  499.                      text: boolean;               (* +2.8a *)
  500.                      sid: integer16);extern;      (* +2.8a *)
  501.    procedure putbuf (sid: integer16;              (* +2.8a *)
  502.                      bufptr: univ_ptr;            (* +2.8a *)
  503.                      buflen: integer32);extern;   (* +2.8a *)
  504.    procedure getbuf (sid: integer16;
  505.                      bufptr: univ_ptr;
  506.                      buflen: integer32;
  507.                      var retlen: integer32;
  508.                      var eos: boolean);extern;
  509.    procedure closef (sid: integer16);extern;
  510. (* function existf  (var pathname : databuffer; pathlength:integer;
  511.                      var ftype:uid_$t): boolean;extern;             -2.8a *)
  512.  
  513.  
  514. (******************************************************************************)
  515. (*                                                                            *)
  516. (* THE FOLLOWING PROCEDURE WILL EXECUTE ANY CLEAN-UP THAT SHOULD BE DONE      *)
  517. (* BEFORE LEAVING KERMIT.                                                     *)
  518. (*                                                                            *)
  519. (******************************************************************************)
  520.  
  521. PROCEDURE restore_system;
  522.  
  523.    BEGIN (* restore system *)
  524.    IF sio_line_opened
  525.       THEN
  526.          BEGIN
  527.          SIO_$CONTROL(sio_stream, SIO_$RAW, str_raw, status);
  528.          SIO_$CONTROL(sio_stream, SIO_$NO_ECHO, str_no_echo, status);
  529.          IF (mode = local) AND (sio_line_opened)
  530.             THEN
  531.                BEGIN
  532.                STREAM_$CLOSE(sio_stream, status);
  533.                END;
  534.          sio_line_opened := FALSE;
  535.          END;
  536.    END; (* of restore system *)
  537.  
  538.  
  539.  
  540. (******************************************************************************)
  541. (*                                                                            *)
  542. (* THE FOLLOWING PROCEDURE WILL OPEN THE SPECIFIED SERIAL I/O LINE.  IF THE   *)
  543. (* CURRENT mode IS host, THEN THE PROCEDURE WILL MAKE SURE THAT STDIN AND     *)
  544. (* STDOUT ARE SERIAL I/O LINES.  IF THEY ARE NOT, THE PROCEDURE WILL SWITCH   *)
  545. (* THE MODE TO local.                                                         *)
  546. (*                                                                            *)
  547. (******************************************************************************)
  548.  
  549. PROCEDURE open_sio_line;
  550.  
  551.    VAR
  552.       device : ARRAY[1..9] OF CHAR;
  553.       status : STATUS_$T;
  554.  
  555.    BEGIN (* open serial i/o line *)
  556.    IF sio_line_opened
  557.       THEN restore_system;
  558.    IF mode = local
  559.       THEN
  560.          BEGIN
  561.          (* Allow line number to be any single digit. *)
  562.          device := '/DEV/SIO ';
  563.          device[9] := chr(sio_line + ord('0')); (* encode sio_line as a digit *)
  564.          STREAM_$OPEN(device, 9, STREAM_$UPDATE, STREAM_$NO_CONC_WRITE,
  565.                           sio_stream, status);
  566.          IF status.all = STATUS_$OK
  567.             THEN
  568.                sio_line_opened := TRUE
  569.             ELSE
  570.                BEGIN
  571.                sio_line_opened := FALSE;
  572.                WRITELN('Warning : unable to open stream to line ', sio_line:1);
  573.                RETURN;
  574.                END;
  575.          END
  576.       ELSE
  577.          sio_line_opened := TRUE;
  578.    IF sio_line_opened
  579.       THEN
  580.          BEGIN
  581.          SIO_$INQUIRE(sio_stream, SIO_$RAW, str_raw, status);
  582.          IF status.all = STATUS_$OK
  583.             THEN
  584.                SIO_$INQUIRE(sio_stream, SIO_$NO_ECHO, str_no_echo, status);
  585.          IF (status.all = SIO_$STREAM_NOT_SIO) AND (mode = host)
  586.             THEN
  587.                BEGIN
  588.                mode := local;
  589.                sio_line_opened := FALSE;
  590.                END
  591.             ELSE
  592.          IF status.all <> STATUS_$OK
  593.             THEN
  594.                BEGIN
  595.                WRITELN('Warning : unable to open stream to line ', sio_line:1);
  596.                STREAM_$CLOSE(sio_stream, status);
  597.                sio_line_opened := FALSE;
  598.                END;
  599.          END;
  600.    END; (* of open serial i/o line *)
  601.  
  602.  
  603.  
  604. (******************************************************************************)
  605. (*                                                                            *)
  606. (* THE FOLLOWING PROCEDURE WILL CLEAR THE statistics RECORD.                  *)
  607. (*                                                                            *)
  608. (******************************************************************************)
  609.  
  610. PROCEDURE clear_statistics;
  611.  
  612.    BEGIN
  613.    WITH statistics DO
  614.       BEGIN
  615.       filename := ' ';
  616.       namelength := 0;
  617.       totalpkts := 0;
  618.       numretries := 0;
  619.       charssent := 0;
  620.       charsrcvd := 0;
  621.       maxcharsinpkt := 0;
  622.       ovhdsent := 0;
  623.       ovhdrcvd := 0;
  624.       CAL_$GET_LOCAL_TIME(starttime);
  625.       stoptime := starttime;
  626.       collecting := FALSE;
  627.       completed := FALSE;
  628.       lastpktrep:=0;
  629.       lastretryrep:=0;
  630.       sincelast:=0; (* send_the_files & receive_some_files output initial header *)
  631.       END; (* of with *)
  632.    END; (* of clear statistics *)
  633.  
  634.  
  635.  
  636. (******************************************************************************)
  637. (*                                                                            *)
  638. (* THE FOLLOWING PROCEDURE WILL INITIALIZE THE VARIABLES                      *)
  639. (*                                                                            *)
  640. (******************************************************************************)
  641.  
  642. PROCEDURE initialize;
  643.  
  644.    VAR
  645.       index  : INTEGER;
  646.       ir_rec : stream_$ir_rec_t;
  647.       inquire_err_mask : stream_$inquire_mask_t;
  648.       status : STATUS_$T;
  649.  
  650.    BEGIN (* initialize *)
  651.    mymaxl := MAXPACKETLENGTH;
  652.    mytimeout := DEFAULT_mytimeout;
  653.    mynpad := 0;
  654.    mypadc := NUL;
  655.    myqctl := '#';
  656.    eight_bit := true;
  657.    IF eight_bit THEN
  658.       myqbin := '&'      (* I insist on quoting with this character *)
  659.      ELSE
  660.       myqbin := 'N';     (* don't want to quote *)
  661.    strip_parity :=true;  (* assume parity bit not available *)
  662.    myeol := CR;
  663.    chkt := 1;
  664.    myrept := '~';
  665.    rept := SP; (* flags "no repeating" *)
  666.    repeating:=false;
  667.  
  668.    theirmaxl := 80;
  669.    theirtimeout := DEFAULT_theirtimeout;
  670.    theirnpad := 0;
  671.    theirpadc := NUL;
  672.    theireol := CR;
  673.    theirqctl := '#';
  674.    theirqbin := '&';   {[2.8]}
  675.  
  676.    maxtries := DEFAULT_maxtries;
  677.    send_delay := DEFAULT_send_delay;
  678.    markchar := SOH;
  679.    normal:=true;
  680.  
  681.    state := START;
  682.    server_mode := FALSE;
  683.    take_mode := FALSE;
  684.  
  685.    numberoftries := 0;
  686.    currentpacket := MAXSEQUENCENUMBER;
  687.  
  688.    file_type := ascii;
  689.    transactname := ' ';
  690.    transactlength := 0;
  691.    logging.transactions := FALSE;
  692.    sessionname := ' ';
  693.    sessionlength := 0;
  694.    logging.session := FALSE;
  695.  
  696.    debug := FALSE;
  697.    sendservNAKs := TRUE;
  698.    local_echo := FALSE;
  699.    clear_statistics;
  700.  
  701.    (* empty the xmt and rcv buffers *)
  702.    xmtbuffer.data := ' ';
  703.    xmtbuffer.len := 0;
  704.    rcvbuffer.data := ' ';
  705.    rcvbuffer.len := 0;
  706.  
  707.    WITH strin_rec DO
  708.       BEGIN
  709.       size := 0;
  710.       index := 0;
  711.       currchar := NUL;
  712.       prevchar := NUL;
  713.       rcvdchar := FALSE;
  714.       END; (* of with *)
  715.    WITH strout_rec DO
  716.       BEGIN
  717.       size := 0;
  718.       index := 0;
  719.       currchar := NUL;
  720.       prevchar := NUL;
  721.       rcvdchar := FALSE;
  722.       END; (* of with *)
  723.  
  724.    WITH keybdin_rec DO
  725.       BEGIN
  726.       size := 0;
  727.       index := 0;
  728.       currchar := NUL;
  729.       prevchar := NUL;
  730.       rcvdchar := FALSE;
  731.       END; (* of with *)
  732.    WITH keybdout_rec DO
  733.       BEGIN
  734.       size := 0;
  735.       index := 0;
  736.       currchar := NUL;
  737.       prevchar := NUL;
  738.       rcvdchar := FALSE;
  739.       END; (* of with *)
  740.  
  741.    ucase:=['A'..'Z'];  (* this assumes ASCII *)
  742.    lcase:=['a'..'z'];
  743.    alpha:=lcase+ucase;
  744.    alphanum:=['0'..'9']+alpha;
  745.  
  746.    (* Obtain the initial status of the i/o lines so they may be reset on.     *)
  747.    (* Also, determine if Kermit is being run as a host or as a local version. *)
  748.    (* If run as a host, set sio_stream to STDIN (or STDOUT, they will be the  *)
  749.    (* same.  If run as a local Kermit, then first try to set sio_stream to    *)
  750.    (* line 2.  Note what type line driving program is - needed for "graphics" *)
  751.    (* and raw-mode calls.                                                     *)
  752.  
  753.    ir_rec.strid := stdin;
  754.    stream_$inquire ([stream_$otype],stream_$use_strid, ir_rec, inquire_err_mask, status);
  755.    IF status.all <> STATUS_$OK then
  756.        BEGIN
  757.        display_type := other_line;
  758.        (* guess it's local *)
  759.        mode := local;
  760.        END
  761.      ELSE
  762.        BEGIN
  763.        IF ir_rec.otype = sio_$uid THEN
  764.          { Kermit is being run as a remote host }
  765.          BEGIN
  766.          display_type := sio_line_type;
  767.          sio_stream := STDIN;
  768.          mode := host;
  769.          open_sio_line;
  770.          END
  771.         ELSE { assume Kermit is being run locally }
  772.          BEGIN
  773.          mode := local;
  774.          IF ir_rec.otype = input_pad_$uid THEN
  775.              BEGIN
  776.              display_type := display;
  777.              graphics := true;
  778.              END
  779.            ELSE
  780.              BEGIN
  781.              graphics := false;
  782.              IF ir_rec.otype = mbx_$uid THEN
  783.                  display_type := mbx_line
  784.                ELSE
  785.                  display_type := other_line;
  786.              END;
  787.          END;
  788.        END;
  789.    IF mode=local THEN
  790.        BEGIN
  791.        sio_line := 2; { assume we will be using line 2 }
  792.        sio_line_opened := FALSE;
  793.        END;
  794.    rawmode := (mode=local) AND (graphics OR (display_type = mbx_line));
  795.                (* could also apply to sio & display but not graphics if
  796.                   relevant code existed in connect *)
  797.    IF graphics THEN
  798.        escape_char := DEFAULT_escape_char
  799.      ELSE
  800.        escape_char := DEFAULT_alt_escape_char;
  801.    END; (* of initialize *)
  802.  
  803. (******************************************************************************)
  804. (*                                                                            *)
  805. (* THE FOLLOWING PROCEDURE WILL SIMPLY PRINT THE OPENING HEADER FOR KERMIT    *)
  806. (*                                                                            *)
  807. (******************************************************************************)
  808.  
  809. PROCEDURE printheader;
  810.  
  811.    VAR
  812.       clock : CAL_$TIMEDATE_REC_T;
  813.  
  814.    BEGIN (* print header *)
  815.    WRITE('Kermit-apollo APX ', version:versionlength, '     ');
  816.    CAL_$DECODE_LOCAL_TIME(clock);
  817.    CASE CAL_$WEEKDAY(clock.year, clock.month, clock.day) OF
  818.       CAL_$SUN : WRITE('Sunday, ');
  819.       CAL_$MON : WRITE('Monday, ');
  820.       CAL_$TUE : WRITE('Tuesday, ');
  821.       CAL_$WED : WRITE('Wednesday, ');
  822.       CAL_$THU : WRITE('Thursday, ');
  823.       CAL_$FRI : WRITE('Friday, ');
  824.       CAL_$SAT : WRITE('Saturday, ');
  825.       END; (* of case *)
  826.    CASE clock.month OF
  827.       1  : WRITE('January ');
  828.       2  : WRITE('February ');
  829.       3  : WRITE('March ');
  830.       4  : WRITE('April ');
  831.       5  : WRITE('May ');
  832.       6  : WRITE('June ');
  833.       7  : WRITE('July ');
  834.       8  : WRITE('August ');
  835.       9  : WRITE('September ');
  836.       10 : WRITE('October ');
  837.       11 : WRITE('November ');
  838.       12 : WRITE('December ');
  839.       END; (* of case *)
  840.    WRITE(clock.day:1, ', ', clock.year:4, '  ');
  841.    IF clock.hour > 12
  842.       THEN
  843.          WRITELN((clock.hour - 12):1, ':', clock.minute:1, ' PM')
  844.       ELSE
  845.          WRITELN(clock.hour:1, ':', clock.minute:1, ' AM');
  846.    END; (* of print header *)
  847.  
  848.  
  849.  
  850. (******************************************************************************)
  851. (*                                                                            *)
  852. (* THE FOLLOWING PROCEDURE WILL INITIALIZE THE EVENTCOUNT POINTERS TO THE     *)
  853. (* CURRENT EVENTCOUNTERS.                                                     *)
  854. (*                                                                            *)
  855. (******************************************************************************)
  856.  
  857. PROCEDURE initialize_eventpointers;
  858.  
  859.    BEGIN (* initialize eventpointers *)
  860.    STREAM_$GET_EC(STDIN, STREAM_$GETREC_EC_KEY, waitptrs[KEYBD_INDEX], status);
  861.    STREAM_$GET_EC(sio_stream, STREAM_$GETREC_EC_KEY, waitptrs[STRIN_INDEX], status);
  862.    TIME_$GET_EC(TIME_$CLOCKH_KEY, waitptrs[TIME_INDEX], status);
  863.    END; (* of initialize eventpointers *)
  864.  
  865.  
  866.  
  867. (******************************************************************************)
  868. (*                                                                            *)
  869. (* THE FOLLOWING FUNCTION TAKES AS INPUT A CHARACTER STRING WHICH CONTAINS A  *)
  870. (* NON-NEGATIVE INTEGER AND RETURNS THAT INTEGER.  IF THE CHARACTER STRING    *)
  871. (* DOES NOT CONTAIN A NON-NEGATIVE INTEGER, THEN -1 IS RETURNED.              *)
  872. (*                                                                            *)
  873. (******************************************************************************)
  874.  
  875. FUNCTION convert_to_int(token : STRING) : INTEGER;
  876.  
  877.    VAR
  878.       index : INTEGER;
  879.       temp  : INTEGER;
  880.  
  881.    BEGIN (* convert to integer *)
  882.    temp := 0;
  883.    index := 0;
  884.    WHILE index < 80 DO
  885.       BEGIN
  886.       index := index + 1;
  887.       IF NOT (token[index] IN ['0' .. '9'])
  888.          THEN
  889.             BEGIN
  890.             IF (token[index] = SP) AND (index > 1)
  891.                THEN
  892.                   EXIT
  893.                ELSE
  894.                   BEGIN
  895.                   temp := -1;
  896.                   EXIT;
  897.                   END;
  898.             END
  899.          ELSE
  900.             temp := (temp * 10) + (ORD(token[index]) - ORD('0'));
  901.       END; (* of while *)
  902.    convert_to_int := temp;
  903.    END; (* of convert to integer *)
  904.  
  905.  
  906.  
  907. (******************************************************************************)
  908. (*                                                                            *)
  909. (* THIS FUNCTION TRANSFORMS THE INTEGER x, WHICH IS ASSUMED TO LIE IN THE     *)
  910. (* RANGE 0 TO 94, INTO A PRINTABLE ASCII CHARACTER; 0 BECOMES SP, 1 BECOMES   *)
  911. (* "!", ETC.                                                                  *)
  912. (*                                                                            *)
  913. (******************************************************************************)
  914.  
  915. FUNCTION makechar(x : INTEGER) : CHAR;
  916.  
  917.    BEGIN (* char *)
  918.    makechar := CHR(x + 32);
  919.    END; (* of char *)
  920.  
  921.  
  922.  
  923. (******************************************************************************)
  924. (*                                                                            *)
  925. (* THIS FUNCTION TRANSFORMS THE CHARACTER x, WHICH IS ASSUMED TO BE IN THE    *)
  926. (* PRINTABLE RANGE (SP THROUTH '~', INTO AN INTEGER IN THE RANGE 0 TO 94.     *)
  927. (*                                                                            *)
  928. (******************************************************************************)
  929.  
  930. FUNCTION unchar(x : CHAR) : INTEGER;
  931.  
  932.    BEGIN (* unchar *)
  933.    unchar := ORD(x) - 32;
  934.    END; (* of unchar *)
  935.  
  936.  
  937.  
  938. (******************************************************************************)
  939. (*                                                                            *)
  940. (* THIS FUNCTION MAPS BETWEEN CONTROL CHARACTERS AND THEIR PRINTABLE          *)
  941. (* REPRESENTATIONS.                                                           *)
  942. (*                                                                            *)
  943. (******************************************************************************)
  944.  
  945. FUNCTION ctl(x : CHAR) : CHAR;
  946.  
  947.    BEGIN (* ctl *)
  948. {   IF (x < SP) OR (x = DEL)                     {[2.8]+ old way commented out}
  949. {      THEN
  950. {         ctl := CHR((ORD(x) + 64) MOD 128)
  951. {      ELSE
  952. {         ctl := CHR((ORD(x) - 64) MOD 128);
  953. {}
  954.    IF (x < CHR (64))
  955.       THEN
  956.          ctl := CHR((ORD(x) + 64))
  957.       ELSE
  958.          ctl := CHR((ORD(x) - 64));              {[2.8]-}
  959.    END; (* of ctl *)
  960.  
  961.  
  962.  
  963. (******************************************************************************)
  964. (*                                                                            *)
  965. (* THE FOLLOWING PROCEDURE WILL RETURN A CHECKSUM CHARACTER FOR THE STRING    *)
  966. (* packetstring, THE CHECKSUM COMPUTATION BEGINS AT THE first CHARACTER       *)
  967. (* AND ENDS AT THE last CHARACTER.                                            *)
  968. (*                                                                            *)
  969. (******************************************************************************)
  970.  
  971. FUNCTION checksum(packetstring : packetstrtyp;
  972.                   first        : INTEGER;
  973.                   last         : INTEGER) : CHAR;
  974.  
  975.    VAR
  976.       s     : INTEGER;
  977.       index : INTEGER;
  978.  
  979.    BEGIN (* checksum *)
  980.    s := 0;
  981.    FOR index := first TO last DO
  982.       s := s + ORD(packetstring[index]);
  983.    checksum := makechar((s + ((s & 8#300) DIV 8#100)) & 8#77);
  984.    END; (* of checksum *)
  985.  
  986.  
  987.  
  988. (******************************************************************************)
  989. (*                                                                            *)
  990. (* THE FOLLOWING PROCEDURE WILL RETURN THE NEXT CHARACTER RECEIVED FROM THE   *)
  991. (* CONNECTED KERMIT.                                                          *)
  992. (*                                                                            *)
  993. (******************************************************************************)
  994.  
  995. PROCEDURE getchar(VAR ch : CHAR);
  996.  
  997.    VAR
  998.       key    : STREAM_$SK_T;
  999.       status : STATUS_$T;
  1000.       wakeup : INTEGER;
  1001.  
  1002.    BEGIN (* getchar *)
  1003.    strin_rec.rcvdchar := false;
  1004.    strin_rec.timedout := false;
  1005.    IF strin_rec.index >= strin_rec.size
  1006.       THEN (* we have read everything in this buffer and need a new one *)
  1007.          BEGIN
  1008.          REPEAT
  1009.             waitvalues[STRIN_INDEX] := EC2_$READ(waitptrs[STRIN_INDEX]^);
  1010.             waitvalues[TIME_INDEX] := EC2_$READ(waitptrs[TIME_INDEX]^);
  1011.             STREAM_$GET_CONDITIONAL(sio_stream, ADDR(strin_rec.buffer),
  1012.                                     MAX_BUFFER_SIZE, strin_rec.ptr,
  1013.                                     strin_rec.size, key, status);
  1014.             IF status.all <> 0
  1015.                THEN
  1016.                   BEGIN
  1017.                   IF (status.subsys = stream_$subs) AND THEN
  1018.                      (status.code = stream_$end_of_file)
  1019.                      THEN
  1020.                         RETURN
  1021.                      ELSE
  1022.                         BEGIN
  1023.                         WRITELN('ERROR READING FROM INPUT STREAM ');
  1024.                         RETURN;
  1025.                         END;
  1026.                   END; (* of status.all *)
  1027.             strin_rec.index := 0;
  1028.             IF strin_rec.size = 0
  1029.                THEN
  1030.                   BEGIN
  1031.                   waitvalues[STRIN_INDEX] := waitvalues[STRIN_INDEX] + 1;
  1032.                   waitvalues[TIME_INDEX] := waitvalues[TIME_INDEX] +
  1033.                                             4 * theirtimeout; { ticks 1/4 sec }
  1034.                   wakeup := EC2_$WAIT(waitptrs[TIME_INDEX],
  1035.                                       waitvalues[TIME_INDEX], 2, status);
  1036.                   IF wakeup = TIME_INDEX
  1037.                      THEN
  1038.                         BEGIN
  1039.                         strin_rec.timedout := TRUE;
  1040.                         END
  1041.                      ELSE
  1042.                         BEGIN
  1043.                         getchar(ch);
  1044.                         RETURN;
  1045.                         END;
  1046.                   END;
  1047.             IF strin_rec.size < 0
  1048.                THEN (* stream has more to send, buffer overflow *)
  1049.                   BEGIN
  1050.                   strin_rec.size := MAX_BUFFER_SIZE;
  1051.                   END;
  1052.          UNTIL (strin_rec.size <> 0) OR strin_rec.timedout;
  1053.          END; (* of read another buffer *)
  1054.    IF NOT strin_rec.timedout
  1055.       THEN
  1056.          BEGIN
  1057.          strin_rec.index := strin_rec.index + 1;
  1058.          strin_rec.prevchar := strin_rec.currchar;
  1059.          strin_rec.currchar := strin_rec.ptr^[strin_rec.index];
  1060.          strin_rec.rcvdchar := true;
  1061.          ch := strin_rec.currchar;
  1062.          END;
  1063.  
  1064. (******************************************************************************)
  1065. (*                                                                            *)
  1066. (* THE FOLLOWING IF STATEMENT IS A CLUDGE TO STRIP THE PARITY BIT FROM        *)
  1067. (* RECEIVED CHARACTERS.                                                       *)
  1068. (*                                                                            *)
  1069. (******************************************************************************)
  1070.  
  1071.    IF strip_parity AND (ORD(ch) > 127) THEN ch := CHR(ORD(ch) - 128);
  1072.    RETURN;
  1073.    END; (* of getchar *)
  1074.  
  1075.  
  1076.  
  1077. (******************************************************************************)
  1078. (*                                                                            *)
  1079. (* THE FOLLOWING PROCEDURE WILL SEND THE PACKET POINTED TO BY thispacket out  *)
  1080. (* THE DOOR.                                                                  *)
  1081. (*                                                                            *)
  1082. (******************************************************************************)
  1083.  
  1084. PROCEDURE sendpacket(thispacket : INTEGER);
  1085.  
  1086.    VAR
  1087.       packetstring : packetstrtyp;
  1088.       index        : INTEGER;
  1089.       key          : STREAM_$SK_T;
  1090.       status       : STATUS_$T;
  1091.       size         : INTEGER32;
  1092.       report       : 0..2;
  1093.  
  1094.    BEGIN (* send packet*)
  1095.    WITH packet[thispacket] DO
  1096.       BEGIN
  1097.       packetstring[1] := mark;
  1098.       packetstring[2] := makechar(len);
  1099.       packetstring[3] := makechar(seq);
  1100.       CASE typ OF
  1101.          D : packetstring[4] := 'D';
  1102.          Y : packetstring[4] := 'Y';
  1103.          N : packetstring[4] := 'N';
  1104.          S : packetstring[4] := 'S';
  1105.          B : packetstring[4] := 'B';
  1106.          F : packetstring[4] := 'F';
  1107.          G : packetstring[4] := 'G';
  1108.          Z : packetstring[4] := 'Z';
  1109.          E : packetstring[4] := 'E';
  1110.          R : packetstring[4] := 'R';
  1111.       END; (* of case *)
  1112.       IF len > 3
  1113.          THEN
  1114.             FOR index := 1 TO len-3 DO
  1115.                BEGIN
  1116.                packetstring[4 + index] := data[index];
  1117.                IF file_type = ascii THEN {mask off the 8th bit of each char}
  1118.                   packetstring[4 + index] :=
  1119.                      CHR(ORD(packetstring[4 + index]) MOD 128);
  1120.                END;
  1121.       packetstring[len+2] := checksum(packetstring, 2, len+1);
  1122.       IF theirnpad > 0
  1123.          THEN
  1124.             BEGIN
  1125.             size := 1;
  1126.             FOR index := 1 TO theirnpad DO
  1127.                STREAM_$PUT_CHR(sio_stream, ADDR(theirpadc), size, key, status);
  1128.             END;
  1129.       size := len+2;
  1130.       STREAM_$PUT_CHR(sio_stream, ADDR(packetstring), size, key, status);
  1131.       size := 1;
  1132.       STREAM_$PUT_REC(sio_stream, ADDR(theireol), size, key, status);
  1133.       IF debug THEN WRITELN(debugfile, 'THIS WAS SENT              : ',
  1134.                                        packetstring:len+2);
  1135.       WITH statistics DO
  1136.          BEGIN
  1137.             IF collecting THEN
  1138.                BEGIN
  1139.                charssent := charssent + len + 3 + theirnpad;
  1140.                IF (len + 2) > maxcharsinpkt
  1141.                   THEN maxcharsinpkt := len + 2;
  1142.                IF typ = D
  1143.                   THEN ovhdsent := ovhdsent + theirnpad + 6
  1144.                   ELSE ovhdsent := ovhdsent + theirnpad + len + 3;
  1145.                END; (* of with *)
  1146.             IF mode = local
  1147.                THEN
  1148.                 IF graphics THEN
  1149.                   BEGIN
  1150.                   (* update display if either total has changed *)
  1151.                   IF totalpkts <> lastpktrep THEN
  1152.                      BEGIN
  1153.                      WRITELN(ESC, '[4;11H', statistics.totalpkts:1,
  1154.                           ESC, '[0K');
  1155.                      lastpktrep:=totalpkts;
  1156.                      END;
  1157.                   IF numretries<>lastretryrep THEN
  1158.                      BEGIN
  1159.                      WRITELN(ESC, '[5;11H', statistics.numretries:1,
  1160.                           ESC, '[0K');
  1161.                      lastretryrep:=numretries;
  1162.                      END;
  1163.                   END  (* of graphics *)
  1164.                 ELSE
  1165.                   BEGIN
  1166.                   report:=0;
  1167.                   (* report all retries and every packet_interval-th packet *)
  1168.                   IF numretries<>lastretryrep THEN
  1169.                       report:=2
  1170.                   ELSE IF (totalpkts=1) AND (lastpktrep<>1) THEN
  1171.                       report:=2
  1172.                   ELSE IF (totalpkts MOD packet_interval =0) AND
  1173.                      (lastpktrep<>totalpkts) THEN
  1174.                       report:=1;  (* packets only *)
  1175.                   IF report<>0 THEN       (* should be > but compiler generates
  1176.                                              warning *)
  1177.                       BEGIN
  1178.                       IF sincelast>=header_freq THEN
  1179.                           BEGIN
  1180.                           WRITELN('  packets   retries');
  1181.                           sincelast:=0;
  1182.                           report:=2;  (* show retries *)
  1183.                           END;
  1184.                       write(totalpkts:10);
  1185.                       lastpktrep:=totalpkts;
  1186.                       IF report=2 THEN
  1187.                           BEGIN
  1188.                           write(numretries:10);
  1189.                           lastretryrep:=numretries;
  1190.                           END;
  1191.                       writeln;
  1192.                       sincelast:=sincelast+1;
  1193.                       END;  (* report>0 *)
  1194.                   END  (* of not graphics *)
  1195.             END; (* of then *)
  1196.       END; (* of with *)
  1197.    END; (* of send packet *)
  1198.  
  1199.  
  1200.  
  1201. (******************************************************************************)
  1202. (*                                                                            *)
  1203. (* THE FOLLOWING PROCEDURE WAITS TO RECEIVE THE NEXT PACKET.  IF THE PACKET   *)
  1204. (* IS RECEIVED, IT IS BROKEN INTO THE VARIOUS packetrec FIELDS.  IF A         *)
  1205. (* TIMEOUT OCCURS, A TIMEOUT PACKET IS RETURNED.  THE PACKET IS RETURNED IN   *)
  1206. (* THE GLOBAL receivedpacket.                                                 *)
  1207. (*                                                                            *)
  1208. (******************************************************************************)
  1209.  
  1210. PROCEDURE receivepacket;
  1211.  
  1212.    VAR
  1213.       packetstring   : packetstrtyp;
  1214.       index          : INTEGER;
  1215.       packetreceived : BOOLEAN;
  1216.       SOHreceived    : BOOLEAN;
  1217.       ch             : CHAR;
  1218.       packetlength   : INTEGER;
  1219.       report         : 0..2;
  1220.  
  1221.    BEGIN (* receive packet *)
  1222.    packetreceived := FALSE;
  1223.    SOHreceived := FALSE;
  1224.    index := 0;
  1225.    REPEAT
  1226.       getchar(ch);
  1227.       IF strin_rec.timedout
  1228.          THEN
  1229.             BEGIN
  1230.             WITH receivedpacket DO
  1231.                BEGIN
  1232.                mark := MARKCHAR;
  1233.                len := 0;
  1234.                seq := 0;
  1235.                typ := Timeout;
  1236.                data := ' ';
  1237.                check := makechar(0);
  1238.                END; (* of with *)
  1239.             RETURN;
  1240.             END; (* of if timedout *)
  1241.       IF ch = MARKCHAR
  1242.          THEN
  1243.             BEGIN
  1244.             SOHreceived := TRUE;
  1245.             index := 1;
  1246.             packetstring[index] := ch;
  1247.             END
  1248.          ELSE
  1249.             BEGIN
  1250.             IF SOHreceived
  1251.                THEN
  1252.                   BEGIN
  1253.                   index := index + 1;
  1254.                   packetstring[index] := ch;
  1255.                   IF index = 2
  1256.                      THEN
  1257.                         packetlength := unchar(ch)
  1258.                      ELSE
  1259.                         BEGIN
  1260.                         IF index = packetlength + 2
  1261.                            THEN packetreceived := TRUE;
  1262.                         END;
  1263.                   END;
  1264.             END;
  1265.       IF statistics.collecting
  1266.          THEN statistics.charsrcvd := statistics.charsrcvd + 1;
  1267.    UNTIL packetreceived;
  1268.    WITH receivedpacket DO
  1269.       BEGIN
  1270.       mark := packetstring[1];
  1271.       len := unchar(packetstring[2]);
  1272.       seq := unchar(packetstring[3]);
  1273.       CASE packetstring[4] OF
  1274.          'D' : typ := D;
  1275.          'Y' : typ := Y;
  1276.          'N' : typ := N;
  1277.          'S' : typ := S;
  1278.          'B' : typ := B;
  1279.          'F' : typ := F;
  1280.          'Z' : typ := Z;
  1281.          'R' : typ := R;
  1282.          'G' : typ := G;
  1283.          OTHERWISE typ := E;
  1284.       END; (* of case *)
  1285.       data := ' ';
  1286.       IF len > 3
  1287.          THEN
  1288.             FOR index := 5 TO len+1 DO
  1289.                data[index-4] := packetstring[index];
  1290.       IF debug THEN WRITELN(debugfile, 'THIS WAS RECEIVED : ',
  1291.                                         packetstring:len+2);
  1292.       IF (mode=local) AND (packetstring[4]='E') THEN
  1293.           BEGIN
  1294.           (* Display remote Kermit's error message *)
  1295.           writeln('Error from remote Kermit:');
  1296.           writeln(' ':3,data:len-3);
  1297.           END;
  1298.       check := checksum(packetstring, 2, len+1);
  1299.       IF check <> packetstring[len+2]
  1300.          THEN
  1301.             BEGIN
  1302.             IF debug THEN WRITELN(debugfile, 'CHECKSUM ERROR');
  1303.             typ := Checksum_error;
  1304.             END;
  1305.       IF (file_type = ascii) AND (len > 3) THEN {mask off the 8th bit of chr's}
  1306.          FOR index := 1 to len-3 DO
  1307.             data[index] := CHR(ORD(data[index]) MOD 128);
  1308.       WITH statistics DO
  1309.          BEGIN
  1310.             IF collecting THEN
  1311.                BEGIN
  1312.                IF (len + 2) > maxcharsinpkt
  1313.                   THEN maxcharsinpkt := len + 2;
  1314.                IF typ = D
  1315.                   THEN ovhdrcvd := ovhdrcvd + theirnpad + 6
  1316.                   ELSE ovhdrcvd := ovhdrcvd + theirnpad + len + 3;
  1317.                END; (* of with *)
  1318.             IF mode = local
  1319.                THEN
  1320.                 IF graphics THEN
  1321.                  BEGIN
  1322.                   (* update display if either total has changed *)
  1323.                   IF totalpkts <> lastpktrep THEN
  1324.                      BEGIN
  1325.                      WRITELN(ESC, '[4;11H', statistics.totalpkts:1,
  1326.                           ESC, '[0K');
  1327.                      lastpktrep:=totalpkts;
  1328.                      END;
  1329.                   IF numretries<>lastretryrep THEN
  1330.                      BEGIN
  1331.                      WRITELN(ESC, '[5;11H', statistics.numretries:1,
  1332.                           ESC, '[0K');
  1333.                      lastretryrep:=numretries;
  1334.                      END;
  1335.                   END  (* of graphics *)
  1336.                 ELSE
  1337.                   BEGIN
  1338.                   report:=0;
  1339.                   (* report all retries and every packet_interval-th packet *)
  1340.                   IF numretries<>lastretryrep THEN
  1341.                       report:=2
  1342.                   ELSE IF (totalpkts=1) AND (lastpktrep<>1) THEN
  1343.                       report:=2
  1344.                   ELSE IF (totalpkts MOD packet_interval =0) AND
  1345.                      (lastpktrep<>totalpkts) THEN
  1346.                       report:=1;  (* packets only *)
  1347.                   IF report<>0 THEN       (* should be > but compiler generates
  1348.                                              warning *)
  1349.                       BEGIN
  1350.                       IF sincelast>=header_freq THEN
  1351.                           BEGIN
  1352.                           WRITELN('  packets   retries');
  1353.                           sincelast:=0;
  1354.                           report:=2;  (* show retries *)
  1355.                           END;
  1356.                       write(totalpkts:10);
  1357.                       lastpktrep:=totalpkts;
  1358.                       IF report=2 THEN
  1359.                           BEGIN
  1360.                           write(numretries:10);
  1361.                           lastretryrep:=numretries;
  1362.                           END;
  1363.                       writeln;
  1364.                       sincelast:=sincelast+1;
  1365.                       END;  (* report>0 *)
  1366.                   END  (* of not graphics *)
  1367.             END; (* of then *)
  1368.       END; (* of with *)
  1369.    END; (* of receive packet *)
  1370.  
  1371.  
  1372.  
  1373. (******************************************************************************)
  1374. (*                                                                            *)
  1375. (* THE FOLLOWING FUNCTION RETURNS A BOOLEAN VALUE SIGNALLING THE RECEPTION    *)
  1376. (* OF AN ACK PACKET.  THE FUNCTION WILL ONLY RETURN TRUE IF THE NEXT PACKET   *)
  1377. (* RECEIVED IS A GOOD ACK.  IF THE NEXT PACKET IS NOT AN ACK, IS A NAK, OR    *)
  1378. (* NOTHING IS RECEIVED WITHIN THE TIMEOUT PERIOD, THEN THE FUNCTION RETURNS   *)
  1379. (* FALSE.                                                                     *)
  1380. (*                                                                            *)
  1381. (* NOTE : RECEIVING A NAK FOR THE NEXT PACKET IS THE SAME AS RECEIVING AN ACK *)
  1382. (*        FOR THE CURRENT PACKET.                                             *)
  1383. (*                                                                            *)
  1384. (******************************************************************************)
  1385.  
  1386. FUNCTION receivedACK : BOOLEAN;
  1387.  
  1388.    BEGIN (* received ACK *)
  1389.    receivedACK := FALSE; { assume that we are not successful }
  1390.    receivepacket;
  1391.    IF ((receivedpacket.typ = Y) AND (receivedpacket.seq = currentpacket)) OR
  1392.       ((receivedpacket.typ = N) AND (receivedpacket.seq = currentpacket+1))
  1393.       THEN
  1394.          receivedACK := TRUE;
  1395.    END; (* of receivedACK *)
  1396.  
  1397.  
  1398.  
  1399. (******************************************************************************)
  1400. (*                                                                            *)
  1401. (* THE FOLLOWING FUNCTION RETURNS AN ACK FOR THE MOST RECENTLY RECEIVED       *)
  1402. (* PACKET, IE. THE PACKET IN receivedpacket.                                  *)
  1403. (*                                                                            *)
  1404. (******************************************************************************)
  1405.  
  1406. PROCEDURE sendACK;
  1407.  
  1408.    VAR
  1409.       thispacket : INTEGER;
  1410.  
  1411.    BEGIN (* send ACK *)
  1412.    thispacket := receivedpacket.seq;
  1413.    WITH packet[thispacket] DO
  1414.       BEGIN
  1415.       mark := markchar;
  1416.       typ := Y;
  1417.       len := 3;
  1418.       data := ' ';
  1419.       seq := thispacket;
  1420.       END; (* of with *)
  1421.    sendpacket(thispacket);
  1422.    END; (* of send ACK *)
  1423.  
  1424.  
  1425.  
  1426. (******************************************************************************)
  1427. (*                                                                            *)
  1428. (* THE FOLLOWING PROCEDURE RETURNS A NAK FOR currentpacket.                   *)
  1429. (*                                                                            *)
  1430. (******************************************************************************)
  1431.  
  1432. PROCEDURE sendNAK;
  1433.  
  1434.    BEGIN (* send NAK *)
  1435.    WITH packet[currentpacket] DO
  1436.       BEGIN
  1437.       mark := markchar;
  1438.       typ := N;
  1439.       len := 3;
  1440.       data := ' ';
  1441.       seq := currentpacket;
  1442.       END; (* of with *)
  1443.    sendpacket(currentpacket);
  1444.    END; (* of send NAK *)
  1445.  
  1446.  
  1447.  
  1448. (******************************************************************************)
  1449. (*                                                                            *)
  1450. (* THE FOLLOWING PROCEDURE WILL SEND AN ERROR PACKET TO THE CONNECTED KERMIT  *)
  1451. (* WITH THE CORRESPONDING ERROR MESSAGE.                                      *)
  1452. (*                                                                            *)
  1453. (******************************************************************************)
  1454.  
  1455. PROCEDURE senderror(message : databuffer;
  1456.                     messlen : INTEGER);
  1457.  
  1458.    BEGIN (* send error *)
  1459.    WITH packet[currentpacket] DO
  1460.       BEGIN
  1461.       mark := markchar;
  1462.       len := messlen + 3;
  1463.       seq := currentpacket;
  1464.       typ := E;
  1465.       data := message;
  1466.       END; (* of with *)
  1467.    sendpacket(currentpacket);
  1468.    END; (* of send error *)
  1469.  
  1470.  
  1471. (******************************************************************************)
  1472. (*                                                                            *)
  1473. (* THE FOLLOWING PROCEDURE WILL FILL THE xmtfile's buffer WITH INPUT FROM THE *)
  1474. (* FILE, TAKING CARE OF CONTROL, 8 BIT AND REPEAT QUOTING AS IT GOES.         *)
  1475. (*                                                                            *)
  1476. (******************************************************************************)
  1477.  
  1478. PROCEDURE fillxmtbuffer;
  1479.  
  1480.    VAR
  1481.       index    : INTEGER;
  1482.       repcount : INTEGER;
  1483.       chlen    : INTEGER;  (* no. bytes needed to encode current chara. *)
  1484.       ch       : CHAR;     (* chara being processed *)
  1485.       save     : CHAR;     (* chara repeat count refers to. *)
  1486.       retlen   : INTEGER32;
  1487.       gbbuff   : ARRAY[1..1] OF CHAR; (* see comment on getbuf call *)
  1488.  
  1489.  
  1490.   PROCEDURE chartobuffer(ch:CHAR);
  1491.  
  1492.    BEGIN
  1493.    IF quoting8 AND ( ORD (ch) > 127 )          {[2.8]+ mod. 2.8a}
  1494.       THEN
  1495.          WITH xmtbuffer DO
  1496.             BEGIN
  1497.             data [len+1] := theirqbin;
  1498.             len := len + 1;
  1499.             chlen:=1;
  1500.             ch := CHR (ORD (ch) MOD 128);
  1501.             END                                       {[2.8]-}
  1502.       ELSE
  1503.          BEGIN
  1504.          chlen:=0;
  1505.          IF strip_parity THEN
  1506.             ch := CHR (ORD (ch) MOD 128);
  1507.          END;
  1508.    IF (ch < SP) OR (ch = DEL) OR (ch = theirqctl) OR (repeating AND (ch = rept)) OR
  1509.       (quoting8 AND (ch=theirqbin))
  1510.       THEN
  1511.          BEGIN
  1512.          WITH xmtbuffer DO
  1513.             BEGIN
  1514.                data[len+1] := theirqctl;
  1515.                IF (ch = theirqctl) OR (ch=rept) OR (ch=theirqbin)
  1516.                   THEN
  1517.                      data[len+2] := ch
  1518.                   ELSE
  1519.                      data[len+2] := ctl(ch);
  1520.                len := len + 2;
  1521.                chlen := chlen + 2;
  1522.                END; (* of with *)
  1523.          END (* of then *)
  1524.       ELSE
  1525.          BEGIN
  1526.          WITH xmtbuffer DO
  1527.             BEGIN
  1528.             data[len+1] := ch;
  1529.             len := len + 1;
  1530.             chlen := chlen + 1;
  1531.             END; (* of with *)
  1532.          END; (* of else *)
  1533.   END; (* of chartobuffer *)
  1534.  
  1535.   PROCEDURE repeatfill;
  1536.  
  1537.   BEGIN
  1538.   IF repeating AND (chlen+2<repcount*chlen) THEN (* repeat whenever it's more
  1539.                                                     efficient *)
  1540.       WITH xmtbuffer DO
  1541.         BEGIN
  1542.         len:=len-chlen; (* one copy already added to buffer *)
  1543.         data[len+1]:=rept;
  1544.         data[len+2]:=makechar(repcount);
  1545.         len:=len+2;
  1546.         chartobuffer(save);
  1547.         END
  1548.     ELSE
  1549.       FOR index:=2 TO repcount DO (* one copy already added to buffer *)
  1550.         chartobuffer(save);
  1551.   repcount:=0;
  1552.   END; (* of repeatfill *)
  1553.  
  1554.    BEGIN (* fill xmt buffer *)
  1555.    FOR index := 1 TO MAXDATALENGTH DO
  1556.       xmtbuffer.data[index] := SP;
  1557.    xmtbuffer.len := 0;
  1558.    repcount:=0;
  1559.    IF NOT xmt_eof
  1560.    THEN
  1561.      REPEAT
  1562.        IF xmt_eoln THEN
  1563.           WITH xmtbuffer DO
  1564.              BEGIN
  1565.              data[len+1] := theirqctl;
  1566.              data[len+2] := ctl(CR);
  1567.              data[len+3] := theirqctl;
  1568.              data[len+4] := ctl(LF);
  1569.              len := len + 4;
  1570.              xmt_eoln := false;
  1571.              END  (* of with and of xmt_eoln *)
  1572.           ELSE
  1573.              BEGIN
  1574.              (* was ADDR(ch), but gave problems on 1 particular file *)
  1575.              getbuf (xmtid, ADDR (gbbuff), 1, retlen, xmt_eof);
  1576.              ch:=gbbuff[1];
  1577.              IF retlen = 0
  1578.                 THEN
  1579.                    BEGIN
  1580.                    (* end-of-file *)
  1581.                    repeatfill; (* handle any outstanding charas *)
  1582.                    IF (xmtbuffer.len <> 0) AND (file_type = ascii)
  1583.                                 (* should be > but compiler generates warning *)
  1584.                      THEN
  1585.                         xmt_eoln := true; (* leave to next iteration in case
  1586.                                              no more room in buffer *)
  1587.                    END
  1588.                 ELSE IF (ch=LF) AND (file_type = ascii) THEN
  1589.                    BEGIN
  1590.                    (* end-of-line *)
  1591.                    repeatfill; (* handle any outstanding charas *)
  1592.                    xmt_eoln := true;
  1593.                    END
  1594.                 ELSE
  1595.                    BEGIN
  1596.                    (* encode ch *)
  1597.                    IF NOT repeating THEN
  1598.                       chartobuffer(ch)
  1599.                    ELSE IF (repcount>0) AND (repcount<94) AND (ch = save) THEN
  1600.                       (* can't encode numbers above 94 *)
  1601.                       repcount:=repcount+1
  1602.                    ELSE
  1603.                       BEGIN
  1604.                       IF repcount>0 THEN
  1605.                           repeatfill;
  1606.                       chartobuffer(ch); (* put one copy in buffer *)
  1607.                       save:=ch;
  1608.                       repcount:=1;
  1609.                       END;
  1610.                   END; (* of encode ch *)
  1611.             END; (* of NOT xmt_eoln *)
  1612.    UNTIL xmt_eof OR (xmtbuffer.len >= theirmaxl-9); (* 3 bytes packet overhead, up
  1613.                                                       to 5 (~n&#x) for a chara *)
  1614.    END; (* of fill xmt buffer *)
  1615.  
  1616.  
  1617.  
  1618. (******************************************************************************)
  1619. (*                                                                            *)
  1620. (* THE FOLLOWING PROCEDURE WILL FILL THE rcvfile's buffer WITH THE DATA       *)
  1621. (* IN receivedpacket.  IF THE buffer BECOMES FULL OR A CR-LF SEQUENCE IS      *)
  1622. (* ENCOUNTERED, THEN THE BUFFER IS WRITTEN TO rcvfile.                        *)
  1623. (*                                                                            *)
  1624. (******************************************************************************)
  1625.  
  1626. PROCEDURE fillrcvbuffer;
  1627.  
  1628.    VAR
  1629.       index    : INTEGER;
  1630.       i        : INTEGER;
  1631.       repcount : INTEGER;
  1632.       bit8     : BOOLEAN;                                        {[2.8]}
  1633.       chara    : CHAR;
  1634.  
  1635.  BEGIN (* fill rcv buffer *)
  1636.    index := 0;
  1637.    repcount:=1; (* one occurrence of each chara unless flagged *)
  1638.    WHILE index < receivedpacket.len-3 DO
  1639.       BEGIN
  1640.       index := index + 1;
  1641.       bit8 := false;                                             {[2.8]}
  1642.       chara := receivedpacket.data[index];
  1643.       IF repeating AND (chara = rept) THEN
  1644.           BEGIN
  1645.           index := index+1;
  1646.           repcount := unchar(receivedpacket.data[index]);
  1647.           END
  1648.         ELSE
  1649.           BEGIN
  1650.           IF quoting8 AND (chara = myqbin) THEN
  1651.             BEGIN
  1652.             bit8 := true;
  1653.             index := index + 1;
  1654.             chara := receivedpacket.data[index];
  1655.             END;
  1656.           IF chara = myqctl THEN
  1657.             BEGIN
  1658.             index := index + 1;
  1659.             chara := receivedpacket.data[index];
  1660.             IF (chara = ctl(LF)) AND (NOT bit8)
  1661.                THEN
  1662.                   BEGIN
  1663.                   chara := LF;
  1664.                   (* preceded by CR ? *)
  1665.                   IF (file_type = ascii) AND (rcvbuffer.len<>0)
  1666.                                (* should be > but compiler generates warning *)
  1667.                      THEN
  1668.                         IF rcvbuffer.data[rcvbuffer.len] = CR
  1669.                            THEN
  1670.                                BEGIN
  1671. (*                               IF rcvbuffer.len = 1                   -2.8a *)
  1672. (*                                  THEN                                -2.8a *)
  1673. (*                                     WRITELN(rcvfile)                 -2.8a *)
  1674. (*                                  ELSE                                -2.8a *)
  1675. (*                                     WRITELN(rcvfile,                 -2.8a *)
  1676. (*                                     rcvbuffer.data:rcvbuffer.len-1); -2.8a *)
  1677.                                rcvbuffer.data[rcvbuffer.len] := LF;  (* +2.8a *)
  1678.                                putbuf (rcvid, ADDR(rcvbuffer.data),
  1679.                                         rcvbuffer.len);              (* +2.8a *)
  1680.                                rcvbuffer.len := 0;
  1681.                                repcount := repcount-1;
  1682.                                END
  1683.                   END
  1684.             ELSE IF (chara <> myqctl) AND (chara <> rept) AND (chara <> myqbin)
  1685.                      THEN
  1686.                        chara := ctl(chara);
  1687.             END; (* controlled chara. *)
  1688.           IF bit8 THEN
  1689.               chara := CHR( ORD(chara)+128 );
  1690.           FOR i := 1 TO repcount DO
  1691.               BEGIN
  1692.               IF rcvbuffer.len = MAX_BUFFER_SIZE
  1693.                 THEN
  1694.                   BEGIN
  1695. (*                WRITE(rcvfile, rcvbuffer.data:rcvbuffer.len);      -2.8a *)
  1696.                   putbuf (rcvid, ADDR(rcvbuffer.data), rcvbuffer.len); (* +2.8a *)
  1697.                   rcvbuffer.len := 0;
  1698.                   END;
  1699.               rcvbuffer.len := rcvbuffer.len + 1;
  1700.               rcvbuffer.data[rcvbuffer.len] := chara;
  1701.               END;
  1702.           repcount:=1;
  1703.           END; (* chara <> rept *)
  1704.       END; (* of while *)
  1705.    END; (* of fill rcv buffer *)
  1706.  
  1707.  
  1708.  
  1709. (******************************************************************************)
  1710. (*                                                                            *)
  1711. (* THE FOLLOWING PROCEDURE WILL PROCESS THE PARAMETERS CONTAINED IN THE data  *)
  1712. (* FIELD OF receivedpacket, WHICH SHOULD BE AN S PACKET OR AN ACK FOR AN S    *)
  1713. (* PACKET.                                                                    *)
  1714. (*                                                                            *)
  1715. (******************************************************************************)
  1716.  
  1717. PROCEDURE processparams;
  1718.  
  1719.    BEGIN (* process parameters *)
  1720.    WITH receivedpacket DO
  1721.       BEGIN
  1722.       theirmaxl := unchar(data[1]);
  1723.       theirtimeout := unchar(data[2]);
  1724.       theirnpad := unchar(data[3]);
  1725.       theirpadc := ctl(data[4]);
  1726.       theireol := CR; (* CR is the default *)
  1727.       IF len >= 8
  1728.          THEN
  1729.             IF data[5] <> SP
  1730.                THEN
  1731.                   theireol := CHR(unchar(data[5]));
  1732.       theirqctl := '#'; (* # is the default *)
  1733.       IF len >= 9
  1734.          THEN
  1735.             IF data[6] <> SP
  1736.                THEN
  1737.                   theirqctl := data[6];
  1738.       quoting8 :=  false;  (* No quoting until agreed *)
  1739.       theirqbin := 'N';
  1740.       IF (len >= 10) AND (eight_bit)
  1741.          THEN
  1742.             IF (data[7] = SP) OR (data[7] = 'N')
  1743.                THEN
  1744.                   theirqbin := 'N'
  1745.                   (* and quoting8 stays false *)
  1746.                ELSE
  1747.                   BEGIN
  1748.                   quoting8 := true;
  1749.                   IF data[7] = 'Y'
  1750.                      THEN
  1751.                         theirqbin := myqbin
  1752.                      ELSE
  1753.                         theirqbin := data[7];           {[2.8]-}
  1754.                   END;
  1755.       (* [8] is chkt - I can only do 1 *)
  1756.       rept := SP;
  1757.       repeating := false;
  1758.       IF len >= 12
  1759.          THEN
  1760.             BEGIN
  1761.             rept := data[9];
  1762.             IF (rept = myrept) AND (myrept <> SP)
  1763.                THEN
  1764.                   repeating := true
  1765.                ELSE
  1766.                  rept := SP;
  1767.                  (* and repeating stays false *)
  1768.             END;
  1769.       END; (* of with *)
  1770.    END; (* of process parameters *)
  1771.  
  1772.  
  1773.  
  1774. (******************************************************************************)
  1775. (*                                                                            *)
  1776. (* THE FOLLOWING PROCEDURE WILL LOG THE MOST RECENT TRANSACTION INTO THE LOG  *)
  1777. (* FILE.                                                                      *)
  1778. (*                                                                            *)
  1779. (******************************************************************************)
  1780.  
  1781. PROCEDURE log_transaction;
  1782.  
  1783.    VAR
  1784.       clock         : CAL_$TIMEDATE_REC_T;
  1785.       total_time    : TIME_$CLOCK_T;
  1786.       total_seconds : INTEGER32;
  1787.  
  1788.    BEGIN (* log transaction *)
  1789.    IF debug THEN WRITELN(debugfile, 'Entering log_transaction');
  1790.    IF logging.transactions
  1791.       THEN
  1792.          BEGIN
  1793.          WITH statistics DO
  1794.             BEGIN
  1795.             WRITELN(transactfile);
  1796.             WRITELN(transactfile, 'Statistics on most recent file ',
  1797.                     'transferred :');
  1798.             WRITELN(transactfile);
  1799.             CAL_$DECODE_TIME(starttime, clock);
  1800.             WRITELN(transactfile, '   Starting Time                : ',
  1801.                     clock.hour:1, ':', clock.minute:1);
  1802.             CAL_$DECODE_TIME(stoptime, clock);
  1803.             WRITELN(transactfile, '   Ending Time                  : ',
  1804.                     clock.hour:1, ':', clock.minute:1);
  1805.             total_time := stoptime;
  1806.             IF CAL_$SUB_CLOCK(total_time, starttime)
  1807.                THEN
  1808.                   BEGIN
  1809.                   total_seconds := CAL_$CLOCK_TO_SEC(total_time);
  1810.                   WRITELN(transactfile, '   Total time                   : ',
  1811.                           total_seconds:1, ' seconds');
  1812.                   END;
  1813.             WRITELN(transactfile, '   Total characters transmitted : ',
  1814.                     (charssent + charsrcvd):1);
  1815.             WRITELN(transactfile, '      Characters sent           : ',
  1816.                     charssent:1);
  1817.             WRITELN(transactfile, '      Characters received       : ',
  1818.                     charsrcvd:1);
  1819.             WRITELN(transactfile, '      Maximum in one packet     : ',
  1820.                     maxcharsinpkt:1);
  1821.             WRITELN(transactfile, '   Overhead characters sent     : ',
  1822.                     ovhdsent:1);
  1823.             WRITELN(transactfile, '   Overhead characters received : ',
  1824.                     ovhdrcvd:1);
  1825.             IF charssent + charsrcvd = 0
  1826.                THEN
  1827.                   WRITELN(transactfile, '0.00%')
  1828.                ELSE
  1829.                   WRITELN(transactfile, (((ovhdsent+ovhdrcvd) /
  1830.                          (charssent+charsrcvd))*100):6:2,
  1831.                          '%');
  1832.             WRITE(transactfile, '   Baud-rate                    : ');
  1833.             IF total_seconds = 0
  1834.                THEN
  1835.                   WRITELN(transactfile, 'Not determined')
  1836.                ELSE
  1837.                   WRITELN(transactfile, ((charssent+charsrcvd) DIV
  1838.                         total_seconds)*10:1);
  1839.             WRITE(transactfile, '   Effective baud-rate          : ');
  1840.             IF total_seconds = 0
  1841.                THEN
  1842.                   WRITELN(transactfile, 'Not determined')
  1843.                ELSE
  1844.                   WRITELN(transactfile, ((charssent+charsrcvd-
  1845.                           ovhdsent-ovhdrcvd) DIV
  1846.                           total_seconds)*10:1);
  1847.             WRITELN(transactfile);
  1848.             END; (* of with *)
  1849.          END;
  1850.    END; (* of log transaction *)
  1851.  
  1852. (******************************************************************************)
  1853. (*                                                                            *)
  1854. (* THE FOLLOWING PROCEDURE CONVERTS APOLLO FILE NAMES TO KERMIT NORMALISED    *)
  1855. (* FORM, AND RECEIVED NAMES INTO LEGAL APOLLO NAMES. KERMIT NORMAL FORM IS    *)
  1856. (* alphanumerics.alphanumerics (NO LENGTH LIMIT). APOLLO NAMES CONTAIN        *)
  1857. (* ALPHANUMERICS, DOLLARS,UNDERLINES AND DOTS STARTING WITH ALPHA OR DOLLAR   *)
  1858. (* AND UP TO 32 CHARAS. THE PROCEDURE REMOVES DIRECTORY PATHNAMES FROM APOLLO *)
  1859. (* FILE NAMES.                                                                *)
  1860. (*                                                                            *)
  1861. (******************************************************************************)
  1862.  
  1863. PROCEDURE hashfile(rawname:databuffer;rawlength:INTEGER;VAR hashname:databuffer;
  1864.                    VAR hashlength:INTEGER; sending:BOOLEAN);
  1865.  
  1866. VAR legalchars:SET OF CHAR;
  1867.     tempname:databuffer;
  1868.     slashpos,dotpos,i,hlen,templen:INTEGER;
  1869.     ch:CHAR;
  1870.  
  1871. BEGIN
  1872. hashname:=' ';
  1873. IF normal THEN
  1874.     (* hashing wanted *)
  1875.     BEGIN
  1876.     legalchars:=alphanum+['.'];
  1877.     IF NOT sending THEN
  1878.         legalchars:=legalchars+['$','_'];
  1879.     (* copy all legal chars [+ surplus dots] & note posn. of last slash *)
  1880.     templen:=0;
  1881.     tempname:=' ';
  1882.     slashpos:=1;  (* points to first chara after *)
  1883.     FOR i:=1 TO rawlength DO
  1884.       BEGIN
  1885.       ch:=rawname[i];
  1886.       IF ch IN legalchars THEN
  1887.           BEGIN
  1888.           templen:=templen+1;
  1889.           tempname[templen]:=ch;
  1890.           END
  1891.       ELSE IF (ch='/') OR (ch='\') THEN
  1892.           slashpos:=templen+1;
  1893.       END;
  1894.     (* check that what we now have is legal and non-empty. Redefine legalchars to legal
  1895.       first characters *)
  1896.     legalchars:=alpha;
  1897.     IF NOT sending THEN
  1898.         legalchars:=legalchars+['$'];
  1899.     REPEAT (* first for [slashpos..templen] , then if nec. whole name *)
  1900.       IF slashpos>templen THEN
  1901.           slashpos:=1;  (* no legals in last element, use whole name *)
  1902.       IF sending THEN
  1903.           (* check last chara not a dot *)
  1904.           WHILE (slashpos<=templen) AND (tempname[templen]='.') DO
  1905.             templen:=templen-1;
  1906.       (* check 1st *)
  1907.       WHILE (slashpos<=templen) AND NOT (tempname[slashpos] IN legalchars) DO
  1908.         slashpos:=slashpos+1;
  1909.     UNTIL (slashpos<=templen) OR (templen=0);
  1910.     IF templen>0 THEN
  1911.         BEGIN
  1912.         (* If sending, copy without dots to hashname, mark last dot posn. and insert
  1913.            afterwards. If receiving copy everything up to 32 charas *)
  1914.         hlen:=0;
  1915.         dotpos:=0;
  1916.         FOR i:=slashpos TO templen DO
  1917.           IF sending AND (tempname[i]='.') THEN
  1918.               dotpos:=hlen+1
  1919.           ELSE IF sending OR (hlen<32) THEN
  1920.               BEGIN
  1921.               hlen:=hlen+1;
  1922.               hashname[hlen]:=tempname[i];
  1923.               END;
  1924.           IF dotpos>0 THEN
  1925.               BEGIN
  1926.               FOR i:=hlen DOWNTO dotpos DO
  1927.                 hashname[i+1]:=hashname[i];
  1928.               hashname[dotpos]:='.';
  1929.               hlen:=hlen+1;
  1930.               END;
  1931.         END;  (* of templen>0 *)
  1932.     END;  (* of normal *)
  1933. IF (NOT normal) OR (templen=0) THEN
  1934.     (* use supplied filename and suffer any consequences *)
  1935.     BEGIN
  1936.     hlen:=rawlength;
  1937.     hashname:=rawname;
  1938.     END;
  1939. (* If receiving, put in lower case *)
  1940. IF normal AND (NOT sending) THEN
  1941.     FOR i:=1 TO hlen DO
  1942.       IF hashname[i] IN ucase THEN
  1943.           hashname[i] := chr( ord(hashname[i]) +32); (* assumes ASCII *)
  1944. hashlength:=hlen;
  1945. END;  (* of hashfile *)
  1946.  
  1947.  
  1948. (******************************************************************************)
  1949. (*                                                                            *)
  1950. (* THE FOLLOWING PROCEDURE WILL FILL data WITH THE INITIAL CONNECTION DATA    *)
  1951. (* AS OUTLINED IN THE KERMIT PROTOCOL MANUAL.  THE FUNCTION RETURNS THE       *)
  1952. (* LENTH OF THE DATA.                                                         *)
  1953. (*                                                                            *)
  1954. (******************************************************************************)
  1955.  
  1956. FUNCTION createsendinitdata(VAR data : databuffer) : INTEGER;
  1957.  
  1958.    VAR
  1959.       index : INTEGER;
  1960.  
  1961.    BEGIN (* create send-init data *)
  1962.    data[1] := makechar(mymaxl);
  1963.    data[2] := makechar(mytimeout);
  1964.    data[3] := makechar(mynpad);
  1965.    data[4] := ctl(mypadc);
  1966.    data[5] := makechar(ORD(myeol));
  1967.    data[6] := myqctl;
  1968.    data[7] := myqbin;                             {[2.8]}
  1969.    data[8] := '1';    (* default checksums *)
  1970.    data[9] := myrept;
  1971.    FOR index := 10 TO MAXDATALENGTH DO            {[2.8]}
  1972.       data[index] := SP;
  1973.    createsendinitdata := 9;                       {[2.8]}
  1974.    END; (* of create send-init data *)
  1975.  
  1976.  
  1977.  
  1978. (******************************************************************************)
  1979. (*                                                                            *)
  1980. (* THE FOLLOWING PROCEDURE WILL SEND THE SPECIFIED FILE(S) TO THE CONNECTED   *)
  1981. (* KERMIT.                                                                    *)
  1982. (*                                                                            *)
  1983. (******************************************************************************)
  1984.  
  1985. PROCEDURE send_the_files;
  1986.  
  1987.    VAR
  1988.       status : STATUS_$T;
  1989.  
  1990.  
  1991.  
  1992.    (***************************************************************************)
  1993.    (*                                                                         *)
  1994.    (* THE FOLLOWING PROCEDURE WILL SEND A SEND-INIT PACKET                    *)
  1995.    (*                                                                         *)
  1996.    (***************************************************************************)
  1997.  
  1998.    PROCEDURE send_sendinit;
  1999.  
  2000.       VAR
  2001.          sio_status :status_$T;
  2002.  
  2003.       BEGIN (* send send-init packet *)
  2004.       currentpacket := 0;
  2005.       numberoftries := 0;
  2006.       WITH packet[currentpacket] DO
  2007.          BEGIN
  2008.          mark := markchar;
  2009.          typ := S;
  2010.          len := createsendinitdata(data) + 3;
  2011.          seq := currentpacket;
  2012.          END; (* of with *)
  2013.       REPEAT
  2014.          sendpacket(currentpacket);
  2015.          receivepacket;
  2016.          IF (receivedpacket.typ = Y) AND (receivedpacket.seq = 0)
  2017.             THEN
  2018.                BEGIN
  2019.                processparams;
  2020.                currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS;
  2021.                numberoftries := 0;
  2022. (*             IF NOT existf(xmtname)                   -2.8a *)
  2023. (*                THEN                                  -2.8a *)
  2024. (*                   BEGIN                              -2.8a *)
  2025. (*                   senderror('File not found', 14);   -2.8a *)
  2026. (*                   state := ABORT;                    -2.8a *)
  2027. (*                   END                                -2.8a *)
  2028. (*                ELSE                                  -2.8a *)
  2029.                      BEGIN
  2030.                      openi(xmtname, xmtlength, FALSE, xmtid);
  2031.                      xmt_eof := FALSE;
  2032.                      xmt_eoln := FALSE;
  2033.                      statistics.totalpkts := statistics.totalpkts + 1;
  2034.                      state := SEND_FILE;
  2035.                      hashfile(xmtname,xmtlength,kermitname,kermitlength,
  2036.                        true);         (* hash from Apollo to kermit form *)
  2037.                      IF debug THEN
  2038.                          writeln(debugfile,'Sending ',xmtname:xmtlength,
  2039.                            ' as ',kermitname:kermitlength);
  2040.                      END; (* of if *)
  2041.                END (* of then *)
  2042.             ELSE
  2043.                BEGIN
  2044.                numberoftries := numberoftries + 1;
  2045.                statistics.numretries := statistics.numretries + 1;
  2046.                IF numberoftries > MAXTRIES
  2047.                   THEN
  2048.                      BEGIN
  2049.                      senderror('Maxtries exceeded', 17);
  2050.                      state := ABORT;
  2051.                      END
  2052.                    ELSE
  2053.                      SIO_$CONTROL(sio_stream, SIO_$FLUSH_IN, true, sio_status);
  2054.                END; (* of else *)
  2055.       UNTIL state <> SEND_INIT;
  2056.       END; (* of send send-init packet *)
  2057.  
  2058.  
  2059.  
  2060.    (***************************************************************************)
  2061.    (*                                                                         *)
  2062.    (* THE FOLLOWING PROCEDURE WILL SEND A FILE-HEADER PACKET.                 *)
  2063.    (*                                                                         *)
  2064.    (***************************************************************************)
  2065.  
  2066.    PROCEDURE send_fileheader;
  2067.  
  2068.       VAR
  2069.          temp_time        : TIME_$CLOCK_T;
  2070.          temp_num_pkts    : INTEGER32;
  2071.          temp_num_retries : INTEGER32;
  2072.          i,xlen           : INTEGER;
  2073.          ch               : CHAR;
  2074.          sio_status :status_$T;
  2075.  
  2076.       BEGIN (* send file header *)
  2077.       WITH packet[currentpacket] DO
  2078.          BEGIN
  2079.          mark := MARKCHAR;
  2080.          typ := F;
  2081.          (* Encode. Assume no non-printing or 8 bit. Repeats can go long hand.
  2082.             However coding control charas. must be encoded. *)
  2083.          xlen := 0;
  2084.          data := ' ';
  2085.          FOR i:=1 TO kermitlength DO
  2086.            BEGIN
  2087.            ch := kermitname[i];
  2088.            IF (ch = theirqctl) OR (repeating AND (ch = rept)) OR
  2089.              (quoting8 AND (ch=theirqbin)) THEN
  2090.                BEGIN
  2091.                xlen := xlen+1 ;
  2092.                data[xlen] := theirqctl;
  2093.                END;
  2094.            xlen := xlen+1 ;
  2095.            data[xlen] := ch;
  2096.            END;
  2097.          len := xlen + 3;
  2098.          seq := currentpacket;
  2099.          END; (* of with *)
  2100.       REPEAT
  2101.          sendpacket(currentpacket);
  2102.          IF receivedACK
  2103.             THEN
  2104.                BEGIN
  2105.                fillxmtbuffer;
  2106.                currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS;
  2107.                numberoftries := 0;
  2108.                IF xmtbuffer.len = 0
  2109.                   THEN (* file is empty *)
  2110.                      state := SEND_EOF
  2111.                   ELSE
  2112.                      state := SEND_DATA;
  2113.                temp_num_pkts := statistics.totalpkts;
  2114.                temp_num_retries := statistics.numretries;
  2115.                temp_time := statistics.stoptime; {starting time is time that}
  2116.                clear_statistics;                 {the last transfer stopped }
  2117.                statistics.totalpkts := temp_num_pkts + 1;
  2118.                statistics.numretries := temp_num_retries;
  2119.                statistics.starttime := temp_time;
  2120.                statistics.filename := xmtname;
  2121.                statistics.namelength := xmtlength;
  2122.                END
  2123.             ELSE
  2124.                IF ((receivedpacket.typ = N) OR (receivedpacket.typ = Timeout) OR
  2125.                    (receivedpacket.typ = Checksum_error))
  2126.                   THEN
  2127.                      BEGIN
  2128.                      numberoftries := numberoftries + 1;
  2129.                      statistics.numretries := statistics.numretries + 1;
  2130.                      IF numberoftries > MAXTRIES
  2131.                         THEN
  2132.                            BEGIN
  2133.                            senderror('Maxtries exceeded', 17);
  2134.                            closef(xmtid);
  2135.                            state := ABORT;
  2136.                            END
  2137.                         ELSE
  2138.                            SIO_$CONTROL(sio_stream, SIO_$FLUSH_IN, true, sio_status);
  2139.                      END
  2140.                   ELSE
  2141.                      BEGIN
  2142.                      closef(xmtid);
  2143.                      state := ABORT;
  2144.                      END;
  2145.       UNTIL state <> SEND_FILE;
  2146.       END; (* of send file header *)
  2147.  
  2148.  
  2149.  
  2150.    (***************************************************************************)
  2151.    (*                                                                         *)
  2152.    (* THE FOLLOWING PROCEDURE WILL SEND THE CURRENT xmtbuffer TO THE USER.    *)
  2153.    (*                                                                         *)
  2154.    (***************************************************************************)
  2155.  
  2156.    PROCEDURE send_filedata;
  2157.     VAR    sio_status :status_$T;
  2158.  
  2159.       BEGIN (* send file data *)
  2160.       REPEAT
  2161.          IF numberoftries = 0
  2162.             THEN (* we need to create a packet with the contents of xmtbuffer *)
  2163.                WITH packet[currentpacket] DO
  2164.                   BEGIN
  2165.                   mark := MARKCHAR;
  2166.                   typ := D;
  2167.                   len := xmtbuffer.len + 3;
  2168.                   data := xmtbuffer.data;
  2169.                   seq := currentpacket;
  2170.                   END; (* of with *)
  2171.          sendpacket(currentpacket);
  2172.          IF receivedACK
  2173.             THEN
  2174.                BEGIN
  2175.                currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS;
  2176.                statistics.totalpkts := statistics.totalpkts + 1;
  2177.                numberoftries := 0;
  2178.                fillxmtbuffer;
  2179.                IF xmtbuffer.len = 0
  2180.                   THEN
  2181.                      BEGIN
  2182.                      state := SEND_EOF;
  2183.                      END;
  2184.                END
  2185.             ELSE
  2186.                BEGIN
  2187.                CASE receivedpacket.typ OF
  2188.                   N,
  2189.                   Timeout,
  2190.                   Checksum_error :
  2191.                      BEGIN
  2192.                      numberoftries := numberoftries + 1;
  2193.                      statistics.numretries := statistics.numretries + 1;
  2194.                      IF numberoftries > MAXTRIES
  2195.                         THEN
  2196.                            BEGIN
  2197.                            senderror('Maxtries exceeded', 17);
  2198.                            closef(xmtid);
  2199.                            state := ABORT;
  2200.                            END
  2201.                         ELSE
  2202.                            SIO_$CONTROL(sio_stream, SIO_$FLUSH_IN, true, sio_status);
  2203.                      END;
  2204.                   Y :
  2205.                      BEGIN
  2206.                      IF receivedpacket.seq = (currentpacket-1) MOD
  2207.                                               MAXNUMBEROFPACKETS
  2208.                         THEN
  2209.                            BEGIN
  2210.                            numberoftries := numberoftries + 1;
  2211.                            statistics.numretries := statistics.numretries + 1;
  2212.                            IF numberoftries > MAXTRIES
  2213.                               THEN
  2214.                                  BEGIN
  2215.                                  senderror('Maxtries exceeded', 17);
  2216.                                  closef(xmtid);
  2217.                                  state := ABORT;
  2218.                                  END
  2219.                               ELSE
  2220.                                  SIO_$CONTROL(sio_stream, SIO_$FLUSH_IN, true, sio_status);
  2221.                            END
  2222.                         ELSE
  2223.                            BEGIN
  2224.                            closef(xmtid);
  2225.                            state := ABORT;
  2226.                            END;
  2227.                      END;
  2228.                   OTHERWISE
  2229.                      BEGIN
  2230.                      closef(xmtid);
  2231.                      state := ABORT;
  2232.                      END;
  2233.                   END; (* of case *)
  2234.                END;
  2235.       UNTIL state <> SEND_DATA;
  2236.       END; (* of send file data *)
  2237.  
  2238.  
  2239.  
  2240.    (***************************************************************************)
  2241.    (*                                                                         *)
  2242.    (* THE FOLLOWING PROCEDURE WILL SEND AN EOF PACKET TO THE OTHER KERMIT.    *)
  2243.    (*                                                                         *)
  2244.    (***************************************************************************)
  2245.  
  2246.    PROCEDURE send_end_of_file;
  2247.      VAR    sio_status :status_$T;
  2248.  
  2249.       BEGIN (* send eof *)
  2250.       closef(xmtid);
  2251.       WITH packet[currentpacket] DO
  2252.          BEGIN
  2253.          mark := markchar;
  2254.          typ := Z;
  2255.          len := 3;
  2256.          data := ' ';
  2257.          seq := currentpacket;
  2258.          END; (* of with *)
  2259.       REPEAT
  2260.          sendpacket(currentpacket);
  2261.          IF receivedACK
  2262.             THEN
  2263.                BEGIN
  2264.                currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS;
  2265.                numberoftries := 0;
  2266.                CAL_$GET_LOCAL_TIME(statistics.stoptime);
  2267.                statistics.completed := TRUE;
  2268.                IF logging.transactions
  2269.                   THEN log_transaction;
  2270.                statistics.totalpkts := statistics.totalpkts + 1;
  2271.                state := SEND_BREAK;
  2272.                END
  2273.             ELSE
  2274.                IF (receivedpacket.typ = N) OR (receivedpacket.typ = Timeout) OR
  2275.                   (receivedpacket.typ = Checksum_error)
  2276.                   THEN
  2277.                      BEGIN
  2278.                      numberoftries := numberoftries + 1;
  2279.                      statistics.numretries := statistics.numretries + 1;
  2280.                      IF numberoftries > MAXTRIES
  2281.                         THEN
  2282.                            BEGIN
  2283.                            senderror('Maxtries exceeded', 17);
  2284.                            state := ABORT;
  2285.                            END
  2286.                         ELSE
  2287.                            SIO_$CONTROL(sio_stream, SIO_$FLUSH_IN, true, sio_status);
  2288.                      END
  2289.                   ELSE
  2290.                      state := ABORT;
  2291.       UNTIL state <> SEND_EOF;
  2292.       END; (* of send eof *)
  2293.  
  2294.  
  2295.  
  2296.    (***************************************************************************)
  2297.    (*                                                                         *)
  2298.    (* THE FOLLOWING PROCEDURE WILL SEND A BREAK PACKET TO THE OTHER KERMIT.   *)
  2299.    (*                                                                         *)
  2300.    (***************************************************************************)
  2301.  
  2302.    PROCEDURE send_a_break;
  2303.  
  2304.       BEGIN (* send break *)
  2305.       WITH packet[currentpacket] DO
  2306.          BEGIN
  2307.          mark := MARKCHAR;
  2308.          typ := B;
  2309.          len := 3;
  2310.          data := ' ';
  2311.          seq := currentpacket;
  2312.          END; (* of with *)
  2313.       REPEAT
  2314.          sendpacket(currentpacket);
  2315.          receivepacket;
  2316.          IF ((receivedpacket.typ = Y) AND (receivedpacket.seq = currentpacket)) OR
  2317.             ((receivedpacket.typ = N) AND (receivedpacket.seq = 0))
  2318.             THEN
  2319.                BEGIN
  2320.                statistics.totalpkts := statistics.totalpkts + 1;
  2321.                state := COMPLETE
  2322.                END
  2323.             ELSE
  2324.                IF ((receivedpacket.typ = N) AND
  2325.                    (receivedpacket.seq = currentpacket)) OR
  2326.                   (receivedpacket.typ = Timeout) OR
  2327.                   (receivedpacket.typ = Checksum_error)
  2328.                   THEN
  2329.                      state := SEND_BREAK
  2330.                   ELSE
  2331.                      state := ABORT;
  2332.       UNTIL state <> SEND_BREAK;
  2333.       END; (* of send break *)
  2334.  
  2335.    BEGIN (* send the files *)
  2336.    statistics.totalpkts := 0;
  2337.    statistics.numretries := 0;
  2338.    IF mode = local
  2339.       THEN
  2340.          BEGIN
  2341.          IF graphics THEN
  2342.             BEGIN
  2343.             PAD_$CREATE_FRAME(ERROUT, 80, 25, status);
  2344.             WRITELN(ESC, '[1;1H');
  2345.             END;
  2346.          printheader;
  2347.          WRITELN;
  2348.          IF graphics THEN
  2349.             BEGIN
  2350.             WRITELN('Packets : ', statistics.totalpkts:1);
  2351.             WRITELN('Retries : ', statistics.numretries:1);
  2352.             END
  2353.            ELSE
  2354.             WRITELN('  packets   retries');
  2355.          END;
  2356.    SIO_$CONTROL(sio_stream, SIO_$FLUSH_IN, true, status);
  2357.    REPEAT
  2358.       IF debug THEN WRITELN(debugfile, 'STATE : ', ORD(state));
  2359.       statistics.collecting := TRUE;
  2360.       CASE state OF
  2361.          SEND_INIT  : BEGIN
  2362.                       send_sendinit;
  2363.                       END;
  2364.          SEND_FILE  : BEGIN
  2365.                       send_fileheader;
  2366.                       END;
  2367.          SEND_DATA  : BEGIN
  2368.                       send_filedata;
  2369.                       END;
  2370.          SEND_EOF   : BEGIN
  2371.                       send_end_of_file;
  2372.                       END;
  2373.          SEND_BREAK : BEGIN
  2374.                       send_a_break;
  2375.                       END;
  2376.          OTHERWISE    BEGIN
  2377.                       statistics.collecting := FALSE;
  2378.                       EXIT;
  2379.                       END;
  2380.          END; (* of case *)
  2381.    UNTIL FOREVER;
  2382.    IF mode = local
  2383.       THEN PAD_$DELETE_FRAME(ERROUT, status);
  2384.    END; (* of send the files *)
  2385.  
  2386.  
  2387.  
  2388. (******************************************************************************)
  2389. (*                                                                            *)
  2390. (* THE FOLLOWING PROCEDURE WILL RECEIVE FILES FROM THE CONNECTED KERMIT.      *)
  2391. (*                                                                            *)
  2392. (******************************************************************************)
  2393.  
  2394. PROCEDURE receive_some_files;
  2395.  
  2396.    VAR
  2397.       status : STATUS_$T;
  2398.  
  2399.  
  2400.  
  2401.    (***************************************************************************)
  2402.    (*                                                                         *)
  2403.    (* THE FOLLOWING PROCEDURE WILL WAIT FOR A SEND-INIT PACKET FROM THE       *)
  2404.    (* CONNECTED KERMIT.  THIS IS THE ENTRY POINT FOR NON-SERVER RECEIVE       *)
  2405.    (* COMMAND.                                                                *)
  2406.    (*                                                                         *)
  2407.    (***************************************************************************)
  2408.  
  2409.    PROCEDURE wait_for_send_init;
  2410.  
  2411.       BEGIN (* wait for send-init *)
  2412.       currentpacket := 0;
  2413.       numberoftries := 0;
  2414.       REPEAT
  2415.          receivepacket;
  2416.          IF (receivedpacket.typ = S) AND (receivedpacket.seq = 0)
  2417.             THEN
  2418.                BEGIN
  2419.                processparams;
  2420.                WITH packet[currentpacket] DO
  2421.                   BEGIN
  2422.                   mark := markchar;
  2423.                   typ := Y;
  2424.                   len := createsendinitdata(data) + 3;
  2425.                   seq := currentpacket;
  2426.                   END; (* of with *)
  2427.                sendpacket(currentpacket);
  2428.                currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS;
  2429.                numberoftries := 0;
  2430.                statistics.totalpkts := statistics.totalpkts + 1;
  2431.                state := REC_FILE;
  2432.                END
  2433.             ELSE
  2434.                IF (receivedpacket.typ = Timeout) OR
  2435.                   (receivedpacket.typ = Checksum_error)
  2436.                   THEN
  2437.                      BEGIN
  2438.                      sendNAK;
  2439.                      numberoftries := numberoftries + 1;
  2440.                      statistics.numretries := statistics.numretries + 1;
  2441.                      IF numberoftries > MAXTRIES
  2442.                         THEN
  2443.                            BEGIN
  2444.                            senderror('Maxtries exceeded', 17);
  2445.                            state := ABORT;
  2446.                            END;
  2447.                      END
  2448.                   ELSE
  2449.                      BEGIN
  2450.                      sendNAK;
  2451.                      state := ABORT;
  2452.                      END;
  2453.       UNTIL state <> REC_INIT;
  2454.       END; (* of wait for send-init*)
  2455.  
  2456.  
  2457.  
  2458.    (***************************************************************************)
  2459.    (*                                                                         *)
  2460.    (* THE FOLLOWING PROCEDURE WILL WAIT FOR A FILE-HEADER PACKET FROM THE     *)
  2461.    (* CONNECTED KERMIT. THIS IS THE ENTRY POINT FOR SERVER RECEIVE COMMAND.   *)
  2462.    (*                                                                         *)
  2463.    (***************************************************************************)
  2464.  
  2465.    PROCEDURE wait_for_fileheader;
  2466.  
  2467.       VAR
  2468.          index,i          : INTEGER;
  2469.          temp_time        : TIME_$CLOCK_T;
  2470.          temp_num_pkts    : INTEGER32;
  2471.          temp_num_retries : INTEGER32;
  2472.          sio_status       : STATUS_$T;
  2473.  
  2474.       BEGIN (* wait for file-header *)
  2475.       REPEAT
  2476.          receivepacket;
  2477.          CASE receivedpacket.typ OF
  2478.             Timeout, { The advanced state table in the 5.0 Protocol Manual    }
  2479.                      { suggests sending a NAK, however, I feel that resending }
  2480.                      { the previous ACK is more appropriate.                  }
  2481.             Checksum_error,
  2482.             S : BEGIN (* previous ACK was lost, so re-send it *)
  2483.                 IF receivedpacket.seq = currentpacket - 1
  2484.                    THEN
  2485.                       BEGIN
  2486.                       sendpacket(currentpacket-1);
  2487.                       numberoftries := numberoftries + 1;
  2488.                       statistics.numretries := statistics.numretries + 1;
  2489.                       IF numberoftries > MAXTRIES
  2490.                          THEN
  2491.                             BEGIN
  2492.                             senderror('Maxtries exceeded', 17);
  2493.                             state := ABORT;
  2494.                             END
  2495.                          ELSE
  2496.                             SIO_$CONTROL(sio_stream, SIO_$FLUSH_IN, true, sio_status);
  2497.                       END
  2498.                    ELSE
  2499.                       BEGIN
  2500.                       sendNAK;
  2501.                       state := ABORT;
  2502.                       END;
  2503.                 END; (* of S case *)
  2504.             Z : BEGIN (* previous ACK was lost, so re-send it *)
  2505.                 IF receivedpacket.seq = currentpacket - 1
  2506.                    THEN
  2507.                       BEGIN
  2508.                       sendACK;
  2509.                       numberoftries := numberoftries + 1;
  2510.                       statistics.numretries := statistics.numretries + 1;
  2511.                       IF numberoftries > MAXTRIES
  2512.                          THEN
  2513.                             BEGIN
  2514.                             senderror('Maxtries exceeded', 17);
  2515.                             state := ABORT;
  2516.                             END
  2517.                          ELSE
  2518.                             SIO_$CONTROL(sio_stream, SIO_$FLUSH_IN, true, sio_status);
  2519.                       END
  2520.                    ELSE
  2521.                       BEGIN
  2522.                       sendNAK;
  2523.                       state := ABORT;
  2524.                       END;
  2525.                 END; (* of Z case *)
  2526.             B : BEGIN
  2527.                 IF receivedpacket.seq = currentpacket
  2528.                    THEN
  2529.                       BEGIN
  2530.                       sendACK;
  2531.                       statistics.totalpkts := statistics.totalpkts + 1;
  2532.                       state := COMPLETE;
  2533.                       END
  2534.                    ELSE
  2535.                       BEGIN
  2536.                       sendNAK;
  2537.                       state := ABORT;
  2538.                       END;
  2539.                 END; (* of B case *)
  2540.             F : BEGIN
  2541.                 (* decode repeats etc. using rcvbuffer *)
  2542.                 rcvbuffer.len := 0;
  2543.                 fillrcvbuffer;
  2544.                 kermitlength := rcvbuffer.len;
  2545.                 FOR i:=1 TO MAXDATALENGTH DO
  2546.                   kermitname[i] := rcvbuffer.data[i];
  2547.                 rcvbuffer.len := 0;  (* don't want name in the file *)
  2548.                 IF rcvname=' ' THEN
  2549.                     (* no name specified at this end, hash and use other Kermit's *)
  2550.                     BEGIN
  2551.                     IF kermitlength < MAXDATALENGTH
  2552.                         THEN
  2553.                         FOR index := kermitlength+1 TO MAXDATALENGTH DO
  2554.                           kermitname[index] := SP;
  2555.                     hashfile(kermitname,kermitlength,rcvname,rcvlength,false);
  2556.                       (* hash received name to legal Apollo *)
  2557.                     END;
  2558.                 IF debug THEN
  2559.                     writeln(debugfile,'Receiving ',kermitname:kermitlength,
  2560.                       ' as ',rcvname:rcvlength);
  2561. (*              OPEN(rcvfile, rcvname, 'UNKNOWN');               -2.8a *)
  2562. (*                IF status <> 0                                 -2.8a *)
  2563. (*                  THEN                                         -2.8a *)
  2564. (*                     BEGIN                                     -2.8a *)
  2565. (*                     senderror'Unable to open file', 19);      -2.8a *)
  2566. (*                     state := ABORT;                           -2.8a *)
  2567. (*                     IF mode=local THEN                        -2.8a *)
  2568. (*                         writeln'Unable to open file');        -2.8a *)
  2569. (*                     END                                       -2.8a *)
  2570. (*                  ELSE                                         -2.8a *)
  2571.                 IF (file_type = ascii) THEN                   (* +2.8a *)
  2572.                    openo(rcvname, rcvlength, TRUE, rcvid)     (* +2.8a *)
  2573.                 ELSE                                          (* +2.8a *)
  2574.                    openo(rcvname, rcvlength, FALSE, rcvid);   (* +2.8a *)
  2575.                      BEGIN
  2576. (*                   REWRITE(rcvfile);                           -2.8a *)
  2577.                      rcvbuffer.len := 0; { clear the rcvbuffer }
  2578.                      sendACK;
  2579.                      currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS;
  2580.                      numberoftries := 0;
  2581.                      state := REC_DATA;
  2582.                      temp_num_pkts := statistics.totalpkts;
  2583.                      temp_num_retries := statistics.numretries;
  2584.                      temp_time := statistics.stoptime;  {starting time is the time}
  2585.                      clear_statistics;                  {that the last transfer   }
  2586.                      statistics.starttime := temp_Time; {ended                    }
  2587.                      statistics.filename := rcvname;
  2588.                      statistics.namelength := rcvlength;
  2589.                      statistics.totalpkts := temp_num_pkts + 1;
  2590.                      statistics.numretries := temp_num_retries;
  2591.                      END;
  2592.                 END; (* of F case *)
  2593.           { Timeout :
  2594.                 BEGIN
  2595.                 sendNAK;
  2596.                 numberoftries := numberoftries + 1;
  2597.                 statistics.numretries := statistics.numretries + 1;
  2598.                 IF numberoftries > MAXTRIES
  2599.                    THEN
  2600.                       BEGIN
  2601.                       senderror('Maxtries exceeded', 17);
  2602.                       closef (rcvid);                    (* +2.8a *)
  2603.                       state := ABORT;
  2604.                       END
  2605.                    ELSE
  2606.                       SIO_$CONTROL(sio_stream, SIO_$FLUSH_IN, true, sio_status);
  2607.                  END;  }
  2608.              OTHERWISE
  2609.                  BEGIN
  2610.                  sendNAK;
  2611.                  state := ABORT;
  2612.                  END;
  2613.          END; (* of case *)
  2614.       UNTIL state <> REC_FILE;
  2615.       END; (* of wait for file-header *)
  2616.  
  2617.  
  2618.  
  2619.    (***************************************************************************)
  2620.    (*                                                                         *)
  2621.    (* THE FOLLOWING PROCEDURE WILL WAIT FOR A FILE-DATA PACKET FROM THE       *)
  2622.    (* CONNECTED KERMIT.                                                       *)
  2623.    (*                                                                         *)
  2624.    (***************************************************************************)
  2625.  
  2626.    PROCEDURE wait_for_filedata;
  2627.      VAR    sio_status :status_$T;
  2628.  
  2629.       BEGIN (* wait for file-data *)
  2630.       REPEAT
  2631.          receivepacket;
  2632.          CASE receivedpacket.typ OF
  2633.             D : BEGIN
  2634.                 IF receivedpacket.seq = currentpacket
  2635.                    THEN
  2636.                       BEGIN
  2637.                       fillrcvbuffer;
  2638.                       sendACK;
  2639.                       currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS;
  2640.                       numberoftries := 0;
  2641.                       statistics.totalpkts := statistics.totalpkts + 1;
  2642.                       END
  2643.                    ELSE
  2644.                       IF receivedpacket.seq = (currentpacket - 1) MOD
  2645.                                               MAXNUMBEROFPACKETS
  2646.                          THEN
  2647.                             BEGIN
  2648.                             sendACK;
  2649.                             numberoftries := numberoftries + 1;
  2650.                             statistics.numretries := statistics.numretries + 1;
  2651.                             IF numberoftries > MAXTRIES
  2652.                                THEN
  2653.                                   BEGIN
  2654.                                   senderror('Maxtries exceeded', 17);
  2655.                                   closef (rcvid);   (* +2.8a *)
  2656.                                   state := ABORT;
  2657.                                   END
  2658.                                ELSE
  2659.                                   SIO_$CONTROL(sio_stream, SIO_$FLUSH_IN, true, sio_status);
  2660.                             END
  2661.                          ELSE
  2662.                             BEGIN
  2663.                             senderror('Unexpected sequence number', 26);
  2664.                             closef (rcvid);   (* +2.8a *)
  2665.                             state := ABORT;
  2666.                             END;
  2667.                 END;
  2668.             Z : BEGIN
  2669.                 IF receivedpacket.seq = currentpacket
  2670.                    THEN
  2671.                       BEGIN
  2672.                       sendACK;
  2673.                       statistics.totalpkts := statistics.totalpkts + 1;
  2674.                       WITH rcvbuffer DO
  2675.                         IF len <> 0       (* should be > but compiler generates
  2676.                                              warning *)
  2677.                         THEN { empty out the rcvbuffer }
  2678.                           BEGIN
  2679. (*                          IF data [len]=LF                      -2.8a *)
  2680. (*                          THEN                                  -2.8a *)
  2681. (*                            len := len - 1;                     -2.8a *)
  2682. (*                          WRITELN (rcvfile, data:len);          -2.8a *)
  2683.                             putbuf (rcvid, ADDR(data), len);   (* +2.8a *)
  2684.                             len := 0;
  2685.                           END;
  2686. (*                    CLOSE(rcvfile);                             -2.8a *)
  2687.                       closef (rcvid);   (* +2.8a *)
  2688.                       rcvname:=' ';    (* +APX. If more files, use different
  2689.                                                 names *)
  2690.                       currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS;
  2691.                       numberoftries := 0;
  2692.                       state := REC_FILE;
  2693.                       CAL_$GET_LOCAL_TIME(statistics.stoptime);
  2694.                       statistics.completed := TRUE;
  2695.                       IF logging.transactions
  2696.                          THEN log_transaction;
  2697.                       END
  2698.                    ELSE
  2699.                       BEGIN
  2700.                       senderror('Unexpected sequence number', 26);
  2701.                       closef (rcvid);   (* +2.8a *)
  2702.                       state := ABORT;
  2703.                       END;
  2704.                 END;
  2705.             F : BEGIN
  2706.                 IF receivedpacket.seq = (currentpacket - 1) MOD
  2707.                                         MAXNUMBEROFPACKETS
  2708.                    THEN
  2709.                       BEGIN
  2710.                       sendACK;
  2711.                       numberoftries := numberoftries + 1;
  2712.                       statistics.numretries := statistics.numretries + 1;
  2713.                       IF numberoftries > MAXTRIES
  2714.                          THEN
  2715.                             BEGIN
  2716.                             senderror('Maxtries exceeded', 17);
  2717.                             closef (rcvid);   (* +2.8a *)
  2718.                             state := ABORT;
  2719.                             END
  2720.                          ELSE
  2721.                             SIO_$CONTROL(sio_stream, SIO_$FLUSH_IN, true, sio_status);
  2722.                       END
  2723.                    ELSE
  2724.                       BEGIN
  2725.                       senderror('Unexpected sequence number', 26);
  2726.                       closef (rcvid);   (* +2.8a *)
  2727.                       state := ABORT;
  2728.                       END;
  2729.                 END;
  2730.             Timeout,
  2731.             Checksum_error :
  2732.                 BEGIN
  2733.                 sendNAK;
  2734.                 numberoftries := numberoftries + 1;
  2735.                 statistics.numretries := statistics.numretries + 1;
  2736.                 IF numberoftries > MAXTRIES
  2737.                    THEN
  2738.                       BEGIN
  2739.                       senderror('Maxtries exceeded', 17);
  2740.                       closef (rcvid);   (* +2.8a *)
  2741.                       state := ABORT;
  2742.                       END
  2743.                    ELSE
  2744.                       SIO_$CONTROL(sio_stream, SIO_$FLUSH_IN, true, sio_status);
  2745.                 END;
  2746.             OTHERWISE
  2747.                 BEGIN
  2748.                 senderror('Unexpected packet type', 22);
  2749.                 closef (rcvid);   (* +2.8a *)
  2750.                 state := ABORT;
  2751.                 END;
  2752.              END; (* of case *)
  2753.       UNTIL state <> REC_DATA;
  2754.       END; (* of wait for file-data *)
  2755.  
  2756.    BEGIN (* receive some files *)
  2757.    statistics.totalpkts := 0;
  2758.    statistics.numretries := 0;
  2759.    IF mode = local
  2760.       THEN
  2761.          BEGIN
  2762.          IF graphics THEN
  2763.             BEGIN
  2764.             PAD_$CREATE_FRAME(ERROUT, 80, 25, status);
  2765.             WRITELN(ESC, '[1;1H');
  2766.             END;
  2767.          printheader;
  2768.          WRITELN;
  2769.          IF graphics THEN
  2770.             BEGIN
  2771.             WRITELN('Packets : ', statistics.totalpkts:1);
  2772.             WRITELN('Retries : ', statistics.numretries:1);
  2773.             END
  2774.            ELSE
  2775.             WRITELN('  packets   retries');
  2776.          END;
  2777.    REPEAT
  2778.       IF debug THEN WRITELN(debugfile, 'STATE : ', ORD(state));
  2779.       statistics.collecting := TRUE;
  2780.       CASE state OF
  2781.          REC_INIT : BEGIN
  2782.                     wait_for_send_init;
  2783.                     END;
  2784.          REC_FILE : BEGIN
  2785.                     wait_for_fileheader;
  2786.                     END;
  2787.          REC_DATA : BEGIN
  2788.                     wait_for_filedata;
  2789.                     END;
  2790.          OTHERWISE  BEGIN
  2791.                     statistics.collecting := FALSE;
  2792.                     EXIT;
  2793.                     END;
  2794.          END; (* of case *)
  2795.    UNTIL FOREVER;
  2796.    IF mode = local
  2797.       THEN PAD_$DELETE_FRAME(ERROUT, status);
  2798.    END; (* of receive some files *)
  2799.  
  2800.  
  2801.  
  2802. (******************************************************************************)
  2803. (*                                                                            *)
  2804. (* THE FOLLOWING PROCEDURE WILL EXECUTE THE EXIT COMMAND.  IT WILL DEASSIGN   *)
  2805. (* ALL DEVICES, CLOSE ALL FILES, AND PLACE THE STREAMS BACK TO THEIR          *)
  2806. (* ORIGINAL STATE.                                                            *)
  2807. (*                                                                            *)
  2808. (******************************************************************************)
  2809.  
  2810. PROCEDURE quit;
  2811.  
  2812.    BEGIN (* quit *)
  2813.    restore_system;
  2814.    PFM_$ENABLE; { enable asynchronous faults... typing a ^Q }
  2815.    PGM_$EXIT;
  2816.    END; (* of quit *)
  2817.  
  2818.  
  2819.  
  2820. (******************************************************************************)
  2821. (*                                                                            *)
  2822. (* THE FOLLOWING PROCEDURE WILL INITIALIZE THE SYSTEM FOR THE KERMIT SEND/    *)
  2823. (* RECEIVE STATES.  THIS INVOLVES PLACING THE INPUT AND OUTPUT STREAMS INTO   *)
  2824. (* RAW AND NO-ECHO MODES.  IT ALSO INVOLVES SETTING THE EVENTCOUNTER POINTERS *)
  2825. (* TO POINT TO THE CURRENT EVENTCOUNTERS.                                     *)
  2826. (*                                                                            *)
  2827. (******************************************************************************)
  2828.  
  2829. PROCEDURE initialize_for_send_receive;
  2830.  
  2831.    VAR
  2832.       status : STATUS_$T;
  2833.  
  2834.    BEGIN (* initialize for send-receive *)
  2835.    SIO_$CONTROL(sio_stream, SIO_$RAW, TRUE, status);
  2836.    SIO_$CONTROL(sio_stream, SIO_$NO_ECHO, TRUE, status);
  2837.    initialize_eventpointers;
  2838.    END; (* of initialize for send-receive *)
  2839.  
  2840.  
  2841.  
  2842. (******************************************************************************)
  2843. (*                                                                            *)
  2844. (* THE FOLLOWING PROCEDURE INITIATES THE SERVER MODE.                         *)
  2845. (*                                                                            *)
  2846. (******************************************************************************)
  2847.  
  2848. PROCEDURE server_waits;
  2849.  
  2850.    VAR
  2851.       index : INTEGER;
  2852.  
  2853.    BEGIN (* server waits *)
  2854.    currentpacket := 0;
  2855.    numberoftries := 0;
  2856.    REPEAT
  2857.       receivepacket;
  2858.       IF receivedpacket.seq = 0
  2859.          THEN
  2860.             BEGIN
  2861.             CASE receivedpacket.typ OF
  2862.                S : BEGIN (* Send Initiate *)
  2863.                    processparams;
  2864.                    WITH packet[currentpacket] DO
  2865.                       BEGIN
  2866.                       mark := markchar;
  2867.                       typ := Y;
  2868.                       len := createsendinitdata(data) + 3;
  2869.                       seq := currentpacket;
  2870.                       END; (* of with *)
  2871.                    sendpacket(currentpacket);
  2872.                    currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS;
  2873.                    numberoftries := 0;
  2874.                    state := REC_FILE;
  2875.                    rcvname:=' ';    (* +APX. Ensure other Kermit's filenames are
  2876.                                                used *)
  2877.                    END; (* of S case *)
  2878.                R : BEGIN (* Receive Initiate *)
  2879.                    xmtname := receivedpacket.data;
  2880.                    xmtlength := receivedpacket.len - 3;
  2881.                    IF xmtlength < MAXDATALENGTH
  2882.                       THEN
  2883.                          FOR index := xmtlength+1 to MAXDATALENGTH DO
  2884.                             xmtname[index] := SP;
  2885.                    state := SEND_INIT;
  2886.                    END; (* of R case *)
  2887.                G : BEGIN (* Generic Kermit Command *)
  2888.                    IF (receivedpacket.data[1] = 'F') OR
  2889.                       (receivedpacket.data[1] = 'L')
  2890.                       THEN
  2891.                          BEGIN
  2892.                          sendACK;
  2893.                          quit;
  2894.                          END;
  2895.                    END; (* of G case *)
  2896.                Timeout :
  2897.                    BEGIN
  2898.                    IF sendservNAKs
  2899.                       THEN sendNAK;
  2900.                    END; (* of Timeout case *)
  2901.                OTHERWISE
  2902.                    BEGIN
  2903.                    senderror('Unimplemented server command', 28);
  2904.                    END;
  2905.                END; (* of case *)
  2906.             END (* of then *)
  2907.          ELSE
  2908.             IF receivedpacket.typ = Timeout
  2909.                THEN
  2910.                   sendNak;
  2911.    UNTIL state <> REC_SERVER_IDLE;
  2912.    END; (* of server waits *)
  2913.  
  2914.  
  2915.  
  2916. (******************************************************************************)
  2917. (*                                                                            *)
  2918. (* THE FOLLOWING PROCEDURE WILL SEND A GENERIC FINISH COMMAND TO THE          *)
  2919. (* CONNECTED KERMIT.                                                          *)
  2920. (*                                                                            *)
  2921. (******************************************************************************)
  2922.  
  2923. PROCEDURE send_finish;
  2924.    VAR    sio_status :status_$T;
  2925.  
  2926.    BEGIN (* send finish *)
  2927.    IF mode = host
  2928.       THEN
  2929.          BEGIN
  2930.          WRITELN('Warning : The FINISH command can only be used in local ',
  2931.                  'mode.');
  2932.          RETURN;
  2933.          END
  2934.       ELSE
  2935.          BEGIN
  2936.          open_sio_line;
  2937.          IF sio_line_opened
  2938.             THEN
  2939.                initialize_for_send_receive
  2940.             ELSE
  2941.                RETURN;
  2942.          END;
  2943.    currentpacket := 0;
  2944.    numberoftries := 0;
  2945.    WITH packet[currentpacket] DO
  2946.       BEGIN
  2947.       mark := MARKCHAR;
  2948.       typ := G;
  2949.       data := 'F';
  2950.       len := 4;
  2951.       seq := currentpacket;
  2952.       END;
  2953.    REPEAT
  2954.       sendpacket(currentpacket);
  2955.       IF receivedACK
  2956.          THEN
  2957.             BEGIN
  2958.             restore_system;
  2959.             RETURN;
  2960.             END
  2961.          ELSE
  2962.             BEGIN
  2963.             numberoftries := numberoftries + 1;
  2964.             IF numberoftries > MAXTRIES
  2965.                THEN
  2966.                   BEGIN
  2967.                   WRITELN('Warning : Unable to shutdown connected server.');
  2968.                   restore_system;
  2969.                   RETURN;
  2970.                   END
  2971.                ELSE
  2972.                   SIO_$CONTROL(sio_stream, SIO_$FLUSH_IN, true, sio_status);
  2973.             END;
  2974.    UNTIL FOREVER;
  2975.    END; (* of send finish *)
  2976.  
  2977.  
  2978.  
  2979. (******************************************************************************)
  2980. (*                                                                            *)
  2981. (* THE FOLLOWING PROCEDURE EXECUTES THE CONNECT COMMAND.  ESSENTIALLY THIS    *)
  2982. (* COMMAND ALLOWS KERMIT TO EMULATE A "SEMI-DUMB" TERMINAL.  FOR MORE INFO    *)
  2983. (* PERTAINING TO THE CONNECT COMMAND PLEASE REFER TO THE 'KERMIT USER'S       *)
  2984. (* MANUAL', THE 'KERMIT PROTOCOL MANUAL', OR TO THE HELP FILE.                *)
  2985. (*                                                                            *)
  2986. (******************************************************************************)
  2987.  
  2988. PROCEDURE connect;
  2989.  
  2990.    CONST
  2991.      spm_esc_char=char(16#1d);
  2992.      mbx_no_echo=char(16#02);
  2993.      mbx_normal=char(16#01);
  2994.  
  2995.    TYPE
  2996.       xyrcvdstates = (limbo, rcvdESC, rcvd1, rcvdx, rcvdy);
  2997.  
  2998.    VAR
  2999.       connection_ended : BOOLEAN;
  3000.       xyseq            : RECORD
  3001.                             rcvdstate : xyrcvdstates;
  3002.                             xpos      : INTEGER;
  3003.                             ypos      : INTEGER;
  3004.                          END; (* of xyseq record *)
  3005.  
  3006.       (* The following variables are for handling the graphics primitives     *)
  3007.       status       : STATUS_$T;
  3008.       cur_position : GPR_$POSITION_T;
  3009.       disp_bm_size : GPR_$OFFSET_T;
  3010.       init_bitmap  : GPR_$BITMAP_DESC_T;
  3011.       fwidth       : INTEGER;
  3012.       fhite        : INTEGER;
  3013.       fid          : INTEGER;
  3014.       cur_origin   : GPR_$POSITION_T;
  3015.       timeout      : TIME_$CLOCK_T;
  3016.  
  3017.       (* The following variables are for handling inter_mode mailboxes.       *)
  3018.       mbx_buffer   : ARRAY[1..2] OF CHAR;
  3019.       key          : stream_$sk_t;
  3020.  
  3021.       (* The following variables are for the clean-up handler which is used   *)
  3022.       (* to ensure that the keyboard is returned to its initial state         *)
  3023.       handler_rec : PFM_$CLEANUP_REC;
  3024.  
  3025.    (***************************************************************************)
  3026.    (*                                                                         *)
  3027.    (* THE FOLLOWING PROCEDURE WILL CLEAR THE DATA STRUCTURES USED FOR         *)
  3028.    (* HANDLING THE X-Y POSITIONING ESCAPE SEQUENCE.                           *)
  3029.    (*                                                                         *)
  3030.    (***************************************************************************)
  3031.  
  3032.    PROCEDURE clearxy;
  3033.  
  3034.       BEGIN
  3035.       WITH xyseq DO
  3036.          BEGIN
  3037.          rcvdstate := limbo;
  3038.          xpos := -1;
  3039.          ypos := -1;
  3040.          END;
  3041.       END;
  3042.  
  3043.    (***************************************************************************)
  3044.    (*                                                                         *)
  3045.    (* THE FOLLOWING PROCEDURE WILL CLEAR THE CURRENT CURSOR POSITION.         *)
  3046.    (*                                                                         *)
  3047.    (***************************************************************************)
  3048.  
  3049.    PROCEDURE clearpos;
  3050.  
  3051.       VAR
  3052.         bitmap_desc   : GPR_$BITMAP_DESC_T;
  3053.         source_window : GPR_$WINDOW_T;
  3054.       { source_plane  : GPR_$PLANE_T;   }
  3055.         dest_origin   : GPR_$POSITION_T;
  3056.       { dest_plane    : GPR_$PLANE_T;   }
  3057.         status        : STATUS_$T;
  3058.  
  3059.       BEGIN (* clear position *)
  3060.       IF not graphics THEN
  3061.          RETURN;
  3062.       GPR_$INQ_BITMAP(bitmap_desc, status);
  3063.       GPR_$SET_BITMAP(bitmap_desc, status);
  3064.  
  3065.       WITH source_window DO
  3066.          BEGIN
  3067.          WITH window_base DO
  3068.             BEGIN
  3069.             x_coord := 0;
  3070.             y_coord := 24*fhite + 7;
  3071.             END;
  3072.          WITH window_size DO
  3073.             BEGIN
  3074.             x_size := fwidth;
  3075.             y_size := fhite;
  3076.             END;
  3077.          END;
  3078.     { source_plane := 0;  }
  3079.       WITH dest_origin DO
  3080.          BEGIN
  3081.          x_coord := cur_position.x_coord;
  3082.          y_coord := cur_position.y_coord - 15;
  3083.          END;
  3084.     { dest_plane := 0;    }
  3085.  
  3086.       GPR_$PIXEL_BLT(bitmap_desc, source_window, dest_origin, status);
  3087.       END; (* of clear position *)
  3088.  
  3089.    (***************************************************************************)
  3090.    (*                                                                         *)
  3091.    (* THE FOLLOWING PROCEDURE WILL SCROLL THE TERMINAL EMULATOR SCREEN BY ONE *)
  3092.    (* FULL LINE.                                                              *)
  3093.    (*                                                                         *)
  3094.    (***************************************************************************)
  3095.  
  3096.    PROCEDURE scroll;
  3097.  
  3098.       VAR
  3099.         bitmap_desc   : GPR_$BITMAP_DESC_T;
  3100.         source_window : GPR_$WINDOW_T;
  3101.       { source_plane  : GPR_$PLANE_T;  }
  3102.         dest_origin   : GPR_$POSITION_T;
  3103.       { dest_plane    : GPR_$PLANE_T;  }
  3104.         status        : STATUS_$T;
  3105.  
  3106.       BEGIN
  3107.       IF not graphics THEN
  3108.          RETURN;
  3109.       GPR_$INQ_BITMAP(bitmap_desc, status);
  3110.       GPR_$SET_BITMAP(bitmap_desc, status);
  3111.  
  3112.       WITH source_window DO
  3113.          BEGIN
  3114.          WITH window_base DO
  3115.             BEGIN
  3116.             x_coord := 0;
  3117.             y_coord := fhite+7;
  3118.             END;
  3119.          WITH window_size DO
  3120.             BEGIN
  3121.             x_size := 80*fwidth;
  3122.             y_size := 25*fhite;
  3123.             END;
  3124.          END;
  3125.     { source_plane := 0;  }
  3126.       WITH dest_origin DO
  3127.          BEGIN
  3128.          x_coord := 0;
  3129.          y_coord := 7;
  3130.          END;
  3131.     { dest_plane := 0;    }
  3132.  
  3133.       GPR_$PIXEL_BLT(bitmap_desc, source_window, dest_origin, status);
  3134.       END; (* of scroll *)
  3135.  
  3136.    (***************************************************************************)
  3137.    (*                                                                         *)
  3138.    (* THE FOLLOWING PROCEDURE SIMPLY OBTAINS THE NEXT CHARACTER FROM THE      *)
  3139.    (* SPECIFIED STREAM.  THIS PROCEDURE IS ESSENTIALLY THE SAME AS THE        *)
  3140.    (* GETCHAR PROCEDURE EXCEPT FOR A FEW MINOR EXCEPTIONS.  THE PROCEDURE     *)
  3141.    (* WILL NOT TIMEOUT, IF THERE ARE NOT CHARACTERS TO RECEIVE IT JUST        *)
  3142.    (* RETURNS.  THE PROCEDURE ALLOWS YOU TO SPECIFY WHICH STREAM TO OBTAIN    *)
  3143.    (* THE CHARACTER FROM, RATHER THAN OBTAINING THE CHARACTER FROM THE SIO    *)
  3144.    (* YOU CAN USE IT TO SELECTIVELY POLL THE KEYBOARD.  AND FINALLY, THE      *)
  3145.    (* PROCEDURE CAN ONLY BE ACCESSED FROM CONNECT.  THIS ENABLES THE CONNECT  *)
  3146.    (* PROCEDURE TO EXECUTE SLIGHTLY FASTER TO ALLOW IT TO HANDLE FASTER I/O   *)
  3147.    (* LINES.                                                                  *)
  3148.    (*                                                                         *)
  3149.    (***************************************************************************)
  3150.  
  3151.    PROCEDURE getch(stream         : STREAM_$ID_T;
  3152.                    VAR stream_rec : stream_io_typ);
  3153.  
  3154.       VAR
  3155.          key    : STREAM_$SK_T;
  3156.          status : STATUS_$T;
  3157.          index  : INTEGER; (* for debug *)
  3158.  
  3159.       BEGIN (* get character *)
  3160.       stream_rec.rcvdchar := FALSE; { Assume there is no input }
  3161.       stream_rec.timedout := FALSE; { Since we do not care about timeouts }
  3162.       IF stream_rec.index >= stream_rec.size
  3163.          THEN { we have read everything in this buffer and need a new one }
  3164.             BEGIN
  3165.             STREAM_$GET_CONDITIONAL(stream, ADDR(stream_rec.buffer),
  3166.                                     MAX_BUFFER_SIZE, stream_rec.ptr,
  3167.                                     stream_rec.size, key, status);
  3168.             IF status.all <> STATUS_$OK
  3169.                THEN
  3170.                   BEGIN
  3171.                   WRITELN('Warning : Error reading input in GETCH.');
  3172.                   RETURN;
  3173.                   END;
  3174.             IF stream_rec.size = 0
  3175.                THEN
  3176.                   RETURN;
  3177.             IF stream_rec.size < 0
  3178.                THEN { stream has more to send, buffer overflow }
  3179.                   stream_rec.size := MAX_BUFFER_SIZE;
  3180.             stream_rec.index := 0;
  3181.             END;
  3182.       stream_rec.rcvdchar := TRUE;
  3183.       stream_rec.index := stream_rec.index + 1;
  3184.       stream_rec.prevchar := stream_rec.currchar;
  3185.       stream_rec.currchar := stream_rec.ptr^[stream_rec.index];
  3186.       IF ORD(stream_rec.currchar) > 127
  3187.          THEN { the 8th bit is set and should be cleared }
  3188.             stream_rec.currchar := CHR(ORD(stream_rec.currchar) - 128);
  3189.       IF NOT rawmode THEN
  3190.          IF stream_rec.currchar = LF
  3191.             THEN { end of Apollo line - convert to CR for host }
  3192.                stream_rec.currchar := CR
  3193.          ELSE IF stream_rec.currchar = CR
  3194.             THEN { end of host line - convert to LF for Apollo }
  3195.                stream_rec.currchar := LF;
  3196.       END; (* of get character *)
  3197.  
  3198.  
  3199.  
  3200.    (***************************************************************************)
  3201.    (*                                                                         *)
  3202.    (* THE FOLLOWING PROCEDURE WILL SEND THE SPECIFIED CHARACTER TO THE        *)
  3203.    (* SPECIFIED STREAM WITHOUT ANY UNDO DELAY.                                *)
  3204.    (*                                                                         *)
  3205.    (***************************************************************************)
  3206.  
  3207.    PROCEDURE putch(stream : STREAM_$ID_T;
  3208.                    ch     : CHAR);
  3209.  
  3210.       VAR
  3211.          size   : INTEGER32;
  3212.          key    : STREAM_$SK_T;
  3213.          status : STATUS_$T;
  3214.  
  3215.          bitmap_desc   : GPR_$BITMAP_DESC_T;
  3216.          source_window : GPR_$WINDOW_T;
  3217.        { source_plane  : GPR_$PLANE_T; }
  3218.          dest_origin   : GPR_$POSITION_T;
  3219.        { dest_plane    : GPR_$PLANE_T; }
  3220.  
  3221.       BEGIN (* put character *)
  3222.       IF ( (stream <> STREAM_$ERROUT) AND (stream <> STREAM_$STDOUT) ) OR
  3223.         (NOT graphics)
  3224.          THEN
  3225.             BEGIN
  3226.             size := 1;
  3227.             CASE ch OF
  3228.                CR, KBD_$CR :
  3229.                   STREAM_$PUT_REC(stream, ADDR(CR), size, key, status);
  3230.                KBD_$LEFT_ARROW, KBD_$BS, BS :
  3231.                   STREAM_$PUT_REC(stream, ADDR(BS), size, key, status);
  3232.                KBD_$RIGHT_ARROW, CHR(21) :
  3233.                   STREAM_$PUT_REC(stream, ADDR(CHR(21)), size, key, status);
  3234.                KBD_$UP_ARROW, CHR(26) :
  3235.                   STREAM_$PUT_REC(stream, ADDR(CHR(26)), size, key, status);
  3236.                KBD_$DOWN_ARROW, LF :
  3237.                   STREAM_$PUT_REC(stream, ADDR(LF), size, key, status);
  3238.                KBD_$F1 :
  3239.                   BEGIN
  3240.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3241.                   STREAM_$PUT_REC(stream, ADDR('q'), size, key, status);
  3242.                   END;
  3243.                KBD_$F2 :
  3244.                   BEGIN
  3245.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3246.                   STREAM_$PUT_REC(stream, ADDR('r'), size, key, status);
  3247.                   END;
  3248.                KBD_$F3 :
  3249.                   BEGIN
  3250.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3251.                   STREAM_$PUT_REC(stream, ADDR('s'), size, key, status);
  3252.                   END;
  3253.                KBD_$F4 :
  3254.                   BEGIN
  3255.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3256.                   STREAM_$PUT_REC(stream, ADDR('t'), size, key, status);
  3257.                   END;
  3258.                KBD_$F5 :
  3259.                   BEGIN
  3260.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3261.                   STREAM_$PUT_REC(stream, ADDR('u'), size, key, status);
  3262.                   END;
  3263.                KBD_$F6 :
  3264.                   BEGIN
  3265.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3266.                   STREAM_$PUT_REC(stream, ADDR('v'), size, key, status);
  3267.                   END;
  3268.                KBD_$F7 :
  3269.                   BEGIN
  3270.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3271.                   STREAM_$PUT_REC(stream, ADDR('w'), size, key, status);
  3272.                   END;
  3273.                KBD_$F8 :
  3274.                   BEGIN
  3275.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3276.                   STREAM_$PUT_REC(stream, ADDR('x'), size, key, status);
  3277.                   END;
  3278.                KBD_$R2 : (* CDC-722  F9 KEY  *)
  3279.                   BEGIN
  3280.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3281.                   STREAM_$PUT_REC(stream, ADDR('y'), size, key, status);
  3282.                   END;
  3283.                KBD_$R3 : (* CDC-722  F10 KEY  *)
  3284.                   BEGIN
  3285.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3286.                   STREAM_$PUT_REC(stream, ADDR('z'), size, key, status);
  3287.                   END;
  3288.                KBD_$R4 : (* CDC-722  F11 KEY  *)
  3289.                   BEGIN
  3290.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3291.                   STREAM_$PUT_REC(stream, ADDR('{'), size, key, status);
  3292.                   END;
  3293.                KBD_$F1S :
  3294.                   BEGIN
  3295.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3296.                   STREAM_$PUT_REC(stream, ADDR('a'), size, key, status);
  3297.                   END;
  3298.                KBD_$F2S :
  3299.                   BEGIN
  3300.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3301.                   STREAM_$PUT_REC(stream, ADDR('b'), size, key, status);
  3302.                   END;
  3303.                KBD_$F3S :
  3304.                   BEGIN
  3305.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3306.                   STREAM_$PUT_REC(stream, ADDR('c'), size, key, status);
  3307.                   END;
  3308.                KBD_$F4S :
  3309.                   BEGIN
  3310.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3311.                   STREAM_$PUT_REC(stream, ADDR('d'), size, key, status);
  3312.                   END;
  3313.                KBD_$F5S :
  3314.                   BEGIN
  3315.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3316.                   STREAM_$PUT_REC(stream, ADDR('e'), size, key, status);
  3317.                   END;
  3318.                KBD_$F6S :
  3319.                   BEGIN
  3320.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3321.                   STREAM_$PUT_REC(stream, ADDR('f'), size, key, status);
  3322.                   END;
  3323.                KBD_$F7S :
  3324.                   BEGIN
  3325.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3326.                   STREAM_$PUT_REC(stream, ADDR('g'), size, key, status);
  3327.                   END;
  3328.                KBD_$F8S :
  3329.                   BEGIN
  3330.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3331.                   STREAM_$PUT_REC(stream, ADDR('h'), size, key, status);
  3332.                   END;
  3333.                KBD_$R2S : (* CDC-722  F9S KEY  *)
  3334.                   BEGIN
  3335.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3336.                   STREAM_$PUT_REC(stream, ADDR('i'), size, key, status);
  3337.                   END;
  3338.                KBD_$R3S : (* CDC-722  F10S KEY  *)
  3339.                   BEGIN
  3340.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3341.                   STREAM_$PUT_REC(stream, ADDR('j'), size, key, status);
  3342.                   END;
  3343.                KBD_$R4S : (* CDC-722  F11S KEY  *)
  3344.                   BEGIN
  3345.                   STREAM_$PUT_REC(stream, ADDR(RS), size, key, status);
  3346.                   STREAM_$PUT_REC(stream, ADDR('k'), size, key, status);
  3347.                   END;
  3348.                OTHERWISE
  3349.                   STREAM_$PUT_REC(stream, ADDR(ch), size, key, status);
  3350.             END; (* of case *)
  3351.             END
  3352.          ELSE
  3353.             BEGIN
  3354.             GPR_$SET_CURSOR_ACTIVE(FALSE, status);
  3355.  
  3356.             CASE ch OF
  3357.                CR, KBD_$CR :
  3358.                   BEGIN
  3359.                   cur_position.x_coord := 0;
  3360.                   END;
  3361.                LF :
  3362.                   BEGIN
  3363.                   cur_position.y_coord := cur_position.y_coord + fhite;
  3364.                   IF cur_position.y_coord > 24*fhite - 1
  3365.                      THEN
  3366.                         BEGIN
  3367.                         scroll;
  3368.                         cur_position.y_coord := 24*fhite - 1;
  3369.                         END;
  3370.                   END;
  3371.                KBD_$LEFT_ARROW, KBD_$BS, BS :
  3372.                   BEGIN
  3373.                   IF cur_position.x_coord - fwidth >= 0
  3374.                      THEN
  3375.                         cur_position.x_coord := cur_position.x_coord - fwidth
  3376.                      ELSE
  3377.                         BEGIN
  3378.                         cur_position.x_coord := 79*fwidth;
  3379.                         IF cur_position.y_coord-fhite >= fhite-1
  3380.                            THEN
  3381.                               cur_position.y_coord :=
  3382.                                  cur_position.y_coord - fhite
  3383.                            ELSE
  3384.                               cur_position.y_coord := 24*fhite - 1;
  3385.                         END;
  3386.                   END;
  3387.                KBD_$RIGHT_ARROW, CHR(21) :
  3388.                   BEGIN
  3389.                   IF cur_position.x_coord + fwidth <= 79*fwidth
  3390.                      THEN
  3391.                         cur_position.x_coord := cur_position.x_coord + fwidth
  3392.                      ELSE
  3393.                         BEGIN
  3394.                         cur_position.x_coord := 0;
  3395.                         IF cur_position.y_coord + fhite <= 24*fhite - 1
  3396.                            THEN
  3397.                               cur_position.y_coord :=
  3398.                                  cur_position.y_coord + fhite
  3399.                            ELSE
  3400.                               BEGIN
  3401.                               scroll;
  3402.                               cur_position.y_coord := 24*fhite - 1;
  3403.                               END;
  3404.                         END;
  3405.                   END;
  3406.                KBD_$UP_ARROW, CHR(26) :
  3407.                   BEGIN
  3408.                   IF cur_position.y_coord - fhite >= fhite-1
  3409.                      THEN
  3410.                         cur_position.y_coord := cur_position.y_coord - fhite
  3411.                      ELSE
  3412.                         cur_position.y_coord := 24*fhite - 1;
  3413.                   END;
  3414.                KBD_$DOWN_ARROW :
  3415.                   BEGIN
  3416.                   IF cur_position.y_coord + fhite <= 24*fhite - 1
  3417.                      THEN
  3418.                         cur_position.y_coord := cur_position.y_coord + fhite
  3419.                      ELSE
  3420.                         cur_position.y_coord := fhite - 1;
  3421.                   END;
  3422.                CHR(22) : { clear to end of line }
  3423.                   BEGIN
  3424.                   GPR_$INQ_BITMAP(bitmap_desc, status);
  3425.                   GPR_$SET_BITMAP(bitmap_desc, status);
  3426.                   WITH source_window DO
  3427.                      BEGIN
  3428.                      WITH window_base DO
  3429.                         BEGIN
  3430.                         x_coord := 0;
  3431.                         y_coord := 24*fhite + 7;
  3432.                         END;
  3433.                      WITH window_size DO
  3434.                         BEGIN
  3435.                         x_size := fwidth*80 - cur_position.x_coord;
  3436.                         y_size := fhite;
  3437.                         END;
  3438.                      END;
  3439.                 { source_plane := 0; }
  3440.                   WITH dest_origin DO
  3441.                      BEGIN
  3442.                      x_coord := cur_position.x_coord;
  3443.                      y_coord := cur_position.y_coord - 15;
  3444.                      END;
  3445.                 { dest_plane := 0;  }
  3446.                   GPR_$PIXEL_BLT(bitmap_desc, source_window, dest_origin,
  3447.                                  status);
  3448.                   END;
  3449.                CHR(24) : { clear screen and home }
  3450.                   BEGIN
  3451.                   GPR_$CLEAR(0, status);
  3452.                   cur_position.x_coord := 0;
  3453.                   cur_position.y_coord := 24*fhite - 1;
  3454.                   GPR_$MOVE(0, 30*fhite - 1, status);
  3455.                   GPR_$TEXT('[ Connected to host, type ', 26, status);
  3456.                   IF (escape_char < SP) OR (escape_char = DEL)
  3457.                      THEN
  3458.                         BEGIN
  3459.                         GPR_$TEXT('^', 1, status);
  3460.                         GPR_$TEXT(ctl(escape_char), 1, status);
  3461.                         END
  3462.                      ELSE
  3463.                         GPR_$TEXT(escape_char, 1, status);
  3464.                   GPR_$TEXT(' C to return to the Apollo ]', 28, status);
  3465.                   END;
  3466.                CHR(25) : { home }
  3467.                   BEGIN
  3468.                   cur_position.x_coord := 0;
  3469.                   cur_position.y_coord := 24*fhite - 1;
  3470.                   END;
  3471.                KBD_$F1, KBD_$F2, KBD_$F3, KBD_$F4, KBD_$F5, KBD_$F6, KBD_$F7,
  3472.                KBD_$F8, KBD_$R2, KBD_$R3, KBD_$R4 :
  3473.                   BEGIN
  3474.                   { do nothing }
  3475.                   END;
  3476.                KBD_$F1S, KBD_$F2S, KBD_$F3S, KBD_$F4S, KBD_$F5S, KBD_$F6S,
  3477.                KBD_$F7S, KBD_$F8S, KBD_$R2S, KBD_$R3S, KBD_$R4S :
  3478.                   BEGIN
  3479.                   { do nothing }
  3480.                   END;
  3481.                OTHERWISE
  3482.                   BEGIN
  3483.                   clearpos;
  3484.                   GPR_$MOVE(cur_position.x_coord, cur_position.y_coord, status);
  3485.                   IF (ch < SP) OR (ch = DEL)
  3486.                      THEN
  3487.                         BEGIN
  3488.                         { do nothing }
  3489.                         END
  3490.                      ELSE
  3491.                         BEGIN
  3492.                         GPR_$TEXT(ch, 1, status);
  3493.                         cur_position.x_coord := cur_position.x_coord + fwidth;
  3494.                         IF cur_position.x_coord > 79*fwidth
  3495.                            THEN
  3496.                               BEGIN
  3497.                               cur_position.x_coord := 0;
  3498.                               cur_position.y_coord :=
  3499.                                  cur_position.y_coord + fhite;
  3500.                               IF cur_position.y_coord > 24*fhite - 1
  3501.                                  THEN
  3502.                                     BEGIN
  3503.                                     scroll;
  3504.                                     cur_position.y_coord := 24*fhite - 1;
  3505.                                     END;
  3506.                               END;
  3507.                         END;
  3508.                   END; (* of otherwise *)
  3509.                END; (* of case *)
  3510.  
  3511.             GPR_$SET_CURSOR_POSITION(cur_position, status);
  3512.             GPR_$SET_CURSOR_ACTIVE(true, status);
  3513.             END;
  3514.       END; (* of put character *)
  3515.  
  3516.  
  3517.  
  3518.    (***************************************************************************)
  3519.    (*                                                                         *)
  3520.    (* THE FOLLOWING FUNCTION WILL PROCESS THE NEXT KEY STROKE.  IF A KEY      *)
  3521.    (* STROKE IS PROCESSED THEN TRUE IS RETURNED, OTHERWISE FALSE IS RETURNED. *)
  3522.    (*                                                                         *)
  3523.    (***************************************************************************)
  3524.  
  3525.    FUNCTION processed_keystrokes : BOOLEAN;
  3526.  
  3527.       CONST
  3528.          breaktime = 200; { this is the amount recommended by the System  }
  3529.                           { Programmer's Reference Manual                 }
  3530.  
  3531.       VAR
  3532.          status     : STATUS_$T; { used for sending a break }
  3533.          event      : GPR_$EVENT_T;
  3534.          ch         : CHAR;
  3535.  
  3536.       BEGIN (* processed keystrokes *)
  3537.       IF graphics THEN
  3538.          BEGIN
  3539.          discard( GPR_$COND_EVENT_WAIT(event, ch, cur_position, status) );
  3540.                   (* not interested in function's value *)
  3541.          IF event <> GPR_$KEYSTROKE
  3542.             THEN
  3543.                BEGIN
  3544.                keybdin_rec.rcvdchar := FALSE;
  3545.                END
  3546.             ELSE
  3547.                BEGIN
  3548.                keybdin_rec.rcvdchar := TRUE;
  3549.                keybdin_rec.prevchar := keybdin_rec.currchar;
  3550.                keybdin_rec.currchar := ch;
  3551.                END;
  3552.          END
  3553.       ELSE
  3554.          getch(stdin,keybdin_rec);
  3555.       processed_keystrokes := keybdin_rec.rcvdchar;
  3556.       IF keybdin_rec.rcvdchar
  3557.          THEN
  3558.             BEGIN
  3559.             IF keybdin_rec.prevchar = escape_char
  3560.                THEN
  3561.                   BEGIN
  3562.                   CASE keybdin_rec.currchar OF
  3563.                      'C',
  3564.                      'c' : BEGIN { close the connection, return to local kermit }
  3565.                            connection_ended := TRUE;
  3566.                            END;
  3567.                      'S',
  3568.                      's' : BEGIN { show status of the connection }
  3569.                            END;
  3570.                      'B',
  3571.                      'b' : BEGIN { send a BREAK signal }
  3572.                            SIO_$CONTROL(sio_stream, SIO_$SEND_BREAK, breaktime,
  3573.                                         status);
  3574.                            END;
  3575.                      '0' : BEGIN { send a NUL character }
  3576.                            putch(ERROUT, NUL);
  3577.                            END;
  3578.                      'P',
  3579.                      'p' : BEGIN { Push to local system comman processor }
  3580.                                  { without breaking the connection       }
  3581.                            END;
  3582.                      'Q',
  3583.                      'q' : BEGIN { quit logging session transcript }
  3584.                            logging.session := FALSE;
  3585.                            END;
  3586.                      'R',
  3587.                      'r' : BEGIN { resume logging session transcript }
  3588.                            IF sessionlength <> 0  (* should be > but compiler
  3589.                                                      generates warning *)
  3590.                               THEN { a session file has been defined }
  3591.                                  logging.session := TRUE
  3592.                               ELSE
  3593.                                  BEGIN
  3594.                                  WRITELN;
  3595.                                  WRITELN('Warning : no session file defined.');
  3596.                                  WRITELN;
  3597.                                  END;
  3598.                            END;
  3599.                      '?' : BEGIN { list all the possible single character }
  3600.                                  { arguments                              }
  3601.                            WRITELN;
  3602.                            WRITELN('Recognized single character arguments ',
  3603.                                    'are :');
  3604.                            WRITELN;
  3605.                            WRITELN('   C - close the connection');
  3606.                            WRITELN('   B - send a break character');
  3607.                            WRITELN('   0 - send a NUL character');
  3608.                            WRITELN('   Q - quit logging session transcript');
  3609.                            WRITELN('   R - resume logging session transcript');
  3610.                            WRITELN('   ? - provide this listing');
  3611.                            WRITELN;
  3612.                            END;
  3613.                      OTHERWISE
  3614.                            BEGIN
  3615.                            IF keybdin_rec.currchar = escape_char
  3616.                               THEN
  3617.                                  BEGIN
  3618.                                  (* send it to the display *)
  3619.                                  IF local_echo
  3620.                                     THEN WITH keybdin_rec DO
  3621.                                        BEGIN
  3622.                                        putch(ERROUT, currchar);
  3623.                                        END; (* of with *)
  3624.                                  (* now, send it to the connected system *)
  3625.                                  putch(sio_stream, keybdin_rec.currchar);
  3626.                                  (* then clear it in currchar so that the *)
  3627.                                  (* next keystroke is not interpreted as  *)
  3628.                                  (* a command                             *)
  3629.                                  keybdin_rec.currchar := SP;
  3630.                                  END;
  3631.                            END; (* of otherwise *)
  3632.                      END; (* of case *)
  3633.                   END
  3634.                ELSE
  3635.                   WITH keybdin_rec DO
  3636.                      IF currchar <> escape_char
  3637.                         THEN
  3638.                            BEGIN
  3639.                            IF local_echo
  3640.                               THEN
  3641.                                  (* send it to the display *)
  3642.                                  putch(ERROUT, currchar);
  3643.                            (* now, send it to the connected system *)
  3644.                            putch(sio_stream, keybdin_rec.currchar);
  3645.                            END
  3646.                         { ELSE don't do anything until next keystroke }
  3647.             END; (* of if rcvdchar *)
  3648.       END; (* of processed keystrokes *)
  3649.  
  3650.  
  3651.  
  3652.    (***************************************************************************)
  3653.    (*                                                                         *)
  3654.    (* THE FOLLOWING PROCEDURE WILL CHECK TO SEE IF THERE HAS BEEN ANY INPUT   *)
  3655.    (* FROM THE HOST.  IF SO THE INPUT WILL BE DISPLAYED.                      *)
  3656.    (*                                                                         *)
  3657.    (***************************************************************************)
  3658.  
  3659.    FUNCTION host_active : BOOLEAN;
  3660.  
  3661.       BEGIN (* host active *)
  3662.       IF not sio_line_opened
  3663.          THEN
  3664.             BEGIN
  3665.             host_active := FALSE;
  3666.             RETURN;
  3667.             END;
  3668.       REPEAT
  3669.          getch(sio_stream, strin_rec);
  3670.          host_active := strin_rec.rcvdchar;
  3671.          WITH strin_rec DO
  3672.             BEGIN
  3673.             IF rcvdchar
  3674.                THEN
  3675.                   BEGIN
  3676.                   IF currchar = ESC
  3677.                      THEN
  3678.                         BEGIN
  3679.                         clearxy;
  3680.                         xyseq.rcvdstate := rcvdESC;
  3681.                         END
  3682.                      ELSE
  3683.                         BEGIN
  3684.                         WITH xyseq DO
  3685.                            BEGIN
  3686.                            CASE rcvdstate OF
  3687.                               rcvdESC :
  3688.                                  BEGIN
  3689.                                  IF currchar='1'
  3690.                                     THEN
  3691.                                        rcvdstate := rcvd1
  3692.                                     ELSE
  3693.                                        BEGIN
  3694.                                        putch(ERROUT, ESC);
  3695.                                        putch(ERROUT, currchar);
  3696.                                        clearxy;
  3697.                                        END;
  3698.                                  END;
  3699.                               rcvd1 :
  3700.                                  BEGIN
  3701.                                  xpos := ORD(currchar) - 32;
  3702.                                  IF xpos < 0
  3703.                                     THEN xpos := 0;
  3704.                                  IF xpos > 79
  3705.                                     THEN xpos := 79;
  3706.                                  rcvdstate := rcvdx;
  3707.                                  END;
  3708.                               rcvdx :
  3709.                                  BEGIN
  3710.                                  ypos := ORD(currchar) - 32;
  3711.                                  IF ypos < 0
  3712.                                     THEN ypos := 0;
  3713.                                  IF ypos > 23
  3714.                                     THEN ypos := 23;
  3715.                                  cur_position.x_coord :=
  3716.                                     xpos*fwidth;
  3717.                                  cur_position.y_coord :=
  3718.                                     (ypos+1)*fhite - 1;
  3719.                                  IF graphics THEN
  3720.                                     BEGIN
  3721.                                     GPR_$SET_CURSOR_ACTIVE(FALSE,STATUS);
  3722.                                     GPR_$SET_CURSOR_POSITION(CUR_POSITION,STATUS) ;
  3723.                                     GPR_$SET_CURSOR_ACTIVE(TRUE,STATUS);
  3724.                                     END;
  3725.                                  clearxy;
  3726.                                  END;
  3727.                               limbo :
  3728.                                  BEGIN
  3729.                                  putch(ERROUT, currchar);
  3730.                                  END;
  3731.                               END; (* of case *)
  3732.                            END; (* of with xyseq *)
  3733.                         END; (* of else *)
  3734.                   IF logging.session
  3735.                      THEN
  3736.                         BEGIN
  3737.                         IF currchar = CR
  3738.                            THEN
  3739.                               WRITELN(sessionfile)
  3740.                            ELSE
  3741.                               BEGIN
  3742.                               IF (currchar < SP) OR (currchar = DEL)
  3743.                                  THEN
  3744.                                     BEGIN
  3745.                                     WRITE(sessionfile,
  3746.                                           '^', ctl(currchar))
  3747.                                     END
  3748.                                  ELSE
  3749.                                     WRITE(sessionfile, currchar);
  3750.                               END;
  3751.                         END;
  3752.                   END;
  3753.             END; (* of with *)
  3754.       UNTIL (NOT strin_rec.rcvdchar) OR
  3755.             (EC2_$READ(waitptrs[KEYBD_INDEX]^) > waitvalues[KEYBD_INDEX]);
  3756.       END; (* of host active *)
  3757.  
  3758.  
  3759.    BEGIN (* connect *)
  3760.    IF mode = host
  3761.       THEN
  3762.          BEGIN
  3763.          WRITELN('Warning : The CONNECT command can only be used in LOCAL ',
  3764.                  'mode.');
  3765.          RETURN;
  3766.          END;
  3767.    clearxy;
  3768.    status := PFM_$CLEANUP(handler_rec); {establish clean-up handler}
  3769.    IF status.all <> PFM_$CLEANUP_SET
  3770.       THEN
  3771.          BEGIN
  3772.          IF graphics THEN
  3773.             BEGIN
  3774.             GPR_$DISABLE_INPUT(GPR_$KEYSTROKE, status);
  3775.             GPR_$TERMINATE(FALSE, status);
  3776.             END;
  3777.          PFM_$SIGNAL(status);
  3778.          END
  3779.       ELSE IF graphics THEN
  3780.          BEGIN
  3781.          { initialize specifying borrow mode }
  3782.          fwidth := 11;
  3783.          fhite := 23;
  3784.          disp_bm_size.x_size := 1024;
  3785.          disp_bm_size.y_size := 1024;
  3786.          GPR_$INIT(GPR_$BORROW, 1, disp_bm_size, 0, init_bitmap, status);
  3787.  
  3788.          { set up text font that will be used in borrow mode }
  3789.          GPR_$LOAD_FONT_FILE('/sys/dm/fonts/f9x15', 19, fid, status);
  3790.          GPR_$SET_TEXT_FONT(fid, status);
  3791.  
  3792.          { set time-out to 5 seconds }
  3793.          timeout.low32 := 5*250000;
  3794.          timeout.high16 := 0;
  3795.          GPR_$SET_ACQ_TIME_OUT(timeout, status);
  3796.  
  3797.          { enable keystroke event and characters from 0 to 127 which includes  }
  3798.          { all keys                                                            }
  3799.  
  3800.          GPR_$ENABLE_INPUT(GPR_$KEYSTROKE, [chr(0) .. chr(127),
  3801.                                             KBD_$CR, KBD_$LEFT_ARROW,
  3802.                                             KBD_$RIGHT_ARROW, KBD_$UP_ARROW,
  3803.                                             KBD_$DOWN_ARROW, KBD_$BS,
  3804.                                             KBD_$F1 .. KBD_$F8,
  3805.                                             KBD_$F1S .. KBD_$F8S,
  3806.                                             KBD_$R2 .. KBD_$R4,
  3807.                                             KBD_$R2S .. KBD_$R4S],
  3808.                            status);
  3809.          cur_position.x_coord := 0;
  3810.          cur_position.y_coord := fhite-1;
  3811.          cur_origin.x_coord := 0;
  3812.          cur_origin.y_coord := 8;
  3813.          GPR_$SET_CURSOR_ORIGIN(cur_origin, status);
  3814.          GPR_$SET_CURSOR_POSITION(cur_position, status);
  3815.          GPR_$SET_CURSOR_ACTIVE(TRUE, status);
  3816.          END
  3817.       ELSE IF (display_type = mbx_line) AND rawmode THEN
  3818.          BEGIN
  3819.          (* put into raw mode so no double echo and can send controls *)
  3820.          mbx_buffer[1]:=spm_esc_char;
  3821.          mbx_buffer[2]:=mbx_no_echo;
  3822.          stream_$put_rec(stdout,addr(mbx_buffer),2,key,status);
  3823.          END;
  3824.       (* else sio-code - not yet implemented -
  3825.          or   display without graphics (PAD_$RAW) - or nothing *)
  3826.  
  3827.    open_sio_line;
  3828.        initialize_for_send_receive;
  3829.        connection_ended := FALSE;
  3830.        IF graphics THEN
  3831.           BEGIN
  3832.           GPR_$MOVE(0, 30*fhite - 1, status);
  3833.           GPR_$TEXT('[ Connected to host, type ', 26, status);
  3834.           END
  3835.         ELSE
  3836.           write('[ Connected to host, type ');
  3837.        IF (escape_char < SP) OR (escape_char = DEL)
  3838.           THEN
  3839.              IF graphics THEN
  3840.                 BEGIN
  3841.                 GPR_$TEXT('^', 1, status);
  3842.                 GPR_$TEXT(ctl(escape_char), 1, status);
  3843.                 END
  3844.               ELSE
  3845.                 BEGIN
  3846.                 write('^');
  3847.                 write(ctl(escape_char));
  3848.                 END
  3849.           ELSE IF graphics THEN
  3850.              GPR_$TEXT(escape_char, 1, status)
  3851.           ELSE
  3852.              write(escape_char);
  3853.        IF graphics THEN
  3854.           GPR_$TEXT(' C to return to the Apollo ]', 28, status)
  3855.         ELSE
  3856.           BEGIN
  3857.           writeln(' C to return to the Apollo ]');
  3858.           END;
  3859.        REPEAT
  3860.           waitvalues[KEYBD_INDEX] := EC2_$READ(waitptrs[KEYBD_INDEX]^);
  3861.           waitvalues[STRIN_INDEX] := EC2_$READ(waitptrs[STRIN_INDEX]^);
  3862.           IF (NOT host_active) AND (NOT processed_keystrokes)
  3863.              THEN
  3864.                 IF NOT graphics THEN
  3865.                    (* If graphics, this next bit causes hideously long response
  3866.                       times for some reason. *)
  3867.                    BEGIN
  3868.                    waitvalues[KEYBD_INDEX] := waitvalues[KEYBD_INDEX] + 1;
  3869.                    waitvalues[STRIN_INDEX] := waitvalues[STRIN_INDEX] + 1;
  3870.                    waitvalues[TIME_INDEX] := EC2_$READ(waitptrs[TIME_INDEX]^)
  3871.                                       + 15*4 ; { wait 15 secs, ticks 1/4 sec }
  3872.                    discard( EC2_$WAIT(waitptrs[STRIN_INDEX], waitvalues[STRIN_INDEX],
  3873.                                 2, status) );
  3874.                    END;
  3875.        UNTIL connection_ended;
  3876.    IF graphics THEN
  3877.       BEGIN
  3878.       GPR_$DISABLE_INPUT(GPR_$KEYSTROKE, status);
  3879.       GPR_$TERMINATE(FALSE, status);
  3880.       END
  3881.    ELSE IF (display_type = mbx_line) AND rawmode THEN
  3882.       BEGIN
  3883.       (* cancel raw mode *)
  3884.       mbx_buffer[1]:=spm_esc_char;
  3885.       mbx_buffer[2]:=mbx_normal;
  3886.       stream_$put_rec(stdout,addr(mbx_buffer),2,key,status);
  3887.       END;
  3888.       (* else sio-code - not yet implemented -
  3889.          or   display without graphics (PAD_$RAW) - or nothing *)
  3890.    restore_system;
  3891.    PFM_$RLS_CLEANUP(handler_rec, status);
  3892.    WRITELN('[ Back at the Apollo ]');
  3893.    END; (* of connect *)
  3894.  
  3895.  
  3896.  
  3897. (******************************************************************************)
  3898. (*                                                                            *)
  3899. (* THE FOLLOWING PROCEDURE WILL SCAN THE INPUT line FOR A TOKEN.  A TOKEN,    *)
  3900. (* IN THIS SENSE, IS ANY STRING OF CHARACTERS DELIMITED BY A SPACE.  THE      *)
  3901. (* SEARCH BEGINS AT index.  ON EXIT, index IS RETURNED SUCH THAT IT POINTS TO *)
  3902. (* THE SPACE WHICH MARKED THE END OF THE TOKEN.  THE TOKEN THAT WAS FOUND IS  *)
  3903. (* RETURNED IN token.                                                         *)
  3904. (*                                                                            *)
  3905. (******************************************************************************)
  3906.  
  3907. PROCEDURE gettoken(line      : STRING;
  3908.                    VAR index : INTEGER;
  3909.                    VAR token : STRING);
  3910.    VAR
  3911.       t_index : INTEGER;
  3912.       done    : BOOLEAN;
  3913.  
  3914.    BEGIN (* get token *)
  3915.    IF (index < 1) OR (index > 80)
  3916.       THEN
  3917.          BEGIN
  3918.          index := 81;
  3919.          token := ' ';
  3920.          END
  3921.       ELSE
  3922.          BEGIN
  3923.          t_index := 0;
  3924.          token := ' ';
  3925.          WHILE (line[index] = SP) AND (index < 80) DO
  3926.             index := index + 1;
  3927.          DONE := FALSE;
  3928.          REPEAT
  3929.             t_index := t_index + 1;
  3930.             token[t_index] := line[index];
  3931.             index := index + 1;
  3932.             IF index > 80
  3933.                THEN
  3934.                   done := TRUE
  3935.                ELSE
  3936.                   IF line[index] = SP
  3937.                      THEN
  3938.                         DONE := TRUE;
  3939.          UNTIL done;
  3940.          END; (* of else *)
  3941.    END; (* of get token *)
  3942.  
  3943.  
  3944.  
  3945. (******************************************************************************)
  3946. (*                                                                            *)
  3947. (* THE FOLLOWING PROCEDURE WILL EXECUTE THE CORRESPONDING COMMAND             *)
  3948. (*                                                                            *)
  3949. (******************************************************************************)
  3950.  
  3951. PROCEDURE processcommand(command      : cmdtyps;
  3952.                          sentence     : STRING;
  3953.                          VAR cmdindex : INTEGER);
  3954.  
  3955.    TYPE
  3956.       argrecord = RECORD
  3957.                      length : INTEGER;
  3958.                      data   : ARRAY[1 .. 80] OF CHAR;
  3959.                   END;
  3960.  
  3961.    VAR
  3962.       token : STRING;
  3963.       index : INTEGER;
  3964.  
  3965.       (* The following variables are for the LOCAL command *)
  3966.       lcmd      : NAME_$PNAME_T;
  3967.       llen      : INTEGER;
  3968.       argcount  : INTEGER;
  3969.       arg       : ARRAY[1 .. 10] OF argrecord;
  3970.       argvector : ARRAY[1 .. 10] OF UNIV_PTR;
  3971.       strcount  : INTEGER;
  3972.       strvector : ARRAY[1 .. 2] OF STREAM_$ID_T;
  3973.       inv_mode  : PGM_$MODE;
  3974.       reserved  : ARRAY[1 .. 8] OF REAL;
  3975.       status    : STATUS_$T;
  3976.  
  3977.       (* The following variable is for the send command *)
  3978.       inquiry_attri : STREAM_$IR_REC_T;         (* +2.8a *)
  3979.       inquiry_error : STREAM_$INQUIRE_MASK_T;   (* +2.8a *)
  3980.  
  3981.       (* The following variables are for the show command *)
  3982.       baud   : INTEGER;
  3983.       parity : INTEGER;
  3984.       iostatus  : INTEGER32;
  3985.  
  3986.       (* The following variables are for the STATISTICS command *)
  3987.       clock         : CAL_$TIMEDATE_REC_T;
  3988.       total_time    : TIME_$CLOCK_T;
  3989.       total_seconds : INTEGER32;
  3990.  
  3991.       (* The following variables are for the TRANSMIT command *)
  3992.       ch   : CHAR;
  3993.       size : INTEGER32;
  3994.       key  : STREAM_$SK_T;
  3995.  
  3996.    BEGIN (* processcommand *)
  3997.    CASE command OF
  3998.       CONNECTCMD : BEGIN
  3999.                    connect;
  4000.                    END;
  4001.       EXITCMD    : BEGIN
  4002.                    gettoken(sentence, cmdindex, token);
  4003.                    IF token = '?'
  4004.                       THEN
  4005.                          WRITELN('Syntax : EXIT or QUIT')
  4006.                       ELSE
  4007.                    IF token <> ' '
  4008.                       THEN
  4009.                          WRITELN('Illegal syntax for the EXIT/QUIT command.')
  4010.                       ELSE
  4011.                          quit;
  4012.                    END;
  4013.       FINISHCMD  : BEGIN
  4014.                    gettoken(sentence, cmdindex, token);
  4015.                    IF token = '?'
  4016.                       THEN
  4017.                          WRITELN('Syntax : FINISH')
  4018.                       ELSE
  4019.                    IF token <> ' '
  4020.                       THEN
  4021.                          WRITELN('Illegal syntax for the FINISH command.')
  4022.                       ELSE
  4023.                          send_finish;
  4024.                    END;
  4025.       GETCMD     : BEGIN
  4026.                    gettoken(sentence, cmdindex, token);
  4027.                    IF token = '?'
  4028.                       THEN
  4029.                          WRITELN('Syntax : GET remote_filespec')
  4030.                       ELSE
  4031.                    IF token = ' '
  4032.                       THEN
  4033.                          WRITELN('Illegal syntax for the GET command.')
  4034.                       ELSE
  4035.                    IF mode = host
  4036.                       THEN
  4037.                          WRITELN('Warning : The GET command can only be used',
  4038.                                  ' in LOCAL mode.')
  4039.                       ELSE
  4040.                          BEGIN
  4041.                          open_sio_line;
  4042.                          IF sio_line_opened
  4043.                             THEN
  4044.                                BEGIN
  4045.                                initialize_for_send_receive;
  4046.                                currentpacket := 0;
  4047.                                kermitname := ' ';
  4048.                                kermitlength := 0;
  4049.                                WHILE token[kermitlength + 1] <> SP DO
  4050.                                   BEGIN
  4051.                                   kermitlength := kermitlength + 1;
  4052.                                   kermitname[kermitlength] := token[kermitlength];
  4053.                                   END;
  4054.                                WITH packet[currentpacket] DO
  4055.                                   BEGIN
  4056.                                   mark := markchar;
  4057.                                   typ := R;
  4058.                                   len := kermitlength + 3;
  4059.                                   data := kermitname;
  4060.                                   seq := currentpacket;
  4061.                                   END;
  4062.                                sendpacket(currentpacket);
  4063.                                state := REC_INIT;
  4064.                                rcvname := ' ';  (* get name from other Kermit's F
  4065.                                                    packet *)
  4066.                                rcvlength := 0;
  4067.                                END;
  4068.                          END;
  4069.                    END; (* of get command *)
  4070.       HELPCMD    : BEGIN
  4071.                    gettoken(sentence, cmdindex, token);
  4072.                    IF token <> ' '
  4073.                       THEN
  4074.                          WRITELN('Illegal syntax for the HELP command.')
  4075.                       ELSE
  4076.                          BEGIN
  4077.                          WRITELN;
  4078.                          WRITELN('Kermit ', VERSION:VERSIONLENGTH,
  4079.                                  ' implements the following : ');
  4080.                          WRITELN;
  4081.                          WRITELN('   CONNECT    - go into terminal emulation ',
  4082.                                                  'mode.');
  4083.                          WRITELN('   EXIT       - exits from Kermit.');
  4084.                          WRITELN('   FINISH     - shuts down a remote Kermit ',
  4085.                                                  'in server mode.');
  4086.                          WRITELN('   GET        - request a remote Kermit ',
  4087.                                                  'server to send the');
  4088.                          WRITELN('                specified file.');
  4089.                          WRITELN('   HELP       - provides this listing.');
  4090.                          WRITELN('   LOCAL      - executes the specified ',
  4091.                                                  'command on the local ',
  4092.                                                  'system.');
  4093.                          WRITELN('   LOG        - log the specified entity to ',
  4094.                                                  'the specified file.');
  4095.                          WRITELN('   QUIT       - exits from Kermit.');
  4096.                          WRITELN('   RECEIVE    - waits for the arrival of a ',
  4097.                                                  'file or file group.');
  4098.                          WRITELN('   SEND       - sends a file to the other ',
  4099.                                                  'system.');
  4100.                          WRITELN('   SERVER     - places Kermit in Server ',
  4101.                                                  'mode.');
  4102.                          WRITELN('   SET        - modifies various parameters ',
  4103.                                                  'for file transfer.');
  4104.                          WRITELN('   SHOW       - displays the values of the ',
  4105.                                                  'parameters settable by the');
  4106.                          WRITELN('                set command.');
  4107.                          WRITELN('   STATISTICS - give information about the ',
  4108.                                                  'performance of the most ');
  4109.                          WRITELN('                recent file transfer.');
  4110.                          WRITELN('   TAKE       - executes Kermit commands ',
  4111.                                                  'from the specified file.');
  4112.                          WRITELN('   TRANSMIT   - send the specified file ',
  4113.                                                  'without protocol.');
  4114.                          WRITELN;
  4115.                          END;
  4116.                    END;
  4117.       LOCALCMD   : BEGIN
  4118.                    gettoken(sentence, cmdindex, token);
  4119.                    IF token = ' '
  4120.                       THEN
  4121.                          WRITELN('Illegal syntax for the LOCAL command.')
  4122.                       ELSE
  4123.                    IF token = '?'
  4124.                       THEN
  4125.                          WRITELN('Syntax : LOCAL command')
  4126.                       ELSE
  4127.                          BEGIN
  4128.                          llen := 0;
  4129.                          WHILE token[llen + 1] <> SP DO
  4130.                             BEGIN
  4131.                             llen := llen + 1;
  4132.                             END;
  4133.                          argcount := 1;
  4134.                          arg[1].length := llen;
  4135.                          FOR index := 1 TO llen DO
  4136.                             arg[1].data[index] := token[index];
  4137.                          argvector[1] := ADDR(arg[1]);
  4138.                          NAME_$GET_PATH(arg[1].data, arg[1].length,
  4139.                                         lcmd, llen, status);
  4140.                          IF status.all <> STATUS_$OK
  4141.                             THEN { pathname given is not relative }
  4142.                                BEGIN
  4143.                                lcmd := '/com/';
  4144.                                FOR index := 6 TO arg[1].length + 5 DO
  4145.                                   lcmd[index] := arg[1].data[index-5];
  4146.                                llen := arg[1].length + 5;
  4147.                                END;
  4148.                          gettoken(sentence, cmdindex, token);
  4149.                          WHILE token <> ' ' DO
  4150.                             BEGIN
  4151.                             argcount := argcount + 1;
  4152.                             arg[argcount].length := 0;
  4153.                             WHILE token[arg[argcount].length+1] <> SP DO
  4154.                                BEGIN
  4155.                                arg[argcount].length := arg[argcount].length
  4156.                                                         + 1;
  4157.                                arg[argcount].data[arg[argcount].length] :=
  4158.                                   token[arg[argcount].length];
  4159.                                END;
  4160.                             argvector[argcount] := ADDR(arg[argcount]);
  4161.                             gettoken(sentence, cmdindex, token);
  4162.                             END;
  4163.                          strcount := 2;
  4164.                          strvector[1] := STREAM_$STDIN;
  4165.                          strvector[2] := STREAM_$STDOUT;
  4166.                          inv_mode := [PGM_$WAIT];
  4167.                          PGM_$INVOKE(lcmd, llen, argcount, argvector, strcount,
  4168.                                      strvector, inv_mode, reserved, status);
  4169.                          IF status.all = STATUS_$OK
  4170.                             THEN
  4171.                                WRITELN('Local command executed OK.')
  4172.                             ELSE
  4173.                                WRITELN('Error executing local command.');
  4174.                          END;
  4175.                    END;
  4176.       LOGCMD     : BEGIN
  4177.                    gettoken(sentence, cmdindex, token);
  4178.                    IF token = '?'
  4179.                       THEN
  4180.                          WRITELN('Syntax : LOG [option] [filespec]')
  4181.                       ELSE
  4182.                    IF (token = 'TRANSACTIONS') OR (token = 'transactions')
  4183.                       THEN
  4184.                          BEGIN
  4185.                          gettoken(sentence, cmdindex, token);
  4186.                          IF token = '?'
  4187.                             THEN
  4188.                                WRITELN('OFF or any valid file name.')
  4189.                             ELSE
  4190.                          IF (token = 'OFF') OR (token = 'off')
  4191.                             THEN
  4192.                                BEGIN
  4193.                                IF transactlength <> 0 (* should be > but compiler
  4194.                                                          generates warning *)
  4195.                                   THEN CLOSE(transactfile);
  4196.                                transactname := ' ';
  4197.                                transactlength := 0;
  4198.                                logging.transactions := FALSE;
  4199.                                WRITELN('Logging of transactions is now off.');
  4200.                                END
  4201.                             ELSE
  4202.                          IF token = ' '
  4203.                             THEN
  4204.                                WRITELN('Illegal syntax for filespec.')
  4205.                             ELSE
  4206.                                BEGIN
  4207.                                IF transactname <> ' '
  4208.                                   THEN CLOSE(transactfile);
  4209.                                OPEN(transactfile, token, 'UNKNOWN', iostatus);
  4210.                                IF iostatus <> 0
  4211.                                   THEN
  4212.                                      BEGIN
  4213.                                      WRITELN('Unable to open LOG file.');
  4214.                                      logging.transactions := FALSE;
  4215.                                      END
  4216.                                   ELSE
  4217.                                      BEGIN
  4218.                                      transactname := ' ';
  4219.                                      transactlength := 0;
  4220.                                      REPEAT
  4221.                                         transactlength := transactlength + 1;
  4222.                                         transactname[transactlength] :=
  4223.                                            token[transactlength];
  4224.                                      UNTIL token[transactlength] = SP;
  4225.                                      WRITELN('Logging transactions to ',
  4226.                                              transactname:transactlength);
  4227.                                      REWRITE(transactfile);
  4228.                                      logging.transactions := TRUE;
  4229.                                      END;
  4230.                                END;
  4231.                          END
  4232.                       ELSE
  4233.                    IF (token = 'SESSION') OR (token = 'session')
  4234.                       THEN
  4235.                          BEGIN
  4236.                          gettoken(sentence, cmdindex, token);
  4237.                          IF token = '?'
  4238.                             THEN
  4239.                                WRITELN('OFF or any valid file name.')
  4240.                             ELSE
  4241.                          IF (token = 'OFF') OR (token = 'off')
  4242.                             THEN
  4243.                                BEGIN
  4244.                                IF sessionlength <> 0  (* should be > but compiler
  4245.                                                          generates warning *)
  4246.                                   THEN CLOSE(sessionfile);
  4247.                                sessionname := ' ';
  4248.                                sessionlength := 0;
  4249.                                logging.session := FALSE;
  4250.                                WRITELN('Log file for session is now closed.');
  4251.                                END
  4252.                             ELSE
  4253.                          IF token = ' '
  4254.                             THEN
  4255.                                WRITELN('Illegal syntax for filespec.')
  4256.                             ELSE
  4257.                                BEGIN
  4258.                                IF sessionname <> ' '
  4259.                                   THEN CLOSE(sessionfile);
  4260.                                OPEN(sessionfile, token, 'UNKNOWN', iostatus);
  4261.                                IF iostatus <> 0
  4262.                                   THEN
  4263.                                      BEGIN
  4264.                                      WRITELN('Unable to open LOG file.');
  4265.                                      logging.session := FALSE;
  4266.                                      END
  4267.                                   ELSE
  4268.                                      BEGIN
  4269.                                      sessionname := ' ';
  4270.                                      sessionlength := 0;
  4271.                                      REPEAT
  4272.                                         sessionlength := sessionlength + 1;
  4273.                                         sessionname[sessionlength] :=
  4274.                                            token[sessionlength];
  4275.                                      UNTIL token[sessionlength] = SP;
  4276.                                      WRITELN('Logging sessions to ',
  4277.                                              sessionname:sessionlength);
  4278.                                      REWRITE(sessionfile);
  4279.                                      logging.session := TRUE;
  4280.                                      END;
  4281.                                END;
  4282.                          END;
  4283.                    END;
  4284.       NULLCMD    : { do nothing };
  4285.       RECEIVECMD : BEGIN
  4286.                    gettoken(sentence, cmdindex, token);
  4287.                    IF token = '?'
  4288.                       THEN
  4289.                          WRITELN('Syntax : RECEIVE [filename]')
  4290.                       ELSE
  4291.                          BEGIN
  4292.                          rcvname := ' ';  (* stays blank if no name given *)
  4293.                          rcvlength := 0;
  4294.                          WHILE token[rcvlength + 1] <> SP DO
  4295.                             BEGIN
  4296.                             rcvlength := rcvlength + 1;
  4297.                             rcvname[rcvlength] := token[rcvlength];
  4298.                             END;
  4299.                          open_sio_line;
  4300.                          IF sio_line_opened
  4301.                             THEN
  4302.                                BEGIN
  4303.                                initialize_for_send_receive;
  4304.                                state := REC_INIT;
  4305.                                END;
  4306.                          END;
  4307.                    END;
  4308.       SENDCMD    : BEGIN
  4309.                    gettoken(sentence, cmdindex, token);
  4310.                    IF token = '?'
  4311.                       THEN
  4312.                          WRITELN('Syntax : SEND filespec')
  4313.                       ELSE
  4314.                    IF token = ' '
  4315.                       THEN
  4316.                          WRITELN('Illegal syntax for the SEND command.')
  4317.                       ELSE
  4318.                          BEGIN
  4319.                          xmtname := ' ';
  4320.                          xmtlength := 0;
  4321.                          WHILE token[xmtlength + 1] <> SP DO
  4322.                             BEGIN
  4323.                             xmtlength := xmtlength + 1;
  4324.                             xmtname[xmtlength] := token[xmtlength];
  4325.                             END;
  4326.                          FOR index := 1 TO xmtlength DO        (* +2.8a *)
  4327.                              lcmd[index] := xmtname[index];    (* +2.8a *)
  4328.                          inquiry_attri.obj_name := lcmd;       (* +2.8a *)
  4329.                          inquiry_attri.obj_namlen := xmtlength;(* +2.8a *)
  4330.                          STREAM_$INQUIRE ([12], STREAM_$NAME_UNCONDITIONAL,      (* +2.8a *)
  4331.                                           inquiry_attri, inquiry_error, status); (* +2.8a *)
  4332.                          IF (status.all <> STATUS_$OK) THEN    (* +2.8a *)
  4333.                             WRITELN('SEND file not found.')    (* +2.8a *)
  4334.                          ELSE                                  (* +2.8a *)
  4335.                             BEGIN                              (* +2.8a *)
  4336.                             open_sio_line;
  4337.                             IF sio_line_opened
  4338.                                THEN
  4339.                                   BEGIN
  4340.                                   initialize_for_send_receive;
  4341.                                   IF mode=host THEN
  4342.                                      BEGIN
  4343.                                      waitvalues[TIME_INDEX] :=
  4344.                                         EC2_$READ(waitptrs[TIME_INDEX]^) +
  4345.                                         (4 * send_delay); { ticks 1/4 sec }
  4346.                                      discard( EC2_$WAIT(waitptrs[TIME_INDEX],
  4347.                                                       waitvalues[TIME_INDEX],
  4348.                                                       1, status) );
  4349.                                      END;
  4350.                                   state := SEND_INIT;
  4351.                                   END;
  4352.                             END;                               (* +2.8a *)
  4353.                          END;
  4354.                    END;
  4355.       SERVERCMD  : BEGIN
  4356.                    IF mode = local
  4357.                       THEN
  4358.                          BEGIN
  4359.                          WRITELN('Warning : The SERVER command is intended to ',
  4360.                                  'be used when Kermit is a host.');
  4361.                          RETURN;
  4362.                          END;
  4363.                    gettoken(sentence, cmdindex, token);
  4364.                    IF token = '?'
  4365.                       THEN
  4366.                          WRITELN('Syntax : SERVER')
  4367.                       ELSE
  4368.                    IF token <> ' '
  4369.                       THEN
  4370.                          WRITELN('Illegal syntax for the SERVER command.')
  4371.                       ELSE
  4372.                          BEGIN
  4373.                          open_sio_line;
  4374.                          IF sio_line_opened
  4375.                             THEN
  4376.                                BEGIN
  4377.                                WRITE(' Kermit server running on Apollo host');
  4378.                                WRITE('.  Please type your escape sequence ');
  4379.                                WRITELN('to');
  4380.                                WRITE(' return to your local machine.  Shut');
  4381.                                WRITE(' down the server by typing the Kermit');
  4382.                                WRITELN;
  4383.                                WRITE(' FINISH command on your local machine.');
  4384.                                WRITELN;
  4385.                                WRITELN;
  4386.                                initialize_for_send_receive;
  4387.                                state := REC_SERVER_IDLE;
  4388.                                server_mode := TRUE;
  4389.                                END;
  4390.                          END;
  4391.                    END;
  4392.       SETCMD     : BEGIN
  4393.                    gettoken(sentence, cmdindex, token);
  4394.                    IF token = '?'
  4395.                       THEN
  4396.                          WRITELN('Syntax : SET parameter [option] [value]')
  4397.                       ELSE
  4398.                    IF (token = 'BAUD-RATE') OR (token = 'baud-rate') OR
  4399.                       (token = 'BAUD') OR (token = 'baud')
  4400.                       THEN
  4401.                          BEGIN
  4402.                          gettoken(sentence, cmdindex, token);
  4403.                          IF token = '?'
  4404.                             THEN
  4405.                                WRITELN('110 or 300 or 1200 or 4800 or 9600 or ',
  4406.                                        '19200')
  4407.                             ELSE
  4408.                          IF token = '110'
  4409.                             THEN
  4410.                                BEGIN
  4411.                                SIO_$CONTROL(sio_stream, SIO_$SPEED,
  4412.                                             SIO_$110, status);
  4413.                                IF status.all <> STATUS_$OK
  4414.                                   THEN
  4415.                                      WRITELN('Unable to set baud-rate to 110.');
  4416.                                END
  4417.                             ELSE
  4418.                          IF token = '300'
  4419.                             THEN
  4420.                                BEGIN
  4421.                                SIO_$CONTROL(sio_stream, SIO_$SPEED,
  4422.                                             SIO_$300, status);
  4423.                                IF status.all <> STATUS_$OK
  4424.                                   THEN
  4425.                                      WRITELN('Unable to set baud-rate to 300.');
  4426.                                END
  4427.                             ELSE
  4428.                          IF token = '1200'
  4429.                             THEN
  4430.                                BEGIN
  4431.                                SIO_$CONTROL(sio_stream, SIO_$SPEED,
  4432.                                             SIO_$1200, status);
  4433.                                IF status.all <> STATUS_$OK
  4434.                                   THEN
  4435.                                      WRITELN('Unable to set baud-rate to ',
  4436.                                              '1200.');
  4437.                                END
  4438.                             ELSE
  4439.                          IF token = '4800'
  4440.                             THEN
  4441.                                BEGIN
  4442.                                SIO_$CONTROL(sio_stream, SIO_$SPEED,
  4443.                                             SIO_$4800, status);
  4444.                                IF status.all <> STATUS_$OK
  4445.                                   THEN
  4446.                                      WRITELN('Unable to set baud-rate to ',
  4447.                                              '4800.');
  4448.                                END
  4449.                             ELSE
  4450.                          IF token = '9600'
  4451.                             THEN
  4452.                                BEGIN
  4453.                                SIO_$CONTROL(sio_stream, SIO_$SPEED,
  4454.                                             SIO_$9600, status);
  4455.                                IF status.all <> STATUS_$OK
  4456.                                   THEN
  4457.                                      WRITELN('Unable to set baud-rate to ',
  4458.                                              '9600.');
  4459.                                END
  4460.                             ELSE
  4461.                          IF token = '19200'
  4462.                             THEN
  4463.                                BEGIN
  4464.                                SIO_$CONTROL(sio_stream, SIO_$SPEED,
  4465.                                             SIO_$19200, status);
  4466.                                IF status.all <> STATUS_$OK
  4467.                                   THEN
  4468.                                      WRITELN('Unable to set baud-rate to ',
  4469.                                              '19200.');
  4470.                                END
  4471.                             ELSE
  4472.                                WRITELN('Illegal option for BAUD-RATE ',
  4473.                                        'parameter.');
  4474.                          END
  4475.                       ELSE
  4476.                    IF (token = 'DEBUG') OR (token = 'debug') OR
  4477.                       (token = 'D') OR (token = 'd')
  4478.                       THEN
  4479.                          BEGIN
  4480.                          gettoken(sentence, cmdindex, token);
  4481.                          IF token = '?'
  4482.                             THEN
  4483.                                WRITELN('ON or OFF')
  4484.                             ELSE
  4485.                          IF (token = 'OFF') OR (token = 'off')
  4486.                             THEN
  4487.                                BEGIN
  4488.                                CLOSE(debugfile);
  4489.                                WRITELN('Debug mode is now off.');
  4490.                                debug := FALSE;
  4491.                                END
  4492.                             ELSE
  4493.                          IF (token = 'ON') OR (token = 'on')
  4494.                             THEN
  4495.                                BEGIN
  4496.                                OPEN(debugfile, 'kermit_debug', 'UNKNOWN');
  4497.                                REWRITE(debugfile);
  4498.                                WRITELN('Debug mode is now on.');
  4499.                                debug := TRUE;
  4500.                                END
  4501.                             ELSE
  4502.                                WRITELN('Illegal option for DEBUG parameter.');
  4503.                          END
  4504.                       ELSE
  4505.                    IF (token = 'DELAY') OR (token = 'delay')
  4506.                       THEN
  4507.                          BEGIN
  4508.                          gettoken(sentence, cmdindex, token);
  4509.                          IF token = '?'
  4510.                             THEN
  4511.                                WRITELN('Any non-negative integer.')
  4512.                             ELSE
  4513.                                BEGIN
  4514.                                send_delay := convert_to_int(token);
  4515.                                IF send_delay < 0
  4516.                                   THEN
  4517.                                      BEGIN
  4518.                                      WRITELN('Illegal option for DELAY ',
  4519.                                              'parameter.');
  4520.                                      send_delay := DEFAULT_send_delay;
  4521.                                      END;
  4522.                                END;
  4523.                          END
  4524.                       ELSE
  4525.                    IF (token = 'ECHO') OR (token = 'echo')
  4526.                       THEN
  4527.                          BEGIN
  4528.                          gettoken(sentence, cmdindex, token);
  4529.                          IF token = '?'
  4530.                             THEN
  4531.                                WRITELN('ON or OFF')
  4532.                             ELSE
  4533.                          IF (token = 'ON') OR (token = 'on')
  4534.                             THEN
  4535.                                BEGIN
  4536.                                local_echo := TRUE;
  4537.                                WRITELN('Local keystrokes will be echoed.');
  4538.                                END
  4539.                             ELSE
  4540.                          IF (token = 'OFF') OR (token = 'off')
  4541.                             THEN
  4542.                                BEGIN
  4543.                                local_echo := FALSE;
  4544.                                WRITELN('Local keystrokes will not be echoed.');
  4545.                                END
  4546.                             ELSE
  4547.                                WRITELN('Illegal option for ECHO parameter.');
  4548.                          END
  4549.                       ELSE
  4550.                    IF (token = 'ESCAPE') OR (token = 'escape')
  4551.                       THEN
  4552.                          BEGIN
  4553.                          gettoken(sentence, cmdindex, token);
  4554.                          IF token = '?'
  4555.                             THEN
  4556.                                IF graphics THEN
  4557.                                   WRITELN('Any ascii character.')
  4558.                                  ELSE
  4559.                                   WRITELN('Any printable character.')
  4560.                             ELSE
  4561.                          IF (token = SP) OR (token[2] <> SP) OR (NOT graphics AND
  4562.                            ((token[1] < SP) OR (token[1] =DEL)) )
  4563.                             THEN
  4564.                                WRITELN('Illegal option for ESCAPE parameter.')
  4565.                             ELSE
  4566.                                BEGIN
  4567.                                escape_char := token[1];
  4568.                                WRITE('The escape character is set to ');
  4569.                                IF (escape_char < SP) OR (escape_char = DEL)
  4570.                                   THEN WRITELN('^', ctl(escape_char))
  4571.                                   ELSE WRITELN(escape_char);
  4572.                                END; (* of else *)
  4573.                          END
  4574.                       ELSE
  4575.                    IF (token = 'FILE_TYPE') OR (token = 'file_type')
  4576.                       THEN
  4577.                          BEGIN
  4578.                          gettoken(sentence, cmdindex, token);
  4579.                          IF token = '?'
  4580.                             THEN
  4581.                                WRITELN('ASCII or BINARY')
  4582.                             ELSE
  4583.                          IF (token = 'ASCII') OR (token = 'ascii')
  4584.                             THEN
  4585.                                BEGIN
  4586.                                file_type := ascii;
  4587.                                WRITELN('FILE_TYPE is now ASCII');
  4588.                                END
  4589.                             ELSE
  4590.                          IF (token = 'BINARY') OR (token = 'binary')
  4591.                             THEN
  4592.                                BEGIN
  4593.                                file_type := binary;
  4594.                                WRITELN('FILE_TYPE is now BINARY');
  4595.                                END
  4596.                             ELSE
  4597.                                BEGIN
  4598.                                WRITE('Illegal option for the FILE_TYPE ');
  4599.                                WRITELN('parameter.');
  4600.                                END;
  4601.                          END
  4602.                       ELSE
  4603.                    IF (token = 'LINE') OR (token = 'line')
  4604.                       THEN
  4605.                          BEGIN
  4606.                          gettoken(sentence, cmdindex, token);
  4607.                          IF token = '?'
  4608.                             THEN
  4609.                                WRITELN('1,2 or 3')
  4610.                             ELSE
  4611.                          IF (token = '1') OR (token = '2') OR (token = '3')
  4612.                             THEN
  4613.                                BEGIN
  4614.                                IF mode <> local
  4615.                                   THEN
  4616.                                      BEGIN
  4617.                                      WRITELN('Warning : the LINE command is ',
  4618.                                              'intended to be used when Kermit ',
  4619.                                              'is local.');
  4620.                                      RETURN;
  4621.                                      END;
  4622.                                sio_line := ord(token[1])-ord('0');
  4623.                                END
  4624.                             ELSE
  4625.                                WRITELN('Illegal option for LINE parameter.');
  4626.                          END
  4627.                       ELSE
  4628.                    IF (token = 'NAKS') OR (token = 'naks')
  4629.                       THEN
  4630.                          BEGIN
  4631.                          gettoken(sentence, cmdindex, token);
  4632.                          IF token = '?'
  4633.                             THEN
  4634.                                WRITELN('ON or OFF')
  4635.                             ELSE
  4636.                          IF (token = 'OFF') OR (token = 'off')
  4637.                             THEN
  4638.                                BEGIN
  4639.                                WRITE('Server mode will not send periodic Naks');
  4640.                                WRITELN;
  4641.                                sendservNAKs := FALSE;
  4642.                                END
  4643.                             ELSE
  4644.                          IF (token = 'ON') OR (token = 'on')
  4645.                             THEN
  4646.                                BEGIN
  4647.                                WRITELN('Server mode will send periodic NAKs');
  4648.                                sendservNAKs := TRUE;
  4649.                                END
  4650.                             ELSE
  4651.                                WRITELN('Illegal option for NAKS parameter.');
  4652.                          END
  4653.                       ELSE
  4654.                    IF (token = 'PARITY') OR (token = 'parity')
  4655.                       THEN
  4656.                          BEGIN
  4657.                          gettoken(sentence, cmdindex, token);
  4658.                          IF token = '?'
  4659.                             THEN
  4660.                                WRITELN('ODD or EVEN or NONE')
  4661.                             ELSE
  4662.                          IF (token = 'ODD') OR (token = 'odd')
  4663.                             THEN
  4664.                                BEGIN
  4665.                                SIO_$CONTROL(sio_stream, SIO_$PARITY,
  4666.                                             SIO_$ODD_PARITY, status);
  4667.                                IF status.all <> STATUS_$OK
  4668.                                   THEN
  4669.                                      WRITELN('Unable to set odd parity.');
  4670.                                END
  4671.                             ELSE
  4672.                          IF (token = 'EVEN') OR (token = 'even')
  4673.                             THEN
  4674.                                BEGIN
  4675.                                SIO_$CONTROL(sio_stream, SIO_$PARITY,
  4676.                                             SIO_$EVEN_PARITY, status);
  4677.                                IF status.all <> STATUS_$OK
  4678.                                   THEN
  4679.                                      WRITELN('Unable to set even parity.');
  4680.                                END
  4681.                             ELSE
  4682.                          IF (token = 'NONE') OR (token = 'none')
  4683.                             THEN
  4684.                                BEGIN
  4685.                                SIO_$CONTROL(sio_stream, SIO_$PARITY,
  4686.                                             SIO_$NO_PARITY, status);
  4687.                                IF status.all <> STATUS_$OK
  4688.                                   THEN
  4689.                                      WRITELN('Unable to set no parity.');
  4690.                                END
  4691.                             ELSE
  4692.                                WRITELN('Illegal option for PARITY parameter.');
  4693.                          END
  4694.                       ELSE
  4695.                    IF (token = 'RETRY') OR (token = 'retry')
  4696.                       THEN
  4697.                          BEGIN
  4698.                          gettoken(sentence, cmdindex, token);
  4699.                          IF token = '?'
  4700.                             THEN
  4701.                                WRITELN('Any non-negative integer.')
  4702.                             ELSE
  4703.                                BEGIN
  4704.                                maxtries := convert_to_int(token);
  4705.                                IF maxtries < 0
  4706.                                   THEN
  4707.                                      BEGIN
  4708.                                      WRITELN('Illegal option for RETRY ',
  4709.                                              'parameter.');
  4710.                                      maxtries := DEFAULT_maxtries;
  4711.                                      END;
  4712.                                END;
  4713.                          END
  4714.                       ELSE
  4715.                    IF (token = 'NORMAL') OR (token = 'normal')
  4716.                       THEN
  4717.                          BEGIN
  4718.                          gettoken(sentence, cmdindex, token);
  4719.                          IF token = '?'
  4720.                             THEN
  4721.                                WRITELN('ON or OFF')
  4722.                             ELSE
  4723.                          IF (token = 'OFF') OR (token = 'off')
  4724.                             THEN
  4725.                                BEGIN
  4726.                                WRITE('Filenames will be sent/used  verbatim');
  4727.                                WRITELN;
  4728.                                normal := FALSE;
  4729.                                END
  4730.                             ELSE
  4731.                          IF (token = 'ON') OR (token = 'on')
  4732.                             THEN
  4733.                                BEGIN
  4734.                                WRITELN('File names will be normalised');
  4735.                                normal := TRUE;
  4736.                                END
  4737.                             ELSE
  4738.                                WRITELN('Illegal option for NORMAL parameter.');
  4739.                          END
  4740.                       ELSE
  4741.                    IF (token = 'TIME') OR (token = 'time')
  4742.                       THEN
  4743.                          BEGIN
  4744.                          gettoken(sentence, cmdindex, token);
  4745.                          IF token = '?'
  4746.                             THEN
  4747.                                WRITELN('Any positive integer.')
  4748.                             ELSE
  4749.                                BEGIN
  4750.                                mytimeout := convert_to_int(token);
  4751.                                IF mytimeout > 0
  4752.                                   THEN
  4753.                                      writeln('I will ask remote Kermit to time me',
  4754.                                        ' out after ',mytimeout:1,' seconds')
  4755.                                   ELSE
  4756.                                      BEGIN
  4757.                                      WRITELN('Illegal value for TIME ',
  4758.                                              'parameter.');
  4759.                                      mytimeout := DEFAULT_mytimeout;
  4760.                                      END;
  4761.                                END;
  4762.                          END
  4763.                       ELSE
  4764.                    IF (token = 'TIMEOUT') OR (token = 'timeout')
  4765.                       THEN
  4766.                          BEGIN
  4767.                          gettoken(sentence, cmdindex, token);
  4768.                          IF token = '?'
  4769.                             THEN
  4770.                                WRITELN('Any positive integer.')
  4771.                             ELSE
  4772.                                BEGIN
  4773.                                theirtimeout := convert_to_int(token);
  4774.                                IF theirtimeout > 0
  4775.                                   THEN
  4776.                                      writeln('I will timeout the remote Kermit ',
  4777.                                        'after ',theirtimeout:1,' seconds')
  4778.                                   ELSE
  4779.                                      BEGIN
  4780.                                      WRITELN('Illegal value for TIMEOUT ',
  4781.                                              'parameter.');
  4782.                                      theirtimeout := DEFAULT_theirtimeout;
  4783.                                      END;
  4784.                                END;
  4785.                          END
  4786.                       ELSE
  4787.                    IF (token = 'GRAPHICS') OR (token = 'graphics')
  4788.                       THEN
  4789.                          BEGIN
  4790.                          gettoken(sentence, cmdindex, token);
  4791.                          IF token = '?'
  4792.                             THEN
  4793.                                WRITELN('ON or OFF')
  4794.                             ELSE
  4795.                          IF (token = 'OFF') OR (token = 'off')
  4796.                             THEN
  4797.                                BEGIN
  4798.                                WRITELN('Will not use Graphics Primitives');
  4799.                                graphics := FALSE;
  4800.                                (* ensure escape chara. is printing *)
  4801.                                IF (escape_char < SP) OR (escape_char =DEL) THEN
  4802.                                   BEGIN
  4803.                                   escape_char := DEFAULT_alt_escape_char;
  4804.                                   WRITELN('The escape character is reset to ',
  4805.                                     escape_char);
  4806.                                   END;
  4807.                                (* This next bit could go if PAD_RAW section existed *)
  4808.                                IF (display_type =display) THEN
  4809.                                   BEGIN
  4810.                                   rawmode := FALSE;
  4811.                                   WRITELN('RAW set off');
  4812.                                   END;
  4813.                                END
  4814.                             ELSE
  4815.                          IF (token = 'ON') OR (token = 'on')
  4816.                             THEN
  4817.                                BEGIN
  4818.                                WRITELN('Will use Graphics Primitives');
  4819.                                graphics := TRUE;
  4820.                                rawmode := TRUE;
  4821.                                END
  4822.                             ELSE
  4823.                                WRITELN('Illegal option for GRAPHICS parameter.');
  4824.                          END
  4825.                       ELSE
  4826.                    IF (token = 'cvt_NL') OR (token = 'cvt_nl') OR (token = 'CVT_nl') OR
  4827.                       (token = 'CVT_NL')
  4828.                       (* rawmode was NOT cvt_NL *)
  4829.                       THEN
  4830.                          BEGIN
  4831.                          gettoken(sentence, cmdindex, token);
  4832.                          IF token = '?'
  4833.                             THEN
  4834.                                WRITELN('ON or OFF')
  4835.                             ELSE
  4836.                          IF (token = 'OFF') OR (token = 'off')
  4837.                             THEN
  4838.                                BEGIN
  4839.                                WRITELN('Will transfer LF and CR as is');
  4840.                                rawmode := TRUE;
  4841.                                END
  4842.                             ELSE
  4843.                          IF (token = 'ON') OR (token = 'on')
  4844.                             THEN
  4845.                                BEGIN
  4846.                                WRITELN('Will send Apollo LF as CR and convert host',
  4847.                                 ' CR to LF');
  4848.                                rawmode := FALSE;
  4849.                                END
  4850.                             ELSE
  4851.                                WRITELN('Illegal option for CVT_NL parameter.');
  4852.                          END
  4853.                       ELSE
  4854.                    IF (token = 'raw') OR (token = 'RAW')
  4855.                       THEN
  4856.                          BEGIN
  4857.                          gettoken(sentence, cmdindex, token);
  4858.                          IF token = '?'
  4859.                             THEN
  4860.                                WRITELN('ON or OFF')
  4861.                             ELSE
  4862.                          IF (token = 'OFF') OR (token = 'off')
  4863.                             THEN
  4864.                                BEGIN
  4865.                                WRITELN('Connect will use "cooked" mode.');
  4866.                                rawmode := FALSE;
  4867.                                END
  4868.                             ELSE
  4869.                          IF (token = 'ON') OR (token = 'on')
  4870.                             THEN
  4871.                                BEGIN
  4872.                                WRITELN('Connect will use "raw" mode.');
  4873.                                rawmode := TRUE;
  4874.                                END
  4875.                             ELSE
  4876.                                WRITELN('Illegal option for RAW parameter.');
  4877.                          END
  4878.                       ELSE
  4879.                    IF (token = '8BIT') OR (token = '8bit')
  4880.                       THEN
  4881.                          BEGIN
  4882.                          gettoken(sentence, cmdindex, token);
  4883.                          IF token = '?'
  4884.                             THEN
  4885.                                WRITELN('ON or OFF')
  4886.                             ELSE
  4887.                          IF (token = 'OFF') OR (token = 'off')
  4888.                             THEN
  4889.                                BEGIN
  4890.                                WRITELN('Will not do 8 bit quoting');
  4891.                                eight_bit := FALSE;
  4892.                                myqbin := 'N';
  4893.                                END
  4894.                             ELSE
  4895.                          IF (token = 'ON') OR (token = 'on')
  4896.                             THEN
  4897.                                BEGIN
  4898.                                WRITELN('Will ask for 8 bit quoting');
  4899.                                eight_bit := TRUE;
  4900.                                myqbin := '&';
  4901.                                END
  4902.                             ELSE
  4903.                                WRITELN('Illegal option for 8BIT parameter.');
  4904.                          END
  4905.                       ELSE
  4906.                          WRITELN('Undefined SET parameter.');
  4907.                    END;
  4908.       SHOWCMD    : BEGIN
  4909.                    gettoken(sentence, cmdindex, token);
  4910.                    IF token = '?'
  4911.                       THEN
  4912.                          WRITELN('Syntax : SHOW [option]')
  4913.                       ELSE
  4914.                          BEGIN
  4915.                          IF NOT sio_line_opened
  4916.                             THEN open_sio_line;
  4917.                          IF sio_line_opened
  4918.                             THEN
  4919.                                BEGIN
  4920.                                SIO_$INQUIRE(sio_stream, SIO_$SPEED, baud,
  4921.                                            status);
  4922.                                IF status.all = STATUS_$OK
  4923.                                   THEN
  4924.                                      BEGIN
  4925.                                      WRITE('BAUD-RATE   : ');
  4926.                                      CASE baud OF
  4927.                                         SIO_$50    : WRITELN('50');
  4928.                                         SIO_$75    : WRITELN('75');
  4929.                                         SIO_$110   : WRITELN('110');
  4930.                                         SIO_$134   : WRITELN('134');
  4931.                                         SIO_$150   : WRITELN('150');
  4932.                                         SIO_$300   : WRITELN('300');
  4933.                                         SIO_$600   : WRITELN('600');
  4934.                                         SIO_$1200  : WRITELN('1200');
  4935.                                         SIO_$2000  : WRITELN('2000');
  4936.                                         SIO_$2400  : WRITELN('2400');
  4937.                                         SIO_$3600  : WRITELN('3600');
  4938.                                         SIO_$4800  : WRITELN('4800');
  4939.                                         SIO_$7200  : WRITELN('7200');
  4940.                                         SIO_$9600  : WRITELN('9600');
  4941.                                         SIO_$19200 : WRITELN('19200');
  4942.                                         END; (* of case *)
  4943.                                      END; (* of if *)
  4944.                                END; (* of if *)
  4945.                          IF debug
  4946.                             THEN WRITELN('DEBUG       : on')
  4947.                             ELSE WRITELN('DEBUG       : off');
  4948.                          WRITELN('DELAY       : ', send_delay:1);
  4949.                          IF mode = local
  4950.                             THEN
  4951.                                BEGIN
  4952.                                WRITE('ESCAPE CHAR : ');
  4953.                                IF (escape_char < SP) OR (escape_char = DEL)
  4954.                                   THEN WRITELN('^', ctl(escape_char))
  4955.                                   ELSE WRITELN(escape_char);
  4956.                                WRITE('LOCAL ECHO  : ');
  4957.                                IF local_echo
  4958.                                   THEN WRITELN('On')
  4959.                                   ELSE WRITELN('Off');
  4960.                                END;
  4961.                          WRITE('FILE_TYPE   : ');
  4962.                          IF file_type = ascii
  4963.                             THEN WRITELN(' ascii')
  4964.                             ELSE WRITELN(' binary');
  4965.                          WRITELN('LINE        : ', sio_line:1);
  4966.                          IF mode = host
  4967.                             THEN
  4968.                                IF sendservNAKS
  4969.                                   THEN WRITELN('NAKS        : are sent')
  4970.                                   ELSE WRITELN('NAKS        : are not sent');
  4971.                          IF sio_line_opened
  4972.                             THEN
  4973.                                BEGIN
  4974.                                SIO_$INQUIRE(sio_stream, SIO_$PARITY,
  4975.                                             parity, status);
  4976.                                IF status.all = STATUS_$OK
  4977.                                   THEN
  4978.                                      BEGIN
  4979.                                      WRITE('PARITY      : ');
  4980.                                      CASE parity OF
  4981.                                         SIO_$ODD_PARITY  : WRITELN('odd');
  4982.                                         SIO_$EVEN_PARITY : WRITELN('even');
  4983.                                         SIO_$NO_PARITY   : WRITELN('none');
  4984.                                         END; (* of case *)
  4985.                                      END; (* of if *)
  4986.                                END; (* of if *)
  4987.                          WRITELN('RETRY       : ', maxtries:1);
  4988.                          IF normal
  4989.                             THEN WRITELN('NORMAL      : on')
  4990.                             ELSE WRITELN('NORMAL      : off');
  4991.                          WRITELN('TIME        : ', mytimeout:1);
  4992.                          WRITELN('TIMEOUT     : ', theirtimeout:1);
  4993.                          IF graphics
  4994.                             THEN WRITELN('GRAPHICS    : on')
  4995.                             ELSE WRITELN('GRAPHICS    : off');
  4996.                          IF rawmode
  4997.                             THEN WRITELN('RAW         : on')
  4998.                             ELSE WRITELN('RAW         : off');
  4999.                          IF eight_bit
  5000.                             THEN WRITELN('8BIT        : on')
  5001.                             ELSE WRITELN('8BIT        : off');
  5002.                          END; (* of token <> '?' *)
  5003.                    END;
  5004.       STATISTICSCMD : BEGIN
  5005.                       gettoken(sentence, cmdindex, token);
  5006.                       IF token = '?'
  5007.                          THEN
  5008.                             WRITELN('Syntax : STATISTICS')
  5009.                          ELSE
  5010.                       IF token <> ' '
  5011.                          THEN
  5012.                             WRITELN('Illegal syntax for the STATISTICS ',
  5013.                                     'command.')
  5014.                          ELSE
  5015.                       IF statistics.namelength = 0
  5016.                          THEN
  5017.                             WRITELN('No statistics currently available.')
  5018.                          ELSE
  5019.                             BEGIN
  5020.                             WITH statistics DO
  5021.                                BEGIN
  5022.                                WRITELN;
  5023.                                WRITELN('Statistics on most recent file ',
  5024.                                        'transferred :');
  5025.                                WRITELN;
  5026.                                WRITELN('   File name                    : ',
  5027.                                        filename:namelength);
  5028.                                WRITELN;
  5029.                                WRITE('   Transmitted                  : ');
  5030.                                IF completed
  5031.                                   THEN WRITELN('Successfully')
  5032.                                   ELSE WRITELN('Unsuccessfully');
  5033.  
  5034.                                CAL_$DECODE_TIME(starttime, clock);
  5035.                                WRITELN('   Starting Time                : ',
  5036.                                        clock.hour:1, ':', clock.minute:1);
  5037.                                CAL_$DECODE_TIME(stoptime, clock);
  5038.                                WRITELN('   Ending Time                  : ',
  5039.                                        clock.hour:1, ':', clock.minute:1);
  5040.                                total_time := stoptime;
  5041.                                IF CAL_$SUB_CLOCK(total_time, starttime)
  5042.                                   THEN
  5043.                                      BEGIN
  5044.                                      total_seconds := CAL_$CLOCK_TO_SEC(
  5045.                                                       total_time);
  5046.                                      WRITELN('   Total time               ',
  5047.                                              '    : ', total_seconds:1,
  5048.                                              ' seconds');
  5049.                                      END;
  5050.                                WRITELN('   Total characters transmitted : ',
  5051.                                        (charssent + charsrcvd):1);
  5052.                                WRITELN('      Characters sent           : ',
  5053.                                        charssent:1);
  5054.                                WRITELN('      Characters received       : ',
  5055.                                        charsrcvd:1);
  5056.                                WRITELN('      Maximum in one packet     : ',
  5057.                                        maxcharsinpkt:1);
  5058.                                WRITELN('   Overhead characters sent     : ',
  5059.                                        ovhdsent:1);
  5060.                                WRITELN('   Overhead characters received : ',
  5061.                                        ovhdrcvd:1);
  5062.                                WRITE('   Percent overhead             : ');
  5063.                                IF charssent + charsrcvd = 0
  5064.                                   THEN
  5065.                                      WRITELN('0.00%')
  5066.                                   ELSE
  5067.                                      WRITELN((((ovhdsent+ovhdrcvd) /
  5068.                                              (charssent+charsrcvd))*100):6:2,
  5069.                                              '%');
  5070.                                WRITE('   Baud-rate                    : ');
  5071.                                IF total_seconds = 0
  5072.                                   THEN
  5073.                                      WRITELN('Not determined')
  5074.                                   ELSE
  5075.                                      WRITELN(((charssent+charsrcvd) DIV
  5076.                                                total_seconds)*10:1);
  5077.                                WRITE('   Effective baud-rate          : ');
  5078.                                IF total_seconds = 0
  5079.                                   THEN
  5080.                                      WRITELN('Not determined')
  5081.                                   ELSE
  5082.                                      WRITELN(((charssent+charsrcvd-
  5083.                                               ovhdsent-ovhdrcvd) DIV
  5084.                                               total_seconds)*10:1);
  5085.                                WRITELN;
  5086.                                END; (* of with *)
  5087.                             END; (* of else *)
  5088.                       END; (* of statistics *)
  5089.       TAKECMD    : BEGIN
  5090.                    gettoken(sentence, cmdindex, token);
  5091.                    IF token = '?'
  5092.                       THEN
  5093.                          WRITELN('Syntax : TAKE filespec')
  5094.                       ELSE
  5095.                    IF token = ' '
  5096.                       THEN
  5097.                          WRITELN('Illegal syntax for the TAKE command.')
  5098.                       ELSE
  5099.                          BEGIN
  5100.                          IF take_mode
  5101.                             THEN
  5102.                                CLOSE(takefile);
  5103.                          OPEN(takefile, token, 'OLD', iostatus);
  5104.                          IF iostatus <> 0
  5105.                             THEN
  5106.                                BEGIN
  5107.                                WRITELN('TAKE file not found.');
  5108.                                take_mode := FALSE;
  5109.                                END
  5110.                             ELSE
  5111.                                BEGIN
  5112.                                WRITELN('Taking commands from specified file.');
  5113.                                RESET(takefile);
  5114.                                take_mode := TRUE;
  5115.                                END;
  5116.                          END;
  5117.                    END;
  5118.       TRANSMITCMD: BEGIN
  5119.                    gettoken(sentence, cmdindex, token);
  5120.                    IF token = '?'
  5121.                       THEN
  5122.                          WRITELN('Syntax : TRANSMIT filespec')
  5123.                       ELSE
  5124.                    IF token = ' '
  5125.                       THEN
  5126.                          WRITELN('Illegal syntax for the TRANSMIT command.')
  5127.                       ELSE
  5128.                          BEGIN
  5129.                          OPEN(transmitfile, token, 'OLD', iostatus);
  5130.                          IF iostatus <> 0
  5131.                             THEN
  5132.                                WRITELN('TRANSMIT file not found.')
  5133.                             ELSE
  5134.                                BEGIN
  5135.                                RESET(transmitfile);
  5136.                                WRITELN('Transmitting specified file...');
  5137.                                open_sio_line;
  5138.                                IF sio_line_opened
  5139.                                   THEN
  5140.                                      BEGIN
  5141.                                      size := 1;
  5142.                                      WHILE NOT EOF(transmitfile) DO
  5143.                                         BEGIN
  5144.                                         WHILE NOT EOLN(transmitfile) DO
  5145.                                            BEGIN
  5146.                                            READ(transmitfile, ch);
  5147.                                            STREAM_$PUT_REC(sio_stream, ADDR(ch),
  5148.                                                            size, key, status);
  5149.                                            END;
  5150.                                         STREAM_$PUT_REC(sio_stream, ADDR(CR),
  5151.                                                         size, key, status);
  5152.                                         STREAM_$PUT_REC(sio_stream, ADDR(LF),  (* +2.8a *)
  5153.                                                         size, key, status);    (* +2.8a *)
  5154.                                         READLN(transmitfile);
  5155.                                         END;
  5156.                                      END;
  5157.                                WRITELN('....Transmit complete.');
  5158.                                CLOSE(transmitfile);
  5159.                                END;
  5160.                          END;
  5161.                    END; (* of transmit command *)
  5162.    END; (* of case *)
  5163.    END; (* of processcommand *)
  5164.  
  5165.  
  5166.  
  5167. (******************************************************************************)
  5168. (*                                                                            *)
  5169. (* THE FOLLOWING PROCEDURE SCANS THE INPUT STRING FOR A VALID KERMIT COMMAND. *)
  5170. (* THE COMMAND FOUND IS PASSED BACK TO THE CALLING PROCEDURE.                 *)
  5171. (*                                                                            *)
  5172. (******************************************************************************)
  5173.  
  5174. PROCEDURE parseforcommand(sentence     : STRING;
  5175.                           VAR index    : INTEGER;
  5176.                           VAR cmdfound : cmdtyps);
  5177.  
  5178.    VAR
  5179.       token : string;
  5180.  
  5181.    BEGIN (* parseforcommand *)
  5182.    cmdfound := NULLCMD;
  5183.    index := 1;
  5184.    gettoken(sentence, index, token);
  5185.    IF (token = 'CONNECT') OR (token = 'connect') OR
  5186.       (token = 'C') OR (token = 'c')
  5187.       THEN
  5188.          cmdfound := CONNECTCMD
  5189.       ELSE
  5190.    IF (token = 'EXIT') OR (token = 'exit') OR
  5191.       (token = 'EX') OR (token = 'ex') OR
  5192.       (token = 'E') OR (token = 'e')
  5193.       THEN
  5194.          cmdfound := EXITCMD
  5195.       ELSE
  5196.    IF (token = 'FINISH') OR (token = 'finish') OR
  5197.       (token = 'FI') OR (token = 'fi') OR
  5198.       (token = 'F') OR (token = 'f')
  5199.       THEN
  5200.          cmdfound := FINISHCMD
  5201.       ELSE
  5202.    IF (token = 'GET') OR (token = 'get') OR
  5203.       (token = 'G') OR (token = 'g')
  5204.       THEN
  5205.          cmdfound := GETCMD
  5206.       ELSE
  5207.    IF (token = 'HELP') OR (token = 'help') OR
  5208.       (token = 'H') OR (token = 'h') OR
  5209.       (token = '?')
  5210.       THEN
  5211.          cmdfound := HELPCMD
  5212.       ELSE
  5213.    IF (token = 'LOCAL') OR (token = 'local') OR
  5214.       (token = 'LOC') OR (token = 'loc')
  5215.       THEN
  5216.          cmdfound := LOCALCMD
  5217.       ELSE
  5218.    IF (token = 'LOG') OR (token = 'log')
  5219.       THEN
  5220.          cmdfound := LOGCMD
  5221.       ELSE
  5222.    IF (token = 'QUIT') OR (token = 'quit') OR
  5223.       (token = 'Q') OR (token = 'q')
  5224.       THEN
  5225.          cmdfound := EXITCMD
  5226.       ELSE
  5227.    IF (token = 'RECEIVE') OR (token = 'receive') OR
  5228.       (token = 'R') OR (token = 'r')
  5229.       THEN
  5230.          cmdfound := RECEIVECMD
  5231.       ELSE
  5232.    IF (token = 'SEND') OR (token = 'send') OR
  5233.       (token = 'SEN') OR (token = 'sen')
  5234.       THEN
  5235.          cmdfound := SENDCMD
  5236.       ELSE
  5237.    IF (token = 'SERVER') OR (token = 'server') OR
  5238.       (token = 'SER') OR (token = 'ser')
  5239.       THEN
  5240.          cmdfound := SERVERCMD
  5241.       ELSE
  5242.    IF (token = 'SET') OR (token = 'set')
  5243.       THEN
  5244.          cmdfound := SETCMD
  5245.       ELSE
  5246.    IF (token = 'SHOW') OR (token = 'show') OR
  5247.       (token = 'SH') OR (token = 'sh')
  5248.       THEN
  5249.          cmdfound := SHOWCMD
  5250.       ELSE
  5251.    IF (token = 'STATISTICS') OR (token = 'statistics') OR
  5252.       (token = 'ST') OR (token = 'st')
  5253.       THEN
  5254.          cmdfound := STATISTICSCMD
  5255.       ELSE
  5256.    IF (token = 'TAKE') OR (token = 'take') OR
  5257.       (token = 'TA') OR (token = 'ta')
  5258.       THEN
  5259.          cmdfound := TAKECMD
  5260.       ELSE
  5261.    IF (token = 'TRANSMIT') OR (token = 'transmit') OR
  5262.       (token = 'TR') OR (token = 'tr')
  5263.       THEN
  5264.          cmdfound := TRANSMITCMD
  5265.       ELSE
  5266.    IF token <> ' '
  5267.       THEN
  5268.          WRITELN('Unrecognized command - please reenter.');
  5269.    END; (* of parseforcommand *)
  5270.  
  5271. (******************************************************************************)
  5272. (*                                                                            *)
  5273. (* THE FOLLOWING PROCEDURE WILL ASK FOR INPUT FROM THE USER, PARSE THE INPUT  *)
  5274. (* TO SEE IF IT IS A VALID COMMAND, AND IF SO WILL RETURN THE COMMAND.  IF    *)
  5275. (* THE INPUT IS NOT A VALID COMMAND THEN THE PROCEDURE WILL SIMPLY ASK FOR    *)
  5276. (* MORE INPUT.                                                                *)
  5277. (*                                                                            *)
  5278. (******************************************************************************)
  5279.  
  5280. PROCEDURE getcommand(VAR command  : cmdtyps;
  5281.                      VAR sentence : STRING;
  5282.                      VAR index    : INTEGER);
  5283.  
  5284.    BEGIN (* getcommand *)
  5285.    IF take_mode AND THEN EOF(takefile)
  5286.       (* test first. Previously returned NULLCMD & produced error *)
  5287.       THEN
  5288.          BEGIN
  5289.          CLOSE(takefile);
  5290.          take_mode := FALSE;
  5291.          END;
  5292.    IF not take_mode
  5293.       THEN
  5294.          REPEAT
  5295.             WRITE('Kermit-apollo>');
  5296.             readln(sentence);
  5297.             parseforcommand(sentence, index, command);
  5298.          UNTIL command <> NULLCMD
  5299.       ELSE
  5300.          REPEAT
  5301.             READLN(takefile, sentence);
  5302.             IF mode=local THEN
  5303.                WRITELN('taking: ',sentence);
  5304.             parseforcommand(sentence, index, command);
  5305.          UNTIL (command <> NULLCMD) OR EOF(takefile);
  5306.    END; (* of getcommand *)
  5307.  
  5308.  
  5309.  
  5310. (******************************************************************************)
  5311. (*                                                                            *)
  5312. (* THE FOLLOWING PROCEDURE WILL PROCESS COMMANDS FROM THE CONTROL CARD.       *)
  5313. (*                                                                            *)
  5314. (******************************************************************************)
  5315.  
  5316. PROCEDURE process_command_arguments;
  5317.  
  5318.    VAR
  5319.       status    : STATUS_$T;
  5320.       maxlen    : INTEGER;
  5321.       argnumber : INTEGER;
  5322.       argument  : STRING;
  5323.       index     : INTEGER;
  5324.       cmd       : cmdtyps;
  5325.  
  5326.    BEGIN (* process command arguments *)
  5327.    maxlen := 255;
  5328.    argnumber := 1;
  5329.    argument := ' ';
  5330.    discard( PGM_$GET_ARG(argnumber, argument, status, maxlen) );
  5331.    WHILE status.all <> PGM_$NO_ARG DO
  5332.       BEGIN
  5333.       parseforcommand(argument, index, cmd);
  5334.       IF cmd <> NULLCMD
  5335.          THEN
  5336.             processcommand(cmd, argument, index)
  5337.          ELSE
  5338.             WRITELN('Invalid command : ', argument);
  5339.       argnumber := argnumber + 1;
  5340.       argument := ' ';
  5341.       discard( PGM_$GET_ARG(argnumber, argument, status, maxlen) );
  5342.       END;
  5343.    END; (* of process command arguments *)
  5344.  
  5345.  
  5346.  
  5347. (******************************************************************************)
  5348. (*                                                                            *)
  5349. (* THE FOLLOWING IS THE MAIN DRIVER FOR KERMIT.                               *)
  5350. (*                                                                            *)
  5351. (******************************************************************************)
  5352.  
  5353. BEGIN (* KERMIT *)
  5354. initialize;
  5355. WRITELN;
  5356. printheader;
  5357. WRITELN;
  5358.  
  5359. (* Set up a clean-up handler to ensure that the sio lines are restored to     *)
  5360. (* their initial states.                                                      *)
  5361. status := PFM_$CLEANUP(handler_rec);
  5362. IF (status.all <> PFM_$CLEANUP_SET)
  5363.    THEN
  5364.       BEGIN
  5365.       IF debug
  5366.          THEN
  5367.             BEGIN
  5368.                subsys_t := ' ';
  5369.                module_t := ' ';
  5370.                code_t := ' ';
  5371.                ERROR_$GET_TEXT(status, subsys_t, subsys_l, module_t, module_l,
  5372.                                        code_t, code_l);
  5373.                WRITELN(debugfile, 'Program aborted due to unexpected error -');
  5374.                IF subsys_l > 0
  5375.                   THEN WRITELN(debugfile, '   Subsystem name  : ', subsys_t:-1);
  5376.                IF module_l > 0
  5377.                   THEN WRITELN(debugfile, '   Module name     : ', module_t:-1);
  5378.                IF code_l > 0
  5379.                   THEN WRITELN(debugfile, '   Diagnostic text : ', code_t:-1);
  5380.             END;
  5381.       restore_system;
  5382.       PFM_$SIGNAL(status);
  5383.       quit;
  5384.       END
  5385.    ELSE
  5386.       PFM_$INHIBIT; { inhibit asynchronous faults... typing a ^Q }
  5387.  
  5388. process_command_arguments;
  5389. REPEAT
  5390.    IF debug THEN WRITELN(debugfile, 'STATE : ',ORD(state));
  5391.    CASE state OF
  5392.       START           : BEGIN
  5393.                         getcommand(command, sentence, sentenceindex);
  5394.                         IF command = NULLCMD
  5395.                            THEN
  5396.                               WRITELN(' Invalid command - please reenter.')
  5397.                            ELSE
  5398.                               processcommand(command, sentence, sentenceindex);
  5399.                         END; (* of start *)
  5400.       REC_SERVER_IDLE : BEGIN
  5401.                         server_waits;
  5402.                         END; (* of server *)
  5403.       SEND_INIT,
  5404.       SEND_FILE,
  5405.       SEND_DATA,
  5406.       SEND_EOF,
  5407.       SEND_BREAK      : BEGIN
  5408.                         IF (state = SEND_INIT) OR (state = SEND_FILE)
  5409.                            THEN
  5410.                               BEGIN
  5411.                               clear_statistics;
  5412.                               END;
  5413.                         send_the_files;
  5414.                         IF mode=local THEN
  5415.                             BEGIN
  5416.                             write('transfer ');
  5417.                             IF state=COMPLETE THEN
  5418.                               writeln('successful')
  5419.                              ELSE
  5420.                               writeln('failed');
  5421.                             END;
  5422.                         END;
  5423.       COMPLETE        : BEGIN
  5424.                         IF server_mode
  5425.                            THEN
  5426.                               state := REC_SERVER_IDLE
  5427.                            ELSE
  5428.                               BEGIN
  5429.                               restore_system;
  5430.                               state := START;
  5431.                               END;
  5432.                         END;
  5433.       REC_INIT,
  5434.       REC_FILE,
  5435.       REC_DATA        : BEGIN
  5436.                         IF state <> REC_DATA
  5437.                            THEN
  5438.                               BEGIN
  5439.                               clear_statistics;
  5440.                               END;
  5441.                         receive_some_files;
  5442.                         IF mode=local THEN
  5443.                             BEGIN
  5444.                             write('transfer ');
  5445.                             IF state=COMPLETE THEN
  5446.                               writeln('successful')
  5447.                              ELSE
  5448.                               writeln('failed');
  5449.                             END;
  5450.                         END;
  5451.       ABORT           : BEGIN
  5452.                         CAL_$GET_LOCAL_TIME(statistics.stoptime);
  5453.                         statistics.completed := FALSE;
  5454.                         IF server_mode
  5455.                            THEN
  5456.                               state := REC_SERVER_IDLE
  5457.                            ELSE
  5458.                               BEGIN
  5459.                               restore_system;
  5460.                               state := START;
  5461.                               END;
  5462.                         END;
  5463.       END; (* of case *)
  5464. UNTIL FOREVER;
  5465. END. (* KERMIT *)
  5466.  
  5467.  
  5468.  
  5469. (*---------------- end --- of --- kermitb.pas ---------------------------*)
  5470.  
  5471.  
  5472. module kermitio;  
  5473. %include '/sys/ins/base.ins.pas';  
  5474. %include '/sys/ins/streams.ins.pas';  
  5475. %include '/sys/ins/pfm.ins.pas';  
  5476. %include '/sys/ins/type_uids.ins.pas';  
  5477.  
  5478. {
  5479.  redefines stream to be of undefined structure  
  5480.  }  
  5481. procedure undef_stream (sid: integer16);  
  5482. var  
  5483.   errmask: stream_$redef_mask_t;  
  5484.   status: status_$t;  
  5485.   attrib: stream_$ir_rec_t;  
  5486.  
  5487.  begin  
  5488. { SR9 does not allow redefining UASC to HDRU.  
  5489.   Therefore this stuff has to be commented out !  
  5490.  
  5491.   attrib.rec_type := stream_$undef;  
  5492.   attrib.otype := hdr_undef_$uid;  
  5493.   attrib.opos := stream_$write;  
  5494.   stream_$redefine (sid, [8,11,22], attrib, errmask, status);  
  5495.   if status.all <> 0 then  
  5496.    pfm_$error_trap (status)  
  5497.  }  
  5498.  end;  
  5499.  
  5500. {  
  5501.  open a stream for input  
  5502.  }  
  5503. procedure openi (fn: string;  
  5504.                  fnlen: integer16;  
  5505.                  text: boolean;  
  5506.                  var sid: integer16);  
  5507. var  
  5508.   status: status_$t;  
  5509.   errmask : stream_$redef_mask_t;  
  5510.   attrib : stream_$ir_rec_t;  
  5511.  
  5512.  begin  
  5513.   stream_$open (fn, fnlen, stream_$read, stream_$unregulated, sid, status);  
  5514.   if status.all <> 0 then  
  5515.    pfm_$error_trap (status);  
  5516.   attrib.explicit_ml := true;   { set move mode }  
  5517.   stream_$redefine (sid, [6], attrib, errmask, status);  
  5518.   if not text then  
  5519.    undef_stream (sid)  
  5520.  end;  
  5521.  
  5522. (* open a stream for output     +2.8a *)  
  5523.  
  5524. procedure openo (fn: string;  
  5525.                  fnlen: integer16;  
  5526.                  text: boolean;  
  5527.                  var sid: integer16);  
  5528. var  
  5529.   status: status_$t;  
  5530.   errmask : stream_$redef_mask_t;  
  5531.   attrib : stream_$ir_rec_t;  
  5532.  
  5533.  begin  
  5534.   if text then  
  5535.    stream_$create (fn, fnlen, stream_$make_backup, stream_$no_conc_write, sid,
  5536.      status)  
  5537.   else  
  5538.    stream_$create_bin (fn, fnlen, stream_$make_backup, stream_$no_conc_write,
  5539.      sid, status);  
  5540.   if status.all <> 0 then  
  5541.    pfm_$error_trap (status);  
  5542.   attrib.explicit_ml := true;   { set move mode }  
  5543.   stream_$redefine (sid, [6], attrib, errmask, status);  
  5544.   if status.all <> 0 then  
  5545.    pfm_$error_trap (status);  
  5546.  end;  
  5547.  
  5548. {  
  5549.  close a stream  
  5550.  }  
  5551. procedure closef (sid: integer16);  
  5552. var  
  5553.   status: status_$t;  
  5554.  
  5555.  begin  
  5556.   stream_$close (sid, status);  
  5557.   if status.all <> 0 then  
  5558.    pfm_$error_trap (status)  
  5559.  end;  
  5560.  
  5561. {  
  5562.  read a record (for text file) or a requested number of bytes  
  5563.  (for unstructured file) from a stream  
  5564.  }  
  5565. procedure getbuf (sid: integer16;  
  5566.                   bufptr: univ_ptr;  
  5567.                   buflen: integer32;  
  5568.                   var retlen: integer32;  
  5569.                   var eos: boolean);  
  5570. var  
  5571.   dummyp: univ_ptr;  
  5572.   sk: stream_$sk_t;  
  5573.   status: status_$t;  
  5574.   len: integer32;  
  5575.  
  5576.  begin  
  5577.   stream_$get_rec (sid, bufptr, buflen, dummyp, retlen, sk, status);  
  5578.   if status.all <> 0 then  
  5579.    begin  
  5580.     if status.subsys = stream_$subs  
  5581.      and then status.code = stream_$end_of_file then  
  5582.      begin  
  5583.       retlen := 0;  
  5584.       eos := true  
  5585.      end  
  5586.     else  
  5587.      pfm_$error_trap (status)  
  5588.    end  
  5589.   else  
  5590.    eos := false;  
  5591.   if not eos and then retlen < 0 then  
  5592.    retlen := buflen;
  5593.  end;
  5594.  
  5595. (* write a record to a stream +2.8a *)  
  5596.  
  5597. procedure putbuf (sid: integer16;  
  5598.                   bufptr: univ_ptr;  
  5599.                   buflen: integer32);  
  5600. var  
  5601.   sk: stream_$sk_t;  
  5602.   status: status_$t;  
  5603.  
  5604.  begin  
  5605.   stream_$put_rec (sid, bufptr, buflen, sk, status);  
  5606.   if status.all <> 0 then  
  5607.    pfm_$error_trap (status);  
  5608.  end;  
  5609.  
  5610.  
  5611.  
  5612. (*---------------- end --- of --- kermitio.pas ---------------------------*)
  5613.