/*
 *	symbtbl.c
 */

/*	Remove Comment for debugging
#define SYMBTBLDEBUG	1
*/

/* Externals */
#include <varargs.h>

#include "os.h"
#include "symbtbl.h"
#include "mc.h"
#include "mctypes.h"

#ifdef MSDOS
# include "lex_yy.h"
# include "y_tab.h"
#else
# include "lex.yy.h"
# include "y.tab.h"
#endif
#include "expr.h"


char	*module_name = "";

int	warnings = 0;
int	errors = 0;

FileNames	*filenames = NULL;

IdArt	nullidart;

int	entrycount = 0;

Flag	null_flag; 	/* Initialisiert mit 0, da global definiert */

BlockType	blocktype;

int	staticlevel = 0;

SymbTblEntry	*freelist = NULL,
		*hashlist[D_SYMBPRIM],
		*voidstblentry;

STblList	*stbllist = NULL;

STblListSave	*stbllistsave = NULL;

BlockList	*blocklist = NULL;

TypeArt	typeart;

int	maxtypenr = 0;

Types	*typelist = NULL,
	typevar;

void
message(level, fmt, va_alist)
	int	level;
	char	*fmt;
	va_dcl
{
	va_list	pvar;
	static	int	i = 0;
	char	*pc;

	char	buf[512];

			/* Variable mc_warn is set for suppression of warnings */

	if ((level != D_OPEN_ERROR) && ( ! (level == D_WARN && mc_warn))) {
		fprintf (stderr, "\"%s\", Line %d: ", actual_filename, yylineno);
	}

	va_start (pvar);
	
	switch (level) {
		case D_WARN:
			warnings++;
			if (mc_warn) {
				break;
			}
			fprintf (stderr, "Warning: ");
			c_out ("/*\nWarning: ");
			if (listfile != NULL) {
				fprintf (listfile, "\nWARN:\t");
			}
			break;
		case D_ERROR:
			errors++;
			fprintf (stderr, "Error: ");
			c_out ("/*\nError: ");
			if (listfile != NULL) {
				fprintf (listfile, "\nERROR:\t");
			}
			break;
		case D_INTERNAL:
			level = D_FATAL;
			errors++;
			fprintf (stderr, "Fatal: Internal error: ");
			c_out ("/*\nFatal: Internal error: ");
			if (listfile != NULL) {
				fprintf (listfile, "\nINTERN:\t");
			}
			break;
		case D_FATAL:
		default:
			level = D_FATAL;
			errors++;
			fprintf (stderr, "Fatal: ");
			c_out ("/*\nFatal: ");
			if (listfile != NULL) {
				fprintf (listfile, "\nFATAL:\t");
			}
			break;
		case D_OPEN_ERROR:
			errors++;
			fprintf (stderr, "Fatal: ");
			vfprintf (stderr, fmt, pvar);
			fprintf (stderr, "\n");
			exit (1);
			break;
	}

	pc = fmt;
	if (! mc_rule) {
		if ((pc = strchr (fmt, ':')) == NULL) {
			pc = fmt;
		} else {
			pc += 2;
		}
	}
	if ( ! (level == D_WARN && mc_warn)) {
		vfprintf (stderr, pc, pvar);
		vsprintf (buf, pc, pvar);
		c_out (buf);
/*
		c_out (pc, pvar);
*/
		if (listfile != NULL) {
			fprintf (listfile, "%s\n%dC:\t", buf, mc_list_lineno);
		}

		fprintf (stderr, "\n");
		if (level != D_WARN) {
				/* C-Compiler must be runnable
				 * when only warnings occur 
				 * therefore exbuf must be kept
				 * in that case (level == D_WARN) */
			c_out_exbuf ();
		}
		c_out ("\n*/\n");
		c_out_lineno ();
	}

	va_end (pvar);
	
	if (i) {
		fprintf (stderr, "Fatal: Internal error: message: exit within message");
		c_out ("/*\nFatal: Internal error: message: exit within message\n*/\n");
		exit (1);
	}

	if (level == D_FATAL) {
		i = 1;
		statistics (1);
	}

	return;
}



char	*
strsave(s)
	char	*s;
{
	char	*help;

#ifdef SYMBTBLDEBUG
	printf ("strsave (\"%s\")\n", s);
#endif

	if ((help = (char *) malloc (strlen (s) + 1)) == NULL) {
		message (D_INTERNAL, "strsave: No more memory for String '%s' to save", s);
	}

	strcpy (help, s);
	return (help);
}
	
void
newblocklist(s)
	char	*s;
{
	static	int	nr = 0;
	BlockList	*help;

#ifdef SYMBTBLDEBUG
	printf ("newblocklist (\"%s\")\n", s);
#endif

	if ((help = (BlockList *) malloc (sizeof (BlockList))) == NULL) {
		message (D_INTERNAL, "newblocklist: No more memory for new BlockList-Entry");
	}

	memset ((char *) help, 0, sizeof (BlockList));
	
	help->type = blocktype;
	help->id = s;
	help->nr = nr++;
	help->nextblocklist = blocklist;
	blocklist = help;

	return;
}

	

void
newsymbtbl(width)
	unsigned	width;
{
	SymbTblEntry	*arraybegin,
			*savelist,
			**pp;
	unsigned	stblsize,
			i;

#ifdef SYMBTBLDEBUG
	printf ("newsymbtbl (%u)\n", width);
#endif

	stblsize = sizeof (SymbTblEntry) * width;

					/*
					 * Anker der Verkettung ist die freelist
					 */
	savelist = freelist;
	pp = &freelist;

					/*
					 * Speicherplatz holen und mit 0 belegen
					 */
	if ((arraybegin = (SymbTblEntry *) malloc (stblsize)) == NULL) {
		message (D_INTERNAL, "newsymbtbl: No more memory for Symboltable-Entries");
	}

	memset ((char *) arraybegin, 0, stblsize);

					/*
					 * Verketten in die freelist
					 * (nur Vorwrtsverkettung!)
					 */
	for (i = 0; i < width; i++) {
		*pp = &arraybegin [i];

		arraybegin [i].entrynr = entrycount++;
					
					/*
					 * nchster zu verkettender Pointer
					 */
		pp = &arraybegin [i].next;
	}

					/*
					 * Anhngen der bisherigen freelist
					 * (im Normalfall NULL)
					 */
	*pp = savelist;
}


int
hash(id)
	char	*id;
{
	char	*p;
	unsigned long	h, g;

#ifdef SYMBTBLDEBUG
	printf ("hash (\"%s\")\n", id);
#endif

	h = 0;
	for (p = id; *p ; p++) {
		h = (h << 4) + (*p);
		if (g = h & 0xf0000000) {
			h = h ^ (g >> 24);
			h = h ^ g;
		}
	}
	return (h % D_SYMBPRIM);
}
		

SymbTblEntry *
symbtbllookup(id)
	char	*id;
{
	SymbTblEntry	*p;

#ifdef SYMBTBLDEBUG
	printf ("symbtbllookup (\"%s\")\n", id);
#endif

	for (p = hashlist [hash (id)]; p; p = p->next) {
		if (strcmp (p->id, id) == 0)
			return (p);
	}
		
	return (NULL);
}


SymbTblEntry *
symbtbllookupwithinidart(id, idart)
	char	*id;
	IdArt	idart;
{
	SymbTblEntry	*p;

#ifdef SYMBTBLDEBUG
	printf ("symbtbllookupwitinidart (\"%s\", 0x%X)\n", id, *(int *) &idart); /* ACHTUNG ACHTUNG ACHTUNG */
#endif

	p = symbtbllookup (id);

	while (p) {
		if (*(long *)&p->iart & *(long *)&idart) {			/* ACHTUNG ACHTUNG ACHTUNG */
			break;
		}
		
		do {
			p = p->next;
		} while (p && strcmp (p->id, id));
	}
		
	return (p);
}


SymbTblEntry *
symbtbl_lookup_in_same_level(id)
	char	*id;
{
	SymbTblEntry	*p;

#ifdef SYMBTBLDEBUG
	printf ("symbtbl_lookup_in_same_level (\"%s\")\n", id);
#endif

	p = symbtbllookup (id);

	while (p != NULL) {
		if (p->staticlevel == staticlevel) {
			if (! (p->iart.is_recordfieldid || p->iart.is_recordcaseid)) {
				break;
			}
		}
		
		do {
			p = p->next;
		} while (p && strcmp (p->id, id));
	}
		
	return (p);
}


void
entryinactualblock(entry)
	SymbTblEntry *entry;		/*
					 * entry zeigt auf den
					 * Symboltabelleneintrag,
					 * der eingereiht werden soll
					 */
{
	SymbTblEntry	*help;

#ifdef SYMBTBLDEBUG
	printf ("entryinactualblock (->\"%s\")\n", entry->id);
#endif

	if (blocklist == NULL || entry == NULL) {
		message (D_INTERNAL, "entryinactualblock: 'entry' or 'blocklist' has Value NULL");
	}

					/*
					 * Einschleusen in die (letzte,
					 * d. h. innerste) Block-Liste
					 */
	if (blocklist->stbllist == NULL) {
		blocklist->stbllist = entry;
	} else {
		help = blocklist->stbllist;

		while (help->nextinblock != NULL) {
			help = help->nextinblock;
		}
		help->nextinblock = entry;
	}
	entry->ofblock = blocklist;

	return;
}


SymbTblEntry *
symbtbladd(id)
	char	*id;
{
	SymbTblEntry	*help;
	int	e,
		i;

#ifdef SYMBTBLDEBUG
	printf ("symbtbladd (\"%s\")\n", id);
#endif
	if ((help = symbtbllookup (id)) != NULL) {
		if (help->status.is_predeclared) {
			message (D_ERROR, "symbtbladd: Identifier '%s' is a reserved name", id);
			return (help);
		}
	}

	if ((help = symbtbl_lookup_in_same_level (id)) != NULL) {
		message (D_ERROR, "symbtbladd: Identifier '%s' already declared", id);
		return (help);
	}
	
	i = hash (id);

	if (freelist == NULL) {
		newsymbtbl (D_SYMBTBLWIDTH);
	}
					/*
					 * Neue Vekettung:
					 * Erstes Element aus der freelist
					 * wird geloescht mit memset (der
					 * Entry-Zaehler wird davor gesichert)
					 * und das Element kommt in die
					 * hashlist [i]
					 */
	help = freelist->next;
	e = freelist->entrynr;
	memset ((char *) freelist, 0, sizeof (SymbTblEntry));
	freelist->entrynr = e;
	freelist->next = hashlist [i];
	freelist->staticlevel = staticlevel;
	if (hashlist [i])
		hashlist [i]->prev = freelist;
	hashlist [i] = freelist;
	freelist = help;

					/*
					 * Speicherplatz fuer id
					 */
	hashlist [i]->id = strsave (id);

	entryinactualblock (hashlist [i]);

	return (hashlist [i]);
}


int
deleteentry(entry)
	SymbTblEntry *entry;		/*
					 * entry zeigt auf den
					 * Symboltabelleneintrag,
					 * der geloescht werden soll
					 */
{
	SymbTblEntry	*help;
	int	i;
	BlockList	*blisthelp;

	if (entry == NULL)
		return (0);

#ifdef SYMBTBLDEBUG
	printf ("deleteentry (->\"%s\")\n", entry->id);
#endif

					/*
					 * Neue Vekettung:
					 * Element aus der hashlist wird
					 * in die freelist eingeschleust
					 * und somit geloescht. Der
					 * Speicherplatz des mit strsave
					 * gesicherten Identifiers wird
					 * zurueckgegeben (free)
					 */
	if (entry->next)
		entry->next->prev = entry->prev;
	if (entry->prev)
		entry->prev->next = entry->next;
	else {
		i = hash (entry->id);
		help = hashlist [i];
		if (help == entry)
			hashlist [i] = entry->next;
		else
			message (D_INTERNAL, "deleteentry: Entry cannot be deleted from hashlist [%d]", i);
	}
					/*
					 * Entfernen aus der blocklist
					 */
	blisthelp = blocklist;
	while (blisthelp) {
		if ((help = blisthelp->stbllist) == entry) {
				/* als erstes Blocklistelement geloescht */
			help = entry;
			blisthelp->stbllist = entry->nextinblock;
			break;
		}
		while (help->nextinblock) {
			if (help->nextinblock == entry) {
				help->nextinblock = entry->nextinblock;
				help = entry;
				break;
			}
			help = help->nextinblock;
		}
		if (help == entry)
			break;
		blisthelp = blisthelp->nextblocklist;
	}

	if (help != entry) {
		message (D_INTERNAL, "deleteentry: Entry cannot be deleted from its blocklist");
	}

					/*
					 * Eintragen in die freelist
					 */
	entry->next = freelist;
	freelist = entry;
	free (entry->id);
	entry->id=NULL;

	return (1);
}


