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