home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / c / pqkerm.pas < prev    next >
Pascal/Delphi Source File  |  2020-01-01  |  93KB  |  2,973 lines
  1. (* <<<Connect232.Pas>>> *)
  2. MODULE Connect232 ;
  3.  
  4. (*)
  5.  *  A communications routine via the RS232 line to another host.
  6.  *  Parameters are:
  7.  *
  8.  *      EscChar         The "escape" character, when this character is read
  9.  *                      from the keyboard return to caller.
  10.  *      HalfDuplex      The state of the host's connection, if HalfDuplex is
  11.  *                      true echo the keyboard characters locally.
  12.  *      TabletOk        If true, the yellow button on the puck causes an
  13.  *                      exit too.
  14.                         5-Oct-83. Change cursor shape and allow ANY puck button
  15.                         to cause an exit.
  16.  *      RETURN:         ConCharExit    if <EscChar> caused exit,
  17.  *                      ConButtonExit  for puck button.
  18. (*)
  19.  
  20. EXPORTS    (*-------------*)
  21.  
  22. IMPORTS IO_Unit   FROM IO_Unit;
  23. IMPORTS IOErrors  FROM IOErrors;
  24.  
  25. TYPE
  26.     (* What caused "Connect" to exit *)
  27.     ConExitFlag = (ConCharExit, ConButtonExit) ;
  28.  
  29.  
  30. FUNCTION Connect( EscChar: Char; HalfDuplex, TabletOk: Boolean ) : ConExitFlag;
  31.  
  32.  
  33. PRIVATE   (*---------------*)
  34.  
  35. IMPORTS Screen    FROM Screen ;
  36. IMPORTS System    FROM System ;
  37. IMPORTS IO_Others FROM IO_Others;
  38.  
  39. FUNCTION Connect( EscChar: Char; HalfDuplex, TabletOk: Boolean ) : ConExitFlag;
  40.    CONST
  41.       NUL =   Chr(#000) ;
  42.       BS  =   Chr(#010) ;
  43.       TAB =   Chr(#011) ;
  44.       LF  =   Chr(#012) ;
  45.       CR  =   Chr(#015) ;
  46.       CtrlQ = Chr(#021) ;
  47.       CtrlS = Chr(#023) ;
  48.    VAR
  49.       hpos:  Integer ;   (* current position in the line (for tabs) *)
  50.       oldX, oldY: Integer ;    (* Old cursor offsets *)
  51.       quit:  Boolean ;         (* loop control *)
  52.       LineChr, KeyChr:  Char;  (* current RS232 and keyboard characters *)
  53.       OldCurs, NewCurs: CurPatPtr ;  (* Old and New cursors (if TabletOk) *)
  54.       return: ConExitFlag ;    (* the exit flag *)
  55.  
  56.    PROCEDURE WriteChr( c: Char ) ;
  57.       BEGIN
  58.          SPutChr( c ) ;
  59.          Hpos := Hpos + 1
  60.       END ;
  61.  
  62.    HANDLER CtlC ;
  63.       BEGIN
  64.       END ;
  65.  
  66.    BEGIN  (*-Connect-*)
  67.  
  68.       (* Allocate cursor space *)
  69.       New( 0, 4, NewCurs) ;
  70.       New( 0, 4, OldCurs) ;
  71.  
  72.       (* Clear the cursor area *)
  73.       RasterOp(RXor, 64, 64, 0, 0, 4, RECAST(NewCurs, RasterPtr),
  74.                              0, 0, 4, RECAST(NewCurs, RasterPtr) ) ;
  75.  
  76. (* Cursor values from file: Connect3.Cursor *)
  77.       NewCurs^[ 0,0] := #40 ;
  78.       NewCurs^[ 1,0] := #120 ;
  79.       NewCurs^[ 1,1] := #1642 ;
  80.       NewCurs^[ 1,2] := #167000 ;
  81.       NewCurs^[ 2,0] := #210 ;
  82.       NewCurs^[ 2,1] := #1024 ;
  83.       NewCurs^[ 2,2] := #42000 ;
  84.       NewCurs^[ 3,0] := #404 ;
  85.       NewCurs^[ 3,1] := #1610 ;
  86.       NewCurs^[ 3,2] := #42000 ;
  87.       NewCurs^[ 4,0] := #1002 ;
  88.       NewCurs^[ 4,1] := #1024 ;
  89.       NewCurs^[ 4,2] := #42000 ;
  90.       NewCurs^[ 5,0] := #404 ;
  91.       NewCurs^[ 5,1] := #1642 ;
  92.       NewCurs^[ 5,2] := #162000 ;
  93.       NewCurs^[ 6,0] := #2211 ;
  94.       NewCurs^[ 7,0] := #5122 ;
  95.       NewCurs^[ 7,1] := #100000 ;
  96.       NewCurs^[ 8,0] := #10444 ;
  97.       NewCurs^[ 8,1] := #40000 ;
  98.       NewCurs^[ 9,0] := #20210 ;
  99.       NewCurs^[ 9,1] := #20000 ;
  100.       NewCurs^[10,0] := #40120 ;
  101.       NewCurs^[10,1] := #10000 ;
  102.       NewCurs^[11,0] := #20210 ;
  103.       NewCurs^[11,1] := #20000 ;
  104.       NewCurs^[12,0] := #10444 ;
  105.       NewCurs^[12,1] := #40000 ;
  106.       NewCurs^[13,0] := #5122 ;
  107.       NewCurs^[13,1] := #100000 ;
  108.       NewCurs^[14,0] := #2211 ;
  109.       NewCurs^[15,0] := #404 ;
  110.       NewCurs^[16,0] := #1002 ;
  111.       NewCurs^[17,0] := #404 ;
  112.       NewCurs^[18,0] := #210 ;
  113.       NewCurs^[19,0] := #120 ;
  114.       NewCurs^[20,0] := #40 ;
  115.  
  116.  
  117.       (* Debug :- %)
  118.       Writeln('TabletOk = ', TabletOk) ;
  119.       (% Debug    *)
  120.  
  121.  
  122.       SCurOn ;  (* ? *)
  123.  
  124.  
  125.       (* Set up our cursor, or turn the cursor off if we can't use a cursor *)
  126.       IF TabletOk THEN
  127.          BEGIN
  128.             IOReadCursPicture( OldCurs, oldX, oldY ) ;
  129.             IOLoadCursor( NewCurs, 0, 0) ;
  130.             IOSetModeTablet( relTablet ) ;
  131.             IOCursorMode( TrackCursor )
  132.          END
  133.       ELSE
  134.          IOCursorMode( OffCursor ) ;  (* Turn it off *)
  135.  
  136.       return := ConCharExit ;  (* Assume the exit by escape char *)
  137.       quit := False ;
  138.       WHILE NOT quit DO
  139.          BEGIN
  140.             (*----------   RS232 Input   ----------*)
  141.             IF (IOCRead(RS232In, LineChr)=IOEIOC)  THEN
  142.                BEGIN
  143.                   LineChr := Chr( Land( Ord(LineChr), #177) ) ;
  144.                   IF (LineChr = TAB) THEN
  145.                      BEGIN
  146.                         WriteChr( ' ' ) ;
  147.                         WHILE (Hpos MOD 8) <> 0 DO  WriteChr( ' ' )
  148.                      END
  149.                   ELSE
  150.                      IF (LineChr = BS) THEN
  151.                         BEGIN
  152.                            IF Hpos > 0 THEN
  153.                               BEGIN (* Delete the character *)
  154.                                  SBackSpace( ' ' );
  155.                                  SPutChr( ' ' ) ;
  156.                                  SBackSpace( ' ' ) ;
  157.                                  Hpos := Hpos - 1
  158.                               END
  159.                         END
  160.                      ELSE
  161.                         IF (LineChr IN [NUL, CtrlS, CtrlQ]) THEN (* NOTHING *)
  162.                         ELSE
  163.                            WriteChr( LineChr ) ;   (* write it *)
  164.  
  165.                   IF (LineChr IN [CR, LF]) THEN  Hpos := 0 ;  (* a new line *)
  166.                END ; (* RS232 input *)
  167.  
  168.             (*----------   Keyboard Input   ----------*)
  169.             IF (IOCRead(TransKey, KeyChr)=IOEIOC) THEN
  170.                BEGIN
  171.                   IF (KeyChr = EscChar) THEN
  172.                      BEGIN
  173.                         quit := True
  174.                      END
  175.                   ELSE
  176.                      BEGIN
  177.                         IF IOCWrite(RS232Out, KeyChr)<>IOEIOC THEN
  178.                            KeyChr := Chr(#277) ;
  179.                         IF HalfDuplex THEN WriteChr( KeyChr )
  180.                      END
  181.                END ; (* Keyboard input *)
  182.  
  183.             (*----------   Tablet Input   ----------*)
  184.             IF TabletOk AND TabSwitch THEN 
  185.               BEGIN
  186.                 return := ConButtonExit ;
  187.                 quit := True
  188.               END
  189.  
  190.          END ; (* while *)
  191.  
  192.       (* Restore cursor *)
  193.       IF TabletOk THEN IOLoadCursor( OldCurs, oldX, oldY )
  194.       ELSE IOCursorMode( TrackCursor ) ; (* I assume it was originally on *)
  195.       Dispose( NewCurs ) ;
  196.  
  197.       Connect := return
  198.    END .  (*-Connect-*)
  199.  
  200. (* <<<Kermit.Pas>>> *)
  201. PROGRAM Kermit(Input,Output);
  202. (*)
  203.  * 29-Nov-83 Allow eight bit file transfer with SET EIGHT-BIT ON/OFF
  204.  *           add global flag and extra SET command   [pgt001]
  205.  *           For byte value 0..255 the end of (data) string value is now -1,
  206.  *           and end of file value -2.
  207.  *  1-Dec-83 Place all globals into module KermitGlobals.
  208. (*)
  209.  
  210.  
  211.  
  212. IMPORTS Stdio           FROM Stdio ;
  213. IMPORTS KermitGlobals   FROM KermitGlobals ; (**********)
  214. IMPORTS KermitUtils     FROM KermitUtils ;
  215. IMPORTS KermitParms     FROM KermitParms ;
  216. IMPORTS KermitHelp      FROM KermitHelp ;
  217. IMPORTS KermitError     FROM KermitError ;
  218. IMPORTS KermitSend      FROM KermitSend ;
  219. IMPORTS KermitRecv      FROM KermitRecv ;
  220.  
  221. IMPORTS Connect232      FROM Connect232 ;
  222. IMPORTS PMatch          FROM PMatch ;
  223. IMPORTS PopCmdParse     FROM PopCmdParse ;
  224. IMPORTS Perq_String     FROM Perq_String ;
  225. IMPORTS Screen          FROM Screen ;
  226. IMPORTS IO_Unit         FROM IO_Unit ;
  227. IMPORTS IOErrors        FROM IOErrors;
  228. IMPORTS IO_Others       FROM IO_Others;
  229. IMPORTS System          FROM System;
  230. IMPORTS Sleep           FROM Sleep;
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.    (* Handle ^C's from the console -pt*)
  238. HANDLER CtlC ;
  239.    BEGIN   (*-CtlC-*)
  240.       IOKeyClear ;             (* Remove ^C from input stream *)
  241.       CtrlCPending := False ;  (* Clear to prevent next ^C from aborting job *)
  242.       FromConsole := AbortNow  (* Set our flag *)
  243.    END ;   (*-CtlC-*)
  244.  
  245.  
  246. HANDLER HelpKey(VAR str: Sys9s) ;
  247.    (* Make the HELP key generate the correct command (i.e. not a switch) -pt*)
  248.    BEGIN  (*-HelpKey-*)
  249.       str := 'HELP ' ;
  250.       str[5] := Chr( CR )
  251.    END ;  (*-HelpKey-*)
  252.  
  253. PROCEDURE OverHd( p,f: Stats;
  254.                  VAR o:Integer);
  255.  
  256.    (* Calculate OverHead as % *)
  257.    (* OverHead := (p-f)*100/f *)
  258.  
  259.    BEGIN
  260.       IF (f = 0.0) THEN o := 0
  261.       ELSE o := Round( (p-f)*100/f )
  262.    END;
  263.  
  264. PROCEDURE CalRat(f: Stats;
  265.                  t:Integer;
  266.                  VAR r:Integer);
  267.  
  268.    (* Calculate Effective Baud Rate *)
  269.    (* Rate = f*10/t *)
  270.  
  271.    BEGIN
  272.       IF (t = 0) THEN r := 0
  273.       ELSE r := Round( f*10/t )
  274.    END;
  275.  
  276.  
  277. PROCEDURE Statistics ;
  278.    VAR
  279.       overhead, effrate : Integer;
  280.    BEGIN  (*-Statistics-*)
  281.       (* print info on number of packets etc *)
  282.       (* All output here was originally to STDERR  -pt*)
  283.       Writeln ;
  284.       Writeln('Packets sent:     ',NumSendPacks:1);
  285.       Writeln('Packets received: ',NumRecvPacks:1);
  286.  
  287.       (* Calculate overhead *)
  288.       OverHd(ChInPack,ChInFile,overhead);
  289.       IF (Overhead <> 0) THEN
  290.          BEGIN
  291.             Writeln('Overhead (%):     ' ,overhead:1);
  292.          END;
  293.       IF (RunTime <> 0) THEN
  294.          BEGIN (* calculate effective rate *)
  295.             CalRat(ChInFile,RunTime,effrate);
  296.             Writeln('Effective Rate:   ',effrate:1);
  297.          END;
  298.  
  299.       (* Transmit stats *)
  300.       Inverse( TRUE ) ;
  301.       Writeln(' Send :-') ;
  302.       Inverse( FALSE ) ;
  303.       Writeln('Number of ACK:    ',NumACKrecv:1);
  304.       Writeln('Number of NAK:    ',NumNAKrecv:1);
  305.       Writeln('Number of BAD:    ',NumBADrecv:1);
  306.  
  307.       (* Transmit stats *)
  308.       Inverse( TRUE ) ;
  309.       Writeln(' Receive :-') ;
  310.       Inverse( FALSE ) ;
  311.       Writeln('Number of ACK:    ',NumACK:1);
  312.       Writeln('Number of NAK:    ',NumNAK:1);
  313.       Writeln
  314.    END ; (*-Statistics-*)
  315.  
  316. PROCEDURE FinishUp; (* do any End of Program clean up *)
  317.    BEGIN
  318.       Sclose(DiskFile);
  319.       SYSfinish;  (* do System dependent *)
  320.    END;
  321.  
  322.  
  323.  
  324. PROCEDURE DoConnect ;
  325.    (* Connect to the other host -pt*)
  326.    VAR
  327.       whyExit: ConExitFlag ; (* Why "connect" exited *)
  328.       ch: Char ;  (* the character after the "escape" char *)
  329.    BEGIN (*-DoConnect-*)
  330.       Writeln('[Connecting to host. Type Control-', EscPrint,
  331.               ' C   or any button on the puck]') ;
  332.       REPEAT
  333.          whyExit := Connect( EscapeChar, HalfDuplex, TRUE) ;
  334.          (* Get the command *)
  335.          IF (whyExit = ConButtonExit) THEN (* the button was pressed *)
  336.             BEGIN
  337.                Nap( 10 ) ;
  338.                ch := 'C'  (* Close the connection *)
  339.             END
  340.          ELSE
  341.             WHILE (IOCRead(TransKey, ch) <> IOEIOC) DO ;
  342.  
  343.          IF (ch = EscapeChar) THEN XmtChar( EscapeChar )
  344.          ELSE
  345.             IF (ch = '?') THEN
  346.                BEGIN
  347.                   Writeln ;
  348.                   Writeln('When CONNECT''ed to another host, type Control-', EscPrint) ;
  349.                   Writeln('followed by :-') ;
  350.                   Writeln('  C    to close the connection') ;
  351.                   Writeln('  ^', EscPrint, '   to send that character') ;
  352.                   Writeln('  ?    for this information') ;
  353.                   Writeln('[Back to host]')
  354.                END (* help *)
  355.  
  356.       UNTIL (Uppercase(ch) = 'C') ;
  357.       Writeln ;
  358.       Writeln('[Connection closed. Returning to PERQ]')
  359.    END ; (*-DoConnect-*)
  360.  
  361. BEGIN
  362.    StdIOInit;
  363.    SYSinit;             (*  system dependent  *)
  364.    done:=False;
  365.  
  366.    Writeln ;
  367.    REPEAT
  368.  
  369.       KermitInit;       (* initialize *)
  370.  
  371.       WHILE NOT (RunType IN [transmit, receive, setparm]) AND (NOT done)
  372.       DO
  373.          BEGIN
  374.             CmdIndex := GetCmdLine(NullIdleProc,  'Kermit-PQ',
  375.                                    CmdLine, CmdSpelling,
  376.                                    Inf, RECAST(MainMenu, pNameDesc),
  377.                                    firstPress, OK_to_pop) ;
  378.             ConvUpper( CmdSpelling ) ; (* Make it upper case *)
  379.             (* see what the command was *)
  380.             CASE  CmdIndex  OF
  381.                1:  DoConnect ;          (* CONNECT *)
  382.                2:  done := True ;       (* EXIT *)
  383.                3:  DoHelp ;             (* HELP *)
  384.                4:  done := True ;       (* QUIT *)
  385.                5:  RunType := Receive ; (* RECEIVE *)
  386.                6:  RunType := Transmit; (* SEND *)
  387.                7:  RunType := SetParm ; (* SET  *)
  388.                8:  DoShow ;             (* SHOW *)
  389.                9:  Statistics ;         (* STATISTICS *)
  390.  
  391.                10:  Writeln('%Not a KERMIT command: ', CmdSpelling) ;
  392.                11: Writeln('%Ambiguous command: ', CmdSpelling) ;
  393.                12: (* empty line *) ;
  394.                13: Writeln('%KERMIT does not take switches, type HELP.');
  395.                14: Writeln('?Illegal character after command') ; (* ?? *)
  396.                OTHERWISE: Writeln('?Unknown command: ', CmdSpelling)
  397.                END  (* case *)
  398.          END;
  399.  
  400.       CASE RunType OF
  401.          Receive:
  402.             BEGIN (* filename is optional here *)
  403.                (* Remove blanks from the cmd line *)
  404.                IF (CmdLine <> '') THEN RemDelimiters( CmdLine, ' ', dumStr) ;
  405.                IF GetArgument(aline) THEN
  406.                   BEGIN
  407.                      IF Exists(aline) AND FileWarning THEN
  408.                         BEGIN
  409.                            ErrorMsg('Overwriting: ');
  410.                            ErrorStr(aline);
  411.                         END;
  412.  
  413.                      IF EightBitFile THEN  (* [pgt001] *)
  414.                         DiskFile := Sopen(aline,StdIO8Write)
  415.                      ELSE
  416.                         DiskFile := Sopen(aline,StdIOWrite);
  417.  
  418.                      IF (DiskFile <= StdIOError) THEN
  419.                         ErrorPack('Cannot Open File');
  420.                   END;
  421.                RecvSwitch;
  422.             END;
  423.  
  424.          Transmit:
  425.             BEGIN  (* New version -pt*)
  426.                (* must give file name, so ask if one was not given -pt*)
  427.                IF (CmdLine = '') THEN
  428.                   BEGIN
  429.                      Write('File to transmit ', PromptChar) ;
  430.                      Readln( CmdLine )  (* get the response *)
  431.                   END ;
  432.  
  433.                (* What shall we do with the line ? *)
  434.                (* First remove blanks *)
  435.                RemDelimiters( CmdLine, ' ', dumStr) ;
  436.                IF (CmdLine = '') THEN (* another empty line, do nothing *)
  437.                ELSE
  438.                   IF IsPattern(CmdLine) THEN
  439.                      Writeln('%SEND does not take wild file names')
  440.                   ELSE
  441.                      SendSwitch (* SendFile checks parameters - file exists *)
  442.  
  443.             END;
  444.          Invalid:        (* nothing *);
  445.          SetParm:  SetParameters ;
  446.       END;
  447.       (* case *)
  448.  
  449.    UNTIL done;
  450.  
  451.    FinishUp; (* End of Program *)
  452.  
  453.    ScreenReset  (* Clear up screen data *)
  454. END.
  455.  
  456. (* <<<KermitError.Pas>>> *)
  457. MODULE KermitError ;
  458.  
  459.  
  460.  
  461. EXPORTS
  462.  
  463. IMPORTS KermitGlobals      FROM KermitGlobals ;
  464.  
  465.  
  466. PROCEDURE ErrorMsg(msg:MsgString ) ;
  467. PROCEDURE ErrorInt( msg:MsgString; n: Integer ) ;
  468. PROCEDURE ErrorStr( str: istring ) ;
  469. PROCEDURE DebugPacket(mes : MsgString;
  470.                       VAR p : Ppack);
  471. PROCEDURE Verbose(c:MsgString);
  472.  
  473.  
  474. PRIVATE
  475.  
  476. IMPORTS Screen          FROM Screen ;
  477.  
  478.  
  479. PROCEDURE ErrorMsg(msg:MsgString ) ;
  480.    (* output literal preceeded by NEWLINE *)
  481.    (* to the PERQ error window  -pt*)
  482.    BEGIN (*-ErrorMsg-*)
  483.       ChangeWindow( ErrorWindow ) ;
  484.       Writeln ;
  485.       Write( msg ) ;
  486.       ChangeWindow( KermitWindow )
  487.    END; (*-ErrorMsg-*)
  488.  
  489. PROCEDURE ErrorInt( msg:MsgString; n: Integer ) ;
  490.    (* Output a number preceeded by a message *)
  491.    (* to the PERQ error window  -pt*)
  492.    BEGIN (*-ErrorInt-*)
  493.       ChangeWindow( ErrorWindow ) ;
  494.       Writeln ;
  495.       Write( msg, n:1 ) ;
  496.       ChangeWindow( KermitWindow )
  497.    END; (*-ErrorInt-*)
  498.  
  499. PROCEDURE ErrorStr( str: istring ) ;
  500.    (* Output a "istring" to the error window *)
  501.    VAR i: Integer ;
  502.    BEGIN (*-ErrorStr-*)
  503.       ChangeWindow( ErrorWindow ) ;
  504.       i := 1 ;
  505.       WHILE str[i] <> ENDSTR DO
  506.         BEGIN
  507.            IF (str[i] = LF) THEN Writeln
  508.            ELSE Write(  Chr(str[i])  ) ;
  509.            i := i + 1
  510.         END ;
  511.       ChangeWindow( KermitWindow )
  512.    END ; (*-ErrorStr-*)
  513.  
  514.  
  515. PROCEDURE DebugPacket(mes : MsgString;
  516.                        VAR p : Ppack);
  517.    (* Print Debugging Info, into the error window -pt*)
  518.    VAR
  519.       i: Integer ;   (* index into data field -pt*)
  520.    BEGIN        (*-DebugPacket-*)
  521.       ChangeWindow( ErrorWindow ) ;  (* Print all this in error window -pt*)
  522.       Writeln ;
  523.       Write(mes);
  524.       WITH Buf[p] DO
  525.          BEGIN
  526.             Write( '(count:', count-#40:1 ) ; (* local "UnChar" *)
  527.             Write( ') (seq:', seq-#40:1 ) ;
  528.             Writeln( ') (type:',  Chr(ptype), ')' );
  529.             (* Write out the data field, straight to the screen -pt*)
  530.             i := 1 ;
  531.             WHILE (data[i] <> ENDSTR) DO
  532.                BEGIN
  533.                   Write( Chr(data[i]) ) ;
  534.                   i := i + 1
  535.                END ;
  536.             Writeln ;
  537.             (* done -pt*)
  538.          END;
  539.       ChangeWindow( KermitWindow )  (* back to kermit -pt*)
  540.    END;         (*-DebugPacket-*)
  541.  
  542.  
  543. PROCEDURE Verbose(c:MsgString);
  544.    (* Print writeln if verbosity *)
  545.    BEGIN
  546.       IF Verbosity THEN ErrorMsg(c);
  547.    END.
  548.  
  549. (* <<<KermitGlobals.Pas>>> *)
  550. MODULE KermitGlobals;
  551.  
  552. (*)
  553.  * 1-Dec-83.
  554.  *  Split the Kermit program file into: KermitGlobals which contains all
  555.  *  global information, and Kermit.Pas which is the main program file.
  556.  *  this allow all the kermit modules to be used by any other program.
  557. (*)
  558.  
  559. EXPORTS
  560.  
  561. IMPORTS CmdParse        FROM CmdParse ;
  562. IMPORTS SystemDefs      FROM SystemDefs ;
  563.  
  564. CONST
  565.  
  566.  
  567.    (*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
  568.    KermitWindow = 1 ;  (* Window numbers - See SysInit for their creation -pt*)
  569.    ErrorWindow  = 2 ;  (* An error window for all messages and errors     -pt*)
  570.    FF = Chr(#014) ;    (* A form feed to clear the windows -pt*)
  571.    PromptChar = Chr(#032) ; (* PERQ character set: grey arrow head -pt*)
  572.    OK_to_Pop = True ;  (* Allow pop-up menus -pt*)
  573.    MaxPopCmds = 10 ;   (* Maximum pop-up commands -pt*)
  574.  
  575.    SetCount = 7  ;        (* Number of SET commands [pgt001]*)
  576.    SetNot = SetCount+1 ;  (* Non-SET command index *)
  577.    SetAmbig = SetCount+2; (* Ambiguous SET command *)
  578.    ShowCount = SetCount+1;(* SET commands plus 'ALL' *)
  579.    ShowNot = ShowCount+1 ;
  580.    ShowAmbig = ShowCount+2 ;
  581.    MainCount = 9 ;
  582.    MainNot = MainCount+1 ;
  583.    MainAmbig = MainCount+2 ;
  584.  
  585.    (*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
  586.    return = #015 ;
  587.    formfeed = #014 ;
  588.    controlbar = 28;
  589.  
  590.    { universal manifest constants }
  591.    ENDSTR = -1;    (* End-of-string value  [pgt001] *)
  592.    MAXSTR = 100;   { longest possible string }
  593.    MsgLength = 20; { length of message string -pt}
  594.  
  595.    { ascii character set in decimal }
  596.    BACKSPACE = 8;
  597.    TAB = 9;
  598.    lf = #012 ; (* Line feed/new line *)
  599.    BLANK = 32;
  600.    EXCLAM = 33;    { ! }
  601.    DQUOTE = 34;    { " }
  602.    SHARP = 35;     { # }
  603.    DOLLAR = 36;    { $ }
  604.    PERCENT = 37;   { % }
  605.    AMPER = 38;     { & }
  606.    SQUOTE = 39;    { ' }
  607.    ACUTE = SQUOTE;
  608.    LPAREN = 40;    { ( }
  609.    RPAREN = 41;    { ) }
  610.    STAR = 42;      { * }
  611.    PLUS = 43;      { + }
  612.    COMMA = 44;     { , }
  613.    MINUS = 45;     { - }
  614.    DASH = MINUS;
  615.    PERIOD = 46;    { . }
  616.    SLASH = 47;     { / }
  617.    COLON = 58;     { : }
  618.    SEMICOL = 59;   { ; }
  619.    LESS = 60;      { < }
  620.    EQUALS = 61;    { = }
  621.    GREATER = 62;   { > }
  622.    QUESTION = 63;  { ? }
  623.    ATSIGN = 64;    { @ }
  624.    LBRACK = 91;    { [ }
  625.    BACKSLASH = 92; { \ }
  626.    ESCAPE = BACKSLASH; {  changed  - used to be @ }
  627.    RBRACK = 93;    { ] }
  628.    CARET = 94;     { ^ }
  629.    UNDERLINE = 95; { _ }
  630.    GRAVE = 96;     { ` }
  631.    LETA = 97;      { lower case ... }
  632.    LETB = 98;
  633.    LETC = 99;
  634.    LETD = 100;
  635.    LETE = 101;
  636.    LETF = 102;
  637.    LETG = 103;
  638.    LETH = 104;
  639.    LETI = 105;
  640.    LETJ = 106;
  641.    LETK = 107;
  642.    LETL = 108;
  643.    LETM = 109;
  644.    LETN = 110;
  645.    LETO = 111;
  646.    LETP = 112;
  647.    LETQ = 113;
  648.    LETR = 114;
  649.    LETS = 115;
  650.    LETT = 116;
  651.    LETU = 117;
  652.    LETV = 118;
  653.    LETW = 119;
  654.    LETX = 120;
  655.    LETY = 121;
  656.    LETZ = 122;
  657.    LBRACE = 123;   { left brace }
  658.    BAR = 124;      { | }
  659.    RBRACE = 125;   { right brace }
  660.    TILDE = 126;    { ~ }
  661.  
  662.  
  663.    SOH        = 1;     (* ascii SOH character *)
  664.    CR         = 13;    (* CR *)
  665.    DEL        = 127;   (* rubout *)
  666.  
  667.    DEFEOL     = CR ;   (* default eoln *)
  668.    DEFTRY     = 10;    (* default for number of retries *)
  669.    DEFTIMEOUT = 12;    (* default time out *)
  670.    MAXPACK    = 94;    (* max is 94 ~ - ' ' *)
  671.    DEFDELAY   = 1;     (* delay before sending first init *)
  672.    NUMPARAM   = 6;     (* number of parameters in init packet *)
  673.    DEFQUOTE   = SHARP; (* default quote character  *)
  674.    DEFPAD     = 0;     (* default number OF padding chars  *)
  675.    DEFPADCHAR = 0;     (* default padding character  *)
  676.  
  677.    NumBuffers = 5;         (* Number of packet buffers *)
  678.  
  679.    (* packet types *)
  680.  
  681.    TYPEB  = 66; (* ord('B') *)
  682.    TYPED  = 68; (* ord('D') *)
  683.    TYPEE  = 69; (* ord('E') *)
  684.    TYPEF  = 70; (* ord('F') *)
  685.    TYPEN  = 78; (* ord('N') *)
  686.    TYPES  = 83; (* ord('S') *)
  687.    TYPET  = 84; (* ord('T') *)
  688.    TYPEY  = 89; (* ord('Y') *)
  689.    TYPEZ  = 90; (* ord('Z') *)
  690.  
  691.  
  692.  
  693. TYPE
  694.  
  695.  
  696.    CharBytes = -2..255; (* full 8-bits, with -1 == end-of-string [pgt001]*)
  697.    istring = ARRAY [1..MAXSTR] OF CharBytes;
  698.    MsgString = String[ MsgLength ]; (* String for various messages -pt*)
  699.  
  700.  
  701.    (* Data Types for Kermit *)
  702.  
  703.  
  704.    Packet = RECORD
  705.                mark : CharBytes;       (* SOH character *)
  706.                count: CharBytes;       (* # of bytes following this field *)
  707.                seq  : CharBytes;       (* sequence number modulo 64  *)
  708.                ptype: CharBytes;       (* d,y,n,s,b,f,z,e,t  packet type *)
  709.                data : istring;          (* the actual data *)
  710.                (* chksum is last validchar in data array *)
  711.                (* eol is added, not considered part of packet proper *)
  712.             END;
  713.  
  714.    KermitCommand = (Transmit,Receive,SetParm,Invalid);
  715.  
  716.    KermitStates = (FileData,Init,Break,FileHeader,EOFile,Complete,Abort);
  717.  
  718.    Stats = Real ; (* Statistic counting -pt*)
  719.  
  720.    Ppack = 1..NumBuffers;
  721.  
  722.    CType = RECORD
  723.               check: Integer;
  724.               PacketPtr : Integer;
  725.               i : Integer;
  726.               fld : Integer;
  727.               t : CharBytes;
  728.               finished : Boolean;
  729.               restart : Boolean;
  730.               control : Boolean;
  731.               good : Boolean;
  732.            END;
  733.  
  734.    InType = (abortnow,nothing,CRin);
  735.  
  736.    (* Data types for pop-up menus *)
  737.    MyCmds = ARRAY [1..MaxPopCmds] OF String[25] ;  (* Menu strings *)
  738.    MyMenu = RECORD
  739.                Head: String[25] ;(* Heading *)
  740.                numcmds: Integer ;(* Number of commands *)
  741.                cmd: MyCmds       (* The actual commands *)
  742.             END ;
  743.    MyMenuPtr = ^MyMenu ;
  744.  
  745.  
  746. VAR
  747.  
  748.  
  749.    done:Boolean;
  750.    bufferoverflow, finis, XOFFState:Boolean;
  751.    ch:Char;
  752.    XON, XOFF:Char;
  753.  
  754.    (* Variables for commands *)
  755.    CmdSpelling, CmdLine: CString ;  (* the command and rest of line *)
  756.    CmdIndex: Integer ;  (* Index from command parser *)
  757.    Inf: pCmdList ;      (* Command file pointer *)
  758.    firstPress: Boolean ;(* Inital call to command parser *)
  759.  
  760.    (* Variables for pop-up menus *)
  761.    MainMenu,            (* Main Kermit menu *)
  762.    SetMenu: MyMenuPtr ; (* SET commands *)
  763.    OnOff: CmdArray ;    (* For the SET feature ON/OFF *)
  764.  
  765.  
  766.  
  767.    (* SET variables *)
  768.    EscapeChr: Char ;    (* CONNECT 'escape' character -pt*)
  769.    EscPrint : Char ;    (* Printable verion of this character -pt*)
  770.    BaudRate : String ;
  771.    FileWarning: Boolean ;
  772.    HalfDuplex:Boolean;
  773.    Verbosity: Boolean;  (* true to print verbose messages *)
  774.    Debug    : Boolean;
  775.    EightBitFile: Boolean ; (* 8-bit flag  [pgt001]*) 
  776.    (* Varibles for Kermit *)
  777.    dumStr   : String ;(* Dummy string -pt*)
  778.    dumCh: Char ;      (* A dummy character -pt*)
  779.  
  780.    aline    : istring;
  781.    DiskFile : Integer;(* Should be "filedesc" -pt*)
  782.    SaveState: kermitstates;
  783.    MaxTry   : Integer;
  784.    n,J      : Integer;  (* packet number *)
  785.    NumTry   : Integer;  (* times this packet retried *)
  786.    OldTry   : Integer;
  787.    NumPad   : Integer;  (* padding to send *)
  788.    MyPad    : Integer;  (* number of padding characters I need *)
  789.    PadChar  : CharBytes;
  790.    MyPadChar: CharBytes;
  791.    RunType  : KermitCommand;
  792.    State    : kermitstates; (* current state of the automaton *)
  793.    MyTimeOut:  Integer;     (* when i want to be timed out *)
  794.    TheirTimeOut  : Integer;
  795.    Delay    : Integer;
  796.    SizeRecv, SizeSend : Integer;
  797.    SendEOL, SendQuote : CharBytes;
  798.    myEOL,myQuote: CharBytes;
  799.    NumSendPacks : Integer;
  800.    NumRecvPacks : Integer;
  801.    NumACK : Integer;
  802.    NumNAK : Integer;
  803.    NumACKrecv : Integer;
  804.    NumNAKrecv : Integer;
  805.    NumBADrecv : Integer;
  806.    RunTime: Integer;
  807.    ChInFile, ChInPack : Stats;
  808.  
  809.    Buf : ARRAY [1..NumBuffers] OF packet;
  810.    ThisPacket : Ppack;  (* current packet being sent *)
  811.    LastPacket : Ppack;  (* last packet sent *)
  812.    CurrentPacket : Ppack; (* current packet received *)
  813.    NextPacket : Ppack;  (* next packet being received *)
  814.    InputPacket : Ppack; (* save input to do debug *)
  815.  
  816.    TOPacket : packet;   (* Time_Out Packet *)
  817.    OldTime  : Double ;  (* Clock time -pt*)
  818.    TimeLeft : Integer;  (* until Time_Out *)
  819.  
  820.    FromConsole : InType;(* Input from Console during receive *)
  821.  
  822.    PackControl : CType; (* variables for receive packet routine *)
  823.  
  824.  
  825.  
  826.  
  827.    PROCEDURE SYSinit;   (* special initialization *)
  828.  
  829.    PROCEDURE SYSfinish; (* System dependent *)
  830.  
  831.    PROCEDURE KermitInit;(* initialize various parameters  & defaults *)
  832.  
  833.  
  834.    PROCEDURE ErrorPack(c:MsgString);
  835.    (* Send the other host the an error packet with mesage <c> -pt*)
  836.  
  837.  
  838.    EXCEPTION GotErrorPacket(VAR ErrorMsg: istring) ;
  839.    (*)
  840.     * This is used when procedure "BuildPacket" receives an error packet
  841.     * from the other Host. Handlers in procedures "RecvSwitch" and
  842.     * "SendSwitch" are used to abort the current RECEIVE/SEND command
  843.     * and close any disk files open.
  844.    (*)
  845.  
  846.  
  847.  
  848. PRIVATE
  849.  
  850. IMPORTS Screen      FROM Screen ;
  851. IMPORTS PopCmdParse FROM PopCmdParse ;
  852. IMPORTS IO_Others   FROM IO_Others ;
  853. IMPORTS RS232Baud   FROM RS232Baud ;
  854. IMPORTS Stdio       FROM Stdio ;
  855. IMPORTS KermitUtils FROM KermitUtils ;
  856. IMPORTS KermitSend  FROM KermitSend ;
  857.  
  858.  
  859. PROCEDURE SYSinit; (* special initialization *)
  860.    BEGIN
  861.       Writeln( FF ) ;  (* Clear the entire screen *)
  862.       
  863.       (*----------     PERQ     ----------*)
  864.  
  865.       (* Create the windows *)
  866.       CreateWindow(KermitWindow, 0, 0, 767, 700,
  867.                    'PERQ Kermit, Version 2.0') ;
  868.       (* A cursor for the Kermit window *)
  869.       SCurChr( Chr(#177) ) ;  (* A black rectangle *)
  870.       SCurOn ;   (* Turn it on *)
  871.  
  872.       CreateWindow(ErrorWindow, 0, 701, 767, 322, 'Error and Message Window') ;
  873.  
  874.       ChangeWindow( KermitWindow ) ;
  875.  
  876.       (* Create pop-up menus *)
  877.       New(MainMenu) ;
  878.       WITH  MainMenu^  DO
  879.          BEGIN
  880.             Head := 'Kermit' ;
  881.             numcmds := MainCount ;
  882.             cmd[1] := 'CONNECT' ;
  883.             cmd[2] := 'EXIT' ;
  884.             cmd[3] := 'HELP' ;
  885.             cmd[4] := 'QUIT' ;
  886.             cmd[5] := 'RECEIVE' ;
  887.             cmd[6] := 'SEND' ;
  888.             cmd[7] := 'SET' ;
  889.             cmd[8] := 'SHOW' ;
  890.             cmd[9] := 'STATISTICS' ;
  891.          END ; (* with main menu *)
  892.  
  893.       (* ON or OFF *)
  894.       OnOff[1] := 'ON' ;
  895.       OnOff[2] := 'OFF' ;
  896.  
  897.       New(SetMenu) ;
  898.       WITH  SetMenu^  DO
  899.          BEGIN
  900.             Head := 'SET commands' ;
  901.             numcmds := SetCount ;  (* 7 if we include "ALL" for SHOW cmd *)
  902.             cmd[1] := 'SPEED' ;
  903.             cmd[2] := 'DEBUG' ;
  904.             cmd[3] := 'ESCAPE' ;
  905.             cmd[4] := 'WARNING' ;
  906.             cmd[5] := 'LOCAL' ;
  907.             cmd[6] := 'VERBOSE' ;
  908.             cmd[7] := 'EIGHT-BIT' ; (* [pgt001] *)
  909.             cmd[8] := 'ALL' ;   (* <<<< *)
  910.          END ; (* with SET menu *)
  911.  
  912.       (* other initialisation *)
  913.       InitCmdFile(Inf, 0) ;
  914.       InitPopUp ;
  915.       IOCursorMode( TrackCursor ) ;
  916.       firstPress := True ;
  917.  
  918.       (*----------     KERMIT     ----------*)
  919.       finis:=False;
  920.       XOFFState:=False;
  921.       XON:=Chr(#021); XOFF:=Chr(#023);
  922.  
  923.       (* SET values  -pt*)
  924.       EscapeChr := Chr(#034) ;  (* CONNECT escape character ^\ *)
  925.       EscPrint  := '\' ;        (* Printable version *)
  926.       BaudRate := '9600' ;
  927.       SetBaud( '9600', True ) ;
  928.       HalfDuplex:=False ;
  929.       Verbosity := False;       (* default to false / only valid if local *)
  930.       Debug := False;
  931.       EightBitFile := False ;   (* [pgt001] *)
  932.       FileWarning := False ;
  933.  
  934.  
  935.       (* Statistic counters *)
  936.       NumSendPacks := 0;
  937.       NumRecvPacks := 0;
  938.       NumACK := 0;
  939.       NumNAK := 0;
  940.       NumACKrecv := 0;
  941.       NumNAKrecv := 0;
  942.       NumBADrecv := 0;
  943.  
  944.       ChInFile := 0.0;  (* Statsistics are now reals.  -pt*)
  945.       ChInPack := ChInFile;
  946.  
  947.       (* Other values *)
  948.       NumPad := DEFPAD;               (* set defaults *)
  949.       MyPad := DEFPAD;
  950.       PadChar := DEFPADCHAR;
  951.       MyPadChar := DEFPADCHAR;
  952.       TheirTimeOut := DEFTIMEOUT;
  953.       MyTimeOut := DEFTIMEOUT;
  954.       Delay := DEFDELAY;
  955.       SizeRecv := MAXPACK;
  956.       SizeSend := MAXPACK;
  957.       SendEOL := DEFEOL;
  958.       MyEOL := DEFEOL;
  959.       SendQuote := DEFQUOTE;
  960.       MyQuote := DEFQUOTE;
  961.       MaxTry := DEFTRY;
  962.  
  963.    END;
  964.  
  965. PROCEDURE SYSfinish; (* System dependent *)
  966.    BEGIN
  967.       Writeln( FF ) ;
  968.       Dispose( MainMenu ) ;
  969.       Dispose( SetMenu ) ;
  970.       DstryCmdFile( Inf ) ;
  971.    END;
  972.  
  973.  
  974. PROCEDURE KermitInit;  (* initialize various parameters  & defaults *)
  975.    BEGIN
  976.       n := 0;
  977.  
  978.       RunType := invalid;
  979.       DiskFile := StdIOError;      (* to indicate not open yet *)
  980.  
  981.       ThisPacket := 1;
  982.       LastPacket := 2;
  983.       CurrentPacket := 3;
  984.       NextPacket := 4;
  985.       InputPacket := 5;
  986.  
  987.       WITH TOPacket DO
  988.          BEGIN
  989.             count := 3;
  990.             seq := 0;
  991.             ptype := TYPEN;
  992.             data[1] := ENDSTR;
  993.          END;
  994.  
  995.       FROMCONSOLE:=NOTHING;
  996.  
  997.    END;
  998.  
  999.  
  1000.  
  1001.  
  1002. PROCEDURE CtoS(x:MsgString; VAR s:istring);
  1003.    (* convert constant to STIP string *)
  1004.    VAR
  1005.       i : Integer;
  1006.    BEGIN
  1007.       FOR i:=1 TO Length(x) DO
  1008.          s[i] := Ord(x[i]);
  1009.       s[Length(x)+1] := ENDSTR;
  1010.    END;
  1011.  
  1012. PROCEDURE ErrorPack(c:MsgString);
  1013.    (* output Error packet if necessary -- then exit *)
  1014.    BEGIN
  1015.       WITH Buf[ThisPacket] DO
  1016.          BEGIN
  1017.             seq := n;
  1018.             ptype := TYPEE;
  1019.             CtoS(c,data);
  1020.             count := ilength(data);
  1021.          END;
  1022.       SendPacket;
  1023.       Writeln('%Message to other Host: ', c)
  1024.    END.
  1025.  
  1026. (* <<<KermitHelp.Pas>>> *)
  1027. MODULE KermitHelp ;
  1028.  
  1029. EXPORTS
  1030.  
  1031. PROCEDURE DoHelp ;
  1032.  
  1033. PRIVATE
  1034.  
  1035. IMPORTS  KermitUtils FROM KermitUtils ;
  1036.  
  1037.  
  1038. PROCEDURE DoHelp ;
  1039. (*)
  1040.  * Print out the Kermit help info. Use the utilities to write the
  1041.  * commands in inverse video.
  1042. (*)
  1043. BEGIN (*-DoHelp-*)
  1044. Writeln( Chr(#014) ) ; (* Clear the screen *)
  1045. Inverse( TRUE ) ;  Writeln(' CONNECT'); Inverse( FALSE ) ;
  1046. Writeln('Connect the PERQ to another host.  This allows you to log  into  other');
  1047. Writeln('systems.');
  1048. Inverse( TRUE ) ;  Writeln(' EXIT'); Inverse( FALSE ) ;
  1049. Writeln('Exit from KERMIT back to the PERQ operating system.');
  1050. Inverse( TRUE ) ;  Writeln(' HELP'); Inverse( FALSE ) ;
  1051. Writeln('Print instructions on various commands available in KERMIT.');
  1052. Inverse( TRUE ) ;  Writeln(' QUIT'); Inverse( FALSE ) ;
  1053. Writeln('Same as EXIT.');
  1054. Inverse( TRUE ) ;  Writeln(' RECEIVE <optional file-name>'); Inverse( FALSE ) ;
  1055. Writeln('Receive a file group from the remote host.  If an incoming  file  name');
  1056. Writeln('is  not  legal,  then attempt to transform it to a similar legal name,');
  1057. Writeln('e.g.  by deleting  illegal  or  excessive  characters.   If  the  file');
  1058. Writeln('already exists, it will be superceded unless WARNING is ON.');
  1059. Inverse( TRUE ) ;  Writeln(' SEND <file-specification>'); Inverse( FALSE ) ;
  1060. Writeln('Sends a file from the PERQ to the remote host.  The name of  the  file');
  1061. Writeln('is  passed to the remote host in a special control packet, so that the');
  1062. Writeln('remote host can store it with the same name.  Wildcards  are  not  yet');
  1063. Writeln('supported.');
  1064. Inverse( TRUE ) ;  Writeln(' SET <keyword>'); Inverse( FALSE ) ;
  1065. Writeln('Change various system-dependent parameters.  For a list  of  keywords,');
  1066. Writeln('type SET ?.');
  1067. Inverse( TRUE ) ;  Writeln(' SHOW <keyword>'); Inverse( FALSE ) ;
  1068. Writeln('Display various system-dependent parameters  established  by  the  SET');
  1069. Writeln('command.  For a list of available keywords type SHOW ?.');
  1070. Inverse( TRUE ) ;  Writeln(' STATISTICS'); Inverse( FALSE ) ;
  1071. Writeln('Display some statistics about Kermit''s operations.');
  1072.  
  1073. Writeln
  1074. END (*-DoHelp-*) .
  1075.  
  1076. (* <<<KermitParms.Pas>>> *)
  1077. MODULE KermitParms ;
  1078.  
  1079. (* Deal with various Kermit Parameters: Set and Show *)
  1080. (* 29-Nov-83 Allow eight bit file transfer [pgt001] *)
  1081.  
  1082.  
  1083. EXPORTS
  1084.  
  1085.  
  1086. PROCEDURE SetParameters ;
  1087. PROCEDURE DoShow ;
  1088.  
  1089.  
  1090.  
  1091.  
  1092. PRIVATE
  1093.  
  1094. IMPORTS KermitGlobals   FROM KermitGlobals ;
  1095. IMPORTS RS232Baud       FROM RS232Baud ;
  1096. IMPORTS CmdParse        FROM CmdParse ;
  1097. IMPORTS PopCmdParse     FROM PopCmdParse ;
  1098. IMPORTS PopUp           FROM PopUp ;
  1099. IMPORTS Perq_String     FROM Perq_String ;
  1100.  
  1101.  
  1102. PROCEDURE SetParameters ;
  1103.    (* Set Kermit flags and other communications features -pt*)
  1104.    VAR
  1105.       id, parm: String ; (* SET identifier and (possible) parameter *)
  1106.       switch, parmsw: Boolean ; (* Switch flags for feature and parameter *)
  1107.       index: Integer ; (* Command index *)
  1108.  
  1109.    PROCEDURE DoBaudRate( NewRate: String ) ;
  1110.       (* Try to set a new baud rate for the RS232 port *)
  1111.       CONST
  1112.          InputEnable = True ; (* Enable RS232 input *)
  1113.  
  1114.       HANDLER BadBaudRate ;
  1115.          BEGIN (*-BadBaudRate-*)
  1116.             Writeln('?Bad baud rate given: ', NewRate) ;
  1117.             EXIT( DoBaudRate )
  1118.          END ; (*-BadBaudRate-*)
  1119.  
  1120.       BEGIN (*-DoBaudRate-*)
  1121.          IF (NewRate = '') THEN Writeln('%No value for SET SPEED')
  1122.          ELSE
  1123.             BEGIN
  1124.                (* set the rate *)
  1125.                SetBaud( NewRate, InputEnabled) ;
  1126.                (* Here if that was successful, save the new rate *)
  1127.                BaudRate := NewRate
  1128.             END
  1129.       END ; (*-DoBaudRate-*)
  1130.  
  1131.    FUNCTION MkOctal( src: String ): Integer ;
  1132.       (* convert the octal number in the source string into a number *)
  1133.       VAR
  1134.          i, sum: Integer ; (* index and summation value *)
  1135.          ok: Boolean ;     (* loop control *)
  1136.       BEGIN (*-MkOctal-*)
  1137.          ok := True ;  i := 1 ;  sum := 0 ;
  1138.          WHILE ok DO
  1139.             IF NOT (src[i] IN ['0'..'7']) THEN ok := False (* reached non-octal *)
  1140.             ELSE
  1141.                BEGIN
  1142.                   sum := sum*8 + Ord(src[i]) - #60 ;
  1143.                   i := i + 1 ;
  1144.                   ok := (i <= Length(src)) (* exit test *)
  1145.                END ;
  1146.          MkOctal := sum
  1147.       END ; (*-MkOctal-*)
  1148.  
  1149.    PROCEDURE DoEscChr( OctalStr: String ) ;
  1150.       (* try to set a new CONNECT escape character *)
  1151.       (* OctalStr contains the string representation of the octal number *)
  1152.       VAR
  1153.          val: Integer ; (* The escape character's ordinal *)
  1154.       BEGIN (*-DoEscChr-*)
  1155.          IF (OctalStr = '') THEN
  1156.             Writeln('?SET ESCAPE requires an octal number')
  1157.          ELSE
  1158.             IF (OctalStr[1] IN ['0'..'7']) THEN
  1159.                BEGIN
  1160.                   val := MkOctal( OctalStr ) ; (* Get the value *)
  1161.                   IF (val = 0) OR (val > #037) THEN
  1162.                      Writeln('%Illegal ESCAPE character value: ', val:1:8)
  1163.                   ELSE
  1164.                      BEGIN
  1165.                         (* set the character and its printable version *)
  1166.                         EscapeChr := Chr( val ) ;
  1167.                         EscPrint  := Chr( val + #100 )
  1168.                      END
  1169.                END (* octal digit *)
  1170.             ELSE
  1171.                Writeln('?Non-Octal digit in SET ESCAPE parameter')
  1172.       END ; (*DoEscChr-*)
  1173.  
  1174.    PROCEDURE DoOnOff(VAR flag: Boolean) ;
  1175.       (*)
  1176.        * For the set feature with menu index <index> see if <parm> is
  1177.        * either ON or OFF. If so, set <flag> to True or False, resp.
  1178.        * Otherwise write error message and leave <flag> alone.
  1179.       (*)
  1180.       VAR
  1181.          val: Integer ; (* Value of table search ON/OFF *)
  1182.       BEGIN (*-DoOnOff-*)
  1183.          
  1184.          ConvUpper( parm ) ;  (* MUST be upper case *)
  1185.          
  1186.          IF (parm = '') THEN val := 3  (* not ON/OFF *)
  1187.          ELSE
  1188.             val := UniqueCmdIndex(parm, OnOff, 2) ;
  1189.  
  1190.          CASE  val  OF
  1191.             1: flag := True ;   (* ON  *)
  1192.             2: flag := False ;  (* OFF *)
  1193.             3: Writeln('%SET ', SetMenu^.Cmd[index], ' requires ON or OFF') ;
  1194.             4: Writeln('%Ambiguous ON or OFF in SET ', SetMenu^.Cmd[index] )
  1195.          END ; (* case *)
  1196.  
  1197.       END ; (*-DoOnOff-*)
  1198.  
  1199.    PROCEDURE SetHelp ;
  1200.       (* Provide help information for the command SET ?     *)
  1201.       BEGIN (*-SetHelp-*)
  1202.          Writeln ;
  1203.          Writeln('The following features are available with the SET command :') ;
  1204.          Writeln ;
  1205.          Writeln('SPEED <rate>       Change the PERQ''s line speed') ;
  1206.          Writeln('DEBUG ON|OFF       Print debug information') ;
  1207.          Writeln('ESCAPE <octal>     Change the CONNECT escape character') ;
  1208.          Writeln('WARNING ON|OFF     Give warning when overwriting existing files') ;
  1209.          Writeln('LOCAL ON|OFF       Echo CONNECT typein locally') ;
  1210.          Writeln('VERBOSE ON|OFF     Display Kermit''s actions') ;
  1211.          Writeln('EIGHT-BIT ON|OFF   Allow eight bit file transfer');(*[pgt001]*)
  1212.          Writeln
  1213.       END ; (*-SetHelp-*)
  1214.  
  1215.    BEGIN (*-SetParameter-*)
  1216.       (* If the command line is empty, prompt user *)
  1217.       IF (CmdLine = '') THEN
  1218.          BEGIN
  1219.             Write('Kermit-SET', PromptChar) ;
  1220.             Readln( CmdLine )
  1221.          END ;
  1222.  
  1223.       (* get the first identifier from the line *)
  1224.       dumCh := NextIDString( CmdLine, id, switch ) ;
  1225.       (* and a possible parameter *)
  1226.       dumCh := NextIDString( CmdLine, parm, parmsw ) ;
  1227.  
  1228.       IF (id = '') THEN (* nothing - return *)
  1229.       ELSE
  1230.          IF switch OR parmsw THEN Writeln('%SET does not take switches')
  1231.          ELSE
  1232.             IF (id[1] = '?') THEN SetHelp
  1233.             ELSE
  1234.                BEGIN
  1235.  
  1236.                   index := PopUniqueCmdIndex(id, RECAST(SetMenu, pNameDesc) ) ;
  1237.                   (* What was the command ? *)
  1238.                   CASE  index  OF
  1239.                      1: DoBaudRate( parm ) ;         (* SPEED *)
  1240.                      2: DoOnOff( debug ) ;           (* DEBUG *)
  1241.                      3: DoEscChr( parm ) ;           (* ESCAPE *)
  1242.                      4: DoOnOff( FileWarning ) ;     (* WARNING *)
  1243.                      5: DoOnOff( HalfDuplex ) ;      (* LOCAL *)
  1244.                      6: DoOnOff( Verbosity ) ;       (* VERBOSE *)
  1245.                      7: DoOnOff( EightBitFile ) ;    (* EIGHT-BIT [pgt001]*)
  1246.                      8: Writeln('%Not a SET feature: ', id) ;
  1247.                      9: Writeln('%Ambiguous SET feature: ', id)
  1248.                   END ; (* case *)
  1249.                END (* else *)
  1250.  
  1251.    END ; (*-SetParameter-*)
  1252.  
  1253.  
  1254.  
  1255. PROCEDURE DoShow ;
  1256.    (* Show the Kermit flags and parameters *)
  1257.    VAR
  1258.       flag: ARRAY [Boolean] OF String[3] ;  (* OF or OFF *)
  1259.       id: String ;   (* identifier *)
  1260.       switch: Boolean ;  (* SHOW /xxx    flag *)
  1261.       i: Integer ;   (* Index *)
  1262.  
  1263.    PROCEDURE Feature( index: Integer ) ;
  1264.       (* write a single feature - Index into SetMenu *)
  1265.       BEGIN (*-Index-*)
  1266.          CASE  index  OF
  1267.             1: Writeln('Baud rate  ', BaudRate) ;
  1268.             2: Writeln('Debug      ', flag[debug]) ;
  1269.             3: Writeln('Escape chr ^', EscPrint,'     (Octal ', Ord(EscapeChr):1:8, ')') ;
  1270.             4: Writeln('Warning    ', flag[FileWarning]) ;
  1271.             5: Writeln('Local      ', flag[HalfDuplex]) ;
  1272.             6: Writeln('Verbose    ', flag[Verbosity]) ;
  1273.             7: Writeln('Eight-Bit  ', flag[EightBitFile])  (*[pgt001]*)
  1274.             END  (* case *)
  1275.       END ; (*-Feature-*)
  1276.  
  1277.    BEGIN (*-DoShow-*)
  1278.  
  1279.       Writeln ;
  1280.       flag[True] := 'ON' ;
  1281.       flag[False]:= 'OFF' ;
  1282.  
  1283.       (* get the show feature *)
  1284.       dumCh := NextIDString(CmdLine, id, switch) ;
  1285.       IF (id = '') THEN id := 'ALL' ; (* Default *)
  1286.  
  1287.       IF switch THEN
  1288.          Writeln('%SHOW does not take switches')
  1289.       ELSE
  1290.       IF (id[1] = '?') THEN (* simple help *)
  1291.          BEGIN
  1292.             Writeln('One of the following :-') ;
  1293.             WITH  SetMenu^  DO
  1294.                FOR i := 1 TO ShowCount DO (* include 'ALL' *)
  1295.                   Writeln( Cmd[i] )
  1296.          END
  1297.       ELSE (* find feature's index *)
  1298.          BEGIN
  1299.             (* add 'ALL' to the search *)
  1300.             SetMenu^.numcmds := ShowCount ;
  1301.             i := PopUniqueCmdIndex( id, RECAST(SetMenu, pNameDesc) ) ;
  1302.             SetMenu^.numcmds := SetCount ;
  1303.  
  1304.             IF (i <= SetCount) THEN Feature( i )
  1305.             ELSE
  1306.                IF (i = ShowCount) THEN
  1307.                   BEGIN
  1308.                      FOR i := 1 TO SetCount DO Feature(i)
  1309.                   END
  1310.                ELSE
  1311.                   IF (i = ShowNot) THEN
  1312.                      Writeln('?Not a SHOW parameter: ', id)
  1313.                   ELSE
  1314.                      IF (i = ShowAmbig) THEN
  1315.                         Writeln('%Ambiguous SHOW parameter: ', id)
  1316.          END ; (* else *)
  1317.       Writeln
  1318.    END . (*-DoShow-*)
  1319.  
  1320. (* <<<KermitRecv.Pas>>> *)
  1321. MODULE KermitRecv ;
  1322.  
  1323. (* 29-Nov-83  Allow eight bit file transfer (c.f. sopen call) [pgt001] *)
  1324. (* 30-Nov-83  During a receive clear the screen and show characters    *)
  1325. (*            and packets received.      [pgt002]                      *)
  1326.  
  1327.  
  1328. EXPORTS
  1329.  
  1330. FUNCTION ReceiveACK : (* Returning *) Boolean;
  1331. PROCEDURE RecvSwitch; (* this procedure is the main receive routine *)
  1332.  
  1333.  
  1334. PRIVATE
  1335.  
  1336. IMPORTS KermitGlobals   FROM KermitGlobals ;
  1337. IMPORTS KermitUtils     FROM KermitUtils ;
  1338. IMPORTS Stdio           FROM Stdio ;
  1339. IMPORTS KermitError     FROM KermitError ;
  1340. IMPORTS KermitSend      FROM KermitSend ;  (* for sending ACKs and NAKs, etc *)
  1341. IMPORTS Screen          FROM Screen ;  (* screen control [pgt002] *)
  1342.  
  1343.  
  1344. VAR
  1345.    OldChInFile: Stats ;  (* Characters in file [pgt002]*)
  1346.    BadPackets: Integer ; (* Bad packet count for this recv [pgt002]*)
  1347.  
  1348.  
  1349. {$RANGE-}     (* Range checks off to see if it runs faster   (16-Jan-84)*)
  1350.  
  1351.  
  1352. PROCEDURE Field1; (* Count *)
  1353.    VAR
  1354.       test: Boolean;
  1355.    BEGIN
  1356.       WITH Buf[NextPacket] DO
  1357.          BEGIN
  1358.             WITH PackControl DO
  1359.                BEGIN
  1360.                   Buf[InputPacket].count := t;
  1361.                   count := UnChar(t);
  1362.                   test := (count >= 3) OR (count <= SizeRecv-2);
  1363.                   (* IF (NOT test) AND Debug THEN ErrorMsg('Bad count'); *)
  1364.                   good := good AND test;
  1365.                END;
  1366.          END;
  1367.    END;
  1368.  
  1369. PROCEDURE Field2; (* Packet Number *)
  1370.    VAR
  1371.       test : Boolean;
  1372.    BEGIN
  1373.       WITH Buf[NextPacket] DO
  1374.          BEGIN
  1375.             WITH PackControl DO
  1376.                BEGIN
  1377.                   Buf[InputPacket].seq := t;
  1378.                   seq := UnChar(t);
  1379.                   test := (seq >= 0) OR (seq <= 63);
  1380.                   (* IF (NOT test) AND Debug THEN ErrorMsg('Bad seq number'); *)
  1381.                   good := test AND good;
  1382.                END;
  1383.          END;
  1384.    END;
  1385.  
  1386. PROCEDURE Field3; (* Packet Type *)
  1387.    VAR
  1388.       test : Boolean;
  1389.    BEGIN
  1390.       WITH Buf[NextPacket] DO
  1391.          BEGIN
  1392.             WITH PackControl DO
  1393.                BEGIN
  1394.                   ptype := t;
  1395.                   Buf[InputPacket].ptype := t;
  1396.                   test := IsValidPType(ptype);
  1397.                   (* IF (NOT test) AND Debug THEN ErrorMsg('Bad Packet Type'); *)
  1398.                   good := test AND good;
  1399.                END;
  1400.          END;
  1401.    END;
  1402.  
  1403. PROCEDURE Field4; (* Data *)
  1404.    BEGIN
  1405.       WITH PackControl DO
  1406.          BEGIN
  1407.             PacketPtr := PacketPtr+1;
  1408.             Buf[InputPacket].data[PacketPtr] := t;
  1409.             WITH Buf[NextPacket] DO
  1410.                BEGIN
  1411.                   IF (t = MyQuote) THEN    (* character is quote *)
  1412.                      BEGIN
  1413.                         IF control THEN        (* quote ,quote  *)
  1414.                            BEGIN
  1415.                               data[i] := MyQuote;
  1416.                               i := i+1;
  1417.                               control := False;
  1418.                            END
  1419.                         ELSE      (* set control on *)
  1420.                            control := True
  1421.                      END
  1422.                   ELSE                 (* not quote *)
  1423.                      IF control THEN      (* convert to control *)
  1424.                         BEGIN
  1425.                            data[i] := ctl(t);
  1426.                            i := i+1;
  1427.                            control := False
  1428.                         END
  1429.                      ELSE      (* regular data *)
  1430.                         BEGIN
  1431.                            data[i] := t;
  1432.                            i := i+1;
  1433.                         END;
  1434.                END;
  1435.          END;
  1436.    END;
  1437.  
  1438. PROCEDURE Field5; (* Check Sum *)
  1439.    VAR
  1440.       test : Boolean;
  1441.    BEGIN
  1442.       WITH PackControl DO
  1443.          BEGIN
  1444.             PacketPtr := PacketPtr +1;
  1445.             Buf[InputPacket].data[PacketPtr] := t;
  1446.             Buf[InputPacket].data[PacketPtr + 1] := ENDSTR;
  1447.             check := CheckFunction(check);
  1448.             check := MakeChar(check);
  1449.             test := (t=check);
  1450.             IF (NOT test) AND Debug THEN ErrorMsg('Bad CheckSum');
  1451.             good := test AND good;
  1452.             Buf[NextPacket].data[i] := ENDSTR;
  1453.             finished := True;  (* set finished *)
  1454.          END;
  1455.    END;
  1456.  
  1457. PROCEDURE BuildPacket;
  1458.    (* receive packet & validate checksum *)
  1459.    VAR
  1460.       temp : Ppack;
  1461.    BEGIN
  1462.       WITH PackControl DO
  1463.          BEGIN
  1464.             WITH Buf[NextPacket] DO
  1465.                BEGIN
  1466.                   IF (t <> ENDSTR) THEN
  1467.                      IF restart THEN
  1468.                         BEGIN
  1469.                            (* read until get SOH marker *)
  1470.                            IF (t = SOH) THEN
  1471.                               BEGIN
  1472.                                  finished := False;    (* set varibles *)
  1473.                                  control := False;
  1474.                                  good := True;
  1475.                                  seq := -1;        (* set return values to bad packet *)
  1476.                                  ptype := QUESTION;
  1477.                                  data[1] := ENDSTR;
  1478.                                  data[MAXSTR] := ENDSTR;
  1479.                                  restart := False;
  1480.                                  fld := 0;
  1481.                                  i := 1;
  1482.                                  PacketPtr := 0;
  1483.                                  check := 0;
  1484.                               END;
  1485.                         END
  1486.                      ELSE  (* Not restart -pt*)    (* have started packet *)
  1487.                         BEGIN
  1488.                            IF (t = SOH) THEN    (* check for restart or EOL *)
  1489.                               restart := True
  1490.                            ELSE
  1491.                               IF (t = myEOL) THEN
  1492.                                  BEGIN
  1493.                                     finished := True;
  1494.                                     good := False;
  1495.                                  END
  1496.                               ELSE
  1497.                                  BEGIN
  1498.                                     CASE fld OF
  1499.                                        (* increment field number *)
  1500.                                        0:   fld := 1;
  1501.                                        1:   fld := 2;
  1502.                                        2:   fld := 3;
  1503.                                        3:
  1504.                                           IF (count = 3)  (* no data *)
  1505.                                           THEN fld := 5
  1506.                                           ELSE fld := 4;
  1507.                                        4:
  1508.                                           IF (PacketPtr>=count-3) (* end of data *)
  1509.                                           THEN fld := 5;
  1510.                                        END (* case *);
  1511.                                     IF (fld <> 5)
  1512.                                     THEN  check := check+t; (* add into checksum *)
  1513.  
  1514.                                     CASE fld OF
  1515.                                        1:      Field1;
  1516.                                        2:      Field2;
  1517.                                        3:      Field3;
  1518.                                        4:      Field4;
  1519.                                        5:      Field5;
  1520.                                     END;
  1521.                                     (* case *)
  1522.                                  END;
  1523.                         END;
  1524.  
  1525.                   IF finished THEN
  1526.                      BEGIN
  1527.                         IF (ptype = TYPEE) AND good THEN (* error_packets *)
  1528.                            BEGIN
  1529.                               SendACK(n);          (* send ACK *)
  1530.  
  1531.                               RAISE GotErrorPacket( data ) ; (* ********** *)
  1532.  
  1533.                            END;
  1534.                         NumRecvPacks := NumRecvPacks+1;
  1535.                         IF Debug THEN
  1536.                            BEGIN
  1537.                               DebugPacket('Received: ',InputPacket);
  1538.                               IF good THEN ErrorMsg('Is Good');
  1539.                            END;
  1540.  
  1541.                         temp := CurrentPacket;
  1542.                         CurrentPacket := NextPacket;
  1543.                         NextPacket := temp;
  1544.                      END;
  1545.                END;
  1546.          END;
  1547.    END;
  1548.  
  1549. FUNCTION ReceivePacket: Boolean;
  1550.    BEGIN
  1551.       WITH PackControl DO
  1552.          BEGIN
  1553.             StartTimer;
  1554.             good := False ;
  1555.             finished := False;
  1556.             restart := True;
  1557.             (* No Keyboard Interupt - Set by ^C handler -pt*)
  1558.             FromConsole := nothing;
  1559.             REPEAT
  1560.                t := GetIn;
  1561.  
  1562.                CheckTimer ;
  1563.                IF (FromConsole = abortnow) THEN
  1564.                   BEGIN
  1565.                      State := ABORT ;
  1566.                      ReceivePacket := False ;
  1567.                      EXIT( ReceivePacket )
  1568.                   END;
  1569.  
  1570.                BuildPacket;
  1571.             UNTIL finished  OR (TimeLeft <= 0);
  1572.             IF (TimeLeft <= 0) THEN
  1573.                BEGIN
  1574.                   Buf[CurrentPacket] := TOPacket;
  1575.                   restart := True;
  1576.                   IF NOT ((RunType=Transmit) AND (State=Init)) THEN
  1577.                      BEGIN
  1578.                         ErrorInt('%Timed out ', n)
  1579.                      END;
  1580.                END;
  1581.             StopTimer;
  1582.             IF NOT good THEN BadPackets := BadPackets + 1 ;
  1583.             ReceivePacket := good;
  1584.          END;
  1585.    END;
  1586.  
  1587. FUNCTION ReceiveACK : (* Returning *) Boolean;
  1588.    (* receive ACK with correct number *)
  1589.    VAR
  1590.       Ok: Boolean;
  1591.    BEGIN
  1592.       Ok := ReceivePacket;
  1593.       WITH Buf[CurrentPacket] DO
  1594.          BEGIN
  1595.             IF (ptype = TYPEY) THEN   NumACKrecv := NumACKrecv+1
  1596.             ELSE
  1597.                IF (ptype = TYPEN) THEN  NumNAKrecv := NumNAKrecv+1
  1598.                ELSE
  1599.                     NumBadrecv := NumBadrecv +1;
  1600.             (* got right one ? *)
  1601.             ReceiveACK := ( Ok AND (ptype=TYPEY) AND (n=seq))
  1602.          END;
  1603.    END;
  1604.  
  1605.  
  1606. PROCEDURE GetFile((* Using *) data:istring);
  1607.    (* create file from fileheader packet *)
  1608.    VAR
  1609.       len: Integer;
  1610.    
  1611.    PROCEDURE Strip( var name: istring ) ;
  1612.    (* Strip off any blanks (usually trailing) from the file name *)
  1613.    VAR i, newpos: integer ;
  1614.    BEGIN (*-Strip-*)
  1615.       newpos := 1 ;  (* this is the new character position for non-blanks *)
  1616.       FOR i := 1 TO ilength(name) DO
  1617.         IF (name[i] = blank) THEN (* skip it by not incrementing "newpos"  *)
  1618.         ELSE
  1619.            BEGIN (* restore character *)
  1620.               name[newpos] := name[i] ;
  1621.               newpos := newpos + 1
  1622.            END ;
  1623.  
  1624.       name[newpos] := ENDSTR
  1625.    END ; (*-Strip-*)
  1626.    
  1627.    BEGIN
  1628.       WITH Buf[CurrentPacket] DO
  1629.          BEGIN
  1630.             IF (DiskFile = StdIOError) THEN (* check if we already have a file *)
  1631.                BEGIN
  1632.                   Strip( data ) ;  (* remove any blanks *)
  1633.                   IF Verbosity THEN
  1634.                      BEGIN
  1635.                         ErrorMsg ('Creating file: ');
  1636.                         ErrorStr(data);
  1637.                      END;
  1638.                   IF Exists(data) AND FileWarning THEN
  1639.                      BEGIN
  1640.                         ErrorMsg('File already exists ');
  1641.                         ErrorStr(data);
  1642.                         ErrorMsg('Creating: ');
  1643.                         (* Make it <file>.A *)
  1644.                         len := ilength(data) + 1 ; (* first free char pos *)
  1645.                         data[len] := PERIOD ;
  1646.                         data[len+1] := leta ;
  1647.                         data[len+2] := ENDSTR;
  1648.                         ErrorStr(data)
  1649.                      END;
  1650.                   IF EightBitFile THEN
  1651.                      DiskFile := Sopen(data,StdIO8Write)
  1652.                   ELSE
  1653.                      DiskFile := Sopen(data,StdIOWrite);
  1654.                END;
  1655.             IF (Diskfile <= StdIOError) THEN ErrorPack('Cannot create file  ');
  1656.          END;
  1657.    END;
  1658.  
  1659. PROCEDURE ReceiveInit;
  1660.    (* receive init packet *)
  1661.    (* respond with ACK and  our parameters *)
  1662.    BEGIN
  1663.       IF (NumTry > MaxTry) THEN
  1664.          BEGIN
  1665.             State := Abort;
  1666.             ErrorMsg('Cannot receive init');
  1667.          END
  1668.       ELSE
  1669.          BEGIN
  1670.             Verbose('Receiving Init');
  1671.             NumTry := NumTry+1;
  1672.             IF ReceivePacket
  1673.                AND (Buf[CurrentPacket].ptype = TYPES) THEN
  1674.                BEGIN
  1675.                   WITH Buf[CurrentPacket] DO
  1676.                      BEGIN
  1677.                         n := seq;
  1678.                         DeCodeParm(data);
  1679.                      END;
  1680.  
  1681.                   (* now send mine *)
  1682.                   WITH Buf[ThisPacket] DO
  1683.                      BEGIN
  1684.                         count := NUMPARAM;
  1685.                         seq := n;
  1686.                         Ptype := TYPEY;
  1687.                         EnCodeParm(data);
  1688.                      END;
  1689.  
  1690.                   SendPacket;
  1691.  
  1692.                   NumACK := NumACK+1;
  1693.                   State := FileHeader;
  1694.                   OldTry := NumTry;
  1695.                   NumTry := 0;
  1696.                   n := (n+1) MOD 64
  1697.                END
  1698.             ELSE
  1699.                BEGIN
  1700.                   IF Debug THEN ErrorMsg('Received Bad init');
  1701.                   SendNAK(n);
  1702.                END;
  1703.          END;
  1704.    END;
  1705.  
  1706. PROCEDURE DataToFile; (* output to file *)
  1707.    VAR
  1708.       len,i : Integer;
  1709.       temp : istring;
  1710.    BEGIN
  1711.       WITH Buf[CurrentPacket] DO
  1712.          BEGIN
  1713.             len := ilength(data);
  1714.             ChInFile := ChInFile + len ;
  1715.             PutStr(data,DiskFile)
  1716.          END;
  1717.    END;
  1718.  
  1719. PROCEDURE Dodata;  (* Process Data packet *)
  1720.  
  1721.    BEGIN
  1722.       WITH Buf[CurrentPacket] DO
  1723.          BEGIN
  1724.             IF ( seq = ((n + 63) MOD 64)) THEN
  1725.                BEGIN                (* data last one *)
  1726.                   IF (OldTry > MaxTry) THEN     (* number of tries? *)
  1727.                      BEGIN
  1728.                         State := Abort;
  1729.                         ErrorMsg('Old data - Too many');
  1730.                      END
  1731.                   ELSE
  1732.                      BEGIN
  1733.                         SendACK(seq);
  1734.                         NumTry := 0;
  1735.                      END;
  1736.                END
  1737.             ELSE
  1738.                BEGIN            (* data - this one *)
  1739.                   IF (n <> seq) THEN  SendNAK(n)
  1740.                   ELSE
  1741.                      BEGIN
  1742.                         SendACK(n); (* ACK *)
  1743.                         DataToFile;
  1744.                         OldTry := NumTry;
  1745.                         NumTry := 0;
  1746.                         n := (n+1) MOD 64;
  1747.                      END;
  1748.                END;
  1749.          END;
  1750.    END;
  1751.  
  1752. PROCEDURE DoFileLast;   (* Process File Packet *)
  1753.    BEGIN          (* File header - last one  *)
  1754.       IF (OldTry > MaxTry) THEN   (* tries ? *)
  1755.          BEGIN
  1756.             State := Abort;
  1757.             ErrorMsg('Old file - Too many ');
  1758.          END
  1759.       ELSE
  1760.          BEGIN
  1761.             OldTry := OldTry+1;
  1762.             WITH Buf[CurrentPacket] DO
  1763.                BEGIN
  1764.                   IF (seq = ((n + 63) MOD 64)) THEN     (* packet number *)
  1765.                      BEGIN  (* send ACK *)
  1766.                         SendACK(seq);
  1767.                         NumTry := 0
  1768.                      END
  1769.                   ELSE
  1770.                      BEGIN
  1771.                         SendNAK(n);   (* NAK *)
  1772.                      END;
  1773.                END;
  1774.          END;
  1775.    END;
  1776.  
  1777. PROCEDURE DoEOF;  (* Process EOF packet *)
  1778.    BEGIN                 (* EOF - this one *)
  1779.       IF (Buf[CurrentPacket].seq <> n) THEN   (* packet number ? *)
  1780.          SendNAK(n) (* NAK *)
  1781.       ELSE
  1782.          BEGIN               (* send ACK *)
  1783.             SendACK(n);
  1784.             Sclose(DiskFile);  (* close file *)
  1785.             DiskFile := StdIOError;
  1786.             OldTry := NumTry;
  1787.             NumTry := 0;
  1788.             n := (n+1) MOD 64; (* next packet  *)
  1789.             State := FileHeader;   (* change state *)
  1790.          END;
  1791.    END;
  1792.  
  1793. PROCEDURE ReceiveData;  (* Receive data packets *)
  1794.    VAR
  1795.       strend: Integer;
  1796.       packetnum: istring;
  1797.       good : Boolean;
  1798.  
  1799.    BEGIN
  1800.       IF (NumTry > MaxTry) THEN    (* check number of tries *)
  1801.          BEGIN
  1802.             State := Abort;
  1803.             ErrorInt('Recv data -Too many ', n)
  1804.          END
  1805.       ELSE
  1806.          BEGIN
  1807.             NumTry := NumTry+1;                (* increase number of tries *)
  1808.             good := ReceivePacket;        (* get packet *)
  1809.             WITH Buf[CurrentPacket] DO
  1810.                BEGIN
  1811.                   IF Verbosity THEN
  1812.                      BEGIN
  1813.                         ErrorInt('Receiving (Data) ', Buf[CurrentPacket].seq);
  1814.                      END ;
  1815.  
  1816.                   IF ((ptype = TYPED) OR (ptype=TYPEZ)
  1817.                       OR (ptype=TYPEF)) AND good  THEN   (* check type *)
  1818.                      CASE ptype OF
  1819.                         TYPED:  DoData;
  1820.                         TYPEF:  DoFileLast;
  1821.                         TYPEZ:  DoEOF;
  1822.                         END (* case *)
  1823.                   ELSE
  1824.                      BEGIN
  1825.                         Verbose('Expected data pack');
  1826.                         SendNAK(n);
  1827.                      END;
  1828.                END;
  1829.          END;
  1830.    END;
  1831.  
  1832. PROCEDURE DoBreak; (* Process Break packet *)
  1833.    BEGIN                    (* Break transmission *)
  1834.       IF (Buf[CurrentPacket].seq <> n) THEN  (* packet number ? *)
  1835.          SendNAK(n) (* NAK *)
  1836.       ELSE
  1837.          BEGIN            (* send  ACK *)
  1838.             SendACK(n) ;
  1839.             State := Complete  (* change state *)
  1840.          END
  1841.    END;
  1842.  
  1843. PROCEDURE DoFile; (* Process file packet *)
  1844.    BEGIN                 (* File Header *)
  1845.       WITH Buf[CurrentPacket] DO
  1846.          BEGIN
  1847.             IF (seq <> n) THEN         (* packet number ? *)
  1848.                SendNAK(n)  (* NAK *)
  1849.             ELSE
  1850.                BEGIN               (* send ACK *)
  1851.                   SendACK(n);
  1852.                   ChInFile := ChInFile + ilength(data) ;
  1853.                   GetFile(data);   (* get file name *)
  1854.                   OldTry := NumTry;
  1855.                   NumTry := 0;
  1856.                   n := (n+1) MOD 64; (* next packet  *)
  1857.                   State := FileData;   (* change state *)
  1858.                END;
  1859.          END;
  1860.    END;
  1861.  
  1862. PROCEDURE DoEOFLast; (* Process EOF Packet *)
  1863.    BEGIN               (* End Of File Last One*)
  1864.       IF (OldTry > MaxTry) THEN (* tries ? *)
  1865.          BEGIN
  1866.             State := Abort;
  1867.             ErrorMsg('Old EOF - Too many');
  1868.          END
  1869.       ELSE
  1870.          BEGIN
  1871.             OldTry := OldTry+1;
  1872.             WITH Buf[CurrentPacket] DO
  1873.                BEGIN
  1874.                   IF (seq =((n + 63 ) MOD 64)) THEN   (* packet number *)
  1875.                      BEGIN  (* send ACK *)
  1876.                         SendACK(seq);
  1877.                         Numtry := 0
  1878.                      END
  1879.                   ELSE
  1880.                      BEGIN
  1881.                         SendNAK(n);  (* NAK *)
  1882.                      END
  1883.                END;
  1884.          END;
  1885.    END;
  1886.  
  1887. PROCEDURE DoInitLast;
  1888.    BEGIN                (* Init Packet - last one *)
  1889.       IF (OldTry > MaxTry) THEN  (* number of tries? *)
  1890.          BEGIN
  1891.             State := Abort;
  1892.             ErrorMsg('Old init - Too many');
  1893.          END
  1894.       ELSE
  1895.          BEGIN
  1896.             OldTry := OldTry+1;
  1897.             (* packet number *)
  1898.             IF (Buf[CurrentPacket].seq = ((n + 63) MOD  64)) THEN
  1899.                BEGIN   (* send ACK *)
  1900.                   WITH Buf[ThisPacket] DO
  1901.                      BEGIN
  1902.                         count := NUMPARAM;
  1903.                         seq := Buf[CurrentPacket].seq;
  1904.                         ptype := TYPEY;
  1905.                         EnCodeParm(data);
  1906.                      END;
  1907.                   SendPacket;
  1908.                   NumACK := NumACK+1;
  1909.                   NumTry := 0;
  1910.                END
  1911.             ELSE
  1912.                BEGIN
  1913.                   SendNAK(n);  (* NAK *)
  1914.                END;
  1915.          END;
  1916.    END;
  1917.  
  1918. PROCEDURE ReceiveFile; (* receive file packet *)
  1919.    VAR
  1920.       good: Boolean;
  1921.  
  1922.    BEGIN
  1923.       IF (NumTry > MaxTry) THEN     (* check number of tries *)
  1924.          BEGIN
  1925.             State := Abort;
  1926.             ErrorMsg('Recv file - Too many');
  1927.          END
  1928.       ELSE
  1929.          BEGIN
  1930.             NumTry := NumTry+1;                (* increase number of tries *)
  1931.             good := ReceivePacket;             (* get packet *)
  1932.             WITH Buf[CurrentPacket] DO
  1933.                BEGIN
  1934.                   IF Verbosity THEN BEGIN
  1935.                      ErrorInt('Receiving (File) ', seq)
  1936.                   END;
  1937.  
  1938.                   (* Set up for new file [pgt002] *)
  1939.                   OldChInFile := ChInFile ; (* Start value *)
  1940.                   BadPackets := 0 ;
  1941.  
  1942.                   SSetCursor(250, 100) ;
  1943.                   Write('File: ');
  1944.                   PutStr(data,stdout);
  1945.                   Write(' ':10) ; (* blank the end  of any other names *)
  1946.  
  1947.                   IF ((ptype = TYPES) OR (ptype=TYPEZ)
  1948.                       OR (ptype=TYPEF) OR (ptype=TYPEB)) (* check type *)
  1949.                   AND good    THEN
  1950.                      CASE ptype OF
  1951.                         TYPES:  DoInitLast;
  1952.                         TYPEZ:  DoEOFLast;
  1953.                         TYPEF:  DoFile;
  1954.                         TYPEB:  DoBreak;
  1955.                         END (* case *)
  1956.                   ELSE
  1957.                      BEGIN
  1958.                         IF Debug THEN   ErrorMsg('Expected File Pack');
  1959.                         SendNAK(n);
  1960.                      END;
  1961.                END;
  1962.          END;
  1963.    END;
  1964.  
  1965.  
  1966. PROCEDURE RecvSwitch; (* this procedure is the main receive routine *)
  1967.  
  1968.    HANDLER GotErrorPacket( VAR msg: istring ) ;
  1969.      (* Handle any error packets reveived. Write msg and exit *)
  1970.      BEGIN
  1971.         Inverse( TRUE ) ;
  1972.         Writeln ;
  1973.         Writeln('?RECV received error packet from other Host');
  1974.         putstr(msg, STDOUT) ;
  1975.         Writeln ;
  1976.         Inverse( FALSE ) ;
  1977.         SClose( DiskFile ) ;  (* Close the file, if open *)
  1978.         State := Abort ;
  1979.         EXIT( RecvSwitch )
  1980.      END ;
  1981.  
  1982.    BEGIN
  1983.       State := Init;
  1984.       NumTry := 0;
  1985.  
  1986.       OldChInFile := ChInFile ; (* Start value *)
  1987.       BadPackets := 0 ;
  1988.  
  1989.       (* set up the progress reports (c.f. ReceiveFile too) [pgt002] *)
  1990.       IF NOT Verbosity THEN
  1991.          BEGIN
  1992.            SPutChr(FF) ; (* clear the screen *)
  1993.            SSetCursor(200, 150);   Write( 'Current Packet' );
  1994.            SSetCursor(200, 170);   Write( 'Characters received' );
  1995.            SSetCursor(200, 190);   Write( 'Bad packets received' )
  1996.          END ;
  1997.  
  1998.  
  1999.       REPEAT
  2000.  
  2001.          (* Each time thru' the loop print the values [pgt002] *)
  2002.          IF NOT Verbosity THEN
  2003.             BEGIN
  2004.               SSetCursor(410, 150);  Write( n:8 ) ;
  2005.               SSetCursor(410, 170);  Write( (ChInFile-OldChInFile):10:0 ) ;
  2006.               SSetCursor(410, 190);  Write( BadPackets:8 )
  2007.             END ;
  2008.  
  2009.  
  2010.          CASE State OF
  2011.             FileData:       ReceiveData;
  2012.             Init:           ReceiveInit;
  2013.             Break:          (* nothing *);
  2014.             FileHeader:     ReceiveFile;
  2015.             EOFile:         (* nothing *);
  2016.             Complete:       (* nothing *);
  2017.             Abort:          (* nothing *);
  2018.          END; (* case *)
  2019.  
  2020.       UNTIL ( State = Abort ) OR ( State = Complete );
  2021.    
  2022.       SSetCursor(10, 250) ;
  2023.       Writeln
  2024.    END.
  2025.  
  2026. (* <<<KermitSend>>> *)
  2027. MODULE KermitSend ;
  2028.  
  2029. (* 29-Nov-83 Allow eight bit file transfer (c.f. sopen call) [pgt001] *)
  2030.  
  2031.  
  2032. EXPORTS
  2033.  
  2034. PROCEDURE SendPacket;
  2035. PROCEDURE SendACK((* Using *) n:Integer); (* send ACK packet *)
  2036. PROCEDURE SendNAK((* Using *) n:Integer); (* send NAK packet *)
  2037. PROCEDURE SendSwitch;
  2038.  
  2039.  
  2040.  
  2041.  
  2042. PRIVATE
  2043.  
  2044. IMPORTS KermitGlobals   FROM KermitGlobals ;
  2045. IMPORTS KermitUtils     FROM KermitUtils ;
  2046. IMPORTS Stdio           FROM Stdio ;
  2047. IMPORTS KermitError     FROM KermitError ;
  2048. IMPORTS KermitRecv      FROM KermitRecv ;    (* for receiving ACKs and NAKs *)
  2049. IMPORTS UtilProgress    FROM UtilProgress ;
  2050. IMPORTS Sleep           FROM Sleep ;
  2051.  
  2052.  
  2053. {$RANGE-}    (* Range checks off   16-Jan-84 *)
  2054.  
  2055.  
  2056.  
  2057.  
  2058. VAR
  2059.    DataSendCount: Integer ; (* counter for progress *)
  2060.  
  2061.  
  2062. PROCEDURE PutOut( p : Ppack); (* Output Packet *)
  2063.    (* Use direct calls to XmtChar to send the characters -pt*)
  2064.    VAR
  2065.       i : Integer;
  2066.    BEGIN
  2067.       IF (NumPad > 0) THEN
  2068.          FOR i := 1 TO NumPad DO
  2069.             XmtChar( Chr(PadChar) );
  2070.       WITH Buf[p] DO
  2071.          BEGIN
  2072.             XmtChar( Chr(mark) );
  2073.             XmtChar( Chr(count) );
  2074.             XmtChar( Chr(seq) );
  2075.             XmtChar( Chr(ptype) );
  2076.             FOR i := 1 TO ilength(data) DO
  2077.                XmtChar( Chr(data[i]) );
  2078.          END;
  2079.    END;
  2080.  
  2081.  
  2082. PROCEDURE ReSendPacket;
  2083.    (* re -sends previous packet *)
  2084.    BEGIN
  2085.       NumSendPacks := NumSendPacks+1;
  2086.       ChInPack := ChInPack + NumPad + UnChar(Buf[LastPacket].count) + 3 ;
  2087.       IF Debug
  2088.       THEN DebugPacket('Re-Sending: ',LastPacket);
  2089.       PutOut(LastPacket);
  2090.    END;
  2091.  
  2092. PROCEDURE SendPacket;
  2093.  
  2094.    (* expects count as length of data portion *)
  2095.    (* and seq as number of packet *)
  2096.    (* builds & sends packet *)
  2097.    VAR
  2098.       i,len,chksum : Integer;
  2099.       temp : Ppack;
  2100.    BEGIN
  2101.       IF (NumTry <> 1) AND (RunType = Transmit) THEN
  2102.          ReSendPacket
  2103.       ELSE
  2104.          BEGIN
  2105.             WITH Buf[ThisPacket] DO
  2106.                BEGIN
  2107.                   mark :=SOH;               (* mark *)
  2108.                   len := count;             (* save length *)
  2109.                   count := MakeChar(len+3); (* count = 3+length of data *)
  2110.                   seq := MakeChar(seq);     (* seq number *)
  2111.                   chksum := count + seq + ptype;
  2112.                   IF (len > 0) THEN      (* is there data ? *)
  2113.                      FOR i:= 1 TO len DO
  2114.                         chksum := chksum + data[i];       (* loop for data *)
  2115.                   chksum := CheckFunction(chksum);  (* calculate  checksum *)
  2116.                   data[len+1] := MakeChar(chksum);  (* make printable & output *)
  2117.                   data[len+2] := SendEOL;                    (* EOL *)
  2118.                   data[len+3] := ENDSTR;
  2119.                END;
  2120.  
  2121.             NumSendPacks := NumSendPacks+1;
  2122.             IF Debug
  2123.             THEN DebugPacket('Sending: ',ThisPacket);
  2124.             PutOut(ThisPacket);
  2125.  
  2126.             IF (RunType = Transmit) THEN
  2127.                BEGIN
  2128.                   ChInPack := ChInPack + NumPad + len + 6;
  2129.                   temp := LastPacket;
  2130.                   LastPacket := ThisPacket;
  2131.                   ThisPacket := temp;
  2132.                END;
  2133.          END
  2134.  
  2135.    END;
  2136.  
  2137. PROCEDURE SendACK((* Using *) n:Integer); (* send ACK packet *)
  2138.    BEGIN
  2139.       WITH Buf[ThisPacket] DO
  2140.          BEGIN
  2141.             count := 0;
  2142.             seq := n;
  2143.             ptype := TYPEY;
  2144.          END;
  2145.       SendPacket;
  2146.       NumACK := NumACK+1;
  2147.    END;
  2148.  
  2149. PROCEDURE SendNAK((* Using *) n:Integer); (* send NAK packet *)
  2150.    BEGIN
  2151.       WITH Buf[ThisPacket] DO
  2152.          BEGIN
  2153.             count := 0;
  2154.             seq := n;
  2155.             ptype := TYPEN;
  2156.          END;
  2157.       SendPacket;
  2158.       NumNAK := NumNAK+1;
  2159.    END;
  2160.  
  2161.  
  2162.  
  2163. PROCEDURE GetData((* Returning *)   VAR newstate:KermitStates);
  2164.    (* get data from file into ThisPacket *)
  2165.    VAR
  2166.       (* and return next state - data &  EOF *)
  2167.       x,c : CharBytes;
  2168.       i: Integer;
  2169.    BEGIN
  2170.       IF (NumTry = 1) THEN
  2171.          BEGIN
  2172.             i := 1;
  2173.             x := ENDSTR;
  2174.             WITH Buf[ThisPacket] DO
  2175.                BEGIN
  2176.                   WHILE (i< SizeSend - 8 ) AND (x <> ENDFILE)
  2177.                   (* leave room for quote  & NEWLINE *)
  2178.                   DO
  2179.                      BEGIN
  2180.                         x := getcf(c,DiskFile);
  2181.                         IF (x <> ENDFILE) THEN
  2182.                            IF IsControl(x) OR (x = SendQuote) THEN
  2183.                               BEGIN           (* control char -- quote *)
  2184.                                  IF (x = LF) THEN  (* use proper EOL *)
  2185.                                    BEGIN
  2186.                                       data[i] := SendQuote;
  2187.                                       i := i+1;
  2188.                                       data[i] := Ctl(CR);
  2189.                                       i := i+1;
  2190.                                       (* LF will sent below *)
  2191.                                    END;
  2192.                                  data[i] := SendQuote;
  2193.                                  i := i+1;
  2194.                                  IF (x <> SendQuote) THEN  data[i] := Ctl(x)
  2195.                                  ELSE  data[i] := SendQuote;
  2196.                               END
  2197.                            ELSE               (* regular char *)
  2198.                               data[i] := x;
  2199.  
  2200.                         IF (x <> ENDFILE) THEN
  2201.                            BEGIN
  2202.                               i := i+1;    (* increase count for next char *)
  2203.                               ChInFile := ChInFile + 1 ;
  2204.                            END;
  2205.                      END;
  2206.  
  2207.                   data[i] := ENDSTR;   (* to terminate string *)
  2208.  
  2209.                   count := i -1;       (* length *)
  2210.                   seq := n;
  2211.                   ptype := TYPED;
  2212.  
  2213.                   IF (x = ENDFILE) THEN
  2214.                      BEGIN
  2215.                         newstate := EOFile;
  2216.                         Sclose(DiskFile);
  2217.                         DiskFile := StdIOError;
  2218.                      END
  2219.                   ELSE
  2220.                      newstate := FileData;
  2221.                   SaveState := newstate;        (* save state *)
  2222.                END
  2223.          END
  2224.       ELSE
  2225.          newstate := SaveState;        (* get old state *)
  2226.    END;
  2227.  
  2228. FUNCTION GetNextFile: (* Returning *) Boolean;
  2229.    (* get next file to send in ThisPacket *)
  2230.    (* returns true if no more *)
  2231.    (*         ----    --      -pt*)
  2232.    VAR
  2233.       result: Boolean;
  2234.    BEGIN
  2235.       result := True;
  2236.       IF (NumTry = 1) THEN
  2237.          WITH Buf[ThisPacket] DO
  2238.             BEGIN
  2239.                IF GetArgument(data) THEN
  2240.                   BEGIN            (* open file  *)
  2241.                      IF Exists(data) THEN
  2242.                         BEGIN
  2243.                            (* Initialise counter for each file to be sent *)
  2244.                            DataSendCount := 0 ;
  2245.  
  2246.                            IF EightBitFile THEN  (* [pgt001] *)
  2247.                               DiskFile := Sopen(data,StdIO8Read)
  2248.                            ELSE
  2249.                               DiskFile := Sopen(data,StdIORead);
  2250.  
  2251.                            count := ilength(data);
  2252.                            ChInFile := ChInFile + count ;
  2253.                            seq := n;
  2254.                            ptype := TYPEF;
  2255.                            Write('[Sending ');
  2256.                            PutStr(data,stdout);
  2257.                            Writeln(']') ;
  2258.                            IF (DiskFile <= StdIOError) THEN
  2259.                               ErrorMsg('?Can''t open file');
  2260.                            result := False;
  2261.                         END
  2262.                      ELSE (* file does not exist *)
  2263.                         BEGIN
  2264.                            ErrorMsg('?Can''t find file: ') ;
  2265.                            ErrorStr( data ) ;
  2266.                            result := True  (* I.e. fail: state -> abort *)
  2267.                         END
  2268.                   END;
  2269.             END
  2270.       ELSE
  2271.          result := False; (* for saved packet *)
  2272.       GetNextFile := result;
  2273.    END;
  2274.  
  2275. PROCEDURE SendFile; (* send file name packet *)
  2276.    BEGIN
  2277.       Verbose( 'Sending ');
  2278.       IF (NumTry > MaxTry) THEN
  2279.          BEGIN
  2280.             ErrorMsg ('Send file - Too Many');
  2281.             State := Abort;      (* too many tries, abort *)
  2282.          END
  2283.       ELSE
  2284.          BEGIN
  2285.             NumTry := NumTry+1;
  2286.             IF GetNextFile THEN
  2287.                BEGIN
  2288.                   State := Break;
  2289.                   NumTry := 0;
  2290.                END
  2291.             ELSE
  2292.                BEGIN
  2293.                   IF Verbosity THEN
  2294.                      IF (NumTry = 1)
  2295.                      THEN ErrorStr(Buf[ThisPacket].data)
  2296.                      ELSE ErrorStr(Buf[LastPacket].data);
  2297.                   SendPacket;     (* send this packet *)
  2298.                   IF ReceiveACK THEN
  2299.                      BEGIN
  2300.                         State := FileData;
  2301.                         NumTry := 0;
  2302.                         n := (n+1) MOD 64;
  2303.                      END
  2304.                END;
  2305.          END;
  2306.    END;
  2307.  
  2308. PROCEDURE SendData;  (* send file data packets *)
  2309.    VAR
  2310.       newstate: KermitStates;
  2311.    BEGIN
  2312.       IF (Land(DataSendCount, #03) = 0) THEN
  2313.         WITH OpenList[DiskFile] DO
  2314.          StreamProgress( FileVar ) ;
  2315.       DataSendCount := DataSendCount + 1 ;  (* next "SendData" *)
  2316.  
  2317.       IF (NumTry > MaxTry) THEN
  2318.          BEGIN
  2319.             State := Abort;       (* too many tries, abort *)
  2320.             ErrorMsg ('Send data - Too many');
  2321.          END
  2322.       ELSE
  2323.          BEGIN
  2324.             NumTry := NumTry+1;
  2325.             GetData(newstate);
  2326.             SendPacket;
  2327.             IF ReceiveACK THEN
  2328.                BEGIN
  2329.                   State := newstate;
  2330.                   NumTry := 0;
  2331.                   n := (n+1) MOD 64;
  2332.                END
  2333.          END;
  2334.    END;
  2335.  
  2336. PROCEDURE SendEOF;    (* send EOF  packet *)
  2337.    BEGIN
  2338.       Verbose ('Sending EOF');
  2339.       IF (NumTry > MaxTry) THEN
  2340.          BEGIN
  2341.             State := Abort;       (* too many tries, abort *)
  2342.             ErrorMsg('Send EOF - Too Many');
  2343.          END
  2344.       ELSE
  2345.          BEGIN
  2346.             NumTry := NumTry+1;
  2347.             IF (NumTry = 1) THEN
  2348.                BEGIN
  2349.                   WITH Buf[ThisPacket] DO
  2350.                      BEGIN
  2351.                         ptype := TYPEZ;
  2352.                         seq := n;
  2353.                         count := 0;
  2354.                      END
  2355.                END;
  2356.             SendPacket;
  2357.             IF ReceiveACK THEN
  2358.                BEGIN
  2359.                   State := FileHeader;
  2360.                   NumTry := 0;
  2361.                   n := (n+1) MOD 64;
  2362.                END
  2363.          END;
  2364.    END;
  2365.  
  2366. PROCEDURE SendBreak; (* send break packet *)
  2367.    BEGIN
  2368.       Verbose ('Sending break');
  2369.       IF (NumTry > MaxTry) THEN
  2370.          BEGIN
  2371.             State := Abort;       (* too many tries, abort *)
  2372.             ErrorMsg('Send break -Too Many');
  2373.          END
  2374.       ELSE
  2375.          BEGIN
  2376.             NumTry := NumTry+1;
  2377.             (* make up packet  *)
  2378.             IF (NumTry = 1) THEN
  2379.                BEGIN
  2380.                   WITH Buf[ThisPacket] DO
  2381.                      BEGIN
  2382.                         ptype := TYPEB;
  2383.                         seq := n;
  2384.                         count := 0;
  2385.                      END
  2386.                END;
  2387.             SendPacket; (* send this packet *)
  2388.             IF ReceiveACK THEN
  2389.                BEGIN
  2390.                   State := Complete;
  2391.                END
  2392.          END;
  2393.    END;
  2394.  
  2395. PROCEDURE SendInit;  (* send init packet *)
  2396.    BEGIN
  2397.       Verbose ('Sending Init');
  2398.       IF (NumTry > MaxTry) THEN
  2399.          BEGIN
  2400.             State := Abort;      (* too many tries, abort *)
  2401.             ErrorMsg('Cannot Initialize');
  2402.          END
  2403.       ELSE
  2404.          BEGIN
  2405.             NumTry := NumTry+1;
  2406.             IF (NumTry = 1) THEN
  2407.                BEGIN
  2408.                   WITH Buf[ThisPacket] DO
  2409.                      BEGIN
  2410.                         EnCodeParm(data);
  2411.                         count := NUMPARAM;
  2412.                         seq := n;
  2413.                         ptype := TYPES;
  2414.                      END
  2415.                END;
  2416.  
  2417.             SendPacket; (* send this packet *)
  2418.             IF ReceiveACK THEN
  2419.                BEGIN
  2420.                   WITH Buf[CurrentPacket] DO
  2421.                      BEGIN
  2422.                         SizeSend := UnChar(data[1]);
  2423.                         TheirTimeOut := UnChar(data[2]);
  2424.                         NumPad := UnChar(data[3]);
  2425.                         PadChar := Ctl(data[4]);
  2426.                         SendEOL := CR;  (* default to CR *)
  2427.                         IF (ilength(data) >= 5) THEN
  2428.                            IF (data[5] <> 0) THEN  SendEOL := UnChar(data[5]);
  2429.                         SendQuote := SHARP;  (* default # *)
  2430.                         IF (ilength(data) >= 6) THEN
  2431.                            IF (data[6] <> 0) THEN  SendQuote := data[6];
  2432.                      END;
  2433.  
  2434.                   State := FileHeader;
  2435.                   NumTry := 0;
  2436.                   n := (n+1) MOD 64;
  2437.                END;
  2438.          END;
  2439.    END;
  2440.  
  2441.  
  2442. PROCEDURE SendSwitch;
  2443.    (* Send-switch is the state table switcher for sending files.
  2444.     * It loops until either it is finished or a fault is encountered.
  2445.     * Routines called by sendswitch are responsible for changing the state.
  2446.     *)
  2447.  
  2448.    HANDLER GotErrorPacket(VAR msg: istring) ;
  2449.       (* We got an error packet when trying to receive another packet. *)
  2450.       (* (possibly an ACK). Write the packet data and exit SEND command *)
  2451.       BEGIN
  2452.          Inverse( TRUE ) ;
  2453.          Writeln ;
  2454.          Writeln('?SEND received an error packet from the other Host') ;
  2455.          putstr(msg, STDOUT) ;
  2456.          Writeln ;
  2457.          Inverse( FALSE ) ;
  2458.          SClose( DiskFile ) ; (* close the disk file if its open *)
  2459.          State := Abort ;
  2460.          EXIT( SendSwitch )
  2461.       END ;
  2462.  
  2463.  
  2464.    BEGIN
  2465.       LoadCurs ; (* Load the progress cursors *)
  2466.       State := Init;              (* send initiate is the start state *)
  2467.       NumTry := 0;                (* say no tries yet *)
  2468.       IF (Delay > 0) THEN Sleep(Delay);
  2469.       REPEAT
  2470.          CASE State OF
  2471.             FileData:     SendData;         (* data-send state *)
  2472.             FileHeader:   SendFile;         (* send file name *)
  2473.             EOFile:       SendEOF;          (* send end-of-file *)
  2474.             Init:         SendInit;         (* send initialize *)
  2475.             Break:        SendBreak;        (* send break *)
  2476.             Complete:     (* nothing *);
  2477.             Abort:        (* nothing *);
  2478.             END (* case *);
  2479.       UNTIL ( (State = Abort) OR (State=Complete) );
  2480.  
  2481.       QuitProgress ;  (* Remove progress cursors *)
  2482.  
  2483.    END.
  2484.  
  2485. (* <<<KermitUtils>>> *)
  2486. MODULE  KermitUtils;
  2487.  
  2488. EXPORTS
  2489.  
  2490. IMPORTS KermitGlobals     FROM KermitGlobals ;
  2491.  
  2492.  
  2493. PROCEDURE StartTimer;
  2494. PROCEDURE CheckTimer ;
  2495. PROCEDURE StopTimer;
  2496. PROCEDURE XmtChar(ch:Char);   (* Perq version -pt*)
  2497. FUNCTION GetIn :CharBytes;    (* get character *)
  2498. FUNCTION UnChar(c:CharBytes): CharBytes;
  2499. FUNCTION MakeChar(c:CharBytes): CharBytes;
  2500. FUNCTION IsControl(c:CharBytes): Boolean;
  2501. FUNCTION IsPrintable(c:CharBytes): Boolean;
  2502. FUNCTION Ctl(c:CharBytes): CharBytes;
  2503. FUNCTION IsValidPType(c:CharBytes): Boolean;
  2504. FUNCTION CheckFunction(c:Integer): CharBytes;
  2505. FUNCTION ilength (VAR s : istring) : Integer;
  2506. FUNCTION GetArgument(VAR arg: istring): Boolean ;
  2507. PROCEDURE EnCodeParm(VAR data:istring);  (* encode parameters *)
  2508. PROCEDURE DeCodeParm(VAR data:istring); (* decode parameters *)
  2509. PROCEDURE Inverse( turn_on: Boolean ) ;
  2510.  
  2511.  
  2512.  
  2513.  
  2514. PRIVATE
  2515.  
  2516.  
  2517.  
  2518. IMPORTS IOErrors        FROM IOErrors ;
  2519. IMPORTS IO_Unit         FROM IO_Unit ;
  2520. IMPORTS IO_Others       FROM IO_Others ;
  2521. IMPORTS CmdParse        FROM CmdParse ;
  2522. IMPORTS Screen          FROM Screen ;
  2523.  
  2524.                                                    {$RANGE-}
  2525.  
  2526. FUNCTION UnChar(c:CharBytes): CharBytes;
  2527.    (* reverse of makechar *)
  2528.    BEGIN
  2529.       UnChar := c - BLANK
  2530.    END;
  2531.  
  2532.  
  2533. FUNCTION MakeChar(c:CharBytes): CharBytes;
  2534.    (* convert integer to printable *)
  2535.    BEGIN
  2536.       MakeChar := c + BLANK
  2537.    END;
  2538.  
  2539. FUNCTION IsControl(c:CharBytes): Boolean;
  2540.    (* true if control *)
  2541.    BEGIN
  2542.       (* Clear the 8th bit *)
  2543.       c := Land( c, #177 ) ;
  2544.       IsControl := (c = DEL) OR (c < BLANK)
  2545.    END;
  2546.  
  2547. FUNCTION IsPrintable(c:CharBytes): Boolean;
  2548.    (* opposite of iscontrol *)
  2549.    BEGIN
  2550.       IsPrintable := NOT IsControl(c)
  2551.    END;
  2552.  
  2553. FUNCTION Ctl(c:CharBytes): CharBytes;
  2554.    (* c XOR 100 *)
  2555.    BEGIN
  2556.       Ctl := LXor(c, #100)
  2557.    END;
  2558.  
  2559. FUNCTION IsValidPType(c:CharBytes): Boolean;
  2560.    (* true if valid packet type *)
  2561.    BEGIN
  2562.       IsValidPType := 
  2563.         c IN [TYPEB, TYPED, TYPEE, TYPEF, TYPEN, TYPES, TYPET, TYPEY, TYPEZ]
  2564.    END;
  2565.  
  2566. FUNCTION CheckFunction(c:Integer): CharBytes;
  2567.    (* calculate checksum *)
  2568.    VAR
  2569.       x: Integer;
  2570.    BEGIN
  2571.       (*   CheckFunction := (c + ( c AND 300 ) /100 ) AND 77; *)
  2572.       x := Shift( Land(c, #300), -6) ;
  2573.       CheckFunction := Land(x+c, #077)
  2574.    END;
  2575.  
  2576. PROCEDURE EnCodeParm((* Updating *) VAR data:istring);  (* encode parameters *)
  2577.    VAR
  2578.       i: Integer;
  2579.    BEGIN
  2580.       FOR i:=1 TO NUMPARAM DO
  2581.          data[i] := BLANK;
  2582.       data[NUMPARAM+1] := ENDSTR;
  2583.       data[1] := MakeChar(SizeRecv);     (* my biggest packet *)
  2584.       data[2] := MakeChar(MyTimeOut);    (* when I want timeout*)
  2585.       data[3] := MakeChar(MyPad);        (* how much padding *)
  2586.       data[4] := Ctl(MyPadChar);         (* my padding character *)
  2587.       data[5] := MakeChar(myEOL);        (* my EOL *)
  2588.       data[6] := MyQuote;                (* my quote char *)
  2589.    END;
  2590.  
  2591. PROCEDURE DeCodeParm(VAR data:istring); (* decode parameters *)
  2592.    BEGIN
  2593.       SizeSend := UnChar(data[1]);
  2594.       TheirTimeOut := UnChar(data[2]);   (* when I should time out *)
  2595.       NumPad := UnChar(data[3]);         (* padding characters to send  *)
  2596.       PadChar := Ctl(data[4]);           (* padding character *)
  2597.       SendEOL := UnChar(data[5]);        (* EOL to send *)
  2598.       SendQuote := data[6];              (* quote to send *)
  2599.    END;
  2600.  
  2601.  
  2602.    { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  2603.    { length -- compute length of string }
  2604. FUNCTION ilength (VAR s : istring) : Integer;
  2605.    VAR
  2606.       n : Integer;
  2607.    BEGIN
  2608.       n := 1;
  2609.       WHILE (s[n] <> ENDSTR) DO
  2610.          n := n + 1;
  2611.       ilength := n - 1
  2612.    END;
  2613.  
  2614.  
  2615.  
  2616. PROCEDURE StartTimer;
  2617.    (* Start the time count, in clock ticks.  -pt*)
  2618.    BEGIN
  2619.       IOGetTime( OldTime ) ; (* Current clock value *)
  2620.       TimeLeft := TheirTimeOut * 60 (* in ticks *)
  2621.    END;
  2622.  
  2623. PROCEDURE CheckTimer ;
  2624.    (* Decrement "TimeLeft" by time between last call and now -pt*)
  2625.    VAR  now: Double ;
  2626.    BEGIN
  2627.       IF (TimeLeft > 0) THEN (* Still counting *)
  2628.          BEGIN
  2629.             IOGetTime( now ) ;
  2630.             TimeLeft := TimeLeft - now[0] + OldTime[0] ;
  2631.             OldTime := now
  2632.          END
  2633.    END ;
  2634.  
  2635. PROCEDURE StopTimer;
  2636.    BEGIN
  2637.       TimeLeft := Maxint;
  2638.    END;
  2639.  
  2640.  
  2641. (*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
  2642.  
  2643.  
  2644. PROCEDURE XmtChar(ch:Char);   (* Perq version -pt*)
  2645.    BEGIN
  2646.       WHILE IOCWrite(RS232Out, ch) <> IOEIOC DO (* nothing *) ;
  2647.    END;
  2648.  
  2649.  
  2650. FUNCTION GetIn :CharBytes;  (* get character *)
  2651.    (* Should return NULL (ENDSTR) if no characters, Perq version -pt*)
  2652.    VAR
  2653.       byte: CharBytes ;
  2654.       c :Char ;
  2655.    BEGIN
  2656.       IF (IOCRead(RS232In, c) = IOEIOC) THEN
  2657.          BEGIN
  2658.             byte := land( Ord(c), #377 ) (* [pgt001] *)
  2659.          END
  2660.       ELSE byte := ENDSTR ;
  2661.       GetIn := byte ;
  2662.       (* ChInPack := ChInPack + 1.0  (@ AddTo( x, 1)  *)
  2663.    END;
  2664.  
  2665.  
  2666. (*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
  2667.  
  2668.  
  2669.    (* Get the next argument from the command line -pt*)
  2670.    (* Return True if an argument is available - returned in "arg" too -pt*)
  2671. FUNCTION GetArgument(VAR arg: istring): Boolean ;
  2672.    VAR
  2673.       return: Boolean ;   (* Return value *)
  2674.       i, len: Integer ;   (* index and argument length *)
  2675.       id: String ;        (* Identifier/argument from the line *)
  2676.    BEGIN (*-GetArgument-*)
  2677.       dumCh := NextIDString( CmdLine, id, return ) ; (* Get an identifier *)
  2678.       IF (id = '') THEN return := False (* nothing *)
  2679.       ELSE
  2680.          BEGIN
  2681.             return := True ;       (* Success *)
  2682.             len := Length( id ) ;  (* get the string's length *)
  2683.             FOR i := 1 TO len DO   (* put the string in "arg" *)
  2684.                arg[i] := Ord( id[i] ) ;
  2685.             arg[len+1] := ENDSTR   (* finish it off *)
  2686.          END ;
  2687.       GetArgument := return
  2688.    END ; (*-GetArgument-*)
  2689.  
  2690. PROCEDURE Inverse( turn_on: Boolean ) ;
  2691.   (* Change chrsor function for inverse video *)
  2692.   BEGIN  (*-Inverse-*)
  2693.      IF turn_on THEN SChrFunc( RNot )
  2694.      ELSE  SChrFunc( RRpl )
  2695.   END    (*-Inverse-*).
  2696.  
  2697. (* <<<Stdio.Pas>>> *)
  2698. MODULE STDIO ;
  2699. (* Standard text file I/O *)
  2700. (* from Kernighan + Plauger *)
  2701. (* 29-Nov-83  Allow eight bit file transfer [pgt001] *)
  2702. (*            This forces us to make the end of (data) string value -1 *)
  2703. (*            and end of file value -2 because byte values can be 0..255 *)
  2704.  
  2705.  
  2706. EXPORTS
  2707.  
  2708. IMPORTS  KermitGlobals         FROM KermitGlobals ;
  2709.  
  2710. CONST
  2711.    { standard file descriptors. subscripts in open, etc. }
  2712.    STDIN = 1;              { these are not to be changed }
  2713.    STDOUT = 2;
  2714.    STDERR = 3;
  2715.    lineout = 4;
  2716.    linein = 5;
  2717.    FirstUserFile = STDERR ; (* First index available for user's files -pt*)
  2718.  
  2719.    { other io-related stuff }
  2720.    StdIOError = 0;    { status values for open files }
  2721.    StdIOAvail = 1;
  2722.    StdIORead = 2;
  2723.    StdIOWrite = 3;
  2724.    StdIO8Read = 4 ;  (* [pgt001] *)
  2725.    StdIO8Write = 5 ;  (* [pgt001] *)
  2726.    MAXOPEN = 15;   { maximum number of open files }
  2727.  
  2728.    { universal manifest constants }
  2729.    ENDFILE = ENDSTR - 1;  (* [pgt001] *)
  2730.  
  2731. TYPE
  2732.    filedesc = StdIOError..MAXOPEN;
  2733.    ioblock = RECORD        { to keep track of open files }
  2734.                 filevar : Text;
  2735.                 mode : StdIOError..StdIO8Write;
  2736.              END;
  2737.  
  2738. VAR
  2739.    openlist : ARRAY [1..MAXOPEN] OF ioblock; { open files }
  2740.  
  2741. PROCEDURE StdIOInit;
  2742. PROCEDURE putch (c : CharBytes);
  2743. PROCEDURE putcf (c : CharBytes; fd : filedesc);
  2744. PROCEDURE putstr (VAR s : istring; f : filedesc);
  2745. FUNCTION getch (VAR c : CharBytes) : CharBytes;
  2746. FUNCTION getcf (VAR c: CharBytes; fd : filedesc) : CharBytes;
  2747. FUNCTION getline (VAR s : istring; fd : filedesc;
  2748.                   maxsize : Integer) : Boolean;
  2749.  
  2750. FUNCTION Sopen (name : istring; mode :   Integer) : filedesc;
  2751. PROCEDURE Sclose (fd : filedesc);
  2752. FUNCTION Exists(s:istring): Boolean;
  2753.  
  2754. PRIVATE
  2755.  
  2756.  
  2757. IMPORTS  Perq_string    FROM Perq_String ;
  2758. IMPORTS  Stream         FROM Stream ;
  2759. IMPORTS  FileSystem     FROM FileSystem ;
  2760.  
  2761.  
  2762.    { StdIOInit  -- initialize open file list }
  2763. PROCEDURE StdIOInit;
  2764.    VAR
  2765.       i :     filedesc;
  2766.    BEGIN
  2767.       openlist[STDIN].mode := StdIORead;
  2768.       openlist[STDOUT].mode := StdIOWrite;
  2769.       { initialize rest of files      }
  2770.       FOR i := FirstUserFile TO MAXOPEN DO
  2771.          openlist[i].mode := StdIOAvail;
  2772.  
  2773.    END;
  2774.  
  2775.  
  2776.    { getc (UCB) -- get one character from standard input }
  2777. FUNCTION getch (VAR c : CharBytes) : CharBytes;
  2778.    VAR
  2779.       ch : Char;
  2780.    BEGIN
  2781.       IF Eof THEN c := ENDFILE
  2782.       ELSE
  2783.          IF Eoln THEN
  2784.             BEGIN
  2785.                Readln;
  2786.                c := LF
  2787.             END
  2788.          ELSE
  2789.             BEGIN
  2790.                Read(ch);
  2791.                c := Ord(ch)
  2792.             END;
  2793.       getch := c
  2794.    END;
  2795.  
  2796.    { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  2797.    { getcf (UCB) -- get one character from file }
  2798. FUNCTION getcf (VAR c: CharBytes; fd : filedesc) : CharBytes;
  2799.    VAR
  2800.       ch : Char;
  2801.    BEGIN
  2802.     WITH  openlist[fd]  DO   (* [pgt001] *)
  2803.       IF (fd = STDIN) THEN getcf := getch(c)
  2804.       ELSE
  2805.          IF Eof(filevar) THEN  c := ENDFILE
  2806.          ELSE
  2807.            IF (mode = StdIO8Read) THEN (* [pgt001] *)
  2808.               BEGIN
  2809.                  c := Ord( filevar^ ) ;
  2810.                  Get( filevar )
  2811.               END                      (* [pgt001] *)
  2812.            ELSE
  2813.             IF Eoln(filevar) THEN
  2814.                BEGIN
  2815.                   Readln(filevar);
  2816.                   c := LF
  2817.                END
  2818.             ELSE
  2819.                BEGIN
  2820.                   Read(filevar, ch);
  2821.                   c := Ord(ch)
  2822.                END;
  2823.       getcf := c
  2824.    END;
  2825.  
  2826.    { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  2827.    { getline (UCB) -- get a line from file }
  2828. FUNCTION getline (VAR s : istring; fd : filedesc;
  2829.                   maxsize : Integer) : Boolean;
  2830.    VAR
  2831.       i : Integer;
  2832.       c : CharBytes;
  2833.    BEGIN
  2834.       {$RANGE-}
  2835.       i := 1;
  2836.       REPEAT
  2837.          s[i] := getcf(c, fd);
  2838.          i := i + 1
  2839.       UNTIL (c = ENDFILE) OR (c = LF) OR (i >= maxsize);
  2840.       IF (c = ENDFILE) THEN i := i - 1 ;      { went one too far }
  2841.       s[i] := ENDSTR;
  2842.       getline := (c <> ENDFILE)
  2843.       {$RANGE+}
  2844.    END;
  2845.  
  2846.    { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  2847.    { putch (UCB) -- put one character on standard output }
  2848. PROCEDURE putch (c : CharBytes);
  2849.    BEGIN
  2850.       IF (c = LF) THEN Writeln
  2851.       ELSE Write(Chr(c))
  2852.    END;
  2853.  
  2854.    { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  2855.    { putcf (UCB) -- put a single character on file fd }
  2856. PROCEDURE putcf (c : CharBytes; fd : filedesc);
  2857.    CONST
  2858.       NUL = 0 ;
  2859.    BEGIN
  2860.     WITH  openlist[fd]  DO
  2861.       IF (fd = STDOUT) THEN putch(c)
  2862.       ELSE
  2863.        IF (mode = StdIO8Write) THEN (* [pgt001] *)
  2864.           BEGIN
  2865.              filevar^ := Chr(c) ;
  2866.              Put( filevar )
  2867.           END
  2868.        ELSE
  2869.          BEGIN  (* Normal text file [pgt001]*)
  2870.            c := Land(c, #177) ;    
  2871.            IF (c = LF) THEN   Writeln(filevar)
  2872.            ELSE
  2873.              IF (c = CR) OR (c = NUL) THEN (* ignore *)
  2874.              ELSE
  2875.               Write(filevar, Chr( c ))
  2876.          END ;
  2877.    END;
  2878.  
  2879.    { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  2880.    { putstr (UCB) -- put out string on file }
  2881. PROCEDURE putstr (VAR s : istring; f : filedesc);
  2882.    VAR
  2883.       i : Integer;
  2884.    BEGIN
  2885.       {$RANGE-}
  2886.       i := 1;
  2887.       WHILE (s[i] <> ENDSTR) DO
  2888.          BEGIN
  2889.             putcf(s[i], f);
  2890.             i := i + 1
  2891.          END
  2892.       {$RANGE+}
  2893.    END;
  2894.  
  2895.  
  2896.    { MakeString -- Convert an istring into a Perq String variable -pt }
  2897. PROCEDURE MakeString(src: istring; VAR dest: String) ;
  2898.    VAR
  2899.       i: Integer ;
  2900.    BEGIN (*-MakeString-*)
  2901.       i := 1 ;
  2902.       {$RANGE- Checks off because Length(dest) undefined at the moment -pt}
  2903.       WHILE (src[i] <> ENDSTR) AND (src[i] <> LF) DO
  2904.          BEGIN
  2905.             dest[i] := Chr(src[i]) ;
  2906.             i := i + 1
  2907.          END ;
  2908.       {$RANGE+  Checks back on -pt}
  2909.       Adjust(dest, i-1)   (* Set the dynamic length -pt*)
  2910.    END ; (*-MakeString-*)
  2911.  
  2912.    { open  -- open a file for reading or writing.   Perq version -pt}
  2913. FUNCTION Sopen (name : istring; mode :   Integer) : filedesc;
  2914.    VAR
  2915.       i :     Integer;
  2916.       filename : String ;
  2917.       found : Boolean;
  2918.  
  2919.       (* Reset and Rewrite error handlers. Both set "sopen" to IOERROR   -pt*)
  2920.       (* This means we set inital value of "sopen" before reset/rewrite  -pt*)
  2921.    HANDLER ResetError(filnam: PathName) ;
  2922.       BEGIN
  2923.          sopen := StdIOError
  2924.       END ;
  2925.    HANDLER RewriteError(filnam: PathName) ;
  2926.       BEGIN
  2927.          sopen := StdIOError
  2928.       END ;
  2929.  
  2930.    BEGIN
  2931.       MakeString(name, filename) ; (* Convert to Perq string -pt*)
  2932.       { find a free slot in openlist }
  2933.       Sopen := StdIOError;
  2934.       found := False;
  2935.       i := 1;
  2936.       WHILE (i <= MAXOPEN) AND (NOT found) DO
  2937.          BEGIN
  2938.             IF (openlist[i].mode = StdIOAvail) THEN
  2939.                BEGIN
  2940.                   openlist[i].mode := mode ;
  2941.                   Sopen := i;  (* Here so file handlers can reset value -pt*)
  2942.                   IF (mode = StdIORead) OR (mode = StdIO8Read) THEN
  2943.                      Reset(openlist[i].filevar, filename)  (* [pgt001] *)
  2944.                   ELSE
  2945.                      Rewrite(openlist[i].filevar, filename);
  2946.                   found := True
  2947.                END;
  2948.             i := i + 1
  2949.          END
  2950.    END;
  2951.  
  2952. PROCEDURE Sclose (fd : filedesc);
  2953.    BEGIN
  2954.       IF (fd >= FirstUserFile) AND (fd <= MAXOPEN) THEN
  2955.          BEGIN
  2956.             openlist[fd].mode := StdIOAvail;
  2957.             close(openlist[fd].filevar);
  2958.          END
  2959.    END;
  2960.  
  2961.  
  2962. FUNCTION Exists(s:istring): Boolean;
  2963.    (* returns true if file exists. Perq version -pt*)
  2964.    VAR
  2965.       name: String ;
  2966.       file_id, blocks, bits: Integer ;
  2967.    BEGIN        (*-Exists-*)
  2968.       (* Be quick and use a look-up; better than open/close sequence  -pt*)
  2969.       MakeString(s, name) ;        (* Get the file name as a Perq string *)
  2970.       file_id := FSLookUp(name, blocks, bits) ; (* Do the look-up *)
  2971.       Exists := (file_id <> 0)     (* Zero means it does not exist *)
  2972.    END.         (*-Exists-*)
  2973.