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) 1996
 32 
    		 Crown Copyright (c) 1996
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
Line 54... Line 84...
54 
 * Revision 1.4  94/02/21  16:09:42  16:09:42  ra (Robert Andrews)
 84 
 * Revision 1.4  94/02/21  16:09:42  16:09:42  ra (Robert Andrews)
55 
 * Put in a number of explicit casts.
 85 
 * Put in a number of explicit casts.
56 
 *
 86 
 *
57 
 * Revision 1.3  93/11/19  16:25:34  16:25:34  ra (Robert Andrews)
 87 
 * Revision 1.3  93/11/19  16:25:34  16:25:34  ra (Robert Andrews)
58 
 * Bitfields should have the correct size, not 32.
 88 
 * Bitfields should have the correct size, not 32.
59 
 *
 89 
 *
60 
 * Revision 1.2  93/04/19  13:40:05  13:40:05  ra (Robert Andrews)
 90 
 * Revision 1.2  93/04/19  13:40:05  13:40:05  ra (Robert Andrews)
61 
 * struct_fields and union_fields have been renamed diag_field.
 91 
 * struct_fields and union_fields have been renamed diag_field.
62 
 *
 92 
 *
63 
 * Revision 1.1  93/02/22  17:17:29  17:17:29  ra (Robert Andrews)
 93 
 * Revision 1.1  93/02/22  17:17:29  17:17:29  ra (Robert Andrews)
64 
 * Initial revision
 94 
 * Initial revision
65 
 *
 95 
 *
66 
--------------------------------------------------------------------------
 96 
--------------------------------------------------------------------------
67 
*/
 97 
*/
Line 81... Line 111...
81 
#include "utility.h"
 111 
#include "utility.h"
82 
#include "xdb_output.h"
 112 
#include "xdb_output.h"
83 
#include "xdb_types.h"
 113 
#include "xdb_types.h"
84 
#ifndef SEEK_SET
 114 
#ifndef SEEK_SET
85 
#define SEEK_SET 0
 115 
#define SEEK_SET 0
86 
#endif
 116 
#endif
87 
 
 117 
 
88 
 
 118 
 
89 
/*
 119 
/*
90 
    GENERATE A UNIQUE IDENTIFIER
 120 
    GENERATE A UNIQUE IDENTIFIER
91 
*/
 121 
*/
92 
 
 122 
 
93 
static unsigned unique_id
 123 
static unsigned
94 
    PROTO_Z ()
 124 
unique_id(void)
95 
{
 125 
{
96 
    static unsigned u = 0 ;
 126 
	static unsigned u = 0;
97 
    if ( u == 0 ) {
 127 
	if (u == 0) {
98 
	time_t t = time ( ( time_t * ) NULL ) ;
 128 
		time_t t = time((time_t *)NULL);
99 
	u = ( unsigned ) t ;
 129 
		u = (unsigned)t;
100 
    }
 130 
	}
101 
    return ( u ) ;
 131 
	return (u);
102 
}
 132 
}
103 
 
 133 
 
104 
 
 134 
 
105 
/*
 135 
/*
106 
    CURRENT POSITIONS IN DIAGNOSTIC NAME TABLES
 136 
    CURRENT POSITIONS IN DIAGNOSTIC NAME TABLES
107 
*/
 137 
*/
108 
 
 138 
 
109 
static posn_t dtposn_local = LOCAL_POSN ;
 139 
static posn_t dtposn_local = LOCAL_POSN;
110 
static posn_t dtposn_globl = GLOBL_POSN ;
 140 
static posn_t dtposn_globl = GLOBL_POSN;
111 
 
 141 
 
112 
 
 142 
 
113 
/*
 143 
/*
114 
    OUTPUT A DIAGNOSTIC DIRECTIVE
 144 
    OUTPUT A DIAGNOSTIC DIRECTIVE
115 
*/
 145 
*/
116 
 
 146 
 
117 
posn_t out_dd
 147 
posn_t
118 
    PROTO_N ( ( file, n, loc ) )
 - 
 
119 
    PROTO_T ( FILE *file X int n X int loc )
 148 
out_dd(FILE *file, int n, int loc)
120 
{
 149 
{
121 
    diag_directive *d = dd + n ;
 150 
	diag_directive *d = dd + n;
122 
    long sz = ( diag_format == DIAG_XDB_NEW ? d->new_size : d->old_size ) ;
 151 
	long sz = (diag_format == DIAG_XDB_NEW ? d->new_size : d->old_size);
123 
    posn_t p = ( loc ? dtposn_local : dtposn_globl ) ;
 152 
	posn_t p = (loc ? dtposn_local : dtposn_globl);
124 
    fprintf ( file, "%s", instr_names [ d->instr ] ) ;
 153 
	fprintf(file, "%s", instr_names[d->instr]);
125 
    if ( loc ) {
 154 
	if (loc) {
126 
	dtposn_local = p + sz ;
 155 
		dtposn_local = p + sz;
127 
    } else {
 156 
	} else {
128 
	dtposn_globl = p + sz ;
 157 
		dtposn_globl = p + sz;
129 
    }
 158 
	}
130 
    return ( p ) ;
 159 
	return (p);
131 
}
 160 
}
132 
 
 161 
 
133 
 
 162 
 
134 
/*
 163 
/*
135 
     CREATE A NEW TABLE POSITION
 164 
     CREATE A NEW TABLE POSITION
136 
*/
 165 
*/
137 
 
 166 
 
138 
static table_posn *new_table_posn
 167 
static table_posn *
139 
    PROTO_N ( ( n, sz ) )
 - 
 
140 
    PROTO_T ( posn_t n X long sz )
 168 
