lots and lots of changes & improvements

lang/cem/cemcom.ansi/BigPars

@@ -57,11 +57,9 @@
 #define SZ_WORD		(arith)4
 #define	SZ_INT		(arith)4
 #define	SZ_LONG		(arith)4
-#ifndef NOFLOAT
 #define	SZ_FLOAT	(arith)4
 #define	SZ_DOUBLE	(arith)8
 #define	SZ_LNGDBL	(arith)8	/* for now */
-#endif NOFLOAT
 #define	SZ_POINTER	(arith)4
 
 /* target machine alignment requirements	*/
@@ -70,11 +68,9 @@
 #define AL_WORD		SZ_WORD
 #define	AL_INT		SZ_WORD
 #define	AL_LONG		SZ_WORD
-#ifndef NOFLOAT
 #define	AL_FLOAT	SZ_WORD
 #define	AL_DOUBLE	SZ_WORD
 #define	AL_LNGDBL	SZ_WORD
-#endif NOFLOAT
 #define	AL_POINTER	SZ_WORD
 #define AL_STRUCT	1
 #define AL_UNION	1
@@ -134,14 +130,6 @@
 #define GSTATIC			/* for large global "static" arrays */
 
 
-!File: nofloat.h
-#undef NOFLOAT		1	/* if NOT defined, floats are implemented */
-
-
-!File: noRoption.h
-#undef NOROPTION	1	/* if NOT defined, R option is implemented */
-
-
 !File: nocross.h
 #undef NOCROSS		1	/* if NOT defined, cross compiler */
 

lang/cem/cemcom.ansi/LLlex.c

@@ -7,7 +7,6 @@
 
 #include	"lint.h"
 #include	<alloc.h>
-#include	"nofloat.h"
 #include	"idfsize.h"
 #include	"numsize.h"
 #include	"debug.h"
@@ -32,6 +31,7 @@ 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	*/
@@ -39,6 +39,11 @@ 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[];
+extern arith max_int;
+
 static struct token LexStack[MAX_LL_DEPTH];
 static LexSP = 0;
 
@@ -49,7 +54,7 @@ static LexSP = 0;
 */
 PushLex()
 {
-	ASSERT(LexSP < 2);
+	ASSERT(LexSP < MAX_LL_DEPTH);
 	ASSERT(ASIDE == 0);	/* ASIDE = 0;	*/
 	GetToken(&ahead);
 	LexStack[LexSP++] = dot;
@@ -95,12 +100,11 @@ LLlex()
 char	*string_token();
 arith	char_constant();
 
-
 int
 GetToken(ptok)
 	register struct token *ptok;
 {
-	/*	LexToken() is the actual token recognizer. It calls the
+	/*	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.
@@ -117,7 +121,9 @@ 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;
@@ -152,23 +158,13 @@ firstline:
 	case STSKIP:		/* just skip the skip characters	*/
 		goto again;
 	case STGARB:		/* garbage character			*/
+garbage:
 		if (040 < ch && ch < 0177)
 			lexerror("garbage char %c", ch);
 		else
 			lexerror("garbage char \\%03o", ch);
 		goto again;
 	case STSIMP:	/* a simple character, no part of compound token*/
-		if (ch == '/') { /* probably the start of comment	*/
-			ch = GetChar();
-			if (ch == '*') { /* start of comment */
-				skipcomment();
-				goto again;
-			}
-			else {
-				UnGetChar();
-				ch = '/';	/* restore ch	*/
-			}
-		}
 		return ptok->tk_symb = ch;
 	case STCOMP:	/* maybe the start of a compound token		*/
 		nch = GetChar();		/* character lookahead	*/
@@ -181,18 +177,24 @@ firstline:
 		case '&':
 			if (nch == '&')
 				return ptok->tk_symb = AND;
+			else if (nch == '=')
+				return ptok->tk_symb = ANDAB;
 			UnGetChar();
 			return ptok->tk_symb = ch;
 		case '+':
 			if (nch == '+')
 				return ptok->tk_symb = PLUSPLUS;
+			else if (nch == '=')
+				return ptok->tk_symb = PLUSAB;
 			UnGetChar();
 			return ptok->tk_symb = ch;
 		case '-':
 			if (nch == '-')
 				return ptok->tk_symb = MINMIN;
-			if (nch == '>')
+			else if (nch == '>')
 				return ptok->tk_symb = ARROW;
+			else if (nch == '=')
+				return ptok->tk_symb = MINAB;
 			UnGetChar();
 			return ptok->tk_symb = ch;
 		case '<':
@@ -202,8 +204,12 @@ firstline:
 							'>', &(ptok->tk_len));
 				return ptok->tk_symb = FILESPECIFIER;
 			}
-			if (nch == '<')
+			if (nch == '<') {
+				if ((nch = GetChar()) == '=')
+					return ptok->tk_symb = LEFTAB;
+				UnGetChar();
 				return ptok->tk_symb = LEFT;
+			}
 			if (nch == '=')
 				return ptok->tk_symb = LESSEQ;
 			UnGetChar();
@@ -211,64 +217,53 @@ firstline:
 		case '=':
 			if (nch == '=')
 				return ptok->tk_symb = EQUAL;
-
- 			/*	The following piece of code tries to recognise
- 				old-fashioned assignment operators `=op'
-				Note however, that these are removed from the
-				ANSI C standard.
-			*/
- 			switch (nch) {
- 			case '+':
- 				ptok->tk_symb = PLUSAB;
-				goto warn;
- 			case '-':
- 				ptok->tk_symb = MINAB;
-				goto warn;
- 			case '*':
- 				ptok->tk_symb = TIMESAB;
-				goto warn;
- 			case '/':
- 				ptok->tk_symb = DIVAB;
-				goto warn;
- 			case '%':
- 				ptok->tk_symb = MODAB;
-				goto warn;
- 			case '>':
- 			case '<':
- 				GetChar(ch);
- 				if (ch != nch) {
- 					UnGetChar();
- 					lexerror("illegal combination '=%c'",
- 						nch);
- 				}
- 				ptok->tk_symb = nch == '<' ? LEFTAB : RIGHTAB;
-				goto warn;
- 			case '&':
- 				ptok->tk_symb = ANDAB;
-				goto warn;
- 			case '^':
- 				ptok->tk_symb = XORAB;
-				goto warn;
- 			case '|':
- 				ptok->tk_symb = ORAB;
-			warn:
-				warning("Old-fashioned assignment operator");
-				return ptok->tk_symb;
- 			}
 			UnGetChar();
 			return ptok->tk_symb = ch;
 		case '>':
 			if (nch == '=')
 				return ptok->tk_symb = GREATEREQ;
-			if (nch == '>')
+			if (nch == '>') {
+				if ((nch = GetChar()) == '=')
+					return ptok->tk_symb = RIGHTAB;
+				UnGetChar();
 				return ptok->tk_symb = RIGHT;
+			}
 			UnGetChar();
 			return ptok->tk_symb = ch;
 		case '|':
 			if (nch == '|')
 				return ptok->tk_symb = OR;
+			else if (nch == '=')
+				return ptok->tk_symb = ORAB;
 			UnGetChar();
 			return ptok->tk_symb = ch;
+		case '%':
+			if (nch == '=')
+				return ptok->tk_symb = MODAB;
+			UnGetChar();
+			return ptok->tk_symb = ch;
+		case '*':
+			if (nch == '=')
+				return ptok->tk_symb = TIMESAB;
+			UnGetChar();
+			return ptok->tk_symb = ch;
+		case '^':
+			if (nch == '=')
+				return ptok->tk_symb = XORAB;
+			UnGetChar();
+			return ptok->tk_symb = ch;
+		case '/':
+			if (nch == '*' && !InputLevel) {
+				skipcomment();
+				goto again;
+			}
+			else if (nch == '=')
+				return ptok->tk_symb = DIVAB;
+			UnGetChar();
+			return ptok->tk_symb = ch;
+		default:
+			crash("bad class for char 0%o", ch);
+			/* NOTREACHED */
 		}
 	case STCHAR:				/* character constant	*/
 		ptok->tk_ival = char_constant("character");
@@ -291,6 +286,7 @@ firstline:
 			return ptok->tk_symb = INTEGER;
 		}
 		UnGetChar();
+		/* fallthrough */
 	case STIDF:
 	{
 		register char *tg = &buf[0];
@@ -298,7 +294,15 @@ firstline:
 		register int hash;
 		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
 		hash = STARTHASH();
 		do	{			/* read the identifier	*/
 			if (++pos < idfsize) {
@@ -316,12 +320,16 @@ firstline:
 		idef->id_file = ptok->tk_file;
 		idef->id_line = ptok->tk_line;
 #ifndef NOPP
-		if (idef->id_macro && ReplaceMacros) {
+		if (idef->id_macro && ReplaceMacros && !NoExpandNext) {
+#if 0
 			if (idef->id_macro->mc_count > 0)
 				idef->id_macro->mc_count--;
-			else if (replace(idef))
+			else
-				goto again;
+#endif	/* 0 */
+			if (replace(idef))
+					goto again;
 		}
+		NoExpandNext = 0;
 		if (UnknownIdIsZero && idef->id_reserved != SIZEOF) {
 			ptok->tk_ival = (arith)0;
 			ptok->tk_fund = INT;
@@ -338,171 +346,85 @@ firstline:
 	}
 	case STNUM:				/* a numeric constant	*/
 	{
-		register char *np = &buf[1];
+		register int siz_left = NUMSIZE - 1;
-		register int base = 10;
+		register char *np = &buf[0];
-		register int vch;
+		int flags = 0;
-		register arith val = 0;
+
+#define	store(ch)	if (--siz_left >= 0)		\
+				*np++ = ch;
 
 		if (ch == '.') {
-#ifndef NOFLOAT
+			/*	An embarrasing ambiguity. We have either a
-			/*	A very embarrasing ambiguity. We have either a
+				pp-number, a field operator, an ELLIPSIS or
-				floating point number or field operator or
+				an error (..).
-				ELLIPSIS.
 			*/
-			vch = GetChar();
+			ch = GetChar();
-			if (!is_dig(vch)) {	/* . or ... */
+			if (!is_dig(ch)) {	/* . or ... */
-				if (vch == '.') {
+				if (ch == '.') {
-					if ((vch = GetChar()) == '.')
+					if ((ch = GetChar()) == '.')
 						return ptok->tk_symb = ELLIPSIS;
-					/* This is funny: we can't push the
+					UnGetChar();		/* not '.' */
-					   second dot back. But then again
+					ChPushBack('.');	/* sigh ... */
-					   ..<ch> is already an error in C,
+				} else
-					   so why bother ?
+					UnGetChar();		/* not '.' */
-					*/
-					UnGetChar();
-					lexerror("illegal combination '..'");
-				}
-				UnGetChar();
 				return ptok->tk_symb = '.';
 			}
-			*np++ = '0';
 			UnGetChar();
-#else
+			ch = '.';
-			if ((vch = GetChar()) == '.') {
+			flags |= FLG_DOTSEEN;
-				if ((vch = GetChar()) == '.')
+		 }
-					return ptok->tk_symb = ELLIPSIS;
+		store(ch);
-				UnGetChar();
+		ch = GetChar();
-				lexerror("illegal combination '..'");
+		while(in_idf(ch) || ch == '.') {
-			}
+			store(ch);
-			UnGetChar();
+			if (ch == '.') flags |= FLG_DOTSEEN;
-			return ptok->tk_symb = '.';
+			if (ch == 'e' || ch == 'E') {
-#endif
+				flags |= FLG_ESEEN;
-		}
-		if (ch == '0') {
-			*np++ = ch;
-			ch = GetChar();
-			if (ch == 'x' || ch == 'X') {
-				base = 16;
 				ch = GetChar();
-			}
+				if (ch == '+' || ch == '-') {
-			else
+					flags |= FLG_DOTSEEN;	/* trick */
-				base = 8;
+					store(ch);
-		}
+					ch = GetChar();
-		while (vch = val_in_base(ch, base), vch >= 0) {
-			val = val*base + vch;
-			if (np < &buf[NUMSIZE])
-				*np++ = ch;
-			ch = GetChar();
-		}
-		if (is_suf(ch)) {
-			register int suf_long = 0;
-			register int suf_unsigned = 0;
-
-			/*	The type of the integal constant is
-				based on its suffix.
-			*/
-			do {
-				switch (ch) {
-				case 'l':
-				case 'L':
-					suf_long++;
-					break;
-				case 'u':
-				case 'U':
-					suf_unsigned++;
-					break;
 				}
-				ch = GetChar();
+			} else ch = GetChar();
-			} while (is_suf(ch));
+		}
-			UnGetChar();
+		store('\0');
+		UnGetChar();
 
-			if (suf_long > 1)
+		np = &buf[0];
-				lexerror("only one long suffix allowed");
+		ch = *np++;
-			if (suf_unsigned > 1)
+		if (siz_left < 0) {
-				lexerror("only one unsigned suffix allowed");
+			lexerror("number too long");
-
+			if ((flags & FLG_DOTSEEN)
-			ptok->tk_fund = (suf_long && suf_unsigned) ? ULONG :
+			    || (flags & FLG_ESEEN
-					(suf_long) ? LONG : UNSIGNED;
+				&& !(ch == '0'
-			ptok->tk_ival = val;
+				    && (*np == 'x' || *np == 'X')))) {
-			return ptok->tk_symb = INTEGER;
+			    ptok->tk_fval = Salloc("0.0", (unsigned) 4);
-		}
+			    ptok->tk_fund = DOUBLE;
-#ifndef NOFLOAT
+			    return ptok->tk_symb = FLOATING;
-		if (base == 16 || !(ch == '.' || ch == 'e' || ch == 'E'))
-#endif NOFLOAT
-		{
-			UnGetChar();
-			ptok->tk_ival = val;
-			/*	The semantic analyser must know if the
-				integral constant is given in octal/hexa-
-				decimal form, in which case its type is
-				UNSIGNED, or in decimal form, in which case
-				its type is signed, indicated by
-				the fund INTEGER.
-			*/
-			ptok->tk_fund = 
-				(base == 10 || (base == 8 && val == (arith)0))
-					? INTEGER : UNSIGNED;
-			return ptok->tk_symb = INTEGER;
-		}
-		/* where's the test for the length of the integral ???	*/
-#ifndef NOFLOAT
-		if (ch == '.'){
-			if (np < &buf[NUMSIZE])
-				*np++ = ch;
-			ch = GetChar();
-		}
-		while (is_dig(ch)){
-			if (np < &buf[NUMSIZE])
-				*np++ = ch;
-			ch = GetChar();
-		}
-		if (ch == 'e' || ch == 'E') {
-			if (np < &buf[NUMSIZE])
-				*np++ = ch;
-			ch = GetChar();
-			if (ch == '+' || ch == '-') {
-				if (np < &buf[NUMSIZE])
-					*np++ = ch;
-				ch = GetChar();
-			}
-			if (!is_dig(ch)) {
-				lexerror("malformed floating constant");
-				if (np < &buf[NUMSIZE])
-					*np++ = ch;
-			}
-			while (is_dig(ch)) {
-				if (np < &buf[NUMSIZE])
-					*np++ = ch;
-				ch = GetChar();
 			}
+			ptok->tk_ival = 1;
+			ptok->tk_fund = ULONG;
+			ptok->tk_symb = INTEGER;
 		}
-
+		/* Now, the pp-number must be converted into a token */
-		/*	The type of an integral floating point
+		if ((flags & FLG_DOTSEEN)
-			constant may be given by the float (f)
+			|| (flags & FLG_ESEEN
-			or long double (l) suffix.
+			    && !(ch == '0' && (*np == 'x' || *np == 'X')))) {
-		*/
+			strflt2tok(&buf[0], ptok);
-		if (ch == 'f' || ch == 'F')
+			return ptok->tk_symb = FLOATING;
-			ptok->tk_fund = FLOAT;
-		else if (ch == 'l' || ch == 'L')
-			ptok->tk_fund = LNGDBL;
-		else {
-			ptok->tk_fund = DOUBLE;
-			UnGetChar();
 		}
-
+		strint2tok(&buf[0], ptok);
-		*np++ = '\0';
+		return ptok->tk_symb = INTEGER;
-		buf[0] = '-';	/* good heavens...	*/
-		if (np == &buf[NUMSIZE+1]) {
-			lexerror("floating constant too long");
-			ptok->tk_fval = Salloc("0.0",(unsigned) 5) + 1;
-		}
-		else
-			ptok->tk_fval = Salloc(buf,(unsigned) (np - buf)) + 1;
-		return ptok->tk_symb = FLOATING;
-#endif NOFLOAT
 	}
 	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);
 	}
@@ -533,16 +455,13 @@ skipcomment()
 		while (c != '*') {
 			if (class(c) == STNL) {
 				++LineNumber;
-			} else
+			} else if (c == EOI) {
-			if (c == EOI) {
 				NoUnstack--;
 #ifdef	LINT
 				lint_end_comment();
 #endif	LINT
 				return;
 			}
-			if (c == '/' && (c = GetChar()) == '*')
-				strict("extra comment delimiter found");
 			c = GetChar();
 #ifdef	LINT
 			lint_comment_char(c);
@@ -580,7 +499,8 @@ char_constant(nm)
 		if (ch == '\\')
 			ch = quoted(GetChar());
 		if (ch >= 128) ch -= 256;
-		val = val*256 + ch;
+		if (size < (int)int_size)
+			val |= ch << 8 * size;
 		size++;
 		ch = GetChar();
 	}
@@ -612,7 +532,7 @@ string_token(nm, stop_char, plen)
 			lexerror("end-of-file inside %s", nm);
 			break;
 		}
-		if (ch == '\\')
+		if (ch == '\\' && !AccFileSpecifier)
 			ch = quoted(GetChar());
 		str[pos++] = ch;
 		if (pos == str_size)
@@ -776,3 +696,134 @@ trigraph()
 	PushBack();
 	return('?');
 }
+
+/* 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 {
+		ptok->tk_fund = DOUBLE;
+	}
+	if (*cp) malformed++;
+	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 = is_dig(*cp) ? *cp - '0'
+				    : (( *cp >= 'A' && *cp <= 'F' ? *cp - 'A'
+								: *cp - 'a')
+					+ 10) ;
+		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 ((val & full_mask[(int)int_size]) == val) {
+		if (val >= 0 && val <= max_int) fund = INT;
+		else fund = (base == 10 ? LONG : 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) {
+	    if (fund == INT) fund = LONG;
+	    else 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

@@ -10,7 +10,6 @@
 	to it.
 */
 
-#include "nofloat.h"
 #include "file_info.h"
 #include "nopp.h"
 
@@ -27,9 +26,7 @@ struct token	{
 			int tok_len;	/* length of row of bytes */
 		} tok_string;
 		arith tok_ival;		/* for INTEGER */
-#ifndef NOFLOAT
 		char *tok_fval;		/* for FLOATING */
-#endif NOFLOAT
 	} tok_data;
 };
 
@@ -41,9 +38,7 @@ struct token	{
 #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
-#ifndef NOFLOAT
 #define tk_fval	tok_data.tok_fval
-#endif NOFLOAT
 
 extern struct token dot, ahead, aside;
 

lang/cem/cemcom.ansi/LLmessage.c

@@ -6,7 +6,6 @@
 /*		PARSER ERROR ADMINISTRATION		*/
 
 #include	<alloc.h>
-#include	"nofloat.h"
 #include	"idf.h"
 #include	"arith.h"
 #include	"LLlex.h"
@@ -50,10 +49,8 @@ insert_token(tk)
 		dot.tk_fund = INT;
 		dot.tk_ival = 1;
 		break;
-#ifndef NOFLOAT
 	case FLOATING:
 		dot.tk_fval = Salloc("0.0", 4);
 		break;
-#endif NOFLOAT
 	}
 }

lang/cem/cemcom.ansi/LintPars

@@ -52,10 +52,8 @@
 #define SZ_WORD		(arith)4
 #define	SZ_INT		(arith)4
 #define	SZ_LONG		(arith)4
-#ifndef NOFLOAT
 #define	SZ_FLOAT	(arith)4
 #define	SZ_DOUBLE	(arith)8
-#endif NOFLOAT
 #define	SZ_POINTER	(arith)4
 
 /* target machine alignment requirements	*/
@@ -64,10 +62,8 @@
 #define AL_WORD		SZ_WORD
 #define	AL_INT		SZ_WORD
 #define	AL_LONG		SZ_WORD
-#ifndef NOFLOAT
 #define	AL_FLOAT	SZ_WORD
 #define	AL_DOUBLE	SZ_WORD
-#endif NOFLOAT
 #define	AL_POINTER	SZ_WORD
 #define AL_STRUCT	1
 #define AL_UNION	1
@@ -127,14 +123,6 @@
 #define GSTATIC			/* for large global "static" arrays */
 
 
-!File: nofloat.h
-#undef NOFLOAT		1	/* if NOT defined, floats are implemented */
-
-
-!File: noRoption.h
-#undef NOROPTION	1	/* if NOT defined, R option is implemented */
-
-
 !File: nocross.h
 #undef NOCROSS		1	/* if NOT defined, cross compiler */
 

lang/cem/cemcom.ansi/Makefile

@@ -4,7 +4,7 @@
 # Machine and environ dependent definitions
 EMHOME = ../../..
 CC = cc
-CC = /proj/em/Work/bin/fcc.cc
+CC = $(EMHOME)/bin/fcc
 CFLOW = cflow
 MKDEP = $(EMHOME)/bin/mkdep
 PRID = $(EMHOME)/bin/prid
@@ -17,6 +17,7 @@ EMOLIB = $(EMHOME)/modules/lib/libemopt.a
 EMELIB = $(EMHOME)/modules/lib/libeme.a $(EMHOME)/lib/em_data.a
 STRLIB = $(EMHOME)/modules/lib/libstring.a
 PRTLIB = $(EMHOME)/modules/lib/libprint.a
+FLTLIB = $(EMHOME)/modules/lib/libflt.a
 EMMESLIB = $(EMHOME)/modules/lib/libem_mes.a
 EMMESOLIB = $(EMHOME)/modules/lib/libem_mesO.a
 EMMESCELIB = $(EMHOME)/modules/lib/libem_mesCE.a
@@ -28,15 +29,15 @@ INPLIB = $(EMHOME)/modules/lib/libinput.a
 ALLOCLIB = $(EMHOME)/modules/lib/liballoc.a
 MALLOC = $(EMHOME)/modules/lib/malloc.o
 LIBS = $(INPLIB) $(EMMESLIB) $(EMKLIB) $(PRTLIB) $(STRLIB) \
-	$(ALLOCLIB) $(MALLOC) $(SYSLIB)
+	$(ALLOCLIB) $(MALLOC) $(SYSLIB) $(FLTLIB)
 ELIBS = $(INPLIB) $(EMMESLIB) $(EMELIB) $(PRTLIB) $(STRLIB) \
-	$(ALLOCLIB) $(MALLOC) $(SYSLIB)
+	$(ALLOCLIB) $(MALLOC) $(SYSLIB) $(FLTLIB)
 OLIBS = $(INPLIB) $(EMMESOLIB) $(EMOLIB) $(EMKLIB) $(PRTLIB) $(STRLIB) \
-	$(ALLOCLIB) $(MALLOC) $(SYSLIB)
+	$(ALLOCLIB) $(MALLOC) $(SYSLIB) $(FLTLIB)
 CELIBS = $(INPLIB) $(EMMESCELIB) $(EMCELIB) $(PRTLIB) $(STRLIB) \
-	$(ALLOCLIB) $(MALLOC) $(SYSLIB)
+	$(ALLOCLIB) $(MALLOC) $(SYSLIB) $(FLTLIB)
 LLIBS = $(INPLIB) $(EMMESLIB) $(PRTLIB) $(STRLIB) \
-	$(ALLOCLIB) $(MALLOC) $(SYSLIB)
+	$(ALLOCLIB) $(MALLOC) $(SYSLIB) $(FLTLIB)
 LIB_INCLUDES = -I$(EMHOME)/modules/h -I$(EMHOME)/modules/pkg
 EM_INCLUDES = -I$(EMHOME)/h
 SYSLLIB = $(EMHOME)/modules/lib/llib-lsystem.ln
@@ -70,7 +71,7 @@ LOBJ =	tokenfile.o declar.o statement.o expression.o program.o Lpars.o ival.o
 
 # Objects of hand-written C files
 CSRC =	main.c idf.c declarator.c decspecs.c struct.c \
-	expr.c ch7.c ch7bin.c cstoper.c arith.c \
+	expr.c ch7.c ch7bin.c cstoper.c fltcstoper.c arith.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 \
@@ -79,7 +80,7 @@ CSRC =	main.c idf.c declarator.c decspecs.c struct.c \
 	pragma.c blocks.c dataflow.c Version.c \
 	l_lint.c l_states.c l_misc.c l_ev_ord.c l_outdef.c l_comment.c l_dummy.c
 COBJ =	main.o idf.o declarator.o decspecs.o struct.o \
-	expr.o ch7.o ch7bin.o cstoper.o arith.o \
+	expr.o ch7.o ch7bin.o cstoper.o fltcstoper.o arith.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 \
@@ -106,7 +107,7 @@ GSRC =	$(GCSRC)  $(GHSTRSRC)
 # .h files generated by `make hfiles LLfiles'; PLEASE KEEP THIS UP-TO-DATE!
 GHSRC =	botch_free.h dataflow.h debug.h density.h errout.h \
 	idfsize.h ifdepth.h inputtype.h lapbuf.h argbuf.h lint.h \
-	nobitfield.h nofloat.h nopp.h noRoption.h nocross.h \
+	nobitfield.h nopp.h nocross.h \
 	nparams.h numsize.h parbufsize.h pathlength.h Lpars.h \
 	strsize.h target_sizes.h textsize.h use_tmp.h spec_arith.h static.h \
 	regcount.h
@@ -290,10 +291,8 @@ main.o: input.h
 main.o: inputtype.h
 main.o: level.h
 main.o: lint.h
-main.o: noRoption.h
 main.o: nobitfield.h
 main.o: nocross.h
-main.o: nofloat.h
 main.o: nopp.h
 main.o: proto.h
 main.o: sizes.h
@@ -319,10 +318,8 @@ idf.o: idfsize.h
 idf.o: label.h
 idf.o: level.h
 idf.o: lint.h
-idf.o: noRoption.h
 idf.o: nobitfield.h
 idf.o: nocross.h
-idf.o: nofloat.h
 idf.o: nopp.h
 idf.o: nparams.h
 idf.o: proto.h
@@ -346,7 +343,6 @@ declarator.o: level.h
 declarator.o: lint.h
 declarator.o: nobitfield.h
 declarator.o: nocross.h
-declarator.o: nofloat.h
 declarator.o: nopp.h
 declarator.o: proto.h
 declarator.o: sizes.h
@@ -361,9 +357,7 @@ decspecs.o: decspecs.h
 decspecs.o: def.h
 decspecs.o: level.h
 decspecs.o: lint.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
@@ -379,10 +373,8 @@ struct.o: file_info.h
 struct.o: idf.h
 struct.o: level.h
 struct.o: lint.h
-struct.o: noRoption.h
 struct.o: nobitfield.h
 struct.o: nocross.h
-struct.o: nofloat.h
 struct.o: nopp.h
 struct.o: proto.h
 struct.o: sizes.h
@@ -394,7 +386,9 @@ struct.o: type.h
 expr.o: LLlex.h
 expr.o: Lpars.h
 expr.o: arith.h
+expr.o: assert.h
 expr.o: botch_free.h