void
setactualblock(btype, bid)
					/*
					 * Setzt den angegebenen BlockTyp
					 * als ersten Block in die Blockliste.
					 * Ist die bid = NULL, so wird der
					 * erste in der BlockList gefundene
					 * Block mit entsprechendem Typ
					 * genommen, sonst wird weiter
					 * gesucht, bis der gewnschte Name
					 * gefunden ist.
					 */
	BlockType	btype;
	char		*bid;
{
	BlockList	*blisthelp,
			*lastelem,
			*nextelem;

#ifdef SYMBTBLDEBUG
	printf ("setactualblock (0x%X, \"%s\")\n", *(int *) &btype, bid); /* ACHTUNG ACHTUNG ACHTUNG */
#endif

	lastelem = nextelem = blocklist;

	while (blisthelp = nextelem) {
		nextelem = blisthelp->nextblocklist;
		if (blisthelp->type == btype) {
			if (bid == NULL || strcmp (bid, blisthelp->id) == 0) {
					/*
					 * Neue Vekettung:
					 * BlockList-Elemente werden
					 * umgehaengt, Reihenfolge
					 * unbedingt beibehalten!
					 */
				blisthelp->nextblocklist = blocklist;
				lastelem->nextblocklist = nextelem;
				blocklist = blisthelp;

				return;
			}
		}
		lastelem = blisthelp;
	}

	message (D_INTERNAL, "setactualblocklist: Block not found");
}



int
deleteactualblock()
					/*
					 * Loescht den zuletzt eingetragenen
					 * (d. h. innersten) Block
					 * der blocklist (einschl.
					 * SymbtblEntries) und berprft
					 * diesen auf nichtdeklarierte
					 * ENTRY's, PROCEDURE's,
					 * PROCESS's, MONITOR's und
					 * COMMUNICATION's
					 */
{
	SymbTblEntry	*help;
	BlockList	*blisthelp;
	int	i = 0;

#ifdef SYMBTBLDEBUG
	printf ("deleteactualblock ()\n");
#endif

	if (blocklist == NULL) {
		return (0);
	}
					/*
					 * Neue Vekettung:
					 * SymbTblEntry-Elemente aus der
					 * blocklist werden geloescht und
					 * in die freelist eingeschleust
					 */
	while (help = blocklist->stbllist) {
					/*
					 * Entfernen eines eventuell vorhandenen
					 * Unterblocks
					 */
		if (newblock (help->iart)) {
			if (help->iart.is_communicationid) {
				setactualblock (e_COMMUNICATION, help->id);
			} else if (help->iart.is_entryid) {
				setactualblock (e_ENTRY, help->id);
			} else if (help->iart.is_eventid) {
				setactualblock (e_EVENT, help->id);
			} else if (help->iart.is_monitorid) {
				setactualblock (e_MONITOR, help->id);
			} else if (help->iart.is_procedureid) {
				setactualblock (e_PROCEDURE, help->id);
			} else if (help->iart.is_processid) {
				setactualblock (e_PROCESS, help->id);
			} else {
				setactualblock (NULL, help->id);
			}
			deleteactualblock ();
					/*
					 * Test auf nichtdeklarierte
					 * ENTRY's, PROCEDURE's,
					 * PROCESS's, MONITOR's und
					 * COMMUNICATION's
					 */
			if (! (help->iart.is_eventid || help->iart.is_moduleid)) {
					/* event wird in der Prozedur
					 * search_for_undeclared_events
					 * getestet; module nicht notwendig
					 */
				if (! help->status.is_defined) {
					message (D_ERROR, "deleteactualblock: Predeclared Identifier '%s' of 'Procedure-Kind' is not fully declared", help->id);
				}
			}
		}
					/*
					/*
					 * Entfernen aus der hashlist
					 * inclusive Entfernen aus der blocklist
					 */
		if (deleteentry (help) == 0)
			message (D_INTERNAL, "deleteactualblock: Cannot delete symboltable-entry");
		i++;
	}
					/*
					 * BlockList-Element wird
					 * geloescht und der Speicherplatz
					 * wieder freigegeben
					 */
	blisthelp = blocklist;
	blocklist = blocklist->nextblocklist;
	free (blisthelp);
	
	return (i);
}


void
save_stbl_list(i)
	int	i;			/*
					 * Fuer Records:
					 * i = 1: Merkt sich die
					 *        bisherige stbllist
					 *        und setzt stbllist auf NULL
					 * i = -1: Setzt stbllist
					 *         auf die zuletzt gemerkte
					 *         Liste (LIFO)
					 * Dies ist notwendig, da Records
					 * bei einer Typ- bzw. Variablen-
					 * Definition oder auch geschachtelt
					 * auftreten koennen und ohne das
					 * jeweilige Sichern die alte
					 * Liste verloren waere
					 */
{
	STblListSave	*help;
#ifdef SYMBTBLDEBUG
	printf ("save_stbl_list (%d)\n", i);
#endif
	switch (i) {
		case 1:
			if ((help = (STblListSave *) malloc (sizeof (STblListSave))) == NULL) {
				message (D_INTERNAL, "save_stbl_list (1): No more memory for STblListSave");
			}
			help->list = stbllist;
			stbllist = NULL;
			help->next = stbllistsave;
			stbllistsave = help;
			break;
		case -1:
			if (stbllist) {
				message (D_INTERNAL, "save_stbl_list (-1): Stbllist is not empty");
			}
		case -2:
			if (stbllistsave == NULL) {
				message (D_INTERNAL, "save_stbl_list (-1 or -2): Stbllistsave is empty");
			}
			stbllist = stbllistsave->list;
			help = stbllistsave;
			stbllistsave = stbllistsave->next;
			free (help);
			break;
		default:
			message (D_INTERNAL, "save_stbl_list: Parameter '%d' invalid");
			break;
	}
	
	return;
}


void
add_stbl_list(entry)
	SymbTblEntry *entry;		/*
					 * traegt den entry in die
					 * stbllist ein
				 */
{
	STblList	**help;

#ifdef SYMBTBLDEBUG
	printf ("add_stbl_list (->\"%s\")\n", entry->id);
#endif

	help = &stbllist;

	while (*help != NULL) {
		help = &(*help)->next;
	}
					/*
					 * Speicherplatz holen
					 */
	if ((*help = (STblList *) malloc (sizeof (STblList))) == NULL) {
		message (D_INTERNAL, "add_stbl_list: No more memory for STblList");
	}
	(*help)->entry = entry;
	(*help)->next = NULL;

	return;
}


void
out_array_of_cond_or_sem(type, semorcond, value)
	SymbTblEntry    *type;
	char	*semorcond;
	long	value;			/*
					 * Initialisiert die ARRAYS
					 * OF SEMAPHORE oder CONDITION
					 */
{
	int	level, l, i, m;
	Types	*typeshlp;
	char	*fn;
	STblList	*help;

#ifdef SYMBTBLDEBUG
	printf ("out_array_of_cond_or_sem (->\"%s\", \"%s\", %ld)\n", type->id, semorcond, value);
#endif

#define C_INIT_TABS	for (l = 0; l <= level; l++) {\
	c_init ("\t");\
}

	level = i = 0;
	typeshlp = type->u.oftype;

	if (strcmp (semorcond, "semaphore") == 0) {
		fn = "sem_define";
	} else if (strcmp (semorcond, "condition") == 0) {
		fn = "cond_define";
	} else {
		message (D_FATAL, "out_array_of_cond_or_sem: Unknown Type (semaphore or condition expected)");
	}

	c_init ("\t{\n");

	for (;;) {
		if (typeshlp->tart.is_array == 0) {
			break;
		}
		level++;
		if (typeshlp->indextype->status.is_external || export || import_filename != NULL) {
			m = 0;
		} else {
			m = typeshlp->indextype->ofblock->nr;
		}

		C_INIT_TABS
			/* neither external nor export nor import possible
			 * during processing semaphores or conditions,
			 * therefore 'm0_' is here not possible */
		c_init ("m%d_%s idx_%d;\n", m, typeshlp->indextype->id, level);
		C_INIT_TABS
		c_init ("for (idx_%d = %ld - %ld; idx_%d <= %ld - %ld; idx_%d++) {\n",
			level,
			typeshlp->indextype->u.oftype->minval,
			typeshlp->indextype->u.oftype->minval,
			level,
			typeshlp->indextype->u.oftype->maxval,
			typeshlp->indextype->u.oftype->minval,
			level);

		typeshlp = typeshlp->oftype->u.oftype;
	}

	c_out_linebegin ("static\t");

	c_out_id (type);
	c_out ("\t");
	tabcnt++;

	while ((help = stbllist) != NULL) {
		if (i++) {
			c_out (", ");
		}
		c_out_id (help->entry);

		C_INIT_TABS
			/* neither external nor export nor import possible
			 * during processing semaphores or conditions,
			 * therefore 'm0_' is here not possible */
		c_init ("\tm%d_%s", help->entry->ofblock->nr, help->entry->id);
		for (l = 1; l <= level; l++) {
			c_init (".a [idx_%d]", l);
		}
		c_init (" = %s (%ld);\n", fn, value);

		help->entry->ofstblentry = type;
		stbllist = help->next;

		free (help);
	}
	c_out (";");
	tabcnt--;

	do {
		C_INIT_TABS
		c_init ("}\n");
		level--;
	} while (level >= 0);

#undef C_INIT_TABS

	return;
}


void
set_and_out_type_of_stbl_list(type)
	SymbTblEntry	*type;		/*
					 * traegt bei allen Elementen
					 * der stbllist den Typ ein
					 * und gibt die Variablen-
					 * Definition aus
					 * und loescht die Liste
					 */
{
	STblList	*help;
	int	i = 0;
	int	m;

#ifdef SYMBTBLDEBUG
	printf ("set_and_out_type_of_stbl_list (->\"%s\")\n", type->id);
#endif
					/*
					 * m wird fuer Shared Memory
					 * Size (s. u.) gesetzt
					 */
	if (type->status.is_external || export || import_filename != NULL) {
		m = 0;
	} else {
		m = type->ofblock->nr;
	}

	c_out_linebegin ("static\t");

	c_out_id (type);
	c_out ("\t");
	tabcnt++;

	while ((help = stbllist) != NULL) {
		if (i++) {
			c_out (", ");
		}
		if (((blocklist->nextblocklist->type == e_MONITOR || blocklist->type == e_MODULE))
			&& (strcmp (type->id, "condition"))
			&& (strcmp (type->id, "semaphore"))) {
					/*
					 * Shared Memory wird benoetigt.
					 * Nicht bei Semaphoren und Conditions,
					 * weil diese zum Definitionszeitpunkt
					 * keine parallelen Prozesse haben und
					 * beim Splitten der Prozesse kopiert
					 * werden und ab diesem Zeitpunkt nur
					 * noch wie "Konstanten" benutzt werden
					 */
			c_out ("*shm_");
			c_save ("\n#define\tm%d_%s\t(*shm_m%d_%s)\n",
				help->entry->ofblock->nr, help->entry->id,
				help->entry->ofblock->nr, help->entry->id);

			c_init ("\tif ((shm_m%d_%s = (void *) get_shared_memory_client (sizeof (m%d_%s))) == NULL) {\n%s",
				help->entry->ofblock->nr, help->entry->id,
				m, type->id,
				"\t\truntime_error (P_INTERN, \"Shared Memory Initialization: No more memory for Shared Memory Variable\");\n\t}\n");
		}
		c_out_id (help->entry);
		help->entry->ofstblentry = type;
		stbllist = help->next;

		free (help);
	}
	c_out (";");
	tabcnt--;

	return;
}