new_table_posn(posn_t n, long sz)
141 
{
 169 
{
142 
    table_posn *p ;
 170 
	table_posn *p;
143 
    static int no_tp_free = 0 ;
 171 
	static int no_tp_free = 0;
144 
    static table_posn *tp_free ;
 172 
	static table_posn *tp_free;
145 
    if ( no_tp_free == 0 ) {
 173 
	if (no_tp_free == 0) {
146 
	no_tp_free = 20 ;
 174 
		no_tp_free = 20;
147 
	tp_free = alloc_nof ( table_posn, no_tp_free ) ;
 175 
		tp_free = alloc_nof(table_posn, no_tp_free);
148 
    }
 176 
	}
149 
    p = tp_free++ ;
 177 
	p = tp_free++;
150 
    no_tp_free-- ;
 178 
	no_tp_free--;
151 
    p->is_lab = 0 ;
 179 
	p->is_lab = 0;
152 
    p->posn = n ;
 180 
	p->posn = n;
153 
    p->size = sz ;
 181 
	p->size = sz;
154 
    return ( p ) ;
 182 
	return (p);
155 
}
 183 
}
156 
 
 184 
 
157 
 
 185 
 
158 
/*
 186 
/*
159 
    OUTPUT A TABLE POSITION
 187 
    OUTPUT A TABLE POSITION
160 
*/
 188 
*/
161 
 
 189 
 
162 
void out_posn
 190 
void
163 
    PROTO_N ( ( file, p, comma ) )
 - 
 
164 
    PROTO_T ( FILE *file X table_posn *p X int comma )
 191 
out_posn(FILE *file, table_posn *p, int comma)
165 
{
 192 
{
166 
    if ( p->is_lab ) {
 193 
	if (p->is_lab) {
167 
	fprintf ( file, "LD%d", ( int ) p->posn ) ;
 194 
		fprintf(file, "LD%d",(int)p->posn);
168 
    } else {
 195 
	} else {
169 
	fprintf ( file, "0x%x", ( unsigned int ) p->posn ) ;
 196 
		fprintf(file, "0x%x",(unsigned int)p->posn);
170 
    }
 197 
	}
171 
    fputc ( ( comma ? ',' : '\n' ), file ) ;
 198 
	fputc((comma ? ',' : '\n'), file);
172 
    return ;
 199 
	return;
173 
}
 200 
}
174 
 
 201 
 
175 
 
 202 
 
176 
/*
 203 
/*
177 
    GO TO A POSITION IN A FILE AND PRINT A TABLE POSITION
 204 
    GO TO A POSITION IN A FILE AND PRINT A TABLE POSITION
178 
*/
 205 
*/
179 
 
 206 
 
180 
void fill_gap
 207 
void
181 
    PROTO_N ( ( file, fp, t ) )
 - 
 
182 
    PROTO_T ( FILE *file X long fp X posn_t t )
 208 
fill_gap(FILE *file, long fp, posn_t t)
183 
{
 209 
{
184 
    long fp_old = ftell ( file ) ;
 210 
	long fp_old = ftell(file);
185 
    if ( fseek ( file, fp, SEEK_SET ) == -1 ) {
 211 
	if (fseek(file, fp, SEEK_SET) == -1) {
186 
	error ( "Internal file seek error" ) ;
 212 
		error("Internal file seek error");
187 
	return ;
 213 
		return;
188 
    }
 214 
	}
189 
    fprintf ( file, "0x%x", ( unsigned int ) t ) ;
 215 
	fprintf(file, "0x%x", (unsigned int)t);
190 
    if ( fseek ( file, fp_old, SEEK_SET ) == -1 ) {
 216 
	if (fseek(file, fp_old, SEEK_SET) == -1) {
191 
	error ( "Internal file seek error" ) ;
 217 
		error("Internal file seek error");
192 
    }
 218 
	}
193 
    return ;
 219 
	return;
194 
}
 220 
}
195 
 
 221 
 
196 
 
 222 
 
197 
/*
 223 
/*
198 
    CURRENT DIAGNOSTICS LABEL NUMBER
 224 
    CURRENT DIAGNOSTICS LABEL NUMBER
199 
*/
 225 
*/
200 
 
 226 
 
201 
static long diag_lab = 0 ;
 227 
static long diag_lab = 0;
202 
 
 228 
 
203 
 
 229 
 
204 
/*
 230 
/*
205 
    FIND THE TABLE POSITION OF A TDF SHAPE
 231 
    FIND THE TABLE POSITION OF A TDF SHAPE
206 
*/
 232 
*/
207 
 
 233 
 
208 
static table_posn *analyse_diag_shape
 234 
static table_posn *
209 
    PROTO_N ( ( file, sha ) )
 - 
 
210 
    PROTO_T ( FILE *file X shape sha )
 235 
analyse_diag_shape(FILE *file, shape sha)
211 
{
 236 
{
212 
    posn_t t = NULL_POSN ;
 237 
	posn_t t = NULL_POSN;
213 
    long sz = shape_size ( sha ) ;
 238 
	long sz = shape_size(sha);
214 
    switch ( name ( sha ) ) {
 239 
	switch (name(sha)) {
- 
 
 240 
	case scharhd:
215 
	case scharhd : t = CHAR_POSN + sz ; break ;
 241 
		t = CHAR_POSN + sz;
- 
 
 242 
		break;
216 
	case swordhd :
 243 
	case swordhd:
- 
 
 244 
	case slonghd:
217 
	case slonghd : t = SIGNED_POSN + sz ; break ;
 245 
		t = SIGNED_POSN + sz;
- 
 
 246 
		break;
218 
	case ucharhd :
 247 
	case ucharhd:
219 
	case uwordhd :
 248 
	case uwordhd:
- 
 
 249 
	case ulonghd:
220 
	case ulonghd : t = UNSIGNED_POSN + sz ; break ;
 250 
		t = UNSIGNED_POSN + sz;
- 
 
 251 
		break;
221 
	case shrealhd :
 252 
	case shrealhd:
222 
	case realhd :
 253 
	case realhd:
- 
 
 254 
	case doublehd:
223 
	case doublehd : t = FLOATING_POSN + sz ; break ;
 255 
		t = FLOATING_POSN + sz;
- 
 
 256 
		break;
224 
    }
 257 
	}
225 
    return ( new_table_posn ( t, sz ) ) ;
 258 
	return (new_table_posn(t, sz));
226 
}
 259 
}
227 
 
 260 
 
