1 /* ------------------------------------------------------------------------- */
2 /* "objects" : [1] the object-maker, which constructs objects and enters */
3 /* them into the tree, given a low-level specification; */
5 /* [2] the parser of Object/Nearby/Class directives, which */
6 /* checks syntax and translates such directives into */
7 /* specifications for the object-maker. */
9 /* Part of Inform 6.40 */
10 /* copyright (c) Graham Nelson 1993 - 2022 */
12 /* Inform is free software: you can redistribute it and/or modify */
13 /* it under the terms of the GNU General Public License as published by */
14 /* the Free Software Foundation, either version 3 of the License, or */
15 /* (at your option) any later version. */
17 /* Inform is distributed in the hope that it will be useful, */
18 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
19 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
20 /* GNU General Public License for more details. */
22 /* You should have received a copy of the GNU General Public License */
23 /* along with Inform. If not, see https://gnu.org/licenses/ */
25 /* ------------------------------------------------------------------------- */
29 /* ------------------------------------------------------------------------- */
31 /* ------------------------------------------------------------------------- */
33 int no_objects; /* Number of objects made so far */
35 static int no_embedded_routines; /* Used for naming routines which
36 are given as property values: these
37 are called EmbeddedRoutine__1, ... */
39 static fpropt full_object; /* "fpropt" is a typedef for a struct
40 containing an array to hold the
41 attribute and property values of
42 a single object. We only keep one
43 of these, for the current object
44 being made, and compile it into
45 Z-machine tables when each object
46 definition is complete, since
47 sizeof(fpropt) is about 6200 bytes */
48 static fproptg full_object_g; /* Equivalent for Glulx. This object
49 is very small, since the large arrays
50 are allocated dynamically as
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;
58 static memory_list current_object_name; /* The name of the object currently
61 static int current_classname_symbol; /* The symbol index of the class
62 currently being defined.
63 For error-checking and printing
64 names of embedded routines only. */
66 static memory_list embedded_function_name; /* Temporary storage for inline
67 function name in property. */
69 /* ------------------------------------------------------------------------- */
71 /* ------------------------------------------------------------------------- */
72 /* Arrays defined below: */
74 /* classinfo class_info[] Object number and prop offset */
75 /* int classes_to_inherit_from[] The list of classes to inherit */
76 /* from as taken from the current */
77 /* Nearby/Object/Class definition */
78 /* ------------------------------------------------------------------------- */
80 int no_classes; /* Number of class defns made so far */
82 static int current_defn_is_class, /* TRUE if current Nearby/Object/Class
83 defn is in fact a Class definition */
84 no_classes_to_inherit_from; /* Number of classes in the list
85 of classes to inherit in the
86 current Nearby/Object/Class defn */
88 /* ------------------------------------------------------------------------- */
89 /* Making attributes and properties. */
90 /* ------------------------------------------------------------------------- */
92 int no_attributes, /* Number of attributes defined so far */
93 no_properties; /* Number of properties defined so far,
94 plus 1 (properties are numbered from
95 1 and Inform creates "name" and two
96 others itself, so the variable begins
97 the compilation pass set to 4) */
99 /* Print a PROPS trace line. The f flag is 0 for an attribute, 1 for
100 a common property, 2 for an individual property. */
101 static void trace_s(char *name, int32 number, int f)
102 { if (!printprops_switch) return;
104 if (f == 0) stype = "Attr";
105 else if (f == 1) stype = "Prop";
106 else if (f == 2) stype = "Indiv";
107 printf("%-5s %02ld ", stype, (long int) number);
108 if (f != 1) printf(" ");
109 else printf("%s%s",(commonprops[number].is_long)?"L":" ",
110 (commonprops[number].is_additive)?"A":" ");
111 printf(" %s\n", name);
114 extern void make_attribute(void)
116 debug_location_beginning beginning_debug_location =
117 get_token_location_beginning();
120 if (no_attributes==((version_number==3)?32:48))
121 { discard_token_location(beginning_debug_location);
122 if (version_number==3)
123 error("All 32 attributes already declared (compile as Advanced \
124 game to get an extra 16)");
126 error("All 48 attributes already declared");
127 panic_mode_error_recovery();
133 if (no_attributes==NUM_ATTR_BYTES*8) {
134 discard_token_location(beginning_debug_location);
136 "All attributes already declared -- increase NUM_ATTR_BYTES to use \
139 panic_mode_error_recovery();
146 i = token_value; name = token_text;
147 /* We hold onto token_text through the end of this Property directive, which should be okay. */
148 if (token_type != SYMBOL_TT)
149 { discard_token_location(beginning_debug_location);
150 ebf_error("new attribute name", token_text);
151 panic_mode_error_recovery();
155 if (!(symbols[i].flags & UNKNOWN_SFLAG))
156 { discard_token_location(beginning_debug_location);
157 ebf_symbol_error("new attribute name", token_text, typename(symbols[i].type), symbols[i].line);
158 panic_mode_error_recovery();
163 directive_keywords.enabled = TRUE;
165 directive_keywords.enabled = FALSE;
167 if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK))
169 if (!((token_type == SYMBOL_TT)
170 && (symbols[token_value].type == ATTRIBUTE_T)))
171 { discard_token_location(beginning_debug_location);
172 ebf_error("an existing attribute name after 'alias'",
174 panic_mode_error_recovery();
178 assign_symbol(i, symbols[token_value].value, ATTRIBUTE_T);
179 symbols[token_value].flags |= ALIASED_SFLAG;
180 symbols[i].flags |= ALIASED_SFLAG;
183 { assign_symbol(i, no_attributes++, ATTRIBUTE_T);
187 if (debugfile_switch)
188 { debug_file_printf("<attribute>");
189 debug_file_printf("<identifier>%s</identifier>", name);
190 debug_file_printf("<value>%d</value>", symbols[i].value);
191 write_debug_locations(get_token_location_end(beginning_debug_location));
192 debug_file_printf("</attribute>");
195 trace_s(name, symbols[i].value, 0);
200 Property [long] [additive] name
201 Property [long] [additive] name alias oldname
202 Property [long] [additive] name defaultvalue
203 Property [long] individual name
205 extern void make_property(void)
206 { int32 default_value, i;
207 int keywords, prevkeywords;
210 int additive_flag, indiv_flag;
211 debug_location_beginning beginning_debug_location =
212 get_token_location_beginning();
214 /* The next bit is tricky. We want to accept any number of the keywords
215 "long", "additive", "individual" before the property name. But we
216 also want to accept "Property long" -- that's a legitimate
218 The solution is to keep track of which keywords we've seen in
219 a bitmask, and another for one token previous. That way we
220 can back up one token if there's no name visible. */
221 keywords = prevkeywords = 0;
223 { directive_keywords.enabled = TRUE;
225 if ((token_type == DIR_KEYWORD_TT) && (token_value == LONG_DK)) {
226 prevkeywords = keywords;
229 else if ((token_type == DIR_KEYWORD_TT) && (token_value == ADDITIVE_DK)) {
230 prevkeywords = keywords;
233 else if ((token_type == DIR_KEYWORD_TT) && (token_value == INDIVIDUAL_DK)) {
234 prevkeywords = keywords;
242 /* Re-parse the name with keywords turned off. (This allows us to
243 accept a property name like "table".) */
245 directive_keywords.enabled = FALSE;
248 if (token_type != SYMBOL_TT && keywords) {
249 /* This can't be a name. Try putting back the last keyword. */
250 keywords = prevkeywords;
256 additive_flag = indiv_flag = FALSE;
258 obsolete_warning("all properties are now automatically 'long'");
260 additive_flag = TRUE;
264 i = token_value; name = token_text;
265 /* We hold onto token_text through the end of this Property directive, which should be okay. */
266 if (token_type != SYMBOL_TT)
267 { discard_token_location(beginning_debug_location);
268 ebf_error("new property name", token_text);
269 panic_mode_error_recovery();
273 if (!(symbols[i].flags & UNKNOWN_SFLAG))
274 { discard_token_location(beginning_debug_location);
275 ebf_symbol_error("new property name", token_text, typename(symbols[i].type), symbols[i].line);
276 panic_mode_error_recovery();
282 int this_identifier_number;
285 { error("'individual' incompatible with 'additive'");
286 panic_mode_error_recovery();
291 this_identifier_number = no_individual_properties++;
292 assign_symbol(i, this_identifier_number, INDIVIDUAL_PROPERTY_T);
293 if (debugfile_switch) {
294 debug_file_printf("<property>");
296 ("<identifier>%s</identifier>", name);
298 ("<value>%d</value>", this_identifier_number);
299 debug_file_printf("</property>");
301 trace_s(name, symbols[i].value, 2);
305 directive_keywords.enabled = TRUE;
307 directive_keywords.enabled = FALSE;
309 namelen = strlen(name);
310 if (namelen > 3 && strcmp(name+namelen-3, "_to") == 0) {
311 /* Direction common properties "n_to", etc are compared in some
312 libraries. They have STAR_SFLAG to tell us to skip a warning. */
313 symbols[i].flags |= STAR_SFLAG;
316 /* Now we might have "alias" or a default value (but not both). */
318 if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK))
319 { discard_token_location(beginning_debug_location);
321 { error("'alias' incompatible with 'additive'");
322 panic_mode_error_recovery();
327 if (!((token_type == SYMBOL_TT)
328 && (symbols[token_value].type == PROPERTY_T)))
329 { ebf_error("an existing property name after 'alias'",
331 panic_mode_error_recovery();
336 assign_symbol(i, symbols[token_value].value, PROPERTY_T);
337 trace_s(name, symbols[i].value, 1);
338 symbols[token_value].flags |= ALIASED_SFLAG;
339 symbols[i].flags |= ALIASED_SFLAG;
343 /* We now know we're allocating a new common property. Make sure
346 if (no_properties==((version_number==3)?32:64))
347 { discard_token_location(beginning_debug_location);
348 /* The maximum listed here includes "name" but not the
349 unused zero value or the two hidden properties (class
350 inheritance and indiv table). */
351 if (version_number==3)
352 error("All 29 properties already declared (compile as \
353 Advanced game to get 32 more)");
355 error("All 61 properties already declared");
356 panic_mode_error_recovery();
362 if (no_properties==INDIV_PROP_START) {
364 discard_token_location(beginning_debug_location);
366 "All %d properties already declared (increase INDIV_PROP_START to get more)",
369 panic_mode_error_recovery();
378 if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
380 assembly_operand AO = parse_expression(CONSTANT_CONTEXT);
381 default_value = AO.value;
383 backpatch_zmachine(AO.marker, PROP_DEFAULTS_ZA,
384 (no_properties-1) * WORDSIZE);
387 commonprops[no_properties].default_value = default_value;
388 commonprops[no_properties].is_long = TRUE;
389 commonprops[no_properties].is_additive = additive_flag;
391 assign_symbol(i, no_properties++, PROPERTY_T);
393 if (debugfile_switch)
394 { debug_file_printf("<property>");
395 debug_file_printf("<identifier>%s</identifier>", name);
396 debug_file_printf("<value>%d</value>", symbols[i].value);
397 write_debug_locations
398 (get_token_location_end(beginning_debug_location));
399 debug_file_printf("</property>");
402 trace_s(name, symbols[i].value, 1);
405 /* ------------------------------------------------------------------------- */
407 /* ------------------------------------------------------------------------- */
409 commonpropinfo *commonprops; /* Info about common properties
411 INDIV_PROP_START entries) */
413 uchar *properties_table; /* Holds the table of property values
414 (holding one block for each object
415 and coming immediately after the
416 object tree in Z-memory) */
417 memory_list properties_table_memlist;
418 int properties_table_size; /* Number of bytes in this table */
420 /* ------------------------------------------------------------------------- */
421 /* Individual properties */
423 /* Each new i.p. name is given a unique number. These numbers start from */
424 /* 72, since 0 is reserved as a null, 1 to 63 refer to common properties */
425 /* and 64 to 71 are kept for methods of the metaclass Class (for example, */
426 /* 64 is "create"). */
428 /* An object provides individual properties by having property 3 set to a */
429 /* non-zero value, which must be a byte address of a table in the form: */
431 /* <record-1> ... <record-n> 00 00 */
433 /* where a <record> looks like */
435 /* <identifier> <size> <up to 255 bytes of data> */
436 /* or <identifier + 0x8000> */
437 /* ----- 2 bytes ---------- 1 byte <size> number of bytes */
439 /* The <identifier> part is the number allocated to the name of what is */
440 /* being provided. The top bit of this word is set to indicate that */
441 /* although the individual property is being provided, it is provided */
442 /* only privately (so that it is inaccessible except to the object's own */
443 /* embedded routines). */
445 /* In Glulx: i-props are numbered from INDIV_PROP_START+8 up. And all */
446 /* properties, common and individual, are stored in the same table. */
447 /* ------------------------------------------------------------------------- */
449 int no_individual_properties; /* Actually equal to the next
450 identifier number to be allocated,
451 so this is initially 72 even though
452 none have been made yet. */
453 static int individual_prop_table_size; /* Size of the table of individual
454 properties so far for current obj */
455 uchar *individuals_table; /* Table of records, each being the
456 i.p. table for an object */
457 memory_list individuals_table_memlist;
458 int i_m; /* Write mark position in the above */
459 int individuals_length; /* Extent of individuals_table */
461 /* ------------------------------------------------------------------------- */
462 /* Arrays used by this file */
463 /* ------------------------------------------------------------------------- */
465 objecttz *objectsz; /* Allocated to no_objects; Z-code only */
466 memory_list objectsz_memlist;
467 objecttg *objectsg; /* Allocated to no_objects; Glulx only */
468 static memory_list objectsg_memlist;
469 uchar *objectatts; /* Allocated to no_objects; Glulx only */
470 static memory_list objectatts_memlist;
471 static int *classes_to_inherit_from; /* Allocated to no_classes_to_inherit_from */
472 static memory_list classes_to_inherit_from_memlist;
473 classinfo *class_info; /* Allocated up to no_classes */
474 memory_list class_info_memlist;
476 /* ------------------------------------------------------------------------- */
477 /* Tracing for compiler maintenance */
478 /* ------------------------------------------------------------------------- */
480 extern void list_object_tree(void)
482 printf("Object tree:\n");
483 printf("obj name par nxt chl:\n");
484 for (i=0; i<no_objects; i++) {
486 int sym = objectsz[i].symbol;
487 char *symname = ((sym > 0) ? symbols[sym].name : "...");
488 printf("%3d %-32s %3d %3d %3d\n",
490 objectsz[i].parent, objectsz[i].next, objectsz[i].child);
493 int sym = objectsg[i].symbol;
494 char *symname = ((sym > 0) ? symbols[sym].name : "...");
495 printf("%3d %-32s %3d %3d %3d\n",
497 objectsg[i].parent, objectsg[i].next, objectsg[i].child);
502 /* ------------------------------------------------------------------------- */
503 /* Object and class manufacture begins here. */
505 /* These definitions have headers (parsed far, far below) and a series */
506 /* of segments, introduced by keywords and optionally separated by commas. */
507 /* Each segment has its own parsing routine. Note that when errors are */
508 /* detected, parsing continues rather than being abandoned, which assists */
509 /* a little in "error recovery" (i.e. in stopping lots more errors being */
510 /* produced for essentially the same mistake). */
511 /* ------------------------------------------------------------------------- */
513 /* ========================================================================= */
514 /* [1] The object-maker: builds an object from a specification, viz.: */
517 /* shortname_buffer, */
518 /* parent_of_this_obj, */
519 /* current_defn_is_class (flag) */
520 /* classes_to_inherit_from[], no_classes_to_inherit_from, */
521 /* individual_prop_table_size (to date ) */
523 /* For efficiency's sake, the individual properties table has already been */
524 /* created (as far as possible, i.e., all except for inherited individual */
525 /* properties); unless the flag is clear, in which case the actual */
526 /* definition did not specify any individual properties. */
527 /* ========================================================================= */
528 /* Property inheritance from classes. */
529 /* ------------------------------------------------------------------------- */
531 static void property_inheritance_z(void)
533 /* Apply the property inheritance rules to full_object, which should
534 initially be complete (i.e., this routine takes place after the whole
535 Nearby/Object/Class definition has been parsed through).
537 On exit, full_object contains the final state of the properties to
540 int i, j, k, kmax, class, mark,
541 prop_number, prop_length, prop_in_current_defn;
542 uchar *class_prop_block;
546 for (class=0; class<no_classes_to_inherit_from; class++)
549 mark = class_info[classes_to_inherit_from[class] - 1].begins_at;
550 class_prop_block = (properties_table + mark);
552 while (class_prop_block[j]!=0)
553 { if (version_number == 3)
554 { prop_number = class_prop_block[j]%32;
555 prop_length = 1 + class_prop_block[j++]/32;
558 { prop_number = class_prop_block[j]%64;
559 prop_length = 1 + class_prop_block[j++]/64;
561 prop_length = class_prop_block[j++]%64;
564 /* So we now have property number prop_number present in the
565 property block for the class being read: its bytes are
567 class_prop_block[j, ..., j + prop_length - 1]
569 Question now is: is there already a value given in the
570 current definition under this property name? */
572 prop_in_current_defn = FALSE;
574 kmax = full_object.l;
576 fatalerror("More than 64 property entries in an object");
578 for (k=0; k<kmax; k++)
579 if (full_object.pp[k].num == prop_number)
580 { prop_in_current_defn = TRUE;
582 /* (Note that the built-in "name" property is additive) */
584 if ((prop_number==1) || (commonprops[prop_number].is_additive))
586 /* The additive case: we accumulate the class
587 property values onto the end of the full_object
590 for (i=full_object.pp[k].l;
591 i<full_object.pp[k].l+prop_length/2; i++)
593 { error("An additive property has inherited \
594 so many values that the list has overflowed the maximum 32 entries");
597 INITAOTV(&full_object.pp[k].ao[i], LONG_CONSTANT_OT, mark + j);
599 full_object.pp[k].ao[i].marker = INHERIT_MV;
601 full_object.pp[k].l += prop_length/2;
604 /* The ordinary case: the full_object property
605 values simply overrides the class definition,
606 so we skip over the values in the class table */
611 { int y, z, class_block_offset;
613 /* Property 3 holds the address of the table of
614 instance variables, so this is the case where
615 the object already has instance variables in its
616 own table but must inherit some more from the
619 class_block_offset = class_prop_block[j-2]*256
620 + class_prop_block[j-1];
622 z = class_block_offset;
623 while ((individuals_table[z]!=0)||(individuals_table[z+1]!=0))
624 { int already_present = FALSE, l;
625 for (l = full_object.pp[k].ao[0].value; l < i_m;
626 l = l + 3 + individuals_table[l + 2])
627 if (individuals_table[l] == individuals_table[z]
628 && individuals_table[l + 1] == individuals_table[z+1])
629 { already_present = TRUE; break;
631 if (already_present == FALSE)
633 backpatch_zmachine(IDENT_MV,
634 INDIVIDUAL_PROP_ZA, i_m);
635 ensure_memory_list_available(&individuals_table_memlist, i_m+3+individuals_table[z+2]);
636 individuals_table[i_m++] = individuals_table[z];
637 individuals_table[i_m++] = individuals_table[z+1];
638 individuals_table[i_m++] = individuals_table[z+2];
639 for (y=0;y < individuals_table[z+2]/2;y++)
640 { individuals_table[i_m++] = (z+3+y*2)/256;
641 individuals_table[i_m++] = (z+3+y*2)%256;
642 backpatch_zmachine(INHERIT_INDIV_MV,
643 INDIVIDUAL_PROP_ZA, i_m-2);
646 z += individuals_table[z+2] + 3;
648 individuals_length = i_m;
651 /* For efficiency we exit the loop now (this property
652 number has been dealt with) */
657 if (!prop_in_current_defn)
659 /* The case where the class defined a property which wasn't
660 defined at all in full_object: we copy out the data into
661 a new property added to full_object */
665 fatalerror("More than 64 property entries in an object");
666 full_object.pp[k].num = prop_number;
667 full_object.pp[k].l = prop_length/2;
668 for (i=0; i<prop_length/2; i++)
670 INITAOTV(&full_object.pp[k].ao[i], LONG_CONSTANT_OT, mark + j);
672 full_object.pp[k].ao[i].marker = INHERIT_MV;
676 { int y, z, class_block_offset;
678 /* Property 3 holds the address of the table of
679 instance variables, so this is the case where
680 the object had no instance variables of its own
681 but must inherit some more from the class */
683 if (individual_prop_table_size++ == 0)
684 { full_object.pp[k].num = 3;
685 full_object.pp[k].l = 1;
686 INITAOTV(&full_object.pp[k].ao[0], LONG_CONSTANT_OT, individuals_length);
687 full_object.pp[k].ao[0].marker = INDIVPT_MV;
688 i_m = individuals_length;
690 class_block_offset = class_prop_block[j-2]*256
691 + class_prop_block[j-1];
693 z = class_block_offset;
694 while ((individuals_table[z]!=0)||(individuals_table[z+1]!=0))
696 backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
697 ensure_memory_list_available(&individuals_table_memlist, i_m+3+individuals_table[z+2]);
698 individuals_table[i_m++] = individuals_table[z];
699 individuals_table[i_m++] = individuals_table[z+1];
700 individuals_table[i_m++] = individuals_table[z+2];
701 for (y=0;y < individuals_table[z+2]/2;y++)
702 { individuals_table[i_m++] = (z+3+y*2)/256;
703 individuals_table[i_m++] = (z+3+y*2)%256;
704 backpatch_zmachine(INHERIT_INDIV_MV,
705 INDIVIDUAL_PROP_ZA, i_m-2);
707 z += individuals_table[z+2] + 3;
709 individuals_length = i_m;
715 if (individual_prop_table_size > 0)
717 ensure_memory_list_available(&individuals_table_memlist, i_m+2);
719 individuals_table[i_m++] = 0;
720 individuals_table[i_m++] = 0;
721 individuals_length += 2;
725 static void property_inheritance_g(void)
727 /* Apply the property inheritance rules to full_object, which should
728 initially be complete (i.e., this routine takes place after the whole
729 Nearby/Object/Class definition has been parsed through).
731 On exit, full_object contains the final state of the properties to
734 int i, j, k, class, num_props,
735 prop_number, prop_length, prop_flags, prop_in_current_defn;
736 int32 mark, prop_addr;
741 for (class=0; class<no_classes_to_inherit_from; class++) {
742 mark = class_info[classes_to_inherit_from[class] - 1].begins_at;
743 cpb = (properties_table + mark);
744 /* This now points to the compiled property-table for the class.
745 We'll have to go through and decompile it. (For our sins.) */
746 num_props = ReadInt32(cpb);
747 for (j=0; j<num_props; j++) {
749 prop_number = ReadInt16(pe);
751 prop_length = ReadInt16(pe);
753 prop_addr = ReadInt32(pe);
755 prop_flags = ReadInt16(pe);
758 /* So we now have property number prop_number present in the
759 property block for the class being read. Its bytes are
760 cpb[prop_addr ... prop_addr + prop_length - 1]
761 Question now is: is there already a value given in the
762 current definition under this property name? */
764 prop_in_current_defn = FALSE;
766 for (k=0; k<full_object_g.numprops; k++) {
767 if (full_object_g.props[k].num == prop_number) {
768 prop_in_current_defn = TRUE;
773 if (prop_in_current_defn) {
775 || (prop_number < INDIV_PROP_START
776 && commonprops[prop_number].is_additive)) {
777 /* The additive case: we accumulate the class
778 property values onto the end of the full_object
779 properties. Remember that k is still the index number
780 of the first prop-block matching our property number. */
782 if (full_object_g.props[k].continuation == 0) {
783 full_object_g.props[k].continuation = 1;
787 prevcont = full_object_g.props[k].continuation;
788 for (k++; k<full_object_g.numprops; k++) {
789 if (full_object_g.props[k].num == prop_number) {
790 prevcont = full_object_g.props[k].continuation;
794 k = full_object_g.numprops++;
795 ensure_memory_list_available(&full_object_g.props_memlist, k+1);
796 full_object_g.props[k].num = prop_number;
797 full_object_g.props[k].flags = 0;
798 full_object_g.props[k].datastart = full_object_g.propdatasize;
799 full_object_g.props[k].continuation = prevcont+1;
800 full_object_g.props[k].datalen = prop_length;
802 ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize + prop_length);
803 for (i=0; i<prop_length; i++) {
804 int ppos = full_object_g.propdatasize++;
805 INITAOTV(&full_object_g.propdata[ppos], CONSTANT_OT, prop_addr + 4*i);
806 full_object_g.propdata[ppos].marker = INHERIT_MV;
810 /* The ordinary case: the full_object_g property
811 values simply overrides the class definition,
812 so we skip over the values in the class table. */
816 /* The case where the class defined a property which wasn't
817 defined at all in full_object_g: we copy out the data into
818 a new property added to full_object_g. */
819 k = full_object_g.numprops++;
820 ensure_memory_list_available(&full_object_g.props_memlist, k+1);
821 full_object_g.props[k].num = prop_number;
822 full_object_g.props[k].flags = prop_flags;
823 full_object_g.props[k].datastart = full_object_g.propdatasize;
824 full_object_g.props[k].continuation = 0;
825 full_object_g.props[k].datalen = prop_length;
827 ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize + prop_length);
828 for (i=0; i<prop_length; i++) {
829 int ppos = full_object_g.propdatasize++;
830 INITAOTV(&full_object_g.propdata[ppos], CONSTANT_OT, prop_addr + 4*i);
831 full_object_g.propdata[ppos].marker = INHERIT_MV;
840 /* ------------------------------------------------------------------------- */
841 /* Construction of Z-machine-format property blocks. */
842 /* ------------------------------------------------------------------------- */
844 static int write_properties_between(int mark, int from, int to)
845 { int j, k, prop_number;
847 for (prop_number=to; prop_number>=from; prop_number--)
848 { for (j=0; j<full_object.l; j++)
849 { if ((full_object.pp[j].num == prop_number)
850 && (full_object.pp[j].l != 100))
852 int prop_length = 2*full_object.pp[j].l;
853 ensure_memory_list_available(&properties_table_memlist, mark+2+prop_length);
854 if (version_number == 3)
855 properties_table[mark++] = prop_number + (prop_length - 1)*32;
857 { switch(prop_length)
859 properties_table[mark++] = prop_number; break;
861 properties_table[mark++] = prop_number + 0x40; break;
863 properties_table[mark++] = prop_number + 0x80;
864 properties_table[mark++] = prop_length + 0x80; break;
868 for (k=0; k<full_object.pp[j].l; k++)
869 { if (full_object.pp[j].ao[k].marker != 0)
870 backpatch_zmachine(full_object.pp[j].ao[k].marker,
872 properties_table[mark++] = full_object.pp[j].ao[k].value/256;
873 properties_table[mark++] = full_object.pp[j].ao[k].value%256;
879 ensure_memory_list_available(&properties_table_memlist, mark+1);
880 properties_table[mark++]=0;
884 static int write_property_block_z(char *shortname)
886 /* Compile the (now complete) full_object properties into a
887 property-table block at "p" in Inform's memory.
888 "shortname" is the object's short name, if specified; otherwise
891 Return the number of bytes written to the block. */
893 int32 mark = properties_table_size, i;
895 /* printf("Object at %04x\n", mark); */
897 if (shortname != NULL)
899 i = translate_text(510,shortname,STRCTX_OBJNAME);
901 error ("Short name of object exceeded 765 Z-characters");
904 ensure_memory_list_available(&properties_table_memlist, mark+1+i);
905 memcpy(properties_table + mark+1, translated_text, i);
906 properties_table[mark] = i/2;
909 if (current_defn_is_class)
910 { mark = write_properties_between(mark,3,3);
911 ensure_memory_list_available(&properties_table_memlist, mark+6);
913 properties_table[mark++] = full_object.atts[i];
914 ensure_memory_list_available(&class_info_memlist, no_classes+1);
915 class_info[no_classes++].begins_at = mark;
918 mark = write_properties_between(mark, 1, (version_number==3)?31:63);
920 i = mark - properties_table_size;
921 properties_table_size = mark;
926 static int gpropsort(void *ptr1, void *ptr2)
931 if (prop2->num == -1)
933 if (prop1->num == -1)
935 if (prop1->num < prop2->num)
937 if (prop1->num > prop2->num)
940 return (prop1->continuation - prop2->continuation);
943 static int32 write_property_block_g(void)
945 /* Compile the (now complete) full_object properties into a
946 property-table block at "p" in Inform's memory.
947 Return the number of bytes written to the block.
948 In Glulx, the shortname property isn't used here; it's already
949 been compiled into an ordinary string. */
952 int ix, jx, kx, totalprops;
953 int32 mark = properties_table_size;
956 if (current_defn_is_class) {
957 ensure_memory_list_available(&properties_table_memlist, mark+NUM_ATTR_BYTES);
958 for (i=0;i<NUM_ATTR_BYTES;i++)
959 properties_table[mark++] = full_object_g.atts[i];
960 ensure_memory_list_available(&class_info_memlist, no_classes+1);
961 class_info[no_classes++].begins_at = mark;
964 qsort(full_object_g.props, full_object_g.numprops, sizeof(propg),
965 (int (*)(const void *, const void *))(&gpropsort));
967 full_object_g.finalpropaddr = mark;
971 for (ix=0; ix<full_object_g.numprops; ix=jx) {
972 int propnum = full_object_g.props[ix].num;
976 jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
981 /* Write out the number of properties in this table. */
982 ensure_memory_list_available(&properties_table_memlist, mark+4);
983 WriteInt32(properties_table+mark, totalprops);
986 datamark = mark + 10*totalprops;
988 for (ix=0; ix<full_object_g.numprops; ix=jx) {
989 int propnum = full_object_g.props[ix].num;
990 int flags = full_object_g.props[ix].flags;
992 int32 datamarkstart = datamark;
996 jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
998 int32 datastart = full_object_g.props[jx].datastart;
999 ensure_memory_list_available(&properties_table_memlist, datamark+4*full_object_g.props[jx].datalen);
1000 for (kx=0; kx<full_object_g.props[jx].datalen; kx++) {
1001 int32 val = full_object_g.propdata[datastart+kx].value;
1002 WriteInt32(properties_table+datamark, val);
1003 if (full_object_g.propdata[datastart+kx].marker != 0)
1004 backpatch_zmachine(full_object_g.propdata[datastart+kx].marker,
1010 ensure_memory_list_available(&properties_table_memlist, mark+10);
1011 WriteInt16(properties_table+mark, propnum);
1013 WriteInt16(properties_table+mark, totallen);
1015 WriteInt32(properties_table+mark, datamarkstart);
1017 WriteInt16(properties_table+mark, flags);
1023 i = mark - properties_table_size;
1024 properties_table_size = mark;
1028 /* ------------------------------------------------------------------------- */
1029 /* The final stage in Nearby/Object/Class definition processing. */
1030 /* ------------------------------------------------------------------------- */
1032 static void manufacture_object_z(void)
1035 segment_markers.enabled = FALSE;
1036 directives.enabled = TRUE;
1038 ensure_memory_list_available(&objectsz_memlist, no_objects+1);
1040 objectsz[no_objects].symbol = full_object.symbol;
1042 property_inheritance_z();
1044 objectsz[no_objects].parent = parent_of_this_obj;
1045 objectsz[no_objects].next = 0;
1046 objectsz[no_objects].child = 0;
1048 if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fff))
1049 { i = objectsz[parent_of_this_obj-1].child;
1051 objectsz[parent_of_this_obj-1].child = no_objects + 1;
1053 { while(objectsz[i-1].next != 0) i = objectsz[i-1].next;
1054 objectsz[i-1].next = no_objects+1;
1058 /* The properties table consists simply of a sequence of property
1059 blocks, one for each object in order of definition, exactly as
1060 it will appear in the final Z-machine. */
1062 j = write_property_block_z(shortname_buffer);
1064 objectsz[no_objects].propsize = j;
1066 if (current_defn_is_class)
1067 for (i=0;i<6;i++) objectsz[no_objects].atts[i] = 0;
1070 objectsz[no_objects].atts[i] = full_object.atts[i];
1075 static void manufacture_object_g(void)
1078 segment_markers.enabled = FALSE;
1079 directives.enabled = TRUE;
1081 ensure_memory_list_available(&objectsg_memlist, no_objects+1);
1082 ensure_memory_list_available(&objectatts_memlist, no_objects+1);
1084 objectsg[no_objects].symbol = full_object_g.symbol;
1086 property_inheritance_g();
1088 objectsg[no_objects].parent = parent_of_this_obj;
1089 objectsg[no_objects].next = 0;
1090 objectsg[no_objects].child = 0;
1092 if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fffffff))
1093 { i = objectsg[parent_of_this_obj-1].child;
1095 objectsg[parent_of_this_obj-1].child = no_objects + 1;
1097 { while(objectsg[i-1].next != 0) i = objectsg[i-1].next;
1098 objectsg[i-1].next = no_objects+1;
1102 objectsg[no_objects].shortname = compile_string(shortname_buffer,
1105 /* The properties table consists simply of a sequence of property
1106 blocks, one for each object in order of definition, exactly as
1107 it will appear in the final machine image. */
1109 j = write_property_block_g();
1111 objectsg[no_objects].propaddr = full_object_g.finalpropaddr;
1113 objectsg[no_objects].propsize = j;
1115 if (current_defn_is_class)
1116 for (i=0;i<NUM_ATTR_BYTES;i++)
1117 objectatts[no_objects*NUM_ATTR_BYTES+i] = 0;
1119 for (i=0;i<NUM_ATTR_BYTES;i++)
1120 objectatts[no_objects*NUM_ATTR_BYTES+i] = full_object_g.atts[i];
1126 /* ========================================================================= */
1127 /* [2] The Object/Nearby/Class directives parser: translating the syntax */
1128 /* into object specifications and then triggering off the above. */
1129 /* ========================================================================= */
1130 /* Properties ("with" or "private") segment. */
1131 /* ------------------------------------------------------------------------- */
1133 static int *defined_this_segment;
1134 static long defined_this_segment_size; /* calloc size */
1137 static void ensure_defined_this_segment(int newsize)
1139 int oldsize = defined_this_segment_size;
1140 defined_this_segment_size = newsize;
1141 my_recalloc(&defined_this_segment, sizeof(int), oldsize,
1142 defined_this_segment_size, "defined this segment table");
1145 static void properties_segment_z(int this_segment)
1147 /* Parse through the "with" part of an object/class definition:
1149 <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
1151 This routine also handles "private", with this_segment being equal
1152 to the token value for the introductory word ("private" or "with"). */
1155 int i, property_name_symbol, property_number=0, next_prop=0, length,
1156 individual_property, this_identifier_number;
1159 { get_next_token_with_directives();
1160 if ((token_type == SEGMENT_MARKER_TT)
1161 || (token_type == EOF_TT)
1162 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1163 { put_token_back(); return;
1166 if (token_type != SYMBOL_TT)
1167 { ebf_error("property name", token_text);
1171 individual_property = (symbols[token_value].type != PROPERTY_T);
1173 if (individual_property)
1174 { if (symbols[token_value].flags & UNKNOWN_SFLAG)
1175 { this_identifier_number = no_individual_properties++;
1176 assign_symbol(token_value, this_identifier_number,
1177 INDIVIDUAL_PROPERTY_T);
1179 if (debugfile_switch)
1180 { debug_file_printf("<property>");
1182 ("<identifier>%s</identifier>", token_text);
1184 ("<value>%d</value>", this_identifier_number);
1185 debug_file_printf("</property>");
1188 trace_s(token_text, symbols[token_value].value, 2);
1191 { if (symbols[token_value].type==INDIVIDUAL_PROPERTY_T)
1192 this_identifier_number = symbols[token_value].value;
1194 { ebf_symbol_error("property name", token_text, typename(symbols[token_value].type), symbols[token_value].line);
1199 if (def_t_s >= defined_this_segment_size)
1200 ensure_defined_this_segment(def_t_s*2);
1201 defined_this_segment[def_t_s++] = token_value;
1203 if (individual_prop_table_size++ == 0)
1205 int k=full_object.l++;
1207 fatalerror("More than 64 property entries in an object");
1208 full_object.pp[k].num = 3;
1209 full_object.pp[k].l = 1;
1210 INITAOTV(&full_object.pp[k].ao[0], LONG_CONSTANT_OT, individuals_length);
1211 full_object.pp[k].ao[0].marker = INDIVPT_MV;
1213 i_m = individuals_length;
1215 ensure_memory_list_available(&individuals_table_memlist, i_m+3);
1216 individuals_table[i_m] = this_identifier_number/256;
1217 if (this_segment == PRIVATE_SEGMENT)
1218 individuals_table[i_m] |= 0x80;
1219 individuals_table[i_m+1] = this_identifier_number%256;
1221 backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
1222 individuals_table[i_m+2] = 0;
1225 { if (symbols[token_value].flags & UNKNOWN_SFLAG)
1226 { error_named("No such property name as", token_text);
1229 if (this_segment == PRIVATE_SEGMENT)
1230 error_named("Property should be declared in 'with', \
1231 not 'private':", token_text);
1232 if (def_t_s >= defined_this_segment_size)
1233 ensure_defined_this_segment(def_t_s*2);
1234 defined_this_segment[def_t_s++] = token_value;
1235 property_number = symbols[token_value].value;
1237 next_prop=full_object.l++;
1238 if (next_prop >= 64)
1239 fatalerror("More than 64 property entries in an object");
1240 full_object.pp[next_prop].num = property_number;
1243 for (i=0; i<(def_t_s-1); i++)
1244 if (defined_this_segment[i] == token_value)
1245 { error_named("Property given twice in the same declaration:",
1246 symbols[token_value].name);
1249 if (symbols[defined_this_segment[i]].value == symbols[token_value].value)
1250 { char error_b[128+2*MAX_IDENTIFIER_LENGTH];
1252 "Property given twice in the same declaration, because \
1253 the names '%s' and '%s' actually refer to the same property",
1254 symbols[defined_this_segment[i]].name,
1255 symbols[token_value].name);
1259 property_name_symbol = token_value;
1260 symbols[token_value].flags |= USED_SFLAG;
1264 { assembly_operand AO;
1265 get_next_token_with_directives();
1266 if ((token_type == EOF_TT)
1267 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1268 || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1271 if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1273 if ((!individual_property) && (property_number==1)
1274 && ((token_type != SQ_TT) || (strlen(token_text) <2 ))
1275 && (token_type != DQ_TT)
1277 warning ("'name' property should only contain dictionary words");
1279 if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1281 char *prefix, *sep, *sym;
1282 sym = symbols[property_name_symbol].name;
1283 if (current_defn_is_class)
1285 prefix = symbols[current_classname_symbol].name;
1290 prefix = current_object_name.data;
1293 ensure_memory_list_available(&embedded_function_name, strlen(prefix)+strlen(sep)+strlen(sym)+1);
1294 sprintf(embedded_function_name.data, "%s%s%s", prefix, sep, sym);
1296 /* parse_routine() releases lexer text! */
1297 AO.value = parse_routine(NULL, TRUE, embedded_function_name.data, FALSE, -1);
1298 AO.type = LONG_CONSTANT_OT;
1299 AO.marker = IROUTINE_MV;
1301 directives.enabled = FALSE;
1302 segment_markers.enabled = TRUE;
1304 statements.enabled = FALSE;
1305 misc_keywords.enabled = FALSE;
1306 local_variables.enabled = FALSE;
1307 system_functions.enabled = FALSE;
1308 conditions.enabled = FALSE;
1312 /* A special rule applies to values in double-quotes of the
1313 built-in property "name", which always has number 1: such
1314 property values are dictionary entries and not static
1317 if ((!individual_property) &&
1318 (property_number==1) && (token_type == DQ_TT))
1319 { AO.value = dictionary_add(token_text, 0x80, 0, 0);
1320 AO.type = LONG_CONSTANT_OT;
1321 AO.marker = DWORD_MV;
1326 if ((token_type == SYMBOL_TT)
1327 && (symbols[token_value].type==PROPERTY_T))
1329 /* This is not necessarily an error: it's possible
1330 to imagine a property whose value is a list
1331 of other properties to look up, but far more
1332 likely that a comma has been omitted in between
1333 two property blocks */
1336 "Missing ','? Property data seems to contain the property name",
1341 /* An ordinary value, then: */
1344 AO = parse_expression(ARRAY_CONTEXT);
1348 { error_named("Limit (of 32 values) exceeded for property",
1349 symbols[property_name_symbol].name);
1353 if (individual_property)
1354 { if (AO.marker != 0)
1355 backpatch_zmachine(AO.marker, INDIVIDUAL_PROP_ZA,
1357 ensure_memory_list_available(&individuals_table_memlist, i_m+3+length+2);
1358 individuals_table[i_m+3+length++] = AO.value/256;
1359 individuals_table[i_m+3+length++] = AO.value%256;
1362 { full_object.pp[next_prop].ao[length/2] = AO;
1363 length = length + 2;
1368 /* People rarely do, but it is legal to declare a property without
1371 with name "fish", number, time_left;
1373 in which case the properties "number" and "time_left" are
1374 created as in effect variables and initialised to zero. */
1377 { if (individual_property)
1379 ensure_memory_list_available(&individuals_table_memlist, i_m+3+length+2);
1380 individuals_table[i_m+3+length++] = 0;
1381 individuals_table[i_m+3+length++] = 0;
1385 INITAOTV(&full_object.pp[next_prop].ao[0], LONG_CONSTANT_OT, 0);
1390 if ((version_number==3) && (!individual_property))
1393 warning_named("Version 3 limit of 4 values per property exceeded \
1394 (use -v5 to get 32), so truncating property",
1395 symbols[property_name_symbol].name);
1400 if (individual_property)
1402 ensure_memory_list_available(&individuals_table_memlist, individuals_length+length+3);
1403 individuals_table[i_m + 2] = length;
1404 individuals_length += length+3;
1405 i_m = individuals_length;
1408 full_object.pp[next_prop].l = length/2;
1410 if ((token_type == EOF_TT)
1411 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1412 { put_token_back(); return;
1419 static void properties_segment_g(int this_segment)
1421 /* Parse through the "with" part of an object/class definition:
1423 <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
1425 This routine also handles "private", with this_segment being equal
1426 to the token value for the introductory word ("private" or "with"). */
1430 individual_property, this_identifier_number;
1431 int32 property_name_symbol, property_number, length;
1434 { get_next_token_with_directives();
1435 if ((token_type == SEGMENT_MARKER_TT)
1436 || (token_type == EOF_TT)
1437 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1438 { put_token_back(); return;
1441 if (token_type != SYMBOL_TT)
1442 { ebf_error("property name", token_text);
1446 individual_property = (symbols[token_value].type != PROPERTY_T);
1448 if (individual_property)
1449 { if (symbols[token_value].flags & UNKNOWN_SFLAG)
1450 { this_identifier_number = no_individual_properties++;
1451 assign_symbol(token_value, this_identifier_number,
1452 INDIVIDUAL_PROPERTY_T);
1454 if (debugfile_switch)
1455 { debug_file_printf("<property>");
1457 ("<identifier>%s</identifier>", token_text);
1459 ("<value>%d</value>", this_identifier_number);
1460 debug_file_printf("</property>");
1463 trace_s(token_text, symbols[token_value].value, 2);
1466 { if (symbols[token_value].type==INDIVIDUAL_PROPERTY_T)
1467 this_identifier_number = symbols[token_value].value;
1469 { ebf_symbol_error("property name", token_text, typename(symbols[token_value].type), symbols[token_value].line);
1474 if (def_t_s >= defined_this_segment_size)
1475 ensure_defined_this_segment(def_t_s*2);
1476 defined_this_segment[def_t_s++] = token_value;
1477 property_number = symbols[token_value].value;
1479 next_prop=full_object_g.numprops++;
1480 ensure_memory_list_available(&full_object_g.props_memlist, next_prop+1);
1481 full_object_g.props[next_prop].num = property_number;
1482 full_object_g.props[next_prop].flags =
1483 ((this_segment == PRIVATE_SEGMENT) ? 1 : 0);
1484 full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1485 full_object_g.props[next_prop].continuation = 0;
1486 full_object_g.props[next_prop].datalen = 0;
1489 { if (symbols[token_value].flags & UNKNOWN_SFLAG)
1490 { error_named("No such property name as", token_text);
1493 if (this_segment == PRIVATE_SEGMENT)
1494 error_named("Property should be declared in 'with', \
1495 not 'private':", token_text);
1497 if (def_t_s >= defined_this_segment_size)
1498 ensure_defined_this_segment(def_t_s*2);
1499 defined_this_segment[def_t_s++] = token_value;
1500 property_number = symbols[token_value].value;
1502 next_prop=full_object_g.numprops++;
1503 ensure_memory_list_available(&full_object_g.props_memlist, next_prop+1);
1504 full_object_g.props[next_prop].num = property_number;
1505 full_object_g.props[next_prop].flags = 0;
1506 full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1507 full_object_g.props[next_prop].continuation = 0;
1508 full_object_g.props[next_prop].datalen = 0;
1511 for (i=0; i<(def_t_s-1); i++)
1512 if (defined_this_segment[i] == token_value)
1513 { error_named("Property given twice in the same declaration:",
1514 symbols[token_value].name);
1517 if (symbols[defined_this_segment[i]].value == symbols[token_value].value)
1518 { char error_b[128+2*MAX_IDENTIFIER_LENGTH];
1520 "Property given twice in the same declaration, because \
1521 the names '%s' and '%s' actually refer to the same property",
1522 symbols[defined_this_segment[i]].name,
1523 symbols[token_value].name);
1527 property_name_symbol = token_value;
1528 symbols[token_value].flags |= USED_SFLAG;
1532 { assembly_operand AO;
1533 get_next_token_with_directives();
1534 if ((token_type == EOF_TT)
1535 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1536 || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1539 if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1541 if ((!individual_property) && (property_number==1)
1542 && ((token_type != SQ_TT) || (strlen(token_text) <2 ))
1543 && (token_type != DQ_TT)
1545 warning ("'name' property should only contain dictionary words");
1547 if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1549 char *prefix, *sep, *sym;
1550 sym = symbols[property_name_symbol].name;
1551 if (current_defn_is_class)
1553 prefix = symbols[current_classname_symbol].name;
1558 prefix = current_object_name.data;
1561 ensure_memory_list_available(&embedded_function_name, strlen(prefix)+strlen(sep)+strlen(sym)+1);
1562 sprintf(embedded_function_name.data, "%s%s%s", prefix, sep, sym);
1564 INITAOT(&AO, CONSTANT_OT);
1565 /* parse_routine() releases lexer text! */
1566 AO.value = parse_routine(NULL, TRUE, embedded_function_name.data, FALSE, -1);
1567 AO.marker = IROUTINE_MV;
1569 directives.enabled = FALSE;
1570 segment_markers.enabled = TRUE;
1572 statements.enabled = FALSE;
1573 misc_keywords.enabled = FALSE;
1574 local_variables.enabled = FALSE;
1575 system_functions.enabled = FALSE;
1576 conditions.enabled = FALSE;
1580 /* A special rule applies to values in double-quotes of the
1581 built-in property "name", which always has number 1: such
1582 property values are dictionary entries and not static
1585 if ((!individual_property) &&
1586 (property_number==1) && (token_type == DQ_TT))
1587 { AO.value = dictionary_add(token_text, 0x80, 0, 0);
1588 AO.type = CONSTANT_OT;
1589 AO.marker = DWORD_MV;
1594 if ((token_type == SYMBOL_TT)
1595 && (symbols[token_value].type==PROPERTY_T))
1597 /* This is not necessarily an error: it's possible
1598 to imagine a property whose value is a list
1599 of other properties to look up, but far more
1600 likely that a comma has been omitted in between
1601 two property blocks */
1604 "Missing ','? Property data seems to contain the property name",
1609 /* An ordinary value, then: */
1612 AO = parse_expression(ARRAY_CONTEXT);
1615 if (length == 32768) /* VENEER_CONSTRAINT_ON_PROP_TABLE_SIZE? */
1616 { error_named("Limit (of 32768 values) exceeded for property",
1617 symbols[property_name_symbol].name);
1621 ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize+1);
1623 full_object_g.propdata[full_object_g.propdatasize++] = AO;
1628 /* People rarely do, but it is legal to declare a property without
1631 with name "fish", number, time_left;
1633 in which case the properties "number" and "time_left" are
1634 created as in effect variables and initialised to zero. */
1638 assembly_operand AO;
1639 INITAOTV(&AO, CONSTANT_OT, 0);
1640 ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize+1);
1641 full_object_g.propdata[full_object_g.propdatasize++] = AO;
1645 full_object_g.props[next_prop].datalen = length;
1647 if ((token_type == EOF_TT)
1648 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1649 { put_token_back(); return;
1655 static void properties_segment(int this_segment)
1658 properties_segment_z(this_segment);
1660 properties_segment_g(this_segment);
1663 /* ------------------------------------------------------------------------- */
1664 /* Attributes ("has") segment. */
1665 /* ------------------------------------------------------------------------- */
1667 static void attributes_segment(void)
1669 /* Parse through the "has" part of an object/class definition:
1671 [~]<attribute-1> [~]<attribute-2> ... [~]<attribute-n> */
1673 int attribute_number, truth_state, bitmask;
1676 { truth_state = TRUE;
1680 get_next_token_with_directives();
1681 if ((token_type == SEGMENT_MARKER_TT)
1682 || (token_type == EOF_TT)
1683 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1685 ebf_error("attribute name after '~'", token_text);
1686 put_token_back(); return;
1688 if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1690 if ((token_type == SEP_TT) && (token_value == ARTNOT_SEP))
1691 { truth_state = !truth_state; goto ParseAttrN;
1694 if ((token_type != SYMBOL_TT)
1695 || (symbols[token_value].type != ATTRIBUTE_T))
1696 { ebf_error("name of an already-declared attribute", token_text);
1700 attribute_number = symbols[token_value].value;
1701 symbols[token_value].flags |= USED_SFLAG;
1704 bitmask = (1 << (7-attribute_number%8));
1705 attrbyte = &(full_object.atts[attribute_number/8]);
1708 /* In Glulx, my prejudices rule, and therefore bits are numbered
1709 from least to most significant. This is the opposite of the
1710 way the Z-machine works. */
1711 bitmask = (1 << (attribute_number%8));
1712 attrbyte = &(full_object_g.atts[attribute_number/8]);
1716 *attrbyte |= bitmask; /* Set attribute bit */
1718 *attrbyte &= ~bitmask; /* Clear attribute bit */
1723 /* ------------------------------------------------------------------------- */
1724 /* Classes ("class") segment. */
1725 /* ------------------------------------------------------------------------- */
1727 static void add_class_to_inheritance_list(int class_number)
1731 /* The class number is actually the class's object number, which needs
1732 to be translated into its actual class number: */
1734 for (i=0;i<no_classes;i++)
1735 if (class_number == class_info[i].object_number)
1736 { class_number = i+1;
1740 /* Remember the inheritance list so that property inheritance can
1741 be sorted out later on, when the definition has been finished: */
1743 ensure_memory_list_available(&classes_to_inherit_from_memlist, no_classes_to_inherit_from+1);
1745 classes_to_inherit_from[no_classes_to_inherit_from++] = class_number;
1747 /* Inheriting attributes from the class at once: */
1752 |= properties_table[class_info[class_number-1].begins_at - 6 + i];
1755 for (i=0; i<NUM_ATTR_BYTES; i++)
1756 full_object_g.atts[i]
1757 |= properties_table[class_info[class_number-1].begins_at
1758 - NUM_ATTR_BYTES + i];
1762 static void classes_segment(void)
1764 /* Parse through the "class" part of an object/class definition:
1766 <class-1> ... <class-n> */
1769 { get_next_token_with_directives();
1770 if ((token_type == SEGMENT_MARKER_TT)
1771 || (token_type == EOF_TT)
1772 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1773 { put_token_back(); return;
1775 if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1777 if ((token_type != SYMBOL_TT)
1778 || (symbols[token_value].type != CLASS_T))
1779 { ebf_error("name of an already-declared class", token_text);
1782 if (current_defn_is_class && token_value == current_classname_symbol)
1783 { error("A class cannot inherit from itself");
1787 symbols[token_value].flags |= USED_SFLAG;
1788 add_class_to_inheritance_list(symbols[token_value].value);
1792 /* ------------------------------------------------------------------------- */
1793 /* Parse the body of a Nearby/Object/Class definition. */
1794 /* ------------------------------------------------------------------------- */
1796 static void parse_body_of_definition(void)
1797 { int commas_in_row;
1802 { commas_in_row = -1;
1804 { get_next_token_with_directives(); commas_in_row++;
1805 } while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
1807 if (commas_in_row>1)
1808 error("Two commas ',' in a row in object/class definition");
1810 if ((token_type == EOF_TT)
1811 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1812 { if (commas_in_row > 0)
1813 error("Object/class definition finishes with ','");
1814 if (token_type == EOF_TT)
1815 error("Object/class definition incomplete (no ';') at end of file");
1819 if (token_type != SEGMENT_MARKER_TT)
1820 { error_named("Expected 'with', 'has' or 'class' in \
1821 object/class definition but found", token_text);
1826 { case WITH_SEGMENT:
1827 properties_segment(WITH_SEGMENT);
1829 case PRIVATE_SEGMENT:
1830 properties_segment(PRIVATE_SEGMENT);
1833 attributes_segment();
1844 /* ------------------------------------------------------------------------- */
1845 /* Class directives: */
1847 /* Class <name> <body of definition> */
1848 /* ------------------------------------------------------------------------- */
1850 static void initialise_full_object(void)
1854 full_object.symbol = 0;
1856 full_object.atts[0] = 0;
1857 full_object.atts[1] = 0;
1858 full_object.atts[2] = 0;
1859 full_object.atts[3] = 0;
1860 full_object.atts[4] = 0;
1861 full_object.atts[5] = 0;
1864 full_object_g.symbol = 0;
1865 full_object_g.numprops = 0;
1866 full_object_g.propdatasize = 0;
1867 for (i=0; i<NUM_ATTR_BYTES; i++)
1868 full_object_g.atts[i] = 0;
1872 extern void make_class(char * metaclass_name)
1873 { int n, duplicates_to_make = 0, class_number = no_objects+1,
1874 metaclass_flag = (metaclass_name != NULL);
1875 debug_location_beginning beginning_debug_location =
1876 get_token_location_beginning();
1878 current_defn_is_class = TRUE; no_classes_to_inherit_from = 0;
1879 individual_prop_table_size = 0;
1881 ensure_memory_list_available(&class_info_memlist, no_classes+1);
1883 if (no_classes==VENEER_CONSTRAINT_ON_CLASSES)
1884 fatalerror("Inform's maximum possible number of classes (whatever \
1885 amount of memory is allocated) has been reached. If this causes serious \
1886 inconvenience, please contact the maintainers.");
1888 directives.enabled = FALSE;
1891 { token_text = metaclass_name;
1892 token_value = symbol_index(token_text, -1);
1893 token_type = SYMBOL_TT;
1897 if (token_type != SYMBOL_TT)
1898 { discard_token_location(beginning_debug_location);
1899 ebf_error("new class name", token_text);
1900 panic_mode_error_recovery();
1903 if (!(symbols[token_value].flags & UNKNOWN_SFLAG))
1904 { discard_token_location(beginning_debug_location);
1905 ebf_symbol_error("new class name", token_text, typename(symbols[token_value].type), symbols[token_value].line);
1906 panic_mode_error_recovery();
1911 /* Each class also creates a modest object representing itself: */
1913 strcpy(shortname_buffer, token_text);
1915 assign_symbol(token_value, class_number, CLASS_T);
1916 current_classname_symbol = token_value;
1919 if (metaclass_flag) symbols[token_value].flags |= SYSTEM_SFLAG;
1922 /* In Glulx, metaclasses have to be backpatched too! So we can't
1923 mark it as "system", but we should mark it "used". */
1924 if (metaclass_flag) symbols[token_value].flags |= USED_SFLAG;
1927 /* "Class" (object 1) has no parent, whereas all other classes are
1928 the children of "Class". Since "Class" is not present in a module,
1929 a special value is used which is corrected to 1 by the linker. */
1931 if (metaclass_flag) parent_of_this_obj = 0;
1932 else parent_of_this_obj = (module_switch)?MAXINTWORD:1;
1934 class_info[no_classes].object_number = class_number;
1935 class_info[no_classes].symbol = current_classname_symbol;
1936 class_info[no_classes].begins_at = 0;
1938 initialise_full_object();
1940 /* Give the class the (nameless in Inform syntax) "inheritance" property
1941 with value its own class number. (This therefore accumulates onto
1942 the inheritance property of any object inheriting from the class,
1943 since property 2 is always set to "additive" -- see below) */
1946 full_object.symbol = current_classname_symbol;
1948 full_object.pp[0].num = 2;
1949 full_object.pp[0].l = 1;
1950 INITAOTV(&full_object.pp[0].ao[0], LONG_CONSTANT_OT, no_objects + 1);
1951 full_object.pp[0].ao[0].marker = OBJECT_MV;
1954 full_object_g.symbol = current_classname_symbol;
1955 full_object_g.numprops = 1;
1956 ensure_memory_list_available(&full_object_g.props_memlist, 1);
1957 full_object_g.props[0].num = 2;
1958 full_object_g.props[0].flags = 0;
1959 full_object_g.props[0].datastart = 0;
1960 full_object_g.props[0].continuation = 0;
1961 full_object_g.props[0].datalen = 1;
1962 full_object_g.propdatasize = 1;
1963 ensure_memory_list_available(&full_object_g.propdata_memlist, 1);
1964 INITAOTV(&full_object_g.propdata[0], CONSTANT_OT, no_objects + 1);
1965 full_object_g.propdata[0].marker = OBJECT_MV;
1968 if (!metaclass_flag)
1970 if ((token_type == SEP_TT) && (token_value == OPENB_SEP))
1971 { assembly_operand AO;
1972 AO = parse_expression(CONSTANT_CONTEXT);
1974 { error("Duplicate-number not known at compile time");
1979 if ((n<0) || (n>10000))
1980 { error("The number of duplicates must be 0 to 10000");
1984 /* Make one extra duplicate, since the veneer routines need
1985 always to keep an undamaged prototype for the class in stock */
1987 duplicates_to_make = n + 1;
1989 match_close_bracket();
1990 } else put_token_back();
1992 /* Parse the body of the definition: */
1994 parse_body_of_definition();
1997 if (debugfile_switch)
1998 { debug_file_printf("<class>");
1999 debug_file_printf("<identifier>%s</identifier>", shortname_buffer);
2000 debug_file_printf("<class-number>%d</class-number>", no_classes);
2001 debug_file_printf("<value>");
2002 write_debug_object_backpatch(no_objects + 1);
2003 debug_file_printf("</value>");
2004 write_debug_locations
2005 (get_token_location_end(beginning_debug_location));
2006 debug_file_printf("</class>");
2010 manufacture_object_z();
2012 manufacture_object_g();
2014 if (individual_prop_table_size >= VENEER_CONSTRAINT_ON_IP_TABLE_SIZE)
2015 error("This class is too complex: it now carries too many properties. \
2016 You may be able to get round this by declaring some of its property names as \
2017 \"common properties\" using the 'Property' directive.");
2019 if (duplicates_to_make > 0)
2021 int namelen = strlen(shortname_buffer);
2022 char *duplicate_name = my_malloc(namelen+16, "temporary storage for object duplicate names");
2023 strcpy(duplicate_name, shortname_buffer);
2024 for (n=1; (duplicates_to_make--) > 0; n++)
2026 sprintf(duplicate_name+namelen, "_%d", n);
2027 make_object(FALSE, duplicate_name, class_number, class_number, -1);
2029 my_free(&duplicate_name, "temporary storage for object duplicate names");
2032 /* Finished building the class. */
2033 current_classname_symbol = 0;
2036 /* ------------------------------------------------------------------------- */
2037 /* Object/Nearby directives: */
2039 /* Object <name-1> ... <name-n> "short name" [parent] <body of def> */
2041 /* Nearby <name-1> ... <name-n> "short name" <body of definition> */
2042 /* ------------------------------------------------------------------------- */
2044 static int end_of_header(void)
2045 { if (((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
2046 || ((token_type == SEP_TT) && (token_value == COMMA_SEP))
2047 || (token_type == SEGMENT_MARKER_TT)) return TRUE;
2051 extern void make_object(int nearby_flag,
2052 char *textual_name, int specified_parent, int specified_class,
2055 /* Ordinarily this is called with nearby_flag TRUE for "Nearby",
2056 FALSE for "Object"; and textual_name NULL, specified_parent and
2057 specified_class both -1. The next three arguments are used when
2058 the routine is called for class duplicates manufacture (see above).
2059 The last is used to create instances of a particular class. */
2061 int i, tree_depth, internal_name_symbol = 0;
2062 debug_location_beginning beginning_debug_location =
2063 get_token_location_beginning();
2065 directives.enabled = FALSE;
2067 ensure_memory_list_available(¤t_object_name, 32);
2068 sprintf(current_object_name.data, "nameless_obj__%d", no_objects+1);
2070 current_defn_is_class = FALSE;
2072 no_classes_to_inherit_from=0;
2074 individual_prop_table_size = 0;
2076 if (nearby_flag) tree_depth=1; else tree_depth=0;
2078 if (specified_class != -1) goto HeaderPassed;
2082 /* Read past and count a sequence of "->"s, if any are present */
2084 if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
2086 error("The syntax '->' is only used as an alternative to 'Nearby'");
2088 while ((token_type == SEP_TT) && (token_value == ARROW_SEP))
2094 sprintf(shortname_buffer, "?");
2096 segment_markers.enabled = TRUE;
2098 /* This first word is either an internal name, or a textual short name,
2099 or the end of the header part */
2101 if (end_of_header()) goto HeaderPassed;
2103 if (token_type == DQ_TT) textual_name = token_text;
2105 { if (token_type != SYMBOL_TT) {
2106 ebf_error("name for new object or its textual short name",
2109 else if (!(symbols[token_value].flags & UNKNOWN_SFLAG)) {
2110 ebf_symbol_error("new object", token_text, typename(symbols[token_value].type), symbols[token_value].line);
2113 { internal_name_symbol = token_value;
2114 ensure_memory_list_available(¤t_object_name, strlen(token_text)+1);
2115 strcpy(current_object_name.data, token_text);
2119 /* The next word is either a parent object, or
2120 a textual short name, or the end of the header part */
2122 get_next_token_with_directives();
2123 if (end_of_header()) goto HeaderPassed;
2125 if (token_type == DQ_TT)
2126 { if (textual_name != NULL)
2127 error("Two textual short names given for only one object");
2129 textual_name = token_text;
2132 { if ((token_type != SYMBOL_TT)
2133 || (symbols[token_value].flags & UNKNOWN_SFLAG))
2134 { if (textual_name == NULL)
2135 ebf_error("parent object or the object's textual short name",
2138 ebf_error("parent object", token_text);
2140 else goto SpecParent;
2143 /* Finally, it's possible that there is still a parent object */
2146 if (end_of_header()) goto HeaderPassed;
2148 if (specified_parent != -1)
2149 ebf_error("body of object definition", token_text);
2152 if ((symbols[token_value].type == OBJECT_T)
2153 || (symbols[token_value].type == CLASS_T))
2154 { specified_parent = symbols[token_value].value;
2155 symbols[token_value].flags |= USED_SFLAG;
2157 else ebf_error("name of (the parent) object", token_text);
2160 /* Now it really has to be the body of the definition. */
2162 get_next_token_with_directives();
2163 if (end_of_header()) goto HeaderPassed;
2165 ebf_error("body of object definition", token_text);
2168 if (specified_class == -1) put_token_back();
2170 if (internal_name_symbol > 0)
2171 assign_symbol(internal_name_symbol, no_objects + 1, OBJECT_T);
2173 if (textual_name == NULL)
2174 { if (internal_name_symbol > 0)
2175 sprintf(shortname_buffer, "(%s)",
2176 symbols[internal_name_symbol].name);
2178 sprintf(shortname_buffer, "(%d)", no_objects+1);
2181 { if (strlen(textual_name)>765)
2182 error("Short name of object (in quotes) exceeded 765 characters");
2183 strncpy(shortname_buffer, textual_name, 765);
2186 if (specified_parent != -1)
2187 { if (tree_depth > 0)
2188 error("Use of '->' (or 'Nearby') clashes with giving a parent");
2189 parent_of_this_obj = specified_parent;
2192 { parent_of_this_obj = 0;
2195 /* We have to set the parent object to the most recently defined
2196 object at level (tree_depth - 1) in the tree.
2198 A complication is that objects are numbered 1, 2, ... in the
2199 Z-machine (and in the objects[].parent, etc., fields) but
2200 0, 1, 2, ... internally (and as indices to object[]). */
2202 for (i=no_objects-1; i>=0; i--)
2205 /* Metaclass or class objects cannot be '->' parents: */
2206 if ((!module_switch) && (i<4))
2210 if (objectsz[i].parent == 1)
2212 while (objectsz[j].parent != 0)
2213 { j = objectsz[j].parent - 1; k++; }
2216 if (objectsg[i].parent == 1)
2218 while (objectsg[j].parent != 0)
2219 { j = objectsg[j].parent - 1; k++; }
2222 if (k == tree_depth - 1)
2223 { parent_of_this_obj = i+1;
2227 if (parent_of_this_obj == 0)
2228 { if (tree_depth == 1)
2229 error("'->' (or 'Nearby') fails because there is no previous object");
2231 error("'-> -> ...' fails because no previous object is deep enough");
2236 initialise_full_object();
2238 full_object.symbol = internal_name_symbol;
2240 full_object_g.symbol = internal_name_symbol;
2242 if (instance_of != -1) add_class_to_inheritance_list(instance_of);
2244 if (specified_class == -1) parse_body_of_definition();
2245 else add_class_to_inheritance_list(specified_class);
2247 if (debugfile_switch)
2248 { debug_file_printf("<object>");
2249 if (internal_name_symbol > 0)
2250 { debug_file_printf("<identifier>%s</identifier>",
2251 current_object_name.data);
2254 ("<identifier artificial=\"true\">%s</identifier>",
2255 current_object_name.data);
2257 debug_file_printf("<value>");
2258 write_debug_object_backpatch(no_objects + 1);
2259 debug_file_printf("</value>");
2260 write_debug_locations
2261 (get_token_location_end(beginning_debug_location));
2262 debug_file_printf("</object>");
2266 manufacture_object_z();
2268 manufacture_object_g();
2271 /* ========================================================================= */
2272 /* Data structure management routines */
2273 /* ------------------------------------------------------------------------- */
2275 extern void init_objects_vars(void)
2277 properties_table = NULL;
2278 individuals_table = NULL;
2284 classes_to_inherit_from = NULL;
2287 full_object_g.props = NULL;
2288 full_object_g.propdata = NULL;
2291 extern void objects_begin_pass(void)
2293 properties_table_size=0;
2295 /* The three predefined common properties: */
2296 /* (Entry 0 is not used.) */
2299 commonprops[1].default_value = 0;
2300 commonprops[1].is_long = TRUE;
2301 commonprops[1].is_additive = TRUE;
2303 /* class inheritance property */
2304 commonprops[2].default_value = 0;
2305 commonprops[2].is_long = TRUE;
2306 commonprops[2].is_additive = TRUE;
2308 /* instance variables table address */
2309 /* (This property is only meaningful in Z-code; in Glulx its entry is
2310 reserved but never used.) */
2311 commonprops[3].default_value = 0;
2312 commonprops[3].is_long = TRUE;
2313 commonprops[3].is_additive = FALSE;
2317 if (debugfile_switch)
2319 /* These two properties are not symbols, so they won't be emitted
2320 by emit_debug_information_for_predefined_symbol(). Do it
2322 debug_file_printf("<property>");
2324 ("<identifier artificial=\"true\">inheritance class</identifier>");
2325 debug_file_printf("<value>2</value>");
2326 debug_file_printf("</property>");
2327 debug_file_printf("<property>");
2329 ("<identifier artificial=\"true\">instance variables table address "
2330 "(Z-code)</identifier>");
2331 debug_file_printf("<value>3</value>");
2332 debug_file_printf("</property>");
2335 if (define_INFIX_switch) no_attributes = 1;
2336 else no_attributes = 0;
2339 /* Setting the info for object zero is probably a relic of very old code, but we do it. */
2341 ensure_memory_list_available(&objectsz_memlist, 1);
2342 objectsz[0].parent = 0; objectsz[0].child = 0; objectsz[0].next = 0;
2343 no_individual_properties=72;
2346 ensure_memory_list_available(&objectsg_memlist, 1);
2347 objectsg[0].parent = 0; objectsg[0].child = 0; objectsg[0].next = 0;
2348 no_individual_properties = INDIV_PROP_START+8;
2351 current_classname_symbol = 0;
2353 no_embedded_routines = 0;
2355 individuals_length=0;
2358 extern void objects_allocate_arrays(void)
2364 commonprops = my_calloc(sizeof(commonpropinfo), INDIV_PROP_START,
2365 "common property info");
2367 initialise_memory_list(&class_info_memlist,
2368 sizeof(classinfo), 64, (void**)&class_info,
2370 initialise_memory_list(&classes_to_inherit_from_memlist,
2371 sizeof(int), 64, (void**)&classes_to_inherit_from,
2372 "inherited classes list");
2374 initialise_memory_list(&properties_table_memlist,
2375 sizeof(uchar), 10000, (void**)&properties_table,
2376 "properties table");
2377 initialise_memory_list(&individuals_table_memlist,
2378 sizeof(uchar), 10000, (void**)&individuals_table,
2379 "individual properties table");
2381 defined_this_segment_size = 128;
2382 defined_this_segment = my_calloc(sizeof(int), defined_this_segment_size,
2383 "defined this segment table");
2385 initialise_memory_list(¤t_object_name,
2386 sizeof(char), 32, NULL,
2387 "object name currently being defined");
2388 initialise_memory_list(&embedded_function_name,
2389 sizeof(char), 32, NULL,
2390 "temporary storage for inline function name");
2393 initialise_memory_list(&objectsz_memlist,
2394 sizeof(objecttz), 256, (void**)&objectsz,
2398 initialise_memory_list(&objectsg_memlist,
2399 sizeof(objecttg), 256, (void**)&objectsg,
2401 initialise_memory_list(&objectatts_memlist,
2402 NUM_ATTR_BYTES, 256, (void**)&objectatts,
2404 initialise_memory_list(&full_object_g.props_memlist,
2405 sizeof(propg), 64, (void**)&full_object_g.props,
2406 "object property list");
2407 initialise_memory_list(&full_object_g.propdata_memlist,
2408 sizeof(assembly_operand), 1024, (void**)&full_object_g.propdata,
2409 "object property data table");
2413 extern void objects_free_arrays(void)
2415 my_free(&commonprops, "common property info");
2417 deallocate_memory_list(¤t_object_name);
2418 deallocate_memory_list(&embedded_function_name);
2419 deallocate_memory_list(&objectsz_memlist);
2420 deallocate_memory_list(&objectsg_memlist);
2421 deallocate_memory_list(&objectatts_memlist);
2422 deallocate_memory_list(&class_info_memlist);
2423 deallocate_memory_list(&classes_to_inherit_from_memlist);
2425 deallocate_memory_list(&properties_table_memlist);
2426 deallocate_memory_list(&individuals_table_memlist);
2428 my_free(&defined_this_segment,"defined this segment table");
2431 deallocate_memory_list(&full_object_g.props_memlist);
2432 deallocate_memory_list(&full_object_g.propdata_memlist);
2437 /* ========================================================================= */