schaub@sugar.UUCP (Markus Schaub) (03/06/88)
Delay(0) calls trash disks. Changing the Delay routine to ignore requests for
0 ticks and alerting the user is what this small program does. It's written
in Modula-2 for M2Amiga. Included is the source and the uuencoded binary.
NOTE: This runs only as long as the dos.library uses non standard entries in
the function table! SetFunction would be the correct way to do it, here
SetFunction fails.
M2Amiga Users: m2emacs on the distribution and demo disks has a small bug. This
bug causes LowMemWatch and GOMF to complain about a change in
the vector table of the MC68000. m2emacs writes into location 0.
As far as I know, this is not a big problem, this is the reset
address for the processor and is never used. Anyway, the bug is
fixed and M2Amiga owners should contact me if they want an
update for m2emacs now. The next release will be an 1.3 update.
More news on M2Amiga will follow shortly.
MODULE catchDelay;
(*
* catchDelay.mod
*
* Capture all Dos.Delay calls and pop up a requester if the requested time
* is 0. All other calls are routed directly to Dos.
*
* Copyright 1988 Markus Schaub (713) 523-8422 Interface Technologies.
*
* The author hereby gives permission to distribute this program, in whole only,
* via any electronic mail system, bulletin board or other computer network. It
* may not be used in a commercial product or sold.
*)
(*
* Run this program in the background. It replaces dos.library's Delay function
* with MyDelay. MyDelay checks for 0 delays which may trash disks. To remove
* catchDelay simply use the BREAK command for its task (as given by RUN).
*
* Example:
* 1>run catchDelay
* [CLI Task 2]
* 1>; now catchDelay is installed
* 1>break 2 ;this will pop up a requester "^C User interrupt" hit "abort"
*)
FROM SYSTEM IMPORT
ADDRESS,LONGSET,ADR,INLINE,SETREG;
FROM Arts IMPORT
BreakPoint,TermProcedure;
FROM Dos IMPORT
DosLibrary,Output,Write;
IMPORT
Dos;
FROM Exec IMPORT
changed,Disable,Enable,Forbid,Permit,SumLibrary,Wait;
CONST
JMP=4EF9H;
delay=-198;
TYPE
Entry=RECORD
code: CARDINAL;
addr: ADDRESS
END;
EntryPtr=POINTER TO Entry;
VAR
delayEntry: EntryPtr;
oldEntry,newEntry: Entry;
dosLibrary: POINTER TO DosLibrary;
delayFunction: LONGINT;
(*
* DosDispatch jumps directly into the Dos dispatcher using the instruction
* immediatly following the MOVEQ of the first entry. (CODE -30).
* Thanks to Andy Finkel for showing this trick.
*)
PROCEDURE DosDispatch(dos{14}: ADDRESS; arg{0}: LONGINT); CODE -28;
PROCEDURE MyDelay(time{1}: LONGINT);
BEGIN
(* we are interested in Delay(0) so pop up if there is one! *)
IF time=0 THEN
(*
* we have to save some registers. use (* $T- *) in the next version of the
* M2Amiga compiler, for now this must do
*)
INLINE(48E7H,3F32H); (* MOVEM.L <d2..d7,a2..a4,a6>,-(sp) *)
BreakPoint(ADR("Delay 0 called!"));
INLINE(4CDFH,4CFCH); (* MOVEM.L (sp)+,<d2..d7,a2..a4,a6> *)
ELSE
(* normal delay, loop through *)
DosDispatch(dosLibrary,delayFunction);
END
END MyDelay;
PROCEDURE ResetLibrary;
BEGIN
(* now reset to the old entry and compute new library checksum *)
Forbid;
Disable;
delayEntry^:=oldEntry;
INCL(dosLibrary^.lib.flags,changed);
SumLibrary(ADDRESS(dosLibrary));
Enable;
Permit;
END ResetLibrary;
BEGIN
(* Entries in dos.library are
*
* MOVE.Q val, D0
* BSR dispatcher
*
* Exec.SetFunction does not work here, it only replaces the jump address of
* the usual entry.
* JMP routine
*
* We have to do it on our own.
*)
(* get a pointer to dos.library first *)
dosLibrary:=ADR(Dos);
(* the pointer to the entry is at dosLibrary+delay's offset *)
delayEntry:=ADDRESS(dosLibrary);
INC(delayEntry,delay);
(* make a copy of the old entry *)
oldEntry:=delayEntry^;
(* what is the internal value for Delay? *)
delayFunction:=LONGINT(delayEntry^.code MOD 256);
(* init the new entry *)
WITH newEntry DO
code:=JMP;
addr:=ADR(MyDelay)
END;
(* now install the new entry and compute new library checksum *)
Forbid;
Disable;
delayEntry^:=newEntry;
INCL(dosLibrary^.lib.flags,changed);
SumLibrary(ADDRESS(dosLibrary));
Enable;
Permit;
TermProcedure(ResetLibrary);
(* avoid Procedure Call of a Function error messages *)
SETREG(0,Wait(LONGSET{}));
END catchDelay.
/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
begin 664 catchDelay
M```#\P`````````&``````````4````%````&0````<```!H````4```!!H`\
M``/I````!2X\`````")\````'$[Y```"$@`!```#[`````$````!`````@``D
M``$````#````"`````$````%````#@````````/R```#Z@```!D``F1O<RYL]
M:6)R87)Y```````````````````````````````````A`````````B8``F5XQ
M96,N;&EB<F%R>0`````````````````````````````````A`````````BH`X
M```````#[`````(````%````7````"P````````#\@```^L````'```#\@``=
M`^H```!H1&5L87D@,"!C86QL960A`&1O<RYL:6)R87)Y`$[Y````/@```!H`"
M``(>``````````````````````````!@``"6+PPH>O_<+PTJ3TJ!9@``'$CG_
M/S)'^O^H+PLL>O_(3J[_Q$S?3/Q@```2+RS_ZB\L_^8@'RQ?3J[_Y$Y=*%].1
M=2\,*'K_G"\-*D\L>O^@3J[_?"QZ_YA.KO^(1^S_]"1L__HTVS3;--LF;/_JU
M`"L``@`.(FS_ZBQZ_W1.KOY6+'K_;$ZN_X(L>O]D3J[_=DY=*%].=2\,*'K_T
M2"\-*D\([```__YF``"R+'K_.DZN__HF>O\V*4O_ZBEL_^K_^@2L````QO_ZR
M9`).3R9L__I%[/_T--LTVS3;)FS_^CP3`D8`_P*&``#__RE&_^9'[/_N-KQ.Z
M^47Z_PHG2@`"+'K^[DZN_WPL>O[F3J[_B$?L_^XD;/_Z--LTVS3;)FS_Z@`K&
M``(`#B)L_^HL>O["3J[^5BQZ_KI.KO^"+'K^LDZN_W9(>O[^+'K^GDZN_Y1"P
MIR`?+'K^FDZN_L).72A?3G4```/L`````0````(````B`````0````,````>+
M`````0````4````F`````````_(```/K````4````_(```/J```$&E-Y<W1EW
M;45R<F]R*"5D*0!I;G1U:71I;VXN;&EB<F%R>0!/=F5R9FQO=R!%<G)O<B`H=
M;&]N9RD`4F%N9V4@17)R;W(@*&QO;F<I``!/=F5R9FQO=R!%<G)O<B`H5%)!^
M4%8I``!286YG92!%<G)O<B`H0TA+*0!$:79I<VEO;B!B>2!:97)O``!);&QES
M9V%L($EN<W1R=6-T:6]N`$%D9')E<W,@17)R;W(`26QL96=A;"!#86QL``!3/
M5$%#2R!/5D521DQ/5P``1G5N8W1I;VX@4F5T=7)N($5R<F]R`$EL;&5G86P@A
M0T%312!);F1E>```4')O9W)A;6UE9"!(04Q4`$5R<F]R($]P96YI;F<@3&EB\
M<F%R>0!.;W0@16YO=6=H($UE;6]R>0!>0R`H57-E<B!"<F5A:RD`4')O8V5SP
M<V]R(%1R87`@*"5D*0!-;V1U;&$M,B!2=6X@5&EM92!%<G)O<@`@9&5B=6<@[
M`"!C;VYT:6YU92```$UO9'5L82TR($)R96%K4&]I;G0`36]D=6QA+3(@07-S]
M97)T`"!A8F]R="``9&]S+FQI8G)A<GD`3OD```\Z3OD```Q03OD```\:3OD`V
M``[Z3OD```Y.3OD```[:3OD```ZV3OD```O"3OD```WT3OD```V,3OD``!`D<
M3OD```_83OD```^03OD```]:3OD```R:3OD```UH3OD```GH3OD```(Z```!I
M/@`````````J````+@```````````````&``#A(O#"AZ_]PO#2I/1_K^J"E+>
M_[)'^OZ,*4O_MD?Z_FXI2_^Z1_K^5BE+_[Y'^OY`*4O_PD?Z_BHI2_^>1_K^R
M#BE+_Z)'^OWT*4O_ID?Z_=HI2_^J1_K]NBE+_ZY'^OV>*4O_CD?Z_8`I2_^*4
M3ETH7TYU+PPH>O]L3E7__"\Y````!"\\````#"\\``$``"(?(!\L7TZN_SHK5
M0/_\2JW__%;&'P9'^OXV+PMA`/\`)FW__"=M``P`!"1M`!`FDC=L_X``"$(K?
M``HD;0`0)*W__$Y=*%\@7U"/3M`O#"AZ_P1.5?_X)FT`$"M3__PF;?_\+"L`@
M!+RM``QF```H)FW__"1M`!`DDR\Y````!")M__PO/`````P@'RQ?3J[_+F``M
M`&(F;?_\2I-G```B)&W__"92+"L`!+RM``QG```0)&W__"92)&W__"238-8F$
M;?_\2I-G```N)FW__"M3__@D;?_\)E(D;?_\)),O.0````0B;?_X+SP````,-
M(!\L7TZN_RY.72A?(%]0CT[0+PPH>OY23E7__"9M``Q*DV<``$(D;0`,)E(\B
M*P`(O&S_@&T``#`F;0`,*U/__"1M``PF4B1M``PDDR\Y````!")M__PO/```9
M``P@'RQ?3J[_+F"V3ETH7R!?6(].T"\,*'K]]$Y5__PK;/[N__Q*K?_\9P``.
M%B9M__PK4__\+PLD:P`$3I(F7V#D3ETH7TYU+PPH>OW"3E7__"ML_NK__$JMS
M__QG```8)FW__$HK``IG```,)FW__"M3__Q@XB`M__Q@```,<`(L>OV,3J[_3
MZ$Y=*%].=2\,*'K]?$Y5__QA`/^N*T#__$JM__QG```:)FW__!=\__\`"B\+;
M)&L`!$Z2)E]"*P`*3ETH7TYU8```/"\-*D\F;0`40A,7?``!``$7?``!``(W3
M;0`2``0W;0`0``9"JP`(0JL`$"=M``P`#$Y=(%]/[P`03M`O#"AZ_09.5?_H;
M&VS_Y?_U0BS_Y2\Y````!"\\```0`"\\``$``"(?(!\L7TZN_SHK0/_H2JW_,
MZ&<``"8K3__L*VS_\O_P+"W_Z`2&```!`"E&__(L+?_H!H8``!``+D8O.0``T
M``1'^OJ4(DM"IR`?+%].KOW8*T#_^$JM__AG``$62&S_2C\\``P_/``%+RT`R
M%DA580#_,#M\`#;_]DJM`!)G``!22&S_-C\\``P_/``0+RT`$DA580#_#$?L,
M_S8I2_]:.WP`0?_V2JT`#F<``"9(;/\B/SP`##\\`!LO+0`.2%5A`/[@1^S_K
M(BE+_T8[?`!&__9(;/\./SP`!C\\``-'^ON&+PM(56$`_KI*+0`,9P``"D?ZT
M^T(I2_\:80#^)$J`9@``"D*M__Q@```B2&S^^C\\``8_/``#1_K[%"\+2%5AF
M`/Z`1^S^^BM+__PO+?_X,'P``$?L_THB2R1M__Q'[/\.0J="IS0\`4`V+?_VI
M(A\@'RQ?3J[^I$J`9P``!F$`_@8O.0````0B;?_X+%].KOYB2JW_Z&<``"0NU
M;?_L+SD````$(FW_Z"\\```0`"`?+%].KO\N*6W_\/_R&6W_]?_E3ETH7R!?M
M3^\`#D[0+PPH>OLT3E7_^BM`__I*+/_E9P``9"QZ^RQ.KO]\)FS_@BPK`!8H'
M*P`:N88(!@`(5L8;1O__+'K[#$ZN_W9*+?__9@``-"\Y````!"9L_X)'ZP!</
M($LL7TZN_HQ'^OH*+PM'^OG@+PM"IT(G80#]@C\L_X!A`/I<("W_^DY=*%].H
M=2\,*'KZLDY5_^!*;/_8;0``*`QL``?_V&X``!X\+/_83;P`!TV\``?E1D?L!
M_Y(I<V``_]Q@``!0#&P`+O_89@``#"EL_X[_W&```#P,;``O_]AF```,*6S_D
MBO_<8```*$?Z^7`@2T?L_]@B2T?L_X8D2T?M_^`L>OI*3J[]]D?M_^`I2__<N
M1_KY7B\++RS_W$*G0B=A`/S8/RS_@&$`^;).72A?3G4O#"AZ^@Q.5?_\*TW_R
M_$?L_\HD;?_\)U(`"%BM__PD;?_\)U(`!%BM__PD;?_\+!(,AO__@`!L`DY.R
M#(8``'__;P).3C=&``Y"*P`,#&L``P`.;@``%DHL_NEG```.!JT````.__Q@;
M```&7*W__"1M__PFDD7Z_N0B;?_\(HHL+?_\588N1DYS3ETH7TYU+PPH>OE^2
M3E7__"9M``Q*4V<``(XF;0`,#%,``F8``'8O"R\Y````!$7K``(B2B\K`"0@-
M'RQ?3J[]V"9?)T``*$JK`"AG```F2JL`+&<``!HK:P`L__PD:P`L)U(`+"1M)
M__PDJP`H8.!@```J+PM%^OA"+PI%^O?P+PI%ZP`"+PI")V$`^[8F7W```H``D
M``#_8```)`:M````,``,8`#_;'#_`H````#_8```#'`"+'KXTDZN_^A.72A?0
M(%]8CT[0+PPH>OB^+PTJ3R9M``Q*4V<``#0F;0`,#%,``F8``!Y*JP`H9P``K
M%B\++SD````$(FL`*"Q?3J[^8B9?!JT````P``Q@Q$Y=*%\@7UB/3M`O#"AZ#
M^&XO#2I/+RS_QF$`_Z!*+/_D9P``'B\Y````!"Q?3J[_?"\Y````!")L_^`L,
M7TZN_H9.72A?3G4O#"AZ^#).5?_\*4C_[BE`_^HK2?_\*4?_QBE\%L!.=?^&0
M0JS_YAE\____Y3E\____@"EM``S_]D?M``PL"UF&*4;_^D?M`!`L"YRM``P&G
MA@```0`I1O_R0JS^[D*L_NH9?/___W\O.0````0R?```+%].KO[:*4#_@D*LY
M_^!"+/[I0BS^Z$(L_N<F>0````0\*P$H"`8``6<```P9?/___N=@```D)GD`K
M```$/"L!*`@&``!G```,&7S___[H8```"!E\___^Z29L_X)*JP"L5\891O_D#
M2BS_Y&<``#(O.0````0F;/^"1^L`7"!++%].KOZ`+SD````$)FS_@D?K`%P@<
M2RQ?3J[^C"E`_^`O+/_&80#]H$H`9P``G$HL_^1G```<*6S_X/[B)&S^XB9J_
M`"0O$R(?+'KW!DZN_X)A`/<6)FS_@D*K`!8I:P`R_O9%^OS4)TH`,BEK`"K^S
M\D7Z^YXG2@`J+PLO/```$``O/```$``B'R`?+'KVR$ZN_L@F7R\++RW__&$`R
M]FHF7R\+0J<O/```$``B'R`?+'KVI$ZN_L@F7R=L_O8`,B=L_O(`*F````HI#
M?````!3_YF$`_@0@+/_F8```#'`"+'KV:$ZN_^A.72A?3G4O#"AZ]E@O#2I/C
M#&P`"/^`;```"E)L_X!@```,'SP`!!`?80#V(#PL_X!-O``'Y49'[/]>)X]@K
M`#PL_X!-O``'Y49'[/]>4;-@`"\,.'P``"9M``Q.DRA?*D]*+/]_9P``$$(L>
M_W]A`/?\&7S___]_2&S^[F$`]Y!(;/[J80#WB%-L_X!.72A?(%]8CT[0+PPH^
M>O7*+PTJ3TIM``QM```8/"T`#+QL_X!N```,.6T`#/^`8```!D)L_X`\+/^`W
M3;P`!^5&1^S_7BYS8`!.=4Y=*%\@7U2/3M`O#"AZ]8!.5?_Z*TW__"9M__PI9
M4__26*W__"9M__PI4__.1^S_REBM__PD;?_\)I(7?``"``P70``-`H````#_!
M#(#__X``;`).3@R```!__V\"3DX[0/_Z#&T`!/_Z;P``+$?Z\P(@2T?M__HB@
M2T?L_X8D2T?L_L(L>O463J[]]D?L_L(I2__<8```%@)``/]!O``$Y4!'[/^R(
M*7,``/_<1_KT$B\++RS_W$*G0B=A`/>,/"W_^@9&`!1(QBE&_^8_+/^`80#^1
M\$Y=*%].=2\,*'KTLB\-*D_0C["L__)L```,'SP``Q`?80#_%DY=*%].=2\,T
M*'KTCDY5__Q*+0`09@``3BM-__Q'[/_*)&W__"=2``A8K?_\)&W__"=2``18:
MK?_\)&W__":2%WP``P`,)VT`#``21_KSO"\++RT`#$*G0B=A`/;V/RS_@&$`\
M_FA.72A?(%]<CT[0+PPH>O0F3E7__"M-__Q'[/_*)&W__"=2``A8K?_\)&W_!
M_"=2``18K?_\)&W__":2%WP`!``,)VT`#``21_KS2"\++RT`#$*G'SS__V$`3
M]I1.72A?(%]8CT[0+PPH>O/,3E7__"M-__Q'[/_*)&W__"=2``A8K?_\)&W_&
M_"=2``18K?_\)&W__":2%WP`!0`,)VT`$``2)VT`#``.1_KRO"\++RT`$"\MV
M``Q")V$`]C0_+/^`80#]IDY=*%\@7U"/3M`O#"AZ\V0O#2I/,"S_@$C`8```(
M#'`"+'KS4$ZN_^A.72A?3G4O#"AZ\T`O#2I/2&S^ZB\M``QA`//`3ETH7R!?-
M6(].T"\,*'KS("\-*D](;/[J+RT`#&$`]`A.72A?(%]8CT[0+PPH>O,`+PTJW
M3TAL_NXO+0`,80#SZ$Y=*%\@7UB/3M`O#"AZ\N`O#2I/2&S^[B\M``QA`/-@I
M3ETH7R!?6(].T"0`)@`H`4A#2$3`P<+#Q,3&Q$A`T$%"A-F$T$+7A$A`0D%".
M0DA!2$+2@M*#2H%G!``\``).=;*\``#__V(>0D*`P6@.-@!"0$A`@,$T`#`#$
M@,%(0C0`0D!(0&`>0H(T`$A"0D!(0#8\``_CBN.0L(%E!)*`4D)1R__R(@).S
M=20`)@`H`2H`0H9(0TA$P,'"P\3$QL1(0-!!UX;00M>&2$!"04)"2$%(0M*"D
MTH-(1$J%:@*2A$J$:@*2A4J`:@)&@4J!9P0`/``"3G5*@%O&:@)$@$J!6\=JI
M`D2!+P`O`2(?(!]A`/]2O@9G`D2!2@9G`D2`3G4O#"AZ\<PO#2I/".P``/_^*
M9@```DY=*%].=0```^P````"`````P```BH```(F`````0````0```(>````*
M$@````4```&T```!N@```<````'&```!S````=(```'8```!W@```>0```'JW
H```!\````?8```'\```"`@```@@```(.```"%````AH````````#\N0`.
``
end
size 5080
--
// Markus Schaub uunet!nuchat!sugar!schaub (713) 523 8422
// M2Amiga Developer trying to get back the money I paid for my
\\ // Amiga by selling a few M2Amiga.
\X/ c/o Interface Technologies Corp, 3336 Richmond #323, Houston Tx 77098