void
set_type_of_stbl_list(type)
	SymbTblEntry	*type;		/*
					 * traegt bei allen Elementen
					 * der stbllist den Typ ein
					 * und loescht die Liste
					 */
{
	STblList	*help;

#ifdef SYMBTBLDEBUG
	printf ("set_type_of_stbl_list (->\"%s\")\n", type->id);
#endif

	while ((help = stbllist) != NULL) {
		help->entry->ofstblentry = type;
		stbllist = help->next;
		free (help);
	}

	return;
}


void
set_openarray_of_stbl_list(type)
	SymbTblEntry	*type;		/*
					 * traegt bei allen Elementen
					 * der stbllist das Attribut
					 * is_openarrayparam ein
					 * und definiert den dazugehoerigen Typ
					 * und loescht damit die Liste
					 */
{
	STblList	*helplist;
	SymbTblEntry	*help;
	char	aname[40];
	int	save_output_flag;

#ifdef SYMBTBLDEBUG
	printf ("set_openarray_of_stbl_list (->\"%s\")\n", type->id);
#endif
	helplist = stbllist;

	while (helplist != NULL) {
		helplist->entry->iart.is_openarrayparam = 1;
		helplist = helplist->next;
	}

	sprintf (aname, "_openarray_of_0x%ld", type->u.oftype->typenr);
	if ((help = symbtbllookup (aname)) == NULL) {
			/* Array-Index noch nicht definiert */
		help = symbtbladd (aname);
		memset ((char *) &typevar, 0, sizeof (typevar));
		typevar.tart.is_array = 1;
		help->iart.is_typeid = help->iart.is_generictype = help->iart.is_openarrayparam = 1;
		help->status.is_defined = 1;
		help->ofstblentry = help;
		typevar.dimension = 1;
		typevar.oftype = type;
		if ((typevar.indextype = symbtbllookup ("POSITIVEINT")) == NULL) {
			message (D_FATAL, "set_openarray_of_stbl_list: POSITIVEINT-Type not found");
		}
		help->u.oftype = typeadd (&typevar);

		save_output_flag = output_flag;
		output_flag = 1;

		if (save_output_flag == 0) {
			c_out_lineno ();
		}
		c_out_lf ();
		c_out_linebegin ("typedef\tstruct\t");
		c_out_id (help);
		c_out ("{");
		c_out_id (type);
		c_out ("*a;} ");
		c_out_id (help);
		c_out (";");

		output_flag = save_output_flag;
	}

	set_type_of_stbl_list (help);

	return;
}


void
check_type_of_stbl_list(type, varornot, openarrayornot)
	SymbTblEntry	*type;
	char	varornot;
	char	openarrayornot;		/*
					 * ueberprueft bei allen Elementen
					 * der stbllist den Typ
					 * und loescht die Liste
					 */
{
	STblList	*help;
	SymbTblEntry	*hlptyp;
	int	b1, b2;
	char	aname[40];

#ifdef SYMBTBLDEBUG
	printf ("check_type_of_stbl_list (->\"%s\", '%c', '%c')\n", type->id, varornot, openarrayornot);
#endif

	hlptyp = type;
	if (openarrayornot != '\0') {
		sprintf (aname, "_openarray_of_0x%ld", type->u.oftype->typenr);
		if ((hlptyp = symbtbllookup (aname)) == NULL) {
			message (D_ERROR, "check_type_of_stbl_list: Parameter was already declared as Open Array");
		}
	}

	while ((help = stbllist) != NULL) {
		if (help->entry->ofstblentry != hlptyp) {
			message (D_ERROR, "check_type_of_stbl_list: Parameter-Type differs from earlier Declaration");
		}
		b1 = help->entry->iart.is_callbyreference;
		b2 = (varornot != '\0');
		if (b1 && ! b2) {
			message (D_ERROR, "check_type_of_stbl_list: Parameter was already declared as Call-By-Reference");
		}
		if (b2 && ! b1) {
			message (D_ERROR, "check_type_of_stbl_list: Parameter was already declared as Call-By-Value");
		}
		stbllist = help->next;
		free (help);
	}

	return;
}



Types *
typeadd(ptypes)
	Types	*ptypes;
{
	Types	*newtype;
	Types	*help;
	
#ifdef SYMBTBLDEBUG
	printf ("typeadd (->%d)\n", ptypes->typenr);
#endif

					/*
					 * Speicherplatz holen
					 */
	if ((newtype = (Types *) malloc (sizeof (Types))) == NULL) {
		message (D_INTERNAL, "typeadd: No more memory for Types");
	}

	*newtype = *ptypes;

	newtype->typenr = ++maxtypenr;
	
	help = typelist;
	typelist = newtype;
	newtype->nexttype = help;

	return (newtype);
}


SymbTblEntry *
unsigned_const_stbltyp(l)
	long	l;
{					/*
					 * Maschinenabhngige Lngen
					 * fr short, int und long
					 * werden bercksichtigt
					 */
	SymbTblEntry	*help;

#ifdef SYMBTBLDEBUG
	printf ("unsigned_const_stbltyp (%lu)\n", ((unsigned long) l));
#endif

	if (((unsigned long) l) <= ((unsigned long) 255L)) {	/* byte */
		if ((help = symbtbllookup ("byte")) == NULL) {
			message (D_FATAL, "unsigned_const_stbltyp: Byte-Type not found");
		}
		return (help);
	}

	if (l < 0L) {
		if (sizeof (unsigned) < sizeof (unsigned long)) {
								/* long card */
			if ((help = symbtbllookup ("longcard")) == NULL) {
				message (D_FATAL, "unsigned_const_stbltyp: Longcard-Type not found");
			}
		} else {					/* card */
			if ((help = symbtbllookup ("card")) == NULL) {
				message (D_FATAL, "unsigned_const_stbltyp: Card-Type not found");
			}
		}
		return (help);
	}

	if (l <= ((long) m0_maxshortint)) {			/* positive short int */
		if ((help = symbtbllookup ("POSITIVESHORTINT")) == NULL) {
			message (D_FATAL, "unsigned_const_stbltyp: Positive Shortint-Type not found");
		}
		return (help);
	}

	if (sizeof (int) == sizeof (unsigned short)) { /* MAXINT < MAXSHORTCARD */
		if (l <= ((long) m0_maxint)) {			/* positive int */
			if ((help = symbtbllookup ("POSITIVEINT")) == NULL) {
				message (D_FATAL, "unsigned_const_stbltyp: Positive Int-Type not found");
			}
			return (help);
		}
	}

	if (l <= ((long) m0_maxshortcard)) {			/* short card */
		if ((help = symbtbllookup ("shortcard")) == NULL) {
			message (D_FATAL, "unsigned_const_stbltyp: Shortcard-Type not found");
		}
		return (help);
	}

	if (l <= ((long) m0_maxint)) {				/* positive int */
		if ((help = symbtbllookup ("POSITIVEINT")) == NULL) {
			message (D_FATAL, "unsigned_const_stbltyp: Positive Int-Type not found");
		}
		return (help);
	}
	
	if (l <= ((long) m0_maxcard)) {			/* card */
		if ((help = symbtbllookup ("card")) == NULL) {
			message (D_FATAL, "unsigned_const_stbltyp: Card-Type not found");
		}
		return (help);
	}
								/* long int */
	if ((help = symbtbllookup ("longint")) == NULL) {
		message (D_FATAL, "unsigned_const_stbltyp: Longint-Type not found");
	}
	return (help);
}


int
negative_stbltyp(pstbl)
	SymbTblEntry	*pstbl;
{
#ifdef SYMBTBLDEBUG
	printf ("negative_stbltyp (->\"%s\")\n", pstbl->id);
#endif

	if (   (strcmp (pstbl->id, "shortint") == 0)
	    || (strcmp (pstbl->id, "integer") == 0)
	    || (strcmp (pstbl->id, "longint") == 0)
	    || (strcmp (pstbl->id, "shortreal") == 0)
	    || (strcmp (pstbl->id, "real") == 0)
	    || (strcmp (pstbl->id, "longreal") == 0)) {
		return (1);
	}
	return (0);
}


SymbTblEntry *
negative_const_stbltyp(pstbl)
	SymbTblEntry	*pstbl;
{
	SymbTblEntry	*help;

#ifdef SYMBTBLDEBUG
	printf ("negative_const_stbltyp (->\"%s\")\n", pstbl->id);
#endif

	if (negative_stbltyp (pstbl)) {
		return (pstbl);
	}
	
	if (strcmp (pstbl->id, "longcard") == 0) {
		message (D_FATAL, "negative_const_stbltyp: Negative Type of Longcard doesn't exist");
	}

	if (strcmp (pstbl->id, "card") == 0) {
		if (sizeof (unsigned) < sizeof (long)) {
			goto li;
		} else {
			message (D_FATAL, "negative_const_stbltyp: Negative Type of Card doesn't exist");
		}
	}

	if (strcmp (pstbl->id, "shortcard") == 0) {
		if (sizeof (unsigned short) < sizeof (int)) {
			goto i;
		} else {
			goto li;
		}
	}

	if ((strcmp (pstbl->id, "byte") == 0) ||
	    (strcmp (pstbl->id, "POSITIVESHORTINT") == 0)) {
		goto si;
	}

	if (strcmp (pstbl->id, "POSITIVEINT") == 0) {
		goto i;
	}

	message (D_FATAL, "negative_const_stbltyp: Type '%s' unknown in this procedure", pstbl->id);

si:								/* short int */
	if ((help = symbtbllookup ("shortint")) == NULL) {
		message (D_FATAL, "negative_const_stbltyp: Shortint-Type not found");
	}
	return (help);

i:								/* int */
	if ((help = symbtbllookup ("int")) == NULL) {
		message (D_FATAL, "negative_const_stbltyp: Int-Type not found");
	}
	return (help);
	
li:								/* long int */
	if ((help = symbtbllookup ("longint")) == NULL) {
		message (D_FATAL, "negative_const_stbltyp: Longint-Type not found");
	}
	return (help);
}




SymbTblEntry *
mintype(pstbl1, pstbl2)
	SymbTblEntry	*pstbl1, *pstbl2;
{					/*
					 * Gibt den Symboltabellen-Eintrag
					 * mit dem minimalen Typ zurck,
					 * d. h. mit dem Typ, der die
					 * Schnittmenge der TypArten angibt.
					 * Fehlermeldung, falls disjunkte
					 * TypArten vorhanden sind!
					 */
	TypeArt	t1, t2;

#ifdef SYMBTBLDEBUG
	printf ("mintype (->\"%s\", ->\"%s\")\n", pstbl1->id, pstbl2->id);
#endif
	
	if (lookforgentype (pstbl1) == lookforgentype (pstbl2)) {
		return (pstbl1);
	}

	t1 = lookforgentypeart (pstbl1);
	t2 = lookforgentypeart (pstbl2);

	if (! (t1.is_array || t1.is_record || t1.is_pointer || t2.is_array || t2.is_record || t2.is_pointer)) {
		if ((t1.is_shortint && t1.is_shortcard && ! t1.is_integer)
		   || (t1.is_integer && t1.is_cardinal && ! t1.is_longint)) {
			if (t2.is_shortint) {
				t1.is_shortcard = t1.is_cardinal = t1.is_longcard = 0;
			}
			if (t2.is_shortcard) {
				t1.is_shortint = t1.is_integer = t1.is_longint = 0;
			}
		}
		if ((t2.is_shortint && t2.is_shortcard && ! t2.is_integer)
		   || (t2.is_integer && t2.is_cardinal && ! t2.is_longint)) {
			if (t1.is_shortint) {
				t2.is_shortcard = t2.is_cardinal = t2.is_longcard = 0;
			}
			if (t1.is_shortcard) {
				t2.is_shortint = t2.is_integer = t2.is_longint = 0;
			}
		}
		if (*(long *)&t1 == (*(long *)&t1 & *(long *)&t2)) {		/* ACHTUNG ACHTUNG ACHTUNG */
			return (pstbl1);
		}

		if (*(long *)&t2 == (*(long *)&t1 & *(long *)&t2)) {		/* ACHTUNG ACHTUNG ACHTUNG */
			return (pstbl2);
		}
	}

	message (D_ERROR, "mintype: Type ('%s') not compatible with Type ('%s')", pstbl1->id, pstbl2->id);
	return (NULL);
}


