Checking procedures
CheckEntity:
PUBLIC
PROC [t: TupleHandle] =
signals IllegalEntity if test fails.
{[]← QDomainOf[t]};
CheckRelship:
PUBLIC
PROC [t: TupleHandle] =
signals IllegalRelship if test fails.
{[]← QRelationOf[t]};
CheckDomain:
PUBLIC
PROC [d: Domain] =
{IF NOT QDomainOf[d] = DomainDomain THEN ERROR Error[IllegalDomain]};
CheckRelation:
PUBLIC
PROC [r: Relation] =
{IF NOT QDomainOf[r] = RelationDomain THEN ERROR Error[IllegalRelation]};
CheckAttribute:
PUBLIC
PROC [a: Attribute] =
{IF NOT QDomainOf[a] = AttributeDomain THEN ERROR Error[IllegalAttribute]};
IsDomainType:
PUBLIC
PROC [vt: DataType]
RETURNS [
BOOL] =
BEGIN
WITH vt^
SELECT
FROM
vt1: TupleObject[tupleSet] => RETURN[vt.tid>=DomainTSID AND vt.tid<=IndexFactorTSID];
vt1: TupleObject[entity] => RETURN[vt = AnyDomainType];
vt1: TupleObject[stored] => RETURN[Eq[GetCachedTupleTS[vt], DomainDomain]];
ENDCASE => RETURN[FALSE]
END;
IsKeyAttribute:
PUBLIC
PROC [a: Attribute]
RETURNS [
BOOL] =
{u: Uniqueness← V2U[SafeGetP[a, aUniquenessIs]]; RETURN[u=Key OR u=OptionalKey]};
CompatibleType:
PUBLIC
PROC [v: Value, t: DataType, fh: DBStorage.FieldHandle←
NIL]
RETURNS [
BOOL] =
Returns TRUE if v can be fetched or stored in an attribute of type t.
Takes the optional argument fh only so we can special-case the exception
of aTypeIs which claims to be IntType but returns an entity.
NOTE: GetAttributeInfo also performs the same check in its discrimination,
so this routine need only be called when GetAttributeInfo is not used.
BEGIN
WITH v
SELECT
FROM
v1: ROPE => RETURN[t=RopeType];
v1: REF INT => RETURN[t=IntType];
v1: REF BOOL => RETURN[t=BoolType];
v1: REF GMT => RETURN[t=TimeType];
v1: Entity =>
BEGIN d: Domain← QDomainOf[v1]; -- signals if v is a relship
IF t=IntType THEN RETURN[d=DomainDomain AND fh=T2SAT[aTypeCodeProp].vHandle];
IF t=RopeType OR t=RecordType OR t=BoolType OR t=TimeType THEN RETURN[FALSE];
CheckDomain[t];
RETURN[CompatibleDomain[d, t]]
END;
ENDCASE =>
IF t=RecordType THEN RETURN[TRUE] ELSE ERROR Error[IllegalValue];
END;
CompatibleDomain:
PUBLIC
PROC [sub, super: Domain]
RETURNS [
BOOL] =
Returns TRUE iff sub=super or sub is related through transitive closure of
SubType relations to super. Should work with system sub or super.
BEGIN
thisSuper: Domain;
subsSupers: RelshipSet;
IF Eq[super, AnyDomainType] OR Eq[sub, super] THEN RETURN[TRUE];
IF IsSystem[sub]
THEN
-- system domains have no supers except Domain matches DataType
RETURN[sub=DomainDomain AND super=DataTypeDomain];
subsSupers← QRelationSubset[dSubType, LIST[[dSubTypeIs, sub]] ];
UNTIL Null[thisSuper← QNextRelship[subsSupers]]
DO
IF CompatibleDomain[V2E[QGetF[thisSuper, dSubTypeOf]], super]
THEN
{QReleaseRelshipSet[subsSupers]; RETURN [TRUE]};
ENDLOOP;
QReleaseRelshipSet[subsSupers];
RETURN [FALSE]
END;
String manipulation
ConvertToUpper:
PUBLIC
PROC[s:
ROPE]
RETURNS [
ROPE] =
BEGIN pos: INT← -1;
upperProc:
SAFE
PROC
RETURNS [
CHAR] =
CHECKED
{RETURN[Ascii.Upper[s.Fetch[pos← pos+1]]]};
RETURN[Rope.FromProc[s.Length[], upperProc]]
END;
StringToValue:
PUBLIC
PROC[s:
ROPE, a: Attribute]
RETURNS[Value] =
Converts a string to a value of the type required by a, doing the appropriate
string conversion or a Fetch if type is a Domain.
BEGIN pos: INT;
vt: DataType← V2E[QGetP[a, aTypeIs]];
SELECT vt
FROM
IntType =>
IF s.Length[]=0 THEN RETURN[I2V[0]] ELSE RETURN[I2V[RopeToInt[s]]];
TimeType =>
IF s.Length[]=0 THEN RETURN[T2V[LOOPHOLE[LONG[0]]]]
ELSE RETURN[T2V[RopeToTime[s]]];
BoolType =>
IF s.Equal["TRUE"] THEN RETURN[B2V[TRUE]]
ELSE IF s.Equal["FALSE"] THEN RETURN[B2V[FALSE]]
ELSE ERROR Error[MismatchedAttributeValueType];
AnyDomainType =>
Must search every domain in the system unless s contains domain name or is empty
IF s.Length[]=0 THEN RETURN[NIL]
ELSE
IF (pos← s.Find[":"])#-1
THEN
BEGIN -- treat s as name of an entity in vt
vt← QDeclareDomain[s.Substr[0, pos], QSegmentOf[a], OldOnly];
IF vt=NIL THEN ERROR Error[NotFound];
RETURN[QFetchEntity[vt, s.Substr[pos+2], QSegmentOf[a]]];
END
ELSE
-- no "domain: value" specified
BEGIN ds: EntitySet← QDomainSubset[DomainDomain];
d: Domain; e: Entity;
UNTIL Null[d← QNextEntity[ds]]
DO
e← QDeclareEntity[d, s, OldOnly ];
IF e#NIL THEN RETURN[e];
ENDLOOP;
we reach here if NO domain contained an entity named e.
ERROR Error[NotFound];
END;
ENDCASE =>
BEGIN e: Entity; -- treat s as name of an entity in vt
CheckDomain[vt];
IF s.Length[]=0 THEN RETURN[NIL];
IF (e← QDeclareEntity[vt, s, OldOnly])=NIL THEN ERROR Error[NotFound];
RETURN[e];
END;
END;
ParseSegmentName:
PUBLIC
PROC[path:
ROPE]
RETURNS [name, ext, server:
ROPE] =
BEGIN
file: ROPE;
pos: INT;
First split path into server and file name, and that path contains directory
IF path.Fetch[0]='[
THEN
IF (pos← path.Find["]"])=-1 THEN ERROR Error[IllegalFileName]
ELSE {server← path.Substr[1, pos-1]; file← path.Substr[pos+1]}
ELSE
{file← path; server← "Juniper"}; -- default to Juniper
IF file.Fetch[0]#'<
AND
NOT server.Equal["Local",
FALSE]
THEN
ERROR Error[IllegalFileName]; -- missing directory on Juniper
Now split file into name and ext
IF (pos← file.Find["."])=-1 THEN {name← file; ext← NIL}
ELSE {name← file.Substr[0, pos]; ext← file.Substr[pos+1]};
END;
NCode:
PUBLIC
PROC[v: Value]
RETURNS[
ROPE] =
TRUSTED
Encodes value v as an index key. All routines constructing index
keys or doing key comparisons should call this routine.
BEGIN
IF v=NIL THEN RETURN[NIL]; -- pass NILs right through for now
WITH v
SELECT
FROM
v1:
ROPE =>
BEGIN CheckForNulls[v1]; RETURN[ConvertToUpper[v1]] END;
v1:
REF
INT =>
BEGIN i: LONG CARDINAL← LOOPHOLE[v1^, LONG CARDINAL]+20000000000B;
s: STRING← [4]; s.length← 4;
s[0]← HighByte[Basics.HighHalf[i]];
s[1]← LowByte[Basics.HighHalf[i]];
s[2]← HighByte[Basics.LowHalf[i]]; s[3]← LowByte[Basics.LowHalf[i]];
RETURN[ConvertUnsafe.ToRope[s]]
END;
v1:
REF
GMT =>
-- same as above but don't turn off top bit
BEGIN i: LONG CARDINAL← BasicTime.ToPupTime[v1^];
s: STRING← [4]; s.length← 4;
s[0]← HighByte[Basics.HighHalf[i]]; s[1]← LowByte[Basics.HighHalf[i]];
s[2]← HighByte[Basics.LowHalf[i]]; s[3]← LowByte[Basics.LowHalf[i]];
RETURN[ConvertUnsafe.ToRope[s]]
END;
v1: Entity =>
-- we index entity-valued attributes by the entity name
RETURN[ConvertToUpper[QNameOf[v1]]];
v1:
REF
BOOL =>
IF v1^ THEN RETURN["TRUE"] ELSE RETURN["FALSE"];
ENDCASE => ERROR Error[NotImplemented]; -- for now
END;
NCodeForTuple:
PROC[t: Relship, i: Index]
RETURNS [
ROPE] =
Encodes the attributes of t required as factors of index i as ropes, concatenates
the ropes in the order required by the index, and returns the result (for use in
using DBStorage indices, which require a single rope key). A null byte is placed
between the encoded attribute ropes to preserve the lexicographic priorities of
the attributes. Note this means null chars may not appear in attributes of type string
if proper orderings are to result.
BEGIN
s: ROPE← "";
FOR ifs:
LIST
OF IndexFactor← VL2EL[QGetPList[i, ifIndexOf]], ifs.rest
UNTIL ifs=
NIL
DO
if: IndexFactor← ifs.first;
s← Rope.Cat[s, NCode[QGetF[t, V2E[QGetP[if, ifAttributeIs]]]], "\000"];
ENDLOOP;
RETURN[s];
END;
MakeNullValueOfType:
PUBLIC
PROC [vt: DataType]
RETURNS[Value] =
BEGIN
SELECT vt
FROM
RopeType => {gdfc: ROPE← ""; RETURN[gdfc]};
IntType => RETURN[NEW[INT← 0]];
TimeType => RETURN[NEW[GMT← [BasicTime.nullGMT]]];
BoolType => RETURN[NEW[BOOL← FALSE]];
ENDCASE => RETURN[NIL];
END;
RopeToInt:
PROC[s:
ROPE]
RETURNS [i:
INT] =
BEGIN ENABLE IO.Error => ERROR Error[MismatchedAttributeValueType];
i← IO.GetInt[IO.RIS[s]];
END;
RopeToTime:
PROC[s:
ROPE]
RETURNS [gmt:
GMT] =
BEGIN
gmt.time← IO.GetTime[IO.RIS[s] ! IO.Error => ERROR Error[MismatchedAttributeValueType]];
END;
Caching procedures and variables
numberOfCachedAttributes: CARDINAL = 60; --size of cache
lastAttributeIndex: CARDINAL← 0; --points to most recently created entry in cache
lastAttributes: REF AttributeArray← NEW[AttributeArray];
AttributeArray:
TYPE =
ARRAY [0..numberOfCachedAttributes)
OF
RECORD [
tid: LONG CARDINAL← 0,
relation: Relation,
type: DataType,
uniqueness: Uniqueness,
handle: DBStorage.FieldHandle,
link: LinkType,
indexFactors: LIST OF IndexFactor ];
GetCachedAttributeInfo:
PUBLIC
PROC[x: Attribute]
RETURNS[
relation: Relation, type: DataType, handle: DBStorage.FieldHandle,
uniqueness: Uniqueness, link: LinkType, indexFactors: LIST OF IndexFactor] =
Looks for x in attribute cache lastAttributes; returns its info if found, else enter it and
then returns its info. Should not be used for system attributes.
BEGIN i: CARDINAL;
DBStats.Inc[GetAttributeInfo];
FOR i
IN [0..numberOfCachedAttributes)
DO
IF lastAttributes[i].tid=x.tid
THEN
RETURN[
lastAttributes[i].relation, lastAttributes[i].type, lastAttributes[i].handle,
lastAttributes[i].uniqueness, lastAttributes[i].link, lastAttributes[i].indexFactors]
ENDLOOP;
DBStats.Inc[GetAttributeInfoMiss];
IF IsSystem[x] THEN ERROR InternalError;
i← lastAttributeIndex← (lastAttributeIndex +1) MOD numberOfCachedAttributes;
Free last entry if it was in use (saved pos in local i, because the following can be recursive)
IF lastAttributes[i].tid#0 THEN lastAttributes[i].tid ← 0;
Compute and make a new entry in lastAttributes array
relation← V2E[SafeGetP[x, aRelationIs]];
handle← V2Rec[SafeGetP[x, aHandleProp]];
uniqueness← V2U[SafeGetP[x, aUniquenessIs]];
[type, link]← GetTypeAndLink[x];
indexFactors← VL2EL[QGetPList[x, ifAttributeOf]];
lastAttributes[i]← [x.tid, relation, type, uniqueness, handle, link, indexFactors];
END;
numberOfCachedRelations: CARDINAL = 16; -- size of cache
lastRelationIndex: CARDINAL← 0; -- points to most recently created entry in cache
lastRelations: REF RelationArray← NEW[RelationArray];
RelationArray:
TYPE =
ARRAY [0..numberOfCachedRelations)
OF
RECORD [
tid: LONG CARDINAL← 0,
first, second: Attribute,
indexes: LIST OF Index ];
GetCachedRelationInfo:
PUBLIC
PROC [
x: Relation] RETURNS [first, second: Attribute, indexes: LIST OF Index] =
We keep a cache of info about relations. Only call this for STORED relations.
BEGIN i: CARDINAL; attSet: RelshipSet; t: Relship;
DBStats.Inc[GetRelationInfo];
FOR i
IN [0..numberOfCachedRelations)
DO
IF lastRelations[i].tid=x.tid
THEN
RETURN[
lastRelations[i].first, lastRelations[i].second, lastRelations[i].indexes ] ENDLOOP;
DBStats.Inc[GetRelationInfoMiss];
IF IsSystem[x] THEN ERROR InternalError;
i← lastRelationIndex← (lastRelationIndex +1) MOD numberOfCachedRelations;
Saved pos in local i, because the following can be recursive
Make new entry
attSet← QRelationSubset[aRelation, LIST[[aRelationIs, x]]];
IF (t← QNextRelship[attSet])#NIL THEN first← V2E[QGetF[t, aRelationOf]];
IF (t← QNextRelship[attSet])#NIL THEN second← V2E[QGetF[t, aRelationOf]];
QReleaseRelshipSet[attSet];
indexes← GetRelationIndices[x];
lastRelations[i]← [
tid: x.tid,
first: first,
second: second,
indexes: indexes];
END;
GetRelationIndices:
PROC [r: Relation]
RETURNS [
LIST
OF Index] =
Only called by proc above; don't call this directly, use the cached information.
Returns the list of indices on r. Must first find attributes of r, then find any index
factors involving those attributes, then find the indices to which the index factors belong,
removing duplicates (indices with more than one index factor will appear more than once).
BEGIN il: LIST OF Index← NIL;
FOR al:
LIST
OF Attribute← VL2EL[QGetPList[r, aRelationOf]], al.rest
UNTIL al=
NIL
DO
ifl: LIST OF IndexFactor← VL2EL[QGetPList[al.first, ifAttributeOf]];
FOR iflT:
LIST
OF IndexFactor← ifl, ifl.rest
UNTIL iflT=
NIL
DO
IF iflT.first#NIL THEN il← AppendIfNew[V2E[QGetP[iflT.first, ifIndexIs]], il];
ENDLOOP;
ENDLOOP;
RETURN[il]
END;
numberOfCachedDomains: CARDINAL = 8; -- size of cache
lastDomainIndex: CARDINAL← 0; -- points to most recently created entry in cache
lastDomains: REF DomainArray← NEW[DomainArray];
DomainArray:
TYPE =
ARRAY [0..numberOfCachedDomains)
OF
RECORD [
tid: LONG CARDINAL← 0,
surrogates, indexedSurrogates: LIST OF Relation,
nameIndex: Index,
subDomains: LIST OF Domain ];
GetCachedDomainInfo:
PUBLIC
PROC [x: Domain]
RETURNS [
surrogates, indexedSurrogates: LIST OF Relation,
nameIndex: Index, subDomains: LIST OF Domain] =
We keep a cache of info about Domains. Only call this for STORED Domains.
The indexedAttributes are attributes of relations that both (1) participate in an index
and (2) are surrogate attributes actually stored as fake attributes of entities in this domain.
The nameIndex is the index on entity names for this domain, and the subDomains are
needed to make DomainSubset go fast.
BEGIN i: CARDINAL;
DBStats.Inc[GetDomainInfo];
FOR i
IN [0..numberOfCachedDomains)
DO
IF lastDomains[i].tid=x.tid
THEN
RETURN[
lastDomains[i].surrogates, lastDomains[i].indexedSurrogates,
lastDomains[i].nameIndex, lastDomains[i].subDomains ] ENDLOOP;
DBStats.Inc[GetDomainInfoMiss];
IF IsSystem[x] THEN ERROR InternalError;
i← lastDomainIndex← (lastDomainIndex +1) MOD numberOfCachedDomains;
Save pos in local i, because the following can cause recursive calls to ourselves.
[surrogates, indexedSurrogates]← GetIndexedSurrogates[x];
nameIndex← V2E[SafeGetP[x, dIndexProp]];
subDomains← FindSubDomains[x];
lastDomains[i]← [
tid: x.tid,
surrogates: surrogates,
indexedSurrogates: indexedSurrogates,
nameIndex: nameIndex,
subDomains: subDomains];
END;
GetIndexedSurrogates:
PROC [d: Domain]
RETURNS [surrogates, indexedSurrogates: LIST OF Relation] =
Only called by GetCachedDomainInfo; don't call this directly, use the cached information.
Finds relations whose first attribute references d that both (1) participate in an index
and (2) are actually surrogate relations whose attributes are stored in entities in domain d.
BEGIN
surrogates← GetSurrogates[d];
indexedSurrogates← NIL;
FOR surrogatesT:
LIST
OF Relation← surrogates, surrogatesT.rest
UNTIL surrogatesT=
NIL
DO
surrAttrs: LIST OF Attribute ← VL2EL[QGetPList[surrogatesT.first, aRelationOf]];
FOR surrAttrs← surrAttrs, surrAttrs.rest
UNTIL surrAttrs=
NIL
DO
IF SafeGetP[surrAttrs.first, ifAttributeOf]#NIL THEN GOTO ThisRelation;
ENDLOOP;
REPEAT
ThisRelation=> indexedSurrogates← CONS[surrogatesT.first, indexedSurrogates];
ENDLOOP;
END;
GetSurrogates:
PROC [d: Domain]
RETURNS [
LIST
OF Relation] =
Returns the list of surrogate relations that have been targetted to domain d.
Only called by proc above; don't call this directly, use the cached information.
First we find the attributes that have been targetted to domain d using a group scan on
aDomainOf, then we find their relations, eliminating duplicates.
BEGIN rl: LIST OF Relation← NIL;
FOR al:
LIST
OF Attribute← VL2EL[QGetPList[d, aDomainOf]], al.rest
UNTIL al=
NIL
DO
r: Relation← V2E[QGetP[al.first, aRelationIs]];
rl← AppendIfNew[r, rl];
ENDLOOP;
RETURN[rl]
END;
numberOfCachedTuples: CARDINAL = 128; -- size of cache
lastTupleIndex: CARDINAL← 0; -- points to most recently created entry in cache
lastTuples: REF TupleArray← NEW[TupleArray];
TupleArray:
TYPE =
ARRAY [0..numberOfCachedTuples)
OF
RECORD [
tid: LONG CARDINAL← 0,
tupleSet: TupleSet ];
GetCachedTupleTS:
PUBLIC
PROC [
x: TupleHandle -- STORED Entity or Relship --] RETURNS [ts: TupleSet] =
We keep a cache of the last tuple's tupleset. Only call this for STORED tuples.
BEGIN i: CARDINAL;
DBStats.Inc[GetTupleInfo];
FOR i
IN [0..numberOfCachedTuples)
DO
IF lastTuples[i].tid=x.tid THEN RETURN[lastTuples[i].tupleSet] ENDLOOP;
DBStats.Inc[GetTupleInfoMiss];
i← lastTupleIndex← (lastTupleIndex +1) MOD numberOfCachedTuples;
Make new entry
lastTuples[i]← [
tid: x.tid,
tupleSet: ts← DBStorage.ReadTupleset[x] ];
END;
FlushCaches:
PUBLIC
PROC[] =
BEGIN
FOR i:
CARDINAL
IN [0..numberOfCachedAttributes)
DO
For attributes, must free handle if there is one
IF lastAttributes[i].tid#0 THEN lastAttributes[i].tid ← 0; ENDLOOP;
lastAttributeIndex ← 0;
FOR i:
CARDINAL
IN [0..numberOfCachedRelations)
DO
lastRelations[i].tid ← 0; ENDLOOP;
lastRelationIndex ← 0;
FOR i:
CARDINAL
IN [0..numberOfCachedDomains)
DO
lastDomains[i].tid ← 0; ENDLOOP;
lastDomainIndex ← 0;
FlushTSCache[];
END;
FlushTSCache:
PUBLIC
PROC =
BEGIN
FOR i:
CARDINAL
IN [0..numberOfCachedTuples)
DO
lastTuples[i].tid ← 0; ENDLOOP;
lastTupleIndex ← 0;
END;
Index-related procedures
GetNameIndex:
PUBLIC
PROC [d: Domain]
RETURNS [Index] =
Returns the name index for domain d.
{RETURN[GetCachedDomainInfo[d].nameIndex]};
GetDomainIndex:
PUBLIC
PROC[s: Segment]
RETURNS [Index] =
Returns the domain index for the segment
{RETURN[DBStorage.RootIndicesFromSegment[s].index1]};
GetRelationIndex:
PUBLIC
PROC[s: Segment]
RETURNS [Index] =
Returns the relation index for the segment
{RETURN[DBStorage.RootIndicesFromSegment[s].index2]};
CreateEntityIndexEntries:
PUBLIC
PROC [e: Entity] =
Finds the name index for e's Domain and insert e into it.
Also creates index entries for any surrogate relations that are actually stored in e.
BEGIN
d: Domain← QDomainOf[e];
nameIndex: Index← GetNameIndex[d];
surrRelns: LIST OF Relation← GetCachedDomainInfo[d].indexedSurrogates;
DBStorage.InsertIntoIndex[nameIndex, NCode[QNameOf[e]], e];
FOR surrRelns← surrRelns, surrRelns.rest
UNTIL surrRelns=
NIL
DO
r: Relation← surrRelns.first;
fakeSurrogateRelship: Relship← SurrogateCreateRelship[r];
T2SST[fakeSurrogateRelship].vEntity← e;
CreateAllIndexEntries[fakeSurrogateRelship];
ENDLOOP;
END;
DestroyEntityIndexEntries:
PUBLIC
PROC [e: Entity] =
Find the name index for e's Domain and remove e from it. Does NOT destroy
any surrogate relation index entries; that can be done by DestroyLinksTo.
BEGIN
d: Domain← QDomainOf[e];
nameIndex: Index← GetNameIndex[d];
IF nameIndex#
NIL
THEN
Non-NIL unless we are destroying this entity in the process of destroying domain
DBStorage.DeleteFromIndex[nameIndex, NCode[QNameOf[e]], e];
END;
DestroyIndexEntries:
PUBLIC
PROC [t: Relship, changed: Attribute] =
Deletes any index entries involving changed attribute of t. For each index on the
relation with an index factor involving the changed attribute, delete the entry in
the index. Works for both surrogate relations and ordinary ones; in the surrogate case,
we index under the real underlying tuple handle, which is actually the entity.
BEGIN i: Index; th: DBStorage.TupleHandle← GetTupleHandle[t];
ifs: LIST OF IndexFactor;
FOR ifs← GetCachedAttributeInfo[changed].indexFactors, ifs.rest
UNTIL ifs=
NIL
DO
For each index factor involving changed, delete the index entry.
i← V2E[SafeGetP[ifs.first, ifIndexIs]]; -- index for this index factor
DBStorage.DeleteFromIndex[i, NCodeForTuple[t, i], th];
ENDLOOP;
END;
DestroyAllIndexEntries:
PUBLIC
PROC [t: Relship] =
Find all relevant indexes for t and delete t from them. To do this, find the attributes of
t's relation, find index factors involving those attributes, find indices for those index factors,
and destroy index entries for them. The relationship t may be an ordinary or surrogate
relationship; GetTupleHandle below returns the entity handle in the latter case, the
relationship handle in the former case, so the right thing happens.
BEGIN i: Index; th: DBStorage.TupleHandle← GetTupleHandle[t];
FOR il:
LIST
OF Index← GetCachedRelationInfo[QRelationOf[t]].indexes, il.rest
UNTIL il=
NIL
DO
i← il.first;
DBStorage.DeleteFromIndex[i, NCodeForTuple[t, i], th];
ENDLOOP;
END;
CreateIndexEntries:
PUBLIC
PROC [t: Relship, changed: Attribute] =
(Re-)creates any index entries involving changed attribute of t. For each index on
the tupleset with an index factor involving the changed attribute, re-enter the
tuple in the index. Use DestroyIndexEntries above to destroy any old entry.
BEGIN i: Index; th: DBStorage.TupleHandle← GetTupleHandle[t];
ifs: LIST OF IndexFactor;
FOR ifs← GetCachedAttributeInfo[changed].indexFactors, ifs.rest
UNTIL ifs=
NIL
DO
For each index factor involving changed, delete the index entry.
i← V2E[SafeGetP[ifs.first, ifIndexIs]]; -- index for this index factor
DBStorage.InsertIntoIndex[i, NCodeForTuple[t, i], th];
ENDLOOP;
END;
CreateAllIndexEntries:
PUBLIC
PROC [t: Relship] =
Find all existing indexes for t's tupleset and insert t into them.
BEGIN i: Index; th: DBStorage.TupleHandle← GetTupleHandle[t];
FOR il:
LIST
OF Index← GetCachedRelationInfo[QRelationOf[t]].indexes, il.rest
UNTIL il=
NIL
DO
i← il.first;
DBStorage.InsertIntoIndex[i, NCodeForTuple[t, i], th];
ENDLOOP;
END;
DestroyVariableFieldsOf:
PUBLIC
PROC[t: Relship] =
NIL out variable-length string attributes so that DBStorage deletes "string tuples" associated
with t for strings that overflow the length specified for the attribute. Does NOT create
or destroy any index entries associated with the attribute, the caller must do that.
BEGIN
r: Relation← QRelationOf[t];
FOR al:
LIST
OF Attribute← VL2EL[QGetPList[r, aRelationOf]], al.rest
UNTIL al=
NIL
DO
a: Attribute← al.first;
IF V2E[QGetP[a, aTypeIs]]=RopeType THEN QSetF[t, a, NIL, FALSE] ENDLOOP;
END;
DestroyLinksTo:
PUBLIC
PROC[e: Entity] =
Destroys any references to e by following backlinks (groups) to the tuples whose
fields point to t, and destroying those tuples. Also destroys tuples that do NOT
reference e via a group (i.e., with aUnlinkedIs TRUE); we get these because
QGetAllRefAttributes returns unlinked attributes as well.
Note: DBModelGlobalImpl.DestroyDictionaryEntity depends upon this procedure
working for dictionary entities as well as ordinary client entities.
BEGIN
al: AttributeList; rs: RelshipSet;
r: Relship;
al← QGetAllRefAttributes[e];
FOR alT: AttributeList← al, alT.rest
UNTIL alT=
NIL
DO
rs← QRelationSubset[V2E[SafeGetP[alT.first, aRelationIs]], LIST[[alT.first, e]] ];
WHILE (r← QNextRelship[rs])#
NIL
DO
QDestroyRelship[r] ENDLOOP;
QReleaseRelshipSet[rs];
ENDLOOP;
END;
DestroyLinksFrom:
PUBLIC
PROC[t: Relship] =
Destroys backlinks to t (in groups) by storing NIL in those attributes (a) of t
that point to entities (the Storage level removes the corresponding backlinks).
BEGIN
reln: Relation← QRelationOf[t]; -- r's Relation
typeOfA: DataType; -- a's type (a domain entity or simple valuetype entity)
FOR al:
LIST
OF Attribute← VL2EL[QGetPList[reln, aRelationOf]], al.rest
UNTIL al=
NIL
DO
a: Attribute← al.first;
typeOfA ← V2E[QGetP[a, aTypeIs]];
IF typeOfA=AnyDomainType
OR QDomainOf[typeOfA] = DomainDomain
THEN
This NILs out field whether it was link field or string field (want to either way).
We disable update of index entries for efficiency, we'll destroy them later.
QSetF[t, a, NIL, FALSE ! InternalError => TRUSTED {IF desperate THEN CONTINUE}];
ENDLOOP;
END;
TranslateToSegment:
PUBLIC
PROC[e: Entity, of: TupleHandle]
RETURNS [Entity] =
THIS PROCEDURE NO LONGER USED; too hard to check if in "!" domain quickly.
If e is not in of's segment, create a stub for it in that segment: an entity in the domain
with the name "!". The entity name is "<seg>:<foo>:<baz>" where <seg> is the name of
the "to" segment, <foo> is the domain of e, and <baz> is the name of e.
BEGIN
IF SameSegment[e, of] THEN RETURN[e]
ELSE
BEGIN
s: Segment← DBStorage.SegmentFromTuple[e];
to: Segment← QSegmentOf[e];
RETURN[QDeclareEntity[QDeclareDomain["!", s, NewOrOld],
Rope.Cat[Atom.GetPName[to], ":", QNameOf[QDomainOf[e]], ":", QNameOf[e]] ]];
END;
END;
Handy entity list and set procedures
SearchEntityList:
PUBLIC
PROC [
el: LIST OF Entity, test: PROC[Entity] RETURNS[BOOL]] RETURNS [Entity]=
BEGIN
FOR elT:
LIST
OF Entity← el, elT.rest
UNTIL elT=
NIL
DO
IF test[elT.first] THEN RETURN[elT.first] ENDLOOP;
RETURN[NIL]
END;
EntityListLength:
PUBLIC
PROC [ el:
LIST
OF Entity]
RETURNS [
INT]=
BEGIN count: INT← 0;
FOR elT:
LIST
OF Entity← el, elT.rest
UNTIL elT=
NIL
DO
count← count+1 ENDLOOP;
RETURN[count]
END;
FindSubDomains:
PROC[d: Domain]
RETURNS [
LIST
OF Domain] = {
Returns all subDomains of d but not d itself
IF Eq[d, AnyDomainType] THEN RETURN[QEntitySetToList[DomainSubset[DomainDomain]]]
ELSE RETURN[TransitiveClosure[d, T2CT[dSubTypeOf], T2CT[dSubTypeIs]]]
};
FindSuperDomains:
PUBLIC
PROC[d: Domain]
RETURNS [
LIST
OF Domain] =
returns all super-Domains of d but not d itself
{RETURN[TransitiveClosure[d, T2CT[dSubTypeIs], T2CT[dSubTypeOf]]]};
TransitiveClosure:
PUBLIC
PROC[e: Entity, from, to: Attribute]
RETURNS [
LIST
OF Entity] =
Find all entities referenced by relships via the to attribute whose from attribute refns e,
then all entities referenced by relships via the to attribute whose from
attribute reference one of those, and so on, return the result as a list.
BEGIN thisSub: Entity; rel: Relship;
r: Relation← V2E[SafeGetP[from, aRelationIs]];
subs: RelshipSet← QRelationSubset[r, LIST[[from, e]] ];
el: LIST OF Entity← NIL;
UNTIL Null[rel← QNextRelship[subs]]
DO
thisSub← V2E[QGetF[rel, to]];
el← Nconc[TransitiveClosure[thisSub, from, to], el];
el← CONS[thisSub, el];
ENDLOOP;
QReleaseRelshipSet[subs];
RETURN[el]
END;
EmptyDomain:
PUBLIC
PROC [d: Domain]
RETURNS [b:
BOOLEAN] =
BEGIN
es: EntitySet← QDomainSubset[d: d, searchSubDomains: FALSE];
b← Null[QNextEntity[es]];
QReleaseEntitySet[es];
END;
EmptyRelation:
PUBLIC
PROC [r: Relation]
RETURNS [b:
BOOLEAN] =
BEGIN
rs: RelshipSet← QRelationSubset[r];
b← Null[QNextRelship[rs]];
QReleaseRelshipSet[rs];
END;
Nconc:
PUBLIC
PROC[l1, l2:
LIST
OF Entity]
RETURNS [
LIST
OF Entity] =
BEGIN lp: LIST OF Entity← l1;
IF l1=NIL THEN RETURN[l2];
FOR lp← l1, lp.rest UNTIL lp.rest=NIL DO ENDLOOP;
lp.rest← l2;
RETURN[l1];
END;
NumberOfAttributes:
PUBLIC
PROC [r: Relation]
RETURNS [n:
CARDINAL] =
{RETURN[EntityListLength[VL2EL[QGetPList[r, aRelationOf]]]]};
GetFirstAttribute:
PUBLIC
PROC [
of: Relation, notCounting: Attribute← NIL] RETURNS [a: Attribute] =
Returns the first attribute of relation "of" except for "notCounting". Uses
GetCacheRelationInfo to get attributes, unless "of" is a system relation.
BEGIN ENABLE Error => TRUSTED {IF code=NILArgument THEN {a← NIL; CONTINUE}};
first, second: Attribute;
IF IsSystem[of]
THEN
IF (a← T2STT[of].vAttributes.first)#notCounting THEN RETURN[a]
ELSE RETURN[T2STT[of].vAttributes.rest.first];
[first, second] ← GetCachedRelationInfo[of];
IF Eq[notCounting, first] THEN RETURN[second]
ELSE RETURN[first];
END;
AppendIfNew:
PROC[e: Entity, el:
LIST
OF Entity]
RETURNS [
LIST
OF Entity] =
Add entity e to list el if it is not already in the list.
BEGIN elT: LIST OF Entity;
FOR elT← el, elT.rest
UNTIL elT=
NIL
DO
IF Eq[elT.first, e] THEN RETURN[el] ENDLOOP;
RETURN[CONS[e, el]];
END;
Miscellaneous procs
GetTypeAndLink:
PUBLIC
PROC [a: Attribute]
RETURNS [type: Entity, link: LinkType] =
The use of aTypeIs is unusual. If aTypeCodeProp > 0, the type is the system entity whose
tid is the aTypeCodeProp. Else the type is the domain referenced by aTypeEntityProp,
and aTypeCodeProp= - LOOPHOLE[LinkType, INTEGER], distinguishable since <= 0.
Must check explicitly for system attribute because SafeGetP won't handle aTypeEntityProp
and aTypeCodeProp on system entities (it would be too inefficient to NEW INTs and BOOLs).
BEGIN
vtTid: INT; pos: LONG CARDINAL;
IF IsSystem[a] THEN RETURN[T2SAT[a].vType, Linked];
vtTid← V2I[SafeGetP[a, aTypeCodeProp]];
IF vtTid<=0
THEN
RETURN [V2E[SafeGetP[a, aTypeEntityProp]], LOOPHOLE[Basics.LowHalf[-vtTid]]]
ELSE
IF (pos← vtTid)<=AnyDomainTypeID
THEN
RETURN[DBModelPrivate.systemTupleVec[pos], Linked]
ELSE ERROR InternalError;
END;
SetTypeAndLink:
PUBLIC
PROC [a: Attribute, type: Entity, link: LinkType] =
See comment above about encoding of aTypeCodeProp and aTypeEntityProp.
Also note: if attribute is not linked, must set aUnlinked to domain so can find later.
BEGIN
WITH type^
SELECT
FROM
vt: TupleObject[entity] =>
-- Simple datum type: RopeType, IntType, etc.
[]← SafeSetP[a, aTypeCodeProp, NEW[INT← vt.tid]];
vt: TupleObject[stored] => {
Attribute defined on client-defined domain. Store domain in the aTypeEntity field.
[]← SafeSetP [a, aTypeCodeProp, NEW[INT← - LOOPHOLE[link, INTEGER]]];
[]← SafeSetP[a, aTypeEntityProp, type];
IF link=Unlinked
OR link=Remote
THEN
-- set aUnlinked so can find refs by group scan
[]← SafeSetP[a, aUnlinkedIs, type];
};
ENDCASE => ERROR Error[MismatchedAttributeValueType];
END;
GetTupleHandle:
PROC [t: Relship]
RETURNS [DBStorage.TupleHandle] =
Returns the target entity's tuple handle if t is surrogate, else just returns t.
BEGIN
WITH t^
SELECT
FROM
t1: surrogate TupleObject => RETURN[t1.vEntity];
t1: stored TupleObject => RETURN[t];
ENDCASE => ERROR InternalError;
END;
MakeFD:
PUBLIC
PROC [vt: DataType, length:
INT← 0, link:
BOOL←
TRUE, a: Attribute←
NIL]
RETURNS [DBStorage.FieldDescriptor] =
Takes information about an attribute, returns a field descriptor for values of the given
attribute.
BEGIN
len: CARDINAL← Basics.LowHalf[length]; -- sigh
SELECT vt
FROM
BoolType => RETURN[[OneWord[]]];
IntType => RETURN[[TwoWord[]]];
TimeType => RETURN[[TwoWord[]]];
RopeType => RETURN[[VarByte[lengthHint: len]]];
RecordType => RETURN[[NWord[length: len]]];
ENDCASE => {
-- some entity reffing field
IF a=NIL THEN ERROR;
IF link THEN RETURN[[Group[groupID: a]]]
ELSE RETURN[[VarByte[lengthHint: len]]];
};
END;
Cattell on December 17, 1982 5:48 pm: Created this file to remove many common routines from DBModelBasicImpl, DBModelSystemImpl, DBModelSetImpl, and DBModelGlobalImpl. Also reduced the size of those files as a result.
Cattell on December 30, 1982 11:24 am: Added new relation and tupleset cache to improve performance. The global proc to flush all caches is now call FlushCache, not FlushAttributeCache.
Cattell on January 27, 1983 1:53 pm: Added CreateEntityIndexEntries and DestroyEntityIndexEntries so that both surrogate relation optimization and indices can be applied to the same relation.
Cattell on January 28, 1983 1:26 pm: Added GetCachedDomainInfo to cache info for CreateEntityIndexEntries and DestroyEntityIndexEntries, modified them to use it. Cached index information in GetCachedRelationInfo and GetCachedAttributeInfo, on the basis of a study of performance that showed this was a significant portion of the time in SetF and CreateRelship (at least in the case when there were NO indices to bother with).
Cattell on January 31, 1983 11:54 am: DestroyEntityIndexEntries doesn't need to destroy the surrogate relation index entries, because QDestroyEntity which uses it already destroys these by calling DestroyLinksTo which individually destroys the surrogate relships which destroys the index entries.
Cattell on February 8, 1983 3:06 pm: check for non-existent domain from SetFS/StringToValue string.
Cattell on March 14, 1983 2:23 pm: added index and subdomain to GetCachedDomainInfo. Got rid of GetNameIndex and made FindSubDomains a private procedure to this module. Fixed bug in GetTypeAndLink whereby it called SafeGetP[system attribute, aTypeCodeProp], which SafeGetP can't handle. Put checks in caching procedures to make sure they are never called on system entities (which was actually the source of the aforementioned bug).
Cattell on April 11, 1983 10:18 am: GetTypeAndLink returned Basics.LowHalf[vtTid] instead of Basics.LowHalf[-vtTid], didn't work for anything but Linked (= 0). I wonder why Walnut didn't trip over this.
Cattell on April 14, 1983 9:55 am: Good 'ol Jimmy Database noticed that GetCachedRelationInfo fails doing GetF on NIL when a relation has less than two attributes; check for this explicitly now.
Cattell on July 25, 1983 4:04 pm: Fixed bug in GetRelationIndices; it needed an extra loop in the case when there were multiple indices on the same attribute of a relation.
Willie-Sue on December 6, 1983 12:19 pm: made initialization for TimeType use BasicTime.NullGMT.