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