Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/23/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;