From 58556457bcbedc1f66bdddcdd8f420018e45c313 Mon Sep 17 00:00:00 2001 From: David Brown Date: Fri, 12 Aug 2016 20:41:58 +0100 Subject: [PATCH] Support non-printables in string literals and tidy case alignment and constant literals. --- bootstrap/unix-44/OPC.c | 194 ++++---- bootstrap/unix-44/OPM.c | 10 +- bootstrap/unix-44/OPS.c | 2 +- bootstrap/unix-44/Texts.c | 4 +- bootstrap/unix-44/errors.c | 30 +- bootstrap/unix-44/vt100.c | 2 +- bootstrap/unix-48/OPC.c | 194 ++++---- bootstrap/unix-48/OPM.c | 10 +- bootstrap/unix-48/OPS.c | 2 +- bootstrap/unix-48/Texts.c | 4 +- bootstrap/unix-48/errors.c | 30 +- bootstrap/unix-48/vt100.c | 2 +- bootstrap/unix-88/OPC.c | 194 ++++---- bootstrap/unix-88/OPM.c | 10 +- bootstrap/unix-88/OPS.c | 2 +- bootstrap/unix-88/Texts.c | 4 +- bootstrap/unix-88/errors.c | 30 +- bootstrap/unix-88/vt100.c | 2 +- bootstrap/windows-48/OPC.c | 194 ++++---- bootstrap/windows-48/OPM.c | 10 +- bootstrap/windows-48/OPS.c | 2 +- bootstrap/windows-48/Texts.c | 4 +- bootstrap/windows-48/errors.c | 30 +- bootstrap/windows-48/vt100.c | 2 +- bootstrap/windows-88/OPC.c | 194 ++++---- bootstrap/windows-88/OPM.c | 10 +- bootstrap/windows-88/OPS.c | 2 +- bootstrap/windows-88/Texts.c | 4 +- bootstrap/windows-88/errors.c | 30 +- bootstrap/windows-88/vt100.c | 2 +- src/compiler/OPC.Mod | 194 ++++---- src/compiler/OPV.Mod | 869 ++++++++++++++++------------------ 32 files changed, 1125 insertions(+), 1148 deletions(-) diff --git a/bootstrap/unix-44/OPC.c b/bootstrap/unix-44/OPC.c index d96b0e32..0864f1b1 100644 --- a/bootstrap/unix-44/OPC.c +++ b/bootstrap/unix-44/OPC.c @@ -22,6 +22,7 @@ export void OPC_BegBlk (void); export void OPC_BegStat (void); static void OPC_CProcDefs (OPT_Object obj, INTEGER vis); export void OPC_Case (LONGINT caseVal, INTEGER form); +static void OPC_CharacterLiteral (LONGINT c); export void OPC_Cmp (INTEGER rel); export void OPC_CompleteIdent (OPT_Object obj); 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); static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause); 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_TypeDefs (OPT_Object obj, INTEGER vis); export void OPC_TypeOf (OPT_Object ap); @@ -815,11 +817,12 @@ void OPC_TDescDecl (OPT_Struct typ) OPC_Andent(typ); OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1); OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ)); - OPM_Write('\"'); + OPM_Write('"'); if (typ->strobj != NIL) { 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; OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs); 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); OPM_WriteString((CHAR*)"#include ", (LONGINT)10); - OPM_Write('\"'); + OPM_Write('"'); OPM_WriteStringVar((void*)name, name__len); OPM_WriteString((CHAR*)".h", (LONGINT)3); - OPM_Write('\"'); + OPM_Write('"'); OPM_WriteLn(); __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) { CHAR ch; OPM_WriteString((CHAR*)"case ", (LONGINT)6); switch (form) { case 3: - ch = (CHAR)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); - } + OPC_CharacterLiteral(caseVal); break; case 4: case 5: case 6: 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) { - INTEGER i, len; - CHAR ch; + INTEGER i; SET s; LONGINT hex; BOOLEAN skipLeading; @@ -1945,18 +1977,7 @@ void OPC_Constant (OPT_Const con, INTEGER form) OPM_WriteInt(con->intval); break; case 3: - ch = (CHAR)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); - } + OPC_CharacterLiteral(con->intval); break; case 4: case 5: case 6: OPM_WriteInt(con->intval); @@ -1991,18 +2012,7 @@ void OPC_Constant (OPT_Const con, INTEGER form) } break; case 10: - OPM_Write('\"'); - 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('\"'); + OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1); break; case 11: 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; - struct InitKeywords__47 *lnk; -} *InitKeywords__47_s; + struct InitKeywords__48 *lnk; +} *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; __DUP(s, s__len, CHAR); h = OPC_PerfectHash((void*)s, s__len); - OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n; - __COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); - *InitKeywords__47_s->n += 1; + OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n; + __COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); + *InitKeywords__48_s->n += 1; __DEL(s); } static void OPC_InitKeywords (void) { SHORTINT n, i; - struct InitKeywords__47 _s; + struct InitKeywords__48 _s; _s.n = &n; - _s.lnk = InitKeywords__47_s; - InitKeywords__47_s = &_s; + _s.lnk = InitKeywords__48_s; + InitKeywords__48_s = &_s; n = 0; i = 0; while (i <= 104) { OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1; i += 1; } - Enter__48((CHAR*)"asm", (LONGINT)4); - Enter__48((CHAR*)"auto", (LONGINT)5); - Enter__48((CHAR*)"break", (LONGINT)6); - Enter__48((CHAR*)"case", (LONGINT)5); - Enter__48((CHAR*)"char", (LONGINT)5); - Enter__48((CHAR*)"const", (LONGINT)6); - Enter__48((CHAR*)"continue", (LONGINT)9); - Enter__48((CHAR*)"default", (LONGINT)8); - Enter__48((CHAR*)"do", (LONGINT)3); - Enter__48((CHAR*)"double", (LONGINT)7); - Enter__48((CHAR*)"else", (LONGINT)5); - Enter__48((CHAR*)"enum", (LONGINT)5); - Enter__48((CHAR*)"extern", (LONGINT)7); - Enter__48((CHAR*)"export", (LONGINT)7); - Enter__48((CHAR*)"float", (LONGINT)6); - Enter__48((CHAR*)"for", (LONGINT)4); - Enter__48((CHAR*)"fortran", (LONGINT)8); - Enter__48((CHAR*)"goto", (LONGINT)5); - Enter__48((CHAR*)"if", (LONGINT)3); - Enter__48((CHAR*)"import", (LONGINT)7); - Enter__48((CHAR*)"int", (LONGINT)4); - Enter__48((CHAR*)"long", (LONGINT)5); - Enter__48((CHAR*)"register", (LONGINT)9); - Enter__48((CHAR*)"return", (LONGINT)7); - Enter__48((CHAR*)"short", (LONGINT)6); - Enter__48((CHAR*)"signed", (LONGINT)7); - Enter__48((CHAR*)"sizeof", (LONGINT)7); - Enter__48((CHAR*)"static", (LONGINT)7); - Enter__48((CHAR*)"struct", (LONGINT)7); - Enter__48((CHAR*)"switch", (LONGINT)7); - Enter__48((CHAR*)"typedef", (LONGINT)8); - Enter__48((CHAR*)"union", (LONGINT)6); - Enter__48((CHAR*)"unsigned", (LONGINT)9); - Enter__48((CHAR*)"void", (LONGINT)5); - Enter__48((CHAR*)"volatile", (LONGINT)9); - Enter__48((CHAR*)"while", (LONGINT)6); - InitKeywords__47_s = _s.lnk; + Enter__49((CHAR*)"asm", (LONGINT)4); + Enter__49((CHAR*)"auto", (LONGINT)5); + Enter__49((CHAR*)"break", (LONGINT)6); + Enter__49((CHAR*)"case", (LONGINT)5); + Enter__49((CHAR*)"char", (LONGINT)5); + Enter__49((CHAR*)"const", (LONGINT)6); + Enter__49((CHAR*)"continue", (LONGINT)9); + Enter__49((CHAR*)"default", (LONGINT)8); + Enter__49((CHAR*)"do", (LONGINT)3); + Enter__49((CHAR*)"double", (LONGINT)7); + Enter__49((CHAR*)"else", (LONGINT)5); + Enter__49((CHAR*)"enum", (LONGINT)5); + Enter__49((CHAR*)"extern", (LONGINT)7); + Enter__49((CHAR*)"export", (LONGINT)7); + Enter__49((CHAR*)"float", (LONGINT)6); + Enter__49((CHAR*)"for", (LONGINT)4); + Enter__49((CHAR*)"fortran", (LONGINT)8); + Enter__49((CHAR*)"goto", (LONGINT)5); + Enter__49((CHAR*)"if", (LONGINT)3); + Enter__49((CHAR*)"import", (LONGINT)7); + Enter__49((CHAR*)"int", (LONGINT)4); + Enter__49((CHAR*)"long", (LONGINT)5); + Enter__49((CHAR*)"register", (LONGINT)9); + Enter__49((CHAR*)"return", (LONGINT)7); + Enter__49((CHAR*)"short", (LONGINT)6); + Enter__49((CHAR*)"signed", (LONGINT)7); + Enter__49((CHAR*)"sizeof", (LONGINT)7); + Enter__49((CHAR*)"static", (LONGINT)7); + Enter__49((CHAR*)"struct", (LONGINT)7); + Enter__49((CHAR*)"switch", (LONGINT)7); + Enter__49((CHAR*)"typedef", (LONGINT)8); + Enter__49((CHAR*)"union", (LONGINT)6); + Enter__49((CHAR*)"unsigned", (LONGINT)9); + Enter__49((CHAR*)"void", (LONGINT)5); + Enter__49((CHAR*)"volatile", (LONGINT)9); + Enter__49((CHAR*)"while", (LONGINT)6); + InitKeywords__48_s = _s.lnk; } diff --git a/bootstrap/unix-44/OPM.c b/bootstrap/unix-44/OPM.c index abef45d6..b76b57e9 100644 --- a/bootstrap/unix-44/OPM.c +++ b/bootstrap/unix-44/OPM.c @@ -228,17 +228,17 @@ BOOLEAN OPM_OpenPar (void) OPM_LogWLn(); OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35); 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_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48); 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_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_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24); + OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24); 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_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57); OPM_LogWLn(); diff --git a/bootstrap/unix-44/OPS.c b/bootstrap/unix-44/OPS.c index e4591084..f81f68c6 100644 --- a/bootstrap/unix-44/OPS.c +++ b/bootstrap/unix-44/OPS.c @@ -325,7 +325,7 @@ void OPS_Get (SHORTINT *sym) } } switch (OPS_ch) { - case '\"': case '\'': + case '"': case '\'': OPS_Str(&s); break; case '#': diff --git a/bootstrap/unix-44/Texts.c b/bootstrap/unix-44/Texts.c index f4cb302a..0c64fdcb 100644 --- a/bootstrap/unix-44/Texts.c +++ b/bootstrap/unix-44/Texts.c @@ -787,9 +787,9 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ) (*S).s[__X(i, ((LONGINT)(64)))] = 0x00; (*S).len = i; (*S).class = 1; - } else if (ch == '\"') { + } else if (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; i += 1; Texts_Read((void*)&*S, S__typ, &ch); diff --git a/bootstrap/unix-44/errors.c b/bootstrap/unix-44/errors.c index b0c6f226..8d2b6945 100644 --- a/bootstrap/unix-44/errors.c +++ b/bootstrap/unix-44/errors.c @@ -25,7 +25,7 @@ export void *errors__init(void) errors_errors[6][0] = 0x00; errors_errors[7][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[11][0] = 0x00; __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("MODULE expected", errors_errors[16], 16); errors_errors[17][0] = 0x00; - __MOVE("\'.\' missing", errors_errors[18], 12); - __MOVE("\',\' missing", errors_errors[19], 12); - __MOVE("\':\' missing", errors_errors[20], 12); + __MOVE("'.' missing", errors_errors[18], 12); + __MOVE("',' missing", errors_errors[19], 12); + __MOVE("':' missing", errors_errors[20], 12); errors_errors[21][0] = 0x00; - __MOVE("\')\' missing", errors_errors[22], 12); - __MOVE("\']\' missing", errors_errors[23], 12); - __MOVE("\'}\' missing", errors_errors[24], 12); + __MOVE("')' missing", errors_errors[22], 12); + __MOVE("']' missing", errors_errors[23], 12); + __MOVE("'}' missing", errors_errors[24], 12); __MOVE("OF missing", errors_errors[25], 11); __MOVE("THEN missing", errors_errors[26], 13); __MOVE("DO missing", errors_errors[27], 11); __MOVE("TO missing", errors_errors[28], 11); errors_errors[29][0] = 0x00; - __MOVE("\'(\' missing", errors_errors[30], 12); + __MOVE("'(' missing", errors_errors[30], 12); errors_errors[31][0] = 0x00; errors_errors[32][0] = 0x00; errors_errors[33][0] = 0x00; - __MOVE("\':=\' missing", errors_errors[34], 13); - __MOVE("\',\' or OF expected", errors_errors[35], 19); + __MOVE("':=' missing", errors_errors[34], 13); + __MOVE("',' or OF expected", errors_errors[35], 19); errors_errors[36][0] = 0x00; errors_errors[37][0] = 0x00; __MOVE("identifier expected", errors_errors[38], 20); - __MOVE("\';\' missing", errors_errors[39], 12); + __MOVE("';' missing", errors_errors[39], 12); errors_errors[40][0] = 0x00; __MOVE("END missing", errors_errors[41], 12); 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("incompatible assignment", errors_errors[113], 24); __MOVE("string too long to be assigned", errors_errors[114], 31); - __MOVE("parameter doesn\'t match", errors_errors[115], 24); - __MOVE("number of parameters doesn\'t match", errors_errors[116], 35); - __MOVE("result type doesn\'t match", errors_errors[117], 26); - __MOVE("export mark doesn\'t match with forward declaration", errors_errors[118], 51); + __MOVE("parameter doesn't match", errors_errors[115], 24); + __MOVE("number of parameters doesn't match", errors_errors[116], 35); + __MOVE("result type doesn't match", errors_errors[117], 26); + __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("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); diff --git a/bootstrap/unix-44/vt100.c b/bootstrap/unix-44/vt100.c index e2fa5210..dacaeca6 100644 --- a/bootstrap/unix-44/vt100.c +++ b/bootstrap/unix-44/vt100.c @@ -252,7 +252,7 @@ export void *vt100__init(void) __REGCMD("RCP", vt100_RCP); __REGCMD("SCP", vt100_SCP); /* BEGIN */ - __COPY("", vt100_CSI, ((LONGINT)(5))); + __COPY("\033", vt100_CSI, ((LONGINT)(5))); Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5))); __ENDMOD; } diff --git a/bootstrap/unix-48/OPC.c b/bootstrap/unix-48/OPC.c index d96b0e32..0864f1b1 100644 --- a/bootstrap/unix-48/OPC.c +++ b/bootstrap/unix-48/OPC.c @@ -22,6 +22,7 @@ export void OPC_BegBlk (void); export void OPC_BegStat (void); static void OPC_CProcDefs (OPT_Object obj, INTEGER vis); export void OPC_Case (LONGINT caseVal, INTEGER form); +static void OPC_CharacterLiteral (LONGINT c); export void OPC_Cmp (INTEGER rel); export void OPC_CompleteIdent (OPT_Object obj); 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); static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause); 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_TypeDefs (OPT_Object obj, INTEGER vis); export void OPC_TypeOf (OPT_Object ap); @@ -815,11 +817,12 @@ void OPC_TDescDecl (OPT_Struct typ) OPC_Andent(typ); OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1); OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ)); - OPM_Write('\"'); + OPM_Write('"'); if (typ->strobj != NIL) { 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; OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs); 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); OPM_WriteString((CHAR*)"#include ", (LONGINT)10); - OPM_Write('\"'); + OPM_Write('"'); OPM_WriteStringVar((void*)name, name__len); OPM_WriteString((CHAR*)".h", (LONGINT)3); - OPM_Write('\"'); + OPM_Write('"'); OPM_WriteLn(); __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) { CHAR ch; OPM_WriteString((CHAR*)"case ", (LONGINT)6); switch (form) { case 3: - ch = (CHAR)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); - } + OPC_CharacterLiteral(caseVal); break; case 4: case 5: case 6: 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) { - INTEGER i, len; - CHAR ch; + INTEGER i; SET s; LONGINT hex; BOOLEAN skipLeading; @@ -1945,18 +1977,7 @@ void OPC_Constant (OPT_Const con, INTEGER form) OPM_WriteInt(con->intval); break; case 3: - ch = (CHAR)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); - } + OPC_CharacterLiteral(con->intval); break; case 4: case 5: case 6: OPM_WriteInt(con->intval); @@ -1991,18 +2012,7 @@ void OPC_Constant (OPT_Const con, INTEGER form) } break; case 10: - OPM_Write('\"'); - 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('\"'); + OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1); break; case 11: 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; - struct InitKeywords__47 *lnk; -} *InitKeywords__47_s; + struct InitKeywords__48 *lnk; +} *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; __DUP(s, s__len, CHAR); h = OPC_PerfectHash((void*)s, s__len); - OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n; - __COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); - *InitKeywords__47_s->n += 1; + OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n; + __COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); + *InitKeywords__48_s->n += 1; __DEL(s); } static void OPC_InitKeywords (void) { SHORTINT n, i; - struct InitKeywords__47 _s; + struct InitKeywords__48 _s; _s.n = &n; - _s.lnk = InitKeywords__47_s; - InitKeywords__47_s = &_s; + _s.lnk = InitKeywords__48_s; + InitKeywords__48_s = &_s; n = 0; i = 0; while (i <= 104) { OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1; i += 1; } - Enter__48((CHAR*)"asm", (LONGINT)4); - Enter__48((CHAR*)"auto", (LONGINT)5); - Enter__48((CHAR*)"break", (LONGINT)6); - Enter__48((CHAR*)"case", (LONGINT)5); - Enter__48((CHAR*)"char", (LONGINT)5); - Enter__48((CHAR*)"const", (LONGINT)6); - Enter__48((CHAR*)"continue", (LONGINT)9); - Enter__48((CHAR*)"default", (LONGINT)8); - Enter__48((CHAR*)"do", (LONGINT)3); - Enter__48((CHAR*)"double", (LONGINT)7); - Enter__48((CHAR*)"else", (LONGINT)5); - Enter__48((CHAR*)"enum", (LONGINT)5); - Enter__48((CHAR*)"extern", (LONGINT)7); - Enter__48((CHAR*)"export", (LONGINT)7); - Enter__48((CHAR*)"float", (LONGINT)6); - Enter__48((CHAR*)"for", (LONGINT)4); - Enter__48((CHAR*)"fortran", (LONGINT)8); - Enter__48((CHAR*)"goto", (LONGINT)5); - Enter__48((CHAR*)"if", (LONGINT)3); - Enter__48((CHAR*)"import", (LONGINT)7); - Enter__48((CHAR*)"int", (LONGINT)4); - Enter__48((CHAR*)"long", (LONGINT)5); - Enter__48((CHAR*)"register", (LONGINT)9); - Enter__48((CHAR*)"return", (LONGINT)7); - Enter__48((CHAR*)"short", (LONGINT)6); - Enter__48((CHAR*)"signed", (LONGINT)7); - Enter__48((CHAR*)"sizeof", (LONGINT)7); - Enter__48((CHAR*)"static", (LONGINT)7); - Enter__48((CHAR*)"struct", (LONGINT)7); - Enter__48((CHAR*)"switch", (LONGINT)7); - Enter__48((CHAR*)"typedef", (LONGINT)8); - Enter__48((CHAR*)"union", (LONGINT)6); - Enter__48((CHAR*)"unsigned", (LONGINT)9); - Enter__48((CHAR*)"void", (LONGINT)5); - Enter__48((CHAR*)"volatile", (LONGINT)9); - Enter__48((CHAR*)"while", (LONGINT)6); - InitKeywords__47_s = _s.lnk; + Enter__49((CHAR*)"asm", (LONGINT)4); + Enter__49((CHAR*)"auto", (LONGINT)5); + Enter__49((CHAR*)"break", (LONGINT)6); + Enter__49((CHAR*)"case", (LONGINT)5); + Enter__49((CHAR*)"char", (LONGINT)5); + Enter__49((CHAR*)"const", (LONGINT)6); + Enter__49((CHAR*)"continue", (LONGINT)9); + Enter__49((CHAR*)"default", (LONGINT)8); + Enter__49((CHAR*)"do", (LONGINT)3); + Enter__49((CHAR*)"double", (LONGINT)7); + Enter__49((CHAR*)"else", (LONGINT)5); + Enter__49((CHAR*)"enum", (LONGINT)5); + Enter__49((CHAR*)"extern", (LONGINT)7); + Enter__49((CHAR*)"export", (LONGINT)7); + Enter__49((CHAR*)"float", (LONGINT)6); + Enter__49((CHAR*)"for", (LONGINT)4); + Enter__49((CHAR*)"fortran", (LONGINT)8); + Enter__49((CHAR*)"goto", (LONGINT)5); + Enter__49((CHAR*)"if", (LONGINT)3); + Enter__49((CHAR*)"import", (LONGINT)7); + Enter__49((CHAR*)"int", (LONGINT)4); + Enter__49((CHAR*)"long", (LONGINT)5); + Enter__49((CHAR*)"register", (LONGINT)9); + Enter__49((CHAR*)"return", (LONGINT)7); + Enter__49((CHAR*)"short", (LONGINT)6); + Enter__49((CHAR*)"signed", (LONGINT)7); + Enter__49((CHAR*)"sizeof", (LONGINT)7); + Enter__49((CHAR*)"static", (LONGINT)7); + Enter__49((CHAR*)"struct", (LONGINT)7); + Enter__49((CHAR*)"switch", (LONGINT)7); + Enter__49((CHAR*)"typedef", (LONGINT)8); + Enter__49((CHAR*)"union", (LONGINT)6); + Enter__49((CHAR*)"unsigned", (LONGINT)9); + Enter__49((CHAR*)"void", (LONGINT)5); + Enter__49((CHAR*)"volatile", (LONGINT)9); + Enter__49((CHAR*)"while", (LONGINT)6); + InitKeywords__48_s = _s.lnk; } diff --git a/bootstrap/unix-48/OPM.c b/bootstrap/unix-48/OPM.c index abef45d6..b76b57e9 100644 --- a/bootstrap/unix-48/OPM.c +++ b/bootstrap/unix-48/OPM.c @@ -228,17 +228,17 @@ BOOLEAN OPM_OpenPar (void) OPM_LogWLn(); OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35); 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_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48); 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_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_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24); + OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24); 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_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57); OPM_LogWLn(); diff --git a/bootstrap/unix-48/OPS.c b/bootstrap/unix-48/OPS.c index e4591084..f81f68c6 100644 --- a/bootstrap/unix-48/OPS.c +++ b/bootstrap/unix-48/OPS.c @@ -325,7 +325,7 @@ void OPS_Get (SHORTINT *sym) } } switch (OPS_ch) { - case '\"': case '\'': + case '"': case '\'': OPS_Str(&s); break; case '#': diff --git a/bootstrap/unix-48/Texts.c b/bootstrap/unix-48/Texts.c index 9a70708a..84409097 100644 --- a/bootstrap/unix-48/Texts.c +++ b/bootstrap/unix-48/Texts.c @@ -787,9 +787,9 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ) (*S).s[__X(i, ((LONGINT)(64)))] = 0x00; (*S).len = i; (*S).class = 1; - } else if (ch == '\"') { + } else if (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; i += 1; Texts_Read((void*)&*S, S__typ, &ch); diff --git a/bootstrap/unix-48/errors.c b/bootstrap/unix-48/errors.c index b0c6f226..8d2b6945 100644 --- a/bootstrap/unix-48/errors.c +++ b/bootstrap/unix-48/errors.c @@ -25,7 +25,7 @@ export void *errors__init(void) errors_errors[6][0] = 0x00; errors_errors[7][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[11][0] = 0x00; __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("MODULE expected", errors_errors[16], 16); errors_errors[17][0] = 0x00; - __MOVE("\'.\' missing", errors_errors[18], 12); - __MOVE("\',\' missing", errors_errors[19], 12); - __MOVE("\':\' missing", errors_errors[20], 12); + __MOVE("'.' missing", errors_errors[18], 12); + __MOVE("',' missing", errors_errors[19], 12); + __MOVE("':' missing", errors_errors[20], 12); errors_errors[21][0] = 0x00; - __MOVE("\')\' missing", errors_errors[22], 12); - __MOVE("\']\' missing", errors_errors[23], 12); - __MOVE("\'}\' missing", errors_errors[24], 12); + __MOVE("')' missing", errors_errors[22], 12); + __MOVE("']' missing", errors_errors[23], 12); + __MOVE("'}' missing", errors_errors[24], 12); __MOVE("OF missing", errors_errors[25], 11); __MOVE("THEN missing", errors_errors[26], 13); __MOVE("DO missing", errors_errors[27], 11); __MOVE("TO missing", errors_errors[28], 11); errors_errors[29][0] = 0x00; - __MOVE("\'(\' missing", errors_errors[30], 12); + __MOVE("'(' missing", errors_errors[30], 12); errors_errors[31][0] = 0x00; errors_errors[32][0] = 0x00; errors_errors[33][0] = 0x00; - __MOVE("\':=\' missing", errors_errors[34], 13); - __MOVE("\',\' or OF expected", errors_errors[35], 19); + __MOVE("':=' missing", errors_errors[34], 13); + __MOVE("',' or OF expected", errors_errors[35], 19); errors_errors[36][0] = 0x00; errors_errors[37][0] = 0x00; __MOVE("identifier expected", errors_errors[38], 20); - __MOVE("\';\' missing", errors_errors[39], 12); + __MOVE("';' missing", errors_errors[39], 12); errors_errors[40][0] = 0x00; __MOVE("END missing", errors_errors[41], 12); 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("incompatible assignment", errors_errors[113], 24); __MOVE("string too long to be assigned", errors_errors[114], 31); - __MOVE("parameter doesn\'t match", errors_errors[115], 24); - __MOVE("number of parameters doesn\'t match", errors_errors[116], 35); - __MOVE("result type doesn\'t match", errors_errors[117], 26); - __MOVE("export mark doesn\'t match with forward declaration", errors_errors[118], 51); + __MOVE("parameter doesn't match", errors_errors[115], 24); + __MOVE("number of parameters doesn't match", errors_errors[116], 35); + __MOVE("result type doesn't match", errors_errors[117], 26); + __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("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); diff --git a/bootstrap/unix-48/vt100.c b/bootstrap/unix-48/vt100.c index e2fa5210..dacaeca6 100644 --- a/bootstrap/unix-48/vt100.c +++ b/bootstrap/unix-48/vt100.c @@ -252,7 +252,7 @@ export void *vt100__init(void) __REGCMD("RCP", vt100_RCP); __REGCMD("SCP", vt100_SCP); /* BEGIN */ - __COPY("", vt100_CSI, ((LONGINT)(5))); + __COPY("\033", vt100_CSI, ((LONGINT)(5))); Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5))); __ENDMOD; } diff --git a/bootstrap/unix-88/OPC.c b/bootstrap/unix-88/OPC.c index ff97a2cb..10dc0df2 100644 --- a/bootstrap/unix-88/OPC.c +++ b/bootstrap/unix-88/OPC.c @@ -23,6 +23,7 @@ export void OPC_BegBlk (void); export void OPC_BegStat (void); static void OPC_CProcDefs (OPT_Object obj, INTEGER vis); export void OPC_Case (LONGINT caseVal, INTEGER form); +static void OPC_CharacterLiteral (LONGINT c); export void OPC_Cmp (INTEGER rel); export void OPC_CompleteIdent (OPT_Object obj); 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); static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause); 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_TypeDefs (OPT_Object obj, INTEGER vis); export void OPC_TypeOf (OPT_Object ap); @@ -816,11 +818,12 @@ void OPC_TDescDecl (OPT_Struct typ) OPC_Andent(typ); OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1); OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ)); - OPM_Write('\"'); + OPM_Write('"'); if (typ->strobj != NIL) { 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; OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs); 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); OPM_WriteString((CHAR*)"#include ", (LONGINT)10); - OPM_Write('\"'); + OPM_Write('"'); OPM_WriteStringVar((void*)name, name__len); OPM_WriteString((CHAR*)".h", (LONGINT)3); - OPM_Write('\"'); + OPM_Write('"'); OPM_WriteLn(); __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) { CHAR ch; OPM_WriteString((CHAR*)"case ", (LONGINT)6); switch (form) { case 3: - ch = (CHAR)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); - } + OPC_CharacterLiteral(caseVal); break; case 4: case 5: case 6: 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) { - INTEGER i, len; - CHAR ch; + INTEGER i; SET s; LONGINT hex; BOOLEAN skipLeading; @@ -1946,18 +1978,7 @@ void OPC_Constant (OPT_Const con, INTEGER form) OPM_WriteInt(con->intval); break; case 3: - ch = (CHAR)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); - } + OPC_CharacterLiteral(con->intval); break; case 4: case 5: case 6: OPM_WriteInt(con->intval); @@ -1992,18 +2013,7 @@ void OPC_Constant (OPT_Const con, INTEGER form) } break; case 10: - OPM_Write('\"'); - 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('\"'); + OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1); break; case 11: 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; - struct InitKeywords__47 *lnk; -} *InitKeywords__47_s; + struct InitKeywords__48 *lnk; +} *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; __DUP(s, s__len, CHAR); h = OPC_PerfectHash((void*)s, s__len); - OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n; - __COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); - *InitKeywords__47_s->n += 1; + OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n; + __COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); + *InitKeywords__48_s->n += 1; __DEL(s); } static void OPC_InitKeywords (void) { SHORTINT n, i; - struct InitKeywords__47 _s; + struct InitKeywords__48 _s; _s.n = &n; - _s.lnk = InitKeywords__47_s; - InitKeywords__47_s = &_s; + _s.lnk = InitKeywords__48_s; + InitKeywords__48_s = &_s; n = 0; i = 0; while (i <= 104) { OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1; i += 1; } - Enter__48((CHAR*)"asm", (LONGINT)4); - Enter__48((CHAR*)"auto", (LONGINT)5); - Enter__48((CHAR*)"break", (LONGINT)6); - Enter__48((CHAR*)"case", (LONGINT)5); - Enter__48((CHAR*)"char", (LONGINT)5); - Enter__48((CHAR*)"const", (LONGINT)6); - Enter__48((CHAR*)"continue", (LONGINT)9); - Enter__48((CHAR*)"default", (LONGINT)8); - Enter__48((CHAR*)"do", (LONGINT)3); - Enter__48((CHAR*)"double", (LONGINT)7); - Enter__48((CHAR*)"else", (LONGINT)5); - Enter__48((CHAR*)"enum", (LONGINT)5); - Enter__48((CHAR*)"extern", (LONGINT)7); - Enter__48((CHAR*)"export", (LONGINT)7); - Enter__48((CHAR*)"float", (LONGINT)6); - Enter__48((CHAR*)"for", (LONGINT)4); - Enter__48((CHAR*)"fortran", (LONGINT)8); - Enter__48((CHAR*)"goto", (LONGINT)5); - Enter__48((CHAR*)"if", (LONGINT)3); - Enter__48((CHAR*)"import", (LONGINT)7); - Enter__48((CHAR*)"int", (LONGINT)4); - Enter__48((CHAR*)"long", (LONGINT)5); - Enter__48((CHAR*)"register", (LONGINT)9); - Enter__48((CHAR*)"return", (LONGINT)7); - Enter__48((CHAR*)"short", (LONGINT)6); - Enter__48((CHAR*)"signed", (LONGINT)7); - Enter__48((CHAR*)"sizeof", (LONGINT)7); - Enter__48((CHAR*)"static", (LONGINT)7); - Enter__48((CHAR*)"struct", (LONGINT)7); - Enter__48((CHAR*)"switch", (LONGINT)7); - Enter__48((CHAR*)"typedef", (LONGINT)8); - Enter__48((CHAR*)"union", (LONGINT)6); - Enter__48((CHAR*)"unsigned", (LONGINT)9); - Enter__48((CHAR*)"void", (LONGINT)5); - Enter__48((CHAR*)"volatile", (LONGINT)9); - Enter__48((CHAR*)"while", (LONGINT)6); - InitKeywords__47_s = _s.lnk; + Enter__49((CHAR*)"asm", (LONGINT)4); + Enter__49((CHAR*)"auto", (LONGINT)5); + Enter__49((CHAR*)"break", (LONGINT)6); + Enter__49((CHAR*)"case", (LONGINT)5); + Enter__49((CHAR*)"char", (LONGINT)5); + Enter__49((CHAR*)"const", (LONGINT)6); + Enter__49((CHAR*)"continue", (LONGINT)9); + Enter__49((CHAR*)"default", (LONGINT)8); + Enter__49((CHAR*)"do", (LONGINT)3); + Enter__49((CHAR*)"double", (LONGINT)7); + Enter__49((CHAR*)"else", (LONGINT)5); + Enter__49((CHAR*)"enum", (LONGINT)5); + Enter__49((CHAR*)"extern", (LONGINT)7); + Enter__49((CHAR*)"export", (LONGINT)7); + Enter__49((CHAR*)"float", (LONGINT)6); + Enter__49((CHAR*)"for", (LONGINT)4); + Enter__49((CHAR*)"fortran", (LONGINT)8); + Enter__49((CHAR*)"goto", (LONGINT)5); + Enter__49((CHAR*)"if", (LONGINT)3); + Enter__49((CHAR*)"import", (LONGINT)7); + Enter__49((CHAR*)"int", (LONGINT)4); + Enter__49((CHAR*)"long", (LONGINT)5); + Enter__49((CHAR*)"register", (LONGINT)9); + Enter__49((CHAR*)"return", (LONGINT)7); + Enter__49((CHAR*)"short", (LONGINT)6); + Enter__49((CHAR*)"signed", (LONGINT)7); + Enter__49((CHAR*)"sizeof", (LONGINT)7); + Enter__49((CHAR*)"static", (LONGINT)7); + Enter__49((CHAR*)"struct", (LONGINT)7); + Enter__49((CHAR*)"switch", (LONGINT)7); + Enter__49((CHAR*)"typedef", (LONGINT)8); + Enter__49((CHAR*)"union", (LONGINT)6); + Enter__49((CHAR*)"unsigned", (LONGINT)9); + Enter__49((CHAR*)"void", (LONGINT)5); + Enter__49((CHAR*)"volatile", (LONGINT)9); + Enter__49((CHAR*)"while", (LONGINT)6); + InitKeywords__48_s = _s.lnk; } diff --git a/bootstrap/unix-88/OPM.c b/bootstrap/unix-88/OPM.c index 17b93af9..d476a920 100644 --- a/bootstrap/unix-88/OPM.c +++ b/bootstrap/unix-88/OPM.c @@ -229,17 +229,17 @@ BOOLEAN OPM_OpenPar (void) OPM_LogWLn(); OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35); 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_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48); 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_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_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24); + OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24); 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_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57); OPM_LogWLn(); diff --git a/bootstrap/unix-88/OPS.c b/bootstrap/unix-88/OPS.c index 3bf438fd..e01abff9 100644 --- a/bootstrap/unix-88/OPS.c +++ b/bootstrap/unix-88/OPS.c @@ -326,7 +326,7 @@ void OPS_Get (SHORTINT *sym) } } switch (OPS_ch) { - case '\"': case '\'': + case '"': case '\'': OPS_Str(&s); break; case '#': diff --git a/bootstrap/unix-88/Texts.c b/bootstrap/unix-88/Texts.c index 2f177403..ca4e46af 100644 --- a/bootstrap/unix-88/Texts.c +++ b/bootstrap/unix-88/Texts.c @@ -788,9 +788,9 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ) (*S).s[__X(i, ((LONGINT)(64)))] = 0x00; (*S).len = i; (*S).class = 1; - } else if (ch == '\"') { + } else if (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; i += 1; Texts_Read((void*)&*S, S__typ, &ch); diff --git a/bootstrap/unix-88/errors.c b/bootstrap/unix-88/errors.c index 45523073..039c1bd0 100644 --- a/bootstrap/unix-88/errors.c +++ b/bootstrap/unix-88/errors.c @@ -26,7 +26,7 @@ export void *errors__init(void) errors_errors[6][0] = 0x00; errors_errors[7][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[11][0] = 0x00; __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("MODULE expected", errors_errors[16], 16); errors_errors[17][0] = 0x00; - __MOVE("\'.\' missing", errors_errors[18], 12); - __MOVE("\',\' missing", errors_errors[19], 12); - __MOVE("\':\' missing", errors_errors[20], 12); + __MOVE("'.' missing", errors_errors[18], 12); + __MOVE("',' missing", errors_errors[19], 12); + __MOVE("':' missing", errors_errors[20], 12); errors_errors[21][0] = 0x00; - __MOVE("\')\' missing", errors_errors[22], 12); - __MOVE("\']\' missing", errors_errors[23], 12); - __MOVE("\'}\' missing", errors_errors[24], 12); + __MOVE("')' missing", errors_errors[22], 12); + __MOVE("']' missing", errors_errors[23], 12); + __MOVE("'}' missing", errors_errors[24], 12); __MOVE("OF missing", errors_errors[25], 11); __MOVE("THEN missing", errors_errors[26], 13); __MOVE("DO missing", errors_errors[27], 11); __MOVE("TO missing", errors_errors[28], 11); errors_errors[29][0] = 0x00; - __MOVE("\'(\' missing", errors_errors[30], 12); + __MOVE("'(' missing", errors_errors[30], 12); errors_errors[31][0] = 0x00; errors_errors[32][0] = 0x00; errors_errors[33][0] = 0x00; - __MOVE("\':=\' missing", errors_errors[34], 13); - __MOVE("\',\' or OF expected", errors_errors[35], 19); + __MOVE("':=' missing", errors_errors[34], 13); + __MOVE("',' or OF expected", errors_errors[35], 19); errors_errors[36][0] = 0x00; errors_errors[37][0] = 0x00; __MOVE("identifier expected", errors_errors[38], 20); - __MOVE("\';\' missing", errors_errors[39], 12); + __MOVE("';' missing", errors_errors[39], 12); errors_errors[40][0] = 0x00; __MOVE("END missing", errors_errors[41], 12); 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("incompatible assignment", errors_errors[113], 24); __MOVE("string too long to be assigned", errors_errors[114], 31); - __MOVE("parameter doesn\'t match", errors_errors[115], 24); - __MOVE("number of parameters doesn\'t match", errors_errors[116], 35); - __MOVE("result type doesn\'t match", errors_errors[117], 26); - __MOVE("export mark doesn\'t match with forward declaration", errors_errors[118], 51); + __MOVE("parameter doesn't match", errors_errors[115], 24); + __MOVE("number of parameters doesn't match", errors_errors[116], 35); + __MOVE("result type doesn't match", errors_errors[117], 26); + __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("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); diff --git a/bootstrap/unix-88/vt100.c b/bootstrap/unix-88/vt100.c index 9ffcb0c3..ccc6c6b7 100644 --- a/bootstrap/unix-88/vt100.c +++ b/bootstrap/unix-88/vt100.c @@ -253,7 +253,7 @@ export void *vt100__init(void) __REGCMD("RCP", vt100_RCP); __REGCMD("SCP", vt100_SCP); /* BEGIN */ - __COPY("", vt100_CSI, ((LONGINT)(5))); + __COPY("\033", vt100_CSI, ((LONGINT)(5))); Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5))); __ENDMOD; } diff --git a/bootstrap/windows-48/OPC.c b/bootstrap/windows-48/OPC.c index d96b0e32..0864f1b1 100644 --- a/bootstrap/windows-48/OPC.c +++ b/bootstrap/windows-48/OPC.c @@ -22,6 +22,7 @@ export void OPC_BegBlk (void); export void OPC_BegStat (void); static void OPC_CProcDefs (OPT_Object obj, INTEGER vis); export void OPC_Case (LONGINT caseVal, INTEGER form); +static void OPC_CharacterLiteral (LONGINT c); export void OPC_Cmp (INTEGER rel); export void OPC_CompleteIdent (OPT_Object obj); 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); static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause); 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_TypeDefs (OPT_Object obj, INTEGER vis); export void OPC_TypeOf (OPT_Object ap); @@ -815,11 +817,12 @@ void OPC_TDescDecl (OPT_Struct typ) OPC_Andent(typ); OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1); OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ)); - OPM_Write('\"'); + OPM_Write('"'); if (typ->strobj != NIL) { 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; OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs); 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); OPM_WriteString((CHAR*)"#include ", (LONGINT)10); - OPM_Write('\"'); + OPM_Write('"'); OPM_WriteStringVar((void*)name, name__len); OPM_WriteString((CHAR*)".h", (LONGINT)3); - OPM_Write('\"'); + OPM_Write('"'); OPM_WriteLn(); __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) { CHAR ch; OPM_WriteString((CHAR*)"case ", (LONGINT)6); switch (form) { case 3: - ch = (CHAR)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); - } + OPC_CharacterLiteral(caseVal); break; case 4: case 5: case 6: 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) { - INTEGER i, len; - CHAR ch; + INTEGER i; SET s; LONGINT hex; BOOLEAN skipLeading; @@ -1945,18 +1977,7 @@ void OPC_Constant (OPT_Const con, INTEGER form) OPM_WriteInt(con->intval); break; case 3: - ch = (CHAR)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); - } + OPC_CharacterLiteral(con->intval); break; case 4: case 5: case 6: OPM_WriteInt(con->intval); @@ -1991,18 +2012,7 @@ void OPC_Constant (OPT_Const con, INTEGER form) } break; case 10: - OPM_Write('\"'); - 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('\"'); + OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1); break; case 11: 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; - struct InitKeywords__47 *lnk; -} *InitKeywords__47_s; + struct InitKeywords__48 *lnk; +} *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; __DUP(s, s__len, CHAR); h = OPC_PerfectHash((void*)s, s__len); - OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n; - __COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); - *InitKeywords__47_s->n += 1; + OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n; + __COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); + *InitKeywords__48_s->n += 1; __DEL(s); } static void OPC_InitKeywords (void) { SHORTINT n, i; - struct InitKeywords__47 _s; + struct InitKeywords__48 _s; _s.n = &n; - _s.lnk = InitKeywords__47_s; - InitKeywords__47_s = &_s; + _s.lnk = InitKeywords__48_s; + InitKeywords__48_s = &_s; n = 0; i = 0; while (i <= 104) { OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1; i += 1; } - Enter__48((CHAR*)"asm", (LONGINT)4); - Enter__48((CHAR*)"auto", (LONGINT)5); - Enter__48((CHAR*)"break", (LONGINT)6); - Enter__48((CHAR*)"case", (LONGINT)5); - Enter__48((CHAR*)"char", (LONGINT)5); - Enter__48((CHAR*)"const", (LONGINT)6); - Enter__48((CHAR*)"continue", (LONGINT)9); - Enter__48((CHAR*)"default", (LONGINT)8); - Enter__48((CHAR*)"do", (LONGINT)3); - Enter__48((CHAR*)"double", (LONGINT)7); - Enter__48((CHAR*)"else", (LONGINT)5); - Enter__48((CHAR*)"enum", (LONGINT)5); - Enter__48((CHAR*)"extern", (LONGINT)7); - Enter__48((CHAR*)"export", (LONGINT)7); - Enter__48((CHAR*)"float", (LONGINT)6); - Enter__48((CHAR*)"for", (LONGINT)4); - Enter__48((CHAR*)"fortran", (LONGINT)8); - Enter__48((CHAR*)"goto", (LONGINT)5); - Enter__48((CHAR*)"if", (LONGINT)3); - Enter__48((CHAR*)"import", (LONGINT)7); - Enter__48((CHAR*)"int", (LONGINT)4); - Enter__48((CHAR*)"long", (LONGINT)5); - Enter__48((CHAR*)"register", (LONGINT)9); - Enter__48((CHAR*)"return", (LONGINT)7); - Enter__48((CHAR*)"short", (LONGINT)6); - Enter__48((CHAR*)"signed", (LONGINT)7); - Enter__48((CHAR*)"sizeof", (LONGINT)7); - Enter__48((CHAR*)"static", (LONGINT)7); - Enter__48((CHAR*)"struct", (LONGINT)7); - Enter__48((CHAR*)"switch", (LONGINT)7); - Enter__48((CHAR*)"typedef", (LONGINT)8); - Enter__48((CHAR*)"union", (LONGINT)6); - Enter__48((CHAR*)"unsigned", (LONGINT)9); - Enter__48((CHAR*)"void", (LONGINT)5); - Enter__48((CHAR*)"volatile", (LONGINT)9); - Enter__48((CHAR*)"while", (LONGINT)6); - InitKeywords__47_s = _s.lnk; + Enter__49((CHAR*)"asm", (LONGINT)4); + Enter__49((CHAR*)"auto", (LONGINT)5); + Enter__49((CHAR*)"break", (LONGINT)6); + Enter__49((CHAR*)"case", (LONGINT)5); + Enter__49((CHAR*)"char", (LONGINT)5); + Enter__49((CHAR*)"const", (LONGINT)6); + Enter__49((CHAR*)"continue", (LONGINT)9); + Enter__49((CHAR*)"default", (LONGINT)8); + Enter__49((CHAR*)"do", (LONGINT)3); + Enter__49((CHAR*)"double", (LONGINT)7); + Enter__49((CHAR*)"else", (LONGINT)5); + Enter__49((CHAR*)"enum", (LONGINT)5); + Enter__49((CHAR*)"extern", (LONGINT)7); + Enter__49((CHAR*)"export", (LONGINT)7); + Enter__49((CHAR*)"float", (LONGINT)6); + Enter__49((CHAR*)"for", (LONGINT)4); + Enter__49((CHAR*)"fortran", (LONGINT)8); + Enter__49((CHAR*)"goto", (LONGINT)5); + Enter__49((CHAR*)"if", (LONGINT)3); + Enter__49((CHAR*)"import", (LONGINT)7); + Enter__49((CHAR*)"int", (LONGINT)4); + Enter__49((CHAR*)"long", (LONGINT)5); + Enter__49((CHAR*)"register", (LONGINT)9); + Enter__49((CHAR*)"return", (LONGINT)7); + Enter__49((CHAR*)"short", (LONGINT)6); + Enter__49((CHAR*)"signed", (LONGINT)7); + Enter__49((CHAR*)"sizeof", (LONGINT)7); + Enter__49((CHAR*)"static", (LONGINT)7); + Enter__49((CHAR*)"struct", (LONGINT)7); + Enter__49((CHAR*)"switch", (LONGINT)7); + Enter__49((CHAR*)"typedef", (LONGINT)8); + Enter__49((CHAR*)"union", (LONGINT)6); + Enter__49((CHAR*)"unsigned", (LONGINT)9); + Enter__49((CHAR*)"void", (LONGINT)5); + Enter__49((CHAR*)"volatile", (LONGINT)9); + Enter__49((CHAR*)"while", (LONGINT)6); + InitKeywords__48_s = _s.lnk; } diff --git a/bootstrap/windows-48/OPM.c b/bootstrap/windows-48/OPM.c index abef45d6..b76b57e9 100644 --- a/bootstrap/windows-48/OPM.c +++ b/bootstrap/windows-48/OPM.c @@ -228,17 +228,17 @@ BOOLEAN OPM_OpenPar (void) OPM_LogWLn(); OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35); 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_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48); 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_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_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24); + OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24); 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_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57); OPM_LogWLn(); diff --git a/bootstrap/windows-48/OPS.c b/bootstrap/windows-48/OPS.c index e4591084..f81f68c6 100644 --- a/bootstrap/windows-48/OPS.c +++ b/bootstrap/windows-48/OPS.c @@ -325,7 +325,7 @@ void OPS_Get (SHORTINT *sym) } } switch (OPS_ch) { - case '\"': case '\'': + case '"': case '\'': OPS_Str(&s); break; case '#': diff --git a/bootstrap/windows-48/Texts.c b/bootstrap/windows-48/Texts.c index 9a70708a..84409097 100644 --- a/bootstrap/windows-48/Texts.c +++ b/bootstrap/windows-48/Texts.c @@ -787,9 +787,9 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ) (*S).s[__X(i, ((LONGINT)(64)))] = 0x00; (*S).len = i; (*S).class = 1; - } else if (ch == '\"') { + } else if (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; i += 1; Texts_Read((void*)&*S, S__typ, &ch); diff --git a/bootstrap/windows-48/errors.c b/bootstrap/windows-48/errors.c index b0c6f226..8d2b6945 100644 --- a/bootstrap/windows-48/errors.c +++ b/bootstrap/windows-48/errors.c @@ -25,7 +25,7 @@ export void *errors__init(void) errors_errors[6][0] = 0x00; errors_errors[7][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[11][0] = 0x00; __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("MODULE expected", errors_errors[16], 16); errors_errors[17][0] = 0x00; - __MOVE("\'.\' missing", errors_errors[18], 12); - __MOVE("\',\' missing", errors_errors[19], 12); - __MOVE("\':\' missing", errors_errors[20], 12); + __MOVE("'.' missing", errors_errors[18], 12); + __MOVE("',' missing", errors_errors[19], 12); + __MOVE("':' missing", errors_errors[20], 12); errors_errors[21][0] = 0x00; - __MOVE("\')\' missing", errors_errors[22], 12); - __MOVE("\']\' missing", errors_errors[23], 12); - __MOVE("\'}\' missing", errors_errors[24], 12); + __MOVE("')' missing", errors_errors[22], 12); + __MOVE("']' missing", errors_errors[23], 12); + __MOVE("'}' missing", errors_errors[24], 12); __MOVE("OF missing", errors_errors[25], 11); __MOVE("THEN missing", errors_errors[26], 13); __MOVE("DO missing", errors_errors[27], 11); __MOVE("TO missing", errors_errors[28], 11); errors_errors[29][0] = 0x00; - __MOVE("\'(\' missing", errors_errors[30], 12); + __MOVE("'(' missing", errors_errors[30], 12); errors_errors[31][0] = 0x00; errors_errors[32][0] = 0x00; errors_errors[33][0] = 0x00; - __MOVE("\':=\' missing", errors_errors[34], 13); - __MOVE("\',\' or OF expected", errors_errors[35], 19); + __MOVE("':=' missing", errors_errors[34], 13); + __MOVE("',' or OF expected", errors_errors[35], 19); errors_errors[36][0] = 0x00; errors_errors[37][0] = 0x00; __MOVE("identifier expected", errors_errors[38], 20); - __MOVE("\';\' missing", errors_errors[39], 12); + __MOVE("';' missing", errors_errors[39], 12); errors_errors[40][0] = 0x00; __MOVE("END missing", errors_errors[41], 12); 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("incompatible assignment", errors_errors[113], 24); __MOVE("string too long to be assigned", errors_errors[114], 31); - __MOVE("parameter doesn\'t match", errors_errors[115], 24); - __MOVE("number of parameters doesn\'t match", errors_errors[116], 35); - __MOVE("result type doesn\'t match", errors_errors[117], 26); - __MOVE("export mark doesn\'t match with forward declaration", errors_errors[118], 51); + __MOVE("parameter doesn't match", errors_errors[115], 24); + __MOVE("number of parameters doesn't match", errors_errors[116], 35); + __MOVE("result type doesn't match", errors_errors[117], 26); + __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("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); diff --git a/bootstrap/windows-48/vt100.c b/bootstrap/windows-48/vt100.c index e2fa5210..dacaeca6 100644 --- a/bootstrap/windows-48/vt100.c +++ b/bootstrap/windows-48/vt100.c @@ -252,7 +252,7 @@ export void *vt100__init(void) __REGCMD("RCP", vt100_RCP); __REGCMD("SCP", vt100_SCP); /* BEGIN */ - __COPY("", vt100_CSI, ((LONGINT)(5))); + __COPY("\033", vt100_CSI, ((LONGINT)(5))); Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5))); __ENDMOD; } diff --git a/bootstrap/windows-88/OPC.c b/bootstrap/windows-88/OPC.c index ff97a2cb..10dc0df2 100644 --- a/bootstrap/windows-88/OPC.c +++ b/bootstrap/windows-88/OPC.c @@ -23,6 +23,7 @@ export void OPC_BegBlk (void); export void OPC_BegStat (void); static void OPC_CProcDefs (OPT_Object obj, INTEGER vis); export void OPC_Case (LONGINT caseVal, INTEGER form); +static void OPC_CharacterLiteral (LONGINT c); export void OPC_Cmp (INTEGER rel); export void OPC_CompleteIdent (OPT_Object obj); 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); static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause); 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_TypeDefs (OPT_Object obj, INTEGER vis); export void OPC_TypeOf (OPT_Object ap); @@ -816,11 +818,12 @@ void OPC_TDescDecl (OPT_Struct typ) OPC_Andent(typ); OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1); OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ)); - OPM_Write('\"'); + OPM_Write('"'); if (typ->strobj != NIL) { 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; OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs); 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); OPM_WriteString((CHAR*)"#include ", (LONGINT)10); - OPM_Write('\"'); + OPM_Write('"'); OPM_WriteStringVar((void*)name, name__len); OPM_WriteString((CHAR*)".h", (LONGINT)3); - OPM_Write('\"'); + OPM_Write('"'); OPM_WriteLn(); __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) { CHAR ch; OPM_WriteString((CHAR*)"case ", (LONGINT)6); switch (form) { case 3: - ch = (CHAR)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); - } + OPC_CharacterLiteral(caseVal); break; case 4: case 5: case 6: 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) { - INTEGER i, len; - CHAR ch; + INTEGER i; SET s; LONGINT hex; BOOLEAN skipLeading; @@ -1946,18 +1978,7 @@ void OPC_Constant (OPT_Const con, INTEGER form) OPM_WriteInt(con->intval); break; case 3: - ch = (CHAR)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); - } + OPC_CharacterLiteral(con->intval); break; case 4: case 5: case 6: OPM_WriteInt(con->intval); @@ -1992,18 +2013,7 @@ void OPC_Constant (OPT_Const con, INTEGER form) } break; case 10: - OPM_Write('\"'); - 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('\"'); + OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1); break; case 11: 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; - struct InitKeywords__47 *lnk; -} *InitKeywords__47_s; + struct InitKeywords__48 *lnk; +} *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; __DUP(s, s__len, CHAR); h = OPC_PerfectHash((void*)s, s__len); - OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n; - __COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); - *InitKeywords__47_s->n += 1; + OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n; + __COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); + *InitKeywords__48_s->n += 1; __DEL(s); } static void OPC_InitKeywords (void) { SHORTINT n, i; - struct InitKeywords__47 _s; + struct InitKeywords__48 _s; _s.n = &n; - _s.lnk = InitKeywords__47_s; - InitKeywords__47_s = &_s; + _s.lnk = InitKeywords__48_s; + InitKeywords__48_s = &_s; n = 0; i = 0; while (i <= 104) { OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1; i += 1; } - Enter__48((CHAR*)"asm", (LONGINT)4); - Enter__48((CHAR*)"auto", (LONGINT)5); - Enter__48((CHAR*)"break", (LONGINT)6); - Enter__48((CHAR*)"case", (LONGINT)5); - Enter__48((CHAR*)"char", (LONGINT)5); - Enter__48((CHAR*)"const", (LONGINT)6); - Enter__48((CHAR*)"continue", (LONGINT)9); - Enter__48((CHAR*)"default", (LONGINT)8); - Enter__48((CHAR*)"do", (LONGINT)3); - Enter__48((CHAR*)"double", (LONGINT)7); - Enter__48((CHAR*)"else", (LONGINT)5); - Enter__48((CHAR*)"enum", (LONGINT)5); - Enter__48((CHAR*)"extern", (LONGINT)7); - Enter__48((CHAR*)"export", (LONGINT)7); - Enter__48((CHAR*)"float", (LONGINT)6); - Enter__48((CHAR*)"for", (LONGINT)4); - Enter__48((CHAR*)"fortran", (LONGINT)8); - Enter__48((CHAR*)"goto", (LONGINT)5); - Enter__48((CHAR*)"if", (LONGINT)3); - Enter__48((CHAR*)"import", (LONGINT)7); - Enter__48((CHAR*)"int", (LONGINT)4); - Enter__48((CHAR*)"long", (LONGINT)5); - Enter__48((CHAR*)"register", (LONGINT)9); - Enter__48((CHAR*)"return", (LONGINT)7); - Enter__48((CHAR*)"short", (LONGINT)6); - Enter__48((CHAR*)"signed", (LONGINT)7); - Enter__48((CHAR*)"sizeof", (LONGINT)7); - Enter__48((CHAR*)"static", (LONGINT)7); - Enter__48((CHAR*)"struct", (LONGINT)7); - Enter__48((CHAR*)"switch", (LONGINT)7); - Enter__48((CHAR*)"typedef", (LONGINT)8); - Enter__48((CHAR*)"union", (LONGINT)6); - Enter__48((CHAR*)"unsigned", (LONGINT)9); - Enter__48((CHAR*)"void", (LONGINT)5); - Enter__48((CHAR*)"volatile", (LONGINT)9); - Enter__48((CHAR*)"while", (LONGINT)6); - InitKeywords__47_s = _s.lnk; + Enter__49((CHAR*)"asm", (LONGINT)4); + Enter__49((CHAR*)"auto", (LONGINT)5); + Enter__49((CHAR*)"break", (LONGINT)6); + Enter__49((CHAR*)"case", (LONGINT)5); + Enter__49((CHAR*)"char", (LONGINT)5); + Enter__49((CHAR*)"const", (LONGINT)6); + Enter__49((CHAR*)"continue", (LONGINT)9); + Enter__49((CHAR*)"default", (LONGINT)8); + Enter__49((CHAR*)"do", (LONGINT)3); + Enter__49((CHAR*)"double", (LONGINT)7); + Enter__49((CHAR*)"else", (LONGINT)5); + Enter__49((CHAR*)"enum", (LONGINT)5); + Enter__49((CHAR*)"extern", (LONGINT)7); + Enter__49((CHAR*)"export", (LONGINT)7); + Enter__49((CHAR*)"float", (LONGINT)6); + Enter__49((CHAR*)"for", (LONGINT)4); + Enter__49((CHAR*)"fortran", (LONGINT)8); + Enter__49((CHAR*)"goto", (LONGINT)5); + Enter__49((CHAR*)"if", (LONGINT)3); + Enter__49((CHAR*)"import", (LONGINT)7); + Enter__49((CHAR*)"int", (LONGINT)4); + Enter__49((CHAR*)"long", (LONGINT)5); + Enter__49((CHAR*)"register", (LONGINT)9); + Enter__49((CHAR*)"return", (LONGINT)7); + Enter__49((CHAR*)"short", (LONGINT)6); + Enter__49((CHAR*)"signed", (LONGINT)7); + Enter__49((CHAR*)"sizeof", (LONGINT)7); + Enter__49((CHAR*)"static", (LONGINT)7); + Enter__49((CHAR*)"struct", (LONGINT)7); + Enter__49((CHAR*)"switch", (LONGINT)7); + Enter__49((CHAR*)"typedef", (LONGINT)8); + Enter__49((CHAR*)"union", (LONGINT)6); + Enter__49((CHAR*)"unsigned", (LONGINT)9); + Enter__49((CHAR*)"void", (LONGINT)5); + Enter__49((CHAR*)"volatile", (LONGINT)9); + Enter__49((CHAR*)"while", (LONGINT)6); + InitKeywords__48_s = _s.lnk; } diff --git a/bootstrap/windows-88/OPM.c b/bootstrap/windows-88/OPM.c index 17b93af9..d476a920 100644 --- a/bootstrap/windows-88/OPM.c +++ b/bootstrap/windows-88/OPM.c @@ -229,17 +229,17 @@ BOOLEAN OPM_OpenPar (void) OPM_LogWLn(); OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35); 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_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48); 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_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_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24); + OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24); 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_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57); OPM_LogWLn(); diff --git a/bootstrap/windows-88/OPS.c b/bootstrap/windows-88/OPS.c index 3bf438fd..e01abff9 100644 --- a/bootstrap/windows-88/OPS.c +++ b/bootstrap/windows-88/OPS.c @@ -326,7 +326,7 @@ void OPS_Get (SHORTINT *sym) } } switch (OPS_ch) { - case '\"': case '\'': + case '"': case '\'': OPS_Str(&s); break; case '#': diff --git a/bootstrap/windows-88/Texts.c b/bootstrap/windows-88/Texts.c index 2f177403..ca4e46af 100644 --- a/bootstrap/windows-88/Texts.c +++ b/bootstrap/windows-88/Texts.c @@ -788,9 +788,9 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ) (*S).s[__X(i, ((LONGINT)(64)))] = 0x00; (*S).len = i; (*S).class = 1; - } else if (ch == '\"') { + } else if (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; i += 1; Texts_Read((void*)&*S, S__typ, &ch); diff --git a/bootstrap/windows-88/errors.c b/bootstrap/windows-88/errors.c index 45523073..039c1bd0 100644 --- a/bootstrap/windows-88/errors.c +++ b/bootstrap/windows-88/errors.c @@ -26,7 +26,7 @@ export void *errors__init(void) errors_errors[6][0] = 0x00; errors_errors[7][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[11][0] = 0x00; __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("MODULE expected", errors_errors[16], 16); errors_errors[17][0] = 0x00; - __MOVE("\'.\' missing", errors_errors[18], 12); - __MOVE("\',\' missing", errors_errors[19], 12); - __MOVE("\':\' missing", errors_errors[20], 12); + __MOVE("'.' missing", errors_errors[18], 12); + __MOVE("',' missing", errors_errors[19], 12); + __MOVE("':' missing", errors_errors[20], 12); errors_errors[21][0] = 0x00; - __MOVE("\')\' missing", errors_errors[22], 12); - __MOVE("\']\' missing", errors_errors[23], 12); - __MOVE("\'}\' missing", errors_errors[24], 12); + __MOVE("')' missing", errors_errors[22], 12); + __MOVE("']' missing", errors_errors[23], 12); + __MOVE("'}' missing", errors_errors[24], 12); __MOVE("OF missing", errors_errors[25], 11); __MOVE("THEN missing", errors_errors[26], 13); __MOVE("DO missing", errors_errors[27], 11); __MOVE("TO missing", errors_errors[28], 11); errors_errors[29][0] = 0x00; - __MOVE("\'(\' missing", errors_errors[30], 12); + __MOVE("'(' missing", errors_errors[30], 12); errors_errors[31][0] = 0x00; errors_errors[32][0] = 0x00; errors_errors[33][0] = 0x00; - __MOVE("\':=\' missing", errors_errors[34], 13); - __MOVE("\',\' or OF expected", errors_errors[35], 19); + __MOVE("':=' missing", errors_errors[34], 13); + __MOVE("',' or OF expected", errors_errors[35], 19); errors_errors[36][0] = 0x00; errors_errors[37][0] = 0x00; __MOVE("identifier expected", errors_errors[38], 20); - __MOVE("\';\' missing", errors_errors[39], 12); + __MOVE("';' missing", errors_errors[39], 12); errors_errors[40][0] = 0x00; __MOVE("END missing", errors_errors[41], 12); 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("incompatible assignment", errors_errors[113], 24); __MOVE("string too long to be assigned", errors_errors[114], 31); - __MOVE("parameter doesn\'t match", errors_errors[115], 24); - __MOVE("number of parameters doesn\'t match", errors_errors[116], 35); - __MOVE("result type doesn\'t match", errors_errors[117], 26); - __MOVE("export mark doesn\'t match with forward declaration", errors_errors[118], 51); + __MOVE("parameter doesn't match", errors_errors[115], 24); + __MOVE("number of parameters doesn't match", errors_errors[116], 35); + __MOVE("result type doesn't match", errors_errors[117], 26); + __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("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); diff --git a/bootstrap/windows-88/vt100.c b/bootstrap/windows-88/vt100.c index 9ffcb0c3..ccc6c6b7 100644 --- a/bootstrap/windows-88/vt100.c +++ b/bootstrap/windows-88/vt100.c @@ -253,7 +253,7 @@ export void *vt100__init(void) __REGCMD("RCP", vt100_RCP); __REGCMD("SCP", vt100_SCP); /* BEGIN */ - __COPY("", vt100_CSI, ((LONGINT)(5))); + __COPY("\033", vt100_CSI, ((LONGINT)(5))); Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5))); __ENDMOD; } diff --git a/src/compiler/OPC.Mod b/src/compiler/OPC.Mod index a0c474ca..67a67a9f 100644 --- a/src/compiler/OPC.Mod +++ b/src/compiler/OPC.Mod @@ -31,7 +31,10 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) DynTypExt = "__typ"; TagExt = "__typ"; 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 @@ -542,9 +545,10 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) BegStat; OPM.WriteString("__TDESC("); Andent(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 ; - Str1('", #), {', typ^.size); + OPM.Write(DoubleQuote); + Str1(', #), {', typ^.size); nofptrs := 0; PutPtrOffsets(typ, 0, nofptrs); Str1("#}}", -(nofptrs + 1) * OPM.LIntSize); EndStat END TDescDecl; @@ -562,12 +566,11 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) PROCEDURE Align*(VAR adr: LONGINT; base: LONGINT); BEGIN CASE base OF - | 2: INC(adr, adr MOD 2) + | 2: INC(adr, adr MOD 2) | 4: INC(adr, (-adr) MOD 4) | 8: INC(adr, (-adr) MOD 8) - |16: INC(adr, (-adr) MOD 16) - ELSE (*1*) - (*OPM.LogWStr("unhandled case at OPC.Align, base = "); OPM.LogWNum(base, 0); OPM.LogWLn;*) + | 16: INC(adr, (-adr) MOD 16) + ELSE (*1*) (*OPM.LogWStr("unhandled case at OPC.Align, base = "); OPM.LogWNum(base, 0); OPM.LogWLn;*) END END Align; @@ -585,10 +588,9 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) | OPM.Set: RETURN OPM.SetAlign | OPM.Pointer: RETURN OPM.PointerAlign | OPM.ProcTyp: RETURN OPM.ProcAlign - | OPM.Comp: - IF typ^.comp = OPM.Record THEN RETURN typ^.align MOD 10000H - ELSE RETURN Base(typ^.BaseTyp) - END + | OPM.Comp: IF typ^.comp = OPM.Record THEN RETURN typ^.align MOD 10000H + ELSE RETURN Base(typ^.BaseTyp) + END ELSE OPM.LogWStr("unhandled case in OPC.Base, typ^form = "); OPM.LogWNum(typ^.form, 0); OPM.LogWLn; END END Base; @@ -749,8 +751,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) PROCEDURE Include(name: ARRAY OF CHAR); BEGIN - OPM.WriteString("#include "); OPM.Write('"'); OPM.WriteStringVar(name); - OPM.WriteString(".h"); OPM.Write('"'); OPM.WriteLn + OPM.WriteString("#include "); OPM.Write(DoubleQuote); OPM.WriteStringVar(name); + OPM.WriteString(".h"); OPM.Write(DoubleQuote); OPM.WriteLn END Include; 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.forcenewsym: OPM.Write("F") | OPM.verbose: OPM.Write("v") - ELSE - (* 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; + 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; END END END; @@ -1173,44 +1168,67 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) PROCEDURE Cmp*(rel: INTEGER); BEGIN CASE rel OF - OPM.eql : - OPM.WriteString(" == "); - | OPM.neq : - OPM.WriteString(" != "); - | OPM.lss : - OPM.WriteString(" < "); - | OPM.leq : - 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; + | OPM.eql: OPM.WriteString(" == ") + | OPM.neq: OPM.WriteString(" != ") + | OPM.lss: OPM.WriteString(" < ") + | OPM.leq: 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 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); VAR ch: CHAR; BEGIN OPM.WriteString('case '); CASE form OF - | OPM.Char : - ch := CHR (caseVal); - IF (ch >= " ") & (ch <= "~") THEN - OPM.Write("'"); - IF (ch = Backslash) OR (ch = "?") OR (ch = "'") OR (ch = '"') THEN OPM.Write(Backslash); OPM.Write(ch); - 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; + | OPM.Char: CharacterLiteral(caseVal) + | 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; OPM.WriteString(': '); END Case; @@ -1242,58 +1260,36 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) END Len; PROCEDURE Constant* (con: OPT.Const; form: INTEGER); - VAR i, len: INTEGER; ch: CHAR; s: SET; + VAR i: INTEGER; s: SET; hex: LONGINT; skipLeading: BOOLEAN; BEGIN CASE form OF - OPM.Byte: - OPM.WriteInt(con^.intval) - | OPM.Bool: - OPM.WriteInt(con^.intval) - | OPM.Char: - ch := CHR(con^.intval); - IF (ch >= " ") & (ch <= "~") THEN - OPM.Write("'"); - IF (ch = Backslash) OR (ch = "?") OR (ch = "'") OR (ch = '"') THEN OPM.Write(Backslash) END ; - 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; - s := con^.setval; i := MAX(SET) + 1; - REPEAT - hex := 0; - REPEAT - DEC(i); hex := 2 * hex; - IF i IN s THEN INC(hex) END - UNTIL i MOD 8 = 0; - IF (hex # 0) OR ~skipLeading THEN - OPM.WriteHex(hex); - skipLeading := FALSE - END - UNTIL i = 0; - IF skipLeading THEN OPM.Write("0") END - | OPM.String: - OPM.Write('"'); - len := SHORT(con^.intval2) - 1; i := 0; - 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; + | OPM.Byte: OPM.WriteInt(con^.intval) + | OPM.Bool: OPM.WriteInt(con^.intval) + | OPM.Char: CharacterLiteral(con.intval) + | 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; + s := con^.setval; i := MAX(SET) + 1; + REPEAT + hex := 0; + REPEAT + DEC(i); hex := 2 * hex; + IF i IN s THEN INC(hex) END + UNTIL i MOD 8 = 0; + IF (hex # 0) OR ~skipLeading THEN + OPM.WriteHex(hex); + skipLeading := FALSE + END + UNTIL i = 0; + IF skipLeading THEN OPM.Write("0") END + | OPM.String: StringLiteral(con.ext^, con.intval2-1) + | OPM.NilTyp: OPM.WriteString('NIL'); + ELSE OPM.LogWStr("unhandled case in OPC.Constant, form = "); OPM.LogWNum(form, 0); OPM.LogWLn; END; END Constant; diff --git a/src/compiler/OPV.Mod b/src/compiler/OPV.Mod index 8cb7096e..0df0e920 100644 --- a/src/compiler/OPV.Mod +++ b/src/compiler/OPV.Mod @@ -217,53 +217,48 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 PROCEDURE Precedence (class, subclass, form, comp: INTEGER): INTEGER; BEGIN CASE class OF - OPM.Nconst, 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.Nvarpar: - IF comp IN {OPM.Array, OPM.DynArr} THEN RETURN 10 ELSE RETURN 9 END (* arrays don't need deref *) - | OPM.Nderef: - RETURN 9 - | OPM.Nmop: - CASE subclass OF - 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 - | OPM.Ndop: - CASE subclass OF - OPM.times: - IF form = OPM.Set THEN RETURN 4 ELSE RETURN 8 END - | OPM.slash: - IF form = OPM.Set THEN RETURN 3 ELSE RETURN 8 END - | OPM.div, OPM.mod: - RETURN 10 (* div/mod are replaced by functions *) - | OPM.plus: - IF form = OPM.Set THEN RETURN 2 ELSE RETURN 7 END - | OPM.minus: - IF form = OPM.Set THEN RETURN 4 ELSE RETURN 7 END - | OPM.lss, OPM.leq, OPM.gtr, OPM.geq: - RETURN 6 - | OPM.eql, OPM.neq: - RETURN 5 - | OPM.and: - RETURN 1 - | OPM.or: - RETURN 0 - | OPM.len, OPM.in, OPM.ash, OPM.msk, OPM.bit, OPM.lsh, OPM.rot: - RETURN 10 - ELSE - OPM.LogWStr("unhandled case in OPV.Precedence OPM.Ndop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; - END; - | OPM.Nupto: - RETURN 10 - | OPM.Ntype, OPM.Neguard: (* ignored anyway *) - RETURN MaxPrec - ELSE - OPM.LogWStr("unhandled case in OPV.Precedence, class = "); OPM.LogWNum(class, 0); OPM.LogWLn; + | OPM.Nconst, + 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.Nvarpar: IF comp IN {OPM.Array, OPM.DynArr} THEN RETURN 10 ELSE RETURN 9 END (* arrays don't need deref *) + | OPM.Nderef: RETURN 9 + | OPM.Nmop: CASE subclass OF + | 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 + | OPM.Ndop: CASE subclass OF + | OPM.times: IF form = OPM.Set THEN RETURN 4 ELSE RETURN 8 END + | OPM.slash: IF form = OPM.Set THEN RETURN 3 ELSE RETURN 8 END + | OPM.div, + OPM.mod: RETURN 10 (* div/mod are replaced by functions *) + | OPM.plus: IF form = OPM.Set THEN RETURN 2 ELSE RETURN 7 END + | OPM.minus: IF form = OPM.Set THEN RETURN 4 ELSE RETURN 7 END + | OPM.lss, + OPM.leq, + OPM.gtr, + OPM.geq: RETURN 6 + | OPM.eql, + OPM.neq: RETURN 5 + | OPM.and: RETURN 1 + | OPM.or: RETURN 0 + | OPM.len, + OPM.in, + OPM.ash, + OPM.msk, + OPM.bit, + OPM.lsh, + OPM.rot: RETURN 10 + ELSE OPM.LogWStr("unhandled case in OPV.Precedence OPM.Ndop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; + END; + | OPM.Nupto: RETURN 10 + | OPM.Ntype, + OPM.Neguard: (* ignored anyway *) RETURN MaxPrec + ELSE OPM.LogWStr("unhandled case in OPV.Precedence, class = "); OPM.LogWNum(class, 0); OPM.LogWLn; END; END Precedence; @@ -302,9 +297,6 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 ELSIF form = OPM.LInt THEN IF from < OPM.LInt THEN OPM.WriteString("(LONGINT)") END ; 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 IF from < OPM.Int THEN OPM.WriteString("(int)"); expr(n, 9) ELSE @@ -372,90 +364,80 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 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 *) CASE class OF - OPM.Nproc: - OPC.Ident(n^.obj) - | OPM.Nvar: - OPC.CompleteIdent(n^.obj) - | OPM.Nvarpar: - 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(".") - END ; - OPC.Ident(n^.obj) - | OPM.Nderef: - IF n^.typ^.comp = OPM.DynArr THEN design(n^.left, 10); OPM.WriteString("->data") - ELSE OPM.Write(Deref); design(n^.left, designPrec) - END - | OPM.Nindex: - d := n^.left; - IF d^.typ^.comp = OPM.DynArr THEN dims := 0; - WHILE d^.class = OPM.Nindex DO d := d^.left; INC(dims) END ; - IF n^.typ^.comp = OPM.DynArr THEN OPM.Write("&") END ; - design(d, designPrec); - OPM.Write(OpenBracket); - IF n^.typ^.comp = OPM.DynArr THEN OPM.Write("(") END ; - i := dims; x := n; - WHILE x # d DO (* apply Horner schema *) - IF x^.left # d THEN Index(x, d, 7, i); OPM.WriteString(" + "); Len(d, i); OPM.WriteString(" * ("); DEC(i) - ELSE Index(x, d, MinPrec, i) - END ; - x := x^.left - END ; - FOR i := 1 TO dims DO OPM.Write(")") END ; - IF n^.typ^.comp = OPM.DynArr THEN - (* element type is OPM.DynArr; finish Horner schema with virtual indices = 0*) - OPM.Write(")"); - WHILE i < (d^.typ^.size - 4) DIV 4 DO - OPM.WriteString(" * "); Len(d, i); - INC(i) - END - END ; - OPM.Write(CloseBracket) - ELSE - design(n^.left, designPrec); - OPM.Write(OpenBracket); - Index(n, n^.left, MinPrec, 0); - OPM.Write(CloseBracket) - END - | OPM.Nguard: - typ := n^.typ; obj := n^.left^.obj; - IF OPM.typchk IN OPM.opt THEN - IF typ^.comp = OPM.Record THEN OPM.WriteString(GuardRecFunc); - IF obj^.mnolev # OPM.level THEN (*intermediate level var-par record*) - OPM.WriteStringVar(obj^.scope^.name); OPM.WriteString("__curr->"); OPC.Ident(obj) - ELSE (*local var-par record*) - OPC.Ident(obj) - END ; - ELSE (*Pointer*) - IF typ^.BaseTyp^.strobj = NIL THEN OPM.WriteString("__GUARDA(") ELSE OPM.WriteString(GuardPtrFunc) END ; - expr(n^.left, MinPrec); typ := typ^.BaseTyp - END ; - OPM.WriteString(Comma); - OPC.Andent(typ); OPM.WriteString(Comma); - OPM.WriteInt(typ^.extlev); OPM.Write(")") - ELSE - IF typ^.comp = OPM.Record THEN (* do not cast record directly, cast pointer to record *) - OPM.WriteString("*("); OPC.Ident(typ^.strobj); OPM.WriteString("*)"); OPC.CompleteIdent(obj) - ELSE (*simply cast pointer*) - OPM.Write("("); OPC.Ident(typ^.strobj); OPM.Write(")"); expr(n^.left, designPrec) - END - END - | OPM.Neguard: - IF OPM.typchk IN OPM.opt THEN - IF n^.left^.class = OPM.Nvarpar THEN OPM.WriteString("__GUARDEQR("); - OPC.CompleteIdent(n^.left^.obj); OPM.WriteString(Comma); TypeOf(n^.left); - ELSE OPM.WriteString("__GUARDEQP("); expr(n^.left^.left, MinPrec) - END ; (* __GUARDEQx includes deref *) - OPM.WriteString(Comma); OPC.Ident(n^.left^.typ^.strobj); OPM.Write(")") - ELSE - expr(n^.left, MinPrec) (* always lhs of assignment *) - END - | OPM.Nmop: - 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; + | OPM.Nproc: OPC.Ident(n^.obj) + | OPM.Nvar: OPC.CompleteIdent(n^.obj) + | OPM.Nvarpar: 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(".") + END ; + OPC.Ident(n^.obj) + | OPM.Nderef: IF n^.typ^.comp = OPM.DynArr THEN design(n^.left, 10); OPM.WriteString("->data") + ELSE OPM.Write(Deref); design(n^.left, designPrec) + END + | OPM.Nindex: d := n^.left; + IF d^.typ^.comp = OPM.DynArr THEN dims := 0; + WHILE d^.class = OPM.Nindex DO d := d^.left; INC(dims) END ; + IF n^.typ^.comp = OPM.DynArr THEN OPM.Write("&") END ; + design(d, designPrec); + OPM.Write(OpenBracket); + IF n^.typ^.comp = OPM.DynArr THEN OPM.Write("(") END ; + i := dims; x := n; + WHILE x # d DO (* apply Horner schema *) + IF x^.left # d THEN Index(x, d, 7, i); OPM.WriteString(" + "); Len(d, i); OPM.WriteString(" * ("); DEC(i) + ELSE Index(x, d, MinPrec, i) + END ; + x := x^.left + END ; + FOR i := 1 TO dims DO OPM.Write(")") END ; + IF n^.typ^.comp = OPM.DynArr THEN + (* element type is OPM.DynArr; finish Horner schema with virtual indices = 0*) + OPM.Write(")"); + WHILE i < (d^.typ^.size - 4) DIV 4 DO + OPM.WriteString(" * "); Len(d, i); + INC(i) + END + END ; + OPM.Write(CloseBracket) + ELSE + design(n^.left, designPrec); + OPM.Write(OpenBracket); + Index(n, n^.left, MinPrec, 0); + OPM.Write(CloseBracket) + END + | OPM.Nguard: typ := n^.typ; obj := n^.left^.obj; + IF OPM.typchk IN OPM.opt THEN + IF typ^.comp = OPM.Record THEN OPM.WriteString(GuardRecFunc); + IF obj^.mnolev # OPM.level THEN (*intermediate level var-par record*) + OPM.WriteStringVar(obj^.scope^.name); OPM.WriteString("__curr->"); OPC.Ident(obj) + ELSE (*local var-par record*) + OPC.Ident(obj) + END ; + ELSE (*Pointer*) + IF typ^.BaseTyp^.strobj = NIL THEN OPM.WriteString("__GUARDA(") ELSE OPM.WriteString(GuardPtrFunc) END ; + expr(n^.left, MinPrec); typ := typ^.BaseTyp + END ; + OPM.WriteString(Comma); + OPC.Andent(typ); OPM.WriteString(Comma); + OPM.WriteInt(typ^.extlev); OPM.Write(")") + ELSE + IF typ^.comp = OPM.Record THEN (* do not cast record directly, cast pointer to record *) + OPM.WriteString("*("); OPC.Ident(typ^.strobj); OPM.WriteString("*)"); OPC.CompleteIdent(obj) + ELSE (*simply cast pointer*) + OPM.Write("("); OPC.Ident(typ^.strobj); OPM.Write(")"); expr(n^.left, designPrec) + END + END + | OPM.Neguard: IF OPM.typchk IN OPM.opt THEN + IF n^.left^.class = OPM.Nvarpar THEN OPM.WriteString("__GUARDEQR("); + OPC.CompleteIdent(n^.left^.obj); OPM.WriteString(Comma); TypeOf(n^.left); + ELSE OPM.WriteString("__GUARDEQP("); expr(n^.left^.left, MinPrec) + END ; (* __GUARDEQx includes deref *) + OPM.WriteString(Comma); OPC.Ident(n^.left^.typ^.strobj); OPM.Write(")") + ELSE + expr(n^.left, MinPrec) (* always lhs of assignment *) + END + | OPM.Nmop: 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; END ; IF prec > designPrec THEN OPM.Write(CloseParen) END END design; @@ -484,8 +466,6 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 OPM.WriteString("(double)"); prec := 9 ELSIF (form = OPM.LInt) & (n^.typ^.form < OPM.LInt) THEN (* integral promotion *) OPM.WriteString("(LONGINT)"); prec := 9 - (*ELSIF (form = Int64) & (n^.typ^.form < Int64) THEN - OPM.WriteString("(SYSTEM_INT64)"); prec := 9;*) END END ELSIF ansi THEN @@ -551,187 +531,162 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 OPM.Write(OpenParen); END; CASE class OF - OPM.Nconst: - OPC.Constant(n^.conval, form) - | OPM.Nupto: (* n^.typ = OPT.settyp *) - OPM.WriteString(SetRangeFunc); expr(l, MinPrec); OPM.WriteString(Comma); expr (r, MinPrec); - OPM.Write(CloseParen) - | OPM.Nmop: - CASE subclass OF - OPM.not: - OPM.Write("!"); expr(l, exprPrec) - | OPM.minus: - IF form = OPM.Set THEN OPM.Write("~") ELSE OPM.Write("-"); END ; - expr(l, exprPrec) - | OPM.is: - typ := n^.obj^.typ; - IF l^.typ^.comp = OPM.Record THEN OPM.WriteString(IsFunc); OPC.TypeOf(l^.obj) - ELSE OPM.WriteString(IsPFunc); expr(l, MinPrec); typ := typ^.BaseTyp - END ; - OPM.WriteString(Comma); - OPC.Andent(typ); OPM.WriteString(Comma); - OPM.WriteInt(typ^.extlev); OPM.Write(")") - | OPM.conv: - Convert(l, form, exprPrec) - | OPM.abs: - IF SideEffects(l) THEN - IF l^.typ^.form < OPM.Real THEN - IF l^.typ^.form < OPM.LInt THEN OPM.WriteString("(int)") END ; - OPM.WriteString("__ABSF(") - ELSE OPM.WriteString("__ABSFD(") + | OPM.Nconst: OPC.Constant(n^.conval, form) + | OPM.Nupto: (* n^.typ = OPT.settyp *) + OPM.WriteString(SetRangeFunc); expr(l, MinPrec); OPM.WriteString(Comma); expr (r, MinPrec); + OPM.Write(CloseParen) + | OPM.Nmop: + CASE subclass OF + | OPM.not: OPM.Write("!"); expr(l, exprPrec) + | OPM.minus: IF form = OPM.Set THEN OPM.Write("~") ELSE OPM.Write("-") END; + expr(l, exprPrec) + | OPM.is: typ := n^.obj^.typ; + IF l^.typ^.comp = OPM.Record THEN OPM.WriteString(IsFunc); OPC.TypeOf(l^.obj) + ELSE OPM.WriteString(IsPFunc); expr(l, MinPrec); typ := typ^.BaseTyp + END ; + OPM.WriteString(Comma); + OPC.Andent(typ); OPM.WriteString(Comma); + OPM.WriteInt(typ^.extlev); OPM.Write(")") + | OPM.conv: Convert(l, form, exprPrec) + | OPM.abs: IF SideEffects(l) THEN + IF l^.typ^.form < OPM.Real THEN + IF l^.typ^.form < OPM.LInt THEN OPM.WriteString("(int)") END ; + OPM.WriteString("__ABSF(") + ELSE OPM.WriteString("__ABSFD(") + END + ELSE OPM.WriteString("__ABS(") + END ; + expr(l, MinPrec); OPM.Write(CloseParen) + | OPM.cap: OPM.WriteString("__CAP("); expr(l, MinPrec); OPM.Write(CloseParen) + | OPM.odd: OPM.WriteString("__ODD("); expr(l, MinPrec); OPM.Write(CloseParen) + | OPM.adr: OPM.WriteString("(LONGINT)(uintptr_t)"); (*SYSTEM*) + IF l^.class = OPM.Nvarpar THEN OPC.CompleteIdent(l^.obj) + ELSE + IF (l^.typ^.form # OPM.String) & ~(l^.typ^.comp IN {OPM.Array, OPM.DynArr}) THEN OPM.Write("&") END ; + expr(l, exprPrec) + END + | OPM.val: IF ~(l^.class IN {OPM.Nvar, OPM.Nvarpar, OPM.Nfield, OPM.Nindex}) (*SYSTEM*) + 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}) + & (n^.typ^.size = l^.typ^.size) + THEN + OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen); + IF (n^.typ^.form IN {OPM.Pointer, OPM.ProcTyp}) OR (l^.typ^.form IN {OPM.Pointer, OPM.ProcTyp}) THEN + OPM.WriteString("(uintptr_t)") + END; + expr(l, exprPrec) + ELSE + IF (n^.typ^.form IN {OPM.Pointer, OPM.ProcTyp}) OR (l^.typ^.form IN {OPM.Pointer, OPM.ProcTyp}) THEN + OPM.WriteString("__VALP("); + ELSE + OPM.WriteString("__VAL("); + END; + OPC.Ident(n^.typ^.strobj); OPM.WriteString(Comma); + expr(l, MinPrec); OPM.Write(CloseParen) + END + ELSE OPM.err(200) END - ELSE OPM.WriteString("__ABS(") - END ; - expr(l, MinPrec); OPM.Write(CloseParen) - | OPM.cap: - OPM.WriteString("__CAP("); expr(l, MinPrec); OPM.Write(CloseParen) - | OPM.odd: - 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) - ELSE - IF (l^.typ^.form # OPM.String) & ~(l^.typ^.comp IN {OPM.Array, OPM.DynArr}) THEN OPM.Write("&") END ; - expr(l, exprPrec) - END - | OPM.val: (*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}) - & (l^.typ^.form IN {OPM.LInt, OPM.Pointer, OPM.Set, OPM.ProcTyp}) - & (n^.typ^.size = l^.typ^.size) - THEN - OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen); - IF (n^.typ^.form IN {OPM.Pointer, OPM.ProcTyp}) OR (l^.typ^.form IN {OPM.Pointer, OPM.ProcTyp}) THEN - OPM.WriteString("(uintptr_t)") - END; - expr(l, exprPrec) - ELSE - IF (n^.typ^.form IN {OPM.Pointer, OPM.ProcTyp}) OR (l^.typ^.form IN {OPM.Pointer, OPM.ProcTyp}) THEN - OPM.WriteString("__VALP("); - ELSE - OPM.WriteString("__VAL("); - END; - OPC.Ident(n^.typ^.strobj); OPM.WriteString(Comma); - expr(l, MinPrec); OPM.Write(CloseParen) - END - ELSE OPM.err(200) - END - | OPM.Ndop: - CASE subclass OF - OPM.len: - Len(l, r^.conval^.intval) - | OPM.in, OPM.ash, OPM.msk, OPM.bit, OPM.lsh, OPM.rot, OPM.div, 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(") - ELSE OPM.WriteString("__ASHR(") - END - ELSIF SideEffects(r) THEN OPM.WriteString("__ASHF(") - ELSE OPM.WriteString("__ASH(") - END - | OPM.msk: - OPM.WriteString("__MASK("); - | OPM.bit: - OPM.WriteString("__BIT(") - | OPM.lsh: - IF r^.class = OPM.Nconst THEN - IF r^.conval^.intval >= 0 THEN OPM.WriteString("__LSHL(") - ELSE OPM.WriteString("__LSHR(") - END - ELSE OPM.WriteString("__LSH(") - END - | OPM.rot: - IF r^.class = OPM.Nconst THEN - IF r^.conval^.intval >= 0 THEN OPM.WriteString("__ROTL(") - ELSE OPM.WriteString("__ROTR(") - END - ELSE OPM.WriteString("__ROT(") - END - | OPM.div: - IF SideEffects(n) THEN - IF form < OPM.LInt THEN OPM.WriteString("(int)") END ; - OPM.WriteString("__DIVF(") - ELSE OPM.WriteString("__DIV(") - END - | OPM.mod: - IF form < OPM.LInt THEN OPM.WriteString("(int)") END ; - IF SideEffects(n) THEN OPM.WriteString("__MODF(") - ELSE OPM.WriteString("__MOD(") - END; - ELSE - OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; - END ; - expr(l, MinPrec); - OPM.WriteString(Comma); - IF (subclass IN {OPM.ash, OPM.lsh, OPM.rot}) & (r^.class = OPM.Nconst) & (r^.conval^.intval < 0) THEN - OPM.WriteInt(-r^.conval^.intval) - ELSE expr(r, MinPrec) - END ; - IF subclass IN {OPM.lsh, OPM.rot} THEN OPM.WriteString(Comma); OPC.Ident(l^.typ^.strobj) END ; - OPM.Write(CloseParen) - | OPM.eql .. OPM.geq: - IF l^.typ^.form IN {OPM.String, OPM.Comp} THEN - OPM.WriteString("__STRCMP("); - expr(l, MinPrec); OPM.WriteString(Comma); expr(r, MinPrec); OPM.Write(CloseParen); - OPC.Cmp(subclass); OPM.Write("0") - ELSE - expr(l, exprPrec); OPC.Cmp(subclass); - typ := l^.typ; - IF (typ^.form = OPM.Pointer) & (r^.typ.form # OPM.NilTyp) & (r^.typ # typ) & (r^.typ # OPT.sysptrtyp) THEN - OPM.WriteString("(void *) ") - END ; - expr(r, exprPrec) - END - 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 *) - expr(l, exprPrec); - CASE subclass OF - OPM.times: - IF form = OPM.Set THEN OPM.WriteString(" & ") - ELSE OPM.WriteString(" * ") + | OPM.Ndop: CASE subclass OF + | OPM.len: Len(l, r^.conval^.intval) + | OPM.in, + OPM.ash, + OPM.msk, + OPM.bit, + OPM.lsh, + OPM.rot, + OPM.div, + 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(") + ELSE OPM.WriteString("__ASHR(") + END + ELSIF SideEffects(r) THEN OPM.WriteString("__ASHF(") + ELSE OPM.WriteString("__ASH(") + END + | OPM.msk: OPM.WriteString("__MASK("); + | OPM.bit: OPM.WriteString("__BIT(") + | OPM.lsh: IF r^.class = OPM.Nconst THEN + IF r^.conval^.intval >= 0 THEN OPM.WriteString("__LSHL(") + ELSE OPM.WriteString("__LSHR(") + END + ELSE OPM.WriteString("__LSH(") + END + | OPM.rot: IF r^.class = OPM.Nconst THEN + IF r^.conval^.intval >= 0 THEN OPM.WriteString("__ROTL(") + ELSE OPM.WriteString("__ROTR(") + END + ELSE OPM.WriteString("__ROT(") + END + | OPM.div: IF SideEffects(n) THEN + IF form < OPM.LInt THEN OPM.WriteString("(int)") END ; + OPM.WriteString("__DIVF(") + ELSE OPM.WriteString("__DIV(") + END + | OPM.mod: IF form < OPM.LInt THEN OPM.WriteString("(int)") END ; + IF SideEffects(n) THEN OPM.WriteString("__MODF(") + ELSE OPM.WriteString("__MOD(") + END; + ELSE OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; + END ; + expr(l, MinPrec); + OPM.WriteString(Comma); + IF (subclass IN {OPM.ash, OPM.lsh, OPM.rot}) & (r^.class = OPM.Nconst) & (r^.conval^.intval < 0) THEN + OPM.WriteInt(-r^.conval^.intval) + ELSE expr(r, MinPrec) + END ; + IF subclass IN {OPM.lsh, OPM.rot} THEN OPM.WriteString(Comma); OPC.Ident(l^.typ^.strobj) END ; + OPM.Write(CloseParen) + | OPM.eql + .. OPM.geq: IF l^.typ^.form IN {OPM.String, OPM.Comp} THEN + OPM.WriteString("__STRCMP("); + expr(l, MinPrec); OPM.WriteString(Comma); expr(r, MinPrec); OPM.Write(CloseParen); + OPC.Cmp(subclass); OPM.Write("0") + ELSE + expr(l, exprPrec); OPC.Cmp(subclass); + typ := l^.typ; + IF (typ^.form = OPM.Pointer) & (r^.typ.form # OPM.NilTyp) & (r^.typ # typ) & (r^.typ # OPT.sysptrtyp) THEN + OPM.WriteString("(void *) ") + END ; + expr(r, exprPrec) + END + 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 *) + expr(l, exprPrec); + CASE subclass OF + | OPM.times: IF form = OPM.Set THEN OPM.WriteString(" & ") + ELSE OPM.WriteString(" * ") + END + | OPM.slash: IF form = OPM.Set THEN OPM.WriteString(" ^ ") + ELSE OPM.WriteString(" / "); + IF (r^.obj = NIL) OR (r^.obj^.typ^.form IN OPM.intSet) THEN + OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen) + END + END + | OPM.and: OPM.WriteString(" && ") + | OPM.plus: IF form = OPM.Set THEN OPM.WriteString(" | ") + ELSE OPM.WriteString(" + ") + END + | OPM.minus: IF form = OPM.Set THEN OPM.WriteString(" & ~") + ELSE OPM.WriteString(" - ") + END; + | OPM.or: OPM.WriteString(" || "); + ELSE OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; + END; + 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*) END - | OPM.slash: - IF form = OPM.Set THEN OPM.WriteString(" ^ ") - ELSE OPM.WriteString(" / "); - IF (r^.obj = NIL) OR (r^.obj^.typ^.form IN OPM.intSet) THEN - OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen) - END - END - | OPM.and: - OPM.WriteString(" && ") - | OPM.plus: - IF form = OPM.Set THEN OPM.WriteString(" | ") - ELSE OPM.WriteString(" + ") - END - | OPM.minus: - IF form = OPM.Set THEN OPM.WriteString(" & ~") - ELSE OPM.WriteString(" - ") - END; - | OPM.or: - OPM.WriteString(" || "); - ELSE - OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; - END; - 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*) - END - | OPM.Ncall: - IF (l^.obj # NIL) & (l^.obj^.mode = OPM.TProc) THEN - IF l^.subcl = OPM.super THEN proc := SuperProc(n) - ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(l^.obj) - END ; - OPC.Ident(proc); - n^.obj := proc^.link - ELSIF l^.class = OPM.Nproc THEN design(l, 10) - ELSE design(l, ProcTypeVar) - END ; - ActualPar(r, n^.obj) - ELSE - design(n, prec); (* not exprPrec! *) - END ; + | OPM.Ncall: IF (l^.obj # NIL) & (l^.obj^.mode = OPM.TProc) THEN + IF l^.subcl = OPM.super THEN proc := SuperProc(n) + ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(l^.obj) + END ; + OPC.Ident(proc); + n^.obj := proc^.link + ELSIF l^.class = OPM.Nproc THEN design(l, 10) + ELSE design(l, ProcTypeVar) + END ; + ActualPar(r, n^.obj) + ELSE design(n, prec); (* not exprPrec! *) + END; IF (exprPrec <= prec) & (class IN {OPM.Nconst, OPM.Nupto, OPM.Nmop, OPM.Ndop, OPM.Ncall, OPM.Nguard}) THEN OPM.Write(CloseParen) END @@ -863,161 +818,137 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 BEGIN WHILE (n # NIL) & OPM.noerr DO 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 - OPM.Nenter: - IF n^.obj = NIL THEN (* enter module *) - INC(OPM.level); stat(n^.left, outerProc); DEC(OPM.level); - OPC.GenEnumPtrs(OPT.topScope^.scope); - DefineTDescs(n^.right); OPC.EnterBody; InitTDescs(n^.right); - OPM.WriteString("/* BEGIN */"); OPM.WriteLn; - stat(n^.right, outerProc); OPC.ExitBody - ELSE (* enter proc *) - proc := n^.obj; - OPC.TypeDefs(proc^.scope^.right, 0); - IF ~proc^.scope^.leaf THEN OPC.DefineInter (proc) END ; (* define intermediate procedure scope *) - INC(OPM.level); stat(n^.left, proc); DEC(OPM.level); - OPC.EnterProc(proc); stat(n^.right, proc); - OPC.ExitProc(proc, TRUE, ImplicitReturn(n^.right)); - END - | OPM.Ninittd: (* done in enter module *) - | OPM.Nassign: - CASE n^.subcl OF - OPM.assign: - l := n^.left; r := n^.right; - IF l^.typ^.comp = OPM.Array THEN (* includes string assignment but not COPY *) - OPM.WriteString(MoveFunc); - expr(r, MinPrec); OPM.WriteString(Comma); expr(l, MinPrec); OPM.WriteString(Comma); - IF r^.typ = OPT.stringtyp THEN OPM.WriteInt(r^.conval^.intval2) - ELSE OPM.WriteInt(r^.typ^.size) - END ; - OPM.Write(CloseParen) - ELSE - IF (l^.typ^.form = OPM.Pointer) & (l^.obj # NIL) & (l^.obj^.adr = 1) & (l^.obj^.mode = OPM.Var) THEN - l^.obj^.adr := 0; design(l, MinPrec); l^.obj^.adr := 1; (* avoid cast of WITH-variable *) - IF r^.typ^.form # OPM.NilTyp THEN OPM.WriteString(" = (void*)") - ELSE OPM.WriteString(" = ") - END - ELSE - design(l, MinPrec); OPM.WriteString(" = ") - END ; - IF l^.typ = r^.typ THEN expr(r, MinPrec) - ELSIF (l^.typ^.form = OPM.Pointer) & (r^.typ^.form # OPM.NilTyp) & (l^.typ^.strobj # NIL) THEN - OPM.Write("("); OPC.Ident(l^.typ^.strobj); OPM.Write(")"); expr(r, MinPrec) - ELSIF l^.typ^.comp = OPM.Record THEN - OPM.WriteString("*("); OPC.Andent(l^.typ); OPM.WriteString("*)&"); expr(r, 9) - ELSE expr(r, MinPrec) - END - END - | OPM.newfn: - IF n^.left^.typ^.BaseTyp^.comp = OPM.Record THEN - OPM.WriteString("__NEW("); design(n^.left, MinPrec); OPM.WriteString(", "); - OPC.Andent(n^.left^.typ^.BaseTyp); OPM.WriteString(")") - ELSIF n^.left^.typ^.BaseTyp^.comp IN {OPM.Array, OPM.DynArr} THEN - NewArr(n^.left, n^.right) - END - | OPM.incfn, OPM.decfn: - expr(n^.left, MinPrec); OPC.Increment(n^.subcl = OPM.decfn); expr(n^.right, MinPrec) - | OPM.inclfn, OPM.exclfn: - expr(n^.left, MinPrec); OPC.SetInclude(n^.subcl = OPM.exclfn); OPM.WriteString(SetOfFunc); expr(n^.right, MinPrec); - OPM.Write(CloseParen) - | OPM.copyfn: - OPM.WriteString(CopyFunc); - expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(Comma); - Len(n^.left, 0); OPM.Write(CloseParen) - | (*SYSTEM*)OPM.movefn: - OPM.WriteString(MoveFunc); - expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(Comma); - expr(n^.right^.link, MinPrec); - OPM.Write(CloseParen) - | (*SYSTEM*)OPM.getfn: - 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) - | (*SYSTEM*)OPM.putfn: - 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) - | (*SYSTEM*)OPM.getrfn, OPM.putrfn: OPM.err(200) - | (*SYSTEM*)OPM.sysnewfn: - OPM.WriteString("__SYSNEW("); - design(n^.left, MinPrec); OPM.WriteString(", "); - expr(n^.right, MinPrec); - OPM.Write(")") - ELSE - OPM.LogWStr("unhandled case in OPV.expr, n^.subcl = "); OPM.LogWNum(n^.subcl, 0); OPM.LogWLn; - END - | OPM.Ncall: - IF (n^.left^.obj # NIL) & (n^.left^.obj^.mode = OPM.TProc) THEN - IF n^.left^.subcl = OPM.super THEN proc := SuperProc(n) - ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(n^.left^.obj) - END ; - OPC.Ident(proc); - n^.obj := proc^.link - ELSIF n^.left^.class = OPM.Nproc THEN design(n^.left, 10) - ELSE design(n^.left, ProcTypeVar) - END ; - ActualPar(n^.right, n^.obj) - | OPM.Nifelse: - 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); - OPM.WriteInt(n^.left^.right^.right^.conval^.intval); OPM.Write(CloseParen); OPC.EndStat - END - | OPM.Ncase: - INC(exit.level); CaseStat(n, outerProc); DEC(exit.level) - | OPM.Nwhile: - INC(exit.level); OPM.WriteString("while "); expr(n^.left, MaxPrec); - OPM.Write(Blank); OPC.BegBlk; stat(n^.right, outerProc); OPC.EndBlk; - DEC(exit.level) - | OPM.Nrepeat: - INC(exit.level); OPM.WriteString("do "); OPC.BegBlk; stat(n^.left, outerProc); OPC.EndBlk0; - OPM.WriteString(" while (!"); expr(n^.right, 9); OPM.Write(CloseParen); - DEC(exit.level) - | OPM.Nloop: - saved := exit; exit.level := 0; exit.label := -1; - OPM.WriteString("for (;;) "); OPC.BegBlk; stat(n^.left, outerProc); OPC.EndBlk; - IF exit.label # -1 THEN - OPC.BegStat; OPM.WriteString("exit__"); OPM.WriteInt(exit.label); OPM.Write(":"); OPC.EndStat - END ; - exit := saved - | OPM.Nexit: - IF exit.level = 0 THEN OPM.WriteString(Break) - ELSE - IF exit.label = -1 THEN exit.label := nofExitLabels; INC(nofExitLabels) END ; - OPM.WriteString("goto exit__"); OPM.WriteInt(exit.label) - END - | OPM.Nreturn: - IF OPM.level = 0 THEN - IF mainprog THEN OPM.WriteString("__FINI") ELSE OPM.WriteString("__ENDMOD") END - ELSE - IF n^.left # NIL THEN - (* Make local copy of result before ExitProc deletes dynamic vars *) - OPM.WriteString("_o_result = "); - IF (n^.left^.typ^.form = OPM.Pointer) & (n^.obj^.typ # n^.left^.typ) THEN - OPM.WriteString("(void*)"); expr(n^.left, 10) - ELSE - expr(n^.left, MinPrec) - END; - OPM.WriteString(";"); OPM.WriteLn; OPC.BegStat; - OPC.ExitProc(outerProc, FALSE, FALSE); - OPM.WriteString("return _o_result"); - ELSE - OPM.WriteString("return"); - END - END - | OPM.Nwith: - IfStat(n, n^.subcl = 0, outerProc) - | OPM.Ntrap: - 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 ; + | OPM.Nenter: IF n^.obj = NIL THEN (* enter module *) + INC(OPM.level); stat(n^.left, outerProc); DEC(OPM.level); + OPC.GenEnumPtrs(OPT.topScope^.scope); + DefineTDescs(n^.right); OPC.EnterBody; InitTDescs(n^.right); + OPM.WriteString("/* BEGIN */"); OPM.WriteLn; + stat(n^.right, outerProc); OPC.ExitBody + ELSE (* enter proc *) + proc := n^.obj; + OPC.TypeDefs(proc^.scope^.right, 0); + IF ~proc^.scope^.leaf THEN OPC.DefineInter (proc) END ; (* define intermediate procedure scope *) + INC(OPM.level); stat(n^.left, proc); DEC(OPM.level); + OPC.EnterProc(proc); stat(n^.right, proc); + OPC.ExitProc(proc, TRUE, ImplicitReturn(n^.right)); + END + | OPM.Ninittd: (* done in enter module *) + | OPM.Nassign: CASE n^.subcl OF + | OPM.assign: l := n^.left; r := n^.right; + IF l^.typ^.comp = OPM.Array THEN (* includes string assignment but not COPY *) + OPM.WriteString(MoveFunc); + expr(r, MinPrec); OPM.WriteString(Comma); expr(l, MinPrec); OPM.WriteString(Comma); + IF r^.typ = OPT.stringtyp THEN OPM.WriteInt(r^.conval^.intval2) + ELSE OPM.WriteInt(r^.typ^.size) + END ; + OPM.Write(CloseParen) + ELSE + IF (l^.typ^.form = OPM.Pointer) & (l^.obj # NIL) & (l^.obj^.adr = 1) & (l^.obj^.mode = OPM.Var) THEN + l^.obj^.adr := 0; design(l, MinPrec); l^.obj^.adr := 1; (* avoid cast of WITH-variable *) + IF r^.typ^.form # OPM.NilTyp THEN OPM.WriteString(" = (void*)") + ELSE OPM.WriteString(" = ") + END + ELSE + design(l, MinPrec); OPM.WriteString(" = ") + END ; + IF l^.typ = r^.typ THEN expr(r, MinPrec) + ELSIF (l^.typ^.form = OPM.Pointer) & (r^.typ^.form # OPM.NilTyp) & (l^.typ^.strobj # NIL) THEN + OPM.Write("("); OPC.Ident(l^.typ^.strobj); OPM.Write(")"); expr(r, MinPrec) + ELSIF l^.typ^.comp = OPM.Record THEN + OPM.WriteString("*("); OPC.Andent(l^.typ); OPM.WriteString("*)&"); expr(r, 9) + ELSE expr(r, MinPrec) + END + END + | OPM.newfn: IF n^.left^.typ^.BaseTyp^.comp = OPM.Record THEN + OPM.WriteString("__NEW("); design(n^.left, MinPrec); OPM.WriteString(", "); + OPC.Andent(n^.left^.typ^.BaseTyp); OPM.WriteString(")") + ELSIF n^.left^.typ^.BaseTyp^.comp IN {OPM.Array, OPM.DynArr} THEN + NewArr(n^.left, n^.right) + END + | OPM.incfn, + OPM.decfn: expr(n^.left, MinPrec); OPC.Increment(n^.subcl = OPM.decfn); expr(n^.right, MinPrec) + | OPM.inclfn, + OPM.exclfn: expr(n^.left, MinPrec); OPC.SetInclude(n^.subcl = OPM.exclfn); OPM.WriteString(SetOfFunc); expr(n^.right, MinPrec); + OPM.Write(CloseParen) + | OPM.copyfn: OPM.WriteString(CopyFunc); + expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(Comma); + Len(n^.left, 0); OPM.Write(CloseParen) + | OPM.movefn: (*SYSTEM*) + OPM.WriteString(MoveFunc); + expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(Comma); + expr(n^.right^.link, MinPrec); + OPM.Write(CloseParen) + | OPM.getfn: (*SYSTEM*) + 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.putfn: (*SYSTEM*) + 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.getrfn, (*SYSTEM*) + OPM.putrfn: (*SYSTEM*) OPM.err(200) + | OPM.sysnewfn: (*SYSTEM*) + OPM.WriteString("__SYSNEW("); + design(n^.left, MinPrec); OPM.WriteString(", "); + expr(n^.right, MinPrec); + OPM.Write(")") + ELSE OPM.LogWStr("unhandled case in OPV.expr, n^.subcl = "); OPM.LogWNum(n^.subcl, 0); OPM.LogWLn; + END + | OPM.Ncall: IF (n^.left^.obj # NIL) & (n^.left^.obj^.mode = OPM.TProc) THEN + IF n^.left^.subcl = OPM.super THEN proc := SuperProc(n) + ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(n^.left^.obj) + END ; + OPC.Ident(proc); + n^.obj := proc^.link + ELSIF n^.left^.class = OPM.Nproc THEN design(n^.left, 10) + ELSE design(n^.left, ProcTypeVar) + END ; + ActualPar(n^.right, n^.obj) + | OPM.Nifelse: 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); + OPM.WriteInt(n^.left^.right^.right^.conval^.intval); OPM.Write(CloseParen); OPC.EndStat + END + | OPM.Ncase: INC(exit.level); CaseStat(n, outerProc); DEC(exit.level) + | OPM.Nwhile: INC(exit.level); OPM.WriteString("while "); expr(n^.left, MaxPrec); + OPM.Write(Blank); OPC.BegBlk; stat(n^.right, outerProc); OPC.EndBlk; + DEC(exit.level) + | OPM.Nrepeat: INC(exit.level); OPM.WriteString("do "); OPC.BegBlk; stat(n^.left, outerProc); OPC.EndBlk0; + OPM.WriteString(" while (!"); expr(n^.right, 9); OPM.Write(CloseParen); + DEC(exit.level) + | OPM.Nloop: saved := exit; exit.level := 0; exit.label := -1; + OPM.WriteString("for (;;) "); OPC.BegBlk; stat(n^.left, outerProc); OPC.EndBlk; + IF exit.label # -1 THEN + OPC.BegStat; OPM.WriteString("exit__"); OPM.WriteInt(exit.label); OPM.Write(":"); OPC.EndStat + END ; + exit := saved + | OPM.Nexit: IF exit.level = 0 THEN OPM.WriteString(Break) + ELSE + IF exit.label = -1 THEN exit.label := nofExitLabels; INC(nofExitLabels) END ; + OPM.WriteString("goto exit__"); OPM.WriteInt(exit.label) + END + | OPM.Nreturn: IF OPM.level = 0 THEN + IF mainprog THEN OPM.WriteString("__FINI") ELSE OPM.WriteString("__ENDMOD") END + ELSE + IF n^.left # NIL THEN + (* Make local copy of result before ExitProc deletes dynamic vars *) + OPM.WriteString("_o_result = "); + IF (n^.left^.typ^.form = OPM.Pointer) & (n^.obj^.typ # n^.left^.typ) THEN + OPM.WriteString("(void*)"); expr(n^.left, 10) + ELSE + expr(n^.left, MinPrec) + END; + OPM.WriteString(";"); OPM.WriteLn; OPC.BegStat; + OPC.ExitProc(outerProc, FALSE, FALSE); + OPM.WriteString("return _o_result"); + ELSE + OPM.WriteString("return"); + END + END + | OPM.Nwith: IfStat(n, n^.subcl = 0, outerProc) + | OPM.Ntrap: OPC.Halt(n^.right^.conval^.intval) + ELSE OPM.LogWStr("unhandled case in OPV.expr, n^.class = "); OPM.LogWNum(n^.class, 0); OPM.LogWLn; + 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 END