Subversion Repositories tendra.SVN

Rev

Rev 5 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 5 Rev 6
Line -... Line 1...
- 
 
 1 
/*
- 
 
 2 
 * Copyright (c) 2002-2006 The TenDRA Project <http://www.tendra.org/>.
- 
 
 3 
 * All rights reserved.
- 
 
 4 
 *
- 
 
 5 
 * Redistribution and use in source and binary forms, with or without
- 
 
 6 
 * modification, are permitted provided that the following conditions are met:
- 
 
 7 
 *
- 
 
 8 
 * 1. Redistributions of source code must retain the above copyright notice,
- 
 
 9 
 *    this list of conditions and the following disclaimer.
- 
 
 10 
 * 2. Redistributions in binary form must reproduce the above copyright notice,
- 
 
 11 
 *    this list of conditions and the following disclaimer in the documentation
- 
 
 12 
 *    and/or other materials provided with the distribution.
- 
 
 13 
 * 3. Neither the name of The TenDRA Project nor the names of its contributors
- 
 
 14 
 *    may be used to endorse or promote products derived from this software
- 
 
 15 
 *    without specific, prior written permission.
- 
 
 16 
 *
- 
 
 17 
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
- 
 
 18 
 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
- 
 
 19 
 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
- 
 
 20 
 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
- 
 
 21 
 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- 
 
 22 
 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- 
 
 23 
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
- 
 
 24 
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
- 
 
 25 
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
- 
 
 26 
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
- 
 
 27 
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- 
 
 28 
 *
- 
 
 29 
 * $Id$
- 
 
 30 
 */
1 
/*
 31 
/*
2 
    		 Crown Copyright (c) 1997
 32 
    		 Crown Copyright (c) 1997
3
33 
 
4 
    This TenDRA(r) Computer Program is subject to Copyright
 34 
    This TenDRA(r) Computer Program is subject to Copyright
5 
    owned by the United Kingdom Secretary of State for Defence
 35 
    owned by the United Kingdom Secretary of State for Defence
6 
    acting through the Defence Evaluation and Research Agency
 36 
    acting through the Defence Evaluation and Research Agency
7 
    (DERA).  It is made available to Recipients with a
 37 
    (DERA).  It is made available to Recipients with a
8 
    royalty-free licence for its use, reproduction, transfer
 38 
    royalty-free licence for its use, reproduction, transfer
9 
    to other parties and amendment for any purpose not excluding
 39 
    to other parties and amendment for any purpose not excluding
10 
    product development provided that any such use et cetera
 40 
    product development provided that any such use et cetera
11 
    shall be deemed to be acceptance of the following conditions:-
 41 
    shall be deemed to be acceptance of the following conditions:-
12
42 
 
13 
        (1) Its Recipients shall ensure that this Notice is
 43 
        (1) Its Recipients shall ensure that this Notice is
14 
        reproduced upon any copies or amended versions of it;
 44 
        reproduced upon any copies or amended versions of it;
15
45 
 
16 
        (2) Any amended version of it shall be clearly marked to
 46 
        (2) Any amended version of it shall be clearly marked to
17 
        show both the nature of and the organisation responsible
 47 
        show both the nature of and the organisation responsible
18 
        for the relevant amendment or amendments;
 48 
        for the relevant amendment or amendments;
19
49 
 
20 
        (3) Its onward transfer from a recipient to another
 50 
        (3) Its onward transfer from a recipient to another
21 
        party shall be deemed to be that party's acceptance of
 51 
        party shall be deemed to be that party's acceptance of
22 
        these conditions;
 52 
        these conditions;
23
53 
 
24 
        (4) DERA gives no warranty or assurance as to its
 54 
        (4) DERA gives no warranty or assurance as to its
25 
        quality or suitability for any purpose and DERA accepts
 55 
        quality or suitability for any purpose and DERA accepts
26 
        no liability whatsoever in relation to any use to which
 56 
        no liability whatsoever in relation to any use to which
27 
        it may be put.
 57 
        it may be put.
28 
*/
 58 
*/
Line 74... Line 104...
74 
 
 104 
 
75 
    These variables give the standard tokens used in the diagnostic
 105 
    These variables give the standard tokens used in the diagnostic
76 
    output.
 106 
    output.
77 
*/
 107 
*/
78 
 
 108 
 
79 
static ulong diag_id_scope_tok = LINK_NONE ;
 109 
static ulong diag_id_scope_tok = LINK_NONE;
80 
static ulong exp_to_source_tok = LINK_NONE ;
 110 
static ulong exp_to_source_tok = LINK_NONE;
81 
 
 111 
 
82 
 
 112 
 
83 
/*
 113 
/*
84 
    ENCODE A DIAGNOSTIC FILE NAME
 114 
    ENCODE A DIAGNOSTIC FILE NAME
85 
 
 115 
 
86 
    This routine adds the diagnostic file name given by posn to the
 116 
    This routine adds the diagnostic file name given by posn to the
87 
    bitstream bs.
 117 
    bitstream bs.
88 
*/
 118 
*/
89 
 
 119 
 
90 
static BITSTREAM *enc_diag_file
 120 
static BITSTREAM *
91 
    PROTO_N ( ( bs, posn ) )
 - 
 
92 
    PROTO_T ( BITSTREAM *bs X PTR ( POSITION ) posn )
 121 
enc_diag_file(BITSTREAM *bs, PTR(POSITION)posn)
93 
{
 122 
{
94 
    ulong n = DEREF_ulong ( posn_tok ( posn ) ) ;
 123 
	ulong n = DEREF_ulong(posn_tok(posn));
95 
    if ( n == LINK_NONE ) {
 124 
	if (n == LINK_NONE) {
96 
	BITSTREAM *ts ;
 125 
		BITSTREAM *ts;
97 
	string bn = DEREF_string ( posn_base ( posn ) ) ;
 126 
		string bn = DEREF_string(posn_base(posn));
98 
	string mn = ustrlit ( find_machine () ) ;
 127 
		string mn = ustrlit(find_machine());
99 
	ulong date = DEREF_ulong ( posn_datestamp ( posn ) ) ;
 128 
		ulong date = DEREF_ulong(posn_datestamp(posn));
100 
	n = capsule_no ( NULL_string, VAR_token ) ;
 129 
		n = capsule_no(NULL_string, VAR_token);
101 
	COPY_ulong ( posn_tok ( posn ), n ) ;
 130 
		COPY_ulong(posn_tok(posn), n);
102 
	if ( !output_date ) date = 0 ;
 131 
		if (!output_date) {
- 
 
 132 
			date = 0;
- 
 
 133 
		}
103 
	ts = enc_tokdef_start ( n, "P", NIL ( ulong ), 0 ) ;
 134 
		ts = enc_tokdef_start(n, "P", NIL(ulong), 0);
104 
	ENC_make_filename ( ts ) ;
 135 
		ENC_make_filename(ts);
105 
	ENC_make_nat ( ts ) ;
 136 
		ENC_make_nat(ts);
106 
	ENC_INT ( ts, date ) ;
 137 
		ENC_INT(ts, date);
107 
	ts = enc_ustring ( ts, mn ) ;
 138 
		ts = enc_ustring(ts, mn);
108 
	ts = enc_ustring ( ts, bn ) ;
 139 
		ts = enc_ustring(ts, bn);
109 
	enc_tokdef_end ( n, ts ) ;
 140 
		enc_tokdef_end(n, ts);
110 
    }
 141 
	}
111 
 
 142 
 
112 
    /* Encode token application */
 143 
	/* Encode token application */
113 
    ENC_filename_apply_token ( bs ) ;
 144 
	ENC_filename_apply_token(bs);
114 
    n = link_no ( bs, n, VAR_token ) ;
 145 
	n = link_no(bs, n, VAR_token);
115 
    ENC_make_tok ( bs, n ) ;
 146 
	ENC_make_tok(bs, n);
116 
    ENC_LEN_SMALL ( bs, 0 ) ;
 147 
	ENC_LEN_SMALL(bs, 0);
117 
    return ( bs ) ;
 148 
	return (bs);
118 
}
 149 
}
119 
 
 150 
 
120 
 
 151 
 
121 
/*
 152 
/*
122 
    ENCODE A DIAGNOSTIC SOURCE MARK
 153 
    ENCODE A DIAGNOSTIC SOURCE MARK
123 
 
 154 
 
124 
    This routine adds the diagnostic source mark given by loc to the
 155 
    This routine adds the diagnostic source mark given by loc to the
125 
    bitstream bs.
 156 
    bitstream bs.
126 
*/
 157 
*/
127 
 
 158 
 
128 
static BITSTREAM *enc_diag_loc
 159 
static BITSTREAM *
129 
    PROTO_N ( ( bs, loc ) )
 - 
 
130 
    PROTO_T ( BITSTREAM *bs X PTR ( LOCATION ) loc )
 160 
enc_diag_loc(BITSTREAM *bs, PTR(LOCATION)loc)
131 
{
 161 
{
132 
    ulong ln, cn ;
 162 
	ulong ln, cn;
133 
    PTR ( POSITION ) posn ;
 163 
	PTR(POSITION)posn;
134 
    if ( IS_NULL_ptr ( loc ) ) {
 164 
	if (IS_NULL_ptr(loc)) {
135 
	ln = builtin_loc.line ;
 165 
		ln = builtin_loc.line;
136 
	cn = builtin_loc.line ;
 166 
		cn = builtin_loc.line;
137 
	posn = builtin_loc.posn ;
 167 
		posn = builtin_loc.posn;
138 
    } else {
 168 
	} else {
139 
	ln = DEREF_ulong ( loc_line ( loc ) ) ;
 169 
		ln = DEREF_ulong(loc_line(loc));
140 
	cn = DEREF_ulong ( loc_column ( loc ) ) ;
 170 
		cn = DEREF_ulong(loc_column(loc));
141 
	posn = DEREF_ptr ( loc_posn ( loc ) ) ;
 171 
		posn = DEREF_ptr(loc_posn(loc));
142 
    }
 172 
	}
143 
    ENC_make_sourcemark ( bs ) ;
 173 
	ENC_make_sourcemark(bs);
144 
    bs = enc_diag_file ( bs, posn ) ;
 174 
	bs = enc_diag_file(bs, posn);
145 
    ENC_make_nat ( bs ) ;
 175 
	ENC_make_nat(bs);
146 
    ENC_INT ( bs, ln ) ;
 176 
	ENC_INT(bs, ln);
147 
    ENC_make_nat ( bs ) ;
 177 
	ENC_make_nat(bs);
148 
    ENC_INT ( bs, cn ) ;
 178 
	ENC_INT(bs, cn);
149 
    return ( bs ) ;
 179 
	return (bs);
150 
}
 180 
}
151 
 
 181 
 
152 
 
 182 
 
153 
/*
 183 
/*
154 
    ENCODE A DIAGNOSTIC IDENTIFIER NAME
 184 
    ENCODE A DIAGNOSTIC IDENTIFIER NAME
155 
 
 185 
 
156 
    This routine adds the name of the identifier id to the bitstream bs
 186 
    This routine adds the name of the identifier id to the bitstream bs
157 
    as a TDF string.
 187 
    as a TDF string.
158 
*/
 188 
*/
159 
 
 189 
 
160 
BITSTREAM *enc_diag_name
 190 
BITSTREAM *
161 
    PROTO_N ( ( bs, id, q ) )
 - 
 
162 
    PROTO_T ( BITSTREAM *bs X IDENTIFIER id X int q )
 191 
enc_diag_name(BITSTREAM *bs, IDENTIFIER id, int q)
163 
{
 192 
{
164 
    string s = mangle_diag ( id, q ) ;
 193 
	string s = mangle_diag(id, q);
165 
    bs = enc_ustring ( bs, s ) ;
 194 
	bs = enc_ustring(bs, s);
166 
    return ( bs ) ;
 195 
	return (bs);
167 
}
 196 
}
168 
 
 197 
 
169 
 
 198 
 
