-
Notifications
You must be signed in to change notification settings - Fork 1
/
serial.scr
executable file
·1 lines (1 loc) · 39 KB
/
serial.scr
1
SERIAL.SCR contains general purpose queue routines, plus serial input and output routines. The serial buffer is kept within the dictionary. Uses either multi-tasking serial port polling or interrupts. copyright 1989-2007 Frank C. Sergeant - [email protected] BSD/MIT/X-style license, see file license20040130.txt. ( load screen Serial output & interrupt-driven serial input) ( queues) 6002 LOAD 6003 6004 THRU ( CODE version of queues) ( 6005 LOAD ( high-level version of queues) ( general serial port and modem) 6006 6024 THRU ( reading the serial port, either via polling or interrupts) ( 6025 6027 THRU ( using multi-tasking for SER-IN) 6028 6035 THRU ( using interrupts for SER-IN) ( create a queue of bytes) : BYTEQ: ( size -) ( - queue) CREATE DUP 1- ( ie modmask) , ( size) 0 ( ie head) , ( size) 0 ( ie tail) , ( size) ALLOT ( ) ; : QRESET ( queue -) CELL + DUP OFF CELL + OFF ; ( Queue handling words - in code) CODE (Q@ ( queue - c) ( this does not wait) 0 [BX] AX MOV, ( get mask) 2 [BX] AX AND, ( apply mask to head in AX) 2 [BX] W-PTR INC, ( increment the head for next time) AX BX ADD, ( add current head to start of queue) 6 [BX] BL MOV, ( skip over mask & pointers & fetch byte) BH BH SUB, NXT, END-CODE CODE Q? ( queue - #) 4 [BX] AX MOV, ( tail to AX) 2 [BX] AX SUB, ( subtract head) AX BX MOV, ( return #items in queue in BX) NXT, END-CODE : Q@ ( queue - c) BEGIN DUP Q? UNTIL (Q@ ; ( Queue handling words - in code) CODE Q! ( c queue -) 0 [BX] AX MOV, ( get mask) 4 [BX] AX AND, ( apply mask to tail in AX) 4 [BX] W-PTR INC, ( increment tail for next time) AX BX ADD, ( add current tail to start of queue) AX POP, ( get byte) AL 6 [BX] MOV, ( and store it) BX POP, ( refill top of stack) NXT, END-CODE ( QUEUE in high-level code ) : QMASK ( queue - mask) @ ; : QFROM ( queue - offset) CELL + @ ; ( head pointer) : QTO ( queue - offset) [ 2 CELLS ] LITERAL + @ ; ( tail) : Q? ( queue - #items) DUP QTO SWAP QFROM - ; : Q@ ( queue - c) BEGIN PAUSE DUP Q? UNTIL ( ie wait forever if necessary) DUP QMASK OVER QFROM AND OVER + [ 3 CELLS ] LITERAL + C@ 1 ROT CELL + +! ; : Q! ( c queue -) DUP QMASK OVER QTO AND OVER [ 2 CELLS ] LITERAL + 1 SWAP +! + [ 3 CELLS ] LITERAL + C! ; ( Set or clear specific bits of an I/O port ) : +BITS ( port mask -) OVER PC@ OR SWAP PC! ; : -BITS ( port mask -) $FF XOR OVER PC@ AND SWAP PC! ; ( serial port variables) VARIABLE PORT ( ie 1 or 2 for com1 or com2) VARIABLE IOBASE ( usually $03F8 for com1 or $02F8 for com2) VARIABLE SIRQ# ( Typically 4 for com1 and 3 for com2) VARIABLE SINT# ( Typically 12 for com1 and 11 for com2) ( serial port registers) : DATA ( - port) IOBASE @ ; ( serial data register) : IER ( - port) IOBASE @ 1+ ; ( interrupt enable register): DIV-LSB ( - port) DATA ; ( divisor ) : DIV-MSB ( - port) IER ; ( latches ) : IIR ( - port) IOBASE @ 2 + ; ( interrupt id register ) : LCR ( - port) IOBASE @ 3 + ; ( line control register ) : MCR ( - port ) IOBASE @ 4 + ; ( modem control register) : LSR ( - port ) IOBASE @ 5 + ; ( line status register ) : MSR ( - port ) IOBASE @ 6 + ; ( modem status register ) : FCR ( - port ) IIR ; ( fifo control register ) ( EXIT ) $0020 CONSTANT PIC_CTRL $0021 CONSTANT PIC_MASK ( Modem Control Register set bits) : DTR ( - port bit) MCR ( ie port) 1 ( ie bit) ; : RTS ( - port bit) MCR ( ie port) 2 ( ie bit) ; : OUT2 ( - port bit) MCR ( ie port) 8 ( ie bit) ; : +DTR ( -) DTR ( port bit) +BITS ; : -DTR ( -) DTR ( port bit) -BITS ; : +RTS ( -) RTS ( port bit) +BITS ; : -RTS ( -) RTS ( port bit) -BITS ; : +OUT2 ( -) OUT2 ( port bit) +BITS ; : -OUT2 ( -) OUT2 ( port bit) -BITS ; : LOOPBACK ( -) MCR $10 +BITS ; : NOLOOPBACK ( -) MCR $10 -BITS ; ( Modem Status Register read bits) : MSR: CREATE ( bit -) C, DOES> ( msr - f) C@ AND ( f) ; 1 MSR: dCTS $10 MSR: CTS 2 MSR: dDSR $20 MSR: DSR 4 MSR: dRING $40 MSR: RING 8 MSR: dRLSD $80 MSR: RLSD EXIT prefix of 'd' stands for 'delta' CTS = clear to send, DSR = data set ready RING = ring indicator dRING = trailing edge ring indicator RLSD = receive line signal detect = modem carrier detect ( select a serial port and create the queue) : COM ( port# -) 1 4 CLAMP 11 OVER 1 AND + SINT# ! 3 OVER 1 AND + SIRQ# ! DUP PORT ! $40 SWAP 1- 2* L@ DUP 0= ABORT" invalid serial port" IOBASE ! ; 4096 BYTEQ: SERIAL ( define the queue) ( 2 COM ( pick the serial port) ( Set databits and parity) : FIFO-OFF ( -) 0 FCR PC! ; : FIFO-ON ( -) ( 1) $87 FCR PC! NOP IIR PC@ $C0 AND $C0 - IF ( bad) FIFO-OFF THEN ; : DATABITS ( #bits -) 5 8 CLAMP 5 - LCR 3 -BITS LCR SWAP +BITS ; : PARITY! ( mask -) LCR $38 -BITS LCR SWAP +BITS ; : NO-PARITY ( -) 0 PARITY! ; : ODD-PARITY ( -) $08 PARITY! ; : EVEN-PARITY ( -) $18 PARITY! ; EXIT : MARK-PARITY ( -) $28 PARITY! ; : SPACE-PARITY ( -) $38 PARITY! ; ( baud rate) : >DIVISOR ( -) LCR $80 +BITS ; : >DATA ( -) LCR $80 -BITS ; : DIV@ ( - u) >DIVISOR DIV-LSB PC@ DIV-MSB PC@ $100 * + >DATA ; : DIV! ( u -) >DIVISOR DUP $100 U/ DIV-MSB PC! $FF AND DIV-LSB PC! >DATA ; VARIABLE BAUD-RATE 0 BAUD-RATE ! : BPS ( bps -) DUP BAUD-RATE ! DUP 49664 - IF 49664 1 ROT UM/MOD ELSE 1 ( 115,200) THEN DIV! DROP ; ( display serial port status ) : .bps ( divisor -) DUP 0= IF ." invalid " ELSE DUP 1 = IF ." 115200 " ELSE ( default) 49664 1 ROT UM/MOD 6 U.R SPACE THEN THEN DROP ; : .STA BASE @ HEX CR ." IER IIR LCR MCR LSR MSR DATA com port bps" CR DATA MSR LSR MCR LCR IIR IER 7 FOR PC@ 5 .R NEXT IOBASE PORT 2 FOR @ 5 .R NEXT BASE ! SPACE DIV@ .bps CR ; ( Serial input ) : RESET-SER-IN ( -) SERIAL QRESET ; : SER-IN? ( - #items_waiting) SERIAL Q? ; : SER-IN ( - c) SERIAL Q@ ; : GET-2BYTES ( - iijj) SER-IN ( ii) $100 * SER-IN ( jj) + ; ( Serial output >SERIAL ) : SER-OUT ( c -) LSR 10000 FOR DUP PC@ $20 AND ( ready?) IF 5 - ( ie DATA) PC! POP DROP EXIT ELSE 1 MS THEN NEXT -1 ABORT" timeout in SER-OUT " 2DROP ; : ONLYCR ( -) $0D SER-OUT ; : >SERIAL ( -) ['] SER-OUT IS EMIT ; ( EXIT ) : >FULLSERIAL ( -) ['] SER-IN? IS KEY? ['] SER-IN IS KEY ['] SER-OUT DUP IS EMIT IS DEFAULT-EMIT ; ( send a string to the modem) : >MODEM ( string -) >SERIAL COUNT TYPE ONLYCR >SCR ; COMPILER : M" ( -) \ " COMPILE >MODEM ; FORTH : M" ( -) $22 WORD >MODEM ; : ANSWER ( -) M" ATS0=1" ; : NOANSWER ( -) M" ATS0=0" ; : MODEM-INIT ( -) ( in case this resets the modem) -OUT2 50 MS +OUT2 -DTR 50 MS +DTR ; : +++ ( -) 3 FOR 4 MS '+ SER-OUT NEXT ; : HANG-UP ( -) CR ." Hanging up " ( -DTR 200 MS +DTR 200 MS -DTR ) 1000 MS +++ 1000 MS M" ATH0" 100 MS NOANSWER 100 MS -DTR ." -- modem should have hung up " ( MODEM-INIT) ; : STRING-IN? ( str1 str2 - f) ( is str1 contained in str2?) SWAP COUNT DUP PUSH ROT COUNT POP - ( how much longer is the 2nd string?) ( a # a #) ( DUP 0< IF 2DROP 2DROP 0 EXIT THEN ( s1 #1 s2 #) 1+ 0 MAX FOR ( s1 #1 s2) PUSH 2DUP ( s1 #1 s1 #1) R@ ROT ROT COMP POP SWAP ( s1 #1 s2 f) 0= IF 2DROP DROP -1 POP DROP EXIT THEN ( s1 #1 s2) 1+ NEXT 2DROP DROP 0 ; ( user interface) : GET-Y/N ( - f) BEGIN KEY DUP 'Y = OVER 'y = OR IF DROP -1 EXIT THEN DUP 'N = SWAP 'n = OR IF 0 EXIT THEN BEEP AGAIN ; : TRY-AGAIN? ( a - f) CR COUNT TYPE CR ." Try again? (Y/N) " GET-Y/N ( f) ; : .MSG ( a -) 0 0 AT 160 SPACES 0 0 AT COUNT TYPE ; ( ?SER-IN is an interruptable SER-IN) : ?SER-IN ( - c) BEGIN KEY? IF KEY DROP CR ." Abort serial transfer (Y/N)? " GET-Y/N CR ABORT" Transfer aborted" ." Transfer continuing " THEN SER-IN? IF SER-IN ( c) DUP EMIT EXIT THEN AGAIN ; ( WAIT-FOR) CREATE WAIT-BUFFER 50 ALLOT CREATE IN-BUFFER 50 ALLOT VARIABLE WAIT-LENGTH : WAIT-FOR ( a -) COUNT DUP WAIT-LENGTH ! ( a #) WAIT-BUFFER SWAP CMOVE ( ) IN-BUFFER WAIT-LENGTH @ FOR ( a) ?SER-IN ( a c) OVER C! 1+ ( a) NEXT DROP ( ) BEGIN WAIT-BUFFER IN-BUFFER WAIT-LENGTH @ COMP WHILE ( no match yet) IN-BUFFER DUP 1 +UNDER WAIT-LENGTH @ 1- CMOVE ?SER-IN IN-BUFFER WAIT-LENGTH @ 1- + C! ( ) REPEAT ( ) ; : GET-MODEM-STRING ( - a) ( eat leading CR and LF ) BEGIN ?SER-IN DUP $0A = OVER $0D = OR WHILE DROP REPEAT PAD 1+ SWAP ( then collect characters up to an ending CR ) BEGIN ( a c) DUP $0D - WHILE OVER C! 1+ ?SER-IN REPEAT DROP ( a) PAD - 1- PAD C! PAD ( DUP COUNT TYPE CR ) ; ( examine the serial queue for testing) : ?ECHO ( -) BEGIN SER-IN? WHILE SER-IN EMIT REPEAT ; : ?HEX ( -) BASE @ HEX BEGIN 100 MS SER-IN? WHILE PAUSE BEGIN SER-IN? WHILE PAUSE SER-IN 3 U.R REPEAT REPEAT BASE ! ; : ?DUMP ( -) ( non destructive dump of serial queue) BASE @ HEX CR SER-IN? FOR ?SCROLL SER-IN DUP SERIAL Q! DUP $20 '~ BETWEEN IF EMIT ELSE ." <" <# # #S #> ." >" THEN NEXT BASE ! ; ( multi-tasking, DRAIN the serial chip into the serial queue) : DRAIN ( -) BEGIN LSR PC@ 1 AND WHILE DATA PC@ SERIAL Q! ( get new byte & store in queue) REPEAT ; ( multi-tasking, READ-SERIAL SERIAL-TASK ) ( Read serial port and stuff characters into the serial queue) : READ-SERIAL ( -) BEGIN DRAIN PAUSE AGAIN ; TASK: SERIAL-TASK ' READ-SERIAL SERIAL-TASK TASK! EXIT : (.QUEUE ( -) HEX BEGIN PAUSE SER-IN? IF SER-IN 3 U.R THEN AGAIN DECIMAL ; TASK: .QUEUE ' (.QUEUE .QUEUE TASK! ( multi-tasking, COMM initialize serial port, etc. ) : COMM ( port -) COM ( ) 8 DATABITS NO-PARITY FIFO-ON 9600 BPS +DTR +RTS RESET-SER-IN SERIAL-TASK WAKE MULTI 200 MS RESET-SER-IN ; : UNINSTALL-SINT ( -) ; ( do nothing ) ( get & set interrupt vectors) CODE INT-VECTOR@ ( int# - seg offset) BL AL MOV, $35 #, AH MOV, $21 #, INT, ( call DOS) ES PUSH, NXT, END-CODE CODE INT-VECTOR! ( seg offset int# -) BL AL MOV, $25 #, AH MOV, DX POP, ( ie offset) DS POP, ( ie seg) $21 #, INT, ( call DOS) CS PUSH, DS POP, ( restore DS) BX POP, ( refill top of stack) NXT, END-CODE CODE INTS-OFF ( -) CLI, NXT, END-CODE CODE INTS-ON ( -) STI, NXT, END-CODE ( 8259 interrupt controller) : IRQ_MASK ( - mask) 1 SIRQ# @ FOR 2* NEXT ; ( above is the OR mask; it must be inverted for ANDing) : EOI ( -) $20 PIC_CTRL PC! ; ( send end-of-interrupt) : ENABLE_PIC ( -) PIC_MASK IRQ_MASK -BITS ( enable irq#) ; : DISABLE_PIC ( -) PIC_MASK IRQ_MASK +BITS ( disable irq#) ; ( Macros for building an interrupt handler) : EOI, ( -) $20 #, AL MOV, PIC_CTRL #, AL OUT, ; : ENABLE_PIC, ( -) PIC_MASK #, AL IN, IRQ_MASK $FF XOR #, AL AND, PIC_MASK #, AL OUT, ; : DISABLE_PIC, ( -) PIC_MASK #, AL IN, IRQ_MASK #, AL OR, PIC_MASK #, AL OUT, ; ( Macros for building an interrupt handler) : DRAIN, ( -) BEGIN, LSR #, DX MOV, AL IN, 1 #, AL AND, 0=, NOT, WHILE, DATA #, DX MOV, AL IN, ( read input character) SERIAL #, BX MOV, 0 [BX] CX MOV, ( mask) 4 [BX] CX AND, ( tail) 4 [BX] W-PTR INC, ( incr tail) CX BX ADD, ( add tail to start of buffer) AL 6 [BX] MOV, ( store char into buffer) REPEAT, ; : CLEAR-IID, ( -) BEGIN, IIR #, DX MOV, AL IN, 1 #, AL AND, 0=, WHILE, MSR #, DX MOV, AL IN, ( if delta flags caused the int) LSR #, DX MOV, AL IN, ( if OE etc caused the int) DRAIN, ( probably overkill) REPEAT, ; ( lay down the code to build the interrupt handler) : HANDLER, ( -) DS PUSH, DX PUSH, CX PUSH, BX PUSH, AX PUSH, ( save) CS PUSH, DS POP, ( in case int is called when in DOS, etc.) DISABLE_PIC, EOI, STI, DRAIN, CLEAR-IID, ( EOI, ) CLI, ENABLE_PIC, AX POP, BX POP, CX POP, DX POP, DS POP, IRET, ; ( installer for macro-defined handler) VARIABLE OLD-SVECTOR 2 ALLOT 0 0 OLD-SVECTOR 2! : INSTALL-SINT ( a -) INTS-OFF ( +DTR 10 MS -DTR 10 MS +DTR) 200 MS SINT# @ INT-VECTOR@ OLD-SVECTOR 2! CS@ SWAP SINT# @ ( seg offset int#) INT-VECTOR! ENABLE_PIC $0B MCR PC! ( set DTR, RTS, & OUT2 high) 1 IER PC! ( enable only data-in int) LSR PC@ MSR PC@ 2DROP DATA PC@ IIR PC@ 2DROP EOI RESET-SER-IN INTS-ON ; : UNINSTALL-SINT ( -) OLD-SVECTOR 2@ OR IF INTS-OFF DISABLE_PIC OLD-SVECTOR 2@ SINT# @ INT-VECTOR! 0 0 OLD-SVECTOR 2! INTS-ON ( ELSE CR ." Nothing to uninstall! " CR ) THEN ; ( do we need to drop DTR or RTS?) : BUILD-HANDLER ( -) " CODE SERIAL-HANDLER HANDLER, END-CODE ' SERIAL-HANDLER INSTALL-SINT " COUNT EVALUATE ; : COMM ( # -) UNINSTALL-SINT ( just in case) COM ( ) 8 DATABITS NO-PARITY FIFO-ON 9600 BPS BUILD-HANDLER +DTR +RTS RESET-SER-IN ; : RECOMM ( -) 8 DATABITS NO-PARITY FIFO-ON " ' SERIAL-HANDLER INSTALL-SINT " COUNT EVALUATE ; ( DUMB terminal) : DUMB ( -) ( abort by pressing ESC key ) CR BEGIN PAUSE SER-IN? IF SER-IN EMIT THEN KEY? IF KEY DUP 27 = IF DROP CR ." now in Pygmy " CR EXIT ELSE SER-OUT THEN THEN AGAIN ; ( DUMBER terminal) : ?LF ( last -) $0D = IF $0A EMIT THEN ; : DUMBER ( -) ( abort by pressing ESC key ) CR BEGIN PAUSE SER-IN? IF SER-IN DUP $0A = IF DROP ELSE DUP EMIT ?LF THEN THEN KEY? IF KEY DUP 27 = IF DROP CR ." now in Pygmy " CR EXIT ELSE SER-OUT THEN THEN AGAIN ;