-- File: DBModelPrivateImpl.mesa
-- Contents: Implementation of miscellaneous internal procedures for Model level
-- Last edited by:
  -- Rick Cattell on April 28, 1983 12:02 pm
  -- Willie-Sue, January 31, 1983 4:27 pm

DIRECTORY
  Atom,
  Convert,
  ConvertUnsafe,
  DateAndTime USING [Parse, Unintelligible],
  DBEnvironment,
  DBHeapStorage USING [Free],
  DBStorage,
  DBStats,
  DBTuplesConcrete,
  DB,
  DBModel,
  DBModelPrivate,
  Inline,
  Rope,
  System USING[GreenwichMeanTime];

DBModelPrivateImpl: PROGRAM
   IMPORTS Atom, Convert, ConvertUnsafe, DateAndTime, Inline, Rope,
   	DBHeapStorage, DBStats, DBStorage, DB, DBModel, DBModelPrivate
   EXPORTS DB, DBModelPrivate, DBEnvironment =

BEGIN OPEN DB, DBModelPrivate, DBModel; 

desperate: PUBLIC BOOL_ FALSE;

enableAugments: PUBLIC BOOL_ TRUE; -- Turns on cross-segment entity ref feature

-- opaque type objects: concrete in DBTuplesConcrete exported to DBModel

TupleObject: PUBLIC TYPE = DBTuplesConcrete.TupleObject;
EntityObject: PUBLIC TYPE = TupleObject;
RelshipObject: PUBLIC TYPE = TupleObject;

EntitySetObject: PUBLIC TYPE = DBTuplesConcrete.EntitySetObject;
RelshipSetObject: PUBLIC TYPE = DBTuplesConcrete.RelshipSetObject;


-- REFS to opaque type objects

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;

GreenwichMeanTime: TYPE = System.GreenwichMeanTime;


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;
  

-- Checking procedures

CheckEntity: PUBLIC PROC [t: TupleHandle] =
  -- signals IllegalEntity if test fails.
  {[]_ QDomainOf[t]};
  
CheckRelship: PUBLIC PROC [t: TupleHandle] =
  -- signals IllegalRelship if test fails.
  {[]_ 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] =
  -- Returns TRUE if v can be fetched or stored in an attribute of type t.
  -- Takes the optional argument fh only so we can special-case the exception
  -- of aTypeIs which claims to be IntType but returns an entity.
  -- NOTE: GetAttributeInfo also performs the same check in its discrimination,
  -- so this routine need only be called when GetAttributeInfo is not used.
  BEGIN
  WITH v SELECT FROM
   v1: ROPE => RETURN[t=StringType];
   v1: REF INT => RETURN[t=IntType];
   v1: REF BOOL => RETURN[t=BoolType];
   v1: REF GreenwichMeanTime =>RETURN[t=TimeType];
   v1: REF POINTER TO UNSPECIFIED => RETURN[t=RecordType];
   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=StringType OR t=RecordType OR t=BoolType OR t=TimeType THEN RETURN[FALSE];
     CheckDomain[t];
     RETURN[CompatibleDomain[d, t]]
     END;
   ENDCASE => ERROR Error[IllegalValue];
  END;	      

CompatibleDomain: PUBLIC PROC [sub, super: Domain] RETURNS [BOOL] =
  -- Returns TRUE iff sub=super or sub is related through transitive closure of
  -- SubType relations to super.  Should work with system sub or super.
  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;


-- String manipulation

ConvertToUpper: PUBLIC PROC[s: ROPE] RETURNS [ROPE] =
  BEGIN pos: INT_ -1;
  upperProc: SAFE PROC RETURNS [CHAR] = CHECKED 
    {RETURN[Rope.Upper[s.Fetch[pos_ pos+1]]]};
  RETURN[Rope.FromProc[s.Length[], upperProc]]
  END;

