src/objects.c

   1 /* ------------------------------------------------------------------------- */
   2 /*   "objects" :  [1] the object-maker, which constructs objects and enters  */
   3 /*                    them into the tree, given a low-level specification;   */
   4 /*                                                                           */
   5 /*                [2] the parser of Object/Nearby/Class directives, which    */
   6 /*                    checks syntax and translates such directives into      */
   7 /*                    specifications for the object-maker.                   */
   8 /*                                                                           */
   9 /*   Part of Inform 6.40                                                     */
  10 /*   copyright (c) Graham Nelson 1993 - 2022                                 */
  11 /*                                                                           */
  12 /* Inform is free software: you can redistribute it and/or modify            */
  13 /* it under the terms of the GNU General Public License as published by      */
  14 /* the Free Software Foundation, either version 3 of the License, or         */
  15 /* (at your option) any later version.                                       */
  16 /*                                                                           */
  17 /* Inform is distributed in the hope that it will be useful,                 */
  18 /* but WITHOUT ANY WARRANTY; without even the implied warranty of            */
  19 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the              */
  20 /* GNU General Public License for more details.                              */
  21 /*                                                                           */
  22 /* You should have received a copy of the GNU General Public License         */
  23 /* along with Inform. If not, see https://gnu.org/licenses/                  */
  24 /*                                                                           */
  25 /* ------------------------------------------------------------------------- */
  26
  27 #include "header.h"
  28
  29 /* ------------------------------------------------------------------------- */
  30 /*   Objects.                                                                */
  31 /* ------------------------------------------------------------------------- */
  32
  33 int no_objects;                        /* Number of objects made so far      */
  34
  35 static int no_embedded_routines;       /* Used for naming routines which
  36                                           are given as property values: these
  37                                           are called EmbeddedRoutine__1, ... */
  38
  39 static fpropt full_object;             /* "fpropt" is a typedef for a struct
  40                                           containing an array to hold the
  41                                           attribute and property values of
  42                                           a single object.  We only keep one
  43                                           of these, for the current object
  44                                           being made, and compile it into
  45                                           Z-machine tables when each object
  46                                           definition is complete, since
  47                                           sizeof(fpropt) is about 6200 bytes */
  48 static fproptg full_object_g;          /* Equivalent for Glulx. This object
  49                                           is very small, since the large arrays
  50                                           are allocated dynamically as
  51                                           memory-lists                       */
  52
  53 static char shortname_buffer[766];     /* Text buffer to hold the short name
  54                                           (which is read in first, but
  55                                           written almost last)               */
  56 static int parent_of_this_obj;
  57
  58 static memory_list current_object_name; /* The name of the object currently
  59                                            being defined.                    */
  60
  61 static int current_classname_symbol;    /* The symbol index of the class
  62                                            currently being defined.
  63                                            For error-checking and printing
  64                                            names of embedded routines only.  */
  65
  66 static memory_list embedded_function_name; /* Temporary storage for inline
  67                                               function name in property.     */
  68
  69 /* ------------------------------------------------------------------------- */
  70 /*   Classes.                                                                */
  71 /* ------------------------------------------------------------------------- */
  72 /*   Arrays defined below:                                                   */
  73 /*                                                                           */
  74 /*    classinfo class_info[]              Object number and prop offset      */
  75 /*    int   classes_to_inherit_from[]     The list of classes to inherit     */
  76 /*                                        from as taken from the current     */
  77 /*                                        Nearby/Object/Class definition     */
  78 /* ------------------------------------------------------------------------- */
  79
  80 int        no_classes;                 /* Number of class defns made so far  */
  81
  82 static int current_defn_is_class,      /* TRUE if current Nearby/Object/Class
  83                                           defn is in fact a Class definition */
  84            no_classes_to_inherit_from; /* Number of classes in the list
  85                                           of classes to inherit in the
  86                                           current Nearby/Object/Class defn   */
  87
  88 /* ------------------------------------------------------------------------- */
  89 /*   Making attributes and properties.                                       */
  90 /* ------------------------------------------------------------------------- */
  91
  92 int no_attributes,                 /* Number of attributes defined so far    */
  93     no_properties;                 /* Number of properties defined so far,
  94                                       plus 1 (properties are numbered from
  95                                       1 and Inform creates "name" and two
  96                                       others itself, so the variable begins
  97                                       the compilation pass set to 4)         */
  98
  99 /* Print a PROPS trace line. The f flag is 0 for an attribute, 1 for
 100    a common property, 2 for an individual property. */
 101 static void trace_s(char *name, int32 number, int f)
 102 {   if (!printprops_switch) return;
 103     char *stype = "";
 104     if (f == 0) stype = "Attr";
 105     else if (f == 1) stype = "Prop";
 106     else if (f == 2) stype = "Indiv";
 107     printf("%-5s  %02ld  ", stype, (long int) number);
 108     if (f != 1) printf("  ");
 109     else      printf("%s%s",(commonprops[number].is_long)?"L":" ",
 110                             (commonprops[number].is_additive)?"A":" ");
 111     printf("  %s\n", name);
 112 }
 113
 114 extern void make_attribute(void)
 115 {   int i; char *name;
 116     debug_location_beginning beginning_debug_location =
 117         get_token_location_beginning();
 118
 119  if (!glulx_mode) {
 120     if (no_attributes==((version_number==3)?32:48))
 121     {   discard_token_location(beginning_debug_location);
 122         if (version_number==3)
 123             error("All 32 attributes already declared (compile as Advanced \
 124 game to get an extra 16)");
 125         else
 126             error("All 48 attributes already declared");
 127         panic_mode_error_recovery();
 128         put_token_back();
 129         return;
 130     }
 131  }
 132  else {
 133     if (no_attributes==NUM_ATTR_BYTES*8) {
 134       discard_token_location(beginning_debug_location);
 135       error_numbered(
 136         "All attributes already declared -- increase NUM_ATTR_BYTES to use \
 137 more than",
 138         NUM_ATTR_BYTES*8);
 139       panic_mode_error_recovery();
 140       put_token_back();
 141       return;
 142     }
 143  }
 144
 145     get_next_token();
 146     i = token_value; name = token_text;
 147     /* We hold onto token_text through the end of this Property directive, which should be okay. */
 148     if (token_type != SYMBOL_TT)
 149     {   discard_token_location(beginning_debug_location);
 150         ebf_error("new attribute name", token_text);
 151         panic_mode_error_recovery();
 152         put_token_back();
 153         return;
 154     }
 155     if (!(symbols[i].flags & UNKNOWN_SFLAG))
 156     {   discard_token_location(beginning_debug_location);
 157         ebf_symbol_error("new attribute name", token_text, typename(symbols[i].type), symbols[i].line);
 158         panic_mode_error_recovery();
 159         put_token_back();
 160         return;
 161     }
 162
 163     directive_keywords.enabled = TRUE;
 164     get_next_token();
 165     directive_keywords.enabled = FALSE;
 166
 167     if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK))
 168     {   get_next_token();
 169         if (!((token_type == SYMBOL_TT)
 170               && (symbols[token_value].type == ATTRIBUTE_T)))
 171         {   discard_token_location(beginning_debug_location);
 172             ebf_error("an existing attribute name after 'alias'",
 173                 token_text);
 174             panic_mode_error_recovery();
 175             put_token_back();
 176             return;
 177         }
 178         assign_symbol(i, symbols[token_value].value, ATTRIBUTE_T);
 179         symbols[token_value].flags |= ALIASED_SFLAG;
 180         symbols[i].flags |= ALIASED_SFLAG;
 181     }
 182     else
 183     {   assign_symbol(i, no_attributes++, ATTRIBUTE_T);
 184         put_token_back();
 185     }
 186
 187     if (debugfile_switch)
 188     {   debug_file_printf("<attribute>");
 189         debug_file_printf("<identifier>%s</identifier>", name);
 190         debug_file_printf("<value>%d</value>", symbols[i].value);
 191         write_debug_locations(get_token_location_end(beginning_debug_location));
 192         debug_file_printf("</attribute>");
 193     }
 194
 195     trace_s(name, symbols[i].value, 0);
 196     return;
 197 }
 198
 199 /* Format:
 200    Property [long] [additive] name
 201    Property [long] [additive] name alias oldname
 202    Property [long] [additive] name defaultvalue
 203    Property [long] individual name
 204  */
 205 extern void make_property(void)
 206 {   int32 default_value, i;
 207     int keywords, prevkeywords;
 208     char *name;
 209     int namelen;
 210     int additive_flag, indiv_flag;
 211     debug_location_beginning beginning_debug_location =
 212         get_token_location_beginning();
 213
 214     /* The next bit is tricky. We want to accept any number of the keywords
 215        "long", "additive", "individual" before the property name. But we
 216        also want to accept "Property long" -- that's a legitimate
 217        property name.
 218        The solution is to keep track of which keywords we've seen in
 219        a bitmask, and another for one token previous. That way we
 220        can back up one token if there's no name visible. */
 221     keywords = prevkeywords = 0;
 222     do
 223     {   directive_keywords.enabled = TRUE;
 224         get_next_token();
 225         if ((token_type == DIR_KEYWORD_TT) && (token_value == LONG_DK)) {
 226             prevkeywords = keywords;
 227             keywords |= 1;
 228         }
 229         else if ((token_type == DIR_KEYWORD_TT) && (token_value == ADDITIVE_DK)) {
 230             prevkeywords = keywords;
 231             keywords |= 2;
 232         }
 233         else if ((token_type == DIR_KEYWORD_TT) && (token_value == INDIVIDUAL_DK)) {
 234             prevkeywords = keywords;
 235             keywords |= 4;
 236         }
 237         else {
 238             break;
 239         }
 240     } while (TRUE);
 241
 242     /* Re-parse the name with keywords turned off. (This allows us to
 243        accept a property name like "table".) */
 244     put_token_back();
 245     directive_keywords.enabled = FALSE;
 246     get_next_token();
 247
 248     if (token_type != SYMBOL_TT && keywords) {
 249         /* This can't be a name. Try putting back the last keyword. */
 250         keywords = prevkeywords;
 251         put_token_back();
 252         put_token_back();
 253         get_next_token();
 254     }
 255
 256     additive_flag = indiv_flag = FALSE;
 257     if (keywords & 1)
 258         obsolete_warning("all properties are now automatically 'long'");
 259     if (keywords & 2)
 260         additive_flag = TRUE;
 261     if (keywords & 4)
 262         indiv_flag = TRUE;
 263
 264     i = token_value; name = token_text;
 265     /* We hold onto token_text through the end of this Property directive, which should be okay. */
 266     if (token_type != SYMBOL_TT)
 267     {   discard_token_location(beginning_debug_location);
 268         ebf_error("new property name", token_text);
 269         panic_mode_error_recovery();
 270         put_token_back();
 271         return;
 272     }
 273     if (!(symbols[i].flags & UNKNOWN_SFLAG))
 274     {   discard_token_location(beginning_debug_location);
 275         ebf_symbol_error("new property name", token_text, typename(symbols[i].type), symbols[i].line);
 276         panic_mode_error_recovery();
 277         put_token_back();
 278         return;
 279     }
 280
 281     if (indiv_flag) {
 282         int this_identifier_number;
 283
 284         if (additive_flag)
 285         {   error("'individual' incompatible with 'additive'");
 286             panic_mode_error_recovery();
 287             put_token_back();
 288             return;
 289         }
 290
 291         this_identifier_number = no_individual_properties++;
 292         assign_symbol(i, this_identifier_number, INDIVIDUAL_PROPERTY_T);
 293         if (debugfile_switch) {
 294             debug_file_printf("<property>");
 295             debug_file_printf
 296                 ("<identifier>%s</identifier>", name);
 297             debug_file_printf
 298                 ("<value>%d</value>", this_identifier_number);
 299             debug_file_printf("</property>");
 300         }
 301         trace_s(name, symbols[i].value, 2);
 302         return;
 303     }
 304
 305     directive_keywords.enabled = TRUE;
 306     get_next_token();
 307     directive_keywords.enabled = FALSE;
 308
 309     namelen = strlen(name);
 310     if (namelen > 3 && strcmp(name+namelen-3, "_to") == 0) {
 311         /* Direction common properties "n_to", etc are compared in some
 312            libraries. They have STAR_SFLAG to tell us to skip a warning. */
 313         symbols[i].flags |= STAR_SFLAG;
 314     }
 315
 316     /* Now we might have "alias" or a default value (but not both). */
 317
 318     if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK))
 319     {   discard_token_location(beginning_debug_location);
 320         if (additive_flag)
 321         {   error("'alias' incompatible with 'additive'");
 322             panic_mode_error_recovery();
 323             put_token_back();
 324             return;
 325         }
 326         get_next_token();
 327         if (!((token_type == SYMBOL_TT)
 328             && (symbols[token_value].type == PROPERTY_T)))
 329         {   ebf_error("an existing property name after 'alias'",
 330                 token_text);
 331             panic_mode_error_recovery();
 332             put_token_back();
 333             return;
 334         }
 335
 336         assign_symbol(i, symbols[token_value].value, PROPERTY_T);
 337         trace_s(name, symbols[i].value, 1);
 338         symbols[token_value].flags |= ALIASED_SFLAG;
 339         symbols[i].flags |= ALIASED_SFLAG;
 340         return;
 341     }
 342
 343     /* We now know we're allocating a new common property. Make sure
 344        there's room. */
 345     if (!glulx_mode) {
 346         if (no_properties==((version_number==3)?32:64))
 347         {   discard_token_location(beginning_debug_location);
 348             /* The maximum listed here includes "name" but not the
 349                unused zero value or the two hidden properties (class
 350                inheritance and indiv table). */
 351             if (version_number==3)
 352                 error("All 29 properties already declared (compile as \
 353 Advanced game to get 32 more)");
 354             else
 355                 error("All 61 properties already declared");
 356             panic_mode_error_recovery();
 357             put_token_back();
 358             return;
 359         }
 360     }
 361     else {
 362         if (no_properties==INDIV_PROP_START) {
 363             char error_b[128];
 364             discard_token_location(beginning_debug_location);
 365             sprintf(error_b,
 366                 "All %d properties already declared (increase INDIV_PROP_START to get more)",
 367                 INDIV_PROP_START-3);
 368             error(error_b);
 369             panic_mode_error_recovery();
 370             put_token_back();
 371             return;
 372         }
 373     }
 374
 375     default_value = 0;
 376     put_token_back();
 377
 378     if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
 379     {
 380         assembly_operand AO = parse_expression(CONSTANT_CONTEXT);
 381         default_value = AO.value;
 382         if (AO.marker != 0)
 383             backpatch_zmachine(AO.marker, PROP_DEFAULTS_ZA,
 384                 (no_properties-1) * WORDSIZE);
 385     }
 386
 387     commonprops[no_properties].default_value = default_value;
 388     commonprops[no_properties].is_long = TRUE;
 389     commonprops[no_properties].is_additive = additive_flag;
 390
 391     assign_symbol(i, no_properties++, PROPERTY_T);
 392
 393     if (debugfile_switch)
 394     {   debug_file_printf("<property>");
 395         debug_file_printf("<identifier>%s</identifier>", name);
 396         debug_file_printf("<value>%d</value>", symbols[i].value);
 397         write_debug_locations
 398             (get_token_location_end(beginning_debug_location));
 399         debug_file_printf("</property>");
 400     }
 401
 402     trace_s(name, symbols[i].value, 1);
 403 }
 404
 405 /* ------------------------------------------------------------------------- */
 406 /*   Properties.                                                             */
 407 /* ------------------------------------------------------------------------- */
 408
 409 commonpropinfo *commonprops;            /* Info about common properties
 410                                            (fixed allocation of
 411                                            INDIV_PROP_START entries) */
 412
 413 uchar *properties_table;               /* Holds the table of property values
 414                                           (holding one block for each object
 415                                           and coming immediately after the
 416                                           object tree in Z-memory)           */
 417 memory_list properties_table_memlist;
 418 int properties_table_size;             /* Number of bytes in this table      */
 419
 420 /* ------------------------------------------------------------------------- */
 421 /*   Individual properties                                                   */
 422 /*                                                                           */
 423 /*   Each new i.p. name is given a unique number.  These numbers start from  */
 424 /*   72, since 0 is reserved as a null, 1 to 63 refer to common properties   */
 425 /*   and 64 to 71 are kept for methods of the metaclass Class (for example,  */
 426 /*   64 is "create").                                                        */
 427 /*                                                                           */
 428 /*   An object provides individual properties by having property 3 set to a  */
 429 /*   non-zero value, which must be a byte address of a table in the form:    */
 430 /*                                                                           */
 431 /*       <record-1> ... <record-n> 00 00                                     */
 432 /*                                                                           */
 433 /*   where a <record> looks like                                             */
 434 /*                                                                           */
 435 /*       <identifier>              <size>  <up to 255 bytes of data>         */
 436 /*       or <identifier + 0x8000>                                            */
 437 /*       ----- 2 bytes ----------  1 byte  <size> number of bytes            */
 438 /*                                                                           */
 439 /*   The <identifier> part is the number allocated to the name of what is    */
 440 /*   being provided.  The top bit of this word is set to indicate that       */
 441 /*   although the individual property is being provided, it is provided      */
 442 /*   only privately (so that it is inaccessible except to the object's own   */
 443 /*   embedded routines).                                                     */
 444 /*                                                                           */
 445 /*   In Glulx: i-props are numbered from INDIV_PROP_START+8 up. And all      */
 446 /*   properties, common and individual, are stored in the same table.        */
 447 /* ------------------------------------------------------------------------- */
 448
 449        int no_individual_properties;   /* Actually equal to the next
 450                                           identifier number to be allocated,
 451                                           so this is initially 72 even though
 452                                           none have been made yet.           */
 453 static int individual_prop_table_size; /* Size of the table of individual
 454                                           properties so far for current obj  */
 455        uchar *individuals_table;       /* Table of records, each being the
 456                                           i.p. table for an object           */
 457        memory_list individuals_table_memlist;
 458        int i_m;                        /* Write mark position in the above   */
 459        int individuals_length;         /* Extent of individuals_table        */
 460
 461 /* ------------------------------------------------------------------------- */
 462 /*   Arrays used by this file                                                */
 463 /* ------------------------------------------------------------------------- */
 464
 465 objecttz     *objectsz;              /* Allocated to no_objects; Z-code only */
 466 memory_list objectsz_memlist;
 467 objecttg     *objectsg;              /* Allocated to no_objects; Glulx only  */
 468 static memory_list objectsg_memlist;
 469 uchar        *objectatts;            /* Allocated to no_objects; Glulx only  */
 470 static memory_list objectatts_memlist;
 471 static int   *classes_to_inherit_from; /* Allocated to no_classes_to_inherit_from */
 472 static memory_list classes_to_inherit_from_memlist;
 473 classinfo    *class_info;            /* Allocated up to no_classes           */
 474 memory_list   class_info_memlist;
 475
 476 /* ------------------------------------------------------------------------- */
 477 /*   Tracing for compiler maintenance                                        */
 478 /* ------------------------------------------------------------------------- */
 479
 480 extern void list_object_tree(void)
 481 {   int i;
 482     printf("Object tree:\n");
 483     printf("obj name                             par nxt chl:\n");
 484     for (i=0; i<no_objects; i++) {
 485         if (!glulx_mode) {
 486             int sym = objectsz[i].symbol;
 487             char *symname = ((sym > 0) ? symbols[sym].name : "...");
 488             printf("%3d %-32s %3d %3d %3d\n",
 489                 i+1, symname,
 490                 objectsz[i].parent, objectsz[i].next, objectsz[i].child);
 491         }
 492         else {
 493             int sym = objectsg[i].symbol;
 494             char *symname = ((sym > 0) ? symbols[sym].name : "...");
 495             printf("%3d %-32s %3d %3d %3d\n",
 496                 i+1, symname,
 497                 objectsg[i].parent, objectsg[i].next, objectsg[i].child);
 498         }
 499     }
 500 }
 501
 502 /* ------------------------------------------------------------------------- */
 503 /*   Object and class manufacture begins here.                               */
 504 /*                                                                           */
 505 /*   These definitions have headers (parsed far, far below) and a series     */
 506 /*   of segments, introduced by keywords and optionally separated by commas. */
 507 /*   Each segment has its own parsing routine.  Note that when errors are    */
 508 /*   detected, parsing continues rather than being abandoned, which assists  */
 509 /*   a little in "error recovery" (i.e. in stopping lots more errors being   */
 510 /*   produced for essentially the same mistake).                             */
 511 /* ------------------------------------------------------------------------- */
 512
 513 /* ========================================================================= */
 514 /*   [1]  The object-maker: builds an object from a specification, viz.:     */
 515 /*                                                                           */
 516 /*           full_object,                                                    */
 517 /*           shortname_buffer,                                               */
 518 /*           parent_of_this_obj,                                             */
 519 /*           current_defn_is_class (flag)                                    */
 520 /*           classes_to_inherit_from[], no_classes_to_inherit_from,          */
 521 /*           individual_prop_table_size (to date  )                          */
 522 /*                                                                           */
 523 /*   For efficiency's sake, the individual properties table has already been */
 524 /*   created (as far as possible, i.e., all except for inherited individual  */
 525 /*   properties); unless the flag is clear, in which case the actual         */
 526 /*   definition did not specify any individual properties.                   */
 527 /* ========================================================================= */
 528 /*   Property inheritance from classes.                                      */
 529 /* ------------------------------------------------------------------------- */
 530
 531 static void property_inheritance_z(void)
 532 {
 533     /*  Apply the property inheritance rules to full_object, which should
 534         initially be complete (i.e., this routine takes place after the whole
 535         Nearby/Object/Class definition has been parsed through).
 536
 537         On exit, full_object contains the final state of the properties to
 538         be written.                                                          */
 539
 540     int i, j, k, kmax, class, mark,
 541         prop_number, prop_length, prop_in_current_defn;
 542     uchar *class_prop_block;
 543
 544     ASSERT_ZCODE();
 545
 546     for (class=0; class<no_classes_to_inherit_from; class++)
 547     {
 548         j=0;
 549         mark = class_info[classes_to_inherit_from[class] - 1].begins_at;
 550         class_prop_block = (properties_table + mark);
 551
 552         while (class_prop_block[j]!=0)
 553         {   if (version_number == 3)
 554             {   prop_number = class_prop_block[j]%32;
 555                 prop_length = 1 + class_prop_block[j++]/32;
 556             }
 557             else
 558             {   prop_number = class_prop_block[j]%64;
 559                 prop_length = 1 + class_prop_block[j++]/64;
 560                 if (prop_length > 2)
 561                     prop_length = class_prop_block[j++]%64;
 562             }
 563
 564             /*  So we now have property number prop_number present in the
 565                 property block for the class being read: its bytes are
 566
 567                 class_prop_block[j, ..., j + prop_length - 1]
 568
 569                 Question now is: is there already a value given in the
 570                 current definition under this property name?                 */
 571
 572             prop_in_current_defn = FALSE;
 573
 574             kmax = full_object.l;
 575             if (kmax > 64)
 576                 fatalerror("More than 64 property entries in an object");
 577
 578             for (k=0; k<kmax; k++)
 579                 if (full_object.pp[k].num == prop_number)
 580                 {   prop_in_current_defn = TRUE;
 581
 582                     /*  (Note that the built-in "name" property is additive) */
 583
 584                     if ((prop_number==1) || (commonprops[prop_number].is_additive))
 585                     {
 586                         /*  The additive case: we accumulate the class
 587                             property values onto the end of the full_object
 588                             property                                         */
 589
 590                         for (i=full_object.pp[k].l;
 591                              i<full_object.pp[k].l+prop_length/2; i++)
 592                         {   if (i >= 32)
 593                             {   error("An additive property has inherited \
 594 so many values that the list has overflowed the maximum 32 entries");
 595                                 break;
 596                             }
 597                             INITAOTV(&full_object.pp[k].ao[i], LONG_CONSTANT_OT, mark + j);
 598                             j += 2;
 599                             full_object.pp[k].ao[i].marker = INHERIT_MV;
 600                         }
 601                         full_object.pp[k].l += prop_length/2;
 602                     }
 603                     else
 604                         /*  The ordinary case: the full_object property
 605                             values simply overrides the class definition,
 606                             so we skip over the values in the class table    */
 607
 608                         j+=prop_length;
 609
 610                     if (prop_number==3)
 611                     {   int y, z, class_block_offset;
 612
 613                         /*  Property 3 holds the address of the table of
 614                             instance variables, so this is the case where
 615                             the object already has instance variables in its
 616                             own table but must inherit some more from the
 617                             class  */
 618
 619                         class_block_offset = class_prop_block[j-2]*256
 620                                              + class_prop_block[j-1];
 621
 622                         z = class_block_offset;
 623                         while ((individuals_table[z]!=0)||(individuals_table[z+1]!=0))
 624                         {   int already_present = FALSE, l;
 625                             for (l = full_object.pp[k].ao[0].value; l < i_m;
 626                                  l = l + 3 + individuals_table[l + 2])
 627                                 if (individuals_table[l] == individuals_table[z]
 628                                     && individuals_table[l + 1] == individuals_table[z+1])
 629                                 {   already_present = TRUE; break;
 630                                 }
 631                             if (already_present == FALSE)
 632                             {   if (module_switch)
 633                                     backpatch_zmachine(IDENT_MV,
 634                                         INDIVIDUAL_PROP_ZA, i_m);
 635                                 ensure_memory_list_available(&individuals_table_memlist, i_m+3+individuals_table[z+2]);
 636                                 individuals_table[i_m++] = individuals_table[z];
 637                                 individuals_table[i_m++] = individuals_table[z+1];
 638                                 individuals_table[i_m++] = individuals_table[z+2];
 639                                 for (y=0;y < individuals_table[z+2]/2;y++)
 640                                 {   individuals_table[i_m++] = (z+3+y*2)/256;
 641                                     individuals_table[i_m++] = (z+3+y*2)%256;
 642                                     backpatch_zmachine(INHERIT_INDIV_MV,
 643                                         INDIVIDUAL_PROP_ZA, i_m-2);
 644                                 }
 645                             }
 646                             z += individuals_table[z+2] + 3;
 647                         }
 648                         individuals_length = i_m;
 649                     }
 650
 651                     /*  For efficiency we exit the loop now (this property
 652                         number has been dealt with)                          */
 653
 654                     break;
 655                 }
 656
 657             if (!prop_in_current_defn)
 658             {
 659                 /*  The case where the class defined a property which wasn't
 660                     defined at all in full_object: we copy out the data into
 661                     a new property added to full_object                      */
 662
 663                 k=full_object.l++;
 664                 if (k >= 64)
 665                     fatalerror("More than 64 property entries in an object");
 666                 full_object.pp[k].num = prop_number;
 667                 full_object.pp[k].l = prop_length/2;
 668                 for (i=0; i<prop_length/2; i++)
 669                 {
 670                     INITAOTV(&full_object.pp[k].ao[i], LONG_CONSTANT_OT, mark + j);
 671                     j+=2;
 672                     full_object.pp[k].ao[i].marker = INHERIT_MV;
 673                 }
 674
 675                 if (prop_number==3)
 676                 {   int y, z, class_block_offset;
 677
 678                     /*  Property 3 holds the address of the table of
 679                         instance variables, so this is the case where
 680                         the object had no instance variables of its own
 681                         but must inherit some more from the class  */
 682
 683                     if (individual_prop_table_size++ == 0)
 684                     {   full_object.pp[k].num = 3;
 685                         full_object.pp[k].l = 1;
 686                         INITAOTV(&full_object.pp[k].ao[0], LONG_CONSTANT_OT, individuals_length);
 687                         full_object.pp[k].ao[0].marker = INDIVPT_MV;
 688                         i_m = individuals_length;
 689                     }
 690                     class_block_offset = class_prop_block[j-2]*256
 691                                          + class_prop_block[j-1];
 692
 693                     z = class_block_offset;
 694                     while ((individuals_table[z]!=0)||(individuals_table[z+1]!=0))
 695                     {   if (module_switch)
 696                         backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
 697                         ensure_memory_list_available(&individuals_table_memlist, i_m+3+individuals_table[z+2]);
 698                         individuals_table[i_m++] = individuals_table[z];
 699                         individuals_table[i_m++] = individuals_table[z+1];
 700                         individuals_table[i_m++] = individuals_table[z+2];
 701                         for (y=0;y < individuals_table[z+2]/2;y++)
 702                         {   individuals_table[i_m++] = (z+3+y*2)/256;
 703                             individuals_table[i_m++] = (z+3+y*2)%256;
 704                             backpatch_zmachine(INHERIT_INDIV_MV,
 705                                 INDIVIDUAL_PROP_ZA, i_m-2);
 706                         }
 707                         z += individuals_table[z+2] + 3;
 708                     }
 709                     individuals_length = i_m;
 710                 }
 711             }
 712         }
 713     }
 714
 715     if (individual_prop_table_size > 0)
 716     {
 717         ensure_memory_list_available(&individuals_table_memlist, i_m+2);
 718
 719         individuals_table[i_m++] = 0;
 720         individuals_table[i_m++] = 0;
 721         individuals_length += 2;
 722     }
 723 }
 724
 725 static void property_inheritance_g(void)
 726 {
 727   /*  Apply the property inheritance rules to full_object, which should
 728       initially be complete (i.e., this routine takes place after the whole
 729       Nearby/Object/Class definition has been parsed through).
 730
 731       On exit, full_object contains the final state of the properties to
 732       be written. */
 733
 734   int i, j, k, class, num_props,
 735     prop_number, prop_length, prop_flags, prop_in_current_defn;
 736   int32 mark, prop_addr;
 737   uchar *cpb, *pe;
 738
 739   ASSERT_GLULX();
 740
 741   for (class=0; class<no_classes_to_inherit_from; class++) {
 742     mark = class_info[classes_to_inherit_from[class] - 1].begins_at;
 743     cpb = (properties_table + mark);
 744     /* This now points to the compiled property-table for the class.
 745        We'll have to go through and decompile it. (For our sins.) */
 746     num_props = ReadInt32(cpb);
 747     for (j=0; j<num_props; j++) {
 748       pe = cpb + 4 + j*10;
 749       prop_number = ReadInt16(pe);
 750       pe += 2;
 751       prop_length = ReadInt16(pe);
 752       pe += 2;
 753       prop_addr = ReadInt32(pe);
 754       pe += 4;
 755       prop_flags = ReadInt16(pe);
 756       pe += 2;
 757
 758       /*  So we now have property number prop_number present in the
 759           property block for the class being read. Its bytes are
 760           cpb[prop_addr ... prop_addr + prop_length - 1]
 761           Question now is: is there already a value given in the
 762           current definition under this property name? */
 763
 764       prop_in_current_defn = FALSE;
 765
 766       for (k=0; k<full_object_g.numprops; k++) {
 767         if (full_object_g.props[k].num == prop_number) {
 768           prop_in_current_defn = TRUE;
 769           break;
 770         }
 771       }
 772
 773       if (prop_in_current_defn) {
 774         if ((prop_number==1)
 775           || (prop_number < INDIV_PROP_START
 776             && commonprops[prop_number].is_additive)) {
 777           /*  The additive case: we accumulate the class
 778               property values onto the end of the full_object
 779               properties. Remember that k is still the index number
 780               of the first prop-block matching our property number. */
 781           int prevcont;
 782           if (full_object_g.props[k].continuation == 0) {
 783             full_object_g.props[k].continuation = 1;
 784             prevcont = 1;
 785           }
 786           else {
 787             prevcont = full_object_g.props[k].continuation;
 788             for (k++; k<full_object_g.numprops; k++) {
 789               if (full_object_g.props[k].num == prop_number) {
 790                 prevcont = full_object_g.props[k].continuation;
 791               }
 792             }
 793           }
 794           k = full_object_g.numprops++;
 795           ensure_memory_list_available(&full_object_g.props_memlist, k+1);
 796           full_object_g.props[k].num = prop_number;
 797           full_object_g.props[k].flags = 0;
 798           full_object_g.props[k].datastart = full_object_g.propdatasize;
 799           full_object_g.props[k].continuation = prevcont+1;
 800           full_object_g.props[k].datalen = prop_length;
 801
 802           ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize + prop_length);
 803           for (i=0; i<prop_length; i++) {
 804             int ppos = full_object_g.propdatasize++;
 805             INITAOTV(&full_object_g.propdata[ppos], CONSTANT_OT, prop_addr + 4*i);
 806             full_object_g.propdata[ppos].marker = INHERIT_MV;
 807           }
 808         }
 809         else {
 810           /*  The ordinary case: the full_object_g property
 811               values simply overrides the class definition,
 812               so we skip over the values in the class table. */
 813         }
 814       }
 815           else {
 816             /*  The case where the class defined a property which wasn't
 817                 defined at all in full_object_g: we copy out the data into
 818                 a new property added to full_object_g. */
 819             k = full_object_g.numprops++;
 820             ensure_memory_list_available(&full_object_g.props_memlist, k+1);
 821             full_object_g.props[k].num = prop_number;
 822             full_object_g.props[k].flags = prop_flags;
 823             full_object_g.props[k].datastart = full_object_g.propdatasize;
 824             full_object_g.props[k].continuation = 0;
 825             full_object_g.props[k].datalen = prop_length;
 826
 827             ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize + prop_length);
 828             for (i=0; i<prop_length; i++) {
 829               int ppos = full_object_g.propdatasize++;
 830               INITAOTV(&full_object_g.propdata[ppos], CONSTANT_OT, prop_addr + 4*i);
 831               full_object_g.propdata[ppos].marker = INHERIT_MV;
 832             }
 833           }
 834
 835     }
 836   }
 837
 838 }
 839
 840 /* ------------------------------------------------------------------------- */
 841 /*   Construction of Z-machine-format property blocks.                       */
 842 /* ------------------------------------------------------------------------- */
 843
 844 static int write_properties_between(int mark, int from, int to)
 845 {   int j, k, prop_number;
 846
 847     for (prop_number=to; prop_number>=from; prop_number--)
 848     {   for (j=0; j<full_object.l; j++)
 849         {   if ((full_object.pp[j].num == prop_number)
 850                 && (full_object.pp[j].l != 100))
 851             {
 852                 int prop_length = 2*full_object.pp[j].l;
 853                 ensure_memory_list_available(&properties_table_memlist, mark+2+prop_length);
 854                 if (version_number == 3)
 855                     properties_table[mark++] = prop_number + (prop_length - 1)*32;
 856                 else
 857                 {   switch(prop_length)
 858                     {   case 1:
 859                           properties_table[mark++] = prop_number; break;
 860                         case 2:
 861                           properties_table[mark++] = prop_number + 0x40; break;
 862                         default:
 863                           properties_table[mark++] = prop_number + 0x80;
 864                           properties_table[mark++] = prop_length + 0x80; break;
 865                     }
 866                 }
 867
 868                 for (k=0; k<full_object.pp[j].l; k++)
 869                 {   if (full_object.pp[j].ao[k].marker != 0)
 870                         backpatch_zmachine(full_object.pp[j].ao[k].marker,
 871                             PROP_ZA, mark);
 872                     properties_table[mark++] = full_object.pp[j].ao[k].value/256;
 873                     properties_table[mark++] = full_object.pp[j].ao[k].value%256;
 874                 }
 875             }
 876         }
 877     }
 878
 879     ensure_memory_list_available(&properties_table_memlist, mark+1);
 880     properties_table[mark++]=0;
 881     return(mark);
 882 }
 883
 884 static int write_property_block_z(char *shortname)
 885 {
 886     /*  Compile the (now complete) full_object properties into a
 887         property-table block at "p" in Inform's memory.
 888         "shortname" is the object's short name, if specified; otherwise
 889         NULL.
 890
 891         Return the number of bytes written to the block.                     */
 892
 893     int32 mark = properties_table_size, i;
 894
 895     /* printf("Object at %04x\n", mark); */
 896
 897     if (shortname != NULL)
 898     {
 899         i = translate_text(510,shortname,STRCTX_OBJNAME);
 900         if (i < 0) {
 901             error ("Short name of object exceeded 765 Z-characters");
 902             i = 0;
 903         }
 904         ensure_memory_list_available(&properties_table_memlist, mark+1+i);
 905         memcpy(properties_table + mark+1, translated_text, i);
 906         properties_table[mark] = i/2;
 907         mark += i+1;
 908     }
 909     if (current_defn_is_class)
 910     {   mark = write_properties_between(mark,3,3);
 911         ensure_memory_list_available(&properties_table_memlist, mark+6);
 912         for (i=0;i<6;i++)
 913             properties_table[mark++] = full_object.atts[i];
 914         ensure_memory_list_available(&class_info_memlist, no_classes+1);
 915         class_info[no_classes++].begins_at = mark;
 916     }
 917
 918     mark = write_properties_between(mark, 1, (version_number==3)?31:63);
 919
 920     i = mark - properties_table_size;
 921     properties_table_size = mark;
 922
 923     return(i);
 924 }
 925
 926 static int gpropsort(void *ptr1, void *ptr2)
 927 {
 928   propg *prop1 = ptr1;
 929   propg *prop2 = ptr2;
 930
 931   if (prop2->num == -1)
 932     return -1;
 933   if (prop1->num == -1)
 934     return 1;
 935   if (prop1->num < prop2->num)
 936     return -1;
 937   if (prop1->num > prop2->num)
 938     return 1;
 939
 940   return (prop1->continuation - prop2->continuation);
 941 }
 942
 943 static int32 write_property_block_g(void)
 944 {
 945   /*  Compile the (now complete) full_object properties into a
 946       property-table block at "p" in Inform's memory.
 947       Return the number of bytes written to the block.
 948       In Glulx, the shortname property isn't used here; it's already
 949       been compiled into an ordinary string. */
 950
 951   int32 i;
 952   int ix, jx, kx, totalprops;
 953   int32 mark = properties_table_size;
 954   int32 datamark;
 955
 956   if (current_defn_is_class) {
 957     ensure_memory_list_available(&properties_table_memlist, mark+NUM_ATTR_BYTES);
 958     for (i=0;i<NUM_ATTR_BYTES;i++)
 959       properties_table[mark++] = full_object_g.atts[i];
 960     ensure_memory_list_available(&class_info_memlist, no_classes+1);
 961     class_info[no_classes++].begins_at = mark;
 962   }
 963
 964   qsort(full_object_g.props, full_object_g.numprops, sizeof(propg),
 965     (int (*)(const void *, const void *))(&gpropsort));
 966
 967   full_object_g.finalpropaddr = mark;
 968
 969   totalprops = 0;
 970
 971   for (ix=0; ix<full_object_g.numprops; ix=jx) {
 972     int propnum = full_object_g.props[ix].num;
 973     if (propnum == -1)
 974         break;
 975     for (jx=ix;
 976         jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
 977         jx++);
 978     totalprops++;
 979   }
 980
 981   /* Write out the number of properties in this table. */
 982   ensure_memory_list_available(&properties_table_memlist, mark+4);
 983   WriteInt32(properties_table+mark, totalprops);
 984   mark += 4;
 985
 986   datamark = mark + 10*totalprops;
 987
 988   for (ix=0; ix<full_object_g.numprops; ix=jx) {
 989     int propnum = full_object_g.props[ix].num;
 990     int flags = full_object_g.props[ix].flags;
 991     int totallen = 0;
 992     int32 datamarkstart = datamark;
 993     if (propnum == -1)
 994       break;
 995     for (jx=ix;
 996         jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
 997         jx++) {
 998       int32 datastart = full_object_g.props[jx].datastart;
 999       ensure_memory_list_available(&properties_table_memlist, datamark+4*full_object_g.props[jx].datalen);
1000       for (kx=0; kx<full_object_g.props[jx].datalen; kx++) {
1001         int32 val = full_object_g.propdata[datastart+kx].value;
1002         WriteInt32(properties_table+datamark, val);
1003         if (full_object_g.propdata[datastart+kx].marker != 0)
1004           backpatch_zmachine(full_object_g.propdata[datastart+kx].marker,
1005             PROP_ZA, datamark);
1006         totallen++;
1007         datamark += 4;
1008       }
1009     }
1010     ensure_memory_list_available(&properties_table_memlist, mark+10);
1011     WriteInt16(properties_table+mark, propnum);
1012     mark += 2;
1013     WriteInt16(properties_table+mark, totallen);
1014     mark += 2;
1015     WriteInt32(properties_table+mark, datamarkstart);
1016     mark += 4;
1017     WriteInt16(properties_table+mark, flags);
1018     mark += 2;
1019   }
1020
1021   mark = datamark;
1022
1023   i = mark - properties_table_size;
1024   properties_table_size = mark;
1025   return i;
1026 }
1027
1028 /* ------------------------------------------------------------------------- */
1029 /*   The final stage in Nearby/Object/Class definition processing.           */
1030 /* ------------------------------------------------------------------------- */
1031
1032 static void manufacture_object_z(void)
1033 {   int i, j;
1034
1035     segment_markers.enabled = FALSE;
1036     directives.enabled = TRUE;
1037
1038     ensure_memory_list_available(&objectsz_memlist, no_objects+1);
1039
1040     objectsz[no_objects].symbol = full_object.symbol;
1041
1042     property_inheritance_z();
1043
1044     objectsz[no_objects].parent = parent_of_this_obj;
1045     objectsz[no_objects].next = 0;
1046     objectsz[no_objects].child = 0;
1047
1048     if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fff))
1049     {   i = objectsz[parent_of_this_obj-1].child;
1050         if (i == 0)
1051             objectsz[parent_of_this_obj-1].child = no_objects + 1;
1052         else
1053         {   while(objectsz[i-1].next != 0) i = objectsz[i-1].next;
1054             objectsz[i-1].next = no_objects+1;
1055         }
1056     }
1057
1058         /*  The properties table consists simply of a sequence of property
1059             blocks, one for each object in order of definition, exactly as
1060             it will appear in the final Z-machine.                           */
1061
1062     j = write_property_block_z(shortname_buffer);
1063
1064     objectsz[no_objects].propsize = j;
1065
1066     if (current_defn_is_class)
1067         for (i=0;i<6;i++) objectsz[no_objects].atts[i] = 0;
1068     else
1069         for (i=0;i<6;i++)
1070             objectsz[no_objects].atts[i] = full_object.atts[i];
1071
1072     no_objects++;
1073 }
1074
1075 static void manufacture_object_g(void)
1076 {   int32 i, j;
1077
1078     segment_markers.enabled = FALSE;
1079     directives.enabled = TRUE;
1080
1081     ensure_memory_list_available(&objectsg_memlist, no_objects+1);
1082     ensure_memory_list_available(&objectatts_memlist, no_objects+1);
1083
1084     objectsg[no_objects].symbol = full_object_g.symbol;
1085
1086     property_inheritance_g();
1087
1088     objectsg[no_objects].parent = parent_of_this_obj;
1089     objectsg[no_objects].next = 0;
1090     objectsg[no_objects].child = 0;
1091
1092     if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fffffff))
1093     {   i = objectsg[parent_of_this_obj-1].child;
1094         if (i == 0)
1095             objectsg[parent_of_this_obj-1].child = no_objects + 1;
1096         else
1097         {   while(objectsg[i-1].next != 0) i = objectsg[i-1].next;
1098             objectsg[i-1].next = no_objects+1;
1099         }
1100     }
1101
1102     objectsg[no_objects].shortname = compile_string(shortname_buffer,
1103       STRCTX_OBJNAME);
1104
1105         /*  The properties table consists simply of a sequence of property
1106             blocks, one for each object in order of definition, exactly as
1107             it will appear in the final machine image.                      */
1108
1109     j = write_property_block_g();
1110
1111     objectsg[no_objects].propaddr = full_object_g.finalpropaddr;
1112
1113     objectsg[no_objects].propsize = j;
1114
1115     if (current_defn_is_class)
1116         for (i=0;i<NUM_ATTR_BYTES;i++)
1117             objectatts[no_objects*NUM_ATTR_BYTES+i] = 0;
1118     else
1119         for (i=0;i<NUM_ATTR_BYTES;i++)
1120             objectatts[no_objects*NUM_ATTR_BYTES+i] = full_object_g.atts[i];
1121
1122     no_objects++;
1123 }
1124
1125
1126 /* ========================================================================= */
1127 /*   [2]  The Object/Nearby/Class directives parser: translating the syntax  */
1128 /*        into object specifications and then triggering off the above.      */
1129 /* ========================================================================= */
1130 /*   Properties ("with" or "private") segment.                               */
1131 /* ------------------------------------------------------------------------- */
1132
1133 static int *defined_this_segment;
1134 static long defined_this_segment_size; /* calloc size */
1135 static int def_t_s;
1136
1137 static void ensure_defined_this_segment(int newsize)
1138 {
1139     int oldsize = defined_this_segment_size;
1140     defined_this_segment_size = newsize;
1141     my_recalloc(&defined_this_segment, sizeof(int), oldsize,
1142         defined_this_segment_size, "defined this segment table");
1143 }
1144
1145 static void properties_segment_z(int this_segment)
1146 {
1147     /*  Parse through the "with" part of an object/class definition:
1148
1149         <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
1150
1151         This routine also handles "private", with this_segment being equal
1152         to the token value for the introductory word ("private" or "with").  */
1153
1154
1155     int   i, property_name_symbol, property_number=0, next_prop=0, length,
1156           individual_property, this_identifier_number;
1157
1158     do
1159     {   get_next_token_with_directives();
1160         if ((token_type == SEGMENT_MARKER_TT)
1161             || (token_type == EOF_TT)
1162             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1163         {   put_token_back(); return;
1164         }
1165
1166         if (token_type != SYMBOL_TT)
1167         {   ebf_error("property name", token_text);
1168             return;
1169         }
1170
1171         individual_property = (symbols[token_value].type != PROPERTY_T);
1172
1173         if (individual_property)
1174         {   if (symbols[token_value].flags & UNKNOWN_SFLAG)
1175             {   this_identifier_number = no_individual_properties++;
1176                 assign_symbol(token_value, this_identifier_number,
1177                     INDIVIDUAL_PROPERTY_T);
1178
1179                 if (debugfile_switch)
1180                 {   debug_file_printf("<property>");
1181                     debug_file_printf
1182                         ("<identifier>%s</identifier>", token_text);
1183                     debug_file_printf
1184                         ("<value>%d</value>", this_identifier_number);
1185                     debug_file_printf("</property>");
1186                 }
1187
1188                 trace_s(token_text, symbols[token_value].value, 2);
1189             }
1190             else
1191             {   if (symbols[token_value].type==INDIVIDUAL_PROPERTY_T)
1192                     this_identifier_number = symbols[token_value].value;
1193                 else
1194                 {   ebf_symbol_error("property name", token_text, typename(symbols[token_value].type), symbols[token_value].line);
1195                     return;
1196                 }
1197             }
1198
1199             if (def_t_s >= defined_this_segment_size)
1200                 ensure_defined_this_segment(def_t_s*2);
1201             defined_this_segment[def_t_s++] = token_value;
1202
1203             if (individual_prop_table_size++ == 0)
1204             {
1205                 int k=full_object.l++;
1206                 if (k >= 64)
1207                     fatalerror("More than 64 property entries in an object");
1208                 full_object.pp[k].num = 3;
1209                 full_object.pp[k].l = 1;
1210                 INITAOTV(&full_object.pp[k].ao[0], LONG_CONSTANT_OT, individuals_length);
1211                 full_object.pp[k].ao[0].marker = INDIVPT_MV;
1212
1213                 i_m = individuals_length;
1214             }
1215             ensure_memory_list_available(&individuals_table_memlist, i_m+3);
1216             individuals_table[i_m] = this_identifier_number/256;
1217             if (this_segment == PRIVATE_SEGMENT)
1218                 individuals_table[i_m] |= 0x80;
1219             individuals_table[i_m+1] = this_identifier_number%256;
1220             if (module_switch)
1221                 backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
1222             individuals_table[i_m+2] = 0;
1223         }
1224         else
1225         {   if (symbols[token_value].flags & UNKNOWN_SFLAG)
1226             {   error_named("No such property name as", token_text);
1227                 return;
1228             }
1229             if (this_segment == PRIVATE_SEGMENT)
1230                 error_named("Property should be declared in 'with', \
1231 not 'private':", token_text);
1232             if (def_t_s >= defined_this_segment_size)
1233                 ensure_defined_this_segment(def_t_s*2);
1234             defined_this_segment[def_t_s++] = token_value;
1235             property_number = symbols[token_value].value;
1236
1237             next_prop=full_object.l++;
1238             if (next_prop >= 64)
1239                 fatalerror("More than 64 property entries in an object");
1240             full_object.pp[next_prop].num = property_number;
1241         }
1242
1243         for (i=0; i<(def_t_s-1); i++)
1244             if (defined_this_segment[i] == token_value)
1245             {   error_named("Property given twice in the same declaration:",
1246                     symbols[token_value].name);
1247             }
1248             else
1249             if (symbols[defined_this_segment[i]].value == symbols[token_value].value)
1250             {   char error_b[128+2*MAX_IDENTIFIER_LENGTH];
1251                 sprintf(error_b,
1252                     "Property given twice in the same declaration, because \
1253 the names '%s' and '%s' actually refer to the same property",
1254                     symbols[defined_this_segment[i]].name,
1255                     symbols[token_value].name);
1256                 error(error_b);
1257             }
1258
1259         property_name_symbol = token_value;
1260         symbols[token_value].flags |= USED_SFLAG;
1261
1262         length=0;
1263         do
1264         {   assembly_operand AO;
1265             get_next_token_with_directives();
1266             if ((token_type == EOF_TT)
1267                 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1268                 || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1269                 break;
1270
1271             if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1272
1273             if ((!individual_property) && (property_number==1)
1274                 && ((token_type != SQ_TT) || (strlen(token_text) <2 ))
1275                 && (token_type != DQ_TT)
1276                 )
1277                 warning ("'name' property should only contain dictionary words");
1278
1279             if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1280             {
1281                 char *prefix, *sep, *sym;
1282                 sym = symbols[property_name_symbol].name;
1283                 if (current_defn_is_class)
1284                 {
1285                     prefix = symbols[current_classname_symbol].name;
1286                     sep = "::";
1287                 }
1288                 else
1289                 {
1290                     prefix = current_object_name.data;
1291                     sep = ".";
1292                 }
1293                 ensure_memory_list_available(&embedded_function_name, strlen(prefix)+strlen(sep)+strlen(sym)+1);
1294                 sprintf(embedded_function_name.data, "%s%s%s", prefix, sep, sym);
1295
1296                 /* parse_routine() releases lexer text! */
1297                 AO.value = parse_routine(NULL, TRUE, embedded_function_name.data, FALSE, -1);
1298                 AO.type = LONG_CONSTANT_OT;
1299                 AO.marker = IROUTINE_MV;
1300
1301                 directives.enabled = FALSE;
1302                 segment_markers.enabled = TRUE;
1303
1304                 statements.enabled = FALSE;
1305                 misc_keywords.enabled = FALSE;
1306                 local_variables.enabled = FALSE;
1307                 system_functions.enabled = FALSE;
1308                 conditions.enabled = FALSE;
1309             }
1310             else
1311
1312             /*  A special rule applies to values in double-quotes of the
1313                 built-in property "name", which always has number 1: such
1314                 property values are dictionary entries and not static
1315                 strings                                                      */
1316
1317             if ((!individual_property) &&
1318                 (property_number==1) && (token_type == DQ_TT))
1319             {   AO.value = dictionary_add(token_text, 0x80, 0, 0);
1320                 AO.type = LONG_CONSTANT_OT;
1321                 AO.marker = DWORD_MV;
1322             }
1323             else
1324             {   if (length!=0)
1325                 {
1326                     if ((token_type == SYMBOL_TT)
1327                         && (symbols[token_value].type==PROPERTY_T))
1328                     {
1329                         /*  This is not necessarily an error: it's possible
1330                             to imagine a property whose value is a list
1331                             of other properties to look up, but far more
1332                             likely that a comma has been omitted in between
1333                             two property blocks                              */
1334
1335                         warning_named(
1336                "Missing ','? Property data seems to contain the property name",
1337                             token_text);
1338                     }
1339                 }
1340
1341                 /*  An ordinary value, then:                                 */
1342
1343                 put_token_back();
1344                 AO = parse_expression(ARRAY_CONTEXT);
1345             }
1346
1347             if (length == 64)
1348             {   error_named("Limit (of 32 values) exceeded for property",
1349                     symbols[property_name_symbol].name);
1350                 break;
1351             }
1352
1353             if (individual_property)
1354             {   if (AO.marker != 0)
1355                     backpatch_zmachine(AO.marker, INDIVIDUAL_PROP_ZA,
1356                         i_m+3+length);
1357                 ensure_memory_list_available(&individuals_table_memlist, i_m+3+length+2);
1358                 individuals_table[i_m+3+length++] = AO.value/256;
1359                 individuals_table[i_m+3+length++] = AO.value%256;
1360             }
1361             else
1362             {   full_object.pp[next_prop].ao[length/2] = AO;
1363                 length = length + 2;
1364             }
1365
1366         } while (TRUE);
1367
1368         /*  People rarely do, but it is legal to declare a property without
1369             a value at all:
1370
1371                 with  name "fish", number, time_left;
1372
1373             in which case the properties "number" and "time_left" are
1374             created as in effect variables and initialised to zero.          */
1375
1376         if (length == 0)
1377         {   if (individual_property)
1378             {
1379                 ensure_memory_list_available(&individuals_table_memlist, i_m+3+length+2);
1380                 individuals_table[i_m+3+length++] = 0;
1381                 individuals_table[i_m+3+length++] = 0;
1382             }
1383             else
1384             {
1385                 INITAOTV(&full_object.pp[next_prop].ao[0], LONG_CONSTANT_OT, 0);
1386                 length = 2;
1387             }
1388         }
1389
1390         if ((version_number==3) && (!individual_property))
1391         {   if (length > 8)
1392             {
1393        warning_named("Version 3 limit of 4 values per property exceeded \
1394 (use -v5 to get 32), so truncating property",
1395                     symbols[property_name_symbol].name);
1396                 length = 8;
1397             }
1398         }
1399
1400         if (individual_property)
1401         {
1402             ensure_memory_list_available(&individuals_table_memlist, individuals_length+length+3);
1403             individuals_table[i_m + 2] = length;
1404             individuals_length += length+3;
1405             i_m = individuals_length;
1406         }
1407         else
1408             full_object.pp[next_prop].l = length/2;
1409
1410         if ((token_type == EOF_TT)
1411             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1412         {   put_token_back(); return;
1413         }
1414
1415     } while (TRUE);
1416 }
1417
1418
1419 static void properties_segment_g(int this_segment)
1420 {
1421     /*  Parse through the "with" part of an object/class definition:
1422
1423         <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
1424
1425         This routine also handles "private", with this_segment being equal
1426         to the token value for the introductory word ("private" or "with").  */
1427
1428
1429     int   i, next_prop,
1430           individual_property, this_identifier_number;
1431     int32 property_name_symbol, property_number, length;
1432
1433     do
1434     {   get_next_token_with_directives();
1435         if ((token_type == SEGMENT_MARKER_TT)
1436             || (token_type == EOF_TT)
1437             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1438         {   put_token_back(); return;
1439         }
1440
1441         if (token_type != SYMBOL_TT)
1442         {   ebf_error("property name", token_text);
1443             return;
1444         }
1445
1446         individual_property = (symbols[token_value].type != PROPERTY_T);
1447
1448         if (individual_property)
1449         {   if (symbols[token_value].flags & UNKNOWN_SFLAG)
1450             {   this_identifier_number = no_individual_properties++;
1451                 assign_symbol(token_value, this_identifier_number,
1452                     INDIVIDUAL_PROPERTY_T);
1453
1454                 if (debugfile_switch)
1455                 {   debug_file_printf("<property>");
1456                     debug_file_printf
1457                         ("<identifier>%s</identifier>", token_text);
1458                     debug_file_printf
1459                         ("<value>%d</value>", this_identifier_number);
1460                     debug_file_printf("</property>");
1461                 }
1462
1463                 trace_s(token_text, symbols[token_value].value, 2);
1464             }
1465             else
1466             {   if (symbols[token_value].type==INDIVIDUAL_PROPERTY_T)
1467                     this_identifier_number = symbols[token_value].value;
1468                 else
1469                 {   ebf_symbol_error("property name", token_text, typename(symbols[token_value].type), symbols[token_value].line);
1470                     return;
1471                 }
1472             }
1473
1474             if (def_t_s >= defined_this_segment_size)
1475                 ensure_defined_this_segment(def_t_s*2);
1476             defined_this_segment[def_t_s++] = token_value;
1477             property_number = symbols[token_value].value;
1478
1479             next_prop=full_object_g.numprops++;
1480             ensure_memory_list_available(&full_object_g.props_memlist, next_prop+1);
1481             full_object_g.props[next_prop].num = property_number;
1482             full_object_g.props[next_prop].flags =
1483               ((this_segment == PRIVATE_SEGMENT) ? 1 : 0);
1484             full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1485             full_object_g.props[next_prop].continuation = 0;
1486             full_object_g.props[next_prop].datalen = 0;
1487         }
1488         else
1489         {   if (symbols[token_value].flags & UNKNOWN_SFLAG)
1490             {   error_named("No such property name as", token_text);
1491                 return;
1492             }
1493             if (this_segment == PRIVATE_SEGMENT)
1494                 error_named("Property should be declared in 'with', \
1495 not 'private':", token_text);
1496
1497             if (def_t_s >= defined_this_segment_size)
1498                 ensure_defined_this_segment(def_t_s*2);
1499             defined_this_segment[def_t_s++] = token_value;
1500             property_number = symbols[token_value].value;
1501
1502             next_prop=full_object_g.numprops++;
1503             ensure_memory_list_available(&full_object_g.props_memlist, next_prop+1);
1504             full_object_g.props[next_prop].num = property_number;
1505             full_object_g.props[next_prop].flags = 0;
1506             full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1507             full_object_g.props[next_prop].continuation = 0;
1508             full_object_g.props[next_prop].datalen = 0;
1509         }
1510
1511         for (i=0; i<(def_t_s-1); i++)
1512             if (defined_this_segment[i] == token_value)
1513             {   error_named("Property given twice in the same declaration:",
1514                     symbols[token_value].name);
1515             }
1516             else
1517             if (symbols[defined_this_segment[i]].value == symbols[token_value].value)
1518             {   char error_b[128+2*MAX_IDENTIFIER_LENGTH];
1519                 sprintf(error_b,
1520                     "Property given twice in the same declaration, because \
1521 the names '%s' and '%s' actually refer to the same property",
1522                     symbols[defined_this_segment[i]].name,
1523                     symbols[token_value].name);
1524                 error(error_b);
1525             }
1526
1527         property_name_symbol = token_value;
1528         symbols[token_value].flags |= USED_SFLAG;
1529
1530         length=0;
1531         do
1532         {   assembly_operand AO;
1533             get_next_token_with_directives();
1534             if ((token_type == EOF_TT)
1535                 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1536                 || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1537                 break;
1538
1539             if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1540
1541             if ((!individual_property) && (property_number==1)
1542                 && ((token_type != SQ_TT) || (strlen(token_text) <2 ))
1543                 && (token_type != DQ_TT)
1544                 )
1545                 warning ("'name' property should only contain dictionary words");
1546
1547             if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1548             {
1549                 char *prefix, *sep, *sym;
1550                 sym = symbols[property_name_symbol].name;
1551                 if (current_defn_is_class)
1552                 {
1553                     prefix = symbols[current_classname_symbol].name;
1554                     sep = "::";
1555                 }
1556                 else
1557                 {
1558                     prefix = current_object_name.data;
1559                     sep = ".";
1560                 }
1561                 ensure_memory_list_available(&embedded_function_name, strlen(prefix)+strlen(sep)+strlen(sym)+1);
1562                 sprintf(embedded_function_name.data, "%s%s%s", prefix, sep, sym);
1563
1564                 INITAOT(&AO, CONSTANT_OT);
1565                 /* parse_routine() releases lexer text! */
1566                 AO.value = parse_routine(NULL, TRUE, embedded_function_name.data, FALSE, -1);
1567                 AO.marker = IROUTINE_MV;
1568
1569                 directives.enabled = FALSE;
1570                 segment_markers.enabled = TRUE;
1571
1572                 statements.enabled = FALSE;
1573                 misc_keywords.enabled = FALSE;
1574                 local_variables.enabled = FALSE;
1575                 system_functions.enabled = FALSE;
1576                 conditions.enabled = FALSE;
1577             }
1578             else
1579
1580             /*  A special rule applies to values in double-quotes of the
1581                 built-in property "name", which always has number 1: such
1582                 property values are dictionary entries and not static
1583                 strings                                                      */
1584
1585             if ((!individual_property) &&
1586                 (property_number==1) && (token_type == DQ_TT))
1587             {   AO.value = dictionary_add(token_text, 0x80, 0, 0);
1588                 AO.type = CONSTANT_OT;
1589                 AO.marker = DWORD_MV;
1590             }
1591             else
1592             {   if (length!=0)
1593                 {
1594                     if ((token_type == SYMBOL_TT)
1595                         && (symbols[token_value].type==PROPERTY_T))
1596                     {
1597                         /*  This is not necessarily an error: it's possible
1598                             to imagine a property whose value is a list
1599                             of other properties to look up, but far more
1600                             likely that a comma has been omitted in between
1601                             two property blocks                              */
1602
1603                         warning_named(
1604                "Missing ','? Property data seems to contain the property name",
1605                             token_text);
1606                     }
1607                 }
1608
1609                 /*  An ordinary value, then:                                 */
1610
1611                 put_token_back();
1612                 AO = parse_expression(ARRAY_CONTEXT);
1613             }
1614
1615             if (length == 32768) /* VENEER_CONSTRAINT_ON_PROP_TABLE_SIZE? */
1616             {   error_named("Limit (of 32768 values) exceeded for property",
1617                     symbols[property_name_symbol].name);
1618                 break;
1619             }
1620
1621             ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize+1);
1622
1623             full_object_g.propdata[full_object_g.propdatasize++] = AO;
1624             length += 1;
1625
1626         } while (TRUE);
1627
1628         /*  People rarely do, but it is legal to declare a property without
1629             a value at all:
1630
1631                 with  name "fish", number, time_left;
1632
1633             in which case the properties "number" and "time_left" are
1634             created as in effect variables and initialised to zero.          */
1635
1636         if (length == 0)
1637         {
1638             assembly_operand AO;
1639             INITAOTV(&AO, CONSTANT_OT, 0);
1640             ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize+1);
1641             full_object_g.propdata[full_object_g.propdatasize++] = AO;
1642             length += 1;
1643         }
1644
1645         full_object_g.props[next_prop].datalen = length;
1646
1647         if ((token_type == EOF_TT)
1648             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1649         {   put_token_back(); return;
1650         }
1651
1652     } while (TRUE);
1653 }
1654
1655 static void properties_segment(int this_segment)
1656 {
1657   if (!glulx_mode)
1658     properties_segment_z(this_segment);
1659   else
1660     properties_segment_g(this_segment);
1661 }
1662
1663 /* ------------------------------------------------------------------------- */
1664 /*   Attributes ("has") segment.                                             */
1665 /* ------------------------------------------------------------------------- */
1666
1667 static void attributes_segment(void)
1668 {
1669     /*  Parse through the "has" part of an object/class definition:
1670
1671         [~]<attribute-1> [~]<attribute-2> ... [~]<attribute-n>               */
1672
1673     int attribute_number, truth_state, bitmask;
1674     uchar *attrbyte;
1675     do
1676     {   truth_state = TRUE;
1677
1678         ParseAttrN:
1679
1680         get_next_token_with_directives();
1681         if ((token_type == SEGMENT_MARKER_TT)
1682             || (token_type == EOF_TT)
1683             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1684         {   if (!truth_state)
1685                 ebf_error("attribute name after '~'", token_text);
1686             put_token_back(); return;
1687         }
1688         if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1689
1690         if ((token_type == SEP_TT) && (token_value == ARTNOT_SEP))
1691         {   truth_state = !truth_state; goto ParseAttrN;
1692         }
1693
1694         if ((token_type != SYMBOL_TT)
1695             || (symbols[token_value].type != ATTRIBUTE_T))
1696         {   ebf_error("name of an already-declared attribute", token_text);
1697             return;
1698         }
1699
1700         attribute_number = symbols[token_value].value;
1701         symbols[token_value].flags |= USED_SFLAG;
1702
1703         if (!glulx_mode) {
1704             bitmask = (1 << (7-attribute_number%8));
1705             attrbyte = &(full_object.atts[attribute_number/8]);
1706         }
1707         else {
1708             /* In Glulx, my prejudices rule, and therefore bits are numbered
1709                from least to most significant. This is the opposite of the
1710                way the Z-machine works. */
1711             bitmask = (1 << (attribute_number%8));
1712             attrbyte = &(full_object_g.atts[attribute_number/8]);
1713         }
1714
1715         if (truth_state)
1716             *attrbyte |= bitmask;     /* Set attribute bit */
1717         else
1718             *attrbyte &= ~bitmask;    /* Clear attribute bit */
1719
1720     } while (TRUE);
1721 }
1722
1723 /* ------------------------------------------------------------------------- */
1724 /*   Classes ("class") segment.                                              */
1725 /* ------------------------------------------------------------------------- */
1726
1727 static void add_class_to_inheritance_list(int class_number)
1728 {
1729     int i;
1730
1731     /*  The class number is actually the class's object number, which needs
1732         to be translated into its actual class number:                       */
1733
1734     for (i=0;i<no_classes;i++)
1735         if (class_number == class_info[i].object_number)
1736         {   class_number = i+1;
1737             break;
1738         }
1739
1740     /*  Remember the inheritance list so that property inheritance can
1741         be sorted out later on, when the definition has been finished:       */
1742
1743     ensure_memory_list_available(&classes_to_inherit_from_memlist, no_classes_to_inherit_from+1);
1744
1745     classes_to_inherit_from[no_classes_to_inherit_from++] = class_number;
1746
1747     /*  Inheriting attributes from the class at once:                        */
1748
1749     if (!glulx_mode) {
1750         for (i=0; i<6; i++)
1751             full_object.atts[i]
1752                 |= properties_table[class_info[class_number-1].begins_at - 6 + i];
1753     }
1754     else {
1755         for (i=0; i<NUM_ATTR_BYTES; i++)
1756             full_object_g.atts[i]
1757                 |= properties_table[class_info[class_number-1].begins_at
1758                     - NUM_ATTR_BYTES + i];
1759     }
1760 }
1761
1762 static void classes_segment(void)
1763 {
1764     /*  Parse through the "class" part of an object/class definition:
1765
1766         <class-1> ... <class-n>                                              */
1767
1768     do
1769     {   get_next_token_with_directives();
1770         if ((token_type == SEGMENT_MARKER_TT)
1771             || (token_type == EOF_TT)
1772             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1773         {   put_token_back(); return;
1774         }
1775         if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1776
1777         if ((token_type != SYMBOL_TT)
1778             || (symbols[token_value].type != CLASS_T))
1779         {   ebf_error("name of an already-declared class", token_text);
1780             return;
1781         }
1782         if (current_defn_is_class && token_value == current_classname_symbol)
1783         {   error("A class cannot inherit from itself");
1784             return;
1785         }
1786
1787         symbols[token_value].flags |= USED_SFLAG;
1788         add_class_to_inheritance_list(symbols[token_value].value);
1789     } while (TRUE);
1790 }
1791
1792 /* ------------------------------------------------------------------------- */
1793 /*   Parse the body of a Nearby/Object/Class definition.                     */
1794 /* ------------------------------------------------------------------------- */
1795
1796 static void parse_body_of_definition(void)
1797 {   int commas_in_row;
1798
1799     def_t_s = 0;
1800
1801     do
1802     {   commas_in_row = -1;
1803         do
1804         {   get_next_token_with_directives(); commas_in_row++;
1805         } while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
1806
1807         if (commas_in_row>1)
1808             error("Two commas ',' in a row in object/class definition");
1809
1810         if ((token_type == EOF_TT)
1811             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1812         {   if (commas_in_row > 0)
1813                 error("Object/class definition finishes with ','");
1814             if (token_type == EOF_TT)
1815                 error("Object/class definition incomplete (no ';') at end of file");
1816             break;
1817         }
1818
1819         if (token_type != SEGMENT_MARKER_TT)
1820         {   error_named("Expected 'with', 'has' or 'class' in \
1821 object/class definition but found", token_text);
1822             break;
1823         }
1824         else
1825         switch(token_value)
1826         {   case WITH_SEGMENT:
1827                 properties_segment(WITH_SEGMENT);
1828                 break;
1829             case PRIVATE_SEGMENT:
1830                 properties_segment(PRIVATE_SEGMENT);
1831                 break;
1832             case HAS_SEGMENT:
1833                 attributes_segment();
1834                 break;
1835             case CLASS_SEGMENT:
1836                 classes_segment();
1837                 break;
1838         }
1839
1840     } while (TRUE);
1841
1842 }
1843
1844 /* ------------------------------------------------------------------------- */
1845 /*   Class directives:                                                       */
1846 /*                                                                           */
1847 /*        Class <name>  <body of definition>                                 */
1848 /* ------------------------------------------------------------------------- */
1849
1850 static void initialise_full_object(void)
1851 {
1852   int i;
1853   if (!glulx_mode) {
1854     full_object.symbol = 0;
1855     full_object.l = 0;
1856     full_object.atts[0] = 0;
1857     full_object.atts[1] = 0;
1858     full_object.atts[2] = 0;
1859     full_object.atts[3] = 0;
1860     full_object.atts[4] = 0;
1861     full_object.atts[5] = 0;
1862   }
1863   else {
1864     full_object_g.symbol = 0;
1865     full_object_g.numprops = 0;
1866     full_object_g.propdatasize = 0;
1867     for (i=0; i<NUM_ATTR_BYTES; i++)
1868       full_object_g.atts[i] = 0;
1869   }
1870 }
1871
1872 extern void make_class(char * metaclass_name)
1873 {   int n, duplicates_to_make = 0, class_number = no_objects+1,
1874         metaclass_flag = (metaclass_name != NULL);
1875     debug_location_beginning beginning_debug_location =
1876         get_token_location_beginning();
1877
1878     current_defn_is_class = TRUE; no_classes_to_inherit_from = 0;
1879     individual_prop_table_size = 0;
1880
1881     ensure_memory_list_available(&class_info_memlist, no_classes+1);
1882
1883     if (no_classes==VENEER_CONSTRAINT_ON_CLASSES)
1884         fatalerror("Inform's maximum possible number of classes (whatever \
1885 amount of memory is allocated) has been reached. If this causes serious \
1886 inconvenience, please contact the maintainers.");
1887
1888     directives.enabled = FALSE;
1889
1890     if (metaclass_flag)
1891     {   token_text = metaclass_name;
1892         token_value = symbol_index(token_text, -1);
1893         token_type = SYMBOL_TT;
1894     }
1895     else
1896     {   get_next_token();
1897         if (token_type != SYMBOL_TT)
1898         {   discard_token_location(beginning_debug_location);
1899             ebf_error("new class name", token_text);
1900             panic_mode_error_recovery();
1901             return;
1902         }
1903         if (!(symbols[token_value].flags & UNKNOWN_SFLAG))
1904         {   discard_token_location(beginning_debug_location);
1905             ebf_symbol_error("new class name", token_text, typename(symbols[token_value].type), symbols[token_value].line);
1906             panic_mode_error_recovery();
1907             return;
1908         }
1909     }
1910
1911     /*  Each class also creates a modest object representing itself:         */
1912
1913     strcpy(shortname_buffer, token_text);
1914
1915     assign_symbol(token_value, class_number, CLASS_T);
1916     current_classname_symbol = token_value;
1917
1918     if (!glulx_mode) {
1919         if (metaclass_flag) symbols[token_value].flags |= SYSTEM_SFLAG;
1920     }
1921     else {
1922         /*  In Glulx, metaclasses have to be backpatched too! So we can't
1923             mark it as "system", but we should mark it "used". */
1924         if (metaclass_flag) symbols[token_value].flags |= USED_SFLAG;
1925     }
1926
1927     /*  "Class" (object 1) has no parent, whereas all other classes are
1928         the children of "Class".  Since "Class" is not present in a module,
1929         a special value is used which is corrected to 1 by the linker.       */
1930
1931     if (metaclass_flag) parent_of_this_obj = 0;
1932     else parent_of_this_obj = (module_switch)?MAXINTWORD:1;
1933
1934     class_info[no_classes].object_number = class_number;
1935     class_info[no_classes].symbol = current_classname_symbol;
1936     class_info[no_classes].begins_at = 0;
1937
1938     initialise_full_object();
1939
1940     /*  Give the class the (nameless in Inform syntax) "inheritance" property
1941         with value its own class number.  (This therefore accumulates onto
1942         the inheritance property of any object inheriting from the class,
1943         since property 2 is always set to "additive" -- see below)           */
1944
1945     if (!glulx_mode) {
1946       full_object.symbol = current_classname_symbol;
1947       full_object.l = 1;
1948       full_object.pp[0].num = 2;
1949       full_object.pp[0].l = 1;
1950       INITAOTV(&full_object.pp[0].ao[0], LONG_CONSTANT_OT, no_objects + 1);
1951       full_object.pp[0].ao[0].marker = OBJECT_MV;
1952     }
1953     else {
1954       full_object_g.symbol = current_classname_symbol;
1955       full_object_g.numprops = 1;
1956       ensure_memory_list_available(&full_object_g.props_memlist, 1);
1957       full_object_g.props[0].num = 2;
1958       full_object_g.props[0].flags = 0;
1959       full_object_g.props[0].datastart = 0;
1960       full_object_g.props[0].continuation = 0;
1961       full_object_g.props[0].datalen = 1;
1962       full_object_g.propdatasize = 1;
1963       ensure_memory_list_available(&full_object_g.propdata_memlist, 1);
1964       INITAOTV(&full_object_g.propdata[0], CONSTANT_OT, no_objects + 1);
1965       full_object_g.propdata[0].marker = OBJECT_MV;
1966     }
1967
1968     if (!metaclass_flag)
1969     {   get_next_token();
1970         if ((token_type == SEP_TT) && (token_value == OPENB_SEP))
1971         {   assembly_operand AO;
1972             AO = parse_expression(CONSTANT_CONTEXT);
1973             if (AO.marker != 0)
1974             {   error("Duplicate-number not known at compile time");
1975                 n=0;
1976             }
1977             else
1978                 n = AO.value;
1979             if ((n<0) || (n>10000))
1980             {   error("The number of duplicates must be 0 to 10000");
1981                 n=0;
1982             }
1983
1984             /*  Make one extra duplicate, since the veneer routines need
1985                 always to keep an undamaged prototype for the class in stock */
1986
1987             duplicates_to_make = n + 1;
1988
1989             match_close_bracket();
1990         } else put_token_back();
1991
1992         /*  Parse the body of the definition:                                */
1993
1994         parse_body_of_definition();
1995     }
1996
1997     if (debugfile_switch)
1998     {   debug_file_printf("<class>");
1999         debug_file_printf("<identifier>%s</identifier>", shortname_buffer);
2000         debug_file_printf("<class-number>%d</class-number>", no_classes);
2001         debug_file_printf("<value>");
2002         write_debug_object_backpatch(no_objects + 1);
2003         debug_file_printf("</value>");
2004         write_debug_locations
2005             (get_token_location_end(beginning_debug_location));
2006         debug_file_printf("</class>");
2007     }
2008
2009     if (!glulx_mode)
2010       manufacture_object_z();
2011     else
2012       manufacture_object_g();
2013
2014     if (individual_prop_table_size >= VENEER_CONSTRAINT_ON_IP_TABLE_SIZE)
2015         error("This class is too complex: it now carries too many properties. \
2016 You may be able to get round this by declaring some of its property names as \
2017 \"common properties\" using the 'Property' directive.");
2018
2019     if (duplicates_to_make > 0)
2020     {
2021         int namelen = strlen(shortname_buffer);
2022         char *duplicate_name = my_malloc(namelen+16, "temporary storage for object duplicate names");
2023         strcpy(duplicate_name, shortname_buffer);
2024         for (n=1; (duplicates_to_make--) > 0; n++)
2025         {
2026             sprintf(duplicate_name+namelen, "_%d", n);
2027             make_object(FALSE, duplicate_name, class_number, class_number, -1);
2028         }
2029         my_free(&duplicate_name, "temporary storage for object duplicate names");
2030     }
2031
2032     /* Finished building the class. */
2033     current_classname_symbol = 0;
2034 }
2035
2036 /* ------------------------------------------------------------------------- */
2037 /*   Object/Nearby directives:                                               */
2038 /*                                                                           */
2039 /*       Object  <name-1> ... <name-n> "short name"  [parent]  <body of def> */
2040 /*                                                                           */
2041 /*       Nearby  <name-1> ... <name-n> "short name"  <body of definition>    */
2042 /* ------------------------------------------------------------------------- */
2043
2044 static int end_of_header(void)
2045 {   if (((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
2046         || ((token_type == SEP_TT) && (token_value == COMMA_SEP))
2047         || (token_type == SEGMENT_MARKER_TT)) return TRUE;
2048     return FALSE;
2049 }
2050
2051 extern void make_object(int nearby_flag,
2052     char *textual_name, int specified_parent, int specified_class,
2053     int instance_of)
2054 {
2055     /*  Ordinarily this is called with nearby_flag TRUE for "Nearby",
2056         FALSE for "Object"; and textual_name NULL, specified_parent and
2057         specified_class both -1.  The next three arguments are used when
2058         the routine is called for class duplicates manufacture (see above).
2059         The last is used to create instances of a particular class.  */
2060
2061     int i, tree_depth, internal_name_symbol = 0;
2062     debug_location_beginning beginning_debug_location =
2063         get_token_location_beginning();
2064
2065     directives.enabled = FALSE;
2066
2067     ensure_memory_list_available(&current_object_name, 32);
2068     sprintf(current_object_name.data, "nameless_obj__%d", no_objects+1);
2069
2070     current_defn_is_class = FALSE;
2071
2072     no_classes_to_inherit_from=0;
2073
2074     individual_prop_table_size = 0;
2075
2076     if (nearby_flag) tree_depth=1; else tree_depth=0;
2077
2078     if (specified_class != -1) goto HeaderPassed;
2079
2080     get_next_token();
2081
2082     /*  Read past and count a sequence of "->"s, if any are present          */
2083
2084     if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
2085     {   if (nearby_flag)
2086           error("The syntax '->' is only used as an alternative to 'Nearby'");
2087
2088         while ((token_type == SEP_TT) && (token_value == ARROW_SEP))
2089         {   tree_depth++;
2090             get_next_token();
2091         }
2092     }
2093
2094     sprintf(shortname_buffer, "?");
2095
2096     segment_markers.enabled = TRUE;
2097
2098     /*  This first word is either an internal name, or a textual short name,
2099         or the end of the header part                                        */
2100
2101     if (end_of_header()) goto HeaderPassed;
2102
2103     if (token_type == DQ_TT) textual_name = token_text;
2104     else
2105     {   if (token_type != SYMBOL_TT) {
2106             ebf_error("name for new object or its textual short name",
2107                 token_text);
2108         }
2109         else if (!(symbols[token_value].flags & UNKNOWN_SFLAG)) {
2110             ebf_symbol_error("new object", token_text, typename(symbols[token_value].type), symbols[token_value].line);
2111         }
2112         else
2113         {   internal_name_symbol = token_value;
2114             ensure_memory_list_available(&current_object_name, strlen(token_text)+1);
2115             strcpy(current_object_name.data, token_text);
2116         }
2117     }
2118
2119     /*  The next word is either a parent object, or
2120         a textual short name, or the end of the header part                  */
2121
2122     get_next_token_with_directives();
2123     if (end_of_header()) goto HeaderPassed;
2124
2125     if (token_type == DQ_TT)
2126     {   if (textual_name != NULL)
2127             error("Two textual short names given for only one object");
2128         else
2129             textual_name = token_text;
2130     }
2131     else
2132     {   if ((token_type != SYMBOL_TT)
2133             || (symbols[token_value].flags & UNKNOWN_SFLAG))
2134         {   if (textual_name == NULL)
2135                 ebf_error("parent object or the object's textual short name",
2136                     token_text);
2137             else
2138                 ebf_error("parent object", token_text);
2139         }
2140         else goto SpecParent;
2141     }
2142
2143     /*  Finally, it's possible that there is still a parent object           */
2144
2145     get_next_token();
2146     if (end_of_header()) goto HeaderPassed;
2147
2148     if (specified_parent != -1)
2149         ebf_error("body of object definition", token_text);
2150     else
2151     {   SpecParent:
2152         if ((symbols[token_value].type == OBJECT_T)
2153             || (symbols[token_value].type == CLASS_T))
2154         {   specified_parent = symbols[token_value].value;
2155             symbols[token_value].flags |= USED_SFLAG;
2156         }
2157         else ebf_error("name of (the parent) object", token_text);
2158     }
2159
2160     /*  Now it really has to be the body of the definition.                  */
2161
2162     get_next_token_with_directives();
2163     if (end_of_header()) goto HeaderPassed;
2164
2165     ebf_error("body of object definition", token_text);
2166
2167     HeaderPassed:
2168     if (specified_class == -1) put_token_back();
2169
2170     if (internal_name_symbol > 0)
2171         assign_symbol(internal_name_symbol, no_objects + 1, OBJECT_T);
2172
2173     if (textual_name == NULL)
2174     {   if (internal_name_symbol > 0)
2175             sprintf(shortname_buffer, "(%s)",
2176                 symbols[internal_name_symbol].name);
2177         else
2178             sprintf(shortname_buffer, "(%d)", no_objects+1);
2179     }
2180     else
2181     {   if (strlen(textual_name)>765)
2182             error("Short name of object (in quotes) exceeded 765 characters");
2183         strncpy(shortname_buffer, textual_name, 765);
2184     }
2185
2186     if (specified_parent != -1)
2187     {   if (tree_depth > 0)
2188             error("Use of '->' (or 'Nearby') clashes with giving a parent");
2189         parent_of_this_obj = specified_parent;
2190     }
2191     else
2192     {   parent_of_this_obj = 0;
2193         if (tree_depth>0)
2194         {
2195             /*  We have to set the parent object to the most recently defined
2196                 object at level (tree_depth - 1) in the tree.
2197
2198                 A complication is that objects are numbered 1, 2, ... in the
2199                 Z-machine (and in the objects[].parent, etc., fields) but
2200                 0, 1, 2, ... internally (and as indices to object[]).        */
2201
2202             for (i=no_objects-1; i>=0; i--)
2203             {   int j = i, k = 0;
2204
2205                 /*  Metaclass or class objects cannot be '->' parents:  */
2206                 if ((!module_switch) && (i<4))
2207                     continue;
2208
2209                 if (!glulx_mode) {
2210                     if (objectsz[i].parent == 1)
2211                         continue;
2212                     while (objectsz[j].parent != 0)
2213                     {   j = objectsz[j].parent - 1; k++; }
2214                 }
2215                 else {
2216                     if (objectsg[i].parent == 1)
2217                         continue;
2218                     while (objectsg[j].parent != 0)
2219                     {   j = objectsg[j].parent - 1; k++; }
2220                 }
2221
2222                 if (k == tree_depth - 1)
2223                 {   parent_of_this_obj = i+1;
2224                     break;
2225                 }
2226             }
2227             if (parent_of_this_obj == 0)
2228             {   if (tree_depth == 1)
2229     error("'->' (or 'Nearby') fails because there is no previous object");
2230                 else
2231     error("'-> -> ...' fails because no previous object is deep enough");
2232             }
2233         }
2234     }
2235
2236     initialise_full_object();
2237     if (!glulx_mode)
2238         full_object.symbol = internal_name_symbol;
2239     else
2240         full_object_g.symbol = internal_name_symbol;
2241
2242     if (instance_of != -1) add_class_to_inheritance_list(instance_of);
2243
2244     if (specified_class == -1) parse_body_of_definition();
2245     else add_class_to_inheritance_list(specified_class);
2246
2247     if (debugfile_switch)
2248     {   debug_file_printf("<object>");
2249         if (internal_name_symbol > 0)
2250         {   debug_file_printf("<identifier>%s</identifier>",
2251                  current_object_name.data);
2252         } else
2253         {   debug_file_printf
2254                 ("<identifier artificial=\"true\">%s</identifier>",
2255                  current_object_name.data);
2256         }
2257         debug_file_printf("<value>");
2258         write_debug_object_backpatch(no_objects + 1);
2259         debug_file_printf("</value>");
2260         write_debug_locations
2261             (get_token_location_end(beginning_debug_location));
2262         debug_file_printf("</object>");
2263     }
2264
2265     if (!glulx_mode)
2266       manufacture_object_z();
2267     else
2268       manufacture_object_g();
2269 }
2270
2271 /* ========================================================================= */
2272 /*   Data structure management routines                                      */
2273 /* ------------------------------------------------------------------------- */
2274
2275 extern void init_objects_vars(void)
2276 {
2277     properties_table = NULL;
2278     individuals_table = NULL;
2279     commonprops = NULL;
2280
2281     objectsz = NULL;
2282     objectsg = NULL;
2283     objectatts = NULL;
2284     classes_to_inherit_from = NULL;
2285     class_info = NULL;
2286
2287     full_object_g.props = NULL;
2288     full_object_g.propdata = NULL;
2289 }
2290
2291 extern void objects_begin_pass(void)
2292 {
2293     properties_table_size=0;
2294
2295     /* The three predefined common properties: */
2296     /* (Entry 0 is not used.) */
2297
2298     /* "name" */
2299     commonprops[1].default_value = 0;
2300     commonprops[1].is_long = TRUE;
2301     commonprops[1].is_additive = TRUE;
2302
2303     /* class inheritance property */
2304     commonprops[2].default_value = 0;
2305     commonprops[2].is_long = TRUE;
2306     commonprops[2].is_additive = TRUE;
2307
2308     /* instance variables table address */
2309     /* (This property is only meaningful in Z-code; in Glulx its entry is
2310        reserved but never used.) */
2311     commonprops[3].default_value = 0;
2312     commonprops[3].is_long = TRUE;
2313     commonprops[3].is_additive = FALSE;
2314
2315     no_properties = 4;
2316
2317     if (debugfile_switch)
2318     {
2319         /* These two properties are not symbols, so they won't be emitted
2320            by emit_debug_information_for_predefined_symbol(). Do it
2321            manually. */
2322         debug_file_printf("<property>");
2323         debug_file_printf
2324             ("<identifier artificial=\"true\">inheritance class</identifier>");
2325         debug_file_printf("<value>2</value>");
2326         debug_file_printf("</property>");
2327         debug_file_printf("<property>");
2328         debug_file_printf
2329             ("<identifier artificial=\"true\">instance variables table address "
2330              "(Z-code)</identifier>");
2331         debug_file_printf("<value>3</value>");
2332         debug_file_printf("</property>");
2333     }
2334
2335     if (define_INFIX_switch) no_attributes = 1;
2336     else no_attributes = 0;
2337
2338     no_objects = 0;
2339     /* Setting the info for object zero is probably a relic of very old code, but we do it. */
2340     if (!glulx_mode) {
2341         ensure_memory_list_available(&objectsz_memlist, 1);
2342         objectsz[0].parent = 0; objectsz[0].child = 0; objectsz[0].next = 0;
2343         no_individual_properties=72;
2344     }
2345     else {
2346         ensure_memory_list_available(&objectsg_memlist, 1);
2347         objectsg[0].parent = 0; objectsg[0].child = 0; objectsg[0].next = 0;
2348         no_individual_properties = INDIV_PROP_START+8;
2349     }
2350     no_classes = 0;
2351     current_classname_symbol = 0;
2352
2353     no_embedded_routines = 0;
2354
2355     individuals_length=0;
2356 }
2357
2358 extern void objects_allocate_arrays(void)
2359 {
2360     objectsz = NULL;
2361     objectsg = NULL;
2362     objectatts = NULL;
2363
2364     commonprops = my_calloc(sizeof(commonpropinfo), INDIV_PROP_START,
2365                                 "common property info");
2366
2367     initialise_memory_list(&class_info_memlist,
2368         sizeof(classinfo), 64, (void**)&class_info,
2369         "class info");
2370     initialise_memory_list(&classes_to_inherit_from_memlist,
2371         sizeof(int),       64, (void**)&classes_to_inherit_from,
2372         "inherited classes list");
2373
2374     initialise_memory_list(&properties_table_memlist,
2375         sizeof(uchar), 10000, (void**)&properties_table,
2376         "properties table");
2377     initialise_memory_list(&individuals_table_memlist,
2378         sizeof(uchar), 10000, (void**)&individuals_table,
2379         "individual properties table");
2380
2381     defined_this_segment_size = 128;
2382     defined_this_segment  = my_calloc(sizeof(int), defined_this_segment_size,
2383                                 "defined this segment table");
2384
2385     initialise_memory_list(&current_object_name,
2386         sizeof(char), 32, NULL,
2387         "object name currently being defined");
2388     initialise_memory_list(&embedded_function_name,
2389         sizeof(char), 32, NULL,
2390         "temporary storage for inline function name");
2391
2392     if (!glulx_mode) {
2393       initialise_memory_list(&objectsz_memlist,
2394           sizeof(objecttz), 256, (void**)&objectsz,
2395           "z-objects");
2396     }
2397     else {
2398       initialise_memory_list(&objectsg_memlist,
2399           sizeof(objecttg), 256, (void**)&objectsg,
2400           "g-objects");
2401       initialise_memory_list(&objectatts_memlist,
2402           NUM_ATTR_BYTES, 256, (void**)&objectatts,
2403           "g-attributes");
2404       initialise_memory_list(&full_object_g.props_memlist,
2405           sizeof(propg), 64, (void**)&full_object_g.props,
2406           "object property list");
2407       initialise_memory_list(&full_object_g.propdata_memlist,
2408           sizeof(assembly_operand), 1024, (void**)&full_object_g.propdata,
2409           "object property data table");
2410     }
2411 }
2412
2413 extern void objects_free_arrays(void)
2414 {
2415     my_free(&commonprops, "common property info");
2416
2417     deallocate_memory_list(&current_object_name);
2418     deallocate_memory_list(&embedded_function_name);
2419     deallocate_memory_list(&objectsz_memlist);
2420     deallocate_memory_list(&objectsg_memlist);
2421     deallocate_memory_list(&objectatts_memlist);
2422     deallocate_memory_list(&class_info_memlist);
2423     deallocate_memory_list(&classes_to_inherit_from_memlist);
2424
2425     deallocate_memory_list(&properties_table_memlist);
2426     deallocate_memory_list(&individuals_table_memlist);
2427
2428     my_free(&defined_this_segment,"defined this segment table");
2429
2430     if (!glulx_mode) {
2431         deallocate_memory_list(&full_object_g.props_memlist);
2432         deallocate_memory_list(&full_object_g.propdata_memlist);
2433     }
2434
2435 }
2436
2437 /* ========================================================================= */