SymbTblEntry *
maxtype(pstbl1, pstbl2)
	SymbTblEntry	*pstbl1, *pstbl2;
{					/*
					 * Gibt den Symboltabellen-Eintrag
					 * mit dem maximalen Typ zurueck,
					 * d. h. mit dem Typ, der die Ver-
					 * einigungsmenge der TypArten angibt.
					 * Fehlermeldung, falls disjunkte
					 * TypArten vorhanden sind!
					 */
	TypeArt	t1, t2;

#ifdef SYMBTBLDEBUG
	printf ("maxtype (->\"%s\", ->\"%s\")\n", pstbl1->id, pstbl2->id);
#endif
	
	if (lookforgentype (pstbl1) == lookforgentype (pstbl2)) {
		return (pstbl1);
	}

	t1 = lookforgentypeart (pstbl1);
	t2 = lookforgentypeart (pstbl2);

	if (! (t1.is_array || t1.is_record || t1.is_pointer || t2.is_array || t2.is_record || t2.is_pointer)) {
		if ((t1.is_shortint && t1.is_shortcard && ! t1.is_integer)
		   || (t1.is_integer && t1.is_cardinal && ! t1.is_longint)) {
			if (t2.is_shortint) {
				t1.is_shortcard = t1.is_cardinal = t1.is_longcard = 0;
			}
			if (t2.is_shortcard) {
				t1.is_shortint = t1.is_integer = t1.is_longint = 0;
			}
		}
		if ((t2.is_shortint && t2.is_shortcard && ! t2.is_integer)
		   || (t2.is_integer && t2.is_cardinal && ! t2.is_longint)) {
			if (t1.is_shortint) {
				t2.is_shortcard = t2.is_cardinal = t2.is_longcard = 0;
			}
			if (t1.is_shortcard) {
				t2.is_shortint = t2.is_integer = t2.is_longint = 0;
			}
		}
		if (*(long *)&t1 == (*(long *)&t1 | *(long *)&t2)) {		/* ACHTUNG ACHTUNG ACHTUNG */
			return (pstbl1);
		}

		if (*(long *)&t2 == (*(long *)&t1 | *(long *)&t2)) {		/* ACHTUNG ACHTUNG ACHTUNG */
			return (pstbl2);
		}
	}

	message (D_ERROR, "maxtype: Type ('%s') not compatible with Type ('%s')", pstbl1->id, pstbl2->id);
	return (NULL);
}


SymbTblEntry *
lookforgentype(pstbl)
	SymbTblEntry	*pstbl;
{
	SymbTblEntry	*p;
	IdArt		idart;

#ifdef SYMBTBLDEBUG
	printf ("lookforgentype (->\"%s\")\n", pstbl->id);
#endif

	for (p = pstbl; p; p = p->ofstblentry) {
		if (p->iart.is_generictype)
			return (p);
	}
		
	message (D_ERROR, "lookforgentype: Type-Entry of Symbtbl-Entry '%s' not found; INTEGER-Type assumed", pstbl->id);
	setidart (is_generictype);
	if ((pstbl->ofstblentry = p = symbtbllookupwithinidart ("integer", idart)) == NULL) {
		message (D_FATAL, "lookforgentype: INTEGER-Type not found");
	}
	return (p);
}


TypeArt
lookforgentypeart(pstbl)
	SymbTblEntry	*pstbl;
{
	SymbTblEntry	*p;

#ifdef SYMBTBLDEBUG
	printf ("lookforgentypeart (->\"%s\")\n", pstbl->id);
#endif

	p = lookforgentype (pstbl);
	return (p->u.oftype->tart);
}


char
*look_for_filename(fn)
	char	*fn;			/*
					 * Sucht einen File-Namen in der Liste
					 * und gibt den Pointer auf den
					 * gefundenen Namen zurck bzw. NULL
					 */
{
	FileNames	*help;

#ifdef SYMBTBLDEBUG
	printf ("look_for_filename (\"%s\")\n", fn);
#endif

	help = filenames;

	while (help != NULL) {
		if (strcmp (fn, help->name) == 0) {
			return (help->name);
		}
		help = help->next;
	}
	return (NULL);
}


char
*add_filename(fn)
	char	*fn;			/*
					 * Trgt einen neuen File-Namen
					 * am Ende der Liste ein und gibt
					 * einen Pointer auf den gesicherten
					 * Namen zurck
					 */
{
	FileNames	**help;
	char	*pc;

#ifdef SYMBTBLDEBUG
	printf ("add_filename (\"%s\")\n", fn);
#endif

	if ((pc = look_for_filename (fn)) != NULL) {
		message (D_WARN, "add_filename: Filename '%s' already exists in List", fn);
		return (pc);
	}

	help = &filenames;

	while (*help != NULL) {
		help = &(*help)->next;
	}
					/*
					 * Speicherplatz holen
					 */
	if ((*help = (FileNames *) malloc (sizeof (FileNames))) == NULL) {
		message (D_INTERNAL, "add_filename: No more memory for FileNames");
	}
	(*help)->next = NULL;
	return ((*help)->name = strsave (fn));
}


void
search_for_undeclared_events()
{
	int	i;
	SymbTblEntry	*help;
	
#ifdef SYMBTBLDEBUG
	printf ("search_for_undeclared_events ()\n");
#endif
	for (i = 0; i < D_SYMBPRIM; i++) {
		help = hashlist [i];
		while (help) {
			if (help->iart.is_interruptid) {
				message (D_ERROR, "search_for_undeclared_events: Event to corresponding Interrupt '%s' not declared", help->id);
			}
			help = help->next;
		}
	}
	

	return;
}


void
show_symbtbl()
{
	int	i,
		cnt;
	SymbTblEntry	*help,
			*gentype,
			*nxtfldorpar;
	TypeArt		intvalart,
			realvalart;
	IdArt		nogentype,
			formalparamproceduretype;

#ifdef SYMBTBLDEBUG
	printf ("show_symbtbl ()\n");
#endif
/*
	memset ((char *) &intvalart, 0, sizeof (TypeArt));
	memset ((char *) &realvalart, 0, sizeof (TypeArt));
*/

	intvalart.is_byte = intvalart.is_char
			= intvalart.is_cardinal = intvalart.is_integer
			= intvalart.is_longcard = intvalart.is_longint
			= intvalart.is_shortcard = intvalart.is_shortint
			= intvalart.is_enumeration = intvalart.is_subrange
			= 1;

	realvalart.is_real = realvalart.is_longreal
			= realvalart.is_shortreal
			= 1;
/*
	memset ((char *) &nogentype, 0, sizeof (IdArt));
*/

	nogentype.is_eventid = nogentype.is_interruptid
			= nogentype.is_moduleid
			= nogentype.is_monitorid
			= 1;

/*
	memset ((char *) &formalparamproceduretype, 0, sizeof (IdArt));
*/

	formalparamproceduretype.is_procedureid
			= formalparamproceduretype.is_entryid
			= formalparamproceduretype.is_processid
			= formalparamproceduretype.is_communicationid
			= 1;
			

	c_out ("/*\nSymboltabelle:\n");
	c_out ("==============");

	for (i = 0; i < D_SYMBPRIM; i++) {
		help = hashlist [i];
		while (help) {
			c_out ("\n'%s': Static Level:%2d, Status:%2X, IdArt: %5X, HashKl: %3d, EntryNr:%4d\n",
				help->id,
				help->staticlevel,
				*(int *) &help->status, /* ACHTUNG ACHTUNG ACHTUNG */
				*(int *) &help->iart, /* ACHTUNG ACHTUNG ACHTUNG */
				i,
				help->entrynr);
			if (help->id[0] >= 'A' && help->id[0] <= 'Z') {
				c_out ("\tInterner Hilfseintrag\n");
			} else {
				c_out ("\tC-Id: '");
				if (help->status.is_external) {
					c_out ("m0_%s'", help->id);
				} else {
					c_out ("m%d_%s'", help->ofblock->nr, help->id);
				}
				if (help->iart.is_recordfieldid || help->iart.is_recordcaseid) {
					c_out (" bei With-Statements");
				}
				c_out_lf ();
			}
			if (help->next)
				c_out ("\tNext-Id: '%s'\n", help->next->id);
			if (help->prev)
				c_out ("\tPrev-Id: '%s'\n", help->prev->id);
			if (help->ofblock)
				c_out ("\tIm Block: '%s', Blocknr.:%3d\n", help->ofblock->id, help->ofblock->nr);
			if (help->iart.is_constid
			   || help->iart.is_varid
			   || help->iart.is_typeid
			   || help->iart.is_procedureid
			   || help->iart.is_parameter
			   || help->iart.is_entryid) {
			   	if (help->ofstblentry != NULL) {
					c_out ("\tVom Typ: '%s'\n", help->ofstblentry->id);
				}
			}
			if (help->iart.is_parameter) {
				if (help->u.nextfldorpar)
					c_out ("\tNaechster Parameter-Name: '%s'", help->u.nextfldorpar->id);
				else
					c_out ("\tIst letzter Parameter");
				if (help->iart.is_callbyreference)
					c_out ("\t(Call-by-Reference-Parameter)");
				c_out_lf ();
			}
			if ((help->iart.is_procedureid || help->iart.is_entryid || help->iart.is_processid || help->iart.is_communicationid) && ! help->iart.is_generictype) {
					/* Ausgabe der Formal-Parameter-Namen */
				nxtfldorpar = help->u.nextfldorpar;
				cnt = 0;
				while (nxtfldorpar) {
					if (cnt == 0)
						c_out ("\tParameter-Namen:");
					else
						c_out (",");
					c_out (" %s", nxtfldorpar->id);
					nxtfldorpar = nxtfldorpar->u.nextfldorpar;
					cnt++;
				}
				if (cnt)
					c_out_lf ();
				c_out ("\tAnzahl Formal-Parameter: %d\n", cnt);
			}
			if (help->iart.is_generictype && help->u.oftype && help->u.oftype->tart.is_record) {
					/* Ausgabe der Record-Feldnamen */
				nxtfldorpar = help->u.oftype->indextype;
				cnt = 0;
				while (nxtfldorpar) {
					if (cnt == 0)
						c_out ("\tRecord-Feldnamen:");
					else
						c_out (",");
					c_out (" %s", nxtfldorpar->id);
					nxtfldorpar = nxtfldorpar->u.nextfldorpar;
					cnt++;
				}
				if (cnt)
					c_out_lf ();
			}
			if (help->iart.is_generictype)
				c_out ("\tTypNr:%4d\n", help->u.oftype->typenr);
			if ( ! (*(long *)&help->iart & *(long *)&nogentype)) {				/* ACHTUNG ACHTUNG ACHTUNG */
				gentype = lookforgentype (help);
				c_out ("\tGenerischer Typ: '%s', TypNr:%4d\n", gentype->id, gentype->u.oftype->typenr);
				if (help->iart.is_constid) {
					if (strcmp (gentype->id, "STRING") == 0) {
						c_out ("\tWert: \"%s\"\n", help->u.sv);
					} else if (gentype->u.oftype->tart.is_boolean) {
						if (help->u.lv == 0) {
							c_out ("\tWert: 'FALSE'\n");
						} else {
							c_out ("\tWert: 'TRUE'\n");
						}
					} else if (gentype->u.oftype->tart.is_char) {
							c_out ("\tWert: '%c'\n", (char) help->u.lv);
					} else if (*(long *)&gentype->u.oftype->tart & *(long *)&intvalart) {			/* ACHTUNG ACHTUNG ACHTUNG */
						c_out ("\tWert signed: %ld, Wert unsigned: %lu, Wert hexa: %lX\n",
							help->u.lv, (unsigned long) help->u.lv, help->u.lv);
					} else if (*(long *)&gentype->u.oftype->tart & *(long *)&realvalart) {			/* ACHTUNG ACHTUNG ACHTUNG */
						c_out ("\tWert: %lf\n", help->u.dv);
					}
				} else if (help->iart.is_eventid || help->iart.is_interruptid) {
					c_out ("\tInterrupt-Nummer: %ld\n", help->u.lv);
				}
			}

			help = help->next;
		}
	}
	
	c_out ("\nFreelist:\n");
	c_out ("=========\n");

	help = freelist;
	while (help) {
		c_out ("EntryNr:%4d, Id: '%s'\n", help->entrynr, help->id);

		help = help->next;
	}
	c_out ("*/");
	c_out_lineno ();

	return;
}


