WebSVN – tendra.SVN – Blame – /branches/algol60/src/tools/tspec/index.c

Rev	Author	Line No.	Line
2	7u83	1	`/*`
		2	`Crown Copyright (c) 1997`
		3
		4	`This TenDRA(r) Computer Program is subject to Copyright`
		5	`owned by the United Kingdom Secretary of State for Defence`
		6	`acting through the Defence Evaluation and Research Agency`
		7	`(DERA). It is made available to Recipients with a`
		8	`royalty-free licence for its use, reproduction, transfer`
		9	`to other parties and amendment for any purpose not excluding`
		10	`product development provided that any such use et cetera`
		11	`shall be deemed to be acceptance of the following conditions:-`
		12
		13	`(1) Its Recipients shall ensure that this Notice is`
		14	`reproduced upon any copies or amended versions of it;`
		15
		16	`(2) Any amended version of it shall be clearly marked to`
		17	`show both the nature of and the organisation responsible`
		18	`for the relevant amendment or amendments;`
		19
		20	`(3) Its onward transfer from a recipient to another`
		21	`party shall be deemed to be that party's acceptance of`
		22	`these conditions;`
		23
		24	`(4) DERA gives no warranty or assurance as to its`
		25	`quality or suitability for any purpose and DERA accepts`
		26	`no liability whatsoever in relation to any use to which`
		27	`it may be put.`
		28	`*/`
		29
		30
		31	`#include "config.h"`
		32	`#include "object.h"`
		33	`#include "hash.h"`
		34	`#include "name.h"`
		35	`#include "type.h"`
		36	`#include "print.h"`
		37	`#include "utility.h"`
		38
		39
		40	`/*`
		41	`FLAGS`
		42
		43	`These flags are used to indicate various output states indicated by`
		44	`preprocessing directives. A value of 1 is the default (which`
		45	`actually means that the condition is false), 2 means that the given`
		46	`statement is true, and 0 means that its negation is true.`
		47	`*/`
		48
		49	`static int building_libs = 1 ;`
		50	`static int commented_out = 1 ;`
		51
		52
		53	`/*`
		54	`FIELD SEPARATOR`
		55
		56	`The field separator for the machine processable index. This`
		57	`separator can be changed, but no command line option is provided to`
		58	`do this as '$' seems ideal.`
		59	`*/`
		60
		61	`static char field_sep = '$' ;`
		62
		63
		64	`/*`
		65	`PRINT FIELD SEPARATOR`
		66
		67	`Routine to print field separator of the machine processable index.`
		68	`*/`
		69
		70	`#define print_field_sep() IGNORE putchar ( field_sep )`
		71
		72
		73	`/*`
		74	`PRINT FIELD`
		75
		76	`Routine to print field and separator of the machine processable index.`
		77	`*/`
		78
		79	`static void print_field`
		80	`PROTO_N ( ( s ) )`
		81	`PROTO_T ( char *s )`
		82	`{`
		83	`IGNORE printf ( "%s%c", s, field_sep ) ;`
		84	`return ;`
		85	`}`
		86
		87
		88	`/*`
		89	`PRINT ESCAPED FIELD`
		90
		91	`Routine to print field without separator of the machine processable`
		92	`index, escaping characters that could confuse output processing tools.`
		93	`*/`
		94
		95	`static void print_escape`
		96	`PROTO_N ( ( s ) )`
		97	`PROTO_T ( char *s )`
		98	`{`
		99	`int c ;`
		100	`while ( ( c = *s++ ) != '\0' ) {`
		101	`if ( c == field_sep ) {`
		102	`IGNORE printf ( "\\F" ) ;`
		103	`} else if ( c == '\n' ) {`
		104	`IGNORE printf ( "\\n" ) ;`
		105	`} else if ( c == '\\' ) {`
		106	`IGNORE printf ( "\\\\" ) ;`
		107	`} else {`
		108	`IGNORE putchar ( c ) ;`
		109	`}`
		110	`}`
		111	`return ;`
		112	`}`
		113
		114
		115	`/*`
		116	`PRINT VALUE FIELD`
		117
		118	`Routine to print the final value field of the machine processable index.`
		119	`*/`
		120
		121	`static void print_value`
		122	`PROTO_N ( ( s ) )`
		123	`PROTO_T ( char *s )`
		124	`{`
		125	`print_field_sep () ;`
		126	`print_escape ( s ) ;`
		127	`IGNORE putchar ( '\n' ) ;`
		128	`return ;`
		129	`}`
		130
		131
		132	`/*`
		133	`PRINT EMPTY VALUE FIELD`
		134
		135	`Routine to print the final empty value field of the machine processable`
		136	`index.`
		137	`*/`
		138
		139	`static void print_no_value`
		140	`PROTO_Z ()`
		141	`{`
		142	`IGNORE printf ( "%c\n", field_sep ) ;`
		143	`return ;`
		144	`}`
		145
		146
		147	`/*`
		148	`PRINT SORT, INFO AND TYPE FIELDS`
		149
		150	`Routine to print sort, info and type fields of the machine processable`
		151	`index.`
		152	`*/`
		153
		154	`static void print_sit_v`
		155	`PROTO_N ( ( s, i, t, nm ) )`
		156	`PROTO_T ( char s X char i X type t X char nm )`
		157	`{`
		158	`IGNORE printf ( "%s%c%s%c", s, field_sep, i, field_sep ) ;`
		159	`IGNORE print_type ( stdout, t, nm, 0 ) ;`
		160	`return ;`
		161	`}`
		162
		163
		164	`/*`
		165	`PRINT SORT AND TYPE FIELDS`
		166
		167	`Routine to print sort, empty info, and type fields of the machine`
		168	`processable index.`
		169	`*/`
		170
		171	`static void print_st_v`
		172	`PROTO_N ( ( s, t, nm ) )`
		173	`PROTO_T ( char s X type t X char *nm )`
		174	`{`
		175	`print_sit_v ( s, "", t, nm ) ;`
		176	`return ;`
		177	`}`
		178
		179
		180	`/*`
		181	`PRINT SORT AND INFO FIELDS`
		182
		183	`Routine to print sort, info, and empty type fields of the machine`
		184	`processable index.`
		185	`*/`
		186
		187	`static void print_si_v`
		188	`PROTO_N ( ( s, i ) )`
		189	`PROTO_T ( char s X char i )`
		190	`{`
		191	`IGNORE printf ( "%s%c%s%c", s, field_sep, i, field_sep ) ;`
		192	`return ;`
		193	`}`
		194
		195
		196	`/*`
		197	`PRINT SORT FIELD`
		198
		199	`Routine to print sort, empty info, and empty type fields of the`
		200	`machine processable index.`
		201	`*/`
		202
		203	`static void print_s_v`
		204	`PROTO_N ( ( s ) )`
		205	`PROTO_T ( char *s )`
		206	`{`
		207	`IGNORE printf ( "%s%c%c", s, field_sep, field_sep ) ;`
		208	`return ;`
		209	`}`
		210
		211
		212	`/*`
		213	`PRINT SORT, INFO, TYPE AND EMPTY VALUE FIELDS`
		214
		215	`Routine to print sort, info, type and empty value fields of the`
		216	`machine processable index.`
		217	`*/`
		218
		219	`static void print_sit`
		220	`PROTO_N ( ( s, i, t, nm ) )`
		221	`PROTO_T ( char s X char i X type t X char nm )`
		222	`{`
		223	`print_sit_v ( s, i, t, nm ) ;`
		224	`print_no_value () ;`
		225	`return ;`
		226	`}`
		227
		228
		229	`/*`
		230	`PRINT SORT, TYPE AND EMPTY VALUE FIELDS`
		231
		232	`Routine to print sort, empty info, type and empty value fields of the`
		233	`machine processable index.`
		234	`*/`
		235
		236	`static void print_st`
		237	`PROTO_N ( ( s, t, nm ) )`
		238	`PROTO_T ( char s X type t X char *nm )`
		239	`{`
		240	`print_st_v ( s, t, nm ) ;`
		241	`print_no_value () ;`
		242	`return ;`
		243	`}`
		244
		245
		246	`/*`
		247	`PRINT SORT, INFO AND EMPTY VALUE FIELDS`
		248
		249	`Routine to print sort, info, empty type and empty value fields of the`
		250	`machine processable index.`
		251	`*/`
		252
		253	`static void print_si`
		254	`PROTO_N ( ( s, i ) )`
		255	`PROTO_T ( char s X char i )`
		256	`{`
		257	`print_si_v ( s, i ) ;`
		258	`print_no_value () ;`
		259	`return ;`
		260	`}`
		261
		262
		263	`/*`
		264	`PRINT SORT AND EMPTY VALUE FIELDS`
		265
		266	`Routine to print sort, empty info, empty type and empty value fields`
		267	`of the machine processable index.`
		268	`*/`
		269
		270	`static void print_s`
		271	`PROTO_N ( ( s ) )`
		272	`PROTO_T ( char *s )`
		273	`{`
		274	`print_s_v ( s ) ;`
		275	`print_no_value () ;`
		276	`return ;`
		277	`}`
		278
		279
		280	`/*`
		281	`IF STACK STATE`
		282
		283	`This stack is used to keep track of the current +IF conditions.`
		284	`*/`
		285
		286	`static object **if_stack = 0 ;`
		287	`static int if_stack_sz = 0 ;`
		288	`static int if_stack_index = 0 ;`
		289
		290
		291	`/*`
		292	`STACK AN IF COMMAND OBJECT`
		293
		294	`Routine to stack an object representing +IFxxx or +ELSE.`
		295	`*/`
		296
		297	`static void stack_if`
		298	`PROTO_N ( ( p ) )`
		299	`PROTO_T ( object *p )`
		300	`{`
		301	`if ( if_stack_index == if_stack_sz ) {`
		302	`if_stack_sz += 16 ;`
		303	`if_stack = realloc_nof ( if_stack, object *, if_stack_sz ) ;`
		304	`}`
		305	`if_stack [ if_stack_index ] = p ;`
		306	`if_stack_index++ ;`
		307	`return ;`
		308	`}`
		309
		310
		311	`/*`
		312	`UNSTACK AN IF COMMAND OBJECT`
		313
		314	`Routine to unstack an object representing +IFxxx or +ELSE.`
		315	`*/`
		316
		317	`static object *unstack_if`
		318	`PROTO_Z ()`
		319	`{`
		320	`return ( if_stack [ --if_stack_index ] ) ;`
		321	`}`
		322
		323
		324	`/*`
		325	`PRINT IF NESTING`
		326
		327	`Routine to print the currently stacked +IFxxx and +ELSE nesting.`
		328	`*/`
		329
		330	`static void print_if_nest`
		331	`PROTO_Z ()`
		332	`{`
		333	`int i ;`
		334	`for ( i = 0 ; i < if_stack_index ; i++ ) {`
		335	`char code ;`
		336	`object *p = if_stack [ i ] ;`
		337	`char *c = p->name ;`
		338
		339	`if ( i > 0 ) print_escape ( ";" ) ;`
		340	`if ( i + 1 < if_stack_index &&`
		341	`if_stack [ i + 1 ]->u.u_num == CMD_ELSE ) {`
		342	`IGNORE printf ( "e" ) ;`
		343	`i++ ;`
		344	`}`
		345	`switch ( p->u.u_num ) EXHAUSTIVE {`
		346	`case CMD_IF : code = 'i' ; break ;`
		347	`case CMD_IFDEF : code = 'd' ; break ;`
		348	`case CMD_IFNDEF : code = 'n' ; break ;`
		349	`}`
		350	`IGNORE printf ( "%c", code ) ;`
		351	`print_escape ( ":" ) ;`
		352	`print_escape ( c ) ;`
		353	`}`
		354	`return ;`
		355	`}`
		356
		357
		358	`/*`
		359	`PRINT A MACHINE PROCESSABLE ITEM INDEX`
		360
		361	`This routine prints the index item indicated by the token object p.`
		362	`u gives the token status, a the current file name, and e is used in`
		363	`enumeration items. The output is in fields suitable for machine`
		364	`processing by tools such as 'awk'.`
		365	`*/`
		366
		367	`static void print_item_m`
		368	`PROTO_N ( ( p, u, a, e ) )`
		369	`PROTO_T ( object p X char u X char a X type e )`
		370	`{`
		371	`char *nm ;`
		372	`char *ap ;`
		373	`char *tnm = p->name ;`
		374	`object *q = p->u.u_obj ;`
		375
		376	`if ( q->objtype == OBJ_FIELD ) {`
		377	`nm = q->u.u_field->fname ;`
		378	`} else {`
		379	`nm = q->name ;`
		380	`}`
		381
		382	`/* Field 1: C_SYMBOL */`
		383	`print_field ( nm ) ;`
		384
		385	`/* Field 2: TOKEN */`
		386	`print_field ( tnm ) ;`
		387
		388	`/* Field 3: STATUS */`
		389	`IGNORE printf ( "%c%c", u [ 0 ], field_sep ) ;`
		390
		391	`/* Field 4: IF_NESTING */`
		392	`print_if_nest () ;`
		393	`print_field_sep () ;`
		394
		395	`/* Field 5: API_LOCATION */`
		396	`for ( ap = a ; ap && ap != ':' ; ap++ ) IGNORE putchar ( *ap ) ;`
		397	`print_field_sep () ;`
		398
		399	`/* Field 6: FILE_LOCATION */`
		400	`if ( *ap ) ap++ ;`
		401	`for ( ; ap && ap != ':' ; ap++ ) IGNORE putchar ( *ap ) ;`
		402	`print_field_sep () ;`
		403
		404	`/* Field 7: LINE_LOCATION */`
		405	`IGNORE printf ( "%d%c", q->line_no, field_sep ) ;`
		406
		407	`/* Field 8: SUBSET_NESTING */`
		408	`if ( *ap ) IGNORE printf ( "%s", ap + 1 ) ;`
		409	`print_field_sep () ;`
		410
		411	`/* Fields 9-12: SORT, INFO, TYPE, VALUE */`
		412	`switch ( q->objtype ) {`
		413
		414	`case OBJ_CONST : {`
		415	`print_st ( "const", q->u.u_type, null_str ) ;`
		416	`break ;`
		417	`}`
		418
		419	`case OBJ_ENUMVAL : {`
		420	`print_field ( "enum_member" ) ;`
		421	`print_type ( stdout, e, null_str, 0 ) ;`
		422	`print_field_sep () ;`
		423	`if ( q->u.u_str ) {`
		424	`print_value ( q->u.u_str ) ;`
		425	`} else {`
		426	`print_no_value () ;`
		427	`}`
		428	`break ;`
		429	`}`
		430
		431	`case OBJ_EXP : {`
		432	`type *t = q->u.u_type ;`
		433	`char *s = ( t->id == TYPE_LVALUE ? "lvalue" : "rvalue" ) ;`
		434	`print_st ( s, t, null_str ) ;`
		435	`break ;`
		436	`}`
		437
		438	`case OBJ_EXTERN : {`
		439	`type *t = q->u.u_type ;`
		440	`if ( t->id == TYPE_LVALUE ) t = t->u.subtype ;`
		441	`if ( t->id == TYPE_PROC ) {`
		442	`print_sit ( "func", "extern", t, nm ) ;`
		443	`} else {`
		444	`print_st ( "extern", t, null_str ) ;`
		445	`}`
		446	`break ;`
		447	`}`
		448
		449	`case OBJ_WEAK : {`
		450	`type *t = q->u.u_type ;`
		451	`print_sit ( "func", "weak", t, nm ) ;`
		452	`break ;`
		453	`}`
		454
		455	`case OBJ_DEFINE : {`
		456	`char *s = q->u.u_str ;`
		457	`if ( *s == '(' ) {`
		458	`print_field ( "define" ) ;`
		459	`print_field ( "param" ) ;`
		460	`for ( ; s && s != ')' ; s++ ) {`
		461	`IGNORE putchar ( *s ) ;`
		462	`}`
		463	`if ( *s == ')' ) s++ ;`
		464	`IGNORE printf ( ")" ) ;`
		465	`} else {`
		466	`print_s_v ( "define" ) ;`
		467	`}`
		468	`while ( *s == ' ' ) s++ ;`
		469	`print_value ( s ) ;`
		470	`break ;`
		471	`}`
		472
		473	`case OBJ_FIELD : {`
		474	`field *f = q->u.u_field ;`
		475	`print_field ( "member" ) ;`
		476	`print_type ( stdout, f->stype, null_str, 0 ) ;`
		477	`print_field_sep () ;`
		478	`print_type ( stdout, f->ftype, null_str, 0 ) ;`
		479	`print_no_value () ;`
		480	`break ;`
		481	`}`
		482
		483	`case OBJ_FUNC : {`
		484	`print_st ( "func", q->u.u_type, nm ) ;`
		485	`break ;`
		486	`}`
		487
		488	`case OBJ_MACRO : {`
		489	`print_st ( "macro", q->u.u_type, nm ) ;`
		490	`break ;`
		491	`}`
		492
		493	`case OBJ_NAT : {`
		494	`print_s ( "nat" ) ;`
		495	`break ;`
		496	`}`
		497
		498	`case OBJ_STATEMENT : {`
		499	`type *t = q->u.u_type ;`
		500	`if ( t ) {`
		501	`print_sit ( "statement", "param", t, null_str ) ;`
		502	`} else {`
		503	`print_s ( "statement" ) ;`
		504	`}`
		505	`break ;`
		506	`}`
		507
		508	`case OBJ_TOKEN : {`
		509	`print_s_v ( "token" ) ;`
		510	`print_value ( q->u.u_str ) ;`
		511	`break ;`
		512	`}`
		513
		514	`case OBJ_TYPE : {`
		515	`type *t = q->u.u_type ;`
		516	`int i = t->id ;`
		517	`switch ( i ) {`
		518
		519	`case TYPE_DEFINED : {`
		520	`print_st ( "typedef", t->v.next, null_str ) ;`
		521	`break ;`
		522	`}`
		523
		524	`case TYPE_GENERIC : {`
		525	`print_s ( "opaque" ) ;`
		526	`break ;`
		527	`}`
		528
		529	`case TYPE_INT : {`
		530	`print_s ( "integral" ) ;`
		531	`break ;`
		532	`}`
		533
		534	`case TYPE_SIGNED : {`
		535	`print_s ( "signed_integral" ) ;`
		536	`break ;`
		537	`}`
		538
		539	`case TYPE_UNSIGNED : {`
		540	`print_s ( "unsigned_integral" ) ;`
		541	`break ;`
		542	`}`
		543
		544	`case TYPE_PROMOTE : {`
		545	`print_field ( "promotion" ) ;`
		546	`print_type ( stdout, t->v.next, null_str, 0 ) ;`
		547	`print_field_sep () ;`
		548	`print_no_value () ;`
		549	`break ;`
		550	`}`
		551
		552	`case TYPE_FLOAT : {`
		553	`print_s ( "floating" ) ;`
		554	`break ;`
		555	`}`
		556
		557	`case TYPE_ARITH : {`
		558	`print_s ( "arithmetic" ) ;`
		559	`break ;`
		560	`}`
		561
		562	`case TYPE_SCALAR : {`
		563	`print_s ( "scalar" ) ;`
		564	`break ;`
		565	`}`
		566
		567	`case TYPE_STRUCT :`
		568	`case TYPE_STRUCT_TAG :`
		569	`case TYPE_UNION :`
		570	`case TYPE_UNION_TAG :`
		571	`case TYPE_ENUM :`
		572	`case TYPE_ENUM_TAG : {`
		573	`char *s ;`
		574	`type *en = null ;`
		575	`object *r = t->v.obj2 ;`
		576	`char *inf = ( r ? "exact" : "" ) ;`
		577	`switch ( i ) EXHAUSTIVE {`
		578	`case TYPE_STRUCT : s = "struct" ; break ;`
		579	`case TYPE_STRUCT_TAG : s = "struct_tag" ; break ;`
		580	`case TYPE_UNION : s = "union" ; break ;`
		581	`case TYPE_UNION_TAG : s = "union_tag" ; break ;`
		582	`case TYPE_ENUM : s = "enum" ; en = t ; break ;`
		583	`case TYPE_ENUM_TAG : s = "enum_tag" ; en = t ; break ;`
		584	`}`
		585	`print_si ( s, inf ) ;`
		586	`while ( r ) {`
		587	`print_item_m ( r, u, a, en ) ;`
		588	`r = r->next ;`
		589	`}`
		590	`break ;`
		591	`}`
		592
		593	`default : {`
		594	`error ( ERR_INTERNAL, "Unknown type identifier, '%d'", i ) ;`
		595	`break ;`
		596	`}`
		597	`}`
		598	`break ;`
		599	`}`
		600
		601	`default : {`
		602	`error ( ERR_INTERNAL, "Unknown object type, '%d'", q->objtype ) ;`
		603	`break ;`
		604	`}`
		605	`}`
		606	`return ;`
		607	`}`
		608
		609
		610	`/*`
		611	`PRINT AN INDEX ITEM`
		612
		613	`This routine prints the index item indicated by the token object p.`
		614	`u gives the token status, a the current file name, and e is used in`
		615	`enumeration items. The output is in a humun readable format.`
		616	`*/`
		617
		618	`static void print_item_h`
		619	`PROTO_N ( ( p, u, a, e ) )`
		620	`PROTO_T ( object p X char u X char a X type e )`
		621	`{`
		622	`char *tnm = p->name ;`
		623	`object *q = p->u.u_obj ;`
		624	`char *nm = q->name ;`
		625	`IGNORE printf ( "TOKEN: %s\n", tnm ) ;`
		626	`IGNORE printf ( "STATUS: %s", u ) ;`
		627	`if ( building_libs == 0 ) IGNORE printf ( " (not library building)" ) ;`
		628	`if ( building_libs == 2 ) IGNORE printf ( " (library building only)" ) ;`
		629	`IGNORE printf ( "\nDEFINED: %s, line %d\n", a, q->line_no ) ;`
		630	`IGNORE printf ( "INFO: " ) ;`
		631	`if ( commented_out == 2 ) IGNORE printf ( "(commented out) " ) ;`
		632
		633	`switch ( q->objtype ) {`
		634
		635	`case OBJ_CONST : {`
		636	`IGNORE printf ( "%s is a constant expression of type ", nm ) ;`
		637	`print_type ( stdout, q->u.u_type, null_str, 0 ) ;`
		638	`IGNORE printf ( "\n\n" ) ;`
		639	`break ;`
		640	`}`
		641
		642	`case OBJ_ENUMVAL : {`
		643	`IGNORE printf ( "%s is a member of the enumeration type ", nm ) ;`
		644	`print_type ( stdout, e, null_str, 0 ) ;`
		645	`IGNORE printf ( "\n\n" ) ;`
		646	`break ;`
		647	`}`
		648
		649	`case OBJ_EXP : {`
		650	`IGNORE printf ( "%s is an expression of type ", nm ) ;`
		651	`print_type ( stdout, q->u.u_type, null_str, 0 ) ;`
		652	`IGNORE printf ( "\n\n" ) ;`
		653	`break ;`
		654	`}`
		655
		656	`case OBJ_EXTERN : {`
		657	`type *t = q->u.u_type ;`
		658	`if ( t->id == TYPE_LVALUE ) t = t->u.subtype ;`
		659	`IGNORE printf ( "%s is an external ", nm ) ;`
		660	`if ( t->id == TYPE_PROC ) {`
		661	`IGNORE printf ( "function with prototype " ) ;`
		662	`print_type ( stdout, t, nm, 0 ) ;`
		663	`} else {`
		664	`IGNORE printf ( "expression with type " ) ;`
		665	`print_type ( stdout, t, null_str, 0 ) ;`
		666	`}`
		667	`IGNORE printf ( "\n\n" ) ;`
		668	`break ;`
		669	`}`
		670
		671	`case OBJ_WEAK : {`
		672	`type *t = q->u.u_type ;`
		673	`IGNORE printf ( "%s is an external ", nm ) ;`
		674	`IGNORE printf ( "function with weak prototype " ) ;`
		675	`print_type ( stdout, t, nm, 0 ) ;`
		676	`IGNORE printf ( "\n\n" ) ;`
		677	`break ;`
		678	`}`
		679
		680	`case OBJ_DEFINE : {`
		681	`char *s = q->u.u_str ;`
		682	`IGNORE printf ( "%s is a macro ", nm ) ;`
		683	`if ( *s == '(' ) {`
		684	`IGNORE printf ( "with arguments " ) ;`
		685	`for ( ; s && s != ')' ; s++ ) {`
		686	`IGNORE putchar ( *s ) ;`
		687	`}`
		688	`if ( *s == ')' ) s++ ;`
		689	`IGNORE printf ( ") " ) ;`
		690	`}`
		691	`while ( *s == ' ' ) s++ ;`
		692	`IGNORE printf ( "defined to be %s\n\n", s ) ;`
		693	`break ;`
		694	`}`
		695
		696	`case OBJ_FIELD : {`
		697	`field *f = q->u.u_field ;`
		698	`IGNORE printf ( "%s is a field selector of ", f->fname ) ;`
		699	`print_type ( stdout, f->stype, null_str, 0 ) ;`
		700	`IGNORE printf ( " of type " ) ;`
		701	`print_type ( stdout, f->ftype, null_str, 0 ) ;`
		702	`IGNORE printf ( "\n\n" ) ;`
		703	`break ;`
		704	`}`
		705
		706	`case OBJ_FUNC : {`
		707	`IGNORE printf ( "%s is a function with prototype ", nm ) ;`
		708	`print_type ( stdout, q->u.u_type, nm, 0 ) ;`
		709	`IGNORE printf ( "\n\n" ) ;`
		710	`break ;`
		711	`}`
		712
		713	`case OBJ_MACRO : {`
		714	`IGNORE printf ( "%s is a macro with prototype ", nm ) ;`
		715	`print_type ( stdout, q->u.u_type, nm, 0 ) ;`
		716	`IGNORE printf ( "\n\n" ) ;`
		717	`break ;`
		718	`}`
		719
		720	`case OBJ_NAT : {`
		721	`IGNORE printf ( "%s is a constant integer\n\n", nm ) ;`
		722	`break ;`
		723	`}`
		724
		725	`case OBJ_STATEMENT : {`
		726	`type *t = q->u.u_type ;`
		727	`IGNORE printf ( "%s is a statement", nm ) ;`
		728	`if ( t ) {`
		729	`IGNORE printf ( " with arguments" ) ;`
		730	`print_type ( stdout, t, null_str, 0 ) ;`
		731	`}`
		732	`IGNORE printf ( "\n\n" ) ;`
		733	`break ;`
		734	`}`
		735
		736	`case OBJ_TOKEN : {`
		737	`IGNORE printf ( "%s is a complex token\n\n", nm ) ;`
		738	`break ;`
		739	`}`
		740
		741	`case OBJ_TYPE : {`
		742	`type *t = q->u.u_type ;`
		743	`int i = t->id ;`
		744	`print_type ( stdout, t, null_str, 0 ) ;`
		745	`switch ( i ) {`
		746
		747	`case TYPE_DEFINED : {`
		748	`IGNORE printf ( " is a type defined to be " ) ;`
		749	`print_type ( stdout, t->v.next, null_str, 0 ) ;`
		750	`IGNORE printf ( "\n\n" ) ;`
		751	`break ;`
		752	`}`
		753
		754	`case TYPE_GENERIC : {`
		755	`IGNORE printf ( " is a type\n\n" ) ;`
		756	`break ;`
		757	`}`
		758
		759	`case TYPE_INT : {`
		760	`IGNORE printf ( " is an integral type\n\n" ) ;`
		761	`break ;`
		762	`}`
		763
		764	`case TYPE_SIGNED : {`
		765	`IGNORE printf ( " is a signed integral type\n\n" ) ;`
		766	`break ;`
		767	`}`
		768
		769	`case TYPE_UNSIGNED : {`
		770	`IGNORE printf ( " is an unsigned integral type\n\n" ) ;`
		771	`break ;`
		772	`}`
		773
		774	`case TYPE_PROMOTE : {`
		775	`IGNORE printf ( " is the integral promotion of " ) ;`
		776	`print_type ( stdout, t->v.next, null_str, 0 ) ;`
		777	`IGNORE printf ( "\n\n" ) ;`
		778	`break ;`
		779	`}`
		780
		781	`case TYPE_FLOAT : {`
		782	`IGNORE printf ( " is a floating type\n\n" ) ;`
		783	`break ;`
		784	`}`
		785
		786	`case TYPE_ARITH : {`
		787	`IGNORE printf ( " is an arithmetic type\n\n" ) ;`
		788	`break ;`
		789	`}`
		790
		791	`case TYPE_SCALAR : {`
		792	`IGNORE printf ( " is a scalar type\n\n" ) ;`
		793	`break ;`
		794	`}`
		795
		796	`case TYPE_STRUCT :`
		797	`case TYPE_STRUCT_TAG :`
		798	`case TYPE_UNION :`
		799	`case TYPE_UNION_TAG : {`
		800	`char *n ;`
		801	`object *r = t->v.obj2 ;`
		802	`switch ( i ) EXHAUSTIVE {`
		803	`case TYPE_STRUCT : n = "structure" ; break ;`
		804	`case TYPE_STRUCT_TAG : n = "structure" ; break ;`
		805	`case TYPE_UNION : n = "union" ; break ;`
		806	`case TYPE_UNION_TAG : n = "union" ; break ;`
		807	`}`
		808	`if ( r == null ) {`
		809	`IGNORE printf ( " is an inexact %s type\n\n", n ) ;`
		810	`} else {`
		811	`IGNORE printf ( " is an exact %s type\n\n", n ) ;`
		812	`while ( r ) {`
		813	`print_item_h ( r, u, a, ( type * ) null ) ;`
		814	`r = r->next ;`
		815	`}`
		816	`}`
		817	`break ;`
		818	`}`
		819
		820	`case TYPE_ENUM :`
		821	`case TYPE_ENUM_TAG : {`
		822	`object *r = t->v.obj2 ;`
		823	`IGNORE printf ( " is an enumeration type\n\n" ) ;`
		824	`while ( r ) {`
		825	`print_item_h ( r, u, a, t ) ;`
		826	`r = r->next ;`
		827	`}`
		828	`break ;`
		829	`}`
		830
		831	`default : {`
		832	`IGNORE printf ( " is a type\n\n" ) ;`
		833	`error ( ERR_INTERNAL, "Unknown type identifier, '%d'", i ) ;`
		834	`break ;`
		835	`}`
		836	`}`
		837	`break ;`
		838	`}`
		839
		840	`default : {`
		841	`error ( ERR_INTERNAL, "Unknown object type, '%d'", q->objtype ) ;`
		842	`break ;`
		843	`}`
		844	`}`
		845	`return ;`
		846	`}`
		847
		848
		849	`/*`
		850	`PRINT INDEX USING PRINT ITEM FUNCTION`
		851
		852	`This routine prints an index of the set object input using fn.`
		853	`*/`
		854
		855	`typedef void ( index_func ) PROTO_S ( ( object , char , char , type * ) ) ;`
		856
		857	`static void print_index_with`
		858	`PROTO_N ( ( input, fn ) )`
		859	`PROTO_T ( object *input X index_func fn )`
		860	`{`
		861	`object *p = input->u.u_obj ;`
		862	`info *i = p->u.u_info ;`
		863	`char *a = p->name ;`
		864	`char *u = ( i->implemented ? "implemented" : "used" ) ;`
		865	`for ( p = i->elements ; p != null ; p = p->next ) {`
		866	`switch ( p->objtype ) {`
		867
		868	`case OBJ_IF : {`
		869	`/* Deal with preprocessing directives */`
		870	`char *c = p->name ;`
		871	`if ( fn == print_item_m ) {`
		872	`switch ( p->u.u_num ) {`
		873	`case CMD_IF :`
		874	`case CMD_IFDEF :`
		875	`case CMD_IFNDEF :`
		876	`case CMD_ELSE : {`
		877	`stack_if ( p ) ;`
		878	`break ;`
		879	`}`
		880	`case CMD_ENDIF : {`
		881	`if ( unstack_if ()->u.u_num == CMD_ELSE ) {`
		882	`IGNORE unstack_if () ;`
		883	`}`
		884	`break ;`
		885	`}`
		886	`}`
		887	`} else if ( streq ( c, BUILDING_MACRO ) ) {`
		888	`/* Check for the building_libs macro */`
		889	`switch ( p->u.u_num ) {`
		890	`case CMD_IF :`
		891	`case CMD_IFDEF : {`
		892	`building_libs = 2 ;`
		893	`break ;`
		894	`}`
		895	`case CMD_IFNDEF : {`
		896	`building_libs = 0 ;`
		897	`break ;`
		898	`}`
		899	`case CMD_ELSE : {`
		900	`building_libs = 2 - building_libs ;`
		901	`break ;`
		902	`}`
		903	`case CMD_ENDIF : {`
		904	`building_libs = 1 ;`
		905	`break ;`
		906	`}`
		907	`}`
		908	`} else {`
		909	`/* Check for integers */`
		910	`int n = 0 ;`
		911	`while ( *c == '-' ) c++ ;`
		912	`while ( c >= '0' && c <= '9' ) {`
		913	`n = 10 * n + ( *c - '0' ) ;`
		914	`c++ ;`
		915	`}`
		916	`if ( *c == 0 ) {`
		917	`switch ( p->u.u_num ) {`
		918	`case CMD_IF : {`
		919	`commented_out = ( n ? 0 : 2 ) ;`
		920	`break ;`
		921	`}`
		922	`case CMD_ELSE : {`
		923	`commented_out = 2 - commented_out ;`
		924	`break ;`
		925	`}`
		926	`case CMD_ENDIF : {`
		927	`commented_out = 1 ;`
		928	`break ;`
		929	`}`
		930	`}`
		931	`}`
		932	`}`
		933	`break ;`
		934	`}`
		935
		936	`case OBJ_SET : {`
		937	`/* Deal with subsets */`
		938	`print_index_with ( p, fn ) ;`
		939	`break ;`
		940	`}`
		941
		942	`case OBJ_TOKEN : {`
		943	`/* Deal with tokens */`
		944	`if ( i->implemented \|\| !restrict_use ) {`
		945	`( fn ) ( p, u, a, ( type ) null ) ;`
		946	`}`
		947	`break ;`
		948	`}`
		949	`}`
		950	`}`
		951	`return ;`
		952	`}`
		953
		954
		955	`/*`
		956	`PRINT MACHINE PROCESSABLE INDEX`
		957
		958	`This routine prints an index intended for machine processing of the`
		959	`set object input.`
		960	`*/`
		961
		962	`void print_machine_index`
		963	`PROTO_N ( ( input ) )`
		964	`PROTO_T ( object *input )`
		965	`{`
		966	`print_index_with ( input, print_item_m ) ;`
		967	`return ;`
		968	`}`
		969
		970
		971	`/*`
		972	`PRINT INDEX`
		973
		974	`This routine prints an index intended for human readers of the set`
		975	`object input.`
		976	`*/`
		977
		978	`void print_index`
		979	`PROTO_N ( ( input ) )`
		980	`PROTO_T ( object *input )`
		981	`{`
		982	`print_index_with ( input, print_item_h ) ;`
		983	`return ;`
		984	`}`

Subversion Repositories tendra.SVN

(root)/branches/algol60/src/tools/tspec/index.c – Rev 2