<> <> <> <> <> <> <> <> <> 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; <> initialized: BOOL_ FALSE; <> minfString: ROPE _ ""; -- less than any other string infString: ROPE _ "\177"; -- greater than any other string <> QInitialize: PUBLIC PROC[nCachePages: NAT, cacheFileName: ROPE] = { <> IF initialized THEN RETURN; initialized_ TRUE; IF cacheFileName=NIL THEN cacheFileName_ "DBSegment.VM"; DBStorage.Initialize[nCachePages, cacheFileName]; InitializeSystemTuples[]; InitializeSetObjects[]; }; <> 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]; <> sh _ SegmentToHandle[segment]; <> sh.schemaVersionStamp _ DBModelSchema.SchemaVersionStamp[sh]; <> IF sh.stableVS^.stamp # sh.schemaVersionStamp THEN sh.stableVS^ _ NEW[DBDefs.VSObject _ [sh.schemaVersionStamp]]; <> sh.schemaUpdated _ FALSE }; <> 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 { <> sh.schemaVersionStamp _ sh.stableVS^.stamp _ sh.schemaVersionStamp + 1; sh.schemaUpdated _ FALSE }; <> sh.VSForThisTrans^ _ sh.stableVS^; <> 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]; <> FlushCaches[sh]; <> IF sh.VSForThisTrans # NIL THEN { sh.VSForThisTrans^.stamp _ 0; sh.VSForThisTrans _ NIL }; <> 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 { <> sh.schemaVersionStamp _ sh.stableVS^.stamp _ sh.schemaVersionStamp + 1; sh.schemaUpdated _ FALSE }; <> IF sh.VSForThisTrans # NIL THEN { sh.VSForThisTrans^ _ sh.stableVS^; sh.VSForThisTrans _ NIL }; ENDLOOP; DBStorage.FinishTransaction[trans, FALSE, FALSE] }; }; <> 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]; }; <> QDeclareSegment: PUBLIC PROC[filePath: ROPE, segment: Segment, number: SegmentIndex _ 0, lock: AlpineEnvironment.LockOption _ [intendWrite, wait], readonly: BOOL _ FALSE, createIfNotFound: BOOL_ TRUE, nPagesInitial, nPagesPerExtent: INT_ 64, nFreeTuples: NAT _ 32] = { <> <> <> 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 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] = { <> trans _ DBStorage.OpenTransaction[segment, NIL, FALSE].trans; RETURN[trans] }; InternalCloseTransaction: PROC[trans: Transaction] = { <> IF trans#NIL THEN { DBStorage.FinishTransaction[trans, FALSE, FALSE] }; }; QEraseSegment: PUBLIC PROC[segment: Segment, useTrans: Transaction] RETURNS [trans: Transaction]= { <> 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] = { <> 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] = { <> openFile: DBCommon.OpenFileHandle; [openFile: openFile] _ DBStorage.GetSegmentInfo[segment]; RETURN[DBFileAlpine.VersionNumberFromOpenFile[openFile]] }; ParseSegmentName: PUBLIC PROC[path: ROPE] RETURNS [name, ext, server: ROPE] = <> BEGIN file: ROPE; pos: INT; <> 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 <> 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] ]; <> QDeclareDomain: PUBLIC PROC [name: ROPE, segment: Segment, version: Version_ NewOrOld] RETURNS [d: Domain] = { <> 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; <> 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]; <> []_ 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] = { <> 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 <> 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] = { <> 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: ROPE_ NIL, start: FirstLast _ First, ds: DomainSet] RETURNS[DomainSet] = { <=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] = { <> IF ds = NIL THEN RETURN[NIL]; RETURN[DBModelSchema.TupleToDomain[DBStorage.NextScanIndex[ds.scanHandle]]] }; QPrevDomain: PUBLIC PROC [ds: DomainSet] RETURNS [Domain] = { <> IF ds = NIL THEN RETURN[NIL]; RETURN[DBModelSchema.TupleToDomain[DBStorage.PrevScanIndex[ds.scanHandle]]] }; QReleaseDomainSet: PUBLIC PROC [ds: DomainSet] = { <> IF ds = NIL THEN RETURN ELSE { DBStorage.CloseScanIndex[ds.scanHandle]; ds.scanHandle _ NIL }}; QDeclareSubType: PUBLIC PROC [of, is: Domain] = { <> <> 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; <> 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 <> 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] = { <> <> <> 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 <> {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] = { <> 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] = { <> 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] = { <> 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; <> 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] = { <> 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 <> 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] = { <> 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: ROPE_ NIL, start: FirstLast _ First, rs: RelationSet] RETURNS[RelationSet] = { <=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] = { <> IF rs = NIL THEN RETURN[NIL]; RETURN[DBModelSchema.TupleToRelation[DBStorage.NextScanIndex[rs.scanHandle]]] }; QPrevRelation: PUBLIC PROC [rs: RelationSet] RETURNS [Relation] = { <> IF rs = NIL THEN RETURN[NIL]; RETURN[DBModelSchema.TupleToRelation[DBStorage.PrevScanIndex[rs.scanHandle]]] }; QReleaseRelationSet: PUBLIC PROC [rs: 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] = { <> <> 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]; <> 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] ]; <> attCount_ NumberOfAttributes[r]; <> <<(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)>> <> <> <> 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 <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] = { <> 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] = { <> <> <> <> <> 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]; <> <> 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; <> 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] = { <> i_ DBStorage.CreateSystemPageTuple[IndexDomain.systemTupleSet, t]; DBStorage.CreateIndex[i]; -- storage level sets iHandleProp }; QIndexOrder: PUBLIC PROC [i: Index] RETURNS [order: LIST OF Attribute] = { <> 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] = { <> <> 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] = { <> <> <> <> DestroyLinksTo[t]; DBStorage.DestroyTuple[t]; }; SameIndex: PROC[i: Index, nl: LIST OF Attribute] RETURNS[BOOLEAN] = { <> <> 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.