sio.f

   1 \\r
   2 \ SIO.F\r
   3 \ Serial input/output words for IBM PC compatiables.\r
   4 \\r
   5 \ Adjust the value of CONSTANT words IRQ and COMBASE for your system.\r
   6 \\r
   7 \ SIO.F is a example of direct control of hardware.\r
   8 \ You should not or can not do this in a respectable OS.\r
   9 \ However, MS-DOS is not one of them :).\r
  10 \\r
  11 \ There are two input and output buffers. Serial port output as well as input\r
  12 \ are driven by interrupts. High-level words simply take or put characters in\r
  13 \ the buffers. Then the interrupt service routine takes outgoing characters\r
  14 \ from the output buffer and puts incomming characters in the input buffer.\r
  15 \\r
  16 \ 1996. 2. 9.\r
  17 \ Wonyong Koh\r
  18 \\r
  19 \ 1997. 6. 21\r
  20 \       Align 'IrptServ' according to new EXE structure.\r
  21 \r
  22 HEX\r
  23 \r
  24   3 CONSTANT IRQ        \ normally COM1 and COM3 use IRQ4,\r
  25                         \          COM2 and COM4 use IRQ3\r
  26 02F8 CONSTANT COMBASE   \ base address, 3F8 for COM1, 2F8 for COM2\r
  27                         \               3E8 for COM3, 2E8 for COM4\r
  28 \r
  29 : BINARY   2 BASE ! ;\r
  30 \r
  31 CODE ENABLE\r
  32     STI,\r
  33     NEXT,\r
  34 END-CODE\r
  35 \r
  36 CODE DISABLE\r
  37     CLI,\r
  38     NEXT,\r
  39 END-CODE\r
  40 \r
  41 20 CONSTANT CTRL8259_0          \ interrupt control register\r
  42 21 CONSTANT CTRL8259_1          \ interrupt mask register\r
  43 20 CONSTANT EOI                 \ end of interrupt\r
  44 \r
  45 COMBASE     CONSTANT TXR        \ transmission register (WRITE)\r
  46 COMBASE     CONSTANT RXR        \ receive register      (READ)\r
  47 COMBASE 1 + CONSTANT IER        \ interrupt enable\r
  48 COMBASE 2 + CONSTANT IIR        \ interrupt ID\r
  49 COMBASE 3 + CONSTANT LCR        \ line contril\r
  50 COMBASE 4 + CONSTANT MCR        \ modem control\r
  51 COMBASE 5 + CONSTANT LSR        \ line status\r
  52 COMBASE 6 + CONSTANT MSR        \ modem status\r
  53 COMBASE     CONSTANT DLL        \ divisor latch low\r
  54 COMBASE 1 + CONSTANT DLH        \ divisor latch high\r
  55 \r
  56 00 CONSTANT NO\r
  57 18 CONSTANT ODD\r
  58 08 CONSTANT EVEN\r
  59 : PARITY ( n -- )\r
  60     LCR PC@\r
  61     [ BINARY 00011000 INVERT HEX ] LITERAL AND\r
  62     OR LCR PC! ;\r
  63 \r
  64 : BITS ( n -- )                 \ n = 5, 6, 7, or 8\r
  65     5 -\r
  66     LCR PC@\r
  67     [ BINARY 00000011 INVERT HEX ] LITERAL AND\r
  68     OR LCR PC! ;\r
  69 \r
  70 : STOPBIT ( n -- )              \ n = 0 or 1\r
  71     2 LSHIFT\r
  72     LCR PC@\r
  73     [ BINARY 00000100 INVERT HEX ] LITERAL AND\r
  74     OR LCR PC! ;\r
  75 \r
  76 : BPS ( n -- )                  \ set speed\r
  77     LCR PC@ SWAP\r
  78     0FF LCR PC!                 \ set Divisor-Latch Access-Bit\r
  79     [ DECIMAL ] 115200.\r
  80     [ HEX ] ROT UM/MOD NIP      \ calculate divisor\r
  81     DUP 0FF AND  DLL PC!\r
  82         8 RSHIFT DLH PC!\r
  83     LCR PC! ;                   \ restore original LCR\r
  84 \r
  85 : DROP-RTS\r
  86     1 MSR PC! ;\r
  87 \r
  88 : DTR-RTS\r
  89     3 MSR PC! ;\r
  90 \r
  91 DTR-RTS\r
  92 \r
  93 BINARY\r
  94 : CLEAR-UART\r
  95     BEGIN\r
  96        RXR PC@ DROP\r
  97        LSR PC@ DROP\r
  98        MSR PC@ DROP\r
  99        EOI CTRL8259_0 PC!\r
 100        IIR PC@ 00000001 AND\r
 101     UNTIL ;\r
 102 \r
 103 : ENABLE-IRQ\r
 104     CTRL8259_1 PC@\r
 105     [ 1 IRQ LSHIFT INVERT ] LITERAL AND         \ clear mask bit\r
 106     CTRL8259_1 PC!\r
 107 \r
 108     LCR PC@  01111111 AND  LCR PC!              \ clear divisor latch addr.\r
 109 \r
 110     00001111 IER PC!                    \ interrupts when data received\r
 111     CLEAR-UART\r
 112     MCR PC@  00001000 OR  MCR PC!       \ allow modem to generate interrupts\r
 113     ENABLE ;\r
 114 \r
 115 : DISABLE-IRQ\r
 116     CTRL8259_1 PC@\r
 117     [ 1 IRQ LSHIFT ] LITERAL OR         \ set mask bit\r
 118     CTRL8259_1 PC!\r
 119 \r
 120     00000000 IER PC!                    \ no interrupt allowed\r
 121 \r
 122     MCR PC@  11110111 AND  MCR PC! ;\r
 123 \r
 124 DECIMAL\r
 125 \r
 126 1 10 LSHIFT CONSTANT RxBufSize  \ receive buffer size = 2 ^ 10 (1024)\r
 127                                 \ The buffer size should be power of 2.\r
 128 VARIABLE RxBuffer  RxBufSize ALLOT\r
 129 VARIABLE #Rx\r
 130 VARIABLE RxHead\r
 131 VARIABLE RxTail\r
 132 VARIABLE RxOverflow\r
 133 \r
 134 1 8 LSHIFT CONSTANT TxBufSize   \ transmit buffer size = 2 ^ 8 (256)\r
 135                                 \ The buffer size should be power of 2.\r
 136 CREATE TxBuffer  TxBufSize CHARS ALLOT\r
 137 VARIABLE #Tx\r
 138 VARIABLE TxHead\r
 139 VARIABLE TxTail\r
 140 \r
 141 VARIABLE LSR@\r
 142 VARIABLE MSR@\r
 143 \r
 144 HEX\r
 145 \r
 146 : CLEAR-BUFFER\r
 147     DISABLE\r
 148     0 #Rx    !\r
 149     0 RxHead !\r
 150     0 RxTail !\r
 151     0 #Tx    !\r
 152     0 TxHead !\r
 153     0 TxTail !\r
 154     -1 LSR@ !\r
 155     -1 MSR@ !\r
 156     ENABLE ;\r
 157 \r
 158 CODE ModemServ\r
 159     MSR # DX MOV,\r
 160     DX AL IN,\r
 161     AL MSR@ ) MOV,\r
 162     RET,\r
 163 END-CODE\r
 164 \r
 165 CODE TxServ\r
 166     0 # #Tx ) WORD CMP,\r
 167     1 L# JNZ,\r
 168     IER # DX MOV,\r
 169     01 # AL MOV,\r
 170     DX AL OUT,                  \ Disable TXR empty irpt\r
 171     RET,\r
 172 1 L:\r
 173     TxTail ) BX MOV,\r
 174     TxBuffer [BX] AL MOV,\r
 175     TXR # DX MOV,\r
 176     DX AL OUT,\r
 177     BX INC,\r
 178     TxBufSize 1- # BX AND,\r
 179     BX TxTail ) MOV,\r
 180     #Tx ) WORD DEC,\r
 181     RET,\r
 182 END-CODE\r
 183 \r
 184 CODE RxServ\r
 185     RXR # DX MOV,\r
 186     DX AL IN,\r
 187     RxBufSize # #Rx ) CMP,\r
 188     1 L# JNZ,\r
 189     -1 # RxOverflow ) MOV,\r
 190     RET,\r
 191 1 L:\r
 192     RxHead ) BX MOV,\r
 193     AL RxBuffer [BX] MOV,\r
 194     BX INC,\r
 195     RxBufSize 1- # BX AND,\r
 196     BX RxHead ) MOV,\r
 197     #Rx ) WORD INC,\r
 198     RET,\r
 199 END-CODE\r
 200 \r
 201 CODE LineServ\r
 202     LSR # DX MOV,\r
 203     DX AL IN,\r
 204     AL LSR@ ) MOV,\r
 205     RET,\r
 206 END-CODE\r
 207 \r
 208 CREATE IrptTable\r
 209 ' ModemServ , ' TxServ , ' RxServ , ' LineServ ,\r
 210 \r
 211 HEX\r
 212 \r
 213 CODE IrptServ\r
 214     STI,                        \ Enable irpt\r
 215     AX PUSH,\r
 216     BX PUSH,\r
 217     DX PUSH,\r
 218     DS PUSH,\r
 219     CHAR " PARSE model" ENVIRONMENT? DROP\r
 220     CHAR " PARSE ROM Model" COMPARE 0=\r
 221     CHAR " PARSE model" ENVIRONMENT? DROP\r
 222     CHAR " PARSE RAM Model" COMPARE 0= OR\r
 223     [IF]\r
 224        CS AX MOV,\r
 225        AX DS MOV,\r
 226     [THEN]\r
 227     CHAR " PARSE model" ENVIRONMENT? DROP\r
 228     CHAR " PARSE EXE Model" COMPARE 0=\r
 229     [IF]\r
 230       CS AX MOV,\r
 231       1000 # AX ADD,            \ data segment follows after 64KB code segment\r
 232       AX DS MOV,\r
 233     [THEN]\r
 234     IIR # DX MOV,               \ identify irpt\r
 235     DX AL IN,\r
 236     01 # AL TEST,\r
 237     1 L# JNZ,\r
 238     AX BX MOV,\r
 239     0006 # BX AND,\r
 240     IrptTable [BX] CALL,\r
 241 1 L:                            \ do end of interrupt\r
 242     EOI # AL MOV,\r
 243     CTRL8259_0 # AL OUT,\r
 244     IER # DX MOV,\r
 245     DX AL IN,\r
 246     AX PUSH,\r
 247     0 # AL MOV,\r
 248     DX AL OUT,\r
 249     AX POP,\r
 250     DX AL OUT,\r
 251     DS POP,\r
 252     DX POP,\r
 253     BX POP,\r
 254     AX POP,\r
 255     IRET,\r
 256 END-CODE\r
 257 \r
 258 CREATE OLD-VECTOR 2 CELLS ALLOT\r
 259 CODE ATTACH-IRPT ( -- )\r
 260     BX PUSH,\r
 261     DS PUSH,\r
 262     IRQ 8 + 3500 OR # AX MOV,           \ AL = irpt number, AH = 35h\r
 263     21 INT,                             \ DOS get interrupt vector service\r
 264     BX OLD-VECTOR ) MOV,                \ save old vector\r
 265     ES OLD-VECTOR CELL+ ) MOV,\r
 266     IRQ 8 + 2500 OR # AX MOV,           \ AL = irpt number, AH = 25h\r
 267     CS@ # DX MOV,\r
 268     DX DS MOV,                          \ irpt service roution in CS:IrptServ\r
 269     ' IrptServ # DX MOV,\r
 270     21 INT,                             \ DOS set irpt vector\r
 271     DS POP,\r
 272     BX POP,\r
 273     NEXT,\r
 274 END-CODE\r
 275 \r
 276 CODE DETACH-IRPT ( -- )                 \ restore old vector\r
 277     BX PUSH,\r
 278     DS PUSH,\r
 279     IRQ 8 + 2500 OR # AX MOV,           \ AL = irpt number, AH = 25h\r
 280     OLD-VECTOR ) DX MOV,\r
 281     OLD-VECTOR CELL+ ) DS MOV,          \ DOS set irpt vector\r
 282     21 INT,\r
 283     DS POP,\r
 284     BX POP,\r
 285     NEXT,\r
 286 END-CODE\r
 287 \r
 288 : SER-IN? ( -- f )                      \ true if char received\r
 289     #Rx @ 0<> ;\r
 290 \r
 291 : SER-IN ( -- x )\r
 292     #Rx @ 0= IF    0 EXIT\r
 293              ELSE  RxTail @ RxBuffer + C@\r
 294                    RxTail @ 1+ [ RxBufSize 1 - ] LITERAL AND RxTail !\r
 295                    -1 #Rx +!\r
 296              THEN ;\r
 297 \r
 298 VARIABLE TIMEOUT\r
 299 : SER-OUT ( x -- error_code )\r
 300     #Tx @ TxBufSize <>\r
 301     IF TxHead @ TxBuffer + C!\r
 302        TxHead @ 1+ [ TxBufSize 1- ] LITERAL AND TxHead !\r
 303        1 #Tx +!\r
 304        [ HEX ] 0F IER PC!\r
 305     THEN ;\r
 306 \r
 307 DECIMAL\r
 308 \r
 309 : TERM\r
 310     19200 BPS  NO PARITY  8 BITS  0 STOPBIT\r
 311     CLEAR-BUFFER\r
 312     ATTACH-IRPT\r
 313     ENABLE-IRQ\r
 314     CLEAR-BUFFER\r
 315     BEGIN\r
 316        SER-IN? IF  SER-IN EMIT  THEN\r
 317        EKEY?   IF  KEY DUP 27 = IF DROP DISABLE-IRQ DETACH-IRPT EXIT THEN\r
 318                        SER-OUT\r
 319                THEN\r
 320     AGAIN ;\r
 321 \r
 322 CHAR " PARSE FILE" ENVIRONMENT?\r
 323 [IF]\r
 324   0= [IF] << CON [THEN]\r
 325 [ELSE] << CON\r
 326 [THEN]\r