IMPLEMENTATION MODULE MyDev;
(* 19.10.90/bp *)
(*$ LargeVars:=FALSE StackChk:=FALSE RangeChk:=FALSE CaseChk:=FALSE
    OverflowChk:=FALSE NilChk:=FALSE
    Volatile:=FALSE StackParms:=FALSE
*)

(*
Fast wörtliche Umsetzung aus RKM: Libraries und Devices.
EINIGE Fehler entdeckt und korrigiert, wahrscheinlich einige
neue eingebaut.
Insbesondere die nicht so gängigen Kommandos (flush , stop, ...) sind
vielleicht nicht korrekt implementiert. AutoDocs genau ansehen!
In Audio.doc recht gut erklärt.

Dies ist zwar fehlerfrei compiliert und gelinkt,
aber NOCH NICHT (GAR NICHT!) getestet!
 *)

FROM SYSTEM	IMPORT	ADDRESS, ADR, ASSEMBLE, REG, SETREG, LONGSET,CAST,BPTR;
FROM Arts	IMPORT	dosCmdBuf, dosCmdLen, Terminate;
FROM ExecD	IMPORT	IOStdReqPtr, DevicePtr,	openFail,aborted, noCmd,
			badLength, LibFlags, LibFlagSet, MemReqs, MemReqSet,
			Task, TaskPtr, IOFlagSet, MsgPortAction,
			invalid, reset, read, write, update, clear, stop,
			start, flush, UnitPtr, UnitFlags, UnitFlagSet;
FROM ExecL	IMPORT	Remove, AllocMem, FreeMem, RemTask, GetMsg, PutMsg,
			WaitPort, ReplyMsg, AllocSignal, Wait,	Signal,
			FindTask, Disable, Enable;
FROM DosD	IMPORT	ProcessPtr;
FROM DosL	IMPORT	CreateProc;


CONST
  revision = 75; (* Bei jeder Änderung weiterzählen!! *)
  immediates=LONGSET{invalid,reset,stop,start,flush};
  myPri = 0;
  myStackSize = 2000;

VAR
  (* Wird vom Hauptmodul gesetzt, danach R/O! *)
  myDevBase:MyBasePtr;

PROCEDURE Dummy(VAR a:INTEGER);
BEGIN
  a:=3;
END Dummy;

PROCEDURE Dummy2(VAR a:INTEGER);
BEGIN
  a:=3;
END Dummy2;


(*$ LoadA4:=TRUE *)
PROCEDURE Dummy3(VAR a:INTEGER);
BEGIN
  a:=3;
  ASSEMBLE( MOVE.L myDevBase(A4),A0 END );
END Dummy3;

PROCEDURE PerformIO(iob:IOStdReqPtr; tunit: MyUnitPtr);
(* Hier ist im RKM ein großer Fehler, der sich leider auch in vielen
   Devices niederschlägt: bei invalid wird der Request nicht beantwortet!
   Dies ist hier korrigiert.
 *)
TYPE
  CharPtr = POINTER TO CHAR;
VAR
  i:LONGINT; p:CharPtr;
  OldStopped: BOOLEAN;
  msg: IOStdReqPtr;

   PROCEDURE InternalStart;
   VAR t:TaskPtr;
   BEGIN (* Auch hier war ein großer Fehler: kein TaskPtr! *)
     EXCL(tunit^.unit.flags,stopped);
     t:=CAST(TaskPtr,CAST(LONGINT,tunit^.procPort)-SIZE(Task));
     Signal(t,LONGSET{tunit^.unit.msgPort.sigBit});
   END InternalStart;

BEGIN
  WITH iob^ DO
    CASE command OF
    | invalid, update, clear:
       	error:=noCmd;
    | reset:
       	(* fill me in !! *)
    | read:
	p:=CAST(CharPtr,data);
	actual:=length;
	FOR i:=1 TO length DO
	  p^:=0C; INC(p);
	END;
    | write:
  	actual:=length;
    | stop:
  	INCL(tunit^.unit.flags,stopped);
    | start:
  	InternalStart;
    | flush:
        OldStopped:=stopped IN tunit^.unit.flags;
  	INCL(tunit^.unit.flags,stopped);
  	LOOP
	  msg:=GetMsg(ADR(tunit^.unit.msgPort));
	  IF msg=NIL THEN EXIT END;
	  msg^.error:=aborted;
	  ReplyMsg(msg);
	END;
	IF ~OldStopped THEN InternalStart END;
    | foo, bar:
  	actual:=0;
    | ELSE (* kann nicht vorkommen, spart aber Code *)
    END;
    IF ~(command IN immediates) AND ~(inTask IN tunit^.unit.flags) THEN
      EXCL(tunit^.unit.flags,active)
    END;
    IF ~(0 IN flags) THEN (* kein quick *)
      ReplyMsg(iob);
    END;
  END; (* with iob *)
