File: DBModelGlobalImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Contents: Implementation of global operations for Model level
Last edited by:
Eric Bier on August 6, 1981 17:10:15
Rick Cattell on January 4, 1984 10:36 am
Willie-Sue on February 22, 1985 9:21:53 am PST
Donahue, October 22, 1985 2:24:58 pm PDT
Widom, September 9, 1985 5:06:22 pm PDT
DIRECTORY
AlpineEnvironment USING [LockOption],
Atom USING [MakeAtom],
Basics USING [LowHalf],
DBCommon,
DBFileAlpine,
DBStorage,
DBDefs,
DB,
DBModel,
DBModelPrivate,
Rope;
DBModelGlobalImpl: CEDAR PROGRAM
IMPORTS Atom, DBDefs, DBFileAlpine, DBStorage, DB, DBModel, DBModelPrivate, Basics, Rope
EXPORTS DBModel =
BEGIN OPEN DBCommon, DBDefs;
Variables private to this module
initialized: BOOLFALSE;
The following shouldn't go into DB because they might get used before initialized
minfString: ROPE ← ""; -- less than any other string
infString: ROPE ← "\177"; -- greater than any other string
Initialization of database system
QInitialize: PUBLIC PROC[nCachePages: NAT, cacheFileName: ROPE] = {
Initializes database system
IF initialized THEN RETURN;
initialized← TRUE;
IF cacheFileName=NIL THEN cacheFileName← "DBSegment.VM";
DBStorage.Initialize[nCachePages, cacheFileName];
InitializeSystemTuples[];
InitializeSetObjects[];
};
Transaction operations
QOpenTransaction: PUBLIC PROC[segment: Segment, useTrans: TransactionHandle ← NIL] RETURNS[trans: TransactionHandle] = {
sh: SegmentHandle;
realTrans: DBCommon.Transaction ← IF useTrans = NIL THEN NIL ELSE useTrans.trans;
IF NOT initialized THEN ERROR Error[DatabaseNotInitialized];
realTrans ← DBSegment.OpenTransaction[segment, useTrans, FALSE];
If the file didn't change then the schema and data are guaranteed to be valid (fileChanged is TRUE for the first transaction opened on a segment)
sh ← SegmentToHandle[segment];
Fetch the schema version stamp from the database
sh.schemaVersionStamp ← DBModelSchema.SchemaVersionStamp[sh];
If the stableVS doesn't agree with the fetched VS then either this is the first transaction opened on this segment or another client has updated the schema. In either case we want to create a new stableVS (rendering objects pointing to the old one invalid -- there won't be any such objects if this is the first transaction).
IF sh.stableVS^.stamp # sh.schemaVersionStamp THEN
sh.stableVS^ ← NEW[DBDefs.VSObject ← [sh.schemaVersionStamp]];
Note that the schema hasn't yet been updated
sh.schemaUpdated ← FALSE };
Create a VS to use for schema objects created during this transaction
sh.VSForThisTrans ← NEW[DBDefs.VSHandle ← NEW[DBDefs.VSObject ← [sh.schemaVersionStamp]]];
RETURN[trans] };
QMarkTransaction: PUBLIC PROC[trans: Transaction] = {
IF trans#NIL THEN {
FOR segments: LIST OF Segment ← DBStorage.SegmentsOfTrans[trans], segments.rest UNTIL segments=NIL DO
sh: SegmentHandle ← SegmentToHandle[segments.first];
IF sh.schemaUpdated THEN {
The physical schema VS has been updated; we need to update the model level VS's
sh.schemaVersionStamp ← sh.stableVS^.stamp ← sh.schemaVersionStamp + 1;
sh.schemaUpdated ← FALSE };
The schema objects created in the transaction being marked are now valid:
sh.VSForThisTrans^ ← sh.stableVS^;
Make a new VS to use for newly created schema objects
sh.VSForThisTrans ← NEW[DBDefs.VSHandle ← NEW[DBDefs.VSObject ← [sh.schemaVersionStamp]]];
ENDLOOP;
DBStorage.FinishTransaction[trans, FALSE, TRUE] };
};
QAbortTransaction: PUBLIC PROC[trans: Transaction] = {
IF trans#NIL THEN {
FOR segments: LIST OF Segment ← DBStorage.SegmentsOfTrans[trans], segments.rest UNTIL segments=NIL DO
sh: SegmentHandle ← SegmentToHandle[segments.first];
Flush the caches since the data may have been changed within this transaction
FlushCaches[sh];
Invalidate the schema objects created in this transaction by setting their version stamp to 0
IF sh.VSForThisTrans # NIL THEN {
sh.VSForThisTrans^.stamp ← 0;
sh.VSForThisTrans ← NIL };
Note that the schema hasn't yet been updated (we need to do this here since next time a transaction is opened on this segment fileChanged may be FALSE)
sh.schemaUpdated ← FALSE;
ENDLOOP;
DBStorage.FinishTransaction[trans, TRUE, FALSE] };
};
QCloseTransaction: PUBLIC PROC[trans: Transaction] = {
IF trans#NIL THEN {
FOR segments: LIST OF Segment ← DBStorage.SegmentsOfTrans[trans], segments.rest UNTIL segments=NIL DO
sh: SegmentHandle ← SegmentToHandle[segments.first];
IF sh.schemaUpdated THEN {
The physical schema VS has been updated; we need to update the model level VS's
sh.schemaVersionStamp ← sh.stableVS^.stamp ← sh.schemaVersionStamp + 1;
sh.schemaUpdated ← FALSE };
The schema objects created in the transaction being marked are now valid:
IF sh.VSForThisTrans # NIL THEN {
sh.VSForThisTrans^ ← sh.stableVS^;
sh.VSForThisTrans ← NIL };
ENDLOOP;
DBStorage.FinishTransaction[trans, FALSE, FALSE] };
};
The following three procs parallel the above three, but do not commit (abort) the transaction (i.e. do not talk to the file server) - that is being handled from the outside
QFlushCache: PUBLIC PROC[trans: Transaction] =
{ IF trans#NIL THEN DBStorage.FlushTransaction[trans, FALSE, TRUE]};
QAbortCache: PUBLIC PROC[trans: Transaction] = {
IF trans#NIL THEN DBStorage.FlushTransaction[trans, TRUE, FALSE]
};
QEndTransaction: PUBLIC PROC[trans: Transaction] = {
IF trans#NIL THEN DBStorage.FlushTransaction[trans, FALSE, FALSE];
};
Segment operations
QDeclareSegment: PUBLIC PROC[filePath: ROPE, segment: Segment, number: SegmentIndex ← 0, lock: AlpineEnvironment.LockOption ← [intendWrite, wait], readonly: BOOLFALSE, createIfNotFound: BOOLTRUE, nPagesInitial, nPagesPerExtent: INT← 64, nFreeTuples: NAT ← 32] = {
Open a segment. Simply registers it, doesn't open the file till transaction opened.
Note that we have a slightly different semantics for the version than DBStorage.
We NEVER clobber an existing segment, that must be done with EraseSegment.
fileVersion: DBStorage.VersionOptions← IF createIfNotFound THEN None ELSE OldFileOnly;
trans: Transaction;
IF readonly AND createIfNotFound THEN ERROR Error[WriteNotAllowed];
IF NOT initialized THEN ERROR Error[DatabaseNotInitialized];
IF segment=NIL THEN segment← Atom.MakeAtom[ParseSegmentName[filePath].name];
IF number=0 THEN number← MapSegmentToNumber[segment];
DBModelPrivate.CreateSegmentObject[segment];
DBStorage.AttachSegment[
filePath, segment, number, lock, readonly, fileVersion, FALSE, nPagesInitial, nPagesPerExtent, nFreeTuples];
If readonly is FALSE, make sure there's not a protection violation.
IF NOT readonly THEN {
trans ← InternalOpenTransaction[segment !
DB.Error => {IF code = ProtectionViolation THEN GOTO ReadOnly ELSE ERROR Error[code]} ];
InternalCloseTransaction[trans] };
EXITS
ReadOnly => { InternalCloseTransaction[QGetSegmentInfo[segment].trans]; ERROR Error[WriteNotAllowed] }
};
InternalOpenTransaction: PROC[segment: Segment] RETURNS[trans: Transaction] = {
Called when DeclareSegment opens a transaction to check for a protection violation.
trans ← DBStorage.OpenTransaction[segment, NIL, FALSE].trans;
RETURN[trans] };
InternalCloseTransaction: PROC[trans: Transaction] = {
Called by DeclareSegment to close transactions opened by InternalOpenTransaction.
IF trans#NIL THEN { DBStorage.FinishTransaction[trans, FALSE, FALSE] };
};
QEraseSegment: PUBLIC PROC[segment: Segment, useTrans: Transaction] RETURNS [trans: Transaction]= {
Erases a segment. Opens a new transaction (committed) and returns it.
filePath: ROPE; number: SegmentIndex; lock: AlpineEnvironment.LockOption;
readonly: BOOL; oldTrans: Transaction;
nPagesInitial, nPagesPerExtent: INT; nFreeTuples: INT;
[filePath, number, oldTrans, lock, readonly, nPagesInitial, nPagesPerExtent, nFreeTuples]←
DBStorage.GetSegmentInfo[segment];
QCloseTransaction[oldTrans]; -- does nothing if no transaction open
DBStorage.AttachSegment[
filePath, segment, number, lock, readonly, None, TRUE, nPagesInitial, nPagesPerExtent, nFreeTuples];
trans ← QOpenTransaction[segment: segment, useTrans: useTrans].trans;
QMarkTransaction[trans];
RETURN[trans]
};
QGetSegmentInfo: PUBLIC PROC[segment: Segment] RETURNS [
filePath: ROPE, number: SegmentIndex, trans: Transaction, lock: AlpineEnvironment.LockOption, readOnly: BOOL] = {
IF segment=NIL THEN ERROR Error[NILArgument];
[filePath, number, trans, lock, readOnly, , ] ← DBStorage.GetSegmentInfo[segment];
IF filePath = NIL THEN number ← MapSegmentToNumber[segment ! Error => CONTINUE];
RETURN[filePath, number, trans, lock, readOnly]
};
QGetSegments: PUBLIC PROC RETURNS [sl: LIST OF Segment] = {
addToList: PROC [s: Segment, segmentIndex: DBStorage.SegmentIndex]RETURNS [stop: BOOL] =
{sl← CONS[s, sl]; RETURN[FALSE]};
sl← NIL;
DBStorage.EnumerateSegments[addToList];
RETURN[sl];
};
QGetBuiltinSegments: PUBLIC PROC RETURNS[LIST OF Segment] = {
must construct an entirely new list of new records, so a user cannot change the numbering; hence the very awful code that follows
sai: LIST OF Segment ← CONS[$Squirrel, NIL]; -- known start
last: LIST OF Segment ← sai;
FOR sL: LIST OF SegmentAndIndex ← mapSegmentToNumberList.rest, sL.rest UNTIL sL=NIL DO
last.rest ← CONS[sL.first.segment, NIL];
last ← last.rest;
ENDLOOP;
RETURN[sai];
};
QGetVersion: PUBLIC PROC[segment: Segment] RETURNS[version: NAT] = {
returns the Alpine version number of a database
openFile: DBCommon.OpenFileHandle;
[openFile: openFile] ← DBStorage.GetSegmentInfo[segment];
RETURN[DBFileAlpine.VersionNumberFromOpenFile[openFile]]
};
ParseSegmentName: PUBLIC PROC[path: ROPE] RETURNS [name, ext, server: ROPE] =
Separates [server]name.ext, and checks that name contains directory if non-local server
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;
MapSegmentToNumber: PROC [segment: Segment] RETURNS [NAT] = {
FOR mL: LIST OF SegmentAndIndex ← mapSegmentToNumberList, mL.rest UNTIL mL=NIL DO
IF segment = mL.first.segment THEN RETURN[mL.first.index];
ENDLOOP;
ERROR Error[CannotDefaultSegment]; -- seg number not given & can't guess
};
ConsIfNew: PROC [s: Segment, sl: LIST OF Segment] RETURNS [LIST OF Segment] = {
IF sl=NIL THEN RETURN[LIST[s]];
IF s=sl.first THEN RETURN[sl];
RETURN[CONS[sl.first, ConsIfNew[s, sl.rest]]] };
SegmentAndIndex: TYPE = RECORD[segment: Segment, index: SegmentIndex];
mapSegmentToNumberList: LIST OF SegmentAndIndex =
LIST[ [$Squirrel, 100B],
[$Foo, 101B],
[$Icons, 140B],
[$Walnut, 200B],
[$Hickory, 210B],
[$Grapenut, 220B],
[$Coconut, 230B],
[$Help, 240B],
[$Nuthatch, 250B],
[$Finger, 260B],
[$Test, 300B],
[$Whiteboard, 310B],
[$Tool, 320B],
[$WalnutSortDef, 330B],  -- reserve [330B .. 350B) for Pasadena
[$Chestnut, 400B] ];
Schema definition and interrogation operations
QDeclareDomain: PUBLIC PROC [name: ROPE, segment: Segment, version: Version← NewOrOld] RETURNS [d: Domain] = {
Creates a domain of this name or fetches it if it already exists.
sh: SegmentHandle;
IF NOT initialized THEN ERROR Error[DatabaseNotInitialized];
sh ← SegmentToHandle[segment];
IF name=NIL THEN name← "";
IF name.Length[]#0 THEN
BEGIN
d ← DBModelSchema.GetDomain[name, sh];
IF d#NIL THEN IF version=NewOnly THEN ERROR Error[AlreadyExists] ELSE RETURN[d];
IF version=OldOnly THEN RETURN[NIL];
END;
Create a new domain. Must set name and index entry manually since SetP assumes exists.
BEGIN
t: TupleHandle; i: Index;
t ← DBStorage.CreateSystemPageTuple[DomainDomain.systemTupleSet, NIL, segment];
DBStorage.CreateTupleset[t];
SetValFromHandle[t, tupleSetNameHandle, RopeType, Unlinked, S2PV[name]];
DBStorage.InsertIntoIndex[GetDomainIndex[sh], ConvertToUpper[name], t];
create the name field and index for the entities of this domain
[]← DBStorage.AddField[t, MakeFD[RopeType, DefaultNameLength]];
i ← CreateTupleSetIndex[t];
[]← SafeSetP[t, dIndexProp, E2PV[i]];
d ← NEW[DomainObject ← [version: sh.VSForThisTrans, name: name, segment: sh, tuple: t]];
DBModelSchema.UpdateVersionStamp[sh];
RETURN[d]
END
};
QDestroyDomain: PUBLIC PROC [d: Domain] = {
Destroys a domain, all its entities, and all relationships that reference entities in d.
e: Entity; r: Relship;
es: EntitySet; esi: CARDINAL;
supers: RelshipSet; supersi: CARDINAL;
al: LIST OF Entity;
dIndex: Index;
dt: TupleHandle;
IF QNullDomain[d] THEN RETURN;
IF DBModelSchema.InvalidDomain[d] THEN ERROR Error[InvalidSchema];
dt ← DBModelSchema.GetDomainTuple[d];
al ← VL2EL[QGetPList[dt, aTypeOf]]; -- reffing attr's
IF QSubTypes[d]#NIL THEN
ERROR Error[NotImplemented]; -- must destroy the domain's subdomains first!
[es, esi] ← GetNewEntitySet[];
es ← QDomainSubset[d: d, es: es]; -- all entities
[supers, supersi] ← GetNewRelshipSet[];
supers ← QRelationSubset[dSubType, LIST[[dSubTypeIs, E2V[dt]]], First, supers];
WHILE (r ← QNextRelship[supers])#NIL DO
destroy any links to super domains
SafeSetF[r, dSubTypeOf, nullValue];
SafeSetF[r, dSubTypeIs, nullValue];
DBStorage.DestroyTuple[NARROW[r]];
ENDLOOP;
QReleaseRelshipSet[supers];
ReturnRelshipSet[supersi];
WHILE (e← QNextEntity[es])#NIL DO QDestroyEntity[e] ENDLOOP;
QReleaseEntitySet[es];
ReturnEntitySet[esi];
FOR alT: LIST OF Entity ← al, alT.rest UNTIL alT=NIL DO
IF NOT NullEntity[alT.first] THEN {
reln: Relation ← DBModelSchema.TupleToRelation[PV2E[SafeGetP[alT.first, aRelationIs]]];
QDestroyRelation[reln]};
ENDLOOP;
DBStorage.DeleteFromIndex[GetDomainIndex[d.segment], ConvertToUpper[d.name], dt];
dIndex ← PV2E[SafeGetP[dt, dIndexProp]];
[]← SafeSetP[dt, dIndexProp, nullValue];
QDestroyIndex[dIndex];
DestroyDictionaryEntity[dt]; -- destroys any user links to d, all ours should be gone
DBModelSchema.UpdateVersionStamp[d.segment];
d.version ← NIL; -- invalidates the domain
};
QDomainInfo: PUBLIC PROC [d: Domain] RETURNS [name: ROPE, segment: Segment] = {
Returns the name of a domain and the segment it belongs to.
IF QNullDomain[d] THEN RETURN[NIL, NIL];
IF DBModelSchema.InvalidDomain[d] THEN ERROR Error[InvalidSchema];
RETURN[d.name, d.segment.segment] };
QEnumerateDomains: PUBLIC PROC [segment: Segment, lowName, highName: ROPENIL, start: FirstLast ← First, ds: DomainSet] RETURNS[DomainSet] = {
Provides a domain set that enumerates domains in the given segment. If lowName and highName are non-NIL, enumerates only those domains whose name is lexicographically >=lowName and <=highName. If only highName is NIL, it defaults to lowName, i.e. we will search for the domain whose name exactly equals lowName.
iScan: DBStorage.IndexHandle ← GetDomainIndex[SegmentToHandle[segment]];
[lowName, highName] ← NCodeAndDefaultLimits[lowName, highName];
ds.scanHandle ← DBStorage.OpenScanIndex[iScan, [lowName, highName, TRUE, TRUE], start];
RETURN[ds] };
QNextDomain: PUBLIC PROC [ds: DomainSet] RETURNS [Domain] = {
Returns NIL when no more domains in the set.
IF ds = NIL THEN RETURN[NIL];
RETURN[DBModelSchema.TupleToDomain[DBStorage.NextScanIndex[ds.scanHandle]]] };
QPrevDomain: PUBLIC PROC [ds: DomainSet] RETURNS [Domain] = {
Can be used to back up a DomainSet. Returns NIL when back to beginning.
IF ds = NIL THEN RETURN[NIL];
RETURN[DBModelSchema.TupleToDomain[DBStorage.PrevScanIndex[ds.scanHandle]]] };
QReleaseDomainSet: PUBLIC PROC [ds: DomainSet] = {
Should be called when client is finished with a DomainSet.
IF ds = NIL THEN RETURN ELSE {
DBStorage.CloseScanIndex[ds.scanHandle];
ds.scanHandle ← NIL }};
QDeclareSubType: PUBLIC PROC [of, is: Domain] = {
Check that super (of) is not already sub (is) of sub, that super has no entities in it,
and that super is not already supertype of sub (just return in this case).
st: Relship;
IF QNullDomain[of] OR QNullDomain[is] THEN ERROR Error[IllegalDomain];
IF DBModelSchema.InvalidDomain[of] OR DBModelSchema.InvalidDomain[is] THEN ERROR Error[InvalidSchema];
IF IsSubDomain[of, is] THEN RETURN;
It's already a subType, just return and leave it that way
FOR dlT: LIST OF Domain ← QSubTypes[is], dlT.rest UNTIL dlT=NIL DO
IF QDomainEq[dlT.first, of] THEN
ERROR Error[IllegalSuperType] -- super is already of a subdomain!
ENDLOOP;
IF NOT EmptyDomain[of] THEN
Currently can't define subdomain if super already has entries
ERROR Error[NotImplemented]; -- But client can resume if knows no surrogates
st ← DBStorage.CreateSystemPageTuple[dSubType.systemTupleSet, NIL, of.segment.segment];
SafeSetF[st, dSubTypeIs, E2PV[DBModelSchema.GetDomainTuple[is]]];
SafeSetF[st, dSubTypeOf, E2PV[DBModelSchema.GetDomainTuple[of]]];
DBModelSchema.UpdateVersionStamp[of.segment];
};
QDestroySubType: PUBLIC PROC [of, is: Domain] = {
Need only delete the subtype tuple, st. There should be no refs to it, and we
leave it to the user to insure that no existing relships now become illegal.
However, we must explicitly set sub and super to NIL to destroy SL's back-refs.
st: Relship;
rs: RelshipSet; rsi: CARDINAL;
oft, ist: TupleHandle;
oft ← DBModelSchema.GetDomainTuple[of];
ist ← DBModelSchema.GetDomainTuple[is];
[rs, rsi] ← GetNewRelshipSet[];
rs ← QRelationSubset[dSubType, LIST[ [dSubTypeIs, E2V[ist]], [dSubTypeOf, E2V[oft]] ], First, rs];
IF (st← QNextRelship[rs])=NIL THEN
It's not a subType, just return and leave it that way
{QReleaseRelshipSet[rs]; ReturnRelshipSet[rsi]; RETURN};
QReleaseRelshipSet[rs];
ReturnRelshipSet[rsi];
SafeSetF[st, dSubTypeOf, nullValue];
SafeSetF[st, dSubTypeIs, nullValue];
DBStorage.DestroyTuple[NARROW[st]];
};
QSuperType: PUBLIC PROC [d: Domain] RETURNS [super: Domain] = {
Returns the supertype of a given domain (if one has been previously defined using DeclareSubType)
rel: Relship;
rs: RelshipSet; rsi: CARDINAL;
IF QNullDomain[d] THEN RETURN[NIL];
IF DBModelSchema.InvalidDomain[d] THEN ERROR Error[InvalidSchema];
[rs, rsi] ← GetNewRelshipSet[];
rs ← QRelationSubset[dSubType, LIST[ [dSubTypeIs, E2V[DBModelSchema.GetDomainTuple[d]] ]], First, rs];
rel ← QNextRelship[rs];
IF NullRelship[rel] THEN super ← NIL
ELSE super ← DBModelSchema.TupleToDomain[V2E[QGetF[rel, dSubTypeOf]]];
QReleaseRelshipSet[rs];
ReturnRelshipSet[rsi];
RETURN[super] };
QSubTypes: PUBLIC PROC [d: Domain] RETURNS[subs: LIST OF Domain] = {
Returns the subtypes of a given domain (if any have been previously defined using DeclareSubType)
IF QNullDomain[d] THEN RETURN[NIL];
IF DBModelSchema.InvalidDomain[d] THEN ERROR Error[InvalidSchema];
RETURN[TransitiveClosure[DBModelSchema.GetDomainTuple[d], dSubTypeOf, dSubTypeIs]] };
IsSubDomain: PROC[of, is: Domain] RETURNS[BOOL] = {
FOR dl: LIST OF Domain ← QSubTypes[of], dl.rest UNTIL dl=NIL DO
IF QDomainEq[dl.first, is] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE] };
DeleteFromDomainList: PROC[dl: LIST OF Domain, d: Domain] RETURNS [LIST OF Domain] = {
IF dl=NIL THEN RETURN[NIL];
IF QDomainEq[dl.first, d] THEN RETURN[dl.rest];
RETURN[CONS[dl.first, DeleteFromDomainList[dl.rest, d]]] };
QDeclareRelation: PUBLIC PROC[
name: ROPE, segment: Segment, version: Version← NewOrOld]
RETURNS [r: Relation] = {
Creates a relation of the given name in the given segment, or fetches it if it already exists.
sh: SegmentHandle;
IF NOT initialized THEN ERROR Error[DatabaseNotInitialized];
sh ← SegmentToHandle[segment];
IF name=NIL THEN name← "";
IF name.Length[]#0 THEN
BEGIN
r ← DBModelSchema.GetRelation[name, sh];
IF r#NIL THEN IF version=NewOnly THEN ERROR Error[AlreadyExists] ELSE RETURN[r];
IF version=OldOnly THEN RETURN[NIL];
END;
Create a new relation. Must set name and index entry manually 'since SetP assumes exists.
BEGIN
t: TupleHandle;
t ← DBStorage.CreateSystemPageTuple[RelationDomain.systemTupleSet, NIL, segment];
DBStorage.CreateTupleset[t, 0 -- NO refs to Relships --];
[]← SafeSetP[t, r1to1Prop, B2PV[FALSE]];
SetValFromHandle[t, tupleSetNameHandle, RopeType, Unlinked, S2PV[name]];
DBStorage.InsertIntoIndex[GetRelationIndex[sh], ConvertToUpper[name], t];
r ← NEW[RelationObject ← [version: sh.VSForThisTrans, name: name, segment: sh, is1to1: FALSE, tuple: t]];
DBModelSchema.UpdateVersionStamp[sh];
RETURN[r];
END
};
QDestroyRelation: PUBLIC PROC [r: Relation] = {
Destroys a relation, its attributes, and all of its relships.
rel: Relship;
rs: RelshipSet; rsi: CARDINAL;
rt: TupleHandle;
IF QNullRelation[r] THEN RETURN;
IF DBModelSchema.InvalidRelation[r] THEN ERROR Error[InvalidSchema];
[rs, rsi] ← GetNewRelshipSet[];
rs ← QRelationSubset[r, NIL, First, rs];
WHILE (rel← QNextRelship[rs])#NIL DO QDestroyRelship[rel] ENDLOOP; -- destroy relships
QReleaseRelshipSet[rs];
ReturnRelshipSet[rsi];
FOR alT: LIST OF Attribute ← r.attributes, alT.rest UNTIL alT=NIL DO
Destroy attributes: must nil out any refs to domains & relations (to kill back refs)
at: TupleHandle ← DBModelSchema.GetAttributeTuple[alT.first];
[]← SafeSetP[at, aRelationIs, nullValue];
[]← SafeSetP[at, aTypeEntityProp, nullValue];
[]← SafeSetP[at, aDomainIs, nullValue];
alT.first.version ← NIL; -- invalidates the attribute
DBStorage.DestroyTuple[at];
ENDLOOP;
rt ← DBModelSchema.GetRelationTuple[r];
DBStorage.DeleteFromIndex[
GetRelationIndex[r.segment], ConvertToUpper[r.name], rt];
DestroyDictionaryEntity[rt];
DBModelSchema.UpdateVersionStamp[r.segment];
r.version ← NIL; -- invalidates the relation
};
QRelationInfo: PUBLIC PROC [r: Relation] RETURNS[name: ROPE, segment: Segment, attrList: LIST OF Attribute] = {
Returns the name of a relation, the segment it belongs to, and a list of its attributes
IF QNullRelation[r] THEN RETURN[NIL, NIL, NIL];
IF DBModelSchema.InvalidRelation[r] THEN ERROR Error[InvalidSchema];
RETURN[r.name, r.segment.segment, r.attributes] };
QEnumerateRelations: PUBLIC PROC [segment: Segment, lowName, highName: ROPENIL, start: FirstLast ← First, rs: RelationSet] RETURNS[RelationSet] = {
Provides a relation set that enumerates relations in the given segment. If lowName and highName are non-NIL, enumerates only those relations whose name is lexicographically >=lowName and <=highName. If only highName is NIL, it defaults to lowName, i.e. we will search for the domain whose name exactly equals lowName.
iScan: DBStorage.IndexHandle ← GetRelationIndex[SegmentToHandle[segment]];
[lowName, highName] ← NCodeAndDefaultLimits[lowName, highName];
rs.scanHandle ← DBStorage.OpenScanIndex[iScan, [lowName, highName, TRUE, TRUE], start];
RETURN[rs] };
QNextRelation: PUBLIC PROC [rs: RelationSet] RETURNS [Relation] = {
Returns NIL when no more relations in the set.
IF rs = NIL THEN RETURN[NIL];
RETURN[DBModelSchema.TupleToRelation[DBStorage.NextScanIndex[rs.scanHandle]]] };
QPrevRelation: PUBLIC PROC [rs: RelationSet] RETURNS [Relation] = {
Can be used to back up a RelationSet. Returns NIL when back to beginning.
IF rs = NIL THEN RETURN[NIL];
RETURN[DBModelSchema.TupleToRelation[DBStorage.PrevScanIndex[rs.scanHandle]]] };
QReleaseRelationSet: PUBLIC PROC [rs: RelationSet] = {
Should be called when client is finished with a RelationSet.
IF rs = NIL THEN RETURN ELSE {
DBStorage.CloseScanIndex[rs.scanHandle];
rs.scanHandle ← NIL }};
QDeclareAttribute: PUBLIC PROC [
r: Relation, name: ROPE, type: DataType ← NIL, uniqueness: Uniqueness ← None,
length: INT← 0, link: LinkType← Linked, version: Version← NewOrOld]
RETURNS[a: Attribute] = {
Create a new attribute dictionary entity, and defines a new fieldhandle for
the appropriate tupleset.
t: TupleHandle;
fh: DBStorage.FieldHandle;
attCount: CARDINAL;
rt: TupleHandle;
IF QNullRelation[r] THEN RETURN[NIL];
IF DBModelSchema.InvalidRelation[r] THEN ERROR Error[InvalidSchema];
IF link=Colocated THEN ERROR Error[NotImplemented];
a ← DBModelSchema.GetAttribute[r, name];
IF a#NIL THEN IF version=NewOnly THEN ERROR Error[AlreadyExists] ELSE RETURN[a];
No existing attribute, so create it.
IF version = OldOnly THEN RETURN[NIL];
IF type=NIL THEN ERROR Error[NILArgument]; -- Must not default type, if new!
rt ← DBModelSchema.GetRelationTuple[r];
t ← DBStorage.CreateSystemPageTuple[AttributeDomain.systemTupleSet, rt];
a ← NEW[AttributeObject ← [version: r.segment.VSForThisTrans, name: name, relation: r, type: type, uniqueness: uniqueness, link: link, tuple: t]];
DBModelSchema.UpdateVersionStamp[r.segment];
r.attributes ← AddToEnd[a, r.attributes];
ChangeName[t, name];
DBModelPrivate.SetTypeAndLink[t, type, link];
[]← SafeSetP[t, aRelationIs, E2PV[rt]];
[]← SafeSetP[t, aLengthIs, I2PV[length]];
[]← SafeSetP[t, aUniquenessIs, U2PV[uniqueness] ];
Create the fields for values of this attribute in a's Relation or ref'd Domain:
attCount← NumberOfAttributes[r];
The surrogate relation optimization follows. If:
(1) this is the first attribute of r
(2) it is a single-attribute primary key
(3) it is an entity-valued attribute but not of type AnyDomainType
(4) the domain it references is empty (has not entities yet)
(5) the domain it refs has no subdomains (else they'd need the attr too)
then we set r1to1Prop to TRUE for this relation, and store the 2nd-Nth
attributes with the domain instead; the relation's relships will be
surrogates not actually stored as tuples
IF attCount=1 AND uniqueness=Key AND surrogatesEnabled THEN
SELECT type FROM
IntType, RopeType, BoolType, AnyDomainType, TimeType =>
NULL;
ENDCASE => {
d: Domain ← DataTypeToDomain[type, r.segment];
IF EmptyDomain[d] AND QSubTypes[d]=NIL THEN
BEGIN -- this is it! we can do the surrogate relation optimization!
r.is1to1 ← TRUE;
[]← SafeSetP[rt, r1to1Prop, B2PV[TRUE]];
[]← SafeSetP[t, aDomainIs, E2PV[DBModelSchema.GetDomainTuple[d]]];
RETURN
END };
IF r.is1to1 THEN
we are defining Nth attribute of a 1 to 1 (surrogate) relation where N>1:
BEGIN
storageDomain: Entity ← DataTypeToEntity[GetFirstAttribute[r].type, r.segment];
a.fh ← fh ← DBStorage.AddField[storageDomain, MakeFD[type, length, link=Linked, t]];
[]← SafeSetP[t, aHandleProp, [handle[fh]]];
END
ELSE -- we are defining an attribute of a normal relation:
BEGIN
a.fh ← fh← DBStorage.AddField[rt, MakeFD[type, length, link=Linked, t]];
[]← SafeSetP[t, aHandleProp, [handle[fh]]];
END;
};
QAttributeInfo: PUBLIC PROC [a: Attribute] RETURNS [name: ROPE, r: Relation, type: DataType, uniqueness: Uniqueness, link: LinkType] = {
Returns the name of the given attribute, the relation it belongs to, the type, uniqueness, and link (see QDeclareAttribute).
IF QNullAttribute[a] THEN RETURN[NIL, NIL, NIL, None, None];
IF DBModelSchema.InvalidAttribute[a] THEN ERROR Error[InvalidSchema];
RETURN[a.name, a.relation, a.type, a.uniqueness, a.link] };
QDeclareIndex: PUBLIC PROC[
r: Relation, order: LIST OF Attribute, version: Version] RETURNS[i: Index] = {
Creates an index on relation r, keyed on the attributes in order; r may not have tuples.
We enter the index factors such that a group scan on the index will return them in order
of increasing lexicographic significance. We check to see if there's another identical
index on r. We allow an index on all kinds of attributes, including entity-valued ones.
On entity-valued attributes, the string values used will actually be the entity names.
count: INT;
if: IndexFactor;
ifs: LIST OF IndexFactor;
segment: SegmentHandle;
rt: TupleHandle;
IF QNullRelation[r] THEN ERROR Error[IllegalRelation];
IF DBModelSchema.InvalidRelation[r] THEN ERROR Error[InvalidSchema];
See if the index (ie an index with the same attribute order) already exists.
Try all the indexes that include the first attribute in order:
ifs← VL2TL[QGetPList[DBModelSchema.GetAttributeTuple[order.first], ifAttributeOf]];
FOR ifsT: LIST OF IndexFactor← ifs, ifsT.rest UNTIL ifsT=NIL DO
i← V2E[QGetP[ifsT.first, ifIndexIs]];
IF SameIndex[i, order] THEN
IF version=NewOnly THEN ERROR Error[AlreadyExists] ELSE RETURN[i];
ENDLOOP;
IF version=OldOnly THEN ERROR InternalError;
Check that relation empty, then create index and index factors.
IF NOT EmptyRelation[r] THEN ERROR Error[NotImplemented];
rt ← DBModelSchema.GetRelationTuple[r];
i← CreateTupleSetIndex[rt]; count← 0;
IF r.is1to1 THEN segment ← r.segment;
FOR orderL: LIST OF Attribute← order, orderL.rest UNTIL orderL=NIL DO
if← DBStorage.CreateSystemPageTuple[IndexFactorDomain.systemTupleSet, rt];
[]← SafeSetP[if, ifIndexIs, E2PV[i]]; -- Each factor points to its index...
[]← SafeSetP[if, ifOrdinalPositionIs, I2PV[count]]; -- ... gives its pos'n in the order
[]← SafeSetP[if, ifAttributeIs, E2PV[DBModelSchema.GetAttributeTuple[orderL.first]]]; -- .. and the attribute it refers to
count← count+1;
ENDLOOP;
DBModelSchema.UpdateVersionStamp[r.segment];
};
CreateTupleSetIndex: PROC[t: TupleHandle] RETURNS [i: Index] = {
Creates the storage level index on a domain or relation, and the Index entity
i← DBStorage.CreateSystemPageTuple[IndexDomain.systemTupleSet, t];
DBStorage.CreateIndex[i]; -- storage level sets iHandleProp
};
QIndexOrder: PUBLIC PROC [i: Index] RETURNS [order: LIST OF Attribute] = {
Gives the order of attributes for the index.
ifs: LIST OF IndexFactor← VL2TL[QGetPList[i, ifIndexOf]];
RETURN[IFListToAttrList[ifs]] };
AddToEnd: PROC [a: Attribute, al: LIST OF Attribute] RETURNS [LIST OF Attribute] = {
IF al=NIL THEN RETURN[LIST[a]]
ELSE RETURN[CONS[al.first, AddToEnd[a, al.rest]]] };
IFListToAttrList: PROC [ifl: LIST OF IndexFactor] RETURNS [LIST OF Attribute] = {
e: Entity;
IF ifl = NIL THEN RETURN[NIL];
e ← V2E[QGetP[ifl.first, ifAttributeIs]];
RETURN[CONS[DBModelSchema.TupleToAttribute[e], IFListToAttrList[ifl.rest]]] };
QDestroyIndex: PROC[i: Index] = {
Used to destroy index on domain or on relation.
Warning: must not destroy index on domain w/o destroying domain, since still refs index.
ifs: LIST OF IndexFactor← VL2TL[QGetPList[i, ifIndexOf]];
FOR ifsT: LIST OF IndexFactor← ifs, ifsT.rest UNTIL ifsT=NIL DO
[]← SafeSetP[ifsT.first, ifIndexIs, nullValue];
DBStorage.DestroyTuple[ifsT.first] ENDLOOP;
DBModelSchema.UpdateVersionStamp[SegmentOf[i]];
DBStorage.DestroyIndex[i];
DestroyDictionaryEntity[i];
};
DestroyDictionaryEntity: PROC[t: TupleHandle] = {
Destroy a domain, relation, attribute, index, or index factor entity.
Also destroys any group links to the entity: we don't know all the possible links to
the entity, now that we allow client-defined relations to reference dictionary entities.
We assume caller has destroyed any dependent entities and index entries, however.
DestroyLinksTo[t];
DBStorage.DestroyTuple[t];
};
SameIndex: PROC[i: Index, nl: LIST OF Attribute] RETURNS[BOOLEAN] = {
Determines whether the index factors of the given index, when compared in order to the
Attributes in nl, are the same.
a1, a2: Attribute;
if: IndexFactor;
count: INT← 0;
ifs: LIST OF Entity ← VL2EL[QGetPList[i, ifIndexOf]];
FOR nlT: LIST OF Attribute ← nl, nlT.rest UNTIL nlT=NIL DO
IF ifs=NIL THEN -- there more attributes in nl than index factors in ifs
RETURN[FALSE];
a1 ← nlT.first;
if ← ifs.first; ifs← ifs.rest;
IF count#PV2I[SafeGetP[if, ifOrdinalPositionIs]] THEN ERROR InternalError;
a2 ← DBModelSchema.TupleToAttribute[PV2E[SafeGetP[if, ifAttributeIs]]];
IF NOT QAttributeEq[a1, a2] THEN RETURN[FALSE];
count← count+1;
ENDLOOP;
IF ifs#NIL THEN RETURN[FALSE]; -- there were more index factors than attributes in nl
RETURN[TRUE]
};
NCodeAndDefaultLimits: PROC [low, high: ROPE] RETURNS [newLow, newHigh: ROPE] = TRUSTED
BEGIN
IF high=NIL THEN
IF low=NIL THEN {low← minfString; high← infString}
ELSE {low← NCode[S2V[low]]; high← low}
ELSE
{low← NCode[S2V[low]]; high← NCode[S2V[high]]};
RETURN[low, high]
END;
VL2EL: PROC[vl: LIST OF Value] RETURNS [LIST OF Entity] = {
IF vl = NIL THEN RETURN[NIL]
ELSE RETURN[CONS[V2E[vl.first], VL2EL[vl.rest]]] };
END.