Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/21/simatr.sim
There is 1 other file named simatr.sim in the archive. Click here to see a list.
00050	OPTIONS(/-Q/-D/-I/-A/P:"Display of attribute files");
00100	BEGIN
00150	EXTERNAL INTEGER PROCEDURE bitfield,input,andint,rdx50,imax,
00200	absadr,storebyte,wildsix,match6,sxrx50,sixbit,xcalli;
00250	EXTERNAL REF(Infile)PROCEDURE findinfile;
00300	EXTERNAL REF(Printfile) PROCEDURE findprintfile;
00350	EXTERNAL REF(Directfile) PROCEDURE finddirectfile;
00400	EXTERNAL TEXT PROCEDURE conc,idrx50,idsixbit,litenbokstav,inline,
00450	checkextension,scanto,tsub,compress,rest,upcase,octal;
00500	EXTERNAL CHARACTER PROCEDURE fetchar,findtrigger;
00510	EXTERNAL BOOLEAN PROCEDURE dotypeout;
00550	EXTERNAL PROCEDURE abort,depchar,exit;
00600	EXTERNAL CLASS atrstr, dirhnd;
00650	atrstr CLASS atrdisplay;
00700	BEGIN
00750	    BOOLEAN pending_semicolon, pending_new_line, atr_open;
00800	    CHARACTER delimiter;
00850	    REF(Printfile)displayfile;
00900	    INTEGER rlimit, level, indentation_step, base_indentation;
00950	    REF(zde)next_zde;
01000	    TEXT endtext,begintext,switchtext,entrytext,statement_marker;
01050	    TEXT protectedtext,innertext;
01100	    CHARACTER null;
01150	    INTEGER i;
01200	    TEXT t,u;
01250	    TEXT ARRAY zhetype[0:13];
01300	    TEXT ARRAY typecode[0:9];
01350	    TEXT ARRAY kindcode[0:4];
01400	    TEXT ARRAY modecode[0:7];
01450	    TEXT ARRAY mfocode[0:5];
01500	
01550	    PROCEDURE atrclose;
01600	    INSPECT atrfile DO IF atr_open THEN
01650	    BEGIN Close; atr_open:= FALSE;
01700	    END;
01750	
01800	    REF(zde) PROCEDURE zdeload(zdetyp); INTEGER zdetyp;
01850	    INSPECT
01900	    (IF zdetyp=qzqu THEN NEW zqud ELSE
01950	    (IF zdetyp=qzhb THEN NEW zhbd ELSE
02000	    (IF zdetyp=qzhe THEN NEW zhed ELSE
02050	    (IF zdetyp=-1   THEN NEW zebd ELSE
02100	    (IF zdetyp=-2   THEN NEW zheqquachd ELSE NONE)))))
02150	    DO BEGIN load; zdeload:- THIS zde END;
02200	
02250	    PROCEDURE Setpos(i); INTEGER i;
02300	    INSPECT displayfile DO Setpos(i);
02350	
02400	    PROCEDURE Putint(i,n); INTEGER i,n;
02450	    BEGIN TEXT t;
02500		t:- Blanks(n); t.Putint(i); putitem(null,t);
02550	    END putint;
02600	
02650	    !;!	PROCEDURE putimage; !;! INSPECT displayfile DO Outimage;
02700	
02750	    PROCEDURE blanklines(n); INTEGER n;
02800	    INSPECT displayfile DO
02850	    BEGIN
02900		Outimage; pending_new_line:= FALSE;
02950		IF n>0 THEN Eject(Line+n);
03000	    END;
03050	
03100	    PROCEDURE puttext(t); TEXT t;  putitem(null,t);
03150	
03200	    PROCEDURE putitem(c,t); TEXT t; CHARACTER c;
03250	    INSPECT displayfile DO
03300	    BEGIN INTEGER i;
03350		i := 1 + (level-1) * indentation_step + base_indentation;
03400		IF i <= 0 THEN i:= 1;
03450		IF pending_semicolon THEN
03500		BEGIN Outchar(';'); pending_semicolon:= FALSE END;
03550		IF pending_new_line OR
03600		Pos > rlimit OR Pos <= i OR Length-Pos<t.Length+3 THEN
03650		BEGIN
03700		    IF NOT (Letter(c) OR Digit(c) OR c=' ' OR c=null) THEN
03750		    BEGIN Outchar(c); c:= null END;
03800		    IF Pos > i THEN
03850		    BEGIN
03900			IF Image.Strip =/= NOTEXT THEN Outimage;
03950			IF c=' ' THEN c:= null;
04000		    END; pending_new_line:= FALSE;
04050		    Setpos(i);
04100		END ELSE IF fetchar(Image,Pos-1)=';' THEN Setpos(Pos+1);
04150		IF NOT(c = null OR (c=' ' AND Pos <= i)) THEN Outchar(c);
04200		IF t =/= NOTEXT THEN
04250		BEGIN IF c=';' THEN Outchar(' '); Outtext(t) END;
04300	    END putitem;
04350	
04400	    PROCEDURE new_line; pending_new_line:= TRUE;
04450	
04500	    PROCEDURE putsemicolon; pending_semicolon:= TRUE;
     
