IMPLEMENTATION MODULE MD;

(*$
  LargeVars  := FALSE
  StackChk   := FALSE
  Volatile   := FALSE
  StackParms := FALSE
  EntryClear := FALSE
*)

IMPORT
  ED: ExecD, EL: ExecL, DosD, DosL,
  R, A: Arts,
  y: SYSTEM;

CONST
  oom = "Out of memory";

  SemName = 'm2rtd';

  magicAloha     = 2;
  magicBye       = 3;
  magicStartMod  = 7;
  magicEndMod    = 8;
  magicStartProc = 5;
  magicEndProc   = 6;
  magicRef       = 0;
  magicRunTime   = 4;

TYPE
  ErrorFramePtr = POINTER TO A.ErrorFrame;
  DebugInfoPtr  = y.ADDRESS;

  BreakPoint = RECORD
    mod:      y.ADDRESS;
    refPoint: INTEGER;
  END;

  AnchorPtr = POINTER TO AnchorDesc;
  AnchorDesc = RECORD
    sem:         ED.SignalSemaphore;
    debugSig,
    prgSig:      INTEGER;
    debugTask,
    prgTask:     ED.TaskPtr;
    err:         BOOLEAN;
    outstanding: BOOLEAN;
    action:      INTEGER;
    info:        DebugInfoPtr;
    frame:       ErrorFramePtr;
    startCD:     DosD.FileLockPtr;
    module:      y.ADDRESS;
    errsOnly:    BOOLEAN;
    breaksOnly:  BOOLEAN;
    breakCount:  INTEGER;
    breakPoints: ARRAY [0..99] OF BreakPoint;
    varBase:     y.ADDRESS;
    procNo:      INTEGER;
    modNo:       INTEGER;
    refNo:       INTEGER;
  END;


VAR
  (*$ LongAlign := TRUE *)
  Anchor: AnchorPtr;
  debInfo: DebugInfoPtr;
  HadRuntime: BOOLEAN;