END PerformIO;

(* Der Prozess: ===================================================== *)
PROCEDURE MyProcess();
VAR me: ProcessPtr;
    StartMsg: MyMsgPtr;
    io: IOStdReqPtr;
    myUnit: MyUnitPtr;
    wait: LONGSET;
    first:BOOLEAN;
BEGIN
  me:=CAST(ProcessPtr,FindTask(NIL));
  WaitPort(ADR(me^.msgPort));
  StartMsg:=GetMsg(ADR(me^.msgPort));
  myUnit:=StartMsg^.unit;
  (* device brauchen wir nicht, es ist myDevBase! *)
  WITH myUnit^ DO
    unit.msgPort.sigBit:=AllocSignal(-1);
    unit.msgPort.flags:=signal;
    wait:=LONGSET{unit.msgPort.sigBit};
    first:=TRUE; (* für etwas dümmlichen Eingang in die LOOP *)
    LOOP (* forever *)
      IF first THEN
        first:=FALSE
      ELSE
        SETREG(0,Wait(wait));
      END;
      IF ~(stopped IN unit.flags) AND ~(active IN unit.flags) THEN
        INCL(unit.flags,active);
        LOOP
          io:=GetMsg(ADR(unit.msgPort));
          IF io=NIL THEN EXIT END;
          PerformIO(io,myUnit);
        END;
        unit.flags:=unit.flags-UnitFlagSet{active,inTask};
      END; (* ~stopped *)
    END; (* loop *)
  END; (* with unit^ *)
END MyProcess;
(* ================================================================== *)

PROCEDURE FreeUnit(unit:MyUnitPtr);
BEGIN
  FreeMem(unit,SIZE(unit^));
END FreeUnit;

PROCEDURE InitUnit(unitNr:INTEGER);
VAR newUnit: MyUnitPtr;
    TrickSegList: BPTR;
    adr:ADDRESS;
BEGIN
  adr:=ADR(MyProcess)-4;
  TrickSegList:=BPTR(adr); (* MyProcess liegt garantiert auf Langwort!*)
  newUnit:=AllocMem(SIZE(MyUnit),MemReqSet{public,memClear});
  IF newUnit#NIL THEN
    WITH newUnit^ DO
      unitNum:=unitNr;
      procPort:=CreateProc(ADR(myName),myPri,TrickSegList,myStackSize);
      IF procPort#NIL THEN
        unit.msgPort.flags:=ignore;
        (* msgPort.pad2:=CAST(LONGINT,procPort)-SIZE(Task); ?? *)
	msg.unit:=newUnit;
	msg.device:=myDevBase;
	PutMsg(procPort,ADR(msg));
	myDevBase^.units[unitNr]:=newUnit;
      ELSE
        FreeUnit(newUnit);
      END;
    END;
  END;
END InitUnit;

PROCEDURE ExpungeUnit(unit: MyUnitPtr);
VAR task: TaskPtr;
    unitNum: SHORTINT;
BEGIN
  (* Dies geht, weil unitOpencnt=0 ist! *)
  task:=CAST(TaskPtr,unit^.procPort);
  DEC(task,SIZE(Task));
  RemTask(task);
  unitNum:=unit^.unitNum;
  FreeUnit(unit);
  myDevBase^.units[unitNum]:=NIL;
END ExpungeUnit;

(* device: a6; iob: a1; unitnum: d0; flags:d1 *)
PROCEDURE DevOpen(iob{9}:IOStdReqPtr);
VAR (* lokale Variablen können immer sein! *)
  unitNr: LONGCARD;
  flags: LONGSET;
