v2.0/bin/FILBP.PAS

   1 {$title: 'Command Line Filename Parser' $linesize:79}
   2 MODULE parse;   {$debug- $stackck+}
   3 { command line filename parsing;  Bob Wallace Microsoft 7/81 }
   4 CONST maxfile = 32;   {NOTE: must be set same as caller}
   5
   6
   7                   dfprf = 'PRF';
   8                   msprf = 'Profile filename [';
   9                   dfhst = 'HST';
  10                   mshst = 'Histogram filename [';
  11                   dfmap = 'MAP';
  12                   msmap = 'Map file  [';
  13                   nuln = 'NUL     ';
  14
  15 TYPE
  16   filenam = lstring (maxfile);       {filename parameter type}
  17   setsw = ARRAY [wrd(0)..3] OF byte; {switches parameter type}
  18   sets = set of 0..31;               {caller's parameter type}
  19   setc = set of chr(0)..chr(127);    {set of characters}
  20   cpmex = string (3);  cpmnm = string (8);
  21   cpmfn = RECORD
  22             cfd [0]: string (2);
  23             cfn [2]: cpmnm;  cfp [10]: char;  cfe [11]: cpmex;
  24           END;
  25   setbitt = ARRAY [wrd(0)..7] OF byte;
  26 CONST setbit = setbitt (128, 64, 32, 16, 8, 4, 2, 1);
  27
  28 VAR idset:setc; VALUE idset:=setc ['A'..'Z','a'..'z','0'..'9',
  29             '$', '&', '#', '@', '!', '%', '-', '_', '`', '''',
  30             '(', ')', '<', '>', '{', '}', '\', '^', '~', '|'];
  31 VAR drset:setc; VALUE drset:=setc ['A'..'O','a'..'o'];
  32
  33 PROCEDURE fillc (dst: adrmem; len: word;  chc: char);  extern;
  34 PROCEDURE movel (prf: adrmem; dst: adrmem; len: word); extern;
  35 PROCEDURE ptyuqq (len: word; prf: adsmem);             extern;
  36 PROCEDURE plyuqq;                                      extern;
  37 FUNCTION gtyuqq (len: word; dst: adsmem): word;        extern;
  38
  39 PROCEDURE filbm
  40 (VAR prffil,hstfil,mapfil: filenam;  VAR oldsw: setsw);
  41 (* sets the filenames for source, hstect, listing, and second
  42  listing (hstect list or cross ref);  also sets any switches,
  43  allowing those in the oldsw set and returning them in oldsw *)
  44 VAR prf, hst, map: cpmfn; {target filenames in CPM format}
  45   newsw: setsw;                {new switches, return in oldsw}
  46   qq: lstring (128); iq: word; {command line, current index}
  47   pqq: ads of lstring (128);    {address CPM-type command line}
  48               cesxqq [extern]: word;   {segment val}
  49   c: char;  l: word;  iscomma: boolean;  i: word; {other stuff}
  50
  51   FUNCTION parchr (ch: char): boolean;  {true iff CH found}
  52   BEGIN
  53     parchr := (iq <= qq.len) AND (qq [iq] = ch);
  54     IF result (parchr) THEN iq := iq+1;
  55   END;
  56
  57   FUNCTION upperc: char;  {return current char, in upper case}
  58   BEGIN
  59     upperc := qq[iq];
  60     IF result (upperc) >= 'a'
  61       THEN upperc := chr (ord (result (upperc)) - 32);
  62   END;
  63
  64   PROCEDURE blanks;  {skip blanks and set any switches}
  65   BEGIN
  66     WHILE parchr (' ') DO {nothing};
  67     IF parchr ('/') THEN
  68     BEGIN
  69       IF (iq <= qq.len)
  70       AND THEN (ord (upperc) - 64) IN retype (sets, oldsw)
  71       THEN
  72         BEGIN
  73           i := wrd (upperc) - 64;  iq := iq + 1;
  74           newsw[i DIV 8] := newsw[i DIV 8] OR setbit[i MOD 8];
  75           blanks;   {recurse for more}
  76         END
  77       ELSE iq := iq - 1;   {put "/" back on line to get error}
  78     END;
  79   END;
  80
  81   FUNCTION parset (VAR dst: string;  CONST chs: setc): boolean;
  82   (* Move characters from qq to DST as long as they are in CHS
  83      Deletes from qq, blanks DST, returns true if any moved *)
  84   VAR i: word;
  85   BEGIN
  86     fillc (adr dst, wrd (upper (dst)), ' ');  parset := false;
  87     FOR i := 1 TO wrd (upper (dst)) DO
  88       IF (iq > qq.len) OR ELSE NOT (qq [iq] IN chs)
  89       THEN BREAK
  90       ELSE
  91       BEGIN
  92         dst [i] := upperc;  parset := true;  iq := iq + 1;
  93       END;
  94   END;
  95
  96   FUNCTION filenm (CONST prompt: string; VAR nam: filenam;
  97                    VAR fcb: cpmfn; defext: cpmex): boolean;
  98   (* Get a filename into the FCB, setting defaults as
  99      appropriate;  return true iff a filename found *)
 100   VAR i: word;  p: adrmem;  defile: cpmnm;
 101   BEGIN
 102     blanks;
 103     IF iscomma THEN defile := prf.cfn ELSE defile := nuln;
 104     IF iq > qq.len THEN
 105     BEGIN
 106       ptyuqq (wrd (upper (prompt)), ads prompt);
 107       FOR i := 1 TO 8 DO
 108         IF defile [i] <> ' ' THEN ptyuqq (1, ads defile [i]);
 109       ptyuqq (1, ads '.');  ptyuqq (3, ads defext);
 110       ptyuqq (3, ads ']: ');
 111       qq.len := gtyuqq (upper (qq), ads qq [1]);  iq := 1;
 112     END;
 113     fcb.cfp := '.';
 114     IF (iq < qq.len) AND (qq [iq+1] = ':')
 115       AND THEN parset (c, drset)
 116       THEN
 117         BEGIN
 118           fcb.cfd[1] := c;  fcb.cfd[2] := ':';  iq := iq+1;
 119           defile := prf.cfn;   {default to source name now}
 120         END
 121       ELSE fcb.cfd := '  ';
 122     filenm := parset (fcb.cfn, idset);
 123     IF parchr (':')
 124     THEN BEGIN  fcb.cfe := ':  ';  fcb.cfp := ' ';  END
 125     ELSE
 126     IF parchr ('.')
 127       THEN [eval (parset (fcb.cfe, idset));  defile := prf.cfn]
 128       ELSE fcb.cfe := defext;
 129     IF NOT result (filenm) THEN fcb.cfn := defile;
 130     blanks;
 131     nam.len := 0;  p := adr fcb;
 132     FOR i := 0 TO 13 DO IF p^[i] <> wrd (' ')
 133     THEN [nam.len := nam.len+1; nam[nam.len] := chr (p^[i])];
 134   END;
 135
 136   FUNCTION conso (CONST fn: cpmnm): boolean;
 137   BEGIN
 138     conso := (fn = 'CON     ') OR (fn = 'USER    ');
 139   END;
 140
 141
 142 BEGIN
 143   newsw := setsw (do 4 of 0);
 144   pqq.r := 128;   pqq.s := cesxqq;
 145   FOR i := 0 TO pqq^.len+1 DO qq[i] := pqq^[i];  iq := 1;
 146   REPEAT
 147     iscomma := true;  prf.cfn := '        ';
 148     IF filenm (msprf, prffil, prf, dfprf)
 149     THEN
 150     BEGIN
 151       eval (parchr (','));
 152       eval (filenm (mshst, hstfil, hst, dfhst));
 153       iscomma := parchr (',');
 154       eval (filenm (msmap, mapfil, map, 'map'));
 155       blanks;  eval (parchr (';'));  blanks;
 156       IF hst.cfn <> nuln THEN newsw[3] := newsw[3] OR 8;
 157       IF map.cfn <> nuln THEN newsw[3] := newsw[3] OR 04;
 158       IF conso (map.cfn) THEN newsw[3] := newsw[3] OR 01;
 159       IF iq > qq.len THEN [oldsw := newsw;  return];
 160     END;
 161     ptyuqq (15, ads 'Line invalid: ''');  i := qq.len - iq + 1;
 162     IF i > 0 THEN ptyuqq (i, ads qq [iq]);
 163     ptyuqq (15, ads ''', start again.');  plyuqq;  iq := 256;
 164   UNTIL FALSE;
 165 END;
 166 END.
 167