170 
/*
 199 
/*
171 
    ENCODE THE START OF A DIAGNOSTIC TAG DEFINITION
 200 
    ENCODE THE START OF A DIAGNOSTIC TAG DEFINITION
172 
 
 201 
 
173 
    This routine encodes the start of a diagnostic tag definition for
 202 
    This routine encodes the start of a diagnostic tag definition for
174 
    diagnostic tag number n.  It returns a bitstream to which the
 203 
    diagnostic tag number n.  It returns a bitstream to which the
175 
    diagnostic type definition needs to be added.
 204 
    diagnostic type definition needs to be added.
176 
*/
 205 
*/
177 
 
 206 
 
178 
static BITSTREAM *enc_diag_tagdef_start
 207 
static BITSTREAM *
179 
    PROTO_N ( ( n ) )
 - 
 
180 
    PROTO_T ( ulong n )
 208 
enc_diag_tagdef_start(ulong n)
181 
{
 209 
{
182 
    BITSTREAM *bs = start_bitstream ( NIL ( FILE ), diagtype_unit->link ) ;
 210 
	BITSTREAM *bs = start_bitstream(NIL(FILE), diagtype_unit->link);
183 
    record_usage ( n, VAR_diagtag, USAGE_DEFN ) ;
 211 
	record_usage(n, VAR_diagtag, USAGE_DEFN);
184 
    ENC_make_diag_tagdef ( bs ) ;
 212 
	ENC_make_diag_tagdef(bs);
185 
    n = link_no ( bs, n, VAR_diagtag ) ;
 213 
	n = link_no(bs, n, VAR_diagtag);
186 
    ENC_INT ( bs, n ) ;
 214 
	ENC_INT(bs, n);
187 
    return ( bs ) ;
 215 
	return (bs);
188 
}
 216 
}
189 
 
 217 
 
190 
 
 218 
 
191 
/*
 219 
/*
192 
    ENCODE THE END OF A DIAGNOSTIC TAG DEFINITION
 220 
    ENCODE THE END OF A DIAGNOSTIC TAG DEFINITION
193 
 
 221 
 
194 
    This routine completes the definition of a diagnostic tag.  bs is the
 222 
    This routine completes the definition of a diagnostic tag.  bs is the
195 
    result of a previous call to enc_diag_tagdef_start.
 223 
    result of a previous call to enc_diag_tagdef_start.
196 
*/
 224 
*/
197 
 
 225 
 
198 
static void enc_diag_tagdef_end
 226 
static void
199 
    PROTO_N ( ( bs ) )
 - 
 
200 
    PROTO_T ( BITSTREAM *bs )
 227 
enc_diag_tagdef_end(BITSTREAM *bs)
201 
{
 228 
{
202 
    count_item ( bs ) ;
 229 
	count_item(bs);
203 
    diagtype_unit = join_bitstreams ( diagtype_unit, bs ) ;
 230 
	diagtype_unit = join_bitstreams(diagtype_unit, bs);
204 
    return ;
 231 
	return;
205 
}
 232 
}
206 
 
 233 
 
207 
 
 234 
 
208 
/*
 235 
/*
209 
    ENCODE A LIST OF DIAGNOSTIC BASE CLASSES
 236 
    ENCODE A LIST OF DIAGNOSTIC BASE CLASSES
210 
 
 237 
 
211 
    This routine adds the list of diagnostic base classes given by br
 238 
    This routine adds the list of diagnostic base classes given by br
212 
    to the bitstream bs in reverse order.  A count of the number of bases
 239 
    to the bitstream bs in reverse order.  A count of the number of bases
213 
    is maintained in pm.
 240 
    is maintained in pm.
214 
*/
 241 
*/
215 
 
 242 
 
216 
static BITSTREAM *enc_diag_bases
 243 
static BITSTREAM *
217 
    PROTO_N ( ( bs, br, pm ) )
 - 
 
218 
    PROTO_T ( BITSTREAM *bs X LIST ( GRAPH ) br X unsigned *pm )
 244 
enc_diag_bases(BITSTREAM *bs, LIST(GRAPH)br, unsigned *pm)
219 
{
 - 
 
220 
    if ( !IS_NULL_list ( br ) ) {
 - 
 
221 
	GRAPH gs = DEREF_graph ( HEAD_list ( br ) ) ;
 - 
 
222 
	CLASS_TYPE cs = DEREF_ctype ( graph_head ( gs ) ) ;
 - 
 
223 
	IDENTIFIER cid = DEREF_id ( ctype_name ( cs ) ) ;
 - 
 
224 
	DECL_SPEC acc = DEREF_dspec ( graph_access ( gs ) ) ;
 - 
 
225 
	bs = enc_diag_bases ( bs, TAIL_list ( br ), pm ) ;
 - 
 
226 
	bs = enc_diag_name ( bs, cid, 0 ) ;
 - 
 
227 
	bs = enc_base ( bs, gs, 1 ) ;
 - 
 
228 
	if ( acc & dspec_virtual ) {
 - 
 
229 
	    ENC_diag_ptr ( bs ) ;
 - 
 
230 
	    bs = enc_diag_ctype ( bs, cs ) ;
 - 
 
231 
	    ENC_diag_tq_null ( bs ) ;
 - 
 
232 
	} else {
 - 
 
233 
	    bs = enc_diag_ctype ( bs, cs ) ;
 - 
 
234 
	}
 - 
 
235 
	( *pm )++ ;
 - 
 
236 
    }
 - 
 
237 
    return ( bs ) ;
 - 
 
238 
}
 - 
 
239 
 
 - 
 
240 
 
 - 
 
241 
/*
 - 
 
242 
    ENCODE A LIST OF DIAGNOSTIC CLASS MEMBERS
 - 
 
243 
 
 - 
 
244 
    This routine adds the list of diagnostic class members given by mem
 - 
 
245 
    to the bitstream bs in reverse order.  A count of the number of members
 - 
 
246 
    is maintained in pm.
 - 
 
247 
*/
 - 
 
248 
 
 - 
 
249 
static BITSTREAM *enc_diag_mems
 - 
 
250 
    PROTO_N ( ( bs, mem, pm ) )
 - 
 
251 
    PROTO_T ( BITSTREAM *bs X MEMBER mem X unsigned *pm )
 - 
 
252 
{
 245 
{
253 
    if ( !IS_NULL_member ( mem ) ) {
 246 
	if (!IS_NULL_list(br)) {
254 
	IDENTIFIER mid = DEREF_id ( member_id ( mem ) ) ;
 247 
		GRAPH gs = DEREF_graph(HEAD_list(br));
255 
	TYPE s = DEREF_type ( id_member_type ( mid ) ) ;
 248 
		CLASS_TYPE cs = DEREF_ctype(graph_head(gs));
256 
	mem = DEREF_member ( member_next ( mem ) ) ;
 249 
		IDENTIFIER cid = DEREF_id(ctype_name(cs));
257 
	mem = next_data_member ( mem, 2 ) ;
 250 
		DECL_SPEC acc = DEREF_dspec(graph_access(gs));
258 
	bs = enc_diag_mems ( bs, mem, pm ) ;
 251 
		bs = enc_diag_bases(bs, TAIL_list(br), pm);
259 
	bs = enc_diag_name ( bs, mid, 0 ) ;
 252 
		bs = enc_diag_name(bs, cid, 0);
260 
	bs = enc_member ( bs, mid ) ;
 253 
		bs = enc_base(bs, gs, 1);
- 
 
 254 
		if (acc & dspec_virtual) {
- 
 
 255 
			ENC_diag_ptr(bs);
- 
 
 256 
			bs = enc_diag_ctype(bs, cs);
- 
 
 257 
			ENC_diag_tq_null(bs);
- 
 
 258 
		} else {
261 
	bs = enc_diag_type ( bs, s, 0 ) ;
 259 
			bs = enc_diag_ctype(bs, cs);
- 
 
 260 
		}
262 
	( *pm )++ ;
 261 
		(*pm)++;
263 
    }
 262 
	}
264 
    return ( bs ) ;
 263 
	return (bs);
265 
}
 264 
}
- 
 
 265 
 
266 
 
 266 
 
- 
 
 267 
/*
- 
 
 268 
    ENCODE A LIST OF DIAGNOSTIC CLASS MEMBERS
- 
 
 269 
 
- 
 
 270 
    This routine adds the list of diagnostic class members given by mem
- 
 
 271 
    to the bitstream bs in reverse order.  A count of the number of members
- 
 
 272 
    is maintained in pm.
- 
 
 273 
*/
- 
 
 274 
 
- 
 
 275 
static BITSTREAM *
- 
 
 276 
enc_diag_mems(BITSTREAM *bs, MEMBER mem, unsigned *pm)
- 
 
 277 
{
- 
 
 278 
	if (!IS_NULL_member(mem)) {
- 
 
 279 
		IDENTIFIER mid = DEREF_id(member_id(mem));
- 
 
 280 
		TYPE s = DEREF_type(id_member_type(mid));
- 
 
 281 
		mem = DEREF_member(member_next(mem));
- 
 
 282 
		mem = next_data_member(mem, 2);
- 
 
 283 
		bs = enc_diag_mems(bs, mem, pm);
- 
 
 284 
		bs = enc_diag_name(bs, mid, 0);
- 
 
 285 
		bs = enc_member(bs, mid);
- 
 
 286 
		bs = enc_diag_type(bs, s, 0);
- 
 
 287 
		(*pm)++;
- 
 
 288 
	}
- 
 
 289 
	return (bs);
- 
 
 290 
}
- 
 
 291 
 
267 
 
 292 
 
268 
/*
 293 
/*
269 
    ENCODE A DIAGNOSTIC VIRTUAL FUNCTION TABLE
 294 
    ENCODE A DIAGNOSTIC VIRTUAL FUNCTION TABLE
270 
 
 295 
 
271 
    This routine adds the diagnostic information for the virtual function
 296 
    This routine adds the diagnostic information for the virtual function
272 
    table vt to the bitstream bs.  A count of the number of items is
 297 
    table vt to the bitstream bs.  A count of the number of items is
273 
    maintained in pm.
 298 
    maintained in pm.
274 
*/
 299 
*/
275 
 
 300 
 
276 
static BITSTREAM *enc_diag_vtable
 301 
static BITSTREAM *
277 
    PROTO_N ( ( bs, vt, pm ) )
 - 
 
278 
    PROTO_T ( BITSTREAM *bs X VIRTUAL vt X unsigned *pm )
 302 
enc_diag_vtable(BITSTREAM *bs, VIRTUAL vt, unsigned *pm)
279 
{
 303 
{
280 
    while ( !IS_NULL_virt ( vt ) ) {
 304 
	while (!IS_NULL_virt(vt)) {
281 
	OFFSET off = DEREF_off ( virt_table_off ( vt ) ) ;
 305 
		OFFSET off = DEREF_off(virt_table_off(vt));
282 
	if ( IS_NULL_off ( off ) ) {
 306 
		if (IS_NULL_off(off)) {
283 
	    /* New virtual function table */
 307 
			/* New virtual function table */
284 
	    ulong n = DEREF_ulong ( virt_table_tok ( vt ) ) ;
 308 
			ulong n = DEREF_ulong(virt_table_tok(vt));
285 
	    bs = enc_ustring ( bs, ustrlit ( "__vptr" ) ) ;
 309 
			bs = enc_ustring(bs, ustrlit("__vptr"));
286 
	    ENC_exp_apply_token ( bs ) ;
 310 
			ENC_exp_apply_token(bs);
287 
	    n = link_no ( bs, n, VAR_token ) ;
 311 
			n = link_no(bs, n, VAR_token);
288 
	    ENC_make_tok ( bs, n ) ;
 312 
			ENC_make_tok(bs, n);
289 
	    ENC_LEN_SMALL ( bs, 0 ) ;
 313 
			ENC_LEN_SMALL(bs, 0);
290 
	    ENC_diag_ptr ( bs ) ;
 314 
			ENC_diag_ptr(bs);
291 
	    bs = enc_diag_special ( bs, TOK_vtab_diag, VAR_diagtag ) ;
 315 
			bs = enc_diag_special(bs, TOK_vtab_diag, VAR_diagtag);
292 
	    ENC_diag_tq_null ( bs ) ;
 316 
			ENC_diag_tq_null(bs);
293 
	    ( *pm )++ ;
 317 
			(*pm)++;
- 
 
 318 
		}
- 
 
 319 
		vt = DEREF_virt(virt_next(vt));
294 
	}
 320 
	}
295 
	vt = DEREF_virt ( virt_next ( vt ) ) ;
 - 
 
296 
    }
 - 
 
297 
    return ( bs ) ;
 321 
	return (bs);
298 
}
 322 
}
299 
 
 323 
 