+expr.o: debug.h
 expr.o: declar.h
 expr.o: decspecs.h
 expr.o: def.h
@@ -404,10 +398,8 @@ expr.o: idf.h
 expr.o: label.h
 expr.o: level.h
 expr.o: lint.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
@@ -424,7 +416,6 @@ ch7.o: idf.h
 ch7.o: label.h
 ch7.o: lint.h
 ch7.o: nobitfield.h
-ch7.o: nofloat.h
 ch7.o: nopp.h
 ch7.o: proto.h
 ch7.o: spec_arith.h
@@ -437,9 +428,7 @@ ch7bin.o: expr.h
 ch7bin.o: idf.h
 ch7bin.o: label.h
 ch7bin.o: lint.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
@@ -453,24 +442,37 @@ 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
+fltcstoper.o: Lpars.h
+fltcstoper.o: arith.h
+fltcstoper.o: assert.h
+fltcstoper.o: debug.h
+fltcstoper.o: expr.h
+fltcstoper.o: idf.h
+fltcstoper.o: label.h
+fltcstoper.o: nobitfield.h
+fltcstoper.o: nocross.h
+fltcstoper.o: nopp.h
+fltcstoper.o: sizes.h
+fltcstoper.o: spec_arith.h
+fltcstoper.o: target_sizes.h
+fltcstoper.o: type.h
 arith.o: Lpars.h
 arith.o: arith.h
+arith.o: assert.h
+arith.o: debug.h
 arith.o: expr.h
 arith.o: field.h
 arith.o: idf.h
 arith.o: label.h
 arith.o: lint.h
 arith.o: mes.h
-arith.o: noRoption.h
 arith.o: nobitfield.h
 arith.o: nocross.h
-arith.o: nofloat.h
 arith.o: nopp.h
 arith.o: proto.h
 arith.o: sizes.h
@@ -495,10 +497,8 @@ code.o: l_lint.h
 code.o: label.h
 code.o: level.h
 code.o: lint.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
@@ -519,7 +519,6 @@ dumpidf.o: idf.h
 dumpidf.o: label.h
 dumpidf.o: lint.h
 dumpidf.o: nobitfield.h
-dumpidf.o: nofloat.h
 dumpidf.o: nopp.h
 dumpidf.o: proto.h
 dumpidf.o: spec_arith.h
@@ -536,7 +535,6 @@ error.o: expr.h
 error.o: file_info.h
 error.o: label.h
 error.o: lint.h
-error.o: nofloat.h
 error.o: nopp.h
 error.o: spec_arith.h
 error.o: tokenname.h
@@ -553,7 +551,6 @@ field.o: label.h
 field.o: lint.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
@@ -564,7 +561,6 @@ 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
@@ -582,7 +578,6 @@ LLlex.o: input.h
 LLlex.o: lint.h
 LLlex.o: macro.h
 LLlex.o: nocross.h
-LLlex.o: nofloat.h
 LLlex.o: nopp.h
 LLlex.o: numsize.h
 LLlex.o: sizes.h
@@ -594,7 +589,6 @@ 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
@@ -614,7 +608,6 @@ domacro.o: idfsize.h
 domacro.o: ifdepth.h
 domacro.o: input.h
 domacro.o: macro.h
-domacro.o: nofloat.h
 domacro.o: nopp.h
 domacro.o: nparams.h
 domacro.o: parbufsize.h
@@ -632,7 +625,6 @@ replace.o: idfsize.h
 replace.o: input.h
 replace.o: lapbuf.h
 replace.o: macro.h
-replace.o: nofloat.h
 replace.o: nopp.h
 replace.o: nparams.h
 replace.o: numsize.h
@@ -654,10 +646,8 @@ options.o: idf.h
 options.o: idfsize.h
 options.o: lint.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
@@ -668,7 +658,6 @@ skip.o: arith.h
 skip.o: class.h
 skip.o: file_info.h
 skip.o: input.h
-skip.o: nofloat.h
 skip.o: nopp.h
 skip.o: spec_arith.h
 stack.o: Lpars.h
@@ -680,9 +669,7 @@ stack.o: idf.h
 stack.o: level.h
 stack.o: lint.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
@@ -698,7 +685,6 @@ type.o: idf.h
 type.o: lint.h
 type.o: nobitfield.h
 type.o: nocross.h
-type.o: nofloat.h
 type.o: nopp.h
 type.o: proto.h
 type.o: sizes.h
@@ -714,7 +700,6 @@ ch7mon.o: idf.h
 ch7mon.o: label.h
 ch7mon.o: lint.h
 ch7mon.o: nobitfield.h
-ch7mon.o: nofloat.h
 ch7mon.o: nopp.h
 ch7mon.o: spec_arith.h
 ch7mon.o: type.h
@@ -725,9 +710,7 @@ label.o: idf.h
 label.o: label.h
 label.o: level.h
 label.o: lint.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
@@ -748,7 +731,6 @@ eval.o: lint.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
@@ -766,19 +748,19 @@ 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: nocross.h
 switch.o: nopp.h
+switch.o: sizes.h
 switch.o: spec_arith.h
 switch.o: switch.h
+switch.o: target_sizes.h
 switch.o: type.h
 conversion.o: Lpars.h
 conversion.o: arith.h
 conversion.o: lint.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
@@ -788,7 +770,6 @@ util.o: align.h
 util.o: def.h
 util.o: lint.h
 util.o: nocross.h
-util.o: nofloat.h
 util.o: regcount.h
 util.o: sizes.h
 util.o: stack.h
@@ -812,7 +793,6 @@ proto.o: level.h
 proto.o: lint.h
 proto.o: nobitfield.h
 proto.o: nocross.h
-proto.o: nofloat.h
 proto.o: nopp.h
 proto.o: nparams.h
 proto.o: proto.h
@@ -834,7 +814,6 @@ pragma.o: idfsize.h
 pragma.o: ifdepth.h
 pragma.o: input.h
 pragma.o: macro.h
-pragma.o: nofloat.h
 pragma.o: nopp.h
 pragma.o: nparams.h
 pragma.o: parbufsize.h
@@ -847,7 +826,6 @@ blocks.o: atw.h
 blocks.o: label.h
 blocks.o: lint.h
 blocks.o: nocross.h
-blocks.o: nofloat.h
 blocks.o: sizes.h
 blocks.o: spec_arith.h
 blocks.o: stack.h
@@ -871,7 +849,6 @@ l_lint.o: label.h
 l_lint.o: level.h
 l_lint.o: lint.h
 l_lint.o: nobitfield.h
-l_lint.o: nofloat.h
 l_lint.o: nopp.h
 l_lint.o: spec_arith.h
 l_lint.o: stack.h
@@ -896,7 +873,6 @@ l_states.o: label.h
 l_states.o: level.h
 l_states.o: lint.h
 l_states.o: nobitfield.h
-l_states.o: nofloat.h
 l_states.o: nopp.h
 l_states.o: spec_arith.h
 l_states.o: stack.h
@@ -915,7 +891,6 @@ l_misc.o: label.h
 l_misc.o: level.h
 l_misc.o: lint.h
 l_misc.o: nobitfield.h
-l_misc.o: nofloat.h
 l_misc.o: nopp.h
 l_misc.o: spec_arith.h
 l_misc.o: stack.h
@@ -937,7 +912,6 @@ l_ev_ord.o: label.h
 l_ev_ord.o: level.h
 l_ev_ord.o: lint.h
 l_ev_ord.o: nobitfield.h
-l_ev_ord.o: nofloat.h
 l_ev_ord.o: nopp.h
 l_ev_ord.o: spec_arith.h
 l_ev_ord.o: stack.h
@@ -962,7 +936,6 @@ l_outdef.o: label.h
 l_outdef.o: level.h
 l_outdef.o: lint.h
 l_outdef.o: nobitfield.h
-l_outdef.o: nofloat.h
 l_outdef.o: nopp.h
 l_outdef.o: spec_arith.h
 l_outdef.o: stack.h
@@ -998,7 +971,6 @@ declar.o: level.h
 declar.o: lint.h
 declar.o: nobitfield.h
 declar.o: nocross.h
-declar.o: nofloat.h
 declar.o: nopp.h
 declar.o: proto.h
 declar.o: sizes.h
@@ -1021,7 +993,6 @@ statement.o: l_state.h
 statement.o: label.h
 statement.o: lint.h
 statement.o: nobitfield.h
-statement.o: nofloat.h
 statement.o: nopp.h
 statement.o: spec_arith.h
 statement.o: stack.h
@@ -1035,9 +1006,7 @@ expression.o: file_info.h
 expression.o: idf.h
 expression.o: label.h
 expression.o: lint.h
-expression.o: noRoption.h
 expression.o: nobitfield.h
-expression.o: nofloat.h
 expression.o: nopp.h
 expression.o: spec_arith.h
 expression.o: type.h
@@ -1055,7 +1024,6 @@ program.o: l_state.h
 program.o: label.h
 program.o: lint.h
 program.o: nobitfield.h
-program.o: nofloat.h
 program.o: nopp.h
 program.o: spec_arith.h
 program.o: type.h
@@ -1075,10 +1043,8 @@ ival.o: l_lint.h
 ival.o: label.h
 ival.o: level.h
 ival.o: lint.h
-ival.o: noRoption.h
 ival.o: nobitfield.h
 ival.o: nocross.h
-ival.o: nofloat.h
 ival.o: nopp.h
 ival.o: proto.h
 ival.o: sizes.h

lang/cem/cemcom.ansi/SmallPars

@@ -57,11 +57,9 @@
 #define SZ_WORD		(arith)4
 #define	SZ_INT		(arith)4
 #define	SZ_LONG		(arith)4
-#ifndef NOFLOAT
 #define	SZ_FLOAT	(arith)4
 #define	SZ_DOUBLE	(arith)8
 #define	SZ_LNGDBL	(arith)8	/* for now */
-#endif NOFLOAT
 #define	SZ_POINTER	(arith)4
 
 /* target machine alignment requirements	*/
@@ -70,11 +68,9 @@
 #define AL_WORD		SZ_WORD
 #define	AL_INT		SZ_WORD
 #define	AL_LONG		SZ_WORD
-#ifndef NOFLOAT
 #define	AL_FLOAT	SZ_WORD
 #define	AL_DOUBLE	SZ_WORD
 #define	AL_LNGDBL	SZ_WORD
-#endif NOFLOAT
 #define	AL_POINTER	SZ_WORD
 #define AL_STRUCT	1
 #define AL_UNION	1
@@ -134,14 +130,6 @@
 #define GSTATIC			/* for large global "static" arrays */
 
 
-!File: nofloat.h
-#undef NOFLOAT		1	/* if NOT defined, floats are implemented */
-
-
-!File: noRoption.h
-#define NOROPTION	1	/* if NOT defined, R option is implemented */
-
-
 !File: nocross.h
 #undef NOCROSS		1	/* if NOT defined, cross compiler */
 

lang/cem/cemcom.ansi/align.h

@@ -5,16 +5,13 @@
 /* $Header$ */
 /*	 A L I G N M E N T   D E F I N I T I O N S	*/
 
-#include "nofloat.h"
 #include "nocross.h"
 #include "target_sizes.h"
 
 #ifndef NOCROSS
 extern int
 	short_align, word_align, int_align, long_align,
-#ifndef NOFLOAT
 	float_align, double_align, lngdbl_align,
-#endif NOFLOAT
 	pointer_align,
 	struct_align, union_align;
 #else NOCROSS
@@ -22,11 +19,9 @@ extern int
 #define word_align	((int)AL_WORD)
 #define int_align	((int)AL_INT)
 #define long_align	((int)AL_LONG)
-#ifndef NOFLOAT
 #define float_align	((int)AL_FLOAT)
 #define double_align	((int)AL_DOUBLE)
 #define	lngdbl_align	((int)AL_LNGDBL)
-#endif NOFLOAT
 #define pointer_align	((int)AL_POINTER)
 #define struct_align	((int)AL_STRUCT)
 #define union_align	((int)AL_UNION)

lang/cem/cemcom.ansi/arith.c

@@ -13,9 +13,9 @@
 
 #include	<alloc.h>
 #include	"lint.h"
-#include	"nofloat.h"
 #include	"nobitfield.h"
 #include	"idf.h"
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"sizes.h"
 #include	"type.h"
@@ -25,12 +25,12 @@
 #include	"Lpars.h"
 #include	"field.h"
 #include	"mes.h"
-#include	"noRoption.h"
+#include	"assert.h"
 
 extern char *symbol2str();
 extern char options[];
 
-arithbalance(e1p, oper, e2p)	/* RM 6.6 */
+arithbalance(e1p, oper, e2p)	/* 3.1.2.5 */
 	register struct expr **e1p, **e2p;
 	int oper;
 {
@@ -38,15 +38,17 @@ arithbalance(e1p, oper, e2p)	/* RM 6.6 */
 		of the arithmetic operator oper.
 	*/
 	register int t1, t2, u1, u2;
+	int shifting = (oper == LEFT || oper == RIGHT
+			|| oper == LEFTAB || oper == RIGHTAB);
 
 	t1 = any2arith(e1p, oper);
 	t2 = any2arith(e2p, oper);
 	/* Now t1 and t2 are either INT, LONG, FLOAT, DOUBLE, or LNGDBL */
 
-#ifndef NOFLOAT
 	/*	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)
 			int2float(e2p, lngdbl_type);
@@ -82,7 +84,6 @@ arithbalance(e1p, oper, e2p)	/* RM 6.6 */
 			int2float(e1p, float_type);
 		return;
 	}
-#endif NOFLOAT
 
 	/* Now they are INT or LONG */
 	u1 = (*e1p)->ex_type->tp_unsigned;
@@ -93,7 +94,8 @@ arithbalance(e1p, oper, e2p)	/* RM 6.6 */
 	*/
 	if (t1 == LONG && u1 && (t2 != LONG || !u2))
 		t2 = int2int(e2p, ulong_type);
-	else if (t2 == LONG && u2 && (t1 != LONG || !u1))
+	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
@@ -104,7 +106,7 @@ arithbalance(e1p, oper, e2p)	/* RM 6.6 */
 	*/
 	if (t1 == LONG && t2 == INT && u2)
 		t2 = int2int(e2p, (int_size<long_size)? long_type : ulong_type);
-	else if (t2 == LONG && t1 == INT && u1)
+	else if (t2 == LONG && t1 == INT && u1 && !shifting)	/* ??? */
 		t1 = int2int(e1p, (int_size<long_size)? long_type : ulong_type);
 	if (int_size > long_size) /* sanity check */
 		crash("size of int exceeds size of long");
@@ -115,17 +117,17 @@ arithbalance(e1p, oper, e2p)	/* RM 6.6 */
 	if (t1 == LONG && t2 != LONG)
 		t2 = int2int(e2p, long_type);
 	else
-	if (t2 == LONG && t1 != LONG)
+	if (t2 == LONG && t1 != LONG && !shifting)	/* ??? */
 		t1 = int2int(e1p, long_type);
 
 	/*	If either operand has type unsigned int, the other operand
 		is converted to unsigned int.
 		Otherwise, both operands have type int.
 	*/
-	if (u1 && !u2)
+	if (u1 && !u2 && !shifting)
 		t2 = int2int(e2p, (t1 == LONG) ? ulong_type : uint_type);
 	else
-	if (!u1 && u2)
+	if (!u1 && u2 && !shifting)
 		t1 = int2int(e1p, (t2 == LONG) ? ulong_type : uint_type);
 }
 
@@ -168,15 +170,15 @@ ch76pointer(expp, oper, tp)
 			ch7cast(expp, oper, tp);
 	}
 	else
-	if (	is_integral_type(exp->ex_type)
+	if (is_integral_type(exp->ex_type)) {
-#ifndef NOROPTION
+		if ((oper != EQUAL && oper != NOTEQUAL && oper != ':')
-		&&
+		    || !(is_cp_cst(exp) && exp->VL_VALUE == 0)) {
-		(	!options['R'] /* we don't care */ ||
+			expr_error(exp,"%s on %s and pointer",
-			(oper == EQUAL || oper == NOTEQUAL || oper == ':')
+					symbol2str(oper),
-		)
+					symbol2str(exp->ex_type->tp_fund));
-#endif NOROPTION
+		}
-	)		/* ch 7.7 */
 		ch7cast(expp, CAST, tp);
+	}
 	else	{
 		expr_error(exp, "%s on %s and pointer",
 				symbol2str(oper),
@@ -191,8 +193,8 @@ any2arith(expp, oper)
 	register struct expr **expp;
 	register int oper;
 {
-	/*	Turns any expression into int_type, long_type or
+	/*	Turns any expression into int_type, long_type,
-		double_type.
+		float_type, double_type or lngdbl_type.
 	*/
 	int fund;
 
@@ -200,41 +202,32 @@ any2arith(expp, oper)
 	case CHAR:
 	case SHORT:
 	case GENERIC:
-		int2int(expp,
+		ASSERT((*expp)->ex_type->tp_size <= int_type->tp_size);
-			(*expp)->ex_type->tp_unsigned ? uint_type : int_type);
+
+		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:
-		/* test the admissibility of the operator */
-		if (	is_test_op(oper) || oper == '=' || oper == PARCOMMA ||
-			oper == ',' || oper == ':'
-		)	{
-			/* allowed by K & R */
-		}
-		else
-#ifndef NOROPTION
-		if (!options['R'])	{
-			/* allowed by us */
-		}
-		else
-			expr_warning(*expp, "%s on enum", symbol2str(oper));
-#endif NOROPTION
 #ifndef	LINT
 		int2int(expp, int_type);
 #endif	LINT
 		break;
-#ifndef	NOFLOAT
 	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;
-#endif	NOFLOAT
 #ifndef NOBITFIELD
 	case FIELD:
 		field2arith(expp);
@@ -322,7 +315,6 @@ int2int(expp, tp)
 	return exp->ex_type->tp_fund;
 }
 
-#ifndef NOFLOAT
 int2float(expp, tp)
 	register struct expr **expp;
 	struct type *tp;
@@ -331,18 +323,20 @@ int2float(expp, tp)
 		converted to the floating type tp.
 	*/
 	register struct expr *exp = *expp;
-	char buf[32];
 	
 	fp_used = 1;
 	if (is_cp_cst(exp)) {
 		*expp = new_expr();
 		**expp = *exp;
-		sprint(buf+1, "%ld", (long)(exp->VL_VALUE));
+		/* sprint(buf+1, "%ld", (long)(exp->VL_VALUE));
-		buf[0] = '-';
+		/* buf[0] = '-';
-		exp = *expp;
+		*/
+		exp = *expp;	/* ??? */
+		
 		exp->ex_type = tp;
 		exp->ex_class = Float;
-		exp->FL_VALUE = Salloc(buf, (unsigned)strlen(buf)+2) + 1;
+		exp->FL_VALUE = 0 /* Salloc(buf, (unsigned)strlen(buf)+1) */ ;
+		flt_arith2flt(exp->VL_VALUE, &(exp->FL_ARITH));
 		exp->FL_DATLAB = 0;
 	}
 	else	*expp = arith2arith(tp, INT2FLOAT, *expp);
@@ -376,7 +370,6 @@ float2float(expp, tp)
 	else
 		*expp = arith2arith(tp, FLOAT2FLOAT, *expp);
 }
-#endif NOFLOAT
 
 array2pointer(exp)
 	register struct expr *exp;
@@ -384,8 +377,9 @@ array2pointer(exp)
 	/*	The expression, which must be an array, is converted
 		to a pointer.
 	*/
-	exp->ex_type = construct_type(POINTER, exp->ex_type->tp_up, 0,
+	exp->ex_type = construct_type(POINTER, exp->ex_type->tp_up
-				     (arith)0, NO_PROTO);
+				    , /* exp->ex_type->tp_typequal */ 0
+				    , (arith)0, NO_PROTO);
 }
 
 function2pointer(exp)
@@ -454,10 +448,9 @@ opnd2logical(expp, oper)
 	case LONG:
 	case ENUM:
 	case POINTER:
-#ifndef NOFLOAT
 	case FLOAT:
 	case DOUBLE:
-#endif NOFLOAT
+	case LNGDBL:
 		break;
 	default:
 		expr_error(*expp, "%s operand to %s",
@@ -503,13 +496,11 @@ any2opnd(expp, oper)
 {
 	if (!*expp)
 		return;
-	switch ((*expp)->ex_type->tp_fund)	{	/* RM 7.1 */
+	switch ((*expp)->ex_type->tp_fund)	{
 	case CHAR:
 	case SHORT:
 	case ENUM:
-#ifndef NOFLOAT
+	/* case FLOAT:	/* not necessary anymore */
-	case FLOAT:
-#endif NOFLOAT
 		any2arith(expp, oper);
 		break;
 	case ARRAY:
@@ -533,10 +524,8 @@ any2parameter(expp)
 	/*	To handle default argument promotions
 	*/
 	any2opnd(expp, '(');
-#ifndef NOFLOAT
 	if ((*expp)->ex_type->tp_fund == FLOAT)
 		float2float(expp, double_type);
-#endif NOFLOAT
 }
 
 #ifndef NOBITFIELD
@@ -569,19 +558,13 @@ field2arith(expp)
 }
 #endif NOBITFIELD
 
-#ifndef NOFLOAT
+/*	switch_sign_fp() negates the given floating constant expression,
-/*	switch_sign_fp() negates the given floating constant expression
+ *	and frees the string representing the old value.
-	The lexical analyser has reserved an extra byte of space in front
+ */
-	of the string containing the representation of the floating
-	constant.  This byte contains the '-' character and we have to
-	take care of the first byte the fl_value pointer points to.
-*/
 switch_sign_fp(expr)
 	register struct expr *expr;
 {
-	if (*(expr->FL_VALUE) == '-')
+	flt_umin(&(expr->FL_ARITH));
-		++(expr->FL_VALUE);
+	if (expr->FL_VALUE) free(expr->FL_VALUE);
-	else
+	expr->FL_VALUE = 0;
-		--(expr->FL_VALUE);
 }
-#endif NOFLOAT

lang/cem/cemcom.ansi/arith.h

@@ -26,3 +26,7 @@
 #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/ch7.c

@@ -3,13 +3,13 @@
  * 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  7 RM	*/
+/*	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	"nofloat.h"
 #include	"debug.h"
 #include	"nobitfield.h"
 #include	"idf.h"
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"proto.h"
 #include	"type.h"
@@ -23,6 +23,7 @@
 
 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
@@ -52,15 +53,15 @@ ch7sel(expp, oper, idf)
 				"char c; c->selector"
 			*/
 			switch (tp->tp_fund)	{
+			case POINTER:
+				break;
 			case INT:
 			case LONG:
-				/* Allowed by RM 14.1 */
+				/* An error is given in idf2sdef() */
 				ch7cast(expp, CAST, pa_type);
 				sd = idf2sdef(idf, tp);
 				tp = sd->sd_stype;
 				break;
-			case POINTER:
-				break;
 			default:
 				expr_error(exp, "-> applied to %s",
 					symbol2str(tp->tp_fund));
@@ -69,7 +70,9 @@ ch7sel(expp, oper, idf)
 				return;
 			}
 		}
-	} /* oper == ARROW */
+	} else {		/* oper == '.' */
+		/* nothing */
+	}
 	exp = *expp;
 	switch (tp->tp_fund)	{
 	case POINTER:	/* for int *p;	p->next = ...	*/
@@ -105,8 +108,10 @@ ch7sel(expp, oper, idf)
 			*/
 			exp->VL_VALUE += sd->sd_offset;
 			exp->ex_type = sd->sd_type;
-			if (exp->ex_type == error_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)	{
@@ -116,13 +121,17 @@ ch7sel(expp, oper, idf)
 				ASSERT(is_cp_cst(op->op_right));
 				op->op_right->VL_VALUE += sd->sd_offset;
 				exp->ex_type = sd->sd_type;
-				if (exp->ex_type == error_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 = exp->OP_LEFT->ex_lvalue;
+				exp->ex_lvalue = sd->sd_type->tp_fund != ARRAY;
+				if (!exp->OP_LEFT->ex_lvalue)
+					exp->ex_flags |= EX_ILVALUE;
 			}
 		}
 	}
@@ -130,11 +139,15 @@ ch7sel(expp, oper, idf)
 		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;
 }
 
@@ -191,15 +204,6 @@ ch7cast(expp, oper, tp)
 		int i = is_integral_type(tp);
 
 		if (oldi && i)	{
-			if (	oper != CAST
-			&&	(	tp->tp_fund == ENUM
-				||	oldtp->tp_fund == ENUM
-				)
-			) {
-				expr_warning(*expp,
-					"dubious %s on enum",
-					symbol2str(oper));
-			}
 #ifdef	LINT
 			if (oper == CAST)
 				(*expp)->ex_type = tp;
@@ -209,13 +213,8 @@ ch7cast(expp, oper, tp)
 			int2int(expp, tp);
 #endif	LINT
 		}
-#ifndef NOFLOAT
 		else
 		if (oldi && !i)	{
-			if (oldtp->tp_fund == ENUM && oper != CAST)
-				expr_warning(*expp,
-					"conversion of enum to %s\n",
-					symbol2str(tp->tp_fund));
 #ifdef	LINT
 			if (oper == CAST)
 				(*expp)->ex_type = tp;
@@ -247,12 +246,6 @@ ch7cast(expp, oper, tp)
 			float2float(expp, tp);
 #endif	LINT
 		}
-#else NOFLOAT
-		else {
-			crash("(ch7cast) floats not implemented\n");
-			/*NOTREACHED*/
-		}
-#endif NOFLOAT
 	}
 	else
 	if (oldtp->tp_fund == POINTER && tp->tp_fund == POINTER)	{
@@ -330,6 +323,9 @@ ch7cast(expp, oper, tp)
 			);
 		(*expp)->ex_type = tp;		/* brute force */
 	}
+	if (oper == CAST) {
+		(*expp)->ex_flags |= EX_ILVALUE;
+	}
 }
 
 /*	Determine whether two types are equal.
@@ -348,9 +344,10 @@ equal_type(tp, otp)
 		return 0;
 	if (tp->tp_align != otp->tp_align)
 		return 0;
-	if (tp->tp_fund != ARRAY)
+	if (tp->tp_fund != ARRAY /* && tp->tp_fund != STRUCT */ ) {	/* UNION ??? */
 		if (tp->tp_size != otp->tp_size)
 			return 0;
+	}
 
 	switch (tp->tp_fund) {
 
@@ -359,9 +356,13 @@ equal_type(tp, otp)
 			each parameter in the composite parameter type list
 			is the composite type of the corresponding paramaters.
 		*/
-		if (tp->tp_proto && otp->tp_proto &&
+		if (tp->tp_proto && otp->tp_proto) {
-		    !equal_proto(tp->tp_proto, otp->tp_proto))
+			if (!equal_proto(tp->tp_proto, otp->tp_proto))
-			return 0;
+				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:
@@ -374,6 +375,16 @@ equal_type(tp, otp)
 		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);
 
@@ -387,6 +398,78 @@ equal_type(tp, otp)
 	}
 }
 
