/* voc 2.1.0 [2019/11/01]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 #define LONGINT INT32 #define SET UINT32 #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 INT16 OPS_numtyp; export INT64 OPS_intval; export REAL OPS_realval; export LONGREAL OPS_lrlval; static CHAR OPS_ch; export void OPS_Get (INT8 *sym); static void OPS_Identifier (INT8 *sym); export void OPS_Init (void); static void OPS_Number (void); static void OPS_Str (INT8 *sym); static void OPS_err (INT16 n); static void OPS_err (INT16 n) { OPM_err(n); } static void OPS_Str (INT8 *sym) { INT16 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[__X(i, 256)] = OPS_ch; i += 1; } OPM_Get(&OPS_ch); OPS_str[__X(i, 256)] = 0x00; OPS_intval = i + 1; if (OPS_intval == 2) { *sym = 35; OPS_numtyp = 1; OPS_intval = (INT16)OPS_str[0]; } else { *sym = 37; } } static void OPS_Identifier (INT8 *sym) { INT16 i; i = 0; do { OPS_name[__X(i, 256)] = 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[__X(i, 256)] = 0x00; *sym = 38; } static struct Number__6 { struct Number__6 *lnk; } *Number__6_s; static INT16 Ord__7 (CHAR ch, BOOLEAN hex); static LONGREAL Ten__9 (INT16 e); static LONGREAL Ten__9 (INT16 e) { 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; } } return x; } static INT16 Ord__7 (CHAR ch, BOOLEAN hex) { if (ch <= '9') { return (INT16)ch - 48; } else if (hex) { return ((INT16)ch - 65) + 10; } else { OPS_err(2); return 0; } __RETCHK; } static void OPS_Number (void) { INT16 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[__X(n, 24)] = 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) + (INT64)Ord__7(dig[__X(i, 24)], 1); i += 1; } } else { OPS_err(203); } } else if (OPS_ch == 'H') { OPM_Get(&OPS_ch); OPS_numtyp = 2; if (n <= 16) { if ((n == 16 && dig[0] > '7')) { OPS_intval = -1; } while (i < n) { OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1); i += 1; } } else { OPS_err(203); } } else { OPS_numtyp = 2; while (i < n) { d = Ord__7(dig[__X(i, 24)], 0); i += 1; if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) { OPS_intval = OPS_intval * 10 + (INT64)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[__X(n, 24)], 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 (INT8 *sym) { INT8 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; Get__1_s = _s.lnk; 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; }