1
/* ------------------------------------------------------------------------- */
2
/* "objects" : [1] the object-maker, which constructs objects and enters */
3
/* them into the tree, given a low-level specification; */
5
/* [2] the parser of Object/Nearby/Class directives, which */
6
/* checks syntax and translates such directives into */
7
/* specifications for the object-maker. */
9
/* Part of Inform 6.31 */
10
/* copyright (c) Graham Nelson 1993 - 2006 */
12
/* ------------------------------------------------------------------------- */
16
/* ------------------------------------------------------------------------- */
18
/* ------------------------------------------------------------------------- */
20
int no_objects; /* Number of objects made so far */
22
static int no_embedded_routines; /* Used for naming routines which
23
are given as property values: these
24
are called EmbeddedRoutine__1, ... */
26
static fpropt full_object; /* "fpropt" is a typedef for a struct
27
containing an array to hold the
28
attribute and property values of
29
a single object. We only keep one
30
of these, for the current object
31
being made, and compile it into
32
Z-machine tables when each object
33
definition is complete, since
34
sizeof(fpropt) is about 6200 bytes */
35
static fproptg full_object_g; /* Equivalent for Glulx. This object
36
is very small, since the large arrays
37
are allocated dynamically by the
39
static char shortname_buffer[766]; /* Text buffer to hold the short name
40
(which is read in first, but
41
written almost last) */
42
static int parent_of_this_obj;
44
static char *classname_text, *objectname_text;
45
/* For printing names of embedded
48
/* ------------------------------------------------------------------------- */
50
/* ------------------------------------------------------------------------- */
51
/* Arrays defined below: */
53
/* int32 class_begins_at[n] offset of properties block for */
54
/* nth class (always an offset */
55
/* inside the properties_table) */
56
/* int classes_to_inherit_from[] The list of classes to inherit */
57
/* from as taken from the current */
58
/* Nearby/Object/Class definition */
59
/* int class_object_numbers[n] The number of the prototype-object */
60
/* for the nth class */
61
/* ------------------------------------------------------------------------- */
63
int no_classes; /* Number of class defns made so far */
65
static int current_defn_is_class, /* TRUE if current Nearby/Object/Class
66
defn is in fact a Class definition */
67
no_classes_to_inherit_from; /* Number of classes in the list
68
of classes to inherit in the
69
current Nearby/Object/Class defn */
71
/* ------------------------------------------------------------------------- */
72
/* Making attributes and properties. */
73
/* ------------------------------------------------------------------------- */
75
int no_attributes, /* Number of attributes defined so far */
76
no_properties; /* Number of properties defined so far,
77
plus 1 (properties are numbered from
78
1 and Inform creates "name" and two
79
others itself, so the variable begins
80
the compilation pass set to 4) */
82
static void trace_s(char *name, int32 number, int f)
83
{ if (!printprops_switch) return;
84
printf("%s %02ld ",(f==0)?"Attr":"Prop",(long int) number);
85
if (f==0) printf(" ");
86
else printf("%s%s",(prop_is_long[number])?"L":" ",
87
(prop_is_additive[number])?"A":" ");
91
extern void make_attribute(void)
95
if (no_attributes==((version_number==3)?32:48))
96
{ if (version_number==3)
97
error("All 32 attributes already declared (compile as Advanced \
98
game to get an extra 16)");
100
error("All 48 attributes already declared");
101
panic_mode_error_recovery(); return;
105
if (no_attributes==NUM_ATTR_BYTES*8) {
107
"All attributes already declared -- increase NUM_ATTR_BYTES to use \
110
panic_mode_error_recovery();
116
i = token_value; name = token_text;
117
if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG)))
118
{ ebf_error("new attribute name", token_text);
119
panic_mode_error_recovery(); return;
122
directive_keywords.enabled = TRUE;
124
directive_keywords.enabled = FALSE;
126
if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK))
128
if (!((token_type == SYMBOL_TT)
129
&& (stypes[token_value] == ATTRIBUTE_T)))
130
{ ebf_error("an existing attribute name after 'alias'",
131
token_text); panic_mode_error_recovery(); return;
133
assign_symbol(i, svals[token_value], ATTRIBUTE_T);
134
sflags[token_value] |= ALIASED_SFLAG;
135
sflags[i] |= ALIASED_SFLAG;
138
{ assign_symbol(i, no_attributes++, ATTRIBUTE_T);
142
trace_s(name, svals[i], 0);
146
extern void make_property(void)
147
{ int32 default_value, i;
148
int additive_flag=FALSE; char *name;
152
if (no_properties==((version_number==3)?32:64))
153
{ if (version_number==3)
154
error("All 30 properties already declared (compile as \
155
Advanced game to get an extra 62)");
157
error("All 62 properties already declared");
158
panic_mode_error_recovery(); return;
162
/* INDIV_PROP_START could be a memory setting */
163
if (no_properties==INDIV_PROP_START) {
164
error_numbered("All properties already declared -- max is",
166
panic_mode_error_recovery();
172
{ directive_keywords.enabled = TRUE;
174
if ((token_type == DIR_KEYWORD_TT) && (token_value == LONG_DK))
175
obsolete_warning("all properties are now automatically 'long'");
177
if ((token_type == DIR_KEYWORD_TT) && (token_value == ADDITIVE_DK))
178
additive_flag = TRUE;
183
directive_keywords.enabled = FALSE;
186
i = token_value; name = token_text;
187
if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG)))
188
{ ebf_error("new property name", token_text);
189
panic_mode_error_recovery(); return;
192
directive_keywords.enabled = TRUE;
194
directive_keywords.enabled = FALSE;
196
if (strcmp(name+strlen(name)-3, "_to") == 0) sflags[i] |= STAR_SFLAG;
198
if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK))
200
{ error("'alias' incompatible with 'additive'");
201
panic_mode_error_recovery();
205
if (!((token_type == SYMBOL_TT)
206
&& (stypes[token_value] == PROPERTY_T)))
207
{ ebf_error("an existing property name after 'alias'",
208
token_text); panic_mode_error_recovery(); return;
211
assign_symbol(i, svals[token_value], PROPERTY_T);
212
trace_s(name, svals[i], 1);
213
sflags[token_value] |= ALIASED_SFLAG;
214
sflags[i] |= ALIASED_SFLAG;
221
if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
222
{ AO = parse_expression(CONSTANT_CONTEXT);
223
default_value = AO.value;
225
backpatch_zmachine(AO.marker, PROP_DEFAULTS_ZA,
226
(no_properties-1) * WORDSIZE);
229
prop_default_value[no_properties] = default_value;
230
prop_is_long[no_properties] = TRUE;
231
prop_is_additive[no_properties] = additive_flag;
233
assign_symbol(i, no_properties++, PROPERTY_T);
234
trace_s(name, svals[i], 1);
237
/* ------------------------------------------------------------------------- */
239
/* ------------------------------------------------------------------------- */
241
int32 *prop_default_value; /* Default values for properties */
242
int *prop_is_long, /* Property modifiers, TRUE or FALSE:
243
"long" means "never write a 1-byte
244
value to this property", and is an
245
obsolete feature: since Inform 5
246
all properties have been "long" */
247
*prop_is_additive; /* "additive" means that values
248
accumulate rather than erase each
249
other during class inheritance */
250
char *properties_table; /* Holds the table of property values
251
(holding one block for each object
252
and coming immediately after the
253
object tree in Z-memory) */
254
int properties_table_size; /* Number of bytes in this table */
256
/* ------------------------------------------------------------------------- */
257
/* Individual properties */
259
/* Each new i.p. name is given a unique number. These numbers start from */
260
/* 72, since 0 is reserved as a null, 1 to 63 refer to common properties */
261
/* and 64 to 71 are kept for methods of the metaclass Class (for example, */
262
/* 64 is "create"). */
264
/* An object provides individual properties by having property 3 set to a */
265
/* non-zero value, which must be a byte address of a table in the form: */
267
/* <record-1> ... <record-n> 00 00 */
269
/* where a <record> looks like */
271
/* <identifier> <size> <up to 255 bytes of data> */
272
/* or <identifier + 0x8000> */
273
/* ----- 2 bytes ---------- 1 byte <size> number of bytes */
275
/* The <identifier> part is the number allocated to the name of what is */
276
/* being provided. The top bit of this word is set to indicate that */
277
/* although the individual property is being provided, it is provided */
278
/* only privately (so that it is inaccessible except to the object's own */
279
/* embedded routines). */
281
/* In Glulx: i-props are numbered from INDIV_PROP_START+8 up. And all */
282
/* properties, common and individual, are stored in the same table. */
283
/* ------------------------------------------------------------------------- */
285
int no_individual_properties; /* Actually equal to the next
286
identifier number to be allocated,
287
so this is initially 72 even though
288
none have been made yet. */
289
static int individual_prop_table_size; /* Size of the table of individual
290
properties so far for current obj */
291
uchar *individuals_table; /* Table of records, each being the
292
i.p. table for an object */
293
int i_m; /* Write mark position in the above */
294
int individuals_length; /* Extent of individuals_table */
296
/* ------------------------------------------------------------------------- */
297
/* Arrays used by this file */
298
/* ------------------------------------------------------------------------- */
300
objecttz *objectsz; /* Z-code only */
301
objecttg *objectsg; /* Glulx only */
302
uchar *objectatts; /* Glulx only */
303
static int *classes_to_inherit_from;
304
int *class_object_numbers;
305
int32 *class_begins_at;
308
/* ------------------------------------------------------------------------- */
309
/* Tracing for compiler maintenance */
310
/* ------------------------------------------------------------------------- */
312
extern void list_object_tree(void)
314
printf("obj par nxt chl Object tree:\n");
315
for (i=0; i<no_objects; i++)
316
printf("%3d %3d %3d %3d\n",
317
i+1,objectsz[i].parent,objectsz[i].next, objectsz[i].child);
320
/* ------------------------------------------------------------------------- */
321
/* Object and class manufacture begins here. */
323
/* These definitions have headers (parsed far, far below) and a series */
324
/* of segments, introduced by keywords and optionally separated by commas. */
325
/* Each segment has its own parsing routine. Note that when errors are */
326
/* detected, parsing continues rather than being abandoned, which assists */
327
/* a little in "error recovery" (i.e. in stopping lots more errors being */
328
/* produced for essentially the same mistake). */
329
/* ------------------------------------------------------------------------- */
331
/* ========================================================================= */
332
/* [1] The object-maker: builds an object from a specification, viz.: */
335
/* shortname_buffer, */
336
/* parent_of_this_obj, */
337
/* current_defn_is_class (flag) */
338
/* classes_to_inherit_from[], no_classes_to_inherit_from, */
339
/* individual_prop_table_size (to date ) */
341
/* For efficiency's sake, the individual properties table has already been */
342
/* created (as far as possible, i.e., all except for inherited individual */
343
/* properties); unless the flag is clear, in which case the actual */
344
/* definition did not specify any individual properties. */
345
/* ========================================================================= */
346
/* Property inheritance from classes. */
347
/* ------------------------------------------------------------------------- */
349
static void property_inheritance_z(void)
351
/* Apply the property inheritance rules to full_object, which should
352
initially be complete (i.e., this routine takes place after the whole
353
Nearby/Object/Class definition has been parsed through).
355
On exit, full_object contains the final state of the properties to
358
int i, j, k, kmax, class, mark,
359
prop_number, prop_length, prop_in_current_defn;
360
uchar *class_prop_block;
364
for (class=0; class<no_classes_to_inherit_from; class++)
367
mark = class_begins_at[classes_to_inherit_from[class]-1];
368
class_prop_block = (uchar *) (properties_table + mark);
370
while (class_prop_block[j]!=0)
371
{ if (version_number == 3)
372
{ prop_number = class_prop_block[j]%32;
373
prop_length = 1 + class_prop_block[j++]/32;
376
{ prop_number = class_prop_block[j]%64;
377
prop_length = 1 + class_prop_block[j++]/64;
379
prop_length = class_prop_block[j++]%64;
382
/* So we now have property number prop_number present in the
383
property block for the class being read: its bytes are
385
class_prop_block[j, ..., j + prop_length - 1]
387
Question now is: is there already a value given in the
388
current definition under this property name? */
390
prop_in_current_defn = FALSE;
392
kmax = full_object.l;
394
for (k=0; k<kmax; k++)
395
if (full_object.pp[k].num == prop_number)
396
{ prop_in_current_defn = TRUE;
398
/* (Note that the built-in "name" property is additive) */
400
if ((prop_number==1) || (prop_is_additive[prop_number]))
402
/* The additive case: we accumulate the class
403
property values onto the end of the full_object
406
for (i=full_object.pp[k].l;
407
i<full_object.pp[k].l+prop_length/2; i++)
409
{ error("An additive property has inherited \
410
so many values that the list has overflowed the maximum 32 entries");
413
full_object.pp[k].ao[i].value = mark + j;
415
full_object.pp[k].ao[i].marker = INHERIT_MV;
416
full_object.pp[k].ao[i].type = LONG_CONSTANT_OT;
418
full_object.pp[k].l += prop_length/2;
421
/* The ordinary case: the full_object property
422
values simply overrides the class definition,
423
so we skip over the values in the class table */
428
{ int y, z, class_block_offset;
431
/* Property 3 holds the address of the table of
432
instance variables, so this is the case where
433
the object already has instance variables in its
434
own table but must inherit some more from the
437
if (individuals_length+64 > MAX_INDIV_PROP_TABLE_SIZE)
438
memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
439
MAX_INDIV_PROP_TABLE_SIZE);
441
class_block_offset = class_prop_block[j-2]*256
442
+ class_prop_block[j-1];
444
p = individuals_table + class_block_offset;
445
z = class_block_offset;
446
while ((p[0]!=0)||(p[1]!=0))
447
{ int already_present = FALSE, l;
448
for (l = full_object.pp[k].ao[0].value; l < i_m;
449
l = l + 3 + individuals_table[l + 2])
450
if (individuals_table[l] == p[0]
451
&& individuals_table[l + 1] == p[1])
452
{ already_present = TRUE; break;
454
if (already_present == FALSE)
456
backpatch_zmachine(IDENT_MV,
457
INDIVIDUAL_PROP_ZA, i_m);
458
individuals_table[i_m++] = p[0];
459
individuals_table[i_m++] = p[1];
460
individuals_table[i_m++] = p[2];
461
for (y=0;y < p[2]/2;y++)
462
{ individuals_table[i_m++] = (z+3+y*2)/256;
463
individuals_table[i_m++] = (z+3+y*2)%256;
464
backpatch_zmachine(INHERIT_INDIV_MV,
465
INDIVIDUAL_PROP_ZA, i_m-2);
471
individuals_length = i_m;
474
/* For efficiency we exit the loop now (this property
475
number has been dealt with) */
480
if (!prop_in_current_defn)
482
/* The case where the class defined a property which wasn't
483
defined at all in full_object: we copy out the data into
484
a new property added to full_object */
487
full_object.pp[k].num = prop_number;
488
full_object.pp[k].l = prop_length/2;
489
for (i=0; i<prop_length/2; i++)
490
{ full_object.pp[k].ao[i].value = mark + j;
492
full_object.pp[k].ao[i].marker = INHERIT_MV;
493
full_object.pp[k].ao[i].type = LONG_CONSTANT_OT;
497
{ int y, z, class_block_offset;
500
/* Property 3 holds the address of the table of
501
instance variables, so this is the case where
502
the object had no instance variables of its own
503
but must inherit some more from the class */
505
if (individuals_length+64 > MAX_INDIV_PROP_TABLE_SIZE)
506
memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
507
MAX_INDIV_PROP_TABLE_SIZE);
509
if (individual_prop_table_size++ == 0)
510
{ full_object.pp[k].num = 3;
511
full_object.pp[k].l = 1;
512
full_object.pp[k].ao[0].value
513
= individuals_length;
514
full_object.pp[k].ao[0].marker = INDIVPT_MV;
515
full_object.pp[k].ao[0].type = LONG_CONSTANT_OT;
516
i_m = individuals_length;
518
class_block_offset = class_prop_block[j-2]*256
519
+ class_prop_block[j-1];
521
p = individuals_table + class_block_offset;
522
z = class_block_offset;
523
while ((p[0]!=0)||(p[1]!=0))
525
backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
526
individuals_table[i_m++] = p[0];
527
individuals_table[i_m++] = p[1];
528
individuals_table[i_m++] = p[2];
529
for (y=0;y < p[2]/2;y++)
530
{ individuals_table[i_m++] = (z+3+y*2)/256;
531
individuals_table[i_m++] = (z+3+y*2)%256;
532
backpatch_zmachine(INHERIT_INDIV_MV,
533
INDIVIDUAL_PROP_ZA, i_m-2);
538
individuals_length = i_m;
544
if (individual_prop_table_size > 0)
545
{ individuals_table[i_m++] = 0;
546
individuals_table[i_m++] = 0;
547
individuals_length += 2;
551
static void property_inheritance_g(void)
553
/* Apply the property inheritance rules to full_object, which should
554
initially be complete (i.e., this routine takes place after the whole
555
Nearby/Object/Class definition has been parsed through).
557
On exit, full_object contains the final state of the properties to
560
int i, j, k, class, num_props,
561
prop_number, prop_length, prop_flags, prop_in_current_defn;
562
int32 mark, prop_addr;
567
for (class=0; class<no_classes_to_inherit_from; class++) {
568
mark = class_begins_at[classes_to_inherit_from[class]-1];
569
cpb = (uchar *) (properties_table + mark);
570
/* This now points to the compiled property-table for the class.
571
We'll have to go through and decompile it. (For our sins.) */
572
num_props = ReadInt32(cpb);
573
for (j=0; j<num_props; j++) {
575
prop_number = ReadInt16(pe);
577
prop_length = ReadInt16(pe);
579
prop_addr = ReadInt32(pe);
581
prop_flags = ReadInt16(pe);
584
/* So we now have property number prop_number present in the
585
property block for the class being read. Its bytes are
586
cpb[prop_addr ... prop_addr + prop_length - 1]
587
Question now is: is there already a value given in the
588
current definition under this property name? */
590
prop_in_current_defn = FALSE;
592
for (k=0; k<full_object_g.numprops; k++) {
593
if (full_object_g.props[k].num == prop_number) {
594
prop_in_current_defn = TRUE;
599
if (prop_in_current_defn) {
601
|| (prop_number < INDIV_PROP_START
602
&& prop_is_additive[prop_number])) {
603
/* The additive case: we accumulate the class
604
property values onto the end of the full_object
605
properties. Remember that k is still the index number
606
of the first prop-block matching our property number. */
608
if (full_object_g.props[k].continuation == 0) {
609
full_object_g.props[k].continuation = 1;
613
prevcont = full_object_g.props[k].continuation;
614
for (k++; k<full_object_g.numprops; k++) {
615
if (full_object_g.props[k].num == prop_number) {
616
prevcont = full_object_g.props[k].continuation;
620
k = full_object_g.numprops++;
621
full_object_g.props[k].num = prop_number;
622
full_object_g.props[k].flags = 0;
623
full_object_g.props[k].datastart = full_object_g.propdatasize;
624
full_object_g.props[k].continuation = prevcont+1;
625
full_object_g.props[k].datalen = prop_length;
626
if (full_object_g.propdatasize + prop_length
627
> MAX_OBJ_PROP_TABLE_SIZE) {
628
error_numbered("Limit of property data exceeded for this object; \
629
MAX_OBJ_PROP_TABLE_SIZE is", MAX_OBJ_PROP_TABLE_SIZE);
633
for (i=0; i<prop_length; i++) {
634
int ppos = full_object_g.propdatasize++;
635
full_object_g.propdata[ppos].value = prop_addr + 4*i;
636
full_object_g.propdata[ppos].marker = INHERIT_MV;
637
full_object_g.propdata[ppos].type = CONSTANT_OT;
641
/* The ordinary case: the full_object_g property
642
values simply overrides the class definition,
643
so we skip over the values in the class table. */
647
/* The case where the class defined a property which wasn't
648
defined at all in full_object_g: we copy out the data into
649
a new property added to full_object_g. */
650
k = full_object_g.numprops++;
651
full_object_g.props[k].num = prop_number;
652
full_object_g.props[k].flags = prop_flags;
653
full_object_g.props[k].datastart = full_object_g.propdatasize;
654
full_object_g.props[k].continuation = 0;
655
full_object_g.props[k].datalen = prop_length;
656
if (full_object_g.propdatasize + prop_length
657
> MAX_OBJ_PROP_TABLE_SIZE) {
658
error_numbered("Limit of property data exceeded for this object; \
659
MAX_OBJ_PROP_TABLE_SIZE is", MAX_OBJ_PROP_TABLE_SIZE);
663
for (i=0; i<prop_length; i++) {
664
int ppos = full_object_g.propdatasize++;
665
full_object_g.propdata[ppos].value = prop_addr + 4*i;
666
full_object_g.propdata[ppos].marker = INHERIT_MV;
667
full_object_g.propdata[ppos].type = CONSTANT_OT;
671
if (full_object_g.numprops == MAX_OBJ_PROP_COUNT) {
672
error_numbered("Limit of property entries exceeded for this \
673
object; MAX_OBJ_PROP_COUNT is", MAX_OBJ_PROP_COUNT);
681
/* ------------------------------------------------------------------------- */
682
/* Construction of Z-machine-format property blocks. */
683
/* ------------------------------------------------------------------------- */
685
static int write_properties_between(uchar *p, int mark, int from, int to)
686
{ int j, k, prop_number, prop_length;
687
for (prop_number=to; prop_number>=from; prop_number--)
688
{ for (j=0; j<full_object.l; j++)
689
{ if ((full_object.pp[j].num == prop_number)
690
&& (full_object.pp[j].l != 100))
691
{ prop_length = 2*full_object.pp[j].l;
692
if (version_number == 3)
693
p[mark++] = prop_number + (prop_length - 1)*32;
695
{ switch(prop_length)
697
p[mark++] = prop_number; break;
699
p[mark++] = prop_number + 0x40; break;
701
p[mark++] = prop_number + 0x80;
702
p[mark++] = prop_length + 0x80; break;
706
for (k=0; k<full_object.pp[j].l; k++)
707
{ if (full_object.pp[j].ao[k].marker != 0)
708
backpatch_zmachine(full_object.pp[j].ao[k].marker,
710
p[mark++] = full_object.pp[j].ao[k].value/256;
711
p[mark++] = full_object.pp[j].ao[k].value%256;
721
static int write_property_block_z(char *shortname)
723
/* Compile the (now complete) full_object properties into a
724
property-table block at "p" in Inform's memory.
725
"shortname" is the object's short name, if specified; otherwise
728
Return the number of bytes written to the block. */
730
int32 mark = properties_table_size, i;
731
uchar *p = (uchar *) properties_table;
733
/* printf("Object at %04x\n", mark); */
735
if (shortname != NULL)
736
{ uchar *tmp = translate_text(p+mark+1,shortname);
737
i = subtract_pointers(tmp,(p+mark+1));
738
if (i>510) error ("Short name of object exceeded 765 Z-characters");
742
if (current_defn_is_class)
743
{ mark = write_properties_between(p,mark,3,3);
745
p[mark++] = full_object.atts[i];
746
class_begins_at[no_classes++] = mark;
749
mark = write_properties_between(p, mark, 1, (version_number==3)?31:63);
751
i = mark - properties_table_size;
752
properties_table_size = mark;
757
static int gpropsort(void *ptr1, void *ptr2)
762
if (prop2->num == -1)
764
if (prop1->num == -1)
766
if (prop1->num < prop2->num)
768
if (prop1->num > prop2->num)
771
return (prop1->continuation - prop2->continuation);
774
static int32 write_property_block_g(void)
776
/* Compile the (now complete) full_object properties into a
777
property-table block at "p" in Inform's memory.
778
Return the number of bytes written to the block.
779
In Glulx, the shortname property isn't used here; it's already
780
been compiled into an ordinary string. */
783
int ix, jx, kx, totalprops;
784
int32 mark = properties_table_size;
786
uchar *p = (uchar *) properties_table;
788
if (current_defn_is_class) {
789
for (i=0;i<NUM_ATTR_BYTES;i++)
790
p[mark++] = full_object_g.atts[i];
791
class_begins_at[no_classes++] = mark;
794
qsort(full_object_g.props, full_object_g.numprops, sizeof(propg),
795
(int (*)(const void *, const void *))(&gpropsort));
797
full_object_g.finalpropaddr = mark;
801
for (ix=0; ix<full_object_g.numprops; ix=jx) {
802
int propnum = full_object_g.props[ix].num;
806
jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
811
/* Write out the number of properties in this table. */
812
WriteInt32(p+mark, totalprops);
815
datamark = mark + 10*totalprops;
817
for (ix=0; ix<full_object_g.numprops; ix=jx) {
818
int propnum = full_object_g.props[ix].num;
819
int flags = full_object_g.props[ix].flags;
821
int32 datamarkstart = datamark;
825
jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
827
int32 datastart = full_object_g.props[jx].datastart;
828
for (kx=0; kx<full_object_g.props[jx].datalen; kx++) {
829
int32 val = full_object_g.propdata[datastart+kx].value;
830
WriteInt32(p+datamark, val);
831
if (full_object_g.propdata[datastart+kx].marker != 0)
832
backpatch_zmachine(full_object_g.propdata[datastart+kx].marker,
838
WriteInt16(p+mark, propnum);
840
WriteInt16(p+mark, totallen);
842
WriteInt32(p+mark, datamarkstart);
844
WriteInt16(p+mark, flags);
850
i = mark - properties_table_size;
851
properties_table_size = mark;
855
/* ------------------------------------------------------------------------- */
856
/* The final stage in Nearby/Object/Class definition processing. */
857
/* ------------------------------------------------------------------------- */
859
static void manufacture_object_z(void)
862
segment_markers.enabled = FALSE;
863
directives.enabled = TRUE;
865
property_inheritance_z();
867
objectsz[no_objects].parent = parent_of_this_obj;
868
objectsz[no_objects].next = 0;
869
objectsz[no_objects].child = 0;
871
if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fff))
872
{ i = objectsz[parent_of_this_obj-1].child;
874
objectsz[parent_of_this_obj-1].child = no_objects + 1;
876
{ while(objectsz[i-1].next != 0) i = objectsz[i-1].next;
877
objectsz[i-1].next = no_objects+1;
881
/* The properties table consists simply of a sequence of property
882
blocks, one for each object in order of definition, exactly as
883
it will appear in the final Z-machine. */
885
j = write_property_block_z(shortname_buffer);
887
objectsz[no_objects].propsize = j;
888
if (properties_table_size >= MAX_PROP_TABLE_SIZE)
889
memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
891
if (current_defn_is_class)
892
for (i=0;i<6;i++) objectsz[no_objects].atts[i] = 0;
895
objectsz[no_objects].atts[i] = full_object.atts[i];
900
static void manufacture_object_g(void)
903
segment_markers.enabled = FALSE;
904
directives.enabled = TRUE;
906
property_inheritance_g();
908
objectsg[no_objects].parent = parent_of_this_obj;
909
objectsg[no_objects].next = 0;
910
objectsg[no_objects].child = 0;
912
if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fffffff))
913
{ i = objectsg[parent_of_this_obj-1].child;
915
objectsg[parent_of_this_obj-1].child = no_objects + 1;
917
{ while(objectsg[i-1].next != 0) i = objectsg[i-1].next;
918
objectsg[i-1].next = no_objects+1;
922
objectsg[no_objects].shortname = compile_string(shortname_buffer,
925
/* The properties table consists simply of a sequence of property
926
blocks, one for each object in order of definition, exactly as
927
it will appear in the final machine image. */
929
j = write_property_block_g();
931
objectsg[no_objects].propaddr = full_object_g.finalpropaddr;
933
objectsg[no_objects].propsize = j;
934
if (properties_table_size >= MAX_PROP_TABLE_SIZE)
935
memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
937
if (current_defn_is_class)
938
for (i=0;i<NUM_ATTR_BYTES;i++)
939
objectatts[no_objects*NUM_ATTR_BYTES+i] = 0;
941
for (i=0;i<NUM_ATTR_BYTES;i++)
942
objectatts[no_objects*NUM_ATTR_BYTES+i] = full_object_g.atts[i];
948
/* ========================================================================= */
949
/* [2] The Object/Nearby/Class directives parser: translating the syntax */
950
/* into object specifications and then triggering off the above. */
951
/* ========================================================================= */
952
/* Properties ("with" or "private") segment. */
953
/* ------------------------------------------------------------------------- */
955
static int defined_this_segment[128], def_t_s;
957
static void properties_segment_z(int this_segment)
959
/* Parse through the "with" part of an object/class definition:
961
<prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
963
This routine also handles "private", with this_segment being equal
964
to the token value for the introductory word ("private" or "with"). */
967
int i, property_name_symbol, property_number, next_prop, length,
968
individual_property, this_identifier_number;
972
if ((token_type == SEGMENT_MARKER_TT)
973
|| (token_type == EOF_TT)
974
|| ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
975
{ put_token_back(); return;
978
if (token_type != SYMBOL_TT)
979
{ ebf_error("property name", token_text);
983
individual_property = (stypes[token_value] != PROPERTY_T);
985
if (individual_property)
986
{ if (sflags[token_value] & UNKNOWN_SFLAG)
987
{ this_identifier_number = no_individual_properties++;
988
assign_symbol(token_value, this_identifier_number,
989
INDIVIDUAL_PROPERTY_T);
992
{ if (stypes[token_value]==INDIVIDUAL_PROPERTY_T)
993
this_identifier_number = svals[token_value];
995
{ char already_error[128];
996
sprintf(already_error,
997
"\"%s\" is a name already in use (with type %s) \
998
and may not be used as a property name too",
999
token_text, typename(stypes[token_value]));
1000
error(already_error);
1005
defined_this_segment[def_t_s++] = token_value;
1007
if (individual_prop_table_size++ == 0)
1008
{ full_object.pp[full_object.l].num = 3;
1009
full_object.pp[full_object.l].l = 1;
1010
full_object.pp[full_object.l].ao[0].value
1011
= individuals_length;
1012
full_object.pp[full_object.l].ao[0].type = LONG_CONSTANT_OT;
1013
full_object.pp[full_object.l].ao[0].marker = INDIVPT_MV;
1015
i_m = individuals_length;
1018
individuals_table[i_m] = this_identifier_number/256;
1019
if (this_segment == PRIVATE_SEGMENT)
1020
individuals_table[i_m] |= 0x80;
1021
individuals_table[i_m+1] = this_identifier_number%256;
1023
backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
1024
individuals_table[i_m+2] = 0;
1027
{ if (sflags[token_value] & UNKNOWN_SFLAG)
1028
{ error_named("No such property name as", token_text);
1031
if (this_segment == PRIVATE_SEGMENT)
1032
error_named("Property should be declared in 'with', \
1033
not 'private':", token_text);
1034
defined_this_segment[def_t_s++] = token_value;
1035
property_number = svals[token_value];
1037
next_prop=full_object.l++;
1038
full_object.pp[next_prop].num = property_number;
1041
for (i=0; i<(def_t_s-1); i++)
1042
if (defined_this_segment[i] == token_value)
1043
{ error_named("Property given twice in the same declaration:",
1044
(char *) symbs[token_value]);
1047
if (svals[defined_this_segment[i]] == svals[token_value])
1048
{ char error_b[128];
1050
"Property given twice in the same declaration, because \
1051
the names '%s' and '%s' actually refer to the same property",
1052
(char *) symbs[defined_this_segment[i]],
1053
(char *) symbs[token_value]);
1057
property_name_symbol = token_value;
1058
sflags[token_value] |= USED_SFLAG;
1062
{ assembly_operand AO;
1064
if ((token_type == EOF_TT)
1065
|| ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1066
|| ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1069
if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1071
if ((!individual_property) && (property_number==1)
1072
&& ((token_type != SQ_TT) || (strlen(token_text) <2 ))
1073
&& (token_type != DQ_TT)
1075
warning ("'name' property should only contain dictionary words");
1077
if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1078
{ char embedded_name[80];
1079
if (current_defn_is_class)
1080
{ sprintf(embedded_name,
1081
"%s::%s", classname_text,
1082
(char *) symbs[property_name_symbol]);
1085
{ sprintf(embedded_name,
1086
"%s.%s", objectname_text,
1087
(char *) symbs[property_name_symbol]);
1089
AO.value = parse_routine(NULL, TRUE, embedded_name, FALSE, -1);
1090
AO.type = LONG_CONSTANT_OT;
1091
AO.marker = IROUTINE_MV;
1093
directives.enabled = FALSE;
1094
segment_markers.enabled = TRUE;
1096
statements.enabled = FALSE;
1097
misc_keywords.enabled = FALSE;
1098
local_variables.enabled = FALSE;
1099
system_functions.enabled = FALSE;
1100
conditions.enabled = FALSE;
1104
/* A special rule applies to values in double-quotes of the
1105
built-in property "name", which always has number 1: such
1106
property values are dictionary entries and not static
1109
if ((!individual_property) &&
1110
(property_number==1) && (token_type == DQ_TT))
1111
{ AO.value = dictionary_add(token_text, 0x80, 0, 0);
1112
AO.type = LONG_CONSTANT_OT;
1113
AO.marker = DWORD_MV;
1118
if ((token_type == SYMBOL_TT)
1119
&& (stypes[token_value]==PROPERTY_T))
1121
/* This is not necessarily an error: it's possible
1122
to imagine a property whose value is a list
1123
of other properties to look up, but far more
1124
likely that a comma has been omitted in between
1125
two property blocks */
1128
"Missing ','? Property data seems to contain the property name",
1133
/* An ordinary value, then: */
1136
AO = parse_expression(ARRAY_CONTEXT);
1140
{ error_named("Limit (of 32 values) exceeded for property",
1141
(char *) symbs[property_name_symbol]);
1145
if (individual_property)
1146
{ if (AO.marker != 0)
1147
backpatch_zmachine(AO.marker, INDIVIDUAL_PROP_ZA,
1149
individuals_table[i_m+3+length++] = AO.value/256;
1150
individuals_table[i_m+3+length++] = AO.value%256;
1153
{ full_object.pp[next_prop].ao[length/2] = AO;
1154
length = length + 2;
1159
/* People rarely do, but it is legal to declare a property without
1162
with name "fish", number, time_left;
1164
in which case the properties "number" and "time_left" are
1165
created as in effect variables and initialised to zero. */
1168
{ if (individual_property)
1169
{ individuals_table[i_m+3+length++] = 0;
1170
individuals_table[i_m+3+length++] = 0;
1173
{ full_object.pp[next_prop].ao[0].value = 0;
1174
full_object.pp[next_prop].ao[0].type = LONG_CONSTANT_OT;
1175
full_object.pp[next_prop].ao[0].marker = 0;
1180
if ((version_number==3) && (!individual_property))
1183
warning_named("Version 3 limit of 4 values per property exceeded \
1184
(use -v5 to get 32), so truncating property",
1185
(char *) symbs[property_name_symbol]);
1186
full_object.pp[next_prop].l=4;
1190
if (individual_property)
1191
{ individuals_table[i_m + 2] = length;
1192
individuals_length += length+3;
1193
i_m = individuals_length;
1194
if (individuals_length+64 > MAX_INDIV_PROP_TABLE_SIZE)
1195
memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
1196
MAX_INDIV_PROP_TABLE_SIZE);
1199
full_object.pp[next_prop].l = length/2;
1201
if ((token_type == EOF_TT)
1202
|| ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1203
{ put_token_back(); return;
1210
static void properties_segment_g(int this_segment)
1212
/* Parse through the "with" part of an object/class definition:
1214
<prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
1216
This routine also handles "private", with this_segment being equal
1217
to the token value for the introductory word ("private" or "with"). */
1221
individual_property, this_identifier_number;
1222
int32 property_name_symbol, property_number, length;
1226
if ((token_type == SEGMENT_MARKER_TT)
1227
|| (token_type == EOF_TT)
1228
|| ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1229
{ put_token_back(); return;
1232
if (token_type != SYMBOL_TT)
1233
{ ebf_error("property name", token_text);
1237
individual_property = (stypes[token_value] != PROPERTY_T);
1239
if (individual_property)
1240
{ if (sflags[token_value] & UNKNOWN_SFLAG)
1241
{ this_identifier_number = no_individual_properties++;
1242
assign_symbol(token_value, this_identifier_number,
1243
INDIVIDUAL_PROPERTY_T);
1246
{ if (stypes[token_value]==INDIVIDUAL_PROPERTY_T)
1247
this_identifier_number = svals[token_value];
1249
{ char already_error[128];
1250
sprintf(already_error,
1251
"\"%s\" is a name already in use (with type %s) \
1252
and may not be used as a property name too",
1253
token_text, typename(stypes[token_value]));
1254
error(already_error);
1259
defined_this_segment[def_t_s++] = token_value;
1260
property_number = svals[token_value];
1262
next_prop=full_object_g.numprops++;
1263
full_object_g.props[next_prop].num = property_number;
1264
full_object_g.props[next_prop].flags =
1265
((this_segment == PRIVATE_SEGMENT) ? 1 : 0);
1266
full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1267
full_object_g.props[next_prop].continuation = 0;
1268
full_object_g.props[next_prop].datalen = 0;
1271
{ if (sflags[token_value] & UNKNOWN_SFLAG)
1272
{ error_named("No such property name as", token_text);
1275
if (this_segment == PRIVATE_SEGMENT)
1276
error_named("Property should be declared in 'with', \
1277
not 'private':", token_text);
1279
defined_this_segment[def_t_s++] = token_value;
1280
property_number = svals[token_value];
1282
next_prop=full_object_g.numprops++;
1283
full_object_g.props[next_prop].num = property_number;
1284
full_object_g.props[next_prop].flags = 0;
1285
full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
1286
full_object_g.props[next_prop].continuation = 0;
1287
full_object_g.props[next_prop].datalen = 0;
1290
for (i=0; i<(def_t_s-1); i++)
1291
if (defined_this_segment[i] == token_value)
1292
{ error_named("Property given twice in the same declaration:",
1293
(char *) symbs[token_value]);
1296
if (svals[defined_this_segment[i]] == svals[token_value])
1297
{ char error_b[128];
1299
"Property given twice in the same declaration, because \
1300
the names '%s' and '%s' actually refer to the same property",
1301
(char *) symbs[defined_this_segment[i]],
1302
(char *) symbs[token_value]);
1306
if (full_object_g.numprops == MAX_OBJ_PROP_COUNT) {
1307
error_numbered("Limit of property entries exceeded for this \
1308
object; MAX_OBJ_PROP_COUNT is", MAX_OBJ_PROP_COUNT);
1312
property_name_symbol = token_value;
1313
sflags[token_value] |= USED_SFLAG;
1317
{ assembly_operand AO;
1319
if ((token_type == EOF_TT)
1320
|| ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1321
|| ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
1324
if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
1326
if ((!individual_property) && (property_number==1)
1327
&& (token_type != SQ_TT) && (token_type != DQ_TT)
1329
warning ("'name' property should only contain dictionary words");
1331
if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
1332
{ char embedded_name[80];
1333
if (current_defn_is_class)
1334
{ sprintf(embedded_name,
1335
"%s::%s", classname_text,
1336
(char *) symbs[property_name_symbol]);
1339
{ sprintf(embedded_name,
1340
"%s.%s", objectname_text,
1341
(char *) symbs[property_name_symbol]);
1343
AO.value = parse_routine(NULL, TRUE, embedded_name, FALSE, -1);
1344
AO.type = CONSTANT_OT;
1345
AO.marker = IROUTINE_MV;
1347
directives.enabled = FALSE;
1348
segment_markers.enabled = TRUE;
1350
statements.enabled = FALSE;
1351
misc_keywords.enabled = FALSE;
1352
local_variables.enabled = FALSE;
1353
system_functions.enabled = FALSE;
1354
conditions.enabled = FALSE;
1358
/* A special rule applies to values in double-quotes of the
1359
built-in property "name", which always has number 1: such
1360
property values are dictionary entries and not static
1363
if ((!individual_property) &&
1364
(property_number==1) && (token_type == DQ_TT))
1365
{ AO.value = dictionary_add(token_text, 0x80, 0, 0);
1366
AO.type = CONSTANT_OT;
1367
AO.marker = DWORD_MV;
1372
if ((token_type == SYMBOL_TT)
1373
&& (stypes[token_value]==PROPERTY_T))
1375
/* This is not necessarily an error: it's possible
1376
to imagine a property whose value is a list
1377
of other properties to look up, but far more
1378
likely that a comma has been omitted in between
1379
two property blocks */
1382
"Missing ','? Property data seems to contain the property name",
1387
/* An ordinary value, then: */
1390
AO = parse_expression(ARRAY_CONTEXT);
1393
if (length == 32768) /* VENEER_CONSTRAINT_ON_PROP_TABLE_SIZE? */
1394
{ error_named("Limit (of 32768 values) exceeded for property",
1395
(char *) symbs[property_name_symbol]);
1399
if (full_object_g.propdatasize >= MAX_OBJ_PROP_TABLE_SIZE) {
1400
error_numbered("Limit of property data exceeded for this \
1401
object; MAX_OBJ_PROP_TABLE_SIZE is", MAX_OBJ_PROP_TABLE_SIZE);
1405
full_object_g.propdata[full_object_g.propdatasize++] = AO;
1410
/* People rarely do, but it is legal to declare a property without
1413
with name "fish", number, time_left;
1415
in which case the properties "number" and "time_left" are
1416
created as in effect variables and initialised to zero. */
1420
assembly_operand AO;
1422
AO.type = CONSTANT_OT;
1424
full_object_g.propdata[full_object_g.propdatasize++] = AO;
1428
full_object_g.props[next_prop].datalen = length;
1430
if ((token_type == EOF_TT)
1431
|| ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1432
{ put_token_back(); return;
1438
static void properties_segment(int this_segment)
1441
properties_segment_z(this_segment);
1443
properties_segment_g(this_segment);
1446
/* ------------------------------------------------------------------------- */
1447
/* Attributes ("has") segment. */
1448
/* ------------------------------------------------------------------------- */
1450
static void attributes_segment(void)
1452
/* Parse through the "has" part of an object/class definition:
1454
[~]<attribute-1> [~]<attribute-2> ... [~]<attribute-n> */
1456
int attribute_number, truth_state, bitmask;
1459
{ truth_state = TRUE;
1464
if ((token_type == SEGMENT_MARKER_TT)
1465
|| (token_type == EOF_TT)
1466
|| ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1468
ebf_error("attribute name after '~'", token_text);
1469
put_token_back(); return;
1471
if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1473
if ((token_type == SEP_TT) && (token_value == ARTNOT_SEP))
1474
{ truth_state = !truth_state; goto ParseAttrN;
1477
if ((token_type != SYMBOL_TT)
1478
|| (stypes[token_value] != ATTRIBUTE_T))
1479
{ ebf_error("name of an already-declared attribute", token_text);
1483
attribute_number = svals[token_value];
1484
sflags[token_value] |= USED_SFLAG;
1487
bitmask = (1 << (7-attribute_number%8));
1488
attrbyte = &(full_object.atts[attribute_number/8]);
1491
/* In Glulx, my prejudices rule, and therefore bits are numbered
1492
from least to most significant. This is the opposite of the
1493
way the Z-machine works. */
1494
bitmask = (1 << (attribute_number%8));
1495
attrbyte = &(full_object_g.atts[attribute_number/8]);
1499
*attrbyte |= bitmask; /* Set attribute bit */
1501
*attrbyte &= ~bitmask; /* Clear attribute bit */
1506
/* ------------------------------------------------------------------------- */
1507
/* Classes ("class") segment. */
1508
/* ------------------------------------------------------------------------- */
1510
static void add_class_to_inheritance_list(int class_number)
1514
/* The class number is actually the class's object number, which needs
1515
to be translated into its actual class number: */
1517
for (i=0;i<no_classes;i++)
1518
if (class_number == class_object_numbers[i])
1519
{ class_number = i+1;
1523
/* Remember the inheritance list so that property inheritance can
1524
be sorted out later on, when the definition has been finished: */
1526
classes_to_inherit_from[no_classes_to_inherit_from++] = class_number;
1528
/* Inheriting attributes from the class at once: */
1533
|= properties_table[class_begins_at[class_number-1] - 6 + i];
1536
for (i=0; i<NUM_ATTR_BYTES; i++)
1537
full_object_g.atts[i]
1538
|= properties_table[class_begins_at[class_number-1]
1539
- NUM_ATTR_BYTES + i];
1543
static void classes_segment(void)
1545
/* Parse through the "class" part of an object/class definition:
1547
<class-1> ... <class-n> */
1551
if ((token_type == SEGMENT_MARKER_TT)
1552
|| (token_type == EOF_TT)
1553
|| ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1554
{ put_token_back(); return;
1556
if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
1558
if ((token_type != SYMBOL_TT)
1559
|| (stypes[token_value] != CLASS_T))
1560
{ ebf_error("name of an already-declared class", token_text);
1564
sflags[token_value] |= USED_SFLAG;
1565
add_class_to_inheritance_list(svals[token_value]);
1569
/* ------------------------------------------------------------------------- */
1570
/* Parse the body of a Nearby/Object/Class definition. */
1571
/* ------------------------------------------------------------------------- */
1573
static void parse_body_of_definition(void)
1574
{ int commas_in_row;
1579
{ commas_in_row = -1;
1581
{ get_next_token(); commas_in_row++;
1582
} while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
1584
if (commas_in_row>1)
1585
error("Two commas ',' in a row in object/class definition");
1587
if ((token_type == EOF_TT)
1588
|| ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
1589
{ if (commas_in_row > 0)
1590
error("Object/class definition finishes with ','");
1594
if (token_type != SEGMENT_MARKER_TT)
1595
{ error_named("Expected 'with', 'has' or 'class' in \
1596
object/class definition but found", token_text);
1601
{ case WITH_SEGMENT:
1602
properties_segment(WITH_SEGMENT);
1604
case PRIVATE_SEGMENT:
1605
properties_segment(PRIVATE_SEGMENT);
1608
attributes_segment();
1619
/* ------------------------------------------------------------------------- */
1620
/* Class directives: */
1622
/* Class <name> <body of definition> */
1623
/* ------------------------------------------------------------------------- */
1625
static void initialise_full_object(void)
1630
full_object.atts[0] = 0;
1631
full_object.atts[1] = 0;
1632
full_object.atts[2] = 0;
1633
full_object.atts[3] = 0;
1634
full_object.atts[4] = 0;
1635
full_object.atts[5] = 0;
1638
full_object_g.numprops = 0;
1639
full_object_g.propdatasize = 0;
1640
for (i=0; i<NUM_ATTR_BYTES; i++)
1641
full_object_g.atts[i] = 0;
1645
extern void make_class(char * metaclass_name)
1646
{ int n, duplicates_to_make = 0, class_number = no_objects+1,
1647
metaclass_flag = (metaclass_name != NULL);
1648
char duplicate_name[128]; dbgl start_dbgl = token_line_ref;
1650
current_defn_is_class = TRUE; no_classes_to_inherit_from = 0;
1651
individual_prop_table_size = 0;
1653
if (no_classes==MAX_CLASSES)
1654
memoryerror("MAX_CLASSES", MAX_CLASSES);
1656
if (no_classes==VENEER_CONSTRAINT_ON_CLASSES)
1657
fatalerror("Inform's maximum possible number of classes (whatever \
1658
amount of memory is allocated) has been reached. If this causes serious \
1659
inconvenience, please contact the author.");
1661
directives.enabled = FALSE;
1664
{ token_text = metaclass_name;
1665
token_value = symbol_index(token_text, -1);
1666
token_type = SYMBOL_TT;
1670
if ((token_type != SYMBOL_TT)
1671
|| (!(sflags[token_value] & UNKNOWN_SFLAG)))
1672
{ ebf_error("new class name", token_text);
1673
panic_mode_error_recovery();
1678
/* Each class also creates a modest object representing itself: */
1680
strcpy(shortname_buffer, token_text);
1682
assign_symbol(token_value, class_number, CLASS_T);
1683
classname_text = (char *) symbs[token_value];
1686
if (metaclass_flag) sflags[token_value] |= SYSTEM_SFLAG;
1689
/* In Glulx, metaclasses have to be backpatched too! So we can't
1690
mark it as "system", but we should mark it "used". */
1691
if (metaclass_flag) sflags[token_value] |= USED_SFLAG;
1694
/* "Class" (object 1) has no parent, whereas all other classes are
1695
the children of "Class". Since "Class" is not present in a module,
1696
a special value is used which is corrected to 1 by the linker. */
1698
if (metaclass_flag) parent_of_this_obj = 0;
1699
else parent_of_this_obj = (module_switch)?MAXINTWORD:1;
1701
class_object_numbers[no_classes] = class_number;
1703
initialise_full_object();
1705
/* Give the class the (nameless in Inform syntax) "inheritance" property
1706
with value its own class number. (This therefore accumulates onto
1707
the inheritance property of any object inheriting from the class,
1708
since property 2 is always set to "additive" -- see below) */
1712
full_object.pp[0].num = 2;
1713
full_object.pp[0].l = 1;
1714
full_object.pp[0].ao[0].value = no_objects + 1;
1715
full_object.pp[0].ao[0].type = LONG_CONSTANT_OT;
1716
full_object.pp[0].ao[0].marker = OBJECT_MV;
1719
full_object_g.numprops = 1;
1720
full_object_g.props[0].num = 2;
1721
full_object_g.props[0].flags = 0;
1722
full_object_g.props[0].datastart = 0;
1723
full_object_g.props[0].continuation = 0;
1724
full_object_g.props[0].datalen = 1;
1725
full_object_g.propdatasize = 1;
1726
full_object_g.propdata[0].value = no_objects + 1;
1727
full_object_g.propdata[0].type = CONSTANT_OT;
1728
full_object_g.propdata[0].marker = OBJECT_MV;
1731
if (!metaclass_flag)
1733
if ((token_type == SEP_TT) && (token_value == OPENB_SEP))
1734
{ assembly_operand AO;
1735
AO = parse_expression(CONSTANT_CONTEXT);
1737
{ error("Duplicate-number not known at compile time");
1742
if ((n<0) || (n>10000))
1743
{ error("The number of duplicates must be 0 to 10000");
1747
/* Make one extra duplicate, since the veneer routines need
1748
always to keep an undamaged prototype for the class in stock */
1750
duplicates_to_make = n + 1;
1752
match_close_bracket();
1753
} else put_token_back();
1755
/* Parse the body of the definition: */
1757
parse_body_of_definition();
1760
if (debugfile_switch)
1761
{ write_debug_byte(CLASS_DBR);
1762
write_debug_string(shortname_buffer);
1763
write_dbgl(start_dbgl);
1764
write_dbgl(token_line_ref);
1768
manufacture_object_z();
1770
manufacture_object_g();
1772
if (individual_prop_table_size >= VENEER_CONSTRAINT_ON_IP_TABLE_SIZE)
1773
error("This class is too complex: it now carries too many properties. \
1774
You may be able to get round this by declaring some of its property names as \
1775
\"common properties\" using the 'Property' directive.");
1777
if (duplicates_to_make > 0)
1778
{ sprintf(duplicate_name, "%s_1", shortname_buffer);
1779
for (n=1; (duplicates_to_make--) > 0; n++)
1781
{ int i = strlen(duplicate_name);
1782
while (duplicate_name[i] != '_') i--;
1783
sprintf(duplicate_name+i+1, "%d", n);
1785
make_object(FALSE, duplicate_name, class_number, class_number, -1);
1790
/* ------------------------------------------------------------------------- */
1791
/* Object/Nearby directives: */
1793
/* Object <name-1> ... <name-n> "short name" [parent] <body of def> */
1795
/* Nearby <name-1> ... <name-n> "short name" <body of definition> */
1796
/* ------------------------------------------------------------------------- */
1798
static int end_of_header(void)
1799
{ if (((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
1800
|| ((token_type == SEP_TT) && (token_value == COMMA_SEP))
1801
|| (token_type == SEGMENT_MARKER_TT)) return TRUE;
1805
extern void make_object(int nearby_flag,
1806
char *textual_name, int specified_parent, int specified_class,
1809
/* Ordinarily this is called with nearby_flag TRUE for "Nearby",
1810
FALSE for "Object"; and textual_name NULL, specified_parent and
1811
specified_class both -1. The next three arguments are used when
1812
the routine is called for class duplicates manufacture (see above).
1813
The last is used to create instances of a particular class. */
1815
int i, tree_depth, internal_name_symbol = 0;
1816
char internal_name[64];
1817
dbgl start_dbgl = token_line_ref;
1819
directives.enabled = FALSE;
1821
if (no_objects==MAX_OBJECTS) memoryerror("MAX_OBJECTS", MAX_OBJECTS);
1823
sprintf(internal_name, "nameless_obj__%d", no_objects+1);
1824
objectname_text = internal_name;
1826
current_defn_is_class = FALSE;
1828
no_classes_to_inherit_from=0;
1830
individual_prop_table_size = 0;
1832
if (nearby_flag) tree_depth=1; else tree_depth=0;
1834
if (specified_class != -1) goto HeaderPassed;
1838
/* Read past and count a sequence of "->"s, if any are present */
1840
if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
1842
error("The syntax '->' is only used as an alternative to 'Nearby'");
1844
while ((token_type == SEP_TT) && (token_value == ARROW_SEP))
1850
sprintf(shortname_buffer, "?");
1852
segment_markers.enabled = TRUE;
1854
/* This first word is either an internal name, or a textual short name,
1855
or the end of the header part */
1857
if (end_of_header()) goto HeaderPassed;
1859
if (token_type == DQ_TT) textual_name = token_text;
1861
{ if ((token_type != SYMBOL_TT)
1862
|| (!(sflags[token_value] & UNKNOWN_SFLAG)))
1863
ebf_error("name for new object or its textual short name",
1866
{ internal_name_symbol = token_value;
1867
strcpy(internal_name, token_text);
1871
/* The next word is either a parent object, or
1872
a textual short name, or the end of the header part */
1875
if (end_of_header()) goto HeaderPassed;
1877
if (token_type == DQ_TT)
1878
{ if (textual_name != NULL)
1879
error("Two textual short names given for only one object");
1881
textual_name = token_text;
1884
{ if ((token_type != SYMBOL_TT)
1885
|| (sflags[token_value] & UNKNOWN_SFLAG))
1886
{ if (textual_name == NULL)
1887
ebf_error("parent object or the object's textual short name",
1890
ebf_error("parent object", token_text);
1892
else goto SpecParent;
1895
/* Finally, it's possible that there is still a parent object */
1898
if (end_of_header()) goto HeaderPassed;
1900
if (specified_parent != -1)
1901
ebf_error("body of object definition", token_text);
1904
if ((stypes[token_value] == OBJECT_T)
1905
|| (stypes[token_value] == CLASS_T))
1906
{ specified_parent = svals[token_value];
1907
sflags[token_value] |= USED_SFLAG;
1909
else ebf_error("name of (the parent) object", token_text);
1912
/* Now it really has to be the body of the definition. */
1915
if (end_of_header()) goto HeaderPassed;
1917
ebf_error("body of object definition", token_text);
1920
if (specified_class == -1) put_token_back();
1922
if (internal_name_symbol > 0)
1923
assign_symbol(internal_name_symbol, no_objects + 1, OBJECT_T);
1925
if (listobjects_switch)
1926
printf("%3d \"%s\"\n", no_objects+1,
1927
(textual_name==NULL)?"(with no short name)":textual_name);
1928
if (textual_name == NULL)
1929
{ if (internal_name_symbol > 0)
1930
sprintf(shortname_buffer, "(%s)",
1931
(char *) symbs[internal_name_symbol]);
1933
sprintf(shortname_buffer, "(%d)", no_objects+1);
1936
{ if (strlen(textual_name)>765)
1937
error("Short name of object (in quotes) exceeded 765 characters");
1938
strncpy(shortname_buffer, textual_name, 765);
1941
if (specified_parent != -1)
1942
{ if (tree_depth > 0)
1943
error("Use of '->' (or 'Nearby') clashes with giving a parent");
1944
parent_of_this_obj = specified_parent;
1947
{ parent_of_this_obj = 0;
1950
/* We have to set the parent object to the most recently defined
1951
object at level (tree_depth - 1) in the tree.
1953
A complication is that objects are numbered 1, 2, ... in the
1954
Z-machine (and in the objects[].parent, etc., fields) but
1955
0, 1, 2, ... internally (and as indices to object[]). */
1957
for (i=no_objects-1; i>=0; i--)
1960
/* Metaclass or class objects cannot be '->' parents: */
1961
if ((!module_switch) && (i<4))
1965
if (objectsz[i].parent == 1)
1967
while (objectsz[j].parent != 0)
1968
{ j = objectsz[j].parent - 1; k++; }
1971
if (objectsg[i].parent == 1)
1973
while (objectsg[j].parent != 0)
1974
{ j = objectsg[j].parent - 1; k++; }
1977
if (k == tree_depth - 1)
1978
{ parent_of_this_obj = i+1;
1982
if (parent_of_this_obj == 0)
1983
{ if (tree_depth == 1)
1984
error("'->' (or 'Nearby') fails because there is no previous object");
1986
error("'-> -> ...' fails because no previous object is deep enough");
1991
initialise_full_object();
1992
if (instance_of != -1) add_class_to_inheritance_list(instance_of);
1994
if (specified_class == -1) parse_body_of_definition();
1995
else add_class_to_inheritance_list(specified_class);
1997
if (debugfile_switch)
1998
{ write_debug_byte(OBJECT_DBR);
1999
write_debug_byte((no_objects+1)/256);
2000
write_debug_byte((no_objects+1)%256);
2001
write_debug_string(internal_name);
2002
write_dbgl(start_dbgl);
2003
write_dbgl(token_line_ref);
2007
manufacture_object_z();
2009
manufacture_object_g();
2012
/* ========================================================================= */
2013
/* Data structure management routines */
2014
/* ------------------------------------------------------------------------- */
2016
extern void init_objects_vars(void)
2018
properties_table = NULL;
2019
prop_is_long = NULL;
2020
prop_is_additive = NULL;
2021
prop_default_value = NULL;
2026
classes_to_inherit_from = NULL;
2027
class_begins_at = NULL;
2030
extern void objects_begin_pass(void)
2032
properties_table_size=0;
2033
prop_is_long[1] = TRUE; prop_is_additive[1] = TRUE; /* "name" */
2034
prop_is_long[2] = TRUE; prop_is_additive[2] = TRUE; /* inheritance prop */
2036
prop_is_long[3] = TRUE; prop_is_additive[3] = FALSE;
2037
/* instance variables table address */
2040
if (define_INFIX_switch) no_attributes = 1;
2041
else no_attributes = 0;
2045
objectsz[0].parent = 0; objectsz[0].child = 0; objectsz[0].next = 0;
2046
no_individual_properties=72;
2049
objectsg[0].parent = 0; objectsg[0].child = 0; objectsg[0].next = 0;
2050
no_individual_properties = INDIV_PROP_START+8;
2054
no_embedded_routines = 0;
2056
individuals_length=0;
2059
extern void objects_allocate_arrays(void)
2065
prop_default_value = my_calloc(sizeof(int32), INDIV_PROP_START,
2066
"property default values");
2067
prop_is_long = my_calloc(sizeof(int), INDIV_PROP_START,
2068
"property-is-long flags");
2069
prop_is_additive = my_calloc(sizeof(int), INDIV_PROP_START,
2070
"property-is-additive flags");
2072
classes_to_inherit_from = my_calloc(sizeof(int), MAX_CLASSES,
2073
"inherited classes list");
2074
class_begins_at = my_calloc(sizeof(int32), MAX_CLASSES,
2075
"pointers to classes");
2076
class_object_numbers = my_calloc(sizeof(int), MAX_CLASSES,
2077
"class object numbers");
2079
properties_table = my_malloc(MAX_PROP_TABLE_SIZE,"properties table");
2080
individuals_table = my_malloc(MAX_INDIV_PROP_TABLE_SIZE,
2081
"individual properties table");
2084
objectsz = my_calloc(sizeof(objecttz), MAX_OBJECTS,
2088
objectsg = my_calloc(sizeof(objecttg), MAX_OBJECTS,
2090
objectatts = my_calloc(NUM_ATTR_BYTES, MAX_OBJECTS,
2092
full_object_g.props = my_calloc(sizeof(propg), MAX_OBJ_PROP_COUNT,
2093
"object property list");
2094
full_object_g.propdata = my_calloc(sizeof(assembly_operand),
2095
MAX_OBJ_PROP_TABLE_SIZE,
2096
"object property data table");
2100
extern void objects_free_arrays(void)
2102
my_free(&prop_default_value, "property default values");
2103
my_free(&prop_is_long, "property-is-long flags");
2104
my_free(&prop_is_additive, "property-is-additive flags");
2106
my_free(&objectsz, "z-objects");
2107
my_free(&objectsg, "g-objects");
2108
my_free(&objectatts, "g-attributes");
2109
my_free(&class_object_numbers,"class object numbers");
2110
my_free(&classes_to_inherit_from, "inherited classes list");
2111
my_free(&class_begins_at, "pointers to classes");
2113
my_free(&properties_table, "properties table");
2114
my_free(&individuals_table,"individual properties table");
2117
my_free(&full_object_g.props, "object property list");
2118
my_free(&full_object_g.propdata, "object property data table");
2123
/* ========================================================================= */
added
removed
inform-6.31.1/src/objects.c