300 
 
 324 
 
301 
/*
 325 
/*
302 
    LIST OF INCOMPLETE CLASSES
 326 
    LIST OF INCOMPLETE CLASSES
303 
 
 327 
 
304 
    This list is used to hold all the classes which are used while they
 328 
    This list is used to hold all the classes which are used while they
305 
    are incomplete.  A diagnostic tag is introduced for each such class
 329 
    are incomplete.  A diagnostic tag is introduced for each such class
306 
    which may be defined later if the class is completed.
 330 
    which may be defined later if the class is completed.
307 
*/
 331 
*/
308 
 
 332 
 
309 
static LIST ( CLASS_TYPE ) diag_classes = NULL_list ( CLASS_TYPE ) ;
 333 
static LIST(CLASS_TYPE)diag_classes = NULL_list(CLASS_TYPE);
310 
 
 334 
 
311 
 
 335 
 
312 
/*
 336 
/*
313 
    DEFINE A DIAGNOSTIC TAG FOR A CLASS
 337 
    DEFINE A DIAGNOSTIC TAG FOR A CLASS
314 
 
 338 
 
315 
    This routine defines a diagnostic tag for the class ct if it is complete
 339 
    This routine defines a diagnostic tag for the class ct if it is complete
316 
    or def is true.
 340 
    or def is true.
317 
*/
 341 
*/
318 
 
 342 
 
319 
static ulong enc_diag_class
 343 
static ulong
320 
    PROTO_N ( ( ct, def ) )
 - 
 
321 
    PROTO_T ( CLASS_TYPE ct X int def )
 344 
enc_diag_class(CLASS_TYPE ct, int def)
322 
{
 345 
{
323 
    ulong tok = LINK_NONE ;
 346 
	ulong tok = LINK_NONE;
324 
    CLASS_INFO ci = DEREF_cinfo ( ctype_info ( ct ) ) ;
 347 
	CLASS_INFO ci = DEREF_cinfo(ctype_info(ct));
325 
    IDENTIFIER id = DEREF_id ( ctype_name ( ct ) ) ;
 348 
	IDENTIFIER id = DEREF_id(ctype_name(ct));
326 
    ulong n = DEREF_ulong ( id_no ( id ) ) ;
 349 
	ulong n = DEREF_ulong(id_no(id));
327 
    if ( n == LINK_NONE ) {
 350 
	if (n == LINK_NONE) {
328 
	/* Create diagnostic tag information */
 351 
		/* Create diagnostic tag information */
329 
	n = capsule_no ( NULL_string, VAR_diagtag ) ;
 352 
		n = capsule_no(NULL_string, VAR_diagtag);
330 
	COPY_ulong ( id_no ( id ), n ) ;
 353 
		COPY_ulong(id_no(id), n);
331 
    }
 354 
	}
332 
    if ( ( ci & cinfo_complete ) && ( ci & cinfo_defined ) ) {
 355 
	if ((ci & cinfo_complete) && (ci & cinfo_defined)) {
333 
	/* Complete class */
 356 
		/* Complete class */
334 
	tok = compile_class ( ct ) ;
 357 
		tok = compile_class(ct);
335 
	def = 1 ;
 358 
		def = 1;
336 
    } else {
 359 
	} else {
337 
	/* Incomplete class */
 360 
		/* Incomplete class */
- 
 
 361 
		if (def) {
338 
	if ( def ) tok = special_no ( TOK_empty_shape ) ;
 362 
			tok = special_no(TOK_empty_shape);
339 
    }
 363 
		}
- 
 
 364 
	}
340 
    if ( def ) {
 365 
	if (def) {
341 
	/* Define diagnostic tag */
 366 
		/* Define diagnostic tag */
342 
	unsigned m = 0 ;
 367 
		unsigned m = 0;
343 
	BITSTREAM *bs, *ts ;
 368 
		BITSTREAM *bs, *ts;
344 
	GRAPH gr = DEREF_graph ( ctype_base ( ct ) ) ;
 369 
		GRAPH gr = DEREF_graph(ctype_base(ct));
345 
	LIST ( GRAPH ) br = DEREF_list ( graph_tails ( gr ) ) ;
 370 
		LIST(GRAPH)br = DEREF_list(graph_tails(gr));
346 
	NAMESPACE ns = DEREF_nspace ( ctype_member ( ct ) ) ;
 371 
		NAMESPACE ns = DEREF_nspace(ctype_member(ct));
347 
	MEMBER mem = DEREF_member ( nspace_ctype_first ( ns ) ) ;
 372 
		MEMBER mem = DEREF_member(nspace_ctype_first(ns));
348 
 
 373 
 
349 
	/* Encode diagnostic tag definition */
 374 
		/* Encode diagnostic tag definition */
350 
	bs = enc_diag_tagdef_start ( n ) ;
 375 
		bs = enc_diag_tagdef_start(n);
351 
	ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
 376 
		ts = start_bitstream(NIL(FILE), bs->link);
352 
	if ( ci & cinfo_union ) {
 377 
		if (ci & cinfo_union) {
353 
	    ENC_diag_union ( bs ) ;
 378 
			ENC_diag_union(bs);
- 
 
 379 
		} else {
- 
 
 380 
			ENC_diag_struct(bs);
- 
 
 381 
		}
- 
 
 382 
		ENC_shape_apply_token(bs);
- 
 
 383 
		tok = link_no(bs, tok, VAR_token);
- 
 
 384 
		ENC_make_tok(bs, tok);
- 
 
 385 
		ENC_LEN_SMALL(bs, 0);
- 
 
 386 
		bs = enc_diag_name(bs, id, 1);
- 
 
 387 
		mem = next_data_member(mem, 2);
- 
 
 388 
		if (ci & cinfo_polymorphic) {
- 
 
 389 
			VIRTUAL vt = DEREF_virt(ctype_virt(ct));
- 
 
 390 
			ts = enc_diag_vtable(ts, vt, &m);
- 
 
 391 
		}
- 
 
 392 
		ts = enc_diag_mems(ts, mem, &m);
- 
 
 393 
		ts = enc_diag_bases(ts, br, &m);
- 
 
 394 
		ENC_LIST(bs, m);
- 
 
 395 
		bs = join_bitstreams(bs, ts);
- 
 
 396 
		enc_diag_tagdef_end(bs);
354 
	} else {
 397 
	} else {
355 
	    ENC_diag_struct ( bs ) ;
 - 
 
356 
	}
 - 
 
357 
	ENC_shape_apply_token ( bs ) ;
 - 
 
358 
	tok = link_no ( bs, tok, VAR_token ) ;
 - 
 
359 
	ENC_make_tok ( bs, tok ) ;
 - 
 
360 
	ENC_LEN_SMALL ( bs, 0 ) ;
 - 
 
361 
	bs = enc_diag_name ( bs, id, 1 ) ;
 - 
 
362 
	mem = next_data_member ( mem, 2 ) ;
 - 
 
363 
	if ( ci & cinfo_polymorphic ) {
 - 
 
364 
	    VIRTUAL vt = DEREF_virt ( ctype_virt ( ct ) ) ;
 - 
 
365 
	    ts = enc_diag_vtable ( ts, vt, &m ) ;
 398 
		CONS_ctype(ct, diag_classes, diag_classes);
366 
	}
 399 
	}
367 
	ts = enc_diag_mems ( ts, mem, &m ) ;
 - 
 
368 
	ts = enc_diag_bases ( ts, br, &m ) ;
 - 
 
369 
	ENC_LIST ( bs, m ) ;
 - 
 
370 
	bs = join_bitstreams ( bs, ts ) ;
 - 
 
371 
	enc_diag_tagdef_end ( bs ) ;
 - 
 
372 
    } else {
 - 
 
373 
	CONS_ctype ( ct, diag_classes, diag_classes ) ;
 - 
 
374 
    }
 - 
 
375 
    return ( n ) ;
 400 
	return (n);
376 
}
 401 
}
377 
 
 402 
 
378 
 
 403 
 
379 
/*
 404 
/*
380 
    DEFINE INCOMPLETE CLASSES
 405 
    DEFINE INCOMPLETE CLASSES
381 
 
 406 
 
382 
    This routine defines the diagnostic tags for the incomplete classes
 407 
    This routine defines the diagnostic tags for the incomplete classes
383 
    in the list above.
 408 
    in the list above.
384 
*/
 409 
*/
385 
 
 410 
 
- 
 
 411 
int
386 
int enc_diag_pending
 412 
enc_diag_pending(void)
387 
    PROTO_Z ()
 - 
 
388 
{
 413 
{
389 
    int changed = 0 ;
 414 
	int changed = 0;
390 
    if ( output_diag ) {
 415 
	if (output_diag) {
391 
	LIST ( CLASS_TYPE ) p ;
 416 
		LIST(CLASS_TYPE)p;
392 
#if TDF_NEW_DIAG
 417 
#if TDF_NEW_DIAG
393 
	if ( output_new_diag ) {
 418 
		if (output_new_diag) {
394 
	    changed = enc_dg_pending () ;
 419 
			changed = enc_dg_pending();
395 
	    return ( changed ) ;
 420 
			return (changed);
396 
	}
 421 
		}
397 
#endif
 422 
#endif
398 
	while ( p = diag_classes, !IS_NULL_list ( p ) ) {
 423 
		while (p = diag_classes, !IS_NULL_list(p)) {
399 
	    diag_classes = NULL_list ( CLASS_TYPE ) ;
 424 
			diag_classes = NULL_list(CLASS_TYPE);
400 
	    while ( !IS_NULL_list ( p ) ) {
 425 
			while (!IS_NULL_list(p)) {
401 
		CLASS_TYPE ct ;
 426 
				CLASS_TYPE ct;
402 
		DESTROY_CONS_ctype ( destroy, ct, p, p ) ;
 427 
				DESTROY_CONS_ctype(destroy, ct, p, p);
403 
		IGNORE enc_diag_class ( ct, 1 ) ;
 428 
				IGNORE enc_diag_class(ct, 1);
404 
		changed = 1 ;
 429 
				changed = 1;
405 
	    }
 430 
			}
406 
	}
 431 
		}
407 
    }
 432 
	}
408 
    return ( changed ) ;
 433 
	return (changed);
409 
}
 434 
}
410 
 
 435 
 
411 
 
 436 
 
412 
/*
 437 
/*
413 
    ENCODE A DIAGNOSTIC CLASS TYPE
 438 
    ENCODE A DIAGNOSTIC CLASS TYPE
414 
 
 439 
 
415 
    This routine encodes the diagnostic information for the class type ct
 440 
    This routine encodes the diagnostic information for the class type ct
416 
    to the bitstream bs.
 441 
    to the bitstream bs.
417 
*/
 442 
*/
418 
 
 443 
 
419 
BITSTREAM *enc_diag_ctype
 444 
BITSTREAM *
420 
    PROTO_N ( ( bs, ct ) )
 - 
 
421 
    PROTO_T ( BITSTREAM *bs X CLASS_TYPE ct )
 445 
enc_diag_ctype(BITSTREAM *bs, CLASS_TYPE ct)
422 
{
 446 
{
423 
    IDENTIFIER id = DEREF_id ( ctype_name ( ct ) ) ;
 447 
	IDENTIFIER id = DEREF_id(ctype_name(ct));
424 
    ulong n = DEREF_ulong ( id_no ( id ) ) ;
 448 
	ulong n = DEREF_ulong(id_no(id));
425 
    if ( n == LINK_NONE ) {
 449 
	if (n == LINK_NONE) {
426 
	CLASS_INFO ci = DEREF_cinfo ( ctype_info ( ct ) ) ;
 450 
		CLASS_INFO ci = DEREF_cinfo(ctype_info(ct));
427 
	if ( ci & cinfo_token ) {
 451 
		if (ci & cinfo_token) {
428 
	    /* Allow for tokenised types */
 452 
			/* Allow for tokenised types */
429 
	    TYPE t = DEREF_type ( ctype_form ( ct ) ) ;
 453 
			TYPE t = DEREF_type(ctype_form(ct));
430 
	    bs = enc_diag_type ( bs, t, 0 ) ;
 454 
			bs = enc_diag_type(bs, t, 0);
431 
	    return ( bs ) ;
 455 
			return (bs);
432 
	}
 456 
		}
433 
	n = enc_diag_class ( ct, 0 ) ;
 457 
		n = enc_diag_class(ct, 0);
434 
    }
 458 
	}
435 
    n = link_no ( bs, n, VAR_diagtag ) ;
 459 
	n = link_no(bs, n, VAR_diagtag);
436 
    ENC_use_diag_tag ( bs ) ;
 460 
	ENC_use_diag_tag(bs);
437 
    ENC_make_diag_tag ( bs, n ) ;
 461 
	ENC_make_diag_tag(bs, n);
438 
    return ( bs ) ;
 462 
	return (bs);
439 
}
 463 
}
440 
 
 464 
 
