1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 14:20:56 +11:00

Compare commits

..

2 Commits

Author SHA1 Message Date
Virgil Dupras
af5a97243a forth: implement "0b" number parsing 2020-03-19 16:03:35 -04:00
Virgil Dupras
f0cbda1f2e tests: add Forth tests
Modest first step
2020-03-19 15:43:48 -04:00
9 changed files with 96 additions and 3 deletions

View File

@ -8,9 +8,13 @@
// in sync with glue.asm // in sync with glue.asm
#define RAMSTART 0x900 #define RAMSTART 0x900
#define STDIO_PORT 0x00 #define STDIO_PORT 0x00
// This binary is also used for automated tests and those tests, when
// failing, send a non-zero value to RET_PORT to indicate failure
#define RET_PORT 0x01
static int running; static int running;
static FILE *fp; static FILE *fp;
static int retcode = 0;
static uint8_t iord_stdio() static uint8_t iord_stdio()
{ {
@ -30,6 +34,12 @@ static void iowr_stdio(uint8_t val)
} }
} }
static void iowr_ret(uint8_t val)
{
retcode = val;
}
int main(int argc, char *argv[]) int main(int argc, char *argv[])
{ {
bool tty = false; bool tty = false;
@ -61,6 +71,7 @@ int main(int argc, char *argv[])
m->ramstart = RAMSTART; m->ramstart = RAMSTART;
m->iord[STDIO_PORT] = iord_stdio; m->iord[STDIO_PORT] = iord_stdio;
m->iowr[STDIO_PORT] = iowr_stdio; m->iowr[STDIO_PORT] = iowr_stdio;
m->iowr[RET_PORT] = iowr_ret;
// initialize memory // initialize memory
for (int i=0; i<sizeof(KERNEL); i++) { for (int i=0; i<sizeof(KERNEL); i++) {
m->mem[i] = KERNEL[i]; m->mem[i] = KERNEL[i];
@ -78,5 +89,5 @@ int main(int argc, char *argv[])
emul_printdebug(); emul_printdebug();
} }
fclose(fp); fclose(fp);
return 0; return retcode;
} }

View File

@ -194,3 +194,7 @@ PC! c a -- Spit c to port a
PC@ a -- c Fetch c from port a PC@ a -- c Fetch c from port a
WORD -- a Read one word from buffered input and push its addr WORD -- a Read one word from buffered input and push its addr
There are also ascii const emitters:
LF
SPC

View File

@ -27,7 +27,7 @@
: (parseh) ( a -- n f ) : (parseh) ( a -- n f )
( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 ) ( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 ) DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 )
( We have "0x" suffix ) ( We have "0x" prefix )
2 + 2 +
( validate slen ) ( validate slen )
DUP SLEN ( a l ) DUP SLEN ( a l )
@ -44,9 +44,40 @@
AGAIN AGAIN
; ;
( returns negative value on error )
: bindig ( c -- n )
( '0' is ASCII 48 )
48 -
DUP 0 < IF EXIT THEN ( bad )
DUP 2 < IF EXIT THEN ( good )
( bad )
255 -
;
: (parseb) ( a -- n f )
( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
DUP @ 25136 = NOT IF 0 EXIT THEN ( a 0 )
( We have "0b" prefix )
2 +
( validate slen )
DUP SLEN ( a l )
DUP 0 = IF DROP 0 EXIT THEN ( a 0 )
16 > IF DROP 0 EXIT THEN ( a 0 )
0 ( a r )
BEGIN
OVER C@
DUP 0 = IF DROP SWAP DROP 1 EXIT THEN ( r, 1 )
bindig ( a r n )
DUP 0 < IF DROP DROP 1 EXIT THEN ( a 0 )
SWAP 2 * + ( a r*2+n )
SWAP 1 + SWAP ( a+1 r )
AGAIN
;
: (parse) ( a -- n ) : (parse) ( a -- n )
(parsec) NOT SKIP? EXIT (parsec) NOT SKIP? EXIT
(parseh) NOT SKIP? EXIT (parseh) NOT SKIP? EXIT
(parseb) NOT SKIP? EXIT
(parsed) NOT SKIP? EXIT (parsed) NOT SKIP? EXIT
( nothing works ) ( nothing works )
ABORT" unknown word! " ABORT" unknown word! "

View File

@ -5,3 +5,6 @@
1 + 1 +
AGAIN AGAIN
; ;
: LF 10 EMIT ;
: SPC 32 EMIT ;

View File

@ -2,8 +2,9 @@ EMULDIR = ../emul
.PHONY: run .PHONY: run
run: run:
$(MAKE) -C $(EMULDIR) zasm/zasm zasm/avra runbin/runbin shell/shell $(MAKE) -C $(EMULDIR) zasm/zasm zasm/avra runbin/runbin shell/shell forth/forth
cd unit && ./runtests.sh cd unit && ./runtests.sh
cd zasm && ./runtests.sh cd zasm && ./runtests.sh
cd avra && ./runtests.sh cd avra && ./runtests.sh
cd shell && ./runtests.sh cd shell && ./runtests.sh
cd forth && ./runtests.sh

9
tests/forth/harness.fs Normal file
View File

@ -0,0 +1,9 @@
( Forth testing harness
"#" means "assert". We stop at first failure, indicating
the failure through IO on port 1 )
: fail SPC ." failed" LF 1 1 PC! BYE ;
: # SKIP? fail SPC ." pass" LF ;
: #eq 2DUP SWAP . SPC '=' EMIT SPC . '?' EMIT = # ;

27
tests/forth/runtests.sh Executable file
View File

@ -0,0 +1,27 @@
#!/bin/sh -e
BASE=../..
EXEC="${BASE}/emul/forth/forth"
FDIR="${BASE}/forth"
TMP=$(mktemp)
chk() {
echo "Running test $1"
cat harness.fs $1 > ${TMP}
if ! ${EXEC} ${TMP}; then
exit 1
fi
}
if [ ! -z $1 ]; then
chk $1
exit 0
fi
# those tests run without any builtin
for fn in test_*.fs; do
chk "${fn}"
done
echo "All tests passed!"
rm ${TMP}

5
tests/forth/test_ari.fs Normal file
View File

@ -0,0 +1,5 @@
48 13 + 61 #eq
48 13 - 35 #eq
48 13 * 624 #eq
48 13 / 3 #eq
48 13 MOD 9 #eq

View File

@ -0,0 +1,2 @@
'b' 0x62 #eq
0b1111010101 981 #eq