Support non-printables in string literals and tidy case alignment and constant literals.

This commit is contained in:
David Brown 2016-08-12 20:41:58 +01:00
parent fe03130fe1
commit 58556457bc
32 changed files with 1125 additions and 1148 deletions

View file

@ -22,6 +22,7 @@ export void OPC_BegBlk (void);
export void OPC_BegStat (void); export void OPC_BegStat (void);
static void OPC_CProcDefs (OPT_Object obj, INTEGER vis); static void OPC_CProcDefs (OPT_Object obj, INTEGER vis);
export void OPC_Case (LONGINT caseVal, INTEGER form); export void OPC_Case (LONGINT caseVal, INTEGER form);
static void OPC_CharacterLiteral (LONGINT c);
export void OPC_Cmp (INTEGER rel); export void OPC_Cmp (INTEGER rel);
export void OPC_CompleteIdent (OPT_Object obj); export void OPC_CompleteIdent (OPT_Object obj);
export void OPC_Constant (OPT_Const con, INTEGER form); export void OPC_Constant (OPT_Const con, INTEGER form);
@ -75,6 +76,7 @@ static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude); export void OPC_SetInclude (BOOLEAN exclude);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause); static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x); static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x);
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l);
export void OPC_TDescDecl (OPT_Struct typ); export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INTEGER vis); export void OPC_TypeDefs (OPT_Object obj, INTEGER vis);
export void OPC_TypeOf (OPT_Object ap); export void OPC_TypeOf (OPT_Object ap);
@ -815,11 +817,12 @@ void OPC_TDescDecl (OPT_Struct typ)
OPC_Andent(typ); OPC_Andent(typ);
OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1); OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1);
OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ)); OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ));
OPM_Write('\"'); OPM_Write('"');
if (typ->strobj != NIL) { if (typ->strobj != NIL) {
OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256))); OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256)));
} }
OPC_Str1((CHAR*)"\", #), {", (LONGINT)9, typ->size); OPM_Write('"');
OPC_Str1((CHAR*)", #), {", (LONGINT)8, typ->size);
nofptrs = 0; nofptrs = 0;
OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs); OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs);
OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize)); OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize));
@ -1170,10 +1173,10 @@ static void OPC_Include (CHAR *name, LONGINT name__len)
{ {
__DUP(name, name__len, CHAR); __DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", (LONGINT)10); OPM_WriteString((CHAR*)"#include ", (LONGINT)10);
OPM_Write('\"'); OPM_Write('"');
OPM_WriteStringVar((void*)name, name__len); OPM_WriteStringVar((void*)name, name__len);
OPM_WriteString((CHAR*)".h", (LONGINT)3); OPM_WriteString((CHAR*)".h", (LONGINT)3);
OPM_Write('\"'); OPM_Write('"');
OPM_WriteLn(); OPM_WriteLn();
__DEL(name); __DEL(name);
} }
@ -1855,26 +1858,56 @@ void OPC_Cmp (INTEGER rel)
} }
} }
static void OPC_CharacterLiteral (LONGINT c)
{
if (c < 32 || c > 126) {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(c);
} else {
OPM_Write('\'');
if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
OPM_Write('\'');
}
}
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
{
LONGINT i;
INTEGER c;
__DUP(s, s__len, CHAR);
OPM_Write('"');
i = 0;
while (i < l) {
c = (int)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
c = __MASK(c, -64);
OPM_Write((CHAR)(48 + __ASHR(c, 3)));
c = __MASK(c, -8);
OPM_Write((CHAR)(48 + c));
} else {
if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
}
i += 1;
}
OPM_Write('"');
__DEL(s);
}
void OPC_Case (LONGINT caseVal, INTEGER form) void OPC_Case (LONGINT caseVal, INTEGER form)
{ {
CHAR ch; CHAR ch;
OPM_WriteString((CHAR*)"case ", (LONGINT)6); OPM_WriteString((CHAR*)"case ", (LONGINT)6);
switch (form) { switch (form) {
case 3: case 3:
ch = (CHAR)caseVal; OPC_CharacterLiteral(caseVal);
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
OPM_Write(ch);
} else {
OPM_Write(ch);
}
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(caseVal);
}
break; break;
case 4: case 5: case 6: case 4: case 5: case 6:
OPM_WriteInt(caseVal); OPM_WriteInt(caseVal);
@ -1932,8 +1965,7 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
void OPC_Constant (OPT_Const con, INTEGER form) void OPC_Constant (OPT_Const con, INTEGER form)
{ {
INTEGER i, len; INTEGER i;
CHAR ch;
SET s; SET s;
LONGINT hex; LONGINT hex;
BOOLEAN skipLeading; BOOLEAN skipLeading;
@ -1945,18 +1977,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
OPM_WriteInt(con->intval); OPM_WriteInt(con->intval);
break; break;
case 3: case 3:
ch = (CHAR)con->intval; OPC_CharacterLiteral(con->intval);
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(con->intval);
}
break; break;
case 4: case 5: case 6: case 4: case 5: case 6:
OPM_WriteInt(con->intval); OPM_WriteInt(con->intval);
@ -1991,18 +2012,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
} }
break; break;
case 10: case 10:
OPM_Write('\"'); OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1);
len = (int)con->intval2 - 1;
i = 0;
while (i < len) {
ch = (*con->ext)[__X(i, ((LONGINT)(256)))];
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
i += 1;
}
OPM_Write('\"');
break; break;
case 11: case 11:
OPM_WriteString((CHAR*)"NIL", (LONGINT)4); OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
@ -2015,74 +2025,74 @@ void OPC_Constant (OPT_Const con, INTEGER form)
} }
} }
static struct InitKeywords__47 { static struct InitKeywords__48 {
SHORTINT *n; SHORTINT *n;
struct InitKeywords__47 *lnk; struct InitKeywords__48 *lnk;
} *InitKeywords__47_s; } *InitKeywords__48_s;
static void Enter__48 (CHAR *s, LONGINT s__len); static void Enter__49 (CHAR *s, LONGINT s__len);
static void Enter__48 (CHAR *s, LONGINT s__len) static void Enter__49 (CHAR *s, LONGINT s__len)
{ {
INTEGER h; INTEGER h;
__DUP(s, s__len, CHAR); __DUP(s, s__len, CHAR);
h = OPC_PerfectHash((void*)s, s__len); h = OPC_PerfectHash((void*)s, s__len);
OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n; OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n;
__COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); __COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
*InitKeywords__47_s->n += 1; *InitKeywords__48_s->n += 1;
__DEL(s); __DEL(s);
} }
static void OPC_InitKeywords (void) static void OPC_InitKeywords (void)
{ {
SHORTINT n, i; SHORTINT n, i;
struct InitKeywords__47 _s; struct InitKeywords__48 _s;
_s.n = &n; _s.n = &n;
_s.lnk = InitKeywords__47_s; _s.lnk = InitKeywords__48_s;
InitKeywords__47_s = &_s; InitKeywords__48_s = &_s;
n = 0; n = 0;
i = 0; i = 0;
while (i <= 104) { while (i <= 104) {
OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1; OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1;
i += 1; i += 1;
} }
Enter__48((CHAR*)"asm", (LONGINT)4); Enter__49((CHAR*)"asm", (LONGINT)4);
Enter__48((CHAR*)"auto", (LONGINT)5); Enter__49((CHAR*)"auto", (LONGINT)5);
Enter__48((CHAR*)"break", (LONGINT)6); Enter__49((CHAR*)"break", (LONGINT)6);
Enter__48((CHAR*)"case", (LONGINT)5); Enter__49((CHAR*)"case", (LONGINT)5);
Enter__48((CHAR*)"char", (LONGINT)5); Enter__49((CHAR*)"char", (LONGINT)5);
Enter__48((CHAR*)"const", (LONGINT)6); Enter__49((CHAR*)"const", (LONGINT)6);
Enter__48((CHAR*)"continue", (LONGINT)9); Enter__49((CHAR*)"continue", (LONGINT)9);
Enter__48((CHAR*)"default", (LONGINT)8); Enter__49((CHAR*)"default", (LONGINT)8);
Enter__48((CHAR*)"do", (LONGINT)3); Enter__49((CHAR*)"do", (LONGINT)3);
Enter__48((CHAR*)"double", (LONGINT)7); Enter__49((CHAR*)"double", (LONGINT)7);
Enter__48((CHAR*)"else", (LONGINT)5); Enter__49((CHAR*)"else", (LONGINT)5);
Enter__48((CHAR*)"enum", (LONGINT)5); Enter__49((CHAR*)"enum", (LONGINT)5);
Enter__48((CHAR*)"extern", (LONGINT)7); Enter__49((CHAR*)"extern", (LONGINT)7);
Enter__48((CHAR*)"export", (LONGINT)7); Enter__49((CHAR*)"export", (LONGINT)7);
Enter__48((CHAR*)"float", (LONGINT)6); Enter__49((CHAR*)"float", (LONGINT)6);
Enter__48((CHAR*)"for", (LONGINT)4); Enter__49((CHAR*)"for", (LONGINT)4);
Enter__48((CHAR*)"fortran", (LONGINT)8); Enter__49((CHAR*)"fortran", (LONGINT)8);
Enter__48((CHAR*)"goto", (LONGINT)5); Enter__49((CHAR*)"goto", (LONGINT)5);
Enter__48((CHAR*)"if", (LONGINT)3); Enter__49((CHAR*)"if", (LONGINT)3);
Enter__48((CHAR*)"import", (LONGINT)7); Enter__49((CHAR*)"import", (LONGINT)7);
Enter__48((CHAR*)"int", (LONGINT)4); Enter__49((CHAR*)"int", (LONGINT)4);
Enter__48((CHAR*)"long", (LONGINT)5); Enter__49((CHAR*)"long", (LONGINT)5);
Enter__48((CHAR*)"register", (LONGINT)9); Enter__49((CHAR*)"register", (LONGINT)9);
Enter__48((CHAR*)"return", (LONGINT)7); Enter__49((CHAR*)"return", (LONGINT)7);
Enter__48((CHAR*)"short", (LONGINT)6); Enter__49((CHAR*)"short", (LONGINT)6);
Enter__48((CHAR*)"signed", (LONGINT)7); Enter__49((CHAR*)"signed", (LONGINT)7);
Enter__48((CHAR*)"sizeof", (LONGINT)7); Enter__49((CHAR*)"sizeof", (LONGINT)7);
Enter__48((CHAR*)"static", (LONGINT)7); Enter__49((CHAR*)"static", (LONGINT)7);
Enter__48((CHAR*)"struct", (LONGINT)7); Enter__49((CHAR*)"struct", (LONGINT)7);
Enter__48((CHAR*)"switch", (LONGINT)7); Enter__49((CHAR*)"switch", (LONGINT)7);
Enter__48((CHAR*)"typedef", (LONGINT)8); Enter__49((CHAR*)"typedef", (LONGINT)8);
Enter__48((CHAR*)"union", (LONGINT)6); Enter__49((CHAR*)"union", (LONGINT)6);
Enter__48((CHAR*)"unsigned", (LONGINT)9); Enter__49((CHAR*)"unsigned", (LONGINT)9);
Enter__48((CHAR*)"void", (LONGINT)5); Enter__49((CHAR*)"void", (LONGINT)5);
Enter__48((CHAR*)"volatile", (LONGINT)9); Enter__49((CHAR*)"volatile", (LONGINT)9);
Enter__48((CHAR*)"while", (LONGINT)6); Enter__49((CHAR*)"while", (LONGINT)6);
InitKeywords__47_s = _s.lnk; InitKeywords__48_s = _s.lnk;
} }

View file

@ -228,17 +228,17 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35); OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" a - don\'t check ASSERTs at runtime, use this option in tested production code", (LONGINT)80); OPM_LogWStr((CHAR*)" a - don't check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48); OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" t - don\'t check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101); OPM_LogWStr((CHAR*)" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" S - don\'t call external assembler/compiler, only generate C code", (LONGINT)67); OPM_LogWStr((CHAR*)" S - don't call external assembler/compiler, only generate C code", (LONGINT)67);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24); OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" f - don\'t use color output", (LONGINT)29); OPM_LogWStr((CHAR*)" f - don't use color output", (LONGINT)29);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57); OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57);
OPM_LogWLn(); OPM_LogWLn();

View file

@ -325,7 +325,7 @@ void OPS_Get (SHORTINT *sym)
} }
} }
switch (OPS_ch) { switch (OPS_ch) {
case '\"': case '\'': case '"': case '\'':
OPS_Str(&s); OPS_Str(&s);
break; break;
case '#': case '#':

View file

@ -787,9 +787,9 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
(*S).s[__X(i, ((LONGINT)(64)))] = 0x00; (*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
(*S).len = i; (*S).len = i;
(*S).class = 1; (*S).class = 1;
} else if (ch == '\"') { } else if (ch == '"') {
Texts_Read((void*)&*S, S__typ, &ch); Texts_Read((void*)&*S, S__typ, &ch);
while ((((ch != '\"' && ch >= ' ')) && i != 63)) { while ((((ch != '"' && ch >= ' ')) && i != 63)) {
(*S).s[__X(i, ((LONGINT)(64)))] = ch; (*S).s[__X(i, ((LONGINT)(64)))] = ch;
i += 1; i += 1;
Texts_Read((void*)&*S, S__typ, &ch); Texts_Read((void*)&*S, S__typ, &ch);

View file

@ -25,7 +25,7 @@ export void *errors__init(void)
errors_errors[6][0] = 0x00; errors_errors[6][0] = 0x00;
errors_errors[7][0] = 0x00; errors_errors[7][0] = 0x00;
errors_errors[8][0] = 0x00; errors_errors[8][0] = 0x00;
__MOVE("\'=\' expected", errors_errors[9], 13); __MOVE("'=' expected", errors_errors[9], 13);
errors_errors[10][0] = 0x00; errors_errors[10][0] = 0x00;
errors_errors[11][0] = 0x00; errors_errors[11][0] = 0x00;
__MOVE("type definition starts with incorrect symbol", errors_errors[12], 45); __MOVE("type definition starts with incorrect symbol", errors_errors[12], 45);
@ -34,28 +34,28 @@ export void *errors__init(void)
__MOVE("declaration followed by incorrect symbol", errors_errors[15], 41); __MOVE("declaration followed by incorrect symbol", errors_errors[15], 41);
__MOVE("MODULE expected", errors_errors[16], 16); __MOVE("MODULE expected", errors_errors[16], 16);
errors_errors[17][0] = 0x00; errors_errors[17][0] = 0x00;
__MOVE("\'.\' missing", errors_errors[18], 12); __MOVE("'.' missing", errors_errors[18], 12);
__MOVE("\',\' missing", errors_errors[19], 12); __MOVE("',' missing", errors_errors[19], 12);
__MOVE("\':\' missing", errors_errors[20], 12); __MOVE("':' missing", errors_errors[20], 12);
errors_errors[21][0] = 0x00; errors_errors[21][0] = 0x00;
__MOVE("\')\' missing", errors_errors[22], 12); __MOVE("')' missing", errors_errors[22], 12);
__MOVE("\']\' missing", errors_errors[23], 12); __MOVE("']' missing", errors_errors[23], 12);
__MOVE("\'}\' missing", errors_errors[24], 12); __MOVE("'}' missing", errors_errors[24], 12);
__MOVE("OF missing", errors_errors[25], 11); __MOVE("OF missing", errors_errors[25], 11);
__MOVE("THEN missing", errors_errors[26], 13); __MOVE("THEN missing", errors_errors[26], 13);
__MOVE("DO missing", errors_errors[27], 11); __MOVE("DO missing", errors_errors[27], 11);
__MOVE("TO missing", errors_errors[28], 11); __MOVE("TO missing", errors_errors[28], 11);
errors_errors[29][0] = 0x00; errors_errors[29][0] = 0x00;
__MOVE("\'(\' missing", errors_errors[30], 12); __MOVE("'(' missing", errors_errors[30], 12);
errors_errors[31][0] = 0x00; errors_errors[31][0] = 0x00;
errors_errors[32][0] = 0x00; errors_errors[32][0] = 0x00;
errors_errors[33][0] = 0x00; errors_errors[33][0] = 0x00;
__MOVE("\':=\' missing", errors_errors[34], 13); __MOVE("':=' missing", errors_errors[34], 13);
__MOVE("\',\' or OF expected", errors_errors[35], 19); __MOVE("',' or OF expected", errors_errors[35], 19);
errors_errors[36][0] = 0x00; errors_errors[36][0] = 0x00;
errors_errors[37][0] = 0x00; errors_errors[37][0] = 0x00;
__MOVE("identifier expected", errors_errors[38], 20); __MOVE("identifier expected", errors_errors[38], 20);
__MOVE("\';\' missing", errors_errors[39], 12); __MOVE("';' missing", errors_errors[39], 12);
errors_errors[40][0] = 0x00; errors_errors[40][0] = 0x00;
__MOVE("END missing", errors_errors[41], 12); __MOVE("END missing", errors_errors[41], 12);
errors_errors[42][0] = 0x00; errors_errors[42][0] = 0x00;
@ -131,10 +131,10 @@ export void *errors__init(void)
__MOVE("operand is not a variable", errors_errors[112], 26); __MOVE("operand is not a variable", errors_errors[112], 26);
__MOVE("incompatible assignment", errors_errors[113], 24); __MOVE("incompatible assignment", errors_errors[113], 24);
__MOVE("string too long to be assigned", errors_errors[114], 31); __MOVE("string too long to be assigned", errors_errors[114], 31);
__MOVE("parameter doesn\'t match", errors_errors[115], 24); __MOVE("parameter doesn't match", errors_errors[115], 24);
__MOVE("number of parameters doesn\'t match", errors_errors[116], 35); __MOVE("number of parameters doesn't match", errors_errors[116], 35);
__MOVE("result type doesn\'t match", errors_errors[117], 26); __MOVE("result type doesn't match", errors_errors[117], 26);
__MOVE("export mark doesn\'t match with forward declaration", errors_errors[118], 51); __MOVE("export mark doesn't match with forward declaration", errors_errors[118], 51);
__MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61); __MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61);
__MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71); __MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71);
__MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64); __MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64);