441 
 
 465 
 
442 
/*
 466 
/*
443 
    ENCODE A DIAGNOSTIC ENUMERATION TYPE
 467 
    ENCODE A DIAGNOSTIC ENUMERATION TYPE
444 
 
 468 
 
445 
    This routine encodes the diagnostic information for the enumeration
 469 
    This routine encodes the diagnostic information for the enumeration
446 
    type et to the bitstream bs.  This is represented by a diagnostic tag.
 470 
    type et to the bitstream bs.  This is represented by a diagnostic tag.
447 
*/
 471 
*/
448 
 
 472 
 
449 
static BITSTREAM *enc_diag_etype
 473 
static BITSTREAM *
450 
    PROTO_N ( ( bs, et ) )
 - 
 
451 
    PROTO_T ( BITSTREAM *bs X ENUM_TYPE et )
 474 
enc_diag_etype(BITSTREAM *bs, ENUM_TYPE et)
452 
{
 - 
 
453 
    IDENTIFIER id = DEREF_id ( etype_name ( et ) ) ;
 - 
 
454 
    ulong n = DEREF_ulong ( id_no ( id ) ) ;
 - 
 
455 
    if ( n == LINK_NONE ) {
 - 
 
456 
	/* Decompose enumeration type */
 - 
 
457 
	BITSTREAM *ts ;
 - 
 
458 
	TYPE t = DEREF_type ( etype_rep ( et ) ) ;
 - 
 
459 
	LIST ( IDENTIFIER ) p = DEREF_list ( etype_values ( et ) ) ;
 - 
 
460 
	CLASS_INFO ei = DEREF_cinfo ( etype_info ( et ) ) ;
 - 
 
461 
	if ( !( ei & cinfo_complete ) ) {
 - 
 
462 
	    bs = enc_diag_type ( bs, t, 0 ) ;
 - 
 
463 
	    return ( bs ) ;
 - 
 
464 
	}
 - 
 
465 
 
 - 
 
466 
	/* Encode diagnostic tag definition */
 - 
 
467 
	n = capsule_no ( NULL_string, VAR_diagtag ) ;
 - 
 
468 
	COPY_ulong ( id_no ( id ), n ) ;
 - 
 
469 
	ts = enc_diag_tagdef_start ( n ) ;
 - 
 
470 
	ENC_diag_enum ( ts ) ;
 - 
 
471 
	ts = enc_diag_type ( ts, t, 0 ) ;
 - 
 
472 
	ts = enc_diag_name ( ts, id, 1 ) ;
 - 
 
473 
	ENC_LIST ( ts, LENGTH_list ( p ) ) ;
 - 
 
474 
	while ( !IS_NULL_list ( p ) ) {
 - 
 
475 
	    /* Scan through enumerators */
 - 
 
476 
	    IDENTIFIER pid = DEREF_id ( HEAD_list ( p ) ) ;
 - 
 
477 
	    EXP e = DEREF_exp ( id_enumerator_value ( pid ) ) ;
 - 
 
478 
	    ts = enc_exp ( ts, e ) ;
 - 
 
479 
	    ts = enc_diag_name ( ts, pid, 1 ) ;
 - 
 
480 
	    p = TAIL_list ( p ) ;
 - 
 
481 
	}
 - 
 
482 
	enc_diag_tagdef_end ( ts ) ;
 - 
 
483 
    }
 - 
 
484 
 
 - 
 
485 
    /* Encode diagnostic tag use */
 - 
 
486 
    n = link_no ( bs, n, VAR_diagtag ) ;
 - 
 
487 
    ENC_use_diag_tag ( bs ) ;
 - 
 
488 
    ENC_make_diag_tag ( bs, n ) ;
 - 
 
489 
    return ( bs ) ;
 - 
 
490 
}
 - 
 
491 
 
 - 
 
492 
 
 - 
 
493 
/*
 - 
 
494 
    ENCODE A TOKENISED DIAGNOSTIC TYPE
 - 
 
495 
 
 - 
 
496 
    This routine adds the diagnostic information for the tokenised type
 - 
 
497 
    id ( args ) to the bitstream bs.
 - 
 
498 
*/
 - 
 
499 
 
 - 
 
500 
static BITSTREAM *enc_diag_tok_type
 - 
 
501 
    PROTO_N ( ( bs, id, args ) )
 - 
 
502 
    PROTO_T ( BITSTREAM *bs X IDENTIFIER id X LIST ( TOKEN ) args )
 - 
 
503 
{
 475 
{
- 
 
 476 
	IDENTIFIER id = DEREF_id(etype_name(et));
- 
 
 477 
	ulong n = DEREF_ulong(id_no(id));
- 
 
 478 
	if (n == LINK_NONE) {
- 
 
 479 
		/* Decompose enumeration type */
- 
 
 480 
		BITSTREAM *ts;
- 
 
 481 
		TYPE t = DEREF_type(etype_rep(et));
- 
 
 482 
		LIST(IDENTIFIER)p = DEREF_list(etype_values(et));
- 
 
 483 
		CLASS_INFO ei = DEREF_cinfo(etype_info(et));
- 
 
 484 
		if (!(ei & cinfo_complete)) {
- 
 
 485 
			bs = enc_diag_type(bs, t, 0);
- 
 
 486 
			return (bs);
- 
 
 487 
		}
- 
 
 488 
 
- 
 
 489 
		/* Encode diagnostic tag definition */
- 
 
 490 
		n = capsule_no(NULL_string, VAR_diagtag);
- 
 
 491 
		COPY_ulong(id_no(id), n);
- 
 
 492 
		ts = enc_diag_tagdef_start(n);
- 
 
 493 
		ENC_diag_enum(ts);
- 
 
 494 
		ts = enc_diag_type(ts, t, 0);
- 
 
 495 
		ts = enc_diag_name(ts, id, 1);
- 
 
 496 
		ENC_LIST(ts, LENGTH_list(p));
- 
 
 497 
		while (!IS_NULL_list(p)) {
- 
 
 498 
			/* Scan through enumerators */
- 
 
 499 
			IDENTIFIER pid = DEREF_id(HEAD_list(p));
- 
 
 500 
			EXP e = DEREF_exp(id_enumerator_value(pid));
- 
 
 501 
			ts = enc_exp(ts, e);
- 
 
 502 
			ts = enc_diag_name(ts, pid, 1);
- 
 
 503 
			p = TAIL_list(p);
- 
 
 504 
		}
- 
 
 505 
		enc_diag_tagdef_end(ts);
- 
 
 506 
	}
- 
 
 507 
 
- 
 
 508 
	/* Encode diagnostic tag use */
- 
 
 509 
	n = link_no(bs, n, VAR_diagtag);
- 
 
 510 
	ENC_use_diag_tag(bs);
- 
 
 511 
	ENC_make_diag_tag(bs, n);
- 
 
 512 
	return (bs);
- 
 
 513 
}
- 
 
 514 
 
- 
 
 515 
 
- 
 
 516 
/*
- 
 
 517 
    ENCODE A TOKENISED DIAGNOSTIC TYPE
- 
 
 518 
 
- 
 
 519 
    This routine adds the diagnostic information for the tokenised type
- 
 
 520 
    id ( args ) to the bitstream bs.
- 
 
 521 
*/
- 
 
 522 
 
- 
 
 523 
static BITSTREAM *
- 
 
 524 
enc_diag_tok_type(BITSTREAM *bs, IDENTIFIER id, LIST(TOKEN)args)
- 
 
 525 
{
504 
    if ( IS_NULL_list ( args ) ) {
 526 
	if (IS_NULL_list(args)) {
505 
	ulong n = get_diag_tag ( id, VAR_token ) ;
 527 
		ulong n = get_diag_tag(id, VAR_token);
506 
	if ( n == LINK_NONE ) {
 528 
		if (n == LINK_NONE) {
507 
	    /* Find external name */
 529 
			/* Find external name */
508 
	    string s = mangle_name ( id, VAR_diagtag, 0 ) ;
 530 
			string s = mangle_name(id, VAR_diagtag, 0);
509 
	    n = capsule_no ( s, VAR_diagtag ) ;
 531 
			n = capsule_no(s, VAR_diagtag);
510 
	    set_diag_tag ( id, VAR_token, n ) ;
 532 
			set_diag_tag(id, VAR_token, n);
- 
 
 533 
		}
- 
 
 534 
		n = link_no(bs, n, VAR_diagtag);
- 
 
 535 
		ENC_use_diag_tag(bs);
- 
 
 536 
		ENC_make_diag_tag(bs, n);
- 
 
 537 
	} else {
- 
 
 538 
		/* NOT YET IMPLEMENTED */
- 
 
 539 
		ENC_diag_type_null(bs);
511 
	}
 540 
	}
512 
	n = link_no ( bs, n, VAR_diagtag ) ;
 - 
 
513 
	ENC_use_diag_tag ( bs ) ;
 - 
 
514 
	ENC_make_diag_tag ( bs, n ) ;
 - 
 
515 
    } else {
 - 
 
516 
	/* NOT YET IMPLEMENTED */
 - 
 
517 
	ENC_diag_type_null ( bs ) ;
 - 
 
518 
    }
 - 
 
519 
    return ( bs ) ;
 541 
	return (bs);
520 
}
 542 
}
521 
 
 543 
 
522 
 
 544 
 
523 
/*
 545 
/*
524 
    ENCODE A DIAGNOSTIC TYPE QUALIFIER
 546 
    ENCODE A DIAGNOSTIC TYPE QUALIFIER
525 
 
 547 
 
526 
    This routine adds the diagnostic type qualifiers cv to the bitstream bs.
 548 
    This routine adds the diagnostic type qualifiers cv to the bitstream bs.
527 
*/
 549 
*/
528 
 
 550 
 
529 
static BITSTREAM *enc_diag_type_qual
 551 
static BITSTREAM *
530 
    PROTO_N ( ( bs, cv ) )
 - 
 
531 
    PROTO_T ( BITSTREAM *bs X CV_SPEC cv )
 552 
enc_diag_type_qual(BITSTREAM *bs, CV_SPEC cv)
532 
{
 553 
{
- 
 
 554 
	if (cv & cv_const) {
533 
    if ( cv & cv_const ) ENC_add_diag_const ( bs ) ;
 555 
		ENC_add_diag_const(bs);
- 
 
 556 
	}
- 
 
 557 
	if (cv & cv_volatile) {
534 
    if ( cv & cv_volatile ) ENC_add_diag_volatile ( bs ) ;
 558 
		ENC_add_diag_volatile(bs);
- 
 
 559 
	}
535 
    ENC_diag_tq_null ( bs ) ;
 560 
	ENC_diag_tq_null(bs);
536 
    return ( bs ) ;
 561 
	return (bs);
537 
}
 562 
}
538 
 
 563 
 
539 
 
 564 
 
540 
/*
 565 
/*
541 
    ENCODE A DIAGNOSTIC TYPE
 566 
    ENCODE A DIAGNOSTIC TYPE
542 
 
 567 
 
543 
    This routine adds the diagnostic information for the type t to the
 568 
    This routine adds the diagnostic information for the type t to the
544 
    bitstream bs.  The type qualifiers are only output if qual is true.
 569 
    bitstream bs.  The type qualifiers are only output if qual is true.
545 
*/
 570 
*/
546 
 
 571 
 
