home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / intelmdsb / mdstak.p80 < prev    next >
Text File  |  2020-01-01  |  7KB  |  254 lines
  1. $TITLE ('TAKE - ROUTINES TO IMPLEMENT THE "TAKE" COMMAND')
  2. take$module:
  3.  
  4. /* COPYRIGHT (C) 1985, Trustees of Columbia University in the City of New */
  5. /* York.  Permission is granted to any individual or institution to use,  */
  6. /* copy, or redistribute this software so long as it is not sold for      */
  7. /* profit, provided this copyright notice is retained. */
  8.  
  9. /* Contains the following public routines: */
  10. /*      take, takehelp, takeini, takeline */
  11. do;
  12.  
  13. /* Global declarations */
  14.  
  15. declare true literally '0FFH';
  16. declare false literally '00H';
  17.  
  18. declare space literally '020H';
  19. declare cr literally '0DH';
  20. declare lf literally '0AH';
  21. declare null literally '00H';
  22. declare crlf literally 'cr,lf,null';
  23.  
  24. declare readonly literally '1';
  25. declare noedit literally '0';
  26.  
  27. declare def$drive(5) byte external;     /* the default local drive */
  28. declare debug byte external;
  29. declare taking byte external;           /* TRUE if TAKE in effect */
  30.  
  31. declare takeeof byte initial(false);
  32. declare lasttake byte initial(false);
  33. declare takefile(15) byte;              /* full name of the take file */
  34. declare (jfn, status) address;
  35. declare tbufsize literally '128';       /* Size of the TAKE file buffer */
  36. declare takebuff(tbufsize) byte;
  37. declare (nextchar, lastchar) byte;
  38.  
  39. /* Subroutines */
  40.  
  41. co:    procedure(char) external;
  42.     declare char byte;
  43. end co;
  44.  
  45. print:     procedure(string) external;
  46.     declare string address;
  47. end print;
  48.  
  49. ci:    procedure byte external;
  50. end ci;
  51.  
  52. open:     procedure(jfn, filenm, access, mode, status) external;
  53.     declare (jfn, filenm, access, mode, status) address;
  54. end open;
  55.  
  56. read:     procedure(jfn, buffer, count, actual, status) external;
  57.     declare (jfn, buffer, count, actual, status) address;
  58. end read;
  59.  
  60. close:     procedure(jfn, status) external;
  61.     declare (jfn, status) address;
  62. end close;
  63.  
  64. ready:     procedure(port) byte external;
  65.     declare (port) byte;
  66. end ready;
  67.  
  68. newline: procedure external; end newline;
  69.  
  70. token:  procedure address external; end token;
  71.  
  72. upcase:    procedure (addr) external;
  73.     declare addr address;
  74. end upcase;
  75.  
  76. movevar: procedure(offset, source, dest) byte external;
  77.     declare offset byte;
  78.     declare (source, dest) address;
  79. end movevar;
  80.  
  81. /* Close the TAKE file */
  82. closetake: procedure;
  83.     call close(jfn, .status);
  84.     if status > 0 then
  85.       call print(.('\Unable to close TAKE file\$'));
  86. end closetake;
  87.  
  88. /* Fill the TAKE buffer with the next block from the TAKE file */
  89. filltbuf: procedure;
  90.     declare count address;
  91.  
  92.     call read(jfn, .takebuff, tbufsize, .count, .status);
  93.     if status > 0 then
  94.       do;
  95.         call print(.('Error reading TAKE file\$'));
  96.         takeeof = true;
  97.       end;
  98.     else
  99.       do;
  100.         if count < tbufsize then lasttake = true;
  101.         nextchar = 0;
  102.         lastchar = count - 1;
  103.       end;
  104. end filltbuf;
  105.  
  106. /* TAKECHAR: Return to the caller a character from the TAKE file */
  107. /*   buffer.  This routine discards nulls but returns all other */
  108. /*   characters.  It returns a zero on end-of-file. */
  109. takechar: procedure byte;
  110.     declare retbyte byte;
  111.  
  112.     retbyte = 0;
  113.     do while (retbyte = 0 and takeeof = false);
  114.       if nextchar > lastchar then
  115.         do; /* The current buffer contents is exhausted */
  116.           if lasttake then /* This is the last (short) block */
  117.             takeeof = true;
  118.           call filltbuf; /* Refill the buffer */
  119.           if nextchar > lastchar then /* No more data */
  120.             takeeof = true;
  121.         end;
  122.       if takeeof then retbyte = 0;
  123.       else
  124.         do;
  125.           retbyte = takebuff(nextchar);
  126.           nextchar = nextchar + 1;
  127.         end;
  128.     end;
  129.     return retbyte;
  130. end takechar;
  131.  
  132.  
  133. /* TAKELINE: Return to the caller a command line from the TAKE file. */
  134. /*   This routine closes the TAKE file and resets TAKE mode on end */
  135. /*   of file. */
  136. takeline: procedure (bufaddr) public;
  137.     declare bufaddr address;
  138.     declare bufstart address;
  139.     declare bufchr based bufaddr byte;
  140.     declare nextbyte byte;
  141.  
  142.     bufstart = bufaddr; /* Save start of buffer */
  143.     nextbyte = takechar;
  144.     do while (nextbyte <> 0 and nextbyte <> cr);
  145.       bufchr = nextbyte;
  146.       bufaddr = bufaddr + 1;
  147.       nextbyte = takechar;
  148.     end;
  149.     bufchr = 0; /* Set stopper */
  150.     if nextbyte = cr then nextbyte = takechar; /* Discard LF */
  151.     /* Search for a semicolon (comment delimiter) in the TAKE file */
  152.     /*   command line */
  153.     bufaddr = bufstart;
  154.     do while (bufchr <> ';' and bufchr <> null);
  155.       bufaddr = bufaddr + 1;
  156.     end;
  157.     if bufchr = ';' then /* Found a semicolon */
  158.       /* Truncate the command at the semicolon in the following */
  159.       /*   cases: (1) The delimiter occurs in the 1st position of */
  160.       /*   record.  (2) The delimiter is preceded by a blank. */
  161.       do;
  162.         if bufaddr = bufstart then bufchr = null;
  163.         else
  164.           do;
  165.             bufaddr = bufaddr - 1; /* Check previous byte */
  166.             if bufchr = space then bufchr = null;
  167.           end;
  168.       end;
  169.     if takeeof then
  170.       do;
  171.         call closetake;
  172.         taking = false;
  173.       end;
  174. end takeline;
  175.  
  176. /* Initialize Kermit to take from the file KERMIT.INI */
  177. takeini: procedure public;
  178.     declare dummy byte;
  179.     dummy = movevar(0,.('KERMIT.INI',null),.takefile); /* Set up name */
  180.     call open(.jfn, .takefile, readonly, noedit, .status);
  181.     if (status = 0) then
  182.       do;
  183.         taking = true;
  184.         lasttake = false;
  185.         takeeof = false;
  186.         call filltbuf;
  187.       end;
  188. end takeini;
  189.  
  190. /* Display help for the TAKE command */
  191. takehelp: procedure public;
  192.     call print(.('\TAKE\\$'));
  193.     call print(.('  The TAKE command causes Kermit to read commands $'));
  194.     call print(.('from a specified file.\\$'));
  195.     call print(.('Syntax:\\$'));
  196.     call print(.('    TAKE file\\$'));
  197.     call print(.('If a TAKE command is encountered within a TAKE file, $'));
  198.     call print(.('the old TAKE file \$'));
  199.     call print(.('will be closed and the new one opened.\\$'));
  200. end takehelp;
  201.  
  202. take:   procedure public;
  203.     declare filename address;
  204.     declare foffset byte;
  205.     declare fnptr address;
  206.     declare fnchr based fnptr byte;
  207.  
  208.     filename = token;
  209.     if (filename = 0) then
  210.       call print(.('TAKE file not specified.\$'));
  211.     else
  212.       do;
  213.         if taking then
  214.           do; /* Close the prior TAKE file */
  215.             call closetake;
  216.             taking = false;
  217.           end;
  218.         call upcase(filename);
  219.         /* Crack the file name */
  220.         fnptr = filename;
  221.         if fnchr = ':' then
  222.           do; /* File name on command has a drive */
  223.             foffset = movevar(0,filename,.takefile); /* Use file name as-is */
  224.           end;
  225.         else
  226.           do;
  227.             foffset = movevar(0,.def$drive,.takefile); /* Build local file name */
  228.             foffset = movevar(foffset,filename,.takefile); /*  from default drive */
  229.           end;
  230.         if debug then
  231.           do;
  232.             call print(.(cr,lf,'TAKE file name is: $'));
  233.             call print(.takefile);
  234.             call newline;
  235.           end; /* debug */
  236.         call open(.jfn, .takefile, readonly, noedit, .status);
  237.         if (status > 0) then
  238.           do;
  239.             call print(.(cr,lf,'Cannot open TAKE file ',null));
  240.             call print(.takefile);
  241.             call print(.(crlf));
  242.           end;
  243.         else
  244.           do;
  245.             taking = true;
  246.             lasttake = false;
  247.             takeeof = false;
  248.             call filltbuf;
  249.           end;
  250.         end;
  251. end take;
  252.  
  253. end take$module;
  254.