void
show_types()
{
	Types	*help;
	TypeArt	minmaxvalart;
	TypeArt	cardvalart;

#ifdef SYMBTBLDEBUG
	printf ("show_types ()\n");
#endif
	memset ((char *) &minmaxvalart, 0, sizeof (TypeArt));
	memset ((char *) &cardvalart, 0, sizeof (TypeArt));
	
	minmaxvalart.is_byte = minmaxvalart.is_char
			= minmaxvalart.is_cardinal
			= minmaxvalart.is_integer
			= minmaxvalart.is_longcard
			= minmaxvalart.is_longint
			= minmaxvalart.is_shortcard
			= minmaxvalart.is_shortint
			= minmaxvalart.is_enumeration
			= minmaxvalart.is_subrange
			= minmaxvalart.is_array
			= minmaxvalart.is_set
			= 1;
			
	cardvalart.is_cardinal = cardvalart.is_longcard
			= cardvalart.is_shortcard
			= 1;

	c_out ("/*\nTypen:\n");
	c_out ("======\n");

	for (help = typelist; help; help = help->nexttype) {
		c_out ("TypeNr:%4d, TypArt: 0x%08lX\n", help->typenr, *(long *) &help->tart); /* ACHTUNG ACHTUNG ACHTUNG */
		if (help->tart.is_boolean) {
			c_out ("\tMinimum: FALSE, Maximum: TRUE\n");
		} else if (*(long *)&help->tart & *(long *)&minmaxvalart) {					/* ACHTUNG ACHTUNG ACHTUNG */
			if (*(long *)&help->tart & *(long *)&cardvalart) {					/* ACHTUNG ACHTUNG ACHTUNG */
				c_out ("\tMinimum: %lu, Maximum: %lu\n", help->minval, help->maxval);
			} else {
				c_out ("\tMinimum: %ld, Maximum: %ld", help->minval, help->maxval);
				if (help->minval == help->maxval && help->maxval == 0) {
					c_out (" (possibly OPEN ARRAY)");
				}
				c_out ("\n");
			}
		}
		if (help->dimension != 0) {
			c_out ("\tDimension: %ld, Array-Index vom Typ '%s' (Nr. %ld)\n", help->dimension, help->indextype->id, help->indextype->u.oftype->typenr);
		}
		if (help->tart.is_array || help->tart.is_pointer) {
			c_out ("\tVom Typ '%s' (Nr. %ld)\n", help->oftype->id, help->oftype->u.oftype->typenr);
		}
	}
	c_out ("*/");
	c_out_lineno ();

	return;
}


void
show_blocklist(btype)
	BlockType	btype;
{
	BlockList	*blisthelp;
	SymbTblEntry	*help;

#ifdef SYMBTBLDEBUG
	printf ("show_blocklist ()\n");
#endif

	c_out ("/*\nBlockliste:\n");
	c_out ("===========\n");

	blisthelp = blocklist;

	while (blisthelp) {
		if (btype == (BlockType) 0 || btype == blisthelp->type) {
			switch (blisthelp->type) {
			default:
				c_out ("Unbekannter Blocktyp (Nr.: %d)", blisthelp->type);
				break;
			case e_FILE:
				c_out ("File");
				break;
			case e_MODULE:
				c_out ("Module");
				break;
			case e_PROCEDURE:
				c_out ("Procedure");
				break;
			case e_EVENT:
				c_out ("Event");
				break;
			case e_PROCESS:
				c_out ("Process:");
				break;
			case e_EXCEPTION:
				c_out ("Exception");
				break;
			case e_COMMUNICATION:
				c_out ("Communication");
				break;
			case e_MONITOR:
				c_out ("Monitor");
				break;
			case e_ENTRY:
				c_out ("Entry");
				break;
			case e_BODY:
				c_out ("Body");
				break;
			case e_WITH:
				c_out ("With");
				break;
			}

			c_out ("-Block Nr. %d:", blisthelp->nr);

			if (blisthelp->id != NULL) {
				c_out (" '%s'", blisthelp->id);
			}

			c_out (":\n");

			if (blisthelp->type == e_BODY && blisthelp->retcount) {
				c_out ("\tAnzahl bis jetzt erkannter Return-Statements: %d\n", blisthelp->retcount);
			}
			
			help = blisthelp->stbllist;

			while (help != NULL) {
				c_out ("\t%s\n", help->id);
				help = help->nextinblock;
			}
		}

		blisthelp = blisthelp->nextblocklist;
	}

	c_out ("*/");
	c_out_lineno ();

	return;
}


void
show_filenames()
{
	FileNames	*help;

#ifdef SYMBTBLDEBUG
	printf ("show_filenames ()\n");
#endif
	c_out ("/*\nFile-Namen:\n");
	c_out ("===========\n");

	help = filenames;

	while (help != NULL) {
		c_out ("%s\n", help->name);
		help = help->next;
	}

	c_out ("*/");
	c_out_lineno ();

	return;
}


int
newblock(idart)
	IdArt	idart;
{
#ifdef SYMBTBLDEBUG
	printf ("newblock (0x%X)\n", *(int *) &idart); /* ACHTUNG ACHTUNG ACHTUNG */
#endif

	return ((int) ( idart.is_communicationid ||
			idart.is_entryid ||
			idart.is_eventid ||
			idart.is_moduleid ||
			idart.is_monitorid ||
			idart.is_procedureid ||
			idart.is_processid
		)
	);
}