547 
BITSTREAM *enc_diag_type
 572 
BITSTREAM *
548 
    PROTO_N ( ( bs, t, qual ) )
 - 
 
549 
    PROTO_T ( BITSTREAM *bs X TYPE t X int qual )
 573 
enc_diag_type(BITSTREAM *bs, TYPE t, int qual)
550 
{
 574 
{
551 
    if ( IS_NULL_type ( t ) ) {
 575 
	if (IS_NULL_type(t)) {
552 
	ENC_diag_type_null ( bs ) ;
 576 
		ENC_diag_type_null(bs);
553 
	return ( bs ) ;
 577 
		return (bs);
554 
    }
 - 
 
555 
    if ( qual ) {
 - 
 
556 
	/* Output type qualifier */
 - 
 
557 
	CV_SPEC cv = DEREF_cv ( type_qual ( t ) ) ;
 - 
 
558 
	if ( cv & cv_qual ) {
 - 
 
559 
	    ENC_diag_loc ( bs ) ;
 - 
 
560 
	    bs = enc_diag_type ( bs, t, 0 ) ;
 - 
 
561 
	    bs = enc_diag_type_qual ( bs, cv ) ;
 - 
 
562 
	    return ( bs ) ;
 - 
 
563 
	}
 578 
	}
- 
 
 579 
	if (qual) {
- 
 
 580 
		/* Output type qualifier */
- 
 
 581 
		CV_SPEC cv = DEREF_cv(type_qual(t));
- 
 
 582 
		if (cv & cv_qual) {
- 
 
 583 
			ENC_diag_loc(bs);
- 
 
 584 
			bs = enc_diag_type(bs, t, 0);
- 
 
 585 
			bs = enc_diag_type_qual(bs, cv);
- 
 
 586 
			return (bs);
564 
    }
 587 
		}
- 
 
 588 
	}
565 
    ASSERT ( ORDER_type == 18 ) ;
 589 
	ASSERT(ORDER_type == 18);
566 
    switch ( TAG_type ( t ) ) {
 590 
	switch (TAG_type(t)) {
567 
	case type_integer_tag : {
 591 
	case type_integer_tag: {
568 
	    /* Integral types */
 592 
		/* Integral types */
569 
	    ENC_diag_variety ( bs ) ;
 593 
		ENC_diag_variety(bs);
570 
	    bs = enc_variety ( bs, t ) ;
 594 
		bs = enc_variety(bs, t);
571 
	    break ;
 595 
		break;
- 
 
 596 
	}
- 
 
 597 
	case type_floating_tag: {
- 
 
 598 
		/* Floating point types */
- 
 
 599 
		ENC_diag_floating_variety(bs);
- 
 
 600 
		bs = enc_flvar(bs, t);
- 
 
 601 
		break;
- 
 
 602 
	}
- 
 
 603 
	case type_ptr_tag:
- 
 
 604 
	case type_ref_tag: {
- 
 
 605 
		/* Pointer types */
- 
 
 606 
		TYPE s = DEREF_type(type_ptr_etc_sub(t));
- 
 
 607 
		CV_SPEC cv = DEREF_cv(type_qual(s));
- 
 
 608 
		ENC_diag_ptr(bs);
- 
 
 609 
		bs = enc_diag_type(bs, s, 0);
- 
 
 610 
		bs = enc_diag_type_qual(bs, cv);
- 
 
 611 
		break;
- 
 
 612 
	}
- 
 
 613 
	case type_ptr_mem_tag: {
- 
 
 614 
		/* Pointer to member types */
- 
 
 615 
		int tok = TOK_pm_type;
- 
 
 616 
		TYPE s = DEREF_type(type_ptr_mem_sub(t));
- 
 
 617 
		if (IS_type_func(s)) {
- 
 
 618 
			tok = TOK_pmf_type;
- 
 
 619 
		}
- 
 
 620 
		bs = enc_diag_special(bs, tok, VAR_diagtag);
- 
 
 621 
		break;
572 
	}
 622 
	}
573 
	case type_floating_tag : {
 623 
	case type_func_tag: {
574 
	    /* Floating point types */
 624 
		/* Function types */
575 
	    ENC_diag_floating_variety ( bs ) ;
 625 
		TYPE r = DEREF_type(type_func_ret(t));
576 
	    bs = enc_flvar ( bs, t ) ;
 626 
		LIST(TYPE)p = DEREF_list(type_func_mtypes(t));
577 
	    break ;
 627 
		int ell = DEREF_int(type_func_ellipsis(t));
578 
	}
 - 
 
579 
	case type_ptr_tag :
 628 
		ENC_diag_proc(bs);
580 
	case type_ref_tag : {
 629 
		ENC_LIST(bs, LENGTH_list(p));
581 
	    /* Pointer types */
 630 
		while (!IS_NULL_list(p)) {
582 
	    TYPE s = DEREF_type ( type_ptr_etc_sub ( t ) ) ;
 631 
			TYPE s = DEREF_type(HEAD_list(p));
583 
	    CV_SPEC cv = DEREF_cv ( type_qual ( s ) ) ;
 632 
			bs = enc_diag_type(bs, s, 0);
584 
	    ENC_diag_ptr ( bs ) ;
 633 
			p = TAIL_list(p);
- 
 
 634 
		}
585 
	    bs = enc_diag_type ( bs, s, 0 ) ;
 635 
		bs = enc_bool(bs,(ell & FUNC_ELLIPSIS));
586 
	    bs = enc_diag_type_qual ( bs, cv ) ;
 636 
		bs = enc_diag_type(bs, r, 0);
587 
	    break ;
 637 
		break;
588 
	}
 638 
	}
589 
	case type_ptr_mem_tag : {
 - 
 
590 
	    /* Pointer to member types */
 - 
 
591 
	    int tok = TOK_pm_type ;
 - 
 
592 
	    TYPE s = DEREF_type ( type_ptr_mem_sub ( t ) ) ;
 - 
 
593 
	    if ( IS_type_func ( s ) ) tok = TOK_pmf_type ;
 - 
 
594 
	    bs = enc_diag_special ( bs, tok, VAR_diagtag ) ;
 - 
 
595 
	    break ;
 - 
 
596 
	}
 - 
 
597 
	case type_func_tag : {
 - 
 
598 
	    /* Function types */
 - 
 
599 
	    TYPE r = DEREF_type ( type_func_ret ( t ) ) ;
 - 
 
600 
	    LIST ( TYPE ) p = DEREF_list ( type_func_mtypes ( t ) ) ;
 - 
 
601 
	    int ell = DEREF_int ( type_func_ellipsis ( t ) ) ;
 - 
 
602 
	    ENC_diag_proc ( bs ) ;
 - 
 
603 
	    ENC_LIST ( bs, LENGTH_list ( p ) ) ;
 - 
 
604 
	    while ( !IS_NULL_list ( p ) ) {
 - 
 
605 
		TYPE s = DEREF_type ( HEAD_list ( p ) ) ;
 - 
 
606 
		bs = enc_diag_type ( bs, s, 0 ) ;
 - 
 
607 
		p = TAIL_list ( p ) ;
 - 
 
608 
	    }
 - 
 
609 
	    bs = enc_bool ( bs, ( ell & FUNC_ELLIPSIS ) ) ;
 - 
 
610 
	    bs = enc_diag_type ( bs, r, 0 ) ;
 - 
 
611 
	    break ;
 - 
 
612 
	}
 - 
 
613 
	case type_array_tag : {
 639 
	case type_array_tag: {
614 
	    /* Array types */
 640 
		/* Array types */
615 
	    TYPE i = type_sint ;
 641 
		TYPE i = type_sint;
616 
	    TYPE s = DEREF_type ( type_array_sub ( t ) ) ;
 642 
		TYPE s = DEREF_type(type_array_sub(t));
617 
	    NAT n = DEREF_nat ( type_array_size ( t ) ) ;
 643 
		NAT n = DEREF_nat(type_array_size(t));
618 
	    ENC_diag_array ( bs ) ;
 644 
		ENC_diag_array(bs);
619 
	    bs = enc_diag_type ( bs, s, 0 ) ;
 645 
		bs = enc_diag_type(bs, s, 0);
620 
	    bs = enc_shape_offset ( bs, s ) ;
 646 
		bs = enc_shape_offset(bs, s);
621 
	    bs = enc_make_int ( bs, i, 0 ) ;
 647 
		bs = enc_make_int(bs, i, 0);
622 
	    if ( IS_NULL_nat ( n ) ) {
 648 
		if (IS_NULL_nat(n)) {
623 
		/* Empty array bound */
 649 
			/* Empty array bound */
624 
		bs = enc_make_int ( bs, i, 0 ) ;
 650 
			bs = enc_make_int(bs, i, 0);
625 
	    } else {
 - 
 
626 
		/* Calculated array bound */
 - 
 
627 
		unsigned long v = get_nat_value ( n ) ;
 - 
 
628 
		if ( v < SMALL_ARRAY_BOUND ) {
 - 
 
629 
		    /* Small value */
 - 
 
630 
		    if ( v ) v-- ;
 - 
 
631 
		    bs = enc_make_int ( bs, i, ( int ) v ) ;
 - 
 
632 
		} else {
 651 
		} else {
- 
 
 652 
			/* Calculated array bound */
- 
 
 653 
			unsigned long v = get_nat_value(n);
- 
 
 654 
			if (v < SMALL_ARRAY_BOUND) {
- 
 
 655 
				/* Small value */
- 
 
 656 
				if (v) {
- 
 
 657 
					v--;
- 
 
 658 
				}
- 
 
 659 
				bs = enc_make_int(bs, i,(int)v);
- 
 
 660 
			} else {
633 
		    ENC_minus ( bs ) ;
 661 
				ENC_minus(bs);
634 
		    bs = enc_error_treatment ( bs, i ) ;
 662 
				bs = enc_error_treatment(bs, i);
635 
		    ENC_make_int ( bs ) ;
 663 
				ENC_make_int(bs);
636 
		    bs = enc_variety ( bs, i ) ;
 664 
				bs = enc_variety(bs, i);
637 
		    bs = enc_snat ( bs, n, 0, 1 ) ;
 665 
				bs = enc_snat(bs, n, 0, 1);
638 
		    bs = enc_make_int ( bs, i, 1 ) ;
 666 
				bs = enc_make_int(bs, i, 1);
639 
		}
 667 
			}
640 
	    }
 668 
		}
641 
	    bs = enc_diag_type ( bs, i, 0 ) ;
 669 
		bs = enc_diag_type(bs, i, 0);
642 
	    break ;
 670 
		break;
643 
	}
 671 
	}
644 
	case type_bitfield_tag : {
 672 
	case type_bitfield_tag: {
645 
	    /* Bitfield types */
 673 
		/* Bitfield types */
646 
	    INT_TYPE bf = DEREF_itype ( type_bitfield_defn ( t ) ) ;
 674 
		INT_TYPE bf = DEREF_itype(type_bitfield_defn(t));
647 
	    TYPE s = DEREF_type ( itype_bitfield_sub ( bf ) ) ;
 675 
		TYPE s = DEREF_type(itype_bitfield_sub(bf));
648 
	    NAT n = DEREF_nat ( itype_bitfield_size ( bf ) ) ;
 676 
		NAT n = DEREF_nat(itype_bitfield_size(bf));
649 
	    ENC_diag_bitfield ( bs ) ;
 677 
		ENC_diag_bitfield(bs);
650 
	    bs = enc_diag_type ( bs, s, 0 ) ;
 678 
		bs = enc_diag_type(bs, s, 0);
651 
	    bs = enc_nat ( bs, n, 1 ) ;
 679 
		bs = enc_nat(bs, n, 1);
652 
	    break ;
 680 
		break;
653 
	}
 681 
	}
654 
	case type_compound_tag : {
 682 
	case type_compound_tag: {
655 
	    /* Class types */
 683 
		/* Class types */
656 
	    CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
 684 
		CLASS_TYPE ct = DEREF_ctype(type_compound_defn(t));
657 
	    bs = enc_diag_ctype ( bs, ct ) ;
 685 
		bs = enc_diag_ctype(bs, ct);
658 
	    break ;
 686 
		break;
659 
	}
 687 
	}
660 
	case type_enumerate_tag : {
 688 
	case type_enumerate_tag: {
661 
	    /* Enumeration types */
 689 
		/* Enumeration types */
662 
	    ENUM_TYPE et = DEREF_etype ( type_enumerate_defn ( t ) ) ;
 690 
		ENUM_TYPE et = DEREF_etype(type_enumerate_defn(t));
663 
	    bs = enc_diag_etype ( bs, et ) ;
 691 
		bs = enc_diag_etype(bs, et);
664 
	    break ;
 692 
		break;
665 
	}
 693 
	}
666 
	case type_token_tag : {
 694 
	case type_token_tag: {
667 
	    /* Tokenised types */
 695 
		/* Tokenised types */
668 
	    IDENTIFIER tok = DEREF_id ( type_token_tok ( t ) ) ;
 696 
		IDENTIFIER tok = DEREF_id(type_token_tok(t));
669 
	    LIST ( TOKEN ) args = DEREF_list ( type_token_args ( t ) ) ;
 697 
		LIST(TOKEN)args = DEREF_list(type_token_args(t));
670 
	    bs = enc_diag_tok_type ( bs, tok, args ) ;
 698 
		bs = enc_diag_tok_type(bs, tok, args);
671 
	    break ;
 699 
		break;
672 
	}
 700 
	}
673 
	default : {
 701 
	default : {
674 
	    /* Other types */
 702 
		/* Other types */
675 
	    ENC_diag_type_null ( bs ) ;
 703 
		ENC_diag_type_null(bs);
676 
	    break ;
 704 
		break;
677 
	}
 705 
	}
678 
    }
 706 
	}
679 
    return ( bs ) ;
 707 
	return (bs);
680 
}
 708 
}
681 
 
 709 
 
