examples/database/test19.log

   1 program test19;\r
   2 (*                                                     19 lipiec 1988\r
   3  \r
   4       ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»\r
   5       º       m o d u l  o b s l u g i     º\r
   6       º            r e l a c j i           º\r
   7       º                                    º\r
   8       ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼\r
   9  \r
  10   zadaniem modulu jest zrealizowanie systemu wspolpracy z\r
  11  relacjami i krotkami: modul opisuje te pojecia i definiuje\r
  12  operacje na nich: insert, delete, make etc.*)\r
  13  \r
  14  \r
  15    (***************************************************)\r
  16    (*                                                 *)\r
  17    (*        Assumptions on file system               *)\r
  18    (*                                                 *)\r
  19    (* The module handling relations assumes a file    *)\r
  20    (* system of random access files. The signature    *)\r
  21    (* of file system consists of four sorts:          *)\r
  22    (*  P - files,                                     *)\r
  23    (*  R - records,                                   *)\r
  24    (*  S - file's names,                              *)\r
  25    (*  N - nonnegative integers                       *)\r
  26    (* and several operations and predicates,          *)\r
  27    (*   makefile : S x N -> P                         *)\r
  28    (*   openfile : S x N -> P                         *)\r
  29    (*   closefile : P -> P                            *)\r
  30    (*   isopen?  : P -> B0                            *)\r
  31    (*   frewind   : P -> P                            *)\r
  32    (*   feof      : P -> B0                           *)\r
  33    (*   fput      : P x R -> P                        *)\r
  34    (*   fget      : P -> R                            *)\r
  35    (*   fseek     : P x N -> P                        *)\r
  36    (*   position : P -> N                             *)\r
  37    (*   filelen  : P -> N                             *)\r
  38    (*                                                 *)\r
  39    (* which satisfy  the following properties         *)\r
  40    (*                                                 *)\r
  41    (* isopen?(makefile(s,n))                          *)\r
  42    (* position(makefile(s,n)) = 1                     *)\r
  43    (* feof(p) <=> (position(p) = filelen(p))          *)\r
  44    (* ªisopen?(closefile(p))                          *)\r
  45    (* position(frewind(p)) = 1                        *)\r
  46    (* k<filelen(p) => position(fseek(p,k)) = k        *)\r
  47    (*                                                 *)\r
  48    (* isopen?(p) => (p':=fput(p,r))(k:=position(p'))  *)\r
  49    (*  (p":=fseek(p',k-1)) (r':=fget(p")) (r =r')     *)\r
  50    (*                                                 *)\r
  51    (*  isopen?(p) => (p':=frewind(p))                 *)\r
  52    (*   (while ªfeof(p') do  r:= fget(p') od) true    *)\r
  53    (*                                                 *)\r
  54    (*  position(p) ó filelen(p)                       *)\r
  55    (*                                                 *)\r
  56    (*** * * * * * * * * * * * * * * * * * * * * * * ***)\r
  57  \r
  58 unit FileSystem: class;\r
  59   (* system plikow bezposredniego dostepu *)\r
  60  \r
  61  \r
  62   (************************************************************)\r
  63   (*            T Y P Y     D A N Y C H                       *)\r
  64   (************************************************************)\r
  65  \r
  66   unit Rfile: class;\r
  67     (* plik jest ciagiem ponumerowanych rekordow\r
  68        jednakowej dlugosci *)\r
  69  \r
  70        var name: arrayof char (* nazwa zewnetrzna *),\r
  71            opened: boolean (* czy otwarty *),\r
  72            reclen (* dlugosc rekordu - w slowach *),\r
  73                   (* rozmiar slowa odpowiada rozmiarowi\r
  74                      liczby typu integer *)\r
  75            position (* numer biezacego rekordu *),\r
  76            length: integer (* dlugosc pliku -\r
  77                               numer pozycji nastepnej po\r
  78                               ostatniej zajetej *),\r
  79            plik: file (* plik bezposredniego dostepu *),\r
  80            next, prev: Rfile (* wszystkie pliki w systemie\r
  81                                 sa powiazane w liste\r
  82                                 dwukierunkowa *)\r
  83     end Rfile;\r
  84  \r
  85  \r
  86   var system: Rfile; (* dowiazanie do straznika listy plikow *)\r
  87  \r
  88  \r
  89  \r
  90         \r
  91  \r
  92 (******************************************************************)\r
  93 (******************************************************************)\r
  94  \r
  95  \r
  96                         \r
  97   (*****************************************************************)\r
  98   (*          P R O C E D U R Y   I   F U N K C J E                *)\r
  99   (*          S Y S T E M U    P L I K O W                         *)\r
 100   (*****************************************************************)\r
 101  \r
 102  \r
 103  \r
 104                            (******************************)\r
 105                            (*     A U X I L I A R Y      *)\r
 106                            (******************************)\r
 107  \r
 108  \r
 109                                                 \r
 110                            unit FindInSystem: function\r
 111                                 ( name:arrayof char): Rfile ;\r
 112                                 \r
 113                                 unit equalstring: function\r
 114                                      (s1, s2: arrayof char): boolean;\r
 115                                    var i1, i2, len, i: integer;\r
 116                                 begin\r
 117                                  if s1 = none then\r
 118                                  writeln(" 1st parameter in equalstring=none");\r
 119                                  call endrun fi;\r
 120                                  if s2 = none then\r
 121                                  writeln(" 2nd parameter in equalstring=none");\r
 122                                  call endrun fi;\r
 123                                    i1 := lower(s1); i2 := lower(s2);\r
 124                                    len := upper(s1) - i1 + 1;\r
 125                                    if len =/= upper(s2) - i2 + 1\r
 126                                      then return fi;\r
 127                                    for i := 1 to len\r
 128                                     do if s1(i1)  =/= s2(i2)\r
 129                                          then return fi;\r
 130                                        i1 := i1 + 1;\r
 131                                        i2 := i2 + 1;\r
 132                                     od;\r
 133                                    result := true\r
 134                                 end equalstring;\r
 135                                 \r
 136                               var p: Rfile;\r
 137                            begin system.name := name;\r
 138                                  p := system.next;\r
 139                                  while not equalstring( name, p.name )\r
 140                                    do p := p.next od;\r
 141                                  if (p = system) then result := none\r
 142                                                  else result := p fi;\r
 143                           end FindInSystem;\r
 144  \r
 145                          (*********************************)\r
 146                         \r
 147                          unit AddToSystem: function\r
 148                               (name: arrayof char): Rfile;\r
 149                            begin\r
 150                              result := new Rfile;\r
 151                              result.name := name;\r
 152                              result.next := system.next;\r
 153                              result.prev := system;\r
 154                              system.next.prev := result;\r
 155                              system.next := result;\r
 156                            end AddToSystem;\r
 157                         \r
 158                          (*********************************)\r
 159                         \r
 160                          unit DeleteFromSystem: procedure\r
 161                               (p:Rfile);\r
 162                            begin\r
 163                              if p = system then return fi;\r
 164                              p.next.prev := p.prev;\r
 165                              p.prev.next := p.next\r
 166                            end DeleteFromSystem;\r
 167                         \r
 168                           (********************************)\r
 169                         \r
 170                           unit FindFileLength: function\r
 171                                 (p: file, recl:integer): integer;\r
 172                                 \r
 173                          (* odtwarza dlugosc istniejacego pliku,\r
 174                             recl - dlugosc rekord w slowach *)\r
 175                         \r
 176                             var record: arrayof integer, i:integer;\r
 177                             begin\r
 178                               if p = none then\r
 179                                  write(" FS - FindFileLength - ");\r
 180                                  writeln("file object does not exist");\r
 181                                  return;\r
 182                               fi;       \r
 183                               result := 1;\r
 184                               call reset(p);\r
 185                               array record dim (1:recl);\r
 186                               i := recl*intsize;\r
 187                               do\r
 188                                 getrec(p,record,i);\r
 189                                 if i =/= recl*intsize then exit fi;\r
 190                                 result := result + 1;\r
 191                               od;\r
 192                             end FindFileLength;         \r
 193  \r
 194  \r
 195                 \r
 196                 \r
 197  \r
 198                         \r
 199 (*****************************************************************)\r
 200  \r
 201 (*   M A K E F I L E   *)\r
 202                 \r
 203         (* utworzenie i dolaczenie do systemu nowego pliku\r
 204            o zadanej nazwie i dlugosci rekordu *)\r
 205  \r
 206  \r
 207         \r
 208     unit makefile: function\r
 209          ( name: arrayof char (* nazwa zewnetrzna pliku *),\r
 210            reclen: integer (* dlugosc rekordu pliku *) ): Rfile;\r
 211         \r
 212       begin\r
 213         if FindInSystem(name) =/= none\r
 214            (* istnieje w systemie plik o tej nazwie *)\r
 215         then\r
 216            writeln(" FS - makefile - file name duplicated");\r
 217         fi;\r
 218         if reclen <= 0\r
 219         then\r
 220           writeln(" FS - makefile - record length should be possitive");\r
 221         fi;\r
 222         result := AddToSystem(name);                            \r
 223         result.opened := true;\r
 224         result .reclen := reclen;\r
 225         result.position := 1;\r
 226         result.length := 1;\r
 227         open (result.plik, direct, name);\r
 228         call rewrite(result.plik);\r
 229      end makefile;      \r
 230  \r
 231  \r
 232 (***************************************************************)\r
 233  \r
 234 (*   O P E N F I L E    *)\r
 235  \r
 236        (* otwarcie i ewentualne dolaczenie do systemu\r
 237           pliku o zadanej nazwie zewnetrznej i rozmiarze\r
 238           rekordu *)\r
 239  \r
 240  \r
 241  \r
 242    unit openfile: function\r
 243         (name: arrayof char (* nazwa zewnetrzna pliku *),\r
 244          reclen: integer (* dlugosc rekordu pliku *) ): Rfile;\r
 245                                 \r
 246      begin\r
 247        if reclen <= 0\r
 248        then\r
 249          writeln(" FS - openfile - record length should be possitive");\r
 250        fi;\r
 251        result := FindInSystem(name);\r
 252        if result = none then result := AddToSystem(name) fi;\r
 253        result.opened := true;\r
 254        result.reclen := reclen;\r
 255        result.position := 1;\r
 256        open(result.plik, direct, name);\r
 257        result.length := FindFileLength(result.plik,reclen);\r
 258        if result.length = 1 then call rewrite(result.plik)\r
 259           else call reset(result.plik) fi;\r
 260     end openfile;\r
 261  \r
 262  \r
 263 (***************************************************************)\r
 264  \r
 265 (*   C L O S E F I L E    *)\r
 266  \r
 267     (* zamkniecie pliku z usunieciem obiektu pliku ;\r
 268        obiekt typu Rfile pozostaje w systemie z odpowiednia\r
 269        adnotacja *)\r
 270  \r
 271  \r
 272    unit closefile: procedure (p:Rfile);\r
 273      begin\r
 274        if p = none\r
 275        then\r
 276          writeln(" FS - closefile - closing nonexisting file");\r
 277        fi;\r
 278        if not p.opened\r
 279        then\r
 280         writeln(" FS - closefile - closing not opened file");\r
 281        fi;\r
 282        p. opened := false;\r
 283        kill(p.plik)\r
 284     end closefile;\r
 285  \r
 286  \r
 287  \r
 288 (****************************************************************)\r
 289  \r
 290 (*   I S O P E N    *)\r
 291  \r
 292     (* sprawdzenie, czy plik jest otwarty *)\r
 293  \r
 294  \r
 295    unit isopen: function( p:Rfile): boolean;\r
 296      begin\r
 297        if p = none\r
 298        then\r
 299          writeln(" FS - isopen - testing nonexisting file");\r
 300        fi;\r
 301        result := p.opened\r
 302      end isopen;\r
 303  \r
 304  \r
 305 (****************************************************************)\r
 306  \r
 307 (*   F R E W I N D   *)\r
 308  \r
 309       (* przewiniecie pliku do poczatku *)\r
 310  \r
 311  \r
 312    unit frewind: procedure( p:Rfile);\r
 313      begin\r
 314        if p = none\r
 315        then\r
 316         writeln(" FS - frewind - rewinding nonexisting file");\r
 317        fi;\r
 318        if not p.opened\r
 319        then\r
 320           writeln(" FS - frewind - rewinding net opened file");\r
 321        fi;\r
 322        p.position := 1;\r
 323        call reset(p.plik)\r
 324      end frewind;\r
 325  \r
 326  \r
 327 (**************************************************************)\r
 328  \r
 329 (*   F E O F    *)\r
 330  \r
 331      (* test, czy koniec pliku *)\r
 332  \r
 333  \r
 334    unit feof: function(p: Rfile): boolean;\r
 335      begin\r
 336        if p = none\r
 337        then\r
 338           writeln(" FS - feof - testing nonexisting file");\r
 339        fi;\r
 340        if not p.opened\r
 341        then\r
 342          writeln(" FS - feof - testing not opened file");\r
 343        fi;\r
 344        result := ( p.position >= p.length )\r
 345      end feof;\r
 346  \r
 347  \r
 348 (**************************************************************)\r
 349  \r
 350 (*   F P U T   *)\r
 351  \r
 352      (* wlozenie rekordu na plik w miejsce wskazane przez\r
 353         atrybut position *)\r
 354         \r
 355         \r
 356  \r
 357    unit fput: procedure( p: Rfile, Record: arrayof integer);\r
 358  \r
 359      var ile, i : integer;\r
 360      begin\r
 361        if p = none\r
 362        then\r
 363          writeln(" FS - fput - file does not exist"); i:= inchar;\r
 364        fi;\r
 365        if not p.opened\r
 366        then\r
 367          writeln(" FS - fput - file not opened");\r
 368        fi;\r
 369        if p.position > p.length\r
 370        then\r
 371         writeln(" FS - fput - try to access after file length");\r
 372        fi;\r
 373        if Record = none\r
 374        then\r
 375           writeln(" FS - fput - record does not exist");\r
 376        fi;\r
 377        ile := upper(Record) - lower(Record) + 1;\r
 378        if ile =/= p.reclen\r
 379        then\r
 380           writeln(" FS - fput - wrong record length");\r
 381        fi;\r
 382        i := ile * intsize;\r
 383        putrec(p.plik, Record, i);\r
 384        if i =/= ile * intsize\r
 385        then\r
 386          writeln(" FS - fput - error during writing ");\r
 387        fi;\r
 388        p.position := p.position + 1;\r
 389        if p.position > p.length then p.length := p.position fi;\r
 390      end fput;\r
 391  \r
 392  \r
 393 (**************************************************************)\r
 394  \r
 395 (*   F G E T   *)\r
 396  \r
 397     (* odczytanie rekordu z pliku z miejsca wskazywanego\r
 398        przez atrybut position *)\r
 399  \r
 400  \r
 401    unit fget: function( p: Rfile): arrayof integer;\r
 402      var Record: arrayof integer,\r
 403          ile, i : integer;\r
 404       begin\r
 405         if p = none\r
 406         then\r
 407            writeln(" FS - fget - file does not exist ");\r
 408         fi;\r
 409         if not p.opened\r
 410         then\r
 411            writeln(" FS - fget - file not opened");\r
 412         fi;\r
 413         if p.position >= p.length\r
 414         then\r
 415            writeln(" FS - fget - try to read past eof");\r
 416         fi;\r
 417         ile := p.reclen;\r
 418         array Record dim (1:ile);\r
 419         i := ile * intsize;\r
 420         getrec(p.plik, Record, i);\r
 421         if i =/= ile * intsize\r
 422         then\r
 423            writeln(" FS - fget - error during reading");\r
 424         fi;\r
 425         p.position := p.position + 1;\r
 426         result := Record;\r
 427      end fget;\r
 428  \r
 429  \r
 430  \r
 431 (*************************************************************)\r
 432  \r
 433 (*   F S E E K   *)\r
 434  \r
 435        (* wyszukanie w pliku rekordu o zadanym numerze -\r
 436           ustawienie atrybutu position *)\r
 437         \r
 438  \r
 439  \r
 440    unit fseek: procedure( p: Rfile, nrrec: integer);\r
 441  \r
 442      var offset: integer;\r
 443       begin\r
 444         if p = none\r
 445         then\r
 446            writeln(" FS - fseek - file does not exist");\r
 447         fi;\r
 448         if not p.opened\r
 449         then\r
 450           writeln(" FS - fseek - file not opened");\r
 451         fi;\r
 452         if nrrec <= 0\r
 453         then\r
 454          writeln(" FS - fseek - record number should be positive");\r
 455         fi;\r
 456         if nrrec > p.length\r
 457         then\r
 458           writeln(" FS - fseek - try to access after file length");\r
 459         fi;\r
 460         p.position := nrrec;\r
 461         offset := (nrrec - 1) * p.reclen * intsize;\r
 462         call seek(p.plik, offset, 0)\r
 463      end fseek;\r
 464  \r
 465  \r
 466  \r
 467 (************************************************************)\r
 468  \r
 469 (*   P O S I T I O N   *)\r
 470  \r
 471     (* answeres the current position of file pointer *)\r
 472  \r
 473  \r
 474    unit position: function( p: Rfile): integer;\r
 475      begin\r
 476        if p = none\r
 477        then\r
 478          writeln(" FS - position - checking nonexisting file");\r
 479        fi;\r
 480        if not p.opened\r
 481        then\r
 482          writeln(" FS - position - checking not opened file");\r
 483        fi;\r
 484        result := p.position\r
 485      end position;\r
 486  \r
 487  \r
 488 (************************************************************)\r
 489  \r
 490 (*   F I L E L E N   *)\r
 491  \r
 492     (* gives the file length - the number of position\r
 493        immediately after the last one *)\r
 494  \r
 495  \r
 496   unit filelen: function( p: Rfile): integer;\r
 497     begin\r
 498       if p = none\r
 499       then\r
 500         writeln(" FS - filelen - checking nonexisting file");\r
 501       fi;\r
 502       if not p.opened\r
 503       then\r
 504         writeln(" FS - filelen - checking not opened file");\r
 505       fi;\r
 506       result := p.length\r
 507     end filelen;\r
 508  \r
 509  \r
 510 (**************************************************************)\r
 511 (**************************************************************)\r
 512  \r
 513  \r
 514  \r
 515  \r
 516         \r
 517  \r
 518  \r
 519  \r
 520   begin (* of FileSystem *)\r
 521      system := new Rfile;\r
 522      system.next, system.prev := system;\r
 523   end FileSystem;\r
 524  \r
 525 (***************************************************************)\r
 526 (*  Pakiet Grafiki Blokowej                                    *)\r
 527 (*                                                             *)\r
 528 (*                                                             *)\r
 529 (*                                                             *)\r
 530 (*                                                             *)\r
 531 (***************************************************************)\r
 532   unit Bold : procedure;\r
 533   begin\r
 534     write( chr(27), "[1m")\r
 535   end Bold;\r
 536  \r
 537   unit Blink : procedure;\r
 538   begin\r
 539     write( chr(27), "[5m")\r
 540   end Blink;\r
 541  \r
 542   unit Reverse : procedure;\r
 543   begin\r
 544     write( chr(27), "[7m")\r
 545   end Reverse;\r
 546  \r
 547   unit Normal : procedure;\r
 548   begin\r
 549     write( chr(27), "[0m")\r
 550   end Normal;\r
 551  \r
 552   unit Underscore : procedure;\r
 553   begin\r
 554     write( chr(27), "[4m")\r
 555   end Underscore;\r
 556  \r
 557  \r
 558  \r
 559   unit inchar : IIuwgraph function : integer;\r
 560     (*podaj nr znaku przeslanego z klawiatury *)\r
 561     var i : integer;\r
 562   begin\r
 563     do\r
 564       i := inkey;\r
 565       if i <> 0 then exit fi;\r
 566     od;\r
 567     result := i;\r
 568   end inchar;\r
 569  \r
 570   unit NewPage : procedure;\r
 571   begin\r
 572     write( chr(27), "[2J")\r
 573   end NewPage;\r
 574  \r
 575   unit  SetCursor : procedure(row, column : integer);\r
 576     var c,d,e,f  : char,\r
 577         i,j : integer;\r
 578   begin\r
 579     i := row div 10;\r
 580     j := row mod 10;\r
 581     c := chr(48+i);\r
 582     d := chr(48+j);\r
 583     i := column div 10;\r
 584     j := column mod 10;\r
 585     e := chr(48+i);\r
 586     f := chr(48+j);\r
 587     write( chr(27), "[", c, d, ";", e, f, "H")\r
 588   end SetCursor;\r
 589 h(***************************************************************)\r
 590 (*  koniec Grafiki                                             *)\r
 591 (***************************************************************)\r
 592  \r
 593 unit HandlerOfRelations : FileSystem class(PageSize: integer,\r
 594              TreeHeight: integer,\r
 595                                 HalfPageSize : integer) ;\r
 596   signal signal8,      (*przekroczono wysokosc TreeHeight   *)\r
 597          signal14,     (*dwa identyczne klucze o jednakowych ref*)\r
 598          Signal13;       (*sygnal usuwania nieobecnego rekordu*)\r
 599  signal Signal11,  (*nie ma poprzednika w PrevKey*)\r
 600         Signal12;  (*nie ma nastepnika w NextKey*)\r
 601  \r
 602  \r
 603   unit Node : class;\r
 604      (*klasa prefiksujaca wszystkie klasy wykorzystywane w\r
 605      interpreterze*)\r
 606     var Gender:integer\r
 607   begin\r
 608   end Node;\r
 609  \r
 610 (*  unit ObjectToRec : function (n : Node) : arrayof integer;\r
 611   end ObjectToRec;\r
 612  \r
 613   unit RecToObject : function(a: arrayof integer) : Node;\r
 614   end RecToObject;*)\r
 615  \r
 616 (*struktura logiczna\r
 617  \r
 618                      DataFile\r
 619                    /     |      \\r
 620            Atrybut               \             .\r
 621                      | Relation   \            |\r
 622                      |             \           |\r
 623                      |                         |\r
 624                      |           |IndexFile  | |\r
 625                      |           |           | |\r
 626                      | _______________________ |      *)\r
 627  \r
 628  \r
 629  \r
 630        (********************************************\r
 631         *                                          *\r
 632         *        DataFile                          *\r
 633         *                                          *\r
 634         *    Reset                                 *\r
 635         *    AddRec                                *\r
 636         *    DelRec                                *\r
 637         *    FindRec                               *\r
 638         *    FreePlace                             *\r
 639         *                                          *\r
 640         *                                          *\r
 641         ********************************************)\r
 642  \r
 643   unit DataFile : Node class;\r
 644       (*typ DataFile jest wspolnym prefiksem dla Atrybut i\r
 645 Relation i IndexFile. Ten typ umo*liwia operacje\r
 646       Wstaw Rekord, UsunRekord etc. *)\r
 647     var plik : Rfile;\r
 648     var FreePlace : integer; (* pozycja wolnego miejsca\r
 649                                 w pliku*)\r
 650  \r
 651  \r
 652     unit Reset : procedure ;\r
 653     begin\r
 654        call fseek(plik,1);\r
 655     end Reset;\r
 656  \r
 657     unit AddRec : procedure (input Record:arrayof integer;\r
 658                            output RefRec:integer);\r
 659       (*Procedura wstawia rekord Record do DataFile i zwraca\r
 660 jego pozycje w pliku wykorzystujac przy tym informacje o\r
 661 wolnych miejscach zapamietana na stosie FreePlace*)\r
 662  \r
 663       var AuxRec: arrayof integer;\r
 664     begin\r
 665        array AuxRec dim(lower(Record):upper(Record));\r
 666        if FreePlace=0\r
 667        then\r
 668           RefRec:=FileLen(plik);\r
 669           (*jesli nie bylo usunietych rekordow, to Record\r
 670            zapiszemy na koncu pliku*)\r
 671        else\r
 672           RefRec:=FreePlace;\r
 673           call fseek(plik,RefRec);\r
 674           AuxRec:=fget(plik);(*odczytanie pozycji poprzed\r
 675                             niego wolnego miejsca, ktore\r
 676                   bedzie teraz aktualnym wolnym miejscem*)\r
 677           FreePlace:=AuxRec(1);\r
 678        fi;\r
 679        call fseek(plik,RefRec);\r
 680        call fput(plik,Record)\r
 681    end AddRec;\r
 682  \r
 683      unit DelRec: procedure(input DataRef: integer);\r
 684        (*Procedura usuwa rekord wskazany przez DataRef i wpisuje\r
 685 na jego miejsce referencje do ostatniego wolnego miejsca.\r
 686 Pozycja usunietego rekordu jest zapamietana na stosie\r
 687 FreePlace *)\r
 688  \r
 689        var AuxRec: arrayof integer;\r
 690      begin\r
 691         call fseek(plik,DataRef);\r
 692         array AuxRec dim (1 : plik.reclen);\r
 693         AuxRec(1):=FreePlace;\r
 694         call fput(plik,AuxRec);\r
 695         FreePlace:=DataRef;\r
 696      end DelRec;\r
 697  \r
 698      unit FindRec:procedure(input Record:arrayof integer;\r
 699                            output RefRec : integer);\r
 700 (*Procedura FindRec odszukuje rekord wskazany przez Record\r
 701 i zwraca jego pozycje w pliku*)\r
 702        var equal :boolean,\r
 703            i,  Place: integer,\r
 704            AuxRec: arrayof integer;\r
 705      begin\r
 706         array AuxRec dim(lower(Record): upper(Record));\r
 707         call Reset;\r
 708         equal:=false;\r
 709         while (not feof(plik) and not equal)\r
 710         do\r
 711           RefRec := position(plik);\r
 712           AuxRec:= fget(plik);\r
 713           for i:=lower(AuxRec) to upper(AuxRec)\r
 714           do\r
 715             equal:= AuxRec(i)=Record(i);\r
 716             if not equal then exit fi\r
 717           od (*koniec porownywania rekordow*);\r
 718           (* czy znaleziony jest usunietym wczesniej rekordem? *)\r
 719           if (equal and FreePlace <> 0)\r
 720           then\r
 721              Place:=FreePlace;\r
 722              while not Place=0\r
 723              do\r
 724                 if RefRec = Place\r
 725                 then\r
 726                    equal:=false;\r
 727                    exit (*if equal*)\r
 728                 else\r
 729                    call fseek(plik,Place);\r
 730                    AuxRec:=fget(plik);\r
 731                    Place:=AuxRec(1)\r
 732                 fi;\r
 733              od;\r
 734             call fseek(plik,RefRec+plik.reclen);\r
 735           fi (*if equal*);\r
 736         od (*eof plik*);\r
 737         if not equal\r
 738         then\r
 739             RefRec:=-1(*nie znalezlismy rekordu*)\r
 740          fi;\r
 741      end FindRec;\r
 742  \r
 743   begin (*DataFile*)\r
 744  \r
 745       FreePlace:=0\r
 746   end DataFile;\r
 747  \r
 748 (*\r
 749         ********************************************\r
 750         *              Relation                    *\r
 751         *                                          *\r
 752         *    insert                                *\r
 753         *    delete                                *\r
 754         *    retrieve                              *\r
 755         *    member                                *\r
 756         *    close                                 *\r
 757         *    open                                  *\r
 758         *    allocate                              *\r
 759         *    deallocate                            *\r
 760         *                                          *\r
 761         ********************************************\r
 762 *)\r
 763 unit Relation : DataFile class ;\r
 764    var Index :arrayof IndexFile;\r
 765  \r
 766    unit Tuple : Node class;\r
 767      (*element relacji*)\r
 768    end Tuple;\r
 769  \r
 770    unit virtual TupleToRec : function (t : Tuple): arrayof\r
 771                                                            integer;\r
 772    end TupleToRec ;\r
 773  \r
 774    unit virtual RecToTuple : function(a : arrayof integer):\r
 775                                                         Tuple;\r
 776    end RecToTuple;\r
 777  \r
 778  \r
 779  \r
 780   unit Insert:  procedure (t: Tuple);\r
 781     var i,PageRef,DataRef:integer;\r
 782     var AuxRec : arrayof integer;\r
 783   begin\r
 784  AuxRec:=TupleToRec(t);\r
 785  call AddRec(AuxRec, DataRef);\r
 786  if  Index <> none\r
 787  then\r
 788  for i:=1 to upper(Index)\r
 789  do\r
 790    if Index(i)<>none\r
 791    then\r
 792       call Index(i).AddKey(Index(i).KeyOf(t),DataRef)\r
 793    fi\r
 794       od;\r
 795       fi;\r
 796   end Insert;\r
 797  \r
 798   unit Delete : procedure (t: Tuple);\r
 799    var i,DataRef :integer,\r
 800       AuxRec : arrayof integer;\r
 801   begin\r
 802    if Index =/= none\r
 803    then (*najpierw szukamy w indeksach i usuwamy tam*)\r
 804      for i:=1 to upper(Index)\r
 805      do\r
 806        if none <> Index(i)\r
 807        then\r
 808           DataRef := Index(i).FindKey(Index(i).KeyOf(t));\r
 809           call  Index(i).DelKey(Index(i).KeyOf(t),DataRef);\r
 810          (*\r
 811 DelKey dziala? *)\r
 812        fi;\r
 813      od\r
 814    else (*brak indeksu*)\r
 815      AuxRec := TupleToRec(t);\r
 816      call FindRec(AuxRec, DataRef);\r
 817    fi;\r
 818    if DataRef = -1\r
 819    then\r
 820      raise Signal13   (*proba usuniecia rekordu ktorego nie ma*)\r
 821    else\r
 822      call DelRec(DataRef) ;  (*wstawic  na liste usuniec*)\r
 823    fi\r
 824  end Delete;\r
 825  \r
 826  \r
 827      (*  ********************************************\r
 828         *          IndexFile                       *\r
 829         *                                          *\r
 830         *  Key                                     *\r
 831         *  Order                                   *\r
 832         *  Item                                    *\r
 833         *  Page                                    *\r
 834         *  Addkey                                  *\r
 835         *  DelKey                                  *\r
 836         *  NextKey                                 *\r
 837         *  FindKey                                 *\r
 838         *  SearchKey                               *\r
 839         *  PrevKey                                 *\r
 840         *  MinKey                                  *\r
 841         *  MaxKey                                  *\r
 842         *  Path                                    *\r
 843         *  CloseIndex                              *\r
 844         ********************************************\r
 845 *)\r
 846  \r
 847 unit IndexFile : DataFile coroutine;\r
 848  \r
 849  \r
 850   unit SearchStep: class;\r
 851     var PageRef,RefOnPage : integer,\r
 852         updated : boolean;\r
 853   end SearchStep;\r
 854  \r
 855   unit Item : class ;\r
 856     var ky: key, PageRef: integer, DataRef: integer;\r
 857       (* item jest jednostka ( rekordem) przechowywana w\r
 858       indeksie na stronie tzn.Page\r
 859       zawiera:\r
 860         ky - klucz,\r
 861         PageRef - informacje o stronie na ktorej znajduje sie\r
 862  korzen poddrzewa z kluczami wiekszymi od klucza kl,\r
 863            a mniejszymi od kluczy podporzadkowanych sasiadowi z\r
 864  lewej,\r
 865         DataRef - informacja w ktorym rekordzie zapisano\r
 866  krotke odpowiadajaca naszemu kluczowi ky*)\r
 867   end Item;\r
 868  \r
 869   unit Page: class;\r
 870     var ItemsOnPage,     (*ilu synow ma ta strona +1*)\r
 871         LessPageRef: integer;  (*wskaznik do poddrzewa elementow\r
 872 mniejszych od pierwszego klucza na tej stronie*)\r
 873     var ItemsArray: arrayof Item;\r
 874   begin\r
 875     array ItemsArray dim (1:PageSize)\r
 876   end Page;\r
 877  \r
 878   var KeySize: integer;\r
 879  \r
 880   unit key : Node class ;\r
 881     (*definicja klucza zgodnie z zyczeniem uzytkownika*)\r
 882   end key;\r
 883  \r
 884  \r
 885   var StackOfPages: arrayof Page;\r
 886   var Finger: integer;   (*zmienne StackOfPages i Finger\r
 887  implementuja stos stron*)\r
 888   var Path: arrayof SearchStep; (*zmienne Path i Finger\r
 889                                   implementuja sciezke*)\r
 890  \r
 891 (* axiom: nr strony wskazanej przez Finger w StackOfPages jest\r
 892  identyczny z numerem strony wskazanym przez Finger w Path*)\r
 893  \r
 894   unit virtual KeyOf : function (t : Tuple) : key;\r
 895     (*KeyOf tworzy z dowolnej krotki klucz zaleznie od\r
 896      rozwazanego indeksu*)\r
 897   end KeyOf;\r
 898  \r
 899   unit virtual Leq: function (k1,k2 : key):Boolean;\r
 900       (* Leq sprawdza czy krotki k1,k2 sa w relacji\r
 901       obowiazujacej w rozwazanym indeksie\r
 902       zakladamy, ze jest to relacja antysymetryczna*)\r
 903   end Leq;\r
 904  \r
 905  \r
 906   unit AddKey : procedure (input ky:key,DataRef:integer);\r
 907     (*wstawienie klucza ky i referencji DataRef do indexu w odpowiednie\r
 908                                                       miejsce w B-drzewie\r
 909      DataRef jest adresem rekordu ktory odpowiada kluczowi\r
 910      w pliku relacji*)\r
 911     var depth,       (*aktualna glebokosc stosu stron*)\r
 912         PageRef,\r
 913         i : integer,\r
 914         AddItem, AuxItem, itm2 : Item,\r
 915         IncreaseHeight : boolean,\r
 916         NewRoot : Page,\r
 917         AuxRec : arrayof integer;\r
 918  \r
 919     unit Search : procedure (input itm1 : Item, PageRef :\r
 920                                                          integer;\r
 921                                            output include : boolean, itm2 :\r
 922                                                                   Item);\r
 923                 (*szukaj poczawszy od strony PageRef, miejsca dla itm1;\r
 924                  jezeli nie znajdzie miejsca na tej stronie to\r
 925 rekurencyjnie szuka na nastepnej odpowiedniej az do\r
 926 liscia;\r
 927                  jezeli include to WSTAWIA obiekt itm2*)\r
 928  \r
 929       var NextPageRef,\r
 930           ItemRef :  integer,\r
 931           inclde  :  boolean,\r
 932           item2   :  Item,\r
 933           AuxPage :  Page;\r
 934  \r
 935       unit Insert : procedure;\r
 936                   (*wstawia obiekt itm2 na strone PageRef w miejscu ItemRef*)\r
 937                   var OldPage, RightPage : Page,\r
 938                             AuxRec : arrayof integer,\r
 939                          AuxItmArr ,\r
 940                         AuxItmArr2 : arrayof Item,\r
 941                        RightPageRef,\r
 942                                  i : integer;\r
 943       begin (*Insert*)\r
 944                 OldPage := StackOfPages(Finger);\r
 945                 if OldPage.ItemsOnPage < PageSize\r
 946                 then (*jest miejsce na tej stronie *)\r
 947                   call UpdatePage (item2, ItemRef, OldPage);\r
 948                   Path(Finger).RefOnPage := ItemRef + 1;\r
 949                   include := false;\r
 950                 else (*strona jest pelna dokonujemy podzialu *)\r
 951                   include := true;\r
 952                   OldPage.ItemsOnPage := HalfPageSize;\r
 953                   Path(Finger).updated := true;\r
 954                   RightPage := new Page;\r
 955                   RightPage.ItemsOnPage := HalfPageSize;\r
 956                   array RightPage.ItemsArray dim (1:PageSize);\r
 957                   AuxItmArr := OldPage.ItemsArray;\r
 958                   AuxItmArr2 := RightPage.ItemsArray;\r
 959                   if ItemRef = HalfPageSize\r
 960                   then (*obiekt itm2=item2 idzie do gory*)\r
 961                     for i := 1  to  HalfPageSize\r
 962                     do\r
 963                            AuxItmArr2(i):=AuxItmArr(i+HalfPageSize)\r
 964                     od;\r
 965                     itm2:= item2;\r
 966                   else (*to nie item2 idzie do gory  *)\r
 967                       if ItemRef < HalfPageSize\r
 968                       then (*wstawiamy do lewej strony*)\r
 969                            for i := 1  to HalfPageSize\r
 970                            do\r
 971                                 AuxItmArr2(i) :=\r
 972                                                 AuxItmArr(i+HalfPageSize)\r
 973                            od;\r
 974                            itm2 := AuxItmArr(HalfPageSize);\r
 975                            for i := HalfPageSize-1 downto ItemRef+1\r
 976                            do\r
 977                                 AuxItmArr(i+1) :=\r
 978                                                 AuxItmArr(i)\r
 979                            od;\r
 980                           AuxItmArr(ItemRef+1) := item2;\r
 981                          else (*ItemRef>HalfPageSize *)\r
 982                            itm2 := AuxItmArr(HalfPageSize+1);\r
 983                            for i := HalfPageSize+2  to ItemRef\r
 984                            do\r
 985                                 AuxItmArr2(i-HalfPageSize-1) :=\r
 986                                                                 AuxItmArr(i)\r
 987                            od;\r
 988                            AuxItmArr2(ItemRef-HalfPageSize)\r
 989                                                         := item2;\r
 990  \r
 991                            for i := ItemRef+1  to PageSize\r
 992                            do\r
 993                                 AuxItmArr2(i-HalfPageSize) :=\r
 994                                                 AuxItmArr(i)\r
 995                            od;\r
 996                          fi (*ItemRef < HalfPageSize *)\r
 997                  fi (*ItemRef = HalfPagSize *);\r
 998 (*****)          (*   StackOfPages(finger) := OldPage; *)\r
 999                     call fseek(plik,Path(Finger).PageRef);\r
1000            call fput(plik,PageToRec(StackOfPages(Finger)));\r
1001                     RightPage.LessPageRef := itm2.PageRef;\r
1002                       AuxRec :=PageToRec(RightPage);\r
1003                     call AddRec(AuxRec,RightPageRef);\r
1004                     itm2.PageRef :=RightPageRef;\r
1005                 fi (* *)\r
1006       end Insert;\r
1007  \r
1008  \r
1009     begin (*Search*)\r
1010  \r
1011       if PageRef = -1\r
1012       then (*poprzednia strona jest lisciem, nalezy do niej\r
1013              wstawic itm1 ale z PageRef = -1*)\r
1014         include := true;\r
1015         itm2 := itm1;\r
1016         itm2.PageRef := -1;\r
1017       else (*przeszukaj te strone*)\r
1018         Finger, depth := Finger+1;\r
1019         call GetPage (PageRef);\r
1020         AuxPage := StackOfPages (Finger);\r
1021         call SearchPage (AuxPage, itm1, NextPageRef, ItemRef);\r
1022         call Search(itm1, NextPageRef, include, item2);\r
1023         if include\r
1024         then (*wstawic obiekt item2 na strone PageRef w miejsce\r
1025               ItemRef; jezeli na tej stronie wystarczy miejsca\r
1026               na nowy obiekt to wstawic go i zgasic include;\r
1027               jezeli brakuje miejsca to strone dzielimy i\r
1028               include pozostawiamy zapalone, nowy item itm2 ma\r
1029               byc wstawiony na wyzszej stronie  *)\r
1030            call Insert;\r
1031         fi (*include*);\r
1032         Finger := Finger -1;\r
1033       fi (*PageRef=-1*);\r
1034     end Search;\r
1035  \r
1036  \r
1037   begin (*AddKey*)\r
1038     (*szukaj w korzeniu i powtarzaj rekurencyjnie w odp.\r
1039      poddrzewach, gdy znajdziesz to sygnal blad\r
1040      w przeciwnym przypadku*)\r
1041     Path(1).updated := true;\r
1042     AuxItem := new Item;\r
1043     AuxItem.ky := ky;\r
1044     AuxItem.DataRef := DataRef;\r
1045     AuxItem.PageRef := -1;\r
1046     Finger := 0;\r
1047     call Search(AuxItem, Path(1).PageRef,\r
1048                                  IncreaseHeight, AddItem);\r
1049     if IncreaseHeight\r
1050     then (*korzen podzielony, dodajemy nowy korzen*)\r
1051       NewRoot := new Page;\r
1052       NewRoot.ItemsOnPage := 1;\r
1053       NewRoot.LessPageRef := Path(1).PageRef;\r
1054                         (*adres prawej czesci starego korzenia*)\r
1055       array NewRoot.ItemsArray dim (1:PageSize);\r
1056       NewRoot.ItemsArray(1) := AddItem;\r
1057       if depth+1 > TreeHeight\r
1058            then (*przekroczono dopuszczalna wysokosc drzewa*)\r
1059         raise Signal8\r
1060            fi;\r
1061       for i := 1 to depth\r
1062            do\r
1063              StackOfPages(i+1) := StackOfPages(i);\r
1064              Path(i+1) := Path(i);\r
1065            od;\r
1066            StackOfPages(1) := NewRoot;\r
1067            Path(1) := new SearchStep;\r
1068       Path(1).RefOnPage := 1;\r
1069       Path(1).updated := true;\r
1070                       AuxRec :=PageToRec(NewRoot);\r
1071            call AddRec(AuxRec, PageRef);\r
1072            Path(1).PageRef := PageRef (*adres nowego korzenia*) ;\r
1073       Finger := depth+1;\r
1074     else\r
1075       Finger := depth;\r
1076          fi (*IncreaseHeight*);\r
1077  \r
1078   end AddKey;\r
1079  \r
1080  \r
1081  \r
1082  \r
1083 (*AXIOM  po wykonaniu dowolnej operacji zmieniajacej Finger\r
1084  Finger i Path pokazuja na sciezce jakis item w ktorym jest\r
1085  klucz tzn. item dla ktorego RefOnPage =/= 0*)\r
1086  \r
1087   unit PrevKey : procedure (output ky:key, DataRef:integer);\r
1088     (*ky jest bezposrednim poprzednikiem klucza biezacego\r
1089 wskazanego przez Path. DataRef wskazuje referencje do\r
1090 krotki odpowiadajacej ky w pliku danych*)\r
1091     var AuxPage : Page,\r
1092         AuxRec : arrayof integer,\r
1093         PageRef, nextPageRef,\r
1094         RefOnPage : integer;\r
1095   begin (*Zakladamy, ze biezacy klucz jest wskazany przez\r
1096                                                 Path(Finger)*)\r
1097     RefOnPage := Path(Finger).RefOnPage;\r
1098     PageRef:=Path(Finger).PageRef;\r
1099     AuxPage:=StackOfPages(Finger);\r
1100     if AuxPage.LessPageRef = -1\r
1101     then (*jestesmy w lisciu*)\r
1102             if RefOnPage <> 1\r
1103             then (*poprzednikiem jest sasiad z lewej*)\r
1104                  RefOnPage := RefOnPage -1;\r
1105                  Path(Finger).RefOnPage := RefOnPage\r
1106             else (*RefOnPage = 1*)\r
1107                  if Finger =1\r
1108                  then (*to jest korzen*)\r
1109                    ky:=AuxPage.ItemsArray(RefOnPage).ky;\r
1110                    DataRef:=AuxPage.ItemsArray(RefOnPage).DataRef;\r
1111                    raise signal11; (*nie ma poprzednika*)\r
1112                    return;\r
1113                  else\r
1114                    RefOnPage := 0;\r
1115                    while Finger <> 1 and RefOnPage = 0\r
1116                    do\r
1117                         Finger := Finger-1;\r
1118                         Auxpage := StackOfPages(Finger);\r
1119                         RefOnPage := Path(Finger).RefOnPage\r
1120                    od;\r
1121                    if Finger = 1 and RefOnPage = 0\r
1122                    then\r
1123                         ky:=AuxPage.ItemsArray(1).ky;\r
1124                         DataRef:=AuxPage.ItemsArray(1).DataRef;\r
1125                         raise signal11; (*nie ma poprzednika*)\r
1126                         return;\r
1127                    fi;\r
1128                  fi (* Finger = 1 *);\r
1129             fi (* RefOnPage <> 1 *);\r
1130          else (*to nie jest lisc*)\r
1131                 if RefOnPage = 1\r
1132                 then\r
1133                   nextPageRef := AuxPage.LessPageRef;\r
1134                   Path(Finger).RefOnPage := 0\r
1135                 else\r
1136                   RefOnPage := RefOnPage -1;\r
1137                   nextPageRef := AuxPage.ItemsArray(RefOnPage).PageRef;\r
1138                   Path(Finger).RefOnPage := RefOnPage\r
1139                 fi;\r
1140                 while nextPageRef <> -1      (*szukamy najwiekszego syna*)\r
1141                 do\r
1142                   Finger := Finger +1;\r
1143                   PageRef := nextPageRef;\r
1144                   call GetPage(PageRef);\r
1145                   AuxPage := StackOfPages(Finger);\r
1146                   RefOnPage, Path(Finger).RefOnPage :=\r
1147                                              Auxpage.ItemsOnPage;\r
1148                   nextPageRef := AuxPage.ItemsArray(RefOnPage).PageRef\r
1149                 od;\r
1150          fi;\r
1151     ky:=AuxPage.ItemsArray(RefOnPage).ky;\r
1152     DataRef:=AuxPage.ItemsArray(RefOnPage).DataRef\r
1153   end PrevKey;\r
1154  \r
1155  \r
1156   unit MinKey : procedure (output k:Key, DataRef : integer);\r
1157     (*ustawia Pointer do indexu i Path tak by pokazywaly\r
1158 najmniejszy klucz. k - jest najmniejszym kluczem w\r
1159 rozwazanym indeksie, DataRef jest odpowiadajaca mu\r
1160 referencja do rekordu w pliku glownym relacji*)\r
1161  \r
1162     var PageRef : integer,\r
1163         AuxPage : Page,\r
1164         AuxItem : Item;\r
1165  \r
1166   begin\r
1167     Finger :=1;\r
1168      do\r
1169       AuxPage := StackOfPages(Finger);\r
1170       PageRef := AuxPage.LessPageRef;\r
1171       Path(Finger).RefOnPage := 0;\r
1172       if PageRef = -1 then exit fi;\r
1173       Finger := Finger +1;\r
1174       call GetPage(PageRef);\r
1175      od;\r
1176      AuxItem := AuxPage.ItemsArray(1);\r
1177      k := AuxItem.ky;\r
1178      DataRef := AuxItem.DataRef;\r
1179      Path(Finger).RefOnPage := 1;\r
1180  \r
1181   end MinKey;\r
1182  \r
1183   unit MaxKey : procedure( output k:Key, DataRef: integer);\r
1184 (*ustawia Pointer do indexu i Path tak by pokazywaly\r
1185 najwiekszy klucz*)\r
1186     var PageRef, n : integer,\r
1187            AuxPage : Page;\r
1188  \r
1189   begin\r
1190     Finger :=1;\r
1191      do\r
1192       AuxPage := StackOfPages(Finger);\r
1193       Path(Finger).RefOnPage, n :=\r
1194                                 AuxPage.ItemsOnPage ;\r
1195       PageRef := AuxPage.ItemsArray(n).PageRef;\r
1196       if PageRef = -1 then exit fi;\r
1197       Finger := Finger+1;\r
1198       call GetPage(PageRef);\r
1199      od;\r
1200      k := AuxPage.ItemsArray(n).Ky;\r
1201      DataRef := AuxPage.ItemsArray(n).DataRef;\r
1202  \r
1203   end MaxKey;\r
1204  \r
1205  \r
1206  \r
1207 (*************************************************************************)\r
1208  \r
1209  \r
1210   unit NextKey: procedure (output ky:key,DataRef:integer);\r
1211 (*referencja DataRef do bezposredniego nastepnika biezacej\r
1212  pozycji\r
1213      ky jest bezposrednim nastepnikiem klucza biezacego\r
1214  wskazanego przez Path. DataRef wskazuje referencje do\r
1215  krotki odpowiadajacej ky w pliku danych*)\r
1216      var AuxPage : Page,\r
1217          AuxItem : Item,\r
1218         PageRef,nextPageRef,\r
1219         RefOnPage : integer;\r
1220   begin (*Zakladamy, ze biezacy klucz jest wskazany przez\r
1221                                                 Path(Finger) *)\r
1222     RefOnPage := Path(Finger).RefOnPage;\r
1223     PageRef := Path(Finger).PageRef;\r
1224     AuxPage:=StackOfPages(Finger);\r
1225  \r
1226     if AuxPage.LessPageRef = -1\r
1227     then (*jestesmy w lisciu*)\r
1228        while Finger <> 1 and RefOnPage = AuxPage.ItemsOnPage\r
1229        do\r
1230          Finger := Finger - 1;\r
1231          AuxPage := StackOfPages(Finger);\r
1232          RefOnPage := Path(Finger).refOnPage\r
1233        od;\r
1234        if  RefOnPage = AuxPage.ItemsOnPage\r
1235        then\r
1236            AuxItem := AuxPage.ItemsArray(RefOnPage);\r
1237            DataRef := AuxItem.DataRef;\r
1238            ky := AuxItem.ky;\r
1239           raise signal12; (*nie ma nastepnika*)\r
1240           return;\r
1241        else\r
1242          RefOnPage := RefOnPage+1;\r
1243          Path(Finger).RefOnPage := RefOnPage\r
1244        fi;\r
1245     else (*to nie jest lisc*)\r
1246       nextPageRef := AuxPage.ItemsArray(RefOnPage).PageRef;\r
1247       while nextPageRef <> -1\r
1248            do\r
1249                 Finger := Finger+1;\r
1250                 PageRef := NextPageRef;\r
1251                 call GetPage(PageRef);\r
1252                 AuxPage := StackOfPages(Finger);\r
1253                 Path(Finger).refOnPage := 0;\r
1254                 NextPageRef := AuxPage.LesspageRef\r
1255            od;\r
1256       RefOnPage := 1;\r
1257       Path(Finger).RefOnPage := 1\r
1258     fi;\r
1259     AuxItem := AuxPage.ItemsArray(RefOnPage);\r
1260     DataRef := AuxItem.DataRef;\r
1261     ky := AuxItem.ky\r
1262   end NextKey;\r
1263  \r
1264  \r
1265   unit DelKey : procedure (input ky:key,DataRef:integer);\r
1266     (*usuwanie klucza ky, o referencji do pliku glownego\r
1267     dataref, z indeksu, jezeli takiego klucza nie ma to\r
1268     sygnal*)\r
1269     var DataRef1: integer,\r
1270         k: key,\r
1271         underflw:boolean;  (*true if underflow occurred*)\r
1272  \r
1273      unit remove : procedure(output underflw:boolean);\r
1274       var AuxPage,AuxPage1 :Page,\r
1275           i,ItemsOnPage,RefOnPage,nextPageRef :integer;\r
1276       begin\r
1277         AuxPage:=StackOfPages(Finger);\r
1278         i:=Finger;\r
1279         Path(Finger).updated:=true;\r
1280         RefOnPage := Path(Finger).RefOnPage;\r
1281  \r
1282         if  AuxPage.LessPageRef <> -1\r
1283         then (*to nie jest lisc*)\r
1284           NextPageRef :=\r
1285                     AuxPage.ItemsArray(RefOnPage).PageRef;\r
1286           while NextPageRef <> -1\r
1287           do\r
1288             Finger := Finger+1;\r
1289             call GetPage(NextPageRef);\r
1290             AuxPage1 := StackOfPages(Finger);\r
1291             Path(Finger).RefOnPage := 0;\r
1292             NextPageRef := AuxPage1.LessPageRef\r
1293           od;\r
1294           Path(Finger).updated:=true;\r
1295           Path(Finger).RefOnPage := 1;\r
1296           AuxPage.ItemsArray(RefOnPage).ky:=\r
1297                                 AuxPage1.ItemsArray(1).ky;\r
1298           AuxPage.ItemsArray(RefOnPage).DataRef:=\r
1299                            AuxPage1.ItemsArray(1).DataRef;\r
1300           StackOfPages(i):=AuxPage;(*wymienilam usuniety element*)\r
1301           AuxPage:= AuxPage1;\r
1302           RefOnPage:=1;\r
1303         fi;(*jestesmy w lisciu*)\r
1304  \r
1305           ItemsOnPage:= AuxPage.ItemsOnPage -1;\r
1306         \r
1307           for i:=RefOnPage to ItemsOnPage\r
1308           do\r
1309             AuxPage.ItemsArray(i):=AuxPage.ItemsArray(i+1)\r
1310           od;\r
1311           AuxPage.ItemsOnPage:= ItemsOnPage;\r
1312           StackOfPages(Finger):=AuxPage;\r
1313           if ItemsOnPage<HalfPageSize\r
1314           then (*trzeba wywolac underflow*)\r
1315           underflw:=true\r
1316         fi\r
1317     end remove;\r
1318  \r
1319 unit underflow: procedure(inout underflw:boolean);\r
1320      (* Finger wskazuje strone A na ktorej jest niedomiar *)\r
1321     var Itm:Item,\r
1322         AuxPage,AuxPage1, AuxPage2:Page,\r
1323         i,k,n,pb,lb,PageRef,RefOnPage: integer,\r
1324         AuxRec: arrayof integer;\r
1325     begin\r
1326       call SetCursor(7,1);     (*****************************)\r
1327       writeln("underflow",Finger);\r
1328       underflw:=false;\r
1329       if Finger<>1 then\r
1330       AuxPage:=StackOfPages(Finger);(*strona z niedomiarem*)\r
1331  \r
1332       Path(Finger).updated:=true ;\r
1333       Path(Finger-1).updated:=true ;\r
1334       AuxPage1:=StackOfPages(Finger-1); (*strona ojca*)\r
1335       RefOnPage:=Path(Finger-1).RefOnPage;\r
1336       if RefOnPage< AuxPage1.ItemsOnPage\r
1337       then (*istnieje prawy stryj*)\r
1338          k:=RefOnPage+1;\r
1339          Itm:=AuxPage1.ItemsArray(k);\r
1340          PageRef:=Itm.PageRef;\r
1341          (*wczytanie strony-brata prawego na AuxPage2*)\r
1342          call fseek(plik,PageRef);\r
1343          AuxRec:=fget(plik);\r
1344          AuxPage2:=RecToPage(AuxRec);\r
1345  \r
1346          Itm.PageRef:=AuxPage2.LessPageRef;\r
1347          AuxPage.ItemsArray(AuxPage.ItemsOnPage+1):=Itm;\r
1348          (*stryj schodzi do AuxPage*)\r
1349          n:=AuxPage2.ItemsOnPage-HalfPageSize;\r
1350  \r
1351          if  n>0\r
1352          then\r
1353            n:=entier((n-1)/2);(* przelewamy n elementow *)\r
1354            Itm:=AuxPage2.ItemsArray(n+1);\r
1355            Itm.PageRef:=PageRef;\r
1356            AuxPage1.ItemsArray(k):=Itm;\r
1357            for i:=1 to n\r
1358            do\r
1359              AuxPage.ItemsArray(HalfPageSize+i):=\r
1360                                    AuxPage2.ItemsArray(i)\r
1361            od;\r
1362            AuxPage.ItemsOnPage:=HalfPageSize+n;\r
1363            StackOfPages(Finger):=AuxPage;\r
1364            StackOfPages(Finger-1):=AuxPage1;\r
1365            k:=AuxPage2.ItemsOnPage-(n+1);\r
1366  \r
1367            for i:=1 to k\r
1368            do\r
1369               AuxPage2.ItemsArray(i):=\r
1370                                  AuxPage2.ItemsArray(n+1+i)\r
1371            od;\r
1372            AuxPage2.ItemsOnPage:=k;\r
1373            AuxRec:=PageToRec(AuxPage2);(*zapamiet. AuxPage2*)\r
1374            call fseek(plik,PageRef);\r
1375            call fput(plik,AuxRec);\r
1376          else\r
1377             (*AuxPage2.ItemsOnPage=HalfPageSize tzn. n=0*)\r
1378             for i:=1 to HalfPageSize\r
1379             do\r
1380               AuxPage.ItemsArray(HalfPageSize+i):=\r
1381                                    AuxPage2.ItemsArray(i)\r
1382             od;\r
1383             AuxPage.ItemsOnPage:=PageSize;\r
1384             for i:=RefOnPage+2 to AuxPage1.ItemsOnPage\r
1385             do\r
1386               AuxPage1.ItemsArray(i-1):=\r
1387                                    AuxPage1.ItemsArray(i)\r
1388             od;\r
1389  \r
1390             AuxPage1.ItemsOnPage:=AuxPage1.ItemsOnPage-1;\r
1391             StackOfPages(Finger-1):=AuxPage1;\r
1392             StackOfPages(Finger):=AuxPage;\r
1393             call DelRec(PageRef);\r
1394             if AuxPage1.ItemsOnPage<HalfPageSize\r
1395             then\r
1396                Finger:=Finger-1;\r
1397                underflw:=true;\r
1398                (*niedomiar na stronie ojca*)\r
1399             fi ;\r
1400           fi (*n>0*)\r
1401  \r
1402         else (*nie ma prawego stryja, wez z lewej*)\r
1403           if  RefOnPage>1\r
1404           then\r
1405             Itm:=AuxPage1.ItemsArray(RefOnPage-1);\r
1406             PageRef:=Itm.PageRef;\r
1407           else\r
1408             PageRef:=AuxPage1.LessPageRef;\r
1409           fi;\r
1410           (*wczytanie strony-brata lewego na AuxPage2*)\r
1411           call fseek(plik,PageRef);\r
1412           AuxRec:=fget(plik);\r
1413           AuxPage2:=RecToPage(AuxRec);  (*str-brat lewy*)\r
1414  \r
1415           Itm:=AuxPage1.ItemsArray(RefOnPage);\r
1416           Itm.PageRef:=AuxPage.LessPageRef;\r
1417           n:=AuxPage2.ItemsOnPage-HalfPageSize;\r
1418           if n>0\r
1419           then\r
1420             n:=entier((n-1)/2);\r
1421             (*przesun o n+1 w prawo elem na str.AuxPage*)\r
1422              k:=AuxPage.ItemsOnPage;\r
1423              for i:=1 to n+1\r
1424              do\r
1425                AuxPage.ItemsArray(k+n+2-i):=\r
1426                                AuxPage.ItemsArray(k+1-i)\r
1427              od;\r
1428  \r
1429              AuxPage.ItemsArray(n+1):=Itm;\r
1430              (*ojciec do AuxPage*)\r
1431              AuxPage.ItemsOnPage:=k+n+1;\r
1432              Itm:=AuxPage2.ItemsArray(HalfPageSize+n+1);\r
1433              Itm.PageRef:=PageRef; (*referencja do AuxPage*)\r
1434              AuxPage1.ItemsArray(RefOnPage):=Itm;\r
1435              for i:=1 to n\r
1436              do\r
1437                AuxPage.ItemsArray(i):=\r
1438                    AuxPage2.ItemsArray(HalfPageSize+1+i+n)\r
1439              od;\r
1440              AuxPage.ItemsOnPage:=HalfPageSize+n;\r
1441              AuxPage2.ItemsOnPage:= HalfPageSize+n;\r
1442  \r
1443              (*wyslac strony i zapisac sciezke i stos*)\r
1444              StackOfPages(Finger-1):=AuxPage1;\r
1445              StackOfPages(Finger):=AuxPage;\r
1446              (*zapamietanie strony AuxPage2*)\r
1447              AuxRec:=PageToRec(AuxPage2);\r
1448              call fseek(plik,PageRef);\r
1449              call fput(plik,AuxRec);\r
1450  \r
1451           else\r
1452             (*n=o tzn.AuxPage2.ItemsOnPage=HalfPageSize*)\r
1453  \r
1454             AuxPage2.ItemsArray(HalfPageSize+1):=Itm;\r
1455             for i:=1 to HalfPageSize-1\r
1456             do\r
1457               AuxPage2.ItemsArray(HalfPageSize+1+i):=\r
1458                                    AuxPage.ItemsArray(i)\r
1459             od;\r
1460             AuxPage1.ItemsOnPage:=AuxPage1.ItemsOnPage-1;\r
1461             AuxPage2.ItemsOnPage:=PageSize;\r
1462             StackOfPages(Finger-1):=AuxPage1;\r
1463             StackOfPages(Finger):=AuxPage2;\r
1464             Path(Finger-1).RefOnPage:=RefOnPage-1;\r
1465             call DelRec(Path(Finger).PageRef);\r
1466             (*wyrzucono str AuxPage*)\r
1467             Path(Finger).PageRef:=PageRef;\r
1468  \r
1469             if AuxPage1.ItemsOnPage<HalfPageSize\r
1470             then\r
1471                Finger:=Finger-1;\r
1472                underflw:=true (*niedomiar na stronie ojca*)\r
1473             fi;\r
1474           fi (*n>0*)\r
1475  \r
1476      fi(*lewy istnieje*)\r
1477  \r
1478  \r
1479     else (*niedomiar jest w korzeniu*)\r
1480       AuxPage:=StackOfPages(1);\r
1481       if AuxPage.ItemsOnPage=0\r
1482       then\r
1483         call DelRec(Path(1).PageRef);\r
1484         if AuxPage.LessPageRef<>-1\r
1485         then\r
1486              i:=2;\r
1487              while Path(i)<>none\r
1488              do\r
1489                 Path(i-1):=Path(i);\r
1490                 StackOfPages(i-1):=StackOfPages(i);\r
1491                 i:=i+1\r
1492              od\r
1493         else\r
1494           writeln("drzewo znika ");\r
1495         fi;\r
1496      fi\r
1497     fi (*Finger<>1*);\r
1498   end underflow;\r
1499  \r
1500   begin (*DelKey*)\r
1501       k:=ky;\r
1502       DataRef1:=FindKey(k);\r
1503       do\r
1504       if k=ky and DataRef=DataRef1\r
1505       then\r
1506          (*znalezlismy wlasciwy klucz *)\r
1507          call remove(underflw);\r
1508          while underflw\r
1509          do\r
1510             call underflow(underflw)\r
1511          od;\r
1512          return\r
1513       else\r
1514         if k<>ky or DataRef1= -1\r
1515         then\r
1516           writeln("* nie ma takiego klucza *")\r
1517         else\r
1518           call NextKey(k,DataRef1)\r
1519         fi\r
1520       fi\r
1521     od\r
1522   end DelKey;\r
1523  \r
1524  \r
1525   unit FindKey:function (k : key): integer;\r
1526     (*wynikiem poszukiwania klucza k jest referencja do\r
1527      datafile wskazujaca na krotke o danym kluczu. Gdy\r
1528      nie znaleziono, wartoscia funkcji jest -1 *)\r
1529      var PageRef,\r
1530      i : integer,\r
1531      AuxPage : Page,\r
1532      Itms : arrayof Item,\r
1533      k1 : Key;\r
1534    begin\r
1535      Finger := 1;\r
1536      PageRef := Path(Finger).PageRef;\r
1537      do\r
1538        call GetPage( PageRef );\r
1539        (*przeszukujemy strone o adresie Pageref*)\r
1540        AuxPage := StackOfPages(Finger);\r
1541        Itms := AuxPage.ItemsArray;\r
1542        for i := AuxPage.ItemsOnPage downto 1\r
1543        do\r
1544           k1 := Itms(i).ky;\r
1545           if leq(k1, k)\r
1546           then\r
1547               Path(Finger).RefOnPage := i;\r
1548               if leq(k, k1)\r
1549               then (*znaleziony*)\r
1550                   result := Itms(i).DataRef;\r
1551                   return\r
1552               fi;\r
1553               PageRef := Itms(i).PageRef;\r
1554               exit;\r
1555             else\r
1556               if i =1\r
1557               then (*klucz k jest mniejszy od wszystkich kluczy\r
1558                                 na rozwazanej stronie*)\r
1559                  PageRef := AuxPage.LessPageRef;\r
1560                  Path(Finger).RefOnPage := 0;\r
1561               fi;\r
1562           fi;\r
1563        od;\r
1564  \r
1565        if PageRef = -1\r
1566        then (*jestesmy w lisciu, nie ma poszukiwanego klucza*)\r
1567           if Path(Finger).RefOnPage = 0\r
1568           then\r
1569               Path(Finger).RefOnPage :=1\r
1570           fi;\r
1571           result := -1;\r
1572           exit (*FindKey*)\r
1573        else\r
1574           Finger := Finger+1\r
1575        fi;\r
1576     od;\r
1577  end FindKey;\r
1578  \r
1579 unit SearchKey: procedure(input k:key;\r
1580                             output DataRef : integer);\r
1581 (*referencja do klucza, ktory jest >=k *)\r
1582 begin\r
1583    DataRef:=FindKey(k);\r
1584    if DataRef=-1\r
1585    then\r
1586      call NextKey(k,DataRef)\r
1587    fi\r
1588 end SearchKey;\r
1589  \r
1590  \r
1591  \r
1592   unit GetPage  :  procedure(PageRef : integer);\r
1593   (* wczytanie do stosu stron strony o adresie  PageRef,\r
1594     chyba, ze strona o tej referencji jest juz w stosie.\r
1595     Poprawienie sciezki i ew. przeslanie do pliku strony\r
1596     wskazanej przez Path(Finger).PageRef o ile byla zmieniana jej tresc *)\r
1597  \r
1598     var AuxRec : arrayof integer;\r
1599   begin\r
1600  \r
1601     if Path(Finger) = none\r
1602     then\r
1603       Path(Finger) := new SearchStep;\r
1604       Path(Finger).Updated := false;\r
1605       Path(Finger).PageRef := PageRef-1; (*chce by byla roznica ponizej *)\r
1606     fi;\r
1607 (*!   if Path(Finger).PageRef <> PageRef\r
1608     then   *)   (*zmiana strony *)\r
1609       if Path(Finger).Updated\r
1610       then (*wyslanie strony na plik, poniewaz byla zmieniana *)\r
1611         AuxRec := PageToRec(StackOfPages(Finger));\r
1612         call fseek(plik, Path(Finger).PageRef);\r
1613         call fput(plik,AuxRec);\r
1614       fi (*updated*);\r
1615       (*wczytanie potrzebnej strony*)\r
1616       call fseek(plik, PageRef);\r
1617       AuxRec := fget(plik);\r
1618       StackOfPages(Finger) := RecToPage(AuxRec);\r
1619       Path(Finger) := new SearchStep;\r
1620       Path(Finger).PageRef := PageRef;\r
1621       Path(Finger).updated := false;\r
1622 (*!    fi  *)\r
1623  \r
1624   end GetPage  ;\r
1625  \r
1626   unit UpdatePage  :  procedure (input AuxItem : Item,\r
1627                                     ItemRef : integer,\r
1628                                                         AuxPage : Page);\r
1629   (* wstaw AuxItem na wskazanej stronie, w miejscu ItemRef +1 *)\r
1630     var  AuxItmArr : arrayof Item,\r
1631          n,i: integer;\r
1632   begin\r
1633     AuxPage.ItemsOnPage, n := AuxPage.ItemsOnPage +1;\r
1634     for i := n  downto ItemRef +2\r
1635     do\r
1636       AuxItmArr :=   AuxPage.ItemsArray;\r
1637       AuxItmArr(i) := AuxItmArr(i-1)\r
1638     od;\r
1639     AuxPage.ItemsArray(ItemRef+1) := AuxItem;\r
1640     Path(Finger).Updated := true;\r
1641   end UpdatePage  ;\r
1642  \r
1643   unit order : function (i1, i2 : Item) : boolean;\r
1644   (*ropzszerzenie porzadku LessOrEqual Leq o badanie DataRef w\r
1645 przypadku gdy klucze sa rowne   *)\r
1646  \r
1647     var k1,k2 :key,\r
1648         n : integer;\r
1649  \r
1650   begin\r
1651     k1 := i1.ky;\r
1652     k2 := i2.ky;\r
1653     if Leq(k2,k1)\r
1654     then (* k2ók1 *)\r
1655       if Leq(k1, k2)\r
1656       then (* k1=k2 *)\r
1657  \r
1658         (* DORADZAMY zbadaj czy k1 = k2? *************************)\r
1659         (* potrzebna inna funkcja EQ? booleowska *****************)\r
1660         (* o odp. wlasnosciach: zwrotnsc,przechodniosc, symetria *)\r
1661         \r
1662         n := i1.DataRef - i2.DataRef;\r
1663         if n=0\r
1664         then (*dwa identyczne klucze o jednakowych referencjach*)\r
1665           raise Signal14\r
1666         fi;\r
1667         result := n<0;\r
1668       else (* k1>k2 *)\r
1669         result := false\r
1670       fi\r
1671     else (*k1<k2 ?*)\r
1672       if not Leq(k1, k2)\r
1673       then\r
1674 (* 16.08.87 ********************************************)\r
1675         (* raise RelacjaNieSpojna *)\r
1676       else      \r
1677         result := true\r
1678       fi        \r
1679     fi\r
1680   end order;\r
1681  \r
1682   unit SearchPage  : procedure (input P : Page, it : Item;\r
1683                                  output NextPageRef, ItemRef : integer);\r
1684   (* szukamy miejsca dla obiektu it na stronie P, NextPageRef\r
1685 jest adresem strony na ktorej mozemy kontynuowac\r
1686 poszukiwania; ItemRef jest numerem obiektu mniejszego od it\r
1687 lub jest rowne 0 gdy nasz obiekt it jest mniejszy\r
1688 od wszystkich obiektow na stronie*)\r
1689  \r
1690      var Itms : arrayof Item,\r
1691          it1 : Item;\r
1692  \r
1693   begin\r
1694     Itms :=P.ItemsArray;\r
1695     for ItemRef  := P.ItemsOnPage  downto  1\r
1696     do\r
1697       it1 := Itms(ItemRef);\r
1698       if order (it1, it)\r
1699       then (*it1<it *)\r
1700         NextPageRef := it1.PageRef;\r
1701         return\r
1702       fi\r
1703     od;\r
1704     (*obiekt it jest mniejszy od wszystkich obiektow na tej\r
1705 stronie*)\r
1706     ItemRef := 0;\r
1707     NextPageRef := P.LessPageRef;\r
1708   end SearchPage ;\r
1709  \r
1710  \r
1711  \r
1712   unit RecToPage  :  function(A: arrayof integer): Page;\r
1713     (*Ta funkcja odczytuje tablice liczb calkowitych i zmienia\r
1714 ja w strone Page. Wykorzystuje sie virtualna funkcje\r
1715 RecToKey.   *)\r
1716     var P: Page,\r
1717         i,j : integer,\r
1718         It : Item;\r
1719   begin\r
1720     P:=new Page;\r
1721     P.ItemsOnPage,j := A(1);\r
1722     P.LessPageRef := A(2);\r
1723     array P.ItemsArray dim (1:PageSize);\r
1724     for i := 1 to  j  (*P.ItemsOnPage*)\r
1725     do\r
1726       It := new Item;\r
1727       It.ky := RecToKey(A, 3+(i-1)*(KeySize+2) ) ;\r
1728       It.PageRef := A(i*(KeySize+2)+1);\r
1729       It.DataRef := A(i*(KeySize+2)+2);\r
1730       P.ItemsArray(i) := It;\r
1731     od(*itemsOnPage*);\r
1732     result :=P\r
1733   end RecToPage ;\r
1734  \r
1735   unit PageToRec : function (P: Page): arrayof integer;\r
1736     (*Funkcja odwrotna do poprzedniej*)\r
1737     var A :  arrayof integer,\r
1738         It:  Item,\r
1739         i :  integer;\r
1740   begin\r
1741     array A dim(1:(2+PageSize*(KeySize+2)));\r
1742     A(1) :=P.ItemsOnPage;\r
1743     A(2) := P.LessPageRef;\r
1744     for i := 1  to P.ItemsOnPage\r
1745     do\r
1746       It:=P.ItemsArray(i);\r
1747     (*  if It = none then writeln(" It w PageToRec jest none");\r
1748                         writeln("ItemsOnPage= ",P.ItemsOnPage,"i= ",i)\r
1749       fi; *)\r
1750       call KeyToRec(It.ky, A, 3+(i-1)*(KeySize+2) );\r
1751        (*O KeyToRec zakladam, ze jest to procedura virtualna,\r
1752 ktora przepisuje klucz ky do tablicy A poczynajac od\r
1753 danego miejsca A(j) do kolejnych KeySize komorek tej\r
1754 tablicy. *)\r
1755       A(i*(KeySize+2)+1) := It.PageRef;\r
1756       A(i*(KeySize+2)+2) := It.DataRef;\r
1757     od;\r
1758     result := A\r
1759   end PageToRec ;\r
1760  \r
1761   unit virtual KeyToRec  :  procedure(ky:Key, A: arrayof integer, j: integer);\r
1762     (*procedura virtualna, ktora przepisuje klucz ky do tablicy\r
1763 A poczynajac od danego miejsca A(j) do kolejnych KeySize\r
1764 komorek tej tablicy. *)\r
1765  \r
1766   begin\r
1767  \r
1768   end KeyToRec ;\r
1769  \r
1770   unit virtual RecToKey : function(A: arrayof integer,  \r
1771                                                         j:integer): Key;\r
1772     (*Funkcja odczytuje KeySize kolejnych komorek z tablicy A\r
1773 poczynajac od A(j) i tworzy z nich klucz   *)\r
1774  \r
1775   begin\r
1776  \r
1777   end RecToKey ;\r
1778  \r
1779   var AuxRec : arrayof integer,\r
1780       akey   :  Key,\r
1781       PageRef : integer;\r
1782  \r
1783 begin (*IndexFile*)\r
1784   (*ustawic wskazowke do IndexFile *)\r
1785   (*zainicjowac Path i StackOfPages*)\r
1786   Finger :=1;\r
1787   array StackOfPages dim(1:TreeHeight);\r
1788   array Path dim (1:TreeHeight);\r
1789   StackOfPages(1) := new Page;\r
1790   StackOfPages(1).ItemsOnPage := 0;\r
1791   StackOfPages(1).LessPageRef := -1;\r
1792   array StackOfPages(1).ItemsArray dim (1: PageSize);\r
1793   Path(1):= new SearchStep;\r
1794   Path(1).PageRef := 1;\r
1795   Path(1).RefOnPage := 0;\r
1796  \r
1797  \r
1798 end IndexFile;\r
1799  \r
1800  \r
1801  \r
1802  \r
1803 begin (*Relation*)\r
1804  \r
1805    end Relation;\r
1806  \r
1807  \r
1808  \r
1809  \r
1810 begin (*obsluga relacji*)\r
1811  \r
1812 end HandlerOfRelations;\r
1813  \r
1814  \r
1815 begin (*to begin odpowiada zewnetrznym : program i end*)\r
1816  \r
1817 pref HandlerOfRelations(4,8,2) block\r
1818  \r
1819 unit Bibliografia   : Relation  class;\r
1820   (*nasza przykladowa relacja *)\r
1821   const autleng=25, tytleng=50, wydleng=15;\r
1822  \r
1823   unit Krotka : Tuple class ;\r
1824     var autor,\r
1825         tytul,\r
1826         wydawca : arrayof char,\r
1827         rok,\r
1828         pozycja : integer;\r
1829   begin\r
1830     array autor dim(1 : autleng);\r
1831     array tytul dim (1 : tytleng);\r
1832     array wydawca dim (1 :wydleng);\r
1833   end Krotka;\r
1834  \r
1835   var ak : Krotka;    (*aktualna krotka*)\r
1836  \r
1837   unit virtual TupleToRec : function (k : Krotka): arrayof\r
1838                                                            integer;\r
1839   var Aux : arrayof integer,\r
1840         AIC : arrayof char,\r
1841         i : integer;\r
1842  \r
1843   begin\r
1844     array Aux dim (1:95);\r
1845     AIC := k.autor;\r
1846     for i := 1 to autleng\r
1847     do\r
1848       Aux(i) := ord(AIC(i));\r
1849       if ord(AIC(i)) = 13\r
1850       then (*Enter  *)\r
1851          exit\r
1852       fi;\r
1853     od;\r
1854     for i := 1 to tytleng\r
1855     do\r
1856        Aux(autleng+i) := ord(k.tytul(i));\r
1857        if ord(k.tytul(i)) = 13\r
1858        then (*Enter *)\r
1859           exit\r
1860        fi;\r
1861     od;\r
1862     for i := 1 to wydleng\r
1863     do\r
1864        Aux(75+i) := ord(k.wydawca(i));\r
1865        if ord(k.wydawca(i)) = 13\r
1866        then (*Enter *)\r
1867           exit\r
1868        fi;\r
1869     od;\r
1870     Aux(91) := k.rok;\r
1871     Aux(92) := k.pozycja;\r
1872     result := Aux;\r
1873   end TupleToRec;\r
1874  \r
1875 unit virtual RecToTuple : function (a: arrayof integer)\r
1876                                                          :Krotka;\r
1877     (*   *)\r
1878    var k:krotka,\r
1879        i:integer;\r
1880 begin\r
1881    k:=new krotka;\r
1882    for i:=1 to autleng\r
1883    do\r
1884       k.autor(i):=chr(a(i));\r
1885       if a(i) = 13\r
1886       then (*koniec tekstu *)\r
1887          exit\r
1888       fi;\r
1889    od;\r
1890    for i:=1 to tytleng\r
1891    do\r
1892       k.tytul(i):=chr(a(autleng+i));\r
1893       if a(autleng+i) = 13\r
1894       then (*koniec tekstu *)\r
1895          exit\r
1896       fi;\r
1897    od;\r
1898    for  i := 1  to wydleng\r
1899    do\r
1900       k.wydawca(i):=chr(a(75+i));\r
1901       if a(75+i) = 13\r
1902       then (*koniec tekstu *)\r
1903          exit\r
1904       fi;\r
1905    od;\r
1906    k.rok:=a(91);\r
1907    k.pozycja:=a(92);\r
1908    result := k\r
1909 end RecToTuple  ;\r
1910  \r
1911 unit DrukujKrotke :  procedure;\r
1912   (*drukuj aktualna krotke *)\r
1913 begin\r
1914   call SetCursor(4,1);\r
1915   writeln("                                        ");\r
1916   writeln("                                        ");\r
1917   writeln("                                        ");\r
1918   writeln("                                        ");\r
1919   call SetCursor(10,1);\r
1920   write("      autor:                              ");\r
1921   call SetCursor(10,14);\r
1922   call Drukuj(ak.autor); writeln;\r
1923   write("      tytul:                              ");\r
1924   call SetCursor(11,14);\r
1925   call Drukuj(ak.tytul); writeln;\r
1926   write("    wydawca:                              ");\r
1927   call SetCursor(12,14);\r
1928   call Drukuj(ak.wydawca); writeln;\r
1929   writeln("rok wydania: ",ak.rok);\r
1930   writeln(" pozycja nr: ",ak.pozycja);\r
1931 end DrukujKrotke ;\r
1932  \r
1933 unit WczytajKrotke :  procedure;\r
1934   (*Czytaj aktualna krotke *)\r
1935 begin\r
1936   call SetCursor(25,1);\r
1937   write("edit tuple, pressing PgDn finishes ");\r
1938  \r
1939   do\r
1940     call SetCursor(4,1);\r
1941     writeln; call Reverse;\r
1942     write("      autor: "); call Normal;\r
1943     call Czytaj(ak.autor); call Reverse;\r
1944     write("      tytul: "); call Normal;\r
1945     call Czytaj(ak.tytul); call Reverse;\r
1946     write("    wydawca: "); call Normal;\r
1947     call Czytaj(ak.wydawca); call Reverse;\r
1948     write("rok wydania: "); call Normal;\r
1949     read(ak.rok); call Reverse;\r
1950     write(" pozycja nr: "); call Normal;\r
1951     readln(ak.pozycja);\r
1952     if inchar = -81 then exit fi;\r
1953   od;\r
1954 end WczytajKrotke ;\r
1955  \r
1956 unit IndeksAutorow : IndexFile class ;\r
1957   (*   *)\r
1958   unit klucz : Key class ;\r
1959     var autor : arrayof char;\r
1960   begin\r
1961     array autor dim (1: autleng );\r
1962  \r
1963   end klucz;\r
1964  \r
1965   unit virtual KeyOf  :  function (k :Krotka) : klucz;\r
1966     (*tworzenie klucza z krotki *)\r
1967   begin\r
1968     result := new klucz;\r
1969     result.autor := copy (k.autor)\r
1970   end KeyOf ;\r
1971  \r
1972   unit virtual Leq : function (k1,k2 : klucz) : boolean;\r
1973     (*porownanie dwu kluczy *)\r
1974     var i: integer;\r
1975   begin\r
1976     result := true;\r
1977  \r
1978  \r
1979  \r
1980     for i := 1 to autleng\r
1981     do\r
1982       if ord(k1.autor(i)) =13\r
1983       then\r
1984         exit\r
1985       else\r
1986         if ord(k2.autor(i)) = 13        \r
1987         then\r
1988           result := false;\r
1989           exit\r
1990         else\r
1991         \r
1992         fi;\r
1993       fi;\r
1994       if ord(k1.autor(i)) = ord(k2.autor(i))\r
1995       then (*rowne*)\r
1996       else\r
1997         if ord(k1.autor(i)) < ord(k2.autor(i))\r
1998         then\r
1999           result := true ;\r
2000         else\r
2001           result := false;\r
2002         fi;\r
2003         exit;\r
2004       fi;\r
2005     od;\r
2006   end Leq ;\r
2007  \r
2008     unit virtual KeyToRec :  procedure(ky:klucz, A: arrayof integer,\r
2009                                                                j: integer);\r
2010        (*procedura virtualna, ktora przepisuje klucz ky do tablicy\r
2011        A poczynajac od danego miejsca A(j) do kolejnych KeySize\r
2012        komorek tej tablicy. *)\r
2013  \r
2014      var i : integer;\r
2015      begin\r
2016        for i := 1 to autleng\r
2017        do\r
2018          A(j+i-1) := ord(ky.autor(i))\r
2019        od;\r
2020      end KeyToRec ;\r
2021  \r
2022      unit virtual RecToKey : function(A: arrayof integer,       \r
2023                                                 j:integer): klucz;\r
2024        (*Funkcja odczytuje KeySize kolejnych komorek z tablicy A\r
2025        poczynajac od A(j) i tworzy z nich klucz   *)\r
2026  \r
2027      var k : klucz;\r
2028      begin\r
2029        k := new klucz;\r
2030        for i := 1 to autleng\r
2031        do\r
2032           k.autor(i) := chr(A(j+i-1))\r
2033        od;\r
2034        result := k\r
2035      end RecToKey ;\r
2036  \r
2037      unit DrukujStrone : procedure (PageRef: integer);\r
2038      var P : Page,\r
2039          j,\r
2040          i : integer,\r
2041          l : klucz,\r
2042          c : char,\r
2043          AuxRec : arrayof integer;\r
2044   begin\r
2045     if PageRef = -1 then  return fi;\r
2046        for i := 1 to TreeHeight\r
2047        do\r
2048         if Path(i) = none then exit fi;\r
2049         if Path(i).updated\r
2050         then\r
2051           call fseek(plik,Path(i).PageRef);\r
2052           call fput(plik,PageToRec(StackOfPages(i)));\r
2053           Path(i).updated := false;\r
2054         fi;\r
2055        od;\r
2056        (*wczytaj strone*)\r
2057        call fseek(plik, PageRef);\r
2058        AuxRec := fget(plik);\r
2059        P := RecToPage(AuxRec);\r
2060        (*drukuj*)\r
2061  \r
2062        writeln("stronaRefNr=",PageRef:4,"  itemow =", P.ItemsOnPage:3);\r
2063        write(" klucze                ");\r
2064        for i := 1 to P.ItemsOnPage\r
2065        do\r
2066           l := P.ItemsArray(i).ky;\r
2067           for j := 1 to 12\r
2068          do\r
2069            c := l.autor(j);\r
2070            if ord(c) = 13\r
2071            then\r
2072              write(' ')\r
2073            else\r
2074              write(c)\r
2075            fi;\r
2076          od;\r
2077        od;\r
2078        writeln;\r
2079        write(" PgRfs",P.LessPageRef:5);\r
2080        for i := 1 to P.ItemsOnPage\r
2081        do\r
2082           write(P.ItemsArray(i).PageRef:12);\r
2083        od;\r
2084        writeln;\r
2085        call DrukujStrone(P.LessPageRef);\r
2086        for i := 1 to P.ItemsOnPage\r
2087        do\r
2088           call DrukujStrone(P.ItemsArray(i).PageRef);\r
2089        od;\r
2090        kill(AuxRec);\r
2091   end DrukujStrone;\r
2092  \r
2093   var akl : klucz;\r
2094  \r
2095   begin (*indeksAutorow*)\r
2096      KeySize := autleng;\r
2097      akl, akey := new klucz;\r
2098      (*  dlugosc rekordu-klucza = 2+(PageSize * (KeySize + 2)); *)\r
2099      if otworz\r
2100      then\r
2101         plik := openfile(unpack("autor.idx"),2+(PageSize * (KeySize + 2)) );\r
2102         (* odczytac strony do StackOfPages *)\r
2103         Path(1).PageRef := INFO(1);\r
2104         Path(1).RefOnPage := 1;\r
2105         call fseek(plik,Path(1).PageRef);\r
2106         AuxRec := fget(plik);\r
2107         StackOfPages(1) := RecToPage(AuxRec);\r
2108         kill(AuxRec);\r
2109      else\r
2110         plik := makefile(unpack("autor.idx"),2+(PageSize * (KeySize + 2)) );\r
2111      fi;\r
2112      return;\r
2113        (* ZAMYKANIE indeksu *)\r
2114        (* strony zmienione ze sciezki sa zapisywane na pliku *)\r
2115      for i := 1 to TreeHeight\r
2116      do\r
2117         if Path(i) = none then exit fi;\r
2118         if Path(i).updated\r
2119         then\r
2120            call fseek(plik,Path(i).PageRef);\r
2121            call fput(plik,PageToRec(StackOfPages(i)));\r
2122            Path(i).updated := false;\r
2123          fi;\r
2124        od;\r
2125        (* ZAPISAC nr rekordu - korzenia *)\r
2126        INFO(1) := Path(1).PageRef;\r
2127        call closefile(plik);\r
2128      end IndeksAutorow ;\r
2129  \r
2130      var IA :IndeksAutorow ;\r
2131  \r
2132      unit IndeksPoz : IndexFile class ;\r
2133   (*   *)\r
2134      unit klucz : Key class ;\r
2135      var poz : integer;\r
2136      begin\r
2137  \r
2138      end klucz;\r
2139  \r
2140      unit virtual KeyOf  :  function (k :Krotka) : klucz;\r
2141         (*tworzenie klucza z krotki *)\r
2142      begin\r
2143        result := new klucz;\r
2144        result.poz := k.pozycja\r
2145      end KeyOf ;\r
2146  \r
2147      unit virtual Leq : function (k1,k2 : klucz) : boolean;\r
2148         (*porownanie dwu kluczy *)\r
2149      begin\r
2150        result := not (k1.poz > k2.poz)\r
2151      end Leq ;\r
2152  \r
2153      unit virtual KeyToRec :  procedure(ky:klucz, A: arrayof integer,\r
2154                                                                 j: integer);\r
2155       (*procedura virtualna, ktora przepisuje klucz ky do tablicy\r
2156        A poczynajac od danego miejsca A(j) do kolejnych KeySize\r
2157        komorek tej tablicy. *)\r
2158  \r
2159     (*   *)\r
2160      var i : integer;\r
2161      begin\r
2162         A(j) := ky.poz;\r
2163      end KeyToRec ;\r
2164  \r
2165      unit virtual RecToKey : function(A: arrayof integer,       \r
2166                                                 j:integer): klucz;\r
2167        (*Funkcja odczytuje KeySize kolejnych komorek z tablicy A\r
2168          poczynajac od A(j) i tworzy z nich klucz   *)\r
2169     (*    *)\r
2170      var k : klucz;\r
2171      begin\r
2172         k := new klucz;\r
2173         k.poz := A(j);\r
2174         result := k\r
2175      end RecToKey ;\r
2176  \r
2177      unit DrukujStrone : procedure (PageRef: integer);\r
2178      var P : Page,\r
2179          i : integer,\r
2180          AuxRec : arrayof integer;\r
2181      begin\r
2182        if PageRef = -1 then  return fi;\r
2183        for i := 1 to TreeHeight\r
2184        do\r
2185          if Path(i) = none then exit fi;\r
2186          if Path(i).updated\r
2187          then\r
2188             call fseek(plik,Path(i).PageRef);\r
2189             call fput(plik,PageToRec(StackOfPages(i)));\r
2190             Path(i).updated := false;\r
2191          fi;\r
2192        od;\r
2193        (*wczytaj strone*)\r
2194        call fseek(plik, PageRef);\r
2195        AuxRec := fget(plik);\r
2196        P := RecToPage(AuxRec);\r
2197        (*drukuj*)\r
2198  \r
2199        writeln("stronaRefNr=",PageRef:4,"  itemow =", P.ItemsOnPage:3);\r
2200        write(" klucze    ");\r
2201        for i := 1 to P.ItemsOnPage\r
2202        do\r
2203           write(P.ItemsArray(i).ky qua klucz.poz:12);\r
2204        od;\r
2205 (* 16.08.87 *******************************************************)\r
2206        writeln;\r
2207        write(" PgRfs",P.LessPageRef:5);\r
2208        for i := 1 to P.ItemsOnPage\r
2209        do\r
2210          write(P.ItemsArray(i).PageRef:12);\r
2211        od;\r
2212        writeln;\r
2213        call DrukujStrone(P.LessPageRef);\r
2214        for i := 1 to P.ItemsOnPage\r
2215        do\r
2216          call DrukujStrone(P.ItemsArray(i).PageRef);\r
2217        od;\r
2218        kill(AuxRec);\r
2219   end DrukujStrone;\r
2220  \r
2221  \r
2222   var akl : klucz;\r
2223  \r
2224   begin (*indeksPozycji*)\r
2225      KeySize := 1;\r
2226      akl, akey := new klucz;\r
2227      (*  plik.reclength := 2+(PageSize * (KeySize + 2)); *)\r
2228      if otworz\r
2229      then\r
2230        plik := openfile(unpack("nrpzycji.idx"),2+(PageSize * (KeySize + 2)));\r
2231        (* odczytac strone-korzen do StackOfPages *)\r
2232  \r
2233        Path(1).PageRef := INFO(2);\r
2234        Path(1).RefOnPage := 1;\r
2235        call fseek(plik,Path(1).PageRef);\r
2236        AuxRec := fget(plik);\r
2237        StackOfPages(1) := RecToPage(AuxRec);\r
2238        kill(AuxRec);\r
2239      else\r
2240        plik := makefile(unpack("nrpzycji.idx"),2+(PageSize * (KeySize + 2)) );\r
2241      fi;\r
2242      return;\r
2243       (* ZAMYKANIE indexu *)\r
2244        for i := 1 to TreeHeight\r
2245        do\r
2246          if Path(i) = none then exit fi;\r
2247          if Path(i).updated\r
2248          then\r
2249             call fseek(plik,Path(i).PageRef);\r
2250             call fput(plik,PageToRec(StackOfPages(i)));\r
2251             Path(i).updated := false;\r
2252          fi;\r
2253        od;\r
2254               (* ZAPISAC nr rekordu - korzenia *)\r
2255               INFO(2) := Path(1).PageRef;\r
2256               call closefile(plik);\r
2257 end IndeksPoz ;\r
2258  \r
2259 var IB :IndeksPoz ;\r
2260  \r
2261 begin (*bibliografia*)\r
2262  \r
2263 if otworz\r
2264 then\r
2265   plik:= openfile(unpack("bibliog.dta"), 95);\r
2266 else\r
2267   plik:= makefile(unpack("bibliog.dta"), 95);\r
2268 fi;\r
2269   ak := new Krotka;\r
2270  (* call IncreaseIndex( new IndeksAutorow); *)\r
2271   array Index dim(1 : 2);\r
2272   Index(1), IA := new IndeksAutorow;\r
2273   Index(2), IB := new IndeksPoz;\r
2274 end Bibliografia ;\r
2275  \r
2276  \r
2277     (*deklaracje pomocnicze programu glownego*)\r
2278      var cha : char,\r
2279          otworz,                (* otwieramy *)\r
2280          otwarta : boolean,  (*czy baza bibliograficzna juz jest otwarta?*)\r
2281          R : Bibliografia,\r
2282          i,j : integer,\r
2283          Rec : arrayof integer;\r
2284  \r
2285   unit Czytaj  :  procedure(a: arrayof char);\r
2286   (*czytaj tablice znakow *)\r
2287   var i,j : integer,\r
2288       cha1: char;\r
2289   begin\r
2290     for i  := 1 to upper(a)\r
2291     do\r
2292       j := inchar;\r
2293       a(i) := chr(j);\r
2294       write(a(i));\r
2295       if j = 13\r
2296       then (*wczytano Enter *)\r
2297         writeln;\r
2298         exit\r
2299       fi;\r
2300     od;\r
2301     if i < upper(a)\r
2302     then\r
2303       a(i+1) := chr(13)\r
2304     else\r
2305       a(upper(a)) := chr(13)\r
2306     fi\r
2307   end Czytaj ;\r
2308  \r
2309   unit Drukuj : procedure (a : arrayof char);\r
2310     (*drukuj tablice znakow jako linijke tekstu *)\r
2311   var i : integer;\r
2312   begin\r
2313     for i := 1 to upper(a)\r
2314     do\r
2315       write(a(i));\r
2316       if ord(a(i)) =13\r
2317       then (*wydrukowano Enter *)\r
2318           exit\r
2319       fi\r
2320     od;\r
2321   end Drukuj ;\r
2322  \r
2323 var INFO : arrayof integer,\r
2324     j1,j2: integer,\r
2325     extrem : boolean,\r
2326     infoplik : Rfile;\r
2327  \r
2328     handlers\r
2329  \r
2330        when Signal13 :\r
2331           call SetCursor(5,1);\r
2332           writeln("Trying to delete an already absent record");\r
2333           return;\r
2334         \r
2335        when Signal11 :\r
2336            call SetCursor(5,1);\r
2337            writeln("osiagnieto element minimalny");\r
2338            extrem := true;\r
2339            return;\r
2340         \r
2341        when Signal12 :\r
2342            call SetCursor(5,1);\r
2343            writeln("osiagnieto element maksymalny");\r
2344            extrem := true;\r
2345            return;      \r
2346     end handlers;\r
2347  \r
2348  \r
2349 begin (*program glowny prefiksowany przez HandlerOfRelations*)\r
2350   (*dane bibliograficzne*)\r
2351   (*wyswietl powitanie*)\r
2352  \r
2353    array INFO dim (1:3);\r
2354    call Reverse;\r
2355    call NewPage;\r
2356    call SetCursor(13,10);\r
2357    (*call Normal;*)\r
2358    (*call Bold;*)\r
2359    write("TOOLBOX dla baz danych");\r
2360    call SetCursor(15,10);\r
2361    write("test 19v.4");\r
2362    call SetCursor(21,10);\r
2363    (*call Normal;*)\r
2364    write("G.Mirkowska, A.Salwicki - Lipiec 1988");\r
2365    call SetCursor(22,10);\r
2366    write("klase FileSystem napisala J.Warpechowska");\r
2367    call SetCursor(23,68);\r
2368    write("press a key");\r
2369    i := inchar;\r
2370    call Normal;\r
2371    call NewPage;\r
2372    writeln; writeln; writeln;\r
2373    write(\r
2374    "Do you wish to use the previously prepared bibliography files?(y/n)?");\r
2375    i := inchar;\r
2376    call Bold;\r
2377    write(chr(i));\r
2378    if i =121\r
2379    then\r
2380      otworz := true;\r
2381      infoplik := openfile(unpack("bibliog.bas"),3);\r
2382      INFO := fget(infoplik);\r
2383    else\r
2384      otworz := false;\r
2385      infoplik := makefile(unpack("bibliog.bas"),3);\r
2386    fi;\r
2387  \r
2388     R :=new Bibliografia;\r
2389     R.FreePlace := Info(3);\r
2390     call NewPage;\r
2391     call Reverse;\r
2392     writeln(\r
2393  "i-INSERT  d-DELETE  s-SEARCH  m-MINMAX  t-TYPE  n-NEXT  p-PREVIOUS q-QUIT");\r
2394  \r
2395     writeln(\r
2396  "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ");\r
2397     writeln;\r
2398     call SetCursor(23,1);\r
2399     call Normal;\r
2400     writeln(\r
2401  "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ");\r
2402     writeln(\r
2403  "                                                                          ");\r
2404     call Blink;\r
2405     write(\r
2406  "                                                         make a choice    ");\r
2407     call Normal;\r
2408     call Bold;\r
2409     call SetCursor(1,76);\r
2410     cha := chr(inchar);\r
2411     writeln(cha);\r
2412     call SetCursor(25,1);\r
2413     write(\r
2414  "                                                                        ");\r
2415     call SetCursor(5,1);\r
2416   do\r
2417     case cha\r
2418  \r
2419       when 'q' : (* quit*)\r
2420         call Blink;\r
2421         call SetCursor(24,7);\r
2422         writeln("end of program test19-4,  CLOSING FILES");\r
2423         call Normal;\r
2424         call SetCursor(5,1);\r
2425         call closefile(R.plik);\r
2426         attach(R.IA);\r
2427         attach(R.IB);\r
2428         INFO(3) := R.FreePlace;\r
2429         call frewind(infoplik);\r
2430         call fput(infoplik,INFO);\r
2431         call closefile(infoplik);\r
2432         call NewPage;\r
2433         call endrun;\r
2434         (* end quit *)\r
2435         \r
2436       when 'i': (*read a tuple and INSERT*)\r
2437         call R.WczytajKrotke;\r
2438         call SetCursor(24,7);\r
2439         call Blink;\r
2440         call Reverse;\r
2441         write("inserting the tuple");\r
2442         call R.Insert(R.ak);\r
2443         j1,j2 := 1;\r
2444         call Normal;\r
2445         call SetCursor(24,7);\r
2446         write("                                                      ");\r
2447         \r
2448       when 't' : (*type*)\r
2449         call Normal;\r
2450         call Reverse;\r
2451         call SetCursor(3,38);\r
2452         write("print: r-RELATION or b-BTREE ");\r
2453         cha := chr(inchar);\r
2454         call Normal;\r
2455         writeln(cha);\r
2456         if cha = 'r'\r
2457         then (*printing relation*)\r
2458           call SetCursor(24,4);\r
2459           write(" press SPACEBAR for next record");\r
2460           call SetCursor(5,1);\r
2461           call fseek(R.plik,1);\r
2462           while not feof(R.plik)\r
2463           do\r
2464             Rec := fget(R.plik);\r
2465             R.ak := R.RecToTuple(Rec);\r
2466             call R.DrukujKrotke;\r
2467             call SetCursor(24,19);\r
2468             i:=inchar;\r
2469           od;\r
2470         else (*printing Btree*)\r
2471           call SetCursor(4,30);\r
2472           call Reverse;\r
2473           write("select index: a-AUTHORS or p-POSITIONS ");\r
2474           call Normal;\r
2475           cha := chr(inchar);\r
2476           writeln(cha);\r
2477           call SetCursor(5,1);\r
2478          if cha = 'p'\r
2479          then\r
2480            call R.IB.DrukujStrone(R.IB.Path(1).PageRef);\r
2481          else\r
2482            call R.IA.DrukujStrone(R.IA.Path(1).PageRef);\r
2483          fi;\r
2484  \r
2485        fi (*koniec drukuj*);\r
2486  \r
2487    when 's': (*search for a tuple*)\r
2488      call SetCursor(3,19);\r
2489      call Reverse;\r
2490      write(" searching tuple (t)? or key (k)? ");\r
2491      cha := chr(inchar);\r
2492         writeln(cha);\r
2493         call Normal;\r
2494      if cha = 't'\r
2495      then (*give a tuple *)\r
2496        call SetCursor(5,1);\r
2497        call R.WczytajKrotke;\r
2498        Rec := R.TupleToRec(R.ak);\r
2499         call SetCursor(24,7);\r
2500         call Blink;\r
2501         call Reverse;\r
2502         write("searching the tuple");\r
2503  \r
2504        call R.FindRec(Rec, i);\r
2505  \r
2506         call Normal;\r
2507         call SetCursor(24,7);\r
2508         write("                                             ");\r
2509        if i = -1\r
2510        then (*  *)\r
2511            writeln(" the tuple not found");\r
2512        else (*  *)\r
2513            writeln(" position of the tuple in the datafile = ",i);\r
2514            (* call fseek(R.plik, i);\r
2515            Rec := fget(R.plik);\r
2516            R.ak := R.RecToTuple(rec);\r
2517            call R.DrukujKrotke; *)\r
2518       fi;\r
2519      else (*'k'  *)\r
2520        if cha ='k'\r
2521        then (*searching in the authors or position index*)\r
2522          call SetCursor(4,19);\r
2523          call Reverse;\r
2524          write("which index: authors(a)? or positions(p)?  ");\r
2525          cha := chr(inchar);\r
2526          writeln(cha);\r
2527          call Normal;   \r
2528          if cha = 'a'\r
2529          then\r
2530            i := 1;\r
2531            call SetCursor(5,1);\r
2532            write(" autor:  ");\r
2533            call Czytaj(R.IA.akl.autor);\r
2534         \r
2535            j1 := R.IA.Findkey(R.IA.akl);\r
2536            if j1<> -1\r
2537            then (*znaleziono  *)\r
2538              call SetCursor(24,7);\r
2539              writeln("tuple found on position = ",j1);\r
2540              call fseek(R.plik, j1);\r
2541              Rec := fget(R.plik);\r
2542              R.ak := R.RecToTuple(Rec);\r
2543              call R.DrukujKrotke;\r
2544            else (*nie znaleziono *)\r
2545              call SetCursor(24,7);\r
2546              writeln(" tuple not found");\r
2547            fi\r
2548          else (*zakladamy cha ='p'*)\r
2549            i := 2;\r
2550            call SetCursor(5,1);\r
2551            write(" position nr:  ");\r
2552            read(R.IB.akl.poz);\r
2553            j2 := R.Index(i).Findkey(R.IB.akl);\r
2554            if j2<> -1\r
2555            then (*znaleziono  *)\r
2556              call SetCursor(24,7);\r
2557              write("tuple found on position = ",j2);\r
2558              call fseek(R.plik, j2);\r
2559              Rec := fget(R.plik);\r
2560              R.ak := R.RecToTuple(rec);\r
2561              call SetCursor(6,1);\r
2562              call R.DrukujKrotke;\r
2563            else (*nie znaleziono *)\r
2564              call SetCursor(24,7);\r
2565              writeln(" tuple not found");\r
2566            fi ;\r
2567          fi (*wyboru klucza*);\r
2568        fi (*cha ='c'*)\r
2569      fi (*when 's'*);\r
2570  \r
2571  \r
2572  \r
2573    when 'p': (*show the previous tuple*)\r
2574  \r
2575          call SetCursor(4,19);\r
2576          call Reverse;\r
2577          write("which index: authors(a)? or positions(p)?  ");\r
2578          cha := chr(inchar);\r
2579                 writeln(cha);\r
2580          call Normal;   \r
2581          if cha = 'a'\r
2582          then\r
2583             if j1>0\r
2584             then (*aktualna krotka jest okreslona *)\r
2585               call R.Index(1).PrevKey(R.IA.akl,j1);\r
2586               if extrem\r
2587               then\r
2588                 extrem := false;\r
2589                 j1 :=0;\r
2590                 R.IA.akl := R.IA.new klucz;\r
2591               else\r
2592                 call SetCursor(24,7);\r
2593                 write("tuple found on position = ",j1);\r
2594                 call fseek(R.plik, j1);\r
2595                 Rec := fget(R.plik);\r
2596                 R.ak := R.RecToTuple(Rec);\r
2597                 call SetCursor(6,1);\r
2598                 call R.DrukujKrotke;\r
2599               fi;\r
2600            else (*  *)\r
2601              call SetCursor(24,7);\r
2602              write("no key has been located yet");\r
2603            fi;\r
2604          else\r
2605             if j2>0\r
2606             then (*aktualna krotka jest okreslona *)\r
2607               call R.Index(2).PrevKey(R.IB.akl,j2);\r
2608               if extrem\r
2609               then\r
2610                 extrem := false;\r
2611               else\r
2612                 call SetCursor(24,7);\r
2613                 write("tuple found on position = ",j2);\r
2614                 call fseek(R.plik, j2);\r
2615                 Rec := fget(R.plik);\r
2616                 R.ak := R.RecToTuple(Rec);\r
2617                 call SetCursor(6,1);\r
2618                 call R.DrukujKrotke;\r
2619               fi;\r
2620            else (*  *)\r
2621              call SetCursor(24,7);\r
2622              writeln("no key has been located yet");\r
2623            fi;\r
2624         fi (* prev *);\r
2625  \r
2626  \r
2627    when 'm': (*min or max*)\r
2628      call Reverse;\r
2629      call SetCursor(3,25);\r
2630      write("searching index of: authors(a)? or positions(p)?");\r
2631      cha := chr(inchar);\r
2632                 call Normal;\r
2633                 writeln(cha);\r
2634      if cha ='a'\r
2635      then\r
2636        call Reverse;\r
2637        call SetCursor(4,25);\r
2638        write("searching index of authors: min(i)? or max(x)?");\r
2639        cha := chr(inchar);\r
2640            call Normal;\r
2641            writeln(cha);\r
2642         call SetCursor(5,1);\r
2643         if cha = 'i'\r
2644         then\r
2645             call R.IA.MinKey(R.IA.akl, j1);\r
2646             call SetCursor(24,7);\r
2647             writeln(" min key found on position = ",j1);\r
2648             call fseek(R.plik, j1);\r
2649             Rec := fget(R.plik);\r
2650             R.ak := R.RecToTuple(Rec);\r
2651             call SetCursor(6,1);\r
2652             call R.DrukujKrotke;\r
2653           else\r
2654             call R.IA.MaxKey(R.IA.akl, j1);\r
2655             call SetCursor(24,7);\r
2656             writeln("max key found on position = ",j1);\r
2657             call fseek(R.plik, j1);\r
2658             Rec := fget(R.plik);\r
2659             R.ak := R.RecToTuple(Rec);\r
2660             call SetCursor(6,1);\r
2661             call R.DrukujKrotke;\r
2662        fi;\r
2663      else (*wg pozycji*)\r
2664        call Reverse;\r
2665        call SetCursor(4,25);\r
2666        write("searching index of positions: min(i)? or max(x)?");\r
2667        cha := chr(inchar);\r
2668        call Normal;\r
2669        writeln(cha);\r
2670        call SetCursor(24,7);\r
2671        if cha = 'i'\r
2672        then\r
2673             call R.IB.MinKey(R.IB.akl, j2);\r
2674             writeln("tuple found on position = ",j2);\r
2675             call fseek(R.plik, j2);\r
2676             Rec := fget(R.plik);\r
2677             R.ak := R.RecToTuple(Rec);\r
2678             call SetCursor(6,1);\r
2679             call R.DrukujKrotke;\r
2680           else\r
2681             call R.IB.MaxKey(R.IB.akl, j2);\r
2682             writeln("tuple found on position = ",j2);\r
2683             call fseek(R.plik, j2);\r
2684             Rec := fget(R.plik);\r
2685             R.ak := R.RecToTuple(Rec);\r
2686             call SetCursor(6,1);\r
2687             call R.DrukujKrotke;\r
2688       fi;\r
2689      fi;  (* end of minmax utility *)\r
2690  \r
2691  \r
2692    when 'n': (*show the next tuple*)\r
2693          call SetCursor(4,19);\r
2694          call Reverse;\r
2695          write("which index: authors(a)? or positions(p)?  ");\r
2696          cha := chr(inchar);\r
2697          writeln(cha);\r
2698          call Normal;   \r
2699          call SetCursor(24,7);\r
2700          if cha = 'a'\r
2701          then\r
2702             if j1>0\r
2703             then (*aktualna krotka jest okreslona *)\r
2704               call R.Index(1).NextKey(R.IA.akl,j1);\r
2705               if extrem\r
2706               then\r
2707                 extrem := false;\r
2708               else\r
2709                 writeln("tuple found on position = ",j1);\r
2710                 call fseek(R.plik, j1);\r
2711                 Rec := fget(R.plik);\r
2712                 R.ak := R.RecToTuple(Rec);\r
2713                 call SetCursor(6,1);\r
2714                 call R.DrukujKrotke;\r
2715               fi;\r
2716            else (*  *)\r
2717              writeln("no key has been located yet");\r
2718            fi;\r
2719          else\r
2720             if j2>0\r
2721             then (*aktualna krotka jest okreslona *)\r
2722               call R.Index(2).NextKey(R.IB.akl,j2);\r
2723               if extrem\r
2724               then\r
2725                 extrem := false;\r
2726               else\r
2727                 writeln("tuple found on position = ",j2);\r
2728                 call fseek(R.plik, j2);\r
2729                 Rec := fget(R.plik);\r
2730                 R.ak := R.RecToTuple(Rec);\r
2731                 call SetCursor(6,1);\r
2732                 call R.DrukujKrotke;\r
2733               fi;\r
2734            else (*  *)\r
2735              writeln("no key has been located yet");\r
2736            fi;\r
2737         fi (*Next*);\r
2738  \r
2739    when 'd': (*delete the actual tuple*)\r
2740      call Reverse;\r
2741      call SetCursor(3,25);\r
2742      write("from index of: authors(a)? or positions(p)?");\r
2743      cha := chr(inchar);\r
2744      call Normal;\r
2745      writeln(cha);\r
2746  \r
2747      if cha ='a'\r
2748      then (* ustawic aktualna krotke*)\r
2749  \r
2750      else\r
2751  \r
2752      fi;\r
2753  \r
2754      call SetCursor(25,4);\r
2755      call Blink;\r
2756      call Reverse;\r
2757      write("DELETING the actual tuple");\r
2758      call R.Delete(R.ak);\r
2759  \r
2760  \r
2761    otherwise\r
2762       call SetCursor(25,4);\r
2763       write("REPEAT")\r
2764    esac;\r
2765  \r
2766     call Normal;\r
2767     call SetCursor(25,1);\r
2768     write("                                           ");\r
2769     call Blink;\r
2770     call Reverse;\r
2771     call SetCursor(25,60);\r
2772     write("press a key");\r
2773     call Normal;\r
2774     call Bold;\r
2775     call SetCursor(1,76);\r
2776     write(chr(32));\r
2777     i:=inchar;\r
2778     call Normal;        \r
2779     call SetCursor(3,1);\r
2780     writeln(\r
2781  "                                                                         ");\r
2782     writeln(\r
2783  "                                                                         ");\r
2784     writeln(\r
2785  "                                                                         ");\r
2786     writeln(\r
2787  "                                                                         ");\r
2788     writeln(\r
2789  "                                                                         ");\r
2790     writeln(\r
2791  "                                                                         ");\r
2792     writeln(\r
2793  "                                                                         ");\r
2794     writeln(\r
2795  "                                                                         ");\r
2796     writeln(\r
2797  "                                                                         ");\r
2798     writeln(\r
2799  "                                                                         ");\r
2800     writeln(\r
2801  "                                                                         ");\r
2802     writeln(\r
2803  "                                                                         ");\r
2804     call SetCursor(24,1);\r
2805     writeln(\r
2806  "                                                                         ");\r
2807     write(\r
2808  "                                                                         ");\r
2809  \r
2810     call Normal;\r
2811     call Blink;\r
2812     call Reverse;\r
2813     call SetCursor(25,60);\r
2814     write("make your choice");\r
2815     call Normal;\r
2816     call Bold;\r
2817     call SetCursor(1,76);\r
2818     write(chr(32));\r
2819     i := inchar;\r
2820     cha := chr(i);\r
2821     call SetCursor(1,76);\r
2822     writeln(chr(i));\r
2823     call SetCursor(25,60);\r
2824     write("                    ");\r
2825     call SetCursor(5,1);\r
2826   od\r
2827  end\r
2828 end Test19;\r
2829  \r