Listing: 1 (*======================================================== 2 == JPI-TopSpeed Modula-2 V2 == 3 == demo program: == 4 == == 5 == Example RS232 module == 6 == == 7 ========================================================*) 8 9 (*# call(o_a_copy=>off) *) 10 (*# check(stack=>off,index=>off,range=>off,overflow=>off,nil_ptr=>off) *) 11 12 IMPLEMENTATION MODULE rs; 13 (*==*) 14 IMPORT SYSTEM, Lib; 15 16 CONST Com1 = 3F8H; 17 Com1INr = 4; 18 Com2 = 2F8H; 19 Com2INr = 3; 20 21 IntEnable = 1; 22 DivisorMsb = 1; 23 IntId = 2; 24 LineCont = 3; 25 ModemCont = 4; 26 LineStatus = 5; 27 ModemStatus = 6; 28 Debug = TRUE; 29 30 TYPE b = SET OF SHORTCARD[0..7]; ***** ^ not supported yet 31 VAR IOBase,ComINr : CARDINAL; 32 33 CONST 34 TXBuffer ::= IOBase; 35 RXBuffer ::= IOBase; 36 DivisorLsb ::= IOBase; 37 38 39 BufferSize = 256; 40 TRMax = BufferSize-16; 41 Noise = FALSE; 42 43 VAR 44 OldC : FarADDRESS; 45 Term : PROC; 46 (*# save, data(volatile=>on) *) 47 TXReady,CTS,CTSH : BOOLEAN; 48 RTS : BOOLEAN; 49 TXCount,TXI,TXO : CARDINAL; 50 RXCount,RXI,RXO : CARDINAL; 51 (*# restore *) 52 IBuf,OBuf : ARRAY[0..BufferSize-1] OF SHORTCARD; 53 54 PROCEDURE WrStr(string: ARRAY OF CHAR); 55 VAR R : SYSTEM.Registers; 56 i : CARDINAL; 57 BEGIN 58 IF Debug THEN 59 i := 0; 60 WHILE (iCHR(0)) DO 61 R.AL := SHORTCARD(string[i]); 62 R.AH := 14; 63 R.BL := 0; 64 Lib.Intr( R ,10H ); 65 INC(i); 66 END; 67 END; 68 END WrStr; 69 70 PROCEDURE WrLn; 71 TYPE 72 a3 = ARRAY [0..1] OF CHAR; 73 CONST 74 crlf = a3(CHR(13),CHR(10)); 75 BEGIN 76 WrStr( crlf ); 77 END WrLn; 78 79 80 PROCEDURE TX; 81 BEGIN 82 IF CTS OR NOT CTSH THEN 83 TXReady := FALSE; 84 DEC(TXCount); 85 SYSTEM.Out( TXBuffer,OBuf[TXO] ); 86 TXO := (TXO+1) MOD BufferSize; 87 END; 88 END TX; 89 90 PROCEDURE RX; 91 BEGIN 92 IF RXCount >= TRMax THEN 93 SYSTEM.Out( IOBase+ModemCont, SHORTCARD( b{0,3} ) ); 94 RTS := FALSE; 95 END; 96 IBuf[RXI] := SYSTEM.In( RXBuffer ); 97 IF Noise AND (Lib.RANDOM(500)=0) THEN 98 IBuf[RXI] := SHORTCARD(Lib.RANDOM(256)); 99 END; 100 RXI := (RXI+1) MOD BufferSize; 101 INC(RXCount); 102 END RX; 103 104 VAR GotBreak : BOOLEAN; 105 106 (* pragmas for interrupt handler *) 107 (*# save, 108 call(interrupt => on, 109 reg_param => (), 110 same_ds => off 111 ) 112 *) 113 PROCEDURE Int; 114 VAR i : SHORTCARD; 115 s : b; 116 BEGIN 117 LOOP 118 i := SYSTEM.In( IOBase+IntId ); 119 IF i=1 THEN EXIT; END; 120 CASE i DIV 2 OF 121 | 0 : (* Modem status *) 122 s := b(SYSTEM.In( IOBase+ModemStatus )); 123 CTS :=4 IN s; 124 IF CTS AND (TXCount >0) AND TXReady THEN TX END; 125 126 | 1 : (* TXEmpty *) 127 TXReady := TRUE; 128 IF TXCount > 0 THEN TX; END; 129 130 | 2 : (* RXReady *) 131 132 RX; 133 134 | 3 : (* LineStatus *) 135 136 s := b(SYSTEM.In( IOBase+LineStatus )); 137 138 IF 1 IN s THEN WrStr('OR-Error'); WrLn; END; 139 IF 2 IN s THEN WrStr('PE-Error'); WrLn; END; 140 IF 4 IN s THEN WrStr('Break'); WrLn; 141 ELSIF 3 IN s THEN WrStr('FE-Error'); WrLn; 142 END; 143 ELSE 144 WrStr('Unknown Int'); WrLn; 145 END; 146 END; 147 SYSTEM.Out(20H,20H); 148 END Int; 149 150 (*# restore *) 151 152 PROCEDURE RxCount():CARDINAL; 153 BEGIN 154 RETURN RXCount; 155 END RxCount; 156 157 PROCEDURE TxCount():CARDINAL; 158 BEGIN 159 RETURN TXCount; 160 END TxCount; 161 162 PROCEDURE TxFree ():CARDINAL; 163 BEGIN 164 RETURN TRMax-TXCount; 165 END TxFree; 166 167 VAR lc : SHORTCARD; 168 169 PROCEDURE Break( Time : CARDINAL ); 170 BEGIN 171 SYSTEM.Out( IOBase+LineCont,SHORTCARD( b(SYSTEM.In(IOBase+LineCont))+b{6})) ; 172 Lib.Delay( Time ); 173 SYSTEM.Out( IOBase+LineCont,SHORTCARD( b(SYSTEM.In(IOBase+LineCont))-b{6})); 174 END Break; 175 176 PROCEDURE Init( Baud : CARDINAL; 177 WordLength : wl; 178 Parity : pt; 179 OneStopBit : BOOLEAN; 180 HandShake : BOOLEAN); 181 182 VAR d : CARDINAL; i : SHORTCARD; 183 BEGIN 184 SYSTEM.DI; 185 TXI := 0; 186 TXO := 0; 187 RXI := 0; 188 RXO := 0; 189 RXCount := 0; 190 TXCount := 0; 191 SYSTEM.EI; 192 CTSH := HandShake; 193 lc := (WordLength-5) MOD 4; 194 IF NOT OneStopBit THEN lc := lc+4; END; 195 CASE Parity OF 196 | None :; 197 | Even : lc := lc+18H; 198 | Odd : lc := lc+ 8H; 199 | Mark : lc := lc+38H; 200 | Space : lc := lc+28H; 201 END; 202 SYSTEM.Out( IOBase+LineCont,80H ); 203 d := CARDINAL( 115200 DIV LONGCARD( Baud ) ); 204 SYSTEM.Out( DivisorLsb, SHORTCARD(d)); 205 SYSTEM.Out( IOBase+DivisorMsb, SHORTCARD(d DIV 100H)); 206 SYSTEM.Out( IOBase+LineCont,lc ); 207 TXReady := TRUE; 208 SYSTEM.Out( IOBase+ModemCont,SHORTCARD(b{0,1,3})); 209 CTS := 4 IN b(SYSTEM.In( IOBase+ModemStatus )); 210 LOOP 211 i := SYSTEM.In( IOBase+IntId ); 212 IF i=1 THEN EXIT; END; 213 CASE i DIV 2 OF 214 | 0 : (* Modem status *) 215 i := SYSTEM.In( IOBase+ModemStatus ); 216 | 1 : (* TXEmpty *) 217 | 2 : (* RXReady *) 218 | 3 : (* LineStatus *) 219 i := SYSTEM.In( IOBase+LineStatus ); 220 END; 221 END; 222 END Init; 223 224 225 PROCEDURE Receive(VAR Buf : ARRAY OF BYTE; Len : CARDINAL ); 226 VAR i : CARDINAL; 227 BEGIN 228 FOR i := 0 TO Len-1 DO 229 WHILE RXCount = 0 DO END; 230 Buf[i] := IBuf[RXO]; 231 DEC( RXCount ); 232 RXO := (RXO+1) MOD BufferSize; 233 END; 234 IF NOT RTS AND (RXCount < TRMax-16) THEN 235 SYSTEM.Out( IOBase+ModemCont, SHORTCARD( b{0,1,3} ) ); 236 RTS := TRUE; 237 END; 238 END Receive; 239 240 (*# call(o_a_copy=>off) *) 241 PROCEDURE Send( Buf : ARRAY OF BYTE; Len : CARDINAL ); 242 VAR i : CARDINAL; 243 BEGIN 244 FOR i := 0 TO Len-1 DO 245 OBuf[TXI] := Buf[i]; 246 INC(TXCount); 247 WHILE TXCount=BufferSize DO END; 248 TXI := (TXI+1) MOD BufferSize; 249 IF TXReady THEN TX; END; 250 END; 251 END Send; 252 253 VAR 254 IntTab[0:0] : ARRAY[0..255] OF FarADDRESS; 255 256 257 PROCEDURE CloseDown; 258 BEGIN 259 SYSTEM.Out( IOBase+IntEnable,00H ); 260 SYSTEM.Out( IOBase+ModemCont,SHORTCARD(b{})); 261 Lib.Delay(100); 262 SYSTEM.DI; 263 IntTab[8+ComINr] := OldC; 264 SYSTEM.EI; 265 Term; 266 END CloseDown; 267 268 PROCEDURE Install( Port : CARDINAL ); 269 BEGIN 270 IF Port= 1 THEN 271 Install2( Com1,Com1INr ); 272 ELSE 273 Install2( Com2,Com2INr ); 274 END; 275 END Install; 276 277 PROCEDURE Install2( Port,Intr : CARDINAL); 278 TYPE bs = SET OF SHORTCARD[0..7]; 279 VAR s : SHORTCARD; i : CARDINAL; 280 fa : FarADDRESS; 281 BEGIN 282 SYSTEM.DI; 283 IOBase := Port; 284 ComINr := Intr; 285 SYSTEM.Out( IOBase+IntEnable,00H ); 286 SYSTEM.Out( IOBase+LineStatus,0 ); 287 TXI := 0; 288 TXO := 0; 289 RXI := 0; 290 RXO := 0; 291 RXCount := 0; 292 TXCount := 0; 293 OldC := IntTab[8+ComINr]; 294 IntTab[8+ComINr] := FarADR(Int); 295 Lib.Terminate( CloseDown,Term ); 296 SYSTEM.NewPriority( CARDINAL(BITSET( SYSTEM.CurrentPriority() )-{ComINr} ) ); 297 TXReady := TRUE; 298 RTS := TRUE; 299 SYSTEM.Out( IOBase+IntEnable,0BH ); 300 SYSTEM.Out( IOBase+ModemCont,SHORTCARD(b{0,1,3})); 301 SYSTEM.EI; 302 END Install2; 303 304 305 PROCEDURE BreakTest():BOOLEAN; 306 BEGIN 307 RETURN 4 IN b(SYSTEM.In( IOBase+LineStatus )); 308 END BreakTest; 309 310 BEGIN 311 lc := SYSTEM.In( IOBase+LineCont ); 312 END rs. 1 error