home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / STAY50.ZIP / FLISTU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-11-28  |  16.6 KB  |  341 lines
  1.  
  2. {$I direct.inc}
  3. {───────────────────────────────────────────────────────────────────────────}
  4. {  FLISTU.PAS      File list unit                                           }
  5. {                                                                           }
  6. {  Copyright (C) 1988 Lane H.Ferris  All Rights Reserved                    }
  7. {───────────────────────────────────────────────────────────────────────────}
  8. {                           Dinsaurs live                                   }
  9. {───────────────────────────────────────────────────────────────────────────}
  10.   unit FLISTU  ;
  11.   {────────────────────────────────────────────────────────────────────────}
  12.                                interface
  13.   {────────────────────────────────────────────────────────────────────────}
  14.  
  15.   type
  16.     filenamestr = string[64] ;
  17.  
  18.     Function  FLopen  (pFilename : filenamestr ) : integer ;
  19.     Procedure FLclose (pFilename : filenamestr )    ;
  20.     Procedure FLgetNr (pLineNr :word; var Strptr:string ) ;
  21.  
  22.   {────────────────────────────────────────────────────────────────────────}
  23.                               implementation
  24.   {────────────────────────────────────────────────────────────────────────}
  25.   uses macros   ,
  26.        SR50subs ,
  27.        sr50 {debugging only}     ;
  28.  
  29.    type
  30.  
  31.     SeekLstptr    = ^SeekLstType ;
  32.     SeekLstType   = record           { Seek Chain Entry          }
  33.       SeekLink    : SeekLstptr   ;   { addr of next entry or nil }
  34.       SeekLineNr  : word         ;   { Line Nr at this location  }
  35.       SeekLastNr  : word         ;   { Last Line number in buf   }
  36.       SeekFileLoc : longint      ;   { Byte location within file }
  37.       Seektextlth : word         ;   { actual text bytes in buf  }
  38.     {SeekLstType}   end          ;
  39.     FLbitmap      = array[0..511] of byte ;
  40.  
  41.    const
  42.     FLhasopenfile : boolean = false ;
  43.     _4K           = 4*1024          ;        { Blk file buffer size   }
  44.     crlf          : word    = $0A0D ;        { word of cr lf          }
  45.    var
  46.     FLfilename     : filenamestr    ;        { last opened file       }
  47.     FLinfile       : file           ;        { File of byte           }
  48.     FLfilesize     : longint        ;        { Nr bytes in file       }
  49.     FlBufptr       : pointer        ;        { ptr to file buffer     }
  50.     FLmapptr       : ^FLbitmap      ;        { 1 bit for each txtrec  }
  51.     FLbytesinbuf   : word           ;        { bytes in blk buffer    }
  52.     SeekLstAnchor  : SeekLstPtr     ;        { Anchor for Seek list   }
  53.     BufSeekLst     : SeekLstptr     ;        { List represented in buf}
  54.   {────────────────────────────────────────────────────────────────────────}
  55.   {                           SetLastLineNr                                }
  56.   {────────────────────────────────────────────────────────────────────────}
  57.   {   count down the buffer for crlf and return  last line number found    }
  58.   {   set a bit in a large bitstring to indicate where a line exists       }
  59.   {────────────────────────────────────────────────────────────────────────}
  60.    Procedure SetLastLineNr  (pLstptr : SeekLstptr )   ;
  61.     var
  62.      locptr     :SeekLstptr ;
  63.      txtlines   :word       ;
  64.      txtptr     :pointer    ;
  65.      Mapbyteptr :^byte      ;
  66.      i,j        :word       ;
  67.     begin
  68.       locptr   := pLstptr  ;
  69.       txtptr   := FLbufptr ;
  70.       txtlines := 0        ;
  71.       pLstptr^.SeekTextlth := 0 ;
  72.       fillchar(FLmapptr^,                   { say no text with crlf    }
  73.                sizeof(FLmapptr^),0) ;
  74.       FLmapptr^[0] := $80           ;       { set bit for first record }
  75.       for i := 0 to FLbytesinbuf do begin   { scan for more records    }
  76.         if word(txtptr^) = crlf then begin
  77.           inc(txtlines)  ;
  78.           pLstptr^.Seektextlth := i+2 ;
  79.           j := i+2 ;                    { beginning of next txt rec }
  80.           Mapbyteptr := ptr(vec(FLmapptr).seg,vec(FLmapptr).ofs+(j DIV 8)) ;
  81.           Mapbyteptr^ := Mapbyteptr^ or ($80 shr (j MOD 8)) ; { set bit }
  82.           end {if word..} ;
  83.         incptr(txtptr,1) ;
  84.         end              ;
  85.       pLstptr^.SeeklastNr  := pLstptr^.SeekLineNr+txtlines-1 ;
  86.     end { Procedure SetLastLineNr } ;
  87.   {────────────────────────────────────────────────────────────────────────}
  88.   {                           FLclose                                      }
  89.   {────────────────────────────────────────────────────────────────────────}
  90.    Procedure FLclose(pFilename : filenamestr )   ;
  91.     var
  92.      seekptr : Seeklstptr ;
  93.     begin
  94.       close(FLinfile)  ;
  95.       if IOresult <> 0 then
  96.         Errormsg(warnlevel, 'FLopen cannot close '+ pfilename ) ;
  97.       while SeekLstAnchor <> nil do            { free all seeklist entries }
  98.        begin
  99.        seekptr := SeekLstAnchor^.seeklink ;
  100.        dispose(SeekLstAnchor)             ;
  101.        SeekLstAnchor := seekptr           ;
  102.        end {while..};
  103.       freemem(FLbufptr,_4K)               ;  { memory for Block file buf }
  104.       freemem(FLmapptr,sizeof(Flmapptr^)) ;  { memory for txtrec bitmap  }
  105.       FLhasopenfile := false        ;
  106.     end {FLclose}      ;
  107.   {────────────────────────────────────────────────────────────────────────}
  108.   {                           FLopen                                       }
  109.   {────────────────────────────────────────────────────────────────────────}
  110.    Function FLopen  (pFilename : filenamestr )   : integer ;
  111.     var
  112.      Openresult : integer ;
  113.     begin
  114.       {$I-}
  115.       if FLhasopenfile then
  116.                 FLclose(FLFilename) ;    { close previous file }
  117.       FLfilename := pFilename       ;
  118.       assign( FLinfile, pFilename ) ;    { open new file       }
  119.       reset ( FLinfile,1 )          ;
  120.       {$I+}
  121.       Openresult := IOresult        ;
  122.       FLopen := Openresult            ;
  123.       if Openresult <> 0 then begin
  124.          Errormsg(warnlevel, 'FLopen: cannot open '+pFilename ) ;
  125.          exit                       ;
  126.          end {if ioresult}          ;
  127.       FLhasopenfile := true         ;
  128.       FLfilesize    := filesize(FLinfile) ;
  129.       If Maxavail < _4K+512 then begin
  130.          errormsg(warnlevel,'FLopen: Heap overflow') ;
  131.          FlOpen := 203 ; exit ;
  132.          end ;
  133.       getmem(FLbufptr,_4K)          ;  { memory for Block file buf }
  134.       getmem(FLmapptr,                 { memory for txtrec bitmap  }
  135.                  sizeof(FLmapptr^)) ;
  136.       fillchar(FLmapptr^,
  137.                sizeof(FLmapptr^),0) ;  { say no text with crlf     }
  138.       if FLbufptr = nil then begin
  139.         Errormsg(warnlevel, 'FLopen: no memory for File buffer') ;
  140.         FLclose(Flfilename)         ;
  141.         FLhasopenfile := false      ;
  142.         exit                        ;
  143.       end {if nil..}                ;
  144.                                        { prime the input buffer }
  145.       Blockread(FLinfile,FLbufptr^,_4k,Flbytesinbuf) ;
  146.       new(SeekLstAnchor)            ;  { anchor list of seek locs }
  147.        with SeekLstAnchor^ do begin
  148.          SeekLink    := nil      ;
  149.          SeekLineNr  := 1        ;
  150.          SeekFileloc := 0        ;
  151.          SetLastLineNr(SeekLstAnchor); { scan and set last line Nr }
  152.        end {with SeekLstAnchr}   ;
  153.       BufSeekLst   := SeekLstAnchor ;  { Current List in buffer    }
  154.  
  155.     end {Procedure FLopen} ;
  156.  
  157.   {────────────────────────────────────────────────────────────────────────}
  158.   {                           FLbufread                                    }
  159.   {────────────────────────────────────────────────────────────────────────}
  160.   {         Reads another buffer of text from the physical file            }
  161.   {────────────────────────────────────────────────────────────────────────}
  162.    Procedure FLbufread  (pLineNr : word )   ;
  163.     var
  164.      locptr : SeekLstptr ;
  165.      done   : boolean    ;
  166.     begin
  167.       locptr := SeekLstAnchor ;
  168.       done   := false         ;
  169.  
  170.       while
  171.         (locptr^.SeekLink <> nil) and
  172.         (NOT done) do                     { search SeekLine list to find    }
  173.         with locptr^ do                   { lower linenumber than requested }
  174.         if SeekLink^.SeekLineNr           { parameter line number           }
  175.            > pLineNr then done := true
  176.            else locptr := SeekLink    ;
  177.                                           { locptr now has low linenumber  }
  178.       if locptr^.Seektextlth = 0 then     { Check for End of file          }
  179.           begin
  180.           BufSeekLst := locptr ;
  181.           exit ; end           ;
  182.  
  183.       if locptr^.SeekLastNr >= pLineNr
  184.         then {ok}                         { pLineNr is within this buffer }
  185.         else begin                        { else have to read forward     }
  186.           new(locptr^.SeekLink) ;         { allocate another list entry   }
  187.           locptr^.seeklink^ := Locptr^ ;  { fill in the Seeklist entry    }
  188.           locptr := locptr^.seeklink   ;  { point to new seeklist entry   }
  189.           locptr^.seeklink := nil      ;
  190.           locptr^.SeekLineNr  := locptr^.SeekLastNr+1 ; { next file line Nr }
  191.           locptr^.SeekFileLoc := Locptr^.SeekFileloc    { Seek file byte from.. }
  192.                               + Locptr^.SeekTextlth   ; { last seek + full lines}
  193.         end {else begin} ;
  194.          { VM386 bug: 06 error if directory is changed }
  195.         Seek(FLinfile,locptr^.SeekFileLoc) ;
  196.         unfreeze;
  197.         if IOresult <> 0 then
  198.             Errormsg(warnlevel, 'FLread: seek error in '+FLFilename ) ;
  199.  
  200.         Blockread(FLinfile,FLbufptr^,_4k,FLbytesinbuf) ;
  201.         SetLastLineNr(locptr)       ;    { scan and set last line Nr }
  202.         BufSeekLst   := locptr      ;    { current SeekLst in buffer }
  203.     end { Procedure FLbufread } ;
  204.    {────────────────────────────────────────────────────────────────────────}
  205.    {                             BitScanOfs                                 }
  206.    {────────────────────────────────────────────────────────────────────────}
  207.    {   bitcount := BitScanofs(FLmapptr^,size(FLmapptr^),bitcount) ;         }
  208.    {        scans a large bit string and returns position of next bit       }
  209.    {────────────────────────────────────────────────────────────────────────}
  210.    Function BitScanOfs(BitMapPtr : pointer;
  211.                        BitMapsize,bitcount :word) :word ;
  212.      Begin
  213.      Inline(
  214.   $29/$D2                {     sub    dx,dx              ;}
  215.   /$8B/$86/>BITCOUNT     {     mov    ax,[bp+>bitcount]  ; position of last bit returned}
  216.   /$B9/$08/$00           {     mov    cx,8               ;}
  217.   /$F7/$F1               {     div    cx                 ; position of byte last returned}
  218.   /$89/$D1               {     mov    cx,dx              ; save bitpos MOD 8}
  219.   /$89/$C3               {     mov    bx,ax              ; save offset to byte}
  220.   /$C4/$BE/>BITMAPPTR    {     les    di,[bp+>BitMapPtr] ; pointer to full bitstring}
  221.   /$01/$DF               {     add    di,bx              ; point to byte}
  222.   /$26                   {     es:                       ;}
  223.   /$FF/$35               {     push   [di]               ; save the current byte}
  224.   /$57                   {     push   di                 ; save the ofs to it}
  225.   /$B0/$FF               {     mov    al,$FF             ;}
  226.   /$D2/$E8               {     shr    al,cl              ; 0 bits ahead/1 bits behind old bit}
  227.   /$26                   {     es:                       ;}
  228.   /$20/$05               {     and    0[di],al           ; kill the bit last returned}
  229.   /$29/$C0               {     sub    ax,ax              ; scan for a byte containing a bit}
  230.   /$8B/$8E/>BITMAPSIZE   {     mov    cx,[bp+>BitMapsize];}
  231.   /$F3/$AE               {     repe   scasb              ; repeat while equal to zero}
  232.   /$4F                   {     dec    di                 ; set pointer to last byte}
  233.   /$26                   {     es:                       ;}
  234.   /$8A/$1D               {     mov    bl,0[di]           ; fetch byte}
  235.   /$2B/$BE/>BITMAPPTR    {     sub    di,[bp+>BitMapPtr] ; fetch byte count scanned}
  236.   /$29/$D2               {     sub    dx,dx              ;}
  237.   /$89/$F8               {     mov    ax,di              ;}
  238.   /$B9/$08/$00           {     mov    cx,8               ;}
  239.   /$F7/$E1               {     mul    cx                 ; now have bit count}
  240.                          {                               ; now add bits in the stop byte}
  241.   /$D0/$E3               {L1:  sal    bl,1               ; shift out any bit that may be there}
  242.   /$72/$03               {     jc     L2                 ; carry if bit is shifted out}
  243.   /$40                   {     inc    ax                 ; count the non-bit}
  244.   /$E2/$F9               {     loop   L1                 ; shift until we find the bit}
  245.   /$5F                   {L2:  pop    di                 ; replace the modified bit pattern}
  246.   /$26                   {     es:                       ;}
  247.   /$8F/$05               {     pop    [di]               ;}
  248.   /$89/$46/$FE           {     mov    [bp-2],ax          ; stow the function return value}
  249.             ) ;
  250.    End {BitScanOfs} ;
  251.   {────────────────────────────────────────────────────────────────────────}
  252.   {                           MaptoBufofs                                  }
  253.   {────────────────────────────────────────────────────────────────────────}
  254.   {                Search for a bit in the buffer bit map which            }
  255.   {          represents this line number. Return its offset in buffer      }
  256.   {────────────────────────────────────────────────────────────────────────}
  257.    Function MaptoBufofs (pLineNr :word) :word ;
  258.     var
  259.      i        :word    ;
  260.      bitcount :word    ;
  261.      maxbits  :word    ;
  262.     Begin
  263.  
  264.       { scan the bit map until we find pLineNr bit }
  265.       { there is always at least one bit, viz, the first line in buffer bit }
  266.  
  267.       i        := BufSeekLst^.SeekLineNr-1 ; { first lineNr in this buffer }
  268.       bitcount := 0                        ;
  269.       maxbits  := sizeof(FLmapptr^)*8      ; { number of slots in bitmap }
  270.       MaptoBufofs := 0                     ;
  271.       REPEAT
  272.        bitcount := BitScanofs(FLmapptr,sizeof(FLmapptr^),bitcount) ;
  273.        if bitcount <= maxbits then inc(i) ;
  274.        if i >= pLineNr then begin
  275.          MaptoBufofs := bitcount   ; { a bit displacement and a byte }
  276.          exit                      ; { displacement are equivalent   }
  277.          end                       ;
  278.        inc(bitcount)               ; { dont read old bit again }
  279.       UNTIL (bitcount >= maxbits)  ;
  280.  
  281.     End { MaptoBufofs } ;
  282.   {────────────────────────────────────────────────────────────────────────}
  283.   {                           FLgetNr                                      }
  284.   {────────────────────────────────────────────────────────────────────────}
  285.   {                Search for Line Nr in current buffer                    }
  286.   {          Search for Line number , return actual line nr found          }
  287.   {────────────────────────────────────────────────────────────────────────}
  288.    Procedure FLgetNr  (pLineNr :word; var Strptr:string ) ;
  289.     var
  290.      Seekptr : SeekLstptr ;
  291.      Hdptr   : pointer    ;
  292.      Edptr   : pointer    ;
  293.      found   : boolean    ;
  294.      Outstr  : string absolute Strptr ;
  295.      thisnr  : word       ;
  296.      txtlth  : word       ;
  297.  
  298.     begin
  299.       Seekptr := BufSeekLst ;
  300.       found   := false      ;
  301.  
  302.       while NOT found do begin
  303.          if ((pLineNr >= seekptr^.SeekLineNr)  { read another buffer when   }
  304.                  and                           { line nr not in current buf }
  305.              (pLineNr <= seekptr^.SeekLastNr))
  306.           then found := true ;
  307.          if NOT found then begin
  308.            FLbufread(pLineNr)    ;
  309.            seekptr := BufSeekLst ;
  310.          end {if..}              ;
  311.          if seekptr^.seektextlth = 0        { check for end of file      }
  312.              then found := true  ;
  313.       end {while}                ;
  314.  
  315.       Hdptr := FlBufptr        ;            { search for desired line Nr    }
  316.       Edptr := Hdptr           ;            { search for a its bit in map   }
  317.       thisnr := seekptr^.SeekLineNr ;
  318.  
  319.       incptr(Hdptr, MaptoBufofs(pLineNr   )) ;
  320.       incptr(Edptr, MaptoBufofs(pLineNr+1 )) ;
  321.       txtlth := ptrdiff(Edptr,Hdptr)     ;
  322.       if txtlth > 255 then txtlth := 255 ;
  323.  
  324.       Outstr[0] := char(txtlth) ;
  325.       move(Hdptr^,Outstr[1],txtlth) ;
  326.  
  327.       if txtlth > 0 then {found ok}   { return ptr if LineNr found }
  328.         else begin                    { else return EOF indication }
  329.           str(seekptr^.SeekLastNr,OutStr) ;
  330.           Outstr := #26+Outstr            ;
  331.         end ;
  332.  
  333.     end { Procedure FLgetNr } ;
  334.   {────────────────────────────────────────────────────────────────────────}
  335.   {                        initialization                                  }
  336.   {────────────────────────────────────────────────────────────────────────}
  337.  
  338.   begin { FLST initialization }
  339.    SeekLstAnchor := nil ;
  340.   end   { FLST initialization } .
  341.