04550	    zqu CLASS zqud;
04600	    BEGIN
04650	
04700		PROCEDURE displayindices;
04750		BEGIN
04800		    INTEGER i;
04850		    TEXT t;
04900		    t:- Blanks(nsb*4);
04950		    WHILE t.More DO
05000		    BEGIN
05050			t.Putchar('0'); t.Putchar(':'); t.Putchar('0');
05100			t.Putchar(',');
05150		    END;
05200		    depchar(t,t.Length,']');
05250		    putitem('[',t);
05300		END displayindices;
05350	
05400		PROCEDURE display;
05450		BEGIN
05500		    CHARACTER d;
05550		    d:= ' ';
05600		    IF mode = qdeclared THEN new_line;
05650		    IF typ=qlabel AND knd=qprocedure THEN
05700		    BEGIN
05750			puttext(switchtext);
05800			GOTO l;
05850		    END ELSE
05900		    BEGIN
05950			IF (IF knd = qclass THEN TRUE ELSE
06000			knd = qprocedure AND
06050			mode = qdeclared) THEN
06100			BEGIN
06150			    new_line;
06200			    INSPECT zquzb DO level:= sol;
06250			    IF knd = qclass AND qid=/=NOTEXT
06300			    THEN puttext(qid);
06350			END;
06400			BEGIN
06405			    IF typ NE qnotype THEN
06410			    BEGIN IF typ=qlabel AND mode=qdeclared THEN
06415				BEGIN
06420				    putitem(' ',id);
06422				    putitem(':',NOTEXT);
06425				    GOTO l1;
06430				END;
06435				putitem(d,typecode[typ]);
06500				IF typ=qref THEN
06550				BEGIN putitem('(',qid); putitem(')',NOTEXT);
06555				END;
06610			    END;
06650			    IF knd NE qsimple THEN putitem(d,kindcode[knd]);
06700			l:  putitem(' ',id);
06750			    IF knd = qarray AND mode=qdeclared THEN
06800			    displayindices;
06850			    IF typ=qlabel AND mode=qdeclared THEN
06900			    BEGIN
06950			l1:	putitem(';',entrytext);
07000				putitem(':',qid);
07050			    END label;
07100		    END END;
07150		END display;
07200	    END zqud;
     
