doc/nguide/ngdump/bufio.pas

   1 {$R+,I+}\r
   2 {$M 45000,0,655360}\r
   3 unit BufIO;\r
   4 \r
   5 interface\r
   6 \r
   7 procedure bread(var f:file; var buf; count:word; var result:word);\r
   8 procedure bskip(var f:file; n:longint);\r
   9 procedure bseek(var f:file; p:longint);\r
  10 function  bpos(var f:file):longint;\r
  11 \r
  12 implementation\r
  13 \r
  14 {$define Buffered}\r
  15 \r
  16 {$ifdef Buffered}\r
  17 \r
  18 const MaxFbuf = 1024;\r
  19 \r
  20 var   fbuf   : array [1..MaxFbuf] of byte;\r
  21       inbuf  : 0..MaxFbuf;\r
  22       curbuf : 1..MaxFbuf+1;\r
  23 \r
  24 procedure bread( var f:file; var buf; count:word; var result:word);\r
  25 type ByteArray = array [1..maxint] of byte;\r
  26 var done,n:word;\r
  27     abuf : ByteArray absolute buf;\r
  28 begin\r
  29   result := 0;\r
  30   if (count > inbuf) or (inbuf = 0) then begin\r
  31      if (inbuf > 0)\r
  32       then move(fbuf[curbuf], buf, inbuf);\r
  33      done := inbuf;\r
  34      while (done < count) do begin\r
  35         blockread(f, fbuf, MaxFbuf, result);\r
  36         inbuf := result;\r
  37         if (inbuf < 1) then begin\r
  38 {           writeln('BufIO.bread: unexpected eof.'); }\r
  39            FillChar(buf, count, 0);\r
  40            result := 0;\r
  41            exit;\r
  42         end;\r
  43         curbuf := 1;\r
  44         n := count - done;\r
  45         if (n > inbuf) then n := inbuf;\r
  46         move(fbuf[curbuf], abuf[done+1], n);\r
  47         inc(done, n);\r
  48         dec(inbuf, n);\r
  49         inc(curbuf, n);\r
  50      end;\r
  51   end\r
  52   else begin\r
  53      move(fbuf[curbuf], buf, count);\r
  54      dec(inbuf, count);\r
  55      inc(curbuf);\r
  56   end;\r
  57   result := count;\r
  58 end;\r
  59 \r
  60 procedure bseek(var f:file; p:longint);\r
  61 begin\r
  62   seek(f, p);\r
  63   inbuf := 0; curbuf := 1;       { flush buffer }\r
  64 end;\r
  65 \r
  66 function bpos(var f:file):longint;\r
  67 begin\r
  68   bpos := filepos(f) - inbuf;\r
  69 end;\r
  70 \r
  71 procedure bskip(var f:file; n:longint);\r
  72 begin\r
  73   if (n < inbuf) then begin\r
  74      dec(inbuf, n);\r
  75      inc(curbuf, n);\r
  76   end\r
  77   else begin\r
  78      bseek(f, bpos(f)+n);\r
  79   end;\r
  80 end;\r
  81 \r
  82 {$else}\r
  83 \r
  84 procedure bread( var f:file; var buf; count:word; var result:word);\r
  85 begin\r
  86   blockread(f, buf, count, result);\r
  87   if (result < 1) then begin\r
  88      writeln('BufIO.bread: unexpected eof.');\r
  89   end;\r
  90 end;\r
  91 \r
  92 procedure bseek(var f:file; p:longint);\r
  93 begin\r
  94   seek(f, p);\r
  95 end;\r
  96 \r
  97 function bpos(var f:file):longint;\r
  98 begin\r
  99   bpos := filepos(f);\r
 100 end;\r
 101 \r
 102 procedure bskip(var f:file; n:longint);\r
 103 begin\r
 104   bseek(f, filepos(f)+n);\r
 105 end;\r
 106 \r
 107 {$endif}\r
 108 \r
 109 (*\r
 110 var SaveExitProc : Pointer;\r
 111 \r
 112 {$F+} procedure MyExitProc; {$F-}\r
 113 begin\r
 114   ExitProc := SaveExitProc;\r
 115 end;\r
 116 *)\r
 117 \r
 118 begin\r
 119 {$ifdef Buffered}\r
 120   inbuf := 0;\r
 121   curbuf := 1;\r
 122 {$endif}\r
 123 end.\r
 124 \1a