<> <> <> <> <> <> <> DIRECTORY Ascii USING[Upper], Atom, Basics, BasicTime, ConvertUnsafe, DBEnvironment, DBStorage, DBStats, DBTuplesConcrete, DB, DBModel, DBModelPrivate, IO, Rope; DBModelPrivateImpl: CEDAR 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; <> TupleObject: PUBLIC TYPE = DBTuplesConcrete.TupleObject; EntityObject: PUBLIC TYPE = TupleObject; RelshipObject: PUBLIC TYPE = TupleObject; EntitySetObject: PUBLIC TYPE = DBTuplesConcrete.EntitySetObject; RelshipSetObject: PUBLIC TYPE = DBTuplesConcrete.RelshipSetObject; <> 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; <> CheckEntity: PUBLIC PROC [t: TupleHandle] = <> {[]_ QDomainOf[t]}; CheckRelship: PUBLIC PROC [t: TupleHandle] = <> {[]_ 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] = <> <> <> <> <> 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] = <> <> 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; <> 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] = <> <> 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 => <> 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; <> 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; <> 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; NCode: PUBLIC PROC[v: Value] RETURNS[ROPE] = TRUSTED <> <> 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] = <> <> <> <> <> <> 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; <> 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] = <> <> 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; <> IF lastAttributes[i].tid#0 THEN lastAttributes[i].tid _ 0; <> 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] = <> 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; <> <> 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] = <> <> <> <> 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] = <> <> <> <> <> 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; <> [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] = <> <> <> 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] = <> <> <> <> 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] = <> 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; <> lastTuples[i]_ [ tid: x.tid, tupleSet: ts_ DBStorage.ReadTupleset[x] ]; END; FlushCaches: PUBLIC PROC[] = BEGIN FOR i: CARDINAL IN [0..numberOfCachedAttributes) DO <> 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; <> GetNameIndex: PUBLIC PROC [d: Domain] RETURNS [Index] = <> {RETURN[GetCachedDomainInfo[d].nameIndex]}; GetDomainIndex: PUBLIC PROC[s: Segment] RETURNS [Index] = <> {RETURN[DBStorage.RootIndicesFromSegment[s].index1]}; GetRelationIndex: PUBLIC PROC[s: Segment] RETURNS [Index] = <> {RETURN[DBStorage.RootIndicesFromSegment[s].index2]}; CreateEntityIndexEntries: PUBLIC PROC [e: Entity] = <> <> 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] = <> <> BEGIN d: Domain_ QDomainOf[e]; nameIndex: Index_ GetNameIndex[d]; IF nameIndex#NIL THEN <> DBStorage.DeleteFromIndex[nameIndex, NCode[QNameOf[e]], e]; END; DestroyIndexEntries: PUBLIC PROC [t: Relship, changed: Attribute] = <> <> <> <> BEGIN i: Index; th: DBStorage.TupleHandle_ GetTupleHandle[t]; ifs: LIST OF IndexFactor; FOR ifs_ GetCachedAttributeInfo[changed].indexFactors, ifs.rest UNTIL ifs=NIL DO <> 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] = <> <> <> <> <> 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>> <> <> BEGIN i: Index; th: DBStorage.TupleHandle_ GetTupleHandle[t]; ifs: LIST OF IndexFactor; FOR ifs_ GetCachedAttributeInfo[changed].indexFactors, ifs.rest UNTIL ifs=NIL DO <> 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] = <> 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] = <> <> <> 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] = <> <> <> <> <> <> 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] = <> <> 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 <> <> QSetF[t, a, NIL, FALSE ! InternalError => TRUSTED {IF desperate THEN CONTINUE}]; ENDLOOP; END; TranslateToSegment: PUBLIC PROC[e: Entity, of: TupleHandle] RETURNS [Entity] = <> <> <::" where is the name of>> < is the domain of e, and 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; <> 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] = { <> 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] = <> {RETURN[TransitiveClosure[d, T2CT[dSubTypeIs], T2CT[dSubTypeOf]]]}; TransitiveClosure: PUBLIC PROC[e: Entity, from, to: Attribute] RETURNS [LIST OF Entity] = <> <> <> 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] = <> <> 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] = <> 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; <> GetTypeAndLink: PUBLIC PROC [a: Attribute] RETURNS [type: Entity, link: LinkType] = < 0, the type is the system entity whose>> <> <> <> <> 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] = <> <> BEGIN WITH type^ SELECT FROM vt: TupleObject[entity] => -- Simple datum type: RopeType, IntType, etc. []_ SafeSetP[a, aTypeCodeProp, NEW[INT_ vt.tid]]; vt: TupleObject[stored] => { <> []_ 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] = <> 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] = <> <> 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; <> LowByte: PROC [n: CARDINAL] RETURNS [CHAR] = TRUSTED INLINE {RETURN[LOOPHOLE[LOOPHOLE[n, Basics.BytePair].low]]}; HighByte: PROC [n: CARDINAL] RETURNS [CHAR] = TRUSTED INLINE {RETURN[LOOPHOLE[LOOPHOLE[n, Basics.BytePair].high]]}; END. CHANGE LOG 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. Changed by Willie-Sue on February 15, 1985 <>