Atlas - FILBP.PAS
Home / ext / JunkDrawer / DOS / BuildTools / v2.0 Lines: 1 | Size: 6144 bytes [Download] [Show on GitHub] [Search similar files] [Raw] [Raw (proxy)][FILE BEGIN]1{$title: 'Command Line Filename Parser' $linesize:79} 2MODULE parse; {$debug- $stackck+} 3{ command line filename parsing; Bob Wallace Microsoft 7/81 } 4CONST 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 15TYPE 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; 26CONST setbit = setbitt (128, 64, 32, 16, 8, 4, 2, 1); 27 28VAR idset:setc; VALUE idset:=setc ['A'..'Z','a'..'z','0'..'9', 29 '$', '&', '#', '@', '!', '%', '-', '_', '`', '''', 30 '(', ')', '<', '>', '{', '}', '\', '^', '~', '|']; 31VAR drset:setc; VALUE drset:=setc ['A'..'O','a'..'o']; 32 33PROCEDURE fillc (dst: adrmem; len: word; chc: char); extern; 34PROCEDURE movel (prf: adrmem; dst: adrmem; len: word); extern; 35PROCEDURE ptyuqq (len: word; prf: adsmem); extern; 36PROCEDURE plyuqq; extern; 37FUNCTION gtyuqq (len: word; dst: adsmem): word; extern; 38 39PROCEDURE 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 *) 44VAR 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 142BEGIN 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; 165END; 166END. 167[FILE END](C) 2025 0x4248 (C) 2025 4248 Media and 4248 Systems, All part of 0x4248 See LICENCE files for more information. Not all files are by 0x4248 always check Licencing.