+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;
 {
@@ -397,15 +480,35 @@ equal_proto(pl, opl)
 		(a function prototype), the composite type is a function
 		prototype with parameter type list.
 	*/
-	if (pl == 0 || opl == 0) return 0;
+	while ( pl && opl) {
 
-	if (pl->pl_flag != opl->pl_flag)
+	    if ((pl->pl_flag & ~PL_ERRGIVEN) != (opl->pl_flag & ~PL_ERRGIVEN))
 		return 0;
 
-	if (!equal_type(pl->pl_type, opl->pl_type))
+	    if (!equal_type(pl->pl_type, opl->pl_type))
 		return 0;
 
-	return equal_proto(pl->next, opl->next);
+	    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)
@@ -431,13 +534,17 @@ ch7asgn(expp, oper, expr)
 	struct type *tp;
 
 	/* We expect an lvalue */
-	if (!exp->ex_lvalue)	{
+	if (!exp->ex_lvalue) {
-		expr_error(exp, "no lvalue in lhs of %s", symbol2str(oper));
+		expr_error(exp, "no lvalue in operand of %s", symbol2str(oper));
-		exp->ex_depth = 99;	/* no direct store/load at EVAL() */
+	} else if (exp->ex_flags & EX_ILVALUE)	{
-			/* what is 99 ??? DG */
+		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));
 	}
-	if (exp->ex_flags & EX_READONLY)
-		strict("lhs of assignment is read-only");
 
 	/*	Preserve volatile markers across the tree.
 		This is questionable, depending on the way the optimizer
@@ -520,11 +627,9 @@ is_arith_type(tp)
 	case INT:
 	case LONG:
 	case ENUM:
-#ifndef NOFLOAT
 	case FLOAT:
 	case DOUBLE:
 	case LNGDBL:
-#endif NOFLOAT
 		return 1;
 #ifndef NOBITFIELD
 	case FIELD:

lang/cem/cemcom.ansi/ch7bin.c

@@ -3,20 +3,19 @@
  * See the copyright notice in the ACK home directory, in the file "Copyright".
  */
 /* $Header$ */
-/* SEMANTIC ANALYSIS (CHAPTER 7RM)  --  BINARY OPERATORS */
+/* SEMANTIC ANALYSIS (CHAPTER 3.3)  --  BINARY OPERATORS */
 
 #include	"botch_free.h"
 #include	<alloc.h>
-#include	"nofloat.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	"noRoption.h"
 
 extern char options[];
 extern char *symbol2str();
@@ -40,8 +39,8 @@ ch7bin(expp, oper, expr)
 	any2opnd(expp, oper);
 	any2opnd(&expr, oper);
 	switch (oper)	{
-	case '[':				/* RM 7.1 */
+	case '[':				/* 3.3.2.1 */
-		/* RM 14.3 states that indexing follows the commutative laws */
+		/* indexing follows the commutative laws */
 		switch ((*expp)->ex_type->tp_fund)	{
 		case POINTER:
 		case ARRAY:
@@ -67,14 +66,10 @@ ch7bin(expp, oper, expr)
 		ch7mon('*', expp);
 		break;
 
-	case '(':				/* RM 7.1 */
+	case '(':				/* 3.3.2.2 */
 		if (	(*expp)->ex_type->tp_fund == POINTER &&
 			(*expp)->ex_type->tp_up->tp_fund == FUNCTION
 		)	{
-#ifndef NOROPTION
-			if (options['R'])
-				warning("function pointer called");
-#endif NOROPTION
 			ch7mon('*', expp);
 		}
 		if ((*expp)->ex_type->tp_fund != FUNCTION)	{
@@ -82,6 +77,8 @@ ch7bin(expp, oper, expr)
 				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,
@@ -89,7 +86,7 @@ ch7bin(expp, oper, expr)
 		(*expp)->ex_flags |= EX_SIDEEFFECTS;
 		break;
 
-	case PARCOMMA:				/* RM 7.1 */
+	case PARCOMMA:				/* 3.3.2.2 */
 		if ((*expp)->ex_type->tp_fund == FUNCTION)
 			function2pointer(*expp);
 		*expp = new_oper(expr->ex_type, *expp, PARCOMMA, expr);
@@ -102,7 +99,7 @@ ch7bin(expp, oper, expr)
 	case ORAB:
 		opnd2integral(expp, oper);
 		opnd2integral(&expr, oper);
-		/* Fall through */
+		/* fallthrough */
 	case '/':
 	case DIVAB:
 	case TIMESAB:
@@ -115,7 +112,7 @@ ch7bin(expp, oper, expr)
 	case '|':
 		opnd2integral(expp, oper);
 		opnd2integral(&expr, oper);
-		/* Fall through */
+		/* fallthrough */
 	case '*':
 		arithbalance(expp, oper, &expr);
 		commutative_binop(expp, oper, expr);
@@ -127,7 +124,7 @@ ch7bin(expp, oper, expr)
 			expr = *expp;
 			*expp = etmp;
 		}
-		/*FALLTHROUGH*/
+		/* fallthrough */
 	case PLUSAB:
 	case POSTINCR:
 	case PLUSPLUS:
@@ -226,8 +223,9 @@ ch7bin(expp, oper, expr)
 				ch7bin(expp, ',', expr);
 			}
 		}
-		else
+		else {
 			*expp = new_oper(int_type, *expp, oper, expr);
+		}
 		(*expp)->ex_flags |= EX_LOGICAL;
 		break;
 
@@ -310,6 +308,8 @@ mk_binop(expp, oper, expr, commutative)
 
 	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) :
@@ -320,16 +320,18 @@ mk_binop(expp, oper, expr, commutative)
 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
 	*/
-#ifndef NOFLOAT
+	if ((typ = any2arith(expp2, oper)) == FLOAT
-	if (any2arith(expp2, oper) == DOUBLE)	{
+	    || typ == DOUBLE
+	    || typ == LNGDBL)	{
 		expr_error(*expp2,
-			"illegal combination of float and pointer");
+			"illegal combination of %s and pointer",
+			symbol2str(typ));
 		erroneous2int(expp2);
 	}
-#endif NOFLOAT
 	ch7bin( expp2, '*',
 		intexpr(size_of_type((*expp1)->ex_type->tp_up, "object"),
 			pa_type->tp_fund)

lang/cem/cemcom.ansi/ch7mon.c

@@ -3,13 +3,13 @@
  * See the copyright notice in the ACK home directory, in the file "Copyright".
  */
 /* $Header$ */
-/* SEMANTIC ANALYSIS (CHAPTER 7RM) -- MONADIC OPERATORS */
+/* SEMANTIC ANALYSIS (CHAPTER 3.3) -- MONADIC OPERATORS */
 
 #include	"botch_free.h"
 #include	<alloc.h>
-#include	"nofloat.h"
 #include	"nobitfield.h"
 #include	"Lpars.h"
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"type.h"
 #include	"label.h"
@@ -18,7 +18,7 @@
 #include	"def.h"
 
 extern char options[];
-extern long full_mask[/*MAXSIZE*/];	/* cstoper.c */
+extern arith full_mask[/*MAXSIZE*/];	/* cstoper.c */
 char *symbol2str();
 
 ch7mon(oper, expp)
@@ -29,16 +29,20 @@ ch7mon(oper, expp)
 	register struct expr *expr;
 
 	switch (oper)	{
-	case '*':			/* RM 7.2 */
+	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 != POINTER) {
-			expr_error(*expp,
+		    if ((*expp)->ex_type->tp_fund != FUNCTION) {
-				"* applied to non-pointer (%s)",
+			    expr_error(*expp,
-				symbol2str((*expp)->ex_type->tp_fund));
+				    "* applied to non-pointer (%s)",
-		}
+				    symbol2str((*expp)->ex_type->tp_fund));
-		else {
+		    } 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 */
@@ -54,16 +58,17 @@ ch7mon(oper, expp)
 				(*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) {
-			warning("& before array ignored");
+			expr_warning(*expp, "& before array ignored");
 			array2pointer(*expp);
 		}
 		else
 		if ((*expp)->ex_type->tp_fund == FUNCTION) {
-			warning("& before function ignored");
+			expr_warning(*expp, "& before function ignored");
 			function2pointer(*expp);
 		}
 		else
@@ -74,6 +79,8 @@ ch7mon(oper, expp)
 #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)) {
@@ -90,28 +97,25 @@ ch7mon(oper, expp)
 					break;	/* break case '&' */
 				}
 			}
-			(*expp)->ex_type = pointer_to((*expp)->ex_type);
+			(*expp)->ex_type = pointer_to((*expp)->ex_type,
+						(*expp)->ex_type->tp_typequal);
 			(*expp)->ex_lvalue = 0;
 			(*expp)->ex_flags &= ~EX_READONLY;
 		}
 		break;
 	case '~':
-#ifndef NOFLOAT
 	{
 		int fund = (*expp)->ex_type->tp_fund;
 
-		if (fund == FLOAT || fund == DOUBLE)	{
+		if (fund == FLOAT || fund == DOUBLE || fund == LNGDBL)	{
-			expr_error(
+			expr_error( *expp,
-				*expp,
+				    "~ not allowed on %s operands",
-				"~ not allowed on %s operands",
+				    symbol2str(fund));
-				symbol2str(fund)
-			);
 			erroneous2int(expp);
 			break;
 		}
 		/* FALLTHROUGH */
 	}
-#endif NOFLOAT
 	case '-':
 		any2arith(expp, oper);
 		if (is_cp_cst(*expp))	{
@@ -124,11 +128,9 @@ ch7mon(oper, expp)
 			  );
 		}
 		else
-#ifndef NOFLOAT
 		if (is_fp_cst(*expp))
 			switch_sign_fp(*expp);
 		else
-#endif NOFLOAT
 			*expp = new_oper((*expp)->ex_type,
 					NILEXPR, oper, *expp);
 		break;
@@ -152,7 +154,7 @@ ch7mon(oper, expp)
 		break;
 	case SIZEOF:
 		if (ISNAME(*expp) && (*expp)->VL_IDF->id_def->df_formal_array)
-			warning("sizeof formal array %s is sizeof pointer!",
+			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) :

lang/cem/cemcom.ansi/char.tab

@@ -10,14 +10,15 @@
 %iSTGARB
 STSKIP:\r \t\013\f
 STNL:\n
-STCOMP:-!&+<=>|
+STCOMP:-!&+<=>|*%/^
-STSIMP:%()*,/:;?[]^{}~
+STSIMP:(),:;?[]{}~
 STCHAR:'
-STIDF:a-zA-KM-Z_
+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[] = {
@@ -44,7 +45,7 @@ STEOI:\200
 %	ISHEX
 %
 %C
-1:a-fA-F
+1:0-9a-fA-F
 %Tchar ishex[] = {
 %p
 %T};
@@ -57,14 +58,6 @@ STEOI:\200
 %p
 %T};
 %
-%	ISSUF
-%
-%C
-1:lLuU
-%Tchar issuf[] = {
-%p
-%T};
-%
 %	ISWSP
 %
 %C

lang/cem/cemcom.ansi/class.h

@@ -13,7 +13,7 @@
 #define	class(ch)	(tkclass[ch])
 
 /*	Being the start of a token is, fortunately, a mutual exclusive
-	property, so, although there are less than 16 classes they can be
+	property, so, as there are less than 16 classes they can be
 	packed in 4 bits.
 */
 
@@ -28,6 +28,10 @@
 #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

lang/cem/cemcom.ansi/code.c

@@ -11,6 +11,7 @@
 #include	<alloc.h>
 #include	"dataflow.h"
 #include	"use_tmp.h"
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"type.h"
 #include	"idf.h"
@@ -28,7 +29,6 @@
 #include	"specials.h"
 #include	"atw.h"
 #include	"assert.h"
-#include	"noRoption.h"
 #include	"file_info.h"
 #ifdef	LINT
 #include	"l_lint.h"
@@ -37,9 +37,8 @@
 label lab_count = 1;
 label datlab_count = 1;
 
-#ifndef NOFLOAT
 int fp_used;
-#endif NOFLOAT
+extern arith NewLocal();	/* util.c	*/
 
 /* global function info */
 char *func_name;
@@ -109,12 +108,10 @@ end_code()
 	/*	end_code() performs the actions to be taken when closing
 		the output stream.
 	*/
-#ifndef NOFLOAT
 	if (fp_used) {
 		/* floating point used	*/
 		C_ms_flt();
 	}
-#endif NOFLOAT
 	def_strings(str_list);
 	str_list = 0;
 	C_ms_src((int)(LineNumber - 2), FileName);
@@ -204,6 +201,7 @@ begin_proc(ds, idf)		/* to be called when entering a procedure */
 		DfaStartFunction(name);
 #endif	DATAFLOW
 
