home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / intelmdsa / md2rec.plm < prev    next >
Text File  |  2020-01-01  |  9KB  |  385 lines
  1. /* RECEIVE: Routines for reading from the console and the serial ports */
  2.  
  3.  
  4. recv$module:
  5. do;
  6.  
  7. declare true literally '0FFH';
  8. declare false literally '00H';
  9.  
  10. declare port1dat literally '0F4H';
  11. declare port1cmd literally '0F5H';
  12. declare port2dat literally '0F6H';
  13. declare port2cmd literally '0F7H';
  14. declare rx$rdy literally '02H';
  15.  
  16.  
  17. declare null literally '00';
  18. declare cr literally '0DH';
  19. declare lf literally '0AH';
  20. declare crlf literally 'cr,lf,null';
  21. declare myquote literally '023H';
  22. declare chrmsk literally '07FH';
  23.  
  24. declare writeonly literally '2';
  25. declare noedit literally '0';
  26.  
  27. declare state byte;
  28. declare tries byte;
  29. declare msgnum byte;
  30. declare maxtry literally '5';
  31.  
  32. declare eol byte;
  33. declare port byte external;
  34. declare driver byte external;
  35. declare debug byte external;
  36.  
  37. declare pksize literally '94';
  38. declare packet(pksize) byte external;
  39. declare (jfn, count, status) address;
  40. declare oldtry byte;
  41.  
  42.  
  43. ci:     procedure byte external;
  44. end ci;
  45.  
  46.  
  47. csts:   procedure byte external;
  48. end csts;
  49.  
  50.  
  51. co:     procedure(char)external;
  52.         declare char byte;
  53. end co;
  54.  
  55.  
  56. print:  procedure(string)external;
  57.         declare string address;
  58. end print;
  59.  
  60.  
  61. nout:   procedure(num)external;
  62.         declare num address;
  63. end nout;
  64.  
  65.  
  66. newline: procedure external; end newline;
  67.  
  68.  
  69. open:   procedure(jfn, file, access, mode, status) external;
  70.         declare (jfn, file, access, mode, status) address;
  71. end open;
  72.  
  73.  
  74. write:  procedure(jfn, buffer, count, status) external;
  75.         declare (jfn, buffer, count, status) address;
  76. end write;
  77.  
  78.  
  79. close:  procedure(jfn, status) external;
  80.         declare (jfn, status) address;
  81. end close;
  82.  
  83.  
  84. exit:   procedure external;
  85. end exit;
  86.  
  87.  
  88. getc:   procedure(port) byte external;
  89.         declare port byte;
  90. end getc;
  91.  
  92.  
  93. ctl:    procedure(char) byte external;
  94.         declare char byte;
  95. end ctl;
  96.  
  97.  
  98. spack:  procedure(type, pknum, length, packet) external;
  99.         declare (type, pknum, length, packet) address;
  100. end spack;
  101.  
  102.  
  103. rpack:  procedure(length, pknum, packet) byte external;
  104.         declare (length, pknum, packet) address;
  105. end rpack;
  106.  
  107.  
  108. spar:   procedure (a) external;
  109.         declare a address;
  110. end spar;
  111.  
  112.  
  113. rpar:   procedure (a) external;
  114.         declare a address;
  115. end rpar;
  116.  
  117.  
  118. ready:  procedure (port) byte public;
  119.         declare (port, status) byte;
  120.         do case port;
  121.           do;
  122.             status = csts;
  123.           end;
  124.           do;
  125.             status = input(port1cmd) and rx$rdy;
  126.           end;
  127.           do;
  128.             status = input(port2cmd) and rx$rdy;
  129.           end;
  130.         end;
  131.         return status;
  132. end ready;
  133.  
  134.  
  135. bufemp: procedure(packet, len);
  136.         declare packet address;
  137.         declare inchar based packet byte;
  138.         declare (i, char, len) byte;
  139.  
  140.         if debug then call print(.('Writing to disk...',null));
  141.         i = 0;
  142.         do while (i < len);
  143.           char  = inchar;
  144.           if char = myquote then do;
  145.             packet = packet + 1;
  146.             i = i + 1;
  147.             char = inchar;
  148.             if (char and chrmsk) <> myquote then char = ctl(char);
  149.           end;
  150.           if debug then call co(char);
  151.           call write(jfn, .char, 1, .status);
  152.           if status > 0 then do;
  153.             call print(.('Write error ',null));
  154.             call nout(status);
  155.             call newline;
  156.           call exit;
  157.           end;
  158.           packet = packet + 1;
  159.           i = i + 1;
  160.         end;
  161.         if debug then call newline;
  162. end bufemp;
  163.  
  164.  
  165. rinit:  procedure byte;
  166.         declare (len, num, retc) byte;
  167.  
  168.         if tries > maxtry then return 'A';
  169.         else tries = tries + 1;
  170.  
  171.         if debug then call print(.('rinit...',crlf));
  172.  
  173.         retc = rpack(.len, .num, .packet);
  174.         if (retc <> 'S') then return state;
  175.         /* here on send init received */
  176.         call rpar(.packet);
  177.         call spar(.packet);
  178.         call spack('Y', msgnum, 6, .packet);
  179.         oldtry = tries;
  180.         tries = 0;
  181.         msgnum = (msgnum + 1) mod 64;
  182.         return 'F';
  183. end rinit;
  184.  
  185.  
  186. /* to insert dirver address infront of filename */
  187.  
  188. insert : procedure(c,length);
  189.          declare (index,c,length) byte ;
  190.  
  191.          index = length;
  192.          do while (index <> 0FFH);
  193.             packet(index + 4) = packet(index);
  194.             index = index - 1 ;
  195.          end;
  196.          packet(0) = ':';
  197.          packet(1) = 'F';
  198.          packet(2) = c ;
  199.          packet(3) = ':';
  200.          length = length + 4;
  201. end insert;
  202.  
  203. rfile:  procedure byte;
  204.         declare (len, num, retc) byte;
  205.  
  206.         if tries > maxtry then return 'A';
  207.         else tries = tries + 1;
  208.  
  209.         if debug then call print(.('rfile...',crlf));
  210.  
  211.         retc = rpack(.len, .num, .packet);
  212.         if retc = 'S' then do;
  213.           if (oldtry > maxtry) then return 'A';
  214.             else oldtry = oldtry + 1;
  215.           if (num = msgnum - 1) then
  216.             do;
  217.               call spar(.packet);
  218.               call spack('Y', num, 6 , .packet);
  219.               tries = 0;
  220.               return state;
  221.             end;
  222.           else return 'A';
  223.         end;
  224.  
  225.         if retc = 'Z' then do;
  226.           if (oldtry > maxtry) then return 'A';
  227.             else oldtry = oldtry + 1;
  228.           if (num = msgnum - 1) then
  229.             do;
  230.               call spack('Y', num, 0, 0);
  231.               tries = 0;
  232.               return state;
  233.             end;
  234.           else return 'A';
  235.         end;
  236.  
  237.         if retc = 'F' then do;
  238.           if (num <> msgnum) then return 'A';
  239.           call print(.(cr,lf,'Receiving ',null));
  240.           call print(.packet);
  241.           call newline;
  242.           if len > 10 then
  243.            do;
  244.             call print(.('*** error **** $'));
  245.             call print(.('received filename has more than 6 characters',crlf));
  246.             return('A') ;
  247.            end;
  248.         if (driver < 5 ) then
  249.          do;
  250.           do case driver;
  251.              ; /* driver = 0 */
  252.              call insert('1',len); /* driver 1 */
  253.              call insert('2',len); /* driver 2 */
  254.              call insert('3',len); /* driver 3 */
  255.              call insert('4',len); /* driver 4 */
  256.           end ;
  257.         end;
  258.         else
  259.          do;
  260.            call print(.('disk driver number : 0|1|2|3|4 ',crlf));
  261.            return ('A') ;
  262.          end;
  263.           call open(.jfn, .packet, writeonly, noedit, .status);
  264.           if status > 0 then
  265.             do;
  266.               call print (.('Unable to create file, error ', null));
  267.               call nout(status);
  268.               call newline;
  269.               return 'A';
  270.             end;
  271.           call spack('Y', msgnum, 0, 0);
  272.           oldtry = tries;
  273.           tries = 0;
  274.           msgnum = (msgnum + 1) mod 64;
  275.           return 'D';
  276.         end;
  277.  
  278.         if retc = 'B' then do;
  279.           if (num <> msgnum) then return 'A';
  280.           call spack('Y', msgnum, 0, 0);
  281.           return 'C';
  282.         end;
  283.  
  284.         return state;
  285. end rfile;
  286.  
  287.  
  288.  
  289. rdata:  procedure byte;
  290.         declare (num, len, retc) byte;
  291.  
  292.         if tries > maxtry then return 'A';
  293.           else tries = tries + 1;
  294.  
  295.         if debug then call print(.('rdata...',crlf));
  296.  
  297.         retc = rpack(.len, .num, .packet);
  298.  
  299.         if retc = 'D' then do;
  300.           if (num <> msgnum) then do;
  301.             if (oldtry > maxtry) then return 'A';
  302.               else oldtry = oldtry + 1;
  303.             if (num = msgnum - 1) then do;
  304.               call spar(.packet);
  305.               call spack('Y', num, 6, .packet);
  306.               tries = 0;
  307.               return state;
  308.             end;
  309.             else return 'A';
  310.           end;
  311.           call bufemp(.packet, len);
  312.           call spack('Y', msgnum, 0, 0);
  313.           oldtry = tries;
  314.           tries = 0;
  315.           msgnum = (msgnum + 1) mod 64;
  316.           return 'D';
  317.         end;
  318.  
  319.         if retc = 'F' then do;
  320.           if (oldtry > maxtry) then return 'A';
  321.             else oldtry = oldtry + 1;
  322.           if (num = msgnum - 1) then
  323.             do;
  324.               call spack('Y', num, 0, 0);
  325.               tries = 0;
  326.               return state;
  327.             end;
  328.           else return 'A';
  329.         end;
  330.  
  331.         if retc = 'Z' then do;
  332.           if (num <> msgnum) then return 'A';
  333.           call spack('Y', msgnum, 0, 0);
  334.           call close(jfn, .status);
  335.           if status > 0 then call print(.(cr,lf,'Unable to close file',null));
  336.           msgnum = (msgnum + 1) mod 64;
  337.           return 'F';
  338.         end;
  339.  
  340.         return state;
  341. end rdata;
  342.  
  343.  
  344. recv:   procedure byte public;
  345.  
  346.         if debug then call print(.('Receive a file',crlf));
  347.         state = 'R';
  348.         msgnum = 0;
  349.         tries = 0;
  350.         oldtry = 0;
  351.         do while true;
  352.           if state = 'D' then state = rdata;
  353.           else
  354.              if state = 'F' then state = rfile;
  355.              else
  356.                 if state = 'R' then state = rinit;
  357.                 else
  358.                     if state = 'C' then return true;
  359.                     else return false;
  360.         end;
  361. end recv;
  362.  
  363. /* to receive a file from VAX when command GET is used  */
  364.  
  365. getrecv:   procedure byte public;
  366.  
  367.         if debug then call print(.('Receive a file',crlf));
  368.         state = 'F';
  369.         msgnum = 1;
  370.         tries = 0;
  371.         oldtry = 0;
  372.         do while true;
  373.           if state = 'D' then state = rdata;
  374.           else
  375.              if state = 'F' then state = rfile;
  376.              else
  377.                 if state = 'R' then state = rinit;
  378.                 else
  379.                     if state = 'C' then return ('W');
  380.                     else return false;
  381.         end;
  382. end getrecv;
  383.  
  384. end recv$module;
  385.