commit b3340a1060a3729bdb1578f069be168dbbbbf525
parent a4780d9d43d429546eab41517da68d937bda1ada
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 26 Jul 2022 21:26:13 -0400
Add drv/pc/com and fiddle with emit/key mechanisms
The idea was to run tests automatically in QEMU -nographic. It almost works,
but there's this last step where I need to wait for the system to be ready
before sending it data to COM1. So... it doesn't work. Let's set that aside for
now...
Diffstat:
7 files changed, 31 insertions(+), 16 deletions(-)
diff --git a/Makefile b/Makefile
@@ -46,7 +46,7 @@ run: dusk
.PHONY: test
test: dusk
- echo "' byefail to abort f<< tests/all.fs bye" | ./dusk && echo "All tests passed" || (echo; exit 1)
+ echo "' byefail to abort f<< tests/all.fs bye" | ./dusk || (echo; exit 1)
.PHONY: clean
clean:
diff --git a/fs/drv/pc/com.fs b/fs/drv/pc/com.fs
@@ -0,0 +1,18 @@
+\ COM driver
+
+\ Hardcoded to COM1, 115220 bauds, 8N1
+
+$3f8 const COMPORT
+
+: com$ 0 COMPORT 1+ pc! \ disable interrupts
+ $80 COMPORT 3 + pc! \ DLAB input mode
+ 1 COMPORT pc! \ DLAB lo, 115200 bauds divided by 1
+ 0 COMPORT 1+ pc! \ DLAB hi
+ $03 COMPORT 3 + pc! \ 8 bits no parity 1 stop bit
+ $c7 COMPORT 2 + pc! \ enable FIFO, clear it, 14-byte threshold
+ $0b COMPORT 4 + pc! ; \ IRQ enabled RTS/DSR set
+
+: >com ( c -- ) begin COMPORT 5 + pc@ $20 and until COMPORT pc! ;
+
+: com>? ( -- c? f ) COMPORT 5 + pc@ 1 and dup if COMPORT pc@ swap then ;
+: com> ( -- c ) begin com>? until ;
diff --git a/fs/tests/all.fs b/fs/tests/all.fs
@@ -5,3 +5,4 @@ f<< /tests/sys/all.fs
f<< /tests/fs/all.fs
f<< /tests/asm/all.fs
f<< /tests/cc/all.fs
+S" All tests passed" stype nl>
diff --git a/fs/tests/harness.fs b/fs/tests/harness.fs
@@ -1,3 +1,5 @@
+?f<< /lib/with.fs
+
\ # means "assert"
: # ( f -- ) not if abort" assertion failed" then ;
: #eq ( n n -- ) 2dup = if 2drop else swap .x ." != " .x abort then ;
@@ -11,8 +13,7 @@ create _buf $100 allot
\ capture is called with one word to call with capture on. It returns the
\ captured string. $ff bytes max.
: capture ( -- str )
- word ['] _emit to emit 0 to _sz runword
- ['] (emit) to emit
+ word ['] _emit to' emit with[ 0 to _sz runword ]with
_sz _buf c! _buf ;
: #s= ( s1 s2 -- ) 2dup s= if 2drop else swap stype ." != " stype abort then ;
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -488,19 +488,11 @@ xcode r>A
lblareg m) bx mov,
ax jmp,
-pc $b8000 ,
-xcode (emit) \ temporary, this is going in /drv/pc
- AX pspop,
-pc to lblemit \ al=c
- di dup ( pc ) m) mov,
- dup ( pc ) m) inc,
- ( pc ) m) inc,
- di 0 d) al mov,
- di 1 d) 7 i) mov,
- ret,
-
xcode emit
- wcall, (alias) xwordlbl (emit) ,
+ wcall, (alias) xwordlbl drop ,
+
+xcode key
+ wcall, (alias) xwordlbl abort ,
xcode rtype ( a u -- )
CX SI pspop2,
diff --git a/fs/xcomp/pc/init.fs b/fs/xcomp/pc/init.fs
@@ -4,6 +4,9 @@ herestart to here
\ We now have f<<
f<< /sys/doc.fs
f<< /drv/pc/acpi.fs
+f<< /drv/pc/com.fs
f<< /drv/pc/vid8025.fs
f<< /sys/grid.fs
+
' (emit) to emit
+' int16h to key
diff --git a/fs/xcomp/pc/kernel.fs b/fs/xcomp/pc/kernel.fs
@@ -45,7 +45,7 @@ pc to L1 \ segment with ffff limits
0 L2 jmpfar,
0 to realmode
-xcode key ( -- c ) pc lblcurrent pc>addr !
+xcode int16h ( -- c ) pc lblcurrent pc>addr !
$18 L1 jmpfar,
pc lblbootptr pc>addr !
