UnixText.pas - Text File Device Driver example

unit UnixText;
{ UNIXTEXT.PAS - Transparent reads/writes on a Unix text file

  Written by Lars Fosdal ([email protected]), March 23, 1994
  Released to the public domain, March 23, 1994

  Written in Borland Pascal 7.01

  Allows using Readln/Writeln directly on a Unix text file by
  translating LF to CRLF on Reads, and stripping CR's on Writes.

  Limitation:
  All CR's will be stripped on Writes.  To strip only from CRLF
  combinations, a redesign of the PC2Unix function which
  implements lookahead is required.
  I found this unnecessary for most purposes.
}

interface

const
  UnixFlushTreshold = 512; { Flush if less that xxx bytes free in buffer }
  MaxUnixBufferSize = 16384; { Max buffer size }
  { Remember that two buffers will be allocated }

procedure AssignUnix(var F: Text; name: string; BufferSize: Word);

implementation

type
  pFile = ^ file; { Pointer to a binary file }

  { TTextRec contains a UserData field with 16 bytes, which is
    documented not to be used by the Borland file system. }

  pUnixRec = ^RUnixRec; { TTextRec.UserData type cast }

  RUnixRec = record
    DataFile: pFile; { Pointer to the "text" file }
    ReadBuf: Pointer;
    Unused: array [9 .. 16] of Byte; { not used }
  end; { REC RUnixRec }

function Unix2PC(var iBuf; var oBuf; iCount: Word): Word; far;
{ - Translate LF to CRLF - Return new char count }
begin
  ASM
    push ds           { Remember current dataseg }
    mov  cx, iCount   { How many chars to translate? }
    mov  dx, di
    jcxz @@Done       { Quit if none }
    mov  bx, 0A0Dh    { Store CRLF in BX (reversed) }
    les  di, oBuf     { ES:DI -> oBuf }
    lds  si, iBuf     { DS:SI -> iBuf }
    mov  dx, di
    cld
  @@Nxt:
    lodsb           { get a char }
    cmp al, 0Ah     { was it a LF? }
    je @@LF
    stosb           { nope, store it }
    loop @@Nxt      { are there any more chars? }
    jmp @@Done
  @@LF: mov ax, bx      { it was a LF, get the CRLF }
    stosw           { and store it }
    loop @@Nxt      { are there any more chars? }
  @@Done:
    pop  ds           { restore ds }
    mov  ax, di       { determine number of chars stored }
    sub  ax, dx
    mov @Result, ax
  END;
end; { FUNC Unix2PC }

function UnixRead(var F: TTextRec): Integer; far;
{ - Called by Read, ReadLn, Eof, Eoln, SeekEof, SeekEoln }
var
  Unix: pUnixRec;
  BytesIn: Integer;
begin
  Unix := @F.UserData;
  BlockRead(Unix^.DataFile^, Unix^.ReadBuf^, F.BufSize shr 1, BytesIn);
  F.BufEnd := Unix2PC(Unix^.ReadBuf^, F.BufPtr^, BytesIn);
  F.BufPos := 0;
  UnixRead := IOResult; { Return BlockRead IO result }
end; { FUNC UnixRead }

function PC2Unix(var iBuf, oBuf; iCount: Word): Word; far;
{ - Strip carriage returns }
begin
  ASM
    push ds           { remember ds }
    mov dx, di
    mov cx, iCount    { how many chars? }
    jcxz @@Done
    lds si, iBuf      { DS:SI -> iBuf }
    les di, oBuf      { ES:DI -> oBuf }
    mov dx, di
    cld
  @@Nxt:
    lodsb           { get next char }
    cmp al, 0Dh     { if it is a CR... }
    je @@Skip       { ignore it }
    stosb           { if not, store it }
  @@Skip:
    loop @@Nxt      { are there any more chars }
  @@Done:
    pop ds            { restore ds }
    mov ax, di        { determine number of chars stored }
    sub ax, dx
    mov @Result, ax
  END;
end; { FUNC PC2Unix }

function UnixWrite(var F: TTextRec): Integer; far;
{ - Called by Write, Writeln, Close, and also by fmOutput mode flush }
var
  Unix: pUnixRec;
  BytesOut: Integer;
