14.7 Objinterface Interface

ORIGIN '~beta/basiclib/betaenv';
LIB_DEF 'sysutilsobjint' '../lib';
BODY 'private/objinterfacebody';

(* The lowlevel BETA interface to BETA objects
 *
 * COPYRIGHT
 *       Copyright Mjolner Informatics, 1992-96
 *       All rights reserved.
 *)
--- LIB: attributes ---

(* Possible values of protoType.scanRefs.refType if isStatic is FALSE: *)
REFTYPE_DYNAMIC: (# exit 0 #);
REFTYPE_OFFLINE: (# exit 1 #);
REFTYPE_ORIGIN: (# exit 2 #);

(* Possible values of protoType.scanSimples.simpleType. 
 * Must be disjoint from the REFTYPEs, as they're 
 * assigned to the same repetitions. *)

SIMPLETYPE_INT16: (# exit 64 #); 
SIMPLETYPE_INT32: (# exit 65 #);
SIMPLETYPE_REAL64: (# exit 66 #);

(* The following are used by the objectserializer, not by scanSimples,
 * but they are intermixed in the ObjectServer.  Therefore their valueset 
 * must be disjoint.
 *)
SIMPLETYPE_HANDLED: (# exit 67 #); (* handled by previous entry in memory *)
SIMPLETYPE_BIN32:   (# exit 68 #); (* 4 bytes binary data *)
SIMPLETYPE_INT16BIN16: (# exit 69 #);
SIMPLETYPE_BIN16INT16: (# exit 70 #);
SIMPLETYPE_INT16INT16: (# exit 71 #);

(* no need yet: SIMPLETYPE_BIN16INT16: (# exit 71 #); *)

COMProtoTypes: (# exit true #);
DISP_OFF: (# exit 24 #);

protoType:
  (* Pattern used to access various attributes of the BETA prototype located
   * at address 'address'
   *)
  (# beta: @...;
     address: @integer; (* The memory address of THIS(prototype) *)
                      
     GCtab: IntegerValue
       (* Value of the GCtab field, i.e. distance to the allocation
        * tables in THIS(Prototype), used by the garbage collector.
        *)
       (# ... #);
     OriginOff: IntegerValue
       (* Value of the OriginOff field, i.e. the offset of the Origin field
        * in having THIS(Prototype).
        *)
       (# ... #);
     GPart: IntegerValue 
       (* Address for generation entry point corresponding to THIS(Prototype)
        *)
       (# ... #);
     Size: Integervalue
       (* The size in longs of objects having THIS(prototype) *)
       (# ... #);
     Prefix: IntegerValue
       (* The prototype of the prefix *)
       (# ... #);
     LabId:
       (* exit the name of used in 'beta.dump' for the pattern corresponding 
        * to THIS(Prototype) 
        *)
       (# id: ^text;
          doIt: @...
       do doIt
       exit id[]
       #);
     GroupId:
       (* exit the name of the file, the pattern corresponding to
        * THIS(Prototype) is declared in. This is also used in 'beta.dump'.
        * This method is pretty slow as it involves a search through a
        * linked list. 
        *)
       (# id: ^text;
       do ...
       exit id[]
       #);
     scanRefs: 
       (* Scan through references in THIS(Prototype). The boolean isStatic
        * indicates whether the current reference is static or dynamic.
        * If isStatic is TRUE, thisProto contains the address of the
        * prototype of the static inlined partobject.
        * If isStatic is FALSE, refType indicates whether the dynamic reference
        * is an origin reference, a reference to an offline allocated static
        * part, or an ordinary dynamic reference. Possible values are
        * REFTYPE_DYNAMIC, REFTYPE_OFFLINE and REFTYPE_ORIGIN.
        * thisOffset tells at what offset the reference is placed in objects 
        * having THIS(prototype).
        * thisAddr is the memory address thisOffset is found in.
        *)
       (# isStatic: @boolean;
          thisOffset,thisAddr,thisProto,thisOriginOff: @integer;
          refType: @Integer;
       do ...
       #);
     scanSimples:
       (* Scan through "simple values" in THIS(Prototype). 
        * thisOffset tells at what offset the value is placed in objects 
        * having THIS(prototype).
        * simpleType holds the type of the value. Possible types are
        * SIMPLETYPE_INT32, SIMPLETYPE_INT16, SIMPLETYPE_REAL64.
        *)
       (# thisOffset, simpleType: @Integer;
       do ...
       #);
     astIndex: IntegerValue
       (* exit the astIndex corresponding to this prototype.
        * Please note, that the value returned is not immediately useful
        * for accessing the ast through MPS.  The value returned _must_
        * be multiplied with 2 (two) in order to be useful for MPS.
        * I.e. you should write something like:
        *          pt.astindex*2->ff.indexToNode
        * where pt: @prototype and ff: @fragmentForm
        *)
       (# ... #);
     formIndex: IntegerValue
       (* exit the index of the form containing the objectDescriptor
        * corresponding to this prototype. The value returned is an index
        * into the fragmentList of the group. *)
       (# ... #);
  enter address
  exit address
  #); (* Prototype *)

getProtoTypeForStruc:
  (* exit the prototype corresponding to structure## *)
  (# structure: ##object;
     protoAdr: @Integer;
  enter structure##
  ...
  exit protoAdr
  #);

getProtoType:
  (* exit the prototype for obj *)
  (# obj: ^object;
     protoAdr: @Integer;
  enter obj[]
  ...
  exit protoAdr
  #);

isComponent: BooleanValue
  (* Exits true if obj is a component. *)
  (# obj: ^Object;
  enter obj[]
  ...
  #);

objectToComponent:
  (* Exits the component part of the object entered *)
  (# comp: ^|Object;
     obj: ^Object;
  enter obj[]
  do ...
  exit comp[]
  #);

componentToObject:
  (* Exits the item part of the object entered *)
  (# comp: ^|Object;
     obj: ^Object;
  enter comp[]
  do ...
  exit obj[]
  #);

getPatternName:
  (* exit the name of the pattern obj is an instance of *)
  (# obj: ^object;
     name: ^text
  enter obj[]
  do ...;
  exit name[]
  #);

getOrigin:
  (* exit the object that is the origin of obj. The origin of a BETA object is
   * the object statically enclosing the *pattern* the object is an instance
   * of.
   *)
  (# obj: ^object;
     doIt: @...
  enter obj[]
  do doIt
  exit obj[]
  #);

getProtoField: IntegerValue
  (* exit the value of the protoType Field for obj *)
  (# obj: ^object;
  enter obj[]
  ...
  #);

putProtoField:
  (* Put 'value' into the prototype field of 'obj *)
  (# value: @integer;
     obj: ^Object;
  enter (obj[], value)
  ...
  #);

getGCField: IntegerValue
  (# obj: ^object;
  enter obj[]
  ...
  #);

addressToObject:
  (* Given a memory address, exit the BETA object at that address.
   * You must have a static instance of addressToObject when using it.
   *)
  (# addr: @integer;
     obj: ^object;
  enter addr
  ...
  exit obj[]
  #);

printObject:
  (* Print obj in textual form on the stream s. If s is NONE, Screen is used *)
  (# obj: ^object;
     s: ^stream;
  enter (obj[],s[])
  do ...
  #);

extGetCstring: external
  (* Given the address of a zero-terminated string, returns the string. *)
  (# stringAdr: @Integer;
     s: [1]@Char;
  enter stringAdr
  do 'copyInput' -> callC;
  exit s
  #);

assignRef: external
  (* Given the address of an object in objAdr, and the address of a reference
   * field in another object in fieldAdr, assignRef puts the object reference
   * into the field.
   * Use this instead of directly assigning the object address to the field
   * as this will sooner or later give GC problems. *)
  (# fieldAdr, objAdr: @Integer;
  enter (fieldAdr, objAdr)
  #);

group_header: data
  (# data_start: ^group_header;
     protoTableAdr: @Integer;
     data_end: ^group_header;
     code_start: @Integer;
     code_end: @Integer;
     groupNameAddr: @integer;
     unique_group_id_hash: @Integer;
     unique_group_id_modtime: @Integer;
     ptr: @Integer
  #);

NextGroup: external
  (* current is a pointer to a group header. NextGroup returns the
   * group after current in the executable. If current is NONE, the
   * first group is returned.
   *)
  (# current: ^group_header;
  enter current[]
  exit current[]
  #);
NameOfGroup: external
  (* Returns the groupname address of the group whose header is
   * given as parameter.
   *)
  (# group: ^group_header;
     nameAdr: @Integer;
  enter group[]
  exit nameAdr
  #);
AddGroup: external
  (* Add new_group to list of known data-segment headers 
   * in runtime system - used by e.g. NextGroup.
   *)
  (# new_group: @integer (* address of start of data segment *)
  enter new_group
  #);
IsPrototypeOfGroup: External
  (* Exits true if data_addr is the address of
   * a prototype in the fragment group corresponding
   * to gh.
   *)
  (# gh: ^group_header;
     data_addr: @integer;
     is_proto_in_group: @boolean;
  enter (gh[], data_addr)
  exit is_proto_in_group
  #);
IsPrototypeOfProcess: External
  (* Exits true if data_addr is the address of
   * a prototype in the fragment groups constituting
   * the current program.
   *)
  (# data_addr: @integer;
     is_proto_in_group: @boolean;
  enter data_addr
  exit is_proto_in_group
  #);

(* Prototype constants for special object types *)
ComponentPTValue:   (# exit -1 #);
StackObjectPTValue: (# exit -2 #);
StructurePTValue:   (# exit -3 #);
RefRepPTValue:      (# exit -4 #);
ValRepPTValue:      (# exit -5 #);
ByteRepPTValue:     (# exit -6 #);
WordRepPTValue:     (# exit -7 #);
DoubleRepPTValue:   (# exit -8 #);
DopartObjectPTValue:(# exit -9 #);
DynItemRepPTValue:  (# exit -10 #);
DynCompRepPTValue:  (# exit -11 #);

getOIDforObject:
  (* exits a unique Object Identifier, that is valid for the
   * lifetime of this program run.  The object may die, though,
   * if no references to it exist.
   * Having an OID does NOT count as a root for the Garbage Collector.
   *)
  (# obj: ^Object;
     OID: @Integer;
  enter obj[]
  ...
  exit OID
  #);

getObjectByOID:
  (* Finds the object associated with the Object Identifier.
   * Note! Having an OID does NOT count as a root for the Garbage Collector.
   *)
  (# obj: ^Object;
     OID: @Integer;
  enter OID
  ...
  exit obj[]
  #)