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 bufSizeon) *) 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^.Heighton) *) 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+10; 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= 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^.DPoff) *) 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 LenLONGCARD(fwr^.HeaderSize)) AND (PLen0) AND (Len0 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 (LenLONGCARD(fwr^.HeaderSize)) AND (PLen4= 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^.IndexCounton) *) 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.ICountiwr^.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