07250	    zhe CLASS zhed;
07300	    BEGIN
07350		PROCEDURE display;;
07400	    END;
07450	
07500	    zhb CLASS zhbd;
07550	    BEGIN
07600		PROCEDURE display;
07650		BEGIN
07700		    REF(zqud) z; CHARACTER d; INTEGER m;
07750		    level:= sol+1;
07800		    IF nrp > 0 THEN
07850		    BEGIN
07900			d:= '(';
07950			z:- zqulist.first;
08000			WHILE z=/=NONE DO
08050			INSPECT z DO
08100			BEGIN
08150			    IF parameter THEN
08200			    BEGIN putitem(d,id); d:= ','; END;
08250			    z:- z.suc;
08300			END;
08350			putitem(')',NOTEXT);
08400			putitem(';',entrytext); putitem(':',idrx50(unr));
08450			putsemicolon;
08500			new_line;
08550			FOR m:= qvalue,qname DO
08600			BEGIN
08650			    d:= ' ';
08700			    z:- zqulist.first;
08750			    WHILE z=/=NONE DO
08800			    INSPECT z DO
08850			    BEGIN
08900				IF mode=m THEN
08950				BEGIN
09000				    IF mode=qname OR typ=qtext OR knd=qarray THEN
09050				    BEGIN
09100					IF d=' ' THEN puttext(modecode[mode]);
09150					putitem(d,id); d:= ',';
09200				END END;
09250				z:- z.suc;
09300			    END;
09350			    IF d NE ' ' THEN putsemicolon;
09400			END FOR m;
09450	
09500			z:- zqulist.first; d:= ' ';
09550			WHILE z=/=NONE DO
09600			BEGIN !Parameter types;
09650			    INSPECT z DO
09700			    IF parameter THEN
09750			    BEGIN
09800				IF same_type_and_kind(z.pred) THEN
09850				BEGIN
09900				    putitem(',',id); d:= ',';
09950				END ELSE
10000				BEGIN
10050				    display; d:= ' ';
10100				END;
10150				IF NOT same_type_and_kind(z.suc) THEN
10200				BEGIN d:= ' '; putsemicolon END;
10250			    END; z:- z.suc;
10300			END;
10350			IF d NE ' ' THEN putsemicolon;
10400		    END nrp>0 ELSE
10450		    BEGIN
10500			putitem(';',entrytext);
10550			putitem(':',idrx50(unr));
10600			putsemicolon;
10650		    END nrp=0;
10700		    new_line; d:= ' ';
10750		    z:- zqulist.first;
10800		    WHILE z=/=NONE DO
10850		    INSPECT z DO
10900		    BEGIN !Check for virtuals;
10950			IF mode = qvirtual THEN
11000			BEGIN
11050			    IF d=' ' THEN
11100			    BEGIN
11150				puttext(modecode[qvirtual]);
11200				putitem(' ',NOTEXT); d:= ';';
11250			    END;
11300			    display; putsemicolon;
11350			END; z:- z.suc
11400		    END;
11450		    FOR m:= qhdn,qnhdn DO
11500		    BEGIN
11550			new_line; d:= ' ';
11600			z:- zqulist.first;
11650			WHILE z=/=NONE DO
11700			INSPECT z DO
11750			BEGIN
11800			    IF mode=m THEN
11850			    BEGIN
11900				IF d=' ' THEN puttext(modecode[m]);
11950				putitem(d,id); d:= ',';
12000			    END;
12050			    z:- z.suc
12100			END;
12150			IF d NE ' ' THEN putsemicolon;
12200		    END;
12250	
12300		    new_line; z:- zqulist.first; d:= ' ';
12350		    WHILE z=/=NONE DO
12400		    INSPECT z DO
12450		    BEGIN
12500			IF tpt THEN
12550			BEGIN
12600			    IF d=' ' THEN puttext(protectedtext);
12650			    putitem(d,id); d:= ',';
12700			END;
12750			z:- z.suc
12800		    END;
12850		    IF d NE ' ' THEN putsemicolon;
12900	
12950		    level:= sol;
13000		    IF zhetyp=qprocb THEN
13050		    BEGIN
13100			IF nrp>0 THEN new_line;
13150			puttext(statement_marker);
13200			putsemicolon;
13250		    END ELSE
13300		    BEGIN
13350			new_line;
13400			puttext(begintext);
13450		    END;
13500		    level:= sol+1;
13550		    new_line;
13600	
13650		    z:- zqulist.first; d:= null;
13700		    WHILE z=/=NONE DO
13750		    BEGIN !display attributes;
13800			INSPECT z DO
13850			IF mode=qdeclared THEN
13900			BEGIN
13950			    IF NOT declared_class_or_procedure AND
14000			    same_type_and_kind(z.pred) AND typ NE qlabel THEN
14050			    BEGIN
14100				putitem(',',id); d:= ',';
14150				IF knd=qarray THEN displayindices
14200			    END ELSE
14250			    BEGIN
14300				IF d NE null THEN putsemicolon;
14350				d:= ' ';
14400				IF knd=qclass OR knd=qprocedure THEN
14450				BEGIN
14500				    new_line; display;
14550				    INSPECT next WHEN zhb DO
14600				    BEGIN
14650					display;
14700					INSPECT list_trailer DO display;
14750				    END;
14800				END ELSE display;
14850			    END;
14900			END; z:- z.suc;
14950		    END;
15000		    IF zhetyp=qclasb THEN
15050		    BEGIN
15100			IF NOT noi THEN
15150			BEGIN
15200			    new_line; putitem(';',innertext);
15250		    END END;
15300		    putsemicolon; new_line;
15350		END display;
15400	    END zhbd;
     