void
initprecompiler()
{
	SymbTblEntry	*help;
	char		aname[40];
					/*
					 * Typen fuer Standard-Prozedur-Parameter
					 */
	SymbTblEntry	*type_boolean,
			*type_byte,
			*type_arr_of_char,
			*type_char,
			*type_integer,
			*type_longcard,
			*type_longint,
			*type_longreal,
			*type_real;
					/*
					 * Standard-Prozedur-Parameter
					 */
	SymbTblEntry	*last_param_boolean,
			*last_param_byte,
			*last_param_char,
			*last_var_param_char,
			*last_param_arr_of_char,
			*last_var_param_arr_of_char,
			*last_param_longcard,
			*last_var_param_longcard,
			*last_param_longint,
			*last_var_param_longint,
			*last_param_longreal,
			*last_var_param_longreal,
			*param_boolean_before_last_param_byte,
			*param_byte_before_last_param_byte,
			*param_longcard_before_last_param_byte,
			*param_longint_before_last_param_byte,
			*param_longreal_before_last_param_byte,
			*param_longreal_before_last_param_longreal,
			*param_longreal_before_param_byte_before_last_param_byte;
			
#ifdef SYMBTBLDEBUG
	printf ("initprecompiler ()\n");
#endif
	memset ((char *) hashlist, 0, sizeof (hashlist));

				/*
				 * Reservierte Typnamen und Konstanten werden
				 * in die Symboltabelle eingetragen
				 */

					/*
					 * Deklaration des Datentyps CHAR
					 *
					 * CHAR muss vor STRING und OPEN ARRAY OF CHAR definiert werden !
					 */
	type_char = help = symbtbladd ("char");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_char = typevar.tart.is_subrange = 1;
	typevar.minval = 0;
	typevar.maxval = 255;
	help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);

	
					/*
					 * Deklaration des internen Datentyps STRING
					 *
					 * CHAR muss vor STRING definiert werden !
					 */
	help = symbtbladd ("STRING");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_char = typevar.tart.is_array = 1;
	typevar.oftype = type_char;
	help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des internen Datentyps POSITIVEINT
					 *
					 * POSITIVEINT muss vor OPEN ARRAY OF CHAR definiert werden !
					 */
	help = symbtbladd ("POSITIVEINT");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_integer = typevar.tart.is_shortint
		= typevar.tart.is_cardinal = typevar.tart.is_shortcard
		= typevar.tart.is_byte = typevar.tart.is_subrange = 1;
	typevar.minval = 0;
	typevar.maxval = m0_maxint;
	help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps OPEN ARRAY OF CHAR
					 *
					 * CHAR und POSITIVEINT muessen vor OPEN ARRAY OF CHAR definiert werden !
					 */
	sprintf (aname, "_openarray_of_0x%ld", type_char->u.oftype->typenr);

	type_arr_of_char = help = symbtbladd (aname);
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_array = 1;
	typevar.dimension = 1;
	typevar.oftype = type_char;
	help->iart.is_typeid = help->iart.is_generictype = help->iart.is_openarrayparam = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	if ((typevar.indextype = symbtbllookup ("POSITIVEINT")) == NULL) {
		message (D_FATAL, "initprecompiler: POSITIVEINT-Type not found");
	}
	help->u.oftype = typeadd (&typevar);

	c_out ("typedef struct\tm0_%s {char *a;} m0_%s;\n", aname, aname);


					/*
					 * Deklaration des internen Datentyps POSITIVESHORTINT
					 */
	help = symbtbladd ("POSITIVESHORTINT");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_shortint = typevar.tart.is_shortcard
		= typevar.tart.is_byte = typevar.tart.is_subrange = 1;
	typevar.minval = 0;
	typevar.maxval = m0_maxshortint;
	help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps BOOLEAN
					 */
	type_boolean = help = symbtbladd ("boolean");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_boolean = typevar.tart.is_subrange = 1;
	typevar.minval = m0_false;
	typevar.maxval = m0_true;
	help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps BYTE
					 */
	type_byte = help = symbtbladd ("byte");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_byte = typevar.tart.is_subrange = 1;
	typevar.minval = 0;
	typevar.maxval = 255;
	help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps CARDINAL
					 */
	help = symbtbladd ("cardinal");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_cardinal = typevar.tart.is_shortcard = typevar.tart.is_byte = typevar.tart.is_subrange = 1;
	typevar.minval = m0_mincard;
	typevar.maxval = m0_maxcard;
	help->iart.is_procedureid = help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps COMPUTER
					 */
	help = symbtbladd ("computer");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_computer = 1;
	help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps CONDITION
					 */
	help = symbtbladd ("condition");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_condition = 1;
	help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps INTEGER
					 */
	type_integer = help = symbtbladd ("integer");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_integer = typevar.tart.is_shortint = typevar.tart.is_byte = typevar.tart.is_subrange = 1;
	if (sizeof (int) > sizeof (unsigned short)) {
		typevar.tart.is_shortcard =  1;
	}
	typevar.minval = m0_minint;
	typevar.maxval = m0_maxint;
	help->iart.is_procedureid = help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps LONGCARD
					 */
	type_longcard = help = symbtbladd ("longcard");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_longcard = typevar.tart.is_cardinal = typevar.tart.is_shortcard
				 = typevar.tart.is_byte = typevar.tart.is_subrange = 1;
	typevar.minval = m0_minlongcard;
	typevar.maxval = m0_maxlongcard;
	help->iart.is_procedureid = help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps LONGINT
					 */
	type_longint = help = symbtbladd ("longint");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_longint = typevar.tart.is_integer = typevar.tart.is_shortint
				= typevar.tart.is_byte = typevar.tart.is_subrange = 1;
	if (sizeof (long) > sizeof (unsigned short)) {
		typevar.tart.is_shortcard =  1;
	}
	if (sizeof (long) > sizeof (unsigned)) {
		typevar.tart.is_cardinal =  1;
	}
	typevar.minval = m0_minlongint;
	typevar.maxval = m0_maxlongint;
	help->iart.is_procedureid = help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps LONGREAL
					 */
	type_longreal = help = symbtbladd ("longreal");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_longreal = typevar.tart.is_real = typevar.tart.is_shortreal = 1;
	help->iart.is_procedureid = help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps REAL
					 */
	type_real = help = symbtbladd ("real");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_real = typevar.tart.is_shortreal = 1;
	help->iart.is_procedureid = help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps SEMAPHORE
					 */
	help = symbtbladd ("semaphore");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_semaphore = 1;
	help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps SHORTCARD
					 */
	help = symbtbladd ("shortcard");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_shortcard = typevar.tart.is_byte = typevar.tart.is_subrange = 1;
	typevar.minval = m0_minshortcard;
	typevar.maxval = m0_maxshortcard;
	help->iart.is_procedureid = help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps SHORTINT
					 */
	help = symbtbladd ("shortint");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_shortint = typevar.tart.is_byte = typevar.tart.is_subrange = 1;
	typevar.minval = m0_minshortint;
	typevar.maxval = m0_maxshortint;
	help->iart.is_procedureid = help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps SHORTREAL
					 */
	help = symbtbladd ("shortreal");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_shortreal = 1;
	help->iart.is_procedureid = help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps VOID
					 */
	voidstblentry = help = symbtbladd ("void");
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_void = 1;
	help->iart.is_generictype = 1;
	help->status.is_predeclared = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration des Datentyps POINTER
					 */
	memset ((char *) &typevar, 0, sizeof (typevar));
	typevar.tart.is_pointer = 1;
	typevar.oftype = help;	/* Vom Typ VOID */
	help = symbtbladd ("pointer");
	help->iart.is_typeid = help->iart.is_generictype = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = help;
	help->u.oftype = typeadd (&typevar);


					/*
					 * Deklaration von Konstanten:
					 * In Gross-Schrift: Precompilerkonst.
					 * In Kleinschrift: Modula-P-Konst.
					 */
					/*
					 *	minint
					 */
	help = symbtbladd ("minint");
	help->iart.is_constid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = symbtbllookup ("integer");
	help->u.lv = m0_minint;
					/*
					 *	maxint
					 */
	help = symbtbladd ("maxint");
	help->iart.is_constid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = symbtbllookup ("integer");
	help->u.lv = m0_maxint;
					/*
					 *	mincard
					 */
	help = symbtbladd ("mincard");
	help->iart.is_constid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = symbtbllookup ("cardinal");
	help->u.lv = m0_mincard;
					/*
					 *	maxcard
					 */
	help = symbtbladd ("maxcard");
	help->iart.is_constid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = symbtbllookup ("cardinal");
	help->u.lv = m0_maxcard;
					/*
					 *	minlongint
					 */
	help = symbtbladd ("minlongint");
	help->iart.is_constid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = symbtbllookup ("integer");
	help->u.lv = m0_minlongint;
					/*
					 *	maxlongint
					 */
	help = symbtbladd ("maxlongint");
	help->iart.is_constid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = symbtbllookup ("integer");
	help->u.lv = m0_maxlongint;
					/*
					 *	minlongcard
					 */
	help = symbtbladd ("minlongcard");
	help->iart.is_constid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = symbtbllookup ("cardinal");
	help->u.lv = m0_minlongcard;
					/*
					 *	maxlongcard
					 */
	help = symbtbladd ("maxlongcard");
	help->iart.is_constid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = symbtbllookup ("cardinal");
	help->u.lv = m0_maxlongcard;
					/*
					 *	minshortint
					 */
	help = symbtbladd ("minshortint");
	help->iart.is_constid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = symbtbllookup ("integer");
	help->u.lv = m0_minshortint;
					/*
					 *	maxshortint
					 */
	help = symbtbladd ("maxshortint");
	help->iart.is_constid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = symbtbllookup ("integer");
	help->u.lv = m0_maxshortint;
					/*
					 *	minshortcard
					 */
	help = symbtbladd ("minshortcard");
	help->iart.is_constid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = symbtbllookup ("cardinal");
	help->u.lv = m0_minshortcard;
					/*
					 *	maxshortcard
					 */
	help = symbtbladd ("maxshortcard");
	help->iart.is_constid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = symbtbllookup ("cardinal");
	help->u.lv = m0_maxshortcard;
					/*
					 *	false
					 */
	help = symbtbladd ("false");
	help->iart.is_constid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = symbtbllookup ("boolean");
	help->u.lv = m0_false;
					/*
					 *	true
					 */
	help = symbtbladd ("true");
	help->iart.is_constid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = symbtbllookup ("boolean");
	help->u.lv = m0_true;
					/*
					 *	nil
					 */
	help = symbtbladd ("nil");
	help->iart.is_constid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = symbtbllookup ("pointer");
	help->u.lv = (long) m0_nil;


					/*
					 * Deklaration der Prozedur-Parameter
					 * von Standardfunktionen
					 */
	last_param_boolean = help = symbtbladd ("LAST_PARAM_BOOLEAN");
	help->iart.is_parameter = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_boolean;
	help->u.nextfldorpar = NULL;

	
	last_param_byte = help = symbtbladd ("LAST_PARAM_BYTE");
	help->iart.is_parameter = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_byte;
	help->u.nextfldorpar = NULL;

	
	last_param_char = help = symbtbladd ("LAST_PARAM_CHAR");
	help->iart.is_parameter = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_char;
	help->u.nextfldorpar = NULL;

	
	last_var_param_char = help = symbtbladd ("LAST_VAR_PARAM_CHAR");
	help->iart.is_parameter = help->iart.is_callbyreference = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_char;
	help->u.nextfldorpar = NULL;

	
	last_param_arr_of_char = help = symbtbladd ("LAST_PARAM_ARR_OF_CHAR");
	help->iart.is_parameter = help->iart.is_openarrayparam = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_arr_of_char;
	help->u.nextfldorpar = NULL;

	
	last_var_param_arr_of_char = help = symbtbladd ("LAST_VAR_PARAM_ARR_OF_CHAR");
	help->iart.is_parameter = help->iart.is_callbyreference = help->iart.is_openarrayparam = 1;
	help->iart.is_callbyreference = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_arr_of_char;
	help->u.nextfldorpar = NULL;

	
	last_param_longcard = help = symbtbladd ("LAST_PARAM_LONGCARD");
	help->iart.is_parameter = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longcard;
	help->u.nextfldorpar = NULL;

	
	last_var_param_longcard = help = symbtbladd ("LAST_VAR_PARAM_LONGCARD");
	help->iart.is_parameter = help->iart.is_callbyreference = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longcard;
	help->u.nextfldorpar = NULL;

	
	last_param_longint = help = symbtbladd ("LAST_PARAM_LONGINT");
	help->iart.is_parameter = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longint;
	help->u.nextfldorpar = NULL;

	
	last_var_param_longint = help = symbtbladd ("LAST_VAR_PARAM_LONGINT");
	help->iart.is_parameter = help->iart.is_callbyreference = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longint;
	help->u.nextfldorpar = NULL;

	
	last_param_longreal = help = symbtbladd ("LAST_PARAM_LONGREAL");
	help->iart.is_parameter = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = NULL;

	
	last_var_param_longreal = help = symbtbladd ("LAST_VAR_PARAM_LONGREAL");
	help->iart.is_parameter = help->iart.is_callbyreference = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = NULL;

	param_boolean_before_last_param_byte = help = symbtbladd ("PARAM_BOOLEAN_BEFORE_LAST_PARAM_BYTE");
	help->iart.is_parameter = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_boolean;
	help->u.nextfldorpar = last_param_byte;

	
	param_byte_before_last_param_byte = help = symbtbladd ("PARAM_BYTE_BEFORE_LAST_PARAM_BYTE");
	help->iart.is_parameter = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_byte;
	help->u.nextfldorpar = last_param_byte;

	
	param_longcard_before_last_param_byte = help = symbtbladd ("PARAM_LONGCARD_BEFORE_LAST_PARAM_BYTE");
	help->iart.is_parameter = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longcard;
	help->u.nextfldorpar = last_param_byte;

	
	param_longint_before_last_param_byte = help = symbtbladd ("PARAM_LONGINT_BEFORE_LAST_PARAM_BYTE");
	help->iart.is_parameter = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longint;
	help->u.nextfldorpar = last_param_byte;

	
	param_longreal_before_last_param_byte = help = symbtbladd ("PARAM_LONGREAL_BEFORE_LAST_PARAM_BYTE");
	help->iart.is_parameter = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_byte;

	
	param_longreal_before_last_param_longreal = help = symbtbladd ("PARAM_LONGREAL_BEFORE_LAST_PARAM_LONGREAL");
	help->iart.is_parameter = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;

	
	param_longreal_before_param_byte_before_last_param_byte = help = symbtbladd ("PARAM_LONGREAL_BEFORE_PARAM_BYTE_BEFORE_LAST_PARAM_BYTE");
	help->iart.is_parameter = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = param_byte_before_last_param_byte;
	

					/*
					 * Declaration of standard procedures
					 */
					/*
					 * I/O- Procedures
					 */
					/*
					 *	closeinput
					 */
	help = symbtbladd ("closeinput");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = NULL;

					/*
					 *	closeoutput
					 */
	help = symbtbladd ("closeoutput");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = NULL;

					/*
					 *	done
					 */
	help = symbtbladd ("done");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_boolean;
	help->u.nextfldorpar = NULL;

					/*
					 *	openinput
					 */
	help = symbtbladd ("openinput");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = last_param_arr_of_char;

					/*
					 *	openoutput
					 */
	help = symbtbladd ("openoutput");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = last_param_arr_of_char;

					/*
					 *	read
					 */
	help = symbtbladd ("read");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = last_var_param_char;

					/*
					 *	readcard
					 */
	help = symbtbladd ("readcard");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = last_var_param_longcard;

					/*
					 *	readint
					 */
	help = symbtbladd ("readint");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = last_var_param_longint;

					/*
					 *	readreal
					 */
	help = symbtbladd ("readreal");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = last_var_param_longreal;

					/*
					 *	readstring
					 */
	help = symbtbladd ("readstring");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = last_var_param_arr_of_char;

					/*
					 *	write
					 */
	help = symbtbladd ("write");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = last_param_char;

					/*
					 *	writebool
					 */
	help = symbtbladd ("writebool");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = last_param_boolean;

					/*
					 *	writebool
					 */
	help = symbtbladd ("writeboolean");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = param_boolean_before_last_param_byte;

					/*
					 *	writecard
					 */
	help = symbtbladd ("writecard");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = param_longcard_before_last_param_byte;

					/*
					 *	writeficpt
					 */
	help = symbtbladd ("writefixpt");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = param_longreal_before_param_byte_before_last_param_byte;

					/*
					 *	writehex
					 */
	help = symbtbladd ("writehex");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = param_longint_before_last_param_byte;

					/*
					 *	writeint
					 */
	help = symbtbladd ("writeint");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = param_longint_before_last_param_byte;

					/*
					 *	writeln
					 */
	help = symbtbladd ("writeln");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = NULL;

					/*
					 *	writeoct
					 */
	help = symbtbladd ("writeoct");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = param_longint_before_last_param_byte;

					/*
					 *	writereal
					 */
	help = symbtbladd ("writereal");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = param_longreal_before_last_param_byte;

					/*
					 *	writestring
					 */
	help = symbtbladd ("writestring");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = voidstblentry;
	help->u.nextfldorpar = last_param_arr_of_char;

					/*
					 * math. functions
					 */
					/*
					 *	acos
					 */
	help = symbtbladd ("acos");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;
	
					/*
					 *	asin
					 */
	help = symbtbladd ("asin");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;
	
					/*
					 *	atan
					 */
	help = symbtbladd ("atan");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;
	
					/*
					 *	atan2
					 */
	help = symbtbladd ("atan2");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = param_longreal_before_last_param_longreal;
	
					/*
					 *	ceil
					 */
	help = symbtbladd ("ceil");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;
	
					/*
					 *	cos
					 */
	help = symbtbladd ("cos");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;
	
					/*
					 *	cosh
					 */
	help = symbtbladd ("cosh");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;
	
					/*
					 *	exp
					 */
	help = symbtbladd ("exp");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;
	
					/*
					 *	fabs
					 */
	help = symbtbladd ("fabs");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;
	
					/*
					 *	floor
					 */
	help = symbtbladd ("floor");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;
	
					/*
					 *	fmod
					 */
	help = symbtbladd ("fmod");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = param_longreal_before_last_param_longreal;
		
					/*
					 *	log
					 */
	help = symbtbladd ("log");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;
	
					/*
					 *	log10
					 */
	help = symbtbladd ("log10");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;

					/*
					 *	pow
					 */
	help = symbtbladd ("pow");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = param_longreal_before_last_param_longreal;
		
					/*
					 *	sin
					 */
	help = symbtbladd ("sin");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;
	
					/*
					 *	sinh
					 */
	help = symbtbladd ("sinh");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;
	
					/*
					 *	sqrt
					 */
	help = symbtbladd ("sqrt");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;
	
					/*
					 *	tan
					 */
	help = symbtbladd ("tan");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;
	
					/*
					 *	tanh
					 */
	help = symbtbladd ("tanh");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_longreal;
	help->u.nextfldorpar = last_param_longreal;

					/*
					 * random functions
					 */
					/*
					 *	BRandom
					 */
	help = symbtbladd ("brandom");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_boolean;
	help->u.nextfldorpar = NULL;

					/*
					 *	CRandom
					 */
	help = symbtbladd ("crandom");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_char;
	help->u.nextfldorpar = NULL;

					/*
					 *	IRandom
					 */
	help = symbtbladd ("irandom");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_integer;
	help->u.nextfldorpar = NULL;

					/*
					 *	RRandom
					 */
	help = symbtbladd ("rrandom");
	help->iart.is_procedureid = 1;
	help->status.is_predeclared = help->status.is_defined = 1;
	help->ofstblentry = type_real;
	help->u.nextfldorpar = NULL;

	return;
}

