IMPLEMENTATION MODULE DosSupport;
(* 9.6.90/bp
 * Dies sind alle Dos-Prozeduren, die ein neues Lock oder FileHandle erzeugen.
 * Alle Objekte werden in einer Liste vermerkt und bei Programmende
 * wieder freigegeben.
 * 31.10.90/bp
 * Optimiert
 * 16.2.91/bp
 * Die neuen 2.0 Prozeduren eingefügt.
 *)
(*$
    LargeVars:=FALSE
    StackChk:=FALSE
    RangeChk:=FALSE
    OverflowChk:=FALSE
    Volatile:=FALSE
    NilChk:=FALSE
    StackParms:=FALSE
    LongAlign:=TRUE
*)
FROM SYSTEM	IMPORT	ASSEMBLE, ADR, ADDRESS, BPTR;
FROM ExecD	IMPORT	MemReqs, MemReqSet;
FROM ExecL	IMPORT	Remove, AddTail, AllocMem, FreeMem;
FROM Arts	IMPORT	Error,programName;
IMPORT d:DosD, DosL, R;

TYPE
  FTyp = BOOLEAN; (* Da nur 2 Möglichkeiten... *)
  FTrackPtr = POINTER TO FTrack;
  FTrack = RECORD
    succ,
    pred: FTrackPtr;
    obj: BPTR;    (* Lock oder FileHandle *)
    typ: FTyp;
  END;

CONST
  fileLock=FALSE;
  fileHandle=NOT fileLock;
  myReqs=MemReqSet{}; (* KEIN public! clear unnötig *)

VAR
  TrackList: RECORD
    head,
    tail,
    tailPred: FTrackPtr;
  END;

PROCEDURE NewObj(obj{R.D6}:BPTR; typ{R.D7}:FTyp):BPTR;
VAR new{R.A3}: FTrackPtr;
BEGIN
  IF obj#NIL THEN
    new:=AllocMem(SIZE(new^),myReqs);
    IF new=NIL THEN
      Error(programName,ADR('out of memory'));
    END;
    new^.obj:=obj;
    new^.typ:=typ;
    AddTail(ADR(TrackList),new);
  END;
  RETURN obj;
END NewObj;

PROCEDURE KillObj(obj:BPTR; typ:FTyp);
VAR ft{R.A3}:FTrackPtr;
BEGIN
  IF typ=fileLock THEN DosL.UnLock(obj) ELSE DosL.Close(obj) END;
  ft:=TrackList.head;
  WHILE (ft^.succ#NIL) & ((ft^.obj#obj) OR (ft^.typ#typ)) DO
    ft:=ft^.succ
  END;
  IF ft^.succ#NIL THEN
    Remove(ft);
    FreeMem(ft,SIZE(ft^))
  END;
END KillObj;

PROCEDURE Open(name:ADDRESS; accessMode:LONGINT):d.FileHandlePtr;
BEGIN
  RETURN NewObj(DosL.Open(name,accessMode),fileHandle);
END Open;

PROCEDURE Close(file:d.FileHandlePtr);
BEGIN
  KillObj(file,fileHandle);
END Close;

PROCEDURE Lock(name:ADDRESS; accessMode:LONGINT):d.FileLockPtr;
BEGIN
  RETURN NewObj(DosL.Lock(name,accessMode),fileLock);
END Lock;

PROCEDURE UnLock(lock:d.FileLockPtr);
BEGIN
  KillObj(lock,fileLock);
END UnLock;

PROCEDURE DupLock(lock:d.FileLockPtr):d.FileLockPtr;
BEGIN
  RETURN NewObj(DosL.DupLock(lock),fileLock);
END DupLock;

PROCEDURE ParentDir(lock:d.FileLockPtr):d.FileLockPtr;
BEGIN
  RETURN NewObj(DosL.ParentDir(lock),fileLock);
END ParentDir;

PROCEDURE CreateDir(name:ADDRESS):d.FileLockPtr;
BEGIN
  RETURN NewObj(DosL.CreateDir(name),fileLock);
END CreateDir;


(*
 * Die folgenden Prozeduren sind nur benutzbar,
 * wenn  DosL.dosVersion >= 36 ist!
 * Andernfalls: Programmabbruch!
 *)
PROCEDURE CheckVersion;
BEGIN
  IF DosL.dosVersion<36 THEN
    Error(programName,ADR("Needs Dos>=36"));
  END;
END CheckVersion;

PROCEDURE DupLockFromFH(fh:d.FileHandlePtr
		):d.FileLockPtr;
BEGIN
  CheckVersion;
  RETURN NewObj(DosL.DupLockFromFH(fh),fileLock);
END DupLockFromFH;

(* Achtung: wandelt bei Erfolg das Lock in ein
 * FileHandle um!
 *)
PROCEDURE OpenFromLock(lock:d.FileLockPtr
		):d.FileHandlePtr;

  PROCEDURE illMsg;
  (*$ EntryExitCode:=FALSE *)
  BEGIN (* lokaler String wg. optim. Linken *)
    ASSEMBLE(
      DC.B "Illegal lock in DosSupport.OpenFromLock",0
      EVEN
    END);
  END illMsg;

VAR
  newH{R.D7}:d.FileHandlePtr;
  ft{R.A3}:FTrackPtr;
BEGIN
  CheckVersion;
  newH:=DosL.OpenFromLock(lock);
  IF newH#NIL THEN
    ft:=TrackList.head;
    WHILE (ft^.succ#NIL) & ((ft^.obj#lock) OR (ft^.typ#fileLock)) DO
      ft:=ft^.succ
    END;
    IF ft^.succ#NIL THEN
      ft^.obj:=newH;
      ft^.typ:=fileHandle
    ELSE (* Lock muss von MIR verwaltet werden! *)
      Error(programName,ADR(illMsg));
    END;
  END;
  RETURN newH;
END OpenFromLock;

PROCEDURE ParentOfFH(fh:d.FileHandlePtr
		):d.FileLockPtr;
BEGIN
  CheckVersion;
  RETURN NewObj(DosL.ParentOfFH(fh),fileLock);
END ParentOfFH;

BEGIN (* DosSupport *)
  ASSEMBLE(
	LEA	TrackList(A4),A0
	MOVE.L	A0,(A0)	(* NewList *)
	ADDQ.L	#4,(A0)
	CLR.L	4(A0)
	MOVE.L	A0,8(A0)
  END);
CLOSE
  WHILE TrackList.head^.succ#NIL DO
    KillObj(TrackList.head^.obj,TrackList.head^.typ)
  END;
END DosSupport.mod