-- FeaturePST.mesa

-- A generic package to organize list elements
-- in a priority search tree by the intervals they cover,
-- and to search by interval.

-- last modified by E. McCreight, November 8, 1982  12:49 PM
-- written by E. McCreight, February 8, 1982  11:51 AM

DIRECTORY
  ppdefs,
  ChipNetDefs,
  InlineDefs;

FeaturePST: DEFINITIONS
  IMPORTS InlineDefs =
  BEGIN
  checkTree: PRIVATE BOOLEAN = FALSE;

  Domain: PRIVATE TYPE = ChipNetDefs.Coord;
  Interval: PRIVATE TYPE = ChipNetDefs.Interval;
    -- assumes [Interval.min..Interval.max)
  domainOffset: PRIVATE LONG CARDINAL = 20000000000B;
    -- between RadixKey and Domain
  Item: PRIVATE TYPE = ChipNetDefs.FeaturePtr;
  nullItem: PRIVATE Item = NIL;

  RadixKey: PRIVATE TYPE = LONG CARDINAL;
  RadixIndex: PRIVATE TYPE = [0..31);

  FeaturePSTHandle: TYPE = LONG POINTER TO PSTObject _ NIL;
  PSTHandle: PRIVATE TYPE = FeaturePSTHandle;
  PSTObject: PRIVATE TYPE = RECORD [
    zone: UNCOUNTED ZONE,
    freeNodes: PSTBinNodePtr _ NIL,
      -- free ones linked through halves[lower]
    root: PSTNodePtr
    ];

  PSTNodePtr: PRIVATE TYPE = LONG POINTER TO PSTNode _
    NIL | NULL;
  PSTNode: PRIVATE TYPE = RECORD[
    SELECT target: * FROM
      nil => NULL,
      leaf => [item: Item],
      internal => [pst: PSTBinNodePtr],
        -- never NIL, except in free list
      ENDCASE] _ [nil[]];

  Half: PRIVATE TYPE = {lower, upper};

  PSTBinNodePtr: PRIVATE TYPE = LONG POINTER TO
    PSTBinNode _ NIL;
  PSTBinNode: PRIVATE TYPE = RECORD[
    -- This priority search tree is a kind of Patricia
    -- tree (see Knuth v. 3 p. 490).
    -- Bits [0..uLen) of int.max of all Items
    -- in this subtree must match each other and that of
    -- vMin.  lower vs upper is determined by bit uLen.
    -- Of all Items meeting these criteria, the one with minimal
    -- int.min appears in vMin.
    vMin: Item,
    uLen: RadixIndex,
    halves: ARRAY Half OF PSTNode];


  NewFeaturePST: PROCEDURE[zone: UNCOUNTED ZONE]
    RETURNS[PSTHandle];

  DestroyFeaturePST: PROCEDURE[p: PSTHandle]
    RETURNS[PSTHandle];

  InsertFeaturePST, DeleteFeaturePST: PROCEDURE[p: PSTHandle, item: Item];

  CouldntDeleteFeaturePST: SIGNAL;

  MaxFeatureInCover: PROCEDURE[p: PSTHandle,
    d: Domain] RETURNS[covered: BOOLEAN, item: Item];

  SearchFeaturePST: PROCEDURE[p: PSTHandle,
    int: Interval, touch: PROCEDURE[item: Item]];

  ClassifyFeaturePSTInterval: PROCEDURE[p: PSTHandle,
    int: Interval,
    covered: PROCEDURE[int: Interval, repItem: Item],
    gap: PROCEDURE[int: Interval]];

  NullFeatureCovered: PROCEDURE[int: Interval, repItem: Item];

  NullFeatureGap: PROCEDURE[int: Interval];

  highBit: WORD = 100000B;
  allBits: WORD = 177777B;

-- The following code knows that a RadixKey is a
-- LONG CARDINAL.

  TreeHalf: PRIVATE PROCEDURE[item: Item, pref: RadixIndex]
    RETURNS[Half] = INLINE
    BEGIN OPEN InlineDefs;
    k: RadixKey _ RadixMaxKey[item];
    SELECT pref FROM
     >15 =>
      RETURN[
        (IF BITAND[LowHalf[k], BITSHIFT[highBit, 16-pref]]=0
        THEN lower
        ELSE upper)];
     ENDCASE =>
      RETURN[
        (IF BITAND[HighHalf[k], BITSHIFT[highBit, -pref]]=0
        THEN lower
        ELSE upper)];
    END; -- of TreeHalf


  Above: PRIVATE PROCEDURE[y: Domain, p: PSTBinNodePtr]
    RETURNS[BOOLEAN] = INLINE
    BEGIN OPEN InlineDefs;
    ky: RadixKey _ ToRadixKey[y];
    kn: RadixKey _ RadixMaxKey[p.vMin];
    kn _ SELECT p.uLen FROM
      >15 =>
        LOOPHOLE[
          LongNumber[num[highbits: HighHalf[kn],
            lowbits: BITOR[LowHalf[kn],
              BITSHIFT[allBits, 16-p.uLen]]]],
          RadixKey],
      ENDCASE =>
        LOOPHOLE[
          LongNumber[num[highbits: BITOR[HighHalf[kn],
              BITSHIFT[allBits, -p.uLen]],
            lowbits: allBits]],
          RadixKey];
    RETURN[kn<=ky];
    END; -- of Above


  PrefixTable: PRIVATE TYPE = PACKED ARRAY [0..256) OF [0..8];
    -- t[i] is the number of high-order 0 bits in
    -- an 8-bit representation of i
  PrefixTablePtr: PRIVATE TYPE =
    LONG POINTER TO PrefixTable _ NIL;

  CommonLen: PRIVATE PROCEDURE[i1, i2: Item,
    pt: PrefixTablePtr] RETURNS[RadixIndex] = INLINE
    BEGIN OPEN InlineDefs;
    k1: RadixKey _ RadixMaxKey[i1];
    k2: RadixKey _ RadixMaxKey[i2];
    d: WORD;
    result: RadixIndex;
    IF (d _ BITXOR[HighHalf[k1], HighHalf[k2]])=0 THEN
      BEGIN
      IF (d _ BITXOR[LowHalf[k1], LowHalf[k2]])=0 THEN
        RETURN[LAST[RadixIndex]]
      ELSE result _ 16;
      END
    ELSE result _ 0;
    IF BITAND[d, 177400B]=0 THEN result _ result+8
      ELSE d _ BITSHIFT[d, -8];
    RETURN[result+pt[d]];
    END; -- of CommonLen

  Shallower: PRIVATE PROCEDURE[i1, i2: Item] RETURNS
    [BOOLEAN] = INLINE
    {RETURN[SELECT Min[i1]-Min[i2] FROM
      <0 => TRUE,
      >0 => FALSE,
      ENDCASE => Max[i2]<=Max[i1]
    ]};

  RadixMaxKey: PRIVATE PROCEDURE[item: Item]
    RETURNS[RadixKey] = INLINE
    {RETURN[ToRadixKey[Max[item]]]};

  ToRadixKey: PRIVATE PROCEDURE[d: Domain]
    RETURNS[RadixKey] = INLINE
    {RETURN[LOOPHOLE[d, RadixKey]+domainOffset]};


  Min: PRIVATE PROCEDURE[item: Item] -- closed lower bound
    RETURNS[Domain] = INLINE
    {RETURN[item.cover.y1]};

  Max: PRIVATE PROCEDURE[item: Item] -- open upper bound
    RETURNS[Domain] = INLINE
    {RETURN[item.cover.y2]};

  END. -- of FeaturePST