begin
  Unix := @F.UserData;
  BytesOut := PC2Unix(F.BufPtr^, Unix^.ReadBuf^, F.BufPos);
  BlockWrite(Unix^.DataFile^, Unix^.ReadBuf^, BytesOut);
  F.BufPos := 0;
  UnixWrite := IOResult; { Return BlockWrite IO result }
end; { FUNC UnixWrite }

function UnixWriteFlush(var F: TTextRec): Integer; far;
{ - Flush buffer to disk - a buffer size treshold have been added to
  improve performance by avoiding a write after every write/writeln }
begin
  if ((F.BufSize shr 1) - F.BufPos) < UnixFlushTreshold then
    UnixWriteFlush := UnixWrite(F) { Write flush }
  else
    UnixWriteFlush := 0;
end; { FUNC UnixWriteFlush }

function UnixOpen(var F: TTextRec): Integer; far;
{ - Called by Reset, Append, or Rewrite }
var
  Unix: pUnixRec;
begin
  Unix := @F.UserData;
  if not Assigned(F.BufPtr)
   then GetMem(F.BufPtr, F.BufSize); { Allocate buffers }

  if not Assigned(Unix^.ReadBuf)
   then GetMem(Unix^.ReadBuf, F.BufSize);

  if not Assigned(Unix^.DataFile)
   then New(Unix^.DataFile); { Make space for the device driver file }

  Assign(Unix^.DataFile^, F.Name); { and assign the file name to it }
  case F.Mode of { The ,1 indicates a 1 byte block size }
    fmInput:
      begin
        Reset(Unix^.DataFile^, 1);
        F.InOutFunc := @UnixRead;
        F.FlushFunc := nil;
      end;
    fmInOut:
      begin { fmInOut is passed by Append }
        Reset(Unix^.DataFile^, 1);
        Seek(Unix^.DataFile^, FileSize(Unix^.DataFile^)); { Position for write }
        F.Mode := fmOutput; { Switch to write mode }
        F.InOutFunc := @UnixWrite;
        F.FlushFunc := @UnixWriteFlush;
      end;
    fmOutput:
      begin
        Rewrite(Unix^.DataFile^, 1);
        F.InOutFunc := @UnixWrite;
        F.FlushFunc := @UnixWriteFlush;
      end;
  end;
  F.BufPos := 0; { Reset buffer indexes }
  F.BufEnd := 0;
  UnixOpen := IOResult; { Return IO result from Reset, Rewrite or Append }
end;

function UnixClose(var F: TTextRec): Integer; far;
{ - Close Unix file }
var
  Unix: pUnixRec;
begin
  Unix := @F.UserData;
  Close(Unix^.DataFile^); { Close the file }
  Dispose(Unix^.DataFile); { free up allocations }
  Unix^.DataFile := nil;
  FreeMem(Unix^.ReadBuf, F.BufSize);
  Unix^.ReadBuf := nil;
  FreeMem(F.BufPtr, F.BufSize);
  F.BufPtr := nil;
  UnixClose := IOResult;
end; { FUNC UnixClose }

procedure AssignUnix(var F: Text; name: string; BufferSize: Word);
{ - Assign a text file to the unix device driver }
var
  TRec: TTextRec absolute F;
begin
  FillChar(TRec, SizeOf(TRec), 0); { Clean out the TTextRec }
  TRec.OpenFunc := @UnixOpen; { Assign the device driver functions }
  TRec.InOutFunc := nil;
  TRec.FlushFunc := nil;
  TRec.CloseFunc := @UnixClose;
  TRec.Mode := fmClosed; { Initial file mode must be closed }
  if BufferSize > MaxUnixBufferSize { Init the buffer size }
  then BufferSize := MaxUnixBufferSize
   else if BufferSize < 2 * UnixFlushTreshold
    then BufferSize := 2 * UnixFlushTreshold;
  TRec.BufSize := BufferSize and $FFFE; { Ensure even size }
  Move(name[1], TRec.Name, Length(name)); { and the filename }
end; { PROC AssignUnix }

end.