/* ------------------------------------------------------------------------- *//* "objects" : [1] the object-maker, which constructs objects and enters *//* them into the tree, given a low-level specification; *//* *//* [2] the parser of Object/Nearby/Class directives, which *//* checks syntax and translates such directives into *//* specifications for the object-maker. *//* *//* Part of Inform 6.33 *//* copyright (c) Graham Nelson 1993 - 2014 *//* *//* ------------------------------------------------------------------------- */ #include "header.h" /* ------------------------------------------------------------------------- *//* Objects. *//* ------------------------------------------------------------------------- */ int no_objects; /* Number of objects made so far */ static int no_embedded_routines; /* Used for naming routines which are given as property values: these are called EmbeddedRoutine__1, ... */ static fpropt full_object; /* "fpropt" is a typedef for a struct containing an array to hold the attribute and property values of a single object. We only keep one of these, for the current object being made, and compile it into Z-machine tables when each object definition is complete, since sizeof(fpropt) is about 6200 bytes */static fproptg full_object_g; /* Equivalent for Glulx. This object is very small, since the large arrays are allocated dynamically by the Glulx compiler */static char shortname_buffer[766]; /* Text buffer to hold the short name (which is read in first, but written almost last) */static int parent_of_this_obj; static char *classname_text, *objectname_text; /* For printing names of embedded routines only */ /* ------------------------------------------------------------------------- *//* Classes. *//* ------------------------------------------------------------------------- *//* Arrays defined below: *//* *//* int32 class_begins_at[n] offset of properties block for *//* nth class (always an offset *//* inside the properties_table) *//* int classes_to_inherit_from[] The list of classes to inherit *//* from as taken from the current *//* Nearby/Object/Class definition *//* int class_object_numbers[n] The number of the prototype-object *//* for the nth class *//* ------------------------------------------------------------------------- */ int no_classes; /* Number of class defns made so far */ static int current_defn_is_class, /* TRUE if current Nearby/Object/Class defn is in fact a Class definition */ no_classes_to_inherit_from; /* Number of classes in the list of classes to inherit in the current Nearby/Object/Class defn */ /* ------------------------------------------------------------------------- *//* Making attributes and properties. *//* ------------------------------------------------------------------------- */ int no_attributes, /* Number of attributes defined so far */ no_properties; /* Number of properties defined so far, plus 1 (properties are numbered from 1 and Inform creates "name" and two others itself, so the variable begins the compilation pass set to 4) */ static void trace_s(char *name, int32 number, int f){ if (!printprops_switch) return; printf("%s %02ld ",(f==0)?"Attr":"Prop",(long int) number); if (f==0) printf(" "); else printf("%s%s",(prop_is_long[number])?"L":" ", (prop_is_additive[number])?"A":" "); printf(" %s\n",name);} extern void make_attribute(void){ int i; char *name; debug_location_beginning beginning_debug_location = get_token_location_beginning(); if (!glulx_mode) { if (no_attributes==((version_number==3)?32:48)) { discard_token_location(beginning_debug_location); if (version_number==3) error("All 32 attributes already declared (compile as Advanced \game to get an extra 16)"); else error("All 48 attributes already declared"); panic_mode_error_recovery(); put_token_back(); return; } } else { if (no_attributes==NUM_ATTR_BYTES*8) { discard_token_location(beginning_debug_location); error_numbered( "All attributes already declared -- increase NUM_ATTR_BYTES to use \more than", NUM_ATTR_BYTES*8); panic_mode_error_recovery(); put_token_back(); return; } } get_next_token(); i = token_value; name = token_text; if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG))) { discard_token_location(beginning_debug_location); ebf_error("new attribute name", token_text); panic_mode_error_recovery(); put_token_back(); return; } directive_keywords.enabled = TRUE; get_next_token(); directive_keywords.enabled = FALSE; if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK)) { get_next_token(); if (!((token_type == SYMBOL_TT) && (stypes[token_value] == ATTRIBUTE_T))) { discard_token_location(beginning_debug_location); ebf_error("an existing attribute name after 'alias'", token_text); panic_mode_error_recovery(); put_token_back(); return; } assign_symbol(i, svals[token_value], ATTRIBUTE_T); sflags[token_value] |= ALIASED_SFLAG; sflags[i] |= ALIASED_SFLAG; } else { assign_symbol(i, no_attributes++, ATTRIBUTE_T); put_token_back(); } if (debugfile_switch) { debug_file_printf("<attribute>"); debug_file_printf("<identifier>%s</identifier>", name); debug_file_printf("<value>%d</value>", svals[i]); write_debug_locations(get_token_location_end(beginning_debug_location)); debug_file_printf("</attribute>"); } trace_s(name, svals[i], 0); return;} extern void make_property(void){ int32 default_value, i; int additive_flag=FALSE; char *name; assembly_operand AO; debug_location_beginning beginning_debug_location = get_token_location_beginning(); if (!glulx_mode) { if (no_properties==((version_number==3)?32:64)) { discard_token_location(beginning_debug_location); if (version_number==3) error("All 30 properties already declared (compile as \Advanced game to get an extra 62)"); else error("All 62 properties already declared"); panic_mode_error_recovery(); put_token_back(); return; } } else { /* INDIV_PROP_START could be a memory setting */ if (no_properties==INDIV_PROP_START) { discard_token_location(beginning_debug_location); error_numbered("All properties already declared -- max is", INDIV_PROP_START); panic_mode_error_recovery(); put_token_back(); return; } } do { directive_keywords.enabled = TRUE; get_next_token(); if ((token_type == DIR_KEYWORD_TT) && (token_value == LONG_DK)) obsolete_warning("all properties are now automatically 'long'"); else if ((token_type == DIR_KEYWORD_TT) && (token_value == ADDITIVE_DK)) additive_flag = TRUE; else break; } while (TRUE); put_token_back(); directive_keywords.enabled = FALSE; get_next_token(); i = token_value; name = token_text; if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG))) { discard_token_location(beginning_debug_location); ebf_error("new property name", token_text); panic_mode_error_recovery(); put_token_back(); return; } directive_keywords.enabled = TRUE; get_next_token(); directive_keywords.enabled = FALSE; if (strcmp(name+strlen(name)-3, "_to") == 0) sflags[i] |= STAR_SFLAG; if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK)) { discard_token_location(beginning_debug_location); if (additive_flag) { error("'alias' incompatible with 'additive'"); panic_mode_error_recovery(); put_token_back(); return; } get_next_token(); if (!((token_type == SYMBOL_TT) && (stypes[token_value] == PROPERTY_T))) { ebf_error("an existing property name after 'alias'", token_text); panic_mode_error_recovery(); put_token_back(); return; } assign_symbol(i, svals[token_value], PROPERTY_T); trace_s(name, svals[i], 1); sflags[token_value] |= ALIASED_SFLAG; sflags[i] |= ALIASED_SFLAG; return; } default_value = 0; put_token_back(); if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) { AO = parse_expression(CONSTANT_CONTEXT); default_value = AO.value; if (AO.marker != 0) backpatch_zmachine(AO.marker, PROP_DEFAULTS_ZA, (no_properties-1) * WORDSIZE); } prop_default_value[no_properties] = default_value; prop_is_long[no_properties] = TRUE; prop_is_additive[no_properties] = additive_flag; assign_symbol(i, no_properties++, PROPERTY_T); if (debugfile_switch) { debug_file_printf("<property>"); debug_file_printf("<identifier>%s</identifier>", name); debug_file_printf("<value>%d</value>", svals[i]); write_debug_locations (get_token_location_end(beginning_debug_location)); debug_file_printf("</property>"); } trace_s(name, svals[i], 1);} /* ------------------------------------------------------------------------- *//* Properties. *//* ------------------------------------------------------------------------- */ int32 *prop_default_value; /* Default values for properties */int *prop_is_long, /* Property modifiers, TRUE or FALSE: "long" means "never write a 1-byte value to this property", and is an obsolete feature: since Inform 5 all properties have been "long" */ *prop_is_additive; /* "additive" means that values accumulate rather than erase each other during class inheritance */char *properties_table; /* Holds the table of property values (holding one block for each object and coming immediately after the object tree in Z-memory) */int properties_table_size; /* Number of bytes in this table */ /* ------------------------------------------------------------------------- *//* Individual properties *//* *//* Each new i.p. name is given a unique number. These numbers start from *//* 72, since 0 is reserved as a null, 1 to 63 refer to common properties *//* and 64 to 71 are kept for methods of the metaclass Class (for example, *//* 64 is "create"). *//* *//* An object provides individual properties by having property 3 set to a *//* non-zero value, which must be a byte address of a table in the form: *//* *//* <record-1> ... <record-n> 00 00 *//* *//* where a <record> looks like *//* *//* <identifier> <size> <up to 255 bytes of data> *//* or <identifier + 0x8000> *//* ----- 2 bytes ---------- 1 byte <size> number of bytes *//* *//* The <identifier> part is the number allocated to the name of what is *//* being provided. The top bit of this word is set to indicate that *//* although the individual property is being provided, it is provided *//* only privately (so that it is inaccessible except to the object's own *//* embedded routines). *//* *//* In Glulx: i-props are numbered from INDIV_PROP_START+8 up. And all *//* properties, common and individual, are stored in the same table. *//* ------------------------------------------------------------------------- */ int no_individual_properties; /* Actually equal to the next identifier number to be allocated, so this is initially 72 even though none have been made yet. */static int individual_prop_table_size; /* Size of the table of individual properties so far for current obj */ uchar *individuals_table; /* Table of records, each being the i.p. table for an object */ int i_m; /* Write mark position in the above */ int individuals_length; /* Extent of individuals_table */ /* ------------------------------------------------------------------------- *//* Arrays used by this file *//* ------------------------------------------------------------------------- */ objecttz *objectsz; /* Z-code only */objecttg *objectsg; /* Glulx only */uchar *objectatts; /* Glulx only */static int *classes_to_inherit_from;int *class_object_numbers;int32 *class_begins_at; /* ------------------------------------------------------------------------- *//* Tracing for compiler maintenance *//* ------------------------------------------------------------------------- */ extern void list_object_tree(void){ int i; printf("obj par nxt chl Object tree:\n"); for (i=0; i<no_objects; i++) printf("%3d %3d %3d %3d\n", i+1,objectsz[i].parent,objectsz[i].next, objectsz[i].child);} /* ------------------------------------------------------------------------- *//* Object and class manufacture begins here. *//* *//* These definitions have headers (parsed far, far below) and a series *//* of segments, introduced by keywords and optionally separated by commas. *//* Each segment has its own parsing routine. Note that when errors are *//* detected, parsing continues rather than being abandoned, which assists *//* a little in "error recovery" (i.e. in stopping lots more errors being *//* produced for essentially the same mistake). *//* ------------------------------------------------------------------------- */ /* ========================================================================= *//* [1] The object-maker: builds an object from a specification, viz.: *//* *//* full_object, *//* shortname_buffer, *//* parent_of_this_obj, *//* current_defn_is_class (flag) *//* classes_to_inherit_from[], no_classes_to_inherit_from, *//* individual_prop_table_size (to date ) *//* *//* For efficiency's sake, the individual properties table has already been *//* created (as far as possible, i.e., all except for inherited individual *//* properties); unless the flag is clear, in which case the actual *//* definition did not specify any individual properties. *//* ========================================================================= *//* Property inheritance from classes. *//* ------------------------------------------------------------------------- */ static void property_inheritance_z(void){ /* Apply the property inheritance rules to full_object, which should initially be complete (i.e., this routine takes place after the whole Nearby/Object/Class definition has been parsed through). On exit, full_object contains the final state of the properties to be written. */ int i, j, k, kmax, class, mark, prop_number, prop_length, prop_in_current_defn; uchar *class_prop_block; ASSERT_ZCODE(); for (class=0; class<no_classes_to_inherit_from; class++) { j=0; mark = class_begins_at[classes_to_inherit_from[class]-1]; class_prop_block = (uchar *) (properties_table + mark); while (class_prop_block[j]!=0) { if (version_number == 3) { prop_number = class_prop_block[j]%32; prop_length = 1 + class_prop_block[j++]/32; } else { prop_number = class_prop_block[j]%64; prop_length = 1 + class_prop_block[j++]/64; if (prop_length > 2) prop_length = class_prop_block[j++]%64; } /* So we now have property number prop_number present in the property block for the class being read: its bytes are class_prop_block[j, ..., j + prop_length - 1] Question now is: is there already a value given in the current definition under this property name? */ prop_in_current_defn = FALSE; kmax = full_object.l; for (k=0; k<kmax; k++) if (full_object.pp[k].num == prop_number) { prop_in_current_defn = TRUE; /* (Note that the built-in "name" property is additive) */ if ((prop_number==1) || (prop_is_additive[prop_number])) { /* The additive case: we accumulate the class property values onto the end of the full_object property */ for (i=full_object.pp[k].l; i<full_object.pp[k].l+prop_length/2; i++) { if (i >= 32) { error("An additive property has inherited \so many values that the list has overflowed the maximum 32 entries"); break; } full_object.pp[k].ao[i].value = mark + j; j += 2; full_object.pp[k].ao[i].marker = INHERIT_MV; full_object.pp[k].ao[i].type = LONG_CONSTANT_OT; } full_object.pp[k].l += prop_length/2; } else /* The ordinary case: the full_object property values simply overrides the class definition, so we skip over the values in the class table */ j+=prop_length; if (prop_number==3) { int y, z, class_block_offset; uchar *p; /* Property 3 holds the address of the table of instance variables, so this is the case where the object already has instance variables in its own table but must inherit some more from the class */ class_block_offset = class_prop_block[j-2]*256 + class_prop_block[j-1]; p = individuals_table + class_block_offset; z = class_block_offset; while ((p[0]!=0)||(p[1]!=0)) { int already_present = FALSE, l; for (l = full_object.pp[k].ao[0].value; l < i_m; l = l + 3 + individuals_table[l + 2]) if (individuals_table[l] == p[0] && individuals_table[l + 1] == p[1]) { already_present = TRUE; break; } if (already_present == FALSE) { if (module_switch) backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);Lines 1–500 of 2256. Load more
/* ------------------------------------------------------------------------- */ /* "objects" : [1] the object-maker, which constructs objects and enters */ /* them into the tree, given a low-level specification; */ /* */ /* [2] the parser of Object/Nearby/Class directives, which */ /* checks syntax and translates such directives into */ /* specifications for the object-maker. */ /* */ /* Part of Inform 6.33 */ /* copyright (c) Graham Nelson 1993 - 2014 */ /* */ /* ------------------------------------------------------------------------- */ #include "header.h" /* ------------------------------------------------------------------------- */ /* Objects. */ /* ------------------------------------------------------------------------- */ int no_objects; /* Number of objects made so far */ static int no_embedded_routines; /* Used for naming routines which are given as property values: these are called EmbeddedRoutine__1, ... */ static fpropt full_object; /* "fpropt" is a typedef for a struct containing an array to hold the attribute and property values of a single object. We only keep one of these, for the current object being made, and compile it into Z-machine tables when each object definition is complete, since sizeof(fpropt) is about 6200 bytes */ static fproptg full_object_g; /* Equivalent for Glulx. This object is very small, since the large arrays are allocated dynamically by the Glulx compiler */ static char shortname_buffer[766]; /* Text buffer to hold the short name (which is read in first, but written almost last) */ static int parent_of_this_obj; static char *classname_text, *objectname_text; /* For printing names of embedded routines only */ /* ------------------------------------------------------------------------- */ /* Classes. */ /* ------------------------------------------------------------------------- */ /* Arrays defined below: */ /* */ /* int32 class_begins_at[n] offset of properties block for */ /* nth class (always an offset */ /* inside the properties_table) */ /* int classes_to_inherit_from[] The list of classes to inherit */ /* from as taken from the current */ /* Nearby/Object/Class definition */ /* int class_object_numbers[n] The number of the prototype-object */ /* for the nth class */ /* ------------------------------------------------------------------------- */ int no_classes; /* Number of class defns made so far */ static int current_defn_is_class, /* TRUE if current Nearby/Object/Class defn is in fact a Class definition */ no_classes_to_inherit_from; /* Number of classes in the list of classes to inherit in the current Nearby/Object/Class defn */ /* ------------------------------------------------------------------------- */ /* Making attributes and properties. */ /* ------------------------------------------------------------------------- */ int no_attributes, /* Number of attributes defined so far */ no_properties; /* Number of properties defined so far, plus 1 (properties are numbered from 1 and Inform creates "name" and two others itself, so the variable begins the compilation pass set to 4) */ static void trace_s(char *name, int32 number, int f) { if (!printprops_switch) return; printf("%s %02ld ",(f==0)?"Attr":"Prop",(long int) number); if (f==0) printf(" "); else printf("%s%s",(prop_is_long[number])?"L":" ", (prop_is_additive[number])?"A":" "); printf(" %s\n",name); } extern void make_attribute(void) { int i; char *name; debug_location_beginning beginning_debug_location = get_token_location_beginning(); if (!glulx_mode) { if (no_attributes==((version_number==3)?32:48)) { discard_token_location(beginning_debug_location); if (version_number==3) error("All 32 attributes already declared (compile as Advanced \ game to get an extra 16)"); else error("All 48 attributes already declared"); panic_mode_error_recovery(); put_token_back(); return; } } else { if (no_attributes==NUM_ATTR_BYTES*8) { discard_token_location(beginning_debug_location); error_numbered( "All attributes already declared -- increase NUM_ATTR_BYTES to use \ more than", NUM_ATTR_BYTES*8); panic_mode_error_recovery(); put_token_back(); return; } } get_next_token(); i = token_value; name = token_text; if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG))) { discard_token_location(beginning_debug_location); ebf_error("new attribute name", token_text); panic_mode_error_recovery(); put_token_back(); return; } directive_keywords.enabled = TRUE; get_next_token(); directive_keywords.enabled = FALSE; if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK)) { get_next_token(); if (!((token_type == SYMBOL_TT) && (stypes[token_value] == ATTRIBUTE_T))) { discard_token_location(beginning_debug_location); ebf_error("an existing attribute name after 'alias'", token_text); panic_mode_error_recovery(); put_token_back(); return; } assign_symbol(i, svals[token_value], ATTRIBUTE_T); sflags[token_value] |= ALIASED_SFLAG; sflags[i] |= ALIASED_SFLAG; } else { assign_symbol(i, no_attributes++, ATTRIBUTE_T); put_token_back(); } if (debugfile_switch) { debug_file_printf("<attribute>"); debug_file_printf("<identifier>%s</identifier>", name); debug_file_printf("<value>%d</value>", svals[i]); write_debug_locations(get_token_location_end(beginning_debug_location)); debug_file_printf("</attribute>"); } trace_s(name, svals[i], 0); return; } extern void make_property(void) { int32 default_value, i; int additive_flag=FALSE; char *name; assembly_operand AO; debug_location_beginning beginning_debug_location = get_token_location_beginning(); if (!glulx_mode) { if (no_properties==((version_number==3)?32:64)) { discard_token_location(beginning_debug_location); if (version_number==3) error("All 30 properties already declared (compile as \ Advanced game to get an extra 62)"); else error("All 62 properties already declared"); panic_mode_error_recovery(); put_token_back(); return; } } else { /* INDIV_PROP_START could be a memory setting */ if (no_properties==INDIV_PROP_START) { discard_token_location(beginning_debug_location); error_numbered("All properties already declared -- max is", INDIV_PROP_START); panic_mode_error_recovery(); put_token_back(); return; } } do { directive_keywords.enabled = TRUE; get_next_token(); if ((token_type == DIR_KEYWORD_TT) && (token_value == LONG_DK)) obsolete_warning("all properties are now automatically 'long'"); else if ((token_type == DIR_KEYWORD_TT) && (token_value == ADDITIVE_DK)) additive_flag = TRUE; else break; } while (TRUE); put_token_back(); directive_keywords.enabled = FALSE; get_next_token(); i = token_value; name = token_text; if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG))) { discard_token_location(beginning_debug_location); ebf_error("new property name", token_text); panic_mode_error_recovery(); put_token_back(); return; } directive_keywords.enabled = TRUE; get_next_token(); directive_keywords.enabled = FALSE; if (strcmp(name+strlen(name)-3, "_to") == 0) sflags[i] |= STAR_SFLAG; if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK)) { discard_token_location(beginning_debug_location); if (additive_flag) { error("'alias' incompatible with 'additive'"); panic_mode_error_recovery(); put_token_back(); return; } get_next_token(); if (!((token_type == SYMBOL_TT) && (stypes[token_value] == PROPERTY_T))) { ebf_error("an existing property name after 'alias'", token_text); panic_mode_error_recovery(); put_token_back(); return; } assign_symbol(i, svals[token_value], PROPERTY_T); trace_s(name, svals[i], 1); sflags[token_value] |= ALIASED_SFLAG; sflags[i] |= ALIASED_SFLAG; return; } default_value = 0; put_token_back(); if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) { AO = parse_expression(CONSTANT_CONTEXT); default_value = AO.value; if (AO.marker != 0) backpatch_zmachine(AO.marker, PROP_DEFAULTS_ZA, (no_properties-1) * WORDSIZE); } prop_default_value[no_properties] = default_value; prop_is_long[no_properties] = TRUE; prop_is_additive[no_properties] = additive_flag; assign_symbol(i, no_properties++, PROPERTY_T); if (debugfile_switch) { debug_file_printf("<property>"); debug_file_printf("<identifier>%s</identifier>", name); debug_file_printf("<value>%d</value>", svals[i]); write_debug_locations (get_token_location_end(beginning_debug_location)); debug_file_printf("</property>"); } trace_s(name, svals[i], 1); } /* ------------------------------------------------------------------------- */ /* Properties. */ /* ------------------------------------------------------------------------- */ int32 *prop_default_value; /* Default values for properties */ int *prop_is_long, /* Property modifiers, TRUE or FALSE: "long" means "never write a 1-byte value to this property", and is an obsolete feature: since Inform 5 all properties have been "long" */ *prop_is_additive; /* "additive" means that values accumulate rather than erase each other during class inheritance */ char *properties_table; /* Holds the table of property values (holding one block for each object and coming immediately after the object tree in Z-memory) */ int properties_table_size; /* Number of bytes in this table */ /* ------------------------------------------------------------------------- */ /* Individual properties */ /* */ /* Each new i.p. name is given a unique number. These numbers start from */ /* 72, since 0 is reserved as a null, 1 to 63 refer to common properties */ /* and 64 to 71 are kept for methods of the metaclass Class (for example, */ /* 64 is "create"). */ /* */ /* An object provides individual properties by having property 3 set to a */ /* non-zero value, which must be a byte address of a table in the form: */ /* */ /* <record-1> ... <record-n> 00 00 */ /* */ /* where a <record> looks like */ /* */ /* <identifier> <size> <up to 255 bytes of data> */ /* or <identifier + 0x8000> */ /* ----- 2 bytes ---------- 1 byte <size> number of bytes */ /* */ /* The <identifier> part is the number allocated to the name of what is */ /* being provided. The top bit of this word is set to indicate that */ /* although the individual property is being provided, it is provided */ /* only privately (so that it is inaccessible except to the object's own */ /* embedded routines). */ /* */ /* In Glulx: i-props are numbered from INDIV_PROP_START+8 up. And all */ /* properties, common and individual, are stored in the same table. */ /* ------------------------------------------------------------------------- */ int no_individual_properties; /* Actually equal to the next identifier number to be allocated, so this is initially 72 even though none have been made yet. */ static int individual_prop_table_size; /* Size of the table of individual properties so far for current obj */ uchar *individuals_table; /* Table of records, each being the i.p. table for an object */ int i_m; /* Write mark position in the above */ int individuals_length; /* Extent of individuals_table */ /* ------------------------------------------------------------------------- */ /* Arrays used by this file */ /* ------------------------------------------------------------------------- */ objecttz *objectsz; /* Z-code only */ objecttg *objectsg; /* Glulx only */ uchar *objectatts; /* Glulx only */ static int *classes_to_inherit_from; int *class_object_numbers; int32 *class_begins_at; /* ------------------------------------------------------------------------- */ /* Tracing for compiler maintenance */ /* ------------------------------------------------------------------------- */ extern void list_object_tree(void) { int i; printf("obj par nxt chl Object tree:\n"); for (i=0; i<no_objects; i++) printf("%3d %3d %3d %3d\n", i+1,objectsz[i].parent,objectsz[i].next, objectsz[i].child); } /* ------------------------------------------------------------------------- */ /* Object and class manufacture begins here. */ /* */ /* These definitions have headers (parsed far, far below) and a series */ /* of segments, introduced by keywords and optionally separated by commas. */ /* Each segment has its own parsing routine. Note that when errors are */ /* detected, parsing continues rather than being abandoned, which assists */ /* a little in "error recovery" (i.e. in stopping lots more errors being */ /* produced for essentially the same mistake). */ /* ------------------------------------------------------------------------- */ /* ========================================================================= */ /* [1] The object-maker: builds an object from a specification, viz.: */ /* */ /* full_object, */ /* shortname_buffer, */ /* parent_of_this_obj, */ /* current_defn_is_class (flag) */ /* classes_to_inherit_from[], no_classes_to_inherit_from, */ /* individual_prop_table_size (to date ) */ /* */ /* For efficiency's sake, the individual properties table has already been */ /* created (as far as possible, i.e., all except for inherited individual */ /* properties); unless the flag is clear, in which case the actual */ /* definition did not specify any individual properties. */ /* ========================================================================= */ /* Property inheritance from classes. */ /* ------------------------------------------------------------------------- */ static void property_inheritance_z(void) { /* Apply the property inheritance rules to full_object, which should initially be complete (i.e., this routine takes place after the whole Nearby/Object/Class definition has been parsed through). On exit, full_object contains the final state of the properties to be written. */ int i, j, k, kmax, class, mark, prop_number, prop_length, prop_in_current_defn; uchar *class_prop_block; ASSERT_ZCODE(); for (class=0; class<no_classes_to_inherit_from; class++) { j=0; mark = class_begins_at[classes_to_inherit_from[class]-1]; class_prop_block = (uchar *) (properties_table + mark); while (class_prop_block[j]!=0) { if (version_number == 3) { prop_number = class_prop_block[j]%32; prop_length = 1 + class_prop_block[j++]/32; } else { prop_number = class_prop_block[j]%64; prop_length = 1 + class_prop_block[j++]/64; if (prop_length > 2) prop_length = class_prop_block[j++]%64; } /* So we now have property number prop_number present in the property block for the class being read: its bytes are class_prop_block[j, ..., j + prop_length - 1] Question now is: is there already a value given in the current definition under this property name? */ prop_in_current_defn = FALSE; kmax = full_object.l; for (k=0; k<kmax; k++) if (full_object.pp[k].num == prop_number) { prop_in_current_defn = TRUE; /* (Note that the built-in "name" property is additive) */ if ((prop_number==1) || (prop_is_additive[prop_number])) { /* The additive case: we accumulate the class property values onto the end of the full_object property */ for (i=full_object.pp[k].l; i<full_object.pp[k].l+prop_length/2; i++) { if (i >= 32) { error("An additive property has inherited \ so many values that the list has overflowed the maximum 32 entries"); break; } full_object.pp[k].ao[i].value = mark + j; j += 2; full_object.pp[k].ao[i].marker = INHERIT_MV; full_object.pp[k].ao[i].type = LONG_CONSTANT_OT; } full_object.pp[k].l += prop_length/2; } else /* The ordinary case: the full_object property values simply overrides the class definition, so we skip over the values in the class table */ j+=prop_length; if (prop_number==3) { int y, z, class_block_offset; uchar *p; /* Property 3 holds the address of the table of instance variables, so this is the case where the object already has instance variables in its own table but must inherit some more from the class */ class_block_offset = class_prop_block[j-2]*256 + class_prop_block[j-1]; p = individuals_table + class_block_offset; z = class_block_offset; while ((p[0]!=0)||(p[1]!=0)) { int already_present = FALSE, l; for (l = full_object.pp[k].ao[0].value; l < i_m; l = l + 3 + individuals_table[l + 2]) if (individuals_table[l] == p[0] && individuals_table[l + 1] == p[1]) { already_present = TRUE; break; } if (already_present == FALSE) { if (module_switch) backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);