View file

@ -252,7 +252,7 @@ export void *vt100__init(void)
__REGCMD("RCP", vt100_RCP); __REGCMD("RCP", vt100_RCP);
__REGCMD("SCP", vt100_SCP); __REGCMD("SCP", vt100_SCP);
/* BEGIN */ /* BEGIN */
__COPY("", vt100_CSI, ((LONGINT)(5))); __COPY("\033", vt100_CSI, ((LONGINT)(5)));
Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5))); Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5)));
__ENDMOD; __ENDMOD;
} }

View file

@ -22,6 +22,7 @@ export void OPC_BegBlk (void);
export void OPC_BegStat (void); export void OPC_BegStat (void);
static void OPC_CProcDefs (OPT_Object obj, INTEGER vis); static void OPC_CProcDefs (OPT_Object obj, INTEGER vis);
export void OPC_Case (LONGINT caseVal, INTEGER form); export void OPC_Case (LONGINT caseVal, INTEGER form);
static void OPC_CharacterLiteral (LONGINT c);
export void OPC_Cmp (INTEGER rel); export void OPC_Cmp (INTEGER rel);
export void OPC_CompleteIdent (OPT_Object obj); export void OPC_CompleteIdent (OPT_Object obj);
export void OPC_Constant (OPT_Const con, INTEGER form); export void OPC_Constant (OPT_Const con, INTEGER form);
@ -75,6 +76,7 @@ static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude); export void OPC_SetInclude (BOOLEAN exclude);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause); static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x); static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x);
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l);
export void OPC_TDescDecl (OPT_Struct typ); export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INTEGER vis); export void OPC_TypeDefs (OPT_Object obj, INTEGER vis);
export void OPC_TypeOf (OPT_Object ap); export void OPC_TypeOf (OPT_Object ap);
@ -815,11 +817,12 @@ void OPC_TDescDecl (OPT_Struct typ)
OPC_Andent(typ); OPC_Andent(typ);
OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1); OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1);
OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ)); OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ));
OPM_Write('\"'); OPM_Write('"');
if (typ->strobj != NIL) { if (typ->strobj != NIL) {
OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256))); OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256)));
} }
OPC_Str1((CHAR*)"\", #), {", (LONGINT)9, typ->size); OPM_Write('"');
OPC_Str1((CHAR*)", #), {", (LONGINT)8, typ->size);
nofptrs = 0; nofptrs = 0;
OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs); OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs);
OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize)); OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize));
@ -1170,10 +1173,10 @@ static void OPC_Include (CHAR *name, LONGINT name__len)
{ {
__DUP(name, name__len, CHAR); __DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", (LONGINT)10); OPM_WriteString((CHAR*)"#include ", (LONGINT)10);
OPM_Write('\"'); OPM_Write('"');
OPM_WriteStringVar((void*)name, name__len); OPM_WriteStringVar((void*)name, name__len);
OPM_WriteString((CHAR*)".h", (LONGINT)3); OPM_WriteString((CHAR*)".h", (LONGINT)3);
OPM_Write('\"'); OPM_Write('"');
OPM_WriteLn(); OPM_WriteLn();
__DEL(name); __DEL(name);
} }
@ -1855,26 +1858,56 @@ void OPC_Cmp (INTEGER rel)
} }
} }
static void OPC_CharacterLiteral (LONGINT c)
{
if (c < 32 || c > 126) {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(c);
} else {
OPM_Write('\'');
if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
OPM_Write('\'');
}
}
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
{
LONGINT i;
INTEGER c;
__DUP(s, s__len, CHAR);
OPM_Write('"');
i = 0;
while (i < l) {
c = (int)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
c = __MASK(c, -64);
OPM_Write((CHAR)(48 + __ASHR(c, 3)));
c = __MASK(c, -8);
OPM_Write((CHAR)(48 + c));
} else {
if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
}
i += 1;
}
OPM_Write('"');
__DEL(s);
}
void OPC_Case (LONGINT caseVal, INTEGER form) void OPC_Case (LONGINT caseVal, INTEGER form)
{ {
CHAR ch; CHAR ch;
OPM_WriteString((CHAR*)"case ", (LONGINT)6); OPM_WriteString((CHAR*)"case ", (LONGINT)6);
switch (form) { switch (form) {
case 3: case 3:
ch = (CHAR)caseVal; OPC_CharacterLiteral(caseVal);
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
OPM_Write(ch);
} else {
OPM_Write(ch);
}
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(caseVal);
}
break; break;
case 4: case 5: case 6: case 4: case 5: case 6:
OPM_WriteInt(caseVal); OPM_WriteInt(caseVal);
@ -1932,8 +1965,7 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
void OPC_Constant (OPT_Const con, INTEGER form) void OPC_Constant (OPT_Const con, INTEGER form)
{ {
INTEGER i, len; INTEGER i;
CHAR ch;
SET s; SET s;
LONGINT hex; LONGINT hex;
BOOLEAN skipLeading; BOOLEAN skipLeading;
@ -1945,18 +1977,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
OPM_WriteInt(con->intval); OPM_WriteInt(con->intval);
break; break;
case 3: case 3:
ch = (CHAR)con->intval; OPC_CharacterLiteral(con->intval);
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(con->intval);
}
break; break;
case 4: case 5: case 6: case 4: case 5: case 6:
OPM_WriteInt(con->intval); OPM_WriteInt(con->intval);
@ -1991,18 +2012,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
} }
break; break;
case 10: case 10:
OPM_Write('\"'); OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1);
len = (int)con->intval2 - 1;
i = 0;
while (i < len) {
ch = (*con->ext)[__X(i, ((LONGINT)(256)))];
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
i += 1;
}
OPM_Write('\"');
break; break;
case 11: case 11:
OPM_WriteString((CHAR*)"NIL", (LONGINT)4); OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
@ -2015,74 +2025,74 @@ void OPC_Constant (OPT_Const con, INTEGER form)
} }
} }
static struct InitKeywords__47 { static struct InitKeywords__48 {
SHORTINT *n; SHORTINT *n;
struct InitKeywords__47 *lnk; struct InitKeywords__48 *lnk;
} *InitKeywords__47_s; } *InitKeywords__48_s;
static void Enter__48 (CHAR *s, LONGINT s__len); static void Enter__49 (CHAR *s, LONGINT s__len);
static void Enter__48 (CHAR *s, LONGINT s__len) static void Enter__49 (CHAR *s, LONGINT s__len)
{ {
INTEGER h; INTEGER h;
__DUP(s, s__len, CHAR); __DUP(s, s__len, CHAR);
h = OPC_PerfectHash((void*)s, s__len); h = OPC_PerfectHash((void*)s, s__len);
OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n; OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n;
__COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); __COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
*InitKeywords__47_s->n += 1; *InitKeywords__48_s->n += 1;
__DEL(s); __DEL(s);
} }
static void OPC_InitKeywords (void) static void OPC_InitKeywords (void)
{ {
SHORTINT n, i; SHORTINT n, i;
struct InitKeywords__47 _s; struct InitKeywords__48 _s;
_s.n = &n; _s.n = &n;
_s.lnk = InitKeywords__47_s; _s.lnk = InitKeywords__48_s;
InitKeywords__47_s = &_s; InitKeywords__48_s = &_s;
n = 0; n = 0;
i = 0; i = 0;
while (i <= 104) { while (i <= 104) {
OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1; OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1;
i += 1; i += 1;
} }
Enter__48((CHAR*)"asm", (LONGINT)4); Enter__49((CHAR*)"asm", (LONGINT)4);
Enter__48((CHAR*)"auto", (LONGINT)5); Enter__49((CHAR*)"auto", (LONGINT)5);
Enter__48((CHAR*)"break", (LONGINT)6); Enter__49((CHAR*)"break", (LONGINT)6);
Enter__48((CHAR*)"case", (LONGINT)5); Enter__49((CHAR*)"case", (LONGINT)5);
Enter__48((CHAR*)"char", (LONGINT)5); Enter__49((CHAR*)"char", (LONGINT)5);
Enter__48((CHAR*)"const", (LONGINT)6); Enter__49((CHAR*)"const", (LONGINT)6);
Enter__48((CHAR*)"continue", (LONGINT)9); Enter__49((CHAR*)"continue", (LONGINT)9);
Enter__48((CHAR*)"default", (LONGINT)8); Enter__49((CHAR*)"default", (LONGINT)8);
Enter__48((CHAR*)"do", (LONGINT)3); Enter__49((CHAR*)"do", (LONGINT)3);
Enter__48((CHAR*)"double", (LONGINT)7); Enter__49((CHAR*)"double", (LONGINT)7);
Enter__48((CHAR*)"else", (LONGINT)5); Enter__49((CHAR*)"else", (LONGINT)5);
Enter__48((CHAR*)"enum", (LONGINT)5); Enter__49((CHAR*)"enum", (LONGINT)5);
Enter__48((CHAR*)"extern", (LONGINT)7); Enter__49((CHAR*)"extern", (LONGINT)7);
Enter__48((CHAR*)"export", (LONGINT)7); Enter__49((CHAR*)"export", (LONGINT)7);
Enter__48((CHAR*)"float", (LONGINT)6); Enter__49((CHAR*)"float", (LONGINT)6);
Enter__48((CHAR*)"for", (LONGINT)4); Enter__49((CHAR*)"for", (LONGINT)4);
Enter__48((CHAR*)"fortran", (LONGINT)8); Enter__49((CHAR*)"fortran", (LONGINT)8);
Enter__48((CHAR*)"goto", (LONGINT)5); Enter__49((CHAR*)"goto", (LONGINT)5);
Enter__48((CHAR*)"if", (LONGINT)3); Enter__49((CHAR*)"if", (LONGINT)3);
Enter__48((CHAR*)"import", (LONGINT)7); Enter__49((CHAR*)"import", (LONGINT)7);
Enter__48((CHAR*)"int", (LONGINT)4); Enter__49((CHAR*)"int", (LONGINT)4);
Enter__48((CHAR*)"long", (LONGINT)5); Enter__49((CHAR*)"long", (LONGINT)5);
Enter__48((CHAR*)"register", (LONGINT)9); Enter__49((CHAR*)"register", (LONGINT)9);
Enter__48((CHAR*)"return", (LONGINT)7); Enter__49((CHAR*)"return", (LONGINT)7);
Enter__48((CHAR*)"short", (LONGINT)6); Enter__49((CHAR*)"short", (LONGINT)6);
Enter__48((CHAR*)"signed", (LONGINT)7); Enter__49((CHAR*)"signed", (LONGINT)7);
Enter__48((CHAR*)"sizeof", (LONGINT)7); Enter__49((CHAR*)"sizeof", (LONGINT)7);
Enter__48((CHAR*)"static", (LONGINT)7); Enter__49((CHAR*)"static", (LONGINT)7);
Enter__48((CHAR*)"struct", (LONGINT)7); Enter__49((CHAR*)"struct", (LONGINT)7);
Enter__48((CHAR*)"switch", (LONGINT)7); Enter__49((CHAR*)"switch", (LONGINT)7);
Enter__48((CHAR*)"typedef", (LONGINT)8); Enter__49((CHAR*)"typedef", (LONGINT)8);
Enter__48((CHAR*)"union", (LONGINT)6); Enter__49((CHAR*)"union", (LONGINT)6);
Enter__48((CHAR*)"unsigned", (LONGINT)9); Enter__49((CHAR*)"unsigned", (LONGINT)9);
Enter__48((CHAR*)"void", (LONGINT)5); Enter__49((CHAR*)"void", (LONGINT)5);
Enter__48((CHAR*)"volatile", (LONGINT)9); Enter__49((CHAR*)"volatile", (LONGINT)9);
Enter__48((CHAR*)"while", (LONGINT)6); Enter__49((CHAR*)"while", (LONGINT)6);
InitKeywords__47_s = _s.lnk; InitKeywords__48_s = _s.lnk;
} }

View file

@ -228,17 +228,17 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35); OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" a - don\'t check ASSERTs at runtime, use this option in tested production code", (LONGINT)80); OPM_LogWStr((CHAR*)" a - don't check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48); OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" t - don\'t check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101); OPM_LogWStr((CHAR*)" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" S - don\'t call external assembler/compiler, only generate C code", (LONGINT)67); OPM_LogWStr((CHAR*)" S - don't call external assembler/compiler, only generate C code", (LONGINT)67);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24); OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" f - don\'t use color output", (LONGINT)29); OPM_LogWStr((CHAR*)" f - don't use color output", (LONGINT)29);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57); OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57);
OPM_LogWLn(); OPM_LogWLn();

View file

@ -325,7 +325,7 @@ void OPS_Get (SHORTINT *sym)
} }
} }
switch (OPS_ch) { switch (OPS_ch) {
case '\"': case '\'': case '"': case '\'':
OPS_Str(&s); OPS_Str(&s);
break; break;
case '#': case '#':

View file

@ -787,9 +787,9 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
(*S).s[__X(i, ((LONGINT)(64)))] = 0x00; (*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
(*S).len = i; (*S).len = i;
(*S).class = 1; (*S).class = 1;
} else if (ch == '\"') { } else if (ch == '"') {
Texts_Read((void*)&*S, S__typ, &ch); Texts_Read((void*)&*S, S__typ, &ch);
while ((((ch != '\"' && ch >= ' ')) && i != 63)) { while ((((ch != '"' && ch >= ' ')) && i != 63)) {
(*S).s[__X(i, ((LONGINT)(64)))] = ch; (*S).s[__X(i, ((LONGINT)(64)))] = ch;
i += 1; i += 1;
Texts_Read((void*)&*S, S__typ, &ch); Texts_Read((void*)&*S, S__typ, &ch);

View file

@ -25,7 +25,7 @@ export void *errors__init(void)
errors_errors[6][0] = 0x00; errors_errors[6][0] = 0x00;
errors_errors[7][0] = 0x00; errors_errors[7][0] = 0x00;
errors_errors[8][0] = 0x00; errors_errors[8][0] = 0x00;
__MOVE("\'=\' expected", errors_errors[9], 13); __MOVE("'=' expected", errors_errors[9], 13);
errors_errors[10][0] = 0x00; errors_errors[10][0] = 0x00;
errors_errors[11][0] = 0x00; errors_errors[11][0] = 0x00;
__MOVE("type definition starts with incorrect symbol", errors_errors[12], 45); __MOVE("type definition starts with incorrect symbol", errors_errors[12], 45);
@ -34,28 +34,28 @@ export void *errors__init(void)
__MOVE("declaration followed by incorrect symbol", errors_errors[15], 41); __MOVE("declaration followed by incorrect symbol", errors_errors[15], 41);
__MOVE("MODULE expected", errors_errors[16], 16); __MOVE("MODULE expected", errors_errors[16], 16);
errors_errors[17][0] = 0x00; errors_errors[17][0] = 0x00;
__MOVE("\'.\' missing", errors_errors[18], 12); __MOVE("'.' missing", errors_errors[18], 12);
__MOVE("\',\' missing", errors_errors[19], 12); __MOVE("',' missing", errors_errors[19], 12);
__MOVE("\':\' missing", errors_errors[20], 12); __MOVE("':' missing", errors_errors[20], 12);
errors_errors[21][0] = 0x00; errors_errors[21][0] = 0x00;
__MOVE("\')\' missing", errors_errors[22], 12); __MOVE("')' missing", errors_errors[22], 12);
__MOVE("\']\' missing", errors_errors[23], 12); __MOVE("']' missing", errors_errors[23], 12);
__MOVE("\'}\' missing", errors_errors[24], 12); __MOVE("'}' missing", errors_errors[24], 12);
__MOVE("OF missing", errors_errors[25], 11); __MOVE("OF missing", errors_errors[25], 11);
__MOVE("THEN missing", errors_errors[26], 13); __MOVE("THEN missing", errors_errors[26], 13);
__MOVE("DO missing", errors_errors[27], 11); __MOVE("DO missing", errors_errors[27], 11);
__MOVE("TO missing", errors_errors[28], 11); __MOVE("TO missing", errors_errors[28], 11);
errors_errors[29][0] = 0x00; errors_errors[29][0] = 0x00;
__MOVE("\'(\' missing", errors_errors[30], 12); __MOVE("'(' missing", errors_errors[30], 12);
errors_errors[31][0] = 0x00; errors_errors[31][0] = 0x00;
errors_errors[32][0] = 0x00; errors_errors[32][0] = 0x00;
errors_errors[33][0] = 0x00; errors_errors[33][0] = 0x00;
__MOVE("\':=\' missing", errors_errors[34], 13); __MOVE("':=' missing", errors_errors[34], 13);
__MOVE("\',\' or OF expected", errors_errors[35], 19); __MOVE("',' or OF expected", errors_errors[35], 19);
errors_errors[36][0] = 0x00; errors_errors[36][0] = 0x00;
errors_errors[37][0] = 0x00; errors_errors[37][0] = 0x00;
__MOVE("identifier expected", errors_errors[38], 20); __MOVE("identifier expected", errors_errors[38], 20);
__MOVE("\';\' missing", errors_errors[39], 12); __MOVE("';' missing", errors_errors[39], 12);
errors_errors[40][0] = 0x00; errors_errors[40][0] = 0x00;
__MOVE("END missing", errors_errors[41], 12); __MOVE("END missing", errors_errors[41], 12);
errors_errors[42][0] = 0x00; errors_errors[42][0] = 0x00;
@ -131,10 +131,10 @@ export void *errors__init(void)
__MOVE("operand is not a variable", errors_errors[112], 26); __MOVE("operand is not a variable", errors_errors[112], 26);
__MOVE("incompatible assignment", errors_errors[113], 24); __MOVE("incompatible assignment", errors_errors[113], 24);
__MOVE("string too long to be assigned", errors_errors[114], 31); __MOVE("string too long to be assigned", errors_errors[114], 31);
__MOVE("parameter doesn\'t match", errors_errors[115], 24); __MOVE("parameter doesn't match", errors_errors[115], 24);
__MOVE("number of parameters doesn\'t match", errors_errors[116], 35); __MOVE("number of parameters doesn't match", errors_errors[116], 35);
__MOVE("result type doesn\'t match", errors_errors[117], 26); __MOVE("result type doesn't match", errors_errors[117], 26);
__MOVE("export mark doesn\'t match with forward declaration", errors_errors[118], 51); __MOVE("export mark doesn't match with forward declaration", errors_errors[118], 51);
__MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61); __MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61);
__MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71); __MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71);
__MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64); __MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64);

