Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/util/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;