{ ====================================================================
SIO.F
Serial port access extensions.
Copyright (C) 2001 FORTH, Inc.
Rick VanNorman rvn@forth.com
==================================================================== }
OPTIONAL SIO Serial port access extensions.
PACKAGE SERIALPORT
{ ------------------------ (C) globalchimes at yahoo dot ca ----------
Data structures
DIRTY is true if the status bar needs to be updated.
COM-NAME holds the ASCIIZ string defining the com port.
COM-SPEED holds the baud rate.
COM-SETTING holds miscellaneous settings:
+0 DCBflags low byte
+1 ByteSize
+2 Parity
+3 StopBits
COMMCONFIG is the data structure for the CommConfigDialog. It includes
an embedded DCB structure. COM: defines the DCB fields within COMMCONFIG.
--------------------------------------------------------------------------- }
VARIABLE DIRTY
CREATE COM-NAME 256 ALLOT
VARIABLE COM-SPEED
VARIABLE COM-SETTING
CREATE COMMCONFIG 15 CELLS DUP , CELL- /ALLOT
: COM: ( u1 u2 -- u3) CREATE OVER , +
DOES> ( -- addr) @ COMMCONFIG + ;
8 \ Header
4 COM: DCB \ Length of DCB
4 COM: BaudRate \ Line speed, bits per second
4 COM: DCBflags \ See flags below
2 + \ Not currently used
2 COM: XonLim \ Transmit XON threshold
2 COM: XoffLim \ Transmit XOFF threshold
1 COM: ByteSize \ Bits per character (4-8)
1 COM: Parity \ 0-4 --> no,odd,even,mark,space
1 COM: StopBits \ 0,1,2 --> 1,1.5,2
1 COM: XonChar \ Tx and Rx XON char
1 COM: XoffChar \ Tx and Rx XOFF char
1 COM: ErrorChar \ Error replacement char
1 COM: EofChar \ End of input char
1 COM: EvtChar \ Received event char
2 + \ Reserved, do not usde
DROP
{ ---------------------------------------------------------------------------
More data
COMH is the handle to the open com port.
COMM-TIMEOUTS is an array of data to tell the open com port to
return immediately if no characters are waiting.
XKEY-FLAG is true if a character is waiting and
XKEY-CHAR is the character received.
XMT-FLAG is a holding spot for data transmission and
XMT-CHAR is a holding spot for the transmit character.
(COM-KEY?) returns true if a character has been seen and not read; if
no previous character was waiting, it checks the serial port and reads
a character if available.
(COM-KEY) waits for and returns a character.
(COM-EMIT) sends a character.
--------------------------------------------------------------------------- }
0 VALUE COMH
CREATE COMM-TIMEOUTS -1 , 0 , 0 , 1 , 20 ,
PUBLIC
VARIABLE XKEY-FLAG
VARIABLE XKEY-CHAR
VARIABLE XMT-FLAG
VARIABLE XMT-CHAR
: (COM-KEY?) ( -- flag )
PAUSE XKEY-FLAG @ DUP ?EXIT DROP
COMH XKEY-CHAR 1 XKEY-FLAG 0 ReadFile 0= THROW
XKEY-FLAG @ ;
: (COM-KEY) ( -- char )
BEGIN (COM-KEY?) UNTIL XKEY-CHAR @ 0 XKEY-FLAG ! ;
: (COM-EMIT) ( char -- )
XMT-CHAR ! PAUSE
COMH XMT-CHAR 1 XMT-FLAG 0 WriteFile 0= THROW ;
: (COM-TYPE) ( addr u -- )
PAUSE COMH -ROT XMT-FLAG 0 WriteFile 0= THROW ;
PRIVATE
{ ---------------------------------------------------------------------------
Configuration
COMHELP tells the user a little about the TERM program usage.
?COMHELP checks for a baudrate and a comport name.
SERCONFIG runs the CommConfigDialog to let the user configure the port.
OPEN-COM returns a handle to the requested serial device.
CLOSE-COM closes the open com port.
COMINIT opens the specified device and sets its initial baudrate.
COMPORT performs initialization of the comport
--------------------------------------------------------------------------- }
: COMHELP
CR ." Must supply a baud rate and com port string. For example: "
." 9600 COM= COM2 ."
ABORT ;
: ?COMHELP ( -- )
DEPTH 0= IF COMHELP EXIT THEN
>IN @ BL WORD C@ 0= IF COMHELP EXIT THEN >IN ! ;
: SERCONFIG
COMMCONFIG >R
COM-NAME HWND R@ CommConfigDialog IF
COMH DCB SetCommState DROP
DIRTY ON
THEN
R> DROP ;
: OPEN-COM ( zaddr -- handle )
GENERIC_READ GENERIC_WRITE OR
0
0
OPEN_EXISTING
0
0
CreateFile
DUP -1 = ABORT" Port not available" ;
CONSOLE-WINDOW +ORDER
: CLOSE-COM ( -- )
COMH CloseHandle DROP 0 TO COMH
S" Inactive" 3 SF-STATUS PANE-TYPE ;
CONSOLE-WINDOW -ORDER
: COMINIT ( zaddr -- )
COMH IF CLOSE-COM THEN
OPEN-COM TO COMH
COMH COMM-TIMEOUTS SetCommTimeouts DROP ;
{ ---------------------------------------------------------------------
Port control
The EscapeCommFunction function directs a specified communications device
to perform an extended function.
BOOL EscapeCommFunction(
HANDLE hFile, // handle to communications device
DWORD dwFunc // extended function to perform
);
dwFunc Meaning
CLRDTR Clears the DTR (data-terminal-ready) signal.
CLRRTS Clears the RTS (request-to-send) signal.
SETDTR Sends the DTR (data-terminal-ready) signal.
SETRTS Sends the RTS (request-to-send) signal.
SETXOFF Causes transmission to act as if an XOFF character has been received.
SETXON Causes transmission to act as if an XON character has been received.
SETBREAK Suspends character transmission and places the transmission line in a break state until the ClearCommBreak function is called (or EscapeCommFunction is called with the CLRBREAK extended function code). The SETBREAK extended function code is identical to the SetCommBreak function. Note that this extended function does not flush data that has not been transmitted.
CLRBREAK Restores character transmission and places the transmission line in a nonbreak state. The CLRBREAK extended function code is identical to the ClearCommBreak function.
If the function succeeds, the return value is nonzero.
+DTR asserts DTR, -DTR lowers it. And so on...
--------------------------------------------------------------------- }
2 IMPORT: EscapeCommFunction
PUBLIC
: +DTR ( -- ) COMH SETDTR EscapeCommFunction DROP ;
: -DTR ( -- ) COMH CLRDTR EscapeCommFunction DROP ;
: +RTS ( -- ) COMH SETRTS EscapeCommFunction DROP ;
: -RTS ( -- ) COMH CLRRTS EscapeCommFunction DROP ;
: +BREAK ( -- ) COMH SETBREAK EscapeCommFunction DROP ;
: -BREAK ( -- ) COMH CLRBREAK EscapeCommFunction DROP ;
PRIVATE
{ ---------------------------------------------------------------------------
Comport status line
COMSTAT is an array in which the com status line is built.
.BAUD puts the numeric representation of the baud rate into COMSTAT .
.COM puts the ascii representation of the comport into COMSTAT .
.STATUS updates the status bar with the comport information.
?.STATUS updates the status line if DIRTY is true.
The message switch SBAR-MESSAGES is extended to include the detection
of a left button press on the com port status area of the status bar.
If a press is detected, the configuration dialog is displayed.
--------------------------------------------------------------------------- }
CREATE COMSTAT 256 ALLOT
: .BAUD
BASE @ >R DECIMAL
BaudRate @ (.) COMSTAT APPEND
R> BASE ! ;
: .COM ( -- )
COM-NAME ZCOUNT COMSTAT APPEND S" :" COMSTAT APPEND ;
CONSOLE-WINDOW +ORDER
DEFER .STATUS
: SIO.STATUS ( -- )
0 COMSTAT C! .COM .BAUD COMSTAT COUNT 3 SF-STATUS PANE-TYPE ;
' SIO.STATUS IS .STATUS
CONSOLE-WINDOW -ORDER
: ?.STATUS ( -- )
DIRTY @ IF .STATUS DIRTY OFF THEN ;
' SERCONFIG SBLHITS 3 CELLS + !
: COMSET: ( c1 c2 c3 c4 -- ) CREATE C, C, C, C,
DOES> ( -- ) COM-SETTING 4 CMOVE ;
{ --------------------------------------------------------------------
-------------------------------------------------------------------- }
PUBLIC
0 0 8 $11 COMSET: N,8,1 0 0 7 $11 COMSET: N,7,1
0 1 8 $13 COMSET: O,8,1 0 1 7 $13 COMSET: O,7,1
0 2 8 $13 COMSET: E,8,1 0 2 7 $13 COMSET: E,7,1
( Default) N,8,1
: COMPORT ( baud -- ) \ Usage: n COMPORT
BL WORD COUNT COM-NAME ZPLACE
COM-NAME COMINIT
COMH DCB GetCommState DROP
BaudRate !
COMH DCB SetCommState DROP
.STATUS ;
: COMPORT-COM1 ( baud -- ) \ Usage: n COMPORT-COM1
s" COM1" COM-NAME ZPLACE
COM-NAME COMINIT
COMH DCB GetCommState DROP
BaudRate !
COMH DCB SetCommState DROP
.STATUS ;
: COMPORT-COM2 ( baud -- ) \ Usage: n COMPORT-COM2
s" COM2" COM-NAME ZPLACE
COM-NAME COMINIT
COMH DCB GetCommState DROP
BaudRate !
COMH DCB SetCommState DROP
.STATUS ;
: COMPORT-COM3 ( baud -- ) \ Usage: n COMPORT-COM3
s" COM3" COM-NAME ZPLACE
COM-NAME COMINIT
COMH DCB GetCommState DROP
BaudRate !
COMH DCB SetCommState DROP
.STATUS ;
: COMPORT-COM4 ( baud -- ) \ Usage: n COMPORT-COM4
s" COM4" COM-NAME ZPLACE
COM-NAME COMINIT
COMH DCB GetCommState DROP
BaudRate !
COMH DCB SetCommState DROP
.STATUS ;
: COM= ( baud -- ) \ Usage: n COM=
BL WORD COUNT DUP 0= ABORT" NO NAME"
COM-NAME ZPLACE COM-SPEED ! ;
: +COM ( -- )
COM-NAME COMINIT
COMH DCB GetCommState DROP
COM-SPEED @ BaudRate !
COM-SETTING COUNT DCBflags C! COUNT ByteSize C!
COUNT Parity C! C@ StopBits C!
COMH DCB SetCommState DROP .STATUS ;
: -COM ( -- ) CLOSE-COM ;
:ONSYSLOAD 0 TO COMH ;
:ONSYSEXIT CLOSE-COM ;
PRIVATE
: COMPORT: ( -- ) >IN @ CREATE >IN ! BL STRING
DOES> COUNT COM-NAME ZPLACE ;
PUBLIC
COMPORT: COM1 COMPORT: COM2 COMPORT: COM3 COMPORT: COM4
: BAUD ( n -- ) COM-SPEED ! +COM ;
END-PACKAGE
.(
Type COMPORT COM[1234] to open a connection.
)