Update to Inform v6.42

Commit e528e4802e3fdc2364a9a92aa127e7a5091a8d4e dated February 10 2024.
These changes are similiarly relicensed to GPL per Section 4(c)(ii) of
the Artistic License 2.0.

diff --git a/configure.ac b/configure.ac
index 0ff8cedcadd4356575eb4139840bcd978e964c48..971edc42ad4d4559d3f5ae43ba9bd79e7fac97b0 100644 (file)
--- a/configure.ac
+++ b/configure.ac
@@ -15,7 +15,7 @@
 # You should have received a copy of the GNU General Public License
 # along with Inform. If not, see https://gnu.org/licenses/
 
 # You should have received a copy of the GNU General Public License
 # along with Inform. If not, see https://gnu.org/licenses/
 

-AC_INIT([inform], [6.41], [j@jxself.org])
+AC_INIT([inform], [6.42], [j@jxself.org])

 AM_INIT_AUTOMAKE([foreign])
 AC_OUTPUT(Makefile src/Makefile)
 
 AM_INIT_AUTOMAKE([foreign])
 AC_OUTPUT(Makefile src/Makefile)
 

diff --git a/src/arrays.c b/src/arrays.c
index c48cc65dfbf85fc7ed2f57a29b59ba8a23e78094..82caa7cb11ba187142d4ebf87ad480b57603dbc1 100644 (file)
--- a/src/arrays.c
+++ b/src/arrays.c
@@ -3,8 +3,8 @@
 /*               likewise global variables, which are in some ways a         */
 /*               simpler form of the same thing.                             */
 /*                                                                           */
 /*               likewise global variables, which are in some ways a         */
 /*               simpler form of the same thing.                             */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -292,7 +292,7 @@ extern void make_global()
     int name_length;
     assembly_operand AO;
 
     int name_length;
     assembly_operand AO;
 

-    int32 globalnum;
+    uint32 globalnum;

     int32 global_symbol;
     debug_location_beginning beginning_debug_location =
         get_token_location_beginning();
     int32 global_symbol;
     debug_location_beginning beginning_debug_location =
         get_token_location_beginning();


@@ -322,7 +322,7 @@ extern void make_global()
 
     if (token_type != SYMBOL_TT)
     {   discard_token_location(beginning_debug_location);
 
     if (token_type != SYMBOL_TT)
     {   discard_token_location(beginning_debug_location);

-        ebf_error("new global variable name", token_text);
+        ebf_curtoken_error("new global variable name");

         panic_mode_error_recovery(); return;
     }
 
         panic_mode_error_recovery(); return;
     }
 


@@ -413,7 +413,7 @@ extern void make_global()
                 4*globalnum);
     }
     
                 4*globalnum);
     }
     

-    if (globalnum < 0 || globalnum >= global_initial_value_memlist.count)
+    if (globalnum >= global_initial_value_memlist.count)

         compiler_error("Globalnum out of range");
     global_initial_value[globalnum] = AO.value;
     
         compiler_error("Globalnum out of range");
     global_initial_value[globalnum] = AO.value;
     


@@ -456,7 +456,7 @@ extern void make_array()
 
     if (token_type != SYMBOL_TT)
     {   discard_token_location(beginning_debug_location);
 
     if (token_type != SYMBOL_TT)
     {   discard_token_location(beginning_debug_location);

-        ebf_error("new array name", token_text);
+        ebf_curtoken_error("new array name");

         panic_mode_error_recovery(); return;
     }
 
         panic_mode_error_recovery(); return;
     }
 


@@ -492,7 +492,7 @@ extern void make_array()
     if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
     {
         discard_token_location(beginning_debug_location);
     if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
     {
         discard_token_location(beginning_debug_location);

-        ebf_error("array definition", token_text);
+        ebf_curtoken_error("array definition");

         put_token_back();
         return;
     }
         put_token_back();
         return;
     }


@@ -516,8 +516,7 @@ extern void make_array()
              array_type = BUFFER_ARRAY;
     else
     {   discard_token_location(beginning_debug_location);
              array_type = BUFFER_ARRAY;
     else
     {   discard_token_location(beginning_debug_location);

-        ebf_error
-            ("'->', '-->', 'string', 'table' or 'buffer'", token_text);
+        ebf_curtoken_error("'->', '-->', 'string', 'table' or 'buffer'");

         panic_mode_error_recovery();
         return;
     }
         panic_mode_error_recovery();
         return;
     }


@@ -632,6 +631,8 @@ extern void make_array()
                 put_token_back();
 
                 AO = parse_expression(ARRAY_CONTEXT);
                 put_token_back();
 
                 AO = parse_expression(ARRAY_CONTEXT);

+                if (AO.marker == ERROR_MV)
+                    break;

 
                 if (i == 0)
                 {   get_next_token();
 
                 if (i == 0)
                 {   get_next_token();


@@ -656,7 +657,7 @@ extern void make_array()
 
             get_next_token();
             if (token_type != DQ_TT)
 
             get_next_token();
             if (token_type != DQ_TT)

-            {   ebf_error("literal text in double-quotes", token_text);
+            {   ebf_curtoken_error("literal text in double-quotes");

                 token_text = "error";
             }
 
                 token_text = "error";
             }
 


@@ -705,6 +706,7 @@ advance as part of 'Zcharacter table':", unicode);
             i = 0;
             while (TRUE)
             {
             i = 0;
             while (TRUE)
             {

+                assembly_operand AO;

                 /* This isn't the start of a statement, but it's safe to
                    release token texts anyway. Expressions in an array
                    list are independent of each other. */
                 /* This isn't the start of a statement, but it's safe to
                    release token texts anyway. Expressions in an array
                    list are independent of each other. */


@@ -719,11 +721,14 @@ advance as part of 'Zcharacter table':", unicode);
                         been missed, and the programmer is now starting
                         a new routine                                        */
 
                         been missed, and the programmer is now starting
                         a new routine                                        */
 

-                    ebf_error("']'", token_text);
+                    ebf_curtoken_error("']'");

                     put_token_back(); break;
                 }
                 put_token_back();
                     put_token_back(); break;
                 }
                 put_token_back();

-                array_entry(i, is_static, parse_expression(ARRAY_CONTEXT));
+                AO = parse_expression(ARRAY_CONTEXT);
+                if (AO.marker == ERROR_MV)
+                    break;
+                array_entry(i, is_static, AO);

                 i++;
             }
     }
                 i++;
             }
     }


@@ -864,7 +869,7 @@ extern void arrays_allocate_arrays(void)
         "global variable values");
 
     initialise_memory_list(&current_array_name,
         "global variable values");
 
     initialise_memory_list(&current_array_name,

-        sizeof(char), MAX_IDENTIFIER_LENGTH+1, NULL,
+        sizeof(char), 32, NULL,

         "array name currently being defined");
 }
 
         "array name currently being defined");
 }
 

diff --git a/src/asm.c b/src/asm.c
index 2736ad1f1f08a0bbb80ae586091cd91c565c17a5..858ff9dd59477220fdc1887cc59386ed7c935ef6 100644 (file)
--- a/src/asm.c
+++ b/src/asm.c
@@ -1,8 +1,8 @@
 /* ------------------------------------------------------------------------- */
 /*   "asm" : The Inform assembler                                            */
 /*                                                                           */
 /* ------------------------------------------------------------------------- */
 /*   "asm" : The Inform assembler                                            */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -92,11 +92,9 @@ static char opcode_syntax_string[128];  /*  Text buffer holding the correct
 static int routine_symbol;         /* The symbol index of the routine currently
                                       being compiled */
 static memory_list current_routine_name; /* The name of the routine currently
 static int routine_symbol;         /* The symbol index of the routine currently
                                       being compiled */
 static memory_list current_routine_name; /* The name of the routine currently

-                                      being compiled. (This may be longer
-                                      than MAX_IDENTIFIER_LENGTH, e.g. for
-                                      an "obj.prop" property routine.)       */
-static int routine_locals;         /* The number of local variables used by
-                                      the routine currently being compiled   */
+                                      being compiled. (This may not be a
+                                      simple symbol, e.g. for an "obj.prop"
+                                      property routine.)                     */

 
 static int32 routine_start_pc;
 
 
 static int32 routine_start_pc;
 


@@ -322,7 +320,7 @@ extern int is_variable_ot(int otval)
 extern char *variable_name(int32 i)
 {
     if (i==0) return("sp");
 extern char *variable_name(int32 i)
 {
     if (i==0) return("sp");

-    if (i<MAX_LOCAL_VARIABLES) return local_variable_names[i-1].text;
+    if (i<MAX_LOCAL_VARIABLES) return get_local_variable_name(i-1);

 
     if (!glulx_mode) {
       if (i==255) return("TEMP1");
 
     if (!glulx_mode) {
       if (i==255) return("TEMP1");


@@ -657,7 +655,12 @@ static opcodez opcodes_table_z[] =
     /* Opcodes introduced in Z-Machine Specification Standard 1.0 */
 
 /* 116 */ { (uchar *) "print_unicode", 5, 0, -1, 0x0b,      0,      0, 0, EXT },
     /* Opcodes introduced in Z-Machine Specification Standard 1.0 */
 
 /* 116 */ { (uchar *) "print_unicode", 5, 0, -1, 0x0b,      0,      0, 0, EXT },

-/* 117 */ { (uchar *) "check_unicode", 5, 0, -1, 0x0c,     St,      0, 0, EXT }
+/* 117 */ { (uchar *) "check_unicode", 5, 0, -1, 0x0c,     St,      0, 0, EXT },
+
+    /* Opcodes introduced in Z-Machine Specification Standard 1.1 */
+
+/* 118 */ { (uchar *) "set_true_colour", 5, 0, -1, 0x0d,    0,      0, 0, EXT },
+/* 119 */ { (uchar *) "buffer_screen",   6, 6, -1, 0x1d,   St,      0, 0, EXT }

 };
 
     /* Subsequent forms for opcodes whose meaning changes with version */
 };
 
     /* Subsequent forms for opcodes whose meaning changes with version */


@@ -872,6 +875,7 @@ static opcodez internal_number_to_opcode_z(int32 i)
 
 static void make_opcode_syntax_z(opcodez opco)
 {   char *p = "", *q = opcode_syntax_string;
 
 static void make_opcode_syntax_z(opcodez opco)
 {   char *p = "", *q = opcode_syntax_string;

+    /* TODO: opcode_syntax_string[128] is unsafe */

     sprintf(q, "%s", opco.name);
     switch(opco.no)
     {   case ONE: p=" <operand>"; break;
     sprintf(q, "%s", opco.name);
     switch(opco.no)
     {   case ONE: p=" <operand>"; break;


@@ -919,6 +923,7 @@ static void make_opcode_syntax_g(opcodeg opco)
     int ix;
     char *cx;
     char *q = opcode_syntax_string;
     int ix;
     char *cx;
     char *q = opcode_syntax_string;

+    /* TODO: opcode_syntax_string[128] is unsafe */

 
     sprintf(q, "%s", opco.name);
     sprintf(q+strlen(q), " <%d operand%s", opco.no,
 
     sprintf(q, "%s", opco.name);
     sprintf(q+strlen(q), " <%d operand%s", opco.no,


@@ -1250,6 +1255,8 @@ extern void assemblez_instruction(const assembly_instruction *AI)
         {   for (j=0;start_pc<zcode_ha_size;
                  j++, start_pc++)
             {   if (j%16==0) printf("\n                               ");
         {   for (j=0;start_pc<zcode_ha_size;
                  j++, start_pc++)
             {   if (j%16==0) printf("\n                               ");

+                if (zcode_markers[start_pc] & 0x7f)
+                    printf("{%s}", describe_mv_short(zcode_markers[start_pc] & 0x7f));

                 printf("%02x ", zcode_holding_area[start_pc]);
             }
         }
                 printf("%02x ", zcode_holding_area[start_pc]);
             }
         }


@@ -1317,7 +1324,7 @@ static void assembleg_macro(const assembly_instruction *AI)
             AMO_1 = AI->operand[1];
             AMO_2 = AI->operand[2];
             if ((AMO_0.type == LOCALVAR_OT) && (AMO_0.value == 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
+                /* 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);
                 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);


@@ -1333,7 +1340,7 @@ static void assembleg_macro(const assembly_instruction *AI)
             AMO_1 = AI->operand[1];
             AMO_2 = AI->operand[2];
             if ((AMO_0.type == LOCALVAR_OT) && (AMO_0.value == 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
+                /* 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);
                 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);


@@ -1647,9 +1654,9 @@ extern void assembleg_instruction(const assembly_instruction *AI)
                 printf("%02x ", zcode_holding_area[start_pc]);
             }
             else {
                 printf("%02x ", zcode_holding_area[start_pc]);
             }
             else {

-                printf("%02x", zcode_holding_area[start_pc]);

                 if (zcode_markers[start_pc])
                 if (zcode_markers[start_pc])

-                    printf("{%02x}", zcode_markers[start_pc]);
+                    printf("{%s}", describe_mv_short(zcode_markers[start_pc]));
+                printf("%02x", zcode_holding_area[start_pc]);

                 printf(" ");
             }
         }
                 printf(" ");
             }
         }


@@ -1722,22 +1729,22 @@ extern void define_symbol_label(int symbol)
     labels[label].symbol = symbol;
 }
 
     labels[label].symbol = symbol;
 }
 

-extern int32 assemble_routine_header(int no_locals,
-    int routine_asterisked, char *name, int embedded_flag, int the_symbol)
+/* The local variables must already be set up; no_locals indicates
+   how many exist. */
+extern int32 assemble_routine_header(int routine_asterisked, char *name,
+    int embedded_flag, int the_symbol)

 {   int i, rv;
     int stackargs = FALSE;
     int name_length;
 
     execution_never_reaches_here = EXECSTATE_REACHABLE;
 
 {   int i, rv;
     int stackargs = FALSE;
     int name_length;
 
     execution_never_reaches_here = EXECSTATE_REACHABLE;
 

-    routine_locals = no_locals;
-    

     ensure_memory_list_available(&variables_memlist, MAX_LOCAL_VARIABLES);
     for (i=0; i<MAX_LOCAL_VARIABLES; i++) variables[i].usage = FALSE;
 
     if (no_locals >= 1
     ensure_memory_list_available(&variables_memlist, MAX_LOCAL_VARIABLES);
     for (i=0; i<MAX_LOCAL_VARIABLES; i++) variables[i].usage = FALSE;
 
     if (no_locals >= 1

-      && strcmpcis(local_variable_names[0].text, "_vararg_count")==0) {
-      stackargs = TRUE;
+        && strcmpcis(get_local_variable_name(0), "_vararg_count")==0) {
+        stackargs = TRUE;

     }
 
     if (veneer_mode) routine_starts_line = blank_brief_location;
     }
 
     if (veneer_mode) routine_starts_line = blank_brief_location;


@@ -1800,7 +1807,8 @@ extern int32 assemble_routine_header(int no_locals,
 
       if ((routine_asterisked) || (define_INFIX_switch))
       {   char fnt[256]; assembly_operand PV, RFA, CON, STP, SLF; int ln, ln2;
 
       if ((routine_asterisked) || (define_INFIX_switch))
       {   char fnt[256]; assembly_operand PV, RFA, CON, STP, SLF; int ln, ln2;

-
+          /* TODO: fnt[256] is unsafe */
+          

           ln = next_label++;
           ln2 = next_label++;
 
           ln = next_label++;
           ln2 = next_label++;
 


@@ -2044,7 +2052,7 @@ void assemble_routine_end(int embedded_flag, debug_locations locations)
         debug_file_printf
             ("<byte-count>%d</byte-count>", zmachine_pc - routine_start_pc);
         write_debug_locations(locations);
         debug_file_printf
             ("<byte-count>%d</byte-count>", zmachine_pc - routine_start_pc);
         write_debug_locations(locations);

-        for (i = 1; i <= routine_locals; ++i)
+        for (i = 1; i <= no_locals; ++i)

         {   debug_file_printf("<local-variable>");
             debug_file_printf("<identifier>%s</identifier>", variable_name(i));
             if (glulx_mode)
         {   debug_file_printf("<local-variable>");
             debug_file_printf("<identifier>%s</identifier>", variable_name(i));
             if (glulx_mode)


@@ -2070,7 +2078,7 @@ void assemble_routine_end(int embedded_flag, debug_locations locations)
 
     /* Issue warnings about any local variables not used in the routine. */
 
 
     /* Issue warnings about any local variables not used in the routine. */
 

-    for (i=1; i<=routine_locals; i++)
+    for (i=1; i<=no_locals; i++)

         if (!(variables[i].usage))
             dbnu_warning("Local variable", variable_name(i),
                 routine_starts_line);
         if (!(variables[i].usage))
             dbnu_warning("Local variable", variable_name(i),
                 routine_starts_line);


@@ -2216,7 +2224,7 @@ static void transfer_routine_z(void)
                 addr = labels[j].offset - offset_of_next + 2;
             }
             if (addr<-0x2000 || addr>0x1fff) 
                 addr = labels[j].offset - offset_of_next + 2;
             }
             if (addr<-0x2000 || addr>0x1fff) 

-                fatalerror("Branch out of range: divide the routine up?");
+                error_fmt("Branch out of range: routine \"%s\" is too large", current_routine_name.data);

             if (addr<0) addr+=(int32) 0x10000L;
 
             addr=addr&0x3fff;
             if (addr<0) addr+=(int32) 0x10000L;
 
             addr=addr&0x3fff;


@@ -2247,7 +2255,7 @@ static void transfer_routine_z(void)
                 addr = labels[j].offset - new_pc;
             }
             if (addr<-0x8000 || addr>0x7fff) 
                 addr = labels[j].offset - new_pc;
             }
             if (addr<-0x8000 || addr>0x7fff) 

-                fatalerror("Jump out of range: divide the routine up?");
+                error_fmt("Jump out of range: routine \"%s\" is too large", current_routine_name.data);

             if (addr<0) addr += (int32) 0x10000L;
             zcode_holding_area[i] = addr/256;
             zcode_holding_area[i+1] = addr%256;
             if (addr<0) addr += (int32) 0x10000L;
             zcode_holding_area[i] = addr/256;
             zcode_holding_area[i+1] = addr%256;


@@ -2260,6 +2268,7 @@ static void transfer_routine_z(void)
           default:
             switch(zcode_markers[i] & 0x7f)
             {   case NULL_MV: break;
           default:
             switch(zcode_markers[i] & 0x7f)
             {   case NULL_MV: break;

+                case ERROR_MV: break;

                 case VARIABLE_MV:
                 case OBJECT_MV:
                 case ACTION_MV:
                 case VARIABLE_MV:
                 case OBJECT_MV:
                 case ACTION_MV:


@@ -2485,6 +2494,8 @@ static void transfer_routine_g(void)
         switch(zcode_markers[i] & 0x7f) {
         case NULL_MV: 
             break;
         switch(zcode_markers[i] & 0x7f) {
         case NULL_MV: 
             break;

+        case ERROR_MV:
+            break;

         case ACTION_MV:
         case IDENT_MV:
             break;
         case ACTION_MV:
         case IDENT_MV:
             break;


@@ -3061,7 +3072,9 @@ static assembly_operand parse_operand_z(void)
 }
 
 static void parse_assembly_z(void)
 }
 
 static void parse_assembly_z(void)

-{   int n, min, max, indirect_addressed, error_flag = FALSE;
+{   int n, min, max;
+    int indirect_addressed, jumplabel_args;
+    int error_flag = FALSE;

     opcodez O;
 
     AI.operand_count = 0;
     opcodez O;
 
     AI.operand_count = 0;


@@ -3107,8 +3120,7 @@ static void parse_assembly_z(void)
         if (i>0) token_text[i-1] = ':';
 
         if (n==-1)
         if (i>0) token_text[i-1] = ':';
 
         if (n==-1)

-        {   ebf_error("Expected 0OP, 1OP, 2OP, VAR, EXT, VAR_LONG or EXT_LONG",
-                token_text);
+        {   ebf_curtoken_error("Expected 0OP, 1OP, 2OP, VAR, EXT, VAR_LONG or EXT_LONG");

             n = EXT;
         }
         custom_opcode_z.no = n;
             n = EXT;
         }
         custom_opcode_z.no = n;


@@ -3124,10 +3136,9 @@ static void parse_assembly_z(void)
                 case TWO: max = 32; break;
             }
             if ((custom_opcode_z.code < min) || (custom_opcode_z.code >= max))
                 case TWO: max = 32; break;
             }
             if ((custom_opcode_z.code < min) || (custom_opcode_z.code >= max))

-            {   char range[32];
-                sprintf(range, "%d to %d", min, max-1);
-            error_named("For this operand type, opcode number must be in range",
-                    range);
+            {
+                error_fmt("For this operand type, opcode number must be in range %d to %d",
+                          min, max-1);

                 custom_opcode_z.code = min;
             }
         }
                 custom_opcode_z.code = min;
             }
         }


@@ -3148,9 +3159,74 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
         }
         O = custom_opcode_z;
     }
         }
         O = custom_opcode_z;
     }

+    else if ((token_type == SEP_TT) && (token_value == ARROW_SEP || token_value == DARROW_SEP))
+    {
+        int32 start_pc = zcode_ha_size;
+        int bytecount = 0;
+        int isword = (token_value == DARROW_SEP);
+        while (1) {
+            assembly_operand AO;
+            /* This isn't the start of a statement, but it's safe to
+               release token texts anyway. */
+            release_token_texts();
+            get_next_token();
+            if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
+            put_token_back();
+            AO = parse_expression(ARRAY_CONTEXT);
+            if (AO.marker == ERROR_MV) {
+                break;
+            }
+            if (!isword) {
+                if (AO.marker != 0)
+                    error("Entries in code byte arrays must be known constants");
+                if (AO.value >= 256)
+                    warning("Entry in code byte array not in range 0 to 255");
+            }
+            if (execution_never_reaches_here) {
+                continue;
+            }
+            if (bytecount == 0 && asm_trace_level > 0) {
+                printf("%5d  +%05lx %3s %-12s", ErrorReport.line_number,
+                    ((long int) zmachine_pc), "   ",
+                    isword?"<words>":"<bytes>");
+            }
+            if (!isword) {
+                byteout((AO.value & 0xFF), 0);
+                bytecount++;
+                if (asm_trace_level > 0) {
+                    printf(" %02x", (AO.value & 0xFF));
+                }
+            }
+            else {
+                byteout(((AO.value >> 8) & 0xFF), AO.marker);
+                byteout((AO.value & 0xFF), 0);
+                bytecount += 2;
+                if (asm_trace_level > 0) {
+                    printf(" ");
+                    print_operand(&AO, TRUE);
+                }
+            }
+        }
+        if (bytecount > 0 && asm_trace_level > 0) {
+            printf("\n");
+        }
+        if (asm_trace_level>=2)
+        {
+            int j;
+            for (j=0;start_pc<zcode_ha_size;
+                 j++, start_pc++)
+            {   if (j%16==0) printf("                               ");
+                if (zcode_markers[start_pc] & 0x7f)
+                    printf("{%s}", describe_mv_short(zcode_markers[start_pc] & 0x7f));
+                printf("%02x ", zcode_holding_area[start_pc]);
+            }
+            if (j) printf("\n");
+        }
+        return;
+    }

     else
     {   if (token_type != OPCODE_NAME_TT)
     else
     {   if (token_type != OPCODE_NAME_TT)

-        {   ebf_error("an opcode name", token_text);
+        {   ebf_curtoken_error("an opcode name");

             panic_mode_error_recovery();
             return;
         }
             panic_mode_error_recovery();
             return;
         }


@@ -3159,11 +3235,12 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
     }
 
     indirect_addressed = (O.op_rules == VARIAB);
     }
 
     indirect_addressed = (O.op_rules == VARIAB);

+    jumplabel_args = (O.op_rules == LABEL);        /* only @jump */

 
     if (O.op_rules == TEXT)
     {   get_next_token();
         if (token_type != DQ_TT)
 
     if (O.op_rules == TEXT)
     {   get_next_token();
         if (token_type != DQ_TT)

-            ebf_error("literal text in double-quotes", token_text);
+            ebf_curtoken_error("literal text in double-quotes");

         AI.text = token_text;
         if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) return;
         get_next_token();
         AI.text = token_text;
         if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) return;
         get_next_token();


@@ -3172,7 +3249,7 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
             AI.text = NULL;
             return;
         }
             AI.text = NULL;
             return;
         }

-        ebf_error("semicolon ';' after print string", token_text);
+        ebf_curtoken_error("semicolon ';' after print string");

         AI.text = NULL;
         put_token_back();
         return;
         AI.text = NULL;
         put_token_back();
         return;


@@ -3190,7 +3267,7 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
             get_next_token();
             if ((token_type != SYMBOL_TT)
                 && (token_type != LOCAL_VARIABLE_TT))
             get_next_token();
             if ((token_type != SYMBOL_TT)
                 && (token_type != LOCAL_VARIABLE_TT))

-                ebf_error("variable name or 'sp'", token_text);
+                ebf_curtoken_error("variable name or 'sp'");

             n = 255;
             if (token_type == LOCAL_VARIABLE_TT) n = token_value;
             else
             n = 255;
             if (token_type == LOCAL_VARIABLE_TT) n = token_value;
             else


@@ -3230,7 +3307,7 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
                     n = parse_label();
                 }
                 else
                     n = parse_label();
                 }
                 else

-                    ebf_error("label name after '?' or '?~'", token_text);
+                    ebf_curtoken_error("label name after '?' or '?~'");

             }
             AI.branch_label_number = n;
             continue;
             }
             AI.branch_label_number = n;
             continue;


@@ -3249,10 +3326,16 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
             AI.operand[AI.operand_count++] = parse_operand_z();
             get_next_token();
             if (!((token_type == SEP_TT) && (token_value == CLOSE_SQUARE_SEP)))
             AI.operand[AI.operand_count++] = parse_operand_z();
             get_next_token();
             if (!((token_type == SEP_TT) && (token_value == CLOSE_SQUARE_SEP)))

-            {   ebf_error("']'", token_text);
+            {   ebf_curtoken_error("']'");

                 put_token_back();
             }
         }
                 put_token_back();
             }
         }

+        else if (jumplabel_args)
+        {   assembly_operand AO;
+            put_token_back();
+            INITAOTV(&AO, LONG_CONSTANT_OT, parse_label());
+            AI.operand[AI.operand_count++] = AO;
+        }

         else
         {   put_token_back();
             AI.operand[AI.operand_count++] = parse_operand_z();
         else
         {   put_token_back();
             AI.operand[AI.operand_count++] = parse_operand_z();


@@ -3349,151 +3432,218 @@ static assembly_operand parse_operand_g(void)
 
 static void parse_assembly_g(void)
 {
 
 static void parse_assembly_g(void)
 {

-  opcodeg O;
-  assembly_operand AO;
-  int error_flag = FALSE, is_macro = FALSE;
+    opcodeg O;
+    assembly_operand AO;
+    int error_flag = FALSE, is_macro = FALSE;

 
 

-  AI.operand_count = 0;
-  AI.text = NULL;
+    AI.operand_count = 0;
+    AI.text = NULL;

 
 

-  opcode_names.enabled = TRUE;
-  opcode_macros.enabled = TRUE;
-  get_next_token();
-  opcode_names.enabled = FALSE;
-  opcode_macros.enabled = FALSE;
+    opcode_names.enabled = TRUE;
+    opcode_macros.enabled = TRUE;
+    get_next_token();
+    opcode_names.enabled = FALSE;
+    opcode_macros.enabled = FALSE;

 
 

-  if (token_type == DQ_TT) {
-    char *cx;
-    int badflags;
+    if (token_type == DQ_TT) {
+        char *cx;
+        int badflags;

 
 

-    AI.internal_number = -1;
+        AI.internal_number = -1;

 
 

-    /* The format is @"FlagsCount:Code". Flags (which are optional)
-       can include "S" for store, "SS" for two stores, "B" for branch
-       format, "R" if execution never continues after the opcode. The
-       Count is the number of arguments (currently limited to 0-9),
-       and the Code is a decimal integer representing the opcode
-       number.
+        /* The format is @"FlagsCount:Code". Flags (which are optional)
+           can include "S" for store, "SS" for two stores, "B" for branch
+           format, "R" if execution never continues after the opcode. The
+           Count is the number of arguments (currently limited to 0-9),
+           and the Code is a decimal integer representing the opcode
+           number.

 
 

-       So: @"S3:123" for a three-argument opcode (load, load, store)
-       whose opcode number is (decimal) 123. Or: @"2:234" for a
-       two-argument opcode (load, load) whose number is 234. */
+           So: @"S3:123" for a three-argument opcode (load, load, store)
+           whose opcode number is (decimal) 123. Or: @"2:234" for a
+           two-argument opcode (load, load) whose number is 234. */

 
 

-    custom_opcode_g.name = (uchar *) token_text;
-    custom_opcode_g.flags = 0;
-    custom_opcode_g.op_rules = 0;
-    custom_opcode_g.no = 0;
+        custom_opcode_g.name = (uchar *) token_text;
+        custom_opcode_g.flags = 0;
+        custom_opcode_g.op_rules = 0;
+        custom_opcode_g.no = 0;

 
 

-    badflags = FALSE;
+        badflags = FALSE;

 
 

-    for (cx = token_text; *cx && *cx != ':'; cx++) {
-      if (badflags)
-      continue;
+        for (cx = token_text; *cx && *cx != ':'; cx++) {
+            if (badflags)
+                continue;

 
 

-      switch (*cx) {
-      case 'S':
-      if (custom_opcode_g.flags & St)
-        custom_opcode_g.flags |= St2;
-      else
-        custom_opcode_g.flags |= St;
-      break;
-      case 'B':
-      custom_opcode_g.flags |= Br;
-      break;
-      case 'R':
-      custom_opcode_g.flags |= Rf;
-      break;
-      default:
-      if (isdigit(*cx)) {
-        custom_opcode_g.no = (*cx) - '0';
-        break;
-      }
-      badflags = TRUE;
-      error("Unknown custom opcode flag: options are B (branch), \
+            switch (*cx) {
+            case 'S':
+                if (custom_opcode_g.flags & St)
+                    custom_opcode_g.flags |= St2;
+                else
+                    custom_opcode_g.flags |= St;
+                break;
+            case 'B':
+                custom_opcode_g.flags |= Br;
+                break;
+            case 'R':
+                custom_opcode_g.flags |= Rf;
+                break;
+            default:
+                if (isdigit(*cx)) {
+                    custom_opcode_g.no = (*cx) - '0';
+                    break;
+                }
+                badflags = TRUE;
+                error("Unknown custom opcode flag: options are B (branch), \

 S (store), SS (two stores), R (execution never continues)");
 S (store), SS (two stores), R (execution never continues)");

-      break;
-      }
-    }
+                break;
+            }
+        }

 
 

-    if (*cx != ':') {
-      error("Custom opcode must have colon");
-    }
-    else {
-      cx++;
-      if (!(*cx))
-      error("Custom opcode must have colon followed by opcode number");
-      else
-      custom_opcode_g.code = atoi(cx);
-    }
+        if (*cx != ':') {
+            error("Custom opcode must have colon");
+        }
+        else {
+            cx++;
+            if (!(*cx))
+                error("Custom opcode must have colon followed by opcode number");
+            else
+                custom_opcode_g.code = atoi(cx);
+        }

 
 

-    O = custom_opcode_g;
-  }
-  else {
-    if (token_type != OPCODE_NAME_TT && token_type != OPCODE_MACRO_TT) {
-      ebf_error("an opcode name", token_text);
-      panic_mode_error_recovery();
-      return;
+        O = custom_opcode_g;

     }
     }

-    AI.internal_number = token_value;
-    if (token_type == OPCODE_MACRO_TT) {
-      O = internal_number_to_opmacro_g(AI.internal_number);
-      is_macro = TRUE;
+    else if ((token_type == SEP_TT) && (token_value == ARROW_SEP || token_value == DARROW_SEP))
+    {
+        int32 start_pc = zcode_ha_size;
+        int bytecount = 0;
+        int isword = (token_value == DARROW_SEP);
+        while (1) {
+            assembly_operand AO;
+            /* This isn't the start of a statement, but it's safe to
+               release token texts anyway. */
+            release_token_texts();
+            get_next_token();
+            if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
+            put_token_back();
+            AO = parse_expression(ARRAY_CONTEXT);
+            if (AO.marker == ERROR_MV) {
+                break;
+            }
+            if (!isword) {
+                if (AO.marker != 0)
+                    error("Entries in code byte arrays must be known constants");
+                if (AO.value >= 256)
+                    warning("Entry in code byte array not in range 0 to 255");
+            }
+            if (execution_never_reaches_here) {
+                continue;
+            }
+            if (bytecount == 0 && asm_trace_level > 0) {
+                printf("%5d  +%05lx %3s %-12s", ErrorReport.line_number,
+                    ((long int) zmachine_pc), "   ",
+                    isword?"<words>":"<bytes>");
+            }
+            if (!isword) {
+                byteout((AO.value & 0xFF), 0);
+                bytecount++;
+                if (asm_trace_level > 0) {
+                    printf(" %02x", (AO.value & 0xFF));
+                }
+            }
+            else {
+                byteout(((AO.value >> 24) & 0xFF), AO.marker);
+                byteout(((AO.value >> 16) & 0xFF), 0);
+                byteout(((AO.value >> 8) & 0xFF), 0);
+                byteout((AO.value & 0xFF), 0);
+                bytecount += 4;
+                if (asm_trace_level > 0) {
+                    printf(" ");
+                    print_operand(&AO, TRUE);
+                }
+            }
+        }
+        if (bytecount > 0 && asm_trace_level > 0) {
+            printf("\n");
+        }
+        if (asm_trace_level>=2)
+        {
+            int j;
+            for (j=0;start_pc<zcode_ha_size;
+                 j++, start_pc++)
+            {   if (j%16==0) printf("                               ");
+                if (zcode_markers[start_pc])
+                    printf("{%s}", describe_mv_short(zcode_markers[start_pc]));
+                printf("%02x ", zcode_holding_area[start_pc]);
+            }
+            if (j) printf("\n");
+        }
+        return;
+    }
+    else {
+        if (token_type != OPCODE_NAME_TT && token_type != OPCODE_MACRO_TT) {
+            ebf_curtoken_error("an opcode name");
+            panic_mode_error_recovery();
+            return;
+        }
+        AI.internal_number = token_value;
+        if (token_type == OPCODE_MACRO_TT) {
+            O = internal_number_to_opmacro_g(AI.internal_number);
+            is_macro = TRUE;
+        }
+        else
+            O = internal_number_to_opcode_g(AI.internal_number);

     }
     }

-    else
-      O = internal_number_to_opcode_g(AI.internal_number);
-  }

   
   

-  return_sp_as_variable = TRUE;
+    return_sp_as_variable = TRUE;

 
 

-  while (1) {
-    get_next_token();
+    while (1) {
+        get_next_token();

     
     

-    if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) 
-      break;
+        if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) 
+            break;

 
 

-    if (AI.operand_count == 8) {
-      error("No assembly instruction may have more than 8 operands");
-      panic_mode_error_recovery(); 
-      break;
-    }
+        if (AI.operand_count == 8) {
+            error("No assembly instruction may have more than 8 operands");
+            panic_mode_error_recovery(); 
+            break;
+        }

 
 

-    if ((O.flags & Br) && (AI.operand_count == O.no-1)) {
-      if (!((token_type == SEP_TT) && (token_value == BRANCH_SEP))) {
-        error_flag = TRUE;
-        error("Branch opcode must have '?' label");
-        put_token_back();
-      }
-      AO.type = CONSTANT_OT;
-      AO.value = parse_label();
-      AO.marker = BRANCH_MV;
-    }
-    else {
-      put_token_back();
-      AO = parse_operand_g();
-    }
+        if ((O.flags & Br) && (AI.operand_count == O.no-1)) {
+            if (!((token_type == SEP_TT) && (token_value == BRANCH_SEP))) {
+                error_flag = TRUE;
+                error("Branch opcode must have '?' label");
+                put_token_back();
+            }
+            AO.type = CONSTANT_OT;
+            AO.value = parse_label();
+            AO.marker = BRANCH_MV;
+        }
+        else {
+            put_token_back();
+            AO = parse_operand_g();
+        }

 
 

-    AI.operand[AI.operand_count] = AO;
-    AI.operand_count++;
-  }
+        AI.operand[AI.operand_count] = AO;
+        AI.operand_count++;
+    }

 
 

-  return_sp_as_variable = FALSE;
+    return_sp_as_variable = FALSE;

 
 

-  if (O.no != AI.operand_count) {
-    error_flag = TRUE;
-  }
+    if (O.no != AI.operand_count) {
+        error_flag = TRUE;
+    }

 
 

-  if (!error_flag) {
-    if (is_macro)
-      assembleg_macro(&AI);
-    else
-      assembleg_instruction(&AI);
-  }
+    if (!error_flag) {
+        if (is_macro)
+            assembleg_macro(&AI);
+        else
+            assembleg_instruction(&AI);
+    }

 
 

-  if (error_flag) {
-    make_opcode_syntax_g(O);
-    error_named("Assembly mistake: syntax is",
-      opcode_syntax_string);
-  }
+    if (error_flag) {
+        make_opcode_syntax_g(O);
+        error_named("Assembly mistake: syntax is",
+            opcode_syntax_string);
+    }

 }
 
 extern void parse_assembly(void)
 }
 
 extern void parse_assembly(void)


@@ -3571,7 +3721,7 @@ extern void asm_allocate_arrays(void)
         "code area");
 
     initialise_memory_list(&current_routine_name,
         "code area");
 
     initialise_memory_list(&current_routine_name,

-        sizeof(char), 3*MAX_IDENTIFIER_LENGTH, NULL,
+        sizeof(char), 64, NULL,

         "routine name currently being defined");
 }
 
         "routine name currently being defined");
 }
 

diff --git a/src/bpatch.c b/src/bpatch.c
index c1bd1bbb5c48e77417ec39481771775c416f8ccd..c8fef23fc8a175454fb54897e0a606ba55d1e4e7 100644 (file)
--- a/src/bpatch.c
+++ b/src/bpatch.c
@@ -2,8 +2,8 @@
 /*   "bpatch" : Keeps track of, and finally acts on, backpatch markers,      */
 /*              correcting symbol values not known at compilation time       */
 /*                                                                           */
 /*   "bpatch" : Keeps track of, and finally acts on, backpatch markers,      */
 /*              correcting symbol values not known at compilation time       */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -47,6 +47,7 @@ extern char *describe_mv(int mval)
         case IROUTINE_MV:   return("routine");
         case VROUTINE_MV:   return("veneer routine");
         case ARRAY_MV:      return("internal array");
         case IROUTINE_MV:   return("routine");
         case VROUTINE_MV:   return("veneer routine");
         case ARRAY_MV:      return("internal array");

+        case STATIC_ARRAY_MV:  return("internal static 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 NO_OBJS_MV:    return("the number of objects");
         case INHERIT_MV:    return("inherited common p value");
         case INDIVPT_MV:    return("indiv prop table address");


@@ -62,10 +63,53 @@ extern char *describe_mv(int mval)
         case ACTION_MV:     return("action");
         case OBJECT_MV:     return("internal object");
 
         case ACTION_MV:     return("action");
         case OBJECT_MV:     return("internal object");
 

+        /* Only occurs secondary to another reported error */
+        case ERROR_MV:      return("error");
+

     }
     return("** No such MV **");
 }
 
     }
     return("** No such MV **");
 }
 

+extern char *describe_mv_short(int mval)
+{   switch(mval)
+    {   case NULL_MV:       return("");
+
+        /*  Marker values used in ordinary story file backpatching  */
+
+        case DWORD_MV:      return("dict");
+        case STRING_MV:     return("str");
+        case INCON_MV:      return("syscon");
+        case IROUTINE_MV:   return("rtn");
+        case VROUTINE_MV:   return("vrtn");
+        case ARRAY_MV:      return("arr");
+        case STATIC_ARRAY_MV:  return("stat-arr");
+        case NO_OBJS_MV:    return("obj-count");
+        case INHERIT_MV:    return("inh-com");
+        case INDIVPT_MV:    return("indiv-ptab");
+        case INHERIT_INDIV_MV: return("inh-indiv");
+        case MAIN_MV:       return("main");
+        case SYMBOL_MV:     return("sym");
+
+        /*  Additional marker values used in Glulx backpatching
+            (IDENT_MV is not really used at all any more) */
+
+        case VARIABLE_MV:   return("glob");
+        case IDENT_MV:      return("prop");
+        case ACTION_MV:     return("action");
+        case OBJECT_MV:     return("obj");
+
+        case LABEL_MV:      return("lbl");
+        case DELETED_MV:    return("del");
+
+        /* Only occurs secondary to another reported error */
+        case ERROR_MV:      return("err");
+
+    }
+    if (mval >= BRANCH_MV && mval < BRANCHMAX_MV) return "br";
+    
+    return("???");
+}
+

 /* ------------------------------------------------------------------------- */
 /*   The mending operation                                                   */
 /* ------------------------------------------------------------------------- */
 /* ------------------------------------------------------------------------- */
 /*   The mending operation                                                   */
 /* ------------------------------------------------------------------------- */


@@ -143,9 +187,17 @@ static int32 backpatch_value_z(int32 value)
             value += individuals_offset;
             break;
         case MAIN_MV:
             value += individuals_offset;
             break;
         case MAIN_MV:

-            value = symbol_index("Main", -1);
-            if (symbols[value].type != ROUTINE_T)
+            value = get_symbol_index("Main");
+            if (value < 0 || (symbols[value].flags & UNKNOWN_SFLAG)) {

                 error("No 'Main' routine has been defined");
                 error("No 'Main' routine has been defined");

+                value = 0;
+                break;
+            }
+            if (symbols[value].type != ROUTINE_T) {
+                ebf_symbol_error("'Main' routine", symbols[value].name, typename(symbols[value].type), symbols[value].line);
+                value = 0;
+                break;
+            }

             symbols[value].flags |= USED_SFLAG;
             value = symbols[value].value;
             if (OMIT_UNUSED_ROUTINES)
             symbols[value].flags |= USED_SFLAG;
             value = symbols[value].value;
             if (OMIT_UNUSED_ROUTINES)


@@ -290,9 +342,17 @@ static int32 backpatch_value_g(int32 value)
             value += individuals_offset;
             break;
         case MAIN_MV:
             value += individuals_offset;
             break;
         case MAIN_MV:

-            value = symbol_index("Main", -1);
-            if (symbols[value].type != ROUTINE_T)
+            value = get_symbol_index("Main");
+            if (value < 0 || (symbols[value].flags & UNKNOWN_SFLAG)) {

                 error("No 'Main' routine has been defined");
                 error("No 'Main' routine has been defined");

+                value = 0;
+                break;
+            }
+            if (symbols[value].type != ROUTINE_T) {
+                ebf_symbol_error("'Main' routine", symbols[value].name, typename(symbols[value].type), symbols[value].line);
+                value = 0;
+                break;
+            }

             symbols[value].flags |= USED_SFLAG;
             value = symbols[value].value;
             if (OMIT_UNUSED_ROUTINES)
             symbols[value].flags |= USED_SFLAG;
             value = symbols[value].value;
             if (OMIT_UNUSED_ROUTINES)

diff --git a/src/chars.c b/src/chars.c
index 3fdf10deaffff1493c1f57c92301f6de05576335..2d4e21bac580670a44eae410f2fa1f322b49c441 100644 (file)
--- a/src/chars.c
+++ b/src/chars.c
@@ -1,8 +1,8 @@
 /* ------------------------------------------------------------------------- */
 /*   "chars" : Character set mappings and the Z-machine alphabet table       */
 /*                                                                           */
 /* ------------------------------------------------------------------------- */
 /*   "chars" : Character set mappings and the Z-machine alphabet table       */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -335,8 +335,9 @@ static void read_source_to_iso_file(uchar *uccg)
 /*                                                                           */
 /*      00         remains 0 (meaning "end of file")                         */
 /*      TAB        becomes SPACE                                             */
 /*                                                                           */
 /*      00         remains 0 (meaning "end of file")                         */
 /*      TAB        becomes SPACE                                             */

+/*      0a         remains '\n'                                              */

 /*      0c         ("form feed") becomes '\n'                                */
 /*      0c         ("form feed") becomes '\n'                                */

-/*      0d         becomes '\n'                                              */
+/*      0d         remains '\r'                                              */

 /*      other control characters become '?'                                  */
 /*      7f         becomes '?'                                               */
 /*      80 to 9f   become '?'                                                */
 /*      other control characters become '?'                                  */
 /*      7f         becomes '?'                                               */
 /*      80 to 9f   become '?'                                                */


@@ -359,7 +360,7 @@ static void make_source_to_iso_grid(void)
         for (n=1; n<32; n++) source_to_iso_grid[n] = '?';
         source_to_iso_grid[10] = '\n';
         source_to_iso_grid[12] = '\n';
         for (n=1; n<32; n++) source_to_iso_grid[n] = '?';
         source_to_iso_grid[10] = '\n';
         source_to_iso_grid[12] = '\n';

-        source_to_iso_grid[13] = '\n';
+        source_to_iso_grid[13] = '\r';

         source_to_iso_grid[127] = '?';
         source_to_iso_grid[TAB_CHARACTER] = ' ';
 
         source_to_iso_grid[127] = '?';
         source_to_iso_grid[TAB_CHARACTER] = ' ';
 

diff --git a/src/directs.c b/src/directs.c
index d8374c367a6e8863eae86cb5d2f5e59826c877fc..b9d26d2f4d8045a597982f572e871788340780e7 100644 (file)
--- a/src/directs.c
+++ b/src/directs.c
@@ -1,8 +1,8 @@
 /* ------------------------------------------------------------------------- */
 /*   "directs" : Directives (# commands)                                     */
 /*                                                                           */
 /* ------------------------------------------------------------------------- */
 /*   "directs" : Directives (# commands)                                     */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -23,7 +23,6 @@
 
 int no_routines,                   /* Number of routines compiled so far     */
     no_named_routines,             /* Number not embedded in objects         */
 
 int no_routines,                   /* Number of routines compiled so far     */
     no_named_routines,             /* Number not embedded in objects         */

-    no_locals,                     /* Number of locals in current routine    */

     no_termcs;                     /* Number of terminating characters       */
 int terminating_characters[32];
 
     no_termcs;                     /* Number of terminating characters       */
 int terminating_characters[32];
 


@@ -39,23 +38,23 @@ static int ifdef_stack[MAX_IFDEF_STACK], ifdef_sp;
 
 /* ------------------------------------------------------------------------- */
 
 
 /* ------------------------------------------------------------------------- */
 

-static int ebf_error_recover(char *s1, char *s2)
+static int ebf_error_recover(char *s1)

 {
 {

-    /* Display an "expected... but found..." error, then skim forward
-       to the next semicolon and return FALSE. This is such a common
-       case in parse_given_directive() that it's worth a utility
-       function. You will see many error paths that look like:
+    /* Display an "expected... but found (current token)" error, then
+       skim forward to the next semicolon and return FALSE. This is
+       such a common case in parse_given_directive() that it's worth a
+       utility function. You will see many error paths that look like:

           return ebf_error_recover(...);
     */
           return ebf_error_recover(...);
     */

-    ebf_error(s1, s2);
+    ebf_curtoken_error(s1);

     panic_mode_error_recovery();
     return FALSE;
 }
 
     panic_mode_error_recovery();
     return FALSE;
 }
 

-static int ebf_symbol_error_recover(char *s1, char *name, char *type, brief_location report_line)
+static int ebf_symbol_error_recover(char *s1, char *type, brief_location report_line)

 {
     /* Same for ebf_symbol_error(). */
 {
     /* Same for ebf_symbol_error(). */

-    ebf_symbol_error(s1, name, type, report_line);
+    ebf_symbol_error(s1, token_text, type, report_line);

     panic_mode_error_recovery();
     return FALSE;
 }
     panic_mode_error_recovery();
     return FALSE;
 }


@@ -122,13 +121,7 @@ extern int parse_given_directive(int internal_flag)
                panic_mode_error_recovery(); return FALSE;
            }
            if (token_type != DQ_TT)
                panic_mode_error_recovery(); return FALSE;
            }
            if (token_type != DQ_TT)

-           {   return ebf_error_recover("abbreviation string", token_text);
-           }
-           /* Abbreviation string with null must fit in a MAX_ABBREV_LENGTH
-              array. */
-           if (strlen(token_text)>=MAX_ABBREV_LENGTH)
-           {   error_named("Abbreviation too long", token_text);
-               continue;
+           {   return ebf_error_recover("abbreviation string");

            }
            make_abbreviation(token_text);
         } while (TRUE);
            }
            make_abbreviation(token_text);
         } while (TRUE);


@@ -167,12 +160,12 @@ extern int parse_given_directive(int internal_flag)
 
         if (token_type != SYMBOL_TT)
         {   discard_token_location(beginning_debug_location);
 
         if (token_type != SYMBOL_TT)
         {   discard_token_location(beginning_debug_location);

-            return ebf_error_recover("new constant name", token_text);
+            return ebf_error_recover("new constant name");

         }
 
         if (!(symbols[i].flags & (UNKNOWN_SFLAG + REDEFINABLE_SFLAG)))
         {   discard_token_location(beginning_debug_location);
         }
 
         if (!(symbols[i].flags & (UNKNOWN_SFLAG + REDEFINABLE_SFLAG)))
         {   discard_token_location(beginning_debug_location);

-            return ebf_symbol_error_recover("new constant name", token_text, typename(symbols[i].type), symbols[i].line);
+            return ebf_symbol_error_recover("new constant name", typename(symbols[i].type), symbols[i].line);

         }
 
         assign_symbol(i, 0, CONSTANT_T);
         }
 
         assign_symbol(i, 0, CONSTANT_T);


@@ -250,7 +243,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
     case DEFAULT_CODE:
         get_next_token();
         if (token_type != SYMBOL_TT)
     case DEFAULT_CODE:
         get_next_token();
         if (token_type != SYMBOL_TT)

-            return ebf_error_recover("name", token_text);
+            return ebf_error_recover("name");

 
         i = -1;
         if (symbols[token_value].flags & UNKNOWN_SFLAG)
 
         i = -1;
         if (symbols[token_value].flags & UNKNOWN_SFLAG)


@@ -296,7 +289,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
          */
         get_next_token();
         if (token_type != SQ_TT && token_type != DQ_TT)
          */
         get_next_token();
         if (token_type != SQ_TT && token_type != DQ_TT)

-            return ebf_error_recover("dictionary word", token_text);
+            return ebf_error_recover("dictionary word");

 
         {
             char *wd = token_text;
 
         {
             char *wd = token_text;


@@ -400,7 +393,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
       DefCondition:
         get_next_token();
         if (token_type != SYMBOL_TT)
       DefCondition:
         get_next_token();
         if (token_type != SYMBOL_TT)

-            return ebf_error_recover("symbol name", token_text);
+            return ebf_error_recover("symbol name");

 
         /* Special case: a symbol of the form "VN_nnnn" is considered
            defined if the compiler version number is at least nnnn.
 
         /* Special case: a symbol of the form "VN_nnnn" is considered
            defined if the compiler version number is at least nnnn.


@@ -506,7 +499,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
     HashIfCondition:
         get_next_token();
         if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
     HashIfCondition:
         get_next_token();
         if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))

-            return ebf_error_recover("semicolon after 'If...' condition", token_text);
+            return ebf_error_recover("semicolon after 'If...' condition");

 
         if (ifdef_sp >= MAX_IFDEF_STACK) {
             error("'If' directives nested too deeply");
 
         if (ifdef_sp >= MAX_IFDEF_STACK) {
             error("'If' directives nested too deeply");


@@ -570,13 +563,13 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
     case INCLUDE_CODE:
         get_next_token();
         if (token_type != DQ_TT)
     case INCLUDE_CODE:
         get_next_token();
         if (token_type != DQ_TT)

-            return ebf_error_recover("filename in double-quotes", token_text);
+            return ebf_error_recover("filename in double-quotes");

 
         {   char *name = token_text;
 
             get_next_token();
             if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
 
         {   char *name = token_text;
 
             get_next_token();
             if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))

-                ebf_error("semicolon ';' after Include filename", token_text);
+                ebf_curtoken_error("semicolon ';' after Include filename");

 
             if (strcmp(name, "language__") == 0)
                  load_sourcefile(Language_Name, 0);
 
             if (strcmp(name, "language__") == 0)
                  load_sourcefile(Language_Name, 0);


@@ -610,13 +603,13 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
         }
         get_next_token(); i = token_value;
         if (token_type != SYMBOL_TT)
         }
         get_next_token(); i = token_value;
         if (token_type != SYMBOL_TT)

-            return ebf_error_recover("new low string name", token_text);
+            return ebf_error_recover("new low string name");

         if (!(symbols[i].flags & UNKNOWN_SFLAG))
         if (!(symbols[i].flags & UNKNOWN_SFLAG))

-            return ebf_symbol_error_recover("new low string name", token_text, typename(symbols[i].type), symbols[i].line);
+            return ebf_symbol_error_recover("new low string name", typename(symbols[i].type), symbols[i].line);

 
         get_next_token();
         if (token_type != DQ_TT)
 
         get_next_token();
         if (token_type != DQ_TT)

-            return ebf_error_recover("literal string in double-quotes", token_text);
+            return ebf_error_recover("literal string in double-quotes");

 
         assign_symbol(i, compile_string(token_text, STRCTX_LOWSTRING), CONSTANT_T);
         break;
 
         assign_symbol(i, compile_string(token_text, STRCTX_LOWSTRING), CONSTANT_T);
         break;


@@ -647,26 +640,25 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
         if ((token_type == DIR_KEYWORD_TT) && (token_value == ERROR_DK))
         {   get_next_token();
             if (token_type != DQ_TT)
         if ((token_type == DIR_KEYWORD_TT) && (token_value == ERROR_DK))
         {   get_next_token();
             if (token_type != DQ_TT)

-            {   return ebf_error_recover("error message in double-quotes", token_text);
+            {   return ebf_error_recover("error message in double-quotes");

             }
             error(token_text); break;
         }
         if ((token_type == DIR_KEYWORD_TT) && (token_value == FATALERROR_DK))
         {   get_next_token();
             if (token_type != DQ_TT)
             }
             error(token_text); break;
         }
         if ((token_type == DIR_KEYWORD_TT) && (token_value == FATALERROR_DK))
         {   get_next_token();
             if (token_type != DQ_TT)

-            {   return ebf_error_recover("fatal error message in double-quotes", token_text);
+            {   return ebf_error_recover("fatal error message in double-quotes");

             }
             fatalerror(token_text); break;
         }
         if ((token_type == DIR_KEYWORD_TT) && (token_value == WARNING_DK))
         {   get_next_token();
             if (token_type != DQ_TT)
             }
             fatalerror(token_text); break;
         }
         if ((token_type == DIR_KEYWORD_TT) && (token_value == WARNING_DK))
         {   get_next_token();
             if (token_type != DQ_TT)

-            {   return ebf_error_recover("warning message in double-quotes", token_text);
+            {   return ebf_error_recover("warning message in double-quotes");

             }
             warning(token_text); break;
         }
             }
             warning(token_text); break;
         }

-        return ebf_error_recover("a message in double-quotes, 'error', 'fatalerror' or 'warning'",
-            token_text);
+        return ebf_error_recover("a message in double-quotes, 'error', 'fatalerror' or 'warning'");

         break;
 
     /* --------------------------------------------------------------------- */
         break;
 
     /* --------------------------------------------------------------------- */


@@ -715,16 +707,14 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
             get_next_token();
             if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) {
                 if (token_type != DQ_TT) {
             get_next_token();
             if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) {
                 if (token_type != DQ_TT) {

-                    return ebf_error_recover("a file name in double-quotes",
-                        token_text);
+                    return ebf_error_recover("a file name in double-quotes");

                 }
                 origsource_file = token_text;
 
                 get_next_token();
                 if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) {
                     if (token_type != NUMBER_TT) {
                 }
                 origsource_file = token_text;
 
                 get_next_token();
                 if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) {
                     if (token_type != NUMBER_TT) {

-                        return ebf_error_recover("a file line number",
-                            token_text);
+                        return ebf_error_recover("a file line number");

                     }
                     origsource_line = token_value;
                     if (origsource_line < 0)
                     }
                     origsource_line = token_value;
                     if (origsource_line < 0)


@@ -733,8 +723,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
                     get_next_token();
                     if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) {
                         if (token_type != NUMBER_TT) {
                     get_next_token();
                     if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) {
                         if (token_type != NUMBER_TT) {

-                            return ebf_error_recover("a file line number",
-                                token_text);
+                            return ebf_error_recover("a file line number");

                         }
                         origsource_char = token_value;
                         if (origsource_char < 0)
                         }
                         origsource_char = token_value;
                         if (origsource_char < 0)


@@ -805,9 +794,9 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
         }
 
         if (token_type != SYMBOL_TT)
         }
 
         if (token_type != SYMBOL_TT)

-            return ebf_error_recover("name of routine to replace", token_text);
+            return ebf_error_recover("name of routine to replace");

         if (!(symbols[token_value].flags & UNKNOWN_SFLAG))
         if (!(symbols[token_value].flags & UNKNOWN_SFLAG))

-            return ebf_error_recover("name of routine not yet defined", token_text);
+            return ebf_error_recover("name of routine not yet defined");

 
         symbols[token_value].flags |= REPLACE_SFLAG;
 
 
         symbols[token_value].flags |= REPLACE_SFLAG;
 


@@ -824,7 +813,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
         }
 
         if (token_type != SYMBOL_TT || !(symbols[token_value].flags & UNKNOWN_SFLAG))
         }
 
         if (token_type != SYMBOL_TT || !(symbols[token_value].flags & UNKNOWN_SFLAG))

-            return ebf_error_recover("semicolon ';' or new routine name", token_text);
+            return ebf_error_recover("semicolon ';' or new routine name");

 
         /* Define the original-form symbol as a zero constant. Its
            value will be overwritten later, when we define the
 
         /* Define the original-form symbol as a zero constant. Its
            value will be overwritten later, when we define the


@@ -862,7 +851,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
         directive_keywords.enabled = FALSE;
         if ((token_type != DIR_KEYWORD_TT)
             || ((token_value != SCORE_DK) && (token_value != TIME_DK)))
         directive_keywords.enabled = FALSE;
         if ((token_type != DIR_KEYWORD_TT)
             || ((token_value != SCORE_DK) && (token_value != TIME_DK)))

-            return ebf_error_recover("'score' or 'time' after 'statusline'", token_text);
+            return ebf_error_recover("'score' or 'time' after 'statusline'");

         if (token_value == SCORE_DK) statusline_flag = SCORE_STYLE;
         else statusline_flag = TIME_STYLE;
         break;
         if (token_value == SCORE_DK) statusline_flag = SCORE_STYLE;
         else statusline_flag = TIME_STYLE;
         break;


@@ -878,7 +867,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
         get_next_token();
         df_dont_note_global_symbols = FALSE;
         if (token_type != SYMBOL_TT)
         get_next_token();
         df_dont_note_global_symbols = FALSE;
         if (token_type != SYMBOL_TT)

-            return ebf_error_recover("routine name to stub", token_text);
+            return ebf_error_recover("routine name to stub");

 
         i = token_value; flag = FALSE;
 
 
         i = token_value; flag = FALSE;
 


@@ -889,7 +878,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
 
         get_next_token(); k = token_value;
         if (token_type != NUMBER_TT)
 
         get_next_token(); k = token_value;
         if (token_type != NUMBER_TT)

-            return ebf_error_recover("number of local variables", token_text);
+            return ebf_error_recover("number of local variables");

         if ((k>4) || (k<0))
         {   error("Must specify 0 to 4 local variables for 'Stub' routine");
             k = 0;
         if ((k>4) || (k<0))
         {   error("Must specify 0 to 4 local variables for 'Stub' routine");
             k = 0;


@@ -903,13 +892,14 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
                 (We don't set local_variable.keywords because we're not
                 going to be parsing any code.)                               */
 
                 (We don't set local_variable.keywords because we're not
                 going to be parsing any code.)                               */
 

-            strcpy(local_variable_names[0].text, "dummy1");
-            strcpy(local_variable_names[1].text, "dummy2");
-            strcpy(local_variable_names[2].text, "dummy3");
-            strcpy(local_variable_names[3].text, "dummy4");
+            clear_local_variables();
+            if (k >= 1) add_local_variable("dummy1");
+            if (k >= 2) add_local_variable("dummy2");
+            if (k >= 3) add_local_variable("dummy3");
+            if (k >= 4) add_local_variable("dummy4");

 
             assign_symbol(i,
 
             assign_symbol(i,

-                assemble_routine_header(k, FALSE, symbols[i].name, FALSE, i),
+                assemble_routine_header(FALSE, symbols[i].name, FALSE, i),

                 ROUTINE_T);
 
             /*  Ensure the return value of a stubbed routine is false,
                 ROUTINE_T);
 
             /*  Ensure the return value of a stubbed routine is false,


@@ -937,8 +927,8 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
         dont_enter_into_symbol_table = TRUE;
         get_next_token();
         dont_enter_into_symbol_table = FALSE;
         dont_enter_into_symbol_table = TRUE;
         get_next_token();
         dont_enter_into_symbol_table = FALSE;

-        if (token_type != DQ_TT)
-            return ebf_error_recover("string of switches", token_text);
+        if (token_type != UQ_TT)
+            return ebf_error_recover("string of switches");

         if (!ignore_switches_switch)
         {
             if (constant_made_yet) {
         if (!ignore_switches_switch)
         {
             if (constant_made_yet) {


@@ -1010,7 +1000,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
            'on' and 'off' are trace keywords. */
         
         if (token_type != TRACE_KEYWORD_TT)
            'on' and 'off' are trace keywords. */
         
         if (token_type != TRACE_KEYWORD_TT)

-            return ebf_error_recover("debugging keyword", token_text);
+            return ebf_error_recover("debugging keyword");

 
         trace_keywords.enabled = TRUE;
 
 
         trace_keywords.enabled = TRUE;
 


@@ -1100,7 +1090,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
     case UNDEF_CODE:
         get_next_token();
         if (token_type != SYMBOL_TT)
     case UNDEF_CODE:
         get_next_token();
         if (token_type != SYMBOL_TT)

-            return ebf_error_recover("symbol name", token_text);
+            return ebf_error_recover("symbol name");

 
         if (symbols[token_value].flags & UNKNOWN_SFLAG)
         {   break; /* undef'ing an undefined constant is okay */
 
         if (symbols[token_value].flags & UNKNOWN_SFLAG)
         {   break; /* undef'ing an undefined constant is okay */


@@ -1114,7 +1104,10 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
         if (debugfile_switch)
         {   write_debug_undef(token_value);
         }
         if (debugfile_switch)
         {   write_debug_undef(token_value);
         }

-        end_symbol_scope(token_value);
+        /* We remove it from the symbol table. But previous uses of the symbol
+           were valid, so we don't set neverused true. We also mark it
+           USED so that it can't trigger "symbol not used" warnings. */
+        end_symbol_scope(token_value, FALSE);

         symbols[token_value].flags |= USED_SFLAG;
         break;
 
         symbols[token_value].flags |= USED_SFLAG;
         break;
 


@@ -1172,8 +1165,8 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
                    version.
                    The calculation here is repeated from select_target(). */
                 DICT_ENTRY_BYTE_LENGTH = ((version_number==3)?7:9) - (ZCODE_LESS_DICT_DATA?1:0);
                    version.
                    The calculation here is repeated from select_target(). */
                 DICT_ENTRY_BYTE_LENGTH = ((version_number==3)?7:9) - (ZCODE_LESS_DICT_DATA?1:0);

-                debtok = symbol_index("DICT_ENTRY_BYTES", -1);
-                if (!(symbols[debtok].flags & UNKNOWN_SFLAG))
+                debtok = get_symbol_index("DICT_ENTRY_BYTES");
+                if (debtok >= 0 && !(symbols[debtok].flags & UNKNOWN_SFLAG))

                 {
                     if (!(symbols[debtok].flags & REDEFINABLE_SFLAG))
                     {
                 {
                     if (!(symbols[debtok].flags & REDEFINABLE_SFLAG))
                     {


@@ -1209,18 +1202,18 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
                 new_alphabet(token_text, 0);
                 get_next_token();
                 if (token_type != DQ_TT)
                 new_alphabet(token_text, 0);
                 get_next_token();
                 if (token_type != DQ_TT)

-                    return ebf_error_recover("double-quoted alphabet string", token_text);
+                    return ebf_error_recover("double-quoted alphabet string");

                 new_alphabet(token_text, 1);
                 get_next_token();
                 if (token_type != DQ_TT)
                 new_alphabet(token_text, 1);
                 get_next_token();
                 if (token_type != DQ_TT)

-                    return ebf_error_recover("double-quoted alphabet string", token_text);
+                    return ebf_error_recover("double-quoted alphabet string");

                 new_alphabet(token_text, 2);
             break;
 
             case SQ_TT:
                 map_new_zchar(text_to_unicode(token_text));
                 if (token_text[textual_form_length] != 0)
                 new_alphabet(token_text, 2);
             break;
 
             case SQ_TT:
                 map_new_zchar(text_to_unicode(token_text));
                 if (token_text[textual_form_length] != 0)

-                    return ebf_error_recover("single character value", token_text);
+                    return ebf_error_recover("single character value");

             break;
 
             case DIR_KEYWORD_TT:
             break;
 
             case DIR_KEYWORD_TT:


@@ -1241,13 +1234,11 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
                                 new_zscii_character(text_to_unicode(token_text),
                                     plus_flag);
                                 if (token_text[textual_form_length] != 0)
                                 new_zscii_character(text_to_unicode(token_text),
                                     plus_flag);
                                 if (token_text[textual_form_length] != 0)

-                                    return ebf_error_recover("single character value",
-                                        token_text);
+                                    return ebf_error_recover("single character value");

                                 plus_flag = TRUE;
                                 break;
                             default:
                                 plus_flag = TRUE;
                                 break;
                             default:

-                                return ebf_error_recover("character or Unicode number",
-                                    token_text);
+                                return ebf_error_recover("character or Unicode number");

                         }
                         get_next_token();
                     }
                         }
                         get_next_token();
                     }


@@ -1264,8 +1255,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
                                     = token_value;
                                 break;
                             default:
                                     = token_value;
                                 break;
                             default:

-                                return ebf_error_recover("ZSCII number",
-                                    token_text);
+                                return ebf_error_recover("ZSCII number");

                         }
                         get_next_token();
                     }
                         }
                         get_next_token();
                     }


@@ -1273,13 +1263,12 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
                     break;
                 default:
                     return ebf_error_recover("'table', 'terminating', \
                     break;
                 default:
                     return ebf_error_recover("'table', 'terminating', \

-a string or a constant",
-                        token_text);
+a string or a constant");

             }
                 break;
             default:
                 return ebf_error_recover("three alphabet strings, \
             }
                 break;
             default:
                 return ebf_error_recover("three alphabet strings, \

-a 'table' or 'terminating' command or a single character", token_text);
+a 'table' or 'terminating' command or a single character");

         }
         break;
 
         }
         break;
 


@@ -1292,7 +1281,7 @@ a 'table' or 'terminating' command or a single character", token_text);
 
     get_next_token();
     if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
 
     get_next_token();
     if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))

-    {   ebf_error("';'", token_text);
+    {   ebf_curtoken_error("';'");

         /* Put the non-semicolon back. We will continue parsing from
            that point, in hope that it's the start of a new directive.
            (This recovers cleanly from a missing semicolon at the end
         /* Put the non-semicolon back. We will continue parsing from
            that point, in hope that it's the start of a new directive.
            (This recovers cleanly from a missing semicolon at the end


@@ -1314,7 +1303,6 @@ extern void init_directs_vars(void)
 extern void directs_begin_pass(void)
 {   no_routines = 0;
     no_named_routines = 0;
 extern void directs_begin_pass(void)
 {   no_routines = 0;
     no_named_routines = 0;

-    no_locals = 0;

     no_termcs = 0;
     constant_made_yet = FALSE;
     ifdef_sp = 0;
     no_termcs = 0;
     constant_made_yet = FALSE;
     ifdef_sp = 0;

diff --git a/src/errors.c b/src/errors.c
index a71447e9b3aa5757abd087ea4b897113ca2df58f..c7ec13dc29587d2a5f1ccf5ce4947127573c0076 100644 (file)
--- a/src/errors.c
+++ b/src/errors.c
@@ -2,8 +2,8 @@
 /*   "errors" : Warnings, errors and fatal errors                            */
 /*              (with error throwback code for RISC OS machines)             */
 /*                                                                           */
 /*   "errors" : Warnings, errors and fatal errors                            */
 /*              (with error throwback code for RISC OS machines)             */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -171,6 +171,14 @@ static char *location_text(brief_location report_line)
     return other_pos_buff;
 }
 
     return other_pos_buff;
 }
 

+char *current_location_text(void)
+{
+    /* Convert the current lexer location to a brief string.
+       (Called by some trace messages.)
+       This uses the static buffer other_pos_buff. */
+    return location_text(get_brief_location(&ErrorReport));
+}
+

 static void ellipsize_error_message_buff(void)
 {
     /* If the error buffer was actually filled up by a message, it was
 static void ellipsize_error_message_buff(void)
 {
     /* If the error buffer was actually filled up by a message, it was


@@ -204,13 +212,23 @@ extern void fatalerror(char *s)
     exit(1);
 }
 
     exit(1);
 }
 

+extern void fatalerror_fmt(const char *format, ...)
+{
+    va_list argument_pointer;
+    va_start(argument_pointer, format);
+    vsnprintf(error_message_buff, ERROR_BUFLEN, format, argument_pointer);
+    va_end(argument_pointer);
+    ellipsize_error_message_buff();
+    fatalerror(error_message_buff);
+}
+

 extern void fatalerror_named(char *m, char *fn)
 {   snprintf(error_message_buff, ERROR_BUFLEN, "%s \"%s\"", m, fn);
     ellipsize_error_message_buff();
     fatalerror(error_message_buff);
 }
 
 extern void fatalerror_named(char *m, char *fn)
 {   snprintf(error_message_buff, ERROR_BUFLEN, "%s \"%s\"", m, fn);
     ellipsize_error_message_buff();
     fatalerror(error_message_buff);
 }
 

-extern void memory_out_error(int32 size, int32 howmany, char *name)
+extern void fatalerror_memory_out(int32 size, int32 howmany, char *name)

 {   if (howmany == 1)
         snprintf(error_message_buff, ERROR_BUFLEN,
             "Run out of memory allocating %d bytes for %s", size, name);
 {   if (howmany == 1)
         snprintf(error_message_buff, ERROR_BUFLEN,
             "Run out of memory allocating %d bytes for %s", size, name);


@@ -278,15 +296,18 @@ extern void error(char *s)
     message(1,s);
 }
 
     message(1,s);
 }
 

-extern void error_named(char *s1, char *s2)
-{   snprintf(error_message_buff, ERROR_BUFLEN,"%s \"%s\"",s1,s2);
+extern void error_fmt(const char *format, ...)
+{
+    va_list argument_pointer;
+    va_start(argument_pointer, format);
+    vsnprintf(error_message_buff, ERROR_BUFLEN, format, argument_pointer);
+    va_end(argument_pointer);

     ellipsize_error_message_buff();
     error(error_message_buff);
 }
 
     ellipsize_error_message_buff();
     error(error_message_buff);
 }
 

-extern void error_numbered(char *s1, int val)
-{
-    snprintf(error_message_buff, ERROR_BUFLEN,"%s %d.",s1,val);
+extern void error_named(char *s1, char *s2)
+{   snprintf(error_message_buff, ERROR_BUFLEN,"%s \"%s\"",s1,s2);

     ellipsize_error_message_buff();
     error(error_message_buff);
 }
     ellipsize_error_message_buff();
     error(error_message_buff);
 }


@@ -305,16 +326,35 @@ extern void error_named_at(char *s1, char *s2, brief_location report_line)
     ErrorReport = E; concise_switch = i;
 }
 
     ErrorReport = E; concise_switch = i;
 }
 

-extern void no_such_label(char *lname)
-{   error_named("No such label as",lname);
-}
-

 extern void ebf_error(char *s1, char *s2)
 {   snprintf(error_message_buff, ERROR_BUFLEN, "Expected %s but found %s", s1, s2);
     ellipsize_error_message_buff();
     error(error_message_buff);
 }
 
 extern void ebf_error(char *s1, char *s2)
 {   snprintf(error_message_buff, ERROR_BUFLEN, "Expected %s but found %s", s1, s2);
     ellipsize_error_message_buff();
     error(error_message_buff);
 }
 

+extern void ebf_curtoken_error(char *s)
+{
+    /* This is "Expected (s) but found (the current token_text)". We use
+       token_type as a hint for how to display token_text. */
+    
+    if (token_type == DQ_TT) {
+        snprintf(error_message_buff, ERROR_BUFLEN, "Expected %s but found string \"%s\"", s, token_text);
+    }
+    else if (token_type == SQ_TT && strlen(token_text)==1) {
+        snprintf(error_message_buff, ERROR_BUFLEN, "Expected %s but found char '%s'", s, token_text);
+    }
+    else if (token_type == SQ_TT) {
+        snprintf(error_message_buff, ERROR_BUFLEN, "Expected %s but found dict word '%s'", s, token_text);
+    }
+    else {
+        /* Symbols, unquoted strings, and numbers can be printed directly. EOF will have "<end of file>" in token_text. */
+        snprintf(error_message_buff, ERROR_BUFLEN, "Expected %s but found %s", s, token_text);
+    }
+    
+    ellipsize_error_message_buff();
+    error(error_message_buff);
+}
+

 extern void ebf_symbol_error(char *s1, char *name, char *type, brief_location report_line)
 {   snprintf(error_message_buff, ERROR_BUFLEN, "\"%s\" is a name already in use and may not be used as a %s (%s \"%s\" was defined at %s)", name, s1, type, name, location_text(report_line));
     ellipsize_error_message_buff();
 extern void ebf_symbol_error(char *s1, char *name, char *type, brief_location report_line)
 {   snprintf(error_message_buff, ERROR_BUFLEN, "\"%s\" is a name already in use and may not be used as a %s (%s \"%s\" was defined at %s)", name, s1, type, name, location_text(report_line));
     ellipsize_error_message_buff();


@@ -407,9 +447,13 @@ extern void warning(char *s1)
     message(2,s1);
 }
 
     message(2,s1);
 }
 

-extern void warning_numbered(char *s1, int val)
-{   if (nowarnings_switch) { no_suppressed_warnings++; return; }
-    snprintf(error_message_buff, ERROR_BUFLEN,"%s %d.", s1, val);
+extern void warning_fmt(const char *format, ...)
+{
+    va_list argument_pointer;
+    if (nowarnings_switch) { no_suppressed_warnings++; return; }
+    va_start(argument_pointer, format);
+    vsnprintf(error_message_buff, ERROR_BUFLEN, format, argument_pointer);
+    va_end(argument_pointer);

     ellipsize_error_message_buff();
     message(2,error_message_buff);
 }
     ellipsize_error_message_buff();
     message(2,error_message_buff);
 }


@@ -422,6 +466,19 @@ extern void warning_named(char *s1, char *s2)
     message(2,error_message_buff);
 }
 
     message(2,error_message_buff);
 }
 

+extern void warning_at(char *name, brief_location report_line)
+{   int i;
+    ErrorPosition E = ErrorReport;
+    if (nowarnings_switch) { no_suppressed_warnings++; return; }
+    export_brief_location(report_line, &ErrorReport);
+    snprintf(error_message_buff, ERROR_BUFLEN, "%s", name);
+    ellipsize_error_message_buff();
+    i = concise_switch; concise_switch = TRUE;
+    message(2,error_message_buff);
+    concise_switch = i;
+    ErrorReport = E;
+}
+

 extern void symtype_warning(char *context, char *name, char *type, char *wanttype)
 {
     if (nowarnings_switch) { no_suppressed_warnings++; return; }
 extern void symtype_warning(char *context, char *name, char *type, char *wanttype)
 {
     if (nowarnings_switch) { no_suppressed_warnings++; return; }

diff --git a/src/expressc.c b/src/expressc.c
index 067cab395b286e68363e2c3bbeac13459c2a9e9f..61a5d5aadb1f3a445a837e85babd72ae457d7fc9 100644 (file)
--- a/src/expressc.c
+++ b/src/expressc.c
@@ -1,8 +1,8 @@
 /* ------------------------------------------------------------------------- */
 /*   "expressc" :  The expression code generator                             */
 /*                                                                           */
 /* ------------------------------------------------------------------------- */
 /*   "expressc" :  The expression code generator                             */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -1084,10 +1084,16 @@ static assembly_operand check_nonzero_at_runtime_g(assembly_operand AO1,
     /* Test if inside the "Class" object... */
     INITAOTV(&AO3, BYTECONSTANT_OT, GOBJFIELD_PARENT());
     assembleg_3(aload_gc, AO, AO3, stack_pointer);
     /* Test if inside the "Class" object... */
     INITAOTV(&AO3, BYTECONSTANT_OT, GOBJFIELD_PARENT());
     assembleg_3(aload_gc, AO, AO3, stack_pointer);

-    ln = symbol_index("Class", -1);
-    AO3.value = symbols[ln].value;
-    AO3.marker = OBJECT_MV;
-    AO3.type = CONSTANT_OT;
+    ln = get_symbol_index("Class");
+    if (ln < 0) {
+        error("No 'Class' object found");
+        AO3 = zero_operand;
+    }
+    else {
+        AO3.value = symbols[ln].value;
+        AO3.marker = OBJECT_MV;
+        AO3.type = CONSTANT_OT;
+    }

     assembleg_2_branch(jne_gc, stack_pointer, AO3, passed_label);
   }
   
     assembleg_2_branch(jne_gc, stack_pointer, AO3, passed_label);
   }
   


@@ -1105,10 +1111,16 @@ static assembly_operand check_nonzero_at_runtime_g(assembly_operand AO1,
   }
   else {
     /* Build the symbol for "Object" */
   }
   else {
     /* Build the symbol for "Object" */

-    ln = symbol_index("Object", -1);
-    AO2.value = symbols[ln].value;
-    AO2.marker = OBJECT_MV;
-    AO2.type = CONSTANT_OT;
+    ln = get_symbol_index("Object");
+    if (ln < 0) {
+        error("No 'Object' object found");
+        AO2 = zero_operand;
+    }
+    else {
+        AO2.value = symbols[ln].value;
+        AO2.marker = OBJECT_MV;
+        AO2.type = CONSTANT_OT;
+    }

     if (check_sp) {
       /* Push "Object" */
       assembleg_store(AO1, AO2);
     if (check_sp) {
       /* Push "Object" */
       assembleg_store(AO1, AO2);


@@ -2643,11 +2655,48 @@ static void generate_code_from(int n, int void_flag)
                             assembleg_2(random_gc, AO, stack_pointer);
                             assembleg_3(aload_gc, AO2, stack_pointer, Result);
                          }
                             assembleg_2(random_gc, AO, stack_pointer);
                             assembleg_3(aload_gc, AO2, stack_pointer, Result);
                          }

+                         else if (is_constant_ot(ET[ET[below].right].value.type) && ET[ET[below].right].value.marker == 0) {
+                           /* One argument, value known at compile time */
+                           int32 arg = ET[ET[below].right].value.value; /* signed */
+                           if (arg > 0) {
+                             assembly_operand AO;
+                             INITAO(&AO);
+                             AO.value = arg;
+                             set_constant_ot(&AO);
+                             assembleg_2(random_gc,
+                               AO, stack_pointer);
+                             assembleg_3(add_gc, stack_pointer, one_operand,
+                               Result);
+                           }
+                           else {
+                             /* This handles zero or negative */
+                             assembly_operand AO;
+                             INITAO(&AO);
+                             AO.value = -arg;
+                             set_constant_ot(&AO);
+                             assembleg_1(setrandom_gc,
+                               AO);
+                             assembleg_store(Result, zero_operand);
+                           }
+                         }

                          else {
                          else {

+                           /* One argument, not known at compile time */
+                           int ln, ln2;
+                           assembleg_store(temp_var1, ET[ET[below].right].value);
+                           ln = next_label++;
+                           ln2 = next_label++;
+                           assembleg_2_branch(jle_gc, temp_var1, zero_operand, ln);

                            assembleg_2(random_gc,
                            assembleg_2(random_gc,

-                             ET[ET[below].right].value, stack_pointer);
+                             temp_var1, stack_pointer);

                            assembleg_3(add_gc, stack_pointer, one_operand,
                              Result);
                            assembleg_3(add_gc, stack_pointer, one_operand,
                              Result);

+                           assembleg_0_branch(jump_gc, ln2);
+                           assemble_label_no(ln);
+                           assembleg_2(neg_gc, temp_var1, stack_pointer);
+                           assembleg_1(setrandom_gc,
+                             stack_pointer);
+                           assembleg_store(Result, zero_operand);
+                           assemble_label_no(ln2);

                          }
                          break;
 
                          }
                          break;
 


@@ -3001,7 +3050,7 @@ assembly_operand code_generate(assembly_operand AO, int context, int label)
     }
 
     if (expr_trace_level >= 2)
     }
 
     if (expr_trace_level >= 2)

-    {   printf("Raw parse tree:\n"); show_tree(AO, FALSE);
+    {   printf("Raw parse tree:\n"); show_tree(&AO, FALSE);

     }
 
     if (context == CONDITION_CONTEXT)
     }
 
     if (context == CONDITION_CONTEXT)


@@ -3021,7 +3070,7 @@ assembly_operand code_generate(assembly_operand AO, int context, int label)
             default: printf("* ILLEGAL *"); break;
         }
         printf(" context with annotated tree:\n");
             default: printf("* ILLEGAL *"); break;
         }
         printf(" context with annotated tree:\n");

-        show_tree(AO, TRUE);
+        show_tree(&AO, TRUE);

     }
 
     generate_code_from(AO.value, (context==VOID_CONTEXT));
     }
 
     generate_code_from(AO.value, (context==VOID_CONTEXT));

diff --git a/src/expressp.c b/src/expressp.c
index c93337ae885a4b57d9592598ba39c09507505b72..906eed160e4dd7810d609aadfe3828c5d524f3bc 100644 (file)
--- a/src/expressp.c
+++ b/src/expressp.c
@@ -1,8 +1,8 @@
 /* ------------------------------------------------------------------------- */
 /*   "expressp" :  The expression parser                                     */
 /*                                                                           */
 /* ------------------------------------------------------------------------- */
 /*   "expressp" :  The expression parser                                     */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -67,6 +67,8 @@ static int comma_allowed, arrow_allowed, superclass_allowed,
 
 int system_function_usage[NUMBER_SYSTEM_FUNCTIONS];
 
 
 int system_function_usage[NUMBER_SYSTEM_FUNCTIONS];
 

+static void check_system_constant_available(int);
+

 static int get_next_etoken(void)
 {   int v, symbol = 0, mark_symbol_as_used = FALSE,
         initial_bracket_level = bracket_level;
 static int get_next_etoken(void)
 {   int v, symbol = 0, mark_symbol_as_used = FALSE,
         initial_bracket_level = bracket_level;


@@ -324,8 +326,8 @@ but not used as a value:", unicode);
 
                     current_token.text += 3;
                     current_token.type = SYMBOL_TT;
 
                     current_token.text += 3;
                     current_token.type = SYMBOL_TT;

-                    symbol = symbol_index(current_token.text, -1);
-                    if (symbols[symbol].type != GLOBAL_VARIABLE_T) {
+                    symbol = get_symbol_index(current_token.text);
+                    if (symbol < 0 || symbols[symbol].type != GLOBAL_VARIABLE_T) {

                         ebf_error(
                         "global variable name after '#g$'",
                         current_token.text);
                         ebf_error(
                         "global variable name after '#g$'",
                         current_token.text);


@@ -376,7 +378,7 @@ but not used as a value:", unicode);
                         "'#r$Routine' can now be written just 'Routine'");
                     current_token.text += 3;
                     current_token.type = SYMBOL_TT;
                         "'#r$Routine' can now be written just 'Routine'");
                     current_token.text += 3;
                     current_token.type = SYMBOL_TT;

-                    current_token.value = symbol_index(current_token.text, -1);
+                    current_token.value = symbol_index(current_token.text, -1, NULL);

                     goto ReceiveSymbol;
 
                 case HASHWDOLLAR_SEP:
                     goto ReceiveSymbol;
 
                 case HASHWDOLLAR_SEP:


@@ -388,13 +390,14 @@ but not used as a value:", unicode);
                     get_next_token();
                     system_constants.enabled = FALSE;
                     if (token_type != SYSTEM_CONSTANT_TT)
                     get_next_token();
                     system_constants.enabled = FALSE;
                     if (token_type != SYSTEM_CONSTANT_TT)

-                    {   ebf_error(
-                        "'r$', 'n$', 'g$' or internal Inform constant name after '#'",
-                        token_text);
+                    {   ebf_curtoken_error(
+                        "'r$', 'n$', 'g$' or internal Inform constant name after '#'");

                         break;
                     }
                     else
                         break;
                     }
                     else

-                    {   current_token.type   = token_type;
+                    {
+                        check_system_constant_available(token_value);
+                        current_token.type   = token_type;

                         current_token.value  = token_value;
                         current_token.text   = token_text;
                         current_token.marker = INCON_MV;
                         current_token.value  = token_value;
                         current_token.text   = token_text;
                         current_token.marker = INCON_MV;


@@ -472,27 +475,31 @@ but not used as a value:", unicode);
     return TRUE;
 }
 
     return TRUE;
 }
 

-/* --- Operator precedences ------------------------------------------------ */
+/* --- Operator precedences and error values-------------------------------- */

 
 #define LOWER_P   101
 #define EQUAL_P   102
 #define GREATER_P 103
 
 
 #define LOWER_P   101
 #define EQUAL_P   102
 #define GREATER_P 103
 

-#define e1        1       /* Missing operand error                */
-#define e2        2       /* Unexpected close bracket             */
-#define e3        3       /* Missing operator error               */
-#define e4        4       /* Expression ends with an open bracket */
-#define e5        5       /* Associativity illegal error          */
+#define BYPREC     -1       /* Compare the precedence of two operators */
+
+#define NOVAL_E     1       /* Missing operand error                */
+#define CLOSEB_E    2       /* Unexpected close bracket             */
+#define NOOP_E      3       /* Missing operator error               */
+#define OPENB_E     4       /* Expression ends with an open bracket */
+#define ASSOC_E     5       /* Associativity illegal error          */

 
 

-const int prec_table[] = {
+const int prec_table[49] = {

 
 

-/* a .......... (         )           end       op          term             */
+/*   a .......   (         )           end       op:pre      op:bin      op:post     term      */

 
 

-/* b  (    */   LOWER_P,  e3,         LOWER_P,  LOWER_P,    e3,
-/* .  )    */   EQUAL_P,  GREATER_P,  e2,       GREATER_P,  GREATER_P,
-/* .  end  */   e4,       GREATER_P,  e1,       GREATER_P,  GREATER_P,
-/* .  op   */   LOWER_P,  GREATER_P,  LOWER_P,  -1,         GREATER_P,
-/* .  term */   LOWER_P,  e3,         LOWER_P,  LOWER_P,    e3
+/* b  (    */    LOWER_P,  NOOP_E,     LOWER_P,  LOWER_P,    LOWER_P,    NOOP_E,     NOOP_E,
+/* .  )    */    EQUAL_P,  GREATER_P,  CLOSEB_E, GREATER_P,  GREATER_P,  GREATER_P,  GREATER_P,
+/* .  end  */    OPENB_E,  GREATER_P,  NOVAL_E,  GREATER_P,  GREATER_P,  GREATER_P,  GREATER_P,
+/* .  op:pre  */ LOWER_P,  NOOP_E,     LOWER_P,  BYPREC,     BYPREC,     NOOP_E,     NOOP_E,
+/* .  op:bin  */ LOWER_P,  GREATER_P,  LOWER_P,  BYPREC,     BYPREC,     BYPREC,     GREATER_P,
+/* .  op:post */ LOWER_P,  GREATER_P,  LOWER_P,  BYPREC,     BYPREC,     BYPREC,     GREATER_P,
+/* .  term */    LOWER_P,  NOOP_E,     LOWER_P,  LOWER_P,    LOWER_P,    NOOP_E,     NOOP_E

 
 };
 
 
 };
 


@@ -501,7 +508,7 @@ static int find_prec(const token_data *a, const token_data *b)
     /*  We are comparing the precedence of tokens  a  and  b
         (where a occurs to the left of b).  If the expression is correct,
         the only possible values are GREATER_P, LOWER_P or EQUAL_P;
     /*  We are comparing the precedence of tokens  a  and  b
         (where a occurs to the left of b).  If the expression is correct,
         the only possible values are GREATER_P, LOWER_P or EQUAL_P;

-        if it is malformed then one of e1 to e5 results.
+        if it is malformed then one of the *_E results.

 
         Note that this routine is not symmetrical and that the relation
         is not trichotomous.
 
         Note that this routine is not symmetrical and that the relation
         is not trichotomous.


@@ -512,25 +519,50 @@ static int find_prec(const token_data *a, const token_data *b)
             a GREATER_P a   if a left-associative
     */
 
             a GREATER_P a   if a left-associative
     */
 

-    int i, j, l1, l2;
+    int ai, bi, j, l1, l2;

 
 

+    /*   Select a column and row in prec_table, based on the type of
+         a and b. If a/b is an operator, we have to distinguish three
+         columns/rows depending on whether the operator is prefix,
+         postfix, or neither.
+    */
+    

     switch(a->type)
     switch(a->type)

-    {   case SUBOPEN_TT:  i=0; break;
-        case SUBCLOSE_TT: i=1; break;
-        case ENDEXP_TT:   i=2; break;
-        case OP_TT:       i=3; break;
-        default:          i=4; break;
+    {   case SUBOPEN_TT:  ai=0; break;
+        case SUBCLOSE_TT: ai=1; break;
+        case ENDEXP_TT:   ai=2; break;
+        case OP_TT:
+            if (operators[a->value].usage == PRE_U)
+                ai=3;
+            else if (operators[a->value].usage == POST_U)
+                ai=5;
+            else
+                ai=4;
+            break;
+        default:          ai=6; break;

     }
     switch(b->type)
     }
     switch(b->type)

-    {   case SUBOPEN_TT:  i+=0; break;
-        case SUBCLOSE_TT: i+=5; break;
-        case ENDEXP_TT:   i+=10; break;
-        case OP_TT:       i+=15; break;
-        default:          i+=20; break;
+    {   case SUBOPEN_TT:  bi=0; break;
+        case SUBCLOSE_TT: bi=1; break;
+        case ENDEXP_TT:   bi=2; break;
+        case OP_TT:
+            if (operators[b->value].usage == PRE_U)
+                bi=3;
+            else if (operators[b->value].usage == POST_U)
+                bi=5;
+            else
+                bi=4;
+            break;
+        default:          bi=6; break;

     }
     }

+    
+    j = prec_table[ai+7*bi];
+    if (j != BYPREC) return j;

 
 

-    j = prec_table[i]; if (j != -1) return j;
-
+    /* BYPREC is the (a=OP, b=OP) cases. We must compare the precedence of the
+       two operators.
+       (We've already eliminated invalid cases like (a++ --b).)
+    */

     l1 = operators[a->value].precedence;
     l2 = operators[b->value].precedence;
     if (operators[b->value].usage == PRE_U) return LOWER_P;
     l1 = operators[a->value].precedence;
     l2 = operators[b->value].precedence;
     if (operators[b->value].usage == PRE_U) return LOWER_P;


@@ -550,7 +582,7 @@ static int find_prec(const token_data *a, const token_data *b)
     switch(operators[a->value].associativity)
     {   case L_A: return GREATER_P;
         case R_A: return LOWER_P;
     switch(operators[a->value].associativity)
     {   case L_A: return GREATER_P;
         case R_A: return LOWER_P;

-        case 0:   return e5;
+        case 0:   return ASSOC_E;

     }
     return GREATER_P;
 }
     }
     return GREATER_P;
 }


@@ -606,8 +638,32 @@ int z_system_constant_list[] =
       grammar_table_SC,
       -1 };
 
       grammar_table_SC,
       -1 };
 

+static void check_system_constant_available(int t)
+{
+    if (OMIT_SYMBOL_TABLE) {
+        /* Certain system constants refer to the symbol table, which
+           is meaningless if OMIT_SYMBOL_TABLE is set. */
+        switch(t)
+        {
+            case identifiers_table_SC:
+            case attribute_names_array_SC:
+            case property_names_array_SC:
+            case action_names_array_SC:
+            case fake_action_names_array_SC:
+            case array_names_offset_SC:
+            case global_names_array_SC:
+            case routine_names_array_SC:
+            case constant_names_array_SC:
+                error_named("OMIT_SYMBOL_TABLE omits system constant", system_constants.keywords[t]);
+            default:
+                break;
+        }
+    }
+}
+

 static int32 value_of_system_constant_z(int t)
 static int32 value_of_system_constant_z(int t)

-{   switch(t)
+{
+    switch(t)

     {   case adjectives_table_SC:
             return adjectives_offset;
         case actions_table_SC:
     {   case adjectives_table_SC:
             return adjectives_offset;
         case actions_table_SC:


@@ -1042,7 +1098,7 @@ static void add_bracket_layer_to_emitter_stack(int depth)
 {   /* There's no point in tracking bracket layers that don't fence off any values. */
     if (emitter_sp < depth + 1) return;
     if (expr_trace_level >= 2)
 {   /* There's no point in tracking bracket layers that don't fence off any values. */
     if (emitter_sp < depth + 1) return;
     if (expr_trace_level >= 2)

-        printf("Adding bracket layer\n");
+        printf("Adding bracket layer (depth %d)\n", depth);

     ++emitter_stack[emitter_sp-depth-1].bracket_count;
 }
 
     ++emitter_stack[emitter_sp-depth-1].bracket_count;
 }
 


@@ -1215,7 +1271,7 @@ static void emit_token(const token_data *t)
                 default:
                     warning("Property name in expression is not qualified by object");
             }
                 default:
                     warning("Property name in expression is not qualified by object");
             }

-        } /* if (is_property_t */
+        }

     }
 
     switch(arity)
     }
 
     switch(arity)


@@ -1223,7 +1279,12 @@ static void emit_token(const token_data *t)
             o1 = emitter_stack[emitter_sp - 1].op;
             if ((o1.marker == 0) && is_constant_ot(o1.type))
             {   switch(t->value)
             o1 = emitter_stack[emitter_sp - 1].op;
             if ((o1.marker == 0) && is_constant_ot(o1.type))
             {   switch(t->value)

-                {   case UNARY_MINUS_OP: x = -o1.value; goto FoldConstant;
+                {   case UNARY_MINUS_OP:
+                        if ((uint32)o1.value == 0x80000000)
+                          x = 0x80000000;
+                        else
+                          x = -o1.value;
+                        goto FoldConstant;

                     case ARTNOT_OP: 
                          if (!glulx_mode)
                              x = (~o1.value) & 0xffff;
                     case ARTNOT_OP: 
                          if (!glulx_mode)
                              x = (~o1.value) & 0xffff;


@@ -1390,23 +1451,24 @@ static void emit_token(const token_data *t)
        for 32-bit arithmetic. */
 
     if (!glulx_mode && ((x<-32768) || (x > 32767)))
        for 32-bit arithmetic. */
 
     if (!glulx_mode && ((x<-32768) || (x > 32767)))

-    {   char folding_error[40];
+    {

         int32 ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
         int32 ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;
         int32 ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
         int32 ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;

+        char op = '?';

         switch(t->value)
         {
             case PLUS_OP:
         switch(t->value)
         {
             case PLUS_OP:

-                sprintf(folding_error, "%d + %d = %d", ov1, ov2, x);
+                op = '+';

                 break;
             case MINUS_OP:
                 break;
             case MINUS_OP:

-                sprintf(folding_error, "%d - %d = %d", ov1, ov2, x);
+                op = '-';

                 break;
             case TIMES_OP:
                 break;
             case TIMES_OP:

-                sprintf(folding_error, "%d * %d = %d", ov1, ov2, x);
+                op = '*';

                 break;
         }
                 break;
         }

-        error_named("Signed arithmetic on compile-time constants overflowed \
-the range -32768 to +32767:", folding_error);
+        error_fmt("Signed arithmetic on compile-time constants overflowed \
+the range -32768 to +32767 (%d %c %d = %d)", ov1, op, ov2, x);

     }
 
     FoldConstant:
     }
 
     FoldConstant:


@@ -1479,10 +1541,10 @@ static void show_node(int n, int depth, int annotate)
     if (ET[n].right != -1) show_node(ET[n].right, depth, annotate);
 }
 
     if (ET[n].right != -1) show_node(ET[n].right, depth, annotate);
 }
 

-extern void show_tree(assembly_operand AO, int annotate)
-{   if (AO.type == EXPRESSION_OT) show_node(AO.value, 0, annotate);
+extern void show_tree(const assembly_operand *AO, int annotate)
+{   if (AO->type == EXPRESSION_OT) show_node(AO->value, 0, annotate);

     else
     else

-    {   printf("Constant: "); print_operand(&AO, annotate);
+    {   printf("Constant: "); print_operand(AO, annotate);

         printf("\n");
     }
 }
         printf("\n");
     }
 }


@@ -1882,8 +1944,11 @@ extern assembly_operand parse_expression(int context)
         is constant and thus known at compile time.
 
         If an error has occurred in the expression, which recovery from was
         is constant and thus known at compile time.
 
         If an error has occurred in the expression, which recovery from was

-        not possible, then the return is (short constant) 0.  This should
-        minimise the chance of a cascade of further error messages.
+        not possible, then the return is (short constant) 0 with marker
+        value ERROR_MV.  The caller may check for this marker value to
+        decide whether to (e.g.) stop reading array values. Otherwise, it
+        will just be treated as a zero, which should minimise the chance
+        of a cascade of further error messages.

     */
 
     token_data a, b, pop; int i;
     */
 
     token_data a, b, pop; int i;


@@ -1925,7 +1990,8 @@ extern assembly_operand parse_expression(int context)
     directives.enabled = FALSE;
 
     if (get_next_etoken() == FALSE)
     directives.enabled = FALSE;
 
     if (get_next_etoken() == FALSE)

-    {   ebf_error("expression", token_text);
+    {   ebf_curtoken_error("expression");
+        AO.marker = ERROR_MV;

         return AO;
     }
 
         return AO;
     }
 


@@ -1939,6 +2005,7 @@ extern assembly_operand parse_expression(int context)
 
         if (sr_sp == 0)
         {   compiler_error("SR error: stack empty");
 
         if (sr_sp == 0)
         {   compiler_error("SR error: stack empty");

+            AO.marker = ERROR_MV;

             return(AO);
         }
 
             return(AO);
         }
 


@@ -1948,10 +2015,12 @@ extern assembly_operand parse_expression(int context)
         {   if (emitter_sp == 0)
             {   error("No expression between brackets '(' and ')'");
                 put_token_back();
         {   if (emitter_sp == 0)
             {   error("No expression between brackets '(' and ')'");
                 put_token_back();

+                AO.marker = ERROR_MV;

                 return AO;
             }
             if (emitter_sp > 1)
             {   compiler_error("SR error: emitter stack overfull");
                 return AO;
             }
             if (emitter_sp > 1)
             {   compiler_error("SR error: emitter stack overfull");

+                AO.marker = ERROR_MV;

                 return AO;
             }
 
                 return AO;
             }
 


@@ -1959,7 +2028,7 @@ extern assembly_operand parse_expression(int context)
             if (AO.type == EXPRESSION_OT)
             {   if (expr_trace_level >= 3)
                 {   printf("Tree before lvalue checking:\n");
             if (AO.type == EXPRESSION_OT)
             {   if (expr_trace_level >= 3)
                 {   printf("Tree before lvalue checking:\n");

-                    show_tree(AO, FALSE);
+                    show_tree(&AO, FALSE);

                 }
                 if (!glulx_mode)
                     check_property_operator(AO.value);
                 }
                 if (!glulx_mode)
                     check_property_operator(AO.value);


@@ -1979,6 +2048,7 @@ extern assembly_operand parse_expression(int context)
             if (context == CONSTANT_CONTEXT)
                 if (!is_constant_ot(AO.type))
                 {   AO = zero_operand;
             if (context == CONSTANT_CONTEXT)
                 if (!is_constant_ot(AO.type))
                 {   AO = zero_operand;

+                    AO.marker = ERROR_MV;

                     ebf_error("constant", "<expression>");
                 }
             put_token_back();
                     ebf_error("constant", "<expression>");
                 }
             put_token_back();


@@ -1988,7 +2058,7 @@ extern assembly_operand parse_expression(int context)
 
         switch(find_prec(&a,&b))
         {
 
         switch(find_prec(&a,&b))
         {

-            case e5:                 /* Associativity error                  */
+            case ASSOC_E:            /* Associativity error                  */

                 error_named("Brackets mandatory to clarify order of:",
                     a.text);
 
                 error_named("Brackets mandatory to clarify order of:",
                     a.text);
 


@@ -2048,8 +2118,10 @@ extern assembly_operand parse_expression(int context)
                 } while (find_prec(&sr_stack[sr_sp-1], &pop) != LOWER_P);
                 break;
 
                 } while (find_prec(&sr_stack[sr_sp-1], &pop) != LOWER_P);
                 break;
 

-            case e1:                 /* Missing operand error                */
+            case NOVAL_E:            /* Missing operand error                */

                 error_named("Missing operand after", a.text);
                 error_named("Missing operand after", a.text);

+                /* We insert a "0" token so that the rest of the expression
+                   can be compiled. */

                 put_token_back();
                 current_token.type = NUMBER_TT;
                 current_token.value = 0;
                 put_token_back();
                 current_token.type = NUMBER_TT;
                 current_token.value = 0;


@@ -2057,13 +2129,15 @@ extern assembly_operand parse_expression(int context)
                 current_token.text = "0";
                 break;
 
                 current_token.text = "0";
                 break;
 

-            case e2:                 /* Unexpected close bracket             */
+            case CLOSEB_E:           /* Unexpected close bracket             */

                 error("Found '(' without matching ')'");
                 get_next_etoken();
                 break;
 
                 error("Found '(' without matching ')'");
                 get_next_etoken();
                 break;
 

-            case e3:                 /* Missing operator error               */
-                error("Missing operator: inserting '+'");
+            case NOOP_E:             /* Missing operator error               */
+                error_named("Missing operator after", a.text);
+                /* We insert a "+" token so that the rest of the expression
+                   can be compiled. */

                 put_token_back();
                 current_token.type = OP_TT;
                 current_token.value = PLUS_OP;
                 put_token_back();
                 current_token.type = OP_TT;
                 current_token.value = PLUS_OP;


@@ -2071,7 +2145,7 @@ extern assembly_operand parse_expression(int context)
                 current_token.text = "+";
                 break;
 
                 current_token.text = "+";
                 break;
 

-            case e4:                 /* Expression ends with an open bracket */
+            case OPENB_E:            /* Expression ends with an open bracket */

                 error("Found '(' without matching ')'");
                 sr_sp--;
                 break;
                 error("Found '(' without matching ')'");
                 sr_sp--;
                 break;


@@ -2099,6 +2173,80 @@ extern int test_for_incdec(assembly_operand AO)
     return s*(ET[ET[AO.value].down].value.value);
 }
 
     return s*(ET[ET[AO.value].down].value.value);
 }
 

+
+/* Determine if the operand (a parsed expression) is a constant (as
+   per is_constant_ot()) or a comma-separated list of such constants.
+   
+   "(1)" and "(1,2,3)" both count, and even "((1,2),3)", but
+   not "(1,(2,3))"; the list must be left-associated.
+
+   Backpatched constants (function names, etc) are acceptable, as are
+   folded constant expressions. Variables are right out.
+
+   The constants are stored in the ops_found array, up to a maximum of
+   max_ops_found. For Inform parsing reasons, the array list is backwards
+   from the order found.
+
+   Returns the number of constants found. If the expression is not a list of
+   constants, returns zero.
+   
+   (The return value may be more than max_ops_found, in which case we weren't
+   able to return them all in the array.)
+*/
+extern int test_constant_op_list(const assembly_operand *AO, assembly_operand *ops_found, int max_ops_found)
+{
+    int count = 0;
+    int n;
+
+    if (AO->type != EXPRESSION_OT) {
+        if (!is_constant_ot(AO->type))
+            return 0;
+
+        if (ops_found && max_ops_found > 0)
+            ops_found[0] = *AO;
+        return 1;
+    }
+
+    n = AO->value;
+
+    /* For some reason the top node is always a COMMA with no .right,
+       just a .down. Should we rely on this? For now yes. */
+
+    if (operators[ET[n].operator_number].token_value != COMMA_SEP)
+        return 0;
+    if (ET[n].right != -1)
+        return 0;
+    n = ET[n].down;
+
+    while (TRUE) {
+        if (ET[n].right != -1) {
+            if (ET[ET[n].right].down != -1)
+                return 0;
+            if (!is_constant_ot(ET[ET[n].right].value.type))
+                return 0;
+            
+            if (ops_found && max_ops_found > count)
+                ops_found[count] = ET[ET[n].right].value;
+            count++;
+        }
+
+        if (ET[n].down == -1) {
+            if (!is_constant_ot(ET[n].value.type))
+                return 0;
+            
+            if (ops_found && max_ops_found > count)
+                ops_found[count] = ET[n].value;
+            count++;
+            return count;
+        }
+        
+        if (operators[ET[n].operator_number].token_value != COMMA_SEP)
+            return 0;
+
+        n = ET[n].down;
+    }
+}
+

 /* ========================================================================= */
 /*   Data structure management routines                                      */
 /* ------------------------------------------------------------------------- */
 /* ========================================================================= */
 /*   Data structure management routines                                      */
 /* ------------------------------------------------------------------------- */

diff --git a/src/files.c b/src/files.c
index 50fdf5a4f99d9b949affc0d4ee2151affa799748..68d1c5581a8130a7009848b7e3d9c3f7b383b4b1 100644 (file)
--- a/src/files.c
+++ b/src/files.c
@@ -7,8 +7,8 @@
 /*             routines in "inform.c", since they are tied up with ICL       */
 /*             settings and are very host OS-dependent.                      */
 /*                                                                           */
 /*             routines in "inform.c", since they are tied up with ICL       */
 /*             settings and are very host OS-dependent.                      */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -40,7 +40,7 @@ int32 total_chars_read;                 /* Characters read in (from all
 static int checksum_low_byte,           /* For calculating the Z-machine's   */
            checksum_high_byte;          /* "verify" checksum                 */
 
 static int checksum_low_byte,           /* For calculating the Z-machine's   */
            checksum_high_byte;          /* "verify" checksum                 */
 

-static int32 checksum_long;             /* For the Glulx checksum,           */
+static uint32 checksum_long;             /* For the Glulx checksum,          */

 static int checksum_count;              /* similarly                         */
 
 /* ------------------------------------------------------------------------- */
 static int checksum_count;              /* similarly                         */
 
 /* ------------------------------------------------------------------------- */


@@ -115,7 +115,7 @@ extern void load_sourcefile(char *filename_given, int same_directory_flag)
     do
     {   x = translate_in_filename(x, name, filename_given, same_directory_flag,
                 (total_files==0)?1:0);
     do
     {   x = translate_in_filename(x, name, filename_given, same_directory_flag,
                 (total_files==0)?1:0);

-        handle = fopen(name,"r");
+        handle = fopen(name,"rb");

     } while ((handle == NULL) && (x != 0));
 
     InputFiles[total_files].filename = my_malloc(strlen(name)+1, "filename storage");
     } while ((handle == NULL) && (x != 0));
 
     InputFiles[total_files].filename = my_malloc(strlen(name)+1, "filename storage");


@@ -300,16 +300,16 @@ static void sf_put(int c)
 
       switch (checksum_count) {
       case 0:
 
       switch (checksum_count) {
       case 0:

-        checksum_long += (((int32)(c & 0xFF)) << 24);
+        checksum_long += (((uint32)(c & 0xFF)) << 24);

         break;
       case 1:
         break;
       case 1:

-        checksum_long += (((int32)(c & 0xFF)) << 16);
+        checksum_long += (((uint32)(c & 0xFF)) << 16);

         break;
       case 2:
         break;
       case 2:

-        checksum_long += (((int32)(c & 0xFF)) << 8);
+        checksum_long += (((uint32)(c & 0xFF)) << 8);

         break;
       case 3:
         break;
       case 3:

-        checksum_long += ((int32)(c & 0xFF));
+        checksum_long += ((uint32)(c & 0xFF));

         break;
       }
       
         break;
       }
       


@@ -357,7 +357,7 @@ static void output_compression(int entnum, int32 *size, int *count)
     (*size) += 1;
     break;
   case 3:
     (*size) += 1;
     break;
   case 3:

-    cx = (char *)abbreviations_at + ent->u.val*MAX_ABBREV_LENGTH;
+    cx = abbreviation_text(ent->u.val);

     while (*cx) {
       sf_put(*cx);
       cx++;
     while (*cx) {
       sf_put(*cx);
       cx++;


@@ -619,7 +619,6 @@ static void output_file_z(void)
 static void output_file_g(void)
 {   char new_name[PATHLEN];
     int32 size, i, j, offset;
 static void output_file_g(void)
 {   char new_name[PATHLEN];
     int32 size, i, j, offset;

-    int32 VersionNum;

     uint32 code_length, size_before_code, next_cons_check;
     int use_function;
     int first_byte_of_triple, second_byte_of_triple, third_byte_of_triple;
     uint32 code_length, size_before_code, next_cons_check;
     int use_function;
     int first_byte_of_triple, second_byte_of_triple, third_byte_of_triple;


@@ -646,35 +645,33 @@ static void output_file_g(void)
 
     /* Determine the version number. */
 
 
     /* Determine the version number. */
 

-    VersionNum = 0x00020000;
+    final_glulx_version = 0x00020000;

 
     /* Increase for various features the game may have used. */
     if (no_unicode_chars != 0 || (uses_unicode_features)) {
 
     /* Increase for various features the game may have used. */
     if (no_unicode_chars != 0 || (uses_unicode_features)) {

-      VersionNum = 0x00030000;
+      final_glulx_version = 0x00030000;

     }
     if (uses_memheap_features) {
     }
     if (uses_memheap_features) {

-      VersionNum = 0x00030100;
+      final_glulx_version = 0x00030100;

     }
     if (uses_acceleration_features) {
     }
     if (uses_acceleration_features) {

-      VersionNum = 0x00030101;
+      final_glulx_version = 0x00030101;

     }
     if (uses_float_features) {
     }
     if (uses_float_features) {

-      VersionNum = 0x00030102;
+      final_glulx_version = 0x00030102;

     }
     if (uses_double_features || uses_extundo_features) {
     }
     if (uses_double_features || uses_extundo_features) {

-      VersionNum = 0x00030103;
+      final_glulx_version = 0x00030103;

     }
 
     /* And check if the user has requested a specific version. */
     if (requested_glulx_version) {
     }
 
     /* And check if the user has requested a specific version. */
     if (requested_glulx_version) {

-      if (requested_glulx_version < VersionNum) {
-        static char error_message_buff[256];
-        sprintf(error_message_buff, "Version 0x%08lx requested, but \
-game features require version 0x%08lx", (long)requested_glulx_version, (long)VersionNum);
-        warning(error_message_buff);
+      if (requested_glulx_version < final_glulx_version) {
+        warning_fmt("Version 0x%08lx requested, but game features require version 0x%08lx",
+                    (long)requested_glulx_version, (long)final_glulx_version);

       }
       else {
       }
       else {

-        VersionNum = requested_glulx_version;
+        final_glulx_version = requested_glulx_version;

       }
     }
 
       }
     }
 


@@ -687,10 +684,10 @@ game features require version 0x%08lx", (long)requested_glulx_version, (long)Ver
     sf_put('u');
     sf_put('l');
     /* Version number. */
     sf_put('u');
     sf_put('l');
     /* Version number. */

-    sf_put((VersionNum >> 24));
-    sf_put((VersionNum >> 16));
-    sf_put((VersionNum >> 8));
-    sf_put((VersionNum));
+    sf_put((final_glulx_version >> 24));
+    sf_put((final_glulx_version >> 16));
+    sf_put((final_glulx_version >> 8));
+    sf_put((final_glulx_version));

     /* RAMSTART */
     sf_put((Write_RAM_At >> 24));
     sf_put((Write_RAM_At >> 16));
     /* RAMSTART */
     sf_put((Write_RAM_At >> 24));
     sf_put((Write_RAM_At >> 16));


@@ -1220,9 +1217,9 @@ extern void open_transcript_file(char *what_of)
 
     transcript_open = TRUE;
 
 
     transcript_open = TRUE;
 

-    sprintf(topline_buffer, "Transcript of the text of \"%s\"", what_of);
+    snprintf(topline_buffer, 256, "Transcript of the text of \"%s\"", what_of);

     write_to_transcript_file(topline_buffer, STRCTX_INFO);
     write_to_transcript_file(topline_buffer, STRCTX_INFO);

-    sprintf(topline_buffer, "[From %s]", banner_line);
+    snprintf(topline_buffer, 256, "[From %s]", banner_line);

     write_to_transcript_file(topline_buffer, STRCTX_INFO);
     if (TRANSCRIPT_FORMAT == 1) {
         write_to_transcript_file("[I:info, G:game text, V:veneer text, L:lowmem string, A:abbreviation, D:dict word, O:object name, S:symbol, X:infix]", STRCTX_INFO);
     write_to_transcript_file(topline_buffer, STRCTX_INFO);
     if (TRANSCRIPT_FORMAT == 1) {
         write_to_transcript_file("[I:info, G:game text, V:veneer text, L:lowmem string, A:abbreviation, D:dict word, O:object name, S:symbol, X:infix]", STRCTX_INFO);


@@ -1242,10 +1239,22 @@ extern void close_transcript_file(void)
 {   char botline_buffer[256];
     char sn_buffer[7];
 
 {   char botline_buffer[256];
     char sn_buffer[7];
 

+    write_to_transcript_file("",  STRCTX_INFO);
+
+    if (!glulx_mode) {
+        snprintf(botline_buffer, 256, "[Compiled Z-machine version %d]", version_number);
+    }
+    else {
+        int32 major = (final_glulx_version >> 16) & 0xFFFF;
+        int32 minor = (final_glulx_version >> 8) & 0xFF;
+        int32 patch = final_glulx_version & 0xFF;
+        snprintf(botline_buffer, 256, "[Compiled Glulx version %d.%d.%d]", major, minor, patch);
+    }
+    write_to_transcript_file(botline_buffer, STRCTX_INFO);
+    

     write_serial_number(sn_buffer);
     write_serial_number(sn_buffer);

-    sprintf(botline_buffer, "[End of transcript: release %d, serial %s]",
+    snprintf(botline_buffer, 256, "[End of transcript: release %d, serial %s]",

         release_number, sn_buffer);
         release_number, sn_buffer);

-    write_to_transcript_file("",  STRCTX_INFO);

     write_to_transcript_file(botline_buffer, STRCTX_INFO);
     write_to_transcript_file("",  STRCTX_INFO);
 
     write_to_transcript_file(botline_buffer, STRCTX_INFO);
     write_to_transcript_file("",  STRCTX_INFO);
 

diff --git a/src/header.h b/src/header.h
index 5094c812f316eb086c983e6375d24ffdd7c1145f..80bfa1e964ab0684321b06ec06fb0b947897ae4f 100644 (file)
--- a/src/header.h
+++ b/src/header.h
@@ -1,10 +1,10 @@
 /* ------------------------------------------------------------------------- */
 /*   Header file for Inform:  Z-machine ("Infocom" format) compiler          */
 /*                                                                           */
 /* ------------------------------------------------------------------------- */
 /*   Header file for Inform:  Z-machine ("Infocom" format) compiler          */
 /*                                                                           */

-/*                              Inform 6.41                                  */
+/*                              Inform 6.42                                  */

 /*                                                                           */
 /*   This header file and the others making up the Inform source code are    */
 /*                                                                           */
 /*   This header file and the others making up the Inform source code are    */

-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -34,8 +34,8 @@
 /* ------------------------------------------------------------------------- */
 
 /* For releases, set to the release date in the form "1st January 2000" */
 /* ------------------------------------------------------------------------- */
 
 /* For releases, set to the release date in the form "1st January 2000" */

-#define RELEASE_DATE "22nd July 2022"
-#define RELEASE_NUMBER 1641
+#define RELEASE_DATE "10th February 2024"
+#define RELEASE_NUMBER 1642

 #define GLULX_RELEASE_NUMBER 38
 #define VNUMBER RELEASE_NUMBER
 
 #define GLULX_RELEASE_NUMBER 38
 #define VNUMBER RELEASE_NUMBER
 


@@ -570,14 +570,14 @@
 
 
 #define ReadInt32(ptr)                               \
 
 
 #define ReadInt32(ptr)                               \

-  (   (((int32)(((uchar *)(ptr))[0])) << 24)         \
-    | (((int32)(((uchar *)(ptr))[1])) << 16)         \
-    | (((int32)(((uchar *)(ptr))[2])) <<  8)         \
-    | (((int32)(((uchar *)(ptr))[3]))      ) )
+  (   (((uint32)(((uchar *)(ptr))[0])) << 24)         \
+    | (((uint32)(((uchar *)(ptr))[1])) << 16)         \
+    | (((uint32)(((uchar *)(ptr))[2])) <<  8)         \
+    | (((uint32)(((uchar *)(ptr))[3]))      ) )

 
 #define ReadInt16(ptr)                               \
 
 #define ReadInt16(ptr)                               \

-  (   (((int32)(((uchar *)(ptr))[0])) << 8)          \
-    | (((int32)(((uchar *)(ptr))[1]))     ) )
+  (   (((uint32)(((uchar *)(ptr))[0])) << 8)          \
+    | (((uint32)(((uchar *)(ptr))[1]))     ) )

 
 #define WriteInt32(ptr, val)                         \
   ((ptr)[0] = (uchar)(((int32)(val)) >> 24),         \
 
 #define WriteInt32(ptr, val)                         \
   ((ptr)[0] = (uchar)(((int32)(val)) >> 24),         \


@@ -602,10 +602,6 @@
 /* ------------------------------------------------------------------------- */
 
 #define  MAX_ERRORS            100
 /* ------------------------------------------------------------------------- */
 
 #define  MAX_ERRORS            100

-#define  MAX_IDENTIFIER_LENGTH  32
-#define  MAX_ABBREV_LENGTH      64
-#define  MAX_DICT_WORD_SIZE     40
-#define  MAX_DICT_WORD_BYTES    (40*4)

 #define  MAX_NUM_ATTR_BYTES     39
 #define  MAX_VERB_WORD_SIZE    120
 
 #define  MAX_NUM_ATTR_BYTES     39
 #define  MAX_VERB_WORD_SIZE    120
 


@@ -650,10 +646,12 @@ typedef struct memory_list_s
     size_t count;       /* number of items allocated */
 } memory_list;
 
     size_t count;       /* number of items allocated */
 } memory_list;
 

-typedef struct identstruct_s
-{
-    char text[MAX_IDENTIFIER_LENGTH+1];
-} identstruct;
+typedef struct brief_location_s
+{   int32 file_index;
+    int32 line_number;
+    int32 orig_file_index;
+    int32 orig_line_number;
+} brief_location;

 
 typedef struct assembly_operand_t
 {   int   type;     /* ?_OT value */
 
 typedef struct assembly_operand_t
 {   int   type;     /* ?_OT value */


@@ -673,8 +671,11 @@ typedef struct variableinfo_s {
 
 typedef struct verbt {
     int lines;
 
 typedef struct verbt {
     int lines;

-    int *l; /* alloced array */
+    int *l; /* alloced array of grammar line indexes
+               (positions in grammar_lines[]) */

     int size; /* allocated size of l */
     int size; /* allocated size of l */

+    brief_location line; /* originally defined at */
+    int used; /* only set at locate_dead_grammar_lines() time */

 } verbt;
 
 typedef struct actioninfo_s {
 } verbt;
 
 typedef struct actioninfo_s {


@@ -765,6 +766,8 @@ typedef struct abbreviation_s {
     int value;
     int quality;
     int freq;
     int value;
     int quality;
     int freq;

+    int textpos; /* in abbreviations_text */
+    int textlen;

 } abbreviation;
 
 typedef struct maybe_file_position_S
 } abbreviation;
 
 typedef struct maybe_file_position_S


@@ -792,13 +795,6 @@ typedef struct debug_locations_s
     int reference_count;
 } debug_locations;
 
     int reference_count;
 } debug_locations;
 

-typedef struct brief_location_s
-{   int32 file_index;
-    int32 line_number;
-    int32 orig_file_index;
-    int32 orig_line_number;
-} brief_location;
-

 typedef struct debug_location_beginning_s
 {   debug_locations *head;
     int32 beginning_byte_index;
 typedef struct debug_location_beginning_s
 {   debug_locations *head;
     int32 beginning_byte_index;


@@ -822,6 +818,7 @@ typedef struct lexeme_data_s {
     char *text;  /* points at lextexts array */
     int32 value;
     int type;    /* a *_TT value */
     char *text;  /* points at lextexts array */
     int32 value;
     int type;    /* a *_TT value */

+    int newsymbol; /* (for SYMBOL_TT) this token created the symbol */

     debug_location location;
     int lextext; /* index of text string in lextexts */
     int context; /* lexical context used to interpret this token */
     debug_location location;
     int lextext; /* index of text string in lextexts */
     int context; /* lexical context used to interpret this token */


@@ -1118,6 +1115,8 @@ typedef struct operator_s
 #define picture_table_zc 115
 #define print_unicode_zc 116
 #define check_unicode_zc 117
 #define picture_table_zc 115
 #define print_unicode_zc 116
 #define check_unicode_zc 117

+#define set_true_colour_zc 118
+#define buffer_screen_zc 119

 
 
 /* ------------------------------------------------------------------------- */
 
 
 /* ------------------------------------------------------------------------- */


@@ -1226,12 +1225,23 @@ typedef struct operator_s
 #define dstore_gm 3
 
 
 #define dstore_gm 3
 
 

-#define SYMBOL_TT    0                      /* value = index in symbol table */
-#define NUMBER_TT    1                      /* value = the number            */
-#define DQ_TT        2                      /* no value                      */
-#define SQ_TT        3                      /* no value                      */
-#define SEP_TT       4                      /* value = the _SEP code         */
-#define EOF_TT       5                      /* no value                      */
+#define SYMBOL_TT    0                      /* symbol.
+                                               value = index in symbol table */
+#define NUMBER_TT    1                      /* number (including hex, float,
+                                               etc).
+                                               value = the number            */
+#define DQ_TT        2                      /* double-quoted string.
+                                               no value; look at the text    */
+#define SQ_TT        3                      /* single-quoted string.
+                                               no value                      */
+#define UQ_TT        4                      /* unquoted string; only when
+                                               dont_enter_into_symbol_table
+                                               is true.
+                                               no value                      */
+#define SEP_TT       5                      /* separator (punctuation).
+                                               value = the _SEP code         */
+#define EOF_TT       6                      /* end of file.
+                                               no value                      */

 
 #define STATEMENT_TT      100               /* a statement keyword           */
 #define SEGMENT_MARKER_TT 101               /* with/has/class etc.           */
 
 #define STATEMENT_TT      100               /* a statement keyword           */
 #define SEGMENT_MARKER_TT 101               /* with/has/class etc.           */


@@ -1278,22 +1288,25 @@ typedef struct operator_s
 /*   Symbol flag definitions (in no significant order)                       */
 /* ------------------------------------------------------------------------- */
 
 /*   Symbol flag definitions (in no significant order)                       */
 /* ------------------------------------------------------------------------- */
 

-#define UNKNOWN_SFLAG  1
-#define REPLACE_SFLAG  2
-#define USED_SFLAG     4
-#define DEFCON_SFLAG   8
-#define STUB_SFLAG     16
-#define IMPORT_SFLAG   32
-#define EXPORT_SFLAG   64
-#define ALIASED_SFLAG  128
+#define UNKNOWN_SFLAG  1     /* no definition known */
+#define REPLACE_SFLAG  2     /* routine marked for Replace */
+#define USED_SFLAG     4     /* referred to in code */
+#define DEFCON_SFLAG   8     /* defined by Default */
+#define STUB_SFLAG     16    /* defined by Stub */
+#define UNHASHED_SFLAG 32    /* removed from hash chain */
+#define DISCARDED_SFLAG 64   /* removed and should never have been used */
+#define ALIASED_SFLAG  128   /* defined as property/attribute alias name */

 
 

-#define CHANGE_SFLAG   256
-#define SYSTEM_SFLAG   512
-#define INSF_SFLAG     1024
-#define UERROR_SFLAG   2048
-#define ACTION_SFLAG   4096
-#define REDEFINABLE_SFLAG  8192
-#define STAR_SFLAG    16384
+#define CHANGE_SFLAG   256   /* defined by Default with a value,
+                                or symbol has a backpatchable value */
+#define SYSTEM_SFLAG   512   /* created by compiler */
+#define INSF_SFLAG     1024  /* created in System_File */
+#define UERROR_SFLAG   2048  /* "No such constant" error issued */
+#define ACTION_SFLAG   4096  /* action name constant (Foo_A) */
+#define REDEFINABLE_SFLAG  8192  /* built-in symbol that can be redefined
+                                    by the user */
+#define STAR_SFLAG    16384  /* function defined with "*" or property named
+                                "foo_to" */

 
 /* ------------------------------------------------------------------------- */
 /*   Symbol type definitions                                                 */
 
 /* ------------------------------------------------------------------------- */
 /*   Symbol type definitions                                                 */


@@ -1920,7 +1933,9 @@ typedef struct operator_s
 #define OBJECT_MV             16     /* Ref to internal object number */
 #define STATIC_ARRAY_MV       17     /* Ref to internal static array address */
 
 #define OBJECT_MV             16     /* Ref to internal object number */
 #define STATIC_ARRAY_MV       17     /* Ref to internal static array address */
 

-#define LARGEST_BPATCH_MV     17     /* Larger marker values are never written
+#define ERROR_MV              18     /* An error was reported while
+                                        generating this value */
+#define LARGEST_BPATCH_MV     18     /* Larger marker values are never written

                                         to backpatch tables */
 
 /* Values 32-35 were used only for module import/export. */
                                         to backpatch tables */
 
 /* Values 32-35 were used only for module import/export. */


@@ -2142,7 +2157,7 @@ extern void assemble_label_no(int n);
 extern int assemble_forward_label_no(int n);
 extern void assemble_jump(int n);
 extern void define_symbol_label(int symbol);
 extern int assemble_forward_label_no(int n);
 extern void assemble_jump(int n);
 extern void define_symbol_label(int symbol);

-extern int32 assemble_routine_header(int no_locals, int debug_flag,
+extern int32 assemble_routine_header(int debug_flag,

     char *name, int embedded_flag, int the_symbol);
 extern void assemble_routine_end(int embedded_flag, debug_locations locations);
 
     char *name, int embedded_flag, int the_symbol);
 extern void assemble_routine_end(int embedded_flag, debug_locations locations);
 


@@ -2248,6 +2263,7 @@ extern int32 zcode_backpatch_size, staticarray_backpatch_size,
 extern int   backpatch_marker, backpatch_error_flag;
 
 extern char *describe_mv(int mval);
 extern int   backpatch_marker, backpatch_error_flag;
 
 extern char *describe_mv(int mval);

+extern char *describe_mv_short(int mval);

 
 extern int32 backpatch_value(int32 value);
 extern void  backpatch_zmachine_image_z(void);
 
 extern int32 backpatch_value(int32 value);
 extern void  backpatch_zmachine_image_z(void);


@@ -2290,7 +2306,7 @@ extern void  make_upper_case(char *str);
 
 extern brief_location routine_starts_line;
 
 
 extern brief_location routine_starts_line;
 

-extern int  no_routines, no_named_routines, no_locals, no_termcs;
+extern int  no_routines, no_named_routines, no_termcs;

 extern int  terminating_characters[];
 
 extern int  parse_given_directive(int internal_flag);
 extern int  terminating_characters[];
 
 extern int  parse_given_directive(int internal_flag);


@@ -2307,29 +2323,35 @@ extern int  no_errors, no_warnings, no_suppressed_warnings, no_compiler_errors;
 extern ErrorPosition ErrorReport;
 
 extern void fatalerror(char *s) NORETURN;
 extern ErrorPosition ErrorReport;
 
 extern void fatalerror(char *s) NORETURN;

+extern void fatalerror_fmt(const char *format, ...) NORETURN;

 extern void fatalerror_named(char *s1, char *s2) NORETURN;
 extern void fatalerror_named(char *s1, char *s2) NORETURN;

-extern void memory_out_error(int32 size, int32 howmany, char *name) NORETURN;
-extern void error_max_dynamic_strings(int index);
-extern void error_max_abbreviations(int index);
+extern void fatalerror_memory_out(int32 size, int32 howmany, char *name) NORETURN;
+

 extern void error(char *s);
 extern void error(char *s);

+extern void error_fmt(const char *format, ...);

 extern void error_named(char *s1, char *s2);
 extern void error_named(char *s1, char *s2);

-extern void error_numbered(char *s1, int val);

 extern void error_named_at(char *s1, char *s2, brief_location report_line);
 extern void ebf_error(char *s1, char *s2);
 extern void error_named_at(char *s1, char *s2, brief_location report_line);
 extern void ebf_error(char *s1, char *s2);

+extern void ebf_curtoken_error(char *s);

 extern void ebf_symbol_error(char *s1, char *name, char *type, brief_location report_line);
 extern void char_error(char *s, int ch);
 extern void unicode_char_error(char *s, int32 uni);
 extern void ebf_symbol_error(char *s1, char *name, char *type, brief_location report_line);
 extern void char_error(char *s, int ch);
 extern void unicode_char_error(char *s, int32 uni);

-extern void no_such_label(char *lname);
+extern void error_max_dynamic_strings(int index);
+extern void error_max_abbreviations(int index);
+

 extern void warning(char *s);
 extern void warning(char *s);

-extern void warning_numbered(char *s1, int val);
+extern void warning_fmt(const char *format, ...);

 extern void warning_named(char *s1, char *s2);
 extern void warning_named(char *s1, char *s2);

+extern void warning_at(char *name, brief_location report_line);

 extern void symtype_warning(char *context, char *name, char *type, char *wanttype);
 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 symtype_warning(char *context, char *name, char *type, char *wanttype);
 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 int  compiler_error(char *s);
 extern int  compiler_error_named(char *s1, char *s2);
 extern void print_sorry_message(void);
 extern int  compiler_error(char *s);
 extern int  compiler_error_named(char *s1, char *s2);
 extern void print_sorry_message(void);

+extern char *current_location_text(void);

 
 #ifdef ARC_THROWBACK
 extern int  throwback_switch;
 
 #ifdef ARC_THROWBACK
 extern int  throwback_switch;


@@ -2367,9 +2389,10 @@ extern int glulx_system_constant_list[];
 extern int32 value_of_system_constant(int t);
 extern char *name_of_system_constant(int t);
 extern void clear_expression_space(void);
 extern int32 value_of_system_constant(int t);
 extern char *name_of_system_constant(int t);
 extern void clear_expression_space(void);

-extern void show_tree(assembly_operand AO, int annotate);
+extern void show_tree(const assembly_operand *AO, int annotate);

 extern assembly_operand parse_expression(int context);
 extern int test_for_incdec(assembly_operand AO);
 extern assembly_operand parse_expression(int context);
 extern int test_for_incdec(assembly_operand AO);

+extern int  test_constant_op_list(const assembly_operand *AO, assembly_operand *ops_found, int max_ops_found);

 
 /* ------------------------------------------------------------------------- */
 /*   Extern definitions for "files"                                          */
 
 /* ------------------------------------------------------------------------- */
 /*   Extern definitions for "files"                                          */


@@ -2461,7 +2484,7 @@ extern int
 extern int oddeven_packing_switch;
 
 extern int glulx_mode, compression_switch;
 extern int oddeven_packing_switch;
 
 extern int glulx_mode, compression_switch;

-extern int32 requested_glulx_version;
+extern int32 requested_glulx_version, final_glulx_version;

 
 extern int error_format,    store_the_text,       asm_trace_setting,
     expr_trace_setting,     tokens_trace_setting,
 
 extern int error_format,    store_the_text,       asm_trace_setting,
     expr_trace_setting,     tokens_trace_setting,


@@ -2501,7 +2524,8 @@ extern int  total_source_line_count;
 extern int  dont_enter_into_symbol_table;
 extern int  return_sp_as_variable;
 extern int  next_token_begins_syntax_line;
 extern int  dont_enter_into_symbol_table;
 extern int  return_sp_as_variable;
 extern int  next_token_begins_syntax_line;

-extern identstruct *local_variable_names;
+extern int  no_locals;
+extern int *local_variable_name_offsets;

 
 extern int32 token_value;
 extern int   token_type;
 
 extern int32 token_value;
 extern int   token_type;


@@ -2514,10 +2538,15 @@ extern void discard_token_location(debug_location_beginning beginning);
 extern debug_locations get_token_location_end(debug_location_beginning beginning);
 
 extern void describe_token_triple(const char *text, int32 value, int type);
 extern debug_locations get_token_location_end(debug_location_beginning beginning);
 
 extern void describe_token_triple(const char *text, int32 value, int type);

+#define describe_current_token() describe_token_triple(token_text, token_value, token_type)

 /* The describe_token() macro works on both token_data and lexeme_data structs. */
 #define describe_token(t) describe_token_triple((t)->text, (t)->value, (t)->type)
 
 extern void construct_local_variable_tables(void);
 /* The describe_token() macro works on both token_data and lexeme_data structs. */
 #define describe_token(t) describe_token_triple((t)->text, (t)->value, (t)->type)
 
 extern void construct_local_variable_tables(void);

+extern void clear_local_variables(void);
+extern void add_local_variable(char *name);
+extern char *get_local_variable_name(int index);
+

 extern void declare_systemfile(void);
 extern int  is_systemfile(void);
 extern void report_errors_at_current_line(void);
 extern void declare_systemfile(void);
 extern int  is_systemfile(void);
 extern void report_errors_at_current_line(void);


@@ -2555,9 +2584,12 @@ extern int MAX_LOCAL_VARIABLES;
 extern int DICT_WORD_SIZE, DICT_CHAR_SIZE, DICT_WORD_BYTES;
 extern int ZCODE_HEADER_EXT_WORDS, ZCODE_HEADER_FLAGS_3;
 extern int ZCODE_LESS_DICT_DATA;
 extern int DICT_WORD_SIZE, DICT_CHAR_SIZE, DICT_WORD_BYTES;
 extern int ZCODE_HEADER_EXT_WORDS, ZCODE_HEADER_FLAGS_3;
 extern int ZCODE_LESS_DICT_DATA;

+extern int ZCODE_MAX_INLINE_STRING;

 extern int NUM_ATTR_BYTES, GLULX_OBJECT_EXT_BYTES;
 extern int WARN_UNUSED_ROUTINES, OMIT_UNUSED_ROUTINES;
 extern int STRIP_UNREACHABLE_LABELS;
 extern int NUM_ATTR_BYTES, GLULX_OBJECT_EXT_BYTES;
 extern int WARN_UNUSED_ROUTINES, OMIT_UNUSED_ROUTINES;
 extern int STRIP_UNREACHABLE_LABELS;

+extern int OMIT_SYMBOL_TABLE;
+extern int LONG_DICT_FLAG_BUG;

 extern int TRANSCRIPT_FORMAT;
 
 /* These macros define offsets that depend on the value of NUM_ATTR_BYTES.
 extern int TRANSCRIPT_FORMAT;
 
 /* These macros define offsets that depend on the value of NUM_ATTR_BYTES.


@@ -2640,8 +2672,8 @@ extern char *typename(int type);
 extern int hash_code_from_string(char *p);
 extern int strcmpcis(char *p, char *q);
 extern int get_symbol_index(char *p);
 extern int hash_code_from_string(char *p);
 extern int strcmpcis(char *p, char *q);
 extern int get_symbol_index(char *p);

-extern int symbol_index(char *lexeme_text, int hashcode);
-extern void end_symbol_scope(int k);
+extern int symbol_index(char *lexeme_text, int hashcode, int *created);
+extern void end_symbol_scope(int k, int neveruse);

 extern void describe_symbol(int k);
 extern void list_symbols(int level);
 extern void assign_marked_symbol(int index, int marker, int32 value, int type);
 extern void describe_symbol(int k);
 extern void list_symbols(int level);
 extern void assign_marked_symbol(int index, int marker, int32 value, int type);


@@ -2684,6 +2716,7 @@ extern void  parse_code_block(int break_label, int continue_label,
 
 extern void  match_close_bracket(void);
 extern void  parse_statement(int break_label, int continue_label);
 
 extern void  match_close_bracket(void);
 extern void  parse_statement(int break_label, int continue_label);

+extern void  parse_statement_singleexpr(assembly_operand AO);

 extern int   parse_label(void);
 
 /* ------------------------------------------------------------------------- */
 extern int   parse_label(void);
 
 /* ------------------------------------------------------------------------- */


@@ -2728,7 +2761,6 @@ extern int32 low_strings_top;
 
 extern int   no_abbreviations;
 extern int   abbrevs_lookup_table_made, is_abbreviation;
 
 extern int   no_abbreviations;
 extern int   abbrevs_lookup_table_made, is_abbreviation;

-extern uchar *abbreviations_at;

 extern abbreviation *abbreviations;
 
 extern int32 total_chars_trans, total_bytes_trans,
 extern abbreviation *abbreviations;
 
 extern int32 total_chars_trans, total_bytes_trans,


@@ -2796,6 +2828,7 @@ extern int32 compile_string(char *b, int strctx);
 extern int32 translate_text(int32 p_limit, char *s_text, int strctx);
 extern void  optimise_abbreviations(void);
 extern void  make_abbreviation(char *text);
 extern int32 translate_text(int32 p_limit, char *s_text, int strctx);
 extern void  optimise_abbreviations(void);
 extern void  make_abbreviation(char *text);

+extern char *abbreviation_text(int num);

 extern void  show_dictionary(int level);
 extern void  word_to_ascii(uchar *p, char *result);
 extern void  print_dict_word(int node);
 extern void  show_dictionary(int level);
 extern void  word_to_ascii(uchar *p, char *result);
 extern void  print_dict_word(int node);


@@ -2838,6 +2871,7 @@ extern int32 *grammar_token_routine,
 extern void find_the_actions(void);
 extern void make_fake_action(void);
 extern assembly_operand action_of_name(char *name);
 extern void find_the_actions(void);
 extern void make_fake_action(void);
 extern assembly_operand action_of_name(char *name);

+extern void locate_dead_grammar_lines(void);

 extern void make_verb(void);
 extern void extend_verb(void);
 extern void list_verb_table(void);
 extern void make_verb(void);
 extern void extend_verb(void);
 extern void list_verb_table(void);

diff --git a/src/inform.c b/src/inform.c
index 1890d58e2acdb72eca10ca4ae3ef9341b5251a63..25da037e5b535b985a188d2365fa44e5509815d8 100644 (file)
--- a/src/inform.c
+++ b/src/inform.c
@@ -2,8 +2,8 @@
 /*   "inform" :  The top level of Inform: switches, pathnames, filenaming    */
 /*               conventions, ICL (Inform Command Line) files, main          */
 /*                                                                           */
 /*   "inform" :  The top level of Inform: switches, pathnames, filenaming    */
 /*               conventions, ICL (Inform Command Line) files, main          */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -47,7 +47,9 @@ int version_number,      /* 3 to 8 (Z-code)                                  */
 int32 scale_factor,      /* packed address multiplier                        */
     length_scale_factor; /* length-in-header multiplier                      */
 
 int32 scale_factor,      /* packed address multiplier                        */
     length_scale_factor; /* length-in-header multiplier                      */
 

-int32 requested_glulx_version;
+int32 requested_glulx_version; /* version requested via -v switch            */
+int32 final_glulx_version;     /* requested version combined with game
+                                  feature requirements                       */

 
 extern void select_version(int vn)
 {   version_number = vn;
 
 extern void select_version(int vn)
 {   version_number = vn;


@@ -154,17 +156,17 @@ static void select_target(int targ)
 
     if (INDIV_PROP_START < 256) {
         INDIV_PROP_START = 256;
 
     if (INDIV_PROP_START < 256) {
         INDIV_PROP_START = 256;

-        warning_numbered("INDIV_PROP_START should be at least 256 in Glulx. Setting to", INDIV_PROP_START);
+        warning_fmt("INDIV_PROP_START should be at least 256 in Glulx; setting to %d", INDIV_PROP_START);

     }
 
     if (NUM_ATTR_BYTES % 4 != 3) {
       NUM_ATTR_BYTES += (3 - (NUM_ATTR_BYTES % 4)); 
     }
 
     if (NUM_ATTR_BYTES % 4 != 3) {
       NUM_ATTR_BYTES += (3 - (NUM_ATTR_BYTES % 4)); 

-      warning_numbered("NUM_ATTR_BYTES must be a multiple of four, plus three. Increasing to", NUM_ATTR_BYTES);
+      warning_fmt("NUM_ATTR_BYTES must be a multiple of four, plus three; increasing to %d", NUM_ATTR_BYTES);

     }
 
     if (DICT_CHAR_SIZE != 1 && DICT_CHAR_SIZE != 4) {
       DICT_CHAR_SIZE = 4;
     }
 
     if (DICT_CHAR_SIZE != 1 && DICT_CHAR_SIZE != 4) {
       DICT_CHAR_SIZE = 4;

-      warning_numbered("DICT_CHAR_SIZE must be either 1 or 4. Setting to", DICT_CHAR_SIZE);
+      warning_fmt("DICT_CHAR_SIZE must be either 1 or 4; setting to %d", DICT_CHAR_SIZE);

     }
   }
 
     }
   }
 


@@ -173,17 +175,10 @@ static void select_target(int targ)
     MAX_LOCAL_VARIABLES = MAX_KEYWORD_GROUP_SIZE;
   }
 
     MAX_LOCAL_VARIABLES = MAX_KEYWORD_GROUP_SIZE;
   }
 

-  if (DICT_WORD_SIZE > MAX_DICT_WORD_SIZE) {
-    DICT_WORD_SIZE = MAX_DICT_WORD_SIZE;
-    warning_numbered(
-      "DICT_WORD_SIZE cannot exceed MAX_DICT_WORD_SIZE; resetting", 
-      MAX_DICT_WORD_SIZE);
-    /* MAX_DICT_WORD_SIZE can be increased in header.h without fear. */
-  }

   if (NUM_ATTR_BYTES > MAX_NUM_ATTR_BYTES) {
     NUM_ATTR_BYTES = MAX_NUM_ATTR_BYTES;
   if (NUM_ATTR_BYTES > MAX_NUM_ATTR_BYTES) {
     NUM_ATTR_BYTES = MAX_NUM_ATTR_BYTES;

-    warning_numbered(
-      "NUM_ATTR_BYTES cannot exceed MAX_NUM_ATTR_BYTES; resetting",
+    warning_fmt(
+      "NUM_ATTR_BYTES cannot exceed MAX_NUM_ATTR_BYTES; resetting to %d",

       MAX_NUM_ATTR_BYTES);
     /* MAX_NUM_ATTR_BYTES can be increased in header.h without fear. */
   }
       MAX_NUM_ATTR_BYTES);
     /* MAX_NUM_ATTR_BYTES can be increased in header.h without fear. */
   }


@@ -354,6 +349,7 @@ static void reset_switch_settings(void)
     compression_switch = TRUE;
     glulx_mode = FALSE;
     requested_glulx_version = 0;
     compression_switch = TRUE;
     glulx_mode = FALSE;
     requested_glulx_version = 0;

+    final_glulx_version = 0;

 
     /* These aren't switches, but for clarity we reset them too. */
     asm_trace_level = 0;
 
     /* These aren't switches, but for clarity we reset them too. */
     asm_trace_level = 0;


@@ -1041,6 +1037,7 @@ static void run_pass(void)
     sort_dictionary();
     if (track_unused_routines)
         locate_dead_functions();
     sort_dictionary();
     if (track_unused_routines)
         locate_dead_functions();

+    locate_dead_grammar_lines();

     construct_storyfile();
 }
 
     construct_storyfile();
 }
 


@@ -1128,14 +1125,14 @@ disabling -X switch\n");
 
     run_pass();
 
 
     run_pass();
 

+    if (no_errors==0) { output_file(); output_has_occurred = TRUE; }
+    else { output_has_occurred = FALSE; }
+

     if (transcript_switch)
     {   write_dictionary_to_transcript();
         close_transcript_file();
     }
 
     if (transcript_switch)
     {   write_dictionary_to_transcript();
         close_transcript_file();
     }
 

-    if (no_errors==0) { output_file(); output_has_occurred = TRUE; }
-    else { output_has_occurred = FALSE; }
-

     if (debugfile_switch)
     {   end_debug_file();
     }
     if (debugfile_switch)
     {   end_debug_file();
     }


@@ -1169,7 +1166,7 @@ static void cli_print_help(int help_level)
     printf(
 "\nThis program is a compiler of Infocom format (also called \"Z-machine\")\n\
 story files, as well as \"Glulx\" story files:\n\
     printf(
 "\nThis program is a compiler of Infocom format (also called \"Z-machine\")\n\
 story files, as well as \"Glulx\" story files:\n\

-Copyright (c) Graham Nelson 1993 - 2022.\n\n");
+Copyright (c) Graham Nelson 1993 - 2024.\n\n");

 
    /* For people typing just "inform", a summary only: */
 
 
    /* For people typing just "inform", a summary only: */
 


@@ -1539,6 +1536,16 @@ static int strcpyupper(char *to, char *from, int max)
 static void execute_icl_command(char *p);
 static int execute_dashdash_command(char *p, char *p2);
 
 static void execute_icl_command(char *p);
 static int execute_dashdash_command(char *p, char *p2);
 

+/* Open a file and see whether the initial lines match the "!% ..." format
+   used for ICL commands. Stop when we reach a line that doesn't.
+   
+   This does not do line break conversion. It just reads to the next
+   \n (and ignores \r as whitespace). Therefore it will work on Unix and
+   DOS source files, but fail to cope with Mac-Classic (\r) source files.
+   I am not going to worry about this, because files from the Mac-Classic
+   era shouldn't have "!%" lines; that convention was invented well after
+   Mac switched over to \n format.
+ */

 static int execute_icl_header(char *argname)
 {
   FILE *command_file;
 static int execute_icl_header(char *argname)
 {
   FILE *command_file;


@@ -1551,7 +1558,7 @@ static int execute_icl_header(char *argname)
 
   do
     {   x = translate_in_filename(x, filename, argname, 0, 1);
 
   do
     {   x = translate_in_filename(x, filename, argname, 0, 1);

-        command_file = fopen(filename,"r");
+        command_file = fopen(filename,"rb");

     } while ((command_file == NULL) && (x != 0));
   if (!command_file) {
     /* Fail silently. The regular compiler will try to open the file
     } while ((command_file == NULL) && (x != 0));
   if (!command_file) {
     /* Fail silently. The regular compiler will try to open the file

diff --git a/src/lexer.c b/src/lexer.c
index 63cafbcd4a41747c9197193b8b84ab5c38d3ab04..1843b0aee63e2cbcc07a4a144c757085e7ad4356 100644 (file)
--- a/src/lexer.c
+++ b/src/lexer.c
@@ -1,8 +1,8 @@
 /* ------------------------------------------------------------------------- */
 /*   "lexer" : Lexical analyser                                              */
 /*                                                                           */
 /* ------------------------------------------------------------------------- */
 /*   "lexer" : Lexical analyser                                              */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -29,10 +29,9 @@ int total_source_line_count,            /* Number of source lines so far     */
                                            (generally as a result of an error
                                            message or the start of pass)     */
     dont_enter_into_symbol_table,       /* Return names as text (with
                                            (generally as a result of an error
                                            message or the start of pass)     */
     dont_enter_into_symbol_table,       /* Return names as text (with

-                                           token type DQ_TT, i.e., as if
-                                           they had double-quotes around)
-                                           and not as entries in the symbol
-                                           table, when TRUE. If -2, only the
+                                           token type UQ_TT) and not as
+                                           entries in the symbol table,
+                                           when TRUE. If -2, only the

                                            keyword table is searched.        */
     return_sp_as_variable;              /* When TRUE, the word "sp" denotes
                                            the stack pointer variable
                                            keyword table is searched.        */
     return_sp_as_variable;              /* When TRUE, the word "sp" denotes
                                            the stack pointer variable


@@ -269,8 +268,7 @@ static lexeme_data circle[CIRCLE_SIZE];
 
 typedef struct lextext_s {
     char *text;
 
 typedef struct lextext_s {
     char *text;

-    size_t size; /* Allocated size (including terminal null)
-                    This is always at least MAX_IDENTIFIER_LENGTH+1         */
+    size_t size; /* Allocated size (including terminal null)                 */

 } lextext;
 
 static lextext *lextexts; /* Allocated to no_lextexts */
 } lextext;
 
 static lextext *lextexts; /* Allocated to no_lextexts */


@@ -286,12 +284,19 @@ static int lex_pos;         /* Current write position in that lextext        */
 /* ------------------------------------------------------------------------- */
 /*   The lexer itself needs up to 3 characters of lookahead (it uses an      */
 /*   LR(3) grammar to translate characters into tokens).                     */
 /* ------------------------------------------------------------------------- */
 /*   The lexer itself needs up to 3 characters of lookahead (it uses an      */
 /*   LR(3) grammar to translate characters into tokens).                     */

+/*                                                                           */
+/*   Past the end of the stream, we fill in zeros. This has the awkward      */
+/*   side effect that a zero byte in a source file will silently terminate   */
+/*   it, rather than producing an "illegal source character" error.          */
+/*   On the up side, we can compile veneer routines (which are null-         */
+/*   terminated strings) with no extra work.                                 */

 /* ------------------------------------------------------------------------- */
 
 #define LOOKAHEAD_SIZE 3
 
 static int current, lookahead,          /* The latest character read, and    */
     lookahead2, lookahead3;             /* the three characters following it */
 /* ------------------------------------------------------------------------- */
 
 #define LOOKAHEAD_SIZE 3
 
 static int current, lookahead,          /* The latest character read, and    */
     lookahead2, lookahead3;             /* the three characters following it */

+                                        /* (zero means end-of-stream)        */

 
 static int pipeline_made;               /* Whether or not the pipeline of
                                            characters has been constructed
 
 static int pipeline_made;               /* Whether or not the pipeline of
                                            characters has been constructed


@@ -337,6 +342,8 @@ extern void describe_token_triple(const char *text, int32 value, int type)
                                  break;
         case SQ_TT:              printf("string '%s'", text);
                                  break;
                                  break;
         case SQ_TT:              printf("string '%s'", text);
                                  break;

+        case UQ_TT:              printf("barestring %s", text);
+                                 break;

         case SEP_TT:             printf("separator '%s'", text);
                                  break;
         case EOF_TT:             printf("end of file");
         case SEP_TT:             printf("separator '%s'", text);
                                  break;
         case EOF_TT:             printf("end of file");


@@ -440,6 +447,7 @@ static char *opcode_list_z[] = {
     "get_wind_prop", "scroll_window", "pop_stack", "read_mouse",
     "mouse_window", "push_stack", "put_wind_prop", "print_form",
     "make_menu", "picture_table", "print_unicode", "check_unicode",
     "get_wind_prop", "scroll_window", "pop_stack", "read_mouse",
     "mouse_window", "push_stack", "put_wind_prop", "print_form",
     "make_menu", "picture_table", "print_unicode", "check_unicode",

+    "set_true_colour", "buffer_screen",

     ""
 };
 
     ""
 };
 


@@ -605,11 +613,8 @@ static int lexical_context(void)
         always translate to the same output tokens whenever the context
         is the same.
 
         always translate to the same output tokens whenever the context
         is the same.
 

-        In fact, for efficiency reasons this number omits the bit of
-        information held in the variable "dont_enter_into_symbol_table".
-        Inform never needs to backtrack through tokens parsed in that
-        way (thankfully, as it would be expensive indeed to check
-        the tokens).                                                         */
+        (For many years, the "dont_enter_into_symbol_table" variable
+        was omitted from this number. But now we can include it.)            */

 
     int c = 0;
     if (opcode_names.enabled)         c |= 1;
 
     int c = 0;
     if (opcode_names.enabled)         c |= 1;


@@ -625,11 +630,17 @@ static int lexical_context(void)
     if (local_variables.enabled)      c |= 1024;
 
     if (return_sp_as_variable)        c |= 2048;
     if (local_variables.enabled)      c |= 1024;
 
     if (return_sp_as_variable)        c |= 2048;

+    if (dont_enter_into_symbol_table) c |= 4096;
+    

     return(c);
 }
 
 static void print_context(int c)
 {
     return(c);
 }
 
 static void print_context(int c)
 {

+    if (c < 0) {
+        printf("??? ");
+        return;
+    }

     if ((c & 1) != 0) printf("OPC ");
     if ((c & 2) != 0) printf("DIR ");
     if ((c & 4) != 0) printf("TK ");
     if ((c & 1) != 0) printf("OPC ");
     if ((c & 2) != 0) printf("DIR ");
     if ((c & 4) != 0) printf("TK ");


@@ -642,6 +653,7 @@ static void print_context(int c)
     if ((c & 512) != 0) printf("SCON ");
     if ((c & 1024) != 0) printf("LV ");
     if ((c & 2048) != 0) printf("sp ");
     if ((c & 512) != 0) printf("SCON ");
     if ((c & 1024) != 0) printf("LV ");
     if ((c & 2048) != 0) printf("sp ");

+    if ((c & 4096) != 0) printf("dontent ");

 }
 
 static int *keywords_hash_table;
 }
 
 static int *keywords_hash_table;


@@ -657,14 +669,22 @@ static int *local_variable_hash_codes;
    119 for Glulx.
 */
 
    119 for Glulx.
 */
 

+/* The number of local variables in the current routine. */
+int no_locals;
+

 /* Names of local variables in the current routine.
 /* Names of local variables in the current routine.

+   The values are positions in local_variable_names_memlist.

    This is allocated to MAX_LOCAL_VARIABLES-1. (The stack pointer "local"
    is not included in this array.)
 
    (This could be a memlist, growing as needed up to MAX_LOCAL_VARIABLES-1.
    But right now we just allocate the max.)
  */
    This is allocated to MAX_LOCAL_VARIABLES-1. (The stack pointer "local"
    is not included in this array.)
 
    (This could be a memlist, growing as needed up to MAX_LOCAL_VARIABLES-1.
    But right now we just allocate the max.)
  */

-identstruct *local_variable_names;
+int *local_variable_name_offsets;
+
+static memory_list local_variable_names_memlist;
+/* How much of local_variable_names_memlist is used by the no_local locals. */
+static int local_variable_names_usage;

 
 static char one_letter_locals[128];
 
 
 static char one_letter_locals[128];
 


@@ -729,9 +749,42 @@ static void make_keywords_tables(void)
     }
 }
 
     }
 }
 

+extern void clear_local_variables(void)
+{
+    no_locals = 0;
+    local_variable_names_usage = 0;
+}
+
+extern void add_local_variable(char *name)
+{
+    int len;
+
+    if (no_locals >= MAX_LOCAL_VARIABLES-1) {
+        /* This should have been caught before we got here */
+        error("too many local variables");
+        return;
+    }
+    
+    len = strlen(name)+1;
+    ensure_memory_list_available(&local_variable_names_memlist, local_variable_names_usage + len);
+    local_variable_name_offsets[no_locals++] = local_variable_names_usage;
+    strcpy((char *)local_variable_names_memlist.data+local_variable_names_usage, name);
+    local_variable_names_usage += len;
+}
+
+extern char *get_local_variable_name(int index)
+{
+    if (index < 0 || index >= no_locals)
+        return "???";   /* shouldn't happen */
+
+    return (char *)local_variable_names_memlist.data + local_variable_name_offsets[index];
+}
+

 /* Look at the strings stored in local_variable_names (from 0 to no_locals).
    Set local_variables.keywords to point to these, and also prepare the
 /* Look at the strings stored in local_variable_names (from 0 to no_locals).
    Set local_variables.keywords to point to these, and also prepare the

-   hash tables. */
+   hash tables.
+   This must be called after add_local_variable(), but before we start
+   compiling function code. */

 extern void construct_local_variable_tables(void)
 {   int i, h;
     for (i=0; i<HASH_TAB_SIZE; i++) local_variable_hash_table[i] = -1;
 extern void construct_local_variable_tables(void)
 {   int i, h;
     for (i=0; i<HASH_TAB_SIZE; i++) local_variable_hash_table[i] = -1;


@@ -739,7 +792,7 @@ extern void construct_local_variable_tables(void)
 
     for (i=0; i<no_locals; i++)
     {
 
     for (i=0; i<no_locals; i++)
     {

-        char *p = local_variable_names[i].text;
+        char *p = (char *)local_variable_names_memlist.data + local_variable_name_offsets[i];

         local_variables.keywords[i] = p;
         if (p[1] == 0)
         {   one_letter_locals[(uchar)p[0]] = i;
         local_variables.keywords[i] = p;
         if (p[1] == 0)
         {   one_letter_locals[(uchar)p[0]] = i;


@@ -758,16 +811,49 @@ extern void construct_local_variable_tables(void)
     }
 }
 
     }
 }
 

-static void interpret_identifier(char *p, int pos, int dirs_only_flag)
+static void interpret_identifier(char *p, int pos)

 {   int index, hashcode;
 
     /*  An identifier is either a keyword or a "symbol", a name which the
         lexical analyser leaves to higher levels of Inform to understand.    */
 
 {   int index, hashcode;
 
     /*  An identifier is either a keyword or a "symbol", a name which the
         lexical analyser leaves to higher levels of Inform to understand.    */
 

+    circle[pos].newsymbol = FALSE;
+    

     hashcode = hash_code_from_string(p);
 
     hashcode = hash_code_from_string(p);
 

-    if (dirs_only_flag) goto KeywordSearch;
+    /*  If dont_enter_into_symbol_table is true, we skip all keywords
+        (and variables) and just mark the name as an unquoted string.
+        Except that if dont_enter_into_symbol_table is -2, we recognize
+        directive keywords (only).
+    */

 
 

+    if (dont_enter_into_symbol_table) {
+
+        if (dont_enter_into_symbol_table == -2) {
+            /* This is a simplified version of the keyword-checking loop
+               below. */
+            index = keywords_hash_table[hashcode];
+            while (index >= 0)
+            {   int *i = keywords_data_table + 3*index;
+                keyword_group *kg = keyword_groups[*i];
+                if (kg == &directives)
+                {   char *q = kg->keywords[*(i+1)];
+                    if (((kg->case_sensitive) && (strcmp(p, q)==0))
+                        || ((!(kg->case_sensitive)) && (strcmpcis(p, q)==0)))
+                    {   circle[pos].type = kg->change_token_type;
+                        circle[pos].value = *(i+1);
+                        return;
+                    }
+                }
+                index = *(i+2);
+            }
+        }
+        
+        circle[pos].type = UQ_TT;
+        circle[pos].value = 0;
+        return;
+    }
+    

     /*  If this is assembly language, perhaps it is "sp"?                    */
 
     if (return_sp_as_variable && (p[0]=='s') && (p[1]=='p') && (p[2]==0))
     /*  If this is assembly language, perhaps it is "sp"?                    */
 
     if (return_sp_as_variable && (p[0]=='s') && (p[1]=='p') && (p[2]==0))


@@ -790,7 +876,9 @@ static void interpret_identifier(char *p, int pos, int dirs_only_flag)
         if (index >= 0)
         {   for (;index<no_locals;index++)
             {   if (hashcode == local_variable_hash_codes[index])
         if (index >= 0)
         {   for (;index<no_locals;index++)
             {   if (hashcode == local_variable_hash_codes[index])

-                {   if (strcmpcis(p, local_variable_names[index].text)==0)
+                {
+                    char *locname = (char *)local_variable_names_memlist.data + local_variable_name_offsets[index];
+                    if (strcmpcis(p, locname)==0)

                     {   circle[pos].type = LOCAL_VARIABLE_TT;
                         circle[pos].value = index+1;
                         return;
                     {   circle[pos].type = LOCAL_VARIABLE_TT;
                         circle[pos].value = index+1;
                         return;


@@ -803,13 +891,11 @@ static void interpret_identifier(char *p, int pos, int dirs_only_flag)
     /*  Now the bulk of the keywords.  Note that the lexer doesn't recognise
         the name of a system function which has been Replaced.               */
 
     /*  Now the bulk of the keywords.  Note that the lexer doesn't recognise
         the name of a system function which has been Replaced.               */
 

-    KeywordSearch:

     index = keywords_hash_table[hashcode];
     while (index >= 0)
     {   int *i = keywords_data_table + 3*index;
         keyword_group *kg = keyword_groups[*i];
     index = keywords_hash_table[hashcode];
     while (index >= 0)
     {   int *i = keywords_data_table + 3*index;
         keyword_group *kg = keyword_groups[*i];

-        if (((!dirs_only_flag) && (kg->enabled))
-            || (dirs_only_flag && (kg == &directives)))
+        if (kg->enabled)

         {   char *q = kg->keywords[*(i+1)];
             if (((kg->case_sensitive) && (strcmp(p, q)==0))
                 || ((!(kg->case_sensitive)) && (strcmpcis(p, q)==0)))
         {   char *q = kg->keywords[*(i+1)];
             if (((kg->case_sensitive) && (strcmp(p, q)==0))
                 || ((!(kg->case_sensitive)) && (strcmpcis(p, q)==0)))


@@ -824,11 +910,9 @@ static void interpret_identifier(char *p, int pos, int dirs_only_flag)
         index = *(i+2);
     }
 
         index = *(i+2);
     }
 

-    if (dirs_only_flag) return;
-

     /*  Search for the name; create it if necessary.                         */
 
     /*  Search for the name; create it if necessary.                         */
 

-    circle[pos].value = symbol_index(p, hashcode);
+    circle[pos].value = symbol_index(p, hashcode, &circle[pos].newsymbol);

     circle[pos].type = SYMBOL_TT;
 }
 
     circle[pos].type = SYMBOL_TT;
 }
 


@@ -901,6 +985,7 @@ static void make_tokeniser_grid(void)
     tokeniser_grid[0]    = EOF_CODE;
     tokeniser_grid[' ']  = WHITESPACE_CODE;
     tokeniser_grid['\n'] = WHITESPACE_CODE;
     tokeniser_grid[0]    = EOF_CODE;
     tokeniser_grid[' ']  = WHITESPACE_CODE;
     tokeniser_grid['\n'] = WHITESPACE_CODE;

+    tokeniser_grid['\r'] = WHITESPACE_CODE;

     tokeniser_grid['$']  = RADIX_CODE;
     tokeniser_grid['!']  = COMMENT_CODE;
 
     tokeniser_grid['$']  = RADIX_CODE;
     tokeniser_grid['!']  = COMMENT_CODE;
 


@@ -1378,7 +1463,7 @@ static int32 construct_double(int wanthigh, int signbit, double intv, double fra
 /*                                                                           */
 /*   Note that file_load_chars(p, size) loads "size" bytes into buffer "p"   */
 /*   from the current input file.  If the file runs out, then if it was      */
 /*                                                                           */
 /*   Note that file_load_chars(p, size) loads "size" bytes into buffer "p"   */
 /*   from the current input file.  If the file runs out, then if it was      */

-/*   the last source file 4 EOF characters are placed in the buffer: if it   */
+/*   the last source file 4 null characters are placed in the buffer: if it  */

 /*   was only an Include file ending, then a '\n' character is placed there  */
 /*   (essentially to force termination of any comment line) followed by      */
 /*   three harmless spaces.                                                  */
 /*   was only an Include file ending, then a '\n' character is placed there  */
 /*   (essentially to force termination of any comment line) followed by      */
 /*   three harmless spaces.                                                  */


@@ -1541,12 +1626,33 @@ static int get_next_char_from_pipeline(void)
     CurrentLB->chars_read++;
     if (forerrors_pointer < FORERRORS_SIZE-1)
         forerrors_buff[forerrors_pointer++] = current;
     CurrentLB->chars_read++;
     if (forerrors_pointer < FORERRORS_SIZE-1)
         forerrors_buff[forerrors_pointer++] = current;

-    if (current == '\n') reached_new_line();
+
+    /* The file is open in binary mode, so we have to do our own newline
+       conversion. (We want to do it consistently across all platforms.)
+
+       The strategy is to convert all \r (CR) characters to \n (LF), but
+       *don't* advance the line counter for \r if it's followed by \n.
+       The rest of the lexer treats multiple \n characters the same as
+       one, so the simple conversion will work out okay.
+
+       (Note that, for historical reasons, a ctrl-L (formfeed) is also
+       treated as \r. This conversion has already been handled by
+       source_to_iso_grid[].)
+    */
+    if (current == '\n') {
+        reached_new_line();
+    }
+    else if (current == '\r') {
+        current = '\n';
+        if (lookahead != '\n')
+            reached_new_line();
+    }
+    

     return(current);
 }
 
 /* ------------------------------------------------------------------------- */
     return(current);
 }
 
 /* ------------------------------------------------------------------------- */

-/*   Source 2: from a string                                                 */
+/*   Source 2: from a (null-terminated) string                               */

 /* ------------------------------------------------------------------------- */
 
 static int source_to_analyse_pointer;            /*  Current read position   */
 /* ------------------------------------------------------------------------- */
 
 static int source_to_analyse_pointer;            /*  Current read position   */


@@ -1565,7 +1671,12 @@ static int get_next_char_from_string(void)
     CurrentLB->chars_read++;
     if (forerrors_pointer < FORERRORS_SIZE-1)
         forerrors_buff[forerrors_pointer++] = current;
     CurrentLB->chars_read++;
     if (forerrors_pointer < FORERRORS_SIZE-1)
         forerrors_buff[forerrors_pointer++] = current;

+
+    /* We shouldn't have \r when compiling from string (veneer function).
+       If we do, just shove it under the carpet. */
+    if (current == '\r') current = '\n';

     if (current == '\n') reached_new_line();
     if (current == '\n') reached_new_line();

+    

     return(current);
 }
 
     return(current);
 }
 


@@ -1586,7 +1697,8 @@ static int get_next_char_from_string(void)
 /*                                                                           */
 /*       restart_lexer(source, name) if source is NULL, initialise the lexer */
 /*                                       to read from source files;          */
 /*                                                                           */
 /*       restart_lexer(source, name) if source is NULL, initialise the lexer */
 /*                                       to read from source files;          */

-/*                                   otherwise, to read from this string.    */
+/*                                       otherwise, to read from this null-  */
+/*                                       terminated string.                  */

 /* ------------------------------------------------------------------------- */
 
 extern void release_token_texts(void)
 /* ------------------------------------------------------------------------- */
 
 extern void release_token_texts(void)


@@ -1632,11 +1744,28 @@ extern void release_token_texts(void)
 extern void put_token_back(void)
 {   tokens_put_back++;
 
 extern void put_token_back(void)
 {   tokens_put_back++;
 

+    int pos = circle_position - tokens_put_back + 1;
+    if (pos<0) pos += CIRCLE_SIZE;
+

     if (tokens_trace_level > 0)
     if (tokens_trace_level > 0)

-    {   if (tokens_trace_level == 1) printf("<- ");
-        else printf("<-\n");
+    {
+        printf("<- ");
+        if (tokens_trace_level > 1) {
+            describe_token(&circle[pos]);
+            printf("\n");
+        }

     }
 
     }
 

+    if (circle[pos].type == SYMBOL_TT && circle[pos].newsymbol) {
+        /* Remove the symbol from the symbol table. (Or mark it as unreachable
+           anyhow.) */
+        end_symbol_scope(circle[pos].value, TRUE);
+        /* Remove new-symbol flag, and force reinterpretation next time
+           we see the symbol. */
+        circle[pos].newsymbol = FALSE;
+        circle[pos].context = -1;
+    }
+    

     /*  The following error, of course, should never happen!                 */
 
     if (tokens_put_back == CIRCLE_SIZE)
     /*  The following error, of course, should never happen!                 */
 
     if (tokens_put_back == CIRCLE_SIZE)


@@ -1695,7 +1824,9 @@ static void lexadds(char *str)
 }
 
 extern void get_next_token(void)
 }
 
 extern void get_next_token(void)

-{   int d, i, j, k, quoted_size, e, radix, context; int32 n; char *r;
+{   int d, i, j, k, quoted_size, e, radix, context;
+    uint32 n;
+    char *r;

     int floatend;
     int returning_a_put_back_token = TRUE;
     
     int floatend;
     int returning_a_put_back_token = TRUE;
     


@@ -1708,7 +1839,7 @@ extern void get_next_token(void)
         if (context != circle[i].context)
         {   j = circle[i].type;
             if ((j==0) || ((j>=100) && (j<200)))
         if (context != circle[i].context)
         {   j = circle[i].type;
             if ((j==0) || ((j>=100) && (j<200)))

-                interpret_identifier(circle[i].text, i, FALSE);
+                interpret_identifier(circle[i].text, i);

             circle[i].context = context;
         }
         goto ReturnBack;
             circle[i].context = context;
         }
         goto ReturnBack;


@@ -1723,7 +1854,7 @@ extern void get_next_token(void)
         /* fresh lextext block; must init it */
         no_lextexts = lex_index+1;
         ensure_memory_list_available(&lextexts_memlist, no_lextexts);
         /* fresh lextext block; must init it */
         no_lextexts = lex_index+1;
         ensure_memory_list_available(&lextexts_memlist, no_lextexts);

-        lextexts[lex_index].size = MAX_IDENTIFIER_LENGTH + 1;
+        lextexts[lex_index].size = 64;   /* this can grow */

         lextexts[lex_index].text = my_malloc(lextexts[lex_index].size, "one lexeme text");
     }
     lex_pos = 0;
         lextexts[lex_index].text = my_malloc(lextexts[lex_index].size, "one lexeme text");
     }
     lex_pos = 0;


@@ -1733,6 +1864,7 @@ extern void get_next_token(void)
     circle[circle_position].text = NULL; /* will fill in later */
     circle[circle_position].value = 0;
     circle[circle_position].type = 0;
     circle[circle_position].text = NULL; /* will fill in later */
     circle[circle_position].value = 0;
     circle[circle_position].type = 0;

+    circle[circle_position].newsymbol = FALSE;

     circle[circle_position].context = context;
 
     StartTokenAgain:
     circle[circle_position].context = context;
 
     StartTokenAgain:


@@ -1758,7 +1890,7 @@ extern void get_next_token(void)
             goto StartTokenAgain;
 
         case COMMENT_CODE:
             goto StartTokenAgain;
 
         case COMMENT_CODE:

-            while ((lookahead != '\n') && (lookahead != 0))
+            while ((lookahead != '\n') && (lookahead != '\r') && (lookahead != 0))

                 (*get_next_char)();
             goto StartTokenAgain;
 
                 (*get_next_char)();
             goto StartTokenAgain;
 


@@ -1779,7 +1911,7 @@ extern void get_next_token(void)
 
             lexaddc(0);
             circle[circle_position].type = NUMBER_TT;
 
             lexaddc(0);
             circle[circle_position].type = NUMBER_TT;

-            circle[circle_position].value = n;
+            circle[circle_position].value = (int32)n;

             break;
 
             FloatNumber:
             break;
 
             FloatNumber:


@@ -1869,11 +2001,7 @@ extern void get_next_token(void)
             quoted_size=0;
             do
             {   e = d; d = (*get_next_char)(); lexaddc(d);
             quoted_size=0;
             do
             {   e = d; d = (*get_next_char)(); lexaddc(d);

-                if (quoted_size++==64)
-                {   error(
-                    "Too much text for one pair of quotations '...' to hold");
-                    lexaddc('\''); break;
-                }
+                quoted_size++;

                 if ((d == '\'') && (e != '@'))
                 {   if (quoted_size == 1)
                     {   d = (*get_next_char)(); lexaddc(d);
                 if ((d == '\'') && (e != '@'))
                 {   if (quoted_size == 1)
                     {   d = (*get_next_char)(); lexaddc(d);


@@ -1882,28 +2010,27 @@ extern void get_next_token(void)
                     }
                     break;
                 }
                     }
                     break;
                 }

-            } while (d != EOF);
-            if (d==EOF) ebf_error("'\''", "end of file");
+            } while (d != 0);
+            if (d==0) ebf_error("'\''", "end of file");

             lexdelc();
             circle[circle_position].type = SQ_TT;
             break;
 
         case DQUOTE_CODE:    /* Double-quotes: scan a literal string */
             lexdelc();
             circle[circle_position].type = SQ_TT;
             break;
 
         case DQUOTE_CODE:    /* Double-quotes: scan a literal string */

-            quoted_size=0;

             do
             {   d = (*get_next_char)(); lexaddc(d);
                 if (d == '\n')
                 {   lex_pos--;
                     while (lexlastc() == ' ') lex_pos--;
                     if (lexlastc() != '^') lexaddc(' ');
             do
             {   d = (*get_next_char)(); lexaddc(d);
                 if (d == '\n')
                 {   lex_pos--;
                     while (lexlastc() == ' ') lex_pos--;
                     if (lexlastc() != '^') lexaddc(' ');

-                    while ((lookahead != EOF) &&
+                    while ((lookahead != 0) &&

                           (tokeniser_grid[lookahead] == WHITESPACE_CODE))
                     (*get_next_char)();
                 }
                 else if (d == '\\')
                 {   int newline_passed = FALSE;
                     lex_pos--;
                           (tokeniser_grid[lookahead] == WHITESPACE_CODE))
                     (*get_next_char)();
                 }
                 else if (d == '\\')
                 {   int newline_passed = FALSE;
                     lex_pos--;

-                    while ((lookahead != EOF) &&
+                    while ((lookahead != 0) &&

                           (tokeniser_grid[lookahead] == WHITESPACE_CODE))
                         if ((d = (*get_next_char)()) == '\n')
                             newline_passed = TRUE;
                           (tokeniser_grid[lookahead] == WHITESPACE_CODE))
                         if ((d = (*get_next_char)()) == '\n')
                             newline_passed = TRUE;


@@ -1915,8 +2042,8 @@ extern void get_next_token(void)
                             chb);
                     }
                 }
                             chb);
                     }
                 }

-            }   while ((d != EOF) && (d!='\"'));
-            if (d==EOF) ebf_error("'\"'", "end of file");
+            }   while ((d != 0) && (d!='\"'));
+            if (d==0) ebf_error("'\"'", "end of file");

             lexdelc();
             circle[circle_position].type = DQ_TT;
             break;
             lexdelc();
             circle[circle_position].type = DQ_TT;
             break;


@@ -1924,37 +2051,13 @@ extern void get_next_token(void)
         case IDENTIFIER_CODE:    /* Letter or underscore: an identifier */
 
             lexaddc(d); n=1;
         case IDENTIFIER_CODE:    /* Letter or underscore: an identifier */
 
             lexaddc(d); n=1;

-            while ((n<=MAX_IDENTIFIER_LENGTH)
-                   && ((tokeniser_grid[lookahead] == IDENTIFIER_CODE)
+            while (((tokeniser_grid[lookahead] == IDENTIFIER_CODE)

                    || (tokeniser_grid[lookahead] == DIGIT_CODE)))
                 n++, lexaddc((*get_next_char)());
 
             lexaddc(0);
 
                    || (tokeniser_grid[lookahead] == DIGIT_CODE)))
                 n++, lexaddc((*get_next_char)());
 
             lexaddc(0);
 

-            if (n > MAX_IDENTIFIER_LENGTH)
-            {   char bad_length[100];
-                sprintf(bad_length,
-                    "Name exceeds the maximum length of %d characters:",
-                         MAX_IDENTIFIER_LENGTH);
-                error_named(bad_length, lextexts[lex_index].text);
-                /* Eat any further extra characters in the identifier */
-                while (((tokeniser_grid[lookahead] == IDENTIFIER_CODE)
-                        || (tokeniser_grid[lookahead] == DIGIT_CODE)))
-                    (*get_next_char)();
-                /* Trim token so that it doesn't violate
-                   MAX_IDENTIFIER_LENGTH during error recovery */
-                lextexts[lex_index].text[MAX_IDENTIFIER_LENGTH] = 0;
-            }
-
-            if (dont_enter_into_symbol_table)
-            {   circle[circle_position].type = DQ_TT;
-                circle[circle_position].value = 0;
-                if (dont_enter_into_symbol_table == -2)
-                    interpret_identifier(lextexts[lex_index].text, circle_position, TRUE);
-                break;
-            }
-
-            interpret_identifier(lextexts[lex_index].text, circle_position, FALSE);
+            interpret_identifier(lextexts[lex_index].text, circle_position);

             break;
 
         default:
             break;
 
         default:


@@ -2059,7 +2162,10 @@ extern void get_next_token(void)
         else
         {   printf("-> "); describe_token(&circle[i]);
             printf(" ");
         else
         {   printf("-> "); describe_token(&circle[i]);
             printf(" ");

-            if (tokens_trace_level > 2) print_context(circle[i].context);
+            if (tokens_trace_level > 2) {
+                if (circle[i].newsymbol) printf("newsym ");
+                print_context(circle[i].context);
+            }

             printf("\n");
         }
     }
             printf("\n");
         }
     }


@@ -2073,6 +2179,7 @@ extern void restart_lexer(char *lexical_source, char *name)
     for (i=0; i<CIRCLE_SIZE; i++)
     {   circle[i].type = 0;
         circle[i].value = 0;
     for (i=0; i<CIRCLE_SIZE; i++)
     {   circle[i].type = 0;
         circle[i].value = 0;

+        circle[i].newsymbol = FALSE;

         circle[i].text = "(if this is ever visible, there is a bug)";
         circle[i].lextext = -1;
         circle[i].context = 0;
         circle[i].text = "(if this is ever visible, there is a bug)";
         circle[i].lextext = -1;
         circle[i].context = 0;


@@ -2125,6 +2232,9 @@ extern void init_lexer_vars(void)
     cur_lextexts = 0;
     lex_index = -1;
     lex_pos = -1;
     cur_lextexts = 0;
     lex_index = -1;
     lex_pos = -1;

+
+    no_locals = 0;
+    local_variable_names_usage = 0;

     
     blank_brief_location.file_index = -1;
     blank_brief_location.line_number = 0;
     
     blank_brief_location.file_index = -1;
     blank_brief_location.line_number = 0;


@@ -2144,6 +2254,8 @@ extern void lexer_begin_pass(void)
 
     pipeline_made = FALSE;
 
 
     pipeline_made = FALSE;
 

+    no_locals = 0;
+

     restart_lexer(NULL, NULL);
 }
 
     restart_lexer(NULL, NULL);
 }
 


@@ -2171,8 +2283,11 @@ extern void lexer_allocate_arrays(void)
     keywords_data_table = my_calloc(sizeof(int), 3*MAX_KEYWORDS,
         "keyword hashing linked list");
     
     keywords_data_table = my_calloc(sizeof(int), 3*MAX_KEYWORDS,
         "keyword hashing linked list");
     

-    local_variable_names = my_calloc(sizeof(identstruct), MAX_LOCAL_VARIABLES-1,
+    initialise_memory_list(&local_variable_names_memlist,
+        sizeof(char), MAX_LOCAL_VARIABLES*32, NULL,

         "text of local variable names");
         "text of local variable names");

+    local_variable_name_offsets = my_calloc(sizeof(int), MAX_LOCAL_VARIABLES-1,
+        "offsets of local variable names");

     local_variable_hash_table = my_calloc(sizeof(int), HASH_TAB_SIZE,
         "local variable hash table");
     local_variable_hash_codes = my_calloc(sizeof(int), MAX_LOCAL_VARIABLES,
     local_variable_hash_table = my_calloc(sizeof(int), HASH_TAB_SIZE,
         "local variable hash table");
     local_variable_hash_codes = my_calloc(sizeof(int), MAX_LOCAL_VARIABLES,


@@ -2217,7 +2332,8 @@ extern void lexer_free_arrays(void)
     my_free(&keywords_hash_ends_table, "keyword hash end table");
     my_free(&keywords_data_table, "keyword hashing linked list");
 
     my_free(&keywords_hash_ends_table, "keyword hash end table");
     my_free(&keywords_data_table, "keyword hashing linked list");
 

-    my_free(&local_variable_names, "text of local variable names");
+    deallocate_memory_list(&local_variable_names_memlist);
+    my_free(&local_variable_name_offsets, "offsets of local variable names");

     my_free(&local_variable_hash_table, "local variable hash table");
     my_free(&local_variable_hash_codes, "local variable hash codes");
 
     my_free(&local_variable_hash_table, "local variable hash table");
     my_free(&local_variable_hash_codes, "local variable hash codes");
 

diff --git a/src/memory.c b/src/memory.c
index 78d06efe1fe9d2cf9fcaa152d5a407cb3fc478f0..d437ceebee986b4cc5b47503be4ad44ca1bb318d 100644 (file)
--- a/src/memory.c
+++ b/src/memory.c
@@ -1,8 +1,8 @@
 /* ------------------------------------------------------------------------- */
 /*   "memory" : Memory management and ICL memory setting commands            */
 /*                                                                           */
 /* ------------------------------------------------------------------------- */
 /*   "memory" : Memory management and ICL memory setting commands            */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -25,7 +25,7 @@ size_t malloced_bytes=0;               /* Total amount of memory allocated   */
 
 /* Wrappers for malloc(), realloc(), etc.
 
 
 /* Wrappers for malloc(), realloc(), etc.
 

-   Note that all of these functions call memory_out_error() on failure.
+   Note that all of these functions call fatalerror_memory_out() on failure.

    This is a fatal error and does not return. However, we check my_malloc()
    return values anyway as a matter of good habit.
  */
    This is a fatal error and does not return. However, we check my_malloc()
    return values anyway as a matter of good habit.
  */


@@ -39,7 +39,7 @@ extern void *my_malloc(size_t size, char *whatfor)
     if (size==0) return(NULL);
     c=(char _huge *)halloc(size,1);
     malloced_bytes+=size;
     if (size==0) return(NULL);
     c=(char _huge *)halloc(size,1);
     malloced_bytes+=size;

-    if (c==0) memory_out_error(size, 1, whatfor);
+    if (c==0) fatalerror_memory_out(size, 1, whatfor);

     return(c);
 }
 
     return(c);
 }
 


@@ -52,7 +52,7 @@ extern void my_realloc(void *pointer, size_t oldsize, size_t size,
     }
     c=halloc(size,1);
     malloced_bytes+=(size-oldsize);
     }
     c=halloc(size,1);
     malloced_bytes+=(size-oldsize);

-    if (c==0) memory_out_error(size, 1, whatfor);
+    if (c==0) fatalerror_memory_out(size, 1, whatfor);

     if (memout_switch)
         printf("Increasing allocation from %ld to %ld bytes for %s was (%08lx) now (%08lx)\n",
             (long int) oldsize, (long int) size, whatfor,
     if (memout_switch)
         printf("Increasing allocation from %ld to %ld bytes for %s was (%08lx) now (%08lx)\n",
             (long int) oldsize, (long int) size, whatfor,


@@ -71,7 +71,7 @@ extern void *my_calloc(size_t size, size_t howmany, char *whatfor)
     if ((size*howmany) == 0) return(NULL);
     c=(void _huge *)halloc(howmany*size,1);
     malloced_bytes+=size*howmany;
     if ((size*howmany) == 0) return(NULL);
     c=(void _huge *)halloc(howmany*size,1);
     malloced_bytes+=size*howmany;

-    if (c==0) memory_out_error(size, howmany, whatfor);
+    if (c==0) fatalerror_memory_out(size, howmany, whatfor);

     return(c);
 }
 
     return(c);
 }
 


@@ -84,7 +84,7 @@ extern void my_recalloc(void *pointer, size_t size, size_t oldhowmany,
     }
     c=(void _huge *)halloc(size*howmany,1);
     malloced_bytes+=size*(howmany-oldhowmany);
     }
     c=(void _huge *)halloc(size*howmany,1);
     malloced_bytes+=size*(howmany-oldhowmany);

-    if (c==0) memory_out_error(size, howmany, whatfor);
+    if (c==0) fatalerror_memory_out(size, howmany, whatfor);

     if (memout_switch)
         printf("Increasing allocation from %ld to %ld bytes: array (%ld entries size %ld) for %s was (%08lx) now (%08lx)\n",
             ((long int)size) * ((long int)oldhowmany),
     if (memout_switch)
         printf("Increasing allocation from %ld to %ld bytes: array (%ld entries size %ld) for %s was (%08lx) now (%08lx)\n",
             ((long int)size) * ((long int)oldhowmany),


@@ -103,10 +103,10 @@ extern void *my_malloc(size_t size, char *whatfor)
     if (size==0) return(NULL);
     c=malloc(size);
     malloced_bytes+=size;
     if (size==0) return(NULL);
     c=malloc(size);
     malloced_bytes+=size;

-    if (c==0) memory_out_error(size, 1, whatfor);
+    if (c==0) fatalerror_memory_out(size, 1, whatfor);

     if (memout_switch)
     if (memout_switch)

-        printf("Allocating %ld bytes for %s at (%08lx)\n",
-            (long int) size,whatfor,(long int) c);
+        printf("Allocating %ld bytes for %s at (%p)\n",
+            (long int) size, whatfor, c);

     return(c);
 }
 
     return(c);
 }
 


@@ -119,12 +119,10 @@ extern void my_realloc(void *pointer, size_t oldsize, size_t size,
     }
     c=realloc(*(int **)pointer,  size);
     malloced_bytes+=(size-oldsize);
     }
     c=realloc(*(int **)pointer,  size);
     malloced_bytes+=(size-oldsize);

-    if (c==0) memory_out_error(size, 1, whatfor);
+    if (c==0) fatalerror_memory_out(size, 1, whatfor);

     if (memout_switch)
     if (memout_switch)

-        printf("Increasing allocation from %ld to %ld bytes for %s was (%08lx) now (%08lx)\n",
-            (long int) oldsize, (long int) size, whatfor,
-            (long int) (*(int **)pointer), 
-            (long int) c);
+        printf("Increasing allocation from %ld to %ld bytes for %s was (%p) now (%p)\n",
+            (long int) oldsize, (long int) size, whatfor, pointer, c);

     *(int **)pointer = c;
 }
 
     *(int **)pointer = c;
 }
 


@@ -133,13 +131,12 @@ extern void *my_calloc(size_t size, size_t howmany, char *whatfor)
     if (size*howmany==0) return(NULL);
     c=calloc(howmany, size);
     malloced_bytes+=size*howmany;
     if (size*howmany==0) return(NULL);
     c=calloc(howmany, size);
     malloced_bytes+=size*howmany;

-    if (c==0) memory_out_error(size, howmany, whatfor);
+    if (c==0) fatalerror_memory_out(size, howmany, whatfor);

     if (memout_switch)
         printf("Allocating %ld bytes: array (%ld entries size %ld) \
     if (memout_switch)
         printf("Allocating %ld bytes: array (%ld entries size %ld) \

-for %s at (%08lx)\n",
+for %s at (%p)\n",

             ((long int)size) * ((long int)howmany),
             ((long int)size) * ((long int)howmany),

-            (long int)howmany,(long int)size,whatfor,
-            (long int) c);
+            (long int)howmany,(long int)size, whatfor, c);

     return(c);
 }
 
     return(c);
 }
 


@@ -152,13 +149,13 @@ extern void my_recalloc(void *pointer, size_t size, size_t oldhowmany,
     }
     c=realloc(*(int **)pointer, size*howmany); 
     malloced_bytes+=size*(howmany-oldhowmany);
     }
     c=realloc(*(int **)pointer, size*howmany); 
     malloced_bytes+=size*(howmany-oldhowmany);

-    if (c==0) memory_out_error(size, howmany, whatfor);
+    if (c==0) fatalerror_memory_out(size, howmany, whatfor);

     if (memout_switch)
     if (memout_switch)

-        printf("Increasing allocation from %ld to %ld bytes: array (%ld entries size %ld) for %s was (%08lx) now (%08lx)\n",
+        printf("Increasing allocation from %ld to %ld bytes: array (%ld entries size %ld) for %s was (%p) now (%p)\n",

             ((long int)size) * ((long int)oldhowmany),
             ((long int)size) * ((long int)howmany),
             (long int)howmany, (long int)size, whatfor,
             ((long int)size) * ((long int)oldhowmany),
             ((long int)size) * ((long int)howmany),
             (long int)howmany, (long int)size, whatfor,

-            (long int) *(int **)pointer, (long int) c);
+            pointer, c);

     *(int **)pointer = c;
 }
 
     *(int **)pointer = c;
 }
 


@@ -168,8 +165,8 @@ extern void my_free(void *pointer, char *whatitwas)
 {
     if (*(int **)pointer != NULL)
     {   if (memout_switch)
 {
     if (*(int **)pointer != NULL)
     {   if (memout_switch)

-            printf("Freeing memory for %s at (%08lx)\n",
-                whatitwas, (long int) (*(int **)pointer));
+            printf("Freeing memory for %s at (%p)\n",
+                whatitwas, pointer);

 #ifdef PC_QUICKC
         hfree(*(int **)pointer);
 #else
 #ifdef PC_QUICKC
         hfree(*(int **)pointer);
 #else


@@ -277,6 +274,7 @@ int DICT_WORD_BYTES; /* DICT_WORD_SIZE*DICT_CHAR_SIZE */
 int ZCODE_HEADER_EXT_WORDS; /* (zcode 1.0) requested header extension size */
 int ZCODE_HEADER_FLAGS_3; /* (zcode 1.1) value to place in Flags 3 word */
 int ZCODE_LESS_DICT_DATA; /* (zcode) use 2 data bytes per dict word instead of 3 */
 int ZCODE_HEADER_EXT_WORDS; /* (zcode 1.0) requested header extension size */
 int ZCODE_HEADER_FLAGS_3; /* (zcode 1.1) value to place in Flags 3 word */
 int ZCODE_LESS_DICT_DATA; /* (zcode) use 2 data bytes per dict word instead of 3 */

+int ZCODE_MAX_INLINE_STRING; /* (zcode) length of string literals that can be inlined */

 int NUM_ATTR_BYTES;
 int GLULX_OBJECT_EXT_BYTES; /* (glulx) extra bytes for each object record */
 int32 MAX_STACK_SIZE;
 int NUM_ATTR_BYTES;
 int GLULX_OBJECT_EXT_BYTES; /* (glulx) extra bytes for each object record */
 int32 MAX_STACK_SIZE;


@@ -284,6 +282,8 @@ int32 MEMORY_MAP_EXTENSION;
 int WARN_UNUSED_ROUTINES; /* 0: no, 1: yes except in system files, 2: yes always */
 int OMIT_UNUSED_ROUTINES; /* 0: no, 1: yes */
 int STRIP_UNREACHABLE_LABELS; /* 0: no, 1: yes (default) */
 int WARN_UNUSED_ROUTINES; /* 0: no, 1: yes except in system files, 2: yes always */
 int OMIT_UNUSED_ROUTINES; /* 0: no, 1: yes */
 int STRIP_UNREACHABLE_LABELS; /* 0: no, 1: yes (default) */

+int OMIT_SYMBOL_TABLE; /* 0: no, 1: yes */
+int LONG_DICT_FLAG_BUG; /* 0: no bug, 1: bug (default for historic reasons) */

 int TRANSCRIPT_FORMAT; /* 0: classic, 1: prefixed */
 
 /* The way memory sizes are set causes great nuisance for those parameters
 int TRANSCRIPT_FORMAT; /* 0: classic, 1: prefixed */
 
 /* The way memory sizes are set causes great nuisance for those parameters


@@ -315,6 +315,8 @@ static void list_memory_sizes(void)
       printf("|  %25s = %-7d |\n","ZCODE_HEADER_FLAGS_3",ZCODE_HEADER_FLAGS_3);
     if (!glulx_mode)
       printf("|  %25s = %-7d |\n","ZCODE_LESS_DICT_DATA",ZCODE_LESS_DICT_DATA);
       printf("|  %25s = %-7d |\n","ZCODE_HEADER_FLAGS_3",ZCODE_HEADER_FLAGS_3);
     if (!glulx_mode)
       printf("|  %25s = %-7d |\n","ZCODE_LESS_DICT_DATA",ZCODE_LESS_DICT_DATA);

+    if (!glulx_mode)
+      printf("|  %25s = %-7d |\n","ZCODE_MAX_INLINE_STRING",ZCODE_MAX_INLINE_STRING);

     printf("|  %25s = %-7d |\n","INDIV_PROP_START", INDIV_PROP_START);
     if (glulx_mode)
       printf("|  %25s = %-7d |\n","MEMORY_MAP_EXTENSION",
     printf("|  %25s = %-7d |\n","INDIV_PROP_START", INDIV_PROP_START);
     if (glulx_mode)
       printf("|  %25s = %-7d |\n","MEMORY_MAP_EXTENSION",


@@ -329,6 +331,8 @@ static void list_memory_sizes(void)
     printf("|  %25s = %-7d |\n","WARN_UNUSED_ROUTINES",WARN_UNUSED_ROUTINES);
     printf("|  %25s = %-7d |\n","OMIT_UNUSED_ROUTINES",OMIT_UNUSED_ROUTINES);
     printf("|  %25s = %-7d |\n","STRIP_UNREACHABLE_LABELS",STRIP_UNREACHABLE_LABELS);
     printf("|  %25s = %-7d |\n","WARN_UNUSED_ROUTINES",WARN_UNUSED_ROUTINES);
     printf("|  %25s = %-7d |\n","OMIT_UNUSED_ROUTINES",OMIT_UNUSED_ROUTINES);
     printf("|  %25s = %-7d |\n","STRIP_UNREACHABLE_LABELS",STRIP_UNREACHABLE_LABELS);

+    printf("|  %25s = %-7d |\n","OMIT_SYMBOL_TABLE",OMIT_SYMBOL_TABLE);
+    printf("|  %25s = %-7d |\n","LONG_DICT_FLAG_BUG",LONG_DICT_FLAG_BUG);

     printf("+--------------------------------------+\n");
 }
 
     printf("+--------------------------------------+\n");
 }
 


@@ -349,6 +353,7 @@ extern void set_memory_sizes(void)
     ZCODE_HEADER_EXT_WORDS = 3;
     ZCODE_HEADER_FLAGS_3 = 0;
     ZCODE_LESS_DICT_DATA = 0;
     ZCODE_HEADER_EXT_WORDS = 3;
     ZCODE_HEADER_FLAGS_3 = 0;
     ZCODE_LESS_DICT_DATA = 0;

+    ZCODE_MAX_INLINE_STRING = 32;

     GLULX_OBJECT_EXT_BYTES = 0;
     MEMORY_MAP_EXTENSION = 0;
     /* We estimate the default Glulx stack size at 4096. That's about
     GLULX_OBJECT_EXT_BYTES = 0;
     MEMORY_MAP_EXTENSION = 0;
     /* We estimate the default Glulx stack size at 4096. That's about


@@ -360,6 +365,8 @@ extern void set_memory_sizes(void)
     OMIT_UNUSED_ROUTINES = 0;
     WARN_UNUSED_ROUTINES = 0;
     STRIP_UNREACHABLE_LABELS = 1;
     OMIT_UNUSED_ROUTINES = 0;
     WARN_UNUSED_ROUTINES = 0;
     STRIP_UNREACHABLE_LABELS = 1;

+    OMIT_SYMBOL_TABLE = 0;
+    LONG_DICT_FLAG_BUG = 1;

     TRANSCRIPT_FORMAT = 0;
 
     adjust_memory_sizes();
     TRANSCRIPT_FORMAT = 0;
 
     adjust_memory_sizes();


@@ -432,6 +439,12 @@ static void explain_parameter(char *command)
   rather than three. (Z-code only.)\n");
         return;
     }
   rather than three. (Z-code only.)\n");
         return;
     }

+    if (strcmp(command,"ZCODE_MAX_INLINE_STRING")==0)
+    {   printf(
+"  ZCODE_MAX_INLINE_STRING is the length beyond which string literals cannot\n\
+  be inlined in assembly opcodes. (Z-code only.)\n");
+        return;
+    }

     if (strcmp(command,"GLULX_OBJECT_EXT_BYTES")==0)
     {   printf(
 "  GLULX_OBJECT_EXT_BYTES is an amount of additional space to add to each \n\
     if (strcmp(command,"GLULX_OBJECT_EXT_BYTES")==0)
     {   printf(
 "  GLULX_OBJECT_EXT_BYTES is an amount of additional space to add to each \n\


@@ -504,6 +517,21 @@ static void explain_parameter(char *command)
   will be compiled, at the cost of less optimized code. The default is 1.\n");
         return;
     }
   will be compiled, at the cost of less optimized code. The default is 1.\n");
         return;
     }

+    if (strcmp(command,"OMIT_SYMBOL_TABLE")==0)
+    {
+        printf(
+"  OMIT_SYMBOL_TABLE, if set to 1, will skip compiling debug symbol names \n\
+  into the game file.\n");
+        return;
+    }
+    if (strcmp(command,"LONG_DICT_FLAG_BUG")==0)
+    {
+        printf(
+"  LONG_DICT_FLAG_BUG, if set to 0, will fix the old bug which ignores \n\
+  the '//p' flag in long dictionary words. If 1, the buggy behavior is \n\
+  retained.\n");
+        return;
+    }

     if (strcmp(command,"SERIAL")==0)
     {
         printf(
     if (strcmp(command,"SERIAL")==0)
     {
         printf(


@@ -629,6 +657,7 @@ static void set_trace_option(char *command)
         printf("  FREQ: show how efficient abbreviations were (same as -f)\n    (only meaningful with -e)\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("  FREQ: show how efficient abbreviations were (same as -f)\n    (only meaningful with -e)\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("    MAP=3: also show number of bytes that each segment occupies\n");

         printf("  MEM: show internal memory allocations\n");
         printf("  OBJECTS: display the object table\n");
         printf("  PROPS: show attributes and properties defined\n");
         printf("  MEM: show internal memory allocations\n");
         printf("  OBJECTS: display the object table\n");
         printf("  PROPS: show attributes and properties defined\n");


@@ -801,6 +830,8 @@ extern void memory_command(char *command)
                 ZCODE_HEADER_FLAGS_3=j, flag=1;
             if (strcmp(command,"ZCODE_LESS_DICT_DATA")==0)
                 ZCODE_LESS_DICT_DATA=j, flag=1;
                 ZCODE_HEADER_FLAGS_3=j, flag=1;
             if (strcmp(command,"ZCODE_LESS_DICT_DATA")==0)
                 ZCODE_LESS_DICT_DATA=j, flag=1;

+            if (strcmp(command,"ZCODE_MAX_INLINE_STRING")==0)
+                ZCODE_MAX_INLINE_STRING=j, flag=1;

             if (strcmp(command,"GLULX_OBJECT_EXT_BYTES")==0)
                 GLULX_OBJECT_EXT_BYTES=j, flag=1;
             if (strcmp(command,"MAX_STATIC_DATA")==0)
             if (strcmp(command,"GLULX_OBJECT_EXT_BYTES")==0)
                 GLULX_OBJECT_EXT_BYTES=j, flag=1;
             if (strcmp(command,"MAX_STATIC_DATA")==0)


@@ -909,6 +940,18 @@ extern void memory_command(char *command)
                 if (STRIP_UNREACHABLE_LABELS > 1 || STRIP_UNREACHABLE_LABELS < 0)
                     STRIP_UNREACHABLE_LABELS = 1;
             }
                 if (STRIP_UNREACHABLE_LABELS > 1 || STRIP_UNREACHABLE_LABELS < 0)
                     STRIP_UNREACHABLE_LABELS = 1;
             }

+            if (strcmp(command,"OMIT_SYMBOL_TABLE")==0)
+            {
+                OMIT_SYMBOL_TABLE=j, flag=1;
+                if (OMIT_SYMBOL_TABLE > 1 || OMIT_SYMBOL_TABLE < 0)
+                    OMIT_SYMBOL_TABLE = 1;
+            }
+            if (strcmp(command,"LONG_DICT_FLAG_BUG")==0)
+            {
+                LONG_DICT_FLAG_BUG=j, flag=1;
+                if (LONG_DICT_FLAG_BUG > 1 || LONG_DICT_FLAG_BUG < 0)
+                    LONG_DICT_FLAG_BUG = 1;
+            }

             if (strcmp(command,"SERIAL")==0)
             {
                 if (j >= 0 && j <= 999999)
             if (strcmp(command,"SERIAL")==0)
             {
                 if (j >= 0 && j <= 999999)

diff --git a/src/objects.c b/src/objects.c
index f122c3ec80004f9d50249524ba650babfc58c37e..88715bbf1fbb5cd4cdc37c966dac30dbb5d771db 100644 (file)
--- a/src/objects.c
+++ b/src/objects.c
@@ -6,8 +6,8 @@
 /*                    checks syntax and translates such directives into      */
 /*                    specifications for the object-maker.                   */
 /*                                                                           */
 /*                    checks syntax and translates such directives into      */
 /*                    specifications for the object-maker.                   */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -50,9 +50,11 @@ static fproptg full_object_g;          /* Equivalent for Glulx. This object
                                           are allocated dynamically as
                                           memory-lists                       */
 
                                           are allocated dynamically as
                                           memory-lists                       */
 

-static char shortname_buffer[766];     /* Text buffer to hold the short name
+static char *shortname_buffer;         /* Text buffer to hold the short name

                                           (which is read in first, but
                                           written almost last)               */
                                           (which is read in first, but
                                           written almost last)               */

+static memory_list shortname_buffer_memlist;
+

 static int parent_of_this_obj;
 
 static memory_list current_object_name; /* The name of the object currently
 static int parent_of_this_obj;
 
 static memory_list current_object_name; /* The name of the object currently


@@ -99,8 +101,8 @@ int no_attributes,                 /* Number of attributes defined so far    */
 /* Print a PROPS trace line. The f flag is 0 for an attribute, 1 for
    a common property, 2 for an individual property. */
 static void trace_s(char *name, int32 number, int f)
 /* Print a PROPS trace line. The f flag is 0 for an attribute, 1 for
    a common property, 2 for an individual property. */
 static void trace_s(char *name, int32 number, int f)

-{   if (!printprops_switch) return;
-    char *stype = "";
+{   char *stype = "";
+    if (!printprops_switch) return;

     if (f == 0) stype = "Attr";
     else if (f == 1) stype = "Prop";
     else if (f == 2) stype = "Indiv";
     if (f == 0) stype = "Attr";
     else if (f == 1) stype = "Prop";
     else if (f == 2) stype = "Indiv";


@@ -108,7 +110,7 @@ static void trace_s(char *name, int32 number, int f)
     if (f != 1) printf("  ");
     else      printf("%s%s",(commonprops[number].is_long)?"L":" ",
                             (commonprops[number].is_additive)?"A":" ");
     if (f != 1) printf("  ");
     else      printf("%s%s",(commonprops[number].is_long)?"L":" ",
                             (commonprops[number].is_additive)?"A":" ");

-    printf("  %s\n", name);
+    printf("  %-24s  (%s)\n", name, current_location_text());

 }
 
 extern void make_attribute(void)
 }
 
 extern void make_attribute(void)


@@ -132,9 +134,9 @@ game to get an extra 16)");
  else {
     if (no_attributes==NUM_ATTR_BYTES*8) {
       discard_token_location(beginning_debug_location);
  else {
     if (no_attributes==NUM_ATTR_BYTES*8) {
       discard_token_location(beginning_debug_location);

-      error_numbered(
-        "All attributes already declared -- increase NUM_ATTR_BYTES to use \
-more than", 
+      error_fmt(
+        "All %d attributes already declared -- increase NUM_ATTR_BYTES to use \
+more", 

         NUM_ATTR_BYTES*8);
       panic_mode_error_recovery(); 
       put_token_back();
         NUM_ATTR_BYTES*8);
       panic_mode_error_recovery(); 
       put_token_back();


@@ -147,7 +149,7 @@ more than",
     /* We hold onto token_text through the end of this Property directive, which should be okay. */
     if (token_type != SYMBOL_TT)
     {   discard_token_location(beginning_debug_location);
     /* We hold onto token_text through the end of this Property directive, which should be okay. */
     if (token_type != SYMBOL_TT)
     {   discard_token_location(beginning_debug_location);

-        ebf_error("new attribute name", token_text);
+        ebf_curtoken_error("new attribute name");

         panic_mode_error_recovery(); 
         put_token_back();
         return;
         panic_mode_error_recovery(); 
         put_token_back();
         return;


@@ -169,8 +171,7 @@ more than",
         if (!((token_type == SYMBOL_TT)
               && (symbols[token_value].type == ATTRIBUTE_T)))
         {   discard_token_location(beginning_debug_location);
         if (!((token_type == SYMBOL_TT)
               && (symbols[token_value].type == ATTRIBUTE_T)))
         {   discard_token_location(beginning_debug_location);

-            ebf_error("an existing attribute name after 'alias'",
-                token_text);
+            ebf_curtoken_error("an existing attribute name after 'alias'");

             panic_mode_error_recovery();
             put_token_back();
             return;
             panic_mode_error_recovery();
             put_token_back();
             return;


@@ -265,7 +266,7 @@ extern void make_property(void)
     /* We hold onto token_text through the end of this Property directive, which should be okay. */
     if (token_type != SYMBOL_TT)
     {   discard_token_location(beginning_debug_location);
     /* We hold onto token_text through the end of this Property directive, which should be okay. */
     if (token_type != SYMBOL_TT)
     {   discard_token_location(beginning_debug_location);

-        ebf_error("new property name", token_text);
+        ebf_curtoken_error("new property name");

         panic_mode_error_recovery();
         put_token_back();
         return;
         panic_mode_error_recovery();
         put_token_back();
         return;


@@ -326,8 +327,7 @@ extern void make_property(void)
         get_next_token();
         if (!((token_type == SYMBOL_TT)
             && (symbols[token_value].type == PROPERTY_T)))
         get_next_token();
         if (!((token_type == SYMBOL_TT)
             && (symbols[token_value].type == PROPERTY_T)))

-        {   ebf_error("an existing property name after 'alias'",
-                token_text);
+        {   ebf_curtoken_error("an existing property name after 'alias'");

             panic_mode_error_recovery();
             put_token_back();
             return;
             panic_mode_error_recovery();
             put_token_back();
             return;


@@ -360,12 +360,10 @@ Advanced game to get 32 more)");
     }
     else {
         if (no_properties==INDIV_PROP_START) {
     }
     else {
         if (no_properties==INDIV_PROP_START) {

-            char error_b[128];

             discard_token_location(beginning_debug_location);
             discard_token_location(beginning_debug_location);

-            sprintf(error_b,
+            error_fmt(

                 "All %d properties already declared (increase INDIV_PROP_START to get more)",
                 INDIV_PROP_START-3);
                 "All %d properties already declared (increase INDIV_PROP_START to get more)",
                 INDIV_PROP_START-3);

-            error(error_b);

             panic_mode_error_recovery(); 
             put_token_back();
             return;
             panic_mode_error_recovery(); 
             put_token_back();
             return;


@@ -589,11 +587,17 @@ static void property_inheritance_z(void)
 
                         for (i=full_object.pp[k].l;
                              i<full_object.pp[k].l+prop_length/2; i++)
 
                         for (i=full_object.pp[k].l;
                              i<full_object.pp[k].l+prop_length/2; i++)

-                        {   if (i >= 32)
+                        {
+                            if (i >= 32)

                             {   error("An additive property has inherited \
 so many values that the list has overflowed the maximum 32 entries");
                                 break;
                             }
                             {   error("An additive property has inherited \
 so many values that the list has overflowed the maximum 32 entries");
                                 break;
                             }

+                            if ((version_number==3) && i >= 4)
+                            {   error("An additive property has inherited \
+so many values that the list has overflowed the maximum 4 entries");
+                                break;
+                            }

                             INITAOTV(&full_object.pp[k].ao[i], LONG_CONSTANT_OT, mark + j);
                             j += 2;
                             full_object.pp[k].ao[i].marker = INHERIT_MV;
                             INITAOTV(&full_object.pp[k].ao[i], LONG_CONSTANT_OT, mark + j);
                             j += 2;
                             full_object.pp[k].ao[i].marker = INHERIT_MV;


@@ -863,7 +867,13 @@ static int write_properties_between(int mark, int from, int to)
                 }
 
                 for (k=0; k<full_object.pp[j].l; k++)
                 }
 
                 for (k=0; k<full_object.pp[j].l; k++)

-                {   if (full_object.pp[j].ao[k].marker != 0)
+                {
+                    if (k >= 32) {
+                        /* We catch this earlier, but we'll check again to avoid overflowing ao[] */
+                        error("Too many values for Z-machine property");
+                        break;
+                    }
+                    if (full_object.pp[j].ao[k].marker != 0)

                         backpatch_zmachine(full_object.pp[j].ao[k].marker,
                             PROP_ZA, mark);
                     properties_table[mark++] = full_object.pp[j].ao[k].value/256;
                         backpatch_zmachine(full_object.pp[j].ao[k].marker,
                             PROP_ZA, mark);
                     properties_table[mark++] = full_object.pp[j].ao[k].value/256;


@@ -893,6 +903,7 @@ static int write_property_block_z(char *shortname)
 
     if (shortname != NULL)
     {
 
     if (shortname != NULL)
     {

+        /* The limit of 510 bytes, or 765 Z-characters, is a Z-spec limit. */

         i = translate_text(510,shortname,STRCTX_OBJNAME);
         if (i < 0) {
             error ("Short name of object exceeded 765 Z-characters");
         i = translate_text(510,shortname,STRCTX_OBJNAME);
         if (i < 0) {
             error ("Short name of object exceeded 765 Z-characters");


@@ -1161,7 +1172,7 @@ static void properties_segment_z(int this_segment)
         }
 
         if (token_type != SYMBOL_TT)
         }
 
         if (token_type != SYMBOL_TT)

-        {   ebf_error("property name", token_text);
+        {   ebf_curtoken_error("property name");

             return;
         }
 
             return;
         }
 


@@ -1242,13 +1253,12 @@ not 'private':", token_text);
             }
             else
             if (symbols[defined_this_segment[i]].value == symbols[token_value].value)
             }
             else
             if (symbols[defined_this_segment[i]].value == symbols[token_value].value)

-            {   char error_b[128+2*MAX_IDENTIFIER_LENGTH];
-                sprintf(error_b,
+            {
+                error_fmt(

                     "Property given twice in the same declaration, because \
                     "Property given twice in the same declaration, because \

-the names '%s' and '%s' actually refer to the same property",
+the names \"%s\" and \"%s\" actually refer to the same property",

                     symbols[defined_this_segment[i]].name,
                     symbols[token_value].name);
                     symbols[defined_this_segment[i]].name,
                     symbols[token_value].name);

-                error(error_b);

             }
 
         property_name_symbol = token_value;
             }
 
         property_name_symbol = token_value;


@@ -1339,12 +1349,20 @@ the names '%s' and '%s' actually refer to the same property",
                 AO = parse_expression(ARRAY_CONTEXT);
             }
 
                 AO = parse_expression(ARRAY_CONTEXT);
             }
 

+            /* length is in bytes here, but we report the limit in words. */
+

             if (length == 64)
             {   error_named("Limit (of 32 values) exceeded for property",
                     symbols[property_name_symbol].name);
                 break;
             }
 
             if (length == 64)
             {   error_named("Limit (of 32 values) exceeded for property",
                     symbols[property_name_symbol].name);
                 break;
             }
 

+            if ((version_number==3) && (!individual_property) && length == 8)
+            {   error_named("Limit (of 4 values) exceeded for property",
+                    symbols[property_name_symbol].name);
+                break;
+            }
+            

             if (individual_property)
             {   if (AO.marker != 0)
                     backpatch_zmachine(AO.marker, INDIVIDUAL_PROP_ZA,
             if (individual_property)
             {   if (AO.marker != 0)
                     backpatch_zmachine(AO.marker, INDIVIDUAL_PROP_ZA,


@@ -1382,16 +1400,6 @@ the names '%s' and '%s' actually refer to the same property",
             }
         }
 
             }
         }
 

-        if ((version_number==3) && (!individual_property))
-        {   if (length > 8)
-            {
-       warning_named("Version 3 limit of 4 values per property exceeded \
-(use -v5 to get 32), so truncating property",
-                    symbols[property_name_symbol].name);
-                length = 8;
-            }
-        }
-

         if (individual_property)
         {
             ensure_memory_list_available(&individuals_table_memlist, individuals_length+length+3);
         if (individual_property)
         {
             ensure_memory_list_available(&individuals_table_memlist, individuals_length+length+3);


@@ -1434,7 +1442,7 @@ static void properties_segment_g(int this_segment)
         }
 
         if (token_type != SYMBOL_TT)
         }
 
         if (token_type != SYMBOL_TT)

-        {   ebf_error("property name", token_text);
+        {   ebf_curtoken_error("property name");

             return;
         }
 
             return;
         }
 


@@ -1510,13 +1518,12 @@ not 'private':", token_text);
             }
             else
             if (symbols[defined_this_segment[i]].value == symbols[token_value].value)
             }
             else
             if (symbols[defined_this_segment[i]].value == symbols[token_value].value)

-            {   char error_b[128+2*MAX_IDENTIFIER_LENGTH];
-                sprintf(error_b,
+            {
+                error_fmt(

                     "Property given twice in the same declaration, because \
                     "Property given twice in the same declaration, because \

-the names '%s' and '%s' actually refer to the same property",
+the names \"%s\" and \"%s\" actually refer to the same property",

                     symbols[defined_this_segment[i]].name,
                     symbols[token_value].name);
                     symbols[defined_this_segment[i]].name,
                     symbols[token_value].name);

-                error(error_b);

             }
 
         property_name_symbol = token_value;
             }
 
         property_name_symbol = token_value;


@@ -1677,7 +1684,7 @@ static void attributes_segment(void)
             || (token_type == EOF_TT)
             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
         {   if (!truth_state)
             || (token_type == EOF_TT)
             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
         {   if (!truth_state)

-                ebf_error("attribute name after '~'", token_text);
+                ebf_curtoken_error("attribute name after '~'");

             put_token_back(); return;
         }
         if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
             put_token_back(); return;
         }
         if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;


@@ -1688,7 +1695,7 @@ static void attributes_segment(void)
 
         if ((token_type != SYMBOL_TT)
             || (symbols[token_value].type != ATTRIBUTE_T))
 
         if ((token_type != SYMBOL_TT)
             || (symbols[token_value].type != ATTRIBUTE_T))

-        {   ebf_error("name of an already-declared attribute", token_text);
+        {   ebf_curtoken_error("name of an already-declared attribute");

             return;
         }
 
             return;
         }
 


@@ -1771,7 +1778,7 @@ static void classes_segment(void)
 
         if ((token_type != SYMBOL_TT)
             || (symbols[token_value].type != CLASS_T))
 
         if ((token_type != SYMBOL_TT)
             || (symbols[token_value].type != CLASS_T))

-        {   ebf_error("name of an already-declared class", token_text);
+        {   ebf_curtoken_error("name of an already-declared class");

             return;
         }
         if (current_defn_is_class && token_value == current_classname_symbol)
             return;
         }
         if (current_defn_is_class && token_value == current_classname_symbol)


@@ -1884,14 +1891,14 @@ inconvenience, please contact the maintainers.");
 
     if (metaclass_flag)
     {   token_text = metaclass_name;
 
     if (metaclass_flag)
     {   token_text = metaclass_name;

-        token_value = symbol_index(token_text, -1);
+        token_value = symbol_index(token_text, -1, NULL);

         token_type = SYMBOL_TT;
     }
     else
     {   get_next_token();
         if (token_type != SYMBOL_TT)
         {   discard_token_location(beginning_debug_location);
         token_type = SYMBOL_TT;
     }
     else
     {   get_next_token();
         if (token_type != SYMBOL_TT)
         {   discard_token_location(beginning_debug_location);

-            ebf_error("new class name", token_text);
+            ebf_curtoken_error("new class name");

             panic_mode_error_recovery();
             return;
         }
             panic_mode_error_recovery();
             return;
         }


@@ -1905,6 +1912,7 @@ inconvenience, please contact the maintainers.");
 
     /*  Each class also creates a modest object representing itself:         */
 
 
     /*  Each class also creates a modest object representing itself:         */
 

+    ensure_memory_list_available(&shortname_buffer_memlist, strlen(token_text)+1);

     strcpy(shortname_buffer, token_text);
 
     assign_symbol(token_value, class_number, CLASS_T);
     strcpy(shortname_buffer, token_text);
 
     assign_symbol(token_value, class_number, CLASS_T);


@@ -2085,6 +2093,7 @@ extern void make_object(int nearby_flag,
         }
     }
 
         }
     }
 

+    ensure_memory_list_available(&shortname_buffer_memlist, 2);

     sprintf(shortname_buffer, "?");
 
     segment_markers.enabled = TRUE;
     sprintf(shortname_buffer, "?");
 
     segment_markers.enabled = TRUE;


@@ -2097,8 +2106,7 @@ extern void make_object(int nearby_flag,
     if (token_type == DQ_TT) textual_name = token_text;
     else
     {   if (token_type != SYMBOL_TT) {
     if (token_type == DQ_TT) textual_name = token_text;
     else
     {   if (token_type != SYMBOL_TT) {

-            ebf_error("name for new object or its textual short name",
-                token_text);
+            ebf_curtoken_error("name for new object or its textual short name");

         }
         else if (!(symbols[token_value].flags & UNKNOWN_SFLAG)) {
             ebf_symbol_error("new object", token_text, typename(symbols[token_value].type), symbols[token_value].line);
         }
         else if (!(symbols[token_value].flags & UNKNOWN_SFLAG)) {
             ebf_symbol_error("new object", token_text, typename(symbols[token_value].type), symbols[token_value].line);


@@ -2126,10 +2134,9 @@ extern void make_object(int nearby_flag,
     {   if ((token_type != SYMBOL_TT)
             || (symbols[token_value].flags & UNKNOWN_SFLAG))
         {   if (textual_name == NULL)
     {   if ((token_type != SYMBOL_TT)
             || (symbols[token_value].flags & UNKNOWN_SFLAG))
         {   if (textual_name == NULL)

-                ebf_error("parent object or the object's textual short name",
-                    token_text);
+                ebf_curtoken_error("parent object or the object's textual short name");

             else
             else

-                ebf_error("parent object", token_text);
+                ebf_curtoken_error("parent object");

         }
         else goto SpecParent;
     }
         }
         else goto SpecParent;
     }


@@ -2140,7 +2147,7 @@ extern void make_object(int nearby_flag,
     if (end_of_header()) goto HeaderPassed;
 
     if (specified_parent != -1)
     if (end_of_header()) goto HeaderPassed;
 
     if (specified_parent != -1)

-        ebf_error("body of object definition", token_text);
+        ebf_curtoken_error("body of object definition");

     else
     {   SpecParent:
         if ((symbols[token_value].type == OBJECT_T)
     else
     {   SpecParent:
         if ((symbols[token_value].type == OBJECT_T)


@@ -2148,7 +2155,7 @@ extern void make_object(int nearby_flag,
         {   specified_parent = symbols[token_value].value;
             symbols[token_value].flags |= USED_SFLAG;
         }
         {   specified_parent = symbols[token_value].value;
             symbols[token_value].flags |= USED_SFLAG;
         }

-        else ebf_error("name of (the parent) object", token_text);
+        else ebf_curtoken_error("name of (the parent) object");

     }
 
     /*  Now it really has to be the body of the definition.                  */
     }
 
     /*  Now it really has to be the body of the definition.                  */


@@ -2156,7 +2163,7 @@ extern void make_object(int nearby_flag,
     get_next_token_with_directives();
     if (end_of_header()) goto HeaderPassed;
 
     get_next_token_with_directives();
     if (end_of_header()) goto HeaderPassed;
 

-    ebf_error("body of object definition", token_text);
+    ebf_curtoken_error("body of object definition");

 
     HeaderPassed:
     if (specified_class == -1) put_token_back();
 
     HeaderPassed:
     if (specified_class == -1) put_token_back();


@@ -2165,16 +2172,30 @@ extern void make_object(int nearby_flag,
         assign_symbol(internal_name_symbol, no_objects + 1, OBJECT_T);
 
     if (textual_name == NULL)
         assign_symbol(internal_name_symbol, no_objects + 1, OBJECT_T);
 
     if (textual_name == NULL)

-    {   if (internal_name_symbol > 0)
+    {
+        if (internal_name_symbol > 0) {
+            ensure_memory_list_available(&shortname_buffer_memlist, strlen(symbols[internal_name_symbol].name)+4);

             sprintf(shortname_buffer, "(%s)",
                 symbols[internal_name_symbol].name);
             sprintf(shortname_buffer, "(%s)",
                 symbols[internal_name_symbol].name);

-        else
+        }
+        else {
+            ensure_memory_list_available(&shortname_buffer_memlist, 32);

             sprintf(shortname_buffer, "(%d)", no_objects+1);
             sprintf(shortname_buffer, "(%d)", no_objects+1);

+        }

     }
     else
     }
     else

-    {   if (strlen(textual_name)>765)
-            error("Short name of object (in quotes) exceeded 765 characters");
-        strncpy(shortname_buffer, textual_name, 765);
+    {
+        if (!glulx_mode) {
+            /* This check is only advisory. It's possible that a string of less than 765 characters will encode to more than 510 bytes. We'll double-check in write_property_block_z(). */
+            if (strlen(textual_name)>765)
+                error("Short name of object (in quotes) exceeded 765 Z-characters");
+            ensure_memory_list_available(&shortname_buffer_memlist, 766);
+            strncpy(shortname_buffer, textual_name, 765);
+        }
+        else {
+            ensure_memory_list_available(&shortname_buffer_memlist, strlen(textual_name)+1);
+            strcpy(shortname_buffer, textual_name);
+        }

     }
 
     if (specified_parent != -1)
     }
 
     if (specified_parent != -1)


@@ -2271,7 +2292,8 @@ extern void init_objects_vars(void)
     properties_table = NULL;
     individuals_table = NULL;
     commonprops = NULL;
     properties_table = NULL;
     individuals_table = NULL;
     commonprops = NULL;

-
+    shortname_buffer = NULL;
+    

     objectsz = NULL;
     objectsg = NULL;
     objectatts = NULL;
     objectsz = NULL;
     objectsg = NULL;
     objectatts = NULL;


@@ -2379,6 +2401,9 @@ extern void objects_allocate_arrays(void)
     initialise_memory_list(&current_object_name,
         sizeof(char), 32, NULL,
         "object name currently being defined");
     initialise_memory_list(&current_object_name,
         sizeof(char), 32, NULL,
         "object name currently being defined");

+    initialise_memory_list(&shortname_buffer_memlist,
+        sizeof(char), 768, (void**)&shortname_buffer,
+        "textual name of object currently being defined");

     initialise_memory_list(&embedded_function_name,
         sizeof(char), 32, NULL,
         "temporary storage for inline function name");
     initialise_memory_list(&embedded_function_name,
         sizeof(char), 32, NULL,
         "temporary storage for inline function name");


@@ -2409,6 +2434,7 @@ extern void objects_free_arrays(void)
     my_free(&commonprops, "common property info");
     
     deallocate_memory_list(&current_object_name);
     my_free(&commonprops, "common property info");
     
     deallocate_memory_list(&current_object_name);

+    deallocate_memory_list(&shortname_buffer_memlist);

     deallocate_memory_list(&embedded_function_name);
     deallocate_memory_list(&objectsz_memlist);
     deallocate_memory_list(&objectsg_memlist);
     deallocate_memory_list(&embedded_function_name);
     deallocate_memory_list(&objectsz_memlist);
     deallocate_memory_list(&objectsg_memlist);

diff --git a/src/states.c b/src/states.c
index 56572acf7eeb6e396106d79c5b1512e91d771dac..b0695e956c50ee1cfc9ea7900d6c45732382356d 100644 (file)
--- a/src/states.c
+++ b/src/states.c
@@ -1,8 +1,8 @@
 /* ------------------------------------------------------------------------- */
 /*   "states" :  Statement translator                                        */
 /*                                                                           */
 /* ------------------------------------------------------------------------- */
 /*   "states" :  Statement translator                                        */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -29,13 +29,13 @@ static int match_colon(void)
 of a 'for' loop specification: replacing ';' with ':'");
         else
         if (token_value != COLON_SEP)
 of a 'for' loop specification: replacing ';' with ':'");
         else
         if (token_value != COLON_SEP)

-        {   ebf_error("':'", token_text);
+        {   ebf_curtoken_error("':'");

             panic_mode_error_recovery();
             return(FALSE);
         }
     }
     else
             panic_mode_error_recovery();
             return(FALSE);
         }
     }
     else

-    {   ebf_error("':'", token_text);
+    {   ebf_curtoken_error("':'");

         panic_mode_error_recovery();
         return(FALSE);
     }
         panic_mode_error_recovery();
         return(FALSE);
     }


@@ -46,14 +46,14 @@ static void match_open_bracket(void)
 {   get_next_token();
     if ((token_type == SEP_TT) && (token_value == OPENB_SEP)) return;
     put_token_back();
 {   get_next_token();
     if ((token_type == SEP_TT) && (token_value == OPENB_SEP)) return;
     put_token_back();

-    ebf_error("'('", token_text);
+    ebf_curtoken_error("'('");

 }
 
 extern void match_close_bracket(void)
 {   get_next_token();
     if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP)) return;
     put_token_back();
 }
 
 extern void match_close_bracket(void)
 {   get_next_token();
     if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP)) return;
     put_token_back();

-    ebf_error("')'", token_text);
+    ebf_curtoken_error("')'");

 }
 
 static void parse_action(void)
 }
 
 static void parse_action(void)


@@ -98,7 +98,11 @@ static void parse_action(void)
         codegen_action = TRUE;
     }
     else
         codegen_action = TRUE;
     }
     else

-    {   codegen_action = FALSE;
+    {
+        if (token_type != UQ_TT) {
+            ebf_curtoken_error("name of action");
+        }
+        codegen_action = FALSE;

         AO2 = action_of_name(token_text);
     }
 
         AO2 = action_of_name(token_text);
     }
 


@@ -121,7 +125,7 @@ static void parse_action(void)
     }
     if (!((token_type == SEP_TT) && (token_value == GREATER_SEP || token_value == COMMA_SEP)))
     {
     }
     if (!((token_type == SEP_TT) && (token_value == GREATER_SEP || token_value == COMMA_SEP)))
     {

-        ebf_error("',' or '>'", token_text);
+        ebf_curtoken_error("',' or '>'");

     }
 
     if ((token_type == SEP_TT) && (token_value == COMMA_SEP))
     }
 
     if ((token_type == SEP_TT) && (token_value == COMMA_SEP))


@@ -135,7 +139,7 @@ static void parse_action(void)
         get_next_token();
         if (!((token_type == SEP_TT) && (token_value == GREATER_SEP)))
         {
         get_next_token();
         if (!((token_type == SEP_TT) && (token_value == GREATER_SEP)))
         {

-            ebf_error("'>'", token_text);
+            ebf_curtoken_error("'>'");

         }
     }
 
         }
     }
 


@@ -143,7 +147,7 @@ static void parse_action(void)
     {   get_next_token();
         if (!((token_type == SEP_TT) && (token_value == GREATER_SEP)))
         {   put_token_back();
     {   get_next_token();
         if (!((token_type == SEP_TT) && (token_value == GREATER_SEP)))
         {   put_token_back();

-            ebf_error("'>>'", token_text);
+            ebf_curtoken_error("'>>'");

         }
     }
 
         }
     }
 


@@ -272,7 +276,7 @@ extern int parse_label(void)
         return(symbols[token_value].value);
     }
 
         return(symbols[token_value].value);
     }
 

-    ebf_error("label name", token_text);
+    ebf_curtoken_error("label name");

     return 0;
 }
 
     return 0;
 }
 


@@ -305,7 +309,12 @@ static void parse_print_z(int finally_return)
         if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
         switch(token_type)
         {   case DQ_TT:
         if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
         switch(token_type)
         {   case DQ_TT:

-              if (strlen(token_text) > 32)
+              if (token_text[0] == '^' && token_text[1] == '\0') {
+                  /* The string "^" is always a simple newline. */
+                  assemblez_0(new_line_zc);
+                  break;
+              }
+              if ((int)strlen(token_text) > ZCODE_MAX_INLINE_STRING)

               {   INITAOT(&AO, LONG_CONSTANT_OT);
                   AO.marker = STRING_MV;
                   AO.value  = compile_string(token_text, STRCTX_GAME);
               {   INITAOT(&AO, LONG_CONSTANT_OT);
                   AO.marker = STRING_MV;
                   AO.value  = compile_string(token_text, STRCTX_GAME);


@@ -441,7 +450,7 @@ static void parse_print_z(int finally_return)
                               AO.marker = IROUTINE_MV;
                               AO.symindex = token_value;
                               if (symbols[token_value].type != ROUTINE_T)
                               AO.marker = IROUTINE_MV;
                               AO.symindex = token_value;
                               if (symbols[token_value].type != ROUTINE_T)

-                                ebf_error("printing routine name", token_text);
+                                ebf_curtoken_error("printing routine name");

                           }
                           symbols[token_value].flags |= USED_SFLAG;
 
                           }
                           symbols[token_value].flags |= USED_SFLAG;
 


@@ -462,7 +471,7 @@ static void parse_print_z(int finally_return)
                                 QUANTITY_CONTEXT, -1), temp_var1);
                           goto PrintTermDone;
 
                                 QUANTITY_CONTEXT, -1), temp_var1);
                           goto PrintTermDone;
 

-                        default: ebf_error("print specification", token_text);
+                        default: ebf_curtoken_error("print specification");

                           get_next_token();
                           assemblez_1(print_num_zc,
                           code_generate(parse_expression(QUANTITY_CONTEXT),
                           get_next_token();
                           assemblez_1(print_num_zc,
                           code_generate(parse_expression(QUANTITY_CONTEXT),


@@ -492,13 +501,13 @@ static void parse_print_z(int finally_return)
         get_next_token();
         if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
         if ((token_type != SEP_TT) || (token_value != COMMA_SEP))
         get_next_token();
         if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
         if ((token_type != SEP_TT) || (token_value != COMMA_SEP))

-        {   ebf_error("comma", token_text);
+        {   ebf_curtoken_error("comma");

             panic_mode_error_recovery(); return;
         }
         else get_next_token();
     } while(TRUE);
 
             panic_mode_error_recovery(); return;
         }
         else get_next_token();
     } while(TRUE);
 

-    if (count == 0) ebf_error("something to print", token_text);
+    if (count == 0) ebf_curtoken_error("something to print");

     if (finally_return)
     {   assemblez_0(new_line_zc);
         assemblez_0(rtrue_zc);
     if (finally_return)
     {   assemblez_0(new_line_zc);
         assemblez_0(rtrue_zc);


@@ -535,6 +544,12 @@ static void parse_print_g(int finally_return)
         if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
         switch(token_type)
         {   case DQ_TT:
         if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
         switch(token_type)
         {   case DQ_TT:

+              if (token_text[0] == '^' && token_text[1] == '\0') {
+                  /* The string "^" is always a simple newline. */
+                  INITAOTV(&AO, BYTECONSTANT_OT, 0x0A);
+                  assembleg_1(streamchar_gc, AO);
+                  break;
+              }

               /* We can't compile a string into the instruction,
                  so this always goes into the string area. */
               {   INITAOT(&AO, CONSTANT_OT);
               /* We can't compile a string into the instruction,
                  so this always goes into the string area. */
               {   INITAOT(&AO, CONSTANT_OT);


@@ -564,7 +579,6 @@ static void parse_print_g(int finally_return)
                   get_next_token();
                   if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP))
                   {   assembly_operand AO1;
                   get_next_token();
                   if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP))
                   {   assembly_operand AO1;

-                      int ln, ln2;

 
                       put_token_back(); put_token_back();
                       local_variables.enabled = FALSE;
 
                       put_token_back(); put_token_back();
                       local_variables.enabled = FALSE;


@@ -591,19 +605,15 @@ static void parse_print_g(int finally_return)
                                   AO1 = code_generate(
                                       parse_expression(QUANTITY_CONTEXT),
                                       QUANTITY_CONTEXT, -1);
                                   AO1 = code_generate(
                                       parse_expression(QUANTITY_CONTEXT),
                                       QUANTITY_CONTEXT, -1);

-                                  if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0))
-                                  {   assembleg_2(stkpeek_gc, zero_operand, 
-                                      stack_pointer);
+                                  if (is_constant_ot(AO1.type) && AO1.marker == 0) {
+                                      if (AO1.value >= 0 && AO1.value < 0x100)
+                                          assembleg_1(streamchar_gc, AO1);
+                                      else
+                                          assembleg_1(streamunichar_gc, AO1);
+                                  }
+                                  else {
+                                      assembleg_1(streamunichar_gc, AO1);

                                   }
                                   }

-                                  INITAOTV(&AO2, HALFCONSTANT_OT, 0x100);
-                                  assembleg_2_branch(jgeu_gc, AO1, AO2, 
-                                      ln = next_label++);
-                                  ln2 = next_label++;
-                                  assembleg_1(streamchar_gc, AO1);
-                                  assembleg_jump(ln2);
-                                  assemble_label_no(ln);
-                                  assembleg_1(streamunichar_gc, AO1);
-                                  assemble_label_no(ln2);

                                   goto PrintTermDone;
                               case ADDRESS_MK:
                                   if (runtime_error_checking_switch)
                                   goto PrintTermDone;
                               case ADDRESS_MK:
                                   if (runtime_error_checking_switch)


@@ -678,7 +688,7 @@ static void parse_print_g(int finally_return)
                               AO.marker = IROUTINE_MV;
                               AO.symindex = token_value;
                               if (symbols[token_value].type != ROUTINE_T)
                               AO.marker = IROUTINE_MV;
                               AO.symindex = token_value;
                               if (symbols[token_value].type != ROUTINE_T)

-                                ebf_error("printing routine name", token_text);
+                                ebf_curtoken_error("printing routine name");

                           }
                           symbols[token_value].flags |= USED_SFLAG;
 
                           }
                           symbols[token_value].flags |= USED_SFLAG;
 


@@ -692,7 +702,7 @@ static void parse_print_g(int finally_return)
                             AO2);
                           goto PrintTermDone;
 
                             AO2);
                           goto PrintTermDone;
 

-                        default: ebf_error("print specification", token_text);
+                        default: ebf_curtoken_error("print specification");

                           get_next_token();
                           assembleg_1(streamnum_gc,
                           code_generate(parse_expression(QUANTITY_CONTEXT),
                           get_next_token();
                           assembleg_1(streamnum_gc,
                           code_generate(parse_expression(QUANTITY_CONTEXT),


@@ -722,13 +732,13 @@ static void parse_print_g(int finally_return)
         get_next_token();
         if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
         if ((token_type != SEP_TT) || (token_value != COMMA_SEP))
         get_next_token();
         if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
         if ((token_type != SEP_TT) || (token_value != COMMA_SEP))

-        {   ebf_error("comma", token_text);
+        {   ebf_curtoken_error("comma");

             panic_mode_error_recovery(); return;
         }
         else get_next_token();
     } while(TRUE);
 
             panic_mode_error_recovery(); return;
         }
         else get_next_token();
     } while(TRUE);
 

-    if (count == 0) ebf_error("something to print", token_text);
+    if (count == 0) ebf_curtoken_error("something to print");

     if (finally_return)
     {
         INITAOTV(&AO, BYTECONSTANT_OT, 0x0A);
     if (finally_return)
     {
         INITAOTV(&AO, BYTECONSTANT_OT, 0x0A);


@@ -748,7 +758,7 @@ static int parse_named_label_statements()
         get_next_token();
         if (token_type != SYMBOL_TT)
         {
         get_next_token();
         if (token_type != SYMBOL_TT)
         {

-            ebf_error("label name", token_text);
+            ebf_curtoken_error("label name");

             return TRUE;
         }
 
             return TRUE;
         }
 


@@ -761,7 +771,7 @@ static int parse_named_label_statements()
         }
         else
         {   if (symbols[token_value].type != LABEL_T) {
         }
         else
         {   if (symbols[token_value].type != LABEL_T) {

-                ebf_error("label name", token_text);
+                ebf_curtoken_error("label name");

                 return TRUE;
             }
             if (symbols[token_value].flags & CHANGE_SFLAG)
                 return TRUE;
             }
             if (symbols[token_value].flags & CHANGE_SFLAG)


@@ -774,7 +784,7 @@ static int parse_named_label_statements()
 
         get_next_token();
         if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
 
         get_next_token();
         if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))

-        {   ebf_error("';'", token_text);
+        {   ebf_curtoken_error("';'");

             put_token_back(); return FALSE;
         }
 
             put_token_back(); return FALSE;
         }
 


@@ -824,8 +834,10 @@ static void parse_statement_z(int break_label, int continue_label)
     {   parse_action(); goto StatementTerminator; }
 
     if (token_type == EOF_TT)
     {   parse_action(); goto StatementTerminator; }
 
     if (token_type == EOF_TT)

-    {   ebf_error("statement", token_text); return; }
+    {   ebf_curtoken_error("statement"); return; }

 
 

+    /* If we don't see a keyword, this must be a function call or
+       other expression-with-side-effects. */

     if (token_type != STATEMENT_TT)
     {   put_token_back();
         AO = parse_expression(VOID_CONTEXT);
     if (token_type != STATEMENT_TT)
     {   put_token_back();
         AO = parse_expression(VOID_CONTEXT);


@@ -854,8 +866,7 @@ static void parse_statement_z(int break_label, int continue_label)
                      if ((token_type==SEP_TT)&&(token_value==SEMICOLON_SEP))
                          break;
                      if (token_type != DQ_TT)
                      if ((token_type==SEP_TT)&&(token_value==SEMICOLON_SEP))
                          break;
                      if (token_type != DQ_TT)

-                         ebf_error("text of box line in double-quotes",
-                             token_text);
+                         ebf_curtoken_error("text of box line in double-quotes");

                      {   int i, j;
                          for (i=0, j=0; token_text[i] != 0; j++)
                              if (token_text[i] == '@')
                      {   int i, j;
                          for (i=0, j=0; token_text[i] != 0; j++)
                              if (token_text[i] == '@')


@@ -943,7 +954,7 @@ static void parse_statement_z(int break_label, int continue_label)
                  if ((token_type != MISC_KEYWORD_TT)
                      || ((token_value != ON_MK)
                          && (token_value != OFF_MK)))
                  if ((token_type != MISC_KEYWORD_TT)
                      || ((token_value != ON_MK)
                          && (token_value != OFF_MK)))

-                 {   ebf_error("'on' or 'off'", token_text);
+                 {   ebf_curtoken_error("'on' or 'off'");

                      panic_mode_error_recovery();
                      break;
                  }
                      panic_mode_error_recovery();
                      break;
                  }


@@ -1207,7 +1218,7 @@ static void parse_statement_z(int break_label, int continue_label)
                  {   get_next_token();
                      if ((token_type != SEP_TT)
                          || (token_value != SEMICOLON_SEP))
                  {   get_next_token();
                      if ((token_type != SEP_TT)
                          || (token_value != SEMICOLON_SEP))

-                     {   ebf_error("';'", token_text);
+                     {   ebf_curtoken_error("';'");

                          put_token_back();
                      }
                  }
                          put_token_back();
                      }
                  }


@@ -1318,7 +1329,7 @@ static void parse_statement_z(int break_label, int continue_label)
                  misc_keywords.enabled = FALSE;
                  if ((token_type != MISC_KEYWORD_TT)
                      || (token_value != TO_MK))
                  misc_keywords.enabled = FALSE;
                  if ((token_type != MISC_KEYWORD_TT)
                      || (token_value != TO_MK))

-                 {   ebf_error("'to'", token_text);
+                 {   ebf_curtoken_error("'to'");

                      panic_mode_error_recovery();
                      return;
                  }
                      panic_mode_error_recovery();
                      return;
                  }


@@ -1363,7 +1374,7 @@ static void parse_statement_z(int break_label, int continue_label)
                      (symbols[token_value].type == GLOBAL_VARIABLE_T))
                      AO.value = symbols[token_value].value;
                  else
                      (symbols[token_value].type == GLOBAL_VARIABLE_T))
                      AO.value = symbols[token_value].value;
                  else

-                 {   ebf_error("'objectloop' variable", token_text);
+                 {   ebf_curtoken_error("'objectloop' variable");

                      panic_mode_error_recovery(); break;
                  }
                  misc_keywords.enabled = TRUE;
                      panic_mode_error_recovery(); break;
                  }
                  misc_keywords.enabled = TRUE;


@@ -1695,9 +1706,8 @@ static void parse_statement_z(int break_label, int continue_label)
                          && (token_value != BOLD_MK)
                          && (token_value != UNDERLINE_MK)
                          && (token_value != FIXED_MK)))
                          && (token_value != BOLD_MK)
                          && (token_value != UNDERLINE_MK)
                          && (token_value != FIXED_MK)))

-                 {   ebf_error(
-"'roman', 'bold', 'underline', 'reverse' or 'fixed'",
-                         token_text);
+                 {   ebf_curtoken_error(
+"'roman', 'bold', 'underline', 'reverse' or 'fixed'");

                      panic_mode_error_recovery();
                      break;
                  }
                      panic_mode_error_recovery();
                      break;
                  }


@@ -1762,7 +1772,7 @@ static void parse_statement_z(int break_label, int continue_label)
 
     get_next_token();
     if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
 
     get_next_token();
     if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))

-    {   ebf_error("';'", token_text);
+    {   ebf_curtoken_error("';'");

         put_token_back();
     }
 }
         put_token_back();
     }
 }


@@ -1794,8 +1804,10 @@ static void parse_statement_g(int break_label, int continue_label)
     {   parse_action(); goto StatementTerminator; }
 
     if (token_type == EOF_TT)
     {   parse_action(); goto StatementTerminator; }
 
     if (token_type == EOF_TT)

-    {   ebf_error("statement", token_text); return; }
+    {   ebf_curtoken_error("statement"); return; }

 
 

+    /* If we don't see a keyword, this must be a function call or
+       other expression-with-side-effects. */

     if (token_type != STATEMENT_TT)
     {   put_token_back();
         AO = parse_expression(VOID_CONTEXT);
     if (token_type != STATEMENT_TT)
     {   put_token_back();
         AO = parse_expression(VOID_CONTEXT);


@@ -1823,8 +1835,7 @@ static void parse_statement_g(int break_label, int continue_label)
                      if ((token_type==SEP_TT)&&(token_value==SEMICOLON_SEP))
                          break;
                      if (token_type != DQ_TT)
                      if ((token_type==SEP_TT)&&(token_value==SEMICOLON_SEP))
                          break;
                      if (token_type != DQ_TT)

-                         ebf_error("text of box line in double-quotes",
-                             token_text);
+                         ebf_curtoken_error("text of box line in double-quotes");

                      {   int i, j;
                          for (i=0, j=0; token_text[i] != 0; j++)
                              if (token_text[i] == '@')
                      {   int i, j;
                          for (i=0, j=0; token_text[i] != 0; j++)
                              if (token_text[i] == '@')


@@ -1910,7 +1921,7 @@ static void parse_statement_g(int break_label, int continue_label)
                  if ((token_type != MISC_KEYWORD_TT)
                      || ((token_value != ON_MK)
                          && (token_value != OFF_MK)))
                  if ((token_type != MISC_KEYWORD_TT)
                      || ((token_value != ON_MK)
                          && (token_value != OFF_MK)))

-                 {   ebf_error("'on' or 'off'", token_text);
+                 {   ebf_curtoken_error("'on' or 'off'");

                      panic_mode_error_recovery();
                      break;
                  }
                      panic_mode_error_recovery();
                      break;
                  }


@@ -2195,7 +2206,7 @@ static void parse_statement_g(int break_label, int continue_label)
                  {   get_next_token();
                      if ((token_type != SEP_TT)
                          || (token_value != SEMICOLON_SEP))
                  {   get_next_token();
                      if ((token_type != SEP_TT)
                          || (token_value != SEMICOLON_SEP))

-                     {   ebf_error("';'", token_text);
+                     {   ebf_curtoken_error("';'");

                          put_token_back();
                      }
                  }
                          put_token_back();
                      }
                  }


@@ -2332,7 +2343,7 @@ static void parse_statement_g(int break_label, int continue_label)
                  misc_keywords.enabled = FALSE;
                  if ((token_type != MISC_KEYWORD_TT)
                      || (token_value != TO_MK))
                  misc_keywords.enabled = FALSE;
                  if ((token_type != MISC_KEYWORD_TT)
                      || (token_value != TO_MK))

-                 {   ebf_error("'to'", token_text);
+                 {   ebf_curtoken_error("'to'");

                      panic_mode_error_recovery();
                      return;
                  }
                      panic_mode_error_recovery();
                      return;
                  }


@@ -2375,7 +2386,7 @@ static void parse_statement_g(int break_label, int continue_label)
                      INITAOTV(&AO, GLOBALVAR_OT, symbols[token_value].value);
                  }
                  else {
                      INITAOTV(&AO, GLOBALVAR_OT, symbols[token_value].value);
                  }
                  else {

-                     ebf_error("'objectloop' variable", token_text);
+                     ebf_curtoken_error("'objectloop' variable");

                      panic_mode_error_recovery(); 
                      break;
                  }
                      panic_mode_error_recovery(); 
                      break;
                  }


@@ -2472,10 +2483,16 @@ static void parse_statement_g(int break_label, int continue_label)
                  }
 
                  sequence_point_follows = TRUE;
                  }
 
                  sequence_point_follows = TRUE;

-                 ln = symbol_index("Class", -1);
-                 INITAOT(&AO2, CONSTANT_OT);
-                 AO2.value = symbols[ln].value;
-                 AO2.marker = OBJECT_MV;
+                 ln = get_symbol_index("Class");
+                 if (ln < 0) {
+                     error("No 'Class' object found");
+                     AO2 = zero_operand;
+                 }
+                 else {
+                     INITAOT(&AO2, CONSTANT_OT);
+                     AO2.value = symbols[ln].value;
+                     AO2.marker = OBJECT_MV;
+                 }

                  assembleg_store(AO, AO2);
 
                  assemble_label_no(ln = next_label++);
                  assembleg_store(AO, AO2);
 
                  assemble_label_no(ln = next_label++);


@@ -2631,9 +2648,8 @@ static void parse_statement_g(int break_label, int continue_label)
                          && (token_value != BOLD_MK)
                          && (token_value != UNDERLINE_MK)
                          && (token_value != FIXED_MK)))
                          && (token_value != BOLD_MK)
                          && (token_value != UNDERLINE_MK)
                          && (token_value != FIXED_MK)))

-                 {   ebf_error(
-"'roman', 'bold', 'underline', 'reverse' or 'fixed'",
-                         token_text);
+                 {   ebf_curtoken_error(
+"'roman', 'bold', 'underline', 'reverse' or 'fixed'");

                      panic_mode_error_recovery();
                      break;
                  }
                      panic_mode_error_recovery();
                      break;
                  }


@@ -2727,7 +2743,7 @@ static void parse_statement_g(int break_label, int continue_label)
 
     get_next_token();
     if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
 
     get_next_token();
     if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))

-    {   ebf_error("';'", token_text);
+    {   ebf_curtoken_error("';'");

         put_token_back();
     }
 }
         put_token_back();
     }
 }


@@ -2756,6 +2772,48 @@ extern void parse_statement(int break_label, int continue_label)
         execution_never_reaches_here &= ~EXECSTATE_ENTIRE;
 }
 
         execution_never_reaches_here &= ~EXECSTATE_ENTIRE;
 }
 

+/* This does the same work as parse_statement(), but it's called if you've
+   already parsed an expression (in void context) and you want to generate
+   it as a statement. Essentially it's a copy of parse_statement() and
+   parse_statement_z/g(), except we skip straight to the "expression-with-
+   side-effects" bit and omit everything else.
+
+   The caller doesn't need to pass break_label/continue_label; they're
+   not used for this code path.
+*/
+extern void parse_statement_singleexpr(assembly_operand AO)
+{
+    int res;
+    int saved_entire_flag;
+    
+    res = parse_named_label_statements();
+    if (!res)
+        return;
+
+    saved_entire_flag = (execution_never_reaches_here & EXECSTATE_ENTIRE);
+    if (execution_never_reaches_here)
+        execution_never_reaches_here |= EXECSTATE_ENTIRE;
+
+    code_generate(AO, VOID_CONTEXT, -1);
+    
+    if (vivc_flag) {
+        panic_mode_error_recovery();
+    }
+    else {
+        /* StatementTerminator... */
+        get_next_token();
+        if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
+        {   ebf_curtoken_error("';'");
+            put_token_back();
+        }
+    }
+
+    if (saved_entire_flag)
+        execution_never_reaches_here |= EXECSTATE_ENTIRE;
+    else
+        execution_never_reaches_here &= ~EXECSTATE_ENTIRE;
+}
+

 /* ========================================================================= */
 /*   Data structure management routines                                      */
 /* ------------------------------------------------------------------------- */
 /* ========================================================================= */
 /*   Data structure management routines                                      */
 /* ------------------------------------------------------------------------- */

diff --git a/src/symbols.c b/src/symbols.c
index e8ac5b6446031572fd6bd4c4e3f90e89276b48b3..dc4eb53dbd5acbf615c7fa54e17b755be1d36e9f 100644 (file)
--- a/src/symbols.c
+++ b/src/symbols.c
@@ -1,8 +1,8 @@
 /* ------------------------------------------------------------------------- */
 /*   "symbols" :  The symbols table; creating stock of reserved words        */
 /*                                                                           */
 /* ------------------------------------------------------------------------- */
 /*   "symbols" :  The symbols table; creating stock of reserved words        */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -69,10 +69,13 @@ symbolinfo *symbols;                           /* Allocated up to no_symbols */
 static memory_list symbols_memlist;
 symboldebuginfo *symbol_debug_info;            /* Allocated up to no_symbols */
 static memory_list symbol_debug_info_memlist;
 static memory_list symbols_memlist;
 symboldebuginfo *symbol_debug_info;            /* Allocated up to no_symbols */
 static memory_list symbol_debug_info_memlist;

+static char *temp_symbol_buf;        /* used in write_the_identifier_names() */
+static memory_list temp_symbol_buf_memlist;

 
 /* ------------------------------------------------------------------------- */
 /*   Memory to hold the text of symbol names: note that this memory is       */
 
 /* ------------------------------------------------------------------------- */
 /*   Memory to hold the text of symbol names: note that this memory is       */

-/*   allocated as needed in chunks of size SYMBOLS_CHUNK_SIZE.               */
+/*   allocated as needed in chunks of size SYMBOLS_CHUNK_SIZE. (Or           */
+/*   larger, if needed for a particularly enormous symbol.)                  */

 /* ------------------------------------------------------------------------- */
 
 #define SYMBOLS_CHUNK_SIZE (4096)
 /* ------------------------------------------------------------------------- */
 
 #define SYMBOLS_CHUNK_SIZE (4096)


@@ -237,10 +240,16 @@ extern int get_symbol_index(char *p)
     return -1;
 }
 
     return -1;
 }
 

-extern int symbol_index(char *p, int hashcode)
+extern int symbol_index(char *p, int hashcode, int *created)

 {
     /*  Return the index in the symbols array of symbol "p", creating a
 {
     /*  Return the index in the symbols array of symbol "p", creating a

-        new symbol with that name if it isn't already there.
+        new symbol with that name if it isn't already there. This
+        always returns a valid symbol index.
+
+        The optional created argument receives TRUE if the symbol
+        was newly created.
+
+        Pass in the hashcode of p if you know it, or -1 if you don't.

 
         New symbols are created with flag UNKNOWN_SFLAG, value 0x100
         (a 2-byte quantity in Z-machine terms) and type CONSTANT_T.
 
         New symbols are created with flag UNKNOWN_SFLAG, value 0x100
         (a 2-byte quantity in Z-machine terms) and type CONSTANT_T.


@@ -264,6 +273,7 @@ extern int symbol_index(char *p, int hashcode)
         {
             if (track_unused_routines)
                 df_note_function_symbol(this);
         {
             if (track_unused_routines)
                 df_note_function_symbol(this);

+            if (created) *created = FALSE;

             return this;
         }
         if (new_entry > 0) break;
             return this;
         }
         if (new_entry > 0) break;


@@ -273,7 +283,7 @@ extern int symbol_index(char *p, int hashcode)
     } while (this != -1);
 
     if (symdef_trace_setting)
     } while (this != -1);
 
     if (symdef_trace_setting)

-        printf("Encountered symbol %d '%s'\n", no_symbols, p);
+        printf("%s: Encountered symbol %d '%s'\n", current_location_text(), no_symbols, p);

     
     ensure_memory_list_available(&symbols_memlist, no_symbols+1);
     if (debugfile_switch)
     
     ensure_memory_list_available(&symbols_memlist, no_symbols+1);
     if (debugfile_switch)


@@ -289,18 +299,19 @@ extern int symbol_index(char *p, int hashcode)
     }
 
     len = strlen(p);
     }
 
     len = strlen(p);

-    if (symbols_free_space+len+1 >= symbols_ceiling)
-    {   symbols_free_space
-            = my_malloc(SYMBOLS_CHUNK_SIZE, "symbol names chunk");
-        symbols_ceiling = symbols_free_space + SYMBOLS_CHUNK_SIZE;
+    if (!symbols_free_space || symbols_free_space+len+1 >= symbols_ceiling)
+    {
+        /* Allocate a new chunk whose size is big enough for the current
+           symbol, or SYMBOLS_CHUNK_SIZE, whichever is greater. */
+        int chunklen = SYMBOLS_CHUNK_SIZE;
+        if (chunklen < len+1)
+            chunklen = len+1;
+        symbols_free_space
+            = my_malloc(chunklen, "symbol names chunk");
+        symbols_ceiling = symbols_free_space + chunklen;

         ensure_memory_list_available(&symbol_name_space_chunks_memlist, no_symbol_name_space_chunks+1);
         symbol_name_space_chunks[no_symbol_name_space_chunks++]
             = symbols_free_space;
         ensure_memory_list_available(&symbol_name_space_chunks_memlist, no_symbol_name_space_chunks+1);
         symbol_name_space_chunks[no_symbol_name_space_chunks++]
             = symbols_free_space;

-        if (symbols_free_space+len+1 >= symbols_ceiling)
-        {
-            /* This should be impossible, since SYMBOLS_CHUNK_SIZE > MAX_IDENTIFIER_LENGTH. */
-            fatalerror("Symbol exceeds the maximum possible length");
-        }

     }
 
     strcpy(symbols_free_space, p);
     }
 
     strcpy(symbols_free_space, p);


@@ -322,17 +333,29 @@ extern int symbol_index(char *p, int hashcode)
 
     if (track_unused_routines)
         df_note_function_symbol(no_symbols);
 
     if (track_unused_routines)
         df_note_function_symbol(no_symbols);

+    if (created) *created = TRUE;

     return(no_symbols++);
 }
 
     return(no_symbols++);
 }
 

-extern void end_symbol_scope(int k)
+extern void end_symbol_scope(int k, int neveruse)

 {
     /* Remove the given symbol from the hash table, making it
 {
     /* Remove the given symbol from the hash table, making it

-       invisible to symbol_index. This is used by the Undef directive.
-       If the symbol is not found, this silently does nothing.
+       invisible to symbol_index. This is used by the Undef directive
+       and put_token_back().
+
+       If you know the symbol has never been used, set neveruse and
+       it will be flagged as an error if it *is* used.
+       
+       If the symbol is not found in the hash table, this silently does
+       nothing.

     */
 
     int j;
     */
 
     int j;

+    
+    symbols[k].flags |= UNHASHED_SFLAG;
+    if (neveruse)
+        symbols[k].flags |= DISCARDED_SFLAG;
+        

     j = hash_code_from_string(symbols[k].name);
     if (start_of_list[j] == k)
     {   start_of_list[j] = symbols[k].next_entry;
     j = hash_code_from_string(symbols[k].name);
     if (start_of_list[j] == k)
     {   start_of_list[j] = symbols[k].next_entry;


@@ -388,8 +411,8 @@ static void describe_flags(int flags)
     if (flags & USED_SFLAG)     printf("(used) ");
     if (flags & DEFCON_SFLAG)   printf("(Defaulted) ");
     if (flags & STUB_SFLAG)     printf("(Stubbed) ");
     if (flags & USED_SFLAG)     printf("(used) ");
     if (flags & DEFCON_SFLAG)   printf("(Defaulted) ");
     if (flags & STUB_SFLAG)     printf("(Stubbed) ");

-    if (flags & IMPORT_SFLAG)   printf("(Imported) ");
-    if (flags & EXPORT_SFLAG)   printf("(Exported) ");
+    if (flags & UNHASHED_SFLAG) printf("(not in hash chain) ");
+    if (flags & DISCARDED_SFLAG)  printf("(removed, do not use) ");

     if (flags & ALIASED_SFLAG)  printf("(aliased) ");
     if (flags & CHANGE_SFLAG)   printf("(value will change) ");
     if (flags & SYSTEM_SFLAG)   printf("(System) ");
     if (flags & ALIASED_SFLAG)  printf("(aliased) ");
     if (flags & CHANGE_SFLAG)   printf("(value will change) ");
     if (flags & SYSTEM_SFLAG)   printf("(System) ");


@@ -527,15 +550,22 @@ extern void issue_unused_warnings(void)
     }
     /*  Now back to mark anything necessary as used  */
 
     }
     /*  Now back to mark anything necessary as used  */
 

-    i = symbol_index("Main", -1);
-    if (!(symbols[i].flags & UNKNOWN_SFLAG)) symbols[i].flags |= USED_SFLAG;
+    i = get_symbol_index("Main");
+    if (i >= 0 && !(symbols[i].flags & UNKNOWN_SFLAG)) {
+        symbols[i].flags |= USED_SFLAG;
+    }

 
     for (i=0;i<no_symbols;i++)
     {   if (((symbols[i].flags
 
     for (i=0;i<no_symbols;i++)
     {   if (((symbols[i].flags

-             & (SYSTEM_SFLAG + UNKNOWN_SFLAG + EXPORT_SFLAG
+             & (SYSTEM_SFLAG + UNKNOWN_SFLAG

                 + INSF_SFLAG + USED_SFLAG + REPLACE_SFLAG)) == 0)
                 + INSF_SFLAG + USED_SFLAG + REPLACE_SFLAG)) == 0)

-             && (symbols[i].type != OBJECT_T))
+             && (symbols[i].type != OBJECT_T)) {

             dbnu_warning(typename(symbols[i].type), symbols[i].name, symbols[i].line);
             dbnu_warning(typename(symbols[i].type), symbols[i].name, symbols[i].line);

+        }
+        if ((symbols[i].flags & DISCARDED_SFLAG)
+            && (symbols[i].flags & USED_SFLAG)) {
+            error_named_at("Symbol was removed from the symbol table, but seems to be in use anyway", symbols[i].name, symbols[i].line);
+        }

     }
 }
 
     }
 }
 


@@ -552,7 +582,7 @@ extern void issue_debug_symbol_warnings(void)
 
 /* ------------------------------------------------------------------------- */
 /*   These are arrays used only during story file creation, and not          */
 
 /* ------------------------------------------------------------------------- */
 /*   These are arrays used only during story file creation, and not          */

-/*   allocated until then.                                                   */
+/*   allocated until just before write_the_identifier_names() time.          */

 
        int32 *individual_name_strings; /* Packed addresses of Z-encoded
                                           strings of the names of the
 
        int32 *individual_name_strings; /* Packed addresses of Z-encoded
                                           strings of the names of the


@@ -563,7 +593,7 @@ extern void issue_debug_symbol_warnings(void)
        int32 *array_name_strings;      /* Ditto for arrays                   */
 
 extern void write_the_identifier_names(void)
        int32 *array_name_strings;      /* Ditto for arrays                   */
 
 extern void write_the_identifier_names(void)

-{   int i, j, k, t, null_value; char idname_string[256];
+{   int i, j, k, t, null_value;

     static char unknown_attribute[20] = "<unknown attribute>";
 
     for (i=0; i<no_individual_properties; i++)
     static char unknown_attribute[20] = "<unknown attribute>";
 
     for (i=0; i<no_individual_properties; i++)


@@ -579,114 +609,133 @@ extern void write_the_identifier_names(void)
         if ((t == INDIVIDUAL_PROPERTY_T) || (t == PROPERTY_T))
         {   if (symbols[i].flags & ALIASED_SFLAG)
             {   if (individual_name_strings[symbols[i].value] == 0)
         if ((t == INDIVIDUAL_PROPERTY_T) || (t == PROPERTY_T))
         {   if (symbols[i].flags & ALIASED_SFLAG)
             {   if (individual_name_strings[symbols[i].value] == 0)

-                {   sprintf(idname_string, "%s", symbols[i].name);
+                {
+                    int sleni = strlen(symbols[i].name);
+                    ensure_memory_list_available(&temp_symbol_buf_memlist, sleni+1);
+                    sprintf(temp_symbol_buf, "%s", symbols[i].name);

 
                     for (j=i+1, k=0; (j<no_symbols && k<3); j++)
                     {   if ((symbols[j].type == symbols[i].type)
                             && (symbols[j].value == symbols[i].value))
 
                     for (j=i+1, k=0; (j<no_symbols && k<3); j++)
                     {   if ((symbols[j].type == symbols[i].type)
                             && (symbols[j].value == symbols[i].value))

-                        {   sprintf(idname_string+strlen(idname_string),
+                        {
+                            int slenj = strlen(symbols[j].name);
+                            ensure_memory_list_available(&temp_symbol_buf_memlist, strlen(temp_symbol_buf)+1+slenj+1);
+                            sprintf(temp_symbol_buf+strlen(temp_symbol_buf),

                                 "/%s", symbols[j].name);
                             k++;
                         }
                     }
 
                     individual_name_strings[symbols[i].value]
                                 "/%s", symbols[j].name);
                             k++;
                         }
                     }
 
                     individual_name_strings[symbols[i].value]

-                        = compile_string(idname_string, STRCTX_SYMBOL);
+                        = compile_string(temp_symbol_buf, STRCTX_SYMBOL);

                 }
             }
             else
                 }
             }
             else

-            {   sprintf(idname_string, "%s", symbols[i].name);
-
+            {

                 individual_name_strings[symbols[i].value]
                 individual_name_strings[symbols[i].value]

-                    = compile_string(idname_string, STRCTX_SYMBOL);
+                    = compile_string(symbols[i].name, STRCTX_SYMBOL);

             }
         }
         if (t == ATTRIBUTE_T)
             }
         }
         if (t == ATTRIBUTE_T)

-        {   if (symbols[i].flags & ALIASED_SFLAG)
+        {
+            if (symbols[i].flags & ALIASED_SFLAG)

             {   if (attribute_name_strings[symbols[i].value] == null_value)
             {   if (attribute_name_strings[symbols[i].value] == null_value)

-                {   sprintf(idname_string, "%s", symbols[i].name);
+                {
+                    int sleni = strlen(symbols[i].name);
+                    ensure_memory_list_available(&temp_symbol_buf_memlist, sleni+1);
+                    sprintf(temp_symbol_buf, "%s", symbols[i].name);

 
                     for (j=i+1, k=0; (j<no_symbols && k<3); j++)
                     {   if ((symbols[j].type == symbols[i].type)
                             && (symbols[j].value == symbols[i].value))
 
                     for (j=i+1, k=0; (j<no_symbols && k<3); j++)
                     {   if ((symbols[j].type == symbols[i].type)
                             && (symbols[j].value == symbols[i].value))

-                        {   sprintf(idname_string+strlen(idname_string),
+                        {
+                            int slenj = strlen(symbols[j].name);
+                            ensure_memory_list_available(&temp_symbol_buf_memlist, strlen(temp_symbol_buf)+1+slenj+1);
+                            sprintf(temp_symbol_buf+strlen(temp_symbol_buf),

                                 "/%s", symbols[j].name);
                             k++;
                         }
                     }
 
                     attribute_name_strings[symbols[i].value]
                                 "/%s", symbols[j].name);
                             k++;
                         }
                     }
 
                     attribute_name_strings[symbols[i].value]

-                        = compile_string(idname_string, STRCTX_SYMBOL);
+                        = compile_string(temp_symbol_buf, STRCTX_SYMBOL);

                 }
             }
             else
                 }
             }
             else

-            {   sprintf(idname_string, "%s", symbols[i].name);
-
+            {

                 attribute_name_strings[symbols[i].value]
                 attribute_name_strings[symbols[i].value]

-                    = compile_string(idname_string, STRCTX_SYMBOL);
+                    = compile_string(symbols[i].name, STRCTX_SYMBOL);

             }
         }
             }
         }

+        

         if (symbols[i].flags & ACTION_SFLAG)
         if (symbols[i].flags & ACTION_SFLAG)

-        {   sprintf(idname_string, "%s", symbols[i].name);
-            idname_string[strlen(idname_string)-3] = 0;
+        {
+            int sleni = strlen(symbols[i].name);
+            ensure_memory_list_available(&temp_symbol_buf_memlist, sleni+1);
+            sprintf(temp_symbol_buf, "%s", symbols[i].name);
+            temp_symbol_buf[strlen(temp_symbol_buf)-3] = 0;

 
             if (debugfile_switch)
             {   debug_file_printf("<action>");
                 debug_file_printf
 
             if (debugfile_switch)
             {   debug_file_printf("<action>");
                 debug_file_printf

-                    ("<identifier>##%s</identifier>", idname_string);
+                    ("<identifier>##%s</identifier>", temp_symbol_buf);

                 debug_file_printf("<value>%d</value>", symbols[i].value);
                 debug_file_printf("</action>");
             }
 
             action_name_strings[symbols[i].value]
                 debug_file_printf("<value>%d</value>", symbols[i].value);
                 debug_file_printf("</action>");
             }
 
             action_name_strings[symbols[i].value]

-                = compile_string(idname_string, STRCTX_SYMBOL);
+                = compile_string(temp_symbol_buf, STRCTX_SYMBOL);

         }
     }
 
     for (i=0; i<no_symbols; i++)
     {   if (symbols[i].type == FAKE_ACTION_T)
         }
     }
 
     for (i=0; i<no_symbols; i++)
     {   if (symbols[i].type == FAKE_ACTION_T)

-        {   sprintf(idname_string, "%s", symbols[i].name);
-            idname_string[strlen(idname_string)-3] = 0;
+        {
+            int sleni = strlen(symbols[i].name);
+            ensure_memory_list_available(&temp_symbol_buf_memlist, sleni+1);
+            sprintf(temp_symbol_buf, "%s", symbols[i].name);
+            temp_symbol_buf[strlen(temp_symbol_buf)-3] = 0;

 
             action_name_strings[symbols[i].value
                     - ((grammar_version_number==1)?256:4096) + no_actions]
 
             action_name_strings[symbols[i].value
                     - ((grammar_version_number==1)?256:4096) + no_actions]

-                = compile_string(idname_string, STRCTX_SYMBOL);
+                = compile_string(temp_symbol_buf, STRCTX_SYMBOL);

         }
     }
 
     for (j=0; j<no_arrays; j++)
         }
     }
 
     for (j=0; j<no_arrays; j++)

-    {   i = arrays[j].symbol;
-        sprintf(idname_string, "%s", symbols[i].name);
-
+    {
+        i = arrays[j].symbol;

         array_name_strings[j]
         array_name_strings[j]

-            = compile_string(idname_string, STRCTX_SYMBOL);
+            = compile_string(symbols[i].name, STRCTX_SYMBOL);

     }
     }

-  if (define_INFIX_switch)
-  { for (i=0; i<no_symbols; i++)
-    {   if (symbols[i].type == GLOBAL_VARIABLE_T)
-        {   sprintf(idname_string, "%s", symbols[i].name);
-            array_name_strings[no_arrays + symbols[i].value -16]
-                = compile_string(idname_string, STRCTX_SYMBOL);
+    
+    if (define_INFIX_switch)
+    {
+        for (i=0; i<no_symbols; i++)
+        {   if (symbols[i].type == GLOBAL_VARIABLE_T)
+            {
+                array_name_strings[no_arrays + symbols[i].value -16]
+                    = compile_string(symbols[i].name, STRCTX_SYMBOL);
+            }

         }
         }

-    }
-
-    for (i=0; i<no_named_routines; i++)
-    {   sprintf(idname_string, "%s", symbols[named_routine_symbols[i]].name);
+        
+        for (i=0; i<no_named_routines; i++)
+        {

             array_name_strings[no_arrays + no_globals + i]
             array_name_strings[no_arrays + no_globals + i]

-                = compile_string(idname_string, STRCTX_SYMBOL);
-    }
-
-    for (i=0, no_named_constants=0; i<no_symbols; i++)
-    {   if (((symbols[i].type == OBJECT_T) || (symbols[i].type == CLASS_T)
-            || (symbols[i].type == CONSTANT_T))
-            && ((symbols[i].flags & (UNKNOWN_SFLAG+ACTION_SFLAG))==0))
-        {   sprintf(idname_string, "%s", symbols[i].name);
-            array_name_strings[no_arrays + no_globals + no_named_routines
-                + no_named_constants++]
-                = compile_string(idname_string, STRCTX_SYMBOL);
+                = compile_string(symbols[named_routine_symbols[i]].name, STRCTX_SYMBOL);
+        }
+        
+        for (i=0, no_named_constants=0; i<no_symbols; i++)
+        {   if (((symbols[i].type == OBJECT_T) || (symbols[i].type == CLASS_T)
+                 || (symbols[i].type == CONSTANT_T))
+                && ((symbols[i].flags & (UNKNOWN_SFLAG+ACTION_SFLAG))==0))
+            {
+                array_name_strings[no_arrays + no_globals + no_named_routines
+                                   + no_named_constants++]
+                    = compile_string(symbols[i].name, STRCTX_SYMBOL);
+            }

         }
     }
         }
     }

-  }

 
     veneer_mode = FALSE;
 }
 
     veneer_mode = FALSE;
 }


@@ -709,7 +758,7 @@ extern void assign_symbol(int index, int32 value, int type)
     assign_symbol_base(index, value, type);
     symbols[index].marker = 0;
     if (symdef_trace_setting)
     assign_symbol_base(index, value, type);
     symbols[index].marker = 0;
     if (symdef_trace_setting)

-        printf("Defined symbol %d '%s' as %d (%s)\n", index, symbols[index].name, value, typename(type));
+        printf("%s: Defined symbol %d '%s' as %d (%s)\n", current_location_text(), index, symbols[index].name, value, typename(type));

 }
 
 extern void assign_marked_symbol(int index, int marker, int32 value, int type)
 }
 
 extern void assign_marked_symbol(int index, int marker, int32 value, int type)


@@ -717,7 +766,7 @@ extern void assign_marked_symbol(int index, int marker, int32 value, int type)
     assign_symbol_base(index, value, type);
     symbols[index].marker = marker;
     if (symdef_trace_setting)
     assign_symbol_base(index, value, type);
     symbols[index].marker = marker;
     if (symdef_trace_setting)

-        printf("Defined symbol %d '%s' as %s %d (%s)\n", index, symbols[index].name, describe_mv(marker), value, typename(type));
+        printf("%s: Defined symbol %d '%s' as %s %d (%s)\n", current_location_text(), index, symbols[index].name, describe_mv(marker), value, typename(type));

 }
 
 static void emit_debug_information_for_predefined_symbol
 }
 
 static void emit_debug_information_for_predefined_symbol


@@ -769,7 +818,7 @@ static void emit_debug_information_for_predefined_symbol
 }
 
 static void create_symbol(char *p, int32 value, int type)
 }
 
 static void create_symbol(char *p, int32 value, int type)

-{   int i = symbol_index(p, -1);
+{   int i = symbol_index(p, -1, NULL);

     if (!(symbols[i].flags & (UNKNOWN_SFLAG + REDEFINABLE_SFLAG))) {
         /* Symbol already defined! */
         if (symbols[i].value == value && symbols[i].type == type) {
     if (!(symbols[i].flags & (UNKNOWN_SFLAG + REDEFINABLE_SFLAG))) {
         /* Symbol already defined! */
         if (symbols[i].value == value && symbols[i].type == type) {


@@ -789,7 +838,7 @@ static void create_symbol(char *p, int32 value, int type)
 }
 
 static void create_rsymbol(char *p, int value, int type)
 }
 
 static void create_rsymbol(char *p, int value, int type)

-{   int i = symbol_index(p, -1);
+{   int i = symbol_index(p, -1, NULL);

     /* This is only called for a few symbols with known names.
        They will not collide. */
     symbols[i].value = value; symbols[i].type = type; symbols[i].line = blank_brief_location;
     /* This is only called for a few symbols with known names.
        They will not collide. */
     symbols[i].value = value; symbols[i].type = type; symbols[i].line = blank_brief_location;


@@ -815,7 +864,7 @@ static void stockup_symbols(void)
         create_rsymbol("Grammar__Version", 1, CONSTANT_T);
     else
         create_rsymbol("Grammar__Version", 2, CONSTANT_T);
         create_rsymbol("Grammar__Version", 1, CONSTANT_T);
     else
         create_rsymbol("Grammar__Version", 2, CONSTANT_T);

-    grammar_version_symbol = symbol_index("Grammar__Version", -1);
+    grammar_version_symbol = get_symbol_index("Grammar__Version");

 
     if (runtime_error_checking_switch)
         create_rsymbol("STRICT_MODE",0, CONSTANT_T);
 
     if (runtime_error_checking_switch)
         create_rsymbol("STRICT_MODE",0, CONSTANT_T);


@@ -828,6 +877,9 @@ static void stockup_symbols(void)
         create_symbol("infix__watching", 0, ATTRIBUTE_T);
     }
 
         create_symbol("infix__watching", 0, ATTRIBUTE_T);
     }
 

+    if (OMIT_SYMBOL_TABLE)
+        create_symbol("OMIT_SYMBOL_TABLE", 0, CONSTANT_T);
+

     create_symbol("WORDSIZE",        WORDSIZE, CONSTANT_T);
     /* DICT_ENTRY_BYTES must be REDEFINABLE_SFLAG because the Version directive can change it. */
     create_rsymbol("DICT_ENTRY_BYTES", DICT_ENTRY_BYTE_LENGTH, CONSTANT_T);
     create_symbol("WORDSIZE",        WORDSIZE, CONSTANT_T);
     /* DICT_ENTRY_BYTES must be REDEFINABLE_SFLAG because the Version directive can change it. */
     create_rsymbol("DICT_ENTRY_BYTES", DICT_ENTRY_BYTE_LENGTH, CONSTANT_T);


@@ -1236,15 +1288,15 @@ extern void locate_dead_functions(void)
        issue_unused_warnings(). But for the sake of thoroughness,
        we'll mark them specially. */
 
        issue_unused_warnings(). But for the sake of thoroughness,
        we'll mark them specially. */
 

-    ix = symbol_index("Main__", -1);
-    if (symbols[ix].type == ROUTINE_T) {
+    ix = get_symbol_index("Main__");
+    if (ix >= 0 && symbols[ix].type == ROUTINE_T) {

         uint32 addr = symbols[ix].value * (glulx_mode ? 1 : scale_factor);
         tofunc = df_function_for_address(addr);
         if (tofunc)
             tofunc->usage |= DF_USAGE_MAIN;
     }
         uint32 addr = symbols[ix].value * (glulx_mode ? 1 : scale_factor);
         tofunc = df_function_for_address(addr);
         if (tofunc)
             tofunc->usage |= DF_USAGE_MAIN;
     }

-    ix = symbol_index("Main", -1);
-    if (symbols[ix].type == ROUTINE_T) {
+    ix = get_symbol_index("Main");
+    if (ix >= 0 && symbols[ix].type == ROUTINE_T) {

         uint32 addr = symbols[ix].value * (glulx_mode ? 1 : scale_factor);
         tofunc = df_function_for_address(addr);
         if (tofunc)
         uint32 addr = symbols[ix].value * (glulx_mode ? 1 : scale_factor);
         tofunc = df_function_for_address(addr);
         if (tofunc)


@@ -1537,11 +1589,12 @@ extern void init_symbols_vars(void)
     symbols = NULL;
     start_of_list = NULL;
     symbol_debug_info = NULL;
     symbols = NULL;
     start_of_list = NULL;
     symbol_debug_info = NULL;

+    temp_symbol_buf = NULL;

 
     symbol_name_space_chunks = NULL;
     no_symbol_name_space_chunks = 0;
 
     symbol_name_space_chunks = NULL;
     no_symbol_name_space_chunks = 0;

-    symbols_free_space=NULL;
-    symbols_ceiling=NULL;
+    symbols_free_space = NULL;
+    symbols_ceiling = NULL;

 
     no_symbols = 0;
 
 
     no_symbols = 0;
 


@@ -1581,6 +1634,11 @@ extern void symbols_allocate_arrays(void)
             sizeof(symboldebuginfo), 6400, (void**)&symbol_debug_info,
             "symbol debug backpatch info");
     }
             sizeof(symboldebuginfo), 6400, (void**)&symbol_debug_info,
             "symbol debug backpatch info");
     }

+    
+    initialise_memory_list(&temp_symbol_buf_memlist,
+        sizeof(char), 64, (void**)&temp_symbol_buf,
+        "temporary symbol name");
+        

     start_of_list = my_calloc(sizeof(int32), HASH_TAB_SIZE,
                      "hash code list beginnings");
 
     start_of_list = my_calloc(sizeof(int32), HASH_TAB_SIZE,
                      "hash code list beginnings");
 


@@ -1634,6 +1692,8 @@ extern void symbols_free_arrays(void)
     {
         deallocate_memory_list(&symbol_debug_info_memlist);
     }
     {
         deallocate_memory_list(&symbol_debug_info_memlist);
     }

+    deallocate_memory_list(&temp_symbol_buf_memlist);
+    

     my_free(&start_of_list, "hash code list beginnings");
 
     if (symbol_replacements)
     my_free(&start_of_list, "hash code list beginnings");
 
     if (symbol_replacements)

diff --git a/src/syntax.c b/src/syntax.c
index ad7e121e62ffa0d2f83519fdb52016564b6b1d56..cae1bc47a087d2ee6aa7bedc7ba4d525dd865f81 100644 (file)
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -1,8 +1,8 @@
 /* ------------------------------------------------------------------------- */
 /*   "syntax" : Syntax analyser and compiler                                 */
 /*                                                                           */
 /* ------------------------------------------------------------------------- */
 /*   "syntax" : Syntax analyser and compiler                                 */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -86,10 +86,12 @@ extern void get_next_token_with_directives(void)
        Object, where we want to support internal #ifdefs. (Although
        function-parsing predates this and doesn't make use of it.) */
 
        Object, where we want to support internal #ifdefs. (Although
        function-parsing predates this and doesn't make use of it.) */
 

-    int directives_save, segment_markers_save, statements_save;
-

     while (TRUE)
     {
     while (TRUE)
     {

+        int directives_save, segment_markers_save, statements_save,
+            conditions_save, local_variables_save, misc_keywords_save,
+            system_functions_save;
+

         get_next_token();
 
         /* If the first token is not a '#', return it directly. */
         get_next_token();
 
         /* If the first token is not a '#', return it directly. */


@@ -100,6 +102,10 @@ extern void get_next_token_with_directives(void)
         directives_save = directives.enabled;
         segment_markers_save = segment_markers.enabled;
         statements_save = statements.enabled;
         directives_save = directives.enabled;
         segment_markers_save = segment_markers.enabled;
         statements_save = statements.enabled;

+        conditions_save = conditions.enabled;
+        local_variables_save = local_variables.enabled;
+        misc_keywords_save = misc_keywords.enabled;
+        system_functions_save = system_functions.enabled;

 
         directives.enabled = TRUE;
         segment_markers.enabled = FALSE;
 
         directives.enabled = TRUE;
         segment_markers.enabled = FALSE;


@@ -119,22 +125,19 @@ extern void get_next_token_with_directives(void)
         if (token_type == DIRECTIVE_TT)
             parse_given_directive(TRUE);
         else
         if (token_type == DIRECTIVE_TT)
             parse_given_directive(TRUE);
         else

-        {   ebf_error("directive", token_text);
+        {   ebf_curtoken_error("directive");

             return;
         }
 
             return;
         }
 

-        /* Restore all the lexer flags. (We are squashing several of them
-           into a single save variable, which I think is safe because that's
-           what CKnight did.)
-        */
+        /* Restore all the lexer flags. */

         directive_keywords.enabled = FALSE;
         directives.enabled = directives_save;
         segment_markers.enabled = segment_markers_save;
         directive_keywords.enabled = FALSE;
         directives.enabled = directives_save;
         segment_markers.enabled = segment_markers_save;

-        statements.enabled =
-            conditions.enabled =
-            local_variables.enabled =
-            misc_keywords.enabled = 
-            system_functions.enabled = statements_save;
+        statements.enabled = statements_save;
+        conditions.enabled = conditions_save;
+        local_variables.enabled = local_variables_save;
+        misc_keywords.enabled = misc_keywords_save; 
+        system_functions.enabled = system_functions_save;

     }
 }
 
     }
 }
 


@@ -186,7 +189,7 @@ extern int parse_directive(int internal_flag)
         get_next_token();
         df_dont_note_global_symbols = FALSE;
         if (token_type != SYMBOL_TT)
         get_next_token();
         df_dont_note_global_symbols = FALSE;
         if (token_type != SYMBOL_TT)

-        {   ebf_error("routine name", token_text);
+        {   ebf_curtoken_error("routine name");

             return(FALSE);
         }
         if ((!(symbols[token_value].flags & UNKNOWN_SFLAG))
             return(FALSE);
         }
         if ((!(symbols[token_value].flags & UNKNOWN_SFLAG))


@@ -236,7 +239,7 @@ extern int parse_directive(int internal_flag)
 
         get_next_token();
         if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
 
         get_next_token();
         if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))

-        {   ebf_error("';' after ']'", token_text);
+        {   ebf_curtoken_error("';' after ']'");

             put_token_back();
         }
         return TRUE;
             put_token_back();
         }
         return TRUE;


@@ -256,9 +259,9 @@ extern int parse_directive(int internal_flag)
     {   /* If we're internal, we expect only a directive here. If
            we're top-level, the possibilities are broader. */
         if (internal_flag)
     {   /* If we're internal, we expect only a directive here. If
            we're top-level, the possibilities are broader. */
         if (internal_flag)

-            ebf_error("directive", token_text);
+            ebf_curtoken_error("directive");

         else
         else

-            ebf_error("directive, '[' or class name", token_text);
+            ebf_curtoken_error("directive, '[' or class name");

         panic_mode_error_recovery();
         return TRUE;
     }
         panic_mode_error_recovery();
         return TRUE;
     }


@@ -266,7 +269,9 @@ extern int parse_directive(int internal_flag)
     return !(parse_given_directive(internal_flag));
 }
 
     return !(parse_given_directive(internal_flag));
 }
 

-/* Check what's coming up after a switch case value. */
+/* Check what's coming up after a switch case value.
+   (This is "switch sign" in the sense of "worm sign", not like a signed
+   variable.) */

 static int switch_sign(void)
 {
     if ((token_type == SEP_TT)&&(token_value == COLON_SEP))   return 1;
 static int switch_sign(void)
 {
     if ((token_type == SEP_TT)&&(token_value == COLON_SEP))   return 1;


@@ -323,17 +328,18 @@ static void compile_alternatives(assembly_operand switch_value, int n,
     compile_alternatives_g(switch_value, n, stack_level, label, flag);
 }
 
     compile_alternatives_g(switch_value, n, stack_level, label, flag);
 }
 

+static void generate_switch_spec(assembly_operand switch_value, int label, int label_after, int speccount);
+

 static void parse_switch_spec(assembly_operand switch_value, int label,
     int action_switch)
 {
 static void parse_switch_spec(assembly_operand switch_value, int label,
     int action_switch)
 {

-    int i, j, label_after = -1, spec_sp = 0;
-    int max_equality_args = ((!glulx_mode) ? 3 : 1);
+    int label_after = -1, spec_sp = 0;

 
     sequence_point_follows = FALSE;
 
     do
     {   if (spec_sp >= MAX_SPEC_STACK)
 
     sequence_point_follows = FALSE;
 
     do
     {   if (spec_sp >= MAX_SPEC_STACK)

-        {   error("At most 32 values can be given in a single 'switch' case");
+        {   error_fmt("At most %d values can be given in a single 'switch' case", MAX_SPEC_STACK);

             panic_mode_error_recovery();
             return;
         }
             panic_mode_error_recovery();
             return;
         }


@@ -341,19 +347,20 @@ static void parse_switch_spec(assembly_operand switch_value, int label,
         if (action_switch)
         {   get_next_token();
             if (token_type == SQ_TT || token_type == DQ_TT) {
         if (action_switch)
         {   get_next_token();
             if (token_type == SQ_TT || token_type == DQ_TT) {

-                ebf_error("action (or fake action) name", token_text);
+                ebf_curtoken_error("action (or fake action) name");

                 continue;
             }
             spec_stack[spec_sp] = action_of_name(token_text);
 
             if (spec_stack[spec_sp].value == -1)
             {   spec_stack[spec_sp].value = 0;
                 continue;
             }
             spec_stack[spec_sp] = action_of_name(token_text);
 
             if (spec_stack[spec_sp].value == -1)
             {   spec_stack[spec_sp].value = 0;

-                ebf_error("action (or fake action) name", token_text);
+                ebf_curtoken_error("action (or fake action) name");

             }
         }
             }
         }

-        else
+        else {

             spec_stack[spec_sp] =
       code_generate(parse_expression(CONSTANT_CONTEXT), CONSTANT_CONTEXT, -1);
             spec_stack[spec_sp] =
       code_generate(parse_expression(CONSTANT_CONTEXT), CONSTANT_CONTEXT, -1);

+        }

 
         misc_keywords.enabled = TRUE;
         get_next_token();
 
         misc_keywords.enabled = TRUE;
         get_next_token();


@@ -363,75 +370,86 @@ static void parse_switch_spec(assembly_operand switch_value, int label,
         switch(spec_type[spec_sp-1])
         {   case 0:
                 if (action_switch)
         switch(spec_type[spec_sp-1])
         {   case 0:
                 if (action_switch)

-                    ebf_error("',' or ':'", token_text);
-                else ebf_error("',', ':' or 'to'", token_text);
+                    ebf_curtoken_error("',' or ':'");
+                else ebf_curtoken_error("',', ':' or 'to'");

                 panic_mode_error_recovery();
                 return;
             case 1: goto GenSpecCode;
             case 3: if (label_after == -1) label_after = next_label++;
         }
                 panic_mode_error_recovery();
                 return;
             case 1: goto GenSpecCode;
             case 3: if (label_after == -1) label_after = next_label++;
         }

-     } while(TRUE);
-
-     GenSpecCode:
-
-     if ((spec_sp > max_equality_args) && (label_after == -1))
-         label_after = next_label++;
-
-     if (label_after == -1)
-     {   compile_alternatives(switch_value, spec_sp, 0, label, FALSE); return;
-     }
-
-     for (i=0; i<spec_sp;)
-     {
-         j=i; while ((j<spec_sp) && (spec_type[j] != 3)) j++;
-
-         if (j > i)
-         {   if (j-i > max_equality_args) j=i+max_equality_args;
-
-             if (j == spec_sp)
-                 compile_alternatives(switch_value, j-i, i, label, FALSE);
-             else
-                 compile_alternatives(switch_value, j-i, i, label_after, TRUE);
-
-             i=j;
-         }
-         else
-         {   
-           if (!glulx_mode) {
-             if (i == spec_sp - 2)
-             {   assemblez_2_branch(jl_zc, switch_value, spec_stack[i],
-                     label, TRUE);
-                 assemblez_2_branch(jg_zc, switch_value, spec_stack[i+1],
-                     label, TRUE);
-             }
-             else
-             {   assemblez_2_branch(jl_zc, switch_value, spec_stack[i],
-                     next_label, TRUE);
-                 assemblez_2_branch(jg_zc, switch_value, spec_stack[i+1],
-                     label_after, FALSE);
-                 assemble_label_no(next_label++);
-             }
-           }
-           else {
-             if (i == spec_sp - 2)
-             {   assembleg_2_branch(jlt_gc, switch_value, spec_stack[i],
-                     label);
-                 assembleg_2_branch(jgt_gc, switch_value, spec_stack[i+1],
-                     label);
-             }
-             else
-             {   assembleg_2_branch(jlt_gc, switch_value, spec_stack[i],
-                     next_label);
-                 assembleg_2_branch(jle_gc, switch_value, spec_stack[i+1],
-                     label_after);
-                 assemble_label_no(next_label++);
-             }
-           }
-           i = i+2;
-         }
-     }
-
-     assemble_label_no(label_after);
+    } while(TRUE);
+
+ GenSpecCode:
+    generate_switch_spec(switch_value, label, label_after, spec_sp);
+}
+
+/* Generate code for a switch case. The case values are in spec_stack[]
+   and spec_type[]. */
+static void generate_switch_spec(assembly_operand switch_value, int label, int label_after, int speccount)
+{
+    int i, j;
+    int max_equality_args = ((!glulx_mode) ? 3 : 1);
+
+    sequence_point_follows = FALSE;
+
+    if ((speccount > max_equality_args) && (label_after == -1))
+        label_after = next_label++;
+
+    if (label_after == -1)
+    {   compile_alternatives(switch_value, speccount, 0, label, FALSE); return;
+    }
+
+    for (i=0; i<speccount;)
+    {
+        j=i; while ((j<speccount) && (spec_type[j] != 3)) j++;
+
+        if (j > i)
+        {   if (j-i > max_equality_args) j=i+max_equality_args;
+
+            if (j == speccount)
+                compile_alternatives(switch_value, j-i, i, label, FALSE);
+            else
+                compile_alternatives(switch_value, j-i, i, label_after, TRUE);
+
+            i=j;
+        }
+        else
+        {   
+          if (!glulx_mode) {
+            if (i == speccount - 2)
+            {   assemblez_2_branch(jl_zc, switch_value, spec_stack[i],
+                    label, TRUE);
+                assemblez_2_branch(jg_zc, switch_value, spec_stack[i+1],
+                    label, TRUE);
+            }
+            else
+            {   assemblez_2_branch(jl_zc, switch_value, spec_stack[i],
+                    next_label, TRUE);
+                assemblez_2_branch(jg_zc, switch_value, spec_stack[i+1],
+                    label_after, FALSE);
+                assemble_label_no(next_label++);
+            }
+          }
+          else {
+            if (i == speccount - 2)
+            {   assembleg_2_branch(jlt_gc, switch_value, spec_stack[i],
+                    label);
+                assembleg_2_branch(jgt_gc, switch_value, spec_stack[i+1],
+                    label);
+            }
+            else
+            {   assembleg_2_branch(jlt_gc, switch_value, spec_stack[i],
+                    next_label);
+                assembleg_2_branch(jle_gc, switch_value, spec_stack[i+1],
+                    label_after);
+                assemble_label_no(next_label++);
+            }
+          }
+          i = i+2;
+        }
+    }
+
+    assemble_label_no(label_after);

 }
 
 extern int32 parse_routine(char *source, int embedded_flag, char *name,
 }
 
 extern int32 parse_routine(char *source, int embedded_flag, char *name,


@@ -450,10 +468,7 @@ extern int32 parse_routine(char *source, int embedded_flag, char *name,
         restart_lexer(lexical_source, name);
     }
 
         restart_lexer(lexical_source, name);
     }
 

-    no_locals = 0;
-
-    for (i=0;i<MAX_LOCAL_VARIABLES-1;i++)
-        local_variable_names[i].text[0] = 0;
+    clear_local_variables();

 
     do
     {   statements.enabled = TRUE;
 
     do
     {   statements.enabled = TRUE;


@@ -465,32 +480,26 @@ extern int32 parse_routine(char *source, int embedded_flag, char *name,
         {   debug_flag = TRUE; continue;
         }
 
         {   debug_flag = TRUE; continue;
         }
 

-        if (token_type != DQ_TT)
+        if (token_type != UQ_TT)

         {   if ((token_type == SEP_TT)
                 && (token_value == SEMICOLON_SEP)) break;
         {   if ((token_type == SEP_TT)
                 && (token_value == SEMICOLON_SEP)) break;

-            ebf_error("local variable name or ';'", token_text);
-            panic_mode_error_recovery();
-            break;
-        }
-
-        if (strlen(token_text) > MAX_IDENTIFIER_LENGTH)
-        {   error_named("Local variable identifier too long:", token_text);
+            ebf_curtoken_error("local variable name or ';'");

             panic_mode_error_recovery();
             break;
         }
 
         if (no_locals == MAX_LOCAL_VARIABLES-1)
             panic_mode_error_recovery();
             break;
         }
 
         if (no_locals == MAX_LOCAL_VARIABLES-1)

-        {   error_numbered("Too many local variables for a routine; max is",
+        {   error_fmt("Too many local variables for a routine; max is %d",

                 MAX_LOCAL_VARIABLES-1);
             panic_mode_error_recovery();
             break;
         }
 
         for (i=0;i<no_locals;i++) {
                 MAX_LOCAL_VARIABLES-1);
             panic_mode_error_recovery();
             break;
         }
 
         for (i=0;i<no_locals;i++) {

-            if (strcmpcis(token_text, local_variable_names[i].text)==0)
+            if (strcmpcis(token_text, get_local_variable_name(i))==0)

                 error_named("Local variable defined twice:", token_text);
         }
                 error_named("Local variable defined twice:", token_text);
         }

-        strcpy(local_variable_names[no_locals++].text, token_text);
+        add_local_variable(token_text);

     } while(TRUE);
 
     /* Set up the local variable hash and the local_variables.keywords
     } while(TRUE);
 
     /* Set up the local variable hash and the local_variables.keywords


@@ -504,7 +513,7 @@ extern int32 parse_routine(char *source, int embedded_flag, char *name,
     if ((embedded_flag == FALSE) && (veneer_mode == FALSE) && debug_flag)
         symbols[r_symbol].flags |= STAR_SFLAG;
 
     if ((embedded_flag == FALSE) && (veneer_mode == FALSE) && debug_flag)
         symbols[r_symbol].flags |= STAR_SFLAG;
 

-    packed_address = assemble_routine_header(no_locals, debug_flag,
+    packed_address = assemble_routine_header(debug_flag,

         name, embedded_flag, r_symbol);
 
     do
         name, embedded_flag, r_symbol);
 
     do


@@ -513,7 +522,7 @@ extern int32 parse_routine(char *source, int embedded_flag, char *name,
         get_next_token();
 
         if (token_type == EOF_TT)
         get_next_token();
 
         if (token_type == EOF_TT)

-        {   ebf_error("']'", token_text);
+        {   ebf_curtoken_error("']'");

             assemble_routine_end
                 (embedded_flag,
                  get_token_location_end(beginning_debug_location));
             assemble_routine_end
                 (embedded_flag,
                  get_token_location_end(beginning_debug_location));


@@ -556,7 +565,7 @@ extern int32 parse_routine(char *source, int embedded_flag, char *name,
             get_next_token();
             if ((token_type == SEP_TT) &&
                 (token_value == COLON_SEP)) continue;
             get_next_token();
             if ((token_type == SEP_TT) &&
                 (token_value == COLON_SEP)) continue;

-            ebf_error("':' after 'default'", token_text);
+            ebf_curtoken_error("':' after 'default'");

             panic_mode_error_recovery();
             continue;
         }
             panic_mode_error_recovery();
             continue;
         }


@@ -564,7 +573,9 @@ extern int32 parse_routine(char *source, int embedded_flag, char *name,
         /*  Only check for the form of a case switch if the initial token
             isn't double-quoted text, as that would mean it was a print_ret
             statement: this is a mild ambiguity in the grammar. 
         /*  Only check for the form of a case switch if the initial token
             isn't double-quoted text, as that would mean it was a print_ret
             statement: this is a mild ambiguity in the grammar. 

-            Action statements also cannot be cases. */
+            Action statements also cannot be cases.
+            We don't try to handle parenthesized expressions as cases
+            at the top level. */

 
         if ((token_type != DQ_TT) && (token_type != SEP_TT))
         {   get_next_token();
 
         if ((token_type != DQ_TT) && (token_type != SEP_TT))
         {   get_next_token();


@@ -654,7 +665,7 @@ extern void parse_code_block(int break_label, int continue_label,
                 break;
             }
             if (token_type == EOF_TT)
                 break;
             }
             if (token_type == EOF_TT)

-            {   ebf_error("'}'", token_text);
+            {   ebf_curtoken_error("'}'");

                 break;
             }
 
                 break;
             }
 


@@ -679,7 +690,7 @@ extern void parse_code_block(int break_label, int continue_label,
                     get_next_token();
                     if ((token_type == SEP_TT) &&
                         (token_value == COLON_SEP)) continue;
                     get_next_token();
                     if ((token_type == SEP_TT) &&
                         (token_value == COLON_SEP)) continue;

-                    ebf_error("':' after 'default'", token_text);
+                    ebf_curtoken_error("':' after 'default'");

                     panic_mode_error_recovery();
                     continue;
                 }
                     panic_mode_error_recovery();
                     continue;
                 }


@@ -687,8 +698,76 @@ extern void parse_code_block(int break_label, int continue_label,
                 /*  Decide: is this an ordinary statement, or the start
                     of a new case?  */
 
                 /*  Decide: is this an ordinary statement, or the start
                     of a new case?  */
 

+                /*  Again, double-quoted text is a print_ret statement. */

                 if (token_type == DQ_TT) goto NotASwitchCase;
 
                 if (token_type == DQ_TT) goto NotASwitchCase;
 

+                if ((token_type == SEP_TT)&&(token_value == OPENB_SEP)) {
+                    /* An open-paren means we need to parse a full
+                       expression. */
+                    assembly_operand AO;
+                    int constcount;
+                    put_token_back();
+                    AO = parse_expression(VOID_CONTEXT);
+                    /* If this expression is followed by a colon, we'll
+                       handle it as a switch case. */
+                    constcount = test_constant_op_list(&AO, spec_stack, MAX_SPEC_STACK);
+                    if ((token_type == SEP_TT)&&(token_value == COLON_SEP)) {
+                        int ix;
+
+                        if (!constcount)
+                        {
+                            ebf_error("constant", "<expression>");
+                            panic_mode_error_recovery();
+                            continue;
+                        }
+
+                        if (constcount > MAX_SPEC_STACK)
+                        {   error_fmt("At most %d values can be given in a single 'switch' case", MAX_SPEC_STACK);
+                            panic_mode_error_recovery();
+                            continue;
+                        }
+
+                        get_next_token();
+                        /* Gotta fill in the spec_type values for the
+                           spec_stacks. */
+                        for (ix=0; ix<constcount-1; ix++)
+                            spec_type[ix] = 2; /* comma */
+                        spec_type[constcount-1] = 1; /* colon */
+                        
+                        /* The rest of this is parallel to the
+                           parse_switch_spec() case below. */
+                        /* Before you ask: yes, the spec_stacks values
+                           appear in the reverse order from how
+                           parse_switch_spec() would do it. The results
+                           are the same because we're just comparing
+                           temp_var1 with a bunch of constants. */
+                        if (default_clause_made)
+                            error("'default' must be the last 'switch' case");
+                        
+                        if (switch_clause_made)
+                        {   if (!execution_never_reaches_here)
+                                {   sequence_point_follows = FALSE;
+                                    assemble_jump(break_label);
+                                }
+                            assemble_label_no(switch_label);
+                        }
+                        
+                        switch_label = next_label++;
+                        switch_clause_made = TRUE;
+                        
+                        AO = temp_var1;
+                        generate_switch_spec(AO, switch_label, -1, constcount);
+                        continue;
+                    }
+                    
+                    /* Otherwise, treat this as a statement. Imagine
+                       we've jumped down to NotASwitchCase, except that
+                       we have the expression AO already parsed. */
+                    sequence_point_follows = TRUE;
+                    parse_statement_singleexpr(AO);
+                    continue;
+                }
+

                 unary_minus_flag
                     = ((token_type == SEP_TT)&&(token_value == MINUS_SEP));
                 if (unary_minus_flag) get_next_token();
                 unary_minus_flag
                     = ((token_type == SEP_TT)&&(token_value == MINUS_SEP));
                 if (unary_minus_flag) get_next_token();


@@ -731,7 +810,7 @@ extern void parse_code_block(int break_label, int continue_label,
             }
 
             if ((switch_rule != 0) && (!switch_clause_made))
             }
 
             if ((switch_rule != 0) && (!switch_clause_made))

-                ebf_error("switch value", token_text);
+                ebf_curtoken_error("switch value");

 
             NotASwitchCase:
             sequence_point_follows = TRUE;
 
             NotASwitchCase:
             sequence_point_follows = TRUE;


@@ -741,7 +820,7 @@ extern void parse_code_block(int break_label, int continue_label,
     }
     else {
         if (switch_rule != 0)
     }
     else {
         if (switch_rule != 0)

-            ebf_error("braced code block after 'switch'", token_text);
+            ebf_curtoken_error("braced code block after 'switch'");

         
         /* Parse a single statement. */
         parse_statement(break_label, continue_label);
         
         /* Parse a single statement. */
         parse_statement(break_label, continue_label);

diff --git a/src/tables.c b/src/tables.c
index 505b1e6b6559fe728bbd5401546ecb2244d96e05..cea36903917e88d891b400be50c77f0e1c0d6f18 100644 (file)
--- a/src/tables.c
+++ b/src/tables.c
@@ -3,8 +3,8 @@
 /*               of dynamic memory, gluing together all the required         */
 /*               tables.                                                     */
 /*                                                                           */
 /*               of dynamic memory, gluing together all the required         */
 /*               tables.                                                     */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -112,17 +112,23 @@ extern void write_serial_number(char *buffer)
         the ability to work out today's date                                 */
 
     time_t tt;  tt=time(0);
         the ability to work out today's date                                 */
 
     time_t tt;  tt=time(0);

-    if (serial_code_given_in_program)
+    if (serial_code_given_in_program) {

         strcpy(buffer, serial_code_buffer);
         strcpy(buffer, serial_code_buffer);

-    else
+    }
+    else {

 #ifdef TIME_UNAVAILABLE
         sprintf(buffer,"970000");
 #else
 #ifdef TIME_UNAVAILABLE
         sprintf(buffer,"970000");
 #else

-        strftime(buffer,10,"%y%m%d",localtime(&tt));
+        /* Write a six-digit date, null-terminated. Fall back to "970000"
+           if that fails. */
+        int len = strftime(buffer,7,"%y%m%d",localtime(&tt));
+        if (len != 6)
+            sprintf(buffer,"970000");

 #endif
 #endif

+    }

 }
 
 }
 

-static char percentage_buffer[32];
+static char percentage_buffer[64];

 
 static char *show_percentage(int32 x, int32 total)
 {
 
 static char *show_percentage(int32 x, int32 total)
 {


@@ -132,9 +138,12 @@ static char *show_percentage(int32 x, int32 total)
     else if (x == 0) {
         sprintf(percentage_buffer, "  ( --- )");
     }
     else if (x == 0) {
         sprintf(percentage_buffer, "  ( --- )");
     }

-    else {
+    else if (memory_map_setting < 3) {

         sprintf(percentage_buffer, "  (%.1f %%)", (float)x * 100.0 / (float)total);
     }
         sprintf(percentage_buffer, "  (%.1f %%)", (float)x * 100.0 / (float)total);
     }

+    else {
+        sprintf(percentage_buffer, "  (%.1f %%, %d bytes)", (float)x * 100.0 / (float)total, x);
+    }

     return percentage_buffer;
 }
 
     return percentage_buffer;
 }
 


@@ -146,6 +155,7 @@ static char *version_name(int v)
         case 4: return "Plus";
         case 5: return "Advanced";
         case 6: return "Graphical";
         case 4: return "Plus";
         case 5: return "Advanced";
         case 6: return "Graphical";

+        case 7: return "Extended Alternate";

         case 8: return "Extended";
     }
     return "experimental format";
         case 8: return "Extended";
     }
     return "experimental format";


@@ -263,31 +273,34 @@ static void construct_storyfile_z(void)
           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;
           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;

+    int32 rough_size;

     int skip_backpatching = FALSE;
     char *output_called = "story file";
 
     ASSERT_ZCODE();
 
     int skip_backpatching = FALSE;
     char *output_called = "story file";
 
     ASSERT_ZCODE();
 

-    individual_name_strings =
-        my_calloc(sizeof(int32), no_individual_properties,
-            "identifier name strings");
-    action_name_strings =
-        my_calloc(sizeof(int32), no_actions + no_fake_actions,
-            "action name strings");
-    attribute_name_strings =
-        my_calloc(sizeof(int32), 48,
-            "attribute name strings");
-    array_name_strings =
-        my_calloc(sizeof(int32),
-            no_symbols,
-            "array name strings");
+    if (!OMIT_SYMBOL_TABLE) {
+        individual_name_strings =
+            my_calloc(sizeof(int32), no_individual_properties,
+                      "identifier name strings");
+        action_name_strings =
+            my_calloc(sizeof(int32), no_actions + no_fake_actions,
+                      "action name strings");
+        attribute_name_strings =
+            my_calloc(sizeof(int32), 48,
+                      "attribute name strings");
+        array_name_strings =
+            my_calloc(sizeof(int32),
+                      no_symbols,
+                      "array name strings");

 
 

-    write_the_identifier_names();
+        write_the_identifier_names();
+    }

 
     /*  We now know how large the buffer to hold our construction has to be  */
 
 
     /*  We now know how large the buffer to hold our construction has to be  */
 

-    zmachine_paged_memory = my_malloc(rough_size_of_paged_memory_z(),
-        "output buffer");
+    rough_size = rough_size_of_paged_memory_z();
+    zmachine_paged_memory = my_malloc(rough_size, "output buffer");

 
     /*  Foolish code to make this routine compile on all ANSI compilers      */
 
 
     /*  Foolish code to make this routine compile on all ANSI compilers      */
 


@@ -297,7 +310,8 @@ static void construct_storyfile_z(void)
         points its value will be recorded for milestones like
         "dictionary table start".  It begins at 0x40, just after the header  */
 
         points its value will be recorded for milestones like
         "dictionary table start".  It begins at 0x40, just after the header  */
 

-    mark = 0x40;
+    for (mark=0; mark<0x40; mark++)
+        p[mark] = 0x0;

 
     /*  ----------------- Low Strings and Abbreviations -------------------- */
 
 
     /*  ----------------- Low Strings and Abbreviations -------------------- */
 


@@ -444,7 +458,7 @@ static void construct_storyfile_z(void)
 
     identifier_names_offset = mark;
 
 
     identifier_names_offset = mark;
 

-    if (TRUE)
+    if (!OMIT_SYMBOL_TABLE)

     {   p[mark++] = no_individual_properties/256;
         p[mark++] = no_individual_properties%256;
         for (i=1; i<no_individual_properties; i++)
     {   p[mark++] = no_individual_properties/256;
         p[mark++] = no_individual_properties%256;
         for (i=1; i<no_individual_properties; i++)


@@ -478,6 +492,17 @@ static void construct_storyfile_z(void)
 
         id_names_length = (mark - identifier_names_offset)/2;
     }
 
         id_names_length = (mark - identifier_names_offset)/2;
     }

+    else {
+        attribute_names_offset = mark;
+        action_names_offset = mark;
+        fake_action_names_offset = mark;
+        array_names_offset = mark;
+        global_names_offset = mark;
+        routine_names_offset = mark;
+        constant_names_offset = mark;
+        id_names_length = 0;
+    }
+    

     routine_flags_array_offset = mark;
 
     if (define_INFIX_switch)
     routine_flags_array_offset = mark;
 
     if (define_INFIX_switch)


@@ -530,6 +555,12 @@ table format requested (producing number 2 format instead)");
     for (i=0; i<no_Inform_verbs; i++)
     {   p[grammar_table_at + i*2] = (mark/256);
         p[grammar_table_at + i*2 + 1] = (mark%256);
     for (i=0; i<no_Inform_verbs; i++)
     {   p[grammar_table_at + i*2] = (mark/256);
         p[grammar_table_at + i*2 + 1] = (mark%256);

+        if (!Inform_verbs[i].used) {
+            /* This verb was marked unused at locate_dead_grammar_lines()
+               time. Omit the grammar lines. */
+            p[mark++] = 0;
+            continue;
+        }

         p[mark++] = Inform_verbs[i].lines;
         for (j=0; j<Inform_verbs[i].lines; j++)
         {   k = Inform_verbs[i].l[j];
         p[mark++] = Inform_verbs[i].lines;
         for (j=0; j<Inform_verbs[i].lines; j++)
         {   k = Inform_verbs[i].l[j];


@@ -650,9 +681,12 @@ or less.");
     }
 
     /*  -------------------------- Code Area ------------------------------- */
     }
 
     /*  -------------------------- Code Area ------------------------------- */

-    /*  (From this point on we don't write any more into the "p" buffer.)    */
+    /*  (From this point on we don't write any higher into the "p" buffer.)  */

     /*  -------------------------------------------------------------------- */
 
     /*  -------------------------------------------------------------------- */
 

+    if (mark > rough_size)
+        compiler_error("Paged size exceeds rough estimate.");
+

     Write_Code_At = mark;
     if (!OMIT_UNUSED_ROUTINES) {
         code_length = zmachine_pc;
     Write_Code_At = mark;
     if (!OMIT_UNUSED_ROUTINES) {
         code_length = zmachine_pc;


@@ -697,11 +731,10 @@ or less.");
     }
 
     if (excess > 0)
     }
 
     if (excess > 0)

-    {   char memory_full_error[80];
-        sprintf(memory_full_error,
+    {
+        fatalerror_fmt(

             "The %s exceeds version-%d limit (%dK) by %d bytes",
              output_called, version_number, limit, excess);
             "The %s exceeds version-%d limit (%dK) by %d bytes",
              output_called, version_number, limit, excess);

-        fatalerror(memory_full_error);

     }
 
     /*  --------------------------- Offsets -------------------------------- */
     }
 
     /*  --------------------------- Offsets -------------------------------- */


@@ -735,26 +768,24 @@ or less.");
          */
         excess = code_length + code_offset - (scale_factor*((int32) 0x10000L));
         if (excess > 0)
          */
         excess = code_length + code_offset - (scale_factor*((int32) 0x10000L));
         if (excess > 0)

-        {   char code_full_error[80];
-            sprintf(code_full_error,
+        {
+            fatalerror_fmt(

                 "The code area limit has been exceeded by %d bytes",
                  excess);
                 "The code area limit has been exceeded by %d bytes",
                  excess);

-            fatalerror(code_full_error);

         }
 
         excess = strings_length + strings_offset - (scale_factor*((int32) 0x10000L));
         if (excess > 0)
         }
 
         excess = strings_length + strings_offset - (scale_factor*((int32) 0x10000L));
         if (excess > 0)

-        {   char strings_full_error[140];
+        {

             if (oddeven_packing_switch)
             if (oddeven_packing_switch)

-                sprintf(strings_full_error,
+                fatalerror_fmt(

                     "The strings area limit has been exceeded by %d bytes",
                      excess);
             else
                     "The strings area limit has been exceeded by %d bytes",
                      excess);
             else

-                sprintf(strings_full_error,
+                fatalerror_fmt(

                     "The code+strings area limit has been exceeded by %d bytes. \
  Try running Inform again with -B on the command line.",
                      excess);
                     "The code+strings area limit has been exceeded by %d bytes. \
  Try running Inform again with -B on the command line.",
                      excess);

-            fatalerror(strings_full_error);

         }
     }
     else
         }
     }
     else


@@ -848,12 +879,15 @@ or less.");
 
     if (!skip_backpatching)
     {   backpatch_zmachine_image_z();
 
     if (!skip_backpatching)
     {   backpatch_zmachine_image_z();

-        for (i=1; i<id_names_length; i++)
-        {   int32 v = 256*p[identifier_names_offset + i*2]
-                      + p[identifier_names_offset + i*2 + 1];
-            if (v!=0) v += strings_offset/scale_factor;
-            p[identifier_names_offset + i*2] = v/256;
-            p[identifier_names_offset + i*2 + 1] = v%256;
+
+        if (!OMIT_SYMBOL_TABLE) {
+            for (i=1; i<id_names_length; i++)
+            {   int32 v = 256*p[identifier_names_offset + i*2]
+                    + p[identifier_names_offset + i*2 + 1];
+                if (v!=0) v += strings_offset/scale_factor;
+                p[identifier_names_offset + i*2] = v/256;
+                p[identifier_names_offset + i*2 + 1] = v%256;
+            }

         }
 
         mark = actions_at;
         }
 
         mark = actions_at;


@@ -1042,6 +1076,7 @@ static void construct_storyfile_g(void)
           abbrevs_at, prop_defaults_at, object_tree_at, object_props_at,
           grammar_table_at, arrays_at, static_arrays_at;
     int32 threespaces, code_length;
           abbrevs_at, prop_defaults_at, object_tree_at, object_props_at,
           grammar_table_at, arrays_at, static_arrays_at;
     int32 threespaces, code_length;

+    int32 rough_size;

 
     ASSERT_GLULX();
 
 
     ASSERT_GLULX();
 


@@ -1066,8 +1101,8 @@ static void construct_storyfile_g(void)
 
     /*  We now know how large the buffer to hold our construction has to be  */
 
 
     /*  We now know how large the buffer to hold our construction has to be  */
 

-    zmachine_paged_memory = my_malloc(rough_size_of_paged_memory_g(),
-        "output buffer");
+    rough_size = rough_size_of_paged_memory_g();
+    zmachine_paged_memory = my_malloc(rough_size, "output buffer");

 
     /*  Foolish code to make this routine compile on all ANSI compilers      */
 
 
     /*  Foolish code to make this routine compile on all ANSI compilers      */
 


@@ -1246,63 +1281,71 @@ static void construct_storyfile_g(void)
        number of actions
     */
 
        number of actions
     */
 

-    identifier_names_offset = mark;
-    mark += 32; /* eight pairs of values, to be filled in. */
-
-    WriteInt32(p+identifier_names_offset+0, Write_RAM_At + mark);
-    WriteInt32(p+identifier_names_offset+4, no_properties);
-    for (i=0; i<no_properties; i++) {
-      j = individual_name_strings[i];
-      if (j)
-        j = Write_Strings_At + compressed_offsets[j-1];
-      WriteInt32(p+mark, j);
-      mark += 4;
-    }
-
-    WriteInt32(p+identifier_names_offset+8, Write_RAM_At + mark);
-    WriteInt32(p+identifier_names_offset+12, 
-      no_individual_properties-INDIV_PROP_START);
-    for (i=INDIV_PROP_START; i<no_individual_properties; i++) {
-      j = individual_name_strings[i];
-      if (j)
-        j = Write_Strings_At + compressed_offsets[j-1];
-      WriteInt32(p+mark, j);
-      mark += 4;
-    }
-
-    WriteInt32(p+identifier_names_offset+16, Write_RAM_At + mark);
-    WriteInt32(p+identifier_names_offset+20, NUM_ATTR_BYTES*8);
-    for (i=0; i<NUM_ATTR_BYTES*8; i++) {
-      j = attribute_name_strings[i];
-      if (j)
-        j = Write_Strings_At + compressed_offsets[j-1];
-      WriteInt32(p+mark, j);
+    if (!OMIT_SYMBOL_TABLE) {
+      identifier_names_offset = mark;
+      mark += 32; /* eight pairs of values, to be filled in. */
+  
+      WriteInt32(p+identifier_names_offset+0, Write_RAM_At + mark);
+      WriteInt32(p+identifier_names_offset+4, no_properties);
+      for (i=0; i<no_properties; i++) {
+        j = individual_name_strings[i];
+        if (j)
+          j = Write_Strings_At + compressed_offsets[j-1];
+        WriteInt32(p+mark, j);
+        mark += 4;
+      }
+  
+      WriteInt32(p+identifier_names_offset+8, Write_RAM_At + mark);
+      WriteInt32(p+identifier_names_offset+12, 
+        no_individual_properties-INDIV_PROP_START);
+      for (i=INDIV_PROP_START; i<no_individual_properties; i++) {
+        j = individual_name_strings[i];
+        if (j)
+          j = Write_Strings_At + compressed_offsets[j-1];
+        WriteInt32(p+mark, j);
+        mark += 4;
+      }
+  
+      WriteInt32(p+identifier_names_offset+16, Write_RAM_At + mark);
+      WriteInt32(p+identifier_names_offset+20, NUM_ATTR_BYTES*8);
+      for (i=0; i<NUM_ATTR_BYTES*8; i++) {
+        j = attribute_name_strings[i];
+        if (j)
+          j = Write_Strings_At + compressed_offsets[j-1];
+        WriteInt32(p+mark, j);
+        mark += 4;
+      }
+  
+      WriteInt32(p+identifier_names_offset+24, Write_RAM_At + mark);
+      WriteInt32(p+identifier_names_offset+28, no_actions + no_fake_actions);
+      action_names_offset = mark;
+      fake_action_names_offset = mark + 4*no_actions;
+      for (i=0; i<no_actions + no_fake_actions; i++) {
+        j = action_name_strings[i];
+        if (j)
+          j = Write_Strings_At + compressed_offsets[j-1];
+        WriteInt32(p+mark, j);
+        mark += 4;
+      }
+  
+      array_names_offset = mark;
+      WriteInt32(p+mark, no_arrays);

       mark += 4;
       mark += 4;

+      for (i=0; i<no_arrays; i++) {
+        j = array_name_strings[i];
+        if (j)
+          j = Write_Strings_At + compressed_offsets[j-1];
+        WriteInt32(p+mark, j);
+        mark += 4;
+      }

     }
     }

-
-    WriteInt32(p+identifier_names_offset+24, Write_RAM_At + mark);
-    WriteInt32(p+identifier_names_offset+28, no_actions + no_fake_actions);
-    action_names_offset = mark;
-    fake_action_names_offset = mark + 4*no_actions;
-    for (i=0; i<no_actions + no_fake_actions; i++) {
-      j = action_name_strings[i];
-      if (j)
-        j = Write_Strings_At + compressed_offsets[j-1];
-      WriteInt32(p+mark, j);
-      mark += 4;
+    else {
+      identifier_names_offset = mark;
+      action_names_offset = mark;
+      fake_action_names_offset = mark;
+      array_names_offset = mark;

     }
 
     }
 

-    array_names_offset = mark;
-    WriteInt32(p+mark, no_arrays);
-    mark += 4;
-    for (i=0; i<no_arrays; i++) {
-      j = array_name_strings[i];
-      if (j)
-        j = Write_Strings_At + compressed_offsets[j-1];
-      WriteInt32(p+mark, j);
-      mark += 4;
-    }    
-

     individuals_offset = mark;
 
     /*  ------------------------ Grammar Table ----------------------------- */
     individuals_offset = mark;
 
     /*  ------------------------ Grammar Table ----------------------------- */


@@ -1323,6 +1366,12 @@ table format requested (producing number 2 format instead)");
     for (i=0; i<no_Inform_verbs; i++) {
       j = mark + Write_RAM_At;
       WriteInt32(p+(grammar_table_at+4+i*4), j);
     for (i=0; i<no_Inform_verbs; i++) {
       j = mark + Write_RAM_At;
       WriteInt32(p+(grammar_table_at+4+i*4), j);

+      if (!Inform_verbs[i].used) {
+          /* This verb was marked unused at locate_dead_grammar_lines()
+             time. Omit the grammar lines. */
+          p[mark++] = 0;
+          continue;
+      }

       p[mark++] = Inform_verbs[i].lines;
       for (j=0; j<Inform_verbs[i].lines; j++) {
         int tok;
       p[mark++] = Inform_verbs[i].lines;
       for (j=0; j<Inform_verbs[i].lines; j++) {
         int tok;


@@ -1384,6 +1433,9 @@ table format requested (producing number 2 format instead)");
 
     RAM_Size = mark;
 
 
     RAM_Size = mark;
 

+    if (RAM_Size > rough_size)
+        compiler_error("RAM size exceeds rough estimate.");
+    

     Out_Size = Write_RAM_At + RAM_Size;
 
     /*  --------------------------- Offsets -------------------------------- */
     Out_Size = Write_RAM_At + RAM_Size;
 
     /*  --------------------------- Offsets -------------------------------- */


@@ -1590,18 +1642,23 @@ static void display_frequencies()
     
     for (i=0; i<no_abbreviations; i++) {
         int32 saving;
     
     for (i=0; i<no_abbreviations; i++) {
         int32 saving;

+        char *astr;

         if (!glulx_mode)
             saving = 2*((abbreviations[i].freq-1)*abbreviations[i].quality)/3;
         else
             saving = (abbreviations[i].freq-1)*abbreviations[i].quality;
         if (!glulx_mode)
             saving = 2*((abbreviations[i].freq-1)*abbreviations[i].quality)/3;
         else
             saving = (abbreviations[i].freq-1)*abbreviations[i].quality;

+
+        astr = abbreviation_text(i);
+        /* Print the abbreviation text, left-padded to ten spaces, with
+           spaces replaced by underscores. */
+        for (j=strlen(astr); j<10; j++) {
+            putchar(' ');
+        }
+        for (j=0; astr[j]; j++) {
+            putchar(astr[j] == ' ' ? '_' : astr[j]);
+        }

         
         

-        char abbrev_string[MAX_ABBREV_LENGTH];
-        strcpy(abbrev_string,
-               (char *)abbreviations_at+i*MAX_ABBREV_LENGTH);
-        for (j=0; abbrev_string[j]!=0; j++)
-            if (abbrev_string[j]==' ') abbrev_string[j]='_';
-        
-        printf("%10s %5d/%5d   ",abbrev_string,abbreviations[i].freq, saving);
+        printf(" %5d/%5d   ", abbreviations[i].freq, saving);

         
         if ((i%3)==2) printf("\n");
     }
         
         if ((i%3)==2) printf("\n");
     }

diff --git a/src/text.c b/src/text.c
index 03d11301d6668ecb284aea2990b9d1f2ea6c892c..149f0f9a98a8ff45ea33b607c0a9deffd21b3a28 100644 (file)
--- a/src/text.c
+++ b/src/text.c
@@ -1,8 +1,8 @@
 /* ------------------------------------------------------------------------- */
 /*   "text" : Text translation, the abbreviations optimiser, the dictionary  */
 /*                                                                           */
 /* ------------------------------------------------------------------------- */
 /*   "text" : Text translation, the abbreviations optimiser, the dictionary  */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -105,11 +105,10 @@ static int unicode_entity_index(int32 unicode);
 abbreviation *abbreviations;             /* Allocated up to no_abbreviations */
 static memory_list abbreviations_memlist;
 
 abbreviation *abbreviations;             /* Allocated up to no_abbreviations */
 static memory_list abbreviations_memlist;
 

-/* Memory to hold the text of any abbreviation strings declared. This is
-   counted in units of MAX_ABBREV_LENGTH bytes. (An abbreviation must fit
-   in that many bytes, null included.)                                       */
-uchar *abbreviations_at;                 /* Allocated up to no_abbreviations */
-static memory_list abbreviations_at_memlist;
+/* Memory to hold the text of any abbreviation strings declared.             */
+static int32 abbreviations_totaltext;
+static char *abbreviations_text;  /* Allocated up to abbreviations_totaltext */
+static memory_list abbreviations_text_memlist;

 
 static int *abbreviations_optimal_parse_schedule;
 static memory_list abbreviations_optimal_parse_schedule_memlist;
 
 static int *abbreviations_optimal_parse_schedule;
 static memory_list abbreviations_optimal_parse_schedule_memlist;


@@ -137,6 +136,11 @@ uchar *translated_text;                /* Area holding translated strings
                                           static_strings_area below */
 static memory_list translated_text_memlist;
 
                                           static_strings_area below */
 static memory_list translated_text_memlist;
 

+static char *temp_symbol;              /* Temporary symbol name used while
+                                          processing "@(...)".               */
+static memory_list temp_symbol_memlist;
+
+

 static int32 text_out_pos;             /* The "program counter" during text
                                           translation: the next position to
                                           write Z-coded text output to       */
 static int32 text_out_pos;             /* The "program counter" during text
                                           translation: the next position to
                                           write Z-coded text output to       */


@@ -162,26 +166,26 @@ static int text_out_overflow;          /* During text translation, becomes
 /* ------------------------------------------------------------------------- */
 
 static void make_abbrevs_lookup(void)
 /* ------------------------------------------------------------------------- */
 
 static void make_abbrevs_lookup(void)

-{   int bubble_sort, j, k, l; char p[MAX_ABBREV_LENGTH]; char *p1, *p2;
+{   int bubble_sort, j, k;
+    char *p1, *p2;

     do
     {   bubble_sort = FALSE;
         for (j=0; j<no_abbreviations; j++)
             for (k=j+1; k<no_abbreviations; k++)
     do
     {   bubble_sort = FALSE;
         for (j=0; j<no_abbreviations; j++)
             for (k=j+1; k<no_abbreviations; k++)

-            {   p1=(char *)abbreviations_at+j*MAX_ABBREV_LENGTH;
-                p2=(char *)abbreviations_at+k*MAX_ABBREV_LENGTH;
+            {   p1=abbreviation_text(j);
+                p2=abbreviation_text(k);

                 if (strcmp(p1,p2)<0)
                 if (strcmp(p1,p2)<0)

-                {   strcpy(p,p1); strcpy(p1,p2); strcpy(p2,p);
-                    l=abbreviations[j].value; abbreviations[j].value=abbreviations[k].value;
-                    abbreviations[k].value=l;
-                    l=abbreviations[j].quality; abbreviations[j].quality=abbreviations[k].quality;
-                    abbreviations[k].quality=l;
+                {
+                    abbreviation temp = abbreviations[j];
+                    abbreviations[j] = abbreviations[k];
+                    abbreviations[k] = temp;

                     bubble_sort = TRUE;
                 }
             }
     } while (bubble_sort);
 
     for (j=no_abbreviations-1; j>=0; j--)
                     bubble_sort = TRUE;
                 }
             }
     } while (bubble_sort);
 
     for (j=no_abbreviations-1; j>=0; j--)

-    {   p1=(char *)abbreviations_at+j*MAX_ABBREV_LENGTH;
+    {   p1=abbreviation_text(j);

         abbrevs_lookup[(uchar)p1[0]]=j;
         abbreviations[j].freq=0;
     }
         abbrevs_lookup[(uchar)p1[0]]=j;
         abbreviations[j].freq=0;
     }


@@ -206,9 +210,13 @@ static void make_abbrevs_lookup(void)
 static int try_abbreviations_from(unsigned char *text, int i, int from)
 {   int j, k; uchar *p, c;
     c=text[i];
 static int try_abbreviations_from(unsigned char *text, int i, int from)
 {   int j, k; uchar *p, c;
     c=text[i];

-    for (j=from, p=(uchar *)abbreviations_at+from*MAX_ABBREV_LENGTH;
-         (j<no_abbreviations)&&(c==p[0]); j++, p+=MAX_ABBREV_LENGTH)
-    {   if (text[i+1]==p[1])
+    for (j=from;
+         j<no_abbreviations;
+         j++)
+    {
+        p=(uchar *)abbreviations_text+abbreviations[j].textpos;
+        if (c != p[0]) break;
+        if (text[i+1]==p[1])

         {   for (k=2; p[k]!=0; k++)
                 if (text[i+k]!=p[k]) goto NotMatched;
             if (!glulx_mode) {
         {   for (k=2; p[k]!=0; k++)
                 if (text[i+k]!=p[k]) goto NotMatched;
             if (!glulx_mode) {


@@ -222,18 +230,27 @@ static int try_abbreviations_from(unsigned char *text, int i, int from)
     return(-1);
 }
 
     return(-1);
 }
 

+/* Create an abbreviation. */

 extern void make_abbreviation(char *text)
 {
 extern void make_abbreviation(char *text)
 {

+    int alen;
+    int32 pos;
+    

     /* If -e mode is off, we won't waste space creating an abbreviation entry. */
     if (!economy_switch)
         return;
     /* If -e mode is off, we won't waste space creating an abbreviation entry. */
     if (!economy_switch)
         return;

+
+    alen = strlen(text);
+    pos = abbreviations_totaltext;

     
     ensure_memory_list_available(&abbreviations_memlist, no_abbreviations+1);
     
     ensure_memory_list_available(&abbreviations_memlist, no_abbreviations+1);

-    ensure_memory_list_available(&abbreviations_at_memlist, no_abbreviations+1);
-    
-    strcpy((char *)abbreviations_at
-            + no_abbreviations*MAX_ABBREV_LENGTH, text);
+    ensure_memory_list_available(&abbreviations_text_memlist, pos+alen+1);
+
+    strcpy(abbreviations_text+pos, text);
+    abbreviations_totaltext += (alen+1);

 
 

+    abbreviations[no_abbreviations].textpos = pos;
+    abbreviations[no_abbreviations].textlen = alen;

     abbreviations[no_abbreviations].value = compile_string(text, STRCTX_ABBREV);
     abbreviations[no_abbreviations].freq = 0;
 
     abbreviations[no_abbreviations].value = compile_string(text, STRCTX_ABBREV);
     abbreviations[no_abbreviations].freq = 0;
 


@@ -249,6 +266,19 @@ extern void make_abbreviation(char *text)
     no_abbreviations++;
 }
 
     no_abbreviations++;
 }
 

+/* Return a pointer to the (uncompressed) abbreviation text.
+   This should be treated as temporary; it is only valid until the next
+   make_abbreviation() call. */
+extern char *abbreviation_text(int num)
+{
+    if (num < 0 || num >= no_abbreviations) {
+        compiler_error("Invalid abbrev for abbreviation_text()");
+        return "";
+    }
+    
+    return abbreviations_text + abbreviations[num].textpos;
+}
+

 /* ------------------------------------------------------------------------- */
 /*   The front end routine for text translation.                             */
 /*   strctx indicates the purpose of the string. This is mostly used for     */
 /* ------------------------------------------------------------------------- */
 /*   The front end routine for text translation.                             */
 /*   strctx indicates the purpose of the string. This is mostly used for     */


@@ -256,6 +286,18 @@ extern void make_abbreviation(char *text)
 /*   specially during compilation.                                           */
 /* ------------------------------------------------------------------------- */
 
 /*   specially during compilation.                                           */
 /* ------------------------------------------------------------------------- */
 

+/* TODO: When called from a print statement (parse_print()), it would be
+   nice to detect if the generated string is exactly one character. In that
+   case, we could return the character value and a flag to indicate the
+   caller could use @print_char/@streamchar/@new_line/@streamunichar
+   instead of printing a compiled string.
+
+   We'd need a new STRCTX value or two to distinguish direct-printed strings
+   from referenceable strings.
+
+   Currently, parse_print() checks for the "^" case manually, which is a
+   bit icky. */   
+   

 extern int32 compile_string(char *b, int strctx)
 {   int32 i, j, k;
     uchar *c;
 extern int32 compile_string(char *b, int strctx)
 {   int32 i, j, k;
     uchar *c;


@@ -425,7 +467,9 @@ static void write_z_char_g(int i)
 /* Helper routine to compute the weight, in units, of a character handled by the Z-Machine */
 static int zchar_weight(int c)
 {
 /* Helper routine to compute the weight, in units, of a character handled by the Z-Machine */
 static int zchar_weight(int c)
 {

-    int lookup = iso_to_alphabet_grid[c];
+    int lookup;
+    if (c == ' ') return 1;
+    lookup = iso_to_alphabet_grid[c];

     if (lookup < 0) return 4;
     if (lookup < 26) return 1;
     return 2;
     if (lookup < 0) return 4;
     if (lookup < 26) return 1;
     return 2;


@@ -543,9 +587,12 @@ extern int32 translate_text(int32 p_limit, char *s_text, int strctx)
             {
                 c = text_in[j];
                 /* Loop on all abbreviations starting with what is in c. */
             {
                 c = text_in[j];
                 /* Loop on all abbreviations starting with what is in c. */

-                for (k=from, q=(uchar *)abbreviations_at+from*MAX_ABBREV_LENGTH;
-                    (k<no_abbreviations)&&(c==q[0]); k++, q+=MAX_ABBREV_LENGTH)
-                {   
+                for (k=from;
+                     k<no_abbreviations;
+                     k++)
+                {
+                    q=(uchar *)abbreviations_text+abbreviations[k].textpos;
+                    if (c!=q[0]) break;

                     /* Let's compare; we also keep track of the length of the abbreviation. */
                     for (l=1; q[l]!=0; l++)
                     {    if (text_in[j+l]!=q[l]) {goto NotMatched;}
                     /* Let's compare; we also keep track of the length of the abbreviation. */
                     for (l=1; q[l]!=0; l++)
                     {    if (text_in[j+l]!=q[l]) {goto NotMatched;}


@@ -602,7 +649,7 @@ extern int32 translate_text(int32 p_limit, char *s_text, int strctx)
             ((j = abbreviations_optimal_parse_schedule[i]) != -1))
         {
             /* Fill with 1s, which will get ignored by everyone else. */
             ((j = abbreviations_optimal_parse_schedule[i]) != -1))
         {
             /* Fill with 1s, which will get ignored by everyone else. */

-            uchar *p = (uchar *)abbreviations_at+j*MAX_ABBREV_LENGTH;
+            uchar *p = (uchar *)abbreviation_text(j);

             for (k=0; p[k]!=0; k++) text_in[i+k]=1;
             /* Actually write the abbreviation in the story file. */
             abbreviations[j].freq++;
             for (k=0; p[k]!=0; k++) text_in[i+k]=1;
             /* Actually write the abbreviation in the story file. */
             abbreviations[j].freq++;


@@ -663,31 +710,32 @@ advance as part of 'Zcharacter table':", unicode);
             else if (text_in[i+1]=='(')
             {
                 /*   @(...) (dynamic string)   */
             else if (text_in[i+1]=='(')
             {
                 /*   @(...) (dynamic string)   */

-                char dsymbol[MAX_IDENTIFIER_LENGTH+1];

                 int len = 0, digits = 0;
                 i += 2;
                 /* This accepts "12xyz" as a symbol, which it really isn't,
                    but that just means it won't be found. */
                 int len = 0, digits = 0;
                 i += 2;
                 /* This accepts "12xyz" as a symbol, which it really isn't,
                    but that just means it won't be found. */

-                while ((text_in[i] == '_' || isalnum(text_in[i])) && len < MAX_IDENTIFIER_LENGTH) {
+                while ((text_in[i] == '_' || isalnum(text_in[i]))) {

                     char ch = text_in[i++];
                     if (isdigit(ch)) digits++;
                     char ch = text_in[i++];
                     if (isdigit(ch)) digits++;

-                    dsymbol[len++] = ch;
+                    ensure_memory_list_available(&temp_symbol_memlist, len+1);
+                    temp_symbol[len++] = ch;

                 }
                 }

-                dsymbol[len] = '\0';
+                ensure_memory_list_available(&temp_symbol_memlist, len+1);
+                temp_symbol[len] = '\0';

                 j = -1;
                 j = -1;

-                /* We would like to parse dsymbol as *either* a decimal
+                /* We would like to parse temp_symbol as *either* a decimal

                    number or a constant symbol. */
                 if (text_in[i] != ')' || len == 0) {
                     error("'@(...)' abbreviation must contain a symbol");
                 }
                 else if (digits == len) {
                     /* all digits; parse as decimal */
                    number or a constant symbol. */
                 if (text_in[i] != ')' || len == 0) {
                     error("'@(...)' abbreviation must contain a symbol");
                 }
                 else if (digits == len) {
                     /* all digits; parse as decimal */

-                    j = atoi(dsymbol);
+                    j = atoi(temp_symbol);

                 }
                 else {
                 }
                 else {

-                    int sym = symbol_index(dsymbol, -1);
-                    if ((symbols[sym].flags & UNKNOWN_SFLAG) || symbols[sym].type != CONSTANT_T || symbols[sym].marker) {
-                        error_named("'@(...)' abbreviation expected a known constant value, but contained", dsymbol);
+                    int sym = get_symbol_index(temp_symbol);
+                    if (sym < 0 || (symbols[sym].flags & UNKNOWN_SFLAG) || symbols[sym].type != CONSTANT_T || symbols[sym].marker) {
+                        error_named("'@(...)' abbreviation expected a known constant value, but contained", temp_symbol);

                     }
                     else {
                         symbols[sym].flags |= USED_SFLAG;
                     }
                     else {
                         symbols[sym].flags |= USED_SFLAG;


@@ -836,7 +884,7 @@ advance as part of 'Zcharacter table':", unicode);
       if ((economy_switch) && (compression_switch) && (!is_abbreviation)
         && ((k=abbrevs_lookup[text_in[i]])!=-1)
         && ((j=try_abbreviations_from(text_in, i, k)) != -1)) {
       if ((economy_switch) && (compression_switch) && (!is_abbreviation)
         && ((k=abbrevs_lookup[text_in[i]])!=-1)
         && ((j=try_abbreviations_from(text_in, i, k)) != -1)) {

-        char *cx = (char *)abbreviations_at+j*MAX_ABBREV_LENGTH;
+        char *cx = abbreviation_text(j);

         i += (strlen(cx)-1);
         write_z_char_g('@');
         write_z_char_g('A');
         i += (strlen(cx)-1);
         write_z_char_g('@');
         write_z_char_g('A');


@@ -862,31 +910,32 @@ string.");
           while (isdigit(text_in[i])) i++; i--;
         }
         else if (text_in[i+1]=='(') {
           while (isdigit(text_in[i])) i++; i--;
         }
         else if (text_in[i+1]=='(') {

-            char dsymbol[MAX_IDENTIFIER_LENGTH+1];

             int len = 0, digits = 0;
             i += 2;
             /* This accepts "12xyz" as a symbol, which it really isn't,
                but that just means it won't be found. */
             int len = 0, digits = 0;
             i += 2;
             /* This accepts "12xyz" as a symbol, which it really isn't,
                but that just means it won't be found. */

-            while ((text_in[i] == '_' || isalnum(text_in[i])) && len < MAX_IDENTIFIER_LENGTH) {
+            while ((text_in[i] == '_' || isalnum(text_in[i]))) {

                 char ch = text_in[i++];
                 if (isdigit(ch)) digits++;
                 char ch = text_in[i++];
                 if (isdigit(ch)) digits++;

-                dsymbol[len++] = ch;
+                ensure_memory_list_available(&temp_symbol_memlist, len+1);
+                temp_symbol[len++] = ch;

             }
             }

-            dsymbol[len] = '\0';
+            ensure_memory_list_available(&temp_symbol_memlist, len+1);
+            temp_symbol[len] = '\0';

             j = -1;
             j = -1;

-            /* We would like to parse dsymbol as *either* a decimal
+            /* We would like to parse temp_symbol as *either* a decimal

                number or a constant symbol. */
             if (text_in[i] != ')' || len == 0) {
                 error("'@(...)' abbreviation must contain a symbol");
             }
             else if (digits == len) {
                 /* all digits; parse as decimal */
                number or a constant symbol. */
             if (text_in[i] != ')' || len == 0) {
                 error("'@(...)' abbreviation must contain a symbol");
             }
             else if (digits == len) {
                 /* all digits; parse as decimal */

-                j = atoi(dsymbol);
+                j = atoi(temp_symbol);

             }
             else {
             }
             else {

-                int sym = symbol_index(dsymbol, -1);
-                if ((symbols[sym].flags & UNKNOWN_SFLAG) || symbols[sym].type != CONSTANT_T || symbols[sym].marker) {
-                    error_named("'@(...)' abbreviation expected a known constant value, but contained", dsymbol);
+                int sym = get_symbol_index(temp_symbol);
+                if (sym < 0 || (symbols[sym].flags & UNKNOWN_SFLAG) || symbols[sym].type != CONSTANT_T || symbols[sym].marker) {
+                    error_named("'@(...)' abbreviation expected a known constant value, but contained", temp_symbol);

                 }
                 else {
                     symbols[sym].flags |= USED_SFLAG;
                 }
                 else {
                     symbols[sym].flags |= USED_SFLAG;


@@ -1384,7 +1433,7 @@ static void compress_makebits(int entnum, int depth, int prevbit,
     compression_table_size += 2;
     break;
   case 3:
     compression_table_size += 2;
     break;
   case 3:

-    cx = (char *)abbreviations_at + ent->u.val*MAX_ABBREV_LENGTH;
+    cx = abbreviation_text(ent->u.val);

     compression_table_size += (1 + 1 + strlen(cx));
     break;
   case 4:
     compression_table_size += (1 + 1 + strlen(cx));
     break;
   case 4:


@@ -1423,12 +1472,27 @@ typedef struct optab_s
     int32  popularity;
     int32  score;
     int32  location;
     int32  popularity;
     int32  score;
     int32  location;

-    char text[MAX_ABBREV_LENGTH];
+    char  *text; /* allocated to textsize, min 4 */
+    int32  textsize;

 } optab;
 static int32 MAX_BESTYET;
 static optab *bestyet; /* High-score entries (up to MAX_BESTYET used/allocated) */
 static optab *bestyet2; /* The selected entries (up to selected used; allocated to MAX_ABBREVS) */
 
 } optab;
 static int32 MAX_BESTYET;
 static optab *bestyet; /* High-score entries (up to MAX_BESTYET used/allocated) */
 static optab *bestyet2; /* The selected entries (up to selected used; allocated to MAX_ABBREVS) */
 

+static void optab_copy(optab *dest, const optab *src)
+{
+    dest->length = src->length;
+    dest->popularity = src->popularity;
+    dest->score = src->score;
+    dest->location = src->location;
+    if (src->length+1 > dest->textsize) {
+        int32 oldsize = dest->textsize;
+        dest->textsize = (src->length+1)*2;
+        my_realloc(&dest->text, oldsize, dest->textsize, "bestyet2.text");
+    }
+    strcpy(dest->text, src->text);
+}
+

 static int pass_no;
 
 static void optimise_pass(void)
 static int pass_no;
 
 static void optimise_pass(void)


@@ -1459,7 +1523,7 @@ static void optimise_pass(void)
             for (j=0; j<tlbtab[i].occurrences; j++)
             {   for (j2=0; j2<tlbtab[i].occurrences; j2++) grandflags[j2]=1;
                 nl=2; noflags=tlbtab[i].occurrences;
             for (j=0; j<tlbtab[i].occurrences; j++)
             {   for (j2=0; j2<tlbtab[i].occurrences; j2++) grandflags[j2]=1;
                 nl=2; noflags=tlbtab[i].occurrences;

-                while ((noflags>=2)&&(nl<MAX_ABBREV_LENGTH-1))
+                while (noflags>=2)

                 {   nl++;
                     for (j2=0; j2<nl; j2++)
                         if (opttext[grandtable[tlbtab[i].intab+j]+j2]=='\n')
                 {   nl++;
                     for (j2=0; j2<nl; j2++)
                         if (opttext[grandtable[tlbtab[i].intab+j]+j2]=='\n')


@@ -1562,7 +1626,24 @@ extern void optimise_abbreviations(void)
     MAX_BESTYET = 4 * MAX_ABBREVS;
     
     bestyet=my_calloc(sizeof(optab), MAX_BESTYET, "bestyet");
     MAX_BESTYET = 4 * MAX_ABBREVS;
     
     bestyet=my_calloc(sizeof(optab), MAX_BESTYET, "bestyet");

+    for (i=0; i<MAX_BESTYET; i++) {
+        bestyet[i].length = 0;
+        bestyet[i].popularity = 0;
+        bestyet[i].score = 0;
+        bestyet[i].location = 0;
+        bestyet[i].textsize = 4;
+        bestyet[i].text = my_malloc(bestyet[i].textsize, "bestyet.text");
+    }
+

     bestyet2=my_calloc(sizeof(optab), MAX_ABBREVS, "bestyet2");
     bestyet2=my_calloc(sizeof(optab), MAX_ABBREVS, "bestyet2");

+    for (i=0; i<MAX_ABBREVS; i++) {
+        bestyet2[i].length = 0;
+        bestyet2[i].popularity = 0;
+        bestyet2[i].score = 0;
+        bestyet2[i].location = 0;
+        bestyet2[i].textsize = 4;
+        bestyet2[i].text = my_malloc(bestyet2[i].textsize, "bestyet2.text");
+    }

 
     bestyet2[0].text[0]='.';
     bestyet2[0].text[1]=' ';
 
     bestyet2[0].text[0]='.';
     bestyet2[0].text[1]=' ';


@@ -1674,6 +1755,11 @@ extern void optimise_abbreviations(void)
             if (bestyet[i].score!=0)
             {   available++;
                 nl=bestyet[i].length;
             if (bestyet[i].score!=0)
             {   available++;
                 nl=bestyet[i].length;

+                if (nl+1 > bestyet[i].textsize) {
+                    int32 oldsize = bestyet[i].textsize;
+                    bestyet[i].textsize = (nl+1)*2;
+                    my_realloc(&bestyet[i].text, oldsize, bestyet[i].textsize, "bestyet.text");
+                }

                 for (j2=0; j2<nl; j2++) bestyet[i].text[j2]=
                     opttext[bestyet[i].location+j2];
                 bestyet[i].text[nl]=0;
                 for (j2=0; j2<nl; j2++) bestyet[i].text[j2]=
                     opttext[bestyet[i].location+j2];
                 bestyet[i].text[nl]=0;


@@ -1698,7 +1784,7 @@ extern void optimise_abbreviations(void)
             if (max>0)
             {
                 char testtext[4];
             if (max>0)
             {
                 char testtext[4];

-                bestyet2[selected++]=bestyet[maxat];
+                optab_copy(&bestyet2[selected++], &bestyet[maxat]);

 
                 if (optabbrevs_trace_setting >= 1) {
                     printf(
 
                 if (optabbrevs_trace_setting >= 1) {
                     printf(


@@ -1813,14 +1899,11 @@ int dict_entries;                     /* Total number of records entered     */
 /*   In modifying the compiler for Glulx, I found it easier to discard the   */
 /*   typedef, and operate directly on uchar arrays of length DICT_WORD_SIZE. */
 /*   In Z-code, DICT_WORD_SIZE will be 6, so the Z-code compiler will work   */
 /*   In modifying the compiler for Glulx, I found it easier to discard the   */
 /*   typedef, and operate directly on uchar arrays of length DICT_WORD_SIZE. */
 /*   In Z-code, DICT_WORD_SIZE will be 6, so the Z-code compiler will work   */

-/*   as before. In Glulx, it can be any value up to MAX_DICT_WORD_SIZE.      */
-/*   (That limit is defined as 40 in the header; it exists only for a few    */
-/*   static buffers, and can be increased without using significant memory.) */
+/*   as before. In Glulx, it can be any value.                               */

 /*                                                                           */
 /*                                                                           */

-/*   ...Well, that certainly bit me on the butt, didn't it. In further       */
-/*   modifying the compiler to generate a Unicode dictionary, I have to      */
-/*   store four-byte values in the uchar array. This is handled by making    */
-/*   the array size DICT_WORD_BYTES (which is DICT_WORD_SIZE*DICT_CHAR_SIZE).*/
+/*   In further modifying the compiler to generate a Unicode dictionary,     */
+/*   I have to store four-byte values in the uchar array. We make the array  */
+/*   size DICT_WORD_BYTES (which is DICT_WORD_SIZE*DICT_CHAR_SIZE).          */

 /*   Then we store the 32-bit character value big-endian. This lets us       */
 /*   continue to compare arrays bytewise, which is a nice simplification.    */
 /* ------------------------------------------------------------------------- */
 /*   Then we store the 32-bit character value big-endian. This lets us       */
 /*   continue to compare arrays bytewise, which is a nice simplification.    */
 /* ------------------------------------------------------------------------- */


@@ -1840,14 +1923,17 @@ extern void copy_sorts(uchar *d1, uchar *d2)
         d1[i] = d2[i];
 }
 
         d1[i] = d2[i];
 }
 

-static uchar prepared_sort[MAX_DICT_WORD_BYTES];     /* Holds the sort code
-                                                        of current word */
+static memory_list prepared_sort_memlist;
+static uchar *prepared_sort;    /* Holds the sort code of current word */

 
 

-static int number_and_case;
+static int prepared_dictflags_pos;  /* Dict flags set by the current word */
+static int prepared_dictflags_neg;  /* Dict flags *not* set by the word */

 
 /* Also used by verbs.c */
 static void dictionary_prepare_z(char *dword, uchar *optresult)
 
 /* Also used by verbs.c */
 static void dictionary_prepare_z(char *dword, uchar *optresult)

-{   int i, j, k, k2, wd[13]; int32 tot;
+{   int i, j, k, k2, wd[13];
+    int32 tot;
+    int negflag;

 
     /* A rapid text translation algorithm using only the simplified rules
        applying to the text of dictionary entries: first produce a sequence
 
     /* A rapid text translation algorithm using only the simplified rules
        applying to the text of dictionary entries: first produce a sequence


@@ -1855,22 +1941,50 @@ static void dictionary_prepare_z(char *dword, uchar *optresult)
 
     int dictsize = (version_number==3) ? 6 : 9;
 
 
     int dictsize = (version_number==3) ? 6 : 9;
 

-    number_and_case = 0;
+    prepared_dictflags_pos = 0;
+    prepared_dictflags_neg = 0;

 
 

-    for (i=0, j=0; dword[j]!=0; i++, j++)
-    {   if ((dword[j] == '/') && (dword[j+1] == '/'))
-        {   for (j+=2; dword[j] != 0; j++)
-            {   switch(dword[j])
-                {   case 'p': number_and_case |= 4;  break;
+    for (i=0, j=0; dword[j]!=0; j++)
+    {
+        if ((dword[j] == '/') && (dword[j+1] == '/'))
+        {
+            /* The rest of the word is dict flags. Run through them. */
+            negflag = FALSE;
+            for (j+=2; dword[j] != 0; j++)
+            {
+                switch(dword[j])
+                {
+                    case '~':
+                        if (!dword[j+1])
+                            error_named("'//~' with no flag character (pn) in dict word", dword);
+                        negflag = !negflag;
+                        break;
+                    case 'p':
+                        if (!negflag)
+                            prepared_dictflags_pos |= 4;
+                        else
+                            prepared_dictflags_neg |= 4;
+                        negflag = FALSE;
+                        break;
+                    case 'n':
+                        if (!negflag)
+                            prepared_dictflags_pos |= 128;
+                        else
+                            prepared_dictflags_neg |= 128;
+                        negflag = FALSE;
+                        break;

                     default:
                     default:

-                        error_named("Expected 'p' after '//' \
-to give number of dictionary word", dword);
+                        error_named("Expected flag character (pn~) after '//' in dict word", dword);

                         break;
                 }
             }
             break;
         }
                         break;
                 }
             }
             break;
         }

-        if (i>=dictsize) break;
+
+        /* LONG_DICT_FLAG_BUG emulates the old behavior where we stop looping
+           at dictsize. */
+        if (LONG_DICT_FLAG_BUG && i>=dictsize)
+            break;

 
         k=(int) dword[j];
         if (k==(int) '\'')
 
         k=(int) dword[j];
         if (k==(int) '\'')


@@ -1901,26 +2015,37 @@ apostrophe in", dword);
                 char_error("Character can be printed but not input:", k);
             else
             {   /* Use 4 more Z-chars to encode a ZSCII escape sequence      */
                 char_error("Character can be printed but not input:", k);
             else
             {   /* Use 4 more Z-chars to encode a ZSCII escape sequence      */

-
-                wd[i++] = 5; wd[i++] = 6;
+                if (i<dictsize)
+                    wd[i++] = 5;
+                if (i<dictsize)
+                    wd[i++] = 6;

                 k2 = -k2;
                 k2 = -k2;

-                wd[i++] = k2/32; wd[i] = k2%32;
+                if (i<dictsize)
+                    wd[i++] = k2/32;
+                if (i<dictsize)
+                    wd[i++] = k2%32;

             }
         }
         else
         {   alphabet_used[k2] = 'Y';
             }
         }
         else
         {   alphabet_used[k2] = 'Y';

-            if ((k2/26)!=0)
+            if ((k2/26)!=0 && i<dictsize)

                 wd[i++]=3+(k2/26);            /* Change alphabet for symbols */
                 wd[i++]=3+(k2/26);            /* Change alphabet for symbols */

-            wd[i]=6+(k2%26);                  /* Write the Z character       */
+            if (i<dictsize)
+                wd[i++]=6+(k2%26);            /* Write the Z character       */

         }
     }
 
         }
     }
 

-    /* Fill up to the end of the dictionary block with PAD characters        */
+    if (i > dictsize)
+        compiler_error("dict word buffer overflow");
+
+    /* Fill up to the end of the dictionary block with PAD characters
+       (for safety, we right-pad to 9 chars even in V3)                      */

 
     for (; i<9; i++) wd[i]=5;
 
     /* The array of Z-chars is converted to two or three 2-byte blocks       */
 
     for (; i<9; i++) wd[i]=5;
 
     /* The array of Z-chars is converted to two or three 2-byte blocks       */

-
+    ensure_memory_list_available(&prepared_sort_memlist, DICT_WORD_BYTES);
+    

     tot = wd[2] + wd[1]*(1<<5) + wd[0]*(1<<10);
     prepared_sort[1]=tot%0x100;
     prepared_sort[0]=(tot/0x100)%0x100;
     tot = wd[2] + wd[1]*(1<<5) + wd[0]*(1<<10);
     prepared_sort[1]=tot%0x100;
     prepared_sort[0]=(tot/0x100)%0x100;


@@ -1947,25 +2072,48 @@ static void dictionary_prepare_g(char *dword, uchar *optresult)
 { 
   int i, j, k;
   int32 unicode;
 { 
   int i, j, k;
   int32 unicode;

+  int negflag;

 
 

-  number_and_case = 0;
+  prepared_dictflags_pos = 0;
+  prepared_dictflags_neg = 0;

 
 

-  for (i=0, j=0; (dword[j]!=0); i++, j++) {
+  for (i=0, j=0; (dword[j]!=0); j++) {

     if ((dword[j] == '/') && (dword[j+1] == '/')) {
     if ((dword[j] == '/') && (dword[j+1] == '/')) {

+      /* The rest of the word is dict flags. Run through them. */
+      negflag = FALSE;

       for (j+=2; dword[j] != 0; j++) {
         switch(dword[j]) {
       for (j+=2; dword[j] != 0; j++) {
         switch(dword[j]) {

+        case '~':
+            if (!dword[j+1])
+                error_named("'//~' with no flag character (pn) in dict word", dword);
+            negflag = !negflag;
+            break;

         case 'p':
         case 'p':

-          number_and_case |= 4;  
-          break;
+            if (!negflag)
+                prepared_dictflags_pos |= 4;
+            else
+                prepared_dictflags_neg |= 4;
+            negflag = FALSE;
+            break;
+        case 'n':
+            if (!negflag)
+                prepared_dictflags_pos |= 128;
+            else
+                prepared_dictflags_neg |= 128;
+            negflag = FALSE;
+            break;

         default:
         default:

-          error_named("Expected 'p' after '//' \
-to give gender or number of dictionary word", dword);
+          error_named("Expected flag character (pn~) after '//' in dict word", dword);

           break;
         }
       }
       break;
     }
           break;
         }
       }
       break;
     }

-    if (i>=DICT_WORD_SIZE) break;
+
+    /* LONG_DICT_FLAG_BUG emulates the old behavior where we stop looping
+       at DICT_WORD_SIZE. */
+    if (LONG_DICT_FLAG_BUG && i>=DICT_WORD_SIZE)
+        break;

 
     k= ((unsigned char *)dword)[j];
     if (k=='\'') 
 
     k= ((unsigned char *)dword)[j];
     if (k=='\'') 


@@ -1996,17 +2144,27 @@ Define DICT_CHAR_SIZE=4 for a Unicode-compatible dictionary.");
     if (k >= (unsigned)'A' && k <= (unsigned)'Z')
       k += ('a' - 'A');
 
     if (k >= (unsigned)'A' && k <= (unsigned)'Z')
       k += ('a' - 'A');
 

+    ensure_memory_list_available(&prepared_sort_memlist, DICT_WORD_BYTES);
+    

     if (DICT_CHAR_SIZE == 1) {
     if (DICT_CHAR_SIZE == 1) {

-      prepared_sort[i] = k;
+      if (i<DICT_WORD_SIZE)
+        prepared_sort[i++] = k;

     }
     else {
     }
     else {

-      prepared_sort[4*i]   = (k >> 24) & 0xFF;
-      prepared_sort[4*i+1] = (k >> 16) & 0xFF;
-      prepared_sort[4*i+2] = (k >>  8) & 0xFF;
-      prepared_sort[4*i+3] = (k)       & 0xFF;
+      if (i<DICT_WORD_SIZE) {
+        prepared_sort[4*i]   = (k >> 24) & 0xFF;
+        prepared_sort[4*i+1] = (k >> 16) & 0xFF;
+        prepared_sort[4*i+2] = (k >>  8) & 0xFF;
+        prepared_sort[4*i+3] = (k)       & 0xFF;
+        i++;
+      }

     }
   }
 
     }
   }
 

+  if (i > DICT_WORD_SIZE)
+    compiler_error("dict word buffer overflow");
+
+  /* Right-pad with zeroes */

   if (DICT_CHAR_SIZE == 1) {
     for (; i<DICT_WORD_SIZE; i++)
       prepared_sort[i] = 0;
   if (DICT_CHAR_SIZE == 1) {
     for (; i<DICT_WORD_SIZE; i++)
       prepared_sort[i] = 0;


@@ -2125,23 +2283,29 @@ static int dictionary_find(char *dword)
 }
 
 /* ------------------------------------------------------------------------- */
 }
 
 /* ------------------------------------------------------------------------- */

-/*  Add "dword" to the dictionary with (x,y,z) as its data fields; unless    */
-/*  it already exists, in which case OR the data with (x,y,z)                */
+/*  Add "dword" to the dictionary with (flag1,flag2,flag3) as its data       */
+/*  fields; unless it already exists, in which case OR the data fields with  */
+/*  those flags.                                                             */

 /*                                                                           */
 /*  These fields are one byte each in Z-code, two bytes each in Glulx.       */
 /*                                                                           */
 /*  Returns: the accession number.                                           */
 /* ------------------------------------------------------------------------- */
 
 /*                                                                           */
 /*  These fields are one byte each in Z-code, two bytes each in Glulx.       */
 /*                                                                           */
 /*  Returns: the accession number.                                           */
 /* ------------------------------------------------------------------------- */
 

-extern int dictionary_add(char *dword, int x, int y, int z)
+extern int dictionary_add(char *dword, int flag1, int flag2, int flag3)

 {   int n; uchar *p;
     int ggfr = 0, gfr = 0, fr = 0, r = 0;
     int ggf = VACANT, gf = VACANT, f = VACANT, at = root;
     int a, b;
     int res=((version_number==3)?4:6);
 
 {   int n; uchar *p;
     int ggfr = 0, gfr = 0, fr = 0, r = 0;
     int ggf = VACANT, gf = VACANT, f = VACANT, at = root;
     int a, b;
     int res=((version_number==3)?4:6);
 

+    /* Fill in prepared_sort and prepared_dictflags. */

     dictionary_prepare(dword, NULL);
 
     dictionary_prepare(dword, NULL);
 

+    /* Adjust flag1 according to prepared_dictflags. */
+    flag1 &= (~prepared_dictflags_neg);
+    flag1 |= prepared_dictflags_pos;
+

     if (root == VACANT)
     {   root = 0; goto CreateEntry;
     }
     if (root == VACANT)
     {   root = 0; goto CreateEntry;
     }


@@ -2152,17 +2316,15 @@ extern int dictionary_add(char *dword, int x, int y, int z)
         {
             if (!glulx_mode) {
                 p = dictionary+7 + at*DICT_ENTRY_BYTE_LENGTH + res;
         {
             if (!glulx_mode) {
                 p = dictionary+7 + at*DICT_ENTRY_BYTE_LENGTH + res;

-                p[0]=(p[0])|x; p[1]=(p[1])|y;
+                p[0] |= flag1; p[1] |= flag2;

                 if (!ZCODE_LESS_DICT_DATA)
                 if (!ZCODE_LESS_DICT_DATA)

-                    p[2]=(p[2])|z;
-                if (x & 128) p[0] = (p[0])|number_and_case;
+                    p[2] |= flag3;

             }
             else {
                 p = dictionary+4 + at*DICT_ENTRY_BYTE_LENGTH + DICT_ENTRY_FLAG_POS;
             }
             else {
                 p = dictionary+4 + at*DICT_ENTRY_BYTE_LENGTH + DICT_ENTRY_FLAG_POS;

-                p[0]=(p[0])|(x/256); p[1]=(p[1])|(x%256); 
-                p[2]=(p[2])|(y/256); p[3]=(p[3])|(y%256); 
-                p[4]=(p[4])|(z/256); p[5]=(p[5])|(z%256);
-                if (x & 128) p[1] = (p[1]) | number_and_case;
+                p[0] |= (flag1/256); p[1] |= (flag1%256); 
+                p[2] |= (flag2/256); p[3] |= (flag2%256); 
+                p[4] |= (flag3/256); p[5] |= (flag3%256);

             }
             return at;
         }
             }
             return at;
         }


@@ -2270,9 +2432,8 @@ extern int dictionary_add(char *dword, int x, int y, int z)
         p[2]=prepared_sort[2]; p[3]=prepared_sort[3];
         if (version_number > 3)
           {   p[4]=prepared_sort[4]; p[5]=prepared_sort[5]; }
         p[2]=prepared_sort[2]; p[3]=prepared_sort[3];
         if (version_number > 3)
           {   p[4]=prepared_sort[4]; p[5]=prepared_sort[5]; }

-        p[res]=x; p[res+1]=y;
-        if (!ZCODE_LESS_DICT_DATA) p[res+2]=z;
-        if (x & 128) p[res] = (p[res])|number_and_case;
+        p[res]=flag1; p[res+1]=flag2;
+        if (!ZCODE_LESS_DICT_DATA) p[res+2]=flag3;

 
         dictionary_top += DICT_ENTRY_BYTE_LENGTH;
 
 
         dictionary_top += DICT_ENTRY_BYTE_LENGTH;
 


@@ -2288,11 +2449,9 @@ extern int dictionary_add(char *dword, int x, int y, int z)
           p[i] = prepared_sort[i];
         
         p += DICT_WORD_BYTES;
           p[i] = prepared_sort[i];
         
         p += DICT_WORD_BYTES;

-        p[0] = 0; p[1] = x;
-        p[2] = y/256; p[3] = y%256;
-        p[4] = 0; p[5] = z;
-        if (x & 128) 
-          p[1] |= number_and_case;
+        p[0] = (flag1/256); p[1] = (flag1%256);
+        p[2] = (flag2/256); p[3] = (flag2%256);
+        p[4] = (flag3/256); p[5] = (flag3%256);

         
         dictionary_top += DICT_ENTRY_BYTE_LENGTH;
 
         
         dictionary_top += DICT_ENTRY_BYTE_LENGTH;
 


@@ -2512,11 +2671,13 @@ static void recursively_show_z(int node, int level)
 
         flags = (int) p[res];
         if (flags & 128)
 
         flags = (int) p[res];
         if (flags & 128)

-        {   printf("noun ");
-            if (flags & 4)  printf("p"); else printf(" ");
-            printf(" ");
-        }
-        else printf("       ");
+            printf("noun ");
+        else
+            printf("     ");
+        if (flags & 4)
+            printf("p ");
+        else
+            printf("  ");

         if (flags & 8)
         {   if (grammar_version_number == 1)
                 printf("preposition:%d  ", (int) p[res+2]);
         if (flags & 8)
         {   if (grammar_version_number == 1)
                 printf("preposition:%d  ", (int) p[res+2]);


@@ -2571,11 +2732,13 @@ static void recursively_show_g(int node, int level)
             for (i=0; i<DICT_ENTRY_BYTE_LENGTH; i++) printf("%02x ",p[i]);
         }
         if (flags & 128)
             for (i=0; i<DICT_ENTRY_BYTE_LENGTH; i++) printf("%02x ",p[i]);
         }
         if (flags & 128)

-        {   printf("noun ");
-            if (flags & 4)  printf("p"); else printf(" ");
-            printf(" ");
-        }
-        else printf("       ");
+            printf("noun ");
+        else
+            printf("     ");
+        if (flags & 4)
+            printf("p ");
+        else
+            printf("  ");

         if (flags & 8)
         {   printf("preposition    ");
         }
         if (flags & 8)
         {   printf("preposition    ");
         }


@@ -2671,6 +2834,8 @@ extern void init_text_vars(void)
     grandtable = NULL;
     grandflags = NULL;
 
     grandtable = NULL;
     grandflags = NULL;
 

+    translated_text = NULL;
+    temp_symbol = NULL;

     all_text = NULL;
 
     for (j=0; j<256; j++) abbrevs_lookup[j] = -1;
     all_text = NULL;
 
     for (j=0; j<256; j++) abbrevs_lookup[j] = -1;


@@ -2682,6 +2847,7 @@ extern void init_text_vars(void)
     dtree = NULL;
     final_dict_order = NULL;
     dict_sort_codes = NULL;
     dtree = NULL;
     final_dict_order = NULL;
     dict_sort_codes = NULL;

+    prepared_sort = NULL;

     dict_entries=0;
 
     static_strings_area = NULL;
     dict_entries=0;
 
     static_strings_area = NULL;


@@ -2697,6 +2863,7 @@ extern void init_text_vars(void)
 extern void text_begin_pass(void)
 {   abbrevs_lookup_table_made = FALSE;
     no_abbreviations=0;
 extern void text_begin_pass(void)
 {   abbrevs_lookup_table_made = FALSE;
     no_abbreviations=0;

+    abbreviations_totaltext=0;

     total_chars_trans=0; total_bytes_trans=0;
     all_text_top=0;
     dictionary_begin_pass();
     total_chars_trans=0; total_bytes_trans=0;
     all_text_top=0;
     dictionary_begin_pass();


@@ -2718,6 +2885,10 @@ extern void text_allocate_arrays(void)
         sizeof(uchar), 8000, (void**)&translated_text,
         "translated text holding area");
     
         sizeof(uchar), 8000, (void**)&translated_text,
         "translated text holding area");
     

+    initialise_memory_list(&temp_symbol_memlist,
+        sizeof(char), 32, (void**)&temp_symbol,
+        "temporary symbol name");
+    

     initialise_memory_list(&all_text_memlist,
         sizeof(char), 0, (void**)&all_text,
         "transcription text for optimise");
     initialise_memory_list(&all_text_memlist,
         sizeof(char), 0, (void**)&all_text,
         "transcription text for optimise");


@@ -2726,8 +2897,8 @@ extern void text_allocate_arrays(void)
         sizeof(uchar), 128, (void**)&static_strings_area,
         "static strings area");
     
         sizeof(uchar), 128, (void**)&static_strings_area,
         "static strings area");
     

-    initialise_memory_list(&abbreviations_at_memlist,
-        MAX_ABBREV_LENGTH, 64, (void**)&abbreviations_at,
+    initialise_memory_list(&abbreviations_text_memlist,
+        sizeof(char), 64, (void**)&abbreviations_text,

         "abbreviation text");
 
     initialise_memory_list(&abbreviations_memlist,
         "abbreviation text");
 
     initialise_memory_list(&abbreviations_memlist,


@@ -2747,6 +2918,9 @@ extern void text_allocate_arrays(void)
     initialise_memory_list(&dict_sort_codes_memlist,
         sizeof(uchar), 1500*DICT_WORD_BYTES, (void**)&dict_sort_codes,
         "dictionary sort codes");
     initialise_memory_list(&dict_sort_codes_memlist,
         sizeof(uchar), 1500*DICT_WORD_BYTES, (void**)&dict_sort_codes,
         "dictionary sort codes");

+    initialise_memory_list(&prepared_sort_memlist,
+        sizeof(uchar), DICT_WORD_BYTES, (void**)&prepared_sort,
+        "prepared sort buffer");

 
     final_dict_order = NULL; /* will be allocated at sort_dictionary() time */
 
 
     final_dict_order = NULL; /* will be allocated at sort_dictionary() time */
 


@@ -2805,11 +2979,12 @@ extern void extract_all_text()
 extern void text_free_arrays(void)
 {
     deallocate_memory_list(&translated_text_memlist);
 extern void text_free_arrays(void)
 {
     deallocate_memory_list(&translated_text_memlist);

+    deallocate_memory_list(&temp_symbol_memlist);

     
     deallocate_memory_list(&all_text_memlist);
     
     deallocate_memory_list(&low_strings_memlist);
     
     deallocate_memory_list(&all_text_memlist);
     
     deallocate_memory_list(&low_strings_memlist);

-    deallocate_memory_list(&abbreviations_at_memlist);
+    deallocate_memory_list(&abbreviations_text_memlist);

     deallocate_memory_list(&abbreviations_memlist);
 
     deallocate_memory_list(&abbreviations_optimal_parse_schedule_memlist);
     deallocate_memory_list(&abbreviations_memlist);
 
     deallocate_memory_list(&abbreviations_optimal_parse_schedule_memlist);


@@ -2817,6 +2992,7 @@ extern void text_free_arrays(void)
 
     deallocate_memory_list(&dtree_memlist);
     deallocate_memory_list(&dict_sort_codes_memlist);
 
     deallocate_memory_list(&dtree_memlist);
     deallocate_memory_list(&dict_sort_codes_memlist);

+    deallocate_memory_list(&prepared_sort_memlist);

     my_free(&final_dict_order, "final dictionary ordering table");
 
     deallocate_memory_list(&dictionary_memlist);
     my_free(&final_dict_order, "final dictionary ordering table");
 
     deallocate_memory_list(&dictionary_memlist);


@@ -2833,6 +3009,18 @@ extern void text_free_arrays(void)
 extern void ao_free_arrays(void)
 {
     /* Called only after optimise_abbreviations() runs. */
 extern void ao_free_arrays(void)
 {
     /* Called only after optimise_abbreviations() runs. */

+
+    int32 i;
+    if (bestyet) {
+        for (i=0; i<MAX_BESTYET; i++) {
+            my_free(&bestyet[i].text, "bestyet.text");
+        }
+    }
+    if (bestyet2) {
+        for (i=0; i<MAX_ABBREVS; i++) {
+            my_free(&bestyet2[i].text, "bestyet2.text");
+        }
+    }

     
     my_free (&opttext,"stashed transcript for optimisation");
     my_free (&bestyet,"bestyet");
     
     my_free (&opttext,"stashed transcript for optimisation");
     my_free (&bestyet,"bestyet");

diff --git a/src/veneer.c b/src/veneer.c
index 1e8616cd2a0694d277ace64eba14179e40c0b64f..e065d04d360240e9cbb4b39f1b77266cee9ff435 100644 (file)
--- a/src/veneer.c
+++ b/src/veneer.c
@@ -3,8 +3,8 @@
 /*              by the compiler (e.g. DefArt) which the program doesn't      */
 /*              provide                                                      */
 /*                                                                           */
 /*              by the compiler (e.g. DefArt) which the program doesn't      */
 /*              provide                                                      */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -46,9 +46,10 @@ extern void compile_initial_routine(void)
   int32 j;
     assembly_operand AO;
 
   int32 j;
     assembly_operand AO;
 

-    j = symbol_index("Main__", -1);
+    j = symbol_index("Main__", -1, NULL);
+    clear_local_variables();

     assign_symbol(j,
     assign_symbol(j,

-        assemble_routine_header(0, FALSE, "Main__", FALSE, j),
+        assemble_routine_header(FALSE, "Main__", FALSE, j),

         ROUTINE_T);
     symbols[j].flags |= SYSTEM_SFLAG + USED_SFLAG;
     if (trace_fns_setting==3) symbols[j].flags |= STAR_SFLAG;
         ROUTINE_T);
     symbols[j].flags |= SYSTEM_SFLAG + USED_SFLAG;
     if (trace_fns_setting==3) symbols[j].flags |= STAR_SFLAG;


@@ -124,6 +125,7 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
          w = 0 -> 33;\
          if (w == 0) w=80;\
          w2 = (w - maxw)/2;\
          w = 0 -> 33;\
          if (w == 0) w=80;\
          w2 = (w - maxw)/2;\

+         if (w2 < 3) w2 = 3;\

          style reverse;\
          @sub w2 2 -> w;\
          line = 5;\
          style reverse;\
          @sub w2 2 -> w;\
          line = 5;\


@@ -211,11 +213,16 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
                  prop = (i-->0) & $7fff;\
              }\
          }",
                  prop = (i-->0) & $7fff;\
              }\
          }",

-        "p = #identifiers_table;\
+        "#IFDEF OMIT_SYMBOL_TABLE;\
+         p = size = 0;\
+         print \"<number \", prop, \">\";\
+         #IFNOT;\
+         p = #identifiers_table;\

          size = p-->0;\
          if (prop<=0 || prop>=size || p-->prop==0)\
              print \"<number \", prop, \">\";\
          else print (string) p-->prop;\
          size = p-->0;\
          if (prop<=0 || prop>=size || p-->prop==0)\
              print \"<number \", prop, \">\";\
          else print (string) p-->prop;\

+         #ENDIF;\

          ]", "", "", "", ""
     },
 
          ]", "", "", "", ""
     },
 


@@ -266,6 +273,10 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
 
         "CA__Pr",
         "obj id a b c d e f x y z s s2 n m;\
 
         "CA__Pr",
         "obj id a b c d e f x y z s s2 n m;\

+         #IFV3;\
+         #Message error \"Object message calls are not supported in v3.\";\
+         obj = id = a = b = c = d = e = f = x = y = z = s = s2 = n = m = 0;\
+         #IFNOT;\

          if (obj < 1 || obj > #largest_object-255)\
          {   switch(Z__Region(obj))\
              { 2: if (id == call)\
          if (obj < 1 || obj > #largest_object-255)\
          {   switch(Z__Region(obj))\
              { 2: if (id == call)\


@@ -327,6 +338,7 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
         default: return x-->m;\
             }\
          }\
         default: return x-->m;\
             }\
          }\

+         #ENDIF;\

          rfalse;\
          ]"
     },
          rfalse;\
          ]"
     },


@@ -417,7 +429,11 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
              identifier = (identifier & $3f00) / $100;\
              if (~~(obj ofclass cla)) rfalse; i=0-->5;\
              if (cla == 2) return i+2*identifier-2;\
              identifier = (identifier & $3f00) / $100;\
              if (~~(obj ofclass cla)) rfalse; i=0-->5;\
              if (cla == 2) return i+2*identifier-2;\

+             #IFV3;\
+             i = (i+60+cla*9)-->0;\
+             #IFNOT;\

              i = 0-->((i+124+cla*14)/2);\
              i = 0-->((i+124+cla*14)/2);\

+             #ENDIF;\

              i = CP__Tab(i + 2*(0->i) + 1, -1)+6;\
              return CP__Tab(i, identifier);\
          }\
              i = CP__Tab(i + 2*(0->i) + 1, -1)+6;\
              return CP__Tab(i, identifier);\
          }\


@@ -438,16 +454,23 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
     },
     {
         /*  RL__Pr:  read the property length of an individual property value,
     },
     {
         /*  RL__Pr:  read the property length of an individual property value,

-                     returning 0 if it isn't provided by the given object    */
+                     returning 0 if it isn't provided by the given object.
+                     This is also used for inherited values (of the form
+                     class::prop). */

 
         "RL__Pr",
         "obj identifier x;\
          if (identifier<64 && identifier>0) return obj.#identifier;\
          x = obj..&identifier;\
          if (x==0) rfalse;\
 
         "RL__Pr",
         "obj identifier x;\
          if (identifier<64 && identifier>0) return obj.#identifier;\
          x = obj..&identifier;\
          if (x==0) rfalse;\

-         if (identifier&$C000==$4000)\
+         if (identifier&$C000==$4000) {\
+             #IFV3;\
+             return 1+((x-1)->0)/$20;\
+             #IFNOT;\

              switch (((x-1)->0)&$C0)\
              {  0: return 1;  $40: return 2;  $80: return ((x-1)->0)&$3F; }\
              switch (((x-1)->0)&$C0)\
              {  0: return 1;  $40: return 2;  $80: return ((x-1)->0)&$3F; }\

+             #ENDIF;\
+         }\

          return (x-1)->0;\
          ]", "", "", "", "", ""
     },
          return (x-1)->0;\
          ]", "", "", "", "", ""
     },


@@ -583,8 +606,13 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
          \" in the\"; switch(size&7){0,1:q=0; 2:print \" string\";\
          q=1; 3:print \" table\";q=1; 4:print \" buffer\";q=WORDSIZE;} \
          if(size&16) print\" (->)\"; if(size&8) print\" (-->)\";\
          \" in the\"; switch(size&7){0,1:q=0; 2:print \" string\";\
          q=1; 3:print \" table\";q=1; 4:print \" buffer\";q=WORDSIZE;} \
          if(size&16) print\" (->)\"; if(size&8) print\" (-->)\";\

+         #IFDEF OMIT_SYMBOL_TABLE;\
+         \" array which has entries \", q, \" up to \",id,\" **]\";\
+         #IFNOT;\

          \" array ~\", (string) #array_names_offset-->p,\
          \" array ~\", (string) #array_names_offset-->p,\

-         \"~, which has entries \", q, \" up to \",id,\" **]\"; }\
+         \"~, which has entries \", q, \" up to \",id,\" **]\";\
+         #ENDIF;\
+         }\

          if (crime >= 24 && crime <=27) { if (crime<=25) print \"read\";\
          else print \"write\"; print \" outside memory using \";\
          switch(crime) { 24,26:\"-> **]\"; 25,27:\"--> **]\"; } }\
          if (crime >= 24 && crime <=27) { if (crime<=25) print \"read\";\
          else print \"write\"; print \" outside memory using \";\
          switch(crime) { 24,26:\"-> **]\"; 25,27:\"--> **]\"; } }\


@@ -618,10 +646,12 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
          \", but it is longer than 2 bytes so you cannot use ~.~\";\
          else\
          {   print \" has no property \", (property) id;\
          \", but it is longer than 2 bytes so you cannot use ~.~\";\
          else\
          {   print \" has no property \", (property) id;\

+             #IFNDEF OMIT_SYMBOL_TABLE;\

              p = #identifiers_table;\
              size = p-->0;\
              if (id<0 || id>=size)\
                  print \" (and nor has any other object)\";\
              p = #identifiers_table;\
              size = p-->0;\
              if (id<0 || id>=size)\
                  print \" (and nor has any other object)\";\

+             #ENDIF;\

          }\
          print \" to \", (string) crime, \" **]^\";\
          ]", ""
          }\
          print \" to \", (string) crime, \" **]^\";\
          ]", ""


@@ -687,6 +717,16 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
 
         "CP__Tab",
         "x id n l;\
 
         "CP__Tab",
         "x id n l;\

+         #IFV3;\
+         while (1)\
+         {   n = x->0;\
+             if (n == 0) break;\
+             x++;\
+             if (id == (n & $1f)) return x;\
+             l = (n/$20)+1;\
+             x = x + l;\
+         }\
+         #IFNOT;\

          while ((n=0->x) ~= 0)\
          {   if (n & $80) { x++; l = (0->x) & $3f; }\
              else { if (n & $40) l=2; else l=1; }\
          while ((n=0->x) ~= 0)\
          {   if (n & $80) { x++; l = (0->x) & $3f; }\
              else { if (n & $40) l=2; else l=1; }\


@@ -694,12 +734,17 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
              if ((n & $3f) == id) return x;\
              x = x + l;\
          }\
              if ((n & $3f) == id) return x;\
              x = x + l;\
          }\

+         #ENDIF;\

          if (id<0) return x+1; rfalse; ]", "", "", "", "", ""
     },
     {   /*  Cl__Ms:   the five message-receiving properties of Classes       */
 
         "Cl__Ms",
         "obj id y a b c d x;\
          if (id<0) return x+1; rfalse; ]", "", "", "", "", ""
     },
     {   /*  Cl__Ms:   the five message-receiving properties of Classes       */
 
         "Cl__Ms",
         "obj id y a b c d x;\

+         #IFV3;\
+         #Message error \"Class messages are not supported in v3.\";\
+         obj = id = y = a = b = c = d = x = 0;\
+         #IFNOT;\

          switch(id)\
          {   create:\
                  if (children(obj)<=1) rfalse; x=child(obj);\
          switch(id)\
          {   create:\
                  if (children(obj)<=1) rfalse; x=child(obj);\


@@ -730,6 +775,7 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
                  { RT__Err(\"copy\", b, -obj); rfalse; }\
                  Copy__Primitive(a, b); rfalse;\
          }\
                  { RT__Err(\"copy\", b, -obj); rfalse; }\
                  Copy__Primitive(a, b); rfalse;\
          }\

+         #ENDIF;\

          ]", "", "", ""
     },
     {   /*  RT__ChT:  check at run-time that a proposed object move is legal
          ]", "", "", ""
     },
     {   /*  RT__ChT:  check at run-time that a proposed object move is legal


@@ -986,6 +1032,10 @@ static VeneerRoutine VRs_g[VENEER_ROUTINES] =
              print (name) cla, \"::\";\
              @ushiftr prop 16 prop;\
            }\
              print (name) cla, \"::\";\
              @ushiftr prop 16 prop;\
            }\

+           #IFDEF OMIT_SYMBOL_TABLE;\
+           ptab = maxcom = minind = maxind = str = 0;\
+           print \"<number \", prop, \">\";\
+           #IFNOT;\

            ptab = #identifiers_table;\
            maxcom = ptab-->1;\
            minind = INDIV_PROP_START;\
            ptab = #identifiers_table;\
            maxcom = ptab-->1;\
            minind = INDIV_PROP_START;\


@@ -1001,6 +1051,7 @@ static VeneerRoutine VRs_g[VENEER_ROUTINES] =
              print (string) str;\
            else\
              print \"<number \", prop, \">\";\
              print (string) str;\
            else\
              print \"<number \", prop, \">\";\

+           #ENDIF;\

          ]", "", "", "", "", ""
     },
 
          ]", "", "", "", "", ""
     },
 


@@ -1429,8 +1480,13 @@ static VeneerRoutine VRs_g[VENEER_ROUTINES] =
          \" in the\"; switch(size&7){0,1:q=0; 2:print \" string\";\
          q=1; 3:print \" table\";q=1; 4:print \" buffer\";q=WORDSIZE;} \
          if(size&16) print\" (->)\"; if(size&8) print\" (-->)\";\
          \" in the\"; switch(size&7){0,1:q=0; 2:print \" string\";\
          q=1; 3:print \" table\";q=1; 4:print \" buffer\";q=WORDSIZE;} \
          if(size&16) print\" (->)\"; if(size&8) print\" (-->)\";\

+         #IFDEF OMIT_SYMBOL_TABLE;\
+         \" array which has entries \", q, \" up to \",id,\" **]\";\
+         #IFNOT;\

          \" array ~\", (string) #array_names_offset-->(p+1),\
          \" array ~\", (string) #array_names_offset-->(p+1),\

-         \"~, which has entries \", q, \" up to \",id,\" **]\"; }\
+         \"~, which has entries \", q, \" up to \",id,\" **]\";\
+         #ENDIF;\
+         }\

          if (crime >= 24 && crime <=27) { if (crime<=25) print \"read\";\
          else print \"write\"; print \" outside memory using \";\
          switch(crime) { 24,26:\"-> **]\"; 25,27:\"--> **]\"; } }\
          if (crime >= 24 && crime <=27) { if (crime<=25) print \"read\";\
          else print \"write\"; print \" outside memory using \";\
          switch(crime) { 24,26:\"-> **]\"; 25,27:\"--> **]\"; } }\


@@ -1462,10 +1518,12 @@ static VeneerRoutine VRs_g[VENEER_ROUTINES] =
          if (id<0) print \"is not of class \", (name) -id;",
         "else\
          {   print \" has no property \", (property) id;\
          if (id<0) print \"is not of class \", (name) -id;",
         "else\
          {   print \" has no property \", (property) id;\

+             #IFNDEF OMIT_SYMBOL_TABLE;\

              p = #identifiers_table;\
              size = INDIV_PROP_START + p-->3;\
              if (id<0 || id>=size)\
                  print \" (and nor has any other object)\";\
              p = #identifiers_table;\
              size = INDIV_PROP_START + p-->3;\
              if (id<0 || id>=size)\
                  print \" (and nor has any other object)\";\

+             #ENDIF;\

          }\
          print \" to \", (string) crime, \" **]^\";\
          ]", ""
          }\
          print \" to \", (string) crime, \" **]^\";\
          ]", ""


@@ -2203,15 +2261,16 @@ static void compile_symbol_table_routine(void)
 {   int32 j, nl, arrays_l, routines_l, constants_l;
     assembly_operand AO, AO2, AO3;
 
 {   int32 j, nl, arrays_l, routines_l, constants_l;
     assembly_operand AO, AO2, AO3;
 

+    clear_local_variables();

     /* Assign local var names for the benefit of the debugging information 
        file. (We don't set local_variable.keywords because we're not
        going to be parsing any code.) */
     /* Assign local var names for the benefit of the debugging information 
        file. (We don't set local_variable.keywords because we're not
        going to be parsing any code.) */

-    strcpy(local_variable_names[0].text, "dummy1");
-    strcpy(local_variable_names[1].text, "dummy2");
+    add_local_variable("dummy1");
+    add_local_variable("dummy2");

 
 

-    veneer_mode = TRUE; j = symbol_index("Symb__Tab", -1);
+    veneer_mode = TRUE; j = symbol_index("Symb__Tab", -1, NULL);

     assign_symbol(j,
     assign_symbol(j,

-        assemble_routine_header(2, FALSE, "Symb__Tab", FALSE, j),
+        assemble_routine_header(FALSE, "Symb__Tab", FALSE, j),

         ROUTINE_T);
     symbols[j].flags |= SYSTEM_SFLAG + USED_SFLAG;
     if (trace_fns_setting==3) symbols[j].flags |= STAR_SFLAG;
         ROUTINE_T);
     symbols[j].flags |= SYSTEM_SFLAG + USED_SFLAG;
     if (trace_fns_setting==3) symbols[j].flags |= STAR_SFLAG;


@@ -2363,7 +2422,7 @@ extern void compile_veneer(void)
     {   try_veneer_again = FALSE;
         for (i=0; i<VENEER_ROUTINES; i++)
         {   if (veneer_routine_needs_compilation[i] == VR_CALLED)
     {   try_veneer_again = FALSE;
         for (i=0; i<VENEER_ROUTINES; i++)
         {   if (veneer_routine_needs_compilation[i] == VR_CALLED)

-            {   j = symbol_index(VRs[i].name, -1);
+            {   j = symbol_index(VRs[i].name, -1, NULL);

                 if (symbols[j].flags & UNKNOWN_SFLAG)
                 {   veneer_mode = TRUE;
                     strcpy(veneer_source_area, VRs[i].source1);
                 if (symbols[j].flags & UNKNOWN_SFLAG)
                 {   veneer_mode = TRUE;
                     strcpy(veneer_source_area, VRs[i].source1);

diff --git a/src/verbs.c b/src/verbs.c
index 9fe65bc913a4491d1d316b27fb6fb3fd6e98f3e0..de35f3039dd6ceefebc483d94a5e59b434da9536 100644 (file)
--- a/src/verbs.c
+++ b/src/verbs.c
@@ -2,8 +2,8 @@
 /*   "verbs" :  Manages actions and grammar tables; parses the directives    */
 /*              Verb and Extend.                                             */
 /*                                                                           */
 /*   "verbs" :  Manages actions and grammar tables; parses the directives    */
 /*              Verb and Extend.                                             */
 /*                                                                           */

-/*   Part of Inform 6.41                                                     */
-/*   copyright (c) Graham Nelson 1993 - 2022                                 */
+/*   Part of Inform 6.42                                                     */
+/*   copyright (c) Graham Nelson 1993 - 2024                                 */

 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */
 /*                                                                           */
 /* Inform is free software: you can redistribute it and/or modify            */
 /* it under the terms of the GNU General Public License as published by      */


@@ -110,9 +110,11 @@ static memory_list English_verbs_given_memlist;
   int32   *adjectives; /* Allocated to no_adjectives */
   static memory_list adjectives_memlist;
 
   int32   *adjectives; /* Allocated to no_adjectives */
   static memory_list adjectives_memlist;
 

-  static uchar *adjective_sort_code; /* Allocated to no_adjectives*DICT_WORD_BYTES */
+  static uchar *adjective_sort_code; /* Allocated to no_adjectives*DICT_WORD_BYTES, except it's sometimes no_adjectives+1 because we can bump it tentatively */

   static memory_list adjective_sort_code_memlist;
 
   static memory_list adjective_sort_code_memlist;
 

+  static memory_list action_symname_memlist; /* Used for temporary symbols */
+

 /* ------------------------------------------------------------------------- */
 /*   Tracing for compiler maintenance                                        */
 /* ------------------------------------------------------------------------- */
 /* ------------------------------------------------------------------------- */
 /*   Tracing for compiler maintenance                                        */
 /* ------------------------------------------------------------------------- */


@@ -313,28 +315,34 @@ static void new_action(char *b, int c)
         At present just a hook for some tracing code.                        */
 
     if (printactions_switch)
         At present just a hook for some tracing code.                        */
 
     if (printactions_switch)

-        printf("Action '%s' is numbered %d\n",b,c);
+        printf("%s: Action '%s' is numbered %d\n", current_location_text(), b, c);

 }
 
 /* Note that fake actions are numbered from a high base point upwards;
    real actions are numbered from 0 upward in GV2.                           */
 
 extern void make_fake_action(void)
 }
 
 /* Note that fake actions are numbered from a high base point upwards;
    real actions are numbered from 0 upward in GV2.                           */
 
 extern void make_fake_action(void)

-{   int i;
-    char action_sub[MAX_IDENTIFIER_LENGTH+4];
+{   char *action_sub;
+    int i;

     debug_location_beginning beginning_debug_location =
         get_token_location_beginning();
 
     get_next_token();
     if (token_type != SYMBOL_TT)
     {   discard_token_location(beginning_debug_location);
     debug_location_beginning beginning_debug_location =
         get_token_location_beginning();
 
     get_next_token();
     if (token_type != SYMBOL_TT)
     {   discard_token_location(beginning_debug_location);

-        ebf_error("new fake action name", token_text);
+        ebf_curtoken_error("new fake action name");

         panic_mode_error_recovery(); return;
     }
         panic_mode_error_recovery(); return;
     }

+
+    /* Enough space for "token__A". */
+    ensure_memory_list_available(&action_symname_memlist, strlen(token_text)+4);
+    action_sub = action_symname_memlist.data;
+    strcpy(action_sub, token_text);
+    strcat(action_sub, "__A");
+    

     /* Action symbols (including fake_actions) may collide with other kinds of symbols. So we don't check that. */
 
     /* Action symbols (including fake_actions) may collide with other kinds of symbols. So we don't check that. */
 

-    snprintf(action_sub, MAX_IDENTIFIER_LENGTH+4, "%s__A", token_text);
-    i = symbol_index(action_sub, -1);
+    i = symbol_index(action_sub, -1, NULL);

 
     if (!(symbols[i].flags & UNKNOWN_SFLAG))
     {   discard_token_location(beginning_debug_location);
 
     if (!(symbols[i].flags & UNKNOWN_SFLAG))
     {   discard_token_location(beginning_debug_location);


@@ -367,12 +375,17 @@ extern assembly_operand action_of_name(char *name)
     /*  Returns the action number of the given name, creating it as a new
         action name if it isn't already known as such.                       */
 
     /*  Returns the action number of the given name, creating it as a new
         action name if it isn't already known as such.                       */
 

-    char action_sub[MAX_IDENTIFIER_LENGTH+4];
+    char *action_sub;

     int j;
     assembly_operand AO;
 
     int j;
     assembly_operand AO;
 

-    snprintf(action_sub, MAX_IDENTIFIER_LENGTH+4, "%s__A", name);
-    j = symbol_index(action_sub, -1);
+    /* Enough space for "name__A". */
+    ensure_memory_list_available(&action_symname_memlist, strlen(name)+4);
+    action_sub = action_symname_memlist.data;
+    strcpy(action_sub, name);
+    strcat(action_sub, "__A");
+    
+    j = symbol_index(action_sub, -1, NULL);

 
     if (symbols[j].type == FAKE_ACTION_T)
     {   INITAO(&AO);
 
     if (symbols[j].type == FAKE_ACTION_T)
     {   INITAO(&AO);


@@ -411,24 +424,29 @@ extern assembly_operand action_of_name(char *name)
 
 extern void find_the_actions(void)
 {   int i; int32 j;
 
 extern void find_the_actions(void)
 {   int i; int32 j;

-    char action_name[MAX_IDENTIFIER_LENGTH+4];
-    char action_sub[MAX_IDENTIFIER_LENGTH+4];

 
     for (i=0; i<no_actions; i++)
 
     for (i=0; i<no_actions; i++)

-    {   strcpy(action_name, symbols[actions[i].symbol].name);
-        action_name[strlen(action_name) - 3] = '\0'; /* remove "__A" */
+    {
+        /* The name looks like "action__A". We're going to convert that to
+           "actionSub". Allocate enough space for both. */
+        int namelen = strlen(symbols[actions[i].symbol].name);
+        char *action_sub, *action_name;
+        ensure_memory_list_available(&action_symname_memlist, 2*(namelen+1));
+        action_sub = action_symname_memlist.data;
+        action_name = (char *)action_symname_memlist.data + (namelen+1);
+        
+        strcpy(action_name, symbols[actions[i].symbol].name);
+        action_name[namelen - 3] = '\0'; /* remove "__A" */

         strcpy(action_sub, action_name);
         strcat(action_sub, "Sub");
         strcpy(action_sub, action_name);
         strcat(action_sub, "Sub");

-        j = symbol_index(action_sub, -1);
+        j = symbol_index(action_sub, -1, NULL);

         if (symbols[j].flags & UNKNOWN_SFLAG)
         {
             error_named_at("No ...Sub action routine found for action:", action_name, symbols[actions[i].symbol].line);
         }
         if (symbols[j].flags & UNKNOWN_SFLAG)
         {
             error_named_at("No ...Sub action routine found for action:", action_name, symbols[actions[i].symbol].line);
         }

-        else
-        if (symbols[j].type != ROUTINE_T)
+        else if (symbols[j].type != ROUTINE_T)

         {
         {

-            error_named_at("No ...Sub action routine found for action:", action_name, symbols[actions[i].symbol].line);
-            error_named_at("-- ...Sub symbol found, but not a routine:", action_sub, symbols[j].line);
+            ebf_symbol_error("action's ...Sub routine", action_sub, typename(symbols[j].type), symbols[j].line);

         }
         else
         {   actions[i].byte_offset = symbols[j].value;
         }
         else
         {   actions[i].byte_offset = symbols[j].value;


@@ -452,8 +470,8 @@ static int make_adjective(char *English_word)
         This routine is used only in grammar version 1: the corresponding
         table is left empty in GV2.                                          */
 
         This routine is used only in grammar version 1: the corresponding
         table is left empty in GV2.                                          */
 

+    uchar *new_sort_code;

     int i; 
     int i; 

-    uchar new_sort_code[MAX_DICT_WORD_BYTES];

 
     if (no_adjectives >= 255) {
         error("Grammar version 1 cannot support more than 255 prepositions");
 
     if (no_adjectives >= 255) {
         error("Grammar version 1 cannot support more than 255 prepositions");


@@ -464,9 +482,13 @@ static int make_adjective(char *English_word)
         error("Grammar version 1 cannot be used with ZCODE_LESS_DICT_DATA");
         return 0;
     }
         error("Grammar version 1 cannot be used with ZCODE_LESS_DICT_DATA");
         return 0;
     }

+
+    /* Allocate the extra space even though we might not need it. We'll use
+       the prospective new adjective_sort_code slot as a workspace. */

     ensure_memory_list_available(&adjectives_memlist, no_adjectives+1);
     ensure_memory_list_available(&adjective_sort_code_memlist, (no_adjectives+1) * DICT_WORD_BYTES);
 
     ensure_memory_list_available(&adjectives_memlist, no_adjectives+1);
     ensure_memory_list_available(&adjective_sort_code_memlist, (no_adjectives+1) * DICT_WORD_BYTES);
 

+    new_sort_code = adjective_sort_code+no_adjectives*DICT_WORD_BYTES;

     dictionary_prepare(English_word, new_sort_code);
     for (i=0; i<no_adjectives; i++)
         if (compare_sorts(new_sort_code,
     dictionary_prepare(English_word, new_sort_code);
     for (i=0; i<no_adjectives; i++)
         if (compare_sorts(new_sort_code,


@@ -474,8 +496,6 @@ static int make_adjective(char *English_word)
             return(0xff-i);
     adjectives[no_adjectives]
         = dictionary_add(English_word,8,0,0xff-no_adjectives);
             return(0xff-i);
     adjectives[no_adjectives]
         = dictionary_add(English_word,8,0,0xff-no_adjectives);

-    copy_sorts(adjective_sort_code+no_adjectives*DICT_WORD_BYTES,
-        new_sort_code);

     return(0xff-no_adjectives++);
 }
 
     return(0xff-no_adjectives++);
 }
 


@@ -538,7 +558,7 @@ static char *find_verb_by_number(int num)
     p=English_verb_list;
     while (p < English_verb_list+English_verb_list_size)
     {
     p=English_verb_list;
     while (p < English_verb_list+English_verb_list_size)
     {

-        int val = (p[1] << 8) | p[2];
+        int val = ((uchar)p[1] << 8) | (uchar)p[2];

         if (val == num) {
             return p+3;
         }
         if (val == num) {
             return p+3;
         }


@@ -561,11 +581,10 @@ static void register_verb(char *English_verb, int number)
 
     /* We set a hard limit of MAX_VERB_WORD_SIZE=120 because the
        English_verb_list table stores length in a leading byte. (We could
 
     /* We set a hard limit of MAX_VERB_WORD_SIZE=120 because the
        English_verb_list table stores length in a leading byte. (We could

-       raise that to 250, really, but there's little point when
-       MAX_DICT_WORD_SIZE is 40.) */
+       raise that to 250, really.) */

     entrysize = strlen(English_verb)+4;
     if (entrysize > MAX_VERB_WORD_SIZE+4)
     entrysize = strlen(English_verb)+4;
     if (entrysize > MAX_VERB_WORD_SIZE+4)

-        error_numbered("Verb word is too long -- max length is", MAX_VERB_WORD_SIZE);
+        error_fmt("Verb word is too long -- max length is %d", MAX_VERB_WORD_SIZE);

     ensure_memory_list_available(&English_verb_list_memlist, English_verb_list_size + entrysize);
     top = English_verb_list + English_verb_list_size;
     English_verb_list_size += entrysize;
     ensure_memory_list_available(&English_verb_list_memlist, English_verb_list_size + entrysize);
     top = English_verb_list + English_verb_list_size;
     English_verb_list_size += entrysize;


@@ -592,11 +611,44 @@ static int get_verb(void)
         return j;
     }
 
         return j;
     }
 

-    ebf_error("an English verb in quotes", token_text);
+    ebf_curtoken_error("an English verb in quotes");

 
     return -1;
 }
 
 
     return -1;
 }
 

+void locate_dead_grammar_lines()
+{
+    /* Run through the grammar table and check whether each entry is
+       associated with a verb word. (Some might have been detached by
+       "Extend only".)
+    */
+    int verb;
+    char *p;
+
+    for (verb=0; verb<no_Inform_verbs; verb++) {
+        Inform_verbs[verb].used = FALSE;
+    }
+    
+    p=English_verb_list;
+    while (p < English_verb_list+English_verb_list_size)
+    {
+        verb = ((uchar)p[1] << 8) | (uchar)p[2];
+        if (verb < 0 || verb >= no_Inform_verbs) {
+            error_named("An entry in the English verb list had an invalid verb number", p+3);
+        }
+        else {
+            Inform_verbs[verb].used = TRUE;
+        }
+        p=p+(uchar)p[0];
+    }
+
+    for (verb=0; verb<no_Inform_verbs; verb++) {
+        if (!Inform_verbs[verb].used) {
+            warning_at("Verb declaration no longer has any verbs associated. Use \"Extend replace\" instead of \"Extend only\"?", Inform_verbs[verb].line);
+        }
+    }
+}
+

 /* ------------------------------------------------------------------------- */
 /*   Grammar lines for Verb/Extend directives.                               */
 /* ------------------------------------------------------------------------- */
 /* ------------------------------------------------------------------------- */
 /*   Grammar lines for Verb/Extend directives.                               */
 /* ------------------------------------------------------------------------- */


@@ -652,7 +704,7 @@ static int grammar_line(int verbnum, int line)
     }
     if (!((token_type == SEP_TT) && (token_value == TIMES_SEP)))
     {   discard_token_location(beginning_debug_location);
     }
     if (!((token_type == SEP_TT) && (token_value == TIMES_SEP)))
     {   discard_token_location(beginning_debug_location);

-        ebf_error("'*' divider", token_text);
+        ebf_curtoken_error("'*' divider");

         panic_mode_error_recovery();
         return FALSE;
     }
         panic_mode_error_recovery();
         return FALSE;
     }


@@ -680,12 +732,12 @@ static int grammar_line(int verbnum, int line)
         bytecode = 0; wordcode = 0;
         if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
         {   discard_token_location(beginning_debug_location);
         bytecode = 0; wordcode = 0;
         if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
         {   discard_token_location(beginning_debug_location);

-            ebf_error("'->' clause", token_text);
+            ebf_curtoken_error("'->' clause");

             return FALSE;
         }
         if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
         {   if (last_was_slash && (grammar_token>0))
             return FALSE;
         }
         if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
         {   if (last_was_slash && (grammar_token>0))

-                ebf_error("grammar token", token_text);
+                ebf_curtoken_error("grammar token");

             break;
         }
 
             break;
         }
 


@@ -694,7 +746,7 @@ static int grammar_line(int verbnum, int line)
         {   if (grammar_version_number == 1)
                 error("'/' can only be used with Library 6/3 or later");
             if (last_was_slash)
         {   if (grammar_version_number == 1)
                 error("'/' can only be used with Library 6/3 or later");
             if (last_was_slash)

-                ebf_error("grammar token or '->'", token_text);
+                ebf_curtoken_error("grammar token or '->'");

             else
             {   last_was_slash = TRUE;
                 slash_mode = TRUE;
             else
             {   last_was_slash = TRUE;
                 slash_mode = TRUE;


@@ -724,7 +776,7 @@ static int grammar_line(int verbnum, int line)
                      if ((token_type != SYMBOL_TT)
                          || (symbols[token_value].type != ROUTINE_T))
                      {   discard_token_location(beginning_debug_location);
                      if ((token_type != SYMBOL_TT)
                          || (symbols[token_value].type != ROUTINE_T))
                      {   discard_token_location(beginning_debug_location);

-                         ebf_error("routine name after 'noun='", token_text);
+                         ebf_curtoken_error("routine name after 'noun='");

                          panic_mode_error_recovery();
                          return FALSE;
                      }
                          panic_mode_error_recovery();
                          return FALSE;
                      }


@@ -779,7 +831,7 @@ are using Library 6/3 or later");
                  get_next_token();
                  if (!((token_type==SEP_TT)&&(token_value==SETEQUALS_SEP)))
                  {   discard_token_location(beginning_debug_location);
                  get_next_token();
                  if (!((token_type==SEP_TT)&&(token_value==SETEQUALS_SEP)))
                  {   discard_token_location(beginning_debug_location);

-                     ebf_error("'=' after 'scope'", token_text);
+                     ebf_curtoken_error("'=' after 'scope'");

                      panic_mode_error_recovery();
                      return FALSE;
                  }
                      panic_mode_error_recovery();
                      return FALSE;
                  }


@@ -788,7 +840,7 @@ are using Library 6/3 or later");
                  if ((token_type != SYMBOL_TT)
                      || (symbols[token_value].type != ROUTINE_T))
                  {   discard_token_location(beginning_debug_location);
                  if ((token_type != SYMBOL_TT)
                      || (symbols[token_value].type != ROUTINE_T))
                  {   discard_token_location(beginning_debug_location);

-                     ebf_error("routine name after 'scope='", token_text);
+                     ebf_curtoken_error("routine name after 'scope='");

                      panic_mode_error_recovery();
                      return FALSE;
                  }
                      panic_mode_error_recovery();
                      return FALSE;
                  }


@@ -865,9 +917,9 @@ tokens in any line (unless you're compiling with library 6/3 or later)");
     get_next_token();
     dont_enter_into_symbol_table = FALSE;
 
     get_next_token();
     dont_enter_into_symbol_table = FALSE;
 

-    if (token_type != DQ_TT)
+    if (token_type != UQ_TT)

     {   discard_token_location(beginning_debug_location);
     {   discard_token_location(beginning_debug_location);

-        ebf_error("name of new or existing action", token_text);
+        ebf_curtoken_error("name of new or existing action");

         panic_mode_error_recovery();
         return FALSE;
     }
         panic_mode_error_recovery();
         return FALSE;
     }


@@ -957,7 +1009,7 @@ extern void make_verb(void)
     }
 
     if (no_given == 0)
     }
 
     if (no_given == 0)

-    {   ebf_error("English verb in quotes", token_text);
+    {   ebf_curtoken_error("English verb in quotes");

         panic_mode_error_recovery(); return;
     }
 
         panic_mode_error_recovery(); return;
     }
 


@@ -968,7 +1020,7 @@ extern void make_verb(void)
         if (Inform_verb == -1) return;
         get_next_token();
         if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
         if (Inform_verb == -1) return;
         get_next_token();
         if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))

-            ebf_error("';' after English verb", token_text);
+            ebf_curtoken_error("';' after English verb");

     }
     else
     {   verb_equals_form = FALSE;
     }
     else
     {   verb_equals_form = FALSE;


@@ -976,11 +1028,17 @@ extern void make_verb(void)
             error("Z-code is limited to 255 verbs.");
             panic_mode_error_recovery(); return;
         }
             error("Z-code is limited to 255 verbs.");
             panic_mode_error_recovery(); return;
         }

+        if (no_Inform_verbs >= 65535) {
+            error("Inform is limited to 65535 verbs.");
+            panic_mode_error_recovery(); return;
+        }

         ensure_memory_list_available(&Inform_verbs_memlist, no_Inform_verbs+1);
         Inform_verb = no_Inform_verbs;
         Inform_verbs[no_Inform_verbs].lines = 0;
         Inform_verbs[no_Inform_verbs].size = 4;
         Inform_verbs[no_Inform_verbs].l = my_malloc(sizeof(int) * Inform_verbs[no_Inform_verbs].size, "grammar lines for one verb");
         ensure_memory_list_available(&Inform_verbs_memlist, no_Inform_verbs+1);
         Inform_verb = no_Inform_verbs;
         Inform_verbs[no_Inform_verbs].lines = 0;
         Inform_verbs[no_Inform_verbs].size = 4;
         Inform_verbs[no_Inform_verbs].l = my_malloc(sizeof(int) * Inform_verbs[no_Inform_verbs].size, "grammar lines for one verb");

+        Inform_verbs[no_Inform_verbs].line = get_brief_location(&ErrorReport);
+        Inform_verbs[no_Inform_verbs].used = FALSE;

     }
 
     for (i=0, pos=0; i<no_given; i++) {
     }
 
     for (i=0, pos=0; i<no_given; i++) {


@@ -1032,6 +1090,10 @@ extern void extend_verb(void)
             error("Z-code is limited to 255 verbs.");
             panic_mode_error_recovery(); return;
         }
             error("Z-code is limited to 255 verbs.");
             panic_mode_error_recovery(); return;
         }

+        if (no_Inform_verbs >= 65535) {
+            error("Inform is limited to 65535 verbs.");
+            panic_mode_error_recovery(); return;
+        }

         ensure_memory_list_available(&Inform_verbs_memlist, no_Inform_verbs+1);
         l = -1;
         while (get_next_token(),
         ensure_memory_list_available(&Inform_verbs_memlist, no_Inform_verbs+1);
         l = -1;
         while (get_next_token(),


@@ -1061,6 +1123,8 @@ extern void extend_verb(void)
         Inform_verbs[no_Inform_verbs].l = my_malloc(sizeof(int) * Inform_verbs[no_Inform_verbs].size, "grammar lines for one verb");
         for (k=0; k<l; k++)
             Inform_verbs[no_Inform_verbs].l[k] = Inform_verbs[Inform_verb].l[k];
         Inform_verbs[no_Inform_verbs].l = my_malloc(sizeof(int) * Inform_verbs[no_Inform_verbs].size, "grammar lines for one verb");
         for (k=0; k<l; k++)
             Inform_verbs[no_Inform_verbs].l[k] = Inform_verbs[Inform_verb].l[k];

+        Inform_verbs[no_Inform_verbs].line = get_brief_location(&ErrorReport);
+        Inform_verbs[no_Inform_verbs].used = FALSE;

         Inform_verb = no_Inform_verbs++;
     }
     else
         Inform_verb = no_Inform_verbs++;
     }
     else


@@ -1084,7 +1148,7 @@ extern void extend_verb(void)
             extend_mode = EXTEND_LAST;
 
         if (extend_mode==0)
             extend_mode = EXTEND_LAST;
 
         if (extend_mode==0)

-        {   ebf_error("'replace', 'last', 'first' or '*'", token_text);
+        {   ebf_curtoken_error("'replace', 'last', 'first' or '*'");

             extend_mode = EXTEND_LAST;
         }
     }
             extend_mode = EXTEND_LAST;
         }
     }


@@ -1179,6 +1243,10 @@ extern void verbs_allocate_arrays(void)
         sizeof(uchar), 50*DICT_WORD_BYTES, (void**)&adjective_sort_code,
         "adjective sort codes");
 
         sizeof(uchar), 50*DICT_WORD_BYTES, (void**)&adjective_sort_code,
         "adjective sort codes");
 

+    initialise_memory_list(&action_symname_memlist,
+        sizeof(uchar), 32, NULL,
+        "action temporary symbols");
+    

     initialise_memory_list(&English_verb_list_memlist,
         sizeof(char), 2048, (void**)&English_verb_list,
         "register of verbs");
     initialise_memory_list(&English_verb_list_memlist,
         sizeof(char), 2048, (void**)&English_verb_list,
         "register of verbs");


@@ -1201,6 +1269,7 @@ extern void verbs_free_arrays(void)
     deallocate_memory_list(&grammar_token_routine_memlist);
     deallocate_memory_list(&adjectives_memlist);
     deallocate_memory_list(&adjective_sort_code_memlist);
     deallocate_memory_list(&grammar_token_routine_memlist);
     deallocate_memory_list(&adjectives_memlist);
     deallocate_memory_list(&adjective_sort_code_memlist);

+    deallocate_memory_list(&action_symname_memlist);

     deallocate_memory_list(&English_verb_list_memlist);
     deallocate_memory_list(&English_verbs_given_memlist);
 }
     deallocate_memory_list(&English_verb_list_memlist);
     deallocate_memory_list(&English_verbs_given_memlist);
 }