Listing: 1 (*======================================================== 2 == JPI-TopSpeed Modula-2 V2 == 3 == demo program: == 4 == == 5 == Terminate and Stay Resident Calculator == 6 == == 7 ========================================================*) 8 9 (*# data(stack_size=>2000H) *) 10 (*# check(stack=>off,index=>off,range=>off,overflow=>off,nil_ptr=>off) *) 11 (*# debug(vid=>off) *) 12 13 MODULE TSRcalc; 14 (* ==== *) 15 16 IMPORT IO,Window,Lib,SYSTEM,Storage; 17 IMPORT TSR ; 18 19 CONST Ix = 30; 20 Iy = 10; 21 Sx = 22; 22 Sy = 2; 23 24 TYPE LONGSET = SET OF [0..31]; ***** ^ not supported yet 25 26 StateType = (DigState,NumState,OptState); 27 28 ModeType = (DecMode,HexMode,BinMode); 29 30 ModeInfRec = RECORD 31 Name:ARRAY[1..4] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 32 Base:CARDINAL; 33 END; ***** ^ not supported yet 34 35 ModeInfArr = ARRAY ModeType OF ModeInfRec; ***** ^ not supported yet ***** ^ not supported yet 36 37 CONST ModeInf = ModeInfArr(ModeInfRec("Dec",10),ModeInfRec("Hex",16),ModeInfRec ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 38 ("Bin",2)); ***** ^ not supported yet ***** ^ not supported yet 39 40 VAR Value,Other,Memory :LONGINT; 41 Mode :ModeType; ***** ^ not supported yet 42 State :StateType; ***** ^ not supported yet 43 Q,C,Opt :CHAR; 44 W :Window.WinType; ***** ^ not supported yet 45 X,Y :CARDINAL; 46 47 48 CONST KeyL = CHR(128+75); ***** ^ undeclared identifier ***** ^ not supported yet 49 KeyR = CHR(128+77); ***** ^ undeclared identifier ***** ^ not supported yet 50 KeyU = CHR(128+72); ***** ^ undeclared identifier ***** ^ not supported yet 51 KeyD = CHR(128+80); ***** ^ undeclared identifier ***** ^ not supported yet 52 Key5 = CHR(128+63); ***** ^ undeclared identifier ***** ^ not supported yet 53 Key10 = CHR(128+68); ***** ^ undeclared identifier ***** ^ not supported yet 54 55 PROCEDURE BiosGetKey():CHAR; 56 (* ========== *) 57 58 VAR R:SYSTEM.Registers; ***** ^ not supported yet 59 60 BEGIN 61 R.AH := 0; ***** ^ not supported yet ***** ^ not supported yet 62 Lib.Intr(R,016H); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 63 IF R.AL<>0 THEN ***** ^ not supported yet ***** ^ not supported yet 64 RETURN CHR(R.AL); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 65 ELSE 66 RETURN CHR(128+R.AH); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 67 END; 68 END BiosGetKey; ***** ^ not supported yet 69 70 PROCEDURE UpdateDisplay; 71 (* ============== *) 72 73 CONST Width = 16; 74 75 VAR I:CARDINAL; 76 77 BEGIN 78 Window.GotoXY(4,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 79 CASE Mode OF ***** ^ not supported yet 80 81 | DecMode:IO.WrLngInt(Value,Width); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 82 | HexMode:IO.WrLngHex(Value,Width); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 83 | BinMode:FOR I := Width-1 TO 0 BY -1 DO ***** ^ not supported yet 84 IO.WrChar(CHR(ORD('0')+ORD(I IN LONGSET(Value)))); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 85 END; 86 87 END; 88 Window.GotoXY(4,2); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 89 IO.WrStr(ModeInf[Mode].Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 90 IO.WrStr(" "); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 91 IF Memory<>0 THEN 92 IO.WrStr("M"); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 93 ELSE 94 IO.WrStr(" "); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 95 END; 96 END UpdateDisplay; ***** ^ not supported yet 97 98 PROCEDURE Crash(L:CARDINAL); 99 (* ===== *) 100 101 102 VAR I:SHORTCARD; 103 J:CARDINAL; 104 P,Q:BITSET; ***** ^ undeclared identifier 105 106 BEGIN 107 Q := BITSET(SYSTEM.In(061H)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 108 P := Q*{2..7}; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 109 J := L; 110 WHILE J>0 DO 111 SYSTEM.Out(061H,SHORTCARD(P)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 112 FOR I := 0 TO SHORTCARD([400H:J]^) DO ***** ^ not supported yet ***** ^ not supported yet 113 P := P/{1}; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 114 END; 115 DEC(J); ***** ^ undeclared identifier ***** ^ not supported yet 116 END; 117 SYSTEM.Out(061H,SHORTCARD(Q)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 118 L := L DIV 100; 119 IF (X>=L) AND (Y>=L) THEN 120 FOR J := 1 TO L DO 121 DEC(X); ***** ^ undeclared identifier ***** ^ not supported yet 122 DEC(Y); ***** ^ undeclared identifier ***** ^ not supported yet 123 Window.Change(W,X,Y,X+Sx+J+J,Y+Sy+J+J); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 124 END; 125 FOR J := L TO 1 BY -1 DO 126 INC(X); ***** ^ undeclared identifier ***** ^ not supported yet 127 INC(Y); ***** ^ undeclared identifier ***** ^ not supported yet 128 Window.Change(W,X,Y,X+Sx+J+J-1,Y+Sy+J+J-1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 129 END; 130 END 131 END Crash; ***** ^ not supported yet 132 133 134 PROCEDURE RunCalc; 135 (* ======= *) 136 137 VAR I,F:CARDINAL; 138 R:SYSTEM.Registers; ***** ^ not supported yet 139 140 BEGIN 141 Window.PutOnTop(W); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 142 Window.Use(W); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 143 LOOP 144 CASE C OF 145 | 'c':Value := 0; 146 Other := 0; 147 Opt := '='; 148 | '0'..'9','A'..'F', 149 Key5..Key10:IF C<='9' THEN 150 DEC(C,ORD('0')); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 151 ELSIF (C>='A')AND(C<='F') THEN 152 DEC(C,ORD('A')); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 153 INC(C,10); ***** ^ undeclared identifier ***** ^ not supported yet 154 ELSE 155 DEC(C,ORD(Key5)); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 156 INC(C,10); ***** ^ undeclared identifier ***** ^ not supported yet 157 END; 158 IF ORD(C)DigState THEN ***** ^ not supported yet ***** ^ not supported yet 160 Value := 0; 161 END; 162 State := DigState; ***** ^ not supported yet ***** ^ not supported yet 163 IF Value<=MAX(LONGINT) DIV LONGINT(ModeInf[Mode].Base) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 164 THEN 165 Value := Value*LONGINT(ModeInf[Mode].Base)+LONGINT(ORD ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 166 (C)); ***** ^ not supported yet 167 ELSE 168 Crash(50); ***** ^ not supported yet ***** ^ not supported yet 169 END; 170 ELSE 171 Crash(100); ***** ^ not supported yet ***** ^ not supported yet 172 END; 173 | 10C:IF State = DigState THEN ***** ^ not supported yet ***** ^ not supported yet 174 Value := Value DIV LONGINT(ModeInf[Mode].Base); ***** ^ not supported yet ***** ^ not supported yet 175 END; 176 | 'e':Value := 0; 177 State := NumState; ***** ^ not supported yet ***** ^ not supported yet 178 179 | '+','-','*','/','a','o','x','=',CHR(13),'X','O': ***** ^ undeclared identifier ***** ^ not supported yet 180 IF State<>OptState THEN ***** ^ not supported yet ***** ^ not supported yet 181 CASE Opt OF 182 183 | '+':Other := Other+Value; 184 | '-':Other := Other-Value; 185 | '*':Other := Other*Value; 186 | '/': 187 IF Value = 0 THEN Other := MAX(LONGINT) ***** ^ undeclared identifier ***** ^ not supported yet 188 ELSE Other := Other DIV Value; 189 END; 190 | 'a':Other := LONGINT(LONGSET(Other)*LONGSET(Value)); ***** ^ not supported yet ***** ^ not supported yet 191 | 'O', 192 'o':Other := LONGINT(LONGSET(Other)+LONGSET(Value)); ***** ^ not supported yet ***** ^ not supported yet 193 | 'X', 194 'x':Other := LONGINT(LONGSET(Other)/LONGSET(Value)); ***** ^ not supported yet ***** ^ not supported yet 195 | CHR(13), ***** ^ undeclared identifier ***** ^ not supported yet 196 '=':Other := Value; 197 198 END; 199 Value := Other; 200 State := OptState; ***** ^ not supported yet ***** ^ not supported yet 201 END; 202 Opt := C; 203 | 'd':Mode := DecMode; ***** ^ not supported yet ***** ^ not supported yet 204 State := NumState; ***** ^ not supported yet ***** ^ not supported yet 205 | 'H', 206 'h':Mode := HexMode; ***** ^ not supported yet ***** ^ not supported yet 207 State := NumState; ***** ^ not supported yet ***** ^ not supported yet 208 | 'b':Mode := BinMode; ***** ^ not supported yet ***** ^ not supported yet 209 State := NumState; ***** ^ not supported yet ***** ^ not supported yet 210 | 'M', 211 'm':C := BiosGetKey(); ***** ^ not supported yet ***** ^ not supported yet 212 CASE CAP(C) OF ***** ^ undeclared identifier ***** ^ not supported yet 213 214 | '+':Memory := Memory+Value; 215 | '-':Memory := Memory-Value; 216 | '*':Memory := Memory*Value; 217 | '/':Memory := Memory DIV Value; 218 | 'R':Value := Memory; 219 State := NumState; ***** ^ not supported yet ***** ^ not supported yet 220 | 'C':Memory := 0; 221 | '=':Memory := Value; 222 223 END; 224 State := NumState; ***** ^ not supported yet ***** ^ not supported yet 225 | KeyL,KeyR, 226 KeyU,KeyD: 227 228 IF (C = KeyL) AND (X>0) THEN DEC(X); ***** ^ undeclared identifier ***** ^ not supported yet 229 ELSIF (C = KeyR) AND (X+Sx<78) THEN INC(X); ***** ^ undeclared identifier ***** ^ not supported yet 230 ELSIF (C = KeyU) AND (Y>0) THEN DEC(Y); ***** ^ undeclared identifier ***** ^ not supported yet 231 ELSIF (C = KeyD) AND (Y+Sy<23) THEN INC(Y); ***** ^ undeclared identifier ***** ^ not supported yet 232 ELSE 233 F := 2000; 234 WHILE (X<>Ix) OR (Y<>Iy) DO 235 FOR I := 1 TO 10 DO 236 Lib.Sound(F); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 237 Lib.Delay(5); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 238 DEC(F,F DIV 50); ***** ^ undeclared identifier ***** ^ not supported yet 239 END; 240 IF X>Ix THEN DEC(X); END; ***** ^ undeclared identifier ***** ^ not supported yet 241 IF XIy THEN DEC(Y); END; ***** ^ undeclared identifier ***** ^ not supported yet 243 IF Y