Added the appropriate #! magic at the beginning of shell scripts. (Some modern shells don't like scripts to be without it.)

lang/cem/cemcom.ansi/.distr

@@ -0,0 +1,100 @@
+proto.make
+proto.main
+LLlex.c
+LLlex.h
+LLmessage.c
+SmallPars
+BigPars
+align.h
+arith.c
+arith.h
+assert.h
+atw.h
+blocks.c
+cemcom.ansi.1
+ch3.c
+ch3bin.c
+ch3mon.c
+char.tab
+class.h
+code.c
+code.str
+conversion.c
+cstoper.c
+dataflow.c
+declar.g
+declar.str
+declarator.c
+decspecs.c
+decspecs.h
+def.str
+domacro.c
+dumpidf.c
+error.c
+estack.str
+eval.c
+expr.c
+expr.str
+expression.g
+field.c
+field.str
+file_info.h
+fltcstoper.c
+idf.c
+idf.str
+init.c
+input.c
+input.h
+interface.h
+ival.g
+l_brace.str
+l_class.h
+l_comment.h
+l_comment.c
+l_em.h
+l_ev_ord.c
+l_lint.c
+l_lint.h
+l_misc.c
+l_outdef.c
+l_outdef.str
+l_state.str
+l_states.c
+label.c
+label.h
+level.h
+macro.str
+main.c
+make.allocd
+make.hfiles
+make.next
+make.tokcase
+make.tokfile
+mes.h
+options
+options.c
+pragma.c
+program.g
+proto.c
+proto.str
+replace.c
+replace.str
+sizes.h
+skip.c
+specials.h
+stab.c
+stack.c
+stack.str
+statement.g
+stb.c
+stmt.str
+struct.c
+struct.str
+switch.c
+switch.str
+tokenname.c
+tokenname.h
+type.c
+type.str
+util.str
+util.c

lang/cem/cemcom.ansi/BigPars

@@ -0,0 +1,143 @@
+!File: lint.h
+/*#define	LINT		1	/* if defined, 'lint' is produced	*/
+
+
+!File: pathlength.h
+#define PATHLENGTH	1024	/* max. length of path to file		*/
+
+
+!File: errout.h
+#define	ERROUT		STDERR	/* file pointer for writing messages	*/
+#define	ERR_SHADOW	5	/* a syntax error overshadows error messages
+					until ERR_SHADOW symbols have been
+					accepted without syntax error */
+
+
+!File: idfsize.h
+#define	IDFSIZE	64	/* maximum significant length of an identifier	*/
+
+
+!File: numsize.h
+#define	NUMSIZE	256	/* maximum length of a numeric constant		*/
+
+
+!File: nparams.h
+#define	NPARAMS 32	/* maximum number of parameters 		*/
+#define	STDC_NPARAMS 31	/* ANSI limit on number of parameters		*/
+
+
+!File: ifdepth.h
+#define	IFDEPTH	256	/* maximum number of nested if-constructions	*/
+
+
+!File: density.h
+#define	DENSITY	3	/* see switch.[ch] for an explanation		*/
+
+
+!File: macbuf.h
+#define	LAPBUF	128	/* initial size of macro replacement buffer	*/
+#define ARGBUF	128	/* initial size of macro parameter buffer(s)	*/
+
+
+!File: strsize.h
+#define ISTRSIZE	32	/* minimum number of bytes allocated for
+					storing a string		*/
+#define RSTRSIZE	16	/* step size in enlarging the memory for
+					the storage of a string		*/
+
+
+!File: trgt_sizes.h
+#define MAXSIZE		8	/* the maximum of the SZ_* constants	*/
+
+/* target machine sizes	*/
+#define	SZ_CHAR		1
+#define	SZ_SHORT	2
+#define SZ_WORD		4
+#define	SZ_INT		4
+#define	SZ_LONG		4
+#define	SZ_FLOAT	4
+#define	SZ_DOUBLE	8
+#define	SZ_LNGDBL	8	/* for now */
+#define	SZ_POINTER	4
+
+/* target machine alignment requirements	*/
+#define	AL_CHAR		1
+#define	AL_SHORT	SZ_SHORT
+#define AL_WORD		SZ_WORD
+#define	AL_INT		SZ_WORD
+#define	AL_LONG		SZ_WORD
+#define	AL_FLOAT	SZ_WORD
+#define	AL_DOUBLE	SZ_WORD
+#define	AL_LNGDBL	SZ_WORD
+#define	AL_POINTER	SZ_WORD
+#define AL_STRUCT	1
+#define AL_UNION	1
+
+
+!File: botch_free.h
+/*#define BOTCH_FREE	1	/* when defined, botch freed memory, as a check	*/
+
+
+!File: dataflow.h
+#define DATAFLOW	1	/* produce some compile-time xref	*/
+
+
+!File: debug.h
+/*#define DEBUG		1	/* perform various self-tests		*/
+#define NDEBUG		1	/* disable assertions			*/
+
+
+!File: use_tmp.h
+#define PREPEND_SCOPES	1	/* collect exa, exp, ina and inp commands
+					and if USE_TMP is defined let them
+					precede the rest of the generated
+					compact code	*/
+#define USE_TMP		1	/* use C_insertpart, C_endpart mechanism
+					to generate EM-code in the order needed
+					for the code-generators. If not defined,
+					the old-style peephole optimizer is
+					needed.	*/
+
+
+!File: parbufsize.h
+#define PARBUFSIZE	1024
+
+
+!File: textsize.h
+#define ITEXTSIZE	32	/* 1st piece of memory for repl. text	*/
+
+
+!File: inputtype.h
+#define INP_READ_IN_ONE	1	/* read input file in one	*/
+
+
+!File: nopp.h
+/*#define NOPP		1	/* if NOT defined, use built-int preprocessor */
+
+
+!File: nobitfield.h
+/*#define NOBITFIELD	1	/* if NOT defined, implement bitfields	*/
+
+
+!File: spec_arith.h
+/* describes internal compiler arithmetics */
+#undef	SPECIAL_ARITHMETICS	/* something different from native long */
+/*#define UNSIGNED_ARITH	unsigned arith	/* if it is supported */
+
+
+!File: static.h
+#define GSTATIC			/* for large global "static" arrays */
+
+
+!File: nocross.h
+/*#define NOCROSS		1	/* if NOT defined, cross compiler */
+
+
+!File: regcount.h
+/*#define REGCOUNT		1	/* count occurrences for register messages */
+
+
+!File: dbsymtab.h
+#define DBSYMTAB	1	/* ability to produce symbol table for debugger */
+
+

lang/cem/cemcom.ansi/LLlex.c

@@ -0,0 +1,849 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*		    L E X I C A L   A N A L Y Z E R			*/
+
+#include	"debug.h"
+#include	"lint.h"
+#include	<alloc.h>
+#include	"idfsize.h"
+#include	"numsize.h"
+#include	"strsize.h"
+#include	"nopp.h"
+#include	"input.h"
+#include	"arith.h"
+#include	"def.h"
+#include	"macro.h"
+#include	"idf.h"
+#include	"LLlex.h"
+#include	"Lpars.h"
+#include	"class.h"
+#include	"assert.h"
+#include	"sizes.h"
+#include	"specials.h"	/* registration of special identifiers */
+
+/* Data about the token yielded */
+struct token dot, ahead, aside;
+int token_nmb = 0;		/* number of the ahead token */
+int tk_nmb_at_last_syn_err = -5/*ERR_SHADOW*/;
+				/* token number at last syntax error */
+int idfsize = IDFSIZE;
+char sp_occurred[SP_TOTAL+1];
+
+#ifndef	NOPP
+int ReplaceMacros = 1;		/* replacing macros			*/
+int AccDefined = 0;		/* accept "defined(...)"		*/
+int UnknownIdIsZero = 0;	/* interpret unknown id as integer 0	*/
+int Unstacked = 0;		/* an unstack is done 			*/
+extern int InputLevel;
+#endif
+int AccFileSpecifier = 0;	/* return filespecifier <...>		*/
+int EoiForNewline = 0;		/* return EOI upon encountering newline	*/
+int File_Inserted = 0;		/* a file has just been inserted	*/
+int LexSave = 0;		/* last character read by GetChar	*/
+#define	MAX_LL_DEPTH	2
+
+#define	FLG_ESEEN	0x01	/* possibly a floating point number */
+#define	FLG_DOTSEEN	0x02	/* certainly a floating point number */
+extern arith full_mask[];
+
+#ifdef LINT
+extern int lint_skip_comment;
+#endif
+
+#ifndef	NOPP
+static struct token LexStack[MAX_LL_DEPTH];
+static LexSP = 0;
+
+/*	In PushLex() the actions are taken in order to initialise or
+	re-initialise the lexical scanner.
+	E.g. at the invocation of a sub-parser that uses LLlex(), the
+	state of the current parser should be saved.
+*/
+PushLex()
+{
+	ASSERT(LexSP < MAX_LL_DEPTH);
+	ASSERT(ASIDE == 0);	/* ASIDE = 0;	*/
+	GetToken(&ahead);
+	LexStack[LexSP++] = dot;
+}
+
+PopLex()
+{
+	ASSERT(LexSP > 0);
+	dot = LexStack[--LexSP];
+}
+#endif	/* NOPP */
+
+int
+LLlex()
+{
+	/*	LLlex() plays the role of Lexical Analyzer for the C parser.
+		The look-ahead and putting aside of tokens are taken into
+		account.
+	*/
+	if (ASIDE) {	/* a token is put aside		*/
+		dot = aside;
+		ASIDE = 0;
+	}
+	else {		/* read ahead and return the old one	*/
+#ifdef	LINT
+		lint_comment_ahead();
+#endif	/* LINT */
+		dot = ahead;
+		/*	the following test is performed due to the dual
+			task of LLlex(): it is also called for parsing the
+			restricted constant expression following a #if or
+			#elif.  The newline character causes EOF to be
+			returned in this case to stop the LLgen parsing task.
+		*/
+		if (DOT != EOI)
+			GetToken(&ahead);
+		else
+			DOT = EOF;
+	}
+	return DOT;
+}
+
+
+char	*string_token();
+arith	char_constant();
+
+int
+GetToken(ptok)
+	register struct token *ptok;
+{
+	/*	GetToken() is the actual token recognizer. It calls the
+		control line interpreter if it encounters a "\n{w}*#"
+		combination. Macro replacement is also performed if it is
+		needed.
+	*/
+	char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 1];
+	register int ch, nch;
+
+	token_nmb++;
+
+	if (File_Inserted) {
+		File_Inserted = 0;
+		goto firstline;
+	}
+
+again:	/* rescan the input after an error or replacement	*/
+	ch = GetChar();
+go_on:	/* rescan, the following character has been read	*/
+	if ((ch & 0200) && ch != EOI) /* stop on non-ascii character */
+	{
+		fatal("non-ascii '\\%03o' read", ch & 0377);
+	}
+	/* keep track of the place of the token in the file	*/
+	ptok->tk_file = FileName;
+	ptok->tk_line = LineNumber;
+
+	switch (class(ch)) {	/* detect character class	*/
+	case STNL:		/* newline, vertical space or formfeed	*/
+firstline:
+		LineNumber++;			/* also at vs and ff	*/
+		ptok->tk_file = FileName;
+		ptok->tk_line = LineNumber;
+		if (EoiForNewline)	/* called in control line	*/
+			/*	a newline in a control line indicates the
+				end-of-information of the line.
+			*/
+			return ptok->tk_symb = EOI;
+
+		while ((ch = GetChar()),
+			(ch == '#'
+#ifndef NOPP
+			|| ch == '/'
+#endif
+			|| class(ch) == STSKIP)) {
+			/* blanks are allowed before hashes */
+			if (ch == '#') {
+				/* a control line follows */
+				domacro();
+#ifndef	NOPP
+				if (File_Inserted) {
+					File_Inserted = 0;
+					goto firstline;
+				}
+			} else if (ch == '/') {
+				if ((GetChar() == '*') && !InputLevel) {
+					skipcomment();
+				} else {
+					UnGetChar();
+					break;
+				}
+#endif	/* NOPP */
+			}
+		}
+			/*	We have to loop here, because in
+				`domacro' the nl, vt or ff is read. The
+				character following it may again be a `#'.
+			*/
+		goto go_on;
+	case STSKIP:		/* just skip the skip characters	*/
+		goto again;
+	case STGARB:		/* garbage character			*/
+#ifndef	NOPP
+garbage:
+#endif
+		if (040 < ch && ch < 0177) {
+			return ptok->tk_symb = ch;
+		} else {
+			lexerror("garbage char \\%03o", ch);
+		}
+		goto again;
+	case STSIMP:	/* a simple character, no part of compound token*/
+		return ptok->tk_symb = ch;
+	case STCOMP:	/* maybe the start of a compound token		*/
+		nch = GetChar();		/* character lookahead	*/
+		switch (ch) {
+		case '!':
+			if (nch == '=')
+				return ptok->tk_symb = NOTEQUAL;
+			break;
+		case '&':
+			if (nch == '&')
+				return ptok->tk_symb = AND;
+			if (nch == '=')
+				return ptok->tk_symb = ANDAB;
+			break;
+		case '+':
+			if (nch == '+')
+				return ptok->tk_symb = PLUSPLUS;
+			if (nch == '=')
+				return ptok->tk_symb = PLUSAB;
+			break;
+		case '-':
+			if (nch == '-')
+				return ptok->tk_symb = MINMIN;
+			if (nch == '>')
+				return ptok->tk_symb = ARROW;
+			if (nch == '=')
+				return ptok->tk_symb = MINAB;
+			break;
+		case '<':
+			if (AccFileSpecifier) {
+				UnGetChar();	/* pushback nch */
+				ptok->tk_bts = string_token("file specifier",
+							'>', &(ptok->tk_len));
+				return ptok->tk_symb = FILESPECIFIER;
+			}
+			if (nch == '<') {
+				if ((nch = GetChar()) == '=')
+					return ptok->tk_symb = LEFTAB;
+				UnGetChar();
+				return ptok->tk_symb = LEFT;
+			}
+			if (nch == '=')
+				return ptok->tk_symb = LESSEQ;
+			break;
+		case '=':
+			if (nch == '=')
+				return ptok->tk_symb = EQUAL;
+			break;
+		case '>':
+			if (nch == '=')
+				return ptok->tk_symb = GREATEREQ;
+			if (nch == '>') {
+				if ((nch = GetChar()) == '=')
+					return ptok->tk_symb = RIGHTAB;
+				UnGetChar();
+				return ptok->tk_symb = RIGHT;
+			}
+			break;
+		case '|':
+			if (nch == '|')
+				return ptok->tk_symb = OR;
+			if (nch == '=')
+				return ptok->tk_symb = ORAB;
+			break;
+		case '%':
+			if (nch == '=')
+				return ptok->tk_symb = MODAB;
+			break;
+		case '*':
+			if (nch == '=')
+				return ptok->tk_symb = TIMESAB;
+			break;
+		case '^':
+			if (nch == '=')
+				return ptok->tk_symb = XORAB;
+			break;
+		case '/':
+#ifndef	NOPP
+			if (nch == '*' && !InputLevel) {
+				skipcomment();
+				goto again;
+			}
+#endif
+			if (nch == '=')
+				return ptok->tk_symb = DIVAB;
+			break;
+		default:
+			crash("bad class for char 0%o", ch);
+			/* NOTREACHED */
+		}
+		UnGetChar();
+		return ptok->tk_symb = ch;
+	case STCHAR:				/* character constant	*/
+		ptok->tk_ival = char_constant("character");
+		ptok->tk_fund = INT;
+		return ptok->tk_symb = INTEGER;
+	case STSTR:					/* string	*/
+		ptok->tk_bts = string_token("string", '"', &(ptok->tk_len));
+		ptok->tk_fund = CHAR;		/* string of characters */
+		return ptok->tk_symb = STRING;
+	case STELL:		/* wide character constant/string prefix */
+		nch = GetChar();
+		if (nch == '"') {
+			ptok->tk_bts = string_token("wide character string",
+					'"', &(ptok->tk_len));
+			ptok->tk_fund = WCHAR;	/* string of wide characters */
+			return ptok->tk_symb = STRING;
+		} else if (nch == '\'') {
+			ptok->tk_ival = char_constant("wide character");
+			ptok->tk_fund = INT;
+			return ptok->tk_symb = INTEGER;
+		}
+		UnGetChar();
+		/* fallthrough */
+	case STIDF:
+	{
+		register char *tg = &buf[0];
+		register int pos = -1;
+		register struct idf *idef;
+		extern int idfsize;		/* ??? */
+#ifndef	NOPP
+		int NoExpandNext = 0;
+
+		if (Unstacked) EnableMacros();	/* unstack macro's when allowed. */
+		if (ch == NOEXPM)  {
+			NoExpandNext = 1;
+			ch = GetChar();
+		}
+#endif
+		do	{			/* read the identifier	*/
+			if (++pos < idfsize) {
+				*tg++ = ch;
+			}
+			ch = GetChar();
+		} while (in_idf(ch));
+
+		if (ch != EOI)
+			UnGetChar();
+		*tg++ = '\0';	/* mark the end of the identifier	*/
+		idef = ptok->tk_idf = str2idf(buf, 1);
+		sp_occurred[idef->id_special] = 1;
+		idef->id_file = ptok->tk_file;
+		idef->id_line = ptok->tk_line;
+#ifndef	NOPP
+		if (idef->id_macro && ReplaceMacros && !NoExpandNext) {
+			if (replace(idef))
+					goto again;
+		}
+		if (UnknownIdIsZero && idef->id_reserved != SIZEOF) {
+			ptok->tk_ival = (arith)0;
+			ptok->tk_fund = INT;
+			return ptok->tk_symb = INTEGER;
+		}
+#endif /* NOPP */
+		ptok->tk_symb = (
+			idef->id_reserved
+			    ? idef->id_reserved
+			    : idef->id_def && idef->id_def->df_sc == TYPEDEF
+				? TYPE_IDENTIFIER
+				: IDENTIFIER
+		);
+		return IDENTIFIER;
+	}
+	case STNUM:				/* a numeric constant	*/
+	{
+		register int siz_left = NUMSIZE - 1;
+		register char *np = &buf[0];
+		int flags = 0;
+
+#define	store(ch)	if (--siz_left >= 0)		\
+				*np++ = ch;
+
+		if (ch == '.') {
+			/*	An embarrasing ambiguity. We have either a
+				pp-number, a field operator, an ELLIPSIS or
+				an error (..).
+			*/
+			ch = GetChar();
+			if (!is_dig(ch)) {	/* . or ... */
+				if (ch == '.') {
+					if ((ch = GetChar()) == '.')
+						return ptok->tk_symb = ELLIPSIS;
+					UnGetChar();		/* not '.' */
+					ChPushBack('.');	/* sigh ... */
+				} else
+					UnGetChar();		/* not '.' */
+				return ptok->tk_symb = '.';
+			}
+			UnGetChar();
+			ch = '.';
+			flags |= FLG_DOTSEEN;
+		 }
+		store(ch);
+		ch = GetChar();
+		while(in_idf(ch) || ch == '.') {
+			store(ch);
+			if (ch == '.') flags |= FLG_DOTSEEN;
+			if (ch == 'e' || ch == 'E') {
+				flags |= FLG_ESEEN;
+				ch = GetChar();
+				if (ch == '+' || ch == '-') {
+					flags |= FLG_DOTSEEN;	/* trick */
+					store(ch);
+					ch = GetChar();
+				}
+			} else ch = GetChar();
+		}
+		store('\0');
+		UnGetChar();
+
+		np = &buf[0];
+		ch = *np++;
+		if (siz_left < 0) {
+			lexerror("number too long");
+			if ((flags & FLG_DOTSEEN)
+			    || (flags & FLG_ESEEN
+				&& !(ch == '0'
+				    && (*np == 'x' || *np == 'X')))) {
+			    ptok->tk_fval = Salloc("0.0", (unsigned) 4);
+			    ptok->tk_fund = DOUBLE;
+			    return ptok->tk_symb = FLOATING;
+			}
+			ptok->tk_ival = 1;
+			ptok->tk_fund = ULONG;
+			ptok->tk_symb = INTEGER;
+		}
+		/* Now, the pp-number must be converted into a token */
+		if ((flags & FLG_DOTSEEN)
+			|| (flags & FLG_ESEEN
+			    && !(ch == '0' && (*np == 'x' || *np == 'X')))) {
+			strflt2tok(&buf[0], ptok);
+			return ptok->tk_symb = FLOATING;
+		}
+		strint2tok(&buf[0], ptok);
+		return ptok->tk_symb = INTEGER;
+	}
+	case STEOI:			/* end of text on source file	*/
+		return ptok->tk_symb = EOI;
+#ifndef	NOPP
+	case STMSPEC:
+		if (!InputLevel) goto garbage;
+		if (ch == TOKSEP) goto again;
+		/* fallthrough shouldn't happen */
+#endif
+	default:				/* this cannot happen	*/
+		crash("bad class for char 0%o", ch);
+	}
+	/*NOTREACHED*/
+}
+
+#ifndef	NOPP
+skipcomment()
+{
+	/*	The last character read has been the '*' of '/_*'.  The
+		characters, except NL and EOI, between '/_*' and the first
+		occurring '*_/' are not interpreted.
+		NL only affects the LineNumber.  EOI is not legal.
+
+		Important note: it is not possible to stop skipping comment
+		beyond the end-of-file of an included file.
+		EOI is returned by LoadChar only on encountering EOF of the
+		top-level file...
+	*/
+	register int c, oldc = '\0';
+
+	NoUnstack++;
+	c = GetChar();
+#ifdef	LINT
+	if (! lint_skip_comment) {
+		lint_start_comment();
+		lint_comment_char(c);
+	}
+#endif	/* LINT */
+	do {
+		while (c != '*') {
+			if (class(c) == STNL) {
+				++LineNumber;
+			} else if (c == EOI) {
+				NoUnstack--;
+#ifdef	LINT
+				if (! lint_skip_comment) lint_end_comment();
+#endif	/* LINT */
+				return;
+			}
+			oldc = c;
+			c = GetChar();
+#ifdef	LINT
+			if (! lint_skip_comment) lint_comment_char(c);
+#endif	/* LINT */
+		} /* last Character seen was '*' */
+		c = GetChar();
+		if ( c != '/' && oldc == '/')
+			lexwarning("comment inside comment ?");
+		oldc = '*';
+#ifdef	LINT
+		if (! lint_skip_comment) lint_comment_char(c);
+#endif	/* LINT */
+	} while (c != '/');
+#ifdef	LINT
+	if (! lint_skip_comment) lint_end_comment();
+#endif	/* LINT */
+	NoUnstack--;
+}
+#endif	/* NOPP */
+
+arith
+char_constant(nm)
+	char *nm;
+{
+	register arith val = 0;
+	register int ch;
+	int size = 0;
+
+	ch = GetChar();
+	if (ch == '\'')
+		lexerror("%s constant too short", nm);
+	else
+	while (ch != '\'') {
+		if (ch == '\n') {
+			lexerror("newline in %s constant", nm);
+			LineNumber++;
+			break;
+		}
+		if (ch == '\\')
+			ch = quoted(GetChar());
+		if (ch >= 128) ch -= 256;
+		if (size < (int)int_size)
+			val |= ch << 8 * size;
+		size++;
+		ch = GetChar();
+	}
+	if (size > 1)
+		lexstrict("%s constant includes more than one character", nm);
+	if (size > (int)int_size)
+		lexerror("%s constant too long", nm);
+	return val;
+}
+
+char *
+string_token(nm, stop_char, plen)
+	char *nm;
+	int *plen;
+{
+	register int ch;
+	register int str_size;
+	register char *str = Malloc((unsigned) (str_size = ISTRSIZE));
+	register int pos = 0;
+	
+	ch = GetChar();
+	while (ch != stop_char) {
+		if (ch == '\n') {
+			lexerror("newline in %s", nm);
+			LineNumber++;
+			break;
+		}
+		if (ch == EOI) {
+			lexerror("end-of-file inside %s", nm);
+			break;
+		}
+		if (ch == '\\' && !AccFileSpecifier)
+			ch = quoted(GetChar());
+		str[pos++] = ch;
+		if (pos == str_size)
+			str = Realloc(str, (unsigned) (str_size += RSTRSIZE));
+		ch = GetChar();
+	}
+	str[pos++] = '\0'; /* for filenames etc. */
+	*plen = pos;
+	return str;
+}
+
+int
+quoted(ch)
+	register int ch;
+{	
+	/*	quoted() replaces an escaped character sequence by the
+		character meant.
+	*/
+	/* first char after backslash already in ch */
+	if (!is_oct(ch)) {		/* a quoted char */
+		switch (ch) {
+		case 'n':
+			ch = '\n';
+			break;
+		case 't':
+			ch = '\t';
+			break;
+		case 'b':
+			ch = '\b';
+			break;
+		case 'r':
+			ch = '\r';
+			break;
+		case 'f':
+			ch = '\f';
+			break;
+		case 'a':		/* alert */
+			ch = '\007';
+			break;
+		case 'v':		/* vertical tab */
+			ch = '\013';
+			break;
+		case 'x':		/* quoted hex */
+		{
+			register int hex = 0;
+			register int vch;
+
+			for (;;) {
+				ch = GetChar();
+				if ((vch = hex_val(ch)) == -1)
+					break;
+				hex = hex * 16 + vch;
+			}
+			UnGetChar();
+			ch = hex;
+		}
+		}
+	}
+	else {				/* a quoted octal */
+		register int oct = 0, cnt = 0;
+
+		do {
+			oct = oct*8 + (ch-'0');
+			ch = GetChar();
+		} while (is_oct(ch) && ++cnt < 3);
+		UnGetChar();
+		ch = oct;
+	}
+	return ch&0377;
+}
+
+
+int
+hex_val(ch)
+	register int ch;
+{
+	return is_dig(ch) ? ch - '0'
+			: is_hex(ch) ? (ch - 'a' + 10) & 017
+			: -1;
+}
+
+
+int
+GetChar()
+{
+	/*	The routines GetChar and trigraph parses the trigraph
+		sequences and removes occurences of \\\n.
+	*/
+	register int ch;
+
+#ifndef NOPP
+again:
+#endif
+	LoadChar(ch);
+
+#ifndef NOPP
+	/* possible trigraph sequence */
+	if (ch == '?')
+		ch = trigraph();
+
+	/* \<newline> is removed from the input stream */
+	if (ch == '\\') {
+		LoadChar(ch);
+		if (ch == '\n') {
+			++LineNumber;
+			goto again;
+		}
+		PushBack();
+		ch = '\\';
+	}
+#endif
+	return(LexSave = ch);
+}
+
+#ifndef NOPP
+int
+trigraph()
+{
+	register int ch;
+
+	LoadChar(ch);
+	if (ch == '?') {
+		LoadChar(ch);
+		switch (ch) {		/* its a trigraph */
+		case '=':
+			ch =  '#';
+			return(ch);
+		case '(':
+			ch = '[';
+			return(ch);
+		case '/':
+			ch = '\\';
+			return(ch);
+		case ')':
+			ch = ']';
+			return(ch);
+		case '\'':
+			ch = '^';
+			return(ch);
+		case '<':
+			ch = '{';
+			return(ch);
+		case '!':
+			ch = '|';
+			return(ch);
+		case '>':
+			ch = '}';
+			return(ch);
+		case '-':
+			ch = '~';
+			return(ch);
+		}
+		PushBack();
+	}
+	PushBack();
+	return('?');
+}
+#endif
+
+/* strflt2tok only checks the syntax of the floating-point number and
+ * selects the right type for the number.
+ */
+strflt2tok(fltbuf, ptok)
+char fltbuf[];
+struct token *ptok;
+{
+	register char *cp = fltbuf;
+	int malformed = 0;
+
+	while (is_dig(*cp)) cp++;
+	if (*cp == '.') {
+		cp++;
+		while (is_dig(*cp)) cp++;
+	}
+	if (*cp == 'e' || *cp == 'E') {
+		cp++;
+		if (*cp == '+' || *cp == '-')
+			cp++;
+		if (!is_dig(*cp)) malformed++;
+		while (is_dig(*cp)) cp++;
+	}
+	if (*cp == 'f' || *cp == 'F') {
+		if (*(cp + 1)) malformed++;
+		*cp = '\0';
+		ptok->tk_fund = FLOAT;
+	} else if (*cp == 'l' || *cp == 'L') {
+		if (*(cp + 1)) malformed++;
+		*cp = '\0';
+		ptok->tk_fund = LNGDBL;
+	} else {
+		if (*cp) malformed++;
+		ptok->tk_fund = DOUBLE;
+	}
+	if (malformed) {
+		lexerror("malformed floating constant");
+		ptok->tk_fval = Salloc("0.0", (unsigned) 4);
+	} else {
+		ptok->tk_fval = Salloc(fltbuf, (unsigned) (cp - fltbuf + 1));
+	}
+}
+
+strint2tok(intbuf, ptok)
+char intbuf[];
+struct token *ptok;
+{
+	register char *cp = intbuf;
+	int base = 10;
+	arith val = 0, dig, ubound;
+	int uns_flg = 0, lng_flg = 0, malformed = 0, ovfl = 0;
+	int fund;
+
+	ASSERT(*cp != '-');
+	if (*cp == '0') {
+		cp++;
+		if (*cp == 'x' || *cp == 'X') {
+			cp++;
+			base = 16;
+		} else base = 8;
+	}
+	/* The upperbound will be the same as when computed with
+	 * max_unsigned_arith / base (since base is even). The problem here
+	 * is that unsigned arith is not accepted by all compilers.
+	 */
+	ubound = max_arith / (base / 2);
+
+	while (is_hex(*cp)) {
+		dig = hex_val(*cp);
+		if (dig >= base) {
+			malformed++;			/* ignore */
+		}
+		else {
+			if (val < 0 || val > ubound) ovfl++;
+			val *= base;
+			if (val < 0 && val + dig >= 0) ovfl++;
+			val += dig;
+		}
+		cp++;
+	}
+
+	while (*cp) {
+		if (*cp == 'l' || *cp == 'L') lng_flg++;
+		else if (*cp == 'u' || *cp == 'U') uns_flg++;
+		else break;
+		cp++;
+	}
+	if (*cp) {
+	    malformed++;
+	}
+	if (malformed) {
+		lexerror("malformed %s integer constant",
+				(base == 10 ? "decimal"
+					    : (base == 8 ? "octal"
+							: "hexadecimal")));
+	} else {
+		if (lng_flg > 1)
+			lexerror("only one long suffix allowed");
+		if (uns_flg > 1)
+			lexerror("only one unsigned suffix allowed");
+	}
+	if (ovfl) {
+		lexwarning("overflow in constant");
+		fund = ULONG;
+	} else if (!lng_flg && (val & full_mask[(int)int_size]) == val) {
+		if (val >= 0 && val <= max_int) {
+			fund = INT;
+		} else if (int_size == long_size) {
+			fund = UNSIGNED;
+		} else if (base == 10 && !uns_flg)
+			fund = LONG;
+		else	fund = UNSIGNED;
+	} else if((val & full_mask[(int)long_size]) == val) {
+		if (val >= 0) fund = LONG;
+		else fund = ULONG;
+	} else {	/* sizeof(arith) is greater than long_size */
+		ASSERT(arith_size > long_size);
+		lexwarning("constant too large for target machine");
+		/* cut the size to prevent further complaints */
+		val &= full_mask[(int)long_size];
+		fund = ULONG;
+	}
+	if (lng_flg) {
+		/* fund can't be INT */
+		if (fund == UNSIGNED) fund = ULONG;
+	}
+	if (uns_flg) {
+	    if (fund == INT) fund = UNSIGNED;
+	    else if (fund == LONG) fund = ULONG;
+	}
+	ptok->tk_fund = fund;
+	ptok->tk_ival = val;
+}

lang/cem/cemcom.ansi/LLlex.h

@@ -0,0 +1,65 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* D E F I N I T I O N S   F O R   T H E   L E X I C A L   A N A L Y Z E R */
+
+/*	A token from the input stream is represented by an integer,
+	called a "symbol", but it may have other information associated
+	to it.
+*/
+
+#include "file_info.h"
+#include "nopp.h"
+
+/* the structure of a token:	*/
+struct token	{
+	int tok_symb;		/* the token itself */
+	char *tok_file;		/* the file it (probably) comes from */
+	unsigned int tok_line;	/* the line it (probably) comes from */
+	int tok_fund;
+	union	{
+		struct idf *tok_idf;	/* for IDENTIFIER & TYPE_IDENTIFIER */
+		struct	{		/* for STRING */
+			char *tok_bts;	/* row of bytes */
+			int tok_len;	/* length of row of bytes */
+		} tok_string;
+		arith tok_ival;		/* for INTEGER */
+		char *tok_fval;		/* for FLOATING */
+	} tok_data;
+};
+
+#define tk_symb	tok_symb
+#define tk_file	tok_file
+#define tk_line	tok_line
+#define tk_fund	tok_fund
+#define tk_idf	tok_data.tok_idf
+#define tk_bts	tok_data.tok_string.tok_bts
+#define tk_len	tok_data.tok_string.tok_len
+#define tk_ival	tok_data.tok_ival
+#define tk_fval	tok_data.tok_fval
+
+extern struct token dot, ahead, aside;
+extern int token_nmb;			/* number of the ahead token */
+extern int tk_nmb_at_last_syn_err;	/* token number at last syntax error */
+
+#ifndef NOPP
+extern int ReplaceMacros;	/* "LLlex.c"	*/
+extern int AccDefined;		/* "LLlex.c"	*/
+extern int Unstacked;		/* "LLlex.c"	*/
+extern int UnknownIdIsZero;	/* "LLlex.c"	*/
+#endif /* NOPP */
+extern int EoiForNewline;	/* "LLlex.c"	*/
+extern int AccFileSpecifier;	/* "LLlex.c"	*/
+extern int File_Inserted;	/* "LLlex.c"	*/
+
+extern int NoUnstack;		/* buffer.c	*/
+
+extern int err_occurred;	/* "error.c"	*/
+
+#define	DOT	dot.tk_symb
+#define	AHEAD	ahead.tk_symb
+#define	ASIDE	aside.tk_symb
+
+#define EOF	(-1)

lang/cem/cemcom.ansi/LLmessage.c

@@ -0,0 +1,64 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*		PARSER ERROR ADMINISTRATION		*/
+
+#include	<alloc.h>
+#include	"idf.h"
+#include	"arith.h"
+#include	"LLlex.h"
+#include	"Lpars.h"
+
+extern char *symbol2str();
+
+LLmessage(tk)	{
+	err_occurred = 1;
+	if (tk < 0)	{
+		error("end of file expected");
+	}
+	else if (tk)	{
+#ifndef LLNONCORR
+		error("%s missing before %s", symbol2str(tk), symbol2str(DOT));
+#endif
+		insert_token(tk);
+	}
+	else	{
+#ifndef LLNONCORR
+		error("%s deleted", symbol2str(DOT));
+#else
+		error("%s not expected", symbol2str(DOT));
+#endif
+	}
+	tk_nmb_at_last_syn_err = token_nmb;
+}
+
+insert_token(tk)
+	int tk;
+{
+	aside = dot;
+
+	DOT = tk;
+
+	switch (tk)	{
+	/* The operands need some body */
+	case IDENTIFIER:
+		dot.tk_idf = gen_idf();
+		break;
+	case TYPE_IDENTIFIER:
+		dot.tk_idf = str2idf("int", 0);
+		break;
+	case STRING:
+		dot.tk_bts = Salloc("", 1);
+		dot.tk_len = 1;
+		break;
+	case INTEGER:
+		dot.tk_fund = INT;
+		dot.tk_ival = 1;
+		break;
+	case FLOATING:
+		dot.tk_fval = Salloc("0.0", 4);
+		break;
+	}
+}

lang/cem/cemcom.ansi/LintPars

@@ -0,0 +1,143 @@
+!File: lint.h
+#define	LINT		1	/* if defined, 'lint' is produced	*/
+#define	ANSI		1	/* tell l_* files it's ANSI		*/
+
+
+!File: pathlength.h
+#define PATHLENGTH	1024	/* max. length of path to file		*/
+
+
+!File: errout.h
+#define	ERROUT		STDERR	/* file pointer for writing messages	*/
+#define	ERR_SHADOW	0	/* a syntax error overshadows error messages
+					until ERR_SHADOW symbols have been
+					accepted without syntax error */
+
+
+!File: idfsize.h
+#define	IDFSIZE	64	/* maximum significant length of an identifier	*/
+
+
+!File: numsize.h
+#define	NUMSIZE	256	/* maximum length of a numeric constant		*/
+
+
+!File: nparams.h
+#define	NPARAMS 32	/* maximum number of parameters			*/
+#define	STDC_NPARAMS 31	/* ANSI limit on number of parameters		*/
+
+
+!File: ifdepth.h
+#define	IFDEPTH	256	/* maximum number of nested if-constructions	*/
+
+
+!File: density.h
+#define	DENSITY	2	/* see switch.[ch] for an explanation		*/
+
+
+!File: macbuf.h
+#define	LAPBUF	128	/* initial size of macro replacement buffer	*/
+#define ARGBUF	128	/* initial size of macro parameter buffer(s)	*/
+
+
+!File: strsize.h
+#define ISTRSIZE	32	/* minimum number of bytes allocated for
+					storing a string		*/
+#define RSTRSIZE	16	/* step size in enlarging the memory for
+					the storage of a string		*/
+
+
+!File: trgt_sizes.h
+#define MAXSIZE		8	/* the maximum of the SZ_* constants	*/
+
+/* target machine sizes	*/
+#define	SZ_CHAR		1
+#define	SZ_SHORT	2
+#define SZ_WORD		4
+#define	SZ_INT		4
+#define	SZ_LONG		4
+#define	SZ_FLOAT	4
+#define	SZ_DOUBLE	8
+#define	SZ_POINTER	4
+#define	SZ_LNGDBL	8	/* for now */
+
+/* target machine alignment requirements	*/
+#define	AL_CHAR		1
+#define	AL_SHORT	SZ_SHORT
+#define AL_WORD		SZ_WORD
+#define	AL_INT		SZ_WORD
+#define	AL_LONG		SZ_WORD
+#define	AL_FLOAT	SZ_WORD
+#define	AL_DOUBLE	SZ_WORD
+#define	AL_LNGDBL	SZ_WORD
+#define	AL_POINTER	SZ_WORD
+#define AL_STRUCT	1
+#define AL_UNION	1
+
+
+!File: botch_free.h
+#undef BOTCH_FREE	1	/* when defined, botch freed memory, as a check	*/
+
+
+!File: dataflow.h
+#undef	DATAFLOW	1	/* produce some compile-time xref	*/
+
+
+!File: debug.h
+#undef DEBUG		1	/* perform various self-tests		*/
+
+
+!File: use_tmp.h
+#undef PREPEND_SCOPES	1	/* collect exa, exp, ina and inp commands
+					and if USE_TMP is defined let them
+					precede the rest of the generated
+					compact code	*/
+#undef USE_TMP		1	/* use C_insertpart, C_endpart mechanism
+					to generate EM-code in the order needed
+					for the code-generators. If not defined,
+					the old-style peephole optimizer is
+					needed.	*/
+
+
+!File: parbufsize.h
+#define PARBUFSIZE	1024
+
+
+!File: textsize.h
+#define ITEXTSIZE	 32	/* 1st piece of memory for repl. text	*/
+
+
+!File: inputtype.h
+#define INP_READ_IN_ONE	1	/* read input file in one	*/
+
+
+!File: nopp.h
+#undef NOPP		1	/* if NOT defined, use built-int preprocessor */
+
+
+!File: nobitfield.h
+#undef NOBITFIELD	1	/* if NOT defined, implement bitfields	*/
+
+
+!File: spec_arith.h
+/* describes internal compiler arithmetics */
+#undef	SPECIAL_ARITHMETICS	/* something different from native long */
+#undef UNSIGNED_ARITH	unsigned arith
+
+
+!File: static.h
+#define GSTATIC			/* for large global "static" arrays */
+
+
+!File: nocross.h
+#undef NOCROSS		1	/* if NOT defined, cross compiler */
+
+
+!File: regcount.h
+#undef REGCOUNT		1	/* count occurrences for register messages */
+
+
+!File: dbsymtab.h
+#undef DBSYMTAB	1	/* ability to produce symbol table for debugger */
+
+

lang/cem/cemcom.ansi/Makefile.erik

@@ -0,0 +1,718 @@
+# $Header$
+#	M A K E F I L E   F O R   A C K   C - C O M P I L E R
+
+# Machine and environ dependent definitions
+EMHOME =	/usr/em#			# ACK tree on this machine
+DESTINATION =	/user1/$$USER/bin#		# where to put the stuff
+MKDEP =		$(EMHOME)/bin/mkdep#		# dependency generator
+MAP =
+#MAP = -DInsertFile=ins_file -DInsertText=ins_text# bug in m68k2 back end
+SIM =		/user1/dick/bin/sim#		# Dicks sim program
+LINT =		/usr/new/lint
+
+# Libraries and EM interface definitions
+SYSLIB =	$(EMHOME)/modules/lib/libsystem.a
+EMKLIB =	$(EMHOME)/modules/lib/libemk.a
+EMELIB =	$(EMHOME)/modules/lib/libeme.a $(EMHOME)/lib/em_data.a
+STRLIB =	$(EMHOME)/modules/lib/libstring.a
+PRTLIB =	$(EMHOME)/modules/lib/libprint.a
+EMMESLIB =	$(EMHOME)/modules/lib/libem_mes.a
+INPLIB =	$(EMHOME)/modules/lib/libinput.a
+ALLOCLIB =	$(EMHOME)/modules/lib/liballoc.a
+MALLOC =	$(EMHOME)/modules/lib/malloc.o
+#CH3LIB =	$(EMHOME)/modules/lib/libch3.a
+CH3LIB =
+LIBS =		$(INPLIB) $(CH3LIB) $(EMMESLIB) $(EMKLIB) \
+		$(PRTLIB) $(STRLIB) $(ALLOCLIB) $(MALLOC) $(SYSLIB)
+ELIBS =		$(INPLIB) $(CH3LIB) $(EMMESLIB) $(EMELIB) \
+		$(PRTLIB) $(STRLIB) $(ALLOCLIB) $(MALLOC) $(SYSLIB)
+LIB_INCLUDES =	-I$(EMHOME)/modules/h -I$(EMHOME)/modules/pkg
+EM_INCLUDES =	-I$(EMHOME)/h
+SYSLLIB =	$(EMHOME)/modules/lib/llib-lsys.ln
+EMKLLIB =	$(EMHOME)/modules/lib/llib-lemk.ln
+EMELLIB =	$(EMHOME)/modules/lib/llib-leme.ln
+STRLLIB =	$(EMHOME)/modules/lib/llib-lstr.ln
+PRTLLIB =	$(EMHOME)/modules/lib/llib-lprint.ln
+EMMESLLIB =	$(EMHOME)/modules/lib/llib-lmes.ln
+INPLLIB =	$(EMHOME)/modules/lib/llib-linput.ln
+CH3LLIB =	$(EMHOME)/modules/lib/llib-lch3.ln
+ALLOCLLIB =	$(EMHOME)/modules/lib/llib-alloc.ln
+LINTLIBS =
+#LINTLIBS =	$(CH3LLIB) $(INPLLIB) $(EMMESLLIB) $(EMKLLIB) \
+#		$(PRTLLIB) $(STRLLIB) $(SYSLLIB) $(ALLOCLLIB)
+
+# Where to install the compiler and its driver
+CEMCOM =	$(DESTINATION)/cemcom
+DRIVER =	$(DESTINATION)/cem
+
+# What C compiler to use and how
+# CC = $(ACK) -.c
+# CC = CC
+# CC = /bin/cc
+COPTIONS =
+
+# What parser generator to use and how
+GEN =		$(EMHOME)/bin/LLgen
+GENOPTIONS =	-vv
+
+# Special #defines during compilation
+CDEFS =		$(MAP) $(EM_INCLUDES) $(LIB_INCLUDES)
+CFLAGS =	$(CDEFS) $(COPTIONS) -O# we cannot pass the COPTIONS to lint!
+
+# Grammar files and their objects
+LSRC =	tokenfile.g declar.g statement.g expression.g program.g ival.g
+GLCSRC = tokenfile.c declar.c statement.c expression.c program.c Lpars.c ival.c
+LOBJ =	tokenfile.o declar.o statement.o expression.o program.o Lpars.o ival.o
+
+CSRC =  main.c idf.c declarator.c decspecs.c struct.c \
+        expr.c ch7.c ch7bin.c cstoper.c arith.c \
+        asm.c code.c dumpidf.c error.c field.c\
+        tokenname.c LLlex.c LLmessage.c \
+        input.c domacro.c replace.c init.c options.c \
+        scan.c skip.c stack.c type.c ch7mon.c label.c eval.c \
+        switch.c conversion.c util.c \
+        blocks.c dataflow.c Version.c
+# Objects of hand-written C files
+COBJ =	main.o idf.o declarator.o decspecs.o struct.o \
+	expr.o ch7.o ch7bin.o cstoper.o arith.o \
+	asm.o code.o dumpidf.o error.o field.o\
+	tokenname.o LLlex.o LLmessage.o \
+	input.o domacro.o replace.o init.o options.o \
+	scan.o skip.o stack.o type.o ch7mon.o label.o eval.o \
+	switch.o conversion.o util.o \
+	blocks.o dataflow.o Version.o
+
+# Objects of other generated C files
+GCSRC = char.c symbol2str.c next.c
+GOBJ =	char.o symbol2str.o next.o
+
+# generated source files
+GSRC =	char.c symbol2str.c next.c \
+	code.h declar.h decspecs.h def.h expr.h field.h  estack.h \
+	idf.h macro.h stack.h stmt.h struct.h switch.h type.h util.h
+
+# .h files generated by `make hfiles'; PLEASE KEEP THIS UP-TO-DATE!
+GHSRC = botch_free.h dataflow.h debug.h density.h errout.h \
+	idfsize.h ifdepth.h inputtype.h inumlength.h lapbuf.h \
+	nobitfield.h nofloat.h nopp.h noRoption.h nocross.h \
+	nparams.h numsize.h parbufsize.h pathlength.h \
+	strsize.h target_sizes.h textsize.h use_tmp.h spec_arith.h static.h \
+	reg_count.h
+
+# Other generated files, for 'make clean' only
+GENERATED = tokenfile.g Lpars.h LLfiles LL.output lint.out \
+	print Xref lxref hfiles cfiles $(GLCSRC)
+
+# include files containing ALLOCDEF specifications
+NEXTFILES = code.str declar.str decspecs.str def.str expr.str field.str \
+	estack.str util.str \
+	idf.str macro.str stack.str stmt.str struct.str switch.str type.str
+
+.SUFFIXES: .str .h
+.str.h:
+	./make.allocd <$*.str >$*.h
+
+all:	cc
+
+cc:
+	make "EMHOME="$(EMHOME) "CC=$(CC)" hfiles
+	make "EMHOME="$(EMHOME) "CC=$(CC)" LLfiles
+	make "EMHOME="$(EMHOME) "CC=$(CC)" main
+
+cem:	cem.c
+	$(CC) -O cem.c $(SYSLIB) -o cem
+
+lint.cem: cem.c
+	$(LINT) -bx cem.c
+
+hfiles: ./make.hfiles Parameters
+	./make.hfiles Parameters
+	@touch hfiles
+
+LLfiles: $(LSRC)
+	$(GEN) $(GENOPTIONS) $(LSRC)
+	@touch LLfiles
+
+tokenfile.g:	tokenname.c make.tokfile
+	<tokenname.c ./make.tokfile >tokenfile.g
+
+symbol2str.c:	tokenname.c make.tokcase
+	<tokenname.c ./make.tokcase >symbol2str.c
+
+char.c:	char.tab
+	$(EMHOME)/bin/tabgen -fchar.tab >char.c
+
+next.c:	make.next $(NEXTFILES)
+	./make.next $(NEXTFILES) >next.c
+
+code.h:		make.allocd
+declar.h:	make.allocd
+decspecs.h:	make.allocd
+def.h:		make.allocd
+estack.h:	make.allocd
+expr.h:		make.allocd
+field.h:	make.allocd
+idf.h:		make.allocd
+macro.h:	make.allocd
+stack.h:	make.allocd
+stmt.h:		make.allocd
+struct.h:	make.allocd
+switch.h:	make.allocd
+type.h:		make.allocd
+util.h:		make.allocd
+
+# Objects needed for 'main'
+OBJ =	$(COBJ) $(LOBJ) $(GOBJ)
+SRC =	$(CSRC) $(LCSRC) $(GCSRC)
+
+main:	$(OBJ) Makefile.erik
+	$(CC) $(COPTIONS) $(LFLAGS) $(OBJ) $(LIBS) -o main 
+	size main
+
+emain:	$(OBJ) Makefile.erik
+	$(CC) $(COPTIONS) $(LFLAGS) $(OBJ) $(ELIBS) -o emain 
+	size emain
+
+cfiles: hfiles LLfiles $(GSRC)
+	@touch cfiles
+
+install: main cem
+	cp main $(CEMCOM)
+	cp cem $(DRIVER)
+
+print:	files
+	pr `cat files` > print
+
+tags:	cfiles
+	ctags $(SRC)
+
+shar:	files
+	shar `cat files`
+
+listcfiles:
+	@echo $(SRC)
+
+listobjects:
+	@echo $(OBJ)
+
+depend:	cfiles
+	sed '/^#AUTOAUTO/,$$d' Makefile.erik >Makefile.erik.new
+	echo '#AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO' >>Makefile.erik.new
+	$(MKDEP) $(SRC) | sed 's/\.c:/.o:/' >>Makefile.erik.new
+	mv Makefile.erik Makefile.erik.old
+	mv Makefile.erik.new Makefile.erik
+	
+xref:
+	ctags -x `grep "\.[ch]" files`|sed "s/).*/)/">Xref
+	
+lxref:
+	lxref $(OBJ) -lc >lxref
+
+lint:	lint.main lint.cem
+
+lint.main: cfiles
+	$(LINT) -bx $(CDEFS) $(SRC) $(LINTLIBS) >lint.out
+
+cchk:
+	cchk $(SRC)
+
+clean:
+	rm -f $(LCSRC) $(OBJ) $(GENERATED) $(GSRC) $(GHSRC)
+
+sim:	cfiles
+	$(SIM) $(SIMFLAGS) $(CSRC) $(GSRC) $(LSRC)
+
+#AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
+main.o: LLlex.h
+main.o: Lpars.h
+main.o: align.h
+main.o: arith.h
+main.o: debug.h
+main.o: declar.h
+main.o: file_info.h
+main.o: idf.h
+main.o: input.h
+main.o: inputtype.h
+main.o: level.h
+main.o: noRoption.h
+main.o: nobitfield.h
+main.o: nocross.h
+main.o: nofloat.h
+main.o: nopp.h
+main.o: sizes.h
+main.o: spec_arith.h
+main.o: specials.h
+main.o: target_sizes.h
+main.o: tokenname.h
+main.o: type.h
+main.o: use_tmp.h
+idf.o: LLlex.h
+idf.o: Lpars.h
+idf.o: align.h
+idf.o: arith.h
+idf.o: assert.h
+idf.o: botch_free.h
+idf.o: debug.h
+idf.o: declar.h
+idf.o: decspecs.h
+idf.o: def.h
+idf.o: file_info.h
+idf.o: idf.h
+idf.o: idfsize.h
+idf.o: label.h
+idf.o: level.h
+idf.o: noRoption.h
+idf.o: nobitfield.h
+idf.o: nocross.h
+idf.o: nofloat.h
+idf.o: nopp.h
+idf.o: sizes.h
+idf.o: spec_arith.h
+idf.o: specials.h
+idf.o: stack.h
+idf.o: struct.h
+idf.o: target_sizes.h
+idf.o: type.h
+declarator.o: Lpars.h
+declarator.o: arith.h
+declarator.o: botch_free.h
+declarator.o: declar.h
+declarator.o: expr.h
+declarator.o: idf.h
+declarator.o: label.h
+declarator.o: nobitfield.h
+declarator.o: nocross.h
+declarator.o: nofloat.h
+declarator.o: nopp.h
+declarator.o: sizes.h
+declarator.o: spec_arith.h
+declarator.o: target_sizes.h
+declarator.o: type.h
+decspecs.o: Lpars.h
+decspecs.o: arith.h
+decspecs.o: decspecs.h
+decspecs.o: def.h
+decspecs.o: level.h
+decspecs.o: noRoption.h
+decspecs.o: nobitfield.h
+decspecs.o: nofloat.h
+decspecs.o: spec_arith.h
+decspecs.o: type.h
+struct.o: LLlex.h
+struct.o: Lpars.h
+struct.o: align.h
+struct.o: arith.h
+struct.o: assert.h
+struct.o: botch_free.h
+struct.o: debug.h
+struct.o: def.h
+struct.o: field.h
+struct.o: file_info.h
+struct.o: idf.h
+struct.o: level.h
+struct.o: noRoption.h
+struct.o: nobitfield.h
+struct.o: nocross.h
+struct.o: nofloat.h
+struct.o: nopp.h
+struct.o: sizes.h
+struct.o: spec_arith.h
+struct.o: stack.h
+struct.o: struct.h
+struct.o: target_sizes.h
+struct.o: type.h
+expr.o: LLlex.h
+expr.o: Lpars.h
+expr.o: arith.h
+expr.o: botch_free.h
+expr.o: declar.h
+expr.o: decspecs.h
+expr.o: def.h
+expr.o: expr.h
+expr.o: file_info.h
+expr.o: idf.h
+expr.o: label.h
+expr.o: level.h
+expr.o: noRoption.h
+expr.o: nobitfield.h
+expr.o: nocross.h
+expr.o: nofloat.h
+expr.o: nopp.h
+expr.o: sizes.h
+expr.o: spec_arith.h
+expr.o: target_sizes.h
+expr.o: type.h
+ch7.o: Lpars.h
+ch7.o: arith.h
+ch7.o: assert.h
+ch7.o: debug.h
+ch7.o: def.h
+ch7.o: expr.h
+ch7.o: idf.h
+ch7.o: label.h
+ch7.o: nobitfield.h
+ch7.o: nofloat.h
+ch7.o: nopp.h
+ch7.o: spec_arith.h
+ch7.o: struct.h
+ch7.o: type.h
+ch7bin.o: Lpars.h
+ch7bin.o: arith.h
+ch7bin.o: botch_free.h
+ch7bin.o: expr.h
+ch7bin.o: idf.h
+ch7bin.o: label.h
+ch7bin.o: noRoption.h
+ch7bin.o: nobitfield.h
+ch7bin.o: nofloat.h
+ch7bin.o: nopp.h
+ch7bin.o: spec_arith.h
+ch7bin.o: struct.h
+ch7bin.o: type.h
+cstoper.o: Lpars.h
+cstoper.o: arith.h
+cstoper.o: assert.h
+cstoper.o: debug.h
+cstoper.o: expr.h
+cstoper.o: idf.h
+cstoper.o: label.h
+cstoper.o: nobitfield.h
+cstoper.o: nocross.h
+cstoper.o: nofloat.h
+cstoper.o: nopp.h
+cstoper.o: sizes.h
+cstoper.o: spec_arith.h
+cstoper.o: target_sizes.h
+cstoper.o: type.h
+arith.o: Lpars.h
+arith.o: arith.h
+arith.o: botch_free.h
+arith.o: expr.h
+arith.o: field.h
+arith.o: idf.h
+arith.o: label.h
+arith.o: mes.h
+arith.o: noRoption.h
+arith.o: nobitfield.h
+arith.o: nofloat.h
+arith.o: nopp.h
+arith.o: spec_arith.h
+arith.o: type.h
+code.o: Lpars.h
+code.o: arith.h
+code.o: assert.h
+code.o: atw.h
+code.o: botch_free.h
+code.o: code.h
+code.o: dataflow.h
+code.o: debug.h
+code.o: declar.h
+code.o: decspecs.h
+code.o: def.h
+code.o: expr.h
+code.o: file_info.h
+code.o: idf.h
+code.o: label.h
+code.o: level.h
+code.o: noRoption.h
+code.o: nobitfield.h
+code.o: nocross.h
+code.o: nofloat.h
+code.o: nopp.h
+code.o: sizes.h
+code.o: spec_arith.h
+code.o: specials.h
+code.o: stack.h
+code.o: stmt.h
+code.o: target_sizes.h
+code.o: type.h
+code.o: use_tmp.h
+dumpidf.o: Lpars.h
+dumpidf.o: arith.h
+dumpidf.o: debug.h
+dumpidf.o: def.h
+dumpidf.o: expr.h
+dumpidf.o: field.h
+dumpidf.o: idf.h
+dumpidf.o: label.h
+dumpidf.o: nobitfield.h
+dumpidf.o: nofloat.h
+dumpidf.o: nopp.h
+dumpidf.o: spec_arith.h
+dumpidf.o: stack.h
+dumpidf.o: static.h
+dumpidf.o: struct.h
+dumpidf.o: type.h
+error.o: LLlex.h
+error.o: arith.h
+error.o: debug.h
+error.o: errout.h
+error.o: expr.h
+error.o: file_info.h
+error.o: label.h
+error.o: nofloat.h
+error.o: nopp.h
+error.o: spec_arith.h
+error.o: tokenname.h
+field.o: Lpars.h
+field.o: align.h
+field.o: arith.h
+field.o: assert.h
+field.o: code.h
+field.o: debug.h
+field.o: expr.h
+field.o: field.h
+field.o: idf.h
+field.o: label.h
+field.o: nobitfield.h
+field.o: nocross.h
+field.o: nofloat.h
+field.o: nopp.h
+field.o: sizes.h
+field.o: spec_arith.h
+field.o: target_sizes.h
+field.o: type.h
+tokenname.o: LLlex.h
+tokenname.o: Lpars.h
+tokenname.o: arith.h
+tokenname.o: file_info.h
+tokenname.o: idf.h
+tokenname.o: nofloat.h
+tokenname.o: nopp.h
+tokenname.o: spec_arith.h
+tokenname.o: tokenname.h
+LLlex.o: LLlex.h
+LLlex.o: Lpars.h
+LLlex.o: arith.h
+LLlex.o: assert.h
+LLlex.o: class.h
+LLlex.o: debug.h
+LLlex.o: def.h
+LLlex.o: file_info.h
+LLlex.o: idf.h
+LLlex.o: idfsize.h
+LLlex.o: input.h
+LLlex.o: nocross.h
+LLlex.o: nofloat.h
+LLlex.o: nopp.h
+LLlex.o: numsize.h
+LLlex.o: sizes.h
+LLlex.o: spec_arith.h
+LLlex.o: strsize.h
+LLlex.o: target_sizes.h
+LLmessage.o: LLlex.h
+LLmessage.o: Lpars.h
+LLmessage.o: arith.h
+LLmessage.o: file_info.h
+LLmessage.o: idf.h
+LLmessage.o: nofloat.h
+LLmessage.o: nopp.h
+LLmessage.o: spec_arith.h
+input.o: file_info.h
+input.o: input.h
+input.o: inputtype.h
+input.o: nopp.h
+domacro.o: LLlex.h
+domacro.o: Lpars.h
+domacro.o: arith.h
+domacro.o: assert.h
+domacro.o: botch_free.h
+domacro.o: class.h
+domacro.o: debug.h
+domacro.o: file_info.h
+domacro.o: idf.h
+domacro.o: idfsize.h
+domacro.o: ifdepth.h
+domacro.o: input.h
+domacro.o: interface.h
+domacro.o: macro.h
+domacro.o: nofloat.h
+domacro.o: nopp.h
+domacro.o: nparams.h
+domacro.o: parbufsize.h
+domacro.o: spec_arith.h
+domacro.o: textsize.h
+replace.o: LLlex.h
+replace.o: arith.h
+replace.o: assert.h
+replace.o: class.h
+replace.o: debug.h
+replace.o: file_info.h
+replace.o: idf.h
+replace.o: input.h
+replace.o: interface.h
+replace.o: macro.h
+replace.o: nofloat.h
+replace.o: nopp.h
+replace.o: pathlength.h
+replace.o: spec_arith.h
+replace.o: static.h
+replace.o: strsize.h
+init.o: class.h
+init.o: idf.h
+init.o: interface.h
+init.o: macro.h
+init.o: nopp.h
+options.o: align.h
+options.o: arith.h
+options.o: botch_free.h
+options.o: class.h
+options.o: dataflow.h
+options.o: idf.h
+options.o: idfsize.h
+options.o: macro.h
+options.o: noRoption.h
+options.o: nobitfield.h
+options.o: nocross.h
+options.o: nofloat.h
+options.o: nopp.h
+options.o: sizes.h
+options.o: spec_arith.h
+options.o: target_sizes.h
+options.o: use_tmp.h
+scan.o: class.h
+scan.o: idf.h
+scan.o: input.h
+scan.o: interface.h
+scan.o: lapbuf.h
+scan.o: macro.h
+scan.o: nopp.h
+scan.o: nparams.h
+skip.o: LLlex.h
+skip.o: arith.h
+skip.o: class.h
+skip.o: file_info.h
+skip.o: input.h
+skip.o: interface.h
+skip.o: nofloat.h
+skip.o: nopp.h
+skip.o: spec_arith.h
+stack.o: Lpars.h
+stack.o: arith.h
+stack.o: botch_free.h
+stack.o: debug.h
+stack.o: def.h
+stack.o: idf.h
+stack.o: level.h
+stack.o: mes.h
+stack.o: noRoption.h
+stack.o: nobitfield.h
+stack.o: nofloat.h
+stack.o: nopp.h
+stack.o: spec_arith.h
+stack.o: stack.h
+stack.o: struct.h
+stack.o: type.h
+type.o: Lpars.h
+type.o: align.h
+type.o: arith.h
+type.o: botch_free.h
+type.o: def.h
+type.o: idf.h
+type.o: nobitfield.h
+type.o: nocross.h
+type.o: nofloat.h
+type.o: nopp.h
+type.o: sizes.h
+type.o: spec_arith.h
+type.o: target_sizes.h
+type.o: type.h
+ch7mon.o: Lpars.h
+ch7mon.o: arith.h
+ch7mon.o: botch_free.h
+ch7mon.o: def.h
+ch7mon.o: expr.h
+ch7mon.o: idf.h
+ch7mon.o: label.h
+ch7mon.o: nobitfield.h
+ch7mon.o: nofloat.h
+ch7mon.o: nopp.h
+ch7mon.o: spec_arith.h
+ch7mon.o: type.h
+label.o: Lpars.h
+label.o: arith.h
+label.o: def.h
+label.o: idf.h
+label.o: label.h
+label.o: level.h
+label.o: noRoption.h
+label.o: nobitfield.h
+label.o: nofloat.h
+label.o: nopp.h
+label.o: spec_arith.h
+label.o: type.h
+eval.o: Lpars.h
+eval.o: align.h
+eval.o: arith.h
+eval.o: assert.h
+eval.o: atw.h
+eval.o: code.h
+eval.o: dataflow.h
+eval.o: debug.h
+eval.o: def.h
+eval.o: expr.h
+eval.o: idf.h
+eval.o: label.h
+eval.o: level.h
+eval.o: mes.h
+eval.o: nobitfield.h
+eval.o: nocross.h
+eval.o: nofloat.h
+eval.o: nopp.h
+eval.o: sizes.h
+eval.o: spec_arith.h
+eval.o: specials.h
+eval.o: stack.h
+eval.o: target_sizes.h
+eval.o: type.h
+switch.o: Lpars.h
+switch.o: arith.h
+switch.o: assert.h
+switch.o: botch_free.h
+switch.o: code.h
+switch.o: debug.h
+switch.o: density.h
+switch.o: expr.h
+switch.o: idf.h
+switch.o: label.h
+switch.o: noRoption.h
+switch.o: nobitfield.h
+switch.o: nofloat.h
+switch.o: nopp.h
+switch.o: spec_arith.h
+switch.o: switch.h
+switch.o: type.h
+conversion.o: Lpars.h
+conversion.o: arith.h
+conversion.o: nobitfield.h
+conversion.o: nocross.h
+conversion.o: nofloat.h
+conversion.o: sizes.h
+conversion.o: spec_arith.h
+conversion.o: target_sizes.h
+conversion.o: type.h
+util.o: Lpars.h
+util.o: align.h
+util.o: def.h
+util.o: nocross.h
+util.o: nofloat.h
+util.o: regcount.h
+util.o: sizes.h
+util.o: stack.h
+util.o: target_sizes.h
+util.o: use_tmp.h
+util.o: util.h
+blocks.o: Lpars.h
+blocks.o: align.h
+blocks.o: arith.h
+blocks.o: atw.h
+blocks.o: label.h
+blocks.o: nocross.h
+blocks.o: nofloat.h
+blocks.o: sizes.h
+blocks.o: spec_arith.h
+blocks.o: stack.h
+blocks.o: target_sizes.h
+dataflow.o: dataflow.h
+char.o: class.h
+symbol2str.o: Lpars.h

lang/cem/cemcom.ansi/Resolve

@@ -0,0 +1,67 @@
+: create a directory Xsrc with name clashes resolved
+: and run make in that directory
+: '$Header$'
+
+case $# in
+1)	
+	;;
+*)	echo "$0: one argument expected" 1>&2
+	exit 1
+	;;
+esac
+PW=`pwd`
+options=
+case $1 in
+main|emain|lnt)
+	target=$PW/$1
+	;;
+omain)
+	target=$PW/$1
+	options=-DPEEPHOLE
+	;;
+cemain)
+	target=$PW/$1
+	options=-DCODE_EXPANDER
+	;;
+Xlint)
+	target=$1
+	;;
+*)	echo "$0: $1: Illegal argument" 1>&2
+	exit 1
+	;;
+esac
+if test -d ../Xsrc
+then
+	:
+else	mkdir ../Xsrc
+fi
+make EMHOME=$EMHOME longnames
+: remove code generating routines from the clashes list as they are defines.
+: code generating routine names start with C_
+sed '/^C_/d' < longnames > tmp$$
+cclash -c -l7 tmp$$ > ../Xsrc/Xclashes
+rm -f tmp$$
+cd ../Xsrc
+if cmp -s Xclashes clashes
+then
+	:
+else
+	mv Xclashes clashes
+fi
+rm -f Makefile
+for i in `cat $PW/Cfiles`
+do
+	cat >> Makefile <<EOF
+
+$i:	clashes $PW/$i
+	cid -Fclashes < $PW/$i > $i
+EOF
+done
+make EMHOME=$EMHOME `cat $PW/Cfiles`
+rm -f Makefile
+ed - $PW/Makefile <<'EOF'
+/^#EXCLEXCL/,/^#INCLINCL/d
+w Makefile
+q
+EOF
+make EMHOME=$EMHOME COPTIONS=$options MACH=$mach CURRDIR=$PW/ $target

lang/cem/cemcom.ansi/SmallPars

@@ -0,0 +1,143 @@
+!File: lint.h
+/*#define	LINT		1	/* if defined, 'lint' is produced	*/
+
+
+!File: pathlength.h
+#define PATHLENGTH	1024	/* max. length of path to file		*/
+
+
+!File: errout.h
+#define	ERROUT		STDERR	/* file pointer for writing messages	*/
+#define	ERR_SHADOW	5	/* a syntax error overshadows error messages
+					until ERR_SHADOW symbols have been
+					accepted without syntax error */
+
+
+!File: idfsize.h
+#define	IDFSIZE	64	/* maximum significant length of an identifier	*/
+
+
+!File: numsize.h
+#define	NUMSIZE	256	/* maximum length of a numeric constant		*/
+
+
+!File: nparams.h
+#define	NPARAMS 32	/* maximum number of parameters 		*/
+#define	STDC_NPARAMS 31	/* ANSI limit on number of parameters		*/
+
+
+!File: ifdepth.h
+#define	IFDEPTH	256	/* maximum number of nested if-constructions	*/
+
+
+!File: density.h
+#define	DENSITY	3	/* see switch.[ch] for an explanation		*/
+
+
+!File: macbuf.h
+#define	LAPBUF	128	/* initial size of macro replacement buffer	*/
+#define ARGBUF	128	/* initial size of macro parameter buffer(s)	*/
+
+
+!File: strsize.h
+#define ISTRSIZE	32	/* minimum number of bytes allocated for
+					storing a string		*/
+#define RSTRSIZE	8	/* step size in enlarging the memory for
+					the storage of a string		*/
+
+
+!File: trgt_sizes.h
+#define MAXSIZE		8	/* the maximum of the SZ_* constants	*/
+
+/* target machine sizes	*/
+#define	SZ_CHAR		1
+#define	SZ_SHORT	2
+#define SZ_WORD		4
+#define	SZ_INT		4
+#define	SZ_LONG		4
+#define	SZ_FLOAT	4
+#define	SZ_DOUBLE	8
+#define	SZ_LNGDBL	8	/* for now */
+#define	SZ_POINTER	4
+
+/* target machine alignment requirements	*/
+#define	AL_CHAR		1
+#define	AL_SHORT	SZ_SHORT
+#define AL_WORD		SZ_WORD
+#define	AL_INT		SZ_WORD
+#define	AL_LONG		SZ_WORD
+#define	AL_FLOAT	SZ_WORD
+#define	AL_DOUBLE	SZ_WORD
+#define	AL_LNGDBL	SZ_WORD
+#define	AL_POINTER	SZ_WORD
+#define AL_STRUCT	1
+#define AL_UNION	1
+
+
+!File: botch_free.h
+/*#define BOTCH_FREE	1	/* when defined, botch freed memory, as a check	*/
+
+
+!File: dataflow.h
+/*#define DATAFLOW	1	/* produce some compile-time xref	*/
+
+
+!File: debug.h
+/*#define DEBUG		1	/* perform various self-tests		*/
+#define NDEBUG		1	/* disable assertions			*/
+
+
+!File: use_tmp.h
+/*#define PREPEND_SCOPES	1	/* collect exa, exp, ina and inp commands
+					and if USE_TMP is defined let them
+					precede the rest of the generated
+					compact code	*/
+/*#define USE_TMP		1	/* use C_insertpart, C_endpart mechanism
+					to generate EM-code in the order needed
+					for the code-generators. If not defined,
+					the old-style peephole optimizer is
+					needed.	*/
+
+
+!File: parbufsize.h
+#define PARBUFSIZE	1024
+
+
+!File: textsize.h
+#define ITEXTSIZE	16	/* 1st piece of memory for repl. text	*/
+
+
+!File: inputtype.h
+/*#define INP_READ_IN_ONE	1	/* read input file in one	*/
+
+
+!File: nopp.h
+#define NOPP		1	/* if NOT defined, use built-int preprocessor */
+
+
+!File: nobitfield.h
+/*#define NOBITFIELD	1	/* if NOT defined, implement bitfields	*/
+
+
+!File: spec_arith.h
+/* describes internal compiler arithmetics */
+#undef	SPECIAL_ARITHMETICS	/* something different from native long */
+/*#define UNSIGNED_ARITH	unsigned arith	/* if it is supported */
+
+
+!File: static.h
+#define GSTATIC			/* for large global "static" arrays */
+
+
+!File: nocross.h
+/*#define NOCROSS		1	/* if NOT defined, cross compiler */
+
+
+!File: regcount.h
+/*#define REGCOUNT		1	/* count occurrences for register messages */
+
+
+!File: dbsymtab.h
+/*#define DBSYMTAB	1	/* ability to produce symbol table for debugger */
+
+

lang/cem/cemcom.ansi/Version.c

@@ -0,0 +1,8 @@
+/* $Header$ */
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+#ifndef	lint
+static char Version[] = "ACK CEM compiler Version 3.1";
+#endif	lint

lang/cem/cemcom.ansi/align.h

@@ -0,0 +1,30 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	 A L I G N M E N T   D E F I N I T I O N S	*/
+
+#include "nocross.h"
+#include "trgt_sizes.h"
+
+#ifndef NOCROSS
+extern int
+	short_align, word_align, int_align, long_align,
+	float_align, double_align, lngdbl_align,
+	pointer_align,
+	struct_align, union_align;
+#else /* NOCROSS */
+#define short_align	((int)AL_SHORT)
+#define word_align	((int)AL_WORD)
+#define int_align	((int)AL_INT)
+#define long_align	((int)AL_LONG)
+#define float_align	((int)AL_FLOAT)
+#define double_align	((int)AL_DOUBLE)
+#define	lngdbl_align	((int)AL_LNGDBL)
+#define pointer_align	((int)AL_POINTER)
+#define struct_align	((int)AL_STRUCT)
+#define union_align	((int)AL_UNION)
+#endif /* NOCROSS */
+
+extern arith align();

lang/cem/cemcom.ansi/arith.c

@@ -0,0 +1,637 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	A R I T H M E T I C   C O N V E R S I O N S	 */
+
+/*	This file contains the routines for the various conversions that
+	may befall operands in C. It is structurally a mess, but I haven't
+	decided yet whether I can't find the right structure or the
+	semantics of C is a mess.
+*/
+
+#include	<alloc.h>
+#include	"debug.h"
+#include	"lint.h"
+#include	"nobitfield.h"
+#include	"idf.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"sizes.h"
+#include	"type.h"
+#include	"proto.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"Lpars.h"
+#include	"field.h"
+#include	"mes.h"
+#include	"assert.h"
+
+extern char *symbol2str();
+extern char options[];
+extern arith flt_flt2arith();
+extern label code_string();
+
+arithbalance(e1p, oper, e2p)	/* 3.1.2.5 */
+	register struct expr **e1p, **e2p;
+	int oper;
+{
+	/*	The expressions *e1p and *e2p are balanced to be operands
+		of the arithmetic operator oper.
+		We check here if the EX_PTRDIFF flag should be retained.
+		They are set to zero in because one of the opreands might
+		have a floating type, in which case the flags shouldn't
+		travel upward in the expression tree.
+	*/
+	register int t1, t2, u1, u2;
+	int shifting = (oper == LEFT || oper == RIGHT
+			|| oper == LEFTAB || oper == RIGHTAB);
+	int ptrdiff = 0;
+
+	t1 = any2arith(e1p, oper);
+	t2 = any2arith(e2p, oper);
+
+	if (int_size != pointer_size) {
+		if (ptrdiff = ((*e1p)->ex_flags & EX_PTRDIFF)
+			    || ((*e2p)->ex_flags & EX_PTRDIFF)) {
+			if (!((*e1p)->ex_flags & EX_PTRDIFF) && t1 == LONG)
+				ptrdiff = 0;
+			if (!((*e2p)->ex_flags & EX_PTRDIFF) && t2 == LONG
+			    && !shifting)
+				ptrdiff = 0;
+		}
+		/* Now turn off ptrdiff flags */
+		(*e1p)->ex_flags &= ~EX_PTRDIFF;
+		(*e2p)->ex_flags &= ~EX_PTRDIFF;
+	}
+
+	/* Now t1 and t2 are either INT, LONG, FLOAT, DOUBLE, or LNGDBL */
+
+	/*	If any operand has the type long double, the other operand
+		is converted to long double.
+	*/
+	/* ??? t1 == LNGDBL, t2 == DOUBLE */
+	if (t1 == LNGDBL) {
+		if (t2 != LNGDBL) {
+		    if (t2 == DOUBLE || t2 == FLOAT)
+			float2float(e2p, lngdbl_type);
+		    else
+			int2float(e2p, lngdbl_type);
+		}
+		return;
+	} else if (t2 == LNGDBL) {
+		if (t1 != LNGDBL)
+		    if (t1 == DOUBLE || t1 == FLOAT)
+			float2float(e1p, lngdbl_type);
+		    else
+			int2float(e1p, lngdbl_type);
+		return;
+	}
+
+	/*	If any operand has the type double, the other operand
+		is converted to double.
+	*/
+	if (t1 == DOUBLE) {
+		if (t2 == FLOAT)
+			float2float(e2p, double_type);
+		else if (t2 != DOUBLE)
+			int2float(e2p, double_type);
+		return;
+	} else if (t2 == DOUBLE) {
+		if (t1 == FLOAT)
+			float2float(e1p, double_type);
+		else if (t1 != DOUBLE)
+			int2float(e1p, double_type);
+		return;
+	}
+
+	/*	If any operand has the type float, the other operand
+		is converted to float.
+	*/
+	if (t1 == FLOAT) {
+		if (t2 != FLOAT)
+			int2float(e2p, float_type);
+		return;
+	} else if (t2 == FLOAT) {
+		if (t1 != FLOAT)
+			int2float(e1p, float_type);
+		return;
+	}
+
+	/* Now they are INT or LONG */
+	u1 = (*e1p)->ex_type->tp_unsigned;
+	u2 = (*e2p)->ex_type->tp_unsigned;
+
+	/*	If either operand has type unsigned long int, the other
+		operand is converted to unsigned long int.
+	*/
+	if (t1 == LONG && u1 && (t2 != LONG || !u2))
+		t2 = int2int(e2p, ulong_type);
+	else if (t2 == LONG && u2 && (t1 != LONG || !u1)
+			&& !shifting)	/* ??? */
+		t1 = int2int(e1p, ulong_type);
+
+	/*	If one operand has type long int and the other has type unsigned
+		int, if a long int can represent all values of an unsigned int,
+		the operand of type unsigned int is converted to long int; if
+		a long int cannot represent all values of an unsigned int,
+		both operands are converted to unsigned long int.
+	*/
+	if (t1 == LONG && t2 == INT && u2)
+		t2 = int2int(e2p, (int_size<long_size)? long_type : ulong_type);
+	else if (t2 == LONG && t1 == INT && u1 && !shifting)	/* ??? */
+		t1 = int2int(e1p, (int_size<long_size)? long_type : ulong_type);
+
+	/*	If either operand has type long int, the other operand is con-
+		verted to long int.
+	*/
+	if (t1 == LONG && t2 != LONG)
+		t2 = int2int(e2p, long_type);
+	else
+	if (t2 == LONG && t1 != LONG && !shifting)	/* ??? */
+		t1 = int2int(e1p, long_type);
+
+	u1 = (*e1p)->ex_type->tp_unsigned;
+	u2 = (*e2p)->ex_type->tp_unsigned;
+
+	/*	If either operand has type unsigned int, the other operand
+		is converted to unsigned int.
+		Otherwise, both operands have type int.
+	*/
+	if (u1 && !u2 && !shifting)
+		t2 = int2int(e2p, (t1 == LONG) ? ulong_type : uint_type);
+	else
+	if (!u1 && u2 && !shifting)
+		t1 = int2int(e1p, (t2 == LONG) ? ulong_type : uint_type);
+
+	if (int_size != pointer_size) {
+		if (ptrdiff) {
+			(*e1p)->ex_flags |= EX_PTRDIFF;
+			(*e2p)->ex_flags |= EX_PTRDIFF;
+		}
+	}
+}
+
+relbalance(e1p, oper, e2p)
+	register struct expr **e1p, **e2p;
+{
+	/*	The expressions *e1p and *e2p are balanced to be operands
+		of the relational operator oper, or the ':'.
+		Care is taken to switch the operands in case of a
+		null-pointer constant. This is done so that ch3cast()
+		allows assignments of a null-pointer to a function
+		pointer.
+	*/
+	register struct expr *e1 = *e1p, *e2 = *e2p;
+	struct expr *tmpexpr;
+
+	if (e1->ex_type->tp_fund == POINTER
+	    && is_cp_cst(e1)
+	    && e1->VL_VALUE == 0) {
+		tmpexpr = e1;
+		e1 = e2;
+		e2 = tmpexpr;
+	}
+	if (e1->ex_type->tp_fund == POINTER)
+		ch3pointer(e2p, oper, e1->ex_type);
+	else if (e2->ex_type->tp_fund == POINTER)
+		ch3pointer(e1p, oper, e2->ex_type);
+	else if (e1->ex_type == e2->ex_type
+		&& e1->ex_type->tp_fund == ENUM) {}
+	else if (oper == ':'
+		    && e1->ex_type->tp_fund == VOID
+		    && e2->ex_type->tp_fund == VOID) {}
+	else
+		arithbalance(e1p, oper, e2p);
+}
+
+ch3pointer(expp, oper, tp)
+	struct expr **expp;
+	register struct type *tp;
+{
+	/*	Checks whether *expp may be compared to tp using oper,
+		as described in chapter 3.3.8 and 3.3.9.
+		tp is known to be a pointer.
+	*/
+	register struct expr *exp = *expp;
+
+	if (exp->ex_type->tp_fund == POINTER)	{
+		if (exp->ex_type != tp)
+			ch3cast(expp, oper, tp);
+	}
+	else
+	if (is_integral_type(exp->ex_type)) {
+		if ((oper != EQUAL && oper != NOTEQUAL && oper != ':')
+		    || !(is_cp_cst(exp) && exp->VL_VALUE == 0)) {
+			expr_error(exp,"%s on %s and pointer",
+					symbol2str(oper),
+					symbol2str(exp->ex_type->tp_fund));
+		}
+		ch3cast(expp, CAST, tp);
+	}
+	else	{
+		expr_error(exp, "%s on %s and pointer",
+				symbol2str(oper),
+				symbol2str(exp->ex_type->tp_fund)
+			);
+		ch3cast(expp, oper, tp);
+	}
+}
+
+int
+any2arith(expp, oper)
+	register struct expr **expp;
+	register int oper;
+{
+	/*	Turns any expression into int_type, long_type,
+		float_type, double_type or lngdbl_type.
+	*/
+	int fund;
+
+	switch (fund = (*expp)->ex_type->tp_fund)	{
+	case CHAR:
+	case SHORT:
+		ASSERT((*expp)->ex_type->tp_size <= int_type->tp_size);
+
+		if ((*expp)->ex_type->tp_unsigned
+		    && (*expp)->ex_type->tp_size == int_type->tp_size) {
+			int2int(expp, uint_type);
+		} else {
+			int2int(expp, int_type);
+		}
+		break;
+	case INT:
+	case LONG:
+		break;
+	case ENUM:
+#ifndef	LINT
+		/*	we do not want this conversion for lint, since we
+			want to keep enums and ints separate
+		*/
+		int2int(expp, int_type);
+#endif	/* LINT */
+		break;
+	case FLOAT:
+/*	only when it is a parameter and the default promotion should
+	occur. Hence this code is moved to any2parameter().
+		float2float(expp, double_type);
+		break;
+*/
+	case DOUBLE:
+	case LNGDBL:
+		break;
+#ifndef NOBITFIELD
+	case FIELD:
+		field2arith(expp);
+		break;
+#endif /* NOBITFIELD */
+	default:
+		expr_error(*expp, "operator %s on non-numerical operand (%s)",
+			symbol2str(oper), symbol2str(fund));
+	case ERRONEOUS:
+		erroneous2int(expp);
+		break;
+	}
+
+	return (*expp)->ex_type->tp_fund;
+}
+
+erroneous2int(expp)
+	struct expr **expp;
+{
+	/*	the (erroneous) expression *expp is replaced by an
+		int expression
+	*/
+	register struct expr *exp = *expp;
+	int flags = exp->ex_flags;
+	
+	free_expression(exp);
+	exp = intexpr((arith)0, INT);
+	exp->ex_flags = (flags | EX_ERROR);
+	*expp = exp;
+}
+
+struct expr *
+arith2arith(tp, oper, expr)
+	struct type *tp;
+	int oper;
+	register struct expr *expr;
+{
+	/*	arith2arith constructs a new expression containing a
+		run-time conversion between some arithmetic types.
+	*/
+	register struct expr *new = new_expr();
+	
+	new->ex_file = expr->ex_file;
+	new->ex_line = expr->ex_line;
+	new->ex_type = tp;
+	new->ex_class = Type;
+	return new_oper(tp, new, oper, expr);
+}
+
+int
+int2int(expp, tp)
+	struct expr **expp;
+	register struct type *tp;
+{
+	/*	The expression *expp, which is of some integral type, is
+		converted to the integral type tp.
+	*/
+	register struct expr *exp = *expp;
+	
+	if (is_cp_cst(exp))	{
+		register struct type *tp1 = exp->ex_type;
+
+		exp->ex_type = tp;
+		if (! tp1->tp_unsigned && tp->tp_unsigned) {
+			/*	Avoid "unreal" overflow warnings, such as
+				caused by f.i.:
+					unsigned int x = ~0;
+					unsigned int y = -1;
+			*/
+			extern long full_mask[];
+			long remainder = exp->VL_VALUE &
+						~full_mask[(int)(tp->tp_size)];
+
+			if (remainder == 0 ||
+			    remainder == ~full_mask[(int)(tp->tp_size)]) {
+				exp->VL_VALUE &= ~remainder;
+			}
+		}
+		cut_size(exp);
+	}
+	else	{
+		exp = arith2arith(tp, INT2INT, exp);
+	}
+	*expp = exp;
+	return exp->ex_type->tp_fund;
+}
+
+/* With compile-time constants, we don't set fp_used, since this is done
+ * only when necessary in eval.c.
+ */
+int2float(expp, tp)
+	register struct expr **expp;
+	struct type *tp;
+{
+	/*	The expression *expp, which is of some integral type, is
+		converted to the floating type tp.
+	*/
+	register struct expr *exp = *expp;
+	int uns = exp->ex_type->tp_unsigned;
+	
+	if (is_cp_cst(exp)) {
+		exp->ex_type = tp;
+		exp->ex_class = Float;
+		flt_arith2flt(exp->VL_VALUE, &(exp->FL_ARITH), uns);
+	}
+	else	{
+		fp_used = 1;
+		*expp = arith2arith(tp, INT2FLOAT, *expp);
+	}
+}
+
+float2int(expp, tp)
+	struct expr **expp;
+	struct type *tp;
+{
+	/*	The expression *expp, which is of some floating type, is
+		converted to the integral type tp.
+	*/
+	register struct expr *ex = *expp;
+	
+	if (is_fp_cst(ex)) {
+		arith ar = flt_flt2arith(&ex->FL_ARITH, tp->tp_unsigned);
+
+		if (flt_status == FLT_OVFL)
+			expr_warning(ex,"overflow in float to int conversion");
+		else if (flt_status == FLT_UNFL)
+			expr_warning(ex,"underflow in float to unsigned conversion");
+		ex->ex_type = tp;
+		/* The following lines are copied from fill_int_expr */
+		ex->ex_class = Value;
+		ex->VL_CLASS = Const;
+		ex->VL_VALUE = ar;
+		cut_size(ex);
+	} else {
+		fp_used = 1;
+		*expp = arith2arith(tp, FLOAT2INT, ex);
+	}
+}
+
+float2float(expp, tp)
+	register struct expr **expp;
+	struct type *tp;
+{
+	/*	The expression *expp, which is of some floating type, is
+		converted to the floating type tp.
+		There is no need for an explicit conversion operator
+		if the expression is a constant.
+	*/
+	
+	if (is_fp_cst(*expp))
+		(*expp)->ex_type = tp;
+	else {
+		fp_used = 1;
+		*expp = arith2arith(tp, FLOAT2FLOAT, *expp);
+	}
+}
+
+array2pointer(exp)
+	register struct expr *exp;
+{
+	/*	The expression, which must be an array, is converted
+		to a pointer.
+	*/
+	exp->ex_type = construct_type(POINTER, exp->ex_type->tp_up
+				    , /* exp->ex_type->tp_typequal */ 0
+				    , (arith)0, NO_PROTO);
+}
+
+function2pointer(exp)
+	register struct expr *exp;
+{
+	/*	The expression, which must be a function, is converted
+		to a pointer to the function.
+	*/
+	exp->ex_type = construct_type(POINTER, exp->ex_type, 0,
+				     (arith)0, NO_PROTO);
+}
+
+string2pointer(ex)
+	register struct expr *ex;
+{
+	/*	The expression, which must be a string constant, is converted
+		to a pointer to the string-containing area.
+	*/
+	label lbl;
+
+	lbl = code_string(ex->SG_VALUE, ex->SG_LEN);
+	ex->ex_class = Value;
+	ex->VL_CLASS = Label;
+	ex->VL_LBL = lbl;
+	ex->VL_VALUE = (arith)0;
+}
+
+opnd2integral(expp, oper)
+	register struct expr **expp;
+	int oper;
+{
+	register int fund = (*expp)->ex_type->tp_fund;
+
+	if (fund != INT && fund != LONG)	{
+		expr_error(*expp, "%s operand to %s",
+				symbol2str(fund), symbol2str(oper));
+		erroneous2int(expp);
+		/* fund = INT; */
+	}
+}
+
+opnd2logical(expp, oper)
+	register struct expr **expp;
+	int oper;
+{
+	int fund = (*expp)->ex_type->tp_fund;
+
+	if (fund == FUNCTION || fund == ARRAY) {
+		expr_warning(*expp, "%s operand to %s",
+			symbol2str(fund),
+			symbol2str(oper));
+		if (fund == FUNCTION) function2pointer(*expp);
+		else array2pointer(*expp);
+	}
+#ifndef NOBITFIELD
+	else 
+	if (fund == FIELD)
+		field2arith(expp);
+#endif /* NOBITFIELD */
+	switch (fund = (*expp)->ex_type->tp_fund) {
+	case CHAR:
+	case SHORT:
+	case INT:
+	case LONG:
+	case ENUM:
+	case POINTER:
+	case FLOAT:
+	case DOUBLE:
+	case LNGDBL:
+		break;
+	default:
+		expr_error(*expp, "%s operand to %s",
+			symbol2str(fund), symbol2str(oper));
+	case ERRONEOUS:
+		erroneous2int(expp);
+		break;
+	}
+}
+
+opnd2test(expp, oper)
+	register struct expr **expp;
+{
+	opnd2logical(expp, oper);
+	if ((*expp)->ex_class == Oper) {
+		switch((*expp)->OP_OPER) {
+		case '<':
+		case '>':
+		case LESSEQ:
+		case GREATEREQ:
+		case EQUAL:
+		case NOTEQUAL:
+		case '!':
+		case AND:
+		case OR:	/* && and || also impose a test	*/
+			/* It is already a test */
+			return;
+		case ',':
+			opnd2test(&((*expp)->OP_RIGHT), oper);
+			return;
+		}
+	}
+	ch3bin(expp, NOTEQUAL, intexpr((arith)0, INT));
+}
+
+any2opnd(expp, oper)
+	register struct expr **expp;
+{
+	if (!*expp)
+		return;
+
+	if (oper == SIZEOF || oper == ADDRESSOF) return;
+
+	switch ((*expp)->ex_type->tp_fund)	{
+	case CHAR:
+	case SHORT:
+	case ENUM:
+	/* case FLOAT:	/* not necessary anymore */
+		any2arith(expp, oper);
+		break;
+	case ARRAY:
+		array2pointer(*expp);
+		break;
+	case POINTER:
+		if ((*expp)->ex_class == String)
+			string2pointer(*expp);
+		break;
+	case FUNCTION:
+		function2pointer(*expp);
+		break;
+#ifndef NOBITFIELD
+	case FIELD:
+		field2arith(expp);
+		break;
+#endif /* NOBITFIELD */
+	}
+}
+
+any2parameter(expp)
+	register struct expr **expp;
+{
+	/*	To handle default argument promotions
+	*/
+	any2opnd(expp, '(');
+	if (int_size != pointer_size)
+	    if ((*expp)->ex_flags & EX_PTRDIFF)
+		expr_warning(*expp, "pointer difference caused long expression");
+	if ((*expp)->ex_type->tp_fund == FLOAT)
+		float2float(expp, double_type);
+}
+
+#ifndef NOBITFIELD
+field2arith(expp)
+	register struct expr **expp;
+{
+	/*	The expression to extract the bitfield value from the
+		memory word is put in the tree.
+	*/
+	register struct type *tp = (*expp)->ex_type->tp_up;
+	register struct field *fd = (*expp)->ex_type->tp_field;
+
+	(*expp)->ex_type = word_type;
+
+	if (tp->tp_unsigned)	{	/* don't worry about the sign bit */
+		if (fd->fd_width >= 8 * (int)word_size)
+			(*expp)->ex_type = uword_type;
+		ch3bin(expp, RIGHT, intexpr((arith)fd->fd_shift, INT));
+		ch3bin(expp, '&', intexpr(fd->fd_mask, INT));
+	}
+	else	{	/* take care of the sign bit: sign extend if needed */
+		arith other_bits = (int)word_size * 8 - fd->fd_width;
+
+		ch3bin(expp, LEFT,
+			intexpr(other_bits - fd->fd_shift,
+						INT)
+		);
+		ch3bin(expp, RIGHT, intexpr(other_bits, INT));
+	}
+}
+#endif /* NOBITFIELD */
+
+/*	switch_sign_fp() negates the given floating constant expression,
+ *	and frees the string representing the old value.
+ */
+switch_sign_fp(expr)
+	register struct expr *expr;
+{
+	flt_umin(&(expr->FL_ARITH));
+}

lang/cem/cemcom.ansi/arith.h

@@ -0,0 +1,32 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* COMPILER ARITHMETIC */
+
+/*	Normally the compiler does its internal arithmetics in longs
+	native to the source machine, which is always good for local
+	compilations, and generally OK too for cross compilations
+	downwards and sidewards.  For upwards cross compilation and
+	to save storage on small machines, SPECIAL_ARITHMETICS will
+	be handy.
+*/
+
+#include	"spec_arith.h"
+
+#ifndef	SPECIAL_ARITHMETICS
+
+#include <em_arith.h>		/* obtain definition of "arith"	*/
+
+#else	/* SPECIAL_ARITHMETICS */
+
+/*	All preprocessor arithmetic should be done in longs.
+*/
+#define	arith	long				/* dummy */
+
+#endif	/* SPECIAL_ARITHMETICS */
+
+#define	arith_size	(sizeof(arith))
+#define	arith_sign	((arith) 1 << (arith_size * 8 - 1))
+#define	max_arith	(~arith_sign)

lang/cem/cemcom.ansi/asm.c

@@ -0,0 +1,16 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Header$ */
+/*		A S M			*/
+
+/*ARGSUSED*/
+code_asm(s, l)
+	char *s;
+	int l;
+{
+	/*	'asm' '(' string ')' ';'
+	*/
+	error("\"asm\" instruction not implemented");
+}

lang/cem/cemcom.ansi/assert.h

@@ -0,0 +1,24 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	 A S S E R T I O N    M A C R O   D E F I N I T I O N		*/
+
+/*	At some points in the program, it must be sure that some condition
+	holds true, due to further, successful, processing.  As long as
+	there is no reasonable method to prove that a program is 100%
+	correct, these assertions are needed in some places.
+*/
+#include	"debug.h"	/* UF */
+
+#ifdef	DEBUG
+/*	Note: this macro uses parameter substitution inside strings */
+#define	ASSERT(exp)	(exp || crash("in %s, %u: assertion %s failed", \
+				__FILE__, __LINE__, "exp"))
+#define	NOTREACHED()	crash("in %s, %u: unreachable statement reached", \
+				__FILE__, __LINE__)
+#else
+#define	ASSERT(exp)
+#define	NOTREACHED()
+#endif	/* DEBUG */

lang/cem/cemcom.ansi/atw.h

@@ -0,0 +1,10 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* Align To Word boundary Definition	*/
+
+#include "sizes.h"
+
+#define	ATW(arg)	((((arg) + ((int)word_size - 1)) / word_size) * word_size)

lang/cem/cemcom.ansi/blocks.c

@@ -0,0 +1,200 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	B L O C K   S T O R I N G   A N D   L O A D I N G	*/
+
+#include	"lint.h"
+#ifndef	LINT
+
+#include <em.h>
+#include <em_reg.h>
+#include "arith.h"
+#include "sizes.h"
+#include "atw.h"
+#include "align.h"
+#ifndef STB
+#include "label.h"
+#include "stack.h"
+#include "Lpars.h"
+extern arith NewLocal();
+#define LocalPtrVar()	NewLocal(pointer_size, pointer_align, reg_pointer, REGISTER)
+#define LocalIntVar()	NewLocal(int_size, int_align, reg_any, REGISTER)
+#endif /* STB */
+
+/*	Because EM does not support the loading and storing of
+	objects having other sizes than word fragment and multiple,
+	we need to have a way of transferring these objects, whereby
+	we simulate "loi" and "sti": the address of the source resp.
+	destination is located on top of stack and a call is done
+	to load_block() resp. store_block().
+	===============================================================
+	# Loadblock() works on the stack as follows: ([ ] indicates the
+	# position of the stackpointer)
+	# lower address--->
+	# 1)	| &object
+	# 2)	| ... ATW(sz) bytes ... | sz | &stack_block | &object
+	# 3)	| ... ATW(sz) bytes ...
+	===============================================================
+	Loadblock() pushes ATW(sz) bytes directly onto the stack!
+
+	Store_block() works on the stack as follows:
+	lower address--->
+	1)	| ... ATW(sz) bytes ... | &object
+	2)	| ... ATW(sz) bytes ... | &object | &stack_block | sz
+	3)	<empty>
+
+	If sz is a legal argument for "loi" or "sti", just one EM
+	instruction is generated.
+	In the other cases, the notion of alignment is taken into account:
+	we only push an object of the size accepted by EM onto the stack,
+	while we need a loop to store the stack block into a memory object.
+*/
+
+suitable_sz(sz, al)
+	arith sz;
+	int al;
+{
+	return	((int)sz % (int)word_size == 0 && al % word_align == 0) ||
+		(
+			word_size % sz == 0 &&
+			(al >= (int)sz || al >= word_align)
+		/* Lots of Irritating Stupid Parentheses */
+		);
+}
+
+store_block(sz, al)
+	arith sz;
+	int al;
+{
+	if (suitable_sz(sz, al))
+		C_sti(sz);
+	else {
+#ifndef STB
+		arith src, dst;
+
+		/* allocate two pointer temporaries */
+		src = LocalPtrVar();
+		dst = LocalPtrVar();
+
+		/* load the addresses */
+		StoreLocal(dst, pointer_size);
+		C_lor((arith)1);	/* push current sp */
+		StoreLocal(src, pointer_size);
+		copy_loop(sz, src, dst);
+		C_asp(ATW(sz));
+		FreeLocal(dst);
+		FreeLocal(src);
+#else /* STB */
+		/*	address of destination lies on the stack	*/
+
+		/*	push address of first byte of block on stack onto
+			the stack by computing it from the current stack
+			pointer position
+		*/
+		C_lor((arith)1);	/* push current sp		*/
+		C_adp(pointer_size);	/* set & to 1st byte of block	*/
+		C_loc(sz);		/* number of bytes to transfer	*/
+		C_cal("__stb");		/* call transfer routine	*/
+		C_asp(pointer_size + pointer_size + int_size + ATW(sz));
+#endif /* STB */
+	}
+}
+
+load_block(sz, al)
+	arith sz;
+	int al;
+{
+
+	if (suitable_sz(sz, al))
+		C_loi(sz);
+	else {
+#ifndef STB
+		arith src, dst;
+
+		/* allocate two pointer temporaries */
+		src = LocalPtrVar();
+		dst = LocalPtrVar();
+
+		StoreLocal(src, pointer_size);
+		C_asp(-ATW(sz));	/* allocate stack block */
+		C_lor((arith)1);	/* push & of stack block as dst	*/
+		StoreLocal(dst, pointer_size);
+		copy_loop(sz, src, dst);
+		FreeLocal(dst);
+		FreeLocal(src);
+#else /* STB */
+		arith esz = ATW(sz) - pointer_size;
+		C_asp(-esz);		/* allocate stack block */
+		C_lor((arith)1);	/* push & of stack block as dst	*/
+		C_dup(pointer_size);		/* fetch source address	*/
+		C_adp(esz);
+		C_loi(pointer_size);
+		C_loc(sz);			/* # bytes to copy	*/
+		C_cal("__stb");			/* library copy routine	*/
+		C_asp(int_size + pointer_size + pointer_size);
+#endif /* STB */
+	}
+}
+
+copy_block(sz, al)
+	arith sz;
+	int al;
+{
+
+	if (suitable_sz(sz, al))
+		C_blm(sz);
+	else {
+#ifndef STB
+		arith src, dst;
+
+		/* allocate two pointer temporaries */
+		src = LocalPtrVar();
+		dst = LocalPtrVar();
+
+		StoreLocal(dst, pointer_size);
+		StoreLocal(src, pointer_size);
+		copy_loop(sz, src, dst);
+		FreeLocal(dst);
+		FreeLocal(src);
+#else /* STB */
+		C_loc(sz);			/* # bytes to copy	*/
+		C_cal("__stb");			/* library copy routine	*/
+		C_asp(int_size + pointer_size + pointer_size);
+#endif /* STB */
+	}
+}
+
+#ifndef STB
+copy_loop(sz, src, dst)
+	arith sz, src, dst;
+{
+	/* generate inline byte-copy loop */
+	label l_cont = text_label(), l_stop = text_label();
+	arith tmp_sz = LocalIntVar();
+
+	C_loc(sz);		/* amount of bytes */
+	StoreLocal(tmp_sz, int_size);
+	C_df_ilb(l_cont);
+	LoadLocal(tmp_sz, int_size);
+	C_zle(l_stop);
+	C_del(tmp_sz);
+	LoadLocal(src, pointer_size);
+	C_dup(pointer_size);
+	C_adp((arith)1);
+	StoreLocal(src, pointer_size);
+	C_loi((arith)1);
+	LoadLocal(dst, pointer_size);
+	C_dup(pointer_size);
+	C_adp((arith)1);
+	StoreLocal(dst, pointer_size);
+	C_sti((arith)1);
+	C_bra(l_cont);
+	C_df_ilb(l_stop);
+	FreeLocal(tmp_sz);
+}
+#endif /* STB */
+
+#endif	/* LINT */
+

lang/cem/cemcom.ansi/cem.1

@@ -0,0 +1,230 @@
+.TH CEM 1L 86/11/12
+.SH NAME
+cem \- ACK C compiler
+.SH SYNOPSIS
+.B cem
+[ option ] ... file ...
+.SH DESCRIPTION
+.I Cem
+is a
+.I cc (1)-like
+C compiler that uses the C front-end compiler
+.I cemcom (1)
+of the Amsterdam Compiler Kit.
+.I Cem
+interprets its arguments not starting with a '\-' as
+source files, to be compiled by the various parts of the compilation process,
+which are listed below.
+File arguments whose names end with \fB.\fP\fIcharacter\fP are interpreted as
+follows:
+.IP .[ao]
+object file.
+.IP .[ci]
+C source code
+.IP .e
+EM assembler source file.
+.IP .k
+compact EM file, not yet optimized by the EM peephole optimizer.
+.IP .m
+compact EM file, already optimized by the peephole optimizer.
+.IP .s
+assembler file.
+.LP
+The actions to be taken by
+.I cem
+are directed by the type of file argument and the various options that are
+presented to it.
+.PP
+The following set of options, which is a mixture of options interpreted by
+.I cc (1)
+and 
+.I ack (?)
+are interpreted by
+.I cem .
+(The options not specified here are passed to the loader.)
+.IP \fB\-B\fP\fIname\fP
+Use 
+.I name
+as front-end compiler instead of the default 
+.I cemcom (1).
+.br
+Same as "\fB\-Rcem=\fP\fIname\fP".
+.IP \fB\-C\fP
+Run C preprocessor 
+.I /lib/cpp
+only and prevent it from eliding comments.
+.IP \fB\-D\fP\fIname\fP\fB=\fP\fIdef\fP
+Define the 
+.I name
+to the preprocessor, as if by "#define".
+.IP \fB\-D\fP\fIname\fP
+.br
+Same as "\fB\-D\fP\fIname\fP\fB=1\fP".
+.IP \fB\-E\fP
+Run only the macro preprocessor on the named files and send the
+result to standard output.
+.IP \fB\-I\fP\fIdir\fP
+\&"#include" files whose names do not begin with '/' are always
+sought first in the directory of the \fIfile\fP argument, then in directories
+in \fB\-I\fP options, then in directories on a standard list (which in fact
+consists of "/usr/include").
+.IP \fB\-L\fP\fIdir\fP
+Use \fIdir\fP as library-containing directory instead of the default.
+.IP \fB\-N\fP\fIc\fP
+Only effective if ACK pipeline is used. 
+This option causes some default actions and options to be suppressed, according
+to
+.I c :
+.RS
+.IP \fBc\fP
+do not convert from EM a.out to local a.out format (i.e., skip the 
+.B cv
+pass.)
+.IP \fBl\fP
+do not pass the default loader flags to the
+.B ld
+pass.
+.RE
+.IP \fB\-P\fP
+Same as \fB\-E\fP, but sending the result of input file \fIfile\fP\fB.[ceis]\fP
+to \fIfile\fP\fB.i\fP.
+.IP \fB\-R\fP
+Passed to \fIcemcom\fP(1) in order to parse the named C programs according
+to the C language as described in [K&R] (also called \fIRestricted\fP C).
+.IP \fB\-R\fP\fIprog\fP\fB=\fP\fIname\fP
+.br
+Use \fIname\fP as program for phase \fIprog\fP of the compilation instead of
+the default.
+\&\fIProg\fP is one of the following names:
+.RS
+.IP \fBcpp\fP
+macro preprocessor
+.IP \fBcem\fP
+front\-end compiler
+.IP \fBopt\fP
+EM peephole optimizer
+.IP \fBdecode\fP
+EM compact to EM assembler translator
+.IP \fBencode\fP
+EM assembler to EM compact translator
+.IP \fBbe\fP
+EM compact code to target\-machine assembly code compiler
+.IP \fBcg\fP
+same as \fBbe\fP
+.IP \fBas\fP
+assembler
+.IP \fBld\fP
+linker/loader
+.IP \fBcv\fP
+a.out format converting program (only if ACK pipeline is used)
+.RE
+.IP \fB\-R\fP\fIprog\fP\fB\-\fP\fIoption\fP
+.br
+Pass \fB\-\fP\fIoption\fP to the compilation phase indicated by \fIprog\fP.
+.IP \fB\-S\fP
+Same as \fB\-c.s\fP.
+.IP \fB\-U\fP\fIname\fP
+.br
+Remove any initial definition of \fIname\fP.
+.IP \fB\-V\fP\fIcm\fP.\fIn\fP,\ \fB\-V\fIcm\fP.\fIncm\fP.\fIn\fP\ ...
+.br
+Set the size and alignment requirements of the C constructs of the named
+C input files.
+The letter \fIc\fP indicates the simple type, which is one of
+\fBs\fP(short), \fBi\fP(int), \fBl\fP(long), \fBf\fP(float), \fBd\fP(double) or
+\fBp\fP(pointer).
+The \fIm\fP parameter can be used to specify the length of the type (in bytes)
+and the \fIn\fP parameter for the alignment of that type.
+Absence of \fIm\fP or \fIn\fP causes the default value to be retained.
+To specify that the bitfields should be right adjusted instead of the
+default left adjustment, specify \fBr\fP as \fIc\fP parameter
+without parameters.
+.br
+This option is passed directly to \fIcemcom\fP(1).
+.IP \fB\-c\fP
+Same as \fB\-c.o\fP.
+.IP \fB\-c.e\fP
+Produce human-readable EM assembly code on \fIfile\fP\fB.e\fP for the
+named files \fIfile\fP\fB.[cikm]\fP 
+.IP \fB\-c.k\fP
+Compile C source \fIfile\fP\fB.[ci]\fP or
+encode human-readable EM assembly code from \fIfile\fP\fB.e\fP
+into non-optimized compact EM code and write the result on \fIfile\fP\fB.k\fP
+.IP \fB\-c.m\fP
+Compile C source \fIfile\fP\fB.[ci]\fP,
+translate non-optimized EM code from \fIfile\fP\fB.k\fP or
+encode EM assembly code from \fIfile\fP\fB.e\fP
+into optimized compact EM code and write the result on \fIfile\fP\fB.m\fP
+.IP \fB\-c.o\fP
+Suppress the loading phase of the compilation, and force an object file to
+be produced even if only one program is compiled
+.IP \fB\-c.s\fP
+Compile the named \fIfile\fP\fB.[ceikm]\fP input files, and leave the 
+assembly language output on corresponding files suffixed ".s".
+.IP \fB\-k\fP
+Same as \fB\-c.k\fP.
+.IP \fB\-l\fP\fIname\fP
+.br
+Append the library \fBlib\fP\fIname\fP\fB.a\fP to the list of files that
+should be loaded and linked into the final output file.
+The library is searched for in the library directory.
+.IP \fB\-m\fP
+Same as \fB\-c.m\fP.
+.IP \fB\-o\fP\ \fIoutput\fP
+.br
+Name the final output file \fIoutput\fP.
+If this option is used, the default "a.out" will be left undisturbed.
+.IP \fB\-p\fP
+Produce EM profiling code (\fBfil\fP and \fBlin\fP instructions to
+enable an interpreter to keep track of the current location in the
+source code)
+.IP \fB\-t\fP
+Keep the intermediate files, produced during the various phases of the 
+compilation.
+The produced files are named \fIfile\fP\fB.\fP\fIcharacter\fP where 
+\&\fIcharacter\fP indicates the type of the file as listed before.
+.IP \fB\-v\fP
+Verbose.
+Print the commands before they are executed.
+.IP \fB\-vn\fP
+Do not really execute (for debugging purposes only).
+.IP \fB\-vd\fP
+Print some additional information (for debugging purposes only).
+.IP \fB\-\-\fP\fIanything\fP
+.br
+Equivalent to \fB\-Rcem\-\-\fP\fIanything\fP.
+The options 
+.B \-\-C ,
+.B \-\-E
+and
+.B \-\-P
+all have the same effect as respectively
+.B \-C ,
+.B \-E
+and
+.B \-P
+except for the fact that the macro preprocessor is taken to be the
+built\-in preprocessor of the \fBcem\fP phase.
+Most "\-\-" options are used by
+.I cemcom (1)
+to set some internal debug switches.
+.LP
+.SH SEE ALSO
+cemcom(1), cc(1), ack(?), as(1), ld(1)
+.br
+.IP [K&R]
+B.W. Kernighan and D.M. Ritchie, \fIThe C Programming Language\fP,
+Prentice-Hall, 1978.
+.SH DIAGNOSTICS
+.I Cem
+reports any failure of its components.
+.SH BUGS
+.IP \(bu
+All intermediate files are placed in the current working directory which
+causes files with the same name as the intermediate files to be overwritten.
+.IP \(bu
+.B Cem
+only accepts a limited number of arguments to be passed to the components.
+(e.g., 256).
+.IP \(bu
+Please report suggestions and other bugs to erikb@vu44.uucp

lang/cem/cemcom.ansi/cem.c

@@ -0,0 +1,764 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/*	$Header$	*/
+/*
+	Driver for the CEMCOM compiler: works like /bin/cc and accepts
+	most of the options accepted by /bin/cc and /usr/em/bin/ack.
+	Date written: dec 4, 1985
+	Adapted for 68000 (Aug 19, 1986)
+	Merged the vax and mantra versions (Nov 10, 1986)
+	Author: Erik Baalbergen
+*/
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <errno.h>
+#include <signal.h>
+
+#define MAXARGC	256	/* maximum number of arguments allowed in a list */
+#define USTR_SIZE	1024	/* maximum length of string variable */
+
+struct arglist {
+	int al_argc;
+	char *al_argv[MAXARGC];
+};
+
+/* some system-dependent variables	*/
+char *PP = "/lib/cpp";
+char *CEM = "/usr/em/lib/em_cemcom";
+char *ENCODE = "/usr/em/lib/em_encode";
+char *DECODE = "/usr/em/lib/em_decode";
+char *OPT = "/usr/em/lib/em_opt";
+char *SHELL = "/bin/sh";
+
+#ifndef MANTRA
+char *CG = "/usr/em/lib/vax4/cg";
+char *AS = "/bin/as";
+char *AS_FIX = "/user1/erikb/bin/mcomm";
+char *LD = "/bin/ld";
+char *LIBDIR = "/user1/cem/lib";
+char *V_FLAG = "-Vs2.2w4.4i4.4l4.4f4.4d8.4p4.4";
+#else MANTRA
+char *CG = "/usr/em/lib/m68k2/cg";
+char *AS = "/usr/em/lib/m68k2/as";
+char *LD = "/usr/em/lib/em_led";
+char *CV = "/usr/em/lib/m68k2/cv";
+char *LIBDIR = "/usr/em/lib/m68k2";
+char *V_FLAG = "-Vs2.2w2.2i2.2l4.2f4.2d8.2p4.2";
+#endif MANTRA
+
+struct arglist LD_HEAD = {
+	2,
+	{
+#ifndef MANTRA
+		"/usr/em/lib/vax4/head_em",
+		"/usr/em/lib/vax4/head_cc"
+#else MANTRA
+		"/usr/em/lib/m68k2/head_em",
+		"/usr/em/lib/m68k2/head_cc"
+#endif MANTRA
+	}
+};
+
+struct arglist LD_TAIL = {
+#ifndef MANTRA
+	4,
+	{
+		"/user1/cem/lib/libc.a",
+		"/user1/cem/lib/stb.o",
+		"/usr/em/lib/vax4/tail_mon",
+		"/usr/em/lib/vax4/tail_em"
+	}
+#else MANTRA
+	7,
+	{
+		"/usr/em/lib/m68k2/tail_cc.1s",
+		"/usr/em/lib/m68k2/tail_cc.2g",
+		"/usr/em/lib/m68k2/tail_cem",
+		"/usr/em/lib/m68k2/tail_fp.a",
+		"/usr/em/lib/m68k2/tail_em.rt",
+		"/usr/em/lib/m68k2/tail_mon",
+		"/usr/em/lib/m68k2/end_em"
+	}
+#endif MANTRA
+};
+
+char *o_FILE = "a.out";
+#ifdef MANTRA
+char *cv_FILE = "cv.out";
+#endif MANTRA
+
+#define remove(str)	(((FLAG(t) == 0) && unlink(str)), (str)[0] = '\0')
+#define cleanup(str)		(str && remove(str))
+#define mkname(dst, s1, s2)	mkstr(dst, (s1), (s2), 0)
+#define init(al)		(al)->al_argc = 1
+#define library(nm) \
+	mkstr(alloc((unsigned int)strlen(nm) + strlen(LIBDIR) + 7), \
+		LIBDIR, "/lib", nm, ".a", 0)
+
+struct arglist SRCFILES, LDFILES, GEN_LDFILES, PP_FLAGS, CEM_FLAGS,
+	OPT_FLAGS, DECODE_FLAGS, ENCODE_FLAGS, CG_FLAGS, AS_FLAGS,
+	O_FLAGS, DEBUG_FLAGS, CALL_VEC;
+
+#ifndef MANTRA
+struct arglist LD_FLAGS;
+#else MANTRA
+struct arglist LD_FLAGS = {
+	5,
+	{
+		"-b0:0x80000",
+		"-a0:2",
+		"-a1:2",
+		"-a2:2",
+		"-a3:2"
+	}
+};
+struct arglist CV_FLAGS;
+int Nc_flag = 0;
+#endif MANTRA
+
+/* option naming */
+#define NAME(chr)	chr
+#define FLAG(chr)	NAME(chr)_flag
+int E_flag, P_flag, S_flag, c_flag, e_flag, k_flag, 
+	m_flag, o_flag, t_flag, v_flag;
+
+/* various passes */
+struct prog {
+	char *p_name;
+	char **p_task;
+	struct arglist *p_flags;
+} ProgParts[] = {
+	{ "cpp",	&PP,		&PP_FLAGS	},
+	{ "cem",	&CEM,		&CEM_FLAGS	},
+	{ "opt",	&OPT,		&OPT_FLAGS	},
+	{ "decode",	&DECODE,	&DECODE_FLAGS	},
+	{ "encode",	&ENCODE,	&ENCODE_FLAGS	},
+	{ "be",		&CG,		&CG_FLAGS	},
+	{ "cg",		&CG,		&CG_FLAGS	},
+	{ "as",		&AS,		&AS_FLAGS	},
+	{ "ld",		&LD,		&LD_FLAGS	},
+#ifdef MANTRA
+	{ "cv",		&CV,		&CV_FLAGS	},
+#endif MANTRA
+	{ 0,		0,		0		}
+};
+
+/* various forward declarations */
+int trap();
+char *mkstr();
+char *alloc();
+long sizeof_file();
+
+/* various globals */
+char *ProgCall = 0;
+int debug = 0;
+int exec = 1;
+int RET_CODE = 0;
+
+main(argc, argv)
+	char *argv[];
+{
+	char *str, **argvec, *file, *ldfile = 0;
+	int count, ext;
+	char Nfile[USTR_SIZE], kfile[USTR_SIZE], sfile[USTR_SIZE],
+		mfile[USTR_SIZE], ofile[USTR_SIZE], BASE[USTR_SIZE];
+	register struct arglist *call = &CALL_VEC;
+
+	set_traps(trap);
+	ProgCall = *argv++;
+	append(&CEM_FLAGS, "-L");
+	while (--argc > 0) {
+		if (*(str = *argv++) != '-') {
+			append(&SRCFILES, str);
+			continue;
+		}
+		switch (str[1]) {
+		case '-':
+			switch (str[2]) {
+			case 'C':
+			case 'E':
+			case 'P':
+				FLAG(E) = 1;
+				append(&PP_FLAGS, str);
+				PP = CEM;
+				FLAG(P) = (str[2] == 'P');
+				break;
+			default:
+				append(&DEBUG_FLAGS, str);
+				break;
+			}
+			break;
+		case 'B':
+			PP = CEM = &str[2];
+			break;
+		case 'C':
+		case 'E':
+		case 'P':
+			FLAG(E) = 1;
+			append(&PP_FLAGS, str);
+			FLAG(P) = (str[1] == 'P');
+			break;
+		case 'c':
+			if (str[2] == '.') {
+				switch (str[3]) {
+				case 's':
+					FLAG(S) = 1;
+					break;
+				case 'k':
+					FLAG(k) = 1;
+					break;
+				case 'o':
+					FLAG(c) = 1;
+					break;
+				case 'm':
+					FLAG(m) = 1;
+					break;
+				case 'e':
+					FLAG(e) = 1;
+					break;
+				default:
+					bad_option(str);
+				}
+			}
+			else
+			if (str[2] == '\0')
+				FLAG(c) = 1;
+			else
+				bad_option(str);
+			break;
+		case 'D':
+		case 'I':
+		case 'U':
+			append(&PP_FLAGS, str);
+			break;
+		case 'k':
+			FLAG(k) = 1;
+			break;
+		case 'l':
+			if (str[2] == '\0')	/* no standard libraries */
+				LD_HEAD.al_argc = LD_TAIL.al_argc = 0;
+			else	/* use library from library directory */
+				append(&SRCFILES, library(&str[2]));
+			break;
+		case 'L':	/* change default library directory */
+			LIBDIR = &str[2];
+			break;
+		case 'm':
+			FLAG(m) = 1;
+			break;
+#ifdef MANTRA
+		case 'N':
+			switch (str[2]) {
+			case 'c': /* no a.out conversion */
+				Nc_flag = 1;
+				break;
+			case 'l': /* no default options to led */
+				LD_FLAGS.al_argc = 0;
+				break;
+			default:
+				bad_option(str);
+			}
+			break;
+#endif MANTRA
+		case 'o':
+			FLAG(o) = 1;
+			if (argc-- < 0)
+				bad_option(str);
+			else
+				o_FILE = *argv++;
+			break;
+		case 'O':
+			append(&O_FLAGS, "-O");
+			break;
+		case 'R':
+			if (str[2] == '\0')
+				append(&CEM_FLAGS, str);
+			else
+				Roption(str);
+			break;
+		case 'S':
+			FLAG(S) = 1;
+			break;
+		case 't':
+			FLAG(t) = 1;
+			break;
+		case 'v':	/* set debug switches */
+			FLAG(v) = 1;
+			switch (str[2]) {
+			case 'd':
+				debug = 1;
+				break;
+			case 'n':	/* no execute */
+				exec = 0;
+				break;
+			case '\0':
+				break;
+			default:
+				bad_option(str);
+			}
+			break;
+		case 'V':
+			V_FLAG = str;
+			break;
+		default:
+			append(&LD_FLAGS, str);
+		}
+	}
+	if (debug) report("Note: debug output");
+	if (exec == 0)
+		report("Note: no execution");
+	count = SRCFILES.al_argc;
+	argvec = &(SRCFILES.al_argv[0]);
+	Nfile[0] = '\0';
+	while (count-- > 0) {
+		basename(file = *argvec++, BASE);
+		if (FLAG(E)) {
+			char ifile[USTR_SIZE];
+
+			init(call);
+			append(call, PP);
+			concat(call, &DEBUG_FLAGS);
+			concat(call, &PP_FLAGS);
+			append(call, file);
+			runvec(call, FLAG(P) ? mkname(ifile, BASE, ".i") : 0);
+			continue;
+		}
+		ext = extension(file);
+		/* .c to .k and .N	*/
+		if (ext == 'c' || ext == 'i') {
+			init(call);
+			append(call, CEM);
+			concat(call, &DEBUG_FLAGS);
+			append(call, V_FLAG);
+			concat(call, &CEM_FLAGS);
+			concat(call, &PP_FLAGS);
+			append(call, file);
+			append(call, mkname(kfile, BASE, ".k"));
+			append(call, mkname(Nfile, BASE, ".N"));
+			if (runvec(call, (char *)0)) {
+				file = kfile;
+				ext = 'k';
+				if (sizeof_file(Nfile) <= 0L)
+					remove(Nfile);
+			}
+			else {
+				remove(kfile);
+				remove(Nfile);
+				continue;
+			}
+		}
+		/* .e to .k */
+		if (ext == 'e') {
+			init(call);
+			append(call, ENCODE);
+			concat(call, &ENCODE_FLAGS);
+			append(call, file);
+			append(call, mkname(kfile, BASE, ".k"));
+			if (runvec(call, (char *)0) == 0)
+				continue;
+			file = kfile;
+			ext = 'k';
+		}
+		if (FLAG(k))
+			continue;
+		/* decode .k or .m */
+		if (FLAG(e) && (ext == 'k' || ext == 'm')) {
+			char efile[USTR_SIZE];
+			init(call);
+			append(call, DECODE);
+			concat(call, &DECODE_FLAGS);
+			append(call, file);
+			append(call, mkname(efile, BASE, ".e"));
+			runvec(call, (char *)0);
+			cleanup(kfile);
+			continue;
+		}
+		/* .k to .m */
+		if (ext == 'k') {
+			init(call);
+			append(call, OPT);
+			concat(call, &OPT_FLAGS);
+			append(call, file);
+			if (runvec(call, mkname(mfile, BASE, ".m")) == 0)
+				continue;
+			file = mfile;
+			ext = 'm';
+			cleanup(kfile);
+		}
+		if (FLAG(m))
+			continue;
+		/* .m to .s */
+		if (ext == 'm') {
+			init(call);
+			append(call, CG);
+			concat(call, &CG_FLAGS);
+			append(call, file);
+			append(call, mkname(sfile, BASE, ".s"));
+			if (runvec(call, (char *)0) == 0)
+				continue;
+			if (Nfile[0] != '\0') {
+#ifndef MANTRA
+				init(call);
+				append(call, AS_FIX);
+				append(call, Nfile);
+				append(call, sfile);
+				runvec(call, (char *)0);
+#endif MANTRA
+				remove(Nfile);
+			}
+			cleanup(mfile);
+			file = sfile;
+			ext = 's';
+		}
+		if (FLAG(S))
+			continue;
+		/* .s to .o */
+		if (ext == 's') {
+			ldfile = FLAG(c) ?
+				ofile :
+				alloc((unsigned)strlen(BASE) + 3);
+			init(call);
+			append(call, AS);
+			concat(call, &AS_FLAGS);
+#ifdef MANTRA
+			append(call, "-");
+#endif MANTRA
+			append(call, "-o");
+			append(call, mkname(ldfile, BASE, ".o"));
+			append(call, file);
+			if (runvec(call, (char *)0) == 0)
+				continue;
+			file = ldfile;
+			ext = 'o';
+			cleanup(sfile);
+		}
+		if (FLAG(c))
+			continue;
+		append(&LDFILES, file);
+		if (ldfile) {
+			append(&GEN_LDFILES, ldfile);
+			ldfile = 0;
+		}
+	}
+	/* *.o to a.out */
+	if (RET_CODE == 0 && LDFILES.al_argc > 0) {
+		init(call);
+		append(call, LD);
+		concat(call, &LD_FLAGS);
+		append(call, "-o");
+#ifndef MANTRA
+		append(call, o_FILE);
+#else MANTRA
+		append(call, Nc_flag ? o_FILE : cv_FILE);
+#endif MANTRA
+		concat(call, &LD_HEAD);
+		concat(call, &LDFILES);
+		concat(call, &LD_TAIL);
+		if (runvec(call, (char *)0)) {
+			register i = GEN_LDFILES.al_argc;
+
+			while (i-- > 0)
+				remove(GEN_LDFILES.al_argv[i]);
+#ifdef MANTRA
+			/* convert to local a.out format */
+			if (Nc_flag == 0) {
+				init(call);
+				append(call, CV);
+				concat(call, &CV_FLAGS);
+				append(call, cv_FILE);
+				append(call, o_FILE);
+				if (runvec(call, (char *)0))
+					remove(cv_FILE);
+			}
+#endif MANTRA
+		}
+	}
+	exit(RET_CODE);
+}
+
+#define BUFSIZE  (USTR_SIZE * MAXARGC)
+char alloc_buf[BUFSIZE];
+
+char *
+alloc(u)
+	unsigned u;
+{
+	static char *bufptr = &alloc_buf[0];
+	register char *p = bufptr;
+
+	if ((bufptr += u) >= &alloc_buf[BUFSIZE])
+		panic("no space");
+	return p;
+}
+
+append(al, arg)
+	register struct arglist *al;
+	char *arg;
+{
+	if (al->al_argc >= MAXARGC)
+		panic("argument list overflow");
+	al->al_argv[(al->al_argc)++] = arg;
+}
+
+concat(al1, al2)
+	struct arglist *al1, *al2;
+{
+	register int i = al2->al_argc;
+	register char **p = &(al1->al_argv[al1->al_argc]);
+	register char **q = &(al2->al_argv[0]);
+
+	if ((al1->al_argc += i) >= MAXARGC)
+		panic("argument list overflow");
+	while (i-- > 0)
+		*p++ = *q++;
+}
+
+/*	The next function is a dirty old one, taking a variable number of
+	arguments.
+	Take care that the last argument is a null-valued pointer!
+*/
+/*VARARGS1*/
+char *
+mkstr(dst, arg)
+	char *dst, *arg;
+{
+	char **vec = (char **) &arg;
+	register char *p;
+	register char *q = dst;
+
+	while (p = *vec++) {
+		while (*q++ = *p++);
+		q--;
+	}
+	return dst;
+}
+
+Roption(str)
+	char *str;	/* of the form "prog=/-arg"	*/
+{
+	char *eq;
+	char *prog, *arg;
+	char bc;
+	char *cindex();
+
+	prog = &str[2];
+	if (eq = cindex(prog, '='))
+		bc = '=';
+	else
+	if (eq = cindex(prog, '-'))
+		bc = '-';
+	else {
+		bad_option(str);
+		return;
+	}
+	*eq++ = '\0';
+	if (arg = eq) {
+		char *opt = 0;
+		struct prog *pp = &ProgParts[0];
+
+		if (bc == '-')
+			opt = mkstr(alloc((unsigned)strlen(arg) + 2),
+								"-", arg, 0);
+		while (pp->p_name) {
+			if (strcmp(prog, pp->p_name) == 0) {
+				if (opt)
+					append(pp->p_flags, opt);
+				else
+					*(pp->p_task) = arg;
+				return;
+			}
+			pp++;
+		}
+	}
+	bad_option(str);
+}
+
+basename(str, dst)
+	char *str;
+	register char *dst;
+{
+	register char *p1 = str;
+	register char *p2 = p1;
+
+	while (*p1)
+		if (*p1++ == '/')
+			p2 = p1;
+	p1--;
+	if (*--p1 == '.') {
+		*p1 = '\0';
+		while (*dst++ = *p2++) {}
+		*p1 = '.';
+	}
+	else
+		while (*dst++ = *p2++) {}
+}
+
+int
+extension(fn)
+	register char *fn;
+{
+	char c;
+
+	while (*fn++) {}
+	fn--;
+	c = *--fn;
+	return (*--fn == '.') ? c : 0;
+}
+
+long
+sizeof_file(nm)
+	char *nm;
+{
+	struct stat stbuf;
+
+	if (stat(nm, &stbuf) == 0)
+		return stbuf.st_size;
+	return -1;
+}
+
+char * sysmsg[]  = {
+	0,
+	"Hangup",
+	"Interrupt",
+	"Quit",
+	"Illegal instruction",
+	"Trace/BPT trap",
+	"IOT trap",
+	"EMT trap",
+	"Floating exception",
+	"Killed",
+	"Bus error",
+	"Memory fault",
+	"Bad system call",
+	"Broken pipe",
+	"Alarm call",
+	"Terminated",
+	"Signal 16"
+};
+
+runvec(vec, outp)
+	struct arglist *vec;
+	char *outp;
+{
+	int status, fd;
+	char *task = vec->al_argv[1];
+
+	vec->al_argv[vec->al_argc] = 0;
+	if (FLAG(v))
+		print_vec(vec);
+	if (exec == 0)
+		return 1;
+	if (fork() == 0) {	/* start up the process */
+		extern int errno;
+		if (outp) {	/* redirect standard output	*/
+			close(1);
+			if ((fd = creat(outp, 0666)) < 0)
+				panic("cannot create %s", outp);
+			if (fd != 1)
+				panic("illegal redirection");
+		}
+		if (debug) report("exec %s", task);
+		execv(task, &(vec->al_argv[1]));
+		/* not an a.out file, let's try it with the SHELL */
+		if (debug) report("try it with %s", SHELL);
+		if (errno == ENOEXEC) {
+			vec->al_argv[0] = SHELL;
+			execv(SHELL, &(vec->al_argv[0]));
+		}
+		/* failed, so ... */
+		panic("cannot execute %s", task);
+		exit(1);
+	}
+	else {
+		int loworder, highorder, sig;
+
+		wait(&status);
+		loworder = status & 0377;
+		highorder = (status >> 8) & 0377;
+		if (loworder == 0) {
+			if (highorder)
+				report("%s: exit status %d", task, highorder);
+			return highorder ? ((RET_CODE = 1), 0) : 1;
+		}
+		else {
+			sig = loworder & 0177;
+			if (sig == 0177)
+				report("%s: stopped by ptrace", task);
+			else
+			if (sysmsg[sig])
+				report("%s: %s%s", task, sysmsg[sig],
+					(loworder & 0200)
+						? " - core dumped"
+						: "");
+			RET_CODE = 1;
+			return 0;
+		}
+	}
+	/*NOTREACHED*/
+}
+
+bad_option(str)
+	char *str;
+{
+	report("bad option %s", str);
+}
+
+/*VARARGS1*/
+report(fmt, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
+	char *fmt;
+{
+	fprintf(stderr, "%s: ", ProgCall);
+	fprintf(stderr, fmt, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9);
+	fprintf(stderr, "\n");
+}
+
+/*VARARGS1*/
+panic(fmt, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
+	char *fmt;
+{
+	fprintf(stderr, "%s: ", ProgCall);
+	fprintf(stderr, fmt, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9);
+	fprintf(stderr, "\n");
+	exit(1);
+}
+
+set_traps(f)
+	int (*f)();
+{
+	signal(SIGHUP, f);
+	signal(SIGINT, f);
+	signal(SIGQUIT, f);
+	signal(SIGALRM, f);
+	signal(SIGTERM, f);
+}
+
+/*ARGSUSED*/
+trap(sig)
+{
+	set_traps(SIG_IGN);
+	panic("Trapped");
+}
+
+print_vec(vec)
+	struct arglist *vec;
+{
+	register i;
+
+	for (i = 1; i < vec->al_argc; i++)
+		printf("%s ", vec->al_argv[i]);
+	printf("\n");
+}
+
+char *
+cindex(s, c)
+	char *s, c;
+{
+	while (*s)
+		if (*s++ == c)
+			return s - 1;
+	return (char *) 0;
+}

lang/cem/cemcom.ansi/cemcom.1

@@ -0,0 +1,104 @@
+.TH EM_CEMCOM 6ACK
+.ad
+.SH NAME
+em_cemcom \- C to EM compiler
+.SH SYNOPSIS
+\fB~/em/lib/em_cemcom\fP [\fIoptions\fP] \fIsource \fP[\fIdestination \fP[\fInamelist\fP]]
+.SH DESCRIPTION
+\fICemcom\fP is a compiler that translates C programs
+into EM compact code.
+The input is taken from \fIsource\fP, while the
+EM code is written on \fIdestination\fP.
+If either of these two names is "\fB-\fP", standard input or output respectively
+is taken.
+The file \fInamelist\fP, if supplied, will contain a list of the names
+of external, so-called \fBcommon\fP, variables.
+When the preprocessor is invoked to run stand-alone, \fIdestination\fP
+needs not be specified.
+.br
+\fIOptions\fP is a, possibly empty, sequence of the following combinations:
+.IP \fB\-D\fIname\fR=\fItext\fR
+.br
+define \fIname\fR as a macro with \fItext\fR as its replacement text.
+.IP \fB\-D\fIname\fR
+.br
+the same as \fB\-D\fIname\fR=1.
+.IP \fB\-I\fIdirname\fR
+.br
+insert \fIdirname\fR in the list of include directories.
+.IP \fB\-M\fP\fIn\fP
+set maximum identifier length to \fIn\fP.
+.IP \fB\-g\fP
+produce a DBX-style symbol table.
+.IP \fB\-n\fR
+do not generate EM register messages.
+The user-declared variables are not stored into registers on the target
+machine.
+.IP \fB\-L\fR
+don't generate the EM \fBfil\fR and \fBlin\fR instructions 
+that usually are generated to enable
+an interpreter to keep track of the current location in the source code.
+.IP \fB\-p\fR
+generate code at each procedure entry to call the routine
+.BR procentry ,
+and at each return to call the routine
+.BE procexit .
+These routines are supplied with one parameter, a pointer to a
+string containing the name of the procedure.
+.IP \fB\-A\fR[\fIfile\fR]
+.br
+if \fIfile\fR is not given, generate a list
+of makefile dependencies and write them to the standard output.
+If \fIfile\fP is given,
+generate the list of makefile dependencies on file \fIfile\fP.
+.IP \fB-i\fR
+when generating makefile dependencies, do not include files from
+/usr/include.
+.IP \fB-m\fR
+when generating makefile dependencies, generate them in the following format:
+.RS
+.IP "file.o: file1.h"
+.RE
+.IP ""
+where "file.o" is derived from the source file name. Normally, only a list
+of files included is generated.
+.IP \fB\-R\fR
+interpret the input as restricted C (according to the language as 
+described in \fIThe C programming language\fR by Kernighan and Ritchie.)
+.IP \fB\-U\fIname\fR
+.br
+get rid of the compiler-predefined macro \fIname\fR.
+.IP \fB\-V\fIcm\fR.\fIn\fR,\ \fB\-V\fIcm\fR.\fIncm\fR.\fIn\fR\ ...
+.br
+set the size and alignment requirements.
+The letter \fIc\fR indicates the simple type, which is one of
+\fBs\fR(short), \fBi\fR(int), \fBl\fR(long), \fBf\fR(float), \fBd\fR(double) or
+\fBp\fR(pointer).
+The \fIm\fR parameter can be used to specify the length of the type (in bytes)
+and the \fIn\fR parameter for the alignment of that type.
+Absence of \fIm\fR or \fIn\fR causes the default value to be retained.
+To specify that the bitfields should be right adjusted instead of the
+default left adjustment, specify \fBr\fR as \fIc\fR parameter.
+.IP \fB\-w\fR
+suppress warning messages.
+.IP \fB\-s\fR
+suppress stricts.
+.IP \fB\-a\fR
+suppress warnings and stricts.
+.IP \fB\-o\fR
+suppress warnings and stricts about old-style.
+.IP \fB\-\-\fItext\fR
+.br
+where \fItext\fR can be either of the above or
+a debug flag of the compiler (which is not useful for the common user.)
+This feature can be used in various shell scripts and surrounding programs
+to force a certain option to be handed over to \fBcemcom\fR.
+.LP
+.SH FILES
+.IR ~em/lib/em_cemcom :
+the compiler
+.SH DIAGNOSTICS
+All warning and error messages are written on standard error output.
+.SH REFERENCE
+Baalbergen, E.H., D. Grune, M. Waage ;"\fIThe CEM compiler\fR", 
+Informatica Manual IM-4

lang/cem/cemcom.ansi/cemcom.ansi.1

@@ -0,0 +1,103 @@
+.TH EM_CEMCOM.ANSI 6 "$Revision$"
+.ad
+.SH NAME
+em_cemcom.ansi \- ANSI C to EM compiler
+.SH SYNOPSIS
+\fB~/em/lib.bin/em_cemcom.ansi\fP [ options ] source destination
+.SH DESCRIPTION
+\fICemcom\fP is a compiler that translates C programs
+into EM compact code.
+The input is taken from \fIsource\fP, while the
+EM code is written on \fIdestination\fP.
+If either of these two names is "\fB-\fP", standard input or output respectively
+is taken.
+When the preprocessor is invoked to run stand-alone, \fIdestination\fP
+needs not be specified.
+.br
+\fIOptions\fP is a, possibly empty, sequence of the following combinations:
+.IP \fB\-D\fIname\fR=\fItext\fR
+.br
+define \fIname\fR as a macro with \fItext\fR as its replacement text.
+.IP \fB\-D\fIname\fR
+.br
+the same as \fB\-D\fIname\fR=1.
+.IP \fB\-I\fIdirname\fR
+.br
+insert \fIdirname\fR in the list of include directories.
+.IP \fB\-M\fP\fIn\fP
+set maximum identifier length to \fIn\fP.
+.IP \fB\-g\fP
+produce a DBX-style symbol table.
+.IP \fB\-n\fR
+do not generate EM register messages.
+The user-declared variables are not stored into registers on the target
+machine.
+.IP \fB\-L\fR
+don't generate the EM \fBfil\fR and \fBlin\fR instructions 
+that usually are generated to enable
+an interpreter to keep track of the current location in the source code.
+.IP \fB\-p\fR
+generate code at each procedure entry to call the routine
+.BR procentry ,
+and at each return to call the routine
+.BE procexit .
+These routines are supplied with one parameter, a pointer to a
+string containing the name of the procedure.
+.IP \fB\-A\fR[\fIfile\fR]
+.br
+if \fIfile\fR is not given, generate a list
+of makefile dependencies and write them to the standard output.
+If \fIfile\fP is given,
+generate the list of makefile dependencies on file \fIfile\fP.
+.IP \fB-i\fR
+when generating makefile dependencies, do not include files from
+/usr/include.
+.IP \fB-m\fR
+when generating makefile dependencies, generate them in the following format:
+.RS
+.IP "file.o: file1.h"
+.RE
+.IP ""
+where "file.o" is derived from the source file name. Normally, only a list
+of files included is generated.
+.IP \fB\-R\fR
+interpret the input as restricted C (according to the language as 
+described in \fIThe C programming language\fR by Kernighan and Ritchie.)
+.IP \fB\-U\fIname\fR
+.br
+get rid of the compiler-predefined macro \fIname\fR.
+.IP \fB\-V\fIcm\fR.\fIn\fR,\ \fB\-V\fIcm\fR.\fIncm\fR.\fIn\fR\ ...
+.br
+set the size and alignment requirements.
+The letter \fIc\fR indicates the simple type, which is one of
+\fBs\fR(short), \fBi\fR(int), \fBl\fR(long), \fBf\fR(float), \fBd\fR(double),
+\fBx\fR(long double) or
+\fBp\fR(pointer).
+The \fIm\fR parameter can be used to specify the length of the type (in bytes)
+and the \fIn\fR parameter for the alignment of that type.
+Absence of \fIm\fR or \fIn\fR causes the default value to be retained.
+To specify that the bitfields should be right adjusted instead of the
+default left adjustment, specify \fBr\fR as \fIc\fR parameter.
+.IP \fB\-w\fR
+suppress warning messages.
+.IP \fB\-s\fR
+suppress stricts.
+.IP \fB\-a\fR
+suppress warnings and stricts.
+.IP \fB\-o\fR
+suppress warnings and stricts about old-style.
+.IP \fB\-\-\fItext\fR
+.br
+where \fItext\fR can be either of the above or
+a debug flag of the compiler (which is not useful for the common user.)
+This feature can be used in various shell scripts and surrounding programs
+to force a certain option to be handed over to \fBcemcom\fR.
+.LP
+.SH FILES
+.IR ~em/lib.bin/em_cemcom.ansi :
+the compiler
+.SH DIAGNOSTICS
+All warning and error messages are written on standard error output.
+.SH REFERENCE
+Baalbergen, E.H., D. Grune, M. Waage ;"\fIThe CEM compiler\fR", 
+Informatica Manual IM-4

lang/cem/cemcom.ansi/ch3.c

@@ -0,0 +1,729 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	S E M A N T I C   A N A L Y S I S -- C H A P T E R  3.3		*/
+
+#include	"debug.h"
+#include	"lint.h"
+#include	"nobitfield.h"
+#include	"idf.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"proto.h"
+#include	"type.h"
+#include	"struct.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"def.h"
+#include	"Lpars.h"
+#include	"assert.h"
+#include	"file_info.h"
+
+extern char options[];
+extern char *symbol2str();
+extern struct type *qualifier_type();
+
+/*	Most expression-handling routines have a pointer to a
+	(struct type *) as first parameter. The object under the pointer
+	gets updated in the process.
+*/
+
+ch3sel(expp, oper, idf)
+	struct expr **expp;
+	struct idf *idf;
+{
+	/*	The selector idf is applied to *expp; oper may be '.' or
+		ARROW.
+	*/
+	register struct expr *exp;
+	register struct type *tp;
+	register struct sdef *sd;
+
+	any2opnd(expp, oper);
+	exp = *expp;
+	tp = exp->ex_type;
+	if (oper == ARROW)	{
+		if (tp->tp_fund == POINTER &&
+		    ( tp->tp_up->tp_fund == STRUCT ||
+		      tp->tp_up->tp_fund == UNION))	/* normal case */
+			tp = tp->tp_up;
+		else {	/* constructions like "12->selector" and
+				"char c; c->selector"
+			*/
+			switch (tp->tp_fund)	{
+			case POINTER:
+				break;
+			case INT:
+			case LONG:
+				/* An error is given in idf2sdef() */
+				ch3cast(expp, CAST, pa_type);
+				sd = idf2sdef(idf, tp);
+				tp = sd->sd_stype;
+				break;
+			default:
+				expr_error(exp, "-> applied to %s",
+					symbol2str(tp->tp_fund));
+			case ERRONEOUS:
+				exp->ex_type = error_type;
+				return;
+			}
+		}
+	} else {		/* oper == '.' */
+		/* nothing */
+	}
+	exp = *expp;
+	switch (tp->tp_fund)	{
+	case POINTER:	/* for int *p;	p->next = ...	*/
+	case STRUCT:
+	case UNION:
+		break;
+	case INT:
+	case LONG:
+		/* warning will be given by idf2sdef() */
+		break;
+	default:
+		if (!is_anon_idf(idf))
+			expr_error(exp, "selector %s applied to %s",
+				idf->id_text, symbol2str(tp->tp_fund));
+	case ERRONEOUS:
+		exp->ex_type = error_type;
+		return;
+	}
+	sd = idf2sdef(idf, tp);
+	if (oper == '.')	{
+		/*	there are 3 cases in which the selection can be
+			performed compile-time: 
+			I:	n.sel (n either an identifier or a constant)
+			II:	(e.s1).s2 (transformed into (e.(s1+s2)))
+			III:	(e->s1).s2 (transformed into (e->(s1+s2)))
+				The code performing these conversions is
+				extremely obscure.
+		*/
+		if (exp->ex_class == Value)	{
+			/*	It is an object we know the address of; so
+				we can calculate the address of the
+				selected member 
+			*/
+			exp->VL_VALUE += sd->sd_offset;
+			exp->ex_type = sd->sd_type;
+			exp->ex_lvalue = exp->ex_type->tp_fund != ARRAY;
+			if (exp->ex_type == error_type) {
+				exp->ex_flags |= EX_ERROR;
+			}
+		}
+		else
+		if (exp->ex_class == Oper)	{
+			struct oper *op = &(exp->ex_object.ex_oper);
+			
+			if (op->op_oper == '.' || op->op_oper == ARROW)	{
+				ASSERT(is_cp_cst(op->op_right));
+				op->op_right->VL_VALUE += sd->sd_offset;
+				exp->ex_type = sd->sd_type;
+				exp->ex_lvalue = exp->ex_type->tp_fund != ARRAY;
+				if (exp->ex_type == error_type) {
+					exp->ex_flags |= EX_ERROR;
+				}
+			}
+			else {
+				exp = new_oper(sd->sd_type, exp, '.',
+						intexpr(sd->sd_offset, INT));
+				exp->ex_lvalue = sd->sd_type->tp_fund != ARRAY;
+				if (!exp->OP_LEFT->ex_lvalue)
+					exp->ex_flags |= EX_ILVALUE;
+			}
+		}
+	}
+	else { /* oper == ARROW */
+		if (is_ld_cst(exp)) {
+			exp->VL_VALUE += sd->sd_offset;
+			exp->ex_type = sd->sd_type;
+		}
+		else  {
+			exp = new_oper(sd->sd_type,
+				exp, oper, intexpr(sd->sd_offset, INT));
+		}
+		exp->ex_lvalue = (sd->sd_type->tp_fund != ARRAY);
+		exp->ex_flags &= ~EX_ILVALUE;
+	}
+	if ((sd->sd_type->tp_typequal & TQ_CONST)
+	    || (tp->tp_typequal & TQ_CONST))
+		exp->ex_flags |= EX_READONLY;
+	if ((sd->sd_type->tp_typequal & TQ_VOLATILE)
+	    || (tp->tp_typequal & TQ_VOLATILE))
+		exp->ex_flags |= EX_VOLATILE;
+	if (oper == '.' && exp->ex_flags & EX_READONLY)  {
+		exp->ex_type = qualifier_type(exp->ex_type, TQ_CONST);
+	}
+	if (exp->ex_flags & EX_VOLATILE)  {
+		exp->ex_type = qualifier_type(exp->ex_type, TQ_VOLATILE);
+	}
+	*expp = exp;
+}
+
+ch3incr(expp, oper)
+	struct expr **expp;
+{
+	/*	The monadic prefix/postfix incr/decr operator oper is
+		applied to *expp.
+	*/
+	ch3asgn(expp, oper, intexpr((arith)1, INT));
+}
+
+ch3cast(expp, oper, tp)
+	register struct expr **expp;
+	register struct type *tp;
+{
+	/*	The expression *expp is cast to type tp; the cast is
+		caused by the operator oper.  If the cast has
+		to be passed on to run time, its left operand will be an
+		expression of class Type.
+	*/
+	register struct type *oldtp;
+	register struct expr *exp = *expp;
+	int qual_lev, ascompat = 0;
+
+	if (oper == RETURN && tp->tp_fund == VOID) {
+		expr_strict(exp, "return <expression> in function returning void");
+		exp->ex_type = void_type;
+		return;
+	}
+	if (exp->ex_type->tp_fund == FUNCTION) {
+		function2pointer(exp);
+	}
+	if (exp->ex_type->tp_fund == ARRAY)
+		array2pointer(exp);
+	if (exp->ex_class == String)
+		string2pointer(exp);
+	oldtp = exp->ex_type;
+
+	if (oldtp->tp_size <= 0 && oldtp->tp_fund != VOID) {
+		expr_error(exp,"incomplete type in expression");
+	}
+
+#ifndef NOBITFIELD
+	if (oldtp->tp_fund == FIELD)	{
+		field2arith(expp);
+		ch3cast(expp, oper, tp);
+		return;
+	}
+	if (tp->tp_fund == FIELD) {
+		ch3cast(expp, oper, tp->tp_up);
+		return;
+	}
+#endif /* NOBITFIELD */
+	switch (oper) {
+	default:	qual_lev = -1; break;
+	case CAST:	qual_lev = -999; break;		/* ??? hack */
+	case CASTAB:
+	case '=':
+	case RETURN:	ascompat = 1;		/* assignment compatibility */
+		/* fallthrough */
+	case '-':
+	case '<':
+	case '>':
+	case LESSEQ:
+	case GREATEREQ:
+	case EQUAL:
+	case NOTEQUAL:
+	case ':':
+			qual_lev = -2;
+			break;
+	}
+
+	if (equal_type(tp, oldtp, qual_lev, 0)) {
+		/* life is easy */
+		if (ascompat && tp->tp_fund == POINTER) {
+			if ((tp->tp_up->tp_typequal & oldtp->tp_up->tp_typequal)
+			    != oldtp->tp_up->tp_typequal) {
+				expr_strict( exp, "qualifier error");
+			}
+		}
+		exp->ex_type = tp;	/* so qualifiers are allright */
+	}
+	else
+	if (tp->tp_fund == VOID) {
+		/* easy again */
+		exp->ex_type = void_type;
+	}
+	else
+	if (is_arith_type(oldtp) && is_arith_type(tp))	{
+		int oldi = is_integral_type(oldtp);
+		int i = is_integral_type(tp);
+
+		if (oldi && i)	{
+#ifdef	LINT
+			if (oper == CAST)
+				exp->ex_type = tp;
+			else {
+				int2int(expp, tp);
+			}
+#else	/* LINT */
+			int2int(expp, tp);
+#endif	/* LINT */
+		}
+		else
+		if (oldi && !i)	{
+#ifdef	LINT
+			if (oper == CAST)
+				exp->ex_type = tp;
+			else {
+				int2float(expp, tp);
+			}
+#else	/* LINT */
+			int2float(expp, tp);
+#endif	/* LINT */
+		}
+		else
+		if (!oldi && i) {
+#ifdef	LINT
+			if (oper == CAST)
+				exp->ex_type = tp;
+			else {
+				float2int(expp, tp);
+			}
+#else	/* LINT */
+			float2int(expp, tp);
+#endif	/* LINT */
+		}
+		else {
+			/* !oldi && !i */
+#ifdef	LINT
+			if (oper == CAST)
+				exp->ex_type = tp;
+			else {
+				float2float(expp, tp);
+			}
+#else	/* LINT */
+			float2float(expp, tp);
+#endif	/* LINT */
+		}
+	}
+	else
+	if (oldtp->tp_fund == POINTER && tp->tp_fund == POINTER)	{
+		switch (oper) {
+		case EQUAL:
+		case NOTEQUAL:
+		case '=':
+		case CASTAB:
+		case RETURN:
+		case ':':
+		    if (tp->tp_up && oldtp->tp_up) {
+			    if (tp->tp_up->tp_fund == VOID
+				&& oldtp->tp_up->tp_fund != FUNCTION) {
+				break;	/* switch */
+			    }
+			    if (oldtp->tp_up->tp_fund == VOID
+				&& tp->tp_up->tp_fund != FUNCTION) {
+				break;	/* switch */
+			    }
+			    if (oldtp->tp_up->tp_fund == VOID
+				&& is_cp_cst(exp)
+				&& exp->VL_VALUE == (arith)0)
+				break;	/* switch */
+		    }
+		    /* falltrough */
+		default:
+		    if (oper == CASTAB)
+			    expr_strict(exp, "incompatible pointers in call");
+		    else
+			    expr_strict(exp, "incompatible pointers in %s",
+							symbol2str(oper));
+		    break;
+		case CAST: break;
+		}
+#ifdef	LINT
+		if (oper != CAST)
+			lint_ptr_conv(oldtp->tp_up->tp_fund, tp->tp_up->tp_fund);
+#endif	/* LINT */
+		exp->ex_type = tp;	/* free conversion */
+	}
+	else
+	if (oldtp->tp_fund == POINTER && is_integral_type(tp))	{
+		/* from pointer to integral */
+		if (oper != CAST)
+			expr_strict(exp,
+				"illegal conversion of pointer to %s",
+				symbol2str(tp->tp_fund));
+		if (oldtp->tp_size > tp->tp_size)
+			expr_warning(exp,
+				"conversion of pointer to %s loses accuracy",
+				symbol2str(tp->tp_fund));
+		if (oldtp->tp_size != tp->tp_size) {
+			int2int(expp, tp);
+		} else
+			exp->ex_type = tp;
+	}
+	else
+	if (tp->tp_fund == POINTER && is_integral_type(oldtp))	{
+		/* from integral to pointer */
+		switch (oper)	{
+		case CAST:
+			break;
+		case CASTAB:
+		case EQUAL:
+		case NOTEQUAL:
+		case '=':
+		case RETURN:
+			if (is_cp_cst(exp) && exp->VL_VALUE == (arith)0)
+				break;
+		default:
+			expr_strict(exp,
+				"illegal conversion of %s to pointer",
+				symbol2str(oldtp->tp_fund));
+			break;
+		}
+		if (oldtp->tp_size > tp->tp_size)
+			expr_warning(exp,
+				"conversion of %s to pointer loses accuracy",
+				symbol2str(oldtp->tp_fund));
+		if (oldtp->tp_size != tp->tp_size) {
+			int2int(expp, tp);
+		} else
+			exp->ex_type = tp;
+	}
+	else
+	if (oldtp->tp_fund == ERRONEOUS) {
+		/* we just won't look */
+		exp->ex_type = tp;	/* brute force */
+	}
+	else
+	if (oldtp->tp_size == tp->tp_size && oper == CAST)	{
+		expr_strict(exp, "dubious conversion based on equal size");
+		exp->ex_type = tp;		/* brute force */
+	}
+	else	{
+		if (oldtp->tp_fund != ERRONEOUS && tp->tp_fund != ERRONEOUS)
+			expr_error(exp, "cannot convert %s to %s",
+					symbol2str(oldtp->tp_fund),
+					symbol2str(tp->tp_fund)
+				    );
+		exp->ex_type = tp;		/* brute force */
+	}
+	/* re-initialize exp, since *expp may have changed */
+	exp = *expp;
+	if (oper == CAST) {
+		exp->ex_flags |= EX_ILVALUE;
+	}
+}
+
+/*	Determine whether two types are equal.
+*/
+equal_type(tp, otp, qual_lev, diag)
+	register struct type *tp, *otp;
+	int qual_lev, diag;
+{
+	 if (tp == otp)
+		return 1;
+	if (!tp
+	    || !otp
+	    || (tp->tp_fund != otp->tp_fund)
+	    || (tp->tp_unsigned != otp->tp_unsigned)
+	    || (tp->tp_align != otp->tp_align))
+		return 0;
+	if (tp->tp_size != otp->tp_size) {
+		if (tp->tp_fund != ARRAY
+		    || (tp->tp_size != -1 && otp->tp_size != -1))
+			return 0;
+	}
+
+	if (qual_lev >= 0 && tp->tp_typequal != otp->tp_typequal) {
+		strict("missing or illegal qualifiers");
+	}
+
+	switch (tp->tp_fund) {
+
+	case FUNCTION:
+		/*	If both types have parameter type lists, the type of
+			each parameter in the composite parameter type list
+			is the composite type of the corresponding paramaters.
+		*/
+		if (tp->tp_proto && otp->tp_proto) {
+			if (!equal_proto(tp->tp_proto, otp->tp_proto, diag))
+				return 0;
+		} else if (tp->tp_proto || otp->tp_proto) {
+			if (!legal_mixture(tp, otp, diag))
+				return 0;
+		}
+		return equal_type(tp->tp_up, otp->tp_up, qual_lev + 1, diag);
+
+	case ARRAY:
+		/*	If one type is an array of known size, the composite
+			type is an array of that size
+		*/
+		if (tp->tp_size != otp->tp_size &&
+		     (tp->tp_size != -1 && otp->tp_size != -1))
+			return 0;
+		return equal_type(tp->tp_up, otp->tp_up, qual_lev/* ??? +1 */, diag);
+
+	case POINTER:
+		return equal_type(tp->tp_up, otp->tp_up, qual_lev + 1, diag);
+
+	case FIELD:
+		return equal_type(tp->tp_up, otp->tp_up, qual_lev/* ??? +1 */, diag);
+
+	case STRUCT:
+	case UNION:
+	case ENUM:
+		return tp->tp_idf == otp->tp_idf && tp->tp_sdef == otp->tp_sdef;
+
+	default:
+		return 1;
+	}
+}
+
+check_pseudoproto(pl, opl, diag)
+	register struct proto *pl, *opl;
+{
+	int retval = 1;
+
+	if (pl->pl_flag & PL_ELLIPSIS) {
+		if (diag) {	
+			error("illegal ellipsis terminator");
+			pl->pl_flag |= PL_ERRGIVEN;
+			opl->pl_flag |= PL_ERRGIVEN;
+		}
+		return 0;
+	}
+	if (opl->pl_flag & PL_VOID) {
+		if (!(pl->pl_flag & PL_VOID)) {
+			if (diag) {
+				strict("function is defined without parameters");
+			}
+			return 0;
+		}
+		return 1;
+	}
+	while (pl && opl) {
+	    if (!equal_type(pl->pl_type, opl->pl_type, -1, diag)) {
+		if (diag) {
+			if (!(pl->pl_flag & PL_ERRGIVEN)
+			    && !(opl->pl_flag & PL_ERRGIVEN))
+				error("incorrect type for parameter %s of definition",
+					opl->pl_idf->id_text);
+			pl->pl_flag |= PL_ERRGIVEN;
+			opl->pl_flag |= PL_ERRGIVEN;
+		}
+		retval = 0;
+	    }
+	    pl = pl->next;
+	    opl = opl->next;
+	}
+	if (pl || opl) {
+		if (diag) error("incorrect number of parameters");
+		retval = 0;
+	}
+	return retval;
+}
+
+legal_mixture(tp, otp, diag)
+	struct type *tp, *otp;
+	int diag;
+{
+	struct proto *pl = tp->tp_proto, *opl = otp->tp_proto;
+	int retval = 1;
+	register struct proto *prot;
+	int fund;
+
+	ASSERT( (pl != 0) ^ (opl != 0));
+	if (pl)  {
+		prot = pl;
+	} else  {
+		prot = opl;
+	}
+	if (!opl && otp->tp_pseudoproto) {
+		return check_pseudoproto(tp->tp_proto, otp->tp_pseudoproto, diag);
+	}
+
+	if (prot->pl_flag & PL_ELLIPSIS) {
+		if (prot->pl_flag & PL_ERRGIVEN) {
+			if (pl)
+				error("illegal ellipsis terminator");
+			else	error("ellipsis terminator in previous (prototype) declaration");
+			prot->pl_flag |= PL_ERRGIVEN;
+		}
+		return 0;
+	}
+	while (prot) {
+				/* if (!(prot->pl_flag & PL_ELLIPSIS)) {} */
+		fund = prot->pl_type->tp_fund;
+		if (fund == CHAR || fund == SHORT || fund == FLOAT) {
+			if (diag && !(prot->pl_flag & PL_ERRGIVEN))
+			    error("illegal %s parameter in %sdeclaration",
+				symbol2str(fund), (opl ? "previous (prototype) " : "" ));
+			prot->pl_flag |= PL_ERRGIVEN;
+			retval = 0;
+		}
+		prot = prot->next;
+	}
+	return retval;
+}
+
+equal_proto(pl, opl, diag)
+	register struct proto *pl, *opl;
+	int diag;
+{
+	if (pl == opl)
+		return 1;
+
+	/*	If only one type is a function type with a parameter type list
+		(a function prototype), the composite type is a function
+		prototype with parameter type list.
+	*/
+	while ( pl && opl) {
+
+	    if ((pl->pl_flag & ~PL_ERRGIVEN) != (opl->pl_flag & ~PL_ERRGIVEN) ||
+	        !equal_type(pl->pl_type, opl->pl_type, -1, diag))
+		return 0;
+
+	    pl = pl->next;
+	    opl = opl->next;
+	}
+	return !(pl || opl);
+}
+
+/* check if a type has a consqualified member */
+recurqual(tp, qual)
+struct type *tp;
+int qual;
+{
+	register struct sdef *sdf;
+
+	ASSERT(tp);
+
+	if (tp->tp_typequal & qual) return 1;
+	switch(tp->tp_fund) {
+	case UNION:
+	case STRUCT:
+	case ENUM:
+		sdf = tp->tp_sdef;
+		while (sdf) {
+			if (recurqual(sdf->sd_type, qual))
+				return 1;
+			sdf = sdf->sd_sdef;
+		}
+		break;
+	}
+	return 0;
+}
+
+ch3asgn(expp, oper, expr)
+	struct expr **expp;
+	struct expr *expr;
+{
+	/*	The assignment operators.
+		"f op= e" should be interpreted as
+		"f = (typeof f)((typeof (f op e))f op (typeof (f op e))e)"
+		and not as "f = f op (typeof f)e".
+		Consider, for example, (i == 10) i *= 0.9; (i == 9), where
+		typeof i == int.
+		The resulting expression tree becomes:
+				op=
+				/ \
+			       /   \
+			      f     (typeof (f op e))e
+		EVAL should however take care of evaluating (typeof (f op e))f
+	*/
+	register struct expr *exp = *expp;
+	int fund = exp->ex_type->tp_fund;
+	struct type *tp;
+	char *oper_string = symbol2str(oper);
+
+	/* We expect an lvalue */
+	if (fund == ARRAY || fund == FUNCTION) exp->ex_lvalue = 0;
+	if (!exp->ex_lvalue) {
+		expr_error(exp, "no lvalue in operand of %s", oper_string);
+	} else if (exp->ex_flags & EX_ILVALUE)	{
+		expr_strict(exp, "incorrect lvalue in operand of %s", oper_string);
+	} else if (exp->ex_flags & EX_READONLY) {
+		expr_error(exp, "operand of %s is read-only", oper_string);
+	} else if (fund == STRUCT || fund == UNION) {
+		if (recurqual(exp->ex_type, TQ_CONST))
+			expr_error(exp,"operand of %s contains a const-qualified member",
+					    oper_string);
+	}
+
+	if (oper == '=') {
+		ch3cast(&expr, oper, exp->ex_type);
+		tp = expr->ex_type;
+	}
+	else {	/* turn e into e' where typeof(e') = typeof (f op e) */
+		struct expr *extmp = intexpr((arith)0, INT);
+
+		/* this is really $#@&*%$# ! */
+		/* if you correct this, please correct lint_new_oper() too */
+		extmp->ex_lvalue = 1;
+		extmp->ex_type = exp->ex_type;
+		ch3bin(&extmp, oper, expr);
+		/* Note that ch3bin creates a tree of the expression
+			((typeof (f op e))f op (typeof (f op e))e),
+		   where f ~ extmp and e ~ expr.
+		   We want to use (typeof (f op e))e.
+		   Ch3bin does not create a tree if both operands
+		   were illegal or constants!
+		*/
+		tp = extmp->ex_type;	/* perform the arithmetic in type tp */
+		if (extmp->ex_class == Oper) {
+			expr = extmp->OP_RIGHT;
+			extmp->OP_RIGHT = NILEXPR;
+			free_expression(extmp);
+		}
+		else
+			expr = extmp;
+	}
+#ifndef NOBITFIELD
+	exp = new_oper(fund == FIELD ? exp->ex_type->tp_up : exp->ex_type,
+		exp, oper, expr);
+#else /* NOBITFIELD */
+	exp = new_oper(exp->ex_type, exp, oper, expr);
+#endif /* NOBITFIELD */
+	exp->OP_TYPE = tp;	/* for EVAL() */
+	exp->ex_flags |= EX_SIDEEFFECTS;
+	*expp = exp;
+}
+
+/*	Some interesting (?) questions answered.
+*/
+int
+is_integral_type(tp)
+	register struct type *tp;
+{
+	switch (tp->tp_fund)	{
+	case CHAR:
+	case SHORT:
+	case INT:
+	case LONG:
+	case ENUM:
+		return 1;
+#ifndef NOBITFIELD
+	case FIELD:
+		return is_integral_type(tp->tp_up);
+#endif /* NOBITFIELD */
+	default:
+		return 0;
+	}
+}
+
+int
+is_arith_type(tp)
+	register struct type *tp;
+{
+	switch (tp->tp_fund)	{
+	case CHAR:
+	case SHORT:
+	case INT:
+	case LONG:
+	case ENUM:
+	case FLOAT:
+	case DOUBLE:
+	case LNGDBL:
+		return 1;
+#ifndef NOBITFIELD
+	case FIELD:
+		return is_arith_type(tp->tp_up);
+#endif /* NOBITFIELD */
+	default:
+		return 0;
+	}
+}

lang/cem/cemcom.ansi/ch3bin.c

@@ -0,0 +1,400 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* SEMANTIC ANALYSIS (CHAPTER 3.3)  --  BINARY OPERATORS */
+
+#include	"botch_free.h"
+#include	"debug.h"
+#include	<alloc.h>
+#include	"lint.h"
+#include	"idf.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"type.h"
+#include	"struct.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"Lpars.h"
+#include	"sizes.h"
+
+extern char options[];
+extern char *symbol2str();
+
+/*	This chapter asks for the repeated application of code to handle
+	an operation that may be executed at compile time or at run time,
+	depending on the constancy of the operands.
+*/
+
+/*
+ * Although the relational operators are generally not commutative, we can
+ * switch the arguments if the operator is adapted (e.g. < becomes >)
+ */
+#define non_commutative_binop(expp, oper, expr)	mk_binop(expp, oper, expr, 0)
+#define commutative_binop(expp, oper, expr)	mk_binop(expp, oper, expr, 1)
+#define non_commutative_relop(expp, oper, expr)	mk_binop(expp, oper, expr, 1)
+
+ch3bin(expp, oper, expr)
+	register struct expr **expp;
+	struct expr *expr;
+{
+	/*	apply binary operator oper between *expp and expr.
+		NB: don't swap operands if op is one of the op= operators!!!
+	*/
+	register struct type *expp_tp;
+
+	any2opnd(expp, oper);
+	expp_tp = (*expp)->ex_type;
+	/* expp_tp can never be ARRAY, since any2opnd() converts the type
+	 * to pointer (except for SIZEOF and unary &).
+	 */
+	any2opnd(&expr, oper);
+	switch (oper)	{
+	case '[':				/* 3.3.2.1 */
+		/* indexing follows the commutative laws */
+		switch (expp_tp->tp_fund)	{
+		case POINTER:
+			break;
+		case ERRONEOUS:
+			return;
+		default:		/* unindexable */
+			switch (expr->ex_type->tp_fund)	{
+			case POINTER:
+				break;
+			case ERRONEOUS:
+				return;
+			default:
+				expr_error(*expp,
+					"indexing an object of type %s",
+					symbol2str(expp_tp->tp_fund));
+				return;
+			}
+			break;
+		}
+		ch3bin(expp, '+', expr);
+		ch3mon('*', expp);
+		break;
+
+	case '(':				/* 3.3.2.2 */
+		if (expp_tp->tp_fund == POINTER
+		    && expp_tp->tp_up->tp_fund == FUNCTION)	{
+			ch3mon('*', expp);
+			expp_tp = (*expp)->ex_type;
+		}
+		if (expp_tp->tp_fund != FUNCTION)	{
+			expr_error(*expp, "call of non-function (%s)",
+				symbol2str(expp_tp->tp_fund));
+			/* leave the expression; it may still serve */
+			free_expression(expr);	/* there go the parameters */
+			*expp = new_oper(error_type,
+					*expp, '(', (struct expr *)0);
+		}
+		else
+			*expp = new_oper(expp_tp->tp_up, *expp, '(', expr);
+		(*expp)->ex_flags |= EX_SIDEEFFECTS;
+		break;
+
+	case PARCOMMA:				/* 3.3.2.2 */
+		*expp = new_oper(expr->ex_type, *expp, PARCOMMA, expr);
+		break;
+
+	case '%':
+	case MODAB:
+	case ANDAB:
+	case XORAB:
+	case ORAB:
+		opnd2integral(expp, oper);
+		opnd2integral(&expr, oper);
+		/* fallthrough */
+	case '/':
+	case DIVAB:
+	case TIMESAB:
+		arithbalance(expp, oper, &expr);
+		non_commutative_binop(expp, oper, expr);
+		break;
+
+	case '&':
+	case '^':
+	case '|':
+		opnd2integral(expp, oper);
+		opnd2integral(&expr, oper);
+		/* fallthrough */
+	case '*':
+		arithbalance(expp, oper, &expr);
+		commutative_binop(expp, oper, expr);
+		break;
+
+	case '+':
+		if (expr->ex_type->tp_fund == POINTER)	{ /* swap operands */
+			struct expr *etmp = expr;
+			expp_tp = expr->ex_type;	/* both in registers */
+			expr = *expp;
+			*expp = etmp;
+		}
+		/* fallthrough */
+	case PLUSAB:
+	case POSTINCR:
+	case PLUSPLUS:
+		if (expp_tp->tp_fund == POINTER)	{
+			pointer_arithmetic(expp, oper, &expr);
+			if (expr->ex_type->tp_size != (*expp)->ex_type->tp_size)
+				ch3cast(&expr, CAST, (*expp)->ex_type);
+			pointer_binary(expp, oper, expr);
+		}
+		else	{
+			arithbalance(expp, oper, &expr);
+			if (oper == '+')
+				commutative_binop(expp, oper, expr);
+			else
+				non_commutative_binop(expp, oper, expr);
+		}
+		break;
+
+	case '-':
+	case MINAB:
+	case POSTDECR:
+	case MINMIN:
+		if (expp_tp->tp_fund == POINTER)	{
+			if (expr->ex_type->tp_fund == POINTER)
+				pntminuspnt(expp, oper, expr);
+			else {
+				pointer_arithmetic(expp, oper, &expr);
+				pointer_binary(expp, oper, expr);
+			}
+		}
+		else	{
+			arithbalance(expp, oper, &expr);
+			non_commutative_binop(expp, oper, expr);
+		}
+		break;
+
+	case LEFT:
+	case RIGHT:
+	case LEFTAB:
+	case RIGHTAB:
+		opnd2integral(expp, oper);
+		opnd2integral(&expr, oper);
+		arithbalance(expp, oper, &expr); /* ch. 3.3.7 */
+		ch3cast(&expr, oper, int_type); /* cvt. rightop to int */
+		non_commutative_binop(expp, oper, expr);
+		break;
+
+	case '<':
+	case '>':
+	case LESSEQ:
+	case GREATEREQ:
+	case EQUAL:
+	case NOTEQUAL:
+		relbalance(expp, oper, &expr);
+		non_commutative_relop(expp, oper, expr);
+		(*expp)->ex_type = int_type;
+		break;
+
+	case AND:
+	case OR:
+		opnd2test(expp, oper);
+		opnd2test(&expr, oper);
+		if (is_cp_cst(*expp))	{
+			register struct expr *ex = *expp;
+
+			/* the following condition is a short-hand for
+				((oper == AND) && o1) || ((oper == OR) && !o1)
+				where o1 == (*expp)->VL_VALUE;
+				and ((oper == AND) || (oper == OR))
+			*/
+			if ((oper == AND) == (ex->VL_VALUE != (arith)0)) {
+				*expp = expr;
+			}
+			else {
+				ex->ex_flags |= expr->ex_flags;
+				free_expression(expr);
+				*expp = intexpr((arith)(oper != AND), INT);
+			}
+			(*expp)->ex_flags |= ex->ex_flags | EX_ILVALUE;
+			free_expression(ex);
+		}
+		else
+		if (is_cp_cst(expr))	{
+			/* Note!!!: the following condition is a short-hand for
+				((oper == AND) && o2) || ((oper == OR) && !o2)
+				where o2 == expr->VL_VALUE
+				and ((oper == AND) || (oper == OR))
+			*/
+			if ((oper == AND) == (expr->VL_VALUE != (arith)0)) {
+				(*expp)->ex_flags |= expr->ex_flags | EX_ILVALUE;
+				free_expression(expr);
+			}
+			else {
+				if (oper == OR)
+					expr->VL_VALUE = (arith)1;
+				ch3bin(expp, ',', expr);
+			}
+		}
+		else {
+			*expp = new_oper(int_type, *expp, oper, expr);
+		}
+		(*expp)->ex_flags |= EX_LOGICAL;
+		break;
+
+	case ':':
+		if (is_struct_or_union(expp_tp->tp_fund)
+		    || is_struct_or_union(expr->ex_type->tp_fund))	{
+			if (!equal_type(expp_tp, expr->ex_type, -1, 0))
+				expr_error(*expp, "illegal balance");
+		}
+		else 
+			relbalance(expp, oper, &expr);
+#ifdef	LINT
+		if (	(is_cp_cst(*expp) && is_cp_cst(expr))
+		&&	(*expp)->VL_VALUE == expr->VL_VALUE
+		) {
+			hwarning("operands of : are constant and equal");
+		}
+#endif	/* LINT */
+		*expp = new_oper((*expp)->ex_type, *expp, oper, expr);
+		break;
+
+	case '?':
+		opnd2logical(expp, oper);
+		if (is_cp_cst(*expp)) {
+#ifdef	LINT
+			hwarning("condition in ?: expression is constant");
+#endif	/* LINT */
+			if ((*expp)->VL_VALUE) {
+				free_expression(*expp);
+				free_expression(expr->OP_RIGHT);
+				*expp = expr->OP_LEFT;
+			}
+			else {
+				free_expression(*expp);
+				free_expression(expr->OP_LEFT);
+				*expp = expr->OP_RIGHT;
+			}
+			free_expr(expr);
+			(*expp)->ex_flags |= EX_ILVALUE;
+		}
+		else {
+			*expp = new_oper(expr->ex_type, *expp, oper, expr);
+		}
+		break;
+
+	case ',':
+		if (is_cp_cst(*expp)) {
+#ifdef	LINT
+			hwarning("constant expression ignored");
+#endif	/* LINT */
+			free_expression(*expp);
+			*expp = expr;
+		}
+		else {
+			*expp = new_oper(expr->ex_type, *expp, oper, expr);
+		}
+		(*expp)->ex_flags |= EX_COMMA;
+		break;
+	}
+}
+
+pntminuspnt(expp, oper, expr)
+	register struct expr **expp, *expr;
+{
+	/*	Subtracting two pointers is so complicated it merits a
+		routine of its own.
+	*/
+	struct type *up_type = (*expp)->ex_type->tp_up;
+
+	if (!equal_type(up_type, expr->ex_type->tp_up, -1, 0)) {
+		expr_error(*expp, "subtracting incompatible pointers");
+		free_expression(expr);
+		erroneous2int(expp);
+		return;
+	}
+	/*	we hope the optimizer will eliminate the load-time
+		pointer subtraction
+	*/
+	*expp = new_oper((*expp)->ex_type, *expp, oper, expr);
+	ch3cast(expp, CAST, pa_type);	/* ptr-ptr: result has pa_type	*/
+	ch3bin(expp, '/'
+		, intexpr(size_of_type(up_type, symbol2str(up_type->tp_fund))
+			    , pa_type->tp_fund));
+	ch3cast(expp, CAST, pa_type);	/* result will be an integral expr */
+					/* cast necessary ??? */
+	if (int_size != pointer_size) (*expp)->ex_flags |= EX_PTRDIFF;
+}
+
+/*
+ * The function arg_switched() returns the operator that should be used
+ * when the arguments are switched.  This is special for some relational
+ * operators.
+ */
+int
+arg_switched(oper)
+{
+	switch (oper) {
+	case '<':	return '>';
+	case '>':	return '<';
+	case LESSEQ:	return GREATEREQ;
+	case GREATEREQ:	return LESSEQ;
+	default:	return oper;
+	}
+}
+
+mk_binop(expp, oper, expr, commutative)
+	struct expr **expp;
+	register struct expr *expr;
+{
+	/*	Constructs in *expp the operation indicated by the operands.
+		"commutative" indicates whether "oper" is a commutative
+		operator.
+	*/
+	register struct expr *ex = *expp;
+
+	if (is_cp_cst(expr) && is_cp_cst(ex))
+		cstbin(expp, oper, expr);
+	else if (is_fp_cst(expr) && is_fp_cst(ex))
+		fltcstbin(expp, oper, expr);
+	else {
+		*expp = (commutative
+			&& !(ex->ex_flags & EX_VOLATILE)
+			&& (expr->ex_depth > ex->ex_depth
+			    || ((expr->ex_flags & EX_SIDEEFFECTS)
+				&& !(ex->ex_flags & EX_SIDEEFFECTS))
+			    || is_cp_cst(ex)))
+			? new_oper(ex->ex_type, expr, arg_switched(oper), ex)
+			: new_oper(ex->ex_type, ex, oper, expr);
+	}
+}
+
+pointer_arithmetic(expp1, oper, expp2)
+	register struct expr **expp1, **expp2;
+{
+	int typ;
+	/*	prepares the integral expression expp2 in order to
+		apply it to the pointer expression expp1
+	*/
+	if ((typ = any2arith(expp2, oper)) == FLOAT
+	    || typ == DOUBLE
+	    || typ == LNGDBL)	{
+		expr_error(*expp2,
+			"illegal combination of %s and pointer",
+			symbol2str(typ));
+		erroneous2int(expp2);
+	}
+	ch3bin( expp2, '*',
+		intexpr(size_of_type((*expp1)->ex_type->tp_up, "object"),
+			pa_type->tp_fund)
+	);
+}
+
+pointer_binary(expp, oper, expr)
+	register struct expr **expp, *expr;
+{
+	/*	constructs the pointer arithmetic expression out of
+		a pointer expression, a binary operator and an integral
+		expression.
+	*/
+	if (is_ld_cst(expr) && is_ld_cst(*expp))
+		cstbin(expp, oper, expr);
+	else
+		*expp = new_oper((*expp)->ex_type, *expp, oper, expr);
+}

lang/cem/cemcom.ansi/ch3mon.c

@@ -0,0 +1,167 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* SEMANTIC ANALYSIS (CHAPTER 3.3) -- MONADIC OPERATORS */
+
+#include	"botch_free.h"
+#include	"debug.h"
+#include	<alloc.h>
+#include	"nobitfield.h"
+#include	"Lpars.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"type.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"idf.h"
+#include	"def.h"
+#include	"sizes.h"
+
+extern char options[];
+extern arith full_mask[/*MAXSIZE*/];	/* cstoper.c */
+char *symbol2str();
+
+ch3mon(oper, expp)
+	register struct expr **expp;
+{
+	/*	The monadic prefix operator oper is applied to *expp.
+	*/
+	register struct expr *expr;
+
+	if (oper != PLUSPLUS && oper != MINMIN)
+		any2opnd(expp, oper);
+
+	switch (oper)	{
+	case '*':			/* 3.3.3.2 */
+		/* no FIELD type allowed	*/
+		expr = *expp;
+		if (expr->ex_type->tp_fund != POINTER) {
+			if (expr->ex_type != error_type) {
+			    expr_error(expr,
+				    "* applied to non-pointer (%s)",
+				    symbol2str(expr->ex_type->tp_fund));
+			}
+		} else {
+			if (is_ld_cst(expr))
+				/* dereference in administration only */
+				expr->ex_type = expr->ex_type->tp_up;
+			else	/* runtime code */
+				*expp = new_oper(expr->ex_type->tp_up, NILEXPR,
+							'*', expr);
+			expr = *expp;
+			expr->ex_lvalue = (
+				expr->ex_type->tp_fund != ARRAY &&
+				expr->ex_type->tp_fund != FUNCTION
+				);
+			if (expr->ex_lvalue && expr->ex_type->tp_size <= 0) {
+				expr_error(expr, "incomplete type in expression");
+			}
+			if (expr->ex_type->tp_typequal & TQ_CONST)
+				expr->ex_flags |= EX_READONLY;
+			if (expr->ex_type->tp_typequal & TQ_VOLATILE)
+				expr->ex_flags |= EX_VOLATILE;
+			expr->ex_flags &= ~EX_ILVALUE;
+		}
+		break;
+	case ADDRESSOF:
+		if ((*expp)->ex_type->tp_fund == ARRAY) {
+			(*expp)->ex_type = pointer_to((*expp)->ex_type, 0);
+		}
+		else
+		if ((*expp)->ex_type->tp_fund == FUNCTION) {
+			(*expp)->ex_type = pointer_to((*expp)->ex_type, 0);
+		}
+		else
+#ifndef NOBITFIELD
+		if ((*expp)->ex_type->tp_fund == FIELD)
+			expr_error(*expp, "& applied to field variable");
+		else
+#endif /* NOBITFIELD */
+		if (!(*expp)->ex_lvalue)
+			expr_error(*expp, "& applied to non-lvalue");
+		else if ((*expp)->ex_flags & EX_ILVALUE)
+			expr_error(*expp, "& applied to illegal lvalue");
+		else {
+			/* assume that enums are already filtered out	*/
+			if (ISNAME(*expp)) {
+				register struct def *def =
+					(*expp)->VL_IDF->id_def;
+
+				/*	&<var> indicates that <var>
+					cannot be used as register
+					anymore
+				*/
+				if (def->df_sc == REGISTER) {
+					expr_error(*expp,
+					"& on register variable not allowed");
+					break;	/* break case ADDRESSOF */
+				}
+			}
+			(*expp)->ex_type = pointer_to((*expp)->ex_type,
+						(*expp)->ex_type->tp_typequal);
+			(*expp)->ex_lvalue = 0;
+			(*expp)->ex_flags &= ~(EX_READONLY | EX_VOLATILE);
+		}
+		break;
+	case '~':
+	{
+		int fund = (*expp)->ex_type->tp_fund;
+
+		if (fund == FLOAT || fund == DOUBLE || fund == LNGDBL)	{
+			expr_error( *expp,
+				    "~ not allowed on %s operands",
+				    symbol2str(fund));
+			erroneous2int(expp);
+			break;
+		}
+		/* FALLTHROUGH */
+	}
+	case '-':
+		any2arith(expp, oper);
+		if (is_cp_cst(*expp))	{
+			arith o1 = (*expp)->VL_VALUE;
+
+			(*expp)->VL_VALUE = (oper == '-') ? -o1 :
+			  ((*expp)->ex_type->tp_unsigned ?
+				(~o1) & full_mask[(int)(*expp)->ex_type->tp_size] :
+				~o1
+			  );
+		}
+		else
+		if (is_fp_cst(*expp))
+			switch_sign_fp(*expp);
+		else
+			*expp = new_oper((*expp)->ex_type,
+					NILEXPR, oper, *expp);
+		break;
+	case '!':
+		opnd2test(expp, '!');
+		if (is_cp_cst(*expp))	{
+			(*expp)->VL_VALUE = !((*expp)->VL_VALUE);
+			(*expp)->ex_type = int_type;	/* a cast ???(EB) */
+		}
+		else
+			*expp = new_oper(int_type, NILEXPR, oper, *expp);
+		(*expp)->ex_flags |= EX_LOGICAL;
+		break;
+	case PLUSPLUS:
+	case MINMIN:
+		ch3incr(expp, oper);
+		break;
+	case SIZEOF:
+		if (ISNAME(*expp) && (*expp)->VL_IDF->id_def->df_formal_array)
+			expr_warning(*expp, "sizeof formal array %s is sizeof pointer!",
+				(*expp)->VL_IDF->id_text);
+		expr = intexpr((*expp)->ex_class == String ?
+				   (arith)((*expp)->SG_LEN) :
+				   size_of_type((*expp)->ex_type,
+				       symbol2str((*expp)->ex_type->tp_fund))
+			       , UNSIGNED);
+		expr->ex_flags |= EX_SIZEOF;
+		free_expression(*expp);
+		*expp = expr;
+		break;
+	}
+}

lang/cem/cemcom.ansi/ch7.c

@@ -0,0 +1,641 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Header$ */
+/*	S E M A N T I C   A N A L Y S I S -- C H A P T E R  3.3		*/
+
+#include	"lint.h"
+#include	"debug.h"
+#include	"nobitfield.h"
+#include	"idf.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"proto.h"
+#include	"type.h"
+#include	"struct.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"def.h"
+#include	"Lpars.h"
+#include	"assert.h"
+#include	"file_info.h"
+
+extern char options[];
+extern char *symbol2str();
+extern struct type *qualifier_type();
+
+/*	Most expression-handling routines have a pointer to a
+	(struct type *) as first parameter. The object under the pointer
+	gets updated in the process.
+*/
+
+ch7sel(expp, oper, idf)
+	struct expr **expp;
+	struct idf *idf;
+{
+	/*	The selector idf is applied to *expp; oper may be '.' or
+		ARROW.
+	*/
+	register struct expr *exp;
+	register struct type *tp;
+	register struct sdef *sd;
+
+	any2opnd(expp, oper);
+	exp = *expp;
+	tp = exp->ex_type;
+	if (oper == ARROW)	{
+		if (tp->tp_fund == POINTER &&
+		    ( tp->tp_up->tp_fund == STRUCT ||
+		      tp->tp_up->tp_fund == UNION))	/* normal case */
+			tp = tp->tp_up;
+		else {	/* constructions like "12->selector" and
+				"char c; c->selector"
+			*/
+			switch (tp->tp_fund)	{
+			case POINTER:
+				break;
+			case INT:
+			case LONG:
+				/* An error is given in idf2sdef() */
+				ch7cast(expp, CAST, pa_type);
+				sd = idf2sdef(idf, tp);
+				tp = sd->sd_stype;
+				break;
+			default:
+				expr_error(exp, "-> applied to %s",
+					symbol2str(tp->tp_fund));
+			case ERRONEOUS:
+				exp->ex_type = error_type;
+				return;
+			}
+		}
+	} else {		/* oper == '.' */
+		/* nothing */
+	}
+	exp = *expp;
+	switch (tp->tp_fund)	{
+	case POINTER:	/* for int *p;	p->next = ...	*/
+	case STRUCT:
+	case UNION:
+		break;
+	case INT:
+	case LONG:
+		/* warning will be given by idf2sdef() */
+		break;
+	default:
+		if (!is_anon_idf(idf))
+			expr_error(exp, "selector %s applied to %s",
+				idf->id_text, symbol2str(tp->tp_fund));
+	case ERRONEOUS:
+		exp->ex_type = error_type;
+		return;
+	}
+	sd = idf2sdef(idf, tp);
+	if (oper == '.')	{
+		/*	there are 3 cases in which the selection can be
+			performed compile-time: 
+			I:	n.sel (n either an identifier or a constant)
+			II:	(e.s1).s2 (transformed into (e.(s1+s2)))
+			III:	(e->s1).s2 (transformed into (e->(s1+s2)))
+				The code performing these conversions is
+				extremely obscure.
+		*/
+		if (exp->ex_class == Value)	{
+			/*	It is an object we know the address of; so
+				we can calculate the address of the
+				selected member 
+			*/
+			exp->VL_VALUE += sd->sd_offset;
+			exp->ex_type = sd->sd_type;
+			exp->ex_lvalue = exp->ex_type->tp_fund != ARRAY;
+			if (exp->ex_type == error_type) {
+				exp->ex_flags |= EX_ERROR;
+			}
+		}
+		else
+		if (exp->ex_class == Oper)	{
+			struct oper *op = &(exp->ex_object.ex_oper);
+			
+			if (op->op_oper == '.' || op->op_oper == ARROW)	{
+				ASSERT(is_cp_cst(op->op_right));
+				op->op_right->VL_VALUE += sd->sd_offset;
+				exp->ex_type = sd->sd_type;
+				exp->ex_lvalue = exp->ex_type->tp_fund != ARRAY;
+				if (exp->ex_type == error_type) {
+					exp->ex_flags |= EX_ERROR;
+				}
+			}
+			else {
+				exp = new_oper(sd->sd_type, exp, '.',
+						intexpr(sd->sd_offset, INT));
+				exp->ex_lvalue = sd->sd_type->tp_fund != ARRAY;
+				if (!exp->OP_LEFT->ex_lvalue)
+					exp->ex_flags |= EX_ILVALUE;
+			}
+		}
+	}
+	else { /* oper == ARROW */
+		exp = new_oper(sd->sd_type,
+			exp, oper, intexpr(sd->sd_offset, INT));
+		exp->ex_lvalue = (sd->sd_type->tp_fund != ARRAY);
+		exp->ex_flags &= ~EX_ILVALUE;
+	}
+	if (sd->sd_type->tp_typequal & TQ_CONST)
+		exp->ex_flags |= EX_READONLY;
+	if (sd->sd_type->tp_typequal & TQ_VOLATILE)
+		exp->ex_flags |= EX_VOLATILE;
+	if (oper == '.' && exp->ex_flags & EX_READONLY)  {
+		exp->ex_type = qualifier_type(exp->ex_type, TQ_CONST);
+	}
+	*expp = exp;
+}
+
+ch7incr(expp, oper)
+	struct expr **expp;
+{
+	/*	The monadic prefix/postfix incr/decr operator oper is
+		applied to *expp.
+	*/
+	ch7asgn(expp, oper, intexpr((arith)1, INT));
+}
+
+ch7cast(expp, oper, tp)
+	register struct expr **expp;
+	register struct type *tp;
+{
+	/*	The expression *expp is cast to type tp; the cast is
+		caused by the operator oper.  If the cast has
+		to be passed on to run time, its left operand will be an
+		expression of class Type.
+	*/
+	register struct type *oldtp;
+
+	if ((*expp)->ex_type->tp_fund == FUNCTION)
+		function2pointer(*expp);
+	if ((*expp)->ex_type->tp_fund == ARRAY)
+		array2pointer(*expp);
+	if ((*expp)->ex_class == String)
+		string2pointer(*expp);
+	oldtp = (*expp)->ex_type;
+
+#ifndef NOBITFIELD
+	if (oldtp->tp_fund == FIELD)	{
+		field2arith(expp);
+		ch7cast(expp, oper, tp);
+	}
+	else
+	if (tp->tp_fund == FIELD) {
+		ch7cast(expp, oper, tp->tp_up);
+	}
+	else
+#endif NOBITFIELD
+	if (equal_type(tp, oldtp)) {
+		/* life is easy */
+	}
+	else
+	if (tp->tp_fund == VOID) {
+		/* easy again */
+		(*expp)->ex_type = void_type;
+	}
+	else
+	if (is_arith_type(oldtp) && is_arith_type(tp))	{
+		int oldi = is_integral_type(oldtp);
+		int i = is_integral_type(tp);
+
+		if (oldi && i)	{
+#ifdef	LINT
+			if (oper == CAST)
+				(*expp)->ex_type = tp;
+			else
+				int2int(expp, tp);
+#else	LINT
+			int2int(expp, tp);
+#endif	LINT
+		}
+		else
+		if (oldi && !i)	{
+#ifdef	LINT
+			if (oper == CAST)
+				(*expp)->ex_type = tp;
+			else
+				int2float(expp, tp);
+#else	LINT
+			int2float(expp, tp);
+#endif	LINT
+		}
+		else
+		if (!oldi && i) {
+#ifdef	LINT
+			if (oper == CAST)
+				(*expp)->ex_type = tp;
+			else
+				float2int(expp, tp);
+#else	LINT
+			float2int(expp, tp);
+#endif	LINT
+		}
+		else {
+			/* !oldi && !i */
+#ifdef	LINT
+			if (oper == CAST)
+				(*expp)->ex_type = tp;
+			else
+				float2float(expp, tp);
+#else	LINT
+			float2float(expp, tp);
+#endif	LINT
+		}
+	}
+	else
+	if (oldtp->tp_fund == POINTER && tp->tp_fund == POINTER)	{
+		if (oper == CASTAB)
+			expr_warning(*expp, "incompatible pointers");
+		else
+		if (oper != CAST)
+			expr_warning(*expp, "incompatible pointers in %s",
+							symbol2str(oper));
+#ifdef	LINT
+		if (oper != CAST)
+			lint_ptr_conv(oldtp->tp_up->tp_fund, tp->tp_up->tp_fund);
+#endif	LINT
+		(*expp)->ex_type = tp;	/* free conversion */
+	}
+	else
+	if (oldtp->tp_fund == POINTER && is_integral_type(tp))	{
+		/* from pointer to integral */
+		if (oper != CAST)
+			expr_warning(*expp,
+				"illegal conversion of pointer to %s",
+				symbol2str(tp->tp_fund));
+		if (oldtp->tp_size > tp->tp_size)
+			expr_warning(*expp,
+				"conversion of pointer to %s loses accuracy",
+				symbol2str(tp->tp_fund));
+		if (oldtp->tp_size != tp->tp_size)
+			int2int(expp, tp);
+		else
+			(*expp)->ex_type = tp;
+	}
+	else
+	if (tp->tp_fund == POINTER && is_integral_type(oldtp))	{
+		/* from integral to pointer */
+		switch (oper)	{
+		case CAST:
+			break;
+		case CASTAB:
+		case EQUAL:
+		case NOTEQUAL:
+		case '=':
+		case RETURN:
+			if (is_cp_cst(*expp) && (*expp)->VL_VALUE == (arith)0)
+				break;
+		default:
+			expr_warning(*expp,
+				"illegal conversion of %s to pointer",
+				symbol2str(oldtp->tp_fund));
+			break;
+		}
+		if (oldtp->tp_size > tp->tp_size)
+			expr_warning(*expp,
+				"conversion of %s to pointer loses accuracy",
+				symbol2str(oldtp->tp_fund));
+		if (oldtp->tp_size != tp->tp_size)
+			int2int(expp, tp);
+		else
+			(*expp)->ex_type = tp;
+	}
+	else
+	if (oldtp->tp_fund == ERRONEOUS) {
+		/* we just won't look */
+		(*expp)->ex_type = tp;	/* brute force */
+	}
+	else
+	if (oldtp->tp_size == tp->tp_size && oper == CAST)	{
+		expr_warning(*expp, "dubious conversion based on equal size");
+		(*expp)->ex_type = tp;		/* brute force */
+	}
+	else	{
+		if (oldtp->tp_fund != ERRONEOUS && tp->tp_fund != ERRONEOUS)
+			expr_error(*expp, "cannot convert %s to %s",
+				symbol2str(oldtp->tp_fund),
+				symbol2str(tp->tp_fund)
+			);
+		(*expp)->ex_type = tp;		/* brute force */
+	}
+	if (oper == CAST) {
+		(*expp)->ex_flags |= EX_ILVALUE;
+	}
+}
+
+/*	Determine whether two types are equal.
+*/
+equal_type(tp, otp)
+	register struct type *tp, *otp;
+{
+	if (tp == otp)
+		return 1;
+	if (!tp || !otp)
+		return 0;
+
+	if (tp->tp_fund != otp->tp_fund)
+		return 0;
+	if (tp->tp_unsigned != otp->tp_unsigned)
+		return 0;
+	if (tp->tp_align != otp->tp_align)
+		return 0;
+	if (tp->tp_fund != ARRAY /* && tp->tp_fund != STRUCT */ ) {	/* UNION ??? */
+		if (tp->tp_size != otp->tp_size)
+			return 0;
+	}
+
+	switch (tp->tp_fund) {
+
+	case FUNCTION:
+		/*	If both types have parameter type lists, the type of
+			each parameter in the composite parameter type list
+			is the composite type of the corresponding paramaters.
+		*/
+		if (tp->tp_proto && otp->tp_proto) {
+			if (!equal_proto(tp->tp_proto, otp->tp_proto))
+				return 0;
+		} else if (tp->tp_proto || otp->tp_proto) {
+			if (!legal_mixture(tp, otp))
+				return 0;
+		}
+		return equal_type(tp->tp_up, otp->tp_up);
+
+	case ARRAY:
+		/*	If one type is an array of known size, the composite
+			type is an array of that size
+		*/
+		if (tp->tp_size != otp->tp_size &&
+		     (tp->tp_size != -1 && otp->tp_size != -1))
+			return 0;
+		return equal_type(tp->tp_up, otp->tp_up);
+
+	case POINTER:
+		if (equal_type(tp->tp_up, otp->tp_up)) {
+		    if (otp->tp_up->tp_typequal & TQ_CONST) {
+			if (!(tp->tp_up->tp_typequal & TQ_CONST)) {
+			    strict("illegal use of pointer to const object");
+			}
+		    }
+		    return 1;
+		}
+		else return 0;
+
+	case FIELD:
+		return equal_type(tp->tp_up, otp->tp_up);
+
+	case STRUCT:
+	case UNION:
+	case ENUM:
+		return tp->tp_idf == otp->tp_idf && tp->tp_sdef == otp->tp_sdef;
+
+	default:
+		return 1;
+	}
+}
+
+check_pseudoproto(pl, opl)
+	register struct proto *pl, *opl;
+{
+	int retval = 1;
+
+	if (pl->pl_flag & PL_ELLIPSIS) {
+		error("illegal ellipsis terminator");
+		return 2;
+	}
+	while (pl && opl) {
+	    if (!equal_type(pl->pl_type, opl->pl_type)) {
+		if (!(pl->pl_flag & PL_ERRGIVEN)
+		    && !(opl->pl_flag & PL_ERRGIVEN))
+			error("incorrect type for parameter %s of definition",
+				opl->pl_idf->id_text);
+		pl->pl_flag |= PL_ERRGIVEN;
+		opl->pl_flag |= PL_ERRGIVEN;
+		retval = 2;
+	    }
+	    pl = pl->next;
+	    opl = opl->next;
+	}
+	if (pl || opl) {
+		error("incorrect number of parameters");
+		retval = 2;
+	}
+	return retval;
+}
+
+legal_mixture(tp, otp)
+	struct type *tp, *otp;
+{
+	register struct proto *pl = tp->tp_proto, *opl = otp->tp_proto;
+	int retval = 1;
+	struct proto *prot;
+	int fund;
+
+	ASSERT( (pl != 0) ^ (opl != 0));
+	if (pl)  {
+		prot = pl;
+	} else  {
+		prot = opl;
+	}
+	if (!opl && otp->tp_pseudoproto) {
+		return check_pseudoproto(tp->tp_proto, otp->tp_pseudoproto);
+	}
+
+	if (prot->pl_flag & PL_ELLIPSIS) {
+		if (!(prot->pl_flag & PL_ERRGIVEN)) {
+			if (pl)
+				error("illegal ellipsis terminator");
+			else	error("ellipsis terminator in previous (prototype) declaration");
+		}
+		prot->pl_flag |= PL_ERRGIVEN;
+		prot = prot->next;
+		return 2;
+	}
+	while (prot) {
+				/* if (!(prot->pl_flag & PL_ELLIPSIS)) {} */
+		fund = prot->pl_type->tp_fund;
+		if (fund == CHAR || fund == SHORT || fund == FLOAT) {
+			if (!(prot->pl_flag & PL_ERRGIVEN))
+			    error("illegal %s parameter in %sdeclaration",
+				symbol2str(fund), (opl ? "previous (prototype) " : "" ));
+			prot->pl_flag |= PL_ERRGIVEN;
+			retval = 2;
+		}
+		prot = prot->next;
+	}
+	return retval;
+}
+
+equal_proto(pl, opl)
+	register struct proto *pl, *opl;
+{
+	if (pl == opl)
+		return 1;
+
+	/*	If only one type is a function type with a parameter type list
+		(a function prototype), the composite type is a function
+		prototype with parameter type list.
+	*/
+	while ( pl && opl) {
+
+	    if ((pl->pl_flag & ~PL_ERRGIVEN) != (opl->pl_flag & ~PL_ERRGIVEN))
+		return 0;
+
+	    if (!equal_type(pl->pl_type, opl->pl_type))
+		return 0;
+
+	    pl = pl->next;
+	    opl = opl->next;
+	}
+	return !(pl || opl);
+}
+
+recurconst(tp)
+struct type *tp;
+{
+	register struct sdef *sdf;
+
+	ASSERT(tp);
+	if (!tp) return 0;
+	if (tp->tp_typequal & TQ_CONST) return 1;
+	sdf = tp->tp_sdef;
+	while (sdf) {
+		if (recurconst(sdf->sd_type))
+			return 1;
+		sdf = sdf->sd_sdef;
+	}
+	return 0;
+}
+
+ch7asgn(expp, oper, expr)
+	struct expr **expp;
+	struct expr *expr;
+{
+	/*	The assignment operators.
+		"f op= e" should be interpreted as
+		"f = (typeof f)((typeof (f op e))f op (typeof (f op e))e)"
+		and not as "f = f op (typeof f)e".
+		Consider, for example, (i == 10) i *= 0.9; (i == 9), where
+		typeof i == int.
+		The resulting expression tree becomes:
+				op=
+				/ \
+			       /   \
+			      f     (typeof (f op e))e
+		EVAL should however take care of evaluating (typeof (f op e))f
+	*/
+	register struct expr *exp = *expp;
+	int fund = exp->ex_type->tp_fund;
+	int vol = 0;
+	struct type *tp;
+
+	/* We expect an lvalue */
+	if (!exp->ex_lvalue) {
+		expr_error(exp, "no lvalue in operand of %s", symbol2str(oper));
+	} else if (exp->ex_flags & EX_ILVALUE)	{
+		strict("incorrect lvalue in operand of %s", symbol2str(oper));
+	} else if (exp->ex_flags & EX_READONLY) {
+		expr_error(exp, "operand of %s is read-only", symbol2str(oper));
+	} else if (fund == STRUCT || fund == UNION) {
+		if (recurconst(exp->ex_type))
+			expr_error(expr,"operand of %s contains a const-qualified member",
+					    symbol2str(oper));
+	}
+
+	/*	Preserve volatile markers across the tree.
+		This is questionable, depending on the way the optimizer
+		wants this information.
+	vol = (exp->ex_flags & EX_VOLATILE) || (expr->ex_flags & EX_VOLATILE);
+	*/
+
+	if (oper == '=') {
+		ch7cast(&expr, oper, exp->ex_type);
+		tp = expr->ex_type;
+	}
+	else {	/* turn e into e' where typeof(e') = typeof (f op e) */
+		struct expr *extmp = intexpr((arith)0, INT);
+
+		/* this is really $#@&*%$# ! */
+		/* if you correct this, please correct lint_new_oper() too */
+		extmp->ex_lvalue = 1;
+		extmp->ex_type = exp->ex_type;
+		ch7bin(&extmp, oper, expr);
+		/* Note that ch7bin creates a tree of the expression
+			((typeof (f op e))f op (typeof (f op e))e),
+		   where f ~ extmp and e ~ expr.
+		   We want to use (typeof (f op e))e.
+		   Ch7bin does not create a tree if both operands
+		   were illegal or constants!
+		*/
+		tp = extmp->ex_type;	/* perform the arithmetic in type tp */
+		if (extmp->ex_class == Oper) {
+			expr = extmp->OP_RIGHT;
+			extmp->OP_RIGHT = NILEXPR;
+			free_expression(extmp);
+		}
+		else
+			expr = extmp;
+	}
+#ifndef NOBITFIELD
+	if (fund == FIELD)
+		exp = new_oper(exp->ex_type->tp_up, exp, oper, expr);
+	else
+		exp = new_oper(exp->ex_type, exp, oper, expr);
+#else NOBITFIELD
+	exp = new_oper(exp->ex_type, exp, oper, expr);
+#endif NOBITFIELD
+	exp->OP_TYPE = tp;	/* for EVAL() */
+	exp->ex_flags |= vol ? (EX_SIDEEFFECTS|EX_VOLATILE) : EX_SIDEEFFECTS;
+	*expp = exp;
+}
+
+/*	Some interesting (?) questions answered.
+*/
+int
+is_integral_type(tp)
+	register struct type *tp;
+{
+	switch (tp->tp_fund)	{
+	case GENERIC:
+	case CHAR:
+	case SHORT:
+	case INT:
+	case LONG:
+	case ENUM:
+		return 1;
+#ifndef NOBITFIELD
+	case FIELD:
+		return is_integral_type(tp->tp_up);
+#endif NOBITFIELD
+	default:
+		return 0;
+	}
+}
+
+int
+is_arith_type(tp)
+	register struct type *tp;
+{
+	switch (tp->tp_fund)	{
+	case GENERIC:
+	case CHAR:
+	case SHORT:
+	case INT:
+	case LONG:
+	case ENUM:
+	case FLOAT:
+	case DOUBLE:
+	case LNGDBL:
+		return 1;
+#ifndef NOBITFIELD
+	case FIELD:
+		return is_arith_type(tp->tp_up);
+#endif NOBITFIELD
+	default:
+		return 0;
+	}
+}

lang/cem/cemcom.ansi/ch7bin.c

@@ -0,0 +1,352 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Header$ */
+/* SEMANTIC ANALYSIS (CHAPTER 3.3)  --  BINARY OPERATORS */
+
+#include	"botch_free.h"
+#include	<alloc.h>
+#include	"lint.h"
+#include	"idf.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"type.h"
+#include	"struct.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"Lpars.h"
+
+extern char options[];
+extern char *symbol2str();
+
+/*	This chapter asks for the repeated application of code to handle
+	an operation that may be executed at compile time or at run time,
+	depending on the constancy of the operands.
+*/
+
+#define commutative_binop(expp, oper, expr)	mk_binop(expp, oper, expr, 1)
+#define non_commutative_binop(expp, oper, expr)	mk_binop(expp, oper, expr, 0)
+
+ch7bin(expp, oper, expr)
+	register struct expr **expp;
+	struct expr *expr;
+{
+	/*	apply binary operator oper between *expp and expr.
+		NB: don't swap operands if op is one of the op= operators!!!
+	*/
+
+	any2opnd(expp, oper);
+	any2opnd(&expr, oper);
+	switch (oper)	{
+	case '[':				/* 3.3.2.1 */
+		/* indexing follows the commutative laws */
+		switch ((*expp)->ex_type->tp_fund)	{
+		case POINTER:
+		case ARRAY:
+			break;
+		case ERRONEOUS:
+			return;
+		default:		/* unindexable */
+			switch (expr->ex_type->tp_fund)	{
+			case POINTER:
+			case ARRAY:
+				break;
+			case ERRONEOUS:
+				return;
+			default:
+				expr_error(*expp,
+					"indexing an object of type %s",
+					symbol2str((*expp)->ex_type->tp_fund));
+				return;
+			}
+			break;
+		}
+		ch7bin(expp, '+', expr);
+		ch7mon('*', expp);
+		break;
+
+	case '(':				/* 3.3.2.2 */
+		if (	(*expp)->ex_type->tp_fund == POINTER &&
+			(*expp)->ex_type->tp_up->tp_fund == FUNCTION
+		)	{
+			ch7mon('*', expp);
+		}
+		if ((*expp)->ex_type->tp_fund != FUNCTION)	{
+			expr_error(*expp, "call of non-function (%s)",
+				symbol2str((*expp)->ex_type->tp_fund));
+			/* leave the expression; it may still serve */
+			free_expression(expr);	/* there go the parameters */
+			*expp = new_oper(error_type,
+					*expp, '(', (struct expr *)0);
+		}
+		else
+			*expp = new_oper((*expp)->ex_type->tp_up,
+					*expp, '(', expr);
+		(*expp)->ex_flags |= EX_SIDEEFFECTS;
+		break;
+
+	case PARCOMMA:				/* 3.3.2.2 */
+		if ((*expp)->ex_type->tp_fund == FUNCTION)
+			function2pointer(*expp);
+		*expp = new_oper(expr->ex_type, *expp, PARCOMMA, expr);
+		break;
+
+	case '%':
+	case MODAB:
+	case ANDAB:
+	case XORAB:
+	case ORAB:
+		opnd2integral(expp, oper);
+		opnd2integral(&expr, oper);
+		/* fallthrough */
+	case '/':
+	case DIVAB:
+	case TIMESAB:
+		arithbalance(expp, oper, &expr);
+		non_commutative_binop(expp, oper, expr);
+		break;
+
+	case '&':
+	case '^':
+	case '|':
+		opnd2integral(expp, oper);
+		opnd2integral(&expr, oper);
+		/* fallthrough */
+	case '*':
+		arithbalance(expp, oper, &expr);
+		commutative_binop(expp, oper, expr);
+		break;
+
+	case '+':
+		if (expr->ex_type->tp_fund == POINTER)	{ /* swap operands */
+			struct expr *etmp = expr;
+			expr = *expp;
+			*expp = etmp;
+		}
+		/* fallthrough */
+	case PLUSAB:
+	case POSTINCR:
+	case PLUSPLUS:
+		if ((*expp)->ex_type->tp_fund == POINTER)	{
+			pointer_arithmetic(expp, oper, &expr);
+			if (expr->ex_type->tp_size != (*expp)->ex_type->tp_size)
+				ch7cast(&expr, CAST, (*expp)->ex_type);
+			pointer_binary(expp, oper, expr);
+		}
+		else	{
+			arithbalance(expp, oper, &expr);
+			if (oper == '+')
+				commutative_binop(expp, oper, expr);
+			else
+				non_commutative_binop(expp, oper, expr);
+		}
+		break;
+
+	case '-':
+	case MINAB:
+	case POSTDECR:
+	case MINMIN:
+		if ((*expp)->ex_type->tp_fund == POINTER)	{
+			if (expr->ex_type->tp_fund == POINTER)
+				pntminuspnt(expp, oper, expr);
+			else {
+				pointer_arithmetic(expp, oper, &expr);
+				pointer_binary(expp, oper, expr);
+			}
+		}
+		else	{
+			arithbalance(expp, oper, &expr);
+			non_commutative_binop(expp, oper, expr);
+		}
+		break;
+
+	case LEFT:
+	case RIGHT:
+	case LEFTAB:
+	case RIGHTAB:
+		opnd2integral(expp, oper);
+		opnd2integral(&expr, oper);
+		arithbalance(expp, oper, &expr); /* ch. 7.5 */
+		ch7cast(&expr, oper, int_type); /* cvt. rightop to int */
+		non_commutative_binop(expp, oper, expr);
+		break;
+
+	case '<':
+	case '>':
+	case LESSEQ:
+	case GREATEREQ:
+	case EQUAL:
+	case NOTEQUAL:
+		relbalance(expp, oper, &expr);
+		non_commutative_binop(expp, oper, expr);
+		(*expp)->ex_type = int_type;
+		break;
+
+	case AND:
+	case OR:
+		opnd2test(expp, oper);
+		opnd2test(&expr, oper);
+		if (is_cp_cst(*expp))	{
+			register struct expr *ex = *expp;
+
+			/* the following condition is a short-hand for
+				((oper == AND) && o1) || ((oper == OR) && !o1)
+				where o1 == (*expp)->VL_VALUE;
+				and ((oper == AND) || (oper == OR))
+			*/
+			if ((oper == AND) == (ex->VL_VALUE != (arith)0))
+				*expp = expr;
+			else {
+				ex->ex_flags |= expr->ex_flags;
+				free_expression(expr);
+				*expp = intexpr((arith)((oper == AND) ? 0 : 1),
+						INT);
+			}
+			(*expp)->ex_flags |= ex->ex_flags;
+			free_expression(ex);
+		}
+		else
+		if (is_cp_cst(expr))	{
+			/* Note!!!: the following condition is a short-hand for
+				((oper == AND) && o2) || ((oper == OR) && !o2)
+				where o2 == expr->VL_VALUE
+				and ((oper == AND) || (oper == OR))
+			*/
+			if ((oper == AND) == (expr->VL_VALUE != (arith)0)) {
+				(*expp)->ex_flags |= expr->ex_flags;
+				free_expression(expr);
+			}
+			else {
+				if (oper == OR)
+					expr->VL_VALUE = (arith)1;
+				ch7bin(expp, ',', expr);
+			}
+		}
+		else {
+			*expp = new_oper(int_type, *expp, oper, expr);
+		}
+		(*expp)->ex_flags |= EX_LOGICAL;
+		break;
+
+	case ':':
+		if (	is_struct_or_union((*expp)->ex_type->tp_fund)
+		||	is_struct_or_union(expr->ex_type->tp_fund)
+		)	{
+			if (!equal_type((*expp)->ex_type, expr->ex_type))
+				expr_error(*expp, "illegal balance");
+		}
+		else
+			relbalance(expp, oper, &expr);
+#ifdef	LINT
+		if (	(is_cp_cst(*expp) && is_cp_cst(expr))
+		&&	(*expp)->VL_VALUE == expr->VL_VALUE
+		) {
+			hwarning("operands of : are constant and equal");
+		}
+#endif	LINT
+		*expp = new_oper((*expp)->ex_type, *expp, oper, expr);
+		break;
+
+	case '?':
+		opnd2logical(expp, oper);
+		if (is_cp_cst(*expp)) {
+#ifdef	LINT
+			hwarning("condition in ?: expression is constant");
+#endif	LINT
+			*expp = (*expp)->VL_VALUE ?
+				expr->OP_LEFT : expr->OP_RIGHT;
+		}
+		else {
+			*expp = new_oper(expr->ex_type, *expp, oper, expr);
+		}
+		break;
+
+	case ',':
+		if (is_cp_cst(*expp))
+			*expp = expr;
+		else
+			*expp = new_oper(expr->ex_type, *expp, oper, expr);
+		(*expp)->ex_flags |= EX_COMMA;
+		break;
+	}
+}
+
+pntminuspnt(expp, oper, expr)
+	register struct expr **expp, *expr;
+{
+	/*	Subtracting two pointers is so complicated it merits a
+		routine of its own.
+	*/
+	struct type *up_type = (*expp)->ex_type->tp_up;
+
+	if (!equal_type(up_type, expr->ex_type->tp_up)) {
+		expr_error(*expp, "subtracting incompatible pointers");
+		free_expression(expr);
+		erroneous2int(expp);
+		return;
+	}
+	/*	we hope the optimizer will eliminate the load-time
+		pointer subtraction
+	*/
+	*expp = new_oper((*expp)->ex_type, *expp, oper, expr);
+	ch7cast(expp, CAST, pa_type);	/* ptr-ptr: result has pa_type	*/
+	ch7bin(expp, '/',
+		intexpr(size_of_type(up_type, "object"), pa_type->tp_fund));
+	ch7cast(expp, CAST, int_type);	/* result will be an integer expr */
+}
+
+mk_binop(expp, oper, expr, commutative)
+	struct expr **expp;
+	register struct expr *expr;
+{
+	/*	Constructs in *expp the operation indicated by the operands.
+		"commutative" indicates whether "oper" is a commutative
+		operator.
+	*/
+	register struct expr *ex = *expp;
+
+	if (is_cp_cst(expr) && is_cp_cst(ex))
+		cstbin(expp, oper, expr);
+	else if (is_fp_cst(expr) && is_fp_cst(ex))
+		fltcstbin(expp, oper, expr);
+	else	{
+		*expp = (commutative && expr->ex_depth >= ex->ex_depth) ?
+				new_oper(ex->ex_type, expr, oper, ex) :
+				new_oper(ex->ex_type, ex, oper, expr);
+	}
+}
+
+pointer_arithmetic(expp1, oper, expp2)
+	register struct expr **expp1, **expp2;
+{
+	int typ;
+	/*	prepares the integral expression expp2 in order to
+		apply it to the pointer expression expp1
+	*/
+	if ((typ = any2arith(expp2, oper)) == FLOAT
+	    || typ == DOUBLE
+	    || typ == LNGDBL)	{
+		expr_error(*expp2,
+			"illegal combination of %s and pointer",
+			symbol2str(typ));
+		erroneous2int(expp2);
+	}
+	ch7bin( expp2, '*',
+		intexpr(size_of_type((*expp1)->ex_type->tp_up, "object"),
+			pa_type->tp_fund)
+	);
+}
+
+pointer_binary(expp, oper, expr)
+	register struct expr **expp, *expr;
+{
+	/*	constructs the pointer arithmetic expression out of
+		a pointer expression, a binary operator and an integral
+		expression.
+	*/
+	if (is_ld_cst(expr) && is_ld_cst(*expp))
+		cstbin(expp, oper, expr);
+	else
+		*expp = new_oper((*expp)->ex_type, *expp, oper, expr);
+}

lang/cem/cemcom.ansi/ch7mon.c

@@ -0,0 +1,168 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Header$ */
+/* SEMANTIC ANALYSIS (CHAPTER 3.3) -- MONADIC OPERATORS */
+
+#include	"botch_free.h"
+#include	<alloc.h>
+#include	"nobitfield.h"
+#include	"Lpars.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"type.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"idf.h"
+#include	"def.h"
+
+extern char options[];
+extern arith full_mask[/*MAXSIZE*/];	/* cstoper.c */
+char *symbol2str();
+
+ch7mon(oper, expp)
+	register struct expr **expp;
+{
+	/*	The monadic prefix operator oper is applied to *expp.
+	*/
+	register struct expr *expr;
+
+	switch (oper)	{
+	case '*':			/* 3.3.3.2 */
+		/* no FIELD type allowed	*/
+		if ((*expp)->ex_type->tp_fund == ARRAY)
+			array2pointer(*expp);
+		if ((*expp)->ex_type->tp_fund != POINTER) {
+		    if ((*expp)->ex_type->tp_fund != FUNCTION) {
+			    expr_error(*expp,
+				    "* applied to non-pointer (%s)",
+				    symbol2str((*expp)->ex_type->tp_fund));
+		    } else {
+			    warning("superfluous use of * on function");
+			    /* ignore indirection (yegh) */
+		    }
+		} else {
+			expr = *expp;
+			if (expr->ex_lvalue == 0 && expr->ex_class != String)
+				/* dereference in administration only */
+				expr->ex_type = expr->ex_type->tp_up;
+			else	/* runtime code */
+				*expp = new_oper(expr->ex_type->tp_up, NILEXPR,
+							'*', expr);
+			(*expp)->ex_lvalue = (
+				(*expp)->ex_type->tp_fund != ARRAY &&
+				(*expp)->ex_type->tp_fund != FUNCTION
+				);
+			if ((*expp)->ex_type->tp_typequal & TQ_CONST)
+				(*expp)->ex_flags |= EX_READONLY;
+			if ((*expp)->ex_type->tp_typequal & TQ_VOLATILE)
+				(*expp)->ex_flags |= EX_VOLATILE;
+			(*expp)->ex_flags &= ~EX_ILVALUE;
+		}
+		break;
+	case '&':
+		if ((*expp)->ex_type->tp_fund == ARRAY) {
+			expr_warning(*expp, "& before array ignored");
+			array2pointer(*expp);
+		}
+		else
+		if ((*expp)->ex_type->tp_fund == FUNCTION) {
+			expr_warning(*expp, "& before function ignored");
+			function2pointer(*expp);
+		}
+		else
+#ifndef NOBITFIELD
+		if ((*expp)->ex_type->tp_fund == FIELD)
+			expr_error(*expp, "& applied to field variable");
+		else
+#endif NOBITFIELD
+		if (!(*expp)->ex_lvalue)
+			expr_error(*expp, "& applied to non-lvalue");
+		else if ((*expp)->ex_flags & EX_ILVALUE)
+			expr_error(*expp, "& applied to illegal lvalue");
+		else {
+			/* assume that enums are already filtered out	*/
+			if (ISNAME(*expp)) {
+				register struct def *def =
+					(*expp)->VL_IDF->id_def;
+
+				/*	&<var> indicates that <var>
+					cannot be used as register
+					anymore
+				*/
+				if (def->df_sc == REGISTER) {
+					expr_error(*expp,
+					"& on register variable not allowed");
+					break;	/* break case '&' */
+				}
+			}
+			(*expp)->ex_type = pointer_to((*expp)->ex_type,
+						(*expp)->ex_type->tp_typequal);
+			(*expp)->ex_lvalue = 0;
+			(*expp)->ex_flags &= ~EX_READONLY;
+		}
+		break;
+	case '~':
+	{
+		int fund = (*expp)->ex_type->tp_fund;
+
+		if (fund == FLOAT || fund == DOUBLE || fund == LNGDBL)	{
+			expr_error( *expp,
+				    "~ not allowed on %s operands",
+				    symbol2str(fund));
+			erroneous2int(expp);
+			break;
+		}
+		/* FALLTHROUGH */
+	}
+	case '-':
+		any2arith(expp, oper);
+		if (is_cp_cst(*expp))	{
+			arith o1 = (*expp)->VL_VALUE;
+
+			(*expp)->VL_VALUE = (oper == '-') ? -o1 :
+			  ((*expp)->ex_type->tp_unsigned ?
+				(~o1) & full_mask[(*expp)->ex_type->tp_size] :
+				~o1
+			  );
+		}
+		else
+		if (is_fp_cst(*expp))
+			switch_sign_fp(*expp);
+		else
+			*expp = new_oper((*expp)->ex_type,
+					NILEXPR, oper, *expp);
+		break;
+	case '!':
+		if ((*expp)->ex_type->tp_fund == FUNCTION)
+			function2pointer(*expp);
+		if ((*expp)->ex_type->tp_fund != POINTER)
+			any2arith(expp, oper);
+		opnd2test(expp, '!');
+		if (is_cp_cst(*expp))	{
+			(*expp)->VL_VALUE = !((*expp)->VL_VALUE);
+			(*expp)->ex_type = int_type;	/* a cast ???(EB) */
+		}
+		else
+			*expp = new_oper(int_type, NILEXPR, oper, *expp);
+		(*expp)->ex_flags |= EX_LOGICAL;
+		break;
+	case PLUSPLUS:
+	case MINMIN:
+		ch7incr(expp, oper);
+		break;
+	case SIZEOF:
+		if (ISNAME(*expp) && (*expp)->VL_IDF->id_def->df_formal_array)
+			expr_warning(*expp, "sizeof formal array %s is sizeof pointer!",
+				(*expp)->VL_IDF->id_text);
+		expr = intexpr((*expp)->ex_class == String ?
+				   (arith)((*expp)->SG_LEN) :
+				   size_of_type((*expp)->ex_type, "object"),
+				INT);
+		expr->ex_flags |= EX_SIZEOF;
+		free_expression(*expp);
+		*expp = expr;
+		break;
+	}
+}

lang/cem/cemcom.ansi/char.tab

@@ -0,0 +1,67 @@
+%
+%	CHARACTER CLASSES
+%
+% some general settings:
+%S129
+%F	%s,
+%
+%	START OF TOKEN
+%
+%iSTGARB
+STSKIP:\r \t\013\f
+STNL:\n
+STCOMP:-!&+<=>|*%/^
+STSIMP:(),:;?[]{}~
+STCHAR:'
+STIDF:a-zA-KM-Z_\003
+STELL:L
+STNUM:.0-9
+STSTR:"
+STEOI:\200
+STMSPEC:\004
+%T/* character classes */
+%T#include "class.h"
+%Tchar tkclass[] = {
+%p
+%T};
+%
+%	INIDF
+%
+%C
+1:a-zA-Z_0-9
+%Tchar inidf[] = {
+%F	%s,
+%p
+%T};
+%
+%	ISDIG
+%
+%C
+1:0-9
+%Tchar isdig[] = {
+%p
+%T};
+%
+%	ISHEX
+%
+%C
+1:0-9a-fA-F
+%Tchar ishex[] = {
+%p
+%T};
+%
+%	ISOCT
+%
+%C
+1:0-7
+%Tchar isoct[] = {
+%p
+%T};
+%
+%	ISWSP
+%
+%C
+1: \t\n
+%Tchar iswsp[] = {
+%p
+%T};

lang/cem/cemcom.ansi/class.h

@@ -0,0 +1,47 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*		U S E   O F   C H A R A C T E R   C L A S S E S		*/
+
+/*	As a starter, chars are divided into classes, according to which
+	token they can be the start of.
+	At present such a class number is supposed to fit in 4 bits.
+*/
+
+#define	class(ch)	(tkclass[ch])
+
+/*	Being the start of a token is, fortunately, a mutual exclusive
+	property, so, as there are less than 16 classes they can be
+	packed in 4 bits.
+*/
+
+#define	STSKIP	0	/* spaces and so on: skipped characters		*/
+#define	STNL	1	/* newline character(s): update linenumber etc.	*/
+#define	STGARB	2	/* garbage ascii character: not allowed in C	*/
+#define	STSIMP	3	/* this character can occur as token in C	*/
+#define	STCOMP	4	/* this one can start a compound token in C	*/
+#define	STELL	5	/* wide character- or string- constant prefix	*/
+#define	STIDF	6	/* being the initial character of an identifier	*/
+#define	STCHAR	7	/* the starter of a character constant		*/
+#define	STSTR	8	/* the starter of a string			*/
+#define	STNUM	9	/* the starter of a numeric constant		*/
+#define	STEOI	10	/* End-Of-Information mark			*/
+#define	STMSPEC	11	/* special class for token expansion		*/
+
+#define	NOEXPM	'\003'	/* don't expand the next macro identifier	*/
+#define	TOKSEP	'\004'	/* the token separator				*/
+
+/*	But occurring inside a token is not, so we need 1 bit for each
+	class.  This is implemented as a collection of tables to speed up
+	the decision whether a character has a special meaning.
+*/
+#define	in_idf(ch)	(inidf[ch])
+#define	is_oct(ch)	(isoct[ch])
+#define	is_dig(ch)	(isdig[ch])
+#define	is_hex(ch)	(ishex[ch])
+#define	is_wsp(ch)	(iswsp[ch])
+
+extern char tkclass[];
+extern char inidf[], isoct[], isdig[], ishex[], iswsp[];

lang/cem/cemcom.ansi/code.c

@@ -0,0 +1,802 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	C O D E - G E N E R A T I N G   R O U T I N E S		*/
+
+#include	"lint.h"
+#include	"debug.h"
+#include	"dbsymtab.h"
+#ifndef	LINT
+#include	<em.h>
+#else
+#include	"l_em.h"
+#include	"l_lint.h"
+#endif	/* LINT */
+#include	"botch_free.h"
+#include	<alloc.h>
+#include	"dataflow.h"
+#include	"use_tmp.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"type.h"
+#include	"idf.h"
+#include	"label.h"
+#include	"code.h"
+#include	"stmt.h"
+#include	"def.h"
+#include	"expr.h"
+#include	"sizes.h"
+#include	"stack.h"
+#include	"level.h"
+#include	"decspecs.h"
+#include	"declar.h"
+#include	"Lpars.h"
+#include	"specials.h"
+#include	"atw.h"
+#include	"assert.h"
+#include	"LLlex.h"
+#include	"align.h"
+#ifdef	LINT
+#include	"l_lint.h"
+#endif	/* LINT */
+#ifdef DBSYMTAB
+#include	<stb.h>
+#endif /* DBSYMTAB */
+
+label lab_count = 1;
+label datlab_count = 1;
+
+int fp_used;
+extern arith NewLocal();	/* util.c	*/
+
+/* global function info */
+char *func_name;
+struct type *func_type;
+#ifdef LINT
+int func_notypegiven;
+#endif
+
+#ifdef USE_TMP
+static int	tmp_id;
+static int	pro_id;
+#endif /* USE_TMP */
+
+extern char options[];
+extern char *symbol2str();
+extern char *source;
+
+#ifndef	LINT
+init_code(dst_file)
+	char *dst_file;
+{
+	/*	init_code() initialises the output file on which the
+		compact EM code is written
+	*/
+	C_init(word_size, pointer_size); /* initialise EM module */
+	if (C_open(dst_file) == 0)
+		fatal("cannot write to %s\n", dst_file);
+	C_magic();
+	C_ms_emx(word_size, pointer_size);
+#ifdef DBSYMTAB
+	if (options['g']) {
+		C_ms_std(source, N_SO, 0);
+		stb_typedef(int_type, "int");
+		stb_typedef(schar_type, "char");
+		stb_typedef(long_type, "long");
+		stb_typedef(short_type, "short");
+		stb_typedef(uchar_type, "unsigned char");
+		stb_typedef(ushort_type, "unsigned short");
+		stb_typedef(ulong_type, "unsigned long");
+		stb_typedef(uint_type, "unsigned int");
+		stb_typedef(float_type, "float");
+		stb_typedef(double_type, "double");
+		stb_typedef(lngdbl_type, "long double");
+		stb_typedef(void_type, "void");
+	}
+#endif /* DBSYMTAB */
+#ifdef USE_TMP
+#ifdef PREPEND_SCOPES
+	C_insertpart(tmp_id = C_getid());
+#endif	/* PREPEND_SCOPES */
+#endif	/* USE_TMP */
+}
+#endif	/* LINT */
+
+struct string_cst *str_list = 0;
+
+label
+code_string(val, len)
+	char *val;
+	int len;
+{
+	register struct string_cst *sc = new_string_cst();
+	label dlb = data_label();
+
+	C_ina_dlb(dlb);
+	sc->next = str_list;
+	str_list = sc;
+	sc->sc_value = val;
+	sc->sc_len = len;
+	sc->sc_dlb = dlb;
+	return dlb;
+}
+
+def_strings(sc)
+	register struct string_cst *sc;
+{
+	while (sc) {
+		struct string_cst *sc1 = sc;
+
+		C_df_dlb(sc->sc_dlb);
+		str_cst(sc->sc_value, sc->sc_len, 1);	/* string in rom */
+		sc = sc->next;
+		free(sc1->sc_value);
+		free_string_cst(sc1);
+	}
+}
+
+/* flush_strings() is called from program.g after each external definition */
+flush_strings() {
+	if (str_list) {
+		def_strings(str_list);
+		str_list = 0;
+	}
+}
+
+#ifndef	LINT
+end_code()
+{
+	/*	end_code() performs the actions to be taken when closing
+		the output stream.
+	*/
+	if (fp_used) {
+		/* floating point used	*/
+		C_ms_flt();
+	}
+	C_ms_src((int)(LineNumber - 2), source);
+	C_close();
+}
+#endif	/* LINT */
+
+#ifdef	PREPEND_SCOPES
+prepend_scopes()
+{
+	/*	prepend_scopes() runs down the list of global idf's
+		and generates those exa's, exp's, ina's and inp's
+		that superior hindsight has provided.
+	*/
+	register struct stack_entry *se = local_level->sl_entry;
+
+#ifdef USE_TMP
+	C_beginpart(tmp_id);
+#endif /* USE_TMP */
+	while (se != 0)	{
+		register struct def *df = se->se_idf->id_def;
+		
+		if (df && (df->df_initialized || df->df_used || df->df_alloc)) {
+			code_scope(se->se_idf->id_text, df);
+		}
+		se = se->next;
+	}
+#ifdef USE_TMP
+	C_endpart(tmp_id);
+#endif /* USE_TMP */
+}
+#endif	/* PREPEND_SCOPES */
+
+code_scope(text, def)
+	char *text;
+	register struct def *def;
+{
+	/*	generates code for one name, text, of the storage class
+		as given by def, if meaningful.
+	*/
+	int fund = def->df_type->tp_fund;
+	
+	switch (def->df_sc)	{
+	case EXTERN:
+	case GLOBAL:
+		if (fund == FUNCTION)
+			C_exp(text);
+		else
+			C_exa_dnam(text);
+		break;
+	case STATIC:
+		if (fund == FUNCTION)
+			C_inp(text);
+		else
+			C_ina_dnam(text);
+		break;
+	}
+}
+
+static label return_label, return2_label;
+static char return_expr_occurred;
+static arith func_size;
+static int struct_return;
+static char *last_fn_given = (char *)0;
+static label file_name_label;
+
+begin_proc(ds, idf)		/* to be called when entering a procedure */
+	struct decspecs *ds;
+	struct idf *idf;
+{
+	/*	begin_proc() is called at the entrance of a new function
+		and performs the necessary code generation:
+		-	a scope indicator (if needed) exp/inp
+		-	the procedure entry pro $name
+		-	reserves some space if the result of the function
+			does not fit in the return area
+		-	a fil pseudo instruction
+	*/
+	register char *name = idf->id_text;
+	register struct def *def = idf->id_def;
+
+	/* idf->id_def does not indicate the right def structure
+	 * when the function being defined has a parameter of the
+	 * same name in an old-style function definition.
+	 */
+	while (def->df_level != L_GLOBAL) def = def->next;
+
+	/* When we have a new-style function definition, the parameters
+	 * are defined first, which means that it may look as if they have
+	 * the greatest scope.  Correct this.
+	 */
+	if (idf->id_def == def && def->next && def->next->df_level == L_PROTO) {
+		struct def *tmpdef = def->next;
+
+		def->next = tmpdef->next;
+		tmpdef->next = def;
+		idf->id_def = tmpdef;
+	}
+#ifndef PREPEND_SCOPES
+	code_scope(name, def);
+#endif	/* PREPEND_SCOPES */
+#ifdef	DATAFLOW
+	if (options['d'])
+		DfaStartFunction(name);
+#endif	/* DATAFLOW */
+
+
+	/* set global function info */
+	func_name = name;
+	if (def->df_type->tp_fund != FUNCTION) {
+		error("making function body for non-function");
+		def->df_type = error_type;
+	}
+	func_type = def->df_type->tp_up;
+#ifdef LINT
+	func_notypegiven = ds->ds_notypegiven;
+#endif
+	func_size = ATW(func_type->tp_size);
+	sp_occurred[SP_SETJMP] = 0;
+
+#ifndef USE_TMP
+	C_pro_narg(name);
+#else
+	C_insertpart(pro_id = C_getid());
+#endif
+	if (is_struct_or_union(func_type->tp_fund))	{
+		if (func_size <= 0) {
+			error("unknown return type for function %s", name);
+		} else {
+			struct_return = 1;
+		}
+	}
+	else
+		struct_return = 0;
+	/*	Special arrangements if the function result doesn't fit in
+		the function return area of the EM machine.  The size of
+		the function return area is implementation dependent.
+	*/
+	lab_count = (label) 1;
+	return_label = text_label();
+	return2_label = text_label();
+	return_expr_occurred = 0;
+	LocalInit();
+	prc_entry(name);
+	if (! options['L'])	{	/* profiling */
+		if (!last_fn_given || strcmp(last_fn_given, FileName) != 0) {
+			/* previous function came from other file */
+			C_df_dlb(file_name_label = data_label());
+			C_con_scon(last_fn_given = FileName,
+				(arith)(strlen(FileName) + 1));
+		}
+		/* enable debug trace of EM source */
+		C_fil_dlb(file_name_label, (arith)0);
+		C_lin((arith)LineNumber);
+	}
+#ifdef DBSYMTAB
+	if (options['g']) {
+		stb_string(def, FUNCTION, name);
+		if (! strcmp(name, "main")) {
+			C_ms_stb_cst(name, N_MAIN, 0, (arith) 0);
+		}
+	}
+#endif
+}
+
+end_proc(fbytes)
+	arith fbytes;
+{
+	/*	end_proc() deals with the code to be generated at the end of
+		a function, as there is:
+		-	the EM ret instruction: "ret 0"
+		-	loading of the function result in the function
+			result area if there has been a return <expr>
+			in the function body (see do_return_expr())
+		-	indication of the use of floating points
+		-	indication of the number of bytes used for
+			formal parameters
+		-	use of special identifiers such as "__setjmp"
+		-	"end" + number of bytes used for local variables
+	*/
+	arith nbytes;
+	char optionsn = options['n'];
+
+#ifdef	DATAFLOW
+	if (options['d'])
+		DfaEndFunction();
+#endif	/* DATAFLOW */
+	C_df_ilb(return2_label);
+	if (return_expr_occurred && struct_return == 0) {
+			C_asp(-func_size);
+	}
+	C_df_ilb(return_label);
+	prc_exit();
+	if (return_expr_occurred) {
+		if (struct_return != 0)	{
+			LoadLocal((arith) 0, pointer_size);
+			C_ret(pointer_size);
+		}
+		else
+			C_ret(func_size);
+	}
+	else	C_ret((arith) 0);
+
+	/* getting the number of "local" bytes is posponed until here,
+	   because copying the function result may need temporaries!
+	   However, local_level is now L_FORMAL2, because
+	   L_LOCAL is already unstacked. Therefore, "unstack_level" must
+	   also pass "sl_max_block" to the level above L_LOCAL.
+	*/
+	nbytes = ATW(- local_level->sl_max_block);
+#ifdef USE_TMP
+	C_beginpart(pro_id);
+	C_pro(func_name, nbytes);
+#endif
+	if (fbytes > max_int) {
+		error("%s has more than %ld parameter bytes",
+			func_name, (long) max_int);
+	}
+	C_ms_par(fbytes);		/* # bytes for formals		*/
+	if (sp_occurred[SP_SETJMP]) {	/* indicate use of "__setjmp"	*/
+		options['n'] = 1;
+		C_ms_gto();
+		sp_occurred[SP_SETJMP] = 0;
+	}
+#ifdef USE_TMP
+	C_endpart(pro_id);
+#endif
+	LocalFinish();
+	C_end(nbytes);
+	if (nbytes > max_int) {
+		error("%s has more than %ld bytes of local variables",
+			func_name, (long) max_int);
+	}
+	options['n'] = optionsn;
+}
+
+do_return()
+{
+	/*	do_return handles the case of a return without expression.
+		This version branches to the return label, which is
+		probably smarter than generating a direct return.
+		Return sequences may be expensive.
+	*/
+#ifdef DBSYMTAB
+	if (options['g']) db_line(dot.tk_file, dot.tk_line);
+#endif /* DBSYMTAB */
+	C_bra(return2_label);
+}
+
+do_return_expr(expr)
+	struct expr *expr;
+{
+	/*	do_return_expr() generates the expression and the jump for
+		a return statement with an expression.
+	*/
+	ch3cast(&expr, RETURN, func_type);
+	code_expr(expr, RVAL, TRUE, NO_LABEL, NO_LABEL);
+	if (struct_return != 0) {
+		LoadLocal((arith) 0, pointer_size);
+		store_block(func_type->tp_size, func_type->tp_align);
+	}
+	C_bra(return_label);
+	return_expr_occurred = 1;
+}
+
+code_declaration(idf, expr, lvl, sc)
+	register struct idf *idf;	/* idf to be declared	*/
+	struct expr *expr;	/* initialisation; NULL if absent	*/
+	int lvl;		/* declaration level	*/
+	int sc;			/* storage class, as in the declaration */
+{
+	/*	code_declaration() does the actual declaration of the
+		variable indicated by "idf" on declaration level "lvl".
+		If the variable is initialised, the expression is given
+		in "expr", but for global and static initialisations it
+		is just non-zero, as the expression is not parsed yet.
+		There are some cases to be considered:
+		-	filter out typedefs, they don't correspond to code;
+		-	global variables, coded only if initialized;
+		-	local static variables;
+		-	local automatic variables;
+		Since the expression may be modified in the process,
+		code_declaration() frees it after use, as the caller can
+		no longer do so.
+		
+		If there is a storage class indication (EXTERN/STATIC),
+		code_declaration() will generate an exa or ina.
+		The sc is the actual storage class, as given in the
+		declaration.
+	*/
+	register struct def *def = idf->id_def;
+	register arith size = def->df_type->tp_size;
+	int fund = def->df_type->tp_fund;
+	int def_sc = def->df_sc;
+	
+	if (def_sc == TYPEDEF)	{	/* no code for typedefs		*/
+#ifdef DBSYMTAB
+		if (options['g']) {
+			stb_typedef(def->df_type, idf->id_text);
+		}
+#endif /* DBSYMTAB */
+		return;
+	}
+	if (lvl == L_GLOBAL)	{	/* global variable	*/
+		/* is this an allocating declaration? */
+		if (	(sc == 0 || sc == STATIC)
+			&& fund != FUNCTION
+		)
+			def->df_alloc = ALLOC_SEEN;
+		if (expr && def_sc == STATIC && sc == EXTERN) {
+			warning("%s has internal linkage", idf->id_text);
+		}
+		if (expr) {	/* code only if initialized */
+#ifndef PREPEND_SCOPES
+			code_scope(idf->id_text, def);
+#endif /* PREPEND_SCOPES */
+			def->df_alloc = ALLOC_DONE;
+			C_df_dnam(idf->id_text);
+		}
+	}
+	else
+	if (lvl >= L_LOCAL)	{	/* local variable	*/
+		/* STATIC, EXTERN, GLOBAL, AUTO or REGISTER */
+		switch (def_sc)	{
+		case STATIC:
+			if (fund == FUNCTION) {
+				/* should produce "inp $function" ??? */
+				break;
+			}
+			/*	they are handled on the spot and get an
+				integer label in EM.
+			*/
+#ifdef DBSYMTAB
+			if (options['g'] && ! expr) {
+				stb_string(def, sc, idf->id_text);
+			}
+#endif /* DBSYMTAB */
+			C_df_dlb((label)def->df_address);
+			if (expr) { /* there is an initialisation */
+			}
+			else {	/* produce blank space */
+				if (size <= 0) {
+					error("size of %s unknown", idf->id_text);
+					size = (arith)0;
+				}
+				C_bss_cst(ATW(size), (arith)0, 1);
+			}
+			break;
+		case EXTERN:
+			if (expr && !is_anon_idf(idf) && level != L_GLOBAL)
+				error("cannot initialize extern %s in block"
+						, idf->id_text);
+		case GLOBAL:
+			/* we are sure there is no expression */
+			break;
+		case AUTO:
+		case REGISTER:
+#ifdef DBSYMTAB
+			if (options['g']) {
+				stb_string(def, sc, idf->id_text);
+			}
+#endif /* DBSYMTAB */
+			if (expr)
+				loc_init(expr, idf);
+			else if ((fund == ARRAY)
+				    && (def->df_type->tp_size == (arith)-1)) {
+				error("size for local %s unknown"
+					, idf->id_text);
+			}
+			break;
+		default:
+			crash("bad local storage class");
+			/*NOTREACHED*/
+		}
+	}
+}
+
+loc_init(expr, id)
+	struct expr *expr;
+	struct idf *id;
+{
+	/*	loc_init() generates code for the assignment of
+		expression expr to the local variable described by id.
+		It frees the expression afterwards.
+	*/
+	register struct expr *e = expr;
+	register struct def *df = id->id_def;
+	register struct type *tp = df->df_type;
+	static arith tmpoffset = 0;
+	static arith unknownsize = 0;
+	
+	ASSERT(df->df_sc != STATIC);
+	switch (tp->tp_fund)	{
+	case ARRAY:
+		if (tp->tp_size == (arith) -1)
+			unknownsize = 1;
+	case STRUCT:
+	case UNION:
+		if (e != (struct expr *) 0) {
+			break;		/* switch */
+		} else if (!tmpoffset) {/* first time for this variable */
+			tmpoffset = df->df_address;
+			if (unknownsize) tmpoffset = -1;
+			df->df_address = data_label();
+			C_df_dlb((label)df->df_address);
+		} else {
+			C_lae_dlb((label)df->df_address, (arith)0);
+			load_block(tp->tp_size, word_align);
+			if (unknownsize) {
+				/* tmpoffset += tp->tp_size; */
+				unknownsize = 0;
+
+				tmpoffset = NewLocal(tp->tp_size
+						    , tp->tp_align
+						    , regtype(tp)
+						    , df->df_sc);
+			}
+			C_lal(tmpoffset);
+			store_block(tp->tp_size, tmpoffset % word_align ? 1 : word_align);
+			df->df_address = tmpoffset;
+			tmpoffset = 0;
+		}
+#ifdef DBSYMTAB
+		if (options['g']) {
+			stb_string(df, AUTO, id->id_text);
+
+		}
+#endif /* DBSYMTAB */
+		return;
+	}
+	if (ISCOMMA(e))	{	/* embraced: int i = {12};	*/
+		while (e)	{
+			loc_init(e->OP_LEFT, id);
+			e = e->OP_RIGHT;
+		}
+	}
+	else	{	/* not embraced	*/
+		ch3cast(&expr, '=', tp);	/* may modify expr */
+#ifndef	LINT
+		{
+			struct value vl;
+
+			EVAL(expr, RVAL, TRUE, NO_LABEL, NO_LABEL);
+			vl.vl_class = Name;
+			vl.vl_data.vl_idf = id;
+			vl.vl_value = (arith)0;
+			store_val(&vl, tp);
+		}
+#else	/* LINT */
+		id->id_def->df_set = 1;
+#endif	/* LINT */
+		free_expression(expr);
+	}
+}
+
+bss(idf)
+	register struct idf *idf;
+{
+	/*	bss() allocates bss space for the global idf.
+	*/
+	register struct def *df = idf->id_def;
+	
+#ifndef	PREPEND_SCOPES
+	code_scope(idf->id_text, df);
+#endif	/* PREPEND_SCOPES */
+#ifdef DBSYMTAB
+	if (options['g']) {
+		stb_string(df, df->df_sc, idf->id_text);
+	}
+#endif /* DBSYMTAB */
+	if (df->df_type->tp_size <= 0) {
+		if (df->df_sc != STATIC &&
+		    df->df_type->tp_fund == ARRAY &&
+		    df->df_type->tp_up &&
+		    df->df_type->tp_up->tp_size >= 0) {
+			C_df_dnam(idf->id_text);
+			C_bss_cst(ATW(df->df_type->tp_up->tp_size), (arith)0, 1);
+		}
+		else error("size of %s unknown (\"%s\", line %d)"
+			, idf->id_text, df->df_file, df->df_line);
+	} else {
+		C_df_dnam(idf->id_text);
+		C_bss_cst(ATW(df->df_type->tp_size), (arith)0, 1);
+	}
+}
+
+formal_cvt(hasproto,df)
+	int hasproto;
+	register struct def *df;
+{
+	/*	formal_cvt() converts a formal parameter of type char or
+		short from int to that type. It also converts a formal
+		parameter of type float from a double to a float.
+	*/
+	register struct type *tp = df->df_type;
+
+	if (tp->tp_size != int_size &&
+		(tp->tp_fund == CHAR || tp->tp_fund == SHORT)
+	) {
+		LoadLocal(df->df_address, int_size);
+		/* conversion(int_type, df->df_type); ???
+		   No, you can't do this on the stack! (CJ)
+		*/
+		StoreLocal(df->df_address, tp->tp_size);
+	} else if (tp->tp_size != double_size
+		    && tp->tp_fund == FLOAT
+		    && !hasproto) {
+		LoadLocal(df->df_address, double_size);
+#ifndef	LINT
+		conversion(double_type, float_type);
+#endif	/* LINT */
+		StoreLocal(df->df_address, tp->tp_size);
+	}
+}
+
+#ifdef	LINT
+/*ARGSUSED*/
+#endif	/* LINT */
+code_expr(expr, val, code, tlbl, flbl)
+	struct expr *expr;
+	label tlbl, flbl;
+{
+	/*	code_expr() is the parser's interface to the expression code
+		generator.  If line number trace is wanted, it generates a
+		lin instruction.  EVAL() is called directly.
+	*/
+#ifndef	LINT
+	if (! options['L'])	/* profiling	*/
+		C_lin((arith)(expr->ex_line));
+#ifdef DBSYMTAB
+	if (options['g']) db_line(expr->ex_file, (unsigned int)expr->ex_line);
+#endif
+	EVAL(expr, val, code, tlbl, flbl);
+#else	/* LINT */
+	lint_expr(expr, code ? USED : IGNORED);
+#endif	/* LINT */
+}
+
+/*	The FOR/WHILE/DO/SWITCH stacking mechanism:
+	stack_stmt() has to be called at the entrance of a
+	for, while, do or switch statement to indicate the
+	EM labels where a subsequent break or continue causes
+	the program to jump to.
+*/
+static struct stmt_block *stmt_stack;	/* top of statement stack */
+
+/*	code_break() generates EM code needed at the occurrence of "break":
+	it generates a branch instruction to the break label of the
+	innermost statement in which break has a meaning.
+	As "break" is legal in any of 'while', 'do', 'for' or 'switch',
+	which are the only ones that are stacked, only the top of
+	the stack is interesting.
+*/
+code_break()
+{
+	register struct stmt_block *stmt_block = stmt_stack;
+
+#ifdef DBSYMTAB
+	if (options['g']) db_line(dot.tk_file, dot.tk_line);
+#endif /* DBSYMTAB */
+	if (stmt_block)
+		C_bra(stmt_block->st_break);
+	else
+		error("break not inside for, while, do or switch");
+}
+
+/*	code_continue() generates EM code needed at the occurrence of
+	"continue":
+	it generates a branch instruction to the continue label of the
+	innermost statement in which continue has a meaning.
+*/
+code_continue()
+{
+	register struct stmt_block *stmt_block = stmt_stack;
+
+	while (stmt_block)	{
+		if (stmt_block->st_continue)	{
+#ifdef DBSYMTAB
+			if (options['g']) db_line(dot.tk_file, dot.tk_line);
+#endif /* DBSYMTAB */
+			C_bra(stmt_block->st_continue);
+			return;
+		}
+		stmt_block = stmt_block->next;
+	}
+	error("continue not inside for, while or do");
+}
+
+stack_stmt(break_label, cont_label)
+	label break_label, cont_label;
+{
+	register struct stmt_block *stmt_block = new_stmt_block();
+
+	stmt_block->next = stmt_stack;
+	stmt_block->st_break = break_label;
+	stmt_block->st_continue = cont_label;
+	stmt_stack = stmt_block;
+}
+
+unstack_stmt()
+{
+	/*	unstack_stmt() unstacks the data of a statement
+		which may contain break or continue
+	*/
+	register struct stmt_block *sbp = stmt_stack;
+	stmt_stack = sbp->next;
+	free_stmt_block(sbp);
+}
+
+static label prc_name;
+
+prc_entry(name)
+	char *name;
+{
+	if (options['p']) {
+		C_df_dlb(prc_name = data_label());
+		C_rom_scon(name, (arith) (strlen(name) + 1));
+		C_lae_dlb(prc_name, (arith) 0);
+		C_cal("procentry");
+		C_asp(pointer_size);
+	}
+}
+
+prc_exit()
+{
+	if (options['p']) {
+		C_lae_dlb(prc_name, (arith) 0);
+		C_cal("procexit");
+		C_asp(pointer_size);
+	}
+}
+
+#ifdef DBSYMTAB
+db_line(file, line)
+	char		*file;
+	unsigned int	line;
+{
+	static unsigned oldline;
+	static char	*oldfile;
+
+	if (file != oldfile || line != oldline) {
+		C_ms_std((char *) 0, N_SLINE, (int) line);
+		oldline = line;
+		oldfile = file;
+	}
+}
+#endif /* DBSYMTAB */

lang/cem/cemcom.ansi/code.str

@@ -0,0 +1,22 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	C O D E - G E N E R A T O R   D E F I N I T I O N S	*/
+
+struct string_cst	{	/* storing string constants */
+	struct string_cst *next;
+	char *sc_value;
+	int sc_len;
+	label sc_dlb;
+};
+
+extern struct string_cst *str_list;
+
+/* ALLOCDEF "string_cst" 5 */
+
+#define	LVAL	0
+#define	RVAL	1
+#define	FALSE	0
+#define	TRUE	1

lang/cem/cemcom.ansi/conversion.c

@@ -0,0 +1,152 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	C O N V E R S I O N - C O D E  G E N E R A T O R	*/
+
+#include	"lint.h"
+#ifndef	LINT
+
+#include	<em.h>
+#include	"arith.h"
+#include	"type.h"
+#include	"sizes.h"
+#include	"Lpars.h"
+
+#define	T_SIGNED		1
+#define	T_UNSIGNED		2
+#define	T_FLOATING		3
+
+/*	conversion() generates the EM code for a conversion between
+	the types char, short, int, long, float, double and pointer.
+	There are three conversion types: signed, unsigned and floating.
+	The EM code to obtain this conversion looks like:
+		LOC sizeof(from_type)
+		LOC sizeof(to_type)
+		C??
+*/
+
+static int convtype();
+
+conversion(from_type, to_type)
+	register struct type *from_type, *to_type;
+{
+	register arith from_size = from_type->tp_size;
+	register arith to_size = to_type->tp_size;
+	int from_cnvtype = convtype(from_type);
+	int to_cnvtype = convtype(to_type);
+
+	if ((int)to_size < (int)word_size) to_size = word_size;
+	if ((int)from_size != (int)to_size || from_cnvtype != to_cnvtype) {
+	    switch (from_cnvtype)	{
+	    case T_SIGNED:
+		switch (to_cnvtype)	{
+		case T_SIGNED:
+			C_loc(from_size);
+			C_loc(to_size);
+			C_cii();
+			break;
+		case T_UNSIGNED:
+		case T_FLOATING:
+			if ((int)from_size < (int)word_size) {
+				C_loc(from_size);
+				C_loc(word_size);
+				C_cii();
+				from_size = word_size;
+			}
+			/* 3.2.1.2 */
+			if (to_cnvtype == T_UNSIGNED
+			    && (int)from_size < (int)to_size) {
+				C_loc(from_size);
+				C_loc(to_size);
+				C_cii();
+				from_size = to_size;
+			}
+			C_loc(from_size);
+			C_loc(to_size);
+			if (to_cnvtype == T_UNSIGNED) C_ciu();
+			else C_cif();
+			break;
+		}
+		break;
+	    case T_UNSIGNED:
+		if ((int)from_size < (int)word_size) from_size = word_size;
+		C_loc(from_size);
+		C_loc(to_size);
+		switch (to_cnvtype)	{
+		case T_SIGNED:
+			C_cui();
+			break;
+		case T_UNSIGNED:
+			C_cuu();
+			break;
+		case T_FLOATING:
+			C_cuf();
+			break;
+		}
+		break;
+	    case T_FLOATING:
+		C_loc(from_size);
+		C_loc(to_size);
+		switch (to_cnvtype)	{
+		case T_SIGNED:
+			C_cfi();
+			break;
+		case T_UNSIGNED:
+			C_cfu();
+			break;
+		case T_FLOATING:
+			C_cff();
+			break;
+		}
+		break;
+	    default:
+		crash("(conversion) illegal type conversion");
+		/*NOTREACHED*/
+	    }
+	}
+	if ((int)(to_type->tp_size) < (int)word_size
+	    && to_cnvtype != T_FLOATING
+	    ) {
+		extern arith full_mask[];
+
+		if (to_cnvtype == T_SIGNED) {
+			C_loc(to_type->tp_size);
+			C_loc(word_size);
+			C_cii();
+		}
+		else {
+			C_loc((arith) full_mask[(int)(to_type->tp_size)]);
+			C_and(word_size);
+		}
+	}
+}
+
+/*	convtype() returns in which category a given type falls:
+	signed, unsigned or floating
+*/
+static int
+convtype(tp)
+	register struct type *tp;
+{
+	switch (tp->tp_fund)	{
+	case CHAR:
+	case SHORT:
+	case INT:
+	case ERRONEOUS:
+	case LONG:
+	case ENUM:
+		return tp->tp_unsigned ? T_UNSIGNED : T_SIGNED;
+	case FLOAT:
+	case DOUBLE:
+	case LNGDBL:
+		return T_FLOATING;
+	case POINTER:
+		return T_UNSIGNED;
+	}
+	return 0;
+}
+
+#endif	/* LINT */
+

lang/cem/cemcom.ansi/cstoper.c

@@ -0,0 +1,260 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	C O N S T A N T   E X P R E S S I O N   H A N D L I N G		*/
+
+#include	"trgt_sizes.h"
+#include	"idf.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"type.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"sizes.h"
+#include	"Lpars.h"
+#include	"assert.h"
+
+arith full_mask[MAXSIZE];/* full_mask[1] == 0XFF, full_mask[2] == 0XFFFF, .. */
+#ifndef NOCROSS
+arith max_int;		/* maximum integer on target machine	*/
+arith max_unsigned;	/* maximum unsigned on target machine	*/
+#endif /* NOCROSS */
+extern int ResultKnown;
+
+cstbin(expp, oper, expr)
+	register struct expr **expp, *expr;
+{
+	/*	The operation oper is performed on the constant
+		expressions *expp(ld) and expr(ct), and the result restored in
+		*expp.
+	*/
+	register arith o1 = (*expp)->VL_VALUE;
+	register arith o2 = expr->VL_VALUE;
+	int uns = (*expp)->ex_type->tp_unsigned;
+
+	ASSERT(is_ld_cst(*expp) && is_cp_cst(expr));
+	switch (oper)	{
+	case '*':
+		o1 *= o2;
+		break;
+	case '/':
+		if (o2 == 0)	{
+			if (!ResultKnown)
+				expr_error(expr, "division by 0");
+			else
+				expr_warning(expr, "division by 0");
+			break;
+		}
+		if (uns)	{
+#ifdef UNSIGNED_ARITH
+			o1 /= (UNSIGNED_ARITH) o2;
+#else
+			/*	this is more of a problem than you might
+				think on C compilers which do not have
+				unsigned arith (== long (probably)).
+			*/
+			if (o2 & arith_sign)	{/* o2 > max_arith */
+				o1 = ! (o1 >= 0 || o1 < o2);
+				/*	this is the unsigned test
+					o1 < o2 for o2 > max_arith
+				*/
+			}
+			else	{		/* o2 <= max_arith */
+				arith half, bit, hdiv, hrem, rem;
+
+				half = (o1 >> 1) & ~arith_sign;
+				bit = o1 & 01;
+				/*	now o1 == 2 * half + bit
+					and half <= max_arith
+					and bit <= max_arith
+				*/
+				hdiv = half / o2;
+				hrem = half % o2;
+				rem = 2 * hrem + bit;
+				o1 = 2 * hdiv + (rem < 0 || rem >= o2);
+				/*	that is the unsigned compare
+					rem >= o2 for o2 <= max_arith
+				*/
+			}
+#endif
+		}
+		else
+			o1 /= o2;
+		break;
+	case '%':
+		if (o2 == 0)	{
+			if (!ResultKnown)
+				expr_error(expr, "modulo by 0");
+			else
+				expr_warning(expr, "modulo by 0");
+			break;
+		}
+		if (uns)	{
+#ifdef UNSIGNED_ARITH
+			o1 %= (UNSIGNED_ARITH) o2;
+#else
+			if (o2 & arith_sign)	{/* o2 > max_arith */
+				o1 = (o1 >= 0 || o1 < o2) ? o1 : o1 - o2;
+				/*	this is the unsigned test
+					o1 < o2 for o2 > max_arith
+				*/
+			}
+			else	{		/* o2 <= max_arith */
+				arith half, bit, hrem, rem;
+
+				half = (o1 >> 1) & ~arith_sign;
+				bit = o1 & 01;
+				/*	now o1 == 2 * half + bit
+					and half <= max_arith
+					and bit <= max_arith
+				*/
+				hrem = half % o2;
+				rem = 2 * hrem + bit;
+				o1 = (rem < 0 || rem >= o2) ? rem - o2 : rem;
+			}
+#endif
+		}
+		else
+			o1 %= o2;
+		break;
+	case '+':
+		o1 += o2;
+		break;
+	case '-':
+		o1 -= o2;
+		break;
+	case LEFT:
+		o1 <<= o2;
+		break;
+	case RIGHT:
+		if (o2 == 0)
+			break;
+		if (uns)	{
+			o1 = (o1 >> 1) & ~arith_sign;
+			o1 >>= (o2 - 1);
+		}
+		else	o1 >>= o2;
+		break;
+	case '<':
+		{
+			arith tmp = o1;
+
+			o1 = o2;
+			o2 = tmp;
+		}
+		/* Fall through */
+	case '>':
+		if (uns)	{
+#ifdef UNSIGNED_ARITH
+			o1 = (UNSIGNED_ARITH) o1 > (UNSIGNED_ARITH) o2;
+#else
+			o1 = (o1 & arith_sign ?
+				(o2 & arith_sign ? o1 > o2 : 1) :
+				(o2 & arith_sign ? 0 : o1 > o2)
+			);
+#endif
+		}
+		else
+			o1 = o1 > o2;
+		break;
+	case LESSEQ:
+		{
+			arith tmp = o1;
+
+			o1 = o2;
+			o2 = tmp;
+		}
+		/* Fall through */
+	case GREATEREQ:
+		if (uns)	{
+#ifdef UNSIGNED_ARITH
+			o1 = (UNSIGNED_ARITH) o1 >= (UNSIGNED_ARITH) o2;
+#else
+			o1 = (o1 & arith_sign ?
+				(o2 & arith_sign ? o1 >= o2 : 1) :
+				(o2 & arith_sign ? 0 : o1 >= o2)
+			);
+#endif
+		}
+		else
+			o1 = o1 >= o2;
+		break;
+	case EQUAL:
+		o1 = o1 == o2;
+		break;
+	case NOTEQUAL:
+		o1 = o1 != o2;
+		break;
+	case '&':
+		o1 &= o2;
+		break;
+	case '|':
+		o1 |= o2;
+		break;
+	case '^':
+		o1 ^= o2;
+		break;
+	}
+	(*expp)->VL_VALUE = o1;
+	cut_size(*expp);
+	(*expp)->ex_flags |= expr->ex_flags;
+	(*expp)->ex_flags &= ~EX_PARENS;
+	free_expression(expr);
+}
+
+cut_size(expr)
+	register struct expr *expr;
+{
+	/*	The constant value of the expression expr is made to
+		conform to the size of the type of the expression.
+	*/
+	register arith o1 = expr->VL_VALUE;
+	int uns = expr->ex_type->tp_unsigned;
+	int size = (int) expr->ex_type->tp_size;
+
+	ASSERT(expr->ex_class == Value);
+	if (expr->ex_type->tp_fund == POINTER) {
+		/* why warn on "ptr-3" ?
+		   This quick hack fixes it
+		*/
+		uns = 0;
+	}
+	if (uns) {
+		if (o1 & ~full_mask[size])
+		    if (!ResultKnown)
+			expr_warning(expr,
+				"overflow in unsigned constant expression");
+		o1 &= full_mask[size];
+	}
+	else {
+		int nbits = (int) (arith_size - size) * 8;
+		arith remainder = o1 & ~full_mask[size];
+
+		if (remainder != 0 && remainder != ~full_mask[size])
+		    if (!ResultKnown)
+			expr_warning(expr,"overflow in constant expression");
+		o1 = (o1 << nbits) >> nbits;		/* ??? */
+	}
+	expr->VL_VALUE = o1;
+}
+
+init_cst()
+{
+	register int i = 0;
+	register arith bt = (arith)0;
+
+	while (!(bt < 0))	{
+		bt = (bt << 8) + 0377, i++;
+		if (i == MAXSIZE)
+			fatal("array full_mask too small for this machine");
+		full_mask[i] = bt;
+	}
+	if ((int)long_size > arith_size)
+		fatal("sizeof (arith) insufficient on this machine");
+#ifndef NOCROSS
+	max_int = full_mask[(int)int_size] & ~(1L << ((int)int_size * 8 - 1));
+	max_unsigned = full_mask[(int)int_size];
+#endif /* NOCROSS */
+}

lang/cem/cemcom.ansi/dataflow.c

@@ -0,0 +1,37 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	DATAFLOW ANALYSIS ON C PROGRAMS	*/
+
+/*	Compile the C compiler with flag DATAFLOW.
+	Use the compiler option --d.
+*/
+
+#include	"dataflow.h"	/* UF */
+
+#ifdef	DATAFLOW
+char *CurrentFunction = 0;
+int NumberOfCalls;
+
+DfaStartFunction(nm)
+	char *nm;
+{
+	CurrentFunction = nm;
+	NumberOfCalls = 0;
+}
+
+DfaEndFunction()
+{
+	if (NumberOfCalls == 0)
+		print("DFA: %s: --none--\n", CurrentFunction);
+}
+
+DfaCallFunction(s)
+	char *s;
+{
+	print("DFA: %s: %s\n", CurrentFunction, s);
+	++NumberOfCalls;
+}
+#endif	/* DATAFLOW */

lang/cem/cemcom.ansi/declar.g

@@ -0,0 +1,767 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	DECLARATION SYNTAX PARSER	*/
+
+{
+#include	"lint.h"
+#include	"dbsymtab.h"
+#include	<alloc.h>
+#include	"nobitfield.h"
+#include	"debug.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"LLlex.h"
+#include	"label.h"
+#include	"code.h"
+#include	"idf.h"
+#include	"type.h"
+#include	"proto.h"
+#include	"struct.h"
+#include	"field.h"
+#include	"decspecs.h"
+#include	"def.h"
+#include	"declar.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"sizes.h"
+#include	"level.h"
+#ifdef	LINT
+#include	"l_lint.h"
+#endif	/* LINT */
+
+extern char	options[];
+}
+
+/* 3.5 */
+declaration
+	{struct decspecs Ds;}
+:
+	{Ds = null_decspecs;}
+	decl_specifiers(&Ds)
+	init_declarator_list(&Ds)?
+	';'
+;
+
+/*	A `decl_specifiers' describes a sequence of a storage_class_specifier,
+	an unsigned_specifier, a size_specifier and a simple type_specifier,
+	which may occur in arbitrary order and each of which may be absent;
+	at least one of them must be present, however, since the totally
+	empty case has already be dealt with in `external_definition'.
+	This means that something like:
+		unsigned extern int short xx;
+	is perfectly legal C.
+	
+	On top of that, multiple occurrences of storage_class_specifiers,
+	unsigned_specifiers and size_specifiers are errors, but a second
+	type_specifier should end the decl_specifiers and be treated as
+	the name to be declared.
+	Such a language is not easily expressed in a grammar; enumeration
+	of the permutations is unattractive. We solve the problem by
+	having a regular grammar for the "soft" items, handling the single
+	occurrence of the type_specifier in the grammar (we have no choice),
+	collecting all data in a `struct decspecs' and turning that data
+	structure into what we want.
+	
+	The existence of declarations like
+		short typedef yepp;
+	makes all hope of writing a specific grammar for typedefs illusory.
+*/
+/*      Accept a single declaration specifier.  Then accept zero or more
+	declaration specifiers.  There can be a conflict on both
+	TYPE_IDENTIFIER and IDENTIFIER.
+	The following rule is used:
+	When we see a TYPE_IDENTIFIER, we accept it if no type-specifier was
+	given, and it is not directly followed by an identifier.  If a
+	type-specifier was given, it is taken as the identifier being
+	declared.  If it is followed by an identifier, we assume that an
+	error has been  made, (e.g. unsigned typedeffed_int x;) and that
+	this will be detected later on.
+	When we see an IDENTIFIER, directly followed by another IDENTIFIER,
+	we assume that a typing mistake has been made, and we accept it as
+	an erroneous type-identifier.
+*/
+
+decl_specifiers	/* non-empty */ (register struct decspecs *ds;)
+	/*	Reads a non-empty decl_specifiers and fills the struct
+		decspecs *ds.
+	*/
+:
+	single_decl_specifier(ds)
+	[ %while(  (DOT==TYPE_IDENTIFIER
+			&& ds->ds_size == 0
+			&& ds->ds_unsigned == 0
+			&& ds->ds_type == (struct type *)0)
+		    || AHEAD == IDENTIFIER)	/* always an error */
+		single_decl_specifier(ds)
+	]*
+	{do_decspecs(ds);}
+;
+
+single_decl_specifier /* non_empty */ (register struct decspecs *ds;)
+:
+	[ AUTO | STATIC | EXTERN | TYPEDEF | REGISTER ]
+	{	if (ds->ds_sc_given)
+			error("repeated storage class specifier");
+		ds->ds_sc_given = 1;
+		ds->ds_sc = DOT;
+	}
+|
+	VOLATILE
+	{	if (ds->ds_typequal & TQ_VOLATILE)
+			error("repeated type qualifier");
+		ds->ds_typequal |= TQ_VOLATILE;
+	}
+|
+	CONST
+	{	if (ds->ds_typequal & TQ_CONST)
+			error("repeated type qualifier");
+		ds->ds_typequal |= TQ_CONST;
+	}
+|
+	[ SHORT | LONG ]
+	{	if (ds->ds_size)
+			error("repeated size specifier");
+		ds->ds_size = DOT;
+	}
+|
+	[ SIGNED | UNSIGNED ]
+	{	if (ds->ds_unsigned != 0)
+			error("repeated sign specifier");
+		ds->ds_unsigned = DOT;
+	}
+|
+	[ VOID | CHAR | INT | FLOAT | DOUBLE ]
+	{
+		idf2type(dot.tk_idf, &ds->ds_type);
+		ds->ds_typedef = 0;
+	}
+|
+	%default TYPE_IDENTIFIER
+	{
+		idf2type(dot.tk_idf, &ds->ds_type);
+		ds->ds_typedef = 1;
+	}
+|
+	%erroneous
+	IDENTIFIER
+	{
+		error("%s is not a type identifier", dot.tk_idf->id_text);
+		ds->ds_type = error_type;
+		if (dot.tk_idf->id_def) {
+			dot.tk_idf->id_def->df_type = error_type;
+			dot.tk_idf->id_def->df_sc = TYPEDEF;
+		}
+	}
+|
+	%illegal
+	IDENTIFIER
+|
+	struct_or_union_specifier(&ds->ds_type)
+|
+	enum_specifier(&ds->ds_type)
+;
+
+/* 3.5.2 */
+type_specifier(struct type **tpp;)
+	/*	Used in struct/union declarations and in casts; only the
+		type is relevant.
+	*/
+	{struct decspecs Ds; Ds = null_decspecs;}
+:
+	decl_specifiers(&Ds)
+	{
+		if (Ds.ds_sc_given)
+			error("storage class ignored");
+		if (Ds.ds_sc == REGISTER)
+			error("register ignored");
+	}
+	{*tpp = Ds.ds_type;}
+;
+
+/* 3.5 */
+init_declarator_list(struct decspecs *ds;):
+	init_declarator(ds)
+	[ ',' init_declarator(ds) ]*
+;
+
+init_declarator(register struct decspecs *ds;)
+	{
+		struct declarator Dc;
+	}
+:
+	{
+		Dc = null_declarator;
+	}
+[
+	declarator(&Dc)
+	{
+		reject_params(&Dc);
+		declare_idf(ds, &Dc, level);
+#ifdef	LINT
+		lint_declare_idf(Dc.dc_idf, ds->ds_sc);
+#endif	/* LINT */
+	}
+	[
+		initializer(Dc.dc_idf, ds->ds_sc)
+	|
+		{ code_declaration(Dc.dc_idf, (struct expr *) 0, level, ds->ds_sc); }
+	]
+]
+	{
+#ifdef	LINT
+		add_auto(Dc.dc_idf);
+#endif	/* LINT */
+		remove_declarator(&Dc);
+	}
+;
+
+/* 3.5.7: initializer */
+initializer(struct idf *idf; int sc;)
+	{
+		struct expr *expr = (struct expr *) 0;
+		int fund = idf->id_def->df_type->tp_fund;
+		int autoagg = (level >= L_LOCAL
+				&& sc != STATIC
+				&& ( fund == STRUCT
+				    || fund == UNION
+				    || fund == ARRAY));
+		int globalflag = level == L_GLOBAL
+				|| (level >= L_LOCAL && sc == STATIC);
+	}
+:
+	{	if (idf->id_def->df_type->tp_fund == FUNCTION)	{
+			error("illegal initialization of function");
+			idf->id_def->df_type->tp_fund = ERRONEOUS;
+		}
+		if (level == L_FORMAL2)
+			error("illegal initialization of formal parameter");
+	}
+	'='
+	{
+		if (AHEAD != '{' && AHEAD != STRING ) autoagg = 0;
+#ifdef	LINT
+		lint_statement();
+#endif	/* LINT */
+		if (globalflag) {
+			struct expr ex;
+			code_declaration(idf, &ex, level, sc);
+		}
+		else if (autoagg)
+			loc_init((struct expr *) 0, idf);
+	}
+	initial_value((globalflag || autoagg) ?
+				&(idf->id_def->df_type)
+				: (struct type **)0,
+			&expr)
+	{	if (! globalflag) {
+			if (idf->id_def->df_type->tp_fund == FUNCTION)	{
+				free_expression(expr);
+				expr = 0;
+			}
+#ifdef	DEBUG
+			print_expr("initializer-expression", expr);
+#endif	/* DEBUG */
+#ifdef	LINT
+			change_state(idf, SET);
+#endif	/* LINT */
+#ifdef	DBSYMTAB
+			if (options['g'] && level >= L_LOCAL && expr) {
+				db_line(expr->ex_file, (unsigned) expr->ex_line);
+			}
+#endif	/* DBSYMTAB */
+			if (autoagg)
+				loc_init((struct expr *) 0, idf);
+			else	code_declaration(idf, expr, level, sc);
+		}
+#ifdef	DBSYMTAB
+		if (options['g'] && globalflag) {
+			stb_string(idf->id_def, sc, idf->id_text);
+		}
+#endif	/* DBSYMTAB */
+		idf_initialized(idf);
+	}
+;
+
+/*
+	Functions yielding pointers to functions must be declared as, e.g.,
+		int (*hehe(par1, par2))() char *par1, *par2;	{}
+	Since the function heading is read as a normal declarator,
+	we just include the (formal) parameter list in the declarator
+	description list dc.
+*/
+/* 3.5.4 */
+declarator(register struct declarator *dc;)
+	{	struct formal *fm = NO_PARAMS;
+		struct proto *pl = NO_PROTO;
+		arith count;
+		int qual;
+	}
+:
+	primary_declarator(dc)
+	[/*%while(1)*/
+		'('
+		[ %if (DOT != IDENTIFIER)
+			parameter_type_list(&pl)
+		|
+			formal_list(&fm)
+		|
+			/* empty */
+		]
+		')'
+		{	add_decl_unary(dc, FUNCTION, 0, (arith)0, fm, pl);
+			fm = NO_PARAMS;
+		}
+	|
+		arrayer(&count)
+		{add_decl_unary(dc, ARRAY, 0, count, NO_PARAMS, NO_PROTO);}
+	]*
+|
+	pointer(&qual) declarator(dc)
+	{add_decl_unary(dc, POINTER, qual, (arith)0, NO_PARAMS, NO_PROTO);}
+;
+
+primary_declarator(register struct declarator *dc;) :
+	identifier(&dc->dc_idf)
+|
+	'(' declarator(dc) ')'
+;
+
+arrayer(arith *sizep;)
+	{ struct expr *expr; }
+:
+	'['
+		{ *sizep = (arith)-1; }
+		[
+			constant_expression(&expr)
+			{
+				check_array_subscript(expr);
+				*sizep = expr->VL_VALUE;
+				free_expression(expr);
+			}
+		]?
+	']'
+;
+
+formal_list (struct formal **fmp;)
+:
+	formal(fmp) [ %persistent ',' formal(fmp) ]*
+;
+
+formal(struct formal **fmp;)
+	{struct idf *idf;	}
+:
+	identifier(&idf)
+	{
+		register struct formal *new = new_formal();
+		
+		new->fm_idf = idf;
+		new->next = *fmp;
+		*fmp = new;
+		if (idf->id_def && idf->id_def->df_sc == TYPEDEF) {
+			error("typedef name %s may not be redeclared as a parameter", idf->id_text);
+		}
+	}
+;
+
+/* Change 2 */
+enum_specifier(register struct type **tpp;)
+	{
+		struct idf *idf;
+		arith l = (arith)0;
+	}
+:
+	{if (*tpp) error("multiple types in declaration");}
+	ENUM
+	[
+		{declare_struct(ENUM, (struct idf *) 0, tpp);}
+		enumerator_pack(*tpp, &l)
+	|
+		identifier(&idf)
+		[
+			{declare_struct(ENUM, idf, tpp);}
+			enumerator_pack(*tpp, &l)
+			{
+#ifdef DBSYMTAB
+				if (options['g']) {
+					stb_tag(idf->id_tag, idf->id_text);
+				}
+#endif /*DBSYMTAB */
+			}
+		|
+			{apply_struct(ENUM, idf, tpp);}
+			/* empty */
+		]
+	]
+;
+
+enumerator_pack(register struct type *tp; arith *lp;) :
+	'{'
+	enumerator(tp, lp)
+	[%while (AHEAD != '}')
+		','
+		enumerator(tp, lp)
+	]*
+	[
+		','	{warning("unexpected trailing comma in enumerator pack");}
+	]?
+	'}'
+	{tp->tp_size = int_size;}
+	/*	fancy implementations that put small enums in 1 byte
+		or so should start here.
+	*/
+;
+
+enumerator(struct type *tp; arith *lp;)
+	{
+		struct idf *idf;
+		struct expr *expr;
+	}
+:
+	identifier(&idf)
+	[
+		'='
+		constant_expression(&expr)
+		{
+			*lp = expr->VL_VALUE;
+			free_expression(expr);
+		}
+	]?
+	{declare_enum(tp, idf, (*lp)++);}
+;
+
+/* 8.5 */
+struct_or_union_specifier(register struct type **tpp;)
+	{
+		int fund;
+		struct idf *idfX;
+		register struct idf *idf;
+	}
+:
+	{if (*tpp) error("multiple types in declaration");}
+	[ STRUCT | UNION ]
+	{fund = DOT;}
+	[
+		{
+			declare_struct(fund, (struct idf *)0, tpp);
+		}
+		struct_declaration_pack(*tpp)
+	|
+		identifier(&idfX)	{ idf = idfX; }
+		[
+			{
+				declare_struct(fund, idf, tpp);
+				(idf->id_tag->tg_busy)++;
+			}
+			struct_declaration_pack(*tpp)
+			{
+				(idf->id_tag->tg_busy)--;
+#ifdef DBSYMTAB
+				if (options['g']) {
+					stb_tag(idf->id_tag, idf->id_text);
+				}
+#endif /*DBSYMTAB */
+			}
+		|
+			{
+			  /* a ';' means an empty declaration (probably)
+			   * this means that we have to declare a new
+			   * structure. (yegh)
+			   */
+			  if (DOT == ';' &&
+			      ( !idf->id_tag ||
+				 idf->id_tag->tg_level != level ||
+				 idf->id_tag->tg_type->tp_size < 0
+			     )) declare_struct(fund, idf, tpp);
+			  else apply_struct(fund, idf, tpp);
+			}
+			/* empty */
+		]
+	]
+;
+
+struct_declaration_pack(register struct type *stp;)
+	{
+		struct sdef **sdefp = &stp->tp_sdef;
+		arith size = (arith)0;
+	}
+:
+	/*	The size is only filled in after the whole struct has
+		been read, to prevent recursive definitions.
+	*/
+	'{'
+	struct_declaration(stp, &sdefp, &size)+
+	'}'
+	{stp->tp_size = align(size, stp->tp_align);
+	 completed(stp);
+	}
+;
+
+struct_declaration(struct type *stp; struct sdef ***sdefpp; arith *szp;)
+	{struct type *tp;}
+:
+	type_specifier(&tp) struct_declarator_list(tp, stp, sdefpp, szp) ';'
+;
+
+struct_declarator_list(struct type *tp; struct type *stp;
+			struct sdef ***sdefpp; arith *szp;)
+:
+	struct_declarator(tp, stp, sdefpp, szp)
+	[ ',' struct_declarator(tp, stp, sdefpp, szp) ]*
+;
+
+struct_declarator(struct type *tp; struct type *stp;
+			struct sdef ***sdefpp; arith *szp;)
+	{
+		struct declarator Dc;
+		struct field *fd = 0;
+	}
+:
+	{
+		Dc = null_declarator;
+	}
+[
+	declarator(&Dc)
+	{reject_params(&Dc);}
+	bit_expression(&fd)?
+|
+	{Dc.dc_idf = gen_idf();}
+	bit_expression(&fd)
+]
+	{add_sel(stp, declare_type(tp, &Dc), Dc.dc_idf, sdefpp, szp, fd);}
+	{remove_declarator(&Dc);}
+;
+
+bit_expression(struct field **fd;)
+	{ struct expr *expr; }
+:
+	{
+		*fd = new_field();
+	}
+	':'
+	constant_expression(&expr)
+	{
+		(*fd)->fd_width = expr->VL_VALUE;
+		free_expression(expr);
+#ifdef NOBITFIELD
+		error("bitfields are not implemented");
+#endif /* NOBITFIELD */
+	}
+;
+
+/* 8.7 */
+cast(struct type **tpp;)
+	{struct declarator Dc;}
+:
+	{Dc = null_declarator;}
+	'('
+	type_specifier(tpp)
+	abstract_declarator(&Dc)
+	')'
+	{*tpp = declare_type(*tpp, &Dc);}
+	{remove_declarator(&Dc);}
+;
+
+/*	This code is an abject copy of that of 'declarator', for lack of
+	a two-level grammar.
+*/
+abstract_declarator(register struct declarator *dc;)
+	{	struct proto *pl = NO_PROTO;
+		arith count;
+		int qual;
+	}
+:
+	primary_abstract_declarator(dc)
+	[
+		'('
+		[
+			parameter_type_list(&pl)
+		|
+			/* empty */
+		]
+		')'
+		{add_decl_unary(dc, FUNCTION, 0, (arith)0, NO_PARAMS, pl);
+		 if (pl) remove_proto_idfs(pl);
+		}
+	|
+		arrayer(&count)
+		{add_decl_unary(dc, ARRAY, 0, count, NO_PARAMS, NO_PROTO);}
+	]*
+|
+	pointer(&qual) abstract_declarator(dc)
+	{add_decl_unary(dc, POINTER, qual, (arith)0, NO_PARAMS, NO_PROTO);}
+;
+
+%first first_of_parameter_type_list, parameter_type_list;
+
+primary_abstract_declarator(struct declarator *dc;)
+:
+[%if (AHEAD == ')' || first_of_parameter_type_list(AHEAD))
+	/* empty */
+|
+	'(' abstract_declarator(dc) ')'
+]
+;
+
+parameter_type_list(struct proto **plp;)
+	{	int save_level; }
+:
+	{	if (level > L_PROTO) {
+			save_level = level;
+			level = L_PROTO;
+		} else level--;
+	}
+	parameter_decl_list(plp)
+	[
+		',' ELLIPSIS
+		{	register struct proto *new = new_proto();
+
+			new->next = *plp;
+			new->pl_flag = PL_ELLIPSIS;
+			*plp = new;
+		}
+
+	]?
+	{	check_for_void(*plp);
+		if (level == L_PROTO)
+			level = save_level;
+		else level++;
+	}
+;
+
+parameter_decl_list(struct proto **plp;)
+:
+	parameter_decl(plp)
+	[ %while (AHEAD != ELLIPSIS)
+	  %persistent
+		',' parameter_decl(plp)
+	]*
+;
+
+parameter_decl(struct proto **plp;)
+	{	register struct proto *new = new_proto();
+		struct declarator Dc;
+		struct decspecs Ds;
+	}
+:
+	{	Dc = null_declarator;
+		Ds = null_decspecs;
+	}
+	decl_specifiers(&Ds)
+	parameter_declarator(&Dc)
+	{	add_proto(new, &Ds, &Dc, level);
+		new->next = *plp;
+		*plp = new;
+		remove_declarator(&Dc);
+	}
+;
+
+/*	This is weird. Due to the LR structure of the ANSI C grammar
+	we have to duplicate the actions of 'declarator' and
+	'abstract_declarator'. Calling these separately, as in
+
+	parameter_decl:
+		decl_specifiers
+		[
+			declarator
+		|
+			abstract_declarator
+		]
+
+
+	gives us a conflict on the terminals '(' and '*'. E.i. on
+	some input, it is impossible to decide which rule we take.
+	Combining the two declarators into one common declarator
+	is out of the question, since this results in an empty
+	string for the non-terminal 'declarator'.
+	So we combine the two only for the use of parameter_decl,
+	since this is the only place where they don't give
+	conflicts. However, this makes the grammar messy.
+*/
+parameter_declarator(register struct declarator *dc;)
+	{	struct formal *fm = NO_PARAMS;
+		struct proto *pl = NO_PROTO;
+		arith count;
+		int qual;
+	}
+:
+	primary_parameter_declarator(dc)
+	[
+		'('
+		[ %if (DOT != IDENTIFIER)
+			parameter_type_list(&pl)
+		|
+			formal_list(&fm)
+		|
+			/* empty */
+		]
+		')'
+		{   add_decl_unary(dc, FUNCTION, 0, (arith)0, fm, pl);
+		    reject_params(dc);
+		}
+	|
+		arrayer(&count)
+		{add_decl_unary(dc, ARRAY, 0, count, NO_PARAMS, NO_PROTO);}
+	]*
+|
+	pointer(&qual) parameter_declarator(dc)
+	{add_decl_unary(dc, POINTER, qual, (arith)0, NO_PARAMS, NO_PROTO);}
+;
+
+primary_parameter_declarator(register struct declarator *dc;)
+:
+[%if (AHEAD == ')' || first_of_parameter_type_list(AHEAD)
+				    && (AHEAD != IDENTIFIER))
+	/* empty */
+|
+	identifier(&dc->dc_idf)
+|
+	'(' parameter_declarator(dc) ')'
+]
+;
+
+pointer(int *qual;)
+:
+	'*' type_qualifier_list(qual)
+;
+
+/*	Type qualifiers may come in three flavours:
+	volatile, const, const volatile.
+	These all have different semantic properties:
+
+	volatile:
+		means that the object can be modified
+		without prior knowledge of the implementation.
+
+	const:
+		means that the object can not be modified; thus
+		it's illegal to use this as a l-value.
+
+	const volatile:
+		means  that the object can be modified without
+		prior knowledge of the implementation, but may
+		not be used as a l-value.
+*/
+/* 3.5.4 */
+type_qualifier_list(int *qual;)
+:
+	{ *qual = 0; }
+	[
+		VOLATILE
+		{	if (*qual & TQ_VOLATILE)
+				error("repeated type qualifier");
+			*qual |= TQ_VOLATILE;
+		}
+	|
+		CONST
+		{	if (*qual & TQ_CONST)
+				error("repeated type qualifier");
+			*qual |= TQ_CONST;
+		}
+	]*
+;
+
+empty:
+;

lang/cem/cemcom.ansi/declar.str

@@ -0,0 +1,41 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* DEFINITION OF DECLARATOR DESCRIPTORS */
+
+/*	A 'declarator' consists of an idf and a linked list of
+	language-defined unary operations: *, [] and (), called
+	decl_unary's.
+*/
+
+struct declarator	{
+	/* struct declarator *next; */
+	struct idf *dc_idf;
+	struct decl_unary *dc_decl_unary;
+	struct formal *dc_formal;	/* params for function	*/
+};
+
+struct formal	{			/* list of formals */
+	struct formal *next;
+	struct idf *fm_idf;
+};
+
+/* ALLOCDEF "formal" 5 */
+
+
+#define	NO_PARAMS ((struct formal *) 0)
+
+struct decl_unary	{
+	struct decl_unary *next;
+	int du_fund;			/* POINTER, ARRAY or FUNCTION	*/
+	int du_typequal;		/* CONST, VOLATILE, or 0 */
+	arith du_count;			/* for ARRAYs only	*/
+	struct proto *du_proto;		/* params for function or prototype */
+};
+
+/* ALLOCDEF "decl_unary" 10 */
+
+extern struct type *declare_type();
+extern struct declarator null_declarator;

lang/cem/cemcom.ansi/declarator.c

@@ -0,0 +1,143 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	D E C L A R A T O R   M A N I P U L A T I O N		*/
+
+#include	"debug.h"
+#include	"botch_free.h"
+#include	<alloc.h>
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"type.h"
+#include	"proto.h"
+#include	"Lpars.h"
+#include	"declar.h"
+#include	"def.h"
+#include	"idf.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"sizes.h"
+#include	"level.h"
+
+extern char options[];
+struct declarator null_declarator;
+
+struct type *
+declare_type(tp, dc)
+	struct type *tp;
+	struct declarator *dc;
+{
+	/*	Applies the decl_unary list starting at dc->dc_decl_unary
+		to the type tp and returns the result.
+		Functions that are declared within a parameter type list
+		are purely prototypes. Simply add the type list to the
+		function node.
+	*/
+	register struct decl_unary *du = dc->dc_decl_unary;
+
+	while (du)	{
+		tp = construct_type(du->du_fund, tp, du->du_typequal,
+				    du->du_count, du->du_proto);
+		du = du->next;
+	}
+	return tp;
+}
+
+add_decl_unary(dc, fund, qual,  count, fm, pl)
+	register struct declarator *dc;
+	int qual;
+	arith count;
+	struct formal *fm;
+	struct proto *pl;
+{
+	/*	A decl_unary describing a constructor with fundamental
+		type fund and with size count is inserted in front of the
+		declarator dc.
+	*/
+	register struct decl_unary *new = new_decl_unary();
+
+	new->next = dc->dc_decl_unary;
+	new->du_fund = fund;
+	new->du_count = count;
+	new->du_typequal = qual;
+	new->du_proto = pl;
+	if (fm)	{
+		if (dc->dc_decl_unary)	{
+			/* parameters only allowed at first decl_unary	*/
+			error("formal parameters list discarded");
+		}
+		else	{
+			/* register the proto	*/
+			dc->dc_formal = fm;
+		}
+	}
+
+	dc->dc_decl_unary = new;
+}
+
+remove_declarator(dc)
+	struct declarator *dc;
+{
+	/*	The decl_unary list starting at dc->dc_decl_unary is
+		removed.
+	*/
+	register struct decl_unary *du = dc->dc_decl_unary;
+
+	while (du)	{
+		struct decl_unary *old_du = du;
+
+		du = du->next;
+		free_decl_unary(old_du);
+	}
+}
+
+reject_params(dc)
+	register struct declarator *dc;
+{
+	/*	The declarator is checked to have no parameters, if it
+		is an old-style function.  If it is a new-style function,
+		the identifiers are removed.  The function is not called in
+		case of a function definition.
+	*/
+	register struct decl_unary *du = dc->dc_decl_unary;
+	int	err_given = 0;
+
+	if (dc->dc_formal)	{
+		error("non_empty formal parameter pack");
+		free_formals(dc->dc_formal);
+		dc->dc_formal = 0;
+		err_given = 1;
+	}
+	while (du) {
+		if (du->du_fund == FUNCTION) {
+			if (du->du_proto) remove_proto_idfs(du->du_proto);
+			else if (! err_given && ! options['o']) {
+				err_given = 1;
+				warning("old-fashioned function declaration");
+			}
+		}
+		du = du->next;
+	}
+}
+
+check_array_subscript(expr)
+	register struct expr *expr;
+{
+	arith size = expr->VL_VALUE;
+
+	if (size < 0)	{
+		error("array size is negative");
+		expr->VL_VALUE = (arith)1;
+	}
+	else
+	if (size == 0) {
+		strict("array size is 0");
+	}
+	else
+	if (size & ~max_unsigned) {	/* absolutely ridiculous */
+		expr_error(expr, "overflow in array size");
+		expr->VL_VALUE = (arith)1;
+	}
+}

lang/cem/cemcom.ansi/decspecs.c

@@ -0,0 +1,168 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	D E C L A R A T I O N   S P E C I F I E R   C H E C K I N G	*/
+
+#include	"assert.h"
+#include	"Lpars.h"
+#include	"decspecs.h"
+#include	"arith.h"
+#include	"type.h"
+#include	"level.h"
+#include	"def.h"
+
+extern char options[];
+extern int level;
+extern char *symbol2str();
+extern struct type *qualifier_type();
+
+struct decspecs null_decspecs;
+
+do_decspecs(ds)
+	register struct decspecs *ds;
+{
+	/*	The provisional decspecs ds as obtained from the program
+		is turned into a legal consistent decspecs.
+	*/
+	register struct type *tp = ds->ds_type;
+	
+	ASSERT(level != L_FORMAL1);
+	
+	if (	level == L_GLOBAL &&
+		(ds->ds_sc == AUTO || ds->ds_sc == REGISTER)
+	)	{
+		error("no global %s variable allowed",
+			symbol2str(ds->ds_sc));
+		ds->ds_sc = GLOBAL;
+	}
+
+	if (level == L_FORMAL2)	{
+		if (ds->ds_sc_given &&
+		    ds->ds_sc != REGISTER){
+			error("%s formal illegal", symbol2str(ds->ds_sc));
+			ds->ds_sc = FORMAL;
+		}
+	}
+
+	/*	Since type qualifiers may be associated with types by means
+		of typedefs, we have to perform same basic tests down here.
+	*/
+	if (tp != (struct type *)0) {
+		if ((ds->ds_typequal & TQ_VOLATILE) && (tp->tp_typequal & TQ_VOLATILE))
+			error("indirect repeated type qualifier");
+		if ((ds->ds_typequal & TQ_CONST) && (tp->tp_typequal & TQ_CONST))
+			error("indirect repeated type qualifier");
+		ds->ds_typequal |= tp->tp_typequal;
+	}
+
+	/*	The tests concerning types require a full knowledge of the
+		type and will have to be postponed to declare_idf.
+	*/
+
+	/* some adjustments as described in 3.5.2. */
+	if (tp == 0) {
+		ds->ds_notypegiven = 1;
+		tp = int_type;
+	}
+	if (ds->ds_size) {
+		register int ds_isshort = (ds->ds_size == SHORT);
+
+		if (ds->ds_typedef) goto SIZE_ERROR;		/* yes */
+		if (tp == int_type) {
+			if (ds_isshort) tp = short_type;
+			else tp = long_type;
+		} else if (tp == double_type && !ds_isshort ) {
+			tp = lngdbl_type;
+		} else {
+	SIZE_ERROR:
+			error("%s with illegal type",symbol2str(ds->ds_size));
+		}
+		ds->ds_notypegiven = 0;
+	}
+	if (ds->ds_unsigned) {
+		register int ds_isunsigned = (ds->ds_unsigned == UNSIGNED);
+
+		if (ds->ds_typedef) goto SIGN_ERROR;		/* yes */
+		/*
+		 * All integral types are signed by default (char too),
+		 * so the case that ds->ds_unsigned == SIGNED can be ignored.
+		 */
+		if (tp == schar_type) {
+			if (ds_isunsigned) tp = uchar_type;
+		} else if (tp == short_type) {
+			if (ds_isunsigned) tp = ushort_type;
+		} else if (tp == int_type) {
+			if (ds_isunsigned) tp = uint_type;
+		} else if (tp == long_type) {
+			if (ds_isunsigned) tp = ulong_type;
+		} else {
+	SIGN_ERROR:
+			error("%s with illegal type"
+				, symbol2str(ds->ds_unsigned));
+		}
+		ds->ds_notypegiven = 0;
+	}
+	ds->ds_type = qualifier_type(tp, ds->ds_typequal);
+}
+
+/*	Make tp into a qualified type. This is not as trivial as it
+	may seem. If tp is a fundamental type the qualified type is
+	either existent or will be generated.
+	In case of a complex type the top of the type list will be
+	replaced by a qualified version.
+*/
+struct type *
+qualifier_type(tp, typequal)
+	register struct type *tp;
+	int typequal;
+{
+	register struct type *dtp = tp;
+	register int fund = tp->tp_fund;
+
+	while (dtp && dtp->tp_typequal != typequal)
+		dtp = dtp->next;
+
+	if (!dtp) {
+		dtp = create_type(fund);
+		dtp->tp_unsigned = tp->tp_unsigned;
+		dtp->tp_align = tp->tp_align;
+		dtp->tp_typequal = typequal;
+		dtp->tp_size = tp->tp_size;
+#if 0
+/* The tp_function field does not exist now. See the comment in the
+   function_of() routine.
+*/
+		dtp->tp_function = tp->tp_function;
+#endif
+		switch (fund) {
+		case ARRAY:
+			if (typequal) {
+			    tp->tp_up = qualifier_type(tp->tp_up, typequal);
+			    dtp->tp_typequal = typequal = 0;
+			}
+			goto nottagged;
+		case FIELD:
+			dtp->tp_field = tp->tp_field;
+			/* fallthrough */
+		case POINTER:
+		case FUNCTION:			/* dont't assign tp_proto */
+		nottagged:
+			dtp->tp_up = tp->tp_up;
+			break;
+		case STRUCT:
+		case UNION:
+		case ENUM:
+			dtp->tp_idf = tp->tp_idf;
+			dtp->tp_sdef = tp->tp_sdef;
+			break;
+		default:
+			break;
+		}
+		dtp->next = tp->next; /* don't know head or tail */
+		tp->next = dtp;
+	}
+	return(dtp);
+}
+

lang/cem/cemcom.ansi/decspecs.h

@@ -0,0 +1,21 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* DECLARATION SPECIFIER DEFINITION */
+
+struct decspecs	{
+	struct decspecs *next;
+	struct type *ds_type;	/* single type */
+	int ds_notypegiven;	/* set if type not given explicitly */
+	int ds_typedef;		/* 1 if type was a user typedef */
+	int ds_sc_given;	/* 1 if the st. class is explicitly given */
+	int ds_sc;		/* storage class, given or implied */
+	int ds_size;		/* LONG, SHORT or 0 */
+	int ds_unsigned;	/* SIGNED, UNSIGNED or 0 */
+	int ds_typequal;	/* type qualifiers - see type.str */
+};
+
+extern struct type *qualifier_type();
+extern struct decspecs null_decspecs;

lang/cem/cemcom.ansi/decspecs.str

@@ -0,0 +1,21 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Header$ */
+/* DECLARATION SPECIFIER DEFINITION */
+
+struct decspecs	{
+	struct decspecs *next;
+	struct type *ds_type;	/* single type */
+	int ds_notypegiven;	/* set if type not given explicitly */
+	int ds_typedef;		/* 1 if type was a user typedef */
+	int ds_sc_given;	/* 1 if the st. class is explicitly given */
+	int ds_sc;		/* storage class, given or implied */
+	int ds_size;		/* LONG, SHORT or 0 */
+	int ds_unsigned;	/* SIGNED, UNSIGNED or 0 */
+	int ds_typequal;	/* type qualifiers - see type.str */
+};
+
+extern struct type *qualifier_type();
+extern struct decspecs null_decspecs;

lang/cem/cemcom.ansi/def.str

@@ -0,0 +1,40 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* IDENTIFIER DEFINITION DESCRIPTOR */
+
+#include	"lint.h"
+
+struct def	{		/* for ordinary tags */
+	struct def *next;
+	int df_level;
+	struct type *df_type;
+	int df_sc;		/*	may be:
+					GLOBAL, STATIC, EXTERN,
+					TYPEDEF,
+					FORMAL, AUTO,
+					ENUM, LABEL
+				*/
+	char df_initialized;	/* an initialization has been generated */
+	char df_alloc;		/* 0, ALLOC_SEEN or ALLOC_DONE */
+	char df_used;		/* set if idf is used */
+	char df_formal_array;	/* to warn if sizeof is taken */
+	char *df_file;		/* file containing the definition */
+	unsigned int df_line;	/* line number of the definition */
+#ifdef	LINT
+	char df_set;
+	int df_firstbrace;	/* brace number of its first occurrence */
+	int df_minlevel;	/* the lowest level needed for this def */
+#endif	/* LINT */
+	arith df_address;
+};
+
+#define	ALLOC_SEEN	1	/* an allocating declaration has been seen */
+#define	ALLOC_DONE	2	/* the allocating declaration has been done */
+
+#define REG_DEFAULT	0	/* register candidate, not declared as such */
+#define REG_BONUS	10	/* register candidate, declared as such */
+
+/* ALLOCDEF "def" 50 */

lang/cem/cemcom.ansi/domacro.c

@@ -0,0 +1,863 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* PREPROCESSOR: CONTROLLINE INTERPRETER */
+
+#include	"debug.h"
+#include	"arith.h"
+#include	"LLlex.h"
+#include	"Lpars.h"
+#include	"idf.h"
+#include	"input.h"
+#include	"nopp.h"
+#include	"lint.h"
+
+#ifndef NOPP
+#include	"ifdepth.h"
+#include	"botch_free.h"
+#include	"nparams.h"
+#include	"parbufsize.h"
+#include	"textsize.h"
+#include	"idfsize.h"	
+#include	"assert.h"
+#include	<alloc.h>
+#include	"class.h"
+#include	"macro.h"
+#include	"macbuf.h"
+#include	"replace.h"
+#include	"dbsymtab.h"
+#ifdef DBSYMTAB
+#include	<stb.h>
+#include	<em.h>
+int		IncludeLevel = 0;
+#endif
+
+extern char options[];
+extern	char **inctable;	/* list of include directories		*/
+extern	char *getwdir();
+char ifstack[IFDEPTH];	/* if-stack: the content of an entry is	*/
+				/* 1 if a corresponding ELSE has been	*/
+				/* encountered.				*/
+
+int	nestlevel = -1;
+
+struct idf *
+GetIdentifier(skiponerr)
+	int skiponerr;		/* skip the rest of the line on error */
+{
+	/*	returns a pointer to the descriptor of the identifier that is
+		read from the input stream. When the input doe not contain
+		an identifier, the rest of the line is skipped when
+		skiponerr is on, and a null-pointer is returned.
+		The substitution of macros is disabled.
+	*/
+	int tmp = UnknownIdIsZero;
+	int tok;
+	struct token tk;
+
+	UnknownIdIsZero = ReplaceMacros = 0;
+	tok = GetToken(&tk);
+	ReplaceMacros = 1;
+	UnknownIdIsZero = tmp;
+	if (tok != IDENTIFIER) {
+		if (skiponerr && tok != EOI) SkipToNewLine();
+		return (struct idf *)0;
+	}
+	return tk.tk_idf;
+}
+
+/*	domacro() is the control line interpreter. The '#' has already
+	been read by the lexical analyzer by which domacro() is called.
+	The token appearing directly after the '#' is obtained by calling
+	the basic lexical analyzing function GetToken() and is interpreted
+	to perform the action belonging to that token.
+	An error message is produced when the token is not recognized,
+	i.e. it is not one of "define" .. "undef" , integer or newline.
+*/
+domacro()
+{
+	struct token tk;	/* the token itself			*/
+	int toknum;
+
+	EoiForNewline = 1;
+	ReplaceMacros = 0;
+	toknum = GetToken(&tk);
+	ReplaceMacros = 1;
+	switch(toknum) {		/* select control line action	*/
+	case IDENTIFIER:		/* is it a macro keyword?	*/
+		switch (tk.tk_idf->id_resmac) {
+		case K_DEFINE:				/* "define"	*/
+			do_define();
+			break;
+		case K_ELIF:				/* "elif"	*/
+			do_elif();
+			break;
+		case K_ELSE:				/* "else"	*/
+			do_else();
+			break;
+		case K_ENDIF:				/* "endif"	*/
+			do_endif();
+			break;
+		case K_IF:				/* "if"		*/
+			do_if();
+			break;
+		case K_IFDEF:				/* "ifdef"	*/
+			do_ifdef(1);
+			break;
+		case K_IFNDEF:				/* "ifndef"	*/
+			do_ifdef(0);
+			break;
+		case K_INCLUDE:				/* "include"	*/
+			do_include();
+			break;
+		case K_LINE:				/* "line"	*/
+			/*	set LineNumber and FileName according to
+				the arguments.
+			*/
+			if (GetToken(&tk) != INTEGER) {
+				lexerror("bad #line syntax");
+				SkipToNewLine();
+			}
+			else
+				do_line((unsigned int)tk.tk_ival);
+			break;
+		case K_ERROR:				/* "error"	*/
+			do_error();
+			break;
+		case K_PRAGMA:				/* "pragma"	*/
+			do_pragma();
+			break;
+		case K_UNDEF:				/* "undef"	*/
+			do_undef((struct idf *) 0);
+			break;
+		default:
+			/* invalid word seen after the '#'	*/
+			lexerror("%s: unknown control", tk.tk_idf->id_text);
+			SkipToNewLine();
+		}
+		break;
+	case INTEGER:		/* # <integer> [<filespecifier>]?	*/
+		do_line((unsigned int)tk.tk_ival);
+		break;
+	case EOI:	/* only `#' on this line: do nothing, ignore	*/
+		break;
+	default:	/* invalid token following '#'		*/
+		lexerror("illegal # line");
+		SkipToNewLine();
+	}
+	EoiForNewline = 0;
+}
+
+#ifdef LINT
+int lint_skip_comment;
+#endif
+
+skip_block(to_endif)
+int to_endif;
+{
+	/*	skip_block() skips the input from
+		1)	a false #if, #ifdef, #ifndef or #elif until the
+			corresponding #elif (resulting in true), #else or
+			#endif is read.
+		2)	a #else corresponding to a true #if, #ifdef,
+			#ifndef or #elif until the corresponding #endif is
+			seen.
+	*/
+	register int ch;
+	register int skiplevel = nestlevel; /* current nesting level	*/
+	struct token tk;
+	int toknum;
+
+#ifdef LINT
+	lint_skip_comment++;
+#endif
+	NoUnstack++;
+	for (;;) {
+		ch = GetChar();	/* read first character after newline	*/
+		while (class(ch) == STSKIP)
+			ch = GetChar();
+		if (ch != '#') {
+			if (ch == EOI) {
+				NoUnstack--;
+#ifdef LINT
+				lint_skip_comment--;
+#endif
+				return;
+			}
+			/* A possible '/' is not pushed back */
+			if (ch == '/') {
+				ch = GetChar();
+				if (ch != '*') UnGetChar();
+				else {
+					skipcomment();
+					continue;
+				}
+			} else UnGetChar();
+			SkipToNewLine();
+			continue;
+		}
+		ReplaceMacros = 0;
+		toknum = GetToken(&tk);
+		ReplaceMacros = 1;
+		if (toknum != IDENTIFIER) {
+			if (toknum != INTEGER) {
+				lexerror("illegal # line");
+			}
+			SkipToNewLine();
+			continue;
+		}
+		/*	an IDENTIFIER: look for #if, #ifdef and #ifndef
+			without interpreting them.
+			Interpret #else, #elif and #endif if they occur
+			on the same level.
+		*/
+		switch(tk.tk_idf->id_resmac) {
+		default:
+		case K_UNKNOWN:
+			/* invalid word seen after the '#'      */
+			lexwarning("%s: unknown control", tk.tk_idf->id_text);
+			/* fallthrough */
+		case K_DEFINE:
+		case K_ERROR:
+		case K_INCLUDE:
+		case K_LINE:
+		case K_PRAGMA:
+		case K_UNDEF:
+		case K_FILE:
+			SkipToNewLine();
+			break;
+		case K_IF:
+		case K_IFDEF:
+		case K_IFNDEF:
+			push_if();
+			SkipToNewLine();
+			break;
+		case K_ELIF:
+			if (ifstack[nestlevel])
+				lexerror("#elif after #else");
+			if (!to_endif && nestlevel == skiplevel) {
+				nestlevel--;
+				push_if();
+				if (ifexpr()) {
+					NoUnstack--;
+#ifdef LINT
+					lint_skip_comment--;
+#endif
+					return;
+				}
+			}
+			else SkipToNewLine();	/* otherwise done in ifexpr() */
+			break;
+		case K_ELSE:
+			if (ifstack[nestlevel])
+				lexerror("#else after #else");
+			++(ifstack[nestlevel]);
+			if (!to_endif && nestlevel == skiplevel) {
+				if (SkipToNewLine()) {
+					if (!options['o'])
+						lexstrict("garbage following #else");
+				}
+				NoUnstack--;
+#ifdef LINT
+				lint_skip_comment--;
+#endif
+				return;
+			}
+			else SkipToNewLine();
+			break;
+		case K_ENDIF:
+			ASSERT(nestlevel > nestlow);
+			if (nestlevel == skiplevel) {
+				if (SkipToNewLine()) {
+					if (!options['o'])
+						lexstrict("garbage following #endif");
+				}
+				nestlevel--;
+				NoUnstack--;
+#ifdef LINT
+				lint_skip_comment--;
+#endif
+				return;
+			}
+			else SkipToNewLine();
+			nestlevel--;
+			break;
+		}
+	}
+}
+
+
+ifexpr()
+{
+	/*	ifexpr() returns whether the restricted constant
+		expression following #if or #elif evaluates to true.  This
+		is done by calling the LLgen generated subparser for
+		constant expressions.  The result of this expression will
+		be given in the extern long variable "ifval".
+	*/
+	extern arith ifval;
+	int errors = err_occurred;
+
+	ifval = (arith)0;
+	AccDefined = 1;
+	UnknownIdIsZero = 1;
+	PushLex();	/* NEW parser */
+	If_expr();	/* invoke constant expression parser	*/
+	PopLex();	/* OLD parser */
+	AccDefined = 0;
+	UnknownIdIsZero = 0;
+	return (errors == err_occurred) && (ifval != (arith)0);
+}
+
+do_include()
+{
+	/*	do_include() performs the inclusion of a file.
+	*/
+	char *filenm;
+	char *result;
+	int tok;
+	struct token tk;
+
+	AccFileSpecifier = 1;
+	if (((tok = GetToken(&tk)) == FILESPECIFIER) || tok == STRING)
+		filenm = tk.tk_bts;
+	else {
+		lexerror("bad include syntax");
+		filenm = (char *)0;
+	}
+	AccFileSpecifier = 0;
+	if (SkipToNewLine()) {
+		lexerror("bad include syntax");
+	}
+	inctable[0] = WorkingDir;
+	if (filenm) {
+		if (!InsertFile(filenm, &inctable[tok==FILESPECIFIER],&result)){
+			lexerror("cannot open include file \"%s\"", filenm);
+			add_dependency(filenm);
+			free(filenm);
+		}
+		else {
+			add_dependency(result);
+			WorkingDir = getwdir(result);
+			File_Inserted = 1;
+			FileName = result;
+			LineNumber = 0;
+			nestlow = nestlevel;
+#ifdef DBSYMTAB
+			IncludeLevel++;
+			if (options['g']) {
+				C_ms_stb_cst(FileName, N_BINCL, 0, (arith) 0);
+			}
+#endif /* DBSYMTAB */
+			if (result != filenm) free(filenm);
+		}
+	}
+}
+
+do_define()
+{
+	/*	do_define() interprets a #define control line.
+	*/
+	struct idf *id;		/* the #defined identifier's descriptor	*/
+	int nformals = -1;	/* keep track of the number of formals	*/
+	char *formals[NPARAMS];	/* pointers to the names of the formals	*/
+	char parbuf[PARBUFSIZE];		/* names of formals	*/
+	char *repl_text;	/* start of the replacement text	*/
+	int length;		/* length of the replacement text	*/
+	register ch;
+	char *get_text();
+
+	/* read the #defined macro's name	*/
+	if (!(id = GetIdentifier(1))) {
+		lexerror("illegal #define line");
+		return;
+	}
+	/*	there is a formal parameter list if the identifier is
+		followed immediately by a '('.
+	*/
+	ch = GetChar();
+	if (ch == '(') {
+		if ((nformals = getparams(formals, parbuf)) == -1) {
+			SkipToNewLine();
+			return;	/* an error occurred	*/
+		}
+		ch = GetChar();
+	}
+	/* read the replacement text if there is any			*/
+	ch = skipspaces(ch,0);	/* find first character of the text	*/
+	ASSERT(ch != EOI);
+	/* UnGetChar() is not right when replacement starts with a '/' */
+	ChPushBack(ch);
+	repl_text = get_text((nformals > 0) ? formals : 0, &length);
+	macro_def(id, repl_text, nformals, length, NOFLAG);
+	LineNumber++;
+}
+
+push_if()
+{
+	if (nestlevel >= IFDEPTH)
+		fatal("too many nested #if/#ifdef/#ifndef");
+	else
+		ifstack[++nestlevel] = 0;
+}
+
+do_elif()
+{
+	if (nestlevel <= nestlow) {
+		lexerror("#elif without corresponding #if");
+		SkipToNewLine();
+	}
+	else {		/* restart at this level as if a #if is detected.  */
+		if (ifstack[nestlevel]) {
+			lexerror("#elif after #else");
+			SkipToNewLine();
+		}
+		nestlevel--;
+		push_if();
+		skip_block(1);
+	}
+}
+
+do_else()
+{
+	if (SkipToNewLine())
+		if (!options['o'])
+			lexstrict("garbage following #else");
+	if (nestlevel <= nestlow)
+		lexerror("#else without corresponding #if");
+	else {	/* mark this level as else-d */
+		if (ifstack[nestlevel]) {
+			lexerror("#else after #else");
+		}
+		++(ifstack[nestlevel]);
+		skip_block(1);
+	}
+}
+
+do_endif()
+{
+	if (SkipToNewLine()) {
+		if (!options['o'])
+			lexstrict("garbage following #endif");
+	}
+	if (nestlevel <= nestlow)	{
+		lexerror("#endif without corresponding #if");
+	}
+	else	nestlevel--;
+}
+
+do_if()
+{
+	push_if();
+	if (!ifexpr())	/* a false #if/#elif expression */
+		skip_block(0);
+}
+
+do_ifdef(how)
+{
+	register struct idf *id;
+
+	/*	how == 1 : ifdef; how == 0 : ifndef
+	*/
+	push_if();
+	if (!(id = GetIdentifier(1)))
+		lexerror("illegal #ifdef construction");
+	else if (SkipToNewLine())
+		if (!options['o'])
+			lexstrict("garbage following #%s <identifier>",
+				  how ? "ifdef" : "ifndef");
+
+	/* The next test is a shorthand for:
+		(how && !id->id_macro) || (!how && id->id_macro)
+	*/
+	if (how ^ (id && id->id_macro != 0))
+		skip_block(0);
+}
+
+/* argidf != NULL when the undef came from a -U option */
+do_undef(argidf)
+	struct idf *argidf;
+{
+	register struct idf *id = argidf;
+
+	/* Forget a macro definition.	*/
+	if (id || (id = GetIdentifier(1))) {
+		if (id->id_macro) { /* forget the macro */
+			if (id->id_macro->mc_flag & NOUNDEF) {
+				lexerror("it is not allowed to undef %s", id->id_text);
+			} else {
+				free(id->id_macro->mc_text);
+				free_macro(id->id_macro);
+				id->id_macro = (struct macro *) 0;
+			}
+		} /* else: don't complain */
+		if (!argidf) {
+			if (SkipToNewLine())
+				if (!options['o'])
+					lexstrict("garbage following #undef");
+		}
+	}
+	else
+		lexerror("illegal #undef construction");
+}
+
+do_error()
+{
+	int len;
+	char *get_text();
+	char *bp = get_text((char **) 0, &len);
+
+	lexerror("user error: %s", bp);
+	free(bp);
+	LineNumber++;
+}
+
+int
+getparams(buf, parbuf)
+	char *buf[];
+	char parbuf[];
+{
+	/*	getparams() reads the formal parameter list of a macro
+		definition.
+		The number of parameters is returned.
+		As a formal parameter list is expected when calling this
+		routine, -1 is returned if an error is detected, for
+		example:
+			#define one(1), where 1 is not an identifier.
+		Note that the '(' has already been eaten.
+		The names of the formal parameters are stored into parbuf.
+	*/
+	register char **pbuf = &buf[0];
+	register int c;
+	register char *ptr = &parbuf[0];
+	register char **pbuf2;
+
+	c = GetChar();
+	c = skipspaces(c,0);
+	if (c == ')') {		/* no parameters: #define name()	*/
+		*pbuf = (char *) 0;
+		return 0;
+	}
+	for (;;) {		/* eat the formal parameter list	*/
+		if (class(c) != STIDF && class(c) != STELL) {
+			lexerror("#define: bad formal parameter");
+			return -1;
+		}
+		*pbuf = ptr;	/* name of the formal	*/
+		*ptr++ = c;
+		if (ptr >= &parbuf[PARBUFSIZE])
+			fatal("formal parameter buffer overflow");
+		do {			/* eat the identifier name	*/
+			c = GetChar();
+			*ptr++ = c;
+			if (ptr >= &parbuf[PARBUFSIZE])
+				fatal("formal parameter buffer overflow");
+		} while (in_idf(c));
+		*(ptr - 1) = '\0';	/* mark end of the name		*/
+
+		/*	Check if this formal parameter is already used.
+			Usually, macros do not have many parameters, so ...
+		*/
+		for (pbuf2 = pbuf - 1; pbuf2 >= &buf[0]; pbuf2--) {
+			if (!strcmp(*pbuf2, *pbuf)) {
+				lexerror("formal parameter \"%s\" already used",
+					*pbuf);
+			}
+		}
+
+		pbuf++;
+		c = skipspaces(c,0);
+		if (c == ')') {	/* end of the formal parameter list	*/
+			*pbuf = (char *) 0;
+			return pbuf - buf;
+		}
+		if (c != ',') {
+			lexerror("#define: bad formal parameter list");
+			return -1;
+		}
+		c = GetChar();
+		c = skipspaces(c,0);
+	}
+	/*NOTREACHED*/
+}
+
+macro_def(id, text, nformals, length, flags)
+	register struct idf *id;
+	char *text;
+{
+	register struct macro *newdef = id->id_macro;
+
+	/*	macro_def() puts the contents and information of a macro
+		definition into a structure and stores it into the symbol
+		table entry belonging to the name of the macro.
+		An error is given if there was already a definition
+	*/
+	if (newdef) {		/* is there a redefinition?	*/
+		if (newdef->mc_flag & NOUNDEF) {
+			lexerror("it is not allowed to redefine %s", id->id_text);
+		} else if (!macroeq(newdef->mc_text, text))
+			lexerror("illegal redefine of \"%s\"", id->id_text);
+		free(text);
+		return;
+	}
+	id->id_macro = newdef = new_macro();
+	newdef->mc_text = text;		/* replacement text	*/
+	newdef->mc_nps  = nformals;	/* nr of formals	*/
+	newdef->mc_length = length;	/* length of repl. text	*/
+	newdef->mc_flag = flags;	/* special flags	*/
+}
+
+int
+find_name(nm, index)
+	char *nm, *index[];
+{
+	/*	find_name() returns the index of "nm" in the namelist
+		"index" if it can be found there. 0 is returned if it is
+		not there.
+	*/
+	register char **ip = &index[0];
+
+	while (*ip)
+		if (strcmp(nm, *ip++) == 0)
+			return ip - &index[0];
+	/* arrived here, nm is not in the name list.	*/
+	return 0;
+}
+
+#define	BLANK(ch)	((ch == ' ') || (ch == '\t'))
+
+char *
+get_text(formals, length)
+	char *formals[];
+	int *length;
+{
+	/*	get_text() copies the replacement text of a macro
+		definition with zero, one or more parameters, thereby
+		substituting each formal parameter by a special character
+		(non-ascii: 0200 & (order-number in the formal parameter
+		list)) in order to substitute this character later by the
+		actual parameter. The replacement text is copied into
+		itself because the copied text will contain fewer or the
+		same amount of characters. The length of the replacement
+		text is returned.
+
+		Implementation:
+		finite automaton : we are interested in
+		1-  white space, sequences must be mapped onto 1 single
+		    blank.
+		2-  identifiers, since they might be replaced by some
+		    actual parameter.
+		3-  strings and character constants, since replacing
+		    variables within them is illegal, and white-space is
+		    significant.
+		4-  comment, same as for 1
+		Other tokens will not be seen as such.
+	*/
+	register int c;
+	struct repl repls;
+	register struct repl *repl = &repls;
+	int blank = 0;
+
+	c = GetChar();
+
+	repl->r_ptr = repl->r_text = Malloc(repl->r_size = ITEXTSIZE);
+	*repl->r_ptr = '\0';
+	while ((c != EOI) && (class(c) != STNL)) {
+		if (BLANK(c)) {
+			blank++;
+			c = GetChar();
+			continue;
+		}
+
+		if (c == '\'' || c == '"') {
+			register int delim = c;
+
+			if (blank) {
+				blank = 0;
+				add2repl(repl, ' ');
+			}
+			do {
+			    add2repl(repl, c);
+			    if (c == '\\') add2repl(repl, GetChar());
+			    c = GetChar();
+			} while (c != delim && c != EOI && class(c) != STNL);
+			if (c == EOI || class(c) == STNL) {
+				lexstrict("unclosed opening %c", delim);
+				break;
+			}
+			add2repl(repl, c);
+			c = GetChar();
+		} else if (c == '/') {
+			c = GetChar();
+			if (c == '*') {
+				skipcomment();
+				blank++;
+				c = GetChar();
+				continue;
+			} 
+			if (blank) {
+				blank = 0;
+				add2repl(repl, ' ');
+			}
+			add2repl(repl, '/');
+		} else if (formals
+			    && (class(c) == STIDF || class(c) == STELL)) {
+			char id_buf[IDFSIZE + 1];
+			register char *idp = id_buf;
+			int n;
+
+			/* read identifier: it may be a formal parameter */
+			*idp++ = c;
+			do {
+				c = GetChar();
+				if (idp <= &id_buf[IDFSIZE])
+					*idp++ = c;
+			} while (in_idf(c));
+			*--idp = '\0';
+
+			if (blank) {
+				blank = 0;
+				add2repl(repl, ' ');
+			}
+			/* construct the formal parameter mark or identifier */
+			if (n = find_name(id_buf, formals))
+			    add2repl(repl, FORMALP | (char) n);
+			else {
+			    idp = id_buf;
+			    while (*idp) add2repl(repl, *idp++);
+			}
+		} else if (class(c) == STNUM) {
+			if (blank) {
+				blank = 0;
+				add2repl(repl, ' ');
+			}
+			add2repl(repl, c);
+			if (c == '.') {
+				c = GetChar();
+				if (class(c) != STNUM) {
+					continue;
+				}
+				add2repl(repl, c);
+			}
+			c = GetChar();
+			while(in_idf(c) || c == '.') {
+				add2repl(repl, c);
+				if((c = GetChar()) == 'e' || c == 'E') {
+					add2repl(repl, c);
+					c = GetChar();
+					if (c == '+' || c == '-') {
+						add2repl(repl, c);
+						c = GetChar();
+					}
+				}
+			}
+		} else {
+			if (blank) {
+				blank = 0;
+				add2repl(repl, ' ');
+			}
+			add2repl(repl, c);
+			c = GetChar();
+		}
+	}
+	*length = repl->r_ptr - repl->r_text;
+	return Realloc(repl->r_text, (unsigned)(repl->r_ptr - repl->r_text +1));
+}
+
+/*	macroeq() decides whether two macro replacement texts are
+	identical.  This version compares the texts, which occur
+	as strings, without taking care of the leading and trailing
+	blanks (spaces and tabs).
+*/
+macroeq(s, t)
+	register char *s, *t;
+{
+
+	/* skip leading spaces	*/
+	while (BLANK(*s)) s++;
+	while (BLANK(*t)) t++;
+	/* first non-blank encountered in both strings	*/
+	/* The actual comparison loop:			*/
+	while (*s && *s == *t)
+		s++, t++;
+	/* two cases are possible when arrived here:	*/
+	if (*s == '\0')	{	/* *s == '\0'		*/
+		while (BLANK(*t)) t++;
+		return *t == '\0';
+	}
+	else	{		/* *s != *t		*/
+		while (BLANK(*s)) s++;
+		while (BLANK(*t)) t++;
+		return (*s == '\0') && (*t == '\0');
+	}
+}
+#else /* NOPP */
+
+struct idf *
+GetIdentifier(skiponerr)
+	int skiponerr;		/* skip the rest of the line on error */
+{
+	/*	returns a pointer to the descriptor of the identifier that is
+		read from the input stream. When the input does not contain
+		an identifier, the rest of the line is skipped when
+		skiponerr is on, and a null-pointer is returned.
+		The substitution of macros is disabled.
+	*/
+	int tok;
+	struct token tk;
+
+	tok = GetToken(&tk);
+	if (tok != IDENTIFIER) {
+		if (skiponerr && tok != EOI) SkipToNewLine();
+		return (struct idf *)0;
+	}
+	return tk.tk_idf;
+}
+
+domacro()
+{
+	int tok;
+	struct token tk;
+
+	EoiForNewline = 1;
+	if ((tok = GetToken(&tk)) == IDENTIFIER) {
+		if (! strcmp(tk.tk_idf->id_text, "pragma")) {
+			do_pragma();
+			EoiForNewline = 0;
+			return;
+		}
+	} else if (tok == INTEGER) {
+		do_line((unsigned int) tk.tk_ival);
+		EoiForNewline = 0;
+		return;
+	}
+	lexerror("illegal # line");
+	EoiForNewline = 0;
+	SkipToNewLine();
+}
+#endif /* NOPP */
+
+
+do_line(l)
+	unsigned int l;
+{
+	struct token tk;
+	int t = GetToken(&tk);
+
+	if (t != EOI) SkipToNewLine();
+	LineNumber = l;		/* the number of the next input line */
+	if (t == STRING) {	/* is there a filespecifier? */
+		/*
+		 * Do not attempt to free the old string, since it might
+		 * be used in a def structure.
+		 */
+#ifdef DBSYMTAB
+		if (options['g'] && strcmp(FileName, tk.tk_bts) != 0) {
+			C_ms_std(tk.tk_bts, N_SOL, 0);
+		}
+#endif /* DBSYMTAB */
+		FileName = tk.tk_bts;
+	}
+}

lang/cem/cemcom.ansi/dumpidf.c

@@ -0,0 +1,503 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	DUMP ROUTINES	*/
+
+#include	"debug.h"
+
+#ifdef	DEBUG
+#include	<alloc.h>
+#include	"nopp.h"
+#include	"nobitfield.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"stack.h"
+#include	"idf.h"
+#include	"def.h"
+#include	"type.h"
+#include	"proto.h"
+#include	"struct.h"
+#include	"field.h"
+#include	"Lpars.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"static.h"
+#include	"declar.h"
+
+/*	Some routines (symbol2str, type2str, qual2str) which should have
+ *	yielded strings are written to yield a pointer to a transient piece
+ *	of memory, containing the string, since this is the only reasonable
+ *	thing to do in C. `Transient' means that the result may soon
+ *	disappear, which is generally not a problem, since normally it is
+ *	consumed immediately. Sometimes we need more than one of them, and
+ *	MAXTRANS is the maximum number we will need simultaneously.
+ */
+#define	MAXTRANS	6
+
+extern char options[];
+
+extern char *sprint();
+
+extern struct idf *idf_hashtable[];
+extern char *symbol2str(), *type2str(), *qual2str(), *next_transient();
+
+enum sdef_kind {selector, field};		/* parameter for dumpsdefs */
+
+static int dumplevel;
+
+newline()	{
+	register int dl = dumplevel;
+	
+	print("\n");
+	while (dl >= 2)	{
+		print("\t");
+		dl -= 2;
+	}
+	if (dl)
+		print("    ");
+}
+
+int	dumpidf();
+
+dumpidftab(msg, opt)
+	char msg[];
+{
+	/*	Dumps the identifier table in readable form (but in
+		arbitrary order).
+		Unless opt & 1, macros are not dumped.
+		Unless opt & 2, reserved identifiers are not dumped.
+		Unless opt & 4, universal identifiers are not dumped.
+	*/
+
+	print(">>> DUMPIDF, %s (start)", msg);
+	dumpstack();
+	idfappfun(dumpidf, opt);
+	newline();
+	print(">>> DUMPIDF, %s (end)\n", msg);
+}
+
+dumpstack()
+{
+	/*	Dumps the identifier stack, starting at the top.
+	*/
+	register struct stack_level *stl = local_level;
+	
+	while (stl)	{
+		register struct stack_entry *se = stl->sl_entry;
+		
+		newline();
+		print("%3d: ", stl->sl_level);
+		while (se)	{
+			print("%s ", se->se_idf->id_text);
+			se = se->next;
+		}
+		stl = stl->sl_previous;
+	}
+	print("\n");
+}
+
+dumpidf(idf, opt)
+	register struct idf *idf;
+{
+	/*	All information about the identifier idf is divulged in a
+		hopefully readable format.
+	*/
+	int started = 0;
+	
+	if (!idf)
+		return;
+#ifndef NOPP
+	if ((opt&1) && idf->id_macro)	{
+		if (!started++)	{
+			newline();
+			print("%s:", idf->id_text);
+		}
+		print(" macro");
+	}
+#endif /* NOPP */
+	if ((opt&2) && idf->id_reserved)	{
+		if (!started++)	{
+			newline();
+			print("%s:", idf->id_text);
+		}
+		print(" reserved: %d;", idf->id_reserved);
+	}
+	if (idf->id_def && ((opt&4) || idf->id_def->df_level))	{
+		if (!started++)	{
+			newline();
+			print("%s:", idf->id_text);
+		}
+		dumpdefs(idf->id_def, opt);
+	}
+	if (idf->id_sdef)	{
+		if (!started++)	{
+			newline();
+			print("%s:", idf->id_text);
+		}
+		dumpsdefs(idf->id_sdef, selector);
+	}
+	if (idf->id_tag)	{
+		if (!started++)	{
+			newline();
+			print("%s:", idf->id_text);
+		}
+		dumptags(idf->id_tag);
+	}
+}
+
+dumpdefs(def, opt)
+	register struct def *def;
+{
+	dumplevel++;
+	while (def && ((opt&4) || def->df_level))	{
+		newline();
+		print("L%d: %s %s%stype%s %lo; ",
+			def->df_level,
+			symbol2str(def->df_sc),
+			def->df_initialized ? "init'd " : "",
+			def->df_used ? "used " : "",
+			def->df_sc == ENUM ? ", =" : " at",
+			def->df_address
+		);
+		print("%s, line %u",
+			def->df_file ? def->df_file : "NO_FILE", def->df_line);
+		dumptype(def->df_type);
+		def = def->next;
+	}
+	dumplevel--;
+}
+
+dumptags(tag)
+	register struct tag *tag;
+{
+	dumplevel++;
+	while (tag)	{
+		register struct type *tp = tag->tg_type;
+		register int fund = tp->tp_fund;
+
+		newline();
+		print("L%d: %s %s",
+			tag->tg_level,
+			fund == STRUCT ? "struct" :
+			fund == UNION ? "union" :
+			fund == ENUM ? "enum" : "<UNKNOWN>",
+			tp->tp_idf->id_text
+		);
+		if (is_struct_or_union(fund))	{
+			print(" {");
+			dumpsdefs(tp->tp_sdef, field);
+			newline();
+			print("}");
+		}
+		print(";");
+		tag = tag->next;
+	}
+	dumplevel--;
+}
+
+dumpsdefs(sdef, sdk)
+	register struct sdef *sdef;
+	enum sdef_kind sdk;
+{
+	/*	Since sdef's are members of two chains, there are actually
+		two dumpsdefs's, one following the chain of all selectors
+		belonging to the same idf, starting at idf->id_sdef;
+		and the other following the chain of all selectors belonging
+		to the same struct, starting at stp->tp_sdef.
+	*/
+
+	dumplevel++;
+	while (sdef)	{
+		newline();
+		print("L%d: ", sdef->sd_level);
+#ifndef NOBITFIELD
+		if (sdk == selector)
+#endif /* NOBITFIELD */
+			print("selector %s at offset %lu in %s;",
+				type2str(sdef->sd_type),
+				sdef->sd_offset, type2str(sdef->sd_stype)
+			);
+#ifndef NOBITFIELD
+		else	print("field %s at offset %lu;",
+				type2str(sdef->sd_type), sdef->sd_offset
+			);
+#endif /* NOBITFIELD */
+		sdef = (sdk == selector ? sdef->next : sdef->sd_sdef);
+	}
+	dumplevel--;
+}
+
+dumpproto(pl)
+	register struct proto *pl;
+{
+	register struct type *type;
+	register int argcnt = 0;
+
+	newline();
+	print("dump proto type list (start)");
+	newline();
+	while (pl) {
+		print("%d: %s", argcnt++,
+			pl->pl_flag & PL_FORMAL ?
+			(pl->pl_flag & PL_VOID ? "void" : "formal")
+			: (pl->pl_flag & PL_ELLIPSIS
+				? "ellipsis" : "unknown" ));
+		newline();
+		if (type = pl->pl_type){
+			dumptype(type);
+			newline();
+		}
+		if (pl->pl_idf) {
+			dumplevel++;
+			print("idf:");
+			dumpidf(pl->pl_idf, 7);
+			dumplevel--;
+		}
+		newline();
+		pl = pl->next;
+	}
+	print("dump proto type list (end)\n");
+}
+
+dumptype(tp)
+	register struct type *tp;
+{
+	int ops = 1;
+
+	dumplevel++;
+	newline();
+	if (!tp) {
+		print("<NILTYPE>");
+		newline();
+		dumplevel--;
+		return;
+	}
+
+	print("(@%lx, #%ld, &%d) ", tp, (long)tp->tp_size, tp->tp_align);
+
+	while (ops)	{
+		print("%s", qual2str(tp->tp_typequal));
+		switch (tp->tp_fund)	{
+		case POINTER:
+			print("pointer to ");
+			break;
+		case ARRAY:
+			print("array [%ld] of ", tp->tp_size);
+			break;
+		case FUNCTION:
+			print("function ");
+			if (tp->tp_proto) {
+				print("with prototype");
+				dumplevel++;
+				dumpproto(tp->tp_proto);
+				dumplevel--;
+				newline();
+			}
+			print("yielding ");
+			break;
+		default:
+			print("%s%s ", tp->tp_unsigned ? "unsigned " : "",
+				       symbol2str(tp->tp_fund));
+			if (tp->tp_idf)
+				print("%s ", tp->tp_idf->id_text);
+#ifndef NOBITFIELD
+			if (tp->tp_fund == FIELD && tp->tp_field)	{
+				struct field *fd = tp->tp_field;
+				
+				print("[s=%ld,w=%ld] of ",
+					fd->fd_shift, fd->fd_width);
+			}
+			else
+#endif /* NOBITFIELD */
+			ops = 0;
+			break;
+		}
+		if (ops) tp = tp->tp_up;
+	}
+	dumplevel--;
+}
+
+char *
+type2str(tp)
+	register struct type *tp;
+{
+	/*	Yields a pointer to a one-line description of the type tp.
+	*/
+	char *buf = next_transient();
+	int ops = 1;
+
+	buf[0] = '\0';
+	if (!tp)	{
+		sprint(buf, "<NILTYPE>");
+		return buf;
+	}
+	sprint(buf, "%s(@%lx, #%ld, &%d) ",
+			buf, tp, (long)tp->tp_size, tp->tp_align);
+
+	while (ops)	{
+		sprint(buf, "%s%s", buf, qual2str(tp->tp_typequal));
+		switch (tp->tp_fund)	{
+		case POINTER:
+			sprint(buf, "%spointer to ", buf);
+			break;
+		case ARRAY:
+			sprint(buf, "%sarray [%ld] of ", buf, tp->tp_size);
+			break;
+		case FUNCTION:
+			sprint(buf, "%sfunction yielding ", buf);
+			break;
+		default:
+			sprint(buf, "%s%s%s ", buf,
+					tp->tp_unsigned ? "unsigned " : "",
+					symbol2str(tp->tp_fund)
+			);
+			if (tp->tp_idf)
+				sprint(buf, "%s %s ", buf,
+					tp->tp_idf->id_text);
+#ifndef NOBITFIELD
+			if (tp->tp_fund == FIELD && tp->tp_field)	{
+				struct field *fd = tp->tp_field;
+				
+				sprint(buf, "%s [s=%ld,w=%ld] of ", buf,
+					fd->fd_shift, fd->fd_width);
+			}
+			else
+#endif /* NOBITFIELD */
+			ops = 0;
+			break;
+		}
+		if (ops) tp = tp->tp_up;
+	}
+	return buf;
+}
+
+char *
+qual2str(qual)
+	int qual;
+{
+	char *buf = next_transient();
+
+	*buf = '\0';
+	if (qual == 0)
+		sprint(buf, "(none)");
+	if (qual & TQ_CONST)
+		sprint(buf, "%sconst ", buf);
+	if (qual & TQ_VOLATILE)
+		sprint(buf, "%svolatile ", buf);
+
+	return qual == 0 ? "" : buf;
+}
+
+GSTATIC char trans_buf[MAXTRANS][300];
+
+char *		/* the ultimate transient buffer supplier */
+next_transient()
+{
+	static int bnum;
+
+	if (++bnum == MAXTRANS)
+		bnum = 0;
+	return trans_buf[bnum];
+}
+
+print_expr(msg, expr)
+	char msg[];
+	struct expr *expr;
+{
+	/*	Provisional routine to print an expression preceded by a
+		message msg.
+	*/
+	if (options['x'])	{
+		print("\n%s: ", msg);
+		print("(L=line, T=type, r/lV=r/lvalue, F=flags, D=depth)\n");
+		p1_expr(0, expr);
+	}
+}
+
+p1_expr(lvl, expr)
+	register struct expr *expr;
+{
+	p1_indent(lvl);
+	if (!expr)	{
+		print("NILEXPR\n");
+		return;
+	}
+	print("expr: L=%u, T=%s, %cV, F=%03o, D=%d, %s: ",
+		expr->ex_line,
+		type2str(expr->ex_type),
+		expr->ex_lvalue ? 'l' : 'r',
+		expr->ex_flags & 0xFF,
+		expr->ex_depth,
+		expr->ex_class == Value ? "Value" :
+		expr->ex_class == String ? "String" :
+		expr->ex_class == Float ? "Float" :
+		expr->ex_class == Oper ? "Oper" :
+		expr->ex_class == Type ? "Type" : "UNKNOWN CLASS"
+	);
+	switch (expr->ex_class)	{
+		struct oper *o;
+	case Value:
+		switch (expr->VL_CLASS) {
+		case Const:
+			print("(Const) ");
+			break;
+		case Name:
+			print("(Name) %s + ", expr->VL_IDF->id_text);
+			break;
+		case Label:
+			print("(Label) .%lu + ", expr->VL_LBL);
+			break;
+		default:
+			print("(Unknown) ");
+			break;
+		}
+		print(expr->ex_type->tp_unsigned ? "%lu\n" : "%ld\n",
+			expr->VL_VALUE);
+		break;
+	case String:
+	{
+		char *bts2str();
+
+		print(
+			"\"%s\"\n",
+			bts2str(expr->SG_VALUE, expr->SG_LEN-1,
+							next_transient())
+		);
+		break;
+	}
+	case Float:
+	{
+		char buf[FLT_STRLEN];
+
+		flt_flt2str(&(expr->FL_ARITH), buf, FLT_STRLEN);
+		print("%s\n", buf);
+		break;
+	}
+	case Oper:
+		o = &expr->ex_object.ex_oper;
+		print("\n");
+		p1_expr(lvl+1, o->op_left);
+		p1_indent(lvl);
+		print("%s <%s>\n", symbol2str(o->op_oper),
+			type2str(o->op_type)
+		);
+		p1_expr(lvl+1, o->op_right);
+		break;
+	case Type:
+		print("\n");
+		break;
+	default:
+		print("UNKNOWN CLASS\n");
+		break;
+	}
+}
+
+p1_indent(lvl)
+	register int lvl;
+{
+	while (lvl--)
+		print("  ");
+}
+#endif	/* DEBUG */

lang/cem/cemcom.ansi/error.c

@@ -0,0 +1,627 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	E R R O R   A N D  D I A G N O S T I C   R O U T I N E S	*/
+
+#include	"lint.h"
+#if __STDC__
+#include	<stdarg.h>
+#else
+#include	<varargs.h>
+#endif
+#include	<system.h>
+#ifndef	LINT
+#include	<em.h>
+#else
+#include	"l_em.h"
+#endif	/* LINT */
+
+#include	"debug.h"
+#include	"lint.h"
+#include	"nopp.h"
+#include	"errout.h"
+
+#include	"tokenname.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"def.h"
+#include	"LLlex.h"
+
+/*	This file contains the error-message and diagnostic
+	functions.  Beware, they are called with a variable number of
+	arguments!
+*/
+
+/* error classes */
+#define	STRICT		1
+#define	WARNING		2
+#define	ERROR		3
+#define	CRASH		4
+#define	FATAL		5
+#define DO_DEBUG	6
+
+int err_occurred = 0;
+
+extern char options[];
+#ifdef	LINT
+extern char loptions[];
+#endif	/* LINT */
+
+/*	There are three general error-message functions:
+		lexerror()	lexical and pre-processor error messages
+		error()		syntactic and semantic error messages
+		expr_error()	errors in expressions
+	The difference lies in the place where the file name and line
+	number come from.
+	Lexical errors report from the global variables LineNumber and
+	FileName, expression errors get their information from the
+	expression, whereas other errors use the information in the token.
+*/
+
+static _error();
+
+#if __STDC__
+/*VARARGS*/
+error(char *fmt, ...)
+{
+	va_list ap;
+
+	va_start(ap, fmt);
+	{
+		_error(ERROR, dot.tk_file, dot.tk_line, fmt, ap);
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+expr_error(struct expr *expr, char *fmt, ...)
+{
+	va_list ap;
+
+	va_start(ap, fmt);
+	{
+		if (!(expr->ex_flags & EX_ERROR)) {
+			/* to prevent proliferation */
+			_error(ERROR, expr->ex_file, expr->ex_line, fmt, ap);
+			expr->ex_flags |= EX_ERROR;
+		}
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+lexstrict(char *fmt, ...)
+{
+	va_list ap;
+
+	va_start(ap, fmt);
+	{
+		_error(STRICT, FileName, LineNumber, fmt, ap);
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+strict(char *fmt, ...)
+{
+	va_list ap;
+
+	va_start(ap, fmt);
+	{
+		_error(STRICT, dot.tk_file, dot.tk_line, fmt, ap);
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+expr_strict(struct expr *expr, char *fmt, ...)
+{
+	va_list ap;
+
+	va_start(ap, fmt);
+	{
+		if (!(expr->ex_flags & EX_ERROR)) {
+			/* to prevent proliferation */
+			_error(STRICT, expr->ex_file, expr->ex_line, fmt, ap);
+		}
+	}
+	va_end(ap);
+}
+
+#ifdef DEBUG
+/*VARARGS*/
+debug(char *fmt, ...)
+{
+	va_list ap;
+
+	va_start(ap, fmt);
+	{
+		_error(DO_DEBUG, dot.tk_file, dot.tk_line, fmt, ap);
+	}
+	va_end(ap);
+}
+#endif /* DEBUG */
+
+/*VARARGS*/
+warning(char *fmt, ...)
+{
+	va_list ap;
+
+	va_start(ap, fmt);
+	{
+		_error(WARNING, dot.tk_file, dot.tk_line, fmt, ap);
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+expr_warning(struct expr *expr, char *fmt, ...)
+{
+	va_list ap;
+
+	va_start(ap, fmt);
+	{
+		if (!(expr->ex_flags & EX_ERROR)) {
+			/* to prevent proliferation */
+			_error(WARNING, expr->ex_file, expr->ex_line, fmt, ap);
+		}
+	}
+	va_end(ap);
+}
+
+#ifdef	LINT
+
+/*VARARGS*/
+def_warning(struct def *def, char *fmt, ...)
+{
+	va_list ap;
+
+	va_start(ap, fmt);
+	{
+		_error(WARNING, def->df_file, def->df_line, fmt, ap);
+	}
+	va_end(ap);
+}
+
+
+/*VARARGS*/
+hwarning(char *fmt, ...)
+{
+	va_list ap;
+
+	va_start(ap, fmt);
+	{
+		if (loptions['h'])
+			_error(WARNING, dot.tk_file, dot.tk_line, fmt, ap);
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+awarning(char *fmt, ...)
+{
+	va_list ap;
+
+	va_start(ap, fmt);
+	{
+		if (loptions['a'])
+			_error(WARNING, dot.tk_file, dot.tk_line, fmt, ap);
+	}
+	va_end(ap);
+}
+
+#endif	/* LINT */
+
+/*VARARGS*/
+lexerror(char *fmt, ...)
+{
+	va_list ap;
+
+	va_start(ap, fmt);
+	{
+		_error(ERROR, FileName, LineNumber, fmt, ap);
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+lexwarning(char *fmt, ...)
+{
+	va_list ap;
+
+	va_start(ap, fmt);
+	{
+		_error(WARNING, FileName, LineNumber, fmt, ap);
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+crash(char *fmt, ...)
+{
+	va_list ap;
+
+	va_start(ap, fmt);
+	{
+		_error(CRASH, FileName, LineNumber, fmt, ap);
+	}
+	va_end(ap);
+
+	C_close();
+#ifdef	DEBUG
+	sys_stop(S_ABORT);
+#else	/* DEBUG */
+	sys_stop(S_EXIT);
+#endif	/* DEBUG */
+	/* NOTREACHED */
+}
+
+/*VARARGS*/
+fatal(char *fmt, ...)
+{
+	va_list ap;
+
+	va_start(ap, fmt);
+	{
+		_error(FATAL, FileName, LineNumber, fmt, ap);
+	}
+	va_end(ap);
+
+	if (C_busy()) C_close();
+	sys_stop(S_EXIT);
+	/*NOTREACHED*/
+}
+#else
+/*VARARGS*/
+error(va_alist)				/* fmt, args */
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		char *fmt = va_arg(ap, char *);
+		_error(ERROR, dot.tk_file, dot.tk_line, fmt, ap);
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+expr_error(va_alist)			/* expr, fmt, args */
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		register struct expr *expr = va_arg(ap, struct expr *);
+		char *fmt = va_arg(ap, char *);
+
+		if (!(expr->ex_flags & EX_ERROR)) {
+			/* to prevent proliferation */
+			_error(ERROR, expr->ex_file, expr->ex_line, fmt, ap);
+			expr->ex_flags |= EX_ERROR;
+		}
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+lexstrict(va_alist)
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		char *fmt = va_arg(ap, char *);
+		_error(STRICT, FileName, LineNumber, fmt, ap);
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+strict(va_alist)
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		char *fmt = va_arg(ap, char *);
+		_error(STRICT, dot.tk_file, dot.tk_line, fmt, ap);
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+expr_strict(va_alist)			/* expr, fmt, args */
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		struct expr *expr = va_arg(ap, struct expr *);
+		char *fmt = va_arg(ap, char *);
+
+		if (!(expr->ex_flags & EX_ERROR)) {
+			/* to prevent proliferation */
+			_error(STRICT, expr->ex_file, expr->ex_line, fmt, ap);
+		}
+	}
+	va_end(ap);
+}
+
+#ifdef DEBUG
+/*VARARGS*/
+debug(va_alist)
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		char *fmt = va_arg(ap, char *);
+		_error(DO_DEBUG, dot.tk_file, dot.tk_line, fmt, ap);
+	}
+	va_end(ap);
+}
+#endif /* DEBUG */
+
+/*VARARGS*/
+warning(va_alist)
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		char *fmt = va_arg(ap, char *);
+		_error(WARNING, dot.tk_file, dot.tk_line, fmt, ap);
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+expr_warning(va_alist)			/* expr, fmt, args */
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		struct expr *expr = va_arg(ap, struct expr *);
+		char *fmt = va_arg(ap, char *);
+
+		if (!(expr->ex_flags & EX_ERROR)) {
+			/* to prevent proliferation */
+			_error(WARNING, expr->ex_file, expr->ex_line, fmt, ap);
+		}
+	}
+	va_end(ap);
+}
+
+#ifdef	LINT
+
+/*VARARGS*/
+def_warning(va_alist)			/* def, fmt, args */
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		register struct def *def = va_arg(ap, struct def *);
+		char *fmt = va_arg(ap, char *);
+
+		_error(WARNING, def->df_file, def->df_line, fmt, ap);
+	}
+	va_end(ap);
+}
+
+
+/*VARARGS*/
+hwarning(va_alist)			/* fmt, args */
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		char *fmt = va_arg(ap, char *);
+		if (loptions['h'])
+			_error(WARNING, dot.tk_file, dot.tk_line, fmt, ap);
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+awarning(va_alist)			/* fmt, args */
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		char *fmt = va_arg(ap, char *);
+		if (loptions['a'])
+			_error(WARNING, dot.tk_file, dot.tk_line, fmt, ap);
+	}
+	va_end(ap);
+}
+
+#endif	/* LINT */
+
+/*VARARGS*/
+lexerror(va_alist)			/* fmt, args */
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		char *fmt = va_arg(ap, char *);
+		_error(ERROR, FileName, LineNumber, fmt, ap);
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+lexwarning(va_alist)			/* fmt, args */
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		char *fmt = va_arg(ap, char *);
+		_error(WARNING, FileName, LineNumber, fmt, ap);
+	}
+	va_end(ap);
+}
+
+/*VARARGS*/
+crash(va_alist)				/* fmt, args */
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		char *fmt = va_arg(ap, char *);
+		_error(CRASH, FileName, LineNumber, fmt, ap);
+	}
+	va_end(ap);
+
+	C_close();
+#ifdef	DEBUG
+	sys_stop(S_ABORT);
+#else	/* DEBUG */
+	sys_stop(S_EXIT);
+#endif	/* DEBUG */
+	/* NOTREACHED */
+}
+
+/*VARARGS*/
+fatal(va_alist)				/* fmt, args */
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		char *fmt = va_arg(ap, char *);
+		_error(FATAL, FileName, LineNumber, fmt, ap);
+	}
+	va_end(ap);
+
+	if (C_busy()) C_close();
+	sys_stop(S_EXIT);
+	/*NOTREACHED*/
+}
+#endif
+
+static
+_error(class, fn, ln, fmt, ap)
+	int class;
+	char *fn;
+	unsigned int ln;
+	char *fmt;
+	va_list ap;
+{
+	char *remark;
+	
+	/* check visibility of message */
+	switch (class)	{
+	case WARNING:
+	case ERROR:
+	case STRICT:
+		if (token_nmb < tk_nmb_at_last_syn_err + ERR_SHADOW)
+			/* warning or error message overshadowed */
+			return;
+		break;
+	}
+
+	/*	Since name and number are gathered from different places
+		depending on the class, we first collect the relevant
+		values and then decide what to print.
+	*/
+	/* preliminaries */
+	switch (class)	{
+	case WARNING:
+		if (options['w'])
+			return;
+		break;
+
+	case STRICT:
+		if (options['s'])
+			return;
+		break;
+
+	case ERROR:
+	case CRASH:
+	case FATAL:
+		if (C_busy())
+			C_ms_err();
+		err_occurred = 1;
+		break;
+	}
+
+	/* the remark */
+	switch (class)	{	
+	case STRICT:
+		remark = "(strict)";
+		break;
+	case WARNING:
+#ifndef	LINT
+		remark = "(warning)";
+#else	/* LINT */
+		remark = 0;
+#endif	/* LINT */
+		break;
+
+	case ERROR:
+		remark = 0;
+		break;
+
+	case CRASH:
+		remark = "CRASH\007";
+		break;
+
+	case FATAL:
+		remark = "fatal error --";
+		break;
+#ifdef DEBUG
+	case DO_DEBUG:
+		remark = "(debug)";
+		break;
+#endif /* DEBUG */
+	default:
+		/*NOTREACHED*/;
+	}
+	
+#ifdef	LINT
+	if (	/* there is a file name */
+		fn
+	&&	/* the file name is global */
+		fn[0] == '/'
+	&&	/* it is not a .c file */
+		strcmp(&fn[strlen(fn)-2], ".c") != 0
+	) {
+		/* we skip this message */
+		return;
+	}
+#endif	/* LINT */
+	
+	if (fn)
+		fprint(ERROUT, "\"%s\", line %u: ", fn, ln);
+	if (remark)
+		fprint(ERROUT, "%s ", remark);
+	doprnt(ERROUT, fmt, ap);		/* contents of error */
+	fprint(ERROUT, "\n");
+}

lang/cem/cemcom.ansi/estack.str

@@ -0,0 +1,21 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* EXPRESSION STACK */
+/* Used for global initializations */
+struct e_stack {
+	struct e_stack	*next;
+	arith		s_cnt1, s_cnt2;
+	struct sdef 	*s_def;
+	struct type 	**s_tpp;
+	short 		s_nested;
+};
+
+/* ALLOCDEF "e_stack" 5 */
+
+#define bytes_upto_here	s_cnt1
+#define last_offset	s_cnt2
+#define elem_count	s_cnt1
+#define nelem		s_cnt2

lang/cem/cemcom.ansi/expr.c

@@ -0,0 +1,502 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* EXPRESSION TREE HANDLING */
+
+#include	"lint.h"
+#include	"debug.h"
+#include	"assert.h"
+#include	"botch_free.h"
+#include	<alloc.h>
+#include	"idf.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"def.h"
+#include	"type.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"LLlex.h"
+#include	"Lpars.h"
+#include	"decspecs.h"
+#include	"declar.h"
+#include	"sizes.h"
+#include	"level.h"
+#include	"use_tmp.h"
+
+extern char *symbol2str();
+extern char options[];
+extern int InSizeof;
+
+int
+rank_of(oper)
+	int oper;
+{
+	/*	The rank of the operator oper is returned.
+	*/
+	switch (oper)	{
+	default:
+		return 0;			/* INT2INT etc. */
+	case '[':
+	case '(':
+	case '.':
+	case ARROW:
+	case PARCOMMA:
+		return 1;
+	case '!':
+	case PLUSPLUS:
+	case MINMIN:
+	case CAST:
+	case SIZEOF:
+	case ADDRESSOF:
+		return 2;			/* monadic */
+	case '*':
+	case '/':
+	case '%':
+		return 3;
+	case '+':
+	case '-':
+		return 4;
+	case LEFT:
+	case RIGHT:
+		return 5;
+	case '<':
+	case '>':
+	case LESSEQ:
+	case GREATEREQ:
+		return 6;
+	case EQUAL:
+	case NOTEQUAL:
+		return 7;
+	case '&':
+		return 8;
+	case '^':
+		return 9;
+	case '|':
+		return 10;
+	case AND:
+		return 11;
+	case OR:
+		return 12;
+	case '?':
+	case ':':
+		return 13;
+	case '=':
+	case PLUSAB:
+	case MINAB:
+	case TIMESAB:
+	case DIVAB:
+	case MODAB:
+	case RIGHTAB:
+	case LEFTAB:
+	case ANDAB:
+	case XORAB:
+	case ORAB:
+		return 14;
+	case ',':
+		return 15;
+	}
+	/*NOTREACHED*/
+}
+
+dot2expr(expp)
+	struct expr **expp;
+{
+	/*	The token in dot is converted into an expression, a
+		pointer to which is stored in *expp.
+	*/
+	register struct expr *ex = new_expr();
+
+	*expp = ex;
+	ex->ex_file = dot.tk_file;
+	ex->ex_line = dot.tk_line;
+	switch (DOT)	{
+	case IDENTIFIER:
+		idf2expr(ex);
+		break;
+	case INTEGER:
+		int2expr(ex);
+		break;
+	case FLOATING:
+		float2expr(ex);
+		break;
+	default:
+		crash("bad conversion to expression");
+		/*NOTREACHED*/
+	}
+}
+
+idf2expr(expr)
+	register struct expr *expr;
+{
+	/*	Dot contains an identifier which is turned into an
+		expression.
+		Note that this constitutes an applied occurrence of
+		the identifier.
+	*/
+	register struct idf *idf = dot.tk_idf;	/* != 0*/
+	register struct def *def = idf->id_def;
+	
+	if (def == 0)	{
+		if (AHEAD == '(') {
+			/* function call, declare name implicitly (3.3.2.2) */
+			if (!options['o'])
+				warning("implicit declaration of function %s"
+					, idf->id_text);
+			add_def(idf, EXTERN, funint_type, level);
+		} else	{
+			if (!is_anon_idf(idf))
+				error("%s undefined", idf->id_text);
+			/* declare idf anyway */
+			add_def(idf, 0, error_type, level);
+		}
+		def = idf->id_def;
+	}
+	/* now def != 0 */
+#ifndef	LINT
+	if (!InSizeof) {
+		if (! def->df_used) {
+#ifndef PREPEND_SCOPES
+			code_scope(idf->id_text, def);
+#endif /* PREPEND_SCOPES */
+			def->df_used = 1;
+		}
+	}
+#endif	/* LINT */
+	expr->ex_type = def->df_type;
+	if (expr->ex_type == error_type) {
+		expr->ex_flags |= EX_ERROR;
+	}
+	expr->ex_lvalue =
+		(	def->df_type->tp_fund == FUNCTION ||
+			def->df_type->tp_fund == ARRAY ||
+			def->df_sc == ENUM
+		) ? 0 : 1;
+	if (def->df_type->tp_typequal & TQ_CONST)
+		expr->ex_flags |= EX_READONLY;
+	if (def->df_type->tp_typequal & TQ_VOLATILE)
+		expr->ex_flags |= EX_VOLATILE;
+	expr->ex_class = Value;
+	if (def->df_sc == ENUM)	{
+		expr->VL_CLASS = Const;
+		expr->VL_VALUE = def->df_address;
+	}
+#ifndef	LINT
+	else
+	if (def->df_sc == STATIC && def->df_level >= L_LOCAL) {
+		expr->VL_CLASS = Label;
+		expr->VL_LBL = def->df_address;
+		expr->VL_VALUE = (arith)0;
+	}
+#endif	/* LINT */
+	else {
+		expr->VL_CLASS = Name;
+		expr->VL_IDF = idf;
+		expr->VL_VALUE = (arith)0;
+	}
+}
+
+string2expr(expp, str, len)
+	register struct expr **expp;
+	int len;
+	char *str;
+{
+	/*	The string in the argument is converted into an expression,
+		a pointer to which is stored in *expp.
+	*/
+	register struct expr *ex = new_expr();
+
+	*expp = ex;
+	ex->ex_file = dot.tk_file;
+	ex->ex_line = dot.tk_line;
+	ex->ex_type = string_type;
+	/* ex->ex_type = qualifier_type(ex->ex_type, TQ_CONST); */
+	ex->ex_flags |= EX_READONLY;
+	/* ex->ex_lvalue = 0; */
+	ex->ex_class = String;
+	ex->SG_VALUE = str;
+	ex->SG_LEN = len;
+}
+
+int2expr(expr)
+	struct expr *expr;
+{
+	/*	Dot contains an integer constant which is turned
+		into an expression.
+	*/
+	fill_int_expr(expr, dot.tk_ival, dot.tk_fund);
+}
+
+float2expr(expr)
+	register struct expr *expr;
+{
+	/*	Dot contains a floating point constant which is turned
+		into an expression.
+	*/
+	register int fund;
+
+	fund = dot.tk_fund;
+	switch (fund) {
+	case FLOAT:
+		expr->ex_type = float_type;
+		break;
+	case DOUBLE:
+		expr->ex_type = double_type;
+		break;
+	case LNGDBL:
+		expr->ex_type = lngdbl_type;
+		break;
+	default:
+		crash("(float2expr) bad fund %s\n", symbol2str(fund));
+	}
+	expr->ex_class = Float;
+	flt_str2flt(dot.tk_fval, &(expr->FL_ARITH));
+	free(dot.tk_fval);
+	ASSERT(flt_status != FLT_NOFLT);
+	if (flt_status == FLT_OVFL)
+		expr_warning(expr,"internal floating point overflow");
+}
+
+struct expr*
+intexpr(ivalue, fund)
+	arith ivalue;
+	int fund;
+{
+	/*	The value ivalue is turned into an integer expression of
+		the size indicated by fund.
+	*/
+	register struct expr *expr = new_expr();
+
+	expr->ex_file = dot.tk_file;
+	expr->ex_line = dot.tk_line;
+	fill_int_expr(expr, ivalue, fund);
+	return expr;
+}
+
+fill_int_expr(ex, ivalue, fund)
+	register struct expr *ex;
+	arith ivalue;
+	int fund;
+{
+	/*	Details derived from ivalue and fund are put into the
+		constant integer expression ex.
+	*/
+	switch (fund) {
+	case INT:
+		ex->ex_type = int_type;
+		break;
+	case UNSIGNED:
+		ex->ex_type = uint_type;
+		break;
+	case LONG:
+		ex->ex_type =  long_type;
+		break;
+	case ULONG:
+		ex->ex_type = ulong_type;
+		break;
+	default:
+		crash("(fill_int_expr) bad fund %s\n", symbol2str(fund));
+		/*NOTREACHED*/
+	}
+	ex->ex_class = Value;
+	ex->VL_CLASS = Const;
+	ex->VL_VALUE = ivalue;
+	cut_size(ex);
+}
+
+struct expr *
+new_oper(tp, e1, oper, e2)
+	struct type *tp;
+	register struct expr *e1, *e2;
+{
+	/*	A new expression is constructed which consists of the
+		operator oper which has e1 and e2 as operands; for a
+		monadic operator e1 == NILEXPR.
+		During the construction of the right recursive initialisation
+		tree it is possible for e2 to be NILEXPR.
+	*/
+	register struct expr *expr = new_expr();
+	register struct oper *op;
+
+	if (e2)	{
+		register struct expr *e = e2;
+		
+		while (e->ex_class == Oper && e->OP_LEFT)
+			e = e->OP_LEFT;
+		expr->ex_file = e->ex_file;
+		expr->ex_line = e->ex_line;
+	}
+	else
+	if (e1)	{
+		register struct expr *e = e1;
+		
+		while (e->ex_class == Oper && e->OP_RIGHT)
+			e = e->OP_RIGHT;
+		expr->ex_file = e->ex_file;
+		expr->ex_line = e->ex_line;
+	}
+	else	{
+		expr->ex_file = dot.tk_file;
+		expr->ex_line = dot.tk_line;
+	}
+
+	expr->ex_type = tp;
+	expr->ex_class = Oper;
+	/* combine depths and flags of both expressions */
+	if (e2)	{
+		int e1_depth = e1 ? e1->ex_depth : 0;
+		int e1_flags = e1 ? e1->ex_flags : 0;
+		
+		expr->ex_depth =
+			(e1_depth > e2->ex_depth ? e1_depth : e2->ex_depth) + 1;
+		expr->ex_flags = (e1_flags | e2->ex_flags)
+			& ~(EX_PARENS | EX_READONLY | EX_VOLATILE );
+	}
+	/*
+	 * A function call should be evaluated first when possible.  Just say
+	 * that the expression tree is very deep.
+	 */
+	if (oper == '(') {
+		expr->ex_depth = 50;
+	}
+	op = &expr->ex_object.ex_oper;
+	op->op_type = tp;
+	op->op_oper = oper;
+	op->op_left = e1;
+	op->op_right = e2;
+#ifdef	LINT
+	lint_new_oper(expr);
+#endif	/* LINT */
+	return expr;
+}
+
+chk_cst_expr(expp)
+	struct expr **expp;
+{
+	/*	The expression expr is checked for constancy.
+	
+		There are 6 places where constant expressions occur in C:
+		1.	after #if
+		2.	in a global initialization
+		3.	as size in an array declaration
+		4.	as value in an enum declaration
+		5.	as width in a bit field
+		6.	as case value in a switch
+		
+		The constant expression in a global initialization is
+		handled separately (by IVAL()).
+		
+		There are various disparate restrictions on each of
+		the others in the various C compilers.  I have tried some
+		hypotheses to unify them, but all have failed.
+		
+		Special problems (of which there is only one, sizeof in
+		Preprocessor #if) have to be dealt with locally
+	*/
+	register struct expr *expr = *expp;
+	
+#ifdef	DEBUG
+	print_expr("constant_expression", expr);
+#endif	/* DEBUG */
+	switch(expr->ex_type->tp_fund) {
+	case CHAR:
+	case SHORT:
+	case INT:
+	case ENUM:
+	case LONG:
+		if (is_ld_cst(expr)) {
+			return;
+		}
+		expr_error(expr, "expression is not constant");
+		break;
+	default:
+		expr_error(expr, "non-numerical constant expression");
+		break;
+	}
+	erroneous2int(expp);
+}
+
+init_expression(eppp, expr)
+	register struct expr ***eppp;
+	struct expr *expr;
+{
+	/*	The expression expr is added to the tree designated
+		indirectly by **eppp.
+		The natural form of a tree representing an
+		initial_value_list is right-recursive, ie. with the
+		left-most comma as main operator. The iterative grammar in
+		expression.g, however, tends to produce a left-recursive
+		tree, ie. one with the right-most comma as its main
+		operator.
+		To produce a right-recursive tree from the iterative
+		grammar, we keep track of the address of the pointer where
+		the next expression must be hooked in.
+	*/
+	**eppp = new_oper(void_type, expr, INITCOMMA, NILEXPR);
+	*eppp = &(**eppp)->OP_RIGHT;
+}
+
+int
+is_ld_cst(expr)
+	register struct expr *expr;
+{
+	/*	An expression is a `load-time constant' if it is of the form
+		<idf> +/- <integral> or <integral>.
+	*/
+#ifdef	LINT
+	if (expr->ex_class == String)
+		return 1;
+#endif	/* LINT */
+	return expr->ex_lvalue == 0 && expr->ex_class == Value;
+}
+
+int
+is_cp_cst(expr)
+	struct expr *expr;
+{
+	/*	An expression is a `compile-time constant' if it is a
+		load-time constant, and the idf is not there.
+	*/
+	return is_ld_cst(expr) && expr->VL_CLASS == Const;
+}
+
+int
+is_fp_cst(expr)
+	struct expr *expr;
+{
+	/*	An expression is a `floating-point constant' if it consists
+		of the float only.
+	*/
+	return expr->ex_class == Float;
+}
+
+int
+is_zero_cst(expr)
+	register struct expr *expr;
+{
+	flt_arith var;
+
+	switch(expr->ex_class) {
+	case Value:
+		return expr->VL_VALUE == 0;
+	case Float:
+		flt_arith2flt((arith) 0, &var, 0);
+		return flt_cmp(&var, &(expr->FL_ARITH)) == 0;
+	}
+	/*NOTREACHED*/
+}
+
+free_expression(expr)
+	register struct expr *expr;
+{
+	/*	The expression expr is freed recursively.
+	*/
+	if (expr) {
+		if (expr->ex_class == Oper)	{
+			free_expression(expr->OP_LEFT);
+			free_expression(expr->OP_RIGHT);
+		}
+		free_expr(expr);
+	}
+}

lang/cem/cemcom.ansi/expr.str

@@ -0,0 +1,99 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* EXPRESSION DESCRIPTOR */
+
+/*	What we want to define is the struct expr, but since it contains
+	a union of various goodies, we define them first; so be patient.
+*/
+
+/* classes of value */
+#define Const	1
+#define Name	2
+#define Label	3
+
+struct value	{
+	int vl_class;		/* Const, Name or Label	*/
+	arith vl_value;		/* constant value or offset */
+	union {
+		struct idf *vl_idf;	/* external name */
+		label vl_lbl;		/* compiler-generated label */
+	} vl_data;
+};
+
+struct string	{
+	char *sg_value;		/* row of bytes repr. the constant */
+	int sg_len;		/* length of the row */
+};
+
+struct oper	{
+	struct type *op_type;	/* resulting type of the operation	*/
+	struct expr *op_left;
+	int op_oper;			/* the symbol of the operator	*/
+	struct expr *op_right;
+};
+
+/* The following constants indicate the class of the expression: */
+#define	Value	0		/* it is a value known at load time */
+#define	String	1		/* it is a string constant  */
+#define	Float	2		/* it is a floating point constant	*/
+#define	Oper	3		/* it is a run-time expression */
+#define	Type	4		/* only its type is relevant */
+
+struct expr	{
+	char *ex_file;		/* the file it (probably) comes from */
+	unsigned int ex_line;	/* the line it (probably) comes from */
+	struct type *ex_type;
+	short ex_lvalue;
+	short ex_flags;
+	int ex_class;
+	int ex_depth;
+	union	{
+		struct value ex_value;
+		struct string ex_string;
+		flt_arith ex_fl_arith;
+		struct oper ex_oper;
+	} ex_object;
+};
+
+/* some abbreviated selections	*/
+#define EX_VALUE	ex_object.ex_value
+#define VL_CLASS	EX_VALUE.vl_class
+#define	VL_VALUE	EX_VALUE.vl_value
+#define	VL_IDF		EX_VALUE.vl_data.vl_idf
+#define	VL_LBL		EX_VALUE.vl_data.vl_lbl
+#define	SG_VALUE	ex_object.ex_string.sg_value
+#define SG_LEN		ex_object.ex_string.sg_len
+#define	FL_ARITH	ex_object.ex_fl_arith
+#define	OP_TYPE		ex_object.ex_oper.op_type
+#define	OP_LEFT		ex_object.ex_oper.op_left
+#define	OP_OPER		ex_object.ex_oper.op_oper
+#define	OP_RIGHT	ex_object.ex_oper.op_right
+
+/*	some bits for the ex_flag field, to keep track of various
+	interesting properties of an expression.
+*/
+#define	EX_SIZEOF	0x001		/* contains sizeof operator */
+#define	EX_CAST		0x002		/* contains cast */
+#define	EX_LOGICAL	0x004		/* contains logical operator */
+#define	EX_COMMA	0x008		/* contains expression comma */
+#define	EX_PARENS	0x010		/* the top level is parenthesized */
+#define EX_SIDEEFFECTS	0x020		/* expression has side effects */
+#define	EX_READONLY	0x040		/* read only variabele */
+#define	EX_VOLATILE	0x080		/* volatile variabele */
+#define	EX_ILVALUE	0x100		/* an illegal lvalue e.g. f().x */
+#define	EX_ERROR	0x200		/* the expression is wrong */
+#define	EX_PTRDIFF	0x400		/* subtracting 2 pointers in expr. */
+
+#define	NILEXPR		((struct expr *)0)
+
+/* some useful tests */
+#define	ISNAME(e)	((e)->ex_class == Value && (e)->VL_CLASS == Name)
+#define	ISCOMMA(e)	((e)->ex_class == Oper && (e)->OP_OPER == INITCOMMA)
+
+extern struct expr *intexpr(), *new_oper();
+
+/* ALLOCDEF "expr" 20 */
+

lang/cem/cemcom.ansi/expression.g

@@ -0,0 +1,351 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	EXPRESSION SYNTAX PARSER	*/
+
+{
+#include	<alloc.h>
+#include	"lint.h"
+#include	"debug.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"LLlex.h"
+#include	"type.h"
+#include	"idf.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"code.h"
+#include	"sizes.h"
+
+extern struct expr *intexpr();
+int InSizeof = 0;	/* inside a sizeof- expression */
+int ResultKnown = 0;	/* result of the expression is already known */
+
+/* Since the grammar in the standard is not LL(n), it is modified so that
+ * it accepts basically the same grammar. This means that there is no 1-1
+ * mapping from the grammar in the standard to the grammar given here.
+ * Such is life.
+ */
+}
+
+/* 3.3.1 */
+primary(register struct expr **expp;) :
+	IDENTIFIER
+	{dot2expr(expp);}
+|
+	constant(expp)
+|
+	string(expp)
+|
+	'(' expression(expp) ')'
+	{ (*expp)->ex_flags |= EX_PARENS; }
+;
+
+
+/* Character string literals that are adjacent tokens
+ * are concatenated into a single character string
+ * literal.
+ */
+string(register struct expr **expp;)
+	{	register int i, len;
+		register char *str;
+		register int fund;
+	}
+:
+	STRING
+	{	str = dot.tk_bts;
+		len = dot.tk_len;
+		fund = dot.tk_fund;
+	}
+	[
+		STRING
+		{	/* A pasted string keeps the type of the first
+			 * string literal.
+			 * The pasting of normal strings and wide
+			 * character strings are stated as having an
+			 * undefined behaviour.
+			 */
+			if (dot.tk_fund != fund)
+				warning("illegal pasting of string literals");
+			str = Realloc(str, (unsigned) (--len + dot.tk_len));
+			for (i = 0; i < dot.tk_len; i++)
+				str[len++] = dot.tk_bts[i];
+		}
+	]*
+	{ string2expr(expp, str, len); }
+;
+
+/* 3.3.2 */
+postfix_expression(register struct expr **expp;)
+	{ int oper; 
+	  struct expr *e1 = 0;
+	  struct idf *idf;
+	}
+:
+	primary(expp)
+	[
+		'[' expression(&e1) ']'
+			{ ch3bin(expp, '[', e1); e1 = 0; }
+	|
+		'(' parameter_list(&e1)? ')'
+			{ ch3bin(expp, '(', e1); call_proto(expp); e1 = 0; }
+	|
+		[ '.' | ARROW ]			{ oper = DOT; }
+		identifier(&idf)		{ ch3sel(expp, oper, idf); }
+	|
+		[
+			PLUSPLUS	{ oper = POSTINCR; }
+		|
+			MINMIN		{ oper = POSTDECR; }
+		]
+		    { ch3incr(expp, oper); }
+	]*
+;
+
+parameter_list(struct expr **expp;)
+	{struct expr *e1 = 0;}
+:
+	assignment_expression(expp)
+	{any2opnd(expp, PARCOMMA);}
+	[ %persistent
+		','
+		assignment_expression(&e1)
+		{any2opnd(&e1, PARCOMMA);}
+		{ch3bin(expp, PARCOMMA, e1);}
+	]*
+;
+
+%first	first_of_type_specifier, type_specifier;
+
+/* 3.3.3 & 3.3.4 */
+unary(register struct expr **expp;)
+	{struct type *tp; int oper;}
+:
+%if (first_of_type_specifier(AHEAD) && AHEAD != IDENTIFIER)
+	cast(&tp) unary(expp)
+	{	ch3cast(expp, CAST, tp);
+		(*expp)->ex_flags |= EX_CAST;
+		if (int_size != pointer_size)
+			(*expp)->ex_flags &= ~EX_PTRDIFF;
+	}
+|
+	postfix_expression(expp)
+|
+	unop(&oper) unary(expp)
+	{ch3mon(oper, expp);}
+|
+	size_of(expp)
+;
+
+/* When an identifier is used in a sizeof()-expression, we must stil not
+ * mark it as used.
+ * extern int i;  ....  sizeof(i)  .... need not have a definition for i
+ */
+size_of(register struct expr **expp;)
+	{struct type *tp;}
+:
+	SIZEOF { InSizeof++; }	/* handle (sizeof(sizeof(int))) too */
+	[%if (first_of_type_specifier(AHEAD) && AHEAD != IDENTIFIER)
+		cast(&tp)
+		{
+			*expp = intexpr(size_of_type(tp, "type"), UNSIGNED);
+			(*expp)->ex_flags |= EX_SIZEOF;
+		}
+	|
+		unary(expp)
+		{ch3mon(SIZEOF, expp);}
+	]
+	{ InSizeof--; }
+;
+
+/* 3.3.5-3.3.17 */
+/*	The set of operators in C is stratified in 15 levels, with level
+	N being treated in RM 7.N (although this is not the standard
+	anymore). The standard describes this in phrase-structure-grammar,
+	which we are unable to parse. The description that follows comes
+	from the old C-compiler.
+
+	In principle each operator is assigned a rank, ranging
+	from 1 to 15.  Such an expression can be parsed by a construct
+	like:
+		binary_expression(int maxrank;)
+			{int oper;}
+		:
+			binary_expression(maxrank - 1)
+			[%if (rank_of(DOT) <= maxrank)
+				binop(&oper)
+				binary_expression(rank_of(oper)-1)
+			]?
+		;
+	except that some call of 'unary' is necessary, depending on the
+	grammar.
+	
+	This simple view is marred by three complications:
+	1.	Level 15 (comma operator) is not allowed in many
+		contexts and is different.
+	2.	Level 13 (conditional operator) is a ternary operator,
+		which does not fit this scheme at all.
+	3.	Level 14 (assignment operators) group right-to-left, as
+		opposed to 2-12, which group left-to-right (or are
+		immaterial).
+	4.	The operators in level 14 start with operators in levels
+		2-13 (RM 7.14: The two parts of a compound assignment
+		operator are separate tokens.)  This causes LL1 problems.
+	This forces us to have four rules:
+		binary_expression	for level 2-12
+		conditional_expression	for level 13
+		assignment_expression	for level 14 and
+		expression		for the most general expression
+*/
+
+binary_expression(int maxrank; struct expr **expp;)
+	{int oper, OldResultKnown; struct expr *e1;}
+:
+	unary(expp)
+	[%while (rank_of(DOT) <= maxrank )
+		/*	'?', '=', and ',' are no binops
+		 */
+		binop(&oper)
+		{ OldResultKnown = ResultKnown;
+		  if (oper == OR || oper == AND) {
+			  if (is_cp_cst(*expp) || is_fp_cst(*expp)) {
+				  if (is_zero_cst(*expp)) {
+					  if (oper == AND) ResultKnown++;
+				  } else if (oper == OR) ResultKnown++;
+			  }
+		  }
+		}
+		binary_expression(rank_of(oper)-1, &e1)
+		{
+			ch3bin(expp, oper, e1);
+			ResultKnown = OldResultKnown;
+		}
+	]*
+;
+
+/* 3.3.15 */
+conditional_expression(struct expr **expp;)
+	{struct expr *e1 = 0, *e2 = 0; int OldResultKnown, ConstExpr=0;}
+:
+	/* allow all binary operators */
+	binary_expression(rank_of('?') - 1, expp)
+	[	'?'
+		{ OldResultKnown = ResultKnown;
+		  if (is_cp_cst(*expp) || is_fp_cst(*expp)) {
+			  ConstExpr++;
+			  if (is_zero_cst(*expp)) ResultKnown++;
+		  }
+		}
+		expression(&e1)
+		':'
+		{ if (ConstExpr) {
+			if (OldResultKnown == ResultKnown) ResultKnown++;
+			else ResultKnown = OldResultKnown;
+		  }
+		}
+		conditional_expression(&e2)
+		{	
+			ResultKnown = OldResultKnown;
+			ch3bin(&e1, ':', e2);
+			opnd2test(expp, '?');
+			ch3bin(expp, '?', e1);
+		}
+	]?
+;
+
+/* 3.3.16 */
+assignment_expression(struct expr **expp;)
+	{ int oper;
+	  struct expr *e1 = 0;
+	}
+:
+	conditional_expression(expp)
+	[
+		asgnop(&oper)
+		assignment_expression(&e1)
+		{ch3asgn(expp, oper, e1);}
+	|
+		empty		/* LLgen artefact ??? */
+	]
+;
+
+/* 3.3.17 */
+expression(struct expr **expp;)
+	{struct expr *e1;}
+:
+	assignment_expression(expp)
+	[	','
+		assignment_expression(&e1)
+		{
+			ch3bin(expp, ',', e1);
+		}
+	]*
+;
+
+unop(int *oper;) :
+	['*' | '&' | '-' | '+' | '!' | '~' | PLUSPLUS | MINMIN]
+	{   if (DOT == '&') DOT = ADDRESSOF;
+	    *oper = DOT;
+	}
+;
+
+multop:
+	'*' | '/' | '%'
+;
+
+addop:
+	'+' | '-'
+;
+
+shiftop:
+	LEFT | RIGHT
+;
+
+relop:
+	'<' | '>' | LESSEQ | GREATEREQ
+;
+
+eqop:
+	EQUAL | NOTEQUAL
+;
+
+arithop:
+	multop | addop | shiftop
+|
+	'&' | '^' | '|'
+;
+
+binop(int *oper;) :
+	[ arithop | relop | eqop | AND | OR ]
+	{*oper = DOT;}
+;
+
+asgnop(register int *oper;):
+	[ '=' | PLUSAB | MINAB | TIMESAB | DIVAB | MODAB 
+	| LEFTAB | RIGHTAB | ANDAB | XORAB | ORAB ]
+	{ *oper = DOT; }
+
+;
+
+constant(struct expr **expp;) :
+[
+	INTEGER
+|
+	FLOATING
+]	{dot2expr(expp);}
+;
+
+/* 3.4 */
+constant_expression (struct expr **expp;) :
+	conditional_expression(expp)
+	{ chk_cst_expr(expp); }
+;
+
+identifier(struct idf **idfp;) :
+[ IDENTIFIER
+| TYPE_IDENTIFIER
+]
+	{ *idfp = dot.tk_idf; }
+;

lang/cem/cemcom.ansi/field.c

@@ -0,0 +1,174 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	BITFIELD EXPRESSION EVALUATOR	*/
+
+#include	"lint.h"
+#ifndef	LINT
+
+#include	"nobitfield.h"
+
+#ifndef NOBITFIELD
+#include	<em.h>
+#include	<em_reg.h>
+#include	"debug.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"type.h"
+#include	"idf.h"
+#include	"label.h"
+#include	"code.h"
+#include	"assert.h"
+#include	"expr.h"
+#include	"sizes.h"
+#include	"align.h"
+#include	"Lpars.h"
+#include	"field.h"
+
+arith NewLocal();		/* util.c	*/
+extern arith full_mask[];	/* cstoper.c	*/
+
+/*	Eval_field() evaluates expressions involving bit fields.
+	The various instructions are not yet optimised in the expression
+	tree and are therefore dealt with in this function.
+	The actions taken at any operation are described clearly by the
+	code for this actions.
+	Notes
+	[1]	the bitfields are packed in target machine integers!
+	[2]	op is either an assignment operator or an increment/
+		decrement operator
+	[3]	atype: the type in which the bitfield arithmetic is done;
+		and in which bitfields are stored!
+*/
+eval_field(expr, code)
+	struct expr *expr;
+	int code;
+{
+	int op = expr->OP_OPER;
+	register struct expr *leftop = expr->OP_LEFT;
+	register struct expr *rightop = expr->OP_RIGHT;
+	register struct field *fd = leftop->ex_type->tp_field;
+	struct type *tp = leftop->ex_type->tp_up;
+	arith tmpvar = 0;
+	struct type *atype = ( tp->tp_unsigned
+				&& fd->fd_width >= 8 * (int)word_size)
+				    ? uword_type
+				    : word_type;
+
+	/* First some assertions to be sure that the rest is legal */
+	ASSERT(atype->tp_size == word_size);	/* make sure that C_loc() is legal */
+	ASSERT(leftop->ex_type->tp_fund == FIELD);
+	leftop->ex_type = atype;	/* this is cheating but it works... */
+	if (op == '=') {
+		/* F = E: f = ((E & mask)<<shift) | (~(mask<<shift) & f) */
+		ASSERT(tp == rightop->ex_type);
+		EVAL(rightop, RVAL, TRUE, NO_LABEL, NO_LABEL);
+		conversion(tp, atype);
+		store_field(fd, tp->tp_unsigned, code, leftop, (arith) 0);
+	}
+	else {		/* treat ++F as F += 1 and --F as F -= 1	*/
+		/*	F op= e: f = (((((f>>shift)&mask) op e)&mask)<<shift)|
+					(f&~(mask<<shift))
+		*/
+		if (leftop->ex_depth == 0)	/* simple case	*/
+			load_val(leftop, RVAL);
+		else	{			/* complex case	*/
+			tmpvar = NewLocal(pointer_size, pointer_align, 
+					  reg_pointer, 0);
+			EVAL(leftop, LVAL, TRUE, NO_LABEL, NO_LABEL);
+			C_dup(pointer_size);
+			StoreLocal(tmpvar, pointer_size);
+			C_loi(word_size);
+		}
+		if (tp->tp_unsigned) {
+			C_loc((arith)fd->fd_shift);
+			C_sru(word_size);
+			C_loc(fd->fd_mask);
+			C_and(word_size);
+		}
+		else {
+			arith sft = (int)word_size * 8 - fd->fd_width;
+			C_loc(sft - fd->fd_shift);
+			C_sli(word_size);
+			C_loc(sft);
+			C_sri(word_size);
+		}
+		if (code == TRUE && (op == POSTINCR || op == POSTDECR))
+			C_dup(word_size);
+		conversion(atype, rightop->ex_type);
+		EVAL(rightop, RVAL, TRUE, NO_LABEL, NO_LABEL);
+		/* the 'op' operation: */
+		if (op == PLUSPLUS || op == POSTINCR)
+			assop(rightop->ex_type, PLUSAB);
+		else
+		if (op == MINMIN || op == POSTDECR)
+			assop(rightop->ex_type, MINAB);
+		else
+			assop(rightop->ex_type, op);
+		conversion(rightop->ex_type, atype);
+		store_field(fd, atype->tp_unsigned, 
+			    code == TRUE && op != POSTINCR && op != POSTDECR,
+			    leftop, tmpvar);
+	}
+	if (code == TRUE) {
+		/*	Take care that the effective value stored in
+			the bit field (i.e. the value that is got on
+			retrieval) is on top of stack.
+		*/
+		if (tp->tp_unsigned == 0) {	/* sign extension */
+			register arith shift = (int)word_size * 8 - fd->fd_width;
+
+			C_loc(shift);
+			C_sli(word_size);
+			C_loc(shift);
+			C_sri(word_size);
+		}
+		conversion(atype, expr->ex_type);
+	}
+}
+
+store_field(fd, uns, code, leftop, tmpvar)
+	register struct field *fd;
+	int uns;
+	int code;
+	register struct expr *leftop;
+	arith tmpvar;
+{
+	C_loc(fd->fd_mask);
+	C_and(word_size);
+	if (code == TRUE)
+		C_dup(word_size);
+	C_loc((arith)fd->fd_shift);
+	if (uns)
+		C_slu(word_size);
+	else
+		C_sli(word_size);
+	C_loc(~((fd->fd_mask << fd->fd_shift) | ~full_mask[(int)word_size]));
+	if (leftop->ex_depth == 0)	{	/* simple case	*/
+		load_val(leftop, RVAL);
+		C_and(word_size);
+		C_ior(word_size);
+		store_val(&(leftop->EX_VALUE), uns ? uword_type : word_type);
+	}
+	else	{			/* complex case	*/
+		if (! tmpvar) {
+			tmpvar = NewLocal(pointer_size, pointer_align, 
+				  reg_pointer, 0);
+			EVAL(leftop, LVAL, TRUE, NO_LABEL, NO_LABEL);
+			StoreLocal(tmpvar, pointer_size);
+		}
+		LoadLocal(tmpvar, pointer_size);
+		C_loi(word_size);
+		C_and(word_size);
+		C_ior(word_size);
+		LoadLocal(tmpvar, pointer_size);
+		C_sti(word_size);
+		FreeLocal(tmpvar);
+	}
+}
+#endif /* NOBITFIELD */
+
+#endif	/* LINT */
+

lang/cem/cemcom.ansi/field.str

@@ -0,0 +1,15 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* FIELD DESCRIPTOR */
+
+struct field	{	/* for field specifiers	*/
+	arith fd_mask;
+	int fd_shift;
+	int fd_width;
+	struct sdef *fd_sdef;	/* upward pointer	*/
+};
+
+/* ALLOCDEF "field" 10 */

lang/cem/cemcom.ansi/file_info.h

@@ -0,0 +1,20 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* F I L E   I N F O R M A T I O N   S T R U C T U R E */
+
+struct file_info {
+	unsigned int	fil_lino;
+	int		fil_nestlow;
+	char		*fil_name;
+	char		*fil_wdir;
+};
+
+#define nestlow		finfo.fil_nestlow
+#define LineNumber	finfo.fil_lino
+#define FileName	finfo.fil_name
+#define WorkingDir	finfo.fil_wdir
+
+extern struct file_info finfo;	/* input.c */

lang/cem/cemcom.ansi/fltcstoper.c

@@ -0,0 +1,102 @@
+/*
+ * (c) copyright 1989 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	C O N S T A N T   E X P R E S S I O N   H A N D L I N G		*/
+/*	  F O R   F L O A T I N G   P O I N T   N U M B E R S		*/
+
+#include	"debug.h"
+#include	"assert.h"
+#include	<alloc.h>
+#include	"trgt_sizes.h"
+#include	"idf.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"type.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"sizes.h"
+#include	"Lpars.h"
+
+extern int ResultKnown;
+extern char *symbol2str();
+
+fltcstbin(expp, oper, expr)
+	register struct expr **expp, *expr;
+{
+	/*	The operation oper is performed on the constant
+		expressions *expp(ld) and expr(ct), and the result restored in
+		*expp.
+	*/
+	flt_arith o1, o2;
+	int compar = 0;
+	int cmpval = 0;
+
+	o1 = (*expp)->FL_ARITH;
+	o2 = expr->FL_ARITH;
+
+	ASSERT(is_fp_cst(*expp) && is_fp_cst(expr));
+	switch (oper)	{
+	case '*':
+		flt_mul(&o1, &o2, &o1);
+		break;
+	case '/':
+		flt_div(&o1, &o2, &o1);
+		break;
+	case '+':
+		flt_add(&o1, &o2, &o1);
+		break;
+	case '-':
+		flt_sub(&o1, &o2, &o1);
+		break;
+	case '<':
+	case '>':
+	case LESSEQ:
+	case GREATEREQ:
+	case EQUAL:
+	case NOTEQUAL:
+		compar++;
+		cmpval = flt_cmp(&o1, &o2);
+		switch(oper) {
+		case '<':	cmpval = (cmpval < 0);	break;
+		case '>':	cmpval = (cmpval > 0);	break;
+		case LESSEQ:	cmpval = (cmpval <= 0);	break;
+		case GREATEREQ:	cmpval = (cmpval >= 0);	break;
+		case EQUAL:	cmpval = (cmpval == 0);	break;
+		case NOTEQUAL:	cmpval = (cmpval != 0);	break;
+		}
+		break;
+	default:
+		/* in case of situations like a += 3.0; where a undefined */
+		flt_status = 0;
+		break;
+	}
+
+	switch (flt_status) {
+		case 0:
+		case FLT_UNFL:			/* ignore underflow */
+			break;
+		case FLT_OVFL:
+			if (!ResultKnown)
+			    expr_warning(expr,"floating point overflow on %s"
+					, symbol2str(oper));
+			break;
+		case FLT_DIV0:
+			if (!ResultKnown)
+				expr_error(expr,"division by 0.0");
+			else
+				expr_warning(expr,"division by 0.0");
+			break;
+		default:	/* there can't be another status */
+			crash("(fltcstoper) bad status");
+	}
+	if (compar) {
+		fill_int_expr(*expp, (arith)cmpval, INT);
+	} else {
+		(*expp)->FL_ARITH = o1;
+	}
+	(*expp)->ex_flags |= expr->ex_flags;
+	(*expp)->ex_flags &= ~EX_PARENS;
+	free_expression(expr);
+}

lang/cem/cemcom.ansi/idf.c

@@ -0,0 +1,654 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	IDENTIFIER  FIDDLING & SYMBOL TABLE HANDLING	*/
+
+#include	"lint.h"
+#include	<em_reg.h>
+#include	"debug.h"
+#include	"idfsize.h"
+#include	"botch_free.h"
+#include	"nopp.h"
+#include	"nparams.h"
+#include	<alloc.h>
+#include	"arith.h"
+#include	"align.h"
+#include	"LLlex.h"
+#include	"level.h"
+#include	"stack.h"
+#include	"idf.h"
+#include	"label.h"
+#include	"def.h"
+#include	"type.h"
+#include	"proto.h"
+#include	"struct.h"
+#include	"declar.h"
+#include	"decspecs.h"
+#include	"sizes.h"
+#include	"Lpars.h"
+#include	"assert.h"
+
+extern char options[];
+extern arith NewLocal();
+extern char *symbol2str();
+
+#ifdef DEBUG
+#define IDF_DEBUG
+#endif
+
+#include <idf_pkg.body>
+
+struct idf *
+gen_idf()
+{
+	/*	A new idf is created out of nowhere, to serve as an
+		anonymous name.
+	*/
+	static int name_cnt;
+	char *s = Malloc(strlen(dot.tk_file) + 50);
+
+	sprint(s, "#%d in %s, line %u",
+			++name_cnt, dot.tk_file, dot.tk_line);
+	s = Realloc(s, strlen(s)+1);
+	return str2idf(s, 0);
+}
+
+int
+is_anon_idf(idf)
+	struct idf *idf;
+{
+	return idf->id_text[0] == '#';
+}
+
+declare_idf(ds, dc, lvl)
+	struct decspecs *ds;
+	struct declarator *dc;
+{
+	/*	The identifier inside dc is declared on the level lvl, with
+		properties deduced from the decspecs ds and the declarator
+		dc.
+		The level is given explicitly to be able to insert, e.g.,
+		labels on the outermost level inside the function.
+		This routine implements the rich semantics of C
+		declarations.
+	*/
+	register struct idf *idf = dc->dc_idf;
+	register int sc = ds->ds_sc;
+		/*	This local copy is essential:
+				char b(), c;
+			makes b GLOBAL and c AUTO.
+		*/
+	register struct def *def = idf->id_def;		/* may be NULL */
+	register struct type *type;
+	struct stack_level *stl = stack_level_of(lvl);
+	char formal_array = 0;
+	
+	/* determine the present type */
+	if (ds->ds_type == 0)	{
+		/*	at the L_FORMAL1 level there is no type specified yet
+		*/
+		ASSERT(lvl == L_FORMAL1);
+		type = int_type;	/* may change at L_FORMAL2 */
+	}
+	else	{
+		/* combine the decspecs and the declarator into one type */
+		type = declare_type(ds->ds_type, dc);
+		if (type->tp_size <= (arith)0 &&
+		    actual_declaration(sc, type))	{
+			if (type->tp_size == (arith) -1) {
+				/* the type is not yet known,
+				   but it has to be:
+				*/
+				if (type->tp_fund != VOID) {
+				    if (level != L_GLOBAL)
+					error("unknown %s-type",
+						symbol2str(type->tp_fund));
+				} else	error("void is not a complete type");
+			}
+			else strict("%s has size 0", idf->id_text);
+		}
+	}
+
+	/* some additional work for formal definitions */
+	if (lvl == L_FORMAL2)	{
+		switch (type->tp_fund)	{
+		case FUNCTION:
+			warning("%s is a function; cannot be formal",
+				idf->id_text);
+			type = construct_type(POINTER, type, 0, (arith)0,
+					      NO_PROTO);
+			break;
+		case ARRAY:	/* 3.7.1 */
+			type = construct_type(POINTER, type->tp_up, 0, (arith)0,
+					      NO_PROTO);
+			formal_array = 1;
+			break;
+		case FLOAT:
+		case CHAR:
+		case SHORT:
+			/* The conversion is done in formal_cvt(). It is
+			 * not done when the type is float and there is a
+			 * prototype.
+			 */
+			break;
+		}
+	}
+	/*	The tests on types, postponed from do_decspecs(), can now
+		be performed.
+	*/
+	/* update the storage class */
+	if (type && type->tp_fund == FUNCTION)	{
+		if (lvl != L_GLOBAL)  {		/* 3.5.1 */
+			if (sc == 0)
+				sc = GLOBAL;
+			else if (sc != EXTERN && sc != TYPEDEF) {
+				error("illegal storage class %s for function with block-scope"
+					, symbol2str(sc));
+				ds->ds_sc = sc = EXTERN;
+			}
+		}
+		else if (sc == 0)
+			sc = GLOBAL;
+	}
+	else	/* non-FUNCTION */
+		if (sc == 0)
+			sc =	lvl == L_GLOBAL ? GLOBAL
+				: lvl == L_FORMAL1 || lvl == L_FORMAL2 ? FORMAL
+				: AUTO;
+
+#ifdef	LINT
+	check_hiding(idf, lvl, sc);	/* of some idf by this idf */
+#endif	/* LINT */
+	if (def && lvl == L_LOCAL && def->df_level == L_FORMAL2) {
+		error("%s redeclared", idf->id_text);
+	}
+
+	if (def && 
+	    ( def->df_level == lvl ||
+	      ( lvl != L_GLOBAL && def->df_level > lvl ) ||
+	      (lvl == L_GLOBAL
+	       && def->df_level == L_PROTO
+	       && def->next && def->next->df_level == L_GLOBAL)
+	   ))	{
+		/*	There is already a declaration for idf on this
+			level, or even more inside.
+			The rules differ for different levels.
+		*/
+		switch (lvl)	{
+		case L_GLOBAL:
+			global_redecl(idf, sc, type);
+			def->df_file = idf->id_file;
+			def->df_line = idf->id_line;
+			break;
+		case L_FORMAL1:	/* formal declaration */
+			error("formal %s redeclared", idf->id_text);
+			break;
+		case L_FORMAL2:	/* formal definition */
+		default:	/* local */
+			if (sc != EXTERN) error("%s redeclared", idf->id_text);
+			break;
+		}
+	}
+	else	/* the idf is unknown on this level */
+	if (lvl == L_FORMAL2 && sc != ENUM && good_formal(def, idf))	{
+		/* formal declaration, update only */
+		def->df_type = type;
+		def->df_formal_array = formal_array;
+		def->df_sc = sc;
+		def->df_level = L_FORMAL2;	/* CJ */
+		def->df_file = idf->id_file;
+		def->df_line = idf->id_line;
+	}
+	else	{ /* fill in the def block */
+		register struct def *newdef = new_def();
+
+		newdef->next = def;
+		newdef->df_level = lvl;
+		newdef->df_type = type;
+		newdef->df_sc = sc;
+		newdef->df_file = idf->id_file;
+		newdef->df_line = idf->id_line;
+#ifdef	LINT
+		newdef->df_set = 0;
+		newdef->df_firstbrace = 0;
+#endif	/* LINT */
+		/* link it into the name list in the proper place */
+		idf->id_def = newdef;
+		update_ahead(idf);
+		stack_idf(idf, stl);
+		/*	We now calculate the address.
+			Globals have names and don't get addresses, they
+			get numbers instead (through data_label()).
+			Formals are handled by declare_formals().
+			So here we hand out local addresses only.
+		*/
+		if (lvl >= L_LOCAL)	{
+			ASSERT(sc);
+			switch (sc)	{
+			case REGISTER:
+			case AUTO:
+				if (type->tp_size == (arith)-1
+					&& type->tp_fund != ARRAY) {
+					error("size of local %s unknown",
+						idf->id_text);
+				/** type = idf->id_def->df_type = int_type; **/
+				}
+				if (type->tp_size != (arith) -1) {
+				    newdef->df_address =
+					NewLocal(type->tp_size,
+						 type->tp_align,
+						 regtype(type),
+						 sc);
+				}
+				break;
+			case STATIC:
+				newdef->df_address = (arith) data_label();
+				break;
+			}
+		}
+	}
+}
+
+actual_declaration(sc, tp)
+	int sc;
+	struct type *tp;
+{
+	/*	An actual_declaration needs space, right here and now.
+	*/
+	register int fund = tp->tp_fund;
+	
+	if (sc == ENUM || sc == TYPEDEF) /* virtual declarations */
+		return 0;
+	if (fund == FUNCTION || fund == ARRAY)
+		/* allocation solved in other ways */
+		return 0;
+	if (sc == EXTERN && fund == VOID) {
+		/* strange, but should be accepted */
+		return 0;
+	}
+	/* to be allocated */
+	return 1;
+}
+
+global_redecl(idf, new_sc, tp)
+	register struct idf *idf;
+	struct type *tp;
+{
+	/*	A global identifier may be declared several times,
+		provided the declarations do not conflict; they might
+		conflict in type (or supplement each other in the case of
+		an array) or they might conflict or supplement each other
+		in storage class.
+	*/
+	register struct def *def = idf->id_def;
+
+	while (def->df_level != L_GLOBAL) def = def->next;
+	if (!equal_type(tp, def->df_type, 0, 1)) {
+		error("redeclaration of %s with different type", idf->id_text);
+		return;
+	} else	update_proto(tp, def->df_type);
+	if (tp->tp_fund == ARRAY) {
+		/* Multiple array declaration; this may be interesting */
+		if (tp->tp_size < 0)	{		/* new decl has [] */
+			/* nothing new */
+		} else
+		if (def->df_type->tp_size < 0)	{	/* old decl has [] */
+			def->df_type = tp;
+		}
+	} if (tp->tp_fund == FUNCTION && new_sc == GLOBAL) {
+		/* see 3.1.2.2 */
+		new_sc = EXTERN;
+	}
+
+	/*	Now we may be able to update the storage class.
+		Clean out this mess as soon as we know all the possibilities
+		for new_sc.
+		For now we have:
+			EXTERN:		we have seen the word "extern"
+			GLOBAL:		the item was declared on the outer
+					level, without either "extern" or
+					"static".
+			STATIC:		we have seen the word "static"
+	*/
+
+	switch (def->df_sc)	{	/* the old storage class */
+	case EXTERN:
+		switch (new_sc)	{	/* the new storage class */
+		case STATIC:
+			warning("%s redeclared static", idf->id_text);
+			/* fallthrough */
+		case GLOBAL:
+			def->df_sc = new_sc;
+			/* fallthrough */
+		case EXTERN:
+			break;
+		default:
+			crash("bad storage class");
+			/*NOTREACHED*/
+		}
+		break;
+	case GLOBAL:
+		switch (new_sc)	{	/* the new storage class */
+		case STATIC:		/* linkage disagreement */
+			warning("%s redeclared static", idf->id_text);
+			def->df_sc = new_sc;
+			/* fallthrough */
+		case GLOBAL:
+		case EXTERN:
+			break;
+		default:
+			crash("bad storage class");
+			/*NOTREACHED*/
+		}
+		break;
+	case STATIC:
+		switch (new_sc)	{	/* the new storage class */
+		case GLOBAL:		/* linkage disagreement */
+		case EXTERN:
+			warning("%s is already declared static", idf->id_text);
+			/* fallthrough */
+		case STATIC:
+			break;
+		default:
+			crash("bad storage class");
+			/*NOTREACHED*/
+		}
+		break;
+	case ENUM:
+	case TYPEDEF:
+		error("illegal redeclaration of %s", idf->id_text);
+		break;
+	default:
+		crash("bad storage class");
+		/*NOTREACHED*/
+	}
+}
+
+int
+good_formal(def, idf)
+	register struct def *def;
+	register struct idf *idf;
+{
+	/*	Succeeds if def is a proper L_FORMAL1 definition and
+		gives an error message otherwise.
+	*/
+	if (!def || def->df_level != L_FORMAL1)	{ /* not in parameter list */
+		if (!is_anon_idf(idf))
+			error("%s not in parameter list", idf->id_text);
+		return 0;
+	}
+	ASSERT(def->df_sc == FORMAL);	/* CJ */
+	return 1;
+}
+
+declare_params(dc)
+	struct declarator *dc;
+{
+	/*	Declares the formal parameters if they exist.
+	*/
+	register struct formal *fm = dc->dc_formal;
+
+	while (fm)	{
+		declare_parameter(fm->fm_idf);
+		fm = fm->next;
+	}
+}
+
+idf_initialized(idf)
+	register struct idf *idf;
+{
+	/*	The topmost definition of idf is set to initialized.
+	*/
+	register struct def *def = idf->id_def;	/* the topmost */
+	
+	while (def->df_level <= L_PROTO) def = def->next;
+	if (def->df_initialized)
+		error("multiple initialization of %s", idf->id_text);
+	if (def->df_sc == TYPEDEF)	{
+		error("typedef cannot be initialized");
+		return;
+	}
+	def->df_initialized = 1;
+}
+
+declare_parameter(idf)
+	struct idf *idf;
+{
+	/*	idf is declared as a formal.
+	*/
+	add_def(idf, FORMAL, int_type, level);
+}
+
+declare_enum(tp, idf, l)
+	struct type *tp;
+	struct idf *idf;
+	arith l;
+{
+	/*	idf is declared as an enum constant with value l.
+	*/
+	add_def(idf, ENUM, tp, level);
+	idf->id_def->df_address = l;
+}
+
+check_formals(idf, dc)
+	struct idf *idf;
+	struct declarator *dc;
+{
+	register struct formal *fm = dc->dc_formal;
+	register struct proto *pl = idf->id_def->df_type->tp_proto;
+	register struct decl_unary *du = dc->dc_decl_unary;
+
+	if (!du) {	/* error or typdef'ed function */
+		error("illegal definition of %s", idf->id_text);
+		return;
+	}
+
+	while (du
+		&& (du->du_fund != FUNCTION
+		    || du->next != (struct decl_unary *) 0)) {
+		du = du->next;
+	}
+	if (!du) return;	/* terrible error, signalled earlier */
+
+	if (du->du_proto) return;
+
+	if (pl) {
+		/* Don't give a warning about an old-style definition,
+		 * since the arguments will be checked anyway.
+		 */
+		if (pl->pl_flag & PL_ELLIPSIS) {
+		    if (!(du->du_proto) && !(pl->pl_flag & PL_ERRGIVEN))
+			error("ellipsis terminator in previous declaration");
+		    pl = pl->next;
+		}
+		else if (pl->pl_flag & PL_VOID) {
+		    pl = pl->next;			/* should be 0 */
+		}
+		while(fm && pl) {
+		    if (!equal_type(promoted_type(fm->fm_idf->id_def->df_type)
+					, pl->pl_type, -1, 1)) {
+			if (!(pl->pl_flag & PL_ERRGIVEN))
+			    error("incorrect type for parameter %s"
+						, fm->fm_idf->id_text);
+			pl->pl_flag |= PL_ERRGIVEN;
+		    }
+		    fm = fm->next;
+		    pl = pl->next;
+		}
+		if (pl || fm) {
+			error("incorrect number of parameters");
+		}
+	} else {			/* make a pseudo-prototype */
+		register struct proto *lpl = new_proto();
+
+		if (!options['o'])
+			warning("'%s' old-fashioned function definition"
+					, dc->dc_idf->id_text);
+
+		while (fm) {
+			if (pl == 0) pl = lpl;
+			else {
+				lpl->next = new_proto();
+				lpl = lpl->next;
+			}
+			lpl->pl_flag = PL_FORMAL;
+			lpl->pl_idf = fm->fm_idf;
+			lpl->pl_type =
+				    promoted_type(fm->fm_idf->id_def->df_type);
+			fm = fm->next;
+		}
+		if (pl == 0) {		/* make func(void) */
+			pl = lpl;
+			pl->pl_type = void_type;
+			pl->pl_flag = PL_FORMAL | PL_VOID;
+		}
+		idf->id_def->df_type->tp_pseudoproto = pl;
+	}
+	free_formals(dc->dc_formal);
+	dc->dc_formal = 0;
+}
+
+declare_formals(idf, fp)
+	struct idf *idf;
+	arith *fp;
+{
+	/*	Declares those formals as int that haven't been declared
+		by the user.
+		An address is assigned to each formal parameter.
+		The total size of the formals is returned in *fp;
+	*/
+	register struct stack_entry *se = stack_level_of(L_FORMAL1)->sl_entry;
+	arith f_offset = (arith)0;
+	register int nparams = 0;
+	int hasproto;
+	struct def *df = idf->id_def;
+
+	/* When one of the formals has the same name as the function, 
+	   it hides the function def. Get it.
+	*/
+	while (se) {
+		if (se->se_idf == idf) {
+			df = df->next;
+			break;
+		}
+		se = se->next;
+	}
+
+	se = stack_level_of(L_FORMAL1)->sl_entry;
+	
+	hasproto = df->df_type->tp_proto != 0;
+
+#ifdef	DEBUG
+	if (options['t'])
+		dumpidftab("start declare_formals", 0);
+#endif	/* DEBUG */
+	if (is_struct_or_union(df->df_type->tp_up->tp_fund)) {
+		/* create space for address of return value */
+		f_offset = pointer_size;
+	}
+	while (se)	{
+		df = se->se_idf->id_def;
+		
+		/* this stacklevel may also contain tags. ignore them */
+		if (!df || df->df_level < L_FORMAL1 ) {
+			se = se->next;
+			continue;
+		}
+
+		df->df_address = f_offset;
+		/*	the alignment convention for parameters is: align on
+			word boundaries, i.e. take care that the following
+			parameter starts on a new word boundary.
+		*/
+		if (! hasproto 
+		    && df->df_type->tp_fund == FLOAT
+		    && df->df_type->tp_size != double_size) {
+			f_offset = align(f_offset + double_size, (int) word_size);
+		}
+		else f_offset = align(f_offset + df->df_type->tp_size, (int) word_size);
+		RegisterAccount(df->df_address, df->df_type->tp_size,
+				regtype(df->df_type),
+				df->df_sc);
+		/* cvt int to char or short and double to float, if necessary
+		 */
+		formal_cvt(hasproto, df);
+
+		df->df_level = L_FORMAL2;	/* CJ */
+		if (nparams++ >= STDC_NPARAMS)
+			strict("number of formal parameters exceeds ANSI limit");
+#ifdef DBSYMTAB
+		if (options['g']) {
+			stb_string(df, FORMAL, se->se_idf->id_text);
+		}
+#endif /* DBSYMTAB */
+		se = se->next;
+	}
+	*fp = f_offset;
+}
+
+int
+regtype(tp)
+	struct type *tp;
+{
+	switch(tp->tp_fund) {
+	case INT:
+	case LONG:
+		return reg_any;
+	case FLOAT:
+	case DOUBLE:
+	case LNGDBL:
+		return reg_float;
+	case POINTER:
+		return reg_pointer;
+	}
+	return -1;
+}
+
+add_def(idf, sc, tp, lvl)
+	struct idf *idf;
+	struct type *tp;
+	int lvl;
+	int sc;
+{
+	/*	The identifier idf is declared on level lvl with storage
+		class sc and type tp, through a faked C declaration.
+		This is probably the wrong way to structure the problem,
+		but it will have to do for the time being.
+	*/
+	struct decspecs Ds; struct declarator Dc;
+
+	Ds = null_decspecs;
+	Ds.ds_type = tp;
+	Ds.ds_sc = sc;
+	Dc = null_declarator;
+	Dc.dc_idf = idf;
+	declare_idf(&Ds, &Dc, lvl);
+}
+
+update_ahead(idf)
+	register struct idf *idf;
+{
+	/*	The tk_symb of the token ahead is updated in the light of new
+		information about the identifier idf.
+	*/
+	register int tk_symb = AHEAD;
+
+	if (	(tk_symb == IDENTIFIER || tk_symb == TYPE_IDENTIFIER) &&
+		ahead.tk_idf == idf
+	)
+		AHEAD = idf->id_def && idf->id_def->df_sc == TYPEDEF ?
+				TYPE_IDENTIFIER : IDENTIFIER;
+}
+
+free_formals(fm)
+	register struct formal *fm;
+{
+	while (fm)	{
+		struct formal *tmp = fm->next;
+
+		free_formal(fm);
+		fm = tmp;
+	}
+}

lang/cem/cemcom.ansi/idf.str

@@ -0,0 +1,49 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* IDENTIFIER DESCRIPTOR */
+
+#include	"nopp.h"
+
+struct id_u {
+#ifndef NOPP
+	struct macro *idd_macro;
+	int idd_resmac;		/* if nonzero: keyword of macroproc. 	*/
+#endif /* NOPP */
+	int idd_reserved;	/* non-zero for reserved words		*/
+	char *idd_file;		/* file containing the occurrence	*/
+	unsigned int idd_line;	/* line number of the occurrence	*/
+	struct def *idd_label;	/* labels				*/
+	struct def *idd_def;	/* variables, typedefs, enum-constants	*/
+	struct sdef *idd_sdef;	/* selector tags			*/
+	struct tag *idd_tag;	/* struct, union, and enum tags		*/
+	int idd_special;	/* special action needed at occurrence	*/
+};
+
+#define IDF_TYPE	struct id_u
+#define id_macro	id_user.idd_macro
+#define id_resmac	id_user.idd_resmac
+#define id_reserved	id_user.idd_reserved
+#define id_file		id_user.idd_file
+#define id_line		id_user.idd_line
+#define id_label	id_user.idd_label
+#define id_def		id_user.idd_def
+#define id_sdef		id_user.idd_sdef
+#define id_tag		id_user.idd_tag
+#define id_special	id_user.idd_special
+
+#include <idf_pkg.spec>
+
+#ifndef NOPP
+struct dependency	{
+	struct dependency *next;
+	struct idf *dep_idf;
+};
+
+/* ALLOCDEF "dependency" 10 */
+#endif /* NOPP */
+
+extern int level;
+extern struct idf *gen_idf();

lang/cem/cemcom.ansi/init.c

@@ -0,0 +1,96 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* PREPROCESSOR: INITIALIZATION ROUTINES */
+
+#include	"nopp.h"
+
+#ifndef NOPP
+#include	<system.h>
+#include	<alloc.h>
+#include	<time.h>
+#include	"class.h"
+#include	"macro.h"
+#include	"idf.h"
+
+extern char *sprint();
+
+struct mkey	{
+	char *mk_reserved;
+	int mk_key;
+} mkey[] =	{
+	{"define",	K_DEFINE},
+	{"elif",	K_ELIF},
+	{"else",	K_ELSE},
+	{"endif",	K_ENDIF},
+	{"error",	K_ERROR},
+	{"if",		K_IF},
+	{"ifdef",	K_IFDEF},
+	{"ifndef",	K_IFNDEF},
+	{"include",	K_INCLUDE},
+	{"line",	K_LINE},
+	{"pragma",	K_PRAGMA},
+	{"undef",	K_UNDEF},
+	{0,		K_UNKNOWN}
+};
+
+init_pp()
+{
+	static char *months[12] = {
+		"Jan", "Feb", "Mar", "Apr", "May", "Jun",
+		"Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
+	};
+	long clock, sys_time();
+	static char dbuf[30];
+	static char tbuf[30];
+	struct tm  *tp;
+
+	/*	Initialise the control line keywords (if, include, define, etc)
+		Although the lexical analyzer treats them as identifiers, the
+		control line handler can recognize them as keywords by the
+		id_resmac field of the identifier.
+	*/
+	{
+		register struct mkey *mk = &mkey[0];
+
+		while (mk->mk_reserved)	{
+			register struct idf *idf = str2idf(mk->mk_reserved, 0);
+			
+			if (idf->id_resmac)
+				fatal("maximum identifier length insufficient");
+			idf->id_resmac = mk->mk_key;
+			mk++;
+		}
+	}
+
+	/*	Initialize __LINE__, __FILE__, __DATE__, __TIME__,
+		and __STDC__ macro definitions.
+	*/
+	clock = sys_time();
+	tp = localtime(&clock);
+
+	/* __DATE__ */
+	sprint(dbuf, "\"%s %02d %d\"", months[tp->tm_mon],
+			tp->tm_mday, tp->tm_year+1900);
+	if (tp->tm_mday < 10) dbuf[5] = ' ';		/* hack */
+	macro_def(str2idf("__DATE__", 0), dbuf, -1, strlen(dbuf), NOUNDEF);
+
+	/* __TIME__ */
+	sprint(tbuf, "\"%02d:%02d:%02d\"", tp->tm_hour, tp->tm_min, tp->tm_sec);
+	macro_def(str2idf("__TIME__", 0), tbuf, -1, strlen(tbuf), NOUNDEF);
+
+	/* __LINE__	*/
+	macro_def(str2idf("__LINE__", 0), "0", -1, 1, NOUNDEF | FUNC);
+
+	/* __FILE__	*/
+	macro_def(str2idf("__FILE__", 0), "", -1, 1, NOUNDEF | FUNC);
+
+	/* __STDC__ */
+	macro_def(str2idf("__STDC__", 0), "1", -1, 1, NOUNDEF);
+
+	/* defined(??) */
+	macro_def(str2idf("defined", 0), "", 1, 1, NOUNDEF | FUNC);
+}
+#endif /* NOPP */

lang/cem/cemcom.ansi/input.c

@@ -0,0 +1,91 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+
+#include "inputtype.h"
+#include "file_info.h"
+#include "input.h"
+
+#define INP_PUSHBACK	3
+#define INP_TYPE	struct file_info
+#define INP_VAR		finfo
+struct file_info	finfo;
+#include "nopp.h"
+#include <inp_pkg.body>
+#include <alloc.h>
+
+#include        "dbsymtab.h"
+#include	"lint.h"
+#ifndef NOPP
+#ifdef DBSYMTAB
+#include <stb.h>
+#include <em.h>
+extern int      IncludeLevel;
+extern char	options[];
+#endif
+
+char *
+getwdir(fn)
+	register char *fn;
+{
+	register char *p;
+	char *strrindex();
+
+	p = strrindex(fn, '/');
+	while (p && *(p + 1) == '\0') {	/* remove trailing /'s */
+		*p = '\0';
+		p = strrindex(fn, '/');
+	}
+
+	if (fn[0] == '\0' || (fn[0] == '/' && p == &fn[0])) /* absolute path */
+		return "";
+	if (p) {
+		*p = '\0';
+		fn = Salloc(fn,(unsigned) (p - &fn[0] + 1));
+		*p = '/';
+		return fn;
+	}
+	return "";
+}
+
+int	InputLevel;
+extern int		nestlevel;
+#endif /* NOPP */
+
+int	NoUnstack;
+
+AtEoIT()
+{
+#ifndef NOPP
+	InputLevel--;
+	unstackrepl();
+#endif /* NOPP */
+	return 0;
+}
+
+extern char *source;
+
+AtEoIF()
+{
+#ifndef NOPP
+	if (nestlevel != nestlow) lexwarning("missing #endif");
+	else
+#endif /* NOPP */
+	if (NoUnstack) lexerror("unexpected EOF");
+#ifndef NOPP
+	nestlevel = nestlow;
+#ifdef DBSYMTAB
+	if (options['g'] && IncludeLevel > 0) {
+		C_ms_stb_cst(FileName, N_EINCL, 0, (arith) 0);
+	}
+	IncludeLevel--;
+#endif
+	if (WorkingDir[0] != '\0') free(WorkingDir);
+#endif /* NOPP */
+#ifndef LINT
+	if (FileName != source) free(FileName);
+#endif
+	return 0;
+}

lang/cem/cemcom.ansi/input.h

@@ -0,0 +1,15 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+#define INP_PUSHBACK 3
+
+#include <inp_pkg.spec>
+
+/*	Note: The following macro only garuantees one PushBack.
+*/
+#define UnGetChar()	((LexSave != EOI) ? ChPushBack(LexSave) : 0)
+
+extern	int LexSave;	/* last character read by GetChar		*/
+extern 	int GetChar();	/* character input, with trigraph parsing	*/

lang/cem/cemcom.ansi/interface.h

@@ -0,0 +1,8 @@
+/* $Id$ */
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+#define PRIVATE	static		/* or not */
+#define IMPORT	extern
+#define EXPORT

lang/cem/cemcom.ansi/ival.g

@@ -0,0 +1,766 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* CODE FOR THE INITIALISATION OF GLOBAL VARIABLES */
+
+{
+#include	"lint.h"
+#ifndef	LINT
+#include	<em.h>
+#else
+#include	"l_em.h"
+#include	"l_lint.h"
+#endif	/* LINT */
+#include	"debug.h"
+#include	<alloc.h>
+#include	<assert.h>
+#include	"nobitfield.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"type.h"
+#include	"proto.h"
+#include	"struct.h"
+#include	"field.h"
+#include	"assert.h"
+#include	"Lpars.h"
+#include	"sizes.h"
+#include	"align.h"
+#include	"idf.h"
+#include	"level.h"
+#include	"def.h"
+#include	"LLlex.h"
+#include	"estack.h"
+
+#define con_nullbyte()	C_con_ucon("0", (arith)1)
+#define aggregate_type(tp) ((tp)->tp_fund == ARRAY || (tp)->tp_fund == STRUCT)
+
+char *long2str();
+char *strncpy();
+extern char options[];
+static int gen_error;
+static int pack_level;
+struct type **gen_tphead(), **gen_tpmiddle();
+struct sdef *gen_align_to_next();
+struct e_stack *p_stack;
+}
+
+/* initial_value recursively guides the initialisation expression.
+ */
+/* 3.5 */
+
+initial_value(register struct type **tpp; register struct expr **expp;) :
+	{ if (tpp) gen_tpcheck(tpp); }
+[
+		{ if (pack_level == 0) gen_error = 0; }
+	assignment_expression(expp)
+		{
+#ifdef	LINT
+			lint_expr(*expp, USED);
+#endif	/* LINT */
+			if ((*expp)->ex_type->tp_fund == ARRAY)
+				array2pointer(*expp);
+			if (tpp) {
+				if (level >= L_LOCAL
+				    || is_ld_cst(*expp)
+				    || is_fp_cst(*expp)
+				    || (*expp)->ex_class == String) {
+					gen_simple_exp(tpp, expp);
+					free_expression(*expp);
+					*expp = 0;
+				} else {
+					expr_error(*expp,"illegal initialization");
+					free_expression(*expp);
+					*expp = 0;
+				}
+			}
+		}
+|
+	initial_value_pack(tpp, expp)
+]
+;
+
+initial_value_pack(struct type **tpp; struct expr **expp;)
+:
+	'{'
+			{ if (pack_level == 0) gen_error = 0; pack_level++; }
+	initial_value_list(tpp, expp)
+			{ pack_level--;
+			  if (!pack_level) {
+				while (p_stack) {
+					struct e_stack *p = p_stack->next;
+
+					free_e_stack(p_stack);
+					p_stack = p;
+				}
+			  }
+			  if (pack_level < gen_error) gen_error = 0;
+			}
+	'}'
+;
+
+initial_value_list(register struct type **tpp; struct expr **expp;)
+	{ struct expr *e1;
+	  register struct type **tpp2 = 0;
+	  int err_flag = gen_error;
+	}
+:
+			{ if (tpp) tpp2 = gen_tphead(tpp, 0); }
+	initial_value(tpp2, &e1)
+			{ if (!tpp) init_expression(&expp, e1); }
+	[%while (AHEAD != '}')		/* >>> conflict on ',' */
+		','
+			{ if (tpp) tpp2 = gen_tpmiddle(); }
+		initial_value(tpp2, &e1)
+			{ if (!tpp) init_expression(&expp, e1); }
+	]*
+			{ if (tpp && ! err_flag) gen_tpend(); }
+	','?				/* optional trailing comma */
+;
+
+{
+gen_tpcheck(tpp)
+	struct type **tpp;
+{
+	register struct type *tp;
+
+	if (gen_error) return;
+	switch((tp = *tpp)->tp_fund) {
+	case ARRAY:
+		if (! valid_type(tp->tp_up, "array element"))
+			gen_error = pack_level;
+		break;
+	case STRUCT:
+		if (! valid_type(tp, "struct"))
+			gen_error = pack_level;
+		break;
+	case UNION:
+		if (! valid_type(tp, "union"))
+			gen_error = pack_level;
+		break;
+	case ERRONEOUS:
+		if (! gen_error) gen_error = pack_level;
+		break;
+	}
+}
+
+gen_simple_exp(tpp, expp)
+	struct type **tpp;
+	struct expr **expp;
+{
+	register struct type *tp;
+
+	if (gen_error) return;
+	tp = *tpp;
+	switch(tp->tp_fund) {
+	case ARRAY:
+		if ((*expp)->ex_class == String && tp->tp_up->tp_fund == CHAR) {
+			ch_array(tpp,*expp);
+			break;
+		}
+		/* Fall through */
+	case UNION:
+	case STRUCT:
+		check_and_pad(expp, tpp);
+		break;
+	case ERRONEOUS:
+	case FUNCTION:
+	case VOID:
+		gen_error = pack_level;
+		break;
+	default:
+		check_ival(expp, tp);
+		break;
+	}
+}
+
+struct type **
+arr_elem(tpp, p)
+	struct type **tpp;
+	struct e_stack *p;
+{
+	register struct type *tp = *tpp;
+
+	if (tp->tp_up->tp_fund == CHAR && AHEAD == STRING && p->elem_count == 1) {
+		p->nelem = 1;
+		return tpp;
+	}
+	if (AHEAD == '{' || (! aggregate_type(tp->tp_up) && tp->tp_up->tp_fund != UNION))
+		return &(tp->tp_up);
+	return gen_tphead(&(tp->tp_up), 1);
+}
+
+struct sdef *
+next_field(sd, p)
+	register struct sdef *sd;
+	register struct e_stack *p;
+{
+	if (sd->sd_sdef)
+		p->bytes_upto_here += zero_bytes(sd);
+	p->bytes_upto_here +=
+		size_of_type(sd->sd_type, "selector");
+	p->last_offset = sd->sd_offset;
+	return sd->sd_sdef;
+}
+
+struct type **
+gen_tphead(tpp, nest)
+	struct type **tpp;
+{
+	register struct type *tp = *tpp;
+	register struct e_stack *p;
+	register struct sdef *sd;
+
+	if (tpp && *tpp == error_type) {
+		gen_error = pack_level;
+		return 0;
+	}
+	if (gen_error) return tpp;
+	if (tp->tp_fund == UNION) {
+		/* Here, we saw a {, which could be the start of a union
+		   initializer. It could, however, also be the start of the
+		   initializer for the first union field ...
+		*/
+		sd = tp->tp_sdef;
+		if (AHEAD != '{' &&
+		    (aggregate_type(sd->sd_type) || 
+		     sd->sd_type->tp_fund == UNION)) {
+			/* In this case, assume that it is the start of the
+			   initializer of the union field, so:
+			*/
+			return gen_tphead(&(tp->tp_sdef->sd_type), nest);
+		}
+	}
+	p = new_e_stack();
+	p->next = p_stack;
+	p_stack = p;
+	p->s_nested = nest;
+	p->s_tpp = tpp;
+	switch(tp->tp_fund) {
+	case UNION:
+		p->s_def = sd = tp->tp_sdef;
+		p->bytes_upto_here = 0;
+		return &(sd->sd_type);
+	case ARRAY:
+		p->nelem = -1;
+		p->elem_count = 1;
+		if (tp->tp_size != (arith) -1) {
+			p->nelem = (tp->tp_size / tp->tp_up->tp_size);
+		}
+		return arr_elem(tpp, p);
+	case STRUCT:
+		p->s_def = sd = tp->tp_sdef;
+		p->bytes_upto_here = 0;
+		p->last_offset = -1;
+#ifndef NOBITFIELD
+		while (sd && is_anon_idf(sd->sd_idf)) {
+			put_bf(sd->sd_type, (arith) 0);
+			sd = next_field(sd, p);
+		}
+#endif
+		if (! sd) {
+			/* something wrong with this struct */
+			gen_error = pack_level;
+			p_stack = p->next;
+			free_e_stack(p);
+			return 0;
+		}
+		p->s_def = sd;
+		if (AHEAD != '{' && aggregate_type(sd->sd_type)) {
+			return gen_tphead(&(sd->sd_type), 1);
+		}
+		return &(sd->sd_type);
+	case ERRONEOUS:
+		if (! gen_error) gen_error = pack_level;
+		/* fall through */
+	default:
+		p->nelem = 1;
+		p->elem_count = 1;
+		return tpp;
+	}
+}
+
+struct type **
+gen_tpmiddle()
+{
+	register struct type *tp;
+	register struct sdef *sd;
+	register struct e_stack *p = p_stack;
+
+	if (gen_error) {
+		if (p) return p->s_tpp;
+		return 0;
+	}
+again:
+	tp = *(p->s_tpp);
+	switch(tp->tp_fund) {
+	case ERRONEOUS:
+		if (! gen_error) gen_error = pack_level;
+		return p->s_tpp;
+	case UNION:
+		sd = p->s_def;
+		p->bytes_upto_here +=
+			size_of_type(sd->sd_type, "selector");
+		return p->s_tpp;
+	default:
+		if (p->elem_count == p->nelem && p->s_nested) {
+			p = p->next;
+			free_e_stack(p_stack);
+			p_stack = p;
+			goto again;
+		}
+		p->elem_count++;
+		if (p->nelem >= 0 && p->elem_count > p->nelem) {
+			too_many_initialisers();
+			return p->s_tpp;
+		}
+		if (tp->tp_fund == ARRAY) {
+			return arr_elem(p->s_tpp, p);
+		}
+		return p->s_tpp;
+	case STRUCT:
+		sd = gen_align_to_next(p);
+		if (! sd) {
+			while (p->bytes_upto_here++ < tp->tp_size)
+				con_nullbyte();
+			if (p->s_nested) {
+				p = p->next;
+				free_e_stack(p_stack);
+				p_stack = p;
+				goto again;
+			}
+			too_many_initialisers();
+			return p->s_tpp;
+		}
+		if (AHEAD != '{' && aggregate_type(sd->sd_type)) {
+			return gen_tphead(&(sd->sd_type), 1);
+		}
+		return &(sd->sd_type);
+	}
+}
+
+struct sdef *
+gen_align_to_next(p)
+	register struct e_stack *p;
+{
+	register struct sdef *sd = p->s_def;
+
+	if (! sd) return sd;
+#ifndef NOBITFIELD
+	do {
+		if (is_anon_idf(sd->sd_idf)) put_bf(sd->sd_type, (arith) 0);
+#endif
+		sd = next_field(sd, p);
+#ifndef NOBITFIELD
+	} while (sd && is_anon_idf(sd->sd_idf));
+#endif
+	p->s_def = sd;
+	return sd;
+}
+
+gen_tpend()
+{
+	register struct e_stack *p = p_stack;
+	register struct type *tp;
+	register struct sdef *sd;
+	int getout = 0;
+
+	while (!getout && p) {
+	    if (!gen_error) {
+		tp = *(p->s_tpp);
+		switch(tp->tp_fund) {
+		case UNION:
+			sd = p->s_def;
+			p->bytes_upto_here +=
+				size_of_type(sd->sd_type, "selector");
+			while (p->bytes_upto_here++ < tp->tp_size)
+				con_nullbyte();
+			break;
+		case ARRAY:
+			if (tp->tp_size == -1) {
+				*(p->s_tpp) = construct_type(ARRAY, tp->tp_up,
+					0, p->elem_count, NO_PROTO);
+			}
+			else {
+				while (p->nelem-- > p->elem_count) {
+					pad(tp->tp_up);
+				}
+			}
+			break;
+		case STRUCT:
+			sd = gen_align_to_next(p);
+			while (sd) {
+				pad(sd->sd_type);
+				if (sd->sd_sdef)
+					p->bytes_upto_here += zero_bytes(sd);
+				p->bytes_upto_here +=
+					size_of_type(sd->sd_type, "selector");
+				sd = sd->sd_sdef;
+			}
+			while (p->bytes_upto_here++ < tp->tp_size)
+				con_nullbyte();
+			break;
+		}
+	    }
+	    if (! p->s_nested) getout = 1;
+	    p = p->next;
+	    free_e_stack(p_stack);
+	    p_stack = p;
+	}
+}
+
+/*	check_and_pad() is given a simple initialisation expression
+	where the type can be either a simple or an aggregate type.
+	In the latter case, only the first member is initialised and
+	the rest is zeroed.
+*/
+check_and_pad(expp, tpp)
+	struct type **tpp;
+	struct expr **expp;
+{
+	register struct type *tp = *tpp;
+
+	if (tp->tp_fund == ARRAY) {
+		check_and_pad(expp, &(tp->tp_up));	/* first member	*/
+		if (tp->tp_size == (arith)-1)
+			/*	no size specified upto here: just
+				set it to the size of one member.
+			*/
+			tp = *tpp = construct_type(ARRAY, tp->tp_up,
+					0, (arith)1, NO_PROTO);
+		else {
+			register int dim = tp->tp_size / tp->tp_up->tp_size;
+			/* pad remaining members with zeroes */
+			while (--dim > 0)
+				pad(tp->tp_up);
+		}
+	}
+	else
+	if (tp->tp_fund == STRUCT) {
+		register struct sdef *sd = tp->tp_sdef;
+
+		check_and_pad(expp, &(sd->sd_type));
+		/* next selector is aligned by adding extra zeroes */
+		if (sd->sd_sdef)
+			zero_bytes(sd);
+		while (sd = sd->sd_sdef) { /* pad remaining selectors	*/
+			pad(sd->sd_type);
+			if (sd->sd_sdef)
+				zero_bytes(sd);
+		}
+	}
+	else if (tp->tp_fund == UNION) {
+		/* only the first selector can be initialized */
+		register struct sdef *sd = tp->tp_sdef;
+
+		check_and_pad(expp, &(sd->sd_type));
+	}
+	else	/* simple type	*/
+		check_ival(expp, tp);
+}
+
+/*	pad() fills an element of type tp with zeroes.
+	If the element is an aggregate, pad() is called recursively.
+*/
+pad(tpx)
+	struct type *tpx;
+{
+	register struct type *tp = tpx;
+	register arith sz = tp->tp_size;
+
+	gen_tpcheck(&tpx);
+	if (gen_error) return;
+#ifndef NOBITFIELD
+	if (tp->tp_fund == FIELD) {
+		put_bf(tp, (arith)0);
+		return;
+	}
+#endif /* NOBITFIELD */
+
+	if (tp->tp_align >= word_align) while (sz >= word_size) {
+		C_con_cst((arith) 0);
+		sz -= word_size;
+	}
+	while (sz) {
+		C_con_icon("0", (arith) 1);
+		sz--;
+	}
+}
+
+/*	check_ival() checks whether the initialisation of an element
+	of a fundamental type is legal and, if so, performs the initialisation
+	by directly generating the necessary code.
+	No further comment is needed to explain the internal structure
+	of this straightforward function.
+*/
+check_ival(expp, tp)
+	register struct type *tp;
+	struct expr **expp;
+{
+	/*	The philosophy here is that ch3cast puts an explicit
+		conversion node in front of the expression if the types
+		are not compatible.  In this case, the initialisation
+		expression is no longer a constant.
+	*/
+	register struct expr *expr = *expp;
+	
+	switch (tp->tp_fund) {
+	case CHAR:
+	case SHORT:
+	case INT:
+	case LONG:
+	case ENUM:
+	case POINTER:
+		ch3cast(expp, '=', tp);
+		expr = *expp;
+#ifdef DEBUG
+		print_expr("init-expr after cast", expr);
+#endif /* DEBUG */
+		if (!is_ld_cst(expr))
+			illegal_init_cst(expr);
+		else
+		if (expr->VL_CLASS == Const)
+			con_int(expr);
+		else
+		if (expr->VL_CLASS == Name) {
+			register struct idf *idf = expr->VL_IDF;
+
+			if (idf->id_def->df_level >= L_LOCAL
+			    && idf->id_def->df_sc != GLOBAL
+			    && idf->id_def->df_sc != EXTERN) {
+				illegal_init_cst(expr);
+			}
+			else	/* e.g., int f(); int p = f; */
+			if (idf->id_def->df_type->tp_fund == FUNCTION)
+				C_con_pnam(idf->id_text);
+			else	/* e.g., int a; int *p = &a; */
+				C_con_dnam(idf->id_text, expr->VL_VALUE);
+		}
+		else {
+			ASSERT(expr->VL_CLASS == Label);
+			C_con_dlb(expr->VL_LBL, expr->VL_VALUE);
+		}
+		break;
+	case FLOAT:
+	case DOUBLE:
+	case LNGDBL:
+		ch3cast(expp, '=', tp);
+		expr = *expp;
+#ifdef DEBUG
+		print_expr("init-expr after cast", expr);
+#endif /* DEBUG */
+		if (expr->ex_class == Float) {
+			char buf[FLT_STRLEN];
+
+			flt_flt2str(&(expr->FL_ARITH), buf, FLT_STRLEN);
+			C_con_fcon(buf, expr->ex_type->tp_size);
+		}
+#ifdef NOTDEF
+
+Coercion from int to float is now always done compile time.
+This, to accept declarations like
+double	x = -(double)1;
+and also to prevent runtime coercions for compile-time constants.
+
+		else
+		if (expr->ex_class == Oper && expr->OP_OPER == INT2FLOAT) {
+			/* float f = 1; */
+			expr = expr->OP_RIGHT;
+			if (is_cp_cst(expr))
+				C_con_fcon(long2str((long)expr->VL_VALUE, 10),
+					tp->tp_size);
+			else 
+				illegal_init_cst(expr);
+		}
+#endif /* NOTDEF */
+		else
+			illegal_init_cst(expr);
+		break;
+
+#ifndef NOBITFIELD
+	case FIELD:
+		ch3cast(expp, '=', tp->tp_up);
+		expr = *expp;
+#ifdef DEBUG
+		print_expr("init-expr after cast", expr);
+#endif /* DEBUG */
+		if (is_cp_cst(expr))
+			put_bf(tp, expr->VL_VALUE);
+		else
+			illegal_init_cst(expr);
+		break;
+#endif /* NOBITFIELD */
+
+	case ERRONEOUS:
+		if (! gen_error) gen_error = pack_level;
+		/* fall through */
+	case VOID:
+		break;
+	default:
+		crash("check_ival");
+		/*NOTREACHED*/
+	}
+}
+
+/*	ch_array() initialises an array of characters when given
+	a string constant.
+	Alignment is taken care of.
+*/
+ch_array(tpp, ex)
+	struct type **tpp;	/* type tp = array of characters	*/
+	struct expr *ex;
+{
+	register struct type *tp = *tpp;
+	register int length = ex->SG_LEN, i;
+	register char *to, *from, *s;
+
+	ASSERT(ex->ex_class == String);
+	if (tp->tp_size == (arith)-1) {
+		/* set the dimension	*/
+		tp = *tpp = construct_type(ARRAY, tp->tp_up, 0, (arith)length, NO_PROTO);
+	}
+	else {
+		arith dim = tp->tp_size / tp->tp_up->tp_size;
+
+#ifdef LINT
+		if (length == dim + 1) {
+			    expr_warning(ex, "array is not null-terminated");
+		} else
+#endif
+		if (length > dim + 1) {
+			expr_strict(ex, "too many initializers");
+		}
+		length = dim;
+	}
+	/* throw out the characters of the already prepared string	*/
+	s = Malloc((unsigned) (length));
+	clear(s, (unsigned)length);
+	i = length <= ex->SG_LEN ? length : ex->SG_LEN;
+	to = s; from = ex->SG_VALUE;
+	while(--i >= 0) {
+		*to++ = *from++;
+	}
+	free(ex->SG_VALUE);
+	str_cst(s, length, 0);		/* a string, but not in rom */
+	free(s);
+}
+
+/*	As long as some parts of the pipeline cannot handle very long string
+	constants, string constants are written out in chunks
+*/
+str_cst(str, len, inrom)
+	register char *str;
+	register int len;
+	int inrom;
+{
+	int chunksize = ((127 + (int) word_size) / (int) word_size) * (int) word_size;
+
+	while (len > chunksize) {
+		if (inrom)
+			C_rom_scon(str, (arith) chunksize);
+		else	C_con_scon(str, (arith) chunksize);
+		len -= chunksize;
+		str += chunksize;
+	}
+	if (inrom)
+		C_rom_scon(str, (arith) len);
+	else	C_con_scon(str, (arith) len);
+}
+
+#ifndef NOBITFIELD
+/*	put_bf() takes care of the initialisation of (bit-)field
+	selectors of a struct: each time such an initialisation takes place,
+	put_bf() is called instead of the normal code generating routines.
+	Put_bf() stores the given integral value into "field" and
+	"throws" the result of "field" out if the current selector
+	is the last of this number of fields stored at the same address.
+*/
+put_bf(tp, val)
+	struct type *tp;
+	arith val;
+{
+	static long field = (arith)0;
+	static arith offset = (arith)-1;
+	register struct field *fd = tp->tp_field;
+	register struct sdef *sd =  fd->fd_sdef;
+	static struct expr exp;
+
+	ASSERT(sd);
+	if (offset == (arith)-1) {
+		/* first bitfield in this field	*/
+		offset = sd->sd_offset;
+		exp.ex_type = tp->tp_up;
+		exp.ex_class = Value;
+		exp.VL_CLASS = Const;
+	}
+	if (val != 0)	/* insert the value into "field"	*/
+		field |= (val & fd->fd_mask) << fd->fd_shift;
+	if (sd->sd_sdef == 0 || sd->sd_sdef->sd_offset != offset) {
+		/* the selector was the last stored at this address	*/
+		exp.VL_VALUE = field;
+		con_int(&exp);
+		field = (arith)0;
+		offset = (arith)-1;
+	}
+}
+#endif /* NOBITFIELD */
+
+int
+zero_bytes(sd)
+	register struct sdef *sd;
+{
+	/*	fills the space between a selector of a struct
+		and the next selector of that struct with zero-bytes.
+	*/
+	register int n = sd->sd_sdef->sd_offset - sd->sd_offset -
+		size_of_type(sd->sd_type, "struct member");
+	int count = n;
+
+	while (n-- > 0)
+		con_nullbyte();
+	return count;
+}
+
+int
+valid_type(tp, str)
+	struct type *tp;
+	char *str;
+{
+	ASSERT(tp!=(struct type *)0);
+	if (tp->tp_size < 0) {
+		error("size of %s unknown", str);
+		return 0;
+	}
+	return 1;
+}
+
+con_int(ex)
+	register struct expr *ex;
+{
+	register struct type *tp = ex->ex_type;
+
+	ASSERT(is_cp_cst(ex));
+	if (tp->tp_unsigned)
+		C_con_ucon(long2str((long)ex->VL_VALUE, -10), tp->tp_size);
+	else if (tp->tp_size == word_size)
+		C_con_cst(ex->VL_VALUE);
+	else
+		C_con_icon(long2str((long)ex->VL_VALUE, 10), tp->tp_size);
+}
+
+illegal_init_cst(ex)
+	struct expr *ex;
+{
+	expr_error(ex, "illegal initialization constant");
+	gen_error = pack_level;
+}
+
+too_many_initialisers()
+{
+	error("too many initializers");
+	gen_error = pack_level;
+}
+}

lang/cem/cemcom.ansi/l_brace.str

@@ -0,0 +1,28 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+
+/*	To determine the minimum scope of a local variable, all (braced)
+	scopes are numbered consecutively.  Next we maintain an array which
+	maps the nesting depth (level) onto the scope number; we record
+	the scope number of the first application of a local variable
+	in its definition.  Each further application requires that the
+	level of the variable be at least large enough to comprise both
+	the present scope and that of its first application.  That level
+	number is determined by searching the array and is then recorded in
+	the definition (beacuse it is always equal to or smaller than the
+	level already there).
+
+	The array is implemented as a linked list of struct brace.
+*/
+
+struct brace	{
+	struct brace *next;
+	int br_count;
+	int br_level;
+};
+
+/* ALLOCDEF "brace" 10 */
+

lang/cem/cemcom.ansi/l_class.h

@@ -0,0 +1,28 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+
+/*	Lint class constants	*/
+
+#define	LFDF	'a'	/* Library Function Definition */
+#define	LVDF	'b'	/* Library Variable Definition */
+
+#define	PFDF	'd'	/* Prototype Function Definition */
+
+#define	EFDF	'f'	/* External Function Definition */
+#define	EVDF	'g'	/* External Variable Definition */
+#define	EFDC	'h'	/* External Function Declaration */
+#define	EVDC	'i'	/* External Variable Declaration */
+
+#define	IFDC	'm'	/* Implicit Function Declaration */
+
+#define	SFDF	'q'	/* Static Function Definition */
+#define	SVDF	'r'	/* Static Variable Definition */
+
+#define	FC	'u'	/* Function Call */
+#define	VU	'v'	/* Variable Usage */
+
+#define	XXDF	'z'	/* Ignore Class */
+

lang/cem/cemcom.ansi/l_comment.c

@@ -0,0 +1,211 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	Lint-specific comment handling	*/
+
+#include	<ctype.h>
+
+#include	"lint.h"
+
+#ifdef	LINT
+
+#include	<alloc.h>
+#include	"interface.h"
+#include	"arith.h"
+#include	"l_state.h"
+#include	"l_comment.h"
+
+extern char loptions[];
+
+/*	Since the lexical analyser does a one-token look-ahead, pseudo-
+	comments are read too soon.  This is remedied by first storing them
+	in static variables and then moving them to the real variables
+	one token later.
+*/
+
+PRIVATE int notreached;
+PRIVATE int varargsN = -1;
+PRIVATE int argsused;
+PRIVATE int formatN;
+PRIVATE int formatVAR;
+PRIVATE char *format;
+PRIVATE char *prev_format;
+
+PRIVATE make_format();
+
+int LINTLIB;				/* file is lint library */
+int s_NOTREACHED;			/* statement not reached */
+int f_VARARGSn;				/* function with variable # of args */
+int f_ARGSUSED;				/* function does not use all args */
+int f_FORMATn;				/* argument f_FORMATn is f_FORMAT */
+char *f_FORMAT;
+int f_FORMATvar;			/* but the formal argument may be
+					   absent because of varargs.h */
+
+lint_init_comment()
+{
+	LINTLIB = loptions['L'];
+}
+
+lint_comment_ahead()
+{
+	s_NOTREACHED = notreached;
+	notreached = 0;
+}
+
+lint_comment_function()
+{
+	f_ARGSUSED = argsused | loptions['v'];
+	argsused = 0;
+
+	f_VARARGSn = varargsN;
+	varargsN = -1;
+
+	f_FORMATn = formatN;
+	formatN = 0;
+	f_FORMAT = format;
+	if (format)
+		prev_format = format;
+	format = 0;
+
+	f_FORMATvar = formatVAR;
+	formatVAR = 0;
+}
+
+PRIVATE char buf[1000];
+PRIVATE char *bufpos;			/* next free position in buf */
+
+lint_start_comment()
+{
+	bufpos = &buf[0];
+}
+
+lint_comment_char(c)
+	int c;
+{
+/* This function is called with every character between /_* and *_/ */
+	if (bufpos - &buf[0] < sizeof(buf)-1)
+		*bufpos++ = (char)c;
+}
+
+lint_end_comment()
+{
+	*bufpos++ = '\0';
+	bufpos = &buf[0];
+
+	/* skip initial blanks */
+	while (*bufpos && isspace(*bufpos)) {
+		bufpos++;
+	}
+
+	/* now test for one of the pseudo-comments */
+	if (strncmp(bufpos, "NOTREACHED", 10) == 0) {
+		notreached = 1;
+	}
+	else
+	if (strncmp(bufpos, "ARGSUSED", 8) == 0) {
+		argsused = 1;
+	}
+	else
+	if (strncmp(bufpos, "LINTLIBRARY", 11) == 0) {
+		LINTLIB = 1;
+	}
+	else
+	if (strncmp(bufpos, "VARARGS", 7) == 0) {
+		bufpos += 7;
+		varargsN = isdigit(*bufpos) ? atoi(bufpos) : 0;
+	}
+	else
+	if (strncmp(bufpos, "FORMAT", 6) == 0 && isdigit(bufpos[6])) {
+		register int argn;
+
+		bufpos += 6;
+		argn = *bufpos++ - '0';
+		varargsN = argn + 1;
+		if (*bufpos == 'v') {
+			/* something like FORMAT3v */
+			formatVAR = 1;
+			bufpos++;
+		}
+		make_format(argn, bufpos);
+		
+	}
+}
+
+/*	We use a small FSA to skip layout inside formats, but to preserve
+	a space between letters and digits.
+*/
+
+#define	NONE		0
+#define	LETGIT		1
+#define	LETGITSPACE	2
+
+PRIVATE
+make_format(argn, oldf)
+	int argn;
+	char *oldf;
+{
+	register char *newf;
+	register int last_stat;
+
+	while (*oldf && *oldf != '$') {
+		oldf++;
+	}
+	if (!*oldf) {
+		/* no format given, repeat previous format */
+		if (!prev_format) {
+			warning("format missing and no previous format");
+		}
+		formatN = argn;
+		format = prev_format;
+		return;
+	}
+	if (*oldf++ != '$') {
+		warning("no format in FORMAT pseudo-comment");
+		format = 0;
+		return;
+	}
+
+	/* there is a new format to be composed */
+	newf = Malloc(strlen(oldf));
+		/* certainly enough and probably not overly too much */
+	formatN = argn;
+	format = newf;
+
+	last_stat = NONE;
+	while (*oldf && *oldf != '$') {
+		register char ch = *oldf++;
+
+		if (isspace(ch)) {
+			if (last_stat == LETGIT)
+				last_stat = LETGITSPACE;
+		}
+		else
+		if (isalnum(ch)) {
+			switch (last_stat) {
+			case NONE:
+				last_stat = LETGIT;
+				break;
+			case LETGITSPACE:
+				*newf++ = ' ';
+				last_stat = LETGIT;
+				break;
+			}
+			*newf++ = ch;
+		}
+		else {
+			last_stat = NONE;
+			*newf++ = ch;
+		}
+	}
+	if (*oldf != '$') {
+		warning("no end of format in FORMAT pseudo-comment");
+		format = 0;
+		return;
+	}
+	*newf++ = '\0';
+}
+
+#endif	/* LINT */

lang/cem/cemcom.ansi/l_comment.h

@@ -0,0 +1,15 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+
+extern int LINTLIB;			/* file is lint library */
+extern int s_NOTREACHED;		/* statement not reached */
+extern int f_VARARGSn;			/* function with variable # of args */
+extern int f_ARGSUSED;			/* function does not use all args */
+extern int f_FORMATn;			/* argument f_FORMATn is f_FORMAT */
+extern char *f_FORMAT;
+extern int f_FORMATvar;			/* but the formal argument may be
+					   absent because of varargs.h */
+

lang/cem/cemcom.ansi/l_dummy.c

@@ -0,0 +1,74 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Header$ */
+
+/*
+ *The following functions are hacked to null-functions (i.e. they
+ * do nothing). This needs another solution in the future.
+ */
+#include	"lint.h"
+
+#ifdef	LINT
+
+#include	"arith.h"
+#include	"label.h"
+
+C_close(){}
+int C_busy(){return 0;}
+
+
+/* More routines */
+/* ARGSUSED */
+CC_bhcst(ps_xxx,n,w,i) arith n,w; {}
+/* ARGSUSED */
+CC_crcst(ps_xxx,v) arith v; {}
+/* ARGSUSED */
+CC_crdlb(ps_xxx,v,s) label v; arith s; {}
+/* ARGSUSED */
+CC_crdnam(ps_xxx,v,s) char *v; arith s; {}
+/* ARGSUSED */
+CC_crfcon(ps_xxx,v,s) char *v; arith s; {}
+/* ARGSUSED */
+CC_cricon(ps_xxx,v,s) char *v; arith s; {}
+/* ARGSUSED */
+CC_crilb(ps_xxx,v) label v; {}
+/* ARGSUSED */
+CC_crpnam(ps_xxx,v) char *v; {}
+/* ARGSUSED */
+CC_crscon(ps_xxx,v,s) char *v; arith s; {}
+/* ARGSUSED */
+CC_crucon(ps_xxx,v,s) char *v; arith s; {}
+/* ARGSUSED */
+CC_cst(l) {}
+/* ARGSUSED */
+CC_dfdlb(l) label l; {}
+/* ARGSUSED */
+CC_dfdnam(s) char *s; {}
+/* ARGSUSED */
+CC_dfilb(l) label l; {}
+/* ARGSUSED */
+CC_end(l) arith l; {}
+CC_msend() {}
+/* ARGSUSED */
+CC_msstart(ms) {}
+/* ARGSUSED */
+CC_opcst(op_xxx,c) arith c; {}
+/* ARGSUSED */
+CC_opdlb(op_xxx,g,o) label g; arith o; {}
+/* ARGSUSED */
+CC_opilb(op_xxx,b) label b; {}
+/* ARGSUSED */
+CC_oppnam(op_xxx,p) char *p; {}
+/* ARGSUSED */
+CC_pronarg(s) char *s; {}
+/* ARGSUSED */
+CC_psdlb(ps_xxx,l) label l; {}
+/* ARGSUSED */
+CC_psdnam(ps_xxx,s) char *s; {}
+/* ARGSUSED */
+CC_pspnam(ps_xxx,s) char *s; {}
+/* ARGSUSED */
+CC_scon(v,s) char *s; {}
+#endif	LINT

lang/cem/cemcom.ansi/l_em.h

@@ -0,0 +1,77 @@
+/*
+ * (c) copyright 1990 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+
+/*
+ * This file can be considered the em_code.h file of lint.
+ * Those code generating functions that are used by cem and that have not
+ * been defined away by #ifdef LINT, are defined away here. Note that this a
+ * fairly random collection. E.g. it does not include C_open(), since the
+ * standard C-open() C_close() sequence is protected by #ifdef LINT, but it
+ * does include C_close() since the latter is also called in other places,
+ * to terminate the compilation process.
+ */
+
+#define	store_block(sz, al)
+#define	load_block(sz, al)
+
+#define	C_asp(c)
+#define	C_bra(b)
+#define	C_cal(p)
+#define	C_csa(w)
+#define	C_csb(w)
+#define	C_fil_dlb(g,o)
+#define	C_lae_dlb(g,o)
+#define	C_lal(c)
+#define	C_lin(c)
+#define	C_loi(c)
+#define	C_lol(c)
+#define	C_ret(c)
+#define	C_sdl(c)
+#define	C_sti(c)
+#define	C_stl(c)
+
+#define	C_busy()	0
+#define	C_close()
+
+#define	C_df_dlb(l)
+#define	C_df_dnam(s)
+#define	C_df_ilb(l)
+
+#define	C_pro_narg(s)
+#define	C_end(l)
+
+#define	C_exa_dnam(s)
+#define	C_ina_dnam(s)
+#define	C_ina_dlb(l)
+#define	C_exp(s)
+#define	C_inp(s)
+
+#define	C_bss_cst(n,w,i)
+
+#define	C_con_cst(v)
+#define	C_con_icon(v,s)
+#define	C_con_ucon(v,s)
+#define	C_con_fcon(v,s)
+#define	C_con_scon(v,s)
+#define	C_con_dnam(v,s)
+#define	C_con_dlb(v,s)
+#define	C_con_pnam(v)
+
+#define	C_rom_cst(v)
+#define	C_rom_icon(v,s)
+#define	C_rom_scon(v,s)
+#define	C_rom_ilb(v)
+
+#define	C_ldl(l)
+
+#define	C_mes_begin(ms)
+#define	C_mes_end()
+
+#define	C_ms_gto()
+#define	C_ms_par(b)
+#define	C_ms_reg(o,s,t,c)
+#define	C_ms_err()
+

lang/cem/cemcom.ansi/l_ev_ord.c

@@ -0,0 +1,109 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	Lint evaluation order checking	*/
+
+#include	"lint.h"
+
+#ifdef	LINT
+
+#include	<alloc.h>	/* for st_free */
+#include	"interface.h"
+#include	"assert.h"
+#ifdef ANSI
+#include	<flt_arith.h>
+#endif /* ANSI */
+#include	"arith.h"	/* definition arith */
+#include	"label.h"	/* definition label */
+#include	"expr.h"
+#include	"idf.h"
+#include	"def.h"
+#include	"code.h"	/* RVAL etc */
+#include	"LLlex.h"
+#include	"Lpars.h"
+#include	"stack.h"
+#include	"type.h"
+#include	"level.h"
+#include	"l_lint.h"
+#include	"l_state.h"
+
+extern char *symbol2str();
+
+PRIVATE check_ev_order();
+
+check_and_merge(expr, espp, esp)
+	struct expr *expr;
+	struct expr_state **espp, *esp;
+{
+/* Checks for undefined evaluation orders in case of a non-sequencing operator.
+ * In addition the sets of used and set variables of both expressions are
+ * united.
+ * *espp will be pointing to this new list. esp is used for this list.
+ */
+	register struct expr_state **pp, *p1, *p2;
+	int oper = expr->OP_OPER;
+	int is_sequencer =
+		(oper == '?' || oper == OR || oper == AND || oper ==',');
+
+	for (p1 = *espp; p1; p1 = p1->next) {
+		/* scan the list esp for the same variable */
+		p2 = esp;
+		pp = &esp;
+		while (p2) {
+			if (	/* p1 and p2 refer to the same location */
+				p1->es_idf == p2->es_idf
+			&&	p1->es_offset == p2->es_offset
+			) {
+				/* check */
+				if (!is_sequencer)
+					check_ev_order(p1, p2, expr);
+
+				/* merge the info */
+				p1->es_used |= p2->es_used;
+				p1->es_referred |= p2->es_referred;
+				p1->es_set |= p2->es_set;
+
+				/* and remove the entry from esp */
+				*pp = p2->next;
+				free_expr_state(p2);
+				p2 = *pp;
+			}
+			else {
+				/* skip over the entry in esp */
+				pp = &p2->next;
+				p2 = p2->next;
+			}
+		}
+	}
+	/*	If there is anything left in the list esp, this is put in
+		front of the list *espp is now pointing to, and *espp will be
+		left pointing to this new list.
+	*/
+	if (!esp)
+		return;
+	p1 = *espp;
+	*espp = esp;
+	while (esp->next)
+		esp = esp->next;
+	esp->next = p1;
+}
+
+PRIVATE
+check_ev_order(esp1, esp2, expr)
+	struct expr_state *esp1, *esp2;
+	struct expr *expr;
+{
+	if (	(esp1->es_used && esp2->es_set)
+	||	(esp1->es_set && esp2->es_used)
+	||	(esp1->es_set && esp2->es_set)
+	) {
+		expr_warning(expr,
+			"result of %s depends on evaluation order on %s",
+			symbol2str(expr->OP_OPER),
+			esp1->es_idf->id_text);
+	}
+}
+
+#endif	/* LINT */

lang/cem/cemcom.ansi/l_lint.c

@@ -0,0 +1,455 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	Lint main routines	*/
+
+#include	"lint.h"
+
+#ifdef	LINT
+
+#include	<alloc.h>	/* for st_free */
+#include	"debug.h"
+#include	"interface.h"
+#include	"assert.h"
+#ifdef ANSI
+#include	<flt_arith.h>
+#endif /* ANSI */
+#include	"arith.h"	/* definition arith */
+#include	"label.h"	/* definition label */
+#include	"expr.h"
+#include	"idf.h"
+#include	"def.h"
+#include	"code.h"	/* RVAL etc */
+#include	"LLlex.h"
+#include	"Lpars.h"
+#include	"stack.h"
+#include	"type.h"
+#include	"level.h"
+#include	"l_lint.h"
+#include	"l_state.h"
+#include	"l_outdef.h"
+
+extern char options[128];
+extern char *symbol2str();
+
+PRIVATE struct expr_state *expr2state();
+PRIVATE struct expr_state *value2state();
+PRIVATE struct expr_state *oper2state();
+PRIVATE expr_ignored();
+PRIVATE add_expr_state();
+PRIVATE referred_esp();
+PRIVATE free_expr_states();
+
+lint_init()
+{
+	lint_init_comment();
+	lint_init_stack();
+}
+
+lint_expr(expr, used)
+	struct expr *expr;
+	int used;			/* USED or IGNORED */
+{
+	register struct expr_state *esp;
+
+	esp = expr2state(expr, RVAL, used);
+	referred_esp(esp);
+	free_expr_states(esp);
+}
+
+PRIVATE struct expr_state *
+expr2state(expr, val, used)
+	register struct expr *expr;
+	int val;			/* RVAL or LVAL */
+	int used;			/* USED or IGNORED */
+{
+/* Main function to process an expression tree.
+ * It returns a structure containing information about which variables
+ * are set and which are used in the expression.
+ * In addition it sets 'used' and 'set' fields of the corresponding
+ * variables in the current state.
+ * If the value of an operation without side-effects is not used,
+ * a warning is given.
+ */
+	if (used == IGNORED) {
+		expr_ignored(expr);
+	}
+
+	switch (expr->ex_class) {
+	case Value:
+		return value2state(expr, val);
+
+	case Oper:
+		return oper2state(expr, val, used);
+
+	default:			/* String, Float, Type */
+		return 0;
+	}
+}
+
+PRIVATE struct expr_state *
+value2state(expr, val)
+	struct expr *expr;
+	int val;			/* RVAL or LVAL */
+{
+	switch (expr->VL_CLASS) {
+	case Const:
+	case Label:
+		return 0;
+
+	case Name:
+	{
+		register struct idf *idf = expr->VL_IDF;
+		struct expr_state *esp = 0;
+
+		if (!idf || !idf->id_def)
+			return 0;
+
+		if (val == RVAL && expr->ex_lvalue == 1) {
+			/* value of identifier used */
+			change_state(idf, USED);
+			add_expr_state(expr->EX_VALUE, USED, &esp);
+		}
+		if (val == RVAL && expr->ex_lvalue == 0) {
+			/* address of identifier used */
+			add_expr_state(expr->EX_VALUE, REFERRED, &esp);
+		}
+		return esp;
+	}
+
+	default:
+		NOTREACHED();
+		/* NOTREACHED */
+	}
+}
+
+/*	Let's get this straight.
+	An assignment is performed by elaborating the LHS and the RHS
+	collaterally, to use the A68 terminology, and then serially do the
+	actual assignment. This means:
+	1.	evaluate the LHS as an LVAL,
+	2.	evaluate the RHS as an RVAL,
+	3.	merge them checking for interference,
+	4.	set the result of the LHS to SET, if it is a named variable
+*/
+
+PRIVATE struct expr_state *
+oper2state(expr, val, used)
+	struct expr *expr;
+	int val;			/* RVAL or LVAL */
+	int used;			/* USED or IGNORED */
+{
+	register int oper = expr->OP_OPER;
+	register struct expr *left = expr->OP_LEFT;
+	register struct expr *right = expr->OP_RIGHT;
+	struct expr_state *esp_l = 0;
+	struct expr_state *esp_r = 0;
+
+	switch (oper) {
+
+	/* assignments */
+	case '=':
+	case PLUSAB:
+	case MINAB:
+	case TIMESAB:
+	case DIVAB:
+	case MODAB:
+	case LEFTAB:
+	case RIGHTAB:
+	case ANDAB:
+	case XORAB:
+	case ORAB:
+		/* evaluate the LHS, only once; see RM 7.14 */
+		esp_l = expr2state(left, (oper == '=' ? LVAL : RVAL), USED);
+
+		/* evaluate the RHS as an RVAL and merge */
+		esp_r = expr2state(right, RVAL, USED);
+		check_and_merge(expr, &esp_l, esp_r);
+
+		/* set resulting variable, if any */
+		if (ISNAME(left)) {
+			change_state(left->VL_IDF, SET);
+			add_expr_state(left->EX_VALUE, SET, &esp_l);
+		}
+
+		return esp_l;
+
+	case POSTINCR:
+	case POSTDECR:
+	case PLUSPLUS:
+	case MINMIN:
+		esp_l = expr2state(left, RVAL, USED);
+
+		/* set resulting variable, if any */
+		if (ISNAME(left)) {
+			change_state(left->VL_IDF, SET);
+			add_expr_state(left->EX_VALUE, SET, &esp_l);
+		}
+
+		return esp_l;
+
+	case '?':
+		esp_l = expr2state(left, RVAL, USED);
+		esp_r = expr2state(right->OP_LEFT, RVAL, USED);
+		check_and_merge(expr, &esp_l, esp_r);
+		esp_r = expr2state(right->OP_RIGHT, RVAL, USED);
+		check_and_merge(expr, &esp_l, esp_r);
+		return esp_l;
+
+	case '(':
+		if (right != 0) {
+			/* function call with parameters */
+			register struct expr *ex = right;
+
+			while (	ex->ex_class == Oper
+			&&	ex->OP_OPER == PARCOMMA
+			) {
+				esp_r = expr2state(ex->OP_RIGHT, RVAL, USED);
+				check_and_merge(expr, &esp_l, esp_r);
+				ex = ex->OP_LEFT;
+			}
+			esp_r = expr2state(ex, RVAL, USED);
+			check_and_merge(expr, &esp_l, esp_r);
+		}
+
+		if (ISNAME(left)) {
+			fill_outcall(expr,
+				expr->ex_type->tp_fund == VOID ?
+				VOIDED : used
+			);
+			outcall();
+			left->VL_IDF->id_def->df_used = 1;
+		}
+		else {
+			esp_r = expr2state(left, RVAL, USED);
+			check_and_merge(expr, &esp_l, esp_r);
+		}
+		referred_esp(esp_l);
+		return esp_l;
+
+	case '.':
+		return expr2state(left, val, USED);
+
+	case ARROW:
+		return expr2state(left, RVAL, USED);
+
+	case INT2INT:
+	case INT2FLOAT:
+	case FLOAT2INT:
+	case FLOAT2FLOAT:
+		return expr2state(right, RVAL, USED);
+
+	/* monadic operators */
+	case '-':
+	case '*':
+		if (left)
+			goto dyadic;
+	case '~':
+	case '!':
+		return expr2state(right, RVAL, USED);
+
+	/* relational operators */
+	case '<':
+	case '>':
+	case LESSEQ:
+	case GREATEREQ:
+	case EQUAL:
+	case NOTEQUAL:
+		goto dyadic;
+
+	/* dyadic operators */
+	dyadic:
+	case '+':
+	case '/':
+	case '%':
+	case ',':
+	case LEFT:
+	case RIGHT:
+	case '&':
+	case '|':
+	case '^':
+	case OR:
+	case AND:
+		esp_l = expr2state(left, RVAL,
+					oper == ',' ? IGNORED : USED);
+		esp_r = expr2state(right, RVAL,
+					oper == ',' ? used : USED);
+		check_and_merge(expr, &esp_l, esp_r);
+
+		return esp_l;
+
+	default:
+		return 0;	/* for initcomma */
+	}
+}
+
+PRIVATE
+expr_ignored(expr)
+	struct expr *expr;
+{
+	switch (expr->ex_class) {
+		int oper;
+	case Oper:
+		oper = expr->OP_OPER;
+		switch (oper) {
+		case '=':
+		case TIMESAB:
+		case DIVAB:
+		case MODAB:
+		case LEFTAB:
+		case RIGHTAB:
+		case ANDAB:
+		case XORAB:
+		case ORAB:
+		case AND:			/* doubtful but useful */
+		case OR:			/* doubtful but useful */
+		case '(':
+		case '?':
+		case ',':
+			oper = 0;		/* ignore the ignoring */
+			break;
+
+		case PLUSAB:
+		case MINAB:
+		case POSTINCR:
+		case POSTDECR:
+		case PLUSPLUS:
+		case MINMIN:
+			oper = 0;		/* ignore in priciple */
+			/* may, however, hide the operator '*' */
+			if (	/* operation on a pointer */
+				expr->OP_TYPE->tp_fund == POINTER
+			&&	/* the result is dereferenced, e.g. *p++; */
+				expr->ex_type == expr->OP_TYPE->tp_up
+			) {
+				oper = '*';
+			}
+			break;
+
+		case '/':
+			/*	this is a specially weird case: the '/' may
+				result from pointer subtraction
+			*/
+			if (	expr->OP_TYPE->tp_fund == INT
+			&&	expr->OP_LEFT->OP_OPER == '-'
+			&&	expr->OP_LEFT->OP_TYPE->tp_fund == POINTER
+			) {
+				oper = '-';
+			}
+			break;
+		}
+		if (oper) {
+			hwarning("result of %s ignored", symbol2str(oper));
+		}
+		break;
+
+	case Value:
+		if (expr->VL_CLASS == Const) {
+			hwarning("constant expression ignored");
+		}
+		else {
+			hwarning("value ignored");
+		}
+		break;
+
+	default:			/* String Float */
+		hwarning("constant ignored");
+		break;
+	}
+}
+
+PRIVATE
+add_expr_state(value, to_state, espp)
+	struct value value;
+	struct expr_state **espp;
+{
+	register struct expr_state *esp = *espp;
+
+	ASSERT(value.vl_class == Name);
+
+	/* try to find the esp */
+	while (	esp
+	&&	!(	esp->es_idf == value.vl_data.vl_idf
+		&&	esp->es_offset == value.vl_value
+		)
+	) {
+		esp = esp->next;
+	}
+
+	/* if not found, add it */
+	if (!esp) {
+		esp = new_expr_state();
+		esp->es_idf = value.vl_data.vl_idf;
+		esp->es_offset = value.vl_value;
+		esp->next = *espp;
+		*espp = esp;
+	}
+
+	/* set state */
+	switch (to_state) {
+	case USED:
+		esp->es_used = 1;
+		break;
+	case REFERRED:
+		esp->es_referred = 1;
+		break;
+	case SET:
+		esp->es_set = 1;
+		break;
+	default:
+		NOTREACHED();
+		/* NOTREACHED */
+	}
+}
+
+PRIVATE
+referred_esp(esp)
+	struct expr_state *esp;
+{
+	/* raises all REFERRED items to SET and USED status */
+	while (esp) {
+		if (esp->es_referred) {
+			esp->es_set = 1;
+			change_state(esp->es_idf, SET);
+			esp->es_used = 1;
+			change_state(esp->es_idf, USED);
+			esp->es_referred = 0;
+		}
+		esp = esp->next;
+	}
+}
+
+PRIVATE
+free_expr_states(esp)
+	register struct expr_state *esp;
+{
+	while (esp) {
+		register struct expr_state *esp2 = esp;
+
+		esp = esp->next;
+		free_expr_state(esp2);
+	}
+}
+
+#ifdef	DEBUG
+print_esp(msg, esp)
+	char *msg;
+	struct expr_state *esp;
+{
+	print("%s: <", msg);
+	while (esp) {
+		print(" %s[%d]%c%c%c ",
+			esp->es_idf->id_text, esp->es_offset,
+			(esp->es_used ? 'U' : ' '),
+			(esp->es_referred ? 'R' : ' '),
+			(esp->es_set ? 'S' : ' ')
+		);
+		esp = esp->next;
+	}
+	print(">\n");
+}
+#endif	/* DEBUG */
+
+#endif	/* LINT */

lang/cem/cemcom.ansi/l_lint.h

@@ -0,0 +1,18 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	LINT FLAGS	*/
+
+#define	USED		0
+#define	IGNORED		1
+#define	SET		2
+#define	VOIDED		3
+#define	REFERRED	4
+
+/* for od_valreturned */
+#define	NOVALRETURNED	0
+#define	VALRETURNED	1
+#define	NORETURN	2		/* end of function NOTREACHED */
+

lang/cem/cemcom.ansi/l_misc.c

@@ -0,0 +1,430 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	Lint miscellaneous routines	*/
+
+#include	"lint.h"
+
+#ifdef	LINT
+
+#include	<alloc.h>	/* for st_free */
+#include	"interface.h"
+#ifdef ANSI
+#include	<flt_arith.h>
+#endif /* ANSI */
+#include	"arith.h"	/* definition arith */
+#include	"label.h"	/* definition label */
+#include	"expr.h"
+#include	"idf.h"
+#include	"def.h"
+#include	"code.h"	/* RVAL etc */
+#include	"LLlex.h"
+#include	"Lpars.h"
+#include	"stack.h"
+#include	"type.h"
+#include	"level.h"
+#include	"l_state.h"
+
+extern char *symbol2str();
+extern struct type *func_type;
+
+PRIVATE lint_enum_arith();
+PRIVATE lint_conversion();
+PRIVATE int numsize();
+
+check_hiding(idf, lvl, sc)
+	struct idf *idf;
+	int lvl;
+	int sc;
+{
+	/*	Checks if there is already a definition for this non-extern
+		name on a more global level.
+	*/
+	struct def *def = idf->id_def;
+	
+	if (	def && def->df_level < lvl
+	&&	! (	lvl == L_FORMAL2
+		||	def->df_level == L_UNIVERSAL
+		||	sc == GLOBAL
+		||	sc == EXTERN
+		)
+	) {
+		warning("%s is already defined as a %s",
+			idf->id_text,
+			def->df_level == L_GLOBAL ? "global" :
+			def->df_level == L_FORMAL2 ? "formal" :
+				"more global local"
+		);
+	}
+}
+
+lint_new_oper(expr)
+	struct expr *expr;
+{
+	/*	Does additional checking on a newly constructed expr node
+		of class Oper.
+
+		Some code in this routine could be contracted, but since
+		I am not sure we have covered the entire ground, we'll
+		leave the contracting for some rainy day.
+	*/
+	register struct expr *left = expr->OP_LEFT;
+	register struct expr *right = expr->OP_RIGHT;
+	register int oper = expr->OP_OPER;
+	register int l_fund =
+		left == 0 ? 0 :			/* for monadics */
+		left->ex_type->tp_fund;
+	register int r_fund =
+		right == 0 ? 0 :		/* for ( without parameters */
+		right->ex_type->tp_fund;
+
+	/*	In ch7.c, in ch7asgn(), a combined operator/assignment
+		is hammered into correctness by repeated application of
+		ch7bin(), which calls new_oper(), which calls lint_new_oper().
+		These spurious calls understandably cause spurious error
+		messages, which we don't like.  So we try to suppress these
+		wierd calls here.  This refers to the code marked
+			this is really $#@&*%$# !
+		in ch7asgn().
+	*/
+	switch (oper) {
+	case PLUSAB:
+	case MINAB:
+	case TIMESAB:
+	case DIVAB:
+	case MODAB:
+	case LEFTAB:
+	case RIGHTAB:
+	case ANDAB:
+	case XORAB:
+	case ORAB:
+		/* is the left operand wierd? */
+		if (	left->ex_class == Value
+		&&	left->VL_CLASS == Const
+		&&	left->VL_VALUE == 0
+		) {
+			return;
+		}
+	}
+
+	switch (oper) {
+	case '=':
+		lint_conversion(right, l_fund);
+		break;
+
+	case PLUSAB:
+		lint_conversion(right, l_fund);
+	case '+':
+		lint_enum_arith(l_fund, oper, r_fund);
+		break;
+
+	case MINAB:
+		lint_conversion(right, l_fund);
+	case '-':
+		if (left == 0) {
+			/* unary */
+			if (r_fund == ENUM)
+				warning("negating an enum");
+		}
+		else {
+			/* binary */
+			if (l_fund == ENUM && r_fund == ENUM) {
+				if (left->ex_type != right->ex_type)
+					warning("subtracting enums of different type");
+				/* update the type, cem does not do it */
+				expr->ex_type = int_type;
+			}
+			lint_enum_arith(l_fund, oper, r_fund);
+		}
+		break;
+
+	case TIMESAB:
+		lint_conversion(right, l_fund);
+	case '*':
+		if (left == 0) {
+			/* unary */
+		}
+		else {
+			/* binary */
+			if (l_fund == ENUM || r_fund == ENUM)
+				warning("multiplying enum");
+		}
+		break;
+
+	case DIVAB:
+		lint_conversion(right, l_fund);
+	case '/':
+		if (l_fund == ENUM || r_fund == ENUM)
+			warning("division on enum");
+		break;
+
+	case MODAB:
+		lint_conversion(right, l_fund);
+	case '%':
+		if (l_fund == ENUM || r_fund == ENUM)
+			warning("modulo on enum");
+		break;
+
+	case '~':
+		if (r_fund == ENUM || r_fund == FLOAT || r_fund == DOUBLE)
+			warning("~ on %s", symbol2str(r_fund));
+		break;
+
+	case '!':
+		if (r_fund == ENUM)
+			warning("! on enum");
+		break;
+
+	case INT2INT:
+	case INT2FLOAT:
+	case FLOAT2INT:
+	case FLOAT2FLOAT:
+		lint_conversion(right, l_fund);
+		break;
+
+	case '<':
+	case '>':
+	case LESSEQ:
+	case GREATEREQ:
+	case EQUAL:
+	case NOTEQUAL:
+		if (	(l_fund == ENUM || r_fund == ENUM)
+		&&	left->ex_type != right->ex_type
+		) {
+			warning("comparing enum with non-enum");
+		}
+		lint_relop(left, right, oper);
+		lint_relop(right, left, 
+			oper == '<' ? '>' :
+			oper == '>' ? '<' :
+			oper == LESSEQ ? GREATEREQ :
+			oper == GREATEREQ ? LESSEQ :
+			oper
+		);
+		break;
+
+	case LEFTAB:
+	case RIGHTAB:
+		lint_conversion(right, l_fund);
+	case LEFT:
+	case RIGHT:
+		if (l_fund == ENUM || r_fund == ENUM)
+			warning("shift on enum");
+		break;
+
+	case ANDAB:
+	case ORAB:
+	case XORAB:
+		lint_conversion(right, l_fund);
+	case '&':
+	case '|':
+	case '^':
+		if (l_fund == ENUM || r_fund == ENUM)
+			warning("bit operations on enum");
+		break;
+
+	case ',':
+	case '?':
+	case ':':
+	case AND:
+	case OR:
+	case POSTINCR:
+	case POSTDECR:
+	case PLUSPLUS:
+	case MINMIN:
+	case '(':
+	case '.':
+	case ARROW:
+	default:
+		/* OK with lint */
+		break;
+	}
+}
+
+PRIVATE
+lint_enum_arith(l_fund, oper, r_fund)
+	int l_fund, oper, r_fund;
+{
+	if (	l_fund == ENUM
+	&&	r_fund != CHAR
+	&&	r_fund != SHORT
+	&&	r_fund != INT
+	) {
+		warning("%s on enum and %s",
+			symbol2str(oper), symbol2str(r_fund));
+	}
+	else
+	if (	r_fund == ENUM
+	&&	l_fund != CHAR
+	&&	l_fund != SHORT
+	&&	l_fund != INT
+	) {
+		warning("%s on %s and enum",
+			symbol2str(oper), symbol2str(l_fund));
+	}
+}
+
+PRIVATE
+lint_conversion(from_expr, to_fund)
+	struct expr *from_expr;
+	int to_fund;
+{
+	register int from_fund = from_expr->ex_type->tp_fund;
+
+	/*	was there an attempt to reduce the type of the from_expr
+		of the form
+			expr & 0377
+		or something like this?
+	*/
+	if (from_expr->ex_class == Oper && from_expr->OP_OPER == INT2INT) {
+		from_expr = from_expr->OP_LEFT;
+	}
+	if (from_expr->ex_class == Oper && from_expr->OP_OPER == '&') {
+		struct expr *bits =
+			is_cp_cst(from_expr->OP_LEFT) ? from_expr->OP_LEFT :
+			is_cp_cst(from_expr->OP_RIGHT) ? from_expr->OP_RIGHT :
+			0;
+
+		if (bits) {
+			arith val = bits->VL_VALUE;
+
+			if (val < 256)
+				from_fund = CHAR;
+			else if (val < 256)
+				from_fund = SHORT;
+		}
+	}
+	if (numsize(from_fund) > numsize(to_fund)) {
+		awarning("conversion from %s to %s may lose accuracy",
+			symbol2str(from_fund), symbol2str(to_fund));
+	}
+}
+
+PRIVATE int
+numsize(fund)
+{
+	switch (fund) {
+	case CHAR:	return 1;
+	case SHORT:	return 2;
+	case INT:	return 3;
+	case ENUM:	return 3;
+	case LONG:	return 4;
+	case FLOAT:	return 5;
+	case DOUBLE:	return 6;
+	default:	return 0;
+	}
+}
+
+lint_ret_conv(from_expr)
+	struct expr *from_expr;
+{
+	lint_conversion(from_expr, func_type->tp_fund);
+}
+
+lint_ptr_conv(from, to)
+	short from, to;
+{
+/* X -> X ok			-- this includes struct -> struct, of any size
+ * X -> CHAR ok
+ * DOUBLE -> X ok
+ * FLOAT -> LONG -> INT -> SHORT  ok
+ */
+	if (from == to)
+		return;
+
+	if (to == VOID)
+		return;
+
+	if (to == CHAR)
+		return;
+
+	if (from == DOUBLE)
+		return;
+
+	switch (from) {
+	case FLOAT:
+		switch (to) {
+		case LONG:
+		case INT:
+		case SHORT:
+			return;
+		}
+		break;
+	case LONG:
+		switch (to) {
+		case INT:
+		case SHORT:
+			return;
+		}
+		break;
+	case INT:
+		switch (to) {
+		case SHORT:
+			return;
+		}
+		break;
+	}
+
+	if (from == VOID) {
+		/* OK any which way */
+	}
+	else
+	if (from == CHAR) {
+		hwarning("pointer to char may not align correctly for a %s",
+			symbol2str(to));
+	}
+	else {
+		warning("pointer to %s may not align correctly for a %s",
+			symbol2str(from), symbol2str(to));
+	}
+}
+
+lint_relop(left, right, oper)
+	struct expr *left, *right;
+	int oper;	/* '<', '>', LESSEQ, GREATEREQ, EQUAL, NOTEQUAL */
+{
+	/* left operand may be converted */
+	if (	left->ex_class == Oper
+	&&	left->OP_OPER == INT2INT
+	) {
+		left = left->OP_RIGHT;
+	}
+
+	/* <unsigned> <relop> <neg-const|0> is doubtful */
+	if (	left->ex_type->tp_unsigned
+	&&	right->ex_class == Value
+	&&	right->VL_CLASS == Const
+	) {
+		if (!right->ex_type->tp_unsigned && right->VL_VALUE < 0) {
+			warning("unsigned compared to negative constant");
+		}
+		if (right->VL_VALUE == 0) {
+			switch (oper) {
+			case '<':
+				warning("unsigned < 0 will always fail");
+				break;
+
+			case LESSEQ:
+				warning("unsigned <= 0 is probably wrong");
+				break;
+
+			case GREATEREQ:
+				warning("unsigned >= 0 will always succeed");
+				break;
+			}
+		}
+	}
+
+	/* <char> <relop> <neg-const> is undefined */
+	if (	left->ex_type->tp_fund == CHAR
+	&&	right->ex_class == Value
+	&&	right->VL_CLASS == Const
+	&&	(right->VL_VALUE < 0 || right->VL_VALUE > 127)
+	) {
+		warning("character compared to negative constant");
+	}
+}
+
+#endif	/* LINT */

lang/cem/cemcom.ansi/l_outdef.c

@@ -0,0 +1,620 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	Lint outdef construction	*/
+
+#include	"lint.h"
+
+#ifdef	LINT
+
+#include	<alloc.h>
+#include	"interface.h"
+#ifdef ANSI
+#include	<flt_arith.h>
+#endif /* ANSI */
+#include	"arith.h"
+#include	"assert.h"
+#include	"type.h"
+#include	"proto.h"
+#include	"declar.h"
+#include	"decspecs.h"
+#include	"LLlex.h"
+#include	"Lpars.h"
+#include	"stack.h"
+#include	"def.h"
+#include	"struct.h"
+#include	"field.h"
+#include	"idf.h"
+#include	"level.h"
+#include	"label.h"
+#include	"code.h"
+#include	"expr.h"
+#include	"l_lint.h"
+#include	"l_comment.h"
+#include	"l_outdef.h"
+#include	"l_class.h"
+
+extern char *bts2str();
+extern char *symbol2str();
+extern char *strindex();
+
+int stat_number = 9999;			/* static scope number */
+struct outdef OutDef;
+
+PRIVATE struct outdef OutCall;
+
+PRIVATE local_EFDC();
+PRIVATE output_def();
+PRIVATE outargs();
+PRIVATE outarg();
+PRIVATE outargstring();
+PRIVATE outargtype();
+PRIVATE add_expr_arg();
+PRIVATE def2decl();
+
+lint_declare_idf(idf, sc)
+	struct idf *idf;
+	int sc;
+{
+	register struct def *def = idf->id_def;
+	register int is_function = def->df_type->tp_fund == FUNCTION;
+
+	if (level == L_GLOBAL) {
+		lint_ext_def(idf, sc);
+		if (is_function)
+			def2decl(sc);
+		if (sc != TYPEDEF)
+			outdef();
+	}
+	else
+	if (level >= L_LOCAL && sc != STATIC && is_function) {
+		local_EFDC(idf);
+	}
+}
+
+lint_non_function_decl(ds, dc)
+	struct decspecs *ds;
+	struct declarator *dc;
+{
+	register struct def *def = dc->dc_idf->id_def;
+	register int is_function = def->df_type->tp_fund == FUNCTION;
+
+	if (is_function)
+		def2decl(ds->ds_sc);
+	if (def->df_sc != TYPEDEF)
+		outdef();
+}
+
+lint_ext_def(idf, sc)
+	struct idf *idf;
+{
+/* At this place the following fields of the output definition can be
+ * filled:
+ *		od_name, od_statnr, od_class, od_file, od_line, od_type.
+ * For variable definitions and declarations this will be all.
+ * For functions the fields od_nrargs and od_arg are filled after parsing
+ * the arguments.
+ * The od_valreturned field is known at the end of the function definition.
+ * sc indicates the storage class defined by the declaration specifier.
+ */
+	register struct def *def = idf->id_def;
+	register struct type *type = def->df_type;
+
+	OutDef.od_name = idf->id_text;
+	OutDef.od_statnr = (sc == STATIC ? stat_number : 0);
+
+	switch (type->tp_fund) {
+	case ERRONEOUS:
+		OutDef.od_class = XXDF;
+		break;
+	case FUNCTION:
+		/* For the moment assume it will be a definition.
+		 * If no compound_statement follows, it is a declaration,
+		 * in which case the class will be adjusted by def2decl().
+		 */
+		OutDef.od_class = (sc == STATIC ? SFDF : EFDF);
+		break;
+	default:	/* a variable */
+		OutDef.od_class =
+			sc == EXTERN ? EVDC :
+			sc == STATIC ? SVDF : EVDF;
+		break;
+	}
+	OutDef.od_file = def->df_file;
+	OutDef.od_line = def->df_line;
+	OutDef.od_type = (type->tp_fund == FUNCTION ? type->tp_up : type);
+	OutDef.od_valreturned = NORETURN;
+}
+
+PRIVATE
+def2decl(sc)
+	int sc;
+{
+/* It was assumed we were parsing a function definition.
+ * There was no compound statement following, so actually it was a
+ * declaration. This function updates the class.
+ */
+	OutDef.od_class = (sc == STATIC ? XXDF : EFDC);
+}
+
+set_od_valreturned(n)
+{
+	OutDef.od_valreturned = n;
+}
+
+PRIVATE
+local_EFDC(idf)
+	struct idf *idf;
+{
+	struct outdef od;
+
+	od.od_class = EFDC;
+	od.od_statnr = 0;
+	od.od_name = idf->id_text;
+	od.od_file = idf->id_def->df_file;
+	od.od_line = idf->id_def->df_line;
+	od.od_type = idf->id_def->df_type->tp_up;
+	output_def(&od);
+	/* The other fields are not used for this class. */
+}
+
+lint_formals()
+{
+/* Make a list of 'struct argument's containing the types of the formal
+ * parameters of the function definition just parsed.
+ */
+	register struct stack_entry *se = stack_level_of(L_FORMAL1)->sl_entry;
+	register struct argument **hook = &OutDef.od_arg;
+	register int nrargs = 0;
+
+	while (se) {
+		register struct type *type = se->se_idf->id_def->df_type;
+		register struct argument *arg = new_argument();
+
+		if (f_FORMAT && nrargs == f_FORMATn) {
+			if (	!f_FORMATvar
+			&&	(	type->tp_fund != POINTER
+				||	type->tp_up->tp_fund != CHAR
+				)
+			) {
+				warning("format parameter %d is not pointer to char",
+					nrargs);
+			}
+			arg->ar_type = string_type;
+			arg->ar_class = ArgString;
+			arg->CAS_VALUE = f_FORMAT;
+			arg->CAS_LEN = strlen(f_FORMAT);
+			f_FORMAT = 0;
+		}
+		else {
+			arg->ar_type = type;
+			arg->ar_class = ArgFormal;
+		}
+		*hook = arg;
+		hook = &arg->next;
+
+		nrargs++;
+		se = se->next;
+	}
+
+	if (f_FORMAT) {
+		/*	f_FORMAT has not been consumed, perhaps due to
+			a varargs-like construction; add erroneous ArgFormals
+			until f_FORMATn, then an ArgString, if necessary.
+		*/
+		if (!f_FORMATvar) {
+			warning("FORMAT%d function has only %d argument%s",
+				f_FORMATn, nrargs, nrargs == 1 ? "" : "s"
+			);
+		}
+
+		while (nrargs < f_FORMATn) {
+			register struct argument *arg = new_argument();
+			
+			arg->ar_type = error_type;
+			arg->ar_class = ArgFormal;
+			*hook = arg;
+			hook = &arg->next;
+			nrargs++;
+		}
+		if (nrargs == f_FORMATn) {
+			register struct argument *arg = new_argument();
+			
+			arg->ar_type = string_type;
+			arg->ar_class = ArgString;
+			arg->CAS_VALUE = f_FORMAT;
+			arg->CAS_LEN = strlen(f_FORMAT);
+			f_FORMAT = 0;
+			*hook = arg;
+			hook = &arg->next;
+			nrargs++;
+		}
+		/* life is full of duplicated code; this is no good */
+	}
+
+	if (f_VARARGSn > nrargs) {
+		warning("VARARGS%d function has only %d argument%s",
+			f_VARARGSn, nrargs, nrargs == 1 ? "" : "s"
+		);
+		f_VARARGSn = nrargs;
+	}
+	OutDef.od_nrargs = nrargs;
+}
+
+output_proto(idf, def)
+	struct idf *idf;
+	struct def *def;
+{
+	/* fund == FUNCTION && sc != STATIC */
+	register struct proto *pl = def->df_type->tp_proto;
+	register int nrargs = 0;
+
+	if (!pl) return;
+
+	OutDef.od_name = idf->id_text;
+	OutDef.od_statnr = 0;
+	OutDef.od_class = PFDF;
+	OutDef.od_file = def->df_file;
+	OutDef.od_line = def->df_line;
+	OutDef.od_type = def->df_type->tp_up;
+	OutDef.od_valreturned = NORETURN;/*???*/
+
+	while (pl) {
+		register struct type *type = pl->pl_type;
+		register struct argument *arg = new_argument();
+
+		if (type) {
+			arg->ar_type = type;
+			arg->ar_class = ArgFormal;
+		}
+		else {
+			arg->ar_class = ArgEllipsis;
+		}
+		arg->next = OutDef.od_arg;
+		OutDef.od_arg = arg;
+
+		nrargs++;
+		pl = pl->next;
+	}
+
+	OutDef.od_nrargs = nrargs;
+	outdef();
+}
+
+output_use(idf)
+	struct idf *idf;
+{
+/* Output the usage-definition of the variable described by idf.
+ */
+	OutDef.od_name = idf->id_text;
+	OutDef.od_statnr = (idf->id_def->df_sc == STATIC ? stat_number : 0);
+	OutDef.od_class = VU;
+	OutDef.od_file = FileName;
+	OutDef.od_line = LineNumber;
+	OutDef.od_type = idf->id_def->df_type;
+	outdef();
+}
+
+outdef()
+{
+	output_def(&OutDef);
+}
+
+outcall()
+{
+	output_def(&OutCall);
+}
+
+PRIVATE
+output_def(od)
+	struct outdef *od;
+{
+/* As the types are output the 'struct argument's are freed, because they
+ * are then not needed anymore.
+ */
+	if (od->od_class == XXDF || !od->od_name || od->od_name[0] == '#')
+		return;
+
+	if (LINTLIB) {
+		switch (od->od_class) {
+		case EFDF:
+			od->od_class = LFDF;
+			break;
+		case EVDF:
+			od->od_class = LVDF;
+			break;
+		case SFDF:
+			/* free the 'struct argument's */
+			while (od->od_arg) {
+				register struct argument *tmp = od->od_arg;
+				od->od_arg = od->od_arg->next;
+				free_argument(tmp);
+			}
+			return;
+		default:
+			return;
+		}
+	}
+	printf("%s:%d:%c", od->od_name, od->od_statnr, od->od_class);
+	switch (od->od_class) {
+	case LFDF:
+	case PFDF:
+	case EFDF:
+	case SFDF:
+		if (f_VARARGSn != -1) {
+			printf(":%d", -1 - f_VARARGSn);
+			outargs(od->od_arg, f_VARARGSn);
+		}
+		else {
+			printf(":%d", od->od_nrargs);
+			outargs(od->od_arg, od->od_nrargs);
+		}
+		od->od_arg = 0;
+		printf(":%d", od->od_valreturned);
+		break;
+	case FC:
+		printf(":%d", od->od_nrargs);
+		outargs(od->od_arg, od->od_nrargs);
+		od->od_arg = 0;
+		printf(":%d", od->od_valused);
+		break;
+	case EVDF:
+	case SVDF:
+	case LVDF:
+	case EFDC:
+	case EVDC:
+	case IFDC:
+	case VU:
+		break;
+	default:
+		NOTREACHED();
+		/*NOTREACHED*/
+	}
+	printf(":");
+	outargtype(od->od_type);
+	printf(":%u:%s\n", od->od_line, od->od_file);
+}
+
+PRIVATE
+outargs(arg, n)
+	struct argument *arg;
+{
+/* Output the n arguments in the argument list and remove them */
+
+	register struct argument *tmp;
+
+	while (n--) {
+		ASSERT(arg);
+		outarg(arg);
+		tmp = arg;
+		arg = arg->next;
+		free_argument(tmp);
+	}
+	/* remove the remaining entries */
+	while (arg) {
+		tmp = arg;
+		arg = arg->next;
+		free_argument(tmp);
+	}
+}
+
+PRIVATE
+outarg(arg)
+	struct argument *arg;
+{
+	printf(":");
+	switch (arg->ar_class) {
+	case ArgConst:
+		if (arg->CAA_VALUE >= 0) {
+			/* constant non-negative actual parameter */
+			printf("+");
+		}
+		outargtype(arg->ar_type);
+		break;
+
+	case ArgString:
+		outargstring(arg);
+		break;
+
+	case ArgFormal:
+	case ArgExpr:
+		outargtype(arg->ar_type);
+		if (arg->ar_type->tp_fund == FUNCTION) {
+			/* UGLY PATCH !!! ??? */
+			/*	function names as operands are sometimes
+				FUNCTION and sometimes POINTER to FUNCTION,
+				depending on opaque circumstances.  E.g., in
+					f(main, main);
+				the first main is PtF and the second is F.
+			*/
+			printf("*");
+		}
+		break;
+
+	case ArgEllipsis:
+		printf(".");	/* one is enough for computers */
+		break;
+
+	default:
+		NOTREACHED();
+		/*NOTREACHED*/
+	}
+}
+
+PRIVATE
+outargstring(arg)
+	struct argument *arg;
+{
+	char buff[1000];
+	register char *p;
+
+	bts2str(arg->CAS_VALUE, arg->CAS_LEN, buff);
+	for (p = &buff[0]; *p; p++) {
+		if (*p == '"' || *p == ':')
+			*p = ' ';
+	}
+	printf("\"%s\"", buff);
+}
+
+PRIVATE
+outargtype(tp)
+	struct type *tp;
+{
+	switch (tp->tp_fund) {
+	case POINTER:
+		outargtype(tp->tp_up);
+		printf("*");
+		break;
+
+	case ARRAY:
+		outargtype(tp->tp_up);
+		printf("*");	/* compatible with [] */
+		break;
+
+	case FUNCTION:
+		outargtype(tp->tp_up);
+		printf("()");
+		break;
+
+	case STRUCT:
+	case UNION:
+	case ENUM:
+		/* watch out for anonymous identifiers; the count field does
+		   not have to be the same for all compilation units.
+		   Remove it, so that pass 2 does not see it. The only
+		   problem with this is that pass2 will not see a difference
+		   between two non-tagged types declared on the same line.
+		*/
+		printf("%s ", symbol2str(tp->tp_fund));
+		if (is_anon_idf(tp->tp_idf)) {
+			/* skip the #<num>, replace it by '#anonymous id' */
+			printf("#anonymous id%s",
+				strindex(tp->tp_idf->id_text, ' ')
+			);
+		}
+		else {
+			printf(tp->tp_idf->id_text);
+		}
+		break;
+
+	case CHAR:
+	case INT:
+	case SHORT:
+	case LONG:
+	case ULONG:
+	case FLOAT:
+	case DOUBLE:
+	case LNGDBL:
+	case VOID:
+	case ERRONEOUS:
+		if (tp->tp_unsigned) {
+			printf("unsigned ");
+		}
+		printf("%s", symbol2str(tp->tp_fund));
+		break;
+	default:
+		NOTREACHED();
+		/*NOTREACHED*/
+	}
+}
+
+#ifdef	IMPLICIT
+PRIVATE
+implicit_func_decl(idf, file, line)
+	struct idf *idf;
+	char *file;
+	unsigned int line;
+{
+	struct outdef od;
+
+	od.od_class = IFDC;
+	od.od_statnr = 0;
+	od.od_name = idf->id_text;
+	od.od_file = file;
+	od.od_line = line;
+	od.od_type = idf->id_def->df_type->tp_up;
+	output_def(&od);
+	/* The other fields are not used for this class. */
+}
+#endif	/* IMPLICIT */
+
+fill_outcall(ex, used)
+	struct expr *ex;
+	int used;
+{
+	register struct idf *idf = ex->OP_LEFT->VL_IDF;
+	register struct def *def = idf->id_def;
+
+#ifdef	IMPLICIT
+	if (def->df_sc == IMPLICIT && !idf->id_def->df_used) {
+		/* IFDC, first time */
+		implicit_func_decl(idf, ex->ex_file, ex->ex_line);
+	}
+#endif	/* IMPLICIT */
+
+	OutCall.od_type = def->df_type->tp_up;
+	OutCall.od_statnr = (def->df_sc == STATIC ? stat_number : 0);
+	OutCall.od_class = FC;
+	OutCall.od_name = idf->id_text;
+	OutCall.od_file = ex->ex_file;
+	OutCall.od_line = ex->ex_line;
+	OutCall.od_arg = (struct argument *)0;
+	OutCall.od_nrargs = 0;
+
+	if ((ex = ex->OP_RIGHT) != 0) {
+		/* function call with arguments: */
+		/* store types of argument expressions in 'struct argument's */
+		while (ex->ex_class == Oper && ex->OP_OPER == PARCOMMA) {
+			add_expr_arg(ex->OP_RIGHT);
+			ex = ex->OP_LEFT;
+		}
+		add_expr_arg(ex);
+	}
+	OutCall.od_valused = used;	/* USED, IGNORED or VOIDED */
+}
+
+PRIVATE
+add_expr_arg(e)
+	struct expr *e;
+{
+	register struct argument *arg;
+
+	arg = new_argument();
+	arg->ar_type = e->ex_type;
+	if (is_cp_cst(e)) {
+		arg->ar_class = ArgConst;
+		arg->CAA_VALUE = e->VL_VALUE;
+	}
+	else if (	e->ex_type == string_type
+		&&	e->ex_class == Value
+		&&	e->VL_CLASS == Label
+		) {
+		/* it may be a string; let's look it up */
+		register struct string_cst *sc = str_list;
+
+		while (sc) {
+			if (sc->sc_dlb == e->VL_LBL)
+				break;
+			sc = sc->next;
+		}
+		if (sc) {
+			/* it was a string */
+			arg->ar_class = ArgString;
+			arg->CAS_VALUE = sc->sc_value;
+			arg->CAS_LEN = sc->sc_len - 1;	/* included the \0 */
+		}
+		else {
+			arg->ar_class = ArgExpr;
+		}
+	}
+	else {
+		arg->ar_class = ArgExpr;
+	}
+	arg->next = OutCall.od_arg;
+	OutCall.od_arg = arg;
+	OutCall.od_nrargs++;
+}
+
+#endif	/* LINT */

lang/cem/cemcom.ansi/l_outdef.str

@@ -0,0 +1,48 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	Lint output definition	*/
+
+/* Values for ar_class */
+#define	ArgFormal	0
+#define	ArgExpr		1		/* actual */
+#define	ArgConst	2		/* integer constant */
+#define	ArgString	3		/* string */
+#define	ArgEllipsis	4		/* ellipsis */
+
+struct argument {
+	struct argument *next;
+	struct type *ar_type;
+	int ar_class;			/* for constant parameters */
+	union const_arg {
+		arith ca_value;
+		struct {
+			char *cas_value;
+			int cas_len;
+		} ca_string;
+	} ar_object;
+};
+
+#define	CAA_VALUE	ar_object.ca_value
+#define	CAS_VALUE	ar_object.ca_string.cas_value
+#define	CAS_LEN		ar_object.ca_string.cas_len
+
+/* ALLOCDEF "argument" 10 */
+
+struct outdef {
+	char od_class;
+	int od_statnr;
+	char *od_name;
+	char *od_file;
+	unsigned int od_line;
+	int od_nrargs;
+	struct argument *od_arg;	/* a list of the types of the
+					 * formal parameters */
+	int od_valreturned;
+		/* NOVALRETURNED, VALRETURNED, NORETURN; see l_lint.h */
+	int od_valused;
+		/* USED, IGNORED, SET, VOIDED; see l_lint.h */
+	struct type *od_type;
+};

lang/cem/cemcom.ansi/l_state.str

@@ -0,0 +1,93 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	Lint state stack	*/
+
+/* These datastructures are used to implement a stack on which the
+ * state of automatic variables (including register variables) is
+ * kept.
+ * In this way it is possible to account for the flow of
+ * control of the program.
+ */
+
+#define	TEST_VAR	0		/* not a constant */
+#define	TEST_TRUE	1		/* always true */
+#define	TEST_FALSE	2		/* always false */
+
+struct loop_state {			/* used in lint_end_state only */
+	int lps_test;			/* is the test a constant? */
+	struct state *lps_body;
+	struct state *lps_loop;
+};
+
+struct switch_state {			/* used in lint_end_state only */
+	struct state *sws_case;
+	struct state *sws_break;
+	int sws_default_met;
+};
+
+/*	This union describes the (possibly incomplete) state at the end of the
+	mentioned construct.
+*/
+union lint_end_state {			/* used in lint_stack_entry only */
+	struct state *ule_if;
+	struct loop_state ule_loop;
+	struct switch_state ule_switch;
+};
+
+struct lint_stack_entry {
+	struct lint_stack_entry *next;
+	struct lint_stack_entry *ls_previous;
+	int ls_level;
+	struct state *ls_current;	/* used by all classes */
+	short ls_class;			/* IF, WHILE, DO, FOR, SWITCH, CASE */
+	union lint_end_state ls_end;
+};
+
+/* ALLOCDEF "lint_stack_entry" 10 */
+
+/* macros to access the union */
+#define LS_IF	 	ls_end.ule_if
+#define LS_TEST		ls_end.ule_loop.lps_test
+#define LS_BODY		ls_end.ule_loop.lps_body
+#define LS_LOOP		ls_end.ule_loop.lps_loop
+#define LS_CASE		ls_end.ule_switch.sws_case
+#define LS_BREAK	ls_end.ule_switch.sws_break
+#define LS_DEFAULT_MET	ls_end.ule_switch.sws_default_met
+
+/* describes a branch in the program, with its local idfs */
+struct state {
+	struct state *next;		/* only used by memory allocator */
+	struct auto_def *st_auto_list;
+	int st_notreached;		/* set if not reached */
+	int st_warned;			/* set if warning issued */
+};
+
+/* ALLOCDEF "state" 15 */
+
+/* describes the state of a local idf in a given branch of the program */
+struct auto_def {
+	struct auto_def *next;
+	struct idf *ad_idf;
+	struct def *ad_def;
+	int ad_used;
+	int ad_set;
+	int ad_maybe_set;
+};
+
+/* ALLOCDEF "auto_def" 20 */
+
+/* describes the state of an idf during expression evaluation */
+struct expr_state {			/*actually concerns idfs only */
+	struct expr_state *next;
+	struct idf *es_idf;		/* the idf with its offset */
+	arith es_offset;
+	int es_used;			/* value has been used */
+	int es_referred;		/* address has been taken */
+	int es_set;			/* has been assigned to */
+};
+
+/* ALLOCDEF "expr_state" 20 */
+

lang/cem/cemcom.ansi/label.c

@@ -0,0 +1,54 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*		L A B E L   H A N D L I N G		*/
+
+#include	"Lpars.h"
+#include	"level.h"
+#include	"idf.h"
+#include	"label.h"
+#include	"arith.h"
+#include	"def.h"
+#include	"type.h"
+#include	"stack.h"
+
+extern char options[];
+
+enter_label(idf, defining)
+	register struct idf *idf;
+{
+	/*	The identifier idf is entered as a label. If it is new,
+		it is entered into the idf list with the largest possible
+		scope, i.e., on the lowest possible level.
+		If defining, the label comes from a label statement.
+	*/
+	register struct def *def = idf->id_label;
+
+	if (def)	{
+		if (defining && def->df_initialized)
+			error("redeclaration of label %s", idf->id_text);
+	}
+	else	{
+		stack_idf(idf, stack_level_of(L_LOCAL));
+		def = new_def();
+		def->df_sc = LABEL;
+		idf->id_label = def;
+		def->df_file = idf->id_file;
+		def->df_line = idf->id_line;
+	}
+	if (def->df_address == 0)
+		def->df_address = (arith) text_label();
+	if (defining)
+		def->df_initialized = 1;
+}
+
+unstack_label(idf)
+	register struct idf *idf;
+{
+	/*	The scope in which the label idf occurred is left.
+	*/
+	if (!idf->id_label->df_initialized && !is_anon_idf(idf))
+		error("label %s not defined", idf->id_text);
+}

lang/cem/cemcom.ansi/label.h

@@ -0,0 +1,28 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*		L A B E L   D E F I N I T I O N				*/
+
+#include <em_label.h>		/* obtain definition of "label" */
+
+#define	NO_LABEL	(label) 0
+
+extern label lab_count;
+#define	text_label()	(lab_count++)		/* returns a new text label */
+
+extern label datlab_count;
+#define	data_label()	(datlab_count++)	/* returns a new data label */
+
+#define define_label(idf) enter_label(idf, 1);
+	/*	The identifier idf is defined as a label. If it is new,
+		it is entered into the idf list with the largest possible
+		scope, i.e., on the lowest possible level.
+	*/
+
+#define apply_label(idf) enter_label(idf, 0);
+	/*	The identifier idf is applied as a label. It may or may
+		not be there, and if it is there, it may be from a
+		declaration or another application.
+	*/

lang/cem/cemcom.ansi/level.h

@@ -0,0 +1,23 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*  LEVEL DEFINITIONS */
+
+/*	The level of the top-most stack_level is kept in a global variable
+	with the obvious name 'level'. Although this variable is consulted
+	by a variety of routines, it turns out that its actual value is of
+	importance in only a very few files. Therefore the names of the
+	values are put in a separate include-file.
+	The L_PROTO level is a dummy level, which only occurs within
+	prototype declarations. When the declaration is really declared
+	the level is turned into L_FORMAL2.
+*/
+
+#define	L_PROTO		(-1)		/* prototype declaration */
+#define	L_UNIVERSAL	0
+#define	L_GLOBAL	1
+#define	L_FORMAL1	2		/* formal declaration */
+#define	L_FORMAL2	3		/* formal definition */
+#define	L_LOCAL		4		/* and up */

lang/cem/cemcom.ansi/macro.str

@@ -0,0 +1,52 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* PREPROCESSOR: DEFINITION OF MACRO DESCRIPTOR */
+
+#include	"nopp.h"
+
+#ifndef NOPP
+/*	The flags of the mc_flag field of the macro structure. Note that
+	these flags can be set simultaneously.
+*/
+#define	NOFLAG		0		/* no special flags	*/
+#define	FUNC		0x1		/* function attached    */
+#define	NOUNDEF		0x2		/* reserved macro	*/
+#define	NOREPLACE	0x4		/* prevent recursion	*/
+
+#define	FORMALP 0200	/* mask for creating macro formal parameter	*/
+
+/*	The macro descriptor is very simple, except the fact that the
+	mc_text, which points to the replacement text, contains the
+	non-ascii characters \201, \202, etc, indicating the position of a
+	formal parameter in this text.
+*/
+struct macro	{
+	struct macro *next;
+	char *	mc_text;	/* the replacement text		*/
+	int	mc_nps;		/* number of formal parameters	*/
+	int	mc_length;	/* length of replacement text	*/
+	char	mc_flag;	/* marking this macro		*/
+};
+
+/* ALLOCDEF "macro" 20 */
+
+/* `token' numbers of keywords of command-line processor
+*/
+#define	K_UNKNOWN	0
+#define	K_DEFINE	1
+#define	K_ELIF		2
+#define	K_ELSE		3
+#define	K_ENDIF		4
+#define	K_ERROR		5
+#define	K_IF		6
+#define	K_IFDEF		7
+#define	K_IFNDEF	8
+#define	K_INCLUDE	9
+#define	K_LINE		10
+#define	K_PRAGMA	11
+#define	K_UNDEF		12
+#define K_FILE          100     /* for dependency generator */
+#endif /* NOPP */

lang/cem/cemcom.ansi/main.c

@@ -0,0 +1,514 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* MAIN PROGRAM */
+
+#include	"lint.h"
+#include	<system.h>
+#include	"debug.h"
+#include	"nopp.h"
+#include	"trgt_sizes.h"
+#include	"use_tmp.h"
+#include	"inputtype.h"
+#include	"input.h"
+#include	"level.h"
+#include	"idf.h"
+#include	"arith.h"
+#include	"type.h"
+#include	"proto.h"
+#include	"declar.h"
+#include	"tokenname.h"
+#include	"Lpars.h"
+#include	"LLlex.h"
+#include	<alloc.h>
+#include	"specials.h"
+#include	"nocross.h"
+#include	"sizes.h"
+#include	"align.h"
+#include	"macro.h"
+#include	"assert.h"
+
+extern struct tokenname tkidf[];
+extern char *symbol2str();
+extern char options[128];
+
+#ifndef NOPP
+int inc_pos = 1;			/* place where next -I goes */
+int inc_total = 0;
+int inc_max;
+char **inctable;
+
+extern int do_dependencies;
+extern char *dep_file;
+static File *dep_fd = STDOUT;
+
+extern char *getwdir();
+#endif /* NOPP */
+
+struct sp_id special_ids[] =	{
+	{"__setjmp", SP_SETJMP},	/* non-local goto's are registered */
+	{0, 0}
+};
+
+#ifndef NOCROSS
+arith
+	short_size = SZ_SHORT,
+	word_size = SZ_WORD,
+	dword_size = (2 * SZ_WORD),
+	int_size = SZ_INT,
+	long_size = SZ_LONG,
+	float_size = SZ_FLOAT,
+	double_size = SZ_DOUBLE,
+	lngdbl_size = SZ_LNGDBL,
+	pointer_size = SZ_POINTER;
+
+int
+	short_align = AL_SHORT,
+	word_align = AL_WORD,
+	int_align = AL_INT,
+	long_align = AL_LONG,
+	float_align = AL_FLOAT,
+	double_align = AL_DOUBLE,
+	lngdbl_align = AL_LNGDBL,
+	pointer_align = AL_POINTER,
+	struct_align = AL_STRUCT,
+	union_align = AL_UNION;
+#endif /* NOCROSS */
+
+#ifndef NOPP
+arith ifval;	/* ifval will contain the result of the #if expression	*/
+#endif /* NOPP */
+
+char *prog_name;
+
+main(argc, argv)
+	char *argv[];
+{
+	/* parse and interpret the command line options	*/
+	prog_name = argv[0];
+
+#ifndef NOPP
+	inctable = (char **) Malloc(10 * sizeof(char *));
+	inctable[0] = "";
+	inctable[1] = "/usr/include";
+	inctable[2] = 0;
+	inc_total = 3;
+	inc_max = 10;
+
+	init_pp();	/* initialise the preprocessor macros	*/
+#endif /* NOPP */
+
+	/*	Note: source file "-" indicates that the source is supplied
+		as standard input.  This is only allowed if INP_READ_IN_ONE is
+		not defined!
+	*/
+#ifdef INP_READ_IN_ONE
+	while (argc > 1 && *argv[1] == '-')
+#else /* INP_READ_IN_ONE */
+	while (argc > 1 && *argv[1] == '-' && argv[1][1] != '\0')
+#endif /* INP_READ_IN_ONE */
+	{
+		char *par = &argv[1][1];
+
+		do_option(par);
+		argc--, argv++;
+	}
+#ifdef	LINT
+	lint_init();
+#endif	/* LINT */
+	compile(argc - 1, &argv[1]);
+
+#ifdef	DEBUG
+	if (options['h']) hash_stat();
+	if (options['m']) Info();
+#endif	/* DEBUG */
+
+#ifndef NOPP
+	if (do_dependencies) {
+	    extern char *source;
+
+	    list_dependencies(source);
+	}
+#endif
+	sys_stop(err_occurred ? S_EXIT : S_END);
+	/*NOTREACHED*/
+}
+
+#ifndef NOPP
+
+struct dependency    *file_head;
+extern char *strrindex();
+
+list_dependencies(source)
+char *source;
+{
+    register struct dependency *p = file_head;
+
+    if (source) {
+	register char *s = strrindex(source, '.');
+
+	if (s && *(s+1)) {
+	    s++;
+	    *s++ = 'o';
+	    *s = '\0';
+	    /* the source may be in another directory than the
+	     * object generated, so don't include the pathname
+	     * leading to it.
+             */
+            if (s = strrindex(source, '/')) {
+		source = s + 1;
+	    }
+	}
+	else source = 0;
+    }
+    if (dep_file && !sys_open(dep_file, OP_WRITE, &dep_fd)) {
+	fatal("could not open %s", dep_file);
+    }
+    while (p) {
+	dependency(p->dep_idf->id_text, source);
+	p = p->next;
+    }
+}
+
+add_dependency(s)
+char *s;
+{
+    register struct idf *p = str2idf(s, 1);
+
+    if (! p->id_resmac) {
+	register struct dependency *q = new_dependency();
+
+	p->id_resmac = K_FILE;
+	q->dep_idf = p;
+	q->next = file_head;
+	file_head = q;
+    }
+}
+
+dependency(s, source)
+char *s, *source;
+{
+    if (options['i'] && !strncmp(s, "/usr/include/", 13)) {
+	return;
+    }
+    if (options['m'] && source) {
+	fprint(dep_fd, "%s: %s\n", source, s);
+    }
+    else    fprint(dep_fd, "%s\n", s);
+}
+
+#endif /* NOPP */
+
+char *source = 0;
+
+#ifdef GEN_NM_LIST
+char *nmlist = 0;
+#endif /* GEN_NM_LIST */
+
+compile(argc, argv)
+	char *argv[];
+{
+	char *result;
+#ifndef	LINT
+	register char *destination = 0;
+#endif	/* LINT */
+
+#ifdef DEBUG
+#ifndef NOPP
+	int pp_only = options['E'] || options['P'] || options['C'];
+#endif /* NOPP */
+#endif
+
+	switch (argc) {
+	case 1:
+#ifndef	LINT
+#ifdef DEBUG
+#ifndef NOPP
+		if (!pp_only)
+#endif /* NOPP */
+#endif
+			fatal("%s: destination file not specified", prog_name);
+#endif	/* LINT */
+		break;
+
+#ifndef	LINT
+	case 2:
+		destination = argv[1];
+		break;
+#ifdef GEN_NM_LIST
+	case 3:
+		nmlist = argv[2];
+		destination = argv[1];
+		break;
+#endif /* GEN_NM_LIST */
+#endif	/* LINT */
+
+	default:
+#ifndef	LINT
+#ifdef GEN_NM_LIST
+		fatal("use: %s source destination [namelist]", prog_name);
+#else /* GEN_NM_LIST */
+		fatal("use: %s source destination", prog_name);
+#endif /* GEN_NM_LIST */
+#else	/* LINT */
+		fatal("use: %s source", prog_name);
+#endif	/* LINT */
+		break;
+	}
+
+	if (strcmp(argv[0], "-"))
+		FileName = source = argv[0];
+	else {
+		source = 0;
+		FileName = Salloc("standard input", (unsigned) 16);
+	}
+
+	if (!InsertFile(source, (char **) 0, &result)) /* read the source file	*/
+		fatal("%s: no source file %s\n", prog_name, FileName);
+	File_Inserted = 1;
+	init();
+	LineNumber = 0;
+	nestlow = -1;
+
+#ifndef	LINT
+	init_code(destination
+		  && strcmp(destination, "-") != 0
+			? destination
+			: 0);
+#endif	/* LINT */
+
+#ifndef NOPP
+	WorkingDir = getwdir(source);
+	PushLex();			/* initialize lex machine */
+#else /* NOPP */
+	GetToken(&ahead);
+#endif /* NOPP */
+
+#ifdef DEBUG
+#ifndef NOPP
+	if (pp_only) /* run the preprocessor as if it is stand-alone	*/
+		preprocess();
+	else
+#endif /* NOPP */
+#endif /* DEBUG */
+	{
+		/* compile the source text			*/
+		C_program();
+
+#ifdef PREPEND_SCOPES
+		prepend_scopes();
+#endif /* PREPEND_SCOPES */
+
+#ifndef	LINT
+		end_code();
+#endif	/* LINT */
+
+#ifdef	DEBUG
+		if (options['u'])	{
+			unstack_level();	/* unstack L_GLOBAL */
+		}
+		if (options['f'] || options['t'])
+			dumpidftab("end of main", options['f'] ? 7 : 0);
+#endif	/* DEBUG */
+	}
+#ifndef	NOPP
+	PopLex();
+#endif	/* NOPP */
+}
+
+init()
+{
+	init_cst();	/* initialize variables of "cstoper.c"		*/
+	reserve(tkidf);		/* mark the C reserved words as such	*/
+	init_specials(special_ids);	/* mark special ids as such	*/
+
+	schar_type = standard_type(CHAR, 0, 1, (arith)1);
+	uchar_type = standard_type(CHAR, UNSIGNED, 1, (arith)1);
+
+	short_type = standard_type(SHORT, 0, short_align, short_size);
+	ushort_type = standard_type(SHORT, UNSIGNED, short_align, short_size);
+
+	/*	Treat type `word' as `int', having its own size and
+		alignment requirements.
+		This type is transparent to the user.
+	*/
+	word_type = standard_type(INT, 0, word_align, word_size);
+	uword_type = standard_type(INT, UNSIGNED, word_align, word_size);
+
+	int_type = standard_type(INT, 0, int_align, int_size);
+	uint_type = standard_type(INT, UNSIGNED, int_align, int_size);
+
+	long_type = standard_type(LONG, 0, long_align, long_size);
+	ulong_type = standard_type(LONG, UNSIGNED, long_align, long_size);
+
+	float_type = standard_type(FLOAT, 0, float_align, float_size);
+	double_type = standard_type(DOUBLE, 0, double_align, double_size);
+	lngdbl_type = standard_type(LNGDBL, 0, lngdbl_align, lngdbl_size);
+	void_type = standard_type(VOID, 0, 1, (arith)-1);
+	error_type = standard_type(ERRONEOUS, 0, 1, (arith)1);
+	error_type->tp_up = error_type;
+
+	/*	Pointer Arithmetic type: all arithmetics concerning
+		pointers is supposed to be performed in the
+		pointer arithmetic type which is equal to either
+		int_type or long_type, depending on the pointer_size
+	*/
+	if ((int)pointer_size == (int)int_size)
+		pa_type = int_type;
+	else
+	if ((int)pointer_size == (int)long_size)
+		pa_type = long_type;
+	else
+		fatal("pointer size incompatible with any integral size");
+
+	if ((int)int_size != (int)word_size)
+		fatal("int_size and word_size are not equal");
+	if ((int)short_size > (int)int_size || (int)int_size > (int)long_size)
+		fatal("sizes of short/int/long decreasing");
+	if ((int)float_size > (int)double_size || (int)double_size > (int)lngdbl_size)
+		fatal("sizes of float/double/long double decreasing");
+
+	/* Build a type for function returning int (3.3.2.2) */
+	funint_type = construct_type(FUNCTION, int_type, 0, (arith)0, NO_PROTO);
+	string_type = construct_type(POINTER, schar_type, 0, (arith)0, NO_PROTO);
+
+	/* Define the standard type identifiers. */
+	add_def(str2idf("char", 0), TYPEDEF, schar_type, L_UNIVERSAL);
+	add_def(str2idf("int", 0), TYPEDEF, int_type, L_UNIVERSAL);
+	add_def(str2idf("float", 0), TYPEDEF, float_type, L_UNIVERSAL);
+	add_def(str2idf("double", 0), TYPEDEF, double_type, L_UNIVERSAL);
+	add_def(str2idf("void", 0), TYPEDEF, void_type, L_UNIVERSAL);
+	stack_level();
+}
+
+init_specials(si)
+	register struct sp_id *si;
+{
+	while (si->si_identifier)	{
+		struct idf *idf = str2idf(si->si_identifier, 0);
+
+		if (idf->id_special)
+			fatal("maximum identifier length insufficient");
+		idf->id_special = si->si_flag;
+		si++;
+	}
+}
+
+#ifdef DEBUG
+#ifndef NOPP
+preprocess()
+{
+	/*	preprocess() is the "stand-alone" preprocessor which
+		consecutively calls the lexical analyzer LLlex() to get
+		the tokens and prints them in a suitable way.
+	*/
+	static unsigned int lastlineno = 0;
+	static char *lastfilenm = "";
+
+	while (LLlex() !=  EOI)	{
+		if (lastlineno != dot.tk_line)	{
+			if (strcmp(lastfilenm, dot.tk_file) == 0)	{
+				if (dot.tk_line - lastlineno <= 1)	{
+					lastlineno++;
+					print("\n");
+				}
+				else	{
+					lastlineno = dot.tk_line;
+					if (!options['P'])
+						print("\n#line %ld \"%s\"\n",
+							lastlineno,
+							lastfilenm
+						);
+				}
+			}
+			else	{
+				lastfilenm = dot.tk_file;
+				lastlineno = dot.tk_line;
+				if (!options['P'])
+					print("\n#line %ld \"%s\"\n",
+						lastlineno, lastfilenm);
+			}
+		}
+		else
+		if (strcmp(lastfilenm, dot.tk_file) != 0)	{
+			lastfilenm = dot.tk_file;
+			if (!options['P'])
+				print("\n#line %ld \"%s\"\n",
+					lastlineno, lastfilenm);
+		}
+		switch (DOT)	{
+		case IDENTIFIER:
+		case TYPE_IDENTIFIER:
+			print("%s ", dot.tk_idf->id_text);
+			break;
+		case STRING:
+		{
+			char sbuf[1024];	/* a transient buffer */
+			char *bts2str();
+
+			print("\"%s\" ", bts2str(dot.tk_bts, dot.tk_len -
+			1, sbuf));
+			break;
+		}
+		case INTEGER:
+			print("%ld ", dot.tk_ival);
+			break;
+		case FLOATING:
+			print("%s ", dot.tk_fval);
+			break;
+		case EOI:
+		case EOF:
+			return;
+		default:	/* very expensive...	*/
+			print("%s ", symbol2str(DOT));
+		}
+	}
+}
+#endif /* NOPP */
+
+Info()
+{
+	extern int cnt_string_cst, cnt_formal,
+		    cnt_decl_unary, cnt_def, cnt_expr, cnt_field,
+		    cnt_e_stack, cnt_localvar, cnt_proto, cnt_repl,
+		    cnt_args, cnt_macro, cnt_stack_level,
+		    cnt_stack_entry, cnt_stmt_block, cnt_sdef, cnt_tag,
+		    cnt_switch_hdr, cnt_case_entry, cnt_type, cnt_brace,
+		    cnt_lint_stack_entry, cnt_state, cnt_auto_def,
+		    cnt_expr_state, cnt_argument;
+	print("\
+%6d string_cst\n%6d formal\n\
+%6d decl_unary\n%6d def\n%6d expr\n%6d field\n\
+%6d e_stack\n%6d localvar\n%6d proto\n%6d repl\n\
+%6d args\n%6d macro\n%6d stack_level\n\
+%6d stack_entry\n%6d stmt_block\n%6d sdef\n%6d tag\n\
+%6d switch_hdr\n%6d case_entry\n%6d type\n%6d brace\n\
+%6d lint_stack_entry\n%6d state\n%6d auto_def\n\
+%6d expr_state\n%6d argument\n",
+	cnt_string_cst, cnt_formal,
+	cnt_decl_unary, cnt_def, cnt_expr, cnt_field,
+	cnt_e_stack, cnt_localvar, cnt_proto, cnt_repl,
+	cnt_args, cnt_macro, cnt_stack_level,
+	cnt_stack_entry, cnt_stmt_block, cnt_sdef, cnt_tag,
+	cnt_switch_hdr, cnt_case_entry, cnt_type, cnt_brace,
+	cnt_lint_stack_entry, cnt_state, cnt_auto_def,
+	cnt_expr_state, cnt_argument);
+
+
+}
+#endif /* DEBUG */
+
+void
+No_Mem()				/* called by alloc package */
+{
+	fatal("out of memory");
+}
+
+void
+C_failed()				/* called by EM_code module */
+{
+	fatal("write failed");
+}
+

lang/cem/cemcom.ansi/make.allocd

@@ -0,0 +1,16 @@
+#!/bin/sh
+
+sed -e '
+s:^.*[ 	]ALLOCDEF[ 	].*"\(.*\)"[ 	]*\([0-9][0-9]*\).*$:\
+/* allocation definitions of struct \1 */\
+extern char *st_alloc();\
+extern struct \1 *h_\1;\
+#ifdef DEBUG\
+extern int cnt_\1;\
+extern char *std_alloc();\
+#define new_\1() ((struct \1 *) std_alloc((char **)\&h_\1, sizeof(struct \1), \2, \&cnt_\1))\
+#else\
+#define	new_\1() ((struct \1 *) st_alloc((char **)\&h_\1, sizeof(struct \1), \2))\
+#endif\
+#define	free_\1(p) st_free(p, \&h_\1, sizeof(struct \1))\
+:'

lang/cem/cemcom.ansi/make.hfiles

@@ -0,0 +1,36 @@
+#!/bin/sh
+: Update Files from database
+
+PATH=/bin:/usr/bin
+
+case $# in
+1) ;;
+*)	echo use: $0 file >&2
+	exit 1
+esac
+
+(
+IFCOMMAND="if [ -r \$FN ] ;\
+	then	if cmp -s \$FN \$TMP;\
+		then	rm \$TMP;\
+		else	mv \$TMP \$FN;\
+			echo update \$FN;\
+		fi;\
+	else	mv \$TMP \$FN;\
+		echo create \$FN;\
+	fi"
+echo 'TMP=.uf$$'
+echo 'FN=$TMP'
+echo 'cat >$TMP <<\!EOF!'
+sed -n '/^!File:/,${
+/^$/d
+/^!File:[	 ]*\(.*\)$/s@@!EOF!\
+'"$IFCOMMAND"'\
+FN=\1\
+cat >$TMP <<\\!EOF!@
+p
+}' $1
+echo '!EOF!'
+echo $IFCOMMAND
+) |
+sh

lang/cem/cemcom.ansi/make.next

@@ -0,0 +1,7 @@
+echo '#include "debug.h"'
+sed -n '
+s:^.*ALLOCDEF.*"\(.*\)".*$:struct \1 *h_\1 = 0;\
+#ifdef DEBUG\
+int cnt_\1 = 0;\
+#endif:p
+' $*

lang/cem/cemcom.ansi/make.tokcase

@@ -0,0 +1,41 @@
+cat <<'--EOT--'
+/* Generated by make.tokcase */
+/* $Id$ */
+#include "Lpars.h"
+
+char *
+symbol2str(tok)
+	int tok;
+{
+#define SIZBUF	8
+	/* allow for a few invocations in f.i. an argument list */
+	static char buf[SIZBUF];
+	static int index;
+
+	switch (tok) {
+--EOT--
+
+sed '
+/{[A-Z]/!d
+s/.*{\(.*\),.*\(".*"\).*$/	case \1 :\
+		return \2;/
+'
+
+cat <<'--EOT--'
+	default:
+		if (tok <= 0) return "end of file";
+		if (tok < 040 || tok >= 0177) {
+			return "bad token";
+		}
+		/* fall through */
+	case '\n':
+	case '\f':
+	case '\v':
+	case '\r':
+	case '\t':
+		index = (index+2) & (SIZBUF-1);
+		buf[index] = tok;
+		return &buf[index];
+	}
+}
+--EOT--

lang/cem/cemcom.ansi/make.tokfile

@@ -0,0 +1,11 @@
+cat <<'--EOT--'
+/* Generated by make.tokfile */
+/* $Id$ */
+--EOT--
+
+sed '
+/{[A-Z]/!d
+s/.*{//
+s/,.*//
+s/.*/%token	&;/
+'

lang/cem/cemcom.ansi/mcomm.c

@@ -0,0 +1,246 @@
+/* $Header$ */
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/*	mcomm.c -- change ".lcomm name" into ".comm name" where "name"
+	is specified in a list.
+*/
+#include <stdio.h>
+
+#define IDFSIZE 4096
+
+char *readfile();
+
+struct node {
+	char *name;
+	struct node *left, *right;
+};
+
+char *
+Malloc(n)
+	unsigned n;
+{
+	char *space;
+	char *malloc();
+
+	if ((space = malloc(n)) == 0) {
+		fprintf(stderr, "out of memory\n");
+		exit(1);
+	}
+	return space;
+}
+
+struct node *make_tree();
+
+#define new_node() ((struct node *) Malloc(sizeof (struct node)))
+
+main(argc, argv)
+	char *argv[];
+{
+	char *nl_file, *as_file;
+	char *nl_text, *as_text;
+	struct node *nl_tree = 0;
+	int nl_siz, as_siz;
+
+	if (argc != 3) {
+		fprintf(stderr, "use: %s namelist assembler_file\n", argv[0]);
+		exit(1);
+	}
+	nl_file = argv[1];
+	as_file = argv[2];
+
+	if ((nl_text = readfile(nl_file, &nl_siz)) == 0) {
+		fprintf(stderr, "%s: cannot read namelist %s\n",
+			argv[0], nl_file);
+		exit(1);
+	}
+
+	if ((as_text = readfile(as_file, &as_siz)) == 0) {
+		fprintf(stderr, "%s: cannot read assembler file %s\n",
+			argv[0], as_file);
+		exit(1);
+	}
+
+	nl_tree = make_tree(nl_text);
+	edit(as_text, nl_tree);
+
+	if (writefile(as_file, as_text, as_siz) == 0) {
+		fprintf(stderr, "%s: cannot write to %s\n", argv[0], as_file);
+		exit(1);
+	}
+	return 0;
+}
+
+#include <sys/types.h>
+#include <stat.h>
+
+char *
+readfile(filename, psiz)
+	char *filename;
+	int *psiz;
+{
+	struct stat stbuf;	/* for `stat' to get filesize		*/
+	register int fd;	/* filedescriptor for `filename'	*/
+	register char *cbuf;	/* pointer to buffer to be returned	*/
+
+	if (((fd = open(filename, 0)) < 0) || (fstat(fd, &stbuf) != 0))
+		return 0;
+	cbuf = Malloc(stbuf.st_size + 1);
+	if (read(fd, cbuf, stbuf.st_size) != stbuf.st_size)
+		return 0;
+	cbuf[stbuf.st_size] = '\0';
+	close(fd);		/* filedes no longer needed	*/
+	*psiz = stbuf.st_size;
+	return cbuf;
+}
+
+int
+writefile(filename, text, size)
+	char *filename, *text;
+{
+	register fd;
+
+	if ((fd = open(filename, 1)) < 0)
+		return 0;
+	if (write(fd, text, size) != size)
+		return 0;
+	close(fd);
+	return 1;
+}
+
+struct node *
+make_tree(nl)
+	char *nl;
+{
+	char *id = nl;
+	struct node *tree = 0;
+
+	while (*nl) {
+		if (*nl == '\n') {
+			*nl = '\0';
+			insert(&tree, id);
+			id = ++nl;
+		}
+		else {
+			++nl;
+		}
+	}
+	return tree;
+}
+
+insert(ptree, id)
+	struct node **ptree;
+	char *id;
+{
+	register cmp;
+
+	if (*ptree == 0) {
+		register struct node *nnode = new_node();
+
+		nnode->name = id;
+		nnode->left = nnode->right = 0;
+		*ptree = nnode;
+	}
+	else
+	if ((cmp = strcmp((*ptree)->name, id)) < 0)
+		insert(&((*ptree)->right), id);
+	else
+	if (cmp > 0)
+		insert(&((*ptree)->left), id);
+}
+
+struct node *
+find(tree, id)
+	struct node *tree;
+	char *id;
+{
+	register cmp;
+
+	if (tree == 0)
+		return 0;
+	if ((cmp = strcmp(tree->name, id)) < 0)
+		return find(tree->right, id);
+	if (cmp > 0)
+		return find(tree->left, id);
+	return tree;
+}
+
+edit(text, tree)
+	char *text;
+	struct node *tree;
+{
+	register char *ptr = text;
+	char idbuf[IDFSIZE];
+	register char *id;
+	register char *save_ptr;
+
+	while (*ptr) {
+		if (
+			*ptr   == '.' &&
+			*++ptr == 'l' &&
+			*++ptr == 'c' &&
+			*++ptr == 'o' &&
+			*++ptr == 'm' &&
+			*++ptr == 'm' &&
+			(*++ptr == ' ' || *ptr == '\t')
+		)
+		{
+			save_ptr = ptr - 6;
+			while (*++ptr == ' ' || *ptr == '\t')
+				;
+			if (*ptr == '_')
+				++ptr;
+			if (InId(*ptr)) {
+				id = &idbuf[0];
+				*id++ = *ptr++;
+				while (InId(*ptr))
+					*id++ = *ptr++;
+				*id = '\0';
+				if (find(tree, idbuf) != 0) {
+					*save_ptr++ = ' ';
+					*save_ptr++ = '.';
+				}
+			}
+		}
+		while (*ptr && *ptr++ != '\n')
+			;
+	}
+}
+
+InId(c)
+{
+	switch (c) {
+
+	case 'a': case 'b': case 'c': case 'd': case 'e':
+	case 'f': case 'g': case 'h': case 'i': case 'j':
+	case 'k': case 'l': case 'm': case 'n': case 'o':
+	case 'p': case 'q': case 'r': case 's': case 't':
+	case 'u': case 'v': case 'w': case 'x': case 'y':
+	case 'z':
+	case 'A': case 'B': case 'C': case 'D': case 'E':
+	case 'F': case 'G': case 'H': case 'I': case 'J':
+	case 'K': case 'L': case 'M': case 'N': case 'O':
+	case 'P': case 'Q': case 'R': case 'S': case 'T':
+	case 'U': case 'V': case 'W': case 'X': case 'Y':
+	case 'Z':
+	case '_':
+	case '.':
+	case '0': case '1': case '2': case '3': case '4':
+	case '5': case '6': case '7': case '8': case '9':
+		return 1;
+	
+	default:
+		return 0;
+	}
+}
+
+puttree(nd)
+	struct node *nd;
+{
+	if (nd) {
+		puttree(nd->left);
+		printf("%s\n", nd->name);
+		puttree(nd->right);
+	}
+}

lang/cem/cemcom.ansi/mes.h

@@ -0,0 +1,8 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* MESSAGE ADMINISTRATION */
+
+extern int fp_used;	/* code.c	*/

lang/cem/cemcom.ansi/nmclash.c

@@ -0,0 +1,9 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* Accepted if many characters of long names are significant */
+/* $Header$ */
+abcdefghijklmnopr() { }
+abcdefghijklmnopq() { }
+main() { }

lang/cem/cemcom.ansi/options

@@ -0,0 +1,34 @@
+User options:
+a	no warnings or stricts
+A	while running preprocessor, generate makefile dependencies
+C	while running preprocessor, copy comment
+d	perform a small dataflow analysis
+D	see identifier following as a macro
+E	run preprocessor only
+g	produce symbol table for debugger
+i	suppress /usr/include include files in dependency list
+I	expand include table with directory name following
+m	generate file.o: file1.h format dependency lines
+M	set identifier length
+n	don't generate register messages
+L	don't generate linenumbers and filename indications
+o	no warnings or stricts about normal old-style constuctions
+p	trace
+P	in running the preprocessor do not output '# line' lines
+s	no stricts
+S	switch density
+T	take path following as directory for storing temporary file(s)
+U	undefine predefined name
+V	set objectsize and alignment requirements
+w	suppress warning diagnostics
+
+
+Debug options:
+
+f	dump whole identifier table, including macros and reserved words
+h	supply hash table statistics
+i	print name of include files
+r	right-adjust bitfield
+t	dump table of identifiers
+u	unstack L_UNIVERSAL
+x	dump expressions

lang/cem/cemcom.ansi/options.c

@@ -0,0 +1,317 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	U S E R   O P T I O N - H A N D L I N G		*/
+
+#include	"lint.h"
+#include	"botch_free.h"
+#include	<alloc.h>
+#include	"nopp.h"
+#include	"idfsize.h"
+#include	"nobitfield.h"
+#include	"class.h"
+#include	"macro.h"
+#include	"idf.h"
+#include	"arith.h"
+#include	"sizes.h"
+#include	"align.h"
+#include	"use_tmp.h"
+#include	"dataflow.h"
+#include	"dbsymtab.h"
+
+#ifndef NOPP
+extern char **inctable;
+extern int inc_pos;
+extern int inc_max;
+extern int inc_total;
+int do_dependencies = 0;
+char *dep_file = 0;
+
+#endif /* NOPP */
+
+char options[128];			/* one for every char	*/
+#ifdef	LINT
+char loptions[128];			/* one for every char	*/
+#endif	/* LINT */
+
+extern int idfsize;
+extern int density;
+
+static int txt2int();
+
+do_option(text)
+	char *text;
+{
+	register char opt;
+
+next_option:			/* to allow combined one-char options */
+	switch (opt = *text++)	{
+
+	case 0:			/* to end the goto next_option loop */
+		break;
+
+	default:
+#ifndef	LINT
+		fatal("illegal option: %c", opt);
+#else	/* LINT */
+		warning("illegal option: %c", opt);
+#endif	/* LINT */
+		break;
+
+	case '-':
+		options[*text++] = 1;	/* flags, debug options etc.	*/
+		goto next_option;
+
+#ifndef LINT
+#ifndef NOPP
+        case 'A' :      /* Amake dependency generation */
+                do_dependencies = 1;
+                if (*text) {
+                        dep_file = text;
+                }
+                break;
+        case 'i':
+        case 'm':
+             	options[opt] = 1;
+            	break;
+#endif /* NOPP */
+#endif /* LINT */
+#ifdef DBSYMTAB
+	case 'g':	/* symbol table for debugger */
+		options['g'] = 1;
+		options['n'] = 1;
+		break;
+#endif /* DBSYMTAB */
+
+#ifndef	LINT
+#ifdef	DATAFLOW
+	case 'd':
+#endif	/* DATAFLOW */
+	case 'p':			/* procentry/procexit */
+	case 'L' :			/* no fil/lin */
+	case 'n':			/* use no registers */
+	case 'w':			/* no warnings will be given */
+	case 's':			/* no stricts will be given */
+	case 'o':			/* no complaints about old-style */
+		options[opt] = 1;
+		goto next_option;
+	case 'a':		/* suppress all but errors diagnostics */
+		options['w'] = 1;	/* implies -a */
+		options['s'] = 1;
+		goto next_option;
+#endif	/* LINT */
+
+#ifdef	LINT
+	case 'h':	/* heuristic tests */
+	case 'v':	/* no complaints about unused arguments */
+	case 'a':	/* check long->int int->long conversions */
+	case 'b':	/* don't report unreachable break-statements */
+	case 'x':	/* complain about unused extern declared variables */
+	case 'u':	/* no "used but not defined"; for pass 2 */
+	case 'L':	/* lintlibrary */
+		loptions[opt] = 1;
+		goto next_option;
+#endif	/* LINT */
+
+#ifndef NOPP
+	case 'D' :	{	/* -Dname :	predefine name		*/
+		register char *cp = text, *name, *mactext;
+		unsigned maclen;
+
+		if (class(*cp) != STIDF && class(*cp) != STELL) {
+			error("identifier missing in -D%s", text);
+			break;
+		}
+
+		name = cp;
+
+		while (*cp && in_idf(*cp)) {
+			++cp;
+		}
+
+		if (!*cp) {			/* -Dname */
+			maclen = 1;
+			mactext = Salloc("1", 2);
+		}
+		else
+		if (*cp == '=')	{		/* -Dname=text	*/
+			*cp++ = '\0';		/* end of name	*/
+			maclen = (unsigned) strlen(cp);
+			mactext = Salloc(cp, maclen + 1);
+		}
+		else	{			/* -Dname?? */
+			error("malformed option -D%s", text);
+			break;
+		}
+
+		macro_def(str2idf(name, 0), mactext, -1, (int)maclen, NOFLAG);
+		break;
+	}
+
+	case 'I' :	/* -Ipath : insert "path" into include list	*/
+		if (*text)	{
+			int i;
+			register char *new = text;
+			
+			if (inc_total >= inc_max) {
+				inctable = (char **)
+				   Realloc((char *)inctable,
+					   (unsigned)((inc_max+=10)*sizeof(char *)));
+			}
+				
+			for (i = inc_pos++; i < inc_total ; i++) {
+				char *tmp = inctable[i];
+				
+				inctable[i] = new;
+				new = tmp;
+			}
+			inc_total++;
+		}
+		else inctable[inc_pos] = 0;
+		break;
+#endif /* NOPP */
+
+	case 'M':	/* maximum identifier length */
+		idfsize = txt2int(&text);
+		if (*text || idfsize <= 0)
+			fatal("malformed -M option");
+		if (idfsize > IDFSIZE)
+			fatal("maximum identifier length is %d", IDFSIZE);
+		break;
+
+#ifdef	LINT
+	case 'S' : {		/* -Sint :	static scope number for lint */
+		extern int stat_number;
+		stat_number = txt2int(&text);
+		break;
+	}
+#endif	/* LINT */
+
+	case 'T' : {
+#ifdef USE_TMP
+		extern char *C_tmpdir;
+		if (*text)
+			C_tmpdir = text;
+		else
+			C_tmpdir = ".";
+#else /* USE_TMP */
+		warning("-T option ignored");
+#endif /* USE_TMP */
+		break;
+	}
+		
+#ifndef NOPP
+	case 'U' :		/* -Uname :	undefine predefined	*/
+		if (*text) do_undef(str2idf(text, 0));
+		break;
+#endif /* NOPP */
+
+#ifndef	LINT
+#ifndef NOCROSS
+	case 'V' :	/* set object sizes and alignment requirements	*/
+	{
+		register arith sz, algn;
+		char c;
+
+		while (c = *text++)	{
+			sz = txt2int(&text);
+			algn = 0;
+			if (*text == '.')	{
+				text++;
+				algn = txt2int(&text);
+			}
+			switch (c)	{
+			case 's':	/* short	*/
+				if (sz != (arith)0)
+					short_size = sz;
+				if (algn != 0)
+					short_align = algn;
+				break;
+			case 'w':	/* word		*/
+				if (sz != (arith)0)
+					dword_size = (word_size = sz) << 1;
+				if (algn != 0)
+					word_align = algn;
+				break;
+			case 'i':	/* int		*/
+				if (sz != (arith)0)
+					int_size = sz;
+				if (algn != 0)
+					int_align = algn;
+				break;
+			case 'l':	/* long		*/
+				if (sz != (arith)0)
+					long_size = sz;
+				if (algn != 0)
+					long_align = algn;
+				break;
+			case 'f':	/* float	*/
+				if (sz != (arith)0)
+					float_size = sz;
+				if (algn != 0)
+					float_align = algn;
+				break;
+			case 'd':	/* double	*/
+				if (sz != (arith)0)
+					double_size = sz;
+				if (algn != 0)
+					double_align = algn;
+				break;
+			case 'x':	/* long double	*/
+				if (sz != (arith)0)
+					lngdbl_size = sz;
+				if (algn != 0)
+					lngdbl_align = algn;
+				break;
+			case 'p':	/* pointer	*/
+				if (sz != (arith)0)
+					pointer_size = sz;
+				if (algn != 0)
+					pointer_align = algn;
+				break;
+			case 'r':	/* adjust bitfields right	*/
+#ifndef NOBITFIELD
+				options['r'] = 1;
+#else /* NOBITFIELD */
+				warning("bitfields are not implemented");
+#endif /* NOBITFIELD */
+				break;
+			case 'S':	/* initial struct alignment	*/
+				if (sz != (arith)0)
+					struct_align = sz;
+				break;
+			case 'U':	/* initial union alignment	*/
+				if (sz != (arith)0)
+					union_align = sz;
+				break;
+			default:
+				error("-V: bad type indicator %c\n", c);
+			}
+		}
+		break;
+	}
+	case 'S':
+		density = txt2int(&text);
+		break;
+#endif /* NOCROSS */
+#endif	/* LINT */
+	}
+}
+
+static int
+txt2int(tp)
+	register char **tp;
+{
+	/*	the integer pointed to by *tp is read, while increasing
+		*tp; the resulting value is yielded.
+	*/
+	register int val = 0, ch;
+	
+	while (ch = **tp, ch >= '0' && ch <= '9')	{
+		val = val * 10 + ch - '0';
+		(*tp)++;
+	}
+	return val;
+}

lang/cem/cemcom.ansi/pragma.c

@@ -0,0 +1,46 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* PREPROCESSOR: PRAGMA INTERPRETER */
+
+#include	"debug.h"
+#include	"idf.h"
+
+#define P_UNKNOWN	0
+#define NR_PRAGMAS	0
+
+struct pkey {
+	char *pk_name;
+	int pk_key;
+} pragmas[NR_PRAGMAS + 1] = {
+	{0,		P_UNKNOWN}
+};
+
+extern struct idf *GetIdentifier();
+
+do_pragma()
+{
+#if	NR_PRAGMAS
+	register struct pkey *pkp = &pragmas[0];
+#endif
+	register struct idf *id = GetIdentifier(1);
+
+	if (id != (struct idf *)0) {
+#if	NR_PRAGMAS
+		while(pkp->pk_name) {
+			if (strcmp(pkp->pk_name, id->id_text) == 0)
+				break;
+			pkp++;
+		}
+
+		switch (pkp->pk_key) {
+		case P_UNKNOWN:
+		default:
+			break;
+		}
+#endif
+		SkipToNewLine();
+	}
+}

lang/cem/cemcom.ansi/program.g

@@ -0,0 +1,238 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* PROGRAM PARSER */
+
+/*	The presence of typedef declarations renders it impossible to
+	make a context-free grammar of C. Consequently we need
+	context-sensitive parsing techniques, the simplest one being
+	a subtle cooperation between the parser and the lexical scanner.
+	The lexical scanner has to know whether to return IDENTIFIER
+	or TYPE_IDENTIFIER for a given tag, and it obtains this information
+	from the definition list, as constructed by the parser.
+	The present grammar is essentially LL(2), and is processed by
+	a parser generator which accepts LL(1) with tie breaking rules
+	in C, of the form %if(cond) and %while(cond). To solve the LL(1)
+	ambiguities, the lexical scanner does a one symbol look-ahead.
+	This symbol, however, cannot always be correctly assessed, since
+	the present symbol may cause a change in the definition list
+	which causes the identification of the look-ahead symbol to be
+	invalidated.
+	The lexical scanner relies on the parser (or its routines) to
+	detect this situation and then update the look-ahead symbol.
+	An alternative approach would be to reassess the look-ahead symbol
+	in the lexical scanner when it is promoted to dot symbol. This
+	would be more beautiful but less correct, since then for a short
+	while there would be a discrepancy between the look-ahead symbol
+	and the definition list; I think it would nevertheless work in
+	correct programs.
+	A third solution would be to enter the identifier as soon as it
+	is found; its storage class is then known, although its full type
+	isn't. We would have to fill that in afterwards.
+
+	At block exit the situation is even worse. Upon reading the
+	closing brace, the names declared inside the function are cleared
+	from the name list. This action may expose a type identifier that
+	is the same as the identifier in the look-ahead symbol. This
+	situation certainly invalidates the third solution, and casts
+	doubts upon the second.
+*/
+
+%lexical	LLlex;
+%start		C_program, program;
+%start		If_expr, control_if_expression;
+
+{
+#include	"lint.h"
+#include	"nopp.h"
+#include	"debug.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"LLlex.h"
+#include	"idf.h"
+#include	"label.h"
+#include	"type.h"
+#include	"declar.h"
+#include	"decspecs.h"
+#include	"code.h"
+#include	"expr.h"
+#include	"def.h"
+#ifdef	LINT
+#include	"l_lint.h"
+#endif	/* LINT */
+
+#ifndef NOPP
+extern arith ifval;
+#endif /* NOPP */
+
+extern error();
+}
+
+control_if_expression
+	{
+		struct expr *exprX;
+	}
+:
+	constant_expression(&exprX)
+		{
+#ifndef NOPP
+			register struct expr *expr = exprX;
+			if (expr->ex_flags & EX_SIZEOF)
+				expr_error(expr,
+					"sizeof not allowed in preprocessor");
+			ifval = expr->VL_VALUE;
+			free_expression(expr);
+#endif /* NOPP */
+		}
+;
+
+/* 3.7 */
+program:
+	[%persistent external_definition]*
+	{ unstack_world(); }
+;
+
+/*	A C identifier definition is remarkable in that it formulates
+	the declaration in a way different from most other languages:
+	e.g., rather than defining x as a pointer-to-integer, it defines
+	*x as an integer and lets the compiler deduce that x is actually
+	pointer-to-integer.  This has profound consequences, both for the
+	structure of an identifier definition and for the compiler.
+	
+	A definition starts with a decl_specifiers, which contains things
+	like
+		typedef int
+	which is implicitly repeated for every definition in the list, and
+	then for each identifier a declarator is given, of the form
+		*a()
+	or so.  The decl_specifiers is kept in a struct decspecs, to be
+	used again and again, while the declarator is stored in a struct
+	declarator, only to be passed to declare_idf together with the
+	struct decspecs.
+
+	With the introduction of prototypes, extra problems for the scope
+	administration were introduced as well.  We can have, for example,
+	int x(double x);
+	and
+	int x(double x) { ... use(x) ... }
+	In the first case, the parameter name can be forgotten, whereas in
+	the second case, the parameter should have a block scope.  The
+	problem lies in the fact that the parameter's type is known before
+	the type of the function, which causes the def structure to be on
+	the end of the list.  Our solution is as follows:
+	1-  In case of a declaration, throw the parameter identifier away
+	    before the declaration of the outer x.
+	2-  In case of a definition, the function begin_proc() changes the
+	    def list for the identifier.  This means that declare_idf()
+	    contains an extra test in case we already saw a declaration of
+	    such a function, because this function is called before
+	    begin_proc().
+*/
+
+external_definition
+	{	struct decspecs Ds;
+		struct	declarator Dc;
+	}
+:
+	{	Ds = null_decspecs;
+		Dc = null_declarator;
+	}
+	[ %if (DOT != IDENTIFIER || AHEAD == IDENTIFIER)
+		decl_specifiers(&Ds)
+	|
+		{do_decspecs(&Ds);}
+	]
+	[
+		declarator(&Dc)
+		{
+			declare_idf(&Ds, &Dc, level);
+#ifdef	LINT
+			lint_ext_def(Dc.dc_idf, Ds.ds_sc);
+#endif	/* LINT */
+		}
+		[
+			function(&Ds, &Dc)
+		|
+			{	if (! Ds.ds_sc_given && ! Ds.ds_typequal &&
+				    Ds.ds_notypegiven) {
+					strict("declaration specifiers missing");
+				}
+			}
+			non_function(&Ds, &Dc)
+		]
+	|
+		{	if (! Ds.ds_sc_given && ! Ds.ds_typequal &&
+			    Ds.ds_notypegiven) {
+				strict("declaration missing");
+			}
+		}
+		';'
+	]
+	{remove_declarator(&Dc); flush_strings(); }
+;
+
+non_function(register struct decspecs *ds; register struct declarator *dc;)
+:
+	{	reject_params(dc);
+	}
+	[
+		initializer(dc->dc_idf, ds->ds_sc)
+	|
+		{ code_declaration(dc->dc_idf, (struct expr *) 0, level, ds->ds_sc); }
+	]
+	{
+#ifdef	LINT
+		lint_non_function_decl(ds, dc);
+#endif	/* LINT */
+	}
+	[
+		','
+		init_declarator(ds)
+	]*
+	';'
+;
+
+/* 3.7.1 */
+function(struct decspecs *ds; struct declarator *dc;)
+	{
+		arith fbytes;
+		register struct idf *idf = dc->dc_idf;
+	}
+:
+	{
+#ifdef	LINT
+		lint_start_function();
+#endif	/* LINT */
+		idf_initialized(idf);
+		stack_level();		/* L_FORMAL1 declarations */
+		declare_params(dc);
+		begin_proc(ds, idf);	/* sets global function info */
+		stack_level();		/* L_FORMAL2 declarations */
+		declare_protos(dc);
+	}
+	declaration*
+	{
+		check_formals(idf, dc);		/* check style-mixtures */
+		declare_formals(idf, &fbytes);
+#ifdef	LINT
+		lint_formals();
+#endif	/* LINT */
+	}
+	compound_statement
+	{
+		end_proc(fbytes);
+#ifdef	LINT
+		lint_implicit_return();
+#endif	/* LINT */
+		unstack_level();	/* L_FORMAL2 declarations */
+#ifdef	LINT
+		lint_end_formals();
+#endif	/* LINT */
+		unstack_level();	/* L_FORMAL1 declarations */
+#ifdef	LINT
+		lint_end_function();
+#endif	/* LINT */
+	}
+;

lang/cem/cemcom.ansi/proto.c

@@ -0,0 +1,474 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*  P R O T O T Y P E   F I D D L I N G  */
+
+#include	"lint.h"
+#include	"debug.h"
+#include	"idfsize.h"
+#include	"nparams.h"
+#include	"botch_free.h"
+#include	<alloc.h>
+#include	"Lpars.h"
+#include	"level.h"
+#include	<flt_arith.h>
+#include	"arith.h"
+#include	"align.h"
+#include	"stack.h"
+#include	"idf.h"
+#include	"def.h"
+#include	"type.h"
+#include	"struct.h"
+#include	"label.h"
+#include	"expr.h"
+#include	"declar.h"
+#include	"decspecs.h"
+#include	"proto.h"
+#include	"assert.h"
+
+extern char options[];
+
+check_for_void(pl)
+	register struct proto *pl;
+{
+	register int errcnt = 0;
+
+	if (!pl) return;
+	if ((pl->pl_flag & PL_VOID) && !(pl->next)) return;
+
+	while (pl) {
+		if (pl->pl_flag & PL_VOID) {
+			if (!errcnt && !(pl->pl_flag & PL_ERRGIVEN))
+				error("illegal use of void in argument list");
+			pl->pl_flag |= PL_ERRGIVEN;
+			errcnt++;
+		}
+		pl = pl->next;
+	}
+}
+
+add_proto(pl, ds, dc, lvl)
+	struct proto *pl;
+	struct decspecs *ds;
+	struct declarator *dc;
+	int lvl;
+{
+	/*	The full typed identifier or abstract type, described
+		by the structures decspecs and declarator are turned
+		a into parameter type list structure.
+		The parameters will be declared at level L_FORMAL2,
+		later on it's decided whether they were prototypes
+		or actual declarations.
+	*/
+	register struct idf *idf = dc->dc_idf;
+	register struct def *def = idf ? idf->id_def : (struct def *)0;
+	register int sc = ds->ds_sc;
+	register struct type *type;
+	char formal_array = 0;
+
+	ASSERT(ds->ds_type != (struct type *)0);
+
+	pl->pl_flag = PL_FORMAL;
+	type = declare_type(ds->ds_type, dc);
+	if (type->tp_size < (arith)0 && actual_declaration(sc, type)) {
+		extern char *symbol2str();
+		if (type->tp_fund != VOID)
+			error("unknown %s-type", symbol2str(type->tp_fund));
+		else {
+			if (idf != (struct idf *)0
+			    || ds->ds_sc_given
+			    || ds->ds_typequal) {
+				error("illegal use of void in argument list");
+				pl->pl_flag |= PL_ERRGIVEN;
+			}
+			/* set PL_VOID anyway */
+			pl->pl_flag |= PL_VOID;
+		}
+	}
+	if (ds->ds_sc_given && ds->ds_sc != REGISTER) {
+		if (!(pl->pl_flag & PL_ERRGIVEN)) {
+		    if (ds->ds_sc != AUTO) {
+			error("illegal storage class in parameter declaration");
+		    } else {
+			warning("illegal storage class in parameter declaration");
+		    }
+		}
+	}
+
+	/*	Perform some special conversions for parameters.
+	*/
+	if (type->tp_fund == FUNCTION) {
+		type = construct_type(POINTER, type, 0, (arith) 0, NO_PROTO);
+	} else if (type->tp_fund == ARRAY) {
+		type = construct_type(POINTER, type->tp_up, 0, (arith) 0, NO_PROTO);
+		formal_array = 1;
+	}
+
+	/*	According to the standard we should ignore the storage
+		class of a parameter, unless it's part of a function
+		definition.
+		However, in the routine declare_protos we don't know decspecs,
+		and therefore we can't complain up there. So we build up the
+		storage class, and keep quiet until we reach declare_protos.
+	*/
+	sc = (ds->ds_sc_given && ds->ds_sc != REGISTER) ?
+				0 : sc == 0 ? FORMAL : REGISTER;
+
+	if (def && (def->df_level == lvl /* || def->df_level < L_PROTO */ )) {
+		/* redeclaration at the same level */
+		error("parameter %s redeclared", idf->id_text);
+	} else if (idf != (struct idf *)0) {
+		/*	New definition, redefinition hides earlier one
+		*/
+		register struct def *newdef = new_def();
+		
+		newdef->next = def;
+		newdef->df_level = lvl;
+		newdef->df_sc = sc;
+		newdef->df_type = type;
+		newdef->df_formal_array = formal_array;
+		newdef->df_file = idf->id_file;
+		newdef->df_line = idf->id_line;
+#ifdef LINT
+		newdef->df_set = (type->tp_fund == ARRAY);
+		/* newdef->df_firstbrace = 0; */
+#endif
+		/*	We can't put the idf onto the stack, since these kinds
+			of declaration may occurs at any level, and the idf
+			does not necessarily go at this level. E.g.
+
+			f() {
+			...
+				{ int func(int a, int b);
+				...
+				}
+			}
+
+			The idf's a and b declared in the prototype declaration
+			do not go at any level, they are simply ignored.
+			However, in
+
+			f(int a, int b) {
+			...
+			}
+
+			They should go at level L_FORMAL2. But at this stage
+			we don't know whether we have a prototype or function
+			definition. So, this process is postponed.
+		*/
+		idf->id_def = newdef;
+		update_ahead(idf);
+	}
+
+	pl->pl_idf = idf;
+	pl->pl_type = type;
+}
+
+struct tag *
+gettag(tp, idpp)
+struct type *tp;
+struct idf **idpp;
+{
+	struct tag *tg = (struct tag *)0;
+	register int fund = tp->tp_fund;
+
+        while (fund == FIELD || fund == POINTER
+                || fund == ARRAY || fund == FUNCTION) {
+                tp = tp->tp_up;
+                fund = tp->tp_fund;
+        }
+	*idpp = tp->tp_idf;
+	switch(tp->tp_fund) {
+	case ENUM:
+	case UNION:
+	case STRUCT: tg = tp->tp_idf->id_tag; break;
+	}
+	return tg;
+}
+
+
+declare_protos(dc)
+	register struct declarator *dc;
+{
+	/*	At this points we know that the idf's in protolist are formal
+		parameters. So it's time to declare them at level L_FORMAL2.
+	*/
+	struct stack_level *stl = stack_level_of(L_FORMAL1);
+	register struct decl_unary *du;
+	register struct type *type;
+	register struct proto *pl;
+	register struct def *def;
+
+#ifdef	DEBUG
+	if (options['t'])
+		dumpidftab("start declare_protos", 0);
+#endif	/* DEBUG */
+	du = dc->dc_decl_unary;
+	while (du) {
+		if (du->du_fund == FUNCTION) {
+			if (du->next != (struct decl_unary *) 0) {
+				remove_proto_idfs(du->du_proto);
+				du->du_proto = 0;
+			} else break;
+		}
+		du = du->next;
+	}
+	pl = du ? du->du_proto : NO_PROTO;
+	if (pl) {
+#if	0 /* the id_proto member is deleted (???) */
+		idf->id_proto = 0;
+#endif	/* 0 */
+		do {
+			struct tag *tg;
+			struct idf *idp = 0;
+
+			type = pl->pl_type;
+
+			/* `...' only for type checking */
+			if (pl->pl_flag & PL_ELLIPSIS) {
+				pl = pl->next;
+				continue;
+			}
+
+			/* special case: int f(void) { ; } */
+			if (type->tp_fund == VOID)
+				break;
+
+			if (!pl->pl_idf || !(def = pl->pl_idf->id_def)) {
+				error("no parameter identifier supplied");
+				pl = pl->next;
+				continue;
+			}
+
+			/*	Postponed storage class checking.
+			*/
+			if (def->df_sc == 0)
+				error("illegal storage class in parameter declaration");
+
+			def->df_level = L_FORMAL2;
+			stack_idf(pl->pl_idf, stl);
+			pl = pl->next;
+
+			tg = gettag(type, &idp);
+			if (tg && tg->tg_level <= L_PROTO) {
+				tg->tg_level = L_FORMAL2;
+				stack_idf(idp, stl);
+			}
+		} while (pl);
+	}
+#ifdef	DEBUG
+	if (options['t'])
+		dumpidftab("end declare_protos", 0);
+#endif	/* DEBUG */
+}
+
+
+update_proto(tp, otp)
+	register struct type *tp, *otp;
+{
+	/*	This routine performs the proto type updates.
+		Consider the following code:
+
+		int f(double g());
+		int f(double g(int f(), int));
+		int f(double g(int f(long double), int));
+
+		The most accurate definition is the third line.
+		This routine will silently update all lists,
+		and removes the redundant occupied space.
+	*/
+	register struct proto *pl, *opl;
+
+	if (tp == otp) return;
+	if (!tp || !otp) return;
+
+	while (tp->tp_fund != FUNCTION) {
+		if (tp->tp_fund != POINTER && tp->tp_fund != ARRAY) return;
+		tp = tp->tp_up;
+		otp = otp->tp_up;
+		if (!tp) return;
+	}
+
+	pl = tp->tp_proto;
+	opl = otp->tp_proto;
+	if (pl && opl) {
+		/* both have prototypes */
+		while (pl && opl) {
+			update_proto(pl->pl_type, opl->pl_type);
+			pl = pl->next;
+			opl = opl->next;
+		}
+		/* Do not free the old prototype list. It might be part of
+		 * a typedef.
+		 */
+		otp->tp_proto = tp->tp_proto;
+	} else if (opl) {
+		/* old decl has type */
+	} else if (pl) {
+		otp->tp_proto = pl;
+	}
+
+	update_proto(tp->tp_up, otp->tp_up);
+}
+
+/* struct/union and enum tags can be declared inside prototypes
+ * remove them from the symbol-table
+ */
+remove_proto_tag(tp)
+struct type *tp;
+{
+	register struct idf *ident;
+	register struct tag *tgp, **tgpp;
+	register int fund = tp->tp_fund;
+
+	while (fund == FIELD || fund == POINTER
+		|| fund == ARRAY || fund == FUNCTION) {
+		tp = tp->tp_up;
+		fund = tp->tp_fund;
+	}
+
+	ident = tp->tp_idf;
+	switch (tp->tp_fund) {
+	case ENUM:
+	case STRUCT:
+	case UNION: tgpp = &(ident->id_tag); break;
+	default: return;
+	}
+
+	while((*tgpp) && (*tgpp)->tg_type != tp) {
+		tgpp = &((*tgpp)->next);
+	}
+	if (!*tgpp) return;
+
+	tgp = *tgpp;
+	if (tgp->tg_level > L_PROTO) return;
+
+#ifdef DEBUG
+	if (options['t'])
+		print("Removing idf %s from list\n",
+			ident->id_text);
+#endif
+
+	(*tgpp) = tgp->next;
+	free_tag(tgp);
+}
+
+remove_proto_idfs(pl)
+	register struct proto *pl;
+{
+	/*	Remove all the identifier definitions from the
+		prototype list.
+	*/
+	register struct def *def;
+
+	while (pl) {
+		if (pl->pl_idf) {
+#ifdef DEBUG
+			if (options['t'])
+				print("Removing idf %s from list\n",
+					pl->pl_idf->id_text);
+#endif
+			def = pl->pl_idf->id_def;
+			if (def && def->df_level <= L_PROTO) {
+				pl->pl_idf->id_def = def->next;
+				free_def(def);
+			}
+			pl->pl_idf = (struct idf *) 0;
+		}
+		if (pl->pl_type) {
+			remove_proto_tag(pl->pl_type);
+		}
+		pl = pl->next;
+	}
+}
+
+call_proto(expp)
+	register struct expr **expp;
+{
+	/*	If the function specified by (*expp)->OP_LEFT has a prototype,
+		the parameters are converted according the rules specified in
+		par. 3.3.2.2. E.i. the parameters are converted to the prototype
+		counter parts as if by assignment. For the parameters falling
+		under ellipsis clause the old parameters conversion stuff
+		applies.
+	*/
+	register struct expr *left = (*expp)->OP_LEFT;
+	register struct expr *right = (*expp)->OP_RIGHT;
+	register struct proto *pl = NO_PROTO;
+	static struct proto ellipsis = { 0, 0, 0, PL_ELLIPSIS };
+
+	if (left != NILEXPR) {		/* in case of an error */
+		register struct type *tp = left->ex_type;
+
+		while (tp && tp->tp_fund != FUNCTION && tp != error_type)
+			tp = tp->tp_up;
+		if (tp && tp->tp_proto)
+			pl = tp->tp_proto;
+	}
+
+	if (right != NILEXPR) {		/* function call with parameters */
+		register struct expr **ep = &((*expp)->OP_RIGHT);
+		register int ecnt = 0, pcnt = 0;
+		struct expr **estack[NPARAMS];
+		struct proto *pstack[NPARAMS];
+
+		/* stack up the parameter expressions */
+		while (right->ex_class == Oper && right->OP_OPER == PARCOMMA) {
+			if (ecnt == STDC_NPARAMS)
+				expr_strict(right, "number of parameters exceeds ANSI limit");
+			if (ecnt >= NPARAMS-1) {
+				expr_error(right, "too many parameters");
+				return;
+			}
+			estack[ecnt++] = &(right->OP_RIGHT);
+			ep = &(right->OP_LEFT);
+			right = right->OP_LEFT;
+		}
+		estack[ecnt] = ep;
+
+		/*	Declarations like int f(void) do not expect any
+			parameters.
+		*/
+		if (pl && pl->pl_flag & PL_VOID) {
+			expr_strict(*expp, "no parameters expected");
+			pl = NO_PROTO;
+		}
+
+		/* stack up the prototypes */
+		if (pl) {
+			pcnt--;
+			do {
+				/* stack prototypes */
+				pstack[++pcnt] = pl;
+				pl = pl->next;
+			} while (pl);
+		}
+		else {
+			pstack[0] = &ellipsis;
+		}
+
+		for (ecnt; ecnt >= 0; ecnt--) {
+			/*	Only the parameters specified in the prototype
+				are checked and converted. The parameters that
+				fall under the ellipsis clause are neither
+				checked nor converted !
+			*/
+			if (pcnt < 0) {
+				expr_error(*expp, "more parameters than specified in prototype");
+				break;
+			}
+			else if (!(pstack[pcnt]->pl_flag & PL_ELLIPSIS)) {
+				ch3cast(estack[ecnt],CASTAB,pstack[pcnt]->pl_type);
+				pcnt--;
+			} else
+				any2parameter(estack[ecnt]);
+		}
+		if (pcnt > 0 || (pcnt == 0 && !(pstack[0]->pl_flag & PL_ELLIPSIS)))
+			expr_error(*expp, "fewer parameters than specified in prototype");
+	} else {
+		if (pl && !(pl->pl_flag & PL_VOID))
+			expr_error(*expp, "fewer parameters than specified in prototype");
+	}
+}

lang/cem/cemcom.ansi/proto.main

@@ -0,0 +1,65 @@
+# $Id$
+
+# C compilation part. Not to be called directly.
+# Instead, it is to be called by the Makefile.
+# SRC_DIR, UTIL_HOME, TARGET_HOME, CC, COPTIONS, LINT, LINTOPTIONS, LDOPTIONS,
+# CC_AND_MKDEP, SUF, LIBSUF should be set here.
+
+#PARAMS		do not remove this line!
+
+# PRODUCE is either e (readable EM) or k (compact EM)
+PRODUCE =	k
+
+MDIR =		$(TARGET_HOME)/modules
+LIBDIR =	$(MDIR)/lib
+LINTLIBDIR =	$(UTIL_HOME)/modules/lib
+
+MALLOC =	$(LIBDIR)/malloc.$(SUF)
+
+EMLIB =		$(LIBDIR)/libem_mes.$(LIBSUF) \
+		$(LIBDIR)/libem$(PRODUCE).$(LIBSUF) \
+		$(TARGET_HOME)/lib.bin/em_data.$(LIBSUF)
+
+MODLIB =	$(LIBDIR)/libinput.$(LIBSUF) \
+		$(LIBDIR)/libassert.$(LIBSUF) \
+		$(LIBDIR)/liballoc.$(LIBSUF) \
+		$(MALLOC) \
+		$(LIBDIR)/libflt.$(LIBSUF) \
+		$(LIBDIR)/libprint.$(LIBSUF) \
+		$(LIBDIR)/libstring.$(LIBSUF) \
+		$(LIBDIR)/libsystem.$(LIBSUF)
+
+LIBS =		$(EMLIB) $(MODLIB)
+
+LINTLIBS =	$(LINTLIBDIR)/$(LINTPREF)em_mes.$(LINTSUF) \
+		$(LINTLIBDIR)/$(LINTPREF)emk.$(LINTSUF) \
+		$(LINTLIBDIR)/$(LINTPREF)input.$(LINTSUF) \
+		$(LINTLIBDIR)/$(LINTPREF)assert.$(LINTSUF) \
+		$(LINTLIBDIR)/$(LINTPREF)alloc.$(LINTSUF) \
+		$(LINTLIBDIR)/$(LINTPREF)flt.$(LINTSUF) \
+		$(LINTLIBDIR)/$(LINTPREF)print.$(LINTSUF) \
+		$(LINTLIBDIR)/$(LINTPREF)string.$(LINTSUF) \
+		$(LINTLIBDIR)/$(LINTPREF)system.$(LINTSUF)
+
+PROFILE =
+INCLUDES =	-I. -I$(SRC_DIR) -I$(TARGET_HOME)/modules/h -I$(TARGET_HOME)/h -I$(TARGET_HOME)/modules/pkg
+CFLAGS =	$(PROFILE) $(INCLUDES) $(COPTIONS)
+LINTFLAGS =	$(INCLUDES) $(LINTOPTIONS)
+LDFLAGS =	$(PROFILE) $(LDOPTIONS)
+
+# C_SRC and OBJ should be set here.
+#LISTS		do not remove this line!
+
+all:		main
+
+clean:
+		rm -f *.$(SUF) main
+
+lint:
+		$(LINT) $(LINTFLAGS) $(C_SRC) $(LINTLIBS)
+
+main:		$(OBJ)
+		$(CC) $(LDFLAGS) $(OBJ) $(LIBS) -o main
+
+# do not remove the next line; it is used for generating dependencies
+#DEPENDENCIES

lang/cem/cemcom.ansi/proto.make

@@ -0,0 +1,272 @@
+# $Id$
+
+# make ANSI C compiler
+
+#PARAMS		do not remove this line!
+
+UTIL_BIN = \
+	$(UTIL_HOME)/bin
+SRC_DIR = \
+	$(SRC_HOME)/lang/cem/cemcom.ansi
+
+TABGEN=	$(UTIL_BIN)/tabgen
+LLGEN =	$(UTIL_BIN)/LLgen
+LLGENOPTIONS = \
+	-n
+
+SRC_G =	$(SRC_DIR)/program.g $(SRC_DIR)/declar.g \
+	$(SRC_DIR)/expression.g $(SRC_DIR)/statement.g $(SRC_DIR)/ival.g
+GEN_G =	tokenfile.g
+GFILES=	$(GEN_G) $(SRC_G)
+
+SRC_C = \
+	$(SRC_DIR)/LLlex.c \
+	$(SRC_DIR)/LLmessage.c \
+	$(SRC_DIR)/arith.c \
+	$(SRC_DIR)/blocks.c \
+	$(SRC_DIR)/ch3.c \
+	$(SRC_DIR)/ch3bin.c \
+	$(SRC_DIR)/ch3mon.c \
+	$(SRC_DIR)/code.c \
+	$(SRC_DIR)/conversion.c \
+	$(SRC_DIR)/cstoper.c \
+	$(SRC_DIR)/dataflow.c \
+	$(SRC_DIR)/declarator.c \
+	$(SRC_DIR)/decspecs.c \
+	$(SRC_DIR)/domacro.c \
+	$(SRC_DIR)/dumpidf.c \
+	$(SRC_DIR)/error.c \
+	$(SRC_DIR)/eval.c \
+	$(SRC_DIR)/expr.c \
+	$(SRC_DIR)/field.c \
+	$(SRC_DIR)/fltcstoper.c \
+	$(SRC_DIR)/idf.c \
+	$(SRC_DIR)/init.c \
+	$(SRC_DIR)/input.c \
+	$(SRC_DIR)/l_comment.c \
+	$(SRC_DIR)/l_ev_ord.c \
+	$(SRC_DIR)/l_lint.c \
+	$(SRC_DIR)/l_misc.c \
+	$(SRC_DIR)/l_outdef.c \
+	$(SRC_DIR)/l_states.c \
+	$(SRC_DIR)/label.c \
+	$(SRC_DIR)/main.c \
+	$(SRC_DIR)/options.c \
+	$(SRC_DIR)/pragma.c \
+	$(SRC_DIR)/proto.c \
+	$(SRC_DIR)/replace.c \
+	$(SRC_DIR)/skip.c \
+	$(SRC_DIR)/stab.c \
+	$(SRC_DIR)/stack.c \
+	$(SRC_DIR)/struct.c \
+	$(SRC_DIR)/switch.c \
+	$(SRC_DIR)/tokenname.c \
+	$(SRC_DIR)/type.c \
+	$(SRC_DIR)/util.c
+GEN_C =	tokenfile.c program.c declar.c expression.c statement.c ival.c \
+	symbol2str.c char.c Lpars.c next.c Lncor.c
+CFILES=	$(SRC_C) $(GEN_C)
+
+SRC_H = \
+	$(SRC_DIR)/LLlex.h \
+	$(SRC_DIR)/align.h \
+	$(SRC_DIR)/arith.h \
+	$(SRC_DIR)/assert.h \
+	$(SRC_DIR)/atw.h \
+	$(SRC_DIR)/class.h \
+	$(SRC_DIR)/decspecs.h \
+	$(SRC_DIR)/file_info.h \
+	$(SRC_DIR)/input.h \
+	$(SRC_DIR)/interface.h \
+	$(SRC_DIR)/l_class.h \
+	$(SRC_DIR)/l_comment.h \
+	$(SRC_DIR)/l_em.h \
+	$(SRC_DIR)/l_lint.h \
+	$(SRC_DIR)/label.h \
+	$(SRC_DIR)/level.h \
+	$(SRC_DIR)/mes.h \
+	$(SRC_DIR)/sizes.h \
+	$(SRC_DIR)/specials.h \
+	$(SRC_DIR)/tokenname.h
+
+GEN_H = botch_free.h dataflow.h debug.h density.h errout.h \
+        idfsize.h ifdepth.h inputtype.h macbuf.h lint.h \
+        nobitfield.h nopp.h nocross.h \
+        nparams.h numsize.h parbufsize.h pathlength.h Lpars.h \
+        strsize.h trgt_sizes.h textsize.h use_tmp.h spec_arith.h static.h \
+        regcount.h dbsymtab.h \
+	code.h declar.h def.h expr.h field.h estack.h util.h proto.h replace.h \
+	idf.h macro.h stmt.h struct.h switch.h type.h l_brace.h l_state.h \
+	l_outdef.h stack.h
+
+HFILES=	$(GEN_H) $(SRC_H)
+
+NEXTFILES = \
+	$(SRC_DIR)/code.str \
+	$(SRC_DIR)/declar.str \
+	$(SRC_DIR)/def.str \
+	$(SRC_DIR)/expr.str \
+	$(SRC_DIR)/field.str \
+        $(SRC_DIR)/estack.str \
+	$(SRC_DIR)/util.str \
+	$(SRC_DIR)/proto.str \
+	$(SRC_DIR)/replace.str \
+        $(SRC_DIR)/idf.str \
+	$(SRC_DIR)/macro.str \
+	$(SRC_DIR)/stack.str \
+	$(SRC_DIR)/stmt.str \
+	$(SRC_DIR)/struct.str \
+	$(SRC_DIR)/switch.str \
+	$(SRC_DIR)/type.str \
+        $(SRC_DIR)/l_brace.str \
+	$(SRC_DIR)/l_state.str \
+	$(SRC_DIR)/l_outdef.str
+
+all:		make.main
+		make -f make.main main
+
+install:	all
+		@-mkdir $(TARGET_HOME)
+		@-mkdir $(TARGET_HOME)/lib.bin
+		cp main $(TARGET_HOME)/lib.bin/em_cemcom.ansi
+		if [ $(DO_MACHINE_INDEP) = y ] ; \
+		then	cp $(SRC_DIR)/cemcom.ansi.1 cemcom.ansi.6 ; \
+			mk_manpage cemcom.ansi.6 $(TARGET_HOME) ; \
+			rm -f cemcom.ansi.6 ; \
+		fi
+
+cmp:		all
+		-cmp main $(TARGET_HOME)/lib.bin/em_cemcom.ansi
+
+opr:
+		make pr | opr
+
+pr:
+		@pr $(SRC_DIR)/proto.make $(SRC_DIR)/proto.main Parameters \
+			$(SRC_DIR)/char.tab $(SRC_G) $(SRC_H) $(NEXTFILES) $(SRC_C)
+
+lint:		make.main
+		make -f make.main lint
+
+Cfiles:		hfiles LLfiles $(GEN_C) $(GEN_H) Makefile
+		echo $(CFILES) | tr ' ' '\012' > Cfiles
+		echo $(HFILES) | tr ' ' '\012' >> Cfiles
+
+resolved:	Cfiles
+		CC="$(CC)" UTIL_HOME="$(UTIL_HOME)" do_resolve `cat Cfiles` > Cfiles.new
+		-if cmp -s Cfiles Cfiles.new ; then rm -f Cfiles.new ; else mv Cfiles.new Cfiles ; fi
+		touch resolved
+
+# there is no file called "dependencies"; we want dependencies checked 
+# every time. This means that make.main is made every time. Oh well ...
+# it does not take much time.
+dependencies:	resolved
+		do_deps `grep '.c$$' Cfiles`
+
+make.main:	dependencies make_macros lists $(SRC_DIR)/proto.main
+		rm_deps $(SRC_DIR)/proto.main | sed -e '/^.PARAMS/r make_macros' -e '/^.LISTS/r lists' > make.main
+		cat *.dep >> make.main
+
+make_macros:	Makefile
+		echo 'SRC_DIR=$(SRC_DIR)' > make_macros
+		echo 'UTIL_HOME=$(UTIL_HOME)' >> make_macros
+		echo 'TARGET_HOME=$(TARGET_HOME)' >> make_macros
+		echo 'CC=$(CC)' >> make_macros
+		echo 'COPTIONS=$(COPTIONS)' >> make_macros
+		echo 'LDOPTIONS=$(LDOPTIONS)' >> make_macros
+		echo 'LINT=$(LINT)' >> make_macros
+		echo 'LINTSUF=$(LINTSUF)' >> make_macros
+		echo 'LINTPREF=$(LINTPREF)' >> make_macros
+		echo 'LINTOPTIONS=$(LINTOPTIONS)' >> make_macros
+		echo 'SUF=$(SUF)' >> make_macros
+		echo 'LIBSUF=$(LIBSUF)' >> make_macros
+		echo 'CC_AND_MKDEP=$(CC_AND_MKDEP)' >> make_macros
+
+lists:		Cfiles
+		echo "C_SRC = \\" > lists
+		echo $(CFILES) >> lists
+		echo "OBJ = \\" >> lists
+		echo $(CFILES) | sed -e 's|[^ ]*/||g' -e 's/\.c/.$$(SUF)/g' >> lists
+
+clean:
+		-make -f make.main clean
+		rm -f $(GEN_C) $(GEN_G) $(GEN_H) hfiles LLfiles Cfiles LL.output
+		rm -f resolved *.dep lists make.main make_macros
+
+LLfiles:	$(GFILES)
+		$(LLGEN) $(LLGENOPTIONS) $(GFILES)
+		@touch LLfiles
+		@if [ -f Lncor.c ] ; then : ; else touch Lncor.c ; fi
+
+hfiles:		Parameters $(SRC_DIR)/make.hfiles
+		$(SRC_DIR)/make.hfiles Parameters
+		touch hfiles
+
+tokenfile.g:	$(SRC_DIR)/tokenname.c $(SRC_DIR)/make.tokfile
+		$(SRC_DIR)/make.tokfile <$(SRC_DIR)/tokenname.c >tokenfile.g
+
+symbol2str.c:	$(SRC_DIR)/tokenname.c $(SRC_DIR)/make.tokcase
+		$(SRC_DIR)/make.tokcase <$(SRC_DIR)/tokenname.c >symbol2str.c
+
+code.h:		$(SRC_DIR)/code.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/code.str > code.h
+
+declar.h:	$(SRC_DIR)/declar.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/declar.str > declar.h
+
+def.h:	$(SRC_DIR)/def.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/def.str > def.h
+
+expr.h:	$(SRC_DIR)/expr.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/expr.str > expr.h
+
+field.h:	$(SRC_DIR)/field.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/field.str > field.h
+
+estack.h:	$(SRC_DIR)/estack.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/estack.str > estack.h
+
+util.h:	$(SRC_DIR)/util.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/util.str > util.h
+
+proto.h:	$(SRC_DIR)/proto.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/proto.str > proto.h
+
+replace.h:	$(SRC_DIR)/replace.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/replace.str > replace.h
+
+idf.h:	$(SRC_DIR)/idf.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/idf.str > idf.h
+
+macro.h:	$(SRC_DIR)/macro.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/macro.str > macro.h
+
+stack.h:	$(SRC_DIR)/stack.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/stack.str > stack.h
+
+stmt.h:	$(SRC_DIR)/stmt.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/stmt.str > stmt.h
+
+struct.h:	$(SRC_DIR)/struct.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/struct.str > struct.h
+
+switch.h:	$(SRC_DIR)/switch.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/switch.str > switch.h
+
+type.h:	$(SRC_DIR)/type.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/type.str > type.h
+
+l_brace.h:	$(SRC_DIR)/l_brace.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/l_brace.str > l_brace.h
+
+l_state.h:	$(SRC_DIR)/l_state.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/l_state.str > l_state.h
+
+l_outdef.h:	$(SRC_DIR)/l_outdef.str $(SRC_DIR)/make.allocd
+		$(SRC_DIR)/make.allocd < $(SRC_DIR)/l_outdef.str > l_outdef.h
+
+next.c:		$(NEXTFILES) $(SRC_DIR)/make.next
+		$(SRC_DIR)/make.next $(NEXTFILES) > next.c
+
+char.c:		$(SRC_DIR)/char.tab
+		$(TABGEN) -f$(SRC_DIR)/char.tab >char.c

lang/cem/cemcom.ansi/proto.str

@@ -0,0 +1,22 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* PARAMETER TYPE LIST DEFINITION */
+
+struct proto {
+	struct proto *next;
+	struct type *pl_type;	/* parameter type */
+	struct idf *pl_idf;	/* parameter identifier */
+	short pl_flag;		/* see define's */
+};
+
+#define	NO_PROTO	((struct proto *)0)
+
+#define	PL_VOID		0x01
+#define	PL_FORMAL	0x02
+#define	PL_ELLIPSIS	0x04
+#define	PL_ERRGIVEN	0x08
+
+/* ALLOCDEF "proto" 20 */

lang/cem/cemcom.ansi/replace.c

@@ -0,0 +1,807 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*  M A C R O   R E P L A C E M E N T */
+#include	"nopp.h"
+
+#ifndef NOPP
+
+#include	"debug.h"
+#include	"pathlength.h"
+#include	"strsize.h"
+#include	"nparams.h"
+#include	"idfsize.h"
+#include	"numsize.h"
+#include	<alloc.h>
+#include	"idf.h"
+#include	"input.h"
+#include	"macro.h"
+#include	"arith.h"
+#include	"LLlex.h"
+#include	"class.h"
+#include	"assert.h"
+#include	"static.h"
+#include	"macbuf.h"
+#include	"replace.h"
+
+extern struct idf *GetIdentifier();
+extern int InputLevel;
+struct repl *ReplaceList;	/* list of currently active macros */
+extern char *strcat(), *strcpy();
+
+int
+replace(idf)
+	register struct idf *idf;
+{
+	/*	replace is called by the lexical analyzer to perform
+		macro replacement. The routine actualy functions as a
+		higher interface to the real thing: expand_macro().
+	*/
+	struct repl *repl;
+
+	if (!(idf->id_macro)) return 0;
+	if (idf->id_macro->mc_flag & NOREPLACE)
+		return 0;
+	repl = new_repl();
+	repl->r_ptr = repl->r_text = Malloc(repl->r_size = LAPBUF);
+	repl->r_args = new_args();
+	repl->r_idf = idf;
+	if (!expand_macro(repl, idf))
+		return 0;
+	InputLevel++;
+	InsertText(repl->r_text, (int)(repl->r_ptr - repl->r_text));
+	idf->id_macro->mc_flag |= NOREPLACE;
+	repl->r_level = InputLevel;
+	repl->next = ReplaceList;
+	ReplaceList = repl;
+	return 1;
+}
+
+unstackrepl()
+{
+	Unstacked++;
+}
+
+freeargs(args)
+	struct args *args;
+{
+	register int i;
+
+	/* We must don't know how many parameters were specified, so be
+	 * prepared to free all NPARAMS parameters.
+	 * When an expvec is !0, the rawvec will also be !0.
+	 * When an expvec is 0, all remaining vectors will also be 0.
+	 */
+	for (i = 0; i < NPARAMS; i++) {
+		if (args->a_expvec[i]) {
+			free(args->a_expvec[i]);
+			free(args->a_rawvec[i]);
+		} else break;
+	}
+	free_args(args);
+}
+
+EnableMacros()
+{
+	register struct repl *r = ReplaceList, *prev = 0;
+
+	ASSERT(Unstacked > 0);
+	while(r) {
+		struct repl *nxt = r->next;
+
+		if (r->r_level > InputLevel) {
+			r->r_idf->id_macro->mc_flag &= ~NOREPLACE;
+			if (!prev) ReplaceList = nxt;
+			else prev->next = nxt;
+			free(r->r_text);
+			freeargs(r->r_args);
+			free_repl(r);
+		}
+		else prev = r;
+		r = nxt;
+	}
+	Unstacked = 0;
+}
+
+expand_macro(repl, idf)
+	register struct repl *repl;
+	register struct idf *idf;
+{
+	/*	expand_macro() does the actual macro replacement.
+		"idf" is a description of the identifier which
+		caused the replacement.
+		If the identifier represents a function-like macro
+		call, the number of actual parameters is checked
+		against the number of formal parameters. Note that
+		in ANSI C the parameters are expanded first;
+		this is done by calling getactuals().
+		When the possible parameters are expanded, the replace-
+		ment list associated with "idf" is expanded.
+		expand_macro() returns 1 if the replacement succeeded
+		and 0 if some error occurred.
+
+		A special case is "defined". This acts as a unary operator
+		on a single, unexpanded identifier, which may be surrounded
+		by parenthesis. The function expand_defined() handles this.
+	*/
+	register struct macro *mac = idf->id_macro;
+	struct args *args = repl->r_args;
+	register int ch;
+
+	if (mac->mc_nps != -1) {	/* with parameter list	*/
+		if (mac->mc_flag & FUNC) {
+			/* the following assertion won't compile:
+			ASSERT(!strcmp("defined", idf->id_text));
+			expand the assert macro by hand (??? dirty, temporary)
+			*/
+#ifdef	DEBUG
+			if (strcmp("defined", idf->id_text))
+				crash("in %s, %u: assertion %s failed",
+					__FILE__, __LINE__ - 2,
+					"strcmp(\"defined\", idf->id_text)");
+#endif
+			if (!AccDefined) return 0;
+			expand_defined(repl);
+			return 1;
+		}
+
+		ch = GetChar();
+		ch = skipspaces(ch,1);
+		if (ch != '(') {	/* no replacement if no () */
+			ChPushBack(ch);
+			return 0;
+		} else
+			getactuals(repl, idf);
+
+	}
+
+	if (mac->mc_flag & FUNC) /* this macro leads to special action */
+		macro_func(idf);
+
+	macro2buffer(repl, idf, args);
+
+	/*	According to the ANSI definition:
+
+			#define	a +
+			a+b; --> + + b ;
+
+		'a' must be substituded, but the result should be
+		three tokens: + + ID. Therefore a token separator is
+		inserted after the replacement.
+	*/
+	if (repl->r_text == repl->r_ptr || *(repl->r_ptr - 1) != TOKSEP) {
+		add2repl(repl, TOKSEP);
+	}
+	return 1;
+}
+
+expand_defined(repl)
+	register struct repl *repl;
+{
+	register int ch = GetChar();
+	struct idf *id;
+	int parens = 0;
+
+	ch = skipspaces(ch, 0);
+
+	if (ch == '(') {
+		parens++;
+		ch = GetChar();
+		ch = skipspaces(ch, 0);
+	}
+	if ((class(ch) != STIDF) && (class(ch) != STELL)) {
+		error("identifier missing");
+		if (parens && ch != ')') error(") missing");
+		if (!parens || ch != ')') ChPushBack(ch);
+		add2repl(repl, '0');
+		return;
+	}
+	ChPushBack(ch);
+	id = GetIdentifier(0);
+	ASSERT(id || class(ch) == STELL);
+	ch = GetChar();
+	ch = skipspaces(ch, 0);
+	if (parens && ch != ')') error(") missing");
+	if (!parens || ch != ')') ChPushBack(ch);
+	add2repl(repl, (id && id->id_macro) ? '1' : '0');
+	add2repl(repl, ' ');
+}
+
+newarg(args)
+	struct args *args;
+{
+	args->a_expptr = args->a_expbuf = Malloc(args->a_expsize = ARGBUF);
+	args->a_rawptr = args->a_rawbuf = Malloc(args->a_rawsize = ARGBUF);
+}
+
+getactuals(repl, idf)
+	struct repl *repl;
+	register struct idf *idf;
+{
+	/*	Get the actual parameters from the input stream.
+		The hard part is done by actual(), only comma's and
+		other syntactic trivialities are checked here.
+	*/
+	register struct args *args = repl->r_args;
+	register int nps = idf->id_macro->mc_nps;
+	register int argcnt;
+	register int ch;
+
+	argcnt = 0;
+	newarg(args);
+	if ((ch = GetChar()) != ')') {
+		UnGetChar();
+		while ((ch = actual(repl)) != ')' ) {
+			if (ch != ',') {
+				lexerror("illegal macro call");
+				return;
+			}
+			stash(repl, '\0', 1);
+			args->a_expvec[argcnt] = args->a_expbuf;
+			args->a_rawvec[argcnt] = args->a_rawbuf;
+			++argcnt;
+			if (argcnt == STDC_NPARAMS)
+				lexstrict("number of parameters exceeds ANSI standard");
+			if (argcnt >= NPARAMS)
+				fatal("argument vector overflow");
+			newarg(args);
+		}
+		stash(repl, '\0', 1);
+		args->a_expvec[argcnt] = args->a_expbuf;
+		args->a_rawvec[argcnt] = args->a_rawbuf;
+		++argcnt;
+	}
+	if (argcnt < nps)
+		lexerror("too few macro arguments");
+	else if (argcnt > nps)
+		lexerror("too many macro arguments");
+}
+
+saveraw(repl)
+struct repl *repl;
+{
+	register struct repl *nrepl = ReplaceList;
+	register struct args *ap = nrepl->r_args;
+	register char *p;
+
+	/* stash identifier name */
+	for (p = nrepl->r_idf->id_text; *p != '\0'; p++)
+		stash(repl, *p, -1);
+
+	/*	The following code deals with expanded function
+		like macro calls. It makes the following code
+		work:
+
+			#define	def(a,b)	x(a,b)
+			#define	glue(a,b)	a ## b
+
+			glue(abc,def(a,b))
+
+		Results in:
+
+			abcdef(a,b);
+	*/
+	if (ap->a_rawvec[0]) {
+		/* stash arguments */
+		register int i;
+
+		for (i = 0; ap->a_rawvec[i] != (char *)0; i++) {
+			if (i == 0) stash(repl, '(', -1);
+			else stash(repl, ',', -1);
+			for (p = ap->a_rawvec[i]; *p != '\0'; p++)
+				stash(repl, *p, -1);
+		}
+		stash(repl, ')', -1);
+	}
+}
+
+int
+actual(repl)
+	struct repl *repl;
+{
+	/*	This routine deals with the scanning of an actual parameter.
+		It keeps in account the opening and closing brackets,
+		preprocessor numbers, strings and character constants.
+	*/
+	register int ch = 0;
+	register int level = 0, nostashraw = 0;
+	int lastch;
+	static int Unstacked_missed;
+
+	while (1) {
+		lastch = ch;
+		ch = GetChar();
+
+		if (nostashraw 
+		    && nostashraw >= Unstacked_missed) {
+			nostashraw -= Unstacked_missed;
+			Unstacked_missed = 0;
+		}
+		if (Unstacked) {
+			nostashraw -= Unstacked;
+			if (nostashraw < 0) {
+				Unstacked_missed = -nostashraw;
+				nostashraw = 0;
+			}
+			EnableMacros();
+		}
+		if (class(ch) == STIDF || class(ch) == STELL) {
+			/*	Scan a preprocessor identifier token. If the
+				token is a macro, it is expanded first.
+			*/
+			char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 1];
+			register char *p = buf;
+			register struct idf *idef;
+			register int pos = -1;
+			extern int idfsize;
+			int NoExpandMacro;
+
+			if (ch == NOEXPM) {
+				NoExpandMacro= 1;
+				ch = GetChar();
+			} else NoExpandMacro = 0;
+
+			do {
+				if (++pos < idfsize) {
+					*p++ = ch;
+				}
+				ch = GetChar();
+			} while (in_idf(ch));
+			*p++ = '\0';
+			ch = '\0';	/* It could be an unstashed TOKSEP */
+			UnGetChar();
+
+			/*	When the identifier has an associated macro
+				replacement list, it's expanded.
+			*/
+			idef = findidf(buf);
+			if (!idef || NoExpandMacro || !replace(idef)) {
+				if (NoExpandMacro
+				    || (idef && idef->id_macro
+				        && (idef->id_macro->mc_flag & NOREPLACE)))
+					stash(repl, NOEXPM, !nostashraw);
+				for (p = buf; *p != '\0'; p++)
+					stash(repl, *p, !nostashraw);
+			} else {
+				if (!nostashraw) saveraw(repl);
+				nostashraw++;
+			}
+		} else if (class(ch) == STNUM) {
+			/*	a preprocessing number has the following
+				regular expression:
+				    [0-9|"."[0-9]]{[0-9"."a-zA-Z_]|{[Ee][+-]}}*
+			*/
+			stash(repl, ch, !nostashraw);
+			if (ch == '.') {
+				ch = GetChar();
+				if (class(ch) != STNUM) {
+					ch = '\0';	/* It could be an unstashed TOKSEP */
+					UnGetChar();
+					continue;
+				}
+				else stash(repl, ch, !nostashraw);
+			}
+			ch = GetChar();
+			while (in_idf(ch) || ch == '.') {
+				stash(repl, ch, !nostashraw);
+				if ((ch = GetChar()) == 'e' || ch == 'E') {
+					stash(repl, ch, !nostashraw);
+					ch = GetChar();
+					if (ch == '+' || ch == '-') {
+						stash(repl, ch, !nostashraw);
+						ch = GetChar();
+					}
+				}
+			}
+			ch = '\0';	/* It could be an unstashed TOKSEP */
+			UnGetChar();
+		} else if (ch == '(') {
+			/* a comma may occur between parentheses */
+			level++;
+			stash(repl, ch, !nostashraw);
+		} else if (ch == ')') {
+			level--;
+			/* closing parenthesis of macro call */
+			if (level < 0) return ')';
+			stash(repl, ch, !nostashraw);
+		} else if (ch == ',') {
+			if (level <= 0) { /* comma separator for next argument */
+				if (level)
+					lexerror("unbalanced parenthesis");
+				if (!nostashraw)
+					return ',';	/* ??? */
+			}
+			stash(repl, ch, !nostashraw);
+		} else if (ch == '\n') {
+			/* newlines are accepted as white spaces */
+			LineNumber++;
+			/*	This piece of code needs some explanation:
+				consider the call of a macro defined as:
+					#define sum(a,b) (a+b)
+				in the following form:
+					sum(
+					/_* comment *_/ #include phone_number
+					,2);
+				in which case the include must be handled
+				interpreted as such.
+			*/
+
+a_new_line:		ch = GetChar();
+			while (class(ch) == STSKIP || ch == '/') {
+			    if (ch == '/') {
+				    if ((ch = GetChar()) == '*' && !InputLevel) {
+					skipcomment();
+					stash(repl, ' ', !nostashraw);
+					ch = GetChar();
+					continue;
+				    } else {
+					UnGetChar();
+					ch = '/';
+				    }
+				    stash(repl, '/', !nostashraw);
+				    break;
+			    } else ch = GetChar();
+			}
+
+			if (ch == '#') {
+				domacro();
+				/* Clear File_Inserted since domacro could
+				 * be called again, which calls GetToken().
+				 */
+				File_Inserted = 0;
+				goto a_new_line;
+			} else if (ch == EOI) {
+				lexerror("unterminated macro call");
+				return ')';
+			}
+			if (ch != '/') {
+				UnGetChar();
+				ch = ' ';
+				stash(repl, ' ', !nostashraw);
+			}
+		} else if (ch == '/') {
+			/* comments are treated as one white space token */
+			if ((ch = GetChar()) == '*' && !InputLevel) {
+				skipcomment();
+				stash(repl, ' ', !nostashraw);
+			} else {
+				UnGetChar();
+				ch = '/';
+				stash(repl, '/', !nostashraw);
+			}
+		} else if (ch == '\'' || ch == '"') {
+			/*	Strings are considered as ONE token, thus no
+				replacement within strings.
+			*/
+			register int match = ch;
+
+			stash(repl, ch, !nostashraw);
+			while ((ch = GetChar()) != EOI) {
+				if (ch == match)
+					break;
+				if (ch == '\\') {
+					stash(repl, ch, !nostashraw);
+					ch = GetChar();
+				} else if (ch == '\n') {
+					lexerror("newline in string");
+					LineNumber++;
+					stash(repl, match, !nostashraw);
+					break;
+				}
+				stash(repl, ch, !nostashraw);
+			}
+			if (ch != match) {
+				lexerror("unterminated macro call");
+				return ')';
+			}
+			stash(repl, ch, !nostashraw);
+		} else {
+			if (lastch == TOKSEP && ch == TOKSEP) continue;
+			stash(repl, ch, !nostashraw);
+		}
+	}
+}
+
+macro_func(idef)
+	register struct idf *idef;
+{
+	/*	macro_func() performs the special actions needed with some
+		macros. These macros are __FILE__ and __LINE__ which
+		replacement texts must be evaluated at the time they are
+		used.
+	*/
+	register struct macro *mac = idef->id_macro;
+	static char FilNamBuf[PATHLENGTH];
+	char *long2str();
+
+	switch (idef->id_text[2]) {
+	case 'F':			/* __FILE__	*/
+		FilNamBuf[0] = '"';
+		strcpy(&FilNamBuf[1], FileName);
+		strcat(FilNamBuf, "\"");
+		mac->mc_text = FilNamBuf;
+		mac->mc_length = strlen(FilNamBuf);
+		break;
+	case 'L':			/* __LINE__	*/
+		mac->mc_text = long2str((long)LineNumber, 10);
+		mac->mc_length = strlen(mac->mc_text);
+		break;
+	default:
+		crash("(macro_func)");
+		/*NOTREACHED*/
+	}
+}
+
+macro2buffer(repl, idf, args)
+	register struct repl *repl;
+	register struct idf *idf;
+	register struct args *args;
+{
+	/*	macro2buffer expands the replacement list and places the
+		result onto the replacement buffer. It deals with the #
+		and ## operators, and inserts the actual parameters.
+		The argument buffer contains the raw argument (needed
+		for the ## operator), and the expanded argument (for
+		all other parameter substitutions).
+
+		The grammar of the replacement list is:
+
+			repl_list:	TOKEN repl_list
+				|	PARAMETER repl_list
+				|	'#' PARAMETER
+				|	TOKEN '##' TOKEN
+				|	PARAMETER '##' TOKEN
+				|	TOKEN '##' PARAMETER
+				|	PARAMETER '##' PARAMETER
+				;
+
+		As the grammar indicates, we could make a DFA and
+		use this finite state machine for the replacement
+		list parsing (inserting the arguments, etc.).
+
+		Currently we go through the replacement list in a
+		linear fashion. This is VERY expensive, something
+		smarter should be done (but even a DFA is O(|s|)).
+	*/
+	register char *ptr = idf->id_macro->mc_text;
+	int err = 0;
+	int func = idf->id_macro->mc_nps != -1;
+	char *stringify();
+
+	ASSERT(ptr[idf->id_macro->mc_length] == '\0');
+	while (*ptr) {
+	    if (*ptr == '\'' || *ptr == '"') {
+		register int delim = *ptr;
+
+		do {
+		    add2repl(repl, *ptr);
+		    if (*ptr == '\\')
+			add2repl(repl, *++ptr);
+		    if (*ptr == '\0') {
+			lexerror("unterminated string");
+			return;
+		    }
+		    ptr++;
+		} while (*ptr != delim || *ptr == '\0');
+		add2repl(repl, *ptr++);
+	    } else if (*ptr == '#' && (func || *(ptr+1) == '#')) {
+		if (*++ptr == '#') {
+		    register int tmpindex;
+			/* ## - paste operator */
+		    ptr++;
+
+			/* trim the actual replacement list */
+		    --repl->r_ptr;
+		    while (repl->r_ptr >= repl->r_text
+			    && is_wsp(*repl->r_ptr))
+			--repl->r_ptr;
+
+		    /*	## occurred at the beginning of the replacement list.
+		     */
+		    if (repl->r_ptr < repl->r_text) {
+			err = 1;
+			break;
+		    }
+
+		    if (repl->r_ptr >= repl->r_text
+			    && *repl->r_ptr == TOKSEP)
+			--repl->r_ptr;
+
+		    ++repl->r_ptr;
+		    tmpindex = repl->r_ptr - repl->r_text;
+		    /* tmpindex can be 0 */
+
+		    /* skip space in macro replacement list */
+		    while ((*ptr & FORMALP) == 0 && is_wsp(*ptr))
+			    ptr++;
+
+		    /*	## occurred at the end of the replacement list.
+		     */
+		    if (*ptr & FORMALP) {
+			register int n = *ptr++ & 0177;
+			register char *p;
+
+			ASSERT(n > 0);
+			p = args->a_rawvec[n-1];
+			if (p) {	/* else macro argument missing */
+			    while (is_wsp(*p)) p++;
+			    if (*p == NOEXPM) p++;
+			    while (*p)
+				add2repl(repl, *p++);
+			}
+			while (tmpindex > 0
+				&& in_idf(repl->r_text[tmpindex]))
+			    tmpindex--;
+			if (tmpindex >= 0
+			    && repl->r_text[tmpindex] == NOEXPM)
+				repl->r_text[tmpindex] = TOKSEP;
+		    } else if (*ptr == '\0') {
+			    err = 1;
+			    break;
+		    } else {
+			    if (in_idf(*ptr)) {
+				tmpindex--;
+				while (tmpindex > 0
+					&& in_idf(repl->r_text[tmpindex]))
+				    tmpindex--;
+				if (tmpindex >= 0
+				    && repl->r_text[tmpindex] == NOEXPM)
+					repl->r_text[tmpindex] = TOKSEP;
+			    }
+		    }
+		} else {			/* # operator */
+			ptr = stringify(repl, ptr, args);
+		}
+	    } else if (*ptr & FORMALP) {
+		/* insert actual parameter */
+		register int n = *ptr++ & 0177;
+		register char *p, *q;
+
+		ASSERT(n > 0);
+
+		/*	This is VERY dirty, we look ahead for the
+			## operator. If it's found we use the raw
+			argument buffer instead of the expanded
+			one.
+		*/
+		for (p = ptr; (*p & FORMALP) == 0 && is_wsp(*p); p++)
+			/* EMPTY */;
+		if (*p == '#' && p[1] == '#')
+			q = args->a_rawvec[n-1];
+		else
+			q = args->a_expvec[n-1];
+
+		if (q)			/* else macro argument missing */
+		    while (*q)
+			add2repl(repl, *q++);
+
+		if (repl->r_text == repl->r_ptr || *(repl->r_ptr - 1) != TOKSEP)
+			add2repl(repl, TOKSEP);
+	    } else {
+		add2repl(repl, *ptr++);
+	    }
+	}
+	if (err)
+		lexerror("illegal use of the ## operator");
+}
+
+char *
+stringify(repl, ptr, args)
+	register struct repl *repl;
+	register char *ptr;
+	register struct args *args;
+{
+	/*	If a parameter is immediately preceded by a # token
+		both are replaced by a single string literal that
+		contains the spelling of the token sequence for the
+		corresponding argument.
+		Each occurrence of white space between the argument's
+		tokens become a single space character in the string
+		literal. White spaces before the first token and after
+		the last token comprising the argument are deleted.
+		To retain the original spelling we insert backslashes
+		as appropriate. We only escape backslashes if they
+		occure within string tokens.
+	*/
+	register int space = 1;		/* skip leading spaces */
+	register int delim = 0;		/* string or character constant delim */
+	register int backslash = 0;	/* last character was a \ */
+
+	/* skip spaces macro replacement list */
+	while ((*ptr & FORMALP) == 0 && is_wsp(*ptr))
+		ptr++;
+
+	if (*ptr & FORMALP) {
+		register int n = *ptr++ & 0177;
+		register char *p;
+
+		ASSERT(n != 0);
+		p = args->a_rawvec[n-1];
+		add2repl(repl, '"');
+		while (*p) {
+			if (is_wsp(*p)) {
+				if (!space) {
+					space = 1;
+					add2repl(repl, ' ');
+				}
+				p++;
+				continue;
+			}
+			space = 0;
+
+			if (!delim && (*p == '"' || *p == '\''))
+				delim = *p;
+			else if (*p == delim && !backslash)
+				delim = 0;
+			backslash = *p == '\\';
+			if (*p == '"' || (delim && *p == '\\'))
+				add2repl(repl, '\\');
+			if (*p == TOKSEP || *p == NOEXPM) p++;
+			else add2repl(repl, *p++);
+		}
+
+		/* trim spaces in the replacement list */
+		for (--repl->r_ptr; is_wsp(*repl->r_ptr); repl->r_ptr--)
+			/* EMPTY */;
+		++repl->r_ptr;		/* oops, one to far */
+		add2repl(repl, '"');
+	} else
+		error("illegal use of # operator");
+	return ptr;
+}
+
+/* The following routine is also called from domacro.c.
+ */
+add2repl(repl, ch)
+	register struct repl *repl;
+	int ch;
+{
+	register int index = repl->r_ptr - repl->r_text;
+
+	ASSERT(index < repl->r_size);
+	if (index + 2 >= repl->r_size) {
+		repl->r_text = Realloc(repl->r_text, (unsigned) (repl->r_size <<= 1));
+		repl->r_ptr = repl->r_text + index;
+	}
+	*repl->r_ptr++ = ch;
+	*repl->r_ptr = '\0';
+}
+
+/* If the variable stashraw is negative, we must only stash into the raw
+ * buffer. If the variable is zero, we must only stash into the expanded
+ * buffer. Otherwise, we must use both buffers.
+ */
+stash(repl, ch, stashraw)
+	struct repl *repl;
+	register int ch;
+	int stashraw;
+{
+	/*	Stash characters into the macro expansion buffer.
+	*/
+	register struct args *args = repl->r_args;
+	register int index = args->a_expptr - args->a_expbuf;
+
+	if (stashraw >= 0) {
+		ASSERT(index < args->a_expsize);
+		if (index + 1 >= args->a_expsize) {
+			args->a_expbuf = Realloc(args->a_expbuf,
+						    (unsigned) (args->a_expsize <<= 1));
+			args->a_expptr = args->a_expbuf + index;
+		}
+		*args->a_expptr++ = ch;
+	}
+
+	if (stashraw) {
+		index = args->a_rawptr - args->a_rawbuf;
+		ASSERT(index < args->a_rawsize);
+		if (index + 1 >= args->a_rawsize) {
+			args->a_rawbuf = Realloc(args->a_rawbuf,
+						    (unsigned)(args->a_rawsize <<= 1));
+			args->a_rawptr = args->a_rawbuf + index;
+		}
+		*args->a_rawptr++ = ch;
+	}
+}
+#endif /* NOPP */

lang/cem/cemcom.ansi/replace.str

@@ -0,0 +1,51 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/*	DEFINITIONS FOR THE MACRO REPLACEMENT ROUTINES		*/
+
+struct repl {
+	struct	repl *next;
+	struct	idf *r_idf;		/* name of the macro */
+	struct	args *r_args;		/* replacement parameters */
+	int	r_level;		/* level of insertion */
+	int	r_size;			/* current size of replacement buffer */
+	char	*r_ptr;			/* replacement text index pointer */
+	char	*r_text;		/* replacement text */
+};
+
+/* ALLOCDEF "repl" 4 */
+
+#define NO_REPL		(struct repl *)0
+
+/*	The implementation of the ## operator is currently very clumsy.
+	When the the ## operator is used the arguments are taken from
+	the raw buffer; this buffer contains a precise copy of the
+	original argument. The fully expanded copy is in the arg buffer.
+	The two copies are here explicitely because:
+
+		#define ABC	f()
+		#define	ABCD	2
+		#define	g(x, y)	x ## y + h(x)
+
+		g(ABC, D);		// gives: 2 + h(f()) 
+
+	In this case we need two copies: one raw copy for the pasting
+	operator, and an expanded one as argument for h().
+*/
+struct args {
+	char	*a_expptr;		/* expanded argument index pointer */
+	char	*a_expbuf;		/* expanded argument buffer pointer */
+	int	a_expsize;		/* current size of expanded buffer */
+	char	*a_expvec[NPARAMS];	/* expanded argument vector */
+	char	*a_rawptr;		/* raw argument index pointer */
+	char	*a_rawbuf;		/* raw argument buffer pointer */
+	int	a_rawsize;		/* current size of raw buffer */
+	char	*a_rawvec[NPARAMS];	/* raw argument vector */
+};
+
+/* ALLOCDEF "args" 2 */
+
+#define NO_ARGS		(struct args *)0
+

lang/cem/cemcom.ansi/scan.c

@@ -0,0 +1,237 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Header$ */
+/* PREPROCESSOR: SCANNER FOR THE ACTUAL PARAMETERS OF MACROS	*/
+
+#include	"nopp.h"
+
+#ifndef NOPP
+/*	This file contains the function getactuals() which scans an actual
+	parameter list and splits it up into a list of strings, each one
+	representing an actual parameter.
+*/
+
+#include	"lapbuf.h"	/* UF */
+#include	"nparams.h"	/* UF */
+
+#include	"input.h"
+#include	"class.h"
+#include	"idf.h"
+#include	"macro.h"
+#include	"interface.h"
+#include	"file_info.h"
+
+#define	EOS		'\0'
+#define	overflow()	(fatal("actual parameter buffer overflow"))
+
+PRIVATE char apbuf[LAPBUF]; /* temporary storage for actual parameters	*/
+PRIVATE char *actparams[NPARAMS]; /* pointers to the text of the actuals */
+PRIVATE char *aptr;	/* pointer to last inserted character in apbuf	*/
+
+#define	copy(ch)	((aptr < &apbuf[LAPBUF]) ? (*aptr++ = ch) : overflow())
+
+PRIVATE int nr_of_params;	/* number of actuals read until now	*/
+
+PRIVATE char **
+getactuals(idef)
+	register struct idf *idef;
+{
+	/*	getactuals() collects the actual parameters and turns them
+		into a list of strings, a pointer to which is returned.
+	*/
+	register acnt = idef->id_macro->mc_nps;
+
+	nr_of_params = 0;
+	actparams[0] = aptr = &apbuf[0];
+	copyact('(', ')', 0);	/* read the actual parameters	*/
+	copy(EOS);		/* mark the end of it all	*/
+
+	if (!nr_of_params++)	{		/* 0 or 1 parameter	*/
+		/* there could be a ( <spaces, comment, ...> )
+		*/
+		register char *p = actparams[0];
+
+		while ((class(*p) == STSKIP) || (*p == '\n')) {
+				++p;
+		}
+
+		if (!*p) {	/* the case () : 0 parameters	*/
+			nr_of_params--;
+		}
+	}
+
+	if (nr_of_params != acnt)	{
+		/*	argument mismatch: too many or too few
+			actual parameters.
+		*/
+		lexwarning("argument mismatch, %s", idef->id_text);
+
+		while (nr_of_params < acnt) {
+			/*	too few paraeters: remaining actuals are ""
+			*/
+			actparams[nr_of_params] = "";
+			nr_of_params++;
+		}
+	}
+
+	return actparams;
+}
+
+PRIVATE
+copyact(ch1, ch2, lvl)
+	char ch1, ch2;
+	int lvl;
+{
+	/*	copyact() is taken from Ceriel Jacobs' LLgen, with
+		permission.  Its task is to build a list of actuals
+		parameters, which list is surrounded by '(' and ')' and in
+		which the parameters are separated by ',' if there are
+		more than 1. The balancing of '(',')' and '[',']' and
+		'{','}' is taken care of by calling this function
+		recursively. At each level lvl, copyact() reads the input,
+		upto the corresponding closing bracket.
+
+		Opening bracket is ch1, closing bracket is ch2. If
+		lvl != 0, copy opening and closing parameters too.
+	*/
+	register int ch;		/* Current char */
+	register int match;		/* used to read strings */
+
+	if (lvl) {
+		copy(ch1);
+	}
+
+	for (;;)	{
+		LoadChar(ch);
+
+		if (ch == ch2)	{
+			if (lvl) {
+				copy(ch);
+			}
+			return;
+		}
+
+		switch(ch)	{
+
+#ifdef __MATCHING_PAR__
+		case ')':
+		case '}':
+		case ']':
+			lexerror("unbalanced parenthesis");
+			break;
+#endif __MATCHING_PAR__
+
+		case '(':
+			copyact('(', ')', lvl+1);
+			break;
+
+#ifdef __MATCHING_PAR__
+		case '{':
+			/*	example:
+					#define declare(v, t)	t v
+					declare(v, union{int i, j; float r;});
+			*/
+			copyact('{', '}', lvl+1);
+			break;
+
+		case '[':
+			copyact('[', ']', lvl+1);
+			break;
+#endif __MATCHING_PAR__
+
+		case '\n':
+			LineNumber++;
+			while (LoadChar(ch), ch == '#')	{
+				/*	This piece of code needs some
+					explanation: consider the call of
+					the macro defined as:
+						#define sum(b,c) (b + c)
+					in the following form:
+						sum(
+						#include my_phone_number
+						,2)
+					in which case the include must be
+					interpreted as such.
+				*/
+				domacro();	/* has read nl, vt or ff */
+				/* Loop, for another control line */
+			}
+
+			PushBack();
+			copy(' ');
+			break;
+
+		case '/':
+			LoadChar(ch);
+
+			if (ch == '*' && !InputLevel)	{	/* skip comment	*/
+				skipcomment();
+				continue;
+			}
+
+			PushBack();
+			copy('/');
+			break;
+
+		case ',':
+			if (!lvl)	{
+				/* next parameter encountered */
+				copy(EOS);
+
+				if (++nr_of_params >= NPARAMS) {
+					fatal("too many actual parameters");
+				}
+
+				actparams[nr_of_params] = aptr;
+			}
+			else	{
+				copy(ch);
+			}
+			break;
+
+		case '\'':
+		case '"' :
+			/*	watch out for brackets in strings, they do
+				not count !
+			*/
+			match = ch;
+			copy(ch);
+			while (LoadChar(ch), ch != EOI)	{
+				if (ch == match) {
+					break;
+				}
+
+				if (ch == '\\')	{
+					copy(ch);
+					LoadChar(ch);
+				}
+				else
+				if (ch == '\n')	{
+					lexerror("newline in string");
+					LineNumber++;
+					copy(match);
+					break;
+				}
+
+				copy(ch);
+			}
+
+			if (ch == match)	{
+				copy(ch);
+				break;
+			}
+			/* Fall through */
+
+		case EOI :
+			lexerror("unterminated macro call");
+			return;
+
+		default:
+			copy(ch);
+			break;
+		}
+	}
+}
+#endif NOPP

lang/cem/cemcom.ansi/sizes.h

@@ -0,0 +1,37 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* VARIOUS TARGET MACHINE SIZE DESCRIPTORS */
+
+#include "nocross.h"
+#include "trgt_sizes.h"
+
+#ifndef NOCROSS
+extern arith
+	short_size, word_size, dword_size, int_size, long_size,
+	float_size, double_size, lngdbl_size,
+	pointer_size;
+
+extern arith max_int, max_unsigned;	/* cstoper.c	*/
+#else /* NOCROSS */
+#define short_size	((arith)SZ_SHORT)
+#define word_size	((arith)SZ_WORD)
+#define dword_size	((arith)2*SZ_WORD)
+#define int_size	((arith)SZ_INT)
+#define long_size	((arith)SZ_LONG)
+#define float_size	((arith)SZ_FLOAT)
+#define double_size	((arith)SZ_DOUBLE)
+#define	lngdbl_size	((arith)SZ_LNGDBL)
+#define pointer_size	((arith)SZ_POINTER)
+
+#if SZ_INT == 2
+#define max_int		((arith)32767)
+#define max_unsigned	((arith)65535)
+#else /* SZ_INT == 4 */
+#define max_int		((arith)2147483647)
+#define max_unsigned	((arith)4294967295)
+#endif
+#endif /* NOCROSS */
+

lang/cem/cemcom.ansi/skip.c

@@ -0,0 +1,104 @@
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ */
+/* $Id$ */
+/* PREPROCESSOR: INPUT SKIP FUNCTIONS */
+
+#include	"nopp.h"
+#include	"arith.h"
+#include	"LLlex.h"
+#include	"class.h"
+#include	"input.h"
+
+#ifndef NOPP
+extern int InputLevel;
+
+int
+skipspaces(ch, skipnl)
+	register int ch;
+{
+	/*	skipspaces() skips any white space and returns the first
+		non-space character.
+	*/
+	register int nlseen = 0;
+
+	for (;;) {
+		while (class(ch) == STSKIP)
+			ch = GetChar();
+		if (skipnl && class(ch) == STNL) {
+			ch = GetChar();
+			LineNumber++;
+			nlseen++;
+			continue;
+		}
+		if (ch == TOKSEP && InputLevel) {
+			ch = GetChar();
+			continue;
+		}
+
+		/* \\\n are handled by trigraph */
+
+		if (ch == '/') {
+			ch = GetChar();
+			if (ch == '*' && !InputLevel) {
+				skipcomment();
+				ch = GetChar();
+			}
+			else	{
+				UnGetChar();
+				return '/';
+			}
+		}
+		else if (nlseen && ch == '#') {
+			domacro();
+			ch = GetChar();
+		} else
+			return ch;
+	}
+}
+#endif /* NOPP */
+
+SkipToNewLine()
+{
+	register int ch;
+	register int garbage = 0;
+#ifndef	NOPP
+	register int delim = 0;
+#endif
+
+	while ((ch = GetChar()) != '\n') {
+#ifndef NOPP
+		if (delim) {
+			if (ch == '\\') {
+				if (GetChar() == '\n') break;
+			} else if (ch == delim) {
+				delim = 0;
+			}
+			continue;
+		}
+		else if (ch == '\'' || ch == '\"') {
+			delim = ch;
+			garbage = 1;
+		} else if (ch == '/') {
+			if (GetChar() == '*'
+			    && !InputLevel
+			) {
+				skipcomment();
+				continue;
+			}
+			else UnGetChar();
+		}
+		else if (ch == TOKSEP && InputLevel) {
+			continue;
+		}
+#endif
+		if (!is_wsp(ch))
+			garbage = 1;
+	}
+#ifndef	NOPP
+	if (delim) strict("unclosed opening %c", delim);
+#endif
+	++LineNumber;
+	return garbage;
+}