View file

@ -252,7 +252,7 @@ export void *vt100__init(void)
__REGCMD("RCP", vt100_RCP); __REGCMD("RCP", vt100_RCP);
__REGCMD("SCP", vt100_SCP); __REGCMD("SCP", vt100_SCP);
/* BEGIN */ /* BEGIN */
__COPY("", vt100_CSI, ((LONGINT)(5))); __COPY("\033", vt100_CSI, ((LONGINT)(5)));
Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5))); Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5)));
__ENDMOD; __ENDMOD;
} }

View file

@ -23,6 +23,7 @@ export void OPC_BegBlk (void);
export void OPC_BegStat (void); export void OPC_BegStat (void);
static void OPC_CProcDefs (OPT_Object obj, INTEGER vis); static void OPC_CProcDefs (OPT_Object obj, INTEGER vis);
export void OPC_Case (LONGINT caseVal, INTEGER form); export void OPC_Case (LONGINT caseVal, INTEGER form);
static void OPC_CharacterLiteral (LONGINT c);
export void OPC_Cmp (INTEGER rel); export void OPC_Cmp (INTEGER rel);
export void OPC_CompleteIdent (OPT_Object obj); export void OPC_CompleteIdent (OPT_Object obj);
export void OPC_Constant (OPT_Const con, INTEGER form); export void OPC_Constant (OPT_Const con, INTEGER form);
@ -76,6 +77,7 @@ static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude); export void OPC_SetInclude (BOOLEAN exclude);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause); static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x); static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x);
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l);
export void OPC_TDescDecl (OPT_Struct typ); export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INTEGER vis); export void OPC_TypeDefs (OPT_Object obj, INTEGER vis);
export void OPC_TypeOf (OPT_Object ap); export void OPC_TypeOf (OPT_Object ap);
@ -816,11 +818,12 @@ void OPC_TDescDecl (OPT_Struct typ)
OPC_Andent(typ); OPC_Andent(typ);
OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1); OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1);
OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ)); OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ));
OPM_Write('\"'); OPM_Write('"');
if (typ->strobj != NIL) { if (typ->strobj != NIL) {
OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256))); OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256)));
} }
OPC_Str1((CHAR*)"\", #), {", (LONGINT)9, typ->size); OPM_Write('"');
OPC_Str1((CHAR*)", #), {", (LONGINT)8, typ->size);
nofptrs = 0; nofptrs = 0;
OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs); OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs);
OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize)); OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize));
@ -1171,10 +1174,10 @@ static void OPC_Include (CHAR *name, LONGINT name__len)
{ {
__DUP(name, name__len, CHAR); __DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", (LONGINT)10); OPM_WriteString((CHAR*)"#include ", (LONGINT)10);
OPM_Write('\"'); OPM_Write('"');
OPM_WriteStringVar((void*)name, name__len); OPM_WriteStringVar((void*)name, name__len);
OPM_WriteString((CHAR*)".h", (LONGINT)3); OPM_WriteString((CHAR*)".h", (LONGINT)3);
OPM_Write('\"'); OPM_Write('"');
OPM_WriteLn(); OPM_WriteLn();
__DEL(name); __DEL(name);
} }
@ -1856,26 +1859,56 @@ void OPC_Cmp (INTEGER rel)
} }
} }
static void OPC_CharacterLiteral (LONGINT c)
{
if (c < 32 || c > 126) {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(c);
} else {
OPM_Write('\'');
if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
OPM_Write('\'');
}
}
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
{
LONGINT i;
INTEGER c;
__DUP(s, s__len, CHAR);
OPM_Write('"');
i = 0;
while (i < l) {
c = (int)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
c = __MASK(c, -64);
OPM_Write((CHAR)(48 + __ASHR(c, 3)));
c = __MASK(c, -8);
OPM_Write((CHAR)(48 + c));
} else {
if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
}
i += 1;
}
OPM_Write('"');
__DEL(s);
}
void OPC_Case (LONGINT caseVal, INTEGER form) void OPC_Case (LONGINT caseVal, INTEGER form)
{ {
CHAR ch; CHAR ch;
OPM_WriteString((CHAR*)"case ", (LONGINT)6); OPM_WriteString((CHAR*)"case ", (LONGINT)6);
switch (form) { switch (form) {
case 3: case 3:
ch = (CHAR)caseVal; OPC_CharacterLiteral(caseVal);
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
OPM_Write(ch);
} else {
OPM_Write(ch);
}
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(caseVal);
}
break; break;
case 4: case 5: case 6: case 4: case 5: case 6:
OPM_WriteInt(caseVal); OPM_WriteInt(caseVal);
@ -1933,8 +1966,7 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
void OPC_Constant (OPT_Const con, INTEGER form) void OPC_Constant (OPT_Const con, INTEGER form)
{ {
INTEGER i, len; INTEGER i;
CHAR ch;
SET s; SET s;
LONGINT hex; LONGINT hex;
BOOLEAN skipLeading; BOOLEAN skipLeading;
@ -1946,18 +1978,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
OPM_WriteInt(con->intval); OPM_WriteInt(con->intval);
break; break;
case 3: case 3:
ch = (CHAR)con->intval; OPC_CharacterLiteral(con->intval);
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(con->intval);
}
break; break;
case 4: case 5: case 6: case 4: case 5: case 6:
OPM_WriteInt(con->intval); OPM_WriteInt(con->intval);
@ -1992,18 +2013,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
} }
break; break;
case 10: case 10:
OPM_Write('\"'); OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1);
len = (int)con->intval2 - 1;
i = 0;
while (i < len) {
ch = (*con->ext)[__X(i, ((LONGINT)(256)))];
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
i += 1;
}
OPM_Write('\"');
break; break;
case 11: case 11:
OPM_WriteString((CHAR*)"NIL", (LONGINT)4); OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
@ -2016,74 +2026,74 @@ void OPC_Constant (OPT_Const con, INTEGER form)
} }
} }
static struct InitKeywords__47 { static struct InitKeywords__48 {
SHORTINT *n; SHORTINT *n;
struct InitKeywords__47 *lnk; struct InitKeywords__48 *lnk;
} *InitKeywords__47_s; } *InitKeywords__48_s;
static void Enter__48 (CHAR *s, LONGINT s__len); static void Enter__49 (CHAR *s, LONGINT s__len);
static void Enter__48 (CHAR *s, LONGINT s__len) static void Enter__49 (CHAR *s, LONGINT s__len)
{ {
INTEGER h; INTEGER h;
__DUP(s, s__len, CHAR); __DUP(s, s__len, CHAR);
h = OPC_PerfectHash((void*)s, s__len); h = OPC_PerfectHash((void*)s, s__len);
OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n; OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n;
__COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); __COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
*InitKeywords__47_s->n += 1; *InitKeywords__48_s->n += 1;
__DEL(s); __DEL(s);
} }
static void OPC_InitKeywords (void) static void OPC_InitKeywords (void)
{ {
SHORTINT n, i; SHORTINT n, i;
struct InitKeywords__47 _s; struct InitKeywords__48 _s;
_s.n = &n; _s.n = &n;
_s.lnk = InitKeywords__47_s; _s.lnk = InitKeywords__48_s;
InitKeywords__47_s = &_s; InitKeywords__48_s = &_s;
n = 0; n = 0;
i = 0; i = 0;
while (i <= 104) { while (i <= 104) {
OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1; OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1;
i += 1; i += 1;
} }
Enter__48((CHAR*)"asm", (LONGINT)4); Enter__49((CHAR*)"asm", (LONGINT)4);
Enter__48((CHAR*)"auto", (LONGINT)5); Enter__49((CHAR*)"auto", (LONGINT)5);
Enter__48((CHAR*)"break", (LONGINT)6); Enter__49((CHAR*)"break", (LONGINT)6);
Enter__48((CHAR*)"case", (LONGINT)5); Enter__49((CHAR*)"case", (LONGINT)5);
Enter__48((CHAR*)"char", (LONGINT)5); Enter__49((CHAR*)"char", (LONGINT)5);
Enter__48((CHAR*)"const", (LONGINT)6); Enter__49((CHAR*)"const", (LONGINT)6);
Enter__48((CHAR*)"continue", (LONGINT)9); Enter__49((CHAR*)"continue", (LONGINT)9);
Enter__48((CHAR*)"default", (LONGINT)8); Enter__49((CHAR*)"default", (LONGINT)8);
Enter__48((CHAR*)"do", (LONGINT)3); Enter__49((CHAR*)"do", (LONGINT)3);
Enter__48((CHAR*)"double", (LONGINT)7); Enter__49((CHAR*)"double", (LONGINT)7);
Enter__48((CHAR*)"else", (LONGINT)5); Enter__49((CHAR*)"else", (LONGINT)5);
Enter__48((CHAR*)"enum", (LONGINT)5); Enter__49((CHAR*)"enum", (LONGINT)5);
Enter__48((CHAR*)"extern", (LONGINT)7); Enter__49((CHAR*)"extern", (LONGINT)7);
Enter__48((CHAR*)"export", (LONGINT)7); Enter__49((CHAR*)"export", (LONGINT)7);
Enter__48((CHAR*)"float", (LONGINT)6); Enter__49((CHAR*)"float", (LONGINT)6);
Enter__48((CHAR*)"for", (LONGINT)4); Enter__49((CHAR*)"for", (LONGINT)4);
Enter__48((CHAR*)"fortran", (LONGINT)8); Enter__49((CHAR*)"fortran", (LONGINT)8);
Enter__48((CHAR*)"goto", (LONGINT)5); Enter__49((CHAR*)"goto", (LONGINT)5);
Enter__48((CHAR*)"if", (LONGINT)3); Enter__49((CHAR*)"if", (LONGINT)3);
Enter__48((CHAR*)"import", (LONGINT)7); Enter__49((CHAR*)"import", (LONGINT)7);
Enter__48((CHAR*)"int", (LONGINT)4); Enter__49((CHAR*)"int", (LONGINT)4);
Enter__48((CHAR*)"long", (LONGINT)5); Enter__49((CHAR*)"long", (LONGINT)5);
Enter__48((CHAR*)"register", (LONGINT)9); Enter__49((CHAR*)"register", (LONGINT)9);
Enter__48((CHAR*)"return", (LONGINT)7); Enter__49((CHAR*)"return", (LONGINT)7);
Enter__48((CHAR*)"short", (LONGINT)6); Enter__49((CHAR*)"short", (LONGINT)6);
Enter__48((CHAR*)"signed", (LONGINT)7); Enter__49((CHAR*)"signed", (LONGINT)7);
Enter__48((CHAR*)"sizeof", (LONGINT)7); Enter__49((CHAR*)"sizeof", (LONGINT)7);
Enter__48((CHAR*)"static", (LONGINT)7); Enter__49((CHAR*)"static", (LONGINT)7);
Enter__48((CHAR*)"struct", (LONGINT)7); Enter__49((CHAR*)"struct", (LONGINT)7);
Enter__48((CHAR*)"switch", (LONGINT)7); Enter__49((CHAR*)"switch", (LONGINT)7);
Enter__48((CHAR*)"typedef", (LONGINT)8); Enter__49((CHAR*)"typedef", (LONGINT)8);
Enter__48((CHAR*)"union", (LONGINT)6); Enter__49((CHAR*)"union", (LONGINT)6);
Enter__48((CHAR*)"unsigned", (LONGINT)9); Enter__49((CHAR*)"unsigned", (LONGINT)9);
Enter__48((CHAR*)"void", (LONGINT)5); Enter__49((CHAR*)"void", (LONGINT)5);
Enter__48((CHAR*)"volatile", (LONGINT)9); Enter__49((CHAR*)"volatile", (LONGINT)9);
Enter__48((CHAR*)"while", (LONGINT)6); Enter__49((CHAR*)"while", (LONGINT)6);
InitKeywords__47_s = _s.lnk; InitKeywords__48_s = _s.lnk;
} }

View file

@ -229,17 +229,17 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35); OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" a - don\'t check ASSERTs at runtime, use this option in tested production code", (LONGINT)80); OPM_LogWStr((CHAR*)" a - don't check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48); OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" t - don\'t check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101); OPM_LogWStr((CHAR*)" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" S - don\'t call external assembler/compiler, only generate C code", (LONGINT)67); OPM_LogWStr((CHAR*)" S - don't call external assembler/compiler, only generate C code", (LONGINT)67);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24); OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" f - don\'t use color output", (LONGINT)29); OPM_LogWStr((CHAR*)" f - don't use color output", (LONGINT)29);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57); OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57);
OPM_LogWLn(); OPM_LogWLn();

View file

@ -326,7 +326,7 @@ void OPS_Get (SHORTINT *sym)
} }
} }
switch (OPS_ch) { switch (OPS_ch) {
case '\"': case '\'': case '"': case '\'':
OPS_Str(&s); OPS_Str(&s);
break; break;
case '#': case '#':

View file

@ -788,9 +788,9 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
(*S).s[__X(i, ((LONGINT)(64)))] = 0x00; (*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
(*S).len = i; (*S).len = i;
(*S).class = 1; (*S).class = 1;
} else if (ch == '\"') { } else if (ch == '"') {
Texts_Read((void*)&*S, S__typ, &ch); Texts_Read((void*)&*S, S__typ, &ch);
while ((((ch != '\"' && ch >= ' ')) && i != 63)) { while ((((ch != '"' && ch >= ' ')) && i != 63)) {
(*S).s[__X(i, ((LONGINT)(64)))] = ch; (*S).s[__X(i, ((LONGINT)(64)))] = ch;
i += 1; i += 1;
Texts_Read((void*)&*S, S__typ, &ch); Texts_Read((void*)&*S, S__typ, &ch);

View file

@ -26,7 +26,7 @@ export void *errors__init(void)
errors_errors[6][0] = 0x00; errors_errors[6][0] = 0x00;
errors_errors[7][0] = 0x00; errors_errors[7][0] = 0x00;
errors_errors[8][0] = 0x00; errors_errors[8][0] = 0x00;
__MOVE("\'=\' expected", errors_errors[9], 13); __MOVE("'=' expected", errors_errors[9], 13);
errors_errors[10][0] = 0x00; errors_errors[10][0] = 0x00;
errors_errors[11][0] = 0x00; errors_errors[11][0] = 0x00;
__MOVE("type definition starts with incorrect symbol", errors_errors[12], 45); __MOVE("type definition starts with incorrect symbol", errors_errors[12], 45);
@ -35,28 +35,28 @@ export void *errors__init(void)
__MOVE("declaration followed by incorrect symbol", errors_errors[15], 41); __MOVE("declaration followed by incorrect symbol", errors_errors[15], 41);
__MOVE("MODULE expected", errors_errors[16], 16); __MOVE("MODULE expected", errors_errors[16], 16);
errors_errors[17][0] = 0x00; errors_errors[17][0] = 0x00;
__MOVE("\'.\' missing", errors_errors[18], 12); __MOVE("'.' missing", errors_errors[18], 12);
__MOVE("\',\' missing", errors_errors[19], 12); __MOVE("',' missing", errors_errors[19], 12);
__MOVE("\':\' missing", errors_errors[20], 12); __MOVE("':' missing", errors_errors[20], 12);
errors_errors[21][0] = 0x00; errors_errors[21][0] = 0x00;
__MOVE("\')\' missing", errors_errors[22], 12); __MOVE("')' missing", errors_errors[22], 12);
__MOVE("\']\' missing", errors_errors[23], 12); __MOVE("']' missing", errors_errors[23], 12);
__MOVE("\'}\' missing", errors_errors[24], 12); __MOVE("'}' missing", errors_errors[24], 12);
__MOVE("OF missing", errors_errors[25], 11); __MOVE("OF missing", errors_errors[25], 11);
__MOVE("THEN missing", errors_errors[26], 13); __MOVE("THEN missing", errors_errors[26], 13);
__MOVE("DO missing", errors_errors[27], 11); __MOVE("DO missing", errors_errors[27], 11);
__MOVE("TO missing", errors_errors[28], 11); __MOVE("TO missing", errors_errors[28], 11);
errors_errors[29][0] = 0x00; errors_errors[29][0] = 0x00;
__MOVE("\'(\' missing", errors_errors[30], 12); __MOVE("'(' missing", errors_errors[30], 12);
errors_errors[31][0] = 0x00; errors_errors[31][0] = 0x00;
errors_errors[32][0] = 0x00; errors_errors[32][0] = 0x00;
errors_errors[33][0] = 0x00; errors_errors[33][0] = 0x00;
__MOVE("\':=\' missing", errors_errors[34], 13); __MOVE("':=' missing", errors_errors[34], 13);
__MOVE("\',\' or OF expected", errors_errors[35], 19); __MOVE("',' or OF expected", errors_errors[35], 19);
errors_errors[36][0] = 0x00; errors_errors[36][0] = 0x00;
errors_errors[37][0] = 0x00; errors_errors[37][0] = 0x00;
__MOVE("identifier expected", errors_errors[38], 20); __MOVE("identifier expected", errors_errors[38], 20);
__MOVE("\';\' missing", errors_errors[39], 12); __MOVE("';' missing", errors_errors[39], 12);
errors_errors[40][0] = 0x00; errors_errors[40][0] = 0x00;
__MOVE("END missing", errors_errors[41], 12); __MOVE("END missing", errors_errors[41], 12);
errors_errors[42][0] = 0x00; errors_errors[42][0] = 0x00;
@ -132,10 +132,10 @@ export void *errors__init(void)
__MOVE("operand is not a variable", errors_errors[112], 26); __MOVE("operand is not a variable", errors_errors[112], 26);
__MOVE("incompatible assignment", errors_errors[113], 24); __MOVE("incompatible assignment", errors_errors[113], 24);
__MOVE("string too long to be assigned", errors_errors[114], 31); __MOVE("string too long to be assigned", errors_errors[114], 31);
__MOVE("parameter doesn\'t match", errors_errors[115], 24); __MOVE("parameter doesn't match", errors_errors[115], 24);
__MOVE("number of parameters doesn\'t match", errors_errors[116], 35); __MOVE("number of parameters doesn't match", errors_errors[116], 35);
__MOVE("result type doesn\'t match", errors_errors[117], 26); __MOVE("result type doesn't match", errors_errors[117], 26);
__MOVE("export mark doesn\'t match with forward declaration", errors_errors[118], 51); __MOVE("export mark doesn't match with forward declaration", errors_errors[118], 51);
__MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61); __MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61);
__MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71); __MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71);
__MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64); __MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64);

