Permalink
Browse files

Make IO words vectored

  • Loading branch information...
1 parent b82d604 commit 329304133044ec564ce96f83cde9dedbe3471f3a @ekoeppen committed May 27, 2012
View
@@ -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 -----------------------------------------
View
@@ -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
View
@@ -1,24 +0,0 @@
-DECIMAL
-
-: 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 < ;
-
-: ACCEPT
- 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 -103 = OR -END? AND IF DROP DELETE .TIB-TAIL ELSE
- DUP 13 = OVER 10 = OR IF DROP TIB# @ EXIT ELSE
- DUP -3 = -END? AND IF DROP CURSOR> ELSE
- DUP -4 = -START? AND IF DROP CURSOR< ELSE
- ENDCASE
- AGAIN ;
View
@@ -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 !
+;
View
@@ -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 !
+;
View
@@ -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
View
@@ -22,7 +22,9 @@ TASK0 AWAKE
BEGIN ." Task 2 " PAUSE AGAIN
;
-T1RUN
-T2RUN
+\ T1RUN
+\ T2RUN
+
+ANSI-IO
ABORT
View
@@ -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
Oops, something went wrong.

0 comments on commit 3293041

Please sign in to comment.