GETUQQ and PUTUQQ Fail Due to Buffered I/O

Product Version(s): 3.3x
Operating System:   Pascal
Flags: ENDUSER | TAR21169
Last Modified:  4-APR-1988    ArticleIdent: Q10880

Question:
   There appears to be a problem with using getuqq() and seek()
together on direct files. In each of the examples below, getuqq()
appears to be returning values from the wrong position in the file
after the first, or first few, seeks. The examples all work correctly
with Version 3.20 (I linked with dos2pas.lib).
   Also, with the first two examples, calling rpsuqq() before each
seek appears to solve the problem. However, the third example still
malfunctions in this case.

EXAMPLE 1:
----------
{* This simple example was devised request to demonstrate the problem in
 * using seek() and getuqq() together in the case of a simple direct
 * file of char. If, instead of getuqq(), get() is used to fetch bytes from
 * the file, the program works correctly. The file sktst.dat is 28 bytes long
 * and consists of the characters 'A' through 'Z' followed by a carriage
 * return and line feed.
 *}
program sktst(input, output);
FUNCTION GETUQQ(VAR FFILE: fcbfqq; len: word; dst: adsmem): word; extern;
VAR     I: word;
        C: char;
        F: file of char;
begin
        F.MODE := direct;
        assign(f, 'sktst.dat');
        reset(f);
        FOR I := 10 downto 1 do begin
                writeln;
                writeln('i = ', i);
                seek(f, i);
                if getuqq(f, 1, ads c) <> 0 then
                        writeln('error! - getuqq failed!')
                else if ord(c) <> (ord(i) + 64) then
                        writeln('error! - c = ', c)
                else
                        writeln('correct character found');
        end
end.

CONTENTS OF SKTST.DAT:
---------------------
ABCDEFGHIJKLMNOPQRSTUVWXYZ<cr><lf>

---------------------------------------------------------------------------

EXAMPLE 2:
----------
program bug (input,output);
FUNCTION GETUQQ(VAR F : fcbfqq;
                 LEN : word;
                 DST : adsmem ) : word ; extern;
const
  length = 6+2;
VAR
  I : word;
  MSG : lstring(length);
  MSGFILE : file of char;
Begin
  MSGFILE.MODE := direct;
  assign(msgfile,'bug.dat');
  reset(msgfile);
  if msgfile.errs = 0 then
    FOR I := 0 to 3 do begin
      seek(msgfile,length*i + 1);
      MSG.LEN := length - 2;
      if getuqq(msgfile,msg.len,ads msg[1]) <> 0 then
        MSG.LEN := 0;
      WRITELN(I:2,' ',msg);
    end;
end.

CONTENTS OF BUG.DAT:
-------------------
line 0<cr><lf>
line 1<cr><lf>
line 2<cr><lf>
line 3<cr><lf>
^Z

---------------------------------------------------------------------------

EXAMPLE 3:
----------
{$INCLUDE:'finkxu'}
{$INCLUDE:'finu'}
program test(input,output);
uses filuqq;
uses filkqq;
type    rec=record
                I:integer;
                S:string(230);
             end;
VAR     DREC:rec;
        F:file of rec;
        I,IOSTATUS:word;
begin
        writeln('size of drec=',sizeof(drec));
        F.MODE:=direct;
        assign(f,'this.dat');
        rewrite(f);
        FOR I:=1 to 10 do
         begin
          DREC.I:=ord(i);
          seek(f,i);
          IOSTATUS:=putuqq(f,sizeof(drec),ads drec);
         end;
        writeln('after for loop, i=',i);
        seek(f,1);
        FOR I:=1 to 10 do
         begin
           seek(f,i);
          IOSTATUS:=getuqq(f,sizeof(drec),ads drec);
          WRITELN('GETTING RECORD ',I:1,'. I=',drec.i:1);
         end;
        close(f);
end.

---------------------------------------------------------------------------

Response:
   In Version 3.3x, I/O to DIRECT files is buffered. This change was
made to increase performance but, unfortunately, as a result of this
change, it is no longer feasible to use the UNIT U functions GETUQQ()
and PUTUQQ(). The only way to correct this is to take the buffering
back out. This will not be done because we feel that the resulting
degradation in performance would be more of a problem than the loss of
use of these UNIT U routines.
   The loss of functionality to users resulting from this problem is
minimal. GETUQQ()/PUTUQQ() is used to read/write strings of WHOLE
records to a DIRECT file, starting at some record position, from/to a
buffer. For this purpose, it is easy to build procedures using the
intrinsics GET(), PUT(), and SEEK() to do the job. Furthermore, for
small record lengths (small compared to the buffer size, 512) it is
likely that such procedures would perform much better (i.e., faster)
than using GETUQQ() and PUTUQQ() did in 3.20. The following MODULE
illustrates one way you could implement procedures with equivalent
functionality for most applications. (No claim is made that this is
the best possible way.)

-----------------------------------------------------------------------------
{$INCLUDE: 'finkxu'}
module io_recs [];
uses filkqq;

{* Procedure ERROR_CHECK checks for three possible error conditions in   *}
{* in the parameters passed to GET_RECORDS() or PUT_RECORDS() and ABORTS *}
{* the program if any of these are found. The parameter PROC_FLAG        *}
{* identifies the procedure which called ERROR_CHECK, PROC_FLAG = 1 for  *}
{* GET_RECORDS() and PROC_FLAG = 2 for PUT_RECORDS().                    *}

PROCEDURE ERROR_CHECK(VAR F: fcbfqq; position: integer4; count: word;
BUFF_ADS: adsmem; proc_flag: word);

begin
   if f.cmod <> direct then
      abort('ERROR - FILE NOT OPENED FOR DIRECT ACCESS', 10000,
      proc_flag)
   else if count = 0 then
      abort('ERROR - I/O OF 0 RECORDS REQUESTED', 10001, proc_flag)
   else if (bylong(0, buff_ads.r) + bylong(0, count)*bylong(0, f.size))
   >= 65536 then
      abort('ERROR - BUFFER CANNOT SPAN SEGMENTS', 10002, proc_flag)
end; { error_check }

{* Procedure GET_RECORDS() copies COUNT records from file F, starting at *}
{* record POSITION, to the buffer whose address is DESTINATION.          *}

PROCEDURE GET_RECORDS (VAR F: fcbfqq; position: integer4; count: word;
DESTINATION: adsmem) [public];

VAR   I: word;
      CURR_DEST: adsmem;

begin
   {error_check(f, position, count, destination, 1);}
   CURR_DEST := destination;
   seek(f, position);
   FOR I := 1 to count do begin
      get(f);
      movesl(ads (f^), curr_dest, f.size);
      CURR_DEST.R := curr_dest.r + f.size
   end { end of for }
end; { get_records }

{* Procedure PUT_RECORDS() copies COUNT records from the buffer whose    *}
{* address is SOURCE to the file F, starting at record POSITION.         *}

PROCEDURE PUT_RECORDS (VAR F: fcbfqq; position: integer4; count: word;
SOURCE: adsmem) [public];

VAR   I: word;
      CURR_SRC: adsmem;

begin
   {error_check(f, position, count, source, 2);}
   CURR_SRC := source;
   seek(f, position);
   FOR I := 1 to count do begin
      movesl(curr_src, ads (f^), f.size);
      CURR_SRC.R := curr_src.r + f.size;
      put(f)
   end { end of for }
end; { put_records }

end.
