Google
 

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;