+
 	/* set global function info */
 	func_name = name;
 	if (def->df_type->tp_fund != FUNCTION) {
@@ -368,32 +366,31 @@ code_declaration(idf, expr, lvl, sc)
 		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.  This is to allow:
+		declaration.
-			extern int a;
-			int a = 5;
-		while at the same time forbidding
-			extern int a = 5;
 	*/
 	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		*/
 		return;
-	if (sc == EXTERN && expr && !is_anon_idf(idf))
-		error("%s is extern; cannot initialize", idf->id_text);
 #ifndef PREPEND_SCOPES
-	if (def->df_type->tp_fund == FUNCTION) {
+	if (fund == FUNCTION) {
 		code_scope(idf->id_text, def);
 	}
 #endif PREPEND_SCOPES
 	if (lvl == L_GLOBAL)	{	/* global variable	*/
 		/* is this an allocating declaration? */
 		if (	(sc == 0 || sc == STATIC)
-			&& def->df_type->tp_fund != FUNCTION
+			&& fund != FUNCTION
 			&& size >= 0
 		)
 			def->df_alloc = ALLOC_SEEN;
+		if (expr && def_sc == STATIC && sc == EXTERN) {
+			warning("%s redeclared extern", idf->id_text);
+			def->df_sc = EXTERN;
+		}
 		if (expr) {	/* code only if initialized */
 #ifndef PREPEND_SCOPES
 			code_scope(idf->id_text, def);
@@ -407,7 +404,7 @@ code_declaration(idf, expr, lvl, sc)
 		/* STATIC, EXTERN, GLOBAL, IMPLICIT, AUTO or REGISTER */
 		switch (def_sc)	{
 		case STATIC:
-			if (def->df_type->tp_fund == FUNCTION) {
+			if (fund == FUNCTION) {
 				/* should produce "inp $function" ??? */
 				break;
 			}
@@ -426,6 +423,9 @@ code_declaration(idf, expr, lvl, sc)
 			}
 			break;
 		case EXTERN:
+			if (expr && !is_anon_idf(idf) && level != L_GLOBAL)
+				error("cannot initialize extern in block"
+						, idf->id_text);
 		case GLOBAL:
 		case IMPLICIT:
 			/* we are sure there is no expression */
@@ -437,6 +437,11 @@ code_declaration(idf, expr, lvl, sc)
 		case REGISTER:
 			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");
@@ -455,27 +460,44 @@ loc_init(expr, id)
 	*/
 	register struct expr *e = expr;
 	register struct type *tp = id->id_def->df_type;
+	static arith tmpoffset = 0;
+	static arith unknownsize = 0;
 	
 	ASSERT(id->id_def->df_sc != STATIC);
 	switch (tp->tp_fund)	{
 	case ARRAY:
+		if (id->id_def->df_type->tp_size == (arith) -1)
+			unknownsize = 1;
 	case STRUCT:
 	case UNION:
-		error("automatic %s cannot be initialized in declaration",
+		if (!tmpoffset) {	/* first time for this variable */
-			symbol2str(tp->tp_fund));
+			tmpoffset = id->id_def->df_address;
-		free_expression(e);
+			id->id_def->df_address = data_label();
+			C_df_dlb((label)id->id_def->df_address);
+		} else {
+			/* generate a 'loi, sti' sequence. The peephole
+			 * optimizer will optimize this into a 'blm'
+			 * whenever possible.
+			 */
+			C_lae_dlb((label)id->id_def->df_address, (arith)0);
+			C_loi(tp->tp_size);
+			if (unknownsize) {
+				/* tmpoffset += tp->tp_size; */
+				unknownsize = 0;
+
+				tmpoffset = NewLocal(tp->tp_size
+						    , tp->tp_align
+						    , regtype(tp)
+						    , id->id_def->df_sc);
+			}
+			C_lal(tmpoffset);
+			C_sti(tp->tp_size);
+			id->id_def->df_address = tmpoffset;
+			tmpoffset = 0;
+		}
 		return;
 	}
 	if (ISCOMMA(e))	{	/* embraced: int i = {12};	*/
-#ifndef NOROPTION
-		if (options['R'])	{
-			if (ISCOMMA(e->OP_LEFT)) /* int i = {{1}} */
-				expr_error(e, "extra braces not allowed");
-			else
-			if (e->OP_RIGHT != 0) /* int i = {1 , 2} */
-				expr_error(e, "too many initializers");
-		}
-#endif NOROPTION
 		while (e)	{
 			loc_init(e->OP_LEFT, id);
 			e = e->OP_RIGHT;
@@ -510,25 +532,17 @@ bss(idf)
 #ifndef	PREPEND_SCOPES
 	code_scope(idf->id_text, idf->id_def);
 #endif	PREPEND_SCOPES
-	/*	Since bss() is only called if df_alloc is non-zero, and
-		since df_alloc is only non-zero if size >= 0, we have:
-	*/
-	/*	but we already gave a warning at the declaration of the
-		array. Besides, the message given here does not apply to
-		voids
-	
-	if (options['R'] && size == 0)
-		warning("actual array of size 0");
-	*/
 	C_df_dnam(idf->id_text);
 	C_bss_cst(ATW(size), (arith)0, 1);
 }
 
-formal_cvt(df)
+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.
+		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;
 
@@ -540,6 +554,12 @@ formal_cvt(df)
 		   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);
+		conversion(double_type, float_type);
+		StoreLocal(df->df_address, tp->tp_size);
 	}
 }
 

lang/cem/cemcom.ansi/conversion.c

@@ -8,7 +8,6 @@
 #include	"lint.h"
 #ifndef	LINT
 
-#include	"nofloat.h"
 #include	<em.h>
 #include	"arith.h"
 #include	"type.h"
@@ -17,9 +16,7 @@
 
 #define	T_SIGNED		1
 #define	T_UNSIGNED		2
-#ifndef NOFLOAT
 #define	T_FLOATING		3
-#endif NOFLOAT
 
 /*	conversion() generates the EM code for a conversion between
 	the types char, short, int, long, float, double and pointer.
@@ -52,9 +49,7 @@ conversion(from_type, to_type)
 			C_cii();
 			break;
 		case T_UNSIGNED:
-#ifndef NOFLOAT
 		case T_FLOATING:
-#endif NOOFLOAT
 			if ((int)from_size < (int)word_size) {
 				C_loc(from_size);
 				C_loc(word_size);
@@ -79,14 +74,11 @@ conversion(from_type, to_type)
 		case T_UNSIGNED:
 			C_cuu();
 			break;
-#ifndef NOFLOAT
 		case T_FLOATING:
 			C_cuf();
 			break;
-#endif NOFLOAT
 		}
 		break;
-#ifndef NOFLOAT
 	case T_FLOATING:
 		C_loc(from_size);
 		C_loc(to_size);
@@ -102,17 +94,14 @@ conversion(from_type, to_type)
 			break;
 		}
 		break;
-#endif NOFLOAT
 	default:
 		crash("(conversion) illegal type conversion");
 		/*NOTREACHED*/
 	}
 	if ((int)(to_type->tp_size) < (int)word_size
-#ifndef NOFLOAT
 	    && to_cnvtype != T_FLOATING
-#endif NOFLOAT
 	    ) {
-		extern long full_mask[];
+		extern arith full_mask[];
 
 		if (to_cnvtype == T_SIGNED) {
 			C_loc(to_type->tp_size);
@@ -142,12 +131,10 @@ convtype(tp)
 	case LONG:
 	case ENUM:
 		return tp->tp_unsigned ? T_UNSIGNED : T_SIGNED;
-#ifndef NOFLOAT
 	case FLOAT:
 	case DOUBLE:
 	case LNGDBL:
 		return T_FLOATING;
-#endif NOFLOAT
 	case POINTER:
 		return T_UNSIGNED;
 	}

lang/cem/cemcom.ansi/cstoper.c

@@ -7,6 +7,7 @@
 
 #include	"target_sizes.h"
 #include	"idf.h"
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"type.h"
 #include	"label.h"
@@ -15,11 +16,10 @@
 #include	"Lpars.h"
 #include	"assert.h"
 
-long mach_long_sign;	/* sign bit of the machine long */
+arith full_mask[MAXSIZE];/* full_mask[1] == 0XFF, full_mask[2] == 0XFFFF, .. */
-int mach_long_size;	/* size of long on this machine == sizeof(long) */
-long full_mask[MAXSIZE];/* full_mask[1] == 0XFF, full_mask[2] == 0XFFFF, .. */
 arith max_int;		/* maximum integer on target machine	*/
 arith max_unsigned;	/* maximum unsigned on target machine	*/
+extern int ResultKnown;
 
 cstbin(expp, oper, expr)
 	register struct expr **expp, *expr;
@@ -39,35 +39,38 @@ cstbin(expp, oper, expr)
 		break;
 	case '/':
 		if (o2 == 0)	{
-			expr_error(expr, "division by 0");
+			if (!ResultKnown)
+				expr_error(expr, "division by 0");
+			else
+				expr_warning(expr, "division by 0");
 			break;
 		}
 		if (uns)	{
 			/*	this is more of a problem than you might
 				think on C compilers which do not have
-				unsigned long.
+				unsigned arith (== long (probably)).
 			*/
-			if (o2 & mach_long_sign)	{/* o2 > max_long */
+			if (o2 & arith_sign)	{/* o2 > max_arith */
 				o1 = ! (o1 >= 0 || o1 < o2);
 				/*	this is the unsigned test
-					o1 < o2 for o2 > max_long
+					o1 < o2 for o2 > max_arith
 				*/
 			}
-			else	{		/* o2 <= max_long */
+			else	{		/* o2 <= max_arith */
-				long half, bit, hdiv, hrem, rem;
+				arith half, bit, hdiv, hrem, rem;
 
-				half = (o1 >> 1) & ~mach_long_sign;
+				half = (o1 >> 1) & ~arith_sign;
 				bit = o1 & 01;
 				/*	now o1 == 2 * half + bit
-					and half <= max_long
+					and half <= max_arith
-					and bit <= max_long
+					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_long
+					rem >= o2 for o2 <= max_arith
 				*/
 			}
 		}
@@ -76,24 +79,27 @@ cstbin(expp, oper, expr)
 		break;
 	case '%':
 		if (o2 == 0)	{
-			expr_error(expr, "modulo by 0");
+			if (!ResultKnown)
+				expr_error(expr, "modulo by 0");
+			else
+				expr_warning(expr, "modulo by 0");
 			break;
 		}
 		if (uns)	{
-			if (o2 & mach_long_sign)	{/* o2 > max_long */
+			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_long
+					o1 < o2 for o2 > max_arith
 				*/
 			}
-			else	{		/* o2 <= max_long */
+			else	{		/* o2 <= max_arith */
-				long half, bit, hrem, rem;
+				arith half, bit, hrem, rem;
 
-				half = (o1 >> 1) & ~mach_long_sign;
+				half = (o1 >> 1) & ~arith_sign;
 				bit = o1 & 01;
 				/*	now o1 == 2 * half + bit
-					and half <= max_long
+					and half <= max_arith
-					and bit <= max_long
+					and bit <= max_arith
 				*/
 				hrem = half % o2;
 				rem = 2 * hrem + bit;
@@ -117,7 +123,7 @@ cstbin(expp, oper, expr)
 			break;
 		if (uns)	{
 			o1 >>= 1;
-			o1 &= ~mach_long_sign;
+			o1 &= ~arith_sign;
 			o1 >>= (o2-1);
 		}
 		else
@@ -133,9 +139,9 @@ cstbin(expp, oper, expr)
 		/* Fall through */
 	case '>':
 		if (uns)	{
-			o1 = (o1 & mach_long_sign ?
+			o1 = (o1 & arith_sign ?
-				(o2 & mach_long_sign ? o1 > o2 : 1) :
+				(o2 & arith_sign ? o1 > o2 : 1) :
-				(o2 & mach_long_sign ? 0 : o1 > o2)
+				(o2 & arith_sign ? 0 : o1 > o2)
 			);
 		}
 		else
@@ -151,9 +157,9 @@ cstbin(expp, oper, expr)
 		/* Fall through */
 	case GREATEREQ:
 		if (uns)	{
-			o1 = (o1 & mach_long_sign ?
+			o1 = (o1 & arith_sign ?
-				(o2 & mach_long_sign ? o1 >= o2 : 1) :
+				(o2 & arith_sign ? o1 >= o2 : 1) :
-				(o2 & mach_long_sign ? 0 : o1 >= o2)
+				(o2 & arith_sign ? 0 : o1 >= o2)
 			);
 		}
 		else
@@ -201,16 +207,18 @@ cut_size(expr)
 	}
 	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) (mach_long_size - size) * 8;
+		int nbits = (int) (arith_size - size) * 8;
-		long remainder = o1 & ~full_mask[size];
+		arith remainder = o1 & ~full_mask[size];
 
 		if (remainder != 0 && remainder != ~full_mask[size])
-			expr_warning(expr, "overflow in constant expression");
+		    if (!ResultKnown)
+			expr_warning(expr,"overflow in constant expression");
 		o1 <<= nbits;		/* ??? */
 		o1 >>= nbits;
 	}
@@ -228,10 +236,8 @@ init_cst()
 			fatal("array full_mask too small for this machine");
 		full_mask[i] = bt;
 	}
-	mach_long_size = i;
+	if ((int)long_size > arith_size)
-	mach_long_sign = 1L << (mach_long_size * 8 - 1);
+		fatal("sizeof (arith) insufficient on this machine");
-	if ((int)long_size < mach_long_size)
-		fatal("sizeof (long) insufficient on this machine");
 	max_int = full_mask[(int)int_size] & ~(1L << ((int)int_size * 8 - 1));
 	max_unsigned = full_mask[(int)int_size];
 }

lang/cem/cemcom.ansi/declar.g

@@ -10,6 +10,7 @@
 #include	<alloc.h>
 #include	"nobitfield.h"
 #include	"debug.h"
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"LLlex.h"
 #include	"label.h"
@@ -32,7 +33,7 @@
 #endif	LINT
 }
 
-/* 8 */
+/* 3.5 */
 declaration
 	{struct decspecs Ds;}
 :
@@ -49,12 +50,12 @@ declaration
 	empty case has already be dealt with in `external_definition'.
 	This means that something like:
 		unsigned extern int short xx;
-	is perfectly good C.
+	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 (see the thin ice in RM11.1).
+	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
@@ -86,7 +87,7 @@ decl_specifiers	/* non-empty */ (register struct decspecs *ds;)
 	{do_decspecs(ds);}
 ;
 
-/* 8.1 */
+/* 3.5.1 & 3.5.2 (partially) & 3.5.3 (partially) */
 other_specifier(register struct decspecs *ds;)
 :
 	[ AUTO | STATIC | EXTERN | TYPEDEF | REGISTER ]
@@ -125,7 +126,7 @@ other_specifier(register struct decspecs *ds;)
 	}
 ;
 
-/* 8.2 */
+/* 3.5.2 */
 type_specifier(struct type **tpp;)
 	/*	Used in struct/union declarations and in casts; only the
 		type is relevant.
@@ -161,7 +162,7 @@ single_type_specifier(register struct decspecs *ds;):
 	enum_specifier(&ds->ds_type)
 ;
 
-/* 8.3 */
+/* 3.5 */
 init_declarator_list(struct decspecs *ds;):
 	init_declarator(ds)
 	[ ',' init_declarator(ds) ]*
@@ -179,6 +180,7 @@ init_declarator(register struct decspecs *ds;)
 	declarator(&Dc)
 	{
 		reject_params(&Dc);
+		def_proto(&Dc);
 		declare_idf(ds, &Dc, level);
 #ifdef	LINT
 		lint_declare_idf(Dc.dc_idf, ds->ds_sc);
@@ -198,18 +200,26 @@ init_declarator(register struct decspecs *ds;)
 	}
 ;
 
-/* 8.6: initializer */
+/* 3.5.7: initializer */
 initializer(struct idf *idf; int sc;)
 	{
 		struct expr *expr = (struct expr *) 0;
-		int globalflag = level == L_GLOBAL ||
+		int fund = idf->id_def->df_type->tp_fund;
-				 (level >= L_LOCAL && sc == STATIC);
+		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)
+			warning("illegal initialization of formal parameter (ignored)");
 	}
 	'='
 	{
@@ -220,8 +230,12 @@ initializer(struct idf *idf; int sc;)
 			struct expr ex;
 			code_declaration(idf, &ex, level, sc);
 		}
+		else if (autoagg)
+			loc_init((struct expr *) 0, idf);
 	}
-	initial_value(globalflag ? &(idf->id_def->df_type) : (struct type **)0,
+	initial_value((globalflag || autoagg) ?
+				&(idf->id_def->df_type)
+				: (struct type **)0,
 			&expr)
 	{	if (! globalflag) {
 			if (idf->id_def->df_type->tp_fund == FUNCTION)	{
@@ -234,7 +248,9 @@ initializer(struct idf *idf; int sc;)
 #ifdef	LINT
 			change_state(idf, SET);
 #endif	LINT
-			code_declaration(idf, expr, level, sc);
+			if (autoagg)
+				loc_init((struct expr *) 0, idf);
+			else	code_declaration(idf, expr, level, sc);
 		}
 		init_idf(idf);
 	}
@@ -247,6 +263,7 @@ initializer(struct idf *idf; int sc;)
 	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;
@@ -303,7 +320,7 @@ arrayer(arith *sizep;)
 
 formal_list (struct formal **fmp;)
 :
-	formal(fmp) [ ',' formal(fmp) ]*
+	formal(fmp) [ %persistent ',' formal(fmp) ]*
 ;
 
 formal(struct formal **fmp;)
@@ -404,7 +421,14 @@ struct_or_union_specifier(register struct type **tpp;)
 				(idf->id_struct->tg_busy)--;
 			}
 		|
-			{apply_struct(fund, idf, tpp);}
+			{
+			  /* a ';' means an empty declaration (probably)
+			   * this means that we have to declare a new
+			   * structure. (yegh)
+			   */
+			  if (DOT == ';') declare_struct(fund, idf, tpp);
+			  else apply_struct(fund, idf, tpp);
+			}
 			empty
 		]
 	]
@@ -543,12 +567,13 @@ parameter_type_list(struct proto **plp;)
 		{	register struct proto *new = new_proto();
 
 			new->next = *plp;
-			new->pl_flag = ELLIPSIS;
+			new->pl_flag = PL_ELLIPSIS;
 			*plp = new;
 		}
 
 	]?
-	{	if (level == L_PROTO)
+	{	check_for_void(*plp);
+		if (level == L_PROTO)
 			level = save_level;
 		else level++;
 	}
@@ -558,6 +583,7 @@ parameter_decl_list(struct proto **plp;)
 :
 	parameter_decl(plp)
 	[ %while (AHEAD != ELLIPSIS)
+	  %persistent
 		',' parameter_decl(plp)
 	]*
 ;
@@ -615,11 +641,11 @@ parameter_declarator(register struct declarator *dc;)
 			parameter_type_list(&pl)
 		|
 			formal_list(&fm)
-		|
+		]?
-			empty
-		]
 		')'
-		{add_decl_unary(dc, FUNCTION, 0, (arith)0, fm, pl);}
+		{   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);}
@@ -631,7 +657,8 @@ parameter_declarator(register struct declarator *dc;)
 
 primary_parameter_declarator(register struct declarator *dc;)
 :
-[%if (AHEAD == ')' || first_of_parameter_type_list(AHEAD))
+[%if (AHEAD == ')' || first_of_parameter_type_list(AHEAD)
+				    && (AHEAD != IDENTIFIER))
 	empty
 |
 	identifier(&dc->dc_idf)
@@ -645,7 +672,6 @@ pointer(int *qual;)
 	'*' type_qualifier_list(qual)
 ;
 
-
 /*	Type qualifiers may come in three flavours:
 	volatile, const, const volatile.
 	These all have different semantic properties:
@@ -663,12 +689,12 @@ pointer(int *qual;)
 		prior knowledge of the implementation, but may
 		not be used as a l-value.
 */
+/* 3.5.4 */
 type_qualifier_list(int *qual;)
 :
 [
 	[ VOLATILE | CONST ]
 	{ *qual = (DOT == VOLATILE) ? TQ_VOLATILE : TQ_CONST; }
-
 	[
 		[ VOLATILE | CONST ]
 		{	if (DOT == VOLATILE) {
@@ -690,9 +716,5 @@ type_qualifier_list(int *qual;)
 ]
 ;
 
-
 empty:
 ;
-
-/* 8.8 */
-/* included in the IDENTIFIER/TYPE_IDENTIFIER mechanism */

lang/cem/cemcom.ansi/declarator.c

@@ -7,6 +7,7 @@
 
 #include	"botch_free.h"
 #include	<alloc.h>
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"type.h"
 #include	"proto.h"

lang/cem/cemcom.ansi/decspecs.c

@@ -5,7 +5,6 @@
 /* $Header$ */
 /*	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	"nofloat.h"
 #include	"assert.h"
 #include	"Lpars.h"
 #include	"decspecs.h"
@@ -13,7 +12,6 @@
 #include	"type.h"
 #include	"level.h"
 #include	"def.h"
-#include	"noRoption.h"
 
 extern char options[];
 extern int level;
@@ -70,7 +68,7 @@ do_decspecs(ds)
 		type and will have to be postponed to declare_idf.
 	*/
 
-	/* some adjustments as described in RM 8.2 */
+	/* some adjustments as described in 3.5.2. */
 	if (tp == 0) {
 		ds->ds_notypegiven = 1;
 		tp = int_type;
@@ -86,38 +84,24 @@ do_decspecs(ds)
 		if (tp == int_type)
 			tp = long_type;
 		else
-#ifndef NOFLOAT
 		if (tp == double_type)
 			tp = lngdbl_type;
 		else
-#endif NOFLOAT
 			error("long with illegal type");
 		break;
 	}
 	if (ds->ds_unsigned == UNSIGNED) {
 		switch (tp->tp_fund)	{
 		case CHAR:
-#ifndef NOROPTION
-			if (options['R'])
-				warning("unsigned char not allowed");
-#endif
 			tp = uchar_type;
 			break;
 		case SHORT:
-#ifndef NOROPTION
-			if (options['R'])
-				warning("unsigned short not allowed");
-#endif
 			tp = ushort_type;
 			break;
 		case INT:
 			tp = uint_type;
 			break;
 		case LONG:
-#ifndef NOROPTION
-			if (options['R'])
-				warning("unsigned long not allowed");
-#endif
 			tp = ulong_type;
 			break;
 		default:
@@ -128,7 +112,7 @@ do_decspecs(ds)
 	if (ds->ds_unsigned == SIGNED) {
 		switch (tp->tp_fund) {
 		case CHAR:
-			tp = char_type;
+			tp = schar_type;
 			break;
 		case SHORT:
 			tp = short_type;
@@ -172,8 +156,13 @@ qualifier_type(tp, typequal)
 		dtp->tp_typequal = typequal;
 		dtp->tp_size = tp->tp_size;
 		switch (fund) {
-		case POINTER:
 		case ARRAY:
+			if (typequal) {
+			    tp->tp_up = qualifier_type(tp->tp_up, typequal);
+			    dtp->tp_typequal = typequal = 0;
+			}
+			/* fallthrough */
+		case POINTER:
 		case FUNCTION:
 		case STRUCT:
 		case UNION:

lang/cem/cemcom.ansi/domacro.c

@@ -34,20 +34,28 @@ char ifstack[IFDEPTH];	/* if-stack: the content of an entry is	*/
 int	nestlevel = -1;
 
 struct idf *
-GetIdentifier()
+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. A null-pointer is returned if
+		read from the input stream. When the input doe not contain
-		the input does not contain an identifier.
+		an identifier, the rest of the line is skipped and a
+		null-pointer is returned.
 		The substitution of macros is disabled.
 	*/
+	int tmp = UnknownIdIsZero;
 	int tok;
 	struct token tk;
 
-	ReplaceMacros = 0;
+	UnknownIdIsZero = ReplaceMacros = 0;
 	tok = GetToken(&tk);
 	ReplaceMacros = 1;
-	return tok == IDENTIFIER ? tk.tk_idf : (struct idf *)0;
+	UnknownIdIsZero = tmp;
+	if (tok != IDENTIFIER) {
+		if (skiponerr && tok != EOI) SkipToNewLine(0);
+		return (struct idf *)0;
+	}
+	return tk.tk_idf;
 }
 
 /*	domacro() is the control line interpreter. The '#' has already
@@ -61,9 +69,13 @@ GetIdentifier()
 domacro()
 {
 	struct token tk;	/* the token itself			*/
+	int toknum;
 
 	EoiForNewline = 1;
-	switch(GetToken(&tk)) {		/* select control line action	*/
+	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"	*/
@@ -95,7 +107,7 @@ domacro()
 				the arguments.
 			*/
 			if (GetToken(&tk) != INTEGER) {
-				lexerror("#line without linenumber");
+				error("bad #line syntax");
 				SkipToNewLine(0);
 			}
 			else
@@ -128,8 +140,8 @@ domacro()
 	EoiForNewline = 0;
 }
 
-
+skip_block(to_endif)
-skip_block()
+int to_endif;
 {
 	/*	skip_block() skips the input from
 		1)	a false #if, #ifdef, #ifndef or #elif until the
@@ -142,6 +154,7 @@ skip_block()
 	register int ch;
 	register int skiplevel = nestlevel; /* current nesting level	*/
 	struct token tk;
+	int toknum;
 
 	NoUnstack++;
 	for (;;) {
@@ -153,10 +166,14 @@ skip_block()
 				NoUnstack--;
 				return;
 			}
+			UnGetChar();
 			SkipToNewLine(0);
 			continue;
 		}
-		if (GetToken(&tk) != IDENTIFIER) {
+		ReplaceMacros = 0;
+		toknum = GetToken(&tk);
+		ReplaceMacros = 1;
+		if (toknum != IDENTIFIER) {
 			SkipToNewLine(0);
 			continue;
 		}
@@ -166,13 +183,19 @@ skip_block()
 			on the same level.
 		*/
 		switch(tk.tk_idf->id_resmac) {
+		default:
+			SkipToNewLine(0);
+			break;
 		case K_IF:
 		case K_IFDEF:
 		case K_IFNDEF:
 			push_if();
+			SkipToNewLine(0);
 			break;
 		case K_ELIF:
-			if (nestlevel == skiplevel) {
+			if (ifstack[nestlevel])
+				lexerror("#elif after #else");
+			if (!to_endif && nestlevel == skiplevel) {
 				nestlevel--;
 				push_if();
 				if (ifexpr()) {
@@ -180,15 +203,19 @@ skip_block()
 					return;
 				}
 			}
+			else SkipToNewLine(0);	/* otherwise done in ifexpr() */
 			break;
 		case K_ELSE:
+			if (ifstack[nestlevel])
+				lexerror("#else after #else");
 			++(ifstack[nestlevel]);
-			if (nestlevel == skiplevel) {
+			if (!to_endif && nestlevel == skiplevel) {
 				if (SkipToNewLine(1))
-					strict("garbage following #endif");
+					strict("garbage following #else");
 				NoUnstack--;
 				return;
 			}
+			else SkipToNewLine(0);
 			break;
 		case K_ENDIF:
 			ASSERT(nestlevel > nestlow);
@@ -199,6 +226,7 @@ skip_block()
 				NoUnstack--;
 				return;
 			}
+			else SkipToNewLine(0);
 			nestlevel--;
 			break;
 		}
@@ -241,7 +269,7 @@ do_include()
 	if (((tok = GetToken(&tk)) == FILESPECIFIER) || tok == STRING)
 		filenm = tk.tk_bts;
 	else {
-		lexerror("bad include syntax");
+		error("bad include syntax");
 		filenm = (char *)0;
 	}
 	AccFileSpecifier = 0;
@@ -249,7 +277,7 @@ do_include()
 	inctable[0] = WorkingDir;
 	if (filenm) {
 		if (!InsertFile(filenm, &inctable[tok==FILESPECIFIER],&result)){
-			fatal("cannot open include file \"%s\"", filenm);
+			error("cannot open include file \"%s\"", filenm);
 		}
 		else {
 			WorkingDir = getwdir(result);
@@ -275,9 +303,8 @@ do_define()
 	char *get_text();
 
 	/* read the #defined macro's name	*/
-	if (!(id = GetIdentifier())) {
+	if (!(id = GetIdentifier(1))) {
-		lexerror("#define: illegal macro name");
+		lexerror("illegal #define line");
-		SkipToNewLine(0);
 		return;
 	}
 	/*	there is a formal parameter list if the identifier is
@@ -297,7 +324,8 @@ do_define()
 	if (class(ch) == STNL) {
 		/*	Treat `#define something' as `#define something ""'
 		*/
-		repl_text = "";
+		repl_text = Malloc(1);
+		*repl_text = '\0';
 		length = 0;
 	}
 	else {
@@ -318,35 +346,38 @@ push_if()
 
 do_elif()
 {
-	if (nestlevel <= nestlow || (ifstack[nestlevel])) {
+	if (nestlevel <= nestlow) {
 		lexerror("#elif without corresponding #if");
 		SkipToNewLine(0);
 	}
-	else { /* restart at this level as if a #if is detected.  */
+	else {		/* restart at this level as if a #if is detected.  */
+		if (ifstack[nestlevel]) {
+			lexerror("#elif after #else");
+			SkipToNewLine(0);
+		}
 		nestlevel--;
 		push_if();
-		skip_block();
+		skip_block(1);
 	}
 }
 
 do_else()
 {
-	struct token tok;
-
 	if (SkipToNewLine(1))
 		strict("garbage following #else");
-	if (nestlevel <= nestlow || (ifstack[nestlevel]))
+	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();
+		skip_block(1);
 	}
 }
 
 do_endif()
 {
-	struct token tok;
-
 	if (SkipToNewLine(1))
 		strict("garbage following #endif");
 	if (nestlevel <= nestlow)	{
@@ -359,7 +390,7 @@ do_if()
 {
 	push_if();
 	if (!ifexpr())	/* a false #if/#elif expression */
-		skip_block();
+		skip_block(0);
 }
 
 do_ifdef(how)
@@ -369,15 +400,15 @@ do_ifdef(how)
 	/*	how == 1 : ifdef; how == 0 : ifndef
 	*/
 	push_if();
-	if (!(id = GetIdentifier()))
+	if (!(id = GetIdentifier(1)))
 		lexerror("illegal #ifdef construction");
 
 	/* The next test is a shorthand for:
 		(how && !id->id_macro) || (!how && id->id_macro)
 	*/
 	if (how ^ (id && id->id_macro != 0))
-		skip_block();
+		skip_block(0);
-	else
+	else if (id)
 		SkipToNewLine(0);
 }
 
@@ -386,15 +417,20 @@ do_undef()
 	register struct idf *id;
 
 	/* Forget a macro definition.	*/
-	if (id = GetIdentifier()) {
+	if (id = GetIdentifier(1)) {
 		if (id->id_macro) { /* forget the macro */
-			free_macro(id->id_macro);
+			if (id->id_macro->mc_flag & NOUNDEF) {
-			id->id_macro = (struct macro *) 0;
+				lexerror("it is not allowed to undef %s", id->id_text);
+			} else {
+				free(id->id_text);
+				free_macro(id->id_macro);
+				id->id_macro = (struct macro *) 0;
+			}
 		} /* else: don't complain */
+		SkipToNewLine(0);
 	}
 	else
 		lexerror("illegal #undef construction");
-	SkipToNewLine(0);
 }
 
 do_error()
@@ -488,15 +524,17 @@ macro_def(id, text, nformals, length, flags)
 	/*	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.
-		A warning is given if the definition overwrites another.
+		An error is given if there was already a definition
 	*/
 	if (newdef) {		/* is there a redefinition?	*/
-		if (macroeq(newdef->mc_text, text))
+		if (newdef->mc_flag & NOUNDEF) {
-			return;
+			lexerror("it is not allowed to redefine %s", id->id_text);
-		lexwarning("redefine \"%s\"", id->id_text);
+		} else if (!macroeq(newdef->mc_text, text))
+			lexerror("illegal redefine of \"%s\"", id->id_text);
+		free(text);
+		return;
 	}
-	else
+	id->id_macro = newdef = new_macro();
-		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	*/
@@ -553,14 +591,14 @@ get_text(formals, length)
 			register int delim = c;
 
 			do {
-				/* being careful, as ever */
+			    /* being careful, as ever */
-				if (pos+3 >= text_size)
+			    if (pos+3 >= text_size)
-					text = Srealloc(text,
+				text = Srealloc(text,
-							text_size += RTEXTSIZE);
+					(unsigned) (text_size += RTEXTSIZE));
-				text[pos++] = c;
+			    text[pos++] = c;
-				if (c == '\\')
+			    if (c == '\\')
-					text[pos++] = GetChar();
+				    text[pos++] = GetChar();
-				c = GetChar();
+			    c = GetChar();
 			} while (c != delim && c != EOI && class(c) != STNL);
 			text[pos++] = c;
 			c = GetChar();
@@ -569,7 +607,8 @@ get_text(formals, length)
 		if (c == '/') {
 			c = GetChar();
 			if (pos+1 >= text_size)
-				text = Srealloc(text, text_size += RTEXTSIZE);
+				text = Srealloc(text,
+					(unsigned) (text_size += RTEXTSIZE));
 			if (c == '*') {
 				skipcomment();
 				text[pos++] = ' ';
@@ -593,25 +632,27 @@ get_text(formals, length)
 			} while (in_idf(c));
 			id_buf[--id_size] = '\0';
 			if (n = find_name(id_buf, formals)) {
-				/* construct the formal parameter mark	*/
+			    /* construct the formal parameter mark	*/
-				if (pos+1 >= text_size)
+			    if (pos+1 >= text_size)
-					text = Srealloc(text,
+				text = Srealloc(text,
-						text_size += RTEXTSIZE);
+					(unsigned) (text_size += RTEXTSIZE));
-				text[pos++] = FORMALP | (char) n;
+			    text[pos++] = FORMALP | (char) n;
 			}
 			else {
-				register char *ptr = &id_buf[0];
+			    register char *ptr = &id_buf[0];
 
-				while (pos + id_size >= text_size)
+			    while (pos + id_size >= text_size)
-					text = Srealloc(text,
+				text = Srealloc(text,
-						text_size += RTEXTSIZE);
+					(unsigned) (text_size += RTEXTSIZE));
-				while (text[pos++] = *ptr++) ;
+			    while (text[pos++] = *ptr++)
-				pos--;
+				/* EMPTY */ ;
+			    pos--;
 			}
 		}
 		else {
 			if (pos+1 >= text_size)
-				text = Srealloc(text, text_size += RTEXTSIZE);
+				text = Srealloc(text,
+					(unsigned) (text_size += RTEXTSIZE));
 			text[pos++] = c;
 			c = GetChar();
 		}

lang/cem/cemcom.ansi/dumpidf.c

@@ -8,9 +8,10 @@
 #include	"debug.h"
 
 #ifdef	DEBUG
-#include	"nofloat.h"
+#include	<alloc.h>
 #include	"nopp.h"
 #include	"nobitfield.h"
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"stack.h"
 #include	"idf.h"
@@ -252,8 +253,8 @@ dump_proto(pl)
 	newline();
 	while (pl) {
 		print("%d: %s", argcnt++,
-			pl->pl_flag == FORMAL ?
+			pl->pl_flag & PL_FORMAL ?
-			(pl->pl_flag == VOID ? "void" : "formal")
+			(pl->pl_flag & PL_VOID ? "void" : "formal")
 			: "ellipsis");
 		newline();
 		if (type = pl->pl_type){
@@ -442,9 +443,7 @@ p1_expr(lvl, expr)
 		expr->ex_depth,
 		expr->ex_class == Value ? "Value" :
 		expr->ex_class == String ? "String" :
-#ifndef NOFLOAT
 		expr->ex_class == Float ? "Float" :
-#endif NOFLOAT
 		expr->ex_class == Oper ? "Oper" :
 		expr->ex_class == Type ? "Type" : "UNKNOWN CLASS"
 	);
@@ -479,11 +478,13 @@ p1_expr(lvl, expr)
 		);
 		break;
 	}
-#ifndef NOFLOAT
 	case Float:
+		if (!expr->FL_VALUE) {
+			expr->FL_VALUE = Malloc(FLT_STRLEN);
+			flt_flt2str(&(expr->FL_ARITH), expr->FL_VALUE, FLT_STRLEN);
+		}
 		print("%s\n", expr->FL_VALUE);
 		break;
-#endif NOFLOAT
 	case Oper:
 		o = &expr->ex_object.ex_oper;
 		print("\n");

lang/cem/cemcom.ansi/error.c

@@ -15,6 +15,7 @@
 #include	"debug.h"
 
 #include	"tokenname.h"
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"label.h"
 #include	"expr.h"
@@ -32,6 +33,7 @@
 #define	ERROR		3
 #define	CRASH		4
 #define	FATAL		5
+#define DO_DEBUG	6
 
 int err_occurred = 0;
 
@@ -93,11 +95,28 @@ strict(va_alist)
 
 	va_start(ap);
 	{
-		_error(STRICT, FileName, LineNumber, ap);
+		_error(STRICT, dot.tk_file, dot.tk_line, ap);
 	}
 	va_end(ap);
 }
 
+#ifdef DEBUG
+/*VARARGS*/
+debug(va_alist)
+	va_dcl
+{
+	va_list ap;
+
+	va_start(ap);
+	{
+		_error(DO_DEBUG, dot.tk_file, dot.tk_line, ap);
+		/* _error(DO_DEBUG, NILEXPR, ap);
+		*/
+	}
+	va_end(ap);
+}
+#endif DEBUG
+
 /*VARARGS*/
 warning(va_alist)
 	va_dcl
@@ -106,7 +125,9 @@ warning(va_alist)
 
 	va_start(ap);
 	{
-		_error(WARNING, NILEXPR, ap);
+		_error(WARNING, dot.tk_file, dot.tk_line, ap);
+		/* _error(WARNING, NILEXPR, ap);
+		*/
 	}
 	va_end(ap);
 }
@@ -310,12 +331,18 @@ _error(class, fn, ln, ap)
 	case FATAL:
 		remark = "fatal error --";
 		break;
+#ifdef DEBUG
+	case DO_DEBUG:
+		remark = "(debug)";
+		break;
+#endif DEBUG
 	default:
 		/*NOTREACHED*/;
 	}
 	
 #ifndef	LINT
-	if (ln == last_ln && fn && last_fn && strcmp(fn, last_fn) == 0)	{
+	if (class != DO_DEBUG)	/* ??? DEBUG */
+	    if (ln == last_ln && fn && last_fn && strcmp(fn, last_fn) == 0) {
 		/* we've seen this place before */
 		e_seen++;
 		if (e_seen == MAXERR_LINE)

lang/cem/cemcom.ansi/eval.c

@@ -8,12 +8,13 @@
 #include	"lint.h"
 #ifndef	LINT
 
-#include	"nofloat.h"
 #include	<em.h>
 #include	<em_reg.h>
+#include	<alloc.h>
 #include	"debug.h"
 #include	"nobitfield.h"
 #include	"dataflow.h"
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"type.h"
 #include	"idf.h"
@@ -69,7 +70,7 @@ EVAL(expr, val, code, true_label, false_label)
 	int val, code;
 	label true_label, false_label;
 {
-	register int gencode = (code == TRUE);
+	register int gencode = (code == TRUE && expr->ex_type->tp_size > 0);
 
 	switch (expr->ex_class) {
 	case Value:	/* just a simple value	*/
@@ -82,18 +83,20 @@ EVAL(expr, val, code, true_label, false_label)
 			C_lae_dlb(expr->VL_LBL, expr->VL_VALUE);
 		}
 		break;
-#ifndef NOFLOAT
 	case Float:	/* a floating constant	*/
 		if (gencode) {
 			label datlab = data_label();
 			
+			if (!expr->FL_VALUE) {
+				expr->FL_VALUE = Malloc(FLT_STRLEN);
+				flt_flt2str(&(expr->FL_ARITH), expr->FL_VALUE, FLT_STRLEN);
+			}
 			C_df_dlb(datlab);
 			C_rom_fcon(expr->FL_VALUE, expr->ex_type->tp_size);
 			C_lae_dlb(datlab, (arith)0);
 			C_loi(expr->ex_type->tp_size);
 		}
 		break;
-#endif NOFLOAT
 	case Oper:	/* compound expression	*/
 	{
 		int oper = expr->OP_OPER;
@@ -107,6 +110,7 @@ EVAL(expr, val, code, true_label, false_label)
 		}
 		if (tp->tp_fund == VOID)
 			gencode = 0;
+
 		switch (oper) {
 		case '+':
 			/*	We have the following possibilities :
@@ -130,13 +134,11 @@ EVAL(expr, val, code, true_label, false_label)
 					C_cuu();
 					C_ads(pointer_size);
 					break;
-#ifndef NOFLOAT
 				case FLOAT:
 				case DOUBLE:
 				case LNGDBL:
 					C_adf(tp->tp_size);
 					break;
-#endif NOFLOAT
 				default:
 					crash("bad type +");
 				}
@@ -152,13 +154,11 @@ EVAL(expr, val, code, true_label, false_label)
 					case POINTER:
 						C_ngi(tp->tp_size);
 						break;
-#ifndef NOFLOAT
 					case FLOAT:
 					case DOUBLE:
 					case LNGDBL:
 						C_ngf(tp->tp_size);
 						break;
-#endif NOFLOAT
 					default:
 						CRASH();
 					}
@@ -192,13 +192,11 @@ EVAL(expr, val, code, true_label, false_label)
 					C_ads(pointer_size);
 				}
 				break;
-#ifndef NOFLOAT
 			case FLOAT:
 			case DOUBLE:
 			case LNGDBL:
 				C_sbf(tp->tp_size);
 				break;
-#endif NOFLOAT
 			default:
 				crash("bad type -");
 			}
@@ -223,14 +221,12 @@ EVAL(expr, val, code, true_label, false_label)
 						else
 							C_mli(tp->tp_size);
 						break;
-#ifndef NOFLOAT
 					case FLOAT:
 					case DOUBLE:
 					case LNGDBL:
 						/*C_mlf(double_size);*/
 						C_mlf(tp->tp_size);
 						break;
-#endif NOFLOAT
 					default:
 						crash("bad type *");
 					}
@@ -249,14 +245,12 @@ EVAL(expr, val, code, true_label, false_label)
 					else
 						C_dvi(tp->tp_size);
 					break;
-#ifndef NOFLOAT
 				case FLOAT:
 				case DOUBLE:
 				case LNGDBL:
 					/*C_dvf(double_size);*/
 					C_dvf(tp->tp_size);
 					break;
-#endif NOFLOAT
 				default:
 					crash("bad type /");
 				}
@@ -309,13 +303,11 @@ EVAL(expr, val, code, true_label, false_label)
 					else
 						C_cmi(size);
 					break;
-#ifndef NOFLOAT
 				case FLOAT:
 				case DOUBLE:
 				case LNGDBL:
 					C_cmf(size);
 					break;
-#endif NOFLOAT
 				case POINTER:
 					C_cmp();
 					break;
@@ -543,10 +535,6 @@ EVAL(expr, val, code, true_label, false_label)
 			ASSERT(is_cp_cst(right));
 			if (gencode) {
 				C_adp(right->VL_VALUE);
-				if (val == RVAL && expr->ex_lvalue == 0) {
-					load_block(expr->ex_type->tp_size,
-						expr->ex_type->tp_align);
-				}
 			}
 			break;
 		case ARROW:
@@ -624,11 +612,9 @@ EVAL(expr, val, code, true_label, false_label)
 								true_label);
 			break;
 		case INT2INT:
-#ifndef NOFLOAT
 		case INT2FLOAT:
 		case FLOAT2INT:
 		case FLOAT2FLOAT:
-#endif NOFLOAT
 			EVAL(right, RVAL, gencode, NO_LABEL, NO_LABEL);
 			if (gencode)
 				conversion(right->ex_type, left->ex_type);
@@ -640,9 +626,10 @@ EVAL(expr, val, code, true_label, false_label)
 			only its lvalue is evaluated, its rvalue is
 			loaded by the following statements:
 		*/
-		if (gencode && val == RVAL && expr->ex_lvalue == 1)
+		if (gencode && val == RVAL && expr->ex_lvalue == 1) {
 			load_block(expr->ex_type->tp_size,
 				expr->ex_type->tp_align);
+		}
 		break;
 	}
 	default:
@@ -782,13 +769,12 @@ assop(type, oper)
 			break;
 		}
 		break;
-#ifndef NOFLOAT
 	case FLOAT:
 	case DOUBLE:
 	case LNGDBL:
 		switch (oper) {
 		case PLUSAB:
-		case PLUSPLUS:
+		case PLUSPLUS:			/* ??? etc... */
 		case POSTINCR:
 			C_adf(size);
 			break;
@@ -805,7 +791,6 @@ assop(type, oper)
 			break;
 		}
 		break;
-#endif NOFLOAT
 	case POINTER:
 		if (oper == MINAB || oper == MINMIN || oper == POSTDECR)
 			C_ngi(size);
@@ -851,7 +836,11 @@ store_val(vl, tp)
 		register struct idf *id = vl->vl_data.vl_idf;
 		register struct def *df = id->id_def;
 
-		if (df->df_level == L_GLOBAL) {
+		/* if (df->df_level == L_GLOBAL) { /* } ??? re-examine */
+		if (df->df_sc == GLOBAL
+		    || df->df_sc == EXTERN
+		    || df->df_sc == STATIC
+		    || df->df_sc == IMPLICIT) {
 			if (inword)
 				C_ste_dnam(id->id_text, val);
 			else
@@ -956,7 +945,11 @@ load_val(expr, rlval)
 			C_lpi(id->id_text);
 		}
 		else
-		if (df->df_level == L_GLOBAL) {
+		/* if (df->df_level == L_GLOBAL) { /* } ??? re-examine */
+		if ( df->df_sc == GLOBAL
+		    || df->df_sc == STATIC
+		    || df->df_sc == EXTERN
+		    || df->df_sc == IMPLICIT) {
 			if (rvalue) {
 				if (inword)
 					C_loe_dnam(id->id_text, val);
@@ -974,7 +967,7 @@ load_val(expr, rlval)
 			}
 		}
 		else {
-			ASSERT(df->df_sc != STATIC);
+			/* ASSERT(df->df_sc != STATIC); */
 			if (rvalue) {
 				if (inword || indword)
 					LoadLocal(df->df_address + val, size);

lang/cem/cemcom.ansi/expr.c

@@ -6,10 +6,11 @@
 /* EXPRESSION TREE HANDLING */
 
 #include	"lint.h"
-#include	"nofloat.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"
@@ -21,10 +22,10 @@
 #include	"declar.h"
 #include	"sizes.h"
 #include	"level.h"
-#include	"noRoption.h"
 
 extern char *symbol2str();
 extern char options[];
+extern int InSizeof;
 
 int
 rank_of(oper)
@@ -96,7 +97,6 @@ rank_of(oper)
 	/*NOTREACHED*/
 }
 
-#ifndef NOROPTION
 int
 rank_of_expression(ex)
 	register struct expr *ex;
@@ -112,15 +112,14 @@ check_conditional(expr, oper, pos_descr)
 	register struct expr *expr;
 	char *pos_descr;
 {
-	/*	Warn if restricted C is in effect and the expression expr,
+	/*	Since the grammar is LR and the parser is LL, this kludge
-		which occurs at the position pos_descr, is not lighter than
+		here checks if there was a syntax error caused by
-		the operator oper.
+		the priorities in an expression.
 	*/
-	if (options['R'] && rank_of_expression(expr) >= rank_of(oper))
+	if (rank_of_expression(expr) >= rank_of(oper))
-		expr_warning(expr, "%s %s is ungrammatical",
+		expr_error(expr, "%s %s",
 			symbol2str(expr->OP_OPER), pos_descr);
 }
-#endif
 
 dot2expr(expp)
 	struct expr **expp;
@@ -140,11 +139,9 @@ dot2expr(expp)
 	case INTEGER:
 		int2expr(ex);
 		break;
-#ifndef NOFLOAT
 	case FLOATING:
 		float2expr(ex);
 		break;
-#endif NOFLOAT
 	default:
 		crash("bad conversion to expression");
 		/*NOTREACHED*/
@@ -163,9 +160,12 @@ idf2expr(expr)
 	register struct def *def = idf->id_def;
 	
 	if (def == 0)	{
-		if (AHEAD == '(') /* function call, declare name IMPLICITly */
+		if (AHEAD == '(') {
-			add_def(idf, IMPLICIT, funint_type, level); /* RM 13 */
+			/* function call, declare name IMPLICITly (3.3.2.2) */
-		else	{
+			warning("implicit declaration of function %s"
+				, idf->id_text);
+			add_def(idf, IMPLICIT, funint_type, level);
+		} else	{
 			if (!is_anon_idf(idf))
 				error("%s undefined", idf->id_text);
 			/* declare idf anyway */
@@ -180,11 +180,13 @@ idf2expr(expr)
 	}
 	else {
 #ifndef	LINT
-		def->df_used = 1;
+		if (!InSizeof)
+			def->df_used = 1;
 #endif	LINT
 		expr->ex_type = def->df_type;
-		if (expr->ex_type == error_type)
+		if (expr->ex_type == error_type) {
 			expr->ex_flags |= EX_ERROR;
+		}
 	}
 	expr->ex_lvalue =
 		(	def->df_type->tp_fund == FUNCTION ||
@@ -215,9 +217,9 @@ idf2expr(expr)
 	}
 }
 
-string2expr(expp, typ, str, len)
+string2expr(expp, str, len)
 	register struct expr **expp;
-	int typ, len;
+	int len;
 	char *str;
 {
 	/*	The string in the argument is converted into an expression,
@@ -229,9 +231,7 @@ string2expr(expp, typ, str, len)
 	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_type = qualifier_type(ex->ex_type, TQ_CONST);
-*/
 	ex->ex_flags |= EX_READONLY;
 	ex->ex_lvalue = 0;
 	ex->ex_class = String;
@@ -249,7 +249,6 @@ int2expr(expr)
 	fill_int_expr(expr, dot.tk_ival, dot.tk_fund);
 }
 
-#ifndef NOFLOAT
 float2expr(expr)
 	register struct expr *expr;
 {
@@ -274,9 +273,12 @@ float2expr(expr)
 	}
 	expr->ex_class = Float;
 	expr->FL_VALUE = dot.tk_fval;
+	flt_str2flt(expr->FL_VALUE, &(expr->FL_ARITH));
+	ASSERT(flt_status != FLT_NOFLT);
+	if (flt_status == FLT_OVFL)
+		expr_warning(expr,"internal floating point overflow");
 	expr->FL_DATLAB = 0;
 }
-#endif NOFLOAT
 
 struct expr*
 intexpr(ivalue, fund)
@@ -287,7 +289,7 @@ intexpr(ivalue, fund)
 		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);
@@ -324,8 +326,8 @@ fill_int_expr(ex, ivalue, fund)
 		/*	We cannot make a test like
 				ivalue <= max_unsigned
 			because, if
-				sizeof(long) == int_size
+				sizeof(arith) == int_size
-			holds, max_unsigned may be a negative long in
+			holds, max_unsigned may be a negative arith in
 			which case the comparison results in an unexpected
 			answer.
 		*/
@@ -392,7 +394,8 @@ new_oper(tp, e1, oper, e2)
 		
 		expr->ex_depth =
 			(e1_depth > e2->ex_depth ? e1_depth : e2->ex_depth) + 1;
-		expr->ex_flags = (e1_flags | e2->ex_flags) & ~EX_PARENS;
+		expr->ex_flags = (e1_flags | e2->ex_flags)
+			& ~(EX_PARENS | EX_READONLY /* ??? | EX_VOLATILE */ );
 	}
 	op = &expr->ex_object.ex_oper;
 	op->op_type = tp;
@@ -425,43 +428,24 @@ chk_cst_expr(expp)
 		the others in the various C compilers.  I have tried some
 		hypotheses to unify them, but all have failed.
 		
-		This routine will give a warning for those operators
-		not allowed by K&R, under the R-option only.  The anomalies
-		are cast, logical operators and the expression comma.
 		Special problems (of which there is only one, sizeof in
 		Preprocessor #if) have to be dealt with locally
-		
-		Note that according to K&R the negation ! is illegal in
-		constant expressions and is indeed rejected by the
-		Ritchie compiler.
 	*/
 	register struct expr *expr = *expp;
 	register int fund = expr->ex_type->tp_fund;
-	register int flags = expr->ex_flags;
 	int err = 0;
 	
 #ifdef	DEBUG
 	print_expr("constant_expression", expr);
 #endif	DEBUG
-	if (	fund != CHAR && fund != SHORT && fund != INT &&
+	if ( fund != CHAR && fund != SHORT && fund != INT
-		fund != ENUM && fund != LONG
+	    && fund != ENUM && fund != LONG) {
-	)
+		expr_error(expr, "non-numerical constant expression");
-		expr_error(expr, "non-numerical constant expression"), err++;
+		err++;
-	else
+	} else if (!is_ld_cst(expr)) {
-	if (!is_ld_cst(expr))
+		expr_error(expr, "expression is not constant");
-		expr_error(expr, "expression is not constant"), err++;
+		err++;
-#ifndef NOROPTION
-	if (options['R'])	{
-		if (flags & EX_CAST)
-			expr_warning(expr, "cast in constant expression");
-		if (flags & EX_LOGICAL)
-			expr_warning(expr,
-				"logical operator in constant expression");
-		if (flags & EX_COMMA)
-			expr_warning(expr,
-				"expression comma in constant expression");
 	}
-#endif NOROPTION
 	if (err)
 		erroneous2int(expp);
 }
@@ -501,7 +485,7 @@ is_ld_cst(expr)
 
 int
 is_cp_cst(expr)
-	register struct expr *expr;
+	struct expr *expr;
 {
 	/*	An expression is a `compile-time constant' if it is a
 		load-time constant, and the idf is not there.
@@ -509,17 +493,31 @@ is_cp_cst(expr)
 	return is_ld_cst(expr) && expr->VL_CLASS == Const;
 }
 
-#ifndef NOFLOAT
 int
 is_fp_cst(expr)
-	register struct expr *expr;
+	struct expr *expr;
 {
 	/*	An expression is a `floating-point constant' if it consists
 		of the float only.
 	*/
 	return expr->ex_class == Float;
 }
-#endif NOFLOAT
+
+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);
+		return flt_cmp(&var, &(expr->FL_ARITH)) == 0;
+	}
+	/*NOTREACHED*/
+}
 
 free_expression(expr)
 	register struct expr *expr;
@@ -527,6 +525,8 @@ free_expression(expr)
 	/*	The expression expr is freed recursively.
 	*/
 	if (expr) {
+		if (expr->ex_class == Float && expr->FL_VALUE)
+			free(expr->FL_VALUE);
 		if (expr->ex_class == Oper)	{
 			free_expression(expr->OP_LEFT);
 			free_expression(expr->OP_RIGHT);

lang/cem/cemcom.ansi/expr.str

@@ -9,8 +9,6 @@
 	a union of various goodies, we define them first; so be patient.
 */
 
-#include	"nofloat.h"
-
 /* classes of value */
 #define Const	1
 #define Name	2
@@ -31,12 +29,11 @@ struct string	{
 	label sg_datlab;	/* global data-label			*/
 };
 
-#ifndef NOFLOAT
 struct floating	{
 	char *fl_value;		/* pointer to string repr. the fp const. */
+	flt_arith fl_arith;	/* the value in high precision */
 	label fl_datlab;	/* global data_label	*/
 };
-#endif NOFLOAT
 
 struct oper	{
 	struct type *op_type;	/* resulting type of the operation	*/
@@ -48,9 +45,7 @@ struct oper	{
 /* 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  */
-#ifndef NOFLOAT
 #define	Float	2		/* it is a floating point constant	*/
-#endif NOFLOAT
 #define	Oper	3		/* it is a run-time expression */
 #define	Type	4		/* only its type is relevant */
 
@@ -66,9 +61,7 @@ struct expr	{
 	union	{
 		struct value ex_value;
 		struct string ex_string;
-#ifndef NOFLOAT
 		struct floating ex_float;
-#endif NOFLOAT
 		struct oper ex_oper;
 	} ex_object;
 };
@@ -82,10 +75,9 @@ struct expr	{
 #define	SG_VALUE	ex_object.ex_string.sg_value
 #define SG_LEN		ex_object.ex_string.sg_len
 #define	SG_DATLAB	ex_object.ex_string.sg_datlab
-#ifndef NOFLOAT
 #define	FL_VALUE	ex_object.ex_float.fl_value
+#define	FL_ARITH	ex_object.ex_float.fl_arith
 #define	FL_DATLAB	ex_object.ex_float.fl_datlab
-#endif NOFLOAT
 #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
@@ -94,15 +86,16 @@ struct expr	{
 /*	some bits for the ex_flag field, to keep track of various
 	interesting properties of an expression.
 */
-#define	EX_SIZEOF	0001		/* contains sizeof operator */
+#define	EX_SIZEOF	0x001		/* contains sizeof operator */
-#define	EX_CAST		0002		/* contains cast */
+#define	EX_CAST		0x002		/* contains cast */
-#define	EX_LOGICAL	0004		/* contains logical operator */
+#define	EX_LOGICAL	0x004		/* contains logical operator */
-#define	EX_COMMA	0010		/* contains expression comma */
+#define	EX_COMMA	0x008		/* contains expression comma */
-#define	EX_PARENS	0020		/* the top level is parenthesized */
+#define	EX_PARENS	0x010		/* the top level is parenthesized */
-#define EX_SIDEEFFECTS	0040		/* expression has side effects */
+#define EX_SIDEEFFECTS	0x020		/* expression has side effects */
-#define	EX_READONLY	0100		/* read only variabele */
+#define	EX_READONLY	0x040		/* read only variabele */
-#define	EX_VOLATILE	0200		/* volatile variabele */
+#define	EX_VOLATILE	0x080		/* volatile variabele */
-#define	EX_ERROR	0400		/* the expression is wrong */
+#define	EX_ILVALUE	0x100		/* an illegal lvalue e.g. f().x */
+#define	EX_ERROR	0x200		/* the expression is wrong */
 
 #define	NILEXPR		((struct expr *)0)
 

lang/cem/cemcom.ansi/expression.g

@@ -8,6 +8,7 @@
 {
 #include	<alloc.h>
 #include	"lint.h"
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"LLlex.h"
 #include	"type.h"
@@ -15,12 +16,19 @@
 #include	"label.h"
 #include	"expr.h"
 #include	"code.h"
-#include	"noRoption.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. Thsi means that there is no 1-1
+ * mapping from the grammar in the standard to the grammar given here.
+ * Such is life.
+ */
 }
 
-/* 7.1 */
+/* 3.3.1 */
 primary(register struct expr **expp;) :
 	IDENTIFIER
 	{dot2expr(expp);}
@@ -30,14 +38,14 @@ primary(register struct expr **expp;) :
 	string(expp)
 |
 	'(' expression(expp) ')'
-	{(*expp)->ex_flags |= EX_PARENS;}
+	{ (*expp)->ex_flags |= EX_PARENS; }
 ;
 
 
-/*	Character string literals that are adjacent tokens
+/* Character string literals that are adjacent tokens
-	are concatenated into a single character string
+ * are concatenated into a single character string
-	literal.
+ * literal.
-*/
+ */
 string(register struct expr **expp;)
 	{	register int i, len;
 		register char *str;
@@ -51,12 +59,12 @@ string(register struct expr **expp;)
 	}
 	[
 		STRING
-		{	/*	A pasted string keeps the type of the first
+		{	/* A pasted string keeps the type of the first
-				string literal.
+			 * string literal.
-				The pasting of normal strings and wide
+			 * The pasting of normal strings and wide
-				character strings are stated as having an
+			 * character strings are stated as having an
-				undefined behaviour.
+			 * undefined behaviour.
-			*/
+			 */
 			if (dot.tk_fund != fund)
 				warning("illegal pasting of string literals");
 			str = Srealloc(str, (unsigned) (--len + dot.tk_len));
@@ -64,43 +72,35 @@ string(register struct expr **expp;)
 				str[len++] = dot.tk_bts[i];
 		}
 	]*
-	{string2expr(expp, STRING, str, len);}
+	{ string2expr(expp, str, len); }
 ;
 
-secundary(register struct expr **expp;) :
+/* 3.3.2 */
+postfix_expression(register struct expr **expp;)
+	{ int oper; 
+	  struct expr *e1 = 0;
+	  struct idf *idf;
+	}
+:
 	primary(expp)
 	[
-		index_pack(expp)
+		'[' expression(&e1) ']'
+			{ ch7bin(expp, '[', e1); e1 = 0; }
 	|
-		parameter_pack(expp)
+		'(' parameter_list(&e1)? ')'
+			{ ch7bin(expp, '(', e1); call_proto(expp); e1 = 0; }
 	|
-		selection(expp)
+		[ '.' | ARROW ]			{ oper = DOT; }
+		identifier(&idf)		{ ch7sel(expp, oper, idf); }
 	]*
-;
+	[
-
+		[
-index_pack(struct expr **expp;)
+			PLUSPLUS	{ oper = POSTINCR; }
-	{struct expr *e1;}
+		|
-:
+			MINMIN		{ oper = POSTDECR; }
-	'[' expression(&e1) ']'
+		]
-	{ch7bin(expp, '[', e1);}
+		    { ch7incr(expp, oper); }
-;
+	]?
-
-parameter_pack(struct expr **expp;)
-	{struct expr *e1 = 0;}
-:
-	'(' parameter_list(&e1)? ')'
-	{	ch7bin(expp, '(', e1);
-		call_proto(expp);
-	}
-;
-
-selection(struct expr **expp;)
-	{int oper; struct idf *idf;}
-:
-	[ '.' | ARROW ]
-	{oper = DOT;}
-	identifier(&idf)
-	{ch7sel(expp, oper, idf);}
 ;
 
 parameter_list(struct expr **expp;)
@@ -108,28 +108,17 @@ parameter_list(struct expr **expp;)
 :
 	assignment_expression(expp)
 	{any2opnd(expp, PARCOMMA);}
-	[	','
+	[ %persistent
+		','
 		assignment_expression(&e1)
 		{any2opnd(&e1, PARCOMMA);}
 		{ch7bin(expp, PARCOMMA, e1);}
 	]*
 ;
 
-/* 7.2 */
-postfixed(struct expr **expp;)
-	{int oper;}
-:
-	secundary(expp)
-	[
-		postop(&oper)
-		{ch7incr(expp, oper);}
-	|
-		empty
-	]
-;
-
 %first	first_of_type_specifier, type_specifier;
 
+/* 3.3.3 & 3.3.4 */
 unary(register struct expr **expp;)
 	{struct type *tp; int oper;}
 :
@@ -139,7 +128,7 @@ unary(register struct expr **expp;)
 		(*expp)->ex_flags |= EX_CAST;
 	}
 |
-	postfixed(expp)
+	postfix_expression(expp)
 |
 	unop(&oper) unary(expp)
 	{ch7mon(oper, expp);}
@@ -147,10 +136,14 @@ unary(register struct expr **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
+	SIZEOF { InSizeof++; }	/* handle (sizeof(sizeof(int))) too */
 	[%if (first_of_type_specifier(AHEAD) && AHEAD != IDENTIFIER)
 		cast(&tp)
 		{
@@ -161,13 +154,19 @@ size_of(register struct expr **expp;)
 		unary(expp)
 		{ch7mon(SIZEOF, expp);}
 	]
+	{ InSizeof--; }
 ;
 
-/* 7.3-7.12 */
+/* 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.  In principle each operator is
+	N being treated in RM 7.N (although this is not the standard
-	assigned a rank, ranging from 1 to 15.  Such an expression can
+	anymore). The standard describes this in phrase-structure-grammar,
-	be parsed by a construct like:
+	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;}
 		:
@@ -199,48 +198,57 @@ size_of(register struct expr **expp;)
 */
 
 binary_expression(int maxrank; struct expr **expp;)
-	{int oper; struct expr *e1;}
+	{int oper, OldResultKnown; struct expr *e1;}
 :
 	unary(expp)
-	[%while (rank_of(DOT) <= maxrank && AHEAD != '=')
+	[%while (rank_of(DOT) <= maxrank )
-		/*	'?', '=', and ',' are no binops, and the test
+		/*	'?', '=', and ',' are no binops
-			for AHEAD != '=' keeps the other assignment
+		 */
-			operators out
-		*/
 		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)
 		{
 			ch7bin(expp, oper, e1);
+			ResultKnown = OldResultKnown;
 		}
 	]*
 ;
 
-/* 7.13 */
+/* 3.3.15 */
 conditional_expression(struct expr **expp;)
-/*	There is some unfortunate disagreement about what is allowed
+	{struct expr *e1 = 0, *e2 = 0; int OldResultKnown, ConstExpr=0;}
-	between the '?' and the ':' of a conditional_expression.
-	Although the Ritchie compiler does not even allow
-	conditional_expressions there, some other compilers (e.g., VAX)
-	accept a full assignment_expression there, and programs
-	(like, e.g., emacs) rely on it. So we have little choice.
-*/
-	{struct expr *e1 = 0, *e2 = 0;}
 :
 	/* allow all binary operators */
 	binary_expression(rank_of('?') - 1, expp)
 	[	'?'
-		expression(&e1)
+		{ OldResultKnown = ResultKnown;
-		{
+		  if (is_cp_cst(*expp) || is_fp_cst(*expp)) {
-#ifndef NOROPTION
+			  ConstExpr++;
-			check_conditional(e1, '?', "between ? and :");
+			  if (is_zero_cst(*expp)) ResultKnown++;
-#endif
+		  }
 		}
+		expression(&e1)
 		':'
+		{ if (ConstExpr) {
+			if (OldResultKnown == ResultKnown) ResultKnown++;
+			else ResultKnown = OldResultKnown;
+		  }
+		}
+		/* should be: conditional_expression(&e2)
+		 * but that wouldn't work  with 0 ? 0 : i = 0
+		 */
 		assignment_expression(&e2)
 		{	
-#ifndef NOROPTION
+			check_conditional(e2, '=', "not allowed after :");
-			check_conditional(e2, '=', "after :");
+			ResultKnown = OldResultKnown;
-#endif
 			ch7bin(&e1, ':', e2);
 			opnd2test(expp, '?');
 			ch7bin(expp, '?', e1);
@@ -248,11 +256,10 @@ conditional_expression(struct expr **expp;)
 	]?
 ;
 
-/* 7.14 */
+/* 3.3.16 */
 assignment_expression(struct expr **expp;)
-	{
+	{ int oper;
-		int oper;
+	  struct expr *e1 = 0;
-		struct expr *e1 = 0;
 	}
 :
 	conditional_expression(expp)
@@ -265,7 +272,7 @@ assignment_expression(struct expr **expp;)
 	]
 ;
 
-/* 7.15 */
+/* 3.3.17 */
 expression(struct expr **expp;)
 	{struct expr *e1;}
 :
@@ -283,12 +290,6 @@ unop(int *oper;) :
 	{*oper = DOT;}
 ;
 
-postop(int *oper;):
-	PLUSPLUS {*oper = POSTINCR;}
-|
-	MINMIN {*oper = POSTDECR;}
-;
-
 multop:
 	'*' | '/' | '%'
 ;
@@ -321,30 +322,8 @@ binop(int *oper;) :
 ;
 
 asgnop(register int *oper;):
-	'=' {*oper = DOT;}
+	[ '=' | PLUSAB | MINAB | TIMESAB | DIVAB | MODAB 
-|
+	| LEFTAB | RIGHTAB | ANDAB | XORAB | ORAB ]
-	'+' '=' {*oper = PLUSAB;}
-|
-	'-' '=' {*oper = MINAB;}
-|
-	'*' '=' {*oper = TIMESAB;}
-|
-	'/' '=' {*oper = DIVAB;}
-|
-	'%' '=' {*oper = MODAB;}
-|
-	LEFT '=' {*oper = LEFTAB;}
-|
-	RIGHT '=' {*oper = RIGHTAB;}
-|
-	'&' '=' {*oper = ANDAB;}
-|
-	'^' '=' {*oper = XORAB;}
-|
-	'|' '=' {*oper = ORAB;}
-|
-	[ PLUSAB | MINAB | TIMESAB | DIVAB | MODAB | LEFTAB | RIGHTAB
-	| ANDAB | XORAB | ORAB ]
 	{ *oper = DOT; }
 
 ;
@@ -357,19 +336,16 @@ constant(struct expr **expp;) :
 ]	{dot2expr(expp);}
 ;
 
-/* 15 */
+/* 3.4 */
 constant_expression (struct expr **expp;) :
-	assignment_expression(expp)
+	conditional_expression(expp)
-	{chk_cst_expr(expp);}
+			    /* was: assignment_expression(expp) */
+	{ chk_cst_expr(expp); }
 ;
 
 identifier(struct idf **idfp;) :
-[
+[ IDENTIFIER
-	IDENTIFIER
+| TYPE_IDENTIFIER
-|
-	TYPE_IDENTIFIER
 ]
-	{
+	{ *idfp = dot.tk_idf; }
-		*idfp = dot.tk_idf;
-	}
 ;

lang/cem/cemcom.ansi/field.c

@@ -14,6 +14,7 @@
 #include	<em.h>
 #include	<em_reg.h>
 #include	"debug.h"
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"type.h"
 #include	"idf.h"

lang/cem/cemcom.ansi/idf.c

@@ -7,7 +7,6 @@
 
 #include	"lint.h"
 #include	<em_reg.h>
-#include	"nofloat.h"
 #include	"debug.h"
 #include	"idfsize.h"
 #include	"botch_free.h"
@@ -31,7 +30,6 @@
 #include	"Lpars.h"
 #include	"assert.h"
 #include	"specials.h"	/* registration of special identifiers	*/
-#include	"noRoption.h"
 
 int idfsize = IDFSIZE;
 extern char options[];
@@ -226,24 +224,18 @@ declare_idf(ds, dc, lvl)
 			type = construct_type(POINTER, type, 0, (arith)0,
 					      NO_PROTO);
 			break;
-		case ARRAY:	/* RM 10.1	*/
+		case ARRAY:	/* 3.7.1 */
 			type = construct_type(POINTER, type->tp_up, 0, (arith)0,
 					      NO_PROTO);
 			formal_array = 1;
 			break;
-#ifndef NOFLOAT
+		case FLOAT:
-		case FLOAT:	/* RM 10.1	*/
-			type = double_type;
-			break;
-#endif NOFLOAT
 		case CHAR:
 		case SHORT:
-			/*	The RM is not clear about this: we must
+			/* The conversion is done in formal_cvt(). It is
-				convert the parameter from int (they have
+			 * not done when the type is float and there is a
-				been pushed as ints) to the specified type.
+			 * prototype.
-				The conversion to type int or uint is not
+			 */
-				allowed.
-			*/
 			break;
 		}
 	}
@@ -252,29 +244,27 @@ declare_idf(ds, dc, lvl)
 	*/
 	/* update the storage class */
 	if (type && type->tp_fund == FUNCTION)	{
-		if (sc == 0 || (ds->ds_sc_given && sc == AUTO))	/* RM 8.1 */
+		if (lvl != L_GLOBAL)  {		/* 3.5.1 */
-			sc = GLOBAL;
+			if (sc == 0)
-		else
+				sc = GLOBAL;
-		if (sc == REGISTER) {
+			else if (sc != EXTERN && sc != IMPLICIT) {
-			error("function storage class cannot be register");
+				error("illegal storage class %s for function with block-scope"
-			ds->ds_sc = sc = GLOBAL;
+					, symbol2str(sc));
+				ds->ds_sc = sc = GLOBAL;
+			}
 		}
+		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;
-#ifndef NOROPTION
+
-	if (options['R']) { /* some special K & R tests */
+	/* is it a universal typedef? */
-		/* is it also an enum? */
+	if (def && def->df_level == L_UNIVERSAL)
-		if (idf->id_enum && idf->id_enum->tg_level == level)
+		warning("redeclaring reserved word %s", idf->id_text);
-			warning("%s is also an enum tag", idf->id_text);
-		/* is it a universal typedef? */
-		if (def && def->df_level == L_UNIVERSAL)
-			warning("redeclaring reserved word %s", idf->id_text);
-	}
-#endif
 
 #ifdef	LINT
 	if (	def && def->df_level < lvl
@@ -330,6 +320,7 @@ declare_idf(ds, dc, lvl)
 		def->df_file = idf->id_file;
 		def->df_line = idf->id_line;
 	}
+#if	0	/* be more strict in scope (at least for now) */
 	else
 	if (	lvl >= L_LOCAL &&
 		(type->tp_fund == FUNCTION || sc == EXTERN)
@@ -337,16 +328,13 @@ declare_idf(ds, dc, lvl)
 		/*	extern declaration inside function is treated the
 			same way as global extern declaration
 		*/
-#ifndef NOROPTION
+		if (sc == STATIC && type->tp_fund == FUNCTION)
-		if (	options['R'] &&
-			(sc == STATIC && type->tp_fund == FUNCTION)
-		)
 			if (!is_anon_idf(idf))
 				warning("non-global static function %s",
 					idf->id_text);
-#endif
 		declare_idf(ds, dc, L_GLOBAL);
 	}
+#endif
 	else	{ /* fill in the def block */
 		register struct def *newdef = new_def();
 
@@ -376,7 +364,8 @@ declare_idf(ds, dc, lvl)
 			switch (sc)	{
 			case REGISTER:
 			case AUTO:
-				if (type->tp_size == (arith)-1) {
+				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; **/
@@ -423,10 +412,12 @@ global_redecl(idf, new_sc, tp)
 		in storage class.
 	*/
 	register struct def *def = idf->id_def;
+	int retval;
 
-	if (!equal_type(tp, def->df_type))
+	if (!(retval = equal_type(tp, def->df_type)))
 		error("redeclaration of %s with different type", idf->id_text);
-	else update_proto(tp, def->df_type);
+	else if (retval == 1)
+		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 [] */
@@ -451,6 +442,7 @@ global_redecl(idf, new_sc, tp)
 	*/
 	if (new_sc == IMPLICIT)
 		return;			/* no new information */
+
 	switch (def->df_sc)	{	/* the old storage class */
 	case EXTERN:
 		switch (new_sc)	{	/* the new storage class */
@@ -458,15 +450,8 @@ global_redecl(idf, new_sc, tp)
 		case GLOBAL:
 			break;
 		case STATIC:
-			if (def->df_initialized)	{
+			warning("redeclaration of %s to static ignored"
-				error("cannot redeclare %s to static",
+						, idf->id_text);
-					idf->id_text);
-			}
-			else	{
-				warning("%s redeclared to static",
-						idf->id_text);
-			}
-			def->df_sc = new_sc;
 			break;
 		default:
 			crash("bad storage class");
@@ -481,17 +466,8 @@ global_redecl(idf, new_sc, tp)
 		case GLOBAL:
 			break;
 		case STATIC:
-			if (def->df_initialized)
+			warning("redeclaration of %s to static ignored"
-				error("cannot redeclare %s to static",
+						, idf->id_text);
-					idf->id_text);
-			else	{
-#ifndef NOROPTION
-				if (options['R'])
-					warning("%s redeclared to static",
-						idf->id_text);
-#endif
-				def->df_sc = STATIC;
-			}
 			break;
 		default:
 			crash("bad storage class");
@@ -500,21 +476,13 @@ global_redecl(idf, new_sc, tp)
 		break;
 	case STATIC:
 		switch (new_sc)	{	/* the new storage class */
-		case EXTERN:
-			if (def->df_initialized)
-				error("cannot redeclare %s to extern",
-					idf->id_text);
-			else	{
-				warning("%s redeclared to extern",
-					idf->id_text);
-				def->df_sc = EXTERN;
-			}
-			break;
 		case GLOBAL:
+			warning("%s redeclared extern", idf->id_text);
+			def->df_sc = new_sc;
+			break;
+		case EXTERN:			/* complain at definition */
+			break;
 		case STATIC:
-			if (def->df_type->tp_fund != FUNCTION)
-				warning("%s was already static",
-					idf->id_text);
 			break;
 		default:
 			crash("bad storage class");
@@ -528,11 +496,6 @@ global_redecl(idf, new_sc, tp)
 			def->df_sc = new_sc;
 			break;
 		case STATIC:
-#ifndef NOROPTION
-			if (options['R'])
-				warning("%s was implicitly declared as extern",
-					idf->id_text);
-#endif
 			def->df_sc = new_sc;
 			break;
 		default:
@@ -568,18 +531,16 @@ good_formal(def, idf)
 }
 
 declare_params(dc)
-	register struct declarator *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;
 	}
-	free_formals(dc->dc_formal);
-	dc->dc_formal = 0;
 }
 
 init_idf(idf)
@@ -617,7 +578,76 @@ declare_enum(tp, idf, l)
 	idf->id_def->df_address = l;
 }
 
-declare_formals(fp)
+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 = du->next;
+	ASSERT(du);
+	if (du->du_proto) return;
+
+	warning("'%s' old-fashioned function definition", dc->dc_idf->id_text);
+
+	if (pl) {
+		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)) {
+			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;
+
+		while (fm) {
+			if (pl == 0) pl = lpl = new_proto();
+			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 = new_proto();
+			pl->pl_flag = 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
@@ -628,6 +658,7 @@ declare_formals(fp)
 	register struct stack_entry *se = stack_level_of(L_FORMAL1)->sl_entry;
 	arith f_offset = (arith)0;
 	register int nparams = 0;
+	int hasproto = idf->id_def->df_type->tp_proto != 0;
 
 #ifdef	DEBUG
 	if (options['t'])
@@ -636,13 +667,22 @@ declare_formals(fp)
 	while (se)	{
 		register struct def *def = se->se_idf->id_def;
 		
+		/* this stacklevel may also contain tags. ignore them */
+		if (!def || def->df_level < L_FORMAL1 ) {
+			se = se->next;
+			continue;
+		}
+
 		def->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.
 		*/
 		f_offset = align(f_offset + def->df_type->tp_size, (int) word_size);
-		formal_cvt(def); /* cvt int to char or short, if necessary */
+		/* cvt int to char or short and double to float, if necessary
+		 */
+		formal_cvt(hasproto, def);
+
 		se = se->next;
 		def->df_level = L_FORMAL2;	/* CJ */
 		RegisterAccount(def->df_address, def->df_type->tp_size,
@@ -662,11 +702,10 @@ regtype(tp)
 	case INT:
 	case LONG:
 		return reg_any;
-#ifndef NOFLOAT
 	case FLOAT:
 	case DOUBLE:
+	case LNGDBL:
 		return reg_float;
-#endif NOFLOAT
 	case POINTER:
 		return reg_pointer;
 	}

lang/cem/cemcom.ansi/idf.str

@@ -40,7 +40,6 @@ struct idf	{
 	struct sdef *id_sdef;	/* selector tags			*/
 	struct tag *id_struct;	/* struct and union tags		*/
 	struct tag *id_enum;	/* enum tags				*/
-	int id_proto;		/* non-zero don't complain about proto	*/
 	int id_special;		/* special action needed at occurrence	*/
 };
 

lang/cem/cemcom.ansi/init.c

@@ -74,22 +74,22 @@ init_pp()
 	/* __DATE__ */
 	sprintf(dbuf, "\"%.3s %.2d %d\"", months[tp->tm_mon],
 			tp->tm_mday, tp->tm_year+1900);
-	macro_def(str2idf("__DATE__"), dbuf, -1, 12, NOFLAG);
+	macro_def(str2idf("__DATE__"), dbuf, -1, strlen(dbuf), NOUNDEF);
 
 	/* __TIME__ */
 	sprintf(tbuf, "\"%.2d:%.2d:%.2d\"", tp->tm_hour, tp->tm_min, tp->tm_sec);
-	macro_def(str2idf("__TIME__"), tbuf, -1, 10, NOFLAG);
+	macro_def(str2idf("__TIME__"), tbuf, -1, strlen(tbuf), NOUNDEF);
 
 	/* __LINE__	*/
-	macro_def(str2idf("__LINE__"), "0", -1, 1, FUNC);
+	macro_def(str2idf("__LINE__"), "0", -1, 1, NOUNDEF | FUNC);
 
 	/* __FILE__	*/
-	macro_def(str2idf("__FILE__"), "", -1, 1, FUNC);
+	macro_def(str2idf("__FILE__"), "", -1, 1, NOUNDEF | FUNC);
 
 	/* __STDC__ */
-	macro_def(str2idf("__STDC__"), "1", -1, 1, NOFLAG);
+	macro_def(str2idf("__STDC__"), "1", -1, 1, NOUNDEF);
 
 	/* defined(??) */
-	macro_def(str2idf("defined"), "", 1, 1, FUNC);
+	macro_def(str2idf("defined"), "", 1, 1, NOUNDEF | FUNC);
 }
 #endif NOPP

lang/cem/cemcom.ansi/input.c

@@ -34,7 +34,7 @@ getwdir(fn)
 		return "";
 	if (p) {
 		*p = '\0';
-		fn = Salloc(fn, p - &fn[0] + 1);
+		fn = Salloc(fn,(unsigned) (p - &fn[0] + 1));
 		*p = '/';
 		return fn;
 	}
@@ -43,9 +43,13 @@ getwdir(fn)
 #endif NOPP
 
 int	NoUnstack;
+int	InputLevel;
+#if 0
+#endif
 
 AtEoIT()
 {
+	InputLevel--;
 	unstackrepl();
 	return 0;
 }

lang/cem/cemcom.ansi/input.h

@@ -9,7 +9,7 @@
 
 /*	Note: The following macro only garuantees one PushBack.
 */
-#define UnGetChar()	ChPushBack(LexSave)
+#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/ival.g

@@ -7,12 +7,12 @@
 
 {
 #include	"lint.h"
-#include	"nofloat.h"
 #include	<em.h>
 #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"
@@ -27,7 +27,6 @@
 #include	"level.h"
 #include	"def.h"
 #include	"LLlex.h"
-#include	"noRoption.h"
 #include	"estack.h"
 #ifdef	LINT
 #include	"l_lint.h"
@@ -45,13 +44,15 @@ struct sdef *gen_align_to_next();
 struct e_stack *p_stack;
 }
 
-/*	initial_value recursively guides the initialisation expression.
+/* initial_value recursively guides the initialisation expression.
-	Upto now, the initialisation of a union is not allowed!
+ */
-*/
+/* 3.5 */
-/* 7 */
+{ static int pack_level; }
+
 initial_value(register struct type **tpp; register struct expr **expp;) :
-	{ if (tpp) gen_tpcheck(tpp, 0); }
+	{ if (tpp) gen_tpcheck(tpp); }
 [
+		{ if (pack_level == 0) gen_error = 0; }
 	assignment_expression(expp)
 		{
 #ifdef	LINT
@@ -71,7 +72,6 @@ initial_value(register struct type **tpp; register struct expr **expp;) :
 ;
 
 initial_value_pack(struct type **tpp; struct expr **expp;)
-	{ static int pack_level; }
 :
 	'{'
 			{ if (pack_level == 0) gen_error = 0; pack_level++; }
@@ -108,7 +108,7 @@ initial_value_list(register struct type **tpp; struct expr **expp;)
 ;
 
 {
-gen_tpcheck(tpp, union_allowed)
+gen_tpcheck(tpp)
 	struct type **tpp;
 {
 	register struct type *tp;
@@ -418,24 +418,14 @@ pad(tpx)
 	register struct type *tp = tpx;
 	register arith sz = tp->tp_size;
 
-	gen_tpcheck(&tpx, 1);
+	gen_tpcheck(&tpx);
 	if (gen_error) return;
-	switch (tp->tp_fund) {
-	case UNION:
-#ifndef NOROPTION
-		if (options['R']) {
-			warning("initialisation of unions not allowed");
-		}
-#endif
-		break;
 #ifndef NOBITFIELD
-	case FIELD:
+	if (tp->tp_fund == FIELD) {
 		put_bf(tp, (arith)0);
 		return;
-#endif NOBITFIELD
-		default:
-			break;
 	}
+#endif NOBITFIELD
 
 	while (sz >= word_size) {
 		C_con_cst((arith) 0);
@@ -498,16 +488,21 @@ check_ival(expp, tp)
 			C_con_dlb(expr->VL_LBL, expr->VL_VALUE);
 		}
 		break;
-#ifndef NOFLOAT
 	case FLOAT:
 	case DOUBLE:
+	case LNGDBL:
 		ch7cast(expp, '=', tp);
 		expr = *expp;
 #ifdef DEBUG
 		print_expr("init-expr after cast", expr);
 #endif DEBUG
-		if (expr->ex_class == Float)
+		if (expr->ex_class == Float) {
+			if (!expr->FL_VALUE) {
+				expr->FL_VALUE = Malloc(FLT_STRLEN);
+				flt_flt2str(&(expr->FL_ARITH), expr->FL_VALUE, FLT_STRLEN);
+			}
 			C_con_fcon(expr->FL_VALUE, expr->ex_type->tp_size);
+		}
 #ifdef NOTDEF
 
 Coercion from int to float is now always done compile time.
@@ -529,7 +524,6 @@ and also to prevent runtime coercions for compile-time constants.
 		else
 			illegal_init_cst(expr);
 		break;
-#endif NOFLOAT
 
 #ifndef NOBITFIELD
 	case FIELD:
@@ -562,13 +556,13 @@ ch_array(tpp, ex)
 	struct expr *ex;
 {
 	register struct type *tp = *tpp;
-	register arith length = ex->SG_LEN;
+	register int length = ex->SG_LEN, i;
-	char *s;
+	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, length, NO_PROTO);
+		tp = *tpp = construct_type(ARRAY, tp->tp_up, 0, (arith)length, NO_PROTO);
 	}
 	else {
 		arith dim = tp->tp_size / tp->tp_up->tp_size;
@@ -580,10 +574,14 @@ ch_array(tpp, ex)
 	}
 	/* throw out the characters of the already prepared string	*/
 	s = Malloc((unsigned) (length));
-	clear(s, (int) (length));
+	clear(s, length);
-	strncpy(s, ex->SG_VALUE, (int) 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, (int) (length));
+	str_cst(s, length);
 	free(s);
 }
 
@@ -651,7 +649,7 @@ zero_bytes(sd)
 	*/
 	register int n = sd->sd_sdef->sd_offset - sd->sd_offset -
 		size_of_type(sd->sd_type, "struct member");
-	register int count = n;
+	int count = n;
 
 	while (n-- > 0)
 		con_nullbyte();

lang/cem/cemcom.ansi/l_ev_ord.c

@@ -12,6 +12,7 @@
 #include	<alloc.h>	/* for st_free */
 #include	"interface.h"
 #include	"assert.h"
+#include	<flt_arith.h>
 #include	"arith.h"	/* definition arith */
 #include	"label.h"	/* definition label */
 #include	"expr.h"
@@ -23,7 +24,6 @@
 #include	"stack.h"
 #include	"type.h"
 #include	"level.h"
-#include	"nofloat.h"
 #include	"l_lint.h"
 #include	"l_state.h"
 

lang/cem/cemcom.ansi/l_lint.c

@@ -13,6 +13,7 @@
 #include	"debug.h"
 #include	"interface.h"
 #include	"assert.h"
+#include	<flt_arith.h>
 #include	"arith.h"	/* definition arith */
 #include	"label.h"	/* definition label */
 #include	"expr.h"
@@ -24,7 +25,6 @@
 #include	"stack.h"
 #include	"type.h"
 #include	"level.h"
-#include	"nofloat.h"
 #include	"l_lint.h"
 #include	"l_state.h"
 #include	"l_outdef.h"

lang/cem/cemcom.ansi/l_misc.c

@@ -11,6 +11,7 @@
 
 #include	<alloc.h>	/* for st_free */
 #include	"interface.h"
+#include	<flt_arith.h>
 #include	"arith.h"	/* definition arith */
 #include	"label.h"	/* definition label */
 #include	"expr.h"
@@ -22,7 +23,6 @@
 #include	"stack.h"
 #include	"type.h"
 #include	"level.h"
-#include	"nofloat.h"
 #include	"l_state.h"
 
 extern char *symbol2str();
@@ -140,7 +140,8 @@ lint_new_oper(expr)
 		break;
 
 	case '~':
-		if (r_fund == ENUM || r_fund == FLOAT || r_fund == DOUBLE)
+		if (r_fund == ENUM || r_fund == FLOAT || r_fund == DOUBLE
+					    /* ??? ||  r_fund == LNGDBL */ )
 			warning("~ on %s", symbol2str(r_fund));
 		break;
 
@@ -285,6 +286,7 @@ numsize(fund)
 	case LONG:	return 4;
 	case FLOAT:	return 5;
 	case DOUBLE:	return 6;
+	case LNGDBL:	return 7;
 	default:	return 0;
 	}
 }
@@ -300,8 +302,8 @@ lint_ptr_conv(from, to)
 {
 /* X -> X ok			-- this includes struct -> struct, of any size
  * X -> CHAR ok
- * DOUBLE -> X ok
+ * LNGDBL -> X ok
- * FLOAT -> LONG -> INT -> SHORT  ok
+ * DOUBLE -> FLOAT -> LONG -> INT -> SHORT  ok
  */
 	if (from == to)
 		return;
@@ -309,10 +311,18 @@ lint_ptr_conv(from, to)
 	if (to == CHAR)
 		return;
 
-	if (from == DOUBLE)
+	if (from == LNGDBL)
 		return;
 
 	switch (from) {
+	case DOUBLE:
+		switch(to) {
+		case FLOAT:
+		case INT:
+		case SHORT:
+			return;
+		}
+		break;
 	case FLOAT:
 		switch (to) {
 		case LONG:

lang/cem/cemcom.ansi/l_outdef.c

@@ -11,6 +11,7 @@
 
 #include	<alloc.h>
 #include	"interface.h"
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"assert.h"
 #include	"type.h"
@@ -442,6 +443,7 @@ outargtype(tp)
 	case LONG:
 	case FLOAT:
 	case DOUBLE:
+	case LNGDBL:
 	case VOID:
 	case ERRONEOUS:
 		if (tp->tp_unsigned)

lang/cem/cemcom.ansi/l_states.c

@@ -13,6 +13,7 @@
 #include	"interface.h"
 #include	"assert.h"
 #include	"debug.h"
+#include	<flt_arith.h>
 #include	"arith.h"	/* definition arith */
 #include	"label.h"	/* definition label */
 #include	"expr.h"
@@ -24,7 +25,6 @@
 #include	"stack.h"
 #include	"type.h"
 #include	"level.h"
-#include	"nofloat.h"
 #include	"l_lint.h"
 #include	"l_brace.h"
 #include	"l_state.h"

lang/cem/cemcom.ansi/label.c

@@ -12,7 +12,6 @@
 #include	"arith.h"
 #include	"def.h"
 #include	"type.h"
-#include	"noRoption.h"
 
 extern char options[];
 
@@ -33,25 +32,10 @@ enter_label(idf, defining)
 								idf->id_text);
 		}
 		else	{		/* there may still be room for it */
-#ifndef NOROPTION
-			if (options['R'] && def->df_sc == TYPEDEF)
-				warning("label %s is also a typedef",
-					idf->id_text);
-#endif
-			
 			if (def->df_level == level)	/* but alas, no */
 				error("%s is not a label", idf->id_text);
 			else	{
-				register int lvl = def->df_level + 1;
+				add_def(idf, LABEL, label_type, L_LOCAL);
-				
-#ifndef NOROPTION
-				if (options['R'] && def->df_level > L_LOCAL)
-					warning("label %s is not function-wide",
-								idf->id_text);
-#endif
-				if (lvl < L_LOCAL)
-					lvl = L_LOCAL;
-				add_def(idf, LABEL, label_type, lvl);
 			}
 		}
 	}

lang/cem/cemcom.ansi/macro.str

@@ -12,8 +12,9 @@
 	these flags can be set simultaneously.
 */
 #define NOFLAG		0		/* no special flags	*/
-#define	FUNC		01		/* function attached    */
+#define	FUNC		0x1		/* function attached    */
-#define NOREPLACE	02		/* don't replace	*/
+#define	NOUNDEF		0x2		/* special macro */
+#define NOREPLACE	0x4		/* prevent recursion */
 
 #define	FORMALP 0200	/* mask for creating macro formal parameter	*/
 

lang/cem/cemcom.ansi/main.c

@@ -6,7 +6,6 @@
 /* MAIN PROGRAM */
 
 #include	"lint.h"
-#include	"nofloat.h"
 #include	<system.h>
 #include	"nopp.h"
 #include	"target_sizes.h"
@@ -25,7 +24,6 @@
 #include	"LLlex.h"
 #include	<alloc.h>
 #include	"specials.h"
-#include	"noRoption.h"
 #include	"nocross.h"
 #include	"sizes.h"
 #include	"align.h"
@@ -55,11 +53,9 @@ arith
 	dword_size = (2 * SZ_WORD),
 	int_size = SZ_INT,
 	long_size = SZ_LONG,
-#ifndef NOFLOAT
 	float_size = SZ_FLOAT,
 	double_size = SZ_DOUBLE,
 	lngdbl_size = SZ_LNGDBL,
-#endif NOFLOAT
 	pointer_size = SZ_POINTER;
 
 int
@@ -67,11 +63,9 @@ int
 	word_align = AL_WORD,
 	int_align = AL_INT,
 	long_align = AL_LONG,
-#ifndef NOFLOAT
 	float_align = AL_FLOAT,
 	double_align = AL_DOUBLE,
 	lngdbl_align = AL_LNGDBL,
-#endif NOFLOAT
 	pointer_align = AL_POINTER,
 	struct_align = AL_STRUCT,
 	union_align = AL_UNION;
@@ -113,7 +107,7 @@ main(argc, argv)
 	{
 		char *par = &argv[1][1];
 
-		do_option(par, 1);
+		do_option(par);
 		argc--, argv++;
 	}
 #ifdef	LINT
@@ -240,7 +234,7 @@ init()
 		transparent to the user.
 	*/
 	gen_type = standard_type(GENERIC, 0, 1, (arith)1);
-	char_type = standard_type(CHAR, 0, 1, (arith)1);
+	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);
@@ -259,11 +253,9 @@ init()
 	long_type = standard_type(LONG, 0, long_align, long_size);
 	ulong_type = standard_type(LONG, UNSIGNED, long_align, long_size);
 
-#ifndef NOFLOAT
 	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);
-#endif NOFLOAT
 	void_type = standard_type(VOID, 0, 1, (arith)0);
 	label_type = standard_type(LABEL, 0, 0, (arith)0);
 	error_type = standard_type(ERRONEOUS, 0, 1, (arith)1);
@@ -292,17 +284,15 @@ init()
 	if ((int)short_size > (int)int_size || (int)int_size > (int)long_size)
 		fatal("sizes of short/int/long decreasing");
 
-	/* Build a type for function returning int, RM 13 */
+	/* 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, char_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"), TYPEDEF, char_type, L_UNIVERSAL);
+	add_def(str2idf("char"), TYPEDEF, schar_type, L_UNIVERSAL);
 	add_def(str2idf("int"), TYPEDEF, int_type, L_UNIVERSAL);
-#ifndef NOFLOAT
 	add_def(str2idf("float"), TYPEDEF, float_type, L_UNIVERSAL);
 	add_def(str2idf("double"), TYPEDEF, double_type, L_UNIVERSAL);
-#endif NOFLOAT
 	add_def(str2idf("void"), TYPEDEF, void_type, L_UNIVERSAL);
 	stack_level();
 }
@@ -372,17 +362,16 @@ preprocess()
 			char sbuf[1024];	/* a transient buffer */
 			char *bts2str();
 
-			print("\"%s\" ", bts2str(dot.tk_bts, dot.tk_len, sbuf));
+			print("\"%s\" ", bts2str(dot.tk_bts, dot.tk_len -
+			1, sbuf));
 			break;
 		}
 		case INTEGER:
 			print("%ld ", dot.tk_ival);
 			break;
-#ifndef NOFLOAT
 		case FLOATING:
 			print("%s ", dot.tk_fval);
 			break;
-#endif NOFLOAT
 		case EOI:
 		case EOF:
 			return;

lang/cem/cemcom.ansi/options.c

@@ -8,7 +8,6 @@
 #include	"lint.h"
 #include	"botch_free.h"
 #include	<alloc.h>
-#include	"nofloat.h"
 #include	"nopp.h"
 #include	"idfsize.h"
 #include	"nobitfield.h"
@@ -20,7 +19,6 @@
 #include	"align.h"
 #include	"use_tmp.h"
 #include	"dataflow.h"
-#include	"noRoption.h"
 
 #ifndef NOPP
 extern char **inctable;
@@ -86,14 +84,6 @@ next_option:			/* to allow combined one-char options */
 		goto next_option;
 #endif	LINT
 
-	case 'R':			/* strict version */
-#ifndef	NOROPTION
-		options[opt] = 1;
-#else	NOROPTION
-		warning("-R option not implemented");
-#endif	NOROPTION
-		goto next_option;
-
 #ifdef	___XXX___
 deleted, is now a debug-flag
 	case 'C' :	/* E option + comment output		*/
@@ -284,28 +274,22 @@ deleted, is now a debug-flag
 					long_align = algn;
 				break;
 			case 'f':	/* float	*/
-#ifndef NOFLOAT
 				if (sz != (arith)0)
 					float_size = sz;
 				if (algn != 0)
 					float_align = algn;
-#endif NOFLOAT
 				break;
 			case 'd':	/* double	*/
-#ifndef NOFLOAT
 				if (sz != (arith)0)
 					double_size = sz;
 				if (algn != 0)
 					double_align = algn;
-#endif NOFLOAT
 				break;
 			case 'x':	/* long double	*/
-#ifndef NOFLOAT
 				if (sz != (arith)0)
 					lngdbl_size = sz;
 				if (algn != 0)
 					lngdbl_align = algn;
-#endif NOFLOAT
 				break;
 			case 'p':	/* pointer	*/
 				if (sz != (arith)0)

lang/cem/cemcom.ansi/pragma.c

@@ -38,15 +38,13 @@ struct pkey {
 
 extern struct idf *GetIdentifier();
 
-
 do_pragma()
 {
 	register struct pkey *pkp;
 	register struct idf *id;
 	struct token tk;
-	int flag;
 
-	if ((id = GetIdentifier()) != (struct idf *)0) {
+	if ((id = GetIdentifier(1)) != (struct idf *)0) {
 		/*	Lineair search - why bother ?
 		*/
 		for (pkp = &pragmas[0]; pkp->pk_key != P_UNKNOWN; pkp++)
@@ -67,8 +65,8 @@ do_pragma()
 			strict("unimplemented pragma directive");
 			break;
 		}
+		SkipToNewLine(0);
 	}
-	SkipToNewLine(0);
+	else strict("unrecognized pragma line");
-
 }
 #endif

lang/cem/cemcom.ansi/program.g

@@ -47,6 +47,7 @@
 {
 #include	"lint.h"
 #include	"nopp.h"
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"LLlex.h"
 #include	"idf.h"
@@ -86,10 +87,10 @@ control_if_expression
 		}
 ;
 
-/* 10 */
+/* 3.7 */
 program:
 	[%persistent external_definition]*
-	{unstack_world();}
+	{ unstack_world(); }
 ;
 
 /*	A C identifier definition is remarkable in that it formulates
@@ -176,29 +177,28 @@ non_function(register struct decspecs *ds; register struct declarator *dc;)
 	';'
 ;
 
-/* 10.1 */
+/* 3.7.1 */
 function(struct decspecs *ds; struct declarator *dc;)
 	{
 		arith fbytes;
+		register struct idf *idf = dc->dc_idf;
 	}
 :
-	{	register struct idf *idf = dc->dc_idf;
+	{
 #ifdef	LINT
 		lint_start_function();
 #endif	LINT
 		init_idf(idf);
 		stack_level();		/* L_FORMAL1 declarations */
-		if (dc->dc_formal)
-			strict("'%s' old-fashioned function declaration",
-				idf->id_text);
 		declare_params(dc);
 		begin_proc(ds, idf);	/* sets global function info */
 		stack_level();		/* L_FORMAL2 declarations */
-		declare_protos(idf, dc);
+		declare_protos(dc);
 	}
 	declaration*
 	{
-		declare_formals(&fbytes);
+		check_formals(idf, dc);		/* check style-mixtures */
+		declare_formals(idf, &fbytes);
 #ifdef	LINT
 		lint_formals();
 #endif	LINT

lang/cem/cemcom.ansi/proto.c

@@ -13,6 +13,7 @@
 #include	<alloc.h>
 #include	"Lpars.h"
 #include	"level.h"
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"align.h"
 #include	"stack.h"
@@ -29,6 +30,25 @@
 
 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, level)
 	struct proto *pl;
 	struct decspecs *ds;
@@ -50,7 +70,7 @@ add_proto(pl, ds, dc, level)
 
 	ASSERT(ds->ds_type != (struct type *)0);
 
-	pl->pl_flag = FORMAL;
+	pl->pl_flag = PL_FORMAL;
 	if ((idf = dc->dc_idf) != (struct idf *)0)
 		def = idf->id_def;
 	type = declare_type(ds->ds_type, dc);
@@ -58,9 +78,9 @@ add_proto(pl, ds, dc, level)
 		extern char *symbol2str();
 		error("unknown %s-type", symbol2str(type->tp_fund));
 	} else if (type->tp_size == 0) {
-		pl->pl_flag = VOID;
 		if (idf != (struct idf *)0)
-			strict("illegal use of void in argument list");
+			error("illegal use of void in argument list");
+		else pl->pl_flag = PL_VOID;
 	}
 
 	/*	Perform some special conversions for parameters.
@@ -70,7 +90,7 @@ add_proto(pl, ds, dc, level)
 			remove_proto_idfs(type->tp_proto);
 		type = construct_type(POINTER, type, 0, (arith) 0, NO_PROTO);
 	} else if (type->tp_fund == ARRAY) {
-		type = construct_type(POINTER, type, 0, (arith) 0, NO_PROTO);
+		type = construct_type(POINTER, type->tp_up, 0, (arith) 0, NO_PROTO);
 		formal_array = 1;
 	}
 
@@ -84,7 +104,7 @@ add_proto(pl, ds, dc, level)
 	sc = (ds->ds_sc_given && ds->ds_sc != REGISTER) ?
 				0 : sc == 0 ? FORMAL : REGISTER;
 
-	if (def && (def->df_level == level || def->df_level < L_PROTO)) {
+	if (def && (def->df_level == level /* || def->df_level < L_PROTO */ )) {
 		/* redeclaration at the same level */
 		error("parameter %s redeclared", idf->id_text);
 	} else if (idf != (struct idf *)0) {
@@ -111,6 +131,8 @@ add_proto(pl, ds, dc, level)
 			...
 				{ 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.
@@ -118,6 +140,7 @@ add_proto(pl, ds, dc, level)
 
 			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
@@ -131,8 +154,25 @@ add_proto(pl, ds, dc, level)
 	pl->pl_type = type;
 }
 
-declare_protos(idf, dc)
+struct tag *
-	register struct idf *idf;
+gettag(tp, idpp)
+struct type *tp;
+struct idf **idpp;
+{
+	struct tag *tg;
+
+	while (tp->tp_up) tp = tp->tp_up;
+	*idpp = tp->tp_idf;
+	switch(tp->tp_fund) {
+	case ENUM: tg = tp->tp_idf->id_enum; break;
+	case UNION:
+	case STRUCT: tg = tp->tp_idf->id_struct; break;
+	default: return (struct tag *)0;
+	}
+	return tg;
+}
+
+declare_protos(dc)
 	register struct declarator *dc;
 {
 	/*	At this points we know that the idf's in protolist are formal
@@ -153,12 +193,17 @@ declare_protos(idf, dc)
 		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 == ELLIPSIS) {
+			if (pl->pl_flag & PL_ELLIPSIS) {
 				pl = pl->next;
 				continue;
 			}
@@ -181,6 +226,12 @@ declare_protos(idf, dc)
 			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
@@ -265,6 +316,50 @@ free_proto_list(pl)
 	}
 }
 
+/* struct/union and enum tags can be declared inside prototypes
+ * remove them from the symbol-table
+ */
+remove_proto_tag(tp)
+struct type *tp;
+{
+	struct idf *ident;
+	struct tag *tg, *otg = 0;
+
+	while(tp->tp_up) tp = tp->tp_up;
+
+	ident = tp->tp_idf;
+	switch(tp->tp_fund) {
+	case ENUM: tg = ident->id_enum; break;
+	case UNION:
+	case STRUCT: tg = ident->id_struct; break;
+	default: return;
+	}
+	while (tg && tg->tg_type != tp) {
+		otg = tg;
+		tg = tg->next;
+	}
+	if (tg ->tg_level > L_PROTO) return;
+
+#ifdef DEBUG
+	if (options['t'])
+		print("Removing idf %s from list\n",
+			ident->id_text);
+#endif
+
+	if (!otg) {
+		switch(tp->tp_fund) {
+		case ENUM: ident->id_enum = tg->next; break;
+		case UNION:
+		case STRUCT: ident->id_struct = tg->next; break;
+		}
+		free_tag(tg);
+	}
+	else {
+		otg->next = tg->next;
+		free_tag(tg);
+	}
+}
+
 remove_proto_idfs(pl)
 	register struct proto *pl;
 {
@@ -283,15 +378,19 @@ remove_proto_idfs(pl)
 #endif
 			/*	Remove all the definitions made within
 				a prototype.
+				??? is this really necessary (Hans)
+				wasn't this done before in the declaration
 			*/
-			if (pl->pl_flag == FORMAL) {
+#if 0
+			if (pl->pl_flag & PL_FORMAL) {
 				register struct type *tp = pl->pl_type;
 
 				while (tp && tp->tp_fund != FUNCTION)
 					tp = tp->tp_up;
 				if (tp)
-					remove_proto_idfs(tp->tp_proto);
+				    debug("remove_proto_idfs(tp->tp_proto)");
 			}
+#endif
 			def = pl->pl_idf->id_def;
 			if (def && def->df_level <= L_PROTO){
 				pl->pl_idf->id_def = def->next;
@@ -299,6 +398,9 @@ remove_proto_idfs(pl)
 			}
 			pl->pl_idf = (struct idf *) 0;
 		}
+		if (pl->pl_type) {
+			remove_proto_tag(pl->pl_type);
+		}
 		pl = pl->next;
 	}
 }
@@ -316,7 +418,7 @@ call_proto(expp)
 	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, ELLIPSIS };
+	static struct proto ellipsis = { 0, 0, 0, PL_ELLIPSIS };
 
 	if (left != NILEXPR) {	/* in case of an error */
 		register struct type *tp = left->ex_type;
@@ -333,18 +435,6 @@ call_proto(expp)
 		struct expr **estack[NPARAMS];
 		struct proto *pstack[NPARAMS];
 
-		if (pl == NO_PROTO) {
-			register struct idf *idf;
-
-			if (left->ex_class != Value || left->VL_CLASS != Name) {
-				strict("no prototype supplied");
-			}
-			else if (! (idf = left->VL_IDF)->id_proto) {
-				strict("'%s' no prototype supplied", idf->id_text);
-				idf->id_proto++;
-			}
-		}
-
 		/* stack up the parameter expressions */
 		while (ex->ex_class == Oper && ex->OP_OPER == PARCOMMA) {
 			if (ecnt == STDC_NPARAMS)
@@ -362,7 +452,7 @@ call_proto(expp)
 		/*	Declarations like int f(void) do not expect any
 			parameters.
 		*/
-		if (pl && pl->pl_flag == VOID) {
+		if (pl && pl->pl_flag & PL_VOID) {
 			strict("no parameters expected");
 			pl = NO_PROTO;
 		}
@@ -391,17 +481,17 @@ call_proto(expp)
 				error("more parameters than specified in prototype");
 				break;
 			}
-			else if (pstack[pcnt]->pl_flag != ELLIPSIS) {
+			else if (!(pstack[pcnt]->pl_flag & PL_ELLIPSIS)) {
 				ch7cast(estack[ecnt],CASTAB,pstack[pcnt]->pl_type);
 				pcnt--;
 			} else
 				any2parameter(estack[ecnt]);
 		}
-		if (pcnt >= 0 && pstack[0]->pl_flag != ELLIPSIS)
+		if (pcnt >= 0 && !(pstack[0]->pl_flag & PL_ELLIPSIS))
 			error("less parameters than specified in prototype");
 
 	} else {
-		if (pl && pl->pl_flag != VOID)
+		if (pl && !(pl->pl_flag & PL_VOID))
 			error("less parameters than specified in prototype");
 	}
 }

lang/cem/cemcom.ansi/proto.str

@@ -9,9 +9,14 @@ struct proto {
 	struct proto *next;
 	struct type *pl_type;	/* parameter type */
 	struct idf *pl_idf;	/* parameter identifier */
-	short pl_flag;		/* ELLIPSIS or FORMAL */
+	short pl_flag;		/* see define's */
 };
 
-#define NO_PROTO	((struct proto *)0)
+#define	NO_PROTO	((struct proto *)0)
+
+#define	PL_VOID		0x01
+#define	PL_FORMAL	0x02
+#define	PL_ELLIPSIS	0x04
+#define	PL_ERRGIVEN	0x08
 
 /* ALLOCDEF "proto" 10 */

lang/cem/cemcom.ansi/replace.c

@@ -27,7 +27,9 @@
 #include	"argbuf.h"
 #include	"replace.h"
 
-struct	repl	*ReplaceList;	/* list of currently active macros */
+extern struct idf *GetIdentifier();
+extern int InputLevel;
+struct repl *ReplaceList;	/* list of currently active macros */
 
 int
 replace(idf)
@@ -38,15 +40,23 @@ replace(idf)
 		higher interface to the real thing: expand_macro().
 	*/
 	struct repl *repl;
-	int size;
 	
+	if (!(idf->id_macro)) return 0;
+	if (idf->id_macro->mc_flag & NOREPLACE){
+		return 0;
+	}
 	repl = new_repl();
 	repl->r_ptr = repl->r_text;
 	repl->r_args = new_args();
-	if (!expand_macro(repl, idf, (struct idf *)0))
+	repl->r_idf = idf;
+/* repl->r_level = InputLevel;	/* ?? temporary */
+	if (!expand_macro(repl, idf)) {
 		return 0;
-	free_args(repl->r_args);
+	}
+	InputLevel++;
 	InsertText(repl->r_text, repl->r_ptr - repl->r_text);
+	repl->r_level = InputLevel;
+	idf->id_macro->mc_flag |= NOREPLACE;
 	repl->next = ReplaceList;
 	ReplaceList = repl;
 	return 1;
@@ -54,24 +64,33 @@ replace(idf)
 
 unstackrepl()
 {
-	struct repl *repl = ReplaceList;
+	Unstacked++;
-
-#ifdef PERSONAL_TOUCH
-	if (repl == NO_REPL) {
-		print("Leendert, you don't understand the principle yet\n");
-		return;
-	}
-#else
-	ASSERT(repl != NO_REPL);
-#endif
-	ReplaceList = repl->next;
-	free_repl(repl);
 }
 
-expand_macro(repl, idf, previdf)
+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_args(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;
-	struct idf *previdf;
 {
 	/*	expand_macro() does the actual macro replacement.
 		"idf" is a description of the identifier which
@@ -85,6 +104,10 @@ expand_macro(repl, idf, previdf)
 		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;
@@ -94,44 +117,37 @@ expand_macro(repl, idf, previdf)
 		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 () */
-			/*	This is obscure. See the examples for the replace
+			/*	This is obscure. See the examples for the
-				algorithm in section 3`.8.3.5.
+				replace algorithm in section 3`.8.3.5.
 			lexwarning("macro %s needs arguments", idf->id_text);
 			*/
 			UnGetChar();
 			return 0;
 		} else
-			getactuals(args, idf);
+			getactuals(repl, idf);
 
-		if (mac->mc_flag & FUNC) {
-			struct idf *param = str2idf(args->a_rawbuf);
-
-			*repl->r_ptr++ = param->id_macro ? '1' : '0';
-			*repl->r_ptr = '\0';
-			return 1;
-		}
 	}
 
 	if (mac->mc_flag & FUNC) /* this macro leads to special action */
 		macro_func(idf);
 
-	if (mac->mc_nps == -1) {
+	macro2buffer(repl, idf, args);
-		register int size = mac->mc_length;
-		register char *text = mac->mc_text;
-
-		ASSERT((repl->r_ptr+size) < &(repl->r_text[LAPBUF]));
-		while (size-- > 0)
-			*repl->r_ptr++ = *text++;
-		*repl->r_ptr = '\0';
-	} else
-		macro2buffer(repl, idf, args);
 
 	/*	According to the ANSI definition:
 
@@ -143,23 +159,56 @@ expand_macro(repl, idf, previdf)
 		character based, we have a problem.
 		For now: just insert a space after all tokens,
 		until ANSI fixes this flaw.
+		^^^^^^^^^^^^^^^^^^^^^^^^^^	tsk tsk tsk
 	*/
-	*repl->r_ptr++ = ' ';
+	if (*repl->r_ptr != TOKSEP) *repl->r_ptr++ = TOKSEP;
 	*repl->r_ptr = '\0';
 
-	if (idf != previdf)
-		maccount(repl, idf);
 	return 1;
 }
 
-getactuals(args, idf)
+expand_defined(repl)
-	register struct args *args;
+	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 != ')') UnGetChar();
+		*repl->r_ptr++ = '0';
+		*repl->r_ptr = '\0';
+		return;
+	}
+	UnGetChar();
+	id = GetIdentifier(0);
+	ASSERT(id || class(ch) == STELL);
+	ch = GetChar();
+	ch = skipspaces(ch, 0);
+	if (parens && ch != ')') error(") missing");
+	if (!parens || ch != ')') UnGetChar();
+	*repl->r_ptr++ = (id && id->id_macro) ? '1' : '0';
+	*repl->r_ptr = '\0';
+}
+
+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;
@@ -169,12 +218,12 @@ getactuals(args, idf)
 	args->a_rawvec[0] = args->a_rawptr = &args->a_rawbuf[0];
 	if ((ch = GetChar()) != ')') {
 		PushBack();
-		while ((ch = actual(args, idf)) != ')' ) {
+		while ((ch = actual(repl)) != ')' ) {
 			if (ch != ',') {
 				lexerror("illegal macro call");
 				return;
 			}
-			stash(args, '\0');
+			stash(repl, '\0', 1);
 			++argcnt;
 			args->a_expvec[argcnt] = args->a_expptr;
 			args->a_rawvec[argcnt] = args->a_rawptr;
@@ -183,30 +232,73 @@ getactuals(args, idf)
 			if (argcnt >= NPARAMS)
 				fatal("argument vector overflow");
 		}
-		stash(args, '\0');
+		stash(repl, '\0', 1);
 		++argcnt;
 	}
 	if (argcnt < nps)
 		lexerror("too few macro arguments");
-	if (argcnt > nps)
+	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;
+	struct args *args = repl->r_args;
+	register char *p;
+
+	/* stash identifier name */
+	for (p = nrepl->r_idf->id_text; *p != '\0'; p++)
+		*args->a_rawptr++ = *p;
+
+	/*	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;
+
+		*args->a_rawptr++ = '(';
+		for (i = 0; ap->a_rawvec[i] != (char *)0; i++) {
+			for (p = ap->a_rawvec[i]; *p != '\0'; p++)
+				*args->a_rawptr++ = *p;
+			*args->a_rawptr++ = ',';
+		}
+		*(args->a_rawptr-1) = ')';	/* delete last ',' */
+	}
+}
+
 int
-actual(args, idf)
+actual(repl)
-	register struct args *args;
+	struct repl *repl;
-	register struct idf *idf;
 {
 	/*	This routine deals with the scanning of an actual parameter.
-		It keeps in account the openning and clossing brackets,
+		It keeps in account the opening and closing brackets,
 		preprocessor numbers, strings and character constants.
 	*/
 	register int ch;
-	register int level = 0;
+	register int level = 0, nostashraw = 0;
 
 	while (1) {
 		ch = GetChar();
 
+		if (Unstacked) {
+			nostashraw -= Unstacked;
+			if (nostashraw < 0) 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.
@@ -217,7 +309,12 @@ actual(args, idf)
 			register int pos = -1;
 			register int hash;
 			extern int idfsize;
-			int size;
+			int NoExpandMacro;
+
+			if (ch == NOEXPM) {
+				NoExpandMacro= 1;
+				ch = GetChar();
+			} else NoExpandMacro = 0;
 
 			hash = STARTHASH();
 			do {
@@ -235,47 +332,62 @@ actual(args, idf)
 				replacement list, it's expanded.
 			*/
 			idef = idf_hashed(buf, p - buf, hash);
-			if (idef->id_macro)	/* expand macro identifier */
+			if (NoExpandMacro || !replace(idef)) {
-				expand_actual(args, idef, idf);
+				if ((idef->id_macro
-			else
+				    && (idef->id_macro->mc_flag & NOREPLACE))
+				    || NoExpandMacro)
+					stash(repl, NOEXPM, !nostashraw);
 				for (p = buf; *p != '\0'; p++)
-					stash(args, *p);
+					stash(repl, *p, !nostashraw);
-		} else if (class(ch) == STNUM || class(ch) == '.') {
+			} else {
-			/*	preprocessor number token. No this is no joke,
+				if (!nostashraw) saveraw(repl);
-				the commitee decided (in all it's wisdom) that
+				nostashraw++;
-				a preprocessing number has the following regular
+			}
-				expression:
+		} else if (class(ch) == STNUM) {
-					[0-9"."]{[0-9"."a-zA-Z_]|{[Ee][+-]}}*
+			/*	a preprocessing number has the following
+				regular expression:
+				    [0-9|"."[0-9]]{[0-9"."a-zA-Z_]|{[Ee][+-]}}*
 			*/
-			do {
+			stash(repl, ch, !nostashraw);
-				stash(args, ch);
+			if (ch == '.') {
+				ch = GetChar();
+				if (class(ch) != STNUM) {
+					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(args, ch);
+						stash(repl, ch, !nostashraw);
 						ch = GetChar();
 					}
 				}
-			} while (class(ch) == STNUM || class(ch) == STIDF ||
+			}
-				 class(ch) == STELL || ch == '.');
 			UnGetChar();
 		} else if (ch == '(' || ch == '[' || ch == '{') {
 			/* a comma may occur within these constructions */
 			level++;
-			stash(args, ch);
+			stash(repl, ch, !nostashraw);
 		} else if (ch == ')' || ch == ']' || ch == '}') {
 			level--;
 			/* clossing parenthesis of macro call */
 			if (ch == ')' && level < 0)
 				return ')';
-			stash(args, ch);
+			stash(repl, ch, !nostashraw);
 		} else if (ch == ',') {
 			if (level <= 0) { /* comma separator for next argument */
 				if (level)
 					lexerror("unbalanced parenthesis");
-				return ',';
+				if (!nostashraw)
+					return ',';	/* ??? */
 			}
-			stash(args, ch);
+			stash(repl, ch, !nostashraw);
 		} else if (ch == '\n') {
 			/* newlines are accepted as white spaces */
 			LineNumber++;
@@ -294,16 +406,20 @@ actual(args, idf)
 			*/
 			if (ch == '#')
 				domacro();
+			else if (ch == EOI) {
+				lexerror("unterminated macro call");
+				return ')';
+			}
 			UnGetChar();
-			stash(args, ' ');
+			stash(repl, ' ', !nostashraw);
 		} else if (ch == '/') {
 			/* comments are treated as one white space token */
-			if ((ch = GetChar()) == '*') {
+			if ((ch = GetChar()) == '*' && !InputLevel) {
 				skipcomment();
-				stash(args, ' ');
+				stash(repl, ' ', !nostashraw);
 			} else {
 				UnGetChar();
-				stash(args, '/');
+				stash(repl, '/', !nostashraw);
 			}
 		} else if (ch == '\'' || ch == '"') {
 			/*	Strings are considered as ONE token, thus no
@@ -311,129 +427,28 @@ actual(args, idf)
 			*/
 			register int match = ch;
 
-			stash(args, ch);
+			stash(repl, ch, !nostashraw);
 			while ((ch = GetChar()) != EOI) {
 				if (ch == match)
 					break;
 				if (ch == '\\') {
-					stash(args, ch);
+					stash(repl, ch, !nostashraw);
 					ch = GetChar();
 				} else if (ch == '\n') {
 					lexerror("newline in string");
 					LineNumber++;
-					stash(args, match);
+					stash(repl, match, !nostashraw);
 					break;
 				}
-				stash(args, ch);
+				stash(repl, ch, !nostashraw);
 			}
 			if (ch != match) {
 				lexerror("unterminated macro call");
 				return ')';
 			}
-			stash(args, ch);
+			stash(repl, ch, !nostashraw);
 		} else
-			stash(args, ch);
+			stash(repl, ch, !nostashraw);
-	}
-}
-
-expand_actual(args, idef, idf)
-	register struct args *args;
-	register struct idf *idf, *idef;
-{
-	struct repl *nrepl = new_repl();
-	register char *p;
-
-	nrepl->r_args = new_args();
-	nrepl->r_ptr = nrepl->r_text;
-	if (expand_macro(nrepl, idef, idf)) {
-		register struct args *ap = nrepl->r_args;
-
-		for (p = nrepl->r_text; p < nrepl->r_ptr; p++)
-			*args->a_expptr++ = *p;
-
-		/* stash idef name */
-		for (p = idef->id_text; *p != '\0'; p++)
-			*args->a_rawptr++ = *p;
-
-		/*	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;
-
-			*args->a_rawptr++ = '(';
-			for (i = 0; ap->a_rawvec[i] != (char *)0; i++) {
-				for (p = ap->a_rawvec[i]; *p != '\0'; p++)
-					*args->a_rawptr++ = *p;
-				*args->a_rawptr++ = ',';
-			}
-			*--args->a_rawptr = ')';
-			++args->a_rawptr;	/* one too far */
-		}
-	} else	/* something happened during the macro expansion */
-		for (p = idef->id_text; *p != '\0'; p++)
-			stash(args, *p);
-	free_args(nrepl->r_args);
-	free_repl(nrepl);
-}
-
-maccount(repl, idf)
-	register struct repl *repl;
-	register struct idf *idf;
-{
-	/*	To prevent re-expansion of already expanded macro's we count
-		the occurrences of the currently expanded macro name in the
-		replacement list. This is mainly to prevent recursion as in:
-
-			#define	f(a)	f(2 * (a))
-			f(y+1);
-
-		This results in:
-
-			f(2*(y+1));
-
-		When reading the inserted text we decrement the count of a
-		macro name until it's zero. Then we start expanding it again.
-	*/
-	register char *text = repl->r_text;
-	register int pos = -1;
-	extern int idfsize;
-
-	while (*text != '\0') {
-		if (*text == '\'' || *text == '"') {
-			register int delim;
-
-			for (delim = *text++; *text != delim; text++)
-				if (*text == '\\')
-					text++;
-			text++;
-		} else
-		if (class(*text) == STIDF || class(*text) == STELL) {
-			char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 1];
-			register char *p = buf;
-
-			do {
-				if (++pos < idfsize)
-					*p++ = *text;
-				text++;
-			} while (in_idf(*text));
-			*p++ = '\0';
-
-			if (!strcmp(idf->id_text, buf))
-				idf->id_macro->mc_count++;
-		} else
-			text++;
 	}
 }
 
@@ -459,7 +474,7 @@ macro_func(idef)
 		break;
 	case 'L':			/* __LINE__	*/
 		mac->mc_text = long2str((long)LineNumber, 10);
-		mac->mc_length = 1;
+		mac->mc_length = strlen(mac->mc_text);
 		break;
 	default:
 		crash("(macro_func)");
@@ -499,98 +514,124 @@ macro2buffer(repl, idf, args)
 		smarter should be done (but even a DFA is O(|s|)).
 	*/
 	register char *ptr = idf->id_macro->mc_text;
+	register char *tmpptr;
+	int err = 0;
 	char *stringify();
 
 	while (*ptr) {
-		ASSERT(repl->r_ptr < &(repl->r_text[LAPBUF]));
+	    ASSERT(repl->r_ptr < &(repl->r_text[LAPBUF]));
-		if (*ptr == '\'' || *ptr == '"') {
+	    if (*ptr == '\'' || *ptr == '"') {
-			register int delim = *ptr;
+		register int delim = *ptr;
 
-			do {
+		do {
-				*repl->r_ptr++ = *ptr;
+		    *repl->r_ptr++ = *ptr;
-				if (*ptr == '\\')
+		    if (*ptr == '\\')
-					*repl->r_ptr++ = *++ptr;
+			    *repl->r_ptr++ = *++ptr;
-				if (*ptr == '\0') {
+		    if (*ptr == '\0') {
-					lexerror("unterminated string");
+			    lexerror("unterminated string");
-					*repl->r_ptr = '\0';
+			    *repl->r_ptr = '\0';
-					return;
+			    return;
-				}
+		    }
-				ptr++;
+		    ptr++;
-			} while (*ptr != delim || *ptr == '\0');
+		} while (*ptr != delim || *ptr == '\0');
-			*repl->r_ptr++ = *ptr++;
+		*repl->r_ptr++ = *ptr++;
-		} else if (*ptr == '#') {
+	    } else if (*ptr == '#') {
-			if (*++ptr == '#') {
+		if (*++ptr == '#') {
-				/* ## - paste operator */
+			/* ## - paste operator */
-				ptr++;
+		    ptr++;
 
-				/* trim the actual replacement list */
+			/* trim the actual replacement list */
-				--repl->r_ptr;
+		    --repl->r_ptr;
-				while (is_wsp(*repl->r_ptr) &&
+		    while (is_wsp(*repl->r_ptr)
-				       repl->r_ptr >= repl->r_text)
+				&& repl->r_ptr >= repl->r_text)
-					--repl->r_ptr;
+			    --repl->r_ptr;
 
-				/*	## occurred at the beginning of the
+		    /*	## occurred at the beginning of the
-					replacement list.
+			    replacement list.
-				*/
+		    */
-				if (repl->r_ptr == repl->r_text)
+		    if (repl->r_ptr == repl->r_text
-					goto paste;
+				&& is_wsp(*repl->r_ptr)) {
-				++repl->r_ptr;
+			    err = 1;
+			    break;
+		    }
 
-				/* skip space in macro replacement list */
+		    while(*repl->r_ptr == TOKSEP
-				while ((*ptr & FORMALP) == 0 && is_wsp(*ptr))
+				&& repl->r_ptr >= repl->r_text)
-					ptr++;
+			    --repl->r_ptr;
 
-				/*	## occurred at the end of the
+		    tmpptr = repl->r_ptr;
-					replacement list.
+		    ++repl->r_ptr;
-				*/
+
-				if (*ptr & FORMALP) {
+		    /* skip space in macro replacement list */
-					register int n = *ptr++ & 0177;
+		    while ((*ptr & FORMALP) == 0 && is_wsp(*ptr))
-					register char *p;
+			    ptr++;
-					
+
-					ASSERT(n != 0);
+		    /*	## occurred at the end of the replacement list.
-					p = args->a_rawvec[n-1];
+		    */
-					while (is_wsp(*p))
+		    if (*ptr & FORMALP) {
-						p++;
-					while (*p)
-						*repl->r_ptr++ = *p++;
-				} else if (*ptr == '\0')
-					goto paste;
-			} else
-				ptr = stringify(repl, ptr, args);
-		} else if (*ptr & FORMALP) {
-			/* insert actual parameter */
 			register int n = *ptr++ & 0177;
-			register char *p, *q;
+			register char *p;
-			
-			ASSERT(n != 0);
 
-			/*	This is VERY dirty, we look ahead for the
+			ASSERT(n > 0);
-				## operater. If it's found we use the raw
+			p = args->a_rawvec[n-1];
-				argument buffer instead of the expanded
+			if (p) {	/* else macro argument missing */
-				one.
+			    while (is_wsp(*p))
-			*/
+				p++;
-			for (p = ptr; (*p & FORMALP) == 0 && is_wsp(*p); p++)
+			    if (*p == NOEXPM) p++;
-				/* VOID */;
+			    while (*p)
-			if (*p == '#' && p[1] == '#')
+				*repl->r_ptr++ = *p++;
-				q = args->a_rawvec[n-1];
+			}
-			else
+			if (in_idf(*tmpptr + 1)) {
-				q = args->a_expvec[n-1];
+				while (in_idf(*tmpptr)
-
+					    && tmpptr >= repl->r_text)
-			while (*q)
+					tmpptr--;
-				*repl->r_ptr++ = *q++;
+				if (*tmpptr == NOEXPM) *tmpptr = TOKSEP;
-
+			}
-			*repl->r_ptr++ = ' ';
+		    } else if (*ptr == '\0') {
+			    err = 1;
+			    break;
+		    } else {
+			    if (in_idf(*ptr)) {
+				while (in_idf(*tmpptr)
+					    && tmpptr >= repl->r_text)
+					tmpptr--;
+				if (*tmpptr == NOEXPM) *tmpptr = TOKSEP;
+			    }
+		    }
 		} else
-			*repl->r_ptr++ = *ptr++;
+		    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
+			## operater. 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];
+
+		p = repl->r_ptr;
+		if (q)			/* else macro argument missing */
+		    while (*q)
+			*repl->r_ptr++ = *q++;
+
+		if (*repl->r_ptr != TOKSEP)
+			*repl->r_ptr++ = TOKSEP;
+	    } else
+		*repl->r_ptr++ = *ptr++;
 	}
 	*repl->r_ptr = '\0';
-	return;
+	if (err)
-
+		lexerror("illegal use of the ## operator");
-paste:
-	/*	Sorry, i know this looks a bit like
-		a unix device driver code.
-	*/
-	lexerror("illegal use of the ## operator");
 	return;
 }
 
@@ -625,7 +666,7 @@ stringify(repl, ptr, args)
 		register char *p;
 		
 		ASSERT(n != 0);
-		p = args->a_expvec[n-1];
+		p = args->a_rawvec[n-1];
 		*repl->r_ptr++ = '"';
 		while (*p) {
 			if (is_wsp(*p)) {
@@ -645,7 +686,8 @@ stringify(repl, ptr, args)
 			backslash = *p == '\\';
 			if (*p == '"' || (delim && *p == '\\'))
 				*repl->r_ptr++ = '\\';
-			*repl->r_ptr++ = *p++;
+			if (*p == TOKSEP || *p == NOEXPM) p++;
+			else *repl->r_ptr++ = *p++;
 		}
 
 		/* trim spaces in the replacement list */
@@ -658,20 +700,23 @@ stringify(repl, ptr, args)
 	return ptr;
 }
 
-stash(args, ch)
+stash(repl, ch, stashraw)
-	register struct args *args;
+	struct repl *repl;
 	register int ch;
+	int stashraw;
 {
 	/*	Stash characters into the macro expansion buffer.
 	*/
+	register struct args *args = repl->r_args;
+
 	if (args->a_expptr >= &(args->a_expbuf[ARGBUF]))
 		fatal("macro argument buffer overflow");
 	*args->a_expptr++ = ch;
 
-	if (args->a_rawptr >= &(args->a_rawbuf[ARGBUF]))
+	if (stashraw) {
-		fatal("raw macro argument buffer overflow");
+		if (args->a_rawptr >= &(args->a_rawbuf[ARGBUF]))
-	*args->a_rawptr++ = ch;
+			fatal("raw macro argument buffer overflow");
-
+		*args->a_rawptr++ = ch;
-			
+	}
 }
 #endif NOPP

lang/cem/cemcom.ansi/replace.str

@@ -1,8 +1,10 @@
 struct repl {
 	struct	repl *next;
+	struct	idf *r_idf;		/* name of the macro */
 	struct	args *r_args;		/* replacement parameters */
-	char	r_text[LAPBUF];		/* replacement text */
+	int	r_level;		/* level of insertion */
 	char	*r_ptr;			/* replacement text pointer */
+	char	r_text[LAPBUF];		/* replacement text */
 };
 
 /* ALLOCDEF "repl" 4 */

lang/cem/cemcom.ansi/scan.c

@@ -166,7 +166,7 @@ copyact(ch1, ch2, lvl)
 		case '/':
 			LoadChar(ch);
 
-			if (ch == '*')	{	/* skip comment	*/
+			if (ch == '*' && !InputLevel)	{	/* skip comment	*/
 				skipcomment();
 				continue;
 			}

lang/cem/cemcom.ansi/sizes.h

@@ -5,16 +5,13 @@
 /* $Header$ */
 /* VARIOUS TARGET MACHINE SIZE DESCRIPTORS */
 
-#include "nofloat.h"
 #include "nocross.h"
 #include "target_sizes.h"
 
 #ifndef NOCROSS
 extern arith
 	short_size, word_size, dword_size, int_size, long_size,
-#ifndef NOFLOAT
 	float_size, double_size, lngdbl_size,
-#endif NOFLOAT
 	pointer_size;
 #else NOCROSS
 #define short_size	(SZ_SHORT)
@@ -22,11 +19,9 @@ extern arith
 #define dword_size	(2*SZ_WORD)
 #define int_size	(SZ_INT)
 #define long_size	(SZ_LONG)
-#ifndef NOFLOAT
 #define float_size	(SZ_FLOAT)
 #define double_size	(SZ_DOUBLE)
 #define	lngdbl_size	(SZ_LNGDBL)
-#endif NOFLOAT
 #define pointer_size	(SZ_POINTER)
 #endif NOCROSS
 

lang/cem/cemcom.ansi/skip.c

@@ -12,6 +12,8 @@
 #include	"input.h"
 
 #ifndef NOPP
+extern int InputLevel;
+
 int
 skipspaces(ch, skipnl)
 	register int ch;
@@ -19,12 +21,19 @@ skipspaces(ch, skipnl)
 	/*	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;
+			LineNumber++;
+			nlseen++;
+			continue;
+		}
+		if (ch == TOKSEP && InputLevel) {
+			ch = GetChar();
 			continue;
 		}
 
@@ -32,7 +41,7 @@ skipspaces(ch, skipnl)
 
 		if (ch == '/') {
 			ch = GetChar();
-			if (ch == '*') {
+			if (ch == '*' && !InputLevel) {
 				skipcomment();
 				ch = GetChar();
 			}
@@ -41,7 +50,10 @@ skipspaces(ch, skipnl)
 				return '/';
 			}
 		}
-		else
+		else if(nlseen && ch == '#') {
+			domacro();
+			ch = GetChar();
+		} else
 			return ch;
 	}
 }
@@ -53,10 +65,9 @@ SkipToNewLine(garbage)
 	register int ch;
 	register int pstrict = 0;
 
-	UnGetChar();
 	while ((ch = GetChar()) != '\n') {
 		if (ch == '/') {
-			if ((ch = GetChar()) == '*') {
+			if ((ch = GetChar()) == '*' && !InputLevel) {
 				skipcomment();
 				continue;
 			}

lang/cem/cemcom.ansi/stack.c

@@ -6,7 +6,6 @@
 /*	S T A C K / U N S T A C K  R O U T I N E S	*/
 
 #include	"lint.h"
-#include	"nofloat.h"
 #include	<system.h>
 #include	<em.h>
 #include	"debug.h"
@@ -21,7 +20,6 @@
 #include	"struct.h"
 #include	"level.h"
 #include	"mes.h"
-#include	"noRoption.h"
 
 /* #include	<em_reg.h> */
 
@@ -84,8 +82,9 @@ stack_level_of(lvl)
 		return local_level;
 	stl = &UniversalLevel;
 		
-	while (stl->sl_level != lvl)
+	while (stl->sl_level != lvl) {
 		stl = stl->sl_next;
+	}
 	return stl;
 }
 
@@ -214,25 +213,18 @@ unstack_world()
 			def->df_sc = EXTERN;
 		*/
 		
-		if (	def->df_sc == STATIC
+		if (def->df_sc == STATIC
-			&& def->df_type->tp_fund == FUNCTION
+		    && def->df_type->tp_fund == FUNCTION
-			&& !def->df_initialized
+		    && !def->df_initialized) {
-		)	{
 			/* orphaned static function */
-#ifndef NOROPTION
+			warning("static function %s never defined, %s"
-			if (options['R'])
+				    , idf->id_text
-				warning("static function %s never defined, %s",
+				    , "changed to extern");
-					idf->id_text,
-					"changed to extern"
-				);
-#endif
 			def->df_sc = EXTERN;
 		}
 		
-		if (
+		if (def->df_alloc == ALLOC_SEEN
-			def->df_alloc == ALLOC_SEEN &&
+		    && !def->df_initialized) {
-			!def->df_initialized
-		)	{
 			/* space must be allocated */
 			bss(idf);
 			if (def->df_sc != STATIC)

lang/cem/cemcom.ansi/statement.g

@@ -12,6 +12,7 @@
 #include	"debug.h"
 #include	"botch_free.h"
 
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"LLlex.h"
 #include	"type.h"
@@ -29,12 +30,12 @@
 extern int level;
 }
 
-/*	Each statement construction is stacked in order to trace a
+/* Each statement construction is stacked in order to trace a
-	statement to such a construction. Example: a case statement should
+ * statement to such a construction. Example: a case statement should
-	be recognized as a piece of the most enclosing switch statement.
+ * be recognized as a piece of the most enclosing switch statement.
-*/
+ */
 
-/* 9 */
+/* 3.6 */
 statement
 	{
 #ifdef	LINT
@@ -104,9 +105,9 @@ expression_statement
 		}
 ;
 
+/* 3.6.1 (partially) */
 label
-	{	struct idf *idf;
+	{ struct idf *idf; }
-	}
 :
 	identifier(&idf)
 	{
@@ -125,6 +126,7 @@ label
 	}
 ;
 
+/* 3.6.4.1 */
 if_statement
 	{
 		struct expr *expr;
@@ -186,6 +188,7 @@ if_statement
 	]
 ;
 
+/* 3.6.5.3 */
 while_statement
 	{
 		struct expr *expr;
@@ -233,6 +236,7 @@ while_statement
 		}
 ;
 
+/* 3.6.5.2 */
 do_statement
 	{	struct expr *expr;
 		label l_break = text_label();
@@ -279,6 +283,7 @@ do_statement
 		}
 ;
 
+/* 3.6.5.3 */
 for_statement
 	{	struct expr *e_init = 0, *e_test = 0, *e_incr = 0;
 		label l_break = text_label();
@@ -350,6 +355,7 @@ for_statement
 		}
 ;
 
+/* 3.6.4.2 */
 switch_statement
 	{
 		struct expr *expr;
@@ -375,6 +381,7 @@ switch_statement
 		}
 ;
 
+/* 3.6.1 (partially) */
 case_statement
 	{
 		struct expr *expr;
@@ -393,6 +400,7 @@ case_statement
 	statement
 ;
 
+/* 3.6.1 (partially) */
 default_statement
 :
 	DEFAULT
@@ -406,6 +414,7 @@ default_statement
 	statement
 ;
 
+/* 3.6.6.4 */
 return_statement
 	{	struct expr *expr = 0;
 	}
@@ -436,6 +445,7 @@ return_statement
 	';'
 ;
 
+/* 3.6.6.1 (partially) */
 jump
 	{	struct idf *idf;
 	}
@@ -452,6 +462,7 @@ jump
 		}
 ;
 
+/* 3.6.2 */
 compound_statement:
 	'{'
 		{

lang/cem/cemcom.ansi/struct.c

@@ -23,7 +23,6 @@
 #include	"level.h"
 #include	"assert.h"
 #include	"sizes.h"
-#include	"noRoption.h"
 
 /*	Type of previous selector declared with a field width specified,
 	if any.  If a selector is declared with no field with it is set to 0.
@@ -78,14 +77,6 @@ add_sel(stp, tp, idf, sdefpp, szp, fd)	/* this is horrible */
 	register struct sdef *newsdef;
 	int lvl = tg->tg_level;
 	
-#ifndef NOROPTION
-	if (options['R'] && !is_anon_idf(idf))	{
-		/* a K & R test */
-		if (idf->id_struct && idf->id_struct->tg_level == level)
-			warning("%s is also a struct/union tag", idf->id_text);
-	}
-#endif
-
 	if (stp->tp_fund == STRUCT)	{
 #ifndef NOBITFIELD
 		if (fd == 0)	{	/* no field width specified	*/
@@ -105,24 +96,11 @@ add_sel(stp, tp, idf, sdefpp, szp, fd)	/* this is horrible */
 #endif NOBITFIELD
 	}
 	else	{	/* (stp->tp_fund == UNION)		*/
-		if (fd)	{
+		if (fd) offset = add_field(szp, fd, &tp, idf, stp);
-			error("fields not allowed in unions");
-			free_field(fd);
-			fd = 0;
-		}
 		offset = (arith)0;
 	}
 	
 	check_selector(idf, stp);
-#ifndef NOROPTION
-	if (options['R'])	{
-		if (	sdef && sdef->sd_level == lvl &&
-			( sdef->sd_offset != offset ||
-			  !equal_type(sdef->sd_type, tp))
-		)				/* RM 8.5 */
-			warning("selector %s redeclared", idf->id_text);
-	}
-#endif
 
 	newsdef = new_sdef();
 	newsdef->sd_sdef = (struct sdef *) 0;
@@ -159,7 +137,10 @@ add_sel(stp, tp, idf, sdefpp, szp, fd)	/* this is horrible */
 		stp->tp_align = lcm(stp->tp_align, tp->tp_align);
 	}
 	else
-	if (stp->tp_fund == UNION)	{
+	if (stp->tp_fund == UNION && fd == 0)	{
+		/*	Note: the case that a bitfield is declared is
+			handled by add_field() !
+		*/
 		arith sel_size = size_of_type(tp, "member");
 
 		if (*szp < sel_size)
@@ -198,47 +179,29 @@ declare_struct(fund, idf, tpp)
 	register struct tag **tgp;
 	register struct tag *tg;
 
+
 	if (!idf)
 		idf = gen_idf();
 	tgp = (fund == ENUM ? &idf->id_enum : &idf->id_struct);
-	
-#ifndef NOROPTION
-	if (options['R'] && !is_anon_idf(idf))	{
-		/* a K & R test */
-		if (	fund != ENUM &&
-			idf->id_sdef && idf->id_sdef->sd_level == level
-		)	{
-			warning("%s is also a selector", idf->id_text);
-		}
-		if (	fund == ENUM &&
-			idf->id_def && idf->id_def->df_level == level
-		)	{
-			warning("%s is also a variable", idf->id_text);
-		}
-	}
-#endif
-	
 	tg = *tgp;
-	if (tg && tg->tg_type->tp_size < 0 && tg->tg_type->tp_fund == fund) {
+	if (tg
-		/*	An unfinished declaration has preceded it, possibly on
+	    && tg->tg_type->tp_size < 0
-			an earlier level.  We just fill in the answer.
+	    && tg->tg_type->tp_fund == fund
-		*/
+	    && tg->tg_level == level) {
+		/*	An unfinished declaration has preceded it.
+			We just fill in the answer.
+		 */
 		if (tg->tg_busy) {
 			error("recursive declaration of struct/union %s",
 				idf->id_text);
 			declare_struct(fund, gen_idf(), tpp);
 		}
 		else {
-#ifndef NOROPTION
+			/* hint: if (level <= L_PROTO) */
-			if (options['R'] && tg->tg_level != level)
-				warning("%s declares %s in different range",
-					idf->id_text, symbol2str(fund));
-#endif
 			*tpp = tg->tg_type;
 		}
 	}
-	else
+	else if (tg && tg->tg_level == level && tg->tg_type->tp_size >= 0)	{
-	if (tg && tg->tg_level == level)	{
 		/*	There is an already defined struct/union of this name
 			on our level!
 		*/
@@ -307,15 +270,7 @@ idf2sdef(idf, tp)
 	/* Tp not met; any unique identification will do. */
 	if (sdef = idf->id_sdef)	{
 		/* There is an identification */
-		if (uniq_selector(sdef))	{
+		error("illegal use of selector %s", idf->id_text);
-			/* and it is unique, so we accept */
-			warning("selector %s applied to alien type",
-					idf->id_text);
-		}
-		else	{
-			/* it is ambiguous */
-			error("ambiguous use of selector %s", idf->id_text);
-		}
 		return sdef;
 	}
 	
@@ -328,6 +283,7 @@ idf2sdef(idf, tp)
 	return sdef;
 }
 
+#if	0
 int
 uniq_selector(idf_sdef)
 	register struct sdef *idf_sdef;
@@ -352,6 +308,7 @@ uniq_selector(idf_sdef)
 	}
 	return 1;
 }
+#endif
 
 #ifndef NOBITFIELD
 arith
@@ -365,8 +322,7 @@ add_field(szp, fd, fdtpp, idf, stp)
 	/*	The address where this selector is put is returned. If the
 		selector with specified width does not fit in the word, or
 		an explicit alignment is given, a new address is needed.
-		Note that the fields are packed into machine words (according
+		Note that the fields are packed into machine words.
-		to the RM.)
 	*/
 	long bits_in_type = word_size * 8;
 	static int field_offset = (arith)0;
@@ -392,9 +348,10 @@ add_field(szp, fd, fdtpp, idf, stp)
 	switch ((*fdtpp)->tp_fund)	{
 	case CHAR:
 	case SHORT:
-	case INT:
 	case ENUM:
 	case LONG:
+		strict("non-portable field type");
+	case INT:
 		/* right type; size OK? */
 		if ((*fdtpp)->tp_size > word_size) {
 			error("bit field type %s does not fit in a word",
@@ -461,6 +418,8 @@ add_field(szp, fd, fdtpp, idf, stp)
 	else			/* adjust the field at the left		*/
 		fd->fd_shift = bits_in_type - bits_declared;
 	
+	if (stp->tp_fund == UNION) bits_declared = (arith)0;
+
 	return field_offset;
 }
 #endif NOBITFIELD

lang/cem/cemcom.ansi/switch.c

@@ -5,7 +5,6 @@
 /* $Header$ */
 /*	S W I T C H - S T A T E M E N T  A D M I N I S T R A T I O N	*/
 
-#include	"nofloat.h"
 #include	<em.h>
 #include	"debug.h"
 #include	"botch_free.h"
@@ -14,13 +13,14 @@
 #include	"Lpars.h"
 #include	"idf.h"
 #include	"label.h"
+#include	<flt_arith.h>
 #include	"arith.h"
 #include	"switch.h"
 #include	"code.h"
 #include	"assert.h"
 #include	"expr.h"
 #include	"type.h"
-#include	"noRoption.h"
+#include	"sizes.h"
 
 extern char options[];
 
@@ -39,9 +39,10 @@ compact(nr, low, up)
 static struct switch_hdr *switch_stack = 0;
 
 /* (EB 86.05.20) The following rules hold for switch statements:
-	- the expression E in "switch(E)" is cast to 'int' (RM 9.7)
+	- the expression E in "switch(E)" shall have integral type (3.6.4.2)
-	- the expression E in "case E:" must be 'int' (RM 9.7)
+	- the expression E in "case E:" is converted to the promoted type
-	- the values in the CSA/CSB tables are words (EM 7.4)
+					of the controlling expression
+	- the values in the CSA/CSB tables are words (EM 7.4) (??? JvE)
 	For simplicity, we suppose int_size == word_size.
 */
 
@@ -54,22 +55,21 @@ code_startswitch(expp)
 	register label l_table = text_label();
 	register label l_break = text_label();
 	register struct switch_hdr *sh = new_switch_hdr();
-	int fund = any2arith(expp, SWITCH);	/* INT, LONG or DOUBLE */
+	int fund = any2arith(expp, SWITCH);
+				    /* INT, LONG, FLOAT, DOUBLE or LNGDBL */
 	
 	switch (fund) {
 	case LONG:
-#ifndef NOROPTION
+		if (long_size > int_size)
-		if (options['R'])
+			warning("can't switch on longs (cast to int)");
-			warning("long in switch (cast to int)");
-#endif
 		int2int(expp, int_type);
 		break;
-#ifndef NOFLOAT
+	case FLOAT:
 	case DOUBLE:
-		error("float/double in switch");
+	case LNGDBL:
+		error("floating point type in switch");
 		erroneous2int(expp);
 		break;
-#endif NOFLOAT
 	}
 	stack_stmt(l_break, NO_LABEL);
 	sh->sh_break = l_break;

lang/cem/cemcom.ansi/type.c

@@ -5,7 +5,6 @@
 /* $Header$ */
 /*	T Y P E   D E F I N I T I O N   M E C H A N I S M	 */
 
-#include	"nofloat.h"
 #include	"nobitfield.h"
 #include	"botch_free.h"
 #include	<alloc.h>
@@ -28,14 +27,12 @@ extern struct type *field_of();
 	line parameters.
 */
 struct type
-	*char_type, *uchar_type,
+	*schar_type, *uchar_type,
 	*short_type, *ushort_type,
 	*word_type, *uword_type,
 	*int_type, *uint_type,
 	*long_type, *ulong_type,
-#ifndef NOFLOAT
 	*float_type, *double_type, *lngdbl_type,
-#endif NOFLOAT
 	*void_type, *gen_type, *label_type,
 	*string_type, *funint_type, *error_type;
 
@@ -56,6 +53,19 @@ create_type(fund)
 	return ntp;
 }
 
+struct type *
+promoted_type(tp)
+struct type *tp;
+{
+	if (tp->tp_fund == CHAR || tp->tp_fund == SHORT) {
+		if (tp->tp_unsigned == UNSIGNED && tp->tp_size == int_size)
+			return uint_type;
+		else return int_type;
+	} else if (tp->tp_fund == FLOAT)
+		return double_type;
+	else return tp;
+}
+
 struct type *
 construct_type(fund, tp, qual, count, pl)
 	register struct type *tp;
@@ -123,8 +133,19 @@ function_of(tp, pl, qual)
 	register struct type *dtp = tp->tp_function;
 
 	/* look for a type with the right qualifier */
+#if 0
+/* the code doesn't work in the following case:
+	int func();
+	int func(int a, int b) { return q(a); }
+   because updating the type works inside the data-structures for that type
+   thus, a new type is created for very function. This may change in the
+   future, when declarations with empty parameter lists become obsolete.
+*/
 	while (dtp && (dtp->tp_typequal != qual || dtp->tp_proto != pl))
 		dtp = dtp->next;
+#else
+	dtp = 0;
+#endif
 
 	if (!dtp)	{
 		dtp = create_type(FUNCTION);

lang/cem/cemcom.ansi/type.str

@@ -5,7 +5,6 @@
 /* $Header$ */
 /* TYPE DESCRIPTOR */
 
-#include	"nofloat.h"
 #include	"nobitfield.h"
 
 struct type	{
@@ -23,6 +22,7 @@ struct type	{
 	struct type *tp_pointer;/* to POINTER */
 	struct type *tp_array;	/* to ARRAY */
 	struct proto *tp_proto;	/* prototype list */
+	struct proto *tp_pseudoproto;	/* pseudo prototype list */
 	struct type *tp_function;/* to FUNCTION */
 };
 
@@ -30,26 +30,24 @@ struct type	{
 /*	Type qualifiers. Note: TQ_VOLATILE and TQ_CONST can be
 	'ored' to specify: extern const volatile int a;
 */
-#define	TQ_VOLATILE	01
+#define	TQ_VOLATILE	0x01
-#define	TQ_CONST	02
+#define	TQ_CONST	0x02
 
 extern struct type
 	*create_type(), *standard_type(), *construct_type(), *pointer_to(),
-	*array_of(), *function_of();
+	*array_of(), *function_of(), *promoted_type();
 
 #ifndef NOBITFIELD
 extern struct type *field_of();
 #endif NOBITFIELD
 
 extern struct type
-	*char_type, *uchar_type,
+	*schar_type, *uchar_type,
 	*short_type, *ushort_type,
 	*word_type, *uword_type,
 	*int_type, *uint_type,
 	*long_type, *ulong_type,
-#ifndef NOFLOAT
 	*float_type, *double_type, *lngdbl_type,
-#endif NOFLOAT
 	*void_type, *gen_type, *label_type,
 	*string_type, *funint_type, *error_type;