m2decs.c 15.7 KB
Newer Older
dcw's avatar
dcw committed
1
2
3
4
/* Generate data declarations in Modula-2 */


#include <dcw.h>
dcw's avatar
dcw committed
5
#include <string.h>
dcw's avatar
dcw committed
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
#include "struct.h"
#include "decs.h"


/*
/^#ifdef HASPROTOS
!/endif$
stat %
*/

#ifdef HASPROTOS
static void line( char * , long , long , long , long );
static void defn_declns( char * , char * , declnlist );
static void defn_onetype( decln );
static void impln_declns( char * , char * , declnlist );
static void impln_onetype( decln );
static void variantfields( decln );
static void normalfields( decln );
static void consproc_header( char * , shape );
static void consproc_body( decln , shape );
static void deconskind_header( char * );
static void deconskind_body( decln );
static void deconskind_inner( decln );
static void deconsproc_header( char * , shape );
static void deconsproc_body( decln , shape );
31
32
33
34
static void writeproc_header( char * );
static void writeproc_body( decln );
static void write_using_case( char * , char * , shapelist );
static void write_all_params( char * , shape );
dcw's avatar
dcw committed
35
36
37
static void write_default_printlist( shape );
static void write_printlist( shape , char * );
static void write_param( char * , param );
38
static void outstring( char * );
dcw's avatar
dcw committed
39
40
static void write_bool( void );
static char * lookup_type( char * );
41
static char * lookup_write_proc( char * );
dcw's avatar
dcw committed
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
static int predefined_type( char * );
#else
static void line();
static void defn_declns();
static void defn_onetype();
static void impln_declns();
static void impln_onetype();
static void variantfields();
static void normalfields();
static void consproc_header();
static void consproc_body();
static void deconskind_header();
static void deconskind_body();
static void deconskind_inner();
static void deconsproc_header();
static void deconsproc_body();
58
59
60
61
static void writeproc_header();
static void writeproc_body();
static void write_using_case();
static void write_all_params();
dcw's avatar
dcw committed
62
63
64
static void write_default_printlist();
static void write_printlist();
static void write_param();
65
static void outstring();
dcw's avatar
dcw committed
66
67
static void write_bool();
static char * lookup_type();
68
static char * lookup_write_proc();
dcw's avatar
dcw committed
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
static int predefined_type();
#endif


static int numtabs = 0;
static FILE *outfile;


/* ------------------------- PUBLIC PROCEDURES --------------------------- */


void make_declns( exports, globals, d, basename ) declnlist d; char *exports, *globals, *basename;
{
	printf( "m2datadec: Making data declarations in %s.{def,mod}\n",
		basename );

	defn_declns( exports, basename, d );

	impln_declns( globals, basename, d );
}


/* ------------------------- PRIVATE PROCEDURES -------------------------- */


#define indent() numtabs++
#define outdent() numtabs--

#define nl()	   fputc( '\n', outfile )
#define usefile(f) outfile = f, numtabs = 0


/*VARARGS*/
static void line( fmt, a, b, c, d ) char *fmt; long a, b, c, d;
{
	int i;

	for( i=numtabs; i; i-- ) fputc( '\t', outfile );
	fprintf( outfile, fmt, a, b, c, d );
	nl();
}


/* ------------------------- Definition module --------------------------- */


static void defn_declns( exports, modulename, decs ) char *exports, *modulename; declnlist decs;
{
	FILE		*defnfile;
        char		tempname[256];
	declnlist	d;

        sprintf( tempname, "%s.def", modulename );
        defnfile = fopen( tempname, "w" );
        ASSERT( defnfile != NULL, ("m2datadec: can't create '%s'\n",tempname) );

	usefile( defnfile );

	line( "DEFINITION MODULE %s ;", modulename );
	nl();
	line( "(*" );
	line( " * Automatically Generated by M2DataDec" );
	line( " *)" );
	nl();
	nl();
	line( "FROM FIO IMPORT File;" );
	nl();
	nl();

	if( *exports != '\0' )
	{
		line( "(* Contents of EXPORT section *)" );
		line( exports );
		nl();
	}

	line( "(* Types - declared forward *)" );
	nl();
	line( "TYPE" );
	indent();
	for( d = decs; d != NULL; d=d->next )
	{
		if( d->Struct )
		{
153
			line( "%s;", d->name );
dcw's avatar
dcw committed
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
		} else
		{
			line( "%s\t= INTEGER;", d->name );
		}
	}
	outdent();
	nl();

	for( d = decs; d != NULL; d=d->next )
	{
		defn_onetype( d );
	}
	line( "END %s.", modulename );
	nl();
	fclose( defnfile );
}