View file

@ -253,7 +253,7 @@ export void *vt100__init(void)
__REGCMD("RCP", vt100_RCP); __REGCMD("RCP", vt100_RCP);
__REGCMD("SCP", vt100_SCP); __REGCMD("SCP", vt100_SCP);
/* BEGIN */ /* BEGIN */
__COPY("", vt100_CSI, ((LONGINT)(5))); __COPY("\033", vt100_CSI, ((LONGINT)(5)));
Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5))); Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5)));
__ENDMOD; __ENDMOD;
} }

View file

@ -22,6 +22,7 @@ export void OPC_BegBlk (void);
export void OPC_BegStat (void); export void OPC_BegStat (void);
static void OPC_CProcDefs (OPT_Object obj, INTEGER vis); static void OPC_CProcDefs (OPT_Object obj, INTEGER vis);
export void OPC_Case (LONGINT caseVal, INTEGER form); export void OPC_Case (LONGINT caseVal, INTEGER form);
static void OPC_CharacterLiteral (LONGINT c);
export void OPC_Cmp (INTEGER rel); export void OPC_Cmp (INTEGER rel);
export void OPC_CompleteIdent (OPT_Object obj); export void OPC_CompleteIdent (OPT_Object obj);
export void OPC_Constant (OPT_Const con, INTEGER form); export void OPC_Constant (OPT_Const con, INTEGER form);
@ -75,6 +76,7 @@ static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude); export void OPC_SetInclude (BOOLEAN exclude);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause); static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x); static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x);
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l);
export void OPC_TDescDecl (OPT_Struct typ); export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INTEGER vis); export void OPC_TypeDefs (OPT_Object obj, INTEGER vis);
export void OPC_TypeOf (OPT_Object ap); export void OPC_TypeOf (OPT_Object ap);
@ -815,11 +817,12 @@ void OPC_TDescDecl (OPT_Struct typ)
OPC_Andent(typ); OPC_Andent(typ);
OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1); OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1);
OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ)); OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ));
OPM_Write('\"'); OPM_Write('"');
if (typ->strobj != NIL) { if (typ->strobj != NIL) {
OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256))); OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256)));
} }
OPC_Str1((CHAR*)"\", #), {", (LONGINT)9, typ->size); OPM_Write('"');
OPC_Str1((CHAR*)", #), {", (LONGINT)8, typ->size);
nofptrs = 0; nofptrs = 0;
OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs); OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs);
OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize)); OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize));
@ -1170,10 +1173,10 @@ static void OPC_Include (CHAR *name, LONGINT name__len)
{ {
__DUP(name, name__len, CHAR); __DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", (LONGINT)10); OPM_WriteString((CHAR*)"#include ", (LONGINT)10);
OPM_Write('\"'); OPM_Write('"');
OPM_WriteStringVar((void*)name, name__len); OPM_WriteStringVar((void*)name, name__len);
OPM_WriteString((CHAR*)".h", (LONGINT)3); OPM_WriteString((CHAR*)".h", (LONGINT)3);
OPM_Write('\"'); OPM_Write('"');
OPM_WriteLn(); OPM_WriteLn();
__DEL(name); __DEL(name);
} }
@ -1855,26 +1858,56 @@ void OPC_Cmp (INTEGER rel)
} }
} }
static void OPC_CharacterLiteral (LONGINT c)
{
if (c < 32 || c > 126) {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(c);
} else {
OPM_Write('\'');
if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
OPM_Write('\'');
}
}
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
{
LONGINT i;
INTEGER c;
__DUP(s, s__len, CHAR);
OPM_Write('"');
i = 0;
while (i < l) {
c = (int)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
c = __MASK(c, -64);
OPM_Write((CHAR)(48 + __ASHR(c, 3)));
c = __MASK(c, -8);
OPM_Write((CHAR)(48 + c));
} else {
if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
}
i += 1;
}
OPM_Write('"');
__DEL(s);
}
void OPC_Case (LONGINT caseVal, INTEGER form) void OPC_Case (LONGINT caseVal, INTEGER form)
{ {
CHAR ch; CHAR ch;
OPM_WriteString((CHAR*)"case ", (LONGINT)6); OPM_WriteString((CHAR*)"case ", (LONGINT)6);
switch (form) { switch (form) {
case 3: case 3:
ch = (CHAR)caseVal; OPC_CharacterLiteral(caseVal);
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
OPM_Write(ch);
} else {
OPM_Write(ch);
}
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(caseVal);
}
break; break;
case 4: case 5: case 6: case 4: case 5: case 6:
OPM_WriteInt(caseVal); OPM_WriteInt(caseVal);
@ -1932,8 +1965,7 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
void OPC_Constant (OPT_Const con, INTEGER form) void OPC_Constant (OPT_Const con, INTEGER form)
{ {
INTEGER i, len; INTEGER i;
CHAR ch;
SET s; SET s;
LONGINT hex; LONGINT hex;
BOOLEAN skipLeading; BOOLEAN skipLeading;
@ -1945,18 +1977,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
OPM_WriteInt(con->intval); OPM_WriteInt(con->intval);
break; break;
case 3: case 3:
ch = (CHAR)con->intval; OPC_CharacterLiteral(con->intval);
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(con->intval);
}
break; break;
case 4: case 5: case 6: case 4: case 5: case 6:
OPM_WriteInt(con->intval); OPM_WriteInt(con->intval);
@ -1991,18 +2012,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
} }
break; break;
case 10: case 10:
OPM_Write('\"'); OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1);
len = (int)con->intval2 - 1;
i = 0;
while (i < len) {
ch = (*con->ext)[__X(i, ((LONGINT)(256)))];
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
i += 1;
}
OPM_Write('\"');
break; break;
case 11: case 11:
OPM_WriteString((CHAR*)"NIL", (LONGINT)4); OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
@ -2015,74 +2025,74 @@ void OPC_Constant (OPT_Const con, INTEGER form)
} }
} }
static struct InitKeywords__47 { static struct InitKeywords__48 {
SHORTINT *n; SHORTINT *n;
struct InitKeywords__47 *lnk; struct InitKeywords__48 *lnk;
} *InitKeywords__47_s; } *InitKeywords__48_s;
static void Enter__48 (CHAR *s, LONGINT s__len); static void Enter__49 (CHAR *s, LONGINT s__len);
static void Enter__48 (CHAR *s, LONGINT s__len) static void Enter__49 (CHAR *s, LONGINT s__len)
{ {
INTEGER h; INTEGER h;
__DUP(s, s__len, CHAR); __DUP(s, s__len, CHAR);
h = OPC_PerfectHash((void*)s, s__len); h = OPC_PerfectHash((void*)s, s__len);
OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n; OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n;
__COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); __COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
*InitKeywords__47_s->n += 1; *InitKeywords__48_s->n += 1;
__DEL(s); __DEL(s);
} }
static void OPC_InitKeywords (void) static void OPC_InitKeywords (void)
{ {
SHORTINT n, i; SHORTINT n, i;
struct InitKeywords__47 _s; struct InitKeywords__48 _s;
_s.n = &n; _s.n = &n;
_s.lnk = InitKeywords__47_s; _s.lnk = InitKeywords__48_s;
InitKeywords__47_s = &_s; InitKeywords__48_s = &_s;
n = 0; n = 0;
i = 0; i = 0;
while (i <= 104) { while (i <= 104) {
OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1; OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1;
i += 1; i += 1;
} }
Enter__48((CHAR*)"asm", (LONGINT)4); Enter__49((CHAR*)"asm", (LONGINT)4);
Enter__48((CHAR*)"auto", (LONGINT)5); Enter__49((CHAR*)"auto", (LONGINT)5);
Enter__48((CHAR*)"break", (LONGINT)6); Enter__49((CHAR*)"break", (LONGINT)6);
Enter__48((CHAR*)"case", (LONGINT)5); Enter__49((CHAR*)"case", (LONGINT)5);
Enter__48((CHAR*)"char", (LONGINT)5); Enter__49((CHAR*)"char", (LONGINT)5);
Enter__48((CHAR*)"const", (LONGINT)6); Enter__49((CHAR*)"const", (LONGINT)6);
Enter__48((CHAR*)"continue", (LONGINT)9); Enter__49((CHAR*)"continue", (LONGINT)9);
Enter__48((CHAR*)"default", (LONGINT)8); Enter__49((CHAR*)"default", (LONGINT)8);
Enter__48((CHAR*)"do", (LONGINT)3); Enter__49((CHAR*)"do", (LONGINT)3);
Enter__48((CHAR*)"double", (LONGINT)7); Enter__49((CHAR*)"double", (LONGINT)7);
Enter__48((CHAR*)"else", (LONGINT)5); Enter__49((CHAR*)"else", (LONGINT)5);
Enter__48((CHAR*)"enum", (LONGINT)5); Enter__49((CHAR*)"enum", (LONGINT)5);
Enter__48((CHAR*)"extern", (LONGINT)7); Enter__49((CHAR*)"extern", (LONGINT)7);
Enter__48((CHAR*)"export", (LONGINT)7); Enter__49((CHAR*)"export", (LONGINT)7);
Enter__48((CHAR*)"float", (LONGINT)6); Enter__49((CHAR*)"float", (LONGINT)6);
Enter__48((CHAR*)"for", (LONGINT)4); Enter__49((CHAR*)"for", (LONGINT)4);
Enter__48((CHAR*)"fortran", (LONGINT)8); Enter__49((CHAR*)"fortran", (LONGINT)8);
Enter__48((CHAR*)"goto", (LONGINT)5); Enter__49((CHAR*)"goto", (LONGINT)5);
Enter__48((CHAR*)"if", (LONGINT)3); Enter__49((CHAR*)"if", (LONGINT)3);
Enter__48((CHAR*)"import", (LONGINT)7); Enter__49((CHAR*)"import", (LONGINT)7);
Enter__48((CHAR*)"int", (LONGINT)4); Enter__49((CHAR*)"int", (LONGINT)4);
Enter__48((CHAR*)"long", (LONGINT)5); Enter__49((CHAR*)"long", (LONGINT)5);
Enter__48((CHAR*)"register", (LONGINT)9); Enter__49((CHAR*)"register", (LONGINT)9);
Enter__48((CHAR*)"return", (LONGINT)7); Enter__49((CHAR*)"return", (LONGINT)7);
Enter__48((CHAR*)"short", (LONGINT)6); Enter__49((CHAR*)"short", (LONGINT)6);
Enter__48((CHAR*)"signed", (LONGINT)7); Enter__49((CHAR*)"signed", (LONGINT)7);
Enter__48((CHAR*)"sizeof", (LONGINT)7); Enter__49((CHAR*)"sizeof", (LONGINT)7);
Enter__48((CHAR*)"static", (LONGINT)7); Enter__49((CHAR*)"static", (LONGINT)7);
Enter__48((CHAR*)"struct", (LONGINT)7); Enter__49((CHAR*)"struct", (LONGINT)7);
Enter__48((CHAR*)"switch", (LONGINT)7); Enter__49((CHAR*)"switch", (LONGINT)7);
Enter__48((CHAR*)"typedef", (LONGINT)8); Enter__49((CHAR*)"typedef", (LONGINT)8);
Enter__48((CHAR*)"union", (LONGINT)6); Enter__49((CHAR*)"union", (LONGINT)6);
Enter__48((CHAR*)"unsigned", (LONGINT)9); Enter__49((CHAR*)"unsigned", (LONGINT)9);
Enter__48((CHAR*)"void", (LONGINT)5); Enter__49((CHAR*)"void", (LONGINT)5);
Enter__48((CHAR*)"volatile", (LONGINT)9); Enter__49((CHAR*)"volatile", (LONGINT)9);
Enter__48((CHAR*)"while", (LONGINT)6); Enter__49((CHAR*)"while", (LONGINT)6);
InitKeywords__47_s = _s.lnk; InitKeywords__48_s = _s.lnk;
} }

View file

@ -228,17 +228,17 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35); OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" a - don\'t check ASSERTs at runtime, use this option in tested production code", (LONGINT)80); OPM_LogWStr((CHAR*)" a - don't check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48); OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" t - don\'t check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101); OPM_LogWStr((CHAR*)" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" S - don\'t call external assembler/compiler, only generate C code", (LONGINT)67); OPM_LogWStr((CHAR*)" S - don't call external assembler/compiler, only generate C code", (LONGINT)67);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24); OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" f - don\'t use color output", (LONGINT)29); OPM_LogWStr((CHAR*)" f - don't use color output", (LONGINT)29);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57); OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57);
OPM_LogWLn(); OPM_LogWLn();

View file

@ -325,7 +325,7 @@ void OPS_Get (SHORTINT *sym)
} }
} }
switch (OPS_ch) { switch (OPS_ch) {
case '\"': case '\'': case '"': case '\'':
OPS_Str(&s); OPS_Str(&s);
break; break;
case '#': case '#':

View file

@ -787,9 +787,9 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
(*S).s[__X(i, ((LONGINT)(64)))] = 0x00; (*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
(*S).len = i; (*S).len = i;
(*S).class = 1; (*S).class = 1;
} else if (ch == '\"') { } else if (ch == '"') {
Texts_Read((void*)&*S, S__typ, &ch); Texts_Read((void*)&*S, S__typ, &ch);
while ((((ch != '\"' && ch >= ' ')) && i != 63)) { while ((((ch != '"' && ch >= ' ')) && i != 63)) {
(*S).s[__X(i, ((LONGINT)(64)))] = ch; (*S).s[__X(i, ((LONGINT)(64)))] = ch;
i += 1; i += 1;
Texts_Read((void*)&*S, S__typ, &ch); Texts_Read((void*)&*S, S__typ, &ch);

View file

@ -25,7 +25,7 @@ export void *errors__init(void)
errors_errors[6][0] = 0x00; errors_errors[6][0] = 0x00;
errors_errors[7][0] = 0x00; errors_errors[7][0] = 0x00;
errors_errors[8][0] = 0x00; errors_errors[8][0] = 0x00;
__MOVE("\'=\' expected", errors_errors[9], 13); __MOVE("'=' expected", errors_errors[9], 13);
errors_errors[10][0] = 0x00; errors_errors[10][0] = 0x00;
errors_errors[11][0] = 0x00; errors_errors[11][0] = 0x00;
__MOVE("type definition starts with incorrect symbol", errors_errors[12], 45); __MOVE("type definition starts with incorrect symbol", errors_errors[12], 45);
@ -34,28 +34,28 @@ export void *errors__init(void)
__MOVE("declaration followed by incorrect symbol", errors_errors[15], 41); __MOVE("declaration followed by incorrect symbol", errors_errors[15], 41);
__MOVE("MODULE expected", errors_errors[16], 16); __MOVE("MODULE expected", errors_errors[16], 16);
errors_errors[17][0] = 0x00; errors_errors[17][0] = 0x00;
__MOVE("\'.\' missing", errors_errors[18], 12); __MOVE("'.' missing", errors_errors[18], 12);
__MOVE("\',\' missing", errors_errors[19], 12); __MOVE("',' missing", errors_errors[19], 12);
__MOVE("\':\' missing", errors_errors[20], 12); __MOVE("':' missing", errors_errors[20], 12);
errors_errors[21][0] = 0x00; errors_errors[21][0] = 0x00;
__MOVE("\')\' missing", errors_errors[22], 12); __MOVE("')' missing", errors_errors[22], 12);
__MOVE("\']\' missing", errors_errors[23], 12); __MOVE("']' missing", errors_errors[23], 12);
__MOVE("\'}\' missing", errors_errors[24], 12); __MOVE("'}' missing", errors_errors[24], 12);
__MOVE("OF missing", errors_errors[25], 11); __MOVE("OF missing", errors_errors[25], 11);
__MOVE("THEN missing", errors_errors[26], 13); __MOVE("THEN missing", errors_errors[26], 13);
__MOVE("DO missing", errors_errors[27], 11); __MOVE("DO missing", errors_errors[27], 11);
__MOVE("TO missing", errors_errors[28], 11); __MOVE("TO missing", errors_errors[28], 11);
errors_errors[29][0] = 0x00; errors_errors[29][0] = 0x00;
__MOVE("\'(\' missing", errors_errors[30], 12); __MOVE("'(' missing", errors_errors[30], 12);
errors_errors[31][0] = 0x00; errors_errors[31][0] = 0x00;
errors_errors[32][0] = 0x00; errors_errors[32][0] = 0x00;
errors_errors[33][0] = 0x00; errors_errors[33][0] = 0x00;
__MOVE("\':=\' missing", errors_errors[34], 13); __MOVE("':=' missing", errors_errors[34], 13);
__MOVE("\',\' or OF expected", errors_errors[35], 19); __MOVE("',' or OF expected", errors_errors[35], 19);
errors_errors[36][0] = 0x00; errors_errors[36][0] = 0x00;
errors_errors[37][0] = 0x00; errors_errors[37][0] = 0x00;
__MOVE("identifier expected", errors_errors[38], 20); __MOVE("identifier expected", errors_errors[38], 20);
__MOVE("\';\' missing", errors_errors[39], 12); __MOVE("';' missing", errors_errors[39], 12);
errors_errors[40][0] = 0x00; errors_errors[40][0] = 0x00;
__MOVE("END missing", errors_errors[41], 12); __MOVE("END missing", errors_errors[41], 12);
errors_errors[42][0] = 0x00; errors_errors[42][0] = 0x00;
@ -131,10 +131,10 @@ export void *errors__init(void)
__MOVE("operand is not a variable", errors_errors[112], 26); __MOVE("operand is not a variable", errors_errors[112], 26);
__MOVE("incompatible assignment", errors_errors[113], 24); __MOVE("incompatible assignment", errors_errors[113], 24);
__MOVE("string too long to be assigned", errors_errors[114], 31); __MOVE("string too long to be assigned", errors_errors[114], 31);
__MOVE("parameter doesn\'t match", errors_errors[115], 24); __MOVE("parameter doesn't match", errors_errors[115], 24);
__MOVE("number of parameters doesn\'t match", errors_errors[116], 35); __MOVE("number of parameters doesn't match", errors_errors[116], 35);
__MOVE("result type doesn\'t match", errors_errors[117], 26); __MOVE("result type doesn't match", errors_errors[117], 26);
__MOVE("export mark doesn\'t match with forward declaration", errors_errors[118], 51); __MOVE("export mark doesn't match with forward declaration", errors_errors[118], 51);
__MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61); __MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61);
__MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71); __MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71);
__MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64); __MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64);