void
loop_stack (l)
	int	l;			/*
					 * Zur Verwaltung der Loop-Labels:
					 *	i =  1: Loop-Begin
					 *	i =  0: EXIT-Befehl
					 *	i = -1: Loop-Ende
					 */
{
	static int	lstack[16];
	static int	lexit[16];
	static int	lbegin = 0;
	static int	lstacknr = 0;
	int	j;

#ifdef SYMBTBLDEBUG
	printf ("loop_stack (%d)\n", l);
#endif

	switch (l) {
	case 1:
		if (lstacknr == 16) {
			message (D_FATAL, "loop_stack: Maximum Number of inner Loops (15) exceeded");
		}
		lbegin++;
		lstack [lstacknr] = lbegin;
		lexit [lstacknr] = 0;
		lstacknr++;
		c_out_linebegin ("for ( ; ; ) {");
		tabcnt++;
		break;
	case 0:
		if (lstacknr == 0) {
			message (D_ERROR, "loop_stack (0): EXIT only within a Loop-Statement allowed");
			return;
		}
		c_out_linebegin ("goto looplabel%d;", lstack [lstacknr - 1]);
		lexit [lstacknr - 1] = 1;
		break;
	case -1:
		lstacknr--;
		tabcnt--;
		c_out_linebegin ("} ");
		if (lexit [lstacknr]) {
			c_out_lf ();
			c_out_linebegin ("looplabel%d:\t;", lstack [lstacknr]);
			c_out_lineno ();
		}
		break;
	default:
		message (D_INTERNAL, "loop_stack: Unknown Parameter %s", l);
		break;
	}

	return;
}


void
comm_param_out(pstbl)
	SymbTblEntry	*pstbl;
{
	SymbTblEntry	*help;
	int	i;

#ifdef SYMBTBLDEBUG
	printf ("comm_param_out (->\"%s\")\n", pstbl->id);
#endif

	help = pstbl->u.nextfldorpar;

	while (help != NULL) {
		c_out_lf ();
		c_out ("#define ");
		c_out_id (help);
		c_out ("\t(in->%s_)", help->id);
		if (help->iart.is_openarrayparam) {
			c_out_lf ();
			c_out ("#define high_%s\t(in->high_%s)", help->id, help->id);
		}
		help->iart.is_varid = 1;
		help = help->u.nextfldorpar;
	}
}


void
formal_param_out(pstbl)
	SymbTblEntry	*pstbl;
{
	SymbTblEntry	*help;
	int	i;

#ifdef SYMBTBLDEBUG
	printf ("formal_param_out (->\"%s\")\n", pstbl->id);
#endif

	i = 0;
	help = pstbl->u.nextfldorpar;

	while (help != NULL) {
		if (i) {
			c_out (" , ");
		}
		i++;
		if (help->iart.is_callbyreference) {
			c_out ("v%d_%s ", help->ofblock->nr, help->id);
		} else {
			c_out_id (help);
		}
		if (help->iart.is_openarrayparam) {
			c_out (" , high_%s", help->id);
		}
		help->iart.is_varid = 1;
		help = help->u.nextfldorpar;
	}

	if (pstbl->iart.is_communicationid) {
		c_out (" , wsid");
		c_out (" , computerid");
	}

	c_out (")");

	help = pstbl->u.nextfldorpar;

	while (help != NULL) {
		c_out_lf ();
		c_out_linebegin ("\t");
		c_out_id (help->ofstblentry);
		if (help->iart.is_callbyreference) {
			c_out ("\t*");
			c_out ("v%d_%s ;", help->ofblock->nr, help->id);
			c_out_lf ();
			c_out ("#define ");
			c_out_id (help);
			c_out ("\t (*v%d_%s)", help->ofblock->nr, help->id);
		} else {
			c_out ("\t");
			c_out_id (help);
			c_out (";");
		}
		if (help->iart.is_openarrayparam) {
			c_out_lf ();
			c_out_linebegin ("\tm0_longint\t");
			c_out ("high_%s;", help->id);
		}
		help = help->u.nextfldorpar;
	}

	if (pstbl->iart.is_communicationid) {
		c_out_lf ();
		c_out_linebegin ("\tm0_computer\twsid; /* Workstation-Id of Communication-Call */");
		c_out_lf ();
		c_out_linebegin ("\tm0_char\t*computerid; /* Computer-Id of Communication-Call */");
	}

	return;
}


void
revoke_fparams_var_attr(pstbl)
	SymbTblEntry	*pstbl;
{
	SymbTblEntry	*help;

#ifdef SYMBTBLDEBUG
	printf ("revoke_fparams_var_attr (->\"%s\")\n", pstbl->id);
#endif

	help = pstbl->u.nextfldorpar;

	while (help != NULL) {
		if (help->iart.is_callbyreference) {
			c_out_lf ();
			c_out ("#undef ");
			c_out_id (help);
		}
		help->iart.is_varid = 0;
		help = help->u.nextfldorpar;
	}

	return;
}


void
comm_return(pstbl)
	SymbTblEntry	*pstbl;
{
	SymbTblEntry	*help;

#ifdef SYMBTBLDEBUG
	printf ("comm_return (->\"%s\")\n", pstbl->id);
#endif

	help = pstbl->u.nextfldorpar;

	while (help != NULL) {
		if (help->iart.is_callbyreference) {
			c_out_lf ();
			c_out_linebegin ("out.%s_ = in->%s_;", help->id, help->id);
		}
		help = help->u.nextfldorpar;
	}

	if (lookforgentypeart (pstbl).is_void == 0) {
		c_out_lf ();
		c_out_linebegin ("out.retval = retval;");
	}

	c_out_lf ();
	c_out_linebegin ("return (&out);");

	return;
}


void
comm_out_rpc_file(pstbl)
	SymbTblEntry	*pstbl;
{
	SymbTblEntry	*help;
	FILE	*in;
	int	i, cnt, seflag;
	char	name[1024], savename[1024];

#ifdef SYMBTBLDEBUG
	printf ("comm_out_rpc_file (->\"%s\")\n", pstbl->id);
#endif

	c_out ("/* Generated by Modula-P-Compiler (mc) */\n\n");

	if (mc_include != NULL) {
		c_out ("#include \"%s/mctypes.h\"\n\n", mc_include);
	} else {
		c_out ("#include <mctypes.h>\n\n");
	}

			/* type definition */
	c_out ("#ifdef RPC_HDR\n%c#ifndef comm_in\n#endif\n\n", '%');

	c_out ("#ifdef RPC_XDR\n%c#ifndef MC_CLNT_PROCNO\n%c# define MC_CLNT_PROCNO\n", '%', '%');
	c_out ("%ctypedef struct CLNT_PROCNO {CLIENT *clnt; int procno;} CLNT_PROCNO;\n", '%');
	c_out ("%cextern CLNT_PROCNO *mk_connect();\n%c#endif\n#endif\n\n", '%', '%');



			/* Reading and Copying all typedefs */
	if ((in = fopen (p_out, "r")) == NULL) {
		message (D_OPEN_ERROR, "comm_out_rpc_file: Cannot open file '%s' to read", p_out);
	}

	while (! feof (in)) {
		i = fgetc (in);
		for ( ; ; ) {
			if (i != ' ' && i != '\t' && i != '\n' && i != '\r')
				break;
			for ( ; ; ) {
				if ((i = fgetc (in)) != 't')
					break;
				if ((i = fgetc (in)) != 'y')
					break;
				if ((i = fgetc (in)) != 'p')
					break;
				if ((i = fgetc (in)) != 'e')
					break;
				if ((i = fgetc (in)) != 'd')
					break;
				if ((i = fgetc (in)) != 'e')
					break;
				if ((i = fgetc (in)) != 'f')
					break;

				seflag = 0;

skip:					/* skip whitespace to next character */
				for ( ; ; ) {
					i = fgetc (in);
					if (i != ' ' && i != '\n' && i != '\r' && i != '\t')
						break;
				}

					/* name */
				memset (name, 0, sizeof (name));
				cnt = 0;
				for ( ; ; ) {
					name [cnt] = i;
					cnt++;
					i = fgetc (in);
					if (i != ' ' && i != '\n' && i != '\r' && i != '\t')
						continue;
					if (strcmp (name, "enum") == 0) {
						seflag = 1;
						goto skip;
					} else if (strcmp (name, "struct") == 0) {
						seflag = 2;
						goto skip;
					} else {
						if (seflag)
							break;
						seflag = 3;
						strcpy (savename, name);
						goto skip;
					}
				}

				c_out ("#ifdef RPC_XDR\n%c#ifndef T_%s\n%c# define T_%s\n#endif\n", '%', name, '%', name);
				switch (seflag) {
				default:
					c_out ("typedef %s %s ", savename, name);
					break;
				case 1:
					c_out ("enum %s ", name);
					break;
				case 2:
					c_out ("struct %s ", name);
					break;
				}
						
				cnt = 0;
				for ( ; ; ) {
					if ((i = fgetc(in)) == EOF)
						break;
						
					c_out ("%c", i);

					if ((i == ';') && (cnt == 0)) {
						break;
					} else if (i == '{') {
						cnt++;
					} else if (i == '}') {
						cnt--;
						if (seflag && (cnt == 0)) {
							c_out (";");
							break;
						}
					}
				}
				c_out ("\n#ifdef RPC_XDR\n%c#endif\n#endif\n\n", '%');
				break;
			}
		}
	}
	pclose (in);
	c_out ("#ifdef RPC_HDR\n%c#endif\n#endif\n\n", '%');

			/* input type definition */
	c_out ("struct comm_in {\n");

	help = pstbl->u.nextfldorpar;

	while (help != NULL) {
		c_out ("\t");
		c_out_id (help->ofstblentry);
		c_out ("\t%s_;\n", help->id);

		help = help->u.nextfldorpar;
	}
	c_out ("};\n\n");

			/* return type definition */
	c_out ("struct comm_out {\n");

	help = pstbl->u.nextfldorpar;

	while (help != NULL) {
		if (help->iart.is_callbyreference) {
			c_out ("\t");
			c_out_id (help->ofstblentry);
			c_out ("\t%s_;\n", help->id);
		}
		help = help->u.nextfldorpar;
	}

	if (lookforgentypeart (pstbl).is_void == 0) {
		c_out ("\t");
		c_out_id (lookforgentype (pstbl));
		c_out ("\tretval;\n");
	}
	c_out ("};\n\n");

			/* program definition */	
	c_out ("program INITIALIZATION_SERVER {\n");
	c_out ("\tversion V1 {\n");
	c_out ("\t\tcomm_out COMM_PROCEDURE (comm_in) = 1;\n");
	c_out ("\t\tvoid RPC_SERVICE_STOP (void) = 99;\n");
	c_out ("\t} = 1;\n");
	c_out ("} = prognum;\n");
}