static void defn_onetype( d ) decln d;
{
	shapelist	s;
175
	BOOL		first;
dcw's avatar
dcw committed
176
177
178
179
180
181
182
183
184
185
186
187
188

	line( "(* ----------- Type %s ----------- *)", d->name );
	nl();

	line( "(* Constructor functions for %s *)", d->name );
	for( s = d->shapes; s != NULL; s = s->next )
	{
		consproc_header( d->name, s );
	}
	nl();

	if( d->Defines )
	{
189
190
191
192
		line( "(* Kind of %s *)", d->name );
		line( "TYPE" );
		fprintf( outfile, "\tKindOf%s = ( ", d->name );
		first = TRUE;
dcw's avatar
dcw committed
193
194
		for( s = d->shapes; s; s=s->next )
		{
195
196
197
			if( !first ) fputs( ", ", outfile );
			fprintf( outfile, "%sIs%s", d->name, s->name );
			first = FALSE;
dcw's avatar
dcw committed
198
		}
199
		fprintf( outfile, " );\n" );
dcw's avatar
dcw committed
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
		nl();
		line( "(* Deconstructor kind function for %s *)",
			d->name );
		deconskind_header( d->name );
		nl();
	}

	if( d->Struct )
	{
		line( "(* Deconstructor functions for %s *)", d->name );

		for( s = d->shapes; s != NULL; s = s->next )
		{
			if( s->params != NULL )
			{
				deconsproc_header( d->name, s );
			}
		}
		nl();
	}

221
222
	line( "(* write function for %s *)", d->name );
	writeproc_header( d->name );
223
	nl();
dcw's avatar
dcw committed
224
225
226
227
228
229
230
	nl();
}


/* ----------------------- Implementation module ------------------------- */


231
static void impln_declns( globals, modulename, decs ) char *globals, *modulename; declnlist decs;
dcw's avatar
dcw committed
232
233
234
{
	FILE		*implnfile;
        char		tempname[256];
235
	declnlist	d;
dcw's avatar
dcw committed
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253

        sprintf( tempname, "%s.mod", modulename );
        implnfile = fopen( tempname, "w" );
        ASSERT( implnfile!=NULL, ("m2datadec: can't create '%s'\n",tempname) );

	usefile( implnfile );

	line( "IMPLEMENTATION MODULE %s ;", modulename );
	nl();
	line( "(*" );
	line( " * Automatically Generated by M2DataDec" );
	line( " *)" );
	nl();
	nl();
	line( "FROM Assertions IMPORT Assert, Abort;" );
	nl();
	line( "FROM FIO IMPORT" );
	indent();
254
255
	line( "File, WriteString, WriteChar, WriteInteger," );
	line( "WriteReal, WriteLine, WriteLn;" );
dcw's avatar
dcw committed
256
257
258
259
260
261
262
263
264
265
266
267
268
	nl();
	outdent();
	line( "FROM Storage IMPORT ALLOCATE;" );
	nl();
	nl();

	if( *globals != '\0' )
	{
		line( "(* Contents of GLOBAL section *)" );
		line( globals );
		nl();
	}

269
270
271
272
	line( "(* Pointer type declarations *)" );
	line( "TYPE" );
	indent();
	for( d = decs; d != NULL; d=d->next )
dcw's avatar
dcw committed
273
	{
274
275
276
277
278
		if( d->Struct )
		{
			line( "%s\t= POINTER TO %sRec;", d->name, d->name );
			nl();
		}
dcw's avatar
dcw committed
279
	}
280
281
282
	outdent();

	for( d = decs; d != NULL; d=d->next )
dcw's avatar
dcw committed
283
	{
284
		impln_onetype( d );
dcw's avatar
dcw committed
285
	}
286
	write_bool();
dcw's avatar
dcw committed
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305

	line( "BEGIN" );
	line( "END %s.", modulename );
	fclose( implnfile );
}