View file

@ -252,7 +252,7 @@ export void *vt100__init(void)
__REGCMD("RCP", vt100_RCP); __REGCMD("RCP", vt100_RCP);
__REGCMD("SCP", vt100_SCP); __REGCMD("SCP", vt100_SCP);
/* BEGIN */ /* BEGIN */
__COPY("", vt100_CSI, ((LONGINT)(5))); __COPY("\033", vt100_CSI, ((LONGINT)(5)));
Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5))); Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5)));
__ENDMOD; __ENDMOD;
} }

View file

@ -23,6 +23,7 @@ export void OPC_BegBlk (void);
export void OPC_BegStat (void); export void OPC_BegStat (void);
static void OPC_CProcDefs (OPT_Object obj, INTEGER vis); static void OPC_CProcDefs (OPT_Object obj, INTEGER vis);
export void OPC_Case (LONGINT caseVal, INTEGER form); export void OPC_Case (LONGINT caseVal, INTEGER form);
static void OPC_CharacterLiteral (LONGINT c);
export void OPC_Cmp (INTEGER rel); export void OPC_Cmp (INTEGER rel);
export void OPC_CompleteIdent (OPT_Object obj); export void OPC_CompleteIdent (OPT_Object obj);
export void OPC_Constant (OPT_Const con, INTEGER form); export void OPC_Constant (OPT_Const con, INTEGER form);
@ -76,6 +77,7 @@ static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude); export void OPC_SetInclude (BOOLEAN exclude);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause); static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x); static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x);
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l);
export void OPC_TDescDecl (OPT_Struct typ); export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INTEGER vis); export void OPC_TypeDefs (OPT_Object obj, INTEGER vis);
export void OPC_TypeOf (OPT_Object ap); export void OPC_TypeOf (OPT_Object ap);
@ -816,11 +818,12 @@ void OPC_TDescDecl (OPT_Struct typ)
OPC_Andent(typ); OPC_Andent(typ);
OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1); OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1);
OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ)); OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ));
OPM_Write('\"'); OPM_Write('"');
if (typ->strobj != NIL) { if (typ->strobj != NIL) {
OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256))); OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256)));
} }
OPC_Str1((CHAR*)"\", #), {", (LONGINT)9, typ->size); OPM_Write('"');
OPC_Str1((CHAR*)", #), {", (LONGINT)8, typ->size);
nofptrs = 0; nofptrs = 0;
OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs); OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs);
OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize)); OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize));
@ -1171,10 +1174,10 @@ static void OPC_Include (CHAR *name, LONGINT name__len)
{ {
__DUP(name, name__len, CHAR); __DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", (LONGINT)10); OPM_WriteString((CHAR*)"#include ", (LONGINT)10);
OPM_Write('\"'); OPM_Write('"');
OPM_WriteStringVar((void*)name, name__len); OPM_WriteStringVar((void*)name, name__len);
OPM_WriteString((CHAR*)".h", (LONGINT)3); OPM_WriteString((CHAR*)".h", (LONGINT)3);
OPM_Write('\"'); OPM_Write('"');
OPM_WriteLn(); OPM_WriteLn();
__DEL(name); __DEL(name);
} }
@ -1856,26 +1859,56 @@ void OPC_Cmp (INTEGER rel)
} }
} }
static void OPC_CharacterLiteral (LONGINT c)
{
if (c < 32 || c > 126) {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(c);
} else {
OPM_Write('\'');
if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
OPM_Write('\'');
}
}
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
{
LONGINT i;
INTEGER c;
__DUP(s, s__len, CHAR);
OPM_Write('"');
i = 0;
while (i < l) {
c = (int)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
c = __MASK(c, -64);
OPM_Write((CHAR)(48 + __ASHR(c, 3)));
c = __MASK(c, -8);
OPM_Write((CHAR)(48 + c));
} else {
if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
}
i += 1;
}
OPM_Write('"');
__DEL(s);
}
void OPC_Case (LONGINT caseVal, INTEGER form) void OPC_Case (LONGINT caseVal, INTEGER form)
{ {
CHAR ch; CHAR ch;
OPM_WriteString((CHAR*)"case ", (LONGINT)6); OPM_WriteString((CHAR*)"case ", (LONGINT)6);
switch (form) { switch (form) {
case 3: case 3:
ch = (CHAR)caseVal; OPC_CharacterLiteral(caseVal);
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
OPM_Write(ch);
} else {
OPM_Write(ch);
}
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(caseVal);
}
break; break;
case 4: case 5: case 6: case 4: case 5: case 6:
OPM_WriteInt(caseVal); OPM_WriteInt(caseVal);
@ -1933,8 +1966,7 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
void OPC_Constant (OPT_Const con, INTEGER form) void OPC_Constant (OPT_Const con, INTEGER form)
{ {
INTEGER i, len; INTEGER i;
CHAR ch;
SET s; SET s;
LONGINT hex; LONGINT hex;
BOOLEAN skipLeading; BOOLEAN skipLeading;
@ -1946,18 +1978,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
OPM_WriteInt(con->intval); OPM_WriteInt(con->intval);
break; break;
case 3: case 3:
ch = (CHAR)con->intval; OPC_CharacterLiteral(con->intval);
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(con->intval);
}
break; break;
case 4: case 5: case 6: case 4: case 5: case 6:
OPM_WriteInt(con->intval); OPM_WriteInt(con->intval);
@ -1992,18 +2013,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
} }
break; break;
case 10: case 10:
OPM_Write('\"'); OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1);
len = (int)con->intval2 - 1;
i = 0;
while (i < len) {
ch = (*con->ext)[__X(i, ((LONGINT)(256)))];
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
i += 1;
}
OPM_Write('\"');
break; break;
case 11: case 11:
OPM_WriteString((CHAR*)"NIL", (LONGINT)4); OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
@ -2016,74 +2026,74 @@ void OPC_Constant (OPT_Const con, INTEGER form)
} }
} }
static struct InitKeywords__47 { static struct InitKeywords__48 {
SHORTINT *n; SHORTINT *n;
struct InitKeywords__47 *lnk; struct InitKeywords__48 *lnk;
} *InitKeywords__47_s; } *InitKeywords__48_s;
static void Enter__48 (CHAR *s, LONGINT s__len); static void Enter__49 (CHAR *s, LONGINT s__len);
static void Enter__48 (CHAR *s, LONGINT s__len) static void Enter__49 (CHAR *s, LONGINT s__len)
{ {
INTEGER h; INTEGER h;
__DUP(s, s__len, CHAR); __DUP(s, s__len, CHAR);
h = OPC_PerfectHash((void*)s, s__len); h = OPC_PerfectHash((void*)s, s__len);
OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n; OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n;
__COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); __COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
*InitKeywords__47_s->n += 1; *InitKeywords__48_s->n += 1;
__DEL(s); __DEL(s);
} }
static void OPC_InitKeywords (void) static void OPC_InitKeywords (void)
{ {
SHORTINT n, i; SHORTINT n, i;
struct InitKeywords__47 _s; struct InitKeywords__48 _s;
_s.n = &n; _s.n = &n;
_s.lnk = InitKeywords__47_s; _s.lnk = InitKeywords__48_s;
InitKeywords__47_s = &_s; InitKeywords__48_s = &_s;
n = 0; n = 0;
i = 0; i = 0;
while (i <= 104) { while (i <= 104) {
OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1; OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1;
i += 1; i += 1;
} }
Enter__48((CHAR*)"asm", (LONGINT)4); Enter__49((CHAR*)"asm", (LONGINT)4);
Enter__48((CHAR*)"auto", (LONGINT)5); Enter__49((CHAR*)"auto", (LONGINT)5);
Enter__48((CHAR*)"break", (LONGINT)6); Enter__49((CHAR*)"break", (LONGINT)6);
Enter__48((CHAR*)"case", (LONGINT)5); Enter__49((CHAR*)"case", (LONGINT)5);
Enter__48((CHAR*)"char", (LONGINT)5); Enter__49((CHAR*)"char", (LONGINT)5);
Enter__48((CHAR*)"const", (LONGINT)6); Enter__49((CHAR*)"const", (LONGINT)6);
Enter__48((CHAR*)"continue", (LONGINT)9); Enter__49((CHAR*)"continue", (LONGINT)9);
Enter__48((CHAR*)"default", (LONGINT)8); Enter__49((CHAR*)"default", (LONGINT)8);
Enter__48((CHAR*)"do", (LONGINT)3); Enter__49((CHAR*)"do", (LONGINT)3);
Enter__48((CHAR*)"double", (LONGINT)7); Enter__49((CHAR*)"double", (LONGINT)7);
Enter__48((CHAR*)"else", (LONGINT)5); Enter__49((CHAR*)"else", (LONGINT)5);
Enter__48((CHAR*)"enum", (LONGINT)5); Enter__49((CHAR*)"enum", (LONGINT)5);
Enter__48((CHAR*)"extern", (LONGINT)7); Enter__49((CHAR*)"extern", (LONGINT)7);
Enter__48((CHAR*)"export", (LONGINT)7); Enter__49((CHAR*)"export", (LONGINT)7);
Enter__48((CHAR*)"float", (LONGINT)6); Enter__49((CHAR*)"float", (LONGINT)6);
Enter__48((CHAR*)"for", (LONGINT)4); Enter__49((CHAR*)"for", (LONGINT)4);
Enter__48((CHAR*)"fortran", (LONGINT)8); Enter__49((CHAR*)"fortran", (LONGINT)8);
Enter__48((CHAR*)"goto", (LONGINT)5); Enter__49((CHAR*)"goto", (LONGINT)5);
Enter__48((CHAR*)"if", (LONGINT)3); Enter__49((CHAR*)"if", (LONGINT)3);
Enter__48((CHAR*)"import", (LONGINT)7); Enter__49((CHAR*)"import", (LONGINT)7);
Enter__48((CHAR*)"int", (LONGINT)4); Enter__49((CHAR*)"int", (LONGINT)4);
Enter__48((CHAR*)"long", (LONGINT)5); Enter__49((CHAR*)"long", (LONGINT)5);
Enter__48((CHAR*)"register", (LONGINT)9); Enter__49((CHAR*)"register", (LONGINT)9);
Enter__48((CHAR*)"return", (LONGINT)7); Enter__49((CHAR*)"return", (LONGINT)7);
Enter__48((CHAR*)"short", (LONGINT)6); Enter__49((CHAR*)"short", (LONGINT)6);
Enter__48((CHAR*)"signed", (LONGINT)7); Enter__49((CHAR*)"signed", (LONGINT)7);
Enter__48((CHAR*)"sizeof", (LONGINT)7); Enter__49((CHAR*)"sizeof", (LONGINT)7);
Enter__48((CHAR*)"static", (LONGINT)7); Enter__49((CHAR*)"static", (LONGINT)7);
Enter__48((CHAR*)"struct", (LONGINT)7); Enter__49((CHAR*)"struct", (LONGINT)7);
Enter__48((CHAR*)"switch", (LONGINT)7); Enter__49((CHAR*)"switch", (LONGINT)7);
Enter__48((CHAR*)"typedef", (LONGINT)8); Enter__49((CHAR*)"typedef", (LONGINT)8);
Enter__48((CHAR*)"union", (LONGINT)6); Enter__49((CHAR*)"union", (LONGINT)6);
Enter__48((CHAR*)"unsigned", (LONGINT)9); Enter__49((CHAR*)"unsigned", (LONGINT)9);
Enter__48((CHAR*)"void", (LONGINT)5); Enter__49((CHAR*)"void", (LONGINT)5);
Enter__48((CHAR*)"volatile", (LONGINT)9); Enter__49((CHAR*)"volatile", (LONGINT)9);
Enter__48((CHAR*)"while", (LONGINT)6); Enter__49((CHAR*)"while", (LONGINT)6);
InitKeywords__47_s = _s.lnk; InitKeywords__48_s = _s.lnk;
} }

View file

@ -229,17 +229,17 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35); OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" a - don\'t check ASSERTs at runtime, use this option in tested production code", (LONGINT)80); OPM_LogWStr((CHAR*)" a - don't check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48); OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" t - don\'t check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101); OPM_LogWStr((CHAR*)" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" S - don\'t call external assembler/compiler, only generate C code", (LONGINT)67); OPM_LogWStr((CHAR*)" S - don't call external assembler/compiler, only generate C code", (LONGINT)67);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24); OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" f - don\'t use color output", (LONGINT)29); OPM_LogWStr((CHAR*)" f - don't use color output", (LONGINT)29);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57); OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57);
OPM_LogWLn(); OPM_LogWLn();

View file

@ -326,7 +326,7 @@ void OPS_Get (SHORTINT *sym)
} }
} }
switch (OPS_ch) { switch (OPS_ch) {
case '\"': case '\'': case '"': case '\'':
OPS_Str(&s); OPS_Str(&s);
break; break;
case '#': case '#':

View file

@ -788,9 +788,9 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
(*S).s[__X(i, ((LONGINT)(64)))] = 0x00; (*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
(*S).len = i; (*S).len = i;
(*S).class = 1; (*S).class = 1;
} else if (ch == '\"') { } else if (ch == '"') {
Texts_Read((void*)&*S, S__typ, &ch); Texts_Read((void*)&*S, S__typ, &ch);
while ((((ch != '\"' && ch >= ' ')) && i != 63)) { while ((((ch != '"' && ch >= ' ')) && i != 63)) {
(*S).s[__X(i, ((LONGINT)(64)))] = ch; (*S).s[__X(i, ((LONGINT)(64)))] = ch;
i += 1; i += 1;
Texts_Read((void*)&*S, S__typ, &ch); Texts_Read((void*)&*S, S__typ, &ch);

View file

@ -26,7 +26,7 @@ export void *errors__init(void)
errors_errors[6][0] = 0x00; errors_errors[6][0] = 0x00;
errors_errors[7][0] = 0x00; errors_errors[7][0] = 0x00;
errors_errors[8][0] = 0x00; errors_errors[8][0] = 0x00;
__MOVE("\'=\' expected", errors_errors[9], 13); __MOVE("'=' expected", errors_errors[9], 13);
errors_errors[10][0] = 0x00; errors_errors[10][0] = 0x00;
errors_errors[11][0] = 0x00; errors_errors[11][0] = 0x00;
__MOVE("type definition starts with incorrect symbol", errors_errors[12], 45); __MOVE("type definition starts with incorrect symbol", errors_errors[12], 45);
@ -35,28 +35,28 @@ export void *errors__init(void)
__MOVE("declaration followed by incorrect symbol", errors_errors[15], 41); __MOVE("declaration followed by incorrect symbol", errors_errors[15], 41);
__MOVE("MODULE expected", errors_errors[16], 16); __MOVE("MODULE expected", errors_errors[16], 16);
errors_errors[17][0] = 0x00; errors_errors[17][0] = 0x00;
__MOVE("\'.\' missing", errors_errors[18], 12); __MOVE("'.' missing", errors_errors[18], 12);
__MOVE("\',\' missing", errors_errors[19], 12); __MOVE("',' missing", errors_errors[19], 12);
__MOVE("\':\' missing", errors_errors[20], 12); __MOVE("':' missing", errors_errors[20], 12);
errors_errors[21][0] = 0x00; errors_errors[21][0] = 0x00;
__MOVE("\')\' missing", errors_errors[22], 12); __MOVE("')' missing", errors_errors[22], 12);
__MOVE("\']\' missing", errors_errors[23], 12); __MOVE("']' missing", errors_errors[23], 12);
__MOVE("\'}\' missing", errors_errors[24], 12); __MOVE("'}' missing", errors_errors[24], 12);
__MOVE("OF missing", errors_errors[25], 11); __MOVE("OF missing", errors_errors[25], 11);
__MOVE("THEN missing", errors_errors[26], 13); __MOVE("THEN missing", errors_errors[26], 13);
__MOVE("DO missing", errors_errors[27], 11); __MOVE("DO missing", errors_errors[27], 11);
__MOVE("TO missing", errors_errors[28], 11); __MOVE("TO missing", errors_errors[28], 11);
errors_errors[29][0] = 0x00; errors_errors[29][0] = 0x00;
__MOVE("\'(\' missing", errors_errors[30], 12); __MOVE("'(' missing", errors_errors[30], 12);
errors_errors[31][0] = 0x00; errors_errors[31][0] = 0x00;
errors_errors[32][0] = 0x00; errors_errors[32][0] = 0x00;
errors_errors[33][0] = 0x00; errors_errors[33][0] = 0x00;
__MOVE("\':=\' missing", errors_errors[34], 13); __MOVE("':=' missing", errors_errors[34], 13);
__MOVE("\',\' or OF expected", errors_errors[35], 19); __MOVE("',' or OF expected", errors_errors[35], 19);
errors_errors[36][0] = 0x00; errors_errors[36][0] = 0x00;
errors_errors[37][0] = 0x00; errors_errors[37][0] = 0x00;
__MOVE("identifier expected", errors_errors[38], 20); __MOVE("identifier expected", errors_errors[38], 20);
__MOVE("\';\' missing", errors_errors[39], 12); __MOVE("';' missing", errors_errors[39], 12);
errors_errors[40][0] = 0x00; errors_errors[40][0] = 0x00;
__MOVE("END missing", errors_errors[41], 12); __MOVE("END missing", errors_errors[41], 12);
errors_errors[42][0] = 0x00; errors_errors[42][0] = 0x00;
@ -132,10 +132,10 @@ export void *errors__init(void)
__MOVE("operand is not a variable", errors_errors[112], 26); __MOVE("operand is not a variable", errors_errors[112], 26);
__MOVE("incompatible assignment", errors_errors[113], 24); __MOVE("incompatible assignment", errors_errors[113], 24);
__MOVE("string too long to be assigned", errors_errors[114], 31); __MOVE("string too long to be assigned", errors_errors[114], 31);
__MOVE("parameter doesn\'t match", errors_errors[115], 24); __MOVE("parameter doesn't match", errors_errors[115], 24);
__MOVE("number of parameters doesn\'t match", errors_errors[116], 35); __MOVE("number of parameters doesn't match", errors_errors[116], 35);
__MOVE("result type doesn\'t match", errors_errors[117], 26); __MOVE("result type doesn't match", errors_errors[117], 26);
__MOVE("export mark doesn\'t match with forward declaration", errors_errors[118], 51); __MOVE("export mark doesn't match with forward declaration", errors_errors[118], 51);
__MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61); __MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61);
__MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71); __MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71);
__MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64); __MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64);

