Update to Inform v6.42
[inform.git] / src / asm.c
index 3c53096c05956f084497ed8d8d020459a1ff91eb..858ff9dd59477220fdc1887cc59386ed7c935ef6 100644 (file)
--- a/src/asm.c
+++ b/src/asm.c
@@ -1,8 +1,8 @@
 /* ------------------------------------------------------------------------- */
 /*   "asm" : The Inform assembler                                            */
 /*                                                                           */
-/*   Part of Inform 6.40                                                     */
-/*   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      */
@@ -67,6 +67,8 @@ int uses_float_features;           /* Makes use of Glulx floating-point (3.1.2)
                                       features?                              */
 int uses_extundo_features;         /* Makes use of Glulx extended undo (3.1.3)
                                       features?                              */
+int uses_double_features;          /* Makes use of Glulx double-prec (3.1.3)
+                                      features?                              */
 
 debug_location statement_debug_location;
                                    /* Location of current statement          */
@@ -90,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
-                                      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;
 
@@ -220,6 +220,8 @@ static memory_list sequence_points_memlist;
    The linked list must be in increasing PC order. We know this will
    be true because we call this as we run through the function, so
    zmachine_pc always increases.
+
+   (It won't necessarily be in *label index* order, though.)
 */
 static void set_label_offset(int label, int32 offset)
 {
@@ -318,7 +320,7 @@ extern int is_variable_ot(int otval)
 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");
@@ -504,6 +506,7 @@ typedef struct opcodeg
 #define GOP_Acceleration 4   /* uses_acceleration_features */
 #define GOP_Float        8   /* uses_float_features */
 #define GOP_ExtUndo     16   /* uses_extundo_features */
+#define GOP_Double      32   /* uses_double_features */
 
     /* Codes for the number of operands */
 
@@ -652,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 },
-/* 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 */
@@ -772,6 +780,8 @@ static opcodeg opcodes_table_g[] = {
   { (uchar *) "mfree",      0x179,  0, GOP_MemHeap, 1 },
   { (uchar *) "accelfunc",  0x180,  0, GOP_Acceleration, 2 },
   { (uchar *) "accelparam", 0x181,  0, GOP_Acceleration, 2 },
+  { (uchar *) "hasundo",    0x128,  St, GOP_ExtUndo, 1 },
+  { (uchar *) "discardundo",0x129,   0, GOP_ExtUndo, 0 },
   { (uchar *) "numtof",     0x190,  St, GOP_Float, 2 },
   { (uchar *) "ftonumz",    0x191,  St, GOP_Float, 2 },
   { (uchar *) "ftonumn",    0x192,  St, GOP_Float, 2 },
@@ -801,15 +811,47 @@ static opcodeg opcodes_table_g[] = {
   { (uchar *) "jfge",       0x1C5,  Br, GOP_Float, 3 },
   { (uchar *) "jisnan",     0x1C8,  Br, GOP_Float, 2 },
   { (uchar *) "jisinf",     0x1C9,  Br, GOP_Float, 2 },
-  { (uchar *) "hasundo",    0x128,  St, GOP_ExtUndo, 1 },
-  { (uchar *) "discardundo",0x129,   0, GOP_ExtUndo, 0 },
+  { (uchar *) "numtod",     0x200,  St|St2, GOP_Double, 3 },
+  { (uchar *) "dtonumz",    0x201,  St, GOP_Double, 3 },
+  { (uchar *) "dtonumn",    0x202,  St, GOP_Double, 3 },
+  { (uchar *) "ftod",       0x203,  St|St2, GOP_Double, 3 },
+  { (uchar *) "dtof",       0x204,  St, GOP_Double, 3 },
+  { (uchar *) "dceil",      0x208,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dfloor",     0x209,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dadd",       0x210,  St|St2, GOP_Double, 6 },
+  { (uchar *) "dsub",       0x211,  St|St2, GOP_Double, 6 },
+  { (uchar *) "dmul",       0x212,  St|St2, GOP_Double, 6 },
+  { (uchar *) "ddiv",       0x213,  St|St2, GOP_Double, 6 },
+  { (uchar *) "dmodr",      0x214,  St|St2, GOP_Double, 6 },
+  { (uchar *) "dmodq",      0x215,  St|St2, GOP_Double, 6 },
+  { (uchar *) "dsqrt",      0x218,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dexp",       0x219,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dlog",       0x21A,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dpow",       0x21B,  St|St2, GOP_Double, 6 },
+  { (uchar *) "dsin",       0x220,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dcos",       0x221,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dtan",       0x222,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dasin",      0x223,  St|St2, GOP_Double, 4 },
+  { (uchar *) "dacos",      0x224,  St|St2, GOP_Double, 4 },
+  { (uchar *) "datan",      0x225,  St|St2, GOP_Double, 4 },
+  { (uchar *) "datan2",     0x226,  St|St2, GOP_Double, 6 },
+  { (uchar *) "jdeq",       0x230,  Br, GOP_Double, 7 },
+  { (uchar *) "jdne",       0x231,  Br, GOP_Double, 7 },
+  { (uchar *) "jdlt",       0x232,  Br, GOP_Double, 5 },
+  { (uchar *) "jdle",       0x233,  Br, GOP_Double, 5 },
+  { (uchar *) "jdgt",       0x234,  Br, GOP_Double, 5 },
+  { (uchar *) "jdge",       0x235,  Br, GOP_Double, 5 },
+  { (uchar *) "jdisnan",    0x238,  Br, GOP_Double, 3 },
+  { (uchar *) "jdisinf",    0x239,  Br, GOP_Double, 3 },
 };
 
 /* The opmacros table is used for fake opcodes. The opcode numbers are
    ignored; this table is only used for argument parsing. */
 static opcodeg opmacros_table_g[] = {
-  { (uchar *) "pull", 0, St, 0, 1 },
-  { (uchar *) "push", 0,  0, 0, 1 },
+  { (uchar *) "pull",   pull_gm,       St, 0, 1 },
+  { (uchar *) "push",   push_gm,        0, 0, 1 },
+  { (uchar *) "dload",  dload_gm,  St|St2, 0, 3 },
+  { (uchar *) "dstore", dstore_gm,      0, 0, 3 },
 };
 
 static opcodeg custom_opcode_g;
@@ -833,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;
+    /* TODO: opcode_syntax_string[128] is unsafe */
     sprintf(q, "%s", opco.name);
     switch(opco.no)
     {   case ONE: p=" <operand>"; break;
@@ -880,6 +923,7 @@ static void make_opcode_syntax_g(opcodeg opco)
     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,
@@ -934,10 +978,6 @@ static void make_opcode_syntax_g(opcodeg opco)
 /* This is for Z-code only. */
 static void write_operand(assembly_operand op)
 {   int32 j;
-    if (module_switch && (op.marker != 0))
-    {   if ((op.marker != VARIABLE_MV) && (op.type == SHORT_CONSTANT_OT))
-            op.type = LONG_CONSTANT_OT;
-    }
     j=op.value;
     switch(op.type)
     {   case LONG_CONSTANT_OT:
@@ -947,7 +987,7 @@ static void write_operand(assembly_operand op)
             byteout(j, 0);
             else byteout(j, 0x80 + op.marker); return;
         case VARIABLE_OT:
-            byteout(j, (module_switch)?(0x80 + op.marker):0); return;
+            byteout(j, 0); return;
         case CONSTANT_OT:
         case HALFCONSTANT_OT:
         case BYTECONSTANT_OT:
@@ -1130,7 +1170,8 @@ extern void assemblez_instruction(const assembly_instruction *AI)
 
         /*  Note that variable numbers 249 to 255 (i.e. globals 233 to 239)
             are used as scratch workspace, so need no mapping between
-            modules and story files: nor do local variables 0 to 15  */
+            modules and story files: nor do local variables 0 to 15.
+            (Modules no longer exist but why drop a good comment.) */
 
         if ((o1.value >= MAX_LOCAL_VARIABLES) && (o1.value < 249))
             o1.marker = VARIABLE_MV;
@@ -1214,14 +1255,14 @@ 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                               ");
+                if (zcode_markers[start_pc] & 0x7f)
+                    printf("{%s}", describe_mv_short(zcode_markers[start_pc] & 0x7f));
                 printf("%02x ", zcode_holding_area[start_pc]);
             }
         }
         printf("\n");
     }
 
-    if (module_switch) flush_link_data();
-
     return;
 
     OpcodeSyntaxError:
@@ -1232,9 +1273,11 @@ extern void assemblez_instruction(const assembly_instruction *AI)
 
 static void assembleg_macro(const assembly_instruction *AI)
 {
-    /* validate macro syntax first */
     int ix, no_operands_given;
     opcodeg opco;
+    assembly_operand AMO_0, AMO_1, AMO_2;
+    
+    /* validate macro syntax first */
     
     opco = internal_number_to_opmacro_g(AI->internal_number);
     no_operands_given = AI->operand_count;
@@ -1261,14 +1304,51 @@ static void assembleg_macro(const assembly_instruction *AI)
         }
     }
     
-    /* expand the macro */
-    switch (AI->internal_number) {
-        case pull_gm:
-            assembleg_store(AI->operand[0], stack_pointer);
+    /* Expand the macro.
+       The assembleg_() functions overwrite AI, so we need to copy out
+       its operands before we call them. */
+    
+    switch (opco.code) {
+        case pull_gm:   /* @pull STORE */
+            AMO_0 = AI->operand[0];
+            assembleg_store(AMO_0, stack_pointer);
             break;
         
-        case push_gm:
-            assembleg_store(stack_pointer, AI->operand[0]);
+        case push_gm:   /* @push LOAD */
+            AMO_0 = AI->operand[0];
+            assembleg_store(stack_pointer, AMO_0);
+            break;
+
+        case dload_gm:   /* @dload LOAD STORELO STOREHI */
+            AMO_0 = AI->operand[0];
+            AMO_1 = AI->operand[1];
+            AMO_2 = AI->operand[2];
+            if ((AMO_0.type == LOCALVAR_OT) && (AMO_0.value == 0)) {
+                /* addr is on the stack */
+                assembleg_store(temp_var3, stack_pointer);
+                assembleg_3(aload_gc, temp_var3, one_operand, AMO_1);
+                assembleg_3(aload_gc, temp_var3, zero_operand, AMO_2);
+            }
+            else {
+                assembleg_3(aload_gc, AMO_0, one_operand, AMO_1);
+                assembleg_3(aload_gc, AMO_0, zero_operand, AMO_2);
+            }
+            break;
+
+        case dstore_gm:   /* @dload LOAD LOADHI LOADLO */
+            AMO_0 = AI->operand[0];
+            AMO_1 = AI->operand[1];
+            AMO_2 = AI->operand[2];
+            if ((AMO_0.type == LOCALVAR_OT) && (AMO_0.value == 0)) {
+                /* addr is on the stack */
+                assembleg_store(temp_var3, stack_pointer);
+                assembleg_3(astore_gc, temp_var3, zero_operand, AMO_1);
+                assembleg_3(astore_gc, temp_var3, one_operand, AMO_2);
+            }
+            else {
+                assembleg_3(astore_gc, AMO_0, zero_operand, AMO_1);
+                assembleg_3(astore_gc, AMO_0, one_operand, AMO_2);
+            }
             break;
         
         default:
@@ -1341,6 +1421,9 @@ extern void assembleg_instruction(const assembly_instruction *AI)
     if (opco.op_rules & GOP_ExtUndo) {
         uses_extundo_features = TRUE;
     }
+    if (opco.op_rules & GOP_Double) {
+        uses_double_features = TRUE;
+    }
 
     no_operands_given = AI->operand_count;
 
@@ -1571,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]);
                 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(" ");
             }
         }
@@ -1581,8 +1664,6 @@ extern void assembleg_instruction(const assembly_instruction *AI)
       printf("\n");
     }
 
