Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/dirhnd.sim
There are 3 other files named dirhnd.sim in the archive. Click here to see a list.
00100	OPTIONS(/-A/E/C/P:"Directory handling, wildcard lookup etc.");
00200	EXTERNAL INTEGER PROCEDURE wildsix, sixbit, match6;
00300	EXTERNAL PROCEDURE depchar;
00400	EXTERNAL INTEGER PROCEDURE xcalli,input,andint,bitfield;
00700	EXTERNAL TEXT PROCEDURE compress,conc,rest,scanto,octal,upcase;
00900	EXTERNAL CHARACTER PROCEDURE findtrigger,fetchar;
01000	EXTERNAL REF(Infile)PROCEDURE findinfile;
01100	CLASS dirhnd;
01200	BEGIN
01300	
01400	INTEGER match, basename, basename_mask, baseext, baseext_mask;
01500	INTEGER filnam, ext;
01600	
01700	BOOLEAN no_more;
01800	REF(filenamelist)nextfile;
01900	REF(wildlook)looker;
02000	
02100	CLASS wildlook;
02200	BEGIN
02300	    PROCEDURE scanfilespec(spec); TEXT spec;
02400	    BEGIN
02500		TEXT t, t1;
02600		BOOLEAN dot;
02700		t:- spec.Strip; t.Setpos(1); t1:- scanto(t,'.');
02800		dot:= t1 =/= t;
02900		IF t1 == NOTEXT THEN t1:- Copy("*");
03000		basename:= wildsix(t1,basename_mask,6);
03100		t1:- rest(t);
03200		IF NOT dot AND t1==NOTEXT THEN t1:- Copy("*");
03300		baseext:= wildsix(t1,baseext_mask,3);
03400	    END scanfilespec;
03500	
03600	    WHILE TRUE DO
03700	    BEGIN
03800		Detach;
03900		next: Call(nextfile);
04000		match:= IF no_more THEN 0 ELSE match6(filnam,basename,basename_mask);
04100		IF NOT (match=0) THEN match:= match6(ext,baseext,baseext_mask)
04200		ELSE IF NOT no_more THEN GOTO next;
04300	    END WHILE;
04400	END wildlook;
04500	
04600	CLASS filenamelist;
04800	BEGIN
04900	    REF(directory_path)path;
05000	END;
05100	
05200	filenamelist CLASS sixbit_filenamelist(firstdirblock);
05250	REF(directory_block)firstdirblock;
05300	HIDDEN PROTECTED current, current_block;
05400	BEGIN
05500	    REF(directory_block)current_block;
05600	    INTEGER current;
05700	
05800	    PROCEDURE reset;
05900	    BEGIN current:= filnam:= ext:= 0;
05950		current_block:- firstdirblock;
06000		no_more:= FALSE;
06100	    END reset;
06200	
06300	    l:  reset;
06400	    WHILE NOT no_more DO
06500	    BEGIN
06600		Detach;
06662	l1:	INSPECT current_block DO
06675		BEGIN
06700		    current:= current + 2;
06800		    IF current > count THEN
06810		    BEGIN current_block:- current_block.nextblock;
06820			current:= 0;	GOTO l1;
06830		    END;
06900		    filnam:= filenames(current-2);
06910		    ext := filenames(current-1);
07100		END OTHERWISE no_more:= TRUE;
07200	    END; Detach; GOTO l;
07300	END sixbit_filenamelist;
07400	
07500	CLASS directory_path(pathspec);
07600	VALUE pathspec; TEXT pathspec;
07700	BEGIN
07800	    TEXT dirstr,dirname,dirext,dirpath;
07900	    REF(Infile)dirfile;
08000	    INTEGER dvn;
08100	    INTEGER pt_fcn,pt_swt,pt_ppn,pt_sfd1,pt_sfd2;
08200	
08300	    PROCEDURE init(spec); TEXT spec;
08400	    BEGIN REF(Infile)f;
08500		TEXT switches, t, tbf, pt, dirfilspec;
08600		INTEGER prj, prg, i;
08700		INTEGER ownppn, ownprj, ownprg;
08800		CHARACTER c;
08900	
09000	
09100		INTEGER PROCEDURE octnum;
09200		BEGIN   INTEGER i;
09300		    WHILE t.More DO
09400		    BEGIN c:= t.Getchar;
09500			IF c < '8' AND c >= '0' THEN
09600			i:= i * 8  +  Rank(c) - Rank('0') ELSE GOTO  out
09700		    END; out: octnum:= i;
09800		END octnum;
09900	
10000		ownppn:= xcalli(8R24,0,FALSE,0);
10100		ownprj:= bitfield(ownppn, 0,18);
10200		ownprg:= bitfield(ownppn,18,18);
10300		BEGIN
10400		    tbf:- Blanks(20);
10500		    t:- upcase(compress(compress(spec,' '),Char(9)));
10600		    pt_ppn:= 0;
10700		    dirname:- pt:- NOTEXT;
10800		    IF t=/=NOTEXT THEN
10900		    BEGIN
11000			dirfilspec:-scanto(t,'/');
11100			switches:- rest(t);
11200			dirext:- NOTEXT;
11300			t:- dirfilspec;
11400			dirstr:- scanto(t,':');
11500			IF dirstr == t THEN
11600			BEGIN t.Setpos(1);
11700			    dirstr:- Copy("DSK")
11800			END;
11900			dvn:= sixbit(dirstr);
12000			pt_ppn:= xcalli(8R55,dvn,TRUE,ownppn);
12100			IF t.More THEN
12110			BEGIN scanto(t,'[');
12120			    t:- rest(t);
12160			END;
12200			prj:= octnum;
12210			IF prj = 0 THEN prj:= bitfield(pt_ppn,0,18);
12300			IF c = ',' THEN prg:= octnum ELSE t.Setpos(t.Pos-1);
12400			IF prg = 0 THEN prg:= bitfield(pt_ppn,18,18);
12500			IF dirname == NOTEXT AND  c = ',' THEN
12600			dirname:- scanto(t,']');
12700			i:= prj * 8R1000000 + prg;
12800			IF i NE 0 THEN pt_ppn:= i;
12900	
13000			IF dirname == NOTEXT THEN
13100			BEGIN
13200			    dirname:- Blanks(13); dirname.Putchar('#');
13300			    t:- dirname.Sub(2,12);
13400			    t:- octal(t,pt_ppn);  dirext:- Copy(".UFD");
13500			    pt:- Copy("[1,1]");
13600			END ELSE
13700			BEGIN  t:- dirname;
13800			    IF pt_ppn NE ownppn THEN
13900			    BEGIN pt:- tbf.Sub(2,6);
14000				octal(pt,prj);
14100				pt:- tbf.Sub(9,6);
14200				octal(pt,prg);
14300				pt:- tbf.Sub(1,15);
14400				depchar(pt,1,'['); depchar(pt,8,',');
14500				depchar(pt,15,']');
14600			    END;
14700			    pt_sfd1:= sixbit(dirname);
14800			END;
14900			!** Handle switches here **!;
15000			IF dirext==NOTEXT THEN dirext:- Copy(".SFD");
15100			dirfilspec:- conc(dirstr,":",dirname,dirext,pt);
15200			f:-findinfile(dirfilspec);
15300			IF f =/= NONE THEN
15400			BEGIN
15500			    t:- dirfilspec;
15600			    dirstr:- scanto(t,':'); t:- rest(t);
15700			    dirname:- scanto(t,'.'); t:- rest(t);
15800			    dirext:- scanto(t,'['); t:- rest(t);
15900			    dirpath:- scanto(t,']');
16000			    dvn:= sixbit(dirstr);
16100			END;
16200		    END;
16300		END;
16400		dirfile:- f
16500	    END init;
16600	
16700	    REF(sixbit_filenamelist)PROCEDURE
16800	    loadselectedfilenames(fn,fnm,ex,exm);
16900	    INTEGER fn,fnm,ex,exm; !(Wildcard) filename, mask, extension, mask;
17000	    BEGIN
17100		REF(directory_block)first,last,current,buf;
17200		INTEGER count,n,n1,i,f,e;  BOOLEAN wild, all;
17250	
18050	
18100		wild:= NOT(fnm = 0 AND exm = 0);
18200		all:= fn=0 AND ex=0 OR fnm=-1 AND exm<=-1;
18300		IF NOT all THEN buf:- NEW directory_block(THIS directory_path);
18400		INSPECT dirfile DO
18500		BEGIN
18600		    IF Endfile THEN Open(NOTEXT);
18700		    WHILE NOT Endfile DO
18800		    BEGIN
18900			IF buf==NONE OR buf==first THEN
18910			buf:- NEW directory_block(THIS directory_path);
19000			IF first==NONE THEN first:- current:- last:- buf;
19100			count:= buf.load;   i:= 0;
19200			FOR count:= count//2-1 STEP -1 UNTIL 0 DO
19300			BEGIN
19400			    f:= buf.filenames(i);
19410			    e:= andint(buf.filenames(i+1),8R777777000000);
19505			    IF (IF f = 0 THEN FALSE ELSE IF all THEN TRUE ELSE
19510			    IF match6(f,fn,fnm) = 0 THEN FALSE ELSE
19520			    match6(e,ex,exm) NE 0)  THEN
19530			    BEGIN
19900				n:= n+1;
20100				IF n1>126 THEN
20200				BEGIN
20300				    last:- NEW directory_block
20350				    (THIS directory_path);
20355				    current.count:= n1;
20360				    current:- current.nextblock:- last;
20370				    n1:= 0;
20380				END;
20600				current.filenames(n1):= f;
20700				current.filenames(n1+1):= e;
20800				n1:= n1+2;
20900			    END;
21000			    i:= i+2;
21200			END FOR count;
21250			current.count:= n1;
21300		    END while not endfile;  Close;
21400		END dirfile input;
21500		IF n>0 THEN
21600		INSPECT NEW sixbit_filenamelist(first) DO
21700		loadselectedfilenames:- THIS sixbit_filenamelist;
22700	    END loadselectedfilenames;
22800	
22900	    REF(sixbit_filenamelist)PROCEDURE loadfilenames;
23000	    loadfilenames:- loadselectedfilenames(0,0,0,0);
23100	
23200	    init(pathspec);
23300	END directory_path;
23400	
23500	CLASS directory_block(dir); REF(directory_path)dir;
23600	BEGIN
23700	    REF(directory_block)nextblock;
23800	    INTEGER count;
23810	    INTEGER ARRAY filenames(0:127);
23820	
23830	    INTEGER PROCEDURE load;
23840	    BEGIN count:= input(dir.dirfile,filenames);
23850		load:= count:= Sign(count)*count//5;
23860	    END load;
23870	
23900	END;
24000	
24100	PROCEDURE reset;
24200	BEGIN no_more:= FALSE;
24300	    filnam:= ext:= match:= 0;
24400	    basename:= basename_mask:= baseext:= baseext_mask:= 0;
24500	END reset;
24600	
24700	END directory_handling;