home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / intelmdsa / md2sen.plm < prev   
Text File  |  2020-01-01  |  29KB  |  986 lines
  1. /* SEND MODULE: this module handles all sending of data between the     */
  2. /* host and development system                                          */
  3.  
  4.  
  5. send$module:
  6. do;
  7.  
  8. /* here are some global declarations for the communication module */
  9.  
  10. declare true literally '0FFH';
  11. declare false literally '00H';
  12. declare oldtry byte;
  13. declare port1cmd literally '0F5H';
  14. declare port2cmd literally '0F7H';
  15. declare port1dat literally '0F4H';
  16. declare port2dat literally '0F6H';
  17.  
  18. declare tx$rdy literally '01H';
  19. declare rx$rdy literally '02H';
  20. declare chrmsk literally '07FH';
  21.  
  22. declare maxtry literally '05';
  23. declare space literally '020H';
  24. declare cr literally '0DH';
  25. declare lf literally '0AH';
  26. declare null literally '00H';
  27. declare crlf literally 'cr,lf,null';
  28. declare soh literally '1';
  29. declare eofl literally '0';
  30. declare delete literally '07FH';
  31.  
  32. declare myquote literally '023H';
  33. declare mynumpads literally '0';
  34. declare mypadchr literally '0';
  35. declare myeol literally 'cr';
  36. declare mytime literally '5';
  37.  
  38. declare readonly literally '1';
  39. declare writeonly literally '2';
  40. declare rdwr literally '3';
  41. declare noedit literally '0';
  42.  
  43. declare pksize literally '94';
  44. declare packet(pksize) byte public;     /* buffer for packets */
  45.  
  46. declare state  byte;                    /* FSM last state */
  47. declare msgnum byte;                    /* message number */
  48. declare tries byte;                     /* max number of retries */
  49. declare numpads byte;                   /* how many pads to send */
  50. declare padchar byte;                   /* the present pad character */
  51. declare eol byte;                       /* the present eol character */
  52. declare quote byte;                     /* the present quote character */
  53. declare timeint byte;                   /* the present time out */
  54. declare spsize byte;                    /* the present packet size */
  55.  
  56. declare port byte external;             /* the port to use */
  57. declare filename address external;      /* the address of the filename */
  58. declare lfilename address external;      /* the address of the filename */
  59. declare (jfn, status, pklen) address;
  60. declare ljfn address;
  61. declare cmdptr address external;
  62. declare debug byte external;
  63.  
  64.  
  65.  
  66. /* here are the subroutines */
  67.  
  68. exit:   procedure external;
  69. end exit;
  70.  
  71. co:     procedure(char) external;
  72.         declare char byte;
  73. end co;
  74.  
  75.  
  76. print:  procedure(string) external;
  77.         declare string address;
  78. end print;
  79.  
  80.  
  81. nout:   procedure(n) external;
  82.         declare n address;
  83. end nout;
  84.  
  85. getrecv:   procedure byte external;
  86. end getrecv;
  87.  
  88.  
  89. ci:     procedure byte external;
  90. end ci;
  91.  
  92.  
  93. open:   procedure(jfn, filenm, access, mode, status) external;
  94.         declare (jfn, filenm, access, mode, status) address;
  95. end open;
  96.  
  97.  
  98. read:   procedure(jfn, buffer, count, actual, status) external;
  99.         declare (jfn, buffer, count, actual, status) address;
  100. end read;
  101.  
  102.  
  103. close:  procedure(jfn, status) external;
  104.         declare (jfn, status) address;
  105. end close;
  106.  
  107.  
  108. newline: procedure external; end newline;
  109.  
  110.  
  111. token:  procedure address external; end token;
  112.  
  113.  
  114. /* GNXTFN: this routine returns a pointer to the next file in a file    */
  115. /* list, or false if there are none.                                    */
  116.  
  117. gnxtfn: procedure address;
  118.         filename = token;
  119.         return (filename > 0);
  120. end gnxtfn;
  121.  
  122.  
  123. /* PUTC: takes a character and a port, waits for transmit ready from    */
  124. /* port and then sends the character to it.  Doesn't return a result    */
  125.  
  126. putc:   procedure (c, port) public;
  127.         declare (c, status, port) byte;
  128.  
  129.         status = 0;
  130.         do case port;
  131.           do;
  132.             call co(c);
  133.           end;
  134.           do;
  135.             do while (status := input(port1cmd) and tx$rdy) = 0; end;
  136.             output(port1dat) = c;
  137.           end;
  138.           do;
  139.             do while (status := input(port2cmd) and tx$rdy) = 0; end;
  140.             output(port2dat) = c;
  141.           end;
  142.         end;
  143. end putc;
  144.  
  145.  
  146. /* GETC: this routine waits for something from the receive port then    */
  147. /* brings in the character and returns as a result.                     */
  148.  
  149. getc:   procedure (port) byte public;
  150.         declare (c, status, port) byte;
  151.         status = 0;
  152.         do case port;
  153.           do;
  154.             c = ci;
  155.           end;
  156.           do;
  157.            do while status = 0;
  158.               status = (input(port1cmd) and rx$rdy);
  159.            end;
  160.             c = input(port1dat);
  161.           end;
  162.           do;
  163.             do while status = 0;
  164.              status = (input(port2cmd) and rx$rdy);
  165.             end;
  166.             c = input(port2dat);
  167.          end;
  168.         end;
  169.         return c;
  170. end getc;
  171.  
  172.  
  173. /* TOCHAR: takes a character and converts it to a printable character   */
  174. /*         by adding a space                                            */
  175.  
  176. tochar: procedure(char) byte public;
  177.         declare char byte;
  178.         return (char + space);
  179. end tochar;
  180.  
  181.  
  182. /* UNCHAR: undoes 'tochar' */
  183.  
  184. unchar: procedure(char) byte public;
  185.         declare char byte;
  186.         return (char - space);
  187. end unchar;
  188.  
  189.  
  190. /* CTL: this routine takes a character and toggles the control bit      */
  191. /* (ie. ^A becomes A and A becomes ^A).                                 */
  192.  
  193. ctl:    procedure(char) byte public;
  194.         declare char byte;
  195.         declare cntrlbit literally '040H';
  196.         return (char xor cntrlbit);
  197. end ctl;
  198.  
  199.  
  200. spar:   procedure (a) public;
  201.         declare a address;
  202.         declare b based a byte;
  203.  
  204.  
  205.         b = tochar(pksize);             /* set up header */
  206.         a = a + 1;
  207.         b = tochar(mytime);
  208.         a = a + 1;
  209.         b = tochar(mynumpads);
  210.         a = a + 1;
  211.         b = ctl(mypadchr);
  212.         a = a + 1;
  213.         b = tochar(myeol);
  214.         a = a + 1;
  215.         b = myquote;
  216. end spar;
  217.  
  218.  
  219. rpar:   procedure (addr) public;
  220.         declare addr address;
  221.         declare item based addr byte;
  222.  
  223.         spsize = unchar(item);          /* isn't plm wonderful? */
  224.         addr = addr + 1;
  225.         timeint = unchar(item);
  226.         addr = addr + 1;
  227.         numpads = unchar(item);
  228.         addr = addr + 1;
  229.         padchar = ctl(item);
  230.         addr = addr + 1;
  231.         eol = unchar(item);
  232.         addr = addr + 1;
  233.         quote = item;
  234. end rpar;
  235.  
  236.  
  237. bufill: procedure (packet) byte;
  238.         declare packet address;
  239.         declare (pp, maxpp) address;
  240.         declare (i, c, done) byte;
  241.         declare chr based pp byte;
  242.         declare count address;
  243.  
  244.         done = false;
  245.         pp = packet;
  246.         maxpp = pp + spsize - 8;
  247.         do while not done;
  248.           call read(jfn, .c, 1, .count, .status);
  249.           if status > 0 then
  250.             do;
  251.               call print(.('Error reading file',crlf));
  252.               call exit;
  253.             end;
  254.           if count = 0 then
  255.             done = true;
  256.           else do;
  257.             if ((c and chrmsk) < space) or
  258.                 ((c and chrmsk) = delete) then
  259.               do;
  260.                 chr = quote;
  261.                 pp = pp + 1;
  262.                 chr = ctl(c);
  263.               end;
  264.             else
  265.               if (c and chrmsk) = quote then
  266.                 do;
  267.                   chr = quote;
  268.                   pp = pp + 1;
  269.                   chr = c;
  270.                 end;
  271.               else
  272.                 chr = c;
  273.             pp = pp + 1;
  274.             if pp >= maxpp then done = true;
  275.           end;
  276.         end;
  277.         return (pp - packet);
  278. end bufill;
  279.  
  280.  
  281. /* SPACK: this routine sends a packet of data to the host, it takes     */
  282. /* four parameters, the type of packet, message number, packet length   */
  283. /* and a pointer to a buffer containing what is to be output. It does   */
  284. /* not return a value.                                                  */
  285.  
  286. spack:  procedure(type, pknum, length, packet) public;
  287.         declare (type, pknum, length) byte;
  288.         declare packet address;
  289.         declare char based packet byte;
  290.         declare (i, chksum) byte;
  291.  
  292.         if debug then do;
  293.           call print(.('Sending packet ',null));
  294.           call nout(pknum);
  295.           call newline;
  296.         end;
  297.  
  298.         i = 1;                                  /* do padding */
  299.         do while (i <= numpads);
  300.           call putc(padchar, port);
  301.           if debug then call co('p');
  302.           i = i + 1;
  303.         end;
  304.  
  305.         chksum = 0;
  306.         /* send the packet header */
  307.  
  308.         call putc(soh, port);                   /* send packet marker (soh) */
  309.         if debug then call co('s');
  310.         i = tochar(length + 3);
  311.         chksum = i;
  312.         call putc(i, port);                     /* send character count     */
  313.         if debug then call co('c');
  314.         i = tochar(pknum);
  315.         chksum = chksum + i;                    /* add in packet number     */
  316.         call putc(i, port);                     /* send packet number       */
  317.         if debug then call co('n');
  318.         chksum = chksum + type;                 /* add in packet type       */
  319.         call putc(type, port);                  /* send the packet type     */
  320.         if debug then call co(type);
  321.  
  322.         /* now send the data */
  323.         do i = 1 to length;
  324.           chksum = chksum + char;
  325.           call putc(char, port);
  326.           if debug then call co('.');
  327.           packet = packet + 1;
  328.         end;
  329.  
  330.         /* check sum generation */
  331.  
  332.         chksum = ((chksum + (chksum and 192) / 64) and 63);
  333.         chksum = tochar(chksum);
  334.         call putc(chksum, port);                /* send the chksum */
  335.         if debug then call co('c');
  336.  
  337.         call putc(eol, port);                   /* terminate the packet */
  338.         if debug then do;
  339.           call print(.('e',crlf));
  340.           call co('.');
  341.         end;
  342. end spack;
  343.  
  344.  
  345. /* RPACK: this routine receives a packet from the host.  It takes three */
  346. /* parameters: the address of where to put the length of the packet,    */
  347. /* the address of where to put the packet number and the address of the */
  348. /* buffer to recieve the data.  It returns true for a positive reply or */
  349. /* false for a NEGative reply.                                          */
  350.  
  351. rpack:  procedure(length, pknum, packet) byte public;
  352.         declare (length, pknum, packet, pkptr) address;
  353.  
  354.         declare len based length byte;
  355.         declare num based pknum byte;
  356.         declare pk based pkptr byte;
  357.         declare (i, index, chksum, hischksum, type, inchar, msglen) byte;
  358.  
  359.         declare buffer(128) byte;
  360.  
  361.         if debug then call print(.('rpack | ',null));
  362.  
  363.         inchar = 0;                     /* wait for a header */
  364.         do while inchar <> soh; inchar = getc(port); end;
  365.         index = 0;
  366.         inchar = getc(port);
  367.         do while (inchar <> myeol);
  368.           buffer(index) = inchar;
  369.           index = index + 1;
  370.           inchar = getc(port);
  371.         end;
  372.         buffer(index) = null;
  373.         if debug then do;
  374.         call print(.('Received packet: [',null));
  375.         call print(.buffer);
  376.         call print(.(']',cr,lf,'Length of message: ',null));
  377.         end;
  378.         msglen = index - 1;
  379.         if debug then do;
  380.         call nout(msglen);
  381.         call newline;
  382.         call print(.('Length field: ',null));
  383.         call nout(buffer(0));
  384.         call co('_');
  385.         end;
  386.         len = unchar(buffer(0)-3);
  387.         if debug then do;
  388.         call nout(len);
  389.         call print(.(cr,lf,'Message number: ',null));
  390.         call nout(buffer(1));
  391.         call co('_');
  392.         end;
  393.         num = unchar(buffer(1));
  394.         if debug then do;
  395.         call nout(num);
  396.         call print(.(cr,lf,'Type: ',null));
  397.         end;
  398.         type = buffer(2);
  399.         if debug then do;
  400.         call co(type);
  401.         call newline;
  402.         end; /* debug */
  403.  
  404.         pkptr = packet;
  405.         chksum = buffer(0) + buffer(1) + buffer(2);
  406.  
  407.         i = 3;                          /* index of first data character */
  408.         do while (i < msglen);
  409.           chksum = (pk := buffer(i)) + chksum;
  410.           pkptr = pkptr+1;
  411.           i = i + 1;
  412.         end;
  413.         pk = null;              /* terminate with null for printing */
  414.  
  415.         chksum = (chksum + ((chksum and 192) / 64)) and 63;
  416.  
  417.         if debug then do;
  418.         call print(.('His checksum: ',null));
  419.         call nout(buffer(msglen));
  420.         call co('_');
  421.         end; /* debug */
  422.         hischksum = unchar(buffer(msglen));
  423.         if debug then do;
  424.         call nout(hischksum);
  425.         call print(.(cr,lf,'Our checksum: ',null));
  426.         call nout(chksum);
  427.         call newline;
  428.         end; /* debug */
  429.         if chksum = hischksum then do;
  430.           if debug then call co('.');
  431.           return type;
  432.         end;
  433.         call print(.('Bad checksum received', crlf));
  434.         return false;
  435. end rpack;
  436.  
  437.  
  438.  
  439.  
  440. /* SDATA: this routine sends the data from the buffer area to the host. */
  441. /* It takes no parameters but returns the next state depending on the   */
  442. /* type of acknowledgement.                                             */
  443.  
  444. sdata:  procedure byte;
  445.         declare (num, length, retc) byte;
  446.  
  447.         if debug then call print(.('sdata...',crlf));
  448.  
  449.         if tries > maxtry then return 'A';
  450.           else tries = tries + 1;
  451.  
  452.         call spack('D', msgnum, pklen, .packet);
  453.         retc = rpack(.length, .num, .packet);
  454.         if (retc = 'N') then return state;
  455.         if (retc <> 'Y') then return 'A';
  456.         /* here when good acknowledgement */
  457.         tries = 0;
  458.         msgnum = (msgnum + 1) mod 64;
  459.         pklen = bufill(.packet);
  460.         if pklen > 0 then return 'D';
  461.           else return 'Z';
  462. end sdata;
  463.  
  464.  
  465. /* SFILE: this routine sends a packet to the host which contains the    */
  466. /* filename of the file being sent so that the file can be created at   */
  467. /* the host end. It returns a new state depending on the nature of the  */
  468. /* the hosts acknowledgement.                                           */
  469.  
  470. sfile:  procedure byte;
  471.         declare (char,num, length, retc) byte;
  472.         declare fnptr address;
  473.         declare fnindex based fnptr byte;
  474.  
  475.         if debug then call print(.('sfile...',crlf));
  476.  
  477.         if tries > maxtry then return 'A';
  478.           else tries = tries + 1;
  479.  
  480.         length = 0;                     /* count characters in filename */
  481.         fnptr = filename;
  482.         char = fnindex;
  483.         do while fnindex > space;
  484.           length = length + 1;
  485.           fnptr = fnptr + 1;
  486.         end;
  487.         if debug then call print(.(cr,lf,'Filename is: ',null));
  488.         call print(filename);
  489.         if debug then do;
  490.         call print(.(cr,lf,'length is: ',null));
  491.         call nout(length);
  492.         call newline;
  493.         end; /* debug */
  494.         if ( char = ':' ) then do;
  495.            filename = filename + 4;
  496.            length = length - 4;
  497.         end; /* if */
  498.         call spack('F', msgnum, length, filename);
  499.         retc = rpack(.length, .num, .packet);
  500.  
  501.         if (retc = 'N') then return state;
  502.         if (retc <> 'Y') then return 'A';
  503.         /* here on valid acknowledgement */
  504.         tries = 0;
  505.         msgnum = (msgnum + 1) mod 64;
  506.         pklen = bufill(.packet);
  507.         if pklen > 0 then return 'D';
  508.           else return 'Z';
  509. end sfile;
  510.  
  511.  
  512. /* SEOF: this routine is used when eof is detected, it closes up and    */
  513. /* returns the new state as usual.                                      */
  514.  
  515. seof:   procedure byte;
  516.         declare (num, length, retc) byte;
  517.  
  518.         if debug then call print(.('seof...',crlf));
  519.  
  520.         if tries > maxtry then return 'A';
  521.           else tries = tries + 1;
  522.  
  523.         call spack('Z', msgnum, 0, .packet);
  524.         retc = rpack(.length, .num, .packet);
  525.         if (retc = 'N') then return state;
  526.         if (retc <> 'Y') then return 'A';
  527.         /* here on valid acknowledgement */
  528.         tries = 0;
  529.         call close(jfn, .status);
  530.         if status > 0 then call print(.('Unable to close file',crlf));
  531.         if gnxtfn = false then
  532.           do;
  533.             msgnum = (msgnum + 1) mod 64;
  534.             return 'B';
  535.           end;
  536.         else return 'S';
  537. end seof;
  538.  
  539.  
  540. /* SINIT: this routine does initialisations and opens the file to be    */
  541. /* send, it returns a new state depending on the outcome of trying to   */
  542. /* open the file.                                                       */
  543.  
  544. sinit:  procedure byte;
  545.         declare (len, num, retc) byte;
  546.  
  547.         call print(.(cr,lf,'Sending ',null));
  548.  
  549.         if debug then call print(.('sinit...',crlf));
  550.  
  551.         if tries  > maxtry then return 'A';
  552.           else tries = tries + 1;
  553.  
  554.         if filename = 0 then return 'A';
  555.         call spar(.packet);
  556.         call spack('S', msgnum, 6, .packet);    /* send start packet */
  557.  
  558.         retc = rpack(.len, .num, .packet);
  559.         if (retc = 'N') then return state;
  560.         if (retc <> 'Y') then return 'A';
  561.         /* here on valid acknowledgement */
  562.         call rpar(.packet);
  563.         if eol = 0 then eol = myeol;
  564.         if quote = 0 then quote = myquote;
  565.         tries = 0;
  566.         msgnum = (msgnum + 1) mod 64;
  567.         call open(.jfn, filename, readonly, noedit, .status);
  568.         if (status > 0) then return 'A';
  569.           else return 'F';
  570. end sinit;
  571.  
  572. /* this routine sends a command to the VAX to shut down
  573.    the SERVER mode
  574. */
  575. sfini:  procedure byte;
  576.         declare (len, num, retc) byte;
  577.  
  578.         if debug then call print(.('sinit...',crlf));
  579.         if tries  > maxtry then return 'A';
  580.           else tries = tries + 1;
  581.  
  582.         call spar(.packet);
  583.         call spack('G', msgnum, 1, .('F'));    /* send start packet */
  584.  
  585.         retc = rpack(.len, .num, .packet);
  586.         if (retc = 'N') then return state;
  587.         if (retc <> 'Y') then return 'A';
  588.         /* here on valid acknowledgement */
  589.         call rpar(.packet);
  590.         if eol = 0 then eol = myeol;
  591.         if quote = 0 then quote = myquote;
  592.         tries = 0;
  593.         msgnum = (msgnum + 1) mod 64;
  594.         return 'W';
  595. end sfini;
  596.  
  597. /* this routine sends a command to the VAX to log out
  598.    the VAX itself
  599. */
  600.  
  601. sbye:  procedure byte;
  602.         declare (len, num, retc) byte;
  603.  
  604.         if debug then call print(.('sinit...',crlf));
  605.  
  606.         if tries  > maxtry then return 'A';
  607.           else tries = tries + 1;
  608.  
  609.         call spar(.packet);
  610.         call spack('G', msgnum, 1, .('L'));    /* send start packet */
  611.  
  612.         retc = rpack(.len, .num, .packet);
  613.         if (retc = 'N') then return state;
  614.         if (retc <> 'Y') then return 'A';
  615.         /* here on valid acknowledgement */
  616.         call rpar(.packet);
  617.         if eol = 0 then eol = myeol;
  618.         if quote = 0 then quote = myquote;
  619.         tries = 0;
  620.         msgnum = (msgnum + 1) mod 64;
  621.         return 'W';
  622. end sbye;
  623.  
  624. sget:   procedure byte;
  625.         declare (len, num, retc) byte,
  626.                 pp   address,
  627.                 cch based pp byte;
  628.  
  629.         if debug then call print(.('sinit...',crlf));
  630.  
  631.         if tries  > maxtry then return 'A';
  632.           else tries = tries + 1;
  633.  
  634.         if filename = 0 then return 'A';
  635.         else do;
  636.            pp = filename;
  637.            /* check the length of filename */
  638.            if cch = '[' then do;
  639.               do while cch <> ']';
  640.                  pp = pp + 1;
  641.               end;
  642.            end;
  643.            do while cch <> '.';
  644.               pp = pp + 1;
  645.            end;
  646.         end;
  647.         len = pp - filename + 4;
  648.         call spack('R', msgnum, len, filename);    /* send start packet */
  649.         retc = rpack(.len, .num, .packet);
  650.  
  651.         if (retc <> 'S') then return state;
  652.         /* here on send init received */
  653.         call rpar(.packet);
  654.         call spar(.packet);
  655.         call spack('Y', msgnum, 6, .packet);
  656.         oldtry = tries;
  657.         tries = 0;
  658.         msgnum = (msgnum + 1) mod 64;
  659.         return 'F';
  660. end sget;
  661.  
  662. scwd:   procedure byte;
  663.         declare (len, num, retc) byte,
  664.                 i byte,
  665.                 dir (20) byte,
  666.                 pp   address,
  667.                 cch based pp byte;
  668.  
  669.         if debug then call print(.('sinit...',crlf));
  670.  
  671.         if tries  > maxtry then return 'A';
  672.           else tries = tries + 1;
  673.         pp = filename;
  674.         dir(0) = 'C';
  675.         i = 2;
  676.         if filename > 0 then
  677.          do;
  678.            do while cch <> 0;
  679.                  dir(i) = cch;
  680.                  pp = pp + 1;
  681.                  i = i + 1;
  682.            end;
  683.         end;
  684.         dir(i) = 0;
  685.         len = pp - filename + 2;
  686.         dir(1) = len + 32;
  687.         filename = .dir;
  688.         call spack('G', msgnum, len, filename);    /* send start packet */
  689.         retc = rpack(.len, .num, .packet);
  690.  
  691.         if (retc = 'N') then return state;
  692.         if (retc <> 'Y') then return 'A';
  693.         /* here on valid acknowledgement */
  694.         call rpar(.packet);
  695.         if eol = 0 then eol = myeol;
  696.         if quote = 0 then quote = myquote;
  697.         tries = 0;
  698.         msgnum = (msgnum + 1) mod 64;
  699.         return 'W';
  700. end scwd;
  701.  
  702.  
  703. /* SBREAK: this module breaks the flow of control at the end of a       */
  704. /* transmission and allows the send routine to terminate by returning   */
  705. /* either a successful or failure condition to the main kermit routine. */
  706.  
  707. sbreak: procedure byte;
  708.         declare (num, length, retc) byte;
  709.  
  710.         if debug then call print(.('sbreak...',crlf));
  711.  
  712.         if tries > maxtry then return 'A';
  713.           else tries = tries + 1;
  714.  
  715.         call spack('B', msgnum, 0, .packet);
  716.         retc = rpack(.length, .num, .packet);
  717.  
  718.         if (retc = 'N') then return state;
  719.         if (retc <> 'Y') then return 'A';
  720.         /* we only get here if we received a valid acknowledgement */
  721.         tries = 0;
  722.         msgnum = (msgnum + 1) mod 64;
  723.         return 'C';
  724. end sbreak;
  725.  
  726.  
  727. /* SEND: here's the main code for the send command, it's a FSM for      */
  728. /* sending files. The main loop calles various routines until it        */
  729. /* finishes or an error occurs; this is signified by a true or false    */
  730. /* result being returned to the main 'kermit' routine.                  */
  731.  
  732. send:   procedure byte public;
  733.         declare filename address;
  734.  
  735.         state = 'S';                            /* start in Send-Init state */
  736.         msgnum = 0;
  737.         tries = 0;
  738.  
  739.         spsize = pksize;
  740.         timeint = mytime;
  741.         numpads = mynumpads;
  742.         padchar = mypadchr;
  743.         eol = myeol;
  744.         quote = myquote;
  745.  
  746.         do while true;
  747.           if debug then
  748.             do;
  749.               call print(.('state : ',null));
  750.               call co(state);
  751.               call newline;
  752.             end;
  753.           if state = 'D' then state = sdata;
  754.           else
  755.             if state = 'F' then state = sfile;
  756.             else
  757.               if state = 'Z' then state = seof;
  758.               else
  759.                 if state = 'S' then state = sinit;
  760.                 else
  761.                   if state = 'B' then state = sbreak;
  762.                   else
  763.                     if state = 'C' then return true;
  764.                     else
  765.                       if state = 'A' then return false;
  766.                       else return false;
  767.         end;
  768. end send;
  769.  
  770.  
  771. /* this routine will get a file from VAX when VAX-KERMIT is in
  772.    SERVER mode .
  773. */
  774. get:    procedure byte public;
  775.  
  776.         state = 'R';                            /* start in Get-Init state */
  777.         msgnum = 0;
  778.         tries = 0;
  779.  
  780.         spsize = pksize;
  781.         timeint = mytime;
  782.         numpads = mynumpads;
  783.         padchar = mypadchr;
  784.         eol = myeol;
  785.         quote = myquote;
  786.  
  787.         do while true;
  788.           if debug then
  789.             do;
  790.               call print(.('state : ',null));
  791.               call co(state);
  792.               call newline;
  793.             end;
  794.           if state = 'F' then state = getrecv;
  795.              else
  796.                if state = 'R' then state = sget;
  797.                 else
  798.                   if state = 'W' then return true;
  799.                 else
  800.                   if state = 'A' then return false;
  801.                     else return false;
  802.         end;
  803. end get;
  804.  
  805. /* this routine is used to change working directory of
  806.    VAX when VAX-KERMIT is in SERVER mode .
  807. */
  808. cwd: procedure byte public;
  809.  
  810.         state = 'C';
  811.         msgnum = 0;
  812.         tries = 0;
  813.  
  814.         spsize = pksize;
  815.         timeint = mytime;
  816.         numpads = mynumpads;
  817.         padchar = mypadchr;
  818.         eol = myeol;
  819.         quote = myquote;
  820.  
  821.         do while true;
  822.           if debug then
  823.             do;
  824.               call print(.('state : ',null));
  825.               call co(state);
  826.               call newline;
  827.             end;
  828.           if state = 'C' then state = scwd;
  829.              else
  830.                if state = 'W' then
  831.                 do;
  832.                  call print(.('  DIRECTORY SYSUSERS:$'));
  833.                  filename = filename + 2;
  834.                  call print(filename);
  835.                  return true;
  836.                end;
  837.                  else
  838.                   if state = 'A' then return false;
  839.                     else return false;
  840.         end;
  841. end cwd;
  842.  
  843. /* This routine is used to exit from VAX-KERMIT
  844.    When VAX-KERMIT is in SERVER mode
  845. */
  846. finish:    procedure byte public;
  847.  
  848.         state = 'F';
  849.         msgnum = 0;
  850.         tries = 0;
  851.  
  852.         spsize = pksize;
  853.         timeint = mytime;
  854.         numpads = mynumpads;
  855.         padchar = mypadchr;
  856.         eol = myeol;
  857.         quote = myquote;
  858.  
  859.         do while true;
  860.           if debug then
  861.             do;
  862.               call print(.('state : ',null));
  863.               call co(state);
  864.               call newline;
  865.             end;
  866.           if state = 'F' then state = sfini;
  867.              else
  868.                if state = 'W' then return true;
  869.                  else
  870.                   if state = 'A' then return false;
  871.                     else return false;
  872.         end;
  873. end finish;
  874.  
  875. /* This routine is used to logout from VAX
  876.    When VAX-KERMIT is in SERVER mode
  877. */
  878. bye:    procedure byte public;
  879.  
  880.         state = 'L';
  881.         msgnum = 0;
  882.         tries = 0;
  883.  
  884.         spsize = pksize;
  885.         timeint = mytime;
  886.         numpads = mynumpads;
  887.         padchar = mypadchr;
  888.         eol = myeol;
  889.         quote = myquote;
  890.  
  891.         do while true;
  892.           if debug then
  893.             do;
  894.               call print(.('state : ',null));
  895.               call co(state);
  896.               call newline;
  897.             end;
  898.           if state = 'L' then state = sbye;
  899.              else
  900.                if state = 'W' then return true;
  901.                  else
  902.                   if state = 'A' then return false;
  903.                     else return false;
  904.         end;
  905. end bye;
  906.  
  907. /* this routine is used to send files from MDS to VAX
  908.    when there are a lot of transmitted files involved.
  909.    The argument of LSEND command is the name of a file
  910.    which contains names of files to be sent to VAX .
  911.    In this file , filenames are seperated by at least
  912.    one space or a carage return .
  913. */
  914. lsend:   procedure byte public;
  915.  
  916.         declare
  917.                 (lcount,index,ltlength)  address,
  918.                 (ch,lstatus,lstate,flag)  byte,
  919.                 pp address,
  920.                 buff (2000) byte;
  921.  
  922.           lstate = 'L';                        /* start in Send-Init state */
  923.           if debug then
  924.             do;
  925.               call print(.('lstate : ',null));
  926.               call co(lstate);
  927.               call newline;
  928.             end;
  929.             call open(.ljfn,lfilename,readonly,noedit,.lstatus);
  930.           if (lstatus > 0 ) then do;
  931.                 call print(.('unable to open list file',crlf));
  932.                 return false;
  933.           end;
  934.  
  935.           ltlength = 0;
  936.           flag = true ;
  937.           do while flag; /* read filename into buffer */
  938.              call read(ljfn, .buff(ltlength), 100, .lcount, .lstatus);
  939.              if lstatus > 0 then do ;
  940.                 call print(.('unable to read list file',crlf));
  941.                 call exit;
  942.              end;
  943.              ltlength = ltlength + lcount;
  944.              if lcount = 0   then   /* stop reading  */
  945.                 flag = false;
  946.  
  947.          end; /* while */
  948.  
  949.              index = 0;
  950.              /* replace carage return , line feed by space  */
  951.              do while (index <= ltlength );
  952.                 ch = buff(index);
  953.                 if ((ch = cr) or (ch = lf)) then
  954.                    buff(index) = space;
  955.                 index = index + 1;
  956.              end;/* while*/
  957.  
  958.           buff(ltlength) = 0;
  959.           call close(ljfn,.lstatus);
  960.           if lstatus > 0 then do;
  961.              call print(.('unable to close list file',crlf));
  962.              call exit;
  963.           end;
  964.           cmdptr = .buff;
  965.           filename = token;
  966.           flag = true;
  967.  
  968.           do while flag ;
  969.              if send then
  970.                 call print(.('file sent : OK ',crlf));
  971.              else do;
  972.                 call print(.('send failed :  '));
  973.                 call print(filename);
  974.                 if gnxtfn = false
  975.                 then
  976.                  do;
  977.                     flag = false;
  978.                     return true;
  979.                  end;/* if*/
  980.              end ;/* else */
  981.           end;/* while */
  982.  
  983. end lsend;
  984.  
  985. end send$module;
  986.