home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / intelrmx86 / recv.p86 < prev    next >
Text File  |  2020-01-01  |  6KB  |  305 lines
  1. /* RECEIVE: Routines for reading from the console and the serial ports */
  2. $compact
  3. $optimize(3)
  4.  
  5. recv$module:
  6. do;
  7.  
  8. $include(:INC:LTKSEL.LIT)
  9.  
  10. declare true literally '0FFH';
  11. declare false literally '00H';
  12.  
  13. declare null literally '00';
  14. declare cr literally '0DH';
  15. declare lf literally '0AH';
  16. declare crlf literally 'cr,lf,null';
  17. declare myquote literally '023H';
  18. declare chrmsk literally '07FH';
  19.  
  20. declare state byte;
  21. declare tries byte;
  22. declare msgnum byte;
  23. declare maxtry literally '5';
  24.  
  25. declare eol byte;
  26. declare debug byte external;
  27. declare iobuff(1024) byte external;
  28. declare status word external;
  29.  
  30. declare pksize literally '94';
  31. declare send$packet(pksize) byte external;
  32. declare recv$packet(pksize) byte external;
  33. declare count word;
  34. declare oldtry byte;
  35. declare byte$in dword;
  36.  
  37. declare file$conn token external;
  38. declare filename structure
  39.     (len byte,
  40.      name(80) byte) external;
  41. declare qopen byte external;
  42. declare dummy byte;
  43.  
  44. $include(:INC:USWBF.EXT)
  45. $include(:INC:UGTARG.EXT)
  46.  
  47. check$error: procedure(mode) byte external;
  48.     declare mode byte;
  49. end check$error;
  50.  
  51. file$open: procedure(mode) external;
  52.     declare mode byte;
  53. end file$open;
  54.  
  55. file$close: procedure external;
  56. end file$close;
  57.  
  58. co:    procedure(char)external;
  59.     declare char byte;
  60. end co;
  61.  
  62. print:  procedure(string)external;
  63.     declare string pointer;
  64. end print;
  65.  
  66. nout:     procedure(num)external;
  67.     declare num word;
  68. end nout;
  69.  
  70. noutd:     procedure(num)external;
  71.     declare num dword;
  72. end noutd;
  73.  
  74. newline: procedure external; end newline;
  75.  
  76. ctl:    procedure(char) byte external;
  77.     declare char byte;
  78. end ctl;
  79.  
  80. putc: procedure (c,conn) external;
  81.     declare c byte;
  82.     declare conn token;
  83. end putc;
  84.  
  85. do$put: procedure (conn) external;
  86.     declare conn token;
  87. end do$put;
  88.  
  89. spack:     procedure(type, pknum, length, packet) external;
  90.     declare (type, pknum, length) byte;
  91.     declare packet address;
  92. end spack;
  93.  
  94.  
  95. rpack:     procedure(length, pknum, packet) byte external;
  96.     declare (length, pknum, packet) address;
  97. end rpack;
  98.  
  99.  
  100. spar:    procedure (a) external;
  101.     declare a address;
  102. end spar;
  103.  
  104.  
  105. rpar:    procedure (a) external;
  106.     declare a address;
  107. end rpar;
  108.  
  109.  
  110. bufemp:    procedure(packet, len);
  111.     declare packet address;
  112.     declare inchar based packet byte;
  113.     declare (i, char, len) byte;
  114.  
  115.     if debug then call print(@('Writing to disk...',null));
  116.     i = 0;
  117.     do while (i < len);
  118.       char  = inchar;
  119.       if char = myquote then do;
  120.         packet = packet + 1;
  121.         i = i + 1;
  122.         char = inchar;
  123.         if (char and chrmsk) <> myquote then char = ctl(char);
  124.       end;
  125.       if debug then call co(char);
  126.       call putc(char,file$conn);
  127.       packet = packet + 1;
  128.       byte$in=byte$in+1;
  129.       i = i + 1;
  130.     end;
  131.     if debug then call newline;
  132.     call do$put(file$conn);
  133. end bufemp;
  134.  
  135.  
  136. rinit:     procedure byte public;
  137.     declare (len, num, retc) byte;
  138.  
  139.     if tries > maxtry then return 'A';
  140.     else tries = tries + 1;
  141.  
  142.     if debug then call print(@('rinit...',crlf));
  143.  
  144.     retc = rpack(.len, .num, .recv$packet);
  145.     if (retc <> 'S') then return state;
  146.     /* here on send init received */
  147.     call rpar(.recv$packet);
  148.     call spar(.send$packet);
  149.     call spack('Y', msgnum, 6, .send$packet);
  150.     oldtry = tries;
  151.     tries = 0;
  152.     byte$in=0;
  153.     msgnum = (msgnum + 1) mod 64;
  154.     return 'F';
  155. end rinit;
  156.  
  157.  
  158. rfile:    procedure byte public;
  159.     declare (len, num, retc) byte;
  160.  
  161.     if tries > maxtry then return 'A';
  162.     else tries = tries + 1;
  163.  
  164.     if debug then call print(@('rfile...',crlf));
  165.  
  166.     retc = rpack(.len, .num, .recv$packet);
  167.  
  168.     if retc = 'S' then do;
  169.       if (oldtry > maxtry) then return 'A';
  170.         else oldtry = oldtry + 1;
  171.       if (num = msgnum - 1) then
  172.         do;
  173.           call spar(.send$packet);
  174.            call spack('Y', num, 6 , .send$packet);
  175.           tries = 0;
  176.           return state;
  177.         end;
  178.       else return 'A';
  179.     end;
  180.  
  181.     if retc = 'Z' then do;
  182.       if (oldtry > maxtry) then return 'A';
  183.         else oldtry = oldtry + 1;
  184.       if (num = msgnum - 1) then
  185.         do;
  186.           call spack('Y', num, 0, 0);
  187.           tries = 0;
  188.           return state;
  189.         end;
  190.       else return 'A';
  191.     end;
  192.  
  193.     if retc = 'F' then do;
  194.       if (num <> msgnum) then return 'A';
  195.       call print(@(cr,lf,'Receiving ',null));
  196.       call print(@recv$packet);
  197.       call newline;
  198.       if not qopen then do;
  199.         dummy=DQ$SWITCH$BUFFER(@recv$packet,@status);
  200.         if check$error(0) then return 'A';
  201.         dummy=DQ$GET$ARGUMENT(@filename,@status);
  202.         if check$error(0) then return 'A';
  203.         call file$open(2);
  204.       end;
  205.       if not qopen then return 'A';
  206.       call spack('Y', msgnum, 0, 0);
  207.       oldtry = tries;
  208.       tries = 0;
  209.       msgnum = (msgnum + 1) mod 64;
  210.       return 'D';
  211.     end;
  212.  
  213.     if retc = 'B' then do;
  214.       if (num <> msgnum) then return 'A';
  215.       call spack('Y', msgnum, 0, 0);
  216.       return 'C';
  217.     end;
  218.  
  219.     return state;
  220. end rfile;
  221.  
  222.  
  223.  
  224. rdata:     procedure byte public;
  225.     declare (num, len, retc) byte;
  226.  
  227.     if tries > maxtry then return 'A';
  228.       else tries = tries + 1;
  229.  
  230.     if debug then call print(@('rdata...',crlf));
  231.  
  232.     retc = rpack(.len, .num, .recv$packet);
  233.  
  234.     if retc = 'D' then do;
  235.       if (num <> msgnum) then do;
  236.         if (oldtry > maxtry) then return 'A';
  237.           else oldtry = oldtry + 1;
  238.         if (num = msgnum - 1) then do;
  239.           call spar(.send$packet);
  240.           call spack('Y', num, 6, .send$packet);
  241.           tries = 0;
  242.           return state;
  243.         end;
  244.         else return 'A';
  245.       end;
  246.       call bufemp(.recv$packet, len);
  247.       call spack('Y', msgnum, 0, 0);
  248.       oldtry = tries;
  249.       tries = 0;
  250.         call print(@('recieved ',null));
  251.         call noutd(byte$in);
  252.         call print(@(' bytes ',cr,null));
  253.       msgnum = (msgnum + 1) mod 64;
  254.       return 'D';
  255.       end;
  256.  
  257.     if retc = 'F' then do;
  258.       if (oldtry > maxtry) then return 'A';
  259.         else oldtry = oldtry + 1;
  260.       if (num = msgnum - 1) then
  261.         do;
  262.           call spack('Y', num, 0, 0);
  263.           tries = 0;
  264.           return state;
  265.         end;
  266.       else return 'A';
  267.     end;
  268.  
  269.     if retc = 'Z' then do;
  270.       if (num <> msgnum) then return 'A';
  271.       call spack('Y', msgnum, 0, 0);
  272.       call file$close;
  273.       msgnum = (msgnum + 1) mod 64;
  274.       return 'F';
  275.     end;
  276.  
  277.     call spack('N', msgnum, 0, 0);
  278.     return state;
  279. end rdata;
  280.  
  281. recv$setup: procedure public;
  282.     state = 'R';
  283.     msgnum = 0;
  284.     tries = 0;
  285.     oldtry = 0;
  286. end recv$setup;
  287.  
  288. recv:   procedure byte public;
  289.  
  290.     if debug then call print(@('Receive a file',crlf));
  291.     call recv$setup;
  292.     do while true;
  293.       if state = 'D' then state = rdata;
  294.       else
  295.          if state = 'F' then state = rfile;
  296.          else
  297.             if state = 'R' then state = rinit;
  298.         else
  299.                 if state = 'C' then return true;
  300.             else return false;
  301.     end;
  302. end recv;
  303.  
  304. end recv$module;
  305.