2019-02-05 02:44:07 +02:00
/* ------------------------------------------------------------------------- */
/* "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. */
/* */
2024-02-27 00:51:15 +02:00
/* Part of Inform 6.43 */
2024-02-12 01:08:33 +02:00
/* copyright (c) Graham Nelson 1993 - 2024 */
2019-02-05 02:44:07 +02:00
/* */
/* ------------------------------------------------------------------------- */
# 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
2022-03-03 02:10:25 +02:00
are allocated dynamically as
memory - lists */
2024-02-12 01:08:33 +02:00
static char * shortname_buffer ; /* Text buffer to hold the short name
2019-02-05 02:44:07 +02:00
( which is read in first , but
written almost last ) */
2024-02-12 01:08:33 +02:00
static memory_list shortname_buffer_memlist ;
2019-02-05 02:44:07 +02:00
static int parent_of_this_obj ;
2022-03-03 02:10:25 +02:00
static memory_list current_object_name ; /* The name of the object currently
being defined . */
static int current_classname_symbol ; /* The symbol index of the class
currently being defined .
For error - checking and printing
names of embedded routines only . */
static memory_list embedded_function_name ; /* Temporary storage for inline
function name in property . */
2019-02-05 02:44:07 +02:00
/* ------------------------------------------------------------------------- */
/* Classes. */
/* ------------------------------------------------------------------------- */
/* Arrays defined below: */
/* */
2022-03-03 02:10:25 +02:00
/* classinfo class_info[] Object number and prop offset */
2019-02-05 02:44:07 +02:00
/* int classes_to_inherit_from[] The list of classes to inherit */
/* from as taken from the current */
/* Nearby/Object/Class definition */
/* ------------------------------------------------------------------------- */
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 ) */
2022-07-24 13:10:45 +03:00
/* Print a PROPS trace line. The f flag is 0 for an attribute, 1 for
a common property , 2 for an individual property . */
2019-02-05 02:44:07 +02:00
static void trace_s ( char * name , int32 number , int f )
2024-02-12 01:08:33 +02:00
{ char * stype = " " ;
if ( ! printprops_switch ) return ;
2022-07-24 13:10:45 +03:00
if ( f = = 0 ) stype = " Attr " ;
else if ( f = = 1 ) stype = " Prop " ;
else if ( f = = 2 ) stype = " Indiv " ;
printf ( " %-5s %02ld " , stype , ( long int ) number ) ;
if ( f ! = 1 ) printf ( " " ) ;
2022-03-03 02:10:25 +02:00
else printf ( " %s%s " , ( commonprops [ number ] . is_long ) ? " L " : " " ,
( commonprops [ number ] . is_additive ) ? " A " : " " ) ;
2024-02-12 01:08:33 +02:00
printf ( " %-24s (%s) \n " , name , current_location_text ( ) ) ;
2019-02-05 02:44:07 +02:00
}
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 ) ;
2024-02-12 01:08:33 +02:00
error_fmt (
" All %d attributes already declared -- increase NUM_ATTR_BYTES to use \
more " ,
2019-02-05 02:44:07 +02:00
NUM_ATTR_BYTES * 8 ) ;
panic_mode_error_recovery ( ) ;
put_token_back ( ) ;
return ;
}
}
get_next_token ( ) ;
i = token_value ; name = token_text ;
2022-03-03 02:10:25 +02:00
/* We hold onto token_text through the end of this Property directive, which should be okay. */
if ( token_type ! = SYMBOL_TT )
2019-02-05 02:44:07 +02:00
{ discard_token_location ( beginning_debug_location ) ;
2024-02-12 01:08:33 +02:00
ebf_curtoken_error ( " new attribute name " ) ;
2019-02-05 02:44:07 +02:00
panic_mode_error_recovery ( ) ;
put_token_back ( ) ;
return ;
}
2022-03-03 02:10:25 +02:00
if ( ! ( symbols [ i ] . flags & UNKNOWN_SFLAG ) )
{ discard_token_location ( beginning_debug_location ) ;
ebf_symbol_error ( " new attribute name " , token_text , typename ( symbols [ i ] . type ) , symbols [ i ] . line ) ;
panic_mode_error_recovery ( ) ;
put_token_back ( ) ;
return ;
}
2019-02-05 02:44:07 +02:00
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 )
2022-03-03 02:10:25 +02:00
& & ( symbols [ token_value ] . type = = ATTRIBUTE_T ) ) )
2019-02-05 02:44:07 +02:00
{ discard_token_location ( beginning_debug_location ) ;
2024-02-12 01:08:33 +02:00
ebf_curtoken_error ( " an existing attribute name after 'alias' " ) ;
2019-02-05 02:44:07 +02:00
panic_mode_error_recovery ( ) ;
put_token_back ( ) ;
return ;
}
2022-03-03 02:10:25 +02:00
assign_symbol ( i , symbols [ token_value ] . value , ATTRIBUTE_T ) ;
symbols [ token_value ] . flags | = ALIASED_SFLAG ;
symbols [ i ] . flags | = ALIASED_SFLAG ;
2019-02-05 02:44:07 +02:00
}
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 ) ;
2022-03-03 02:10:25 +02:00
debug_file_printf ( " <value>%d</value> " , symbols [ i ] . value ) ;
2019-02-05 02:44:07 +02:00
write_debug_locations ( get_token_location_end ( beginning_debug_location ) ) ;
debug_file_printf ( " </attribute> " ) ;
}
2022-03-03 02:10:25 +02:00
trace_s ( name , symbols [ i ] . value , 0 ) ;
2019-02-05 02:44:07 +02:00
return ;
}
2022-03-03 02:10:25 +02:00
/* Format:
Property [ long ] [ additive ] name
Property [ long ] [ additive ] name alias oldname
Property [ long ] [ additive ] name defaultvalue
Property [ long ] individual name
*/
2019-02-05 02:44:07 +02:00
extern void make_property ( void )
{ int32 default_value , i ;
2022-03-03 02:10:25 +02:00
int keywords , prevkeywords ;
char * name ;
int namelen ;
int additive_flag , indiv_flag ;
2019-02-05 02:44:07 +02:00
debug_location_beginning beginning_debug_location =
get_token_location_beginning ( ) ;
2022-03-03 02:10:25 +02:00
/* The next bit is tricky. We want to accept any number of the keywords
" long " , " additive " , " individual " before the property name . But we
also want to accept " Property long " - - that ' s a legitimate
property name .
The solution is to keep track of which keywords we ' ve seen in
a bitmask , and another for one token previous . That way we
can back up one token if there ' s no name visible . */
keywords = prevkeywords = 0 ;
2019-02-05 02:44:07 +02:00
do
{ directive_keywords . enabled = TRUE ;
get_next_token ( ) ;
2022-03-03 02:10:25 +02:00
if ( ( token_type = = DIR_KEYWORD_TT ) & & ( token_value = = LONG_DK ) ) {
prevkeywords = keywords ;
keywords | = 1 ;
}
else if ( ( token_type = = DIR_KEYWORD_TT ) & & ( token_value = = ADDITIVE_DK ) ) {
prevkeywords = keywords ;
keywords | = 2 ;
}
else if ( ( token_type = = DIR_KEYWORD_TT ) & & ( token_value = = INDIVIDUAL_DK ) ) {
prevkeywords = keywords ;
keywords | = 4 ;
}
else {
break ;
}
2019-02-05 02:44:07 +02:00
} while ( TRUE ) ;
2022-03-03 02:10:25 +02:00
/* Re-parse the name with keywords turned off. (This allows us to
accept a property name like " table " . ) */
2019-02-05 02:44:07 +02:00
put_token_back ( ) ;
directive_keywords . enabled = FALSE ;
get_next_token ( ) ;
2022-03-03 02:10:25 +02:00
if ( token_type ! = SYMBOL_TT & & keywords ) {
/* This can't be a name. Try putting back the last keyword. */
keywords = prevkeywords ;
put_token_back ( ) ;
put_token_back ( ) ;
get_next_token ( ) ;
}
additive_flag = indiv_flag = FALSE ;
if ( keywords & 1 )
obsolete_warning ( " all properties are now automatically 'long' " ) ;
if ( keywords & 2 )
additive_flag = TRUE ;
if ( keywords & 4 )
indiv_flag = TRUE ;
2019-02-05 02:44:07 +02:00
i = token_value ; name = token_text ;
2022-03-03 02:10:25 +02:00
/* We hold onto token_text through the end of this Property directive, which should be okay. */
if ( token_type ! = SYMBOL_TT )
2019-02-05 02:44:07 +02:00
{ discard_token_location ( beginning_debug_location ) ;
2024-02-12 01:08:33 +02:00
ebf_curtoken_error ( " new property name " ) ;
2019-02-05 02:44:07 +02:00
panic_mode_error_recovery ( ) ;
put_token_back ( ) ;
return ;
}
2022-03-03 02:10:25 +02:00
if ( ! ( symbols [ i ] . flags & UNKNOWN_SFLAG ) )
{ discard_token_location ( beginning_debug_location ) ;
ebf_symbol_error ( " new property name " , token_text , typename ( symbols [ i ] . type ) , symbols [ i ] . line ) ;
panic_mode_error_recovery ( ) ;
put_token_back ( ) ;
return ;
}
if ( indiv_flag ) {
int this_identifier_number ;
if ( additive_flag )
{ error ( " 'individual' incompatible with 'additive' " ) ;
panic_mode_error_recovery ( ) ;
put_token_back ( ) ;
return ;
}
this_identifier_number = no_individual_properties + + ;
assign_symbol ( i , this_identifier_number , INDIVIDUAL_PROPERTY_T ) ;
if ( debugfile_switch ) {
debug_file_printf ( " <property> " ) ;
debug_file_printf
( " <identifier>%s</identifier> " , name ) ;
debug_file_printf
( " <value>%d</value> " , this_identifier_number ) ;
debug_file_printf ( " </property> " ) ;
}
2022-07-24 13:10:45 +03:00
trace_s ( name , symbols [ i ] . value , 2 ) ;
2022-03-03 02:10:25 +02:00
return ;
}
2019-02-05 02:44:07 +02:00
directive_keywords . enabled = TRUE ;
get_next_token ( ) ;
directive_keywords . enabled = FALSE ;
2022-03-03 02:10:25 +02:00
namelen = strlen ( name ) ;
if ( namelen > 3 & & strcmp ( name + namelen - 3 , " _to " ) = = 0 ) {
/* Direction common properties "n_to", etc are compared in some
libraries . They have STAR_SFLAG to tell us to skip a warning . */
symbols [ i ] . flags | = STAR_SFLAG ;
}
/* Now we might have "alias" or a default value (but not both). */
2019-02-05 02:44:07 +02:00
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 )
2022-03-03 02:10:25 +02:00
& & ( symbols [ token_value ] . type = = PROPERTY_T ) ) )
2024-02-12 01:08:33 +02:00
{ ebf_curtoken_error ( " an existing property name after 'alias' " ) ;
2019-02-05 02:44:07 +02:00
panic_mode_error_recovery ( ) ;
put_token_back ( ) ;
return ;
}
2022-03-03 02:10:25 +02:00
assign_symbol ( i , symbols [ token_value ] . value , PROPERTY_T ) ;
trace_s ( name , symbols [ i ] . value , 1 ) ;
symbols [ token_value ] . flags | = ALIASED_SFLAG ;
symbols [ i ] . flags | = ALIASED_SFLAG ;
2019-02-05 02:44:07 +02:00
return ;
}
2022-03-03 02:10:25 +02:00
/* We now know we're allocating a new common property. Make sure
there ' s room . */
if ( ! glulx_mode ) {
if ( no_properties = = ( ( version_number = = 3 ) ? 32 : 64 ) )
{ discard_token_location ( beginning_debug_location ) ;
/* The maximum listed here includes "name" but not the
unused zero value or the two hidden properties ( class
inheritance and indiv table ) . */
if ( version_number = = 3 )
error ( " All 29 properties already declared (compile as \
Advanced game to get 32 more ) " );
else
error ( " All 61 properties already declared " ) ;
panic_mode_error_recovery ( ) ;
put_token_back ( ) ;
return ;
}
}
else {
if ( no_properties = = INDIV_PROP_START ) {
discard_token_location ( beginning_debug_location ) ;
2024-02-12 01:08:33 +02:00
error_fmt (
2022-03-03 02:10:25 +02:00
" All %d properties already declared (increase INDIV_PROP_START to get more) " ,
INDIV_PROP_START - 3 ) ;
panic_mode_error_recovery ( ) ;
put_token_back ( ) ;
return ;
}
}
2019-02-05 02:44:07 +02:00
default_value = 0 ;
put_token_back ( ) ;
if ( ! ( ( token_type = = SEP_TT ) & & ( token_value = = SEMICOLON_SEP ) ) )
2022-03-03 02:10:25 +02:00
{
assembly_operand AO = parse_expression ( CONSTANT_CONTEXT ) ;
2019-02-05 02:44:07 +02:00
default_value = AO . value ;
if ( AO . marker ! = 0 )
backpatch_zmachine ( AO . marker , PROP_DEFAULTS_ZA ,
( no_properties - 1 ) * WORDSIZE ) ;
}
2022-03-03 02:10:25 +02:00
commonprops [ no_properties ] . default_value = default_value ;
commonprops [ no_properties ] . is_long = TRUE ;
commonprops [ no_properties ] . is_additive = additive_flag ;
2019-02-05 02:44:07 +02:00
assign_symbol ( i , no_properties + + , PROPERTY_T ) ;
if ( debugfile_switch )
{ debug_file_printf ( " <property> " ) ;
debug_file_printf ( " <identifier>%s</identifier> " , name ) ;
2022-03-03 02:10:25 +02:00
debug_file_printf ( " <value>%d</value> " , symbols [ i ] . value ) ;
2019-02-05 02:44:07 +02:00
write_debug_locations
( get_token_location_end ( beginning_debug_location ) ) ;
debug_file_printf ( " </property> " ) ;
}
2022-03-03 02:10:25 +02:00
trace_s ( name , symbols [ i ] . value , 1 ) ;
2019-02-05 02:44:07 +02:00
}
/* ------------------------------------------------------------------------- */
/* Properties. */
/* ------------------------------------------------------------------------- */
2022-03-03 02:10:25 +02:00
commonpropinfo * commonprops ; /* Info about common properties
( fixed allocation of
INDIV_PROP_START entries ) */
uchar * properties_table ; /* Holds the table of property values
2019-02-05 02:44:07 +02:00
( holding one block for each object
and coming immediately after the
object tree in Z - memory ) */
2022-03-03 02:10:25 +02:00
memory_list properties_table_memlist ;
2019-02-05 02:44:07 +02:00
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 */
2022-03-03 02:10:25 +02:00
memory_list individuals_table_memlist ;
2019-02-05 02:44:07 +02:00
int i_m ; /* Write mark position in the above */
int individuals_length ; /* Extent of individuals_table */
/* ------------------------------------------------------------------------- */
/* Arrays used by this file */
/* ------------------------------------------------------------------------- */
2022-03-03 02:10:25 +02:00
objecttz * objectsz ; /* Allocated to no_objects; Z-code only */
memory_list objectsz_memlist ;
objecttg * objectsg ; /* Allocated to no_objects; Glulx only */
static memory_list objectsg_memlist ;
uchar * objectatts ; /* Allocated to no_objects; Glulx only */
static memory_list objectatts_memlist ;
static int * classes_to_inherit_from ; /* Allocated to no_classes_to_inherit_from */
static memory_list classes_to_inherit_from_memlist ;
classinfo * class_info ; /* Allocated up to no_classes */
memory_list class_info_memlist ;
2019-02-05 02:44:07 +02:00
/* ------------------------------------------------------------------------- */
/* Tracing for compiler maintenance */
/* ------------------------------------------------------------------------- */
extern void list_object_tree ( void )
{ int i ;
2022-07-24 13:10:45 +03:00
printf ( " Object tree: \n " ) ;
printf ( " obj name par nxt chl: \n " ) ;
for ( i = 0 ; i < no_objects ; i + + ) {
if ( ! glulx_mode ) {
int sym = objectsz [ i ] . symbol ;
char * symname = ( ( sym > 0 ) ? symbols [ sym ] . name : " ... " ) ;
printf ( " %3d %-32s %3d %3d %3d \n " ,
i + 1 , symname ,
objectsz [ i ] . parent , objectsz [ i ] . next , objectsz [ i ] . child ) ;
}
else {
int sym = objectsg [ i ] . symbol ;
char * symname = ( ( sym > 0 ) ? symbols [ sym ] . name : " ... " ) ;
printf ( " %3d %-32s %3d %3d %3d \n " ,
i + 1 , symname ,
objectsg [ i ] . parent , objectsg [ i ] . next , objectsg [ i ] . child ) ;
}
}
2019-02-05 02:44:07 +02:00
}
/* ------------------------------------------------------------------------- */
/* 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 ;
2022-03-03 02:10:25 +02:00
mark = class_info [ classes_to_inherit_from [ class ] - 1 ] . begins_at ;
class_prop_block = ( properties_table + mark ) ;
2019-02-05 02:44:07 +02:00
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 ;
2022-03-03 02:10:25 +02:00
if ( kmax > 64 )
fatalerror ( " More than 64 property entries in an object " ) ;
2019-02-05 02:44:07 +02:00
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) */
2022-03-03 02:10:25 +02:00
if ( ( prop_number = = 1 ) | | ( commonprops [ prop_number ] . is_additive ) )
2019-02-05 02:44:07 +02:00
{
/* 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 + + )
2024-02-12 01:08:33 +02:00
{
if ( i > = 32 )
2019-02-05 02:44:07 +02:00
{ error ( " An additive property has inherited \
so many values that the list has overflowed the maximum 32 entries " );
break ;
}
2024-02-12 01:08:33 +02:00
if ( ( version_number = = 3 ) & & i > = 4 )
{ error ( " An additive property has inherited \
so many values that the list has overflowed the maximum 4 entries " );
break ;
}
2022-03-03 02:10:25 +02:00
INITAOTV ( & full_object . pp [ k ] . ao [ i ] , LONG_CONSTANT_OT , mark + j ) ;
2019-02-05 02:44:07 +02:00
j + = 2 ;
full_object . pp [ k ] . ao [ i ] . marker = INHERIT_MV ;
}
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 ;
/* 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 ] ;
z = class_block_offset ;
2022-03-03 02:10:25 +02:00
while ( ( individuals_table [ z ] ! = 0 ) | | ( individuals_table [ z + 1 ] ! = 0 ) )
2019-02-05 02:44:07 +02:00
{ int already_present = FALSE , l ;
for ( l = full_object . pp [ k ] . ao [ 0 ] . value ; l < i_m ;
l = l + 3 + individuals_table [ l + 2 ] )
2022-03-03 02:10:25 +02:00
if ( individuals_table [ l ] = = individuals_table [ z ]
& & individuals_table [ l + 1 ] = = individuals_table [ z + 1 ] )
2019-02-05 02:44:07 +02:00
{ already_present = TRUE ; break ;
}
if ( already_present = = FALSE )
2022-07-24 13:10:45 +03:00
{
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & individuals_table_memlist , i_m + 3 + individuals_table [ z + 2 ] ) ;
individuals_table [ i_m + + ] = individuals_table [ z ] ;
individuals_table [ i_m + + ] = individuals_table [ z + 1 ] ;
individuals_table [ i_m + + ] = individuals_table [ z + 2 ] ;
for ( y = 0 ; y < individuals_table [ z + 2 ] / 2 ; y + + )
2019-02-05 02:44:07 +02:00
{ individuals_table [ i_m + + ] = ( z + 3 + y * 2 ) / 256 ;
individuals_table [ i_m + + ] = ( z + 3 + y * 2 ) % 256 ;
backpatch_zmachine ( INHERIT_INDIV_MV ,
INDIVIDUAL_PROP_ZA , i_m - 2 ) ;
}
}
2022-03-03 02:10:25 +02:00
z + = individuals_table [ z + 2 ] + 3 ;
2019-02-05 02:44:07 +02:00
}
individuals_length = i_m ;
}
/* For efficiency we exit the loop now (this property
number has been dealt with ) */
break ;
}
if ( ! prop_in_current_defn )
{
/* The case where the class defined a property which wasn't
defined at all in full_object : we copy out the data into
a new property added to full_object */
k = full_object . l + + ;
2022-03-03 02:10:25 +02:00
if ( k > = 64 )
fatalerror ( " More than 64 property entries in an object " ) ;
2019-02-05 02:44:07 +02:00
full_object . pp [ k ] . num = prop_number ;
full_object . pp [ k ] . l = prop_length / 2 ;
for ( i = 0 ; i < prop_length / 2 ; i + + )
2022-03-03 02:10:25 +02:00
{
INITAOTV ( & full_object . pp [ k ] . ao [ i ] , LONG_CONSTANT_OT , mark + j ) ;
2019-02-05 02:44:07 +02:00
j + = 2 ;
full_object . pp [ k ] . ao [ i ] . marker = INHERIT_MV ;
}
if ( prop_number = = 3 )
{ int y , z , class_block_offset ;
/* Property 3 holds the address of the table of
instance variables , so this is the case where
the object had no instance variables of its own
but must inherit some more from the class */
if ( individual_prop_table_size + + = = 0 )
{ full_object . pp [ k ] . num = 3 ;
full_object . pp [ k ] . l = 1 ;
2022-03-03 02:10:25 +02:00
INITAOTV ( & full_object . pp [ k ] . ao [ 0 ] , LONG_CONSTANT_OT , individuals_length ) ;
2019-02-05 02:44:07 +02:00
full_object . pp [ k ] . ao [ 0 ] . marker = INDIVPT_MV ;
i_m = individuals_length ;
}
class_block_offset = class_prop_block [ j - 2 ] * 256
+ class_prop_block [ j - 1 ] ;
z = class_block_offset ;
2022-03-03 02:10:25 +02:00
while ( ( individuals_table [ z ] ! = 0 ) | | ( individuals_table [ z + 1 ] ! = 0 ) )
2022-07-24 13:10:45 +03:00
{
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & individuals_table_memlist , i_m + 3 + individuals_table [ z + 2 ] ) ;
individuals_table [ i_m + + ] = individuals_table [ z ] ;
individuals_table [ i_m + + ] = individuals_table [ z + 1 ] ;
individuals_table [ i_m + + ] = individuals_table [ z + 2 ] ;
for ( y = 0 ; y < individuals_table [ z + 2 ] / 2 ; y + + )
2019-02-05 02:44:07 +02:00
{ individuals_table [ i_m + + ] = ( z + 3 + y * 2 ) / 256 ;
individuals_table [ i_m + + ] = ( z + 3 + y * 2 ) % 256 ;
backpatch_zmachine ( INHERIT_INDIV_MV ,
INDIVIDUAL_PROP_ZA , i_m - 2 ) ;
}
2022-03-03 02:10:25 +02:00
z + = individuals_table [ z + 2 ] + 3 ;
2019-02-05 02:44:07 +02:00
}
individuals_length = i_m ;
}
}
}
}
if ( individual_prop_table_size > 0 )
{
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & individuals_table_memlist , i_m + 2 ) ;
2019-02-05 02:44:07 +02:00
individuals_table [ i_m + + ] = 0 ;
individuals_table [ i_m + + ] = 0 ;
individuals_length + = 2 ;
}
}
static void property_inheritance_g ( 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 , class , num_props ,
prop_number , prop_length , prop_flags , prop_in_current_defn ;
int32 mark , prop_addr ;
uchar * cpb , * pe ;
ASSERT_GLULX ( ) ;
for ( class = 0 ; class < no_classes_to_inherit_from ; class + + ) {
2022-03-03 02:10:25 +02:00
mark = class_info [ classes_to_inherit_from [ class ] - 1 ] . begins_at ;
cpb = ( properties_table + mark ) ;
2019-02-05 02:44:07 +02:00
/* This now points to the compiled property-table for the class.
We ' ll have to go through and decompile it . ( For our sins . ) */
num_props = ReadInt32 ( cpb ) ;
for ( j = 0 ; j < num_props ; j + + ) {
pe = cpb + 4 + j * 10 ;
prop_number = ReadInt16 ( pe ) ;
pe + = 2 ;
prop_length = ReadInt16 ( pe ) ;
pe + = 2 ;
prop_addr = ReadInt32 ( pe ) ;
pe + = 4 ;
prop_flags = ReadInt16 ( pe ) ;
pe + = 2 ;
/* So we now have property number prop_number present in the
property block for the class being read . Its bytes are
cpb [ prop_addr . . . prop_addr + 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 ;
for ( k = 0 ; k < full_object_g . numprops ; k + + ) {
if ( full_object_g . props [ k ] . num = = prop_number ) {
prop_in_current_defn = TRUE ;
break ;
}
}
if ( prop_in_current_defn ) {
if ( ( prop_number = = 1 )
| | ( prop_number < INDIV_PROP_START
2022-03-03 02:10:25 +02:00
& & commonprops [ prop_number ] . is_additive ) ) {
2019-02-05 02:44:07 +02:00
/* The additive case: we accumulate the class
property values onto the end of the full_object
properties . Remember that k is still the index number
of the first prop - block matching our property number . */
int prevcont ;
if ( full_object_g . props [ k ] . continuation = = 0 ) {
full_object_g . props [ k ] . continuation = 1 ;
prevcont = 1 ;
}
else {
prevcont = full_object_g . props [ k ] . continuation ;
for ( k + + ; k < full_object_g . numprops ; k + + ) {
if ( full_object_g . props [ k ] . num = = prop_number ) {
prevcont = full_object_g . props [ k ] . continuation ;
}
}
}
k = full_object_g . numprops + + ;
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & full_object_g . props_memlist , k + 1 ) ;
2019-02-05 02:44:07 +02:00
full_object_g . props [ k ] . num = prop_number ;
full_object_g . props [ k ] . flags = 0 ;
full_object_g . props [ k ] . datastart = full_object_g . propdatasize ;
full_object_g . props [ k ] . continuation = prevcont + 1 ;
full_object_g . props [ k ] . datalen = prop_length ;
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & full_object_g . propdata_memlist , full_object_g . propdatasize + prop_length ) ;
2019-02-05 02:44:07 +02:00
for ( i = 0 ; i < prop_length ; i + + ) {
int ppos = full_object_g . propdatasize + + ;
2022-03-03 02:10:25 +02:00
INITAOTV ( & full_object_g . propdata [ ppos ] , CONSTANT_OT , prop_addr + 4 * i ) ;
2019-02-05 02:44:07 +02:00
full_object_g . propdata [ ppos ] . marker = INHERIT_MV ;
}
}
else {
/* The ordinary case: the full_object_g property
values simply overrides the class definition ,
so we skip over the values in the class table . */
}
}
else {
/* The case where the class defined a property which wasn't
defined at all in full_object_g : we copy out the data into
a new property added to full_object_g . */
k = full_object_g . numprops + + ;
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & full_object_g . props_memlist , k + 1 ) ;
2019-02-05 02:44:07 +02:00
full_object_g . props [ k ] . num = prop_number ;
full_object_g . props [ k ] . flags = prop_flags ;
full_object_g . props [ k ] . datastart = full_object_g . propdatasize ;
full_object_g . props [ k ] . continuation = 0 ;
full_object_g . props [ k ] . datalen = prop_length ;
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & full_object_g . propdata_memlist , full_object_g . propdatasize + prop_length ) ;
2019-02-05 02:44:07 +02:00
for ( i = 0 ; i < prop_length ; i + + ) {
int ppos = full_object_g . propdatasize + + ;
2022-03-03 02:10:25 +02:00
INITAOTV ( & full_object_g . propdata [ ppos ] , CONSTANT_OT , prop_addr + 4 * i ) ;
2019-02-05 02:44:07 +02:00
full_object_g . propdata [ ppos ] . marker = INHERIT_MV ;
}
}
}
}
}
/* ------------------------------------------------------------------------- */
/* Construction of Z-machine-format property blocks. */
/* ------------------------------------------------------------------------- */
2022-03-03 02:10:25 +02:00
static int write_properties_between ( int mark , int from , int to )
{ int j , k , prop_number ;
2019-02-05 02:44:07 +02:00
for ( prop_number = to ; prop_number > = from ; prop_number - - )
{ for ( j = 0 ; j < full_object . l ; j + + )
{ if ( ( full_object . pp [ j ] . num = = prop_number )
& & ( full_object . pp [ j ] . l ! = 100 ) )
2022-03-03 02:10:25 +02:00
{
int prop_length = 2 * full_object . pp [ j ] . l ;
ensure_memory_list_available ( & properties_table_memlist , mark + 2 + prop_length ) ;
2019-02-05 02:44:07 +02:00
if ( version_number = = 3 )
2022-03-03 02:10:25 +02:00
properties_table [ mark + + ] = prop_number + ( prop_length - 1 ) * 32 ;
2019-02-05 02:44:07 +02:00
else
{ switch ( prop_length )
{ case 1 :
2022-03-03 02:10:25 +02:00
properties_table [ mark + + ] = prop_number ; break ;
2019-02-05 02:44:07 +02:00
case 2 :
2022-03-03 02:10:25 +02:00
properties_table [ mark + + ] = prop_number + 0x40 ; break ;
2019-02-05 02:44:07 +02:00
default :
2022-03-03 02:10:25 +02:00
properties_table [ mark + + ] = prop_number + 0x80 ;
properties_table [ mark + + ] = prop_length + 0x80 ; break ;
2019-02-05 02:44:07 +02:00
}
}
for ( k = 0 ; k < full_object . pp [ j ] . l ; k + + )
2024-02-12 01:08:33 +02:00
{
if ( k > = 32 ) {
/* We catch this earlier, but we'll check again to avoid overflowing ao[] */
error ( " Too many values for Z-machine property " ) ;
break ;
}
if ( full_object . pp [ j ] . ao [ k ] . marker ! = 0 )
2019-02-05 02:44:07 +02:00
backpatch_zmachine ( full_object . pp [ j ] . ao [ k ] . marker ,
PROP_ZA , mark ) ;
2022-03-03 02:10:25 +02:00
properties_table [ mark + + ] = full_object . pp [ j ] . ao [ k ] . value / 256 ;
properties_table [ mark + + ] = full_object . pp [ j ] . ao [ k ] . value % 256 ;
2019-02-05 02:44:07 +02:00
}
}
}
}
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & properties_table_memlist , mark + 1 ) ;
properties_table [ mark + + ] = 0 ;
2019-02-05 02:44:07 +02:00
return ( mark ) ;
}
static int write_property_block_z ( char * shortname )
{
/* Compile the (now complete) full_object properties into a
property - table block at " p " in Inform ' s memory .
" shortname " is the object ' s short name , if specified ; otherwise
NULL .
Return the number of bytes written to the block . */
int32 mark = properties_table_size , i ;
/* printf("Object at %04x\n", mark); */
if ( shortname ! = NULL )
2022-03-03 02:10:25 +02:00
{
2024-02-12 01:08:33 +02:00
/* The limit of 510 bytes, or 765 Z-characters, is a Z-spec limit. */
2022-03-03 02:10:25 +02:00
i = translate_text ( 510 , shortname , STRCTX_OBJNAME ) ;
if ( i < 0 ) {
error ( " Short name of object exceeded 765 Z-characters " ) ;
i = 0 ;
}
ensure_memory_list_available ( & properties_table_memlist , mark + 1 + i ) ;
memcpy ( properties_table + mark + 1 , translated_text , i ) ;
properties_table [ mark ] = i / 2 ;
2019-02-05 02:44:07 +02:00
mark + = i + 1 ;
}
if ( current_defn_is_class )
2022-03-03 02:10:25 +02:00
{ mark = write_properties_between ( mark , 3 , 3 ) ;
ensure_memory_list_available ( & properties_table_memlist , mark + 6 ) ;
2019-02-05 02:44:07 +02:00
for ( i = 0 ; i < 6 ; i + + )
2022-03-03 02:10:25 +02:00
properties_table [ mark + + ] = full_object . atts [ i ] ;
ensure_memory_list_available ( & class_info_memlist , no_classes + 1 ) ;
class_info [ no_classes + + ] . begins_at = mark ;
2019-02-05 02:44:07 +02:00
}
2022-03-03 02:10:25 +02:00
mark = write_properties_between ( mark , 1 , ( version_number = = 3 ) ? 31 : 63 ) ;
2019-02-05 02:44:07 +02:00
i = mark - properties_table_size ;
properties_table_size = mark ;
return ( i ) ;
}
static int gpropsort ( void * ptr1 , void * ptr2 )
{
propg * prop1 = ptr1 ;
propg * prop2 = ptr2 ;
if ( prop2 - > num = = - 1 )
return - 1 ;
if ( prop1 - > num = = - 1 )
return 1 ;
if ( prop1 - > num < prop2 - > num )
return - 1 ;
if ( prop1 - > num > prop2 - > num )
return 1 ;
return ( prop1 - > continuation - prop2 - > continuation ) ;
}
static int32 write_property_block_g ( void )
{
/* Compile the (now complete) full_object properties into a
property - table block at " p " in Inform ' s memory .
Return the number of bytes written to the block .
In Glulx , the shortname property isn ' t used here ; it ' s already
been compiled into an ordinary string . */
int32 i ;
int ix , jx , kx , totalprops ;
int32 mark = properties_table_size ;
int32 datamark ;
if ( current_defn_is_class ) {
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & properties_table_memlist , mark + NUM_ATTR_BYTES ) ;
2019-02-05 02:44:07 +02:00
for ( i = 0 ; i < NUM_ATTR_BYTES ; i + + )
2022-03-03 02:10:25 +02:00
properties_table [ mark + + ] = full_object_g . atts [ i ] ;
ensure_memory_list_available ( & class_info_memlist , no_classes + 1 ) ;
class_info [ no_classes + + ] . begins_at = mark ;
2019-02-05 02:44:07 +02:00
}
qsort ( full_object_g . props , full_object_g . numprops , sizeof ( propg ) ,
( int ( * ) ( const void * , const void * ) ) ( & gpropsort ) ) ;
full_object_g . finalpropaddr = mark ;
totalprops = 0 ;
for ( ix = 0 ; ix < full_object_g . numprops ; ix = jx ) {
int propnum = full_object_g . props [ ix ] . num ;
if ( propnum = = - 1 )
break ;
for ( jx = ix ;
jx < full_object_g . numprops & & full_object_g . props [ jx ] . num = = propnum ;
jx + + ) ;
totalprops + + ;
}
/* Write out the number of properties in this table. */
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & properties_table_memlist , mark + 4 ) ;
WriteInt32 ( properties_table + mark , totalprops ) ;
2019-02-05 02:44:07 +02:00
mark + = 4 ;
datamark = mark + 10 * totalprops ;
for ( ix = 0 ; ix < full_object_g . numprops ; ix = jx ) {
int propnum = full_object_g . props [ ix ] . num ;
int flags = full_object_g . props [ ix ] . flags ;
int totallen = 0 ;
int32 datamarkstart = datamark ;
if ( propnum = = - 1 )
break ;
for ( jx = ix ;
jx < full_object_g . numprops & & full_object_g . props [ jx ] . num = = propnum ;
jx + + ) {
int32 datastart = full_object_g . props [ jx ] . datastart ;
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & properties_table_memlist , datamark + 4 * full_object_g . props [ jx ] . datalen ) ;
2019-02-05 02:44:07 +02:00
for ( kx = 0 ; kx < full_object_g . props [ jx ] . datalen ; kx + + ) {
int32 val = full_object_g . propdata [ datastart + kx ] . value ;
2022-03-03 02:10:25 +02:00
WriteInt32 ( properties_table + datamark , val ) ;
2019-02-05 02:44:07 +02:00
if ( full_object_g . propdata [ datastart + kx ] . marker ! = 0 )
backpatch_zmachine ( full_object_g . propdata [ datastart + kx ] . marker ,
PROP_ZA , datamark ) ;
totallen + + ;
datamark + = 4 ;
}
}
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & properties_table_memlist , mark + 10 ) ;
WriteInt16 ( properties_table + mark , propnum ) ;
2019-02-05 02:44:07 +02:00
mark + = 2 ;
2022-03-03 02:10:25 +02:00
WriteInt16 ( properties_table + mark , totallen ) ;
2019-02-05 02:44:07 +02:00
mark + = 2 ;
2022-03-03 02:10:25 +02:00
WriteInt32 ( properties_table + mark , datamarkstart ) ;
2019-02-05 02:44:07 +02:00
mark + = 4 ;
2022-03-03 02:10:25 +02:00
WriteInt16 ( properties_table + mark , flags ) ;
2019-02-05 02:44:07 +02:00
mark + = 2 ;
}
mark = datamark ;
i = mark - properties_table_size ;
properties_table_size = mark ;
return i ;
}
/* ------------------------------------------------------------------------- */
/* The final stage in Nearby/Object/Class definition processing. */
/* ------------------------------------------------------------------------- */
static void manufacture_object_z ( void )
{ int i , j ;
segment_markers . enabled = FALSE ;
directives . enabled = TRUE ;
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & objectsz_memlist , no_objects + 1 ) ;
2022-07-24 13:10:45 +03:00
objectsz [ no_objects ] . symbol = full_object . symbol ;
2022-03-03 02:10:25 +02:00
2019-02-05 02:44:07 +02:00
property_inheritance_z ( ) ;
objectsz [ no_objects ] . parent = parent_of_this_obj ;
objectsz [ no_objects ] . next = 0 ;
objectsz [ no_objects ] . child = 0 ;
if ( ( parent_of_this_obj > 0 ) & & ( parent_of_this_obj ! = 0x7fff ) )
{ i = objectsz [ parent_of_this_obj - 1 ] . child ;
if ( i = = 0 )
objectsz [ parent_of_this_obj - 1 ] . child = no_objects + 1 ;
else
{ while ( objectsz [ i - 1 ] . next ! = 0 ) i = objectsz [ i - 1 ] . next ;
objectsz [ i - 1 ] . next = no_objects + 1 ;
}
}
/* The properties table consists simply of a sequence of property
blocks , one for each object in order of definition , exactly as
it will appear in the final Z - machine . */
j = write_property_block_z ( shortname_buffer ) ;
objectsz [ no_objects ] . propsize = j ;
if ( current_defn_is_class )
for ( i = 0 ; i < 6 ; i + + ) objectsz [ no_objects ] . atts [ i ] = 0 ;
else
for ( i = 0 ; i < 6 ; i + + )
objectsz [ no_objects ] . atts [ i ] = full_object . atts [ i ] ;
no_objects + + ;
}
static void manufacture_object_g ( void )
{ int32 i , j ;
segment_markers . enabled = FALSE ;
directives . enabled = TRUE ;
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & objectsg_memlist , no_objects + 1 ) ;
ensure_memory_list_available ( & objectatts_memlist , no_objects + 1 ) ;
2022-07-24 13:10:45 +03:00
objectsg [ no_objects ] . symbol = full_object_g . symbol ;
2019-02-05 02:44:07 +02:00
property_inheritance_g ( ) ;
objectsg [ no_objects ] . parent = parent_of_this_obj ;
objectsg [ no_objects ] . next = 0 ;
objectsg [ no_objects ] . child = 0 ;
if ( ( parent_of_this_obj > 0 ) & & ( parent_of_this_obj ! = 0x7fffffff ) )
{ i = objectsg [ parent_of_this_obj - 1 ] . child ;
if ( i = = 0 )
objectsg [ parent_of_this_obj - 1 ] . child = no_objects + 1 ;
else
{ while ( objectsg [ i - 1 ] . next ! = 0 ) i = objectsg [ i - 1 ] . next ;
objectsg [ i - 1 ] . next = no_objects + 1 ;
}
}
objectsg [ no_objects ] . shortname = compile_string ( shortname_buffer ,
2022-03-03 02:10:25 +02:00
STRCTX_OBJNAME ) ;
2019-02-05 02:44:07 +02:00
/* The properties table consists simply of a sequence of property
blocks , one for each object in order of definition , exactly as
it will appear in the final machine image . */
j = write_property_block_g ( ) ;
objectsg [ no_objects ] . propaddr = full_object_g . finalpropaddr ;
objectsg [ no_objects ] . propsize = j ;
if ( current_defn_is_class )
for ( i = 0 ; i < NUM_ATTR_BYTES ; i + + )
objectatts [ no_objects * NUM_ATTR_BYTES + i ] = 0 ;
else
for ( i = 0 ; i < NUM_ATTR_BYTES ; i + + )
objectatts [ no_objects * NUM_ATTR_BYTES + i ] = full_object_g . atts [ i ] ;
no_objects + + ;
}
/* ========================================================================= */
/* [2] The Object/Nearby/Class directives parser: translating the syntax */
/* into object specifications and then triggering off the above. */
/* ========================================================================= */
/* Properties ("with" or "private") segment. */
/* ------------------------------------------------------------------------- */
static int * defined_this_segment ;
static long defined_this_segment_size ; /* calloc size */
static int def_t_s ;
static void ensure_defined_this_segment ( int newsize )
{
int oldsize = defined_this_segment_size ;
defined_this_segment_size = newsize ;
my_recalloc ( & defined_this_segment , sizeof ( int ) , oldsize ,
defined_this_segment_size , " defined this segment table " ) ;
}
static void properties_segment_z ( int this_segment )
{
/* Parse through the "with" part of an object/class definition:
< prop - 1 > < values . . . > , < prop - 2 > < values . . . > , . . . , < prop - n > < values . . . >
This routine also handles " private " , with this_segment being equal
to the token value for the introductory word ( " private " or " with " ) . */
int i , property_name_symbol , property_number = 0 , next_prop = 0 , length ,
individual_property , this_identifier_number ;
do
{ get_next_token_with_directives ( ) ;
if ( ( token_type = = SEGMENT_MARKER_TT )
| | ( token_type = = EOF_TT )
| | ( ( token_type = = SEP_TT ) & & ( token_value = = SEMICOLON_SEP ) ) )
{ put_token_back ( ) ; return ;
}
if ( token_type ! = SYMBOL_TT )
2024-02-12 01:08:33 +02:00
{ ebf_curtoken_error ( " property name " ) ;
2019-02-05 02:44:07 +02:00
return ;
}
2022-03-03 02:10:25 +02:00
individual_property = ( symbols [ token_value ] . type ! = PROPERTY_T ) ;
2019-02-05 02:44:07 +02:00
if ( individual_property )
2022-03-03 02:10:25 +02:00
{ if ( symbols [ token_value ] . flags & UNKNOWN_SFLAG )
2019-02-05 02:44:07 +02:00
{ this_identifier_number = no_individual_properties + + ;
assign_symbol ( token_value , this_identifier_number ,
INDIVIDUAL_PROPERTY_T ) ;
if ( debugfile_switch )
{ debug_file_printf ( " <property> " ) ;
debug_file_printf
( " <identifier>%s</identifier> " , token_text ) ;
debug_file_printf
( " <value>%d</value> " , this_identifier_number ) ;
debug_file_printf ( " </property> " ) ;
}
2022-07-24 13:10:45 +03:00
trace_s ( token_text , symbols [ token_value ] . value , 2 ) ;
2019-02-05 02:44:07 +02:00
}
else
2022-03-03 02:10:25 +02:00
{ if ( symbols [ token_value ] . type = = INDIVIDUAL_PROPERTY_T )
this_identifier_number = symbols [ token_value ] . value ;
2019-02-05 02:44:07 +02:00
else
2022-03-03 02:10:25 +02:00
{ ebf_symbol_error ( " property name " , token_text , typename ( symbols [ token_value ] . type ) , symbols [ token_value ] . line ) ;
2019-02-05 02:44:07 +02:00
return ;
}
}
if ( def_t_s > = defined_this_segment_size )
ensure_defined_this_segment ( def_t_s * 2 ) ;
defined_this_segment [ def_t_s + + ] = token_value ;
if ( individual_prop_table_size + + = = 0 )
2022-03-03 02:10:25 +02:00
{
int k = full_object . l + + ;
if ( k > = 64 )
fatalerror ( " More than 64 property entries in an object " ) ;
full_object . pp [ k ] . num = 3 ;
full_object . pp [ k ] . l = 1 ;
INITAOTV ( & full_object . pp [ k ] . ao [ 0 ] , LONG_CONSTANT_OT , individuals_length ) ;
full_object . pp [ k ] . ao [ 0 ] . marker = INDIVPT_MV ;
2019-02-05 02:44:07 +02:00
i_m = individuals_length ;
}
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & individuals_table_memlist , i_m + 3 ) ;
2019-02-05 02:44:07 +02:00
individuals_table [ i_m ] = this_identifier_number / 256 ;
if ( this_segment = = PRIVATE_SEGMENT )
individuals_table [ i_m ] | = 0x80 ;
individuals_table [ i_m + 1 ] = this_identifier_number % 256 ;
individuals_table [ i_m + 2 ] = 0 ;
}
else
2022-03-03 02:10:25 +02:00
{ if ( symbols [ token_value ] . flags & UNKNOWN_SFLAG )
2019-02-05 02:44:07 +02:00
{ error_named ( " No such property name as " , token_text ) ;
return ;
}
if ( this_segment = = PRIVATE_SEGMENT )
error_named ( " Property should be declared in 'with', \
not ' private ' : " , token_text);
if ( def_t_s > = defined_this_segment_size )
ensure_defined_this_segment ( def_t_s * 2 ) ;
defined_this_segment [ def_t_s + + ] = token_value ;
2022-03-03 02:10:25 +02:00
property_number = symbols [ token_value ] . value ;
2019-02-05 02:44:07 +02:00
next_prop = full_object . l + + ;
2022-03-03 02:10:25 +02:00
if ( next_prop > = 64 )
fatalerror ( " More than 64 property entries in an object " ) ;
2019-02-05 02:44:07 +02:00
full_object . pp [ next_prop ] . num = property_number ;
}
for ( i = 0 ; i < ( def_t_s - 1 ) ; i + + )
if ( defined_this_segment [ i ] = = token_value )
{ error_named ( " Property given twice in the same declaration: " ,
2022-03-03 02:10:25 +02:00
symbols [ token_value ] . name ) ;
2019-02-05 02:44:07 +02:00
}
else
2022-03-03 02:10:25 +02:00
if ( symbols [ defined_this_segment [ i ] ] . value = = symbols [ token_value ] . value )
2024-02-12 01:08:33 +02:00
{
error_fmt (
2019-02-05 02:44:07 +02:00
" Property given twice in the same declaration, because \
2024-02-12 01:08:33 +02:00
the names \ " %s \" and \" %s \" actually refer to the same property " ,
2022-03-03 02:10:25 +02:00
symbols [ defined_this_segment [ i ] ] . name ,
symbols [ token_value ] . name ) ;
2019-02-05 02:44:07 +02:00
}
property_name_symbol = token_value ;
2022-03-03 02:10:25 +02:00
symbols [ token_value ] . flags | = USED_SFLAG ;
2019-02-05 02:44:07 +02:00
length = 0 ;
do
{ assembly_operand AO ;
get_next_token_with_directives ( ) ;
if ( ( token_type = = EOF_TT )
| | ( ( token_type = = SEP_TT ) & & ( token_value = = SEMICOLON_SEP ) )
| | ( ( token_type = = SEP_TT ) & & ( token_value = = COMMA_SEP ) ) )
break ;
if ( token_type = = SEGMENT_MARKER_TT ) { put_token_back ( ) ; break ; }
if ( ( ! individual_property ) & & ( property_number = = 1 )
& & ( ( token_type ! = SQ_TT ) | | ( strlen ( token_text ) < 2 ) )
& & ( token_type ! = DQ_TT )
)
warning ( " 'name' property should only contain dictionary words " ) ;
if ( ( token_type = = SEP_TT ) & & ( token_value = = OPEN_SQUARE_SEP ) )
2022-03-03 02:10:25 +02:00
{
char * prefix , * sep , * sym ;
sym = symbols [ property_name_symbol ] . name ;
2019-02-05 02:44:07 +02:00
if ( current_defn_is_class )
2022-03-03 02:10:25 +02:00
{
prefix = symbols [ current_classname_symbol ] . name ;
sep = " :: " ;
2019-02-05 02:44:07 +02:00
}
else
2022-03-03 02:10:25 +02:00
{
prefix = current_object_name . data ;
sep = " . " ;
2019-02-05 02:44:07 +02:00
}
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & embedded_function_name , strlen ( prefix ) + strlen ( sep ) + strlen ( sym ) + 1 ) ;
sprintf ( embedded_function_name . data , " %s%s%s " , prefix , sep , sym ) ;
/* parse_routine() releases lexer text! */
AO . value = parse_routine ( NULL , TRUE , embedded_function_name . data , FALSE , - 1 ) ;
2019-02-05 02:44:07 +02:00
AO . type = LONG_CONSTANT_OT ;
AO . marker = IROUTINE_MV ;
directives . enabled = FALSE ;
segment_markers . enabled = TRUE ;
statements . enabled = FALSE ;
misc_keywords . enabled = FALSE ;
local_variables . enabled = FALSE ;
system_functions . enabled = FALSE ;
conditions . enabled = FALSE ;
}
else
/* A special rule applies to values in double-quotes of the
built - in property " name " , which always has number 1 : such
property values are dictionary entries and not static
strings */
if ( ( ! individual_property ) & &
( property_number = = 1 ) & & ( token_type = = DQ_TT ) )
2024-02-27 00:51:15 +02:00
{ AO . value = dictionary_add ( token_text , NOUN_DFLAG , 0 , 0 ) ;
2019-02-05 02:44:07 +02:00
AO . type = LONG_CONSTANT_OT ;
AO . marker = DWORD_MV ;
}
else
{ if ( length ! = 0 )
{
if ( ( token_type = = SYMBOL_TT )
2022-03-03 02:10:25 +02:00
& & ( symbols [ token_value ] . type = = PROPERTY_T ) )
2019-02-05 02:44:07 +02:00
{
/* This is not necessarily an error: it's possible
to imagine a property whose value is a list
of other properties to look up , but far more
likely that a comma has been omitted in between
two property blocks */
warning_named (
" Missing ','? Property data seems to contain the property name " ,
token_text ) ;
}
}
/* An ordinary value, then: */
put_token_back ( ) ;
AO = parse_expression ( ARRAY_CONTEXT ) ;
}
2024-02-12 01:08:33 +02:00
/* length is in bytes here, but we report the limit in words. */
2019-02-05 02:44:07 +02:00
if ( length = = 64 )
{ error_named ( " Limit (of 32 values) exceeded for property " ,
2022-03-03 02:10:25 +02:00
symbols [ property_name_symbol ] . name ) ;
2019-02-05 02:44:07 +02:00
break ;
}
2024-02-12 01:08:33 +02:00
if ( ( version_number = = 3 ) & & ( ! individual_property ) & & length = = 8 )
{ error_named ( " Limit (of 4 values) exceeded for property " ,
symbols [ property_name_symbol ] . name ) ;
break ;
}
2019-02-05 02:44:07 +02:00
if ( individual_property )
{ if ( AO . marker ! = 0 )
backpatch_zmachine ( AO . marker , INDIVIDUAL_PROP_ZA ,
i_m + 3 + length ) ;
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & individuals_table_memlist , i_m + 3 + length + 2 ) ;
2019-02-05 02:44:07 +02:00
individuals_table [ i_m + 3 + length + + ] = AO . value / 256 ;
individuals_table [ i_m + 3 + length + + ] = AO . value % 256 ;
}
else
{ full_object . pp [ next_prop ] . ao [ length / 2 ] = AO ;
length = length + 2 ;
}
} while ( TRUE ) ;
/* People rarely do, but it is legal to declare a property without
a value at all :
with name " fish " , number , time_left ;
in which case the properties " number " and " time_left " are
created as in effect variables and initialised to zero . */
if ( length = = 0 )
{ if ( individual_property )
2022-03-03 02:10:25 +02:00
{
ensure_memory_list_available ( & individuals_table_memlist , i_m + 3 + length + 2 ) ;
individuals_table [ i_m + 3 + length + + ] = 0 ;
2019-02-05 02:44:07 +02:00
individuals_table [ i_m + 3 + length + + ] = 0 ;
}
else
2022-03-03 02:10:25 +02:00
{
INITAOTV ( & full_object . pp [ next_prop ] . ao [ 0 ] , LONG_CONSTANT_OT , 0 ) ;
2019-02-05 02:44:07 +02:00
length = 2 ;
}
}
if ( individual_property )
{
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & individuals_table_memlist , individuals_length + length + 3 ) ;
2019-02-05 02:44:07 +02:00
individuals_table [ i_m + 2 ] = length ;
individuals_length + = length + 3 ;
i_m = individuals_length ;
}
else
full_object . pp [ next_prop ] . l = length / 2 ;
if ( ( token_type = = EOF_TT )
| | ( ( token_type = = SEP_TT ) & & ( token_value = = SEMICOLON_SEP ) ) )
{ put_token_back ( ) ; return ;
}
} while ( TRUE ) ;
}
static void properties_segment_g ( int this_segment )
{
/* Parse through the "with" part of an object/class definition:
< prop - 1 > < values . . . > , < prop - 2 > < values . . . > , . . . , < prop - n > < values . . . >
This routine also handles " private " , with this_segment being equal
to the token value for the introductory word ( " private " or " with " ) . */
int i , next_prop ,
individual_property , this_identifier_number ;
int32 property_name_symbol , property_number , length ;
do
{ get_next_token_with_directives ( ) ;
if ( ( token_type = = SEGMENT_MARKER_TT )
| | ( token_type = = EOF_TT )
| | ( ( token_type = = SEP_TT ) & & ( token_value = = SEMICOLON_SEP ) ) )
{ put_token_back ( ) ; return ;
}
if ( token_type ! = SYMBOL_TT )
2024-02-12 01:08:33 +02:00
{ ebf_curtoken_error ( " property name " ) ;
2019-02-05 02:44:07 +02:00
return ;
}
2022-03-03 02:10:25 +02:00
individual_property = ( symbols [ token_value ] . type ! = PROPERTY_T ) ;
2019-02-05 02:44:07 +02:00
if ( individual_property )
2022-03-03 02:10:25 +02:00
{ if ( symbols [ token_value ] . flags & UNKNOWN_SFLAG )
2019-02-05 02:44:07 +02:00
{ this_identifier_number = no_individual_properties + + ;
assign_symbol ( token_value , this_identifier_number ,
INDIVIDUAL_PROPERTY_T ) ;
if ( debugfile_switch )
{ debug_file_printf ( " <property> " ) ;
debug_file_printf
( " <identifier>%s</identifier> " , token_text ) ;
debug_file_printf
( " <value>%d</value> " , this_identifier_number ) ;
debug_file_printf ( " </property> " ) ;
}
2022-07-24 13:10:45 +03:00
trace_s ( token_text , symbols [ token_value ] . value , 2 ) ;
2019-02-05 02:44:07 +02:00
}
else
2022-03-03 02:10:25 +02:00
{ if ( symbols [ token_value ] . type = = INDIVIDUAL_PROPERTY_T )
this_identifier_number = symbols [ token_value ] . value ;
2019-02-05 02:44:07 +02:00
else
2022-03-03 02:10:25 +02:00
{ ebf_symbol_error ( " property name " , token_text , typename ( symbols [ token_value ] . type ) , symbols [ token_value ] . line ) ;
2019-02-05 02:44:07 +02:00
return ;
}
}
if ( def_t_s > = defined_this_segment_size )
ensure_defined_this_segment ( def_t_s * 2 ) ;
defined_this_segment [ def_t_s + + ] = token_value ;
2022-03-03 02:10:25 +02:00
property_number = symbols [ token_value ] . value ;
2019-02-05 02:44:07 +02:00
next_prop = full_object_g . numprops + + ;
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & full_object_g . props_memlist , next_prop + 1 ) ;
2019-02-05 02:44:07 +02:00
full_object_g . props [ next_prop ] . num = property_number ;
full_object_g . props [ next_prop ] . flags =
( ( this_segment = = PRIVATE_SEGMENT ) ? 1 : 0 ) ;
full_object_g . props [ next_prop ] . datastart = full_object_g . propdatasize ;
full_object_g . props [ next_prop ] . continuation = 0 ;
full_object_g . props [ next_prop ] . datalen = 0 ;
}
else
2022-03-03 02:10:25 +02:00
{ if ( symbols [ token_value ] . flags & UNKNOWN_SFLAG )
2019-02-05 02:44:07 +02:00
{ error_named ( " No such property name as " , token_text ) ;
return ;
}
if ( this_segment = = PRIVATE_SEGMENT )
error_named ( " Property should be declared in 'with', \
not ' private ' : " , token_text);
if ( def_t_s > = defined_this_segment_size )
ensure_defined_this_segment ( def_t_s * 2 ) ;
defined_this_segment [ def_t_s + + ] = token_value ;
2022-03-03 02:10:25 +02:00
property_number = symbols [ token_value ] . value ;
2019-02-05 02:44:07 +02:00
next_prop = full_object_g . numprops + + ;
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & full_object_g . props_memlist , next_prop + 1 ) ;
2019-02-05 02:44:07 +02:00
full_object_g . props [ next_prop ] . num = property_number ;
full_object_g . props [ next_prop ] . flags = 0 ;
full_object_g . props [ next_prop ] . datastart = full_object_g . propdatasize ;
full_object_g . props [ next_prop ] . continuation = 0 ;
full_object_g . props [ next_prop ] . datalen = 0 ;
}
for ( i = 0 ; i < ( def_t_s - 1 ) ; i + + )
if ( defined_this_segment [ i ] = = token_value )
{ error_named ( " Property given twice in the same declaration: " ,
2022-03-03 02:10:25 +02:00
symbols [ token_value ] . name ) ;
2019-02-05 02:44:07 +02:00
}
else
2022-03-03 02:10:25 +02:00
if ( symbols [ defined_this_segment [ i ] ] . value = = symbols [ token_value ] . value )
2024-02-12 01:08:33 +02:00
{
error_fmt (
2019-02-05 02:44:07 +02:00
" Property given twice in the same declaration, because \
2024-02-12 01:08:33 +02:00
the names \ " %s \" and \" %s \" actually refer to the same property " ,
2022-03-03 02:10:25 +02:00
symbols [ defined_this_segment [ i ] ] . name ,
symbols [ token_value ] . name ) ;
2019-02-05 02:44:07 +02:00
}
property_name_symbol = token_value ;
2022-03-03 02:10:25 +02:00
symbols [ token_value ] . flags | = USED_SFLAG ;
2019-02-05 02:44:07 +02:00
length = 0 ;
do
{ assembly_operand AO ;
get_next_token_with_directives ( ) ;
if ( ( token_type = = EOF_TT )
| | ( ( token_type = = SEP_TT ) & & ( token_value = = SEMICOLON_SEP ) )
| | ( ( token_type = = SEP_TT ) & & ( token_value = = COMMA_SEP ) ) )
break ;
if ( token_type = = SEGMENT_MARKER_TT ) { put_token_back ( ) ; break ; }
if ( ( ! individual_property ) & & ( property_number = = 1 )
2022-03-03 02:10:25 +02:00
& & ( ( token_type ! = SQ_TT ) | | ( strlen ( token_text ) < 2 ) )
& & ( token_type ! = DQ_TT )
2019-02-05 02:44:07 +02:00
)
warning ( " 'name' property should only contain dictionary words " ) ;
if ( ( token_type = = SEP_TT ) & & ( token_value = = OPEN_SQUARE_SEP ) )
2022-03-03 02:10:25 +02:00
{
char * prefix , * sep , * sym ;
sym = symbols [ property_name_symbol ] . name ;
2019-02-05 02:44:07 +02:00
if ( current_defn_is_class )
2022-03-03 02:10:25 +02:00
{
prefix = symbols [ current_classname_symbol ] . name ;
sep = " :: " ;
2019-02-05 02:44:07 +02:00
}
else
2022-03-03 02:10:25 +02:00
{
prefix = current_object_name . data ;
sep = " . " ;
2019-02-05 02:44:07 +02:00
}
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & embedded_function_name , strlen ( prefix ) + strlen ( sep ) + strlen ( sym ) + 1 ) ;
sprintf ( embedded_function_name . data , " %s%s%s " , prefix , sep , sym ) ;
INITAOT ( & AO , CONSTANT_OT ) ;
/* parse_routine() releases lexer text! */
AO . value = parse_routine ( NULL , TRUE , embedded_function_name . data , FALSE , - 1 ) ;
2019-02-05 02:44:07 +02:00
AO . marker = IROUTINE_MV ;
directives . enabled = FALSE ;
segment_markers . enabled = TRUE ;
statements . enabled = FALSE ;
misc_keywords . enabled = FALSE ;
local_variables . enabled = FALSE ;
system_functions . enabled = FALSE ;
conditions . enabled = FALSE ;
}
else
/* A special rule applies to values in double-quotes of the
built - in property " name " , which always has number 1 : such
property values are dictionary entries and not static
strings */
if ( ( ! individual_property ) & &
( property_number = = 1 ) & & ( token_type = = DQ_TT ) )
2024-02-27 00:51:15 +02:00
{ AO . value = dictionary_add ( token_text , NOUN_DFLAG , 0 , 0 ) ;
2019-02-05 02:44:07 +02:00
AO . type = CONSTANT_OT ;
AO . marker = DWORD_MV ;
}
else
{ if ( length ! = 0 )
{
if ( ( token_type = = SYMBOL_TT )
2022-03-03 02:10:25 +02:00
& & ( symbols [ token_value ] . type = = PROPERTY_T ) )
2019-02-05 02:44:07 +02:00
{
/* This is not necessarily an error: it's possible
to imagine a property whose value is a list
of other properties to look up , but far more
likely that a comma has been omitted in between
two property blocks */
warning_named (
" Missing ','? Property data seems to contain the property name " ,
token_text ) ;
}
}
/* An ordinary value, then: */
put_token_back ( ) ;
AO = parse_expression ( ARRAY_CONTEXT ) ;
}
if ( length = = 32768 ) /* VENEER_CONSTRAINT_ON_PROP_TABLE_SIZE? */
{ error_named ( " Limit (of 32768 values) exceeded for property " ,
2022-03-03 02:10:25 +02:00
symbols [ property_name_symbol ] . name ) ;
2019-02-05 02:44:07 +02:00
break ;
}
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & full_object_g . propdata_memlist , full_object_g . propdatasize + 1 ) ;
2019-02-05 02:44:07 +02:00
full_object_g . propdata [ full_object_g . propdatasize + + ] = AO ;
length + = 1 ;
} while ( TRUE ) ;
/* People rarely do, but it is legal to declare a property without
a value at all :
with name " fish " , number , time_left ;
in which case the properties " number " and " time_left " are
created as in effect variables and initialised to zero . */
if ( length = = 0 )
{
assembly_operand AO ;
2022-03-03 02:10:25 +02:00
INITAOTV ( & AO , CONSTANT_OT , 0 ) ;
ensure_memory_list_available ( & full_object_g . propdata_memlist , full_object_g . propdatasize + 1 ) ;
2019-02-05 02:44:07 +02:00
full_object_g . propdata [ full_object_g . propdatasize + + ] = AO ;
length + = 1 ;
}
full_object_g . props [ next_prop ] . datalen = length ;
if ( ( token_type = = EOF_TT )
| | ( ( token_type = = SEP_TT ) & & ( token_value = = SEMICOLON_SEP ) ) )
{ put_token_back ( ) ; return ;
}
} while ( TRUE ) ;
}
static void properties_segment ( int this_segment )
{
if ( ! glulx_mode )
properties_segment_z ( this_segment ) ;
else
properties_segment_g ( this_segment ) ;
}
/* ------------------------------------------------------------------------- */
/* Attributes ("has") segment. */
/* ------------------------------------------------------------------------- */
static void attributes_segment ( void )
{
/* Parse through the "has" part of an object/class definition:
[ ~ ] < attribute - 1 > [ ~ ] < attribute - 2 > . . . [ ~ ] < attribute - n > */
int attribute_number , truth_state , bitmask ;
uchar * attrbyte ;
do
{ truth_state = TRUE ;
ParseAttrN :
get_next_token_with_directives ( ) ;
if ( ( token_type = = SEGMENT_MARKER_TT )
| | ( token_type = = EOF_TT )
| | ( ( token_type = = SEP_TT ) & & ( token_value = = SEMICOLON_SEP ) ) )
{ if ( ! truth_state )
2024-02-12 01:08:33 +02:00
ebf_curtoken_error ( " attribute name after '~' " ) ;
2019-02-05 02:44:07 +02:00
put_token_back ( ) ; return ;
}
if ( ( token_type = = SEP_TT ) & & ( token_value = = COMMA_SEP ) ) return ;
if ( ( token_type = = SEP_TT ) & & ( token_value = = ARTNOT_SEP ) )
{ truth_state = ! truth_state ; goto ParseAttrN ;
}
if ( ( token_type ! = SYMBOL_TT )
2022-03-03 02:10:25 +02:00
| | ( symbols [ token_value ] . type ! = ATTRIBUTE_T ) )
2024-02-12 01:08:33 +02:00
{ ebf_curtoken_error ( " name of an already-declared attribute " ) ;
2019-02-05 02:44:07 +02:00
return ;
}
2022-03-03 02:10:25 +02:00
attribute_number = symbols [ token_value ] . value ;
symbols [ token_value ] . flags | = USED_SFLAG ;
2019-02-05 02:44:07 +02:00
if ( ! glulx_mode ) {
bitmask = ( 1 < < ( 7 - attribute_number % 8 ) ) ;
attrbyte = & ( full_object . atts [ attribute_number / 8 ] ) ;
}
else {
/* In Glulx, my prejudices rule, and therefore bits are numbered
from least to most significant . This is the opposite of the
way the Z - machine works . */
bitmask = ( 1 < < ( attribute_number % 8 ) ) ;
attrbyte = & ( full_object_g . atts [ attribute_number / 8 ] ) ;
}
if ( truth_state )
* attrbyte | = bitmask ; /* Set attribute bit */
else
* attrbyte & = ~ bitmask ; /* Clear attribute bit */
} while ( TRUE ) ;
}
/* ------------------------------------------------------------------------- */
/* Classes ("class") segment. */
/* ------------------------------------------------------------------------- */
static void add_class_to_inheritance_list ( int class_number )
{
int i ;
/* The class number is actually the class's object number, which needs
to be translated into its actual class number : */
for ( i = 0 ; i < no_classes ; i + + )
2022-03-03 02:10:25 +02:00
if ( class_number = = class_info [ i ] . object_number )
2019-02-05 02:44:07 +02:00
{ class_number = i + 1 ;
break ;
}
/* Remember the inheritance list so that property inheritance can
be sorted out later on , when the definition has been finished : */
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & classes_to_inherit_from_memlist , no_classes_to_inherit_from + 1 ) ;
2019-02-05 02:44:07 +02:00
classes_to_inherit_from [ no_classes_to_inherit_from + + ] = class_number ;
/* Inheriting attributes from the class at once: */
if ( ! glulx_mode ) {
for ( i = 0 ; i < 6 ; i + + )
full_object . atts [ i ]
2022-03-03 02:10:25 +02:00
| = properties_table [ class_info [ class_number - 1 ] . begins_at - 6 + i ] ;
2019-02-05 02:44:07 +02:00
}
else {
for ( i = 0 ; i < NUM_ATTR_BYTES ; i + + )
full_object_g . atts [ i ]
2022-03-03 02:10:25 +02:00
| = properties_table [ class_info [ class_number - 1 ] . begins_at
2019-02-05 02:44:07 +02:00
- NUM_ATTR_BYTES + i ] ;
}
}
static void classes_segment ( void )
{
/* Parse through the "class" part of an object/class definition:
< class - 1 > . . . < class - n > */
do
{ get_next_token_with_directives ( ) ;
if ( ( token_type = = SEGMENT_MARKER_TT )
| | ( token_type = = EOF_TT )
| | ( ( token_type = = SEP_TT ) & & ( token_value = = SEMICOLON_SEP ) ) )
{ put_token_back ( ) ; return ;
}
if ( ( token_type = = SEP_TT ) & & ( token_value = = COMMA_SEP ) ) return ;
if ( ( token_type ! = SYMBOL_TT )
2022-03-03 02:10:25 +02:00
| | ( symbols [ token_value ] . type ! = CLASS_T ) )
2024-02-12 01:08:33 +02:00
{ ebf_curtoken_error ( " name of an already-declared class " ) ;
2019-02-05 02:44:07 +02:00
return ;
}
2022-03-03 02:10:25 +02:00
if ( current_defn_is_class & & token_value = = current_classname_symbol )
{ error ( " A class cannot inherit from itself " ) ;
return ;
}
2019-02-05 02:44:07 +02:00
2022-03-03 02:10:25 +02:00
symbols [ token_value ] . flags | = USED_SFLAG ;
add_class_to_inheritance_list ( symbols [ token_value ] . value ) ;
2019-02-05 02:44:07 +02:00
} while ( TRUE ) ;
}
/* ------------------------------------------------------------------------- */
/* Parse the body of a Nearby/Object/Class definition. */
/* ------------------------------------------------------------------------- */
static void parse_body_of_definition ( void )
{ int commas_in_row ;
def_t_s = 0 ;
do
{ commas_in_row = - 1 ;
do
{ get_next_token_with_directives ( ) ; commas_in_row + + ;
} while ( ( token_type = = SEP_TT ) & & ( token_value = = COMMA_SEP ) ) ;
if ( commas_in_row > 1 )
error ( " Two commas ',' in a row in object/class definition " ) ;
if ( ( token_type = = EOF_TT )
| | ( ( token_type = = SEP_TT ) & & ( token_value = = SEMICOLON_SEP ) ) )
{ if ( commas_in_row > 0 )
error ( " Object/class definition finishes with ',' " ) ;
if ( token_type = = EOF_TT )
error ( " Object/class definition incomplete (no ';') at end of file " ) ;
break ;
}
if ( token_type ! = SEGMENT_MARKER_TT )
{ error_named ( " Expected 'with', 'has' or 'class' in \
object / class definition but found " , token_text);
break ;
}
else
switch ( token_value )
{ case WITH_SEGMENT :
properties_segment ( WITH_SEGMENT ) ;
break ;
case PRIVATE_SEGMENT :
properties_segment ( PRIVATE_SEGMENT ) ;
break ;
case HAS_SEGMENT :
attributes_segment ( ) ;
break ;
case CLASS_SEGMENT :
classes_segment ( ) ;
break ;
}
} while ( TRUE ) ;
}
/* ------------------------------------------------------------------------- */
/* Class directives: */
/* */
/* Class <name> <body of definition> */
/* ------------------------------------------------------------------------- */
static void initialise_full_object ( void )
{
int i ;
if ( ! glulx_mode ) {
2022-07-24 13:10:45 +03:00
full_object . symbol = 0 ;
2019-02-05 02:44:07 +02:00
full_object . l = 0 ;
full_object . atts [ 0 ] = 0 ;
full_object . atts [ 1 ] = 0 ;
full_object . atts [ 2 ] = 0 ;
full_object . atts [ 3 ] = 0 ;
full_object . atts [ 4 ] = 0 ;
full_object . atts [ 5 ] = 0 ;
}
else {
2022-07-24 13:10:45 +03:00
full_object_g . symbol = 0 ;
2019-02-05 02:44:07 +02:00
full_object_g . numprops = 0 ;
full_object_g . propdatasize = 0 ;
for ( i = 0 ; i < NUM_ATTR_BYTES ; i + + )
full_object_g . atts [ i ] = 0 ;
}
}
extern void make_class ( char * metaclass_name )
{ int n , duplicates_to_make = 0 , class_number = no_objects + 1 ,
metaclass_flag = ( metaclass_name ! = NULL ) ;
debug_location_beginning beginning_debug_location =
get_token_location_beginning ( ) ;
current_defn_is_class = TRUE ; no_classes_to_inherit_from = 0 ;
individual_prop_table_size = 0 ;
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & class_info_memlist , no_classes + 1 ) ;
2019-02-05 02:44:07 +02:00
if ( no_classes = = VENEER_CONSTRAINT_ON_CLASSES )
fatalerror ( " Inform's maximum possible number of classes (whatever \
amount of memory is allocated ) has been reached . If this causes serious \
inconvenience , please contact the maintainers . " );
directives . enabled = FALSE ;
if ( metaclass_flag )
{ token_text = metaclass_name ;
2024-02-12 01:08:33 +02:00
token_value = symbol_index ( token_text , - 1 , NULL ) ;
2019-02-05 02:44:07 +02:00
token_type = SYMBOL_TT ;
}
else
{ get_next_token ( ) ;
2022-03-03 02:10:25 +02:00
if ( token_type ! = SYMBOL_TT )
2019-02-05 02:44:07 +02:00
{ discard_token_location ( beginning_debug_location ) ;
2024-02-12 01:08:33 +02:00
ebf_curtoken_error ( " new class name " ) ;
2019-02-05 02:44:07 +02:00
panic_mode_error_recovery ( ) ;
return ;
}
2022-03-03 02:10:25 +02:00
if ( ! ( symbols [ token_value ] . flags & UNKNOWN_SFLAG ) )
{ discard_token_location ( beginning_debug_location ) ;
ebf_symbol_error ( " new class name " , token_text , typename ( symbols [ token_value ] . type ) , symbols [ token_value ] . line ) ;
panic_mode_error_recovery ( ) ;
return ;
}
2019-02-05 02:44:07 +02:00
}
/* Each class also creates a modest object representing itself: */
2024-02-12 01:08:33 +02:00
ensure_memory_list_available ( & shortname_buffer_memlist , strlen ( token_text ) + 1 ) ;
2019-02-05 02:44:07 +02:00
strcpy ( shortname_buffer , token_text ) ;
assign_symbol ( token_value , class_number , CLASS_T ) ;
2022-03-03 02:10:25 +02:00
current_classname_symbol = token_value ;
2019-02-05 02:44:07 +02:00
if ( ! glulx_mode ) {
2022-03-03 02:10:25 +02:00
if ( metaclass_flag ) symbols [ token_value ] . flags | = SYSTEM_SFLAG ;
2019-02-05 02:44:07 +02:00
}
else {
/* In Glulx, metaclasses have to be backpatched too! So we can't
mark it as " system " , but we should mark it " used " . */
2022-03-03 02:10:25 +02:00
if ( metaclass_flag ) symbols [ token_value ] . flags | = USED_SFLAG ;
2019-02-05 02:44:07 +02:00
}
/* "Class" (object 1) has no parent, whereas all other classes are
2022-07-24 13:10:45 +03:00
the children of " Class " . */
2019-02-05 02:44:07 +02:00
if ( metaclass_flag ) parent_of_this_obj = 0 ;
2022-07-24 13:10:45 +03:00
else parent_of_this_obj = 1 ;
2019-02-05 02:44:07 +02:00
2022-03-03 02:10:25 +02:00
class_info [ no_classes ] . object_number = class_number ;
2022-07-24 13:10:45 +03:00
class_info [ no_classes ] . symbol = current_classname_symbol ;
class_info [ no_classes ] . begins_at = 0 ;
2019-02-05 02:44:07 +02:00
initialise_full_object ( ) ;
/* Give the class the (nameless in Inform syntax) "inheritance" property
with value its own class number . ( This therefore accumulates onto
the inheritance property of any object inheriting from the class ,
since property 2 is always set to " additive " - - see below ) */
if ( ! glulx_mode ) {
2022-07-24 13:10:45 +03:00
full_object . symbol = current_classname_symbol ;
2019-02-05 02:44:07 +02:00
full_object . l = 1 ;
full_object . pp [ 0 ] . num = 2 ;
full_object . pp [ 0 ] . l = 1 ;
2022-03-03 02:10:25 +02:00
INITAOTV ( & full_object . pp [ 0 ] . ao [ 0 ] , LONG_CONSTANT_OT , no_objects + 1 ) ;
2019-02-05 02:44:07 +02:00
full_object . pp [ 0 ] . ao [ 0 ] . marker = OBJECT_MV ;
}
else {
2022-07-24 13:10:45 +03:00
full_object_g . symbol = current_classname_symbol ;
2019-02-05 02:44:07 +02:00
full_object_g . numprops = 1 ;
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & full_object_g . props_memlist , 1 ) ;
2019-02-05 02:44:07 +02:00
full_object_g . props [ 0 ] . num = 2 ;
full_object_g . props [ 0 ] . flags = 0 ;
full_object_g . props [ 0 ] . datastart = 0 ;
full_object_g . props [ 0 ] . continuation = 0 ;
full_object_g . props [ 0 ] . datalen = 1 ;
full_object_g . propdatasize = 1 ;
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & full_object_g . propdata_memlist , 1 ) ;
INITAOTV ( & full_object_g . propdata [ 0 ] , CONSTANT_OT , no_objects + 1 ) ;
2019-02-05 02:44:07 +02:00
full_object_g . propdata [ 0 ] . marker = OBJECT_MV ;
}
if ( ! metaclass_flag )
{ get_next_token ( ) ;
if ( ( token_type = = SEP_TT ) & & ( token_value = = OPENB_SEP ) )
{ assembly_operand AO ;
AO = parse_expression ( CONSTANT_CONTEXT ) ;
if ( AO . marker ! = 0 )
{ error ( " Duplicate-number not known at compile time " ) ;
n = 0 ;
}
else
n = AO . value ;
if ( ( n < 0 ) | | ( n > 10000 ) )
{ error ( " The number of duplicates must be 0 to 10000 " ) ;
n = 0 ;
}
/* Make one extra duplicate, since the veneer routines need
always to keep an undamaged prototype for the class in stock */
duplicates_to_make = n + 1 ;
match_close_bracket ( ) ;
} else put_token_back ( ) ;
/* Parse the body of the definition: */
parse_body_of_definition ( ) ;
}
if ( debugfile_switch )
{ debug_file_printf ( " <class> " ) ;
debug_file_printf ( " <identifier>%s</identifier> " , shortname_buffer ) ;
debug_file_printf ( " <class-number>%d</class-number> " , no_classes ) ;
debug_file_printf ( " <value> " ) ;
write_debug_object_backpatch ( no_objects + 1 ) ;
debug_file_printf ( " </value> " ) ;
write_debug_locations
( get_token_location_end ( beginning_debug_location ) ) ;
debug_file_printf ( " </class> " ) ;
}
if ( ! glulx_mode )
manufacture_object_z ( ) ;
else
manufacture_object_g ( ) ;
if ( individual_prop_table_size > = VENEER_CONSTRAINT_ON_IP_TABLE_SIZE )
error ( " This class is too complex: it now carries too many properties. \
You may be able to get round this by declaring some of its property names as \
\ " common properties \" using the 'Property' directive. " ) ;
if ( duplicates_to_make > 0 )
2022-03-03 02:10:25 +02:00
{
int namelen = strlen ( shortname_buffer ) ;
char * duplicate_name = my_malloc ( namelen + 16 , " temporary storage for object duplicate names " ) ;
strcpy ( duplicate_name , shortname_buffer ) ;
2019-02-05 02:44:07 +02:00
for ( n = 1 ; ( duplicates_to_make - - ) > 0 ; n + + )
2022-03-03 02:10:25 +02:00
{
sprintf ( duplicate_name + namelen , " _%d " , n ) ;
2019-02-05 02:44:07 +02:00
make_object ( FALSE , duplicate_name , class_number , class_number , - 1 ) ;
}
2022-03-03 02:10:25 +02:00
my_free ( & duplicate_name , " temporary storage for object duplicate names " ) ;
2019-02-05 02:44:07 +02:00
}
2022-03-03 02:10:25 +02:00
/* Finished building the class. */
current_classname_symbol = 0 ;
2019-02-05 02:44:07 +02:00
}
/* ------------------------------------------------------------------------- */
/* Object/Nearby directives: */
/* */
/* Object <name-1> ... <name-n> "short name" [parent] <body of def> */
/* */
/* Nearby <name-1> ... <name-n> "short name" <body of definition> */
/* ------------------------------------------------------------------------- */
static int end_of_header ( void )
{ if ( ( ( token_type = = SEP_TT ) & & ( token_value = = SEMICOLON_SEP ) )
| | ( ( token_type = = SEP_TT ) & & ( token_value = = COMMA_SEP ) )
| | ( token_type = = SEGMENT_MARKER_TT ) ) return TRUE ;
return FALSE ;
}
extern void make_object ( int nearby_flag ,
char * textual_name , int specified_parent , int specified_class ,
int instance_of )
{
/* Ordinarily this is called with nearby_flag TRUE for "Nearby",
FALSE for " Object " ; and textual_name NULL , specified_parent and
specified_class both - 1. The next three arguments are used when
the routine is called for class duplicates manufacture ( see above ) .
The last is used to create instances of a particular class . */
int i , tree_depth , internal_name_symbol = 0 ;
debug_location_beginning beginning_debug_location =
get_token_location_beginning ( ) ;
directives . enabled = FALSE ;
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & current_object_name , 32 ) ;
sprintf ( current_object_name . data , " nameless_obj__%d " , no_objects + 1 ) ;
2019-02-05 02:44:07 +02:00
current_defn_is_class = FALSE ;
no_classes_to_inherit_from = 0 ;
individual_prop_table_size = 0 ;
if ( nearby_flag ) tree_depth = 1 ; else tree_depth = 0 ;
if ( specified_class ! = - 1 ) goto HeaderPassed ;
get_next_token ( ) ;
/* Read past and count a sequence of "->"s, if any are present */
if ( ( token_type = = SEP_TT ) & & ( token_value = = ARROW_SEP ) )
{ if ( nearby_flag )
error ( " The syntax '->' is only used as an alternative to 'Nearby' " ) ;
while ( ( token_type = = SEP_TT ) & & ( token_value = = ARROW_SEP ) )
{ tree_depth + + ;
get_next_token ( ) ;
}
}
2024-02-12 01:08:33 +02:00
ensure_memory_list_available ( & shortname_buffer_memlist , 2 ) ;
2019-02-05 02:44:07 +02:00
sprintf ( shortname_buffer , " ? " ) ;
segment_markers . enabled = TRUE ;
/* This first word is either an internal name, or a textual short name,
or the end of the header part */
if ( end_of_header ( ) ) goto HeaderPassed ;
if ( token_type = = DQ_TT ) textual_name = token_text ;
else
2022-03-03 02:10:25 +02:00
{ if ( token_type ! = SYMBOL_TT ) {
2024-02-12 01:08:33 +02:00
ebf_curtoken_error ( " name for new object or its textual short name " ) ;
2022-03-03 02:10:25 +02:00
}
else if ( ! ( symbols [ token_value ] . flags & UNKNOWN_SFLAG ) ) {
ebf_symbol_error ( " new object " , token_text , typename ( symbols [ token_value ] . type ) , symbols [ token_value ] . line ) ;
}
2019-02-05 02:44:07 +02:00
else
{ internal_name_symbol = token_value ;
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & current_object_name , strlen ( token_text ) + 1 ) ;
strcpy ( current_object_name . data , token_text ) ;
2019-02-05 02:44:07 +02:00
}
}
/* The next word is either a parent object, or
a textual short name , or the end of the header part */
get_next_token_with_directives ( ) ;
if ( end_of_header ( ) ) goto HeaderPassed ;
if ( token_type = = DQ_TT )
{ if ( textual_name ! = NULL )
error ( " Two textual short names given for only one object " ) ;
else
textual_name = token_text ;
}
else
{ if ( ( token_type ! = SYMBOL_TT )
2022-03-03 02:10:25 +02:00
| | ( symbols [ token_value ] . flags & UNKNOWN_SFLAG ) )
2019-02-05 02:44:07 +02:00
{ if ( textual_name = = NULL )
2024-02-12 01:08:33 +02:00
ebf_curtoken_error ( " parent object or the object's textual short name " ) ;
2019-02-05 02:44:07 +02:00
else
2024-02-12 01:08:33 +02:00
ebf_curtoken_error ( " parent object " ) ;
2019-02-05 02:44:07 +02:00
}
else goto SpecParent ;
}
/* Finally, it's possible that there is still a parent object */
get_next_token ( ) ;
if ( end_of_header ( ) ) goto HeaderPassed ;
if ( specified_parent ! = - 1 )
2024-02-12 01:08:33 +02:00
ebf_curtoken_error ( " body of object definition " ) ;
2019-02-05 02:44:07 +02:00
else
{ SpecParent :
2022-03-03 02:10:25 +02:00
if ( ( symbols [ token_value ] . type = = OBJECT_T )
| | ( symbols [ token_value ] . type = = CLASS_T ) )
{ specified_parent = symbols [ token_value ] . value ;
symbols [ token_value ] . flags | = USED_SFLAG ;
2019-02-05 02:44:07 +02:00
}
2024-02-12 01:08:33 +02:00
else ebf_curtoken_error ( " name of (the parent) object " ) ;
2019-02-05 02:44:07 +02:00
}
/* Now it really has to be the body of the definition. */
get_next_token_with_directives ( ) ;
if ( end_of_header ( ) ) goto HeaderPassed ;
2024-02-12 01:08:33 +02:00
ebf_curtoken_error ( " body of object definition " ) ;
2019-02-05 02:44:07 +02:00
HeaderPassed :
if ( specified_class = = - 1 ) put_token_back ( ) ;
if ( internal_name_symbol > 0 )
assign_symbol ( internal_name_symbol , no_objects + 1 , OBJECT_T ) ;
if ( textual_name = = NULL )
2024-02-12 01:08:33 +02:00
{
if ( internal_name_symbol > 0 ) {
ensure_memory_list_available ( & shortname_buffer_memlist , strlen ( symbols [ internal_name_symbol ] . name ) + 4 ) ;
2019-02-05 02:44:07 +02:00
sprintf ( shortname_buffer , " (%s) " ,
2022-03-03 02:10:25 +02:00
symbols [ internal_name_symbol ] . name ) ;
2024-02-12 01:08:33 +02:00
}
else {
ensure_memory_list_available ( & shortname_buffer_memlist , 32 ) ;
2019-02-05 02:44:07 +02:00
sprintf ( shortname_buffer , " (%d) " , no_objects + 1 ) ;
2024-02-12 01:08:33 +02:00
}
2019-02-05 02:44:07 +02:00
}
else
2024-02-12 01:08:33 +02:00
{
if ( ! glulx_mode ) {
/* This check is only advisory. It's possible that a string of less than 765 characters will encode to more than 510 bytes. We'll double-check in write_property_block_z(). */
if ( strlen ( textual_name ) > 765 )
error ( " Short name of object (in quotes) exceeded 765 Z-characters " ) ;
ensure_memory_list_available ( & shortname_buffer_memlist , 766 ) ;
strncpy ( shortname_buffer , textual_name , 765 ) ;
}
else {
ensure_memory_list_available ( & shortname_buffer_memlist , strlen ( textual_name ) + 1 ) ;
strcpy ( shortname_buffer , textual_name ) ;
}
2019-02-05 02:44:07 +02:00
}
if ( specified_parent ! = - 1 )
{ if ( tree_depth > 0 )
error ( " Use of '->' (or 'Nearby') clashes with giving a parent " ) ;
parent_of_this_obj = specified_parent ;
}
else
{ parent_of_this_obj = 0 ;
if ( tree_depth > 0 )
{
/* We have to set the parent object to the most recently defined
object at level ( tree_depth - 1 ) in the tree .
A complication is that objects are numbered 1 , 2 , . . . in the
Z - machine ( and in the objects [ ] . parent , etc . , fields ) but
0 , 1 , 2 , . . . internally ( and as indices to object [ ] ) . */
for ( i = no_objects - 1 ; i > = 0 ; i - - )
{ int j = i , k = 0 ;
/* Metaclass or class objects cannot be '->' parents: */
2022-07-24 13:10:45 +03:00
if ( i < 4 )
2019-02-05 02:44:07 +02:00
continue ;
if ( ! glulx_mode ) {
if ( objectsz [ i ] . parent = = 1 )
continue ;
while ( objectsz [ j ] . parent ! = 0 )
{ j = objectsz [ j ] . parent - 1 ; k + + ; }
}
else {
if ( objectsg [ i ] . parent = = 1 )
continue ;
while ( objectsg [ j ] . parent ! = 0 )
{ j = objectsg [ j ] . parent - 1 ; k + + ; }
}
if ( k = = tree_depth - 1 )
{ parent_of_this_obj = i + 1 ;
break ;
}
}
if ( parent_of_this_obj = = 0 )
{ if ( tree_depth = = 1 )
error ( " '->' (or 'Nearby') fails because there is no previous object " ) ;
else
error ( " '-> -> ...' fails because no previous object is deep enough " ) ;
}
}
}
initialise_full_object ( ) ;
2022-07-24 13:10:45 +03:00
if ( ! glulx_mode )
full_object . symbol = internal_name_symbol ;
else
full_object_g . symbol = internal_name_symbol ;
2019-02-05 02:44:07 +02:00
if ( instance_of ! = - 1 ) add_class_to_inheritance_list ( instance_of ) ;
if ( specified_class = = - 1 ) parse_body_of_definition ( ) ;
else add_class_to_inheritance_list ( specified_class ) ;
if ( debugfile_switch )
{ debug_file_printf ( " <object> " ) ;
if ( internal_name_symbol > 0 )
2022-03-03 02:10:25 +02:00
{ debug_file_printf ( " <identifier>%s</identifier> " ,
current_object_name . data ) ;
2019-02-05 02:44:07 +02:00
} else
{ debug_file_printf
( " <identifier artificial= \" true \" >%s</identifier> " ,
2022-03-03 02:10:25 +02:00
current_object_name . data ) ;
2019-02-05 02:44:07 +02:00
}
debug_file_printf ( " <value> " ) ;
write_debug_object_backpatch ( no_objects + 1 ) ;
debug_file_printf ( " </value> " ) ;
write_debug_locations
( get_token_location_end ( beginning_debug_location ) ) ;
debug_file_printf ( " </object> " ) ;
}
if ( ! glulx_mode )
manufacture_object_z ( ) ;
else
manufacture_object_g ( ) ;
}
/* ========================================================================= */
/* Data structure management routines */
/* ------------------------------------------------------------------------- */
extern void init_objects_vars ( void )
{
properties_table = NULL ;
2022-03-03 02:10:25 +02:00
individuals_table = NULL ;
commonprops = NULL ;
2024-02-12 01:08:33 +02:00
shortname_buffer = NULL ;
2019-02-05 02:44:07 +02:00
objectsz = NULL ;
objectsg = NULL ;
objectatts = NULL ;
classes_to_inherit_from = NULL ;
2022-03-03 02:10:25 +02:00
class_info = NULL ;
full_object_g . props = NULL ;
full_object_g . propdata = NULL ;
2019-02-05 02:44:07 +02:00
}
extern void objects_begin_pass ( void )
{
properties_table_size = 0 ;
2022-03-03 02:10:25 +02:00
/* The three predefined common properties: */
/* (Entry 0 is not used.) */
/* "name" */
commonprops [ 1 ] . default_value = 0 ;
commonprops [ 1 ] . is_long = TRUE ;
commonprops [ 1 ] . is_additive = TRUE ;
/* class inheritance property */
commonprops [ 2 ] . default_value = 0 ;
commonprops [ 2 ] . is_long = TRUE ;
commonprops [ 2 ] . is_additive = TRUE ;
/* instance variables table address */
/* (This property is only meaningful in Z-code; in Glulx its entry is
reserved but never used . ) */
commonprops [ 3 ] . default_value = 0 ;
commonprops [ 3 ] . is_long = TRUE ;
commonprops [ 3 ] . is_additive = FALSE ;
2019-02-05 02:44:07 +02:00
no_properties = 4 ;
if ( debugfile_switch )
2022-03-03 02:10:25 +02:00
{
/* These two properties are not symbols, so they won't be emitted
by emit_debug_information_for_predefined_symbol ( ) . Do it
manually . */
debug_file_printf ( " <property> " ) ;
2019-02-05 02:44:07 +02:00
debug_file_printf
( " <identifier artificial= \" true \" >inheritance class</identifier> " ) ;
debug_file_printf ( " <value>2</value> " ) ;
debug_file_printf ( " </property> " ) ;
debug_file_printf ( " <property> " ) ;
debug_file_printf
( " <identifier artificial= \" true \" >instance variables table address "
" (Z-code)</identifier> " ) ;
debug_file_printf ( " <value>3</value> " ) ;
debug_file_printf ( " </property> " ) ;
}
if ( define_INFIX_switch ) no_attributes = 1 ;
else no_attributes = 0 ;
no_objects = 0 ;
2022-03-03 02:10:25 +02:00
/* Setting the info for object zero is probably a relic of very old code, but we do it. */
2019-02-05 02:44:07 +02:00
if ( ! glulx_mode ) {
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & objectsz_memlist , 1 ) ;
2019-02-05 02:44:07 +02:00
objectsz [ 0 ] . parent = 0 ; objectsz [ 0 ] . child = 0 ; objectsz [ 0 ] . next = 0 ;
no_individual_properties = 72 ;
}
else {
2022-03-03 02:10:25 +02:00
ensure_memory_list_available ( & objectsg_memlist , 1 ) ;
2019-02-05 02:44:07 +02:00
objectsg [ 0 ] . parent = 0 ; objectsg [ 0 ] . child = 0 ; objectsg [ 0 ] . next = 0 ;
no_individual_properties = INDIV_PROP_START + 8 ;
}
no_classes = 0 ;
2022-03-03 02:10:25 +02:00
current_classname_symbol = 0 ;
2019-02-05 02:44:07 +02:00
no_embedded_routines = 0 ;
individuals_length = 0 ;
}
extern void objects_allocate_arrays ( void )
{
objectsz = NULL ;
objectsg = NULL ;
objectatts = NULL ;
2022-03-03 02:10:25 +02:00
commonprops = my_calloc ( sizeof ( commonpropinfo ) , INDIV_PROP_START ,
" common property info " ) ;
2019-02-05 02:44:07 +02:00
2022-03-03 02:10:25 +02:00
initialise_memory_list ( & class_info_memlist ,
sizeof ( classinfo ) , 64 , ( void * * ) & class_info ,
" class info " ) ;
initialise_memory_list ( & classes_to_inherit_from_memlist ,
sizeof ( int ) , 64 , ( void * * ) & classes_to_inherit_from ,
" inherited classes list " ) ;
2019-02-05 02:44:07 +02:00
2022-03-03 02:10:25 +02:00
initialise_memory_list ( & properties_table_memlist ,
sizeof ( uchar ) , 10000 , ( void * * ) & properties_table ,
" properties table " ) ;
initialise_memory_list ( & individuals_table_memlist ,
sizeof ( uchar ) , 10000 , ( void * * ) & individuals_table ,
" individual properties table " ) ;
2019-02-05 02:44:07 +02:00
defined_this_segment_size = 128 ;
defined_this_segment = my_calloc ( sizeof ( int ) , defined_this_segment_size ,
" defined this segment table " ) ;
2022-03-03 02:10:25 +02:00
initialise_memory_list ( & current_object_name ,
sizeof ( char ) , 32 , NULL ,
" object name currently being defined " ) ;
2024-02-12 01:08:33 +02:00
initialise_memory_list ( & shortname_buffer_memlist ,
sizeof ( char ) , 768 , ( void * * ) & shortname_buffer ,
" textual name of object currently being defined " ) ;
2022-03-03 02:10:25 +02:00
initialise_memory_list ( & embedded_function_name ,
sizeof ( char ) , 32 , NULL ,
" temporary storage for inline function name " ) ;
2019-02-05 02:44:07 +02:00
if ( ! glulx_mode ) {
2022-03-03 02:10:25 +02:00
initialise_memory_list ( & objectsz_memlist ,
sizeof ( objecttz ) , 256 , ( void * * ) & objectsz ,
" z-objects " ) ;
2019-02-05 02:44:07 +02:00
}
else {
2022-03-03 02:10:25 +02:00
initialise_memory_list ( & objectsg_memlist ,
sizeof ( objecttg ) , 256 , ( void * * ) & objectsg ,
" g-objects " ) ;
initialise_memory_list ( & objectatts_memlist ,
NUM_ATTR_BYTES , 256 , ( void * * ) & objectatts ,
" g-attributes " ) ;
initialise_memory_list ( & full_object_g . props_memlist ,
sizeof ( propg ) , 64 , ( void * * ) & full_object_g . props ,
" object property list " ) ;
initialise_memory_list ( & full_object_g . propdata_memlist ,
sizeof ( assembly_operand ) , 1024 , ( void * * ) & full_object_g . propdata ,
" object property data table " ) ;
2019-02-05 02:44:07 +02:00
}
}
extern void objects_free_arrays ( void )
{
2022-03-03 02:10:25 +02:00
my_free ( & commonprops , " common property info " ) ;
deallocate_memory_list ( & current_object_name ) ;
2024-02-12 01:08:33 +02:00
deallocate_memory_list ( & shortname_buffer_memlist ) ;
2022-03-03 02:10:25 +02:00
deallocate_memory_list ( & embedded_function_name ) ;
deallocate_memory_list ( & objectsz_memlist ) ;
deallocate_memory_list ( & objectsg_memlist ) ;
deallocate_memory_list ( & objectatts_memlist ) ;
deallocate_memory_list ( & class_info_memlist ) ;
deallocate_memory_list ( & classes_to_inherit_from_memlist ) ;
2019-02-05 02:44:07 +02:00
2022-03-03 02:10:25 +02:00
deallocate_memory_list ( & properties_table_memlist ) ;
deallocate_memory_list ( & individuals_table_memlist ) ;
2019-02-05 02:44:07 +02:00
my_free ( & defined_this_segment , " defined this segment table " ) ;
if ( ! glulx_mode ) {
2022-03-03 02:10:25 +02:00
deallocate_memory_list ( & full_object_g . props_memlist ) ;
deallocate_memory_list ( & full_object_g . propdata_memlist ) ;
2019-02-05 02:44:07 +02:00
}
}
/* ========================================================================= */