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.41 */
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 ensure_memory_list_available(&individuals_table_memlist, i_m+3+individuals_table[z+2]);
634 individuals_table[i_m++] = individuals_table[z];
635 individuals_table[i_m++] = individuals_table[z+1];
636 individuals_table[i_m++] = individuals_table[z+2];
637 for (y=0;y < individuals_table[z+2]/2;y++)
638 { individuals_table[i_m++] = (z+3+y*2)/256;
639 individuals_table[i_m++] = (z+3+y*2)%256;
640 backpatch_zmachine(INHERIT_INDIV_MV,
641 INDIVIDUAL_PROP_ZA, i_m-2);
644 z += individuals_table[z+2] + 3;
646 individuals_length = i_m;
649 /* For efficiency we exit the loop now (this property
650 number has been dealt with) */
655 if (!prop_in_current_defn)
657 /* The case where the class defined a property which wasn't
658 defined at all in full_object: we copy out the data into
659 a new property added to full_object */
663 fatalerror("More than 64 property entries in an object");
664 full_object.pp[k].num = prop_number;
665 full_object.pp[k].l = prop_length/2;
666 for (i=0; i<prop_length/2; i++)
668 INITAOTV(&full_object.pp[k].ao[i], LONG_CONSTANT_OT, mark + j);
670 full_object.pp[k].ao[i].marker = INHERIT_MV;
674 { int y, z, class_block_offset;
676 /* Property 3 holds the address of the table of
677 instance variables, so this is the case where
678 the object had no instance variables of its own
679 but must inherit some more from the class */
681 if (individual_prop_table_size++ == 0)
682 { full_object.pp[k].num = 3;
683 full_object.pp[k].l = 1;
684 INITAOTV(&full_object.pp[k].ao[0], LONG_CONSTANT_OT, individuals_length);
685 full_object.pp[k].ao[0].marker = INDIVPT_MV;
686 i_m = individuals_length;
688 class_block_offset = class_prop_block[j-2]*256
689 + class_prop_block[j-1];
691 z = class_block_offset;
692 while ((individuals_table[z]!=0)||(individuals_table[z+1]!=0))
694 ensure_memory_list_available(&individuals_table_memlist, i_m+3+individuals_table[z+2]);
695 individuals_table[i_m++] = individuals_table[z];
696 individuals_table[i_m++] = individuals_table[z+1];
697 individuals_table[i_m++] = individuals_table[z+2];
698 for (y=0;y < individuals_table[z+2]/2;y++)
699 { individuals_table[i_m++] = (z+3+y*2)/256;
700 individuals_table[i_m++] = (z+3+y*2)%256;
701 backpatch_zmachine(INHERIT_INDIV_MV,
702 INDIVIDUAL_PROP_ZA, i_m-2);
704 z += individuals_table[z+2] + 3;
706 individuals_length = i_m;
712 if (individual_prop_table_size > 0)
714 ensure_memory_list_available(&individuals_table_memlist, i_m+2);
716 individuals_table[i_m++] = 0;
717 individuals_table[i_m++] = 0;
718 individuals_length += 2;
722 static void property_inheritance_g(void)
724 /* Apply the property inheritance rules to full_object, which should
725 initially be complete (i.e., this routine takes place after the whole
726 Nearby/Object/Class definition has been parsed through).
728 On exit, full_object contains the final state of the properties to
731 int i, j, k, class, num_props,
732 prop_number, prop_length, prop_flags, prop_in_current_defn;
733 int32 mark, prop_addr;
738 for (class=0; class<no_classes_to_inherit_from; class++) {
739 mark = class_info[classes_to_inherit_from[class] - 1].begins_at;
740 cpb = (properties_table + mark);
741 /* This now points to the compiled property-table for the class.
742 We'll have to go through and decompile it. (For our sins.) */
743 num_props = ReadInt32(cpb);
744 for (j=0; j<num_props; j++) {
746 prop_number = ReadInt16(pe);
748 prop_length = ReadInt16(pe);
750 prop_addr = ReadInt32(pe);
752 prop_flags = ReadInt16(pe);
755 /* So we now have property number prop_number present in the
756 property block for the class being read. Its bytes are
757 cpb[prop_addr ... prop_addr + prop_length - 1]
758 Question now is: is there already a value given in the
759 current definition under this property name? */
761 prop_in_current_defn = FALSE;
763 for (k=0; k<full_object_g.numprops; k++) {
764 if (full_object_g.props[k].num == prop_number) {
765 prop_in_current_defn = TRUE;
770 if (prop_in_current_defn) {
772 || (prop_number < INDIV_PROP_START
773 && commonprops[prop_number].is_additive)) {
774 /* The additive case: we accumulate the class
775 property values onto the end of the full_object
776 properties. Remember that k is still the index number
777 of the first prop-block matching our property number. */
779 if (full_object_g.props[k].continuation == 0) {
780 full_object_g.props[k].continuation = 1;
784 prevcont = full_object_g.props[k].continuation;
785 for (k++; k<full_object_g.numprops; k++) {
786 if (full_object_g.props[k].num == prop_number) {
787 prevcont = full_object_g.props[k].continuation;
791 k = full_object_g.numprops++;
792 ensure_memory_list_available(&full_object_g.props_memlist, k+1);
793 full_object_g.props[k].num = prop_number;
794 full_object_g.props[k].flags = 0;
795 full_object_g.props[k].datastart = full_object_g.propdatasize;
796 full_object_g.props[k].continuation = prevcont+1;
797 full_object_g.props[k].datalen = prop_length;
799 ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize + prop_length);
800 for (i=0; i<prop_length; i++) {
801 int ppos = full_object_g.propdatasize++;
802 INITAOTV(&full_object_g.propdata[ppos], CONSTANT_OT, prop_addr + 4*i);
803 full_object_g.propdata[ppos].marker = INHERIT_MV;
807 /* The ordinary case: the full_object_g property
808 values simply overrides the class definition,
809 so we skip over the values in the class table. */
813 /* The case where the class defined a property which wasn't
814 defined at all in full_object_g: we copy out the data into
815 a new property added to full_object_g. */
816 k = full_object_g.numprops++;
817 ensure_memory_list_available(&full_object_g.props_memlist, k+1);
818 full_object_g.props[k].num = prop_number;
819 full_object_g.props[k].flags = prop_flags;
820 full_object_g.props[k].datastart = full_object_g.propdatasize;
821 full_object_g.props[k].continuation = 0;
822 full_object_g.props[k].datalen = prop_length;
824 ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize + prop_length);
825 for (i=0; i<prop_length; i++) {
826 int ppos = full_object_g.propdatasize++;
827 INITAOTV(&full_object_g.propdata[ppos], CONSTANT_OT, prop_addr + 4*i);
828 full_object_g.propdata[ppos].marker = INHERIT_MV;
837 /* ------------------------------------------------------------------------- */
838 /* Construction of Z-machine-format property blocks. */
839 /* ------------------------------------------------------------------------- */
841 static int write_properties_between(int mark, int from, int to)
842 { int j, k, prop_number;
844 for (prop_number=to; prop_number>=from; prop_number--)
845 { for (j=0; j<full_object.l; j++)
846 { if ((full_object.pp[j].num == prop_number)
847 && (full_object.pp[j].l != 100))
849 int prop_length = 2*full_object.pp[j].l;
850 ensure_memory_list_available(&properties_table_memlist, mark+2+prop_length);
851 if (version_number == 3)
852 properties_table[mark++] = prop_number + (prop_length - 1)*32;
854 { switch(prop_length)
856 properties_table[mark++] = prop_number; break;
858 properties_table[mark++] = prop_number + 0x40; break;
860 properties_table[mark++] = prop_number + 0x80;
861 properties_table[mark++] = prop_length + 0x80; break;
865 for (k=0; k<full_object.pp[j].l; k++)
866 { if (full_object.pp[j].ao[k].marker != 0)
867 backpatch_zmachine(full_object.pp[j].ao[k].marker,
869 properties_table[mark++] = full_object.pp[j].ao[k].value/256;
870 properties_table[mark++] = full_object.pp[j].ao[k].value%256;
876 ensure_memory_list_available(&properties_table_memlist, mark+1);
877 properties_table[mark++]=0;
881 static int write_property_block_z(char *shortname)
883 /* Compile the (now complete) full_object properties into a
884 property-table block at "p" in Inform's memory.
885 "shortname" is the object's short name, if specified; otherwise
888 Return the number of bytes written to the block. */
890 int32 mark = properties_table_size, i;
892 /* printf("Object at %04x\n", mark); */
894 if (shortname != NULL)
896 i = translate_text(510,shortname,STRCTX_OBJNAME);
898 error ("Short name of object exceeded 765 Z-characters");
901 ensure_memory_list_available(&properties_table_memlist, mark+1+i);
902 memcpy(properties_table + mark+1, translated_text, i);
903 properties_table[mark] = i/2;
906 if (current_defn_is_class)
907 { mark = write_properties_between(mark,3,3);
908 ensure_memory_list_available(&properties_table_memlist, mark+6);
910 properties_table[mark++] = full_object.atts[i];
911 ensure_memory_list_available(&class_info_memlist, no_classes+1);
912 class_info[no_classes++].begins_at = mark;
915 mark = write_properties_between(mark, 1, (version_number==3)?31:63);
917 i = mark - properties_table_size;
918 properties_table_size = mark;
923 static int gpropsort(void *ptr1, void *ptr2)
928 if (prop2->num == -1)
930 if (prop1->num == -1)
932 if (prop1->num < prop2->num)
934 if (prop1->num > prop2->num)
937 return (prop1->continuation - prop2->continuation);
940 static int32 write_property_block_g(void)
942 /* Compile the (now complete) full_object properties into a
943 property-table block at "p" in Inform's memory.
944 Return the number of bytes written to the block.
945 In Glulx, the shortname property isn't used here; it's already
946 been compiled into an ordinary string. */
949 int ix, jx, kx, totalprops;
950 int32 mark = properties_table_size;
953 if (current_defn_is_class) {
954 ensure_memory_list_available(&properties_table_memlist, mark+NUM_ATTR_BYTES);
955 for (i=0;i<NUM_ATTR_BYTES;i++)
956 properties_table[mark++] = full_object_g.atts[i];
957 ensure_memory_list_available(&class_info_memlist, no_classes+1);
958 class_info[no_classes++].begins_at = mark;
961 qsort(full_object_g.props, full_object_g.numprops, sizeof(propg),
962 (int (*)(const void *, const void *))(&gpropsort));
964 full_object_g.finalpropaddr = mark;
968 for (ix=0; ix<full_object_g.numprops; ix=jx) {
969 int propnum = full_object_g.props[ix].num;
973 jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
978 /* Write out the number of properties in this table. */
979 ensure_memory_list_available(&properties_table_memlist, mark+4);
980 WriteInt32(properties_table+mark, totalprops);
983 datamark = mark + 10*totalprops;
985 for (ix=0; ix<full_object_g.numprops; ix=jx) {
986 int propnum = full_object_g.props[ix].num;
987 int flags = full_object_g.props[ix].flags;
989 int32 datamarkstart = datamark;
993 jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
995 int32 datastart = full_object_g.props[jx].datastart;
996 ensure_memory_list_available(&properties_table_memlist, datamark+4*full_object_g.props[jx].datalen);
997 for (kx=0; kx<full_object_g.props[jx].datalen; kx++) {
998 int32 val = full_object_g.propdata[datastart+kx].value;
999 WriteInt32(properties_table+datamark, val);
1000 if (full_object_g.propdata[datastart+kx].marker != 0)
1001 backpatch_zmachine(full_object_g.propdata[datastart+kx].marker,
1007 ensure_memory_list_available(&properties_table_memlist, mark+10);
1008 WriteInt16(properties_table+mark, propnum);
1010 WriteInt16(properties_table+mark, totallen);
1012 WriteInt32(properties_table+mark, datamarkstart);
1014 WriteInt16(properties_table+mark, flags);
1020 i = mark - properties_table_size;
1021 properties_table_size = mark;
1025 /* ------------------------------------------------------------------------- */
1026 /* The final stage in Nearby/Object/Class definition processing. */
1027 /* ------------------------------------------------------------------------- */
1029 static void manufacture_object_z(void)
1032 segment_markers.enabled = FALSE;
1033 directives.enabled = TRUE;
1035 ensure_memory_list_available(&objectsz_memlist, no_objects+1);
1037 objectsz[no_objects].symbol = full_object.symbol;
1039 property_inheritance_z();
1041 objectsz[no_objects].parent = parent_of_this_obj;
1042 objectsz[no_objects].next = 0;
1043 objectsz[no_objects].child = 0;
1045 if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fff))
1046 { i = objectsz[parent_of_this_obj-1].child;
1048 objectsz[parent_of_this_obj-1].child = no_objects + 1;
1050 { while(objectsz[i-1].next != 0) i = objectsz[i-1].next;
1051 objectsz[i-1].next = no_objects+1;
1055 /* The properties table consists simply of a sequence of property
1056 blocks, one for each object in order of definition, exactly as
1057 it will appear in the final Z-machine. */
1059 j = write_property_block_z(shortname_buffer);
1061 objectsz[no_objects].propsize = j;
1063 if (current_defn_is_class)
1064 for (i=0;i<6;i++) objectsz[no_objects].atts[i] = 0;
1067 objectsz[no_objects].atts[i] = full_object.atts[i];
1072 static void manufacture_object_g(void)
1075 segment_markers.enabled = FALSE;
1076 directives.enabled = TRUE;
1078 ensure_memory_list_available(&objectsg_memlist, no_objects+1);
1079 ensure_memory_list_available(&objectatts_memlist, no_objects+1);
1081 objectsg[no_objects].symbol = full_object_g.symbol;
1083 property_inheritance_g();
1085 objectsg[no_objects].parent = parent_of_this_obj;
1086 objectsg[no_objects].next = 0;
1087 objectsg[no_objects].child = 0;
1089 if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fffffff))
1090 { i = objectsg[parent_of_this_obj-1].child;
1092 objectsg[parent_of_this_obj-1].child = no_objects + 1;
1094 { while(objectsg[i-1].next != 0) i = objectsg[i-1].next;
1095 objectsg[i-1].next = no_objects+1;
1099 objectsg[no_objects].shortname = compile_string(shortname_buffer,
1102 /* The properties table consists simply of a sequence of property
1103 blocks, one for each object in order of definition, exactly as
1104 it will appear in the final machine image. */
1106 j = write_property_block_g();
1108 objectsg[no_objects].propaddr = full_object_g.finalpropaddr;
1110 objectsg[no_objects].propsize = j;
1112 if (current_defn_is_class)
1113 for (i=0;i<NUM_ATTR_BYTES;i++)
1114 objectatts[no_objects*NUM_ATTR_BYTES+i] = 0;
1116 for (i=0;i<NUM_ATTR_BYTES;i++)
1117 objectatts[no_objects*NUM_ATTR_BYTES+i] = full_object_g.atts[i];
1123 /* ========================================================================= */
1124 /* [2] The Object/Nearby/Class directives parser: translating the syntax */
1125 /* into object specifications and then triggering off the above. */
1126 /* ========================================================================= */
1127 /* Properties ("with" or "private") segment. */
1128 /* ------------------------------------------------------------------------- */
1130 static int *defined_this_segment;
1131 static long defined_this_segment_size; /* calloc size */
1134 static void ensure_defined_this_segment(int newsize)
1136 int oldsize = defined_this_segment_size;
1137 defined_this_segment_size = newsize;
1138 my_recalloc(&defined_this_segment, sizeof(int), oldsize,
1139 defined_this_segment_size, "defined this segment table");
1142 static void properties_segment_z(int this_segment)
1144 /* Parse through the "with" part of an object/class definition:
1146 <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
1148 This routine also handles "private", with this_segment being equal
1149 to the token value for the introductory word ("private" or "with"). */
1152 int i, property_name_symbol, property_number=0, next_prop=0, length,
1153 individual_property, this_identifier_number;
1156 { get_next_token_with_directives();
1157 if ((token_type == SEGMENT_MARKER_TT)
1158 || (token_type == EOF_TT)
1159 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1160 { put_token_back(); return;
1163 if (token_type != SYMBOL_TT)
1164 { ebf_error("property name", token_text);
1168 individual_property = (symbols[token_value].type != PROPERTY_T);
1170 if (individual_property)
1171 { if (symbols[token_value].flags & UNKNOWN_SFLAG)
1172 { this_identifier_number = no_individual_properties++;
1173 assign_symbol(token_value, this_identifier_number,
1174 INDIVIDUAL_PROPERTY_T);
1176 if (debugfile_switch)
1177 { debug_file_printf("<property>");
1179 ("<identifier>%s</identifier>", token_text);
1181 ("<value>%d</value>", this_identifier_number);
1182 debug_file_printf("</property>");
1185 trace_s(token_text, symbols[token_value].value, 2);
1188 { if (symbols[token_value].type==INDIVIDUAL_PROPERTY_T)
1189 this_identifier_number = symbols[token_value].value;
1191 { ebf_symbol_error("property name", token_text, typename(symbols[token_value].type), symbols[token_value].line);
1196 if (def_t_s >= defined_this_segment_size)
1197 ensure_defined_this_segment(def_t_s*2);
1198 defined_this_segment[def_t_s++] = token_value;
1200 if (individual_prop_table_size++ == 0)
1202 int k=full_object.l++;
1204 fatalerror("More than 64 property entries in an object");
1205 full_object.pp[k].num = 3;
1206 full_object.pp[k].l = 1;
1207 INITAOTV(&full_object.pp[k].ao[0], LONG_CONSTANT_OT, individuals_length);
1208 full_object.pp[k].ao[0].marker = INDIVPT_MV;
1210 i_m = individuals_length;
1212 ensure_memory_list_available(&individuals_table_memlist, i_m+3);
1213 individuals_table[i_m] = this_identifier_number/256;
1214 if (this_segment == PRIVATE_SEGMENT)
1215 individuals_table[i_m] |= 0x80;
1216 individuals_table[i_m+1] = this_identifier_number%256;
1217 individuals_table[i_m+2] = 0;
1220 { if (symbols[token_value].flags & UNKNOWN_SFLAG)
1221 { error_named("No such property name as", token_text);
1224 if (this_segment == PRIVATE_SEGMENT)
1225 error_named("Property should be declared in 'with', \
1226 not 'private':", token_text);
1227 if (def_t_s >= defined_this_segment_size)
1228 ensure_defined_this_segment(def_t_s*2);
1229 defined_this_segment[def_t_s++] = token_value;
1230 property_number = symbols[token_value].value;
1232 next_prop=full_object.l++;
1233 if (next_prop >= 64)
1234 fatalerror("More than 64 property entries in an object");
1235 full_object.pp[next_prop].num = property_number;
1238 for (i=0; i<(def_t_s-1); i++)
1239 if (defined_this_segment[i] == token_value)
1240 { error_named("Property given twice in the same declaration:",
1241 symbols[token_value].name);
1244 if (symbols[defined_this_segment[i]].value == symbols[token_value].value)
1245 { char error_b[128+2*MAX_IDENTIFIER_LENGTH];
1247 "Property given twice in the same declaration, because \
1248 the names '%s' and '%s' actually refer to the same property",
1249 symbols[defined_this_segment[i]].name,
1250 symbols[token_value].name);
1254 property_name_symbol = token_value;
1255 symbols[token_value].flags |= USED_SFLAG;
1259 { assembly_operand AO;
1260 get_next_token_with_directives();
1261 if ((token_type == EOF_TT)
1262 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1263 || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1266 if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1268 if ((!individual_property) && (property_number==1)
1269 && ((token_type != SQ_TT) || (strlen(token_text) <2 ))
1270 && (token_type != DQ_TT)
1272 warning ("'name' property should only contain dictionary words");
1274 if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1276 char *prefix, *sep, *sym;
1277 sym = symbols[property_name_symbol].name;
1278 if (current_defn_is_class)
1280 prefix = symbols[current_classname_symbol].name;
1285 prefix = current_object_name.data;
1288 ensure_memory_list_available(&embedded_function_name, strlen(prefix)+strlen(sep)+strlen(sym)+1);
1289 sprintf(embedded_function_name.data, "%s%s%s", prefix, sep, sym);
1291 /* parse_routine() releases lexer text! */
1292 AO.value = parse_routine(NULL, TRUE, embedded_function_name.data, FALSE, -1);
1293 AO.type = LONG_CONSTANT_OT;
1294 AO.marker = IROUTINE_MV;
1296 directives.enabled = FALSE;
1297 segment_markers.enabled = TRUE;
1299 statements.enabled = FALSE;
1300 misc_keywords.enabled = FALSE;
1301 local_variables.enabled = FALSE;
1302 system_functions.enabled = FALSE;
1303 conditions.enabled = FALSE;
1307 /* A special rule applies to values in double-quotes of the
1308 built-in property "name", which always has number 1: such
1309 property values are dictionary entries and not static
1312 if ((!individual_property) &&
1313 (property_number==1) && (token_type == DQ_TT))
1314 { AO.value = dictionary_add(token_text, 0x80, 0, 0);
1315 AO.type = LONG_CONSTANT_OT;
1316 AO.marker = DWORD_MV;
1321 if ((token_type == SYMBOL_TT)
1322 && (symbols[token_value].type==PROPERTY_T))
1324 /* This is not necessarily an error: it's possible
1325 to imagine a property whose value is a list
1326 of other properties to look up, but far more
1327 likely that a comma has been omitted in between
1328 two property blocks */
1331 "Missing ','? Property data seems to contain the property name",
1336 /* An ordinary value, then: */
1339 AO = parse_expression(ARRAY_CONTEXT);
1343 { error_named("Limit (of 32 values) exceeded for property",
1344 symbols[property_name_symbol].name);
1348 if (individual_property)
1349 { if (AO.marker != 0)
1350 backpatch_zmachine(AO.marker, INDIVIDUAL_PROP_ZA,
1352 ensure_memory_list_available(&individuals_table_memlist, i_m+3+length+2);
1353 individuals_table[i_m+3+length++] = AO.value/256;
1354 individuals_table[i_m+3+length++] = AO.value%256;
1357 { full_object.pp[next_prop].ao[length/2] = AO;
1358 length = length + 2;
1363 /* People rarely do, but it is legal to declare a property without
1366 with name "fish", number, time_left;
1368 in which case the properties "number" and "time_left" are
1369 created as in effect variables and initialised to zero. */
1372 { if (individual_property)
1374 ensure_memory_list_available(&individuals_table_memlist, i_m+3+length+2);
1375 individuals_table[i_m+3+length++] = 0;
1376 individuals_table[i_m+3+length++] = 0;
1380 INITAOTV(&full_object.pp[next_prop].ao[0], LONG_CONSTANT_OT, 0);
1385 if ((version_number==3) && (!individual_property))
1388 warning_named("Version 3 limit of 4 values per property exceeded \
1389 (use -v5 to get 32), so truncating property",
1390 symbols[property_name_symbol].name);
1395 if (individual_property)
1397 ensure_memory_list_available(&individuals_table_memlist, individuals_length+length+3);
1398 individuals_table[i_m + 2] = length;
1399 individuals_length += length+3;
1400 i_m = individuals_length;
1403 full_object.pp[next_prop].l = length/2;
1405 if ((token_type == EOF_TT)
1406 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1407 { put_token_back(); return;
1414 static void properties_segment_g(int this_segment)
1416 /* Parse through the "with" part of an object/class definition:
1418 <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
1420 This routine also handles "private", with this_segment being equal
1421 to the token value for the introductory word ("private" or "with"). */
1425 individual_property, this_identifier_number;
1426 int32 property_name_symbol, property_number, length;
1429 { get_next_token_with_directives();
1430 if ((token_type == SEGMENT_MARKER_TT)
1431 || (token_type == EOF_TT)
1432 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1433 { put_token_back(); return;
1436 if (token_type != SYMBOL_TT)
1437 { ebf_error("property name", token_text);
1441 individual_property = (symbols[token_value].type != PROPERTY_T);
1443 if (individual_property)
1444 { if (symbols[token_value].flags & UNKNOWN_SFLAG)
1445 { this_identifier_number = no_individual_properties++;
1446 assign_symbol(token_value, this_identifier_number,
1447 INDIVIDUAL_PROPERTY_T);
1449 if (debugfile_switch)
1450 { debug_file_printf("<property>");
1452 ("<identifier>%s</identifier>", token_text);
1454 ("<value>%d</value>", this_identifier_number);
1455 debug_file_printf("</property>");
1458 trace_s(token_text, symbols[token_value].value, 2);
1461 { if (symbols[token_value].type==INDIVIDUAL_PROPERTY_T)
1462 this_identifier_number = symbols[token_value].value;
1464 { ebf_symbol_error("property name", token_text, typename(symbols[token_value].type), symbols[token_value].line);
1469 if (def_t_s >= defined_this_segment_size)
1470 ensure_defined_this_segment(def_t_s*2);
1471 defined_this_segment[def_t_s++] = token_value;
1472 property_number = symbols[token_value].value;
1474 next_prop=full_object_g.numprops++;
1475 ensure_memory_list_available(&full_object_g.props_memlist, next_prop+1);
1476 full_object_g.props[next_prop].num = property_number;
1477 full_object_g.props[next_prop].flags =
1478 ((this_segment == PRIVATE_SEGMENT) ? 1 : 0);
1479 full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1480 full_object_g.props[next_prop].continuation = 0;
1481 full_object_g.props[next_prop].datalen = 0;
1484 { if (symbols[token_value].flags & UNKNOWN_SFLAG)
1485 { error_named("No such property name as", token_text);
1488 if (this_segment == PRIVATE_SEGMENT)
1489 error_named("Property should be declared in 'with', \
1490 not 'private':", token_text);
1492 if (def_t_s >= defined_this_segment_size)
1493 ensure_defined_this_segment(def_t_s*2);
1494 defined_this_segment[def_t_s++] = token_value;
1495 property_number = symbols[token_value].value;
1497 next_prop=full_object_g.numprops++;
1498 ensure_memory_list_available(&full_object_g.props_memlist, next_prop+1);
1499 full_object_g.props[next_prop].num = property_number;
1500 full_object_g.props[next_prop].flags = 0;
1501 full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1502 full_object_g.props[next_prop].continuation = 0;
1503 full_object_g.props[next_prop].datalen = 0;
1506 for (i=0; i<(def_t_s-1); i++)
1507 if (defined_this_segment[i] == token_value)
1508 { error_named("Property given twice in the same declaration:",
1509 symbols[token_value].name);
1512 if (symbols[defined_this_segment[i]].value == symbols[token_value].value)
1513 { char error_b[128+2*MAX_IDENTIFIER_LENGTH];
1515 "Property given twice in the same declaration, because \
1516 the names '%s' and '%s' actually refer to the same property",
1517 symbols[defined_this_segment[i]].name,
1518 symbols[token_value].name);
1522 property_name_symbol = token_value;
1523 symbols[token_value].flags |= USED_SFLAG;
1527 { assembly_operand AO;
1528 get_next_token_with_directives();
1529 if ((token_type == EOF_TT)
1530 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1531 || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1534 if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1536 if ((!individual_property) && (property_number==1)
1537 && ((token_type != SQ_TT) || (strlen(token_text) <2 ))
1538 && (token_type != DQ_TT)
1540 warning ("'name' property should only contain dictionary words");
1542 if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1544 char *prefix, *sep, *sym;
1545 sym = symbols[property_name_symbol].name;
1546 if (current_defn_is_class)
1548 prefix = symbols[current_classname_symbol].name;
1553 prefix = current_object_name.data;
1556 ensure_memory_list_available(&embedded_function_name, strlen(prefix)+strlen(sep)+strlen(sym)+1);
1557 sprintf(embedded_function_name.data, "%s%s%s", prefix, sep, sym);
1559 INITAOT(&AO, CONSTANT_OT);
1560 /* parse_routine() releases lexer text! */
1561 AO.value = parse_routine(NULL, TRUE, embedded_function_name.data, FALSE, -1);
1562 AO.marker = IROUTINE_MV;
1564 directives.enabled = FALSE;
1565 segment_markers.enabled = TRUE;
1567 statements.enabled = FALSE;
1568 misc_keywords.enabled = FALSE;
1569 local_variables.enabled = FALSE;
1570 system_functions.enabled = FALSE;
1571 conditions.enabled = FALSE;
1575 /* A special rule applies to values in double-quotes of the
1576 built-in property "name", which always has number 1: such
1577 property values are dictionary entries and not static
1580 if ((!individual_property) &&
1581 (property_number==1) && (token_type == DQ_TT))
1582 { AO.value = dictionary_add(token_text, 0x80, 0, 0);
1583 AO.type = CONSTANT_OT;
1584 AO.marker = DWORD_MV;
1589 if ((token_type == SYMBOL_TT)
1590 && (symbols[token_value].type==PROPERTY_T))
1592 /* This is not necessarily an error: it's possible
1593 to imagine a property whose value is a list
1594 of other properties to look up, but far more
1595 likely that a comma has been omitted in between
1596 two property blocks */
1599 "Missing ','? Property data seems to contain the property name",
1604 /* An ordinary value, then: */
1607 AO = parse_expression(ARRAY_CONTEXT);
1610 if (length == 32768) /* VENEER_CONSTRAINT_ON_PROP_TABLE_SIZE? */
1611 { error_named("Limit (of 32768 values) exceeded for property",
1612 symbols[property_name_symbol].name);
1616 ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize+1);
1618 full_object_g.propdata[full_object_g.propdatasize++] = AO;
1623 /* People rarely do, but it is legal to declare a property without
1626 with name "fish", number, time_left;
1628 in which case the properties "number" and "time_left" are
1629 created as in effect variables and initialised to zero. */
1633 assembly_operand AO;
1634 INITAOTV(&AO, CONSTANT_OT, 0);
1635 ensure_memory_list_available(&full_object_g.propdata_memlist, full_object_g.propdatasize+1);
1636 full_object_g.propdata[full_object_g.propdatasize++] = AO;
1640 full_object_g.props[next_prop].datalen = length;
1642 if ((token_type == EOF_TT)
1643 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1644 { put_token_back(); return;
1650 static void properties_segment(int this_segment)
1653 properties_segment_z(this_segment);
1655 properties_segment_g(this_segment);
1658 /* ------------------------------------------------------------------------- */
1659 /* Attributes ("has") segment. */
1660 /* ------------------------------------------------------------------------- */
1662 static void attributes_segment(void)
1664 /* Parse through the "has" part of an object/class definition:
1666 [~]<attribute-1> [~]<attribute-2> ... [~]<attribute-n> */
1668 int attribute_number, truth_state, bitmask;
1671 { truth_state = TRUE;
1675 get_next_token_with_directives();
1676 if ((token_type == SEGMENT_MARKER_TT)
1677 || (token_type == EOF_TT)
1678 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1680 ebf_error("attribute name after '~'", token_text);
1681 put_token_back(); return;
1683 if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1685 if ((token_type == SEP_TT) && (token_value == ARTNOT_SEP))
1686 { truth_state = !truth_state; goto ParseAttrN;
1689 if ((token_type != SYMBOL_TT)
1690 || (symbols[token_value].type != ATTRIBUTE_T))
1691 { ebf_error("name of an already-declared attribute", token_text);
1695 attribute_number = symbols[token_value].value;
1696 symbols[token_value].flags |= USED_SFLAG;
1699 bitmask = (1 << (7-attribute_number%8));
1700 attrbyte = &(full_object.atts[attribute_number/8]);
1703 /* In Glulx, my prejudices rule, and therefore bits are numbered
1704 from least to most significant. This is the opposite of the
1705 way the Z-machine works. */
1706 bitmask = (1 << (attribute_number%8));
1707 attrbyte = &(full_object_g.atts[attribute_number/8]);
1711 *attrbyte |= bitmask; /* Set attribute bit */
1713 *attrbyte &= ~bitmask; /* Clear attribute bit */
1718 /* ------------------------------------------------------------------------- */
1719 /* Classes ("class") segment. */
1720 /* ------------------------------------------------------------------------- */
1722 static void add_class_to_inheritance_list(int class_number)
1726 /* The class number is actually the class's object number, which needs
1727 to be translated into its actual class number: */
1729 for (i=0;i<no_classes;i++)
1730 if (class_number == class_info[i].object_number)
1731 { class_number = i+1;
1735 /* Remember the inheritance list so that property inheritance can
1736 be sorted out later on, when the definition has been finished: */
1738 ensure_memory_list_available(&classes_to_inherit_from_memlist, no_classes_to_inherit_from+1);
1740 classes_to_inherit_from[no_classes_to_inherit_from++] = class_number;
1742 /* Inheriting attributes from the class at once: */
1747 |= properties_table[class_info[class_number-1].begins_at - 6 + i];
1750 for (i=0; i<NUM_ATTR_BYTES; i++)
1751 full_object_g.atts[i]
1752 |= properties_table[class_info[class_number-1].begins_at
1753 - NUM_ATTR_BYTES + i];
1757 static void classes_segment(void)
1759 /* Parse through the "class" part of an object/class definition:
1761 <class-1> ... <class-n> */
1764 { get_next_token_with_directives();
1765 if ((token_type == SEGMENT_MARKER_TT)
1766 || (token_type == EOF_TT)
1767 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1768 { put_token_back(); return;
1770 if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1772 if ((token_type != SYMBOL_TT)
1773 || (symbols[token_value].type != CLASS_T))
1774 { ebf_error("name of an already-declared class", token_text);
1777 if (current_defn_is_class && token_value == current_classname_symbol)
1778 { error("A class cannot inherit from itself");
1782 symbols[token_value].flags |= USED_SFLAG;
1783 add_class_to_inheritance_list(symbols[token_value].value);
1787 /* ------------------------------------------------------------------------- */
1788 /* Parse the body of a Nearby/Object/Class definition. */
1789 /* ------------------------------------------------------------------------- */
1791 static void parse_body_of_definition(void)
1792 { int commas_in_row;
1797 { commas_in_row = -1;
1799 { get_next_token_with_directives(); commas_in_row++;
1800 } while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
1802 if (commas_in_row>1)
1803 error("Two commas ',' in a row in object/class definition");
1805 if ((token_type == EOF_TT)
1806 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1807 { if (commas_in_row > 0)
1808 error("Object/class definition finishes with ','");
1809 if (token_type == EOF_TT)
1810 error("Object/class definition incomplete (no ';') at end of file");
1814 if (token_type != SEGMENT_MARKER_TT)
1815 { error_named("Expected 'with', 'has' or 'class' in \
1816 object/class definition but found", token_text);
1821 { case WITH_SEGMENT:
1822 properties_segment(WITH_SEGMENT);
1824 case PRIVATE_SEGMENT:
1825 properties_segment(PRIVATE_SEGMENT);
1828 attributes_segment();
1839 /* ------------------------------------------------------------------------- */
1840 /* Class directives: */
1842 /* Class <name> <body of definition> */
1843 /* ------------------------------------------------------------------------- */
1845 static void initialise_full_object(void)
1849 full_object.symbol = 0;
1851 full_object.atts[0] = 0;
1852 full_object.atts[1] = 0;
1853 full_object.atts[2] = 0;
1854 full_object.atts[3] = 0;
1855 full_object.atts[4] = 0;
1856 full_object.atts[5] = 0;
1859 full_object_g.symbol = 0;
1860 full_object_g.numprops = 0;
1861 full_object_g.propdatasize = 0;
1862 for (i=0; i<NUM_ATTR_BYTES; i++)
1863 full_object_g.atts[i] = 0;
1867 extern void make_class(char * metaclass_name)
1868 { int n, duplicates_to_make = 0, class_number = no_objects+1,
1869 metaclass_flag = (metaclass_name != NULL);
1870 debug_location_beginning beginning_debug_location =
1871 get_token_location_beginning();
1873 current_defn_is_class = TRUE; no_classes_to_inherit_from = 0;
1874 individual_prop_table_size = 0;
1876 ensure_memory_list_available(&class_info_memlist, no_classes+1);
1878 if (no_classes==VENEER_CONSTRAINT_ON_CLASSES)
1879 fatalerror("Inform's maximum possible number of classes (whatever \
1880 amount of memory is allocated) has been reached. If this causes serious \
1881 inconvenience, please contact the maintainers.");
1883 directives.enabled = FALSE;
1886 { token_text = metaclass_name;
1887 token_value = symbol_index(token_text, -1);
1888 token_type = SYMBOL_TT;
1892 if (token_type != SYMBOL_TT)
1893 { discard_token_location(beginning_debug_location);
1894 ebf_error("new class name", token_text);
1895 panic_mode_error_recovery();
1898 if (!(symbols[token_value].flags & UNKNOWN_SFLAG))
1899 { discard_token_location(beginning_debug_location);
1900 ebf_symbol_error("new class name", token_text, typename(symbols[token_value].type), symbols[token_value].line);
1901 panic_mode_error_recovery();
1906 /* Each class also creates a modest object representing itself: */
1908 strcpy(shortname_buffer, token_text);
1910 assign_symbol(token_value, class_number, CLASS_T);
1911 current_classname_symbol = token_value;
1914 if (metaclass_flag) symbols[token_value].flags |= SYSTEM_SFLAG;
1917 /* In Glulx, metaclasses have to be backpatched too! So we can't
1918 mark it as "system", but we should mark it "used". */
1919 if (metaclass_flag) symbols[token_value].flags |= USED_SFLAG;
1922 /* "Class" (object 1) has no parent, whereas all other classes are
1923 the children of "Class". */
1925 if (metaclass_flag) parent_of_this_obj = 0;
1926 else parent_of_this_obj = 1;
1928 class_info[no_classes].object_number = class_number;
1929 class_info[no_classes].symbol = current_classname_symbol;
1930 class_info[no_classes].begins_at = 0;
1932 initialise_full_object();
1934 /* Give the class the (nameless in Inform syntax) "inheritance" property
1935 with value its own class number. (This therefore accumulates onto
1936 the inheritance property of any object inheriting from the class,
1937 since property 2 is always set to "additive" -- see below) */
1940 full_object.symbol = current_classname_symbol;
1942 full_object.pp[0].num = 2;
1943 full_object.pp[0].l = 1;
1944 INITAOTV(&full_object.pp[0].ao[0], LONG_CONSTANT_OT, no_objects + 1);
1945 full_object.pp[0].ao[0].marker = OBJECT_MV;
1948 full_object_g.symbol = current_classname_symbol;
1949 full_object_g.numprops = 1;
1950 ensure_memory_list_available(&full_object_g.props_memlist, 1);
1951 full_object_g.props[0].num = 2;
1952 full_object_g.props[0].flags = 0;
1953 full_object_g.props[0].datastart = 0;
1954 full_object_g.props[0].continuation = 0;
1955 full_object_g.props[0].datalen = 1;
1956 full_object_g.propdatasize = 1;
1957 ensure_memory_list_available(&full_object_g.propdata_memlist, 1);
1958 INITAOTV(&full_object_g.propdata[0], CONSTANT_OT, no_objects + 1);
1959 full_object_g.propdata[0].marker = OBJECT_MV;
1962 if (!metaclass_flag)
1964 if ((token_type == SEP_TT) && (token_value == OPENB_SEP))
1965 { assembly_operand AO;
1966 AO = parse_expression(CONSTANT_CONTEXT);
1968 { error("Duplicate-number not known at compile time");
1973 if ((n<0) || (n>10000))
1974 { error("The number of duplicates must be 0 to 10000");
1978 /* Make one extra duplicate, since the veneer routines need
1979 always to keep an undamaged prototype for the class in stock */
1981 duplicates_to_make = n + 1;
1983 match_close_bracket();
1984 } else put_token_back();
1986 /* Parse the body of the definition: */
1988 parse_body_of_definition();
1991 if (debugfile_switch)
1992 { debug_file_printf("<class>");
1993 debug_file_printf("<identifier>%s</identifier>", shortname_buffer);
1994 debug_file_printf("<class-number>%d</class-number>", no_classes);
1995 debug_file_printf("<value>");
1996 write_debug_object_backpatch(no_objects + 1);
1997 debug_file_printf("</value>");
1998 write_debug_locations
1999 (get_token_location_end(beginning_debug_location));
2000 debug_file_printf("</class>");
2004 manufacture_object_z();
2006 manufacture_object_g();
2008 if (individual_prop_table_size >= VENEER_CONSTRAINT_ON_IP_TABLE_SIZE)
2009 error("This class is too complex: it now carries too many properties. \
2010 You may be able to get round this by declaring some of its property names as \
2011 \"common properties\" using the 'Property' directive.");
2013 if (duplicates_to_make > 0)
2015 int namelen = strlen(shortname_buffer);
2016 char *duplicate_name = my_malloc(namelen+16, "temporary storage for object duplicate names");
2017 strcpy(duplicate_name, shortname_buffer);
2018 for (n=1; (duplicates_to_make--) > 0; n++)
2020 sprintf(duplicate_name+namelen, "_%d", n);
2021 make_object(FALSE, duplicate_name, class_number, class_number, -1);
2023 my_free(&duplicate_name, "temporary storage for object duplicate names");
2026 /* Finished building the class. */
2027 current_classname_symbol = 0;
2030 /* ------------------------------------------------------------------------- */
2031 /* Object/Nearby directives: */
2033 /* Object <name-1> ... <name-n> "short name" [parent] <body of def> */
2035 /* Nearby <name-1> ... <name-n> "short name" <body of definition> */
2036 /* ------------------------------------------------------------------------- */
2038 static int end_of_header(void)
2039 { if (((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
2040 || ((token_type == SEP_TT) && (token_value == COMMA_SEP))
2041 || (token_type == SEGMENT_MARKER_TT)) return TRUE;
2045 extern void make_object(int nearby_flag,
2046 char *textual_name, int specified_parent, int specified_class,
2049 /* Ordinarily this is called with nearby_flag TRUE for "Nearby",
2050 FALSE for "Object"; and textual_name NULL, specified_parent and
2051 specified_class both -1. The next three arguments are used when
2052 the routine is called for class duplicates manufacture (see above).
2053 The last is used to create instances of a particular class. */
2055 int i, tree_depth, internal_name_symbol = 0;
2056 debug_location_beginning beginning_debug_location =
2057 get_token_location_beginning();
2059 directives.enabled = FALSE;
2061 ensure_memory_list_available(¤t_object_name, 32);
2062 sprintf(current_object_name.data, "nameless_obj__%d", no_objects+1);
2064 current_defn_is_class = FALSE;
2066 no_classes_to_inherit_from=0;
2068 individual_prop_table_size = 0;
2070 if (nearby_flag) tree_depth=1; else tree_depth=0;
2072 if (specified_class != -1) goto HeaderPassed;
2076 /* Read past and count a sequence of "->"s, if any are present */
2078 if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
2080 error("The syntax '->' is only used as an alternative to 'Nearby'");
2082 while ((token_type == SEP_TT) && (token_value == ARROW_SEP))
2088 sprintf(shortname_buffer, "?");
2090 segment_markers.enabled = TRUE;
2092 /* This first word is either an internal name, or a textual short name,
2093 or the end of the header part */
2095 if (end_of_header()) goto HeaderPassed;
2097 if (token_type == DQ_TT) textual_name = token_text;
2099 { if (token_type != SYMBOL_TT) {
2100 ebf_error("name for new object or its textual short name",
2103 else if (!(symbols[token_value].flags & UNKNOWN_SFLAG)) {
2104 ebf_symbol_error("new object", token_text, typename(symbols[token_value].type), symbols[token_value].line);
2107 { internal_name_symbol = token_value;
2108 ensure_memory_list_available(¤t_object_name, strlen(token_text)+1);
2109 strcpy(current_object_name.data, token_text);
2113 /* The next word is either a parent object, or
2114 a textual short name, or the end of the header part */
2116 get_next_token_with_directives();
2117 if (end_of_header()) goto HeaderPassed;
2119 if (token_type == DQ_TT)
2120 { if (textual_name != NULL)
2121 error("Two textual short names given for only one object");
2123 textual_name = token_text;
2126 { if ((token_type != SYMBOL_TT)
2127 || (symbols[token_value].flags & UNKNOWN_SFLAG))
2128 { if (textual_name == NULL)
2129 ebf_error("parent object or the object's textual short name",
2132 ebf_error("parent object", token_text);
2134 else goto SpecParent;
2137 /* Finally, it's possible that there is still a parent object */
2140 if (end_of_header()) goto HeaderPassed;
2142 if (specified_parent != -1)
2143 ebf_error("body of object definition", token_text);
2146 if ((symbols[token_value].type == OBJECT_T)
2147 || (symbols[token_value].type == CLASS_T))
2148 { specified_parent = symbols[token_value].value;
2149 symbols[token_value].flags |= USED_SFLAG;
2151 else ebf_error("name of (the parent) object", token_text);
2154 /* Now it really has to be the body of the definition. */
2156 get_next_token_with_directives();
2157 if (end_of_header()) goto HeaderPassed;
2159 ebf_error("body of object definition", token_text);
2162 if (specified_class == -1) put_token_back();
2164 if (internal_name_symbol > 0)
2165 assign_symbol(internal_name_symbol, no_objects + 1, OBJECT_T);
2167 if (textual_name == NULL)
2168 { if (internal_name_symbol > 0)
2169 sprintf(shortname_buffer, "(%s)",
2170 symbols[internal_name_symbol].name);
2172 sprintf(shortname_buffer, "(%d)", no_objects+1);
2175 { if (strlen(textual_name)>765)
2176 error("Short name of object (in quotes) exceeded 765 characters");
2177 strncpy(shortname_buffer, textual_name, 765);
2180 if (specified_parent != -1)
2181 { if (tree_depth > 0)
2182 error("Use of '->' (or 'Nearby') clashes with giving a parent");
2183 parent_of_this_obj = specified_parent;
2186 { parent_of_this_obj = 0;
2189 /* We have to set the parent object to the most recently defined
2190 object at level (tree_depth - 1) in the tree.
2192 A complication is that objects are numbered 1, 2, ... in the
2193 Z-machine (and in the objects[].parent, etc., fields) but
2194 0, 1, 2, ... internally (and as indices to object[]). */
2196 for (i=no_objects-1; i>=0; i--)
2199 /* Metaclass or class objects cannot be '->' parents: */
2204 if (objectsz[i].parent == 1)
2206 while (objectsz[j].parent != 0)
2207 { j = objectsz[j].parent - 1; k++; }
2210 if (objectsg[i].parent == 1)
2212 while (objectsg[j].parent != 0)
2213 { j = objectsg[j].parent - 1; k++; }
2216 if (k == tree_depth - 1)
2217 { parent_of_this_obj = i+1;
2221 if (parent_of_this_obj == 0)
2222 { if (tree_depth == 1)
2223 error("'->' (or 'Nearby') fails because there is no previous object");
2225 error("'-> -> ...' fails because no previous object is deep enough");
2230 initialise_full_object();
2232 full_object.symbol = internal_name_symbol;
2234 full_object_g.symbol = internal_name_symbol;
2236 if (instance_of != -1) add_class_to_inheritance_list(instance_of);
2238 if (specified_class == -1) parse_body_of_definition();
2239 else add_class_to_inheritance_list(specified_class);
2241 if (debugfile_switch)
2242 { debug_file_printf("<object>");
2243 if (internal_name_symbol > 0)
2244 { debug_file_printf("<identifier>%s</identifier>",
2245 current_object_name.data);
2248 ("<identifier artificial=\"true\">%s</identifier>",
2249 current_object_name.data);
2251 debug_file_printf("<value>");
2252 write_debug_object_backpatch(no_objects + 1);
2253 debug_file_printf("</value>");
2254 write_debug_locations
2255 (get_token_location_end(beginning_debug_location));
2256 debug_file_printf("</object>");
2260 manufacture_object_z();
2262 manufacture_object_g();
2265 /* ========================================================================= */
2266 /* Data structure management routines */
2267 /* ------------------------------------------------------------------------- */
2269 extern void init_objects_vars(void)
2271 properties_table = NULL;
2272 individuals_table = NULL;
2278 classes_to_inherit_from = NULL;
2281 full_object_g.props = NULL;
2282 full_object_g.propdata = NULL;
2285 extern void objects_begin_pass(void)
2287 properties_table_size=0;
2289 /* The three predefined common properties: */
2290 /* (Entry 0 is not used.) */
2293 commonprops[1].default_value = 0;
2294 commonprops[1].is_long = TRUE;
2295 commonprops[1].is_additive = TRUE;
2297 /* class inheritance property */
2298 commonprops[2].default_value = 0;
2299 commonprops[2].is_long = TRUE;
2300 commonprops[2].is_additive = TRUE;
2302 /* instance variables table address */
2303 /* (This property is only meaningful in Z-code; in Glulx its entry is
2304 reserved but never used.) */
2305 commonprops[3].default_value = 0;
2306 commonprops[3].is_long = TRUE;
2307 commonprops[3].is_additive = FALSE;
2311 if (debugfile_switch)
2313 /* These two properties are not symbols, so they won't be emitted
2314 by emit_debug_information_for_predefined_symbol(). Do it
2316 debug_file_printf("<property>");
2318 ("<identifier artificial=\"true\">inheritance class</identifier>");
2319 debug_file_printf("<value>2</value>");
2320 debug_file_printf("</property>");
2321 debug_file_printf("<property>");
2323 ("<identifier artificial=\"true\">instance variables table address "
2324 "(Z-code)</identifier>");
2325 debug_file_printf("<value>3</value>");
2326 debug_file_printf("</property>");
2329 if (define_INFIX_switch) no_attributes = 1;
2330 else no_attributes = 0;
2333 /* Setting the info for object zero is probably a relic of very old code, but we do it. */
2335 ensure_memory_list_available(&objectsz_memlist, 1);
2336 objectsz[0].parent = 0; objectsz[0].child = 0; objectsz[0].next = 0;
2337 no_individual_properties=72;
2340 ensure_memory_list_available(&objectsg_memlist, 1);
2341 objectsg[0].parent = 0; objectsg[0].child = 0; objectsg[0].next = 0;
2342 no_individual_properties = INDIV_PROP_START+8;
2345 current_classname_symbol = 0;
2347 no_embedded_routines = 0;
2349 individuals_length=0;
2352 extern void objects_allocate_arrays(void)
2358 commonprops = my_calloc(sizeof(commonpropinfo), INDIV_PROP_START,
2359 "common property info");
2361 initialise_memory_list(&class_info_memlist,
2362 sizeof(classinfo), 64, (void**)&class_info,
2364 initialise_memory_list(&classes_to_inherit_from_memlist,
2365 sizeof(int), 64, (void**)&classes_to_inherit_from,
2366 "inherited classes list");
2368 initialise_memory_list(&properties_table_memlist,
2369 sizeof(uchar), 10000, (void**)&properties_table,
2370 "properties table");
2371 initialise_memory_list(&individuals_table_memlist,
2372 sizeof(uchar), 10000, (void**)&individuals_table,
2373 "individual properties table");
2375 defined_this_segment_size = 128;
2376 defined_this_segment = my_calloc(sizeof(int), defined_this_segment_size,
2377 "defined this segment table");
2379 initialise_memory_list(¤t_object_name,
2380 sizeof(char), 32, NULL,
2381 "object name currently being defined");
2382 initialise_memory_list(&embedded_function_name,
2383 sizeof(char), 32, NULL,
2384 "temporary storage for inline function name");
2387 initialise_memory_list(&objectsz_memlist,
2388 sizeof(objecttz), 256, (void**)&objectsz,
2392 initialise_memory_list(&objectsg_memlist,
2393 sizeof(objecttg), 256, (void**)&objectsg,
2395 initialise_memory_list(&objectatts_memlist,
2396 NUM_ATTR_BYTES, 256, (void**)&objectatts,
2398 initialise_memory_list(&full_object_g.props_memlist,
2399 sizeof(propg), 64, (void**)&full_object_g.props,
2400 "object property list");
2401 initialise_memory_list(&full_object_g.propdata_memlist,
2402 sizeof(assembly_operand), 1024, (void**)&full_object_g.propdata,
2403 "object property data table");
2407 extern void objects_free_arrays(void)
2409 my_free(&commonprops, "common property info");
2411 deallocate_memory_list(¤t_object_name);
2412 deallocate_memory_list(&embedded_function_name);
2413 deallocate_memory_list(&objectsz_memlist);
2414 deallocate_memory_list(&objectsg_memlist);
2415 deallocate_memory_list(&objectatts_memlist);
2416 deallocate_memory_list(&class_info_memlist);
2417 deallocate_memory_list(&classes_to_inherit_from_memlist);
2419 deallocate_memory_list(&properties_table_memlist);
2420 deallocate_memory_list(&individuals_table_memlist);
2422 my_free(&defined_this_segment,"defined this segment table");
2425 deallocate_memory_list(&full_object_g.props_memlist);
2426 deallocate_memory_list(&full_object_g.propdata_memlist);
2431 /* ========================================================================= */