682 
 
 710 
 
683 
/*
 711 
/*
684 
    ENCODE DIAGNOSTICS FOR A TOKEN DEFINITION
 712 
    ENCODE DIAGNOSTICS FOR A TOKEN DEFINITION
685 
 
 713 
 
686 
    This routine outputs any diagnostic information for the token id
 714 
    This routine outputs any diagnostic information for the token id
687 
    to the appropriate diagnostic units.  It is only called if id is
 715 
    to the appropriate diagnostic units.  It is only called if id is
688 
    defined.  The type t may be used to override the type of id.
 716 
    defined.  The type t may be used to override the type of id.
689 
*/
 717 
*/
690 
 
 718 
 
691 
void enc_diag_token
 - 
 
692 
    PROTO_N ( ( id, t ) )
 - 
 
693 
    PROTO_T ( IDENTIFIER id X TYPE t )
 - 
 
694 
{
 - 
 
695 
    TOKEN tok ;
 - 
 
696 
#if TDF_NEW_DIAG
 - 
 
697 
    if ( output_new_diag ) {
 - 
 
698 
	enc_dg_token ( id, t ) ;
 - 
 
699 
	return ;
 - 
 
700 
    }
 - 
 
701 
#endif
 719 
void
702 
    tok = DEREF_tok ( id_token_sort ( id ) ) ;
 - 
 
703 
    if ( IS_tok_type ( tok ) ) {
 - 
 
704 
	BASE_TYPE bt = DEREF_btype ( tok_type_kind ( tok ) ) ;
 - 
 
705 
	if ( bt & btype_scalar ) {
 - 
 
706 
	    /* Tokenised arithmetic types */
 - 
 
707 
	    /* EMPTY */
 - 
 
708 
	} else {
 - 
 
709 
	    /* Tokenised generic types */
 - 
 
710 
	    BITSTREAM *bs ;
 - 
 
711 
	    IDENTIFIER alt = DEREF_id ( id_token_alt ( id ) ) ;
 - 
 
712 
	    DECL_SPEC ds = DEREF_dspec ( id_storage ( alt ) ) ;
 - 
 
713 
	    ulong n = get_diag_tag ( id, VAR_token ) ;
 - 
 
714 
	    if ( n == LINK_NONE ) {
 - 
 
715 
		/* Find external name */
 - 
 
716 
		string s = mangle_name ( id, VAR_diagtag, 0 ) ;
 - 
 
717 
		n = capsule_no ( s, VAR_diagtag ) ;
 - 
 
718 
		set_diag_tag ( id, VAR_token, n ) ;
 - 
 
719 
	    }
 - 
 
720 
	    bs = enc_diag_tagdef_start ( n ) ;
 - 
 
721 
	    if ( IS_NULL_type ( t ) ) {
 - 
 
722 
		/* Extract type if not given */
 - 
 
723 
		t = DEREF_type ( tok_type_value ( tok ) ) ;
 - 
 
724 
	    }
 - 
 
725 
	    bs = enc_diag_type ( bs, t, 0 ) ;
 - 
 
726 
	    enc_diag_tagdef_end ( bs ) ;
 - 
 
727 
	    if ( !( ds & dspec_done ) ) {
 - 
 
728 
		/* Output internal name */
 - 
 
729 
		ds |= dspec_done ;
 - 
 
730 
		COPY_dspec ( id_storage ( alt ), ds ) ;
 - 
 
731 
		enc_diag_id ( alt, 1 ) ;
 - 
 
732 
	    }
 - 
 
733 
	}
 - 
 
734 
    }
 - 
 
735 
    return ;
 - 
 
736 
}
 - 
 
737 
 
 - 
 
738 
 
 - 
 
739 
/*
 - 
 
740 
    ENCODE A GLOBAL DIAGNOSTIC IDENTIFIER
 - 
 
741 
 
 - 
 
742 
    This routine adds the diagnostic information for the global identifier
 - 
 
743 
    id to the diagnostic definition unit.  def is true for a definition.
 - 
 
744 
*/
 - 
 
745 
 
 - 
 
746 
void enc_diag_id
 - 
 
747 
    PROTO_N ( ( id, def ) )
 - 
 
748 
    PROTO_T ( IDENTIFIER id X int def )
 720 
enc_diag_token(IDENTIFIER id, TYPE t)
749 
{
 721 
{
750 
    TYPE t ;
 722 
	TOKEN tok;
751 
    ulong n ;
 - 
 
752 
    BITSTREAM *bs = NULL ;
 - 
 
753 
#if TDF_NEW_DIAG
 723 
#if TDF_NEW_DIAG
754 
    if ( output_new_diag ) {
 724 
	if (output_new_diag) {
755 
	enc_dg_id ( id, def ) ;
 725 
		enc_dg_token(id, t);
756 
	return ;
 726 
		return;
757 
    }
 727 
	}
758 
#endif
 728 
#endif
- 
 
 729 
	tok = DEREF_tok(id_token_sort(id));
759 
    UNUSED ( def ) ;
 730 
	if (IS_tok_type(tok)) {
760 
    n = DEREF_ulong ( id_no ( id ) ) ;
 731 
		BASE_TYPE bt = DEREF_btype(tok_type_kind(tok));
761 
    switch ( TAG_id ( id ) ) {
 732 
		if (bt & btype_scalar) {
762 
	case id_class_alias_tag :
 733 
			/* Tokenised arithmetic types */
- 
 
 734 
			/* EMPTY */
- 
 
 735 
		} else {
763 
	case id_enum_alias_tag :
 736 
			/* Tokenised generic types */
- 
 
 737 
			BITSTREAM *bs;
- 
 
 738 
			IDENTIFIER alt = DEREF_id(id_token_alt(id));
- 
 
 739 
			DECL_SPEC ds = DEREF_dspec(id_storage(alt));
- 
 
 740 
			ulong n = get_diag_tag(id, VAR_token);
764 
	case id_type_alias_tag : {
 741 
			if (n == LINK_NONE) {
765 
	    /* Typedef names */
 742 
				/* Find external name */
766 
	    t = DEREF_type ( id_class_name_etc_defn ( id ) ) ;
 743 
				string s = mangle_name(id, VAR_diagtag, 0);
767 
	    bs = start_bitstream ( NIL ( FILE ), diagdef_unit->link ) ;
 744 
				n = capsule_no(s, VAR_diagtag);
768 
	    ENC_diag_desc_typedef ( bs ) ;
 745 
				set_diag_tag(id, VAR_token, n);
- 
 
 746 
			}
769 
	    bs = enc_diag_name ( bs, id, 1 ) ;
 747 
			bs = enc_diag_tagdef_start(n);
- 
 
 748 
			if (IS_NULL_type(t)) {
- 
 
 749 
				/* Extract type if not given */
770 
	    bs = enc_diag_loc ( bs, id_loc ( id ) ) ;
 750 
				t = DEREF_type(tok_type_value(tok));
- 
 
 751 
			}
771 
	    bs = enc_diag_type ( bs, t, 1 ) ;
 752 
			bs = enc_diag_type(bs, t, 0);
- 
 
 753 
			enc_diag_tagdef_end(bs);
- 
 
 754 
			if (!(ds & dspec_done)) {
- 
 
 755 
				/* Output internal name */
772 
	    break ;
 756 
				ds |= dspec_done;
- 
 
 757 
				COPY_dspec(id_storage(alt), ds);
- 
 
 758 
				enc_diag_id(alt, 1);
- 
 
 759 
			}
- 
 
 760 
		}
773 
	}
 761 
	}
- 
 
 762 
	return;
- 
 
 763 
}
- 
 
 764 
 
- 
 
 765 
 
- 
 
 766 
/*
- 
 
 767 
    ENCODE A GLOBAL DIAGNOSTIC IDENTIFIER
- 
 
 768 
 
- 
 
 769 
    This routine adds the diagnostic information for the global identifier
- 
 
 770 
    id to the diagnostic definition unit.  def is true for a definition.
- 
 
 771 
*/
- 
 
 772 
 
- 
 
 773 
void
- 
 
 774 
enc_diag_id(IDENTIFIER id, int def)
- 
 
 775 
{
- 
 
 776 
	TYPE t;
- 
 
 777 
	ulong n;
- 
 
 778 
	BITSTREAM *bs = NULL;
- 
 
 779 
#if TDF_NEW_DIAG
- 
 
 780 
	if (output_new_diag) {
- 
 
 781 
		enc_dg_id(id, def);
- 
 
 782 
		return;
- 
 
 783 
	}
- 
 
 784 
#endif
- 
 
 785 
	UNUSED(def);
- 
 
 786 
	n = DEREF_ulong(id_no(id));
- 
 
 787 
	switch (TAG_id(id)) {
- 
 
 788 
	case id_class_alias_tag:
- 
 
 789 
	case id_enum_alias_tag:
- 
 
 790 
	case id_type_alias_tag: {
- 
 
 791 
		/* Typedef names */
- 
 
 792 
		t = DEREF_type(id_class_name_etc_defn(id));
- 
 
 793 
		bs = start_bitstream(NIL(FILE), diagdef_unit->link);
- 
 
 794 
		ENC_diag_desc_typedef(bs);
- 
 
 795 
		bs = enc_diag_name(bs, id, 1);
- 
 
 796 
		bs = enc_diag_loc(bs, id_loc(id));
- 
 
 797 
		bs = enc_diag_type(bs, t, 1);
- 
 
 798 
		break;
- 
 
 799 
	}
774 
	case id_variable_tag :
 800 
	case id_variable_tag:
775 
	case id_parameter_tag :
 801 
	case id_parameter_tag:
776 
	case id_stat_member_tag : {
 802 
	case id_stat_member_tag: {
777 
	    /* Variable names */
 803 
		/* Variable names */
778 
	    t = DEREF_type ( id_variable_etc_type ( id ) ) ;
 804 
		t = DEREF_type(id_variable_etc_type(id));
779 
	    goto diag_label ;
 805 
		goto diag_label;
780 
	}
 806 
	}
781 
	case id_function_tag :
 807 
	case id_function_tag:
782 
	case id_mem_func_tag :
 808 
	case id_mem_func_tag:
783 
	case id_stat_mem_func_tag : {
 809 
	case id_stat_mem_func_tag: {
784 
	    /* Function names */
 810 
		/* Function names */
785 
	    t = DEREF_type ( id_function_etc_type ( id ) ) ;
 811 
		t = DEREF_type(id_function_etc_type(id));
786 
	    goto diag_label ;
 812 
		goto diag_label;
787 
	}
 813 
	}
788 
	diag_label : {
 814 
diag_label: {
789 
	    bs = start_bitstream ( NIL ( FILE ), diagdef_unit->link ) ;
 815 
		     bs = start_bitstream(NIL(FILE), diagdef_unit->link);
790 
	    ENC_diag_desc_id ( bs ) ;
 816 
		     ENC_diag_desc_id(bs);
791 
	    bs = enc_diag_name ( bs, id, 1 ) ;
 817 
		     bs = enc_diag_name(bs, id, 1);
792 
	    bs = enc_diag_loc ( bs, id_loc ( id ) ) ;
 818 
		     bs = enc_diag_loc(bs, id_loc(id));
793 
	    ENC_obtain_tag ( bs ) ;
 819 
		     ENC_obtain_tag(bs);
794 
	    n = link_no ( bs, n, VAR_tag ) ;
 820 
		     n = link_no(bs, n, VAR_tag);
795 
	    ENC_make_tag ( bs, n ) ;
 821 
		     ENC_make_tag(bs, n);
796 
	    bs = enc_diag_type ( bs, t, 1 ) ;
 822 
		     bs = enc_diag_type(bs, t, 1);
797 
	    break ;
 823 
		     break;
798 
	}
 824 
	     }
799 
    }
 825 
	}
800 
    if ( bs ) {
 826 
	if (bs) {
801 
	count_item ( bs ) ;
 827 
		count_item(bs);
802 
	diagdef_unit = join_bitstreams ( diagdef_unit, bs ) ;
 828 
		diagdef_unit = join_bitstreams(diagdef_unit, bs);
803 
    }
 829 
	}
804 
    return ;
 830 
	return;
805 
}
 831 
}
806 
 
 832 
 
