home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / pibterm / pibt41s1.arc / DOCISBB.MOD < prev    next >
Text File  |  1988-03-23  |  53KB  |  1,627 lines
  1. (*----------------------------------------------------------------------*)
  2. (*   CISB_DLE_Seen --- Handle DLE character seen -- Main CISB B routine *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE CISB_DLE_Seen;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*  CISB_DLE_Seen is called from the main program when the character    *)
  10. (*  <DLE> is received from the host.                                    *)
  11. (*                                                                      *)
  12. (*  This routine calls Read_Packet and dispatches to the appropriate    *)
  13. (*  handler for the incoming packet.                                    *)
  14. (*                                                                      *)
  15. (*----------------------------------------------------------------------*)
  16.  
  17. CONST
  18.    Max_Buf_Size  = 1032            (* Largest data block we can handle  *);
  19.    Max_SA        = 2               (* Maximum number of waiting packets *);
  20.  
  21.    Def_Buf_Size  = 511             (* Default data block                *);
  22.    Def_WS        = 1               (* I can send 2 packets ahead        *);
  23.    Def_WR        = 1               (* I can receive single send-ahead   *);
  24.    Def_BS        = 8               (* I can handle 1024 bytes           *);
  25.    Def_CM        = 1               (* I can handle CRC                  *);
  26.    Def_DQ        = 1               (* I can handle non-quoted NUL       *);
  27.  
  28.    Max_Errors    =  10             (* Maximum errors allowed per block *);
  29.  
  30.                    (* Receive States *)
  31.  
  32.    R_Get_DLE      = 0;
  33.    R_Get_B        = 1;
  34.    R_Get_Seq      = 2;
  35.    R_Get_Data     = 3;
  36.    R_Get_CheckSum = 4;
  37.    R_Send_ACK     = 5;
  38.    R_Timed_Out    = 6;
  39.    R_Success      = 7;
  40.  
  41.                    (* Send States *)
  42.  
  43.    S_Get_DLE      = 1;
  44.    S_Get_Num      = 2;
  45.    S_Get_Packet   = 3;
  46.    S_Timed_Out    = 4;
  47.    S_Send_NAK     = 5;
  48.    S_Send_Data    = 6;
  49.  
  50.                    (* Table of control characters that need to be masked *)
  51.  
  52.    Mask_Table : ARRAY[ 0..31 ] OF BYTE = (
  53.                 0, 0, 0, 1, 0, 1, 0, 0,   { NUL SOH SOB ETX EOT ENQ SYN BEL }
  54.                 0, 0, 0, 0, 0, 0, 0, 0,   { BS  HT  LF  VT  FF  CR  SO  SI  }
  55.                 1, 1, 0, 1, 0, 1, 0, 0,   { DLE DC1 DC2 DC3 DC4 NAK ^V  ^W  }
  56.                 0, 0, 0, 0, 0, 0, 0, 0    { CAN ^Y  ^Z  ESC ?   ?   ?   ?   }
  57.                                          );
  58.  
  59. TYPE
  60.    BufferType = ARRAY[ 0..Max_Buf_Size ] OF BYTE;
  61.  
  62.    Buf_Type   = RECORD
  63.                    Seq : INTEGER    (* Packet's sequence number  *);
  64.                    Num : INTEGER    (* Number of bytes in packet *);
  65.                    Buf : BufferType (* Actual packet data        *);
  66.                 END;
  67.  
  68. VAR
  69.    Timer           : INTEGER       (* Wait time for character to appear *);
  70.    R_Size          : INTEGER       (* Size of receiver buffer *);
  71.    Ch              : INTEGER       (* Current character *);
  72.    Save_Xon_Xoff   : BOOLEAN       (* Save current XON/XOFF status *);
  73.  
  74.    Timed_Out       : BOOLEAN       (* We timed out before receiving character *);
  75.    Masked          : BOOLEAN       (* TRUE if ctrl character was 'masked' *);
  76.  
  77.                                    (* Send-ahead buffers *)
  78.  
  79.    SA_Buf          : ARRAY[ 0..Max_SA ] OF Buf_Type ABSOLUTE Sector_Data;
  80.  
  81.    SA_Next_to_ACK  : INTEGER       (* Which SA_Buf is waiting for an ACK *);
  82.    SA_Next_to_Fill : INTEGER       (* Which SA_Buf is ready for new data *);
  83.    SA_Waiting      : INTEGER       (* Number of SA_Buf's waiting for ACK *);
  84.  
  85.                                    (* File buffer *)
  86.  
  87.    R_Buffer        : BufferType;
  88.  
  89.    FileName        : AnyStr        (* Name of file sent/received *);
  90.  
  91.    I               : INTEGER;
  92.    N               : INTEGER;
  93.    Dummy           : BOOLEAN;
  94.  
  95. LABEL
  96.    Error_Exit;
  97.  
  98. (*----------------------------------------------------------------------*)
  99. (*   Send_Masked_Byte -- Send character with possible <DLE> masking     *)
  100. (*----------------------------------------------------------------------*)
  101.  
  102. PROCEDURE Send_Masked_Byte( Ch : INTEGER );
  103.  
  104. BEGIN (* Send_Masked_Byte *)
  105.  
  106.    Ch := Ch AND $FF;
  107.                                    (* If character is control character,   *)
  108.                                    (* and is in table of characters to     *)
  109.                                    (* mask, then send <DLE><Ch+31> instead *)
  110.                                    (* of character itself.                 *)
  111.  
  112.    IF ( Ch < 32 ) THEN
  113.       IF ( Mask_Table[Ch] <> 0 ) THEN
  114.          BEGIN
  115.             Async_Send( CHR( DLE ) );
  116.             Async_Send( CHR( Ch + ORD('@') ) );
  117.          END
  118.       ELSE
  119.          Async_Send( CHR( Ch ) )
  120.    ELSE
  121.       Async_Send( CHR( Ch ) );
  122.  
  123. END   (* Send_Masked_Byte *);
  124.  
  125. (*----------------------------------------------------------------------*)
  126. (*                Send_ACK -- Send acknowledgement to host              *)
  127. (*----------------------------------------------------------------------*)
  128.  
  129. PROCEDURE Send_ACK;
  130.  
  131. BEGIN (* Send_ACK *)
  132.  
  133.    Async_Send( CHR( DLE ) );
  134.    Async_Send( CHR( Seq_Num + ORD('0') ) );
  135.  
  136.    Update_B_Display;
  137.  
  138. END   (* Send_ACK *);
  139.  
  140. (*----------------------------------------------------------------------*)
  141. (*       Send_NAK --- Send negative acknowledge for block to host       *)
  142. (*----------------------------------------------------------------------*)
  143.  
  144. PROCEDURE Send_NAK;
  145.  
  146. BEGIN (* Send_NAK *)
  147.  
  148.    Display_Message_With_Number( 'Sending NAK for block ', Total_Blocks );
  149.  
  150.    Async_Send( CHR( NAK ) );
  151.  
  152.    Update_B_Display;
  153.  
  154. END   (* Send_NAK *);
  155.  
  156. (*----------------------------------------------------------------------*)
  157. (*                 Send_ENQ --- Send ENQ to host                        *)
  158. (*----------------------------------------------------------------------*)
  159.  
  160. PROCEDURE Send_ENQ;
  161.  
  162. BEGIN (* Send_ENQ *)
  163.  
  164.    Async_Send( CHR( ENQ ) );
  165.  
  166. END   (* Send_ENQ *);
  167.  
  168. (*----------------------------------------------------------------------*)
  169. (*     Read_Byte --- Read one character from serial port with timer     *)
  170. (*----------------------------------------------------------------------*)
  171.  
  172. FUNCTION Read_Byte : BOOLEAN;
  173.  
  174. VAR
  175.    I: INTEGER;
  176.  
  177. BEGIN (* Read_Byte *)
  178.  
  179.    I := 0;
  180.  
  181.    REPEAT
  182.       INC( I );
  183.       Async_Receive_With_Timeout( 1 , Ch );
  184.       Check_Keyboard;
  185.    UNTIL ( I > Timer ) OR ( Ch <> TimeOut ) OR Halt_Transfer;
  186.  
  187.    Timed_Out := ( Ch = TimeOut ) OR ( I > Timer );
  188.  
  189.    Read_Byte := ( NOT Timed_Out     ) AND
  190.                 ( NOT Halt_Transfer );
  191.  
  192. END   (* Read_Byte *);
  193.  
  194. (*----------------------------------------------------------------------*)
  195. (*     Read_Masked_Byte --- Read possibly masked character from port    *)
  196. (*----------------------------------------------------------------------*)
  197.  
  198. FUNCTION Read_Masked_Byte : BOOLEAN;
  199.  
  200. BEGIN (* Read_Masked_Byte *)
  201.  
  202.    Masked := FALSE;
  203.  
  204.    IF ( NOT Read_Byte ) THEN
  205.       BEGIN
  206.          Read_Masked_Byte := FALSE;
  207.          EXIT;
  208.       END;
  209.                                    (* Check for <DLE> -- indicates   *)
  210.                                    (* following character is masked. *)
  211.    IF ( Ch = DLE ) THEN
  212.      BEGIN
  213.  
  214.          IF ( NOT Read_Byte ) THEN
  215.             BEGIN
  216.                Read_Masked_Byte := FALSE;
  217.                EXIT;
  218.             END;
  219.  
  220.          Ch := Ch AND $1F;
  221.  
  222.          Masked := TRUE;
  223.  
  224.       END;
  225.  
  226.    Read_Masked_Byte := TRUE;
  227.  
  228. END   (* Read_Masked_Byte *);
  229.  
  230. (*----------------------------------------------------------------------*)
  231. (*                 Incr_Seq --- Increment block sequence number         *)
  232. (*----------------------------------------------------------------------*)
  233.  
  234. FUNCTION Incr_Seq( Value : INTEGER ) : INTEGER;
  235.  
  236. BEGIN (* Incr_Seq *)
  237.  
  238.    IF ( Value = 9 ) THEN
  239.       Incr_Seq := 0
  240.    ELSE
  241.       Incr_Seq := SUCC( Value );
  242.  
  243. END   (* Incr_Seq *);
  244.  
  245. (*----------------------------------------------------------------------*)
  246. (*              Send_Failure -- Send failure code to host               *)
  247. (*----------------------------------------------------------------------*)
  248.  
  249. PROCEDURE Send_Failure( Code : CHAR );
  250.    FORWARD;
  251.  
  252. (*----------------------------------------------------------------------*)
  253. (*               Read_Packet --- Read packet from host                  *)
  254. (*----------------------------------------------------------------------*)
  255.  
  256. FUNCTION Read_Packet( Lead_In_Seen     : BOOLEAN;
  257.                       From_Send_Packet : BOOLEAN ) : BOOLEAN;
  258.  
  259. (*----------------------------------------------------------------------*)
  260. (*                                                                      *)
  261. (*   Lead_In_Seen is TRUE if the <DLE><B> has been seen already.        *)
  262. (*                                                                      *)
  263. (*   From_Send_Packet is TRUE if called from Send_Packet                *)
  264. (*   (causes exit on first error detected)                              *)
  265. (*                                                                      *)
  266. (*   Returns True if packet is available from host.                     *)
  267. (*                                                                      *)
  268. (*----------------------------------------------------------------------*)
  269.  
  270. VAR
  271.    State      : INTEGER;
  272.    Next_Seq   : INTEGER;
  273.    Block_Num  : INTEGER;
  274.    Errors     : INTEGER;
  275.    New_Cks    : INTEGER;
  276.    I          : INTEGER;
  277.  
  278.    NAK_Sent   : BOOLEAN;
  279.    Do_Exit    : BOOLEAN;
  280.    Got_Packet : BOOLEAN;
  281.  
  282. (*----------------------------------------------------------------------*)
  283.  
  284. PROCEDURE Do_R_Get_DLE;
  285.  
  286. BEGIN (* Do_R_Get_DLE *)
  287.  
  288.    IF Halt_Transfer THEN
  289.       BEGIN
  290.          Display_Message('Transfer terminated by keyboard request.',
  291.                          Err_Mess_Line);
  292.          Send_Failure( 'A' );
  293.          Got_Packet := FALSE;
  294.          Do_Exit    := TRUE;
  295.       END
  296.    ELSE
  297.       IF ( NOT Read_Byte ) THEN
  298.          State := R_Timed_Out
  299.       ELSE IF ( ( Ch AND $7F ) = DLE ) THEN
  300.          State := R_Get_B
  301.       ELSE IF ( ( Ch AND $7F ) = ENQ ) THEN
  302.          State := R_Send_ACK;
  303.  
  304. END   (* Do_R_Get_DLE *);
  305.  
  306. (*----------------------------------------------------------------------*)
  307.  
  308. PROCEDURE Do_R_Get_B;
  309.  
  310. BEGIN (* Do_R_Get_B *)
  311.  
  312. {
  313. IF Debug_Mode THEN
  314.    Write_Log('   R_Get_B State', FALSE, FALSE );
  315. }
  316.    IF ( NOT Read_Byte ) THEN
  317.       State := R_Timed_Out
  318.    ELSE IF ( ( Ch AND $7F ) = ORD('B') ) THEN
  319.       State := R_Get_Seq
  320.    ELSE IF ( Ch = ENQ ) THEN
  321.       State := R_Send_ACK
  322.    ELSE
  323.       State := R_Get_DLE;
  324.  
  325. END   (* Do_R_Get_B *);
  326.  
  327. (*----------------------------------------------------------------------*)
  328.  
  329. PROCEDURE Do_R_Get_Seq;
  330.  
  331. BEGIN (* Do_R_Get_Seq *)
  332. {
  333. IF Debug_Mode THEN
  334.    Write_Log('   R_Get_Seq State', FALSE, FALSE );
  335. }
  336.    IF ( NOT Read_Byte ) THEN
  337.       State := R_Timed_Out
  338.    ELSE IF ( Ch = ENQ ) THEN
  339.       State := R_Send_ACK
  340.    ELSE
  341.       BEGIN
  342.  
  343.          IF ( Quick_B AND Use_CRC ) THEN
  344.             CheckSum := -1
  345.          ELSE
  346.             CheckSum := 0;
  347.  
  348.          Block_Num := Ch - ORD('0');
  349.  
  350.          Do_CheckSum( Ch );
  351.  
  352.          I     := 0;
  353.          State := R_Get_Data;
  354.  
  355.       END;
  356.  
  357. END   (* Do_R_Get_Seq *);
  358.  
  359. (*----------------------------------------------------------------------*)
  360.  
  361. PROCEDURE Do_R_Get_Data;
  362.  
  363. BEGIN (* Do_R_Get_Data *)
  364. {
  365. IF Debug_Mode THEN
  366.    Write_Log('   R_Get_Data State', FALSE, FALSE );
  367. }
  368.    IF ( NOT Read_Masked_Byte ) THEN
  369.       State := R_Timed_Out
  370.    ELSE IF ( ( Ch = ETX ) AND ( NOT Masked ) ) THEN
  371.       BEGIN
  372.          Do_CheckSum( ETX );
  373.          State := R_Get_CheckSum;
  374.       END
  375.    ELSE
  376.       BEGIN
  377.          R_Buffer[ I ] := Ch;
  378.          INC( I );
  379.          Do_CheckSum( Ch );
  380.       END;
  381.  
  382. END   (* Do_R_Get_Data *);
  383.  
  384. (*----------------------------------------------------------------------*)
  385.  
  386. PROCEDURE Do_R_Get_CheckSum;
  387.  
  388. BEGIN (* Do_R_Get_CheckSum *)
  389. {
  390. IF Debug_Mode THEN
  391.    Write_Log('   R_Get_CheckSum State', FALSE, FALSE );
  392. }
  393.    IF ( NOT Read_Masked_Byte ) THEN
  394.       State := R_Timed_Out
  395.    ELSE
  396.       BEGIN
  397.  
  398.          IF ( Quick_B AND Use_CRC ) THEN
  399.             BEGIN
  400.  
  401.                CheckSum := SWAP( CheckSum ) XOR Ch;
  402.                CheckSum := CheckSum XOR ( LO( CheckSum ) SHR 4 );
  403.                CheckSum := CheckSum XOR ( SWAP( LO( CheckSum ) ) SHL 4 ) XOR
  404.                                         ( LO( CheckSum ) SHL 5 );
  405.  
  406.                IF ( NOT Read_Masked_Byte ) THEN
  407.                   New_Cks := CheckSum XOR $FF
  408.                ELSE
  409.                   BEGIN
  410.                      CheckSum := SWAP( CheckSum ) XOR Ch;
  411.                      CheckSum := CheckSum XOR ( LO( CheckSum ) SHR 4 );
  412.                      CheckSum := CheckSum XOR ( SWAP( LO( CheckSum ) ) SHL 4 ) XOR
  413.                                               ( LO( CheckSum ) SHL 5 );
  414.                      New_Cks  := 0;
  415.                   END;
  416.  
  417.             END
  418.          ELSE
  419.             New_Cks := Ch;
  420.  
  421.          IF ( New_Cks <> CheckSum ) THEN
  422.             State := R_Timed_Out
  423.                                    (* Watch for failure packet *)
  424.                                    (* which is always accepted *)
  425.  
  426.          ELSE IF ( R_Buffer[0] = ORD('F') ) THEN
  427.             State := R_Success
  428.                                    (* Watch for duplicate block *)
  429.  
  430.          ELSE IF ( Block_Num = Seq_Num ) THEN
  431.             State := R_Success
  432.  
  433.                                    (* Watch for bad sequence number *)
  434.  
  435.          ELSE IF ( Block_Num <> Next_Seq ) THEN
  436.             State := R_Timed_Out
  437.  
  438.          ELSE
  439.             State := R_Success;
  440.  
  441.       END;
  442.  
  443. END   (* Do_R_Get_CheckSum *);
  444.  
  445. (*----------------------------------------------------------------------*)
  446.  
  447. PROCEDURE Do_R_Timed_Out;
  448.  
  449. BEGIN (* Do_R_Timed_Out *)
  450. {
  451. IF Debug_Mode THEN
  452.    Write_Log('   R_Timed_Out State', FALSE, FALSE );
  453. }
  454.    INC( Errors );
  455.  
  456.    IF ( ( Errors > Max_Errors ) OR From_Send_Packet ) THEN
  457.       BEGIN
  458.          Got_Packet  := FALSE;
  459.          Do_Exit     := TRUE;
  460.       END
  461.    ELSE
  462.       BEGIN
  463.  
  464.          IF ( NOT NAK_Sent ) THEN
  465.             BEGIN
  466.                NAK_Sent := TRUE;
  467.                Send_NAK;
  468.             END;
  469.  
  470.          IF From_Send_Packet THEN
  471.             BEGIN
  472.                Got_Packet := FALSE;
  473.                Do_Exit    := TRUE;
  474.             END
  475.          ELSE
  476.             State := R_Get_DLE;
  477.  
  478.       END;
  479.  
  480. END   (* Do_R_Timed_Out *);
  481.  
  482. (*----------------------------------------------------------------------*)
  483.  
  484. PROCEDURE Do_R_Send_ACK;
  485.  
  486. BEGIN (* Do_R_Send_ACK *)
  487. {
  488. IF Debug_Mode THEN
  489.    Write_Log('   R_Send_ACK State', FALSE, FALSE );
  490. }
  491.    Send_ACK;
  492.  
  493.    NAK_Sent := FALSE;              (* Start with clean slate  *)
  494.    State    := R_Get_DLE;          (* wait for the next block *)
  495.  
  496. END   (* Do_R_Send_ACK *);
  497.  
  498. (*----------------------------------------------------------------------*)
  499.  
  500. PROCEDURE Do_R_Success;
  501.  
  502. BEGIN (* Do_R_Success *)
  503. {
  504. IF Debug_Mode THEN
  505.    Write_Log('   R_Success State', FALSE, FALSE );
  506. }
  507.    Seq_Num     := Block_Num;
  508.    R_Size      := I;
  509.    Got_Packet  := TRUE;
  510.  
  511. END   (* Do_R_Success *);
  512.  
  513. (*----------------------------------------------------------------------*)
  514.  
  515. BEGIN (* Read_Packet *)
  516.                                    (* No packet received yet *)
  517.    Got_Packet := FALSE;
  518.                                    (* Fill received packet with 0s *)
  519.  
  520.    FillChar( R_Buffer, Buffer_Size, 0 );
  521.  
  522.                                    (* Get sequence number of next packet *)
  523.  
  524.    Next_Seq := SUCC( Seq_Num ) MOD 10;
  525.  
  526.                                    (* No errors yet *)
  527.    Errors   := 0;
  528.                                    (* No NAK sent yet *)
  529.    NAK_Sent := FALSE;
  530.                                    (* Increment packets received count *)
  531.    INC( Total_Packets );
  532.                                    (* Get starting state *)
  533.    IF Lead_In_Seen THEN
  534.       State := R_Get_Seq
  535.    ELSE
  536.       State := R_Get_DLE;
  537.                                    (* Get the packet! *)
  538.    Do_Exit := FALSE;
  539.  
  540.    WHILE ( NOT ( Halt_Transfer OR Got_Packet OR Do_Exit ) )  DO
  541.       BEGIN
  542.                                    (* Set long timer *)
  543.          Timer := 300;
  544.                                    (* Check keyboard input *)
  545.          Check_KeyBoard;
  546.  
  547.          CASE State OF
  548.  
  549.             R_Get_DLE      : Do_R_Get_DLE      (* Look for leading DLE     *);
  550.             R_Get_B        : Do_R_Get_B        (* Look for 'B' packet type *);
  551.             R_Get_Seq      : Do_R_Get_Seq      (* Get sequence number      *);
  552.             R_Get_Data     : Do_R_Get_Data     (* Get data                 *);
  553.             R_Get_CheckSum : Do_R_Get_CheckSum (* Get checksum/CRC         *);
  554.             R_Timed_Out    : Do_R_Timed_Out    (* Handle time out          *);
  555.             R_Send_ACK     : Do_R_Send_ACK     (* Send ACK                 *);
  556.             R_Success      : Do_R_Success      (* Handle received OK       *);
  557.  
  558.          END (* CASE *);
  559.  
  560.       END (* WHILE *);
  561.  
  562.    Read_Packet := Got_Packet AND ( NOT Halt_Transfer );
  563.  
  564. END   (* Read_Packet *);
  565.  
  566. (*----------------------------------------------------------------------*)
  567. (*           Send_Data --- Send buffer-full of data to host             *)
  568. (*----------------------------------------------------------------------*)
  569.  
  570. PROCEDURE Send_Data( Buffer_Number : INTEGER );
  571.  
  572. VAR
  573.    I : INTEGER;
  574.  
  575. BEGIN (* Send_Data *)
  576.                                    (* Choose send-ahead buffer *)
  577.  
  578.    WITH SA_Buf[ Buffer_Number ] DO
  579.       BEGIN
  580.                                    (* Initialize checksum *)
  581.  
  582.          IF ( Quick_B AND Use_CRC ) THEN
  583.             CheckSum := -1
  584.          ELSE
  585.             CheckSum := 0;
  586.                                    (* Send <DLE>B to start packet *)
  587.  
  588.          Async_Send( CHR( DLE ) );
  589.          Async_Send( 'B' );
  590.                                    (* Send sequence number of packet *)
  591.  
  592.          Async_Send( CHR( Seq + ORD('0') ) );
  593.  
  594.          Do_CheckSum( Seq + ORD('0') );
  595.  
  596.                                    (* Send data and get checksum/CRC *)
  597.          FOR I := 0 TO Num DO
  598.             BEGIN
  599.                Send_Masked_Byte( Buf[ I ] );
  600.                Do_CheckSum( Buf[ I ] );
  601.             END;
  602.                                    (* Send ETX to mark end of data *)
  603.  
  604.          Async_Send ( CHR( ETX ) );
  605.  
  606.          Do_CheckSum( ETX );
  607.                                    (* Send Checksum or CRC *)
  608.  
  609.          IF ( Quick_B AND Use_CRC ) THEN
  610.             Send_Masked_Byte( CheckSum SHR 8 );
  611.  
  612.          Send_Masked_Byte( CheckSum );
  613.  
  614.       END;
  615.  
  616. END   (* Send_Data *);
  617.  
  618. (*----------------------------------------------------------------------*)
  619. (*           Incr_SA --- Increment send ahead slot number               *)
  620. (*----------------------------------------------------------------------*)
  621.  
  622. FUNCTION Incr_SA( Old_Value : INTEGER ) : INTEGER;
  623.  
  624. BEGIN (* Incr_SA *)
  625.  
  626.    IF ( Old_Value = Max_SA ) THEN
  627.       Incr_SA := 0
  628.    ELSE
  629.       Incr_SA := SUCC( Old_Value );
  630.  
  631. END   (* Incr_SA *);
  632.  
  633. (*----------------------------------------------------------------------*)
  634. (*           Get_ACK --- Wait for ACK of packet from host               *)
  635. (*----------------------------------------------------------------------*)
  636.  
  637. FUNCTION Get_ACK : BOOLEAN;
  638.  
  639. (*----------------------------------------------------------------------*)
  640. (*                                                                      *)
  641. (*  Get_ACK is called to wait until the SA_Buf indicated by             *)
  642. (*  SA_Next_to_ACK has been ACKed by the host.                          *)
  643. (*                                                                      *)
  644. (*----------------------------------------------------------------------*)
  645.  
  646. VAR
  647.    State      : INTEGER;
  648.    Errors     : INTEGER;
  649.    Block_Num  : INTEGER;
  650.    New_Cks    : INTEGER;
  651.    Sent_ENQ   : BOOLEAN;
  652.    Sent_NAK   : BOOLEAN;
  653.    SA_Index   : INTEGER;
  654.    Do_Exit    : BOOLEAN;
  655.    Got_An_Ack : BOOLEAN;
  656.  
  657. (*----------------------------------------------------------------------*)
  658.  
  659. PROCEDURE Do_S_Get_DLE;
  660.  
  661. BEGIN (* Do_S_Get_DLE *)
  662.  
  663.    Timer := 300;
  664.  
  665.    IF Halt_Transfer THEN
  666.       BEGIN
  667.  
  668.          Display_Message('Transfer terminated by keyboard request.',
  669.                          Err_Mess_Line);
  670.  
  671.          Send_Failure('A');
  672.  
  673.          Do_Exit := TRUE;
  674.  
  675.       END
  676.    ELSE
  677.       IF ( NOT Read_Byte ) THEN
  678.          State := S_Timed_Out
  679.       ELSE IF ( Ch = DLE ) THEN
  680.          State := S_Get_Num
  681.       ELSE IF ( Ch = NAK ) THEN
  682.          BEGIN
  683.             INC( Errors );
  684.             IF ( Errors > Max_Errors ) THEN
  685.                Do_Exit := TRUE
  686.             ELSE
  687.                State := S_Send_Data;
  688.          END
  689.       ELSE IF ( Ch = ETX ) THEN
  690.          State := S_Send_NAK;
  691.  
  692. END   (* Do_S_Get_DLE *);
  693.  
  694. (*----------------------------------------------------------------------*)
  695.  
  696. PROCEDURE Do_S_Get_Num;
  697.  
  698. BEGIN (* Do_S_Get_Num *)
  699.  
  700.    IF ( NOT Read_Byte ) THEN
  701.       State := S_Timed_Out
  702.    ELSE IF ( ( Ch >= ORD('0') ) AND ( Ch <= ORD('9') ) ) THEN
  703.       BEGIN (* Received ACK *)
  704.  
  705.          Sent_ENQ  := FALSE;
  706.          Sent_NAK  := FALSE;
  707.          Block_Num := Ch - ORD('0');
  708.  
  709.          IF ( SA_Buf[SA_Next_to_ACK].Seq = Block_Num ) THEN
  710.             BEGIN (* This is the one we're waiting for *)
  711.                SA_Next_to_ACK := Incr_SA( SA_Next_to_ACK );
  712.                DEC( SA_Waiting );
  713.                Got_An_ACK := TRUE;
  714.                Do_Exit    := TRUE;
  715.             END
  716.          ELSE IF ( SA_Buf[ Incr_SA( SA_Next_to_ACK ) ].Seq = Block_Num ) THEN
  717.             BEGIN (* Must have missed an ACK *)
  718.                SA_Next_to_ACK := Incr_SA (SA_Next_to_ACK);
  719.                SA_Next_to_ACK := Incr_SA (SA_Next_to_ACK);
  720.                DEC( SA_Waiting , 2 );
  721.                Got_An_ACK := TRUE;
  722.                Do_Exit    := TRUE;
  723.             END
  724.          ELSE IF ( SA_Buf[ SA_Next_to_ACK ].Seq = Incr_Seq( Block_Num ) ) THEN
  725.             State := S_Get_DLE    (* Duplicate ACK *)
  726.          ELSE
  727.             State := S_Timed_Out;
  728.       END (* Received ACK *)
  729.    ELSE IF ( Ch = ORD('B') ) THEN
  730.       State := S_Get_Packet        (* Try to receive a packet *)
  731.    ELSE IF ( Ch = NAK ) THEN
  732.       BEGIN
  733.          INC( Errors );
  734.          IF ( Errors > Max_Errors ) THEN
  735.             Do_Exit := TRUE
  736.          ELSE
  737.             State := S_Send_Data
  738.       END
  739.    ELSE
  740.       State := S_Timed_Out;
  741.  
  742. END   (* Do_S_Get_Num *);
  743.  
  744. (*----------------------------------------------------------------------*)
  745.  
  746. PROCEDURE Do_S_Get_Packet;
  747.  
  748. BEGIN (* Do_S_Get_Packet *)
  749.                                    (* Read a packet *)
  750.  
  751.    IF Read_Packet( TRUE , TRUE ) THEN
  752.       BEGIN
  753.                                    (* If failure packet, send ACK *)
  754.                                    (* but indicate we didn't get  *)
  755.                                    (* ACK packet.                 *)
  756.  
  757.          IF ( R_Buffer[0] = ORD('F') ) THEN
  758.             Send_ACK
  759.          ELSE
  760.             Got_An_ACK := TRUE;
  761.  
  762.          Do_Exit := TRUE;
  763.  
  764.       END
  765.                                    (* On a bad receive, try again. *)
  766.    ELSE
  767.       State := S_Timed_Out;
  768.  
  769. END   (* Do_S_Get_Packet *);
  770.  
  771. (*----------------------------------------------------------------------*)
  772.  
  773. PROCEDURE Do_S_Timed_Out;
  774.  
  775. BEGIN (* Do_S_Timed_Out *)
  776.                                    (* Increment error count *)
  777.    INC( Errors );
  778.                                    (* If too many time outs, quit *)
  779.    IF ( Errors > 4 ) THEN
  780.       Do_Exit := TRUE
  781.                                    (* Send ENQ to wake up host if  *)
  782.                                    (* we haven't already sent one. *)
  783.    ELSE
  784.       BEGIN
  785.  
  786.          IF ( NOT Sent_ENQ ) THEN
  787.             BEGIN
  788.                Send_ENQ;
  789.                Sent_ENQ := TRUE;
  790.             END;
  791.  
  792.          State := S_Get_DLE;
  793.  
  794.       END;
  795.  
  796. END   (* Do_S_Timed_Out *);
  797.  
  798. (*----------------------------------------------------------------------*)
  799.  
  800. PROCEDURE Do_S_Send_NAK;
  801.  
  802. BEGIN (* Do_S_Send_NAK *)
  803.                                    (* Increment error count *)
  804.    INC( Errors );
  805.                                    (* If too many, quit. *)
  806.    IF ( Errors > Max_Errors ) THEN
  807.       Do_Exit    := TRUE
  808.                                    (* If we didn't send NAK yet, *)
  809.                                    (* send one.                  *)
  810.    ELSE
  811.       BEGIN
  812.  
  813.          IF ( NOT Sent_NAK ) THEN
  814.             BEGIN
  815.                Send_NAK;
  816.                Sent_NAK := TRUE;
  817.             END;
  818.  
  819.          State := S_Get_DLE;
  820.  
  821.       END;
  822.  
  823. END   (* Do_S_Send_NAK *);
  824.  
  825. (*----------------------------------------------------------------------*)
  826.  
  827. PROCEDURE Do_S_Send_Data;
  828.  
  829. VAR
  830.    I : INTEGER;
  831.  
  832. BEGIN (* Do_S_Send_Data *)
  833.                                    (* Get slot of data to send *)
  834.    SA_Index := SA_Next_to_ACK;
  835.                                    (* Send data *)
  836.    FOR I := 1 TO SA_Waiting DO
  837.       BEGIN
  838.          Send_Data( SA_Index );
  839.          SA_Index := Incr_SA( SA_Index );
  840.       END;
  841.  
  842.    State    := S_Get_DLE;
  843.  
  844.    Sent_ENQ := FALSE;
  845.    Sent_NAK := FALSE;
  846.  
  847. END   (* Do_S_Send_Data *);
  848.  
  849. (*----------------------------------------------------------------------*)
  850.  
  851. BEGIN (* Get_ACK *)
  852.  
  853.    Errors          := 0;
  854.    Sent_ENQ        := FALSE;
  855.    Sent_NAK        := FALSE;
  856.    State           := S_Get_DLE;
  857.                                    (* Increment packet count *)
  858.    INC( Total_Packets );
  859.                                    (* No ACK found yet *)
  860.    Do_Exit    := FALSE;
  861.    Got_An_ACK := FALSE;
  862.                                    (* Loop looking for ACK *)
  863.  
  864.    WHILE ( NOT ( Halt_Transfer OR Do_Exit OR Got_An_ACK ) ) DO
  865.       BEGIN
  866.                                    (* Check keyboard input *)
  867.          Check_Keyboard;
  868.                                    (* Handle current ACK state *)
  869.          CASE State OF
  870.  
  871.             S_Get_DLE    : Do_S_Get_DLE     (* Get initial <DLE> *);
  872.             S_Get_Num    : Do_S_Get_Num     (* Get packet number *);
  873.             S_Get_Packet : Do_S_Get_Packet  (* Get packet itself *);
  874.             S_Timed_Out  : Do_S_Timed_Out   (* Handle time out   *);
  875.             S_Send_NAK   : Do_S_Send_NAK    (* Send NAK to host  *);
  876.             S_Send_Data  : Do_S_Send_Data   (* Send data to host *);
  877.  
  878.          END (* CASE *);
  879.  
  880.       END (* WHILE *);
  881.  
  882.    Get_ACK := Got_An_ACK;
  883.  
  884. END   (* Get_ACK *);
  885.  
  886. (*----------------------------------------------------------------------*)
  887. (*           Send_Packet --- Send packet to host                        *)
  888. (*----------------------------------------------------------------------*)
  889.  
  890. FUNCTION Send_Packet( Size : INTEGER ) : BOOLEAN;
  891.  
  892. BEGIN (* Send_Packet *)
  893.                                    (* If window full, look for ACK *)
  894.                                    (* to open slot.  If not found, *)
  895.                                    (* don't send this packet.      *)
  896.  
  897.    IF ( SA_Waiting = SA_Max ) THEN
  898.       IF ( NOT Get_ACK ) THEN
  899.          BEGIN
  900.             Send_Packet := FALSE;
  901.             EXIT;
  902.          END;
  903.                                    (* Get next slot and fill in size, *)
  904.                                    (* sequence number of packet.      *)
  905.  
  906.    Seq_Num                     := Incr_Seq( Seq_Num );
  907.    SA_Buf[SA_Next_to_Fill].Seq := Seq_Num;
  908.    SA_Buf[SA_Next_to_Fill].Num := Size;
  909.  
  910.                                    (* Send the data. *)
  911.    Send_Data( SA_Next_to_Fill );
  912.                                    (* Get slot to be filled next. *)
  913.  
  914.    SA_Next_to_Fill := Incr_SA( SA_Next_to_Fill );
  915.  
  916.                                    (* Increment count of packets *)
  917.                                    (* waiting for ACK            *)
  918.    INC( SA_Waiting );
  919.  
  920.    Send_Packet     := TRUE;
  921.  
  922. END   (* Send_Packet *);
  923.  
  924. (*----------------------------------------------------------------------*)
  925. (*           SA_Flush --- Synchronize last packet with host             *)
  926. (*----------------------------------------------------------------------*)
  927.  
  928. FUNCTION SA_Flush : BOOLEAN;
  929.  
  930. (*----------------------------------------------------------------------*)
  931. (*                                                                      *)
  932. (*  SA_Flush is called after sending the last packet to get host's      *)
  933. (*  ACKs on outstanding packets.                                        *)
  934. (*                                                                      *)
  935. (*----------------------------------------------------------------------*)
  936.  
  937. BEGIN (* SA_Flush *)
  938.  
  939.    WHILE( SA_Waiting <> 0 ) DO
  940.       IF ( NOT Get_ACK ) THEN
  941.          BEGIN
  942.             SA_Flush := FALSE;
  943.             EXIT;
  944.          END;
  945.  
  946.    SA_Flush := TRUE;
  947.  
  948. END   (* SA_Flush *);
  949.  
  950. (*----------------------------------------------------------------------*)
  951. (*           Send_Failure --- Send failure code to host                 *)
  952. (*----------------------------------------------------------------------*)
  953.  
  954. PROCEDURE Send_Failure (* Code : CHAR *);
  955.  
  956. VAR
  957.    Dummy : BOOLEAN;
  958.  
  959. BEGIN (* Send_Failure *)
  960.                                    (* Reinitialize send-ahead variables *)
  961.    SA_Next_to_ACK  := 0;
  962.    SA_Next_to_Fill := 0;
  963.    SA_Waiting      := 0;
  964.                                    (* Prepare failure packet *)
  965.    WITH SA_Buf[0] DO
  966.       BEGIN
  967.          Buf[0] := ORD( 'F'  );
  968.          Buf[1] := ORD( Code );
  969.       END;
  970.                                    (* Send failure packet and wait *)
  971.                                    (* for host to ACK it           *)
  972.    IF Send_Packet( 1 ) THEN
  973.       Dummy := SA_Flush;
  974.  
  975. END   (* Send_Failure *);
  976.  
  977. (*----------------------------------------------------------------------*)
  978. (*           Read_File --- Read data from file being sent out           *)
  979. (*----------------------------------------------------------------------*)
  980.  
  981. FUNCTION Read_File( VAR Data_File : FILE;
  982.                     VAR S_Buffer  : BufferType;
  983.                     N             : INTEGER;
  984.                     Xmt_Size      : INTEGER ) : INTEGER;
  985.  
  986. VAR
  987.    L : INTEGER;
  988.  
  989. BEGIN (* Read_File *)
  990.  
  991.    BlockRead( Data_File, S_Buffer[N], Xmt_Size, L );
  992.  
  993.    Read_File := L;
  994.  
  995. END    (* Read_File *);
  996.  
  997. (*----------------------------------------------------------------------*)
  998. (*           Send_File --- Handle file sending using CISB B             *)
  999. (*----------------------------------------------------------------------*)
  1000.  
  1001. FUNCTION Send_File( Name : AnyStr ) : BOOLEAN;
  1002.  
  1003. VAR
  1004.    N         : INTEGER;
  1005.    Data_File : FILE;
  1006.    IO_Error  : INTEGER;
  1007.    Cps_S     : STRING[10];
  1008.    CPS       : INTEGER;
  1009.    Send_Mess : AnyStr;
  1010.    Open_OK   : BOOLEAN;
  1011.  
  1012. LABEL Error;
  1013.  
  1014. BEGIN (* Send_File *)
  1015.                                    (* Assume send fails        *)
  1016.    Send_File := FALSE;
  1017.  
  1018.    FileMode := 0;
  1019.  
  1020.    ASSIGN( Data_File , Name );
  1021.    RESET ( Data_File , 1    );
  1022.  
  1023.    FileMode := 2;
  1024.  
  1025.    IO_Error := Int24Result;
  1026.                                    (* If file can't be opened, halt *)
  1027.                                    (* transfer.                     *)
  1028.  
  1029.    IF ( IO_Error <> 0 ) THEN
  1030.       BEGIN
  1031.          Send_Failure('E');
  1032.          Display_Message('Can''t open file to be sent, transfer stopped.',
  1033.                          Err_Mess_Line);
  1034.          TFile_Size := 0;
  1035.          GOTO Error;
  1036.       END;
  1037.                                    (* Remember file size *)
  1038.  
  1039.    TFile_Size := FileSize( Data_File );
  1040.  
  1041.    STR( TFile_Size , Cps_S );
  1042.    Write_Log('Size of file to send is ' + Cps_S + ' bytes' , TRUE, FALSE );
  1043.  
  1044.                                    (* Remember starting time for transfer *)
  1045.    Starting_Time := TimeOfDay;
  1046.  
  1047.    REPEAT
  1048.                                    (* Read next sector of data *)
  1049.  
  1050.       WITH SA_Buf[ SA_Next_to_Fill ] DO
  1051.          BEGIN
  1052.             Buf[0] := ORD('N');
  1053.             N      := Read_File( Data_File, Buf, 1, Buffer_Size );
  1054.          END;
  1055.  
  1056.      IF ( Int24Result <> 0 ) THEN
  1057.         BEGIN
  1058.            N             := -1;
  1059.            Halt_Transfer := TRUE;
  1060.         END;
  1061.                                    (* Send data packet if anything *)
  1062.                                    (* to send.                     *)
  1063.       IF ( N > 0 ) THEN
  1064.          BEGIN
  1065.                                    (* If packet not sent, report *)
  1066.                                    (* failure.                   *)
  1067.             INC( Total_Blocks    );
  1068.             INC( Total_Bytes , N );
  1069.  
  1070.             IF ( NOT Send_Packet( N ) ) THEN
  1071.                BEGIN
  1072.                   Display_Message('Can''t send packet, transfer stopped.',
  1073.                                   Err_Mess_Line);
  1074.                   Halt_Transfer := TRUE;
  1075.                END;
  1076.  
  1077.          END;
  1078.                                    (* Check for keyboard input halting *)
  1079.                                    (* transfer.                        *)
  1080.  
  1081.       IF ( NOT Halt_Transfer ) THEN
  1082.          BEGIN
  1083.  
  1084.             Check_Keyboard;
  1085.  
  1086.             IF Halt_Transfer THEN
  1087.                BEGIN
  1088.                   Send_Failure('E');
  1089.                   Display_Message('Transfer terminated by keyboard request.',
  1090.                                   Err_Mess_Line);
  1091.                END;
  1092.  
  1093.          END;
  1094.  
  1095.       Update_B_Display;
  1096.  
  1097.    UNTIL ( N <= 0 ) OR Halt_Transfer;
  1098.  
  1099.    IF ( N < 0 ) THEN
  1100.       BEGIN (* Read failure *)
  1101.          Send_Failure('E');
  1102.          Display_Message('Error reading file, transfer stopped.',
  1103.                          Err_Mess_Line);
  1104.       END   (* Read failure *);
  1105.  
  1106.                                    (* Close file *)
  1107.    Ending_Time := TimeOfDay;
  1108.  
  1109.    CLOSE( Data_File );
  1110.  
  1111.    IO_Error := Int24Result;
  1112.  
  1113.    IF ( NOT Halt_Transfer ) THEN
  1114.       BEGIN
  1115.                                    (* Send end of file packet. *)
  1116.  
  1117.          WITH SA_Buf[ SA_Next_to_Fill ] DO
  1118.             BEGIN
  1119.                Buf[0] := ORD('T');
  1120.                Buf[1] := ORD('C');
  1121.             END;
  1122.  
  1123.          IF ( NOT Send_Packet( 2 ) ) THEN
  1124.             Display_Message('Can''t send end of file packet, transfer stopped.',
  1125.                             Err_Mess_Line )
  1126.          ELSE
  1127.             BEGIN
  1128.                IF SA_Flush THEN
  1129.                   BEGIN
  1130.                      Send_File  := TRUE;
  1131.                      Total_Time := TimeDiff( Starting_Time , Ending_Time );
  1132.                      Send_Mess  := 'Send complete.';
  1133.                      IF ( Total_Time > 0 ) THEN
  1134.                         BEGIN
  1135.                            CPS := TRUNC( Total_Bytes / Total_Time );
  1136.                            STR( CPS , Cps_S );
  1137.                            Send_Mess := Send_Mess + ' Transfer rate: ' + Cps_S +
  1138.                                         ' CPS.';
  1139.                         END;
  1140.                      Display_Message( Send_Mess , Err_Mess_Line );
  1141.                  END;
  1142.             END;
  1143.  
  1144.       END;
  1145.                                    (* Reset serial port if necessary *)
  1146. Error:
  1147.    IF Reset_Port THEN
  1148.       Async_Reset_Port( Comm_Port, Baud_Rate,
  1149.                         Xmodem_Parity_Save,
  1150.                         Xmodem_Bits_Save,
  1151.                         Xmodem_Stop_Save );
  1152.  
  1153.    Reset_Port := FALSE;
  1154.  
  1155.    Window_Delay;
  1156.  
  1157. END    (* Send_File *);
  1158.  
  1159. (*----------------------------------------------------------------------*)
  1160. (*   Do_Transport_Parameters --- Handle '+' packet for Quick B settings *)
  1161. (*----------------------------------------------------------------------*)
  1162.  
  1163. PROCEDURE Do_Transport_Parameters;
  1164.  
  1165. (*----------------------------------------------------------------------*)
  1166. (*                                                                      *)
  1167. (*  Do_Transport_Parameters is called when a Packet type of + is        *)
  1168. (*  received.  It sends a packet of our local Quick B parameters and    *)
  1169. (*  sets the Our_xx parameters to the minimum of the sender's and our   *)
  1170. (*  own parameters.                                                     *)
  1171. (*                                                                      *)
  1172. (*----------------------------------------------------------------------*)
  1173.  
  1174. BEGIN (* Do_Transport_Parameters *)
  1175.  
  1176.                                    (* Pick out sender's parameters *)
  1177.    His_WS := R_Buffer[1];
  1178.    His_WR := R_Buffer[2];
  1179.    His_BS := R_Buffer[3];
  1180.    His_CM := R_Buffer[4];
  1181.                                    (* Prepare to return our own parameters *)
  1182.    WITH SA_Buf[SA_Next_to_Fill] DO
  1183.       BEGIN
  1184.          Buf[0] := ORD('+');
  1185.          Buf[1] := Def_WS;
  1186.          Buf[2] := Def_WR;
  1187.          Buf[3] := Def_BS;
  1188.          Buf[4] := Def_CM;
  1189.          Buf[5] := Def_DQ;
  1190.       END;
  1191.  
  1192.    IF ( NOT Send_Packet( 5 ) ) THEN
  1193.       EXIT;
  1194.  
  1195.    IF SA_Flush THEN                 (* Wait for host's ACK on our packet *)
  1196.       BEGIN
  1197.                                     (* ** Take minimal subset of Transport Params. **  *)
  1198.  
  1199.                                     (* If he can send ahead, we can receive it. *)
  1200.  
  1201.          Our_WR := MIN( His_WS , Def_WR );
  1202.  
  1203.                                     (* If he can receive send ahead, we can send it. *)
  1204.  
  1205.          Our_WS := MIN( His_WR , Def_WS );
  1206.          Our_BS := MIN( His_BS , Def_BS );
  1207.          Our_CM := MIN( His_CM , Def_CM );
  1208.  
  1209.                                     (* Set Our_BS = 4 as default if not given *)
  1210.          IF ( Our_BS = 0 ) THEN
  1211.             Our_BS := 4;
  1212.                                     (* Set buffer size *)
  1213.  
  1214.          Buffer_Size := Our_BS * 128;
  1215.  
  1216.                                    (* Quick B protocol is available *)
  1217.          Quick_B := TRUE;
  1218.                                    (* Set CRC mode *)
  1219.          Use_CRC := ( Our_CM = 1 );
  1220.  
  1221.          IF ( Our_WS <> 0 ) THEN
  1222.             BEGIN
  1223.                SA_Enabled := TRUE;
  1224.                SA_Max     := Max_SA;
  1225.             END;
  1226.  
  1227.       END;
  1228.                                    (* Reinitialize display with new params *)
  1229.    Initialize_Transfer_Display;
  1230.  
  1231. END   (* Do_Transport_Parameters *);
  1232.  
  1233. (*----------------------------------------------------------------------*)
  1234. (*   Do_Application_Parameters --- Handle '?' packet                    *)
  1235. (*----------------------------------------------------------------------*)
  1236.  
  1237. PROCEDURE Do_Application_Parameters;
  1238.  
  1239. (*----------------------------------------------------------------------*)
  1240. (*                                                                      *)
  1241. (*  Do_Application_Parameters is called when a ? packet is received.    *)
  1242. (*  This version ignores the host's packet and returns a ? packet       *)
  1243. (*  saying that normal B Protocol File Transfer is supported.           *)
  1244. (*  (Well, actually it says that no extended application packets are    *)
  1245. (*  supported.  The T packet is assumed to be standard.)                *)
  1246. (*                                                                      *)
  1247. (*----------------------------------------------------------------------*)
  1248.  
  1249. VAR
  1250.    Dummy : BOOLEAN;
  1251.  
  1252. BEGIN (* Do_Application_Parameters *)
  1253.  
  1254.    WITH SA_Buf[ SA_Next_to_Fill ] DO
  1255.       BEGIN
  1256.          Buf[0] := ORD('?');       (* Build the ? packet *)
  1257.          Buf[1] := 1;              (* The T packet flag  *)
  1258.       END;
  1259.  
  1260.    IF Send_Packet( 1 ) THEN              (* Send the packet *)
  1261.       Dummy := SA_Flush;
  1262.  
  1263. END   (* Do_Application_Parameters *);
  1264.  
  1265. (*----------------------------------------------------------------------*)
  1266. (*            Write_File --- Write received data to PC file             *)
  1267. (*----------------------------------------------------------------------*)
  1268.  
  1269. FUNCTION Write_File( VAR Data_File : FILE;
  1270.                          R_Buffer  : BufferType;
  1271.                          N         : INTEGER;
  1272.                          Size      : INTEGER) : INTEGER;
  1273.  
  1274. VAR
  1275.    Size_Written : INTEGER;
  1276.  
  1277. BEGIN (* Write_File *)
  1278.  
  1279.    BlockWrite( Data_File, R_Buffer[ N ], Size, Size_Written );
  1280.    Write_File := Size_Written;
  1281.  
  1282. END   (* Write_File *);
  1283.  
  1284. (*----------------------------------------------------------------------*)
  1285. (*            Receive_File --- Handle file reception using CIS B        *)
  1286. (*----------------------------------------------------------------------*)
  1287.  
  1288. FUNCTION Receive_File( Name : AnyStr ) : BOOLEAN;
  1289.  
  1290. VAR
  1291.    Data_File : FILE;
  1292.    Status    : INTEGER;
  1293.    R_File    : BOOLEAN;
  1294.    Cps_S     : STRING[10];
  1295.    CPS       : INTEGER;
  1296.    Rec_Mess  : AnyStr;
  1297.  
  1298. LABEL  Error;
  1299.  
  1300. BEGIN (* Receive_File *)
  1301.                                    (* Assume transfer fails   *)
  1302.    R_File := FALSE;
  1303.                                    (* Open file to be created *)
  1304.  
  1305.    Add_Path( Name, Download_Dir_Path, Name );
  1306.  
  1307.    ASSIGN ( Data_File , Name );
  1308.    REWRITE( Data_File , 1  );
  1309.                                    (* Halt transfer if file can't be *)
  1310.                                    (* opened.                        *)
  1311.    Status := Int24Result;
  1312.  
  1313.    IF ( Status <> 0 ) THEN
  1314.       BEGIN
  1315.          Send_Failure('E');
  1316.          Display_Message('Can''t open output file, transfer stoppped.',
  1317.                          Err_Mess_Line);
  1318.          Receive_File := FALSE;
  1319.          GOTO Error;
  1320.       END;
  1321.                                    (* Send ACK to start transfer  *)
  1322.    Send_ACK;
  1323.                                    (* Remember starting time for transfer *)
  1324.    Starting_Time := TimeOfDay;
  1325.                                    (* Begin loop over packets *)
  1326.  
  1327.    WHILE ( NOT ( Halt_Transfer OR R_File  ) ) DO
  1328.       BEGIN
  1329.                                    (* Get next packet *)
  1330.  
  1331.          IF Read_Packet( FALSE , FALSE ) THEN
  1332.             BEGIN
  1333.                                    (* Select Action based upon packet type *)
  1334.  
  1335.                CASE CHR( R_Buffer[0] ) OF
  1336.  
  1337.                                    (* Data for file -- write it and *)
  1338.                                    (* acknowledge it.               *)
  1339.                   'N': BEGIN
  1340.                           Status := Write_File( Data_File, R_Buffer, 1,
  1341.                                                 PRED( R_Size ) );
  1342.  
  1343.                           IF ( Int24Result <> 0 ) THEN
  1344.                              BEGIN
  1345.                                 Display_Message('** Write failure...aborting',
  1346.                                                 Err_Mess_Line);
  1347.                                 ClrEol;
  1348.                                 Send_Failure ('E');
  1349.                                 Halt_Transfer := TRUE;
  1350.                              END
  1351.                           ELSE
  1352.                              BEGIN
  1353.                                 Send_ACK;
  1354.                                 Total_Blocks := Total_Blocks + 1;
  1355.                                 Total_Bytes  := Total_Bytes  + R_Size - 1;
  1356.                              END;
  1357.                        END;
  1358.  
  1359.                                    (* End of transfer -- close file *)
  1360.                                    (* and acknowledge end of file   *)
  1361.                   'T': BEGIN
  1362.  
  1363.                           IF ( R_Buffer[1] = ORD('C') ) THEN
  1364.                              BEGIN
  1365.                                 Ending_Time  := TimeOfDay;
  1366.                                 CLOSE( Data_File );
  1367.                                 Status := Int24Result;
  1368.                                 IF ( Status <> 0 ) THEN
  1369.                                    BEGIN
  1370.                                       Display_Message('** Failure during close...aborting',
  1371.                                                       Err_Mess_Line);
  1372.                                       Send_Failure ('E');
  1373.                                       Halt_Transfer := TRUE;
  1374.                                    END
  1375.                                 ELSE
  1376.                                    BEGIN
  1377.                                       Send_ACK;
  1378.                                       R_File  := TRUE;
  1379.                                       Total_Time := TimeDiff( Starting_Time ,
  1380.                                                               Ending_Time );
  1381.                                       Rec_Mess   := 'Receive complete.';
  1382.                                       STR( Total_Bytes , Cps_S );
  1383.                                       Write_Log('Size of file received was ' + Cps_S +
  1384.                                                 ' bytes' , TRUE, FALSE );
  1385.                                       IF ( Total_Time > 0 ) THEN
  1386.                                          BEGIN
  1387.                                             CPS := TRUNC( Total_Bytes / Total_Time );
  1388.                                             STR( CPS , Cps_S );
  1389.                                             Rec_Mess := Rec_Mess + ' Transfer rate: ' + Cps_S +
  1390.                                                         ' CPS.';
  1391.                                          END;
  1392.  
  1393.                                       Display_Message( Rec_Mess , Err_Mess_Line );
  1394.                                    END;
  1395.  
  1396.                              END;
  1397.  
  1398.                        END;
  1399.                                    (* Stop transfer received -- halt *)
  1400.                                    (* transfer and acknowledge.      *)
  1401.                   'F': BEGIN
  1402.                           Send_ACK;
  1403.                           Halt_Transfer := TRUE;
  1404.                           Display_Message('Host cancelled transfer.', Err_Mess_Line);
  1405.                        END;
  1406.  
  1407.                 END   (* CASE *);
  1408.  
  1409.             END  (* IF *)
  1410.          ELSE
  1411.             BEGIN (* No packet received *)
  1412.                Halt_Transfer := TRUE;
  1413.                Display_Message('Failed to received packet, transfer aborted.',
  1414.                                Err_Mess_Line);
  1415.                ClrEol;
  1416.             END   (* No packet received *);
  1417.  
  1418.                                    (* Check for keyboard input halting *)
  1419.                                    (* transfer.                        *)
  1420.  
  1421.          IF ( NOT Halt_Transfer ) THEN
  1422.             BEGIN
  1423.  
  1424.                Check_Keyboard;
  1425.  
  1426.                IF Halt_Transfer THEN
  1427.                   BEGIN
  1428.                      Send_Failure('E');
  1429.                      Display_Message('Transfer terminated by keyboard request.',
  1430.                                      Err_Mess_Line);
  1431.                      ClrEol;
  1432.                   END;
  1433.  
  1434.             END;
  1435.  
  1436.       END  (* WHILE *);
  1437.  
  1438.    Receive_File := R_File AND ( NOT Halt_Transfer );
  1439.    Ending_Time  := TimeOfDay;
  1440.                                    (* Close received file *)
  1441.    CLOSE( Data_File );
  1442.  
  1443.    Status := Int24Result;
  1444.                                    (* If we are to delete partially *)
  1445.                                    (* received files, do so.        *)
  1446.  
  1447.    IF ( ( NOT R_File ) AND Evict_Partial_Trans ) THEN
  1448.       ERASE( Data_File );
  1449.  
  1450.    Status := Int24Result;
  1451.  
  1452. Error:
  1453.    IF Reset_Port THEN
  1454.       Async_Reset_Port( Comm_Port, Baud_Rate,
  1455.                         Xmodem_Parity_Save,
  1456.                         Xmodem_Bits_Save,
  1457.                         Xmodem_Stop_Save );
  1458.    Reset_Port := FALSE;
  1459.  
  1460.    Window_Delay;
  1461.  
  1462. END   (* Receive_File *);
  1463.  
  1464. (*----------------------------------------------------------------------*)
  1465. (*            CISB_DLE_Seen --- M A I N   R O U T I N E                 *)
  1466. (*----------------------------------------------------------------------*)
  1467.  
  1468. BEGIN (* CISB_DLE_Seen *)
  1469.                                    (* Begin by getting the next character.  *)
  1470.                                    (* If it is <B> then enter the           *)
  1471.                                    (* B_Protocol State.  Otherwise simply   *)
  1472.                                    (* return.                               *)
  1473.    Timer         := 10;
  1474.    Halt_Transfer := FALSE;
  1475.  
  1476.    IF ( NOT Read_Byte ) THEN
  1477.       EXIT
  1478.    ELSE IF ( Ch <> ORD('B') ) THEN
  1479.       EXIT;
  1480.                                    (* Initialize send-ahead variables *)
  1481.    SA_Next_to_ACK  := 0;
  1482.    SA_Next_to_Fill := 0;
  1483.    SA_Waiting      := 0;
  1484.                                    (* Reset comm parms to 8,n,1 if we aren't *)
  1485.                                    (* set to that already.                   *)
  1486.    Xmodem_Bits_Save   := Data_Bits;
  1487.    Xmodem_Parity_Save := Parity;
  1488.    Xmodem_Stop_Save   := Stop_Bits;
  1489.  
  1490.    IF ( ( Data_Bits = 8 ) AND ( Parity = 'N' ) ) THEN
  1491.       Reset_Port := FALSE
  1492.    ELSE
  1493.       BEGIN
  1494.          Async_Reset_Port( Comm_Port, Baud_Rate, 'N', 8, 1 );
  1495.          Reset_Port := TRUE;
  1496.          IF Do_Status_Line THEN
  1497.             BEGIN
  1498.                Set_Status_Line_Name( Short_Terminal_Name );
  1499.                Write_To_Status_Line( Status_Line_Name, 1 );
  1500.             END;
  1501.       END;
  1502.                                    (* Announce protocol starts *)
  1503.  
  1504.    Save_Partial_Screen( Saved_Screen, 5, 10, 75, 20 );
  1505.  
  1506.    Comp_Title := 'CompuServe B Protocol';
  1507.  
  1508.    Receiving_File := TRUE;
  1509.  
  1510.    Initialize_Transfer_Display;
  1511.  
  1512.    Halt_Transfer  := FALSE;
  1513.    Receiving_File := TRUE;
  1514.    Display_Status := TRUE;
  1515.    Comp_Title     := 'CIS B -- ';
  1516.    Total_Blocks   := 0;
  1517.    Total_Packets  := 0;
  1518.    Total_Errors   := 0;
  1519.    Total_Bytes    := 0;
  1520.                                    (* Read initial packet *)
  1521.  
  1522.    IF Read_Packet( TRUE , FALSE ) THEN
  1523.       BEGIN
  1524.                                    (* Select Action based upon packet type *)
  1525.  
  1526.          CASE CHR( R_Buffer[0] ) OF
  1527.  
  1528.                                    (* Upload or download *)
  1529.             'T': BEGIN
  1530.  
  1531.                     CASE CHR( R_Buffer[1] ) OF
  1532.                        'D' : BEGIN
  1533.                                 Comp_Title := 'Receiving ';
  1534.                                 Receiving_File := TRUE;
  1535.                              END;
  1536.                        'U' : BEGIN
  1537.                                 Comp_Title := 'Sending ';
  1538.                                 Receiving_File := FALSE;
  1539.                              END;
  1540.                        ELSE
  1541.                              BEGIN
  1542.                                 Send_Failure('N');
  1543.                                 GOTO Error_Exit;
  1544.                              END;
  1545.                     END  (* CASE *);
  1546.  
  1547.                                    (* Get file name *)
  1548.  
  1549.                     CASE CHR( R_Buffer[2] ) OF
  1550.                        'A': Comp_Title := Comp_Title + 'ASCII file "';
  1551.                        'B': Comp_Title := Comp_Title + 'Binary file "';
  1552.                        ELSE
  1553.                           BEGIN
  1554.                              Send_Failure('N');        (* Not implemented *)
  1555.                              GOTO Error_Exit;
  1556.                           END;
  1557.                     END   (* CASE *);
  1558.  
  1559.                     I        := 2;
  1560.                     FileName := '';
  1561.  
  1562.                     WHILE ( R_Buffer[I] <> 0 ) AND ( I < R_Size ) DO
  1563.                        BEGIN
  1564.                           INC( I );
  1565.                           FileName := FileName + CHR( R_Buffer[I] );
  1566.                        END;
  1567.  
  1568.                     Comp_Title := Comp_Title + FileName + '"';
  1569.  
  1570.                                    (* Display file transfer header *)
  1571.  
  1572.                     Initialize_Transfer_Display;
  1573.  
  1574.                                    (* Perform transfer *)
  1575.  
  1576.                     IF ( R_Buffer[1] = ORD('U') ) THEN
  1577.                        Dummy := Send_File( FileName )
  1578.                     ELSE
  1579.                        Dummy := Receive_File( FileName );
  1580.  
  1581.                  END;
  1582.                                    (* Received Transport Parameters Packet *)
  1583.  
  1584.             '+': Do_Transport_Parameters;
  1585.  
  1586.                                    (* Received Application Parameters Packet *)
  1587.  
  1588.             '?': Do_Application_Parameters;
  1589.  
  1590.                                    (* Unknown packet; tell the host we don't know *)
  1591.             ELSE Send_Failure ('N');
  1592.  
  1593.          END (* CASE *);
  1594.  
  1595.       END (* BEGIN *)
  1596.                                    (* No initial packet -- quit *)
  1597.     ELSE
  1598.        BEGIN
  1599.           Display_Message('Can''t get first packet, transfer cancelled',
  1600.                           Err_Mess_Line);
  1601.           IF Reset_Port THEN
  1602.              Async_Reset_Port( Comm_Port, Baud_Rate, Xmodem_Parity_Save,
  1603.                                Xmodem_Bits_Save, Xmodem_Stop_Save );
  1604.           Reset_Port := FALSE;
  1605.           Window_Delay;
  1606.        END;
  1607.  
  1608. Error_Exit:
  1609.                                    (* Reset comm parms back *)
  1610.    IF Reset_Port THEN
  1611.       Async_Reset_Port( Comm_Port, Baud_Rate, Xmodem_Parity_Save,
  1612.                         Xmodem_Bits_Save, Xmodem_Stop_Save );
  1613.  
  1614.    IF Do_Status_Line THEN
  1615.       BEGIN
  1616.          Set_Status_Line_Name( Short_Terminal_Name );
  1617.          Write_To_Status_Line( Status_Line_Name, 1 );
  1618.       END;
  1619.                                    (* Restore previous screen *)
  1620.  
  1621.    Restore_Screen_And_Colors( Saved_Screen );
  1622.  
  1623.                                    (* Restore cursor *)
  1624.    CursorOn;
  1625.  
  1626. END   (* CISB_DLE_Seen *);
  1627.