Add bootstrap and master make files.

bootstrap/unix-44/OPS.c

@@ -0,0 +1,623 @@
+/* voc  1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */
+#include "SYSTEM.h"
+#include "OPM.h"
+
+typedef
+	CHAR OPS_Name[256];
+
+typedef
+	CHAR OPS_String[256];
+
+
+export OPS_Name OPS_name;
+export OPS_String OPS_str;
+export INTEGER OPS_numtyp;
+export LONGINT OPS_intval;
+export REAL OPS_realval;
+export LONGREAL OPS_lrlval;
+static CHAR OPS_ch;
+
+
+export void OPS_Get (SHORTINT *sym);
+static void OPS_Identifier (SHORTINT *sym);
+export void OPS_Init (void);
+static void OPS_Number (void);
+static void OPS_Str (SHORTINT *sym);
+static void OPS_err (INTEGER n);
+
+
+static void OPS_err (INTEGER n)
+{
+	OPM_err(n);
+}
+
+static void OPS_Str (SHORTINT *sym)
+{
+	INTEGER i;
+	CHAR och;
+	i = 0;
+	och = OPS_ch;
+	for (;;) {
+		OPM_Get(&OPS_ch);
+		if (OPS_ch == och) {
+			break;
+		}
+		if (OPS_ch < ' ') {
+			OPS_err(3);
+			break;
+		}
+		if (i == 255) {
+			OPS_err(241);
+			break;
+		}
+		OPS_str[i] = OPS_ch;
+		i += 1;
+	}
+	OPM_Get(&OPS_ch);
+	OPS_str[i] = 0x00;
+	OPS_intval = i + 1;
+	if (OPS_intval == 2) {
+		*sym = 35;
+		OPS_numtyp = 1;
+		OPS_intval = (int)OPS_str[0];
+	} else {
+		*sym = 37;
+	}
+}
+
+static void OPS_Identifier (SHORTINT *sym)
+{
+	INTEGER i;
+	i = 0;
+	do {
+		OPS_name[i] = OPS_ch;
+		i += 1;
+		OPM_Get(&OPS_ch);
+	} while (!(((OPS_ch < '0' || ('9' < OPS_ch && __CAP(OPS_ch) < 'A')) || 'Z' < __CAP(OPS_ch)) || i == 256));
+	if (i == 256) {
+		OPS_err(240);
+		i -= 1;
+	}
+	OPS_name[i] = 0x00;
+	*sym = 38;
+}
+
+static struct Number__6 {
+	struct Number__6 *lnk;
+} *Number__6_s;
+
+static INTEGER Ord__7 (CHAR ch, BOOLEAN hex);
+static LONGREAL Ten__9 (INTEGER e);
+
+static LONGREAL Ten__9 (INTEGER e)
+{
+	LONGREAL _o_result;
+	LONGREAL x, p;
+	x = (LONGREAL)1;
+	p = (LONGREAL)10;
+	while (e > 0) {
+		if (__ODD(e)) {
+			x = x * p;
+		}
+		e = __ASHR(e, 1);
+		if (e > 0) {
+			p = p * p;
+		}
+	}
+	_o_result = x;
+	return _o_result;
+}
+
+static INTEGER Ord__7 (CHAR ch, BOOLEAN hex)
+{
+	INTEGER _o_result;
+	if (ch <= '9') {
+		_o_result = (int)ch - 48;
+		return _o_result;
+	} else if (hex) {
+		_o_result = ((int)ch - 65) + 10;
+		return _o_result;
+	} else {
+		OPS_err(2);
+		_o_result = 0;
+		return _o_result;
+	}
+	__RETCHK;
+}
+
+static void OPS_Number (void)
+{
+	INTEGER i, m, n, d, e;
+	CHAR dig[24];
+	LONGREAL f;
+	CHAR expCh;
+	BOOLEAN neg;
+	struct Number__6 _s;
+	_s.lnk = Number__6_s;
+	Number__6_s = &_s;
+	i = 0;
+	m = 0;
+	n = 0;
+	d = 0;
+	for (;;) {
+		if (('0' <= OPS_ch && OPS_ch <= '9') || (((d == 0 && 'A' <= OPS_ch)) && OPS_ch <= 'F')) {
+			if (m > 0 || OPS_ch != '0') {
+				if (n < 24) {
+					dig[n] = OPS_ch;
+					n += 1;
+				}
+				m += 1;
+			}
+			OPM_Get(&OPS_ch);
+			i += 1;
+		} else if (OPS_ch == '.') {
+			OPM_Get(&OPS_ch);
+			if (OPS_ch == '.') {
+				OPS_ch = 0x7f;
+				break;
+			} else if (d == 0) {
+				d = i;
+			} else {
+				OPS_err(2);
+			}
+		} else {
+			break;
+		}
+	}
+	if (d == 0) {
+		if (n == m) {
+			OPS_intval = 0;
+			i = 0;
+			if (OPS_ch == 'X') {
+				OPM_Get(&OPS_ch);
+				OPS_numtyp = 1;
+				if (n <= 2) {
+					while (i < n) {
+						OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1);
+						i += 1;
+					}
+				} else {
+					OPS_err(203);
+				}
+			} else if (OPS_ch == 'H') {
+				OPM_Get(&OPS_ch);
+				OPS_numtyp = 2;
+				if (n <= 8) {
+					if ((n == 8 && dig[0] > '7')) {
+						OPS_intval = -1;
+					}
+					while (i < n) {
+						OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1);
+						i += 1;
+					}
+				} else {
+					OPS_err(203);
+				}
+			} else {
+				OPS_numtyp = 2;
+				while (i < n) {
+					d = Ord__7(dig[i], 0);
+					i += 1;
+					if (OPS_intval <= __DIV(2147483647 - (LONGINT)d, 10)) {
+						OPS_intval = OPS_intval * 10 + (LONGINT)d;
+					} else {
+						OPS_err(203);
+					}
+				}
+			}
+		} else {
+			OPS_err(203);
+		}
+	} else {
+		f = (LONGREAL)0;
+		e = 0;
+		expCh = 'E';
+		while (n > 0) {
+			n -= 1;
+			f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10;
+		}
+		if (OPS_ch == 'E' || OPS_ch == 'D') {
+			expCh = OPS_ch;
+			OPM_Get(&OPS_ch);
+			neg = 0;
+			if (OPS_ch == '-') {
+				neg = 1;
+				OPM_Get(&OPS_ch);
+			} else if (OPS_ch == '+') {
+				OPM_Get(&OPS_ch);
+			}
+			if (('0' <= OPS_ch && OPS_ch <= '9')) {
+				do {
+					n = Ord__7(OPS_ch, 0);
+					OPM_Get(&OPS_ch);
+					if (e <= __DIV(32767 - n, 10)) {
+						e = e * 10 + n;
+					} else {
+						OPS_err(203);
+					}
+				} while (!(OPS_ch < '0' || '9' < OPS_ch));
+				if (neg) {
+					e = -e;
+				}
+			} else {
+				OPS_err(2);
+			}
+		}
+		e -= (i - d) - m;
+		if (expCh == 'E') {
+			OPS_numtyp = 3;
+			if ((-37 < e && e <= 38)) {
+				if (e < 0) {
+					OPS_realval = (f / (LONGREAL)Ten__9(-e));
+				} else {
+					OPS_realval = (f * Ten__9(e));
+				}
+			} else {
+				OPS_err(203);
+			}
+		} else {
+			OPS_numtyp = 4;
+			if ((-307 < e && e <= 308)) {
+				if (e < 0) {
+					OPS_lrlval = f / (LONGREAL)Ten__9(-e);
+				} else {
+					OPS_lrlval = f * Ten__9(e);
+				}
+			} else {
+				OPS_err(203);
+			}
+		}
+	}
+	Number__6_s = _s.lnk;
+}
+
+static struct Get__1 {
+	struct Get__1 *lnk;
+} *Get__1_s;
+
+static void Comment__2 (void);
+
+static void Comment__2 (void)
+{
+	OPM_Get(&OPS_ch);
+	for (;;) {
+		for (;;) {
+			while (OPS_ch == '(') {
+				OPM_Get(&OPS_ch);
+				if (OPS_ch == '*') {
+					Comment__2();
+				}
+			}
+			if (OPS_ch == '*') {
+				OPM_Get(&OPS_ch);
+				break;
+			}
+			if (OPS_ch == 0x00) {
+				break;
+			}
+			OPM_Get(&OPS_ch);
+		}
+		if (OPS_ch == ')') {
+			OPM_Get(&OPS_ch);
+			break;
+		}
+		if (OPS_ch == 0x00) {
+			OPS_err(5);
+			break;
+		}
+	}
+}
+
+void OPS_Get (SHORTINT *sym)
+{
+	SHORTINT s;
+	struct Get__1 _s;
+	_s.lnk = Get__1_s;
+	Get__1_s = &_s;
+	OPM_errpos = OPM_curpos - 1;
+	while (OPS_ch <= ' ') {
+		if (OPS_ch == 0x00) {
+			*sym = 64;
+			return;
+		} else {
+			OPM_Get(&OPS_ch);
+		}
+	}
+	switch (OPS_ch) {
+		case '\"': case '\'': 
+			OPS_Str(&s);
+			break;
+		case '#': 
+			s = 10;
+			OPM_Get(&OPS_ch);
+			break;
+		case '&': 
+			s = 5;
+			OPM_Get(&OPS_ch);
+			break;
+		case '(': 
+			OPM_Get(&OPS_ch);
+			if (OPS_ch == '*') {
+				Comment__2();
+				OPS_Get(&s);
+			} else {
+				s = 30;
+			}
+			break;
+		case ')': 
+			s = 22;
+			OPM_Get(&OPS_ch);
+			break;
+		case '*': 
+			s = 1;
+			OPM_Get(&OPS_ch);
+			break;
+		case '+': 
+			s = 6;
+			OPM_Get(&OPS_ch);
+			break;
+		case ',': 
+			s = 19;
+			OPM_Get(&OPS_ch);
+			break;
+		case '-': 
+			s = 7;
+			OPM_Get(&OPS_ch);
+			break;
+		case '.': 
+			OPM_Get(&OPS_ch);
+			if (OPS_ch == '.') {
+				OPM_Get(&OPS_ch);
+				s = 21;
+			} else {
+				s = 18;
+			}
+			break;
+		case '/': 
+			s = 2;
+			OPM_Get(&OPS_ch);
+			break;
+		case '0': case '1': case '2': case '3': case '4': 
+		case '5': case '6': case '7': case '8': case '9': 
+			OPS_Number();
+			s = 35;
+			break;
+		case ':': 
+			OPM_Get(&OPS_ch);
+			if (OPS_ch == '=') {
+				OPM_Get(&OPS_ch);
+				s = 34;
+			} else {
+				s = 20;
+			}
+			break;
+		case ';': 
+			s = 39;
+			OPM_Get(&OPS_ch);
+			break;
+		case '<': 
+			OPM_Get(&OPS_ch);
+			if (OPS_ch == '=') {
+				OPM_Get(&OPS_ch);
+				s = 12;
+			} else {
+				s = 11;
+			}
+			break;
+		case '=': 
+			s = 9;
+			OPM_Get(&OPS_ch);
+			break;
+		case '>': 
+			OPM_Get(&OPS_ch);
+			if (OPS_ch == '=') {
+				OPM_Get(&OPS_ch);
+				s = 14;
+			} else {
+				s = 13;
+			}
+			break;
+		case 'A': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "ARRAY") == 0) {
+				s = 54;
+			}
+			break;
+		case 'B': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "BEGIN") == 0) {
+				s = 57;
+			} else if (__STRCMP(OPS_name, "BY") == 0) {
+				s = 29;
+			}
+			break;
+		case 'C': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "CASE") == 0) {
+				s = 46;
+			} else if (__STRCMP(OPS_name, "CONST") == 0) {
+				s = 58;
+			}
+			break;
+		case 'D': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "DO") == 0) {
+				s = 27;
+			} else if (__STRCMP(OPS_name, "DIV") == 0) {
+				s = 3;
+			}
+			break;
+		case 'E': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "END") == 0) {
+				s = 41;
+			} else if (__STRCMP(OPS_name, "ELSE") == 0) {
+				s = 42;
+			} else if (__STRCMP(OPS_name, "ELSIF") == 0) {
+				s = 43;
+			} else if (__STRCMP(OPS_name, "EXIT") == 0) {
+				s = 52;
+			}
+			break;
+		case 'F': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "FOR") == 0) {
+				s = 49;
+			}
+			break;
+		case 'I': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "IF") == 0) {
+				s = 45;
+			} else if (__STRCMP(OPS_name, "IN") == 0) {
+				s = 15;
+			} else if (__STRCMP(OPS_name, "IS") == 0) {
+				s = 16;
+			} else if (__STRCMP(OPS_name, "IMPORT") == 0) {
+				s = 62;
+			}
+			break;
+		case 'L': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "LOOP") == 0) {
+				s = 50;
+			}
+			break;
+		case 'M': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "MOD") == 0) {
+				s = 4;
+			} else if (__STRCMP(OPS_name, "MODULE") == 0) {
+				s = 63;
+			}
+			break;
+		case 'N': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "NIL") == 0) {
+				s = 36;
+			}
+			break;
+		case 'O': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "OR") == 0) {
+				s = 8;
+			} else if (__STRCMP(OPS_name, "OF") == 0) {
+				s = 25;
+			}
+			break;
+		case 'P': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "PROCEDURE") == 0) {
+				s = 61;
+			} else if (__STRCMP(OPS_name, "POINTER") == 0) {
+				s = 56;
+			}
+			break;
+		case 'R': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "RECORD") == 0) {
+				s = 55;
+			} else if (__STRCMP(OPS_name, "REPEAT") == 0) {
+				s = 48;
+			} else if (__STRCMP(OPS_name, "RETURN") == 0) {
+				s = 53;
+			}
+			break;
+		case 'T': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "THEN") == 0) {
+				s = 26;
+			} else if (__STRCMP(OPS_name, "TO") == 0) {
+				s = 28;
+			} else if (__STRCMP(OPS_name, "TYPE") == 0) {
+				s = 59;
+			}
+			break;
+		case 'U': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "UNTIL") == 0) {
+				s = 44;
+			}
+			break;
+		case 'V': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "VAR") == 0) {
+				s = 60;
+			}
+			break;
+		case 'W': 
+			OPS_Identifier(&s);
+			if (__STRCMP(OPS_name, "WHILE") == 0) {
+				s = 47;
+			} else if (__STRCMP(OPS_name, "WITH") == 0) {
+				s = 51;
+			}
+			break;
+		case 'G': case 'H': case 'J': case 'K': case 'Q': 
+		case 'S': case 'X': case 'Y': case 'Z': 
+			OPS_Identifier(&s);
+			break;
+		case '[': 
+			s = 31;
+			OPM_Get(&OPS_ch);
+			break;
+		case ']': 
+			s = 23;
+			OPM_Get(&OPS_ch);
+			break;
+		case '^': 
+			s = 17;
+			OPM_Get(&OPS_ch);
+			break;
+		case 'a': case 'b': case 'c': case 'd': case 'e': 
+		case 'f': case 'g': case 'h': case 'i': case 'j': 
+		case 'k': case 'l': case 'm': case 'n': case 'o': 
+		case 'p': case 'q': case 'r': case 's': case 't': 
+		case 'u': case 'v': case 'w': case 'x': case 'y': 
+		case 'z': 
+			OPS_Identifier(&s);
+			break;
+		case '{': 
+			s = 32;
+			OPM_Get(&OPS_ch);
+			break;
+		case '|': 
+			s = 40;
+			OPM_Get(&OPS_ch);
+			break;
+		case '}': 
+			s = 24;
+			OPM_Get(&OPS_ch);
+			break;
+		case '~': 
+			s = 33;
+			OPM_Get(&OPS_ch);
+			break;
+		case 0x7f: 
+			s = 21;
+			OPM_Get(&OPS_ch);
+			break;
+		default: 
+			s = 0;
+			OPM_Get(&OPS_ch);
+			break;
+	}
+	*sym = s;
+	Get__1_s = _s.lnk;
+}
+
+void OPS_Init (void)
+{
+	OPS_ch = ' ';
+}
+
+
+export void *OPS__init(void)
+{
+	__DEFMOD;
+	__MODULE_IMPORT(OPM);
+	__REGMOD("OPS", 0);
+	__REGCMD("Init", OPS_Init);
+/* BEGIN */
+	__ENDMOD;
+}