PROCEDURE Signal (action: INTEGER);
BEGIN
  IF (~Anchor^.errsOnly OR (action = magicBye)) AND ~Anchor^.err THEN
    Anchor^.action := action;
    EL.Signal (Anchor^.debugTask, y.LONGSET {Anchor^.debugSig});
    IF Anchor^.prgSig IN EL.Wait (y.LONGSET {Anchor^.prgSig}) THEN END;
    IF Anchor^.err AND (Anchor^.action # magicStartMod)
                   AND (Anchor^.action # magicBye) THEN A.Exit (20) END;
  END;
END Signal;

PROCEDURE PrBeg (mod: y.ADDRESS; pno:INTEGER);
VAR
  oldA5 {R.D7}: y.ADDRESS;
(*$ SaveAllRegs := TRUE *)
BEGIN
  y.ASSEMBLE (MOVE.L (A5), oldA5 END);
  IF (Anchor = NIL) OR (Anchor^.prgTask # A.thisTask) THEN RETURN END;
  Anchor^.module  := mod;
  Anchor^.procNo  := pno;
  Anchor^.varBase := oldA5;
  Signal (magicStartProc);
END PrBeg;

PROCEDURE PrEnd;
(*$ SaveAllRegs := TRUE *)
BEGIN
  IF (Anchor = NIL) OR (Anchor^.prgTask # A.thisTask) THEN RETURN END;
  (* m2rtd sets Anchor^.module (Anchor^.modNo is not valid) *)
  Signal (magicEndProc);
END PrEnd;

PROCEDURE MdBeg (mod: y.ADDRESS; mno: INTEGER);
VAR
  oldA5 {R.D7}: y.ADDRESS;
(*$ SaveAllRegs := TRUE *)
BEGIN
  y.ASSEMBLE (MOVE.L (A5), oldA5 END);
  IF (Anchor = NIL) OR (Anchor^.prgTask # A.thisTask) THEN RETURN END;
  Anchor^.module := mod;
  Anchor^.modNo  := mno;
  IF mno = 0 THEN
    Anchor^.varBase := y.REG (R.A4);
  ELSE
    Anchor^.varBase := oldA5;
  END;
  Signal (magicStartMod);
END MdBeg;

PROCEDURE MdEnd;
(*$ SaveAllRegs := TRUE *)
BEGIN
  IF (Anchor = NIL) OR (Anchor^.prgTask # A.thisTask) THEN RETURN END;
  (* m2rtd sets Anchor^.module (Anchor^.modNo is not valid) *)
  Signal (magicEndMod);
END MdEnd;

PROCEDURE P (ref:INTEGER);
VAR
  bp{R.D7}:INTEGER;
(*$ SaveAllRegs := TRUE *)
BEGIN
  IF (Anchor = NIL) OR (Anchor^.prgTask # A.thisTask) THEN RETURN END;
  Anchor^.refNo := ref;
  IF ~Anchor^.errsOnly AND ~Anchor^.err THEN
    IF Anchor^.breaksOnly THEN
      bp := Anchor^.breakCount;
      LOOP
        DEC (bp);
        IF bp < 0 THEN RETURN END;
        WITH Anchor^.breakPoints[bp] DO
          IF (ref = refPoint) & (Anchor^.module = mod) THEN
            EXIT
          END;
        END; (* WITH *)
      END;
    END; (* breaksOnly *)

    Signal (magicRef);
  END;
END P;

PROCEDURE Debug (err: INTEGER): BOOLEAN;
BEGIN
  IF (Anchor = NIL) OR (Anchor^.prgTask # A.thisTask) THEN RETURN TRUE END;
  IF NOT HadRuntime THEN
    IF err = 0 THEN (* is always 0 *)
      HadRuntime := TRUE;
      Signal (magicRunTime);
    END;
    RETURN TRUE;
  ELSE
    Signal (magicBye);
    EL.ReleaseSemaphore (y.ADR (Anchor^.sem));
    EL.FreeSignal (Anchor^.prgSig);
    Anchor := NIL;
    RETURN FALSE;
  END;
END Debug;

BEGIN
  y.ASSEMBLE (
    XREF    _DEBUG (* Das erzwingt Linken mit +x! *)
    MOVE.L  #_DEBUG,debInfo(A4)
  END);

  LOOP
    EL.Forbid;
    Anchor := y.CAST (AnchorPtr, EL.FindSemaphore (y.ADR (SemName)));
    IF Anchor # NIL THEN
      IF EL.AttemptSemaphore (y.ADR (Anchor^.sem)) THEN
        EL.Permit;
        EXIT;
      END;
    ELSE
      EL.Permit;
      IF ~A.Requester (y.ADR ("Please start or free m2rtd."),
                       y.ADR ("'Run' starts program without debugger."),
                       y.ADR (" Retry "), y.ADR (" Run ")) THEN
        Anchor := NIL;
        EXIT;
      END;
    END;
  END; (* LOOP *)
  IF Anchor # NIL THEN
    HadRuntime := FALSE;

    Anchor^.prgTask := A.thisTask;
    Anchor^.info    := debInfo;
    Anchor^.frame   := y.ADR (A.errorFrame);
    Anchor^.err     := FALSE;
    Anchor^.startCD := DosL.GetProgramDir();
    Anchor^.prgSig  := EL.AllocSignal (-1);
    IF Anchor^.prgSig = -1 THEN
      EL.ReleaseSemaphore (y.ADR (Anchor^.sem)); Anchor := NIL;
      A.Exit (20);
    END;
    A.reserved2 := y.ADR (Debug);
    Signal (magicAloha);
  END;
CLOSE
  IF Anchor # NIL THEN
    Signal (magicBye);
    EL.ReleaseSemaphore (y.ADR (Anchor^.sem));
    EL.FreeSignal (Anchor^.prgSig);
    Anchor := NIL;
  END;
END MD.