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.41                                                     */
  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                             {
 633                                 ensure_memory_list_available(&individuals_table_memlist, i_m+3+individuals_table[z+2]);
 634                                 individuals_table[i_m++] = individuals_table[z];
 635                                 individuals_table[i_m++] = individuals_table[z+1];
 636                                 individuals_table[i_m++] = individuals_table[z+2];
 637                                 for (y=0;y < individuals_table[z+2]/2;y++)
 638                                 {   individuals_table[i_m++] = (z+3+y*2)/256;
 639                                     individuals_table[i_m++] = (z+3+y*2)%256;
 640                                     backpatch_zmachine(INHERIT_INDIV_MV,
 641                                         INDIVIDUAL_PROP_ZA, i_m-2);
 642                                 }
 643                             }
 644                             z += individuals_table[z+2] + 3;
 645                         }
 646                         individuals_length = i_m;
 647                     }
 648
 649                     /*  For efficiency we exit the loop now (this property
 650                         number has been dealt with)                          */
 651
 652                     break;
 653                 }
 654
 655             if (!prop_in_current_defn)
 656             {
 657                 /*  The case where the class defined a property which wasn't
 658                     defined at all in full_object: we copy out the data into
 659                     a new property added to full_object                      */
 660
 661                 k=full_object.l++;
 662                 if (k >= 64)
 663                     fatalerror("More than 64 property entries in an object");
 664                 full_object.pp[k].num = prop_number;
 665                 full_object.pp[k].l = prop_length/2;
 666                 for (i=0; i<prop_length/2; i++)
 667                 {
 668                     INITAOTV(&full_object.pp[k].ao[i], LONG_CONSTANT_OT, mark + j);
 669                     j+=2;
 670                     full_object.pp[k].ao[i].marker = INHERIT_MV;
 671                 }
 672
 673                 if (prop_number==3)
 674                 {   int y, z, class_block_offset;
 675
 676                     /*  Property 3 holds the address of the table of
 677                         instance variables, so this is the case where
 678                         the object had no instance variables of its own
 679                         but must inherit some more from the class  */
 680
 681                     if (individual_prop_table_size++ == 0)
 682                     {   full_object.pp[k].num = 3;
 683                         full_object.pp[k].l = 1;
 684                         INITAOTV(&full_object.pp[k].ao[0], LONG_CONSTANT_OT, individuals_length);
 685                         full_object.pp[k].ao[0].marker = INDIVPT_MV;
 686                         i_m = individuals_length;
 687                     }
 688                     class_block_offset = class_prop_block[j-2]*256
 689                                          + class_prop_block[j-1];
 690
 691                     z = class_block_offset;
 692                     while ((individuals_table[z]!=0)||(individuals_table[z+1]!=0))
 693                     {
 694                         ensure_memory_list_available(&individuals_table_memlist, i_m+3+individuals_table[z+2]);
 695                         individuals_table[i_m++] = individuals_table[z];
 696                         individuals_table[i_m++] = individuals_table[z+1];
 697                         individuals_table[i_m++] = individuals_table[z+2];
 698                         for (y=0;y < individuals_table[z+2]/2;y++)
 699                         {   individuals_table[i_m++] = (z+3+y*2)/256;
 700                             individuals_table[i_m++] = (z+3+y*2)%256;
 701                             backpatch_zmachine(INHERIT_INDIV_MV,
 702                                 INDIVIDUAL_PROP_ZA, i_m-2);
 703                         }
 704                         z += individuals_table[z+2] + 3;
 705                     }
 706                     individuals_length = i_m;
 707                 }
 708             }
 709         }
 710     }
 711
 712     if (individual_prop_table_size > 0)
 713     {
 714         ensure_memory_list_available(&individuals_table_memlist, i_m+2);
 715
 716         individuals_table[i_m++] = 0;
 717         individuals_table[i_m++] = 0;
 718         individuals_length += 2;
 719     }
 720 }
 721
 722 static void property_inheritance_g(void)
 723 {
 724   /*  Apply the property inheritance rules to full_object, which should
 725       initially be complete (i.e., this routine takes place after the whole
 726       Nearby/Object/Class definition has been parsed through).
 727
 728       On exit, full_object contains the final state of the properties to
 729       be written. */
 730
 731   int i, j, k, class, num_props,
 732     prop_number, prop_length, prop_flags, prop_in_current_defn;
 733   int32 mark, prop_addr;
 734   uchar *cpb, *pe;
 735
 736   ASSERT_GLULX();
 737
 738   for (class=0; class<no_classes_to_inherit_from; class++) {
 739     mark = class_info[classes_to_inherit_from[class] - 1].begins_at;
 740     cpb = (properties_table + mark);
 741     /* This now points to the compiled property-table for the class.
 742        We'll have to go through and decompile it. (For our sins.) */
 743     num_props = ReadInt32(cpb);
 744     for (j=0; j<num_props; j++) {
 745       pe = cpb + 4 + j*10;
 746       prop_number = ReadInt16(pe);
 747       pe += 2;
 748       prop_length = ReadInt16(pe);
 749       pe += 2;
 750       prop_addr = ReadInt32(pe);
 751       pe += 4;
 752       prop_flags = ReadInt16(pe);
 753       pe += 2;
 754
 755       /*  So we now have property number prop_number present in the
 756           property block for the class being read. Its bytes are
 757           cpb[prop_addr ... prop_addr + prop_length - 1]
 758           Question now is: is there already a value given in the
 759           current definition under this property name? */
 760
 761       prop_in_current_defn = FALSE;
 762
 763       for (k=0; k<full_object_g.numprops; k++) {
 764         if (full_object_g.props[k].num == prop_number) {
 765           prop_in_current_defn = TRUE;
 766           break;
 767         }
 768       }
 769
 770       if (prop_in_current_defn) {
 771         if ((prop_number==1)
 772           || (prop_number < INDIV_PROP_START
 773             && commonprops[prop_number].is_additive)) {
 774           /*  The additive case: we accumulate the class
 775               property values onto the end of the full_object
 776               properties. Remember that k is still the index number
 777               of the first prop-block matching our property number. */
 778           int prevcont;
 779           if (full_object_g.props[k].continuation == 0) {
 780             full_object_g.props[k].continuation = 1;
 781             prevcont = 1;
 782           }
 783           else {
 784             prevcont = full_object_g.props[k].continuation;
 785             for (k++; k<full_object_g.numprops; k++) {
 786               if (full_object_g.props[k].num == prop_number) {
 787                 prevcont = full_object_g.props[k].continuation;
 788               }
 789             }
 790           }
 791           k = full_object_g.numprops++;
 792           ensure_memory_list_available(&full_object_g.props_memlist, k+1);
 793           full_object_g.props[k].num = prop_number;
 794           full_object_g.props[k].flags = 0;
 795           full_object_g.props[k].datastart = full_object_g.propdatasize;
 796           full_object_g.props[k].continuation = prevcont+1;
 797           full_object_g.props[k].datalen = prop_length;
 798
 799           ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize + prop_length);
 800           for (i=0; i<prop_length; i++) {
 801             int ppos = full_object_g.propdatasize++;
 802             INITAOTV(&full_object_g.propdata[ppos], CONSTANT_OT, prop_addr + 4*i);
 803             full_object_g.propdata[ppos].marker = INHERIT_MV;
 804           }
 805         }
 806         else {
 807           /*  The ordinary case: the full_object_g property
 808               values simply overrides the class definition,
 809               so we skip over the values in the class table. */
 810         }
 811       }
 812           else {
 813             /*  The case where the class defined a property which wasn't
 814                 defined at all in full_object_g: we copy out the data into
 815                 a new property added to full_object_g. */
 816             k = full_object_g.numprops++;
 817             ensure_memory_list_available(&full_object_g.props_memlist, k+1);
 818             full_object_g.props[k].num = prop_number;
 819             full_object_g.props[k].flags = prop_flags;
 820             full_object_g.props[k].datastart = full_object_g.propdatasize;
 821             full_object_g.props[k].continuation = 0;
 822             full_object_g.props[k].datalen = prop_length;
 823
 824             ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize + prop_length);
 825             for (i=0; i<prop_length; i++) {
 826               int ppos = full_object_g.propdatasize++;
 827               INITAOTV(&full_object_g.propdata[ppos], CONSTANT_OT, prop_addr + 4*i);
 828               full_object_g.propdata[ppos].marker = INHERIT_MV;
 829             }
 830           }
 831
 832     }
 833   }
 834
 835 }
 836
 837 /* ------------------------------------------------------------------------- */
 838 /*   Construction of Z-machine-format property blocks.                       */
 839 /* ------------------------------------------------------------------------- */
 840
 841 static int write_properties_between(int mark, int from, int to)
 842 {   int j, k, prop_number;
 843
 844     for (prop_number=to; prop_number>=from; prop_number--)
 845     {   for (j=0; j<full_object.l; j++)
 846         {   if ((full_object.pp[j].num == prop_number)
 847                 && (full_object.pp[j].l != 100))
 848             {
 849                 int prop_length = 2*full_object.pp[j].l;
 850                 ensure_memory_list_available(&properties_table_memlist, mark+2+prop_length);
 851                 if (version_number == 3)
 852                     properties_table[mark++] = prop_number + (prop_length - 1)*32;
 853                 else
 854                 {   switch(prop_length)
 855                     {   case 1:
 856                           properties_table[mark++] = prop_number; break;
 857                         case 2:
 858                           properties_table[mark++] = prop_number + 0x40; break;
 859                         default:
 860                           properties_table[mark++] = prop_number + 0x80;
 861                           properties_table[mark++] = prop_length + 0x80; break;
 862                     }
 863                 }
 864
 865                 for (k=0; k<full_object.pp[j].l; k++)
 866                 {   if (full_object.pp[j].ao[k].marker != 0)
 867                         backpatch_zmachine(full_object.pp[j].ao[k].marker,
 868                             PROP_ZA, mark);
 869                     properties_table[mark++] = full_object.pp[j].ao[k].value/256;
 870                     properties_table[mark++] = full_object.pp[j].ao[k].value%256;
 871                 }
 872             }
 873         }
 874     }
 875
 876     ensure_memory_list_available(&properties_table_memlist, mark+1);
 877     properties_table[mark++]=0;
 878     return(mark);
 879 }
 880
 881 static int write_property_block_z(char *shortname)
 882 {
 883     /*  Compile the (now complete) full_object properties into a
 884         property-table block at "p" in Inform's memory.
 885         "shortname" is the object's short name, if specified; otherwise
 886         NULL.
 887
 888         Return the number of bytes written to the block.                     */
 889
 890     int32 mark = properties_table_size, i;
 891
 892     /* printf("Object at %04x\n", mark); */
 893
 894     if (shortname != NULL)
 895     {
 896         i = translate_text(510,shortname,STRCTX_OBJNAME);
 897         if (i < 0) {
 898             error ("Short name of object exceeded 765 Z-characters");
 899             i = 0;
 900         }
 901         ensure_memory_list_available(&properties_table_memlist, mark+1+i);
 902         memcpy(properties_table + mark+1, translated_text, i);
 903         properties_table[mark] = i/2;
 904         mark += i+1;
 905     }
 906     if (current_defn_is_class)
 907     {   mark = write_properties_between(mark,3,3);
 908         ensure_memory_list_available(&properties_table_memlist, mark+6);
 909         for (i=0;i<6;i++)
 910             properties_table[mark++] = full_object.atts[i];
 911         ensure_memory_list_available(&class_info_memlist, no_classes+1);
 912         class_info[no_classes++].begins_at = mark;
 913     }
 914
 915     mark = write_properties_between(mark, 1, (version_number==3)?31:63);
 916
 917     i = mark - properties_table_size;
 918     properties_table_size = mark;
 919
 920     return(i);
 921 }
 922
 923 static int gpropsort(void *ptr1, void *ptr2)
 924 {
 925   propg *prop1 = ptr1;
 926   propg *prop2 = ptr2;
 927
 928   if (prop2->num == -1)
 929     return -1;
 930   if (prop1->num == -1)
 931     return 1;
 932   if (prop1->num < prop2->num)
 933     return -1;
 934   if (prop1->num > prop2->num)
 935     return 1;
 936
 937   return (prop1->continuation - prop2->continuation);
 938 }
 939
 940 static int32 write_property_block_g(void)
 941 {
 942   /*  Compile the (now complete) full_object properties into a
 943       property-table block at "p" in Inform's memory.
 944       Return the number of bytes written to the block.
 945       In Glulx, the shortname property isn't used here; it's already
 946       been compiled into an ordinary string. */
 947
 948   int32 i;
 949   int ix, jx, kx, totalprops;
 950   int32 mark = properties_table_size;
 951   int32 datamark;
 952
 953   if (current_defn_is_class) {
 954     ensure_memory_list_available(&properties_table_memlist, mark+NUM_ATTR_BYTES);
 955     for (i=0;i<NUM_ATTR_BYTES;i++)
 956       properties_table[mark++] = full_object_g.atts[i];
 957     ensure_memory_list_available(&class_info_memlist, no_classes+1);
 958     class_info[no_classes++].begins_at = mark;
 959   }
 960
 961   qsort(full_object_g.props, full_object_g.numprops, sizeof(propg),
 962     (int (*)(const void *, const void *))(&gpropsort));
 963
 964   full_object_g.finalpropaddr = mark;
 965
 966   totalprops = 0;
 967
 968   for (ix=0; ix<full_object_g.numprops; ix=jx) {
 969     int propnum = full_object_g.props[ix].num;
 970     if (propnum == -1)
 971         break;
 972     for (jx=ix;
 973         jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
 974         jx++);
 975     totalprops++;
 976   }
 977
 978   /* Write out the number of properties in this table. */
 979   ensure_memory_list_available(&properties_table_memlist, mark+4);
 980   WriteInt32(properties_table+mark, totalprops);
 981   mark += 4;
 982
 983   datamark = mark + 10*totalprops;
 984
 985   for (ix=0; ix<full_object_g.numprops; ix=jx) {
 986     int propnum = full_object_g.props[ix].num;
 987     int flags = full_object_g.props[ix].flags;
 988     int totallen = 0;
 989     int32 datamarkstart = datamark;
 990     if (propnum == -1)
 991       break;
 992     for (jx=ix;
 993         jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
 994         jx++) {
 995       int32 datastart = full_object_g.props[jx].datastart;
 996       ensure_memory_list_available(&properties_table_memlist, datamark+4*full_object_g.props[jx].datalen);
 997       for (kx=0; kx<full_object_g.props[jx].datalen; kx++) {
 998         int32 val = full_object_g.propdata[datastart+kx].value;
 999         WriteInt32(properties_table+datamark, val);
1000         if (full_object_g.propdata[datastart+kx].marker != 0)
1001           backpatch_zmachine(full_object_g.propdata[datastart+kx].marker,
1002             PROP_ZA, datamark);
1003         totallen++;
1004         datamark += 4;
1005       }
1006     }
1007     ensure_memory_list_available(&properties_table_memlist, mark+10);
1008     WriteInt16(properties_table+mark, propnum);
1009     mark += 2;
1010     WriteInt16(properties_table+mark, totallen);
1011     mark += 2;
1012     WriteInt32(properties_table+mark, datamarkstart);
1013     mark += 4;
1014     WriteInt16(properties_table+mark, flags);
1015     mark += 2;
1016   }
1017
1018   mark = datamark;
1019
1020   i = mark - properties_table_size;
1021   properties_table_size = mark;
1022   return i;
1023 }
1024
1025 /* ------------------------------------------------------------------------- */
1026 /*   The final stage in Nearby/Object/Class definition processing.           */
1027 /* ------------------------------------------------------------------------- */
1028
1029 static void manufacture_object_z(void)
1030 {   int i, j;
1031
1032     segment_markers.enabled = FALSE;
1033     directives.enabled = TRUE;
1034
1035     ensure_memory_list_available(&objectsz_memlist, no_objects+1);
1036
1037     objectsz[no_objects].symbol = full_object.symbol;
1038
1039     property_inheritance_z();
1040
1041     objectsz[no_objects].parent = parent_of_this_obj;
1042     objectsz[no_objects].next = 0;
1043     objectsz[no_objects].child = 0;
1044
1045     if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fff))
1046     {   i = objectsz[parent_of_this_obj-1].child;
1047         if (i == 0)
1048             objectsz[parent_of_this_obj-1].child = no_objects + 1;
1049         else
1050         {   while(objectsz[i-1].next != 0) i = objectsz[i-1].next;
1051             objectsz[i-1].next = no_objects+1;
1052         }
1053     }
1054
1055         /*  The properties table consists simply of a sequence of property
1056             blocks, one for each object in order of definition, exactly as
1057             it will appear in the final Z-machine.                           */
1058
1059     j = write_property_block_z(shortname_buffer);
1060
1061     objectsz[no_objects].propsize = j;
1062
1063     if (current_defn_is_class)
1064         for (i=0;i<6;i++) objectsz[no_objects].atts[i] = 0;
1065     else
1066         for (i=0;i<6;i++)
1067             objectsz[no_objects].atts[i] = full_object.atts[i];
1068
1069     no_objects++;
1070 }
1071
1072 static void manufacture_object_g(void)
1073 {   int32 i, j;
1074
1075     segment_markers.enabled = FALSE;
1076     directives.enabled = TRUE;
1077
1078     ensure_memory_list_available(&objectsg_memlist, no_objects+1);
1079     ensure_memory_list_available(&objectatts_memlist, no_objects+1);
1080
1081     objectsg[no_objects].symbol = full_object_g.symbol;
1082
1083     property_inheritance_g();
1084
1085     objectsg[no_objects].parent = parent_of_this_obj;
1086     objectsg[no_objects].next = 0;
1087     objectsg[no_objects].child = 0;
1088
1089     if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fffffff))
1090     {   i = objectsg[parent_of_this_obj-1].child;
1091         if (i == 0)
1092             objectsg[parent_of_this_obj-1].child = no_objects + 1;
1093         else
1094         {   while(objectsg[i-1].next != 0) i = objectsg[i-1].next;
1095             objectsg[i-1].next = no_objects+1;
1096         }
1097     }
1098
1099     objectsg[no_objects].shortname = compile_string(shortname_buffer,
1100       STRCTX_OBJNAME);
1101
1102         /*  The properties table consists simply of a sequence of property
1103             blocks, one for each object in order of definition, exactly as
1104             it will appear in the final machine image.                      */
1105
1106     j = write_property_block_g();
1107
1108     objectsg[no_objects].propaddr = full_object_g.finalpropaddr;
1109
1110     objectsg[no_objects].propsize = j;
1111
1112     if (current_defn_is_class)
1113         for (i=0;i<NUM_ATTR_BYTES;i++)
1114             objectatts[no_objects*NUM_ATTR_BYTES+i] = 0;
1115     else
1116         for (i=0;i<NUM_ATTR_BYTES;i++)
1117             objectatts[no_objects*NUM_ATTR_BYTES+i] = full_object_g.atts[i];
1118
1119     no_objects++;
1120 }
1121
1122
1123 /* ========================================================================= */
1124 /*   [2]  The Object/Nearby/Class directives parser: translating the syntax  */
1125 /*        into object specifications and then triggering off the above.      */
1126 /* ========================================================================= */
1127 /*   Properties ("with" or "private") segment.                               */
1128 /* ------------------------------------------------------------------------- */
1129
1130 static int *defined_this_segment;
1131 static long defined_this_segment_size; /* calloc size */
1132 static int def_t_s;
1133
1134 static void ensure_defined_this_segment(int newsize)
1135 {
1136     int oldsize = defined_this_segment_size;
1137     defined_this_segment_size = newsize;
1138     my_recalloc(&defined_this_segment, sizeof(int), oldsize,
1139         defined_this_segment_size, "defined this segment table");
1140 }
1141
1142 static void properties_segment_z(int this_segment)
1143 {
1144     /*  Parse through the "with" part of an object/class definition:
1145
1146         <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
1147
1148         This routine also handles "private", with this_segment being equal
1149         to the token value for the introductory word ("private" or "with").  */
1150
1151
1152     int   i, property_name_symbol, property_number=0, next_prop=0, length,
1153           individual_property, this_identifier_number;
1154
1155     do
1156     {   get_next_token_with_directives();
1157         if ((token_type == SEGMENT_MARKER_TT)
1158             || (token_type == EOF_TT)
1159             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1160         {   put_token_back(); return;
1161         }
1162
1163         if (token_type != SYMBOL_TT)
1164         {   ebf_error("property name", token_text);
1165             return;
1166         }
1167
1168         individual_property = (symbols[token_value].type != PROPERTY_T);
1169
1170         if (individual_property)
1171         {   if (symbols[token_value].flags & UNKNOWN_SFLAG)
1172             {   this_identifier_number = no_individual_properties++;
1173                 assign_symbol(token_value, this_identifier_number,
1174                     INDIVIDUAL_PROPERTY_T);
1175
1176                 if (debugfile_switch)
1177                 {   debug_file_printf("<property>");
1178                     debug_file_printf
1179                         ("<identifier>%s</identifier>", token_text);
1180                     debug_file_printf
1181                         ("<value>%d</value>", this_identifier_number);
1182                     debug_file_printf("</property>");
1183                 }
1184
1185                 trace_s(token_text, symbols[token_value].value, 2);
1186             }
1187             else
1188             {   if (symbols[token_value].type==INDIVIDUAL_PROPERTY_T)
1189                     this_identifier_number = symbols[token_value].value;
1190                 else
1191                 {   ebf_symbol_error("property name", token_text, typename(symbols[token_value].type), symbols[token_value].line);
1192                     return;
1193                 }
1194             }
1195
1196             if (def_t_s >= defined_this_segment_size)
1197                 ensure_defined_this_segment(def_t_s*2);
1198             defined_this_segment[def_t_s++] = token_value;
1199
1200             if (individual_prop_table_size++ == 0)
1201             {
1202                 int k=full_object.l++;
1203                 if (k >= 64)
1204                     fatalerror("More than 64 property entries in an object");
1205                 full_object.pp[k].num = 3;
1206                 full_object.pp[k].l = 1;
1207                 INITAOTV(&full_object.pp[k].ao[0], LONG_CONSTANT_OT, individuals_length);
1208                 full_object.pp[k].ao[0].marker = INDIVPT_MV;
1209
1210                 i_m = individuals_length;
1211             }
1212             ensure_memory_list_available(&individuals_table_memlist, i_m+3);
1213             individuals_table[i_m] = this_identifier_number/256;
1214             if (this_segment == PRIVATE_SEGMENT)
1215                 individuals_table[i_m] |= 0x80;
1216             individuals_table[i_m+1] = this_identifier_number%256;
1217             individuals_table[i_m+2] = 0;
1218         }
1219         else
1220         {   if (symbols[token_value].flags & UNKNOWN_SFLAG)
1221             {   error_named("No such property name as", token_text);
1222                 return;
1223             }
1224             if (this_segment == PRIVATE_SEGMENT)
1225                 error_named("Property should be declared in 'with', \
1226 not 'private':", token_text);
1227             if (def_t_s >= defined_this_segment_size)
1228                 ensure_defined_this_segment(def_t_s*2);
1229             defined_this_segment[def_t_s++] = token_value;
1230             property_number = symbols[token_value].value;
1231
1232             next_prop=full_object.l++;
1233             if (next_prop >= 64)
1234                 fatalerror("More than 64 property entries in an object");
1235             full_object.pp[next_prop].num = property_number;
1236         }
1237
1238         for (i=0; i<(def_t_s-1); i++)
1239             if (defined_this_segment[i] == token_value)
1240             {   error_named("Property given twice in the same declaration:",
1241                     symbols[token_value].name);
1242             }
1243             else
1244             if (symbols[defined_this_segment[i]].value == symbols[token_value].value)
1245             {   char error_b[128+2*MAX_IDENTIFIER_LENGTH];
1246                 sprintf(error_b,
1247                     "Property given twice in the same declaration, because \
1248 the names '%s' and '%s' actually refer to the same property",
1249                     symbols[defined_this_segment[i]].name,
1250                     symbols[token_value].name);
1251                 error(error_b);
1252             }
1253
1254         property_name_symbol = token_value;
1255         symbols[token_value].flags |= USED_SFLAG;
1256
1257         length=0;
1258         do
1259         {   assembly_operand AO;
1260             get_next_token_with_directives();
1261             if ((token_type == EOF_TT)
1262                 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1263                 || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1264                 break;
1265
1266             if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1267
1268             if ((!individual_property) && (property_number==1)
1269                 && ((token_type != SQ_TT) || (strlen(token_text) <2 ))
1270                 && (token_type != DQ_TT)
1271                 )
1272                 warning ("'name' property should only contain dictionary words");
1273
1274             if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1275             {
1276                 char *prefix, *sep, *sym;
1277                 sym = symbols[property_name_symbol].name;
1278                 if (current_defn_is_class)
1279                 {
1280                     prefix = symbols[current_classname_symbol].name;
1281                     sep = "::";
1282                 }
1283                 else
1284                 {
1285                     prefix = current_object_name.data;
1286                     sep = ".";
1287                 }
1288                 ensure_memory_list_available(&embedded_function_name, strlen(prefix)+strlen(sep)+strlen(sym)+1);
1289                 sprintf(embedded_function_name.data, "%s%s%s", prefix, sep, sym);
1290
1291                 /* parse_routine() releases lexer text! */
1292                 AO.value = parse_routine(NULL, TRUE, embedded_function_name.data, FALSE, -1);
1293                 AO.type = LONG_CONSTANT_OT;
1294                 AO.marker = IROUTINE_MV;
1295
1296                 directives.enabled = FALSE;
1297                 segment_markers.enabled = TRUE;
1298
1299                 statements.enabled = FALSE;
1300                 misc_keywords.enabled = FALSE;
1301                 local_variables.enabled = FALSE;
1302                 system_functions.enabled = FALSE;
1303                 conditions.enabled = FALSE;
1304             }
1305             else
1306
1307             /*  A special rule applies to values in double-quotes of the
1308                 built-in property "name", which always has number 1: such
1309                 property values are dictionary entries and not static
1310                 strings                                                      */
1311
1312             if ((!individual_property) &&
1313                 (property_number==1) && (token_type == DQ_TT))
1314             {   AO.value = dictionary_add(token_text, 0x80, 0, 0);
1315                 AO.type = LONG_CONSTANT_OT;
1316                 AO.marker = DWORD_MV;
1317             }
1318             else
1319             {   if (length!=0)
1320                 {
1321                     if ((token_type == SYMBOL_TT)
1322                         && (symbols[token_value].type==PROPERTY_T))
1323                     {
1324                         /*  This is not necessarily an error: it's possible
1325                             to imagine a property whose value is a list
1326                             of other properties to look up, but far more
1327                             likely that a comma has been omitted in between
1328                             two property blocks                              */
1329
1330                         warning_named(
1331                "Missing ','? Property data seems to contain the property name",
1332                             token_text);
1333                     }
1334                 }
1335
1336                 /*  An ordinary value, then:                                 */
1337
1338                 put_token_back();
1339                 AO = parse_expression(ARRAY_CONTEXT);
1340             }
1341
1342             if (length == 64)
1343             {   error_named("Limit (of 32 values) exceeded for property",
1344                     symbols[property_name_symbol].name);
1345                 break;
1346             }
1347
1348             if (individual_property)
1349             {   if (AO.marker != 0)
1350                     backpatch_zmachine(AO.marker, INDIVIDUAL_PROP_ZA,
1351                         i_m+3+length);
1352                 ensure_memory_list_available(&individuals_table_memlist, i_m+3+length+2);
1353                 individuals_table[i_m+3+length++] = AO.value/256;
1354                 individuals_table[i_m+3+length++] = AO.value%256;
1355             }
1356             else
1357             {   full_object.pp[next_prop].ao[length/2] = AO;
1358                 length = length + 2;
1359             }
1360
1361         } while (TRUE);
1362
1363         /*  People rarely do, but it is legal to declare a property without
1364             a value at all:
1365
1366                 with  name "fish", number, time_left;
1367
1368             in which case the properties "number" and "time_left" are
1369             created as in effect variables and initialised to zero.          */
1370
1371         if (length == 0)
1372         {   if (individual_property)
1373             {
1374                 ensure_memory_list_available(&individuals_table_memlist, i_m+3+length+2);
1375                 individuals_table[i_m+3+length++] = 0;
1376                 individuals_table[i_m+3+length++] = 0;
1377             }
1378             else
1379             {
1380                 INITAOTV(&full_object.pp[next_prop].ao[0], LONG_CONSTANT_OT, 0);
1381                 length = 2;
1382             }
1383         }
1384
1385         if ((version_number==3) && (!individual_property))
1386         {   if (length > 8)
1387             {
1388        warning_named("Version 3 limit of 4 values per property exceeded \
1389 (use -v5 to get 32), so truncating property",
1390                     symbols[property_name_symbol].name);
1391                 length = 8;
1392             }
1393         }
1394
1395         if (individual_property)
1396         {
1397             ensure_memory_list_available(&individuals_table_memlist, individuals_length+length+3);
1398             individuals_table[i_m + 2] = length;
1399             individuals_length += length+3;
1400             i_m = individuals_length;
1401         }
1402         else
1403             full_object.pp[next_prop].l = length/2;
1404
1405         if ((token_type == EOF_TT)
1406             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1407         {   put_token_back(); return;
1408         }
1409
1410     } while (TRUE);
1411 }
1412
1413
1414 static void properties_segment_g(int this_segment)
1415 {
1416     /*  Parse through the "with" part of an object/class definition:
1417
1418         <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
1419
1420         This routine also handles "private", with this_segment being equal
1421         to the token value for the introductory word ("private" or "with").  */
1422
1423
1424     int   i, next_prop,
1425           individual_property, this_identifier_number;
1426     int32 property_name_symbol, property_number, length;
1427
1428     do
1429     {   get_next_token_with_directives();
1430         if ((token_type == SEGMENT_MARKER_TT)
1431             || (token_type == EOF_TT)
1432             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1433         {   put_token_back(); return;
1434         }
1435
1436         if (token_type != SYMBOL_TT)
1437         {   ebf_error("property name", token_text);
1438             return;
1439         }
1440
1441         individual_property = (symbols[token_value].type != PROPERTY_T);
1442
1443         if (individual_property)
1444         {   if (symbols[token_value].flags & UNKNOWN_SFLAG)
1445             {   this_identifier_number = no_individual_properties++;
1446                 assign_symbol(token_value, this_identifier_number,
1447                     INDIVIDUAL_PROPERTY_T);
1448
1449                 if (debugfile_switch)
1450                 {   debug_file_printf("<property>");
1451                     debug_file_printf
1452                         ("<identifier>%s</identifier>", token_text);
1453                     debug_file_printf
1454                         ("<value>%d</value>", this_identifier_number);
1455                     debug_file_printf("</property>");
1456                 }
1457
1458                 trace_s(token_text, symbols[token_value].value, 2);
1459             }
1460             else
1461             {   if (symbols[token_value].type==INDIVIDUAL_PROPERTY_T)
1462                     this_identifier_number = symbols[token_value].value;
1463                 else
1464                 {   ebf_symbol_error("property name", token_text, typename(symbols[token_value].type), symbols[token_value].line);
1465                     return;
1466                 }
1467             }
1468
1469             if (def_t_s >= defined_this_segment_size)
1470                 ensure_defined_this_segment(def_t_s*2);
1471             defined_this_segment[def_t_s++] = token_value;
1472             property_number = symbols[token_value].value;
1473
1474             next_prop=full_object_g.numprops++;
1475             ensure_memory_list_available(&full_object_g.props_memlist, next_prop+1);
1476             full_object_g.props[next_prop].num = property_number;
1477             full_object_g.props[next_prop].flags =
1478               ((this_segment == PRIVATE_SEGMENT) ? 1 : 0);
1479             full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1480             full_object_g.props[next_prop].continuation = 0;
1481             full_object_g.props[next_prop].datalen = 0;
1482         }
1483         else
1484         {   if (symbols[token_value].flags & UNKNOWN_SFLAG)
1485             {   error_named("No such property name as", token_text);
1486                 return;
1487             }
1488             if (this_segment == PRIVATE_SEGMENT)
1489                 error_named("Property should be declared in 'with', \
1490 not 'private':", token_text);
1491
1492             if (def_t_s >= defined_this_segment_size)
1493                 ensure_defined_this_segment(def_t_s*2);
1494             defined_this_segment[def_t_s++] = token_value;
1495             property_number = symbols[token_value].value;
1496
1497             next_prop=full_object_g.numprops++;
1498             ensure_memory_list_available(&full_object_g.props_memlist, next_prop+1);
1499             full_object_g.props[next_prop].num = property_number;
1500             full_object_g.props[next_prop].flags = 0;
1501             full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1502             full_object_g.props[next_prop].continuation = 0;
1503             full_object_g.props[next_prop].datalen = 0;
1504         }
1505
1506         for (i=0; i<(def_t_s-1); i++)
1507             if (defined_this_segment[i] == token_value)
1508             {   error_named("Property given twice in the same declaration:",
1509                     symbols[token_value].name);
1510             }
1511             else
1512             if (symbols[defined_this_segment[i]].value == symbols[token_value].value)
1513             {   char error_b[128+2*MAX_IDENTIFIER_LENGTH];
1514                 sprintf(error_b,
1515                     "Property given twice in the same declaration, because \
1516 the names '%s' and '%s' actually refer to the same property",
1517                     symbols[defined_this_segment[i]].name,
1518                     symbols[token_value].name);
1519                 error(error_b);
1520             }
1521
1522         property_name_symbol = token_value;
1523         symbols[token_value].flags |= USED_SFLAG;
1524
1525         length=0;
1526         do
1527         {   assembly_operand AO;
1528             get_next_token_with_directives();
1529             if ((token_type == EOF_TT)
1530                 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1531                 || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1532                 break;
1533
1534             if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1535
1536             if ((!individual_property) && (property_number==1)
1537                 && ((token_type != SQ_TT) || (strlen(token_text) <2 ))
1538                 && (token_type != DQ_TT)
1539                 )
1540                 warning ("'name' property should only contain dictionary words");
1541
1542             if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1543             {
1544                 char *prefix, *sep, *sym;
1545                 sym = symbols[property_name_symbol].name;
1546                 if (current_defn_is_class)
1547                 {
1548                     prefix = symbols[current_classname_symbol].name;
1549                     sep = "::";
1550                 }
1551                 else
1552                 {
1553                     prefix = current_object_name.data;
1554                     sep = ".";
1555                 }
1556                 ensure_memory_list_available(&embedded_function_name, strlen(prefix)+strlen(sep)+strlen(sym)+1);
1557                 sprintf(embedded_function_name.data, "%s%s%s", prefix, sep, sym);
1558
1559                 INITAOT(&AO, CONSTANT_OT);
1560                 /* parse_routine() releases lexer text! */
1561                 AO.value = parse_routine(NULL, TRUE, embedded_function_name.data, FALSE, -1);
1562                 AO.marker = IROUTINE_MV;
1563
1564                 directives.enabled = FALSE;
1565                 segment_markers.enabled = TRUE;
1566
1567                 statements.enabled = FALSE;
1568                 misc_keywords.enabled = FALSE;
1569                 local_variables.enabled = FALSE;
1570                 system_functions.enabled = FALSE;
1571                 conditions.enabled = FALSE;
1572             }
1573             else
1574
1575             /*  A special rule applies to values in double-quotes of the
1576                 built-in property "name", which always has number 1: such
1577                 property values are dictionary entries and not static
1578                 strings                                                      */
1579
1580             if ((!individual_property) &&
1581                 (property_number==1) && (token_type == DQ_TT))
1582             {   AO.value = dictionary_add(token_text, 0x80, 0, 0);
1583                 AO.type = CONSTANT_OT;
1584                 AO.marker = DWORD_MV;
1585             }
1586             else
1587             {   if (length!=0)
1588                 {
1589                     if ((token_type == SYMBOL_TT)
1590                         && (symbols[token_value].type==PROPERTY_T))
1591                     {
1592                         /*  This is not necessarily an error: it's possible
1593                             to imagine a property whose value is a list
1594                             of other properties to look up, but far more
1595                             likely that a comma has been omitted in between
1596                             two property blocks                              */
1597
1598                         warning_named(
1599                "Missing ','? Property data seems to contain the property name",
1600                             token_text);
1601                     }
1602                 }
1603
1604                 /*  An ordinary value, then:                                 */
1605
1606                 put_token_back();
1607                 AO = parse_expression(ARRAY_CONTEXT);
1608             }
1609
1610             if (length == 32768) /* VENEER_CONSTRAINT_ON_PROP_TABLE_SIZE? */
1611             {   error_named("Limit (of 32768 values) exceeded for property",
1612                     symbols[property_name_symbol].name);
1613                 break;
1614             }
1615
1616             ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize+1);
1617
1618             full_object_g.propdata[full_object_g.propdatasize++] = AO;
1619             length += 1;
1620
1621         } while (TRUE);
1622
1623         /*  People rarely do, but it is legal to declare a property without
1624             a value at all:
1625
1626                 with  name "fish", number, time_left;
1627
1628             in which case the properties "number" and "time_left" are
1629             created as in effect variables and initialised to zero.          */
1630
1631         if (length == 0)
1632         {
1633             assembly_operand AO;
1634             INITAOTV(&AO, CONSTANT_OT, 0);
1635             ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize+1);
1636             full_object_g.propdata[full_object_g.propdatasize++] = AO;
1637             length += 1;
1638         }
1639
1640         full_object_g.props[next_prop].datalen = length;
1641
1642         if ((token_type == EOF_TT)
1643             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1644         {   put_token_back(); return;
1645         }
1646
1647     } while (TRUE);
1648 }
1649
1650 static void properties_segment(int this_segment)
1651 {
1652   if (!glulx_mode)
1653     properties_segment_z(this_segment);
1654   else
1655     properties_segment_g(this_segment);
1656 }
1657
1658 /* ------------------------------------------------------------------------- */
1659 /*   Attributes ("has") segment.                                             */
1660 /* ------------------------------------------------------------------------- */
1661
1662 static void attributes_segment(void)
1663 {
1664     /*  Parse through the "has" part of an object/class definition:
1665
1666         [~]<attribute-1> [~]<attribute-2> ... [~]<attribute-n>               */
1667
1668     int attribute_number, truth_state, bitmask;
1669     uchar *attrbyte;
1670     do
1671     {   truth_state = TRUE;
1672
1673         ParseAttrN:
1674
1675         get_next_token_with_directives();
1676         if ((token_type == SEGMENT_MARKER_TT)
1677             || (token_type == EOF_TT)
1678             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1679         {   if (!truth_state)
1680                 ebf_error("attribute name after '~'", token_text);
1681             put_token_back(); return;
1682         }
1683         if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1684
1685         if ((token_type == SEP_TT) && (token_value == ARTNOT_SEP))
1686         {   truth_state = !truth_state; goto ParseAttrN;
1687         }
1688
1689         if ((token_type != SYMBOL_TT)
1690             || (symbols[token_value].type != ATTRIBUTE_T))
1691         {   ebf_error("name of an already-declared attribute", token_text);
1692             return;
1693         }
1694
1695         attribute_number = symbols[token_value].value;
1696         symbols[token_value].flags |= USED_SFLAG;
1697
1698         if (!glulx_mode) {
1699             bitmask = (1 << (7-attribute_number%8));
1700             attrbyte = &(full_object.atts[attribute_number/8]);
1701         }
1702         else {
1703             /* In Glulx, my prejudices rule, and therefore bits are numbered
1704                from least to most significant. This is the opposite of the
1705                way the Z-machine works. */
1706             bitmask = (1 << (attribute_number%8));
1707             attrbyte = &(full_object_g.atts[attribute_number/8]);
1708         }
1709
1710         if (truth_state)
1711             *attrbyte |= bitmask;     /* Set attribute bit */
1712         else
1713             *attrbyte &= ~bitmask;    /* Clear attribute bit */
1714
1715     } while (TRUE);
1716 }
1717
1718 /* ------------------------------------------------------------------------- */
1719 /*   Classes ("class") segment.                                              */
1720 /* ------------------------------------------------------------------------- */
1721
1722 static void add_class_to_inheritance_list(int class_number)
1723 {
1724     int i;
1725
1726     /*  The class number is actually the class's object number, which needs
1727         to be translated into its actual class number:                       */
1728
1729     for (i=0;i<no_classes;i++)
1730         if (class_number == class_info[i].object_number)
1731         {   class_number = i+1;
1732             break;
1733         }
1734
1735     /*  Remember the inheritance list so that property inheritance can
1736         be sorted out later on, when the definition has been finished:       */
1737
1738     ensure_memory_list_available(&classes_to_inherit_from_memlist, no_classes_to_inherit_from+1);
1739
1740     classes_to_inherit_from[no_classes_to_inherit_from++] = class_number;
1741
1742     /*  Inheriting attributes from the class at once:                        */
1743
1744     if (!glulx_mode) {
1745         for (i=0; i<6; i++)
1746             full_object.atts[i]
1747                 |= properties_table[class_info[class_number-1].begins_at - 6 + i];
1748     }
1749     else {
1750         for (i=0; i<NUM_ATTR_BYTES; i++)
1751             full_object_g.atts[i]
1752                 |= properties_table[class_info[class_number-1].begins_at
1753                     - NUM_ATTR_BYTES + i];
1754     }
1755 }
1756
1757 static void classes_segment(void)
1758 {
1759     /*  Parse through the "class" part of an object/class definition:
1760
1761         <class-1> ... <class-n>                                              */
1762
1763     do
1764     {   get_next_token_with_directives();
1765         if ((token_type == SEGMENT_MARKER_TT)
1766             || (token_type == EOF_TT)
1767             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1768         {   put_token_back(); return;
1769         }
1770         if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1771
1772         if ((token_type != SYMBOL_TT)
1773             || (symbols[token_value].type != CLASS_T))
1774         {   ebf_error("name of an already-declared class", token_text);
1775             return;
1776         }
1777         if (current_defn_is_class && token_value == current_classname_symbol)
1778         {   error("A class cannot inherit from itself");
1779             return;
1780         }
1781
1782         symbols[token_value].flags |= USED_SFLAG;
1783         add_class_to_inheritance_list(symbols[token_value].value);
1784     } while (TRUE);
1785 }
1786
1787 /* ------------------------------------------------------------------------- */
1788 /*   Parse the body of a Nearby/Object/Class definition.                     */
1789 /* ------------------------------------------------------------------------- */
1790
1791 static void parse_body_of_definition(void)
1792 {   int commas_in_row;
1793
1794     def_t_s = 0;
1795
1796     do
1797     {   commas_in_row = -1;
1798         do
1799         {   get_next_token_with_directives(); commas_in_row++;
1800         } while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
1801
1802         if (commas_in_row>1)
1803             error("Two commas ',' in a row in object/class definition");
1804
1805         if ((token_type == EOF_TT)
1806             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1807         {   if (commas_in_row > 0)
1808                 error("Object/class definition finishes with ','");
1809             if (token_type == EOF_TT)
1810                 error("Object/class definition incomplete (no ';') at end of file");
1811             break;
1812         }
1813
1814         if (token_type != SEGMENT_MARKER_TT)
1815         {   error_named("Expected 'with', 'has' or 'class' in \
1816 object/class definition but found", token_text);
1817             break;
1818         }
1819         else
1820         switch(token_value)
1821         {   case WITH_SEGMENT:
1822                 properties_segment(WITH_SEGMENT);
1823                 break;
1824             case PRIVATE_SEGMENT:
1825                 properties_segment(PRIVATE_SEGMENT);
1826                 break;
1827             case HAS_SEGMENT:
1828                 attributes_segment();
1829                 break;
1830             case CLASS_SEGMENT:
1831                 classes_segment();
1832                 break;
1833         }
1834
1835     } while (TRUE);
1836
1837 }
1838
1839 /* ------------------------------------------------------------------------- */
1840 /*   Class directives:                                                       */
1841 /*                                                                           */
1842 /*        Class <name>  <body of definition>                                 */
1843 /* ------------------------------------------------------------------------- */
1844
1845 static void initialise_full_object(void)
1846 {
1847   int i;
1848   if (!glulx_mode) {
1849     full_object.symbol = 0;
1850     full_object.l = 0;
1851     full_object.atts[0] = 0;
1852     full_object.atts[1] = 0;
1853     full_object.atts[2] = 0;
1854     full_object.atts[3] = 0;
1855     full_object.atts[4] = 0;
1856     full_object.atts[5] = 0;
1857   }
1858   else {
1859     full_object_g.symbol = 0;
1860     full_object_g.numprops = 0;
1861     full_object_g.propdatasize = 0;
1862     for (i=0; i<NUM_ATTR_BYTES; i++)
1863       full_object_g.atts[i] = 0;
1864   }
1865 }
1866
1867 extern void make_class(char * metaclass_name)
1868 {   int n, duplicates_to_make = 0, class_number = no_objects+1,
1869         metaclass_flag = (metaclass_name != NULL);
1870     debug_location_beginning beginning_debug_location =
1871         get_token_location_beginning();
1872
1873     current_defn_is_class = TRUE; no_classes_to_inherit_from = 0;
1874     individual_prop_table_size = 0;
1875
1876     ensure_memory_list_available(&class_info_memlist, no_classes+1);
1877
1878     if (no_classes==VENEER_CONSTRAINT_ON_CLASSES)
1879         fatalerror("Inform's maximum possible number of classes (whatever \
1880 amount of memory is allocated) has been reached. If this causes serious \
1881 inconvenience, please contact the maintainers.");
1882
1883     directives.enabled = FALSE;
1884
1885     if (metaclass_flag)
1886     {   token_text = metaclass_name;
1887         token_value = symbol_index(token_text, -1);
1888         token_type = SYMBOL_TT;
1889     }
1890     else
1891     {   get_next_token();
1892         if (token_type != SYMBOL_TT)
1893         {   discard_token_location(beginning_debug_location);
1894             ebf_error("new class name", token_text);
1895             panic_mode_error_recovery();
1896             return;
1897         }
1898         if (!(symbols[token_value].flags & UNKNOWN_SFLAG))
1899         {   discard_token_location(beginning_debug_location);
1900             ebf_symbol_error("new class name", token_text, typename(symbols[token_value].type), symbols[token_value].line);
1901             panic_mode_error_recovery();
1902             return;
1903         }
1904     }
1905
1906     /*  Each class also creates a modest object representing itself:         */
1907
1908     strcpy(shortname_buffer, token_text);
1909
1910     assign_symbol(token_value, class_number, CLASS_T);
1911     current_classname_symbol = token_value;
1912
1913     if (!glulx_mode) {
1914         if (metaclass_flag) symbols[token_value].flags |= SYSTEM_SFLAG;
1915     }
1916     else {
1917         /*  In Glulx, metaclasses have to be backpatched too! So we can't
1918             mark it as "system", but we should mark it "used". */
1919         if (metaclass_flag) symbols[token_value].flags |= USED_SFLAG;
1920     }
1921
1922     /*  "Class" (object 1) has no parent, whereas all other classes are
1923         the children of "Class".                                             */
1924
1925     if (metaclass_flag) parent_of_this_obj = 0;
1926     else parent_of_this_obj = 1;
1927
1928     class_info[no_classes].object_number = class_number;
1929     class_info[no_classes].symbol = current_classname_symbol;
1930     class_info[no_classes].begins_at = 0;
1931
1932     initialise_full_object();
1933
1934     /*  Give the class the (nameless in Inform syntax) "inheritance" property
1935         with value its own class number.  (This therefore accumulates onto
1936         the inheritance property of any object inheriting from the class,
1937         since property 2 is always set to "additive" -- see below)           */
1938
1939     if (!glulx_mode) {
1940       full_object.symbol = current_classname_symbol;
1941       full_object.l = 1;
1942       full_object.pp[0].num = 2;
1943       full_object.pp[0].l = 1;
1944       INITAOTV(&full_object.pp[0].ao[0], LONG_CONSTANT_OT, no_objects + 1);
1945       full_object.pp[0].ao[0].marker = OBJECT_MV;
1946     }
1947     else {
1948       full_object_g.symbol = current_classname_symbol;
1949       full_object_g.numprops = 1;
1950       ensure_memory_list_available(&full_object_g.props_memlist, 1);
1951       full_object_g.props[0].num = 2;
1952       full_object_g.props[0].flags = 0;
1953       full_object_g.props[0].datastart = 0;
1954       full_object_g.props[0].continuation = 0;
1955       full_object_g.props[0].datalen = 1;
1956       full_object_g.propdatasize = 1;
1957       ensure_memory_list_available(&full_object_g.propdata_memlist, 1);
1958       INITAOTV(&full_object_g.propdata[0], CONSTANT_OT, no_objects + 1);
1959       full_object_g.propdata[0].marker = OBJECT_MV;
1960     }
1961
1962     if (!metaclass_flag)
1963     {   get_next_token();
1964         if ((token_type == SEP_TT) && (token_value == OPENB_SEP))
1965         {   assembly_operand AO;
1966             AO = parse_expression(CONSTANT_CONTEXT);
1967             if (AO.marker != 0)
1968             {   error("Duplicate-number not known at compile time");
1969                 n=0;
1970             }
1971             else
1972                 n = AO.value;
1973             if ((n<0) || (n>10000))
1974             {   error("The number of duplicates must be 0 to 10000");
1975                 n=0;
1976             }
1977
1978             /*  Make one extra duplicate, since the veneer routines need
1979                 always to keep an undamaged prototype for the class in stock */
1980
1981             duplicates_to_make = n + 1;
1982
1983             match_close_bracket();
1984         } else put_token_back();
1985
1986         /*  Parse the body of the definition:                                */
1987
1988         parse_body_of_definition();
1989     }
1990
1991     if (debugfile_switch)
1992     {   debug_file_printf("<class>");
1993         debug_file_printf("<identifier>%s</identifier>", shortname_buffer);
1994         debug_file_printf("<class-number>%d</class-number>", no_classes);
1995         debug_file_printf("<value>");
1996         write_debug_object_backpatch(no_objects + 1);
1997         debug_file_printf("</value>");
1998         write_debug_locations
1999             (get_token_location_end(beginning_debug_location));
2000         debug_file_printf("</class>");
2001     }
2002
2003     if (!glulx_mode)
2004       manufacture_object_z();
2005     else
2006       manufacture_object_g();
2007
2008     if (individual_prop_table_size >= VENEER_CONSTRAINT_ON_IP_TABLE_SIZE)
2009         error("This class is too complex: it now carries too many properties. \
2010 You may be able to get round this by declaring some of its property names as \
2011 \"common properties\" using the 'Property' directive.");
2012
2013     if (duplicates_to_make > 0)
2014     {
2015         int namelen = strlen(shortname_buffer);
2016         char *duplicate_name = my_malloc(namelen+16, "temporary storage for object duplicate names");
2017         strcpy(duplicate_name, shortname_buffer);
2018         for (n=1; (duplicates_to_make--) > 0; n++)
2019         {
2020             sprintf(duplicate_name+namelen, "_%d", n);
2021             make_object(FALSE, duplicate_name, class_number, class_number, -1);
2022         }
2023         my_free(&duplicate_name, "temporary storage for object duplicate names");
2024     }
2025
2026     /* Finished building the class. */
2027     current_classname_symbol = 0;
2028 }
2029
2030 /* ------------------------------------------------------------------------- */
2031 /*   Object/Nearby directives:                                               */
2032 /*                                                                           */
2033 /*       Object  <name-1> ... <name-n> "short name"  [parent]  <body of def> */
2034 /*                                                                           */
2035 /*       Nearby  <name-1> ... <name-n> "short name"  <body of definition>    */
2036 /* ------------------------------------------------------------------------- */
2037
2038 static int end_of_header(void)
2039 {   if (((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
2040         || ((token_type == SEP_TT) && (token_value == COMMA_SEP))
2041         || (token_type == SEGMENT_MARKER_TT)) return TRUE;
2042     return FALSE;
2043 }
2044
2045 extern void make_object(int nearby_flag,
2046     char *textual_name, int specified_parent, int specified_class,
2047     int instance_of)
2048 {
2049     /*  Ordinarily this is called with nearby_flag TRUE for "Nearby",
2050         FALSE for "Object"; and textual_name NULL, specified_parent and
2051         specified_class both -1.  The next three arguments are used when
2052         the routine is called for class duplicates manufacture (see above).
2053         The last is used to create instances of a particular class.  */
2054
2055     int i, tree_depth, internal_name_symbol = 0;
2056     debug_location_beginning beginning_debug_location =
2057         get_token_location_beginning();
2058
2059     directives.enabled = FALSE;
2060
2061     ensure_memory_list_available(&current_object_name, 32);
2062     sprintf(current_object_name.data, "nameless_obj__%d", no_objects+1);
2063
2064     current_defn_is_class = FALSE;
2065
2066     no_classes_to_inherit_from=0;
2067
2068     individual_prop_table_size = 0;
2069
2070     if (nearby_flag) tree_depth=1; else tree_depth=0;
2071
2072     if (specified_class != -1) goto HeaderPassed;
2073
2074     get_next_token();
2075
2076     /*  Read past and count a sequence of "->"s, if any are present          */
2077
2078     if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
2079     {   if (nearby_flag)
2080           error("The syntax '->' is only used as an alternative to 'Nearby'");
2081
2082         while ((token_type == SEP_TT) && (token_value == ARROW_SEP))
2083         {   tree_depth++;
2084             get_next_token();
2085         }
2086     }
2087
2088     sprintf(shortname_buffer, "?");
2089
2090     segment_markers.enabled = TRUE;
2091
2092     /*  This first word is either an internal name, or a textual short name,
2093         or the end of the header part                                        */
2094
2095     if (end_of_header()) goto HeaderPassed;
2096
2097     if (token_type == DQ_TT) textual_name = token_text;
2098     else
2099     {   if (token_type != SYMBOL_TT) {
2100             ebf_error("name for new object or its textual short name",
2101                 token_text);
2102         }
2103         else if (!(symbols[token_value].flags & UNKNOWN_SFLAG)) {
2104             ebf_symbol_error("new object", token_text, typename(symbols[token_value].type), symbols[token_value].line);
2105         }
2106         else
2107         {   internal_name_symbol = token_value;
2108             ensure_memory_list_available(&current_object_name, strlen(token_text)+1);
2109             strcpy(current_object_name.data, token_text);
2110         }
2111     }
2112
2113     /*  The next word is either a parent object, or
2114         a textual short name, or the end of the header part                  */
2115
2116     get_next_token_with_directives();
2117     if (end_of_header()) goto HeaderPassed;
2118
2119     if (token_type == DQ_TT)
2120     {   if (textual_name != NULL)
2121             error("Two textual short names given for only one object");
2122         else
2123             textual_name = token_text;
2124     }
2125     else
2126     {   if ((token_type != SYMBOL_TT)
2127             || (symbols[token_value].flags & UNKNOWN_SFLAG))
2128         {   if (textual_name == NULL)
2129                 ebf_error("parent object or the object's textual short name",
2130                     token_text);
2131             else
2132                 ebf_error("parent object", token_text);
2133         }
2134         else goto SpecParent;
2135     }
2136
2137     /*  Finally, it's possible that there is still a parent object           */
2138
2139     get_next_token();
2140     if (end_of_header()) goto HeaderPassed;
2141
2142     if (specified_parent != -1)
2143         ebf_error("body of object definition", token_text);
2144     else
2145     {   SpecParent:
2146         if ((symbols[token_value].type == OBJECT_T)
2147             || (symbols[token_value].type == CLASS_T))
2148         {   specified_parent = symbols[token_value].value;
2149             symbols[token_value].flags |= USED_SFLAG;
2150         }
2151         else ebf_error("name of (the parent) object", token_text);
2152     }
2153
2154     /*  Now it really has to be the body of the definition.                  */
2155
2156     get_next_token_with_directives();
2157     if (end_of_header()) goto HeaderPassed;
2158
2159     ebf_error("body of object definition", token_text);
2160
2161     HeaderPassed:
2162     if (specified_class == -1) put_token_back();
2163
2164     if (internal_name_symbol > 0)
2165         assign_symbol(internal_name_symbol, no_objects + 1, OBJECT_T);
2166
2167     if (textual_name == NULL)
2168     {   if (internal_name_symbol > 0)
2169             sprintf(shortname_buffer, "(%s)",
2170                 symbols[internal_name_symbol].name);
2171         else
2172             sprintf(shortname_buffer, "(%d)", no_objects+1);
2173     }
2174     else
2175     {   if (strlen(textual_name)>765)
2176             error("Short name of object (in quotes) exceeded 765 characters");
2177         strncpy(shortname_buffer, textual_name, 765);
2178     }
2179
2180     if (specified_parent != -1)
2181     {   if (tree_depth > 0)
2182             error("Use of '->' (or 'Nearby') clashes with giving a parent");
2183         parent_of_this_obj = specified_parent;
2184     }
2185     else
2186     {   parent_of_this_obj = 0;
2187         if (tree_depth>0)
2188         {
2189             /*  We have to set the parent object to the most recently defined
2190                 object at level (tree_depth - 1) in the tree.
2191
2192                 A complication is that objects are numbered 1, 2, ... in the
2193                 Z-machine (and in the objects[].parent, etc., fields) but
2194                 0, 1, 2, ... internally (and as indices to object[]).        */
2195
2196             for (i=no_objects-1; i>=0; i--)
2197             {   int j = i, k = 0;
2198
2199                 /*  Metaclass or class objects cannot be '->' parents:  */
2200                 if (i<4)
2201                     continue;
2202
2203                 if (!glulx_mode) {
2204                     if (objectsz[i].parent == 1)
2205                         continue;
2206                     while (objectsz[j].parent != 0)
2207                     {   j = objectsz[j].parent - 1; k++; }
2208                 }
2209                 else {
2210                     if (objectsg[i].parent == 1)
2211                         continue;
2212                     while (objectsg[j].parent != 0)
2213                     {   j = objectsg[j].parent - 1; k++; }
2214                 }
2215
2216                 if (k == tree_depth - 1)
2217                 {   parent_of_this_obj = i+1;
2218                     break;
2219                 }
2220             }
2221             if (parent_of_this_obj == 0)
2222             {   if (tree_depth == 1)
2223     error("'->' (or 'Nearby') fails because there is no previous object");
2224                 else
2225     error("'-> -> ...' fails because no previous object is deep enough");
2226             }
2227         }
2228     }
2229
2230     initialise_full_object();
2231     if (!glulx_mode)
2232         full_object.symbol = internal_name_symbol;
2233     else
2234         full_object_g.symbol = internal_name_symbol;
2235
2236     if (instance_of != -1) add_class_to_inheritance_list(instance_of);
2237
2238     if (specified_class == -1) parse_body_of_definition();
2239     else add_class_to_inheritance_list(specified_class);
2240
2241     if (debugfile_switch)
2242     {   debug_file_printf("<object>");
2243         if (internal_name_symbol > 0)
2244         {   debug_file_printf("<identifier>%s</identifier>",
2245                  current_object_name.data);
2246         } else
2247         {   debug_file_printf
2248                 ("<identifier artificial=\"true\">%s</identifier>",
2249                  current_object_name.data);
2250         }
2251         debug_file_printf("<value>");
2252         write_debug_object_backpatch(no_objects + 1);
2253         debug_file_printf("</value>");
2254         write_debug_locations
2255             (get_token_location_end(beginning_debug_location));
2256         debug_file_printf("</object>");
2257     }
2258
2259     if (!glulx_mode)
2260       manufacture_object_z();
2261     else
2262       manufacture_object_g();
2263 }
2264
2265 /* ========================================================================= */
2266 /*   Data structure management routines                                      */
2267 /* ------------------------------------------------------------------------- */
2268
2269 extern void init_objects_vars(void)
2270 {
2271     properties_table = NULL;
2272     individuals_table = NULL;
2273     commonprops = NULL;
2274
2275     objectsz = NULL;
2276     objectsg = NULL;
2277     objectatts = NULL;
2278     classes_to_inherit_from = NULL;
2279     class_info = NULL;
2280
2281     full_object_g.props = NULL;
2282     full_object_g.propdata = NULL;
2283 }
2284
2285 extern void objects_begin_pass(void)
2286 {
2287     properties_table_size=0;
2288
2289     /* The three predefined common properties: */
2290     /* (Entry 0 is not used.) */
2291
2292     /* "name" */
2293     commonprops[1].default_value = 0;
2294     commonprops[1].is_long = TRUE;
2295     commonprops[1].is_additive = TRUE;
2296
2297     /* class inheritance property */
2298     commonprops[2].default_value = 0;
2299     commonprops[2].is_long = TRUE;
2300     commonprops[2].is_additive = TRUE;
2301
2302     /* instance variables table address */
2303     /* (This property is only meaningful in Z-code; in Glulx its entry is
2304        reserved but never used.) */
2305     commonprops[3].default_value = 0;
2306     commonprops[3].is_long = TRUE;
2307     commonprops[3].is_additive = FALSE;
2308
2309     no_properties = 4;
2310
2311     if (debugfile_switch)
2312     {
2313         /* These two properties are not symbols, so they won't be emitted
2314            by emit_debug_information_for_predefined_symbol(). Do it
2315            manually. */
2316         debug_file_printf("<property>");
2317         debug_file_printf
2318             ("<identifier artificial=\"true\">inheritance class</identifier>");
2319         debug_file_printf("<value>2</value>");
2320         debug_file_printf("</property>");
2321         debug_file_printf("<property>");
2322         debug_file_printf
2323             ("<identifier artificial=\"true\">instance variables table address "
2324              "(Z-code)</identifier>");
2325         debug_file_printf("<value>3</value>");
2326         debug_file_printf("</property>");
2327     }
2328
2329     if (define_INFIX_switch) no_attributes = 1;
2330     else no_attributes = 0;
2331
2332     no_objects = 0;
2333     /* Setting the info for object zero is probably a relic of very old code, but we do it. */
2334     if (!glulx_mode) {
2335         ensure_memory_list_available(&objectsz_memlist, 1);
2336         objectsz[0].parent = 0; objectsz[0].child = 0; objectsz[0].next = 0;
2337         no_individual_properties=72;
2338     }
2339     else {
2340         ensure_memory_list_available(&objectsg_memlist, 1);
2341         objectsg[0].parent = 0; objectsg[0].child = 0; objectsg[0].next = 0;
2342         no_individual_properties = INDIV_PROP_START+8;
2343     }
2344     no_classes = 0;
2345     current_classname_symbol = 0;
2346
2347     no_embedded_routines = 0;
2348
2349     individuals_length=0;
2350 }
2351
2352 extern void objects_allocate_arrays(void)
2353 {
2354     objectsz = NULL;
2355     objectsg = NULL;
2356     objectatts = NULL;
2357
2358     commonprops = my_calloc(sizeof(commonpropinfo), INDIV_PROP_START,
2359                                 "common property info");
2360
2361     initialise_memory_list(&class_info_memlist,
2362         sizeof(classinfo), 64, (void**)&class_info,
2363         "class info");
2364     initialise_memory_list(&classes_to_inherit_from_memlist,
2365         sizeof(int),       64, (void**)&classes_to_inherit_from,
2366         "inherited classes list");
2367
2368     initialise_memory_list(&properties_table_memlist,
2369         sizeof(uchar), 10000, (void**)&properties_table,
2370         "properties table");
2371     initialise_memory_list(&individuals_table_memlist,
2372         sizeof(uchar), 10000, (void**)&individuals_table,
2373         "individual properties table");
2374
2375     defined_this_segment_size = 128;
2376     defined_this_segment  = my_calloc(sizeof(int), defined_this_segment_size,
2377                                 "defined this segment table");
2378
2379     initialise_memory_list(&current_object_name,
2380         sizeof(char), 32, NULL,
2381         "object name currently being defined");
2382     initialise_memory_list(&embedded_function_name,
2383         sizeof(char), 32, NULL,
2384         "temporary storage for inline function name");
2385
2386     if (!glulx_mode) {
2387       initialise_memory_list(&objectsz_memlist,
2388           sizeof(objecttz), 256, (void**)&objectsz,
2389           "z-objects");
2390     }
2391     else {
2392       initialise_memory_list(&objectsg_memlist,
2393           sizeof(objecttg), 256, (void**)&objectsg,
2394           "g-objects");
2395       initialise_memory_list(&objectatts_memlist,
2396           NUM_ATTR_BYTES, 256, (void**)&objectatts,
2397           "g-attributes");
2398       initialise_memory_list(&full_object_g.props_memlist,
2399           sizeof(propg), 64, (void**)&full_object_g.props,
2400           "object property list");
2401       initialise_memory_list(&full_object_g.propdata_memlist,
2402           sizeof(assembly_operand), 1024, (void**)&full_object_g.propdata,
2403           "object property data table");
2404     }
2405 }
2406
2407 extern void objects_free_arrays(void)
2408 {
2409     my_free(&commonprops, "common property info");
2410
2411     deallocate_memory_list(&current_object_name);
2412     deallocate_memory_list(&embedded_function_name);
2413     deallocate_memory_list(&objectsz_memlist);
2414     deallocate_memory_list(&objectsg_memlist);
2415     deallocate_memory_list(&objectatts_memlist);
2416     deallocate_memory_list(&class_info_memlist);
2417     deallocate_memory_list(&classes_to_inherit_from_memlist);
2418
2419     deallocate_memory_list(&properties_table_memlist);
2420     deallocate_memory_list(&individuals_table_memlist);
2421
2422     my_free(&defined_this_segment,"defined this segment table");
2423
2424     if (!glulx_mode) {
2425         deallocate_memory_list(&full_object_g.props_memlist);
2426         deallocate_memory_list(&full_object_g.propdata_memlist);
2427     }
2428
2429 }
2430
2431 /* ========================================================================= */