StringToValue: PUBLIC PROC[s: ROPE, a: Attribute] RETURNS[Value] =
  -- Converts a string to a value of the type required by a, doing the appropriate
  -- string conversion or a Fetch if type is a Domain.
  BEGIN pos: INT;
  vt: DataType_ V2E[QGetP[a, aTypeIs]];
  SELECT vt FROM
    StringType =>
      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 =>
      -- Must search every domain in the system unless s contains domain name or is empty
      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 {SIGNAL Error[NotFound]; RETURN[NIL]};
        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;
        -- we reach here if NO domain contained an entity named e.
        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 SIGNAL Error[NotFound]; 
      RETURN[e];
      END;
  END;

ParseSegmentName: PUBLIC PROC[path: ROPE] RETURNS [name, ext, server: ROPE] =
  BEGIN
  file: ROPE;
  pos: INT;
  -- First split path into server and file name, and that path contains directory 
  IF path.Fetch[0]='[ THEN
    IF (pos_ path.Find["]"])=-1 THEN ERROR Error[IllegalFileName]
    ELSE {server_ path.Substr[1, pos-1]; file_ path.Substr[pos+1]}
  ELSE
    {file_ path; server_ "Juniper"}; -- default to Juniper
  IF file.Fetch[0]#'< AND NOT server.Equal["Local", FALSE] THEN
    ERROR Error[IllegalFileName]; -- missing directory on Juniper
  -- Now split file into name and ext
  IF (pos_ file.Find["."])=-1 THEN {name_ file; ext_ NIL}
  ELSE {name_ file.Substr[0, pos]; ext_ file.Substr[pos+1]};
  END;

NCode: PUBLIC PROC[v: Value] RETURNS[ROPE] =
  -- Encodes value v as an index key.  All routines constructing index
  --keys or doing key comparisons should call this routine.
  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]_ Inline.HighByte[Inline.HighHalf[i]];  s[1]_ Inline.LowByte[Inline.HighHalf[i]];
      s[2]_ Inline.HighByte[Inline.LowHalf[i]];  s[3]_ Inline.LowByte[Inline.LowHalf[i]];
      RETURN[ConvertUnsafe.ToRope[s]]
      END;
    v1: REF GreenwichMeanTime => -- same as above but don't turn off top bit
      BEGIN i: LONG CARDINAL_ LOOPHOLE[v1^, LONG CARDINAL];
      s: STRING_ [4]; s.length_ 4;
      s[0]_ Inline.HighByte[Inline.HighHalf[i]];  s[1]_ Inline.LowByte[Inline.HighHalf[i]];
      s[2]_ Inline.HighByte[Inline.LowHalf[i]];  s[3]_ Inline.LowByte[Inline.LowHalf[i]];
      RETURN[ConvertUnsafe.ToRope[s]]
      END;
    v1: Entity => -- we index entity-valued attributes by the entity name
      RETURN[ConvertToUpper[QNameOf[v1]]];
    ENDCASE => ERROR Error[NotImplemented]; -- for now
  END;

NCodeForTuple: PROC[t: Relship, i: Index] RETURNS [ROPE] =
  -- Encodes the attributes of t required as factors of index i as ropes, concatenates
  -- the ropes in the order required by the index, and returns the result (for use in
  -- using DBStorage indices, which require a single rope key).  A null byte is placed
  -- between the encoded attribute ropes to preserve the lexicographic priorities of
  -- the attributes.  Note this means null chars may not appear in attributes of type string
  -- if proper orderings are to result.
  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
    StringType => {gdfc: ROPE_ ""; RETURN[gdfc]};
    IntType => RETURN[NEW[INT_ 0]];
    TimeType => RETURN[NEW[GreenwichMeanTime]];
    BoolType => RETURN[NEW[BOOL_ FALSE]];
    ENDCASE => RETURN[NIL];
  END;
  
RopeToInt: PROC[s: ROPE] RETURNS [INT] =
  INLINE BEGIN
  v: Convert.Value_ Convert.Parse[[rope[s]], [signed[0, 10]]].value;
  WITH v SELECT FROM
    error => ERROR Error[MismatchedAttributeValueType];
    signed => RETURN[signed];
    ENDCASE => ERROR;
  END;
  
RopeToTime: PROC[s: ROPE] RETURNS [gmt: System.GreenwichMeanTime] =
  INLINE BEGIN
  gmt_ DateAndTime.Parse[s !
  		DateAndTime.Unintelligible => ERROR Error[MismatchedAttributeValueType]].dt;
  END;