807 
 
 833 
 
808 
/*
 834 
/*
809 
    ENCODE DIAGNOSTICS INITIALISATION FUNCTION
 835 
    ENCODE DIAGNOSTICS INITIALISATION FUNCTION
810 
 
 836 
 
811 
    This routine adds the diagnostic information for the initialisation
 837 
    This routine adds the diagnostic information for the initialisation
812 
    or termination function named s with tag number n to the diagnostics
 838 
    or termination function named s with tag number n to the diagnostics
813 
    definition unit.
 839 
    definition unit.
814 
*/
 840 
*/
815 
 
 841 
 
816 
void enc_diag_init
 842 
void
817 
    PROTO_N ( ( s, n, t ) )
 - 
 
818 
    PROTO_T ( CONST char *s X ulong n X TYPE t )
 843 
enc_diag_init(CONST char *s, ulong n, TYPE t)
819 
{
 844 
{
820 
    if ( output_all ) {
 845 
	if (output_all) {
821 
	string u = ustrlit ( s ) ;
 846 
		string u = ustrlit(s);
822 
	n = capsule_name ( n, &u, VAR_tag ) ;
 847 
		n = capsule_name(n, &u, VAR_tag);
- 
 
 848 
		if (u) {
823 
	if ( u ) n = capsule_name ( n, &u, VAR_tag ) ;
 849 
			n = capsule_name(n, &u, VAR_tag);
824 
    }
 850 
		}
- 
 
 851 
	}
825 
    if ( output_diag && !output_new_diag ) {
 852 
	if (output_diag && !output_new_diag) {
826 
	BITSTREAM *bs = start_bitstream ( NIL ( FILE ), diagdef_unit->link ) ;
 853 
		BITSTREAM *bs = start_bitstream(NIL(FILE), diagdef_unit->link);
827 
	ENC_diag_desc_id ( bs ) ;
 854 
		ENC_diag_desc_id(bs);
828 
	bs = enc_ustring ( bs, ustrlit ( s ) ) ;
 855 
		bs = enc_ustring(bs, ustrlit(s));
829 
	bs = enc_diag_loc ( bs, NULL_ptr ( LOCATION ) ) ;
 856 
		bs = enc_diag_loc(bs, NULL_ptr(LOCATION));
830 
	ENC_obtain_tag ( bs ) ;
 857 
		ENC_obtain_tag(bs);
831 
	n = link_no ( bs, n, VAR_tag ) ;
 858 
		n = link_no(bs, n, VAR_tag);
832 
	ENC_make_tag ( bs, n ) ;
 859 
		ENC_make_tag(bs, n);
833 
	bs = enc_diag_type ( bs, t, 0 ) ;
 860 
		bs = enc_diag_type(bs, t, 0);
834 
	count_item ( bs ) ;
 861 
		count_item(bs);
835 
	diagdef_unit = join_bitstreams ( diagdef_unit, bs ) ;
 862 
		diagdef_unit = join_bitstreams(diagdef_unit, bs);
836 
    }
 863 
	}
837 
    return ;
 864 
	return;
838 
}
 865 
}
839 
 
 866 
 
840 
 
 867 
 
841 
/*
 868 
/*
842 
    ENCODE A LOCAL DIAGNOSTIC IDENTIFIER
 869 
    ENCODE A LOCAL DIAGNOSTIC IDENTIFIER
843 
 
 870 
 
844 
    This routine adds the diagnostic information for the local identifier
 871 
    This routine adds the diagnostic information for the local identifier
845 
    id to the bitstream bs.  ts gives the encoding of the scope of id.
 872 
    id to the bitstream bs.  ts gives the encoding of the scope of id.
846 
*/
 873 
*/
847 
 
 874 
 
848 
BITSTREAM *enc_diag_local
 875 
BITSTREAM *
849 
    PROTO_N ( ( bs, id, ts ) )
 - 
 
850 
    PROTO_T ( BITSTREAM *bs X IDENTIFIER id X BITSTREAM *ts )
 876 
enc_diag_local(BITSTREAM *bs, IDENTIFIER id, BITSTREAM *ts)
851 
{
 877 
{
852 
    TYPE t ;
 878 
	TYPE t;
853 
    ulong n, m ;
 879 
	ulong n, m;
854 
#if TDF_NEW_DIAG
 880 
#if TDF_NEW_DIAG
855 
    if ( output_new_diag ) {
 881 
	if (output_new_diag) {
856 
	bs = enc_dg_local ( bs, id, ts ) ;
 882 
		bs = enc_dg_local(bs, id, ts);
857 
	return ( bs ) ;
 883 
		return (bs);
858 
    }
 884 
	}
859 
#endif
 885 
#endif
860 
    n = diag_id_scope_tok ;
 886 
	n = diag_id_scope_tok;
861 
    if ( n == LINK_NONE ) {
 887 
	if (n == LINK_NONE) {
862 
	/* Assign token number */
 888 
		/* Assign token number */
863 
	n = capsule_no ( ustrlit ( "~diag_id_scope" ), VAR_token ) ;
 889 
		n = capsule_no(ustrlit("~diag_id_scope"), VAR_token);
864 
	diag_id_scope_tok = n ;
 890 
		diag_id_scope_tok = n;
865 
    }
 891 
	}
866 
 
 892 
 
867 
    /* Add identifier information to ts */
 893 
	/* Add identifier information to ts */
868 
    t = DEREF_type ( id_variable_etc_type ( id ) ) ;
 894 
	t = DEREF_type(id_variable_etc_type(id));
869 
    ts = enc_diag_name ( ts, id, 0 ) ;
 895 
	ts = enc_diag_name(ts, id, 0);
870 
    ENC_obtain_tag ( ts ) ;
 896 
	ENC_obtain_tag(ts);
871 
    m = unit_no ( ts, id, VAR_tag, 0 ) ;
 897 
	m = unit_no(ts, id, VAR_tag, 0);
872 
    ENC_make_tag ( ts, m ) ;
 898 
	ENC_make_tag(ts, m);
873 
    ts = enc_diag_type ( ts, t, 1 ) ;
 899 
	ts = enc_diag_type(ts, t, 1);
874 
 
 900 
 
875 
    /* Create a token application */
 901 
	/* Create a token application */
876 
    ENC_exp_apply_token ( bs ) ;
 902 
	ENC_exp_apply_token(bs);
877 
    n = link_no ( bs, n, VAR_token ) ;
 903 
	n = link_no(bs, n, VAR_token);
878 
    ENC_make_tok ( bs, n ) ;
 904 
	ENC_make_tok(bs, n);
879 
    bs = enc_bitstream ( bs, ts ) ;
 905 
	bs = enc_bitstream(bs, ts);
880 
    return ( bs ) ;
 906 
	return (bs);
881 
}
 907 
}
882 
 
 908 
 
883 
 
 909 
 
884 
/*
 910 
/*
885 
    ENCODE A LIST OF DIAGNOSTIC PARAMETERS
 911 
    ENCODE A LIST OF DIAGNOSTIC PARAMETERS
886 
 
 912 
 
887 
    This routine adds the diagnostic information for the list of function
 913 
    This routine adds the diagnostic information for the list of function
888 
    parameters p to the bitstream bs.  ts and e give the function body.
 914 
    parameters p to the bitstream bs.  ts and e give the function body.
889 
*/
 915 
*/
890 
 
 916 
 
891 
BITSTREAM *enc_diag_params
 917 
BITSTREAM *
892 
    PROTO_N ( ( bs, p, ts, e ) )
 - 
 
893 
    PROTO_T ( BITSTREAM *bs X LIST ( IDENTIFIER ) p X BITSTREAM *ts X EXP e )
 918 
enc_diag_params(BITSTREAM *bs, LIST(IDENTIFIER)p, BITSTREAM *ts, EXP e)
894 
{
 919 
{
895 
#if TDF_NEW_DIAG
 920 
#if TDF_NEW_DIAG
896 
    if ( output_new_diag ) {
 921 
	if (output_new_diag) {
897 
	bs = enc_dg_params ( bs, p, ts, e ) ;
 922 
		bs = enc_dg_params(bs, p, ts, e);
898 
	return ( bs ) ;
 923 
		return (bs);
899 
    }
 924 
	}
900 
#endif
 925 
#endif
901 
    if ( IS_NULL_list ( p ) ) {
 926 
	if (IS_NULL_list(p)) {
902 
	bs = join_bitstreams ( bs, ts ) ;
 927 
		bs = join_bitstreams(bs, ts);
903 
    } else {
 928 
	} else {
904 
	IDENTIFIER pid = DEREF_id ( HEAD_list ( p ) ) ;
 929 
		IDENTIFIER pid = DEREF_id(HEAD_list(p));
905 
	BITSTREAM *us = start_bitstream ( NIL ( FILE ), bs->link ) ;
 930 
		BITSTREAM *us = start_bitstream(NIL(FILE), bs->link);
906 
	us = enc_diag_params ( us, TAIL_list ( p ), ts, e ) ;
 931 
		us = enc_diag_params(us, TAIL_list(p), ts, e);
907 
	bs = enc_diag_local ( bs, pid, us ) ;
 932 
		bs = enc_diag_local(bs, pid, us);
908 
    }
 933 
	}
909 
    return ( bs ) ;
 934 
	return (bs);
910 
}
 935 
}
911 
 
 936 
 
912 
 
 937 
 
913 
/*
 938 
/*
914 
    ENCODE DIAGNOSTIC STATEMENT TOKEN
 939 
    ENCODE DIAGNOSTIC STATEMENT TOKEN
915 
 
 940 
 
916 
    This routine adds the token used to associate diagnostic information
 941 
    This routine adds the token used to associate diagnostic information
917 
    with a statement to the bitstream bs.
 942 
    with a statement to the bitstream bs.
918 
*/
 943 
*/
919 
 
 944 
 
920 
BITSTREAM *enc_diag_start
 945 
BITSTREAM *
921 
    PROTO_N ( ( bs ) )
 - 
 
922 
    PROTO_T ( BITSTREAM *bs )
 946 