(* $ LoadA4:=TRUE *)
BEGIN
  unitNr:=REG(0);
  flags:=CAST(LONGSET,REG(1));
  IF unitNr<maxUnit THEN
    WITH myDevBase^ DO
      IF units[unitNr]=NIL THEN
        InitUnit(unitNr);
        IF units[unitNr]=NIL THEN
          iob^.error:=openFail;
          RETURN; (* sonst zu komplizierte IF-Sequenzen! *)
        END;
      END;
      iob^.unit:=CAST(UnitPtr,units[unitNr]);
      INC(units[unitNr]^.unit.openCnt);
      INC(lib.openCnt);
      EXCL(lib.flags,delExp);
    END;
  ELSE
    iob^.error:=openFail;
  END;
END DevOpen;

(* device: a6; iob: a1 *)
PROCEDURE DevClose(iob{9}:IOStdReqPtr): ADDRESS;
VAR unit: MyUnitPtr;
    return: ADDRESS;
(* $ LoadA4:=TRUE *)
BEGIN
  return:=NIL;
  unit:=CAST(MyUnitPtr,iob^.unit);
  iob^.unit:=CAST(UnitPtr,-1);
  iob^.device:=CAST(DevicePtr,-1);
  DEC(unit^.unit.openCnt);
  IF unit^.unit.openCnt=0 THEN
    ExpungeUnit(unit);
  END;
  WITH myDevBase^ DO
    DEC(lib.openCnt);
    IF lib.openCnt=0 THEN
      IF delExp IN lib.flags THEN
        return:=DevExpunge(myDevBase);
      END;
    END;
  END;
  RETURN return;
END DevClose;

PROCEDURE DevExpunge(myDev{14}:MyBasePtr): ADDRESS;
(* $ LoadA4:=TRUE *)
BEGIN
  IF myDev^.lib.openCnt#0 THEN
    INCL(myDev^.lib.flags,delExp);
    RETURN NIL;
  END;
  Remove(myDev); (* aus Device-Liste entfernen *)
  FreeMem(CAST(ADDRESS,LONGINT(myDev)-LONGINT(myDev^.lib.negSize)),
  		myDev^.lib.negSize+myDev^.lib.posSize);
  Terminate; (* TermProcs und Libs schliessen *)
  RETURN dosCmdBuf; (* segList von Init *)
END DevExpunge;

(*$EntryExitCode:=FALSE *)
PROCEDURE DevExtFunc(): ADDRESS;
BEGIN
  ASSEMBLE(
	MOVEQ	#0,D0
	RTS
  END);
END DevExtFunc;

PROCEDURE BeginIO(iob{9}:IOStdReqPtr);
VAR unit: MyUnitPtr;
(* $ LoadA4:=TRUE *)
BEGIN
  iob^.error:=0; (* Von mir eingefügt *)
  unit:=CAST(MyUnitPtr,iob^.unit);
  IF iob^.command<nextCommand THEN
    Disable;
    IF (iob^.command IN immediates) THEN
      Enable;
      PerformIO(iob,unit);
    ELSE
      IF (stopped IN unit^.unit.flags) THEN
        INCL(unit^.unit.flags,inTask);
        EXCL(iob^.flags,0);
        Enable;
        PutMsg(ADR(unit^.unit.msgPort),iob);
      ELSE
        IF (active IN unit^.unit.flags) THEN
          INCL(unit^.unit.flags,inTask);
          EXCL(iob^.flags,0);
          Enable;
          PutMsg(ADR(unit^.unit.msgPort),iob);
        ELSE
          INCL(unit^.unit.flags,active);
          Enable;
          PerformIO(iob,unit);
        END;
      END;
    END;
  ELSE
    iob^.error:=noCmd; (* Fehler!! Wo bleibt Reply?? *)
  END;
END BeginIO;


(* im RKM nicht implementiert! *)
PROCEDURE AbortIO(iob{9}:IOStdReqPtr);
(* $ LoadA4:=TRUE *)
BEGIN
END AbortIO;


BEGIN
 (*
  * Hier könnten die eigenen Daten der Device-Struktur initialisiert werden.
  * Alles ist erlaubt, jedoch sind wir hier im Forbid-Status!
  * Für Expunge kann hier auch eine CLOSE-Procedure definiert werden!
  *)
  myDevBase:=CAST(MyBasePtr,dosCmdLen);
END MyDev.