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