static void impln_onetype( d ) decln d;
{
	shapelist s;

	nl();
	line( "(* ---- Type %s ---- *)", d->name );
	nl();

	if( d->Struct )
	{
		line( "TYPE" );
		indent();
306
		line( "%sRec = RECORD", d->name );
dcw's avatar
dcw committed
307
308
309
310
311
312
313
		indent();

		if( d->Union )
		{
			variantfields( d );
		} else if( d->TagField )
		{
314
			line( "tag\t: KindOf%s;", d->name );
dcw's avatar
dcw committed
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
			normalfields( d );
		} else
		{
			normalfields( d );
		}
		outdent();
		line( "END;" );
		nl();

		outdent();
	}
	nl();

	for( s = d->shapes; s != NULL; s = s->next )
	{
		consproc_body( d, s );
	}

	if( d->Defines )
	{
		deconskind_body( d );
	}

	for( s = d->shapes; s != NULL; s = s->next )
	{
		if( s->params != NULL )
		{
			deconsproc_body( d, s );
		}
	}

346
	writeproc_body( d );
dcw's avatar
dcw committed
347
348
349
350
351
352
353
354
355
356
357
}


/* ------------------------- Fields of record ---------------------------- */


static void variantfields( d ) decln d;
{
	shapelist	s;
	paramlist	p;

358
	line( "CASE tag : KindOf%s OF", d->name );
dcw's avatar
dcw committed
359
360
361

	for( s = d->shapes; s != NULL; s=s->next )
	{
362
		line( "|%sIs%s:", d->name, s->name );
dcw's avatar
dcw committed
363
364
365
		indent();
		for( p = s->params; p != NULL; p=p->next )
		{
366
367
			line( "%s%s\t: %s;", s->name, p->name,
			      lookup_type(p->type) );
dcw's avatar
dcw committed
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
		}
		outdent();
	}

	line( "END;" );
}


static void normalfields( d ) decln d;
{
	shapelist	s;
	paramlist	p;

	for( s = d->shapes; s != NULL; s=s->next )
	{
		for( p = s->params; p != NULL; p=p->next )
		{
385
386
			line( "%s%s\t: %s;", s->name, p->name,
			      lookup_type(p->type) );
dcw's avatar
dcw committed
387
388
389
390
391
392
393
394
395
396
397
398
399
		}
	}
}


/* ----------------------- Construction procedures ----------------------- */


static void consproc_header( name, s ) char *name; shape s;
{
	paramlist	p;
	BOOL		first;

400
	fprintf( outfile, "PROCEDURE %s%s( ", name, s->name );
dcw's avatar
dcw committed
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
	first = TRUE;
	for( p = s->params; p != NULL ; p = p->next )
	{
		if( !first ) fputs( "; ", outfile );
		fprintf( outfile, "%s : %s ",
			 p->name, lookup_type(p->type) );
		first = FALSE;
	}
	fprintf( outfile, ") : %s;\n", name );
}


static void consproc_body( d, s ) decln d; shape s;
{
	paramlist p;

	consproc_header( d->name, s );
	nl();

	if( d->Struct && ! ( d->UseNull && d->shapes == s ) )
	{
		line( "VAR\tnew : %s;", d->name );
		nl();
	}
	line( "BEGIN" );
	indent();

	if( d->UseNull && d->shapes == s )
	{
		line( "RETURN NIL;" );
	} else if( ! d->Struct )
	{
433
		line( "RETURN %s( ORD(%sIs%s) );", d->name, d->name, s->name );
dcw's avatar
dcw committed
434
435
436
437
438
	} else
	{
		line( "NEW( new );", d->name );
		if( d->TagField )
		{
439
			line( "new^.tag\t:= %sIs%s;", d->name, s->name );
dcw's avatar
dcw committed
440
441
442
		}
		for( p=s->params; p != NULL; p=p->next )
		{
443
			line( "new^.%s%s\t:= %s;", s->name, p->name, p->name );
dcw's avatar
dcw committed
444
445
446
447
448
		}
		line( "RETURN new;" );
	}

	outdent();
449
	line( "END %s%s;", d->name, s->name );
dcw's avatar
dcw committed
450
451
452
453
454
455
456
457
458
459
	nl();
	nl();
}


