Update to Inform v6.41 v6.41
authorJason Self <j@jxself.org>
Wed, 10 Aug 2022 03:22:58 +0000 (20:22 -0700)
committerJason Self <j@jxself.org>
Wed, 10 Aug 2022 03:22:58 +0000 (20:22 -0700)
Commit f57b6841b5a8235dad798b024f3e78a424ffa36d dated July 22 2022.
These changes are similiarly relicensed to GPL per Section 4(c)(ii) of
the Artistic License 2.0.

22 files changed:
src/arrays.c
src/asm.c
src/bpatch.c
src/chars.c
src/directs.c
src/errors.c
src/expressc.c
src/expressp.c
src/files.c
src/header.h
src/inform.c
src/lexer.c
src/linker.c [deleted file]
src/memory.c
src/objects.c
src/states.c
src/symbols.c
src/syntax.c
src/tables.c
src/text.c
src/veneer.c
src/verbs.c

index 320287b3c0c5fef909acd4f0355a26c5fd3cff3e..c48cc65dfbf85fc7ed2f57a29b59ba8a23e78094 100644 (file)
@@ -3,7 +3,7 @@
 /*               likewise global variables, which are in some ways a         */
 /*               simpler form of the same thing.                             */
 /*                                                                           */
-/*   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            */
@@ -254,9 +254,7 @@ extern void array_entry(int32 i, int is_static, assembly_operand VAL)
 /* ------------------------------------------------------------------------- */
 /*   Global and Array directives.                                            */
 /*                                                                           */
-/*      Global <variablename> |                                              */
-/*                            | = <value>                                    */
-/*                            | <array specification>                        */
+/*      Global <variablename> [ [=] <value> ]                                */
 /*                                                                           */
 /*      Array <arrayname> [static] <array specification>                     */
 /*                                                                           */
@@ -274,8 +272,8 @@ extern void array_entry(int32 i, int is_static, assembly_operand VAL)
 
 extern void set_variable_value(int i, int32 v)
 {
-    /* This can be called during module-load to create a new global,
-       so we call ensure. */
+    /* This isn't currently called to create a new global, but it has
+       been used that way within living memory. So we call ensure. */
     ensure_memory_list_available(&global_initial_value_memlist, i+1);
     global_initial_value[i]=v;
 }
@@ -288,20 +286,13 @@ extern void set_variable_value(int i, int32 v)
 #define ASCII_AI        2
 #define BRACKET_AI      3
 
-extern void make_global(int array_flag, int name_only)
+extern void make_global()
 {
-    /*  array_flag is TRUE for an Array directive, FALSE for a Global;
-        name_only is only TRUE for parsing an imported variable name, so
-        array_flag is always FALSE in that case.                             */
-
     int32 i;
     int name_length;
-    int array_type, data_type;
-    int is_static = FALSE;
     assembly_operand AO;
-    
-    int extraspace;
 
+    int32 globalnum;
     int32 global_symbol;
     debug_location_beginning beginning_debug_location =
         get_token_location_beginning();
@@ -317,98 +308,71 @@ extern void make_global(int array_flag, int name_only)
 
     if (!glulx_mode) {
         if ((token_type==SYMBOL_TT) && (symbols[i].type==GLOBAL_VARIABLE_T)
-            && (symbols[i].value >= LOWEST_SYSTEM_VAR_NUMBER))
+            && (symbols[i].value >= LOWEST_SYSTEM_VAR_NUMBER)) {
+            globalnum = symbols[i].value - MAX_LOCAL_VARIABLES;
             goto RedefinitionOfSystemVar;
+        }
     }
     else {
-        if ((token_type==SYMBOL_TT) && (symbols[i].type==GLOBAL_VARIABLE_T))
+        if ((token_type==SYMBOL_TT) && (symbols[i].type==GLOBAL_VARIABLE_T)) {
+            globalnum = symbols[i].value - MAX_LOCAL_VARIABLES;
             goto RedefinitionOfSystemVar;
+        }
     }
 
     if (token_type != SYMBOL_TT)
     {   discard_token_location(beginning_debug_location);
-        if (array_flag)
-            ebf_error("new array name", token_text);
-        else ebf_error("new global variable name", token_text);
+        ebf_error("new global variable name", token_text);
         panic_mode_error_recovery(); return;
     }
 
     if (!(symbols[i].flags & UNKNOWN_SFLAG))
     {   discard_token_location(beginning_debug_location);
-        if (array_flag)
-            ebf_symbol_error("new array name", token_text, typename(symbols[i].type), symbols[i].line);
-        else ebf_symbol_error("new global variable name", token_text, typename(symbols[i].type), symbols[i].line);
+        ebf_symbol_error("new global variable name", token_text, typename(symbols[i].type), symbols[i].line);
         panic_mode_error_recovery(); return;
     }
 
-    if ((!array_flag) && (symbols[i].flags & USED_SFLAG))
+    if (symbols[i].flags & USED_SFLAG)
         error_named("Variable must be defined before use:", token_text);
 
     directive_keywords.enabled = TRUE;
     get_next_token();
     directive_keywords.enabled = FALSE;
     if ((token_type==DIR_KEYWORD_TT)&&(token_value==STATIC_DK)) {
-        if (array_flag) {
-            is_static = TRUE;
-        }
-        else {
-            error("Global variables cannot be static");
-        }
+        error("Global variables cannot be static");
     }
     else {
         put_token_back();
     }
     
