-- File: DBModelPrivateImpl.mesa
-- Contents: Implementation of miscellaneous internal procedures for Model level
-- Last edited by:
-- Rick Cattell on September 15, 1983 4:40 pm
-- Willie-Sue, December 6, 1983 12:24 pm
DIRECTORY
Ascii USING[Upper],
Atom,
Basics,
BasicTime,
ConvertUnsafe,
DBEnvironment,
DBStorage,
DBStats,
DBTuplesConcrete,
DB,
DBModel,
DBModelPrivate,
IO,
Rope;
DBModelPrivateImpl: PROGRAM
IMPORTS Ascii, Atom, Basics, BasicTime, ConvertUnsafe, IO, Rope,
DBStats, DBStorage, DB, DBModel, DBModelPrivate
EXPORTS DB, DBModelPrivate, DBEnvironment =
BEGIN OPEN DB, DBModelPrivate, DBModel;
desperate: PUBLIC BOOL← FALSE;
-- opaque type objects: concrete in DBTuplesConcrete exported to DBModel
TupleObject: PUBLIC TYPE = DBTuplesConcrete.TupleObject;
EntityObject: PUBLIC TYPE = TupleObject;
RelshipObject: PUBLIC TYPE = TupleObject;
EntitySetObject: PUBLIC TYPE = DBTuplesConcrete.EntitySetObject;
RelshipSetObject: PUBLIC TYPE = DBTuplesConcrete.RelshipSetObject;
-- REFS to opaque type objects
TupleSet, Index, IndexFactor: TYPE = REF TupleObject;
Domain, Relation, Entity, Attribute, DataType: PUBLIC TYPE = REF EntityObject;
Relship: PUBLIC TYPE = REF RelshipObject;
SystemATuple: TYPE = REF attribute TupleObject;
SystemTSTuple: TYPE = REF tupleSet TupleObject;
SystemSTuple: TYPE = REF surrogate TupleObject;
EntitySet: PUBLIC TYPE = REF EntitySetObject;
RelshipSet: PUBLIC TYPE = REF RelshipSetObject;
T2SST: PROC[t: TupleHandle] RETURNS [SystemSTuple] =
INLINE BEGIN RETURN [NARROW[t]] END;
T2STT: PROC[t: TupleHandle] RETURNS [SystemTSTuple] =
INLINE BEGIN RETURN [NARROW[t]] END;
T2SAT: PROC[t: TupleHandle] RETURNS [SystemATuple] =
BEGIN RETURN [NARROW[t]] END;
-- 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
RopeType =>
RETURN[s];
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 {SIGNAL Error[NotFound]; RETURN[NIL]};
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 SIGNAL 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] =
-- 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]]];
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 = 30; --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 SIGNAL 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 SIGNAL 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 SIGNAL 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 = 10; -- 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;
-- The versions of the following in the Basics interface return CARDINALs!
LowByte: PROC [n: CARDINAL] RETURNS [CHAR] = TRUSTED INLINE
{RETURN[LOOPHOLE[LOOPHOLE[n, Basics.BytePair].low]]};