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.35 */
10 /* copyright (c) Graham Nelson 1993 - 2021 */
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 by the
52 static char shortname_buffer[766]; /* Text buffer to hold the short name
53 (which is read in first, but
54 written almost last) */
55 static int parent_of_this_obj;
57 static char *classname_text, *objectname_text;
58 /* For printing names of embedded
61 /* ------------------------------------------------------------------------- */
63 /* ------------------------------------------------------------------------- */
64 /* Arrays defined below: */
66 /* int32 class_begins_at[n] offset of properties block for */
67 /* nth class (always an offset */
68 /* inside the properties_table) */
69 /* int classes_to_inherit_from[] The list of classes to inherit */
70 /* from as taken from the current */
71 /* Nearby/Object/Class definition */
72 /* int class_object_numbers[n] The number of the prototype-object */
73 /* for the nth class */
74 /* ------------------------------------------------------------------------- */
76 int no_classes; /* Number of class defns made so far */
78 static int current_defn_is_class, /* TRUE if current Nearby/Object/Class
79 defn is in fact a Class definition */
80 no_classes_to_inherit_from; /* Number of classes in the list
81 of classes to inherit in the
82 current Nearby/Object/Class defn */
84 /* ------------------------------------------------------------------------- */
85 /* Making attributes and properties. */
86 /* ------------------------------------------------------------------------- */
88 int no_attributes, /* Number of attributes defined so far */
89 no_properties; /* Number of properties defined so far,
90 plus 1 (properties are numbered from
91 1 and Inform creates "name" and two
92 others itself, so the variable begins
93 the compilation pass set to 4) */
95 static void trace_s(char *name, int32 number, int f)
96 { if (!printprops_switch) return;
97 printf("%s %02ld ",(f==0)?"Attr":"Prop",(long int) number);
98 if (f==0) printf(" ");
99 else printf("%s%s",(prop_is_long[number])?"L":" ",
100 (prop_is_additive[number])?"A":" ");
101 printf(" %s\n",name);
104 extern void make_attribute(void)
106 debug_location_beginning beginning_debug_location =
107 get_token_location_beginning();
110 if (no_attributes==((version_number==3)?32:48))
111 { discard_token_location(beginning_debug_location);
112 if (version_number==3)
113 error("All 32 attributes already declared (compile as Advanced \
114 game to get an extra 16)");
116 error("All 48 attributes already declared");
117 panic_mode_error_recovery();
123 if (no_attributes==NUM_ATTR_BYTES*8) {
124 discard_token_location(beginning_debug_location);
126 "All attributes already declared -- increase NUM_ATTR_BYTES to use \
129 panic_mode_error_recovery();
136 i = token_value; name = token_text;
137 if (token_type != SYMBOL_TT)
138 { discard_token_location(beginning_debug_location);
139 ebf_error("new attribute name", token_text);
140 panic_mode_error_recovery();
144 if (!(sflags[i] & UNKNOWN_SFLAG))
145 { discard_token_location(beginning_debug_location);
146 ebf_symbol_error("new attribute name", token_text, typename(stypes[i]), slines[i]);
147 panic_mode_error_recovery();
152 directive_keywords.enabled = TRUE;
154 directive_keywords.enabled = FALSE;
156 if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK))
158 if (!((token_type == SYMBOL_TT)
159 && (stypes[token_value] == ATTRIBUTE_T)))
160 { discard_token_location(beginning_debug_location);
161 ebf_error("an existing attribute name after 'alias'",
163 panic_mode_error_recovery();
167 assign_symbol(i, svals[token_value], ATTRIBUTE_T);
168 sflags[token_value] |= ALIASED_SFLAG;
169 sflags[i] |= ALIASED_SFLAG;
172 { assign_symbol(i, no_attributes++, ATTRIBUTE_T);
176 if (debugfile_switch)
177 { debug_file_printf("<attribute>");
178 debug_file_printf("<identifier>%s</identifier>", name);
179 debug_file_printf("<value>%d</value>", svals[i]);
180 write_debug_locations(get_token_location_end(beginning_debug_location));
181 debug_file_printf("</attribute>");
184 trace_s(name, svals[i], 0);
188 extern void make_property(void)
189 { int32 default_value, i;
190 int additive_flag=FALSE; char *name;
192 debug_location_beginning beginning_debug_location =
193 get_token_location_beginning();
196 if (no_properties==((version_number==3)?32:64))
197 { discard_token_location(beginning_debug_location);
198 if (version_number==3)
199 error("All 30 properties already declared (compile as \
200 Advanced game to get an extra 62)");
202 error("All 62 properties already declared");
203 panic_mode_error_recovery();
209 if (no_properties==INDIV_PROP_START) {
210 discard_token_location(beginning_debug_location);
211 error_numbered("All properties already declared -- max is",
213 panic_mode_error_recovery();
220 { directive_keywords.enabled = TRUE;
222 if ((token_type == DIR_KEYWORD_TT) && (token_value == LONG_DK))
223 obsolete_warning("all properties are now automatically 'long'");
225 if ((token_type == DIR_KEYWORD_TT) && (token_value == ADDITIVE_DK))
226 additive_flag = TRUE;
231 directive_keywords.enabled = FALSE;
234 i = token_value; name = token_text;
235 if (token_type != SYMBOL_TT)
236 { discard_token_location(beginning_debug_location);
237 ebf_error("new property name", token_text);
238 panic_mode_error_recovery();
242 if (!(sflags[i] & UNKNOWN_SFLAG))
243 { discard_token_location(beginning_debug_location);
244 ebf_symbol_error("new property name", token_text, typename(stypes[i]), slines[i]);
245 panic_mode_error_recovery();
250 directive_keywords.enabled = TRUE;
252 directive_keywords.enabled = FALSE;
254 if (strcmp(name+strlen(name)-3, "_to") == 0) sflags[i] |= STAR_SFLAG;
256 if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK))
257 { discard_token_location(beginning_debug_location);
259 { error("'alias' incompatible with 'additive'");
260 panic_mode_error_recovery();
265 if (!((token_type == SYMBOL_TT)
266 && (stypes[token_value] == PROPERTY_T)))
267 { ebf_error("an existing property name after 'alias'",
269 panic_mode_error_recovery();
274 assign_symbol(i, svals[token_value], PROPERTY_T);
275 trace_s(name, svals[i], 1);
276 sflags[token_value] |= ALIASED_SFLAG;
277 sflags[i] |= ALIASED_SFLAG;
284 if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
285 { AO = parse_expression(CONSTANT_CONTEXT);
286 default_value = AO.value;
288 backpatch_zmachine(AO.marker, PROP_DEFAULTS_ZA,
289 (no_properties-1) * WORDSIZE);
292 prop_default_value[no_properties] = default_value;
293 prop_is_long[no_properties] = TRUE;
294 prop_is_additive[no_properties] = additive_flag;
296 assign_symbol(i, no_properties++, PROPERTY_T);
298 if (debugfile_switch)
299 { debug_file_printf("<property>");
300 debug_file_printf("<identifier>%s</identifier>", name);
301 debug_file_printf("<value>%d</value>", svals[i]);
302 write_debug_locations
303 (get_token_location_end(beginning_debug_location));
304 debug_file_printf("</property>");
307 trace_s(name, svals[i], 1);
310 /* ------------------------------------------------------------------------- */
312 /* ------------------------------------------------------------------------- */
314 int32 *prop_default_value; /* Default values for properties */
315 int *prop_is_long, /* Property modifiers, TRUE or FALSE:
316 "long" means "never write a 1-byte
317 value to this property", and is an
318 obsolete feature: since Inform 5
319 all properties have been "long" */
320 *prop_is_additive; /* "additive" means that values
321 accumulate rather than erase each
322 other during class inheritance */
323 char *properties_table; /* Holds the table of property values
324 (holding one block for each object
325 and coming immediately after the
326 object tree in Z-memory) */
327 int properties_table_size; /* Number of bytes in this table */
329 /* ------------------------------------------------------------------------- */
330 /* Individual properties */
332 /* Each new i.p. name is given a unique number. These numbers start from */
333 /* 72, since 0 is reserved as a null, 1 to 63 refer to common properties */
334 /* and 64 to 71 are kept for methods of the metaclass Class (for example, */
335 /* 64 is "create"). */
337 /* An object provides individual properties by having property 3 set to a */
338 /* non-zero value, which must be a byte address of a table in the form: */
340 /* <record-1> ... <record-n> 00 00 */
342 /* where a <record> looks like */
344 /* <identifier> <size> <up to 255 bytes of data> */
345 /* or <identifier + 0x8000> */
346 /* ----- 2 bytes ---------- 1 byte <size> number of bytes */
348 /* The <identifier> part is the number allocated to the name of what is */
349 /* being provided. The top bit of this word is set to indicate that */
350 /* although the individual property is being provided, it is provided */
351 /* only privately (so that it is inaccessible except to the object's own */
352 /* embedded routines). */
354 /* In Glulx: i-props are numbered from INDIV_PROP_START+8 up. And all */
355 /* properties, common and individual, are stored in the same table. */
356 /* ------------------------------------------------------------------------- */
358 int no_individual_properties; /* Actually equal to the next
359 identifier number to be allocated,
360 so this is initially 72 even though
361 none have been made yet. */
362 static int individual_prop_table_size; /* Size of the table of individual
363 properties so far for current obj */
364 uchar *individuals_table; /* Table of records, each being the
365 i.p. table for an object */
366 int i_m; /* Write mark position in the above */
367 int individuals_length; /* Extent of individuals_table */
369 /* ------------------------------------------------------------------------- */
370 /* Arrays used by this file */
371 /* ------------------------------------------------------------------------- */
373 objecttz *objectsz; /* Z-code only */
374 objecttg *objectsg; /* Glulx only */
375 uchar *objectatts; /* Glulx only */
376 static int *classes_to_inherit_from;
377 int *class_object_numbers;
378 int32 *class_begins_at;
381 /* ------------------------------------------------------------------------- */
382 /* Tracing for compiler maintenance */
383 /* ------------------------------------------------------------------------- */
385 extern void list_object_tree(void)
387 printf("obj par nxt chl Object tree:\n");
388 for (i=0; i<no_objects; i++)
389 printf("%3d %3d %3d %3d\n",
390 i+1,objectsz[i].parent,objectsz[i].next, objectsz[i].child);
393 /* ------------------------------------------------------------------------- */
394 /* Object and class manufacture begins here. */
396 /* These definitions have headers (parsed far, far below) and a series */
397 /* of segments, introduced by keywords and optionally separated by commas. */
398 /* Each segment has its own parsing routine. Note that when errors are */
399 /* detected, parsing continues rather than being abandoned, which assists */
400 /* a little in "error recovery" (i.e. in stopping lots more errors being */
401 /* produced for essentially the same mistake). */
402 /* ------------------------------------------------------------------------- */
404 /* ========================================================================= */
405 /* [1] The object-maker: builds an object from a specification, viz.: */
408 /* shortname_buffer, */
409 /* parent_of_this_obj, */
410 /* current_defn_is_class (flag) */
411 /* classes_to_inherit_from[], no_classes_to_inherit_from, */
412 /* individual_prop_table_size (to date ) */
414 /* For efficiency's sake, the individual properties table has already been */
415 /* created (as far as possible, i.e., all except for inherited individual */
416 /* properties); unless the flag is clear, in which case the actual */
417 /* definition did not specify any individual properties. */
418 /* ========================================================================= */
419 /* Property inheritance from classes. */
420 /* ------------------------------------------------------------------------- */
422 static void property_inheritance_z(void)
424 /* Apply the property inheritance rules to full_object, which should
425 initially be complete (i.e., this routine takes place after the whole
426 Nearby/Object/Class definition has been parsed through).
428 On exit, full_object contains the final state of the properties to
431 int i, j, k, kmax, class, mark,
432 prop_number, prop_length, prop_in_current_defn;
433 uchar *class_prop_block;
437 for (class=0; class<no_classes_to_inherit_from; class++)
440 mark = class_begins_at[classes_to_inherit_from[class]-1];
441 class_prop_block = (uchar *) (properties_table + mark);
443 while (class_prop_block[j]!=0)
444 { if (version_number == 3)
445 { prop_number = class_prop_block[j]%32;
446 prop_length = 1 + class_prop_block[j++]/32;
449 { prop_number = class_prop_block[j]%64;
450 prop_length = 1 + class_prop_block[j++]/64;
452 prop_length = class_prop_block[j++]%64;
455 /* So we now have property number prop_number present in the
456 property block for the class being read: its bytes are
458 class_prop_block[j, ..., j + prop_length - 1]
460 Question now is: is there already a value given in the
461 current definition under this property name? */
463 prop_in_current_defn = FALSE;
465 kmax = full_object.l;
467 for (k=0; k<kmax; k++)
468 if (full_object.pp[k].num == prop_number)
469 { prop_in_current_defn = TRUE;
471 /* (Note that the built-in "name" property is additive) */
473 if ((prop_number==1) || (prop_is_additive[prop_number]))
475 /* The additive case: we accumulate the class
476 property values onto the end of the full_object
479 for (i=full_object.pp[k].l;
480 i<full_object.pp[k].l+prop_length/2; i++)
482 { error("An additive property has inherited \
483 so many values that the list has overflowed the maximum 32 entries");
486 full_object.pp[k].ao[i].value = mark + j;
488 full_object.pp[k].ao[i].marker = INHERIT_MV;
489 full_object.pp[k].ao[i].type = LONG_CONSTANT_OT;
491 full_object.pp[k].l += prop_length/2;
494 /* The ordinary case: the full_object property
495 values simply overrides the class definition,
496 so we skip over the values in the class table */
501 { int y, z, class_block_offset;
504 /* Property 3 holds the address of the table of
505 instance variables, so this is the case where
506 the object already has instance variables in its
507 own table but must inherit some more from the
510 class_block_offset = class_prop_block[j-2]*256
511 + class_prop_block[j-1];
513 p = individuals_table + class_block_offset;
514 z = class_block_offset;
515 while ((p[0]!=0)||(p[1]!=0))
516 { int already_present = FALSE, l;
517 for (l = full_object.pp[k].ao[0].value; l < i_m;
518 l = l + 3 + individuals_table[l + 2])
519 if (individuals_table[l] == p[0]
520 && individuals_table[l + 1] == p[1])
521 { already_present = TRUE; break;
523 if (already_present == FALSE)
525 backpatch_zmachine(IDENT_MV,
526 INDIVIDUAL_PROP_ZA, i_m);
527 if (i_m+3+p[2] > MAX_INDIV_PROP_TABLE_SIZE)
528 memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
529 MAX_INDIV_PROP_TABLE_SIZE);
530 individuals_table[i_m++] = p[0];
531 individuals_table[i_m++] = p[1];
532 individuals_table[i_m++] = p[2];
533 for (y=0;y < p[2]/2;y++)
534 { individuals_table[i_m++] = (z+3+y*2)/256;
535 individuals_table[i_m++] = (z+3+y*2)%256;
536 backpatch_zmachine(INHERIT_INDIV_MV,
537 INDIVIDUAL_PROP_ZA, i_m-2);
543 individuals_length = i_m;
546 /* For efficiency we exit the loop now (this property
547 number has been dealt with) */
552 if (!prop_in_current_defn)
554 /* The case where the class defined a property which wasn't
555 defined at all in full_object: we copy out the data into
556 a new property added to full_object */
559 full_object.pp[k].num = prop_number;
560 full_object.pp[k].l = prop_length/2;
561 for (i=0; i<prop_length/2; i++)
562 { full_object.pp[k].ao[i].value = mark + j;
564 full_object.pp[k].ao[i].marker = INHERIT_MV;
565 full_object.pp[k].ao[i].type = LONG_CONSTANT_OT;
569 { int y, z, class_block_offset;
572 /* Property 3 holds the address of the table of
573 instance variables, so this is the case where
574 the object had no instance variables of its own
575 but must inherit some more from the class */
577 if (individual_prop_table_size++ == 0)
578 { full_object.pp[k].num = 3;
579 full_object.pp[k].l = 1;
580 full_object.pp[k].ao[0].value
581 = individuals_length;
582 full_object.pp[k].ao[0].marker = INDIVPT_MV;
583 full_object.pp[k].ao[0].type = LONG_CONSTANT_OT;
584 i_m = individuals_length;
586 class_block_offset = class_prop_block[j-2]*256
587 + class_prop_block[j-1];
589 p = individuals_table + class_block_offset;
590 z = class_block_offset;
591 while ((p[0]!=0)||(p[1]!=0))
593 backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
594 if (i_m+3+p[2] > MAX_INDIV_PROP_TABLE_SIZE)
595 memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
596 MAX_INDIV_PROP_TABLE_SIZE);
597 individuals_table[i_m++] = p[0];
598 individuals_table[i_m++] = p[1];
599 individuals_table[i_m++] = p[2];
600 for (y=0;y < p[2]/2;y++)
601 { individuals_table[i_m++] = (z+3+y*2)/256;
602 individuals_table[i_m++] = (z+3+y*2)%256;
603 backpatch_zmachine(INHERIT_INDIV_MV,
604 INDIVIDUAL_PROP_ZA, i_m-2);
609 individuals_length = i_m;
615 if (individual_prop_table_size > 0)
617 if (i_m+2 > MAX_INDIV_PROP_TABLE_SIZE)
618 memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
619 MAX_INDIV_PROP_TABLE_SIZE);
621 individuals_table[i_m++] = 0;
622 individuals_table[i_m++] = 0;
623 individuals_length += 2;
627 static void property_inheritance_g(void)
629 /* Apply the property inheritance rules to full_object, which should
630 initially be complete (i.e., this routine takes place after the whole
631 Nearby/Object/Class definition has been parsed through).
633 On exit, full_object contains the final state of the properties to
636 int i, j, k, class, num_props,
637 prop_number, prop_length, prop_flags, prop_in_current_defn;
638 int32 mark, prop_addr;
643 for (class=0; class<no_classes_to_inherit_from; class++) {
644 mark = class_begins_at[classes_to_inherit_from[class]-1];
645 cpb = (uchar *) (properties_table + mark);
646 /* This now points to the compiled property-table for the class.
647 We'll have to go through and decompile it. (For our sins.) */
648 num_props = ReadInt32(cpb);
649 for (j=0; j<num_props; j++) {
651 prop_number = ReadInt16(pe);
653 prop_length = ReadInt16(pe);
655 prop_addr = ReadInt32(pe);
657 prop_flags = ReadInt16(pe);
660 /* So we now have property number prop_number present in the
661 property block for the class being read. Its bytes are
662 cpb[prop_addr ... prop_addr + prop_length - 1]
663 Question now is: is there already a value given in the
664 current definition under this property name? */
666 prop_in_current_defn = FALSE;
668 for (k=0; k<full_object_g.numprops; k++) {
669 if (full_object_g.props[k].num == prop_number) {
670 prop_in_current_defn = TRUE;
675 if (prop_in_current_defn) {
677 || (prop_number < INDIV_PROP_START
678 && prop_is_additive[prop_number])) {
679 /* The additive case: we accumulate the class
680 property values onto the end of the full_object
681 properties. Remember that k is still the index number
682 of the first prop-block matching our property number. */
684 if (full_object_g.props[k].continuation == 0) {
685 full_object_g.props[k].continuation = 1;
689 prevcont = full_object_g.props[k].continuation;
690 for (k++; k<full_object_g.numprops; k++) {
691 if (full_object_g.props[k].num == prop_number) {
692 prevcont = full_object_g.props[k].continuation;
696 k = full_object_g.numprops++;
697 full_object_g.props[k].num = prop_number;
698 full_object_g.props[k].flags = 0;
699 full_object_g.props[k].datastart = full_object_g.propdatasize;
700 full_object_g.props[k].continuation = prevcont+1;
701 full_object_g.props[k].datalen = prop_length;
702 if (full_object_g.propdatasize + prop_length
703 > MAX_OBJ_PROP_TABLE_SIZE) {
704 memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
707 for (i=0; i<prop_length; i++) {
708 int ppos = full_object_g.propdatasize++;
709 full_object_g.propdata[ppos].value = prop_addr + 4*i;
710 full_object_g.propdata[ppos].marker = INHERIT_MV;
711 full_object_g.propdata[ppos].type = CONSTANT_OT;
715 /* The ordinary case: the full_object_g property
716 values simply overrides the class definition,
717 so we skip over the values in the class table. */
721 /* The case where the class defined a property which wasn't
722 defined at all in full_object_g: we copy out the data into
723 a new property added to full_object_g. */
724 k = full_object_g.numprops++;
725 full_object_g.props[k].num = prop_number;
726 full_object_g.props[k].flags = prop_flags;
727 full_object_g.props[k].datastart = full_object_g.propdatasize;
728 full_object_g.props[k].continuation = 0;
729 full_object_g.props[k].datalen = prop_length;
730 if (full_object_g.propdatasize + prop_length
731 > MAX_OBJ_PROP_TABLE_SIZE) {
732 memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
735 for (i=0; i<prop_length; i++) {
736 int ppos = full_object_g.propdatasize++;
737 full_object_g.propdata[ppos].value = prop_addr + 4*i;
738 full_object_g.propdata[ppos].marker = INHERIT_MV;
739 full_object_g.propdata[ppos].type = CONSTANT_OT;
743 if (full_object_g.numprops == MAX_OBJ_PROP_COUNT) {
744 memoryerror("MAX_OBJ_PROP_COUNT",MAX_OBJ_PROP_COUNT);
751 /* ------------------------------------------------------------------------- */
752 /* Construction of Z-machine-format property blocks. */
753 /* ------------------------------------------------------------------------- */
755 static int write_properties_between(uchar *p, int mark, int from, int to)
756 { int j, k, prop_number, prop_length;
757 /* Note that p is properties_table. */
758 for (prop_number=to; prop_number>=from; prop_number--)
759 { for (j=0; j<full_object.l; j++)
760 { if ((full_object.pp[j].num == prop_number)
761 && (full_object.pp[j].l != 100))
762 { prop_length = 2*full_object.pp[j].l;
763 if (mark+2+prop_length >= MAX_PROP_TABLE_SIZE)
764 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
765 if (version_number == 3)
766 p[mark++] = prop_number + (prop_length - 1)*32;
768 { switch(prop_length)
770 p[mark++] = prop_number; break;
772 p[mark++] = prop_number + 0x40; break;
774 p[mark++] = prop_number + 0x80;
775 p[mark++] = prop_length + 0x80; break;
779 for (k=0; k<full_object.pp[j].l; k++)
780 { if (full_object.pp[j].ao[k].marker != 0)
781 backpatch_zmachine(full_object.pp[j].ao[k].marker,
783 p[mark++] = full_object.pp[j].ao[k].value/256;
784 p[mark++] = full_object.pp[j].ao[k].value%256;
794 static int write_property_block_z(char *shortname)
796 /* Compile the (now complete) full_object properties into a
797 property-table block at "p" in Inform's memory.
798 "shortname" is the object's short name, if specified; otherwise
801 Return the number of bytes written to the block. */
803 int32 mark = properties_table_size, i;
804 uchar *p = (uchar *) properties_table;
806 /* printf("Object at %04x\n", mark); */
808 if (shortname != NULL)
810 if (mark+1+510 >= MAX_PROP_TABLE_SIZE)
811 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
812 tmp = translate_text(p+mark+1,p+mark+1+510,shortname,STRCTX_OBJNAME);
813 if (!tmp) error ("Short name of object exceeded 765 Z-characters");
814 i = subtract_pointers(tmp,(p+mark+1));
818 if (current_defn_is_class)
819 { mark = write_properties_between(p,mark,3,3);
821 p[mark++] = full_object.atts[i];
822 class_begins_at[no_classes++] = mark;
825 mark = write_properties_between(p, mark, 1, (version_number==3)?31:63);
827 i = mark - properties_table_size;
828 properties_table_size = mark;
833 static int gpropsort(void *ptr1, void *ptr2)
838 if (prop2->num == -1)
840 if (prop1->num == -1)
842 if (prop1->num < prop2->num)
844 if (prop1->num > prop2->num)
847 return (prop1->continuation - prop2->continuation);
850 static int32 write_property_block_g(void)
852 /* Compile the (now complete) full_object properties into a
853 property-table block at "p" in Inform's memory.
854 Return the number of bytes written to the block.
855 In Glulx, the shortname property isn't used here; it's already
856 been compiled into an ordinary string. */
859 int ix, jx, kx, totalprops;
860 int32 mark = properties_table_size;
862 uchar *p = (uchar *) properties_table;
864 if (current_defn_is_class) {
865 for (i=0;i<NUM_ATTR_BYTES;i++)
866 p[mark++] = full_object_g.atts[i];
867 class_begins_at[no_classes++] = mark;
870 qsort(full_object_g.props, full_object_g.numprops, sizeof(propg),
871 (int (*)(const void *, const void *))(&gpropsort));
873 full_object_g.finalpropaddr = mark;
877 for (ix=0; ix<full_object_g.numprops; ix=jx) {
878 int propnum = full_object_g.props[ix].num;
882 jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
887 /* Write out the number of properties in this table. */
888 if (mark+4 >= MAX_PROP_TABLE_SIZE)
889 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
890 WriteInt32(p+mark, totalprops);
893 datamark = mark + 10*totalprops;
895 for (ix=0; ix<full_object_g.numprops; ix=jx) {
896 int propnum = full_object_g.props[ix].num;
897 int flags = full_object_g.props[ix].flags;
899 int32 datamarkstart = datamark;
903 jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
905 int32 datastart = full_object_g.props[jx].datastart;
906 if (datamark+4*full_object_g.props[jx].datalen >= MAX_PROP_TABLE_SIZE)
907 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
908 for (kx=0; kx<full_object_g.props[jx].datalen; kx++) {
909 int32 val = full_object_g.propdata[datastart+kx].value;
910 WriteInt32(p+datamark, val);
911 if (full_object_g.propdata[datastart+kx].marker != 0)
912 backpatch_zmachine(full_object_g.propdata[datastart+kx].marker,
918 if (mark+10 >= MAX_PROP_TABLE_SIZE)
919 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
920 WriteInt16(p+mark, propnum);
922 WriteInt16(p+mark, totallen);
924 WriteInt32(p+mark, datamarkstart);
926 WriteInt16(p+mark, flags);
932 i = mark - properties_table_size;
933 properties_table_size = mark;
937 /* ------------------------------------------------------------------------- */
938 /* The final stage in Nearby/Object/Class definition processing. */
939 /* ------------------------------------------------------------------------- */
941 static void manufacture_object_z(void)
944 segment_markers.enabled = FALSE;
945 directives.enabled = TRUE;
947 property_inheritance_z();
949 objectsz[no_objects].parent = parent_of_this_obj;
950 objectsz[no_objects].next = 0;
951 objectsz[no_objects].child = 0;
953 if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fff))
954 { i = objectsz[parent_of_this_obj-1].child;
956 objectsz[parent_of_this_obj-1].child = no_objects + 1;
958 { while(objectsz[i-1].next != 0) i = objectsz[i-1].next;
959 objectsz[i-1].next = no_objects+1;
963 /* The properties table consists simply of a sequence of property
964 blocks, one for each object in order of definition, exactly as
965 it will appear in the final Z-machine. */
967 j = write_property_block_z(shortname_buffer);
969 objectsz[no_objects].propsize = j;
970 if (properties_table_size >= MAX_PROP_TABLE_SIZE)
971 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
973 if (current_defn_is_class)
974 for (i=0;i<6;i++) objectsz[no_objects].atts[i] = 0;
977 objectsz[no_objects].atts[i] = full_object.atts[i];
982 static void manufacture_object_g(void)
985 segment_markers.enabled = FALSE;
986 directives.enabled = TRUE;
988 property_inheritance_g();
990 objectsg[no_objects].parent = parent_of_this_obj;
991 objectsg[no_objects].next = 0;
992 objectsg[no_objects].child = 0;
994 if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fffffff))
995 { i = objectsg[parent_of_this_obj-1].child;
997 objectsg[parent_of_this_obj-1].child = no_objects + 1;
999 { while(objectsg[i-1].next != 0) i = objectsg[i-1].next;
1000 objectsg[i-1].next = no_objects+1;
1004 objectsg[no_objects].shortname = compile_string(shortname_buffer,
1007 /* The properties table consists simply of a sequence of property
1008 blocks, one for each object in order of definition, exactly as
1009 it will appear in the final machine image. */
1011 j = write_property_block_g();
1013 objectsg[no_objects].propaddr = full_object_g.finalpropaddr;
1015 objectsg[no_objects].propsize = j;
1016 if (properties_table_size >= MAX_PROP_TABLE_SIZE)
1017 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
1019 if (current_defn_is_class)
1020 for (i=0;i<NUM_ATTR_BYTES;i++)
1021 objectatts[no_objects*NUM_ATTR_BYTES+i] = 0;
1023 for (i=0;i<NUM_ATTR_BYTES;i++)
1024 objectatts[no_objects*NUM_ATTR_BYTES+i] = full_object_g.atts[i];
1030 /* ========================================================================= */
1031 /* [2] The Object/Nearby/Class directives parser: translating the syntax */
1032 /* into object specifications and then triggering off the above. */
1033 /* ========================================================================= */
1034 /* Properties ("with" or "private") segment. */
1035 /* ------------------------------------------------------------------------- */
1037 static int *defined_this_segment;
1038 static long defined_this_segment_size; /* calloc size */
1041 static void ensure_defined_this_segment(int newsize)
1043 int oldsize = defined_this_segment_size;
1044 defined_this_segment_size = newsize;
1045 my_recalloc(&defined_this_segment, sizeof(int), oldsize,
1046 defined_this_segment_size, "defined this segment table");
1049 static void properties_segment_z(int this_segment)
1051 /* Parse through the "with" part of an object/class definition:
1053 <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
1055 This routine also handles "private", with this_segment being equal
1056 to the token value for the introductory word ("private" or "with"). */
1059 int i, property_name_symbol, property_number=0, next_prop=0, length,
1060 individual_property, this_identifier_number;
1063 { get_next_token_with_directives();
1064 if ((token_type == SEGMENT_MARKER_TT)
1065 || (token_type == EOF_TT)
1066 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1067 { put_token_back(); return;
1070 if (token_type != SYMBOL_TT)
1071 { ebf_error("property name", token_text);
1075 individual_property = (stypes[token_value] != PROPERTY_T);
1077 if (individual_property)
1078 { if (sflags[token_value] & UNKNOWN_SFLAG)
1079 { this_identifier_number = no_individual_properties++;
1080 assign_symbol(token_value, this_identifier_number,
1081 INDIVIDUAL_PROPERTY_T);
1083 if (debugfile_switch)
1084 { debug_file_printf("<property>");
1086 ("<identifier>%s</identifier>", token_text);
1088 ("<value>%d</value>", this_identifier_number);
1089 debug_file_printf("</property>");
1094 { if (stypes[token_value]==INDIVIDUAL_PROPERTY_T)
1095 this_identifier_number = svals[token_value];
1097 { ebf_symbol_error("property name", token_text, typename(stypes[token_value]), slines[token_value]);
1102 if (def_t_s >= defined_this_segment_size)
1103 ensure_defined_this_segment(def_t_s*2);
1104 defined_this_segment[def_t_s++] = token_value;
1106 if (individual_prop_table_size++ == 0)
1107 { full_object.pp[full_object.l].num = 3;
1108 full_object.pp[full_object.l].l = 1;
1109 full_object.pp[full_object.l].ao[0].value
1110 = individuals_length;
1111 full_object.pp[full_object.l].ao[0].type = LONG_CONSTANT_OT;
1112 full_object.pp[full_object.l].ao[0].marker = INDIVPT_MV;
1114 i_m = individuals_length;
1117 individuals_table[i_m] = this_identifier_number/256;
1118 if (this_segment == PRIVATE_SEGMENT)
1119 individuals_table[i_m] |= 0x80;
1120 individuals_table[i_m+1] = this_identifier_number%256;
1122 backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
1123 individuals_table[i_m+2] = 0;
1126 { if (sflags[token_value] & UNKNOWN_SFLAG)
1127 { error_named("No such property name as", token_text);
1130 if (this_segment == PRIVATE_SEGMENT)
1131 error_named("Property should be declared in 'with', \
1132 not 'private':", token_text);
1133 if (def_t_s >= defined_this_segment_size)
1134 ensure_defined_this_segment(def_t_s*2);
1135 defined_this_segment[def_t_s++] = token_value;
1136 property_number = svals[token_value];
1138 next_prop=full_object.l++;
1139 full_object.pp[next_prop].num = property_number;
1142 for (i=0; i<(def_t_s-1); i++)
1143 if (defined_this_segment[i] == token_value)
1144 { error_named("Property given twice in the same declaration:",
1145 (char *) symbs[token_value]);
1148 if (svals[defined_this_segment[i]] == svals[token_value])
1149 { char error_b[128];
1151 "Property given twice in the same declaration, because \
1152 the names '%s' and '%s' actually refer to the same property",
1153 (char *) symbs[defined_this_segment[i]],
1154 (char *) symbs[token_value]);
1158 property_name_symbol = token_value;
1159 sflags[token_value] |= USED_SFLAG;
1163 { assembly_operand AO;
1164 get_next_token_with_directives();
1165 if ((token_type == EOF_TT)
1166 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1167 || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1170 if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1172 if ((!individual_property) && (property_number==1)
1173 && ((token_type != SQ_TT) || (strlen(token_text) <2 ))
1174 && (token_type != DQ_TT)
1176 warning ("'name' property should only contain dictionary words");
1178 if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1179 { char embedded_name[80];
1180 if (current_defn_is_class)
1181 { sprintf(embedded_name,
1182 "%s::%s", classname_text,
1183 (char *) symbs[property_name_symbol]);
1186 { sprintf(embedded_name,
1187 "%s.%s", objectname_text,
1188 (char *) symbs[property_name_symbol]);
1190 AO.value = parse_routine(NULL, TRUE, embedded_name, FALSE, -1);
1191 AO.type = LONG_CONSTANT_OT;
1192 AO.marker = IROUTINE_MV;
1194 directives.enabled = FALSE;
1195 segment_markers.enabled = TRUE;
1197 statements.enabled = FALSE;
1198 misc_keywords.enabled = FALSE;
1199 local_variables.enabled = FALSE;
1200 system_functions.enabled = FALSE;
1201 conditions.enabled = FALSE;
1205 /* A special rule applies to values in double-quotes of the
1206 built-in property "name", which always has number 1: such
1207 property values are dictionary entries and not static
1210 if ((!individual_property) &&
1211 (property_number==1) && (token_type == DQ_TT))
1212 { AO.value = dictionary_add(token_text, 0x80, 0, 0);
1213 AO.type = LONG_CONSTANT_OT;
1214 AO.marker = DWORD_MV;
1219 if ((token_type == SYMBOL_TT)
1220 && (stypes[token_value]==PROPERTY_T))
1222 /* This is not necessarily an error: it's possible
1223 to imagine a property whose value is a list
1224 of other properties to look up, but far more
1225 likely that a comma has been omitted in between
1226 two property blocks */
1229 "Missing ','? Property data seems to contain the property name",
1234 /* An ordinary value, then: */
1237 AO = parse_expression(ARRAY_CONTEXT);
1241 { error_named("Limit (of 32 values) exceeded for property",
1242 (char *) symbs[property_name_symbol]);
1246 if (individual_property)
1247 { if (AO.marker != 0)
1248 backpatch_zmachine(AO.marker, INDIVIDUAL_PROP_ZA,
1250 individuals_table[i_m+3+length++] = AO.value/256;
1251 individuals_table[i_m+3+length++] = AO.value%256;
1254 { full_object.pp[next_prop].ao[length/2] = AO;
1255 length = length + 2;
1260 /* People rarely do, but it is legal to declare a property without
1263 with name "fish", number, time_left;
1265 in which case the properties "number" and "time_left" are
1266 created as in effect variables and initialised to zero. */
1269 { if (individual_property)
1270 { individuals_table[i_m+3+length++] = 0;
1271 individuals_table[i_m+3+length++] = 0;
1274 { full_object.pp[next_prop].ao[0].value = 0;
1275 full_object.pp[next_prop].ao[0].type = LONG_CONSTANT_OT;
1276 full_object.pp[next_prop].ao[0].marker = 0;
1281 if ((version_number==3) && (!individual_property))
1284 warning_named("Version 3 limit of 4 values per property exceeded \
1285 (use -v5 to get 32), so truncating property",
1286 (char *) symbs[property_name_symbol]);
1291 if (individual_property)
1293 if (individuals_length+length+3 > MAX_INDIV_PROP_TABLE_SIZE)
1294 memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
1295 MAX_INDIV_PROP_TABLE_SIZE);
1296 individuals_table[i_m + 2] = length;
1297 individuals_length += length+3;
1298 i_m = individuals_length;
1301 full_object.pp[next_prop].l = length/2;
1303 if ((token_type == EOF_TT)
1304 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1305 { put_token_back(); return;
1312 static void properties_segment_g(int this_segment)
1314 /* Parse through the "with" part of an object/class definition:
1316 <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
1318 This routine also handles "private", with this_segment being equal
1319 to the token value for the introductory word ("private" or "with"). */
1323 individual_property, this_identifier_number;
1324 int32 property_name_symbol, property_number, length;
1327 { get_next_token_with_directives();
1328 if ((token_type == SEGMENT_MARKER_TT)
1329 || (token_type == EOF_TT)
1330 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1331 { put_token_back(); return;
1334 if (token_type != SYMBOL_TT)
1335 { ebf_error("property name", token_text);
1339 individual_property = (stypes[token_value] != PROPERTY_T);
1341 if (individual_property)
1342 { if (sflags[token_value] & UNKNOWN_SFLAG)
1343 { this_identifier_number = no_individual_properties++;
1344 assign_symbol(token_value, this_identifier_number,
1345 INDIVIDUAL_PROPERTY_T);
1347 if (debugfile_switch)
1348 { debug_file_printf("<property>");
1350 ("<identifier>%s</identifier>", token_text);
1352 ("<value>%d</value>", this_identifier_number);
1353 debug_file_printf("</property>");
1358 { if (stypes[token_value]==INDIVIDUAL_PROPERTY_T)
1359 this_identifier_number = svals[token_value];
1361 { ebf_symbol_error("property name", token_text, typename(stypes[token_value]), slines[token_value]);
1366 if (def_t_s >= defined_this_segment_size)
1367 ensure_defined_this_segment(def_t_s*2);
1368 defined_this_segment[def_t_s++] = token_value;
1369 property_number = svals[token_value];
1371 next_prop=full_object_g.numprops++;
1372 full_object_g.props[next_prop].num = property_number;
1373 full_object_g.props[next_prop].flags =
1374 ((this_segment == PRIVATE_SEGMENT) ? 1 : 0);
1375 full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1376 full_object_g.props[next_prop].continuation = 0;
1377 full_object_g.props[next_prop].datalen = 0;
1380 { if (sflags[token_value] & UNKNOWN_SFLAG)
1381 { error_named("No such property name as", token_text);
1384 if (this_segment == PRIVATE_SEGMENT)
1385 error_named("Property should be declared in 'with', \
1386 not 'private':", token_text);
1388 if (def_t_s >= defined_this_segment_size)
1389 ensure_defined_this_segment(def_t_s*2);
1390 defined_this_segment[def_t_s++] = token_value;
1391 property_number = svals[token_value];
1393 next_prop=full_object_g.numprops++;
1394 full_object_g.props[next_prop].num = property_number;
1395 full_object_g.props[next_prop].flags = 0;
1396 full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1397 full_object_g.props[next_prop].continuation = 0;
1398 full_object_g.props[next_prop].datalen = 0;
1401 for (i=0; i<(def_t_s-1); i++)
1402 if (defined_this_segment[i] == token_value)
1403 { error_named("Property given twice in the same declaration:",
1404 (char *) symbs[token_value]);
1407 if (svals[defined_this_segment[i]] == svals[token_value])
1408 { char error_b[128];
1410 "Property given twice in the same declaration, because \
1411 the names '%s' and '%s' actually refer to the same property",
1412 (char *) symbs[defined_this_segment[i]],
1413 (char *) symbs[token_value]);
1417 if (full_object_g.numprops == MAX_OBJ_PROP_COUNT) {
1418 memoryerror("MAX_OBJ_PROP_COUNT",MAX_OBJ_PROP_COUNT);
1421 property_name_symbol = token_value;
1422 sflags[token_value] |= USED_SFLAG;
1426 { assembly_operand AO;
1427 get_next_token_with_directives();
1428 if ((token_type == EOF_TT)
1429 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1430 || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1433 if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1435 if ((!individual_property) && (property_number==1)
1436 && ((token_type != SQ_TT) || (strlen(token_text) <2 ))
1437 && (token_type != DQ_TT)
1439 warning ("'name' property should only contain dictionary words");
1441 if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1442 { char embedded_name[80];
1443 if (current_defn_is_class)
1444 { sprintf(embedded_name,
1445 "%s::%s", classname_text,
1446 (char *) symbs[property_name_symbol]);
1449 { sprintf(embedded_name,
1450 "%s.%s", objectname_text,
1451 (char *) symbs[property_name_symbol]);
1453 AO.value = parse_routine(NULL, TRUE, embedded_name, FALSE, -1);
1454 AO.type = CONSTANT_OT;
1455 AO.marker = IROUTINE_MV;
1457 directives.enabled = FALSE;
1458 segment_markers.enabled = TRUE;
1460 statements.enabled = FALSE;
1461 misc_keywords.enabled = FALSE;
1462 local_variables.enabled = FALSE;
1463 system_functions.enabled = FALSE;
1464 conditions.enabled = FALSE;
1468 /* A special rule applies to values in double-quotes of the
1469 built-in property "name", which always has number 1: such
1470 property values are dictionary entries and not static
1473 if ((!individual_property) &&
1474 (property_number==1) && (token_type == DQ_TT))
1475 { AO.value = dictionary_add(token_text, 0x80, 0, 0);
1476 AO.type = CONSTANT_OT;
1477 AO.marker = DWORD_MV;
1482 if ((token_type == SYMBOL_TT)
1483 && (stypes[token_value]==PROPERTY_T))
1485 /* This is not necessarily an error: it's possible
1486 to imagine a property whose value is a list
1487 of other properties to look up, but far more
1488 likely that a comma has been omitted in between
1489 two property blocks */
1492 "Missing ','? Property data seems to contain the property name",
1497 /* An ordinary value, then: */
1500 AO = parse_expression(ARRAY_CONTEXT);
1503 if (length == 32768) /* VENEER_CONSTRAINT_ON_PROP_TABLE_SIZE? */
1504 { error_named("Limit (of 32768 values) exceeded for property",
1505 (char *) symbs[property_name_symbol]);
1509 if (full_object_g.propdatasize >= MAX_OBJ_PROP_TABLE_SIZE) {
1510 memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
1513 full_object_g.propdata[full_object_g.propdatasize++] = AO;
1518 /* People rarely do, but it is legal to declare a property without
1521 with name "fish", number, time_left;
1523 in which case the properties "number" and "time_left" are
1524 created as in effect variables and initialised to zero. */
1528 assembly_operand AO;
1530 AO.type = CONSTANT_OT;
1532 full_object_g.propdata[full_object_g.propdatasize++] = AO;
1536 full_object_g.props[next_prop].datalen = length;
1538 if ((token_type == EOF_TT)
1539 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1540 { put_token_back(); return;
1546 static void properties_segment(int this_segment)
1549 properties_segment_z(this_segment);
1551 properties_segment_g(this_segment);
1554 /* ------------------------------------------------------------------------- */
1555 /* Attributes ("has") segment. */
1556 /* ------------------------------------------------------------------------- */
1558 static void attributes_segment(void)
1560 /* Parse through the "has" part of an object/class definition:
1562 [~]<attribute-1> [~]<attribute-2> ... [~]<attribute-n> */
1564 int attribute_number, truth_state, bitmask;
1567 { truth_state = TRUE;
1571 get_next_token_with_directives();
1572 if ((token_type == SEGMENT_MARKER_TT)
1573 || (token_type == EOF_TT)
1574 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1576 ebf_error("attribute name after '~'", token_text);
1577 put_token_back(); return;
1579 if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1581 if ((token_type == SEP_TT) && (token_value == ARTNOT_SEP))
1582 { truth_state = !truth_state; goto ParseAttrN;
1585 if ((token_type != SYMBOL_TT)
1586 || (stypes[token_value] != ATTRIBUTE_T))
1587 { ebf_error("name of an already-declared attribute", token_text);
1591 attribute_number = svals[token_value];
1592 sflags[token_value] |= USED_SFLAG;
1595 bitmask = (1 << (7-attribute_number%8));
1596 attrbyte = &(full_object.atts[attribute_number/8]);
1599 /* In Glulx, my prejudices rule, and therefore bits are numbered
1600 from least to most significant. This is the opposite of the
1601 way the Z-machine works. */
1602 bitmask = (1 << (attribute_number%8));
1603 attrbyte = &(full_object_g.atts[attribute_number/8]);
1607 *attrbyte |= bitmask; /* Set attribute bit */
1609 *attrbyte &= ~bitmask; /* Clear attribute bit */
1614 /* ------------------------------------------------------------------------- */
1615 /* Classes ("class") segment. */
1616 /* ------------------------------------------------------------------------- */
1618 static void add_class_to_inheritance_list(int class_number)
1622 /* The class number is actually the class's object number, which needs
1623 to be translated into its actual class number: */
1625 for (i=0;i<no_classes;i++)
1626 if (class_number == class_object_numbers[i])
1627 { class_number = i+1;
1631 /* Remember the inheritance list so that property inheritance can
1632 be sorted out later on, when the definition has been finished: */
1634 classes_to_inherit_from[no_classes_to_inherit_from++] = class_number;
1636 /* Inheriting attributes from the class at once: */
1641 |= properties_table[class_begins_at[class_number-1] - 6 + i];
1644 for (i=0; i<NUM_ATTR_BYTES; i++)
1645 full_object_g.atts[i]
1646 |= properties_table[class_begins_at[class_number-1]
1647 - NUM_ATTR_BYTES + i];
1651 static void classes_segment(void)
1653 /* Parse through the "class" part of an object/class definition:
1655 <class-1> ... <class-n> */
1658 { get_next_token_with_directives();
1659 if ((token_type == SEGMENT_MARKER_TT)
1660 || (token_type == EOF_TT)
1661 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1662 { put_token_back(); return;
1664 if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1666 if ((token_type != SYMBOL_TT)
1667 || (stypes[token_value] != CLASS_T))
1668 { ebf_error("name of an already-declared class", token_text);
1672 sflags[token_value] |= USED_SFLAG;
1673 add_class_to_inheritance_list(svals[token_value]);
1677 /* ------------------------------------------------------------------------- */
1678 /* Parse the body of a Nearby/Object/Class definition. */
1679 /* ------------------------------------------------------------------------- */
1681 static void parse_body_of_definition(void)
1682 { int commas_in_row;
1687 { commas_in_row = -1;
1689 { get_next_token_with_directives(); commas_in_row++;
1690 } while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
1692 if (commas_in_row>1)
1693 error("Two commas ',' in a row in object/class definition");
1695 if ((token_type == EOF_TT)
1696 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1697 { if (commas_in_row > 0)
1698 error("Object/class definition finishes with ','");
1699 if (token_type == EOF_TT)
1700 error("Object/class definition incomplete (no ';') at end of file");
1704 if (token_type != SEGMENT_MARKER_TT)
1705 { error_named("Expected 'with', 'has' or 'class' in \
1706 object/class definition but found", token_text);
1711 { case WITH_SEGMENT:
1712 properties_segment(WITH_SEGMENT);
1714 case PRIVATE_SEGMENT:
1715 properties_segment(PRIVATE_SEGMENT);
1718 attributes_segment();
1729 /* ------------------------------------------------------------------------- */
1730 /* Class directives: */
1732 /* Class <name> <body of definition> */
1733 /* ------------------------------------------------------------------------- */
1735 static void initialise_full_object(void)
1740 full_object.atts[0] = 0;
1741 full_object.atts[1] = 0;
1742 full_object.atts[2] = 0;
1743 full_object.atts[3] = 0;
1744 full_object.atts[4] = 0;
1745 full_object.atts[5] = 0;
1748 full_object_g.numprops = 0;
1749 full_object_g.propdatasize = 0;
1750 for (i=0; i<NUM_ATTR_BYTES; i++)
1751 full_object_g.atts[i] = 0;
1755 extern void make_class(char * metaclass_name)
1756 { int n, duplicates_to_make = 0, class_number = no_objects+1,
1757 metaclass_flag = (metaclass_name != NULL);
1758 char duplicate_name[128];
1759 debug_location_beginning beginning_debug_location =
1760 get_token_location_beginning();
1762 current_defn_is_class = TRUE; no_classes_to_inherit_from = 0;
1763 individual_prop_table_size = 0;
1765 if (no_classes==MAX_CLASSES)
1766 memoryerror("MAX_CLASSES", MAX_CLASSES);
1768 if (no_classes==VENEER_CONSTRAINT_ON_CLASSES)
1769 fatalerror("Inform's maximum possible number of classes (whatever \
1770 amount of memory is allocated) has been reached. If this causes serious \
1771 inconvenience, please contact the maintainers.");
1773 directives.enabled = FALSE;
1776 { token_text = metaclass_name;
1777 token_value = symbol_index(token_text, -1);
1778 token_type = SYMBOL_TT;
1782 if (token_type != SYMBOL_TT)
1783 { discard_token_location(beginning_debug_location);
1784 ebf_error("new class name", token_text);
1785 panic_mode_error_recovery();
1788 if (!(sflags[token_value] & UNKNOWN_SFLAG))
1789 { discard_token_location(beginning_debug_location);
1790 ebf_symbol_error("new class name", token_text, typename(stypes[token_value]), slines[token_value]);
1791 panic_mode_error_recovery();
1796 /* Each class also creates a modest object representing itself: */
1798 strcpy(shortname_buffer, token_text);
1800 assign_symbol(token_value, class_number, CLASS_T);
1801 classname_text = (char *) symbs[token_value];
1804 if (metaclass_flag) sflags[token_value] |= SYSTEM_SFLAG;
1807 /* In Glulx, metaclasses have to be backpatched too! So we can't
1808 mark it as "system", but we should mark it "used". */
1809 if (metaclass_flag) sflags[token_value] |= USED_SFLAG;
1812 /* "Class" (object 1) has no parent, whereas all other classes are
1813 the children of "Class". Since "Class" is not present in a module,
1814 a special value is used which is corrected to 1 by the linker. */
1816 if (metaclass_flag) parent_of_this_obj = 0;
1817 else parent_of_this_obj = (module_switch)?MAXINTWORD:1;
1819 class_object_numbers[no_classes] = class_number;
1821 initialise_full_object();
1823 /* Give the class the (nameless in Inform syntax) "inheritance" property
1824 with value its own class number. (This therefore accumulates onto
1825 the inheritance property of any object inheriting from the class,
1826 since property 2 is always set to "additive" -- see below) */
1830 full_object.pp[0].num = 2;
1831 full_object.pp[0].l = 1;
1832 full_object.pp[0].ao[0].value = no_objects + 1;
1833 full_object.pp[0].ao[0].type = LONG_CONSTANT_OT;
1834 full_object.pp[0].ao[0].marker = OBJECT_MV;
1837 full_object_g.numprops = 1;
1838 full_object_g.props[0].num = 2;
1839 full_object_g.props[0].flags = 0;
1840 full_object_g.props[0].datastart = 0;
1841 full_object_g.props[0].continuation = 0;
1842 full_object_g.props[0].datalen = 1;
1843 full_object_g.propdatasize = 1;
1844 full_object_g.propdata[0].value = no_objects + 1;
1845 full_object_g.propdata[0].type = CONSTANT_OT;
1846 full_object_g.propdata[0].marker = OBJECT_MV;
1849 if (!metaclass_flag)
1851 if ((token_type == SEP_TT) && (token_value == OPENB_SEP))
1852 { assembly_operand AO;
1853 AO = parse_expression(CONSTANT_CONTEXT);
1855 { error("Duplicate-number not known at compile time");
1860 if ((n<0) || (n>10000))
1861 { error("The number of duplicates must be 0 to 10000");
1865 /* Make one extra duplicate, since the veneer routines need
1866 always to keep an undamaged prototype for the class in stock */
1868 duplicates_to_make = n + 1;
1870 match_close_bracket();
1871 } else put_token_back();
1873 /* Parse the body of the definition: */
1875 parse_body_of_definition();
1878 if (debugfile_switch)
1879 { debug_file_printf("<class>");
1880 debug_file_printf("<identifier>%s</identifier>", shortname_buffer);
1881 debug_file_printf("<class-number>%d</class-number>", no_classes);
1882 debug_file_printf("<value>");
1883 write_debug_object_backpatch(no_objects + 1);
1884 debug_file_printf("</value>");
1885 write_debug_locations
1886 (get_token_location_end(beginning_debug_location));
1887 debug_file_printf("</class>");
1891 manufacture_object_z();
1893 manufacture_object_g();
1895 if (individual_prop_table_size >= VENEER_CONSTRAINT_ON_IP_TABLE_SIZE)
1896 error("This class is too complex: it now carries too many properties. \
1897 You may be able to get round this by declaring some of its property names as \
1898 \"common properties\" using the 'Property' directive.");
1900 if (duplicates_to_make > 0)
1901 { sprintf(duplicate_name, "%s_1", shortname_buffer);
1902 for (n=1; (duplicates_to_make--) > 0; n++)
1904 { int i = strlen(duplicate_name);
1905 while (duplicate_name[i] != '_') i--;
1906 sprintf(duplicate_name+i+1, "%d", n);
1908 make_object(FALSE, duplicate_name, class_number, class_number, -1);
1913 /* ------------------------------------------------------------------------- */
1914 /* Object/Nearby directives: */
1916 /* Object <name-1> ... <name-n> "short name" [parent] <body of def> */
1918 /* Nearby <name-1> ... <name-n> "short name" <body of definition> */
1919 /* ------------------------------------------------------------------------- */
1921 static int end_of_header(void)
1922 { if (((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1923 || ((token_type == SEP_TT) && (token_value == COMMA_SEP))
1924 || (token_type == SEGMENT_MARKER_TT)) return TRUE;
1928 extern void make_object(int nearby_flag,
1929 char *textual_name, int specified_parent, int specified_class,
1932 /* Ordinarily this is called with nearby_flag TRUE for "Nearby",
1933 FALSE for "Object"; and textual_name NULL, specified_parent and
1934 specified_class both -1. The next three arguments are used when
1935 the routine is called for class duplicates manufacture (see above).
1936 The last is used to create instances of a particular class. */
1938 int i, tree_depth, internal_name_symbol = 0;
1939 char internal_name[64];
1940 debug_location_beginning beginning_debug_location =
1941 get_token_location_beginning();
1943 directives.enabled = FALSE;
1945 if (no_objects==MAX_OBJECTS) memoryerror("MAX_OBJECTS", MAX_OBJECTS);
1947 sprintf(internal_name, "nameless_obj__%d", no_objects+1);
1948 objectname_text = internal_name;
1950 current_defn_is_class = FALSE;
1952 no_classes_to_inherit_from=0;
1954 individual_prop_table_size = 0;
1956 if (nearby_flag) tree_depth=1; else tree_depth=0;
1958 if (specified_class != -1) goto HeaderPassed;
1962 /* Read past and count a sequence of "->"s, if any are present */
1964 if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
1966 error("The syntax '->' is only used as an alternative to 'Nearby'");
1968 while ((token_type == SEP_TT) && (token_value == ARROW_SEP))
1974 sprintf(shortname_buffer, "?");
1976 segment_markers.enabled = TRUE;
1978 /* This first word is either an internal name, or a textual short name,
1979 or the end of the header part */
1981 if (end_of_header()) goto HeaderPassed;
1983 if (token_type == DQ_TT) textual_name = token_text;
1985 { if (token_type != SYMBOL_TT) {
1986 ebf_error("name for new object or its textual short name",
1989 else if (!(sflags[token_value] & UNKNOWN_SFLAG)) {
1990 ebf_symbol_error("new object", token_text, typename(stypes[token_value]), slines[token_value]);
1993 { internal_name_symbol = token_value;
1994 strcpy(internal_name, token_text);
1998 /* The next word is either a parent object, or
1999 a textual short name, or the end of the header part */
2001 get_next_token_with_directives();
2002 if (end_of_header()) goto HeaderPassed;
2004 if (token_type == DQ_TT)
2005 { if (textual_name != NULL)
2006 error("Two textual short names given for only one object");
2008 textual_name = token_text;
2011 { if ((token_type != SYMBOL_TT)
2012 || (sflags[token_value] & UNKNOWN_SFLAG))
2013 { if (textual_name == NULL)
2014 ebf_error("parent object or the object's textual short name",
2017 ebf_error("parent object", token_text);
2019 else goto SpecParent;
2022 /* Finally, it's possible that there is still a parent object */
2025 if (end_of_header()) goto HeaderPassed;
2027 if (specified_parent != -1)
2028 ebf_error("body of object definition", token_text);
2031 if ((stypes[token_value] == OBJECT_T)
2032 || (stypes[token_value] == CLASS_T))
2033 { specified_parent = svals[token_value];
2034 sflags[token_value] |= USED_SFLAG;
2036 else ebf_error("name of (the parent) object", token_text);
2039 /* Now it really has to be the body of the definition. */
2041 get_next_token_with_directives();
2042 if (end_of_header()) goto HeaderPassed;
2044 ebf_error("body of object definition", token_text);
2047 if (specified_class == -1) put_token_back();
2049 if (internal_name_symbol > 0)
2050 assign_symbol(internal_name_symbol, no_objects + 1, OBJECT_T);
2052 if (listobjects_switch)
2053 printf("%3d \"%s\"\n", no_objects+1,
2054 (textual_name==NULL)?"(with no short name)":textual_name);
2055 if (textual_name == NULL)
2056 { if (internal_name_symbol > 0)
2057 sprintf(shortname_buffer, "(%s)",
2058 (char *) symbs[internal_name_symbol]);
2060 sprintf(shortname_buffer, "(%d)", no_objects+1);
2063 { if (strlen(textual_name)>765)
2064 error("Short name of object (in quotes) exceeded 765 characters");
2065 strncpy(shortname_buffer, textual_name, 765);
2068 if (specified_parent != -1)
2069 { if (tree_depth > 0)
2070 error("Use of '->' (or 'Nearby') clashes with giving a parent");
2071 parent_of_this_obj = specified_parent;
2074 { parent_of_this_obj = 0;
2077 /* We have to set the parent object to the most recently defined
2078 object at level (tree_depth - 1) in the tree.
2080 A complication is that objects are numbered 1, 2, ... in the
2081 Z-machine (and in the objects[].parent, etc., fields) but
2082 0, 1, 2, ... internally (and as indices to object[]). */
2084 for (i=no_objects-1; i>=0; i--)
2087 /* Metaclass or class objects cannot be '->' parents: */
2088 if ((!module_switch) && (i<4))
2092 if (objectsz[i].parent == 1)
2094 while (objectsz[j].parent != 0)
2095 { j = objectsz[j].parent - 1; k++; }
2098 if (objectsg[i].parent == 1)
2100 while (objectsg[j].parent != 0)
2101 { j = objectsg[j].parent - 1; k++; }
2104 if (k == tree_depth - 1)
2105 { parent_of_this_obj = i+1;
2109 if (parent_of_this_obj == 0)
2110 { if (tree_depth == 1)
2111 error("'->' (or 'Nearby') fails because there is no previous object");
2113 error("'-> -> ...' fails because no previous object is deep enough");
2118 initialise_full_object();
2119 if (instance_of != -1) add_class_to_inheritance_list(instance_of);
2121 if (specified_class == -1) parse_body_of_definition();
2122 else add_class_to_inheritance_list(specified_class);
2124 if (debugfile_switch)
2125 { debug_file_printf("<object>");
2126 if (internal_name_symbol > 0)
2127 { debug_file_printf("<identifier>%s</identifier>", internal_name);
2130 ("<identifier artificial=\"true\">%s</identifier>",
2133 debug_file_printf("<value>");
2134 write_debug_object_backpatch(no_objects + 1);
2135 debug_file_printf("</value>");
2136 write_debug_locations
2137 (get_token_location_end(beginning_debug_location));
2138 debug_file_printf("</object>");
2142 manufacture_object_z();
2144 manufacture_object_g();
2147 /* ========================================================================= */
2148 /* Data structure management routines */
2149 /* ------------------------------------------------------------------------- */
2151 extern void init_objects_vars(void)
2153 properties_table = NULL;
2154 prop_is_long = NULL;
2155 prop_is_additive = NULL;
2156 prop_default_value = NULL;
2161 classes_to_inherit_from = NULL;
2162 class_begins_at = NULL;
2165 extern void objects_begin_pass(void)
2167 properties_table_size=0;
2168 prop_is_long[1] = TRUE; prop_is_additive[1] = TRUE; /* "name" */
2169 prop_is_long[2] = TRUE; prop_is_additive[2] = TRUE; /* inheritance prop */
2171 prop_is_long[3] = TRUE; prop_is_additive[3] = FALSE;
2172 /* instance variables table address */
2175 if (debugfile_switch)
2176 { debug_file_printf("<property>");
2178 ("<identifier artificial=\"true\">inheritance class</identifier>");
2179 debug_file_printf("<value>2</value>");
2180 debug_file_printf("</property>");
2181 debug_file_printf("<property>");
2183 ("<identifier artificial=\"true\">instance variables table address "
2184 "(Z-code)</identifier>");
2185 debug_file_printf("<value>3</value>");
2186 debug_file_printf("</property>");
2189 if (define_INFIX_switch) no_attributes = 1;
2190 else no_attributes = 0;
2194 objectsz[0].parent = 0; objectsz[0].child = 0; objectsz[0].next = 0;
2195 no_individual_properties=72;
2198 objectsg[0].parent = 0; objectsg[0].child = 0; objectsg[0].next = 0;
2199 no_individual_properties = INDIV_PROP_START+8;
2203 no_embedded_routines = 0;
2205 individuals_length=0;
2208 extern void objects_allocate_arrays(void)
2214 prop_default_value = my_calloc(sizeof(int32), INDIV_PROP_START,
2215 "property default values");
2216 prop_is_long = my_calloc(sizeof(int), INDIV_PROP_START,
2217 "property-is-long flags");
2218 prop_is_additive = my_calloc(sizeof(int), INDIV_PROP_START,
2219 "property-is-additive flags");
2221 classes_to_inherit_from = my_calloc(sizeof(int), MAX_CLASSES,
2222 "inherited classes list");
2223 class_begins_at = my_calloc(sizeof(int32), MAX_CLASSES,
2224 "pointers to classes");
2225 class_object_numbers = my_calloc(sizeof(int), MAX_CLASSES,
2226 "class object numbers");
2228 properties_table = my_malloc(MAX_PROP_TABLE_SIZE,"properties table");
2229 individuals_table = my_malloc(MAX_INDIV_PROP_TABLE_SIZE,
2230 "individual properties table");
2232 defined_this_segment_size = 128;
2233 defined_this_segment = my_calloc(sizeof(int), defined_this_segment_size,
2234 "defined this segment table");
2237 objectsz = my_calloc(sizeof(objecttz), MAX_OBJECTS,
2241 objectsg = my_calloc(sizeof(objecttg), MAX_OBJECTS,
2243 objectatts = my_calloc(NUM_ATTR_BYTES, MAX_OBJECTS,
2245 full_object_g.props = my_calloc(sizeof(propg), MAX_OBJ_PROP_COUNT,
2246 "object property list");
2247 full_object_g.propdata = my_calloc(sizeof(assembly_operand),
2248 MAX_OBJ_PROP_TABLE_SIZE,
2249 "object property data table");
2253 extern void objects_free_arrays(void)
2255 my_free(&prop_default_value, "property default values");
2256 my_free(&prop_is_long, "property-is-long flags");
2257 my_free(&prop_is_additive, "property-is-additive flags");
2259 my_free(&objectsz, "z-objects");
2260 my_free(&objectsg, "g-objects");
2261 my_free(&objectatts, "g-attributes");
2262 my_free(&class_object_numbers,"class object numbers");
2263 my_free(&classes_to_inherit_from, "inherited classes list");
2264 my_free(&class_begins_at, "pointers to classes");
2266 my_free(&properties_table, "properties table");
2267 my_free(&individuals_table,"individual properties table");
2269 my_free(&defined_this_segment,"defined this segment table");
2272 my_free(&full_object_g.props, "object property list");
2273 my_free(&full_object_g.propdata, "object property data table");
2278 /* ========================================================================= */