(* Converted from C-Example in RKM-Companion 2.04 *)

IMPLEMENTATION MODULE CiaTimer;

IMPORT Arts;
IMPORT CR: Resources;
IMPORT HW: Hardware;
IMPORT ED: ExecD;
IMPORT EL: ExecL;
IMPORT R;
FROM SYSTEM IMPORT ADDRESS, ADR, CAST, ASSEMBLE;

(*$ EntryClear:= FALSE
    NilChk:= FALSE
    StackChk:= FALSE
    RangeChk:= FALSE
    OverflowChk:= FALSE
*)



TYPE
   FreeTimer= RECORD
      ciaBase: ED.LibraryPtr;
      timerBit: HW.CiaIcrFlags;
      ciaP: POINTER TO HW.CIAA;
      stopMask: HW.CiaCraFlagSet;
      startMask: HW.CiaCraFlagSet;
      ciaCr: POINTER TO HW.CiaCraFlagSet;
      ciaHi: POINTER TO SHORTCARD;
      ciaLo: POINTER TO SHORTCARD;
      oldAbleMask: HW.CiaIcrFlagSet;
      gotIt: BOOLEAN;
   END;


VAR
   FreeT: FreeTimer;
   StopCounter: CARDINAL;


(* Start- and StopTimer are coded in assembler to make them as
   small as possible, because they should not use much cache space *)
(*$EntryExitCode:= FALSE*)
(*$LoadA4:= TRUE*)
PROCEDURE CiaStartTimer;
(*VAR
   a2{R.A0}: ADDRESS;
   a4{R.D0}: ADDRESS;*)
BEGIN
   (* Partly setup is done in TryTimer, contrary to C-Example *)
   (*EL.Disable;*)
   (*FreeT.ciaCr^:= FreeT.ciaCr^ * FreeT.stopMask;*)
   ASSEMBLE(MOVE.B FreeT.stopMask(A4), D0
            MOVE.L FreeT.ciaCr(A4), A1
            AND.B   D0, (A1)
            END);
   (*EL.Enable;*)
   (*FreeT.ciaLo^:= 255;
   FreeT.ciaHi^:= 255;*)
   ASSEMBLE(MOVE.L FreeT.ciaLo(A4), A0
            MOVE.B #255, (A0)
            MOVE.L FreeT.ciaHi(A4), A0
            MOVE.B #255, (A0)
            END);
(*   FreeT.ciaCr^:= FreeT.ciaCr^ + FreeT.startMask;*)
   ASSEMBLE(MOVE.B FreeT.startMask(A4), D0
            (*MOVE.L FreeT.ciaCr(A4), A0*)
            OR.B   D0, (A1)
            RTS
            END);

END CiaStartTimer;



(*$EntryExitCode:= FALSE*)
(*$LoadA4:= TRUE*)
PROCEDURE CiaStopTimer;
(*VAR
   a1{R.D0}: LONGCARD;
   a2{R.A0}: ADDRESS;
   a3{R.D1}: LONGCARD;*)
BEGIN

   ASSEMBLE(MOVE.B FreeT.stopMask(A4), D0
            MOVE.L FreeT.ciaCr(A4), A0
            AND.B   D0, (A0)
            END);
   (*EL.Disable;*)
   (*FreeT.ciaCr^:= FreeT.ciaCr^ * FreeT.stopMask;*)
   (*EL.Enable;*)
   ASSEMBLE(MOVE.L FreeT.ciaHi(A4), A0
            MOVEQ  #0, D0
            MOVE.B (A0), D0
            MOVE.L #256, D1
            MULU.W D0, D1
            MOVE.L FreeT.ciaLo(A4), A0
            MOVE.B (A0), D0
            ADD.W  D0, D1
            MOVE.W D1, StopCounter(A4)
            RTS
            END);
   (*StopCounter:= CARDINAL(FreeT.ciaHi^)*256 + CARDINAL(FreeT.ciaLo^);*)
END CiaStopTimer;


PROCEDURE CiaGetDiff(): LONGINT;
BEGIN
   RETURN LONGINT(65535-StopCounter);
END CiaGetDiff;



(*
 * Try to obtain a free interval timer on a CIA.
 *)
