(* Release 3.10 *) (*-------------------------------------------------------------------------* * * * RS232.MOD - COMMS Toolkit serial i/o * * * * COPYRIGHT (C) 1988..1992 Clarion Software Corporation. * * All Rights Reserved * * * *--------------------------------------------------------------------------*) IMPLEMENTATION MODULE RS232; (*%F _OS2*) (* DOS Version *) (*# check(index=>off)*) IMPORT Lib,SYSTEM; CONST BuffSize = 1024; LowWater = BuffSize DIV 4; (* Buffer Level when Rx is enabled *) HighWater = LowWater * 3; (* Buffer Level when Rx is disabled *) ICOCW2 = 20H; (* int. controller op. control word 2 *) ICOCW1 = 21H; (* int. controller op. control word 1 (mask) *) (* Intel 8250 register address offsets *) RBR = 0; (* receive buffer register *) THR = 0; (* transmitter holding register *) DLL = 0; (* divisor latch low (least significant) *) DLM = 1; (* divisor latch high (most significant) *) IER = 1; (* interrupt enable register *) IIR = 2; (* interrupt identification register *) LCR = 3; (* line control register *) MCR = 4; (* modem control register *) LSR = 5; (* line status register *) MSR = 6; (* modem status register *) TYPE StopStart = (Stop,Start); RingBuffer = RECORD rptr,wptr : CARDINAL; Buff : ARRAY[0..BuffSize-1] OF CHAR; END; VAR (*# save, data(volatile=>on)*) (* Modified asyncronously - so dont keep in registers! *) TxIdle,NoTx : BOOLEAN; RxBuff,TxBuff : RingBuffer; RxCount : CARDINAL; (* a count of the chars currently in the Rx buffer *) (*# restore *) FlowCtrlType : FlowControls; Installed, DCD,CTS,Dummy : BOOLEAN; OldVector : FarADDRESS; Continue : PROC; (*.............................................*) PROCEDURE Pause():BOOLEAN; BEGIN (* This procedure just wastes a little time so that chips have a *) (* little time to recover between IO calls. *) RETURN TRUE; (* do something so that the compiler doesnt optimise *) END Pause; (* this procedure out! *) (*.............................................*) PROCEDURE GetVector(Int:WORD):FarADDRESS; VAR r : SYSTEM.Registers; BEGIN r.AH := 35H; r.AL := BYTE(Int); Lib.Intr(r,21H); (* DOS Interrupt *) RETURN [r.ES:r.BX]; END GetVector; PROCEDURE SetVector(Int:WORD;Addr:FarADDRESS); VAR r : SYSTEM.Registers; BEGIN r.AH := 25H; r.AL := BYTE(Int); r.DS := SYSTEM.Seg(Addr^); r.DX := SYSTEM.Ofs(Addr^); Lib.Intr(r,21H); (* DOS Interrupt *) END SetVector; PROCEDURE SelectPort(Port:PortNos); BEGIN IF Installed THEN UnInstall; END; (*IF*) CASE Port OF 1 : Base:=3F8H; IntLevel:=4; | 2 : Base:=2F8H; IntLevel:=3; | 3 : Base:=3E8H; IntLevel:=4; | 4 : Base:=2E8H; IntLevel:=3; | END; END SelectPort; (*.............................................*) PROCEDURE InitPort(Baud:CARDINAL;DataBits:Bits;StopBits:Stops;Parity:ParityCodes); VAR Divisor : CARDINAL; LCRValue : SHORTCARD; BEGIN SYSTEM.Out(Base+LCR,80H); (* turn on DLAB to access the divisor *) Divisor := CARDINAL(115200 DIV LONGCARD(Baud)); (* set the divisor *) SYSTEM.Out(Base+DLL,SHORTCARD(Divisor MOD 256)); SYSTEM.Out(Base+DLM,SHORTCARD(Divisor DIV 256)); (* turn off the DLAB and set the new comm. parameters *) LCRValue := SHORTCARD(ORD(Parity)*8+(StopBits-1)*4+(DataBits-5)); SYSTEM.Out(Base+LCR,LCRValue); DCD := 7 IN BITSET(CARDINAL(SYSTEM.In(Base+MSR))); Dummy := Pause(); CTS := 4 IN BITSET(CARDINAL(SYSTEM.In(Base+MSR))); END InitPort; (*.............................................*) PROCEDURE TxInt; VAR tmp : CARDINAL; BEGIN WITH TxBuff DO IF (rptr=wptr) OR (NoTx) THEN TxIdle := TRUE ELSE TxIdle := FALSE; tmp := rptr; rptr := (rptr+1) MOD BuffSize; SYSTEM.Out(Base+THR,SHORTCARD(Buff[tmp])); END; END; END TxInt; (*.............................................*) PROCEDURE SetFlowControl(Which:FlowControls); BEGIN FlowCtrlType := Which; IF Which=RtsCts THEN NoTx := NOT CTS; ELSE NoTx := FALSE; END; IF TxIdle THEN TxInt END; END SetFlowControl; (*.............................................*) PROCEDURE ControlFlow(Which:StopStart); VAR Ch : CHAR; BEGIN IF FlowCtrlType=XonXoff THEN IF Which=Stop THEN Ch:=XOFF ELSE Ch:=XON END; SerialWrite(Ch,1); ELSIF FlowCtrlType=RtsCts THEN IF Which=Stop THEN Ch:=CHR(09H) ELSE Ch:=CHR(0BH) END; SYSTEM.Out(Base+MCR,SHORTCARD(Ch)); END; END ControlFlow; (*.............................................*) (*# save, call(interrupt=>on, reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2),reg_param=>(),same_ds=>off)*) (* NB, The interrupt pragma sets up the registers as parameters to the *) (* procedure in the order defined below. This allows easy access to *) (* the entry registers. *) PROCEDURE SerialInt; VAR c : CHAR; IIRReg : SHORTCARD; i : CARDINAL; b,pic : BITSET; BEGIN (* Disable serial ints at the interrupt controller *) pic := BITSET(SYSTEM.In(ICOCW1)); INCL(pic,IntLevel); SYSTEM.Out(ICOCW1,SHORTCARD(pic)); SYSTEM.EI; (* now that serial ints are disabled we can allow other int types *) LOOP IIRReg := SYSTEM.In(Base+IIR); IF ODD(IIRReg) THEN EXIT; END; CASE IIRReg DIV 2 OF 0 : (* Modem Status - get CTS *) b := BITSET(SYSTEM.In(Base+MSR)); IF 0 IN b THEN (* CTS has changed state *) CTS := (4 IN b); IF FlowCtrlType=RtsCts THEN NoTx := (NOT CTS); IF TxIdle THEN TxInt; END; END; END; IF 3 IN b THEN (* DCD has changed state *) DCD := (7 IN b); END; | 1 : (* TxReady *) TxInt; | 2 : (* RxReady *) c := CHAR(SYSTEM.In(Base)); IF ((c=XOFF) OR (c=XON)) AND (FlowCtrlType=XonXoff) THEN NoTx := (c=XOFF); IF TxIdle THEN TxInt; END; ELSE WITH RxBuff DO Buff[wptr] := CHAR(SYSTEM.In(Base)); wptr := (wptr+1) MOD BuffSize; END; SYSTEM.DI; INC(RxCount); SYSTEM.EI; IF RxCount=HighWater THEN ControlFlow(Stop); END; END; | 3 : (* Rx Line Status - check for error and clear *) b := BITSET(SYSTEM.In(Base+LSR)); b := BITSET(SYSTEM.In(Base)); (* clear rcv reg also *) | END; END; EXCL(pic,IntLevel); (* reenable serial ints at the int controller *) SYSTEM.Out(ICOCW1,SHORTCARD(pic)); SYSTEM.Out(ICOCW2,SHORTCARD(60H+IntLevel)); (* send specific EOI to 8259 *) END SerialInt; (*# restore *) (*.............................................*) PROCEDURE Install; VAR x,IIRReg : SHORTCARD; b : BITSET; BEGIN UnInstall; SYSTEM.DI; SYSTEM.Out(Base+IER,0); (* disable serial ints while we set things up. *) SYSTEM.EI; SetVector(IntLevel+8,FarADR(SerialInt)); RxBuff.rptr := 0; (* initialise ring buffer pointers & other vars *) RxBuff.wptr := 0; TxBuff.rptr := 0; TxBuff.wptr := 0; RxCount := 0; TxIdle := TRUE; NoTx := FALSE; SYSTEM.Out(Base+MCR,10H); (* put 8250 UART into loopback mode *) REPEAT b := BITSET(SYSTEM.In(Base+LSR)); (* wait for tx path to empty *) UNTIL (6 IN b); WHILE ODD(SYSTEM.In(Base+LSR)) DO (* clear out rx path *) x := SYSTEM.In(Base); END; Dummy := Pause(); SYSTEM.Out(Base+IER,0FH); (* enable all four types of serial interrupt *) Dummy := Pause(); SYSTEM.Out(Base+MCR,0BH); (* Raise DTR,RTS and OUT2 *) Dummy := Pause(); LOOP Dummy := Pause(); (* force reads from int. identification reg until it clears *) IIRReg := SYSTEM.In(Base+IIR); IF ODD(IIRReg) THEN EXIT; END; CASE IIRReg DIV 2 OF 0 : x:=SYSTEM.In(Base+MSR); | 1 : (* TxIdle -- ignore *) | 2 : x:=SYSTEM.In(Base); | 3 : (* Rx Line Status *) x:=SYSTEM.In(Base+LSR); x:=SYSTEM.In(Base); | END; END; DCD := 7 IN BITSET(CARDINAL(SYSTEM.In(Base+MSR))); Dummy := Pause(); CTS := 4 IN BITSET(CARDINAL(SYSTEM.In(Base+MSR))); NoTx := (NOT CTS) AND (FlowCtrlType=RtsCts); (* Enable level 4 or level 3 interrupt in interrupt controller *) b := BITSET(SYSTEM.In(ICOCW1)); EXCL(b,IntLevel); Dummy := Pause(); SYSTEM.Out(ICOCW1,SHORTCARD(b)); Dummy := Pause(); SYSTEM.Out(ICOCW2,SHORTCARD(IntLevel)+60H); (* EOI to int controller to clr it *) Installed := TRUE; END Install; (*.............................................*) PROCEDURE CarrierDetect():BOOLEAN; BEGIN RETURN DCD; END CarrierDetect; (*.............................................*) PROCEDURE UnInstall; VAR b : BITSET; BEGIN (* Disable level 4 or level 3 interrupt in interrupt controller *) b := BITSET(SYSTEM.In(ICOCW1)); INCL(b,IntLevel); Dummy := Pause(); SYSTEM.Out(ICOCW1,SHORTCARD(b)); Dummy := Pause(); SYSTEM.Out(Base+IER,0); (* Disable interrupt from 8250 *) Dummy := Pause(); SYSTEM.Out(Base+MCR,0); (* drop DTR and RTS *) SetVector(IntLevel+8,OldVector); Installed := FALSE; END UnInstall; (*.............................................*) (*# save,call(o_a_copy=>off)*) PROCEDURE SerialWrite(b:ARRAY OF CHAR; Lnth:CARDINAL); VAR c : CHAR; i,neww : CARDINAL; BEGIN IF Hooked THEN TxHook(b,Lnth); END; (*IF*) i:=0; WHILE i0) AND (rptr=wptr) THEN (* if t>0 then wait "t" tenth/secs for char to arrive *) WHILE (rptr=wptr) AND (t>0) DO t2:=50; WHILE (rptr=wptr) AND (t2>0) DO Lib.Delay(2); DEC(t2); END; DEC(t); END; END; IF Hooked THEN RxHook(c); END; (*IF*) IF rptr=wptr THEN RETURN FALSE; ELSE c := Buff[rptr]; rptr := (rptr+1) MOD BuffSize; SYSTEM.DI; DEC(RxCount); SYSTEM.EI; IF RxCount=LowWater THEN ControlFlow(Start); END; RETURN TRUE END; END; END SerialRead; (*.............................................*) PROCEDURE FlushInBuf; BEGIN SYSTEM.DI; RxBuff.rptr := 0; RxBuff.wptr := 0; SYSTEM.EI; END FlushInBuf; (*.............................................*) PROCEDURE SetBreak(Tenths:CARDINAL); VAR b : BITSET; BEGIN b := BITSET(SYSTEM.In(Base+LCR)); Dummy := Pause(); SYSTEM.Out(Base+LCR,SHORTCARD(b+{6})); Lib.Delay(Tenths*100); SYSTEM.Out(Base+LCR,SHORTCARD(b)); END SetBreak; (*.............................................*) PROCEDURE AddTxHook(Hook:TxHookProc;VAR OldHook:TxHookProc); BEGIN OldHook := TxHook; TxHook := Hook; END AddTxHook; PROCEDURE AddRxHook(Hook:RxHookProc;VAR OldHook:RxHookProc); BEGIN OldHook := RxHook; RxHook := Hook; END AddRxHook; PROCEDURE TermProc; BEGIN UnInstall(); Continue(); END TermProc; (*................................................*) BEGIN (*RS232*) Base := 3F8H; IntLevel := 4; FlowCtrlType := RtsCts; OldVector := GetVector(IntLevel+8); Lib.Terminate(TermProc,Continue); Hooked := FALSE; RxHook := NULLPROC; TxHook := NULLPROC; Installed := FALSE; END RS232. (*%E*) (*%T _OS2*) (* OS/2 version *) IMPORT Dos; TYPE Byte = SHORTCARD[0..7]; ByteSet = SET OF BYTE; DCBType = RECORD write,read : CARDINAL; flag1,flag2, flag3 : ByteSet; error,break, xon,xoff : CHAR; END; VAR PortNum : CARDINAL; Handle : CARDINAL; CurrBaud : CARDINAL; CurrData : Bits; CurrStop : Stops; CurrParity : ParityCodes; CurrFlow : FlowControls; CurrTime : CARDINAL; Locked,Installed : BOOLEAN; Null : FarADDRESS; PROCEDURE SelectPort(Port:PortNos); BEGIN IF NOT Locked THEN IF Installed THEN UnInstall; END; (*IF*) PortNum := Port; END; END SelectPort; PROCEDURE InitPort2; TYPE ParsType = ARRAY ParityCodes OF SHORTCARD; CONST Pars = ParsType(0,1,0,2,0,3,0,4); VAR char : RECORD data, parity, stop : SHORTCARD; END; BEGIN Dos.DevIOCtl(Null,FarADR(CurrBaud),41H,1,Handle); WITH char DO data := SHORTCARD(CurrData); parity := Pars[CurrParity]; IF CurrStop = 2 THEN stop := 2; ELSE stop := 0; END; END; Dos.DevIOCtl(Null,FarADR(char),42H,1,Handle); END InitPort2; PROCEDURE InitPort(Baud:CARDINAL;DataBits:Bits;StopBits:Stops;Parity:ParityCodes); BEGIN IF NOT Locked THEN CurrBaud := Baud; CurrData := DataBits; CurrStop := StopBits; CurrParity := Parity; IF Handle # MAX(CARDINAL) THEN InitPort2; END; END; END InitPort; PROCEDURE SetFlowControl(Which:FlowControls); VAR dcb : DCBType; BEGIN IF NOT Locked THEN CurrFlow := Which; IF Handle # MAX(CARDINAL) THEN Dos.DevIOCtl(FarADR(dcb),Null,73H,1,Handle); WITH dcb DO EXCL(flag2,7); INCL(flag2,6); EXCL(flag2,1); EXCL(flag2,0); CASE Which OF NoFlowControl : ; (* already set *) | RtsCts : INCL(flag2,7); EXCL(flag2,6); | XonXoff : INCL(flag2,1); INCL(flag2,0); | END; END; Dos.DevIOCtl(Null,FarADR(dcb),53H,1,Handle); END; END; END SetFlowControl; PROCEDURE SetRdTime(time:CARDINAL); VAR dcb : DCBType; BEGIN Dos.DevIOCtl(FarADR(dcb),Null,73H,1,Handle); WITH dcb DO INCL(flag3,1); IF time = 0 THEN INCL(flag3,2); read := 0; ELSE IF time = MAX(CARDINAL) THEN read := 0; ELSE read := time*10-1; END; EXCL(flag3,2); END; END; Dos.DevIOCtl(Null,FarADR(dcb),53H,1,Handle); CurrTime := time; END SetRdTime; PROCEDURE SetWrTime(time:CARDINAL); VAR dcb : DCBType; BEGIN Dos.DevIOCtl(FarADR(dcb),Null,73H,1,Handle); WITH dcb DO IF time = 0 THEN INCL(flag3,0); ELSE IF time = MAX(CARDINAL) THEN write := 0; ELSE write := time*10-1; END; EXCL(flag3,0); END; END; Dos.DevIOCtl(Null,FarADR(dcb),53H,1,Handle); END SetWrTime; PROCEDURE UnInstall2; VAR tmp : CARDINAL; BEGIN IF Handle # MAX(CARDINAL) THEN tmp := Handle; Handle := MAX(CARDINAL); SetRdTime(MAX(CARDINAL)); SetWrTime(MAX(CARDINAL)); Dos.Close(tmp); END; END UnInstall2; PROCEDURE Install; TYPE NamesType = ARRAY PortNos OF ARRAY[0..4] OF CHAR; CONST Names = NamesType('COM1'+0C,'COM2'+0C,'COM3'+0C,'NUL'+0C); VAR r : CARDINAL; a : CARDINAL; BEGIN Dos.EnterCritSec(); IF NOT Locked THEN Locked := TRUE; Dos.ExitCritSec(); UnInstall2; r := Dos.Open(Names[PortNum],Handle,a,0,0,1,CARDINAL({13,7,4,1}),0); IF r = 0 THEN InitPort2; SetFlowControl(CurrFlow); SetRdTime(MAX(CARDINAL)); SetWrTime(600); Installed := TRUE; ELSE Handle := MAX(CARDINAL); END; Locked := FALSE; ELSE Dos.ExitCritSec(); END; END Install; PROCEDURE CarrierDetect():BOOLEAN; VAR r : CARDINAL; mcis : ByteSet; BEGIN IF NOT Locked AND (Handle # MAX(CARDINAL)) THEN r := Dos.DevIOCtl(FarADR(mcis),Null,67H,1,Handle); RETURN (r = 0) AND (7 IN mcis); ELSE RETURN FALSE; END; END CarrierDetect; PROCEDURE UnInstall; VAR tmp : CARDINAL; BEGIN Dos.EnterCritSec(); IF NOT Locked THEN Locked := TRUE; Dos.ExitCritSec(); UnInstall2; Locked := FALSE; Installed := FALSE; ELSE Dos.ExitCritSec(); END; END UnInstall; (*# save, call(o_a_copy => off), check(index=>off) *) PROCEDURE SerialWrite(b:ARRAY OF CHAR; Lnth:CARDINAL); VAR cnt,pos : CARDINAL; BEGIN IF NOT Locked AND (Handle # MAX(CARDINAL)) THEN IF Hooked THEN TxHook(b,Lnth); END; (*IF*) pos := 0; WHILE Lnth-pos # 0 DO Dos.Write(Handle,FarADR(b[pos]),Lnth-pos,cnt); INC(pos,cnt); END; END; END SerialWrite; (*# restore *) PROCEDURE SerialRead(VAR c:CHAR; t:CARDINAL):BOOLEAN; VAR r : CARDINAL; len : CARDINAL; BEGIN IF NOT Locked AND (Handle # MAX(CARDINAL)) THEN IF t # CurrTime THEN SetRdTime(t); END; r := Dos.Read(Handle,FarADR(c),1,len); IF Hooked THEN RxHook(c); END; (*IF*) RETURN (r = 0) AND (len # 0); ELSE RETURN FALSE; END; END SerialRead; PROCEDURE FlushInBuf; VAR Return : RECORD Chars, QSize : CARDINAL; END; (*RECORD*) i : CARDINAL; void : ARRAY[0..128] OF BYTE; BEGIN Dos.DevIOCtl(FarADR(Return),Null,68H,1,Handle); WHILE Return.Chars > 0 DO IF Return.Chars > SIZE(void) THEN i := SIZE(void); ELSE i := Return.Chars; END; (*IF*) Dos.Read(Handle,FarADR(void),i,i); DEC(Return.Chars,i); END; (*WHILE*) END FlushInBuf; PROCEDURE SetBreak(Tenths:CARDINAL); VAR err : CARDINAL; BEGIN IF NOT Locked AND (Handle # MAX(CARDINAL)) THEN Dos.DevIOCtl(FarADR(err),Null,4BH,1,Handle); Dos.Sleep(VAL(LONGCARD,Tenths)*100); Dos.DevIOCtl(FarADR(err),Null,45H,1,Handle); END; END SetBreak; PROCEDURE AddTxHook(Hook:TxHookProc;VAR OldHook:TxHookProc); BEGIN OldHook := TxHook; TxHook := Hook; END AddTxHook; PROCEDURE AddRxHook(Hook:RxHookProc;VAR OldHook:RxHookProc); BEGIN OldHook := RxHook; RxHook := Hook; END AddRxHook; BEGIN (*RS232*) Handle := MAX(CARDINAL); CurrBaud := 1200; CurrData := 8; CurrStop := 1; CurrParity := None; CurrFlow := RtsCts; Locked := FALSE; Null := FarNIL; SelectPort(1); Hooked := FALSE; RxHook := NULLPROC; TxHook := NULLPROC; Installed := FALSE; END RS232. (*%E*)