Topspeed_JPI/TS/SRC/WINFIO.MOD

(* Release 3.00 *)
(* Copyright (C) 1987..1991 Jensen & Partners International *)

(*# call(seg_name => null) *)
(*# module(implementation=>off) *)
(*# data(seg_name => null, near_ptr=>off) *)
(*# call(o_a_copy => off, ds_eq_ss=>off, near_call=>off) *)
(*# check(stack=>off,
          index=>off,
          range=>off,
          overflow=>off,
          nil_ptr=>off) *)


IMPLEMENTATION MODULE WinFIO;

IMPORT Lib, SYSTEM, CoreIO, CoreFile, CoreSig, CoreMain, Windows;

VAR
(*  CoreFile.BufInf : ARRAY[0..MaxHandle] OF FileInf; *) (* NB in CoreFile *)
  IOR: CARDINAL;

TYPE
  Str80 = ARRAY[0..79] OF CHAR;
  PathStr = ARRAY [0..128] OF CHAR;


PROCEDURE ErrorCheck(Code: CARDINAL; ErrNum: CARDINAL; Msg, Name: ARRAY OF CHAR);

VAR
    ErrMsg: ARRAY [0..119] OF CHAR;
    NumStr: ARRAY [0..19] OF CHAR;
    OK: BOOLEAN;
BEGIN
    IF ErrNum = 0 THEN
      ErrNum := Lib.SysErrno();
    END;
    IF IOcheck THEN
        Str.Copy(ErrMsg, Msg);
        Str.Append(ErrMsg, Name);
        Str.Append(ErrMsg, '. Dos Error Code ');
        Str.CardToStr(LONGCARD(ErrNum), NumStr, 10, OK);
        Str.Append(ErrMsg, NumStr);
(*      Lib.WrDosError(SHORTCARD(ErrNum)); *)
        Lib.RunTimeError(CoreSig._FatalErrorPos(), Code+0A0H, ErrMsg);
    END;
    IOR := ErrNum;
END ErrorCheck;

PROCEDURE IOresult () : CARDINAL;
BEGIN
  RETURN IOR;
END IOresult;


PROCEDURE WrBin(F: File; Buf: ARRAY OF BYTE; Count: CARDINAL);

VAR
  NumWrit : CARDINAL;
BEGIN
  IOR := 0;
  OK := TRUE;
  IF Count = 0 THEN RETURN END;
  NumWrit := Windows._lwrite(F, Buf, Count);
  IF NumWrit # Count THEN
      ErrorCheck(6, 0, 'WrBin : ', Lib.NilStr);
      OK := FALSE;
  END;
END WrBin;

PROCEDURE RdBin(F: File; VAR Buf: ARRAY OF BYTE; Count: CARDINAL) : CARDINAL;
VAR
  NumRead: CARDINAL;
BEGIN
  IOR := 0;
  OK := TRUE;
  EOF := FALSE;
  IF Count = 0 THEN RETURN 0 END;
  NumRead := Windows._lread(F, Buf, Count);
  IF NumRead # Count THEN
      OK := FALSE;
      IF NumRead < 0 THEN
          ErrorCheck(7, 0, 'RbBin : ', Lib.NilStr);
      ELSE
          EOF := TRUE;
      END;
  END;
  RETURN NumRead;
END RdBin;


PROCEDURE GetName(name: ARRAY OF CHAR; VAR fn: PathStr);
(* Makes Null terminated filename, also sets IOR to 0 *)
BEGIN
  Str.Copy(fn,name);
  fn[HIGH(fn)] := CHR(0);
  IOR := 0;
END GetName;

PROCEDURE Open(Name: ARRAY OF CHAR) : File;
VAR
  fn: PathStr;
  H: File;
BEGIN
  GetName(Name,fn);
  H := Windows._lopen(fn, Windows.READ_WRITE + INTEGER(ShareMode));
  IF H <> MAX(CARDINAL) THEN
    CoreFile._openfd[H] := (CoreIO.O_RDWR+CoreIO.O_BINARY);
    IF CoreIO.isatty(H) # 0 THEN
      CoreFile._openfd[H] := CoreFile._openfd[H] + CoreIO.O_DEVICE;
    END;
  ELSE
    ErrorCheck(2, 0, 'Open : ', fn);
  END;
  RETURN H;
END Open;

PROCEDURE OpenRead( Name: ARRAY OF CHAR) : File;
VAR
  fn: PathStr;
  H: File;
BEGIN
  GetName(Name,fn);
  H := Windows._lopen(fn, Windows.READ + INTEGER(ShareMode));
  IF H <> MAX(CARDINAL) THEN
    CoreFile._openfd[H] := (CoreIO.O_RDONLY+CoreIO.O_BINARY);
    IF CoreIO.isatty(H) # 0 THEN
      CoreFile._openfd[H] := CoreFile._openfd[H] + CoreIO.O_DEVICE;
    END;
  ELSE
    ErrorCheck(3, 0, 'OpenRead : ', fn);
  END;
  RETURN H;
END OpenRead;

PROCEDURE Exists(Name: ARRAY OF CHAR) : BOOLEAN;
VAR
  fn : PathStr ;
BEGIN
  GetName(Name,fn);
  IF CoreIO._exists(fn) # 0 THEN
    RETURN TRUE;
  END;
  RETURN FALSE;
END Exists;

PROCEDURE Create(Name: ARRAY OF CHAR) : File;
VAR
  fn: PathStr;
  H: File;
BEGIN
  GetName(Name,fn);
  H := Windows._lcreat(fn, 0);
  IF H <> MAX(CARDINAL) THEN
    CoreFile._openfd[H] := (CoreIO.O_RDWR+CoreIO.O_BINARY);
  ELSE
    ErrorCheck(5, 0, 'Create : ', Name);
  END;
  RETURN H;
END Create;

PROCEDURE Close(F: File);
BEGIN
  IOR := 0;
  IF F < CoreFile._open_max THEN
    CoreFile._openfd[F] := {};
  END;
  IF Windows._lclose(F) = -1 THEN
    ErrorCheck(0, 0, 'Close : ', Lib.NilStr);
  END;
  RETURN;
END Close;

BEGIN
  IOR := 0;
  OK      := TRUE;
  EOF := FALSE;
  ShareMode := ShareCompat;
END WinFIO.