enc_diag_start(BITSTREAM *bs)
923 
{
 947 
{
924 
    ulong n = exp_to_source_tok ;
 948 
	ulong n = exp_to_source_tok;
925 
    if ( n == LINK_NONE ) {
 949 
	if (n == LINK_NONE) {
926 
	/* Assign token number */
 950 
		/* Assign token number */
927 
	string tok = ustrlit ( "~exp_to_source" ) ;
 951 
		string tok = ustrlit("~exp_to_source");
928 
#if TDF_NEW_DIAG
 952 
#if TDF_NEW_DIAG
- 
 
 953 
		if (output_new_diag) {
929 
	if ( output_new_diag ) tok = ustrlit ( "~dg_exp" ) ;
 954 
			tok = ustrlit("~dg_exp");
- 
 
 955 
		}
930 
#endif
 956 
#endif
931 
	n = capsule_no ( tok, VAR_token ) ;
 957 
		n = capsule_no(tok, VAR_token);
932 
	exp_to_source_tok = n ;
 958 
		exp_to_source_tok = n;
933 
    }
 959 
	}
934 
    n = link_no ( bs, n, VAR_token ) ;
 960 
	n = link_no(bs, n, VAR_token);
935 
    ENC_exp_apply_token ( bs ) ;
 961 
	ENC_exp_apply_token(bs);
936 
    ENC_make_tok ( bs, n ) ;
 962 
	ENC_make_tok(bs, n);
937 
    return ( bs ) ;
 963 
	return (bs);
938 
}
 964 
}
939 
 
 965 
 
940 
 
 966 
 
941 
 
 967 
 
942 
/*
 968 
/*
943 
    ENCODE THE START OF A DIAGNOSTIC STATEMENT
 969 
    ENCODE THE START OF A DIAGNOSTIC STATEMENT
944 
 
 970 
 
945 
    This routine adds the start of a diagnostic statement e to the
 971 
    This routine adds the start of a diagnostic statement e to the
946 
    bitstream pointed to by pbs.
 972 
    bitstream pointed to by pbs.
947 
*/
 973 
*/
948 
 
 974 
 
949 
BITSTREAM *enc_diag_begin
 975 
BITSTREAM *
950 
    PROTO_N ( ( pbs ) )
 - 
 
951 
    PROTO_T ( BITSTREAM **pbs )
 976 
enc_diag_begin(BITSTREAM **pbs)
952 
{
 977 
{
953 
    BITSTREAM *bs = *pbs ;
 978 
	BITSTREAM *bs = *pbs;
954 
    if ( output_diag ) {
 979 
	if (output_diag) {
955 
	bs = enc_diag_start ( bs ) ;
 980 
		bs = enc_diag_start(bs);
956 
	*pbs = bs ;
 981 
		*pbs = bs;
957 
	bs = start_bitstream ( NIL ( FILE ), bs->link ) ;
 982 
		bs = start_bitstream(NIL(FILE), bs->link);
958 
    }
 983 
	}
959 
    return ( bs ) ;
 984 
	return (bs);
960 
}
 985 
}
961 
 
 986 
 
962 
 
 987 
 
963 
/*
 988 
/*
964 
    SHOULD DIAGNOSTICS BE OUTPUT FOR A STATEMENT?
 989 
    SHOULD DIAGNOSTICS BE OUTPUT FOR A STATEMENT?
965 
 
 990 
 
966 
    Not all statements are marked with diagnostic locations because they
 991 
    Not all statements are marked with diagnostic locations because they
967 
    are revelant when single stepping through the program.  This routine
 992 
    are revelant when single stepping through the program.  This routine
968 
    checks whether diagnostics should be output for the statement e.
 993 
    checks whether diagnostics should be output for the statement e.
969 
*/
 994 
*/
970 
 
 995 
 
971 
int is_diag_stmt
 996 
int
972 
    PROTO_N ( ( e ) )
 - 
 
973 
    PROTO_T ( EXP e )
 997 
is_diag_stmt(EXP e)
974 
{
 998 
{
975 
    if ( !IS_NULL_exp ( e ) ) {
 999 
	if (!IS_NULL_exp(e)) {
976 
	switch ( TAG_exp ( e ) ) {
 1000 
		switch (TAG_exp(e)) {
977 
	    case exp_sequence_tag : {
 1001 
		case exp_sequence_tag: {
978 
		/* Lexical blocks */
 1002 
			/* Lexical blocks */
979 
		if ( output_new_diag ) {
 1003 
			if (output_new_diag) {
980 
		    int blk = DEREF_int ( exp_sequence_block ( e ) ) ;
 1004 
				int blk = DEREF_int(exp_sequence_block(e));
981 
		    return ( blk ) ;
 1005 
				return (blk);
982 
		}
 1006 
			}
983 
		return ( 0 ) ;
 1007 
			return (0);
984 
	    }
 1008 
		}
985 
	    case exp_label_stmt_tag : {
 1009 
		case exp_label_stmt_tag: {
986 
		/* Labelled statements */
 1010 
			/* Labelled statements */
987 
		if ( output_new_diag ) {
 1011 
			if (output_new_diag) {
- 
 
 1012 
				IDENTIFIER lab =
988 
		    IDENTIFIER lab = DEREF_id ( exp_label_stmt_label ( e ) ) ;
 1013 
				    DEREF_id(exp_label_stmt_label(e));
989 
		    HASHID nm = DEREF_hashid ( id_name ( lab ) ) ;
 1014 
				HASHID nm = DEREF_hashid(id_name(lab));
990 
		    if ( !IS_hashid_anon ( nm ) ) return ( 1 ) ;
 1015 
				if (!IS_hashid_anon(nm)) {
- 
 
 1016 
					return (1);
- 
 
 1017 
				}
991 
		}
 1018 
			}
992 
		return ( 0 ) ;
 1019 
			return (0);
993 
	    }
 1020 
		}
994 
	    case exp_if_stmt_tag : {
 1021 
		case exp_if_stmt_tag: {
995 
		/* If statements and expressions */
 1022 
			/* If statements and expressions */
996 
		if ( output_diag ) {
 1023 
			if (output_diag) {
997 
		    IDENTIFIER lab = DEREF_id ( exp_if_stmt_label ( e ) ) ;
 1024 
				IDENTIFIER lab = DEREF_id(exp_if_stmt_label(e));
998 
		    if ( IS_NULL_id ( lab ) ) return ( 1 ) ;
 1025 
				if (IS_NULL_id(lab)) {
- 
 
 1026 
					return (1);
- 
 
 1027 
				}
999 
		}
 1028 
			}
1000 
		return ( 0 ) ;
 1029 
			return (0);
1001 
	    }
 1030 
		}
1002 
	    case exp_decl_stmt_tag :
 1031 
		case exp_decl_stmt_tag:
1003 
	    case exp_while_stmt_tag :
 1032 
		case exp_while_stmt_tag:
1004 
	    case exp_do_stmt_tag :
 1033 
		case exp_do_stmt_tag:
1005 
	    case exp_switch_stmt_tag :
 1034 
		case exp_switch_stmt_tag:
1006 
	    case exp_hash_if_tag :
 1035 
		case exp_hash_if_tag:
1007 
	    case exp_try_block_tag :
 1036 
		case exp_try_block_tag:
1008 
	    case exp_handler_tag : {
 1037 
		case exp_handler_tag: {
1009 
		/* Control statements */
 1038 
			/* Control statements */
1010 
		return ( 0 ) ;
 1039 
			return (0);
- 
 
 1040 
		}
1011 
	    }
 1041 
		}
1012 
	}
 1042 
	}
1013 
    }
 - 
 
1014 
    return ( output_diag ) ;
 1043 
	return (output_diag);
1015 
}
 1044 
}
1016 
 
 1045 
 
1017 
 
 1046 
 
1018 
/*
 1047 
/*
1019 
    ENCODE THE BODY OF A DIAGNOSTIC STATEMENT
 1048 
    ENCODE THE BODY OF A DIAGNOSTIC STATEMENT
1020 
 
 1049 
 
1021 
    This routine adds the diagnostic information associated with the
 1050 
    This routine adds the diagnostic information associated with the
1022 
    statement e to the bitstream bs.
 1051 
    statement e to the bitstream bs.
1023 
*/
 1052 
*/
1024 
 
 1053 
 
1025 
BITSTREAM *enc_diag_stmt
 1054 
BITSTREAM *
1026 
    PROTO_N ( ( bs, e, stmt ) )
 - 
 
1027 
    PROTO_T ( BITSTREAM *bs X EXP e X int stmt )
 1055 
enc_diag_stmt(BITSTREAM *bs, EXP e, int stmt)
1028 
{
 1056 
{
1029 
    PTR ( LOCATION ) loc ;
 1057 
	PTR(LOCATION)loc;
1030 
#if TDF_NEW_DIAG
 1058 
#if TDF_NEW_DIAG
1031 
    if ( output_new_diag ) {
 1059 
	if (output_new_diag) {
1032 
	bs = enc_dg_stmt ( bs, e, stmt ) ;
 1060 
		bs = enc_dg_stmt(bs, e, stmt);
1033 
	return ( bs ) ;
 1061 
		return (bs);
1034 
    }
 1062 
	}
1035 
#endif
 1063 
#endif
1036 
    loc = crt_enc_loc ;
 1064 
	loc = crt_enc_loc;
1037 
    if ( !IS_NULL_exp ( e ) ) {
 1065 
	if (!IS_NULL_exp(e)) {
1038 
	switch ( TAG_exp ( e ) ) {
 1066 
		switch (TAG_exp(e)) {
1039 
	    case exp_decl_stmt_tag : {
 1067 
		case exp_decl_stmt_tag: {
1040 
		IDENTIFIER id = DEREF_id ( exp_decl_stmt_id ( e ) ) ;
 1068 
			IDENTIFIER id = DEREF_id(exp_decl_stmt_id(e));
1041 
		loc = id_loc ( id ) ;
 1069 
			loc = id_loc(id);
1042 
		break ;
 1070 
			break;
1043 
	    }
 1071 
		}
1044 
	    case exp_label_stmt_tag : {
 1072 
		case exp_label_stmt_tag: {
1045 
		IDENTIFIER id = DEREF_id ( exp_label_stmt_label ( e ) ) ;
 1073 
			IDENTIFIER id = DEREF_id(exp_label_stmt_label(e));
1046 
		loc = id_loc ( id ) ;
 1074 
			loc = id_loc(id);
1047 
		break ;
 1075 
			break;
- 
 
 1076 
		}
1048 
	    }
 1077 
		}
1049 
	}
 1078 
	}
1050 
    }
 - 
 
1051 
    bs = enc_diag_loc ( bs, loc ) ;
 1079 
	bs = enc_diag_loc(bs, loc);
1052 
    bs = enc_diag_loc ( bs, loc ) ;
 1080 
	bs = enc_diag_loc(bs, loc);
1053 
    UNUSED ( stmt ) ;
 1081 
	UNUSED(stmt);
1054 
    return ( bs ) ;
 1082 
	return (bs);
1055 
}
 1083 
}
1056 
 
 1084 
 
1057 
 
 1085 
 
1058 
/*
 1086 
/*
1059 
    ENCODE THE END OF A DIAGNOSTIC STATEMENT
 1087 
    ENCODE THE END OF A DIAGNOSTIC STATEMENT
1060 
 
 1088 
 
1061 
    This routine adds the end of the diagnostic statement e to the
 1089 
    This routine adds the end of the diagnostic statement e to the
1062 
    bitstream bs.  ts gives the encoding of e.
 1090 
    bitstream bs.  ts gives the encoding of e.
1063 
*/
 1091 
*/
1064 
 
 1092 
 
1065 
BITSTREAM *enc_diag_end
 1093 
BITSTREAM *
1066 
    PROTO_N ( ( bs, ts, e, stmt ) )
 - 
 
1067 
    PROTO_T ( BITSTREAM *bs X BITSTREAM *ts X EXP e X int stmt )
 1094 
enc_diag_end(BITSTREAM *bs, BITSTREAM *ts, EXP e, int stmt)
1068 
{
 1095 
{
1069 
    if ( output_diag ) {
 1096 
	if (output_diag) {
1070 
	ts = enc_diag_stmt ( ts, e, stmt ) ;
 1097 
		ts = enc_diag_stmt(ts, e, stmt);
1071 
	ts = enc_bitstream ( bs, ts ) ;
 1098 
		ts = enc_bitstream(bs, ts);
1072 
    }
 1099 
	}
1073 
    return ( ts ) ;
 1100 
	return (ts);
1074 
}
 1101 
}
1075 
 
 1102 
 
1076 
 
 1103 
 
1077 
#endif /* TDF_OUTPUT */
 1104 
#endif /* TDF_OUTPUT */