/* -------------------- Deconstruction Kind procedure -------------------- */


static void deconskind_header( name ) char *name;
{
460
	line( "PROCEDURE %sKind( this : %s ) : KindOf%s;", name, name, name );
dcw's avatar
dcw committed
461
462
463
464
465
466
467
468
469
470
471
}


static void deconskind_body( d ) decln d;
{
	deconskind_header( d->name );
	nl();
	line( "BEGIN" );
	indent();
	deconskind_inner( d );
	outdent();
472
	line( "END %sKind;", d->name );
dcw's avatar
dcw committed
473
474
475
476
477
478
479
480
481
482
483
	nl();
	nl();
}


static void deconskind_inner( d ) decln d;
{
	shapelist s = d->shapes;

	if( ! d->Struct )		/* enumerated type */
	{
484
		line( "RETURN VAL(KindOf%s, this);", d->name );
dcw's avatar
dcw committed
485
486
487
488
489
490
491
		return;
	}
	if( d->UseNull )
	{
		line( "IF this = NIL" );
		line( "THEN" );
		indent();
492
		line( "RETURN %sIs%s;", d->name, s->name );
dcw's avatar
dcw committed
493
494
495
496
497
498
499
500
501
		outdent();
		line( "END; (* IF *)" );
		s = s->next;
	}
	if( d->TagField )
	{
		line( "RETURN this^.tag;" );
	} else
	{
502
		line( "RETURN %sIs%s;", d->name, s->name );
dcw's avatar
dcw committed
503
504
505
506
507
508
509
510
511
512
513
	}
}


/* ---------------------- Deconstruction procedures ---------------------- */


static void deconsproc_header( name, s ) char *name; shape s;
{
	paramlist	p;

514
	fprintf( outfile, "PROCEDURE Get%s%s( this : %s ", name, s->name,
dcw's avatar
dcw committed
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
		 	  name );

	for( p = s->params; p != NULL ; p=p->next )
	{
		fprintf( outfile, "; VAR %s : %s ", p->name,
			 lookup_type(p->type) );
	}
	fprintf( outfile, ");\n" );
}


static void deconsproc_body( d, s ) decln d; shape s;
{
	paramlist p;

	deconsproc_header( d->name, s );
	nl();
	line( "BEGIN" );
	indent();

	for( p=s->params; p != NULL; p=p->next )
	{
537
		line( "%s\t:= this^.%s%s;", p->name, s->name, p->name );
dcw's avatar
dcw committed
538
539
540
	}

	outdent();
541
	line( "END Get%s%s;", d->name, s->name );
dcw's avatar
dcw committed
542
543
544
545
546
	nl();
	nl();
}


547
/* --------------------------- Write procedure --------------------------- */
dcw's avatar
dcw committed
548
549


550
static void writeproc_header( name ) char *name;
dcw's avatar
dcw committed
551
{
552
	line( "PROCEDURE Write%s( f : File; this : %s );", name, name );
dcw's avatar
dcw committed
553
554
555
}


556
static void writeproc_body( d ) decln d;
dcw's avatar
dcw committed
557
558
559
{
	shapelist shapes;

560
	writeproc_header( d->name );
dcw's avatar
dcw committed
561
	nl();
dcw's avatar
dcw committed
562
563
564
565
566
567
568

	if( d->PutLoop )
	{
		line( "VAR over : BOOLEAN;" );
		nl();
	}

dcw's avatar
dcw committed
569
570
	line( "BEGIN" );
	indent();
dcw's avatar
dcw committed
571
572
573
574
575
576
577
578
579

	if( d->PutLoop )
	{
		line( "REPEAT" );
		indent();
		line( "over := TRUE;" );
		nl();
	}

dcw's avatar
dcw committed
580
581
582
583
584
585
	shapes = d->shapes;
	if( d->UseNull )
	{
		line( "IF this = NIL" );
		line( "THEN" );
		indent();
dcw's avatar
dcw committed
586
		write_all_params( d->name, /* first */ shapes );
dcw's avatar
dcw committed
587
		outdent();
dcw's avatar
dcw committed
588
589
		line( "ELSE" );
		indent();
dcw's avatar
dcw committed
590
591
		shapes = shapes->next;
	}
dcw's avatar
dcw committed
592

dcw's avatar
dcw committed
593
594
	if( d->TagField )
	{
595
		write_using_case( "this^.tag", d->name, shapes );
dcw's avatar
dcw committed
596
597
	} else if( d->Struct )	/* only one shape left */
	{
598
		write_all_params( d->name, shapes );
dcw's avatar
dcw committed
599
600
	} else			/* enumerated type */
	{
601
602
603
		char tag[256];

		sprintf( tag, "VAL(KindOf%s, this)", d->name );
604
		write_using_case( tag, d->name, shapes );
dcw's avatar
dcw committed
605
	}
dcw's avatar
dcw committed
606
607
608
609
610
611
612
613
614
615
616
	if( d->UseNull )
	{
		outdent();
		line( "END; (* IF *)" );
	}

	if( d->PutLoop )
	{
		outdent();
		line( "UNTIL over;" );
	}
dcw's avatar
dcw committed
617
	outdent();
618
	line( "END Write%s;", d->name );
dcw's avatar
dcw committed
619
620
621
622
	nl();
}