View file

@ -253,7 +253,7 @@ export void *vt100__init(void)
__REGCMD("RCP", vt100_RCP); __REGCMD("RCP", vt100_RCP);
__REGCMD("SCP", vt100_SCP); __REGCMD("SCP", vt100_SCP);
/* BEGIN */ /* BEGIN */
__COPY("", vt100_CSI, ((LONGINT)(5))); __COPY("\033", vt100_CSI, ((LONGINT)(5)));
Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5))); Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5)));
__ENDMOD; __ENDMOD;
} }

View file

@ -31,7 +31,10 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
DynTypExt = "__typ"; DynTypExt = "__typ";
TagExt = "__typ"; TagExt = "__typ";
Tab = 9X; Tab = 9X;
Backslash = 5CX; (* Defined as hex to avoid confusing editor syntax parsing *)
(* The following are defined as hex to avoid confusing editor syntax highlighting *)
Backslash = 5CX;
DoubleQuote = 22X;
VAR VAR
@ -542,9 +545,10 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
BegStat; OPM.WriteString("__TDESC("); BegStat; OPM.WriteString("__TDESC(");
Andent(typ); Andent(typ);
Str1(", #", typ^.n + 1); Str1(", #) = {__TDFLDS(", NofPtrs(typ)); Str1(", #", typ^.n + 1); Str1(", #) = {__TDFLDS(", NofPtrs(typ));
OPM.Write('"'); OPM.Write(DoubleQuote);
IF typ^.strobj # NIL THEN OPM.WriteStringVar(typ^.strobj^.name) END ; IF typ^.strobj # NIL THEN OPM.WriteStringVar(typ^.strobj^.name) END ;
Str1('", #), {', typ^.size); OPM.Write(DoubleQuote);
Str1(', #), {', typ^.size);
nofptrs := 0; PutPtrOffsets(typ, 0, nofptrs); Str1("#}}", -(nofptrs + 1) * OPM.LIntSize); nofptrs := 0; PutPtrOffsets(typ, 0, nofptrs); Str1("#}}", -(nofptrs + 1) * OPM.LIntSize);
EndStat EndStat
END TDescDecl; END TDescDecl;
@ -566,8 +570,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
| 4: INC(adr, (-adr) MOD 4) | 4: INC(adr, (-adr) MOD 4)
| 8: INC(adr, (-adr) MOD 8) | 8: INC(adr, (-adr) MOD 8)
| 16: INC(adr, (-adr) MOD 16) | 16: INC(adr, (-adr) MOD 16)
ELSE (*1*) ELSE (*1*) (*OPM.LogWStr("unhandled case at OPC.Align, base = "); OPM.LogWNum(base, 0); OPM.LogWLn;*)
(*OPM.LogWStr("unhandled case at OPC.Align, base = "); OPM.LogWNum(base, 0); OPM.LogWLn;*)
END END
END Align; END Align;
@ -585,8 +588,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
| OPM.Set: RETURN OPM.SetAlign | OPM.Set: RETURN OPM.SetAlign
| OPM.Pointer: RETURN OPM.PointerAlign | OPM.Pointer: RETURN OPM.PointerAlign
| OPM.ProcTyp: RETURN OPM.ProcAlign | OPM.ProcTyp: RETURN OPM.ProcAlign
| OPM.Comp: | OPM.Comp: IF typ^.comp = OPM.Record THEN RETURN typ^.align MOD 10000H
IF typ^.comp = OPM.Record THEN RETURN typ^.align MOD 10000H
ELSE RETURN Base(typ^.BaseTyp) ELSE RETURN Base(typ^.BaseTyp)
END END
ELSE OPM.LogWStr("unhandled case in OPC.Base, typ^form = "); OPM.LogWNum(typ^.form, 0); OPM.LogWLn; ELSE OPM.LogWStr("unhandled case in OPC.Base, typ^form = "); OPM.LogWNum(typ^.form, 0); OPM.LogWLn;
@ -749,8 +751,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
PROCEDURE Include(name: ARRAY OF CHAR); PROCEDURE Include(name: ARRAY OF CHAR);
BEGIN BEGIN
OPM.WriteString("#include "); OPM.Write('"'); OPM.WriteStringVar(name); OPM.WriteString("#include "); OPM.Write(DoubleQuote); OPM.WriteStringVar(name);
OPM.WriteString(".h"); OPM.Write('"'); OPM.WriteLn OPM.WriteString(".h"); OPM.Write(DoubleQuote); OPM.WriteLn
END Include; END Include;
PROCEDURE IncludeImports(obj: OPT.Object; vis: INTEGER); PROCEDURE IncludeImports(obj: OPT.Object; vis: INTEGER);
@ -821,14 +823,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
| OPM.notcoloroutput: OPM.Write("f") | OPM.notcoloroutput: OPM.Write("f")
| OPM.forcenewsym: OPM.Write("F") | OPM.forcenewsym: OPM.Write("F")
| OPM.verbose: OPM.Write("v") | OPM.verbose: OPM.Write("v")
ELSE ELSE OPM.LogWStr ("( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg"); OPM.LogWLn;
(* this else is necessary cause
if someone defined a new option in OPM module
and forgot to add it here then
if option is passed this will
generate __CASECHK and cause Halt,
noch *)
OPM.LogWStr ("( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg"); OPM.LogWLn;
END END
END END
END; END;
@ -1173,44 +1168,67 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
PROCEDURE Cmp*(rel: INTEGER); PROCEDURE Cmp*(rel: INTEGER);
BEGIN BEGIN
CASE rel OF CASE rel OF
OPM.eql : | OPM.eql: OPM.WriteString(" == ")
OPM.WriteString(" == "); | OPM.neq: OPM.WriteString(" != ")
| OPM.neq : | OPM.lss: OPM.WriteString(" < ")
OPM.WriteString(" != "); | OPM.leq: OPM.WriteString(" <= ")
| OPM.lss : | OPM.gtr: OPM.WriteString(" > ")
OPM.WriteString(" < "); | OPM.geq: OPM.WriteString(" >= ")
| OPM.leq : ELSE OPM.LogWStr("unhandled case in OPC.Cmp, rel = "); OPM.LogWNum(rel, 0); OPM.LogWLn;
OPM.WriteString(" <= ");
| OPM.gtr :
OPM.WriteString(" > ");
| OPM.geq :
OPM.WriteString(" >= ");
ELSE
OPM.LogWStr("unhandled case in OPC.Cmp, rel = "); OPM.LogWNum(rel, 0); OPM.LogWLn;
END; END;
END Cmp; END Cmp;
PROCEDURE CharacterLiteral(c: LONGINT);
BEGIN
IF (c < 32) OR (c > 126) THEN
OPM.WriteString("0x"); OPM.WriteHex(c)
ELSE
OPM.Write("'");
IF (c = ORD(Backslash)) OR (c = ORD("'")) OR (c = ORD("?")) THEN
OPM.Write(Backslash)
END;
OPM.Write(CHR(c));
OPM.Write("'")
END
END CharacterLiteral;
PROCEDURE StringLiteral(s: ARRAY OF CHAR; l: LONGINT);
VAR i: LONGINT; c: INTEGER;
BEGIN
OPM.Write(DoubleQuote);
i := 0; WHILE i < l DO
c := ORD(s[i]);
IF (c < 32) OR (c > 126) THEN
(* Encode binary character value using exactly 3 octal digits.
Use octal in preference to hex as only the octal escape
syntax ensures a subsequent character will not be absorbed
into this literal. *)
OPM.Write(Backslash);
OPM.Write(CHR(ORD("0") + c DIV 64)); c := c MOD 64;
OPM.Write(CHR(ORD("0") + c DIV 8)); c := c MOD 8;
OPM.Write(CHR(ORD("0") + c))
ELSE
IF (c = ORD(Backslash)) OR (c = ORD(DoubleQuote)) OR (c = ORD("?")) THEN
OPM.Write(Backslash)
END;
OPM.Write(CHR(c));
END;
INC(i);
END;
OPM.Write(DoubleQuote)
END StringLiteral;
PROCEDURE Case*(caseVal: LONGINT; form: INTEGER); PROCEDURE Case*(caseVal: LONGINT; form: INTEGER);
VAR VAR
ch: CHAR; ch: CHAR;
BEGIN BEGIN
OPM.WriteString('case '); OPM.WriteString('case ');
CASE form OF CASE form OF
| OPM.Char : | OPM.Char: CharacterLiteral(caseVal)
ch := CHR (caseVal); | OPM.SInt,
IF (ch >= " ") & (ch <= "~") THEN OPM.Int,
OPM.Write("'"); OPM.LInt: OPM.WriteInt(caseVal);
IF (ch = Backslash) OR (ch = "?") OR (ch = "'") OR (ch = '"') THEN OPM.Write(Backslash); OPM.Write(ch); ELSE OPM.LogWStr("unhandled case in OPC.Case, form = "); OPM.LogWNum(form, 0); OPM.LogWLn;
ELSE OPM.Write(ch);
END;
OPM.Write("'");
ELSE
OPM.WriteString("0x"); OPM.WriteHex (caseVal);
END;
| OPM.SInt, OPM.Int, OPM.LInt :
OPM.WriteInt(caseVal);
ELSE
OPM.LogWStr("unhandled case in OPC.Case, form = "); OPM.LogWNum(form, 0); OPM.LogWLn;
END; END;
OPM.WriteString(': '); OPM.WriteString(': ');
END Case; END Case;
@ -1242,32 +1260,19 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END Len; END Len;
PROCEDURE Constant* (con: OPT.Const; form: INTEGER); PROCEDURE Constant* (con: OPT.Const; form: INTEGER);
VAR i, len: INTEGER; ch: CHAR; s: SET; VAR i: INTEGER; s: SET;
hex: LONGINT; skipLeading: BOOLEAN; hex: LONGINT; skipLeading: BOOLEAN;
BEGIN BEGIN
CASE form OF CASE form OF
OPM.Byte: | OPM.Byte: OPM.WriteInt(con^.intval)
OPM.WriteInt(con^.intval) | OPM.Bool: OPM.WriteInt(con^.intval)
| OPM.Bool: | OPM.Char: CharacterLiteral(con.intval)
OPM.WriteInt(con^.intval) | OPM.SInt,
| OPM.Char: OPM.Int,
ch := CHR(con^.intval); OPM.LInt: OPM.WriteInt(con^.intval)
IF (ch >= " ") & (ch <= "~") THEN | OPM.Real: OPM.WriteReal(con^.realval, "f")
OPM.Write("'"); | OPM.LReal: OPM.WriteReal(con^.realval, 0X)
IF (ch = Backslash) OR (ch = "?") OR (ch = "'") OR (ch = '"') THEN OPM.Write(Backslash) END ; | OPM.Set: OPM.WriteString("0x");
OPM.Write(ch);
OPM.Write("'")
ELSE
OPM.WriteString("0x"); OPM.WriteHex(con^.intval)
END
| OPM.SInt, OPM.Int, OPM.LInt:
OPM.WriteInt(con^.intval)
| OPM.Real:
OPM.WriteReal(con^.realval, "f")
| OPM.LReal:
OPM.WriteReal(con^.realval, 0X)
| OPM.Set:
OPM.WriteString("0x");
skipLeading := TRUE; skipLeading := TRUE;
s := con^.setval; i := MAX(SET) + 1; s := con^.setval; i := MAX(SET) + 1;
REPEAT REPEAT
@ -1282,18 +1287,9 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END END
UNTIL i = 0; UNTIL i = 0;
IF skipLeading THEN OPM.Write("0") END IF skipLeading THEN OPM.Write("0") END
| OPM.String: | OPM.String: StringLiteral(con.ext^, con.intval2-1)
OPM.Write('"'); | OPM.NilTyp: OPM.WriteString('NIL');
len := SHORT(con^.intval2) - 1; i := 0; ELSE OPM.LogWStr("unhandled case in OPC.Constant, form = "); OPM.LogWNum(form, 0); OPM.LogWLn;
WHILE i < len DO ch := con^.ext^[i];
IF (ch = Backslash) OR (ch = "?") OR (ch = "'") OR (ch = '"') THEN OPM.Write(Backslash) END ;
OPM.Write(ch); INC(i)
END ;
OPM.Write('"')
| OPM.NilTyp:
OPM.WriteString('NIL');
ELSE
OPM.LogWStr("unhandled case in OPC.Constant, form = "); OPM.LogWNum(form, 0); OPM.LogWLn;
END; END;
END Constant; END Constant;

View file