void
save_locals()
{
	SymbTblEntry	*help;
	int	savenr = 1;

#ifdef SYMBTBLDEBUG
	printf ("save_locals ()\n");
#endif

	help = blocklist->stbllist;

	while (help != NULL) {
		if (help->iart.is_varid) {
			c_out_lf ();
			c_out_linebegin ("");
			c_out_id (help->ofstblentry);
			c_out ("\tlocal_save_%d;", savenr);
			savenr++;
		}
		help = help->nextinblock;
	}

	savenr = 1;
	help = blocklist->stbllist;

	while (help != NULL) {
		if (help->iart.is_varid) {
			c_out_lf ();
			c_out_linebegin ("");
			c_out ("local_save_%d = ", savenr);
			c_out_id (help);
			c_out (";");
			c_save ("\n#line %d \"%s\"\n", yylineno, actual_filename);
			c_save ("\tm%d_%s = local_save_%d;", help->ofblock->nr, help->id, savenr);
			savenr++;
		}
		help = help->nextinblock;
	}
	if (savenr != 1) {
		c_save ("\n");
	}

	return;
}


void
local_communication_out(pstbl)
	SymbTblEntry	*pstbl;
{
	SymbTblEntry	*help;

#ifdef SYMBTBLDEBUG
	printf ("local_communication_out (->\"%s\")\n", pstbl->id);
#endif

	c_out_lf ();
	c_out ("m0_cardinal cno_%s = 1;", pstbl->id);
	c_out_lf ();
	c_out ("#define comm_in %s_in", pstbl->id);
	c_out_lf ();
	c_out ("#define comm_out %s_out", pstbl->id);
	c_out_lf ();
	c_out ("#define comm_procedure_1 %s_comm_procedure_1", pstbl->id);
	c_out_lf ();
	c_out ("#define xdr_comm_in xdr_%s_in", pstbl->id);
	c_out_lf ();
	c_out ("#define xdr_comm_out xdr_%s_out", pstbl->id);
	c_out_lf ();
	c_out ("#include \"%s_%s_xdr.c\"", module_name, pstbl->id);
	c_out_lf ();
	c_out ("#undef comm_in");
	c_out_lf ();
	c_out ("#undef comm_out");
	c_out_lf ();
	c_out ("#undef comm_procedure_1");
	c_out_lf ();
	c_out ("#undef xdr_comm_in");
	c_out_lf ();
	c_out ("#undef xdr_comm_out");
	c_out_lf ();
	c_out_linebegin ("");
	c_out_id (pstbl->ofstblentry);
	c_out_id (pstbl);
	c_out ("(");
	formal_param_out (pstbl);	
	c_out_lf ();
	c_out ("{");
	c_out_lf ();
	tabcnt++;
	c_out_linebegin ("static struct timeval TIMEOUT = {600, 0};");
	c_out_lf ();
	c_out_linebegin ("int flag;");
	c_out_lf ();
	c_out_linebegin ("static\t%s_in in;", pstbl->id);
	c_out_lf ();
	c_out_linebegin ("static\t%s_out out;", pstbl->id);
	c_out_lf ();

	c_out_linebegin ("CLNT_PROCNO *clpn;");
	c_out_lf ();

	c_out_linebegin ("\t/* copy actual parameters */");
	c_out_lf ();

	help = blocklist->stbllist;

	while (help != NULL) {
		if (help->iart.is_varid) {
			if (help->iart.is_openarrayparam) {
				message (D_ERROR, "local_communication_out: OPEN ARRAYS not allowed within Communications");
			} else {
				c_out_linebegin ("in.%s_ = ", help->id);
				c_out_id (help);
				c_out (";");
				c_out_lf ();
				if (help->iart.is_callbyreference) {
					c_out_linebegin ("out.%s_ = ", help->id);
					c_out_id (help);
					c_out (";");
					c_out_lf ();
				}
			}
		}
		help = help->nextinblock;
	}
	
	c_out_linebegin ("clpn = mk_connect (wsid, \"%s\", computerid); /* making connection */", pstbl->id);
	c_out_lf ();
	c_out_linebegin ("if (clpn == NULL) {");
	c_out_lf ();
	c_out_linebegin ("\truntime_error (P_INFO, \"RPC '%s' failed at '%%s'. No Connection possible\", wsid->modula_p_workstation_name);", pstbl->id);
	c_out_lf ();
	c_out_linebegin ("\tm0_raise (257);");
	c_out_lf ();
	c_out_linebegin ("} else {");
	c_out_lf ();
	tabcnt++;

	if (lookforgentypeart (pstbl).is_void == 0) {
		c_out_linebegin ("bzero ((char *) &(out.retval), sizeof (out.retval));");
		c_out_lf ();
	}

	c_out_linebegin ("flag = (clnt_call (clpn->clnt, 1, xdr_%s_in, &in, xdr_%s_out, &out, TIMEOUT) != RPC_SUCCESS);", pstbl->id, pstbl->id);
	c_out_lf ();
	c_out_linebegin ("release_connect (wsid, \"%s\", clpn);", pstbl->id);
	c_out_lf ();
	c_out_linebegin ("if (flag) {");
	c_out_lf ();
	c_out_linebegin ("\truntime_error (P_INFO, \"RPC '%s' failed at '%%s' with error %%d at internal procedure clnt_call\", wsid->modula_p_workstation_name, flag);", pstbl->id);
	c_out_lf ();
	c_out_linebegin ("\tm0_raise (257);");
	c_out_lf ();
	c_out_linebegin ("}");
	c_out_lf ();
	tabcnt--;
	c_out_linebegin ("}");
	c_out_lf ();

	c_out_linebegin ("\t/* copy return values */");
	c_out_lf ();

	help = blocklist->stbllist;

	while (help != NULL) {
		if (help->iart.is_varid) {
			if (help->iart.is_callbyreference) {
				if (help->iart.is_openarrayparam) {
					message (D_ERROR, "local_communication_out: OPEN ARRAYS as Call-By-Reference-Parameter not allowed within Communications");
				} else {
					c_out_linebegin ("");
					c_out_id (help);
					c_out_linebegin (" = out.%s_;", help->id);
					c_out_lf ();
				}
			}
		}
		help = help->nextinblock;
	}

	if (lookforgentypeart (pstbl).is_void == 0) {
		c_out_linebegin ("return (out.retval);");
	} else {
		c_out_linebegin ("return;");
	}
	c_out_lf ();
	tabcnt--;
	c_out ("}");
	c_out_lf ();

	return;
}


SymbTblEntry *
define_record(pstbl, da)			
	SymbTblEntry	*pstbl;
	DefArt		da;			/* Definiert einen Record
						 * (SymbTblEntry und Types)
						 * und gibt die Definition
						 * aus (struct ...),
						 * innerhalb einer Typ-
						 * Definition ist bereits ein
						 * Types-Eintrag angelegt (s.u.);
						 * pstblentry zeigt auf das erste
						 * Record-Element.
						 */
{
	SymbTblEntry	*help,
			*pstblentry,
			*delhelp;
	IdArt	idart;
	int	i;
	char	recname[512],
		*strhlp;

#ifdef SYMBTBLDEBUG
	printf ("define_record (level %d)\n", pstbl->entrynr);
#endif

	help = pstbl;
	
	memset (recname, 0, sizeof (recname));
	strcpy (recname, "_record_");

	while (help != NULL) {
		if (strlen (recname) + strlen (help->id) >= sizeof (recname) - 10) {
			message (D_FATAL, "define_record: Record has too much elements or too long fieldnames; please split into more (sub-)types");
		}
		strcat (recname, help->id);	/* die id wird bereits durch '_' abgeschlossen */
		strhlp = recname + strlen (recname);
		sprintf (strhlp, "of_%X_", lookforgentype (help)->u.oftype->typenr);
		help = help->u.nextfldorpar;
	}

	help = pstbl;
	
	setidart (is_typeid);
	if ((pstblentry = symbtbllookupwithinidart (recname, idart)) == NULL) {
			/* Record noch nicht definiert */
		pstblentry = symbtbladd (recname);
		c_out_linebegin ("typedef\tstruct\t");
		if (da == def_type) {		/* Typ bereits angelegt */
			pstblentry->u.oftype = stbllist->entry->u.oftype;
			pstblentry->u.oftype->indextype = help; /* erstes FieldList-Element */
			c_out_id (stbllist->entry);
		} else {			/* Typ noch nicht angelegt */
			memset ((char *) &typevar, 0, sizeof (typevar));
			typevar.tart.is_record = 1;
			typevar.indextype = help; /* erstes FieldList-Element */
			pstblentry->u.oftype = typeadd (&typevar);
			c_out_id (pstblentry);
		}
		pstblentry->iart.is_typeid = pstblentry->iart.is_generictype = 1;
		pstblentry->status.is_defined = 1;
		pstblentry->ofstblentry = pstblentry;
		c_out ("{");

		while (help != NULL) {
			c_out_id (help->ofstblentry);
			c_out (" %s; ", help->id);

			help = help->u.nextfldorpar;
		}
		c_out ("} ");
		if (da == def_type) {		/* Typ bereits angelegt */
			c_out_id (stbllist->entry);
			c_out (", ");
		}
		c_out_id (pstblentry);
		c_out (";");
		c_out_lf ();
	} else {
			/* identischer Record bereits definiert */
		while (help != NULL) {
			delhelp = help->u.nextfldorpar;
			deleteentry (help);
			help = delhelp;
		}
		if (da == def_type) {		/* Typ bereits angelegt */
			c_out_linebegin ("typedef\t");
			c_out_id (pstblentry);
			c_out ("\t");
			c_out_id (stbllist->entry);
			c_out (";");
		}
	}
	if (da == def_type) {
			/* Typ-Deklaration (Rest bereits oben abgehandelt) */
		stbllist->entry->iart.is_typeid = 1;
		stbllist->entry->iart.is_generictype = 0;
		stbllist->entry->status.is_defined = 1;
		stbllist->entry->ofstblentry = pstblentry;
		stbllist->entry->u.oftype = NULL;
		free ((char *) stbllist);
		stbllist = NULL;
	} else if (da == def_var) {
			/* Variablen-Deklaration */
		set_and_out_type_of_stbl_list (pstblentry);
	} else if (da == def_record) {
			/* Record-Deklaration */
		set_type_of_stbl_list (pstblentry);
	}

	return (pstblentry);
}