623
static void write_using_case( tag, dname, s ) char *tag, *dname; shapelist s;
dcw's avatar
dcw committed
624
625
626
627
{
	line( "CASE %s OF", tag );
	for( ; s != NULL; s = s->next )
	{
628
		line( "|%sIs%s:", dname, s->name );
dcw's avatar
dcw committed
629
		indent();
630
		write_all_params( dname, s );
dcw's avatar
dcw committed
631
632
633
634
		outdent();
	}
	line( "ELSE" );
	indent();
635
	line( "Abort( \"Write%s: impossible tag\" );", dname );
dcw's avatar
dcw committed
636
637
638
639
640
	outdent();
	line( "END; (* CASE *)" );
}


dcw's avatar
dcw committed
641
static void write_all_params( dname, s ) char *dname; shape s;
dcw's avatar
dcw committed
642
{
dcw's avatar
dcw committed
643
644
645
646
647
648
649
	if( s->pl == NULL )
	{
		write_default_printlist( s );
	} else
	{
		write_printlist( s, dname );
	}
dcw's avatar
dcw committed
650
651
652
}


dcw's avatar
dcw committed
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
static void write_default_printlist( s ) shape s;
{
	BOOL		first;
	paramlist	p = s->params;

	/* No print items given - use defaults */

	if( p )
	{
		line( "WriteString( f, \"%s(\" );", s->name );
		for( first = TRUE; p != NULL; p = p->next )
		{
			if( ! first ) line( "WriteChar( f, \",\" );" );
			first = FALSE;
			write_param( s->name, p );
		}
		line( "WriteChar( f, ')' );" );
	} else
	{
		line( "WriteString( f, \"%s\" );", s->name );
	}
}


static void write_printlist( s, dname ) shape s; char *dname;
dcw's avatar
dcw committed
678
{
dcw's avatar
dcw committed
679
680
	/* Some print items given - use them */

dcw's avatar
dcw committed
681
	printlist	pl;
dcw's avatar
dcw committed
682
683
	param		p;
	int		n;
dcw's avatar
dcw committed
684

dcw's avatar
dcw committed
685
686
687
	/* All but the last item */

	for( pl = s->pl; pl->next != NULL; pl = pl->next )
dcw's avatar
dcw committed
688
	{
dcw's avatar
dcw committed
689
		if( pl->item->tag == printitem_is_str )
dcw's avatar
dcw committed
690
		{
dcw's avatar
dcw committed
691
			outstring( pl->item->str );
692
693
		} else
		{
dcw's avatar
dcw committed
694
695
696
			p = findnthparam( pl->item->num, s->params,
					  s->name, dname );
			write_param( s->name, p );
dcw's avatar
dcw committed
697
		}
dcw's avatar
dcw committed
698
699
700
701
702
703
704
	}

	/* Last item */

	if( pl->item->tag == printitem_is_str )
	{
		outstring( pl->item->str );
dcw's avatar
dcw committed
705
706
	} else
	{
dcw's avatar
dcw committed
707
708
		p = findnthparam( pl->item->num, s->params, s->name, dname );
		if( streq( p->type, dname ) )
dcw's avatar
dcw committed
709
		{
dcw's avatar
dcw committed
710
711
712
713
714
			line( "this := this^.%s%s;", s->name, p->name );
			line( "over := FALSE;" );
		} else
		{
			write_param( s->name, p );
dcw's avatar
dcw committed
715
716
717
718
719
		}
	}
}


