home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / OB3.2D2.DMS / in.adf / Module / Break.mod < prev    next >
Encoding:
Text File  |  1994-08-05  |  3.1 KB  |  150 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                                                                         *)
  3. (*  Amiga Oberon Library Module: Break                Date: 02-Nov-92      *)
  4. (*                                                                         *)
  5. (*   © 1992 by Fridtjof Siebert                                            *)
  6. (*                                                                         *)
  7. (*-------------------------------------------------------------------------*)
  8.  
  9. (* $IF BreakRq *)
  10. MODULE BreakRq;
  11. (* $ELSE *)
  12. MODULE Break;
  13. (* $END *)
  14.  
  15. (* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)
  16.  
  17. IMPORT e  := Exec,
  18.        d  := Dos,
  19.        rq := Requests,
  20.        ol := OberonLib,
  21. (* $IF GarbageCollector *)
  22.        gc := GarbageCollector,
  23. (* $END *)
  24. (* $IF BreakRq *)
  25.        arg:= Arguments,
  26.        str:= Strings,
  27. (* $END *)
  28.        s  := SYSTEM;
  29.  
  30. CONST
  31.   CTRLC = LONGSET{d.ctrlC};
  32.  
  33. VAR
  34.   ctrlCOff: INTEGER;    (* 0 = CtrtC enabled *)
  35.   oldExceptCode: PROCEDURE();
  36.   oldExceptData: LONGINT;
  37.   oldSigs: LONGSET;
  38.  
  39.   Me : e.TaskPtr;
  40.  
  41.  
  42. PROCEDURE CtrlCOff*;
  43. BEGIN
  44.   IF (ctrlCOff=0) THEN s.SETREG(0,e.SetExcept(LONGSET{},CTRLC)) END;
  45.   INC(ctrlCOff)
  46. END CtrlCOff;
  47.  
  48.  
  49. PROCEDURE CtrlCOn *;
  50. BEGIN
  51.   DEC(ctrlCOff);
  52.   IF (ctrlCOff=0) THEN s.SETREG(0,e.SetExcept(CTRLC    ,CTRLC)) END;
  53. END CtrlCOn;
  54.  
  55.  
  56. PROCEDURE ShowBreak;
  57. VAR
  58.   name: ARRAY 80 OF CHAR;
  59. BEGIN
  60. (* $IF BreakRq *)
  61.   arg.GetArg(0,name);
  62.   IF str.Length(name)<80 THEN str.AppendChar(name,":") END;
  63.   IF rq.Request(name," *** User Break *** ","","Cancel") THEN END;
  64.   HALT(20);
  65. (* $ELSE *)
  66.   rq.Fail(" *** User Break *** ");
  67. (* $END *)
  68. END ShowBreak;
  69.  
  70.  
  71. (*------  Trap Handler:  ------*)
  72.  
  73.  
  74. PROCEDURE TrapHandler();
  75. BEGIN
  76.   CtrlCOff;
  77.   ol.Break := FALSE;
  78. (* $IF GarbageCollector *)
  79.   gc.mutator.locals := NIL;
  80. (* $END *)
  81.   s.SETREG(15,ol.OldSP);
  82.   ShowBreak;
  83. END TrapHandler;
  84.  
  85.  
  86. PROCEDURE * TrapProc(); (* $EntryExitCode- *)
  87.  
  88. BEGIN
  89.   ol.SetA5;
  90.   s.SETREG(8,TrapHandler);
  91.   s.INLINE(0201FH,             (*    MOVE.L  (A7)+,D0   *)
  92.            00C40H,00003H,      (*    CMPI.W  #3,D0      *)
  93.            06202H,             (*    BHI.S   l          *)
  94.            0504FH,             (*    ADDQ.W  #8,A7      *)
  95.            02F48H,00002H,      (* l: MOVE.L  A0,2(A7)   *)
  96.            04E73H);            (*    RTE                *)
  97. END TrapProc;
  98.  
  99.  
  100.  
  101. PROCEDURE * ExceptProc(d0{0}: LONGSET; a5{9}: LONGINT): LONGSET;
  102.  
  103. BEGIN
  104.   s.SETREG(13,a5);
  105.   IF (d.ctrlC IN d0) & ~ ol.closing THEN
  106.  
  107.     ol.Break := TRUE;
  108.     Me.trapCode := TrapProc;
  109.  
  110.   END;
  111.   RETURN d0;
  112. END ExceptProc;
  113.  
  114.  
  115. PROCEDURE CheckBreak *;
  116.  
  117. CONST TRAP8 = 04E48H;
  118.  
  119. BEGIN
  120.   IF ol.Break THEN s.INLINE(TRAP8) END;
  121. END CheckBreak;
  122.  
  123.  
  124. BEGIN
  125.  
  126.   Me := e.FindTask(NIL);
  127.  
  128.   oldExceptCode := Me.exceptCode;
  129.   oldExceptData := Me.exceptData;
  130.   Me.exceptCode := s.VAL(e.PROC,ExceptProc);
  131.   Me.exceptData := s.REG(13);
  132.  
  133.   oldSigs := e.SetExcept(LONGSET{12},LONGSET{12});
  134.   ctrlCOff := 0;
  135.  
  136. CLOSE
  137.  
  138.   IF e.SetExcept(oldSigs,LONGSET{12})=LONGSET{} THEN END;
  139.   Me.exceptCode := oldExceptCode;
  140.   Me.exceptData := oldExceptData;
  141.  
  142. (* $IF BreakRq *)
  143. END BreakRq.
  144. (* $ELSE *)
  145. END Break.
  146. (* $END *)
  147.  
  148.  
  149.  
  150.