Listing: 1 IMPLEMENTATION MODULE Int24 ; 2 (*======================================================== 3 == TopSpeed Modula-2 V3 == 4 == demo program: == 5 == == 6 == Int24 handler == 7 == == 8 == Skeleton handler for "critical errors" == 9 == == 10 ========================================================*) 11 (*# check(stack=>off,index=>off,range=>off,overflow=>off,nil_ptr=>off) *) 12 13 (* Example of defining an interrupt handler in Modula-2 *) 14 15 IMPORT SYSTEM,Lib,Str ; 16 17 CONST 18 ContinueProg = FALSE; (* Set this to TRUE if you want to continue 19 after an abort (returning 255 to the 20 calling program). 21 If ContinueProg is set to FALSE then the 22 program will terminate on 'abort' *) 23 24 (*----------------------------------------------------------------------*) 25 26 (* These are "safe" version of IO routines, 27 i.e. they do not call any DOS function > 12 28 Alternatively "Window" routines could be used. 29 *) 30 31 PROCEDURE WrStr(string: ARRAY OF CHAR); ***** ^ not supported yet 32 VAR R : SYSTEM.Registers; ***** ^ not supported yet 33 i : CARDINAL; 34 BEGIN 35 i := 0; 36 WHILE (iCHR(0)) DO ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 37 R.DL := SHORTCARD(string[i]); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 38 R.AH := 6; ***** ^ not supported yet ***** ^ not supported yet 39 Lib.Intr( R ,21H ); (* Don't use Lib.Dos as this will trigger ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 40 re-entered check *) 41 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 42 END; 43 END WrStr; ***** ^ not supported yet 44 45 PROCEDURE WrLn; 46 TYPE 47 a3 = ARRAY [0..1] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 48 CONST 49 crlf = a3(CHR(13),CHR(10)); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 50 BEGIN 51 WrStr( crlf ); ***** ^ not supported yet ***** ^ not supported yet 52 END WrLn; ***** ^ not supported yet 53 54 PROCEDURE RdKey(): CHAR; 55 VAR R : SYSTEM.Registers; ***** ^ not supported yet 56 BEGIN 57 R.AH := 7; ***** ^ not supported yet ***** ^ not supported yet 58 Lib.Intr( R ,21H ); (* Don't use Lib.Dos as this will trigger ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 59 re-entered check *) 60 RETURN CHAR(R.AL); ***** ^ not supported yet ***** ^ not supported yet 61 END RdKey; ***** ^ not supported yet 62 63 (*----------------------------------------------------------------------*) 64 (* The pop stack inline code is required if the program should 65 continue after an abort (returning 255 to the calling program). 66 *) 67 68 TYPE 69 Code26 = ARRAY[0..25] OF SHORTCARD ; ***** ^ not supported yet ***** ^ not supported yet 70 71 (*# save, 72 call( reg_saved=>(dx,ax,bx,cx,si,di,es,ds,st1,st2), 73 inline=>on ) 74 *) 75 76 PROCEDURE PopStack()=Code26( ***** ^ not supported yet 77 08BH,0E5H, (* mov sp,bp *) 78 083H,0C4H,01CH, (* add sp,1CH *) 79 058H, (* pop ax *) 80 05BH, (* pop bx *) 81 059H, (* pop cx *) 82 05AH, (* pop dx *) 83 05EH, (* pop si *) 84 05FH, (* pop di *) 85 058H, (* pop ax *) 86 01FH, (* pop ds *) 87 007H, (* pop es *) 88 08BH,0ECH, (* mov bp,sp *) 89 080H,04EH,004H,001H, (* or byte [bp][4],1 *) 90 08BH,0E8H, (* mov bp,ax *) 91 0B8H,0FFH,000H, (* mov ax,0FFH *) 92 0CFH); (* iret *) 93 94 95 (*----------------------------------------------------------------------*) 96 (* Actual Int24 Interrupt Handler 97 *) 98 99 (* pragmas for interrupt handler *) 100 (*# save, 101 call(interrupt => on, 102 reg_param => (), 103 same_ds => off 104 ) 105 *) 106 107 (* NB, The interrupt pragma sets up the registers as parameters to the 108 procedure in the order defined below. This allows easy access to 109 the entry registers 110 *) 111 PROCEDURE Irpt24 ( Flags : BITSET; (* Registers on entry *) ***** ^ undeclared identifier 112 CS,IP : CARDINAL; 113 AX,CX : CARDINAL; 114 DX,BX : CARDINAL; 115 SP,BP : CARDINAL; 116 SI,DI : CARDINAL; 117 DS,ES : CARDINAL ) ; 118 VAR 119 s : ARRAY[0..40] OF CHAR ; ***** ^ not supported yet ***** ^ not supported yet 120 k : CHAR ; 121 saveipf : BOOLEAN ; 122 P_AL : POINTER TO SHORTCARD; ***** ^ not supported yet 123 BEGIN 124 (* N.B. Only DOS functions <= 12 may be called from a critical 125 error handler 126 *) 127 CASE DI OF 128 0 : s := 'Disk write protected' | ***** ^ not supported yet ***** ^ not supported yet 129 2 : s := 'Drive not ready' | ***** ^ not supported yet ***** ^ not supported yet 130 9 : s := 'Printer out of paper' | ***** ^ not supported yet ***** ^ not supported yet 131 ELSE 132 s := 'Disk error' ; ***** ^ not supported yet ***** ^ not supported yet 133 END ; 134 Str.Append(s,'. Abort, Retry, Ignore?'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 135 WrStr(s) ; WrLn ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 136 REPEAT 137 k := CAP(RdKey()) ; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 138 UNTIL (k='R') OR (k='I') OR (k='A') ; 139 P_AL := ADR(AX); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 140 IF k='I' THEN P_AL^ := 0 ; (* ignore *) ***** ^ not supported yet 141 ELSIF k='R' THEN P_AL^ := 1 ; (* retry *) ***** ^ not supported yet 142 ELSE (* abort *) 143 IF ContinueProg THEN ***** ^ not supported yet 144 PopStack; (* Removes MSDOS call frame and Return 255 to caller *) ***** ^ not supported yet 145 (* Does not return here *) 146 ELSE 147 HALT ; ***** ^ undeclared identifier 148 END ; 149 END ; 150 END Irpt24; ***** ^ not supported yet 151 (*# restore *) 152 153 154 VAR 155 Int24Vec[0:24H*4] : FarADDRESS; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 156 VAR 157 h : CARDINAL; 158 BEGIN 159 SYSTEM.DI ; ***** ^ not supported yet ***** ^ not supported yet 160 (* Install interrupt 24 *) 161 Int24Vec := FarADR(Irpt24) ; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 162 SYSTEM.EI ; ***** ^ not supported yet ***** ^ not supported yet 163 END Int24. ***** ^ not supported yet 85 errors