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 /* Copyright (c) Graham Nelson 1993 - 2016 */
11 /* This file is part of Inform. */
13 /* Inform is free software: you can redistribute it and/or modify */
14 /* it under the terms of the GNU General Public License as published by */
15 /* the Free Software Foundation, either version 3 of the License, or */
16 /* (at your option) any later version. */
18 /* Inform is distributed in the hope that it will be useful, */
19 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
20 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
21 /* GNU General Public License for more details. */
23 /* You should have received a copy of the GNU General Public License */
24 /* along with Inform. If not, see https://gnu.org/licenses/ */
26 /* ------------------------------------------------------------------------- */
30 /* ------------------------------------------------------------------------- */
32 /* ------------------------------------------------------------------------- */
34 int no_objects; /* Number of objects made so far */
36 static int no_embedded_routines; /* Used for naming routines which
37 are given as property values: these
38 are called EmbeddedRoutine__1, ... */
40 static fpropt full_object; /* "fpropt" is a typedef for a struct
41 containing an array to hold the
42 attribute and property values of
43 a single object. We only keep one
44 of these, for the current object
45 being made, and compile it into
46 Z-machine tables when each object
47 definition is complete, since
48 sizeof(fpropt) is about 6200 bytes */
49 static fproptg full_object_g; /* Equivalent for Glulx. This object
50 is very small, since the large arrays
51 are allocated dynamically by the
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 char *classname_text, *objectname_text;
59 /* For printing names of embedded
62 /* ------------------------------------------------------------------------- */
64 /* ------------------------------------------------------------------------- */
65 /* Arrays defined below: */
67 /* int32 class_begins_at[n] offset of properties block for */
68 /* nth class (always an offset */
69 /* inside the properties_table) */
70 /* int classes_to_inherit_from[] The list of classes to inherit */
71 /* from as taken from the current */
72 /* Nearby/Object/Class definition */
73 /* int class_object_numbers[n] The number of the prototype-object */
74 /* for the nth class */
75 /* ------------------------------------------------------------------------- */
77 int no_classes; /* Number of class defns made so far */
79 static int current_defn_is_class, /* TRUE if current Nearby/Object/Class
80 defn is in fact a Class definition */
81 no_classes_to_inherit_from; /* Number of classes in the list
82 of classes to inherit in the
83 current Nearby/Object/Class defn */
85 /* ------------------------------------------------------------------------- */
86 /* Making attributes and properties. */
87 /* ------------------------------------------------------------------------- */
89 int no_attributes, /* Number of attributes defined so far */
90 no_properties; /* Number of properties defined so far,
91 plus 1 (properties are numbered from
92 1 and Inform creates "name" and two
93 others itself, so the variable begins
94 the compilation pass set to 4) */
96 static void trace_s(char *name, int32 number, int f)
97 { if (!printprops_switch) return;
98 printf("%s %02ld ",(f==0)?"Attr":"Prop",(long int) number);
99 if (f==0) printf(" ");
100 else printf("%s%s",(prop_is_long[number])?"L":" ",
101 (prop_is_additive[number])?"A":" ");
102 printf(" %s\n",name);
105 extern void make_attribute(void)
107 debug_location_beginning beginning_debug_location =
108 get_token_location_beginning();
111 if (no_attributes==((version_number==3)?32:48))
112 { discard_token_location(beginning_debug_location);
113 if (version_number==3)
114 error("All 32 attributes already declared (compile as Advanced \
115 game to get an extra 16)");
117 error("All 48 attributes already declared");
118 panic_mode_error_recovery();
124 if (no_attributes==NUM_ATTR_BYTES*8) {
125 discard_token_location(beginning_debug_location);
127 "All attributes already declared -- increase NUM_ATTR_BYTES to use \
130 panic_mode_error_recovery();
137 i = token_value; name = token_text;
138 if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG)))
139 { discard_token_location(beginning_debug_location);
140 ebf_error("new attribute name", token_text);
141 panic_mode_error_recovery();
146 directive_keywords.enabled = TRUE;
148 directive_keywords.enabled = FALSE;
150 if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK))
152 if (!((token_type == SYMBOL_TT)
153 && (stypes[token_value] == ATTRIBUTE_T)))
154 { discard_token_location(beginning_debug_location);
155 ebf_error("an existing attribute name after 'alias'",
157 panic_mode_error_recovery();
161 assign_symbol(i, svals[token_value], ATTRIBUTE_T);
162 sflags[token_value] |= ALIASED_SFLAG;
163 sflags[i] |= ALIASED_SFLAG;
166 { assign_symbol(i, no_attributes++, ATTRIBUTE_T);
170 if (debugfile_switch)
171 { debug_file_printf("<attribute>");
172 debug_file_printf("<identifier>%s</identifier>", name);
173 debug_file_printf("<value>%d</value>", svals[i]);
174 write_debug_locations(get_token_location_end(beginning_debug_location));
175 debug_file_printf("</attribute>");
178 trace_s(name, svals[i], 0);
182 extern void make_property(void)
183 { int32 default_value, i;
184 int additive_flag=FALSE; char *name;
186 debug_location_beginning beginning_debug_location =
187 get_token_location_beginning();
190 if (no_properties==((version_number==3)?32:64))
191 { discard_token_location(beginning_debug_location);
192 if (version_number==3)
193 error("All 30 properties already declared (compile as \
194 Advanced game to get an extra 62)");
196 error("All 62 properties already declared");
197 panic_mode_error_recovery();
203 /* INDIV_PROP_START could be a memory setting */
204 if (no_properties==INDIV_PROP_START) {
205 discard_token_location(beginning_debug_location);
206 error_numbered("All properties already declared -- max is",
208 panic_mode_error_recovery();
215 { directive_keywords.enabled = TRUE;
217 if ((token_type == DIR_KEYWORD_TT) && (token_value == LONG_DK))
218 obsolete_warning("all properties are now automatically 'long'");
220 if ((token_type == DIR_KEYWORD_TT) && (token_value == ADDITIVE_DK))
221 additive_flag = TRUE;
226 directive_keywords.enabled = FALSE;
229 i = token_value; name = token_text;
230 if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG)))
231 { discard_token_location(beginning_debug_location);
232 ebf_error("new property name", token_text);
233 panic_mode_error_recovery();
238 directive_keywords.enabled = TRUE;
240 directive_keywords.enabled = FALSE;
242 if (strcmp(name+strlen(name)-3, "_to") == 0) sflags[i] |= STAR_SFLAG;
244 if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK))
245 { discard_token_location(beginning_debug_location);
247 { error("'alias' incompatible with 'additive'");
248 panic_mode_error_recovery();
253 if (!((token_type == SYMBOL_TT)
254 && (stypes[token_value] == PROPERTY_T)))
255 { ebf_error("an existing property name after 'alias'",
257 panic_mode_error_recovery();
262 assign_symbol(i, svals[token_value], PROPERTY_T);
263 trace_s(name, svals[i], 1);
264 sflags[token_value] |= ALIASED_SFLAG;
265 sflags[i] |= ALIASED_SFLAG;
272 if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
273 { AO = parse_expression(CONSTANT_CONTEXT);
274 default_value = AO.value;
276 backpatch_zmachine(AO.marker, PROP_DEFAULTS_ZA,
277 (no_properties-1) * WORDSIZE);
280 prop_default_value[no_properties] = default_value;
281 prop_is_long[no_properties] = TRUE;
282 prop_is_additive[no_properties] = additive_flag;
284 assign_symbol(i, no_properties++, PROPERTY_T);
286 if (debugfile_switch)
287 { debug_file_printf("<property>");
288 debug_file_printf("<identifier>%s</identifier>", name);
289 debug_file_printf("<value>%d</value>", svals[i]);
290 write_debug_locations
291 (get_token_location_end(beginning_debug_location));
292 debug_file_printf("</property>");
295 trace_s(name, svals[i], 1);
298 /* ------------------------------------------------------------------------- */
300 /* ------------------------------------------------------------------------- */
302 int32 *prop_default_value; /* Default values for properties */
303 int *prop_is_long, /* Property modifiers, TRUE or FALSE:
304 "long" means "never write a 1-byte
305 value to this property", and is an
306 obsolete feature: since Inform 5
307 all properties have been "long" */
308 *prop_is_additive; /* "additive" means that values
309 accumulate rather than erase each
310 other during class inheritance */
311 char *properties_table; /* Holds the table of property values
312 (holding one block for each object
313 and coming immediately after the
314 object tree in Z-memory) */
315 int properties_table_size; /* Number of bytes in this table */
317 /* ------------------------------------------------------------------------- */
318 /* Individual properties */
320 /* Each new i.p. name is given a unique number. These numbers start from */
321 /* 72, since 0 is reserved as a null, 1 to 63 refer to common properties */
322 /* and 64 to 71 are kept for methods of the metaclass Class (for example, */
323 /* 64 is "create"). */
325 /* An object provides individual properties by having property 3 set to a */
326 /* non-zero value, which must be a byte address of a table in the form: */
328 /* <record-1> ... <record-n> 00 00 */
330 /* where a <record> looks like */
332 /* <identifier> <size> <up to 255 bytes of data> */
333 /* or <identifier + 0x8000> */
334 /* ----- 2 bytes ---------- 1 byte <size> number of bytes */
336 /* The <identifier> part is the number allocated to the name of what is */
337 /* being provided. The top bit of this word is set to indicate that */
338 /* although the individual property is being provided, it is provided */
339 /* only privately (so that it is inaccessible except to the object's own */
340 /* embedded routines). */
342 /* In Glulx: i-props are numbered from INDIV_PROP_START+8 up. And all */
343 /* properties, common and individual, are stored in the same table. */
344 /* ------------------------------------------------------------------------- */
346 int no_individual_properties; /* Actually equal to the next
347 identifier number to be allocated,
348 so this is initially 72 even though
349 none have been made yet. */
350 static int individual_prop_table_size; /* Size of the table of individual
351 properties so far for current obj */
352 uchar *individuals_table; /* Table of records, each being the
353 i.p. table for an object */
354 int i_m; /* Write mark position in the above */
355 int individuals_length; /* Extent of individuals_table */
357 /* ------------------------------------------------------------------------- */
358 /* Arrays used by this file */
359 /* ------------------------------------------------------------------------- */
361 objecttz *objectsz; /* Z-code only */
362 objecttg *objectsg; /* Glulx only */
363 uchar *objectatts; /* Glulx only */
364 static int *classes_to_inherit_from;
365 int *class_object_numbers;
366 int32 *class_begins_at;
369 /* ------------------------------------------------------------------------- */
370 /* Tracing for compiler maintenance */
371 /* ------------------------------------------------------------------------- */
373 extern void list_object_tree(void)
375 printf("obj par nxt chl Object tree:\n");
376 for (i=0; i<no_objects; i++)
377 printf("%3d %3d %3d %3d\n",
378 i+1,objectsz[i].parent,objectsz[i].next, objectsz[i].child);
381 /* ------------------------------------------------------------------------- */
382 /* Object and class manufacture begins here. */
384 /* These definitions have headers (parsed far, far below) and a series */
385 /* of segments, introduced by keywords and optionally separated by commas. */
386 /* Each segment has its own parsing routine. Note that when errors are */
387 /* detected, parsing continues rather than being abandoned, which assists */
388 /* a little in "error recovery" (i.e. in stopping lots more errors being */
389 /* produced for essentially the same mistake). */
390 /* ------------------------------------------------------------------------- */
392 /* ========================================================================= */
393 /* [1] The object-maker: builds an object from a specification, viz.: */
396 /* shortname_buffer, */
397 /* parent_of_this_obj, */
398 /* current_defn_is_class (flag) */
399 /* classes_to_inherit_from[], no_classes_to_inherit_from, */
400 /* individual_prop_table_size (to date ) */
402 /* For efficiency's sake, the individual properties table has already been */
403 /* created (as far as possible, i.e., all except for inherited individual */
404 /* properties); unless the flag is clear, in which case the actual */
405 /* definition did not specify any individual properties. */
406 /* ========================================================================= */
407 /* Property inheritance from classes. */
408 /* ------------------------------------------------------------------------- */
410 static void property_inheritance_z(void)
412 /* Apply the property inheritance rules to full_object, which should
413 initially be complete (i.e., this routine takes place after the whole
414 Nearby/Object/Class definition has been parsed through).
416 On exit, full_object contains the final state of the properties to
419 int i, j, k, kmax, class, mark,
420 prop_number, prop_length, prop_in_current_defn;
421 uchar *class_prop_block;
425 for (class=0; class<no_classes_to_inherit_from; class++)
428 mark = class_begins_at[classes_to_inherit_from[class]-1];
429 class_prop_block = (uchar *) (properties_table + mark);
431 while (class_prop_block[j]!=0)
432 { if (version_number == 3)
433 { prop_number = class_prop_block[j]%32;
434 prop_length = 1 + class_prop_block[j++]/32;
437 { prop_number = class_prop_block[j]%64;
438 prop_length = 1 + class_prop_block[j++]/64;
440 prop_length = class_prop_block[j++]%64;
443 /* So we now have property number prop_number present in the
444 property block for the class being read: its bytes are
446 class_prop_block[j, ..., j + prop_length - 1]
448 Question now is: is there already a value given in the
449 current definition under this property name? */
451 prop_in_current_defn = FALSE;
453 kmax = full_object.l;
455 for (k=0; k<kmax; k++)
456 if (full_object.pp[k].num == prop_number)
457 { prop_in_current_defn = TRUE;
459 /* (Note that the built-in "name" property is additive) */
461 if ((prop_number==1) || (prop_is_additive[prop_number]))
463 /* The additive case: we accumulate the class
464 property values onto the end of the full_object
467 for (i=full_object.pp[k].l;
468 i<full_object.pp[k].l+prop_length/2; i++)
470 { error("An additive property has inherited \
471 so many values that the list has overflowed the maximum 32 entries");
474 full_object.pp[k].ao[i].value = mark + j;
476 full_object.pp[k].ao[i].marker = INHERIT_MV;
477 full_object.pp[k].ao[i].type = LONG_CONSTANT_OT;
479 full_object.pp[k].l += prop_length/2;
482 /* The ordinary case: the full_object property
483 values simply overrides the class definition,
484 so we skip over the values in the class table */
489 { int y, z, class_block_offset;
492 /* Property 3 holds the address of the table of
493 instance variables, so this is the case where
494 the object already has instance variables in its
495 own table but must inherit some more from the
498 class_block_offset = class_prop_block[j-2]*256
499 + class_prop_block[j-1];
501 p = individuals_table + class_block_offset;
502 z = class_block_offset;
503 while ((p[0]!=0)||(p[1]!=0))
504 { int already_present = FALSE, l;
505 for (l = full_object.pp[k].ao[0].value; l < i_m;
506 l = l + 3 + individuals_table[l + 2])
507 if (individuals_table[l] == p[0]
508 && individuals_table[l + 1] == p[1])
509 { already_present = TRUE; break;
511 if (already_present == FALSE)
513 backpatch_zmachine(IDENT_MV,
514 INDIVIDUAL_PROP_ZA, i_m);
515 if (i_m+3+p[2] > MAX_INDIV_PROP_TABLE_SIZE)
516 memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
517 MAX_INDIV_PROP_TABLE_SIZE);
518 individuals_table[i_m++] = p[0];
519 individuals_table[i_m++] = p[1];
520 individuals_table[i_m++] = p[2];
521 for (y=0;y < p[2]/2;y++)
522 { individuals_table[i_m++] = (z+3+y*2)/256;
523 individuals_table[i_m++] = (z+3+y*2)%256;
524 backpatch_zmachine(INHERIT_INDIV_MV,
525 INDIVIDUAL_PROP_ZA, i_m-2);
531 individuals_length = i_m;
534 /* For efficiency we exit the loop now (this property
535 number has been dealt with) */
540 if (!prop_in_current_defn)
542 /* The case where the class defined a property which wasn't
543 defined at all in full_object: we copy out the data into
544 a new property added to full_object */
547 full_object.pp[k].num = prop_number;
548 full_object.pp[k].l = prop_length/2;
549 for (i=0; i<prop_length/2; i++)
550 { full_object.pp[k].ao[i].value = mark + j;
552 full_object.pp[k].ao[i].marker = INHERIT_MV;
553 full_object.pp[k].ao[i].type = LONG_CONSTANT_OT;
557 { int y, z, class_block_offset;
560 /* Property 3 holds the address of the table of
561 instance variables, so this is the case where
562 the object had no instance variables of its own
563 but must inherit some more from the class */
565 if (individual_prop_table_size++ == 0)
566 { full_object.pp[k].num = 3;
567 full_object.pp[k].l = 1;
568 full_object.pp[k].ao[0].value
569 = individuals_length;
570 full_object.pp[k].ao[0].marker = INDIVPT_MV;
571 full_object.pp[k].ao[0].type = LONG_CONSTANT_OT;
572 i_m = individuals_length;
574 class_block_offset = class_prop_block[j-2]*256
575 + class_prop_block[j-1];
577 p = individuals_table + class_block_offset;
578 z = class_block_offset;
579 while ((p[0]!=0)||(p[1]!=0))
581 backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
582 if (i_m+3+p[2] > MAX_INDIV_PROP_TABLE_SIZE)
583 memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
584 MAX_INDIV_PROP_TABLE_SIZE);
585 individuals_table[i_m++] = p[0];
586 individuals_table[i_m++] = p[1];
587 individuals_table[i_m++] = p[2];
588 for (y=0;y < p[2]/2;y++)
589 { individuals_table[i_m++] = (z+3+y*2)/256;
590 individuals_table[i_m++] = (z+3+y*2)%256;
591 backpatch_zmachine(INHERIT_INDIV_MV,
592 INDIVIDUAL_PROP_ZA, i_m-2);
597 individuals_length = i_m;
603 if (individual_prop_table_size > 0)
605 if (i_m+2 > MAX_INDIV_PROP_TABLE_SIZE)
606 memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
607 MAX_INDIV_PROP_TABLE_SIZE);
609 individuals_table[i_m++] = 0;
610 individuals_table[i_m++] = 0;
611 individuals_length += 2;
615 static void property_inheritance_g(void)
617 /* Apply the property inheritance rules to full_object, which should
618 initially be complete (i.e., this routine takes place after the whole
619 Nearby/Object/Class definition has been parsed through).
621 On exit, full_object contains the final state of the properties to
624 int i, j, k, class, num_props,
625 prop_number, prop_length, prop_flags, prop_in_current_defn;
626 int32 mark, prop_addr;
631 for (class=0; class<no_classes_to_inherit_from; class++) {
632 mark = class_begins_at[classes_to_inherit_from[class]-1];
633 cpb = (uchar *) (properties_table + mark);
634 /* This now points to the compiled property-table for the class.
635 We'll have to go through and decompile it. (For our sins.) */
636 num_props = ReadInt32(cpb);
637 for (j=0; j<num_props; j++) {
639 prop_number = ReadInt16(pe);
641 prop_length = ReadInt16(pe);
643 prop_addr = ReadInt32(pe);
645 prop_flags = ReadInt16(pe);
648 /* So we now have property number prop_number present in the
649 property block for the class being read. Its bytes are
650 cpb[prop_addr ... prop_addr + prop_length - 1]
651 Question now is: is there already a value given in the
652 current definition under this property name? */
654 prop_in_current_defn = FALSE;
656 for (k=0; k<full_object_g.numprops; k++) {
657 if (full_object_g.props[k].num == prop_number) {
658 prop_in_current_defn = TRUE;
663 if (prop_in_current_defn) {
665 || (prop_number < INDIV_PROP_START
666 && prop_is_additive[prop_number])) {
667 /* The additive case: we accumulate the class
668 property values onto the end of the full_object
669 properties. Remember that k is still the index number
670 of the first prop-block matching our property number. */
672 if (full_object_g.props[k].continuation == 0) {
673 full_object_g.props[k].continuation = 1;
677 prevcont = full_object_g.props[k].continuation;
678 for (k++; k<full_object_g.numprops; k++) {
679 if (full_object_g.props[k].num == prop_number) {
680 prevcont = full_object_g.props[k].continuation;
684 k = full_object_g.numprops++;
685 full_object_g.props[k].num = prop_number;
686 full_object_g.props[k].flags = 0;
687 full_object_g.props[k].datastart = full_object_g.propdatasize;
688 full_object_g.props[k].continuation = prevcont+1;
689 full_object_g.props[k].datalen = prop_length;
690 if (full_object_g.propdatasize + prop_length
691 > MAX_OBJ_PROP_TABLE_SIZE) {
692 memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
695 for (i=0; i<prop_length; i++) {
696 int ppos = full_object_g.propdatasize++;
697 full_object_g.propdata[ppos].value = prop_addr + 4*i;
698 full_object_g.propdata[ppos].marker = INHERIT_MV;
699 full_object_g.propdata[ppos].type = CONSTANT_OT;
703 /* The ordinary case: the full_object_g property
704 values simply overrides the class definition,
705 so we skip over the values in the class table. */
709 /* The case where the class defined a property which wasn't
710 defined at all in full_object_g: we copy out the data into
711 a new property added to full_object_g. */
712 k = full_object_g.numprops++;
713 full_object_g.props[k].num = prop_number;
714 full_object_g.props[k].flags = prop_flags;
715 full_object_g.props[k].datastart = full_object_g.propdatasize;
716 full_object_g.props[k].continuation = 0;
717 full_object_g.props[k].datalen = prop_length;
718 if (full_object_g.propdatasize + prop_length
719 > MAX_OBJ_PROP_TABLE_SIZE) {
720 memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
723 for (i=0; i<prop_length; i++) {
724 int ppos = full_object_g.propdatasize++;
725 full_object_g.propdata[ppos].value = prop_addr + 4*i;
726 full_object_g.propdata[ppos].marker = INHERIT_MV;
727 full_object_g.propdata[ppos].type = CONSTANT_OT;
731 if (full_object_g.numprops == MAX_OBJ_PROP_COUNT) {
732 memoryerror("MAX_OBJ_PROP_COUNT",MAX_OBJ_PROP_COUNT);
739 /* ------------------------------------------------------------------------- */
740 /* Construction of Z-machine-format property blocks. */
741 /* ------------------------------------------------------------------------- */
743 static int write_properties_between(uchar *p, int mark, int from, int to)
744 { int j, k, prop_number, prop_length;
745 /* Note that p is properties_table. */
746 for (prop_number=to; prop_number>=from; prop_number--)
747 { for (j=0; j<full_object.l; j++)
748 { if ((full_object.pp[j].num == prop_number)
749 && (full_object.pp[j].l != 100))
750 { prop_length = 2*full_object.pp[j].l;
751 if (mark+2+prop_length >= MAX_PROP_TABLE_SIZE)
752 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
753 if (version_number == 3)
754 p[mark++] = prop_number + (prop_length - 1)*32;
756 { switch(prop_length)
758 p[mark++] = prop_number; break;
760 p[mark++] = prop_number + 0x40; break;
762 p[mark++] = prop_number + 0x80;
763 p[mark++] = prop_length + 0x80; break;
767 for (k=0; k<full_object.pp[j].l; k++)
768 { if (full_object.pp[j].ao[k].marker != 0)
769 backpatch_zmachine(full_object.pp[j].ao[k].marker,
771 p[mark++] = full_object.pp[j].ao[k].value/256;
772 p[mark++] = full_object.pp[j].ao[k].value%256;
782 static int write_property_block_z(char *shortname)
784 /* Compile the (now complete) full_object properties into a
785 property-table block at "p" in Inform's memory.
786 "shortname" is the object's short name, if specified; otherwise
789 Return the number of bytes written to the block. */
791 int32 mark = properties_table_size, i;
792 uchar *p = (uchar *) properties_table;
794 /* printf("Object at %04x\n", mark); */
796 if (shortname != NULL)
798 if (mark+1+510 >= MAX_PROP_TABLE_SIZE)
799 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
800 tmp = translate_text(p+mark+1,p+mark+1+510,shortname);
801 if (!tmp) error ("Short name of object exceeded 765 Z-characters");
802 i = subtract_pointers(tmp,(p+mark+1));
806 if (current_defn_is_class)
807 { mark = write_properties_between(p,mark,3,3);
809 p[mark++] = full_object.atts[i];
810 class_begins_at[no_classes++] = mark;
813 mark = write_properties_between(p, mark, 1, (version_number==3)?31:63);
815 i = mark - properties_table_size;
816 properties_table_size = mark;
821 static int gpropsort(void *ptr1, void *ptr2)
826 if (prop2->num == -1)
828 if (prop1->num == -1)
830 if (prop1->num < prop2->num)
832 if (prop1->num > prop2->num)
835 return (prop1->continuation - prop2->continuation);
838 static int32 write_property_block_g(void)
840 /* Compile the (now complete) full_object properties into a
841 property-table block at "p" in Inform's memory.
842 Return the number of bytes written to the block.
843 In Glulx, the shortname property isn't used here; it's already
844 been compiled into an ordinary string. */
847 int ix, jx, kx, totalprops;
848 int32 mark = properties_table_size;
850 uchar *p = (uchar *) properties_table;
852 if (current_defn_is_class) {
853 for (i=0;i<NUM_ATTR_BYTES;i++)
854 p[mark++] = full_object_g.atts[i];
855 class_begins_at[no_classes++] = mark;
858 qsort(full_object_g.props, full_object_g.numprops, sizeof(propg),
859 (int (*)(const void *, const void *))(&gpropsort));
861 full_object_g.finalpropaddr = mark;
865 for (ix=0; ix<full_object_g.numprops; ix=jx) {
866 int propnum = full_object_g.props[ix].num;
870 jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
875 /* Write out the number of properties in this table. */
876 if (mark+4 >= MAX_PROP_TABLE_SIZE)
877 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
878 WriteInt32(p+mark, totalprops);
881 datamark = mark + 10*totalprops;
883 for (ix=0; ix<full_object_g.numprops; ix=jx) {
884 int propnum = full_object_g.props[ix].num;
885 int flags = full_object_g.props[ix].flags;
887 int32 datamarkstart = datamark;
891 jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
893 int32 datastart = full_object_g.props[jx].datastart;
894 if (datamark+4*full_object_g.props[jx].datalen >= MAX_PROP_TABLE_SIZE)
895 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
896 for (kx=0; kx<full_object_g.props[jx].datalen; kx++) {
897 int32 val = full_object_g.propdata[datastart+kx].value;
898 WriteInt32(p+datamark, val);
899 if (full_object_g.propdata[datastart+kx].marker != 0)
900 backpatch_zmachine(full_object_g.propdata[datastart+kx].marker,
906 if (mark+10 >= MAX_PROP_TABLE_SIZE)
907 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
908 WriteInt16(p+mark, propnum);
910 WriteInt16(p+mark, totallen);
912 WriteInt32(p+mark, datamarkstart);
914 WriteInt16(p+mark, flags);
920 i = mark - properties_table_size;
921 properties_table_size = mark;
925 /* ------------------------------------------------------------------------- */
926 /* The final stage in Nearby/Object/Class definition processing. */
927 /* ------------------------------------------------------------------------- */
929 static void manufacture_object_z(void)
932 segment_markers.enabled = FALSE;
933 directives.enabled = TRUE;
935 property_inheritance_z();
937 objectsz[no_objects].parent = parent_of_this_obj;
938 objectsz[no_objects].next = 0;
939 objectsz[no_objects].child = 0;
941 if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fff))
942 { i = objectsz[parent_of_this_obj-1].child;
944 objectsz[parent_of_this_obj-1].child = no_objects + 1;
946 { while(objectsz[i-1].next != 0) i = objectsz[i-1].next;
947 objectsz[i-1].next = no_objects+1;
951 /* The properties table consists simply of a sequence of property
952 blocks, one for each object in order of definition, exactly as
953 it will appear in the final Z-machine. */
955 j = write_property_block_z(shortname_buffer);
957 objectsz[no_objects].propsize = j;
958 if (properties_table_size >= MAX_PROP_TABLE_SIZE)
959 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
961 if (current_defn_is_class)
962 for (i=0;i<6;i++) objectsz[no_objects].atts[i] = 0;
965 objectsz[no_objects].atts[i] = full_object.atts[i];
970 static void manufacture_object_g(void)
973 segment_markers.enabled = FALSE;
974 directives.enabled = TRUE;
976 property_inheritance_g();
978 objectsg[no_objects].parent = parent_of_this_obj;
979 objectsg[no_objects].next = 0;
980 objectsg[no_objects].child = 0;
982 if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fffffff))
983 { i = objectsg[parent_of_this_obj-1].child;
985 objectsg[parent_of_this_obj-1].child = no_objects + 1;
987 { while(objectsg[i-1].next != 0) i = objectsg[i-1].next;
988 objectsg[i-1].next = no_objects+1;
992 objectsg[no_objects].shortname = compile_string(shortname_buffer,
995 /* The properties table consists simply of a sequence of property
996 blocks, one for each object in order of definition, exactly as
997 it will appear in the final machine image. */
999 j = write_property_block_g();
1001 objectsg[no_objects].propaddr = full_object_g.finalpropaddr;
1003 objectsg[no_objects].propsize = j;
1004 if (properties_table_size >= MAX_PROP_TABLE_SIZE)
1005 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
1007 if (current_defn_is_class)
1008 for (i=0;i<NUM_ATTR_BYTES;i++)
1009 objectatts[no_objects*NUM_ATTR_BYTES+i] = 0;
1011 for (i=0;i<NUM_ATTR_BYTES;i++)
1012 objectatts[no_objects*NUM_ATTR_BYTES+i] = full_object_g.atts[i];
1018 /* ========================================================================= */
1019 /* [2] The Object/Nearby/Class directives parser: translating the syntax */
1020 /* into object specifications and then triggering off the above. */
1021 /* ========================================================================= */
1022 /* Properties ("with" or "private") segment. */
1023 /* ------------------------------------------------------------------------- */
1025 static int *defined_this_segment;
1026 static long defined_this_segment_size; /* calloc size */
1029 static void ensure_defined_this_segment(int newsize)
1031 int oldsize = defined_this_segment_size;
1032 defined_this_segment_size = newsize;
1033 my_recalloc(&defined_this_segment, sizeof(int), oldsize,
1034 defined_this_segment_size, "defined this segment table");
1037 static void properties_segment_z(int this_segment)
1039 /* Parse through the "with" part of an object/class definition:
1041 <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
1043 This routine also handles "private", with this_segment being equal
1044 to the token value for the introductory word ("private" or "with"). */
1047 int i, property_name_symbol, property_number=0, next_prop=0, length,
1048 individual_property, this_identifier_number;
1051 { get_next_token_with_directives();
1052 if ((token_type == SEGMENT_MARKER_TT)
1053 || (token_type == EOF_TT)
1054 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1055 { put_token_back(); return;
1058 if (token_type != SYMBOL_TT)
1059 { ebf_error("property name", token_text);
1063 individual_property = (stypes[token_value] != PROPERTY_T);
1065 if (individual_property)
1066 { if (sflags[token_value] & UNKNOWN_SFLAG)
1067 { this_identifier_number = no_individual_properties++;
1068 assign_symbol(token_value, this_identifier_number,
1069 INDIVIDUAL_PROPERTY_T);
1071 if (debugfile_switch)
1072 { debug_file_printf("<property>");
1074 ("<identifier>%s</identifier>", token_text);
1076 ("<value>%d</value>", this_identifier_number);
1077 debug_file_printf("</property>");
1082 { if (stypes[token_value]==INDIVIDUAL_PROPERTY_T)
1083 this_identifier_number = svals[token_value];
1085 { char already_error[128];
1086 sprintf(already_error,
1087 "\"%s\" is a name already in use (with type %s) \
1088 and may not be used as a property name too",
1089 token_text, typename(stypes[token_value]));
1090 error(already_error);
1095 if (def_t_s >= defined_this_segment_size)
1096 ensure_defined_this_segment(def_t_s*2);
1097 defined_this_segment[def_t_s++] = token_value;
1099 if (individual_prop_table_size++ == 0)
1100 { full_object.pp[full_object.l].num = 3;
1101 full_object.pp[full_object.l].l = 1;
1102 full_object.pp[full_object.l].ao[0].value
1103 = individuals_length;
1104 full_object.pp[full_object.l].ao[0].type = LONG_CONSTANT_OT;
1105 full_object.pp[full_object.l].ao[0].marker = INDIVPT_MV;
1107 i_m = individuals_length;
1110 individuals_table[i_m] = this_identifier_number/256;
1111 if (this_segment == PRIVATE_SEGMENT)
1112 individuals_table[i_m] |= 0x80;
1113 individuals_table[i_m+1] = this_identifier_number%256;
1115 backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
1116 individuals_table[i_m+2] = 0;
1119 { if (sflags[token_value] & UNKNOWN_SFLAG)
1120 { error_named("No such property name as", token_text);
1123 if (this_segment == PRIVATE_SEGMENT)
1124 error_named("Property should be declared in 'with', \
1125 not 'private':", token_text);
1126 if (def_t_s >= defined_this_segment_size)
1127 ensure_defined_this_segment(def_t_s*2);
1128 defined_this_segment[def_t_s++] = token_value;
1129 property_number = svals[token_value];
1131 next_prop=full_object.l++;
1132 full_object.pp[next_prop].num = property_number;
1135 for (i=0; i<(def_t_s-1); i++)
1136 if (defined_this_segment[i] == token_value)
1137 { error_named("Property given twice in the same declaration:",
1138 (char *) symbs[token_value]);
1141 if (svals[defined_this_segment[i]] == svals[token_value])
1142 { char error_b[128];
1144 "Property given twice in the same declaration, because \
1145 the names '%s' and '%s' actually refer to the same property",
1146 (char *) symbs[defined_this_segment[i]],
1147 (char *) symbs[token_value]);
1151 property_name_symbol = token_value;
1152 sflags[token_value] |= USED_SFLAG;
1156 { assembly_operand AO;
1157 get_next_token_with_directives();
1158 if ((token_type == EOF_TT)
1159 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1160 || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1163 if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1165 if ((!individual_property) && (property_number==1)
1166 && ((token_type != SQ_TT) || (strlen(token_text) <2 ))
1167 && (token_type != DQ_TT)
1169 warning ("'name' property should only contain dictionary words");
1171 if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1172 { char embedded_name[80];
1173 if (current_defn_is_class)
1174 { sprintf(embedded_name,
1175 "%s::%s", classname_text,
1176 (char *) symbs[property_name_symbol]);
1179 { sprintf(embedded_name,
1180 "%s.%s", objectname_text,
1181 (char *) symbs[property_name_symbol]);
1183 AO.value = parse_routine(NULL, TRUE, embedded_name, FALSE, -1);
1184 AO.type = LONG_CONSTANT_OT;
1185 AO.marker = IROUTINE_MV;
1187 directives.enabled = FALSE;
1188 segment_markers.enabled = TRUE;
1190 statements.enabled = FALSE;
1191 misc_keywords.enabled = FALSE;
1192 local_variables.enabled = FALSE;
1193 system_functions.enabled = FALSE;
1194 conditions.enabled = FALSE;
1198 /* A special rule applies to values in double-quotes of the
1199 built-in property "name", which always has number 1: such
1200 property values are dictionary entries and not static
1203 if ((!individual_property) &&
1204 (property_number==1) && (token_type == DQ_TT))
1205 { AO.value = dictionary_add(token_text, 0x80, 0, 0);
1206 AO.type = LONG_CONSTANT_OT;
1207 AO.marker = DWORD_MV;
1212 if ((token_type == SYMBOL_TT)
1213 && (stypes[token_value]==PROPERTY_T))
1215 /* This is not necessarily an error: it's possible
1216 to imagine a property whose value is a list
1217 of other properties to look up, but far more
1218 likely that a comma has been omitted in between
1219 two property blocks */
1222 "Missing ','? Property data seems to contain the property name",
1227 /* An ordinary value, then: */
1230 AO = parse_expression(ARRAY_CONTEXT);
1234 { error_named("Limit (of 32 values) exceeded for property",
1235 (char *) symbs[property_name_symbol]);
1239 if (individual_property)
1240 { if (AO.marker != 0)
1241 backpatch_zmachine(AO.marker, INDIVIDUAL_PROP_ZA,
1243 individuals_table[i_m+3+length++] = AO.value/256;
1244 individuals_table[i_m+3+length++] = AO.value%256;
1247 { full_object.pp[next_prop].ao[length/2] = AO;
1248 length = length + 2;
1253 /* People rarely do, but it is legal to declare a property without
1256 with name "fish", number, time_left;
1258 in which case the properties "number" and "time_left" are
1259 created as in effect variables and initialised to zero. */
1262 { if (individual_property)
1263 { individuals_table[i_m+3+length++] = 0;
1264 individuals_table[i_m+3+length++] = 0;
1267 { full_object.pp[next_prop].ao[0].value = 0;
1268 full_object.pp[next_prop].ao[0].type = LONG_CONSTANT_OT;
1269 full_object.pp[next_prop].ao[0].marker = 0;
1274 if ((version_number==3) && (!individual_property))
1277 warning_named("Version 3 limit of 4 values per property exceeded \
1278 (use -v5 to get 32), so truncating property",
1279 (char *) symbs[property_name_symbol]);
1280 full_object.pp[next_prop].l=4;
1284 if (individual_property)
1286 if (individuals_length+length+3 > MAX_INDIV_PROP_TABLE_SIZE)
1287 memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
1288 MAX_INDIV_PROP_TABLE_SIZE);
1289 individuals_table[i_m + 2] = length;
1290 individuals_length += length+3;
1291 i_m = individuals_length;
1294 full_object.pp[next_prop].l = length/2;
1296 if ((token_type == EOF_TT)
1297 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1298 { put_token_back(); return;
1305 static void properties_segment_g(int this_segment)
1307 /* Parse through the "with" part of an object/class definition:
1309 <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
1311 This routine also handles "private", with this_segment being equal
1312 to the token value for the introductory word ("private" or "with"). */
1316 individual_property, this_identifier_number;
1317 int32 property_name_symbol, property_number, length;
1320 { get_next_token_with_directives();
1321 if ((token_type == SEGMENT_MARKER_TT)
1322 || (token_type == EOF_TT)
1323 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1324 { put_token_back(); return;
1327 if (token_type != SYMBOL_TT)
1328 { ebf_error("property name", token_text);
1332 individual_property = (stypes[token_value] != PROPERTY_T);
1334 if (individual_property)
1335 { if (sflags[token_value] & UNKNOWN_SFLAG)
1336 { this_identifier_number = no_individual_properties++;
1337 assign_symbol(token_value, this_identifier_number,
1338 INDIVIDUAL_PROPERTY_T);
1340 if (debugfile_switch)
1341 { debug_file_printf("<property>");
1343 ("<identifier>%s</identifier>", token_text);
1345 ("<value>%d</value>", this_identifier_number);
1346 debug_file_printf("</property>");
1351 { if (stypes[token_value]==INDIVIDUAL_PROPERTY_T)
1352 this_identifier_number = svals[token_value];
1354 { char already_error[128];
1355 sprintf(already_error,
1356 "\"%s\" is a name already in use (with type %s) \
1357 and may not be used as a property name too",
1358 token_text, typename(stypes[token_value]));
1359 error(already_error);
1364 if (def_t_s >= defined_this_segment_size)
1365 ensure_defined_this_segment(def_t_s*2);
1366 defined_this_segment[def_t_s++] = token_value;
1367 property_number = svals[token_value];
1369 next_prop=full_object_g.numprops++;
1370 full_object_g.props[next_prop].num = property_number;
1371 full_object_g.props[next_prop].flags =
1372 ((this_segment == PRIVATE_SEGMENT) ? 1 : 0);
1373 full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1374 full_object_g.props[next_prop].continuation = 0;
1375 full_object_g.props[next_prop].datalen = 0;
1378 { if (sflags[token_value] & UNKNOWN_SFLAG)
1379 { error_named("No such property name as", token_text);
1382 if (this_segment == PRIVATE_SEGMENT)
1383 error_named("Property should be declared in 'with', \
1384 not 'private':", token_text);
1386 if (def_t_s >= defined_this_segment_size)
1387 ensure_defined_this_segment(def_t_s*2);
1388 defined_this_segment[def_t_s++] = token_value;
1389 property_number = svals[token_value];
1391 next_prop=full_object_g.numprops++;
1392 full_object_g.props[next_prop].num = property_number;
1393 full_object_g.props[next_prop].flags = 0;
1394 full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1395 full_object_g.props[next_prop].continuation = 0;
1396 full_object_g.props[next_prop].datalen = 0;
1399 for (i=0; i<(def_t_s-1); i++)
1400 if (defined_this_segment[i] == token_value)
1401 { error_named("Property given twice in the same declaration:",
1402 (char *) symbs[token_value]);
1405 if (svals[defined_this_segment[i]] == svals[token_value])
1406 { char error_b[128];
1408 "Property given twice in the same declaration, because \
1409 the names '%s' and '%s' actually refer to the same property",
1410 (char *) symbs[defined_this_segment[i]],
1411 (char *) symbs[token_value]);
1415 if (full_object_g.numprops == MAX_OBJ_PROP_COUNT) {
1416 memoryerror("MAX_OBJ_PROP_COUNT",MAX_OBJ_PROP_COUNT);
1419 property_name_symbol = token_value;
1420 sflags[token_value] |= USED_SFLAG;
1424 { assembly_operand AO;
1425 get_next_token_with_directives();
1426 if ((token_type == EOF_TT)
1427 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1428 || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1431 if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1433 if ((!individual_property) && (property_number==1)
1434 && (token_type != SQ_TT) && (token_type != DQ_TT)
1436 warning ("'name' property should only contain dictionary words");
1438 if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1439 { char embedded_name[80];
1440 if (current_defn_is_class)
1441 { sprintf(embedded_name,
1442 "%s::%s", classname_text,
1443 (char *) symbs[property_name_symbol]);
1446 { sprintf(embedded_name,
1447 "%s.%s", objectname_text,
1448 (char *) symbs[property_name_symbol]);
1450 AO.value = parse_routine(NULL, TRUE, embedded_name, FALSE, -1);
1451 AO.type = CONSTANT_OT;
1452 AO.marker = IROUTINE_MV;
1454 directives.enabled = FALSE;
1455 segment_markers.enabled = TRUE;
1457 statements.enabled = FALSE;
1458 misc_keywords.enabled = FALSE;
1459 local_variables.enabled = FALSE;
1460 system_functions.enabled = FALSE;
1461 conditions.enabled = FALSE;
1465 /* A special rule applies to values in double-quotes of the
1466 built-in property "name", which always has number 1: such
1467 property values are dictionary entries and not static
1470 if ((!individual_property) &&
1471 (property_number==1) && (token_type == DQ_TT))
1472 { AO.value = dictionary_add(token_text, 0x80, 0, 0);
1473 AO.type = CONSTANT_OT;
1474 AO.marker = DWORD_MV;
1479 if ((token_type == SYMBOL_TT)
1480 && (stypes[token_value]==PROPERTY_T))
1482 /* This is not necessarily an error: it's possible
1483 to imagine a property whose value is a list
1484 of other properties to look up, but far more
1485 likely that a comma has been omitted in between
1486 two property blocks */
1489 "Missing ','? Property data seems to contain the property name",
1494 /* An ordinary value, then: */
1497 AO = parse_expression(ARRAY_CONTEXT);
1500 if (length == 32768) /* VENEER_CONSTRAINT_ON_PROP_TABLE_SIZE? */
1501 { error_named("Limit (of 32768 values) exceeded for property",
1502 (char *) symbs[property_name_symbol]);
1506 if (full_object_g.propdatasize >= MAX_OBJ_PROP_TABLE_SIZE) {
1507 memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
1510 full_object_g.propdata[full_object_g.propdatasize++] = AO;
1515 /* People rarely do, but it is legal to declare a property without
1518 with name "fish", number, time_left;
1520 in which case the properties "number" and "time_left" are
1521 created as in effect variables and initialised to zero. */
1525 assembly_operand AO;
1527 AO.type = CONSTANT_OT;
1529 full_object_g.propdata[full_object_g.propdatasize++] = AO;
1533 full_object_g.props[next_prop].datalen = length;
1535 if ((token_type == EOF_TT)
1536 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1537 { put_token_back(); return;
1543 static void properties_segment(int this_segment)
1546 properties_segment_z(this_segment);
1548 properties_segment_g(this_segment);
1551 /* ------------------------------------------------------------------------- */
1552 /* Attributes ("has") segment. */
1553 /* ------------------------------------------------------------------------- */
1555 static void attributes_segment(void)
1557 /* Parse through the "has" part of an object/class definition:
1559 [~]<attribute-1> [~]<attribute-2> ... [~]<attribute-n> */
1561 int attribute_number, truth_state, bitmask;
1564 { truth_state = TRUE;
1568 get_next_token_with_directives();
1569 if ((token_type == SEGMENT_MARKER_TT)
1570 || (token_type == EOF_TT)
1571 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1573 ebf_error("attribute name after '~'", token_text);
1574 put_token_back(); return;
1576 if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1578 if ((token_type == SEP_TT) && (token_value == ARTNOT_SEP))
1579 { truth_state = !truth_state; goto ParseAttrN;
1582 if ((token_type != SYMBOL_TT)
1583 || (stypes[token_value] != ATTRIBUTE_T))
1584 { ebf_error("name of an already-declared attribute", token_text);
1588 attribute_number = svals[token_value];
1589 sflags[token_value] |= USED_SFLAG;
1592 bitmask = (1 << (7-attribute_number%8));
1593 attrbyte = &(full_object.atts[attribute_number/8]);
1596 /* In Glulx, my prejudices rule, and therefore bits are numbered
1597 from least to most significant. This is the opposite of the
1598 way the Z-machine works. */
1599 bitmask = (1 << (attribute_number%8));
1600 attrbyte = &(full_object_g.atts[attribute_number/8]);
1604 *attrbyte |= bitmask; /* Set attribute bit */
1606 *attrbyte &= ~bitmask; /* Clear attribute bit */
1611 /* ------------------------------------------------------------------------- */
1612 /* Classes ("class") segment. */
1613 /* ------------------------------------------------------------------------- */
1615 static void add_class_to_inheritance_list(int class_number)
1619 /* The class number is actually the class's object number, which needs
1620 to be translated into its actual class number: */
1622 for (i=0;i<no_classes;i++)
1623 if (class_number == class_object_numbers[i])
1624 { class_number = i+1;
1628 /* Remember the inheritance list so that property inheritance can
1629 be sorted out later on, when the definition has been finished: */
1631 classes_to_inherit_from[no_classes_to_inherit_from++] = class_number;
1633 /* Inheriting attributes from the class at once: */
1638 |= properties_table[class_begins_at[class_number-1] - 6 + i];
1641 for (i=0; i<NUM_ATTR_BYTES; i++)
1642 full_object_g.atts[i]
1643 |= properties_table[class_begins_at[class_number-1]
1644 - NUM_ATTR_BYTES + i];
1648 static void classes_segment(void)
1650 /* Parse through the "class" part of an object/class definition:
1652 <class-1> ... <class-n> */
1655 { get_next_token_with_directives();
1656 if ((token_type == SEGMENT_MARKER_TT)
1657 || (token_type == EOF_TT)
1658 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1659 { put_token_back(); return;
1661 if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1663 if ((token_type != SYMBOL_TT)
1664 || (stypes[token_value] != CLASS_T))
1665 { ebf_error("name of an already-declared class", token_text);
1669 sflags[token_value] |= USED_SFLAG;
1670 add_class_to_inheritance_list(svals[token_value]);
1674 /* ------------------------------------------------------------------------- */
1675 /* Parse the body of a Nearby/Object/Class definition. */
1676 /* ------------------------------------------------------------------------- */
1678 static void parse_body_of_definition(void)
1679 { int commas_in_row;
1684 { commas_in_row = -1;
1686 { get_next_token_with_directives(); commas_in_row++;
1687 } while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
1689 if (commas_in_row>1)
1690 error("Two commas ',' in a row in object/class definition");
1692 if ((token_type == EOF_TT)
1693 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1694 { if (commas_in_row > 0)
1695 error("Object/class definition finishes with ','");
1696 if (token_type == EOF_TT)
1697 error("Object/class definition incomplete (no ';') at end of file");
1701 if (token_type != SEGMENT_MARKER_TT)
1702 { error_named("Expected 'with', 'has' or 'class' in \
1703 object/class definition but found", token_text);
1708 { case WITH_SEGMENT:
1709 properties_segment(WITH_SEGMENT);
1711 case PRIVATE_SEGMENT:
1712 properties_segment(PRIVATE_SEGMENT);
1715 attributes_segment();
1726 /* ------------------------------------------------------------------------- */
1727 /* Class directives: */
1729 /* Class <name> <body of definition> */
1730 /* ------------------------------------------------------------------------- */
1732 static void initialise_full_object(void)
1737 full_object.atts[0] = 0;
1738 full_object.atts[1] = 0;
1739 full_object.atts[2] = 0;
1740 full_object.atts[3] = 0;
1741 full_object.atts[4] = 0;
1742 full_object.atts[5] = 0;
1745 full_object_g.numprops = 0;
1746 full_object_g.propdatasize = 0;
1747 for (i=0; i<NUM_ATTR_BYTES; i++)
1748 full_object_g.atts[i] = 0;
1752 extern void make_class(char * metaclass_name)
1753 { int n, duplicates_to_make = 0, class_number = no_objects+1,
1754 metaclass_flag = (metaclass_name != NULL);
1755 char duplicate_name[128];
1757 debug_location_beginning beginning_debug_location =
1758 get_token_location_beginning();
1760 current_defn_is_class = TRUE; no_classes_to_inherit_from = 0;
1761 individual_prop_table_size = 0;
1763 if (no_classes==MAX_CLASSES)
1764 memoryerror("MAX_CLASSES", MAX_CLASSES);
1766 if (no_classes==VENEER_CONSTRAINT_ON_CLASSES)
1767 fatalerror("Inform's maximum possible number of classes (whatever \
1768 amount of memory is allocated) has been reached. If this causes serious \
1769 inconvenience, please contact the maintainers.");
1771 directives.enabled = FALSE;
1774 { token_text = metaclass_name;
1775 token_value = symbol_index(token_text, -1);
1776 token_type = SYMBOL_TT;
1780 if ((token_type != SYMBOL_TT)
1781 || (!(sflags[token_value] & UNKNOWN_SFLAG)))
1782 { discard_token_location(beginning_debug_location);
1783 ebf_error("new class name", token_text);
1784 panic_mode_error_recovery();
1789 /* Each class also creates a modest object representing itself: */
1791 strcpy(shortname_buffer, token_text);
1793 assign_symbol(token_value, class_number, CLASS_T);
1794 classname_text = (char *) symbs[token_value];
1797 if (metaclass_flag) sflags[token_value] |= SYSTEM_SFLAG;
1800 /* In Glulx, metaclasses have to be backpatched too! So we can't
1801 mark it as "system", but we should mark it "used". */
1802 if (metaclass_flag) sflags[token_value] |= USED_SFLAG;
1805 /* "Class" (object 1) has no parent, whereas all other classes are
1806 the children of "Class". Since "Class" is not present in a module,
1807 a special value is used which is corrected to 1 by the linker. */
1809 if (metaclass_flag) parent_of_this_obj = 0;
1810 else parent_of_this_obj = (module_switch)?MAXINTWORD:1;
1812 class_object_numbers[no_classes] = class_number;
1814 initialise_full_object();
1816 /* Give the class the (nameless in Inform syntax) "inheritance" property
1817 with value its own class number. (This therefore accumulates onto
1818 the inheritance property of any object inheriting from the class,
1819 since property 2 is always set to "additive" -- see below) */
1823 full_object.pp[0].num = 2;
1824 full_object.pp[0].l = 1;
1825 full_object.pp[0].ao[0].value = no_objects + 1;
1826 full_object.pp[0].ao[0].type = LONG_CONSTANT_OT;
1827 full_object.pp[0].ao[0].marker = OBJECT_MV;
1830 full_object_g.numprops = 1;
1831 full_object_g.props[0].num = 2;
1832 full_object_g.props[0].flags = 0;
1833 full_object_g.props[0].datastart = 0;
1834 full_object_g.props[0].continuation = 0;
1835 full_object_g.props[0].datalen = 1;
1836 full_object_g.propdatasize = 1;
1837 full_object_g.propdata[0].value = no_objects + 1;
1838 full_object_g.propdata[0].type = CONSTANT_OT;
1839 full_object_g.propdata[0].marker = OBJECT_MV;
1842 class_symbol = token_value;
1844 if (!metaclass_flag)
1846 if ((token_type == SEP_TT) && (token_value == OPENB_SEP))
1847 { assembly_operand AO;
1848 AO = parse_expression(CONSTANT_CONTEXT);
1850 { error("Duplicate-number not known at compile time");
1855 if ((n<0) || (n>10000))
1856 { error("The number of duplicates must be 0 to 10000");
1860 /* Make one extra duplicate, since the veneer routines need
1861 always to keep an undamaged prototype for the class in stock */
1863 duplicates_to_make = n + 1;
1865 match_close_bracket();
1866 } else put_token_back();
1868 /* Parse the body of the definition: */
1870 parse_body_of_definition();
1873 if (debugfile_switch)
1874 { debug_file_printf("<class>");
1875 debug_file_printf("<identifier>%s</identifier>", shortname_buffer);
1876 debug_file_printf("<class-number>%d</class-number>", no_classes);
1877 debug_file_printf("<value>");
1878 write_debug_object_backpatch(no_objects + 1);
1879 debug_file_printf("</value>");
1880 write_debug_locations
1881 (get_token_location_end(beginning_debug_location));
1882 debug_file_printf("</class>");
1886 manufacture_object_z();
1888 manufacture_object_g();
1890 if (individual_prop_table_size >= VENEER_CONSTRAINT_ON_IP_TABLE_SIZE)
1891 error("This class is too complex: it now carries too many properties. \
1892 You may be able to get round this by declaring some of its property names as \
1893 \"common properties\" using the 'Property' directive.");
1895 if (duplicates_to_make > 0)
1896 { sprintf(duplicate_name, "%s_1", shortname_buffer);
1897 for (n=1; (duplicates_to_make--) > 0; n++)
1899 { int i = strlen(duplicate_name);
1900 while (duplicate_name[i] != '_') i--;
1901 sprintf(duplicate_name+i+1, "%d", n);
1903 make_object(FALSE, duplicate_name, class_number, class_number, -1);
1908 /* ------------------------------------------------------------------------- */
1909 /* Object/Nearby directives: */
1911 /* Object <name-1> ... <name-n> "short name" [parent] <body of def> */
1913 /* Nearby <name-1> ... <name-n> "short name" <body of definition> */
1914 /* ------------------------------------------------------------------------- */
1916 static int end_of_header(void)
1917 { if (((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1918 || ((token_type == SEP_TT) && (token_value == COMMA_SEP))
1919 || (token_type == SEGMENT_MARKER_TT)) return TRUE;
1923 extern void make_object(int nearby_flag,
1924 char *textual_name, int specified_parent, int specified_class,
1927 /* Ordinarily this is called with nearby_flag TRUE for "Nearby",
1928 FALSE for "Object"; and textual_name NULL, specified_parent and
1929 specified_class both -1. The next three arguments are used when
1930 the routine is called for class duplicates manufacture (see above).
1931 The last is used to create instances of a particular class. */
1933 int i, tree_depth, internal_name_symbol = 0;
1934 char internal_name[64];
1935 debug_location_beginning beginning_debug_location =
1936 get_token_location_beginning();
1938 directives.enabled = FALSE;
1940 if (no_objects==MAX_OBJECTS) memoryerror("MAX_OBJECTS", MAX_OBJECTS);
1942 sprintf(internal_name, "nameless_obj__%d", no_objects+1);
1943 objectname_text = internal_name;
1945 current_defn_is_class = FALSE;
1947 no_classes_to_inherit_from=0;
1949 individual_prop_table_size = 0;
1951 if (nearby_flag) tree_depth=1; else tree_depth=0;
1953 if (specified_class != -1) goto HeaderPassed;
1957 /* Read past and count a sequence of "->"s, if any are present */
1959 if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
1961 error("The syntax '->' is only used as an alternative to 'Nearby'");
1963 while ((token_type == SEP_TT) && (token_value == ARROW_SEP))
1969 sprintf(shortname_buffer, "?");
1971 segment_markers.enabled = TRUE;
1973 /* This first word is either an internal name, or a textual short name,
1974 or the end of the header part */
1976 if (end_of_header()) goto HeaderPassed;
1978 if (token_type == DQ_TT) textual_name = token_text;
1980 { if ((token_type != SYMBOL_TT)
1981 || (!(sflags[token_value] & UNKNOWN_SFLAG)))
1982 ebf_error("name for new object or its textual short name",
1985 { internal_name_symbol = token_value;
1986 strcpy(internal_name, token_text);
1990 /* The next word is either a parent object, or
1991 a textual short name, or the end of the header part */
1993 get_next_token_with_directives();
1994 if (end_of_header()) goto HeaderPassed;
1996 if (token_type == DQ_TT)
1997 { if (textual_name != NULL)
1998 error("Two textual short names given for only one object");
2000 textual_name = token_text;
2003 { if ((token_type != SYMBOL_TT)
2004 || (sflags[token_value] & UNKNOWN_SFLAG))
2005 { if (textual_name == NULL)
2006 ebf_error("parent object or the object's textual short name",
2009 ebf_error("parent object", token_text);
2011 else goto SpecParent;
2014 /* Finally, it's possible that there is still a parent object */
2017 if (end_of_header()) goto HeaderPassed;
2019 if (specified_parent != -1)
2020 ebf_error("body of object definition", token_text);
2023 if ((stypes[token_value] == OBJECT_T)
2024 || (stypes[token_value] == CLASS_T))
2025 { specified_parent = svals[token_value];
2026 sflags[token_value] |= USED_SFLAG;
2028 else ebf_error("name of (the parent) object", token_text);
2031 /* Now it really has to be the body of the definition. */
2033 get_next_token_with_directives();
2034 if (end_of_header()) goto HeaderPassed;
2036 ebf_error("body of object definition", token_text);
2039 if (specified_class == -1) put_token_back();
2041 if (internal_name_symbol > 0)
2042 assign_symbol(internal_name_symbol, no_objects + 1, OBJECT_T);
2044 if (listobjects_switch)
2045 printf("%3d \"%s\"\n", no_objects+1,
2046 (textual_name==NULL)?"(with no short name)":textual_name);
2047 if (textual_name == NULL)
2048 { if (internal_name_symbol > 0)
2049 sprintf(shortname_buffer, "(%s)",
2050 (char *) symbs[internal_name_symbol]);
2052 sprintf(shortname_buffer, "(%d)", no_objects+1);
2055 { if (strlen(textual_name)>765)
2056 error("Short name of object (in quotes) exceeded 765 characters");
2057 strncpy(shortname_buffer, textual_name, 765);
2060 if (specified_parent != -1)
2061 { if (tree_depth > 0)
2062 error("Use of '->' (or 'Nearby') clashes with giving a parent");
2063 parent_of_this_obj = specified_parent;
2066 { parent_of_this_obj = 0;
2069 /* We have to set the parent object to the most recently defined
2070 object at level (tree_depth - 1) in the tree.
2072 A complication is that objects are numbered 1, 2, ... in the
2073 Z-machine (and in the objects[].parent, etc., fields) but
2074 0, 1, 2, ... internally (and as indices to object[]). */
2076 for (i=no_objects-1; i>=0; i--)
2079 /* Metaclass or class objects cannot be '->' parents: */
2080 if ((!module_switch) && (i<4))
2084 if (objectsz[i].parent == 1)
2086 while (objectsz[j].parent != 0)
2087 { j = objectsz[j].parent - 1; k++; }
2090 if (objectsg[i].parent == 1)
2092 while (objectsg[j].parent != 0)
2093 { j = objectsg[j].parent - 1; k++; }
2096 if (k == tree_depth - 1)
2097 { parent_of_this_obj = i+1;
2101 if (parent_of_this_obj == 0)
2102 { if (tree_depth == 1)
2103 error("'->' (or 'Nearby') fails because there is no previous object");
2105 error("'-> -> ...' fails because no previous object is deep enough");
2110 initialise_full_object();
2111 if (instance_of != -1) add_class_to_inheritance_list(instance_of);
2113 if (specified_class == -1) parse_body_of_definition();
2114 else add_class_to_inheritance_list(specified_class);
2116 if (debugfile_switch)
2117 { debug_file_printf("<object>");
2118 if (internal_name_symbol > 0)
2119 { debug_file_printf("<identifier>%s</identifier>", internal_name);
2122 ("<identifier artificial=\"true\">%s</identifier>",
2125 debug_file_printf("<value>");
2126 write_debug_object_backpatch(no_objects + 1);
2127 debug_file_printf("</value>");
2128 write_debug_locations
2129 (get_token_location_end(beginning_debug_location));
2130 debug_file_printf("</object>");
2134 manufacture_object_z();
2136 manufacture_object_g();
2139 /* ========================================================================= */
2140 /* Data structure management routines */
2141 /* ------------------------------------------------------------------------- */
2143 extern void init_objects_vars(void)
2145 properties_table = NULL;
2146 prop_is_long = NULL;
2147 prop_is_additive = NULL;
2148 prop_default_value = NULL;
2153 classes_to_inherit_from = NULL;
2154 class_begins_at = NULL;
2157 extern void objects_begin_pass(void)
2159 properties_table_size=0;
2160 prop_is_long[1] = TRUE; prop_is_additive[1] = TRUE; /* "name" */
2161 prop_is_long[2] = TRUE; prop_is_additive[2] = TRUE; /* inheritance prop */
2163 prop_is_long[3] = TRUE; prop_is_additive[3] = FALSE;
2164 /* instance variables table address */
2167 if (debugfile_switch)
2168 { debug_file_printf("<property>");
2170 ("<identifier artificial=\"true\">inheritance class</identifier>");
2171 debug_file_printf("<value>2</value>");
2172 debug_file_printf("</property>");
2173 debug_file_printf("<property>");
2175 ("<identifier artificial=\"true\">instance variables table address "
2176 "(Z-code)</identifier>");
2177 debug_file_printf("<value>3</value>");
2178 debug_file_printf("</property>");
2181 if (define_INFIX_switch) no_attributes = 1;
2182 else no_attributes = 0;
2186 objectsz[0].parent = 0; objectsz[0].child = 0; objectsz[0].next = 0;
2187 no_individual_properties=72;
2190 objectsg[0].parent = 0; objectsg[0].child = 0; objectsg[0].next = 0;
2191 no_individual_properties = INDIV_PROP_START+8;
2195 no_embedded_routines = 0;
2197 individuals_length=0;
2200 extern void objects_allocate_arrays(void)
2206 prop_default_value = my_calloc(sizeof(int32), INDIV_PROP_START,
2207 "property default values");
2208 prop_is_long = my_calloc(sizeof(int), INDIV_PROP_START,
2209 "property-is-long flags");
2210 prop_is_additive = my_calloc(sizeof(int), INDIV_PROP_START,
2211 "property-is-additive flags");
2213 classes_to_inherit_from = my_calloc(sizeof(int), MAX_CLASSES,
2214 "inherited classes list");
2215 class_begins_at = my_calloc(sizeof(int32), MAX_CLASSES,
2216 "pointers to classes");
2217 class_object_numbers = my_calloc(sizeof(int), MAX_CLASSES,
2218 "class object numbers");
2220 properties_table = my_malloc(MAX_PROP_TABLE_SIZE,"properties table");
2221 individuals_table = my_malloc(MAX_INDIV_PROP_TABLE_SIZE,
2222 "individual properties table");
2224 defined_this_segment_size = 128;
2225 defined_this_segment = my_calloc(sizeof(int), defined_this_segment_size,
2226 "defined this segment table");
2229 objectsz = my_calloc(sizeof(objecttz), MAX_OBJECTS,
2233 objectsg = my_calloc(sizeof(objecttg), MAX_OBJECTS,
2235 objectatts = my_calloc(NUM_ATTR_BYTES, MAX_OBJECTS,
2237 full_object_g.props = my_calloc(sizeof(propg), MAX_OBJ_PROP_COUNT,
2238 "object property list");
2239 full_object_g.propdata = my_calloc(sizeof(assembly_operand),
2240 MAX_OBJ_PROP_TABLE_SIZE,
2241 "object property data table");
2245 extern void objects_free_arrays(void)
2247 my_free(&prop_default_value, "property default values");
2248 my_free(&prop_is_long, "property-is-long flags");
2249 my_free(&prop_is_additive, "property-is-additive flags");
2251 my_free(&objectsz, "z-objects");
2252 my_free(&objectsg, "g-objects");
2253 my_free(&objectatts, "g-attributes");
2254 my_free(&class_object_numbers,"class object numbers");
2255 my_free(&classes_to_inherit_from, "inherited classes list");
2256 my_free(&class_begins_at, "pointers to classes");
2258 my_free(&properties_table, "properties table");
2259 my_free(&individuals_table,"individual properties table");
2261 my_free(&defined_this_segment,"defined this segment table");
2264 my_free(&full_object_g.props, "object property list");
2265 my_free(&full_object_g.propdata, "object property data table");
2270 /* ========================================================================= */