home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol140 / remake.pli < prev    next >
Encoding:
Text File  |  1984-04-29  |  4.3 KB  |  155 lines
  1. remake:
  2.     proc options(main);
  3.  
  4. /****************************************************************
  5. *                                                               *
  6. *    Compiler manager Revision 1.1. Makes $$$.SUB file with     *
  7. *      unnecessary compiles, libs and links commented out.      *
  8. *                 Written by Les Bell, 3/21/83                  *
  9. *                                                               *
  10. *       Revised to 1.2, with separate procedures 3/28/83        *
  11. *    Rev 1.3 fixed a few phurphies, made word2 more elegant     *
  12. *                                                               *
  13. ****************************************************************/
  14.  
  15.     %replace
  16.         true   by '1'b,
  17.         false  by '0'b,
  18.         nfiles by 10,
  19.         ndels  by 8,
  20.         vernum by 1.2;
  21.  
  22.     dcl
  23.         filename(1:nfiles) char (15) var static,
  24.         upper char(36) static initial
  25.             ('ABCDEFGHIJKLMNOPQRSTUVWXYZ '),
  26.         lower char(36) static initial
  27.             ('abcdefghijklmnopqrstuvwxyz '),
  28.         delims (ndels) char (1) static initial
  29.             (' ','[','=',',','<','(','.','^M');
  30.  
  31.     dcl
  32.         linbuf char(128) var;
  33.  
  34.     dcl
  35.         (count,lastword) fixed;
  36.  
  37.     dcl
  38.         sysin file,
  39.         (infile,outfile) file,
  40.         eofile bit (1) static init (false);
  41.  
  42.     put skip list ('Compiler Manager Revision',vernum);
  43.  
  44.     call getnames;
  45.     call pass1;
  46.     call pass2;
  47.  
  48.     getnames:
  49.         proc;        /* Get list of altered filenames */
  50.  
  51.         dcl eoinp bit (1) static init (false);
  52.  
  53.         on endfile (sysin) eoinp = true;
  54.  
  55.         put skip list ('Input list of altered files, then ^^Z;');
  56.         put skip;
  57.         do lastword = 1 repeat (lastword + 1) while (^eoinp);
  58.             get list (filename(lastword));
  59.             filename(lastword) =
  60.                     translate(filename(lastword),upper,lower);
  61.         end;
  62.     end getnames;
  63.  
  64.     pass1:
  65.         proc;
  66.  
  67.         /* First pass through file, count lines */
  68.  
  69.         open file (infile) input stream title ('$1.SUB');
  70.         on endfile (infile) eofile = true;
  71.  
  72.         read file (infile) into (linbuf);
  73.         do count = 0 repeat (count + 1) while(^eofile);
  74.             read file (infile) into (linbuf);
  75.         end;
  76.         close file (infile);
  77.         eofile = false;
  78.     end pass1;
  79.  
  80.     pass2:
  81.         proc;
  82.  
  83.         /* Second pass reads .SUB file and writes output file backwards */
  84.  
  85.     dcl
  86.         sector char(128) static;
  87.  
  88.     dcl
  89.         (i,j) fixed binary (15);
  90.  
  91.     dcl
  92.         commtd bit (1) static init (false);
  93.  
  94.         open file (infile) input stream title ('$1.SUB');
  95.         open file (outfile) direct output env (f(128)) title ('$$$.SUB');
  96.         do count = count-1 to 0 by -1 while (^eofile);
  97.             read file (infile) into (linbuf);
  98.             commtd = true;
  99.             linbuf = translate(linbuf,upper,lower);
  100.             do i = 1 to lastword - 1 while (commtd);
  101.                 j = index(linbuf,filename(i));
  102.                 if (j ~= 0 & isdelim(substr(linbuf,j+length(filename(i)),1)))
  103.                         then do;
  104.                     commtd = false;
  105.                     call word2;
  106.                     if filename(lastword) = filename(i) then go to same;
  107.                     put skip list ('File affected:',filename(lastword));
  108.                     lastword = lastword + 1;
  109. same:
  110.                 end;
  111.             end;
  112.             if commtd = true then
  113.                 linbuf = ';' || linbuf;
  114.             linbuf = substr(linbuf,1,length(linbuf)-2);
  115.             substr(sector,1) = substr(linbuf,0);
  116.             do i = length(linbuf) + 2 to 128;
  117.                 substr(sector,i,1) = ascii(0);
  118.             end;
  119.             write file (outfile) from (sector) keyfrom (count);
  120.         end;
  121.         close file (outfile);
  122.     end pass2;
  123.  
  124.     word2:
  125.         proc;
  126.  
  127.         dcl
  128.             (i,st,fin,fint) fixed binary (7);
  129.  
  130.         fin = 15;
  131.         st = index(linbuf,' ');
  132.         do i = 1 to ndels;
  133.             fint = index(substr(linbuf,st+1),delims(i));
  134.             if fint ~= 0 then fin = min(fin,fint);
  135.         end;
  136.         filename(lastword) = substr(linbuf,st+1,fin-1);
  137.  
  138.     end word2;
  139.  
  140.     isdelim:
  141.         proc (c) returns (bit(1));
  142.         dcl c char (1);
  143.  
  144.         dcl
  145.             i fixed binary (7);
  146.  
  147.         do i = 1 to ndels;
  148.             if c = delims(i) then return (true);
  149.         end;
  150.         return (false);
  151.  
  152.     end isdelim;
  153.  
  154. end remake;
  155.