Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/util/atrstr.sim
There are 4 other files named atrstr.sim in the archive. Click here to see a list.
00100 OPTIONS(/-Q/-D/-I/-W/-A/E/P:"ATTRIBUTE FILE STRUCTURE");
00200
00300 COMMENT
00400 -------
00500 Written by Lars Enderin, Swedish National Defence Research Institute,
00600 S-104 50 Stockholm 80, Sweden, June 1978.
00700 Copyright (C) 1978 by the Institute. Copying is allowed.
00800
00900
01000 ATRSTR translates the information contained in an ATR (attribute)
01100 file into a SIMULA data structure. The attribute file for a
01200 separately compiled SIMULA module (a SIMULA class, procedure or a
01300 dummy procedure heading for a MACRO-10 or FORTRAN coded procedure)
01400 contains that information which is necessary to determine the correct
01500 code to communicate with the separately compiled external module from
01600 a SIMULA program which uses it. The externally accessible information
01700 of an external module includes a) parameters of procedures and
01800 classes, b) the quantities declared at the outermost block level of a
01900 class, which may be ordinary variables, labels, procedures and local
02000 classes, and c) recursively, the quantities according to (b) for
02100 local classes. An external module also has an "entry name", which is
02200 normally identical to the SIMULA name of the class or procedure
02300 (initial 6 characters) and a "module name", which is derived from the
02400 name of the ATR file when created (if REL file is x.REL, ATR file is
02500 x.ATR). Each module also has an associated "unique identifier" which
02600 is changed when the ATR file information is changed on recompilation.
02700 This identifier and a set of (lexically) immediately following
02800 identifiers is used as global definitions of points within the code
02900 for the external module, e.g. the start of a prototype, start of
03000 declaration coding.
03100
03200 ATR module record layout:
03300
03400 An ATR module consists of 3 parts:
03500
03600 1) Entry and name blocks as in the REL file:
03700
03800 1a) ENTRY block (type 4):
03900
04000 XWD 4,1
04100 EXP 0 ;! relocation bits
04200 RADIX50 0,/<I-name>/
04300
04400 <I-name> is the SIMULA name of the class or procedure.
04500 This information, excluding the zero relocation word, is placed in
04600 the index block of a library file and is used when the module is
04700 looked up.
04800
04900
05000 1b) NAME block (type 6):
05100
05200 XWD 6,1
05300 EXP 0
05400 RADIX50 0,/<E-name>/
05500
05600 <E-name> is determined from the REL file name (<E-name>.REL) given in
05700 the command string to the compiler. Assuming default device,
05800 extensions, and path, the command string is
05900 <E-name>,<L-name>=<S-name> i.e. the file <S-name>.SIM is compiled to
06000 give the REL file <E-name>.REL, the ATR file <E-name>.ATR, the list
06100 file <L-name>.LST.
06200
06300 2) ATR information block:
06400
06500 This is disguised as a REL file comment block (type 0):
06600
06700 XWD 0,M
06800 <N words of ATR information>
06900
07000 The word count, M, is computed from the actual count N by regarding
07100 every 18th word as a relocation word which is not included in M.
07200 This is because LINK-10, LOADER, FUDGE2 and MAKLIB handle REL files
07300 in this fashion. A dummy zero word may sometimes have to be added to
07400 the end of the block to make the count come out correctly.
07500 The ATR information is:
07600
07700 2a) Heading:
07800
07900 One word, zero for a SIMULA procedure, the entry name in RADIX50 for
08000 MACRO-10 or FORTRAN procedures, and a unique identifier with a '%' as
08100 third character for a class.
08200
08300 2b) Attributes:
08400
08500 <A-list>::=ZQU[ZHB[<A-list>]...<zeroword>]
08600
08700 The attributes form an A-list. See Technical Documentation II.6 for
08800 the definition of ZQU and ZHB. Briefly, a ZQU record describes a
08900 declared quantity such as a variable, parameter, procedure or class.
09000 ZHB describes the internal structure of a class or the structure of a
09100 parameter list.
09200
09300 2c) Information for checking:
09400
09500 A list of ZHE(QQUACH) records (see II.6) is created, where each
09600 record corresponds to an external item referenced by this module.
09700 The list ends with a zero word.
09800
09900
10000 3) END block (type 5):
10100
10200 XWD 5,2
10300 EXP 0,0,0
10400
10500 This delimits the ATR module within a library file.
10600
10700 In the old record layout, only part 2 was present. The format was
10800 changed to allow creation of library files by FUDGE2 or MAKLIB, which
10900 treat only REL files. A SIMULA ATR file thus looks like a REL file
11000 with an ENTRY block, a NAME block, a COMMENT block and an END block.
11100
11200
11300
11400 RECORD LAYOUT for library ATR files:
11500
11600
11700 An ATR file with the layout described above may be made part of an
11800 ATR library file. FUDGE2 or MAKLIB can be used to create a library
11900 out of separate ATR files or other libraries. The format is that of
12000 an indexed REL file library:
12100
12200 1) The first block is an index block (type 14), with the structure:
12300
12400 XWD 14,177
12500 <index table>
12600 XWD -1,next
12700
12800 next is the number of the next index block in the file or -1 if no
12900 more index blocks exist.
13000
13100 <index table> consists of a series of <moduleitem>'s, where
13200 <moduleitem> is:
13300
13400 XWD 4,1
13500 RADIX50 0,/<I-name>/
13600 XWD W,B
13700
13800 W is the word offset within block B of the file where the submodule
13900 corresponding to <I-name> starts.
14000
14100
14200 The second block and following blocks (except for inserted index
14300 blocks) contain ATR file information copied into contiguous blocks of
14400 words. If the first block has a pointer to another index block, that
14500 index block is placed before the first submodule referred by an entry
14600 name in it. The second and following index blocks are similar. The
14700 chain of index blocks is finished by a block whose last non-zero word
14800 contains -1.
14900
15000
15100 The ATRSTR class contains classes to map the ATR file structure and
15200 procedures to set up the structure from an ATR file. The ATRLIB class
15300 contains an algorithm for scanning an ATR library file, finding each
15400 module name in turn and allowing for arbitrary use of the information
15500 found before continuing. "Wild card" lookup can be specified, i.e.
15600 parts of the module name can be arbitrary (specified by '?' or '*',
15700 where '*' is equivalent to at most 6 trailing '?' characters).
15800 ;
15900 EXTERNAL INTEGER PROCEDURE input,bitfield,andint,rdx50,
16000 absadr,storebyte,match6,wildsix,sxrx50;
16100 EXTERNAL PROCEDURE abort;
16200 EXTERNAL TEXT PROCEDURE idrx50,idsixbit,litenbokstav,inline;
16300 EXTERNAL CHARACTER PROCEDURE fetchar;
16400
16500 Simset CLASS atrstr;
16600 VIRTUAL: REF(zde) PROCEDURE zdeload;
16700 BEGIN
16800
16900 REF(Directfile)atrfile; !Where ATR info is taken from;
17000 REF(zhe)xzhe; !Keeps track of enclosing block;
17100 REF(zhb)encloser; !D:o;
17200 REF(zqu)lastzqu; !For establishing pointers;
17300 INTEGER header, !Header word of module;
17400 ww0,ww1,ww2,ww3,ww4,ww5; !Workspace;
17500 INTEGER hit; !Word offset,,atr file block no of module;
17600 TEXT entry_name,module_name;
17700 REF(zde)firstzde,lastzde; !List pointers;
17800
17900 REF(Head)zqulist; !List of declarations;
18000 REF(Head) indexblocks; !List of index block data;
18100 REF(index_block) indexblock; !Current index block;
18200 REF(atrlib) atrlooker; !Call(atrlooker) gives next hit (where
18300 ! to find module);
18400
18500 REF(zde) PROCEDURE zdeload(zdetyp); INTEGER zdetyp;
18600 !Loads different type of block depending on zdetyp;
18700 INSPECT
18800 (IF zdetyp=qzqu THEN NEW zqu ELSE
18900 (IF zdetyp=qzhb THEN NEW zhb ELSE
19000 (IF zdetyp=qzhe THEN NEW zhe ELSE
19100 (IF zdetyp=-1 THEN NEW zeb ELSE
19200 (IF zdetyp=-2 THEN NEW zheqquach ELSE NONE)))))
19300 DO BEGIN zdeload:- THIS zde; load END;
19400
19500
19600 CLASS atrlib;
19700 !Describes structure of ATR library and scans index blocks;
19800 BEGIN
19900 INTEGER mname, !RADIX50 or SIXBIT module name;
20000 wildmask, !8R77 in wild card positions;
20100 index, !Current index in index block;
20200 subheader, !Header of index item;
20300 entryname; !RADIX50 name of module;
20400
20500 PROCEDURE convert(id); TEXT id;
20600 !Converts id to SIXBIT (or RADIX50) and determines wildmask;
20700 BEGIN mname:= wildsix(id,wildmask,6);
20800 IF wildmask = 0 THEN mname:= rdx50(id,0);
20900 END convert;
21000
21100 indexblocks:- NEW head;
21200
21300 lookstart: !
21400 ;
21500 hit:= 0; Detach;
21600 indexblock:- indexblocks.first;
21700
21800 loadindex: !
21900 ;
22000
22100 next_block: !
22200 ;
22300 IF indexblock == NONE THEN
22400 BEGIN indexblock:- NEW index_block; indexblock.load
22500 END;
22600
22700 index:= subheader:= 1;
22800 WHILE subheader >= 0 DO
22900 BEGIN !Scan an index block to the end;
23000 subheader:= indexblock.ixbl(index);
23100 IF subheader = 8R4000001 THEN
23200 BEGIN entryname:= indexblock.ixbl(index+1);
23300 IF wildmask = 0 THEN
23400 BEGIN !Leave entryname in radix50 code, exact match needed;
23500 IF mname = entryname THEN
23600 BEGIN
23700 hit:= indexblock.ixbl(index+2);
23800 Detach; !Report success;
23900 GOTO lookstart; !Satisfied;
24000 END
24100 END ELSE
24200 BEGIN
24300 IF match6(sxrx50(entryname),mname,wildmask) NE 0 THEN
24400 BEGIN hit:= indexblock.ixbl(index+2);
24500 Detach; !Report, prepared to scan on;
24600 END;
24700 END;
24800 index:= index+3; !Assume only one entry per module!;
24900 END ELSE
25000 IF subheader > 0 THEN abort("Illegal ATR file format");
25100 END subheader >= 0;
25200
25300 IF subheader+1 < 0 THEN
25400 BEGIN !There is a next block;
25500 index:= andint(subheader,rhmask);
25600 atrfile.Locate(index*128-127);
25700 indexblock:- indexblock.suc;
25800 GOTO loadindex
25900 END;
26000 GOTO lookstart; !Index block exhausted;
26100 END atrlib;
26200
26300 Link CLASS index_block;
26400 BEGIN INTEGER ARRAY ixbl[0:127];
26500 PROCEDURE load; input(atrfile,ixbl);
26600 Into(indexblocks);
26700 END index_block;
26800
26900
27000 PROCEDURE atr_reset;
27100 BEGIN
27200 xzhe:- firstzde:- lastzde:- NONE;
27300 zqulist.Clear;
27400 lastzqu:- NONE;
27500 END atr_reset;
27600
27700
27800 PROCEDURE atrload;
27900 !Determine type of ATR file from first word, start looker for lib;
28000 INSPECT atrfile DO
28100 BEGIN
28300 input(atrfile,ww0); library:= FALSE;
28400 IF ww0 = 8R14000177 THEN
28500 BEGIN library:=TRUE;
28600 atrlooker:- NEW atrlib;
28700 END;
28800 Locate(1);
28900 END;
29000
29100 PROCEDURE load;
29200 INSPECT atrfile DO
29300 BEGIN
29400 IF library THEN
29500 BEGIN !HIT = word offset * 2^18 + 128-word block no;
29600 ww1:= bitfield(hit,0,18);
29700 ww0:= andint(hit,rhmask);
29800 atrfile.Locate(ww0*128 + ww1 - 127);
29900 END;
30000 input(atrfile,ww0);
30100 IF ww0=8r4000001 THEN
30200 BEGIN
30300 !Entry and name block;
30400 input(atrfile,ww1,ww2,ww3,ww4,ww5,ww0,header);
30500 entry_name:- idrx50(ww2); module_name:- idrx50(ww5);
30600 END;
30700 !Load the whole module structure;
30800 read_first_word:
30900 input(atrfile,ww0);
31000 IF ww0 NE 0 THEN
31100 BEGIN
31200 zdeload(bitfield(ww0,0,3));
31300 GO TO read_first_word;
31400 END;
31500 zdeload(-1); !ZEB, end of block;
31600 IF xzhe=/=NONE THEN GO TO read_first_word;
31700 input(atrfile,ww0);
31800 WHILE ww0 NE 0 DO
31900 BEGIN
32000 zdeload(-2); !ZHE(QQUACH) list of unique number vs. lexical;
32100 input(atrfile,ww0);
32200 END;
32300 END load;
32400 !Declaration stack codes;
32500
32600
32700 INTEGER qzqu,qzhb,qzhe;
32800 !zhe and zhb block type codes;
32900 INTEGER qfor,qrblock,qublock,qprocb,qpblock,qclasb,qinspec,qproto,
33000 qebloc,qcext,qpext,qmext,qfext,qsyscl;
33100 INTEGER qquach;
33200 INTEGER qundef; !=0;
33300 !Variable type codes;
33400 INTEGER qnotype,qinteger,qreal,qlreal,qcharacter,qref,qtext,
33500 qlabel,qboolean,qrlreal;
33600 !Kind codes (zqu.knd values);
33700 INTEGER qsimple,qarray,qprocedure,qclass;
33800 !mode codes (zqu.Mod);
33900 INTEGER qdeclared,qvalue,qname,qrefer,qvirtual,qhdn,qnhdn;
34000 INTEGER qexmac,qexmqi,qexfor,qexf40; !zhb.mfo values;
34100 INTEGER rhmask;
34200 BOOLEAN library;
34300
34400
34500 Link CLASS zde; !Dynamic record;
34600 VIRTUAL: PROCEDURE load,display;
34700 BEGIN
34800 INTEGER w0;
34900 REF(zde)next; !Chain to next record in structure;
35000 PROCEDURE load; w0:= ww0;
35100 IF lastzde =/= NONE THEN lastzde.next:- THIS zde
35200 ELSE firstzde:- THIS zde;
35300 lastzde:- THIS zde;
35400 END zde;
35500
35600 zde CLASS zqu; !Declaration quantity;
35700 BEGIN
35800 INTEGER w1,id6a,id6b,qid6a,qid6b;
35900 INTEGER typ,mode,knd;
36000 REF(zhe)zquzhe; !Enclosing block header;
36100 REF(zqu)zquzqu; !Pointer to ZQU for qualifying class;
36200 REF(zhb)zquzb; !Parameter and attribute list header;
36300 BOOLEAN PROCEDURE ext; ext:= bitfield(w0,4,1) > 0;
36400 !TRUE if external;
36500 BOOLEAN PROCEDURE tpt; tpt:= bitfield(w0,6,1) > 0;
36600 BOOLEAN PROCEDURE sys; sys:= bitfield(w0,7,1) > 0;
36700 INTEGER PROCEDURE tmk; tmk:= bitfield(w1,8,10);
36800 INTEGER PROCEDURE ind; ind:= bitfield(w1,18,-18);
36900 INTEGER PROCEDURE nsb; nsb:= bitfield(w1,1,5);
37000 TEXT PROCEDURE id; id:- litenbokstav(idsixbit(id6a,id6b));
37100 TEXT PROCEDURE qid; !Name of qualifying class if any;
37200 qid:- IF typ=qlabel THEN idrx50(qid6a) ELSE
37300 litenbokstav(idsixbit(qid6a,qid6b));
37400
37500 BOOLEAN PROCEDURE declared_class_or_procedure;
37600 declared_class_or_procedure:=
37700 IF NOT mode=qdeclared THEN FALSE ELSE
37800 IF knd=qclass THEN TRUE ELSE
37900 knd=qprocedure AND typ NE qlabel;
38000
38100 BOOLEAN PROCEDURE parameter;
38200 parameter:= mode=qrefer OR mode=qvalue OR mode=qname;
38300
38400 BOOLEAN PROCEDURE same_type_and_kind(z); REF (zqu) z;
38500 IF z=/=NONE THEN
38600 BEGIN
38700 IF typ=z.typ AND knd=z.knd
38800 AND (parameter AND z.parameter OR mode=z.mode) THEN
38900 same_type_and_kind:=
39000 IF typ NE qref THEN TRUE ELSE
39100 qid6a=z.qid6a AND qid6b=z.qid6b;
39200 END same_type_and_kind;
39300
39400 PROCEDURE load;
39500 BEGIN
39600 w0:= ww0;
39700 input(atrfile,w1,id6a,id6b,qid6a,qid6b);
39800 typ:= bitfield(w0,8,4);
39900 mode:= bitfield(w0,12,3);
40000 knd:= bitfield(w0,15,3);
40100 zquzhe:- xzhe;
40200 INSPECT zquzhe WHEN zhb DO THIS zqu.Into(zqulist)
40300 OTHERWISE Into(zqulist);
40400 IF (IF NOT mode=qdeclared THEN FALSE ELSE
40500 IF knd=qclass THEN TRUE ELSE
40600 knd=qprocedure AND typ NE qlabel)
40700 THEN lastzqu:- THIS zqu;
40800 END load;
40900 END zqu;
41000
41100 zde CLASS zeb;
41200 BEGIN !marks end of CLASS or PROCEDURE zqu sublist;
41300 REF(zhb)list_header;
41400 PROCEDURE load;
41500 BEGIN
41600 w0:= ww0;
41700 INSPECT xzhe WHEN zhb DO
41800 BEGIN
41900 list_header:- THIS zhb;
42000 list_trailer:- THIS zeb;
42100 xzhe:- encloser;
42200 END OTHERWISE xzhe:- NONE;
42300 END;
42400 END zeb;
42500
42600 zde CLASS zheqquach;
42700 BEGIN !Shows matching SIMULA id and unique reference id;
42800 INTEGER unr,id6a,id6b;
42900 TEXT PROCEDURE id; id:- idsixbit(id6a,id6b);
43000 PROCEDURE load;
43100 BEGIN w0:= ww0;
43200 input(atrfile,unr,id6a,id6b);
43300 END load;
43400 END zheqquach;
43500
43600 zde CLASS zhe; !Block header, not used separately in ATR files;
43700 BEGIN
43800 INTEGER w1,w2,w3;
43900 REF(zeb)list_trailer;
44000 INTEGER PROCEDURE zhetyp; zhetyp:= bitfield(w0,3,3);
44100 INTEGER PROCEDURE sol; sol:= bitfield(w0,12,6);
44200 INTEGER PROCEDURE dlv; dlv:= -bitfield(w0,18,-18);
44300 INTEGER PROCEDURE ebl; ebl:= -bitfield(w1,0,5);
44400 INTEGER PROCEDURE len; len:= bitfield(w1,5,10);
44500 INTEGER PROCEDURE bnm; bnm:= bitfield(w1,15,9);
44600 BOOLEAN PROCEDURE noi; noi:= bitfield(w0,11,1) > 0;
44700 PROCEDURE load;
44800 BEGIN
44900 input(atrfile,w1,w2,w3);
45000 w0:= ww0;
45100 END;
45200 END;
45300
45400 zhe CLASS zhb; !Header for parameters and attributes;
45500 BEGIN
45600 INTEGER unr;
45700 REF(Head)zqulist;
45800 REF(zqu)zhbzqu;
45900 REF(zhb) prefix;
46000 INTEGER nrp;
46100 REF(zhb)encloser;
46200 INTEGER PROCEDURE vrt; vrt:= bitfield(w3,8,8);
46300 INTEGER PROCEDURE sbl; sbl:= -bitfield(w3,16,5);
46400 INTEGER PROCEDURE std; std:= bitfield(w3,21,5);
46500 INTEGER PROCEDURE szd; szd:= bitfield(w3,26,5);
46600 INTEGER PROCEDURE mfo; mfo:= bitfield(w3,31,3);
46700 BOOLEAN PROCEDURE upf; upf:= bitfield(w3,31,1) > 0;
46800 BOOLEAN PROCEDURE loc; loc:= bitfield(w3,33,1) > 0;
46900 BOOLEAN PROCEDURE kdp; kdp:= bitfield(w3,34,1) > 0;
47000 BOOLEAN PROCEDURE nck; nck:= bitfield(w3,34,1) > 0;
47100 PROCEDURE load;
47200 BEGIN w0:= ww0;
47300 input(atrfile,w1,w2,w3,unr);
47400 nrp:= bitfield(w3,0,8);
47500 zhbzqu:- lastzqu;
47600 lastzqu.zquzb:- THIS zhb; encloser:- xzhe;
47700 IF zhetyp = qclasb OR zhetyp = qprocb THEN xzhe:- THIS zhb;
47800 zqulist:- NEW Head;
47900 INSPECT zhbzqu DO
48000 IF qid6a NE 0 THEN
48100 BEGIN REF(zqu)z; TEXT t;
48200 z:- THIS zqu;
48300 l: z:- z.Pred; IF z=/=NONE THEN
48400 BEGIN IF z.id6a NE qid6a OR z.qid6b NE qid6b THEN GO TO l END;
48500 IF z=/=NONE THEN prefix:- z.zquzb;
48600 END INSPECT zhbzqu;
48700 END load;
48800 END zhb;
48900
49000 qinteger:= 1; qreal:= 2; qlreal:= 3; qcharacter:= 4; qboolean:= 5;
49100 qtext:= 6;
49200 qref:= 7; qlabel:= 8; qnotype:= 9; qrlreal:= 10;
49300 qsimple:= 1; qarray:= 2; qprocedure:= 3; qclass:= 4;
49400
49500 !qdeclared:= 0; qvalue:= 1; qname:= 2; qrefer:= 3; qvirtual:= 4;
49600 qhdn:= 6; qnhdn:= 7;
49700
49800 qzqu:= 4; qzhb:= 2; qzhe:= 1;
49900
50000 !qfor:= 0; qrblock:= 1; qublock:= 2; qprocb:= 3; qpblock:= 4;
50100 qclasb:= 5; qinspec:= 6; qproto:= 7; qebloc:= 8; qcext:= 9;
50200 qpext:= 10; qmext:= 11; qfext:= 12; qsyscl:= 13;
50300 qquach:= qproto;
50400 qexmac:= 1; qexmqi:= 2; qexfor:= 4; qexf40:= 5;
50500 zqulist:- NEW Head;
50600 rhmask:= 8R777777;
50700 END siminfo;