PROCEDURE TryTimer(VAR Ft: FreeTimer): BOOLEAN;
BEGIN
   EL.Disable;

   IF NIL = CR.AddICRVector(Ft.ciaBase, HW.ta, NIL) THEN
      Ft.timerBit:= HW.ta;
      Ft.oldAbleMask:= CR.AbleICR(Ft.ciaBase, HW.CiaIcrFlagSet{HW.ta});
      Ft.ciaCr:= ADR(Ft.ciaP^.cra);
      Ft.ciaHi:= ADR(Ft.ciaP^.tahi);
      Ft.ciaLo:= ADR(Ft.ciaP^.talo);
      Ft.startMask:= HW.CiaCraFlagSet{HW.craStart, HW.craRunmode};
      Ft.stopMask:= HW.CiaCraFlagSet{HW.craTodin, HW.craSpmode, HW.craRunmode, HW.craOutmode, HW.craPbon};

   ELSIF NIL = CR.AddICRVector(Ft.ciaBase, HW.tb, NIL) THEN
      Ft.timerBit:= HW.tb;
      Ft.oldAbleMask:= CR.AbleICR(Ft.ciaBase, HW.CiaIcrFlagSet{HW.tb});
      Ft.ciaCr:= ADR(Ft.ciaP^.crb);
      Ft.ciaHi:= ADR(Ft.ciaP^.tbhi);
      Ft.ciaLo:= ADR(Ft.ciaP^.talo);
      Ft.startMask:= CAST(HW.CiaCraFlagSet, HW.CiaCrbFlagSet{HW.crbStart, HW.crbRunmode});
      Ft.stopMask:= CAST(HW.CiaCraFlagSet, HW.CiaCrbFlagSet{HW.crbAlarm, HW.crbRunmode, HW.crbOutmode, HW.crbPbon});

   ELSE
      EL.Enable;
      RETURN FALSE;
   END;

   EL.Enable;
   RETURN TRUE;
END TryTimer;


(*
 * A routine to find a free interval timer.
 *
 * This routine makes no assumptions about which interval timers
 * (if any) are available for use.  Currently there are two interval
 * timers per CIA chip.
 *
 * Because CIA usage may change in the future, your code should use
 * a routine like this to find a free interval timer.
 *
 * Note that the routine takes a preference flag (which is used to
 * to indicate that you would prefer an interval timer on CIA-A).
 * If the flag is FALSE, it means that you would prefer an interval
 * timer on CIA-B.
 *
 *)
PROCEDURE FindFreeTimer(VAR Ft: FreeTimer; PreferA: BOOLEAN): BOOLEAN;
VAR
   CiaABase, CiaBBase: ADDRESS;
BEGIN
   CiaABase:= EL.OpenResource(ADR(CR.ciaaName));
   CiaBBase:= EL.OpenResource(ADR(CR.ciabName));

   IF (CiaABase = NIL) OR (CiaBBase = NIL) THEN
      RETURN FALSE;
   END;

   IF PreferA THEN
      Ft.ciaBase:= CiaABase;
      Ft.ciaP:= ADR(HW.ciaa);
   ELSE
      Ft.ciaBase:= CiaBBase;
      Ft.ciaP:= ADR(HW.ciab);
   END;
   IF TryTimer(Ft) THEN   RETURN TRUE;   END;

   IF ~PreferA THEN
      Ft.ciaBase:= CiaABase;
      Ft.ciaP:= ADR(HW.ciaa);
   ELSE
      Ft.ciaBase:= CiaBBase;
      Ft.ciaP:= ADR(HW.ciab);
   END;
   IF TryTimer(Ft) THEN   RETURN TRUE;   END;

   RETURN FALSE;

END FindFreeTimer;





BEGIN
    IF FindFreeTimer(FreeT,TRUE) THEN
       FreeT.gotIt:= TRUE;
    ELSE
       Arts.Assert(TRUE, ADR("Could not allocate CIA-Timer."));
       FreeT.gotIt:= FALSE;
    END;


CLOSE
   IF FreeT.gotIt THEN
      FreeT.gotIt:= FALSE;
      CR.RemICRVector(FreeT.ciaBase,FreeT.timerBit,NIL);
   END;
END CiaTimer.