-    if (module_switch) flush_link_data();
-
     return;
 
     OpcodeSyntaxError:
@@ -1596,12 +1677,16 @@ extern void assembleg_instruction(const assembly_instruction *AI)
    is assumed to be reachable. 
    However, if STRIP_UNREACHABLE_LABELS and EXECSTATE_ENTIRE are both set,
    that's not true. The entire statement is being skipped, so we can safely
-   skip all labels within it.
+   skip all unused labels within it.
+   ("Unused" meaning there are no forward jumps to the label. We can't
+   do anything about *backward* jumps because we haven't seen them yet!)
    (If STRIP_UNREACHABLE_LABELS is not set, the ENTIRE flag is ignored.)
 */
 extern void assemble_label_no(int n)
 {
-    if ((execution_never_reaches_here & EXECSTATE_ENTIRE) && STRIP_UNREACHABLE_LABELS) {
+    int inuse = (n >= 0 && n < labeluse_size && labeluse[n]);
+    
+    if ((!inuse) && (execution_never_reaches_here & EXECSTATE_ENTIRE) && STRIP_UNREACHABLE_LABELS) {
         /* We're not going to compile this label at all. Set a negative
            offset, which will trip an error if this label is jumped to. */
         set_label_offset(n, -1);
@@ -1644,22 +1729,22 @@ extern void define_symbol_label(int 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;
 
-    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
-      && 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;
@@ -1722,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;
-
+          /* TODO: fnt[256] is unsafe */
+          
           ln = next_label++;
           ln2 = next_label++;
 
@@ -1966,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);
-        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)
@@ -1992,7 +2078,7 @@ void assemble_routine_end(int embedded_flag, debug_locations locations)
 
     /* 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);
@@ -2128,14 +2214,17 @@ static void transfer_routine_z(void)
             offset_of_next = new_pc + long_form + 1;
 
             if (labels[j].offset < 0) {
-                error("Attempt to jump to an unreachable label");
+                char *lname = "(anon)";
+                if (labels[j].symbol >= 0 && labels[j].symbol < no_symbols)
+                    lname = symbols[labels[j].symbol].name;
+                error_named("Attempt to jump to an unreachable label", lname);
                 addr = 0;
             }
             else {
                 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;
@@ -2156,14 +2245,17 @@ static void transfer_routine_z(void)
           case LABEL_MV:
             j = 256*zcode_holding_area[i] + zcode_holding_area[i+1];
             if (labels[j].offset < 0) {
-                error("Attempt to jump to an unreachable label");
+                char *lname = "(anon)";
+                if (labels[j].symbol >= 0 && labels[j].symbol < no_symbols)
+                    lname = symbols[labels[j].symbol].name;
+                error_named("Attempt to jump to an unreachable label", lname);
                 addr = 0;
             }
             else {
                 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;
@@ -2176,11 +2268,12 @@ static void transfer_routine_z(void)
           default:
             switch(zcode_markers[i] & 0x7f)
             {   case NULL_MV: break;
+                case ERROR_MV: break;
                 case VARIABLE_MV:
                 case OBJECT_MV:
                 case ACTION_MV:
                 case IDENT_MV:
-                    if (!module_switch) break;
+                    break;
                 default:
                     if ((zcode_markers[i] & 0x7f) > LARGEST_BPATCH_MV)
                     {   compiler_error("Illegal code backpatch value");
@@ -2356,7 +2449,10 @@ static void transfer_routine_g(void)
         offset_of_next = new_pc + form_len;
 
         if (labels[j].offset < 0) {
-            error("Attempt to jump to an unreachable label");
+            char *lname = "(anon)";
+            if (labels[j].symbol >= 0 && labels[j].symbol < no_symbols)
+                lname = symbols[labels[j].symbol].name;
+            error_named("Attempt to jump to an unreachable label", lname);
             addr = 0;
         }
         else {
@@ -2398,9 +2494,11 @@ static void transfer_routine_g(void)
         switch(zcode_markers[i] & 0x7f) {
         case NULL_MV: 
             break;
+        case ERROR_MV:
+            break;
         case ACTION_MV:
         case IDENT_MV:
-            if (!module_switch) break;
+            break;
         case OBJECT_MV:
         case VARIABLE_MV:
         default:
@@ -2974,7 +3072,9 @@ static assembly_operand parse_operand_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;
@@ -3020,8 +3120,7 @@ static void parse_assembly_z(void)
         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;
@@ -3037,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))
-            {   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;
             }
         }
@@ -3061,9 +3159,74 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
         }
         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)
-        {   ebf_error("an opcode name", token_text);
+        {   ebf_curtoken_error("an opcode name");
             panic_mode_error_recovery();
             return;
         }
@@ -3072,11 +3235,12 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
     }
 
     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)
-            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();
@@ -3085,7 +3249,7 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
             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;
@@ -3103,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))
-                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
@@ -3143,7 +3307,7 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
                     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;
@@ -3162,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)))
-            {   ebf_error("']'", token_text);
+            {   ebf_curtoken_error("']'");
                 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();
@@ -3262,151 +3432,218 @@ static assembly_operand parse_operand_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)");
-      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)
@@ -3431,6 +3668,7 @@ extern void init_asm_vars(void)
     uses_acceleration_features = FALSE;
     uses_float_features = FALSE;
     uses_extundo_features = FALSE;
+    uses_double_features = FALSE;
 
     labels = NULL;
     sequence_points = NULL;
@@ -3483,7 +3721,7 @@ extern void asm_allocate_arrays(void)
         "code area");
 
     initialise_memory_list(&current_routine_name,
-        sizeof(char), 3*MAX_IDENTIFIER_LENGTH, NULL,
+        sizeof(char), 64, NULL,
         "routine name currently being defined");
 }