home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / modem / wxtermsr.arc / WXTMXFER.INC < prev   
Text File  |  1988-02-12  |  41KB  |  1,043 lines
  1. {$U-,C-,R-,K-}
  2.   {   - originally written by:
  3. Scott Murphy
  4. 77 So. Adams St. #301
  5. Denver, CO 80209
  6. Compuserve 70156,263
  7.   }
  8.   {   - modified to add CRC xmodem, wxmodem 7/86 - 10/86
  9. Peter Boswell
  10. ADI
  11. Suite 650
  12. 350 N. Clark St.
  13. Chicago, Il 60610
  14. People/Link: Topper
  15. Compuserve : 72247,3671
  16.   }
  17. CONST
  18.      SOH = 1;                          {Start Of Header}
  19.      EOT = 4;                          {End Of Transmission}
  20.      ACK = 6;                          {ACKnowledge}
  21.      DLE = $10;                        {Data Link Escape}
  22.      XON = $11;                        {X-On}
  23.      XOFF = $13;                       {X-Off}
  24.      NAK = $15;                        {Negative AcKnowledge}
  25.      SYN = $16;                        {Synchronize}
  26.      CAN = $18;                        {CANcel}
  27.      CHARC = $43;                      {C = CRC Xmodem}
  28.      CHARW = $57;                      {W = WXmodem}
  29.      MAXERRS = 10;                     {Maximum allowed errors}
  30.      L = 0;
  31.      H = 1;
  32.      BufLen  = 128;                    {Disk I/O buffer length}
  33.      Bufnum = 64;                      {Disk I/O buffer count}
  34.      Maxwindow = 4;                    {Wxmodem window size}
  35.                                        {CRC byte translation table}
  36.      Crctab: ARRAY[0..255] OF INTEGER =
  37.      (0, 4129, 8258, 12387, 16516, 20645, 24774, 28903,
  38.       -32504,-28375,-24246,-20117,-15988,-11859,-7730,-3601,
  39.       4657, 528, 12915, 8786, 21173, 17044, 29431, 25302,
  40.       -27847,-31976,-19589,-23718,-11331,-15460,-3073,-7202,
  41.       9314, 13379, 1056, 5121, 25830, 29895, 17572, 21637,
  42.       -23190,-19125,-31448,-27383,-6674,-2609,-14932,-10867,
  43.       13907, 9842, 5649, 1584, 30423, 26358, 22165, 18100,
  44.       -18597,-22662,-26855,-30920,-2081,-6146,-10339,-14404,
  45.       18628, 22757, 26758, 30887, 2112, 6241, 10242, 14371,
  46.       -13876,-9747,-5746,-1617,-30392,-26263,-22262,-18133,
  47.       23285, 19156, 31415, 27286, 6769, 2640, 14899, 10770,
  48.       -9219,-13348,-1089,-5218,-25735,-29864,-17605,-21734,
  49.       27814, 31879, 19684, 23749, 11298, 15363, 3168, 7233,
  50.       -4690,-625,-12820,-8755,-21206,-17141,-29336,-25271,
  51.       32407, 28342, 24277, 20212, 15891, 11826, 7761, 3696,
  52.       -97,-4162,-8227,-12292,-16613,-20678,-24743,-28808,
  53.       -28280,-32343,-20022,-24085,-12020,-16083,-3762,-7825,
  54.       4224, 161, 12482, 8419, 20484, 16421, 28742, 24679,
  55.       -31815,-27752,-23557,-19494,-15555,-11492,-7297,-3234,
  56.       689, 4752, 8947, 13010, 16949, 21012, 25207, 29270,
  57.       -18966,-23093,-27224,-31351,-2706,-6833,-10964,-15091,
  58.       13538, 9411, 5280, 1153, 29798, 25671, 21540, 17413,
  59.       -22565,-18438,-30823,-26696,-6305,-2178,-14563,-10436,
  60.       9939, 14066, 1681, 5808, 26199, 30326, 17941, 22068,
  61.       -9908,-13971,-1778,-5841,-26168,-30231,-18038,-22101,
  62.       22596, 18533, 30726, 26663, 6336, 2273, 14466, 10403,
  63.       -13443,-9380,-5313,-1250,-29703,-25640,-21573,-17510,
  64.       19061, 23124, 27191, 31254, 2801, 6864, 10931, 14994,
  65.       -722,-4849,-8852,-12979,-16982,-21109,-25112,-29239,
  66.       31782, 27655, 23652, 19525, 15522, 11395, 7392, 3265,
  67.       -4321,-194,-12451,-8324,-20581,-16454,-28711,-24584,
  68.       28183, 32310, 20053, 24180, 11923, 16050, 3793, 7920);
  69.  
  70. {*** variables used as globals in this source segment
  71.      (actually global to whole  source) ***}
  72. VAR
  73.    checksum     : INTEGER;
  74.    fname        : bigstring;
  75.    response     : STRING[1];
  76.    crcval,db,sb : INTEGER;
  77.    packetln     : INTEGER;            {128 + Checksum or 128 + CRC}
  78.    p            : parity_set;
  79.    dbuffer      : ARRAY[1..Bufnum,1..BufLen] OF Byte;
  80.    dcount       : INTEGER;
  81.    Wxmode       : BOOLEAN;
  82.    Crcmode      : BOOLEAN;
  83.    Openflag     : BOOLEAN;
  84.  
  85. PROCEDURE updcrc(a : Byte);
  86. BEGIN
  87.   {
  88.      crcval := Crctab[hi(crcval) xor a] xor (lo(crcval) shl 8);
  89.   }
  90.      InLine(
  91.  
  92.         $A1/crcval/       {mov ax,crcval     AX <- crcval}
  93.         $89/$C2/          {mov dx,ax         DX <- crcval}
  94.         $88/$E0/          {mov al,ah         (AX) crcval >> 8}
  95.         $B4/$00/          {mov ah,0 }
  96.         $36/              {ss:}
  97.         $8B/$8E/a/        {mov cx,[bp+a]     CX <- a}
  98.         $31/$C8/          {xor ax,cx         AX <- (crcval >> 8) xor a}
  99.         $D1/$E0/          {shl ax,1          AX <- AX * 2  (word index)}
  100.         $BB/crctab/       {mov bx,offset crctab   BX <- addr(crctab)}
  101.         $01/$C3/          {add bx,ax         BX <- addr(crctab)+((crcval>>8)xor a)*2 }
  102.         $2E/              {cs:}
  103.         $8B/07/           {mov ax,[bx]       AX <- contents of crctab}
  104.         $88/$D6/          {mov dh,dl         (DX) crcval << 8}
  105.         $B2/$00/          {mov dl,00}
  106.         $31/$D0/          {xor ax,dx         AX <- contents of crctab xor crcval << 8}
  107.         $A3/crcval        {mov crcval,ax     crcval <- AX}
  108.  
  109.           );
  110. END;
  111.  
  112. { Xmodem transmit window routine
  113.   Peter Boswell, July 1986       }
  114.  
  115. PROCEDURE txwindow(opt : INTEGER; in_string : bigstring);
  116.  
  117. BEGIN
  118.    CASE opt OF
  119.        1  :     BEGIN                           {initialize}
  120.                    OpenTemp(36,3,78,18,2);
  121.                    ClrScr;
  122.                    GotoXY(10,1);
  123.                    WRITE('File - ',in_string);
  124.                    GotoXY(10,2);
  125.                    WRITE('Mode -');
  126.                    GotoXY(4,3);
  127.                    WRITE('Total time -');
  128.                    GotoXY(2,4);
  129.                    WRITE('Total Blocks -');
  130.                    GotoXY(10,5);
  131.                    WRITE('Sent -');
  132.                    GotoXY(9,6);
  133.                    WRITE('ACK''d -');
  134.                    GotoXY(6,7);
  135.                    WRITE('Last NAK -');
  136.                    GotoXY(9,8);
  137.                    WRITE('X-Off - No');
  138.                    GotoXY(8,9);
  139.                    WRITE('Window - 0');
  140.                    GotoXY(4,11);
  141.                    WRITE('Last Error -');
  142.                    GotoXY(8,10);
  143.                    WRITE('Errors -');
  144.                 END;
  145.        2..11  : BEGIN
  146.                    GotoXY(17,opt);
  147.                    ClrEol;
  148.                    WRITE(in_string);
  149.                 END;
  150.        12     : BEGIN
  151.                    GotoXY(3,12);
  152.                    ClrEol;
  153.                    WRITE(in_string);
  154.                 END;
  155.        99     : CloseTemp;
  156.    END;                                         {case}
  157. END;
  158. { Xmodem receive window routine
  159.   Peter Boswell, October 1986       }
  160.  
  161. PROCEDURE trwindow(opt : INTEGER; in_string : bigstring);
  162.  
  163. BEGIN
  164.    CASE opt OF
  165.        1  :     BEGIN                           {initialize}
  166.                    OpenTemp(36,3,78,13,2);
  167.                    ClrScr;
  168.                    GotoXY(10,1);
  169.                    WRITE('File - ',in_string);
  170.                    GotoXY(10,2);
  171.                    WRITE('Mode -');
  172.                    GotoXY(6,3);
  173.                    WRITE('Received -');
  174.                    GotoXY(6,4);
  175.                    WRITE('Last NAK -');
  176.                    GotoXY(4,5);
  177.                    WRITE('Last Error -');
  178.                    GotoXY(8,6);
  179.                    WRITE('Errors -');
  180.                 END;
  181.        2..6   : BEGIN
  182.                    GotoXY(17,opt);
  183.                    ClrEol;
  184.                    WRITE(in_string);
  185.                 END;
  186.        8      : BEGIN
  187.                    GotoXY(3,8);
  188.                    ClrEol;
  189.                    WRITE(in_string);
  190.                 END;
  191.        99     : CloseTemp;
  192.    END;                                         {case}
  193. END;
  194. {
  195.   This routine deletes all DLE characters and XOR's the following character
  196.   with 64.  If a SYN character is found then -2 is returned.
  197.     }
  198. FUNCTION dlecgetc(Tlimit : INTEGER) : INTEGER;
  199. VAR
  200. savecgetc : INTEGER;
  201. BEGIN
  202.      IF wxmode THEN
  203.      BEGIN
  204.           savecgetc := cgetc(Tlimit);
  205.           IF savecgetc = SYN THEN
  206.              savecgetc := -2
  207.           ELSE
  208.           IF savecgetc = DLE THEN
  209.           BEGIN
  210.                savecgetc := cgetc(Tlimit);
  211.                IF savecgetc >= 0 THEN savecgetc := savecgetc XOr 64;
  212.           END;
  213.           dlecgetc := savecgetc;
  214.      END
  215.      ELSE
  216.      dlecgetc := cgetc(Tlimit);
  217. END;
  218.  
  219. PROCEDURE purge;
  220. BEGIN
  221.      WHILE dlecgetc(1) >= 0 DO
  222.                      ;
  223. END;
  224.  
  225.  
  226. PROCEDURE SaveCommStatus;
  227. BEGIN
  228.       p := parity;
  229.       db := dbits;
  230.       sb := stop_bits;
  231.       dbits        := 8;
  232.       parity       := none;
  233.       stop_bits    := 1;
  234.       update_uart
  235. END;
  236.  
  237. PROCEDURE recv_wcp;
  238. {receive a file using Ward Christensen's checksum protocol}
  239. LABEL
  240.      99;
  241. VAR
  242.    j, firstchar, sectnum, sectcurr, prevchar, lignore, blkcnt,
  243.    toterr, errors, sectcomp, bufcurr, bresult : INTEGER;
  244.    Xtrace, EotFlag, ErrorFlag, Extend : BOOLEAN;
  245.    UserKey : Byte;
  246.    blkfile : FILE;
  247.    statstr : bigstring;
  248.    trfile                     : TEXT;
  249. BEGIN
  250.      status(2, 'RECV XMODEM');
  251.      ErrorFlag := TRUE;
  252.      EotFlag   := FALSE;
  253.      Xtrace    := FALSE;
  254.      Openflag  := FALSE;
  255.      Bufcurr   := 1;
  256.      SaveCommStatus;
  257.      WHILE ErrorFlag DO
  258.      BEGIN
  259.           OpenTemp(1,3,80,8,2);
  260.           REPEAT
  261.                 WRITE('Enter a filename for download file (<cr> to abort): ');
  262.                 READLN(fname);
  263.                 supcase(fname);
  264.                 IF LENGTH(fname) > 0 THEN
  265.                    IF exists(fname) THEN
  266.                    BEGIN
  267.                      WRITE(fname, ' Exists. OK to overwrite it (Y/N)? ');
  268.                      READLN(response);
  269.                      IF UpCase(response) = 'Y' THEN
  270.                         ErrorFlag := FALSE;
  271.                    END
  272.                    ELSE ErrorFlag := FALSE
  273.           UNTIL (NOT ErrorFlag) OR (LENGTH(fname) = 0);
  274.           CloseTemp;
  275.           IF LENGTH(fname) > 0 THEN
  276.           BEGIN
  277.                Assign(blkfile,fname);
  278.                {$I-} REWRITE(blkfile); {$I+}
  279.                ErrorFlag := (IOResult <> 0);
  280.                IF ErrorFlag THEN
  281.                BEGIN
  282.                   WRITELN(#13,#10,'WXTERM --- cannot open file');
  283.                   GOTO 99;
  284.                END
  285.                ELSE
  286.                   openflag := TRUE;
  287.           END;
  288.           IF LENGTH(fname) = 0 THEN
  289.           BEGIN
  290.                WRITELN(#13,#10,'WXTERM --- user aborted receive.');
  291.                GOTO 99;
  292.           END;
  293.      END;                                       {while}
  294.      trwindow(1, fname);
  295.      blkcnt := 0;
  296.      sectnum := 0;
  297.      errors := 0;
  298.      toterr := 0;
  299. {    assign(trfile,'trace');}
  300. {    rewrite(trfile);}
  301.      Crcmode  := TRUE;                          {Assume CRC versus Checksum}
  302.      Packetln := 130;                           {128 byte data + 2 byte CRC}
  303.      Wxmode   := TRUE;                          {Assume Wxmodem}
  304.      Lignore  := 0;                             {ignore packets after error}
  305.      i:=0;                                      {Try for Wxmodem 3 times}
  306.      purge;
  307.      trwindow(8,'Trying Wxmodem');
  308.      REPEAT
  309.           send(ORD('W'));
  310.           firstchar := cgetc(12);               {12 seconds each}
  311.           IF scan(Extend, UserKey) THEN
  312.                IF UserKey = CAN THEN GOTO 99;
  313.           i := i + 1;
  314.      UNTIL (firstchar=SYN) OR (firstchar=CAN) OR (i=3);
  315.      IF firstchar=CAN THEN GOTO 99;
  316.      IF firstchar <> SYN THEN
  317.      BEGIN
  318.           Wxmode := FALSE;
  319.           i:=0;                                 {Try CRC xmodem 3 times}
  320.           trwindow(8,'Trying CRC Xmodem');
  321.           REPEAT
  322.                send(ORD('C'));
  323.                firstchar := cgetc(4);           {4 seconds each}
  324.                IF scan(Extend,UserKey) THEN
  325.                     IF UserKey = CAN THEN GOTO 99;
  326.                i := i + 1;
  327.           UNTIL (firstchar=SOH) OR (firstchar=CAN) OR (i=3);
  328.           IF firstchar = CAN THEN GOTO 99;
  329.           IF firstchar <> SOH THEN
  330.           BEGIN
  331.                Crcmode  := FALSE;
  332.                Packetln := 129;                 {128 bytes + 1 byte Checksum}
  333.                i:=0;                            {Try Checksum xmodem 4 times}
  334.                trwindow(5,'Trying Checksum Xmodem');
  335.                REPEAT
  336.                     send(NAK);
  337.                     firstchar := cgetc(10);     {10 seconds each}
  338.                     IF scan(Extend,UserKey) THEN
  339.                          IF UserKey = CAN THEN GOTO 99;
  340.                     i := i + 1;
  341.                UNTIL (firstchar=SOH) OR (firstchar=CAN) OR (i=4);
  342.           END;                                  {Checksum}
  343.      END;                                       {CRC}
  344.      IF wxmode THEN
  345.      BEGIN
  346.          trwindow(2,'WXmodem');
  347.      END;
  348.      IF NOT wxmode AND crcmode THEN
  349.      BEGIN
  350.          trwindow(2,'CRC Xmodem');
  351.      END;
  352.      IF NOT wxmode AND NOT crcmode THEN
  353.      BEGIN
  354.          trwindow(2,'Checksum Xmodem');
  355.      END;
  356.      trwindow(8,'Press ^X to quit');
  357.         { firstchar contains the first character and Wxmode and Crcmode
  358.           indicate the type of Xmodem }
  359.  
  360.      prevchar := firstchar;                     {save the firstchar}
  361.      WHILE (EotFlag = FALSE) AND (Errors < MAXERRS) DO
  362.      BEGIN                                      {locate start of packet}
  363.        IF (firstchar=SOH) AND
  364.           ((Wxmode AND (prevchar=SYN)) OR (NOT Wxmode)) THEN
  365.        BEGIN                                    {process packet}
  366.           prevchar := -1;
  367.           firstchar := -1;
  368.           sectcurr := dlecgetc(15);
  369. {         writeln(trfile,'sectcurr=',sectcurr:4);}
  370.           sectcomp := dlecgetc(15);
  371.           IF sectcurr = (sectcomp XOr 255) THEN
  372.           BEGIN                                 {sequence versus compl good}
  373.                IF sectcurr = ((sectnum + 1) AND 255) THEN
  374.                BEGIN                            {in sequence}
  375.                     crcval   := 0;
  376.                     checksum := 0;
  377.                     j        := 1;
  378.                     REPEAT
  379.                          firstchar := dlecgetc(15);
  380.                          IF firstchar >= 0 THEN
  381.                          BEGIN
  382.                               IF j < 129 THEN
  383.                                  dbuffer[bufcurr,j] := firstchar;
  384.                               IF Crcmode THEN updcrc(firstchar)
  385.                               ELSE checksum := (checksum AND 255) + firstchar;
  386.                               j := j + 1;
  387.                          END;
  388.                     UNTIL (j > Packetln) OR (firstchar < 0);
  389.                     IF j > Packetln THEN        {good packet length}
  390.                     BEGIN
  391.                          IF (Crcmode AND (crcval=0) OR
  392.                          (NOT Crcmode AND ((checksum ShR 1) = firstchar)))
  393.                          THEN
  394.                          BEGIN                  {good crc/checksum}
  395.                               firstchar := -1;  {make sure this byte not used
  396.                                                  for start of packet }                errors  := 0;
  397.                               sectnum := sectcurr;
  398.                               blkcnt  := blkcnt + 1;
  399.                               send(ACK);
  400.                               IF Wxmode THEN send(sectcurr AND 3);
  401. {                             write(trfile,' ACK ');}
  402. {                             if Wxmode then write(trfile,(sectcurr and 3):1);}
  403.                               STR(blkcnt:4,statstr);
  404.                               trwindow(3,statstr);
  405.                               IF errors <> 0 THEN
  406.                               BEGIN
  407.                                  errors := 0;
  408.                                  trwindow(6,'0');
  409.                                  trwindow(5,' ');
  410.                               END;
  411.                               bufcurr := bufcurr + 1;
  412.                               IF bufcurr > bufnum THEN
  413.                               BEGIN             {Disk write routine}
  414.                                    bufcurr := 1;
  415.                                    IF wxmode AND pcjrmode THEN
  416.                                    BEGIN               {if unable to overlap
  417.                                                         disk i/o and comm i/o.}
  418.                                         send(XOFF);    {stop transmitter}
  419.                                         Delay(250);    {give it a chance}
  420.                                    END;
  421.                                    BLOCKWRITE(blkfile,dbuffer,bufnum,bresult);
  422.                                    IF wxmode AND pcjrmode THEN
  423.                                    BEGIN
  424.                                         Flush(blkfile); {complete all i/o}
  425.                                         send(XON);      {restart transmitter}
  426.                                    END;
  427.                                    IF bresult <> bufnum THEN
  428.                                    BEGIN
  429.                                         trwindow(8,'Disk write error');
  430.                                         GOTO 99;
  431.                                    END;
  432.                               END;              {End of disk write routine}
  433.                          END                    {good crc/checksum}
  434.                          ELSE
  435.                          BEGIN                  {bad crc/checksum}
  436.                               trwindow(5,'CRC/Checksum error');
  437.                               STR((blkcnt+1):6,statstr);
  438.                               trwindow(4,statstr);
  439.                               errors := errors + 1;
  440.                               STR(errors:3,statstr);
  441.                               trwindow(6,statstr);
  442.                               toterr := toterr + 1;
  443.                               purge;  {clear any garbage coming in}
  444.                               send(NAK);
  445.                               IF wxmode THEN
  446.                               BEGIN
  447.                                    send(sectcurr AND 3);
  448.                                    lignore := maxwindow;
  449.                               END;
  450. {                             write(trfile,' NAK CRC ',(sectcurr and 3):1);}
  451.                          END;                   {bad crc/checsum}
  452.                     END                         {good packet length}
  453.                     ELSE
  454.                     BEGIN                       {bad packet length}
  455.                          trwindow(5,'Short block error');
  456.                          STR((blkcnt+1):6,statstr);
  457.                          trwindow(4,statstr);
  458.                          errors := errors + 1;
  459.                          STR(errors:3,statstr);
  460.                          trwindow(6,statstr);
  461.                          toterr := toterr + 1;
  462.                          purge;   {clear any garbage}
  463.                          send(NAK);
  464.                          IF wxmode THEN
  465.                          BEGIN
  466.                               send(sectcurr AND 3);
  467.                               lignore := maxwindow;
  468.                          END;
  469.                          purge;   {clear any garbage}
  470. {                        write(trfile,' NAK SHORT ',(sectcurr and 3):1);}
  471.                     END;                        {bad packet length}
  472.                END                              {good block sequence number}
  473.                ELSE
  474.                BEGIN                            {invalid sequence number}
  475.                     IF lignore <= 0 THEN        {are we ignoring packets?}
  476.                     BEGIN
  477.                          trwindow(5,'Out of sequence');
  478.                          STR((blkcnt+1):6,statstr);
  479.                          trwindow(4,statstr);
  480.                          errors := errors + 1;
  481.                          STR(errors:3,statstr);
  482.                          trwindow(6,statstr);
  483.                          toterr := toterr + 1;
  484.                          purge;   {clear any garbage coming in}
  485.                          send(NAK);
  486.                          IF wxmode THEN
  487.                          BEGIN
  488.                               send((sectnum+1) AND 3);
  489.                               lignore := Maxwindow;
  490.                          END;
  491.                          purge;   {clear any garbage coming in}
  492. {                        write(trfile,' NAK SEQ ',((sectnum+1) and 3):1);}
  493.                     END
  494.                     ELSE lignore := lignore -1
  495.                END;                             {invalid sequence number}
  496.           END                                   {valid complement}
  497.           ELSE
  498.           BEGIN                                 {invalid complement}
  499.                trwindow(5,'Sequence complement error');
  500.                STR((blkcnt+1):6,statstr);
  501.                trwindow(4,statstr);
  502.                errors := errors + 1;
  503.                STR(errors:3,statstr);
  504.                trwindow(6,statstr);
  505.                toterr := toterr + 1;
  506.                purge;    {clear any garbage comming in}
  507.                send(NAK);
  508.                IF wxmode THEN
  509.                BEGIN
  510.                     send((sectnum+1) AND 3);
  511.                     lignore := Maxwindow;
  512.                END;
  513.                purge;    {clear any garbage comming in}
  514. {              write(trfile,' NAK CMP ',((sectnum + 1) and 3):1);}
  515.           END;                                  {invalid complement}
  516.        END                                      {process packet}
  517.        ELSE                                     {not start of packet}
  518.        BEGIN
  519.             CASE prevchar OF
  520.               EOT:   BEGIN
  521.                           IF firstchar=EOT THEN
  522.                           BEGIN
  523.                                EotFlag := TRUE;
  524.                                send(ACK);
  525.                           END;
  526.                      END;
  527.               CAN:   BEGIN
  528.                           IF firstchar=CAN THEN
  529.                           GOTO 99;
  530.                      END;
  531.             END;                                {Of case}
  532.             IF NOT EotFlag THEN
  533.             BEGIN
  534.                  IF firstchar=EOT THEN
  535.                  BEGIN
  536.                       send(NAK);  {first EOT received}
  537.                       trwindow(5,' First EOT received');
  538.                  END;
  539.                  prevchar := firstchar;
  540.                  firstchar := cgetc(15);        {start of packet!!!!}
  541.                  IF firstchar=-1 THEN
  542.                  BEGIN
  543.                       IF (prevchar=CAN) OR (prevchar=EOT) THEN
  544.                          firstchar := prevchar  {assume two have been received}
  545.                       ELSE
  546.                       BEGIN
  547.                            trwindow(5,'Timeout on start of packet');
  548.                            STR((blkcnt+1):6,statstr);
  549.                            trwindow(4,statstr);
  550.                            errors := errors + 1;
  551.                            STR(errors:3,statstr);
  552.                            trwindow(6,statstr);
  553.                            send(XON);
  554.                            toterr := toterr + 1;
  555.                            send(NAK);
  556.                            IF wxmode THEN
  557.                            BEGIN
  558.                                 send((sectnum+1) AND 3);
  559.                                 lignore := Maxwindow;
  560.                            END;
  561. {                          write(trfile,' NAK TIM ',((sectnum+1) and 3):1);}
  562.                       END;
  563.                  END;                           {Timeout at start of packet}
  564.                  IF scan(Extend,UserKey) THEN
  565.                       IF UserKey = CAN THEN GOTO 99;
  566.             END;                                {end of not EotFlag}
  567.          END;                                   {not start of packet}
  568.      END;                                       {xmodem loop}
  569.            {If there are any xmodem packets left in dbuffer, we had best
  570.             write them out}
  571.  
  572.      IF EotFlag AND (bufcurr>1) THEN
  573.      BEGIN
  574.           bufcurr := bufcurr - 1;
  575.           trwindow(8,'Writing final blocks');
  576.           IF wxmode AND pcjrmode THEN
  577.           BEGIN               {if unable to overlap
  578.                                disk i/o and comm i/o.}
  579.                send(XOFF);    {stop transmitter}
  580.                Delay(250);    {give it a chance}
  581.           END;
  582.           BLOCKWRITE(Blkfile,dbuffer,bufcurr,bresult);
  583.           IF wxmode AND pcjrmode THEN
  584.           BEGIN
  585.                Flush(blkfile); {complete all i/o}
  586.                send(XON);      {restart transmitter}
  587.           END;
  588.           IF bufcurr <> bresult THEN
  589.           BEGIN
  590.                trwindow(8,'Disk write error at end of receive');
  591.                EotFlag := FALSE;                {no longer a 'real' eot}
  592.           END;
  593.      END;
  594.  
  595.   99:
  596.      IF NOT Eotflag THEN
  597.      BEGIN
  598.           IF errors >= Maxerrs THEN
  599.                trwindow(8,'Maximum errors exceeded')
  600.           ELSE
  601.           IF UserKey = CAN THEN
  602.           BEGIN
  603.                trwindow(5,'^X entered');
  604.                send(CAN); send(CAN); send(CAN);
  605.           END;
  606.           IF firstchar = CAN THEN
  607.                trwindow(5,'Cancel received');
  608.           IF openflag THEN
  609.           BEGIN
  610.                {$I-} CLOSE(blkfile) {$I+};
  611.                i := IOResult;                     {clear ioresult}
  612.                {$I-} Erase(blkfile); {$I+}
  613.                i := IOResult;                     {clear ioresult}
  614.           END;
  615.      END;
  616.      trwindow(8,'Press any key to continue');
  617.      REPEAT
  618.      UNTIL (KeyPressed);
  619.      IF scan(Extend,UserKey) THEN;
  620.      trwindow(99,'  ');
  621.      status(2,'On-Line/Ready');
  622.      status(3,' ');
  623.      status(0,' ');
  624.      dbits        := db;
  625.      parity       := p;
  626.      stop_bits    := sb;
  627. {    close(trfile);}
  628.      update_uart;
  629. END;
  630.  
  631. PROCEDURE send_wcp;
  632. LABEL
  633.   tran,99;
  634. VAR
  635.    UserKey                    : Byte;
  636.    c, i, j, sectnum, errors   : INTEGER;
  637.    tblks, sblks, ackblks, rblks : INTEGER;        {total, sent, ack'd blocks}
  638.    twindow, awindow           : INTEGER;          {transmission window}
  639.    bresult, nblks, prevchar   : INTEGER;
  640.    bflag, canflag, xpause     : BOOLEAN;
  641.    extend                     : BOOLEAN;
  642.    blkfile                    : FILE;
  643.    statstr                    : bigstring;
  644.    xblk, ackseq               : INTEGER;
  645.    trfile                     : TEXT;
  646.  
  647. PROCEDURE checkack(tlimit : INTEGER);
  648.  
  649. VAR
  650. inchar  :   INTEGER;
  651.  
  652. BEGIN
  653.    REPEAT                                      {until no more data & timelimit}
  654.       inchar := cgetc(0);
  655.       IF inchar <> -1 THEN
  656.       BEGIN                                     {got a character}
  657.          IF wxmode THEN                         {wxmodem}
  658.          BEGIN
  659. {           write(trfile,inchar:4);}
  660.             CASE inchar OF
  661.                XOFF : BEGIN
  662.                          xpause := TRUE;
  663.                          txwindow(8,'Received - waiting');
  664.                       END;
  665.                XON  : BEGIN
  666.                          xpause := FALSE;
  667.                          txwindow(8,'No');
  668.                       END;
  669.                ACK, NAK, CAN :
  670.                       prevchar := inchar;       {save ACK/NAK/CAN}
  671.                0..3 : BEGIN                     {valid ACK/NAK sequence number}
  672.                          CASE prevchar OF
  673.                             ACK : BEGIN
  674.                                      ackseq := inchar - (ackblks AND twindow);
  675.                                      IF ackseq <= 0 THEN
  676.                                         ackseq := ackseq + maxwindow;
  677.                                      nblks := ackblks + ackseq;
  678.                                      IF nblks <= sblks THEN
  679.                                      BEGIN
  680.                                         ackblks := nblks;
  681.                                         STR(ackblks:4,statstr);
  682.                                         txwindow(6,statstr);
  683.                                         IF errors <> 0 THEN
  684.                                         BEGIN
  685.                                            errors := 0;
  686.                                            txwindow(10,'0');
  687.                                         END;
  688.                                      END;
  689. {                                    writeln(trfile,' ACK ',inchar:2,ackblks:5);}
  690.                                      prevchar := -1;
  691.                                   END;                 {case ACK}
  692.                             NAK : BEGIN
  693.                                      ackseq := inchar - (ackblks AND twindow);
  694.                                      IF ackseq <= 0 THEN
  695.                                         ackseq := ackseq + maxwindow;
  696.                                      nblks := ackblks + ackseq;
  697.                                      IF nblks <= sblks THEN
  698.                                      BEGIN
  699.                                         sblks := nblks - 1;
  700.                                         IF (sblks - ackblks) <= 2 THEN
  701.                                            ackblks := sblks;
  702.                                         STR(nblks:4,statstr);
  703.                                         txwindow(7,statstr);
  704.                                         STR(sblks:4,statstr);
  705.                                         txwindow(5,statstr);
  706.                                         errors := errors + 1;
  707.                                         STR(errors:3,statstr);
  708.                                         txwindow(10,statstr);
  709.                                      END
  710.                                      ELSE
  711.                                      BEGIN
  712.                                        GotoXY(3,12);
  713.                                        ClrEol;
  714.                                        WRITELN('Invalid NAK seq ',nblks:4,ackseq:4,inchar:3);
  715.                                      END;
  716. {                                    writeln(0tile,' NAK ',inchar:2,ackblks:5,sblks:5);}
  717.                                      prevchar := -1;
  718.                                   END;                 {case NAK}
  719.                             CAN : BEGIN
  720.                                      IF inchar = CAN THEN
  721.                                         canflag := TRUE;
  722.                                   END;
  723.                          END;                          {of case prevchar}
  724.                       END;                             {case 0..3}
  725.                ELSE                                    {of case inchar}
  726.                   prevchar := -1;       {inchar not XON/XOFF/ACK/NAK/CAN/0/1/2/3}
  727.             END;                                {of case inchar}
  728.          END                                    {wxmodem mode}
  729.          ELSE
  730.          BEGIN                                  {regular xmodem}
  731.             CASE inchar OF
  732.                ACK : BEGIN
  733.                         ackblks := ackblks + 1;
  734.                         errors  := 0;
  735.                      END;
  736.                NAK : BEGIN
  737.                         sblks   := sblks - 1;
  738.                         errors  := errors + 1;
  739.                      END;
  740.                CAN : BEGIN
  741.                         IF prevchar = CAN THEN
  742.                            canflag := TRUE;
  743.                         prevchar   := CAN;
  744.                      END;
  745.             ELSE     prevchar := inchar;
  746.             END;                                {end of case inchar}
  747.          END;                                   {regular xmodem}
  748.       END                                       {end of got a character}
  749.       ELSE                                      {no incoming data, inchar=-1}
  750.       BEGIN
  751.          IF tlimit > 0 THEN
  752.          BEGIN
  753.             Delay(1);
  754.             tlimit := tlimit - 1;
  755.          END;
  756.       END;                                      {end no incoming data}
  757.       IF scan(Extend,UserKey) THEN
  758.       BEGIN
  759.          IF UserKey = CAN THEN
  760.          BEGIN
  761.             canflag := TRUE;
  762.             tlimit  := 0;                       {force end of repeat}
  763.             inchar  := -1;                      { "    "   "  "     }
  764.             xpause  := FALSE;
  765.             purge;
  766.          END;
  767.       END;                                      {end of keypressed}
  768.    UNTIL (tlimit <= 0) AND (inchar = -1);       {repeat until nothing left}
  769. END;                                            {of procedure checkack}
  770.  
  771. PROCEDURE dlesend(c:INTEGER);
  772. VAR
  773.   j : INTEGER;
  774. BEGIN
  775.    IF wxmode THEN
  776.    BEGIN
  777.       IF buf_start <> buf_end THEN              {if there is any incoming data}
  778.          checkack(0);
  779.       WHILE xpause DO                           {X-Off received .. better wait}
  780.          BEGIN
  781.             j := 0;
  782.             REPEAT
  783.                checkack(0);
  784.                j := j + 1;
  785.                Delay(1);
  786.             UNTIL ((xpause = FALSE) OR (j = 10000));
  787.             IF xpause THEN                      {but not forever}
  788.             BEGIN
  789.                txwindow(8,'No - Timed Out');
  790.                xpause := FALSE;
  791.             END;
  792.          END;
  793.       CASE c OF
  794.          SYN, XON, XOFF, DLE :  BEGIN
  795.                                    send(DLE);
  796.                                    send(c XOr 64);
  797.                                 END;
  798.                             ELSE   send(c);
  799.       END;
  800.    END
  801.    ELSE send(c);                                {regular xmodem}
  802. END;
  803.  
  804.  
  805. BEGIN
  806.      status(2, 'SEND XMODEM');
  807.      SaveCommStatus;
  808.      openflag := FALSE;
  809. {    assign(trfile,'trace');}
  810. {    rewrite(trfile);}
  811.      OpenTemp(1,3,80,8,2);
  812.      REPEAT
  813.        WRITE('Enter a filename for upload file (<cr> to abort): ');
  814.        READLN(fname);
  815.        supcase(fname);
  816.        IF LENGTH(fname) > 0 THEN
  817.        BEGIN
  818.          bflag := exists(fname);
  819.          IF NOT bflag THEN
  820.          BEGIN
  821.            WRITELN('Could not open file ',fname);
  822.            WRITELN('(Spelling or drive designation wrong?)');
  823.            WRITELN
  824.          END
  825.        END
  826.     UNTIL bflag OR (LENGTH(fname) = 0);
  827.     CloseTemp;
  828.     IF LENGTH(fname) = 0 THEN
  829.       GOTO 99;
  830.     Assign(Blkfile,fname);
  831.     {I-} RESET(Blkfile); {I+}
  832.     IF IOResult <> 0 THEN
  833.        GOTO 99;
  834.     openflag := TRUE;
  835.     txwindow(1,fname);
  836.     tblks := TRUNC(LongFileSize(Blkfile));
  837.     STR((tblks)*22.3333333/speed:6:2,statstr);
  838.     txwindow(3,statstr);
  839.     STR(tblks:4,statstr);
  840.     txwindow(4,statstr);
  841.     txwindow(12,'Press ^X to abort transfer');
  842.     prevchar := -1;
  843.     sblks   := 0;                               {sent blks}
  844.     ackblks := 0;                               {ack'd blocks}
  845.     rblks   := 0;                               {highest read block}
  846.     errors  := 0;
  847.     canflag := FALSE;                           {not cancelled yet}
  848.     xpause  := FALSE;
  849.     UserKey := 0;
  850.  
  851.                       {Xmodem transmit protocol initialization}
  852.  
  853.     i := 0;
  854.     REPEAT
  855.       c := cgetc(1);
  856.       IF c <> -1 THEN
  857.       BEGIN                                     {we got a character!}
  858.            i := i + 1;                          {one of our 10 characters}
  859.            CASE c OF
  860.              NAK   :  BEGIN                     {Checksum Xmodem}
  861.                            crcmode := FALSE;
  862.                            wxmode  := FALSE;
  863.                            twindow := 0;
  864.                            txwindow(2,'Checksum Xmodem Send');
  865.                            GOTO tran;
  866.                       END;
  867.              CHARC :  BEGIN                     {CRC Xmodem}
  868.                            crcmode := TRUE;
  869.                            wxmode  := FALSE;
  870.                            twindow := 0;
  871.                            txwindow(2,'CRC Xmodem Send');
  872.                            GOTO tran;
  873.                       END;
  874.              CHARW :  BEGIN                     {WXmodem}
  875.                            crcmode := TRUE;
  876.                            wxmode  := TRUE;
  877.                            twindow := Maxwindow - 1;
  878.                            txwindow(2,'WXmodem Send');
  879.                            STR(Maxwindow:1,statstr);
  880.                            txwindow(9,statstr);
  881.                            GOTO tran;
  882.                       END;
  883.              CAN   :  BEGIN                     {Cancel request received}
  884.                            IF canflag THEN GOTO 99
  885.                            ELSE canflag := TRUE;
  886.                       END;
  887.            END;                                 {of case c}
  888.        END;                                     {got a character}
  889.  
  890.        IF scan(Extend, UserKey) THEN ;
  891.     UNTIL (i > 10) OR (UserKey = CAN);
  892.     IF UserKey = CAN THEN GOTO 99;
  893.     UserKey := 0;
  894.     txwindow(10,'Could not start: cancelled');
  895.     purge;
  896.     GOTO 99;
  897.  
  898. tran:                                           {let's send the file!}
  899.     awindow := twindow;
  900.     errors  := 0;
  901.               {Xmodem packet level loop}
  902.  
  903.     WHILE (ackblks < tblks) AND (errors <= MAXERRS) DO
  904.     BEGIN
  905.        i := 0;
  906.        WHILE (sblks - ackblks) > awindow DO     {is the ack window open?}
  907.        BEGIN                                    {no, so wait for ack/nak}
  908.           i := i + 1;
  909.           IF i <= 1 THEN
  910.           BEGIN
  911.              STR((awindow+1):1,statstr);
  912.              txwindow(9,CONCAT(statstr,' Closed'));
  913.           END;
  914.           checkack(50);                         {50*2400 = 120 seconds +}
  915.           IF canflag THEN
  916.              GOTO 99;
  917.           IF scan(Extend,UserKey) THEN
  918.              IF UserKey = CAN THEN
  919.                 GOTO 99;
  920.           IF i > 2400 THEN
  921.           BEGIN
  922.              txwindow(11,'Timeout for ack');
  923.              sblks := ackblks + 1;
  924.              IF sblks > tblks THEN
  925.                 GOTO 99;
  926.           END;
  927.           IF (sblks - ackblks) <= awindow THEN
  928.           BEGIN
  929.              STR((awindow+1):1,statstr);
  930.              txwindow(9,statstr);
  931.           END;
  932.        END;                                     {window closed}
  933.  
  934.        IF sblks < tblks THEN                    {is there anything left?}
  935.        BEGIN
  936.           awindow := twindow;                   {ack window is transmit window}
  937.                            {disk read routine}
  938.           sblks := sblks + 1;
  939.           xblk  := sblks;
  940.           WHILE (xblk > rblks) OR (xblk <= (rblks - bufnum)) DO
  941.           BEGIN
  942.              IF xblk < (rblks - bufnum) THEN    {if we got nak'd back}
  943.              BEGIN
  944.                 Seek(blkfile,(xblk-1));
  945.              END;
  946.              BLOCKREAD(blkfile,dbuffer,bufnum,bresult);
  947.              rblks := xblk + bufnum - 1;        {note rblks must go past eof}
  948.           END;                                  {end of disk read routine}
  949.  
  950.           j := bufnum - rblks + xblk;           {index of next packet}
  951.  
  952.           crcval := 0;
  953.           checksum := 0;
  954.           STR(xblk:4,statstr);
  955.           txwindow(5,statstr);
  956.           IF wxmode THEN
  957.           BEGIN
  958.              WHILE xpause DO
  959.                 BEGIN
  960.                   checkack(15);
  961.                   xpause := FALSE;
  962.                   txwindow(8,'No');
  963.                 END;
  964.              send(SYN);
  965.           END;
  966.           dlesend(SOH);
  967.           dlesend(xblk AND 255);                {block sequence}
  968.           dlesend((xblk AND 255) XOr 255);      {complement sequence}
  969.           FOR i := 1 TO 128 DO
  970.           BEGIN
  971.              c := dbuffer[j,i];
  972.              IF crcmode THEN updcrc(c)
  973.              ELSE checksum := (checksum + c) AND 255;
  974.              dlesend(c);
  975.           END;
  976.           IF crcmode THEN
  977.           BEGIN
  978.              dlesend(Hi(crcval));
  979.              dlesend(Lo(crcval));
  980.           END
  981.           ELSE
  982.              send(checksum);
  983.           IF canflag THEN
  984.              GOTO 99;
  985. {         writeln(trfile,'SENT ',sblks:5,xblk:5);}
  986.        END                                      {something to send}
  987.        ELSE
  988.        BEGIN                                    {nothing else to send}
  989.           IF wxmode THEN
  990.           BEGIN
  991.              awindow := sblks - ackblks - 1;    {wait for final acks}
  992.              STR(awindow:1,statstr);
  993.              txwindow(9,CONCAT(statstr,' -- Closing'));
  994.           END;
  995.        END;
  996.     END;                                        {xmodem send routine}
  997.  
  998.     REPEAT                                      {end of transmission}
  999.       send(EOT);
  1000.       UserKey := 0;
  1001.       REPEAT
  1002.         c := cgetc(15);
  1003.         IF scan(Extend,UserKey) THEN ;
  1004.       UNTIL (c <> -1) OR (UserKey = CAN);
  1005.  
  1006.       IF UserKey = CAN THEN GOTO 99;
  1007.       IF c = NAK THEN
  1008.       BEGIN
  1009.          errors := errors + 1;
  1010.          Delay(250);
  1011.       END;
  1012.     UNTIL (c = ACK) OR (errors = MAXERRS);
  1013.     IF errors = MAXERRS THEN
  1014.        txwindow(11,'ACK not received at EOT');
  1015.     99:
  1016. {   close(trfile);}
  1017.     IF openflag THEN
  1018.     BEGIN
  1019.        {$I-} CLOSE(blkfile) {$I+} ;
  1020.        i := IOResult;                           {clear ioresult}
  1021.     END;
  1022.     IF ((UserKey = CAN) OR canflag) AND (LENGTH(fname) > 0) THEN
  1023.     BEGIN
  1024.       txwindow(11,'Cancel-at your request');
  1025.       REPEAT
  1026.         send(CAN);
  1027.         send(CAN);
  1028.         purge
  1029.       UNTIL cgetc(1) = -1
  1030.     END;
  1031.     txwindow(12,'Press any key to continue');
  1032.     REPEAT
  1033.     UNTIL (KeyPressed);
  1034.     IF scan(Extend,UserKey) THEN;
  1035.     txwindow(99,'  ');
  1036.     status(2,'On-Line/Ready');
  1037.     status(3,' ');
  1038.     dbits        := db;
  1039.     parity       := p;
  1040.     stop_bits    := sb;
  1041.     update_uart
  1042. END;
  1043.