Update to Inform v6.41
[inform.git] / src / lexer.c
index 58841268af2ebfd495b5d6f86ea75573a5041081..63cafbcd4a41747c9197193b8b84ab5c38d3ab04 100644 (file)
@@ -1,7 +1,7 @@
 /* ------------------------------------------------------------------------- */
 /*   "lexer" : Lexical analyser                                              */
 /*                                                                           */
-/*   Part of Inform 6.40                                                     */
+/*   Part of Inform 6.41                                                     */
 /*   copyright (c) Graham Nelson 1993 - 2022                                 */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
@@ -409,7 +409,7 @@ extern void describe_token_triple(const char *text, int32 value, int type)
 
 /* This must exceed the total number of keywords across all groups, 
    including opcodes. */
-#define MAX_KEYWORDS (350)
+#define MAX_KEYWORDS (500)
 
 /* The values will be filled in at compile time, when we know
    which opcode set to use. */
@@ -463,12 +463,17 @@ static char *opcode_list_g[] = {
     "streamunichar",
     "mzero", "mcopy", "malloc", "mfree",
     "accelfunc", "accelparam",
+    "hasundo", "discardundo",
     "numtof", "ftonumz", "ftonumn", "ceil", "floor",
     "fadd", "fsub", "fmul", "fdiv", "fmod",
     "sqrt", "exp", "log", "pow",
     "sin", "cos", "tan", "asin", "acos", "atan", "atan2",
     "jfeq", "jfne", "jflt", "jfle", "jfgt", "jfge", "jisnan", "jisinf",
-    "hasundo", "discardundo",
+    "numtod", "dtonumz", "dtonumn", "ftod", "dtof", "dceil", "dfloor",
+    "dadd", "dsub", "dmul", "ddiv", "dmodr", "dmodq",
+    "dsqrt", "dexp", "dlog", "dpow",
+    "dsin", "dcos", "dtan", "dasin", "dacos", "datan", "datan2",
+    "jdeq", "jdne", "jdlt", "jdle", "jdgt", "jdge", "jdisnan", "jdisinf",
     ""
 };
 
@@ -480,7 +485,7 @@ keyword_group opcode_macros =
 static char *opmacro_list_z[] = { "" };
 
 static char *opmacro_list_g[] = {
-    "pull", "push",
+    "pull", "push", "dload", "dstore",
     ""
 };
 
@@ -1212,9 +1217,10 @@ static double pow10_cheap(int expo)
  * lexer should never do that).
  *
  * Note that using a float constant does *not* set the uses_float_features
- * flag (which would cause the game file to be labelled 3.1.2). There's
- * no VM feature here, just an integer. Of course, any use of the float
- * *opcodes* will set the flag.
+ * flag (which would cause the game file to be labelled 3.1.2). Same with 
+ * double constants and the uses_double_features flag. There's no VM
+ * feature here, just an integer. Of course, any use of the float *opcodes*
+ * will set the flag.
  *
  * The math functions in this routine require #including <math.h>, but
  * they should not require linking the math library (-lm). At least,
@@ -1272,9 +1278,93 @@ static int32 construct_float(int signbit, double intv, double fracv, int expo)
         }
     }
 
+    /* At this point, expo is less than 2^8; fbits is less than 2^23; neither is negative. */
     return (sign) | ((int32)(expo << 23)) | (fbits);
 }
 
