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 - 2018 */
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 if (no_properties==INDIV_PROP_START) {
204 discard_token_location(beginning_debug_location);
205 error_numbered("All properties already declared -- max is",
207 panic_mode_error_recovery();
214 { directive_keywords.enabled = TRUE;
216 if ((token_type == DIR_KEYWORD_TT) && (token_value == LONG_DK))
217 obsolete_warning("all properties are now automatically 'long'");
219 if ((token_type == DIR_KEYWORD_TT) && (token_value == ADDITIVE_DK))
220 additive_flag = TRUE;
225 directive_keywords.enabled = FALSE;
228 i = token_value; name = token_text;
229 if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG)))
230 { discard_token_location(beginning_debug_location);
231 ebf_error("new property name", token_text);
232 panic_mode_error_recovery();
237 directive_keywords.enabled = TRUE;
239 directive_keywords.enabled = FALSE;
241 if (strcmp(name+strlen(name)-3, "_to") == 0) sflags[i] |= STAR_SFLAG;
243 if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK))
244 { discard_token_location(beginning_debug_location);
246 { error("'alias' incompatible with 'additive'");
247 panic_mode_error_recovery();
252 if (!((token_type == SYMBOL_TT)
253 && (stypes[token_value] == PROPERTY_T)))
254 { ebf_error("an existing property name after 'alias'",
256 panic_mode_error_recovery();
261 assign_symbol(i, svals[token_value], PROPERTY_T);
262 trace_s(name, svals[i], 1);
263 sflags[token_value] |= ALIASED_SFLAG;
264 sflags[i] |= ALIASED_SFLAG;
271 if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
272 { AO = parse_expression(CONSTANT_CONTEXT);
273 default_value = AO.value;
275 backpatch_zmachine(AO.marker, PROP_DEFAULTS_ZA,
276 (no_properties-1) * WORDSIZE);
279 prop_default_value[no_properties] = default_value;
280 prop_is_long[no_properties] = TRUE;
281 prop_is_additive[no_properties] = additive_flag;
283 assign_symbol(i, no_properties++, PROPERTY_T);
285 if (debugfile_switch)
286 { debug_file_printf("<property>");
287 debug_file_printf("<identifier>%s</identifier>", name);
288 debug_file_printf("<value>%d</value>", svals[i]);
289 write_debug_locations
290 (get_token_location_end(beginning_debug_location));
291 debug_file_printf("</property>");
294 trace_s(name, svals[i], 1);
297 /* ------------------------------------------------------------------------- */
299 /* ------------------------------------------------------------------------- */
301 int32 *prop_default_value; /* Default values for properties */
302 int *prop_is_long, /* Property modifiers, TRUE or FALSE:
303 "long" means "never write a 1-byte
304 value to this property", and is an
305 obsolete feature: since Inform 5
306 all properties have been "long" */
307 *prop_is_additive; /* "additive" means that values
308 accumulate rather than erase each
309 other during class inheritance */
310 char *properties_table; /* Holds the table of property values
311 (holding one block for each object
312 and coming immediately after the
313 object tree in Z-memory) */
314 int properties_table_size; /* Number of bytes in this table */
316 /* ------------------------------------------------------------------------- */
317 /* Individual properties */
319 /* Each new i.p. name is given a unique number. These numbers start from */
320 /* 72, since 0 is reserved as a null, 1 to 63 refer to common properties */
321 /* and 64 to 71 are kept for methods of the metaclass Class (for example, */
322 /* 64 is "create"). */
324 /* An object provides individual properties by having property 3 set to a */
325 /* non-zero value, which must be a byte address of a table in the form: */
327 /* <record-1> ... <record-n> 00 00 */
329 /* where a <record> looks like */
331 /* <identifier> <size> <up to 255 bytes of data> */
332 /* or <identifier + 0x8000> */
333 /* ----- 2 bytes ---------- 1 byte <size> number of bytes */
335 /* The <identifier> part is the number allocated to the name of what is */
336 /* being provided. The top bit of this word is set to indicate that */
337 /* although the individual property is being provided, it is provided */
338 /* only privately (so that it is inaccessible except to the object's own */
339 /* embedded routines). */
341 /* In Glulx: i-props are numbered from INDIV_PROP_START+8 up. And all */
342 /* properties, common and individual, are stored in the same table. */
343 /* ------------------------------------------------------------------------- */
345 int no_individual_properties; /* Actually equal to the next
346 identifier number to be allocated,
347 so this is initially 72 even though
348 none have been made yet. */
349 static int individual_prop_table_size; /* Size of the table of individual
350 properties so far for current obj */
351 uchar *individuals_table; /* Table of records, each being the
352 i.p. table for an object */
353 int i_m; /* Write mark position in the above */
354 int individuals_length; /* Extent of individuals_table */
356 /* ------------------------------------------------------------------------- */
357 /* Arrays used by this file */
358 /* ------------------------------------------------------------------------- */
360 objecttz *objectsz; /* Z-code only */
361 objecttg *objectsg; /* Glulx only */
362 uchar *objectatts; /* Glulx only */
363 static int *classes_to_inherit_from;
364 int *class_object_numbers;
365 int32 *class_begins_at;
368 /* ------------------------------------------------------------------------- */
369 /* Tracing for compiler maintenance */
370 /* ------------------------------------------------------------------------- */
372 extern void list_object_tree(void)
374 printf("obj par nxt chl Object tree:\n");
375 for (i=0; i<no_objects; i++)
376 printf("%3d %3d %3d %3d\n",
377 i+1,objectsz[i].parent,objectsz[i].next, objectsz[i].child);
380 /* ------------------------------------------------------------------------- */
381 /* Object and class manufacture begins here. */
383 /* These definitions have headers (parsed far, far below) and a series */
384 /* of segments, introduced by keywords and optionally separated by commas. */
385 /* Each segment has its own parsing routine. Note that when errors are */
386 /* detected, parsing continues rather than being abandoned, which assists */
387 /* a little in "error recovery" (i.e. in stopping lots more errors being */
388 /* produced for essentially the same mistake). */
389 /* ------------------------------------------------------------------------- */
391 /* ========================================================================= */
392 /* [1] The object-maker: builds an object from a specification, viz.: */
395 /* shortname_buffer, */
396 /* parent_of_this_obj, */
397 /* current_defn_is_class (flag) */
398 /* classes_to_inherit_from[], no_classes_to_inherit_from, */
399 /* individual_prop_table_size (to date ) */
401 /* For efficiency's sake, the individual properties table has already been */
402 /* created (as far as possible, i.e., all except for inherited individual */
403 /* properties); unless the flag is clear, in which case the actual */
404 /* definition did not specify any individual properties. */
405 /* ========================================================================= */
406 /* Property inheritance from classes. */
407 /* ------------------------------------------------------------------------- */
409 static void property_inheritance_z(void)
411 /* Apply the property inheritance rules to full_object, which should
412 initially be complete (i.e., this routine takes place after the whole
413 Nearby/Object/Class definition has been parsed through).
415 On exit, full_object contains the final state of the properties to
418 int i, j, k, kmax, class, mark,
419 prop_number, prop_length, prop_in_current_defn;
420 uchar *class_prop_block;
424 for (class=0; class<no_classes_to_inherit_from; class++)
427 mark = class_begins_at[classes_to_inherit_from[class]-1];
428 class_prop_block = (uchar *) (properties_table + mark);
430 while (class_prop_block[j]!=0)
431 { if (version_number == 3)
432 { prop_number = class_prop_block[j]%32;
433 prop_length = 1 + class_prop_block[j++]/32;
436 { prop_number = class_prop_block[j]%64;
437 prop_length = 1 + class_prop_block[j++]/64;
439 prop_length = class_prop_block[j++]%64;
442 /* So we now have property number prop_number present in the
443 property block for the class being read: its bytes are
445 class_prop_block[j, ..., j + prop_length - 1]
447 Question now is: is there already a value given in the
448 current definition under this property name? */
450 prop_in_current_defn = FALSE;
452 kmax = full_object.l;
454 for (k=0; k<kmax; k++)
455 if (full_object.pp[k].num == prop_number)
456 { prop_in_current_defn = TRUE;
458 /* (Note that the built-in "name" property is additive) */
460 if ((prop_number==1) || (prop_is_additive[prop_number]))
462 /* The additive case: we accumulate the class
463 property values onto the end of the full_object
466 for (i=full_object.pp[k].l;
467 i<full_object.pp[k].l+prop_length/2; i++)
469 { error("An additive property has inherited \
470 so many values that the list has overflowed the maximum 32 entries");
473 full_object.pp[k].ao[i].value = mark + j;
475 full_object.pp[k].ao[i].marker = INHERIT_MV;
476 full_object.pp[k].ao[i].type = LONG_CONSTANT_OT;
478 full_object.pp[k].l += prop_length/2;
481 /* The ordinary case: the full_object property
482 values simply overrides the class definition,
483 so we skip over the values in the class table */
488 { int y, z, class_block_offset;
491 /* Property 3 holds the address of the table of
492 instance variables, so this is the case where
493 the object already has instance variables in its
494 own table but must inherit some more from the
497 class_block_offset = class_prop_block[j-2]*256
498 + class_prop_block[j-1];
500 p = individuals_table + class_block_offset;
501 z = class_block_offset;
502 while ((p[0]!=0)||(p[1]!=0))
503 { int already_present = FALSE, l;
504 for (l = full_object.pp[k].ao[0].value; l < i_m;
505 l = l + 3 + individuals_table[l + 2])
506 if (individuals_table[l] == p[0]
507 && individuals_table[l + 1] == p[1])
508 { already_present = TRUE; break;
510 if (already_present == FALSE)
512 backpatch_zmachine(IDENT_MV,
513 INDIVIDUAL_PROP_ZA, i_m);
514 if (i_m+3+p[2] > MAX_INDIV_PROP_TABLE_SIZE)
515 memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
516 MAX_INDIV_PROP_TABLE_SIZE);
517 individuals_table[i_m++] = p[0];
518 individuals_table[i_m++] = p[1];
519 individuals_table[i_m++] = p[2];
520 for (y=0;y < p[2]/2;y++)
521 { individuals_table[i_m++] = (z+3+y*2)/256;
522 individuals_table[i_m++] = (z+3+y*2)%256;
523 backpatch_zmachine(INHERIT_INDIV_MV,
524 INDIVIDUAL_PROP_ZA, i_m-2);
530 individuals_length = i_m;
533 /* For efficiency we exit the loop now (this property
534 number has been dealt with) */
539 if (!prop_in_current_defn)
541 /* The case where the class defined a property which wasn't
542 defined at all in full_object: we copy out the data into
543 a new property added to full_object */
546 full_object.pp[k].num = prop_number;
547 full_object.pp[k].l = prop_length/2;
548 for (i=0; i<prop_length/2; i++)
549 { full_object.pp[k].ao[i].value = mark + j;
551 full_object.pp[k].ao[i].marker = INHERIT_MV;
552 full_object.pp[k].ao[i].type = LONG_CONSTANT_OT;
556 { int y, z, class_block_offset;
559 /* Property 3 holds the address of the table of
560 instance variables, so this is the case where
561 the object had no instance variables of its own
562 but must inherit some more from the class */
564 if (individual_prop_table_size++ == 0)
565 { full_object.pp[k].num = 3;
566 full_object.pp[k].l = 1;
567 full_object.pp[k].ao[0].value
568 = individuals_length;
569 full_object.pp[k].ao[0].marker = INDIVPT_MV;
570 full_object.pp[k].ao[0].type = LONG_CONSTANT_OT;
571 i_m = individuals_length;
573 class_block_offset = class_prop_block[j-2]*256
574 + class_prop_block[j-1];
576 p = individuals_table + class_block_offset;
577 z = class_block_offset;
578 while ((p[0]!=0)||(p[1]!=0))
580 backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
581 if (i_m+3+p[2] > MAX_INDIV_PROP_TABLE_SIZE)
582 memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
583 MAX_INDIV_PROP_TABLE_SIZE);
584 individuals_table[i_m++] = p[0];
585 individuals_table[i_m++] = p[1];
586 individuals_table[i_m++] = p[2];
587 for (y=0;y < p[2]/2;y++)
588 { individuals_table[i_m++] = (z+3+y*2)/256;
589 individuals_table[i_m++] = (z+3+y*2)%256;
590 backpatch_zmachine(INHERIT_INDIV_MV,
591 INDIVIDUAL_PROP_ZA, i_m-2);
596 individuals_length = i_m;
602 if (individual_prop_table_size > 0)
604 if (i_m+2 > MAX_INDIV_PROP_TABLE_SIZE)
605 memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
606 MAX_INDIV_PROP_TABLE_SIZE);
608 individuals_table[i_m++] = 0;
609 individuals_table[i_m++] = 0;
610 individuals_length += 2;
614 static void property_inheritance_g(void)
616 /* Apply the property inheritance rules to full_object, which should
617 initially be complete (i.e., this routine takes place after the whole
618 Nearby/Object/Class definition has been parsed through).
620 On exit, full_object contains the final state of the properties to
623 int i, j, k, class, num_props,
624 prop_number, prop_length, prop_flags, prop_in_current_defn;
625 int32 mark, prop_addr;
630 for (class=0; class<no_classes_to_inherit_from; class++) {
631 mark = class_begins_at[classes_to_inherit_from[class]-1];
632 cpb = (uchar *) (properties_table + mark);
633 /* This now points to the compiled property-table for the class.
634 We'll have to go through and decompile it. (For our sins.) */
635 num_props = ReadInt32(cpb);
636 for (j=0; j<num_props; j++) {
638 prop_number = ReadInt16(pe);
640 prop_length = ReadInt16(pe);
642 prop_addr = ReadInt32(pe);
644 prop_flags = ReadInt16(pe);
647 /* So we now have property number prop_number present in the
648 property block for the class being read. Its bytes are
649 cpb[prop_addr ... prop_addr + prop_length - 1]
650 Question now is: is there already a value given in the
651 current definition under this property name? */
653 prop_in_current_defn = FALSE;
655 for (k=0; k<full_object_g.numprops; k++) {
656 if (full_object_g.props[k].num == prop_number) {
657 prop_in_current_defn = TRUE;
662 if (prop_in_current_defn) {
664 || (prop_number < INDIV_PROP_START
665 && prop_is_additive[prop_number])) {
666 /* The additive case: we accumulate the class
667 property values onto the end of the full_object
668 properties. Remember that k is still the index number
669 of the first prop-block matching our property number. */
671 if (full_object_g.props[k].continuation == 0) {
672 full_object_g.props[k].continuation = 1;
676 prevcont = full_object_g.props[k].continuation;
677 for (k++; k<full_object_g.numprops; k++) {
678 if (full_object_g.props[k].num == prop_number) {
679 prevcont = full_object_g.props[k].continuation;
683 k = full_object_g.numprops++;
684 full_object_g.props[k].num = prop_number;
685 full_object_g.props[k].flags = 0;
686 full_object_g.props[k].datastart = full_object_g.propdatasize;
687 full_object_g.props[k].continuation = prevcont+1;
688 full_object_g.props[k].datalen = prop_length;
689 if (full_object_g.propdatasize + prop_length
690 > MAX_OBJ_PROP_TABLE_SIZE) {
691 memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
694 for (i=0; i<prop_length; i++) {
695 int ppos = full_object_g.propdatasize++;
696 full_object_g.propdata[ppos].value = prop_addr + 4*i;
697 full_object_g.propdata[ppos].marker = INHERIT_MV;
698 full_object_g.propdata[ppos].type = CONSTANT_OT;
702 /* The ordinary case: the full_object_g property
703 values simply overrides the class definition,
704 so we skip over the values in the class table. */
708 /* The case where the class defined a property which wasn't
709 defined at all in full_object_g: we copy out the data into
710 a new property added to full_object_g. */
711 k = full_object_g.numprops++;
712 full_object_g.props[k].num = prop_number;
713 full_object_g.props[k].flags = prop_flags;
714 full_object_g.props[k].datastart = full_object_g.propdatasize;
715 full_object_g.props[k].continuation = 0;
716 full_object_g.props[k].datalen = prop_length;
717 if (full_object_g.propdatasize + prop_length
718 > MAX_OBJ_PROP_TABLE_SIZE) {
719 memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
722 for (i=0; i<prop_length; i++) {
723 int ppos = full_object_g.propdatasize++;
724 full_object_g.propdata[ppos].value = prop_addr + 4*i;
725 full_object_g.propdata[ppos].marker = INHERIT_MV;
726 full_object_g.propdata[ppos].type = CONSTANT_OT;
730 if (full_object_g.numprops == MAX_OBJ_PROP_COUNT) {
731 memoryerror("MAX_OBJ_PROP_COUNT",MAX_OBJ_PROP_COUNT);
738 /* ------------------------------------------------------------------------- */
739 /* Construction of Z-machine-format property blocks. */
740 /* ------------------------------------------------------------------------- */
742 static int write_properties_between(uchar *p, int mark, int from, int to)
743 { int j, k, prop_number, prop_length;
744 /* Note that p is properties_table. */
745 for (prop_number=to; prop_number>=from; prop_number--)
746 { for (j=0; j<full_object.l; j++)
747 { if ((full_object.pp[j].num == prop_number)
748 && (full_object.pp[j].l != 100))
749 { prop_length = 2*full_object.pp[j].l;
750 if (mark+2+prop_length >= MAX_PROP_TABLE_SIZE)
751 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
752 if (version_number == 3)
753 p[mark++] = prop_number + (prop_length - 1)*32;
755 { switch(prop_length)
757 p[mark++] = prop_number; break;
759 p[mark++] = prop_number + 0x40; break;
761 p[mark++] = prop_number + 0x80;
762 p[mark++] = prop_length + 0x80; break;
766 for (k=0; k<full_object.pp[j].l; k++)
767 { if (full_object.pp[j].ao[k].marker != 0)
768 backpatch_zmachine(full_object.pp[j].ao[k].marker,
770 p[mark++] = full_object.pp[j].ao[k].value/256;
771 p[mark++] = full_object.pp[j].ao[k].value%256;
781 static int write_property_block_z(char *shortname)
783 /* Compile the (now complete) full_object properties into a
784 property-table block at "p" in Inform's memory.
785 "shortname" is the object's short name, if specified; otherwise
788 Return the number of bytes written to the block. */
790 int32 mark = properties_table_size, i;
791 uchar *p = (uchar *) properties_table;
793 /* printf("Object at %04x\n", mark); */
795 if (shortname != NULL)
797 if (mark+1+510 >= MAX_PROP_TABLE_SIZE)
798 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
799 tmp = translate_text(p+mark+1,p+mark+1+510,shortname);
800 if (!tmp) error ("Short name of object exceeded 765 Z-characters");
801 i = subtract_pointers(tmp,(p+mark+1));
805 if (current_defn_is_class)
806 { mark = write_properties_between(p,mark,3,3);
808 p[mark++] = full_object.atts[i];
809 class_begins_at[no_classes++] = mark;
812 mark = write_properties_between(p, mark, 1, (version_number==3)?31:63);
814 i = mark - properties_table_size;
815 properties_table_size = mark;
820 static int gpropsort(void *ptr1, void *ptr2)
825 if (prop2->num == -1)
827 if (prop1->num == -1)
829 if (prop1->num < prop2->num)
831 if (prop1->num > prop2->num)
834 return (prop1->continuation - prop2->continuation);
837 static int32 write_property_block_g(void)
839 /* Compile the (now complete) full_object properties into a
840 property-table block at "p" in Inform's memory.
841 Return the number of bytes written to the block.
842 In Glulx, the shortname property isn't used here; it's already
843 been compiled into an ordinary string. */
846 int ix, jx, kx, totalprops;
847 int32 mark = properties_table_size;
849 uchar *p = (uchar *) properties_table;
851 if (current_defn_is_class) {
852 for (i=0;i<NUM_ATTR_BYTES;i++)
853 p[mark++] = full_object_g.atts[i];
854 class_begins_at[no_classes++] = mark;
857 qsort(full_object_g.props, full_object_g.numprops, sizeof(propg),
858 (int (*)(const void *, const void *))(&gpropsort));
860 full_object_g.finalpropaddr = mark;
864 for (ix=0; ix<full_object_g.numprops; ix=jx) {
865 int propnum = full_object_g.props[ix].num;
869 jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
874 /* Write out the number of properties in this table. */
875 if (mark+4 >= MAX_PROP_TABLE_SIZE)
876 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
877 WriteInt32(p+mark, totalprops);
880 datamark = mark + 10*totalprops;
882 for (ix=0; ix<full_object_g.numprops; ix=jx) {
883 int propnum = full_object_g.props[ix].num;
884 int flags = full_object_g.props[ix].flags;
886 int32 datamarkstart = datamark;
890 jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
892 int32 datastart = full_object_g.props[jx].datastart;
893 if (datamark+4*full_object_g.props[jx].datalen >= MAX_PROP_TABLE_SIZE)
894 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
895 for (kx=0; kx<full_object_g.props[jx].datalen; kx++) {
896 int32 val = full_object_g.propdata[datastart+kx].value;
897 WriteInt32(p+datamark, val);
898 if (full_object_g.propdata[datastart+kx].marker != 0)
899 backpatch_zmachine(full_object_g.propdata[datastart+kx].marker,
905 if (mark+10 >= MAX_PROP_TABLE_SIZE)
906 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
907 WriteInt16(p+mark, propnum);
909 WriteInt16(p+mark, totallen);
911 WriteInt32(p+mark, datamarkstart);
913 WriteInt16(p+mark, flags);
919 i = mark - properties_table_size;
920 properties_table_size = mark;
924 /* ------------------------------------------------------------------------- */
925 /* The final stage in Nearby/Object/Class definition processing. */
926 /* ------------------------------------------------------------------------- */
928 static void manufacture_object_z(void)
931 segment_markers.enabled = FALSE;
932 directives.enabled = TRUE;
934 property_inheritance_z();
936 objectsz[no_objects].parent = parent_of_this_obj;
937 objectsz[no_objects].next = 0;
938 objectsz[no_objects].child = 0;
940 if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fff))
941 { i = objectsz[parent_of_this_obj-1].child;
943 objectsz[parent_of_this_obj-1].child = no_objects + 1;
945 { while(objectsz[i-1].next != 0) i = objectsz[i-1].next;
946 objectsz[i-1].next = no_objects+1;
950 /* The properties table consists simply of a sequence of property
951 blocks, one for each object in order of definition, exactly as
952 it will appear in the final Z-machine. */
954 j = write_property_block_z(shortname_buffer);
956 objectsz[no_objects].propsize = j;
957 if (properties_table_size >= MAX_PROP_TABLE_SIZE)
958 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
960 if (current_defn_is_class)
961 for (i=0;i<6;i++) objectsz[no_objects].atts[i] = 0;
964 objectsz[no_objects].atts[i] = full_object.atts[i];
969 static void manufacture_object_g(void)
972 segment_markers.enabled = FALSE;
973 directives.enabled = TRUE;
975 property_inheritance_g();
977 objectsg[no_objects].parent = parent_of_this_obj;
978 objectsg[no_objects].next = 0;
979 objectsg[no_objects].child = 0;
981 if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fffffff))
982 { i = objectsg[parent_of_this_obj-1].child;
984 objectsg[parent_of_this_obj-1].child = no_objects + 1;
986 { while(objectsg[i-1].next != 0) i = objectsg[i-1].next;
987 objectsg[i-1].next = no_objects+1;
991 objectsg[no_objects].shortname = compile_string(shortname_buffer,
994 /* The properties table consists simply of a sequence of property
995 blocks, one for each object in order of definition, exactly as
996 it will appear in the final machine image. */
998 j = write_property_block_g();
1000 objectsg[no_objects].propaddr = full_object_g.finalpropaddr;
1002 objectsg[no_objects].propsize = j;
1003 if (properties_table_size >= MAX_PROP_TABLE_SIZE)
1004 memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
1006 if (current_defn_is_class)
1007 for (i=0;i<NUM_ATTR_BYTES;i++)
1008 objectatts[no_objects*NUM_ATTR_BYTES+i] = 0;
1010 for (i=0;i<NUM_ATTR_BYTES;i++)
1011 objectatts[no_objects*NUM_ATTR_BYTES+i] = full_object_g.atts[i];
1017 /* ========================================================================= */
1018 /* [2] The Object/Nearby/Class directives parser: translating the syntax */
1019 /* into object specifications and then triggering off the above. */
1020 /* ========================================================================= */
1021 /* Properties ("with" or "private") segment. */
1022 /* ------------------------------------------------------------------------- */
1024 static int *defined_this_segment;
1025 static long defined_this_segment_size; /* calloc size */
1028 static void ensure_defined_this_segment(int newsize)
1030 int oldsize = defined_this_segment_size;
1031 defined_this_segment_size = newsize;
1032 my_recalloc(&defined_this_segment, sizeof(int), oldsize,
1033 defined_this_segment_size, "defined this segment table");
1036 static void properties_segment_z(int this_segment)
1038 /* Parse through the "with" part of an object/class definition:
1040 <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
1042 This routine also handles "private", with this_segment being equal
1043 to the token value for the introductory word ("private" or "with"). */
1046 int i, property_name_symbol, property_number=0, next_prop=0, length,
1047 individual_property, this_identifier_number;
1050 { get_next_token_with_directives();
1051 if ((token_type == SEGMENT_MARKER_TT)
1052 || (token_type == EOF_TT)
1053 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1054 { put_token_back(); return;
1057 if (token_type != SYMBOL_TT)
1058 { ebf_error("property name", token_text);
1062 individual_property = (stypes[token_value] != PROPERTY_T);
1064 if (individual_property)
1065 { if (sflags[token_value] & UNKNOWN_SFLAG)
1066 { this_identifier_number = no_individual_properties++;
1067 assign_symbol(token_value, this_identifier_number,
1068 INDIVIDUAL_PROPERTY_T);
1070 if (debugfile_switch)
1071 { debug_file_printf("<property>");
1073 ("<identifier>%s</identifier>", token_text);
1075 ("<value>%d</value>", this_identifier_number);
1076 debug_file_printf("</property>");
1081 { if (stypes[token_value]==INDIVIDUAL_PROPERTY_T)
1082 this_identifier_number = svals[token_value];
1084 { char already_error[128];
1085 sprintf(already_error,
1086 "\"%s\" is a name already in use (with type %s) \
1087 and may not be used as a property name too",
1088 token_text, typename(stypes[token_value]));
1089 error(already_error);
1094 if (def_t_s >= defined_this_segment_size)
1095 ensure_defined_this_segment(def_t_s*2);
1096 defined_this_segment[def_t_s++] = token_value;
1098 if (individual_prop_table_size++ == 0)
1099 { full_object.pp[full_object.l].num = 3;
1100 full_object.pp[full_object.l].l = 1;
1101 full_object.pp[full_object.l].ao[0].value
1102 = individuals_length;
1103 full_object.pp[full_object.l].ao[0].type = LONG_CONSTANT_OT;
1104 full_object.pp[full_object.l].ao[0].marker = INDIVPT_MV;
1106 i_m = individuals_length;
1109 individuals_table[i_m] = this_identifier_number/256;
1110 if (this_segment == PRIVATE_SEGMENT)
1111 individuals_table[i_m] |= 0x80;
1112 individuals_table[i_m+1] = this_identifier_number%256;
1114 backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
1115 individuals_table[i_m+2] = 0;
1118 { if (sflags[token_value] & UNKNOWN_SFLAG)
1119 { error_named("No such property name as", token_text);
1122 if (this_segment == PRIVATE_SEGMENT)
1123 error_named("Property should be declared in 'with', \
1124 not 'private':", token_text);
1125 if (def_t_s >= defined_this_segment_size)
1126 ensure_defined_this_segment(def_t_s*2);
1127 defined_this_segment[def_t_s++] = token_value;
1128 property_number = svals[token_value];
1130 next_prop=full_object.l++;
1131 full_object.pp[next_prop].num = property_number;
1134 for (i=0; i<(def_t_s-1); i++)
1135 if (defined_this_segment[i] == token_value)
1136 { error_named("Property given twice in the same declaration:",
1137 (char *) symbs[token_value]);
1140 if (svals[defined_this_segment[i]] == svals[token_value])
1141 { char error_b[128];
1143 "Property given twice in the same declaration, because \
1144 the names '%s' and '%s' actually refer to the same property",
1145 (char *) symbs[defined_this_segment[i]],
1146 (char *) symbs[token_value]);
1150 property_name_symbol = token_value;
1151 sflags[token_value] |= USED_SFLAG;
1155 { assembly_operand AO;
1156 get_next_token_with_directives();
1157 if ((token_type == EOF_TT)
1158 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1159 || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1162 if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1164 if ((!individual_property) && (property_number==1)
1165 && ((token_type != SQ_TT) || (strlen(token_text) <2 ))
1166 && (token_type != DQ_TT)
1168 warning ("'name' property should only contain dictionary words");
1170 if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1171 { char embedded_name[80];
1172 if (current_defn_is_class)
1173 { sprintf(embedded_name,
1174 "%s::%s", classname_text,
1175 (char *) symbs[property_name_symbol]);
1178 { sprintf(embedded_name,
1179 "%s.%s", objectname_text,
1180 (char *) symbs[property_name_symbol]);
1182 AO.value = parse_routine(NULL, TRUE, embedded_name, FALSE, -1);
1183 AO.type = LONG_CONSTANT_OT;
1184 AO.marker = IROUTINE_MV;
1186 directives.enabled = FALSE;
1187 segment_markers.enabled = TRUE;
1189 statements.enabled = FALSE;
1190 misc_keywords.enabled = FALSE;
1191 local_variables.enabled = FALSE;
1192 system_functions.enabled = FALSE;
1193 conditions.enabled = FALSE;
1197 /* A special rule applies to values in double-quotes of the
1198 built-in property "name", which always has number 1: such
1199 property values are dictionary entries and not static
1202 if ((!individual_property) &&
1203 (property_number==1) && (token_type == DQ_TT))
1204 { AO.value = dictionary_add(token_text, 0x80, 0, 0);
1205 AO.type = LONG_CONSTANT_OT;
1206 AO.marker = DWORD_MV;
1211 if ((token_type == SYMBOL_TT)
1212 && (stypes[token_value]==PROPERTY_T))
1214 /* This is not necessarily an error: it's possible
1215 to imagine a property whose value is a list
1216 of other properties to look up, but far more
1217 likely that a comma has been omitted in between
1218 two property blocks */
1221 "Missing ','? Property data seems to contain the property name",
1226 /* An ordinary value, then: */
1229 AO = parse_expression(ARRAY_CONTEXT);
1233 { error_named("Limit (of 32 values) exceeded for property",
1234 (char *) symbs[property_name_symbol]);
1238 if (individual_property)
1239 { if (AO.marker != 0)
1240 backpatch_zmachine(AO.marker, INDIVIDUAL_PROP_ZA,
1242 individuals_table[i_m+3+length++] = AO.value/256;
1243 individuals_table[i_m+3+length++] = AO.value%256;
1246 { full_object.pp[next_prop].ao[length/2] = AO;
1247 length = length + 2;
1252 /* People rarely do, but it is legal to declare a property without
1255 with name "fish", number, time_left;
1257 in which case the properties "number" and "time_left" are
1258 created as in effect variables and initialised to zero. */
1261 { if (individual_property)
1262 { individuals_table[i_m+3+length++] = 0;
1263 individuals_table[i_m+3+length++] = 0;
1266 { full_object.pp[next_prop].ao[0].value = 0;
1267 full_object.pp[next_prop].ao[0].type = LONG_CONSTANT_OT;
1268 full_object.pp[next_prop].ao[0].marker = 0;
1273 if ((version_number==3) && (!individual_property))
1276 warning_named("Version 3 limit of 4 values per property exceeded \
1277 (use -v5 to get 32), so truncating property",
1278 (char *) symbs[property_name_symbol]);
1279 full_object.pp[next_prop].l=4;
1283 if (individual_property)
1285 if (individuals_length+length+3 > MAX_INDIV_PROP_TABLE_SIZE)
1286 memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
1287 MAX_INDIV_PROP_TABLE_SIZE);
1288 individuals_table[i_m + 2] = length;
1289 individuals_length += length+3;
1290 i_m = individuals_length;
1293 full_object.pp[next_prop].l = length/2;
1295 if ((token_type == EOF_TT)
1296 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1297 { put_token_back(); return;
1304 static void properties_segment_g(int this_segment)
1306 /* Parse through the "with" part of an object/class definition:
1308 <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
1310 This routine also handles "private", with this_segment being equal
1311 to the token value for the introductory word ("private" or "with"). */
1315 individual_property, this_identifier_number;
1316 int32 property_name_symbol, property_number, length;
1319 { get_next_token_with_directives();
1320 if ((token_type == SEGMENT_MARKER_TT)
1321 || (token_type == EOF_TT)
1322 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1323 { put_token_back(); return;
1326 if (token_type != SYMBOL_TT)
1327 { ebf_error("property name", token_text);
1331 individual_property = (stypes[token_value] != PROPERTY_T);
1333 if (individual_property)
1334 { if (sflags[token_value] & UNKNOWN_SFLAG)
1335 { this_identifier_number = no_individual_properties++;
1336 assign_symbol(token_value, this_identifier_number,
1337 INDIVIDUAL_PROPERTY_T);
1339 if (debugfile_switch)
1340 { debug_file_printf("<property>");
1342 ("<identifier>%s</identifier>", token_text);
1344 ("<value>%d</value>", this_identifier_number);
1345 debug_file_printf("</property>");
1350 { if (stypes[token_value]==INDIVIDUAL_PROPERTY_T)
1351 this_identifier_number = svals[token_value];
1353 { char already_error[128];
1354 sprintf(already_error,
1355 "\"%s\" is a name already in use (with type %s) \
1356 and may not be used as a property name too",
1357 token_text, typename(stypes[token_value]));
1358 error(already_error);
1363 if (def_t_s >= defined_this_segment_size)
1364 ensure_defined_this_segment(def_t_s*2);
1365 defined_this_segment[def_t_s++] = token_value;
1366 property_number = svals[token_value];
1368 next_prop=full_object_g.numprops++;
1369 full_object_g.props[next_prop].num = property_number;
1370 full_object_g.props[next_prop].flags =
1371 ((this_segment == PRIVATE_SEGMENT) ? 1 : 0);
1372 full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1373 full_object_g.props[next_prop].continuation = 0;
1374 full_object_g.props[next_prop].datalen = 0;
1377 { if (sflags[token_value] & UNKNOWN_SFLAG)
1378 { error_named("No such property name as", token_text);
1381 if (this_segment == PRIVATE_SEGMENT)
1382 error_named("Property should be declared in 'with', \
1383 not 'private':", token_text);
1385 if (def_t_s >= defined_this_segment_size)
1386 ensure_defined_this_segment(def_t_s*2);
1387 defined_this_segment[def_t_s++] = token_value;
1388 property_number = svals[token_value];
1390 next_prop=full_object_g.numprops++;
1391 full_object_g.props[next_prop].num = property_number;
1392 full_object_g.props[next_prop].flags = 0;
1393 full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1394 full_object_g.props[next_prop].continuation = 0;
1395 full_object_g.props[next_prop].datalen = 0;
1398 for (i=0; i<(def_t_s-1); i++)
1399 if (defined_this_segment[i] == token_value)
1400 { error_named("Property given twice in the same declaration:",
1401 (char *) symbs[token_value]);
1404 if (svals[defined_this_segment[i]] == svals[token_value])
1405 { char error_b[128];
1407 "Property given twice in the same declaration, because \
1408 the names '%s' and '%s' actually refer to the same property",
1409 (char *) symbs[defined_this_segment[i]],
1410 (char *) symbs[token_value]);
1414 if (full_object_g.numprops == MAX_OBJ_PROP_COUNT) {
1415 memoryerror("MAX_OBJ_PROP_COUNT",MAX_OBJ_PROP_COUNT);
1418 property_name_symbol = token_value;
1419 sflags[token_value] |= USED_SFLAG;
1423 { assembly_operand AO;
1424 get_next_token_with_directives();
1425 if ((token_type == EOF_TT)
1426 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1427 || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1430 if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1432 if ((!individual_property) && (property_number==1)
1433 && (token_type != SQ_TT) && (token_type != DQ_TT)
1435 warning ("'name' property should only contain dictionary words");
1437 if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1438 { char embedded_name[80];
1439 if (current_defn_is_class)
1440 { sprintf(embedded_name,
1441 "%s::%s", classname_text,
1442 (char *) symbs[property_name_symbol]);
1445 { sprintf(embedded_name,
1446 "%s.%s", objectname_text,
1447 (char *) symbs[property_name_symbol]);
1449 AO.value = parse_routine(NULL, TRUE, embedded_name, FALSE, -1);
1450 AO.type = CONSTANT_OT;
1451 AO.marker = IROUTINE_MV;
1453 directives.enabled = FALSE;
1454 segment_markers.enabled = TRUE;
1456 statements.enabled = FALSE;
1457 misc_keywords.enabled = FALSE;
1458 local_variables.enabled = FALSE;
1459 system_functions.enabled = FALSE;
1460 conditions.enabled = FALSE;
1464 /* A special rule applies to values in double-quotes of the
1465 built-in property "name", which always has number 1: such
1466 property values are dictionary entries and not static
1469 if ((!individual_property) &&
1470 (property_number==1) && (token_type == DQ_TT))
1471 { AO.value = dictionary_add(token_text, 0x80, 0, 0);
1472 AO.type = CONSTANT_OT;
1473 AO.marker = DWORD_MV;
1478 if ((token_type == SYMBOL_TT)
1479 && (stypes[token_value]==PROPERTY_T))
1481 /* This is not necessarily an error: it's possible
1482 to imagine a property whose value is a list
1483 of other properties to look up, but far more
1484 likely that a comma has been omitted in between
1485 two property blocks */
1488 "Missing ','? Property data seems to contain the property name",
1493 /* An ordinary value, then: */
1496 AO = parse_expression(ARRAY_CONTEXT);
1499 if (length == 32768) /* VENEER_CONSTRAINT_ON_PROP_TABLE_SIZE? */
1500 { error_named("Limit (of 32768 values) exceeded for property",
1501 (char *) symbs[property_name_symbol]);
1505 if (full_object_g.propdatasize >= MAX_OBJ_PROP_TABLE_SIZE) {
1506 memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
1509 full_object_g.propdata[full_object_g.propdatasize++] = AO;
1514 /* People rarely do, but it is legal to declare a property without
1517 with name "fish", number, time_left;
1519 in which case the properties "number" and "time_left" are
1520 created as in effect variables and initialised to zero. */
1524 assembly_operand AO;
1526 AO.type = CONSTANT_OT;
1528 full_object_g.propdata[full_object_g.propdatasize++] = AO;
1532 full_object_g.props[next_prop].datalen = length;
1534 if ((token_type == EOF_TT)
1535 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1536 { put_token_back(); return;
1542 static void properties_segment(int this_segment)
1545 properties_segment_z(this_segment);
1547 properties_segment_g(this_segment);
1550 /* ------------------------------------------------------------------------- */
1551 /* Attributes ("has") segment. */
1552 /* ------------------------------------------------------------------------- */
1554 static void attributes_segment(void)
1556 /* Parse through the "has" part of an object/class definition:
1558 [~]<attribute-1> [~]<attribute-2> ... [~]<attribute-n> */
1560 int attribute_number, truth_state, bitmask;
1563 { truth_state = TRUE;
1567 get_next_token_with_directives();
1568 if ((token_type == SEGMENT_MARKER_TT)
1569 || (token_type == EOF_TT)
1570 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1572 ebf_error("attribute name after '~'", token_text);
1573 put_token_back(); return;
1575 if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1577 if ((token_type == SEP_TT) && (token_value == ARTNOT_SEP))
1578 { truth_state = !truth_state; goto ParseAttrN;
1581 if ((token_type != SYMBOL_TT)
1582 || (stypes[token_value] != ATTRIBUTE_T))
1583 { ebf_error("name of an already-declared attribute", token_text);
1587 attribute_number = svals[token_value];
1588 sflags[token_value] |= USED_SFLAG;
1591 bitmask = (1 << (7-attribute_number%8));
1592 attrbyte = &(full_object.atts[attribute_number/8]);
1595 /* In Glulx, my prejudices rule, and therefore bits are numbered
1596 from least to most significant. This is the opposite of the
1597 way the Z-machine works. */
1598 bitmask = (1 << (attribute_number%8));
1599 attrbyte = &(full_object_g.atts[attribute_number/8]);
1603 *attrbyte |= bitmask; /* Set attribute bit */
1605 *attrbyte &= ~bitmask; /* Clear attribute bit */
1610 /* ------------------------------------------------------------------------- */
1611 /* Classes ("class") segment. */
1612 /* ------------------------------------------------------------------------- */
1614 static void add_class_to_inheritance_list(int class_number)
1618 /* The class number is actually the class's object number, which needs
1619 to be translated into its actual class number: */
1621 for (i=0;i<no_classes;i++)
1622 if (class_number == class_object_numbers[i])
1623 { class_number = i+1;
1627 /* Remember the inheritance list so that property inheritance can
1628 be sorted out later on, when the definition has been finished: */
1630 classes_to_inherit_from[no_classes_to_inherit_from++] = class_number;
1632 /* Inheriting attributes from the class at once: */
1637 |= properties_table[class_begins_at[class_number-1] - 6 + i];
1640 for (i=0; i<NUM_ATTR_BYTES; i++)
1641 full_object_g.atts[i]
1642 |= properties_table[class_begins_at[class_number-1]
1643 - NUM_ATTR_BYTES + i];
1647 static void classes_segment(void)
1649 /* Parse through the "class" part of an object/class definition:
1651 <class-1> ... <class-n> */
1654 { get_next_token_with_directives();
1655 if ((token_type == SEGMENT_MARKER_TT)
1656 || (token_type == EOF_TT)
1657 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1658 { put_token_back(); return;
1660 if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1662 if ((token_type != SYMBOL_TT)
1663 || (stypes[token_value] != CLASS_T))
1664 { ebf_error("name of an already-declared class", token_text);
1668 sflags[token_value] |= USED_SFLAG;
1669 add_class_to_inheritance_list(svals[token_value]);
1673 /* ------------------------------------------------------------------------- */
1674 /* Parse the body of a Nearby/Object/Class definition. */
1675 /* ------------------------------------------------------------------------- */
1677 static void parse_body_of_definition(void)
1678 { int commas_in_row;
1683 { commas_in_row = -1;
1685 { get_next_token_with_directives(); commas_in_row++;
1686 } while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
1688 if (commas_in_row>1)
1689 error("Two commas ',' in a row in object/class definition");
1691 if ((token_type == EOF_TT)
1692 || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1693 { if (commas_in_row > 0)
1694 error("Object/class definition finishes with ','");
1695 if (token_type == EOF_TT)
1696 error("Object/class definition incomplete (no ';') at end of file");
1700 if (token_type != SEGMENT_MARKER_TT)
1701 { error_named("Expected 'with', 'has' or 'class' in \
1702 object/class definition but found", token_text);
1707 { case WITH_SEGMENT:
1708 properties_segment(WITH_SEGMENT);
1710 case PRIVATE_SEGMENT:
1711 properties_segment(PRIVATE_SEGMENT);
1714 attributes_segment();
1725 /* ------------------------------------------------------------------------- */
1726 /* Class directives: */
1728 /* Class <name> <body of definition> */
1729 /* ------------------------------------------------------------------------- */
1731 static void initialise_full_object(void)
1736 full_object.atts[0] = 0;
1737 full_object.atts[1] = 0;
1738 full_object.atts[2] = 0;
1739 full_object.atts[3] = 0;
1740 full_object.atts[4] = 0;
1741 full_object.atts[5] = 0;
1744 full_object_g.numprops = 0;
1745 full_object_g.propdatasize = 0;
1746 for (i=0; i<NUM_ATTR_BYTES; i++)
1747 full_object_g.atts[i] = 0;
1751 extern void make_class(char * metaclass_name)
1752 { int n, duplicates_to_make = 0, class_number = no_objects+1,
1753 metaclass_flag = (metaclass_name != NULL);
1754 char duplicate_name[128];
1756 debug_location_beginning beginning_debug_location =
1757 get_token_location_beginning();
1759 current_defn_is_class = TRUE; no_classes_to_inherit_from = 0;
1760 individual_prop_table_size = 0;
1762 if (no_classes==MAX_CLASSES)
1763 memoryerror("MAX_CLASSES", MAX_CLASSES);
1765 if (no_classes==VENEER_CONSTRAINT_ON_CLASSES)
1766 fatalerror("Inform's maximum possible number of classes (whatever \
1767 amount of memory is allocated) has been reached. If this causes serious \
1768 inconvenience, please contact the maintainers.");
1770 directives.enabled = FALSE;
1773 { token_text = metaclass_name;
1774 token_value = symbol_index(token_text, -1);
1775 token_type = SYMBOL_TT;
1779 if ((token_type != SYMBOL_TT)
1780 || (!(sflags[token_value] & UNKNOWN_SFLAG)))
1781 { discard_token_location(beginning_debug_location);
1782 ebf_error("new class name", token_text);
1783 panic_mode_error_recovery();
1788 /* Each class also creates a modest object representing itself: */
1790 strcpy(shortname_buffer, token_text);
1792 assign_symbol(token_value, class_number, CLASS_T);
1793 classname_text = (char *) symbs[token_value];
1796 if (metaclass_flag) sflags[token_value] |= SYSTEM_SFLAG;
1799 /* In Glulx, metaclasses have to be backpatched too! So we can't
1800 mark it as "system", but we should mark it "used". */
1801 if (metaclass_flag) sflags[token_value] |= USED_SFLAG;
1804 /* "Class" (object 1) has no parent, whereas all other classes are
1805 the children of "Class". Since "Class" is not present in a module,
1806 a special value is used which is corrected to 1 by the linker. */
1808 if (metaclass_flag) parent_of_this_obj = 0;
1809 else parent_of_this_obj = (module_switch)?MAXINTWORD:1;
1811 class_object_numbers[no_classes] = class_number;
1813 initialise_full_object();
1815 /* Give the class the (nameless in Inform syntax) "inheritance" property
1816 with value its own class number. (This therefore accumulates onto
1817 the inheritance property of any object inheriting from the class,
1818 since property 2 is always set to "additive" -- see below) */
1822 full_object.pp[0].num = 2;
1823 full_object.pp[0].l = 1;
1824 full_object.pp[0].ao[0].value = no_objects + 1;
1825 full_object.pp[0].ao[0].type = LONG_CONSTANT_OT;
1826 full_object.pp[0].ao[0].marker = OBJECT_MV;
1829 full_object_g.numprops = 1;
1830 full_object_g.props[0].num = 2;
1831 full_object_g.props[0].flags = 0;
1832 full_object_g.props[0].datastart = 0;
1833 full_object_g.props[0].continuation = 0;
1834 full_object_g.props[0].datalen = 1;
1835 full_object_g.propdatasize = 1;
1836 full_object_g.propdata[0].value = no_objects + 1;
1837 full_object_g.propdata[0].type = CONSTANT_OT;
1838 full_object_g.propdata[0].marker = OBJECT_MV;
1841 class_symbol = token_value;
1843 if (!metaclass_flag)
1845 if ((token_type == SEP_TT) && (token_value == OPENB_SEP))
1846 { assembly_operand AO;
1847 AO = parse_expression(CONSTANT_CONTEXT);
1849 { error("Duplicate-number not known at compile time");
1854 if ((n<0) || (n>10000))
1855 { error("The number of duplicates must be 0 to 10000");
1859 /* Make one extra duplicate, since the veneer routines need
1860 always to keep an undamaged prototype for the class in stock */
1862 duplicates_to_make = n + 1;
1864 match_close_bracket();
1865 } else put_token_back();
1867 /* Parse the body of the definition: */
1869 parse_body_of_definition();
1872 if (debugfile_switch)
1873 { debug_file_printf("<class>");
1874 debug_file_printf("<identifier>%s</identifier>", shortname_buffer);
1875 debug_file_printf("<class-number>%d</class-number>", no_classes);
1876 debug_file_printf("<value>");
1877 write_debug_object_backpatch(no_objects + 1);
1878 debug_file_printf("</value>");
1879 write_debug_locations
1880 (get_token_location_end(beginning_debug_location));
1881 debug_file_printf("</class>");
1885 manufacture_object_z();
1887 manufacture_object_g();
1889 if (individual_prop_table_size >= VENEER_CONSTRAINT_ON_IP_TABLE_SIZE)
1890 error("This class is too complex: it now carries too many properties. \
1891 You may be able to get round this by declaring some of its property names as \
1892 \"common properties\" using the 'Property' directive.");
1894 if (duplicates_to_make > 0)
1895 { sprintf(duplicate_name, "%s_1", shortname_buffer);
1896 for (n=1; (duplicates_to_make--) > 0; n++)
1898 { int i = strlen(duplicate_name);
1899 while (duplicate_name[i] != '_') i--;
1900 sprintf(duplicate_name+i+1, "%d", n);
1902 make_object(FALSE, duplicate_name, class_number, class_number, -1);
1907 /* ------------------------------------------------------------------------- */
1908 /* Object/Nearby directives: */
1910 /* Object <name-1> ... <name-n> "short name" [parent] <body of def> */
1912 /* Nearby <name-1> ... <name-n> "short name" <body of definition> */
1913 /* ------------------------------------------------------------------------- */
1915 static int end_of_header(void)
1916 { if (((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1917 || ((token_type == SEP_TT) && (token_value == COMMA_SEP))
1918 || (token_type == SEGMENT_MARKER_TT)) return TRUE;
1922 extern void make_object(int nearby_flag,
1923 char *textual_name, int specified_parent, int specified_class,
1926 /* Ordinarily this is called with nearby_flag TRUE for "Nearby",
1927 FALSE for "Object"; and textual_name NULL, specified_parent and
1928 specified_class both -1. The next three arguments are used when
1929 the routine is called for class duplicates manufacture (see above).
1930 The last is used to create instances of a particular class. */
1932 int i, tree_depth, internal_name_symbol = 0;
1933 char internal_name[64];
1934 debug_location_beginning beginning_debug_location =
1935 get_token_location_beginning();
1937 directives.enabled = FALSE;
1939 if (no_objects==MAX_OBJECTS) memoryerror("MAX_OBJECTS", MAX_OBJECTS);
1941 sprintf(internal_name, "nameless_obj__%d", no_objects+1);
1942 objectname_text = internal_name;
1944 current_defn_is_class = FALSE;
1946 no_classes_to_inherit_from=0;
1948 individual_prop_table_size = 0;
1950 if (nearby_flag) tree_depth=1; else tree_depth=0;
1952 if (specified_class != -1) goto HeaderPassed;
1956 /* Read past and count a sequence of "->"s, if any are present */
1958 if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
1960 error("The syntax '->' is only used as an alternative to 'Nearby'");
1962 while ((token_type == SEP_TT) && (token_value == ARROW_SEP))
1968 sprintf(shortname_buffer, "?");
1970 segment_markers.enabled = TRUE;
1972 /* This first word is either an internal name, or a textual short name,
1973 or the end of the header part */
1975 if (end_of_header()) goto HeaderPassed;
1977 if (token_type == DQ_TT) textual_name = token_text;
1979 { if ((token_type != SYMBOL_TT)
1980 || (!(sflags[token_value] & UNKNOWN_SFLAG)))
1981 ebf_error("name for new object or its textual short name",
1984 { internal_name_symbol = token_value;
1985 strcpy(internal_name, token_text);
1989 /* The next word is either a parent object, or
1990 a textual short name, or the end of the header part */
1992 get_next_token_with_directives();
1993 if (end_of_header()) goto HeaderPassed;
1995 if (token_type == DQ_TT)
1996 { if (textual_name != NULL)
1997 error("Two textual short names given for only one object");
1999 textual_name = token_text;
2002 { if ((token_type != SYMBOL_TT)
2003 || (sflags[token_value] & UNKNOWN_SFLAG))
2004 { if (textual_name == NULL)
2005 ebf_error("parent object or the object's textual short name",
2008 ebf_error("parent object", token_text);
2010 else goto SpecParent;
2013 /* Finally, it's possible that there is still a parent object */
2016 if (end_of_header()) goto HeaderPassed;
2018 if (specified_parent != -1)
2019 ebf_error("body of object definition", token_text);
2022 if ((stypes[token_value] == OBJECT_T)
2023 || (stypes[token_value] == CLASS_T))
2024 { specified_parent = svals[token_value];
2025 sflags[token_value] |= USED_SFLAG;
2027 else ebf_error("name of (the parent) object", token_text);
2030 /* Now it really has to be the body of the definition. */
2032 get_next_token_with_directives();
2033 if (end_of_header()) goto HeaderPassed;
2035 ebf_error("body of object definition", token_text);
2038 if (specified_class == -1) put_token_back();
2040 if (internal_name_symbol > 0)
2041 assign_symbol(internal_name_symbol, no_objects + 1, OBJECT_T);
2043 if (listobjects_switch)
2044 printf("%3d \"%s\"\n", no_objects+1,
2045 (textual_name==NULL)?"(with no short name)":textual_name);
2046 if (textual_name == NULL)
2047 { if (internal_name_symbol > 0)
2048 sprintf(shortname_buffer, "(%s)",
2049 (char *) symbs[internal_name_symbol]);
2051 sprintf(shortname_buffer, "(%d)", no_objects+1);
2054 { if (strlen(textual_name)>765)
2055 error("Short name of object (in quotes) exceeded 765 characters");
2056 strncpy(shortname_buffer, textual_name, 765);
2059 if (specified_parent != -1)
2060 { if (tree_depth > 0)
2061 error("Use of '->' (or 'Nearby') clashes with giving a parent");
2062 parent_of_this_obj = specified_parent;
2065 { parent_of_this_obj = 0;
2068 /* We have to set the parent object to the most recently defined
2069 object at level (tree_depth - 1) in the tree.
2071 A complication is that objects are numbered 1, 2, ... in the
2072 Z-machine (and in the objects[].parent, etc., fields) but
2073 0, 1, 2, ... internally (and as indices to object[]). */
2075 for (i=no_objects-1; i>=0; i--)
2078 /* Metaclass or class objects cannot be '->' parents: */
2079 if ((!module_switch) && (i<4))
2083 if (objectsz[i].parent == 1)
2085 while (objectsz[j].parent != 0)
2086 { j = objectsz[j].parent - 1; k++; }
2089 if (objectsg[i].parent == 1)
2091 while (objectsg[j].parent != 0)
2092 { j = objectsg[j].parent - 1; k++; }
2095 if (k == tree_depth - 1)
2096 { parent_of_this_obj = i+1;
2100 if (parent_of_this_obj == 0)
2101 { if (tree_depth == 1)
2102 error("'->' (or 'Nearby') fails because there is no previous object");
2104 error("'-> -> ...' fails because no previous object is deep enough");
2109 initialise_full_object();
2110 if (instance_of != -1) add_class_to_inheritance_list(instance_of);
2112 if (specified_class == -1) parse_body_of_definition();
2113 else add_class_to_inheritance_list(specified_class);
2115 if (debugfile_switch)
2116 { debug_file_printf("<object>");
2117 if (internal_name_symbol > 0)
2118 { debug_file_printf("<identifier>%s</identifier>", internal_name);
2121 ("<identifier artificial=\"true\">%s</identifier>",
2124 debug_file_printf("<value>");
2125 write_debug_object_backpatch(no_objects + 1);
2126 debug_file_printf("</value>");
2127 write_debug_locations
2128 (get_token_location_end(beginning_debug_location));
2129 debug_file_printf("</object>");
2133 manufacture_object_z();
2135 manufacture_object_g();
2138 /* ========================================================================= */
2139 /* Data structure management routines */
2140 /* ------------------------------------------------------------------------- */
2142 extern void init_objects_vars(void)
2144 properties_table = NULL;
2145 prop_is_long = NULL;
2146 prop_is_additive = NULL;
2147 prop_default_value = NULL;
2152 classes_to_inherit_from = NULL;
2153 class_begins_at = NULL;
2156 extern void objects_begin_pass(void)
2158 properties_table_size=0;
2159 prop_is_long[1] = TRUE; prop_is_additive[1] = TRUE; /* "name" */
2160 prop_is_long[2] = TRUE; prop_is_additive[2] = TRUE; /* inheritance prop */
2162 prop_is_long[3] = TRUE; prop_is_additive[3] = FALSE;
2163 /* instance variables table address */
2166 if (debugfile_switch)
2167 { debug_file_printf("<property>");
2169 ("<identifier artificial=\"true\">inheritance class</identifier>");
2170 debug_file_printf("<value>2</value>");
2171 debug_file_printf("</property>");
2172 debug_file_printf("<property>");
2174 ("<identifier artificial=\"true\">instance variables table address "
2175 "(Z-code)</identifier>");
2176 debug_file_printf("<value>3</value>");
2177 debug_file_printf("</property>");
2180 if (define_INFIX_switch) no_attributes = 1;
2181 else no_attributes = 0;
2185 objectsz[0].parent = 0; objectsz[0].child = 0; objectsz[0].next = 0;
2186 no_individual_properties=72;
2189 objectsg[0].parent = 0; objectsg[0].child = 0; objectsg[0].next = 0;
2190 no_individual_properties = INDIV_PROP_START+8;
2194 no_embedded_routines = 0;
2196 individuals_length=0;
2199 extern void objects_allocate_arrays(void)
2205 prop_default_value = my_calloc(sizeof(int32), INDIV_PROP_START,
2206 "property default values");
2207 prop_is_long = my_calloc(sizeof(int), INDIV_PROP_START,
2208 "property-is-long flags");
2209 prop_is_additive = my_calloc(sizeof(int), INDIV_PROP_START,
2210 "property-is-additive flags");
2212 classes_to_inherit_from = my_calloc(sizeof(int), MAX_CLASSES,
2213 "inherited classes list");
2214 class_begins_at = my_calloc(sizeof(int32), MAX_CLASSES,
2215 "pointers to classes");
2216 class_object_numbers = my_calloc(sizeof(int), MAX_CLASSES,
2217 "class object numbers");
2219 properties_table = my_malloc(MAX_PROP_TABLE_SIZE,"properties table");
2220 individuals_table = my_malloc(MAX_INDIV_PROP_TABLE_SIZE,
2221 "individual properties table");
2223 defined_this_segment_size = 128;
2224 defined_this_segment = my_calloc(sizeof(int), defined_this_segment_size,
2225 "defined this segment table");
2228 objectsz = my_calloc(sizeof(objecttz), MAX_OBJECTS,
2232 objectsg = my_calloc(sizeof(objecttg), MAX_OBJECTS,
2234 objectatts = my_calloc(NUM_ATTR_BYTES, MAX_OBJECTS,
2236 full_object_g.props = my_calloc(sizeof(propg), MAX_OBJ_PROP_COUNT,
2237 "object property list");
2238 full_object_g.propdata = my_calloc(sizeof(assembly_operand),
2239 MAX_OBJ_PROP_TABLE_SIZE,
2240 "object property data table");
2244 extern void objects_free_arrays(void)
2246 my_free(&prop_default_value, "property default values");
2247 my_free(&prop_is_long, "property-is-long flags");
2248 my_free(&prop_is_additive, "property-is-additive flags");
2250 my_free(&objectsz, "z-objects");
2251 my_free(&objectsg, "g-objects");
2252 my_free(&objectatts, "g-attributes");
2253 my_free(&class_object_numbers,"class object numbers");
2254 my_free(&classes_to_inherit_from, "inherited classes list");
2255 my_free(&class_begins_at, "pointers to classes");
2257 my_free(&properties_table, "properties table");
2258 my_free(&individuals_table,"individual properties table");
2260 my_free(&defined_this_segment,"defined this segment table");
2263 my_free(&full_object_g.props, "object property list");
2264 my_free(&full_object_g.propdata, "object property data table");
2269 /* ========================================================================= */