home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / sigmv079.ark / FPARSE.PLI < prev    next >
Encoding:
Text File  |  1984-04-29  |  3.2 KB  |  122 lines
  1. /* parse file name WITHOUT wild cards
  2.     1 -> ptr to char(>=14) string with filename(s) to be parsed
  3.          terminated by a ' ' or 0
  4.          WARNING:  be sure that this character string is not
  5.          a character string varying or all blanks and must be
  6.          terminated with a ' ' or 0
  7.     2 -> ptr to fcb to be filled
  8.    returns
  9.     1 -> ptr to next filename in string if retcode = 0
  10.     2 -> ptr to parsed fcb if successful
  11.     3 -> return code 0 = successful and more files
  12.                      1 = successful, no more files
  13.                      2 = invalid file */
  14.  
  15. fparse:proc(afsptr,(sfsptr),retcode);
  16.         /*
  17.         parse fcb 
  18.         Digital Research
  19.         Pacific Grove, California 93950
  20.         */
  21.  
  22.         declare
  23.         (afsptr,sfsptr) ptr,
  24.         retcode bin fixed (7);
  25.  
  26.         declare
  27.         1 bt80sfs based (sfsptr),
  28.           3 drv fixed(7),
  29.           3 file char (8),
  30.           3 type char (3);
  31.  
  32.         declare
  33.         ptr ptr,
  34.         code bin fixed (7),
  35.         (i,j,k) bin fixed (6),
  36.         ii bin fixed (15),
  37.         chr13 char (13),
  38.         chr254b char (254) based,
  39.         chr1ab(13) char (1) based,
  40.         chr1b char (1) based,
  41.         chr13b char (13) based,
  42.         bf15b bin fixed (15) based,
  43.         illegal_chr(12) char (1) static init (
  44.           ':'  ,  '.'  ,  '*' , '='  ,  ';'  ,  '<'  ,  '>'  ,
  45.           '['  ,  ']'  ,  '?' , '('  ,  ')'   );
  46.  
  47.         code = 2;
  48.         ptr = afsptr;
  49.  
  50.     /* skip leading , */
  51.         if ptr->chr1b = ',' then ptr = addr(ptr->chr1ab(2));
  52.  
  53.     /* deblank */
  54.         ii = verify(ptr->chr254b,' ');
  55.         if ii = 0 then 
  56.         go to return;
  57.         ptr = addr(ptr->chr1ab(ii));
  58.  
  59.     /* check for drive */
  60.         if ptr->chr1ab(2) = ':' then do;
  61.           drv = rank(ptr->chr1b) - 64;    /* 1=A: */
  62.           ptr = addr(ptr->chr1ab(3));     /* skip drive */
  63.           end;
  64.         else drv = 0;
  65.  
  66.  
  67.         j = index(ptr->chr13b,' ');
  68.         k = index(ptr->chr13b,',');
  69.         i = index(ptr->chr13b,'^@');
  70.  
  71.     if k ~= 0 then
  72.          if j = 0 | j > k then
  73.             j = k;
  74.     if i ~= 0 then
  75.         if j = 0 | j > i then
  76.             j = i;
  77.  
  78.         i = index(ptr->chr13b,'.');
  79.  
  80.     /* i is . & j is end + 1 */
  81.         if j < 2 then 
  82.         go to return;
  83.         if i > j then i = 0;
  84.  
  85.     /* chr13 is filename */
  86.         chr13 = substr(ptr->chr13b,1,j-1);
  87.         if i ~= 0 then substr(chr13,i,1) = ' ';
  88.       do k = 1 to 12;
  89.           if index(chr13,illegal_chr(k)) ~= 0 then 
  90.         go to return;
  91.           end;
  92.         if i = 0 then do;
  93.           if j > 9 then 
  94.         go to return;
  95.           file = chr13;
  96.           type = ' ';
  97.           end;
  98.         else do;
  99.           if i > 9 then 
  100.         go to return;
  101.           k = j - i - 1;
  102.           if k < 1 | k > 3 then 
  103.         go to return;
  104.           file = substr(chr13,1,i-1);
  105.           type = substr(chr13,i+1,k);
  106.           end;
  107.         ptr = addr(ptr->chr1ab(j));
  108.         code = 1;
  109.  
  110.     /* deblank next file name */
  111.         if ptr->chr1b = ' ' then do;
  112.           ii = verify(ptr->chr254b,' ');
  113.           ptr = addr(ptr->chr1ab(ii));
  114.           end;
  115.         if ptr->chr1b = ',' then code = 0;
  116.         afsptr = ptr;
  117.  
  118. return:
  119.         retcode = code;
  120.         return;
  121.       end fparse;
  122.