228 
 
 261 
 
229 
/*
 262 
/*
230 
    FIND THE TABLE POSITION OF A DIAGNOSTIC TYPE
 263 
    FIND THE TABLE POSITION OF A DIAGNOSTIC TYPE
231 
*/
 264 
*/
232 
 
 265 
 
233 
table_posn *analyse_diag_type
 266 
table_posn *
234 
    PROTO_N ( ( file, dt, loc ) )
 - 
 
235 
    PROTO_T ( FILE *file X diag_type dt X int loc )
 267 
analyse_diag_type(FILE *file, diag_type dt, int loc)
236 
{
 268 
{
237 
    table_posn *res ;
 269 
	table_posn *res;
- 
 
 270 
	if (dt->been_outed) {
238 
    if ( dt->been_outed ) return ( ( table_posn * ) dt->been_outed ) ;
 271 
		return ((table_posn *)dt->been_outed);
- 
 
 272 
	}
239 
 
 273 
 
240 
    switch ( dt->key ) {
 274 
	switch (dt->key) {
241 
 
 - 
 
242 
	case DIAG_TYPE_ARRAY : {
 275 
	case DIAG_TYPE_ARRAY: {
243 
	    diag_type dtl = dt->data.array.element_type ;
 276 
		diag_type dtl = dt->data.array.element_type;
244 
	    long lo = no ( dt->data.array.lower_b ) ;
 277 
		long lo = no(dt->data.array.lower_b);
245 
	    long hi = no ( dt->data.array.upper_b ) ;
 278 
		long hi = no(dt->data.array.upper_b);
246 
 
 - 
 
247 
	    table_posn *p = analyse_diag_type ( file, dtl, loc ) ;
 - 
 
248 
	    long sz = ( hi - lo + 1 ) * ( p->size ) ;
 - 
 
249 
	    posn_t s, t = out_dd ( file, xdb_subrange, loc ) ;
 - 
 
250 
 
 - 
 
251 
	    if ( diag_format == DIAG_XDB_NEW ) fprintf ( file, "0,0," ) ;
 - 
 
252 
	    fprintf ( file, "%ld,%ld,0x%x,32\n", lo, hi,
 - 
 
253 
		      ( unsigned int ) ( SIGNED_POSN + 32 ) ) ;
 - 
 
254 
	    s = out_dd ( file, xdb_array, loc ) ;
 - 
 
255 
	    if ( diag_format == DIAG_XDB_NEW ) {
 - 
 
256 
		fprintf ( file, "0,0,0,0,0,0," ) ;
 - 
 
257 
	    }
 - 
 
258 
	    fprintf ( file, "0,%ld,0x%x,", sz, ( unsigned int ) t ) ;
 - 
 
259 
	    if ( diag_format == DIAG_XDB_NEW ) {
 - 
 
260 
		out_posn ( file, p, 1 ) ;
 - 
 
261 
		fprintf ( file, "%ld\n", p->size ) ;
 - 
 
262 
	    } else {
 - 
 
263 
		out_posn ( file, p, 0 ) ;
 - 
 
264 
	    }
 - 
 
265 
	    res = new_table_posn ( s, sz ) ;
 - 
 
266 
	    break ;
 - 
 
267 
	}
 - 
 
268 
 
 - 
 
269 
	case DIAG_TYPE_BITFIELD : {
 - 
 
270 
	    long sz = dt->data.bitfield.no_of_bits.nat_val.small_nat ;
 - 
 
271 
	    res = new_table_posn ( SIGNED_POSN + 32, sz ) ;
 - 
 
272 
	    break ;
 - 
 
273 
	}
 - 
 
274 
 
 - 
 
275 
	case DIAG_TYPE_ENUM : {
 - 
 
276 
	    char *nm = dt->data.t_enum.nme.ints.chars ;
 - 
 
277 
	    enum_values *fld = dt->data.t_enum.values->array ;
 - 
 
278 
	    long i, n = ( long ) dt->data.t_enum.values->lastused ;
 - 
 
279 
 
 - 
 
280 
	    /* Initialize enumeration information */
 - 
 
281 
	    long fp ;
 - 
 
282 
	    posn_t t ;
 - 
 
283 
	    t = out_dd ( file, xdb_enum, loc ) ;
 - 
 
284 
	    fp = ftell ( file ) ;
 - 
 
285 
	    fprintf ( file, "%s,32\n", NULL_POSN_STR ) ;
 - 
 
286 
	    res = new_table_posn ( t, L32 ) ;
 - 
 
287 
 
 - 
 
288 
	    /* Deal with enumeration members */
 - 
 
289 
	    for ( i = n - 1 ; i >= 0 ; i-- ) {
 - 
 
290 
		char *fnm = fld [i]->nme.ints.chars ;
 - 
 
291 
		long v = no ( fld [i]->val ) ;
 - 
 
292 
		posn_t s = out_dd ( file, xdb_memenum, loc ) ;
 - 
 
293 
		fill_gap ( file, fp, s ) ;
 - 
 
294 
		if ( diag_format == DIAG_XDB_NEW ) fprintf ( file, "0," ) ;
 - 
 
295 
		if ( *fnm ) {
 - 
 
296 
		    diag_string ( file, fnm ) ;
 - 
 
297 
		} else {
 - 
 
298 
		    diag_string ( file, "__unknown" ) ;
 - 
 
299 
		}
 - 
 
300 
		fprintf ( file, ",%ld,", v ) ;
 - 
 
301 
		fp = ftell ( file ) ;
 - 
 
302 
		fprintf ( file, "%s\n", NULL_POSN_STR ) ;
 - 
 
303 
	    }
 - 
 
304 
 
 - 
 
305 
	    /* Round off enumeration definition */
 - 
 
306 
	    if ( *nm ) {
 - 
 
307 
		( void ) out_dd ( file, xdb_tagdef, loc ) ;
 - 
 
308 
		fprintf ( file, "0," ) ;
 - 
 
309 
		if ( diag_format == DIAG_XDB_NEW ) fprintf ( file, "1," ) ;
 - 
 
310 
		diag_string ( file, nm ) ;
 - 
 
311 
		fprintf ( file, "," ) ;
 - 
 
312 
		out_posn ( file, res, 0 ) ;
 - 
 
313 
	    }
 - 
 
314 
	    break ;
 - 
 
315 
	}
 - 
 
316 
 
 - 
 
317 
	case DIAG_TYPE_FLOAT : {
 - 
 
318 
	    shape sha = f_floating ( dt->data.f_var ) ;
 - 
 
319 
	    res = analyse_diag_shape ( file, sha ) ;
 - 
 
320 
	    break ;
 - 
 
321 
	}
 - 
 
322 
 
 279 
 
323 
	case DIAG_TYPE_LOC : {
 280 
		table_posn *p = analyse_diag_type(file, dtl, loc);
324 
	    diag_type dtl = dt->data.loc.object ;
 281 
		long sz = (hi - lo + 1)*(p->size);
325 
	    res = analyse_diag_type ( file, dtl, loc ) ;
 282 
		posn_t s, t = out_dd(file, xdb_subrange, loc);
326 
	    break ;
 - 
 
327 
	}
 - 
 
328 
 
 283 
 
- 
 
 284 
		if (diag_format == DIAG_XDB_NEW) {
- 
 
 285 
			fprintf(file, "0,0,");
- 
 
 286 
		}
- 
 
 287 
		fprintf(file, "%ld,%ld,0x%x,32\n", lo, hi,
- 
 
 288 
			(unsigned int)(SIGNED_POSN + 32));
- 
 
 289 
		s = out_dd(file, xdb_array, loc);
- 
 
 290 
		if (diag_format == DIAG_XDB_NEW) {
- 
 
 291 
			fprintf(file, "0,0,0,0,0,0,");
- 
 
 292 
		}
- 
 
 293 
		fprintf(file, "0,%ld,0x%x,", sz,(unsigned int)t);
- 
 
 294 
		if (diag_format == DIAG_XDB_NEW) {
- 
 
 295 
			out_posn(file, p, 1);
- 
 
 296 
			fprintf(file, "%ld\n", p->size);
- 
 
 297 
		} else {
- 
 
 298 
			out_posn(file, p, 0);
- 
 
 299 
		}
- 
 
 300 
		res = new_table_posn(s, sz);
- 
 
 301 
		break;
- 
 
 302 
	}
329 
	case DIAG_TYPE_NULL : {
 303 
	case DIAG_TYPE_BITFIELD: {
- 
 
 304 
		long sz = dt->data.bitfield.no_of_bits.nat_val.small_nat;
330 
	    res = new_table_posn ( NULL_POSN, L0 ) ;
 305 
		res = new_table_posn(SIGNED_POSN + 32, sz);
331 
	    break ;
 306 
		break;
332 
	}
 307 
	}
- 
 
 308 
	case DIAG_TYPE_ENUM: {
- 
 
 309 
		char *nm = dt->data.t_enum.nme.ints.chars;
- 
 
 310 
		enum_values *fld = dt->data.t_enum.values->array;
- 
 
 311 
		long i, n = (long)dt->data.t_enum.values->lastused;
- 
 
 312 
 
- 
 
 313 
		/* Initialize enumeration information */
- 
 
 314 
		long fp;
- 
 
 315 
		posn_t t;
- 
 
 316 
		t = out_dd(file, xdb_enum, loc);
- 
 
 317 
		fp = ftell(file);
- 
 
 318 
		fprintf(file, "%s,32\n", NULL_POSN_STR);
- 
 
 319 
		res = new_table_posn(t, L32);
- 
 
 320 
 
- 
 
 321 
		/* Deal with enumeration members */
- 
 
 322 
		for (i = n - 1; i >= 0; i--) {
- 
 
 323 
			char *fnm = fld[i] ->nme.ints.chars;
- 
 
 324 
			long v = no(fld[i] ->val);
- 
 
 325 
			posn_t s = out_dd(file, xdb_memenum, loc);
- 
 
 326 
			fill_gap(file, fp, s);
- 
 
 327 
			if (diag_format == DIAG_XDB_NEW) {
- 
 
 328 
				fprintf(file, "0,");
- 
 
 329 
			}
- 
 
 330 
			if (*fnm) {
- 
 
 331 
				diag_string(file, fnm);
- 
 
 332 
			} else {
- 
 
 333 
				diag_string(file, "__unknown");
- 
 
 334 
			}
- 
 
 335 
			fprintf(file, ",%ld,", v);
- 
 
 336 
			fp = ftell(file);
- 
 
 337 
			fprintf(file, "%s\n", NULL_POSN_STR);
- 
 
 338 
		}
333 
 
 339 
 
- 
 
 340 
		/* Round off enumeration definition */
- 
 
 341 
		if (*nm) {
- 
 
 342 
			(void)out_dd(file, xdb_tagdef, loc);
- 
 
 343 
			fprintf(file, "0,");
- 
 
 344 
			if (diag_format == DIAG_XDB_NEW) {
- 
 
 345 
				fprintf(file, "1,");
- 
 
 346 
			}
- 
 
 347 
			diag_string(file, nm);
- 
 
 348 
			fprintf(file, ",");
- 
 
 349 
			out_posn(file, res, 0);
- 
 
 350 
		}
- 
 
 351 
		break;
- 
 
 352 
	}
- 
 
 353 
	case DIAG_TYPE_FLOAT: {
- 
 
 354 
		shape sha = f_floating(dt->data.f_var);
- 
 
 355 
		res = analyse_diag_shape(file, sha);
- 
 
 356 
		break;
- 
 
 357 
	}
- 
 
 358 
	case DIAG_TYPE_LOC: {
- 
 
 359 
		diag_type dtl = dt->data.loc.object;
- 
 
 360 
		res = analyse_diag_type(file, dtl, loc);
- 
 
 361 
		break;
- 
 
 362 
	}
- 
 
 363 
	case DIAG_TYPE_NULL:
- 
 
 364 
		res = new_table_posn(NULL_POSN, L0);
- 
 
 365 
		break;
334 
	case DIAG_TYPE_PROC : {
 366 
	case DIAG_TYPE_PROC: {
335 
	    diag_type dtl = dt->data.proc.result_type ;
 367 
		diag_type dtl = dt->data.proc.result_type;
336 
	    table_posn *p = analyse_diag_type ( file, dtl, loc ) ;
 368 
		table_posn *p = analyse_diag_type(file, dtl, loc);
337 
	    posn_t t = out_dd ( file, xdb_functype, loc ) ;
 369 
		posn_t t = out_dd(file, xdb_functype, loc);
338 
	    if ( diag_format == DIAG_XDB_NEW ) fprintf ( file, "0,0," ) ;
 370 
		if (diag_format == DIAG_XDB_NEW) {
- 
 
 371 
			fprintf(file, "0,0,");
- 
 
 372 
		}
339 
	    fprintf ( file, "32," ) ;
 373 
		fprintf(file, "32,");
340 
	    out_posn ( file, p, 1 ) ;
 374 
		out_posn(file, p, 1);
341 
	    fprintf ( file, "%s\n", NULL_POSN_STR ) ;
 375 
		fprintf(file, "%s\n", NULL_POSN_STR);
342 
	    res = new_table_posn ( t, L32 ) ;
 376 
		res = new_table_posn(t, L32);
343 
	    break ;
 377 
		break;
344 
	}
 378 
	}
345 
 
 - 
 
346 
	case DIAG_TYPE_PTR : {
 379 
	case DIAG_TYPE_PTR: {
347 
	    diag_type dtl = dt->data.ptr.object ;
 380 
		diag_type dtl = dt->data.ptr.object;
348 
	    table_posn *p = analyse_diag_type ( file, dtl, loc ) ;
 381 
		table_posn *p = analyse_diag_type(file, dtl, loc);
349 
	    posn_t t = out_dd ( file, xdb_pointer, loc ) ;
 382 
		posn_t t = out_dd(file, xdb_pointer, loc);
350 
	    out_posn ( file, p, 1 ) ;
 383 
		out_posn(file, p, 1);
351 
	    fprintf ( file, "32\n" ) ;
 384 
		fprintf(file, "32\n");
352 
	    res = new_table_posn ( t, L32 ) ;
 385 
		res = new_table_posn(t, L32);
353 
	    break ;
 386 
		break;
354 
	}
 387 
	}
- 
 
 388 
	case DIAG_TYPE_STRUCT: {
- 
 
 389 
		shape sha = dt->data.t_struct.tdf_shape;
- 
 
 390 
		long sz = shape_size(sha);
- 
 
 391 
		char *nm = dt->data.t_struct.nme.ints.chars;
- 
 
 392 
#if 0
- 
 
 393 
		struct_fields *fld = dt->data.t_struct.fields->array;
- 
 
 394 
#else
- 
 
 395 
		diag_field *fld = dt->data.t_struct.fields->array;
- 
 
 396 
#endif
- 
 
 397 
		long i, n = (long)dt->data.t_struct.fields->lastused;
- 
 
 398 
 
- 
 
 399 
		/* Initialize structure information */
- 
 
 400 
		long fp;
- 
 
 401 
		posn_t t;
- 
 
 402 
		int taglab = 0;
- 
 
 403 
		char nmbuff[50];
- 
 
 404 
		long dlab = diag_lab++;
- 
 
 405 
		if (diag_format == DIAG_XDB_NEW) {
- 
 
 406 
			if (*nm == 0) {
- 
 
 407 
				unsigned u = unique_id();
- 
 
 408 
				nm = nmbuff;
- 
 
 409 
				sprintf(nm, "(%u.%ld)", u, dlab);
- 
 
 410 
			}
- 
 
 411 
			taglab = 1;
- 
 
 412 
		}
- 
 
 413 
		if (!taglab) {
- 
 
 414 
			fprintf(file, "LD%ld:", dlab);
- 
 
 415 
		}
- 
 
 416 
		t = out_dd(file, xdb_struct, loc);
- 
 
 417 
		fprintf(file, "0,");
- 
 
 418 
		fp = ftell(file);
- 
 
 419 
		fprintf(file, "%s,%s,%s,%ld\n", NULL_POSN_STR, NULL_POSN_STR,
- 
 
 420 
			NULL_POSN_STR, sz);
- 
 
 421 
		res = new_table_posn(t, sz);
- 
 
 422 
 
- 
 
 423 
		/* Print tag information */
- 
 
 424 
		if (*nm) {
- 
 
 425 
			posn_t tt;
- 
 
 426 
			if (taglab) {
- 
 
 427 
				fprintf(file, "LD%ld:", dlab);
- 
 
 428 
			}
- 
 
 429 
			tt = out_dd(file, xdb_tagdef, loc);
- 
 
 430 
			fprintf(file, "0,");
- 
 
 431 
			if (diag_format == DIAG_XDB_NEW) {
- 
 
 432 
				fprintf(file, "1,");
- 
 
 433 
			}
- 
 
 434 
			diag_string(file, nm);
- 
 
 435 
			fprintf(file, ",");
- 
 
 436 
			out_posn(file, res, 0);
- 
 
 437 
			if (taglab) {
- 
 
 438 
				t = tt;
- 
 
 439 
			}
- 
 
 440 
		}
- 
 
 441 
 
- 
 
 442 
		/* Set up structure label */
- 
 
 443 
		res->is_lab = 1;
- 
 
 444 
		res->posn = (posn_t)dlab;
- 
 
 445 
		dt->been_outed = (OUTPUT_REC)res;
355 
 
 446 
 
- 
 
 447 
		/* Deal with structure fields */
356 
	case DIAG_TYPE_STRUCT : {
 448 
		for (i = n - 1; i >= 0; i--) {
357 
	    shape sha = dt->data.t_struct.tdf_shape ;
 449 
			char *fnm = fld[i] ->field_name.ints.chars;
358 
	    long sz = shape_size ( sha ) ;
 450 
			long off = no(fld[i] ->where);
359 
	    char *nm = dt->data.t_struct.nme.ints.chars ;
 451 
			diag_type dtl = fld[i] ->field_type;
360 
#if 0
 - 
 
361 
	    struct_fields *fld = dt->data.t_struct.fields->array ;
 452 
			table_posn *q = analyse_diag_type(file, dtl, loc);
362 
#else
 - 
 
363 
	    diag_field *fld = dt->data.t_struct.fields->array ;
 453 
			posn_t s = out_dd(file, xdb_field, loc);
364 
#endif
 454 
			fill_gap(file, fp, s);
365 
	    long i, n = ( long ) dt->data.t_struct.fields->lastused ;
 455 
			if (diag_format == DIAG_XDB_NEW) {
366 
 
 - 
 
367 
	    /* Initialize structure information */
 456 
				fprintf(file, "0,0,");
368 
	    long fp ;
 457 
			}
369 
	    posn_t t ;
 458 
			if (*fnm) {
370 
	    int taglab = 0 ;
 459 
				diag_string(file, fnm);
371 
	    char nmbuff [50] ;
 460 
			} else {
372 
	    long dlab = diag_lab++ ;
 461 
				diag_string(file, "__unknown");
- 
 
 462 
			}
373 
	    if ( diag_format == DIAG_XDB_NEW ) {
 463 
			fprintf(file, ",%ld,", off);
374 
		if ( *nm == 0 ) {
 464 
			out_posn(file, q, 1);
375 
		    unsigned u = unique_id () ;
 465 
			fprintf(file, "%ld,", q->size);
376 
		    nm = nmbuff ;
 466 
			fp = ftell(file);
377 
		    sprintf ( nm, "(%u.%ld)", u, dlab ) ;
 467 
			fprintf(file, "%s\n", NULL_POSN_STR);
378 
		}
 468 
		}
379 
		taglab = 1 ;
 - 
 
380 
	    }
 - 
 
381 
	    if ( !taglab ) fprintf ( file, "LD%ld:", dlab ) ;
 - 
 
382 
	    t = out_dd ( file, xdb_struct, loc ) ;
 - 
 
383 
	    fprintf ( file, "0," ) ;
 - 
 
384 
	    fp = ftell ( file ) ;
 - 
 
385 
	    fprintf ( file, "%s,%s,%s,%ld\n", NULL_POSN_STR, NULL_POSN_STR,
 - 
 
386 
		      NULL_POSN_STR, sz ) ;
 - 
 
387 
	    res = new_table_posn ( t, sz ) ;
 - 
 
388 
 
 - 
 
389 
	    /* Print tag information */
 - 
 
390 
	    if ( *nm ) {
 - 
 
391 
		posn_t tt ;
 - 
 
392 
		if ( taglab ) fprintf ( file, "LD%ld:", dlab ) ;
 - 
 
393 
		tt = out_dd ( file, xdb_tagdef, loc ) ;
 - 
 
394 
		fprintf ( file, "0," ) ;
 - 
 
395 
		if ( diag_format == DIAG_XDB_NEW ) fprintf ( file, "1," ) ;
 - 
 
396 
		diag_string ( file, nm ) ;
 - 
 
397 
		fprintf ( file, "," ) ;
 - 
 
398 
		out_posn ( file, res, 0 ) ;
 - 
 
399 
		if ( taglab ) t = tt ;
 - 
 
400 
	    }
 - 
 
401 
 
 - 
 
402 
	    /* Set up structure label */
 - 
 
403 
	    res->is_lab = 1 ;
 - 
 
404 
	    res->posn = ( posn_t ) dlab ;
 - 
 
405 
	    dt->been_outed = ( OUTPUT_REC ) res ;
 - 
 
406 
 
 - 
 
407 
	    /* Deal with structure fields */
 - 
 
408 
	    for ( i = n - 1 ; i >= 0 ; i-- ) {
 - 
 
409 
		char *fnm = fld [i]->field_name.ints.chars ;
 - 
 
410 
		long off = no ( fld [i]->where ) ;
 - 
 
411 
		diag_type dtl = fld [i]->field_type ;
 - 
 
412 
		table_posn *q = analyse_diag_type ( file, dtl, loc ) ;
 - 
 
413 
		posn_t s = out_dd ( file, xdb_field, loc ) ;
 - 
 
414 
		fill_gap ( file, fp, s ) ;
 - 
 
415 
		if ( diag_format == DIAG_XDB_NEW ) fprintf ( file, "0,0," ) ;
 - 
 
416 
		if ( *fnm ) {
 - 
 
417 
		    diag_string ( file, fnm ) ;
 - 
 
418 
		} else {
 - 
 
419 
		    diag_string ( file, "__unknown" ) ;
 - 
 
420 
		}
 - 
 
421 
		fprintf ( file, ",%ld,", off ) ;
 - 
 
422 
		out_posn ( file, q, 1 ) ;
 - 
 
423 
		fprintf ( file, "%ld,", q->size ) ;
 - 
 
424 
		fp = ftell ( file ) ;
 - 
 
425 
		fprintf ( file, "%s\n", NULL_POSN_STR ) ;
 - 
 
426 
	    }
 - 
 
427 
 
 469 
 
428 
	    /* Round off structure definition */
 470 
		/* Round off structure definition */
429 
	    res->is_lab = 0 ;
 471 
		res->is_lab = 0;
430 
	    res->posn = t ;
 472 
		res->posn = t;
431 
	    break ;
 473 
		break;
432 
	}
 474 
	}
433 
 
 - 
 
434 
	case DIAG_TYPE_UNION : {
 475 
	case DIAG_TYPE_UNION: {
435 
	    shape sha = dt->data.t_union.tdf_shape ;
 476 
		shape sha = dt->data.t_union.tdf_shape;
436 
	    long sz = shape_size ( sha ) ;
 477 
		long sz = shape_size(sha);
437 
	    char *nm = dt->data.t_union.nme.ints.chars ;
 478 
		char *nm = dt->data.t_union.nme.ints.chars;
438 
#if 0
 479 
#if 0
439 
	    union_fields *fld = dt->data.t_union.fields->array ;
 480 
		union_fields *fld = dt->data.t_union.fields->array;
440 
#else
 481 
#else
441 
	    diag_field *fld = dt->data.t_union.fields->array ;
 482 
		diag_field *fld = dt->data.t_union.fields->array;
442 
#endif
 483 
#endif
443 
	    long i, n = ( long ) dt->data.t_union.fields->lastused ;
 484 
		long i, n = (long)dt->data.t_union.fields->lastused;
444 
 
 485 
 
445 
	    /* Initialize union information */
 486 
		/* Initialize union information */
446 
	    long fp ;
 487 
		long fp;
447 
	    posn_t t ;
 488 
		posn_t t;
448 
	    int taglab = 0 ;
 489 
		int taglab = 0;
449 
	    long dlab = diag_lab++ ;
 490 
		long dlab = diag_lab++;
450 
	    char nmbuff [50] ;
 491 
		char nmbuff[50];
451 
	    if ( diag_format == DIAG_XDB_NEW ) {
 492 
		if (diag_format == DIAG_XDB_NEW) {
452 
		if ( *nm == 0 ) {
 493 
			if (*nm == 0) {
453 
		    unsigned u = unique_id () ;
 494 
				unsigned u = unique_id();
454 
		    nm = nmbuff ;
 495 
				nm = nmbuff;
455 
		    sprintf ( nm, "(%u.%ld)", u, dlab ) ;
 496 
				sprintf(nm, "(%u.%ld)", u, dlab);
456 
		}
 497 
			}
457 
		taglab = 1 ;
 498 
			taglab = 1;
458 
	    }
 499 
		}
- 
 
 500 
		if (!taglab) {
459 
	    if ( !taglab ) fprintf ( file, "LD%ld:", dlab ) ;
 501 
			fprintf(file, "LD%ld:", dlab);
- 
 
 502 
		}
460 
	    t = out_dd ( file, xdb_union, loc ) ;
 503 
		t = out_dd(file, xdb_union, loc);
461 
	    fp = ftell ( file ) ;
 504 
		fp = ftell(file);
462 
	    fprintf ( file, "%s,%ld\n", NULL_POSN_STR, sz ) ;
 505 
		fprintf(file, "%s,%ld\n", NULL_POSN_STR, sz);
463 
	    res = new_table_posn ( t, sz ) ;
 506 
		res = new_table_posn(t, sz);
464 
 
 507 
 
465 
	    /* Print tag information */
 508 
		/* Print tag information */
466 
	    if ( *nm ) {
 509 
		if (*nm) {
467 
		posn_t tt ;
 510 
			posn_t tt;
- 
 
 511 
			if (taglab) {
468 
		if ( taglab ) fprintf ( file, "LD%ld:", dlab ) ;
 512 
				fprintf(file, "LD%ld:", dlab);
- 
 
 513 
			}
469 
		tt = out_dd ( file, xdb_tagdef, loc ) ;
 514 
			tt = out_dd(file, xdb_tagdef, loc);
470 
		fprintf ( file, "0," ) ;
 515 
			fprintf(file, "0,");
471 
		if ( diag_format == DIAG_XDB_NEW ) fprintf ( file, "1," ) ;
 516 
			if (diag_format == DIAG_XDB_NEW) {
- 
 
 517 
				fprintf(file, "1,");
- 
 
 518 
			}
472 
		diag_string ( file, nm ) ;
 519 
			diag_string(file, nm);
473 
		fprintf ( file, "," ) ;
 520 
			fprintf(file, ",");
474 
		out_posn ( file, res, 0 ) ;
 521 
			out_posn(file, res, 0);
475 
		if ( taglab ) t = tt ;
 522 
			if (taglab) {
- 
 
 523 
				t = tt;
476 
	    }
 524 
			}
- 
 
 525 
		}
477 
 
 526 
 
478 
	    /* Set up union label */
 527 
		/* Set up union label */
479 
	    res->is_lab = 1 ;
 528 
		res->is_lab = 1;
480 
	    res->posn = ( posn_t ) dlab ;
 529 
		res->posn = (posn_t)dlab;
481 
	    dt->been_outed = ( OUTPUT_REC ) res ;
 530 
		dt->been_outed = (OUTPUT_REC)res;
482 
 
 531 
 
483 
	    /* Deal with union fields */
 532 
		/* Deal with union fields */
484 
	    for ( i = n - 1 ; i >= 0 ; i-- ) {
 533 
		for (i = n - 1; i >= 0; i--) {
485 
		char *fnm = fld [i]->field_name.ints.chars ;
 534 
			char *fnm = fld[i] ->field_name.ints.chars;
486 
		long off = no ( fld [i]->where ) ;
 535 
			long off = no(fld[i] ->where);
487 
		diag_type dtl = fld [i]->field_type ;
 536 
			diag_type dtl = fld[i] ->field_type;
488 
		table_posn *q = analyse_diag_type ( file, dtl, loc ) ;
 537 
			table_posn *q = analyse_diag_type(file, dtl, loc);
489 
		posn_t s = out_dd ( file, xdb_field, loc ) ;
 538 
			posn_t s = out_dd(file, xdb_field, loc);
490 
		fill_gap ( file, fp, s ) ;
 539 
			fill_gap(file, fp, s);
491 
		if ( diag_format == DIAG_XDB_NEW ) fprintf ( file, "0,0," ) ;
 540 
			if (diag_format == DIAG_XDB_NEW) {
- 
 
 541 
				fprintf(file, "0,0,");
- 
 
 542 
			}
492 
		if ( *fnm ) {
 543 
			if (*fnm) {
493 
		    diag_string ( file, fnm ) ;
 544 
				diag_string(file, fnm);
494 
		} else {
 545 
			} else {
495 
		    diag_string ( file, "__unknown" ) ;
 546 
				diag_string(file, "__unknown");
496 
		}
 547 
			}
497 
		fprintf ( file, ",%ld,", off ) ;
 548 
			fprintf(file, ",%ld,", off);
498 
		out_posn ( file, q, 1 ) ;
 549 
			out_posn(file, q, 1);
499 
		fprintf ( file, "%ld,", q->size ) ;
 550 
			fprintf(file, "%ld,", q->size);
500 
		fp = ftell ( file ) ;
 551 
			fp = ftell(file);
501 
		fprintf ( file, "%s\n", NULL_POSN_STR ) ;
 552 
			fprintf(file, "%s\n", NULL_POSN_STR);
502 
	    }
 553 
		}
503 
 
 554 
 
504 
	    /* Round off union definition */
 555 
		/* Round off union definition */
505 
	    res->is_lab = 0 ;
 556 
		res->is_lab = 0;
506 
	    res->posn = t ;
 557 
		res->posn = t;
507 
	    break ;
 558 
		break;
508 
	}
 559 
	}
509 
 
 560 
 
510 
	case DIAG_TYPE_VARIETY : {
 561 
	case DIAG_TYPE_VARIETY: {
511 
	    shape sha = f_integer ( dt->data.var ) ;
 562 
		shape sha = f_integer(dt->data.var);
512 
	    res = analyse_diag_shape ( file, sha ) ;
 563 
		res = analyse_diag_shape(file, sha);
513 
	    break ;
 564 
		break;
514 
	}
 565 
	}
515 
 
 566 
 
516 
	default : {
 567 
	default:
517 
	    res = new_table_posn ( NULL_POSN, L0 ) ;
 568 
		res = new_table_posn(NULL_POSN, L0);
518 
	    break ;
 569 
		break;
519 
	}
 570 
	}
520 
    }
 - 
 
521 
 
 571 
 
522 
    dt->been_outed = ( OUTPUT_REC ) res ;
 572 
	dt->been_outed = (OUTPUT_REC)res;
523 
    return ( res ) ;
 573 
	return (res);
524 
}
 574 
}
525 
 
 575 
 
