Syntax10.Scn.FntSyntax10i.Scn.Fnt0Courier10.Scn.Fnt 5~8FoldElemsNew[8g8#Syntax10.Scn.Fntww UINT fBinary :1; (* binary mode (skip EOF check)*) UINT fRtsDisable :1; (* don't assert RTS at init time *) UINT fParity :1; (* enable parity checking *) UINT fOutxCtsFlow :1; (* CTS handshaking on output *) UINT fOutxDsrFlow :1; (* DSR handshaking on output *) UINT fDummy :2; (* reserved *) UINT fDtrDisable :1; (* don't assert DTR at init time *) UINT fOutX :1; (* enable output XON/XOFF *) UINT fInX :1; (* enable input XON/XOFF *) UINT fPeChar :1; (* enable parity err replacement *) UINT fNull :1; (* enable null stripping *) UINT fChEvt :1; (* enable Rx character event *) UINT fDtrflow :1; (* DTR handshake on input *) UINT fRtsflow :1; (* RTS handshake on input *) UINT fDummy2 :1; 8  ('8#Syntax10.Scn.Fnt DWORD fCtsHold : 1; (* Tx waiting for CTS signal *) DWORD fDsrHold : 1; (* Tx waiting for DSR signal *) DWORD fRlsdHold : 1; (* Tx waiting for RLSD signal *) DWORD fXoffHold : 1; (* Tx waiting, XOFF char rec'd *) DWORD fXoffSent : 1; (* Tx waiting, XOFF char sent *) DWORD fEof : 1; (* EOF character sent *) DWORD fTxim : 1; (* character waiting for Tx *) DWORD fReserved : 25; (* reserved *) 8bSyntax10b.Scn.Fntgb8Syntax10.Scn.FntCourier10.Scn.Fnt CE_RXOVER 0x0001 CE_OVERRUN 0x0002 CE_RXPARITY 0x0004 CE_FRAME 0x0008 CE_BREAK 0x0010 CE_CTSTO 0x0020 CE_DSRTO 0x0040 CE_RLSDTO 0x0080 CE_TXFULL 0x0100 CE_PTO 0x0200 CE_IOE 0x0400 CE_DNS 0x0800 CE_OOP 0x1000 CE_MODE 0x8000 8,8#Syntax10.Scn.Fnt PROCEDURE ChX (ch: CHAR); BEGIN CASE ch OF " " .. "~": Log.Ch(ch) ELSE Log.Ch("<"); Log.Ch(Hex[ORD(ch) DIV 16 MOD 16]); Log.Ch(Hex[ORD(ch) MOD 16]); Log.Ch(">") END END ChX; 8H  7[0j t%-_ 8MODULE V24; (* MH 17. Febr. 1995 / 17.6.95 *) (* Oberon for Windows V24 interface for Windows NT, Win 95, and Win32s *) IMPORT S := SYSTEM, Kernel, Win32, Input; CONST SendTimeout = 3000; (* ms *) BufSize = 1024; (* receive buffer *) TxQueueSize = 512; GenRW = 0C0000000H; (* GENERIC_READ | GENERIC_WRITE *) OpenExisting = 3; (* OPEN_EXISTING *) MAXDWORD = 0FFFFFFFFH; TYPE DCB32 = RECORD (* DCB structure for Win32 *) DCBlength: LONGINT; (* sizeof(DCB) *) BaudRate: LONGINT; (* current baud rate*) flags: SET; (* bits in flags:  DWORD fBinary: 1; (* binary mode, no EOF check *) DWORD fParity: 1; (* enable parity checking *) DWORD fOutxCtsFlow:1; (* CTS output flow control *) DWORD fOutxDsrFlow:1; (* DSR output flow control *) DWORD fDtrControl:2; (* DTR flow control type *) DWORD fDsrSensitivity:1; (* DSR sensitivity *) DWORD fTXContinueOnXoff:1; (* XOFF continues Tx *) DWORD fOutX: 1; (* XON/XOFF out flow control *) DWORD fInX: 1; (* XON/XOFF in flow control *) DWORD fErrorChar: 1; (* enable error replacement *) DWORD fNull: 1; (* enable null stripping *) DWORD fRtsControl:2; (* RTS flow control *) DWORD fAbortOnError:1; (* abort reads/writes on error *) DWORD fDummy2:17; (* reserved *)  *) wReserved: INTEGER; (* not currently used *) XonLim: INTEGER; (* transmit XON threshold *) XoffLim: INTEGER; (* transmit XOFF threshold *) ByteSize: SHORTINT; (* number of bits/byte, 4-8 *) Parity: SHORTINT; (* 0-4=no,odd,even,mark,space *) StopBits: SHORTINT; (* 0,1,2 = 1, 1.5, 2 *) XonChar: CHAR; (* Tx and Rx XON character *) XoffChar: CHAR; (* Tx and Rx XOFF character *) ErrorChar: CHAR; (* error replacement character *) EofChar: CHAR; (* end of input character *) EvtChar: CHAR; (* received event character *) END ; DCB16 = RECORD (* DCB structure for 16-bit Windows *) Id: SHORTINT; (* internal device identifier *) BaudRate: ARRAY 2 OF CHAR; (* baud rate *) ByteSize: SHORTINT; (* number of bits/byte, 4-8 *) Parity: SHORTINT; (* 0-4=none,odd,even,mark,space*) StopBits: SHORTINT; (* 0,1,2 = 1, 1.5, 2 *) RlsTimeout: INTEGER; (* timeout for RLSD to be set *) CtsTimeout: INTEGER; (* timeout for CTS to be set *) DsrTimeout: INTEGER; (* timeout for DSR to be set *) flags: INTEGER; (* bit fields of flags:  *) XonChar: CHAR; (* Tx and Rx XON character*) XoffChar: CHAR; (* Tx and Rx XOFF character *) XonLim: INTEGER; (* transmit XON threshold *) XoffLim: INTEGER; (* transmit XOFF threshold*) PeChar: CHAR; (* parity error replacement char *) EofChar: CHAR; (* end of Input character *) EvtChar: CHAR; (* received event character *) TxDelay: INTEGER; (* amount of time between chars*) END ; COMMTIMEOUTS = RECORD (* COMMTIMEOUTS *) ReadInterval: LONGINT; ReadTotalMultiplier: LONGINT; ReadTotalConstant: LONGINT; WriteTotalMultiplier: LONGINT; WriteTotalConstant: LONGINT; END ; COMSTAT32 = RECORD (* COMSTAT for Win32 *) status: SET; (* fields in status:  *) cbInQueue: LONGINT; (* bytes in input buffer *) cbOutQueue: LONGINT; (* bytes in output buffer *) END ; COMSTAT16 = RECORD (* COMSTAT for 16-bit Windows *) status: SHORTINT; cbInQueue: ARRAY 2 OF CHAR; cbOutQueue: ARRAY 2 OF CHAR; END ; VAR Error-: ARRAY 64 OF CHAR; PortNames: ARRAY 4 OF ARRAY 8 OF CHAR; ComDevice: LONGINT; (* Hex: ARRAY 16+1 OF CHAR; *) out, nofelems: INTEGER; Buf: ARRAY BufSize OF S.BYTE; onWin32: BOOLEAN; (* Win32 *) CreateFile: PROCEDURE (name: LONGINT; accessMode: LONGINT; shareMode: LONGINT; securityAttr: LONGINT; createOpts: LONGINT; attrAndFlags: LONGINT; template: LONGINT): LONGINT; CloseHandle: PROCEDURE (h: LONGINT); ReadFile: PROCEDURE (f: LONGINT; data: LONGINT; count: LONGINT; VAR read: LONGINT; ovrlp: LONGINT): BOOLEAN; WriteFile: PROCEDURE (f: LONGINT; data, count: LONGINT; VAR written: LONGINT; ovrlp: LONGINT): BOOLEAN; GetLastError: PROCEDURE (): LONGINT; GetCommState: PROCEDURE (hComDev, lpdcb: LONGINT): BOOLEAN; SetCommState: PROCEDURE (hComDev, lpdcb: LONGINT): BOOLEAN; BuildCommDCB: PROCEDURE (lpszDef, lpdcb: LONGINT): BOOLEAN; PurgeComm: PROCEDURE (hComDev, action: LONGINT): BOOLEAN; SetCommTimeouts: PROCEDURE (hComDev, lpctmo: LONGINT): BOOLEAN; SetupComm: PROCEDURE (hComDev, cbInQueue, cbOutQueue: LONGINT): BOOLEAN; FlushFileBuffers: PROCEDURE (hComDev: LONGINT): BOOLEAN; ClearCommError: PROCEDURE (hCommDev: LONGINT; VAR lpdwErrors: SET; lpcst: LONGINT): BOOLEAN; SetCommBreak: PROCEDURE (hCommDev: LONGINT): BOOLEAN; ClearCommBreak: PROCEDURE (hCommDev: LONGINT): BOOLEAN; (* 16-bit Windows *) OpenComm32: PROCEDURE(lpszDevControl, cbInQueue, cbOutQueue: LONGINT): LONGINT; (*BuildCommDCB32: PROCEDURE (lpszDef, lpdcb: LONGINT): LONGINT;*) CloseComm32: PROCEDURE(idComDev: LONGINT); WriteComm32: PROCEDURE(idComDev, lpvBuf, cbWrite: LONGINT): LONGINT; ReadComm32: PROCEDURE(idComDev, lpvBuf, cbRead: LONGINT): LONGINT; GetCommState32: PROCEDURE(idComDev, lpdcb: LONGINT): LONGINT; SetCommState32: PROCEDURE(lpdcb: LONGINT): LONGINT; GetCommError32: PROCEDURE(idComDev, lpStat: LONGINT): LONGINT; FlushComm32: PROCEDURE (idComDev, queue: LONGINT): LONGINT; SetCommBreak32: PROCEDURE (hCommDev: LONGINT): LONGINT; ClearCommBreak32: PROCEDURE (hCommDev: LONGINT): LONGINT; (* Errors returned by GetCommError32:  *) (*  *) PROCEDURE Append (VAR s: ARRAY OF CHAR; suff: ARRAY OF CHAR); VAR i, j, max: LONGINT; BEGIN i := 0; j := 0; max := LEN(s)-1; WHILE s[i] # 0X DO INC(i) END ; WHILE (i < max) & (suff[j] # 0X) DO s[i] := suff[j]; INC(i); INC(j) END ; s[i] := 0X; END Append; PROCEDURE IntToStr (x: LONGINT; VAR s: ARRAY OF CHAR); VAR i: INTEGER; PROCEDURE Digit (x: LONGINT); BEGIN IF x >= 10 THEN Digit(x DIV 10) END ; s[i] := CHR(x MOD 10 + ORD("0")); INC(i); END Digit; BEGIN i := 0; IF x < 0 THEN s[i] := "-"; x := -x; INC(i) END ; Digit(x); s[i] := 0X END IntToStr; PROCEDURE Stop*; BEGIN IF ComDevice >= 0 THEN IF onWin32 THEN CloseHandle(ComDevice) ELSE CloseComm32(ComDevice) END ; ComDevice := -1; END END Stop; PROCEDURE Start* (port, baudrate, parity, data, stop: LONGINT; VAR ok: BOOLEAN); VAR dcb32: DCB32; dcb16: DCB16; to: COMMTIMEOUTS; i: INTEGER; portname, s: ARRAY 32 OF CHAR; BEGIN ASSERT((0 <= port) & (port <= 4), 100); ASSERT((0 <= parity) & (parity <= 4), 101); ASSERT((7 <= data) & (data <= 8), 102); ASSERT((0 <= stop) & (stop <= 2), 103); IF ComDevice >= 0 THEN Stop END ; ok := TRUE; COPY(PortNames[port-1], portname); IF onWin32 THEN ComDevice := CreateFile(S.ADR(portname), GenRW, 0 (*excl acc*), 0 (*no sec attr*), OpenExisting, 0, 0); IF ComDevice # -1 THEN s := ""; IF GetCommState(ComDevice, S.ADR(dcb32)) THEN IF SetupComm(ComDevice, 1024, TxQueueSize) THEN dcb32.BaudRate := baudrate; dcb32.ByteSize := SHORT(SHORT(data)); dcb32.StopBits := SHORT(SHORT(stop)); dcb32.Parity := SHORT(SHORT(parity)); dcb32.flags := {0 (*binary*), 1 (*parity*), 2 (*outxCtsFlow*), 4 (*dtrControl: Enable*), 13 (*rtsControlHandshake*), 14 (*abortOnError*) }; IF SetCommState(ComDevice, S.ADR(dcb32)) THEN IF PurgeComm(ComDevice, 0CH) (* clear input and output buffers *) THEN to.ReadInterval := MAXDWORD; to.ReadTotalMultiplier := 0; to.ReadTotalConstant := 0; to.WriteTotalMultiplier := 0; to.WriteTotalConstant := 0; IF ~SetCommTimeouts(ComDevice, S.ADR(to)) THEN s := "SetCommTimeouts" END ELSE s := "PurgeComm" END ELSE s := "SetCommState" END ELSE s := "SetupComm" END ; ELSE s := "GetCommState" END ; IF s # "" THEN ok := FALSE; Error := "Error initializing port "; Append(Error, portname); Append(Error, " ("); Append(Error, s); Append(Error, " failed)"); END ELSE ok := FALSE; Error := "Error opening port "; Append(Error, portname); END ELSE ComDevice := OpenComm32(S.ADR(portname), 1024, TxQueueSize); IF ComDevice >= 0 THEN s := ""; IF 0 = GetCommState32(ComDevice, S.ADR(dcb16)) THEN dcb16.BaudRate[0] := CHR(baudrate MOD 256); dcb16.BaudRate[1] := CHR((baudrate DIV 256) MOD 256); dcb16.StopBits := SHORT(SHORT(stop)); dcb16.Parity := SHORT(SHORT(parity)); dcb16.ByteSize := SHORT(SHORT(data)); dcb16.flags := S.VAL(INTEGER, 1 + 8 + 8000H); (* binary, rts/cts handshake *) IF 0 = SetCommState32(S.ADR(dcb16)) THEN IF 0 = FlushComm32(ComDevice, 0) THEN IF 0 # FlushComm32(ComDevice, 1) THEN s := "FlushComm32" END ELSE s := "FlushComm32" END ELSE s := "SetCommState32" END ELSE s := "GetCommState" END ; IF s # "" THEN ok := FALSE; Error := "Error initializing port "; Append(Error, portname); Append(Error, " ("); Append(Error, s); Append(Error, " failed)"); END ELSE ok := FALSE; Error := "Error "; IntToStr(ComDevice, s); Append(Error, s); Append(Error, " opening port "); Append(Error, portname); ComDevice := -1; END END END Start; PROCEDURE Avail(): INTEGER; (* PRE: DomDevice # -1 *) (* returns number of bytes in Windows' input buffer *) VAR stat16: COMSTAT16; stat32: COMSTAT32; errors: SET; ret: LONGINT; BEGIN IF onWin32 THEN ASSERT(ClearCommError(ComDevice, errors, S.ADR(stat32))); RETURN SHORT(stat32.cbInQueue) ELSE ret := GetCommError32(ComDevice, S.ADR(stat16)); RETURN ORD(stat16.cbInQueue[0]) + 256*ORD(stat16.cbInQueue[1]); END END Avail; PROCEDURE AvailToSend(): INTEGER; VAR stat16: COMSTAT16; ret: LONGINT; BEGIN IF onWin32 THEN RETURN TxQueueSize ELSE ret := GetCommError32(ComDevice, S.ADR(stat16)); RETURN TxQueueSize - (ORD(stat16.cbOutQueue[0]) + 256*ORD(stat16.cbOutQueue[1])); END END AvailToSend; PROCEDURE Available*(): INTEGER; BEGIN IF ComDevice # -1 THEN RETURN nofelems + Avail() ELSE RETURN 0 END END Available; PROCEDURE Send* (x: S.BYTE); VAR done: BOOLEAN; n, written, ret, err, t: LONGINT; stat16: COMSTAT16; BEGIN IF ComDevice # -1 THEN IF onWin32 THEN done := WriteFile(ComDevice, S.ADR(x), 1, written, 0); ASSERT(done & (written = 1), 100); ELSE n := AvailToSend(); IF n < 1 THEN t := Input.Time() + SendTimeout; REPEAT n := AvailToSend() UNTIL (n > 0) OR (Input.Time() > t); END ; ASSERT(n > 0, 100); ret := WriteComm32(ComDevice, S.ADR(x), 1); IF ret <= 0 THEN (* t := Input.Time() + SendTimeout; REPEAT ret := WriteComm32(ComDevice, S.ADR(x), 1); UNTIL (ret > 0) OR (Input.Time() > t); IF ret <= 0 THEN err := GetCommError32(ComDevice, S.ADR(stat16)); HALT(100) END *) HALT(100) END END END END Send; PROCEDURE Receive* (VAR x: S.BYTE); VAR actuallyRead: LONGINT; n: INTEGER; done: BOOLEAN; ret, err, err2: LONGINT; stat16: COMSTAT16; BEGIN IF ComDevice # -1 THEN IF nofelems <= 0 THEN out := 0; REPEAT n := Avail() UNTIL n > 0; IF n > BufSize THEN n := BufSize END ; IF onWin32 THEN done := ReadFile(ComDevice, S.ADR(Buf[0]), n, actuallyRead, 0); ASSERT(done & (actuallyRead = n), 101); ELSE ret := ReadComm32(ComDevice, S.ADR(Buf[0]), n); IF ret # n THEN err := GetCommError32(ComDevice, S.ADR(stat16)); (* err = CE_RXOVER .. CE_MODE *) (* ret := ret+ReadComm32(ComDevice, S.ADR(Buf[0])+ret, n-ret); IF ret # n THEN err2 := GetCommError32(ComDevice, S.ADR(stat16)); HALT(102); END *) END ; ASSERT(ret = n, 101); END ; nofelems := n; END ; x := Buf[out]; INC(out); DEC(nofelems); ELSE x := 0X END END Receive; PROCEDURE Break*; CONST Pause = 10 (*millisec*); VAR T: LONGINT; BEGIN IF ComDevice # -1 THEN IF onWin32 THEN IF SetCommBreak(ComDevice) THEN T := Input.Time() + Pause; REPEAT UNTIL Input.Time() > T; ASSERT(ClearCommBreak(ComDevice), 100) ELSE HALT(100) END ELSE IF 0 = SetCommBreak32(ComDevice) THEN T := Input.Time() + Pause; REPEAT UNTIL Input.Time() > T; ASSERT(0 = ClearCommBreak32(ComDevice), 100) ELSE HALT(100) END END END END Break; PROCEDURE Init; VAR mod: LONGINT; BEGIN onWin32 := Win32.OS.platform # 0; ComDevice := -1; (* Hex := "0123456789ABCDEF"; *) out := 0; nofelems := 0; PortNames[0] := "COM1"; PortNames[1] := "COM2"; PortNames[2] := "COM3"; PortNames[3] := "COM4"; IF onWin32 THEN mod := Kernel.LoadLibrary("KERNEL32"); Kernel.GetAdr(mod, "CreateFileA", S.VAL(LONGINT, CreateFile)); Kernel.GetAdr(mod, "CloseHandle", S.VAL(LONGINT, CloseHandle)); Kernel.GetAdr(mod, "ReadFile", S.VAL(LONGINT, ReadFile)); Kernel.GetAdr(mod, "WriteFile", S.VAL(LONGINT, WriteFile)); Kernel.GetAdr(mod, "GetLastError", S.VAL(LONGINT, GetLastError)); Kernel.GetAdr(mod, "GetCommState", S.VAL(LONGINT, GetCommState)); Kernel.GetAdr(mod, "SetCommState", S.VAL(LONGINT, SetCommState)); Kernel.GetAdr(mod, "BuildCommDCBA", S.VAL(LONGINT, BuildCommDCB)); Kernel.GetAdr(mod, "PurgeComm", S.VAL(LONGINT, PurgeComm)); Kernel.GetAdr(mod, "SetCommTimeouts", S.VAL(LONGINT, SetCommTimeouts)); Kernel.GetAdr(mod, "SetupComm", S.VAL(LONGINT, SetupComm)); Kernel.GetAdr(mod, "FlushFileBuffers", S.VAL(LONGINT, FlushFileBuffers)); Kernel.GetAdr(mod, "ClearCommError", S.VAL(LONGINT, ClearCommError)); Kernel.GetAdr(mod, "SetCommBreak", S.VAL(LONGINT, SetCommBreak)); Kernel.GetAdr(mod, "ClearCommBreak", S.VAL(LONGINT, ClearCommBreak)); ELSE mod := Kernel.LoadLibrary("GDI32"); Kernel.GetAdr(mod, "OpenComm32", S.VAL(LONGINT, OpenComm32)); Kernel.GetAdr(mod, "CloseComm32", S.VAL(LONGINT, CloseComm32)); Kernel.GetAdr(mod, "WriteComm32", S.VAL(LONGINT, WriteComm32)); Kernel.GetAdr(mod, "ReadComm32", S.VAL(LONGINT, ReadComm32)); Kernel.GetAdr(mod, "SetCommState32", S.VAL(LONGINT, SetCommState32)); Kernel.GetAdr(mod, "GetCommState32", S.VAL(LONGINT, GetCommState32)); Kernel.GetAdr(mod, "GetCommError32", S.VAL(LONGINT, GetCommError32)); Kernel.GetAdr(mod, "FlushComm32", S.VAL(LONGINT, FlushComm32)); Kernel.GetAdr(mod, "SetCommBreak32", S.VAL(LONGINT, SetCommBreak32)); Kernel.GetAdr(mod, "ClearCommBreak32", S.VAL(LONGINT, ClearCommBreak32)); (* mod := Kernel.LoadLibrary("KERNEL32"); Kernel.GetAdr(mod,"BuildCommDCBA", S.VAL(LONGINT, BuildCommDCB32)); *) END END Init; BEGIN Init; END V24.