1 /* $Header: d:/cvsroot/tads/tads3/VMTOBJ.H,v 1.2 1999/05/17 02:52:29 MJRoberts Exp $ */
2 
3 /*
4  *   Copyright (c) 1998, 2002 Michael J. Roberts.  All Rights Reserved.
5  *
6  *   Please see the accompanying license file, LICENSE.TXT, for information
7  *   on using and copying this software.
8  */
9 /*
10 Name
11   vmtobj.h - VM TADS Object implementation
12 Function
13 
14 Notes
15   This implementation assumes a non-relocating memory manager, both for
16   the fixed part (the CVmObject part) and the variable part (the
17   "extension," located in the variable-part heap) of our objects.  In the
18   present implementation, the memory manager satisfies this requirement, and
19   there are no plans to change this.
20 
21   The memory manager is designed *in principal* to allow for object
22   relocation (specifically as a means to reduce heap fragmentation), so it's
23   not a foregone conclusion that such a thing will never be implemented.
24   However, given the large memories of modern machines (especially relative
25   to the size of a typical tads application), and given that recent academic
26   research has been calling into question the conventional wisdom that heap
27   fragmentation is actually a problem in practice, we consider the
28   probability that we will want to implement a relocation memory manager
29   low, and thus we feel it's better to exploit the efficiencies of using and
30   storing direct object pointers in some places in this code.
31 Modified
32   10/30/98 MJRoberts  - Creation
33 */
34 
35 #ifndef VMTOBJ_H
36 #define VMTOBJ_H
37 
38 #include <stdlib.h>
39 #include <string.h>
40 
41 #include "t3std.h"
42 #include "vmtype.h"
43 #include "vmglob.h"
44 #include "vmobj.h"
45 #include "vmundo.h"
46 
47 /* forward-declare our main class */
48 class CVmObjTads;
49 
50 /* ------------------------------------------------------------------------ */
51 /*
52  *   TADS-Object image file data.  The image file state is loaded into an
53  *   image object data block, and we set up our own internal data based on
54  *   it at load time.  The image file data block is arranged as follows:
55  *
56  *.  UINT2 superclass_count
57  *.  UINT2 load_image_property_count
58  *.  UINT2 flags
59  *.  UINT4 superclass_1
60  *.  ...
61  *.  UINT4 superclass_N
62  *.  UINT2 load_image_property_ID_1
63  *.  DATAHOLDER load_image_property_value_1
64  *.  ...
65  *.  UINT2 load_image_property_ID_N
66  *.  DATAHOLDER load_image_property_value_N
67  */
68 
69 /* superclass structure for object extension */
70 struct vm_tadsobj_sc
71 {
72     vm_obj_id_t id;
73     CVmObjTads *objp;
74 };
75 
76 
77 /*
78  *   For our in-memory object extension, we use a structure that stores the
79  *   object data.  We store the properties in a hash table keyed on property
80  *   ID.
81  */
82 struct vm_tadsobj_hdr
83 {
84     /* allocate */
85     static vm_tadsobj_hdr *alloc(VMG_ class CVmObjTads *self,
86                                  unsigned short sc_cnt,
87                                  unsigned short prop_cnt);
88 
89     /* delete */
90     void free_mem();
91 
92     /* reallocate an existing object to expand its property table */
93     static vm_tadsobj_hdr *expand(VMG_ class CVmObjTads *self,
94                                   vm_tadsobj_hdr *obj);
95 
96     /*
97      *   reallocate an existing object to expand its property table to the
98      *   given minimum number of property entries
99      */
100     static vm_tadsobj_hdr *expand_to(VMG_ class CVmObjTads *self,
101                                      vm_tadsobj_hdr *obj,
102                                      size_t new_sc_cnt, size_t min_prop_cnt);
103 
104     /* invalidate the cached inheritance path, if any */
inval_inh_pathvm_tadsobj_hdr105     void inval_inh_path()
106     {
107         /* if we have an inheritance path cached, forget it */
108         if (inh_path != 0)
109         {
110             /* forget the path, so that we recalculate it on demand */
111             t3free(inh_path);
112             inh_path = 0;
113         }
114     }
115 
116     /* find a property entry */
117     inline struct vm_tadsobj_prop *find_prop_entry(uint prop);
118 
119     /* allocate a new hash entry */
120     vm_tadsobj_prop *alloc_prop_entry(vm_prop_id_t prop,
121                                       const vm_val_t *val,
122                                       unsigned int flags);
123 
124     /* calculate the hash code for a property */
calc_hashvm_tadsobj_hdr125     unsigned int calc_hash(uint prop) const
126     {
127         /*
128          *   Simply take the property ID modulo the table size.  We always
129          *   use a power of 2 as the hash table size, so the remainder is
130          *   easy to calculate using a bit mask rather than a more expensive
131          *   integer division.
132          */
133         return (unsigned int)(prop & (hash_siz - 1));
134     }
135 
136     /* check to see if we have the required number of free entries */
has_free_entriesvm_tadsobj_hdr137     int has_free_entries(size_t cnt) const
138         { return cnt <= (size_t)(prop_entry_free - prop_entry_cnt); }
139 
140     /* load image object flags (a combination of VMTOBJ_OBJF_xxx values) */
141     unsigned short li_obj_flags;
142 
143     /* internal object flags (a combination of VMTO_OBJ_xxx values) */
144     unsigned short intern_obj_flags;
145 
146     /*
147      *   Inheritance search table.  We build and save the search path for
148      *   any class with multiple superclasses, because the inheritance path
149      *   for a class with multiple base classes can be somewhat
150      *   time-consuming to determine.  For objects with only one base class,
151      *   we don't bother caching a path, since the path is trivial to
152      *   calculate in these cases.
153      */
154     struct tadsobj_inh_path *inh_path;
155 
156     /*
157      *   Number of hash buckets, and a pointer to the bucket array.  (The
158      *   hash bucket array is allocated as part of the same memory block as
159      *   this structure - we suballocate it from the memory block when
160      *   allocating the structure.)  'hash_arr[hash]' points to the head of
161      *   a list of property entries with the given hash value.
162      */
163     unsigned short hash_siz;
164     struct vm_tadsobj_prop **hash_arr;
165 
166     /*
167      *   Pointer to our allocation array of hash buckets.  We suballocate
168      *   this out of our allocation block.  (Note that this isn't the hash
169      *   table; this is the pool of elements out of which hash table entries
170      *   - not buckets, but the entries in the lists pointed to by the
171      *   buckets - are allocated.)
172      */
173     struct vm_tadsobj_prop *prop_entry_arr;
174 
175     /* total number of hash entries allocated */
176     unsigned short prop_entry_cnt;
177 
178     /*
179      *   Index of next available hash entry.  Hash entries are never
180      *   deleted, so we don't have to worry about returning entries to the
181      *   free pool.  So, the free pool simply consists of entries from this
182      *   index to the maximum index (prop_entry_cnt - 1).
183      *
184      *   When we run out of entries, we must reallocate this entire
185      *   structure to make room for more.  This means that reallocation is
186      *   fairly expensive, but this is acceptable because we will always
187      *   want to resize the hash table at the same time anyway.  We always
188      *   resize the hash table on exhausting our current allocation size
189      *   because we pick the hash table size based on the expected maximum
190      *   number of entries; once we exceed that maximum, we must reconsider
191      *   the hash table size.
192      */
193     unsigned short prop_entry_free;
194 
195     /*
196      *   Number of superclasses, and the array of superclasses.  We
197      *   overallocate the structure to make room for enough superclasses.
198      *   (Note that this means the 'sc' field must be the last thing in the
199      *   structure.)
200      */
201     unsigned short sc_cnt;
202     vm_tadsobj_sc sc[1];
203 };
204 
205 /*
206  *   Tads-object property entry.  Each hash table entry points to a linked
207  *   list of these entries.
208  */
209 struct vm_tadsobj_prop
210 {
211     /* my property ID */
212     vm_prop_id_t prop;
213 
214     /* pointer to the next entry at the same hash value */
215     vm_tadsobj_prop *nxt;
216 
217     /* flags */
218     unsigned char flags;
219 
220     /* my value */
221     vm_val_t val;
222 };
223 
224 
225 /*
226  *   Internal object flags
227  */
228 
229 /* from load image - object originally came from image file */
230 #define VMTO_OBJ_IMAGE   0x0001
231 
232 /* modified - object has been modified since being loaded from image */
233 #define VMTO_OBJ_MOD     0x0002
234 
235 
236 /*
237  *   Property entry flags
238  */
239 
240 /* modified - this property is not from the load image file */
241 #define VMTO_PROP_MOD     0x01
242 
243 /* we've stored undo for this property since the last savepoint */
244 #define VMTO_PROP_UNDO    0x02
245 
246 /* ------------------------------------------------------------------------ */
247 /*
248  *   Load Image Object Flag Values - these values are stored in the image
249  *   file object header.
250  */
251 
252 /* class - the object represents a class, not an instance */
253 #define VMTOBJ_OBJF_CLASS    0x0001
254 
255 
256 /* ------------------------------------------------------------------------ */
257 /*
258  *   Initial empty property table size.  When we initially load an object,
259  *   we'll allocate this many empty slots for modifiable properties.
260  */
261 const ushort VMTOBJ_PROP_INIT = 16;
262 
263 
264 /* ------------------------------------------------------------------------ */
265 /*
266  *   TADS object interface.
267  */
268 class CVmObjTads: public CVmObject
269 {
270     friend class CVmMetaclassTads;
271     friend struct tadsobj_sc_search_ctx;
272 
273 public:
274     /* metaclass registration object */
275     static class CVmMetaclass *metaclass_reg_;
get_metaclass_reg()276     class CVmMetaclass *get_metaclass_reg() const { return metaclass_reg_; }
277 
278     /* am I of the given metaclass? */
is_of_metaclass(class CVmMetaclass * meta)279     virtual int is_of_metaclass(class CVmMetaclass *meta) const
280     {
281         /* try my own metaclass and my base class */
282         return (meta == metaclass_reg_
283                 || CVmObject::is_of_metaclass(meta));
284     }
285 
286     /* is the given object a TadsObject object? */
is_tadsobj_obj(VMG_ vm_obj_id_t obj)287     static int is_tadsobj_obj(VMG_ vm_obj_id_t obj)
288         { return vm_objp(vmg_ obj)->is_of_metaclass(metaclass_reg_); }
289 
290     /* create dynamically using stack arguments */
create_from_stack(VMG_ const uchar ** pc_ptr,uint argc)291     static vm_obj_id_t create_from_stack(VMG_ const uchar **pc_ptr,
292                                          uint argc)
293         { return create_from_stack_intern(vmg_ pc_ptr, argc, FALSE); }
294 
295     /*
296      *   call a static property - we don't have any of our own, so simply
297      *   "inherit" the base class handling
298      */
299     static int call_stat_prop(VMG_ vm_val_t *result,
300                               const uchar **pc_ptr, uint *argc,
301                               vm_prop_id_t prop);
302 
303     /* create an object with no initial extension */
304     static vm_obj_id_t create(VMG_ int in_root_set);
305 
306     /*
307      *   Create an object with a given number of superclasses, and a given
308      *   number of property slots.  The property slots are all initially
309      *   allocated to modified properties.
310      */
311     static vm_obj_id_t create(VMG_ int in_root_set,
312                               ushort superclass_count, ushort prop_slots);
313 
314     /* notify of deletion */
315     void notify_delete(VMG_ int in_root_set);
316 
317     /* create an instance of this object */
318     void create_instance(VMG_ vm_obj_id_t self,
319                          const uchar **pc_ptr, uint argc);
320 
321     /* determine if the object has a finalizer method */
322     virtual int has_finalizer(VMG_ vm_obj_id_t /*self*/);
323 
324     /* invoke the object's finalizer */
325     virtual void invoke_finalizer(VMG_ vm_obj_id_t self);
326 
327     /* get the number of superclasses of this object */
get_superclass_count(VMG_ vm_obj_id_t self)328     virtual int get_superclass_count(VMG_ vm_obj_id_t self) const
329     {
330         /*
331          *   if we have no superclass, inherit the default, since we
332          *   inherit from the system TadsObject class; if we have our own
333          *   superclasses, return them
334          */
335         if (get_sc_count() == 0)
336             return CVmObject::get_superclass_count(vmg_ self);
337         else
338             return get_sc_count();
339     }
340 
341     /* get the nth superclass of this object */
get_superclass(VMG_ vm_obj_id_t self,int idx)342     virtual vm_obj_id_t get_superclass(VMG_ vm_obj_id_t self, int idx) const
343     {
344         /*
345          *   if we have no superclass, inherit the default, since we
346          *   inherit from the system TadsObject class; if we have our own
347          *   superclasses, return them
348          */
349         if (get_sc_count() == 0)
350             return CVmObject::get_superclass(vmg_ self, idx);
351         else if (idx >= get_sc_count())
352             return VM_INVALID_OBJ;
353         else
354             return get_sc(idx);
355     }
356 
357     /* determine if I'm a class object */
is_class_object(VMG_ vm_obj_id_t)358     virtual int is_class_object(VMG_ vm_obj_id_t /*self*/) const
359         { return (get_li_obj_flags() & VMTOBJ_OBJF_CLASS) != 0; }
360 
361     /* determine if I'm an instance of the given object */
362     int is_instance_of(VMG_ vm_obj_id_t obj);
363 
364     /* this object type provides properties */
provides_props(VMG0_)365     int provides_props(VMG0_) const { return TRUE; }
366 
367     /* enumerate properties */
368     void enum_props(VMG_ vm_obj_id_t self,
369                     void (*cb)(VMG_ void *ctx,
370                                vm_obj_id_t self, vm_prop_id_t prop,
371                                const vm_val_t *val),
372                     void *cbctx);
373 
374     /* set a property */
375     void set_prop(VMG_ class CVmUndo *undo,
376                   vm_obj_id_t self, vm_prop_id_t prop, const vm_val_t *val);
377 
378     /* get a property */
379     int get_prop(VMG_ vm_prop_id_t prop, vm_val_t *val,
380                  vm_obj_id_t self, vm_obj_id_t *source_obj, uint *argc);
381 
382     /* inherit a property */
383     int inh_prop(VMG_ vm_prop_id_t prop, vm_val_t *val,
384                  vm_obj_id_t self,
385                  vm_obj_id_t orig_target_obj,
386                  vm_obj_id_t defining_obj,
387                  vm_obj_id_t *source_obj, uint *argc);
388 
389     /* build my property list */
390     void build_prop_list(VMG_ vm_obj_id_t self, vm_val_t *retval);
391 
392     /*
393      *   Receive notification of a new savepoint.  We keep track of
394      *   whether or not we've saved undo information for each modifiable
395      *   property in the current savepoint, so that we can avoid saving
396      *   redundant undo information when repeatedly changing a property
397      *   value (since only the first change in a given savepoint needs to
398      *   be recorded).  When we start a new savepoint, we obviously
399      *   haven't yet stored any undo information for the new savepoint, so
400      *   we can simply clear all of the undo records.
401      */
notify_new_savept()402     void notify_new_savept()
403         { clear_undo_flags(); }
404 
405     /* apply undo */
406     void apply_undo(VMG_ struct CVmUndoRecord *rec);
407 
408     /* mark a reference in an undo record */
409     void mark_undo_ref(VMG_ struct CVmUndoRecord *undo);
410 
411     /*
412      *   remove stale weak references from an undo record -- we keep only
413      *   normal strong references, so we don't need to do anything here
414      */
remove_stale_undo_weak_ref(VMG_ struct CVmUndoRecord *)415     void remove_stale_undo_weak_ref(VMG_ struct CVmUndoRecord *) { }
416 
417     /* mark references */
418     void mark_refs(VMG_ uint state);
419 
420     /*
421      *   remove weak references - we keep only normal (strong) references,
422      *   so this routine doesn't need to do anything
423      */
remove_stale_weak_refs(VMG0_)424     void remove_stale_weak_refs(VMG0_) { }
425 
426     /* load from an image file */
427     void load_from_image(VMG_ vm_obj_id_t self, const char *ptr, size_t siz);
428 
429     /* restore to image file state */
430     void reload_from_image(VMG_ vm_obj_id_t self,
431                            const char *ptr, size_t siz);
432 
433     /* determine if the object has been changed since it was loaded */
434     int is_changed_since_load() const;
435 
436     /* save to a file */
437     void save_to_file(VMG_ class CVmFile *fp);
438 
439     /* restore from a file */
440     void restore_from_file(VMG_ vm_obj_id_t self,
441                            class CVmFile *fp, class CVmObjFixup *fixups);
442 
443     /* rebuild for image file */
444     virtual ulong rebuild_image(VMG_ char *buf, ulong buflen);
445 
446     /* convert to constant data */
447     virtual void convert_to_const_data(VMG_ class CVmConstMapper *mapper,
448                                        vm_obj_id_t self);
449 
450     /* get the nth superclass */
get_sc(ushort n)451     vm_obj_id_t get_sc(ushort n) const
452         { return get_hdr()->sc[n].id; }
453 
454     /* get a pointer to the object for the nth superclass */
get_sc_objp(VMG_ ushort n)455     CVmObjTads *get_sc_objp(VMG_ ushort n) const
456     {
457         CVmObjTads **objpp;
458 
459         /* if we haven't stored the superclass object pointer yet, do so */
460         objpp = &get_hdr()->sc[n].objp;
461         if (*objpp == 0)
462             *objpp = (CVmObjTads *)vm_objp(vmg_ get_hdr()->sc[n].id);
463 
464         /* return the object pointer */
465         return *objpp;
466     }
467 
468     /* set the nth superclass to the given object */
set_sc(VMG_ ushort n,vm_obj_id_t obj)469     void set_sc(VMG_ ushort n, vm_obj_id_t obj)
470     {
471         get_hdr()->sc[n].id = obj;
472         get_hdr()->sc[n].objp = (CVmObjTads *)vm_objp(vmg_ obj);
473     }
474 
475     /* static class initialization/termination */
476     static void class_init(VMG0_);
477     static void class_term(VMG0_);
478 
479 protected:
480     /* create an object with no initial extension */
CVmObjTads()481     CVmObjTads() { ext_ = 0; }
482 
483     /*
484      *   Create an object with a given number of superclasses, and a given
485      *   number of property slots.  All property slots are initially
486      *   allocated to the modifiable property list.
487      */
488     CVmObjTads(VMG_ ushort superclass_count, ushort prop_count);
489 
490     /* internal handler to create from stack arguments */
491     static vm_obj_id_t create_from_stack_intern(VMG_ const uchar **pc_ptr,
492                                                 uint argc, int is_transient);
493 
494     /*
495      *   internal handler to create with multiple inheritance from arguments
496      *   passed on the stack
497      */
498     static vm_obj_id_t create_from_stack_multi(VMG_ uint argc,
499                                                int is_transient);
500 
501     /* get the load iamge object flags */
get_li_obj_flags()502     uint get_li_obj_flags() const
503         { return get_hdr()->li_obj_flags; }
504 
505     /* set the object flags */
set_li_obj_flags(uint flags)506     void set_li_obj_flags(uint flags)
507         { get_hdr()->li_obj_flags = flags; }
508 
509     /*
510      *   Allocate memory - this replaces any existing extension, so the
511      *   caller must take care to free the extension (if one has already
512      *   been allocated) before calling this routine.
513      *
514      *   If 'from_image' is true, we're allocating memory for use with an
515      *   object loaded from an image file, so we'll ignore the superclass
516      *   count and leave the image_data pointer in the header unchanged.
517      *   If 'from_image' is false, we're allocating memory for a dynamic
518      *   object that does not have a presence in the image file, so we'll
519      *   allocate space for the superclass list as part of the extension
520      *   and set the image_data pointer in the header to refer the extra
521      *   space after the modifiable property array and undo bit array.
522      */
523     void alloc_mem(VMG_ ushort sc_count, ushort mod_prop_count,
524                    int from_image);
525 
526     /* get a property from the intrinsic class */
527     int get_prop_intrinsic(VMG_ vm_prop_id_t prop, vm_val_t *val,
528                            vm_obj_id_t self, vm_obj_id_t *source_obj,
529                            uint *argc);
530 
531     /*
532      *   Search for a property, continuing a previous search from the given
533      *   point.  defining_obj is the starting point for the search: we start
534      *   searching in the target object's inheritance tree after
535      *   defining_obj.  This is used to continue an inheritance search from
536      *   a given point, as needed for the 'inherited' operator, for example.
537      */
538     static int search_for_prop_from(VMG_ uint prop,
539                                     vm_val_t *val,
540                                     vm_obj_id_t orig_target_obj,
541                                     vm_obj_id_t *source_obj,
542                                     vm_obj_id_t defining_obj);
543 
544     /* cache and return the inheritance search path for this object */
545     tadsobj_inh_path *get_inh_search_path(VMG0_);
546 
547     /* load the image file properties and superclasses */
548     void load_image_props_and_scs(VMG_ const char *ptr, size_t siz);
549 
550     /* get/set the superclass count */
get_sc_count()551     ushort get_sc_count() const
552         { return get_hdr()->sc_cnt; }
set_sc_count(ushort cnt)553     void set_sc_count(ushort cnt)
554         { get_hdr()->sc_cnt = cnt; }
555 
556     /* clear all undo flags */
557     void clear_undo_flags();
558 
559 
560     /* -------------------------------------------------------------------- */
561     /*
562      *   Low-level format management - these routines encapsulate the byte
563      *   layout of the object in memory.  This is a bit nasty because we
564      *   keep the object's contents in the portable image format.
565      */
566 
567     /* get my header */
get_hdr()568     inline struct vm_tadsobj_hdr *get_hdr() const
569         { return (vm_tadsobj_hdr *)ext_; }
570 
571     /* property evaluator - undefined property */
getp_undef(VMG_ vm_obj_id_t,vm_val_t *,uint *)572     int getp_undef(VMG_ vm_obj_id_t, vm_val_t *, uint *) { return FALSE; }
573 
574     /* property evaluator - createInstance */
575     int getp_create_instance(VMG_ vm_obj_id_t, vm_val_t *, uint *);
576 
577     /* property evaluator - createClone */
578     int getp_create_clone(VMG_ vm_obj_id_t, vm_val_t *, uint *);
579 
580     /* property evaluator - createTransientInstance */
581     int getp_create_trans_instance(VMG_ vm_obj_id_t, vm_val_t *retval,
582                                    uint *argc);
583 
584     /* property evaluator - createInstanceOf */
585     int getp_create_instance_of(VMG_ vm_obj_id_t self,
586                                 vm_val_t *retval, uint *in_argc);
587 
588     /* property evaluator - createTransientInstanceOf */
589     int getp_create_trans_instance_of(VMG_ vm_obj_id_t self,
590                                       vm_val_t *retval, uint *in_argc);
591 
592     /* common handler for createInstance and createTransientInstance */
593     int getp_create_common(VMG_ vm_obj_id_t, vm_val_t *retval, uint *argc,
594                            int is_transient);
595 
596     /* common handler for createInstanceOf and createTransientInstanceOf */
597     int getp_create_multi_common(VMG_ vm_obj_id_t, vm_val_t *retval,
598                                  uint *argc, int is_transient);
599 
600     /* property evaluator - setSuperclassList */
601     int getp_set_sc_list(VMG_ vm_obj_id_t self,
602                          vm_val_t *retval, uint *in_argc);
603 
604     /* property evaluation function table */
605     static int (CVmObjTads::*func_table_[])(VMG_ vm_obj_id_t self,
606                                             vm_val_t *retval, uint *argc);
607 };
608 
609 /* ------------------------------------------------------------------------ */
610 /*
611  *   Registration table object
612  */
613 class CVmMetaclassTads: public CVmMetaclass
614 {
615 public:
616     /* get the global name */
get_meta_name()617     const char *get_meta_name() const { return "tads-object/030004"; }
618 
619     /* create from image file */
create_for_image_load(VMG_ vm_obj_id_t id)620     void create_for_image_load(VMG_ vm_obj_id_t id)
621     {
622         new (vmg_ id) CVmObjTads();
623         G_obj_table->set_obj_gc_characteristics(id, TRUE, FALSE);
624     }
625 
626     /* create from restoring from saved state */
create_for_restore(VMG_ vm_obj_id_t id)627     void create_for_restore(VMG_ vm_obj_id_t id)
628     {
629         new (vmg_ id) CVmObjTads();
630         G_obj_table->set_obj_gc_characteristics(id, TRUE, FALSE);
631     }
632 
633     /* create dynamically using stack arguments */
create_from_stack(VMG_ const uchar ** pc_ptr,uint argc)634     vm_obj_id_t create_from_stack(VMG_ const uchar **pc_ptr, uint argc)
635         { return CVmObjTads::create_from_stack(vmg_ pc_ptr, argc); }
636 
637     /* call a static property */
call_stat_prop(VMG_ vm_val_t * result,const uchar ** pc_ptr,uint * argc,vm_prop_id_t prop)638     int call_stat_prop(VMG_ vm_val_t *result,
639                        const uchar **pc_ptr, uint *argc,
640                        vm_prop_id_t prop)
641     {
642         return CVmObjTads::call_stat_prop(vmg_ result, pc_ptr, argc, prop);
643     }
644 };
645 
646 /* ------------------------------------------------------------------------ */
647 /*
648  *   Intrinsic class modifier object.  This object is for use as a modifier
649  *   object for an intrinsic class.
650  *
651  *   This is a simple subclass of the regular TADS-Object class.  The only
652  *   difference is that we resolve properties a little differently: unlike
653  *   regular TADS Objects, this class is essentially a mix-in, and has no
654  *   intrinsic superclass at all.  This means that the only place we look
655  *   for a property in get_prop is in our property list; we specifically do
656  *   not look for an intrinsic property, nor do we look for a superclass
657  *   that provides an intrinsic property.
658  */
659 class CVmObjIntClsMod: public CVmObjTads
660 {
661     friend class CVmMetaclassIntClsMod;
662 
663 public:
664     static class CVmMetaclass *metaclass_reg_;
get_metaclass_reg()665     class CVmMetaclass *get_metaclass_reg() const { return metaclass_reg_; }
666 
667     /* am I of the given metaclass? */
is_of_metaclass(class CVmMetaclass * meta)668     virtual int is_of_metaclass(class CVmMetaclass *meta) const
669     {
670         /* try my own metaclass and my base class */
671         return (meta == metaclass_reg_
672                 || CVmObjTads::is_of_metaclass(meta));
673     }
674 
675     /* is the given object an intrinsic class modifier object? */
is_intcls_mod_obj(VMG_ vm_obj_id_t obj)676     static int is_intcls_mod_obj(VMG_ vm_obj_id_t obj)
677         { return vm_objp(vmg_ obj)->is_of_metaclass(metaclass_reg_); }
678 
679     /* create dynamically using stack arguments */
create_from_stack(VMG_ const uchar ** pc_ptr,uint argc)680     static vm_obj_id_t create_from_stack(VMG_ const uchar **pc_ptr,
681                                          uint argc)
682     {
683         /* can't create instances of intrinsic class modifiers */
684         err_throw(VMERR_ILLEGAL_NEW);
685         return VM_INVALID_OBJ;
686     }
687 
688     /*
689      *   call a static property - we don't have any of our own, so simply
690      *   "inherit" the base class handling
691      */
call_stat_prop(VMG_ vm_val_t * result,const uchar ** pc_ptr,uint * argc,vm_prop_id_t prop)692     static int call_stat_prop(VMG_ vm_val_t *result,
693                               const uchar **pc_ptr, uint *argc,
694                               vm_prop_id_t prop)
695     {
696         return CVmObjTads::call_stat_prop(vmg_ result, pc_ptr, argc, prop);
697     }
698 
699     /* get a property */
700     int get_prop(VMG_ vm_prop_id_t prop, vm_val_t *val,
701                  vm_obj_id_t self, vm_obj_id_t *source_obj, uint *argc);
702 
703     /* inherit a property */
704     int inh_prop(VMG_ vm_prop_id_t prop, vm_val_t *val,
705                  vm_obj_id_t self,
706                  vm_obj_id_t orig_target_obj,
707                  vm_obj_id_t defining_obj,
708                  vm_obj_id_t *source_obj, uint *argc);
709 
710     /* build my property list */
711     void build_prop_list(VMG_ vm_obj_id_t self, vm_val_t *retval);
712 
713     /* create an object with no initial extension */
CVmObjIntClsMod()714     CVmObjIntClsMod() { ext_ = 0; }
715 
716     /*
717      *   Create an object with a given number of superclasses, and a given
718      *   number of property slots.  All property slots are initially
719      *   allocated to the modifiable property list.
720      */
CVmObjIntClsMod(VMG_ ushort superclass_count,ushort prop_count)721     CVmObjIntClsMod(VMG_ ushort superclass_count, ushort prop_count)
722         : CVmObjTads(vmg_ superclass_count, prop_count) { }
723 };
724 
725 /*
726  *   Registration table object
727  */
728 class CVmMetaclassIntClsMod: public CVmMetaclass
729 {
730 public:
731     /* get the global name */
get_meta_name()732     const char *get_meta_name() const { return "int-class-mod/030000"; }
733 
734     /* create from image file */
create_for_image_load(VMG_ vm_obj_id_t id)735     void create_for_image_load(VMG_ vm_obj_id_t id)
736     {
737         new (vmg_ id) CVmObjIntClsMod();
738         G_obj_table->set_obj_gc_characteristics(id, TRUE, FALSE);
739     }
740 
741     /* create from restoring from saved state */
create_for_restore(VMG_ vm_obj_id_t id)742     void create_for_restore(VMG_ vm_obj_id_t id)
743     {
744         new (vmg_ id) CVmObjIntClsMod();
745         G_obj_table->set_obj_gc_characteristics(id, TRUE, FALSE);
746     }
747 
748     /* create dynamically using stack arguments */
create_from_stack(VMG_ const uchar ** pc_ptr,uint argc)749     vm_obj_id_t create_from_stack(VMG_ const uchar **pc_ptr, uint argc)
750         { return CVmObjIntClsMod::create_from_stack(vmg_ pc_ptr, argc); }
751 
752     /* call a static property */
call_stat_prop(VMG_ vm_val_t * result,const uchar ** pc_ptr,uint * argc,vm_prop_id_t prop)753     int call_stat_prop(VMG_ vm_val_t *result,
754                        const uchar **pc_ptr, uint *argc,
755                        vm_prop_id_t prop)
756     {
757         return CVmObjIntClsMod::
758             call_stat_prop(vmg_ result, pc_ptr, argc, prop);
759     }
760 };
761 
762 #endif /* VMTOBJ_H */
763 
764 /*
765  *   Register the classes
766  */
767 VM_REGISTER_METACLASS(CVmObjTads)
768 VM_REGISTER_METACLASS(CVmObjIntClsMod)
769