Topspeed_JPI/TS-V3/SRC/BTREE.LST

Listing:

    1  (*# call(o_a_size=>off) *)
    2  (*# call(o_a_copy=>off) *)
    3  (*# call(near_call=>on) *)
    4  IMPLEMENTATION MODULE Btree;
    5  (*
    6          Copyright (C) 1988..1991 Jensen & Partners International
    7  *)
    8  
    9  
   10  IMPORT CoreMem, FIOx, Lib, Str;
   11  FROM SYSTEM IMPORT Seg, Ofs, ADR;
   12  (*%T _mthread *)
   13  IMPORT Process;
   14  (*%E *)
   15  
   16  
   17  CONST
   18      (* ----------------------------------------------------------- *)
   19      (* For v3.0, the embedded version number has NOT been changed. *)
   20      (* See BTREE.DOC for details on compatability issues.          *)
   21      (* ----------------------------------------------------------- *)
   22    ThisVersion     = 200;  (* See Open() procedure for testing *)
   23    Nil             = MAX(LONGCARD);
*****                      ^ undeclared identifier
*****                          ^ undeclared identifier
   24    SectorSize      = 512;
   25    PageSize        = SectorSize*2;
*****                                 ^ not supported yet
   26    GuardV1         = 123456789;
   27    GuardV2         = 987654321;
   28    FileDataWrSize  = 32;
   29    IndexDataWrSize = 32;
   30  
   31  
   32  TYPE
   33    LockType        = (Implicit,Explicit,AllImplicit,AllLocks);
   34    LockRec         = RECORD
   35                        Position  : LONGCARD;
*****                                    ^ undeclared identifier
   36                        ICnt,ECnt : SHORTCARD;
   37                        In        : IHandle;
*****                                    ^ undeclared identifier
   38                      END;
*****                      ^ not supported yet
   39    LocksArray      = ARRAY [0..LockQSize-1] OF LockRec;
*****                                ^ undeclared identifier
*****                                          ^ not supported yet
*****                                                ^ not supported yet
   40    FileType        = (IndexSlot,DataSlot,FreeSlot);
   41    KeyType         = ARRAY [1..MaxKeySize] OF BYTE;
*****                                ^ undeclared identifier
*****                                               ^ undeclared identifier
   42    PageRefRec      = RECORD
   43                        Page : LONGCARD;
*****                               ^ undeclared identifier
   44                        Rec  : CARDINAL;
   45                        Cnt  : CARDINAL;
   46                      END;
*****                      ^ not supported yet
   47    PageRef         = RECORD
   48                        Height : CARDINAL;
   49                        Refs   : ARRAY [1..8191] OF PageRefRec;  (* last *)
*****                                           ^ not supported yet
*****                                                    ^ not supported yet
   50                      END;
*****                      ^ not supported yet
   51    PageRefPtr      = POINTER TO PageRef;
*****                                 ^ not supported yet
   52  (* *************************************************************************
   53     In the following two records (IndexData and IndexFile), special
   54     considerations are required for some of the fields...
   55       (*I*)   Denotes fields which must be checked against the contents of
   56               the file when the file is opened.
   57       (*V*)   Denotes fields that reflect the current status of the file,
   58               and thus must be read after the file is locked and written
   59               before the file is unlocked.
   60       (*F*)   Denotes fields which, if changed by a process other than the
   61               current one, require that the current process flush its
   62               buffers.
   63    ************************************************************************* *)
   64    IndexDataWr     = RECORD
   65                        CASE : BOOLEAN OF
*****                        ^ not supported yet
*****                                       ^ 'POINTER' expected
   66                            FALSE : RecordCnt : LONGCARD;                  (*V*)
   67                                    CASE Ft : FileType OF                  (*I*)
   68                                        DataSlot  : RecordSize : CARDINAL; (*I*)
   69                                      | IndexSlot : WriteCnt,              (*F*)
   70                                                    TopPage    : LONGCARD; (*V*)
   71                                                    Depth,                 (*V*)
   72                                                    KeySize,               (*I*)
   73                                                    N2,                    (*I*)
   74                                                    N22        : CARDINAL; (*I*)
   75                                                    DupKey     : BOOLEAN;  (*I*)
   76                                    END;
   77                          | TRUE  : FILL : ARRAY[1..IndexDataWrSize] OF BYTE;
   78                        END;
   79                      END;
   80    IndexFileWr     = RECORD
   81                        CASE : BOOLEAN OF
   82                            FALSE : HeaderSize : CARDINAL;            (*1*)(*I*)
   83                                    FileSize   : LONGCARD;            (*2*)(*V*)
   84                                    Version    : CARDINAL;                 (*I*)
   85                                    FreeList   : LONGCARD;                 (*V*)
   86                                    IndexCount : CARDINAL;                 (*I*)
   87                                    Mode       : AccessMode;               (*I*)
   88                                    PageSz,                                (*I*)
   89                                    MaxKeySz   : CARDINAL;                 (*I*)
   90                          | TRUE  : FILL : ARRAY[1..FileDataWrSize] OF BYTE;
   91                        END;
   92                      END;
   93    IndexData       = RECORD
   94                        LastDataRef: LONGCARD;
   95                        NextIndx   : IHandle;
   96                        LastErr    : Errors;
   97                        ErrorNest  : CARDINAL;
   98                        ihLock     : LockRec;
   99                        CASE Ft : FileType OF
  100                          | DataSlot  : Sync        : BOOLEAN;
  101                                        bufSize     : CARDINAL;
  102                                        bufPtr      : ADDRESS;
  103                          | IndexSlot : OldWriteCnt : LONGCARD;
  104                                        DataPtr     : IHandle;
  105                                        PageRefs    : PageRefPtr;
  106                                        PageLevel   : CARDINAL;
  107                                        CompFct     : CompareFunction;
  108                                        KeyFct      : KeyFunction;
  109                                        LastKeyOK   : BOOLEAN;
  110                                        LastKey     : KeyType;
  111                                        LastKeyRef  : LONGCARD;
  112                        END;
  113                        iwr        : POINTER TO IndexDataWr;
  114                      END;
  115    IndexFile       = RECORD
  116                        G1         : LONGCARD;
  117                        ReadOnly,
  118                        Buffered,
  119                        WriteThru  : BOOLEAN;  (* not fully implemented *)
  120                        Locks      : LocksArray;
  121                        fhLock     : LockRec;
  122                        FHandle    : CARDINAL;
  123                        fwr        : POINTER TO IndexFileWr;
  124                        G2         : LONGCARD;              (* 2nd to last *)
  125                        Id         : ARRAY[0..346] OF IndexData;   (* last *)
  126                      END;
  127    IndexItem       = RECORD
  128                        IP  : LONGCARD;
  129                        DP  : LONGCARD;
  130                        Key : KeyType;
  131                      END;
  132    TPage           = RECORD
  133                        CASE : BOOLEAN OF
  134                            FALSE : ICount : CARDINAL;
  135                                    IItem  : IndexItem;
  136                          | TRUE  : FILL   : ARRAY [1..PageSize] OF BYTE;
  137                        END;
  138                      END;
  139  (*# save *)
  140  (*# data(near_ptr=>off) *)
  141    TPagePointer    = POINTER TO TPage;
  142  (*# restore *)
  143    xTPage          = RECORD
  144                        CASE : BOOLEAN OF
  145                            FALSE : ICount : CARDINAL;
  146                                    IItem  : IndexItem;
  147                          | TRUE  : FILL   : ARRAY [1..PageSize] OF BYTE;
  148                        END;
  149                        extra  : IndexItem;
  150                      END;
  151    BufferPages     = RECORD
  152                        iH     : IHandle;
  153                        Wr     : BOOLEAN;
  154                        Page   : LONGCARD;
  155                        Buf    : TPagePointer;
  156                      END;
  157    FindMode        = (Fnd,Ins,Src,Idx,Rec);
  158                        (* Fnd = first exact key match
  159                           Ins = place to insert into
  160                           Src = first exact key match or greater
  161                           Idx = exact entry (i.e. DataPos also)
  162                           Rec = exact entry (i.e. DataPos also) or greater *)
  163    WalkMode        = (Forward,Backward);
  164    ErrorStrs       = ARRAY Errors,[0..31] OF CHAR;
  165  
  166  
  167  CONST
  168    IndexDataSize = SIZE(IndexData);
  169    IndexFileSize = VSIZE(IndexFile.G2)+IndexDataSize;
  170    ErrorStr  = ErrorStrs('No Error',
  171                          '#: Bad Open',
  172                          'Bad # Slot',
  173                          'Not a FHandle',
  174                          'Not an IHandle',
  175                          'Not a Data File',
  176                          'Not an Index File',
  177                          '#: Bad Index',
  178                          '#: Wrong Record Size',
  179                          'Key Too Large',
  180                          'Duplicated Key',
  181                          '#: Access Mode Not Supported',
  182                          'Error During Read',
  183                          'Error During Write',
  184                          "Couldn't Acquire Lock",
  185                          'Item Must Already Be Locked',
  186                          'File I/O Error',
  187                          'Lock Table Overflow',
  188                          'Unknown Error');
  189    FileDataCheck  = FileDataWrSize=SIZE(IndexFileWr);
  190    IndexDataCheck = IndexDataWrSize=SIZE(IndexDataWr);
  191  (*%F FileDataCheck *)
  192  WARNING - FileDataWrSize must be equal to SIZE(FileDataWr);
  193  (*%E *)
  194  (*%F IndexDataCheck *)
  195  WARNING - IndexDataWrSize must be equal to SIZE(IndexDataWr);
  196  (*%E *)
  197  
  198  
  199    MODULE inline;
  200  
  201    EXPORT MemMove, MemFastMove, AddAddr, IncAddr, DecAddr;
  202  
  203    TYPE
  204      A2 = ARRAY[0..1] OF SHORTCARD;
  205      A3 = ARRAY[0..2] OF SHORTCARD;
  206      A6 = ARRAY[0..5] OF SHORTCARD;
  207      A8 = ARRAY[0..7] OF SHORTCARD;
  208      A19 = ARRAY[0..18] OF SHORTCARD;
  209      A21 = ARRAY[0..20] OF SHORTCARD;
  210  
  211  (*%T _fptr *)
  212  
  213  (*# save *)
  214  (*# call(inline=>on) *)
  215  (*# call(reg_param=>(si,ax,di,es,cx),reg_saved=>(ax,bx,dx,ds,es,st1,st2,st3,st4,st5,st6)) *)
  216    PROCEDURE MemMove(s,r: ADDRESS; c: CARDINAL)=A21(0E3H,013H,(*   jcxz  $1     *)
  217                                                     09CH,     (*   pushf        *)
  218                                                     01EH,     (*   push  ds     *)
  219                                                     08EH,0D8H,(*   mov   ds,ax  *)
  220                                                     03BH,0FEH,(*   cmp   di,si  *)
  221                                                     072H,007H,(*   jb    $0     *)
  222                                                     003H,0F1H,(*   add   si,cx  *)
  223                                                     003H,0F9H,(*   add   di,cx  *)
  224                                                     04EH,     (*   dec   si     *)
  225                                                     04FH,     (*   dec   di     *)
  226                                                     0FDH,     (*   std          *)
  227                                                               (* $0:            *)
  228                                                     0F3H,0A4H,(*   rep   ;movsb *)
  229                                                     01FH,     (*   pop   ds     *)
  230                                                     09DH);    (*   popf         *)
  231                                                               (* $1:            *)
  232  (*# restore *)
  233  
  234  (*# save *)
  235  (*# call(inline=>on) *)
  236  (*# call(reg_param=>(si,ax,di,es,cx),reg_saved=>(ax,bx,dx,ds,es,st1,st2,st3,st4,st5,st6)) *)
  237    PROCEDURE MemFastMove(s,r: ADDRESS; c: CARDINAL)=A8(0E3H,006H,(*   jcxz  $0     *)
  238                                                        01EH,     (*   push  ds     *)
  239                                                        08EH,0D8H,(*   mov   ds,ax  *)
  240                                                        0F3H,0A4H,(*   rep   ;movsb *)
  241                                                        01FH);    (*   pop   ds     *)
  242                                                                  (* $0:            *)
  243  (*# restore *)
  244  
  245  (*# save *)
  246  (*# call(inline=>on) *)
  247  (*# call(reg_param=>(ax,dx,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  248    PROCEDURE AddAddr(A: ADDRESS; I: CARDINAL): ADDRESS=A2(003H,0C1H);(*add ax,cx*)
  249  (*# restore *)
  250  
  251  (*# save *)
  252  (*# call(inline=>on) *)
  253  (*# call(reg_param=>(bx,es,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  254    PROCEDURE IncAddr(VAR a: ADDRESS; i: CARDINAL)=A3(026H,001H,007H); (* add es:[bx],cx *)
  255  (*# restore *)
  256  
  257  (*# save *)
  258  (*# call(inline=>on) *)
  259  (*# call(reg_param=>(bx,es,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  260    PROCEDURE DecAddr(VAR a: ADDRESS; i: CARDINAL)=A3(026H,029H,007H); (* sub es:[bx],cx *)
  261  (*# restore *)
  262  
  263  (*%E *)
  264  
  265  (*%F _fptr *)
  266  
  267  (*# save *)
  268  (*# call(inline=>on) *)
  269  (*# call(reg_param=>(si,di,cx),reg_saved=>(ax,bx,dx,ds,st1,st2,st3,st4,st5,st6)) *)
  270    PROCEDURE MemMove(s,r: ADDRESS; c: CARDINAL)=A19(0E3H,011H,(*  jcxz $1   *)
  271                                                     09CH,     (*  pushf     *)
  272                                                     01EH,     (*  push ds   *)
  273                                                     007H,     (*  pop es    *)
  274                                                     03BH,0FEH,(*  cmp di,si *)
  275                                                     072H,007H,(*  jb $0     *)
  276                                                     003H,0F1H,(*  add si,cx *)
  277                                                     003H,0F9H,(*  add di,cx *)
  278                                                     04EH,     (*  dec si    *)
  279                                                     04FH,     (*  dec di    *)
  280                                                     0FDH,     (*  std       *)
  281                                                               (* $0:        *)
  282                                                     0F3H,0A4H,(*  rep; movsb*)
  283                                                     09DH);    (*  popf      *)
  284                                                               (* $1:        *)
  285  (*# restore *)
  286  
  287  (*# save *)
  288  (*# call(inline=>on) *)
  289  (*# call(reg_param=>(si,di,cx),reg_saved=>(ax,bx,dx,ds,st1,st2,st3,st4,st5,st6)) *)
  290    PROCEDURE MemFastMove(s,r: ADDRESS; c: CARDINAL)=A6(0E3H,004H,  (*  jcxz $0   *)
  291                                                        01EH,       (*  push ds   *)
  292                                                        007H,       (*  pop es    *)
  293                                                        0F3H,0A4H); (*  rep; movsb*)
  294                                                                    (* $0:        *)
  295  (*# restore *)
  296  
  297  (*# save *)
  298  (*# call(inline=>on) *)
  299  (*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  300    PROCEDURE AddAddr(A: ADDRESS; I: CARDINAL): ADDRESS=A2(003H,0C1H);(*add ax,cx*)
  301  (*# restore *)
  302  
  303  (*# save *)
  304  (*# call(inline=>on) *)
  305  (*# call(reg_param=>(bx,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  306    PROCEDURE IncAddr(VAR a: ADDRESS; i: CARDINAL)=A2(001H,007H); (* add [bx],cx *)
  307  (*# restore *)
  308  
  309  (*# save *)
  310  (*# call(inline=>on) *)
  311  (*# call(reg_param=>(bx,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  312    PROCEDURE DecAddr(VAR a: ADDRESS; i: CARDINAL)=A2(029H,007H); (* sub [bx],cx *)
  313  (*# restore *)
  314  
  315  (*%E *)
  316  
  317    END inline;
  318  
  319  
  320  CONST
  321    OutOfMemory = 80;
  322    ioError  = 81;
  323    DiskFull = 82;
  324  
  325  
  326  (*# save *)
  327  (*# call(reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  328  PROCEDURE Die(error: BOOLEAN; code: CARDINAL);
  329  VAR s : ARRAY [0..79] OF CHAR;
  330      b : BOOLEAN;
  331  BEGIN
  332    IF error THEN
  333      Str.CardToStr(LONGCARD(code),s,10,b);
  334      Str.Prepend(s,CHR(13)+CHR(10)+'BTREE: Fatal error, code = ');
  335      Lib.FatalError(s);
  336    END;
  337  END Die;
  338  (*# restore *)
  339  
  340  
  341  PROCEDURE AllocMem(VAR a: ADDRESS; s: CARDINAL);
  342  BEGIN
  343    a := CoreMem.calloc(1,s);
  344  END AllocMem;
  345  
  346  
  347  PROCEDURE FreeMem(VAR a: ADDRESS);
  348  BEGIN
  349    IF a#NIL THEN
  350      CoreMem.free(a);
  351      a := NIL;
  352    END;
  353  END FreeMem;
  354  
  355  
  356  PROCEDURE AdjustBuffer(D: IHandle; rs: CARDINAL);
  357  VAR
  358    sz : CARDINAL;
  359  BEGIN
  360    WITH D.ID^ DO
  361      WITH Id[D.In] DO
  362        IF iwr^.RecordSize=0 THEN
  363          sz := AdjustBlock(rs);
  364          IF bufSize<sz THEN
  365            FreeMem(bufPtr);
  366            AllocMem(bufPtr,sz);
  367            Die(bufPtr=NIL,OutOfMemory);
  368            bufSize := sz;
  369          END;
  370        END;
  371      END;
  372    END;
  373  END AdjustBuffer;
  374  
  375  
  376  PROCEDURE IsFHandle(fH: FHandle): BOOLEAN;
  377  BEGIN
  378    RETURN (fH#NIL) AND
  379           (fH^.G1=GuardV1) AND
  380           (fH^.G2=GuardV2);
  381  END IsFHandle;
  382  
  383  
  384  PROCEDURE IsIHandle(iH: IHandle): BOOLEAN;
  385  BEGIN
  386    RETURN IsFHandle(iH.ID) AND (iH.In<=iH.ID^.fwr^.IndexCount) AND
  387           (iH.ID^.Id[iH.In].Ft#FreeSlot) AND
  388           (iH.ID^.Id[iH.In].iwr^.Ft#FreeSlot);
  389  END IsIHandle;
  390  
  391  
  392  PROCEDURE IsData(iH: IHandle): BOOLEAN;
  393  BEGIN
  394    RETURN IsIHandle(iH) AND
  395           (iH.ID^.Id[iH.In].Ft=DataSlot) AND
  396           (iH.ID^.Id[iH.In].iwr^.Ft=DataSlot);
  397  END IsData;
  398  
  399  
  400  PROCEDURE IsIndex(iH: IHandle): BOOLEAN;
  401  BEGIN
  402    RETURN IsIHandle(iH) AND
  403           (iH.ID^.Id[iH.In].Ft=IndexSlot) AND
  404           (iH.ID^.Id[iH.In].iwr^.Ft=IndexSlot);
  405  END IsIndex;
  406  
  407  
  408  (*# save *)
  409  (*# call(o_a_size=>on) *)
  410  PROCEDURE Error(err: Errors; str: ARRAY OF CHAR);
  411  VAR
  412    st : ARRAY [0..100] OF CHAR;
  413    i  : CARDINAL;
  414  BEGIN
  415    IF err#OK THEN
  416      st := CHR(13)+CHR(10);
  417      Str.Append(st,ErrorStr[err]);
  418      i := Str.Pos(st,'#');
  419      IF i#MAX(CARDINAL) THEN
  420        Str.Delete(st,i,1);
  421        Str.Insert(st,str,i);
  422      ELSIF Str.Length(str)#0 THEN
  423        Str.Append(st,' (');
  424        Str.Append(st,str);
  425        Str.Append(st,')');
  426      END;
  427      ErrorHandler(err,st);
  428    END;
  429  END Error;
  430  (*# restore *)
  431  
  432  
  433  PROCEDURE ClearErr(iH: IHandle);
  434  BEGIN
  435    IF IsIHandle(iH) THEN
  436      iH.ID^.Id[iH.In].LastErr := OK;
  437    END;
  438  END ClearErr;
  439  
  440  
  441  PROCEDURE ClearFErr(fH: FHandle);
  442  VAR
  443    iH : IHandle;
  444  BEGIN
  445    iH.ID := fH;
  446    iH.In := 0;
  447    ClearErr(iH);
  448  END ClearFErr;
  449  
  450  
  451  PROCEDURE SetErr(iH: IHandle; err: Errors);
  452  BEGIN
  453    IF IsIHandle(iH) AND (iH.ID^.Id[iH.In].LastErr=OK) THEN
  454      iH.ID^.Id[iH.In].LastErr := err;
  455    END;
  456  END SetErr;
  457  
  458  
  459  (*# save *)
  460  (*# call(o_a_size=>on) *)
  461  PROCEDURE CallErr(iH: IHandle; err: Errors; str: ARRAY OF CHAR);
  462  BEGIN
  463    SetErr(iH,err);
  464    Error(err,str);
  465  END CallErr;
  466  (*# restore *)
  467  
  468  
  469  PROCEDURE SetFErr(fH: FHandle; err: Errors);
  470  VAR
  471    iH : IHandle;
  472  BEGIN
  473    iH.ID := fH;
  474    iH.In := 0;
  475    SetErr(iH,err);
  476  END SetFErr;
  477  
  478  
  479  (*# save *)
  480  (*# call(o_a_size=>on) *)
  481  PROCEDURE CallFErr(fH: FHandle; err: Errors; str: ARRAY OF CHAR);
  482  VAR
  483    iH : IHandle;
  484  BEGIN
  485    iH.ID := fH;
  486    iH.In := 0;
  487    CallErr(iH,err,str);
  488  END CallFErr;
  489  (*# restore *)
  490  
  491  
  492  (*# save *)
  493  (*# call(o_a_size=>on) *)
  494  PROCEDURE IOerr(iH: IHandle; str: ARRAY OF CHAR): BOOLEAN;
  495  VAR
  496    i : CARDINAL;
  497    tmp : ARRAY[0..80] OF CHAR;
  498    ok : BOOLEAN;
  499  BEGIN
  500    i := FIOx.Error();
  501    IF i#0 THEN
  502      Str.CardToStr(VAL(LONGCARD,i),tmp,10,ok);
  503      Str.Insert(tmp,'#',0);
  504      IF Str.Length(str) # 0 THEN
  505        Str.Append(tmp,' ');
  506        Str.Append(tmp,str);
  507      END;
  508      CallErr(IHandle(iH),FileError,tmp);
  509      RETURN TRUE;
  510    ELSE
  511      RETURN FALSE;
  512    END;
  513  END IOerr;
  514  (*# restore *)
  515  
  516  
  517  (*# save *)
  518  (*# call(o_a_size=>on) *)
  519  PROCEDURE IOFerr(fH: FHandle; str: ARRAY OF CHAR): BOOLEAN;
  520  VAR
  521    iH: IHandle;
  522  BEGIN
  523    iH.ID := fH;
  524    iH.In := 0;
  525    RETURN IOerr(iH,str);
  526  END IOFerr;
  527  (*# restore *)
  528  
  529  
  530  (*# save *)
  531  (*# call(o_a_size=>on) *)
  532  PROCEDURE IOabort(str: ARRAY OF CHAR);
  533  BEGIN
  534    Die(IOerr(Null,str),ioError);
  535  END IOabort;
  536  (*# restore *)
  537  
  538  
  539  PROCEDURE ReadRec(D: IHandle; p: LONGCARD; VAR d: ARRAY OF BYTE);
  540  VAR
  541    l : CARDINAL;
  542  BEGIN
  543    WITH D.ID^ DO
  544      WITH Id[D.In] DO
  545        IF iwr^.RecordSize=0 THEN
  546          FIOx.Seek(FHandle,p-2);
  547          IOabort('ReadRec');
  548          FIOx.Read(FHandle,l,SIZE(l));
  549          IOabort('ReadRec');
  550          IF fwr^.Mode=Compress THEN
  551            AdjustBuffer(D,l);
  552            FIOx.Read(FHandle,bufPtr^,l);
  553            IOabort('ReadRec');
  554            Unpacker(l,bufPtr,ADR(d));
  555          ELSE
  556            FIOx.Read(FHandle,d,l);
  557            IOabort('ReadRec');
  558          END;
  559        ELSE
  560          FIOx.Seek(FHandle,p);
  561          IOabort('ReadRec');
  562          FIOx.Read(FHandle,d,iwr^.RecordSize);
  563        END;
  564      END;
  565    END;
  566  END ReadRec;
  567  
  568  
  569  PROCEDURE LoadRec(D: IHandle; p: LONGCARD; VAR bp: LONGCARD; VAR bs: CARDINAL);
  570  VAR
  571    a : ADDRESS;
  572  BEGIN
  573    WITH D.ID^ DO
  574      WITH Id[D.In] DO
  575        IF iwr^.RecordSize=0 THEN
  576          bp := p-SIZE(CARDINAL);
  577          FIOx.Seek(FHandle,bp);
  578          IOabort('LoadRec');
  579          FIOx.Read(FHandle,bs,SIZE(bs));
  580          IOabort('LoadRec');
  581          IF fwr^.Mode=Compress THEN
  582            AllocMem(a,bs);
  583            Die(a=NIL,OutOfMemory);
  584            FIOx.Read(FHandle,a^,bs);
  585            IOabort('LoadRec');
  586            AdjustBuffer(D,UnpackedSize(bs,a));
  587            Unpacker(bs,a,bufPtr);
  588            FreeMem(a);
  589          ELSE
  590            AdjustBuffer(D,bs);
  591            FIOx.Read(FHandle,bufPtr^,bs);
  592            IOabort('LoadRec');
  593          END;
  594        ELSE
  595          bp := p;
  596          bs := iwr^.RecordSize;
  597          FIOx.Seek(FHandle,p);
  598          IOabort('LoadRec');
  599          FIOx.Read(FHandle,bufPtr^,bs);
  600        END;
  601      END;
  602    END;
  603  END LoadRec;
  604  
  605  
  606    MODULE LRU;
  607      (* This local module encapsulates the LRU buffer. *)
  608  
  609    IMPORT Nil, IHandle, BufferPages, TPage, CallErr, Null, UnknownError,
  610           AllocMem, MemMove, IOabort, Die, OutOfMemory, DiskFull, FIOx, CoreMem;
  611  (*%T _mthread *)
  612    IMPORT Process;
  613  (*%E *)
  614    EXPORT ReadPage, WritePage, ClearPage, ClearBuffers, SaveBuffers;
  615  
  616    CONST
  617      LRUCount = 32;
  618  
  619    VAR
  620      LruPages : ARRAY [1..LRUCount] OF BufferPages;
  621  (*%F _fptr *)
  622      _Buf : TPage;
  623  (*%E *)
  624  
  625    PROCEDURE MovePage(i: CARDINAL; discard: BOOLEAN);
  626    VAR
  627      j    : CARDINAL;
  628      t    : BufferPages;
  629      src,
  630      dest : ADDRESS;
  631      len  : CARDINAL;
  632    BEGIN
  633      IF discard THEN
  634        src := ADR(LruPages[1]);
  635        dest := ADR(LruPages[2]);
  636        len := i-1;
  637        j := 1;
  638      ELSIF i=LRUCount THEN
  639        len := 0;
  640      ELSE
  641        src := ADR(LruPages[i+1]);
  642        dest := ADR(LruPages[i]);
  643        len := LRUCount-i;
  644        j := LRUCount;
  645      END;
  646      IF len # 0 THEN
  647        t := LruPages[i];
  648        MemMove(src,dest,len*SIZE(BufferPages));
  649        LruPages[j] := t;
  650      END;
  651    END MovePage;
  652  
  653  (*# save *)
  654  (*# check(overflow=>off) *)
  655    PROCEDURE FlushPage(i: CARDINAL);
  656    BEGIN
  657      WITH LruPages[i] DO
  658        IF Wr THEN
  659          FIOx.Seek(iH.ID^.FHandle,Page);
  660          IOabort('FlushPage');
  661  (*%F _fptr *)
  662          _Buf := Buf^;
  663          FIOx.Write(iH.ID^.FHandle,_Buf,SIZE(TPage));
  664  (*%E *)
  665  (*%T _fptr *)
  666          FIOx.Write(iH.ID^.FHandle,Buf^,SIZE(TPage));
  667  (*%E *)
  668          IOabort('FlushPage');
  669          IF iH.ID^.Id[iH.In].OldWriteCnt=iH.ID^.Id[iH.In].iwr^.WriteCnt THEN
  670            INC(iH.ID^.Id[iH.In].iwr^.WriteCnt);
  671          END;
  672          Wr := FALSE;
  673          IF iH.ID^.WriteThru THEN
  674            FIOx.Flush(iH.ID^.FHandle);
  675          END;
  676        END;
  677      END;
  678    END FlushPage;
  679  (*# restore *)
  680  
  681    PROCEDURE FindPage(ih: IHandle; page: LONGCARD): BOOLEAN;
  682    VAR
  683      i : CARDINAL;
  684      f : BOOLEAN;
  685    BEGIN
  686      i := LRUCount;
  687      LOOP
  688        WITH LruPages[i] DO
  689          f := (ih=iH) AND (Page=page);
  690        END;
  691        IF f OR (i=1) THEN
  692          EXIT;
  693        END;
  694        DEC(i);
  695      END;
  696      MovePage(i,FALSE);
  697      IF NOT f THEN
  698        FlushPage(LRUCount);
  699        WITH LruPages[LRUCount] DO
  700          iH := ih;
  701          Page := page;
  702        END;
  703      END;
  704      RETURN f;
  705    END FindPage;
  706  
  707    PROCEDURE ReadPage(ih: IHandle; page: LONGCARD; VAR TP: TPage);
  708    BEGIN
  709      (*%T _mthread *) Process.Lock(); (*%E *)
  710      WITH LruPages[LRUCount] DO
  711        IF NOT FindPage(ih,page) THEN
  712          FIOx.Seek(ih.ID^.FHandle,page);
  713          IOabort('ReadPage');
  714  (*%F _fptr *)
  715          FIOx.Read(ih.ID^.FHandle,_Buf,SIZE(TPage));
  716          Buf^ := _Buf;
  717  (*%E *)
  718  (*%T _fptr *)
  719          FIOx.Read(ih.ID^.FHandle,Buf^,SIZE(TPage));
  720  (*%E *)
  721          IOabort('ReadPage');
  722        END;
  723        TP := Buf^;
  724      END;
  725      (*%T _mthread *) Process.Unlock(); (*%E *)
  726    END ReadPage;
  727  
  728    PROCEDURE WritePage(ih: IHandle; page: LONGCARD; VAR TP: TPage);
  729    VAR
  730      r : CARDINAL;
  731    BEGIN
  732      IF page=Nil THEN
  733        CallErr(Null,UnknownError,'WritePage');
  734        Die(TRUE,DiskFull);
  735      END;
  736      (*%T _mthread *) Process.Lock(); (*%E *)
  737      IF NOT FindPage(ih,page) THEN
  738        (* nothing *)
  739      END;
  740      WITH LruPages[LRUCount] DO
  741        Buf^ := TP;
  742        Wr  := TRUE;
  743        IF iH.ID^.WriteThru THEN
  744          FlushPage(LRUCount);
  745        END;
  746      END;
  747      (*%T _mthread *) Process.Unlock(); (*%E *)
  748    END WritePage;
  749  
  750    PROCEDURE UnUse(ih: IHandle; page: LONGCARD; wr: BOOLEAN);
  751    VAR
  752      i : CARDINAL;
  753    BEGIN
  754      (*%T _mthread *) Process.Lock(); (*%E *)
  755      i := 1;
  756      WHILE i<=LRUCount DO
  757        WITH LruPages[i] DO
  758          IF (((ih.In=MAX(CARDINAL)) AND (ih.ID=iH.ID)) OR (ih=iH)) AND
  759             ((page=Page) OR (page=Nil)) THEN
  760            IF wr THEN
  761              FlushPage(i);
  762            ELSE
  763              MovePage(i,TRUE);
  764              LruPages[1].Wr := FALSE;
  765              LruPages[1].iH := Null;
  766              LruPages[1].Page := 0;
  767            END;
  768          END;
  769        END;
  770        INC(i);
  771      END;
  772      (*%T _mthread *) Process.Unlock(); (*%E *)
  773    END UnUse;
  774  
  775    PROCEDURE ClearPage(ih: IHandle; page: LONGCARD);
  776    BEGIN
  777      UnUse(ih,page,FALSE);
  778    END ClearPage;
  779  
  780    PROCEDURE ClearBuffers(ih: IHandle);
  781    BEGIN
  782      UnUse(ih,Nil,FALSE);
  783    END ClearBuffers;
  784  
  785    PROCEDURE SaveBuffers(ih: IHandle);
  786    BEGIN
  787      UnUse(ih,Nil,TRUE);
  788    END SaveBuffers;
  789  
  790    PROCEDURE Init;
  791    VAR
  792      i : CARDINAL;
  793    BEGIN
  794      FOR i := 1 TO LRUCount DO
  795        LruPages[i] := BufferPages(Null,FALSE,0,FarNIL);
  796        LruPages[i].Buf := CoreMem._fcalloc(1,SIZE(TPage));
  797        Die(LruPages[i].Buf=FarNIL,OutOfMemory);
  798      END;
  799    END Init;
  800  
  801    BEGIN
  802      Init;
  803    END LRU;
  804  
  805  
  806  PROCEDURE ccOneLock(lock: LockRec; type: LockType): BOOLEAN;
  807  BEGIN
  808    WITH lock DO
  809      RETURN ((type=Implicit) AND (ICnt=1) AND (ECnt=0)) OR
  810             ((type=Explicit) AND (ECnt=1) AND (ICnt=0));
  811    END;
  812  END ccOneLock;
  813  
  814  
  815  PROCEDURE ccLock(dH: IHandle; VAR lock: LockRec; type: LockType): BOOLEAN;
  816  VAR
  817    lck : FIOx.LockRec;
  818  BEGIN
  819    IF dH.ID^.Buffered THEN
  820      RETURN TRUE;
  821    END;
  822    WITH lock DO
  823      IF (type=Implicit) AND (ICnt#MAX(SHORTCARD)) THEN
  824        INC(ICnt);
  825      ELSIF (type=Explicit) AND (ECnt#MAX(SHORTCARD)) THEN
  826        INC(ECnt);
  827      ELSE
  828        CallErr(dH,LockOverflow,'ccLock');
  829        RETURN FALSE;
  830      END;
  831      IF (type=Implicit) AND (In=Null) THEN
  832        In := dH;
  833      END;
  834      lck.pos := lock.Position;
  835      lck.len := 1;
  836      IF ccOneLock(lock,type) AND NOT FIOx.Lock(dH.ID^.FHandle,lck) THEN
  837        IF type=Implicit THEN
  838          DEC(ICnt);
  839        ELSE
  840          DEC(ECnt);
  841        END;
  842        SetErr(dH,Locked);
  843        RETURN FALSE;
  844      ELSE
  845        RETURN TRUE;
  846      END;
  847    END;
  848  END ccLock;
  849  
  850  
  851  PROCEDURE cLock(dH: IHandle; dLoc: LONGCARD; type: LockType): BOOLEAN;
  852  VAR
  853    idx,
  854    tmp : CARDINAL;
  855  BEGIN
  856    IF dH.ID^.Buffered THEN
  857      RETURN TRUE;
  858    END;
  859    idx := MAX(CARDINAL);
  860    LOOP
  861      FOR tmp := 0 TO LockQSize-1 DO
  862        WITH dH.ID^.Locks[tmp] DO
  863          IF Position=dLoc THEN
  864            idx := tmp;
  865            EXIT;
  866          ELSIF (idx=MAX(CARDINAL)) AND (Position=Nil) THEN
  867            idx := tmp;
  868          END;
  869        END;
  870      END;
  871      IF idx#MAX(CARDINAL) THEN
  872        WITH dH.ID^.Locks[idx] DO
  873          Position := dLoc;
  874          ICnt := 0;
  875          ECnt := 0;
  876          IF type=Implicit THEN
  877            In := dH;
  878          ELSE
  879            In := Null;
  880          END;
  881        END;
  882      END;
  883      EXIT;
  884    END;
  885    IF idx#MAX(CARDINAL) THEN
  886      IF NOT ccLock(dH,dH.ID^.Locks[idx],type) THEN
  887        dH.ID^.Locks[idx].Position := Nil;
  888        RETURN FALSE;
  889      ELSE
  890        RETURN TRUE;
  891      END;
  892    ELSE
  893      CallErr(dH,LockOverflow,'cLock');
  894      RETURN FALSE;
  895    END;
  896  END cLock;
  897  
  898  
  899  PROCEDURE Lock(F: FHandle; DataLoc: LONGCARD): BOOLEAN;
  900  VAR
  901    dH : IHandle;
  902  BEGIN
  903    dH.ID := F;
  904    dH.In := 0;
  905    ClearErr(dH);
  906    IF NOT IsIHandle(dH) THEN
  907      CallFErr(dH.ID,NotIHandle,'Lock');
  908      RETURN FALSE;
  909    END;
  910    RETURN cLock(dH,DataLoc,Explicit);
  911  END Lock;
  912  
  913  
  914  PROCEDURE LockDat(iH: IHandle; dLoc: LONGCARD): BOOLEAN;
  915  VAR
  916    idx,
  917    tmp : CARDINAL;
  918  BEGIN
  919    IF iH.ID^.Buffered THEN
  920      RETURN TRUE;
  921    END;
  922    idx := MAX(CARDINAL);
  923    LOOP
  924      FOR tmp := 0 TO LockQSize-1 DO
  925        WITH iH.ID^.Id[iH.In].DataPtr.ID^.Locks[tmp] DO
  926          IF Position=dLoc THEN
  927            idx := tmp;
  928            EXIT;
  929          ELSIF (idx=MAX(CARDINAL)) AND (Position=Nil) THEN
  930            idx := tmp;
  931          END;
  932        END;
  933      END;
  934      IF idx#MAX(CARDINAL) THEN
  935        WITH iH.ID^.Id[iH.In].DataPtr.ID^.Locks[idx] DO
  936          Position := dLoc;
  937          ICnt := 0;
  938          ECnt := 0;
  939          In := iH;
  940        END;
  941      END;
  942      EXIT;
  943    END;
  944    IF idx#MAX(CARDINAL) THEN
  945      RETURN ccLock(iH,iH.ID^.Id[iH.In].DataPtr.ID^.Locks[idx],Implicit);
  946    ELSE
  947      CallErr(iH,LockOverflow,'LockDat');
  948      RETURN FALSE;
  949    END;
  950  END LockDat;
  951  
  952  
  953  PROCEDURE ccUnLock(dH: IHandle; VAR lock: LockRec; type: LockType);
  954  VAR
  955    lck : FIOx.LockRec;
  956  BEGIN
  957    IF dH.ID^.Buffered THEN
  958      RETURN;
  959    END;
  960    WITH lock DO
  961      IF type=Implicit THEN
  962        IF ICnt#0 THEN
  963          DEC(ICnt);
  964        END;
  965      ELSIF type=AllImplicit THEN
  966        ICnt := 0;
  967      ELSIF type=AllLocks THEN
  968        ICnt := 0;
  969        ECnt := 0;
  970      ELSIF type=Explicit THEN
  971        IF ECnt#0 THEN
  972          DEC(ECnt);
  973        ELSE
  974          CallErr(dH,NotLocked,'ccUnLock');
  975          RETURN;
  976        END;
  977      END;
  978      IF ICnt=0 THEN
  979        IF ECnt#0 THEN
  980          In := Null;
  981        ELSE
  982          lck.pos := Position;
  983          lck.len := 1;
  984          FIOx.UnLock(dH.ID^.FHandle,lck);
  985        END;
  986      END;
  987    END;
  988  END ccUnLock;
  989  
  990  
  991  PROCEDURE cUnLock(dH: IHandle; dLoc: LONGCARD; type: LockType);
  992  VAR
  993    idx : CARDINAL;
  994  BEGIN
  995    IF dH.ID^.Buffered THEN
  996      RETURN;
  997    END;
  998    FOR idx := 0 TO LockQSize-1 DO
  999      IF dH.ID^.Locks[idx].Position=dLoc THEN
 1000        ccUnLock(dH,dH.ID^.Locks[idx],type);
 1001        dH.ID^.Locks[idx].Position := Nil;
 1002        RETURN;
 1003      END;
 1004    END;
 1005    IF type=Explicit THEN
 1006      CallErr(dH,NotLocked,'cUnLock');
 1007    END;
 1008  END cUnLock;
 1009  
 1010  
 1011  PROCEDURE UnLock(F: FHandle; DataLoc: LONGCARD);
 1012  VAR
 1013    dH : IHandle;
 1014  BEGIN
 1015    dH.ID := F;
 1016    dH.In := 0;
 1017    ClearErr(dH);
 1018    IF NOT IsIHandle(dH) THEN
 1019      CallFErr(dH.ID,NotIHandle,'UnLock');
 1020      RETURN;
 1021    END;
 1022    cUnLock(dH,DataLoc,Explicit);
 1023  END UnLock;
 1024  
 1025  
 1026  PROCEDURE UnLockDat(iH: IHandle; dLoc: LONGCARD);
 1027  VAR
 1028    idx : CARDINAL;
 1029  BEGIN
 1030    IF iH.ID^.Buffered THEN
 1031      RETURN;
 1032    END;
 1033    FOR idx := 0 TO LockQSize-1 DO
 1034      WITH iH.ID^.Id[iH.In].DataPtr.ID^ DO
 1035        IF Locks[idx].Position=dLoc THEN
 1036          ccUnLock(iH,Locks[idx],Implicit);
 1037          Locks[idx].Position := Nil;
 1038          RETURN;
 1039        END;
 1040      END;
 1041    END;
 1042  END UnLockDat;
 1043  
 1044  PROCEDURE FollowNextIndx(VAR H : IHandle);
 1045  BEGIN
 1046    WITH H.ID^.Id[H.In] DO H := NextIndx; END;
 1047  END FollowNextIndx;
 1048  
 1049  
 1050  PROCEDURE Release(H: IHandle);
 1051  VAR
 1052    idx : CARDINAL;
 1053  BEGIN
 1054    ClearErr(H);
 1055    IF NOT IsIHandle(H) THEN
 1056      CallFErr(H.ID,NotIHandle,'Release');
 1057      RETURN;
 1058    END;
 1059    IF H.ID^.Id[H.In].Ft=DataSlot THEN
 1060      FollowNextIndx(H);
 1061      WHILE H#Null DO
 1062        Release(H);
 1063        FollowNextIndx(H);
 1064      END;
 1065    ELSE
 1066      IF IsData(H.ID^.Id[H.In].DataPtr) THEN
 1067        WITH H.ID^.Id[H.In].DataPtr.ID^ DO
 1068          IF NOT Buffered THEN
 1069            FOR idx := 0 TO LockQSize-1 DO
 1070              WITH Locks[idx] DO
 1071                IF (Position#Nil) AND (In=H) THEN
 1072                  ccUnLock(H,Locks[idx],AllImplicit);
 1073                  Position := Nil;
 1074                END;
 1075              END;
 1076            END;
 1077          END;
 1078        END;
 1079      END;
 1080    END;
 1081  END Release;
 1082  
 1083  
 1084  PROCEDURE cOneLock(dH: IHandle; dLoc: LONGCARD; type: LockType): BOOLEAN;
 1085  VAR
 1086    idx : CARDINAL;
 1087  BEGIN
 1088    WITH dH.ID^ DO
 1089      IF NOT Buffered THEN
 1090        FOR idx := 0 TO LockQSize-1 DO
 1091          IF Locks[idx].Position=dLoc THEN
 1092            RETURN ccOneLock(Locks[idx],type);
 1093          END;
 1094        END;
 1095      END;
 1096    END;
 1097    RETURN FALSE;
 1098  END cOneLock;
 1099  
 1100  
 1101  PROCEDURE cLocked(dH: IHandle; dLoc: LONGCARD): BOOLEAN;
 1102  VAR
 1103    idx : CARDINAL;
 1104  BEGIN
 1105    WITH dH.ID^ DO
 1106      IF NOT Buffered THEN
 1107        FOR idx := 0 TO LockQSize-1 DO
 1108          IF Locks[idx].Position=dLoc THEN
 1109            RETURN TRUE;
 1110          END;
 1111        END;
 1112        RETURN FALSE;
 1113      ELSE
 1114        RETURN TRUE;
 1115      END;
 1116    END;
 1117  END cLocked;
 1118  
 1119  
 1120  PROCEDURE LockFile(fH: FHandle): BOOLEAN;
 1121  VAR
 1122    iH : IHandle;
 1123  BEGIN
 1124    IF NOT IsFHandle(fH) THEN
 1125      CallFErr(fH,NotFHandle,'LockFile');
 1126      RETURN FALSE;
 1127    END;
 1128    WITH fH^ DO
 1129      IF NOT Buffered THEN
 1130        iH.ID := fH;
 1131        iH.In := 0;
 1132        IF NOT ccLock(iH,fhLock,Implicit) THEN
 1133          RETURN FALSE;
 1134        END;
 1135        IF ccOneLock(fhLock,Implicit) THEN
 1136          FIOx.Seek(FHandle,fhLock.Position);
 1137          IOabort('LockFile');
 1138          FIOx.Read(FHandle,fwr^,FileDataWrSize);
 1139          IOabort('LockFile');
 1140        END;
 1141      END;
 1142    END;
 1143    RETURN TRUE;
 1144  END LockFile;
 1145  
 1146  
 1147  PROCEDURE FlushFHandle(fH: FHandle);
 1148  BEGIN
 1149    WITH fH^ DO
 1150      IF NOT ReadOnly THEN
 1151        FIOx.Seek(FHandle,fhLock.Position);
 1152        IOabort('FlushFHandle');
 1153        FIOx.Write(FHandle,fwr^,FileDataWrSize);
 1154        IOabort('FlushFHandle');
 1155      END;
 1156    END;
 1157  END FlushFHandle;
 1158  
 1159  
 1160  PROCEDURE UnLockFile(fH: FHandle);
 1161  VAR
 1162    iH : IHandle;
 1163  BEGIN
 1164    IF NOT IsFHandle(fH) THEN
 1165      CallFErr(fH,NotFHandle,'UnLockFile');
 1166      RETURN;
 1167    END;
 1168    WITH fH^ DO
 1169      IF NOT Buffered THEN
 1170        IF ccOneLock(fhLock,Implicit) THEN
 1171          FlushFHandle(fH);
 1172        END;
 1173        iH.ID := fH;
 1174        iH.In := 0;
 1175        ccUnLock(iH,fhLock,Implicit);
 1176      END;
 1177    END;
 1178  END UnLockFile;
 1179  
 1180  
 1181  PROCEDURE cLockIHandle(iH: IHandle; type: LockType): BOOLEAN;
 1182  BEGIN
 1183    WITH iH.ID^ DO
 1184      IF NOT Buffered THEN
 1185        WITH Id[iH.In] DO
 1186          IF ccLock(iH,ihLock,type) THEN
 1187            IF ccOneLock(ihLock,type) THEN
 1188              FIOx.Seek(FHandle,ihLock.Position);
 1189              IOabort('cLockIHandle');
 1190              FIOx.Read(FHandle,iwr^,IndexDataWrSize);
 1191              IOabort('cLockIHandle');
 1192              IF (Ft=IndexSlot) AND (OldWriteCnt#iwr^.WriteCnt) THEN
 1193                ClearBuffers(iH);
 1194                OldWriteCnt := iwr^.WriteCnt;
 1195                PageLevel := 0;
 1196                IF PageRefs^.Height<iwr^.Depth THEN
 1197                  FreeMem(PageRefs);
 1198                  AllocMem(PageRefs,VSIZE(PageRef.Height)+(iwr^.Depth+1)*SIZE(PageRefRec));
 1199                  Die(PageRefs=NIL,OutOfMemory);
 1200                  PageRefs^.Height := iwr^.Depth+1;
 1201                END;
 1202              END;
 1203            END;
 1204          ELSE
 1205            RETURN FALSE;
 1206          END;
 1207        END;
 1208      END;
 1209    END;
 1210    RETURN TRUE;
 1211  END cLockIHandle;
 1212  
 1213  
 1214  PROCEDURE LockIHandle(H: IHandle): BOOLEAN;
 1215  BEGIN
 1216    ClearErr(H);
 1217    IF NOT IsIHandle(H) THEN
 1218      CallFErr(H.ID,NotIHandle,'LockIHandle');
 1219      RETURN FALSE;
 1220    END;
 1221    RETURN cLockIHandle(H,Explicit);
 1222  END LockIHandle;
 1223  
 1224  
 1225  PROCEDURE FlushIHandle(iH: IHandle);
 1226  BEGIN
 1227    WITH iH.ID^ DO
 1228      IF NOT ReadOnly THEN
 1229        WITH Id[iH.In] DO
 1230          IF Ft=IndexSlot THEN
 1231            SaveBuffers(iH);
 1232            OldWriteCnt := iwr^.WriteCnt;
 1233          END;
 1234          FIOx.Seek(FHandle,ihLock.Position);
 1235          IOabort('FlushIHandle');
 1236          FIOx.Write(FHandle,iwr^,IndexDataWrSize);
 1237          IOabort('FlushIHandle');
 1238        END;
 1239      END;
 1240    END;
 1241  END FlushIHandle;
 1242  
 1243  
 1244  PROCEDURE SetLastKey(iH: IHandle);
 1245  
 1246  VAR
 1247    TP : TPage;
 1248  
 1249  TYPE
 1250    IPtr = POINTER Seg(TP) TO IndexItem;
 1251    A2 = ARRAY[0..1] OF SHORTCARD;
 1252  
 1253  (*# save *)
 1254  (*# call(inline=>on) *)
 1255  (*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
 1256    PROCEDURE AddIPtr(A: IPtr; I: CARDINAL): IPtr=A2(003H,0C1H);(*add ax,cx*)
 1257  (*# restore *)
 1258  
 1259  VAR
 1260    IP  : IPtr;
 1261  
 1262  BEGIN
 1263    WITH iH.ID^ DO
 1264      WITH Id[iH.In] DO
 1265        LastKeyOK := TRUE;
 1266        ReadPage(iH,PageRefs^.Refs[PageLevel].Page,TP);
 1267        IP := AddIPtr(IPtr(Ofs((TP.IItem))),PageRefs^.Refs[PageLevel].Rec*(2*SIZE(LONGCARD)+iwr^.KeySize));
 1268        LastKey := IP^.Key;
 1269        LastKeyRef := IP^.DP;
 1270      END;
 1271    END;
 1272  END SetLastKey;
 1273  
 1274  
 1275  PROCEDURE cUnLockIHandle(iH: IHandle; type: LockType);
 1276  BEGIN
 1277    WITH iH.ID^ DO
 1278      IF NOT Buffered THEN
 1279        WITH Id[iH.In] DO
 1280          IF ccOneLock(ihLock,type) THEN
 1281            IF Ft=IndexSlot THEN
 1282              IF PageLevel#0 THEN
 1283                SetLastKey(iH);
 1284              END;
 1285              FlushIHandle(iH);
 1286            END;
 1287          END;
 1288          ccUnLock(iH,ihLock,type);
 1289        END;
 1290      END;
 1291    END;
 1292  END cUnLockIHandle;
 1293  
 1294  
 1295  PROCEDURE UnLockIHandle(H: IHandle);
 1296  BEGIN
 1297    ClearErr(H);
 1298    IF NOT IsIHandle(H) THEN
 1299      CallFErr(H.ID,NotIHandle,'UnLockIHandle');
 1300      RETURN;
 1301    END;
 1302    cUnLockIHandle(H,Explicit);
 1303  END UnLockIHandle;
 1304  
 1305  
 1306  PROCEDURE N2Eval(KeySize: CARDINAL): CARDINAL;
 1307  VAR
 1308    t : CARDINAL;
 1309  BEGIN
 1310    t := (PageSize-6) DIV (8+KeySize);
 1311    IF ODD(t) THEN
 1312      DEC(t);
 1313    END;
 1314    IF (t=0) THEN
 1315      CallErr(Null,KeyTooBig,'N2Eval');
 1316      RETURN MAX(CARDINAL);
 1317    END;
 1318    RETURN t;
 1319  END N2Eval;
 1320  
 1321  
 1322  PROCEDURE WalkIx(iH: IHandle; mode: WalkMode);
 1323  
 1324  VAR
 1325    TP : TPage;
 1326  
 1327  TYPE
 1328    IPtr = POINTER Seg(TP) TO IndexItem;
 1329    A2 = ARRAY[0..1] OF SHORTCARD;
 1330    A3 = ARRAY[0..2] OF SHORTCARD;
 1331  
 1332  (*# save *)
 1333  (*# call(inline=>on) *)
 1334  (*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
 1335    PROCEDURE AddIPtr(A: IPtr; I: CARDINAL): IPtr=A2(003H,0C1H);(*add ax,cx*)
 1336  (*# restore *)
 1337  
 1338  (*%T _fptr *)
 1339  (*# save *)
 1340  (*# call(inline=>on) *)
 1341  (*# call(reg_param=>(bx,es,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
 1342  PROCEDURE IncIPtr(VAR a: IPtr; i: CARDINAL)=A3(026H,001H,007H); (* add es:[bx],cx *)
 1343  (*# restore *)
 1344  (*# save *)
 1345  (*# call(inline=>on) *)
 1346  (*# call(reg_param=>(bx,es,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
 1347  PROCEDURE DecIPtr(VAR a: IPtr; i: CARDINAL)=A3(026H,029H,007H); (* sub es:[bx],cx *)
 1348  (*# restore *)
 1349  (*%E *)
 1350  
 1351  (*%F _fptr *)
 1352  (*# save *)
 1353  (*# call(inline=>on) *)
 1354  (*# call(reg_param=>(bx,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
 1355  PROCEDURE IncIPtr(VAR a: IPtr; i: CARDINAL)=A2(001H,007H); (* add [bx],cx *)
 1356  (*# restore *)
 1357  (*# save *)
 1358  (*# call(inline=>on) *)
 1359  (*# call(reg_param=>(bx,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
 1360  PROCEDURE DecIPtr(VAR a: IPtr; i: CARDINAL)=A2(029H,007H); (* sub [bx],cx *)
 1361  (*# restore *)
 1362  (*%E *)
 1363  
 1364  VAR
 1365    IP,
 1366    BP       : IPtr;
 1367    LeafPage : BOOLEAN;
 1368    ItemSize : CARDINAL;
 1369    Index    : CARDINAL;
 1370  
 1371    PROCEDURE GetP(P: LONGCARD);
 1372    BEGIN
 1373      ReadPage(iH,P,TP);
 1374      IP := BP;
 1375      WITH iH.ID^.Id[iH.In] DO
 1376        LeafPage := PageLevel=iwr^.Depth;
 1377        WITH PageRefs^.Refs[PageLevel] DO
 1378          Page := P;
 1379          IF TP.ICount=iwr^.N2 THEN
 1380            IF P=iwr^.TopPage THEN
 1381              Cnt := 2;
 1382            ELSE
 1383              Cnt := PageRefs^.Refs[PageLevel-1].Cnt+1;
 1384            END;
 1385          ELSE
 1386            Cnt := 0;
 1387          END;
 1388        END;
 1389      END;
 1390      Index := 0;
 1391    END GetP;
 1392  
 1393  BEGIN
 1394    WITH iH.ID^.Id[iH.In] DO
 1395      ItemSize := 8+iwr^.KeySize;
 1396      BP := IPtr(Ofs((TP.IItem)));
 1397      LastDataRef := Nil;
 1398      IF PageLevel=0 THEN
 1399        PageLevel := 1;
 1400        GetP(iwr^.TopPage);
 1401        IF TP.ICount=0 THEN
 1402          PageLevel := 0;
 1403          RETURN;
 1404        ELSE
 1405          Index := 0;
 1406          LOOP
 1407            IF mode=Backward THEN
 1408              Index := TP.ICount;
 1409            END;
 1410            PageRefs^.Refs[PageLevel].Rec := Index;
 1411            IncIPtr(IP,Index*ItemSize);
 1412            IF LeafPage THEN
 1413              IF mode=Backward THEN
 1414                DecIPtr(IP,ItemSize);
 1415                DEC(PageRefs^.Refs[PageLevel].Rec);
 1416              END;
 1417              EXIT;
 1418            END;
 1419            INC(PageLevel);
 1420            GetP(IP^.IP);
 1421          END;
 1422        END;
 1423      ELSE
 1424        GetP(PageRefs^.Refs[PageLevel].Page);
 1425        Index := PageRefs^.Refs[PageLevel].Rec;
 1426        IF mode=Forward THEN
 1427          IF (Index+1<TP.ICount) OR
 1428             ((Index<TP.ICount) AND NOT LeafPage) THEN
 1429            INC(Index);
 1430            WHILE NOT LeafPage DO
 1431              PageRefs^.Refs[PageLevel].Rec := Index;
 1432              IncIPtr(IP,Index*ItemSize);
 1433              INC(PageLevel);
 1434              GetP(IP^.IP);
 1435            END;
 1436          ELSE
 1437            REPEAT
 1438              DEC(PageLevel);
 1439              IF PageLevel=0 THEN
 1440                RETURN;
 1441              END;
 1442              GetP(PageRefs^.Refs[PageLevel].Page);
 1443              Index := PageRefs^.Refs[PageLevel].Rec;
 1444            UNTIL Index<TP.ICount;
 1445          END;
 1446        ELSE
 1447          IF LeafPage THEN
 1448            IF Index=0 THEN
 1449              REPEAT
 1450                DEC(PageLevel);
 1451                IF PageLevel=0 THEN
 1452                  RETURN;
 1453                END;
 1454                GetP(PageRefs^.Refs[PageLevel].Page);
 1455                Index := PageRefs^.Refs[PageLevel].Rec;
 1456              UNTIL Index>0;
 1457            END;
 1458          ELSE
 1459            REPEAT
 1460              PageRefs^.Refs[PageLevel].Rec := Index;
 1461              IncIPtr(IP,Index*ItemSize);
 1462              INC(PageLevel);
 1463              GetP(IP^.IP);
 1464              Index := TP.ICount;
 1465            UNTIL LeafPage;
 1466          END;
 1467          DEC(Index);
 1468        END;
 1469        PageRefs^.Refs[PageLevel].Rec := Index;
 1470        IncIPtr(IP,Index*ItemSize);
 1471      END;
 1472      LastDataRef := IP^.DP;
 1473    END;
 1474  END WalkIx;
 1475  
 1476  
 1477  PROCEDURE FindIx(iH: IHandle; Key: ARRAY OF BYTE; DataPos: LONGCARD;
 1478                   Mode: FindMode): BOOLEAN;
 1479  
 1480  VAR
 1481    TP : TPage;
 1482  
 1483  TYPE
 1484    IPtr = POINTER Seg(TP) TO IndexItem;
 1485    A2 = ARRAY[0..1] OF SHORTCARD;
 1486  
 1487  (*# save *)
 1488  (*# call(inline=>on) *)
 1489  (*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
 1490    PROCEDURE AddIPtr(A: IPtr; I: CARDINAL): IPtr=A2(003H,0C1H);(*add ax,cx*)
 1491  (*# restore *)
 1492  
 1493  VAR
 1494    IP,
 1495    BP       : IPtr;
 1496    LeafPage : BOOLEAN;
 1497    ItemSize : CARDINAL;
 1498    Index    : CARDINAL;
 1499    C        : CmpRes;
 1500    First,
 1501    Last     : CARDINAL;
 1502  
 1503  LABEL
 1504    _Greater,
 1505    _Less;
 1506  
 1507    PROCEDURE GetPage(P: LONGCARD);
 1508    BEGIN
 1509      ReadPage(iH,P,TP);
 1510      WITH iH.ID^.Id[iH.In] DO
 1511        LeafPage := PageLevel=iwr^.Depth;
 1512        WITH PageRefs^.Refs[PageLevel] DO
 1513          Page := P;
 1514          IF TP.ICount=iwr^.N2 THEN
 1515            IF P=iwr^.TopPage THEN
 1516              Cnt := 2;
 1517            ELSE
 1518              Cnt := PageRefs^.Refs[PageLevel-1].Cnt+1;
 1519            END;
 1520          ELSE
 1521            Cnt := 0;
 1522          END;
 1523        END;
 1524      END;
 1525      First := 0;
 1526      Last := TP.ICount;
 1527      Index := (First + Last) DIV 2;
 1528      IP := AddIPtr(BP,Index*ItemSize);
 1529    END GetPage;
 1530  
 1531    PROCEDURE Walk(m : WalkMode);
 1532      BEGIN
 1533        WITH iH.ID^.Id[iH.In] DO
 1534          WalkIx(iH,m);
 1535          IF PageLevel#0 THEN
 1536            GetPage(PageRefs^.Refs[PageLevel].Page);
 1537            IP := AddIPtr(BP,PageRefs^.Refs[PageLevel].Rec*ItemSize);
 1538            C := CompFct(ADR(IP^.Key),ADR(Key));
 1539            LastDataRef := IP^.DP;
 1540          ELSE
 1541            LastDataRef := Nil;
 1542          END;
 1543        END;
 1544      END Walk;
 1545  
 1546  BEGIN
 1547    BP := IPtr(ADR(TP.IItem));
 1548    WITH iH.ID^.Id[iH.In] DO
 1549      ItemSize := 2*SIZE(LONGCARD)+iwr^.KeySize;
 1550      PageLevel := 1;
 1551      GetPage(iwr^.TopPage);
 1552      LOOP (* Opt1 *)
 1553        IF Index<TP.ICount THEN
 1554          C := CompFct(ADR(IP^.Key),ADR(Key));
 1555          LastDataRef := IP^.DP;
 1556        ELSE
 1557          C := Greater;
 1558          LastDataRef := Nil;
 1559        END;
 1560        IF First >= Last THEN
 1561          PageRefs^.Refs[PageLevel].Rec := Index;
 1562          IF LeafPage THEN
 1563            CASE Mode OF
 1564              | Ins : RETURN FALSE;
 1565              | Idx : RETURN FALSE;
 1566              | Rec : IF Index=TP.ICount THEN
 1567                        Walk(Forward);
 1568                      END;
 1569                      RETURN FALSE;
 1570              | Fnd,
 1571                Src : WHILE (PageLevel#0) AND (C#Less) DO
 1572                        Walk(Backward);
 1573                      END;
 1574                      Walk(Forward);
 1575                      RETURN (PageLevel#0) AND ((C=Eq) OR (Mode=Src));
 1576            END;
 1577          ELSE
 1578            INC(PageLevel);
 1579            GetPage(IP^.IP);
 1580          END;
 1581        ELSE
 1582          CASE C OF
 1583            | Greater :
 1584  _Greater:                                (* This key is >= the one we want *)
 1585                        Last := Index;
 1586            | Eq      : CASE Mode OF
 1587                          | Ins : IF NOT iwr^.DupKey THEN
 1588                                    CallErr(iH,ErrDupKey,'FindIx');
 1589                                    PageRefs^.Refs[PageLevel].Rec := Index;
 1590                                    RETURN FALSE;
 1591                                  ELSIF IP^.DP<DataPos THEN
 1592                                    GOTO _Less;
 1593                                  ELSE
 1594                                    GOTO _Greater;
 1595                                  END;
 1596                          | Idx,
 1597                            Rec : IF IP^.DP<DataPos THEN
 1598                                    GOTO _Less;
 1599                                  ELSIF IP^.DP=DataPos THEN
 1600                                    PageRefs^.Refs[PageLevel].Rec := Index;
 1601                                    RETURN TRUE;
 1602                                  ELSE
 1603                                    GOTO _Greater;
 1604                                  END;
 1605                          | Fnd,
 1606                            Src : GOTO _Greater;
 1607                        END;
 1608            | Less    :
 1609  _Less:                                   (* This key is < the one we want *)
 1610                        First := Index+1;
 1611          END;
 1612          Index := (First + Last) DIV 2;
 1613          IP := AddIPtr(BP,Index*ItemSize);
 1614        END;
 1615      END;
 1616    END;
 1617  END FindIx;
 1618  
 1619  
 1620  PROCEDURE FreeFreeBlock(fH: FHandle; Loc: LONGCARD);
 1621  BEGIN
 1622    FIOx.Seek(fH^.FHandle,Loc);
 1623    IOabort('FreeFreeBlock');
 1624    FIOx.Write(fH^.FHandle,fH^.fwr^.FreeList,4);
 1625    IOabort('FreeFreeBlock');
 1626    fH^.fwr^.FreeList := Loc;
 1627  END FreeFreeBlock;
 1628  
 1629  
 1630  PROCEDURE AllocateFreeBlock(fH: FHandle): LONGCARD;
 1631  VAR
 1632    Loc : LONGCARD;
 1633    r   : CARDINAL;
 1634  BEGIN
 1635    IF fH^.fwr^.FreeList#Nil THEN
 1636      Loc := fH^.fwr^.FreeList;
 1637      FIOx.Seek(fH^.FHandle,Loc);
 1638      IOabort('AllocateFreeBlock');
 1639      FIOx.Read(fH^.FHandle,fH^.fwr^.FreeList,4);
 1640      IOabort('AllocateFreeBlock');
 1641      RETURN Loc;
 1642    ELSE
 1643      FIOx.Seek(fH^.FHandle,fH^.fwr^.FileSize+PageSize-1);
 1644      IOabort('AllocateFreeBlock');
 1645      FIOx.Write(fH^.FHandle,0,1);
 1646      IF FIOx.Error()=FIOx.DISK_FULL THEN
 1647        FIOx.Truncate(fH^.FHandle,fH^.fwr^.FileSize);
 1648        IOabort('AllocateFreeBlock');
 1649        RETURN Nil;
 1650      END;
 1651      IOabort('AllocateFreeBlock');
 1652      Loc := fH^.fwr^.FileSize;
 1653      INC(fH^.fwr^.FileSize,PageSize);
 1654      RETURN Loc;
 1655    END;
 1656  END AllocateFreeBlock;
 1657  
 1658  
 1659  (*# save *)
 1660  (*# check(overflow=>off) *)
 1661  PROCEDURE FreeBlock(fH: FHandle; Len,Loc: LONGCARD);
 1662  VAR
 1663    iH    : IHandle;
 1664    r,
 1665    PLen,
 1666    NLen  : CARDINAL;
 1667    PLoc,
 1668    PLen4 : LONGCARD;
 1669  BEGIN
 1670    iH.ID := fH;
 1671    iH.In := 0;
 1672    LOOP
 1673      WITH fH^ DO
 1674        CASE fwr^.Mode OF
 1675            FixSize  : AddIndex(iH,Len,Loc);
 1676                       EXIT;
 1677          | Size16,
 1678            Compress : IF Len<SIZE(CARDINAL)*2 THEN
 1679                         Len := SIZE(CARDINAL)*2;
 1680                       END;
 1681                       FIOx.Seek(FHandle,Loc-SIZE(CARDINAL));
 1682                       IOabort('FreeBlock');
 1683                       FIOx.Read(FHandle,PLen,SIZE(CARDINAL));
 1684                       IF FIOx.Error()#FIOx.NO_ERROR THEN
 1685                         PLen := MAX(CARDINAL);
 1686                       END;
 1687                       PLoc := Loc-LONGCARD(PLen);
 1688                       IF ((Loc-SIZE(CARDINAL))>LONGCARD(fwr^.HeaderSize)) AND (PLen<MAX(CARDINAL)-SIZE(LONGCARD)*2) AND FindIx(iH,PLen,PLoc,Idx) THEN
 1689                         DeleteIndex(iH,PLen,PLoc);
 1690                         IF LONGCARD(PLen)+Len<MAX(CARDINAL)-SIZE(LONGCARD)*2 THEN
 1691                           NLen := PLen+CARDINAL(Len);
 1692                           Loc := Loc+Len;
 1693                           Len := 0;
 1694                         ELSE
 1695                           NLen := MAX(CARDINAL)-SIZE(LONGCARD)*2;
 1696                           Len  := Len-LONGCARD((MAX(CARDINAL)-SIZE(LONGCARD)*2-PLen));
 1697                           Loc  := Loc+LONGCARD((MAX(CARDINAL)-SIZE(LONGCARD)*2-PLen))
 1698                         END;
 1699                         IF (Len>0) AND (Len<SIZE(LONGCARD)) THEN
 1700                           NLen := NLen-(SIZE(LONGCARD)-CARDINAL(Len));
 1701                           Loc  := Loc-(SIZE(LONGCARD)-Len);
 1702                           Len  := SIZE(LONGCARD);
 1703                         END;
 1704                         FIOx.Seek(FHandle,PLoc);
 1705                         IOabort('FreeBlock');
 1706                         FIOx.Write(FHandle,NLen,SIZE(CARDINAL));
 1707                         IOabort('FreeBlock');
 1708                         FIOx.Seek(FHandle,PLoc+LONGCARD(NLen)-SIZE(CARDINAL));
 1709                         IOabort('FreeBlock');
 1710                         FIOx.Write(FHandle,NLen,SIZE(CARDINAL));
 1711                         IOabort('FreeBlock');
 1712                         AddIndex(iH,NLen,PLoc);
 1713                       END;
 1714                       IF Len>0 THEN
 1715                         FIOx.Seek(FHandle,Loc);
 1716                         IOabort('FreeBlock');
 1717                         FIOx.Write(FHandle,Len,SIZE(CARDINAL));
 1718                         IOabort('FreeBlock');
 1719                         FIOx.Seek(FHandle,Loc+Len-SIZE(CARDINAL));
 1720                         IOabort('FreeBlock');
 1721                         FIOx.Write(FHandle,Len,SIZE(CARDINAL));
 1722                         IOabort('FreeBlock');
 1723                         AddIndex(iH,Len,Loc);
 1724                         PLoc := Loc+Len;
 1725                       ELSE
 1726                         Len := LONGCARD(NLen);
 1727                         PLoc := PLoc+Len;
 1728                       END;
 1729                       (* Opt2 *)
 1730                       FIOx.Seek(FHandle,PLoc);
 1731                       IOabort('FreeBlock');
 1732                       FIOx.Read(FHandle,PLen,SIZE(CARDINAL));
 1733                       IF FIOx.Error()#FIOx.NO_ERROR THEN
 1734                         PLen := MAX(CARDINAL);
 1735                       END;
 1736                       IF (Len<MAX(CARDINAL)-SIZE(LONGCARD)*2) AND (PLen<MAX(CARDINAL)-SIZE(LONGCARD)*2) AND FindIx(iH,PLen,PLoc,Idx) THEN
 1737                         DeleteIndex(iH,PLen,PLoc);
 1738                         Len := LONGCARD(PLen);
 1739                         Loc := PLoc;
 1740                       ELSE
 1741                         EXIT;
 1742                       END;
 1743          | Size32   : IF Len<SIZE(LONGCARD)*2 THEN
 1744                         Len := SIZE(LONGCARD)*2;
 1745                       END;
 1746                       FIOx.Seek(FHandle,Loc-SIZE(LONGCARD));
 1747                       IOabort('FreeBlock');
 1748                       FIOx.Read(FHandle,PLen4,SIZE(LONGCARD));
 1749                       IF FIOx.Error()#FIOx.NO_ERROR THEN
 1750                         PLen4 := MAX(LONGCARD);
 1751                       END;
 1752                       PLoc := Loc-PLen4;
 1753                       IF ((Loc-SIZE(LONGCARD))>LONGCARD(fwr^.HeaderSize)) AND (PLen4<MAX(LONGCARD)-SIZE(LONGCARD)*2) AND FindIx(iH,PLen4,PLoc,Idx) THEN
 1754                         DeleteIndex(iH,PLen4,PLoc);
 1755                         Len := PLen4+Len;
 1756                         FIOx.Seek(FHandle,PLoc);
 1757                         IOabort('FreeBlock');
 1758                         FIOx.Write(FHandle,Len,SIZE(LONGCARD));
 1759                         IOabort('FreeBlock');
 1760                         FIOx.Seek(FHandle,PLoc+Len-SIZE(LONGCARD));
 1761                         IOabort('FreeBlock');
 1762                         FIOx.Write(FHandle,Len,SIZE(LONGCARD));
 1763                         IOabort('FreeBlock');
 1764                         AddIndex(iH,Len,PLoc);
 1765                         PLoc := PLoc+Len;
 1766                       ELSE
 1767                         FIOx.Seek(FHandle,Loc);
 1768                         IOabort('FreeBlock');
 1769                         FIOx.Write(FHandle,Len,SIZE(LONGCARD));
 1770                         IOabort('FreeBlock');
 1771                         FIOx.Seek(FHandle,Loc+Len-SIZE(LONGCARD));
 1772                         IOabort('FreeBlock');
 1773                         FIOx.Write(FHandle,Len,SIZE(LONGCARD));
 1774                         IOabort('FreeBlock');
 1775                         AddIndex(iH,Len,Loc);
 1776                         PLoc := Loc+Len;
 1777                       END;
 1778                       (* Opt2 *)
 1779                       FIOx.Seek(FHandle,PLoc);
 1780                       IOabort('FreeBlock');
 1781                       FIOx.Read(FHandle,PLen4,SIZE(LONGCARD));
 1782                       IF FIOx.Error()#FIOx.NO_ERROR THEN
 1783                         PLen4 := MAX(LONGCARD);
 1784                       END;
 1785                       IF (Len<MAX(LONGCARD)-SIZE(LONGCARD)*2) AND (PLen4<MAX(LONGCARD)-SIZE(LONGCARD)*2) AND FindIx(iH,PLen4,PLoc,Idx) THEN
 1786                         DeleteIndex(iH,PLen4,PLoc);
 1787                         Len := PLen4;
 1788                         Loc := PLoc;
 1789                       ELSE
 1790                         EXIT;
 1791                       END;
 1792          | NoDealoc : CallFErr(fH,BadFree,'NoDealloc');
 1793                       RETURN;
 1794          ELSE
 1795            CallFErr(fH,UnknownError,'FreeBlock');
 1796            RETURN;
 1797        END;
 1798      END;
 1799    END;
 1800  END FreeBlock;
 1801  (*# restore *)
 1802  
 1803  
 1804  PROCEDURE AllocateBlock(fH: FHandle; Len: LONGCARD): LONGCARD;
 1805  
 1806  VAR
 1807    Loc : LONGCARD;
 1808  
 1809    PROCEDURE Extend;
 1810    BEGIN
 1811      FIOx.Seek(fH^.FHandle,fH^.fwr^.FileSize+Len-1);
 1812      IOabort('AllocateBlock.Extend');
 1813      FIOx.Write(fH^.FHandle,0,1);
 1814      IF FIOx.Error()=FIOx.DISK_FULL THEN
 1815        FIOx.Truncate(fH^.FHandle,fH^.fwr^.FileSize);
 1816        IOabort('AllocateBlock.Extend');
 1817        Loc := Nil;
 1818        RETURN;
 1819      END;
 1820      IOabort('AllocateBlock.Extend');
 1821      Loc := fH^.fwr^.FileSize;
 1822      INC(fH^.fwr^.FileSize,Len);
 1823    END Extend;
 1824  
 1825  VAR
 1826    iH   : IHandle;
 1827    ActLen4,
 1828    tl   : LONGCARD;
 1829    ActLen2,
 1830    r    : CARDINAL;
 1831    Safe : BOOLEAN;
 1832  
 1833  BEGIN
 1834    iH.ID := fH;
 1835    iH.In := 0;
 1836    WITH fH^ DO
 1837      CASE fwr^.Mode OF
 1838          FixSize  : IF Len >= MAX(CARDINAL)-8 THEN
 1839                       CallFErr(fH,BadSize,'Allocate');
 1840                       RETURN Nil;
 1841                     END;
 1842                     IF FindIndex(iH,Len,Loc) THEN
 1843                       DeleteIndex(iH,Len,Loc);
 1844                     ELSE
 1845                       Extend;
 1846                     END;
 1847        | Size16,
 1848          Compress : IF Len<4 THEN
 1849                       Len := 4;
 1850                     END;
 1851                     IF Len >= MAX(CARDINAL)-8 THEN
 1852                       CallFErr(fH,BadSize,'Allocate');
 1853                       RETURN Nil;
 1854                     END;
 1855                     IF FindIndex(iH,Len,Loc) THEN
 1856                       DeleteIndex(iH,Len,Loc);
 1857                     ELSIF SearchIndex(iH,Len+4,Loc) THEN
 1858                       FIOx.Seek(FHandle,Loc);
 1859                       IOabort('AllocateBlock');
 1860                       FIOx.Read(FHandle,ActLen2,SIZE(CARDINAL));
 1861                       IOabort('AllocateBlock');
 1862                       DeleteIndex(iH,ActLen2,Loc);
 1863                       FreeBlock(fH,LONGCARD(ActLen2)-Len,Loc+Len);
 1864                     ELSE
 1865                       Extend;
 1866                     END;
 1867        | Size32   : IF Len<8 THEN
 1868                       Len := 8;
 1869                     END;
 1870                     IF FindIndex(iH,Len,Loc) THEN
 1871                       DeleteIndex(iH,Len,Loc);
 1872                     ELSIF SearchIndex(iH,Len+8,Loc) THEN
 1873                       FIOx.Seek(FHandle,Loc);
 1874                       IOabort('AllocateBlock');
 1875                       FIOx.Read(FHandle,ActLen4,SIZE(LONGCARD));
 1876                       IOabort('AllocateBlock');
 1877                       DeleteIndex(iH,ActLen4,Loc);
 1878                       FreeBlock(fH,ActLen4-Len,Loc+Len);
 1879                     ELSE
 1880                       Extend;
 1881                     END;
 1882        | NoDealoc : Extend;
 1883        ELSE
 1884          CallFErr(fH,UnknownError,'Allocate Block');
 1885          RETURN Nil;
 1886      END;
 1887    END;
 1888    RETURN Loc;
 1889  END AllocateBlock;
 1890  
 1891  
 1892  PROCEDURE LockIx(dH: IHandle): BOOLEAN;
 1893  
 1894    PROCEDURE cLockIx(iH: IHandle): BOOLEAN;
 1895    BEGIN
 1896      IF iH#Null THEN
 1897        IF NOT cLockIHandle(iH,Implicit) THEN
 1898          RETURN FALSE;
 1899        ELSIF NOT cLockIx(iH.ID^.Id[iH.In].NextIndx) THEN
 1900          cUnLockIHandle(iH,Implicit);
 1901          RETURN FALSE;
 1902        END;
 1903      END;
 1904      RETURN TRUE;
 1905    END cLockIx;
 1906  
 1907  BEGIN
 1908    IF NOT cLockIx(dH.ID^.Id[dH.In].NextIndx) THEN
 1909      SetErr(dH,Locked);
 1910      RETURN FALSE;
 1911    ELSE
 1912      RETURN TRUE;
 1913    END;
 1914  END LockIx;
 1915  
 1916  
 1917  PROCEDURE UnLockIx(dH: IHandle);
 1918  BEGIN
 1919    FollowNextIndx(dH);
 1920    WHILE dH#Null DO
 1921      cUnLockIHandle(dH,Implicit);
 1922      FollowNextIndx(dH);
 1923    END;
 1924  END UnLockIx;
 1925  
 1926  
 1927  PROCEDURE Delete(D: IHandle);
 1928  VAR
 1929    r,
 1930    Size,
 1931    BSize : CARDINAL;
 1932    t,
 1933    BPos  : LONGCARD;
 1934    iH,
 1935    tH    : IHandle;
 1936    Key   : KeyType;
 1937  BEGIN
 1938    ClearErr(D);
 1939    IF NOT IsData(D) THEN
 1940      CallErr(D,NotData,'Delete');
 1941      RETURN;
 1942    END;
 1943    IF D.ID^.ReadOnly THEN
 1944      CallErr(D,BadWrite,'Delete with ReadOnly');
 1945      RETURN;
 1946    END;
 1947    IF NOT cLocked(D,D.ID^.Id[D.In].LastDataRef) THEN
 1948      CallErr(D,NotLocked,'Delete');
 1949      RETURN;
 1950    END;
 1951    WITH D.ID^.Id[D.In] DO
 1952      IF LastDataRef#Nil THEN
 1953        IF LockFile(D.ID) THEN
 1954          IF LockIx(D) THEN
 1955            LoadRec(D,LastDataRef,BPos,BSize);
 1956            iH := NextIndx;
 1957            LOOP
 1958              WHILE iH.ID#NIL DO
 1959                iH.ID^.Id[iH.In].KeyFct(ADR(Key),bufPtr);
 1960                DeleteIndex(iH,Key,LastDataRef);
 1961                IF LastError(iH)#OK THEN
 1962                  SetErr(D,LastError(iH));
 1963                  tH := NextIndx;
 1964                  WHILE tH#iH DO
 1965                    tH.ID^.Id[tH.In].KeyFct(ADR(Key),bufPtr);
 1966                    AddIndex(tH,Key,LastDataRef);
 1967                    IF LastError(tH)#OK THEN
 1968                      ClearErr(D);
 1969                      SetErr(D,LastError(tH));
 1970                      EXIT;
 1971                    END;
 1972                    FollowNextIndx(tH);
 1973                  END;
 1974                  EXIT;
 1975                END;
 1976                FollowNextIndx(iH);
 1977              END;
 1978              FreeBlock(D.ID,LONGCARD(BSize),BPos);
 1979              EXIT;
 1980            END;
 1981            cUnLock(D,LastDataRef,AllLocks);
 1982            LastDataRef := Nil;
 1983            IF LastError(D)=OK THEN
 1984              DEC(iwr^.RecordCnt);
 1985            END;
 1986            UnLockIx(D);
 1987          END;
 1988          UnLockFile(D.ID);
 1989        ELSE
 1990          SetErr(D,Locked);
 1991        END;
 1992      END;
 1993    END;
 1994  END Delete;
 1995  
 1996  
 1997  PROCEDURE Add(D: IHandle; Data: ARRAY OF BYTE; Length: CARDINAL);
 1998  VAR
 1999    Size : CARDINAL;
 2000    Buf  : ADDRESS;
 2001    iH,
 2002    tH   : IHandle;
 2003    Key  : KeyType;
 2004  BEGIN
 2005    ClearErr(D);
 2006    IF NOT IsData(D) THEN
 2007      CallErr(D,NotData,'Add');
 2008      RETURN;
 2009    END;
 2010    IF D.ID^.ReadOnly THEN
 2011      CallErr(D,BadWrite,'Add with ReadOnly');
 2012      RETURN;
 2013    END;
 2014    WITH D.ID^.Id[D.In] DO
 2015      IF LockFile(D.ID) THEN
 2016        IF LockIx(D) THEN
 2017          IF iwr^.RecordSize=0 THEN
 2018            IF D.ID^.fwr^.Mode=Compress THEN
 2019              AdjustBuffer(D,Length);
 2020              Size := Packer(Length,ADR(Data),bufPtr);
 2021              Buf := bufPtr;
 2022            ELSE
 2023              Size := Length;
 2024              Buf := ADR(Data);
 2025            END;
 2026            LastDataRef := AllocateBlock(D.ID,LONGCARD(Size+SIZE(Size)))+SIZE(Size);
 2027            IF LastDataRef#Nil THEN
 2028              FIOx.Seek(D.ID^.FHandle,LastDataRef-SIZE(Size));
 2029              IOabort('Add');
 2030              FIOx.Write(D.ID^.FHandle,Size,SIZE(Size));
 2031              IOabort('Add');
 2032            END;
 2033          ELSE
 2034            Size := iwr^.RecordSize;
 2035            Buf := ADR(Data);
 2036            LastDataRef := AllocateBlock(D.ID,LONGCARD(Size));
 2037            IF LastDataRef#Nil THEN
 2038              FIOx.Seek(D.ID^.FHandle,LastDataRef);
 2039              IOabort('Add');
 2040            END;
 2041          END;
 2042          IF LastDataRef=Nil THEN
 2043            UnLockIx(D);
 2044            UnLockFile(D.ID);
 2045            CallErr(D,FileError,'Add');
 2046            RETURN;
 2047          END;
 2048          FIOx.Write(D.ID^.FHandle,Buf^,Size);
 2049          IOabort('Add');
 2050          iH := NextIndx;
 2051          LOOP
 2052            WHILE iH.ID#NIL DO
 2053              iH.ID^.Id[iH.In].KeyFct(ADR(Key),ADR(Data));
 2054              AddIndex(iH,Key,LastDataRef);
 2055              IF LastError(iH)#OK THEN
 2056                SetErr(D,LastError(iH));
 2057                LOOP
 2058                  tH := NextIndx;
 2059                  WHILE tH#iH DO
 2060                    tH.ID^.Id[tH.In].KeyFct(ADR(Key),ADR(Data));
 2061                    DeleteIndex(tH,Key,LastDataRef);
 2062                    IF LastError(tH)#OK THEN
 2063                      ClearErr(D);
 2064                      SetErr(D,LastError(tH));
 2065                      EXIT;
 2066                    END;
 2067                    FollowNextIndx(tH);
 2068                  END;
 2069                  EXIT;
 2070                END;
 2071                IF iwr^.RecordSize=0 THEN
 2072                  FreeBlock(D.ID,LONGCARD(Size+SIZE(Size)),LastDataRef-SIZE(Size));
 2073                ELSE
 2074                  FreeBlock(D.ID,LONGCARD(Size),LastDataRef);
 2075                END;
 2076                EXIT;
 2077              END;
 2078              FollowNextIndx(iH);
 2079            END;
 2080            EXIT;
 2081          END;
 2082          IF LastError(D)=OK THEN
 2083            INC(iwr^.RecordCnt);
 2084          END;
 2085          UnLockIx(D);
 2086        END;
 2087        UnLockFile(D.ID);
 2088      ELSE
 2089        SetErr(D,Locked);
 2090      END;
 2091    END;
 2092  END Add;
 2093  
 2094  
 2095  PROCEDURE Change(D: IHandle; Data: ARRAY OF BYTE; Length: CARDINAL);
 2096  VAR
 2097    BPos : LONGCARD;
 2098    size : CARDINAL;
 2099    t : CARDINAL;
 2100    iH : IHandle;
 2101    err : Errors;
 2102    OldKey,
 2103    NewKey : KeyType;
 2104  BEGIN
 2105    ClearErr(D);
 2106    IF NOT IsData(D) THEN
 2107      CallErr(D,NotData,'Change');
 2108      RETURN;
 2109    END;
 2110    IF D.ID^.ReadOnly THEN
 2111      CallErr(D,BadWrite,'Change with ReadOnly');
 2112      RETURN;
 2113    END;
 2114    IF (D.ID^.Id[D.In].iwr^.RecordSize=0) AND (D.ID^.fwr^.Mode=Compress) THEN
 2115      CallErr(D,BadSize,'Change');
 2116      RETURN;
 2117    END;
 2118    IF D.ID^.Id[D.In].LastDataRef=Nil THEN
 2119      CallErr(D,BadIndex,'Change');
 2120      RETURN;
 2121    END;
 2122    IF NOT cLocked(D,D.ID^.Id[D.In].LastDataRef) THEN
 2123      CallErr(D,NotLocked,'Change');
 2124      RETURN;
 2125    END;
 2126    LoadRec(D,D.ID^.Id[D.In].LastDataRef,BPos,size);
 2127    IF size#Length THEN
 2128      CallErr(D,BadSize,'Change');
 2129      RETURN;
 2130    END;
 2131    err := OK;
 2132    iH := D.ID^.Id[D.In].NextIndx;
 2133    LOOP
 2134      IF iH=Null THEN
 2135        EXIT;
 2136      END;
 2137      WITH iH.ID^.Id[iH.In] DO
 2138        KeyFct(ADR(OldKey),D.ID^.Id[D.In].bufPtr);
 2139        KeyFct(ADR(NewKey),ADR(Data));
 2140        IF CompFct(ADR(OldKey),ADR(NewKey))#Eq THEN
 2141          err := BadIndex;
 2142          EXIT;
 2143        END;
 2144        iH := NextIndx;
 2145      END;
 2146    END;
 2147    CallErr(D,err,'Change');
 2148    IF err=OK THEN
 2149      FIOx.Seek(D.ID^.FHandle,D.ID^.Id[D.In].LastDataRef);
 2150      IOabort('Change');
 2151      FIOx.Write(D.ID^.FHandle,Data,size);
 2152      IOabort('Change');
 2153    END;
 2154  END Change;
 2155  
 2156  
 2157  PROCEDURE SyncIx(iH: IHandle; rec: ARRAY OF BYTE);
 2158  VAR
 2159    tH : IHandle;
 2160  BEGIN
 2161    tH := iH.ID^.Id[iH.In].DataPtr;
 2162    IF tH.ID^.Id[tH.In].Sync THEN
 2163      LOOP
 2164        FollowNextIndx(tH);
 2165        IF tH=Null THEN
 2166          EXIT;
 2167        END;
 2168        IF tH#iH THEN
 2169          WITH tH.ID^.Id[tH.In] DO
 2170            LastKeyRef := iH.ID^.Id[iH.In].LastDataRef;
 2171            KeyFct(ADR(LastKey),ADR(rec));
 2172            LastKeyOK := TRUE;
 2173            PageLevel := 0;
 2174          END;
 2175        END;
 2176      END;
 2177    END;
 2178  END SyncIx;
 2179  
 2180  
 2181  PROCEDURE Search(I: IHandle; Key: ARRAY OF BYTE;
 2182                   VAR Data: ARRAY OF BYTE): BOOLEAN;
 2183  VAR
 2184    r : BOOLEAN;
 2185    t : CARDINAL;
 2186  BEGIN
 2187    ClearErr(I);
 2188    IF NOT IsIndex(I) THEN
 2189      CallErr(I,NotIndex,'Search');
 2190      RETURN FALSE;
 2191    END;
 2192    Release(I);
 2193    IF cLockIHandle(I,Implicit) THEN
 2194      r := SearchIndex(I,Key,I.ID^.Id[I.In].LastDataRef);
 2195      WITH I.ID^.Id[I.In] DO
 2196        IF NOT r THEN
 2197          DataPtr.ID^.Id[DataPtr.In].LastDataRef := Nil;
 2198        ELSE
 2199          IF LockDat(I,LastDataRef) THEN
 2200            DataPtr.ID^.Id[DataPtr.In].LastDataRef := LastDataRef;
 2201            ReadRec(DataPtr,LastDataRef,Data);
 2202  (*
 2203            l := DataPtr.ID^.Id[DataPtr.In].iwr^.RecordSize;
 2204            IF l=0 THEN
 2205              FIOx.Seek(DataPtr.ID^.FHandle,LastDataRef-2);
 2206              IOabort('Search');
 2207              FIOx.Read(DataPtr.ID^.FHandle,l,2);
 2208              IOabort('Search');
 2209            ELSE
 2210              FIOx.Seek(DataPtr.ID^.FHandle,LastDataRef);
 2211              IOabort('Search');
 2212            END;
 2213            FIOx.Read(DataPtr.ID^.FHandle,Data,l);
 2214            IOabort('Search');
 2215  *)
 2216            SyncIx(I,Data);
 2217          ELSE
 2218            r := FALSE;
 2219          END;
 2220        END;
 2221      END;
 2222      cUnLockIHandle(I,Implicit);
 2223      RETURN r;
 2224    ELSE
 2225      RETURN FALSE;
 2226    END;
 2227  END Search;
 2228  
 2229  
 2230  PROCEDURE Find(I: IHandle; Key: ARRAY OF BYTE;
 2231                 VAR Data: ARRAY OF BYTE): BOOLEAN;
 2232  VAR
 2233    r : BOOLEAN;
 2234    t : CARDINAL;
 2235  BEGIN
 2236    ClearErr(I);
 2237    IF NOT IsIndex(I) THEN
 2238      CallErr(I,NotIndex,'Find');
 2239      RETURN FALSE;
 2240    END;
 2241    Release(I);
 2242    IF cLockIHandle(I,Implicit) THEN
 2243      r := FindIndex(I,Key,I.ID^.Id[I.In].LastDataRef);
 2244      WITH I.ID^.Id[I.In] DO
 2245        IF r THEN
 2246          IF LockDat(I,LastDataRef) THEN
 2247            DataPtr.ID^.Id[DataPtr.In].LastDataRef := LastDataRef;
 2248            ReadRec(DataPtr,LastDataRef,Data);
 2249  (*
 2250            l := DataPtr.ID^.Id[DataPtr.In].iwr^.RecordSize;
 2251            IF l=0 THEN
 2252              FIOx.Seek(DataPtr.ID^.FHandle,LastDataRef-2);
 2253              IOabort('Find');
 2254              FIOx.Read(DataPtr.ID^.FHandle,l,2);
 2255              IOabort('Find');
 2256            ELSE
 2257              FIOx.Seek(DataPtr.ID^.FHandle,LastDataRef);
 2258              IOabort('Find');
 2259            END;
 2260            FIOx.Read(DataPtr.ID^.FHandle,Data,l);
 2261            IOabort('Find');
 2262  *)
 2263            SyncIx(I,Data);
 2264          ELSE
 2265            r := FALSE;
 2266          END;
 2267        ELSE
 2268          DataPtr.ID^.Id[DataPtr.In].LastDataRef := Nil;
 2269        END;
 2270      END;
 2271      cUnLockIHandle(I,Implicit);
 2272      RETURN r;
 2273    ELSE
 2274      RETURN FALSE;
 2275    END;
 2276  END Find;
 2277  
 2278  
 2279  PROCEDURE Next(I: IHandle; VAR Data: ARRAY OF BYTE): BOOLEAN;
 2280  VAR
 2281    SerKey : IndexItem;
 2282    Loc    : LONGCARD;
 2283    r      : CARDINAL;
 2284    ok     : BOOLEAN;
 2285  BEGIN
 2286    ClearErr(I);
 2287    IF NOT IsIndex(I) THEN
 2288      CallErr(I,NotIndex,'Next');
 2289      RETURN FALSE;
 2290    END;
 2291    IF cLockIHandle(I,Implicit) THEN
 2292      WITH I.ID^.Id[I.In] DO
 2293        IF NextIndex(I,Loc) THEN
 2294          IF LockDat(I,Loc) THEN
 2295            DataPtr.ID^.Id[DataPtr.In].LastDataRef := Loc;
 2296            ReadRec(DataPtr,Loc,Data);
 2297  (*
 2298            l := DataPtr.ID^.Id[DataPtr.In].iwr^.RecordSize;
 2299            IF l=0 THEN
 2300              FIOx.Seek(DataPtr.ID^.FHandle,Loc-2);
 2301              IOabort('Next');
 2302              FIOx.Read(DataPtr.ID^.FHandle,l,2);
 2303              IOabort('Next');
 2304            ELSE
 2305              FIOx.Seek(DataPtr.ID^.FHandle,Loc);
 2306              IOabort('Next');
 2307            END;
 2308            FIOx.Read(DataPtr.ID^.FHandle,Data,l);
 2309            IOabort('Next');
 2310  *)
 2311            SyncIx(I,Data);
 2312            LastKeyOK := FALSE;
 2313            ok := TRUE;
 2314          ELSE
 2315            PageLevel := 0;
 2316            ok := FALSE;
 2317          END;
 2318        ELSE
 2319          ok := FALSE;
 2320        END;
 2321      END;
 2322      cUnLockIHandle(I,Implicit);
 2323      RETURN ok;
 2324    ELSE
 2325      RETURN FALSE;
 2326    END;
 2327  END Next;
 2328  
 2329  
 2330  PROCEDURE Prev(I: IHandle; VAR Data: ARRAY OF BYTE): BOOLEAN;
 2331  VAR
 2332    SerKey : IndexItem;
 2333    Loc    : LONGCARD;
 2334    r      : CARDINAL;
 2335    ok     : BOOLEAN;
 2336  BEGIN
 2337    ClearErr(I);
 2338    IF NOT IsIndex(I) THEN
 2339      CallErr(I,NotIndex,'Prev');
 2340      RETURN FALSE;
 2341    END;
 2342    IF cLockIHandle(I,Implicit) THEN
 2343      WITH I.ID^.Id[I.In] DO
 2344        IF PrevIndex(I,Loc) THEN
 2345          IF LockDat(I,Loc) THEN
 2346            DataPtr.ID^.Id[DataPtr.In].LastDataRef := Loc;
 2347            ReadRec(DataPtr,Loc,Data);
 2348  (*
 2349            l := DataPtr.ID^.Id[DataPtr.In].iwr^.RecordSize;
 2350            IF l=0 THEN
 2351              FIOx.Seek(DataPtr.ID^.FHandle,Loc-2);
 2352              IOabort('Prev');
 2353              FIOx.Read(DataPtr.ID^.FHandle,l,2);
 2354              IOabort('Prev');
 2355            ELSE
 2356              FIOx.Seek(DataPtr.ID^.FHandle,Loc);
 2357              IOabort('Prev');
 2358            END;
 2359            FIOx.Read(DataPtr.ID^.FHandle,Data,l);
 2360            IOabort('Prev');
 2361  *)
 2362            SyncIx(I,Data);
 2363            LastKeyOK := FALSE;
 2364            ok := TRUE;
 2365          ELSE
 2366            PageLevel := 0;
 2367            ok := FALSE;
 2368          END;
 2369        ELSE
 2370          ok := FALSE;
 2371        END;
 2372      END;
 2373      cUnLockIHandle(I,Implicit);
 2374      RETURN ok;
 2375    ELSE
 2376      RETURN FALSE;
 2377    END;
 2378  END Prev;
 2379  
 2380  
 2381  PROCEDURE Reset(H: IHandle);
 2382  VAR
 2383    iH : IHandle;
 2384  BEGIN
 2385    ClearErr(H);
 2386    IF NOT IsIHandle(H) THEN
 2387      CallFErr(H.ID,NotIHandle,'Reset');
 2388      RETURN;
 2389    END;
 2390    IF IsData(H) THEN
 2391      iH := H.ID^.Id[H.In].NextIndx;
 2392      WHILE iH.ID#NIL DO
 2393        Reset(iH);
 2394        FollowNextIndx(iH);
 2395      END;
 2396    ELSE
 2397      H.ID^.Id[H.In].PageLevel := 0;
 2398      H.ID^.Id[H.In].LastKeyOK := FALSE;
 2399      Release(H);
 2400    END;
 2401    H.ID^.Id[H.In].LastDataRef := Nil;
 2402  END Reset;
 2403  
 2404  
 2405  PROCEDURE UpdateSlot(iH: IHandle);
 2406  BEGIN
 2407    FIOx.Seek(iH.ID^.FHandle,iH.ID^.Id[iH.In].ihLock.Position);
 2408    IOabort('UpdateSlot');
 2409    FIOx.Write(iH.ID^.FHandle,iH.ID^.Id[iH.In].iwr^,IndexDataWrSize);
 2410    IOabort('UpdateSlot');
 2411  END UpdateSlot;
 2412  
 2413  
 2414  PROCEDURE OpenIx(VAR iH: IHandle; CmpFct: CompareFunction; KeSize: CARDINAL;
 2415                   DpKey: BOOLEAN; Create: BOOLEAN);
 2416  VAR
 2417    t : TPage;
 2418    i,
 2419    r : CARDINAL;
 2420  BEGIN
 2421    WITH iH.ID^.Id[iH.In] DO
 2422      LastDataRef := Nil;
 2423      NextIndx := Null;
 2424      LastErr := OK;
 2425      ErrorNest := 0;
 2426      DataPtr := Null;
 2427      PageLevel := 0;
 2428      CompFct := CmpFct;
 2429      KeyFct := NULLPROC;
 2430      LastKeyOK := FALSE;
 2431      IF Create THEN
 2432        OldWriteCnt := 0;
 2433        AllocMem(PageRefs,VSIZE(PageRef.Height)+10*SIZE(PageRefRec));
 2434        Die(PageRefs=NIL,OutOfMemory);
 2435        PageRefs^.Height := 10;
 2436        iwr^.RecordCnt := 0;
 2437        iwr^.WriteCnt := 0;
 2438        IF iH.In=0 THEN
 2439          iwr^.TopPage := iH.ID^.fwr^.FileSize;
 2440          INC(iH.ID^.fwr^.FileSize,PageSize);
 2441        ELSE
 2442          iwr^.TopPage := AllocateBlock(iH.ID,PageSize);
 2443        END;
 2444        iwr^.Depth := 1;
 2445        iwr^.KeySize := KeSize;
 2446        iwr^.N2 := N2Eval(KeSize);
 2447        IF iwr^.N2=MAX(CARDINAL) THEN
 2448          SetFErr(iH.ID,KeyTooBig);
 2449          RETURN;
 2450        END;
 2451        iwr^.N22 := iwr^.N2 DIV 2;
 2452        iwr^.DupKey := DpKey;
 2453        (* create empty Root Page *)
 2454        t.ICount := 0;
 2455        t.IItem.IP := Nil;
 2456        iwr^.Ft := IndexSlot;
 2457        FIOx.Seek(iH.ID^.FHandle,iwr^.TopPage);
 2458        IOabort('OpenIx');
 2459        FIOx.Write(iH.ID^.FHandle,t,SIZE(t));
 2460        IOabort('OpenIx');
 2461        UpdateSlot(iH);
 2462      ELSE
 2463        IF (iwr^.Ft#IndexSlot) OR (iwr^.KeySize#KeSize) OR (iwr^.DupKey#DpKey) THEN
 2464          CallFErr(iH.ID,BadIndex,'OpenIx');
 2465          RETURN;
 2466        END;
 2467        OldWriteCnt := iwr^.WriteCnt;
 2468        i := 10;
 2469        IF i+2 < iwr^.Depth THEN
 2470          i := (iwr^.Depth-i)*2+i;
 2471        END;
 2472        AllocMem(PageRefs,VSIZE(PageRef.Height)+i*SIZE(PageRefRec));
 2473        Die(PageRefs=NIL,OutOfMemory);
 2474        PageRefs^.Height := i;
 2475      END;
 2476      Ft := IndexSlot;
 2477    END;
 2478  END OpenIx;
 2479  
 2480  
 2481  (*# save *)
 2482  (*%T _fcall *) (*# call(near_call=>off) *) (*%E *)
 2483  PROCEDURE SizeCmp4(VAR a,b: LONGCARD): CmpRes;
 2484  BEGIN
 2485    IF a < b THEN
 2486      RETURN Less;
 2487    ELSIF a = b THEN
 2488      RETURN Eq;
 2489    ELSE
 2490      RETURN Greater;
 2491    END;
 2492  END SizeCmp4;
 2493  (*# restore *)
 2494  
 2495  
 2496  (*# save *)
 2497  (*%T _fcall *) (*# call(near_call=>off) *) (*%E *)
 2498  PROCEDURE SizeCmp2(VAR a,b: CARDINAL): CmpRes;
 2499  BEGIN
 2500    IF a < b THEN
 2501      RETURN Less;
 2502    ELSIF a = b THEN
 2503      RETURN Eq;
 2504    ELSE
 2505      RETURN Greater;
 2506    END;
 2507  END SizeCmp2;
 2508  (*# restore *)
 2509  
 2510  
 2511  PROCEDURE Open(Name: ARRAY OF CHAR; MaxIHandle: CARDINAL; AMode : AccessMode;
 2512                 readOnly, shared, Create: BOOLEAN): FHandle;
 2513  
 2514  VAR
 2515    iH : IHandle;
 2516    h,
 2517    r,
 2518    i  : CARDINAL;
 2519    lck : FIOx.LockRec;
 2520  
 2521  (*# save *)
 2522  (*# call(o_a_size=>on) *)
 2523    PROCEDURE Abort(str : ARRAY OF CHAR);
 2524    BEGIN
 2525      IF iH.ID # NIL THEN
 2526        IF iH.ID^.FHandle#MAX(CARDINAL) THEN
 2527          FIOx.Close(iH.ID^.FHandle);
 2528          IOabort('Open.Abort');
 2529        END;
 2530        FreeMem(iH.ID);
 2531      END;
 2532      CallErr(Null,BadOpen,str);
 2533    END Abort;
 2534  (*# restore *)
 2535  
 2536  BEGIN
 2537    IF (AMode=Compress) AND NOT Packing() THEN
 2538      CallErr(Null,BadOpen,'Compress w/o PACK');
 2539      RETURN NIL;
 2540    END;
 2541    IF readOnly AND Create THEN
 2542      CallErr(Null,BadOpen,'ReadOnly with Create');
 2543      RETURN NIL;
 2544    END;
 2545    IF shared AND Create THEN
 2546      CallErr(Null,BadOpen,'Shared with Create');
 2547    END;
 2548    r := FIOx.Open(Name,shared,readOnly,Create);
 2549    IF r=MAX(CARDINAL) THEN
 2550      CallErr(Null,FileError,'Create');
 2551      RETURN NIL;
 2552    END;
 2553    h := SIZE(IndexDataWr)*MaxIHandle+SIZE(IndexFileWr);
 2554    IF h MOD SectorSize#0 THEN
 2555      h := h+SectorSize-(h MOD SectorSize);
 2556    END;
 2557    i := IndexDataSize*MaxIHandle+IndexFileSize+h;
 2558    AllocMem(iH.ID,i);
 2559    Die(iH.ID=NIL,OutOfMemory);
 2560    iH.In := 0;
 2561    WITH iH.ID^ DO
 2562      ReadOnly := readOnly;
 2563      Buffered := NOT shared OR readOnly OR NOT FIOx.MultiFile(r);
 2564      WriteThru := FALSE;
 2565      FOR i := 0 TO LockQSize-1 DO
 2566        Locks[i] := LockRec(Nil,0,0,Null);
 2567      END;
 2568      fhLock := LockRec(0,0,0,Null);
 2569      FHandle := r;
 2570      fwr := AddAddr(iH.ID,IndexFileSize+IndexDataSize*MaxIHandle);
 2571      FOR i := 0 TO MaxIHandle DO
 2572        WITH Id[i] DO
 2573          ihLock := LockRec(0,0,0,Null);
 2574          ihLock.Position := SIZE(IndexFileWr)+SIZE(IndexDataWr)*VAL(LONGCARD,i);
 2575          Ft := FreeSlot;
 2576          iwr := AddAddr(fwr,VAL(CARDINAL,ihLock.Position));
 2577        END;
 2578      END;
 2579      IF Create THEN
 2580        fwr^.HeaderSize := h;
 2581        fwr^.FileSize := VAL(LONGCARD,h);
 2582        fwr^.Version := ThisVersion;
 2583        fwr^.FreeList := Nil;
 2584        fwr^.IndexCount :=MaxIHandle;
 2585        fwr^.Mode := AMode;
 2586        fwr^.PageSz := PageSize;
 2587        fwr^.MaxKeySz := MaxKeySize;
 2588        FOR i := 0 TO MaxIHandle DO
 2589          Id[i].iwr^.Ft := FreeSlot;
 2590        END;
 2591        FIOx.Write(FHandle,fwr^,fwr^.HeaderSize);
 2592        IOabort('Open');
 2593      ELSE
 2594        lck.pos := 0;
 2595        lck.len := SIZE(fwr^.HeaderSize);
 2596        IF NOT Buffered AND NOT FIOx.Lock(FHandle,lck) THEN
 2597          Abort('Lock failure');
 2598          RETURN NIL;
 2599        END;
 2600        FIOx.Read(FHandle,fwr^.HeaderSize,SIZE(fwr^.HeaderSize));
 2601        IF NOT Buffered THEN
 2602          FIOx.UnLock(FHandle,lck);
 2603        END;
 2604        IF FIOx.Error()#FIOx.PAST_EOF THEN
 2605          IOabort('Open');
 2606        END;
 2607        IF (FIOx.Error()=FIOx.PAST_EOF) OR (h#fwr^.HeaderSize) THEN
 2608          Abort('HeaderSize');
 2609          RETURN NIL;
 2610        END;
 2611        lck.pos := 0;
 2612        lck.len := VAL(LONGCARD,fwr^.HeaderSize);
 2613        IF NOT Buffered AND NOT FIOx.Lock(FHandle,lck) THEN
 2614          Abort('Lock failure(2)');
 2615        END;
 2616        FIOx.Read(FHandle,fwr^.FileSize,fwr^.HeaderSize-SIZE(fwr^.HeaderSize));
 2617        IF NOT Buffered THEN
 2618          FIOx.UnLock(FHandle,lck);
 2619        END;
 2620        IF FIOx.Error()#FIOx.PAST_EOF THEN
 2621          IOabort('Open');
 2622        END;
 2623        IF FIOx.Error()=FIOx.PAST_EOF THEN
 2624          Abort('I/O Error');
 2625          RETURN NIL;
 2626        ELSIF (fwr^.Version DIV 10) # (ThisVersion DIV 10) THEN
 2627          Abort('Version');  (* The version number's ones digit isn't tested! *)
 2628          RETURN NIL;
 2629        ELSIF fwr^.Mode#AMode THEN
 2630          Abort('Accessmode');
 2631          RETURN NIL;
 2632        ELSIF fwr^.IndexCount#MaxIHandle THEN
 2633          Abort('MaxIHandle');
 2634          RETURN NIL;
 2635        ELSIF fwr^.PageSz#PageSize THEN
 2636          Abort('PageSize');
 2637          RETURN NIL;
 2638        ELSIF fwr^.MaxKeySz#MaxKeySize THEN
 2639          Abort('MaxKeySize');
 2640          RETURN NIL;
 2641        END;
 2642      END;
 2643      IF AMode=Size32 THEN
 2644        OpenIx(iH,CompareFunction(SizeCmp4),4,TRUE,Create);
 2645      ELSE
 2646        OpenIx(iH,CompareFunction(SizeCmp2),2,TRUE,Create);
 2647      END;
 2648      IF iH=Null THEN
 2649        Abort('Unknown error');
 2650        RETURN NIL;
 2651      END;
 2652    END;
 2653    iH.ID^.G1 := GuardV1;
 2654    iH.ID^.G2 := GuardV2;
 2655    ClearFErr(iH.ID);
 2656    RETURN iH.ID;
 2657  END Open;
 2658  
 2659  
 2660  PROCEDURE OpenIndex(F: FHandle; D: IHandle; I: CARDINAL;
 2661                      CmpFct: CompareFunction; KeFct: KeyFunction;
 2662                      KeSize: CARDINAL; DpKey,New: BOOLEAN): IHandle;
 2663  VAR
 2664    iH  : IHandle;
 2665    idx : CARDINAL;
 2666  BEGIN
 2667    ClearFErr(F);
 2668    IF NOT IsFHandle(F) THEN
 2669      CallFErr(F,NotFHandle,'OpenIndex');
 2670      RETURN Null;
 2671    END;
 2672    IF (D#Null) AND NOT IsData(D) THEN
 2673      CallFErr(F,NotData,'OpenIndex');
 2674      RETURN Null;
 2675    END;
 2676    IF New AND NOT F^.Buffered THEN
 2677      CallFErr(F,BadOpen,'New with Sharing');
 2678      RETURN Null;
 2679    END;
 2680    IF (F^.fwr^.IndexCount<I) OR ((F^.Id[I].iwr^.Ft#FreeSlot)=New) THEN
 2681      CallFErr(F,NoSlot,'Index');
 2682      RETURN Null;
 2683    END;
 2684    IF New AND F^.ReadOnly THEN
 2685      CallFErr(F,BadOpen,'New with ReadOnly');
 2686      RETURN Null;
 2687    END;
 2688    iH.ID := F;
 2689    iH.In := I;
 2690    OpenIx(iH,CmpFct,KeSize,DpKey,New);
 2691    IF iH#Null THEN
 2692      WITH iH.ID^.Id[I] DO
 2693        IF (KeFct#NULLPROC) AND (D#Null) THEN
 2694          KeyFct := KeFct;
 2695          NextIndx := D.ID^.Id[D.In].NextIndx;
 2696          D.ID^.Id[D.In].NextIndx := iH;
 2697          DataPtr := D;
 2698        END;
 2699      END;
 2700    END;
 2701    RETURN iH;
 2702  END OpenIndex;
 2703  
 2704  
 2705  PROCEDURE OpenData(F: FHandle; I,RSize: CARDINAL; New: BOOLEAN): IHandle;
 2706  VAR
 2707    dH : IHandle;
 2708  BEGIN
 2709    ClearFErr(F);
 2710    IF NOT IsFHandle(F) THEN
 2711      CallFErr(F,NotFHandle,'OpenData');
 2712      RETURN Null;
 2713    END;
 2714    IF New AND NOT F^.Buffered THEN
 2715      CallFErr(F,BadOpen,'New with Sharing');
 2716      RETURN Null;
 2717    END;
 2718    IF (F^.fwr^.IndexCount<I) OR ((F^.Id[I].iwr^.Ft#FreeSlot)=New) THEN
 2719      CallFErr(F,NoSlot,'Data');
 2720      RETURN Null;
 2721    END;
 2722    IF (RSize=0) AND (F^.fwr^.Mode=FixSize) THEN
 2723      CallFErr(F,BadOpen,'OpenData');
 2724      RETURN Null;
 2725    END;
 2726    IF New AND F^.ReadOnly THEN
 2727      CallFErr(F,BadOpen,'New with ReadOnly');
 2728    END;
 2729    dH.ID := F;
 2730    dH.In := I;
 2731    WITH dH.ID^.Id[dH.In] DO
 2732      LastDataRef := Nil;
 2733      NextIndx := Null;
 2734      LastErr := OK;
 2735      ErrorNest := 0;
 2736      Sync := FALSE;
 2737      bufSize := RSize;
 2738      IF RSize=0 THEN
 2739        bufPtr := NIL;
 2740      ELSE
 2741        AllocMem(bufPtr,RSize);
 2742        Die(bufPtr=NIL,OutOfMemory);
 2743      END;
 2744      IF New THEN
 2745        iwr^.Ft := DataSlot;
 2746        iwr^.RecordSize := RSize;
 2747        iwr^.RecordCnt := 0;
 2748        UpdateSlot(dH);
 2749      ELSE
 2750        IF iwr^.Ft # DataSlot THEN
 2751          CallFErr(F,NotData,'OpenData');
 2752          RETURN Null;
 2753        ELSIF iwr^.RecordSize # RSize THEN
 2754          CallFErr(F,BadSize,'OpenData');
 2755          RETURN Null;
 2756        END;
 2757      END;
 2758      Ft := DataSlot;
 2759    END;
 2760    RETURN dH;
 2761  END OpenData;
 2762  
 2763  
 2764  PROCEDURE FreeIHandle(VAR H: IHandle);
 2765  VAR
 2766    dH : IHandle;
 2767    iH : IHandle;
 2768  BEGIN
 2769    ClearErr(H);
 2770    ClearFErr(H.ID);
 2771    IF NOT IsIHandle(H) THEN
 2772      CallFErr(H.ID,NotIHandle,'FreeIHandle');
 2773      RETURN;
 2774    END;
 2775    IF NOT H.ID^.Buffered AND IsIndex(H) AND (H.ID^.Id[H.In].DataPtr#Null) THEN
 2776      CallErr(H,BadFree,'FreeIHandle');
 2777      RETURN;
 2778    END;
 2779    IF IsData(H) THEN
 2780      dH := H.ID^.Id[H.In].NextIndx;
 2781      WHILE dH # Null DO
 2782        iH := dH;
 2783        FollowNextIndx(dH);
 2784        iH.ID^.Id[iH.In].NextIndx := Null;
 2785        iH.ID^.Id[iH.In].DataPtr := Null;
 2786        FreeIHandle(iH);
 2787      END;
 2788    ELSE
 2789      dH := H.ID^.Id[H.In].DataPtr;
 2790      LOOP
 2791        IF dH.ID=NIL THEN
 2792          EXIT;
 2793        END;
 2794        iH := dH.ID^.Id[dH.In].NextIndx;
 2795        IF iH=H THEN
 2796          dH.ID^.Id[dH.In].NextIndx := iH.ID^.Id[iH.In].NextIndx;
 2797          EXIT;
 2798        END;
 2799        FollowNextIndx(dH);
 2800      END;
 2801    END;
 2802    WITH H.ID^.Id[H.In] DO
 2803      CASE Ft OF
 2804          IndexSlot : FreeMem(PageRefs);
 2805                      SaveBuffers(H);
 2806                      ClearBuffers(H);
 2807        | DataSlot  : FreeMem(bufPtr);
 2808        ELSE
 2809          (* ignore *)
 2810      END;
 2811      Ft := FreeSlot;
 2812      DataPtr := Null;
 2813    END;
 2814    H := Null;
 2815  END FreeIHandle;
 2816  
 2817  
 2818  PROCEDURE ClearIndex(VAR I: IHandle);
 2819  
 2820  VAR
 2821    TP : TPage;
 2822  
 2823  TYPE
 2824    IPtr = POINTER Seg(TP) TO IndexItem;
 2825    A2 = ARRAY[0..1] OF SHORTCARD;
 2826  
 2827  (*# save *)
 2828  (*# call(inline=>on) *)
 2829  (*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
 2830    PROCEDURE AddIPtr(A: IPtr; I: CARDINAL): IPtr=A2(003H,0C1H);(*add ax,cx*)
 2831  (*# restore *)
 2832  
 2833    PROCEDURE Free(Page: LONGCARD; Level: CARDINAL);
 2834    VAR
 2835      i  : CARDINAL;
 2836      IP : IPtr;
 2837    BEGIN
 2838      WITH I.ID^.Id[I.In] DO
 2839        IF Level=iwr^.Depth THEN
 2840          ClearPage(I,Page);
 2841          FreeBlock(I.ID,PageSize,Page);
 2842        ELSE
 2843          i := 0;
 2844          IP := IPtr(Ofs((TP.IItem)));
 2845          LOOP
 2846            ReadPage(I,Page,TP);
 2847            IF i>TP.ICount THEN
 2848              EXIT;
 2849            END;
 2850            Free(IP^.IP,Level+1);
 2851            INC(i);
 2852            IncAddr(IP,8+iwr^.KeySize);
 2853          END;
 2854          ClearPage(I,Page);
 2855          FreeBlock(I.ID,PageSize,Page);
 2856        END;
 2857      END;
 2858    END Free;
 2859  
 2860  BEGIN
 2861    ClearErr(I);
 2862    ClearFErr(I.ID);
 2863    IF NOT IsIndex(I) THEN
 2864      CallErr(I,NotIndex,'ClearIndex');
 2865      RETURN;
 2866    END;
 2867    IF NOT I.ID^.Buffered THEN
 2868      CallErr(I,BadFree,'ClearIndex');
 2869      RETURN;
 2870    END;
 2871    IF I.ID^.ReadOnly THEN
 2872      CallErr(I,BadWrite,'ClearIndex with ReadOnly');
 2873    END;
 2874    Free(I.ID^.Id[I.In].iwr^.TopPage,1);
 2875    FreeIHandle(I);
 2876  END ClearIndex;
 2877  
 2878  
 2879  PROCEDURE Close(VAR F: FHandle);
 2880  VAR
 2881    idx : CARDINAL;
 2882    iH  : IHandle;
 2883  BEGIN
 2884    ClearFErr(F);
 2885    IF NOT IsFHandle(F) THEN
 2886      CallFErr(F,NotFHandle,'Close');
 2887      RETURN;
 2888    END;
 2889    iH.ID := F;
 2890    iH.In := MAX(CARDINAL);
 2891    SaveBuffers(iH);
 2892    ClearBuffers(iH);
 2893    Flush(F);
 2894    iH.In := 0;
 2895    WITH F^ DO
 2896      IF NOT Buffered THEN
 2897        FOR idx := 0 TO LockQSize-1 DO
 2898          IF Locks[idx].Position#Nil THEN
 2899            ccUnLock(iH,Locks[idx],AllLocks);
 2900          END;
 2901        END;
 2902      END;
 2903      FOR idx := 0 TO F^.fwr^.IndexCount DO
 2904        WITH Id[idx] DO
 2905          IF NOT Buffered AND ((ihLock.ICnt#0) OR (ihLock.ECnt#0)) THEN
 2906            ccUnLock(iH,ihLock,AllLocks);
 2907          END;
 2908          CASE Ft OF
 2909              IndexSlot : FreeMem(PageRefs);
 2910            | DataSlot  : FreeMem(bufPtr);
 2911            ELSE
 2912              (* ignore *)
 2913          END;
 2914        END;
 2915      END;
 2916      IF NOT Buffered AND ((fhLock.ICnt#0) OR (fhLock.ECnt#0)) THEN
 2917        ccUnLock(iH,fhLock,AllLocks);
 2918      END;
 2919      FIOx.Close(FHandle);
 2920    END;
 2921    F^.G1 := 0;
 2922    F^.G2 := 0;
 2923    FreeMem(F);
 2924  END Close;
 2925  
 2926  
 2927  PROCEDURE Allocate(F: FHandle; Length: LONGCARD): LONGCARD;
 2928  VAR
 2929    Pos : LONGCARD;
 2930    iH  : IHandle;
 2931    ok  : BOOLEAN;
 2932  BEGIN
 2933    ClearFErr(F);
 2934    IF NOT IsFHandle(F) THEN
 2935      CallFErr(F,NotFHandle,'Allocate');
 2936      RETURN MAX(LONGCARD);
 2937    END;
 2938    IF F^.ReadOnly THEN
 2939      CallFErr(F,BadWrite,'Allocate with ReadOnly');
 2940      RETURN MAX(LONGCARD);
 2941    END;
 2942    IF LockFile(F) THEN
 2943      Pos := AllocateBlock(F,Length+4);
 2944      IF Pos=Nil THEN
 2945        CallFErr(F,FileError,'Allocate');
 2946        RETURN Nil;
 2947      END;
 2948      FIOx.Seek(F^.FHandle,Pos);
 2949      IOabort('Allocate');
 2950      FIOx.Write(F^.FHandle,Length+4,4);
 2951      IOabort('Allocate');
 2952      iH.ID := F;
 2953      iH.In := 0;
 2954      ok := cLock(iH,Pos+4,Explicit);
 2955      UnLockFile(F);
 2956      RETURN Pos+4;
 2957    ELSE
 2958      RETURN MAX(LONGCARD);
 2959    END;
 2960  END Allocate;
 2961  
 2962  
 2963  PROCEDURE DeAllocate(F: FHandle; Position: LONGCARD);
 2964  VAR
 2965    Len : LONGCARD;
 2966    r   : CARDINAL;
 2967    iH  : IHandle;
 2968  BEGIN
 2969    ClearFErr(F);
 2970    IF NOT IsFHandle(F) THEN
 2971      CallFErr(F,NotFHandle,'DeAllocate');
 2972      RETURN;
 2973    END;
 2974    IF F^.ReadOnly THEN
 2975      CallFErr(F,BadWrite,'DeAllocate with ReadOnly');
 2976      RETURN;
 2977    END;
 2978    iH.ID := F;
 2979    iH.In := 0;
 2980    IF NOT cLocked(iH,Position) THEN
 2981      CallFErr(F,NotLocked,'Write');
 2982    END;
 2983    SetFErr(F,OK);
 2984    IF LockFile(F) THEN
 2985      FIOx.Seek(F^.FHandle,Position-4);
 2986      IOabort('DeAllocate');
 2987      FIOx.Read(F^.FHandle,Len,4);
 2988      IOabort('DeAllocate');
 2989      FreeBlock(F,Len,Position-4);
 2990      cUnLock(iH,Position,AllLocks);
 2991      UnLockFile(F);
 2992    END;
 2993  END DeAllocate;
 2994  
 2995  
 2996  PROCEDURE Read(F: FHandle; Position: LONGCARD; Length: CARDINAL;
 2997                 VAR Data: ARRAY OF BYTE);
 2998  VAR
 2999    iH : IHandle;
 3000  BEGIN
 3001    ClearFErr(F);
 3002    IF NOT IsFHandle(F) THEN
 3003      CallFErr(F,NotFHandle,'Read');
 3004      RETURN;
 3005    END;
 3006    iH.ID := F;
 3007    iH.In := 0;
 3008    IF NOT cLocked(iH,Position) THEN
 3009      CallFErr(F,NotLocked,'Read');
 3010    END;
 3011    SetFErr(F,OK);
 3012    FIOx.Seek(F^.FHandle,Position);
 3013    IOabort('Read');
 3014    FIOx.Read(F^.FHandle,Data,Length);
 3015    IOabort('Read');
 3016  END Read;
 3017  
 3018  
 3019  PROCEDURE Write(F: FHandle; Position: LONGCARD; Length: CARDINAL;
 3020                  Data: ARRAY OF BYTE);
 3021  VAR
 3022    iH : IHandle;
 3023  BEGIN
 3024    ClearFErr(F);
 3025    IF NOT IsFHandle(F) THEN
 3026      CallFErr(F,NotFHandle,'Write');
 3027      RETURN;
 3028    END;
 3029    IF F^.ReadOnly THEN
 3030      CallFErr(F,BadWrite,'Write with ReadOnly');
 3031      RETURN;
 3032    END;
 3033    iH.ID := F;
 3034    iH.In := 0;
 3035    IF NOT cLocked(iH,Position) THEN
 3036      CallFErr(F,NotLocked,'Write');
 3037    END;
 3038    FIOx.Seek(F^.FHandle,Position);
 3039    IOabort('Write');
 3040    FIOx.Write(F^.FHandle,Data,Length);
 3041    IOabort('Write');
 3042  END Write;
 3043  
 3044  
 3045  PROCEDURE Flush(F: FHandle);
 3046  VAR
 3047    idx : CARDINAL;
 3048    iH : IHandle;
 3049  BEGIN
 3050    ClearFErr(F);
 3051    IF NOT IsFHandle(F) THEN
 3052      CallFErr(F,NotFHandle,'Flush');
 3053      RETURN;
 3054    END;
 3055    iH.ID := F;
 3056    IF F^.Buffered THEN
 3057      FOR idx := 0 TO F^.fwr^.IndexCount DO
 3058        iH.In := idx;
 3059        FlushIHandle(iH);
 3060      END;
 3061      FlushFHandle(F);
 3062    ELSE
 3063      FOR idx := 0 TO F^.fwr^.IndexCount DO
 3064        WITH F^.Id[idx] DO
 3065          IF (Ft#FreeSlot) AND ((ihLock.ECnt#0) OR (ihLock.ICnt#0)) THEN
 3066            iH.In := idx;
 3067            FlushIHandle(iH);
 3068          END;
 3069        END;
 3070      END;
 3071      IF (F^.fhLock.ECnt#0) OR (F^.fhLock.ICnt#0) THEN
 3072        FlushFHandle(F);
 3073      END;
 3074    END;
 3075    FIOx.Flush(F^.FHandle);
 3076  END Flush;
 3077  
 3078  
 3079  PROCEDURE AddIndex(I: IHandle; Key: ARRAY OF BYTE; DataLoc: LONGCARD);
 3080  
 3081  VAR
 3082    TP       : xTPage;
 3083  
 3084  TYPE
 3085    IPtr = POINTER Seg(TP) TO IndexItem;
 3086    A2 = ARRAY[0..1] OF SHORTCARD;
 3087  
 3088  (*# save *)
 3089  (*# call(inline=>on) *)
 3090  (*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
 3091    PROCEDURE AddIPtr(A: IPtr; I: CARDINAL): IPtr=A2(003H,0C1H);(*add ax,cx*)
 3092  (*# restore *)
 3093  
 3094  VAR
 3095    InsKey   : IndexItem;
 3096    C        : CmpRes;
 3097    r,
 3098    Level    : CARDINAL;
 3099    b        : BOOLEAN;
 3100    ItemSize : CARDINAL;
 3101    Index    : CARDINAL;
 3102    Page,
 3103    PageTmp  : LONGCARD;
 3104    IP,
 3105    NP,
 3106    XP       : IPtr;
 3107  
 3108  BEGIN
 3109    ClearErr(I);
 3110    IF NOT IsIndex(I) THEN
 3111      CallErr(I,NotIndex,'AddIndex');
 3112      RETURN;
 3113    END;
 3114    IF I.ID^.ReadOnly THEN
 3115      CallErr(I,BadWrite,'AddIndex with ReadOnly');
 3116      RETURN;
 3117    END;
 3118    IF LockFile(I.ID) THEN
 3119      IF cLockIHandle(I,Implicit) THEN
 3120        WITH I.ID^.Id[I.In] DO
 3121          ItemSize := 8+iwr^.KeySize;
 3122          InsKey.IP := Nil;
 3123          InsKey.DP := DataLoc;
 3124          MemFastMove(ADR(Key),ADR(InsKey.Key),iwr^.KeySize);
 3125          b := FindIx(I,InsKey.Key,DataLoc,Ins);
 3126          IF LastError(I)=OK THEN
 3127            Level := PageLevel;
 3128            Index := PageRefs^.Refs[Level].Rec;
 3129            Page  := PageRefs^.Refs[Level].Page;
 3130            ReadPage(I,Page,TPage(TP));
 3131            IF TP.ICount=iwr^.N2 THEN
 3132              FIOx.Truncate(I.ID^.FHandle,I.ID^.fwr^.FileSize+VAL(LONGCARD,PageRefs^.Refs[PageLevel].Cnt)*PageSize);
 3133              IF FIOx.Error()#FIOx.NO_ERROR THEN
 3134                FIOx.Truncate(I.ID^.FHandle,I.ID^.fwr^.FileSize);
 3135                IOabort('AddIndex');
 3136                cUnLockIHandle(I,Implicit);
 3137                UnLockFile(I.ID);
 3138                CallErr(I,FileError,'AddIndex');
 3139                RETURN;
 3140              END;
 3141              IOabort('AddIndex');
 3142            END;
 3143            LOOP
 3144              IP := AddIPtr(IPtr(Ofs((TP.IItem))),Index*ItemSize);
 3145              XP := AddIPtr(IP,ItemSize);
 3146              INC(TP.ICount);
 3147              MemMove(ADR(IP^),ADR(XP^),ItemSize*(TP.ICount-(Index+1))+4);
 3148              MemFastMove(ADR(InsKey),ADR(IP^),ItemSize);
 3149              IF TP.ICount<=iwr^.N2 THEN
 3150                EXIT;
 3151              ELSE
 3152                NP := AddIPtr(IPtr(Ofs((TP.IItem))),ItemSize*iwr^.N22);
 3153                MemFastMove(ADR(NP^),ADR(InsKey),ItemSize);
 3154                TP.ICount := iwr^.N22;
 3155                IncAddr(NP,ItemSize);
 3156                IF I.In=0 THEN
 3157                  InsKey.IP := AllocateFreeBlock(I.ID);
 3158                ELSE
 3159                  InsKey.IP := AllocateBlock(I.ID,PageSize);
 3160                END;
 3161                WritePage(I,InsKey.IP,TPage(TP));
 3162                MemFastMove(ADR(NP^),ADR(TP.IItem),ItemSize*iwr^.N22+4);
 3163                WritePage(I,Page,TPage(TP));
 3164                DEC(Level);
 3165                IF Level=0 THEN
 3166                  TP.ICount := 1;
 3167                  MemFastMove(ADR(InsKey),ADR(TP.IItem),ItemSize);
 3168                  IP := AddIPtr(IPtr(Ofs((TP.IItem))),ItemSize);
 3169                  IP^.IP := iwr^.TopPage;
 3170                  IF I.In=0 THEN
 3171                    iwr^.TopPage := AllocateFreeBlock(I.ID);
 3172                  ELSE
 3173                    iwr^.TopPage := AllocateBlock(I.ID,PageSize);
 3174                  END;
 3175                  Page := iwr^.TopPage;
 3176                  INC(iwr^.Depth);
 3177                  IF iwr^.Depth>PageRefs^.Height THEN
 3178                    FreeMem(PageRefs);
 3179                    r := iwr^.Depth+1;
 3180                    AllocMem(PageRefs,VSIZE(PageRef.Height)+r*SIZE(PageRefRec));
 3181                    Die(PageRefs=NIL,OutOfMemory);
 3182                    PageRefs^.Height := r;
 3183                  END;
 3184                  EXIT;
 3185                END;
 3186              END;
 3187              Index := PageRefs^.Refs[Level].Rec;
 3188              Page  := PageRefs^.Refs[Level].Page;
 3189              ReadPage(I,Page,TPage(TP));
 3190            END;
 3191            WritePage(I,Page,TPage(TP));
 3192            PageLevel := 0;
 3193          END;
 3194          IF LastError(I)=OK THEN
 3195            INC(iwr^.RecordCnt);
 3196          END;
 3197        END;
 3198        cUnLockIHandle(I,Implicit);
 3199      END;
 3200      FIOx.Truncate(I.ID^.FHandle,I.ID^.fwr^.FileSize);
 3201      UnLockFile(I.ID);
 3202    ELSE
 3203      SetErr(I,Locked);
 3204    END;
 3205  END AddIndex;
 3206  
 3207  
 3208  PROCEDURE DeleteIndex(I: IHandle; Key: ARRAY OF BYTE; DataLoc: LONGCARD);
 3209  
 3210  VAR
 3211    TP : TPage;
 3212  
 3213  TYPE
 3214    IPtr = POINTER Seg(TP) TO IndexItem;
 3215    A2 = ARRAY[0..1] OF SHORTCARD;
 3216  
 3217  (*# save *)
 3218  (*# call(inline=>on) *)
 3219  (*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
 3220    PROCEDURE AddIPtr(A: IPtr; I: CARDINAL): IPtr=A2(003H,0C1H);(*add ax,cx*)
 3221  (*# restore *)
 3222  
 3223  VAR
 3224    QP,
 3225    RP       : TPage;
 3226    DelKey   : IndexItem;
 3227    Level    : CARDINAL;
 3228    ItemSize : CARDINAL;
 3229    Page,
 3230    RPage    : LONGCARD;
 3231    IP,
 3232    JP,
 3233    NP       : IPtr;
 3234  
 3235  (* 07/23/90 DWD - This procedure has not yet been optimized
 3236                    by using MemFastMove() *)
 3237  BEGIN
 3238    ClearErr(I);
 3239    IF NOT IsIndex(I) THEN
 3240      CallErr(I,NotIndex,'DeleteIndex');
 3241      RETURN;
 3242    END;
 3243    IF I.ID^.ReadOnly THEN
 3244      CallErr(I,BadWrite,'DeleteIndex with ReadOnly');
 3245      RETURN;
 3246    END;
 3247    IF LockFile(I.ID) THEN
 3248      IF cLockIHandle(I,Implicit) THEN
 3249        WITH I.ID^.Id[I.In] DO
 3250          LOOP
 3251            ItemSize := 8+iwr^.KeySize;
 3252            DelKey.DP := DataLoc;
 3253            MemFastMove(ADR(Key),ADR(DelKey.Key),iwr^.KeySize);
 3254            IF NOT FindIx(I,DelKey.Key,DataLoc,Idx) THEN
 3255              CallErr(I,BadIndex,'DelIndex');
 3256              EXIT;
 3257            END;
 3258            Level := PageLevel;
 3259            Page := PageRefs^.Refs[PageLevel].Page;
 3260            ReadPage(I,Page,TP);
 3261            IP := AddIPtr(IPtr(Ofs((TP.IItem))),ItemSize*PageRefs^.Refs[PageLevel].Rec);
 3262            IF PageLevel#iwr^.Depth THEN
 3263              INC(Level);
 3264              NP := IP;
 3265              IncAddr(NP,ItemSize);
 3266              INC(PageRefs^.Refs[PageLevel].Rec);
 3267              Page := NP^.IP;
 3268              LOOP
 3269                ReadPage(I,Page,QP);
 3270                PageRefs^.Refs[Level].Rec := 0;
 3271                PageRefs^.Refs[Level].Page := Page;
 3272                IF Level=iwr^.Depth THEN
 3273                  EXIT;
 3274                END;
 3275                Page := QP.IItem.IP;
 3276                INC(Level);
 3277              END;
 3278              MemFastMove(ADR(QP.IItem.DP),ADR(IP^.DP),iwr^.KeySize+4);
 3279              WritePage(I,PageRefs^.Refs[PageLevel].Page,TP);
 3280              TP:=QP;
 3281              PageLevel := iwr^.Depth;
 3282              IP := AddIPtr(IPtr(Ofs((TP.IItem))),ItemSize*PageRefs^.Refs[PageLevel].Rec)
 3283            END;
 3284            NP := IP;
 3285            IncAddr(NP,ItemSize);
 3286            DEC(TP.ICount);
 3287            MemFastMove(ADR(NP^),ADR(IP^),ItemSize*(TP.ICount-PageRefs^.Refs[PageLevel].Rec));
 3288            WHILE (TP.ICount<iwr^.N22) AND (PageLevel#1) DO
 3289              IF PageRefs^.Refs[PageLevel-1].Rec=0 THEN
 3290                (* Has got a right sibling *)
 3291                ReadPage(I,PageRefs^.Refs[PageLevel-1].Page,QP);
 3292                IP := AddIPtr(IPtr(Ofs((TP.IItem))),ItemSize*TP.ICount);
 3293                JP := AddIPtr(IPtr(Ofs((QP.IItem))),ItemSize*(PageRefs^.Refs[PageLevel-1].Rec+1));
 3294                RPage :=  JP^.IP;
 3295                DecAddr(JP,ItemSize);
 3296                ReadPage(I,RPage,RP);
 3297                MemFastMove(ADR(JP^.DP),ADR(IP^.DP),iwr^.KeySize+4);
 3298                INC(TP.ICount);
 3299                IF RP.ICount>iwr^.N22 THEN
 3300                  IncAddr(IP,ItemSize);
 3301                  IP^.IP := RP.IItem.IP;
 3302                  MemFastMove(ADR(RP.IItem.DP),ADR(JP^.DP),iwr^.KeySize+4);
 3303                  DEC(RP.ICount);
 3304                  IP := AddIPtr(IPtr(Ofs((RP.IItem))),ItemSize);
 3305                  MemFastMove(ADR(IP^),ADR(RP.IItem),ItemSize*RP.ICount+4);
 3306                  WritePage(I,RPage,RP);
 3307                  WritePage(I,PageRefs^.Refs[PageLevel].Page,TP);
 3308                  WritePage(I,PageRefs^.Refs[PageLevel-1].Page,QP);
 3309                  PageLevel :=0;
 3310                  EXIT;
 3311                END;
 3312                IncAddr(IP,ItemSize);
 3313                MemFastMove(ADR(RP.IItem),ADR(IP^),ItemSize*iwr^.N22+4);
 3314                TP.ICount := iwr^.N2;
 3315                IP := JP;
 3316                IncAddr(IP,ItemSize);
 3317                DEC(QP.ICount);
 3318                MemFastMove(ADR(IP^.DP),ADR(JP^.DP),ItemSize*(QP.ICount-PageRefs^.Refs[PageLevel-1].Rec));
 3319                WritePage(I,PageRefs^.Refs[PageLevel].Page,TP);
 3320                ClearPage(I,RPage);
 3321                IF I.In=0 THEN
 3322                  FreeFreeBlock(I.ID,RPage);
 3323                ELSE
 3324                  FreeBlock(I.ID,PageSize,RPage);
 3325                END;
 3326                DEC(PageLevel);
 3327                TP := QP;
 3328              ELSE
 3329                (* Has got a left sibling *)
 3330                ReadPage(I,PageRefs^.Refs[PageLevel-1].Page,QP);
 3331                IP := AddIPtr(IPtr(Ofs((TP.IItem))),ItemSize);
 3332                MemMove(ADR(TP.IItem),ADR(IP^),ItemSize*TP.ICount+4);
 3333                JP := AddIPtr(IPtr(Ofs((QP.IItem))),ItemSize*(PageRefs^.Refs[PageLevel-1].Rec-1));
 3334                RPage :=  JP^.IP;
 3335                ReadPage(I,RPage,RP);
 3336                MemFastMove(ADR(JP^.DP),ADR(TP.IItem.DP),iwr^.KeySize+4);
 3337                INC(TP.ICount);
 3338                IF RP.ICount>iwr^.N22 THEN
 3339                  NP := AddIPtr(IPtr(Ofs((RP.IItem))),ItemSize*RP.ICount);
 3340                  TP.IItem.IP:= NP^.IP;
 3341                  DecAddr(NP,ItemSize);
 3342                  MemFastMove(ADR(NP^.DP),ADR(JP^.DP),iwr^.KeySize+4);
 3343                  DEC(RP.ICount);
 3344                  WritePage(I,RPage,RP);
 3345                  WritePage(I,PageRefs^.Refs[PageLevel].Page,TP);
 3346                  WritePage(I,PageRefs^.Refs[PageLevel-1].Page,QP);
 3347                  PageLevel := 0;
 3348                  EXIT;
 3349                END;
 3350                IP := AddIPtr(IPtr(Ofs((TP.IItem))),ItemSize*iwr^.N22);
 3351                MemFastMove(ADR(TP.IItem.DP),ADR(IP^.DP),ItemSize*iwr^.N22);
 3352                MemFastMove(ADR(RP.IItem),ADR(TP.IItem),ItemSize*iwr^.N22+4);
 3353                TP.ICount := iwr^.N2;
 3354                IP := JP;
 3355                IncAddr(IP,ItemSize);
 3356                MemFastMove(ADR(IP^),ADR(JP^),ItemSize*(QP.ICount-PageRefs^.Refs[PageLevel-1].Rec)+4);
 3357                DEC(QP.ICount);
 3358                WritePage(I,PageRefs^.Refs[PageLevel].Page,TP);
 3359                ClearPage(I,RPage);
 3360                IF I.In=0 THEN
 3361                  FreeFreeBlock(I.ID,RPage);
 3362                ELSE
 3363                  FreeBlock(I.ID,PageSize,RPage);
 3364                END;
 3365                DEC(PageLevel);
 3366                TP := QP;
 3367              END;
 3368            END;
 3369            IF (TP.ICount=0) AND (iwr^.Depth>1) THEN
 3370              DEC(iwr^.Depth);
 3371              iwr^.TopPage := TP.IItem.IP;
 3372            ELSE
 3373              WritePage(I,PageRefs^.Refs[PageLevel].Page,TP);
 3374            END;
 3375            PageLevel :=0;
 3376            EXIT;
 3377          END;
 3378          IF LastError(I)=OK THEN
 3379            DEC(iwr^.RecordCnt);
 3380          END;
 3381        END;
 3382        cUnLockIHandle(I,Implicit);
 3383      END;
 3384      UnLockFile(I.ID);
 3385    ELSE
 3386      SetErr(I,Locked);
 3387    END;
 3388  END DeleteIndex;
 3389  
 3390  
 3391  PROCEDURE FindIndex(I: IHandle; Key: ARRAY OF BYTE;
 3392                      VAR DataLoc: LONGCARD): BOOLEAN;
 3393  VAR
 3394    res : BOOLEAN;
 3395  BEGIN
 3396    ClearErr(I);
 3397    IF NOT IsIndex(I) THEN
 3398      CallErr(I,NotIndex,'FindIndex');
 3399      RETURN FALSE;
 3400    END;
 3401    Release(I);
 3402    IF cLockIHandle(I,Implicit) THEN
 3403      IF FindIx(I,Key,Nil,Fnd) THEN
 3404        DataLoc := I.ID^.Id[I.In].LastDataRef;
 3405        res := TRUE;
 3406      ELSE
 3407        res := FALSE;
 3408      END;
 3409      I.ID^.Id[I.In].LastKeyOK := FALSE;
 3410      cUnLockIHandle(I,Implicit);
 3411      RETURN res;
 3412    ELSE
 3413      RETURN FALSE;
 3414    END;
 3415  END FindIndex;
 3416  
 3417  
 3418  PROCEDURE SearchIndex(I: IHandle; Key: ARRAY OF BYTE;
 3419                        VAR DataLoc: LONGCARD): BOOLEAN;
 3420  VAR
 3421    res : BOOLEAN;
 3422  BEGIN
 3423    ClearErr(I);
 3424    IF NOT IsIndex(I) THEN
 3425      CallErr(I,NotIndex,'SearchIndex');
 3426      RETURN FALSE;
 3427    END;
 3428    Release(I);
 3429    IF cLockIHandle(I,Implicit) THEN
 3430      IF FindIx(I,Key,Nil,Src) THEN
 3431        DataLoc := I.ID^.Id[I.In].LastDataRef;
 3432        res := TRUE;
 3433      ELSE
 3434        res := FALSE;
 3435      END;
 3436      I.ID^.Id[I.In].LastKeyOK := FALSE;
 3437      cUnLockIHandle(I,Implicit);
 3438      RETURN res;
 3439    ELSE
 3440      RETURN FALSE;
 3441    END;
 3442  END SearchIndex;
 3443  
 3444  
 3445  PROCEDURE Recover(iH: IHandle) : BOOLEAN;
 3446  BEGIN
 3447    WITH iH.ID^ DO
 3448      WITH Id[iH.In] DO
 3449        IF (PageLevel=0) AND LastKeyOK THEN
 3450          RETURN FindIx(iH,LastKey,LastKeyRef,Rec);
 3451        ELSIF PageLevel#0 THEN
 3452          SetLastKey(iH);
 3453        END;
 3454      END;
 3455    END;
 3456    RETURN TRUE;
 3457  END Recover;
 3458  
 3459  
 3460  PROCEDURE NextIndex(I: IHandle; VAR DataLoc: LONGCARD): BOOLEAN;
 3461  VAR
 3462    res : BOOLEAN;
 3463  BEGIN
 3464    ClearErr(I);
 3465    IF NOT IsIndex(I) THEN
 3466      CallErr(I,NotIndex,'NextIndex');
 3467      RETURN FALSE;
 3468    END;
 3469    Release(I);
 3470    IF cLockIHandle(I,Implicit) THEN
 3471      WITH I.ID^.Id[I.In] DO
 3472        IF Recover(I) THEN
 3473          WalkIx(I,Forward);
 3474        END;
 3475        res := PageLevel#0;
 3476        cUnLockIHandle(I,Implicit);
 3477        IF res THEN
 3478          DataLoc := LastDataRef;
 3479        END;
 3480        RETURN res;
 3481      END;
 3482    ELSE
 3483      RETURN FALSE;
 3484    END;
 3485  END NextIndex;
 3486  
 3487  
 3488  PROCEDURE PrevIndex(I: IHandle; VAR DataLoc: LONGCARD): BOOLEAN;
 3489  VAR
 3490    res : BOOLEAN;
 3491  BEGIN
 3492    ClearErr(I);
 3493    IF NOT IsIndex(I) THEN
 3494      CallErr(I,NotIndex,'PrevIndex');
 3495      RETURN FALSE;
 3496    END;
 3497    Release(I);
 3498    IF cLockIHandle(I,Implicit) THEN
 3499      res := Recover(I);
 3500      WITH I.ID^.Id[I.In] DO
 3501        WalkIx(I,Backward);
 3502        res := PageLevel#0;
 3503        cUnLockIHandle(I,Implicit);
 3504        IF res THEN
 3505          DataLoc := LastDataRef;
 3506        END;
 3507        RETURN res;
 3508      END;
 3509    ELSE
 3510      RETURN FALSE;
 3511    END;
 3512  END PrevIndex;
 3513  
 3514  
 3515  PROCEDURE SetSyncMode(D: IHandle; On: BOOLEAN);
 3516  BEGIN
 3517    ClearErr(D);
 3518    IF NOT IsData(D) THEN
 3519      CallErr(D,NotData,'SetSyncMode');
 3520      RETURN;
 3521    END;
 3522    D.ID^.Id[D.In].Sync := On;
 3523    Reset(D);
 3524  END SetSyncMode;
 3525  
 3526  
 3527  PROCEDURE LastError(H: IHandle): Errors;
 3528  BEGIN
 3529    IF NOT IsFHandle(H.ID) THEN
 3530      RETURN NotFHandle;
 3531    ELSIF NOT IsIHandle(H) THEN
 3532      RETURN NotIHandle;
 3533    ELSE
 3534      RETURN H.ID^.Id[H.In].LastErr;
 3535    END;
 3536  END LastError;
 3537  
 3538  
 3539  PROCEDURE LastFError(F: FHandle): Errors;
 3540  VAR
 3541    iH : IHandle;
 3542  BEGIN
 3543    iH.ID := F;
 3544    iH.In := 0;
 3545    RETURN LastError(iH);
 3546  END LastFError;
 3547  
 3548  
 3549  PROCEDURE LastRef(I : IHandle) : LONGCARD;
 3550  BEGIN
 3551    IF NOT IsIHandle(I) THEN
 3552      CallErr(I,NotIHandle,'LastRef');
 3553      RETURN Nil;
 3554    END;
 3555    RETURN I.ID^.Id[I.In].LastDataRef;
 3556  END LastRef;
 3557  
 3558  
 3559  PROCEDURE RecordCount(I: IHandle): LONGCARD;
 3560  BEGIN
 3561    ClearErr(I);
 3562    IF NOT IsIHandle(I) THEN
 3563      CallErr(I,NotIHandle,'RecordCount');
 3564      RETURN Nil;
 3565    END;
 3566    WITH I.ID^.Id[I.In] DO
 3567      IF NOT I.ID^.Buffered AND (ihLock.ICnt=0) AND (ihLock.ECnt=0) THEN
 3568        CallErr(I,NotLocked,'RecordCount');
 3569        RETURN Nil;
 3570      END;
 3571      RETURN iwr^.RecordCnt;
 3572    END;
 3573  END RecordCount;
 3574  
 3575  
 3576  (*# save *)
 3577  (*%T _fcall *) (*# call(near_call=>off) *) (*%E *)
 3578  (*# call(o_a_size=>on) *)
 3579  PROCEDURE Err(err: Errors; str: ARRAY OF CHAR);
 3580  VAR s : ARRAY[0..79] OF CHAR;
 3581  BEGIN
 3582    Str.Concat(s,CHR(13)+CHR(10),str);
 3583    Lib.FatalError(s);
 3584  END Err;
 3585  (*# restore *)
 3586  
 3587  
 3588    MODULE NoPack;
 3589  
 3590    IMPORT MemFastMove;
 3591  
 3592    EXPORT QUALIFIED Packer, Unpacker, UnpackedSize, Packing, AdjustBlock;
 3593  
 3594    PROCEDURE Packer(n: CARDINAL; in: ADDRESS; out: ADDRESS): CARDINAL;
 3595    BEGIN
 3596      MemFastMove(in,out,n);
 3597      RETURN n;
 3598    END Packer;
 3599  
 3600    PROCEDURE Unpacker(n: CARDINAL; in: ADDRESS; out: ADDRESS);
 3601    BEGIN
 3602      MemFastMove(in,out,n);
 3603    END Unpacker;
 3604  
 3605    PROCEDURE UnpackedSize(n: CARDINAL; in: ADDRESS): CARDINAL;
 3606    BEGIN
 3607      RETURN n;
 3608    END UnpackedSize;
 3609  
 3610    PROCEDURE Packing(): BOOLEAN;
 3611    BEGIN
 3612      RETURN FALSE;
 3613    END Packing;
 3614  
 3615    PROCEDURE AdjustBlock(rs: CARDINAL): CARDINAL;
 3616    BEGIN
 3617      RETURN rs;
 3618    END AdjustBlock;
 3619  
 3620    END NoPack;
 3621  
 3622  
 3623  BEGIN
 3624    ErrorHandler := Err;
 3625    Packer := NoPack.Packer;
 3626    Unpacker := NoPack.Unpacker;
 3627    UnpackedSize := NoPack.UnpackedSize;
 3628    Packing := NoPack.Packing;
 3629    AdjustBlock := NoPack.AdjustBlock;
 3630  END Btree.

   19 errors