@ -217,53 +217,48 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
PROCEDURE Precedence (class, subclass, form, comp: INTEGER): INTEGER; PROCEDURE Precedence (class, subclass, form, comp: INTEGER): INTEGER;
BEGIN BEGIN
CASE class OF CASE class OF
OPM.Nconst, OPM.Nvar, OPM.Nfield, OPM.Nindex, OPM.Nproc, OPM.Ncall: | OPM.Nconst,
RETURN 10 OPM.Nvar,
OPM.Nfield,
OPM.Nindex,
OPM.Nproc,
OPM.Ncall: RETURN 10
| OPM.Nguard: IF OPM.typchk IN OPM.opt THEN RETURN 10 ELSE RETURN 9 (*cast*) END | OPM.Nguard: IF OPM.typchk IN OPM.opt THEN RETURN 10 ELSE RETURN 9 (*cast*) END
| OPM.Nvarpar: | OPM.Nvarpar: IF comp IN {OPM.Array, OPM.DynArr} THEN RETURN 10 ELSE RETURN 9 END (* arrays don't need deref *)
IF comp IN {OPM.Array, OPM.DynArr} THEN RETURN 10 ELSE RETURN 9 END (* arrays don't need deref *) | OPM.Nderef: RETURN 9
| OPM.Nderef: | OPM.Nmop: CASE subclass OF
RETURN 9 | OPM.not, OPM.minus, OPM.adr, OPM.val, OPM.conv: RETURN 9
| OPM.Nmop: | OPM.is, OPM.abs, OPM.cap, OPM.odd, OPM.cc: RETURN 10
CASE subclass OF ELSE OPM.LogWStr("unhandled case in OPV.Precedence OPM.Nmop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
OPM.not, OPM.minus, OPM.adr, OPM.val, OPM.conv:
RETURN 9
| OPM.is, OPM.abs, OPM.cap, OPM.odd, OPM.cc:
RETURN 10
ELSE
OPM.LogWStr("unhandled case in OPV.Precedence OPM.Nmop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
END END
| OPM.Ndop: | OPM.Ndop: CASE subclass OF
CASE subclass OF | OPM.times: IF form = OPM.Set THEN RETURN 4 ELSE RETURN 8 END
OPM.times: | OPM.slash: IF form = OPM.Set THEN RETURN 3 ELSE RETURN 8 END
IF form = OPM.Set THEN RETURN 4 ELSE RETURN 8 END | OPM.div,
| OPM.slash: OPM.mod: RETURN 10 (* div/mod are replaced by functions *)
IF form = OPM.Set THEN RETURN 3 ELSE RETURN 8 END | OPM.plus: IF form = OPM.Set THEN RETURN 2 ELSE RETURN 7 END
| OPM.div, OPM.mod: | OPM.minus: IF form = OPM.Set THEN RETURN 4 ELSE RETURN 7 END
RETURN 10 (* div/mod are replaced by functions *) | OPM.lss,
| OPM.plus: OPM.leq,
IF form = OPM.Set THEN RETURN 2 ELSE RETURN 7 END OPM.gtr,
| OPM.minus: OPM.geq: RETURN 6
IF form = OPM.Set THEN RETURN 4 ELSE RETURN 7 END | OPM.eql,
| OPM.lss, OPM.leq, OPM.gtr, OPM.geq: OPM.neq: RETURN 5
RETURN 6 | OPM.and: RETURN 1
| OPM.eql, OPM.neq: | OPM.or: RETURN 0
RETURN 5 | OPM.len,
| OPM.and: OPM.in,
RETURN 1 OPM.ash,
| OPM.or: OPM.msk,
RETURN 0 OPM.bit,
| OPM.len, OPM.in, OPM.ash, OPM.msk, OPM.bit, OPM.lsh, OPM.rot: OPM.lsh,
RETURN 10 OPM.rot: RETURN 10
ELSE ELSE OPM.LogWStr("unhandled case in OPV.Precedence OPM.Ndop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
OPM.LogWStr("unhandled case in OPV.Precedence OPM.Ndop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
END; END;
| OPM.Nupto: | OPM.Nupto: RETURN 10
RETURN 10 | OPM.Ntype,
| OPM.Ntype, OPM.Neguard: (* ignored anyway *) OPM.Neguard: (* ignored anyway *) RETURN MaxPrec
RETURN MaxPrec ELSE OPM.LogWStr("unhandled case in OPV.Precedence, class = "); OPM.LogWNum(class, 0); OPM.LogWLn;
ELSE
OPM.LogWStr("unhandled case in OPV.Precedence, class = "); OPM.LogWNum(class, 0); OPM.LogWLn;
END; END;
END Precedence; END Precedence;
@ -302,9 +297,6 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
ELSIF form = OPM.LInt THEN ELSIF form = OPM.LInt THEN
IF from < OPM.LInt THEN OPM.WriteString("(LONGINT)") END ; IF from < OPM.LInt THEN OPM.WriteString("(LONGINT)") END ;
Entier(n, 9) Entier(n, 9)
(*ELSIF form = Int64 THEN
IF (from >= OPM.SInt) & (from <= OPM.LInt) OR (from >= Int8) & (from < Int64) THEN OPM.WriteString("(SYSTEM_INT64)") END;
Entier(n, 9);*)
ELSIF form = OPM.Int THEN ELSIF form = OPM.Int THEN
IF from < OPM.Int THEN OPM.WriteString("(int)"); expr(n, 9) IF from < OPM.Int THEN OPM.WriteString("(int)"); expr(n, 9)
ELSE ELSE
@ -372,24 +364,18 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
IF prec > designPrec THEN OPM.Write(OpenParen) END; IF prec > designPrec THEN OPM.Write(OpenParen) END;
IF prec = ProcTypeVar THEN OPM.Write(Deref) END; (* proc var calls must be dereferenced in K&R C *) IF prec = ProcTypeVar THEN OPM.Write(Deref) END; (* proc var calls must be dereferenced in K&R C *)
CASE class OF CASE class OF
OPM.Nproc: | OPM.Nproc: OPC.Ident(n^.obj)
OPC.Ident(n^.obj) | OPM.Nvar: OPC.CompleteIdent(n^.obj)
| OPM.Nvar: | OPM.Nvarpar: IF ~(comp IN {OPM.Array, OPM.DynArr}) THEN OPM.Write(Deref) END; (* deref var parameter *)
OPC.CompleteIdent(n^.obj) OPC.CompleteIdent(n^.obj)
| OPM.Nvarpar: | OPM.Nfield: IF n^.left^.class = OPM.Nderef THEN design(n^.left^.left, designPrec); OPM.WriteString("->")
IF ~(comp IN {OPM.Array, OPM.DynArr}) THEN OPM.Write(Deref) END; (* deref var parameter *)
OPC.CompleteIdent(n^.obj)
| OPM.Nfield:
IF n^.left^.class = OPM.Nderef THEN design(n^.left^.left, designPrec); OPM.WriteString("->")
ELSE design(n^.left, designPrec); OPM.Write(".") ELSE design(n^.left, designPrec); OPM.Write(".")
END ; END ;
OPC.Ident(n^.obj) OPC.Ident(n^.obj)
| OPM.Nderef: | OPM.Nderef: IF n^.typ^.comp = OPM.DynArr THEN design(n^.left, 10); OPM.WriteString("->data")
IF n^.typ^.comp = OPM.DynArr THEN design(n^.left, 10); OPM.WriteString("->data")
ELSE OPM.Write(Deref); design(n^.left, designPrec) ELSE OPM.Write(Deref); design(n^.left, designPrec)
END END
| OPM.Nindex: | OPM.Nindex: d := n^.left;
d := n^.left;
IF d^.typ^.comp = OPM.DynArr THEN dims := 0; IF d^.typ^.comp = OPM.DynArr THEN dims := 0;
WHILE d^.class = OPM.Nindex DO d := d^.left; INC(dims) END ; WHILE d^.class = OPM.Nindex DO d := d^.left; INC(dims) END ;
IF n^.typ^.comp = OPM.DynArr THEN OPM.Write("&") END ; IF n^.typ^.comp = OPM.DynArr THEN OPM.Write("&") END ;
@ -419,8 +405,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
Index(n, n^.left, MinPrec, 0); Index(n, n^.left, MinPrec, 0);
OPM.Write(CloseBracket) OPM.Write(CloseBracket)
END END
| OPM.Nguard: | OPM.Nguard: typ := n^.typ; obj := n^.left^.obj;
typ := n^.typ; obj := n^.left^.obj;
IF OPM.typchk IN OPM.opt THEN IF OPM.typchk IN OPM.opt THEN
IF typ^.comp = OPM.Record THEN OPM.WriteString(GuardRecFunc); IF typ^.comp = OPM.Record THEN OPM.WriteString(GuardRecFunc);
IF obj^.mnolev # OPM.level THEN (*intermediate level var-par record*) IF obj^.mnolev # OPM.level THEN (*intermediate level var-par record*)
@ -442,8 +427,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPM.Write("("); OPC.Ident(typ^.strobj); OPM.Write(")"); expr(n^.left, designPrec) OPM.Write("("); OPC.Ident(typ^.strobj); OPM.Write(")"); expr(n^.left, designPrec)
END END
END END
| OPM.Neguard: | OPM.Neguard: IF OPM.typchk IN OPM.opt THEN
IF OPM.typchk IN OPM.opt THEN
IF n^.left^.class = OPM.Nvarpar THEN OPM.WriteString("__GUARDEQR("); IF n^.left^.class = OPM.Nvarpar THEN OPM.WriteString("__GUARDEQR(");
OPC.CompleteIdent(n^.left^.obj); OPM.WriteString(Comma); TypeOf(n^.left); OPC.CompleteIdent(n^.left^.obj); OPM.WriteString(Comma); TypeOf(n^.left);
ELSE OPM.WriteString("__GUARDEQP("); expr(n^.left^.left, MinPrec) ELSE OPM.WriteString("__GUARDEQP("); expr(n^.left^.left, MinPrec)
@ -452,10 +436,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
ELSE ELSE
expr(n^.left, MinPrec) (* always lhs of assignment *) expr(n^.left, MinPrec) (* always lhs of assignment *)
END END
| OPM.Nmop: | OPM.Nmop: IF n^.subcl = OPM.val THEN design(n^.left, prec) END
IF n^.subcl = OPM.val THEN design(n^.left, prec) END ELSE OPM.LogWStr("unhandled case in OPV.design, class = "); OPM.LogWNum(class, 0); OPM.LogWLn;
ELSE
OPM.LogWStr("unhandled case in OPV.design, class = "); OPM.LogWNum(class, 0); OPM.LogWLn;
END ; END ;
IF prec > designPrec THEN OPM.Write(CloseParen) END IF prec > designPrec THEN OPM.Write(CloseParen) END
END design; END design;
@ -484,8 +466,6 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPM.WriteString("(double)"); prec := 9 OPM.WriteString("(double)"); prec := 9
ELSIF (form = OPM.LInt) & (n^.typ^.form < OPM.LInt) THEN (* integral promotion *) ELSIF (form = OPM.LInt) & (n^.typ^.form < OPM.LInt) THEN (* integral promotion *)
OPM.WriteString("(LONGINT)"); prec := 9 OPM.WriteString("(LONGINT)"); prec := 9
(*ELSIF (form = Int64) & (n^.typ^.form < Int64) THEN
OPM.WriteString("(SYSTEM_INT64)"); prec := 9;*)
END END
END END
ELSIF ansi THEN ELSIF ansi THEN
@ -551,30 +531,24 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPM.Write(OpenParen); OPM.Write(OpenParen);
END; END;
CASE class OF CASE class OF
OPM.Nconst: | OPM.Nconst: OPC.Constant(n^.conval, form)
OPC.Constant(n^.conval, form)
| OPM.Nupto: (* n^.typ = OPT.settyp *) | OPM.Nupto: (* n^.typ = OPT.settyp *)
OPM.WriteString(SetRangeFunc); expr(l, MinPrec); OPM.WriteString(Comma); expr (r, MinPrec); OPM.WriteString(SetRangeFunc); expr(l, MinPrec); OPM.WriteString(Comma); expr (r, MinPrec);
OPM.Write(CloseParen) OPM.Write(CloseParen)
| OPM.Nmop: | OPM.Nmop:
CASE subclass OF CASE subclass OF
OPM.not: | OPM.not: OPM.Write("!"); expr(l, exprPrec)
OPM.Write("!"); expr(l, exprPrec) | OPM.minus: IF form = OPM.Set THEN OPM.Write("~") ELSE OPM.Write("-") END;
| OPM.minus:
IF form = OPM.Set THEN OPM.Write("~") ELSE OPM.Write("-"); END ;
expr(l, exprPrec) expr(l, exprPrec)
| OPM.is: | OPM.is: typ := n^.obj^.typ;
typ := n^.obj^.typ;
IF l^.typ^.comp = OPM.Record THEN OPM.WriteString(IsFunc); OPC.TypeOf(l^.obj) IF l^.typ^.comp = OPM.Record THEN OPM.WriteString(IsFunc); OPC.TypeOf(l^.obj)
ELSE OPM.WriteString(IsPFunc); expr(l, MinPrec); typ := typ^.BaseTyp ELSE OPM.WriteString(IsPFunc); expr(l, MinPrec); typ := typ^.BaseTyp
END ; END ;
OPM.WriteString(Comma); OPM.WriteString(Comma);
OPC.Andent(typ); OPM.WriteString(Comma); OPC.Andent(typ); OPM.WriteString(Comma);
OPM.WriteInt(typ^.extlev); OPM.Write(")") OPM.WriteInt(typ^.extlev); OPM.Write(")")
| OPM.conv: | OPM.conv: Convert(l, form, exprPrec)
Convert(l, form, exprPrec) | OPM.abs: IF SideEffects(l) THEN
| OPM.abs:
IF SideEffects(l) THEN
IF l^.typ^.form < OPM.Real THEN IF l^.typ^.form < OPM.Real THEN
IF l^.typ^.form < OPM.LInt THEN OPM.WriteString("(int)") END ; IF l^.typ^.form < OPM.LInt THEN OPM.WriteString("(int)") END ;
OPM.WriteString("__ABSF(") OPM.WriteString("__ABSF(")
@ -583,19 +557,15 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
ELSE OPM.WriteString("__ABS(") ELSE OPM.WriteString("__ABS(")
END ; END ;
expr(l, MinPrec); OPM.Write(CloseParen) expr(l, MinPrec); OPM.Write(CloseParen)
| OPM.cap: | OPM.cap: OPM.WriteString("__CAP("); expr(l, MinPrec); OPM.Write(CloseParen)
OPM.WriteString("__CAP("); expr(l, MinPrec); OPM.Write(CloseParen) | OPM.odd: OPM.WriteString("__ODD("); expr(l, MinPrec); OPM.Write(CloseParen)
| OPM.odd: | OPM.adr: OPM.WriteString("(LONGINT)(uintptr_t)"); (*SYSTEM*)
OPM.WriteString("__ODD("); expr(l, MinPrec); OPM.Write(CloseParen)
| OPM.adr: (*SYSTEM*)
OPM.WriteString("(LONGINT)(uintptr_t)");
IF l^.class = OPM.Nvarpar THEN OPC.CompleteIdent(l^.obj) IF l^.class = OPM.Nvarpar THEN OPC.CompleteIdent(l^.obj)
ELSE ELSE
IF (l^.typ^.form # OPM.String) & ~(l^.typ^.comp IN {OPM.Array, OPM.DynArr}) THEN OPM.Write("&") END ; IF (l^.typ^.form # OPM.String) & ~(l^.typ^.comp IN {OPM.Array, OPM.DynArr}) THEN OPM.Write("&") END ;
expr(l, exprPrec) expr(l, exprPrec)
END END
| OPM.val: (*SYSTEM*) | OPM.val: IF ~(l^.class IN {OPM.Nvar, OPM.Nvarpar, OPM.Nfield, OPM.Nindex}) (*SYSTEM*)
IF ~(l^.class IN {OPM.Nvar, OPM.Nvarpar, OPM.Nfield, OPM.Nindex})
OR (n^.typ^.form IN {OPM.LInt, OPM.Pointer, OPM.Set, OPM.ProcTyp}) OR (n^.typ^.form IN {OPM.LInt, OPM.Pointer, OPM.Set, OPM.ProcTyp})
& (l^.typ^.form IN {OPM.LInt, OPM.Pointer, OPM.Set, OPM.ProcTyp}) & (l^.typ^.form IN {OPM.LInt, OPM.Pointer, OPM.Set, OPM.ProcTyp})
& (n^.typ^.size = l^.typ^.size) & (n^.typ^.size = l^.typ^.size)
@ -616,53 +586,48 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
END END
ELSE OPM.err(200) ELSE OPM.err(200)
END END
| OPM.Ndop: | OPM.Ndop: CASE subclass OF
CASE subclass OF | OPM.len: Len(l, r^.conval^.intval)
OPM.len: | OPM.in,
Len(l, r^.conval^.intval) OPM.ash,
| OPM.in, OPM.ash, OPM.msk, OPM.bit, OPM.lsh, OPM.rot, OPM.div, OPM.mod: OPM.msk,
CASE subclass OF OPM.bit,
| OPM.in: OPM.lsh,
OPM.WriteString("__IN(") OPM.rot,
| OPM.ash: OPM.div,
IF r^.class = OPM.Nconst THEN OPM.mod: CASE subclass OF
| OPM.in: OPM.WriteString("__IN(")
| OPM.ash: IF r^.class = OPM.Nconst THEN
IF r^.conval^.intval >= 0 THEN OPM.WriteString("__ASHL(") IF r^.conval^.intval >= 0 THEN OPM.WriteString("__ASHL(")
ELSE OPM.WriteString("__ASHR(") ELSE OPM.WriteString("__ASHR(")
END END
ELSIF SideEffects(r) THEN OPM.WriteString("__ASHF(") ELSIF SideEffects(r) THEN OPM.WriteString("__ASHF(")
ELSE OPM.WriteString("__ASH(") ELSE OPM.WriteString("__ASH(")
END END
| OPM.msk: | OPM.msk: OPM.WriteString("__MASK(");
OPM.WriteString("__MASK("); | OPM.bit: OPM.WriteString("__BIT(")
| OPM.bit: | OPM.lsh: IF r^.class = OPM.Nconst THEN
OPM.WriteString("__BIT(")
| OPM.lsh:
IF r^.class = OPM.Nconst THEN
IF r^.conval^.intval >= 0 THEN OPM.WriteString("__LSHL(") IF r^.conval^.intval >= 0 THEN OPM.WriteString("__LSHL(")
ELSE OPM.WriteString("__LSHR(") ELSE OPM.WriteString("__LSHR(")
END END
ELSE OPM.WriteString("__LSH(") ELSE OPM.WriteString("__LSH(")
END END
| OPM.rot: | OPM.rot: IF r^.class = OPM.Nconst THEN
IF r^.class = OPM.Nconst THEN
IF r^.conval^.intval >= 0 THEN OPM.WriteString("__ROTL(") IF r^.conval^.intval >= 0 THEN OPM.WriteString("__ROTL(")
ELSE OPM.WriteString("__ROTR(") ELSE OPM.WriteString("__ROTR(")
END END
ELSE OPM.WriteString("__ROT(") ELSE OPM.WriteString("__ROT(")
END END
| OPM.div: | OPM.div: IF SideEffects(n) THEN
IF SideEffects(n) THEN
IF form < OPM.LInt THEN OPM.WriteString("(int)") END ; IF form < OPM.LInt THEN OPM.WriteString("(int)") END ;
OPM.WriteString("__DIVF(") OPM.WriteString("__DIVF(")
ELSE OPM.WriteString("__DIV(") ELSE OPM.WriteString("__DIV(")
END END
| OPM.mod: | OPM.mod: IF form < OPM.LInt THEN OPM.WriteString("(int)") END ;
IF form < OPM.LInt THEN OPM.WriteString("(int)") END ;
IF SideEffects(n) THEN OPM.WriteString("__MODF(") IF SideEffects(n) THEN OPM.WriteString("__MODF(")
ELSE OPM.WriteString("__MOD(") ELSE OPM.WriteString("__MOD(")
END; END;
ELSE ELSE OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
END ; END ;
expr(l, MinPrec); expr(l, MinPrec);
OPM.WriteString(Comma); OPM.WriteString(Comma);
@ -672,8 +637,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
END ; END ;
IF subclass IN {OPM.lsh, OPM.rot} THEN OPM.WriteString(Comma); OPC.Ident(l^.typ^.strobj) END ; IF subclass IN {OPM.lsh, OPM.rot} THEN OPM.WriteString(Comma); OPC.Ident(l^.typ^.strobj) END ;
OPM.Write(CloseParen) OPM.Write(CloseParen)
| OPM.eql .. OPM.geq: | OPM.eql
IF l^.typ^.form IN {OPM.String, OPM.Comp} THEN .. OPM.geq: IF l^.typ^.form IN {OPM.String, OPM.Comp} THEN
OPM.WriteString("__STRCMP("); OPM.WriteString("__STRCMP(");
expr(l, MinPrec); OPM.WriteString(Comma); expr(r, MinPrec); OPM.Write(CloseParen); expr(l, MinPrec); OPM.WriteString(Comma); expr(r, MinPrec); OPM.Write(CloseParen);
OPC.Cmp(subclass); OPM.Write("0") OPC.Cmp(subclass); OPM.Write("0")
@ -685,41 +650,32 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
END ; END ;
expr(r, exprPrec) expr(r, exprPrec)
END END
ELSE ELSE IF (subclass = OPM.and) OR ((form = OPM.Set) & ((subclass = OPM.times) OR (subclass = OPM.minus))) THEN OPM.Write(OpenParen); END; (* to silence clang warnings; -- noch *)
IF (subclass = OPM.and) OR ((form = OPM.Set) & ((subclass = OPM.times) OR (subclass = OPM.minus))) THEN OPM.Write(OpenParen); END; (* to silence clang warnings; -- noch *)
expr(l, exprPrec); expr(l, exprPrec);
CASE subclass OF CASE subclass OF
OPM.times: | OPM.times: IF form = OPM.Set THEN OPM.WriteString(" & ")
IF form = OPM.Set THEN OPM.WriteString(" & ")
ELSE OPM.WriteString(" * ") ELSE OPM.WriteString(" * ")
END END
| OPM.slash: | OPM.slash: IF form = OPM.Set THEN OPM.WriteString(" ^ ")
IF form = OPM.Set THEN OPM.WriteString(" ^ ")
ELSE OPM.WriteString(" / "); ELSE OPM.WriteString(" / ");
IF (r^.obj = NIL) OR (r^.obj^.typ^.form IN OPM.intSet) THEN IF (r^.obj = NIL) OR (r^.obj^.typ^.form IN OPM.intSet) THEN
OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen) OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen)
END END
END END
| OPM.and: | OPM.and: OPM.WriteString(" && ")
OPM.WriteString(" && ") | OPM.plus: IF form = OPM.Set THEN OPM.WriteString(" | ")
| OPM.plus:
IF form = OPM.Set THEN OPM.WriteString(" | ")
ELSE OPM.WriteString(" + ") ELSE OPM.WriteString(" + ")
END END
| OPM.minus: | OPM.minus: IF form = OPM.Set THEN OPM.WriteString(" & ~")
IF form = OPM.Set THEN OPM.WriteString(" & ~")
ELSE OPM.WriteString(" - ") ELSE OPM.WriteString(" - ")
END; END;
| OPM.or: | OPM.or: OPM.WriteString(" || ");
OPM.WriteString(" || "); ELSE OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
ELSE
OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
END; END;
expr(r, exprPrec); expr(r, exprPrec);
IF (subclass = OPM.and) OR ((form = OPM.Set) & ((subclass = OPM.times) OR (subclass = OPM.minus))) THEN OPM.Write(CloseParen) END; (* to silence clang warnings, -- noch*) IF (subclass = OPM.and) OR ((form = OPM.Set) & ((subclass = OPM.times) OR (subclass = OPM.minus))) THEN OPM.Write(CloseParen) END; (* to silence clang warnings, -- noch*)
END END
| OPM.Ncall: | OPM.Ncall: IF (l^.obj # NIL) & (l^.obj^.mode = OPM.TProc) THEN
IF (l^.obj # NIL) & (l^.obj^.mode = OPM.TProc) THEN
IF l^.subcl = OPM.super THEN proc := SuperProc(n) IF l^.subcl = OPM.super THEN proc := SuperProc(n)
ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(l^.obj) ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(l^.obj)
END ; END ;
@ -729,8 +685,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
ELSE design(l, ProcTypeVar) ELSE design(l, ProcTypeVar)
END ; END ;
ActualPar(r, n^.obj) ActualPar(r, n^.obj)
ELSE ELSE design(n, prec); (* not exprPrec! *)
design(n, prec); (* not exprPrec! *)
END; END;
IF (exprPrec <= prec) & (class IN {OPM.Nconst, OPM.Nupto, OPM.Nmop, OPM.Ndop, OPM.Ncall, OPM.Nguard}) THEN IF (exprPrec <= prec) & (class IN {OPM.Nconst, OPM.Nupto, OPM.Nmop, OPM.Ndop, OPM.Ncall, OPM.Nguard}) THEN
OPM.Write(CloseParen) OPM.Write(CloseParen)
@ -863,10 +818,9 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
BEGIN BEGIN
WHILE (n # NIL) & OPM.noerr DO WHILE (n # NIL) & OPM.noerr DO
OPM.errpos := n^.conval^.intval; OPM.errpos := n^.conval^.intval;
IF n^.class # OPM.Ninittd THEN OPC.BegStat; END; IF n^.class # OPM.Ninittd THEN OPC.BegStat END;
CASE n^.class OF CASE n^.class OF
OPM.Nenter: | OPM.Nenter: IF n^.obj = NIL THEN (* enter module *)
IF n^.obj = NIL THEN (* enter module *)
INC(OPM.level); stat(n^.left, outerProc); DEC(OPM.level); INC(OPM.level); stat(n^.left, outerProc); DEC(OPM.level);
OPC.GenEnumPtrs(OPT.topScope^.scope); OPC.GenEnumPtrs(OPT.topScope^.scope);
DefineTDescs(n^.right); OPC.EnterBody; InitTDescs(n^.right); DefineTDescs(n^.right); OPC.EnterBody; InitTDescs(n^.right);
@ -881,10 +835,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPC.ExitProc(proc, TRUE, ImplicitReturn(n^.right)); OPC.ExitProc(proc, TRUE, ImplicitReturn(n^.right));
END END
| OPM.Ninittd: (* done in enter module *) | OPM.Ninittd: (* done in enter module *)
| OPM.Nassign: | OPM.Nassign: CASE n^.subcl OF
CASE n^.subcl OF | OPM.assign: l := n^.left; r := n^.right;
OPM.assign:
l := n^.left; r := n^.right;
IF l^.typ^.comp = OPM.Array THEN (* includes string assignment but not COPY *) IF l^.typ^.comp = OPM.Array THEN (* includes string assignment but not COPY *)
OPM.WriteString(MoveFunc); OPM.WriteString(MoveFunc);
expr(r, MinPrec); OPM.WriteString(Comma); expr(l, MinPrec); OPM.WriteString(Comma); expr(r, MinPrec); OPM.WriteString(Comma); expr(l, MinPrec); OPM.WriteString(Comma);
@ -909,44 +861,41 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
ELSE expr(r, MinPrec) ELSE expr(r, MinPrec)
END END
END END
| OPM.newfn: | OPM.newfn: IF n^.left^.typ^.BaseTyp^.comp = OPM.Record THEN
IF n^.left^.typ^.BaseTyp^.comp = OPM.Record THEN
OPM.WriteString("__NEW("); design(n^.left, MinPrec); OPM.WriteString(", "); OPM.WriteString("__NEW("); design(n^.left, MinPrec); OPM.WriteString(", ");
OPC.Andent(n^.left^.typ^.BaseTyp); OPM.WriteString(")") OPC.Andent(n^.left^.typ^.BaseTyp); OPM.WriteString(")")
ELSIF n^.left^.typ^.BaseTyp^.comp IN {OPM.Array, OPM.DynArr} THEN ELSIF n^.left^.typ^.BaseTyp^.comp IN {OPM.Array, OPM.DynArr} THEN
NewArr(n^.left, n^.right) NewArr(n^.left, n^.right)
END END
| OPM.incfn, OPM.decfn: | OPM.incfn,
expr(n^.left, MinPrec); OPC.Increment(n^.subcl = OPM.decfn); expr(n^.right, MinPrec) OPM.decfn: expr(n^.left, MinPrec); OPC.Increment(n^.subcl = OPM.decfn); expr(n^.right, MinPrec)
| OPM.inclfn, OPM.exclfn: | OPM.inclfn,
expr(n^.left, MinPrec); OPC.SetInclude(n^.subcl = OPM.exclfn); OPM.WriteString(SetOfFunc); expr(n^.right, MinPrec); OPM.exclfn: expr(n^.left, MinPrec); OPC.SetInclude(n^.subcl = OPM.exclfn); OPM.WriteString(SetOfFunc); expr(n^.right, MinPrec);
OPM.Write(CloseParen) OPM.Write(CloseParen)
| OPM.copyfn: | OPM.copyfn: OPM.WriteString(CopyFunc);
OPM.WriteString(CopyFunc);
expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(Comma); expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(Comma);
Len(n^.left, 0); OPM.Write(CloseParen) Len(n^.left, 0); OPM.Write(CloseParen)
| (*SYSTEM*)OPM.movefn: | OPM.movefn: (*SYSTEM*)
OPM.WriteString(MoveFunc); OPM.WriteString(MoveFunc);
expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(Comma); expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(Comma);
expr(n^.right^.link, MinPrec); expr(n^.right^.link, MinPrec);
OPM.Write(CloseParen) OPM.Write(CloseParen)
| (*SYSTEM*)OPM.getfn: | OPM.getfn: (*SYSTEM*)
OPM.WriteString(GetFunc); expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(GetFunc); expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec);
OPM.WriteString(Comma); OPC.Ident(n^.left^.typ^.strobj); OPM.Write(CloseParen) OPM.WriteString(Comma); OPC.Ident(n^.left^.typ^.strobj); OPM.Write(CloseParen)
| (*SYSTEM*)OPM.putfn: | OPM.putfn: (*SYSTEM*)
OPM.WriteString(PutFunc); expr(n^.left, MinPrec); OPM.WriteString(Comma); expr(n^.right, MinPrec); OPM.WriteString(PutFunc); expr(n^.left, MinPrec); OPM.WriteString(Comma); expr(n^.right, MinPrec);
OPM.WriteString(Comma); OPC.Ident(n^.right^.typ^.strobj); OPM.Write(CloseParen) OPM.WriteString(Comma); OPC.Ident(n^.right^.typ^.strobj); OPM.Write(CloseParen)
| (*SYSTEM*)OPM.getrfn, OPM.putrfn: OPM.err(200) | OPM.getrfn, (*SYSTEM*)
| (*SYSTEM*)OPM.sysnewfn: OPM.putrfn: (*SYSTEM*) OPM.err(200)
| OPM.sysnewfn: (*SYSTEM*)
OPM.WriteString("__SYSNEW("); OPM.WriteString("__SYSNEW(");
design(n^.left, MinPrec); OPM.WriteString(", "); design(n^.left, MinPrec); OPM.WriteString(", ");
expr(n^.right, MinPrec); expr(n^.right, MinPrec);
OPM.Write(")") OPM.Write(")")
ELSE ELSE OPM.LogWStr("unhandled case in OPV.expr, n^.subcl = "); OPM.LogWNum(n^.subcl, 0); OPM.LogWLn;
OPM.LogWStr("unhandled case in OPV.expr, n^.subcl = "); OPM.LogWNum(n^.subcl, 0); OPM.LogWLn;
END END
| OPM.Ncall: | OPM.Ncall: IF (n^.left^.obj # NIL) & (n^.left^.obj^.mode = OPM.TProc) THEN
IF (n^.left^.obj # NIL) & (n^.left^.obj^.mode = OPM.TProc) THEN
IF n^.left^.subcl = OPM.super THEN proc := SuperProc(n) IF n^.left^.subcl = OPM.super THEN proc := SuperProc(n)
ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(n^.left^.obj) ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(n^.left^.obj)
END ; END ;
@ -956,36 +905,29 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
ELSE design(n^.left, ProcTypeVar) ELSE design(n^.left, ProcTypeVar)
END ; END ;
ActualPar(n^.right, n^.obj) ActualPar(n^.right, n^.obj)
| OPM.Nifelse: | OPM.Nifelse: IF n^.subcl # OPM.assertfn THEN IfStat(n, FALSE, outerProc)
IF n^.subcl # OPM.assertfn THEN IfStat(n, FALSE, outerProc)
ELSIF assert THEN OPM.WriteString("__ASSERT("); expr(n^.left^.left^.left, MinPrec); OPM.WriteString(Comma); ELSIF assert THEN OPM.WriteString("__ASSERT("); expr(n^.left^.left^.left, MinPrec); OPM.WriteString(Comma);
OPM.WriteInt(n^.left^.right^.right^.conval^.intval); OPM.Write(CloseParen); OPC.EndStat OPM.WriteInt(n^.left^.right^.right^.conval^.intval); OPM.Write(CloseParen); OPC.EndStat
END END
| OPM.Ncase: | OPM.Ncase: INC(exit.level); CaseStat(n, outerProc); DEC(exit.level)
INC(exit.level); CaseStat(n, outerProc); DEC(exit.level) | OPM.Nwhile: INC(exit.level); OPM.WriteString("while "); expr(n^.left, MaxPrec);
| OPM.Nwhile:
INC(exit.level); OPM.WriteString("while "); expr(n^.left, MaxPrec);
OPM.Write(Blank); OPC.BegBlk; stat(n^.right, outerProc); OPC.EndBlk; OPM.Write(Blank); OPC.BegBlk; stat(n^.right, outerProc); OPC.EndBlk;
DEC(exit.level) DEC(exit.level)
| OPM.Nrepeat: | OPM.Nrepeat: INC(exit.level); OPM.WriteString("do "); OPC.BegBlk; stat(n^.left, outerProc); OPC.EndBlk0;
INC(exit.level); OPM.WriteString("do "); OPC.BegBlk; stat(n^.left, outerProc); OPC.EndBlk0;
OPM.WriteString(" while (!"); expr(n^.right, 9); OPM.Write(CloseParen); OPM.WriteString(" while (!"); expr(n^.right, 9); OPM.Write(CloseParen);
DEC(exit.level) DEC(exit.level)
| OPM.Nloop: | OPM.Nloop: saved := exit; exit.level := 0; exit.label := -1;
saved := exit; exit.level := 0; exit.label := -1;
OPM.WriteString("for (;;) "); OPC.BegBlk; stat(n^.left, outerProc); OPC.EndBlk; OPM.WriteString("for (;;) "); OPC.BegBlk; stat(n^.left, outerProc); OPC.EndBlk;
IF exit.label # -1 THEN IF exit.label # -1 THEN
OPC.BegStat; OPM.WriteString("exit__"); OPM.WriteInt(exit.label); OPM.Write(":"); OPC.EndStat OPC.BegStat; OPM.WriteString("exit__"); OPM.WriteInt(exit.label); OPM.Write(":"); OPC.EndStat
END ; END ;
exit := saved exit := saved
| OPM.Nexit: | OPM.Nexit: IF exit.level = 0 THEN OPM.WriteString(Break)
IF exit.level = 0 THEN OPM.WriteString(Break)
ELSE ELSE
IF exit.label = -1 THEN exit.label := nofExitLabels; INC(nofExitLabels) END ; IF exit.label = -1 THEN exit.label := nofExitLabels; INC(nofExitLabels) END ;
OPM.WriteString("goto exit__"); OPM.WriteInt(exit.label) OPM.WriteString("goto exit__"); OPM.WriteInt(exit.label)
END END
| OPM.Nreturn: | OPM.Nreturn: IF OPM.level = 0 THEN
IF OPM.level = 0 THEN
IF mainprog THEN OPM.WriteString("__FINI") ELSE OPM.WriteString("__ENDMOD") END IF mainprog THEN OPM.WriteString("__FINI") ELSE OPM.WriteString("__ENDMOD") END
ELSE ELSE
IF n^.left # NIL THEN IF n^.left # NIL THEN
@ -1003,20 +945,9 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPM.WriteString("return"); OPM.WriteString("return");
END END
END END
| OPM.Nwith: | OPM.Nwith: IfStat(n, n^.subcl = 0, outerProc)
IfStat(n, n^.subcl = 0, outerProc) | OPM.Ntrap: OPC.Halt(n^.right^.conval^.intval)
| OPM.Ntrap: ELSE OPM.LogWStr("unhandled case in OPV.expr, n^.class = "); OPM.LogWNum(n^.class, 0); OPM.LogWLn;
OPC.Halt(n^.right^.conval^.intval)
ELSE
(* this else is necessary cause
it can happen that
n^.class is something which is not handled,
like OPM.Nconst (7)
which I actually experienced
when compiling Texts0.OPM.Mod on raspberry pi
it generates __CASECHK and cause Halt,
noch *)
OPM.LogWStr("unhandled case in OPV.expr, n^.class = "); OPM.LogWNum(n^.class, 0); OPM.LogWLn;
END; END;
IF ~(n^.class IN {OPM.Nenter, OPM.Ninittd, OPM.Nifelse, OPM.Nwith, OPM.Ncase, OPM.Nwhile, OPM.Nloop}) THEN OPC.EndStat END ; IF ~(n^.class IN {OPM.Nenter, OPM.Ninittd, OPM.Nifelse, OPM.Nwith, OPM.Ncase, OPM.Nwhile, OPM.Nloop}) THEN OPC.EndStat END ;
n := n^.link n := n^.link