-- Caching procedures and variables    

numberOfCachedAttributes: CARDINAL = 30; --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] =
  -- Looks for x in attribute cache lastAttributes; returns its info if found, else enter it and
  -- then returns its info.  Should not be used for system attributes.
  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 SIGNAL InternalError;
  i_ lastAttributeIndex_ (lastAttributeIndex +1) MOD numberOfCachedAttributes;
  -- Free last entry if it was in use (saved pos in local i, because the following can be recursive)
  IF lastAttributes[i].tid#0 THEN
   {lastAttributes[i].tid _ 0; DBHeapStorage.Free[lastAttributes[i].handle]};
  -- Compute and make a new entry in lastAttributes array
  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] =
  -- We keep a cache of info about relations.  Only call this for STORED relations.
  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 SIGNAL InternalError;
  i_ lastRelationIndex_ (lastRelationIndex +1) MOD numberOfCachedRelations;
  -- Saved pos in local i, because the following can be recursive
  -- Make new entry
  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] =
  -- Only called by proc above; don't call this directly, use the cached information.
  -- Returns the list of indices on r.  Must first find attributes of r, then find any index
  -- factors involving those attributes, then find the indices to which the index factors belong,
  -- removing duplicates (indices with more than one index factor will appear more than once).
  BEGIN il: LIST OF Index_ NIL;
  FOR al: LIST OF Attribute_ VL2EL[QGetPList[r, aRelationOf]], al.rest UNTIL al=NIL DO
    if: IndexFactor_ V2E[QGetP[al.first, ifAttributeOf]];
    IF if#NIL THEN
      il_ AppendIfNew[V2E[QGetP[if, ifIndexIs]], il];
    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] =
  -- We keep a cache of info about Domains.  Only call this for STORED Domains.
  -- The indexedAttributes are attributes of relations that both (1) participate in an index
  -- and (2) are surrogate attributes actually stored as fake attributes of entities in this domain.
  -- The nameIndex is the index on entity names for this domain, and the subDomains are
  -- needed to make DomainSubset go fast.
  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 SIGNAL InternalError;
  i_ lastDomainIndex_ (lastDomainIndex +1) MOD numberOfCachedDomains;
  -- Save pos in local i, because the following can cause recursive calls to ourselves.
  [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] =
  -- Only called by GetCachedDomainInfo; don't call this directly, use the cached information.
  -- Finds relations whose first attribute references d that both (1) participate in an index
  -- and (2) are actually surrogate relations whose attributes are stored in entities in domain d.
  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] =
  -- Returns the list of surrogate relations that have been targetted to domain d.
  -- Only called by proc above; don't call this directly, use the cached information.
  -- First we find the attributes that have been targetted to domain d using a group scan on
  -- aDomainOf, then we find their relations, eliminating duplicates.
  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 = 10; -- 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] =
  -- We keep a cache of the last tuple's tupleset.  Only call this for STORED tuples.
  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;
  -- Make new entry
  lastTuples[i]_ [
    tid: x.tid,
    tupleSet: ts_ DBStorage.ReadTupleset[x] ];
  END;

FlushCaches: PUBLIC PROC[] =
  BEGIN
  FOR i: CARDINAL IN [0..numberOfCachedAttributes) DO
    -- For attributes, must free handle if there is one
    IF lastAttributes[i].tid#0 THEN
      {lastAttributes[i].tid _ 0; DBHeapStorage.Free[lastAttributes[i].handle]};
    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;
 

-- Index-related procedures

GetNameIndex: PUBLIC PROC [d: Domain] RETURNS [Index] =
  -- Returns the name index for domain d.
  {RETURN[GetCachedDomainInfo[d].nameIndex]};

GetDomainIndex: PUBLIC PROC[s: Segment] RETURNS [Index] = 
  -- Returns the domain index for the segment
  {RETURN[DBStorage.RootIndicesFromSegment[s].index1]};

