home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FPC355_3.ZIP / ZIMMER.ZIP / RS232IB.SEQ < prev    next >
Encoding:
Text File  |  1991-04-23  |  20.0 KB  |  498 lines

  1. \\ RS232IB.SEQ     A BUFFERED CHIP LEVEL RS-232 driver for 8250 chip
  2.  
  3.   This code supports both RS232 ports, but ONLY ONE AT A TIME !!  You
  4. can select either COM1, or COM2 for serial operation. Input is buffered
  5. with a 256 character buffer, so you shouldn't have trouble with receive
  6. overrun.
  7.  
  8.   A simple terminal program is included as an example of usage. If you
  9. use TCOM to target compile this file, you will get a VERY SIMPLE terminal
  10. program that runs in FULL DUPLEX.
  11.  
  12.   This file can be compiled on either F-PC, or TCOM. If you compile it
  13. on F-PC, then the installed interrupt vectors will automatically be
  14. un-installed when you leave F-PC.
  15.  
  16. ****************************** WARNING ******************************
  17.  
  18.           IF YOU USE TCOM TO COMPILE THIS FILE THEN YOU WILL
  19.         NEED TO USE ?REST_COM1: OR ?REST_COM2: TO RESTORE WHICH
  20.         EVER COMM PORT INTERRUPTS YOU WERE USING IN THE
  21.         APPLICATION BEFORE LEAVING THE PROGRAM OR YOU WILL
  22.         SURELY **CRASH** LATER!!!!
  23.  
  24. **********************************************************************
  25.  
  26. {
  27.  
  28. decimal
  29.  
  30. \ ***************************************************************************
  31. \ the next few lines define immediate words that allow definitions to
  32. \ select what will be compiled from source lines for either F-PC or TCOM.
  33. \
  34. \ \ DEFINED TARGET-INIT NIP 0= #IF  \ Test for NOT target compiling
  35. \ \
  36. \ \ ' noop alias \F immediate       \ create \F as a NOOP while in F-PC
  37. \ \ ' \    alias \T immediate       \ create \T as "\" while in F-PC
  38. \ \
  39. \ \ #ELSE
  40. \ \
  41. \ \ ' \    alias \F immediate       \ create \F as "\" while TCOMing
  42. \ \ ' noop alias \T immediate       \ create \T as a NOOP while TCOMing
  43. \ \
  44. \ \ #ENDIF
  45.  
  46. \f code int3       ( -- )
  47. \f                 int 3
  48. \f                 next            end-code
  49.  
  50. \ ***************************************************************************
  51.  
  52. variable rs232_base     \ holds physical address where rs232 boards reside.
  53.                         \ $40:00 is where first  board resides,
  54.                         \ $40:02 is where second board resides if present.
  55. $40 rs232_base !
  56.  
  57. $20 constant EOI        \ End Of Interrupt
  58. $20 constant ictla      \ 8259 interrupt controller #1
  59.  
  60. variable rs232_port     \ port value initialized by COM-INIT and used by
  61.                         \ other com words.
  62. $00 rs232_port !
  63.  
  64. \       COM port buffer configuration.
  65.  
  66. \       [ cnt ][ data up to COMLIMIT ... ]
  67.  
  68. 256 constant bufsize
  69.  
  70. variable imask          \ 8259 interrupt mask bit variable
  71.                         \ COM1: = $10, COM2: = $08
  72. variable comEOI         \ 8259 End Of Interrupt, for specific interrupt
  73.                         \ INT4 (com1) = $64, INT3 (com2) = $63
  74. variable bufin          \ pointer for buffer input
  75. variable bufout         \ pointer for buffer extract
  76. variable intcnt
  77.  
  78. bufsize array combuf
  79.  
  80. variable interrupts     \ counter for the nubmer of interrupts received
  81.  
  82. 0 value rate
  83.  
  84. : baud          ( n1 --- )   \ convert baud value to timer value "rate"
  85.                 115200. rot um/mod nip =: rate ;
  86.  
  87. \ Use in the form "9600 baud". Any of the standard baud rates can be used
  88. \ up to 115200 baud. Non-standard baud rates can also be used, but
  89. \ accuracy will suffer at non0standard baud rates above 2400 baud.
  90.  
  91.  
  92. code com-init   ( parity+stops+bits  baud_val com_port --- )
  93. \T              CLEAR_LABELS
  94. \T              SAVE_BX
  95. \T              xchg si, sp
  96.                 pop bx                          \ comm port # 0 or 1
  97.                 shl bx, # 1                     \ convert to word offset
  98.                 push ds                         \ preserve DS
  99.                 mov ds, rs232_base              \ setup ds to get board base
  100.                 mov dx, 0 [bx]                  \ get port address of board
  101.                                                 \ from $40:$00 or $40:$02.
  102.                                                 \ DX = BASE + 0
  103.                 pop ds                          \ restore DS
  104.                 mov rs232_port dx               \ save port # in value
  105.                 add dx, # 3                     \ DX = BASE + 3
  106.                 mov al, # $80                   \ [DLAB]
  107.                 out dx, al
  108.                 sub dx, # 2                     \ DX = BASE + 1
  109.                 pop ax                          \ baud timer value
  110.                 xchg al, ah                     \ get high part into AL
  111.                 out dx, al                      \ set high part
  112.                 dec dx                          \ DX = BASE + 0
  113.                 jmp 0 $                         \ wait a few clock cycles
  114.            0 $: xchg al, ah                     \ low part into AL
  115.                 out dx, al                      \ set low part
  116.                 add dx, # 3                     \ adj to control reg
  117.                                                 \ DX = BASE + 3
  118.                 pop ax                          \ pop parity, stops, & bits
  119.                 out dx, al                      \ set parity, stops, & bits
  120.                 jmp  1 $                        \ wait some more clocks
  121.            1 $: sub dx, # 2                     \ DX = BASE + 1
  122. \ interrupt enable stuff follows...
  123.                 in al, dx                       \ get current intterupt stat
  124.                 or al, # $01                    \ include DAV interrupt bit
  125.                 out dx, al                      \ interrupt enables off
  126.                 add dx, # $03                   \ DX = BASE + 4
  127.                 in al, dx                       \ PC bus interrupt control
  128.                 or al, # $08                    \ enable chip to bus
  129.                 out dx, al                      \ put back into register
  130.  
  131.                 in al, # ictla 1+               \ get int mask reg from 8259
  132.                 jmp 3 $
  133.            3 $: mov ah, imask                   \ mask bit in 8259
  134.                                                 \ $10 = IRQ4, $08 = IRQ3
  135.                 not ah                          \ compliment for AND to follow
  136.                 and al, ah                      \ clear com port INT bit
  137.                 out # ictla 1+ al               \ restore new mask
  138.  
  139.                 mov intcnt # 0 word             \ zero out interrupt counter
  140.                 mov dx, rs232_port              \ get the comport we're using
  141.                 in al, dx                       \ read port to clear it
  142.                 jmp 2 $
  143.            2 $: in al, dx                       \ read port to clear it again
  144. \F              next
  145. \T              XCHG SI, SP
  146. \T              LOAD_BX
  147. \T              RET
  148.                 end-code
  149.  
  150. code rs232_intoff ( -- )                \ interrupt clear stuff follows...
  151. \T              CLEAR_LABELS
  152.                 \ about to SET port interrupt mask bits to disable interrupts
  153.                 cli
  154.                 in al, # ictla 1+               \ get int mask reg from 8259
  155.                 jmp 0 $
  156.            0 $: or al, imask                    \ SET com port MASK INT bits
  157.                                                 \ $10 = IRQ4, $08 = IRQ3
  158.                 out # ictla 1+ al               \ restore new mask
  159.                 mov al, comEOI          \ Specific EOI for interrupt 4
  160.                                         \ INT4=$64, INT3=$63
  161.                 out # ictla al
  162.                 sti
  163.                 mov dx, rs232_port
  164.                 inc dx                          \ DX = BASE + 1
  165.                 in al, dx                       \ get current intterupt stat
  166.                 mov ah, # $01                   \ DAV interrupt bit
  167.                 not ah                          \ compliment for and
  168.                 and al, ah                      \ clear DAV interrupt bit
  169.                 out dx, al                      \ interrupt enables off
  170.                 add dx, # $03                   \ DX = BASE + 4
  171.                 in al, dx                       \ PC bus interrupt control
  172.                 mov ah, # $08                   \ chip bus enable bit
  173.                 not ah                          \ we want to clear it
  174.                 and al, ah                      \ clear bus enable bit
  175.                 out dx, al                      \ put back into register
  176. \F              next
  177. \T              RET
  178.                 end-code
  179.  
  180.  
  181. code com-out    ( c1 --- )
  182. \T              CLEAR_LABELS
  183.                 mov dx, rs232_port              \ get the comport we're using
  184.                 mov di, dx                      \ copy into DI
  185.                 add dx, # 5
  186.                 mov cx, # $FFFF                 \ timeout value
  187.            2 $: dec cx
  188.                 j0= 3 $                         \ leave if timed out
  189.                 in al, dx                       \ get status port
  190.                 and al, # $20
  191.                 cmp al, # $20                   \ transmit register empty
  192.                 j<> 2 $
  193.            3 $: mov dx, di                      \ back to data port
  194. \F              pop ax                          \ get actual data to send
  195. \T              mov ax, bx
  196.                 out dx, al                      \ and then send the byte
  197. \F              next
  198. \T              LOAD_BX
  199. \T              RET
  200.                 end-code
  201.  
  202. code com-in     ( --- c1 )
  203. \T              CLEAR_LABELS
  204. \T              SAVE_BX
  205.                 mov dx, rs232_port              \ get the comport we're using
  206.                 mov di, dx                      \ copy into DI
  207.                 add dx, # 5
  208.                 mov cx, # $FFFF                 \ time out value
  209.            4 $: dec cx                          \ start time out
  210.                 j0= 5 $                         \ leave if timeout
  211.                 in al, dx                       \ get status port
  212.                 and al, # $01
  213.                 cmp al, # $01                   \ receive buffer full?
  214.                 j<> 4 $
  215.            5 $: mov dx, di                      \ back to data port
  216.                 in al, dx                       \ get the byte
  217.                 sub ah, ah                      \ clear high byte
  218. \F              1push
  219. \T              MOV BX, AX
  220. \T              RET
  221.                 end-code
  222.  
  223. code com-stat   ( --- c1 )
  224. \T              SAVE_BX
  225.                 mov dx, rs232_port              \ get the comport we're using
  226.                 mov di, dx                      \ copy into DI
  227.                 add dx, # 5
  228.                 in al, dx                       \ get status port
  229.                 sub ah, ah                      \ clear high byte
  230. \F              1push
  231. \T              MOV BX, AX
  232. \T              RET
  233.                 end-code
  234.  
  235. \T HERE-T CONSTANT COM_INT
  236.  
  237. \T CODE %%com_int  ( --- )         \ COM port interrupt handler
  238. \T              CLEAR_LABELS
  239. \F LABEL com_int
  240.                 push es         \ save all of the registers
  241.                 push ds
  242.                 push dx
  243.                 push si
  244.                 push di
  245.                 push cx
  246.                 push bx
  247.                 push ax
  248.                 mov ax, cs                      \ setup DS: = CS:
  249. \T              add ax, cs: $103 \ address contains offset to base of DS: seg
  250.                 mov ds, ax
  251.                 inc interrupts word
  252. \ test for a waiting char, and get it into AL
  253.                 mov dx, rs232_port              \ get the comport we're using
  254.                 mov di, dx                      \ copy into DI
  255.            2 $: add dx, # 5
  256.                 in al, dx                       \ get status port
  257.                 and al, # $01
  258.                 cmp al, # $01                   \ receive buffer full?
  259.                 j<> 1 $                         \ ignore if not valid
  260.                 mov dx, di                      \ back to data port
  261.                 in al, dx                       \ get the byte
  262. \ save away the character and bump buffer counter
  263.                 mov bl, bufin                   \ get buffer input pointer
  264.                 cmp bl, bufout                  \ is buffer full?
  265.                 j=  1 $                         \ if full discard char
  266.                 sub bh, bh                      \ clear high part of BX
  267.                 add bx, # combuf                \ add base of COMBUF
  268.                 mov 0 [bx], al                  \ save the character
  269.                 inc bufin byte                  \ bump count
  270.                 sub ax, ax
  271.                 j 2 $                           \ may need to get additional
  272. \ restore everything and return from interrupt
  273.            1 $: mov al, # EOI
  274.                 out # ictla al
  275.                 inc intcnt word                 \ bump interrupt counter
  276.                 pop ax          \ restore all of the registers
  277.                 pop bx
  278.                 pop cx
  279.                 pop di
  280.                 pop si
  281.                 pop dx
  282.                 pop ds
  283.                 pop es
  284.                 iret            end-code
  285.  
  286. variable com1_int#      $0C com1_int# !
  287. variable com2_int#      $0B com2_int# !
  288.  
  289. 0 value commport
  290. 2variable comsave1              \ a place to save the old interrupt vector 4
  291. 2variable comsave2              \ a place to save the old interrupt vector 3
  292.  
  293. code rest_com1: ( --- )                 \ restores COM1: interrupt vector
  294.                 push ds
  295.                 mov dx, comsave1
  296.                 mov ax, # $2500
  297.                 add ax, com1_int#
  298.                 mov ds, comsave1 2+
  299.                 int $21
  300.                 pop ds
  301. \F              next
  302. \T              RET
  303.                 end-code
  304.  
  305. code rest_com2: ( --- )                 \ restores COM2: interrupt vector
  306.                 push ds
  307.                 mov dx, comsave2
  308.                 mov ax, # $2500
  309.                 add ax, com2_int#
  310.                 mov ds, comsave2 2+
  311.                 int $21
  312.                 pop ds
  313. \F              next
  314. \T              RET
  315.                 end-code
  316.  
  317. : ?rest_com1:   ( --- )
  318. \F              defers byefunc
  319.                 comsave1 2@ or           \ don't restore vector thats not set
  320.                 if      rs232_intoff
  321.                         rest_com1:
  322.                         0.0 comsave1 2!
  323.                 then    ;
  324.  
  325. \F ' ?rest_com1: is byefunc
  326.  
  327. : ?rest_com2:   ( --- )
  328. \F              defers byefunc
  329.                 comsave2 2@ or           \ don't restore vector thats not set
  330.                 if      rs232_intoff
  331.                         rest_com2:
  332.                         0.0 comsave2 2!
  333.                 then    ;
  334.  
  335. \F ' ?rest_com2: is byefunc
  336.  
  337. code set_com1:  ( --- )                 \ Set the COM1: interrupt vector
  338.                 push ds
  339.                 push es
  340.                 mov dx, # com_int
  341.                 mov ax, # $2500
  342.                 add ax, com1_int#       \ COM1: interrupt vector = 04
  343.                 mov cx, cs
  344.                 mov ds, cx
  345.                 int $21
  346.                 pop es
  347.                 pop ds
  348. \F              next
  349. \T              RET
  350.                 end-code
  351.  
  352. code set_com2:  ( --- )                 \ Set the COM2: interrupt vector
  353.                 push ds
  354.                 push es
  355.                 mov dx, # com_int
  356.                 mov ax, # $2500
  357.                 add ax, com2_int#       \ COM2: interrupt vector = 03
  358.                 mov cx, cs
  359.                 mov ds, cx
  360.                 int $21
  361.                 pop es
  362.                 pop ds
  363. \F              next
  364. \T              RET
  365.                 end-code
  366.  
  367. code save_com1: ( --- )                 \ Save the COM1: interrupt vector IRQ4
  368. \T              PUSH BX
  369.                 push es
  370.                 mov ax, # $3500
  371.                 add ax, com1_int#       \ get the interrupt vector for com1:
  372.                 int $21
  373.                 mov comsave1 bx
  374.                 mov comsave1 2+ es       \ save old vector
  375.                 pop es
  376. \F              next
  377. \T              POP BX
  378. \T              RET
  379.                 end-code
  380.  
  381. code save_com2: ( --- )                 \ Save the COM2: interrupt vector IRQ3
  382. \T              PUSH BX
  383.                 push es
  384.                 mov ax, # $3500
  385.                 add ax, com2_int#       \ get the interrupt vector for com2:
  386.                 int $21
  387.                 mov comsave2 bx
  388.                 mov comsave2 2+ es       \ save old vector
  389.                 pop es
  390. \F              next
  391. \T              POP BX
  392. \T              RET
  393.                 end-code
  394.  
  395. : com-cnt       ( -- count )  \  get how many bytes are in the buffer
  396.                 bufin c@  bufout c@ -  1-  $ff and  ;
  397.  
  398.  
  399. : com-get       ( -- char )   \  get a character from the buffer
  400.                 com-cnt  0<>                    \ is buffer empty?
  401.                                                 \ if not...
  402.                 if      bufout c@ 1+ 255 and
  403.                         combuf +   c@           \ get the byte
  404.                         1 bufout +!             \ and increment the pointer
  405.                 else    0                       \ return junk (0) if empty
  406.                 then  ;
  407.  
  408.  
  409. : clr-buf       ( -- )   \ empty the buffer
  410.                 1 bufin !   0 bufout !  combuf bufsize erase ;
  411.  
  412. : .buf          ( --- )     \ display the buffer contents
  413.                 base @ hex
  414.                 cr ."  next byte " bufout c@ 1+ $ff and combuf + u.
  415.                 5 spaces ." last byte " bufin c@ 1- $ff and combuf + u.
  416.                 base !     5 spaces
  417.                 com-cnt dup 0= if ." empty" else dup . ." bytes,  " then
  418.                     bufsize 1- = if ." full" then
  419.                 combuf bufsize dump ;
  420.  
  421.  
  422. 0 constant nopar   8 constant oddpar  $18 constant evenpar \ parity control
  423. 0 constant 1stop   4 constant 2stop                        \ stop bit control
  424. 2 constant 7bit    3 constant 8bit                         \ length control
  425.  
  426. nopar 1stop 8bit + + value parity&bits \ default no parity, 8 bit, 2 stops
  427.  
  428. : com2:         ( --- )   \ initialize the communications port stuff
  429.                 2 =: commport
  430.                 $08 imask !
  431.                 $63 comEOI !
  432.                 cr ." Comm Port #2 selected" cr
  433.                 clr-buf
  434.                 comsave2 2@ d0=
  435.                 if      save_com2:      \ save the current vector into comsave
  436.                         set_com2:       \ set our com1 interrupt vector
  437.                         parity&bits rate 1 com-init      \ init the port 2
  438.                 then    ;
  439.  
  440. : com1:         ( -- )
  441.                 1 =: commport
  442.                 $10 imask !
  443.                 $64 comEOI !
  444.                 cr ." Comm Port #1 selected" cr
  445.                 clr-buf
  446.                 comsave1 2@ d0=
  447.                 if      save_com1:
  448.                         set_com1:       \ set our com1 interrupt vector
  449.                         parity&bits rate 0 com-init     \ init the port 1
  450.                 then    ;
  451.  
  452. : terminal      ( -- )
  453.                 DECIMAL                         \ always select decimal
  454. \T              MARGIN_INIT
  455. \T              DOSIO_INIT                      \ init EMIT, TYPE & SPACES
  456.                 9600 baud                       \ initialize the ports speed
  457.                 COM1:
  458.                 begin   key?
  459.                         if      key dup $1B =
  460.                                 if      drop
  461.                                         ?rest_com1:
  462.                                         cr true abort" Quitting"
  463.                                 then    com-out
  464.                         then
  465.                         com-cnt
  466.                         if      com-get emit
  467.                         then
  468.                 again   ;
  469.  
  470. \T \S           STOP HERE IF TARGET COMPILING
  471.  
  472. : ser_typel     ( seg a1 n1 -- )
  473.                 dup>r
  474.                 bounds
  475.                 ?do     dup i c@L com-out
  476.                 loop    drop r> #out +! ;
  477.  
  478. : ser_out       ( c1 -- )
  479.                 com-out #out incr ;
  480.  
  481. : ser_key       ( -- c1 )
  482.                 begin   com-cnt   until
  483.                 com-get ;
  484.  
  485. : toserial      ( -- )  \ re-direct Forth I/O to the serial port COM1:
  486.                 slow
  487.                 ['] (expect) is expect
  488.                 statoff
  489.                 9600 baud
  490.                 com1:
  491.                 ['] ser_typel is typel
  492.                 ['] ser_out   is emit
  493.                 ['] com-cnt   is key?
  494.                 ['] ser_key   is key ;
  495.  
  496. }
  497.  
  498.