15450	    zeb CLASS zebd;
15500	    BEGIN
15550		PROCEDURE display;
15600		BEGIN
15650		    putsemicolon; new_line;
15700		    INSPECT list_header DO
15750		    BEGIN
15800			level:= sol;
15850			IF zhetyp = qclasb THEN
15900			BEGIN
15950			    TEXT t;
16000			    t:- tsub(displayfile.Image,displayfile.Pos-5,5);
16050			    IF t="BEGIN" THEN t:= statement_marker ELSE
16100			    BEGIN
16150				puttext(endtext);
16200				putitem(' ',zhbzqu.id);
16250				putsemicolon; new_line;
16300		    END END END
16350		END display;
16400	    END zebd;
16450	
16500	
16550	    zheqquach CLASS zheqquachd;
16600	    BEGIN
16650		PROCEDURE display;
16700		BEGIN ! SIMULA name, unique identification;
16750		    new_line;
16800		    puttext(id); Setpos(15); puttext(idrx50(unr));
16850		END;
16900	    END zheqquachd;
     
16950	    COMMENT *** initialization ***;
17000	
17050	    t:- Copy(
17100	    "*INTEGER*REAL*LONG REAL*CHARACTER*"
17150	    "BOOLEAN*TEXT*REF*LABEL**"
17200	    "(LONG)REAL*");
17250	    FOR i:= 0 STEP 1 UNTIL 9 DO
17300	    typecode[i]:- scanto(t,'*');
17350	    t:- Copy("DECLARED*VALUE*NAME**VIRTUAL:*"
17400	    "*HIDDEN*NOT HIDDEN*");
17450	    FOR i:= 0 STEP 1 UNTIL 7 DO
17500	    modecode[i]:- scanto(t,'*');
17550	    t:- Copy("**ARRAY*PROCEDURE*CLASS*");
17600	    FOR i:= 0 STEP 1 UNTIL 4 DO
17650	    kindcode[i]:- scanto(t,'*');
17700	    t:- Copy("CODE*QUICK**FORTRAN*F40*");
17750	    FOR i:= 1 STEP 1 UNTIL 5 DO
17800	    mfocode[i]:- scanto(t,'*');
17850	    delimiter:= ';';
17900	    endtext:- Copy("END");
17950	    begintext:- Copy("BEGIN");
18000	    switchtext:- Copy("SWITCH");
18050	    entrytext:- Copy("!Entry");
18100	    statement_marker:- Copy("!...;");
18150	    protectedtext:- Copy("PROTECTED");
18200	    innertext:- Copy("INNER");
18250	
18300	    rlimit:= 65;
18350	    indentation_step:= 4;
18400	    base_indentation:= 0;
18450	END atrdisplay;
     
