Make IO words vectored

generic/CoreForth.s

@@ -132,6 +132,10 @@ cold_start:
     .word LIT, 10, BASE, STORE
     .word LIT, data_start, DP, STORE
     .word LIT, last_word, LATEST, STORE
+    .word LIT, NOOP, DUP, TICKWAIT_KEY, STORE, TICKFINISH_OUTPUT, STORE
+    .word LIT, XKEY, TICKKEY, STORE
+    .word LIT, XEMIT, TICKEMIT, STORE
+    .word LIT, READ_LINE, TICKACCEPT, STORE
     .word COLD
 
     .ltorg
@@ -270,7 +274,7 @@ readline:
     movs r3, r1
     beq readline_end
 readline_loop:
-    bl read_key
+    bl readkey
     cmp r0, #13
     beq readline_end
     cmp r0, #127
@@ -301,41 +305,6 @@ readline_end:
     subs r0, r5, r4
     pop {r3, r4, r5, pc}
 
-/* read keys including escape sequences. Reading escape itself is
- * not supported yet. Escape sequences return negative numbers
- */
-read_widekey:
-    push {r4, r5, lr}
-    bl read_key
-    cmp r0, #27
-    bne 1f
-    bl read_key
-    cmp r0, '['
-    bne 1f
-    bl read_key
-    cmp r0, 'A'
-    blt 3f
-    cmp r0, 'Z'
-    bgt 3f
-    subs r4, r0, '@'
-    b 4f
-3:  movs r4, #10
-    movs r5, #10
-2:  cmp r0, '~'
-    beq 4f
-    cmp r0, '0'
-    blt 1f
-    cmp r0, '9'
-    bgt 1f
-    subs r0, '0'
-    muls r4, r4, r5
-    adds r4, r0
-    bl read_key
-    b 2b
-4:  movs r0, #0
-    subs r0, r4
-1:  pop {r4, r5, pc}
-
 printrstack:
     push {r4, lr}
     ldr r4, =addr_TASKZRTOS
@@ -889,7 +858,7 @@ fill_done:
     bl printrstack
     NEXT
 
-    defcode "EMIT", EMIT
+    defcode "PUTCHAR", PUTCHAR
     pop {r0}
     bl putchar
     NEXT
@@ -942,23 +911,41 @@ fill_done:
     defword ".", DOT
     .word DOTH, SPACE, EXIT
 
-    defcode "(KEY)", XKEY
-    bl read_key
-    push {r0}
-    NEXT
-
-    defcode "KEY", KEY
-    bl read_widekey
+    defcode "READ-KEY", READ_KEY
+    bl readkey
     push {r0}
     NEXT
 
-    defcode "READLINE", READLINE
-    pop {r1}
-    pop {r0}
+    defcode "READ-LINE", READ_LINE
+    ldr r0, =constaddr_TIB
+    ldr r0, [r0]
+    ldr r1, =constaddr_TIBSIZE
+    ldr r1, [r1]
     bl readline
     push {r0}
     NEXT
 
+    defword "WAIT-KEY", WAIT_KEY
+    .word TICKWAIT_KEY, FETCH, EXECUTE, EXIT
+
+    defword "FINISH-OUTPUT", FINISH_OUTPUT
+    .word TICKFINISH_OUTPUT, FETCH, EXECUTE, EXIT
+
+    defword "(KEY)", XKEY
+    .word WAIT_KEY, READ_KEY, EXIT
+
+    defword "KEY", KEY
+    .word TICKKEY, FETCH, EXECUTE, EXIT
+
+    defword "(EMIT)", XEMIT
+    .word FINISH_OUTPUT, PUTCHAR, EXIT
+
+    defword "ACCEPT", ACCEPT
+    .word TICKACCEPT, FETCH, EXECUTE, EXIT
+
+    defword "EMIT", EMIT
+    .word TICKEMIT, FETCH, EXECUTE, EXIT
+
     defword "DUMP", DUMP
     .word QDUP, QBRANCH, dump_end - .
     .word SWAP