dcw's avatar
dcw committed
720
721
722
723
724
725
726
static void write_param( sname, p ) char *sname; param p;
{
	line( "%s( f, this^.%s%s );",
	      lookup_write_proc(p->type), sname, p->name );
}


727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
static void outstring( str ) char *str;
{
	char *p;
	BOOL over = FALSE;

	while( ! over )
	{
		p = strstr( str, "\\n" );
		if( p == NULL )
		{
			line( "WriteString( f, \"%s\" );", str );
			over = TRUE;
		} else
		{
			if( p == str )
			{
				line( "WriteLine( f );" );
			} else
			{
				line( "WriteLn( f, \"%.*s\" );", (p-str), str );
			}
			if( *(p+2) != '\0' )
			{
				str = p + 2;
			} else
			{
				over = TRUE;
			}
		}
	}
}


dcw's avatar
dcw committed
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
static void write_bool()
{
	line( "PROCEDURE WriteBool( f : File; bool : BOOLEAN );" );
	nl();
	line( "BEGIN" );
	indent();
	line( "IF bool" );
	line( "THEN" );
	indent();
	line( "WriteString( f, \"TRUE\" );" );
	outdent();
	line( "ELSE" );
	indent();
	line( "WriteString( f, \"FALSE\" );" );
	outdent();
	line( "END;" );
	outdent();
	line( "END WriteBool;" );
}


/* --------------------- Predefined type lookup system  ------------------ */


struct typelookup
{
	char	*name;
	char	*type_name;
788
	char	*write_name;
dcw's avatar
dcw committed
789
790
791
792
793
};


static struct typelookup lookup[] = {
	"int",		"INTEGER",	"WriteInteger",	
794
	"Int",		"INTEGER",	"WriteInteger",	
dcw's avatar
dcw committed
795
796
797
	"INT",		"INTEGER",	"WriteInteger",	
	"INTEGER",	"INTEGER",	"WriteInteger",	
	"string",	"string",	"WriteString",	
798
	"String",	"String",	"WriteString",	
dcw's avatar
dcw committed
799
	"real",		"REAL",		"WriteReal",	
800
	"Real",		"REAL",		"WriteReal",	
dcw's avatar
dcw committed
801
	"REAL",		"REAL",		"WriteReal",	
802
803
	"float",	"REAL",		"WriteReal",	
	"Float",	"REAL",		"WriteReal",	
dcw's avatar
dcw committed
804
	"char",		"CHAR",		"WriteChar",	
805
	"Char",		"CHAR",		"WriteChar",	
dcw's avatar
dcw committed
806
807
	"CHAR",		"CHAR",		"WriteChar",	
	"bool",		"BOOLEAN",	"WriteBool",	
808
	"Bool",		"BOOLEAN",	"WriteBool",	
dcw's avatar
dcw committed
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
	"BOOL",		"BOOLEAN",	"WriteBool",	
	"BOOLEAN",	"BOOLEAN",	"WriteBool",
};

#define NUM_LOOKUP_TYPES	(sizeof(lookup)/sizeof(lookup[0]))


static char *lookup_type( typename ) char *typename;
{
	int	predef;

	predef = predefined_type( typename );
	return (predef == -1) ? typename : lookup[predef].type_name;
}


825
static char *lookup_write_proc( typename ) char *typename;
dcw's avatar
dcw committed
826
827
828
829
830
831
832
{
	int	predef;
	static  char tmp[256];

	predef = predefined_type( typename );
	if( predef == -1 )
	{
833
		sprintf( tmp, "Write%s", typename );
dcw's avatar
dcw committed
834
835
836
		return tmp;
	} else
	{
837
		return lookup[predef].write_name;
dcw's avatar
dcw committed
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
	}
}


static int predefined_type( typename ) char *typename;
{
	int i;

	for( i=0; i<NUM_LOOKUP_TYPES; i++ )
	{
		if( streq( lookup[i].name, typename ) )
		{
			return i;
		}
	}
	return -1;
}