18500	atrdisplay BEGIN
18550	REF(dirhnd) dh;
18600	TEXT atr_ext, atrfildef, atrfilnam, atrfilext;
18610	
18650	
18700	BOOLEAN PROCEDURE namestarter(c); CHARACTER c;
18750	namestarter:= Letter(c) OR Digit(c)
18775	OR c='*' OR c='?' OR c=Char(27) OR c='[';
18800	
18850	PROCEDURE help_decide(t,quit,xit,next);
18860	TEXT t; LABEL quit, xit, next;
18900	BEGIN CHARACTER c;
18950	new_reply: IF Sysin.Endfile THEN GOTO prog_exit;
19000	    upcase(t);  c:= fetchar(t,1);
19050	    IF c='E' OR c=Char(27) THEN GOTO xit;
19060	    IF c='Q' THEN GOTO quit;
19100	    IF c='Y' THEN GOTO ret;
19150	    IF c='N' OR c=Char(0) THEN GOTO next;
19200	    !Wrong response, offer help;
19250	    t:- inline("Reply Yes, No (CR-LF), "
19300	    "Exit or Quit:/No/:",Sysin);
19350	    Outimage;  GOTO new_reply;
19400	ret:!
19450	;
19500	END help_decide;
19550	
19600	
19650	
19700	TEXT PROCEDURE modulename;
19750	IF NOT module_list.More THEN
19800	BEGIN TEXT t;
19810	    dotypeout(Sysout);
19850	    t:- inline("Name of procedure or class:",Sysin);
19900	    WHILE NOT namestarter(fetchar(t,1)) DO
19950	    BEGIN IF Sysin.Endfile THEN GOTO prog_exit;
20000		Outtext("Procedure or class name,"
20050		"6 characters are sufficient"); Outimage;
20100		Outtext("A list of names with ',' as separator is also valid");
20150		t:- inline("Hit <ESC> (altmode) to exit from library. Name:",Sysin);
20200	    END;
20250	    modulename:- t;
20300	    IF fetchar(t,1) = Char(27) THEN Outimage ELSE
20350	    BEGIN  IF Sysin.Endfile THEN GOTO prog_exit;
20400		t:- compress(t,' '); modulename:- scanto(t,',');
20450		module_list:- rest(t);
20500	    END;
20550	nomore:
20600	END ELSE modulename:- scanto(module_list,',');
20650	
20700	CHARACTER c;
20750	TEXT atr_file_name,listextension,atrextension, t;
20800	TEXT atrdev,atrpath,atrext,module_list;
20850	REF(Directfile) df;
20875	
20887	
20900	PROCEDURE display;
20950	BEGIN
21000	    level:= 1; new_line;
21050	    puttext(Copy("!Module name")); putitem(':',module_name);
21100	    IF entry_name NE module_name THEN
21150	    BEGIN
21200		putitem(' ',Copy("entry name")); putitem(':',entry_name.Strip);
21250	    END;
21300	    IF header NE 0 THEN
21350	    BEGIN putitem(' ',Copy("Header"));
21400		putitem(':',idrx50(header).Strip);
21450	    END;
21475	    putsemicolon; new_line;
21500	    INSPECT firstzde WHEN zqu DO
21550	    INSPECT zquzb DO
21600	    BEGIN
21650		TEXT t;
21700		IF ebl<-3 THEN
21750		BEGIN t:- Blanks(IF ebl<-11 THEN 2 ELSE 1);
21800		    t.Putint(-2-ebl);
21850		END;
21900		puttext(Copy("OPTIONS(/"));
22000		IF t =/= NOTEXT THEN puttext(t);
22010		puttext(Copy("E"));
22020		IF knd=qprocedure THEN
22030		BEGIN
22050		    IF mfo > 0 THEN putitem(':',mfocode[mfo]);
22100		    IF nck THEN putitem(',',Copy("NOCHECK"));
22120		    IF mfo > 0 THEN putitem(',',entry_name.Strip);
22125		END;
22130		puttext(Copy(");"));
22250	    END;
22300	    blanklines(1);
22350	    INSPECT zqulist.first WHEN zqu DO
22400	    BEGIN
22450		display;
22500		INSPECT zquzb DO
22550		BEGIN display; INSPECT list_trailer DO
22600		    BEGIN display; next_zde:- next
22650		END END;
22700	    END;
22750	    blanklines(1);
22800	    level:= 1;
22850	    pending_semicolon:= FALSE;
22900	    IF next_zde IN zheqquachd THEN
22950	    BEGIN
23000		puttext(Copy("External references:"));
23050		blanklines(1);
23100	    END;
23150	    WHILE next_zde IN zheqquachd DO
23200	    BEGIN
23250		next_zde.display;
23300		next_zde:- next_zde.next
23350	    END;
23400	    blanklines(1);
23450	END display;
23460	
23500	    atrextension:- Copy(".ATR");
23550	    listextension:- Copy(".LSA");
23600	try_again: !
23650	;
23700	    t:- upcase(inline("Output file:/Sysout/:",Sysin));
23750	    IF (IF t==NOTEXT THEN TRUE ELSE t="SYSOUT" OR t="TTY:") THEN
23800	    displayfile:- Sysout ELSE
23850	    BEGIN
23900		IF Sysin.Endfile THEN GOTO prog_exit;
23950		t:- checkextension(t,".LSA");
24000		displayfile:- findprintfile(conc("ATRLST ",t));
24050		IF displayfile == NONE THEN GOTO try_again;
24100		displayfile.Open(Blanks(120));
24150	    END;
24200	
24250	new_file: !
24300	;
24350	    atrfile:- NONE; library:= FALSE; atrclose;
24400	
24450	ins_dh: !
24500	;
24550	    INSPECT dh DO
24600	    IF NOT no_more THEN
24650	    BEGIN
24700	c_next:!
24750	;
24800		Call(nextfile);
24950		IF no_more THEN BEGIN dh:- NONE; GOTO new_file; END;
25000		atrfilnam:= idsixbit(filnam,0);
25050		atrfilext:= idsixbit(ext,0);
25100		depchar(atrfilnam,7,'.');
25110		dotypeout(Sysout);
25150		Outtext("Display "); Outtext(atrfildef);
25200		t:- inline("?/No/:",Sysin);
25250		help_decide(t,c_quit,c_quit,c_next);
25300		atr_reset; pending_new_line:= pending_semicolon:= FALSE;
25350		t:- atrfildef;
25400		GOTO find_atr_file;
25450	c_quit: !
25500	;
25550		no_more:= TRUE; GOTO new_file;
25600	    END;
25650	
25700	new_module: !
25750	;
25800	    atr_reset; pending_new_line:= pending_semicolon:= FALSE;
25850	    IF atr_open AND library THEN GOTO next_module;
25900	    dotypeout(Sysout); t:- inline("ATR file:",Sysin);
25950	    WHILE NOT namestarter(fetchar(t,1)) AND NOT Sysin.Endfile  DO
26000	    BEGIN Outtext(
26050		"Name of ATR file (default extension .ATR).  Name may be");
26100		Outimage; Outtext(
26150		"followed by a list of module names in (), separated by");
26200		Outimage;	t:- inline(
26250		"commas: dev:atrfil[p,pn,...](mod1,...). ATR file:",Sysin);
26300	    END;
26350	    IF Sysin.Endfile THEN GO TO prog_exit;
26400	    t:- compress(t,' ');
26450	    IF t == NOTEXT THEN
26500	    BEGIN IF NOT library THEN GOTO new_file;
26550	    END ELSE
26600	    BEGIN
26650		IF library THEN atrclose;  scanto(t,'(');
26700		IF NOT t.More THEN module_list:- NOTEXT ELSE
26750		BEGIN module_list:- rest(t); t:- t.Sub(1,t.Pos-2);
26800		    module_list:- scanto(module_list,')');
26850		END;
26900		t.Setpos(1); atrdev:- scanto(t,':');
26950		IF atrdev == t THEN atrdev:- Copy("DSK") ELSE t:- rest(t);
27000		t.Setpos(1);  atr_file_name:- scanto(t,'[');
27050		IF atr_file_name == t THEN atrpath:- NOTEXT ELSE
27100		BEGIN t.Setpos(t.Pos-1); atrpath:- rest(t);
27150		    IF fetchar(atrpath,atrpath.Length) NE ']' THEN
27200		    atrpath:- conc(atrpath,"]");
27250		END;
27300		t:- atr_file_name;
27350		atr_file_name:- scanto(t,'.');
27355		atr_ext:- rest(t);
27360		IF atr_file_name == NOTEXT THEN
27380		t:- IF atr_ext ==NOTEXT THEN Copy("*.ATR") ELSE
27390		conc("*.",atr_ext);
27450		IF t == atr_file_name THEN t:- conc(t,atrextension);
27500	    t.Setpos(1);
27550	    IF findtrigger(t,Copy("*?")) NE Char(0) THEN
27600	    BEGIN !Wildcard;
27650		dh:- NEW dirhnd;
27700		INSPECT dh DO
27750		BEGIN
27800		    atrfildef:- conc(atrdev,":          ",atrpath);
27850		    scanto(atrfildef,':');
27900		    atrfilnam:- rest(atrfildef).Sub(1,10);
27950		    atrfilext:- atrfilnam.Sub(8,3);
28000		    INSPECT NEW directory_path(atrfildef) DO
28050		    BEGIN
28250			IF dirfile == NONE THEN
28300			BEGIN Outtext("%No such directory: ");
28350			    Outtext(compress(atrfildef,' '));
28400			    Outimage;  dh:- NONE;
28450			    GOTO new_file;
28500			END dirfile==NONE;
28510			NEW wildlook.scanfilespec(t);
28520			nextfile:- loadselectedfilenames
28540			(basename,basename_mask,baseext,baseext_mask);
28545			IF nextfile == NONE THEN
28546			BEGIN Outtext("%No such file: ");
28547			    atrfilnam:= t; Outtext(compress(atrfildef,' '));
28548			    Outimage; dh:- NONE; GOTO new_file;
28549			END;
28550		    END new directory_path;
28600		END inspect dh;
28650		GOTO ins_dh;
28700	    END wildcard;
28750	
28800		t:- conc(atrdev,":",t,atrpath);
28850	find_atr_file: !
28900	;
28950		df:- finddirectfile(t,FALSE);
29000		IF df =/= NONE THEN
29050		BEGIN atrfile:- df; library:= FALSE;
29100		    indexblocks:- NONE;
29150		END ELSE
29200		BEGIN Outtext("%Not found."); Outimage;
29250		    IF NOT library THEN atrfile:- NONE;
29300	    END END;
29350	
29400	    IF atrfile=/=NONE THEN
29450	    BEGIN
29500		atrfile.Open(Blanks(3));
29550		atrfile.Image:- NOTEXT; atr_open:= TRUE;
29600		atrload;
29650		IF library THEN
29700		BEGIN ! Scan modules;
29750	next_module: !
29800	;
29850		    IF hit > 0 THEN GOTO look_for_more;
29900		    t:- NOTEXT; WHILE t==NOTEXT DO t:-modulename;
29950		    IF fetchar(t,1) = Char(27) THEN GOTO new_file;
30000		    atrlooker.convert(t);
30050	look_for_more:
30100		    Call(atrlooker);   IF hit > 0 THEN
30150		    BEGIN IF atrlooker.wildmask NE 0 THEN
30200			BEGIN dotypeout(Sysout); Outtext("Display ");
30250			    Outtext(idrx50(atrlooker.entryname));
30300			    t:- inline("?/No/:",Sysin);
30450			    help_decide(t,new_atrspec,new_file,next_module);
30500			END;
30650			load; display; GOTO new_module;
30700		    END hit > 0;
30750		    GOTO new_module;
30760	new_atrspec: hit:= 0; GOTO new_module;
30800		END;
30850		load; display; GOTO new_file;
30900	    END ELSE GOTO new_module;
30950	prog_exit: atrclose;
31000	    INSPECT displayfile DO IF displayfile=/=Sysout THEN Close;
31025	    Outtext("Exit SIMATR."); Outimage; exit(0);
31050	END;
31100	END program;