home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / term.seq < prev    next >
Text File  |  1991-01-18  |  5KB  |  156 lines
  1. \ Serial Terminal
  2.  
  3. ONLY FORTH ALSO DEFINITIONS DECIMAL
  4.  
  5. POSTFIX
  6.  
  7. \ UART Registers                                      24May88am
  8. HEX
  9. 3F8 CONSTANT PORT   ( COM1 )
  10. \ 2F8 CONSTANT PORT   ( COM2 )
  11. 0C CONSTANT SIRQ
  12. 21 CONSTANT IRQ-CTL
  13. DECIMAL
  14.  
  15. PORT 3 + CONSTANT LCR         ( line control register )
  16. PORT 4 + CONSTANT MCR         ( modem control register )
  17. PORT 5 + CONSTANT LSR         ( line status register )
  18. PORT     CONSTANT BAUDLO      ( baud register low )
  19. PORT 1 + CONSTANT BAUDHI      ( baud register high )
  20.  
  21. comment:
  22. PORT
  23.    Variable holding current UART base address.
  24. COM1
  25.    Select port 1 as serial port.
  26. COM2
  27.    Select port 2 as serial port.
  28.  
  29. TIMEOUT
  30.    Variable holding timeout count for serial input.  A value of
  31.    one corresponds to about 3/4 second timeout.  Storing a zero
  32.    here will effectively eliminate a serial timeout.
  33. comment;
  34.  
  35. \ Initialize UART                                     24May88am
  36. HEX
  37. : !LCR   ( n mask -- )   NOT LCR PC@ AND OR LCR PC! ;
  38. : DATA-BITS   ( n -- )   5 - 3 !LCR   ;
  39. : STOP-BITS   ( n -- )   2 AND 2* 4 !LCR   ;
  40. : PARITY      ( -- )     38 !LCR   ;
  41. 0 CONSTANT NO    8 CONSTANT ODD    18 CONSTANT EVEN
  42. : +BREAK      ( -- )     40 40 !LCR   ;
  43. : -BREAK      ( -- )     00 40 !LCR   ;
  44. DECIMAL
  45. : BAUD        ( n -- )
  46.    128 128 !LCR   9600 12 ROT */
  47.    256 /MOD  BAUDHI PC!  BAUDLO PC!  0 128 !LCR   ;
  48. : SINIT       ( -- )
  49.    8 DATA-BITS  1 STOP-BITS  NO PARITY  9600 BAUD  ;
  50.  
  51. comment:
  52. !LCR   Store bits in unmasked part of line control register
  53. DATA-BITS   Select number of data bits.
  54. STOP-BITS   Select number of stop nits.
  55. NO-PARITY   Select no parity
  56. ODD-PARITY  Select odd parity.
  57. EVEN-PARITY Select even parity.
  58. BREAK-ON    Begin break, hold SOUT low.
  59. BREAK-OFF   Return SOUT to high state.
  60. SET-DTR     Set DTR and RTS high.
  61. BAUD        Set baud rate to n.
  62. SINIT       Default initialization.
  63. comment;
  64.  
  65. \ Serial Receive                                      31Oct89AM
  66. 4000 CONSTANT BUF-SIZE
  67. CREATE BUF  BUF-SIZE ALLOT
  68. HERE CONSTANT BUF-END
  69. VARIABLE TAIL
  70. VARIABLE HEAD
  71. 2VARIABLE OLD-INT
  72. : +HEAD   ( -- )
  73.    HEAD @ 1+  DUP BUF-END = IF  DROP BUF  THEN   HEAD !  ;
  74. : SKEY?   ( -- f )
  75.    TAIL @ HEAD @ <>   ;
  76.  
  77. : ESC  ( -- )
  78.    KEY? IF KEY 27 = ABORT" OK" THEN ;
  79.  
  80. 100 value timeout  ( 100 = about 1 second )
  81. : skeywait  ( -- )      \ wait for character from serial port.
  82.                         \ check for ESC from user once a second.
  83.         begin   fudge @ timeout um*  0= and  ( > 65k goes to zero )
  84.                 0 do  skey? if undo exit then  loop
  85.                 esc
  86.         again ;
  87.  
  88. : SKEY   ( -- char )
  89. \   BEGIN  ESC  SKEY?  UNTIL
  90.    skeywait   HEAD @ C@    +HEAD   ;
  91.  
  92. : SEMIT   ( char -- )
  93.    BEGIN  LSR PC@ 32 AND  UNTIL   PORT PC!  ;
  94.  
  95. \ Interrupt Service Routine
  96. HEX
  97. LABEL ISR
  98. \ Read a character from the serial port and put it into
  99. \ the serial buffer.
  100.    STI  AX PUSH  BX PUSH  DX PUSH  DS PUSH
  101.    CS AX MOV  AX DS MOV
  102.    PORT # DX MOV  DX AL IN
  103.    TAIL #) BX MOV  AL 0 [BX] MOV  BX INC
  104.    BUF-END # BX CMP  0= IF  BUF # BX MOV  THEN   BX TAIL #) MOV
  105.    20 # AL MOV  AL 20 # OUT  ( End-of-Interrupt command )
  106.    DS POP  DX POP  BX POP  AX POP  IRET  END-CODE
  107.  
  108.  
  109. CODE TRAP  ( -- )
  110. \ Save old interrupt vector and install my interrupt routine.
  111.    BX PUSH  DS PUSH  ES PUSH
  112.    3500 SIRQ + # AX MOV  21 INT
  113.    ES OLD-INT #) MOV  BX OLD-INT 2+ #) MOV
  114.    CS PUSH  DS POP  ISR # DX MOV
  115.    2500 SIRQ + # AX MOV  21 INT
  116.    ES POP  DS POP  BX POP  NEXT END-CODE
  117.  
  118. CODE RELEASE  ( -- )
  119. \ Restore previous serial interrupt vector.
  120.    DS PUSH  OLD-INT 2+ #) DX MOV  OLD-INT #) DS MOV
  121.    2500 SIRQ + # AX MOV  21 INT  DS POP  NEXT END-CODE
  122.  
  123. : ENABLE   ( -- )
  124. \ Initialize pointers, enable UART interrupts and enable
  125. \ interrupt controller.
  126.    BUF TAIL !  BUF HEAD !   0B MCR PC!  1 PORT 1+ PC!
  127.    IRQ-CTL PC@  0EF AND  IRQ-CTL PC! ;
  128.  
  129. : DISABLE   ( -- )
  130. \ Disable serial interrupt at interrupt controller.
  131.    IRQ-CTL PC@ 10 OR IRQ-CTL PC!   ;
  132.  
  133. : SERIAL-ON   ( -- )   TRAP  ENABLE   ;
  134. : SERIAL-OFF  ( -- )   DISABLE  RELEASE   ;
  135.  
  136. DECIMAL
  137.  
  138. \ Dumb Terminal
  139. : (TEMIT)  ( char -- )
  140.         DUP 10 = IF DROP  CR          ELSE
  141.         DUP 13 = IF EMIT  #OUT OFF    ELSE
  142.         EMIT THEN THEN ;
  143.  
  144. DEFER TEMIT  ' (TEMIT) IS TEMIT
  145.  
  146. : KILL  HEAD @ TAIL ! ;
  147.  
  148. : TALK  ( -- )
  149.         KILL
  150.         BEGIN   KEY? IF   KEY DUP 27 =
  151.                 IF  DROP EXIT  THEN   SEMIT   THEN
  152.                 SKEY? IF  SKEY TEMIT   THEN
  153.         AGAIN ;
  154.  
  155.  
  156.