-    if (array_flag)
-    {   if (!is_static) {
-            assign_symbol(i, dynamic_array_area_size, ARRAY_T);
-        }
-        else {
-            assign_symbol(i, static_array_area_size, STATIC_ARRAY_T);
-        }
-        ensure_memory_list_available(&arrays_memlist, no_arrays+1);
-        arrays[no_arrays].symbol = i;
-    }
-    else
-    {   if (!glulx_mode && no_globals==233)
-        {   discard_token_location(beginning_debug_location);
-            error("All 233 global variables already declared");
-            panic_mode_error_recovery();
-            return;
-        }
-        
-        ensure_memory_list_available(&variables_memlist, MAX_LOCAL_VARIABLES+no_globals+1);
-        variables[MAX_LOCAL_VARIABLES+no_globals].token = i;
-        variables[MAX_LOCAL_VARIABLES+no_globals].usage = FALSE;
-        assign_symbol(i, MAX_LOCAL_VARIABLES+no_globals, GLOBAL_VARIABLE_T);
-
-        if (name_only) {
-            import_symbol(i);
-        }
-        else {
-            ensure_memory_list_available(&global_initial_value_memlist, no_globals+1);
-            global_initial_value[no_globals++]=0;
-        }
+    if (!glulx_mode && no_globals==233)
+    {   discard_token_location(beginning_debug_location);
+        error("All 233 global variables already declared");
+        panic_mode_error_recovery();
+        return;
     }
 
+    globalnum = no_globals;
+    
+    ensure_memory_list_available(&variables_memlist, MAX_LOCAL_VARIABLES+no_globals+1);
+    variables[MAX_LOCAL_VARIABLES+no_globals].token = i;
+    variables[MAX_LOCAL_VARIABLES+no_globals].usage = FALSE;
+    assign_symbol(i, MAX_LOCAL_VARIABLES+no_globals, GLOBAL_VARIABLE_T);
+
+    ensure_memory_list_available(&global_initial_value_memlist, no_globals+1);
+    global_initial_value[no_globals++]=0;
+
     directive_keywords.enabled = TRUE;
 
     RedefinitionOfSystemVar:
 
-    if (name_only)
-    {   discard_token_location(beginning_debug_location);
-        return;
-    }
-
     get_next_token();
 
     if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
-    {   if (array_flag)
-        {   discard_token_location(beginning_debug_location);
-            ebf_error("array definition", token_text);
-        }
+    {
+        /* No initial value. */
         put_token_back();
-        if (debugfile_switch && !array_flag)
+        if (debugfile_switch)
         {
             char *global_name = current_array_name.data;
             debug_file_printf("<global-variable>");
@@ -423,64 +387,124 @@ extern void make_global(int array_flag, int name_only)
         return;
     }
 
-    if (!array_flag)
+    if (((token_type==SEP_TT)&&(token_value==ARROW_SEP))
+        || ((token_type==SEP_TT)&&(token_value==DARROW_SEP))
+        || ((token_type==DIR_KEYWORD_TT)&&(token_value==STRING_DK))
+        || ((token_type==DIR_KEYWORD_TT)&&(token_value==TABLE_DK))
+        || ((token_type==DIR_KEYWORD_TT)&&(token_value==BUFFER_DK)))
     {
-        /* is_static is always false in this case */
-        if ((token_type == SEP_TT) && (token_value == SETEQUALS_SEP))
-        {   AO = parse_expression(CONSTANT_CONTEXT);
-            if (!glulx_mode) {
-                if (AO.marker != 0)
-                    backpatch_zmachine(AO.marker, DYNAMIC_ARRAY_ZA,
-                        2*(no_globals-1));
-            }
-            else {
-            if (AO.marker != 0)
-                backpatch_zmachine(AO.marker, GLOBALVAR_ZA,
-                4*(no_globals-1));
-            }
-            global_initial_value[no_globals-1] = AO.value;
-            if (debugfile_switch)
-            {
-                char *global_name = current_array_name.data;
-                debug_file_printf("<global-variable>");
-                debug_file_printf("<identifier>%s</identifier>", global_name);
-                debug_file_printf("<address>");
-                write_debug_global_backpatch(symbols[global_symbol].value);
-                debug_file_printf("</address>");
-                write_debug_locations
-                    (get_token_location_end(beginning_debug_location));
-                debug_file_printf("</global-variable>");
-            }
-            return;
-        }
+        error("use 'Array' to define arrays, not 'Global'");
+        return;
+    }
 
-        obsolete_warning("more modern to use 'Array', not 'Global'");
+    /* Skip "=" if present. */
+    if (!((token_type == SEP_TT) && (token_value == SETEQUALS_SEP)))
+        put_token_back();
 
-        if (!glulx_mode) {
-            backpatch_zmachine(ARRAY_MV, DYNAMIC_ARRAY_ZA, 2*(no_globals-1));
-            global_initial_value[no_globals-1]
-                = dynamic_array_area_size+variables_offset;
-        }
-        else {
-            backpatch_zmachine(ARRAY_MV, GLOBALVAR_ZA, 4*(no_globals-1));
-            global_initial_value[no_globals-1]
-                = dynamic_array_area_size;
-        }
+    AO = parse_expression(CONSTANT_CONTEXT);
+    if (!glulx_mode) {
+        if (AO.marker != 0)
+            backpatch_zmachine(AO.marker, DYNAMIC_ARRAY_ZA,
+                2*globalnum);
+    }
+    else {
+        if (AO.marker != 0)
+            backpatch_zmachine(AO.marker, GLOBALVAR_ZA,
+                4*globalnum);
+    }
+    
+    if (globalnum < 0 || globalnum >= global_initial_value_memlist.count)
+        compiler_error("Globalnum out of range");
+    global_initial_value[globalnum] = AO.value;
+    
+    if (debugfile_switch)
+    {
+        char *global_name = current_array_name.data;
+        debug_file_printf("<global-variable>");
+        debug_file_printf("<identifier>%s</identifier>", global_name);
+        debug_file_printf("<address>");
+        write_debug_global_backpatch(symbols[global_symbol].value);
+        debug_file_printf("</address>");
+        write_debug_locations
+            (get_token_location_end(beginning_debug_location));
+        debug_file_printf("</global-variable>");
+    }
+}
+
+extern void make_array()
+{
+    int32 i;
+    int name_length;
+    int array_type, data_type;
+    int is_static = FALSE;
+    assembly_operand AO;
+    
+    int extraspace;
+
+    int32 global_symbol;
+    debug_location_beginning beginning_debug_location =
+        get_token_location_beginning();
+
+    directive_keywords.enabled = FALSE;
+    get_next_token();
+    i = token_value;
+    global_symbol = i;
+    
+    name_length = strlen(token_text) + 1;
+    ensure_memory_list_available(&current_array_name, name_length);
+    strncpy(current_array_name.data, token_text, name_length);
+
+    if (token_type != SYMBOL_TT)
+    {   discard_token_location(beginning_debug_location);
+        ebf_error("new array name", token_text);
+        panic_mode_error_recovery(); return;
+    }
+
+    if (!(symbols[i].flags & UNKNOWN_SFLAG))
+    {   discard_token_location(beginning_debug_location);
+        ebf_symbol_error("new array name", token_text, typename(symbols[i].type), symbols[i].line);
+        panic_mode_error_recovery(); return;
+    }
+
+    directive_keywords.enabled = TRUE;
+    get_next_token();
+    directive_keywords.enabled = FALSE;
+    if ((token_type==DIR_KEYWORD_TT)&&(token_value==STATIC_DK)) {
+        is_static = TRUE;
+    }
+    else {
+        put_token_back();
+    }
+    
+    if (!is_static) {
+        assign_symbol(i, dynamic_array_area_size, ARRAY_T);
+    }
+    else {
+        assign_symbol(i, static_array_area_size, STATIC_ARRAY_T);
+    }
+    ensure_memory_list_available(&arrays_memlist, no_arrays+1);
+    arrays[no_arrays].symbol = i;
+
+    directive_keywords.enabled = TRUE;
+
+    get_next_token();
+
+    if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+    {
+        discard_token_location(beginning_debug_location);
+        ebf_error("array definition", token_text);
+        put_token_back();
+        return;
     }
 
     array_type = BYTE_ARRAY; data_type = UNSPECIFIED_AI;
 
-         if ((!array_flag) &&
-             ((token_type==DIR_KEYWORD_TT)&&(token_value==DATA_DK)))
-                 data_type=NULLS_AI;
-    else if ((!array_flag) &&
-             ((token_type==DIR_KEYWORD_TT)&&(token_value==INITIAL_DK)))
-                 data_type=DATA_AI;
-    else if ((!array_flag) &&
-             ((token_type==DIR_KEYWORD_TT)&&(token_value==INITSTR_DK)))
-                 data_type=ASCII_AI;
-
-    else if ((token_type==SEP_TT)&&(token_value==ARROW_SEP))
+    /* The keywords "data", "initial", and "initstr" used to be accepted
+       here -- but only in a Global directive, not Array. The Global directive
+       no longer calls here, so those keywords are now (more) obsolete.
+    */
+
+    if      ((token_type==SEP_TT)&&(token_value==ARROW_SEP))
              array_type = BYTE_ARRAY;
     else if ((token_type==SEP_TT)&&(token_value==DARROW_SEP))
              array_type = WORD_ARRAY;
@@ -492,12 +516,8 @@ extern void make_global(int array_flag, int name_only)
              array_type = BUFFER_ARRAY;
     else
     {   discard_token_location(beginning_debug_location);
-        if (array_flag)
-            ebf_error
-              ("'->', '-->', 'string', 'table' or 'buffer'", token_text);
-        else
-            ebf_error
-              ("'=', '->', '-->', 'string', 'table' or 'buffer'", token_text);
+        ebf_error
+            ("'->', '-->', 'string', 'table' or 'buffer'", token_text);
         panic_mode_error_recovery();
         return;
     }
index 3c53096c05956f084497ed8d8d020459a1ff91eb..2736ad1f1f08a0bbb80ae586091cd91c565c17a5 100644 (file)
--- a/src/asm.c
+++ b/src/asm.c
@@ -1,7 +1,7 @@
 /* ------------------------------------------------------------------------- */
 /*   "asm" : The Inform assembler                                            */
 /*                                                                           */
-/*   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            */
@@ -67,6 +67,8 @@ int uses_float_features;           /* Makes use of Glulx floating-point (3.1.2)
                                       features?                              */
 int uses_extundo_features;         /* Makes use of Glulx extended undo (3.1.3)
                                       features?                              */
+int uses_double_features;          /* Makes use of Glulx double-prec (3.1.3)
+                                      features?                              */
 
 debug_location statement_debug_location;
                                    /* Location of current statement          */
@@ -220,6 +222,8 @@ static memory_list sequence_points_memlist;
    The linked list must be in increasing PC order. We know this will
    be true because we call this as we run through the function, so
    zmachine_pc always increases.
+
+   (It won't necessarily be in *label index* order, though.)
 */
 static void set_label_offset(int label, int32 offset)
 {
@@ -504,6 +508,7 @@ typedef struct opcodeg
 #define GOP_Acceleration 4   /* uses_acceleration_features */
 #define GOP_Float        8   /* uses_float_features */
 #define GOP_ExtUndo     16   /* uses_extundo_features */
+#define GOP_Double      32   /* uses_double_features */
 
     /* Codes for the number of operands */
 
@@ -772,6 +777,8 @@ static opcodeg opcodes_table_g[] = {
   { (uchar *) "mfree",      0x179,  0, GOP_MemHeap, 1 },
   { (uchar *) "accelfunc",  0x180,  0, GOP_Acceleration, 2 },
   { (uchar *) "accelparam", 0x181,  0, GOP_Acceleration, 2 },
+  { (uchar *) "hasundo",    0x128,  St, GOP_ExtUndo, 1 },
+  { (uchar *) "discardundo",0x129,   0, GOP_ExtUndo, 0 },
   { (uchar *) "numtof",     0x190,  St, GOP_Float, 2 },
   { (uchar *) "ftonumz",    0x191,  St, GOP_Float, 2 },
   { (uchar *) "ftonumn",    0x192,  St, GOP_Float, 2 },
@@ -801,15 +808,47 @@ static opcodeg opcodes_table_g[] = {
   { (uchar *) "jfge",       0x1C5,  Br, GOP_Float, 3 },
   { (uchar *) "jisnan",     0x1C8,  Br, GOP_Float, 2 },
   { (uchar *) "jisinf",     0x1C9,  Br, GOP_Float, 2 },
-  { (uchar *) "hasundo",    0x128,  St, GOP_ExtUndo, 1 },
-  { (uchar *) "discardundo",0x129,   0, GOP_ExtUndo, 0 },
+  { (uchar *) "numtod",     0x200,  St|St2, GOP_Double, 3 },
+  { (uchar *) "dtonumz",    0x201,  St, GOP_Double, 3 },
+  { (uchar *) "dtonumn",    0x202,  St, GOP_Double, 3 },
+  { (uchar *) "ftod",       0x203,  St|St2, GOP_Double, 3 },
+  { (uchar *) "dtof",       0x204,  St, GOP_Double, 3 },
+  { (uchar *) "dceil",      0x208,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dfloor",     0x209,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dadd",       0x210,  St|St2, GOP_Double, 6 },
+  { (uchar *) "dsub",       0x211,  St|St2, GOP_Double, 6 },
+  { (uchar *) "dmul",       0x212,  St|St2, GOP_Double, 6 },
+  { (uchar *) "ddiv",       0x213,  St|St2, GOP_Double, 6 },
+  { (uchar *) "dmodr",      0x214,  St|St2, GOP_Double, 6 },
+  { (uchar *) "dmodq",      0x215,  St|St2, GOP_Double, 6 },
+  { (uchar *) "dsqrt",      0x218,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dexp",       0x219,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dlog",       0x21A,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dpow",       0x21B,  St|St2, GOP_Double, 6 },
+  { (uchar *) "dsin",       0x220,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dcos",       0x221,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dtan",       0x222,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dasin",      0x223,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dacos",      0x224,  St|St2, GOP_Double, 4 },
+  { (uchar *) "datan",      0x225,  St|St2, GOP_Double, 4 },
+  { (uchar *) "datan2",     0x226,  St|St2, GOP_Double, 6 },
+  { (uchar *) "jdeq",       0x230,  Br, GOP_Double, 7 },
+  { (uchar *) "jdne",       0x231,  Br, GOP_Double, 7 },
+  { (uchar *) "jdlt",       0x232,  Br, GOP_Double, 5 },
+  { (uchar *) "jdle",       0x233,  Br, GOP_Double, 5 },
+  { (uchar *) "jdgt",       0x234,  Br, GOP_Double, 5 },
+  { (uchar *) "jdge",       0x235,  Br, GOP_Double, 5 },
+  { (uchar *) "jdisnan",    0x238,  Br, GOP_Double, 3 },
+  { (uchar *) "jdisinf",    0x239,  Br, GOP_Double, 3 },
 };
 
 /* The opmacros table is used for fake opcodes. The opcode numbers are
    ignored; this table is only used for argument parsing. */
 static opcodeg opmacros_table_g[] = {
-  { (uchar *) "pull", 0, St, 0, 1 },
-  { (uchar *) "push", 0,  0, 0, 1 },
+  { (uchar *) "pull",   pull_gm,       St, 0, 1 },
+  { (uchar *) "push",   push_gm,        0, 0, 1 },
+  { (uchar *) "dload",  dload_gm,  St|St2, 0, 3 },
+  { (uchar *) "dstore", dstore_gm,      0, 0, 3 },
 };
 
 static opcodeg custom_opcode_g;
@@ -934,10 +973,6 @@ static void make_opcode_syntax_g(opcodeg opco)
 /* This is for Z-code only. */
 static void write_operand(assembly_operand op)
 {   int32 j;
-    if (module_switch && (op.marker != 0))
-    {   if ((op.marker != VARIABLE_MV) && (op.type == SHORT_CONSTANT_OT))
-            op.type = LONG_CONSTANT_OT;
-    }
     j=op.value;
     switch(op.type)
     {   case LONG_CONSTANT_OT:
@@ -947,7 +982,7 @@ static void write_operand(assembly_operand op)
             byteout(j, 0);
             else byteout(j, 0x80 + op.marker); return;
         case VARIABLE_OT:
-            byteout(j, (module_switch)?(0x80 + op.marker):0); return;
+            byteout(j, 0); return;
         case CONSTANT_OT:
         case HALFCONSTANT_OT:
         case BYTECONSTANT_OT:
@@ -1130,7 +1165,8 @@ extern void assemblez_instruction(const assembly_instruction *AI)
 
         /*  Note that variable numbers 249 to 255 (i.e. globals 233 to 239)
             are used as scratch workspace, so need no mapping between
-            modules and story files: nor do local variables 0 to 15  */
+            modules and story files: nor do local variables 0 to 15.
+            (Modules no longer exist but why drop a good comment.) */
 
         if ((o1.value >= MAX_LOCAL_VARIABLES) && (o1.value < 249))
             o1.marker = VARIABLE_MV;
@@ -1220,8 +1256,6 @@ extern void assemblez_instruction(const assembly_instruction *AI)
         printf("\n");
     }
 
-    if (module_switch) flush_link_data();
-
     return;
 
     OpcodeSyntaxError:
@@ -1232,9 +1266,11 @@ extern void assemblez_instruction(const assembly_instruction *AI)
 
 static void assembleg_macro(const assembly_instruction *AI)
 {
-    /* validate macro syntax first */
     int ix, no_operands_given;
     opcodeg opco;
+    assembly_operand AMO_0, AMO_1, AMO_2;
+    
+    /* validate macro syntax first */
     
     opco = internal_number_to_opmacro_g(AI->internal_number);
     no_operands_given = AI->operand_count;
@@ -1261,14 +1297,51 @@ static void assembleg_macro(const assembly_instruction *AI)
         }
     }
     
-    /* expand the macro */
-    switch (AI->internal_number) {
-        case pull_gm:
-            assembleg_store(AI->operand[0], stack_pointer);
+    /* Expand the macro.
+       The assembleg_() functions overwrite AI, so we need to copy out
+       its operands before we call them. */
+    
+    switch (opco.code) {
+        case pull_gm:   /* @pull STORE */
+            AMO_0 = AI->operand[0];
+            assembleg_store(AMO_0, stack_pointer);
             break;
         
-        case push_gm:
-            assembleg_store(stack_pointer, AI->operand[0]);
+        case push_gm:   /* @push LOAD */
+            AMO_0 = AI->operand[0];
+            assembleg_store(stack_pointer, AMO_0);
+            break;
+
+        case dload_gm:   /* @dload LOAD STORELO STOREHI */
+            AMO_0 = AI->operand[0];
+            AMO_1 = AI->operand[1];
+            AMO_2 = AI->operand[2];
+            if ((AMO_0.type == LOCALVAR_OT) && (AMO_0.value == 0)) {
+                // addr is on the stack
+                assembleg_store(temp_var3, stack_pointer);
+                assembleg_3(aload_gc, temp_var3, one_operand, AMO_1);
+                assembleg_3(aload_gc, temp_var3, zero_operand, AMO_2);
+            }
+            else {
+                assembleg_3(aload_gc, AMO_0, one_operand, AMO_1);
+                assembleg_3(aload_gc, AMO_0, zero_operand, AMO_2);
+            }
+            break;
+
+        case dstore_gm:   /* @dload LOAD LOADHI LOADLO */
+            AMO_0 = AI->operand[0];
+            AMO_1 = AI->operand[1];
+            AMO_2 = AI->operand[2];
+            if ((AMO_0.type == LOCALVAR_OT) && (AMO_0.value == 0)) {
+                // addr is on the stack
+                assembleg_store(temp_var3, stack_pointer);
+                assembleg_3(astore_gc, temp_var3, zero_operand, AMO_1);
+                assembleg_3(astore_gc, temp_var3, one_operand, AMO_2);
+            }
+            else {
+                assembleg_3(astore_gc, AMO_0, zero_operand, AMO_1);
+                assembleg_3(astore_gc, AMO_0, one_operand, AMO_2);
+            }
             break;
         
         default:
@@ -1341,6 +1414,9 @@ extern void assembleg_instruction(const assembly_instruction *AI)
     if (opco.op_rules & GOP_ExtUndo) {
         uses_extundo_features = TRUE;
     }
+    if (opco.op_rules & GOP_Double) {
+        uses_double_features = TRUE;
+    }
 
     no_operands_given = AI->operand_count;
 
@@ -1581,8 +1657,6 @@ extern void assembleg_instruction(const assembly_instruction *AI)
       printf("\n");
     }
 
-    if (module_switch) flush_link_data();
-
     return;
 
     OpcodeSyntaxError:
@@ -1596,12 +1670,16 @@ extern void assembleg_instruction(const assembly_instruction *AI)
    is assumed to be reachable. 
    However, if STRIP_UNREACHABLE_LABELS and EXECSTATE_ENTIRE are both set,
    that's not true. The entire statement is being skipped, so we can safely
-   skip all labels within it.
+   skip all unused labels within it.
+   ("Unused" meaning there are no forward jumps to the label. We can't
+   do anything about *backward* jumps because we haven't seen them yet!)
    (If STRIP_UNREACHABLE_LABELS is not set, the ENTIRE flag is ignored.)
 */
 extern void assemble_label_no(int n)
 {
-    if ((execution_never_reaches_here & EXECSTATE_ENTIRE) && STRIP_UNREACHABLE_LABELS) {
+    int inuse = (n >= 0 && n < labeluse_size && labeluse[n]);
+    
+    if ((!inuse) && (execution_never_reaches_here & EXECSTATE_ENTIRE) && STRIP_UNREACHABLE_LABELS) {
         /* We're not going to compile this label at all. Set a negative
            offset, which will trip an error if this label is jumped to. */
         set_label_offset(n, -1);
@@ -2128,7 +2206,10 @@ static void transfer_routine_z(void)
             offset_of_next = new_pc + long_form + 1;
 
             if (labels[j].offset < 0) {
-                error("Attempt to jump to an unreachable label");
+                char *lname = "(anon)";
+                if (labels[j].symbol >= 0 && labels[j].symbol < no_symbols)
+                    lname = symbols[labels[j].symbol].name;
+                error_named("Attempt to jump to an unreachable label", lname);
                 addr = 0;
             }
             else {
@@ -2156,7 +2237,10 @@ static void transfer_routine_z(void)
           case LABEL_MV:
             j = 256*zcode_holding_area[i] + zcode_holding_area[i+1];
             if (labels[j].offset < 0) {
-                error("Attempt to jump to an unreachable label");
+                char *lname = "(anon)";
+                if (labels[j].symbol >= 0 && labels[j].symbol < no_symbols)
+                    lname = symbols[labels[j].symbol].name;
+                error_named("Attempt to jump to an unreachable label", lname);
                 addr = 0;
             }
             else {
@@ -2180,7 +2264,7 @@ static void transfer_routine_z(void)
                 case OBJECT_MV:
                 case ACTION_MV:
                 case IDENT_MV:
-                    if (!module_switch) break;
+                    break;
                 default:
                     if ((zcode_markers[i] & 0x7f) > LARGEST_BPATCH_MV)
                     {   compiler_error("Illegal code backpatch value");
@@ -2356,7 +2440,10 @@ static void transfer_routine_g(void)
         offset_of_next = new_pc + form_len;
 
         if (labels[j].offset < 0) {
-            error("Attempt to jump to an unreachable label");
+            char *lname = "(anon)";
+            if (labels[j].symbol >= 0 && labels[j].symbol < no_symbols)
+                lname = symbols[labels[j].symbol].name;
+            error_named("Attempt to jump to an unreachable label", lname);
             addr = 0;
         }
         else {
@@ -2400,7 +2487,7 @@ static void transfer_routine_g(void)
             break;
         case ACTION_MV:
         case IDENT_MV:
-            if (!module_switch) break;
+            break;
         case OBJECT_MV:
         case VARIABLE_MV:
         default:
@@ -3431,6 +3518,7 @@ extern void init_asm_vars(void)
     uses_acceleration_features = FALSE;
     uses_float_features = FALSE;
     uses_extundo_features = FALSE;
+    uses_double_features = FALSE;
 
     labels = NULL;
     sequence_points = NULL;
index 1fd984b0c9b8ebf8c51a25b8287afca0f9a12a83..c1bd1bbb5c48e77417ec39481771775c416f8ccd 100644 (file)
@@ -2,7 +2,7 @@
 /*   "bpatch" : Keeps track of, and finally acts on, backpatch markers,      */
 /*              correcting symbol values not known at compilation time       */
 /*                                                                           */
-/*   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            */
@@ -31,6 +31,41 @@ memory_list zcode_backpatch_table_memlist;
 int32 zcode_backpatch_size, staticarray_backpatch_size,
     zmachine_backpatch_size;
 
+/* ------------------------------------------------------------------------- */
+/*   Marker values                                                           */
+/* ------------------------------------------------------------------------- */
+
+extern char *describe_mv(int mval)
+{   switch(mval)
+    {   case NULL_MV:       return("null");
+
+        /*  Marker values used in ordinary story file backpatching  */
+
+        case DWORD_MV:      return("dictionary word");
+        case STRING_MV:     return("string literal");
+        case INCON_MV:      return("system constant");
+        case IROUTINE_MV:   return("routine");
+        case VROUTINE_MV:   return("veneer routine");
+        case ARRAY_MV:      return("internal array");
+        case NO_OBJS_MV:    return("the number of objects");
+        case INHERIT_MV:    return("inherited common p value");
+        case INDIVPT_MV:    return("indiv prop table address");
+        case INHERIT_INDIV_MV: return("inherited indiv p value");
+        case MAIN_MV:       return("ref to Main");
+        case SYMBOL_MV:     return("ref to symbol value");
+
+        /*  Additional marker values used in Glulx backpatching
+            (IDENT_MV is not really used at all any more) */
+
+        case VARIABLE_MV:   return("global variable");
+        case IDENT_MV:      return("prop identifier number");
+        case ACTION_MV:     return("action");
+        case OBJECT_MV:     return("internal object");
+
+    }
+    return("** No such MV **");
+}
+
 /* ------------------------------------------------------------------------- */
 /*   The mending operation                                                   */
 /* ------------------------------------------------------------------------- */
@@ -60,7 +95,7 @@ static int32 backpatch_value_z(int32 value)
             break;
         case VROUTINE_MV:
             if ((value<0) || (value>=VENEER_ROUTINES))
-            {   if (no_link_errors > 0) break;
+            {
                 if (compiler_error
                     ("Backpatch veneer routine number out of range"))
                 {   printf("Illegal BP veneer routine number: %d\n", value);
@@ -78,7 +113,7 @@ static int32 backpatch_value_z(int32 value)
             value = no_objects; break;
         case INCON_MV:
             if ((value<0) || (value>=NO_SYSTEM_CONSTANTS))
-            {   if (no_link_errors > 0) break;
+            {
                 if (compiler_error
                     ("Backpatch system constant number out of range"))
                 {   printf("Illegal BP system constant number: %d\n", value);
@@ -119,7 +154,7 @@ static int32 backpatch_value_z(int32 value)
             break;
         case SYMBOL_MV:
             if ((value<0) || (value>=no_symbols))
-            {   if (no_link_errors > 0) break;
+            {
                 if (compiler_error("Backpatch symbol number out of range"))
                 {   printf("Illegal BP symbol number: %d\n", value);
                     backpatch_error_flag = TRUE;
@@ -141,12 +176,10 @@ static int32 backpatch_value_z(int32 value)
                 if ((backpatch_marker < 0)
                     || (backpatch_marker > LARGEST_BPATCH_MV))
                 {
-                    if (no_link_errors == 0)
-                    {   compiler_error_named(
+                    compiler_error_named(
                         "Illegal backpatch marker attached to symbol",
                         symbols[value].name);
-                        backpatch_error_flag = TRUE;
-                    }
+                    backpatch_error_flag = TRUE;
                 }
                 else
                     symbols[value].value = backpatch_value_z((symbols[value].value) % 0x10000);
@@ -167,7 +200,6 @@ static int32 backpatch_value_z(int32 value)
             }
             break;
         default:
-            if (no_link_errors > 0) break;
             if (compiler_error("Illegal backpatch marker"))
             {   printf("Illegal backpatch marker %d value %04x\n",
                     backpatch_marker, value);
@@ -213,7 +245,7 @@ static int32 backpatch_value_g(int32 value)
             break;
         case VROUTINE_MV:
             if ((value<0) || (value>=VENEER_ROUTINES))
-            {   if (no_link_errors > 0) break;
+            {
                 if (compiler_error
                     ("Backpatch veneer routine number out of range"))
                 {   printf("Illegal BP veneer routine number: %d\n", value);
@@ -231,7 +263,7 @@ static int32 backpatch_value_g(int32 value)
             value = no_objects; break;
         case INCON_MV:
             if ((value<0) || (value>=NO_SYSTEM_CONSTANTS))
-            {   if (no_link_errors > 0) break;
+            {
                 if (compiler_error
                     ("Backpatch system constant number out of range"))
                 {   printf("Illegal BP system constant number: %d\n", value);
@@ -269,7 +301,7 @@ static int32 backpatch_value_g(int32 value)
             break;
         case SYMBOL_MV:
             if ((value<0) || (value>=no_symbols))
-            {   if (no_link_errors > 0) break;
+            {
                 if (compiler_error("Backpatch symbol number out of range"))
                 {   printf("Illegal BP symbol number: %d\n", value);
                     backpatch_error_flag = TRUE;
@@ -291,12 +323,10 @@ static int32 backpatch_value_g(int32 value)
                 if ((backpatch_marker < 0)
                     || (backpatch_marker > LARGEST_BPATCH_MV))
                 {
-                    if (no_link_errors == 0)
-                    {   compiler_error_named(
+                    compiler_error_named(
                         "Illegal backpatch marker attached to symbol",
                         symbols[value].name);
-                        backpatch_error_flag = TRUE;
-                    }
+                    backpatch_error_flag = TRUE;
                 }
                 else
                     symbols[value].value = backpatch_value_g(symbols[value].value);
@@ -335,7 +365,6 @@ symbol");
             }
             break;
         default:
-            if (no_link_errors > 0) break;
             if (compiler_error("Illegal backpatch marker"))
             {   printf("Illegal backpatch marker %d value %04x\n",
                     backpatch_marker, value);
@@ -358,14 +387,10 @@ extern int32 backpatch_value(int32 value)
 }
 
 static void backpatch_zmachine_z(int mv, int zmachine_area, int32 offset)
-{   if (module_switch)
-    {   if (zmachine_area == PROP_DEFAULTS_ZA) return;
-    }
-    else
-    {   if (mv == OBJECT_MV) return;
-        if (mv == IDENT_MV) return;
-        if (mv == ACTION_MV) return;
-    }
+{   
+    if (mv == OBJECT_MV) return;
+    if (mv == IDENT_MV) return;
+    if (mv == ACTION_MV) return;
 
     if (bpatch_trace_setting >= 2)
         printf("BP added: MV %d ZA %d Off %04x\n", mv, zmachine_area, offset);
@@ -378,13 +403,9 @@ static void backpatch_zmachine_z(int mv, int zmachine_area, int32 offset)
 }
 
 static void backpatch_zmachine_g(int mv, int zmachine_area, int32 offset)
-{   if (module_switch)
-    {   if (zmachine_area == PROP_DEFAULTS_ZA) return;
-    }
-    else
-    {   if (mv == IDENT_MV) return;
-        if (mv == ACTION_MV) return;
-    }
+{   
+    if (mv == IDENT_MV) return;
+    if (mv == ACTION_MV) return;
 
 /* The backpatch table format for Glulx:
    First, the marker byte.
@@ -433,9 +454,8 @@ extern void backpatch_zmachine_image_z(void)
             case DYNAMIC_ARRAY_ZA:   addr = variables_offset; break;
             case STATIC_ARRAY_ZA:    addr = static_arrays_offset; break;
             default:
-                if (no_link_errors == 0)
-                    if (compiler_error("Illegal area to backpatch"))
-                        backpatch_error_flag = TRUE;
+                if (compiler_error("Illegal area to backpatch"))
+                    backpatch_error_flag = TRUE;
         }
         addr += offset;
 
@@ -447,9 +467,8 @@ extern void backpatch_zmachine_image_z(void)
 
         if (backpatch_error_flag)
         {   backpatch_error_flag = FALSE;
-            if (no_link_errors == 0)
-                printf("*** MV %d ZA %d Off %04x ***\n",
-                    backpatch_marker, zmachine_area, offset);
+            printf("*** MV %d ZA %d Off %04x ***\n",
+                backpatch_marker, zmachine_area, offset);
         }
     }
 }
@@ -480,7 +499,6 @@ extern void backpatch_zmachine_image_g(void)
         case GLOBALVAR_ZA:       addr = variables_offset; break;
         /* STATIC_ARRAY_ZA is in ROM and therefore not handled here */
         default:
-          if (no_link_errors == 0)
             if (compiler_error("Illegal area to backpatch"))
               backpatch_error_flag = TRUE;
         }
@@ -498,9 +516,8 @@ extern void backpatch_zmachine_image_g(void)
 
         if (backpatch_error_flag)
         {   backpatch_error_flag = FALSE;
-            if (no_link_errors == 0)
-                printf("*** MV %d ZA %d Off %04x ***\n",
-                    backpatch_marker, zmachine_area, offset);
+            printf("*** MV %d ZA %d Off %04x ***\n",
+                backpatch_marker, zmachine_area, offset);
         }
     }
 }
index 52012114933e2c7fe531e682ba9710c033cfff2e..3fdf10deaffff1493c1f57c92301f6de05576335 100644 (file)
@@ -1,7 +1,7 @@
 /* ------------------------------------------------------------------------- */
 /*   "chars" : Character set mappings and the Z-machine alphabet table       */
 /*                                                                           */
-/*   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            */
index 388ac861bcae9ba46f13fbc033ab4a5b4824f03a..d8374c367a6e8863eae86cb5d2f5e59826c877fc 100644 (file)
@@ -1,7 +1,7 @@
 /* ------------------------------------------------------------------------- */
 /*   "directs" : Directives (# commands)                                     */
 /*                                                                           */
-/*   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            */
@@ -134,10 +134,10 @@ extern int parse_given_directive(int internal_flag)
         } while (TRUE);
 
     /* --------------------------------------------------------------------- */
-    /*   Array arrayname array...                                            */
+    /*   Array <arrayname> [static] <array specification>                    */
     /* --------------------------------------------------------------------- */
 
-    case ARRAY_CODE: make_global(TRUE, FALSE); break;      /* See "tables.c" */
+    case ARRAY_CODE: make_array(); break;                  /* See "arrays.c" */
 
     /* --------------------------------------------------------------------- */
     /*   Attribute newname [alias oldname]                                   */
@@ -248,11 +248,6 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
     /* --------------------------------------------------------------------- */
 
     case DEFAULT_CODE:
-        if (module_switch)
-        {   error("'Default' cannot be used in -M (Module) mode");
-            panic_mode_error_recovery(); return FALSE;
-        }
-
         get_next_token();
         if (token_type != SYMBOL_TT)
             return ebf_error_recover("name", token_text);
@@ -378,10 +373,10 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
         make_fake_action(); break;                          /* see "verbs.c" */
 
     /* --------------------------------------------------------------------- */
-    /*   Global variable [= value / array...]                                */
+    /*   Global <variablename> [ [=] <value> ]                               */
     /* --------------------------------------------------------------------- */
 
-    case GLOBAL_CODE: make_global(FALSE, FALSE); break;    /* See "tables.c" */
+    case GLOBAL_CODE: make_global(); break;                /* See "arrays.c" */
 
     /* --------------------------------------------------------------------- */
     /*   If...                                                               */
@@ -559,26 +554,10 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
 
     /* --------------------------------------------------------------------- */
     /*   Import global <varname> [, ...]                                     */
-    /*                                                                       */
-    /* (Further imported goods may be allowed later.)                        */
     /* --------------------------------------------------------------------- */
 
     case IMPORT_CODE:
-        if (!module_switch)
-        {   error("'Import' can only be used in -M (Module) mode");
-            panic_mode_error_recovery(); return FALSE;
-        }
-        directives.enabled = TRUE;
-        do
-        {   get_next_token();
-            if ((token_type == DIRECTIVE_TT) && (token_value == GLOBAL_CODE))
-                 make_global(FALSE, TRUE);
-            else error_named("'Import' cannot import things of this type:",
-                 token_text);
-            get_next_token();
-        } while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
-        put_token_back();
-        directives.enabled = FALSE;
+        error("The 'Import' directive is no longer supported.");
         break;
 
     /* --------------------------------------------------------------------- */
@@ -613,13 +592,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
 
     case LINK_CODE:
         get_next_token();
-        if (token_type != DQ_TT)
-            return ebf_error_recover("filename in double-quotes", token_text);
-        if (strlen(token_text) >= PATHLEN-1) {
-            error_numbered("'Link' filename is too long; max length is", PATHLEN-1);
-            break;
-        }
-        link_module(token_text);                           /* See "linker.c" */
+        error("The 'Link' directive is no longer supported.");
         break;
 
     /* --------------------------------------------------------------------- */
@@ -631,10 +604,6 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
     /* --------------------------------------------------------------------- */
 
     case LOWSTRING_CODE:
-        if (module_switch)
-        {   error("'LowString' cannot be used in -M (Module) mode");
-            panic_mode_error_recovery(); return FALSE;
-        }
         if (glulx_mode) {
             error("The LowString directive has no meaning in Glulx.");
             panic_mode_error_recovery(); return FALSE;
@@ -888,9 +857,6 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
     /* --------------------------------------------------------------------- */
 
     case STATUSLINE_CODE:
-        if (module_switch)
-            warning("This does not set the final game's statusline");
-
         directive_keywords.enabled = TRUE;
         get_next_token();
         directive_keywords.enabled = FALSE;
@@ -974,9 +940,18 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
         if (token_type != DQ_TT)
             return ebf_error_recover("string of switches", token_text);
         if (!ignore_switches_switch)
-        {   if (constant_made_yet)
-                error("A 'Switches' directive must must come before \
-the first constant definition");
+        {
+            if (constant_made_yet) {
+                error("A 'Switches' directive must must come before the first constant definition");
+                break;
+            }
+            if (no_routines > 1)
+            {
+                /* The built-in Main__ routine is number zero. */
+                error("A 'Switches' directive must come before the first routine definition.");
+                break;
+            }
+            obsolete_warning("the Switches directive is deprecated and may produce incorrect results. Use command-line arguments or header comments.");
             switches(token_text, 0);                       /* see "inform.c" */
         }
         break;
@@ -1000,9 +975,9 @@ the first constant definition");
     /*                      [on/off/NUM]      {same as "assembly"}           */
     /*         assembly     [on/off/NUM]                                     */
     /*         expressions  [on/off/NUM]                                     */
-    /*         lines        [on/off/NUM]                                     */
+    /*         lines        [on/off/NUM]      {not supported}                */
     /*         tokens       [on/off/NUM]                                     */
-    /*         linker       [on/off/NUM]                                     */
+    /*         linker       [on/off/NUM]      {not supported}                */
     /*                                                                       */
     /* The first four trace commands immediately display a compiler table.   */
     /* The rest set or clear an ongoing trace.                               */
@@ -1055,17 +1030,20 @@ the first constant definition");
             trace_level = &expr_trace_level; break;
         case TOKENS_TK:
             trace_level = &tokens_trace_level; break;
-        case LINKER_TK:
-            trace_level = &linker_trace_level; break;
         case DICTIONARY_TK:
         case SYMBOLS_TK:
         case OBJECTS_TK:
         case VERBS_TK:
+            /* show a table rather than changing any trace level */
             trace_level = NULL; break;
         case LINES_TK:
             /* never implememented */
             trace_level = NULL; break;
+        case LINKER_TK:
+            /* no longer implememented */
+            trace_level = NULL; break;
         default:
+            /* default to "Trace assembly" */
             put_token_back();
             trace_level = &asm_trace_level; break;
         }
@@ -1093,7 +1071,7 @@ the first constant definition");
 
         HandleTraceKeyword:
 
-        if (i == LINES_TK) {
+        if (i == LINES_TK || i == LINKER_TK) {
             warning_named("Trace option is not supported:", trace_keywords.keywords[i]);
             break;
         }
@@ -1187,6 +1165,7 @@ the first constant definition");
                 {   error("The version number must be in the range 3 to 8");
                     break;
                 }
+                obsolete_warning("the Version directive is deprecated and may produce incorrect results. Use -vN instead, as either a command-line argument or a header comment.");
                 select_version(i);
                 /* We must now do a small dance to reset the DICT_ENTRY_BYTES
                    constant, which was defined at startup based on the Z-code
index 09efcd28fcb56f85ff5b101f138338adc82da31f..a71447e9b3aa5757abd087ea4b897113ca2df58f 100644 (file)
@@ -2,7 +2,7 @@
 /*   "errors" : Warnings, errors and fatal errors                            */
 /*              (with error throwback code for RISC OS machines)             */
 /*                                                                           */
-/*   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            */
@@ -226,13 +226,12 @@ extern void memory_out_error(int32 size, int32 howmany, char *name)
 /*   Survivable diagnostics:                                                 */
 /*      compilation errors   style 1                                         */
 /*      warnings             style 2                                         */
-/*      linkage errors       style 3                                         */
+/*      linkage errors       style 3 (no longer used)                        */
 /*      compiler errors      style 4 (these should never happen and          */
 /*                                    indicate a bug in Inform)              */
 /* ------------------------------------------------------------------------- */
 
-int no_errors, no_warnings, no_suppressed_warnings, no_link_errors,
-    no_compiler_errors;
+int no_errors, no_warnings, no_suppressed_warnings, no_compiler_errors;
 
 char *forerrors_buff;
 int  forerrors_pointer;
@@ -245,8 +244,7 @@ static void message(int style, char *s)
     switch(style)
     {   case 1: printf("Error: "); no_errors++; break;
         case 2: printf("Warning: "); no_warnings++; break;
-        case 3: printf("Error:  [linking '%s']  ", current_module_filename);
-                no_link_errors++; no_errors++; break;
+        case 3: printf("Error:  [linking]  "); no_errors++; break;
         case 4: printf("*** Compiler error: ");
                 no_compiler_errors++; break;
     }
@@ -477,21 +475,6 @@ extern void obsolete_warning(char *s1)
     message(2,error_message_buff);
 }
 
-/* ------------------------------------------------------------------------- */
-/*   Style 3: Link error message routines                                    */
-/* ------------------------------------------------------------------------- */
-
-extern void link_error(char *s)
-{   if (no_errors==MAX_ERRORS) fatalerror("Too many errors: giving up");
-    message(3,s);
-}
-
-extern void link_error_named(char *s1, char *s2)
-{   snprintf(error_message_buff, ERROR_BUFLEN,"%s \"%s\"",s1,s2);
-    ellipsize_error_message_buff();
-    link_error(error_message_buff);
-}
-
 /* ------------------------------------------------------------------------- */
 /*   Style 4: Compiler error message routines                                */
 /* ------------------------------------------------------------------------- */
@@ -499,16 +482,16 @@ extern void link_error_named(char *s1, char *s2)
 extern void print_sorry_message(void)
 {   printf(
 "***********************************************************************\n\
-* 'Compiler errors' should never occur if Inform is working properly. *\n\
-* Check to see if there is a more recent version available, from which\n\
-* the problem may have been removed. If not, please report this fault\n\
-* and if at all possible, please include your source code, as faults\n\
-* such as these are rare and often difficult to reproduce. Sorry.\n\
+* 'Compiler errors' should never occur if Inform is working properly.  *\n\
+* Check to see if there is a more recent version available, from which *\n\
+* the problem may have been removed. If not, please report this fault  *\n\
+* and if at all possible, please include your source code, as faults   *\n\
+* such as these are rare  and often difficult to reproduce. Sorry.     *\n\
 ***********************************************************************\n");
 }
 
 extern int compiler_error(char *s)
-{   if (no_link_errors > 0) return FALSE;
+{
     if (no_errors > 0) return FALSE;
     if (no_compiler_errors==MAX_ERRORS)
         fatalerror("Too many compiler errors: giving up");
@@ -517,7 +500,7 @@ extern int compiler_error(char *s)
 }
 
 extern int compiler_error_named(char *s1, char *s2)
-{   if (no_link_errors > 0) return FALSE;
+{
     if (no_errors > 0) return FALSE;
     snprintf(error_message_buff, ERROR_BUFLEN, "%s \"%s\"",s1,s2);
     ellipsize_error_message_buff();
index f8c75530f67eb365f497e48a8980407c1c9e8b8c..067cab395b286e68363e2c3bbeac13459c2a9e9f 100644 (file)
@@ -1,7 +1,7 @@
 /* ------------------------------------------------------------------------- */
 /*   "expressc" :  The expression code generator                             */
 /*                                                                           */
-/*   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            */
@@ -448,7 +448,7 @@ static void access_memory_z(int oc, assembly_operand AO1, assembly_operand AO2,
 
     assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
         index_ao;
-    int x = 0, y = 0, byte_flag = FALSE, read_flag = FALSE, from_module = FALSE;
+    int x = 0, y = 0, byte_flag = FALSE, read_flag = FALSE;
 
     INITAO(&zero_ao);
     INITAO(&size_ao);
@@ -476,10 +476,12 @@ static void access_memory_z(int oc, assembly_operand AO1, assembly_operand AO2,
             error("Cannot write to a static array");
         }
 
-        if (size_ao.value==-1) 
-            from_module=TRUE;
+        if (size_ao.value==-1) {
+            /* This case was originally meant for module linking.
+               It should no longer be possible. */
+            compiler_error("Array size cannot be negative");
+        }
         else {
-            from_module=FALSE;
             type_ao = zero_ao; type_ao.value = arrays[y].type;
 
             if ((!is_systemfile()))
@@ -511,7 +513,7 @@ static void access_memory_z(int oc, assembly_operand AO1, assembly_operand AO2,
     /* If we recognise AO1 as arising textually from a declared
        array, we can check bounds explicitly. */
 
-    if ((AO1.marker == ARRAY_MV || AO1.marker == STATIC_ARRAY_MV) && (!from_module))
+    if ((AO1.marker == ARRAY_MV || AO1.marker == STATIC_ARRAY_MV))
     {   
         int passed_label = next_label++, failed_label = next_label++,
             final_label = next_label++; 
index 0e0cf6f2773002c9b501d693cba43d5b2832ef0e..c93337ae885a4b57d9592598ba39c09507505b72 100644 (file)
@@ -1,7 +1,7 @@
 /* ------------------------------------------------------------------------- */
 /*   "expressp" :  The expression parser                                     */
 /*                                                                           */
-/*   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            */
@@ -145,7 +145,6 @@ but not used as a value:", unicode);
                        because there could be another definition coming. */
                     if (symbols[symbol].flags & REPLACE_SFLAG)
                     {   current_token.marker = SYMBOL_MV;
-                        if (module_switch) import_symbol(symbol);
                         v = symbol;
                         break;
                     }
@@ -157,7 +156,7 @@ but not used as a value:", unicode);
                 case OBJECT_T:
                 case CLASS_T:
                     /* All objects must be backpatched in Glulx. */
-                    if (module_switch || glulx_mode)
+                    if (glulx_mode)
                         current_token.marker = OBJECT_MV;
                     break;
                 case ARRAY_T:
@@ -167,12 +166,10 @@ but not used as a value:", unicode);
                     current_token.marker = STATIC_ARRAY_MV;
                     break;
                 case INDIVIDUAL_PROPERTY_T:
-                    if (module_switch) current_token.marker = IDENT_MV;
                     break;
                 case CONSTANT_T:
                     if (symbols[symbol].flags & (UNKNOWN_SFLAG + CHANGE_SFLAG))
                     {   current_token.marker = SYMBOL_MV;
-                        if (module_switch) import_symbol(symbol);
                         v = symbol;
                     }
                     else current_token.marker = 0;
@@ -1512,7 +1509,6 @@ static void check_property_operator(int from_node)
                 && ((ET[n].value.type == LONG_CONSTANT_OT)
                     || (ET[n].value.type == SHORT_CONSTANT_OT))
                 && ((ET[n].value.value > 0) && (ET[n].value.value < 64))
-                && (!module_switch)
                 && (ET[n].value.marker == 0))
             flag = TRUE;
 
index 06e85d07031e821b8abc1de0ec7a8c94bae3ab0e..50fdf5a4f99d9b949affc0d4ee2151affa799748 100644 (file)
@@ -7,7 +7,7 @@
 /*             routines in "inform.c", since they are tied up with ICL       */
 /*             settings and are very host OS-dependent.                      */
 /*                                                                           */
-/*   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            */
@@ -273,7 +273,7 @@ extern int file_load_chars(int file_number, char *buffer, int length)
 }
 
 /* ------------------------------------------------------------------------- */
-/*   Final assembly and output of the story file/module.                     */
+/*   Final assembly and output of the story file.                            */
 /* ------------------------------------------------------------------------- */
 
 FILE *sf_handle;
@@ -283,9 +283,7 @@ static void sf_put(int c)
     if (!glulx_mode) {
 
       /*  The checksum is the unsigned sum mod 65536 of the bytes in the
-          story file from 0x0040 (first byte after header) to the end.
-
-          The link data does not contribute to the checksum of a module.     */
+          story file from 0x0040 (first byte after header) to the end.       */
 
       checksum_low_byte += c;
       if (checksum_low_byte>=256)
@@ -400,9 +398,6 @@ static void output_file_z(void)
     /*  Enter the length information into the header.                        */
 
     length=((int32) Write_Strings_At) + static_strings_extent;
-    if (module_switch) length += link_data_size +
-                                 zcode_backpatch_size +
-                                 zmachine_backpatch_size;
 
     while ((length%length_scale_factor)!=0) { length++; blanks++; }
     length=length/length_scale_factor;
@@ -425,7 +420,7 @@ static void output_file_z(void)
     /*  Set the type and creator to Andrew Plotkin's MaxZip, a popular
         Z-code interpreter on the Macintosh  */
 
-    if (!module_switch) fsetfileinfo(new_name, 'mxZR', 'ZCOD');
+    fsetfileinfo(new_name, 'mxZR', 'ZCOD');
 #endif
 
     /*  (1)  Output the paged memory.                                        */
@@ -468,7 +463,6 @@ static void output_file_z(void)
     size_before_code = size;
 
     j=0;
-    if (!module_switch)
     for (i=0; i<zcode_backpatch_size; i=i+3)
     {   int long_flag = TRUE;
         offset
@@ -569,18 +563,7 @@ static void output_file_z(void)
         size++;
     }
 
-    /*  (5)  Output the linking data table (in the case of a module).        */
-
-    if (module_switch)
-        for (i=0; i<link_data_size; i++)
-            sf_put(link_data_area[i]);
-
-    if (module_switch)
-    {   for (i=0; i<zcode_backpatch_size; i++)
-            sf_put(zcode_backpatch_table[i]);
-        for (i=0; i<zmachine_backpatch_size; i++)
-            sf_put(zmachine_backpatch_table[i]);
-    }
+    /*  (5)  When modules existed, we output link data here.                 */
 
     /*  (6)  Output null bytes to reach a multiple of 0.5K.                  */
 
@@ -629,10 +612,7 @@ static void output_file_z(void)
     }
 #endif
 #ifdef MAC_FACE
-     if (module_switch)
-         InformFiletypes (new_name, INF_MODULE_TYPE);
-     else
-         InformFiletypes (new_name, INF_ZCODE_TYPE);
+    InformFiletypes (new_name, INF_ZCODE_TYPE);
 #endif
 }
 
@@ -658,7 +638,7 @@ static void output_file_g(void)
     /*  Set the type and creator to Andrew Plotkin's MaxZip, a popular
         Z-code interpreter on the Macintosh  */
 
-    if (!module_switch) fsetfileinfo(new_name, 'mxZR', 'ZCOD');
+    fsetfileinfo(new_name, 'mxZR', 'GLUL');
 #endif
 
     checksum_long = 0;
@@ -681,7 +661,7 @@ static void output_file_g(void)
     if (uses_float_features) {
       VersionNum = 0x00030102;
     }
-    if (uses_extundo_features) {
+    if (uses_double_features || uses_extundo_features) {
       VersionNum = 0x00030103;
     }
 
@@ -808,7 +788,6 @@ game features require version 0x%08lx", (long)requested_glulx_version, (long)Ver
     size_before_code = size;
 
     j=0;
-    if (!module_switch)
       for (i=0; i<zcode_backpatch_size; i=i+6) {
         int data_len;
         int32 v;
@@ -1178,10 +1157,7 @@ game features require version 0x%08lx", (long)requested_glulx_version, (long)Ver
     }
 #endif
 #ifdef MAC_FACE
-     if (module_switch)
-         InformFiletypes (new_name, INF_MODULE_TYPE);
-     else
-         InformFiletypes (new_name, INF_ZCODE_TYPE);
+    InformFiletypes (new_name, INF_GLULX_TYPE);
 #endif
 }
 
index d92e0f54cc11b1295c0b3563857957260e9e98be..5094c812f316eb086c983e6375d24ffdd7c1145f 100644 (file)
@@ -1,7 +1,7 @@
 /* ------------------------------------------------------------------------- */
 /*   Header file for Inform:  Z-machine ("Infocom" format) compiler          */
 /*                                                                           */
-/*                              Inform 6.40                                  */
+/*                              Inform 6.41                                  */
 /*                                                                           */
 /*   This header file and the others making up the Inform source code are    */
 /*   copyright (c) Graham Nelson 1993 - 2022                                 */
 /* ------------------------------------------------------------------------- */
 
 /* For releases, set to the release date in the form "1st January 2000" */
-#define RELEASE_DATE "in development"
-#define RELEASE_NUMBER 1640
+#define RELEASE_DATE "22nd July 2022"
+#define RELEASE_NUMBER 1641
 #define GLULX_RELEASE_NUMBER 38
-#define MODULE_VERSION_NUMBER 1
 #define VNUMBER RELEASE_NUMBER
 
 /* N indicates an intermediate release for Inform 7 */
 #ifndef GlulxCode_Extension
 #define GlulxCode_Extension  ".ulx"
 #endif
-#ifndef Module_Extension
-#define Module_Extension  ".m5"
-#endif
 #ifndef ICL_Extension
 #define ICL_Extension     ".icl"
 #endif
 #define V7Code_Extension  ""
 #define V8Code_Extension  ""
 #define GlulxCode_Extension  ""
-#define Module_Extension  ""
 #define ICL_Extension     ""
 #endif
 
 #ifndef Code_Directory
 #define Code_Directory    "games"
 #endif
-#ifndef Module_Directory
-#define Module_Directory  "modules"
-#endif
 #ifndef ICL_Directory
 #define ICL_Directory     ""
 #endif
 #ifndef Code_Directory
 #define Code_Directory    ""
 #endif
-#ifndef Module_Directory
-#define Module_Directory  ""
-#endif
 #ifndef ICL_Directory
 #define ICL_Directory     ""
 #endif
@@ -820,7 +809,7 @@ typedef struct debug_location_beginning_s
     int32 orig_beg_char_number;
 } debug_location_beginning;
 
-#define MAX_KEYWORD_GROUP_SIZE (119)
+#define MAX_KEYWORD_GROUP_SIZE (159)
 
 typedef struct keyword_group_s
 {   char *keywords[MAX_KEYWORD_GROUP_SIZE+1]; /* empty-string-terminated */
@@ -1008,6 +997,7 @@ typedef struct operator_s
 
 /* ------------------------------------------------------------------------- */
 /*   Internal numbers representing assemble-able Z-opcodes                   */
+/*   (Must match opcodes_table_z[] and opcode_list_z[])                      */
 /* ------------------------------------------------------------------------- */
 
 #define je_zc 0
@@ -1132,6 +1122,10 @@ typedef struct operator_s
 
 /* ------------------------------------------------------------------------- */
 /*   Internal numbers representing assemble-able Glulx opcodes               */
+/*   (Must match opcodes_table_g[] and opcode_list_g[])                      */
+/*                                                                           */
+/*   This is not a complete list. It only needs to include opcodes that are  */
+/*   directly created by the compiler or listed in the operator tables.      */
 /* ------------------------------------------------------------------------- */
 
 #define nop_gc 0
@@ -1221,35 +1215,6 @@ typedef struct operator_s
 #define mfree_gc 84
 #define accelfunc_gc 85
 #define accelparam_gc 86
-#define numtof_gc 87
-#define ftonumz_gc 88
-#define ftonumn_gc 89
-#define ceil_gc 90
-#define floor_gc 91
-#define fadd_gc 92
-#define fsub_gc 93
-#define fmul_gc 94
-#define fdiv_gc 95
-#define fmod_gc 96
-#define sqrt_gc 97
-#define exp_gc 98
-#define log_gc 99
-#define pow_gc 100
-#define sin_gc 101
-#define cos_gc 102
-#define tan_gc 103
-#define asin_gc 104
-#define acos_gc 105
-#define atan_gc 106
-#define atan2_gc 107
-#define jfeq_gc 108
-#define jfne_gc 109
-#define jflt_gc 110
-#define jfle_gc 111
-#define jfgt_gc 112
-#define jfge_gc 113
-#define jisnan_gc 114
-#define jisinf_gc 115
 
 /* ------------------------------------------------------------------------- */
 /*   Index numbers into the keyword group "opcode_macros_g" (see "lexer.c")  */
@@ -1257,6 +1222,8 @@ typedef struct operator_s
 
 #define pull_gm   0
 #define push_gm   1
+#define dload_gm  2
+#define dstore_gm 3
 
 
 #define SYMBOL_TT    0                      /* value = index in symbol table */
@@ -1941,7 +1908,8 @@ typedef struct operator_s
 #define MAIN_MV               10     /* "Main" routine */
 #define SYMBOL_MV             11     /* Forward ref to unassigned symbol */
 
-/* Additional marker values used in module backpatch areas: */
+/* Additional marker values used in module backpatch areas (most are
+   obsolete). */
 /* (In Glulx, OBJECT_MV and VARIABLE_MV are used in backpatching, even
    without modules.) */
 
@@ -1955,24 +1923,16 @@ typedef struct operator_s
 #define LARGEST_BPATCH_MV     17     /* Larger marker values are never written
                                         to backpatch tables */
 
-/* Value indicating an imported symbol record: */
-
-#define IMPORT_MV             32
-
-/* Values indicating an exported symbol record: */
-
-#define EXPORT_MV             33     /* Defined ordinarily */
-#define EXPORTSF_MV           34     /* Defined in a system file */
-#define EXPORTAC_MV           35     /* Action name */
+/* Values 32-35 were used only for module import/export. */
 
 /* Values used only in branch backpatching: */
-/* ###-I've rearranged these, so that BRANCH_MV can be last; Glulx uses the
-   whole range from BRANCH_MV to BRANCHMAX_MV. */
+/* BRANCH_MV must be last; Glulx uses the whole range from BRANCH_MV
+   to BRANCHMAX_MV. */
 
 #define LABEL_MV              36     /* Ditto: marks "jump" operands */
 #define DELETED_MV            37     /* Ditto: marks bytes deleted from code */
 #define BRANCH_MV             38     /* Used in "asm.c" for routine coding */
-#define BRANCHMAX_MV          58     /* In fact, the range BRANCH_MV to 
+#define BRANCHMAX_MV          102    /* In fact, the range BRANCH_MV to 
                                         BRANCHMAX_MV all means the same thing.
                                         The position within the range means
                                         how far back from the label to go
@@ -2045,7 +2005,6 @@ extern void init_expressp_vars(void); /* expressp: parse expressions         */
 extern void init_files_vars(void);    /* files: handle files                 */
     /* void init_vars(void);             inform: decide what to do           */
 extern void init_lexer_vars(void);    /* lexer: lexically analyse source     */
-extern void init_linker_vars(void);   /* linker: link in pre-compiled module */
 extern void init_memory_vars(void);   /* memory: manage memory settings      */
 extern void init_objects_vars(void);  /* objects: cultivate object tree      */
 extern void init_states_vars(void);   /* states: translate statements to code*/
@@ -2070,7 +2029,6 @@ extern void expressp_begin_pass(void);
 extern void files_begin_pass(void);
     /* void begin_pass(void); */
 extern void lexer_begin_pass(void);
-extern void linker_begin_pass(void);
 extern void memory_begin_pass(void);
 extern void objects_begin_pass(void);
 extern void states_begin_pass(void);
@@ -2082,7 +2040,6 @@ extern void veneer_begin_pass(void);
 extern void verbs_begin_pass(void);
 
 extern void lexer_endpass(void);
-extern void linker_endpass(void);
 
 extern void arrays_allocate_arrays(void);
 extern void asm_allocate_arrays(void);
@@ -2095,7 +2052,6 @@ extern void expressp_allocate_arrays(void);
 extern void files_allocate_arrays(void);
     /* void allocate_arrays(void); */
 extern void lexer_allocate_arrays(void);
-extern void linker_allocate_arrays(void);
 extern void memory_allocate_arrays(void);
 extern void objects_allocate_arrays(void);
 extern void states_allocate_arrays(void);
@@ -2117,7 +2073,6 @@ extern void expressp_free_arrays(void);
 extern void files_free_arrays(void);
     /* void free_arrays(void); */
 extern void lexer_free_arrays(void);
-extern void linker_free_arrays(void);
 extern void memory_free_arrays(void);
 extern void objects_free_arrays(void);
 extern void states_free_arrays(void);
@@ -2146,8 +2101,9 @@ extern memory_list static_array_area_memlist;
 extern int32 *global_initial_value;
 extern arrayinfo *arrays;
 
-extern void make_global(int array_flag, int name_only);
+extern void make_global(void);
 extern void set_variable_value(int i, int32 v);
+extern void make_array(void);
 extern void check_globals(void);
 extern int32 begin_table_array(void);
 extern int32 begin_word_array(void);
@@ -2166,7 +2122,7 @@ extern int32 no_instructions;
 extern int   sequence_point_follows;
 extern int   uses_unicode_features, uses_memheap_features, 
     uses_acceleration_features, uses_float_features,
-    uses_extundo_features;
+    uses_extundo_features, uses_double_features;
 extern debug_location statement_debug_location;
 extern int   execution_never_reaches_here;
 extern variableinfo *variables;
@@ -2291,6 +2247,8 @@ extern int32 zcode_backpatch_size, staticarray_backpatch_size,
     zmachine_backpatch_size;
 extern int   backpatch_marker, backpatch_error_flag;
 
+extern char *describe_mv(int mval);
+
 extern int32 backpatch_value(int32 value);
 extern void  backpatch_zmachine_image_z(void);
 extern void  backpatch_zmachine_image_g(void);
@@ -2344,8 +2302,7 @@ extern int  parse_given_directive(int internal_flag);
 #define FORERRORS_SIZE (512)
 extern char *forerrors_buff;
 extern int  forerrors_pointer;
-extern int  no_errors, no_warnings, no_suppressed_warnings,
-            no_link_errors, no_compiler_errors;
+extern int  no_errors, no_warnings, no_suppressed_warnings, no_compiler_errors;
 
 extern ErrorPosition ErrorReport;
 
@@ -2370,8 +2327,6 @@ extern void symtype_warning(char *context, char *name, char *type, char *wanttyp
 extern void dbnu_warning(char *type, char *name, brief_location report_line);
 extern void uncalled_routine_warning(char *type, char *name, brief_location report_line);
 extern void obsolete_warning(char *s1);
-extern void link_error(char *s);
-extern void link_error_named(char *s1, char *s2);
 extern int  compiler_error(char *s);
 extern int  compiler_error_named(char *s1, char *s2);
 extern void print_sorry_message(void);
@@ -2486,8 +2441,7 @@ extern int WORDSIZE, INDIV_PROP_START,
     OBJECT_BYTE_LENGTH, DICT_ENTRY_BYTE_LENGTH, DICT_ENTRY_FLAG_POS;
 extern int32 MAXINTWORD;
 
-extern int asm_trace_level, expr_trace_level,
-    linker_trace_level,     tokens_trace_level;
+extern int asm_trace_level, expr_trace_level, tokens_trace_level;
 
 extern int
     concise_switch,
@@ -2498,8 +2452,8 @@ extern int
     obsolete_switch,        optabbrevs_trace_setting,
     transcript_switch,      statistics_switch,    optimise_switch,
     version_set_switch,     nowarnings_switch,    hash_switch,
-    memory_map_setting,     module_switch,
-    define_DEBUG_switch,    define_USE_MODULES_switch, define_INFIX_switch,
+    memory_map_setting,
+    define_DEBUG_switch,    define_INFIX_switch,
     runtime_error_checking_switch,
     list_verbs_setting,     list_dict_setting,    list_objects_setting,
     list_symbols_setting;
@@ -2510,7 +2464,7 @@ extern int glulx_mode, compression_switch;
 extern int32 requested_glulx_version;
 
 extern int error_format,    store_the_text,       asm_trace_setting,
-    expr_trace_setting,     linker_trace_setting, tokens_trace_setting,
+    expr_trace_setting,     tokens_trace_setting,
     bpatch_trace_setting,   symdef_trace_setting,
     double_space_setting,   trace_fns_setting,    character_set_setting,
     character_set_unicode;
@@ -2527,8 +2481,6 @@ extern void switches(char *, int);
 extern int translate_in_filename(int last_value, char *new_name, char *old_name,
     int same_directory_flag, int command_line_flag);
 extern void translate_out_filename(char *new_name, char *old_name);
-extern int translate_link_filename(int last_value,
-    char *new_name, char *old_name);
 
 #ifdef ARCHIMEDES
 extern char *riscos_file_type(void);
@@ -2587,23 +2539,6 @@ extern keyword_group directives, statements, segment_markers,
        misc_keywords, directive_keywords, trace_keywords, system_constants,
        opcode_macros;
 
-/* ------------------------------------------------------------------------- */
-/*   Extern definitions for "linker"                                         */
-/* ------------------------------------------------------------------------- */
-
-extern uchar *link_data_area;
-extern int32 link_data_size;
-extern char  current_module_filename[];
-
-extern char *describe_mv(int mval);
-extern void  write_link_marker(int zmachine_area, int32 offset,
-                 assembly_operand op);
-extern void  flush_link_data(void);
-extern void  import_symbol(int32 symbol_number);
-extern void  export_symbol(int32 symbol_number);
-extern void  export_symbol_name(int32 i);
-extern void  link_module(char *filename);
-
 /* ------------------------------------------------------------------------- */
 /*   Extern definitions for "memory"                                         */
 /* ------------------------------------------------------------------------- */
index 5c02b6bfe123020f4c05cafc09f55e55993f8b98..1890d58e2acdb72eca10ca4ae3ef9341b5251a63 100644 (file)
@@ -2,7 +2,7 @@
 /*   "inform" :  The top level of Inform: switches, pathnames, filenaming    */
 /*               conventions, ICL (Inform Command Line) files, main          */
 /*                                                                           */
-/*   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            */
@@ -243,7 +243,6 @@ int asm_trace_level,     /* trace assembly: 0 for off, 1 for assembly
                             3 for branch shortening info, 4 for verbose
                             branch info                                      */
     expr_trace_level,    /* expression tracing: 0 off, 1 on, 2/3 more        */
-    linker_trace_level,  /* linker tracing: 0 to 4 levels                    */
     tokens_trace_level;  /* lexer output tracing: 0 off, 1 on, 2/3 more      */
 
 /* ------------------------------------------------------------------------- */
@@ -269,9 +268,7 @@ int concise_switch,                 /* -c */
     memory_map_setting,             /* $!MAP, -z */
     oddeven_packing_switch,         /* -B */
     define_DEBUG_switch,            /* -D */
-    module_switch,                  /* -M */
     runtime_error_checking_switch,  /* -S */
-    define_USE_MODULES_switch,      /* -U */
     define_INFIX_switch;            /* -X */
 #ifdef ARC_THROWBACK
 int throwback_switch;               /* -T */
@@ -295,8 +292,6 @@ int character_set_setting,          /* set by -C0 through -C9 */
     double_space_setting,           /* set by -d: 0, 1 or 2 */
     trace_fns_setting,              /* $!RUNTIME, -g: 0, 1, 2, or 3 */
     files_trace_setting,            /* $!FILES */
-    linker_trace_setting,           /* $!LINKER: initial value of
-                                       linker_trace_level */
     list_verbs_setting,             /* $!VERBS */
     list_dict_setting,              /* $!DICT */
     list_objects_setting,           /* $!OBJECTS */
@@ -309,7 +304,6 @@ int glulx_mode;                     /* -G */
 
 static void reset_switch_settings(void)
 {   asm_trace_setting = 0;
-    linker_trace_setting = 0;
     tokens_trace_setting = 0;
     expr_trace_setting = 0;
     bpatch_trace_setting = 0;
@@ -343,8 +337,6 @@ static void reset_switch_settings(void)
     memory_map_setting = 0;
     oddeven_packing_switch = FALSE;
     define_DEBUG_switch = FALSE;
-    define_USE_MODULES_switch = FALSE;
-    module_switch = FALSE;
 #ifdef ARC_THROWBACK
     throwback_switch = FALSE;
 #endif
@@ -366,7 +358,6 @@ static void reset_switch_settings(void)
     /* These aren't switches, but for clarity we reset them too. */
     asm_trace_level = 0;
     expr_trace_level = 0;
-    linker_trace_level = 0;
     tokens_trace_level = 0;
 }
 
@@ -398,7 +389,6 @@ static void init_vars(void)
     init_expressp_vars();
     init_files_vars();
     init_lexer_vars();
-    init_linker_vars();
     init_memory_vars();
     init_objects_vars();
     init_states_vars();
@@ -426,10 +416,8 @@ static void begin_pass(void)
     expr_trace_level = expr_trace_setting;
     asm_trace_level = asm_trace_setting;
     tokens_trace_level = tokens_trace_setting;
-    linker_trace_level = linker_trace_setting;
 
     lexer_begin_pass();
-    linker_begin_pass();
     memory_begin_pass();
     objects_begin_pass();
     states_begin_pass();
@@ -440,24 +428,21 @@ static void begin_pass(void)
     veneer_begin_pass();
     verbs_begin_pass();
 
-    if (!module_switch)
-    {
-        /*  Compile a Main__ routine (see "veneer.c")  */
-
-        compile_initial_routine();
-
-        /*  Make the four metaclasses: Class must be object number 1, so
-            it must come first  */
-
-        veneer_mode = TRUE;
-
-        make_class("Class");
-        make_class("Object");
-        make_class("Routine");
-        make_class("String");
-
-        veneer_mode = FALSE;
-    }
+    /*  Compile a Main__ routine (see "veneer.c")  */
+    
+    compile_initial_routine();
+    
+    /*  Make the four metaclasses: Class must be object number 1, so
+        it must come first  */
+    
+    veneer_mode = TRUE;
+    
+    make_class("Class");
+    make_class("Object");
+    make_class("Routine");
+    make_class("String");
+    
+    veneer_mode = FALSE;
 }
 
 extern void allocate_arrays(void)
@@ -473,7 +458,6 @@ extern void allocate_arrays(void)
     files_allocate_arrays();
 
     lexer_allocate_arrays();
-    linker_allocate_arrays();
     memory_allocate_arrays();
     objects_allocate_arrays();
     states_allocate_arrays();
@@ -502,7 +486,6 @@ extern void free_arrays(void)
     files_free_arrays();
 
     lexer_free_arrays();
-    linker_free_arrays();
     memory_free_arrays();
     objects_free_arrays();
     states_free_arrays();
@@ -521,7 +504,6 @@ extern void free_arrays(void)
 static char Source_Path[PATHLEN];
 static char Include_Path[PATHLEN];
 static char Code_Path[PATHLEN];
-static char Module_Path[PATHLEN];
 static char current_source_path[PATHLEN];
        char Debugging_Name[PATHLEN];
        char Transcript_Name[PATHLEN];
@@ -531,7 +513,7 @@ static char ICL_Path[PATHLEN];
 
 /* Set one of the above Path buffers to the given location, or list of
    locations. (A list is comma-separated, and only accepted for Source_Path,
-   Include_Path, ICL_Path, Module_Path.)
+   Include_Path, ICL_Path.)
 */
 static void set_path_value(char *path, char *value)
 {   int i, j;
@@ -546,10 +528,10 @@ static void set_path_value(char *path, char *value)
         if ((value[j] == FN_ALT) || (value[j] == 0))
         {   if ((value[j] == FN_ALT)
                 && (path != Source_Path) && (path != Include_Path)
-                && (path != ICL_Path) && (path != Module_Path))
+                && (path != ICL_Path))
             {   printf("The character '%c' is used to divide entries in a list \
-of possible locations, and can only be used in the Include_Path, Source_Path, \
-Module_Path or ICL_Path variables. Other paths are for output only.\n", FN_ALT);
+of possible locations, and can only be used in the Include_Path, Source_Path \
+or ICL_Path variables. Other paths are for output only.\n", FN_ALT);
                 exit(1);
             }
             if ((path != Debugging_Name) && (path != Transcript_Name)
@@ -564,7 +546,7 @@ Module_Path or ICL_Path variables. Other paths are for output only.\n", FN_ALT);
 
 /* Prepend the given location or list of locations to one of the above
    Path buffers. This is only permitted for Source_Path, Include_Path, 
-   ICL_Path, Module_Path.
+   ICL_Path.
 
    An empty field (in the comma-separated list) means the current
    directory. If the Path buffer is entirely empty, we assume that
@@ -579,10 +561,10 @@ static void prepend_path_value(char *path, char *value)
     char new_path[PATHLEN];
 
     if ((path != Source_Path) && (path != Include_Path)
-        && (path != ICL_Path) && (path != Module_Path))
+        && (path != ICL_Path))
     {   printf("The character '+' is used to add to a list \
-of possible locations, and can only be used in the Include_Path, Source_Path, \
-Module_Path or ICL_Path variables. Other paths are for output only.\n");
+of possible locations, and can only be used in the Include_Path, Source_Path \
+or ICL_Path variables. Other paths are for output only.\n");
         exit(1);
     }
 
@@ -626,7 +608,6 @@ static void set_default_paths(void)
     set_path_value(Source_Path,     Source_Directory);
     set_path_value(Include_Path,    Include_Directory);
     set_path_value(Code_Path,       Code_Directory);
-    set_path_value(Module_Path,     Module_Directory);
     set_path_value(ICL_Path,        ICL_Directory);
     set_path_value(Debugging_Name,  Debugging_File);
     set_path_value(Transcript_Name, Transcript_File);
@@ -667,7 +648,6 @@ static void set_path_command(char *command)
         if (strcmp(pathname, "source_path")==0)  path_to_set=Source_Path;
         if (strcmp(pathname, "include_path")==0) path_to_set=Include_Path;
         if (strcmp(pathname, "code_path")==0)    path_to_set=Code_Path;
-        if (strcmp(pathname, "module_path")==0)  path_to_set=Module_Path;
         if (strcmp(pathname, "icl_path")==0)     path_to_set=ICL_Path;
         if (strcmp(pathname, "debugging_name")==0) path_to_set=Debugging_Name;
         if (strcmp(pathname, "transcript_name")==0) path_to_set=Transcript_Name;
@@ -804,25 +784,6 @@ extern int translate_in_filename(int last_value,
     return last_value;
 }
 
-extern int translate_link_filename(int last_value,
-    char *new_name, char *old_name)
-{   char *prefix_path = NULL;
-    char *extension;
-
-    if (contains_separator(old_name)==0)
-        if (Module_Path[0]!=0)
-            prefix_path = Module_Path;
-
-#ifdef FILE_EXTENSIONS
-    extension = check_extension(old_name, Module_Extension);
-#else
-    extension = "";
-#endif
-
-    return write_translated_name(new_name, old_name,
-               prefix_path, last_value, extension);
-}
-
 static int translate_icl_filename(int last_value,
     char *new_name, char *old_name)
 {   char *prefix_path = NULL;
@@ -865,27 +826,21 @@ extern void translate_out_filename(char *new_name, char *old_name)
 #endif
 
     prefix_path = NULL;
-    if (module_switch)
-    {   extension = Module_Extension;
-        if (Module_Path[0]!=0) prefix_path = Module_Path;
-    }
-    else
-    {
-        if (!glulx_mode) {
-            switch(version_number)
-            {   case 3: extension = Code_Extension;   break;
-                case 4: extension = V4Code_Extension; break;
-                case 5: extension = V5Code_Extension; break;
-                case 6: extension = V6Code_Extension; break;
-                case 7: extension = V7Code_Extension; break;
-                case 8: extension = V8Code_Extension; break;
-            }
-        }
-        else {
-            extension = GlulxCode_Extension;
+    
+    if (!glulx_mode) {
+        switch(version_number)
+        {   case 3: extension = Code_Extension;   break;
+            case 4: extension = V4Code_Extension; break;
+            case 5: extension = V5Code_Extension; break;
+            case 6: extension = V6Code_Extension; break;
+            case 7: extension = V7Code_Extension; break;
+            case 8: extension = V8Code_Extension; break;
         }
-        if (Code_Path[0]!=0) prefix_path = Code_Path;
     }
+    else {
+        extension = GlulxCode_Extension;
+    }
+    if (Code_Path[0]!=0) prefix_path = Code_Path;
 
 #ifdef FILE_EXTENSIONS
     extension = check_extension(old_name, extension);
@@ -902,9 +857,7 @@ static char *name_or_unset(char *p)
 static void help_on_filenames(void)
 {   char old_name[PATHLEN];
     char new_name[PATHLEN];
-    int save_mm = module_switch, x;
-
-    module_switch = FALSE;
+    int x;
 
     printf("Help information on filenames:\n\n");
 
@@ -919,8 +872,8 @@ If <file2> is given, however, the output filename is set to just <file2>\n\
 (not altered in any way).\n\n");
 
     printf(
-"Filenames given in the game source (with commands like Include \"name\" and\n\
-Link \"name\") are also translated by the rules below.\n\n");
+"Filenames given in the game source (with commands like Include \"name\")\n\
+are also translated by the rules below.\n\n");
 
     printf(
 "Rules of translation:\n\n\
@@ -954,9 +907,8 @@ Inform translates plain filenames (such as \"xyzzy\") into full pathnames\n\
    name_or_unset(Code_Path));
 
     printf(
-"       ICL command file (in)  icl_path            %s\n\
-       Module (in & out)      module_path         %s\n\n",
-   name_or_unset(ICL_Path), name_or_unset(Module_Path));
+"       ICL command file (in)  icl_path            %s\n\n",
+   name_or_unset(ICL_Path));
 
     printf(
 "   If the path is unset, then the current working directory is used (so\n\
@@ -978,20 +930,17 @@ Inform translates plain filenames (such as \"xyzzy\") into full pathnames\n\
 "   If two '+' signs are used (\"inform ++include_path=dir jigsaw\") then\n\
    the path or paths are added to the existing list.\n\n");
     printf(
-"   (Modules are written to the first alternative in the module_path list;\n\
-   it is an error to give alternatives at all for purely output paths.)\n\n");
+"   (It is an error to give alternatives at all for purely output paths.)\n\n");
 
 #ifdef FILE_EXTENSIONS
     printf("3. The following file extensions are added:\n\n\
       Source code:     %s\n\
       Include files:   %s\n\
       Story files:     %s (Version 3), %s (v4), %s (v5, the default),\n\
-                       %s (v6), %s (v7), %s (v8), %s (Glulx)\n\
-      Modules:         %s\n\n",
+                       %s (v6), %s (v7), %s (v8), %s (Glulx)\n\n",
       Source_Extension, Include_Extension,
       Code_Extension, V4Code_Extension, V5Code_Extension, V6Code_Extension,
-      V7Code_Extension, V8Code_Extension, GlulxCode_Extension, 
-      Module_Extension);
+      V7Code_Extension, V8Code_Extension, GlulxCode_Extension);
     printf("\
    except that any extension you give (on the command line or in a filename\n\
    used in a program) will override these.  If you give the null extension\n\
@@ -1015,19 +964,8 @@ Inform translates plain filenames (such as \"xyzzy\") into full pathnames\n\
     translate_out_filename(new_name, "rezrov");
     printf("  and a story file is compiled to \"%s\".\n\n", new_name);
 
-    translate_in_filename(0, new_name, "frotz", 0, 1);
-    printf("2. \"inform -M frotz\"\n\
-  the source code is read from \"%s\"\n",
-        new_name);
-    module_switch = TRUE;
-    convert_filename_flag = TRUE;
-    translate_out_filename(new_name, "frotz");
-    printf("  and a module is compiled to \"%s\".\n\n", new_name);
-
-    module_switch = FALSE;
-
     sprintf(old_name, "demos%cplugh", FN_SEP);
-    printf("3. \"inform %s\"\n", old_name);
+    printf("2. \"inform %s\"\n", old_name);
     translate_in_filename(0, new_name, old_name, 0, 1);
     printf("  the source code is read from \"%s\"\n", new_name);
     sprintf(old_name, "demos%cplugh", FN_SEP);
@@ -1035,7 +973,7 @@ Inform translates plain filenames (such as \"xyzzy\") into full pathnames\n\
     translate_out_filename(new_name, old_name);
     printf("  and a story file is compiled to \"%s\".\n\n", new_name);
 
-    printf("4. \"inform plover my_demo\"\n");
+    printf("3. \"inform plover my_demo\"\n");
     translate_in_filename(0, new_name, "plover", 0, 1);
     printf("  the source code is read from \"%s\"\n", new_name);
     convert_filename_flag = FALSE;
@@ -1045,7 +983,7 @@ Inform translates plain filenames (such as \"xyzzy\") into full pathnames\n\
     strcpy(old_name, Source_Path);
     sprintf(new_name, "%cnew%cold%crecent%cold%cancient",
         FN_ALT, FN_ALT, FN_SEP, FN_ALT, FN_SEP);
-    printf("5. \"inform +source_path=%s zooge\"\n", new_name);
+    printf("4. \"inform +source_path=%s zooge\"\n", new_name);
     printf(
 "   Note that four alternative paths are given, the first being the empty\n\
    path-name (meaning: where you are now).  Inform looks for the source code\n\
@@ -1058,7 +996,6 @@ Inform translates plain filenames (such as \"xyzzy\") into full pathnames\n\
         printf("     \"%s\"\n", new_name);
     } while (x != 0);
     strcpy(Source_Path, old_name);
-    module_switch = save_mm;
 }
 
 #ifdef ARCHIMEDES
@@ -1067,12 +1004,10 @@ static char riscos_ft_buffer[4];
 extern char *riscos_file_type(void)
 {
     if (riscos_file_type_format == 1)
-    {   if (module_switch) return("data");
+    {
         return("11A");
     }
 
-    if (module_switch) return("075");
-
     sprintf(riscos_ft_buffer, "%03x", 0x60 + version_number);
     return(riscos_ft_buffer);
 }
@@ -1097,7 +1032,6 @@ static void run_pass(void)
     compile_veneer();
 
     lexer_endpass();
-    if (module_switch) linker_endpass();
 
     issue_debug_symbol_warnings();
     
@@ -1174,23 +1108,6 @@ disabling -X switch\n");
         define_INFIX_switch = FALSE;
     }
 
-    if (module_switch && glulx_mode) {
-        printf("Modules are not available in Glulx: \
-disabling -M switch\n");
-        module_switch = FALSE;
-    }
-
-    if (define_INFIX_switch && module_switch)
-    {   printf("Infix (-X) facilities are not available when compiling \
-modules: disabling -X switch\n");
-        define_INFIX_switch = FALSE;
-    }
-    if (runtime_error_checking_switch && module_switch)
-    {   printf("Strict checking (-S) facilities are not available when \
-compiling modules: disabling -S switch\n");
-        runtime_error_checking_switch = FALSE;
-    }
-
     TIMEVALUE_NOW(&time_start);
     
     no_compilations++;
@@ -1374,7 +1291,6 @@ printf("  E2  Macintosh MPW-style error messages%s\n",
       (error_format==2)?" (current setting)":"");
 printf("  G   compile a Glulx game file\n");
 printf("  H   use Huffman encoding to compress Glulx strings\n");
-printf("  M   compile as a Module for future linking\n");
 
 #ifdef ARCHIMEDES
 printf("\
@@ -1385,7 +1301,6 @@ printf("  S   compile strict error-checking at run-time (on by default)\n");
 #ifdef ARC_THROWBACK
 printf("  T   enable throwback of errors in the DDE\n");
 #endif
-printf("  U   insert \"Constant USE_MODULES;\" automatically\n");
 printf("  V   print the version and date of this program\n");
 printf("  Wn  header extension table is at least n words (n = 3 to 99)\n");
 printf("  X   compile with INFIX debugging facilities present\n");
@@ -1507,10 +1422,6 @@ extern void switches(char *p, int cmode)
                       default:  error_format=1; break;
                   }
                   break;
-        case 'M': module_switch = state;
-                  if (state && (r_e_c_s_set == FALSE))
-                      runtime_error_checking_switch = FALSE;
-                  break;
 #ifdef ARCHIMEDES
         case 'R': switch(p[i+1])
                   {   case '0': s=2; riscos_file_type_format=0; break;
@@ -1534,7 +1445,6 @@ extern void switches(char *p, int cmode)
                   }
                   break;
         case 'H': compression_switch = state; break;
-        case 'U': define_USE_MODULES_switch = state; break;
         case 'V': exit(0); break;
         case 'W': if ((p[i+1]>='0') && (p[i+1]<='9'))
                   {   s=2; ZCODE_HEADER_EXT_WORDS = p[i+1]-'0';
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)
diff --git a/src/linker.c b/src/linker.c
deleted file mode 100644 (file)
index 2da3249..0000000
+++ /dev/null
@@ -1,1152 +0,0 @@
-/* ------------------------------------------------------------------------- */
-/*   "linker" : For compiling and linking modules                            */
-/*                                                                           */
-/*   Part of Inform 6.40                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
-/*                                                                           */
-/* Inform is free software: you can redistribute it and/or modify            */
-/* it under the terms of the GNU General Public License as published by      */
-/* the Free Software Foundation, either version 3 of the License, or         */
-/* (at your option) any later version.                                       */
-/*                                                                           */
-/* Inform 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 General Public License for more details.                              */
-/*                                                                           */
-/* You should have received a copy of the GNU General Public License         */
-/* along with Inform. If not, see https://gnu.org/licenses/                  */
-/*                                                                           */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-uchar *link_data_holding_area;            /* Allocated to link_data_ha_size  */
-static memory_list link_data_holding_area_memlist;
-int32 link_data_ha_size;
-
-uchar *link_data_area;
-static memory_list link_data_area_memlist;
-                                          /*  Start, current top, size of    */
-int32 link_data_size;                     /*  link data table being written  */
-                                          /*  (holding import/export names)  */
-
-/* ------------------------------------------------------------------------- */
-/*   Marker values                                                           */
-/* ------------------------------------------------------------------------- */
-
-extern char *describe_mv(int mval)
-{   switch(mval)
-    {   case NULL_MV:       return("null");
-
-        /*  Marker values used in ordinary story file backpatching  */
-
-        case DWORD_MV:      return("dictionary word");
-        case STRING_MV:     return("string literal");
-        case INCON_MV:      return("system constant");
-        case IROUTINE_MV:   return("routine");
-        case VROUTINE_MV:   return("veneer routine");
-        case ARRAY_MV:      return("internal array");
-        case NO_OBJS_MV:    return("the number of objects");
-        case INHERIT_MV:    return("inherited common p value");
-        case INDIVPT_MV:    return("indiv prop table address");
-        case INHERIT_INDIV_MV: return("inherited indiv p value");
-        case MAIN_MV:       return("ref to Main");
-        case SYMBOL_MV:     return("ref to symbol value");
-
-        /*  Additional marker values used in module backpatching  */
-
-        case VARIABLE_MV:   return("global variable");
-        case IDENT_MV:      return("prop identifier number");
-        case ACTION_MV:     return("action");
-        case OBJECT_MV:     return("internal object");
-
-        /*  Record types in the import/export table (not really marker
-            values at all)  */
-
-        case EXPORT_MV:     return("Export   ");
-        case EXPORTSF_MV:   return("Export sf");
-        case EXPORTAC_MV:   return("Export ##");
-        case IMPORT_MV:     return("Import   ");
-    }
-    return("** No such MV **");
-}
-
-/* ------------------------------------------------------------------------- */
-/*   Import/export records                                                   */
-/* ------------------------------------------------------------------------- */
-
-typedef struct importexport_s
-{   int module_value;
-    int32 symbol_number;
-    char symbol_type;
-    int backpatch;
-    int32 symbol_value;
-    char *symbol_name;
-} ImportExport;
-
-static void describe_importexport(ImportExport *I)
-{   printf("%8s %20s %04d %04x %s\n",
-        describe_mv(I->module_value), I->symbol_name,
-            I->symbol_number, I->symbol_value, typename(I->symbol_type));
-}
-
-/* ========================================================================= */
-/*   Linking in external modules: this code is run when the external         */
-/*   program hits a Link directive.                                          */
-/* ------------------------------------------------------------------------- */
-/*   This map is between global variable numbers in the module and in the    */
-/*   external program: variables_map[n] will be the external global variable */
-/*   no for module global variable no n.  (The entries [0] to [15] are not   */
-/*   used.)                                                                  */
-/* ------------------------------------------------------------------------- */
-
-static int variables_map[256], actions_map[256];
-
-int32 module_map[16];
-
-ImportExport IE;
-
-/* ------------------------------------------------------------------------- */
-/*   These are offsets within the module:                                    */
-/* ------------------------------------------------------------------------- */
-
-static int32 m_code_offset, m_strs_offset, m_static_offset, m_dict_offset,
-             m_vars_offset, m_objs_offset, m_props_offset, m_class_numbers,
-             m_individuals_offset,         m_individuals_length;
-
-static int m_no_objects, m_no_globals, p_no_globals, lowest_imported_global_no;
-
-int32 *xref_table; int xref_top;
-int32 *property_identifier_map;
-int *accession_numbers_map;
-int32 routine_replace[64],
-      routine_replace_with[64]; int no_rr;
-
-/* ------------------------------------------------------------------------- */
-/*   Reading and writing bytes/words in the module (as loaded in), indexing  */
-/*   via "marker addresses".                                                 */
-/* ------------------------------------------------------------------------- */
-
-static int32 read_marker_address(uchar *p, int size,
-    int zmachine_area, int32 offset)
-{
-    /*  A routine to read the value referred to by the marker address
-        (zmachine_area, offset): size is 1 for byte, 2 for word, and the
-        module itself resides at p.                                          */
-
-    int32 addr = 0;
-
-    switch(zmachine_area)
-    {
-        case DYNAMIC_ARRAY_ZA:
-            addr = m_vars_offset; break;
-        case ZCODE_ZA:
-            addr = m_code_offset; break;
-        case STATIC_STRINGS_ZA:
-            addr = m_strs_offset; break;
-        case DICTIONARY_ZA:
-            addr = m_dict_offset; break;
-        case OBJECT_TREE_ZA:
-            addr = m_objs_offset; break;
-        case PROP_ZA:
-            addr = m_props_offset; break;
-        case INDIVIDUAL_PROP_ZA:
-            addr = m_individuals_offset; break;
-    }
-    if (size == 1) return p[addr+offset];
-    return 256*p[addr+offset] + p[addr+offset+1];
-}
-
-static void write_marker_address(uchar *p, int size,
-    int zmachine_area, int32 offset, int32 value)
-{
-    /*  Similar, but to write to it.                                         */
-
-    int32 addr = 0;
-
-    switch(zmachine_area)
-    {
-        case DYNAMIC_ARRAY_ZA:
-            addr = m_vars_offset; break;
-        case ZCODE_ZA:
-            addr = m_code_offset; break;
-        case STATIC_STRINGS_ZA:
-            addr = m_strs_offset; break;
-        case DICTIONARY_ZA:
-            addr = m_dict_offset; break;
-        case OBJECT_TREE_ZA:
-            addr = m_objs_offset; break;
-        case PROP_ZA:
-            addr = m_props_offset; break;
-        case INDIVIDUAL_PROP_ZA:
-            addr = m_individuals_offset; break;
-    }
-    if (size == 1) { p[addr+offset] = value%256; return; }
-    p[addr+offset] = value/256;
-    p[addr+offset+1] = value%256;
-}
-
-int m_read_pos;
-
-static int get_next_record(uchar *p)
-{   int i;
-    int record_type = p[m_read_pos++];
-    switch(record_type)
-    {   case 0: break;
-        case EXPORT_MV:
-        case EXPORTSF_MV:
-        case EXPORTAC_MV:
-        case IMPORT_MV:
-            IE.module_value = record_type;
-            i=p[m_read_pos++]; IE.symbol_number = 256*i + p[m_read_pos++];
-            IE.symbol_type = p[m_read_pos++];
-            if (record_type != IMPORT_MV) IE.backpatch = p[m_read_pos++];
-            i=p[m_read_pos++]; IE.symbol_value = 256*i + p[m_read_pos++];
-            IE.symbol_name = (char *) (p+m_read_pos);
-            m_read_pos += strlen((char *) (p+m_read_pos))+1;
-            if (linker_trace_level >= 2) describe_importexport(&IE);
-            break;
-        default:
-            printf("Marker value of %d\n", record_type);
-            compiler_error("Link: illegal import/export marker value");
-            return -1;
-    }
-    return record_type;
-}
-
-static char link_errorm[128];
-
-static void accept_export(void)
-{   int32 index, map_to = IE.symbol_value % 0x10000;
-    index = symbol_index(IE.symbol_name, -1);
-
-    xref_table[IE.symbol_number] = index;
-
-    if (!(symbols[index].flags & UNKNOWN_SFLAG))
-    {   if (IE.module_value == EXPORTAC_MV)
-        {   if ((!(symbols[index].flags & ACTION_SFLAG))
-                && (symbols[index].type != FAKE_ACTION_T))
-                link_error_named(
-"action name clash with", IE.symbol_name);
-        }
-        else
-        if (symbols[index].type == IE.symbol_type)
-        {   switch(IE.symbol_type)
-            {   case CONSTANT_T:
-                    if ((!(symbols[index].value == IE.symbol_value))
-                        || (IE.backpatch != 0))
-                        link_error_named(
-"program and module give differing values of", IE.symbol_name);
-                    break;
-                case INDIVIDUAL_PROPERTY_T:
-                    property_identifier_map[IE.symbol_value] = symbols[index].value;
-                    break;
-                case ROUTINE_T:
-                    if ((IE.module_value == EXPORTSF_MV)
-                        && (symbols[index].flags & REPLACE_SFLAG))
-                    break;
-                default:
-                    sprintf(link_errorm,
-                        "%s '%s' in both program and module",
-                        typename(IE.symbol_type), IE.symbol_name);
-                    link_error(link_errorm);
-                    break;
-            }
-        }
-        else
-        {   sprintf(link_errorm,
-                    "'%s' has type %s in program but type %s in module",
-                    IE.symbol_name, typename(symbols[index].type),
-                    typename(IE.symbol_type));
-            link_error(link_errorm);
-        }
-    }
-    else
-    {   if (IE.module_value == EXPORTAC_MV)
-        {   IE.symbol_value = no_actions;
-            ensure_memory_list_available(&actions_memlist, no_actions+1);
-            actions[no_actions].symbol = index;
-            actions[no_actions].byte_offset = 0; /* fill in later */
-            no_actions++;
-            if (linker_trace_level >= 4)
-                printf("Creating action ##%s\n", symbols[index].name);
-        }
-        else
-        switch(IE.symbol_type)
-        {   case ROUTINE_T:
-                if ((IE.module_value == EXPORTSF_MV)
-                    && (symbols[index].flags & REPLACE_SFLAG))
-                {   routine_replace[no_rr] = IE.symbol_value;
-                    routine_replace_with[no_rr++] = index;
-                    return;
-                }
-                IE.symbol_value += (zmachine_pc/scale_factor);
-                break;
-            case OBJECT_T:
-            case CLASS_T:
-                IE.symbol_value += no_objects;
-                break;
-            case ARRAY_T:
-                IE.symbol_value += dynamic_array_area_size - (MAX_ZCODE_GLOBAL_VARS*2);
-                break;
-            case GLOBAL_VARIABLE_T:
-                if (no_globals==233)
-                {   link_error(
-"failed because too many extra global variables needed");
-                    return;
-                }
-                variables_map[16 + m_no_globals++] = 16 + no_globals;
-                set_variable_value(no_globals, IE.symbol_value);
-                IE.symbol_value = 16 + no_globals++;
-                break;
-            case INDIVIDUAL_PROPERTY_T:
-                property_identifier_map[IE.symbol_value]
-                    = no_individual_properties;
-                IE.symbol_value = no_individual_properties++;
-
-                if (debugfile_switch)
-                {   debug_file_printf("<property>");
-                    debug_file_printf
-                        ("<identifier>%s</identifier>", IE.symbol_name);
-                    debug_file_printf
-                        ("<value>%d</value>", IE.symbol_value);
-                    debug_file_printf("</property>");
-                }
-
-                break;
-        }
-        assign_marked_symbol(index, IE.backpatch, IE.symbol_value,
-            IE.symbol_type);
-        if (IE.backpatch != 0) symbols[index].flags |= CHANGE_SFLAG;
-        symbols[index].flags |= EXPORT_SFLAG;
-        if (IE.module_value == EXPORTSF_MV)
-            symbols[index].flags |= INSF_SFLAG;
-        if (IE.module_value == EXPORTAC_MV)
-            symbols[index].flags |= ACTION_SFLAG;
-    }
-
-    if (IE.module_value == EXPORTAC_MV)
-    {   if (linker_trace_level >= 4)
-            printf("Map %d '%s' to %d\n",
-                IE.symbol_value, (symbols[index].name), symbols[index].value);
-        actions_map[map_to] = symbols[index].value;
-    }
-}
-
-static void accept_import(void)
-{   int32 index;
-
-    index = symbol_index(IE.symbol_name, -1);
-    symbols[index].flags |= USED_SFLAG;
-    xref_table[IE.symbol_number] = index;
-
-    if (!(symbols[index].flags & UNKNOWN_SFLAG))
-    {   switch (IE.symbol_type)
-        {
-            case GLOBAL_VARIABLE_T:
-                if (symbols[index].type != GLOBAL_VARIABLE_T)
-                    link_error_named(
-"module (wrongly) declared this a variable:", IE.symbol_name);
-                variables_map[IE.symbol_value] = symbols[index].value;
-                if (IE.symbol_value < lowest_imported_global_no)
-                    lowest_imported_global_no = IE.symbol_value;
-                break;
-            default:
-                switch(symbols[index].type)
-                {   case ATTRIBUTE_T:
-                        link_error_named(
-"this attribute is undeclared within module:", IE.symbol_name);; break;
-                    case PROPERTY_T:
-                        link_error_named(
-"this property is undeclared within module:", IE.symbol_name); break;
-                    case INDIVIDUAL_PROPERTY_T:
-                    case ARRAY_T:
-                    case ROUTINE_T:
-                    case CONSTANT_T:
-                    case OBJECT_T:
-                    case CLASS_T:
-                    case FAKE_ACTION_T:
-                        break;
-                    default:
-                        link_error_named(
-"this was referred to as a constant, but isn't:", IE.symbol_name);
-                        break;
-                }
-                break;
-        }
-    }
-    else
-    {   switch (IE.symbol_type)
-        {
-            case GLOBAL_VARIABLE_T:
-                if (symbols[index].type != GLOBAL_VARIABLE_T)
-                    link_error_named(
-                "Module tried to import a Global variable not defined here:",
-                        IE.symbol_name);
-                variables_map[IE.symbol_value] = 16;
-                if (IE.symbol_value < lowest_imported_global_no)
-                    lowest_imported_global_no = IE.symbol_value;
-                break;
-        }
-    }
-}
-
-static int32 backpatch_backpatch(int32 v)
-{   switch(backpatch_marker)
-    {
-        /*  Backpatches made now which are final  */
-
-        case OBJECT_MV:
-            v += no_objects;
-            backpatch_marker = NULL_MV;
-            break;
-
-        case ACTION_MV:
-            if ((v<0) || (v>=256) || (actions_map[v] == -1))
-            {   link_error("unmapped action number");
-                printf("*** Link: unmapped action number %d ***", v);
-                v = 0;
-                break;
-            }
-            v = actions_map[v];
-            backpatch_marker = NULL_MV;
-            break;
-
-        case IDENT_MV:
-            {   int f = v & 0x8000;
-                v = f + property_identifier_map[v-f];
-                backpatch_marker = NULL_MV;
-                break;
-            }
-
-        case VARIABLE_MV:
-            backpatch_marker = NULL_MV;
-            if (v < lowest_imported_global_no)
-            {   v = v + p_no_globals; break;
-            }
-            if (variables_map[v] == -1)
-            {   printf("** Unmapped variable %d! **\n", v);
-                variables_map[v] = 16;
-                link_error("unmapped variable error"); break;
-            }
-            v = variables_map[v];
-            break;
-
-        /*  Backpatch values which are themselves being backpatched  */
-
-        case INDIVPT_MV:
-            v += individuals_length;
-            break;
-
-        case SYMBOL_MV:
-            v = xref_table[v];
-            if ((v<0) || (v>=no_symbols))
-            {   printf("** Symbol number %d cannot be crossreferenced **\n", v);
-                link_error("symbol crossreference error"); v=0;
-                break;
-            }
-            break;
-
-        case STRING_MV:
-            v += static_strings_extent/scale_factor;
-            break;
-
-        case IROUTINE_MV:
-            {   int i;
-                for (i=0;i<no_rr;i++)
-                    if (v == routine_replace[i])
-                    {   v = routine_replace_with[i];
-                        backpatch_marker = SYMBOL_MV;
-                        goto IR_Done;
-                    }
-                v += zmachine_pc/scale_factor;
-            }
-            IR_Done: break;
-
-        case VROUTINE_MV:
-            veneer_routine(v);
-            break;
-
-        case ARRAY_MV:
-            if (v < (MAX_ZCODE_GLOBAL_VARS*2))
-            {   v = 2*(variables_map[v/2 + 16] - 16);
-            }
-            else
-            {   v += dynamic_array_area_size - (MAX_ZCODE_GLOBAL_VARS*2);
-            }
-            break;
-
-        case DWORD_MV:
-            v = accession_numbers_map[v];
-            break;
-
-        case INHERIT_MV:
-            v += properties_table_size;
-            break;
-
-        case INHERIT_INDIV_MV:
-            v += individuals_length;
-            break;
-    }
-    return v;
-}
-
-static void backpatch_module_image(uchar *p,
-    int marker_value, int zmachine_area, int32 offset)
-{   int size = (marker_value>=0x80)?1:2; int32 v;
-    marker_value &= 0x7f;
-
-    backpatch_marker = marker_value;
-
-    if (zmachine_area == PROP_DEFAULTS_ZA) return;
-
-    if (linker_trace_level >= 3)
-        printf("Backpatch %s area %d offset %04x size %d: ",
-            describe_mv(marker_value), zmachine_area, offset, size);
-
-    v = read_marker_address(p, size, zmachine_area, offset);
-    if (linker_trace_level >= 3) printf("%04x ", v);
-
-    v = backpatch_backpatch(v);
-
-    write_marker_address(p, size, zmachine_area, offset, v);
-    if (linker_trace_level >= 3) printf("%04x\n", v);
-}
-
-/* ------------------------------------------------------------------------- */
-/*   The main routine: linking in a module with the given filename.          */
-/* ------------------------------------------------------------------------- */
-
-char current_module_filename[PATHLEN];
-
-void link_module(char *given_filename)
-{   FILE *fin;
-    int record_type;
-    char filename[PATHLEN];
-    uchar *p, p0[64];
-    int32 last, i, j, k, l, m, vn, len, size, link_offset, module_size, map,
-          max_property_identifier, symbols_base = no_symbols;
-
-    strcpy(current_module_filename, given_filename);
-
-    /* (1) Load in the module to link */
-
-    i = 0;
-    do
-    {   i = translate_link_filename(i, filename, given_filename);
-        fin=fopen(filename,"rb");
-    } while ((fin == NULL) && (i != 0));
-
-    if (fin==NULL)
-    {   error_named("Couldn't open module file", filename); return;
-    }
-
-    for (i=0;i<64;i++) p0[i]=fgetc(fin);
-
-    vn = p0[0];
-    if ((vn<65) || (vn>75))
-    {   error_named("File isn't a module:", filename);
-        fclose(fin); return;
-    }
-
-    if (vn != 64 + version_number)
-    {   char ebuff[100];
-        sprintf(ebuff,
-           "module compiled as Version %d (so it can't link\
- into this V%d game):", vn-64, version_number);
-        error_named(ebuff, filename);
-        fclose(fin); return;
-    }
-
-    module_size     = (256*p0[26] + p0[27])*scale_factor;
-    p = my_malloc(module_size + 16, "link module storage");
-        /*  The + 16 allows for rounding errors  */
-
-    for (k=0;k<64;k++) p[k] = p0[k];
-    for (k=64;k<module_size;k++) p[k] = fgetc(fin);
-    fclose(fin);
-
-    if ((p0[52] != 0) || (p0[53] != 0))
-    {   /*  Then the module contains a character set table  */
-        if (alphabet_modified)
-        {   k = FALSE; m = 256*p0[52] + p0[53];
-            for (i=0;i<3;i++) for (j=0;j<26;j++)
-            {   l = alphabet[i][j]; if (l == '~') l = '\"';
-                if (l != p[m]) k = TRUE;
-            }
-            if (k)
-        link_error("module and game both define non-standard character sets, \
-but they disagree");
-            k = FALSE;
-        }
-        else k = TRUE;
-    }
-    else
-    {   if (alphabet_modified) k = TRUE;
-        else k = FALSE;
-    }
-    if (k)
-        link_error("module and game use different character sets");
-
-    i = p[1];
-    if (i > MODULE_VERSION_NUMBER)
-        warning_named("module has a more advanced format than this release \
-of the Inform 6 compiler knows about: it may not link in correctly", filename);
-
-    /* (2) Calculate offsets: see the header-writing code in "tables.c"  */
-
-    map             = (256*p[6] + p[7]);
-    for (i=0; i<16; i++) module_map[i] = 256*p[map + i*2] + p[map + i*2 + 1];
-
-    m_vars_offset   = (256*p[12] + p[13]);
-    m_static_offset = (256*p[14] + p[15]);
-    m_dict_offset   = (256*p[8] + p[9]);
-    m_code_offset   = (256*p[4] + p[5]);
-
-    /* (3) Read the "module map" table   */
-
-    if (linker_trace_level>=4)
-    {   printf("[Reading module map:\n");
-        for (i=0; i<16; i++) printf("%04x ", module_map[i]);
-        printf("]\n");
-    }
-
-    m_objs_offset        = module_map[0];
-    m_props_offset       = module_map[1];
-    m_strs_offset        = scale_factor*module_map[2];
-    m_class_numbers      = module_map[3];
-    m_individuals_offset = module_map[4];
-    m_individuals_length = module_map[5];
-
-    for (i=16;i<256;i++) variables_map[i] = -1;
-    for (i=0;i<16;i++)  variables_map[i] = i;
-    for (i=LOWEST_SYSTEM_VAR_NUMBER;i<256;i++) variables_map[i] = i;
-
-    for (i=0;i<256;i++) actions_map[i] = -1;
-
-    xref_table = my_calloc(sizeof(int32), module_map[6],
-        "linker cross-references table");
-    for (i=0;i<module_map[6];i++) xref_table[i] = -1;
-
-    max_property_identifier = module_map[7];
-    property_identifier_map = my_calloc(sizeof(int32), max_property_identifier,
-        "property identifier map");
-    for (i=0; i<max_property_identifier; i++)
-        property_identifier_map[i] = i;
-
-    m_no_objects         = module_map[8];
-    link_offset          = module_map[9];
-
-    m_no_globals = 0; p_no_globals = no_globals;
-    lowest_imported_global_no=236;
-
-    no_rr = 0;
-
-    if ((linker_trace_level>=1) || transcript_switch)
-    {   char link_banner[PATHLEN+128];
-        sprintf(link_banner,
-            "[Linking release %d.%c%c%c%c%c%c of module '%s' (size %dK)]",
-            p[2]*256 + p[3], p[18], p[19], p[20], p[21], p[22], p[23],
-            filename, module_size/1024);
-        if (linker_trace_level >= 1) printf("%s\n", link_banner);
-        if (transcript_switch)
-            write_to_transcript_file(link_banner, STRCTX_INFO);
-    }
-
-    /* (4) Merge in the dictionary */
-
-    if (linker_trace_level >= 2)
-        printf("Merging module's dictionary at %04x\n", m_dict_offset);
-    k=m_dict_offset; k+=p[k]+1;
-    len=p[k++];
-    size = p[k]*256 + p[k+1]; k+=2;
-
-    accession_numbers_map = my_calloc(sizeof(int), size,
-        "dictionary accession numbers map");
-
-    for (i=0;i<size;i++, k+=len)
-    {   char word[10];
-        word_to_ascii(p+k,word);
-        if (linker_trace_level >= 3)
-            printf("%03d %04x  '%s' %02x %02x %02x\n",i,k,
-            word, p[k+len-3], p[k+len-2], p[k+len-1]);
-
-        accession_numbers_map[i]
-            = dictionary_add(word, p[k+len-3], p[k+len-2], p[k+len-1]);
-    }
-
-    /* (5) Run through import/export table  */
-
-    m_read_pos = module_map[9];
-    if (linker_trace_level>=2)
-        printf("Import/export table is at byte offset %04x\n", m_read_pos);
-
-    do
-    {   record_type = get_next_record(p);
-        if (((record_type == EXPORT_MV) || (record_type == EXPORTSF_MV))
-            && (IE.symbol_type == INDIVIDUAL_PROPERTY_T))
-        {   int32 si = symbol_index(IE.symbol_name, -1);
-            property_identifier_map[IE.symbol_value] = symbols[si].value;
-        }
-        switch(record_type)
-        {   case EXPORT_MV:
-            case EXPORTSF_MV:
-            case EXPORTAC_MV:
-                accept_export(); break;
-            case IMPORT_MV:
-                accept_import(); break;
-        }
-    } while (record_type != 0);
-
-    if ((linker_trace_level >= 4) && (no_rr != 0))
-    {   printf("Replaced routine addresses:\n");
-        for (i=0; i<no_rr; i++)
-        {   printf("Replace code offset %04x with %04x\n",
-                routine_replace[i], routine_replace_with[i]);
-        }
-    }
-
-    if (linker_trace_level >= 4)
-    {   printf("Symbol cross-references table:\n");
-        for (i=0; i<module_map[6]; i++)
-        {   if (xref_table[i] != -1)
-                printf("module %4d -> story file '%s'\n", i,
-                    symbols[xref_table[i]].name);
-        }
-    }
-
-    if (linker_trace_level >= 4)
-    {   printf("Action numbers map:\n");
-        for (i=0; i<256; i++)
-            if (actions_map[i] != -1)
-                printf("%3d -> %3d\n", i, actions_map[i]);
-    }
-
-    if ((linker_trace_level >= 4) && (max_property_identifier > 72))
-    {   printf("Property identifier number map:\n");
-        for (i=72; i<max_property_identifier; i++)
-        {   printf("module %04x -> program %04x\n",
-                i, property_identifier_map[i]);
-        }
-    }
-
-    /* (6) Backpatch the backpatch markers attached to exported symbols  */
-
-    for (i=symbols_base; i<no_symbols; i++)
-    {   if ((symbols[i].flags & CHANGE_SFLAG) && (symbols[i].flags & EXPORT_SFLAG))
-        {   backpatch_marker = symbols[i].marker;
-            j = symbols[i].value % 0x10000;
-
-            j = backpatch_backpatch(j);
-
-            symbols[i].value = j;
-            if (backpatch_marker == 0) symbols[i].flags &= (~(CHANGE_SFLAG));
-        }
-    }
-
-    /* (7) Run through the Z-code backpatch table  */
-
-    for (i=module_map[11]; i<module_map[11]+module_map[12]; i += 3)
-    {   int marker_value = p[i];
-        int32 offset = 256*p[i+1] + p[i+2];
-
-        switch(marker_value & 0x7f)
-        {   case OBJECT_MV:
-            case ACTION_MV:
-            case IDENT_MV:
-            case VARIABLE_MV:
-                backpatch_module_image(p, marker_value, ZCODE_ZA, offset);
-                break;
-            default:
-                ensure_memory_list_available(&zcode_backpatch_table_memlist, zcode_backpatch_size+3);
-                backpatch_module_image(p, marker_value, ZCODE_ZA, offset);
-                zcode_backpatch_table[zcode_backpatch_size++] = backpatch_marker;
-                zcode_backpatch_table[zcode_backpatch_size++] = (offset + zmachine_pc)/256;
-                zcode_backpatch_table[zcode_backpatch_size++] = (offset + zmachine_pc)%256;
-                break;
-        }
-    }
-
-    /* (8) Run through the Z-machine backpatch table  */
-
-    for (i=module_map[13]; i<module_map[13]+module_map[14]; i += 4)
-    {   int marker_value = p[i], zmachine_area = p[i+1];
-        int32 offset = 256*p[i+2] + p[i+3];
-
-        switch(marker_value)
-        {   case OBJECT_MV:
-            case ACTION_MV:
-            case IDENT_MV:
-                backpatch_module_image(p, marker_value, zmachine_area, offset);
-                break;
-            default:
-                backpatch_module_image(p, marker_value, zmachine_area, offset);
-                switch(zmachine_area)
-                {   case PROP_DEFAULTS_ZA:
-                        break;
-                    case PROP_ZA:
-                        offset += properties_table_size; break;
-                    case INDIVIDUAL_PROP_ZA:
-                        offset += individuals_length; break;
-                    case DYNAMIC_ARRAY_ZA:
-                        if (offset < (MAX_ZCODE_GLOBAL_VARS*2))
-                        {   offset = 2*(variables_map[offset/2 + 16] - 16);
-                        }
-                        else
-                        {   offset += dynamic_array_area_size - (MAX_ZCODE_GLOBAL_VARS*2);
-                        }
-                        break;
-                }
-                backpatch_zmachine(backpatch_marker, zmachine_area, offset);
-                break;
-        }
-    }
-
-    /* (9) Adjust initial values of variables */
-
-    if (linker_trace_level >= 3)
-        printf("\nFinal variables map, Module -> Main:\n");
-
-    for (i=16;i<255;i++)
-        if (variables_map[i]!=-1)
-        {   if (linker_trace_level>=2)
-                printf("%d->%d  ",i,variables_map[i]);
-            if (i<lowest_imported_global_no)
-            {   int32 j = read_marker_address(p, 2,
-                    DYNAMIC_ARRAY_ZA, 2*(i-16));
-                set_variable_value(variables_map[i]-16, j);
-                if (linker_trace_level>=2)
-                    printf("(set var %d to %d) ",
-                        variables_map[i], j);
-            }
-        }
-    if (linker_trace_level>=2) printf("\n");
-
-    /* (10) Glue in the dynamic array data */
-
-    i = m_static_offset - m_vars_offset - MAX_ZCODE_GLOBAL_VARS*2;
-    ensure_memory_list_available(&dynamic_array_area_memlist, dynamic_array_area_size + i);
-
-    if (linker_trace_level >= 2)
-        printf("Inserting dynamic array area, %04x to %04x, at %04x\n",
-            m_vars_offset + MAX_ZCODE_GLOBAL_VARS*2, m_static_offset,
-            variables_offset + dynamic_array_area_size);
-    for (k=0;k<i;k++)
-    {   dynamic_array_area[dynamic_array_area_size+k]
-            = p[m_vars_offset+MAX_ZCODE_GLOBAL_VARS*2+k];
-    }
-    dynamic_array_area_size+=i;
-
-    /* (11) Glue in the code area */
-
-    if (linker_trace_level >= 2)
-      printf("Inserting code area, %04x to %04x, at code offset %04x (+%04x)\n",
-        m_code_offset, m_strs_offset, code_offset, zmachine_pc);
-
-    ensure_memory_list_available(&zcode_area_memlist, zmachine_pc + (m_strs_offset - m_code_offset));
-    
-    for (k=m_code_offset;k<m_strs_offset;k++)
-    {
-        zcode_area[zmachine_pc++] = p[k];
-    }
-
-    /* (12) Glue in the static strings area */
-
-    if (linker_trace_level >= 2)
-        printf("Inserting strings area, %04x to %04x, \
-at strings offset %04x (+%04x)\n",
-        m_strs_offset, link_offset, strings_offset,
-        static_strings_extent);
-    ensure_memory_list_available(&static_strings_area_memlist, static_strings_extent+link_offset-m_strs_offset);
-    for (k=m_strs_offset;k<link_offset;k++)
-    {
-        static_strings_area[static_strings_extent++] = p[k];
-    }
-
-    /* (13) Append the class object-numbers table: note that modules
-            provide extra information in this table */
-
-    i = m_class_numbers;
-    do
-    {   j = p[i]*256 + p[i+1]; i+=2;
-        if (j == 0) break;
-
-        ensure_memory_list_available(&class_info_memlist, no_classes+1);
-        
-        class_info[no_classes].object_number = j + no_objects;
-        j = p[i]*256 + p[i+1]; i+=2;
-        class_info[no_classes++].begins_at = j + properties_table_size;
-
-    } while (TRUE);
-
-    /* (14) Glue on the object tree */
-
-    if ((linker_trace_level>=2) && (m_no_objects>0))
-        printf("Joining on object tree of size %d\n", m_no_objects);
-
-    for (i=0, k=no_objects, last=m_props_offset;i<m_no_objects;i++)
-    {
-        ensure_memory_list_available(&objectsz_memlist, no_objects+1);
-        objectsz[no_objects].atts[0]=p[m_objs_offset+14*i];
-        objectsz[no_objects].atts[1]=p[m_objs_offset+14*i+1];
-        objectsz[no_objects].atts[2]=p[m_objs_offset+14*i+2];
-        objectsz[no_objects].atts[3]=p[m_objs_offset+14*i+3];
-        objectsz[no_objects].atts[4]=p[m_objs_offset+14*i+4];
-        objectsz[no_objects].atts[5]=p[m_objs_offset+14*i+5];
-        objectsz[no_objects].parent =
-            (p[m_objs_offset+14*i+6])*256+p[m_objs_offset+14*i+7];
-        objectsz[no_objects].next =
-            (p[m_objs_offset+14*i+8])*256+p[m_objs_offset+14*i+9];
-        objectsz[no_objects].child =
-            (p[m_objs_offset+14*i+10])*256+p[m_objs_offset+14*i+11];
-        if (linker_trace_level>=4)
-            printf("Module objects[%d] has %d,%d,%d\n",
-                i,objectsz[no_objects].parent,
-                objectsz[no_objects].next,objectsz[no_objects].child);
-        if (objectsz[no_objects].parent == 0x7fff)
-        {   objectsz[no_objects].parent = 1;
-            if (objectsz[1].child == 0)
-            {   objectsz[1].child = no_objects+1;
-            }
-            else
-            {   int j1 = 0, j2 = objectsz[1].child;
-                while (j2 != 0)
-                {   j1 = j2;
-                    j2 = objectsz[j2].next;
-                }
-                objectsz[j1].next = no_objects+1;
-            }
-            objectsz[no_objects].next = 0;
-        }
-        else
-        if (objectsz[no_objects].parent>0) objectsz[no_objects].parent += k;
-        if (objectsz[no_objects].next>0)   objectsz[no_objects].next   += k;
-        if (objectsz[no_objects].child>0)  objectsz[no_objects].child  += k;
-        objectsz[no_objects].propsize =
-            (p[m_objs_offset+14*i+12])*256+p[m_objs_offset+14*i+13];
-        last += objectsz[no_objects].propsize;
-        if (linker_trace_level>=4)
-            printf("Objects[%d] has %d,%d,%d\n",
-                no_objects,objectsz[no_objects].parent,
-                objectsz[no_objects].next,objectsz[no_objects].child);
-        no_objects++;
-    }
-
-    /* (15) Glue on the properties */
-
-    if (last>m_props_offset)
-    {   i = m_static_offset - m_vars_offset - MAX_ZCODE_GLOBAL_VARS*2;
-
-        if (linker_trace_level >= 2)
-            printf("Inserting object properties area, %04x to %04x, at +%04x\n",
-                m_props_offset, last, properties_table_size);
-        ensure_memory_list_available(&properties_table_memlist, properties_table_size+last-m_props_offset);
-        for (k=0;k<last-m_props_offset;k++)
-            properties_table[properties_table_size++] = p[m_props_offset+k];
-    }
-
-    /* (16) Bitwise OR Flags 2 (Z-machine requirements flags) */
-
-    j = p[16]*256 + p[17];
-    for (i=0, k=1;i<16;i++, k=k*2) flags2_requirements[i] |= ((j/k)%2);
-
-    /* (17) Append the individual property values table */
-
-    i = m_individuals_length;
-    ensure_memory_list_available(&individuals_table_memlist, individuals_length + i);
-
-    if (linker_trace_level >= 2)
-      printf("Inserting individual prop tables area, %04x to %04x, at +%04x\n",
-            m_individuals_offset, m_individuals_offset + i,
-            individuals_length);
-    for (k=0;k<i;k++)
-    {   individuals_table[individuals_length + k]
-            = p[m_individuals_offset + k];
-    }
-    individuals_length += i;
-
-    /* (18) All done */
-
-    if (linker_trace_level >= 2)
-         printf("Link complete\n");
-
-  my_free(&p, "link module storage");
-  my_free(&xref_table, "linker cross-references table");
-  my_free(&property_identifier_map, "property identifier map");
-  my_free(&accession_numbers_map, "accession numbers map");
-}
-
-/* ========================================================================= */
-/*   Writing imports, exports and markers to the link data table during      */
-/*   module compilation                                                      */
-/* ------------------------------------------------------------------------- */
-/*   Writing to the link data table                                          */
-/* ------------------------------------------------------------------------- */
-
-static void write_link_byte(int x)
-{
-    ensure_memory_list_available(&link_data_holding_area_memlist, link_data_ha_size+1);
-    link_data_holding_area[link_data_ha_size] = (unsigned char) x;
-    link_data_ha_size++; link_data_size++;
-}
-
-extern void flush_link_data(void)
-{   int32 i, j;
-    j = link_data_ha_size;
-    ensure_memory_list_available(&link_data_area_memlist, link_data_size);
-    for (i=0;i<j;i++)
-        link_data_area[link_data_size-j+i] = link_data_holding_area[i];
-    link_data_ha_size = 0;
-}
-
-static void write_link_word(int32 x)
-{   write_link_byte(x/256); write_link_byte(x%256);
-}
-
-static void write_link_string(char *s)
-{   int i;
-    for (i=0; s[i]!=0; i++) write_link_byte(s[i]);
-    write_link_byte(0);
-}
-
-/* ------------------------------------------------------------------------- */
-/*   Exports and imports                                                     */
-/* ------------------------------------------------------------------------- */
-
-static void export_symbols(void)
-{   int symbol_number;
-
-    for (symbol_number = 0; symbol_number < no_symbols; symbol_number++)
-    {   int export_flag = FALSE, import_flag = FALSE;
-
-        if (symbols[symbol_number].type==GLOBAL_VARIABLE_T)
-        {   if (symbols[symbol_number].value < LOWEST_SYSTEM_VAR_NUMBER)
-            {   if (symbols[symbol_number].flags & IMPORT_SFLAG)
-                    import_flag = TRUE;
-                else
-                    if (!(symbols[symbol_number].flags & SYSTEM_SFLAG))
-                        export_flag = TRUE;
-            }
-        }
-        else
-        {   if (!(symbols[symbol_number].flags & SYSTEM_SFLAG))
-            {   if (symbols[symbol_number].flags & UNKNOWN_SFLAG)
-                {   if (symbols[symbol_number].flags & IMPORT_SFLAG)
-                        import_flag = TRUE;
-                }
-                else
-                switch(symbols[symbol_number].type)
-                {   case LABEL_T:
-                    case ATTRIBUTE_T:
-                    case PROPERTY_T:
-                         /*  Ephemera  */
-                         break;
-
-                    default: export_flag = TRUE;
-                }
-            }
-        }
-
-        if (export_flag)
-        {   if (linker_trace_level >= 1)
-            {   IE.module_value = EXPORT_MV;
-                IE.symbol_number = symbol_number;
-                IE.symbol_type = symbols[symbol_number].type;
-                IE.symbol_value = symbols[symbol_number].value;
-                IE.symbol_name = (symbols[symbol_number].name);
-                describe_importexport(&IE);
-            }
-
-            if (symbols[symbol_number].flags & ACTION_SFLAG)
-                write_link_byte(EXPORTAC_MV);
-            else
-            if (symbols[symbol_number].flags & INSF_SFLAG)
-                write_link_byte(EXPORTSF_MV);
-            else
-                write_link_byte(EXPORT_MV);
-
-            write_link_word(symbol_number);
-            write_link_byte(symbols[symbol_number].type);
-            if (symbols[symbol_number].flags & CHANGE_SFLAG)
-                 write_link_byte(symbols[symbol_number].marker);
-            else write_link_byte(0);
-            write_link_word(symbols[symbol_number].value % 0x10000);
-            write_link_string((symbols[symbol_number].name));
-            flush_link_data();
-        }
-
-        if (import_flag)
-        {   if (linker_trace_level >= 1)
-            {   IE.module_value = IMPORT_MV;
-                IE.symbol_number = symbol_number;
-                IE.symbol_type = symbols[symbol_number].type;
-                IE.symbol_value = symbols[symbol_number].value;
-                IE.symbol_name = (symbols[symbol_number].name);
-                describe_importexport(&IE);
-            }
-
-            write_link_byte(IMPORT_MV);
-            write_link_word(symbol_number);
-            write_link_byte(symbols[symbol_number].type);
-            write_link_word(symbols[symbol_number].value);
-            write_link_string((symbols[symbol_number].name));
-            flush_link_data();
-        }
-    }
-}
-
-/* ------------------------------------------------------------------------- */
-/*   Marking for later importation                                           */
-/* ------------------------------------------------------------------------- */
-
-int mv_vref=LOWEST_SYSTEM_VAR_NUMBER-1;
-
-void import_symbol(int32 symbol_number)
-{   symbols[symbol_number].flags |= IMPORT_SFLAG;
-    switch(symbols[symbol_number].type)
-    {   case GLOBAL_VARIABLE_T:
-            assign_symbol(symbol_number, mv_vref--, symbols[symbol_number].type);
-            break;
-    }
-}
-
-/* ========================================================================= */
-/*   Data structure management routines                                      */
-/* ------------------------------------------------------------------------- */
-
-extern void init_linker_vars(void)
-{   link_data_size = 0;
-    link_data_area = NULL;
-    link_data_ha_size = 0;
-    link_data_holding_area = NULL;
-}
-
-extern void linker_begin_pass(void)
-{   link_data_ha_size = 0;
-}
-
-extern void linker_endpass(void)
-{   export_symbols();
-    write_link_byte(0);
-    flush_link_data();
-}
-
-extern void linker_allocate_arrays(void)
-{
-    int initlinksize = (module_switch ? 2000 : 0);
-    initialise_memory_list(&link_data_holding_area_memlist,
-        sizeof(uchar), initlinksize, (void**)&link_data_holding_area,
-        "link data holding area");
-    initialise_memory_list(&link_data_area_memlist,
-        sizeof(uchar), 128, (void**)&link_data_area,
-        "link data area");
-}
-
-extern void linker_free_arrays(void)
-{
-    deallocate_memory_list(&link_data_holding_area_memlist);
-    deallocate_memory_list(&link_data_area_memlist);
-}
-
-/* ========================================================================= */
index bf2eec057c8caa16901d6ff45ab248ff82149eb7..78d06efe1fe9d2cf9fcaa152d5a407cb3fc478f0 100644 (file)
@@ -1,7 +1,7 @@
 /* ------------------------------------------------------------------------- */
 /*   "memory" : Memory management and ICL memory setting commands            */
 /*                                                                           */
-/*   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            */
@@ -627,8 +627,6 @@ static void set_trace_option(char *command)
         printf("  FINDABBREVS: show selection decisions during abbreviation optimization\n    (only meaningful with -u)\n");
         printf("    FINDABBREVS=2: also show three-letter-block decisions\n");
         printf("  FREQ: show how efficient abbreviations were (same as -f)\n    (only meaningful with -e)\n");
-        printf("  LINKER: show module linking info\n");
-        printf("    LINKER=2: more verbose (or 3, 4 for even more)\n");
         printf("  MAP: print memory map of the virtual machine (same as -z)\n");
         printf("    MAP=2: also show percentage of VM that each segment occupies\n");
         printf("  MEM: show internal memory allocations\n");
@@ -694,9 +692,6 @@ static void set_trace_option(char *command)
     else if (strcmp(command, "FREQUENCY")==0 || strcmp(command, "FREQUENCIES")==0 || strcmp(command, "FREQ")==0) {
         frequencies_setting = value;
     }
-    else if (strcmp(command, "LINK")==0 || strcmp(command, "LINKER")==0) {
-        linker_trace_setting = value;
-    }
     else if (strcmp(command, "MAP")==0) {
         memory_map_setting = value;
     }
index 34e0b8673d5807ef701b5d5c180afc85316002b3..f122c3ec80004f9d50249524ba650babfc58c37e 100644 (file)
@@ -6,7 +6,7 @@
 /*                    checks syntax and translates such directives into      */
 /*                    specifications for the object-maker.                   */
 /*                                                                           */
-/*   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            */
@@ -629,9 +629,7 @@ so many values that the list has overflowed the maximum 32 entries");
                                 {   already_present = TRUE; break;
                                 }
                             if (already_present == FALSE)
-                            {   if (module_switch)
-                                    backpatch_zmachine(IDENT_MV,
-                                        INDIVIDUAL_PROP_ZA, i_m);
+                            {
                                 ensure_memory_list_available(&individuals_table_memlist, i_m+3+individuals_table[z+2]);
                                 individuals_table[i_m++] = individuals_table[z];
                                 individuals_table[i_m++] = individuals_table[z+1];
@@ -692,8 +690,7 @@ so many values that the list has overflowed the maximum 32 entries");
 
                     z = class_block_offset;
                     while ((individuals_table[z]!=0)||(individuals_table[z+1]!=0))
-                    {   if (module_switch)
-                        backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
+                    {
                         ensure_memory_list_available(&individuals_table_memlist, i_m+3+individuals_table[z+2]);
                         individuals_table[i_m++] = individuals_table[z];
                         individuals_table[i_m++] = individuals_table[z+1];
@@ -1217,8 +1214,6 @@ static void properties_segment_z(int this_segment)
             if (this_segment == PRIVATE_SEGMENT)
                 individuals_table[i_m] |= 0x80;
             individuals_table[i_m+1] = this_identifier_number%256;
-            if (module_switch)
-                backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
             individuals_table[i_m+2] = 0;
         }
         else
@@ -1925,11 +1920,10 @@ inconvenience, please contact the maintainers.");
     }
 
     /*  "Class" (object 1) has no parent, whereas all other classes are
-        the children of "Class".  Since "Class" is not present in a module,
-        a special value is used which is corrected to 1 by the linker.       */
+        the children of "Class".                                             */
 
     if (metaclass_flag) parent_of_this_obj = 0;
-    else parent_of_this_obj = (module_switch)?MAXINTWORD:1;
+    else parent_of_this_obj = 1;
 
     class_info[no_classes].object_number = class_number;
     class_info[no_classes].symbol = current_classname_symbol;
@@ -2203,7 +2197,7 @@ extern void make_object(int nearby_flag,
             {   int j = i, k = 0;
 
                 /*  Metaclass or class objects cannot be '->' parents:  */
-                if ((!module_switch) && (i<4))
+                if (i<4)
                     continue;
 
                 if (!glulx_mode) {
index ea495505cf70bdef2b8f4bce014f0a4b1ff24dfd..56572acf7eeb6e396106d79c5b1512e91d771dac 100644 (file)
@@ -1,7 +1,7 @@
 /* ------------------------------------------------------------------------- */
 /*   "states" :  Statement translator                                        */
 /*                                                                           */
-/*   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            */
@@ -1100,16 +1100,10 @@ static void parse_statement_z(int break_label, int continue_label)
                      statement_debug_location = spare_debug_location2;
                      if (flag > 0)
                      {   INITAOTV(&AO3, SHORT_CONSTANT_OT, flag);
-                         if (module_switch
-                             && (flag>=MAX_LOCAL_VARIABLES) && (flag<LOWEST_SYSTEM_VAR_NUMBER))
-                             AO3.marker = VARIABLE_MV;
                          assemblez_1(inc_zc, AO3);
                      }
                      else
                      {   INITAOTV(&AO3, SHORT_CONSTANT_OT, -flag);
-                         if ((module_switch) && (flag>=MAX_LOCAL_VARIABLES)
-                             && (flag<LOWEST_SYSTEM_VAR_NUMBER))
-                             AO3.marker = VARIABLE_MV;
                          assemblez_1(dec_zc, AO3);
                      }
                      assemblez_jump(ln);
@@ -1372,9 +1366,6 @@ static void parse_statement_z(int break_label, int continue_label)
                  {   ebf_error("'objectloop' variable", token_text);
                      panic_mode_error_recovery(); break;
                  }
-                 if ((module_switch) && (AO.value >= MAX_LOCAL_VARIABLES)
-                     && (AO.value < LOWEST_SYSTEM_VAR_NUMBER))
-                     AO.marker = VARIABLE_MV;
                  misc_keywords.enabled = TRUE;
                  get_next_token(); flag = TRUE;
                  misc_keywords.enabled = FALSE;
index 8f2a09e52c90a4bd563e73bec844235caa60cb5f..e8ac5b6446031572fd6bd4c4e3f90e89276b48b3 100644 (file)
@@ -1,7 +1,7 @@
 /* ------------------------------------------------------------------------- */
 /*   "symbols" :  The symbols table; creating stock of reserved words        */
 /*                                                                           */
-/*   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            */
@@ -521,8 +521,6 @@ extern void check_warn_symbol_has_metaclass(const assembly_operand *AO, char *co
 extern void issue_unused_warnings(void)
 {   int32 i;
 
-    if (module_switch) return;
-
     /*  Update any ad-hoc variables that might help the library  */
     if (glulx_mode)
     {   global_initial_value[10]=statusline_flag;
@@ -553,8 +551,8 @@ extern void issue_debug_symbol_warnings(void)
 }
 
 /* ------------------------------------------------------------------------- */
-/*   These are arrays used only during story file (never module) creation,   */
-/*   and not allocated until then.                                           */
+/*   These are arrays used only during story file creation, and not          */
+/*   allocated until then.                                                   */
 
        int32 *individual_name_strings; /* Packed addresses of Z-encoded
                                           strings of the names of the
@@ -571,8 +569,6 @@ extern void write_the_identifier_names(void)
     for (i=0; i<no_individual_properties; i++)
         individual_name_strings[i] = 0;
 
-    if (module_switch) return;
-
     veneer_mode = TRUE;
 
     null_value = compile_string(unknown_attribute, STRCTX_SYMBOL);
@@ -821,18 +817,12 @@ static void stockup_symbols(void)
         create_rsymbol("Grammar__Version", 2, CONSTANT_T);
     grammar_version_symbol = symbol_index("Grammar__Version", -1);
 
-    if (module_switch)
-        create_rsymbol("MODULE_MODE",0, CONSTANT_T);
-
     if (runtime_error_checking_switch)
         create_rsymbol("STRICT_MODE",0, CONSTANT_T);
 
     if (define_DEBUG_switch)
         create_rsymbol("DEBUG",      0, CONSTANT_T);
 
-    if (define_USE_MODULES_switch)
-        create_rsymbol("USE_MODULES",0, CONSTANT_T);
-
     if (define_INFIX_switch)
     {   create_rsymbol("INFIX",      0, CONSTANT_T);
         create_symbol("infix__watching", 0, ATTRIBUTE_T);
@@ -940,6 +930,14 @@ static void stockup_symbols(void)
         create_symbol("FLOAT_INFINITY",  0x7F800000, CONSTANT_T);
         create_symbol("FLOAT_NINFINITY", 0xFF800000, CONSTANT_T);
         create_symbol("FLOAT_NAN",       0x7FC00000, CONSTANT_T);
+        /* Same for double constants. Each of these has a high 32-bit
+           word and a low 32-bit word. */
+        create_symbol("DOUBLE_HI_INFINITY",  0x7FF00000, CONSTANT_T);
+        create_symbol("DOUBLE_LO_INFINITY",  0x00000000, CONSTANT_T);
+        create_symbol("DOUBLE_HI_NINFINITY", 0xFFF00000, CONSTANT_T);
+        create_symbol("DOUBLE_LO_NINFINITY", 0x00000000, CONSTANT_T);
+        create_symbol("DOUBLE_HI_NAN",       0x7FF80000, CONSTANT_T);
+        create_symbol("DOUBLE_LO_NAN",       0x00000001, CONSTANT_T);
     }
 
     if (symbol_definitions && symbol_definitions_count) {
index f99de050b87089721355ca52cd7e597df316f608..ad7e121e62ffa0d2f83519fdb52016564b6b1d56 100644 (file)
@@ -1,7 +1,7 @@
 /* ------------------------------------------------------------------------- */
 /*   "syntax" : Syntax analyser and compiler                                 */
 /*                                                                           */
-/*   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            */
index 389eb4bca1506a9d4aa99fe161d461717442ea30..505b1e6b6559fe728bbd5401546ecb2244d96e05 100644 (file)
@@ -1,9 +1,9 @@
 /* ------------------------------------------------------------------------- */
-/*   "tables" :  Constructs the story file or module (the output) up to the  */
-/*               end of dynamic memory, gluing together all the required     */
+/*   "tables" :  Constructs the story file (the output) up to the end        */
+/*               of dynamic memory, gluing together all the required         */
 /*               tables.                                                     */
 /*                                                                           */
-/*   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            */
@@ -99,7 +99,7 @@ int flags2_requirements[16];           /* An array of which bits in Flags 2 of
                                           Values are 0 or 1.                 */
 
 /* ------------------------------------------------------------------------- */
-/*   Construct story/module file (up to code area start).                    */
+/*   Construct story file (up to code area start).                           */
 /*                                                                           */
 /*   (To understand what follows, you really need to look at the run-time    */
 /*   system's specification, the Z-Machine Standards document.)              */
@@ -181,7 +181,7 @@ static int32 rough_size_of_paged_memory_z(void)
     total += 2*((version_number==3)?31:63)        /* property default values */
             + no_objects*((version_number==3)?9:14)     /* object tree table */
             + properties_table_size            /* property values of objects */
-            + (no_classes+1)*(module_switch?4:2)
+            + (no_classes+1)*2
                                                /* class object numbers table */
             + no_symbols*2                       /* names of numerous things */
             + individuals_length                 /* tables of prop variables */
@@ -201,7 +201,7 @@ static int32 rough_size_of_paged_memory_z(void)
               + 2*no_grammar_token_routines;     /* general parsing routines */
 
     total += (dictionary_top)                            /* dictionary size */
-             + ((module_switch)?30:0);                        /* module map */
+             + (0);                                           /* module map */
 
     total += static_array_area_size;                       /* static arrays */
 
@@ -258,13 +258,13 @@ static void construct_storyfile_z(void)
 {   uchar *p;
     int32 i, j, k, l, mark, objs, strings_length, code_length,
           limit=0, excess=0, extend_offset=0, headerext_length=0;
-    int32 globals_at=0, link_table_at=0, dictionary_at=0, actions_at=0, preactions_at=0,
+    int32 globals_at=0, dictionary_at=0, actions_at=0, preactions_at=0,
           abbrevs_at=0, prop_defaults_at=0, object_tree_at=0, object_props_at=0,
-          map_of_module=0, grammar_table_at=0, charset_at=0, headerext_at=0,
+          grammar_table_at=0, charset_at=0, headerext_at=0,
           terminating_chars_at=0, unicode_at=0, id_names_length=0,
           static_arrays_at=0;
     int skip_backpatching = FALSE;
-    char *output_called = (module_switch)?"module":"story file";
+    char *output_called = "story file";
 
     ASSERT_ZCODE();
 
@@ -423,14 +423,8 @@ static void construct_storyfile_z(void)
             p[objs+9]=(objectsz[i].next)%256;
             p[objs+10]=(objectsz[i].child)/256;
             p[objs+11]=(objectsz[i].child)%256;
-            if (!module_switch)
-            {   p[objs+12]=mark/256;
-                p[objs+13]=mark%256;
-            }
-            else
-            {   p[objs+12]=objectsz[i].propsize/256;
-                p[objs+13]=objectsz[i].propsize%256;
-            }
+            p[objs+12]=mark/256;
+            p[objs+13]=mark%256;
             objs+=14;
         }
         mark+=objectsz[i].propsize;
@@ -442,10 +436,6 @@ static void construct_storyfile_z(void)
     for (i=0; i<no_classes; i++)
     {   p[mark++] = class_info[i].object_number/256;
         p[mark++] = class_info[i].object_number%256;
-        if (module_switch)
-        {   p[mark++] = class_info[i].begins_at/256;
-            p[mark++] = class_info[i].begins_at%256;
-        }
     }
     p[mark++] = 0;
     p[mark++] = 0;
@@ -454,7 +444,7 @@ static void construct_storyfile_z(void)
 
     identifier_names_offset = mark;
 
-    if (!module_switch)
+    if (TRUE)
     {   p[mark++] = no_individual_properties/256;
         p[mark++] = no_individual_properties%256;
         for (i=1; i<no_individual_properties; i++)
@@ -629,10 +619,7 @@ table format requested (producing number 2 format instead)");
 
     /*  ------------------------- Module Map ------------------------------- */
 
-    if (module_switch)
-    {   map_of_module = mark;                             /* Filled in below */
-        mark += 30;
-    }
+    /* (no longer used) */
 
     /*  ------------------------ Static Arrays ----------------------------- */
 
@@ -680,10 +667,8 @@ or less.");
     /*  ------------------ Another synchronising gap ----------------------- */
 
     if (oddeven_packing_switch)
-    {   if (module_switch)
-             while ((mark%(scale_factor*2)) != 0) mark++;
-        else
-             while ((mark%(scale_factor*2)) != scale_factor) mark++;
+    {   
+        while ((mark%(scale_factor*2)) != scale_factor) mark++;
     }
     else
         while ((mark%scale_factor) != 0) mark++;
@@ -696,11 +681,7 @@ or less.");
 
     /*  --------------------- Module Linking Data -------------------------- */
 
-    if (module_switch)
-    {   link_table_at = mark; mark += link_data_size;
-        mark += zcode_backpatch_size;
-        mark += zmachine_backpatch_size;
-    }
+    /* (no longer used) */
 
     /*  --------------------- Is the file too big? ------------------------- */
 
@@ -715,10 +696,6 @@ or less.");
         case 8: excess = Out_Size-((int32) 0x80000L); limit = 512; break;
     }
 
-    if (module_switch)
-    {   excess = Out_Size-((int32) 0x10000L); limit=64;
-    }
-
     if (excess > 0)
     {   char memory_full_error[80];
         sprintf(memory_full_error,
@@ -865,54 +842,11 @@ or less.");
 
     /*  ----------------- The Header: Extras for modules ------------------- */
 
-    if (module_switch)
-    {   p[0]=p[0]+64;
-        p[1]=MODULE_VERSION_NUMBER;
-        p[6]=map_of_module/256;
-        p[7]=map_of_module%256;
-
-        mark = map_of_module;                       /*  Module map format:   */
-
-        p[mark++]=object_tree_at/256;               /*  0: Object tree addr  */
-        p[mark++]=object_tree_at%256;
-        p[mark++]=object_props_at/256;              /*  2: Prop values addr  */
-        p[mark++]=object_props_at%256;
-        p[mark++]=(Write_Strings_At/scale_factor)/256;  /*  4: Static strs   */
-        p[mark++]=(Write_Strings_At/scale_factor)%256;
-        p[mark++]=class_numbers_offset/256;         /*  6: Class nos addr    */
-        p[mark++]=class_numbers_offset%256;
-        p[mark++]=individuals_offset/256;           /*  8: Indiv prop values */
-        p[mark++]=individuals_offset%256;
-        p[mark++]=individuals_length/256;           /*  10: Length of table  */
-        p[mark++]=individuals_length%256;
-        p[mark++]=no_symbols/256;                   /*  12: No of symbols    */
-        p[mark++]=no_symbols%256;
-        p[mark++]=no_individual_properties/256;     /*  14: Max property no  */
-        p[mark++]=no_individual_properties%256;
-        p[mark++]=no_objects/256;                   /*  16: No of objects    */
-        p[mark++]=no_objects%256;
-        i = link_table_at;
-        p[mark++]=i/256;                            /*  18: Import/exports   */
-        p[mark++]=i%256;
-        p[mark++]=link_data_size/256;               /*  20: Size of          */
-        p[mark++]=link_data_size%256;
-        i += link_data_size;
-        p[mark++]=i/256;                            /*  22: Code backpatch   */
-        p[mark++]=i%256;
-        p[mark++]=zcode_backpatch_size/256;         /*  24: Size of          */
-        p[mark++]=zcode_backpatch_size%256;
-        i += zcode_backpatch_size;
-        p[mark++]=i/256;                            /*  26: Image backpatch  */
-        p[mark++]=i%256;
-        p[mark++]=zmachine_backpatch_size/256;      /*  28: Size of          */
-        p[mark++]=zmachine_backpatch_size%256;
-
-        /*  Further space in this table is reserved for future use  */
-    }
+    /* (no longer used) */
 
     /*  ---- Backpatch the Z-machine, now that all information is in ------- */
 
-    if (!module_switch && !skip_backpatching)
+    if (!skip_backpatching)
     {   backpatch_zmachine_image_z();
         for (i=1; i<id_names_length; i++)
         {   int32 v = 256*p[identifier_names_offset + i*2]
@@ -1079,17 +1013,9 @@ printf("        + - - - - - - - - - - +   %05lx\n",
 printf("        |     adjectives      |   %s\n",
     show_percentage(dictionary_at-adjectives_offset, Out_Size));
 printf("        +---------------------+   %05lx\n", (long int) dictionary_at);
-addr = (module_switch ? map_of_module : (static_array_area_size ? static_arrays_at : Write_Code_At));
+addr = (static_array_area_size ? static_arrays_at : Write_Code_At);
 printf("        |     dictionary      |   %s\n",
     show_percentage(addr-dictionary_at, Out_Size));
-if (module_switch)
-{
-printf("        + - - - - - - - - - - +   %05lx\n",
-                                          (long int) map_of_module);
-addr = (static_array_area_size ? static_arrays_at : Write_Code_At);
-printf("        | map of module addrs |   %s\n",
-    show_percentage(addr-map_of_module, Out_Size));
-}
 if (static_array_area_size)
 {
 printf("        +---------------------+   %05lx\n", (long int) static_arrays_at);
@@ -1101,15 +1027,9 @@ printf("Above   |       Z-code        |   %s\n",
     show_percentage(Write_Strings_At-Write_Code_At, Out_Size));
 printf("readable+---------------------+   %05lx\n",
                                           (long int) Write_Strings_At);
-addr = (module_switch ? link_table_at : Out_Size);
+addr = (Out_Size);
 printf("memory  |       strings       |   %s\n",
     show_percentage(addr-Write_Strings_At, Out_Size));
-if (module_switch)
-{
-printf("        +=====================+   %05lx\n", (long int) link_table_at);
-printf("        | module linking data |   %s\n",
-    show_percentage(Out_Size-link_table_at, Out_Size));
-}
 printf("        +---------------------+   %05lx\n", (long int) Out_Size);
         }
     }
@@ -1488,7 +1408,7 @@ table format requested (producing number 2 format instead)");
 
     /*  ------ Backpatch the machine, now that all information is in ------- */
 
-    if (!module_switch)
+    if (TRUE)
     {   backpatch_zmachine_image_g();
 
         mark = actions_at + 4;
@@ -1695,7 +1615,7 @@ static void display_statistics_z()
     int32 k_long, rate;
     char *k_str = "";
     uchar *p = (uchar *) zmachine_paged_memory;
-    char *output_called = (module_switch)?"module":"story file";
+    char *output_called = "story file";
     int limit = 0;
 
     /* Yeah, we're repeating this calculation from construct_storyfile_z() */
@@ -1796,7 +1716,7 @@ static void display_statistics_g()
     char *k_str = "";
     int32 limit = 1024*1024;
     int32 strings_length = compression_table_size + compression_string_size;
-    char *output_called = (module_switch)?"module":"story file";
+    char *output_called = "story file";
     
     k_long=(Out_Size/1024);
     if ((Out_Size-1024*k_long) >= 512) { k_long++; k_str=""; }
index 525ecec6da03a40df06bc9b28d51f9b25bc28cbc..03d11301d6668ecb284aea2990b9d1f2ea6c892c 100644 (file)
@@ -1,7 +1,7 @@
 /* ------------------------------------------------------------------------- */
 /*   "text" : Text translation, the abbreviations optimiser, the dictionary  */
 /*                                                                           */
-/*   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            */
@@ -224,6 +224,10 @@ static int try_abbreviations_from(unsigned char *text, int i, int from)
 
 extern void make_abbreviation(char *text)
 {
+    /* If -e mode is off, we won't waste space creating an abbreviation entry. */
+    if (!economy_switch)
+        return;
+    
     ensure_memory_list_available(&abbreviations_memlist, no_abbreviations+1);
     ensure_memory_list_available(&abbreviations_at_memlist, no_abbreviations+1);
     
@@ -2094,16 +2098,9 @@ static void recursively_sort(int node)
 }
 
 extern void sort_dictionary(void)
-{   int i;
-    
+{    
     final_dict_order = my_calloc(sizeof(int), dict_entries, "final dictionary ordering table");
     
-    if (module_switch)
-    {   for (i=0; i<dict_entries; i++)
-            final_dict_order[i] = i;
-        return;
-    }
-
     if (root != VACANT)
     {   fdo_count = 0; recursively_sort(root);
     }
@@ -2330,9 +2327,8 @@ extern void dictionary_set_verb_number(char *dword, int to)
 }
 
 /* ------------------------------------------------------------------------- */
-/*   Tracing code for the dictionary: used not only by "trace" and text      */
-/*   transcription, but also (in the case of "word_to_ascii") in a vital     */
-/*   by the linker.                                                          */
+/*   Tracing code for the dictionary: used by "trace" and text               */
+/*   transcription.                                                          */
 /* ------------------------------------------------------------------------- */
 
 /* In the dictionary-showing code, if d_show_buf is NULL, the text is
index ce29ceb566e464cc261c5460417fd202540693c5..1e8616cd2a0694d277ace64eba14179e40c0b64f 100644 (file)
@@ -3,7 +3,7 @@
 /*              by the compiler (e.g. DefArt) which the program doesn't      */
 /*              provide                                                      */
 /*                                                                           */
-/*   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            */
@@ -2345,8 +2345,6 @@ extern void compile_veneer(void)
 {   int i, j, try_veneer_again;
     VeneerRoutine *VRs; 
 
-    if (module_switch) return;
-
     VRs = (!glulx_mode) ? VRs_z : VRs_g;
 
     /*  Called at the end of the pass to insert as much of the veneer as is
index 31b42bb2ee999a5c92087c6c2c840f7e5ea9aa64..9fe65bc913a4491d1d316b27fb6fb3fd6e98f3e0 100644 (file)
@@ -2,7 +2,7 @@
 /*   "verbs" :  Manages actions and grammar tables; parses the directives    */
 /*              Verb and Extend.                                             */
 /*                                                                           */
-/*   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            */
@@ -309,8 +309,8 @@ extern void list_verb_table(void)
 static void new_action(char *b, int c)
 {
     /*  Called whenever a new action (or fake action) is created (either
-        by using make_action above, or the Fake_Action directive, or by
-        the linker).  At present just a hook for some tracing code.          */
+        by using make_action above, or the Fake_Action directive).
+        At present just a hook for some tracing code.                        */
 
     if (printactions_switch)
         printf("Action '%s' is numbered %d\n",b,c);
@@ -400,7 +400,7 @@ extern assembly_operand action_of_name(char *name)
     AO.value = symbols[j].value;
     AO.marker = ACTION_MV;
     if (!glulx_mode) {
-      AO.type = (module_switch)?LONG_CONSTANT_OT:SHORT_CONSTANT_OT;
+      AO.type = SHORT_CONSTANT_OT;
       if (symbols[j].value >= 256) AO.type = LONG_CONSTANT_OT;
     }
     else {
@@ -414,9 +414,6 @@ extern void find_the_actions(void)
     char action_name[MAX_IDENTIFIER_LENGTH+4];
     char action_sub[MAX_IDENTIFIER_LENGTH+4];
 
-    if (module_switch)
-        for (i=0; i<no_actions; i++) actions[i].byte_offset = 0;
-    else
     for (i=0; i<no_actions; i++)
     {   strcpy(action_name, symbols[actions[i].symbol].name);
         action_name[strlen(action_name) - 3] = '\0'; /* remove "__A" */