(*# call(o_a_size=>off) *)
(*# call(o_a_copy=>off) *)
(*# call(near_call=>on) *)
IMPLEMENTATION MODULE Btree;
(*
        Copyright (C) 1988..1991 Jensen & Partners International
*)


IMPORT CoreMem, FIOx, Lib, Str;
FROM SYSTEM IMPORT Seg, Ofs, ADR;
(*%T _mthread *)
IMPORT Process;
(*%E *)


CONST
    (* ----------------------------------------------------------- *)
    (* For v3.0, the embedded version number has NOT been changed. *)
    (* See BTREE.DOC for details on compatability issues.          *)
    (* ----------------------------------------------------------- *)
  ThisVersion     = 200;  (* See Open() procedure for testing *)
  Nil             = MAX(LONGCARD);
  SectorSize      = 512;
  PageSize        = SectorSize*2;
  GuardV1         = 123456789;
  GuardV2         = 987654321;
  FileDataWrSize  = 32;
  IndexDataWrSize = 32;


TYPE
  LockType        = (Implicit,Explicit,AllImplicit,AllLocks);
  LockRec         = RECORD
                      Position  : LONGCARD;
                      ICnt,ECnt : SHORTCARD;
                      In        : IHandle;
                    END;
  LocksArray      = ARRAY [0..LockQSize-1] OF LockRec;
  FileType        = (IndexSlot,DataSlot,FreeSlot);
  KeyType         = ARRAY [1..MaxKeySize] OF BYTE;
  PageRefRec      = RECORD
                      Page : LONGCARD;
                      Rec  : CARDINAL;
                      Cnt  : CARDINAL;
                    END;
  PageRef         = RECORD
                      Height : CARDINAL;
                      Refs   : ARRAY [1..8191] OF PageRefRec;  (* last *)
                    END;
  PageRefPtr      = POINTER TO PageRef;
(* *************************************************************************
   In the following two records (IndexData and IndexFile), special
   considerations are required for some of the fields...
     (*I*)   Denotes fields which must be checked against the contents of
             the file when the file is opened.
     (*V*)   Denotes fields that reflect the current status of the file,
             and thus must be read after the file is locked and written
             before the file is unlocked.
     (*F*)   Denotes fields which, if changed by a process other than the
             current one, require that the current process flush its
             buffers.
  ************************************************************************* *)
  IndexDataWr     = RECORD
                      CASE : BOOLEAN OF
                          FALSE : RecordCnt : LONGCARD;                  (*V*)
                                  CASE Ft : FileType OF                  (*I*)
                                      DataSlot  : RecordSize : CARDINAL; (*I*)
                                    | IndexSlot : WriteCnt,              (*F*)
                                                  TopPage    : LONGCARD; (*V*)
                                                  Depth,                 (*V*)
                                                  KeySize,               (*I*)
                                                  N2,                    (*I*)
                                                  N22        : CARDINAL; (*I*)
                                                  DupKey     : BOOLEAN;  (*I*)
                                  END;
                        | TRUE  : FILL : ARRAY[1..IndexDataWrSize] OF BYTE;
                      END;
                    END;
  IndexFileWr     = RECORD
                      CASE : BOOLEAN OF
                          FALSE : HeaderSize : CARDINAL;            (*1*)(*I*)
                                  FileSize   : LONGCARD;            (*2*)(*V*)
                                  Version    : CARDINAL;                 (*I*)
                                  FreeList   : LONGCARD;                 (*V*)
                                  IndexCount : CARDINAL;                 (*I*)
                                  Mode       : AccessMode;               (*I*)
                                  PageSz,                                (*I*)
                                  MaxKeySz   : CARDINAL;                 (*I*)
                        | TRUE  : FILL : ARRAY[1..FileDataWrSize] OF BYTE;
                      END;
                    END;
  IndexData       = RECORD
                      LastDataRef: LONGCARD;
                      NextIndx   : IHandle;
                      LastErr    : Errors;
                      ErrorNest  : CARDINAL;
                      ihLock     : LockRec;
                      CASE Ft : FileType OF
                        | DataSlot  : Sync        : BOOLEAN;
                                      bufSize     : CARDINAL;
                                      bufPtr      : ADDRESS;
                        | IndexSlot : OldWriteCnt : LONGCARD;
                                      DataPtr     : IHandle;
                                      PageRefs    : PageRefPtr;
                                      PageLevel   : CARDINAL;
                                      CompFct     : CompareFunction;
                                      KeyFct      : KeyFunction;
                                      LastKeyOK   : BOOLEAN;
                                      LastKey     : KeyType;
                                      LastKeyRef  : LONGCARD;
                      END;
                      iwr        : POINTER TO IndexDataWr;
                    END;
  IndexFile       = RECORD
                      G1         : LONGCARD;
                      ReadOnly,
                      Buffered,
                      WriteThru  : BOOLEAN;  (* not fully implemented *)
                      Locks      : LocksArray;
                      fhLock     : LockRec;
                      FHandle    : CARDINAL;
                      fwr        : POINTER TO IndexFileWr;
                      G2         : LONGCARD;              (* 2nd to last *)
                      Id         : ARRAY[0..346] OF IndexData;   (* last *)
                    END;
  IndexItem       = RECORD
                      IP  : LONGCARD;
                      DP  : LONGCARD;
                      Key : KeyType;
                    END;
  TPage           = RECORD
                      CASE : BOOLEAN OF
                          FALSE : ICount : CARDINAL;
                                  IItem  : IndexItem;
                        | TRUE  : FILL   : ARRAY [1..PageSize] OF BYTE;
                      END;
                    END;
(*# save *)
(*# data(near_ptr=>off) *)
  TPagePointer    = POINTER TO TPage;
(*# restore *)
  xTPage          = RECORD
                      CASE : BOOLEAN OF
                          FALSE : ICount : CARDINAL;
                                  IItem  : IndexItem;
                        | TRUE  : FILL   : ARRAY [1..PageSize] OF BYTE;
                      END;
                      extra  : IndexItem;
                    END;
  BufferPages     = RECORD
                      iH     : IHandle;
                      Wr     : BOOLEAN;
                      Page   : LONGCARD;
                      Buf    : TPagePointer;
                    END;
  FindMode        = (Fnd,Ins,Src,Idx,Rec);
                      (* Fnd = first exact key match
                         Ins = place to insert into
                         Src = first exact key match or greater
                         Idx = exact entry (i.e. DataPos also)
                         Rec = exact entry (i.e. DataPos also) or greater *)
  WalkMode        = (Forward,Backward);
  ErrorStrs       = ARRAY Errors,[0..31] OF CHAR;


CONST
  IndexDataSize = SIZE(IndexData);
  IndexFileSize = VSIZE(IndexFile.G2)+IndexDataSize;
  ErrorStr  = ErrorStrs('No Error',
                        '#: Bad Open',
                        'Bad # Slot',
                        'Not a FHandle',
                        'Not an IHandle',
                        'Not a Data File',
                        'Not an Index File',
                        '#: Bad Index',
                        '#: Wrong Record Size',
                        'Key Too Large',
                        'Duplicated Key',
                        '#: Access Mode Not Supported',
                        'Error During Read',
                        'Error During Write',
                        "Couldn't Acquire Lock",
                        'Item Must Already Be Locked',
                        'File I/O Error',
                        'Lock Table Overflow',
                        'Unknown Error');
  FileDataCheck  = FileDataWrSize=SIZE(IndexFileWr);
  IndexDataCheck = IndexDataWrSize=SIZE(IndexDataWr);
(*%F FileDataCheck *)
WARNING - FileDataWrSize must be equal to SIZE(FileDataWr);
(*%E *)
(*%F IndexDataCheck *)
WARNING - IndexDataWrSize must be equal to SIZE(IndexDataWr);
(*%E *)


  MODULE inline;

  EXPORT MemMove, MemFastMove, AddAddr, IncAddr, DecAddr;

  TYPE
    A2 = ARRAY[0..1] OF SHORTCARD;
    A3 = ARRAY[0..2] OF SHORTCARD;
    A6 = ARRAY[0..5] OF SHORTCARD;
    A8 = ARRAY[0..7] OF SHORTCARD;
    A19 = ARRAY[0..18] OF SHORTCARD;
    A21 = ARRAY[0..20] OF SHORTCARD;

(*%T _fptr *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(si,ax,di,es,cx),reg_saved=>(ax,bx,dx,ds,es,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE MemMove(s,r: ADDRESS; c: CARDINAL)=A21(0E3H,013H,(*   jcxz  $1     *)
                                                   09CH,     (*   pushf        *)
                                                   01EH,     (*   push  ds     *)
                                                   08EH,0D8H,(*   mov   ds,ax  *)
                                                   03BH,0FEH,(*   cmp   di,si  *)
                                                   072H,007H,(*   jb    $0     *)
                                                   003H,0F1H,(*   add   si,cx  *)
                                                   003H,0F9H,(*   add   di,cx  *)
                                                   04EH,     (*   dec   si     *)
                                                   04FH,     (*   dec   di     *)
                                                   0FDH,     (*   std          *)
                                                             (* $0:            *)
                                                   0F3H,0A4H,(*   rep   ;movsb *)
                                                   01FH,     (*   pop   ds     *)
                                                   09DH);    (*   popf         *)
                                                             (* $1:            *)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(si,ax,di,es,cx),reg_saved=>(ax,bx,dx,ds,es,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE MemFastMove(s,r: ADDRESS; c: CARDINAL)=A8(0E3H,006H,(*   jcxz  $0     *)
                                                      01EH,     (*   push  ds     *)
                                                      08EH,0D8H,(*   mov   ds,ax  *)
                                                      0F3H,0A4H,(*   rep   ;movsb *)
                                                      01FH);    (*   pop   ds     *)
                                                                (* $0:            *)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(ax,dx,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE AddAddr(A: ADDRESS; I: CARDINAL): ADDRESS=A2(003H,0C1H);(*add ax,cx*)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(bx,es,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE IncAddr(VAR a: ADDRESS; i: CARDINAL)=A3(026H,001H,007H); (* add es:[bx],cx *)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(bx,es,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE DecAddr(VAR a: ADDRESS; i: CARDINAL)=A3(026H,029H,007H); (* sub es:[bx],cx *)
(*# restore *)

(*%E *)

(*%F _fptr *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(si,di,cx),reg_saved=>(ax,bx,dx,ds,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE MemMove(s,r: ADDRESS; c: CARDINAL)=A19(0E3H,011H,(*  jcxz $1   *)
                                                   09CH,     (*  pushf     *)
                                                   01EH,     (*  push ds   *)
                                                   007H,     (*  pop es    *)
                                                   03BH,0FEH,(*  cmp di,si *)
                                                   072H,007H,(*  jb $0     *)
                                                   003H,0F1H,(*  add si,cx *)
                                                   003H,0F9H,(*  add di,cx *)
                                                   04EH,     (*  dec si    *)
                                                   04FH,     (*  dec di    *)
                                                   0FDH,     (*  std       *)
                                                             (* $0:        *)
                                                   0F3H,0A4H,(*  rep; movsb*)
                                                   09DH);    (*  popf      *)
                                                             (* $1:        *)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(si,di,cx),reg_saved=>(ax,bx,dx,ds,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE MemFastMove(s,r: ADDRESS; c: CARDINAL)=A6(0E3H,004H,  (*  jcxz $0   *)
                                                      01EH,       (*  push ds   *)
                                                      007H,       (*  pop es    *)
                                                      0F3H,0A4H); (*  rep; movsb*)
                                                                  (* $0:        *)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE AddAddr(A: ADDRESS; I: CARDINAL): ADDRESS=A2(003H,0C1H);(*add ax,cx*)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(bx,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE IncAddr(VAR a: ADDRESS; i: CARDINAL)=A2(001H,007H); (* add [bx],cx *)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(bx,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE DecAddr(VAR a: ADDRESS; i: CARDINAL)=A2(029H,007H); (* sub [bx],cx *)
(*# restore *)

(*%E *)

  END inline;


CONST
  OutOfMemory = 80;
  ioError  = 81;
  DiskFull = 82;


(*# save *)
(*# call(reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
PROCEDURE Die(error: BOOLEAN; code: CARDINAL);
VAR s : ARRAY [0..79] OF CHAR;
    b : BOOLEAN;
BEGIN
  IF error THEN
    Str.CardToStr(LONGCARD(code),s,10,b);
    Str.Prepend(s,CHR(13)+CHR(10)+'BTREE: Fatal error, code = ');
    Lib.FatalError(s);
  END;
END Die;
(*# restore *)


PROCEDURE AllocMem(VAR a: ADDRESS; s: CARDINAL);
BEGIN
  a := CoreMem.calloc(1,s);
END AllocMem;


PROCEDURE FreeMem(VAR a: ADDRESS);
BEGIN
  IF a#NIL THEN
    CoreMem.free(a);
    a := NIL;
  END;
END FreeMem;


PROCEDURE AdjustBuffer(D: IHandle; rs: CARDINAL);
VAR
  sz : CARDINAL;
BEGIN
  WITH D.ID^ DO
    WITH Id[D.In] DO
      IF iwr^.RecordSize=0 THEN
        sz := AdjustBlock(rs);
        IF bufSize<sz THEN
          FreeMem(bufPtr);
          AllocMem(bufPtr,sz);
          Die(bufPtr=NIL,OutOfMemory);
          bufSize := sz;
        END;
      END;
    END;
  END;
END AdjustBuffer;


PROCEDURE IsFHandle(fH: FHandle): BOOLEAN;
BEGIN
  RETURN (fH#NIL) AND
         (fH^.G1=GuardV1) AND
         (fH^.G2=GuardV2);
END IsFHandle;


PROCEDURE IsIHandle(iH: IHandle): BOOLEAN;
BEGIN
  RETURN IsFHandle(iH.ID) AND (iH.In<=iH.ID^.fwr^.IndexCount) AND
         (iH.ID^.Id[iH.In].Ft#FreeSlot) AND
         (iH.ID^.Id[iH.In].iwr^.Ft#FreeSlot);
END IsIHandle;


PROCEDURE IsData(iH: IHandle): BOOLEAN;
BEGIN
  RETURN IsIHandle(iH) AND
         (iH.ID^.Id[iH.In].Ft=DataSlot) AND
         (iH.ID^.Id[iH.In].iwr^.Ft=DataSlot);
END IsData;


PROCEDURE IsIndex(iH: IHandle): BOOLEAN;
BEGIN
  RETURN IsIHandle(iH) AND
         (iH.ID^.Id[iH.In].Ft=IndexSlot) AND
         (iH.ID^.Id[iH.In].iwr^.Ft=IndexSlot);
END IsIndex;


(*# save *)
(*# call(o_a_size=>on) *)
PROCEDURE Error(err: Errors; str: ARRAY OF CHAR);
VAR
  st : ARRAY [0..100] OF CHAR;
  i  : CARDINAL;
BEGIN
  IF err#OK THEN
    st := CHR(13)+CHR(10);
    Str.Append(st,ErrorStr[err]);
    i := Str.Pos(st,'#');
    IF i#MAX(CARDINAL) THEN
      Str.Delete(st,i,1);
      Str.Insert(st,str,i);
    ELSIF Str.Length(str)#0 THEN
      Str.Append(st,' (');
      Str.Append(st,str);
      Str.Append(st,')');
    END;
    ErrorHandler(err,st);
  END;
END Error;
(*# restore *)


PROCEDURE ClearErr(iH: IHandle);
BEGIN
  IF IsIHandle(iH) THEN
    iH.ID^.Id[iH.In].LastErr := OK;
  END;
END ClearErr;


PROCEDURE ClearFErr(fH: FHandle);
VAR
  iH : IHandle;
BEGIN
  iH.ID := fH;
  iH.In := 0;
  ClearErr(iH);
END ClearFErr;


PROCEDURE SetErr(iH: IHandle; err: Errors);
BEGIN
  IF IsIHandle(iH) AND (iH.ID^.Id[iH.In].LastErr=OK) THEN
    iH.ID^.Id[iH.In].LastErr := err;
  END;
END SetErr;


(*# save *)
(*# call(o_a_size=>on) *)
PROCEDURE CallErr(iH: IHandle; err: Errors; str: ARRAY OF CHAR);
BEGIN
  SetErr(iH,err);
  Error(err,str);
END CallErr;
(*# restore *)


PROCEDURE SetFErr(fH: FHandle; err: Errors);
VAR
  iH : IHandle;
BEGIN
  iH.ID := fH;
  iH.In := 0;
  SetErr(iH,err);
END SetFErr;


(*# save *)
(*# call(o_a_size=>on) *)
PROCEDURE CallFErr(fH: FHandle; err: Errors; str: ARRAY OF CHAR);
VAR
  iH : IHandle;
BEGIN
  iH.ID := fH;
  iH.In := 0;
  CallErr(iH,err,str);
END CallFErr;
(*# restore *)


(*# save *)
(*# call(o_a_size=>on) *)
PROCEDURE IOerr(iH: IHandle; str: ARRAY OF CHAR): BOOLEAN;
VAR
  i : CARDINAL;
  tmp : ARRAY[0..80] OF CHAR;
  ok : BOOLEAN;
BEGIN
  i := FIOx.Error();
  IF i#0 THEN
    Str.CardToStr(VAL(LONGCARD,i),tmp,10,ok);
    Str.Insert(tmp,'#',0);
    IF Str.Length(str) # 0 THEN
      Str.Append(tmp,' ');
      Str.Append(tmp,str);
    END;
    CallErr(IHandle(iH),FileError,tmp);
    RETURN TRUE;
  ELSE
    RETURN FALSE;
  END;
END IOerr;
(*# restore *)


(*# save *)
(*# call(o_a_size=>on) *)
PROCEDURE IOFerr(fH: FHandle; str: ARRAY OF CHAR): BOOLEAN;
VAR
  iH: IHandle;
BEGIN
  iH.ID := fH;
  iH.In := 0;
  RETURN IOerr(iH,str);
END IOFerr;
(*# restore *)


(*# save *)
(*# call(o_a_size=>on) *)
PROCEDURE IOabort(str: ARRAY OF CHAR);
BEGIN
  Die(IOerr(Null,str),ioError);
END IOabort;
(*# restore *)


PROCEDURE ReadRec(D: IHandle; p: LONGCARD; VAR d: ARRAY OF BYTE);
VAR
  l : CARDINAL;
BEGIN
  WITH D.ID^ DO
    WITH Id[D.In] DO
      IF iwr^.RecordSize=0 THEN
        FIOx.Seek(FHandle,p-2);
        IOabort('ReadRec');
        FIOx.Read(FHandle,l,SIZE(l));
        IOabort('ReadRec');
        IF fwr^.Mode=Compress THEN
          AdjustBuffer(D,l);
          FIOx.Read(FHandle,bufPtr^,l);
          IOabort('ReadRec');
          Unpacker(l,bufPtr,ADR(d));
        ELSE
          FIOx.Read(FHandle,d,l);
          IOabort('ReadRec');
        END;
      ELSE
        FIOx.Seek(FHandle,p);
        IOabort('ReadRec');
        FIOx.Read(FHandle,d,iwr^.RecordSize);
      END;
    END;
  END;
END ReadRec;


PROCEDURE LoadRec(D: IHandle; p: LONGCARD; VAR bp: LONGCARD; VAR bs: CARDINAL);
VAR
  a : ADDRESS;
BEGIN
  WITH D.ID^ DO
    WITH Id[D.In] DO
      IF iwr^.RecordSize=0 THEN
        bp := p-SIZE(CARDINAL);
        FIOx.Seek(FHandle,bp);
        IOabort('LoadRec');
        FIOx.Read(FHandle,bs,SIZE(bs));
        IOabort('LoadRec');
        IF fwr^.Mode=Compress THEN
          AllocMem(a,bs);
          Die(a=NIL,OutOfMemory);
          FIOx.Read(FHandle,a^,bs);
          IOabort('LoadRec');
          AdjustBuffer(D,UnpackedSize(bs,a));
          Unpacker(bs,a,bufPtr);
          FreeMem(a);
        ELSE
          AdjustBuffer(D,bs);
          FIOx.Read(FHandle,bufPtr^,bs);
          IOabort('LoadRec');
        END;
      ELSE
        bp := p;
        bs := iwr^.RecordSize;
        FIOx.Seek(FHandle,p);
        IOabort('LoadRec');
        FIOx.Read(FHandle,bufPtr^,bs);
      END;
    END;
  END;
END LoadRec;


  MODULE LRU;
    (* This local module encapsulates the LRU buffer. *)

  IMPORT Nil, IHandle, BufferPages, TPage, CallErr, Null, UnknownError,
         AllocMem, MemMove, IOabort, Die, OutOfMemory, DiskFull, FIOx, CoreMem;
(*%T _mthread *)
  IMPORT Process;
(*%E *)
  EXPORT ReadPage, WritePage, ClearPage, ClearBuffers, SaveBuffers;

  CONST
    LRUCount = 32;

  VAR
    LruPages : ARRAY [1..LRUCount] OF BufferPages;
(*%F _fptr *)
    _Buf : TPage;
(*%E *)

  PROCEDURE MovePage(i: CARDINAL; discard: BOOLEAN);
  VAR
    j    : CARDINAL;
    t    : BufferPages;
    src,
    dest : ADDRESS;
    len  : CARDINAL;
  BEGIN
    IF discard THEN
      src := ADR(LruPages[1]);
      dest := ADR(LruPages[2]);
      len := i-1;
      j := 1;
    ELSIF i=LRUCount THEN
      len := 0;
    ELSE
      src := ADR(LruPages[i+1]);
      dest := ADR(LruPages[i]);
      len := LRUCount-i;
      j := LRUCount;
    END;
    IF len # 0 THEN
      t := LruPages[i];
      MemMove(src,dest,len*SIZE(BufferPages));
      LruPages[j] := t;
    END;
  END MovePage;

(*# save *)
(*# check(overflow=>off) *)
  PROCEDURE FlushPage(i: CARDINAL);
  BEGIN
    WITH LruPages[i] DO
      IF Wr THEN
        FIOx.Seek(iH.ID^.FHandle,Page);
        IOabort('FlushPage');
(*%F _fptr *)
        _Buf := Buf^;
        FIOx.Write(iH.ID^.FHandle,_Buf,SIZE(TPage));
(*%E *)
(*%T _fptr *)
        FIOx.Write(iH.ID^.FHandle,Buf^,SIZE(TPage));
(*%E *)
        IOabort('FlushPage');
        IF iH.ID^.Id[iH.In].OldWriteCnt=iH.ID^.Id[iH.In].iwr^.WriteCnt THEN
          INC(iH.ID^.Id[iH.In].iwr^.WriteCnt);
        END;
        Wr := FALSE;
        IF iH.ID^.WriteThru THEN
          FIOx.Flush(iH.ID^.FHandle);
        END;
      END;
    END;
  END FlushPage;
(*# restore *)

  PROCEDURE FindPage(ih: IHandle; page: LONGCARD): BOOLEAN;
  VAR
    i : CARDINAL;
    f : BOOLEAN;
  BEGIN
    i := LRUCount;
    LOOP
      WITH LruPages[i] DO
        f := (ih=iH) AND (Page=page);
      END;
      IF f OR (i=1) THEN
        EXIT;
      END;
      DEC(i);
    END;
    MovePage(i,FALSE);
    IF NOT f THEN
      FlushPage(LRUCount);
      WITH LruPages[LRUCount] DO
        iH := ih;
        Page := page;
      END;
    END;
    RETURN f;
  END FindPage;

  PROCEDURE ReadPage(ih: IHandle; page: LONGCARD; VAR TP: TPage);
  BEGIN
    (*%T _mthread *) Process.Lock(); (*%E *)
    WITH LruPages[LRUCount] DO
      IF NOT FindPage(ih,page) THEN
        FIOx.Seek(ih.ID^.FHandle,page);
        IOabort('ReadPage');
(*%F _fptr *)
        FIOx.Read(ih.ID^.FHandle,_Buf,SIZE(TPage));
        Buf^ := _Buf;
(*%E *)
(*%T _fptr *)
        FIOx.Read(ih.ID^.FHandle,Buf^,SIZE(TPage));
(*%E *)
        IOabort('ReadPage');
      END;
      TP := Buf^;
    END;
    (*%T _mthread *) Process.Unlock(); (*%E *)
  END ReadPage;

  PROCEDURE WritePage(ih: IHandle; page: LONGCARD; VAR TP: TPage);
  VAR
    r : CARDINAL;
  BEGIN
    IF page=Nil THEN
      CallErr(Null,UnknownError,'WritePage');
      Die(TRUE,DiskFull);
    END;
    (*%T _mthread *) Process.Lock(); (*%E *)
    IF NOT FindPage(ih,page) THEN
      (* nothing *)
    END;
    WITH LruPages[LRUCount] DO
      Buf^ := TP;
      Wr  := TRUE;
      IF iH.ID^.WriteThru THEN
        FlushPage(LRUCount);
      END;
    END;
    (*%T _mthread *) Process.Unlock(); (*%E *)
  END WritePage;

  PROCEDURE UnUse(ih: IHandle; page: LONGCARD; wr: BOOLEAN);
  VAR
    i : CARDINAL;
  BEGIN
    (*%T _mthread *) Process.Lock(); (*%E *)
    i := 1;
    WHILE i<=LRUCount DO
      WITH LruPages[i] DO
        IF (((ih.In=MAX(CARDINAL)) AND (ih.ID=iH.ID)) OR (ih=iH)) AND
           ((page=Page) OR (page=Nil)) THEN
          IF wr THEN
            FlushPage(i);
          ELSE
            MovePage(i,TRUE);
            LruPages[1].Wr := FALSE;
            LruPages[1].iH := Null;
            LruPages[1].Page := 0;
          END;
        END;
      END;
      INC(i);
    END;
    (*%T _mthread *) Process.Unlock(); (*%E *)
  END UnUse;

  PROCEDURE ClearPage(ih: IHandle; page: LONGCARD);
  BEGIN
    UnUse(ih,page,FALSE);
  END ClearPage;

  PROCEDURE ClearBuffers(ih: IHandle);
  BEGIN
    UnUse(ih,Nil,FALSE);
  END ClearBuffers;

  PROCEDURE SaveBuffers(ih: IHandle);
  BEGIN
    UnUse(ih,Nil,TRUE);
  END SaveBuffers;

  PROCEDURE Init;
  VAR
    i : CARDINAL;
  BEGIN
    FOR i := 1 TO LRUCount DO
      LruPages[i] := BufferPages(Null,FALSE,0,FarNIL);
      LruPages[i].Buf := CoreMem._fcalloc(1,SIZE(TPage));
      Die(LruPages[i].Buf=FarNIL,OutOfMemory);
    END;
  END Init;

  BEGIN
    Init;
  END LRU;


PROCEDURE ccOneLock(lock: LockRec; type: LockType): BOOLEAN;
BEGIN
  WITH lock DO
    RETURN ((type=Implicit) AND (ICnt=1) AND (ECnt=0)) OR
           ((type=Explicit) AND (ECnt=1) AND (ICnt=0));
  END;
END ccOneLock;


PROCEDURE ccLock(dH: IHandle; VAR lock: LockRec; type: LockType): BOOLEAN;
VAR
  lck : FIOx.LockRec;
BEGIN
  IF dH.ID^.Buffered THEN
    RETURN TRUE;
  END;
  WITH lock DO
    IF (type=Implicit) AND (ICnt#MAX(SHORTCARD)) THEN
      INC(ICnt);
    ELSIF (type=Explicit) AND (ECnt#MAX(SHORTCARD)) THEN
      INC(ECnt);
    ELSE
      CallErr(dH,LockOverflow,'ccLock');
      RETURN FALSE;
    END;
    IF (type=Implicit) AND (In=Null) THEN
      In := dH;
    END;
    lck.pos := lock.Position;
    lck.len := 1;
    IF ccOneLock(lock,type) AND NOT FIOx.Lock(dH.ID^.FHandle,lck) THEN
      IF type=Implicit THEN
        DEC(ICnt);
      ELSE
        DEC(ECnt);
      END;
      SetErr(dH,Locked);
      RETURN FALSE;
    ELSE
      RETURN TRUE;
    END;
  END;
END ccLock;


PROCEDURE cLock(dH: IHandle; dLoc: LONGCARD; type: LockType): BOOLEAN;
VAR
  idx,
  tmp : CARDINAL;
BEGIN
  IF dH.ID^.Buffered THEN
    RETURN TRUE;
  END;
  idx := MAX(CARDINAL);
  LOOP
    FOR tmp := 0 TO LockQSize-1 DO
      WITH dH.ID^.Locks[tmp] DO
        IF Position=dLoc THEN
          idx := tmp;
          EXIT;
        ELSIF (idx=MAX(CARDINAL)) AND (Position=Nil) THEN
          idx := tmp;
        END;
      END;
    END;
    IF idx#MAX(CARDINAL) THEN
      WITH dH.ID^.Locks[idx] DO
        Position := dLoc;
        ICnt := 0;
        ECnt := 0;
        IF type=Implicit THEN
          In := dH;
        ELSE
          In := Null;
        END;
      END;
    END;
    EXIT;
  END;
  IF idx#MAX(CARDINAL) THEN
    IF NOT ccLock(dH,dH.ID^.Locks[idx],type) THEN
      dH.ID^.Locks[idx].Position := Nil;
      RETURN FALSE;
    ELSE
      RETURN TRUE;
    END;
  ELSE
    CallErr(dH,LockOverflow,'cLock');
    RETURN FALSE;
  END;
END cLock;


PROCEDURE Lock(F: FHandle; DataLoc: LONGCARD): BOOLEAN;
VAR
  dH : IHandle;
BEGIN
  dH.ID := F;
  dH.In := 0;
  ClearErr(dH);
  IF NOT IsIHandle(dH) THEN
    CallFErr(dH.ID,NotIHandle,'Lock');
    RETURN FALSE;
  END;
  RETURN cLock(dH,DataLoc,Explicit);
END Lock;


PROCEDURE LockDat(iH: IHandle; dLoc: LONGCARD): BOOLEAN;
VAR
  idx,
  tmp : CARDINAL;
BEGIN
  IF iH.ID^.Buffered THEN
    RETURN TRUE;
  END;
  idx := MAX(CARDINAL);
  LOOP
    FOR tmp := 0 TO LockQSize-1 DO
      WITH iH.ID^.Id[iH.In].DataPtr.ID^.Locks[tmp] DO
        IF Position=dLoc THEN
          idx := tmp;
          EXIT;
        ELSIF (idx=MAX(CARDINAL)) AND (Position=Nil) THEN
          idx := tmp;
        END;
      END;
    END;
    IF idx#MAX(CARDINAL) THEN
      WITH iH.ID^.Id[iH.In].DataPtr.ID^.Locks[idx] DO
        Position := dLoc;
        ICnt := 0;
        ECnt := 0;
        In := iH;
      END;
    END;
    EXIT;
  END;
  IF idx#MAX(CARDINAL) THEN
    RETURN ccLock(iH,iH.ID^.Id[iH.In].DataPtr.ID^.Locks[idx],Implicit);
  ELSE
    CallErr(iH,LockOverflow,'LockDat');
    RETURN FALSE;
  END;
END LockDat;


PROCEDURE ccUnLock(dH: IHandle; VAR lock: LockRec; type: LockType);
VAR
  lck : FIOx.LockRec;
BEGIN
  IF dH.ID^.Buffered THEN
    RETURN;
  END;
  WITH lock DO
    IF type=Implicit THEN
      IF ICnt#0 THEN
        DEC(ICnt);
      END;
    ELSIF type=AllImplicit THEN
      ICnt := 0;
    ELSIF type=AllLocks THEN
      ICnt := 0;
      ECnt := 0;
    ELSIF type=Explicit THEN
      IF ECnt#0 THEN
        DEC(ECnt);
      ELSE
        CallErr(dH,NotLocked,'ccUnLock');
        RETURN;
      END;
    END;
    IF ICnt=0 THEN
      IF ECnt#0 THEN
        In := Null;
      ELSE
        lck.pos := Position;
        lck.len := 1;
        FIOx.UnLock(dH.ID^.FHandle,lck);
      END;
    END;
  END;
END ccUnLock;


PROCEDURE cUnLock(dH: IHandle; dLoc: LONGCARD; type: LockType);
VAR
  idx : CARDINAL;
BEGIN
  IF dH.ID^.Buffered THEN
    RETURN;
  END;
  FOR idx := 0 TO LockQSize-1 DO
    IF dH.ID^.Locks[idx].Position=dLoc THEN
      ccUnLock(dH,dH.ID^.Locks[idx],type);
      dH.ID^.Locks[idx].Position := Nil;
      RETURN;
    END;
  END;
  IF type=Explicit THEN
    CallErr(dH,NotLocked,'cUnLock');
  END;
END cUnLock;


PROCEDURE UnLock(F: FHandle; DataLoc: LONGCARD);
VAR
  dH : IHandle;
BEGIN
  dH.ID := F;
  dH.In := 0;
  ClearErr(dH);
  IF NOT IsIHandle(dH) THEN
    CallFErr(dH.ID,NotIHandle,'UnLock');
    RETURN;
  END;
  cUnLock(dH,DataLoc,Explicit);
END UnLock;


PROCEDURE UnLockDat(iH: IHandle; dLoc: LONGCARD);
VAR
  idx : CARDINAL;
BEGIN
  IF iH.ID^.Buffered THEN
    RETURN;
  END;
  FOR idx := 0 TO LockQSize-1 DO
    WITH iH.ID^.Id[iH.In].DataPtr.ID^ DO
      IF Locks[idx].Position=dLoc THEN
        ccUnLock(iH,Locks[idx],Implicit);
        Locks[idx].Position := Nil;
        RETURN;
      END;
    END;
  END;
END UnLockDat;

PROCEDURE FollowNextIndx(VAR H : IHandle);
BEGIN
  WITH H.ID^.Id[H.In] DO H := NextIndx; END;
END FollowNextIndx;


PROCEDURE Release(H: IHandle);
VAR
  idx : CARDINAL;
BEGIN
  ClearErr(H);
  IF NOT IsIHandle(H) THEN
    CallFErr(H.ID,NotIHandle,'Release');
    RETURN;
  END;
  IF H.ID^.Id[H.In].Ft=DataSlot THEN
    FollowNextIndx(H);
    WHILE H#Null DO
      Release(H);
      FollowNextIndx(H);
    END;
  ELSE
    IF IsData(H.ID^.Id[H.In].DataPtr) THEN
      WITH H.ID^.Id[H.In].DataPtr.ID^ DO
        IF NOT Buffered THEN
          FOR idx := 0 TO LockQSize-1 DO
            WITH Locks[idx] DO
              IF (Position#Nil) AND (In=H) THEN
                ccUnLock(H,Locks[idx],AllImplicit);
                Position := Nil;
              END;
            END;
          END;
        END;
      END;
    END;
  END;
END Release;


PROCEDURE cOneLock(dH: IHandle; dLoc: LONGCARD; type: LockType): BOOLEAN;
VAR
  idx : CARDINAL;
BEGIN
  WITH dH.ID^ DO
    IF NOT Buffered THEN
      FOR idx := 0 TO LockQSize-1 DO
        IF Locks[idx].Position=dLoc THEN
          RETURN ccOneLock(Locks[idx],type);
        END;
      END;
    END;
  END;
  RETURN FALSE;
END cOneLock;


PROCEDURE cLocked(dH: IHandle; dLoc: LONGCARD): BOOLEAN;
VAR
  idx : CARDINAL;
BEGIN
  WITH dH.ID^ DO
    IF NOT Buffered THEN
      FOR idx := 0 TO LockQSize-1 DO
        IF Locks[idx].Position=dLoc THEN
          RETURN TRUE;
        END;
      END;
      RETURN FALSE;
    ELSE
      RETURN TRUE;
    END;
  END;
END cLocked;


PROCEDURE LockFile(fH: FHandle): BOOLEAN;
VAR
  iH : IHandle;
BEGIN
  IF NOT IsFHandle(fH) THEN
    CallFErr(fH,NotFHandle,'LockFile');
    RETURN FALSE;
  END;
  WITH fH^ DO
    IF NOT Buffered THEN
      iH.ID := fH;
      iH.In := 0;
      IF NOT ccLock(iH,fhLock,Implicit) THEN
        RETURN FALSE;
      END;
      IF ccOneLock(fhLock,Implicit) THEN
        FIOx.Seek(FHandle,fhLock.Position);
        IOabort('LockFile');
        FIOx.Read(FHandle,fwr^,FileDataWrSize);
        IOabort('LockFile');
      END;
    END;
  END;
  RETURN TRUE;
END LockFile;


PROCEDURE FlushFHandle(fH: FHandle);
BEGIN
  WITH fH^ DO
    IF NOT ReadOnly THEN
      FIOx.Seek(FHandle,fhLock.Position);
      IOabort('FlushFHandle');
      FIOx.Write(FHandle,fwr^,FileDataWrSize);
      IOabort('FlushFHandle');
    END;
  END;
END FlushFHandle;


PROCEDURE UnLockFile(fH: FHandle);
VAR
  iH : IHandle;
BEGIN
  IF NOT IsFHandle(fH) THEN
    CallFErr(fH,NotFHandle,'UnLockFile');
    RETURN;
  END;
  WITH fH^ DO
    IF NOT Buffered THEN
      IF ccOneLock(fhLock,Implicit) THEN
        FlushFHandle(fH);
      END;
      iH.ID := fH;
      iH.In := 0;
      ccUnLock(iH,fhLock,Implicit);
    END;
  END;
END UnLockFile;


PROCEDURE cLockIHandle(iH: IHandle; type: LockType): BOOLEAN;
BEGIN
  WITH iH.ID^ DO
    IF NOT Buffered THEN
      WITH Id[iH.In] DO
        IF ccLock(iH,ihLock,type) THEN
          IF ccOneLock(ihLock,type) THEN
            FIOx.Seek(FHandle,ihLock.Position);
            IOabort('cLockIHandle');
            FIOx.Read(FHandle,iwr^,IndexDataWrSize);
            IOabort('cLockIHandle');
            IF (Ft=IndexSlot) AND (OldWriteCnt#iwr^.WriteCnt) THEN
              ClearBuffers(iH);
              OldWriteCnt := iwr^.WriteCnt;
              PageLevel := 0;
              IF PageRefs^.Height<iwr^.Depth THEN
                FreeMem(PageRefs);
                AllocMem(PageRefs,VSIZE(PageRef.Height)+(iwr^.Depth+1)*SIZE(PageRefRec));
                Die(PageRefs=NIL,OutOfMemory);
                PageRefs^.Height := iwr^.Depth+1;
              END;
            END;
          END;
        ELSE
          RETURN FALSE;
        END;
      END;
    END;
  END;
  RETURN TRUE;
END cLockIHandle;


PROCEDURE LockIHandle(H: IHandle): BOOLEAN;
BEGIN
  ClearErr(H);
  IF NOT IsIHandle(H) THEN
    CallFErr(H.ID,NotIHandle,'LockIHandle');
    RETURN FALSE;
  END;
  RETURN cLockIHandle(H,Explicit);
END LockIHandle;


PROCEDURE FlushIHandle(iH: IHandle);
BEGIN
  WITH iH.ID^ DO
    IF NOT ReadOnly THEN
      WITH Id[iH.In] DO
        IF Ft=IndexSlot THEN
          SaveBuffers(iH);
          OldWriteCnt := iwr^.WriteCnt;
        END;
        FIOx.Seek(FHandle,ihLock.Position);
        IOabort('FlushIHandle');
        FIOx.Write(FHandle,iwr^,IndexDataWrSize);
        IOabort('FlushIHandle');
      END;
    END;
  END;
END FlushIHandle;


PROCEDURE SetLastKey(iH: IHandle);

VAR
  TP : TPage;

TYPE
  IPtr = POINTER Seg(TP) TO IndexItem;
  A2 = ARRAY[0..1] OF SHORTCARD;

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE AddIPtr(A: IPtr; I: CARDINAL): IPtr=A2(003H,0C1H);(*add ax,cx*)
(*# restore *)

VAR
  IP  : IPtr;

BEGIN
  WITH iH.ID^ DO
    WITH Id[iH.In] DO
      LastKeyOK := TRUE;
      ReadPage(iH,PageRefs^.Refs[PageLevel].Page,TP);
      IP := AddIPtr(IPtr(Ofs((TP.IItem))),PageRefs^.Refs[PageLevel].Rec*(2*SIZE(LONGCARD)+iwr^.KeySize));
      LastKey := IP^.Key;
      LastKeyRef := IP^.DP;
    END;
  END;
END SetLastKey;


PROCEDURE cUnLockIHandle(iH: IHandle; type: LockType);
BEGIN
  WITH iH.ID^ DO
    IF NOT Buffered THEN
      WITH Id[iH.In] DO
        IF ccOneLock(ihLock,type) THEN
          IF Ft=IndexSlot THEN
            IF PageLevel#0 THEN
              SetLastKey(iH);
            END;
            FlushIHandle(iH);
          END;
        END;
        ccUnLock(iH,ihLock,type);
      END;
    END;
  END;
END cUnLockIHandle;


PROCEDURE UnLockIHandle(H: IHandle);
BEGIN
  ClearErr(H);
  IF NOT IsIHandle(H) THEN
    CallFErr(H.ID,NotIHandle,'UnLockIHandle');
    RETURN;
  END;
  cUnLockIHandle(H,Explicit);
END UnLockIHandle;


PROCEDURE N2Eval(KeySize: CARDINAL): CARDINAL;
VAR
  t : CARDINAL;
BEGIN
  t := (PageSize-6) DIV (8+KeySize);
  IF ODD(t) THEN
    DEC(t);
  END;
  IF (t=0) THEN
    CallErr(Null,KeyTooBig,'N2Eval');
    RETURN MAX(CARDINAL);
  END;
  RETURN t;
END N2Eval;


PROCEDURE WalkIx(iH: IHandle; mode: WalkMode);

VAR
  TP : TPage;

TYPE
  IPtr = POINTER Seg(TP) TO IndexItem;
  A2 = ARRAY[0..1] OF SHORTCARD;
  A3 = ARRAY[0..2] OF SHORTCARD;

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE AddIPtr(A: IPtr; I: CARDINAL): IPtr=A2(003H,0C1H);(*add ax,cx*)
(*# restore *)

(*%T _fptr *)
(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(bx,es,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
PROCEDURE IncIPtr(VAR a: IPtr; i: CARDINAL)=A3(026H,001H,007H); (* add es:[bx],cx *)
(*# restore *)
(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(bx,es,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
PROCEDURE DecIPtr(VAR a: IPtr; i: CARDINAL)=A3(026H,029H,007H); (* sub es:[bx],cx *)
(*# restore *)
(*%E *)

(*%F _fptr *)
(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(bx,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
PROCEDURE IncIPtr(VAR a: IPtr; i: CARDINAL)=A2(001H,007H); (* add [bx],cx *)
(*# restore *)
(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(bx,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
PROCEDURE DecIPtr(VAR a: IPtr; i: CARDINAL)=A2(029H,007H); (* sub [bx],cx *)
(*# restore *)
(*%E *)

VAR
  IP,
  BP       : IPtr;
  LeafPage : BOOLEAN;
  ItemSize : CARDINAL;
  Index    : CARDINAL;

  PROCEDURE GetP(P: LONGCARD);
  BEGIN
    ReadPage(iH,P,TP);
    IP := BP;
    WITH iH.ID^.Id[iH.In] DO
      LeafPage := PageLevel=iwr^.Depth;
      WITH PageRefs^.Refs[PageLevel] DO
        Page := P;
        IF TP.ICount=iwr^.N2 THEN
          IF P=iwr^.TopPage THEN
            Cnt := 2;
          ELSE
            Cnt := PageRefs^.Refs[PageLevel-1].Cnt+1;
          END;
        ELSE
          Cnt := 0;
        END;
      END;
    END;
    Index := 0;
  END GetP;

BEGIN
  WITH iH.ID^.Id[iH.In] DO
    ItemSize := 8+iwr^.KeySize;
    BP := IPtr(Ofs((TP.IItem)));
    LastDataRef := Nil;
    IF PageLevel=0 THEN
      PageLevel := 1;
      GetP(iwr^.TopPage);
      IF TP.ICount=0 THEN
        PageLevel := 0;
        RETURN;
      ELSE
        Index := 0;
        LOOP
          IF mode=Backward THEN
            Index := TP.ICount;
          END;
          PageRefs^.Refs[PageLevel].Rec := Index;
          IncIPtr(IP,Index*ItemSize);
          IF LeafPage THEN
            IF mode=Backward THEN
              DecIPtr(IP,ItemSize);
              DEC(PageRefs^.Refs[PageLevel].Rec);
            END;
            EXIT;
          END;
          INC(PageLevel);
          GetP(IP^.IP);
        END;
      END;
    ELSE
      GetP(PageRefs^.Refs[PageLevel].Page);
      Index := PageRefs^.Refs[PageLevel].Rec;
      IF mode=Forward THEN
        IF (Index+1<TP.ICount) OR
           ((Index<TP.ICount) AND NOT LeafPage) THEN
          INC(Index);
          WHILE NOT LeafPage DO
            PageRefs^.Refs[PageLevel].Rec := Index;
            IncIPtr(IP,Index*ItemSize);
            INC(PageLevel);
            GetP(IP^.IP);
          END;
        ELSE
          REPEAT
            DEC(PageLevel);
            IF PageLevel=0 THEN
              RETURN;
            END;
            GetP(PageRefs^.Refs[PageLevel].Page);
            Index := PageRefs^.Refs[PageLevel].Rec;
          UNTIL Index<TP.ICount;
        END;
      ELSE
        IF LeafPage THEN
          IF Index=0 THEN
            REPEAT
              DEC(PageLevel);
              IF PageLevel=0 THEN
                RETURN;
              END;
              GetP(PageRefs^.Refs[PageLevel].Page);
              Index := PageRefs^.Refs[PageLevel].Rec;
            UNTIL Index>0;
          END;
        ELSE
          REPEAT
            PageRefs^.Refs[PageLevel].Rec := Index;
            IncIPtr(IP,Index*ItemSize);
            INC(PageLevel);
            GetP(IP^.IP);
            Index := TP.ICount;
          UNTIL LeafPage;
        END;
        DEC(Index);
      END;
      PageRefs^.Refs[PageLevel].Rec := Index;
      IncIPtr(IP,Index*ItemSize);
    END;
    LastDataRef := IP^.DP;
  END;
END WalkIx;


PROCEDURE FindIx(iH: IHandle; Key: ARRAY OF BYTE; DataPos: LONGCARD;
                 Mode: FindMode): BOOLEAN;

VAR
  TP : TPage;

TYPE
  IPtr = POINTER Seg(TP) TO IndexItem;
  A2 = ARRAY[0..1] OF SHORTCARD;

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE AddIPtr(A: IPtr; I: CARDINAL): IPtr=A2(003H,0C1H);(*add ax,cx*)
(*# restore *)

VAR
  IP,
  BP       : IPtr;
  LeafPage : BOOLEAN;
  ItemSize : CARDINAL;
  Index    : CARDINAL;
  C        : CmpRes;
  First,
  Last     : CARDINAL;

LABEL
  _Greater,
  _Less;

  PROCEDURE GetPage(P: LONGCARD);
  BEGIN
    ReadPage(iH,P,TP);
    WITH iH.ID^.Id[iH.In] DO
      LeafPage := PageLevel=iwr^.Depth;
      WITH PageRefs^.Refs[PageLevel] DO
        Page := P;
        IF TP.ICount=iwr^.N2 THEN
          IF P=iwr^.TopPage THEN
            Cnt := 2;
          ELSE
            Cnt := PageRefs^.Refs[PageLevel-1].Cnt+1;
          END;
        ELSE
          Cnt := 0;
        END;
      END;
    END;
    First := 0;
    Last := TP.ICount;
    Index := (First + Last) DIV 2;
    IP := AddIPtr(BP,Index*ItemSize);
  END GetPage;

  PROCEDURE Walk(m : WalkMode);
    BEGIN
      WITH iH.ID^.Id[iH.In] DO
        WalkIx(iH,m);
        IF PageLevel#0 THEN
          GetPage(PageRefs^.Refs[PageLevel].Page);
          IP := AddIPtr(BP,PageRefs^.Refs[PageLevel].Rec*ItemSize);
          C := CompFct(ADR(IP^.Key),ADR(Key));
          LastDataRef := IP^.DP;
        ELSE
          LastDataRef := Nil;
        END;
      END;
    END Walk;

BEGIN
  BP := IPtr(ADR(TP.IItem));
  WITH iH.ID^.Id[iH.In] DO
    ItemSize := 2*SIZE(LONGCARD)+iwr^.KeySize;
    PageLevel := 1;
    GetPage(iwr^.TopPage);
    LOOP (* Opt1 *)
      IF Index<TP.ICount THEN
        C := CompFct(ADR(IP^.Key),ADR(Key));
        LastDataRef := IP^.DP;
      ELSE
        C := Greater;
        LastDataRef := Nil;
      END;
      IF First >= Last THEN
        PageRefs^.Refs[PageLevel].Rec := Index;
        IF LeafPage THEN
          CASE Mode OF
            | Ins : RETURN FALSE;
            | Idx : RETURN FALSE;
            | Rec : IF Index=TP.ICount THEN
                      Walk(Forward);
                    END;
                    RETURN FALSE;
            | Fnd,
              Src : WHILE (PageLevel#0) AND (C#Less) DO
                      Walk(Backward);
                    END;
                    Walk(Forward);
                    RETURN (PageLevel#0) AND ((C=Eq) OR (Mode=Src));
          END;
        ELSE
          INC(PageLevel);
          GetPage(IP^.IP);
        END;
      ELSE
        CASE C OF
          | Greater :
_Greater:                                (* This key is >= the one we want *)
                      Last := Index;
          | Eq      : CASE Mode OF
                        | Ins : IF NOT iwr^.DupKey THEN
                                  CallErr(iH,ErrDupKey,'FindIx');
                                  PageRefs^.Refs[PageLevel].Rec := Index;
                                  RETURN FALSE;
                                ELSIF IP^.DP<DataPos THEN
                                  GOTO _Less;
                                ELSE
                                  GOTO _Greater;
                                END;
                        | Idx,
                          Rec : IF IP^.DP<DataPos THEN
                                  GOTO _Less;
                                ELSIF IP^.DP=DataPos THEN
                                  PageRefs^.Refs[PageLevel].Rec := Index;
                                  RETURN TRUE;
                                ELSE
                                  GOTO _Greater;
                                END;
                        | Fnd,
                          Src : GOTO _Greater;
                      END;
          | Less    :
_Less:                                   (* This key is < the one we want *)
                      First := Index+1;
        END;
        Index := (First + Last) DIV 2;
        IP := AddIPtr(BP,Index*ItemSize);
      END;
    END;
  END;
END FindIx;


PROCEDURE FreeFreeBlock(fH: FHandle; Loc: LONGCARD);
BEGIN
  FIOx.Seek(fH^.FHandle,Loc);
  IOabort('FreeFreeBlock');
  FIOx.Write(fH^.FHandle,fH^.fwr^.FreeList,4);
  IOabort('FreeFreeBlock');
  fH^.fwr^.FreeList := Loc;
END FreeFreeBlock;


PROCEDURE AllocateFreeBlock(fH: FHandle): LONGCARD;
VAR
  Loc : LONGCARD;
  r   : CARDINAL;
BEGIN
  IF fH^.fwr^.FreeList#Nil THEN
    Loc := fH^.fwr^.FreeList;
    FIOx.Seek(fH^.FHandle,Loc);
    IOabort('AllocateFreeBlock');
    FIOx.Read(fH^.FHandle,fH^.fwr^.FreeList,4);
    IOabort('AllocateFreeBlock');
    RETURN Loc;
  ELSE
    FIOx.Seek(fH^.FHandle,fH^.fwr^.FileSize+PageSize-1);
    IOabort('AllocateFreeBlock');
    FIOx.Write(fH^.FHandle,0,1);
    IF FIOx.Error()=FIOx.DISK_FULL THEN
      FIOx.Truncate(fH^.FHandle,fH^.fwr^.FileSize);
      IOabort('AllocateFreeBlock');
      RETURN Nil;
    END;
    IOabort('AllocateFreeBlock');
    Loc := fH^.fwr^.FileSize;
    INC(fH^.fwr^.FileSize,PageSize);
    RETURN Loc;
  END;
END AllocateFreeBlock;


(*# save *)
(*# check(overflow=>off) *)
PROCEDURE FreeBlock(fH: FHandle; Len,Loc: LONGCARD);
VAR
  iH    : IHandle;
  r,
  PLen,
  NLen  : CARDINAL;
  PLoc,
  PLen4 : LONGCARD;
BEGIN
  iH.ID := fH;
  iH.In := 0;
  LOOP
    WITH fH^ DO
      CASE fwr^.Mode OF
          FixSize  : AddIndex(iH,Len,Loc);
                     EXIT;
        | Size16,
          Compress : IF Len<SIZE(CARDINAL)*2 THEN
                       Len := SIZE(CARDINAL)*2;
                     END;
                     FIOx.Seek(FHandle,Loc-SIZE(CARDINAL));
                     IOabort('FreeBlock');
                     FIOx.Read(FHandle,PLen,SIZE(CARDINAL));
                     IF FIOx.Error()#FIOx.NO_ERROR THEN
                       PLen := MAX(CARDINAL);
                     END;
                     PLoc := Loc-LONGCARD(PLen);
                     IF ((Loc-SIZE(CARDINAL))>LONGCARD(fwr^.HeaderSize)) AND (PLen<MAX(CARDINAL)-SIZE(LONGCARD)*2) AND FindIx(iH,PLen,PLoc,Idx) THEN
                       DeleteIndex(iH,PLen,PLoc);
                       IF LONGCARD(PLen)+Len<MAX(CARDINAL)-SIZE(LONGCARD)*2 THEN
                         NLen := PLen+CARDINAL(Len);
                         Loc := Loc+Len;
                         Len := 0;
                       ELSE
                         NLen := MAX(CARDINAL)-SIZE(LONGCARD)*2;
                         Len  := Len-LONGCARD((MAX(CARDINAL)-SIZE(LONGCARD)*2-PLen));
                         Loc  := Loc+LONGCARD((MAX(CARDINAL)-SIZE(LONGCARD)*2-PLen))
                       END;
                       IF (Len>0) AND (Len<SIZE(LONGCARD)) THEN
                         NLen := NLen-(SIZE(LONGCARD)-CARDINAL(Len));
                         Loc  := Loc-(SIZE(LONGCARD)-Len);
                         Len  := SIZE(LONGCARD);
                       END;
                       FIOx.Seek(FHandle,PLoc);
                       IOabort('FreeBlock');
                       FIOx.Write(FHandle,NLen,SIZE(CARDINAL));
                       IOabort('FreeBlock');
                       FIOx.Seek(FHandle,PLoc+LONGCARD(NLen)-SIZE(CARDINAL));
                       IOabort('FreeBlock');
                       FIOx.Write(FHandle,NLen,SIZE(CARDINAL));
                       IOabort('FreeBlock');
                       AddIndex(iH,NLen,PLoc);
                     END;
                     IF Len>0 THEN
                       FIOx.Seek(FHandle,Loc);
                       IOabort('FreeBlock');
                       FIOx.Write(FHandle,Len,SIZE(CARDINAL));
                       IOabort('FreeBlock');
                       FIOx.Seek(FHandle,Loc+Len-SIZE(CARDINAL));
                       IOabort('FreeBlock');
                       FIOx.Write(FHandle,Len,SIZE(CARDINAL));
                       IOabort('FreeBlock');
                       AddIndex(iH,Len,Loc);
                       PLoc := Loc+Len;
                     ELSE
                       Len := LONGCARD(NLen);
                       PLoc := PLoc+Len;
                     END;
                     (* Opt2 *)
                     FIOx.Seek(FHandle,PLoc);
                     IOabort('FreeBlock');
                     FIOx.Read(FHandle,PLen,SIZE(CARDINAL));
                     IF FIOx.Error()#FIOx.NO_ERROR THEN
                       PLen := MAX(CARDINAL);
                     END;
                     IF (Len<MAX(CARDINAL)-SIZE(LONGCARD)*2) AND (PLen<MAX(CARDINAL)-SIZE(LONGCARD)*2) AND FindIx(iH,PLen,PLoc,Idx) THEN
                       DeleteIndex(iH,PLen,PLoc);
                       Len := LONGCARD(PLen);
                       Loc := PLoc;
                     ELSE
                       EXIT;
                     END;
        | Size32   : IF Len<SIZE(LONGCARD)*2 THEN
                       Len := SIZE(LONGCARD)*2;
                     END;
                     FIOx.Seek(FHandle,Loc-SIZE(LONGCARD));
                     IOabort('FreeBlock');
                     FIOx.Read(FHandle,PLen4,SIZE(LONGCARD));
                     IF FIOx.Error()#FIOx.NO_ERROR THEN
                       PLen4 := MAX(LONGCARD);
                     END;
                     PLoc := Loc-PLen4;
                     IF ((Loc-SIZE(LONGCARD))>LONGCARD(fwr^.HeaderSize)) AND (PLen4<MAX(LONGCARD)-SIZE(LONGCARD)*2) AND FindIx(iH,PLen4,PLoc,Idx) THEN
                       DeleteIndex(iH,PLen4,PLoc);
                       Len := PLen4+Len;
                       FIOx.Seek(FHandle,PLoc);
                       IOabort('FreeBlock');
                       FIOx.Write(FHandle,Len,SIZE(LONGCARD));
                       IOabort('FreeBlock');
                       FIOx.Seek(FHandle,PLoc+Len-SIZE(LONGCARD));
                       IOabort('FreeBlock');
                       FIOx.Write(FHandle,Len,SIZE(LONGCARD));
                       IOabort('FreeBlock');
                       AddIndex(iH,Len,PLoc);
                       PLoc := PLoc+Len;
                     ELSE
                       FIOx.Seek(FHandle,Loc);
                       IOabort('FreeBlock');
                       FIOx.Write(FHandle,Len,SIZE(LONGCARD));
                       IOabort('FreeBlock');
                       FIOx.Seek(FHandle,Loc+Len-SIZE(LONGCARD));
                       IOabort('FreeBlock');
                       FIOx.Write(FHandle,Len,SIZE(LONGCARD));
                       IOabort('FreeBlock');
                       AddIndex(iH,Len,Loc);
                       PLoc := Loc+Len;
                     END;
                     (* Opt2 *)
                     FIOx.Seek(FHandle,PLoc);
                     IOabort('FreeBlock');
                     FIOx.Read(FHandle,PLen4,SIZE(LONGCARD));
                     IF FIOx.Error()#FIOx.NO_ERROR THEN
                       PLen4 := MAX(LONGCARD);
                     END;
                     IF (Len<MAX(LONGCARD)-SIZE(LONGCARD)*2) AND (PLen4<MAX(LONGCARD)-SIZE(LONGCARD)*2) AND FindIx(iH,PLen4,PLoc,Idx) THEN
                       DeleteIndex(iH,PLen4,PLoc);
                       Len := PLen4;
                       Loc := PLoc;
                     ELSE
                       EXIT;
                     END;
        | NoDealoc : CallFErr(fH,BadFree,'NoDealloc');
                     RETURN;
        ELSE
          CallFErr(fH,UnknownError,'FreeBlock');
          RETURN;
      END;
    END;
  END;
END FreeBlock;
(*# restore *)


PROCEDURE AllocateBlock(fH: FHandle; Len: LONGCARD): LONGCARD;

VAR
  Loc : LONGCARD;

  PROCEDURE Extend;
  BEGIN
    FIOx.Seek(fH^.FHandle,fH^.fwr^.FileSize+Len-1);
    IOabort('AllocateBlock.Extend');
    FIOx.Write(fH^.FHandle,0,1);
    IF FIOx.Error()=FIOx.DISK_FULL THEN
      FIOx.Truncate(fH^.FHandle,fH^.fwr^.FileSize);
      IOabort('AllocateBlock.Extend');
      Loc := Nil;
      RETURN;
    END;
    IOabort('AllocateBlock.Extend');
    Loc := fH^.fwr^.FileSize;
    INC(fH^.fwr^.FileSize,Len);
  END Extend;

VAR
  iH   : IHandle;
  ActLen4,
  tl   : LONGCARD;
  ActLen2,
  r    : CARDINAL;
  Safe : BOOLEAN;

BEGIN
  iH.ID := fH;
  iH.In := 0;
  WITH fH^ DO
    CASE fwr^.Mode OF
        FixSize  : IF Len >= MAX(CARDINAL)-8 THEN
                     CallFErr(fH,BadSize,'Allocate');
                     RETURN Nil;
                   END;
                   IF FindIndex(iH,Len,Loc) THEN
                     DeleteIndex(iH,Len,Loc);
                   ELSE
                     Extend;
                   END;
      | Size16,
        Compress : IF Len<4 THEN
                     Len := 4;
                   END;
                   IF Len >= MAX(CARDINAL)-8 THEN
                     CallFErr(fH,BadSize,'Allocate');
                     RETURN Nil;
                   END;
                   IF FindIndex(iH,Len,Loc) THEN
                     DeleteIndex(iH,Len,Loc);
                   ELSIF SearchIndex(iH,Len+4,Loc) THEN
                     FIOx.Seek(FHandle,Loc);
                     IOabort('AllocateBlock');
                     FIOx.Read(FHandle,ActLen2,SIZE(CARDINAL));
                     IOabort('AllocateBlock');
                     DeleteIndex(iH,ActLen2,Loc);
                     FreeBlock(fH,LONGCARD(ActLen2)-Len,Loc+Len);
                   ELSE
                     Extend;
                   END;
      | Size32   : IF Len<8 THEN
                     Len := 8;
                   END;
                   IF FindIndex(iH,Len,Loc) THEN
                     DeleteIndex(iH,Len,Loc);
                   ELSIF SearchIndex(iH,Len+8,Loc) THEN
                     FIOx.Seek(FHandle,Loc);
                     IOabort('AllocateBlock');
                     FIOx.Read(FHandle,ActLen4,SIZE(LONGCARD));
                     IOabort('AllocateBlock');
                     DeleteIndex(iH,ActLen4,Loc);
                     FreeBlock(fH,ActLen4-Len,Loc+Len);
                   ELSE
                     Extend;
                   END;
      | NoDealoc : Extend;
      ELSE
        CallFErr(fH,UnknownError,'Allocate Block');
        RETURN Nil;
    END;
  END;
  RETURN Loc;
END AllocateBlock;


PROCEDURE LockIx(dH: IHandle): BOOLEAN;

  PROCEDURE cLockIx(iH: IHandle): BOOLEAN;
  BEGIN
    IF iH#Null THEN
      IF NOT cLockIHandle(iH,Implicit) THEN
        RETURN FALSE;
      ELSIF NOT cLockIx(iH.ID^.Id[iH.In].NextIndx) THEN
        cUnLockIHandle(iH,Implicit);
        RETURN FALSE;
      END;
    END;
    RETURN TRUE;
  END cLockIx;

BEGIN
  IF NOT cLockIx(dH.ID^.Id[dH.In].NextIndx) THEN
    SetErr(dH,Locked);
    RETURN FALSE;
  ELSE
    RETURN TRUE;
  END;
END LockIx;


PROCEDURE UnLockIx(dH: IHandle);
BEGIN
  FollowNextIndx(dH);
  WHILE dH#Null DO
    cUnLockIHandle(dH,Implicit);
    FollowNextIndx(dH);
  END;
END UnLockIx;


PROCEDURE Delete(D: IHandle);
VAR
  r,
  Size,
  BSize : CARDINAL;
  t,
  BPos  : LONGCARD;
  iH,
  tH    : IHandle;
  Key   : KeyType;
BEGIN
  ClearErr(D);
  IF NOT IsData(D) THEN
    CallErr(D,NotData,'Delete');
    RETURN;
  END;
  IF D.ID^.ReadOnly THEN
    CallErr(D,BadWrite,'Delete with ReadOnly');
    RETURN;
  END;
  IF NOT cLocked(D,D.ID^.Id[D.In].LastDataRef) THEN
    CallErr(D,NotLocked,'Delete');
    RETURN;
  END;
  WITH D.ID^.Id[D.In] DO
    IF LastDataRef#Nil THEN
      IF LockFile(D.ID) THEN
        IF LockIx(D) THEN
          LoadRec(D,LastDataRef,BPos,BSize);
          iH := NextIndx;
          LOOP
            WHILE iH.ID#NIL DO
              iH.ID^.Id[iH.In].KeyFct(ADR(Key),bufPtr);
              DeleteIndex(iH,Key,LastDataRef);
              IF LastError(iH)#OK THEN
                SetErr(D,LastError(iH));
                tH := NextIndx;
                WHILE tH#iH DO
                  tH.ID^.Id[tH.In].KeyFct(ADR(Key),bufPtr);
                  AddIndex(tH,Key,LastDataRef);
                  IF LastError(tH)#OK THEN
                    ClearErr(D);
                    SetErr(D,LastError(tH));
                    EXIT;
                  END;
                  FollowNextIndx(tH);
                END;
                EXIT;
              END;
              FollowNextIndx(iH);
            END;
            FreeBlock(D.ID,LONGCARD(BSize),BPos);
            EXIT;
          END;
          cUnLock(D,LastDataRef,AllLocks);
          LastDataRef := Nil;
          IF LastError(D)=OK THEN
            DEC(iwr^.RecordCnt);
          END;
          UnLockIx(D);
        END;
        UnLockFile(D.ID);
      ELSE
        SetErr(D,Locked);
      END;
    END;
  END;
END Delete;


PROCEDURE Add(D: IHandle; Data: ARRAY OF BYTE; Length: CARDINAL);
VAR
  Size : CARDINAL;
  Buf  : ADDRESS;
  iH,
  tH   : IHandle;
  Key  : KeyType;
BEGIN
  ClearErr(D);
  IF NOT IsData(D) THEN
    CallErr(D,NotData,'Add');
    RETURN;
  END;
  IF D.ID^.ReadOnly THEN
    CallErr(D,BadWrite,'Add with ReadOnly');
    RETURN;
  END;
  WITH D.ID^.Id[D.In] DO
    IF LockFile(D.ID) THEN
      IF LockIx(D) THEN
        IF iwr^.RecordSize=0 THEN
          IF D.ID^.fwr^.Mode=Compress THEN
            AdjustBuffer(D,Length);
            Size := Packer(Length,ADR(Data),bufPtr);
            Buf := bufPtr;
          ELSE
            Size := Length;
            Buf := ADR(Data);
          END;
          LastDataRef := AllocateBlock(D.ID,LONGCARD(Size+SIZE(Size)))+SIZE(Size);
          IF LastDataRef#Nil THEN
            FIOx.Seek(D.ID^.FHandle,LastDataRef-SIZE(Size));
            IOabort('Add');
            FIOx.Write(D.ID^.FHandle,Size,SIZE(Size));
            IOabort('Add');
          END;
        ELSE
          Size := iwr^.RecordSize;
          Buf := ADR(Data);
          LastDataRef := AllocateBlock(D.ID,LONGCARD(Size));
          IF LastDataRef#Nil THEN
            FIOx.Seek(D.ID^.FHandle,LastDataRef);
            IOabort('Add');
          END;
        END;
        IF LastDataRef=Nil THEN
          UnLockIx(D);
          UnLockFile(D.ID);
          CallErr(D,FileError,'Add');
          RETURN;
        END;
        FIOx.Write(D.ID^.FHandle,Buf^,Size);
        IOabort('Add');
        iH := NextIndx;
        LOOP
          WHILE iH.ID#NIL DO
            iH.ID^.Id[iH.In].KeyFct(ADR(Key),ADR(Data));
            AddIndex(iH,Key,LastDataRef);
            IF LastError(iH)#OK THEN
              SetErr(D,LastError(iH));
              LOOP
                tH := NextIndx;
                WHILE tH#iH DO
                  tH.ID^.Id[tH.In].KeyFct(ADR(Key),ADR(Data));
                  DeleteIndex(tH,Key,LastDataRef);
                  IF LastError(tH)#OK THEN
                    ClearErr(D);
                    SetErr(D,LastError(tH));
                    EXIT;
                  END;
                  FollowNextIndx(tH);
                END;
                EXIT;
              END;
              IF iwr^.RecordSize=0 THEN
                FreeBlock(D.ID,LONGCARD(Size+SIZE(Size)),LastDataRef-SIZE(Size));
              ELSE
                FreeBlock(D.ID,LONGCARD(Size),LastDataRef);
              END;
              EXIT;
            END;
            FollowNextIndx(iH);
          END;
          EXIT;
        END;
        IF LastError(D)=OK THEN
          INC(iwr^.RecordCnt);
        END;
        UnLockIx(D);
      END;
      UnLockFile(D.ID);
    ELSE
      SetErr(D,Locked);
    END;
  END;
END Add;


PROCEDURE Change(D: IHandle; Data: ARRAY OF BYTE; Length: CARDINAL);
VAR
  BPos : LONGCARD;
  size : CARDINAL;
  t : CARDINAL;
  iH : IHandle;
  err : Errors;
  OldKey,
  NewKey : KeyType;
BEGIN
  ClearErr(D);
  IF NOT IsData(D) THEN
    CallErr(D,NotData,'Change');
    RETURN;
  END;
  IF D.ID^.ReadOnly THEN
    CallErr(D,BadWrite,'Change with ReadOnly');
    RETURN;
  END;
  IF (D.ID^.Id[D.In].iwr^.RecordSize=0) AND (D.ID^.fwr^.Mode=Compress) THEN
    CallErr(D,BadSize,'Change');
    RETURN;
  END;
  IF D.ID^.Id[D.In].LastDataRef=Nil THEN
    CallErr(D,BadIndex,'Change');
    RETURN;
  END;
  IF NOT cLocked(D,D.ID^.Id[D.In].LastDataRef) THEN
    CallErr(D,NotLocked,'Change');
    RETURN;
  END;
  LoadRec(D,D.ID^.Id[D.In].LastDataRef,BPos,size);
  IF size#Length THEN
    CallErr(D,BadSize,'Change');
    RETURN;
  END;
  err := OK;
  iH := D.ID^.Id[D.In].NextIndx;
  LOOP
    IF iH=Null THEN
      EXIT;
    END;
    WITH iH.ID^.Id[iH.In] DO
      KeyFct(ADR(OldKey),D.ID^.Id[D.In].bufPtr);
      KeyFct(ADR(NewKey),ADR(Data));
      IF CompFct(ADR(OldKey),ADR(NewKey))#Eq THEN
        err := BadIndex;
        EXIT;
      END;
      iH := NextIndx;
    END;
  END;
  CallErr(D,err,'Change');
  IF err=OK THEN
    FIOx.Seek(D.ID^.FHandle,D.ID^.Id[D.In].LastDataRef);
    IOabort('Change');
    FIOx.Write(D.ID^.FHandle,Data,size);
    IOabort('Change');
  END;
END Change;


PROCEDURE SyncIx(iH: IHandle; rec: ARRAY OF BYTE);
VAR
  tH : IHandle;
BEGIN
  tH := iH.ID^.Id[iH.In].DataPtr;
  IF tH.ID^.Id[tH.In].Sync THEN
    LOOP
      FollowNextIndx(tH);
      IF tH=Null THEN
        EXIT;
      END;
      IF tH#iH THEN
        WITH tH.ID^.Id[tH.In] DO
          LastKeyRef := iH.ID^.Id[iH.In].LastDataRef;
          KeyFct(ADR(LastKey),ADR(rec));
          LastKeyOK := TRUE;
          PageLevel := 0;
        END;
      END;
    END;
  END;
END SyncIx;


PROCEDURE Search(I: IHandle; Key: ARRAY OF BYTE;
                 VAR Data: ARRAY OF BYTE): BOOLEAN;
VAR
  r : BOOLEAN;
  t : CARDINAL;
BEGIN
  ClearErr(I);
  IF NOT IsIndex(I) THEN
    CallErr(I,NotIndex,'Search');
    RETURN FALSE;
  END;
  Release(I);
  IF cLockIHandle(I,Implicit) THEN
    r := SearchIndex(I,Key,I.ID^.Id[I.In].LastDataRef);
    WITH I.ID^.Id[I.In] DO
      IF NOT r THEN
        DataPtr.ID^.Id[DataPtr.In].LastDataRef := Nil;
      ELSE
        IF LockDat(I,LastDataRef) THEN
          DataPtr.ID^.Id[DataPtr.In].LastDataRef := LastDataRef;
          ReadRec(DataPtr,LastDataRef,Data);
(*
          l := DataPtr.ID^.Id[DataPtr.In].iwr^.RecordSize;
          IF l=0 THEN
            FIOx.Seek(DataPtr.ID^.FHandle,LastDataRef-2);
            IOabort('Search');
            FIOx.Read(DataPtr.ID^.FHandle,l,2);
            IOabort('Search');
          ELSE
            FIOx.Seek(DataPtr.ID^.FHandle,LastDataRef);
            IOabort('Search');
          END;
          FIOx.Read(DataPtr.ID^.FHandle,Data,l);
          IOabort('Search');
*)
          SyncIx(I,Data);
        ELSE
          r := FALSE;
        END;
      END;
    END;
    cUnLockIHandle(I,Implicit);
    RETURN r;
  ELSE
    RETURN FALSE;
  END;
END Search;


PROCEDURE Find(I: IHandle; Key: ARRAY OF BYTE;
               VAR Data: ARRAY OF BYTE): BOOLEAN;
VAR
  r : BOOLEAN;
  t : CARDINAL;
BEGIN
  ClearErr(I);
  IF NOT IsIndex(I) THEN
    CallErr(I,NotIndex,'Find');
    RETURN FALSE;
  END;
  Release(I);
  IF cLockIHandle(I,Implicit) THEN
    r := FindIndex(I,Key,I.ID^.Id[I.In].LastDataRef);
    WITH I.ID^.Id[I.In] DO
      IF r THEN
        IF LockDat(I,LastDataRef) THEN
          DataPtr.ID^.Id[DataPtr.In].LastDataRef := LastDataRef;
          ReadRec(DataPtr,LastDataRef,Data);
(*
          l := DataPtr.ID^.Id[DataPtr.In].iwr^.RecordSize;
          IF l=0 THEN
            FIOx.Seek(DataPtr.ID^.FHandle,LastDataRef-2);
            IOabort('Find');
            FIOx.Read(DataPtr.ID^.FHandle,l,2);
            IOabort('Find');
          ELSE
            FIOx.Seek(DataPtr.ID^.FHandle,LastDataRef);
            IOabort('Find');
          END;
          FIOx.Read(DataPtr.ID^.FHandle,Data,l);
          IOabort('Find');
*)
          SyncIx(I,Data);
        ELSE
          r := FALSE;
        END;
      ELSE
        DataPtr.ID^.Id[DataPtr.In].LastDataRef := Nil;
      END;
    END;
    cUnLockIHandle(I,Implicit);
    RETURN r;
  ELSE
    RETURN FALSE;
  END;
END Find;


PROCEDURE Next(I: IHandle; VAR Data: ARRAY OF BYTE): BOOLEAN;
VAR
  SerKey : IndexItem;
  Loc    : LONGCARD;
  r      : CARDINAL;
  ok     : BOOLEAN;
BEGIN
  ClearErr(I);
  IF NOT IsIndex(I) THEN
    CallErr(I,NotIndex,'Next');
    RETURN FALSE;
  END;
  IF cLockIHandle(I,Implicit) THEN
    WITH I.ID^.Id[I.In] DO
      IF NextIndex(I,Loc) THEN
        IF LockDat(I,Loc) THEN
          DataPtr.ID^.Id[DataPtr.In].LastDataRef := Loc;
          ReadRec(DataPtr,Loc,Data);
(*
          l := DataPtr.ID^.Id[DataPtr.In].iwr^.RecordSize;
          IF l=0 THEN
            FIOx.Seek(DataPtr.ID^.FHandle,Loc-2);
            IOabort('Next');
            FIOx.Read(DataPtr.ID^.FHandle,l,2);
            IOabort('Next');
          ELSE
            FIOx.Seek(DataPtr.ID^.FHandle,Loc);
            IOabort('Next');
          END;
          FIOx.Read(DataPtr.ID^.FHandle,Data,l);
          IOabort('Next');
*)
          SyncIx(I,Data);
          LastKeyOK := FALSE;
          ok := TRUE;
        ELSE
          PageLevel := 0;
          ok := FALSE;
        END;
      ELSE
        ok := FALSE;
      END;
    END;
    cUnLockIHandle(I,Implicit);
    RETURN ok;
  ELSE
    RETURN FALSE;
  END;
END Next;


PROCEDURE Prev(I: IHandle; VAR Data: ARRAY OF BYTE): BOOLEAN;
VAR
  SerKey : IndexItem;
  Loc    : LONGCARD;
  r      : CARDINAL;
  ok     : BOOLEAN;
BEGIN
  ClearErr(I);
  IF NOT IsIndex(I) THEN
    CallErr(I,NotIndex,'Prev');
    RETURN FALSE;
  END;
  IF cLockIHandle(I,Implicit) THEN
    WITH I.ID^.Id[I.In] DO
      IF PrevIndex(I,Loc) THEN
        IF LockDat(I,Loc) THEN
          DataPtr.ID^.Id[DataPtr.In].LastDataRef := Loc;
          ReadRec(DataPtr,Loc,Data);
(*
          l := DataPtr.ID^.Id[DataPtr.In].iwr^.RecordSize;
          IF l=0 THEN
            FIOx.Seek(DataPtr.ID^.FHandle,Loc-2);
            IOabort('Prev');
            FIOx.Read(DataPtr.ID^.FHandle,l,2);
            IOabort('Prev');
          ELSE
            FIOx.Seek(DataPtr.ID^.FHandle,Loc);
            IOabort('Prev');
          END;
          FIOx.Read(DataPtr.ID^.FHandle,Data,l);
          IOabort('Prev');
*)
          SyncIx(I,Data);
          LastKeyOK := FALSE;
          ok := TRUE;
        ELSE
          PageLevel := 0;
          ok := FALSE;
        END;
      ELSE
        ok := FALSE;
      END;
    END;
    cUnLockIHandle(I,Implicit);
    RETURN ok;
  ELSE
    RETURN FALSE;
  END;
END Prev;


PROCEDURE Reset(H: IHandle);
VAR
  iH : IHandle;
BEGIN
  ClearErr(H);
  IF NOT IsIHandle(H) THEN
    CallFErr(H.ID,NotIHandle,'Reset');
    RETURN;
  END;
  IF IsData(H) THEN
    iH := H.ID^.Id[H.In].NextIndx;
    WHILE iH.ID#NIL DO
      Reset(iH);
      FollowNextIndx(iH);
    END;
  ELSE
    H.ID^.Id[H.In].PageLevel := 0;
    H.ID^.Id[H.In].LastKeyOK := FALSE;
    Release(H);
  END;
  H.ID^.Id[H.In].LastDataRef := Nil;
END Reset;


PROCEDURE UpdateSlot(iH: IHandle);
BEGIN
  FIOx.Seek(iH.ID^.FHandle,iH.ID^.Id[iH.In].ihLock.Position);
  IOabort('UpdateSlot');
  FIOx.Write(iH.ID^.FHandle,iH.ID^.Id[iH.In].iwr^,IndexDataWrSize);
  IOabort('UpdateSlot');
END UpdateSlot;


PROCEDURE OpenIx(VAR iH: IHandle; CmpFct: CompareFunction; KeSize: CARDINAL;
                 DpKey: BOOLEAN; Create: BOOLEAN);
VAR
  t : TPage;
  i,
  r : CARDINAL;
BEGIN
  WITH iH.ID^.Id[iH.In] DO
    LastDataRef := Nil;
    NextIndx := Null;
    LastErr := OK;
    ErrorNest := 0;
    DataPtr := Null;
    PageLevel := 0;
    CompFct := CmpFct;
    KeyFct := NULLPROC;
    LastKeyOK := FALSE;
    IF Create THEN
      OldWriteCnt := 0;
      AllocMem(PageRefs,VSIZE(PageRef.Height)+10*SIZE(PageRefRec));
      Die(PageRefs=NIL,OutOfMemory);
      PageRefs^.Height := 10;
      iwr^.RecordCnt := 0;
      iwr^.WriteCnt := 0;
      IF iH.In=0 THEN
        iwr^.TopPage := iH.ID^.fwr^.FileSize;
        INC(iH.ID^.fwr^.FileSize,PageSize);
      ELSE
        iwr^.TopPage := AllocateBlock(iH.ID,PageSize);
      END;
      iwr^.Depth := 1;
      iwr^.KeySize := KeSize;
      iwr^.N2 := N2Eval(KeSize);
      IF iwr^.N2=MAX(CARDINAL) THEN
        SetFErr(iH.ID,KeyTooBig);
        RETURN;
      END;
      iwr^.N22 := iwr^.N2 DIV 2;
      iwr^.DupKey := DpKey;
      (* create empty Root Page *)
      t.ICount := 0;
      t.IItem.IP := Nil;
      iwr^.Ft := IndexSlot;
      FIOx.Seek(iH.ID^.FHandle,iwr^.TopPage);
      IOabort('OpenIx');
      FIOx.Write(iH.ID^.FHandle,t,SIZE(t));
      IOabort('OpenIx');
      UpdateSlot(iH);
    ELSE
      IF (iwr^.Ft#IndexSlot) OR (iwr^.KeySize#KeSize) OR (iwr^.DupKey#DpKey) THEN
        CallFErr(iH.ID,BadIndex,'OpenIx');
        RETURN;
      END;
      OldWriteCnt := iwr^.WriteCnt;
      i := 10;
      IF i+2 < iwr^.Depth THEN
        i := (iwr^.Depth-i)*2+i;
      END;
      AllocMem(PageRefs,VSIZE(PageRef.Height)+i*SIZE(PageRefRec));
      Die(PageRefs=NIL,OutOfMemory);
      PageRefs^.Height := i;
    END;
    Ft := IndexSlot;
  END;
END OpenIx;


(*# save *)
(*%T _fcall *) (*# call(near_call=>off) *) (*%E *)
PROCEDURE SizeCmp4(VAR a,b: LONGCARD): CmpRes;
BEGIN
  IF a < b THEN
    RETURN Less;
  ELSIF a = b THEN
    RETURN Eq;
  ELSE
    RETURN Greater;
  END;
END SizeCmp4;
(*# restore *)


(*# save *)
(*%T _fcall *) (*# call(near_call=>off) *) (*%E *)
PROCEDURE SizeCmp2(VAR a,b: CARDINAL): CmpRes;
BEGIN
  IF a < b THEN
    RETURN Less;
  ELSIF a = b THEN
    RETURN Eq;
  ELSE
    RETURN Greater;
  END;
END SizeCmp2;
(*# restore *)


PROCEDURE Open(Name: ARRAY OF CHAR; MaxIHandle: CARDINAL; AMode : AccessMode;
               readOnly, shared, Create: BOOLEAN): FHandle;

VAR
  iH : IHandle;
  h,
  r,
  i  : CARDINAL;
  lck : FIOx.LockRec;

(*# save *)
(*# call(o_a_size=>on) *)
  PROCEDURE Abort(str : ARRAY OF CHAR);
  BEGIN
    IF iH.ID # NIL THEN
      IF iH.ID^.FHandle#MAX(CARDINAL) THEN
        FIOx.Close(iH.ID^.FHandle);
        IOabort('Open.Abort');
      END;
      FreeMem(iH.ID);
    END;
    CallErr(Null,BadOpen,str);
  END Abort;
(*# restore *)

BEGIN
  IF (AMode=Compress) AND NOT Packing() THEN
    CallErr(Null,BadOpen,'Compress w/o PACK');
    RETURN NIL;
  END;
  IF readOnly AND Create THEN
    CallErr(Null,BadOpen,'ReadOnly with Create');
    RETURN NIL;
  END;
  IF shared AND Create THEN
    CallErr(Null,BadOpen,'Shared with Create');
  END;
  r := FIOx.Open(Name,shared,readOnly,Create);
  IF r=MAX(CARDINAL) THEN
    CallErr(Null,FileError,'Create');
    RETURN NIL;
  END;
  h := SIZE(IndexDataWr)*MaxIHandle+SIZE(IndexFileWr);
  IF h MOD SectorSize#0 THEN
    h := h+SectorSize-(h MOD SectorSize);
  END;
  i := IndexDataSize*MaxIHandle+IndexFileSize+h;
  AllocMem(iH.ID,i);
  Die(iH.ID=NIL,OutOfMemory);
  iH.In := 0;
  WITH iH.ID^ DO
    ReadOnly := readOnly;
    Buffered := NOT shared OR readOnly OR NOT FIOx.MultiFile(r);
    WriteThru := FALSE;
    FOR i := 0 TO LockQSize-1 DO
      Locks[i] := LockRec(Nil,0,0,Null);
    END;
    fhLock := LockRec(0,0,0,Null);
    FHandle := r;
    fwr := AddAddr(iH.ID,IndexFileSize+IndexDataSize*MaxIHandle);
    FOR i := 0 TO MaxIHandle DO
      WITH Id[i] DO
        ihLock := LockRec(0,0,0,Null);
        ihLock.Position := SIZE(IndexFileWr)+SIZE(IndexDataWr)*VAL(LONGCARD,i);
        Ft := FreeSlot;
        iwr := AddAddr(fwr,VAL(CARDINAL,ihLock.Position));
      END;
    END;
    IF Create THEN
      fwr^.HeaderSize := h;
      fwr^.FileSize := VAL(LONGCARD,h);
      fwr^.Version := ThisVersion;
      fwr^.FreeList := Nil;
      fwr^.IndexCount :=MaxIHandle;
      fwr^.Mode := AMode;
      fwr^.PageSz := PageSize;
      fwr^.MaxKeySz := MaxKeySize;
      FOR i := 0 TO MaxIHandle DO
        Id[i].iwr^.Ft := FreeSlot;
      END;
      FIOx.Write(FHandle,fwr^,fwr^.HeaderSize);
      IOabort('Open');
    ELSE
      lck.pos := 0;
      lck.len := SIZE(fwr^.HeaderSize);
      IF NOT Buffered AND NOT FIOx.Lock(FHandle,lck) THEN
        Abort('Lock failure');
        RETURN NIL;
      END;
      FIOx.Read(FHandle,fwr^.HeaderSize,SIZE(fwr^.HeaderSize));
      IF NOT Buffered THEN
        FIOx.UnLock(FHandle,lck);
      END;
      IF FIOx.Error()#FIOx.PAST_EOF THEN
        IOabort('Open');
      END;
      IF (FIOx.Error()=FIOx.PAST_EOF) OR (h#fwr^.HeaderSize) THEN
        Abort('HeaderSize');
        RETURN NIL;
      END;
      lck.pos := 0;
      lck.len := VAL(LONGCARD,fwr^.HeaderSize);
      IF NOT Buffered AND NOT FIOx.Lock(FHandle,lck) THEN
        Abort('Lock failure(2)');
      END;
      FIOx.Read(FHandle,fwr^.FileSize,fwr^.HeaderSize-SIZE(fwr^.HeaderSize));
      IF NOT Buffered THEN
        FIOx.UnLock(FHandle,lck);
      END;
      IF FIOx.Error()#FIOx.PAST_EOF THEN
        IOabort('Open');
      END;
      IF FIOx.Error()=FIOx.PAST_EOF THEN
        Abort('I/O Error');
        RETURN NIL;
      ELSIF (fwr^.Version DIV 10) # (ThisVersion DIV 10) THEN
        Abort('Version');  (* The version number's ones digit isn't tested! *)
        RETURN NIL;
      ELSIF fwr^.Mode#AMode THEN
        Abort('Accessmode');
        RETURN NIL;
      ELSIF fwr^.IndexCount#MaxIHandle THEN
        Abort('MaxIHandle');
        RETURN NIL;
      ELSIF fwr^.PageSz#PageSize THEN
        Abort('PageSize');
        RETURN NIL;
      ELSIF fwr^.MaxKeySz#MaxKeySize THEN
        Abort('MaxKeySize');
        RETURN NIL;
      END;
    END;
    IF AMode=Size32 THEN
      OpenIx(iH,CompareFunction(SizeCmp4),4,TRUE,Create);
    ELSE
      OpenIx(iH,CompareFunction(SizeCmp2),2,TRUE,Create);
    END;
    IF iH=Null THEN
      Abort('Unknown error');
      RETURN NIL;
    END;
  END;
  iH.ID^.G1 := GuardV1;
  iH.ID^.G2 := GuardV2;
  ClearFErr(iH.ID);
  RETURN iH.ID;
END Open;


PROCEDURE OpenIndex(F: FHandle; D: IHandle; I: CARDINAL;
                    CmpFct: CompareFunction; KeFct: KeyFunction;
                    KeSize: CARDINAL; DpKey,New: BOOLEAN): IHandle;
VAR
  iH  : IHandle;
  idx : CARDINAL;
BEGIN
  ClearFErr(F);
  IF NOT IsFHandle(F) THEN
    CallFErr(F,NotFHandle,'OpenIndex');
    RETURN Null;
  END;
  IF (D#Null) AND NOT IsData(D) THEN
    CallFErr(F,NotData,'OpenIndex');
    RETURN Null;
  END;
  IF New AND NOT F^.Buffered THEN
    CallFErr(F,BadOpen,'New with Sharing');
    RETURN Null;
  END;
  IF (F^.fwr^.IndexCount<I) OR ((F^.Id[I].iwr^.Ft#FreeSlot)=New) THEN
    CallFErr(F,NoSlot,'Index');
    RETURN Null;
  END;
  IF New AND F^.ReadOnly THEN
    CallFErr(F,BadOpen,'New with ReadOnly');
    RETURN Null;
  END;
  iH.ID := F;
  iH.In := I;
  OpenIx(iH,CmpFct,KeSize,DpKey,New);
  IF iH#Null THEN
    WITH iH.ID^.Id[I] DO
      IF (KeFct#NULLPROC) AND (D#Null) THEN
        KeyFct := KeFct;
        NextIndx := D.ID^.Id[D.In].NextIndx;
        D.ID^.Id[D.In].NextIndx := iH;
        DataPtr := D;
      END;
    END;
  END;
  RETURN iH;
END OpenIndex;


PROCEDURE OpenData(F: FHandle; I,RSize: CARDINAL; New: BOOLEAN): IHandle;
VAR
  dH : IHandle;
BEGIN
  ClearFErr(F);
  IF NOT IsFHandle(F) THEN
    CallFErr(F,NotFHandle,'OpenData');
    RETURN Null;
  END;
  IF New AND NOT F^.Buffered THEN
    CallFErr(F,BadOpen,'New with Sharing');
    RETURN Null;
  END;
  IF (F^.fwr^.IndexCount<I) OR ((F^.Id[I].iwr^.Ft#FreeSlot)=New) THEN
    CallFErr(F,NoSlot,'Data');
    RETURN Null;
  END;
  IF (RSize=0) AND (F^.fwr^.Mode=FixSize) THEN
    CallFErr(F,BadOpen,'OpenData');
    RETURN Null;
  END;
  IF New AND F^.ReadOnly THEN
    CallFErr(F,BadOpen,'New with ReadOnly');
  END;
  dH.ID := F;
  dH.In := I;
  WITH dH.ID^.Id[dH.In] DO
    LastDataRef := Nil;
    NextIndx := Null;
    LastErr := OK;
    ErrorNest := 0;
    Sync := FALSE;
    bufSize := RSize;
    IF RSize=0 THEN
      bufPtr := NIL;
    ELSE
      AllocMem(bufPtr,RSize);
      Die(bufPtr=NIL,OutOfMemory);
    END;
    IF New THEN
      iwr^.Ft := DataSlot;
      iwr^.RecordSize := RSize;
      iwr^.RecordCnt := 0;
      UpdateSlot(dH);
    ELSE
      IF iwr^.Ft # DataSlot THEN
        CallFErr(F,NotData,'OpenData');
        RETURN Null;
      ELSIF iwr^.RecordSize # RSize THEN
        CallFErr(F,BadSize,'OpenData');
        RETURN Null;
      END;
    END;
    Ft := DataSlot;
  END;
  RETURN dH;
END OpenData;


PROCEDURE FreeIHandle(VAR H: IHandle);
VAR
  dH : IHandle;
  iH : IHandle;
BEGIN
  ClearErr(H);
  ClearFErr(H.ID);
  IF NOT IsIHandle(H) THEN
    CallFErr(H.ID,NotIHandle,'FreeIHandle');
    RETURN;
  END;
  IF NOT H.ID^.Buffered AND IsIndex(H) AND (H.ID^.Id[H.In].DataPtr#Null) THEN
    CallErr(H,BadFree,'FreeIHandle');
    RETURN;
  END;
  IF IsData(H) THEN
    dH := H.ID^.Id[H.In].NextIndx;
    WHILE dH # Null DO
      iH := dH;
      FollowNextIndx(dH);
      iH.ID^.Id[iH.In].NextIndx := Null;
      iH.ID^.Id[iH.In].DataPtr := Null;
      FreeIHandle(iH);
    END;
  ELSE
    dH := H.ID^.Id[H.In].DataPtr;
    LOOP
      IF dH.ID=NIL THEN
        EXIT;
      END;
      iH := dH.ID^.Id[dH.In].NextIndx;
      IF iH=H THEN
        dH.ID^.Id[dH.In].NextIndx := iH.ID^.Id[iH.In].NextIndx;
        EXIT;
      END;
      FollowNextIndx(dH);
    END;
  END;
  WITH H.ID^.Id[H.In] DO
    CASE Ft OF
        IndexSlot : FreeMem(PageRefs);
                    SaveBuffers(H);
                    ClearBuffers(H);
      | DataSlot  : FreeMem(bufPtr);
      ELSE
        (* ignore *)
    END;
    Ft := FreeSlot;
    DataPtr := Null;
  END;
  H := Null;
END FreeIHandle;


PROCEDURE ClearIndex(VAR I: IHandle);

VAR
  TP : TPage;

TYPE
  IPtr = POINTER Seg(TP) TO IndexItem;
  A2 = ARRAY[0..1] OF SHORTCARD;

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE AddIPtr(A: IPtr; I: CARDINAL): IPtr=A2(003H,0C1H);(*add ax,cx*)
(*# restore *)

  PROCEDURE Free(Page: LONGCARD; Level: CARDINAL);
  VAR
    i  : CARDINAL;
    IP : IPtr;
  BEGIN
    WITH I.ID^.Id[I.In] DO
      IF Level=iwr^.Depth THEN
        ClearPage(I,Page);
        FreeBlock(I.ID,PageSize,Page);
      ELSE
        i := 0;
        IP := IPtr(Ofs((TP.IItem)));
        LOOP
          ReadPage(I,Page,TP);
          IF i>TP.ICount THEN
            EXIT;
          END;
          Free(IP^.IP,Level+1);
          INC(i);
          IncAddr(IP,8+iwr^.KeySize);
        END;
        ClearPage(I,Page);
        FreeBlock(I.ID,PageSize,Page);
      END;
    END;
  END Free;

BEGIN
  ClearErr(I);
  ClearFErr(I.ID);
  IF NOT IsIndex(I) THEN
    CallErr(I,NotIndex,'ClearIndex');
    RETURN;
  END;
  IF NOT I.ID^.Buffered THEN
    CallErr(I,BadFree,'ClearIndex');
    RETURN;
  END;
  IF I.ID^.ReadOnly THEN
    CallErr(I,BadWrite,'ClearIndex with ReadOnly');
  END;
  Free(I.ID^.Id[I.In].iwr^.TopPage,1);
  FreeIHandle(I);
END ClearIndex;


PROCEDURE Close(VAR F: FHandle);
VAR
  idx : CARDINAL;
  iH  : IHandle;
BEGIN
  ClearFErr(F);
  IF NOT IsFHandle(F) THEN
    CallFErr(F,NotFHandle,'Close');
    RETURN;
  END;
  iH.ID := F;
  iH.In := MAX(CARDINAL);
  SaveBuffers(iH);
  ClearBuffers(iH);
  Flush(F);
  iH.In := 0;
  WITH F^ DO
    IF NOT Buffered THEN
      FOR idx := 0 TO LockQSize-1 DO
        IF Locks[idx].Position#Nil THEN
          ccUnLock(iH,Locks[idx],AllLocks);
        END;
      END;
    END;
    FOR idx := 0 TO F^.fwr^.IndexCount DO
      WITH Id[idx] DO
        IF NOT Buffered AND ((ihLock.ICnt#0) OR (ihLock.ECnt#0)) THEN
          ccUnLock(iH,ihLock,AllLocks);
        END;
        CASE Ft OF
            IndexSlot : FreeMem(PageRefs);
          | DataSlot  : FreeMem(bufPtr);
          ELSE
            (* ignore *)
        END;
      END;
    END;
    IF NOT Buffered AND ((fhLock.ICnt#0) OR (fhLock.ECnt#0)) THEN
      ccUnLock(iH,fhLock,AllLocks);
    END;
    FIOx.Close(FHandle);
  END;
  F^.G1 := 0;
  F^.G2 := 0;
  FreeMem(F);
END Close;


PROCEDURE Allocate(F: FHandle; Length: LONGCARD): LONGCARD;
VAR
  Pos : LONGCARD;
  iH  : IHandle;
  ok  : BOOLEAN;
BEGIN
  ClearFErr(F);
  IF NOT IsFHandle(F) THEN
    CallFErr(F,NotFHandle,'Allocate');
    RETURN MAX(LONGCARD);
  END;
  IF F^.ReadOnly THEN
    CallFErr(F,BadWrite,'Allocate with ReadOnly');
    RETURN MAX(LONGCARD);
  END;
  IF LockFile(F) THEN
    Pos := AllocateBlock(F,Length+4);
    IF Pos=Nil THEN
      CallFErr(F,FileError,'Allocate');
      RETURN Nil;
    END;
    FIOx.Seek(F^.FHandle,Pos);
    IOabort('Allocate');
    FIOx.Write(F^.FHandle,Length+4,4);
    IOabort('Allocate');
    iH.ID := F;
    iH.In := 0;
    ok := cLock(iH,Pos+4,Explicit);
    UnLockFile(F);
    RETURN Pos+4;
  ELSE
    RETURN MAX(LONGCARD);
  END;
END Allocate;


PROCEDURE DeAllocate(F: FHandle; Position: LONGCARD);
VAR
  Len : LONGCARD;
  r   : CARDINAL;
  iH  : IHandle;
BEGIN
  ClearFErr(F);
  IF NOT IsFHandle(F) THEN
    CallFErr(F,NotFHandle,'DeAllocate');
    RETURN;
  END;
  IF F^.ReadOnly THEN
    CallFErr(F,BadWrite,'DeAllocate with ReadOnly');
    RETURN;
  END;
  iH.ID := F;
  iH.In := 0;
  IF NOT cLocked(iH,Position) THEN
    CallFErr(F,NotLocked,'Write');
  END;
  SetFErr(F,OK);
  IF LockFile(F) THEN
    FIOx.Seek(F^.FHandle,Position-4);
    IOabort('DeAllocate');
    FIOx.Read(F^.FHandle,Len,4);
    IOabort('DeAllocate');
    FreeBlock(F,Len,Position-4);
    cUnLock(iH,Position,AllLocks);
    UnLockFile(F);
  END;
END DeAllocate;


PROCEDURE Read(F: FHandle; Position: LONGCARD; Length: CARDINAL;
               VAR Data: ARRAY OF BYTE);
VAR
  iH : IHandle;
BEGIN
  ClearFErr(F);
  IF NOT IsFHandle(F) THEN
    CallFErr(F,NotFHandle,'Read');
    RETURN;
  END;
  iH.ID := F;
  iH.In := 0;
  IF NOT cLocked(iH,Position) THEN
    CallFErr(F,NotLocked,'Read');
  END;
  SetFErr(F,OK);
  FIOx.Seek(F^.FHandle,Position);
  IOabort('Read');
  FIOx.Read(F^.FHandle,Data,Length);
  IOabort('Read');
END Read;


PROCEDURE Write(F: FHandle; Position: LONGCARD; Length: CARDINAL;
                Data: ARRAY OF BYTE);
VAR
  iH : IHandle;
BEGIN
  ClearFErr(F);
  IF NOT IsFHandle(F) THEN
    CallFErr(F,NotFHandle,'Write');
    RETURN;
  END;
  IF F^.ReadOnly THEN
    CallFErr(F,BadWrite,'Write with ReadOnly');
    RETURN;
  END;
  iH.ID := F;
  iH.In := 0;
  IF NOT cLocked(iH,Position) THEN
    CallFErr(F,NotLocked,'Write');
  END;
  FIOx.Seek(F^.FHandle,Position);
  IOabort('Write');
  FIOx.Write(F^.FHandle,Data,Length);
  IOabort('Write');
END Write;


PROCEDURE Flush(F: FHandle);
VAR
  idx : CARDINAL;
  iH : IHandle;
BEGIN
  ClearFErr(F);
  IF NOT IsFHandle(F) THEN
    CallFErr(F,NotFHandle,'Flush');
    RETURN;
  END;
  iH.ID := F;
  IF F^.Buffered THEN
    FOR idx := 0 TO F^.fwr^.IndexCount DO
      iH.In := idx;
      FlushIHandle(iH);
    END;
    FlushFHandle(F);
  ELSE
    FOR idx := 0 TO F^.fwr^.IndexCount DO
      WITH F^.Id[idx] DO
        IF (Ft#FreeSlot) AND ((ihLock.ECnt#0) OR (ihLock.ICnt#0)) THEN
          iH.In := idx;
          FlushIHandle(iH);
        END;
      END;
    END;
    IF (F^.fhLock.ECnt#0) OR (F^.fhLock.ICnt#0) THEN
      FlushFHandle(F);
    END;
  END;
  FIOx.Flush(F^.FHandle);
END Flush;


PROCEDURE AddIndex(I: IHandle; Key: ARRAY OF BYTE; DataLoc: LONGCARD);

VAR
  TP       : xTPage;

TYPE
  IPtr = POINTER Seg(TP) TO IndexItem;
  A2 = ARRAY[0..1] OF SHORTCARD;

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE AddIPtr(A: IPtr; I: CARDINAL): IPtr=A2(003H,0C1H);(*add ax,cx*)
(*# restore *)

VAR
  InsKey   : IndexItem;
  C        : CmpRes;
  r,
  Level    : CARDINAL;
  b        : BOOLEAN;
  ItemSize : CARDINAL;
  Index    : CARDINAL;
  Page,
  PageTmp  : LONGCARD;
  IP,
  NP,
  XP       : IPtr;

BEGIN
  ClearErr(I);
  IF NOT IsIndex(I) THEN
    CallErr(I,NotIndex,'AddIndex');
    RETURN;
  END;
  IF I.ID^.ReadOnly THEN
    CallErr(I,BadWrite,'AddIndex with ReadOnly');
    RETURN;
  END;
  IF LockFile(I.ID) THEN
    IF cLockIHandle(I,Implicit) THEN
      WITH I.ID^.Id[I.In] DO
        ItemSize := 8+iwr^.KeySize;
        InsKey.IP := Nil;
        InsKey.DP := DataLoc;
        MemFastMove(ADR(Key),ADR(InsKey.Key),iwr^.KeySize);
        b := FindIx(I,InsKey.Key,DataLoc,Ins);
        IF LastError(I)=OK THEN
          Level := PageLevel;
          Index := PageRefs^.Refs[Level].Rec;
          Page  := PageRefs^.Refs[Level].Page;
          ReadPage(I,Page,TPage(TP));
          IF TP.ICount=iwr^.N2 THEN
            FIOx.Truncate(I.ID^.FHandle,I.ID^.fwr^.FileSize+VAL(LONGCARD,PageRefs^.Refs[PageLevel].Cnt)*PageSize);
            IF FIOx.Error()#FIOx.NO_ERROR THEN
              FIOx.Truncate(I.ID^.FHandle,I.ID^.fwr^.FileSize);
              IOabort('AddIndex');
              cUnLockIHandle(I,Implicit);
              UnLockFile(I.ID);
              CallErr(I,FileError,'AddIndex');
              RETURN;
            END;
            IOabort('AddIndex');
          END;
          LOOP
            IP := AddIPtr(IPtr(Ofs((TP.IItem))),Index*ItemSize);
            XP := AddIPtr(IP,ItemSize);
            INC(TP.ICount);
            MemMove(ADR(IP^),ADR(XP^),ItemSize*(TP.ICount-(Index+1))+4);
            MemFastMove(ADR(InsKey),ADR(IP^),ItemSize);
            IF TP.ICount<=iwr^.N2 THEN
              EXIT;
            ELSE
              NP := AddIPtr(IPtr(Ofs((TP.IItem))),ItemSize*iwr^.N22);
              MemFastMove(ADR(NP^),ADR(InsKey),ItemSize);
              TP.ICount := iwr^.N22;
              IncAddr(NP,ItemSize);
              IF I.In=0 THEN
                InsKey.IP := AllocateFreeBlock(I.ID);
              ELSE
                InsKey.IP := AllocateBlock(I.ID,PageSize);
              END;
              WritePage(I,InsKey.IP,TPage(TP));
              MemFastMove(ADR(NP^),ADR(TP.IItem),ItemSize*iwr^.N22+4);
              WritePage(I,Page,TPage(TP));
              DEC(Level);
              IF Level=0 THEN
                TP.ICount := 1;
                MemFastMove(ADR(InsKey),ADR(TP.IItem),ItemSize);
                IP := AddIPtr(IPtr(Ofs((TP.IItem))),ItemSize);
                IP^.IP := iwr^.TopPage;
                IF I.In=0 THEN
                  iwr^.TopPage := AllocateFreeBlock(I.ID);
                ELSE
                  iwr^.TopPage := AllocateBlock(I.ID,PageSize);
                END;
                Page := iwr^.TopPage;
                INC(iwr^.Depth);
                IF iwr^.Depth>PageRefs^.Height THEN
                  FreeMem(PageRefs);
                  r := iwr^.Depth+1;
                  AllocMem(PageRefs,VSIZE(PageRef.Height)+r*SIZE(PageRefRec));
                  Die(PageRefs=NIL,OutOfMemory);
                  PageRefs^.Height := r;
                END;
                EXIT;
              END;
            END;
            Index := PageRefs^.Refs[Level].Rec;
            Page  := PageRefs^.Refs[Level].Page;
            ReadPage(I,Page,TPage(TP));
          END;
          WritePage(I,Page,TPage(TP));
          PageLevel := 0;
        END;
        IF LastError(I)=OK THEN
          INC(iwr^.RecordCnt);
        END;
      END;
      cUnLockIHandle(I,Implicit);
    END;
    FIOx.Truncate(I.ID^.FHandle,I.ID^.fwr^.FileSize);
    UnLockFile(I.ID);
  ELSE
    SetErr(I,Locked);
  END;
END AddIndex;


PROCEDURE DeleteIndex(I: IHandle; Key: ARRAY OF BYTE; DataLoc: LONGCARD);

VAR
  TP : TPage;

TYPE
  IPtr = POINTER Seg(TP) TO IndexItem;
  A2 = ARRAY[0..1] OF SHORTCARD;

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  PROCEDURE AddIPtr(A: IPtr; I: CARDINAL): IPtr=A2(003H,0C1H);(*add ax,cx*)
(*# restore *)

VAR
  QP,
  RP       : TPage;
  DelKey   : IndexItem;
  Level    : CARDINAL;
  ItemSize : CARDINAL;
  Page,
  RPage    : LONGCARD;
  IP,
  JP,
  NP       : IPtr;

(* 07/23/90 DWD - This procedure has not yet been optimized
                  by using MemFastMove() *)
BEGIN
  ClearErr(I);
  IF NOT IsIndex(I) THEN
    CallErr(I,NotIndex,'DeleteIndex');
    RETURN;
  END;
  IF I.ID^.ReadOnly THEN
    CallErr(I,BadWrite,'DeleteIndex with ReadOnly');
    RETURN;
  END;
  IF LockFile(I.ID) THEN
    IF cLockIHandle(I,Implicit) THEN
      WITH I.ID^.Id[I.In] DO
        LOOP
          ItemSize := 8+iwr^.KeySize;
          DelKey.DP := DataLoc;
          MemFastMove(ADR(Key),ADR(DelKey.Key),iwr^.KeySize);
          IF NOT FindIx(I,DelKey.Key,DataLoc,Idx) THEN
            CallErr(I,BadIndex,'DelIndex');
            EXIT;
          END;
          Level := PageLevel;
          Page := PageRefs^.Refs[PageLevel].Page;
          ReadPage(I,Page,TP);
          IP := AddIPtr(IPtr(Ofs((TP.IItem))),ItemSize*PageRefs^.Refs[PageLevel].Rec);
          IF PageLevel#iwr^.Depth THEN
            INC(Level);
            NP := IP;
            IncAddr(NP,ItemSize);
            INC(PageRefs^.Refs[PageLevel].Rec);
            Page := NP^.IP;
            LOOP
              ReadPage(I,Page,QP);
              PageRefs^.Refs[Level].Rec := 0;
              PageRefs^.Refs[Level].Page := Page;
              IF Level=iwr^.Depth THEN
                EXIT;
              END;
              Page := QP.IItem.IP;
              INC(Level);
            END;
            MemFastMove(ADR(QP.IItem.DP),ADR(IP^.DP),iwr^.KeySize+4);
            WritePage(I,PageRefs^.Refs[PageLevel].Page,TP);
            TP:=QP;
            PageLevel := iwr^.Depth;
            IP := AddIPtr(IPtr(Ofs((TP.IItem))),ItemSize*PageRefs^.Refs[PageLevel].Rec)
          END;
          NP := IP;
          IncAddr(NP,ItemSize);
          DEC(TP.ICount);
          MemFastMove(ADR(NP^),ADR(IP^),ItemSize*(TP.ICount-PageRefs^.Refs[PageLevel].Rec));
          WHILE (TP.ICount<iwr^.N22) AND (PageLevel#1) DO
            IF PageRefs^.Refs[PageLevel-1].Rec=0 THEN
              (* Has got a right sibling *)
              ReadPage(I,PageRefs^.Refs[PageLevel-1].Page,QP);
              IP := AddIPtr(IPtr(Ofs((TP.IItem))),ItemSize*TP.ICount);
              JP := AddIPtr(IPtr(Ofs((QP.IItem))),ItemSize*(PageRefs^.Refs[PageLevel-1].Rec+1));
              RPage :=  JP^.IP;
              DecAddr(JP,ItemSize);
              ReadPage(I,RPage,RP);
              MemFastMove(ADR(JP^.DP),ADR(IP^.DP),iwr^.KeySize+4);
              INC(TP.ICount);
              IF RP.ICount>iwr^.N22 THEN
                IncAddr(IP,ItemSize);
                IP^.IP := RP.IItem.IP;
                MemFastMove(ADR(RP.IItem.DP),ADR(JP^.DP),iwr^.KeySize+4);
                DEC(RP.ICount);
                IP := AddIPtr(IPtr(Ofs((RP.IItem))),ItemSize);
                MemFastMove(ADR(IP^),ADR(RP.IItem),ItemSize*RP.ICount+4);
                WritePage(I,RPage,RP);
                WritePage(I,PageRefs^.Refs[PageLevel].Page,TP);
                WritePage(I,PageRefs^.Refs[PageLevel-1].Page,QP);
                PageLevel :=0;
                EXIT;
              END;
              IncAddr(IP,ItemSize);
              MemFastMove(ADR(RP.IItem),ADR(IP^),ItemSize*iwr^.N22+4);
              TP.ICount := iwr^.N2;
              IP := JP;
              IncAddr(IP,ItemSize);
              DEC(QP.ICount);
              MemFastMove(ADR(IP^.DP),ADR(JP^.DP),ItemSize*(QP.ICount-PageRefs^.Refs[PageLevel-1].Rec));
              WritePage(I,PageRefs^.Refs[PageLevel].Page,TP);
              ClearPage(I,RPage);
              IF I.In=0 THEN
                FreeFreeBlock(I.ID,RPage);
              ELSE
                FreeBlock(I.ID,PageSize,RPage);
              END;
              DEC(PageLevel);
              TP := QP;
            ELSE
              (* Has got a left sibling *)
              ReadPage(I,PageRefs^.Refs[PageLevel-1].Page,QP);
              IP := AddIPtr(IPtr(Ofs((TP.IItem))),ItemSize);
              MemMove(ADR(TP.IItem),ADR(IP^),ItemSize*TP.ICount+4);
              JP := AddIPtr(IPtr(Ofs((QP.IItem))),ItemSize*(PageRefs^.Refs[PageLevel-1].Rec-1));
              RPage :=  JP^.IP;
              ReadPage(I,RPage,RP);
              MemFastMove(ADR(JP^.DP),ADR(TP.IItem.DP),iwr^.KeySize+4);
              INC(TP.ICount);
              IF RP.ICount>iwr^.N22 THEN
                NP := AddIPtr(IPtr(Ofs((RP.IItem))),ItemSize*RP.ICount);
                TP.IItem.IP:= NP^.IP;
                DecAddr(NP,ItemSize);
                MemFastMove(ADR(NP^.DP),ADR(JP^.DP),iwr^.KeySize+4);
                DEC(RP.ICount);
                WritePage(I,RPage,RP);
                WritePage(I,PageRefs^.Refs[PageLevel].Page,TP);
                WritePage(I,PageRefs^.Refs[PageLevel-1].Page,QP);
                PageLevel := 0;
                EXIT;
              END;
              IP := AddIPtr(IPtr(Ofs((TP.IItem))),ItemSize*iwr^.N22);
              MemFastMove(ADR(TP.IItem.DP),ADR(IP^.DP),ItemSize*iwr^.N22);
              MemFastMove(ADR(RP.IItem),ADR(TP.IItem),ItemSize*iwr^.N22+4);
              TP.ICount := iwr^.N2;
              IP := JP;
              IncAddr(IP,ItemSize);
              MemFastMove(ADR(IP^),ADR(JP^),ItemSize*(QP.ICount-PageRefs^.Refs[PageLevel-1].Rec)+4);
              DEC(QP.ICount);
              WritePage(I,PageRefs^.Refs[PageLevel].Page,TP);
              ClearPage(I,RPage);
              IF I.In=0 THEN
                FreeFreeBlock(I.ID,RPage);
              ELSE
                FreeBlock(I.ID,PageSize,RPage);
              END;
              DEC(PageLevel);
              TP := QP;
            END;
          END;
          IF (TP.ICount=0) AND (iwr^.Depth>1) THEN
            DEC(iwr^.Depth);
            iwr^.TopPage := TP.IItem.IP;
          ELSE
            WritePage(I,PageRefs^.Refs[PageLevel].Page,TP);
          END;
          PageLevel :=0;
          EXIT;
        END;
        IF LastError(I)=OK THEN
          DEC(iwr^.RecordCnt);
        END;
      END;
      cUnLockIHandle(I,Implicit);
    END;
    UnLockFile(I.ID);
  ELSE
    SetErr(I,Locked);
  END;
END DeleteIndex;


PROCEDURE FindIndex(I: IHandle; Key: ARRAY OF BYTE;
                    VAR DataLoc: LONGCARD): BOOLEAN;
VAR
  res : BOOLEAN;
BEGIN
  ClearErr(I);
  IF NOT IsIndex(I) THEN
    CallErr(I,NotIndex,'FindIndex');
    RETURN FALSE;
  END;
  Release(I);
  IF cLockIHandle(I,Implicit) THEN
    IF FindIx(I,Key,Nil,Fnd) THEN
      DataLoc := I.ID^.Id[I.In].LastDataRef;
      res := TRUE;
    ELSE
      res := FALSE;
    END;
    I.ID^.Id[I.In].LastKeyOK := FALSE;
    cUnLockIHandle(I,Implicit);
    RETURN res;
  ELSE
    RETURN FALSE;
  END;
END FindIndex;


PROCEDURE SearchIndex(I: IHandle; Key: ARRAY OF BYTE;
                      VAR DataLoc: LONGCARD): BOOLEAN;
VAR
  res : BOOLEAN;
BEGIN
  ClearErr(I);
  IF NOT IsIndex(I) THEN
    CallErr(I,NotIndex,'SearchIndex');
    RETURN FALSE;
  END;
  Release(I);
  IF cLockIHandle(I,Implicit) THEN
    IF FindIx(I,Key,Nil,Src) THEN
      DataLoc := I.ID^.Id[I.In].LastDataRef;
      res := TRUE;
    ELSE
      res := FALSE;
    END;
    I.ID^.Id[I.In].LastKeyOK := FALSE;
    cUnLockIHandle(I,Implicit);
    RETURN res;
  ELSE
    RETURN FALSE;
  END;
END SearchIndex;


PROCEDURE Recover(iH: IHandle) : BOOLEAN;
BEGIN
  WITH iH.ID^ DO
    WITH Id[iH.In] DO
      IF (PageLevel=0) AND LastKeyOK THEN
        RETURN FindIx(iH,LastKey,LastKeyRef,Rec);
      ELSIF PageLevel#0 THEN
        SetLastKey(iH);
      END;
    END;
  END;
  RETURN TRUE;
END Recover;


PROCEDURE NextIndex(I: IHandle; VAR DataLoc: LONGCARD): BOOLEAN;
VAR
  res : BOOLEAN;
BEGIN
  ClearErr(I);
  IF NOT IsIndex(I) THEN
    CallErr(I,NotIndex,'NextIndex');
    RETURN FALSE;
  END;
  Release(I);
  IF cLockIHandle(I,Implicit) THEN
    WITH I.ID^.Id[I.In] DO
      IF Recover(I) THEN
        WalkIx(I,Forward);
      END;
      res := PageLevel#0;
      cUnLockIHandle(I,Implicit);
      IF res THEN
        DataLoc := LastDataRef;
      END;
      RETURN res;
    END;
  ELSE
    RETURN FALSE;
  END;
END NextIndex;


PROCEDURE PrevIndex(I: IHandle; VAR DataLoc: LONGCARD): BOOLEAN;
VAR
  res : BOOLEAN;
BEGIN
  ClearErr(I);
  IF NOT IsIndex(I) THEN
    CallErr(I,NotIndex,'PrevIndex');
    RETURN FALSE;
  END;
  Release(I);
  IF cLockIHandle(I,Implicit) THEN
    res := Recover(I);
    WITH I.ID^.Id[I.In] DO
      WalkIx(I,Backward);
      res := PageLevel#0;
      cUnLockIHandle(I,Implicit);
      IF res THEN
        DataLoc := LastDataRef;
      END;
      RETURN res;
    END;
  ELSE
    RETURN FALSE;
  END;
END PrevIndex;


PROCEDURE SetSyncMode(D: IHandle; On: BOOLEAN);
BEGIN
  ClearErr(D);
  IF NOT IsData(D) THEN
    CallErr(D,NotData,'SetSyncMode');
    RETURN;
  END;
  D.ID^.Id[D.In].Sync := On;
  Reset(D);
END SetSyncMode;


PROCEDURE LastError(H: IHandle): Errors;
BEGIN
  IF NOT IsFHandle(H.ID) THEN
    RETURN NotFHandle;
  ELSIF NOT IsIHandle(H) THEN
    RETURN NotIHandle;
  ELSE
    RETURN H.ID^.Id[H.In].LastErr;
  END;
END LastError;


PROCEDURE LastFError(F: FHandle): Errors;
VAR
  iH : IHandle;
BEGIN
  iH.ID := F;
  iH.In := 0;
  RETURN LastError(iH);
END LastFError;


PROCEDURE LastRef(I : IHandle) : LONGCARD;
BEGIN
  IF NOT IsIHandle(I) THEN
    CallErr(I,NotIHandle,'LastRef');
    RETURN Nil;
  END;
  RETURN I.ID^.Id[I.In].LastDataRef;
END LastRef;


PROCEDURE RecordCount(I: IHandle): LONGCARD;
BEGIN
  ClearErr(I);
  IF NOT IsIHandle(I) THEN
    CallErr(I,NotIHandle,'RecordCount');
    RETURN Nil;
  END;
  WITH I.ID^.Id[I.In] DO
    IF NOT I.ID^.Buffered AND (ihLock.ICnt=0) AND (ihLock.ECnt=0) THEN
      CallErr(I,NotLocked,'RecordCount');
      RETURN Nil;
    END;
    RETURN iwr^.RecordCnt;
  END;
END RecordCount;


(*# save *)
(*%T _fcall *) (*# call(near_call=>off) *) (*%E *)
(*# call(o_a_size=>on) *)
PROCEDURE Err(err: Errors; str: ARRAY OF CHAR);
VAR s : ARRAY[0..79] OF CHAR;
BEGIN
  Str.Concat(s,CHR(13)+CHR(10),str);
  Lib.FatalError(s);
END Err;
(*# restore *)


  MODULE NoPack;

  IMPORT MemFastMove;

  EXPORT QUALIFIED Packer, Unpacker, UnpackedSize, Packing, AdjustBlock;

  PROCEDURE Packer(n: CARDINAL; in: ADDRESS; out: ADDRESS): CARDINAL;
  BEGIN
    MemFastMove(in,out,n);
    RETURN n;
  END Packer;

  PROCEDURE Unpacker(n: CARDINAL; in: ADDRESS; out: ADDRESS);
  BEGIN
    MemFastMove(in,out,n);
  END Unpacker;

  PROCEDURE UnpackedSize(n: CARDINAL; in: ADDRESS): CARDINAL;
  BEGIN
    RETURN n;
  END UnpackedSize;

  PROCEDURE Packing(): BOOLEAN;
  BEGIN
    RETURN FALSE;
  END Packing;

  PROCEDURE AdjustBlock(rs: CARDINAL): CARDINAL;
  BEGIN
    RETURN rs;
  END AdjustBlock;

  END NoPack;


BEGIN
  ErrorHandler := Err;
  Packer := NoPack.Packer;
  Unpacker := NoPack.Unpacker;
  UnpackedSize := NoPack.UnpackedSize;
  Packing := NoPack.Packing;
  AdjustBlock := NoPack.AdjustBlock;
END Btree.