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 - 2021                                 */
  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) || (strlen(token_text) <2 ))
1437                 && (token_type != DQ_TT)
1438                 )
1439                 warning ("'name' property should only contain dictionary words");
1440
1441             if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1442             {   char embedded_name[80];
1443                 if (current_defn_is_class)
1444                 {   sprintf(embedded_name,
1445                         "%s::%s", classname_text,
1446                         (char *) symbs[property_name_symbol]);
1447                 }
1448                 else
1449                 {   sprintf(embedded_name,
1450                         "%s.%s", objectname_text,
1451                         (char *) symbs[property_name_symbol]);
1452                 }
1453                 AO.value = parse_routine(NULL, TRUE, embedded_name, FALSE, -1);
1454                 AO.type = CONSTANT_OT;
1455                 AO.marker = IROUTINE_MV;
1456
1457                 directives.enabled = FALSE;
1458                 segment_markers.enabled = TRUE;
1459
1460                 statements.enabled = FALSE;
1461                 misc_keywords.enabled = FALSE;
1462                 local_variables.enabled = FALSE;
1463                 system_functions.enabled = FALSE;
1464                 conditions.enabled = FALSE;
1465             }
1466             else
1467
1468             /*  A special rule applies to values in double-quotes of the
1469                 built-in property "name", which always has number 1: such
1470                 property values are dictionary entries and not static
1471                 strings                                                      */
1472
1473             if ((!individual_property) &&
1474                 (property_number==1) && (token_type == DQ_TT))
1475             {   AO.value = dictionary_add(token_text, 0x80, 0, 0);
1476                 AO.type = CONSTANT_OT;
1477                 AO.marker = DWORD_MV;
1478             }
1479             else
1480             {   if (length!=0)
1481                 {
1482                     if ((token_type == SYMBOL_TT)
1483                         && (stypes[token_value]==PROPERTY_T))
1484                     {
1485                         /*  This is not necessarily an error: it's possible
1486                             to imagine a property whose value is a list
1487                             of other properties to look up, but far more
1488                             likely that a comma has been omitted in between
1489                             two property blocks                              */
1490
1491                         warning_named(
1492                "Missing ','? Property data seems to contain the property name",
1493                             token_text);
1494                     }
1495                 }
1496
1497                 /*  An ordinary value, then:                                 */
1498
1499                 put_token_back();
1500                 AO = parse_expression(ARRAY_CONTEXT);
1501             }
1502
1503             if (length == 32768) /* VENEER_CONSTRAINT_ON_PROP_TABLE_SIZE? */
1504             {   error_named("Limit (of 32768 values) exceeded for property",
1505                     (char *) symbs[property_name_symbol]);
1506                 break;
1507             }
1508
1509             if (full_object_g.propdatasize >= MAX_OBJ_PROP_TABLE_SIZE) {
1510               memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
1511             }
1512
1513             full_object_g.propdata[full_object_g.propdatasize++] = AO;
1514             length += 1;
1515
1516         } while (TRUE);
1517
1518         /*  People rarely do, but it is legal to declare a property without
1519             a value at all:
1520
1521                 with  name "fish", number, time_left;
1522
1523             in which case the properties "number" and "time_left" are
1524             created as in effect variables and initialised to zero.          */
1525
1526         if (length == 0)
1527         {
1528             assembly_operand AO;
1529             AO.value = 0;
1530             AO.type = CONSTANT_OT;
1531             AO.marker = 0;
1532             full_object_g.propdata[full_object_g.propdatasize++] = AO;
1533             length += 1;
1534         }
1535
1536         full_object_g.props[next_prop].datalen = length;
1537
1538         if ((token_type == EOF_TT)
1539             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1540         {   put_token_back(); return;
1541         }
1542
1543     } while (TRUE);
1544 }
1545
1546 static void properties_segment(int this_segment)
1547 {
1548   if (!glulx_mode)
1549     properties_segment_z(this_segment);
1550   else
1551     properties_segment_g(this_segment);
1552 }
1553
1554 /* ------------------------------------------------------------------------- */
1555 /*   Attributes ("has") segment.                                             */
1556 /* ------------------------------------------------------------------------- */
1557
1558 static void attributes_segment(void)
1559 {
1560     /*  Parse through the "has" part of an object/class definition:
1561
1562         [~]<attribute-1> [~]<attribute-2> ... [~]<attribute-n>               */
1563
1564     int attribute_number, truth_state, bitmask;
1565     uchar *attrbyte;
1566     do
1567     {   truth_state = TRUE;
1568
1569         ParseAttrN:
1570
1571         get_next_token_with_directives();
1572         if ((token_type == SEGMENT_MARKER_TT)
1573             || (token_type == EOF_TT)
1574             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1575         {   if (!truth_state)
1576                 ebf_error("attribute name after '~'", token_text);
1577             put_token_back(); return;
1578         }
1579         if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1580
1581         if ((token_type == SEP_TT) && (token_value == ARTNOT_SEP))
1582         {   truth_state = !truth_state; goto ParseAttrN;
1583         }
1584
1585         if ((token_type != SYMBOL_TT)
1586             || (stypes[token_value] != ATTRIBUTE_T))
1587         {   ebf_error("name of an already-declared attribute", token_text);
1588             return;
1589         }
1590
1591         attribute_number = svals[token_value];
1592         sflags[token_value] |= USED_SFLAG;
1593
1594         if (!glulx_mode) {
1595             bitmask = (1 << (7-attribute_number%8));
1596             attrbyte = &(full_object.atts[attribute_number/8]);
1597         }
1598         else {
1599             /* In Glulx, my prejudices rule, and therefore bits are numbered
1600                from least to most significant. This is the opposite of the
1601                way the Z-machine works. */
1602             bitmask = (1 << (attribute_number%8));
1603             attrbyte = &(full_object_g.atts[attribute_number/8]);
1604         }
1605
1606         if (truth_state)
1607             *attrbyte |= bitmask;     /* Set attribute bit */
1608         else
1609             *attrbyte &= ~bitmask;    /* Clear attribute bit */
1610
1611     } while (TRUE);
1612 }
1613
1614 /* ------------------------------------------------------------------------- */
1615 /*   Classes ("class") segment.                                              */
1616 /* ------------------------------------------------------------------------- */
1617
1618 static void add_class_to_inheritance_list(int class_number)
1619 {
1620     int i;
1621
1622     /*  The class number is actually the class's object number, which needs
1623         to be translated into its actual class number:                       */
1624
1625     for (i=0;i<no_classes;i++)
1626         if (class_number == class_object_numbers[i])
1627         {   class_number = i+1;
1628             break;
1629         }
1630
1631     /*  Remember the inheritance list so that property inheritance can
1632         be sorted out later on, when the definition has been finished:       */
1633
1634     classes_to_inherit_from[no_classes_to_inherit_from++] = class_number;
1635
1636     /*  Inheriting attributes from the class at once:                        */
1637
1638     if (!glulx_mode) {
1639         for (i=0; i<6; i++)
1640             full_object.atts[i]
1641                 |= properties_table[class_begins_at[class_number-1] - 6 + i];
1642     }
1643     else {
1644         for (i=0; i<NUM_ATTR_BYTES; i++)
1645             full_object_g.atts[i]
1646                 |= properties_table[class_begins_at[class_number-1]
1647                     - NUM_ATTR_BYTES + i];
1648     }
1649 }
1650
1651 static void classes_segment(void)
1652 {
1653     /*  Parse through the "class" part of an object/class definition:
1654
1655         <class-1> ... <class-n>                                              */
1656
1657     do
1658     {   get_next_token_with_directives();
1659         if ((token_type == SEGMENT_MARKER_TT)
1660             || (token_type == EOF_TT)
1661             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1662         {   put_token_back(); return;
1663         }
1664         if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1665
1666         if ((token_type != SYMBOL_TT)
1667             || (stypes[token_value] != CLASS_T))
1668         {   ebf_error("name of an already-declared class", token_text);
1669             return;
1670         }
1671
1672         sflags[token_value] |= USED_SFLAG;
1673         add_class_to_inheritance_list(svals[token_value]);
1674     } while (TRUE);
1675 }
1676
1677 /* ------------------------------------------------------------------------- */
1678 /*   Parse the body of a Nearby/Object/Class definition.                     */
1679 /* ------------------------------------------------------------------------- */
1680
1681 static void parse_body_of_definition(void)
1682 {   int commas_in_row;
1683
1684     def_t_s = 0;
1685
1686     do
1687     {   commas_in_row = -1;
1688         do
1689         {   get_next_token_with_directives(); commas_in_row++;
1690         } while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
1691
1692         if (commas_in_row>1)
1693             error("Two commas ',' in a row in object/class definition");
1694
1695         if ((token_type == EOF_TT)
1696             || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1697         {   if (commas_in_row > 0)
1698                 error("Object/class definition finishes with ','");
1699             if (token_type == EOF_TT)
1700                 error("Object/class definition incomplete (no ';') at end of file");
1701             break;
1702         }
1703
1704         if (token_type != SEGMENT_MARKER_TT)
1705         {   error_named("Expected 'with', 'has' or 'class' in \
1706 object/class definition but found", token_text);
1707             break;
1708         }
1709         else
1710         switch(token_value)
1711         {   case WITH_SEGMENT:
1712                 properties_segment(WITH_SEGMENT);
1713                 break;
1714             case PRIVATE_SEGMENT:
1715                 properties_segment(PRIVATE_SEGMENT);
1716                 break;
1717             case HAS_SEGMENT:
1718                 attributes_segment();
1719                 break;
1720             case CLASS_SEGMENT:
1721                 classes_segment();
1722                 break;
1723         }
1724
1725     } while (TRUE);
1726
1727 }
1728
1729 /* ------------------------------------------------------------------------- */
1730 /*   Class directives:                                                       */
1731 /*                                                                           */
1732 /*        Class <name>  <body of definition>                                 */
1733 /* ------------------------------------------------------------------------- */
1734
1735 static void initialise_full_object(void)
1736 {
1737   int i;
1738   if (!glulx_mode) {
1739     full_object.l = 0;
1740     full_object.atts[0] = 0;
1741     full_object.atts[1] = 0;
1742     full_object.atts[2] = 0;
1743     full_object.atts[3] = 0;
1744     full_object.atts[4] = 0;
1745     full_object.atts[5] = 0;
1746   }
1747   else {
1748     full_object_g.numprops = 0;
1749     full_object_g.propdatasize = 0;
1750     for (i=0; i<NUM_ATTR_BYTES; i++)
1751       full_object_g.atts[i] = 0;
1752   }
1753 }
1754
1755 extern void make_class(char * metaclass_name)
1756 {   int n, duplicates_to_make = 0, class_number = no_objects+1,
1757         metaclass_flag = (metaclass_name != NULL);
1758     char duplicate_name[128];
1759     int class_symbol;
1760     debug_location_beginning beginning_debug_location =
1761         get_token_location_beginning();
1762
1763     current_defn_is_class = TRUE; no_classes_to_inherit_from = 0;
1764     individual_prop_table_size = 0;
1765
1766     if (no_classes==MAX_CLASSES)
1767         memoryerror("MAX_CLASSES", MAX_CLASSES);
1768
1769     if (no_classes==VENEER_CONSTRAINT_ON_CLASSES)
1770         fatalerror("Inform's maximum possible number of classes (whatever \
1771 amount of memory is allocated) has been reached. If this causes serious \
1772 inconvenience, please contact the maintainers.");
1773
1774     directives.enabled = FALSE;
1775
1776     if (metaclass_flag)
1777     {   token_text = metaclass_name;
1778         token_value = symbol_index(token_text, -1);
1779         token_type = SYMBOL_TT;
1780     }
1781     else
1782     {   get_next_token();
1783         if (token_type != SYMBOL_TT)
1784         {   discard_token_location(beginning_debug_location);
1785             ebf_error("new class name", token_text);
1786             panic_mode_error_recovery();
1787             return;
1788         }
1789         if (!(sflags[token_value] & UNKNOWN_SFLAG))
1790         {   discard_token_location(beginning_debug_location);
1791             ebf_symbol_error("new class name", token_text, typename(stypes[token_value]), slines[token_value]);
1792             panic_mode_error_recovery();
1793             return;
1794         }
1795     }
1796
1797     /*  Each class also creates a modest object representing itself:         */
1798
1799     strcpy(shortname_buffer, token_text);
1800
1801     assign_symbol(token_value, class_number, CLASS_T);
1802     classname_text = (char *) symbs[token_value];
1803
1804     if (!glulx_mode) {
1805         if (metaclass_flag) sflags[token_value] |= SYSTEM_SFLAG;
1806     }
1807     else {
1808         /*  In Glulx, metaclasses have to be backpatched too! So we can't
1809             mark it as "system", but we should mark it "used". */
1810         if (metaclass_flag) sflags[token_value] |= USED_SFLAG;
1811     }
1812
1813     /*  "Class" (object 1) has no parent, whereas all other classes are
1814         the children of "Class".  Since "Class" is not present in a module,
1815         a special value is used which is corrected to 1 by the linker.       */
1816
1817     if (metaclass_flag) parent_of_this_obj = 0;
1818     else parent_of_this_obj = (module_switch)?MAXINTWORD:1;
1819
1820     class_object_numbers[no_classes] = class_number;
1821
1822     initialise_full_object();
1823
1824     /*  Give the class the (nameless in Inform syntax) "inheritance" property
1825         with value its own class number.  (This therefore accumulates onto
1826         the inheritance property of any object inheriting from the class,
1827         since property 2 is always set to "additive" -- see below)           */
1828
1829     if (!glulx_mode) {
1830       full_object.l = 1;
1831       full_object.pp[0].num = 2;
1832       full_object.pp[0].l = 1;
1833       full_object.pp[0].ao[0].value  = no_objects + 1;
1834       full_object.pp[0].ao[0].type   = LONG_CONSTANT_OT;
1835       full_object.pp[0].ao[0].marker = OBJECT_MV;
1836     }
1837     else {
1838       full_object_g.numprops = 1;
1839       full_object_g.props[0].num = 2;
1840       full_object_g.props[0].flags = 0;
1841       full_object_g.props[0].datastart = 0;
1842       full_object_g.props[0].continuation = 0;
1843       full_object_g.props[0].datalen = 1;
1844       full_object_g.propdatasize = 1;
1845       full_object_g.propdata[0].value  = no_objects + 1;
1846       full_object_g.propdata[0].type   = CONSTANT_OT;
1847       full_object_g.propdata[0].marker = OBJECT_MV;
1848     }
1849
1850     class_symbol = token_value;
1851
1852     if (!metaclass_flag)
1853     {   get_next_token();
1854         if ((token_type == SEP_TT) && (token_value == OPENB_SEP))
1855         {   assembly_operand AO;
1856             AO = parse_expression(CONSTANT_CONTEXT);
1857             if (AO.marker != 0)
1858             {   error("Duplicate-number not known at compile time");
1859                 n=0;
1860             }
1861             else
1862                 n = AO.value;
1863             if ((n<0) || (n>10000))
1864             {   error("The number of duplicates must be 0 to 10000");
1865                 n=0;
1866             }
1867
1868             /*  Make one extra duplicate, since the veneer routines need
1869                 always to keep an undamaged prototype for the class in stock */
1870
1871             duplicates_to_make = n + 1;
1872
1873             match_close_bracket();
1874         } else put_token_back();
1875
1876         /*  Parse the body of the definition:                                */
1877
1878         parse_body_of_definition();
1879     }
1880
1881     if (debugfile_switch)
1882     {   debug_file_printf("<class>");
1883         debug_file_printf("<identifier>%s</identifier>", shortname_buffer);
1884         debug_file_printf("<class-number>%d</class-number>", no_classes);
1885         debug_file_printf("<value>");
1886         write_debug_object_backpatch(no_objects + 1);
1887         debug_file_printf("</value>");
1888         write_debug_locations
1889             (get_token_location_end(beginning_debug_location));
1890         debug_file_printf("</class>");
1891     }
1892
1893     if (!glulx_mode)
1894       manufacture_object_z();
1895     else
1896       manufacture_object_g();
1897
1898     if (individual_prop_table_size >= VENEER_CONSTRAINT_ON_IP_TABLE_SIZE)
1899         error("This class is too complex: it now carries too many properties. \
1900 You may be able to get round this by declaring some of its property names as \
1901 \"common properties\" using the 'Property' directive.");
1902
1903     if (duplicates_to_make > 0)
1904     {   sprintf(duplicate_name, "%s_1", shortname_buffer);
1905         for (n=1; (duplicates_to_make--) > 0; n++)
1906         {   if (n>1)
1907             {   int i = strlen(duplicate_name);
1908                 while (duplicate_name[i] != '_') i--;
1909                 sprintf(duplicate_name+i+1, "%d", n);
1910             }
1911             make_object(FALSE, duplicate_name, class_number, class_number, -1);
1912         }
1913     }
1914 }
1915
1916 /* ------------------------------------------------------------------------- */
1917 /*   Object/Nearby directives:                                               */
1918 /*                                                                           */
1919 /*       Object  <name-1> ... <name-n> "short name"  [parent]  <body of def> */
1920 /*                                                                           */
1921 /*       Nearby  <name-1> ... <name-n> "short name"  <body of definition>    */
1922 /* ------------------------------------------------------------------------- */
1923
1924 static int end_of_header(void)
1925 {   if (((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1926         || ((token_type == SEP_TT) && (token_value == COMMA_SEP))
1927         || (token_type == SEGMENT_MARKER_TT)) return TRUE;
1928     return FALSE;
1929 }
1930
1931 extern void make_object(int nearby_flag,
1932     char *textual_name, int specified_parent, int specified_class,
1933     int instance_of)
1934 {
1935     /*  Ordinarily this is called with nearby_flag TRUE for "Nearby",
1936         FALSE for "Object"; and textual_name NULL, specified_parent and
1937         specified_class both -1.  The next three arguments are used when
1938         the routine is called for class duplicates manufacture (see above).
1939         The last is used to create instances of a particular class.  */
1940
1941     int i, tree_depth, internal_name_symbol = 0;
1942     char internal_name[64];
1943     debug_location_beginning beginning_debug_location =
1944         get_token_location_beginning();
1945
1946     directives.enabled = FALSE;
1947
1948     if (no_objects==MAX_OBJECTS) memoryerror("MAX_OBJECTS", MAX_OBJECTS);
1949
1950     sprintf(internal_name, "nameless_obj__%d", no_objects+1);
1951     objectname_text = internal_name;
1952
1953     current_defn_is_class = FALSE;
1954
1955     no_classes_to_inherit_from=0;
1956
1957     individual_prop_table_size = 0;
1958
1959     if (nearby_flag) tree_depth=1; else tree_depth=0;
1960
1961     if (specified_class != -1) goto HeaderPassed;
1962
1963     get_next_token();
1964
1965     /*  Read past and count a sequence of "->"s, if any are present          */
1966
1967     if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
1968     {   if (nearby_flag)
1969           error("The syntax '->' is only used as an alternative to 'Nearby'");
1970
1971         while ((token_type == SEP_TT) && (token_value == ARROW_SEP))
1972         {   tree_depth++;
1973             get_next_token();
1974         }
1975     }
1976
1977     sprintf(shortname_buffer, "?");
1978
1979     segment_markers.enabled = TRUE;
1980
1981     /*  This first word is either an internal name, or a textual short name,
1982         or the end of the header part                                        */
1983
1984     if (end_of_header()) goto HeaderPassed;
1985
1986     if (token_type == DQ_TT) textual_name = token_text;
1987     else
1988     {   if (token_type != SYMBOL_TT) {
1989             ebf_error("name for new object or its textual short name",
1990                 token_text);
1991         }
1992         else if (!(sflags[token_value] & UNKNOWN_SFLAG)) {
1993             ebf_symbol_error("new object", token_text, typename(stypes[token_value]), slines[token_value]);
1994         }
1995         else
1996         {   internal_name_symbol = token_value;
1997             strcpy(internal_name, token_text);
1998         }
1999     }
2000
2001     /*  The next word is either a parent object, or
2002         a textual short name, or the end of the header part                  */
2003
2004     get_next_token_with_directives();
2005     if (end_of_header()) goto HeaderPassed;
2006
2007     if (token_type == DQ_TT)
2008     {   if (textual_name != NULL)
2009             error("Two textual short names given for only one object");
2010         else
2011             textual_name = token_text;
2012     }
2013     else
2014     {   if ((token_type != SYMBOL_TT)
2015             || (sflags[token_value] & UNKNOWN_SFLAG))
2016         {   if (textual_name == NULL)
2017                 ebf_error("parent object or the object's textual short name",
2018                     token_text);
2019             else
2020                 ebf_error("parent object", token_text);
2021         }
2022         else goto SpecParent;
2023     }
2024
2025     /*  Finally, it's possible that there is still a parent object           */
2026
2027     get_next_token();
2028     if (end_of_header()) goto HeaderPassed;
2029
2030     if (specified_parent != -1)
2031         ebf_error("body of object definition", token_text);
2032     else
2033     {   SpecParent:
2034         if ((stypes[token_value] == OBJECT_T)
2035             || (stypes[token_value] == CLASS_T))
2036         {   specified_parent = svals[token_value];
2037             sflags[token_value] |= USED_SFLAG;
2038         }
2039         else ebf_error("name of (the parent) object", token_text);
2040     }
2041
2042     /*  Now it really has to be the body of the definition.                  */
2043
2044     get_next_token_with_directives();
2045     if (end_of_header()) goto HeaderPassed;
2046
2047     ebf_error("body of object definition", token_text);
2048
2049     HeaderPassed:
2050     if (specified_class == -1) put_token_back();
2051
2052     if (internal_name_symbol > 0)
2053         assign_symbol(internal_name_symbol, no_objects + 1, OBJECT_T);
2054
2055     if (listobjects_switch)
2056         printf("%3d \"%s\"\n", no_objects+1,
2057             (textual_name==NULL)?"(with no short name)":textual_name);
2058     if (textual_name == NULL)
2059     {   if (internal_name_symbol > 0)
2060             sprintf(shortname_buffer, "(%s)",
2061                 (char *) symbs[internal_name_symbol]);
2062         else
2063             sprintf(shortname_buffer, "(%d)", no_objects+1);
2064     }
2065     else
2066     {   if (strlen(textual_name)>765)
2067             error("Short name of object (in quotes) exceeded 765 characters");
2068         strncpy(shortname_buffer, textual_name, 765);
2069     }
2070
2071     if (specified_parent != -1)
2072     {   if (tree_depth > 0)
2073             error("Use of '->' (or 'Nearby') clashes with giving a parent");
2074         parent_of_this_obj = specified_parent;
2075     }
2076     else
2077     {   parent_of_this_obj = 0;
2078         if (tree_depth>0)
2079         {
2080             /*  We have to set the parent object to the most recently defined
2081                 object at level (tree_depth - 1) in the tree.
2082
2083                 A complication is that objects are numbered 1, 2, ... in the
2084                 Z-machine (and in the objects[].parent, etc., fields) but
2085                 0, 1, 2, ... internally (and as indices to object[]).        */
2086
2087             for (i=no_objects-1; i>=0; i--)
2088             {   int j = i, k = 0;
2089
2090                 /*  Metaclass or class objects cannot be '->' parents:  */
2091                 if ((!module_switch) && (i<4))
2092                     continue;
2093
2094                 if (!glulx_mode) {
2095                     if (objectsz[i].parent == 1)
2096                         continue;
2097                     while (objectsz[j].parent != 0)
2098                     {   j = objectsz[j].parent - 1; k++; }
2099                 }
2100                 else {
2101                     if (objectsg[i].parent == 1)
2102                         continue;
2103                     while (objectsg[j].parent != 0)
2104                     {   j = objectsg[j].parent - 1; k++; }
2105                 }
2106
2107                 if (k == tree_depth - 1)
2108                 {   parent_of_this_obj = i+1;
2109                     break;
2110                 }
2111             }
2112             if (parent_of_this_obj == 0)
2113             {   if (tree_depth == 1)
2114     error("'->' (or 'Nearby') fails because there is no previous object");
2115                 else
2116     error("'-> -> ...' fails because no previous object is deep enough");
2117             }
2118         }
2119     }
2120
2121     initialise_full_object();
2122     if (instance_of != -1) add_class_to_inheritance_list(instance_of);
2123
2124     if (specified_class == -1) parse_body_of_definition();
2125     else add_class_to_inheritance_list(specified_class);
2126
2127     if (debugfile_switch)
2128     {   debug_file_printf("<object>");
2129         if (internal_name_symbol > 0)
2130         {   debug_file_printf("<identifier>%s</identifier>", internal_name);
2131         } else
2132         {   debug_file_printf
2133                 ("<identifier artificial=\"true\">%s</identifier>",
2134                  internal_name);
2135         }
2136         debug_file_printf("<value>");
2137         write_debug_object_backpatch(no_objects + 1);
2138         debug_file_printf("</value>");
2139         write_debug_locations
2140             (get_token_location_end(beginning_debug_location));
2141         debug_file_printf("</object>");
2142     }
2143
2144     if (!glulx_mode)
2145       manufacture_object_z();
2146     else
2147       manufacture_object_g();
2148 }
2149
2150 /* ========================================================================= */
2151 /*   Data structure management routines                                      */
2152 /* ------------------------------------------------------------------------- */
2153
2154 extern void init_objects_vars(void)
2155 {
2156     properties_table = NULL;
2157     prop_is_long = NULL;
2158     prop_is_additive = NULL;
2159     prop_default_value = NULL;
2160
2161     objectsz = NULL;
2162     objectsg = NULL;
2163     objectatts = NULL;
2164     classes_to_inherit_from = NULL;
2165     class_begins_at = NULL;
2166 }
2167
2168 extern void objects_begin_pass(void)
2169 {
2170     properties_table_size=0;
2171     prop_is_long[1] = TRUE; prop_is_additive[1] = TRUE;            /* "name" */
2172     prop_is_long[2] = TRUE; prop_is_additive[2] = TRUE;  /* inheritance prop */
2173     if (!glulx_mode)
2174         prop_is_long[3] = TRUE; prop_is_additive[3] = FALSE;
2175                                          /* instance variables table address */
2176     no_properties = 4;
2177
2178     if (debugfile_switch)
2179     {   debug_file_printf("<property>");
2180         debug_file_printf
2181             ("<identifier artificial=\"true\">inheritance class</identifier>");
2182         debug_file_printf("<value>2</value>");
2183         debug_file_printf("</property>");
2184         debug_file_printf("<property>");
2185         debug_file_printf
2186             ("<identifier artificial=\"true\">instance variables table address "
2187              "(Z-code)</identifier>");
2188         debug_file_printf("<value>3</value>");
2189         debug_file_printf("</property>");
2190     }
2191
2192     if (define_INFIX_switch) no_attributes = 1;
2193     else no_attributes = 0;
2194
2195     no_objects = 0;
2196     if (!glulx_mode) {
2197         objectsz[0].parent = 0; objectsz[0].child = 0; objectsz[0].next = 0;
2198         no_individual_properties=72;
2199     }
2200     else {
2201         objectsg[0].parent = 0; objectsg[0].child = 0; objectsg[0].next = 0;
2202         no_individual_properties = INDIV_PROP_START+8;
2203     }
2204     no_classes = 0;
2205
2206     no_embedded_routines = 0;
2207
2208     individuals_length=0;
2209 }
2210
2211 extern void objects_allocate_arrays(void)
2212 {
2213     objectsz = NULL;
2214     objectsg = NULL;
2215     objectatts = NULL;
2216
2217     prop_default_value    = my_calloc(sizeof(int32), INDIV_PROP_START,
2218                                 "property default values");
2219     prop_is_long          = my_calloc(sizeof(int), INDIV_PROP_START,
2220                                 "property-is-long flags");
2221     prop_is_additive      = my_calloc(sizeof(int), INDIV_PROP_START,
2222                                 "property-is-additive flags");
2223
2224     classes_to_inherit_from = my_calloc(sizeof(int), MAX_CLASSES,
2225                                 "inherited classes list");
2226     class_begins_at       = my_calloc(sizeof(int32), MAX_CLASSES,
2227                                 "pointers to classes");
2228     class_object_numbers  = my_calloc(sizeof(int),     MAX_CLASSES,
2229                                 "class object numbers");
2230
2231     properties_table      = my_malloc(MAX_PROP_TABLE_SIZE,"properties table");
2232     individuals_table     = my_malloc(MAX_INDIV_PROP_TABLE_SIZE,
2233                                 "individual properties table");
2234
2235     defined_this_segment_size = 128;
2236     defined_this_segment  = my_calloc(sizeof(int), defined_this_segment_size,
2237                                 "defined this segment table");
2238
2239     if (!glulx_mode) {
2240       objectsz            = my_calloc(sizeof(objecttz), MAX_OBJECTS,
2241                                 "z-objects");
2242     }
2243     else {
2244       objectsg            = my_calloc(sizeof(objecttg), MAX_OBJECTS,
2245                                 "g-objects");
2246       objectatts          = my_calloc(NUM_ATTR_BYTES, MAX_OBJECTS,
2247                                 "g-attributes");
2248       full_object_g.props = my_calloc(sizeof(propg), MAX_OBJ_PROP_COUNT,
2249                               "object property list");
2250       full_object_g.propdata = my_calloc(sizeof(assembly_operand),
2251                                  MAX_OBJ_PROP_TABLE_SIZE,
2252                                  "object property data table");
2253     }
2254 }
2255
2256 extern void objects_free_arrays(void)
2257 {
2258     my_free(&prop_default_value, "property default values");
2259     my_free(&prop_is_long,     "property-is-long flags");
2260     my_free(&prop_is_additive, "property-is-additive flags");
2261
2262     my_free(&objectsz,         "z-objects");
2263     my_free(&objectsg,         "g-objects");
2264     my_free(&objectatts,       "g-attributes");
2265     my_free(&class_object_numbers,"class object numbers");
2266     my_free(&classes_to_inherit_from, "inherited classes list");
2267     my_free(&class_begins_at,  "pointers to classes");
2268
2269     my_free(&properties_table, "properties table");
2270     my_free(&individuals_table,"individual properties table");
2271
2272     my_free(&defined_this_segment,"defined this segment table");
2273
2274     if (!glulx_mode) {
2275         my_free(&full_object_g.props, "object property list");
2276         my_free(&full_object_g.propdata, "object property data table");
2277     }
2278
2279 }
2280
2281 /* ========================================================================= */