GetRelationIndex: PUBLIC PROC[s: Segment] RETURNS [Index] = 
  -- Returns the relation index for the segment
  {RETURN[DBStorage.RootIndicesFromSegment[s].index2]};

CreateEntityIndexEntries: PUBLIC PROC [e: Entity] =
  -- Finds the name index for e's Domain and insert e into it.
  -- Also creates index entries for any surrogate relations that are actually stored in e.
  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] =
  -- Find the name index for e's Domain and remove e from it.   Does NOT destroy
  -- any surrogate relation index entries; that can be done by DestroyLinksTo.
  BEGIN
  d: Domain_ QDomainOf[e];
  nameIndex: Index_ GetNameIndex[d];
  IF nameIndex#NIL THEN
    -- Non-NIL unless we are destroying this entity in the process of destroying domain
    DBStorage.DeleteFromIndex[nameIndex, NCode[QNameOf[e]], e];
  END;
  
DestroyIndexEntries: PUBLIC PROC [t: Relship, changed: Attribute] =
  -- Deletes any index entries involving changed attribute of t.  For each index on the
  -- relation with an index factor involving the changed attribute, delete the entry in
  -- the index.  Works for both surrogate relations and ordinary ones; in the surrogate case,
  -- we index under the real underlying tuple handle, which is actually the entity. 
  BEGIN i: Index; th: DBStorage.TupleHandle_ GetTupleHandle[t];
  ifs: LIST OF IndexFactor;
  FOR ifs_ GetCachedAttributeInfo[changed].indexFactors, ifs.rest UNTIL ifs=NIL DO
    -- For each index factor involving changed, delete the index entry.
    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] =
  -- Find all relevant indexes for t and delete t from them.  To do this, find the attributes of
  -- t's relation, find index factors involving those attributes, find indices for those index factors,
  -- and destroy index entries for them.  The relationship t may be an ordinary or surrogate
  -- relationship; GetTupleHandle below returns the entity handle in the latter case, the
  -- relationship handle in the former case, so the right thing happens.
  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
  -- the tupleset with an index factor involving the changed attribute, re-enter the
  -- tuple in the index.  Use DestroyIndexEntries above to destroy any old entry.
  BEGIN i: Index; th: DBStorage.TupleHandle_ GetTupleHandle[t];
  ifs: LIST OF IndexFactor;
  FOR ifs_ GetCachedAttributeInfo[changed].indexFactors, ifs.rest UNTIL ifs=NIL DO
    -- For each index factor involving changed, delete the index entry.
    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] =
  -- Find all existing indexes for t's tupleset and insert t into them.
  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] =
  -- NIL out variable-length string attributes so that DBStorage deletes "string tuples" associated
  -- with t for strings that overflow the length specified for the attribute.  Does NOT create
  -- or destroy any index entries associated with the attribute, the caller must do that.
  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]]=StringType THEN QSetF[t, a, NIL, FALSE] ENDLOOP;
  END;
  
DestroyLinksTo:  PUBLIC PROC[e: Entity] =
  -- Destroys any references to e by following backlinks (groups) to the tuples whose
  -- fields point to t, and destroying those tuples.  Also destroys tuples that do NOT
  -- reference e via a group (i.e., with aUnlinkedIs TRUE); we get these because
  -- QGetAllRefAttributes returns unlinked attributes as well.
  -- Note: DBModelGlobalImpl.DestroyDictionaryEntity depends upon this procedure
  -- working for dictionary entities as well as ordinary client entities.
  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] =
  -- Destroys backlinks to t (in groups) by storing NIL in those attributes (a) of t
  -- that point to entities (the Storage level removes the corresponding backlinks).
  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
      -- This NILs out field whether it was link field or string field (want to either way).
      -- We disable update of index entries for efficiency, we'll destroy them later.
      QSetF[t, a, NIL, FALSE ! InternalError => TRUSTED {IF desperate THEN CONTINUE}];
    ENDLOOP;
  END;

