(*# call(o_a_size=>off) *)
(*# call(o_a_copy=>off) *)
(*# call(near_call=>on) *)
IMPLEMENTATION MODULE FIOx;
(*
        Copyright (C) 1988,1989,1990 Jensen & Partners International
*)


  IMPORT FIO;
  (*%T _OS2 *) IMPORT Dos; (*%E*)
  (*%F _OS2 *) IMPORT Lib, SYSTEM, Str (*%T _mthread *),Process (*%E *); (*%E*)

  VAR
    _multi_mode : MultiMode;
    LocalError : CARDINAL;

(*************************)
(****** DOS Section ******)
(*************************)
(*%F _OS2 *)

  VAR
    DosVerMaj,
    DosVerMin : SHORTCARD;


  PROCEDURE FileLocks(f: File; VAR unlock,lock: LockRec): CARDINAL;
    VAR
      regs : SYSTEM.Registers;
      tmp  : POINTER TO LockRec;
      mode : SHORTCARD;
    BEGIN
      mode := 1;
      tmp := SYSTEM.ADR(unlock);
      LOOP
        IF tmp#NIL THEN
          WITH regs DO
            AH := 5CH;
            AL := mode;
            BX := f;
            CX := CARDINAL(tmp^.pos DIV 65536);
            DX := CARDINAL(tmp^.pos MOD 65536);
            SI := CARDINAL(tmp^.len DIV 65536);
            DI := CARDINAL(tmp^.len MOD 65536);
          END;
          (*%T _mthread *) Process.Lock(); (*%E *)
          Lib.Dos(regs);
          (*%T _mthread *) Process.Unlock(); (*%E *)
          IF SYSTEM.CarryFlag IN regs.Flags THEN
            RETURN regs.AX;
          END;
        END;
        IF mode=0 THEN
          EXIT;
        END;
        tmp := SYSTEM.ADR(lock);
        DEC(mode);
      END;
      RETURN NO_ERROR;
    END FileLocks;


  PROCEDURE Multi(): MultiMode;
    BEGIN
      RETURN _multi_mode;
    END Multi;


  PROCEDURE MultiFile(f: File): BOOLEAN;
    VAR
      regs : SYSTEM.Registers;
    BEGIN
      IF _multi_mode=_multi_file THEN
        WITH regs DO
          AH := 44H;
          AL := 0AH;
          BX := f;
          Lib.Dos(regs);
          RETURN NOT (SYSTEM.CarryFlag IN Flags) AND (15 IN BITSET(DX));
        END;
      ELSE
        RETURN _multi_mode=_multi_yes;
      END;
    END MultiFile;




(*# save *)
(*%T _fcall *) (*# call(near_call=>off) *) (*%E *)
  PROCEDURE DelayDefault();
    BEGIN
      (*%T _mthread *) Process.Delay(DelayDefaultValue DIV 50); (*%E *)
      (*%F _mthread *) Lib.Delay(DelayDefaultValue); (*%E *)
    END DelayDefault;
(*# restore *)


  PROCEDURE Init;
    VAR
      regs : SYSTEM.Registers;
      str : ARRAY[0..5] OF CHAR;
    BEGIN
      _multi_mode := _multi_file;
      WITH regs DO
        AH := 30H;
        Lib.Dos(regs);
        DosVerMaj := AL;
        DosVerMin := AH;
        Lib.EnvironmentFind('multi',str);
        Str.Caps(str);
        IF Str.Compare(str,'YES')=0 THEN
          _multi_mode := _multi_yes;
        ELSIF Str.Compare(str,'NO')=0 THEN
          _multi_mode := _multi_no;
        ELSIF DosVerMaj >= 3 THEN
          AH := 10H;
          AL := 0;
          Lib.Intr(regs,2FH);
          IF AL=0FFH THEN
            _multi_mode := _multi_yes;
          END;
        END;
      END;
    END Init;


(*%E *)
(**************************)
(****** OS/2 Section ******)
(**************************)
(*%T _OS2 *)



  PROCEDURE Multi(): MultiMode;
    BEGIN
      RETURN _multi_yes;
    END Multi;


  PROCEDURE MultiFile(f: File): BOOLEAN;
    BEGIN
      RETURN TRUE;
    END MultiFile;




(*%F _fptr *)
(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(cx)) *)
(*# call(reg_return=>(cx,dx)) *)
(*# call(reg_saved=>(ax,bx,cx,si,di,ds,es,st1,st2)) *)
(*# data(near_ptr=>off) *)
  TYPE
    A6 = ARRAY[0..5] OF SHORTCARD;
    LR_PTR = POINTER TO Dos.LOCKRANGE;
  PROCEDURE LR_ptr(a: NearADDRESS): LR_PTR=A6(033H,0D2H, (*  xor  dx,dx *)
                                              0E3H,002H, (*  jcxz $0    *)
                                              08CH,0DAH);(*  mov  dx,ds *)
                                                         (* $0:         *)
(*# restore *)
(*%E *)


  PROCEDURE FileLocks(f: File; VAR unlock,lock: LockRec): CARDINAL;
    BEGIN
(*%T _fptr *)
      RETURN Dos.FileLocks(f,Dos.LOCKRANGE(unlock),Dos.LOCKRANGE(lock));
(*%E *)
(*%F _fptr *)
      RETURN Dos.FileLocks(f,LR_ptr(ADR(unlock))^,LR_ptr(ADR(lock))^);
(*%E *)
    END FileLocks;


(*# save *)
(*%T _fcall *) (*# call(near_call=>off) *) (*%E *)
  PROCEDURE DelayDefault();
    BEGIN
      Dos.Sleep(DelayDefaultValue);
    END DelayDefault;
(*# restore *)


  PROCEDURE Init();
    BEGIN
    END Init;


(*%E *)
(****************************)
(****** Common Section ******)
(****************************)

  PROCEDURE Open(Name: ARRAY OF CHAR; Share,ReadOnly,Create: BOOLEAN): File;
    TYPE
      Mn = ARRAY BOOLEAN OF BITSET;
      Mj = ARRAY BOOLEAN OF Mn;
      ST = ARRAY[0..64] OF CHAR;
    CONST
      m_Std = {};
      m_ReadWrite = {1};
      m_ReadOnly = {};
      m_DenyAll = {4};
      m_DenyWrite = {5};
      m_DenyNone = {6};
      M = Mj(Mn((m_Std+m_ReadWrite+m_DenyAll),
                (m_Std+m_ReadWrite+m_DenyNone)),
             Mn((m_Std+m_ReadOnly +m_DenyAll),
                (m_Std+m_ReadOnly +m_DenyWrite)));
      m_Test = (m_Std+m_ReadOnly+m_DenyNone);
    VAR
      multi : BOOLEAN;
      h : File;
      savesharemode : BITSET;
    BEGIN
      IF Create AND (ReadOnly OR Share) THEN
        RETURN MAX(CARDINAL);
      END;
      (*%T _mthread *) (*%F _OS2*) Process.Lock(); (*%E*) (*%E *)
      IF Create THEN
        h := FIO.Create(ST(Name));
      ELSE
        savesharemode := FIO.ShareMode;
        IF Share AND (_multi_mode=_multi_file) THEN
          FIO.ShareMode := m_Test;
          h := FIO.OpenRead(ST(Name));
          multi := MultiFile(h);
          FIO.Close(h);
        ELSE
          multi := _multi_mode=_multi_yes;
        END;
        FIO.ShareMode := M[ReadOnly,Share AND multi];
        h := FIO.OpenRead(ST(Name));
        FIO.ShareMode := savesharemode;
      END;
      (*%T _mthread *) (*%F _OS2*) Process.Unlock(); (*%E *) (*%E*)
      RETURN h;
    END Open;


  PROCEDURE Truncate(f: File; l: LONGCARD);
    VAR
      s : LONGCARD;
    BEGIN
      s := Size(f);
      IF FIO.IOresult()=0 THEN
        IF s<l THEN
          Seek(f,l-1);
          IF FIO.IOresult()=0 THEN
            Write(f,0,1);
            IF FIO.IOresult()<>0 THEN
              LocalError := FIO.IOresult();
              IF (Size(f)#s) THEN
                Truncate(f,s);
              END;
            END;
          END;
        ELSIF s>l THEN
          Seek(f,l);
          FIO.Truncate(f);
        END;
      END;
    END Truncate;



  CONST
    Locking = _mthread AND NOT _OS2;


(*# save *)
(*# call(result_optional=>on) *)
  PROCEDURE Common(f: File; x: LockRec; l: BOOLEAN): BOOLEAN;
    VAR
      cnt,
      res : CARDINAL;
    BEGIN
      cnt := RetryCount();
      LOOP
        IF l THEN
          res := FileLocks(f,NULL^,x);
        ELSE
          res := FileLocks(f,x,NULL^);
        END;
        IF (res=NO_ERROR) OR (cnt=0) OR NOT l THEN
          EXIT;
        END;
        DEC(cnt);
        Delay();
      END;
      RETURN res=NO_ERROR;
    END Common;
(*# restore *)


  PROCEDURE Lock(f: File; x: LockRec): BOOLEAN;
    BEGIN
      RETURN Common(f,x,TRUE);
    END Lock;


  PROCEDURE UnLock(f: File; x: LockRec);
    BEGIN
      Common(f,x,FALSE);
    END UnLock;


(*# save *)
(*# call(o_a_size=>on) *)
(*# call(o_a_copy=>off) *)
(*# call(result_optional=>on) *)
  PROCEDURE RangeCommon(f: File; x: ARRAY OF LockRec; lock: BOOLEAN): BOOLEAN;
    VAR
      i,
      j   : CARDINAL;
      res : BOOLEAN;
    BEGIN
      res := TRUE;
      i := 0;
      LOOP
        IF NOT res OR (i>HIGH(x)) OR (x[i].pos=MAX(LONGCARD)) THEN
          EXIT;
        END;
        res := Common(f,x[i],lock);
        INC(i);
      END;
      IF NOT res AND (i>1) THEN
        DEC(i);
        LOOP
          DEC(i);
          Common(f,x[i],NOT lock);
          IF i = 0 THEN
            EXIT;
          END;
        END;
      END;
      RETURN res;
    END RangeCommon;
(*# restore *)


(*# save *)
(*# call(o_a_size=>on) *)
(*# call(o_a_copy=>off) *)
  PROCEDURE LockRange(f: File; x: ARRAY OF LockRec): BOOLEAN;
    BEGIN
      RETURN RangeCommon(f,x,TRUE);
    END LockRange;
(*# restore *)


(*# save *)
(*# call(o_a_size=>on) *)
(*# call(o_a_copy=>off) *)
  PROCEDURE UnLockRange(f: File; x: ARRAY OF LockRec);
    BEGIN
      RangeCommon(f,x,FALSE);
    END UnLockRange;
(*# restore *)

  PROCEDURE Error(): CARDINAL;
    VAR res : CARDINAL;
    BEGIN
      IF LocalError<>0 THEN
        LocalError := 0;
      ELSE
        res := FIO.IOresult();
      END;
      RETURN res;
    END Error;


(*# save *)
(*%T _fcall *) (*# call(near_call=>off) *) (*%E *)
  PROCEDURE RetryCountDefault() : CARDINAL;
    BEGIN
      RETURN RetryCountDefaultValue;
    END RetryCountDefault;
(*# restore *)

  PROCEDURE Read(f: File; VAR b: ARRAY OF BYTE; c: CARDINAL);
  VAR p : ADDRESS;
  BEGIN
    p := ADR(b);
    IF FIO.RdBin(f,p^,c)<>c THEN
      LocalError := PAST_EOF;
    END;
  END Read;

  PROCEDURE Write(f: File; b: ARRAY OF BYTE; c: CARDINAL);
  VAR p : ADDRESS;
  BEGIN
    p := ADR(b);
    FIO.WrBin(f,p^,c);
    IF FIO.IOresult()=FIO.DiskFull THEN
      LocalError := PAST_EOF;
    END;
  END Write;


  BEGIN
    _multi_mode := _multi_yes;
    LocalError := 0;
    RetryCount := RetryCountDefault;
    Delay := DelayDefault;
    Init();
  END FIOx.