SetObject Preallocation
numberOfEntitySetObjects: CARDINAL = 4;
numberOfRelshipSetObjects: CARDINAL = 4;
numberOfDomainSetObjects: CARDINAL = 2;
numberOfRelationSetObjects: CARDINAL = 2;
eSetList: ARRAY [0..numberOfEntitySetObjects) OF EntitySet;
rSetList: ARRAY [0..numberOfRelshipSetObjects) OF RelshipSet;
dSetList: ARRAY [0..numberOfDomainSetObjects) OF DomainSet;
rnSetList: ARRAY [0..numberOfRelationSetObjects) OF RelationSet;
eSetFree: PACKED ARRAY [0..numberOfEntitySetObjects) OF BOOLEAN ← ALL[TRUE];
rSetFree: PACKED ARRAY [0..numberOfRelshipSetObjects) OF BOOLEAN ← ALL[TRUE];
dSetFree: PACKED ARRAY [0..numberOfDomainSetObjects) OF BOOLEAN ← ALL[TRUE];
rnSetFree: PACKED ARRAY [0..numberOfRelationSetObjects) OF BOOLEAN ← ALL[TRUE];
firstFreeESet: [0..numberOfEntitySetObjects] ← 0;
firstFreeRSet: [0..numberOfRelshipSetObjects] ← 0;
firstFreeDSet: [0..numberOfDomainSetObjects] ← 0;
firstFreeRnSet: [0..numberOfRelationSetObjects] ← 0;
QRelationSubset:
PUBLIC
PROCEDURE[
r: Relation, constraint: AttributeValueList, start: FirstLast← First, rs: RelshipSet]
RETURNS [RelshipSet] =
Relation r must be a system or dictionary relation, and constraints only on its attributes.
The full RelationSubset algorithm is described in the model level design document. Briefly,
there are 7 cases, corresponding to the legal combinations of several orthogonal choices:
(1) Is r a surrogate relation? If so, will be doing index, group, or tupleset scan on domain.
(2) Special-case r surrogate with first attribute constraint on entity in r's target domain.
(3) Is there a useful index on r? This can be true whether r is surrogate or not.
(4) Is one of the constraints entity-valued (group-scannable)? r can be surrogate or not.
(5) If all else fails, use a tupleset scan (even if r is surrogage), NextRelship will filter.
In both the surrogate and normal case, we try for an index scan before trying for a
group scan, and try for a group scan before resorting to a tupleset scan.
We handle almost all of the surrogate and normal cases with one flow of control, by
independently setting the surrogate relation field in the index, tupleset, or group scan.
Exception: if r is surrogate and (a) is the case, can use a "justOne" scan.
Note system relations are handled just as dictionary relations. In this case,
the constraint values determine what segment will be searched, as the relation and
constraint attributes give no hint! The group scan which results, however, searches
only the appropriate segment, e.g. in RelationSubset[aType, LIST[[aTypeIs, foo]]] searches
only the segment of foo.
BEGIN
surrogateR: Relation; -- NIL if not surrogate relation
targetAttr: Attribute; -- target attribute if surrogate relation
targetTupleset: DBStorage.TuplesetHandle; -- target domain if r is surrogate relation, else r
entityConstraint: AttributeValue ← [NIL, [null[]], [null[]]]; -- entity-valued constraint if group scannable
reducedList: AttributeValueList; -- remainder of constraint if group or index scannable
recVal: DBStorage.FieldHandle; -- handle to pass to storage level for group scans
groupScannable: BOOL;
indexScan: DBStorage.IndexScanHandle;
(0) Check that valid parameters
IF QNullRelation[r] THEN RETURN[NIL];
IF DBModelSchema.InvalidRelation[r] THEN ERROR Error[InvalidSchema];
IF CheckAVList[constraint]
THEN {
rs.scan ← empty; RETURN[rs] };
IF RelationEq[r, dSubType] AND constraint=NIL THEN ERROR Error[NotImplemented];
(1) Determine whether surrogate or normal relation
IF r.is1to1
THEN
there is not actually a relation, tuples are targetted to the domain ref'd by 1st attrib
BEGIN
surrogateR← r;
targetAttr← GetFirstAttribute[r]
END
ELSE
-- normal relation
surrogateR← NIL;
(2) Try for one-element scan on the target attribute if a surrogate relation
IF surrogateR#
NIL
AND constraint#
NIL
AND QAttributeEq[constraint.first.attribute, targetAttr]
THEN
BEGIN -- no search necessary, want tuple that corresponds to one entity in targetDomain
t: SurrogateRelshipHandle← SurrogateCreateRelship[r];
t.entity← V2E[constraint.first.lo];
IF constraint.rest=
NIL
OR MatchingRelship[t, constraint.rest]
THEN {
rs.scan ← justOne;
rs.hereItIs ← t }
ELSE rs.scan ← empty;
RETURN[rs]
END;
(3) Try for index scan
[indexScan, reducedList]← FindIndexedConstraint[r, constraint, start];
IF indexScan#
NIL
THEN
BEGIN
rs.serialCheck ← reducedList;
rs.scan ← index;
rs.indexScanHandle ← indexScan;
rs.surrogate ← surrogateR;
RETURN[rs];
END;
(4) Try for group scan
[entityConstraint, reducedList, groupScannable]← FindEntityConstraint[constraint];
IF groupScannable
THEN
BEGIN
recVal ← entityConstraint.attribute.fh;
rs.serialCheck ← reducedList;
rs.scan ← group;
rs.groupScanHandle ← DBStorage.OpenScanGroup[V2E[entityConstraint.lo], recVal, start];
rs.surrogate ← surrogateR;
RETURN[rs]
END
(5) Resort to scanning the whole tupleset, either the relation r or if r is surrogate then the
domain ref'd by r's 1st attrib; NextRelship will serially check constraint
ELSE
BEGIN
rs.serialCheck ← constraint;
rs.scan ← tupleSet;
IF r.is1to1
THEN targetTupleset← DataTypeToEntity[targetAttr.type, r.segment]
ELSE targetTupleset← DBModelSchema.GetRelationTuple[r];
rs.tSetScanHandle ← DBStorage.OpenScanTupleset[targetTupleset, start];
rs.surrogate ← surrogateR;
RETURN[rs]
END;
END;
FindEntityConstraint:
PROC [constraint: AttributeValueList]
RETURNS [con: AttributeValue ← [NIL, [null[]]], reducedList: AttributeValueList, found: BOOLEAN] =
Looks for an entity-valued constraint in the AttributeValueList on which a group
scan could be done (i.e., must be a linked attribute). Used by QRelationSubset above.
Must explicitly check for system attributes, which GetCachedAttributeInfo doesn't handle.
BEGIN
reducedList← NIL;
found← FALSE;
FOR conL: AttributeValueList← constraint, conL.rest
UNTIL conL =
NIL
DO
a: Attribute = conL.first.attribute;
link: LinkType; -- whether it is linked
IF a.isSystem THEN link← Linked ELSE link ← a.link;
IF IsDomainType[a.type]
AND (link=Linked
OR link=Colocated)
THEN
{con← conL.first; GOTO Found}
ELSE
reducedList← CONS[conL.first, reducedList];
REPEAT
Found =>
BEGIN
found←
TRUE;
FOR conT: AttributeValueList← conL.rest, conT.rest
UNTIL conT =
NIL
DO
reducedList← CONS[conT.first, reducedList];
ENDLOOP
END;
FINISHED => con← [NIL, [null[]]]; -- return found=FALSE and dummy values.
ENDLOOP;
RETURN
END;
FindIndexedConstraint:
PROC[r: Relation, constraint: AttributeValueList, start: FirstLast]
RETURNS [is: DBStorage.IndexScanHandle, reducedList: AttributeValueList] =
Looks for an index to search to satisfy the constraint, if any. Returns [NIL, constraint]
if none. Else returns an appropriate index scan handle for the index, and the reduced
constraint list (those constraint elements that are not indexed by the B-tree).
Tries all indexes that involve the first attribute in the constraint, returns the first one
that indexes one or more of the attributes in the constraint. Used by QRelationSubset.
BEGIN
i: Index;
ifs: LIST OF IndexFactor;
lowKey, highKey: ROPE;
IF constraint=NIL OR r.isSystem THEN RETURN[NIL, constraint];
ifs← VL2TL[QGetPList[DBModelSchema.GetAttributeTuple[constraint.first.attribute], ifAttributeOf]];
FOR ifs← ifs, ifs.rest
UNTIL ifs=
NIL
DO
i← PV2E[SafeGetP[ifs.first, ifIndexIs]];
SELECT CanUseIndex[i, constraint]
FROM
identical => {
lowKey← NCodeForTupleMatch[constraint, i, low];
highKey← NCodeForTupleMatch[constraint, i, high];
reducedList← NIL;
GO TO FoundAnIndex;
};
indexSuperset => {
lowKey← NCodeForTupleMatch[constraint, i, low];
highKey← NCodeForTupleMatch[constraint, i, high];
reducedList← NIL;
GO TO FoundAnIndex;
};
matchSuperset => {
lowKey← NCodeForTupleMatch[constraint, i, low];
highKey← NCodeForTupleMatch[constraint, i, high];
reducedList← constraint;
GO TO FoundAnIndex;
};
ENDCASE => ERROR;
REPEAT
FoundAnIndex =>
RETURN[DBStorage.OpenScanIndex[i, [lowKey, highKey, TRUE, TRUE], start], reducedList];
FINISHED =>
RETURN[NIL, constraint];
ENDLOOP;
END;
CanUseIndex:
PROCEDURE[i: Index, tm: AttributeValueList]
RETURNS[{different, identical, indexSuperset, matchSuperset}] =
Determines whether the index factors of the given index, when compared in order to the
attribute matches in the given tm, (a) differ at any point, (b) are identical and are equal in
number, (c) are identical as far as they go but the index includes additional factors not
in tm, or (d) are identical but tm includes additional matches.
Used by FindIndexedConstraint above.
BEGIN
if: IndexFactor; count: INT← 0;
ifs: LIST OF IndexFactor← VL2TL[QGetPList[i, ifIndexOf]];
FOR tmL: AttributeValueList← tm, tmL.rest
UNTIL tmL=
NIL
DO
IF ifs=NIL AND count>0 THEN RETURN[matchSuperset];
if← ifs.first; ifs← ifs.rest;
IF count#PV2I[SafeGetP[if, ifOrdinalPositionIs]] THEN ERROR InternalError;
IF NOT EntityEq[PV2E[SafeGetP[if, ifAttributeIs]], DBModelSchema.GetAttributeTuple[tmL.first.attribute]] THEN RETURN[different];
count← count+1;
ENDLOOP;
IF ifs=NIL THEN RETURN[identical]
ELSE RETURN[indexSuperset];
END;
QGetAllRefAttributes:
PUBLIC
PROCEDURE[e: Entity]
RETURNS[al:
LIST
OF Attribute] =
Find all the attributes in which some relationship references e. We do this just by
calling DBStorage.GetGroupIDs to get attributes that reference in other tuples (al3 below),
and combining the result with any surrogate relation attributes that are actually
stored as fields of e itself (al2), and any unlinked relation attributes that might reference
e (al1). We don't actually check to see if the latter reference e, because we don't want to
pay the cost of the RelationSubset; the client can check.
Note: DBModelPrivateImpl.DestroyLinksTo depends on the result of this proc to destroy
references to entities. It must therefore return unlinked attributes, and it must
find client attributes referencing dictionary (Domain, Relation, etc.) entities.
BEGIN al1, al2, al3: LIST OF Attribute ← NIL;
IF
NOT IsSystem[e]
THEN {
d: Domain ← GetCachedEntityInfo[SegmentOf[e], e].domain;
dt: TupleHandle ← DBModelSchema.GetDomainTuple[d];
al1← GetDomainUnlinkedRefAttributes[dt];
al2← GetDomainSurrogateRefAttributes[dt] };
al3 ← TL2AHL[DBStorage.GetGroupIDs[e]];
RETURN[Nconc[Nconc[al1, al2], al3]];
END;
QGetDomainRefAttributes:
PUBLIC
PROC[d: Domain]
RETURNS[al:
LIST
OF Attribute] =
Used to find all attrs reffing d or a superdomain of d.
This differs from above because it gets ALL, not just ones that ref a particular entity.
BEGIN
IF QNullDomain[d] THEN RETURN[NIL];
IF DBModelSchema.InvalidDomain[d] THEN ERROR Error[InvalidSchema];
IF d.isSystem THEN ERROR Error[NotImplemented];
al← GetDomainDirectRefAttributes[d];
FOR dl:
LIST
OF Domain← FindSuperDomains[d], dl.rest
UNTIL dl=
NIL
DO
al← Nconc[al, GetDomainDirectRefAttributes[dl.first]] ENDLOOP;
RETURN[al]
END;
FindSuperDomains:
PROC[d: Domain]
RETURNS [
LIST
OF Domain] =
returns all super-Domains of d but not d itself
{RETURN[TransitiveClosure[DBModelSchema.GetDomainTuple[d], dSubTypeIs, dSubTypeOf]]};
GetDomainDirectRefAttributes:
PROC[d: Domain]
RETURNS[al:
LIST
OF Attribute] =
Returns ALL attributes whose type is d (surrogate, linked, or unlinked), but
not ones whose type is a supertype of d.
{RETURN[VL2AHL[QGetPList[DBModelSchema.GetDomainTuple[d], aTypeOf]]]};
GetDomainSurrogateRefAttributes:
PROC[d: TupleHandle]
RETURNS[al:
LIST
OF Attribute] =
Returns attributes that appear to reference d, but are actually stored as fields of d's entities.
{RETURN[VL2AHL[QGetPList[d, aDomainOf]]]};
GetDomainUnlinkedRefAttributes:
PROC[d: TupleHandle]
RETURNS[al:
LIST
OF Attribute] =
Returns attributes that reference d, but by entity name instead of explicit (group) link.
{RETURN[VL2AHL[QGetPList[d, aUnlinkedOf]]]};
Enumeration operations
QNextEntity:
PUBLIC
PROCEDURE[es: EntitySet]
RETURNS[e: Entity] =
Find the next element from the scan ordering that also matches the es.serialMatch.
Operations depend on type of scan, see DBObjects for explanation of the
EntitySetObject variants. We can handle:
(1) tupleSet scan simply chaining through ALL entities in a domain,
(2) nested scan through currentEntitySet till exhausted, then next in remainingDomains
(3) segment scan through currentEntitySet till exhausted, then next in remainingSegments
(4) group scan finds all entities reffing some entity (used on surrogate fields)
(5) attributeSet goes through all relations, and all attributes for each
(6) system scan follows linked list through system entities
(7) empty scan always returns NIL (used for some special cases)
Invariant maintained by this procedure and PrevEntity: currentEntitySet is always valid
for nested and segment EntitySets.
BEGIN
QNextEntityRec:
PROCEDURE[es: EntitySet, esi:
CARDINAL]
RETURNS[e: Entity] = {
IF es=NIL THEN RETURN[NIL];
TRUSTED {
SELECT es.scan
FROM
tupleSet =>
e← DBStorage.NextScanTupleset[es.tSetScanHandle];
nested => {
DO
IF (e← QNextEntityRec[es.currentEntitySet, esi])#
NIL
THEN {
QReleaseEntitySet[es.currentEntitySet];
ReturnEntitySet[esi];
RETURN[e] };
IF es.remainingDomains=
NIL
THEN {
QReleaseEntitySet[es.currentEntitySet];
ReturnEntitySet[esi];
RETURN[NIL] };
QReleaseEntitySet[es.currentEntitySet]; -- all done with this, get next
ReturnEntitySet[esi];
[es.currentEntitySet, esi] ← GetNewEntitySet[];
es.currentEntitySet← QDomainSubset[
es.remainingDomains.first, es.lowName, es.highName, es.start, es.currentEntitySet, FALSE];
es.previousDomains← CONS[es.remainingDomains.first, es.previousDomains];
es.remainingDomains← es.remainingDomains.rest;
ENDLOOP };
index =>
e← DBStorage.NextScanIndex[es.indexScanHandle];
ENDCASE => ERROR InternalError;
} };
RETURN[QNextEntityRec[es, numberOfEntitySetObjects]];
QPrevEntity:
PUBLIC
PROCEDURE[es: EntitySet]
RETURNS[e: Entity] =
Similar to QNextEntity, but backs up to previous entity. Not yet implemented for all cases.
BEGIN
QPrevEntityRec:
PROCEDURE[es: EntitySet, esi:
CARDINAL]
RETURNS[e: Entity] = {
IF es=NIL THEN RETURN[NIL];
TRUSTED {
SELECT es.scan
FROM
tupleSet =>
e← DBStorage.PrevScanTupleset[es.tSetScanHandle];
nested => {
Note: on nested EntitySets, we assume we are scanning es.previousDomains.first, regardless of
whether we are doing PrevEntity or NextEntity calls. Thus, when we run out of entries in
the current entity set going backward, the next guy to scan is es.previousDomains.rest.first,
and we must move es.previousDomains.first to es.remainingDomains so that we'll get it if
we change directions again.
DO
IF (e← QPrevEntityRec[es.currentEntitySet, esi])#
NIL
THEN {
QReleaseEntitySet[es.currentEntitySet];
ReturnEntitySet[esi];
RETURN[e] };
If previousDomains is NIL, we've tried to back up past beginning and the
currentEntitySet is NIL; it signals to QNextEntity to start again with remainingDomains.
IF es.previousDomains=
NIL
THEN {
QReleaseEntitySet[es.currentEntitySet];
ReturnEntitySet[esi];
RETURN[NIL] };
QReleaseEntitySet[es.currentEntitySet];
ReturnEntitySet[esi];
All done with currentEntitySet now, move one of previousDomains to remainingDomains.
es.remainingDomains← CONS[es.previousDomains.first, es.remainingDomains];
es.previousDomains← es.previousDomains.rest;
If previousDomains is NIL now, nothing left to scan, and currentEntitySet empty.
IF es.previousDomains=
NIL
THEN {
QReleaseEntitySet[es.currentEntitySet];
ReturnEntitySet[esi];
RETURN[NIL] };
[es.currentEntitySet, esi] ← GetNewEntitySet[];
es.currentEntitySet← QDomainSubset[
es.previousDomains.first, es.lowName, es.highName, Last, es.currentEntitySet, FALSE];
ENDLOOP };
index =>
e← DBStorage.PrevScanIndex[es.indexScanHandle];
ENDCASE => ERROR InternalError;
} };
RETURN[QPrevEntityRec[es, numberOfEntitySetObjects]];
END;
QNextRelship:
PUBLIC
PROCEDURE[rs: RelshipSet]
RETURNS[t: Relship] =
Find the next element from the scan ordering (which is an index, group, or tupleset
scan, see RelationSubset) that also matches the rs.serialCheck. The latter match is
done by the following two internal routines. These two routines (MatchingRelship,
MatchingAttribute) are for internal use only, they assume their arguments are reasonable.
An index, group, or tupleset scan can be on a domain tupleset rather than relation tupleset
if the relation is a surrogate relation. In that case we use ConsSurrogate below to create
the surrogate relship corresponding to the entity the index, group, or tupelset scan returned.
BEGIN
ConsSurrogate:
PROC[r: Relation]
RETURNS [newT: SurrogateRelshipHandle] = {
IF QNullRelation[r] THEN ERROR Error[IllegalRelation];
IF DBModelSchema.InvalidRelation[r] THEN ERROR Error[InvalidSchema];
newT ← SurrogateCreateRelship[r];
newT.entity← NARROW[t];
RETURN[newT] };
IF rs=NIL THEN RETURN[NIL];
TRUSTED {
SELECT rs.scan
FROM
tupleSet =>
WHILE (t← DBStorage.NextScanTupleset[rs.tSetScanHandle])#
NIL
DO
IF rs.surrogate#NIL THEN t← ConsSurrogate[rs.surrogate];
IF MatchingRelship[t, rs.serialCheck] THEN RETURN
ENDLOOP;
group =>
WHILE (t← DBStorage.NextInGroup[rs.groupScanHandle])#
NIL
DO
IF rs.surrogate#NIL THEN t← ConsSurrogate[rs.surrogate];
IF MatchingRelship[t, rs.serialCheck]
THEN
RETURN
ENDLOOP;
index =>
WHILE (t← DBStorage.NextScanIndex[rs.indexScanHandle])#
NIL
DO
IF rs.surrogate#NIL THEN t← ConsSurrogate[rs.surrogate];
IF MatchingRelship[t, rs.serialCheck] THEN RETURN
ENDLOOP;
justOne =>
IF rs.hereItIs#
NIL
THEN
{t← rs.hereItIs; rs.hereItIs← NIL; RETURN[t]};
ENDCASE => ERROR InternalError;
};
We reach here iff there were no remaining tuples in the index or tupleset scan
which satisfied the serialMatch constraints.
RETURN[NIL];
END;
QPrevRelship:
PUBLIC
PROCEDURE[rs: RelshipSet]
RETURNS[t: Relship] =
Similar to QNextRelship, but goes backward to previous; not implemented for all cases.
BEGIN
ConsSurrogate:
PROC[r: Relation]
RETURNS [newT: SurrogateRelshipHandle] = {
IF QNullRelation[r] THEN ERROR Error[IllegalRelation];
IF DBModelSchema.InvalidRelation[r] THEN ERROR Error[InvalidSchema];
newT ← SurrogateCreateRelship[r];
newT.entity← NARROW[t];
RETURN[newT] };
IF rs=NIL THEN RETURN[NIL];
TRUSTED {
SELECT rs.scan
FROM
tupleSet =>
WHILE (t← DBStorage.PrevScanTupleset[rs.tSetScanHandle])#
NIL
DO
IF rs.surrogate#NIL THEN t← ConsSurrogate[rs.surrogate];
IF MatchingRelship[t, rs.serialCheck] THEN RETURN
ENDLOOP;
group =>
WHILE (t← DBStorage.PrevInGroup[rs.groupScanHandle])#
NIL
DO
IF rs.surrogate#NIL THEN t← ConsSurrogate[rs.surrogate];
IF MatchingRelship[t, rs.serialCheck]
THEN
RETURN
ENDLOOP;
index =>
WHILE (t← DBStorage.PrevScanIndex[rs.indexScanHandle])#
NIL
DO
IF rs.surrogate#NIL THEN t← ConsSurrogate[rs.surrogate];
IF MatchingRelship[t, rs.serialCheck] THEN RETURN
ENDLOOP;
justOne =>
ERROR Error[NotImplemented];
ENDCASE => ERROR InternalError;
};
We reach here iff there were no remaining tuples in the index or tupleset scan
which satisfied the serialMatch constraints.
RETURN[NIL];
END;
General support routines
QEntitySetToList:
PUBLIC
PROC[es: EntitySet]
RETURNS [el:
LIST
OF Entity] =
BEGIN
e: Entity← QNextEntity[es];
IF e=
NIL
THEN
{QReleaseEntitySet[es]; RETURN[NIL]}
ELSE
RETURN[CONS[e, QEntitySetToList[es]]];
END;
QRelshipSetToList:
PUBLIC
PROC[rs: RelshipSet]
RETURNS [el:
LIST
OF Relship] =
BEGIN
r: Relship← QNextRelship[rs];
IF r=
NIL
THEN
{QReleaseRelshipSet[rs]; RETURN[NIL]}
ELSE
RETURN[CONS[r, QRelshipSetToList[rs]]];
END;
CheckAVList:
PROC[avl: AttributeValueList]
RETURNS [abort:
BOOL] =
Checks to make sure types of attributes and lo/hi's match.
Returns TRUE if should abort operation
This procedure only checks for system entities right now.
TRUSTED BEGIN
FOR avlT: AttributeValueList← avl, avlT.rest
UNTIL avlT=
NIL
DO
alh: AttributeValue = avl.first;
WITH v: alh.lo
SELECT
FROM
abort if any system tuples, attributes cannot have system-tuple values
entity => IF IsSystem[v.value] THEN RETURN[TRUE];
ENDCASE;
ENDLOOP;
RETURN[FALSE]
END;
NCodeForTupleMatch:
PROCEDURE[
tm: AttributeValueList, i: Index, extreme: {high, low}] RETURNS[ROPE] =
Encodes the attribute values specified in tm (using lowValues if extreme = low,
else highValues) as required by index i. Uses appropriate extreme values for
attributes among the index factors of i but not in tm. Omits attributes in tm but
not among the index factors. A null byte is inserted between each attribute value
to preserve the lexicographic ordering of the attributes. If extreme=high then either
one or four 377C bytes are added on the end for any attributes in the index but not
given values in tm, to insure that the result will be greater or equal to any value
for these attributes in the index.
BEGIN
count: INT← 0;
s: ROPE← "";
if: IndexFactor;
ifType: DataType;
ifs: LIST OF IndexFactor← VL2TL[QGetPList[i, ifIndexOf]];
FOR tmL: AttributeValueList← tm, tmL.rest
UNTIL tmL=
NIL
DO
Find index factor for tmL.first and concatenate the corresponding value
IF ifs=
NIL
THEN
No more index factors but there are more attributes in tm: remaining attributes will
be checked by serial match, and all tm attributes are bounded by s (above or below).
RETURN[s];
if← ifs.first; ifs← ifs.rest;
IF
NOT EntityEq[PV2E[SafeGetP[if, ifAttributeIs]], DBModelSchema.GetAttributeTuple[tmL.first.attribute]]
THEN
ERROR InternalError; -- CanUseIndex only succeeds if same order as index factors
IF count#PV2I[SafeGetP[if, ifOrdinalPositionIs]] THEN ERROR InternalError;
{ v: Value ← IF extreme=low OR NullValue[tmL.first.hi] THEN tmL.first.lo ELSE tmL.first.hi;
s ← Rope.Cat[s, NCode[v], "\000"] };
count← count+1;
ENDLOOP;
IF extreme=high
THEN {
Indexed attributes are superset of match's: append extreme value for leftover index factors
FOR ifs← ifs, ifs.rest
UNTIL ifs=
NIL
DO
if← ifs.first;
ifType ← DBModelSchema.TupleToAttribute[PV2E[SafeGetP[if, ifAttributeIs]]].type;
IF ifType=IntType
OR ifType=TimeType
THEN
s← s.Concat["\377\377\377\377"]
ELSE
-- RopeType or entity name
s← s.Concat["\377"];
ENDLOOP };
RETURN[s];
END;
NullValue:
PROC[v: Value]
RETURNS[
BOOLEAN] =
TRUSTED {
WITH v
SELECT
FROM
null => RETURN[TRUE];
ENDCASE => RETURN[FALSE] };
GreaterEqString:
PROC[s1, s2:
ROPE]
RETURNS[
BOOLEAN] =
Returns TRUE iff s1 is lexically greater or equal to s2.
BEGIN RETURN[Rope.Compare[s1, s2] # less] END;
Nconc:
PROC[l1, l2:
LIST
OF Attribute]
RETURNS [
LIST
OF Attribute] =
BEGIN lp: LIST OF Attribute ← l1;
IF l1=NIL THEN RETURN[l2];
FOR lp← l1, lp.rest UNTIL lp.rest=NIL DO ENDLOOP;
lp.rest← l2;
RETURN[l1];
END;
GetNewEntitySet:
PUBLIC
PROC[]
RETURNS [es: EntitySet, esi:
CARDINAL] = {
Return a pointer to a free EntitySetObject, including the index if it comes from the preallocated array
IF firstFreeESet = numberOfEntitySetObjects
THEN {
DBStats.Inc[EntitySetObjectAllocation];
RETURN[NEW[EntitySetObject], numberOfEntitySetObjects] };
es ← eSetList[firstFreeESet];
esi ← firstFreeESet;
eSetFree[firstFreeESet] ← FALSE;
UNTIL (firstFreeESet ← firstFreeESet + 1) = numberOfEntitySetObjects
OR eSetFree[firstFreeESet]
DO
ENDLOOP;
RETURN[es, esi] };
GetNewRelshipSet:
PUBLIC
PROC[]
RETURNS [rs: RelshipSet, rsi:
CARDINAL] = {
Return a pointer to a free RelshipSetObject, including the index if it comes from the preallocated array
IF firstFreeRSet = numberOfRelshipSetObjects
THEN {
DBStats.Inc[RelshipSetObjectAllocation];
RETURN[NEW[RelshipSetObject], numberOfRelshipSetObjects] };
rs ← rSetList[firstFreeRSet];
rsi ← firstFreeRSet;
rSetFree[firstFreeRSet] ← FALSE;
UNTIL (firstFreeRSet ← firstFreeRSet + 1) = numberOfRelshipSetObjects
OR rSetFree[firstFreeRSet]
DO
ENDLOOP;
RETURN[rs, rsi] };
GetNewDomainSet:
PUBLIC
PROC[]
RETURNS [ds: DomainSet, dsi:
CARDINAL] = {
Return a pointer to a free DomainSetObject, including the index if it comes from the preallocated array
IF firstFreeDSet = numberOfDomainSetObjects
THEN {
DBStats.Inc[DomainSetObjectAllocation];
RETURN[NEW[DomainSetObject], numberOfDomainSetObjects] };
ds ← dSetList[firstFreeDSet];
dsi ← firstFreeDSet;
dSetFree[firstFreeDSet] ← FALSE;
UNTIL (firstFreeDSet ← firstFreeDSet + 1) = numberOfDomainSetObjects
OR dSetFree[firstFreeDSet]
DO
ENDLOOP;
GetNewRelationSet:
PROC[]
RETURNS [rs: RelationSet, rsi:
CARDINAL] = {
Return a pointer to a free RelationSetObject, including the index if it comes from the preallocated array
IF firstFreeRnSet = numberOfRelationSetObjects
THEN {
DBStats.Inc[RelationSetObjectAllocation];
RETURN[NEW[RelationSetObject], numberOfRelationSetObjects] };
rs ← rnSetList[firstFreeRnSet];
rsi ← firstFreeRnSet;
rnSetFree[firstFreeRnSet] ← FALSE;
UNTIL (firstFreeRnSet ← firstFreeRnSet + 1) = numberOfRelationSetObjects
OR rnSetFree[firstFreeRnSet]
DO
ENDLOOP;
ReturnEntitySet:
PUBLIC
PROC[i:
CARDINAL] = {
Release preallocated EntitySetObject with index i; if i >= numberOfEntitySetObjects then the EntitySetObject was newly allocated
IF i < numberOfEntitySetObjects
THEN {
eSetList[i].scan ← empty;
eSetFree[i] ← TRUE;
IF i < firstFreeESet THEN firstFreeESet ← i } };
ReturnRelshipSet:
PUBLIC
PROC[i:
CARDINAL] = {
Release preallocated RelshipSetObject with index i; if i >= numberOfRelshipSetObjects then the RelshipSetObject was newly allocated
IF i < numberOfRelshipSetObjects
THEN {
rs: RelshipSet ← rSetList[i];
rs.scan ← empty;
rs.surrogate ← NIL;
rSetFree[i] ← TRUE;
IF i < firstFreeRSet THEN firstFreeRSet ← i } };
ReturnDomainSet:
PUBLIC
PROC[i:
CARDINAL] = {
Release preallocated DomainSetObject with index i; if i >= numberOfDomainSetObjects then the DomainSetObject was newly allocated
IF i < numberOfDomainSetObjects
THEN {
dSetFree[i] ← TRUE;
IF i < firstFreeDSet THEN firstFreeDSet ← i } };
ReturnRelationSet:
PROC[i:
CARDINAL] = {
Release preallocated RelationSetObject with index i; if i >= numberOfRelationSetObjects then the RelationSetObject was newly allocated
IF i < numberOfRelationSetObjects
THEN {
rnSetFree[i] ← TRUE;
IF i < firstFreeRnSet THEN firstFreeRnSet ← i } };
InitializeSetObjects:
PUBLIC PROC[] = {
Preallocate set objects
i: CARDINAL;
FOR i
IN [0..numberOfEntitySetObjects)
DO
eSetList[i] ← NEW[EntitySetObject];
ENDLOOP;
FOR i
IN [0..numberOfRelshipSetObjects)
DO
rSetList[i] ← NEW[RelshipSetObject];
ENDLOOP;
FOR i
IN [0..numberOfDomainSetObjects)
DO
dSetList[i] ← NEW[DomainSetObject];
ENDLOOP;
FOR i
IN [0..numberOfRelationSetObjects)
DO
rnSetList[i] ← NEW[RelationSetObject];
ENDLOOP };
TL2AHL:
PUBLIC
PROC[tl:
LIST
OF TupleHandle]
RETURNS [
LIST
OF Attribute] = {
IF tl =
NIL
THEN
RETURN[
NIL]
ELSE RETURN[CONS[DBModelSchema.TupleToAttribute[tl.first], TL2AHL[tl.rest]]] };
VL2AHL:
PUBLIC
PROC[vl:
LIST
OF Value]
RETURNS [
LIST
OF Attribute] = {
IF vl =
NIL
THEN
RETURN[
NIL]
ELSE RETURN[CONS[DBModelSchema.TupleToAttribute[V2E[vl.first]], VL2AHL[vl.rest]]] };