TranslateToSegment: PUBLIC PROC[e: Entity, of: TupleHandle] RETURNS [Entity] =
  -- If e is not in of's segment, create a stub for it in that segment: an entity in the domain
  -- with the name "!".  The entity name is "<seg>:<foo>:<baz>" where <seg> is the name of
  -- the "to" segment, <foo> is the domain of e, and <baz> is the name of e. 
  BEGIN
  IF SameSegment[e, of] THEN RETURN[e]
  ELSE
    BEGIN
    s: Segment_ DBStorage.SegmentFromTuple[e];
    to: Segment_ QSegmentOf[of];
    IF enableAugments THEN -- Auto-create cross-segment reference
      RETURN[QDeclareEntity[QDeclareDomain["!", s, NewOrOld],
        Rope.Cat[Atom.GetPName[to], ":", QNameOf[QDomainOf[e]], ":", QNameOf[e]] ]]
    ELSE -- We don't allow refs to entites in other segments, this feature disabled
      ERROR Error[MismatchedSegment];
    END;
  END;


-- Handy entity list and set procedures
  
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] = {
  -- Returns all subDomains of d but not d itself
  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] =
  -- returns all super-Domains of d but not d itself
  {RETURN[TransitiveClosure[d, T2CT[dSubTypeIs], T2CT[dSubTypeOf]]]};

TransitiveClosure: PUBLIC PROC[e: Entity, from, to: Attribute] RETURNS [LIST OF Entity] =
  -- Find all entities referenced by relships via the to attribute whose from attribute refns e,
  -- then all entities referenced by relships via the to attribute whose from
  -- attribute reference one of those, and so on, return the result as a list.
  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] =
  -- Returns the first attribute of relation "of" except for "notCounting".  Uses
  -- GetCacheRelationInfo to get attributes, unless "of" is a system relation.
  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] =
   -- Add entity e to list el if it is not already in the list.
   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;  


-- Miscellaneous procs

GetTypeAndLink: PUBLIC PROC [a: Attribute] RETURNS [type: Entity, link: LinkType] =
  -- The use of aTypeIs is unusual.  If aTypeCodeProp > 0, the type is the system entity whose
  -- tid is the aTypeCodeProp.  Else the type is the domain referenced by aTypeEntityProp,
  -- and aTypeCodeProp= - LOOPHOLE[LinkType, INTEGER], distinguishable since <= 0.
  -- Must check explicitly for system attribute because SafeGetP won't handle aTypeEntityProp
  -- and aTypeCodeProp on system entities (it would be too inefficient to NEW INTs and BOOLs).
  BEGIN
  vtTid: INT;
  IF IsSystem[a] THEN RETURN[T2SAT[a].vType, Linked];
  vtTid_ V2I[SafeGetP[a, aTypeCodeProp]];
  IF vtTid<=0 THEN
    RETURN [V2E[SafeGetP[a, aTypeEntityProp]], Inline.LowHalf[-vtTid]]
  ELSE IF vtTid<=AnyDomainTypeID THEN
    RETURN[DBModelPrivate.systemTupleVec[vtTid], Linked]
  ELSE ERROR InternalError;
  END;

SetTypeAndLink: PUBLIC PROC [a: Attribute, type: Entity, link: LinkType] =
  -- See comment above about encoding of aTypeCodeProp and aTypeEntityProp.
  -- Also note: if attribute is not linked, must set aUnlinked to domain so can find later.
  BEGIN
  WITH type^ SELECT FROM
    vt: TupleObject[entity] => -- Simple datum type: StringType, IntType, etc.
       []_ SafeSetP[a, aTypeCodeProp, NEW[INT_ vt.tid]];
    vt: TupleObject[stored] => {
      -- Attribute defined on client-defined domain.  Store domain in the aTypeEntity field.
      []_ 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] =
  -- Returns the target entity's tuple handle if t is surrogate, else just returns t.
  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] =
  -- Takes information about an attribute, returns a field descriptor for values of the given
  -- attribute.
  BEGIN
  len: CARDINAL_ Inline.LowHalf[length]; -- sigh
  SELECT vt FROM
    BoolType  => RETURN[[OneWord[]]];
    IntType => RETURN[[TwoWord[]]];
    TimeType => RETURN[[TwoWord[]]];
    StringType => 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;


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 Inline.LowHalf[vtTid] instead of Inline.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.