+/* Same as the above, but we return *half* of a 64-bit double, depending on whether wanthigh is true (high half) or false (low half).
+ */
+static int32 construct_double(int wanthigh, int signbit, double intv, double fracv, int expo)
+{
+    double absval = (intv + fracv) * pow10_cheap(expo);
+    int32 sign = (signbit ? 0x80000000 : 0x0);
+    double mant;
+    uint32 fhi, flo;
+    if (isinf(absval)) {
+        goto Infinity;
+    }
+    if (isnan(absval)) {
+        goto NotANumber;
+    }
+
+    mant = frexp(absval, &expo);
+
+    /* Normalize mantissa to be in the range [1.0, 2.0) */
+    if (0.5 <= mant && mant < 1.0) {
+        mant *= 2.0;
+        expo--;
+    }
+    else if (mant == 0.0) {
+        expo = 0;
+    }
+    else {
+        goto Infinity;
+    }
+
+    if (expo >= 1024) {
+        goto Infinity;
+    }
+    else if (expo < -1022) {
+        /* Denormalized (very small) number */
+        mant = ldexp(mant, 1022 + expo);
+        expo = 0;
+    }
+    else if (!(expo == 0 && mant == 0.0)) {
+        expo += 1023;
+        mant -= 1.0; /* Get rid of leading 1 */
+    }
+
+    /* fhi receives the high 28 bits; flo the low 24 bits (total 52 bits) */
+    mant *= 268435456.0;          /* 2^28 */
+    fhi = (uint32)mant;           /* Truncate */
+    mant -= (double)fhi;
+    mant *= 16777216.0;           /* 2^24 */
+    flo = (uint32)(mant+0.5);     /* Round */
+    
+    if (flo >> 24) {
+        /* The carry propagated out of a string of 24 1 bits. */
+        flo = 0;
+        fhi++;
+        if (fhi >> 28) {
+            /* And it also propagated out of the next 28 bits. */
+            fhi = 0;
+            expo++;
+            if (expo >= 2047) {
+                goto Infinity;
+            }
+        }
+    }
+
+    /* At this point, expo is less than 2^11; fhi is less than 2^28; flo is less than 2^24; none are negative. */
+    if (wanthigh)
+        return (sign) | ((int32)(expo << 20)) | ((int32)(fhi >> 8));
+    else
+        return (int32)((fhi & 0xFF) << 24) | (int32)(flo);
+
+ Infinity:
+    if (wanthigh)
+        return sign | 0x7FF00000;
+    else
+        return 0x00000000;
+    
+ NotANumber:
+    if (wanthigh)
+        return sign | 0x7FF80000;
+    else
+        return 0x00000001;
+}
+
 /* ------------------------------------------------------------------------- */
 /*   Characters are read via a "pipeline" of variables, allowing us to look  */
 /*       up to three characters ahead of the current position.               */
@@ -1606,6 +1696,7 @@ static void lexadds(char *str)
 
 extern void get_next_token(void)
 {   int d, i, j, k, quoted_size, e, radix, context; int32 n; char *r;
+    int floatend;
     int returning_a_put_back_token = TRUE;
     
     context = lexical_context();
@@ -1692,6 +1783,9 @@ extern void get_next_token(void)
             break;
 
             FloatNumber:
+            /* When we reach here, d is the sign bit ('+' or '-').
+               If we're constructing a 32-bit float, floatend is 0;
+               for a 64-bit double, floatend is '>' for high, '<' for low. */
             {   int expo=0; double intv=0, fracv=0;
                 int expocount=0, intcount=0, fraccount=0;
                 int signbit = (d == '-');
@@ -1735,7 +1829,12 @@ extern void get_next_token(void)
                 }
                 if (intcount + fraccount == 0)
                     error("Floating-point literal must have digits");
-                n = construct_float(signbit, intv, fracv, expo);
+                if (floatend == '>')
+                    n = construct_double(TRUE, signbit, intv, fracv, expo);
+                else if (floatend == '<')
+                    n = construct_double(FALSE, signbit, intv, fracv, expo);
+                else                    
+                    n = construct_float(signbit, intv, fracv, expo);
             }
             lexaddc(0);
             circle[circle_position].type = NUMBER_TT;
@@ -1745,7 +1844,18 @@ extern void get_next_token(void)
 
         case RADIX_CODE:
             radix = 16; d = (*get_next_char)();
-            if (d == '-' || d == '+') { goto FloatNumber; }
+            if (d == '-' || d == '+') {
+                floatend = 0;
+                goto FloatNumber;
+            }
+            if (d == '<' || d == '>') {
+                floatend = d;
+                d = (*get_next_char)();
+                if (d == '-' || d == '+') {
+                    goto FloatNumber;
+                }
+                error("Signed number expected after '$<' or '$>'");
+            }
             if (d == '$') { d = (*get_next_char)(); radix = 2; }
             if (character_digit_value[d] >= radix)
             {   if (radix == 2)