@@ -1055,6 +1042,9 @@ is_positive:
 @ ---------------------------------------------------------------------
 @ -- Control flow -----------------------------------------------------
 
+    defcode "NOOP", NOOP
+    NEXT
+
     defcode "BRANCH", BRANCH
     ldr r0, [r7]
     adds r7, r0
@@ -1396,6 +1386,9 @@ words_loop:
     .word FETCH, QDUP, ZEQU, QBRANCH, words_loop - .
     .word EXIT
 
+    defword "DEFINED?", DEFINEDQ
+    .word BL, WORD, FIND, NIP, EXIT
+
 @ ---------------------------------------------------------------------
 @ -- Disassembler -----------------------------------------------------
 
@@ -1465,7 +1458,7 @@ QUOTE_CHARS:
 4:  .word TWODROP, EXIT
 
     defword "VALID-ADDR?", ISVALIDADDR
-    .word DUP, LIT, 0x400, LIT, last_word, WITHIN, QDUP, QBRANCH, 1f - .
+    .word DUP, LIT, 0x400, LIT, last_word, FROMLINK, CELL, ADD, WITHIN, QDUP, QBRANCH, 1f - .
     .word NIP, EXIT
 1:  .word LIT, ram_start, LIT, ram_top, WITHIN, EXIT
 
@@ -1662,6 +1655,11 @@ print_xt_suffix:
     defvar "SOURCE#", SOURCECOUNT
     defvar ">SOURCE", SOURCEINDEX
     defvar "UP", UP
+    defvar "\047KEY", TICKKEY
+    defvar "\047ACCEPT", TICKACCEPT
+    defvar "\047EMIT", TICKEMIT
+    defvar "\047WAIT-KEY", TICKWAIT_KEY
+    defvar "\047FINISH-OUTPUT", TICKFINISH_OUTPUT
 
 @ ---------------------------------------------------------------------
 @ -- Main task user variables -----------------------------------------

generic/Makefile

@@ -1,4 +1,4 @@
-GEN = ../generic/ansi.gen.s ../generic/accept.gen.s \
+GEN = ../generic/ansi.gen.s \
       ../generic/editor.gen.s ../generic/protothreads.gen.s \
       ../generic/find.gen.s ../generic/strings.gen.s ../generic/multitasking.gen.s \
       ../generic/blocks.gen.s ../generic/quit.gen.s

generic/ansi.ft

@@ -13,14 +13,62 @@ DECIMAL
 : CLR-SOL   ANSI-ESC-START 49 EMIT 75 EMIT ;
 : CLR-LINE   ANSI-ESC-START 50 EMIT 75 EMIT ;
 
--1 CONSTANT KEY-UP
--2 CONSTANT KEY-DOWN
--4 CONSTANT KEY-LEFT
--3 CONSTANT KEY-RIGHT
--101 CONSTANT KEY-HOME
--104 CONSTANT KEY-END
--102 CONSTANT KEY-INSERT
--103 CONSTANT KEY-DELETE
--105 CONSTANT KEY-PGUP
--106 CONSTANT KEY-PGDOWN
+$5B410000 CONSTANT KEY-UP
+$5B420000 CONSTANT KEY-DOWN
+$5B440000 CONSTANT KEY-LEFT
+$5B430000 CONSTANT KEY-RIGHT
+$5B317E00 CONSTANT KEY-HOME
+$5B347E00 CONSTANT KEY-END
+$5B327E00 CONSTANT KEY-INSERT
+$5B337E00 CONSTANT KEY-DELETE
+$5B357E00 CONSTANT KEY-PGUP
+$5B367E00 CONSTANT KEY-PGDOWN
 127 CONSTANT KEY-BACKSPACE
