Dynamic Objects

version 8/140515 by Jesse McGrew

  • Home page
  • Beginning
  • Previous
  • Next



  • Section 4 - Restoring the object's ability to relate, and possibly its relationships
    [Static various-to-various relations are stored as a rectangular bitmap, whose size is determined by the compiler based on the number of objects in the relation's domains. After cloning an object, we must resize all of the bitmaps for relations which apply to the new object.]
    Include (-
    [ DO_FixRelations src obj preserve i storage;
        do_temp_array-->0 = src;
        do_temp_array-->1 = obj;
        do_temp_array-->2 = preserve;
        IterateRelations(DO_FixEachRelation);
    ];
    [ DO_FixEachRelation rel src obj preserve i k1 k2 list storage handler valency;
        ! skip read-only relations
        if (~~(rel-->RR_PERMISSIONS & RELS_ASSERT_TRUE)) return;
        
        k1 = KindBaseTerm(rel-->RR_KIND, 0);
        k2 = KindBaseTerm(rel-->RR_KIND, 1);
        
        if (DO_RelationKindApplies(k1, obj) || DO_RelationKindApplies(k2, obj)) {
            src = do_temp_array-->0;
            obj = do_temp_array-->1;
            preserve = do_temp_array-->2;
            
            valency = RELATION_TY_GetValency(rel);
            
            if (DO_IsDynamicRelation(rel)) {
                ! dynamic relation: the relation structure is fine, just add the new object to it if preserving
                if (preserve && valency ~= RRVAL_O_TO_O or RRVAL_SYM_O_TO_O) {
                    list = LIST_OF_TY_Create(k2);
                    handler = rel-->RR_HANDLER;
                    if (valency ~= RRVAL_O_TO_V && DO_RelationKindApplies(k1, obj)) {
                        handler(rel, RELS_LOOKUP_ALL_Y, src, list);
                        for ( i=LIST_OF_TY_GetLength(list): i>0: i-- )
                            handler(rel, RELS_ASSERT_TRUE, obj, LIST_OF_TY_GetItem(list, i));
                    }
                    if (valency ~= RRVAL_V_TO_O && DO_RelationKindApplies(k2, obj)) {
                        handler(rel, RELS_LOOKUP_ALL_X, src, list);
                        for ( i=LIST_OF_TY_GetLength(list): i>0: i-- )
                            handler(rel, RELS_ASSERT_TRUE, LIST_OF_TY_GetItem(list, i), obj);
                    }
                    FlexFree(list);
                }
            } else if ((storage = rel-->RR_STORAGE) ~= 0) {
                ! static relation: we may need to resize the storage array (for V-to-V) or clear properties (for others, when not preserving)
                switch (valency) {
                    RRVAL_O_TO_V, RRVAL_V_TO_O: if (~~preserve) DO_ClearOtoX(obj, storage);
                    RRVAL_O_TO_O, RRVAL_SYM_O_TO_O: DO_ClearOtoX(obj, storage);
                    RRVAL_V_TO_V: rel-->RR_STORAGE = DO_AddVtoV(obj, storage, preserve, src, 0);
                    RRVAL_SYM_V_TO_V: rel-->RR_STORAGE = DO_AddVtoV(obj, storage, preserve, src, 1);
                    RRVAL_EQUIV: if (~~preserve) DO_ClearEquiv(obj, storage);
                }
            }
        }
    ];
    [ DO_IsDynamicRelation rel;
        ! static relations start with REL_BLOCK_HEADER (which includes the BLK_FLAG_RESIDENT bit)
        if (rel-->0 == REL_BLOCK_HEADER) rfalse;
        rtrue;
    ];
    [ DO_RelationKindApplies rk obj;
        ! relations between any kinds of objects are (as of 6E59) stored as relations of OBJECT_TY,
        ! but maybe that will change in the future
        if (rk == OBJECT_TY) rtrue;
        rfalse;
    ];
    [ DO_ClearOtoX obj prop;
        if (obj provides prop) obj.prop = nothing;
    ];
    [ DO_ClearEquiv obj prop last i;
        if (obj provides prop) {
            last = 0;
            objectloop (i provides prop)
                if (i.prop > last) last = i.prop;
            obj.prop = last + 1;
        }
    ];
    Constant VTOVS_HDR_WORDS = 8;
    [ DO_AddVtoV obj bitmap preserve src sym lp rp nbmp i m l r n oli ori;
        lp = bitmap-->VTOVS_LEFT_INDEX_PROP;
        rp = bitmap-->VTOVS_RIGHT_INDEX_PROP;
        if (obj provides lp) {
            if (obj provides rp) m = 3; ! both
            else m = 1; ! left only
        } else {
            if (obj provides rp) m = 2; ! right only
            else return bitmap;
        }
        ! calculate new domain size
        l = bitmap-->VTOVS_LEFT_DOMAIN_SIZE;
        if (m == 1 or 3) { oli = obj.lp; obj.lp = l; l++; }
        r = bitmap-->VTOVS_RIGHT_DOMAIN_SIZE;
        if (m == 2 or 3) { ori = obj.rp; obj.rp = r; r++; }
        n = l * r;
        ! allocate memory for new bitmap
        ! 1 word for static bitmap pointer + 8 word v2v header + 1 word per 16 entries in the bitmap
        nbmp = DT_Alloc((1 + VTOVS_HDR_WORDS + ((n+15)/16)) * WORDSIZE);
        if (~~nbmp) { print "*** No memory to resize V2V relation ***^"; rfalse; }
        ! point from the dynamic bitmap to the static bitmap
        if (bitmap >= Flex_Heap) nbmp-->0 = bitmap-->(-1); else nbmp-->0 = bitmap;
        ! point from the static bitmap to the dynamic bitmap
        !(nbmp-->0)-->0 = -1;
        !(nbmp-->0)-->1 = nbmp + WORDSIZE;
        ! fill in V2V header
        nbmp = nbmp + WORDSIZE;
        nbmp-->VTOVS_LEFT_INDEX_PROP = lp;
        nbmp-->VTOVS_RIGHT_INDEX_PROP = rp;
        nbmp-->VTOVS_LEFT_DOMAIN_SIZE = l;
        nbmp-->VTOVS_RIGHT_DOMAIN_SIZE = r;
        nbmp-->VTOVS_LEFT_PRINTING_ROUTINE = bitmap-->VTOVS_LEFT_PRINTING_ROUTINE;
        nbmp-->VTOVS_RIGHT_PRINTING_ROUTINE = bitmap-->VTOVS_RIGHT_PRINTING_ROUTINE;
        nbmp-->VTOVS_CACHE_BROKEN = 1;
        nbmp-->VTOVS_CACHE = 0;
        ! expand the bits
        l = bitmap-->VTOVS_LEFT_DOMAIN_SIZE;
        r = bitmap-->VTOVS_RIGHT_DOMAIN_SIZE;
        if (m == 2 or 3) {
            ! need to insert bits for a new column
            DO_InsertBits(bitmap + VTOVS_HDR_WORDS*WORDSIZE, l * r, r, nbmp + VTOVS_HDR_WORDS*WORDSIZE);
        } else {
            ! just copy
            for (i=(l*r + 15)/16: i>0: --i)
                nbmp-->(VTOVS_HDR_WORDS+i) = bitmap-->(VTOVS_HDR_WORDS+i);
        }
        ! preserve relations if needed
        if (preserve) {
            if (m == 1 or 3)
                objectloop (i provides rp)
                    if (DO_Relation_TestVtoV_Raw(src, bitmap, i, sym))
                        DO_Relation_NowVtoV_Raw(obj, nbmp, i, sym);
            if ((~~sym) && m == 2 or 3)
                objectloop (i provides lp)
                    if (DO_Relation_TestVtoV_Raw(i, bitmap, src, sym))
                        DO_Relation_NowVtoV_Raw(i, nbmp, obj, sym);
        }
        ! deallocate old bitmap if necessary
        if (bitmap >= Flex_Heap) DT_Free(bitmap - WORDSIZE);
        return nbmp;
    ];
    ! expands 'nbits' bits from src to dest, inserting a zero bit every
    ! 'interval' bits and using only the lower 16 bits of each word.
    ! the number of words used for dest is (nbits+(nbits/interval)+15)/16.
    [ DO_InsertBits src nbits interval dest sw sb dw db i si f;
        sw = 0; sb = 1; dw = 0; db = 1;
        nbits = nbits + (nbits / interval);
        f = 0; si = 0;
        for (i=0: i<nbits: i++) {
            if (db == 1) dest-->dw = 0;
            if (f) {
                f = 0;
            } else {
                if (src-->sw & sb) dest-->dw = dest-->dw | db;
                sb = sb * 2;
                if (sb == $10000) { sw++; sb = 1; }
                si++;
                if (si == interval) { f = 1; si = 0; }
            }
            db = db * 2;
            if (db == $10000) { dw++; db = 1; }
        }
    ];
    ! "raw" versions of a couple functions from Relations.i6t, to operate directly on the V2V bitmap
    [ DO_Relation_NowVtoV_Raw obj1 vtov_structure obj2 sym pr pr2 i1 i2;
        if (sym && (obj2 ~= obj1)) { DO_Relation_NowVtoV_Raw(obj2, vtov_structure, obj1, false); }
        pr = vtov_structure-->VTOVS_LEFT_INDEX_PROP;
        pr2 = vtov_structure-->VTOVS_RIGHT_INDEX_PROP;
        vtov_structure-->VTOVS_CACHE_BROKEN = true; ! Mark any cache as broken
        if (pr) {
            ! if ((obj1 ofclass Object) && (obj1 provides pr)) i1 = obj1.pr;
            ! else return RunTimeProblem(RTP_IMPREL, obj1, relation);
            i1 = obj1.pr;
        } else i1 = obj1-1;
        if (pr2) {
            ! if ((obj2 ofclass Object) && (obj2 provides pr2)) i2 = obj2.pr2;
            ! else return RunTimeProblem(RTP_IMPREL, obj2, relation);
            i2 = obj2.pr2;
        } else i2 = obj2-1;
        pr = i1*(vtov_structure-->VTOVS_RIGHT_DOMAIN_SIZE) + i2;
        i1 = IncreasingPowersOfTwo_TB-->(pr%16);
        pr = pr/16 + 8;
        vtov_structure-->pr = (vtov_structure-->pr) | i1;
    ];
    [ DO_Relation_TestVtoV_Raw obj1 vtov_structure obj2 sym pr pr2 i1 i2;
        pr = vtov_structure-->VTOVS_LEFT_INDEX_PROP;
        pr2 = vtov_structure-->VTOVS_RIGHT_INDEX_PROP;
        if (sym && (obj2 > obj1)) { sym = obj1; obj1 = obj2; obj2 = sym; }
        if (pr) {
            ! if ((obj1 ofclass Object) && (obj1 provides pr)) i1 = obj1.pr;
            ! else { RunTimeProblem(RTP_IMPREL, obj1, relation); rfalse; }
            i1 = obj1.pr;
        } else i1 = obj1-1;
        if (pr2) {
            ! if ((obj2 ofclass Object) && (obj2 provides pr2)) i2 = obj2.pr2;
            ! else { RunTimeProblem(RTP_IMPREL, obj2, relation); rfalse; }
            i2 = obj2.pr2;
        } else i2 = obj2-1;
        pr = i1*(vtov_structure-->VTOVS_RIGHT_DOMAIN_SIZE) + i2;
        i1 = IncreasingPowersOfTwo_TB-->(pr%16);
        pr = pr/16 + 8;
        if ((vtov_structure-->pr) & i1) rtrue; rfalse;
    ];
    -).
    [Previous versions of this extension had to patch the template routines that handle various-to-various relations, since I7's generated code called them with hardcoded addresses of the relation storage structures. As of 6E59, however, we can simply change the value in relation-->RR_STORAGE.]