<> <> <> <> <> <> <> <> DIRECTORY Ascii USING[Upper], Basics, BasicTime, ConvertUnsafe, DBCommon, DBStorage, DBStats, DBDefs, DB, DBModel, DBModelPrivate, DBModelSchema, Rope; DBModelPrivateImpl: CEDAR PROGRAM IMPORTS Ascii, Basics, BasicTime, ConvertUnsafe, Rope, DBStorage, DB, DBDefs, DBModel, DBModelPrivate, DBModelSchema EXPORTS DBModelPrivate = BEGIN OPEN DB, DBCommon, DBDefs, DBModel, DBModelPrivate; desperate: PUBLIC BOOL_ FALSE; MaxDataTypeID: LONG CARDINAL = 25; <> IsDomainType: PUBLIC PROC [vt: DataType] RETURNS [BOOL] = BEGIN SELECT vt FROM IntType, RopeType, BoolType, TimeType, RecordType => RETURN[FALSE]; ENDCASE => RETURN[TRUE] 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; NCode: PUBLIC PROC[v: Value] RETURNS[ROPE] = TRUSTED <> <> BEGIN WITH v: v SELECT FROM null => RETURN[NIL]; -- pass NILs right through for now rope => BEGIN CheckForNulls[v.value]; RETURN[ConvertToUpper[v.value]] END; integer => BEGIN i: LONG CARDINAL_ LOOPHOLE[v.value, 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; time => -- same as above but don't turn off top bit BEGIN i: LONG CARDINAL_ BasicTime.ToPupTime[v.value]; 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; entity => { -- we index entity-valued attributes by the entity name IF NullEntity[v.value] THEN RETURN[NIL];-- pass NILs right through for now RETURN[ConvertToUpper[GetCachedEntityInfo[SegmentOf[v.value], v.value].name]] }; boolean => IF v.value THEN RETURN["TRUE"] ELSE RETURN["FALSE"]; ENDCASE => ERROR Error[NotImplemented]; -- for now END; CheckForNulls: PROC[s: ROPE] = INLINE BEGIN i: LONG CARDINAL _ 0; last: LONG CARDINAL _ Rope.Size[s]; WHILE (i _ i+1) < last DO IF Rope.Fetch[s,i]=0C OR Rope.Fetch[s,i]=377C THEN ERROR DB.Error[IllegalString] ENDLOOP; END; NCodeForTuple: PROC[t: Relship, i: Index] RETURNS [ROPE] = <> <> <> <> <> <> BEGIN s: ROPE_ ""; FOR ifs: LIST OF IndexFactor_ VL2TL[QGetPList[i, ifIndexOf]], ifs.rest UNTIL ifs=NIL DO if: IndexFactor_ ifs.first; s_ Rope.Cat[s, NCode[QGetF[t, DBModelSchema.TupleToAttribute[V2E[QGetP[if, ifAttributeIs]]]]], "\000"]; ENDLOOP; RETURN[s]; END; MakeNullValueOfType: PUBLIC PROC [vt: DataType] RETURNS[Value] = BEGIN SELECT vt FROM RopeType => {gdfc: ROPE_ ""; RETURN[S2V[gdfc]]}; IntType => RETURN[I2V[0]]; TimeType => RETURN[T2V[BasicTime.nullGMT]]; BoolType => RETURN[B2V[FALSE]]; ENDCASE => RETURN[[null[]]]; END; <> GetDomainIndex: PUBLIC PROC[s: SegmentHandle] RETURNS [DBStorage.IndexHandle] = <> {RETURN[DBStorage.RootIndicesFromSegment[s.segment][DBCommon.domainIndex]]}; GetRelationIndex: PUBLIC PROC[s: SegmentHandle] RETURNS [DBStorage.IndexHandle] = <> {RETURN[DBStorage.RootIndicesFromSegment[s.segment][DBCommon.relationIndex]]}; CreateEntityIndexEntries: PUBLIC PROC [e: Entity] = <> <> BEGIN name: ROPE; d: Domain; nameIndex: Index; surrRelns: LIST OF Relation; dt: TupleHandle; [name, d] _ GetCachedEntityInfo[SegmentOf[e], e]; dt _ DBModelSchema.GetDomainTuple[d]; nameIndex _ PV2E[SafeGetP[dt, dIndexProp]]; DBStorage.InsertIntoIndex[nameIndex, NCode[S2V[name]], e]; FOR surrRelns_ GetIndexedSurrogates[dt], surrRelns.rest UNTIL surrRelns=NIL DO r: Relation_ surrRelns.first; fakeSurrogateRelship: SurrogateRelshipHandle_ SurrogateCreateRelship[r]; fakeSurrogateRelship.entity_ e; CreateAllIndexEntries[fakeSurrogateRelship]; ENDLOOP; END; DestroyEntityIndexEntries: PUBLIC PROC [e: Entity] = <> <> BEGIN name: ROPE; d: Domain; nameIndex: Index; [name, d] _ GetCachedEntityInfo[SegmentOf[e], e]; nameIndex _ PV2E[SafeGetP[DBModelSchema.GetDomainTuple[d], dIndexProp]]; IF nameIndex#NIL THEN <> DBStorage.DeleteFromIndex[nameIndex, NCode[S2V[name]], e]; END; CreateIndexEntries: PUBLIC PROC [t: Relship, indexList: LIST OF Index] = BEGIN th: TupleHandle_ GetTupleHandle[t]; FOR is: LIST OF Index _ indexList, is.rest UNTIL is=NIL DO DBStorage.InsertIntoIndex[is.first, NCodeForTuple[t, is.first], th]; ENDLOOP; END; CreateAllIndexEntries: PUBLIC PROC [t: Relship] = <> BEGIN i: Index; th: TupleHandle_ GetTupleHandle[t]; al: LIST OF Attribute _ QRelationOf[t].attributes; FOR il: LIST OF Index_ GetRelationIndices[al], il.rest UNTIL il=NIL DO i_ il.first; DBStorage.InsertIntoIndex[i, NCodeForTuple[t, i], th]; ENDLOOP; END; DestroyIndexEntries: PUBLIC PROC [t: Relship, indexList: LIST OF Index] = BEGIN th: TupleHandle_ GetTupleHandle[t]; FOR is: LIST OF Index _ indexList, is.rest UNTIL is=NIL DO DBStorage.DeleteFromIndex[is.first, NCodeForTuple[t, is.first], th]; ENDLOOP; END; DestroyAllIndexEntries: PUBLIC PROC [t: Relship, r: Relation] = <> <> <> <> <> BEGIN i: Index; th: TupleHandle_ GetTupleHandle[t]; FOR il: LIST OF Index_ GetRelationIndices[r.attributes], il.rest UNTIL il=NIL DO i_ il.first; DBStorage.DeleteFromIndex[i, NCodeForTuple[t, i], th]; ENDLOOP; END; DestroyLinksTo: PUBLIC PROC[e: Entity] = <> <> <> <> <> <> BEGIN al: LIST OF Attribute; rs: RelshipSet; rsi: CARDINAL; r: Relship; ev: Value _ E2V[e]; al_ QGetAllRefAttributes[e]; IF al # NIL AND DBModelSchema.InvalidAttribute[al.first] THEN ERROR Error[InvalidSchema]; [rs, rsi] _ GetNewRelshipSet[]; FOR alT: LIST OF Attribute_ al, alT.rest UNTIL alT=NIL DO rs_ QRelationSubset[alT.first.relation, LIST[[alT.first, ev]], First, rs]; WHILE (r_ QNextRelship[rs])#NIL DO QDestroyRelship[r] ENDLOOP; QReleaseRelshipSet[rs]; ENDLOOP; ReturnRelshipSet[rsi]; END; GetRelationIndices: PROC [attributes: LIST OF Attribute] RETURNS [LIST OF Index] = BEGIN il: LIST OF Index_ NIL; FOR al: LIST OF Attribute_ attributes, al.rest UNTIL al=NIL DO ifl: LIST OF IndexFactor_ VL2TL[QGetPList[DBModelSchema.GetAttributeTuple[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; GetIndexedSurrogates: PROC [t: TupleHandle] RETURNS [indexedSurrogates: LIST OF Relation] = TRUSTED BEGIN surrogates: LIST OF Relation_ GetSurrogates[t]; indexedSurrogates_ NIL; FOR surrogatesT: LIST OF Relation_ surrogates, surrogatesT.rest UNTIL surrogatesT=NIL DO surrAttrs: LIST OF Attribute _ surrogatesT.first.attributes; FOR surrAttrs_ surrAttrs, surrAttrs.rest UNTIL surrAttrs=NIL DO v: PrivateValue = SafeGetP[DBModelSchema.GetAttributeTuple[surrAttrs.first], ifAttributeOf]; WITH v: v SELECT FROM public => WITH v.val SELECT FROM null => NULL; ENDCASE => GOTO ThisRelation; ENDCASE => GOTO ThisRelation; ENDLOOP; REPEAT ThisRelation=> indexedSurrogates_ CONS[surrogatesT.first, indexedSurrogates]; ENDLOOP; END; GetSurrogates: PROC [t: TupleHandle] RETURNS [LIST OF Relation] = <> <> <> BEGIN rl: LIST OF Relation_ NIL; FOR al: LIST OF Attribute_ VL2AL[QGetPList[t, aDomainOf]], al.rest UNTIL al=NIL DO IF DBModelSchema.InvalidAttribute[al.first] THEN ERROR Error[InvalidSchema]; rl_ AppendIfNewR[al.first.relation, rl]; ENDLOOP; RETURN[rl] END; AppendIfNew: PROC [e: Entity, il: LIST OF Index] RETURNS [LIST OF Index] = <> BEGIN ilT: LIST OF Index; FOR ilT_ il, ilT.rest UNTIL ilT=NIL DO IF EntityEq[ilT.first, e] THEN RETURN[il] ENDLOOP; RETURN[CONS[e, il]]; END; AppendIfNewR: PROC [r: Relation, rl: LIST OF Relation] RETURNS [LIST OF Relation] = <> BEGIN rlT: LIST OF Relation; FOR rlT_ rl, rlT.rest UNTIL rlT=NIL DO IF QRelationEq[rlT.first, r] THEN RETURN[rl] ENDLOOP; RETURN[CONS[r, rl]]; END; <> EmptyDomain: PUBLIC PROC [d: Domain] RETURNS [b: BOOLEAN] = BEGIN es: EntitySet; esi: CARDINAL; [es, esi] _ GetNewEntitySet[]; es _ QDomainSubset[d: d, es: es]; b_ NullEntity[QNextEntity[es]]; QReleaseEntitySet[es]; ReturnEntitySet[esi]; END; EmptyRelation: PUBLIC PROC [r: Relation] RETURNS [b: BOOLEAN] = BEGIN rs: RelshipSet; rsi: CARDINAL; [rs, rsi] _ GetNewRelshipSet[]; rs _ QRelationSubset[r: r, rs: rs]; b_ NullRelship[QNextRelship[rs]]; QReleaseRelshipSet[rs]; ReturnRelshipSet[rsi]; END; NumberOfAttributes: PUBLIC PROC [r: Relation] RETURNS [n: CARDINAL] = BEGIN count: INT_ 0; IF DBModelSchema.InvalidRelation[r] THEN ERROR Error[InvalidSchema]; FOR al: LIST OF Attribute _ r.attributes, al.rest UNTIL al=NIL DO count_ count+1 ENDLOOP; RETURN[count] END; GetFirstAttribute: PUBLIC PROC [ of: Relation, notCounting: Attribute_ NIL] RETURNS [a: Attribute] = <> BEGIN ENABLE Error => TRUSTED {IF code=NILArgument THEN {a_ NIL; CONTINUE}}; IF QAttributeEq[notCounting, of.attributes.first] THEN RETURN[of.attributes.rest.first] ELSE RETURN[of.attributes.first]; END; <> GetTypeAndLink: PUBLIC PROC [a: TupleHandle] RETURNS [type: DataType, link: LinkType] = < 0, the type is the system entity whose>> <> <> <> <> BEGIN vtTid: INT; pos: LONG CARDINAL; vtTid_ PV2I[SafeGetP[a, aTypeCodeProp]]; IF vtTid<=0 THEN RETURN[EntityToDataType[PV2E[SafeGetP[a, aTypeEntityProp]]], LOOPHOLE[Basics.LowHalf[-vtTid]]] ELSE IF (pos_ vtTid)<=MaxDataTypeID THEN RETURN[EntityToDataType[DBModelPrivate.systemTupleVec[pos]], Linked] ELSE ERROR InternalError; END; SetTypeAndLink: PUBLIC PROC [a: TupleHandle, type: DataType, link: LinkType] = <> <> BEGIN segment: SegmentHandle _ IF IsSystem[a] THEN NIL ELSE SegmentOf[a]; typeEntity: Entity _ DataTypeToEntity[type, segment]; SELECT type FROM RopeType, IntType, TimeType, BoolType, AnyDomainType, RecordType => []_ SafeSetP[a, aTypeCodeProp, I2PV[typeEntity.tid]]; ENDCASE => { <> []_ SafeSetP [a, aTypeCodeProp, I2PV[- LOOPHOLE[link, INTEGER]]]; []_ SafeSetP[a, aTypeEntityProp, E2PV[typeEntity]]; IF link=Unlinked OR link=Remote THEN -- set aUnlinked so can find refs by group scan []_ SafeSetP[a, aUnlinkedIs, E2PV[typeEntity]] }; END; SegmentOf: PUBLIC PROC[t: TupleHandle] RETURNS [SegmentHandle] = { CheckNullified[t]; IF IsSystem[t] THEN RETURN[NIL]; RETURN[SegmentToHandle[DBStorage.SegmentFromTuple[t]]] }; CheckNullified: PROC [p: TupleHandle] = INLINE { IF p=NIL THEN ERROR DB.Error[NILArgument] ELSE IF p.tid=NoTID THEN ERROR DB.Error[NullifiedArgument] }; GetTupleHandle: PROC [t: Relship] RETURNS [TupleHandle] = <> TRUSTED BEGIN WITH t SELECT FROM t1: TupleHandle => RETURN[t1]; t2: SurrogateRelshipHandle => RETURN[t2.entity]; ENDCASE => ERROR InternalError; END; MakeFD: PUBLIC PROC [vt: DataType, length: INT_ 0, link: BOOL_ TRUE, a: TupleHandle_ 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; VL2AL: PROC[vl: LIST OF Value] RETURNS [LIST OF Attribute] = { IF vl = NIL THEN RETURN[NIL] ELSE RETURN[CONS[DBModelSchema.TupleToAttribute[V2E[vl.first]], VL2AL[vl.rest]]] }; 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.