526 
 
 576 
 
527 
/*
 577 
/*
528 
    DIAGNOSTIC SCOPE STACK
 578 
    DIAGNOSTIC SCOPE STACK
529 
*/
 579 
*/
530 
 
 580 
 
531 
static dscope *dscope_stack = null ;
 581 
static dscope *dscope_stack = null;
532 
static int no_dscope = 0 ;
 582 
static int no_dscope = 0;
533 
static int dscope_stk_size = 0 ;
 583 
static int dscope_stk_size = 0;
534 
 
 584 
 
535 
 
 585 
 
536 
/*
 586 
/*
537 
    PUSH A DIAGNOSTICS SCOPE
 587 
    PUSH A DIAGNOSTICS SCOPE
538 
*/
 588 
*/
539 
 
 589 
 
540 
void push_dscope
 590 
void
541 
    PROTO_N ( ( p, t ) )
 - 
 
542 
    PROTO_T ( posn_t p X int t )
 591 
push_dscope(posn_t p, int t)
543 
{
 592 
{
544 
    int n = no_dscope++ ;
 593 
	int n = no_dscope++;
545 
    if ( n >= dscope_stk_size ) {
 594 
	if (n >= dscope_stk_size) {
546 
	dscope_stk_size += 20 ;
 595 
		dscope_stk_size += 20;
547 
	dscope_stack = realloc_nof ( dscope_stack, dscope, dscope_stk_size ) ;
 596 
		dscope_stack = realloc_nof(dscope_stack, dscope,
- 
 
 597 
					   dscope_stk_size);
548 
    }
 598 
	}
549 
    dscope_stack [n].posn = p ;
 599 
	dscope_stack[n].posn = p;
550 
    dscope_stack [n].dscope_type = t ;
 600 
	dscope_stack[n].dscope_type = t;
551 
    return ;
 601 
	return;
552 
}
 602 
}
553 
 
 603 
 
554 
 
 604 
 
555 
/*
 605 
/*
556 
    POP A DIAGNOSTICS SCOPE
 606 
    POP A DIAGNOSTICS SCOPE
557 
*/
 607 
*/
558 
 
 608 
 
559 
dscope *pop_dscope
 609 
dscope *
560 
    PROTO_Z ()
 610 
pop_dscope(void)
561 
{
 611 
{
562 
    int n = no_dscope ;
 612 
	int n = no_dscope;
- 
 
 613 
	if (n == 0) {
563 
    if ( n == 0 ) return ( null ) ;
 614 
		return (null);
- 
 
 615 
	}
564 
    no_dscope = ( --n ) ;
 616 
	no_dscope = (--n);
565 
    return ( dscope_stack + n ) ;
 617 
	return (dscope_stack + n);
566 
}
 618 
}