<> <> <> <> <> <> <> <> <<1. Data types and globals>> <<2. Creating and destroying entities and relationships>> <<3. Getting and setting names, properties, and attributes>> <<4. Miscellaneous exported procedures>> <<5. Miscellaneous support routines>> DIRECTORY Atom USING [GetPName, MakeAtom], BasicTime, DBStats USING [Inc, Starting, Stopping], DBStorage, DBTuplesConcrete, DBEnvironment, DB, DBModel, DBModelPrivate, IO, Rope; DBModelBasicImpl: CEDAR PROGRAM IMPORTS Atom, BasicTime, DBStats, DBStorage, DB, DBModel, DBModelPrivate, IO, Rope EXPORTS DB, -- Eq, Null, etc. DBModel, -- "Q" procedures DBModelPrivate, -- surrogate relship procs and GetTypeProp DBEnvironment -- opaque types -- = BEGIN OPEN DBTuplesConcrete, DB, DBModelPrivate, DBModel; ROPE: TYPE = Rope.ROPE; <<1. Data types and globals>> < DBModel>> TupleObject: PUBLIC TYPE = DBTuplesConcrete.TupleObject; EntityObject: PUBLIC TYPE = TupleObject; RelshipObject: PUBLIC TYPE = TupleObject; EntitySetObject: PUBLIC TYPE = DBTuplesConcrete.EntitySetObject; RelshipSetObject: PUBLIC TYPE = DBTuplesConcrete.RelshipSetObject; <> TupleHandle, 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; fakeTransAbort: BOOL_ FALSE; <<2. Creating and destroying entities and relationships>> QDeclareEntity: PUBLIC PROC[d: Domain, name: ROPE_ NIL, version: Version_ NewOrOld] RETURNS [e: Entity] = BEGIN GenSym: PROC[d: Domain] RETURNS[e: Entity] = BEGIN -- generates a unique anonymous entity ENABLE Error => TRUSTED {IF code=NonUniqueEntityName THEN RETRY}; random: LONG CARDINAL _ LOOPHOLE[BasicTime.GetClockPulses[]]; name: ROPE _ IO.PutR[IO.card[random]]; e _ QCreateEntity[d, name]; END; CheckDomain[d]; IF IsSystem[d] THEN ERROR Error[IllegalDomain]; IF name = NIL THEN -- Automatically generate new name/entity if no name given IF version=OldOnly THEN RETURN[NIL] ELSE {e _ GenSym[d]; RETURN}; e _ QFetchEntity[d, name]; IF e = NIL THEN IF version#OldOnly THEN e_ QCreateEntity[d, name] ELSE NULL ELSE -- e#NIL IF version=NewOnly THEN ERROR Error[AlreadyExists] ELSE RETURN; END; QFetchEntity: PUBLIC PROC[d: Domain, name: ROPE, segment: Segment_ NIL] RETURNS [e: Entity] = <> <> <> <> BEGIN nextE: Entity; es: EntitySet; IF fakeTransAbort THEN ERROR Aborted[QGetSegmentInfo[QSegmentOf[d]].trans]; IF d=DomainDomain THEN SELECT TRUE FROM name.Equal["Domain", FALSE] => RETURN[DomainDomain]; name.Equal["Relation", FALSE] => RETURN[RelationDomain]; name.Equal["Attribute", FALSE] => RETURN[AttributeDomain]; name.Equal["DataType", FALSE] => RETURN[DataTypeDomain]; name.Equal["Index", FALSE] => RETURN[IndexDomain]; name.Equal["IndexFactor", FALSE] => RETURN[IndexFactorDomain]; ENDCASE => NULL ELSE IF d=DataTypeDomain THEN SELECT TRUE FROM name.Equal["RopeType", FALSE] => RETURN[RopeType]; name.Equal["IntType", FALSE] => RETURN[IntType]; name.Equal["TimeType", FALSE] => RETURN[TimeType]; name.Equal["BoolType", FALSE] => RETURN[BoolType]; ENDCASE => NULL; es_ QDomainSubset[d, name,,,, segment]; e_ QNextEntity[es]; nextE_ QNextEntity[es]; QReleaseEntitySet[es]; IF Null[e] THEN RETURN[NIL]; IF NOT Null[nextE] THEN ERROR Error[MultipleMatch]; RETURN[e] END; QCreateEntity: PUBLIC PROC [d: Domain, name: ROPE] RETURNS [e: Entity] = <> <> BEGIN DBStats.Inc[CreateEntity]; CheckNullified[d]; IF IsSystem[d] THEN ERROR Error[DictionaryUpdate]; IF IsData[d] THEN ERROR Error[IllegalDomain]; e_ DBStorage.CreateTuple[d]; IF name=NIL THEN CreateEntityIndexEntries[e] -- we may disallow this name=NIL case soon ELSE ChangeNameBody[e: e, s: name, eD: d, existingIndexEntry: FALSE ! Error => TRUSTED {IF code=NonUniqueEntityName THEN DBStorage.DestroyTuple[e]} ]; END; QDestroyEntity: PUBLIC PROC[e: Entity] = <> <<(1) deleting all references to it in indexes and groups,>> <<(2) calling the storage level to destroy the tuple itself, its TH,>> <> BEGIN d: Domain; DBStats.Starting[DestroyEntity]; CheckNullified[e]; d_ QDomainOf[e]; IF IsSystem[d] THEN ERROR Error[DictionaryUpdate] ELSE BEGIN DestroyLinksTo[e]; -- This also destroys any surrogate relation index entries DestroyEntityIndexEntries[e]; -- This destroys the name index entry SetValFromHandle[e, defaultNameHandle, RopeType, , NIL]; -- So DBStorage doesn't crash DBStorage.DestroyTuple[e]; END; FlushTSCache[]; DBStats.Stopping[DestroyEntity]; END; QDeclareRelship: PUBLIC PROC[ r: Relation, init: AttributeValueList_ NIL, version: Version_ NewOrOld] RETURNS[t: Relship] = <> <> <> BEGIN IF version=NewOnly OR init=NIL THEN RETURN[QCreateRelship[r, init]]; t_ FetchRelship[r, init]; IF t=NIL AND version=NewOrOld THEN RETURN[QCreateRelship[r, init]]; END; QCreateRelship: PUBLIC PROC[r: Relation, init: AttributeValueList_ NIL] RETURNS[t: Relship] = <> <> BEGIN DBStats.Inc[CreateRelship]; CheckNullified[r]; IF IsSystem[r] THEN ERROR Error[DictionaryUpdate]; CheckRelation[r]; IF V2B[SafeGetP[r, r1to1Prop]] THEN RETURN[SurrogateCreateRelship[r, init]]; t_ DBStorage.CreateTuple[r]; IF init#NIL THEN SetMultipleF[t, init ! Error => TRUSTED {IF code=NonUniqueKeyValue THEN DBStorage.DestroyTuple[t]} -- clean up -- ]; CreateAllIndexEntries[t]; END; FetchRelship: PROC[r: Relation, avl: AttributeValueList] RETURNS[t: Relship] = <> <> <> BEGIN nextRel: Relship; rs: RelshipSet; rs_ QRelationSubset[r, avl]; t_ QNextRelship[rs]; nextRel_ QNextRelship[rs]; QReleaseRelshipSet[rs]; IF nextRel#NIL THEN ERROR Error[MultipleMatch]; -- need this any more? RETURN[t] END; SurrogateCreateRelship: PUBLIC PROC[r: Relation, init: AttributeValueList] RETURNS[Relship] = <> <> <> BEGIN t: SystemSTuple; DBStats.Inc[SurrogateCreateRelship]; t_ T2SST[DBStorage.ConsSystemTupleObject[surrogate]]; t.tid_ SurrogateRelshipID; t.vRelation_ r; t.vTargetAttribute_ GetFirstAttribute[r]; <> IF init#NIL THEN SetMultipleF[t, init]; RETURN[t] END; QDestroyRelship: PUBLIC PROC[t: Relship] = <> <<(1) destroying any index entries referencing this relationship>> <<(2) removing it from any DBStorage groups by NILing out entity-valued fields,>> <<(3) NILing out string-valued fields to get rid of any dangling strings created by DBStorage>> <<(4) invalidating tupleset cache and calling the storage level to destroy the TupleHandle,>> <> <> <> <> BEGIN r: Relation_ QRelationOf[t]; -- automatically does CheckRelship IF IsSystem[r] THEN ERROR Error[DictionaryUpdate]; DBStats.Starting[DestroyRelship]; IF V2B[SafeGetP[r, r1to1Prop]] THEN {SurrogateDestroyRelship[t]; RETURN}; DestroyAllIndexEntries[t]; -- (1) DestroyVariableFieldsOf[t]; -- (2) DestroyLinksFrom[t]; -- (3) DBStorage.DestroyTuple[t]; -- (4) FlushTSCache[]; DBStats.Stopping[DestroyRelship]; END; SurrogateDestroyRelship: PUBLIC PROC[t: Relship] = <> <> BEGIN rel1: SystemSTuple_ NARROW[t]; as: LIST OF Attribute; DBStats.Inc[SurrogateDestroyRelship]; as_ VL2EL[QGetPList[rel1.vRelation, aRelationOf]]; IF NOT Eq[as.first, rel1.vTargetAttribute] THEN ERROR InternalError; as_ as.rest; -- skip the target attribute <> FOR as_ as, as.rest UNTIL as=NIL DO QSetF[t, as.first, MakeNullValueOfType[GetPT[as.first, aTypeIs]]] ENDLOOP; DestroyAllIndexEntries[t]; FlushTSCache[]; END; <<3. Getting and setting names, properties, and attributes>> QNameOf: PUBLIC PROC [e: Entity] RETURNS [s: ROPE] = <> BEGIN DBStats.Starting[NameOf]; CheckEntity[e]; WITH e^ SELECT FROM e1: TupleObject[stored] => BEGIN eD: Domain_ QDomainOf[e]; IF Eq[eD, DomainDomain] OR Eq[eD, RelationDomain] THEN -- name always second field of these: s_ V2S[GetValFromHandle[e, tupleSetNameHandle, RopeType ]] ELSE IF Eq[eD, AttributeDomain] THEN s_ V2S[GetValFromHandle[e, attributeNameHandle, RopeType ]] ELSE s_ V2S[GetValFromHandle[e, defaultNameHandle, RopeType ]] END; e1: TupleObject[tupleSet] => s_ e1.vName; e1: TupleObject[attribute] => s_ e1.vName; e1: TupleObject[entity] => s_ e1.vName; e1: TupleObject[surrogate] => ERROR Error[IllegalEntity]; ENDCASE => ERROR InternalError; DBStats.Stopping[NameOf]; RETURN[s] END; QChangeName: PUBLIC PROC [e: Entity, s: ROPE] = <> BEGIN eD: Domain; e1: REF TupleObject[stored]; DBStats.Starting[ChangeName]; eD_ QDomainOf[e]; e1 _ T2ST[e]; IF IsSystem[e] THEN -- trying to change name of one of the system entities!! ERROR Error[DictionaryUpdate] ELSE IF IsSystem[eD] THEN -- ChangeName is only write operation permitted on dictionary entities DictionaryChangeName[e, s] ELSE ChangeNameBody[e, s, eD]; DBStats.Stopping[ChangeName]; END; ChangeNameBody: PROC [e: Entity, s: ROPE, eD: Domain, existingIndexEntry: BOOL _ TRUE] = <> <> BEGIN IF s=NIL THEN s_ ""; IF s.Length[]#0 THEN BEGIN old: Entity_ QFetchEntity[eD, s]; IF old#NIL THEN IF Eq[old, e] THEN GOTO Return -- e already has this name ELSE ERROR Error[NonUniqueEntityName]; END; IF existingIndexEntry THEN DestroyEntityIndexEntries[e]; SetValFromHandle[e, defaultNameHandle, RopeType, , s]; CreateEntityIndexEntries[e]; EXITS Return => NULL END; DictionaryChangeName: PROC [e: Entity, s: ROPE] = <> BEGIN eD: Domain_ QDomainOf[e]; index: DBStorage.IndexHandle; IF Eq[eD, AttributeDomain] THEN {SetValFromHandle[e, attributeNameHandle, RopeType, , s]; RETURN} ELSE IF Eq[eD, DomainDomain] THEN index_ GetDomainIndex[QSegmentOf[e]] ELSE IF Eq[eD, RelationDomain] THEN index_ GetRelationIndex[QSegmentOf[e]] ELSE ERROR Error[IllegalEntity]; -- Don't know of any other system domains <> DBStorage.DeleteFromIndex[index, ConvertToUpper[QNameOf[e]], e]; SetValFromHandle[e, tupleSetNameHandle, RopeType, , s]; DBStorage.InsertIntoIndex[index, ConvertToUpper[s], e]; END; QGetF: PUBLIC PROC[t: Relship, a: Attribute, string: BOOL_ FALSE] RETURNS[v: Value] = <> <> <> <> <> <> BEGIN ENABLE InternalError => TRUSTED {IF desperate THEN GOTO GiveUp}; fh: DBStorage.FieldHandle; ft: DataType; fl: LinkType; CheckNullified[t]; CheckNullified[a]; IF IsSurrogate[t] THEN RETURN[SurrogateGetF[t, a, string]]; DBStats.Starting[GetF]; [fh, ft, fl]_ GetAttributeInfo[a, t, TRUE]; v_ GetValFromHandle[t, fh, IF string THEN RopeType ELSE ft, fl]; DBStats.Stopping[GetF]; EXITS GiveUp => RETURN[NIL] END; QGetFS: PUBLIC PROC[t: Relship, a: Attribute] RETURNS [v: ROPE]= BEGIN temp: Entity; vt: DataType; vl: LinkType; [vt, vl]_ GetTypeAndLink[a]; SELECT vt FROM RopeType => RETURN[V2S[QGetF[t,a]]]; IntType => RETURN[IO.PutR[IO.int[V2I[QGetF[t, a]]]]]; TimeType => RETURN[IO.PutR[IO.time[V2T[QGetF[t, a]]]]]; BoolType => RETURN[IF V2B[QGetF[t, a]] THEN "TRUE" ELSE "FALSE"]; RecordType => ERROR Error[NotImplemented]; ENDCASE => -- must be an entity IF vl=Unlinked OR vl=Remote THEN <> RETURN[V2S[QGetF[t, a, TRUE]]] ELSE v_ -- Fetch the entity, return null if null, prepend domain if AnyDomainType IF Null[temp_ V2E[QGetF[t, a]]] THEN "" ELSE IF vt#AnyDomainType THEN QNameOf[temp] ELSE Rope.Cat[QNameOf[QDomainOf[temp]], ": ", QNameOf[temp]]; END; SafeGetF: PUBLIC PROC[t: Relship, a: Attribute] RETURNS[Value] = <> BEGIN fh: DBStorage.FieldHandle; ft: DataType; fl: LinkType; DBStats.Inc[DictionaryGetF]; [fh, ft, fl]_ GetAttributeInfo[a, t, FALSE]; RETURN[GetValFromHandle[t, fh, ft, fl]]; END; SurrogateGetF: PUBLIC PROC [t: Relship, a: Attribute, string: BOOL] RETURNS [v: Value] = <> BEGIN rel1: SystemSTuple_ NARROW[t]; DBStats.Starting[SurrogateGetF]; IF NOT Eq[GetPT[a, aRelationIs], rel1.vRelation] THEN ERROR Error[IllegalAttribute]; IF Eq[a, rel1.vTargetAttribute] THEN <> v_ rel1.vEntity ELSE <> BEGIN fh: DBStorage.FieldHandle; ft: DataType; fl: LinkType; [fh, ft, fl]_ GetAttributeInfo[a, t]; -- fh is handle of field in the entity! v_ GetValFromHandle[rel1.vEntity, fh, IF string THEN RopeType ELSE ft, fl ]; END; DBStats.Stopping[SurrogateGetF]; END; QSetF: PUBLIC PROC[t: Relship, a: Attribute, v: Value, updateIndices: BOOL_ TRUE] = <> <<"t" must be a data or surrogate tuple, "a" must be a dictionary tuple.>> BEGIN ENABLE InternalError => TRUSTED {IF desperate THEN CONTINUE}; fh: DBStorage.FieldHandle; ft: DataType; fl: LinkType; fu: Uniqueness; fr: Relation; CheckRelship[t]; IF IsDictionary[t] THEN ERROR Error[DictionaryUpdate]; IF IsSurrogate[t] THEN {SurrogateSetF[t, a, v]; RETURN}; [fh, ft, fl, fu, fr]_ GetAttributeInfo[a, t]; IF v#NIL AND (fu=Key OR fu=OptionalKey) AND NOT V2B[SafeGetP[fr, r1to1Prop]] THEN <> BEGIN other: Relship_ FetchRelship[fr, LIST[[a, v]]]; IF other#NIL THEN ERROR Error[NonUniqueKeyValue]; END; IF updateIndices THEN DestroyIndexEntries[t, a]; SetValFromHandle[t, fh, ft, fl, v]; IF updateIndices THEN CreateIndexEntries[t, a]; END; SafeSetF: PUBLIC PROC[t: Relship, a: Attribute, v: Value] = <> BEGIN fh: DBStorage.FieldHandle; ft: DataType; fl: LinkType; DBStats.Inc[DictionarySetF]; IF IsSurrogate[t] THEN SurrogateSetF[t, a, v]; [fh, ft, fl]_ GetAttributeInfo[a, t]; SetValFromHandle[t, fh, ft, fl, v]; END; QSetFS: PUBLIC PROC[t: Relship, a: Attribute, v: ROPE]= <> <> BEGIN CheckNIL[a]; QSetF[t, a, StringToValue[v, a]] END; SurrogateSetF: PUBLIC PROC [t: Relship, a: Attribute, v: Value] = <> <> BEGIN fh: DBStorage.FieldHandle; ft: DataType; fl: LinkType; t1: SystemSTuple_ NARROW[t]; DBStats.Starting[SurrogateSetF]; [fh, ft, fl]_ GetAttributeInfo[a, t]; IF Eq[a, t1.vTargetAttribute] THEN <> IF v#NIL AND NOT Eq[QDomainOf[V2E[v]], ft] THEN ERROR Error[MismatchedAttributeValueType] ELSE IF t1.vEntity#NIL THEN ERROR Error[NotImplemented] -- Can't reset target if relation is surrogate ELSE t1.vEntity_ V2E[v] ELSE -- normal case, setting Nth (N>1) attribute: aHandleProp gives handle in domain IF t1.vEntity=NIL THEN ERROR Error[MustSetKeyAttributeFirst] ELSE BEGIN DestroyIndexEntries[t, a]; SetValFromHandle [t1.vEntity, fh, ft, fl, v ]; CreateIndexEntries[t, a]; END; DBStats.Stopping[SurrogateSetF]; END; <> QGetP: PUBLIC PROC [e: Entity, aIs: Attribute, aOf: Attribute_ NIL] RETURNS [v: Value] = <> <> <> <> {RETURN[GetPBody[e, aIs, aOf, FALSE]]}; SafeGetP: PUBLIC PROC [e: Entity, aIs: Attribute] RETURNS [v: Value] = <> <> <> <> {RETURN[GetPBody[e, aIs, NIL, TRUE]]}; GetPBody: PROC [ e: Entity, aIs: Attribute, aOf: Attribute, safe: BOOL] RETURNS [v: Value] = <> BEGIN ENABLE InternalError => TRUSTED {IF desperate THEN GOTO GiveUp}; rs: RelshipSet; t: Relship; IF NOT safe THEN CheckEntity[e]; IF IsSystem[e] THEN RETURN[SystemGetP[e, aIs]]; IF IsSimpleSystemAttribute[aIs] THEN <> RETURN[GetValFromHandle[e, T2SAT[aIs].vHandle, T2SAT[aIs].vType]]; [rs,, ]_ GetPropertyRelships[e, aIs, aOf]; IF (t_ QNextRelship[rs])=NIL THEN v_ MakeNullValueOfType[V2E[SafeGetP[aIs, aTypeIs]]] ELSE {IF QNextRelship[rs]#NIL THEN ERROR Error[MismatchedPropertyCardinality]; v_ QGetF[t, aIs]}; QReleaseRelshipSet[rs]; EXITS GiveUp => RETURN[NIL]; END; IsSimpleSystemAttribute: PROC[aIs: Attribute] RETURNS [BOOL] = <> <> BEGIN r: SystemTSTuple; WITH aIs SELECT FROM aIs1: SystemATuple => IF (r_ T2STT[aIs1.vRelation]).vIsDomain -- invisible attr, e.g. aTypeCodeProp -- OR r.vR1to1 AND Eq[aIs, r.vAttributes.rest.first] -- 2nd attr of surrogate, eg aRelationIs -- THEN RETURN[TRUE]; ENDCASE; RETURN[FALSE] END; GetPropertyRelships: PROC[e: Entity, aIs: Attribute, aOf: Attribute] RETURNS[rs: RelshipSet, newOf: Attribute, r: Relation] = BEGIN CheckAttribute[aIs]; r_ V2E[SafeGetP[aIs, aRelationIs]]; IF aOf=NIL THEN aOf_ GetFirstAttribute[of: r, notCounting: aIs] ELSE CheckAttribute[aOf]; IF NOT CompatibleDomain[QDomainOf[e], V2E[SafeGetP[aOf, aTypeIs]]] THEN ERROR Error[MismatchedAttributeValueType]; rs_ QRelationSubset[r, LIST[[aOf, e]]]; RETURN[rs, aOf, r] END; GetPT: PROC [e: Entity, p: Attribute] RETURNS [Entity] = INLINE {RETURN[ V2E[SafeGetP[e, p]] ]}; QSetP: PUBLIC PROC [ e: Entity, aIs: Attribute, v: Value, aOf: Attribute_ NIL] RETURNS [t: Relship]= <> BEGIN ENABLE InternalError => TRUSTED {IF desperate THEN CONTINUE}; CheckEntity[e]; CheckAttribute[aIs]; IF IsSystem[e] OR IsSystem[aIs] THEN ERROR Error[DictionaryUpdate]; t_ SafeSetP[e, aIs, v, aOf]; END; SafeSetP: PUBLIC PROC [e: Entity, aIs: Attribute, v: Value, aOf: Attribute_ NIL] RETURNS[t: Relship] = <> <> <> BEGIN rs: RelshipSet; r: Relation; IF IsSimpleSystemAttribute[aIs] THEN {SetValFromHandle[e, T2SAT[aIs].vHandle, T2SAT[aIs].vType, Linked, v]; RETURN}; [rs, aOf, r]_ GetPropertyRelships[e, aIs, aOf]; IF IsKeyAttribute[aOf] THEN {t_ QNextRelship[rs]; IF t=NIL THEN t_ QCreateRelship[r, LIST[[aOf, e], [aIs, v]]] ELSE QSetF[t, aIs, v]} ELSE -- Don't actually need rs in this case, but foo... t_ QCreateRelship[r, LIST[[aOf, e], [aIs, v]]]; QReleaseRelshipSet[rs]; END; QGetPList: PUBLIC PROC [e: Entity, aIs: Attribute, aOf: Attribute_ NIL] RETURNS [vl: LIST OF Value] = BEGIN rs: RelshipSet; t: Relship; vFirst, vLast: LIST OF Value_ NIL; CheckEntity[e]; IF IsSystem[e] THEN {IF aIs#aUnlinkedOf AND aIs#aDomainOf THEN ERROR Error[NotImplemented]; RETURN}; [rs, aOf, ]_ GetPropertyRelships[e, aIs, aOf]; IF (t_ QNextRelship[rs])=NIL THEN {QReleaseRelshipSet[rs]; RETURN[NIL]}; vFirst_ vLast_ LIST[QGetF[t, aIs]]; FOR t_ QNextRelship[rs], QNextRelship[rs] UNTIL t=NIL DO vLast_ vLast.rest_ LIST[QGetF[t, aIs]] ENDLOOP; QReleaseRelshipSet[rs]; RETURN[vFirst] END; QSetPList: PUBLIC PROC [e: Entity, aIs: Attribute, vl: LIST OF Value, aOf: Attribute_ NIL] = BEGIN rs: RelshipSet; r: Relation; IF IsSystem[e] THEN ERROR Error[NotImplemented]; [rs, aOf, r]_ GetPropertyRelships[e, aIs, aOf]; MErasePList[rs]; FOR vlT: LIST OF Value_ vl, vlT.rest UNTIL vlT=NIL DO []_ QCreateRelship[r, LIST[[aOf, e], [aIs, vlT.first]]] ENDLOOP; END; MErasePList: PROC[rs: RelshipSet] = BEGIN FOR t: Relship_ QNextRelship[rs], QNextRelship[rs] UNTIL t=NIL DO QDestroyRelship[t] ENDLOOP; QReleaseRelshipSet[rs]; END; <<4. Miscellaneous exported procedures>> <> T2SAT: PROC[t: TupleHandle] RETURNS [SystemATuple] = BEGIN RETURN [NARROW[t]] END; T2STT: PROC[t: TupleHandle] RETURNS [SystemTSTuple] = INLINE BEGIN RETURN [NARROW[t]] END; T2SST: PROC[t: TupleHandle] RETURNS [SystemSTuple] = INLINE BEGIN RETURN [NARROW[t]] END; T2ST: PROC[t: TupleHandle] RETURNS [REF TupleObject[stored]] = INLINE BEGIN RETURN [NARROW[t]] END; <> V2R: PUBLIC SAFE PROC [v: Value] RETURNS [Relship] = CHECKED {RETURN[NARROW[v]]}; V2E: PUBLIC SAFE PROC [v: Value] RETURNS [Entity] = CHECKED {RETURN[NARROW[v]]}; Eq: PUBLIC SAFE PROC[e1, e2: Entity] RETURNS[BOOL] = TRUSTED <> <> <> BEGIN IF e1=NIL THEN RETURN[Null[e2]]; IF e2=NIL THEN RETURN[Null[e1]]; IF SameSegment[e1, e2] OR IsSystem[e1] OR IsSystem[e2] THEN RETURN[e1.tid=e2.tid] ELSE RETURN[FALSE]; END; Null: PUBLIC SAFE PROC[t: TupleHandle] RETURNS[BOOL] = CHECKED BEGIN RETURN[t=NIL OR t.tid=0] END; QDomainOf: PUBLIC PROC [e: Entity] RETURNS [d: Domain] = BEGIN DBStats.Inc[DomainOf]; CheckNIL[e]; CheckNullified[e]; TRUSTED { WITH e SELECT FROM stored => BEGIN ts: TupleSet_ GetCachedTupleTS[e]; tsts: TupleSet; WITH ts SELECT FROM tupleSet => <> <> RETURN[ts]; stored => { tsts_ GetCachedTupleTS[ts]; IF NOT (tsts=DomainDomain) THEN ERROR Error[IllegalEntity] ELSE RETURN [ts] }; ENDCASE => ERROR Error[IllegalEntity]; END; tupleSet => SELECT e FROM DomainDomain, RelationDomain, AttributeDomain, DataTypeDomain, IndexDomain, IndexFactorDomain => RETURN[DomainDomain]; aDomain, aRelation, aType, aUniqueness, aLength, aLink, aUnlinked, ifIndex, ifOrdinalPosition, ifAttribute, dSubType => RETURN[RelationDomain]; ENDCASE => ERROR Error[IllegalEntity]; attribute => RETURN[AttributeDomain]; surrogate => ERROR Error[IllegalEntity]; entity => RETURN[DataTypeDomain]; ENDCASE => ERROR; }; END; QRelationOf: PUBLIC PROC [t: Relship] RETURNS [r: Relation] = BEGIN DBStats.Inc[RelationOf]; CheckNullified[t]; TRUSTED { WITH t SELECT FROM stored => BEGIN ts: TupleSet_ GetCachedTupleTS[t]; tsts: TupleSet; WITH ts1: ts SELECT FROM stored => { tsts_ GetCachedTupleTS[ts]; IF NOT (tsts=RelationDomain) THEN ERROR Error[IllegalRelship] ELSE RETURN [ts] }; attribute, entity, surrogate => ERROR Error[IllegalRelship]; tupleSet => IF ts1.vIsDomain THEN ERROR Error[IllegalRelship] ELSE RETURN [ts]; ENDCASE => ERROR Error[IllegalRelship]; END; tupleSet, attribute, entity => ERROR Error[IllegalRelship]; surrogate => RETURN[vRelation]; ENDCASE => ERROR; }; END; QSegmentOf: PUBLIC PROC[x: Entity] RETURNS [Segment] = { CheckNIL[x]; CheckNullified[x]; IF IsSystem[x] THEN ERROR Error[NotImplemented]; RETURN[DBStorage.SegmentFromTuple[x]]}; <<5. Miscellaneous support routines>> GetValFromHandle: PUBLIC PROC [ t: TupleHandle, fh: DBStorage.FieldHandle, ft: DataType, fl: LinkType_ Linked] RETURNS [v: Value] = <> <> <> <<(See explanation in DBModelSystemImpl of these attributes).>> BEGIN SELECT ft FROM IntType => IF fh = T2SAT[aLinkIs].vHandle THEN RETURN[U2V[GetTypeAndLink[t].link]] ELSE RETURN[NEW[INT_ LOOPHOLE[DBStorage.Read2Word[t, fh]] ]]; TimeType => { time: BasicTime.GMT; time_ BasicTime.FromPupTime[DBStorage.Read2Word[t, fh] ! BasicTime.OutOfRange => {time_ BasicTime.nullGMT; CONTINUE}]; RETURN[NEW[GMT_ LOOPHOLE[time]]]; }; RopeType => RETURN [DBStorage.ReadVarByte[t, fh] ]; RecordType => <> <> {DBStorage.ReadNWord[t, fh, v_ DBStorage.CreateFieldHandle[]]; RETURN[v] }; BoolType => RETURN[NEW[BOOL _ LOOPHOLE[DBStorage.Read1Word[t, fh]]]]; DataTypeDomain => IF fh = T2SAT[aTypeIs].vHandle THEN RETURN[GetTypeAndLink[t].type] ELSE ERROR Error[IllegalValueType] ENDCASE => -- ft is a domain IF fl=Linked OR fl=Colocated THEN -- linked entity, stored as tuple ref RETURN[DBStorage.ReadTID[t, fh]] ELSE IF fl=Unlinked THEN -- entity name stored, look up the corresponding entity in ft RETURN[QDeclareEntity[ft, V2S[GetValFromHandle[t, fh, RopeType]]]] ELSE -- entity is remote, look up entity in another segment RETURN[IDToEntity[V2S[GetValFromHandle[t, fh, RopeType]]]]; END; SetValFromHandle: PUBLIC PROC [ t: TupleHandle, fh: DBStorage.FieldHandle, ft: DataType, fl: LinkType_ Linked, v: Value] = <> <> <> <> <> <> <> <> BEGIN WITH v SELECT FROM v1: REF INT => IF ft#IntType THEN ERROR Error[MismatchedAttributeValueType] ELSE DBStorage.Write2Word[t, fh, LOOPHOLE[v1^]]; v1: REF GMT => IF ft#TimeType THEN ERROR Error[MismatchedAttributeValueType] ELSE DBStorage.Write2Word[t, fh, BasicTime.ToPupTime[v1^]]; v1: ROPE => IF ft#RopeType THEN ERROR Error[MismatchedAttributeValueType] ELSE DBStorage.WriteVarByte[t, fh, v1]; v1: REF BOOL => IF ft#BoolType THEN ERROR Error[MismatchedAttributeValueType] ELSE DBStorage.Write1Word[t, fh, LOOPHOLE[v1^] ]; <> v1: Entity => { IF SameSegment[v1, t] THEN {IF NOT CompatibleDomain[QDomainOf[v1], ft] THEN ERROR Error[MismatchedAttributeValueType]} ELSE IF fl#Remote THEN ERROR Error[MismatchedSegment]; <> IF fl=Linked OR fl=Colocated THEN -- linked: store the entity reference in a group BEGIN temp: DBStorage.GroupScanHandle; DBStorage.WriteTID[t, (temp_ DBStorage.OpenScanGroup[v1, fh, Last])]; <> DBStorage.CloseScanGroup[temp] END ELSE IF fl=Unlinked THEN -- not linked: store name as string SetValFromHandle[t, fh, RopeType, , QNameOf[v1]] ELSE -- fl=Remote: store segment: domain: name SetValFromHandle[t, fh, RopeType, , EntityToID[v1]]; }; ENDCASE => IF v=NIL THEN -- only RopeType and Entity type allow NIL: IF ft=RopeType THEN DBStorage.WriteVarByte[t, fh, NIL] ELSE IF IsDomainType[ft] THEN IF fl=Linked OR fl=Colocated THEN DBStorage.WriteTIDNil[t, fh] ELSE DBStorage.WriteVarByte[t, fh, NIL] ELSE -- give the guy another chance, construct a null value for him ... SetValFromHandle[t, fh, ft, fl, MakeNullValueOfType[ft]] ELSE -- it better be a better IF ft#RecordType THEN ERROR Error[IllegalValue] ELSE DBStorage.WriteNWord[t, fh, v]; END; IDToEntity: PROC[name: ROPE] RETURNS[e: Entity] = { <> segNameLength: INT = Rope.Find[ name, ":" ]; domainNameLength: INT = Rope.Find[ name, ":", segNameLength+2 ] - segNameLength - 2; segName: ROPE = Rope.Substr[ name, 0, segNameLength ]; domainName: ROPE = Rope.Substr[ name, segNameLength+2, domainNameLength ]; entityName: ROPE = Rope.Substr[ name, segNameLength+domainNameLength+4 ]; segment: DB.Segment = Atom.MakeAtom[ segName ]; domain: Domain; domain _ DBModel.QDeclareDomain[ domainName, segment, OldOnly ! DB.Error => TRUSTED {domain _ NIL; CONTINUE} ]; e _ IF domain = NIL THEN NIL ELSE DBModel.QFetchEntity[ domain, entityName, segment ] }; EntityToID: PROC[e: Entity] RETURNS[name: ROPE] = { RETURN[Rope.Cat[ Atom.GetPName[DBModel.QSegmentOf[e]], ": ", DBModel.QNameOf[DBModel.QDomainOf[e]], ": ", DBModel.QNameOf[e] ]] }; SetMultipleF: PROC[t: Relship, alh: AttributeValueList] = <> <> BEGIN FOR alhT: AttributeValueList _ alh, alhT.rest UNTIL alhT=NIL DO QSetF[t, alhT.first.attribute, alhT.first.lo, FALSE] ENDLOOP; END; GetAttributeInfo: PROC[ a: Attribute, t: TupleHandle, doChecking: BOOL_ TRUE] RETURNS[ handle: DBStorage.FieldHandle, type: DataType, link: LinkType, uniqueness: Uniqueness, relation: Relation] = <> <> <> <> <> BEGIN CheckNIL[a]; IF IsSystem[a] THEN <> BEGIN ts: TupleSet; a1: SystemATuple _ T2SAT[a]; DBStats.Inc[SystemGetAttributeInfo]; IF doChecking THEN { IF t.tid=SurrogateRelshipID THEN ts_ T2SST[t].vRelation ELSE ts_ GetCachedTupleTS[t]; IF (a1.tid> BEGIN ts: Relation; <> DBStats.Inc[GetAttributeInfo]; IF t.tid=SurrogateRelshipID THEN ts_ T2SST[t].vRelation ELSE IF IsSystem[t] THEN ERROR InternalError ELSE ts_ GetCachedTupleTS[t]; <> [relation, type, handle, uniqueness, link]_ GetCachedAttributeInfo[a]; IF NOT Eq[ts, relation] THEN ERROR Error[IllegalAttribute]; END; END; END. Last edit by: Cattell 17-Sep-81 12:00:20: Reformatted, added CompatibleDomain, lots of random additions, etc. Cattell 29-Oct-81 20:57:39: Inline.LowHalf[QGetP[...]] ain't caught by type checking. Cattell 23-Nov-81 12:42:26: NameElements, etc., etc. Cattell 24-Nov-81 11:39:36: Non-binary surrogate relships. Cattell 24-Nov-81 17:58:58: did QRelationOf[a] instead of GetPT[a, aRelation] in System*etP Cattell 25-Nov-81 17:11:59: StringToValue has to handle vt = a Domain so that QSetFS can be used on entity-valued fields. Cattell 26-Nov-81 14:56:11: Implemented CreateTuple on surrogate tuples, and SurrogateSetF that works on 1st attribute. Cattell 30-Dec-81 14:17:39: Implemented QSetFS on AnyDomainType fields. Cattell 7-Jan-82 13:30 or so: Must return a null value if FetchRelship in normal arm of QGetP fails. Added MakeNullValueOfType. Cattell 7-Jan-82 13:31:33: Added gdfc to MakeNullValueOfType. Also: SetPVBody now checks for IllegalProperty. Cattell 18-Jan-82 18:04:48: Auggh! Zonked by forgetting the CONTINUE in a catch phrase again. Also a Cattell 19-Jan-82 10:23:06: QDestroyEntity didn't work. DestroyIndexEntries not used. Cattell 21-Jan-82 9:44:13: Want to call CreateNameIndexEntry exactly once in CreateEntry, so it can't call QSetP of NameProp. Cattell 21-Jan-82 15:03:23: StringToValue returns NIL for "" => entity conversion. Cattell 22-Jan-82 8:45:58: DestroyLinksTo should only NIL out first attribute of tuples reffing e if they are NOT surrogate tuples. SurrogateSetF didn't work setting first attribute to NIL, either. Cattell 3-Feb-82 10:45:27: QGetFS, QSetFS: use "" for null entity. Cattell 3-Feb-82 10:45:27: DestroyLinksTo should actually destroy the relationships that reference e, not just NIL out the field. Cattell 9-Mar-82 9:00:04: SetMultipleF didn't work with surrogates. DestroySurrogateRelship now sets all but first attribute to be null value of type. Cattell April 20, 1982 8:44 am: Removed TupleSetOf, which assumed a stored tuple: most calls didn't follow this assumption anyway, use QRelationOf instead. Re-inserted DBHeapStorage.Free on de-cached attributes in FreeLastAttributesEntry (Eric Bier, what were you doing?). SurrogateSetF shouldn't be fetching field handles directly, should be doing through GetAttributeInfo. Neither should fh's be stored in Properties, will have to fix this later. Cattell April 21, 1982 4:24 pm: It seems GetAttributeInfo can't call QRelationOf, 'cause t may be attribute entity. Also, can't cache surrogate tuple info, must explicitly check (bug caused by having SurrogateSetF go through GetAttributeInfo above). Cattell April 23, 1982 11:59 pm: StringToValue["", IntType] now returns 0. Cattell April 24, 1982 8:22 pm: GetTypeProp now allows DomainDomain, AttributeDomain, and RelationDomain. QSetP should already allow it. Also: SurrogateSetF checks for MustSetKeyAttributeFirst. Cattell April 29, 1982 8:06 pm: Added DBStats. Cattell April 29, 1982 9:29 pm: Added caching feature to TupleSetOf: it checks for lastTuplesTid. Changed a number of calls to DBStorage.ReadTupleset to use TupleSetOf instead. And for a finishing touch, added a two-tid cache, lastTuplesTid1 and lastTuplesTid2. Cattell May 6, 1982 8:28 am: Check for ValueTypeDomain in QDomainOf. Cattell May 6, 1982 10:26 am: ChangeName[e, foo] now works even if foo is already name of e (was generating NonUniqueEntityName). Cattell May 22, 1982 1:16 pm: Removed caching of last two tuples tids; it wasn't a noticable performance gain. Put in some dictionary update checks. Removed TS. Cattell May 27, 1982 11:23 am: CreateEntity needs to clean up when get NonUniqueEntityName. Similarly for CreateRelship and NonUniqueKeyValue. Cattell June 23, 1982 10:56 am: Added capability to press on if desparate on internal errors, in order to rescue a database. Only added to main procs, for now. Cattell June 25, 1982 10:12 am: Oops! Removed check for typeOfA=AnyDomainType in DestroyLinksFrom yesterday, thinking it wasn't necessary. But AnyDomainType is NOT a member of DomainDomain, rather it is in DataTypeDomain. I suppose it best belongs in the DomainDomain, but if I change this now various people's code will stop working so I'll wait for next major release. Cattell July 13, 1982 1:34 pm: bug in SetF: shouldn't try to FetchRelship to check Key attributes if v is NIL. Cattell July 16, 1982 2:38 pm: Use TRUE and FALSE instead of + and - for SetFS and GetFS on BoolType fields. Cattell July 31, 1982 3:49 pm: GetNameIndex returns NIL if there is no name index; this happens in the DestroyEntity calls during a DestroyDomain, because the B-Tree has already been destroyed. It could also happen if we implement domains with no entity names. In either case, the DeleteFromIndex is just skipped. Cattell August 1, 1982 12:58 pm: Added DeclareEntity and DeclareRelship, defined them in terms of GetEntityOrNil and FetchRelship in DBViewSetImpl. May be able to collapse some of these procs internally, we have many variations. Cattell August 2, 1982 5:40 pm: Changed GetFS and SetFS (actually StringToValue) to deal specially with AnyDomainType. Such values are retrieved and stored as strings of the form "DomainName: EntityName" so that such fields can be read or written by dump/load/edit programs. SetFS still accepts strings with no ":", in which case all domains are searched. Cattell August 24, 1982 12:13 pm: Bug in SurrogateGetF: it was calling GetP[ a, aHandleProp] instead of using GetAttributeInfo. As a result the field handle wasn't deallocated. Cattell October 11, 1982 3:52 pm: instrumented to time critical DBView operations. Cattell October 13, 1982 8:54 am: temp check for deleted relship in GetF. Cattell October 19, 1982 10:20 am: Removed long-standing redundant creation and deletion of index entry in CreateEntity: it would create the tuple with a null name and then call ChangeName, which reset the index entry. Fixed by copying the code from ChangeName into CreateEntity. Cattell November 4, 1982 4:06 pm: Changes for new properties and indices. Added new GetP, SetP, GetPList, SetPList. Added SafeGetP optimized for one case for now, and added calls to it throughout view level. Various other changes required by changes to system schema. Cattell November 12, 1982 10:00 am: Finished updates for new indices: added DestroyAllIndexEntries, DestroyIndexEntries, CreateAllIndexEntries, CreateIndexEntries, etc., for tuples. Problem not yet fixed: when create an entity, need to create index entries for an surrogate relations on its domain. Similarly for destroy. Cattell December 17, 1982 5:53 pm: Begin conversion to new segments, Error signal, etc. Moved many procs to PrivateImpl. Different ErrorCodes for NILArgument and NullifiedArgument. StringToValue must take attr as second arg. Eq gets more complex. Cattell December 30, 1982 11:32 am: Added more caching: relations and tupleset info. Moved TupleSetOf to DBModelPrivate and called GetCachedTupleTS. Added aLink stuff. Cattell on January 28, 1983 1:36 pm: CreateSurrogateRelship should have been calling GetCachedRelationInfo instead of GetFirstAttribute. Will take GetFirstAttribute out of DBModelPrivate, in fact. Cattell & WSH on January 31, 1983 11:43 am: DestroyRelship should have called DestroyIndexEntries BEFORE calling DestroyLinksFrom and DestroyVariableFieldsOf. Odd this was never noticed before. SurrogateDestroyRelship should similarly call DestroyIndexEntries before nulling out the fields. Finally, QDestroyEntity doesn't need to call DestroyEntityIndexEntries because calling DestroyLinksTo calls SurrogateDestroyRelship on surrogates in the entity, and that destroys the index entries. CreateEntityIndexEntries, on the other hand, must be called by CreateEntity because the Relships aren't CREATED in creating an entity. Cattell February 10, 1983 5:08 pm: QDeclareEntity[NIL name, OldOnly] should probably return NIL. Cattell March 14, 1983 1:45 pm: moved IsDomainType to DBModelPrivateImpl. Cattell March 17, 1983 5:57 pm: added Linked/Unlinked/Colocated/Remote link feature throughout; changed args to SetValFromHandle for this, etc. Cattell March 25, 1983 3:31 pm: optimized creation / deletion of index entries on CreateRelship, via additional argument to QSetF so can disable index entry deletion/creation and do it once at the CreateRelship level. Statistics on Walnut showed this to be a significant portion of the time. A signficant amount of time is also being spent in the SetF in DBModelPrivateImpl.DestroyLinksFrom, which can also call QSetF w/o the index entry updates. Changed DestroyRelship to destroy index entries BEFORE NILing out string-valued and entity-valued fields. Changed the procedures that do that latter (in DBModelPrivateImpl) so that they don't try to touch index entries (using new QSetF argument). Cattell April 15, 1983 12:27 pm: added feature that SetF[t, a, NIL] stores a null value of the appropriate type (0, FALSE, etc.) Changed by Willie-Sue on February 15, 1985 <>