home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / WXM_TERM.ZIP / WXTMXFER.INC < prev   
Encoding:
Text File  |  1986-10-16  |  40.4 KB  |  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.