+
+: ROTKEY   ( current rot-count key -- current' rot-count' )
+    OVER ROTATE ROT OR SWAP 8 -
+;
+
+: READWKEY
+     WAIT-KEY READ-KEY   DUP #27 = IF
+        DROP 0 #24 WAIT-KEY READ-KEY   DUP #91 = IF
+            ROTKEY
+            BEGIN
+                WAIT-KEY READ-KEY DUP >R ROTKEY R>
+                DUP #65 #91 WITHIN SWAP #126 = OR
+            UNTIL DROP
+        ELSE DUP #79 = IF
+                ROTKEY WAIT-KEY READ-KEY ROTKEY DROP
+            THEN
+        THEN
+    THEN
+;
+
+: TIB-TAIL   >TIB @ TIB# @ OVER - SWAP TIB + SWAP ;
+: .TIB-TAIL   CLR-EOL !CURSOR TIB-TAIL TYPE @CURSOR ;
+: CURSOR>   1 >TIB +! CURSOR-RIGHT ;
+: CURSOR<   1 >TIB -! CURSOR-LEFT ;
+: INSERT   TIB-TAIL OVER 1+ SWAP CMOVE>   1 TIB# +!   TIB >TIB @ + C! ;
+: DELETE   1 TIB# -! TIB-TAIL OVER 1+ -ROT CMOVE ;
+: -START?   >TIB @ 0> ;   : -END?   >TIB @ TIB# @ < ;
+: -FULL?   TIB# @ #TIB < ;
+
+: READLINE-CRSR
+    0 TIB# !   0 >TIB !
+    BEGIN
+        KEY
+        CASE
+            DUP 32 127 WITHIN -FULL? AND IF INSERT .TIB-TAIL CURSOR> ELSE
+            DUP 127 = -START? AND IF DROP CURSOR< DELETE .TIB-TAIL ELSE
+            DUP 8 = OVER KEY-DELETE = OR -END? AND IF DROP DELETE .TIB-TAIL ELSE
+            DUP 13 = OVER 10 = OR IF DROP TIB# @ EXIT ELSE
+            DUP KEY-RIGHT = -END? AND IF DROP CURSOR> ELSE
+            DUP KEY-LEFT = -START? AND IF DROP CURSOR< ELSE
+        ENDCASE
+    AGAIN
+;
+
+: ANSI-IO
+    ['] READWKEY 'KEY !
+    ['] READLINE-CRSR  'ACCEPT !
+;

generic/multitasking.ft

@@ -78,3 +78,12 @@ CELL -       USER TOS           \ task's top of stack when switching
     UNTIL
     DROP
 ;
+
+: STOP-FOR-KEY
+    BEGIN KEY? 0= WHILE STOP REPEAT
+;
+
+: MULTITASKING-KEY
+    UP@ UART0-TASK !
+    ['] STOP-FOR-KEY 'WAIT-KEY !
+;

lm3s811/lm3s811_board.s

@@ -271,7 +271,7 @@ init_board:
     .align 2, 0
     .ltorg
 
-read_key:
+readkey:
     push {r1, r2, r3, lr}
 2:  ldr r1, =addr_SBUF_TAIL
     ldrb r3, [r1]
@@ -396,7 +396,7 @@ uart0_key_handler:
     adds r3, #1
     ands r3, r1
     strb r3, [r2]
-    ldr r0, =addr_UART0_TASK
+    ldr r0, =addr_UARTZ_TASK
     ldr r0, [r0]
     cmp r0, #0
     beq 2b

lm3s811/lm3s811_ram.ft

@@ -22,7 +22,9 @@ TASK0 AWAKE
     BEGIN ." Task 2 " PAUSE AGAIN
 ;
 
-T1RUN
-T2RUN
+\ T1RUN
+\ T2RUN
+
+ANSI-IO
 
 ABORT

lm3s811/lm3s811_words.s

@@ -180,6 +180,6 @@
     defvar "SBUF-HEAD", SBUF_HEAD
     defvar "SBUF-TAIL", SBUF_TAIL
     defvar "IVT", IVT, 48 * 4
-    defvar "UART0-TASK", UART0_TASK
+    defvar "UART0-TASK", UARTZ_TASK
 
     .ltorg