diff --git a/bootstrap/unix-44/Compiler.c b/bootstrap/unix-44/Compiler.c index a3cc57ea..5eeecbcd 100644 --- a/bootstrap/unix-44/Compiler.c +++ b/bootstrap/unix-44/Compiler.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspamSf */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspamSf */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/Configuration.c b/bootstrap/unix-44/Configuration.c index 32d0b51f..8d939331 100644 --- a/bootstrap/unix-44/Configuration.c +++ b/bootstrap/unix-44/Configuration.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 @@ -19,6 +19,6 @@ export void *Configuration__init(void) __DEFMOD; __REGMOD("Configuration", 0); /* BEGIN */ - __MOVE("1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); + __MOVE("1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); __ENDMOD; } diff --git a/bootstrap/unix-44/Configuration.h b/bootstrap/unix-44/Configuration.h index db2b8c32..29896228 100644 --- a/bootstrap/unix-44/Configuration.h +++ b/bootstrap/unix-44/Configuration.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Configuration__h #define Configuration__h diff --git a/bootstrap/unix-44/Files.c b/bootstrap/unix-44/Files.c index 25192376..5ccc86c7 100644 --- a/bootstrap/unix-44/Files.c +++ b/bootstrap/unix-44/Files.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/Files.h b/bootstrap/unix-44/Files.h index 1a38cc40..4df07327 100644 --- a/bootstrap/unix-44/Files.h +++ b/bootstrap/unix-44/Files.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #ifndef Files__h #define Files__h diff --git a/bootstrap/unix-44/Heap.c b/bootstrap/unix-44/Heap.c index 9c9c2846..ed20badb 100644 --- a/bootstrap/unix-44/Heap.c +++ b/bootstrap/unix-44/Heap.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/Heap.h b/bootstrap/unix-44/Heap.h index d4afd6fe..15cedcc4 100644 --- a/bootstrap/unix-44/Heap.h +++ b/bootstrap/unix-44/Heap.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #ifndef Heap__h #define Heap__h diff --git a/bootstrap/unix-44/Modules.c b/bootstrap/unix-44/Modules.c index 9cfee5c9..352866db 100644 --- a/bootstrap/unix-44/Modules.c +++ b/bootstrap/unix-44/Modules.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/Modules.h b/bootstrap/unix-44/Modules.h index 4e105135..c6f0ec55 100644 --- a/bootstrap/unix-44/Modules.h +++ b/bootstrap/unix-44/Modules.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Modules__h #define Modules__h diff --git a/bootstrap/unix-44/OPB.c b/bootstrap/unix-44/OPB.c index ef3ea081..80807ca6 100644 --- a/bootstrap/unix-44/OPB.c +++ b/bootstrap/unix-44/OPB.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 @@ -1273,6 +1273,8 @@ void OPB_Op (int8 op, OPT_Node *x, OPT_Node y) case 7: if ((g == 7 && y->typ->size < z->typ->size)) { OPB_Convert(&y, z->typ); + } else if (g == 7) { + OPB_Convert(&z, y->typ); } else { OPB_err(100); } diff --git a/bootstrap/unix-44/OPB.h b/bootstrap/unix-44/OPB.h index 54e81677..7917b570 100644 --- a/bootstrap/unix-44/OPB.h +++ b/bootstrap/unix-44/OPB.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPB__h #define OPB__h diff --git a/bootstrap/unix-44/OPC.c b/bootstrap/unix-44/OPC.c index 6739a87e..fad4716b 100644 --- a/bootstrap/unix-44/OPC.c +++ b/bootstrap/unix-44/OPC.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/OPC.h b/bootstrap/unix-44/OPC.h index 32ec3b7f..6d64b896 100644 --- a/bootstrap/unix-44/OPC.h +++ b/bootstrap/unix-44/OPC.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPC__h #define OPC__h diff --git a/bootstrap/unix-44/OPM.c b/bootstrap/unix-44/OPM.c index 1ab50cf6..c2760a09 100644 --- a/bootstrap/unix-44/OPM.c +++ b/bootstrap/unix-44/OPM.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/OPM.h b/bootstrap/unix-44/OPM.h index 960bd0ba..b798756b 100644 --- a/bootstrap/unix-44/OPM.h +++ b/bootstrap/unix-44/OPM.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPM__h #define OPM__h diff --git a/bootstrap/unix-44/OPP.c b/bootstrap/unix-44/OPP.c index 3a1bf6f6..f691a0ee 100644 --- a/bootstrap/unix-44/OPP.c +++ b/bootstrap/unix-44/OPP.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/OPP.h b/bootstrap/unix-44/OPP.h index 8b28d78e..b466e3aa 100644 --- a/bootstrap/unix-44/OPP.h +++ b/bootstrap/unix-44/OPP.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPP__h #define OPP__h diff --git a/bootstrap/unix-44/OPS.c b/bootstrap/unix-44/OPS.c index 882c9331..bd835f8d 100644 --- a/bootstrap/unix-44/OPS.c +++ b/bootstrap/unix-44/OPS.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/OPS.h b/bootstrap/unix-44/OPS.h index 62dc025a..af7eca8a 100644 --- a/bootstrap/unix-44/OPS.h +++ b/bootstrap/unix-44/OPS.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #ifndef OPS__h #define OPS__h diff --git a/bootstrap/unix-44/OPT.c b/bootstrap/unix-44/OPT.c index 66d53030..3e713505 100644 --- a/bootstrap/unix-44/OPT.c +++ b/bootstrap/unix-44/OPT.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/OPT.h b/bootstrap/unix-44/OPT.h index 6f17b409..5fe4dd5c 100644 --- a/bootstrap/unix-44/OPT.h +++ b/bootstrap/unix-44/OPT.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPT__h #define OPT__h diff --git a/bootstrap/unix-44/OPV.c b/bootstrap/unix-44/OPV.c index ba7bab5f..ab191652 100644 --- a/bootstrap/unix-44/OPV.c +++ b/bootstrap/unix-44/OPV.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 @@ -41,7 +41,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x); static void OPV_ParIntLiteral (int64 n, int32 size); static int16 OPV_Precedence (int16 class, int16 subclass, int16 form, int16 comp); static BOOLEAN OPV_SideEffects (OPT_Node n); -static void OPV_SizeCast (int32 from, int32 to); +static void OPV_SizeCast (OPT_Node n, int32 to); static void OPV_Stamp (OPS_Name s); static OPT_Object OPV_SuperProc (OPT_Node n); static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported); @@ -380,12 +380,24 @@ static void OPV_Entier (OPT_Node n, int16 prec) } } -static void OPV_SizeCast (int32 from, int32 to) +static void OPV_SizeCast (OPT_Node n, int32 to) { - if ((from != to && (from > 4 || to != 4))) { - OPM_WriteString((CHAR*)"(int", 5); - OPM_WriteInt(__ASHL(to, 3)); - OPM_WriteString((CHAR*)")", 2); + if ((to < n->typ->size && __IN(2, OPM_Options, 32))) { + OPM_WriteString((CHAR*)"__SHORT", 8); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)", ", 3); + OPM_WriteInt(OPM_SignedMaximum(to) + 1); + OPM_Write(')'); + } else { + if ((n->typ->size != to && (n->typ->size > 4 || to != 4))) { + OPM_WriteString((CHAR*)"(int", 5); + OPM_WriteInt(__ASHL(to, 3)); + OPM_WriteString((CHAR*)")", 2); + } } } @@ -395,26 +407,19 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, int16 prec) from = n->typ->form; to = newtype->form; if (to == 7) { - OPM_WriteString((CHAR*)"__SETOF(", 9); - OPV_Entier(n, -1); - OPM_WriteString((CHAR*)",", 2); - OPM_WriteInt(__ASHL(newtype->size, 3)); - OPM_Write(')'); - } else if (to == 4) { - if ((newtype->size < n->typ->size && __IN(2, OPM_Options, 32))) { - OPM_WriteString((CHAR*)"__SHORT", 8); - if (OPV_SideEffects(n)) { - OPM_Write('F'); - } - OPM_Write('('); - OPV_Entier(n, -1); - OPM_WriteString((CHAR*)", ", 3); - OPM_WriteInt(OPM_SignedMaximum(newtype->size) + 1); - OPM_Write(')'); - } else { - OPV_SizeCast(n->typ->size, newtype->size); + if (from == 7) { + OPV_SizeCast(n, newtype->size); OPV_Entier(n, 9); + } else { + OPM_WriteString((CHAR*)"__SETOF(", 9); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)",", 2); + OPM_WriteInt(__ASHL(newtype->size, 3)); + OPM_Write(')'); } + } else if (to == 4) { + OPV_SizeCast(n, newtype->size); + OPV_Entier(n, 9); } else if (to == 3) { if (__IN(2, OPM_Options, 32)) { OPM_WriteString((CHAR*)"__CHR", 6); diff --git a/bootstrap/unix-44/OPV.h b/bootstrap/unix-44/OPV.h index 30c2c7e7..49c91eed 100644 --- a/bootstrap/unix-44/OPV.h +++ b/bootstrap/unix-44/OPV.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPV__h #define OPV__h diff --git a/bootstrap/unix-44/Out.c b/bootstrap/unix-44/Out.c index a99d3410..c278b7af 100644 --- a/bootstrap/unix-44/Out.c +++ b/bootstrap/unix-44/Out.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/Out.h b/bootstrap/unix-44/Out.h index 6717f71b..72b7e0cb 100644 --- a/bootstrap/unix-44/Out.h +++ b/bootstrap/unix-44/Out.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #ifndef Out__h #define Out__h diff --git a/bootstrap/unix-44/Platform.c b/bootstrap/unix-44/Platform.c index addd94c0..16672654 100644 --- a/bootstrap/unix-44/Platform.c +++ b/bootstrap/unix-44/Platform.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/Platform.h b/bootstrap/unix-44/Platform.h index 18008f62..d4fe9c38 100644 --- a/bootstrap/unix-44/Platform.h +++ b/bootstrap/unix-44/Platform.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Platform__h #define Platform__h diff --git a/bootstrap/unix-44/Reals.c b/bootstrap/unix-44/Reals.c index f173fc32..97923f8d 100644 --- a/bootstrap/unix-44/Reals.c +++ b/bootstrap/unix-44/Reals.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/Reals.h b/bootstrap/unix-44/Reals.h index 98443ee2..24d6197a 100644 --- a/bootstrap/unix-44/Reals.h +++ b/bootstrap/unix-44/Reals.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Reals__h #define Reals__h diff --git a/bootstrap/unix-44/Strings.c b/bootstrap/unix-44/Strings.c index accc2e6a..afd5e004 100644 --- a/bootstrap/unix-44/Strings.c +++ b/bootstrap/unix-44/Strings.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/Strings.h b/bootstrap/unix-44/Strings.h index 9ebac10a..ce00b00c 100644 --- a/bootstrap/unix-44/Strings.h +++ b/bootstrap/unix-44/Strings.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Strings__h #define Strings__h diff --git a/bootstrap/unix-44/Texts.c b/bootstrap/unix-44/Texts.c index ac457f52..9b65a9b8 100644 --- a/bootstrap/unix-44/Texts.c +++ b/bootstrap/unix-44/Texts.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/Texts.h b/bootstrap/unix-44/Texts.h index 80ab5a77..bf82f949 100644 --- a/bootstrap/unix-44/Texts.h +++ b/bootstrap/unix-44/Texts.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Texts__h #define Texts__h diff --git a/bootstrap/unix-44/errors.c b/bootstrap/unix-44/errors.c index b071c3a8..d35766eb 100644 --- a/bootstrap/unix-44/errors.c +++ b/bootstrap/unix-44/errors.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/errors.h b/bootstrap/unix-44/errors.h index 1560dc0d..6adfb219 100644 --- a/bootstrap/unix-44/errors.h +++ b/bootstrap/unix-44/errors.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef errors__h #define errors__h diff --git a/bootstrap/unix-44/extTools.c b/bootstrap/unix-44/extTools.c index f6b467bb..5f5a39b3 100644 --- a/bootstrap/unix-44/extTools.c +++ b/bootstrap/unix-44/extTools.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/extTools.h b/bootstrap/unix-44/extTools.h index ab7785db..57da5b24 100644 --- a/bootstrap/unix-44/extTools.h +++ b/bootstrap/unix-44/extTools.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef extTools__h #define extTools__h diff --git a/bootstrap/unix-44/vt100.c b/bootstrap/unix-44/vt100.c index 23b25f53..61383b15 100644 --- a/bootstrap/unix-44/vt100.c +++ b/bootstrap/unix-44/vt100.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-44/vt100.h b/bootstrap/unix-44/vt100.h index 95c8d77e..511c4d6b 100644 --- a/bootstrap/unix-44/vt100.h +++ b/bootstrap/unix-44/vt100.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef vt100__h #define vt100__h diff --git a/bootstrap/unix-48/Compiler.c b/bootstrap/unix-48/Compiler.c index a3cc57ea..5eeecbcd 100644 --- a/bootstrap/unix-48/Compiler.c +++ b/bootstrap/unix-48/Compiler.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspamSf */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspamSf */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/Configuration.c b/bootstrap/unix-48/Configuration.c index 32d0b51f..8d939331 100644 --- a/bootstrap/unix-48/Configuration.c +++ b/bootstrap/unix-48/Configuration.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 @@ -19,6 +19,6 @@ export void *Configuration__init(void) __DEFMOD; __REGMOD("Configuration", 0); /* BEGIN */ - __MOVE("1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); + __MOVE("1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); __ENDMOD; } diff --git a/bootstrap/unix-48/Configuration.h b/bootstrap/unix-48/Configuration.h index db2b8c32..29896228 100644 --- a/bootstrap/unix-48/Configuration.h +++ b/bootstrap/unix-48/Configuration.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Configuration__h #define Configuration__h diff --git a/bootstrap/unix-48/Files.c b/bootstrap/unix-48/Files.c index 25192376..5ccc86c7 100644 --- a/bootstrap/unix-48/Files.c +++ b/bootstrap/unix-48/Files.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/Files.h b/bootstrap/unix-48/Files.h index 1a38cc40..4df07327 100644 --- a/bootstrap/unix-48/Files.h +++ b/bootstrap/unix-48/Files.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #ifndef Files__h #define Files__h diff --git a/bootstrap/unix-48/Heap.c b/bootstrap/unix-48/Heap.c index 9c9c2846..ed20badb 100644 --- a/bootstrap/unix-48/Heap.c +++ b/bootstrap/unix-48/Heap.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/Heap.h b/bootstrap/unix-48/Heap.h index d4afd6fe..15cedcc4 100644 --- a/bootstrap/unix-48/Heap.h +++ b/bootstrap/unix-48/Heap.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #ifndef Heap__h #define Heap__h diff --git a/bootstrap/unix-48/Modules.c b/bootstrap/unix-48/Modules.c index 9cfee5c9..352866db 100644 --- a/bootstrap/unix-48/Modules.c +++ b/bootstrap/unix-48/Modules.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/Modules.h b/bootstrap/unix-48/Modules.h index 4e105135..c6f0ec55 100644 --- a/bootstrap/unix-48/Modules.h +++ b/bootstrap/unix-48/Modules.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Modules__h #define Modules__h diff --git a/bootstrap/unix-48/OPB.c b/bootstrap/unix-48/OPB.c index ef3ea081..80807ca6 100644 --- a/bootstrap/unix-48/OPB.c +++ b/bootstrap/unix-48/OPB.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 @@ -1273,6 +1273,8 @@ void OPB_Op (int8 op, OPT_Node *x, OPT_Node y) case 7: if ((g == 7 && y->typ->size < z->typ->size)) { OPB_Convert(&y, z->typ); + } else if (g == 7) { + OPB_Convert(&z, y->typ); } else { OPB_err(100); } diff --git a/bootstrap/unix-48/OPB.h b/bootstrap/unix-48/OPB.h index 54e81677..7917b570 100644 --- a/bootstrap/unix-48/OPB.h +++ b/bootstrap/unix-48/OPB.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPB__h #define OPB__h diff --git a/bootstrap/unix-48/OPC.c b/bootstrap/unix-48/OPC.c index 6739a87e..fad4716b 100644 --- a/bootstrap/unix-48/OPC.c +++ b/bootstrap/unix-48/OPC.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/OPC.h b/bootstrap/unix-48/OPC.h index 32ec3b7f..6d64b896 100644 --- a/bootstrap/unix-48/OPC.h +++ b/bootstrap/unix-48/OPC.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPC__h #define OPC__h diff --git a/bootstrap/unix-48/OPM.c b/bootstrap/unix-48/OPM.c index 1ab50cf6..c2760a09 100644 --- a/bootstrap/unix-48/OPM.c +++ b/bootstrap/unix-48/OPM.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/OPM.h b/bootstrap/unix-48/OPM.h index 960bd0ba..b798756b 100644 --- a/bootstrap/unix-48/OPM.h +++ b/bootstrap/unix-48/OPM.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPM__h #define OPM__h diff --git a/bootstrap/unix-48/OPP.c b/bootstrap/unix-48/OPP.c index 3a1bf6f6..f691a0ee 100644 --- a/bootstrap/unix-48/OPP.c +++ b/bootstrap/unix-48/OPP.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/OPP.h b/bootstrap/unix-48/OPP.h index 8b28d78e..b466e3aa 100644 --- a/bootstrap/unix-48/OPP.h +++ b/bootstrap/unix-48/OPP.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPP__h #define OPP__h diff --git a/bootstrap/unix-48/OPS.c b/bootstrap/unix-48/OPS.c index 882c9331..bd835f8d 100644 --- a/bootstrap/unix-48/OPS.c +++ b/bootstrap/unix-48/OPS.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/OPS.h b/bootstrap/unix-48/OPS.h index 62dc025a..af7eca8a 100644 --- a/bootstrap/unix-48/OPS.h +++ b/bootstrap/unix-48/OPS.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #ifndef OPS__h #define OPS__h diff --git a/bootstrap/unix-48/OPT.c b/bootstrap/unix-48/OPT.c index a23ac389..bd0b6935 100644 --- a/bootstrap/unix-48/OPT.c +++ b/bootstrap/unix-48/OPT.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/OPT.h b/bootstrap/unix-48/OPT.h index 6f17b409..5fe4dd5c 100644 --- a/bootstrap/unix-48/OPT.h +++ b/bootstrap/unix-48/OPT.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPT__h #define OPT__h diff --git a/bootstrap/unix-48/OPV.c b/bootstrap/unix-48/OPV.c index ba7bab5f..ab191652 100644 --- a/bootstrap/unix-48/OPV.c +++ b/bootstrap/unix-48/OPV.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 @@ -41,7 +41,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x); static void OPV_ParIntLiteral (int64 n, int32 size); static int16 OPV_Precedence (int16 class, int16 subclass, int16 form, int16 comp); static BOOLEAN OPV_SideEffects (OPT_Node n); -static void OPV_SizeCast (int32 from, int32 to); +static void OPV_SizeCast (OPT_Node n, int32 to); static void OPV_Stamp (OPS_Name s); static OPT_Object OPV_SuperProc (OPT_Node n); static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported); @@ -380,12 +380,24 @@ static void OPV_Entier (OPT_Node n, int16 prec) } } -static void OPV_SizeCast (int32 from, int32 to) +static void OPV_SizeCast (OPT_Node n, int32 to) { - if ((from != to && (from > 4 || to != 4))) { - OPM_WriteString((CHAR*)"(int", 5); - OPM_WriteInt(__ASHL(to, 3)); - OPM_WriteString((CHAR*)")", 2); + if ((to < n->typ->size && __IN(2, OPM_Options, 32))) { + OPM_WriteString((CHAR*)"__SHORT", 8); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)", ", 3); + OPM_WriteInt(OPM_SignedMaximum(to) + 1); + OPM_Write(')'); + } else { + if ((n->typ->size != to && (n->typ->size > 4 || to != 4))) { + OPM_WriteString((CHAR*)"(int", 5); + OPM_WriteInt(__ASHL(to, 3)); + OPM_WriteString((CHAR*)")", 2); + } } } @@ -395,26 +407,19 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, int16 prec) from = n->typ->form; to = newtype->form; if (to == 7) { - OPM_WriteString((CHAR*)"__SETOF(", 9); - OPV_Entier(n, -1); - OPM_WriteString((CHAR*)",", 2); - OPM_WriteInt(__ASHL(newtype->size, 3)); - OPM_Write(')'); - } else if (to == 4) { - if ((newtype->size < n->typ->size && __IN(2, OPM_Options, 32))) { - OPM_WriteString((CHAR*)"__SHORT", 8); - if (OPV_SideEffects(n)) { - OPM_Write('F'); - } - OPM_Write('('); - OPV_Entier(n, -1); - OPM_WriteString((CHAR*)", ", 3); - OPM_WriteInt(OPM_SignedMaximum(newtype->size) + 1); - OPM_Write(')'); - } else { - OPV_SizeCast(n->typ->size, newtype->size); + if (from == 7) { + OPV_SizeCast(n, newtype->size); OPV_Entier(n, 9); + } else { + OPM_WriteString((CHAR*)"__SETOF(", 9); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)",", 2); + OPM_WriteInt(__ASHL(newtype->size, 3)); + OPM_Write(')'); } + } else if (to == 4) { + OPV_SizeCast(n, newtype->size); + OPV_Entier(n, 9); } else if (to == 3) { if (__IN(2, OPM_Options, 32)) { OPM_WriteString((CHAR*)"__CHR", 6); diff --git a/bootstrap/unix-48/OPV.h b/bootstrap/unix-48/OPV.h index 30c2c7e7..49c91eed 100644 --- a/bootstrap/unix-48/OPV.h +++ b/bootstrap/unix-48/OPV.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPV__h #define OPV__h diff --git a/bootstrap/unix-48/Out.c b/bootstrap/unix-48/Out.c index a99d3410..c278b7af 100644 --- a/bootstrap/unix-48/Out.c +++ b/bootstrap/unix-48/Out.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/Out.h b/bootstrap/unix-48/Out.h index 6717f71b..72b7e0cb 100644 --- a/bootstrap/unix-48/Out.h +++ b/bootstrap/unix-48/Out.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #ifndef Out__h #define Out__h diff --git a/bootstrap/unix-48/Platform.c b/bootstrap/unix-48/Platform.c index addd94c0..16672654 100644 --- a/bootstrap/unix-48/Platform.c +++ b/bootstrap/unix-48/Platform.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/Platform.h b/bootstrap/unix-48/Platform.h index 18008f62..d4fe9c38 100644 --- a/bootstrap/unix-48/Platform.h +++ b/bootstrap/unix-48/Platform.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Platform__h #define Platform__h diff --git a/bootstrap/unix-48/Reals.c b/bootstrap/unix-48/Reals.c index f173fc32..97923f8d 100644 --- a/bootstrap/unix-48/Reals.c +++ b/bootstrap/unix-48/Reals.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/Reals.h b/bootstrap/unix-48/Reals.h index 98443ee2..24d6197a 100644 --- a/bootstrap/unix-48/Reals.h +++ b/bootstrap/unix-48/Reals.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Reals__h #define Reals__h diff --git a/bootstrap/unix-48/Strings.c b/bootstrap/unix-48/Strings.c index accc2e6a..afd5e004 100644 --- a/bootstrap/unix-48/Strings.c +++ b/bootstrap/unix-48/Strings.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/Strings.h b/bootstrap/unix-48/Strings.h index 9ebac10a..ce00b00c 100644 --- a/bootstrap/unix-48/Strings.h +++ b/bootstrap/unix-48/Strings.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Strings__h #define Strings__h diff --git a/bootstrap/unix-48/Texts.c b/bootstrap/unix-48/Texts.c index 8fd544dc..f656fcc8 100644 --- a/bootstrap/unix-48/Texts.c +++ b/bootstrap/unix-48/Texts.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/Texts.h b/bootstrap/unix-48/Texts.h index 3d119274..6feea28a 100644 --- a/bootstrap/unix-48/Texts.h +++ b/bootstrap/unix-48/Texts.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Texts__h #define Texts__h diff --git a/bootstrap/unix-48/errors.c b/bootstrap/unix-48/errors.c index b071c3a8..d35766eb 100644 --- a/bootstrap/unix-48/errors.c +++ b/bootstrap/unix-48/errors.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/errors.h b/bootstrap/unix-48/errors.h index 1560dc0d..6adfb219 100644 --- a/bootstrap/unix-48/errors.h +++ b/bootstrap/unix-48/errors.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef errors__h #define errors__h diff --git a/bootstrap/unix-48/extTools.c b/bootstrap/unix-48/extTools.c index f6b467bb..5f5a39b3 100644 --- a/bootstrap/unix-48/extTools.c +++ b/bootstrap/unix-48/extTools.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/extTools.h b/bootstrap/unix-48/extTools.h index ab7785db..57da5b24 100644 --- a/bootstrap/unix-48/extTools.h +++ b/bootstrap/unix-48/extTools.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef extTools__h #define extTools__h diff --git a/bootstrap/unix-48/vt100.c b/bootstrap/unix-48/vt100.c index 23b25f53..61383b15 100644 --- a/bootstrap/unix-48/vt100.c +++ b/bootstrap/unix-48/vt100.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-48/vt100.h b/bootstrap/unix-48/vt100.h index 95c8d77e..511c4d6b 100644 --- a/bootstrap/unix-48/vt100.h +++ b/bootstrap/unix-48/vt100.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef vt100__h #define vt100__h diff --git a/bootstrap/unix-88/Compiler.c b/bootstrap/unix-88/Compiler.c index a3cc57ea..5eeecbcd 100644 --- a/bootstrap/unix-88/Compiler.c +++ b/bootstrap/unix-88/Compiler.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspamSf */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspamSf */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/Configuration.c b/bootstrap/unix-88/Configuration.c index 32d0b51f..8d939331 100644 --- a/bootstrap/unix-88/Configuration.c +++ b/bootstrap/unix-88/Configuration.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 @@ -19,6 +19,6 @@ export void *Configuration__init(void) __DEFMOD; __REGMOD("Configuration", 0); /* BEGIN */ - __MOVE("1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); + __MOVE("1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); __ENDMOD; } diff --git a/bootstrap/unix-88/Configuration.h b/bootstrap/unix-88/Configuration.h index db2b8c32..29896228 100644 --- a/bootstrap/unix-88/Configuration.h +++ b/bootstrap/unix-88/Configuration.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Configuration__h #define Configuration__h diff --git a/bootstrap/unix-88/Files.c b/bootstrap/unix-88/Files.c index 010c9d80..980cd0fc 100644 --- a/bootstrap/unix-88/Files.c +++ b/bootstrap/unix-88/Files.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/Files.h b/bootstrap/unix-88/Files.h index 87c48fa5..fefffb47 100644 --- a/bootstrap/unix-88/Files.h +++ b/bootstrap/unix-88/Files.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #ifndef Files__h #define Files__h diff --git a/bootstrap/unix-88/Heap.c b/bootstrap/unix-88/Heap.c index 6ab9f1ca..2dd37317 100644 --- a/bootstrap/unix-88/Heap.c +++ b/bootstrap/unix-88/Heap.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/Heap.h b/bootstrap/unix-88/Heap.h index b183ffa4..dc9db0d8 100644 --- a/bootstrap/unix-88/Heap.h +++ b/bootstrap/unix-88/Heap.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #ifndef Heap__h #define Heap__h diff --git a/bootstrap/unix-88/Modules.c b/bootstrap/unix-88/Modules.c index dab15898..57b8190a 100644 --- a/bootstrap/unix-88/Modules.c +++ b/bootstrap/unix-88/Modules.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/Modules.h b/bootstrap/unix-88/Modules.h index 4e105135..c6f0ec55 100644 --- a/bootstrap/unix-88/Modules.h +++ b/bootstrap/unix-88/Modules.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Modules__h #define Modules__h diff --git a/bootstrap/unix-88/OPB.c b/bootstrap/unix-88/OPB.c index ef3ea081..80807ca6 100644 --- a/bootstrap/unix-88/OPB.c +++ b/bootstrap/unix-88/OPB.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 @@ -1273,6 +1273,8 @@ void OPB_Op (int8 op, OPT_Node *x, OPT_Node y) case 7: if ((g == 7 && y->typ->size < z->typ->size)) { OPB_Convert(&y, z->typ); + } else if (g == 7) { + OPB_Convert(&z, y->typ); } else { OPB_err(100); } diff --git a/bootstrap/unix-88/OPB.h b/bootstrap/unix-88/OPB.h index 54e81677..7917b570 100644 --- a/bootstrap/unix-88/OPB.h +++ b/bootstrap/unix-88/OPB.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPB__h #define OPB__h diff --git a/bootstrap/unix-88/OPC.c b/bootstrap/unix-88/OPC.c index 6739a87e..fad4716b 100644 --- a/bootstrap/unix-88/OPC.c +++ b/bootstrap/unix-88/OPC.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/OPC.h b/bootstrap/unix-88/OPC.h index 32ec3b7f..6d64b896 100644 --- a/bootstrap/unix-88/OPC.h +++ b/bootstrap/unix-88/OPC.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPC__h #define OPC__h diff --git a/bootstrap/unix-88/OPM.c b/bootstrap/unix-88/OPM.c index 732baf46..bc0b1d98 100644 --- a/bootstrap/unix-88/OPM.c +++ b/bootstrap/unix-88/OPM.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/OPM.h b/bootstrap/unix-88/OPM.h index 960bd0ba..b798756b 100644 --- a/bootstrap/unix-88/OPM.h +++ b/bootstrap/unix-88/OPM.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPM__h #define OPM__h diff --git a/bootstrap/unix-88/OPP.c b/bootstrap/unix-88/OPP.c index bf1c6c9b..643f8fc5 100644 --- a/bootstrap/unix-88/OPP.c +++ b/bootstrap/unix-88/OPP.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/OPP.h b/bootstrap/unix-88/OPP.h index 8b28d78e..b466e3aa 100644 --- a/bootstrap/unix-88/OPP.h +++ b/bootstrap/unix-88/OPP.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPP__h #define OPP__h diff --git a/bootstrap/unix-88/OPS.c b/bootstrap/unix-88/OPS.c index 882c9331..bd835f8d 100644 --- a/bootstrap/unix-88/OPS.c +++ b/bootstrap/unix-88/OPS.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/OPS.h b/bootstrap/unix-88/OPS.h index 62dc025a..af7eca8a 100644 --- a/bootstrap/unix-88/OPS.h +++ b/bootstrap/unix-88/OPS.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #ifndef OPS__h #define OPS__h diff --git a/bootstrap/unix-88/OPT.c b/bootstrap/unix-88/OPT.c index 186ab7e3..a8d1a2b2 100644 --- a/bootstrap/unix-88/OPT.c +++ b/bootstrap/unix-88/OPT.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/OPT.h b/bootstrap/unix-88/OPT.h index 6f17b409..5fe4dd5c 100644 --- a/bootstrap/unix-88/OPT.h +++ b/bootstrap/unix-88/OPT.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPT__h #define OPT__h diff --git a/bootstrap/unix-88/OPV.c b/bootstrap/unix-88/OPV.c index f566e592..5004eab0 100644 --- a/bootstrap/unix-88/OPV.c +++ b/bootstrap/unix-88/OPV.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 @@ -41,7 +41,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x); static void OPV_ParIntLiteral (int64 n, int32 size); static int16 OPV_Precedence (int16 class, int16 subclass, int16 form, int16 comp); static BOOLEAN OPV_SideEffects (OPT_Node n); -static void OPV_SizeCast (int32 from, int32 to); +static void OPV_SizeCast (OPT_Node n, int32 to); static void OPV_Stamp (OPS_Name s); static OPT_Object OPV_SuperProc (OPT_Node n); static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported); @@ -380,12 +380,24 @@ static void OPV_Entier (OPT_Node n, int16 prec) } } -static void OPV_SizeCast (int32 from, int32 to) +static void OPV_SizeCast (OPT_Node n, int32 to) { - if ((from != to && (from > 4 || to != 4))) { - OPM_WriteString((CHAR*)"(int", 5); - OPM_WriteInt(__ASHL(to, 3)); - OPM_WriteString((CHAR*)")", 2); + if ((to < n->typ->size && __IN(2, OPM_Options, 32))) { + OPM_WriteString((CHAR*)"__SHORT", 8); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)", ", 3); + OPM_WriteInt(OPM_SignedMaximum(to) + 1); + OPM_Write(')'); + } else { + if ((n->typ->size != to && (n->typ->size > 4 || to != 4))) { + OPM_WriteString((CHAR*)"(int", 5); + OPM_WriteInt(__ASHL(to, 3)); + OPM_WriteString((CHAR*)")", 2); + } } } @@ -395,26 +407,19 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, int16 prec) from = n->typ->form; to = newtype->form; if (to == 7) { - OPM_WriteString((CHAR*)"__SETOF(", 9); - OPV_Entier(n, -1); - OPM_WriteString((CHAR*)",", 2); - OPM_WriteInt(__ASHL(newtype->size, 3)); - OPM_Write(')'); - } else if (to == 4) { - if ((newtype->size < n->typ->size && __IN(2, OPM_Options, 32))) { - OPM_WriteString((CHAR*)"__SHORT", 8); - if (OPV_SideEffects(n)) { - OPM_Write('F'); - } - OPM_Write('('); - OPV_Entier(n, -1); - OPM_WriteString((CHAR*)", ", 3); - OPM_WriteInt(OPM_SignedMaximum(newtype->size) + 1); - OPM_Write(')'); - } else { - OPV_SizeCast(n->typ->size, newtype->size); + if (from == 7) { + OPV_SizeCast(n, newtype->size); OPV_Entier(n, 9); + } else { + OPM_WriteString((CHAR*)"__SETOF(", 9); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)",", 2); + OPM_WriteInt(__ASHL(newtype->size, 3)); + OPM_Write(')'); } + } else if (to == 4) { + OPV_SizeCast(n, newtype->size); + OPV_Entier(n, 9); } else if (to == 3) { if (__IN(2, OPM_Options, 32)) { OPM_WriteString((CHAR*)"__CHR", 6); diff --git a/bootstrap/unix-88/OPV.h b/bootstrap/unix-88/OPV.h index 30c2c7e7..49c91eed 100644 --- a/bootstrap/unix-88/OPV.h +++ b/bootstrap/unix-88/OPV.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPV__h #define OPV__h diff --git a/bootstrap/unix-88/Out.c b/bootstrap/unix-88/Out.c index a99d3410..c278b7af 100644 --- a/bootstrap/unix-88/Out.c +++ b/bootstrap/unix-88/Out.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/Out.h b/bootstrap/unix-88/Out.h index 6717f71b..72b7e0cb 100644 --- a/bootstrap/unix-88/Out.h +++ b/bootstrap/unix-88/Out.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #ifndef Out__h #define Out__h diff --git a/bootstrap/unix-88/Platform.c b/bootstrap/unix-88/Platform.c index b648dbcc..f677d8cf 100644 --- a/bootstrap/unix-88/Platform.c +++ b/bootstrap/unix-88/Platform.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/Platform.h b/bootstrap/unix-88/Platform.h index c74c7031..14ebab63 100644 --- a/bootstrap/unix-88/Platform.h +++ b/bootstrap/unix-88/Platform.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Platform__h #define Platform__h diff --git a/bootstrap/unix-88/Reals.c b/bootstrap/unix-88/Reals.c index f173fc32..97923f8d 100644 --- a/bootstrap/unix-88/Reals.c +++ b/bootstrap/unix-88/Reals.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/Reals.h b/bootstrap/unix-88/Reals.h index 98443ee2..24d6197a 100644 --- a/bootstrap/unix-88/Reals.h +++ b/bootstrap/unix-88/Reals.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Reals__h #define Reals__h diff --git a/bootstrap/unix-88/Strings.c b/bootstrap/unix-88/Strings.c index accc2e6a..afd5e004 100644 --- a/bootstrap/unix-88/Strings.c +++ b/bootstrap/unix-88/Strings.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/Strings.h b/bootstrap/unix-88/Strings.h index 9ebac10a..ce00b00c 100644 --- a/bootstrap/unix-88/Strings.h +++ b/bootstrap/unix-88/Strings.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Strings__h #define Strings__h diff --git a/bootstrap/unix-88/Texts.c b/bootstrap/unix-88/Texts.c index 369dceed..97cfe790 100644 --- a/bootstrap/unix-88/Texts.c +++ b/bootstrap/unix-88/Texts.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/Texts.h b/bootstrap/unix-88/Texts.h index 8c6bf3f2..695d46a5 100644 --- a/bootstrap/unix-88/Texts.h +++ b/bootstrap/unix-88/Texts.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Texts__h #define Texts__h diff --git a/bootstrap/unix-88/errors.c b/bootstrap/unix-88/errors.c index b071c3a8..d35766eb 100644 --- a/bootstrap/unix-88/errors.c +++ b/bootstrap/unix-88/errors.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/errors.h b/bootstrap/unix-88/errors.h index 1560dc0d..6adfb219 100644 --- a/bootstrap/unix-88/errors.h +++ b/bootstrap/unix-88/errors.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef errors__h #define errors__h diff --git a/bootstrap/unix-88/extTools.c b/bootstrap/unix-88/extTools.c index f6b467bb..5f5a39b3 100644 --- a/bootstrap/unix-88/extTools.c +++ b/bootstrap/unix-88/extTools.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/extTools.h b/bootstrap/unix-88/extTools.h index ab7785db..57da5b24 100644 --- a/bootstrap/unix-88/extTools.h +++ b/bootstrap/unix-88/extTools.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef extTools__h #define extTools__h diff --git a/bootstrap/unix-88/vt100.c b/bootstrap/unix-88/vt100.c index 23b25f53..61383b15 100644 --- a/bootstrap/unix-88/vt100.c +++ b/bootstrap/unix-88/vt100.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/unix-88/vt100.h b/bootstrap/unix-88/vt100.h index 95c8d77e..511c4d6b 100644 --- a/bootstrap/unix-88/vt100.h +++ b/bootstrap/unix-88/vt100.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef vt100__h #define vt100__h diff --git a/bootstrap/windows-48/Compiler.c b/bootstrap/windows-48/Compiler.c index a3cc57ea..5eeecbcd 100644 --- a/bootstrap/windows-48/Compiler.c +++ b/bootstrap/windows-48/Compiler.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspamSf */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspamSf */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/Configuration.c b/bootstrap/windows-48/Configuration.c index 32d0b51f..8d939331 100644 --- a/bootstrap/windows-48/Configuration.c +++ b/bootstrap/windows-48/Configuration.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 @@ -19,6 +19,6 @@ export void *Configuration__init(void) __DEFMOD; __REGMOD("Configuration", 0); /* BEGIN */ - __MOVE("1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); + __MOVE("1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); __ENDMOD; } diff --git a/bootstrap/windows-48/Configuration.h b/bootstrap/windows-48/Configuration.h index db2b8c32..29896228 100644 --- a/bootstrap/windows-48/Configuration.h +++ b/bootstrap/windows-48/Configuration.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Configuration__h #define Configuration__h diff --git a/bootstrap/windows-48/Files.c b/bootstrap/windows-48/Files.c index 4e669b75..afea83b3 100644 --- a/bootstrap/windows-48/Files.c +++ b/bootstrap/windows-48/Files.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/Files.h b/bootstrap/windows-48/Files.h index 3d4b568e..d797cd7d 100644 --- a/bootstrap/windows-48/Files.h +++ b/bootstrap/windows-48/Files.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #ifndef Files__h #define Files__h diff --git a/bootstrap/windows-48/Heap.c b/bootstrap/windows-48/Heap.c index 9c9c2846..ed20badb 100644 --- a/bootstrap/windows-48/Heap.c +++ b/bootstrap/windows-48/Heap.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/Heap.h b/bootstrap/windows-48/Heap.h index d4afd6fe..15cedcc4 100644 --- a/bootstrap/windows-48/Heap.h +++ b/bootstrap/windows-48/Heap.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #ifndef Heap__h #define Heap__h diff --git a/bootstrap/windows-48/Modules.c b/bootstrap/windows-48/Modules.c index 9cfee5c9..352866db 100644 --- a/bootstrap/windows-48/Modules.c +++ b/bootstrap/windows-48/Modules.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/Modules.h b/bootstrap/windows-48/Modules.h index 4e105135..c6f0ec55 100644 --- a/bootstrap/windows-48/Modules.h +++ b/bootstrap/windows-48/Modules.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Modules__h #define Modules__h diff --git a/bootstrap/windows-48/OPB.c b/bootstrap/windows-48/OPB.c index ef3ea081..80807ca6 100644 --- a/bootstrap/windows-48/OPB.c +++ b/bootstrap/windows-48/OPB.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 @@ -1273,6 +1273,8 @@ void OPB_Op (int8 op, OPT_Node *x, OPT_Node y) case 7: if ((g == 7 && y->typ->size < z->typ->size)) { OPB_Convert(&y, z->typ); + } else if (g == 7) { + OPB_Convert(&z, y->typ); } else { OPB_err(100); } diff --git a/bootstrap/windows-48/OPB.h b/bootstrap/windows-48/OPB.h index 54e81677..7917b570 100644 --- a/bootstrap/windows-48/OPB.h +++ b/bootstrap/windows-48/OPB.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPB__h #define OPB__h diff --git a/bootstrap/windows-48/OPC.c b/bootstrap/windows-48/OPC.c index 6739a87e..fad4716b 100644 --- a/bootstrap/windows-48/OPC.c +++ b/bootstrap/windows-48/OPC.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/OPC.h b/bootstrap/windows-48/OPC.h index 32ec3b7f..6d64b896 100644 --- a/bootstrap/windows-48/OPC.h +++ b/bootstrap/windows-48/OPC.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPC__h #define OPC__h diff --git a/bootstrap/windows-48/OPM.c b/bootstrap/windows-48/OPM.c index 1ab50cf6..c2760a09 100644 --- a/bootstrap/windows-48/OPM.c +++ b/bootstrap/windows-48/OPM.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/OPM.h b/bootstrap/windows-48/OPM.h index 960bd0ba..b798756b 100644 --- a/bootstrap/windows-48/OPM.h +++ b/bootstrap/windows-48/OPM.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPM__h #define OPM__h diff --git a/bootstrap/windows-48/OPP.c b/bootstrap/windows-48/OPP.c index 3a1bf6f6..f691a0ee 100644 --- a/bootstrap/windows-48/OPP.c +++ b/bootstrap/windows-48/OPP.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/OPP.h b/bootstrap/windows-48/OPP.h index 8b28d78e..b466e3aa 100644 --- a/bootstrap/windows-48/OPP.h +++ b/bootstrap/windows-48/OPP.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPP__h #define OPP__h diff --git a/bootstrap/windows-48/OPS.c b/bootstrap/windows-48/OPS.c index 882c9331..bd835f8d 100644 --- a/bootstrap/windows-48/OPS.c +++ b/bootstrap/windows-48/OPS.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/OPS.h b/bootstrap/windows-48/OPS.h index 62dc025a..af7eca8a 100644 --- a/bootstrap/windows-48/OPS.h +++ b/bootstrap/windows-48/OPS.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #ifndef OPS__h #define OPS__h diff --git a/bootstrap/windows-48/OPT.c b/bootstrap/windows-48/OPT.c index a23ac389..bd0b6935 100644 --- a/bootstrap/windows-48/OPT.c +++ b/bootstrap/windows-48/OPT.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/OPT.h b/bootstrap/windows-48/OPT.h index 6f17b409..5fe4dd5c 100644 --- a/bootstrap/windows-48/OPT.h +++ b/bootstrap/windows-48/OPT.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPT__h #define OPT__h diff --git a/bootstrap/windows-48/OPV.c b/bootstrap/windows-48/OPV.c index ba7bab5f..ab191652 100644 --- a/bootstrap/windows-48/OPV.c +++ b/bootstrap/windows-48/OPV.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 @@ -41,7 +41,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x); static void OPV_ParIntLiteral (int64 n, int32 size); static int16 OPV_Precedence (int16 class, int16 subclass, int16 form, int16 comp); static BOOLEAN OPV_SideEffects (OPT_Node n); -static void OPV_SizeCast (int32 from, int32 to); +static void OPV_SizeCast (OPT_Node n, int32 to); static void OPV_Stamp (OPS_Name s); static OPT_Object OPV_SuperProc (OPT_Node n); static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported); @@ -380,12 +380,24 @@ static void OPV_Entier (OPT_Node n, int16 prec) } } -static void OPV_SizeCast (int32 from, int32 to) +static void OPV_SizeCast (OPT_Node n, int32 to) { - if ((from != to && (from > 4 || to != 4))) { - OPM_WriteString((CHAR*)"(int", 5); - OPM_WriteInt(__ASHL(to, 3)); - OPM_WriteString((CHAR*)")", 2); + if ((to < n->typ->size && __IN(2, OPM_Options, 32))) { + OPM_WriteString((CHAR*)"__SHORT", 8); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)", ", 3); + OPM_WriteInt(OPM_SignedMaximum(to) + 1); + OPM_Write(')'); + } else { + if ((n->typ->size != to && (n->typ->size > 4 || to != 4))) { + OPM_WriteString((CHAR*)"(int", 5); + OPM_WriteInt(__ASHL(to, 3)); + OPM_WriteString((CHAR*)")", 2); + } } } @@ -395,26 +407,19 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, int16 prec) from = n->typ->form; to = newtype->form; if (to == 7) { - OPM_WriteString((CHAR*)"__SETOF(", 9); - OPV_Entier(n, -1); - OPM_WriteString((CHAR*)",", 2); - OPM_WriteInt(__ASHL(newtype->size, 3)); - OPM_Write(')'); - } else if (to == 4) { - if ((newtype->size < n->typ->size && __IN(2, OPM_Options, 32))) { - OPM_WriteString((CHAR*)"__SHORT", 8); - if (OPV_SideEffects(n)) { - OPM_Write('F'); - } - OPM_Write('('); - OPV_Entier(n, -1); - OPM_WriteString((CHAR*)", ", 3); - OPM_WriteInt(OPM_SignedMaximum(newtype->size) + 1); - OPM_Write(')'); - } else { - OPV_SizeCast(n->typ->size, newtype->size); + if (from == 7) { + OPV_SizeCast(n, newtype->size); OPV_Entier(n, 9); + } else { + OPM_WriteString((CHAR*)"__SETOF(", 9); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)",", 2); + OPM_WriteInt(__ASHL(newtype->size, 3)); + OPM_Write(')'); } + } else if (to == 4) { + OPV_SizeCast(n, newtype->size); + OPV_Entier(n, 9); } else if (to == 3) { if (__IN(2, OPM_Options, 32)) { OPM_WriteString((CHAR*)"__CHR", 6); diff --git a/bootstrap/windows-48/OPV.h b/bootstrap/windows-48/OPV.h index 30c2c7e7..49c91eed 100644 --- a/bootstrap/windows-48/OPV.h +++ b/bootstrap/windows-48/OPV.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPV__h #define OPV__h diff --git a/bootstrap/windows-48/Out.c b/bootstrap/windows-48/Out.c index 60051d13..f08085ef 100644 --- a/bootstrap/windows-48/Out.c +++ b/bootstrap/windows-48/Out.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/Out.h b/bootstrap/windows-48/Out.h index 6717f71b..72b7e0cb 100644 --- a/bootstrap/windows-48/Out.h +++ b/bootstrap/windows-48/Out.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #ifndef Out__h #define Out__h diff --git a/bootstrap/windows-48/Platform.c b/bootstrap/windows-48/Platform.c index f3eea094..7b5e8a8c 100644 --- a/bootstrap/windows-48/Platform.c +++ b/bootstrap/windows-48/Platform.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/Platform.h b/bootstrap/windows-48/Platform.h index a07ae09d..e0dfb26e 100644 --- a/bootstrap/windows-48/Platform.h +++ b/bootstrap/windows-48/Platform.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Platform__h #define Platform__h diff --git a/bootstrap/windows-48/Reals.c b/bootstrap/windows-48/Reals.c index f173fc32..97923f8d 100644 --- a/bootstrap/windows-48/Reals.c +++ b/bootstrap/windows-48/Reals.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/Reals.h b/bootstrap/windows-48/Reals.h index 98443ee2..24d6197a 100644 --- a/bootstrap/windows-48/Reals.h +++ b/bootstrap/windows-48/Reals.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Reals__h #define Reals__h diff --git a/bootstrap/windows-48/Strings.c b/bootstrap/windows-48/Strings.c index accc2e6a..afd5e004 100644 --- a/bootstrap/windows-48/Strings.c +++ b/bootstrap/windows-48/Strings.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/Strings.h b/bootstrap/windows-48/Strings.h index 9ebac10a..ce00b00c 100644 --- a/bootstrap/windows-48/Strings.h +++ b/bootstrap/windows-48/Strings.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Strings__h #define Strings__h diff --git a/bootstrap/windows-48/Texts.c b/bootstrap/windows-48/Texts.c index 8fd544dc..f656fcc8 100644 --- a/bootstrap/windows-48/Texts.c +++ b/bootstrap/windows-48/Texts.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/Texts.h b/bootstrap/windows-48/Texts.h index 3d119274..6feea28a 100644 --- a/bootstrap/windows-48/Texts.h +++ b/bootstrap/windows-48/Texts.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Texts__h #define Texts__h diff --git a/bootstrap/windows-48/errors.c b/bootstrap/windows-48/errors.c index b071c3a8..d35766eb 100644 --- a/bootstrap/windows-48/errors.c +++ b/bootstrap/windows-48/errors.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/errors.h b/bootstrap/windows-48/errors.h index 1560dc0d..6adfb219 100644 --- a/bootstrap/windows-48/errors.h +++ b/bootstrap/windows-48/errors.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef errors__h #define errors__h diff --git a/bootstrap/windows-48/extTools.c b/bootstrap/windows-48/extTools.c index f6b467bb..5f5a39b3 100644 --- a/bootstrap/windows-48/extTools.c +++ b/bootstrap/windows-48/extTools.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/extTools.h b/bootstrap/windows-48/extTools.h index ab7785db..57da5b24 100644 --- a/bootstrap/windows-48/extTools.h +++ b/bootstrap/windows-48/extTools.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef extTools__h #define extTools__h diff --git a/bootstrap/windows-48/vt100.c b/bootstrap/windows-48/vt100.c index 23b25f53..61383b15 100644 --- a/bootstrap/windows-48/vt100.c +++ b/bootstrap/windows-48/vt100.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-48/vt100.h b/bootstrap/windows-48/vt100.h index 95c8d77e..511c4d6b 100644 --- a/bootstrap/windows-48/vt100.h +++ b/bootstrap/windows-48/vt100.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef vt100__h #define vt100__h diff --git a/bootstrap/windows-88/Compiler.c b/bootstrap/windows-88/Compiler.c index a3cc57ea..5eeecbcd 100644 --- a/bootstrap/windows-88/Compiler.c +++ b/bootstrap/windows-88/Compiler.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspamSf */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspamSf */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/Configuration.c b/bootstrap/windows-88/Configuration.c index 32d0b51f..8d939331 100644 --- a/bootstrap/windows-88/Configuration.c +++ b/bootstrap/windows-88/Configuration.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 @@ -19,6 +19,6 @@ export void *Configuration__init(void) __DEFMOD; __REGMOD("Configuration", 0); /* BEGIN */ - __MOVE("1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); + __MOVE("1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); __ENDMOD; } diff --git a/bootstrap/windows-88/Configuration.h b/bootstrap/windows-88/Configuration.h index db2b8c32..29896228 100644 --- a/bootstrap/windows-88/Configuration.h +++ b/bootstrap/windows-88/Configuration.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Configuration__h #define Configuration__h diff --git a/bootstrap/windows-88/Files.c b/bootstrap/windows-88/Files.c index 7dda2f04..a2df0b07 100644 --- a/bootstrap/windows-88/Files.c +++ b/bootstrap/windows-88/Files.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/Files.h b/bootstrap/windows-88/Files.h index 82031060..85708a3f 100644 --- a/bootstrap/windows-88/Files.h +++ b/bootstrap/windows-88/Files.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #ifndef Files__h #define Files__h diff --git a/bootstrap/windows-88/Heap.c b/bootstrap/windows-88/Heap.c index 6ab9f1ca..2dd37317 100644 --- a/bootstrap/windows-88/Heap.c +++ b/bootstrap/windows-88/Heap.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/Heap.h b/bootstrap/windows-88/Heap.h index b183ffa4..dc9db0d8 100644 --- a/bootstrap/windows-88/Heap.h +++ b/bootstrap/windows-88/Heap.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #ifndef Heap__h #define Heap__h diff --git a/bootstrap/windows-88/Modules.c b/bootstrap/windows-88/Modules.c index dab15898..57b8190a 100644 --- a/bootstrap/windows-88/Modules.c +++ b/bootstrap/windows-88/Modules.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/Modules.h b/bootstrap/windows-88/Modules.h index 4e105135..c6f0ec55 100644 --- a/bootstrap/windows-88/Modules.h +++ b/bootstrap/windows-88/Modules.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Modules__h #define Modules__h diff --git a/bootstrap/windows-88/OPB.c b/bootstrap/windows-88/OPB.c index ef3ea081..80807ca6 100644 --- a/bootstrap/windows-88/OPB.c +++ b/bootstrap/windows-88/OPB.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 @@ -1273,6 +1273,8 @@ void OPB_Op (int8 op, OPT_Node *x, OPT_Node y) case 7: if ((g == 7 && y->typ->size < z->typ->size)) { OPB_Convert(&y, z->typ); + } else if (g == 7) { + OPB_Convert(&z, y->typ); } else { OPB_err(100); } diff --git a/bootstrap/windows-88/OPB.h b/bootstrap/windows-88/OPB.h index 54e81677..7917b570 100644 --- a/bootstrap/windows-88/OPB.h +++ b/bootstrap/windows-88/OPB.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPB__h #define OPB__h diff --git a/bootstrap/windows-88/OPC.c b/bootstrap/windows-88/OPC.c index 6739a87e..fad4716b 100644 --- a/bootstrap/windows-88/OPC.c +++ b/bootstrap/windows-88/OPC.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/OPC.h b/bootstrap/windows-88/OPC.h index 32ec3b7f..6d64b896 100644 --- a/bootstrap/windows-88/OPC.h +++ b/bootstrap/windows-88/OPC.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPC__h #define OPC__h diff --git a/bootstrap/windows-88/OPM.c b/bootstrap/windows-88/OPM.c index 732baf46..bc0b1d98 100644 --- a/bootstrap/windows-88/OPM.c +++ b/bootstrap/windows-88/OPM.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/OPM.h b/bootstrap/windows-88/OPM.h index 960bd0ba..b798756b 100644 --- a/bootstrap/windows-88/OPM.h +++ b/bootstrap/windows-88/OPM.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPM__h #define OPM__h diff --git a/bootstrap/windows-88/OPP.c b/bootstrap/windows-88/OPP.c index bf1c6c9b..643f8fc5 100644 --- a/bootstrap/windows-88/OPP.c +++ b/bootstrap/windows-88/OPP.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/OPP.h b/bootstrap/windows-88/OPP.h index 8b28d78e..b466e3aa 100644 --- a/bootstrap/windows-88/OPP.h +++ b/bootstrap/windows-88/OPP.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPP__h #define OPP__h diff --git a/bootstrap/windows-88/OPS.c b/bootstrap/windows-88/OPS.c index 882c9331..bd835f8d 100644 --- a/bootstrap/windows-88/OPS.c +++ b/bootstrap/windows-88/OPS.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/OPS.h b/bootstrap/windows-88/OPS.h index 62dc025a..af7eca8a 100644 --- a/bootstrap/windows-88/OPS.h +++ b/bootstrap/windows-88/OPS.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tspaSfF */ #ifndef OPS__h #define OPS__h diff --git a/bootstrap/windows-88/OPT.c b/bootstrap/windows-88/OPT.c index 186ab7e3..a8d1a2b2 100644 --- a/bootstrap/windows-88/OPT.c +++ b/bootstrap/windows-88/OPT.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/OPT.h b/bootstrap/windows-88/OPT.h index 6f17b409..5fe4dd5c 100644 --- a/bootstrap/windows-88/OPT.h +++ b/bootstrap/windows-88/OPT.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPT__h #define OPT__h diff --git a/bootstrap/windows-88/OPV.c b/bootstrap/windows-88/OPV.c index f566e592..5004eab0 100644 --- a/bootstrap/windows-88/OPV.c +++ b/bootstrap/windows-88/OPV.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 @@ -41,7 +41,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x); static void OPV_ParIntLiteral (int64 n, int32 size); static int16 OPV_Precedence (int16 class, int16 subclass, int16 form, int16 comp); static BOOLEAN OPV_SideEffects (OPT_Node n); -static void OPV_SizeCast (int32 from, int32 to); +static void OPV_SizeCast (OPT_Node n, int32 to); static void OPV_Stamp (OPS_Name s); static OPT_Object OPV_SuperProc (OPT_Node n); static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported); @@ -380,12 +380,24 @@ static void OPV_Entier (OPT_Node n, int16 prec) } } -static void OPV_SizeCast (int32 from, int32 to) +static void OPV_SizeCast (OPT_Node n, int32 to) { - if ((from != to && (from > 4 || to != 4))) { - OPM_WriteString((CHAR*)"(int", 5); - OPM_WriteInt(__ASHL(to, 3)); - OPM_WriteString((CHAR*)")", 2); + if ((to < n->typ->size && __IN(2, OPM_Options, 32))) { + OPM_WriteString((CHAR*)"__SHORT", 8); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)", ", 3); + OPM_WriteInt(OPM_SignedMaximum(to) + 1); + OPM_Write(')'); + } else { + if ((n->typ->size != to && (n->typ->size > 4 || to != 4))) { + OPM_WriteString((CHAR*)"(int", 5); + OPM_WriteInt(__ASHL(to, 3)); + OPM_WriteString((CHAR*)")", 2); + } } } @@ -395,26 +407,19 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, int16 prec) from = n->typ->form; to = newtype->form; if (to == 7) { - OPM_WriteString((CHAR*)"__SETOF(", 9); - OPV_Entier(n, -1); - OPM_WriteString((CHAR*)",", 2); - OPM_WriteInt(__ASHL(newtype->size, 3)); - OPM_Write(')'); - } else if (to == 4) { - if ((newtype->size < n->typ->size && __IN(2, OPM_Options, 32))) { - OPM_WriteString((CHAR*)"__SHORT", 8); - if (OPV_SideEffects(n)) { - OPM_Write('F'); - } - OPM_Write('('); - OPV_Entier(n, -1); - OPM_WriteString((CHAR*)", ", 3); - OPM_WriteInt(OPM_SignedMaximum(newtype->size) + 1); - OPM_Write(')'); - } else { - OPV_SizeCast(n->typ->size, newtype->size); + if (from == 7) { + OPV_SizeCast(n, newtype->size); OPV_Entier(n, 9); + } else { + OPM_WriteString((CHAR*)"__SETOF(", 9); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)",", 2); + OPM_WriteInt(__ASHL(newtype->size, 3)); + OPM_Write(')'); } + } else if (to == 4) { + OPV_SizeCast(n, newtype->size); + OPV_Entier(n, 9); } else if (to == 3) { if (__IN(2, OPM_Options, 32)) { OPM_WriteString((CHAR*)"__CHR", 6); diff --git a/bootstrap/windows-88/OPV.h b/bootstrap/windows-88/OPV.h index 30c2c7e7..49c91eed 100644 --- a/bootstrap/windows-88/OPV.h +++ b/bootstrap/windows-88/OPV.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef OPV__h #define OPV__h diff --git a/bootstrap/windows-88/Out.c b/bootstrap/windows-88/Out.c index 60051d13..f08085ef 100644 --- a/bootstrap/windows-88/Out.c +++ b/bootstrap/windows-88/Out.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/Out.h b/bootstrap/windows-88/Out.h index 6717f71b..72b7e0cb 100644 --- a/bootstrap/windows-88/Out.h +++ b/bootstrap/windows-88/Out.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. tsSfF */ #ifndef Out__h #define Out__h diff --git a/bootstrap/windows-88/Platform.c b/bootstrap/windows-88/Platform.c index efcb7845..8f725aaa 100644 --- a/bootstrap/windows-88/Platform.c +++ b/bootstrap/windows-88/Platform.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/Platform.h b/bootstrap/windows-88/Platform.h index 2e13990f..070acb18 100644 --- a/bootstrap/windows-88/Platform.h +++ b/bootstrap/windows-88/Platform.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Platform__h #define Platform__h diff --git a/bootstrap/windows-88/Reals.c b/bootstrap/windows-88/Reals.c index f173fc32..97923f8d 100644 --- a/bootstrap/windows-88/Reals.c +++ b/bootstrap/windows-88/Reals.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/Reals.h b/bootstrap/windows-88/Reals.h index 98443ee2..24d6197a 100644 --- a/bootstrap/windows-88/Reals.h +++ b/bootstrap/windows-88/Reals.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Reals__h #define Reals__h diff --git a/bootstrap/windows-88/Strings.c b/bootstrap/windows-88/Strings.c index accc2e6a..afd5e004 100644 --- a/bootstrap/windows-88/Strings.c +++ b/bootstrap/windows-88/Strings.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/Strings.h b/bootstrap/windows-88/Strings.h index 9ebac10a..ce00b00c 100644 --- a/bootstrap/windows-88/Strings.h +++ b/bootstrap/windows-88/Strings.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Strings__h #define Strings__h diff --git a/bootstrap/windows-88/Texts.c b/bootstrap/windows-88/Texts.c index 369dceed..97cfe790 100644 --- a/bootstrap/windows-88/Texts.c +++ b/bootstrap/windows-88/Texts.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/Texts.h b/bootstrap/windows-88/Texts.h index 8c6bf3f2..695d46a5 100644 --- a/bootstrap/windows-88/Texts.h +++ b/bootstrap/windows-88/Texts.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef Texts__h #define Texts__h diff --git a/bootstrap/windows-88/errors.c b/bootstrap/windows-88/errors.c index b071c3a8..d35766eb 100644 --- a/bootstrap/windows-88/errors.c +++ b/bootstrap/windows-88/errors.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/errors.h b/bootstrap/windows-88/errors.h index 1560dc0d..6adfb219 100644 --- a/bootstrap/windows-88/errors.h +++ b/bootstrap/windows-88/errors.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef errors__h #define errors__h diff --git a/bootstrap/windows-88/extTools.c b/bootstrap/windows-88/extTools.c index f6b467bb..5f5a39b3 100644 --- a/bootstrap/windows-88/extTools.c +++ b/bootstrap/windows-88/extTools.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/extTools.h b/bootstrap/windows-88/extTools.h index ab7785db..57da5b24 100644 --- a/bootstrap/windows-88/extTools.h +++ b/bootstrap/windows-88/extTools.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef extTools__h #define extTools__h diff --git a/bootstrap/windows-88/vt100.c b/bootstrap/windows-88/vt100.c index 23b25f53..61383b15 100644 --- a/bootstrap/windows-88/vt100.c +++ b/bootstrap/windows-88/vt100.c @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #define SHORTINT int8 #define INTEGER int16 diff --git a/bootstrap/windows-88/vt100.h b/bootstrap/windows-88/vt100.h index 95c8d77e..511c4d6b 100644 --- a/bootstrap/windows-88/vt100.h +++ b/bootstrap/windows-88/vt100.h @@ -1,4 +1,4 @@ -/* voc 1.95 [2016/10/01]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ +/* voc 1.95 [2016/10/03]. Bootstrapping compiler for address size 8, alignment 8. xtspaSfF */ #ifndef vt100__h #define vt100__h diff --git a/src/compiler/OPB.Mod b/src/compiler/OPB.Mod index a6b8cf67..5cdad662 100644 --- a/src/compiler/OPB.Mod +++ b/src/compiler/OPB.Mod @@ -678,6 +678,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSE err(100) END |OPT.Set: IF (g = OPT.Set) & (y.typ.size < z.typ.size) THEN Convert(y, z.typ) + ELSIF (g = OPT.Set) THEN Convert(z, y.typ) ELSE err(100) END |OPT.Real: IF g = OPT.Int THEN Convert(y, z^.typ) diff --git a/src/compiler/OPV.Mod b/src/compiler/OPV.Mod index 0d29d56d..dd089baf 100644 --- a/src/compiler/OPV.Mod +++ b/src/compiler/OPV.Mod @@ -232,10 +232,16 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 END END Entier; - PROCEDURE SizeCast(from, to: LONGINT); + PROCEDURE SizeCast(n: OPT.Node; to: LONGINT); BEGIN - IF (from # to) & ((from > OPM.CIntSize) OR (to # OPM.CIntSize)) THEN - OPM.WriteString("(int"); OPM.WriteInt(to*8); OPM.WriteString(")") + IF (to < n.typ.size) & (OPM.ranchk IN OPM.Options) THEN + OPM.WriteString("__SHORT"); IF SideEffects(n) THEN OPM.Write("F") END; + OPM.Write(OpenParen); Entier(n, MinPrec); OPM.WriteString(Comma); + OPM.WriteInt(OPM.SignedMaximum(to) + 1); OPM.Write(CloseParen) + ELSE + IF (n.typ.size # to) & ((n.typ.size > OPM.CIntSize) OR (to # OPM.CIntSize)) THEN + OPM.WriteString("(int"); OPM.WriteInt(to*8); OPM.WriteString(")") + END END END SizeCast; @@ -243,16 +249,14 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 VAR from, to: INTEGER; BEGIN from := n^.typ^.form; to := newtype.form; IF to = OPT.Set THEN - OPM.WriteString("__SETOF("); Entier(n, MinPrec); - OPM.WriteString(","); OPM.WriteInt(newtype.size*8); OPM.Write(CloseParen) - ELSIF to = OPT.Int THEN - IF (newtype.size < n.typ.size) & (OPM.ranchk IN OPM.Options) THEN - OPM.WriteString("__SHORT"); IF SideEffects(n) THEN OPM.Write("F") END; - OPM.Write(OpenParen); Entier(n, MinPrec); OPM.WriteString(Comma); - OPM.WriteInt(OPM.SignedMaximum(newtype.size) + 1); OPM.Write(CloseParen) - ELSE - SizeCast(n.typ.size, newtype.size); Entier(n, 9) + IF from = OPT.Set THEN (* Sets of different size *) + SizeCast(n, newtype.size); Entier(n, 9) + ELSE (* Set from integer *) + OPM.WriteString("__SETOF("); Entier(n, MinPrec); + OPM.WriteString(","); OPM.WriteInt(newtype.size*8); OPM.Write(CloseParen) END + ELSIF to = OPT.Int THEN (* integers of different size *) + SizeCast(n, newtype.size); Entier(n, 9) ELSIF to = OPT.Char THEN IF OPM.ranchk IN OPM.Options THEN OPM.WriteString("__CHR"); IF SideEffects(n) THEN OPM.Write("F") END ; diff --git a/src/runtime/LowReal.Mod b/src/runtime/LowReal.Mod deleted file mode 100644 index e5a8f8a6..00000000 --- a/src/runtime/LowReal.Mod +++ /dev/null @@ -1,417 +0,0 @@ -(* $Id: LowReal.Mod,v 1.5 1999/09/02 13:17:38 acken Exp $ *) -MODULE LowReal; - -(* - LowReal - Gives access to the underlying properties of the type REAL - for IEEE single-precision numbers. - Copyright (C) 1995 Michael Griebling - - This module is free software; you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 2 of the - License, or (at your option) any later version. - - This module is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this program; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -*) - - -IMPORT SYSTEM; - -(* - - Real number properties are defined as follows: - - radix--The whole number value of the radix used to represent the - corresponding read number values. - - places--The whole number value of the number of radix places used - to store values of the corresponding real number type. - - expoMin--The whole number value of the exponent minimum. - - expoMax--The whole number value of the exponent maximum. - - large--The largest value of the corresponding real number type. - - small--The smallest positive value of the corresponding real number - type, represented to maximal precision. - - IEC559--A Boolean value that is TRUE if and only if the implementation - of the corresponding real number type conforms to IEC 559:1989 - (IEEE 754:1987) in all regards. - - NOTES - 6 -- If `IEC559' is TRUE, the value of `radix' is 2. - 7 -- If LowReal.IEC559 is TRUE, the 32-bit format of IEC 559:1989 - is used for the type REAL. - 7 -- If LowLong.IEC559 is TRUE, the 64-bit format of IEC 559:1989 - is used for the type REAL. - - LIA1--A Boolean value that is TRUE if and only if the implementation of - the corresponding real number type conforms to ISO/IEC 10967-1:199x - (LIA-1) in all regards: parameters, arithmetic, exceptions, and - notification. - - rounds--A Boolean value that is TRUE if and only if each operation produces - a result that is one of the values of the corresponding real number - type nearest to the mathematical result. - - gUnderflow--A Boolean value that is TRUE if and only if there are values of - the corresponding real number type between 0.0 and `small'. - - exception--A Boolean value that is TRUE if and only if every operation that - attempts to produce a real value out of range raises an exception. - - extend--A Boolean value that is TRUE if and only if expressions of the - corresponding real number type are computed to higher precision than - the stored values. - - nModes--The whole number value giving the number of bit positions needed for - the status flags for mode control. - -*) -CONST - radix* = 2; - places* = 24; - expoMax* = 127; - expoMin* = 1-expoMax; - large* = MAX(REAL); (*3.40282347E+38;*) - (*small* = 1.17549435E-38; (* 2^(-126) *)*) - small* = 1/8.50705917E37; (* don't know better way; -- noch *) - IEC559* = TRUE; - LIA1* = FALSE; - rounds* = FALSE; - gUnderflow* = TRUE; (* there are IEEE numbers smaller than `small' *) - exception* = FALSE; (* at least in the default implementation *) - extend* = FALSE; - nModes* = 0; - - TEN = 10.0; (* some commonly-used constants *) - ONE = 1.0; - ZERO = 0.0; - - expOffset = expoMax; - (*hiBit = 22;*) - (*expBit = hiBit+1;*) - nMask = {0..22,31}; (* number mask *) - expMask = {23..30}; (* exponent mask *) - -TYPE - Modes* = SET; - -VAR - (*small* : REAL; tmp: REAL;*) (* this was a test to get small as a variable at runtime. obviously, compile time preferred; -- noch *) - ErrorHandler*: PROCEDURE (errno : INTEGER); - err-: INTEGER; - -(* Error handler default stub which can be replaced *) - -PROCEDURE DefaultHandler (errno : INTEGER); -BEGIN - err:=errno -END DefaultHandler; - -PROCEDURE ClearError*; -BEGIN - err:=0 -END ClearError; - - -PROCEDURE exponent*(x: REAL): INTEGER; -(* - The value of the call exponent(x) shall be the exponent value of `x' - that lies between `expoMin' and `expoMax'. An exception shall occur - and may be raised if `x' is equal to 0.0. - *) - VAR w: SYSTEM.INT16; -BEGIN - (* NOTE: x=0.0 should raise exception *) - IF x = ZERO THEN RETURN 0 END; - - RETURN SYSTEM.VAL(INTEGER, SYSTEM.LSH((SYSTEM.VAL(SYSTEM.SET32, x) * expMask), -23)); - - - SYSTEM.GET(SYSTEM.ADR(x)+2, w); (* Load most significant word *) - RETURN ((w DIV 128) MOD 256) - expOffset -END exponent; - -PROCEDURE SetExponent(VAR x: REAL; ex: SYSTEM.INT32); - VAR s: SYSTEM.SET32; -BEGIN - ex := SYSTEM.LSH(ex + expOffset, 23); - s := SYSTEM.VAL(SYSTEM.SET32, s) * nMask + SYSTEM.VAL(SYSTEM.SET32, ex) * expMask; - SYSTEM.PUT(SYSTEM.ADR(x), s) -END SetExponent; - -PROCEDURE exponent10*(x: REAL): INTEGER; -(* - The value of the call exponent10(x) shall be the base 10 exponent - value of `x'. An exception shall occur and may be raised if `x' is - equal to 0.0. - *) -VAR exp: INTEGER; -BEGIN - exp := 0; x := ABS(x); - IF x = ZERO THEN RETURN exp END; (* exception could be raised here *) - WHILE x >= TEN DO x := x/TEN; INC(exp) END; - WHILE (x > ZERO) & (x < 1.0) DO x := x*TEN; DEC(exp) END; - RETURN exp -END exponent10; - -(* TYPE REAL: 1/sign, 8/exponent, 23/significand *) - -PROCEDURE fraction*(x: REAL): REAL; -(* - The value of the call fraction(x) shall be the significand (or - significant) part of `x'. Hence the following relationship shall - hold: x = scale(fraction(x), exponent(x)). -*) -VAR c: CHAR; -BEGIN - IF x=ZERO THEN RETURN ZERO - ELSE - (* Set top 7 bits of exponent to 0111111 *) - SYSTEM.GET(SYSTEM.ADR(x)+3, c); - c := CHR(((ORD(c) DIV 128) * 128) + 63); (* Set X0111111 (X unchanged) *) - SYSTEM.PUT(SYSTEM.ADR(x)+3, c); - (* Set bottom bit of exponent to 0 *) - SYSTEM.GET(SYSTEM.ADR(x)+2, c); - c := CHR(ORD(c) MOD 128); (* Set 0XXXXXXX (X unchanged) *) - SYSTEM.PUT(SYSTEM.ADR(x)+2, c); - RETURN x * 2.0; - END -(* - CONST eZero={(hiBit+2)..29}; -BEGIN - IF x=ZERO THEN RETURN ZERO - ELSE RETURN SYSTEM.VAL(REAL,(SYSTEM.VAL(SET,x)*nMask)+eZero)*2.0 (* set the mantissa's exponent to zero *) - END -*) -END fraction; - -PROCEDURE IsInfinity * (real: REAL) : BOOLEAN; - VAR c0, c1, c2, c3: CHAR; -BEGIN - SYSTEM.GET(SYSTEM.ADR(real)+0, c3); - SYSTEM.GET(SYSTEM.ADR(real)+1, c2); - SYSTEM.GET(SYSTEM.ADR(real)+2, c1); - SYSTEM.GET(SYSTEM.ADR(real)+3, c0); - RETURN (ORD(c0) MOD 128 = 127) & (ORD(c1) = 128) & (ORD(c2) = 0) & (ORD(c3) = 0) -END IsInfinity; - -PROCEDURE IsNaN * (real: REAL) : BOOLEAN; - VAR c0, c1, c2, c3: CHAR; -BEGIN - SYSTEM.GET(SYSTEM.ADR(real)+0, c3); - SYSTEM.GET(SYSTEM.ADR(real)+1, c2); - SYSTEM.GET(SYSTEM.ADR(real)+2, c1); - SYSTEM.GET(SYSTEM.ADR(real)+3, c0); - RETURN (ORD(c0) MOD 128 = 127) - & (ORD(c1) DIV 128 = 1) - & ((ORD(c1) MOD 128 # 0) OR (ORD(c2) # 0) OR (ORD(c3) # 0)) -END IsNaN; - -PROCEDURE sign*(x: REAL): REAL; -(* - The value of the call sign(x) shall be 1.0 if `x' is greater than 0.0, - or shall be -1.0 if `x' is less than 0.0, or shall be either 1.0 or - -1.0 if `x' is equal to 0.0. -*) -BEGIN - IF x expoMax THEN RETURN large * sign(x) (* exception raised here *) - ELSIF exp < expoMin THEN RETURN small * sign(x) (* exception here as well *) - END; - SetExponent(x, SHORT(exp)); - (* SetExponent replaces these 2 lines: - lexp := SYSTEM.VAL(SET, SYSTEM.LSH(exp + expOffset, expBit)); (* shifted exponent bits *) - RETURN SYSTEM.VAL(REAL, (SYSTEM.VAL(SET, x) * nMask) + lexp) (* insert new exponent *) - *) -END scale; - -PROCEDURE ulp*(x: REAL): REAL; -(* - The value of the call ulp(x) shall be the value of the corresponding - real number type equal to a unit in the last place of `x', if such a - value exists; otherwise an exception shall occur and may be raised. -*) -BEGIN - RETURN scale(ONE, exponent(x)-places+1) -END ulp; - -PROCEDURE succ*(x: REAL): REAL; -(* - The value of the call succ(x) shall be the next value of the - corresponding real number type greater than `x', if such a type - exists; otherwise an exception shall occur and may be raised. -*) -BEGIN - RETURN x+ulp(x)*sign(x) -END succ; - -PROCEDURE pred*(x: REAL): REAL; -(* - The value of the call pred(x) shall be the next value of the - corresponding real number type less than `x', if such a type exists; - otherwise an exception shall occur and may be raised. -*) -BEGIN - RETURN x-ulp(x)*sign(x) -END pred; - -PROCEDURE intpart*(x: REAL): REAL; -(* - The value of the call intpart(x) shall be the integral part of `x'. - For negative values, this shall be -intpart(abs(x)). -*) - VAR loBit: INTEGER; -BEGIN - loBit := (hiBit+1) - exponent(x); - IF loBit <= 0 THEN RETURN x (* no fractional part *) - ELSIF loBit <= hiBit+1 THEN - RETURN SYSTEM.VAL(REAL,SYSTEM.VAL(SET,x)*{loBit..31}) (* integer part is extracted *) - ELSE RETURN ZERO (* no whole part *) - END -END intpart; - -PROCEDURE fractpart*(x: REAL): REAL; -(* - The value of the call fractpart(x) shall be the fractional part of - `x'. This satifies the relationship fractpart(x)+intpart(x)=x. -*) -BEGIN - RETURN x-intpart(x) -END fractpart; - -PROCEDURE trunc*(x: REAL; n: INTEGER): REAL; -(* - The value of the call trunc(x,n) shall be the value of the most - significant `n' places of `x'. An exception shall occur and may be - raised if `n' is less than or equal to zero. -*) - VAR loBit: INTEGER; mask: SET; -BEGIN loBit:=places-n; - IF n<=0 THEN RETURN ZERO (* exception should be raised *) - ELSIF loBit<=0 THEN RETURN x (* nothing was truncated *) - ELSE mask:={loBit..31}; (* truncation bit mask *) - RETURN SYSTEM.VAL(REAL,SYSTEM.VAL(SET,x)*mask) - END -END trunc; - -PROCEDURE round*(x: REAL; n: INTEGER): REAL; -(* - The value of the call round(x,n) shall be the value of `x' rounded to - the most significant `n' places. An exception shall occur and may be - raised if such a value does not exist, or if `n' is less than or equal - to zero. -*) - VAR loBit: INTEGER; num, mask: SET; r: REAL; -BEGIN loBit:=places-n; - IF n<=0 THEN RETURN ZERO (* exception should be raised *) - ELSIF loBit<=0 THEN RETURN x (* nothing was rounded *) - ELSE mask:={loBit..31}; num:=SYSTEM.VAL(SET,x); (* truncation bit mask and number as SET *) - x:=SYSTEM.VAL(REAL,num*mask); (* truncated result *) - IF loBit-1 IN num THEN (* check if result should be rounded *) - r:=scale(ONE,exponent(x)-n+1); (* rounding fraction *) - IF 31 IN num THEN RETURN x-r (* negative rounding toward -infinity *) - ELSE RETURN x+r (* positive rounding toward +infinity *) - END - ELSE RETURN x (* return truncated result *) - END - END -END round; - -PROCEDURE synthesize*(expart: INTEGER; frapart: REAL): REAL; -(* - The value of the call synthesize(expart,frapart) shall be a value of - the corresponding real number type contructed from the value of - `expart' and `frapart'. This value shall satisfy the relationship - synthesize(exponent(x),fraction(x)) = x. -*) -BEGIN - RETURN scale(frapart, expart) -END synthesize; - - -PROCEDURE setMode*(m: Modes); -(* - The call setMode(m) shall set status flags from the value of `m', - appropriate to the underlying implementation of the corresponding real - number type. - - NOTES - 3 -- Many implementations of floating point provide options for - setting flags within the system which control details of the handling - of the type. Although two procedures are provided, one for each real - number type, the effect may be the same. Typical effects that can be - obtained by this means are: - a) Ensuring that overflow will raise an exception; - b) Allowing underflow to raise an exception; - c) Controlling the rounding; - d) Allowing special values to be produced (e.g. NaNs in - implementations conforming to IEC 559:1989 (IEEE 754:1987)); - e) Ensuring that special valu access will raise an exception; - Since these effects are so varied, the values of type `Modes' that may - be used are not specified by this International Standard. - 4 -- The effects of `setMode' on operation on values of the - corresponding real number type in coroutines other than the calling - coroutine is not defined. Implementations are not require to preserve - the status flags (if any) with the coroutine state. -*) -BEGIN - (* hardware dependent mode setting of coprocessor *) -END setMode; - -PROCEDURE currentMode*(): Modes; -(* - The value of the call currentMode() shall be the current status flags - (in the form set by `setMode'), or the default status flags (if - `setMode' is not used). - - NOTE 5 -- The value of the call currentMode() is not necessarily the - value of set by `setMode', since a call of `setMode' might attempt to - set flags that cannot be set by the program. -*) -BEGIN - RETURN {} -END currentMode; - -PROCEDURE IsLowException*(): BOOLEAN; -(* - Returns TRUE if the current coroutine is in the exceptional execution state - because of the raising of the LowReal exception; otherwise returns FALSE. -*) -BEGIN - RETURN FALSE -END IsLowException; - -BEGIN - (* install the default error handler -- just sets err variable *) - ErrorHandler:=DefaultHandler; -(* tmp := power0(2,126); (* this is test to calculate small as a variable at runtime; -- noch *) - small := sml; - small := 1/power0(2,126); - *) -END LowReal. - - diff --git a/src/runtime/Math.Mod b/src/runtime/Math.Mod index 392534bd..3e8c492e 100644 --- a/src/runtime/Math.Mod +++ b/src/runtime/Math.Mod @@ -1,12 +1,12 @@ -(* $Id: RealMath.Mod,v 1.6 1999/09/02 13:19:17 acken Exp $ *) -MODULE oocRealMath; +MODULE Math; -(* MathL - Oakwood REAL Mathematics. - Adapted (with minimal changes) from OOC RealMath.Mod *) +IMPORT SYSTEM; -(* - RealMath - Target independent mathematical functions for REAL - (IEEE single-precision) numbers. +(* Math - Oakwood REAL Mathematics. + Adapted from OOC LowReal.Mod and RealMath.Mod + + Target independent mathematical functions for REAL + (IEEE single - precision) numbers. Numerical approximations are taken from "Software Manual for the Elementary Functions" by Cody & Waite and "Computer Approximations" @@ -26,82 +26,245 @@ MODULE oocRealMath; You should have received a copy of the GNU Lesser General Public License along with this program; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111 - 1307 USA *) -IMPORT l := LowReal, S := SYSTEM; +(* + Real number properties are defined as follows: + + radix - -The whole number value of the radix used to represent the + corresponding read number values. + + places - -The whole number value of the number of radix places used + to store values of the corresponding real number type. + + expoMin - -The whole number value of the exponent minimum. + + expoMax - -The whole number value of the exponent maximum. + + large - -The largest value of the corresponding real number type. + + small - -The smallest positive value of the corresponding real number + type, represented to maximal precision. + + IEC559 - -A Boolean value that is TRUE if and only if the implementation + of the corresponding real number type conforms to IEC 559:1989 + (IEEE 754:1987) in all regards. + + NOTES + 6 -- If `IEC559' is TRUE, the value of `radix' is 2. + 7 -- If LowReal.IEC559 is TRUE, the 32 - bit format of IEC 559:1989 + is used for the type REAL. + 7 -- If LowLong.IEC559 is TRUE, the 64 - bit format of IEC 559:1989 + is used for the type REAL. + + LIA1 - -A Boolean value that is TRUE if and only if the implementation of + the corresponding real number type conforms to ISO/IEC 10967 - 1:199x + (LIA - 1) in all regards: parameters, arithmetic, exceptions, and + notification. + + rounds - -A Boolean value that is TRUE if and only if each operation produces + a result that is one of the values of the corresponding real number + type nearest to the mathematical result. + + gUnderflow - -A Boolean value that is TRUE if and only if there are values of + the corresponding real number type between 0.0 and `small'. + + exception - -A Boolean value that is TRUE if and only if every operation that + attempts to produce a real value out of range raises an exception. + + extend - -A Boolean value that is TRUE if and only if expressions of the + corresponding real number type are computed to higher precision than + the stored values. + + nModes - -The whole number value giving the number of bit positions needed for + the status flags for mode control. + *) CONST pi* = 3.1415926535897932384626433832795028841972; e* = 2.7182818284590452353602874713526624977572; - ZERO=0.0; ONE=1.0; HALF=0.5; TWO=2.0; (* local constants *) + places* = 24; + large* = MAX(REAL); (* 3.40282347E+38. Largest number this package accepts *) +(*small* = 1.17549435E-38; *) (* 2^(-126) *) + small* = 1/8.50705917E37; (* don't know better way; -- noch *) + expoMax* = 127; + expoMin* = 1-expoMax; - (* internally-used constants *) - huge = l.large; (* largest number this package accepts *) - miny = ONE/huge; (* smallest number this package accepts *) - sqrtHalf = 0.70710678118654752440; - Limit = 2.4414062E-4; (* 2**(-MantBits/2) *) - eps = 2.9802322E-8; (* 2**(-MantBits-1) *) - piInv = 0.31830988618379067154; (* 1/pi *) - piByTwo = 1.57079632679489661923132; - piByFour = 0.78539816339744830962; - lnv = 0.6931610107421875; (* should be exact *) - vbytwo = 0.13830277879601902638E-4; (* used in sinh/cosh *) - ln2Inv = 1.44269504088896340735992468100189213; + expOffset = expoMax; + nMask = {0..22,31}; (* number mask: Sign and mantissa *) + expMask = {23..30}; (* exponent mask: exponent value + 127 *) + + ZERO = 0.0; + HALF = 0.5; + ONE = 1.0; + TWO = 2.0; + TEN = 10.0; + miny = ONE/large; (* Smallest number thispackage accepts *) + sqrtHalf = 0.70710678118654752440; + Limit = 2.4414062E-4; (* 2 * *( - MantBits/2) *) + eps = 2.9802322E-8; (* 2 * *( - MantBits - 1) *) + piInv = 0.31830988618379067154; (* 1/pi *) + piByTwo = 1.57079632679489661923132; + piByFour = 0.78539816339744830962; + lnv = 0.6931610107421875; (* should be exact *) + vbytwo = 0.13830277879601902638E-4; (* used in sinh/cosh *) + ln2Inv = 1.44269504088896340735992468100189213; (* error/exception codes *) - NoError*=0; IllegalRoot*=1; IllegalLog*=2; Overflow*=3; IllegalPower*=4; IllegalLogBase*=5; - IllegalTrig*=6; IllegalInvTrig*=7; HypInvTrigClipped*=8; IllegalHypInvTrig*=9; - LossOfAccuracy*=10; Underflow*=11; + NoError* = 0; IllegalRoot* = 1; IllegalLog* = 2; Overflow* = 3; + IllegalPower* = 4; IllegalLogBase* = 5; IllegalTrig* = 6; IllegalInvTrig* = 7; + HypInvTrigClipped* = 8; IllegalHypInvTrig* = 9; LossOfAccuracy* = 10; Underflow* = 11; VAR + ErrorHandler*: PROCEDURE (errno : INTEGER); + err-: INTEGER; + a1: ARRAY 18 OF REAL; (* lookup table for power function *) a2: ARRAY 9 OF REAL; (* lookup table for power function *) - em: REAL; (* largest number such that 1+epsilon > 1.0 *) + em: REAL; (* largest number such that 1 + epsilon > 1.0 *) LnInfinity: REAL; (* natural log of infinity *) LnSmall: REAL; (* natural log of very small number *) SqrtInfinity: REAL; (* square root of infinity *) TanhMax: REAL; (* maximum Tanh value *) t: REAL; (* internal variables *) -(* internally used support routines *) + +PROCEDURE DefaultErrorHandler(errno : INTEGER); +BEGIN err:=errno END DefaultErrorHandler; + +PROCEDURE ClearError*; +BEGIN err:=0 END ClearError; + + +(* TYPE REAL: 1/sign, 8/exponent, 23/significand *) + +PROCEDURE fraction*(x: REAL): REAL; +(* + The value of the call fraction(x) shall be the significand (or + significant) part of `x'. Hence the following relationship shall + hold: x = scale(fraction(x), exponent(x)). +*) + VAR s: SET; +BEGIN + IF x = ZERO THEN RETURN ZERO + ELSE + s := SYSTEM.VAL(SYSTEM.SET32, x) * nMask + {24..29}; + RETURN SYSTEM.VAL(REAL, s) * 2.0; + END +END fraction; + +PROCEDURE exponent*(x: REAL): INTEGER; +(* + The value of the call exponent(x) shall be the exponent value of `x' + that lies between `expoMin' and `expoMax'. An exception shall occur + and may be raised if `x' is equal to 0.0. + *) +BEGIN + IF x = ZERO THEN RETURN 0 (* NOTE: x=0.0 should raise exception *) + ELSE + RETURN SHORT(SYSTEM.LSH(SYSTEM.VAL(SYSTEM.INT32, x), -23) MOD 256) - 127 + END +END exponent; + +PROCEDURE sign*(x: REAL): REAL; +(* + The value of the call sign(x) shall be 1.0 if `x' is greater than 0.0, + or shall be -1.0 if `x' is less than 0.0, or shall be either 1.0 or + -1.0 if `x' is equal to 0.0. +*) +BEGIN + IF x < ZERO THEN RETURN -ONE ELSE RETURN ONE END +END sign; + +PROCEDURE scale*(x: REAL; n: INTEGER): REAL; +(* + The value of the call scale(x,n) shall be the value x*radix^n if such + a value exists; otherwise an execption shall occur and may be raised. +*) + VAR exp: LONGINT; lexp: SET; +BEGIN + IF x = ZERO THEN RETURN ZERO END; + exp := exponent(x) + n; (* new exponent *) + IF exp > expoMax THEN RETURN large * sign(x) (* exception raised here *) + ELSIF exp < expoMin THEN RETURN small * sign(x) (* exception here as well *) + END; + lexp := SYSTEM.VAL(SYSTEM.SET32, x) * nMask (* sign and significand *) + + SYSTEM.VAL(SYSTEM.SET32, SYSTEM.LSH(exp+expOffset, 23)); (* shifted exponent bits *) + RETURN SYSTEM.VAL(REAL, lexp) +END scale; + +PROCEDURE ulp*(x: REAL): REAL; +(* + The value of the call ulp(x) shall be the value of the corresponding + real number type equal to a unit in the last place of `x', if such a + value exists; otherwise an exception shall occur and may be raised. +*) +BEGIN + RETURN scale(ONE, exponent(x)-places+1) +END ulp; + +PROCEDURE succ*(x: REAL): REAL; +(* + The value of the call succ(x) shall be the next value of the + corresponding real number type greater than `x', if such a type + exists; otherwise an exception shall occur and may be raised. +*) +BEGIN + RETURN x+ulp(x)*sign(x) +END succ; + +PROCEDURE pred*(x: REAL): REAL; +(* + The value of the call pred(x) shall be the next value of the + corresponding real number type less than `x', if such a type exists; + otherwise an exception shall occur and may be raised. +*) +BEGIN + RETURN x-ulp(x)*sign(x) +END pred; + PROCEDURE SinCos (x, y, sign: REAL): REAL; CONST - ymax=9099; (* ENTIER(pi*2**(MantBits/2)) *) - r1=-0.1666665668E+0; - r2= 0.8333025139E-2; - r3=-0.1980741872E-3; - r4= 0.2601903036E-5; + ymax = 9099; (* ENTIER(pi * 2* * (MantBits/2)) *) + r1 = -0.1666665668E+0; + r2 = 0.8333025139E-2; + r3 = -0.1980741872E-3; + r4 = 0.2601903036E-5; VAR n: LONGINT; xn, f, g: REAL; BEGIN - IF y>=ymax THEN l.ErrorHandler(LossOfAccuracy); RETURN ZERO END; + IF y >= ymax THEN ErrorHandler(LossOfAccuracy); RETURN ZERO END; (* determine the reduced number *) - n:=ENTIER(y*piInv+HALF); xn:=n; - IF ODD(n) THEN sign:=-sign END; - x:=ABS(x); - IF x#y THEN xn:=xn-HALF END; + n := ENTIER(y * piInv + HALF); xn := n; + IF ODD(n) THEN sign := -sign END; + x := ABS(x); + IF x # y THEN xn := xn - HALF END; (* fractional part of reduced number *) - f:=SHORT(ABS(LONG(x)) - LONG(xn)*pi); + f := SHORT(ABS(LONG(x)) - LONG(xn) * pi); (* Pre: |f| <= pi/2 *) - IF ABS(f)= 0 *) CONST - P0=0.41731; P1=0.59016; + P0 = 0.41731; P1 = 0.59016; VAR xMant, yEst, z: REAL; xExp: INTEGER; BEGIN (* optimize zeros and check for illegal negative roots *) - IF x=ZERO THEN RETURN ZERO END; - IF x=LnInfinity THEN l.ErrorHandler(Overflow); RETURN huge - ELSIF x= LnInfinity THEN ErrorHandler(Overflow); RETURN large + ELSIF x < LnSmall THEN ErrorHandler(Underflow); RETURN ZERO + ELSIF ABS(x) < eps THEN RETURN ONE END; (* Decompose and scale the number *) - n:=round(ln2Inv*x); - xn:=n; g:=SHORT(LONG(x)-LONG(xn)*ln2); + n := round(ln2Inv * x); + xn := n; g := SHORT(LONG(x) - LONG(xn) * ln2); (* Calculate exp(g)/2 from "Software Manual for the Elementary Functions" *) - z:=g*g; p:=(P1*z+P0)*g; q:=Q1*z+HALF; - RETURN l.scale(HALF+p/(q-p), SHORT(n+1)) + z := g * g; p := (P1 * z + P0) * g; q := Q1 * z + HALF; + RETURN scale(HALF + p/(q - p), SHORT(n + 1)) END exp; -PROCEDURE ln*(x: REAL): REAL; +PROCEDURE ln * (x: REAL): REAL; (* Returns the natural logarithm of x for x > 0 *) CONST - c1=355.0/512.0; c2=-2.121944400546905827679E-4; - A0=-0.5527074855E+0; B0=-0.6632718214E+1; + c1 = 355.0/512.0; c2 = -2.121944400546905827679E-4; + A0 = -0.5527074855E+0; B0 = -0.6632718214E+1; VAR f, zn, zd, r, z, w, xn: REAL; n: INTEGER; BEGIN (* ensure illegal inputs are trapped and handled *) - IF x<=ZERO THEN l.ErrorHandler(IllegalLog); RETURN -huge END; + IF x <= ZERO THEN ErrorHandler(IllegalLog); RETURN -large END; (* reduce the range of the input *) - f:=l.fraction(x)*HALF; n:=l.exponent(x)+1; - IF f>sqrtHalf THEN zn:=(f-HALF)-HALF; zd:=f*HALF+HALF - ELSE zn:=f-HALF; zd:=zn*HALF+HALF; DEC(n) + f := fraction(x) * HALF; n := exponent(x) + 1; + IF f > sqrtHalf THEN zn := (f - HALF) - HALF; zd := f * HALF + HALF + ELSE zn := f - HALF; zd := zn * HALF + HALF; DEC(n) END; (* evaluate rational approximation from "Software Manual for the Elementary Functions" *) - z:=zn/zd; w:=z*z; r:=z+z*(w*A0/(w+B0)); + z := zn/zd; w := z * z; r := z + z * (w * A0/(w + B0)); (* scale the output *) - xn:=n; - RETURN (xn*c2+r)+xn*c1 + xn := n; + RETURN (xn * c2 + r) + xn * c1 END ln; (* The angle in all trigonometric functions is measured in radians *) -PROCEDURE sin*(x: REAL): REAL; +PROCEDURE sin * (x: REAL): REAL; (* Returns the sine of x for all x *) BEGIN - IF xymax THEN l.ErrorHandler(LossOfAccuracy); RETURN ZERO END; + y := ABS(x); + IF y > ymax THEN ErrorHandler(LossOfAccuracy); RETURN ZERO END; (* determine n and the fraction f *) - n:=round(x*twoByPi); xn:=n; - f:=SHORT(LONG(x)-LONG(xn)*piByTwo); + n := round(x * twoByPi); xn := n; + f := SHORT(LONG(x) - LONG(xn) * piByTwo); (* check for underflow *) - IF ABS(f)HALF THEN - i:=1-flag; - IF y>ONE THEN l.ErrorHandler(IllegalInvTrig); res:=huge; RETURN END; + y := ABS(x); + IF y > HALF THEN + i := 1 - flag; + IF y > ONE THEN ErrorHandler(IllegalInvTrig); res := large; RETURN END; (* reduce the input argument *) - g:=(ONE-y)*HALF; r:=-sqrt(g); y:=r+r; + g := (ONE-y) * HALF; r := -sqrt(g); y := r + r; (* compute approximation *) - r:=((P2*g+P1)*g)/((g+Q1)*g+Q0); - res:=y+(y*r) + r := ((P2 * g + P1) * g)/((g + Q1) * g + Q0); + res := y + (y * r) ELSE - i:=flag; - IF yONE THEN f:=ONE/f; n:=2 - ELSE n:=0 + IF f > ONE THEN f := ONE/f; n := 2 + ELSE n := 0 END; (* check if f should be scaled *) - IF f>rt32 THEN f:=(((a*f-HALF)-HALF)+f)/(rt3+f); INC(n) END; + IF f > rt32 THEN f := (((a * f - HALF) - HALF) + f)/(rt3 + f); INC(n) END; (* check for underflow *) - IF ABS(f)1 THEN res:=-res END; + IF n > 1 THEN res := -res END; CASE n OF - | 1: res:=res+piBySix - | 2: res:=res+piByTwo - | 3: res:=res+piByThree + | 1: res := res + piBySix + | 2: res := res + piByTwo + | 3: res := res + piByThree | ELSE (* do nothing *) END; RETURN res END atan; -PROCEDURE arctan*(x: REAL): REAL; - (* Returns the arctangent of x, in the range [-pi/2, pi/2] for all x *) +PROCEDURE arctan * (x: REAL): REAL; + (* Returns the arctangent of x, in the range [ - pi/2, pi/2] for all x *) BEGIN - IF x<0 THEN RETURN -atan(-x) + IF x < 0 THEN RETURN -atan( - x) ELSE RETURN atan(x) END END arctan; -PROCEDURE power*(base, exponent: REAL): REAL; +PROCEDURE power * (base, exp: REAL): REAL; (* Returns the value of the number base raised to the power exponent for base > 0 *) - CONST P1=0.83357541E-1; K=0.4426950409; - Q1=0.69314675; Q2=0.24018510; Q3=0.54360383E-1; - OneOver16=0.0625; XMAX=16*(l.expoMax+1)-1; (*XMIN=16*l.expoMin;*) XMIN=-2016; (* to make it easier for voc; -- noch *) + CONST P1 = 0.83357541E-1; K = 0.4426950409; + Q1 = 0.69314675; Q2 = 0.24018510; Q3 = 0.54360383E-1; + OneOver16 = 0.0625; + XMAX = 16 * (expoMax + 1) - 1; + (* XMIN = 16 * expoMin; *) XMIN = -2016; (* to make it easier for voc; -- noch *) VAR z, g, R, v, u2, u1, w1, w2: REAL; w: LONGREAL; m, p, i: INTEGER; mp, pp, iw1: LONGINT; BEGIN (* handle all possible error conditions *) - IF base<=ZERO THEN - IF base#ZERO THEN l.ErrorHandler(IllegalPower); base:=-base - ELSIF exponent>ZERO THEN RETURN ZERO - ELSE l.ErrorHandler(IllegalPower); RETURN huge + IF base <= ZERO THEN + IF base # ZERO THEN ErrorHandler(IllegalPower); base := -base + ELSIF exp > ZERO THEN RETURN ZERO + ELSE ErrorHandler(IllegalPower); RETURN large END END; (* extract the exponent of base to m and clear exponent of base in g *) - g:=l.fraction(base)*HALF; m:=l.exponent(base)+1; + g := fraction(base) * HALF; + m := exponent(base) + 1; (* determine p table offset with an unrolled binary search *) - p:=1; - IF g<=a1[9] THEN p:=9 END; - IF g<=a1[p+4] THEN INC(p, 4) END; - IF g<=a1[p+2] THEN INC(p, 2) END; + p := 1; + IF g <= a1[9] THEN p := 9 END; + IF g <= a1[p + 4] THEN INC(p, 4) END; + IF g <= a1[p + 2] THEN INC(p, 2) END; (* compute scaled z so that |z| <= 0.044 *) - z:=((g-a1[p+1])-a2[(p+1) DIV 2])/(g+a1[p+1]); z:=z+z; + z := ((g - a1[p + 1]) - a2[(p + 1) DIV 2])/(g + a1[p + 1]); z := z + z; (* approximation for log2(z) from "Software Manual for the Elementary Functions" *) - v:=z*z; R:=P1*v*z; R:=R+K*R; u2:=(R+z*K)+z; - u1:=(m*16-p)*OneOver16; w:=LONG(exponent)*(LONG(u1)+LONG(u2)); (* need extra precision *) + v := z * z; R := P1 * v*z; R := R + K * R; u2 := (R + z * K) + z; + u1 := (m * 16 - p) * OneOver16; w := LONG(exp) * (LONG(u1) + LONG(u2)); (* need extra precision *) (* calculations below were modified to work properly -- incorrect in cited reference? *) - iw1:=ENTIER(16*w); w1:=iw1*OneOver16; w2:=SHORT(w-w1); + iw1 := ENTIER(16 * w); w1 := iw1 * OneOver16; w2 := SHORT(w - w1); (* check for overflow/underflow *) - IF iw1>XMAX THEN l.ErrorHandler(Overflow); RETURN huge - ELSIF iw1 XMAX THEN ErrorHandler(Overflow); RETURN large + ELSIF iw1 < XMIN THEN ErrorHandler(Underflow); RETURN ZERO END; - (* final approximation 2**w2-1 where -0.0625 <= w2 <= 0 *) - IF w2>ZERO THEN INC(iw1); w2:=w2-OneOver16 END; IF iw1<0 THEN i:=0 ELSE i:=1 END; - mp:=div(iw1, 16)+i; pp:=16*mp-iw1; z:=((Q3*w2+Q2)*w2+Q1)*w2; z:=a1[pp+1]+a1[pp+1]*z; - RETURN l.scale(z, SHORT(mp)) + (* final approximation 2 * *w2 - 1 where -0.0625 <= w2 <= 0 *) + IF w2 > ZERO THEN INC(iw1); w2 := w2 - OneOver16 END; + IF iw1 < 0 THEN i := 0 ELSE i := 1 END; + mp := div(iw1, 16) + i; pp := 16 * mp - iw1; + z := ((Q3 * w2 + Q2) * w2 + Q1) * w2; + z := a1[pp + 1] + a1[pp + 1] * z; + RETURN scale(z, SHORT(mp)) END power; -PROCEDURE IsRMathException*(): BOOLEAN; +PROCEDURE IsRMathException * (): BOOLEAN; (* Returns TRUE if the current coroutine is in the exceptional execution state because of the raising of the RealMath exception; otherwise returns FALSE. *) @@ -403,14 +572,14 @@ END IsRMathException; Following routines are provided as extensions to the ISO standard. They are either used as the basis of other functions or provide useful functions which are not part of the ISO standard. -*) + *) PROCEDURE log* (x, base: REAL): REAL; (* log(x,base) is the logarithm of x base 'base'. All positive arguments are allowed but base > 0 and base # 1 *) BEGIN (* log(x, base) = ln(x) / ln(base) *) - IF base<=ZERO THEN l.ErrorHandler(IllegalLogBase); RETURN -huge + IF base <= ZERO THEN ErrorHandler(IllegalLogBase); RETURN -large ELSE RETURN ln(x)/ln(base) END END log; @@ -421,29 +590,29 @@ PROCEDURE ipower* (x: REAL; base: INTEGER): REAL; PROCEDURE Adjust(xadj: REAL): REAL; BEGIN - IF (x0 THEN RETURN ZERO ELSE l.ErrorHandler(Overflow); RETURN Adjust(huge) END + IF base = 0 THEN RETURN ONE (* x * *0 = 1 *) + ELSIF ABS(x) < miny THEN + IF base > 0 THEN RETURN ZERO ELSE ErrorHandler(Overflow); RETURN Adjust(large) END END; (* trap potential overflows and underflows *) - Exp:=(l.exponent(x)+1)*base; y:=LnInfinity*ln2Inv; - IF Exp>y THEN l.ErrorHandler(Overflow); RETURN Adjust(huge) - ELSIF Exp<-y THEN RETURN ZERO + Exp := (exponent(x) + 1) * base; y := LnInfinity * ln2Inv; + IF Exp > y THEN ErrorHandler(Overflow); RETURN Adjust(large) + ELSIF Exp< - y THEN RETURN ZERO END; - (* compute x**base using an optimised algorithm from Knuth, slightly + (* compute x * *base using an optimised algorithm from Knuth, slightly altered : p442, The Art Of Computer Programming, Vol 2 *) - y:=ONE; IF base<0 THEN neg:=TRUE; base := -base ELSE neg:= FALSE END; + y := ONE; IF base < 0 THEN neg := TRUE; base := -base ELSE neg:= FALSE END; LOOP - IF ODD(base) THEN y:=y*x END; - base:=base DIV 2; IF base=0 THEN EXIT END; - x:=x*x; + IF ODD(base) THEN y := y * x END; + base := base DIV 2; IF base = 0 THEN EXIT END; + x := x * x; END; IF neg THEN RETURN ONE/y ELSE RETURN y END END ipower; @@ -451,34 +620,34 @@ END ipower; PROCEDURE sincos* (x: REAL; VAR Sin, Cos: REAL); (* More efficient sin/cos implementation if both values are needed. *) BEGIN - Sin:=sin(x); Cos:=sqrt(ONE-Sin*Sin) + Sin := sin(x); Cos := sqrt(ONE-Sin * Sin) END sincos; PROCEDURE arctan2* (xn, xd: REAL): REAL; -(* arctan2(xn,xd) is the quadrant-correct arc tangent atan(xn/xd). If the +(* arctan2(xn,xd) is the quadrant - correct arc tangent atan(xn/xd). If the denominator xd is zero, then the numerator xn must not be zero. All arguments are legal except xn = xd = 0. *) VAR res: REAL; xpdiff: LONGINT; BEGIN (* check for error conditions *) - IF xd=ZERO THEN - IF xn=ZERO THEN l.ErrorHandler(IllegalTrig); RETURN ZERO - ELSIF xn<0 THEN RETURN -piByTwo + IF xd = ZERO THEN + IF xn = ZERO THEN ErrorHandler(IllegalTrig); RETURN ZERO + ELSIF xn < 0 THEN RETURN -piByTwo ELSE RETURN piByTwo END; ELSE - xpdiff:=l.exponent(xn)-l.exponent(xd); - IF ABS(xpdiff)>=l.expoMax-3 THEN + xpdiff := exponent(xn) - exponent(xd); + IF ABS(xpdiff) >= expoMax - 3 THEN (* overflow detected *) - IF xn<0 THEN RETURN -piByTwo + IF xn < 0 THEN RETURN -piByTwo ELSE RETURN piByTwo END ELSE - res:=ABS(xn/xd); - IF res#ZERO THEN res:=atan(res) END; - IF xdLnInfinity THEN (* handle exp overflows *) - y:=y-lnv; - IF y>LnInfinity-lnv+0.69 THEN l.ErrorHandler(Overflow); - IF x>ZERO THEN RETURN huge ELSE RETURN -huge END - ELSE f:=exp(y); f:=f+f*vbytwo (* don't change to f(1+vbytwo) *) + f := y * y; y := f * ((f * P1 + P0)/(f + Q0)); RETURN x + x * y + ELSIF y > LnInfinity THEN (* handle exp overflows *) + y := y - lnv; + IF y > LnInfinity - lnv + 0.69 THEN ErrorHandler(Overflow); + IF x > ZERO THEN RETURN large ELSE RETURN -large END + ELSE f := exp(y); f := f + f * vbytwo (* don't change to f(1 + vbytwo) *) END - ELSE f:=exp(y); f:=(f-ONE/f)*HALF + ELSE f := exp(y); f := (f - ONE/f) * HALF END; - (* reach here when 1 < ABS(x) < LnInfinity-lnv+0.69 *) - IF x>ZERO THEN RETURN f ELSE RETURN -f END + (* reach here when 1 < ABS(x) < LnInfinity - lnv + 0.69 *) + IF x > ZERO THEN RETURN f ELSE RETURN -f END END sinh; PROCEDURE cosh* (x: REAL): REAL; (* cosh(x) is the hyperbolic cosine of x. The argument x must not be so large that exp(|x|) overflows. *) VAR y, f: REAL; -BEGIN y:=ABS(x); - IF y>LnInfinity THEN (* handle exp overflows *) - y:=y-lnv; - IF y>LnInfinity-lnv+0.69 THEN l.ErrorHandler(Overflow); - IF x>ZERO THEN RETURN huge ELSE RETURN -huge END - ELSE f:=exp(y); RETURN f+f*vbytwo (* don't change to f(1+vbytwo) *) +BEGIN y := ABS(x); + IF y > LnInfinity THEN (* handle exp overflows *) + y := y - lnv; + IF y > LnInfinity - lnv + 0.69 THEN ErrorHandler(Overflow); + IF x > ZERO THEN RETURN large ELSE RETURN -large END + ELSE f := exp(y); RETURN f + f * vbytwo (* don't change to f(1 + vbytwo) *) END - ELSE f:=exp(y); RETURN (f+ONE/f)*HALF + ELSE f := exp(y); RETURN (f + ONE/f) * HALF END END cosh; PROCEDURE tanh* (x: REAL): REAL; (* tanh(x) is the hyperbolic tangent of x. All arguments are legal. *) - CONST P0=-0.8237728127; P1=-0.3831010665E-2; Q0=2.471319654; ln3over2=0.5493061443; - BIG=9.010913347; (* (ln(2)+(t+1)*ln(B))/2 where t=mantissa bits, B=base *) + CONST P0 = -0.8237728127; P1 = -0.3831010665E-2; Q0 = 2.471319654; ln3over2 = 0.5493061443; + BIG = 9.010913347; (* (ln(2) + (t + 1) * ln(B))/2 where t = mantissa bits, B = base *) VAR f, t: REAL; -BEGIN f:=ABS(x); - IF f>BIG THEN t:=ONE - ELSIF f>ln3over2 THEN t:=ONE-TWO/(exp(TWO*f)+ONE) - ELSIF f BIG THEN t := ONE + ELSIF f > ln3over2 THEN t := ONE - TWO/(exp(TWO * f) + ONE) + ELSIF f < Limit THEN t := f ELSE (* approximation from "Software Manual for the Elementary Functions" *) - t:=f*f; t:=t*(P1*t+P0)/(t+Q0); t:=f+f*t + t := f * f; t := t * (P1 * t + P0)/(t + Q0); t := f + f * t END; - IF xSqrtInfinity*HALF THEN l.ErrorHandler(HypInvTrigClipped); - IF x>ZERO THEN RETURN ln(SqrtInfinity) ELSE RETURN -ln(SqrtInfinity) END; - ELSIF x SqrtInfinity * HALF THEN ErrorHandler(HypInvTrigClipped); + IF x > ZERO THEN RETURN ln(SqrtInfinity) ELSE RETURN -ln(SqrtInfinity) END; + ELSIF x < ZERO THEN RETURN -ln( - x + sqrt(x * x + ONE)) + ELSE RETURN ln(x + sqrt(x * x + ONE)) END END arcsinh; @@ -553,9 +722,9 @@ PROCEDURE arccosh* (x: REAL): REAL; (* arccosh(x) is the arc hyperbolic cosine of x. All arguments greater than or equal to 1 are legal. *) BEGIN - IF xSqrtInfinity*HALF THEN l.ErrorHandler(HypInvTrigClipped); RETURN ln(SqrtInfinity) - ELSE RETURN ln(x+sqrt(x*x-ONE)) + IF x < ONE THEN ErrorHandler(IllegalHypInvTrig); RETURN ZERO + ELSIF x > SqrtInfinity * HALF THEN ErrorHandler(HypInvTrigClipped); RETURN ln(SqrtInfinity) + ELSE RETURN ln(x + sqrt(x * x - ONE)) END END arccosh; @@ -563,14 +732,14 @@ PROCEDURE arctanh* (x: REAL): REAL; (* arctanh(x) is the arc hyperbolic tangent of x. |x| < 1 - sqrt(em), where em is machine epsilon. Note that |x| must not be so close to 1 that the result is less accurate than half precision. *) - CONST TanhLimit=0.999984991; (* Tanh(5.9) *) + CONST TanhLimit = 0.999984991; (* Tanh(5.9) *) VAR t: REAL; -BEGIN t:=ABS(x); - IF (t>=ONE) OR (t>(ONE-TWO*em)) THEN l.ErrorHandler(IllegalHypInvTrig); - IF xTanhLimit THEN l.ErrorHandler(LossOfAccuracy) +BEGIN t := ABS(x); + IF (t >= ONE) OR (t > (ONE - TWO * em)) THEN ErrorHandler(IllegalHypInvTrig); + IF x < ZERO THEN RETURN -TanhMax ELSE RETURN TanhMax END + ELSIF t > TanhLimit THEN ErrorHandler(LossOfAccuracy) END; - RETURN arcsinh(x/sqrt(ONE-x*x)) + RETURN arcsinh(x/sqrt(ONE - x * x)) END arctanh; PROCEDURE ToREAL(h: HUGEINT): REAL; @@ -578,14 +747,17 @@ BEGIN RETURN SYSTEM.VAL(REAL, h) END ToREAL; BEGIN - (* determine some fundamental constants used by hyperbolic trig functions *) - em:=l.ulp(ONE); - LnInfinity:=ln(huge); - LnSmall:=ln(miny); - SqrtInfinity:=sqrt(huge); - t:=l.pred(ONE)/sqrt(em); TanhMax:=ln(t+sqrt(t*t+ONE)); + ErrorHandler := DefaultErrorHandler; - (* initialize some tables for the power() function a1[i]=2**((1-i)/16) *) + (* determine fundamental constants used by hyperbolic trig functions *) + em := ulp(ONE); + LnInfinity := ln(large); + LnSmall := ln(miny); + SqrtInfinity := sqrt(large); + t := pred(ONE)/sqrt(em); + TanhMax := ln(t + sqrt(t * t + ONE)); + + (* initialize tables for the power() function a1[i] = 2 * *((1 - i)/16) *) a1[1] := ONE; a1[2] := ToREAL(3F75257DH); a1[3] := ToREAL(3F6AC0C7H); @@ -604,7 +776,7 @@ BEGIN a1[16] := ToREAL(3F05AAC3H); a1[17] := HALF; - (* a2[i]=2**[(1-2i)/16] - a1[2i]; delta resolution *) + (* a2[i] = 2 * *[(1 - 2i)/16] - a1[2i]; delta resolution *) a2[1] := ToREAL(31A92436H); a2[2] := ToREAL(336C2A95H); a2[3] := ToREAL(31A8FC24H); @@ -613,4 +785,4 @@ BEGIN a2[6] := ToREAL(32C12342H); a2[7] := ToREAL(32E75624H); a2[8] := ToREAL(32CF9890H) -END oocRealMath. +END Math. diff --git a/src/tools/make/oberon.mk b/src/tools/make/oberon.mk index d4abd1e3..6ad77214 100644 --- a/src/tools/make/oberon.mk +++ b/src/tools/make/oberon.mk @@ -199,11 +199,9 @@ runtime: cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Modules.Mod cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Strings.Mod cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Files.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Reals.Mod -# cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/LowReal.Mod -# cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Math.Mod -# cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/LowLReal.Mod + cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Math.Mod # cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/MathL.Mod + cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Reals.Mod cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Texts.Mod cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Oberon.Mod @printf "\nMaking lib$(ONAME)$(MODEL)\n"