commit 3ac7474d73020c4f6bda684475ab3350c02efa2d
parent e00ff7ad42f3d78815f7e2f164fb679a44810f2c
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 4 Aug 2022 13:58:08 -0400
Replace dusk.asm with the C VM
Diffstat:
11 files changed, 96 insertions(+), 1023 deletions(-)
diff --git a/.build.yml b/.build.yml
@@ -1,7 +1,5 @@
image: debian/stable
-arch: amd64
packages:
- - nasm
- mtools
- build-essential
- qemu-system-x86
diff --git a/.gitignore b/.gitignore
@@ -1,9 +1,7 @@
/dusk
-/duskvm
-/fatfs
-/boot.fs
+/memdump
/fs/init.fs
-/posix/tmpboot.fs
+/posix/boot.fs
/*.bin
/*.img
*.o
diff --git a/Makefile b/Makefile
@@ -1,35 +1,16 @@
TARGETS = dusk
-BOOTFS_SRC = fs/xcomp/bootlo.fs \
- fs/drv/ramdrive.fs \
- posix/glue1.fs \
- fs/fs/fatlo.fs \
- posix/glue2.fs \
- fs/xcomp/boothi.fs
-TMPBOOTFS_SRC = fs/xcomp/bootlo.fs fs/xcomp/boothi.fs
+BOOTFS_SRC = fs/xcomp/bootlo.fs fs/xcomp/boothi.fs
ALLSRCS = $(shell find fs)
all: $(TARGETS)
-dusk: dusk.asm boot.fs fatfs
- nasm -f elf32 dusk.asm -o dusk.o
- ld -m elf_i386 dusk.o -o $@
-
fs/init.fs: posix/init.fs fs/xcomp/init.fs
cat posix/init.fs fs/xcomp/init.fs > $@
-posix/tmpboot.fs: $(TMPBOOTFS_SRC)
- cat $(TMPBOOTFS_SRC) > $@
-
-duskvm: posix/vm.c posix/tmpboot.fs fs/init.fs
- $(CC) posix/vm.c -Wall -o $@
-
-boot.fs: $(BOOTFS_SRC)
+posix/boot.fs: $(BOOTFS_SRC)
cat $(BOOTFS_SRC) > $@
-fatfs: $(ALLSRCS) posix/init.fs
- dd if=/dev/zero of=$@ bs=1M count=1
- mformat -M 512 -d 1 -i $@ ::
- cat posix/init.fs fs/xcomp/init.fs > fs/init.fs
- mcopy -sQ -i $@ fs/* ::
+dusk: posix/vm.c posix/boot.fs fs/init.fs
+ $(CC) posix/vm.c -Wall -o $@
mbr.bin: dusk buildmbr.fs
./dusk < buildmbr.fs 2> $@
@@ -43,8 +24,8 @@ pc.img: mbr.bin pc.bin $(ALLSRCS)
mformat -M 512 -d 1 -R 40 -i $@ ::
dd if=mbr.bin of=$@ bs=1 seek=62 conv=notrunc
dd if=pc.bin of=$@ bs=1 seek=512 conv=notrunc
- cat fs/xcomp/pc/init.fs fs/xcomp/init.fs > fs/init.fs
mcopy -sQ -i $@ fs/* ::
+ cat fs/xcomp/pc/init.fs fs/xcomp/init.fs | mcopy -D overwrite -i $@ - ::init.fs
.PHONY: pcrun
pcrun: pc.img
@@ -66,4 +47,4 @@ test: dusk
.PHONY: clean
clean:
- rm -f $(TARGETS) dusk.o fatfs fs/init.fs boot.fs *.bin *.img
+ rm -f $(TARGETS) dusk.o fs/init.fs posix/boot.fs memdump *.bin *.img
diff --git a/README.md b/README.md
@@ -168,19 +168,30 @@ Meanwhile, I'm very open to discussions, comments, debates, questions. I would
even say that I'm not closed to patches, as long as you're aware of the fact
that I apply double standards until liftoff.
-## Build and run
+## Build and run Dusk
-To build Dusk OS, you need:
+Dusk is designed to run on bare metal and to build itself from itself (it's
+*almost* self-hosting, but not quite yet. Soon). However, it's also possible to
+build Dusk from any POSIX platform using Dusk's C VM from `posix/vm.c`.
+
+This VM implements a Forth that can interpret the whole of Dusk's Forth code,
+but this VM is CPU-agnostic and has its own simplistic bytecode. This means that
+this VM cannot do fancy stuff like run native code generated by its assemblers
+and compilers. That makes running Dusk from this VM less than exciting: it's
+just a boring Forth.
+
+However, that boring Forth is enough to generate bare metal images for any of
+its target platforms, so that's why it exists. To build this VM, you need:
* GNU Make
-* GNU binutils
-* nasm
-* A x86-compatible Linux kernel to run this on
+* A C compiler
* [mtools][6]
-Run `make` and then run `./dusk`. You'll get a prompt. Documentation is lacking
-for now, you'll have to look at the source to have an idea of available
-vocabulary. Type `bye` to quit.
+Running `make` will yield a `./dusk` binary which if opened, provides an
+interactive prompt.
+
+Documentation is lacking for now, you'll have to look at the source to have an
+idea of available vocabulary. Type `bye` to quit.
There is some documentation in `/fs/doc`.
@@ -191,9 +202,8 @@ and echoed twice. To avoid that, you can invoke it like this:
`make run` does this for you.
-### Running OpenBSD?
-
-You might be interested in [this thread from the mailing list][5].
+But if you really want to play with Dusk, you shouldn't play with this prompt,
+but rather play with a bare metal build which can be ran under QEMU. See below.
### Building bare metal binaries
diff --git a/dusk.asm b/dusk.asm
@@ -1,925 +0,0 @@
-; This is a STC forth. PSP=ebp RSP=esp
-BITS 32
-%define CELLSZ 4
-%define PS_SZ 0x1000
-%define RS_SZ 0x1000
-%define MEMSIZE 0xa0000
-%define SYSCALL_EXIT 1 ; int status
-%define SYSCALL_READ 3 ; int fd, void *buf, size_t count
-%define SYSCALL_WRITE 4 ; int fd, const void *buf, size_t count
-
-%macro pspush 1 ; src
- sub ebp, CELLSZ
- mov dword [ebp], %1
-%endmacro
-
-%macro pspop 1 ; dst
- mov %1, dword [ebp]
- add ebp, CELLSZ
-%endmacro
-
-%macro firstword 3 ; name namelen lbl
-db %1
-dd 0
-db %2
-%push dict
-%$prev_word:
-%3:
-%endmacro
-
-%macro defword 3 ; name namelen lbl
-db %1
-dd %$prev_word
-db %2
-%pop
-%push dict
-%$prev_word:
-%3:
-%endmacro
-
-; If toptr=0, push the value of the dword at addr %1 to PS
-; If toptr!=0 jump to that ptr
-%macro sysval 1 ; lbl
-mov eax,%1
-test dword [toptr], -1
-jnz to_is_set
-mov eax,[eax]
-pspush eax
-ret
-%endmacro
-
-; If toptr=0, jump to the address pointed at by the dword at addr %1
-; If toptr!=0 jump to that ptr
-%macro sysalias 1 ; lbl
-mov eax,%1
-test dword [toptr], -1
-jnz to_is_set
-jmp [eax]
-%endmacro
-
-SECTION .bss
-areg: resd 1 ; A register
-toptr: resd 1 ; Current "to" word pointer. 0 means none
-bootptr: resd 1
-current: resd 1
-here: resd 1
-compiling: resd 1
-curword: resb 0x20 ; 1b len, then contents
-inrd: resd 1 ; in<
-emit: resd 1
-main: resd 1
-abort: resd 1
- resd PS_SZ
-ps_top:
- resd RS_SZ
-rs_top:
-herestart: resb MEMSIZE
-heremax:
-SECTION .data
-bootsrc: incbin "boot.fs"
-wnfstr: db " word not found"
-uflwstr: db "stack underflow"
-wordexpstr: db "word expected"
-fatfs: incbin "fatfs"
-SECTION .text
-
-GLOBAL _start
-_start:
- mov dword [bootptr], bootsrc
- mov dword [here], herestart
- mov dword [current], word_mainloop
- mov dword [main], word_mainloop
- mov dword [inrd], word_bootrd
- mov dword [emit], word__emit
- mov dword [abort], word__abort
- jmp word_abort
-
-firstword 'bye', 3, word_bye
- mov eax, SYSCALL_EXIT
- mov ebx, 0 ; error code
- int 0x80
-
-defword 'byefail', 7, word_byefail
- mov eax, SYSCALL_EXIT
- mov ebx, 1 ; error code
- int 0x80
-
-defword 'noop', 4, word_noop
-_ret: ; label for whenever you need to conditionally return
- ret
-
-defword 'main', 4, word_main
- sysalias main
-
-defword 'quit', 4, word_quit
- cld
- mov dword [toptr], 0
- mov esp, rs_top
- jmp word_main
-
-defword '(abort)', 7, word__abort
- mov ebp, ps_top
- jmp word_quit
-
-defword 'abort', 5, word_abort
- sysalias abort
-
-defword 'exit', 4, word_exit
- pop eax
- ret
-
-defword 'execute', 7, word_execute
- pspop eax
- jmp eax
-
-; Compiled by "create"
-; This word is called right before data begins, which means that the address
-; that interests us is right on top of RS.
-defword '(cell)', 6, word_cellroutine
- pop eax
- pspush eax
- ret
-
-; Compiled by "value"
-; Called right before a 4b data, RS has its address now.
-; If toptr=0, return that value
-; If toptr!=0 jump to that ptr
-defword '(val)', 5, word_valroutine
- pop eax
- test dword [toptr], -1
- jnz to_is_set
- mov ebx, [eax]
- pspush ebx
- ret
-
-; Compiled by "alias"
-; Called right before a 4b word pointer, RS has its address now.
-; If toptr=0, return jump to where it's pointing.
-; If toptr!=0 jump to that ptr
-defword '(alias)', 7, word_aliasroutine
- pop eax
- test dword [toptr], -1
- jnz to_is_set
- jmp [eax]
-
-; Compiled by "does"
-; When called, RS points to the address of the word following "does>"
-; After that 4b pointer, data begins, so we want to push its address to PS.
-defword '(does)', 6, word_doesroutine
- pop eax
- mov ebx, eax
- add ebx, CELLSZ
- pspush ebx
- jmp [eax]
-
-; String literal. What follows it is a byte with the length of the string.
-; What we do here is to push the address of that string to PS, and then read
-; that length byte, then skip that many bytes and jump there.
-defword '(s)', 3, word_strlit
- pop esi ; addr of str
- pspush esi
- xor eax, eax
- lodsb ; len
- add esi, eax ; ret to PC right after str
- jmp esi
-
-defword '(br)', 4, word_brroutine
- pop eax
- jmp dword [eax]
-
-defword '(?br)', 5, word_condbrroutine
- pspop eax
- or eax, eax
- jz word_brroutine
- pop eax
- add eax, CELLSZ
- jmp eax
-
-defword '(next)', 6, word_nextroutine
- dec dword [esp+CELLSZ]
- jnz word_brroutine
- pop eax
- pop ebx
- add eax, CELLSZ
- jmp eax
-
-defword 'boot<', 5, word_bootrd
- mov esi, [bootptr]
- xor eax,eax
- mov al, [esi]
- inc dword [bootptr]
- pspush eax
- ret
-
-defword '(emit)', 6, word__emit
- mov eax, SYSCALL_WRITE
- mov ebx, 1 ; stdout
- mov ecx, ebp ; buffer: top of PS, little endian
- mov edx, 1 ; len
- int 0x80
- pspop eax
- ret
-
-defword 'emit', 4, word_emit
- sysalias emit
-
-defword 'stderr', 6, word_stderr
- mov eax, SYSCALL_WRITE
- mov ebx, 2 ; stderr
- mov ecx, ebp ; buffer: top of PS, little endian
- mov edx, 1 ; len
- int 0x80
- pspop eax
- ret
-
-defword 'key', 3, word_key
- pspush 0
- mov eax, SYSCALL_READ
- mov ebx, 0 ; stdin
- mov ecx, ebp ; buffer
- mov edx, 1 ; len
- int 0x80
- ret
-
-defword 'drop', 4, word_drop
- add ebp, CELLSZ
- ret
-
-defword 'dup', 3, word_dup
- mov eax, [ebp]
- sub ebp, CELLSZ
- mov [ebp], eax
- ret
-
-defword '?dup', 4, word_conddup
- test dword [ebp], -1
- jnz word_dup
- ret
-
-defword 'swap', 4, word_swap
- mov eax, [ebp]
- mov ebx, [ebp+CELLSZ]
- mov [ebp], ebx
- mov [ebp+CELLSZ], eax
- ret
-
-defword 'over', 4, word_over
- mov eax, [ebp+CELLSZ]
- sub ebp, CELLSZ
- mov [ebp], eax
- ret
-
-defword 'rot', 3, word_rot
- mov eax, [ebp]
- mov ebx, [ebp+CELLSZ]
- mov ecx, [ebp+CELLSZ*2]
- mov [ebp], ecx
- mov [ebp+CELLSZ], eax
- mov [ebp+CELLSZ*2], ebx
- ret
-
-defword 'nip', 3, word_nip
- pspop eax
- mov [ebp], eax
- ret
-
-defword 'tuck', 4, word_tuck
- mov eax, [ebp]
- mov ebx, [ebp+CELLSZ]
- mov [ebp], ebx
- mov [ebp+CELLSZ], eax
- pspush eax
- ret
-
-defword 'rot>', 4, word_rotr
- mov eax, [ebp]
- mov ebx, [ebp+CELLSZ]
- mov ecx, [ebp+CELLSZ*2]
- mov [ebp], ebx
- mov [ebp+CELLSZ], ecx
- mov [ebp+CELLSZ*2], eax
- ret
-
-; Warning: RS routines are all called, which means that we have to work from
-; the second item from the top rather than the first.
-
-defword 'r>', 2, word_rs2ps
- pop eax
- sub ebp, CELLSZ
- pop dword [ebp]
- jmp eax
-
-defword '>r', 2, word_ps2rs
- pspop eax
- xchg eax, [esp]
- jmp eax
-
-defword 'r@', 2, word_rsget
- mov eax, [esp+CELLSZ]
- pspush eax
- ret
-
-defword 'r~', 2, word_rsdrop
- pop eax
- add esp, CELLSZ
- jmp eax
-
-defword 'scnt', 4, word_scnt
- mov eax, ps_top
- sub eax, ebp
- shr ax, 2 ; div by 4, preserve neg
- pspush eax
- ret
-
-defword 'rcnt', 4, word_rcnt
- mov eax, rs_top
- sub eax, esp
- shr ax, 2 ; div by 4, preserve neg
- dec ax ; ignore this call
- pspush eax
- ret
-
-defword '>A', 2, word_Aset
- pspop eax
- mov [areg], eax
- ret
-
-defword 'A>', 2, word_Aget
- mov eax, [areg]
- pspush eax
- ret
-
-defword 'Ac@', 3, word_Acfetch
- mov eax, 0
- mov esi, [areg]
- mov al, [esi]
- pspush eax
- ret
-
-defword 'Ac!', 3, word_Acstore
- pspop eax
- mov esi, [areg]
- mov [esi], al
- ret
-
-defword 'A+', 2, word_Ainc
- inc dword [areg]
- ret
-
-defword 'A-', 2, word_Adec
- dec dword [areg]
- ret
-
-defword 'A>r', 3, word_A2rs
- pop eax
- push dword [areg]
- jmp eax
-
-defword 'r>A', 3, word_rs2A
- pop eax
- pop dword [areg]
- jmp eax
-
-to_is_set: ; eax=cell addr
- pspush eax
- mov ebx, [toptr]
- mov dword [toptr], 0
- jmp ebx
-
-defword '[to]', 4, word_set_toptr
- pspop eax
- mov [toptr], eax
- ret
-
-defword 'to?', 3, word_get_toptr
- mov eax, [toptr]
- pspush eax
- mov dword [toptr], 0
- ret
-
-defword '1+', 2, word_inc
- inc dword [ebp]
- ret
-
-defword '1-', 2, word_dec
- dec dword [ebp]
- ret
-
-defword 'c@', 2, word_cfetch
- mov esi, [ebp]
- mov eax, 0
- mov al, [esi]
- mov [ebp], eax
- ret
-
-defword 'c!', 2, word_cstore
- pspop eax
- pspop ebx
- mov [eax], bl
- ret
-
-defword 'c,', 2, word_cwrite
- pspop eax
-_cwrite: ; al=c
- mov esi, [here]
- mov [esi], al
- inc dword [here]
- ret
-
-defword 'w@', 2, word_wfetch
- mov esi, [ebp]
- mov eax, 0
- mov ax, [esi]
- mov [ebp], eax
- ret
-
-defword 'w!', 2, word_wstore
- pspop eax
- pspop ebx
- mov [eax], bx
- ret
-
-defword '@', 1, word_fetch
- mov esi, [ebp]
- mov eax, [esi]
- mov [ebp], eax
- ret
-
-defword '!', 1, word_store
- pspop eax
- pspop ebx
- mov [eax], ebx
- ret
-
-defword '+!', 2, word_addstore
- pspop eax
- pspop ebx
- add [eax], ebx
- ret
-
-defword ',', 1, word_write
- pspop eax
-_write: ; eax=n
- mov esi, [here]
- mov [esi], eax
- add dword [here], CELLSZ
- ret
-
-defword '+', 1, word_add
- pspop eax
- add [ebp], eax
- ret
-
-defword '-', 1, word_sub
- pspop eax
- sub [ebp], eax
- ret
-
-defword '*', 1, word_mul
- pspop eax
- mov ebx, [ebp]
- mul ebx
- mov [ebp], eax
- ret
-
-; ( a b -- r q )
-defword '/mod', 4, word_divmod
- mov eax, [ebp+4]
- mov ebx, [ebp]
- xor edx, edx
- div ebx
- mov [ebp+4], edx ; remainder
- mov [ebp], eax ; quotient
- ret
-
-defword 'and', 3, word_and
- pspop eax
- and [ebp], eax
- ret
-
-defword 'or', 2, word_or
- pspop eax
- or [ebp], eax
- ret
-
-defword 'xor', 3, word_xor
- pspop eax
- xor [ebp], eax
- ret
-
-defword 'bool', 4, word_bool
- mov eax, [ebp]
- mov dword [ebp], 0
- test eax, eax
- setnz byte [ebp]
- ret
-
-defword 'not', 3, word_not
- mov eax, [ebp]
- mov dword [ebp], 0
- test eax, eax
- setz byte [ebp]
- ret
-
-defword '<', 1, word_lt
- pspop eax
- sub [ebp], eax
- mov dword [ebp], 0
- setc byte [ebp]
- ret
-
-defword '<<c', 3, word_shlc
- pspush 0
- shl dword [ebp+CELLSZ], 1
- setc byte [ebp]
- ret
-
-defword '>>c', 3, word_shrc
- pspush 0
- shr dword [ebp+CELLSZ], 1
- setc byte [ebp]
- ret
-
-; ( n u -- n )
-defword 'lshift', 6, word_lshift
- pspop ecx
- shl dword [ebp], cl
- ret
-
-defword 'rshift', 6, word_rshift
- pspop ecx
- shr dword [ebp], cl
- ret
-
-litncode:
- pspush 0
-litncode_end:
-defword 'litn', 4, word_litn
- mov esi, litncode ; src
- mov ecx, litncode_end-litncode-CELLSZ ; len_of_code-len-of-imm
- call _movewrite
- jmp word_write
-
-defword 'execute,', 8, word_executewrite
- mov al, 0xe8 ; call opcode
- call _cwrite
- pspop eax ; absolute addr
- sub eax, [here] ; displacement
- sub eax, 4 ; ... from *after* call/jmp op
- jmp _write
-
-defword 'exit,', 5, word_exitwrite
- mov al, 0xc3 ; ret opcode
- jmp _cwrite
-
-defword 'current', 7, word_current
- sysval current
-
-defword 'here', 4, word_here
- sysval here
-
-defword 'heremax', 7, word_heremax
- pspush heremax
- ret
-
-defword 'fatfs(', 6, word_fatfsaddr
- pspush fatfs
- ret
-
-defword 'compiling', 9, word_compiling
- sysval compiling
-
-; where "word" feeds itself
-defword 'in<', 3, word_inrd
- sysalias inrd
-
-; ( src dst u -- )
-defword 'move', 4, word_move
- pspop ecx
- pspop edi
- pspop esi
- test ecx, ecx
- jz _ret
- rep movsb
- ret
-
-; ( a u -- )
-defword 'move,', 5, word_movewrite
- pspop ecx
- pspop esi
- test ecx, ecx
- jz _ret
-_movewrite: ; esi=a ecx=u
- mov edi, [here]
- add dword [here], ecx
- rep movsb
- ret
-
-; ( a u -- )
-defword 'rtype', 5, word_rtype
- pspop ecx
- pspop esi
-_rtype_loop:
- xor eax, eax
- mov al, [esi]
- pspush eax
- push esi
- push ecx
- call word_emit
- pop ecx
- pop esi
- inc esi
- dec ecx
- jnz _rtype_loop
- ret
-
-; ( -- )
-defword '(wnf)', 5, word_wnf
- mov esi, curword+1
- xor ecx, ecx
- mov cl, [curword]
- call _rtype_loop
- mov ecx, 15
- mov esi, wnfstr
-_errmsg:
- call _rtype_loop
- jmp word_abort
-
-defword 'stack?', 6, word_stackcond
- cmp ebp, ps_top
- jna _ret
- mov ecx, 15
- mov esi, uflwstr
- jmp _errmsg
-
-; ( -- str )
-defword 'curword', 7, word_curword
- pspush curword
- ret
-
-; ( -- str-or-0 )
-defword 'maybeword', 9, word_maybeword
- ; save toptr so that it doesn't mess [inrd], which could be calling a word
- ; with to semantics
- push dword [toptr]
- mov dword [toptr], 0
-_word_loop1:
- call [inrd] ; ( -- c )
- pspop eax
- test eax, eax
- js _word_eof
- cmp eax, 0x21 ; is ws?
- jc _word_loop1
- mov ebx, curword+1
-_word_loop2:
- mov [ebx], al
- inc ebx
- push ebx
- call [inrd] ; ( -- c )
- pop ebx
- pspop eax
- test eax, eax
- js _word_stoploop2 ; EOF, but we just treat is as a WS
- cmp eax, 0x21 ; is ws?
- jnc _word_loop2
-_word_stoploop2:
- pop dword [toptr]
- sub ebx, curword+1
- mov [curword], bl
- pspush curword
- ret
-_word_eof:
- pop dword [toptr]
- pspush 0
- ret
-
-; ( -- str-or-0 )
-defword 'word', 4, word_word
- call word_maybeword
- test dword [ebp], -1
- jnz _ret
- mov ecx, 13
- mov esi, wordexpstr
- jmp _errmsg
-
-; ( str -- n? f ) esi=sa ecx=sl
-_parse_c:
- cmp ecx, 3
- jnz _parse_no
- cmp byte [esi+2], "'"
- jnz _parse_no
- xor eax, eax
- mov al, [esi+1]
- mov [ebp], eax
- pspush 1
- ret
-
-; ( str -- n? f ) esi=sa ecx=sl
-_parse_h:
- cmp ecx, 2
- jc _parse_no
- inc esi ; skip $
- dec ecx
- xor eax, eax ; res
- xor ebx, ebx
-_parse_h_loop:
- mov bl, [esi]
- or bl, 0x20
- sub bl, '0'
- jc _parse_no
- cmp bl, 10
- jc _parse_h_ok ; ebx=n
- sub bl, 'a'-'0'
- jc _parse_no
- add bl, 10 ; ebx=n
- cmp bl, 16
- jnc _parse_no
-_parse_h_ok: ; ebx=n
- shl eax, 4 ; res*16
- add eax, ebx
- inc esi
- dec ecx
- jnz _parse_h_loop
- mov [ebp], eax
- pspush 1
- ret
-__h_no:
- mov dword [ebp], 0
- ret
-
-; ( str -- n? f ) esi=sa ecx=sl
-_parse_ud:
- test ecx, ecx
- jz _parse_no
- xor eax, eax ; res
-_parse_ud_loop:
- mov ebx, 10
- mul ebx ; res*10
- mov bl, [esi]
- sub bl, '0'
- jc _parse_no
- cmp bl, 10 ; ebx=n
- jnc _parse_no
- add eax, ebx
- inc esi
- dec ecx
- jnz _parse_ud_loop
- mov [ebp], eax
- pspush 1
- ret
-
-; ( str -- n? f )
-defword 'parse', 5, word_parse
- mov esi, [ebp]
- xor ecx, ecx
- mov cl, [esi]
- inc esi
- cmp byte [esi], "'"
- jz _parse_c
- cmp byte [esi], '$'
- jz _parse_h
- cmp byte [esi], '-'
- jnz _parse_ud
- inc esi
- dec ecx
- call _parse_ud
- test dword [ebp], -1
- jz _parse_no
- neg dword [ebp+CELLSZ]
- ret
-_parse_no:
- mov dword [ebp], 0
- ret
-
-; ( a1 a2 u -- f )
-defword '[]=', 3, word_rangeeq
- pspop ecx
- pspop edi
- pspop esi
- xor eax, eax
- repz cmpsb
- setz al
- pspush eax
- ret
-
-; ( str -- word-or-0 )
-defword 'find', 4, word_find
- mov esi, [ebp]
- xor ecx, ecx
- mov cl, [esi]
- inc dword [ebp]
- mov edx, [current]
-_find_loop:
- mov edi, edx
- dec edi
- mov al, [edi]
- and al, 0x3f ; 3f instead of 7f? we reserve space for another flag.
- cmp al, cl
- jnz _find_skip1
- ; same length
- sub edi, 4
- sub edi, ecx
- mov esi, [ebp]
- repz cmpsb
- jnz _find_skip2
- ; same contents
- mov [ebp], edx
- ret
-_find_skip2:
- mov cl, al
-_find_skip1:
- sub edx, 5
- mov edx, [edx]
- test edx, edx
- jnz _find_loop
- ; not found
- mov dword [ebp], 0
- ret
-
-; ( -- w )
-defword "'", 1, word_apos
- call word_word
- call word_find
- test dword [ebp], -1
- jz word_wnf
- ret
-
-; : entry ( str -- )
-; c@+ tuck move, ( len ) current , c, here to current ;
-defword 'entry', 5, word_entry
- pspop esi
- xor ecx, ecx
- mov cl, [esi]
- inc esi
- mov edx, ecx ; save len
- call _movewrite
- mov eax, [current]
- call _write
- mov eax, edx
- call _cwrite
- mov eax, [here]
- mov [current], eax
- ret
-
-; : xtcomp 1 to compiling begin
-; word parse if litn else curword find if
-; dup immediate? if execute else call, then
-; else (wnf) then then
-; compiling not until
-; exit, ;
-defword 'xtcomp', 6, word_xtcomp
- mov dword [compiling], 1
-_xtcomp_loop:
- call word_word
- call word_parse
- pspop eax
- test eax, eax
- jz _xtcomp_notlit
- ; is literal
- call word_litn
- jmp _xtcomp_loop
-_xtcomp_notlit:
- pspush curword
- call word_find
- test dword [ebp], -1
- jz word_wnf
- ; word found
- mov eax, [ebp] ; w
- dec eax
- test byte [eax], 0x80
- jnz _xtcomp_imm
- call word_executewrite
- jmp _xtcomp_loop
-_xtcomp_imm:
- call word_execute
- test dword [compiling], -1
- jnz _xtcomp_loop
- jmp word_exitwrite
-
-defword ':', 1, word_docol
- call word_word
- call word_entry
- jmp word_xtcomp
-
-defword ';', 0x81, word_compstop
- mov dword [compiling], 0
- ret
-
-; ( str -- )
-defword 'runword', 7, word_runword
- call word_parse
- pspop eax
- test eax, eax
- jnz _ret ; is a literal
- ; not a literal
- pspush curword
- call word_find
- test dword [ebp], -1
- jz word_wnf
- call word_execute
- jmp word_stackcond
-
-defword 'mainloop', 8, word_mainloop
- call word_word
- call word_runword
- jmp word_mainloop
diff --git a/fs/tests/asm/i386.fs b/fs/tests/asm/i386.fs
@@ -1,4 +1,5 @@
?f<< /tests/harness.fs
+ARCH S" i386" s= not [if] ." Skipping i386 assembler tests" nl> \s [then]
?f<< /asm/i386.fs
testbegin
\ Tests for asm/i386.fs
diff --git a/fs/tests/kernel.fs b/fs/tests/kernel.fs
@@ -24,8 +24,51 @@ chain foo myfoo
42 foo 43 #eq
fooinit
42 foo 86 #eq \ (42+1)*2
-testend
\ [if]..then
1 [if] 42 42 #eq [then]
0 [if] abort [then]
+
+\ does words
+: incer doer , does> @ 1+ ;
+41 incer foo
+101 incer bar
+
+foo 42 #eq
+bar 102 #eq
+
+\ case
+: foo ( n ) case
+ 1 of = 111 endof
+ 42 of > 222 endof
+ 333
+ endcase ;
+
+here .x
+current .x
+' foo .x
+1 foo 111 #eq
+2 foo 222 #eq
+3 foo 222 #eq
+42 foo 333 #eq
+
+\ while..repeat
+: foo begin dup 9 20 =><= not while dup 3 5 =><= not while 1+ repeat
+ 100 + else 200 + then ;
+
+1 foo 103 #eq
+10 foo 210 #eq
+6 foo 209 #eq
+20 foo 220 #eq
+
+\ prevword
+: bar ;
+: baz ;
+' baz prevword ' bar #eq
+
+\ autoloading
+floaded #
+
+0 ( file doesn't exist ) floaded? not #
+S" /tests/harness.fs" findpath floaded? #
+testend
diff --git a/fs/tests/lib/core.fs b/fs/tests/lib/core.fs
@@ -13,43 +13,4 @@ $1234 capture .x S" 00001234" #s=
42 1024 * 1024 * capture .sz S" 42MB" #s=
-1 capture .sz S" 3GB" #s=
-\ does words
-: incer doer , does> @ 1+ ;
-41 incer foo
-101 incer bar
-
-foo 42 #eq
-bar 102 #eq
-
-\ case
-: foo ( n ) case
- 1 of = 111 endof
- 42 of > 222 endof
- 333
- endcase ;
-
-1 foo 111 #eq
-2 foo 222 #eq
-3 foo 222 #eq
-42 foo 333 #eq
-
-\ while..repeat
-: foo begin dup 9 20 =><= not while dup 3 5 =><= not while 1+ repeat
- 100 + else 200 + then ;
-
-1 foo 103 #eq
-10 foo 210 #eq
-6 foo 209 #eq
-20 foo 220 #eq
-
-\ prevword
-: bar ;
-: baz ;
-' baz prevword ' bar #eq
-
-\ autoloading
-floaded #
-
-0 ( file doesn't exist ) floaded? not #
-S" /tests/harness.fs" findpath floaded? #
testend
diff --git a/posix/glue1.fs b/posix/glue1.fs
@@ -1,3 +0,0 @@
-\ Glue code between the storage driver and the FS handler
-fatfs( to ramdrv(
-RAMDrive value fatdrv
diff --git a/posix/glue2.fs b/posix/glue2.fs
@@ -1,5 +0,0 @@
-\ Glue code that goes between the filesystem part and boothi
-alias fatopenlo fopen
-alias fatchild fchild
-0 S" drv" fchild S" ramdrive.fs" fchild floaded,
-0 S" fs" fchild S" fatlo.fs" fchild floaded,
diff --git a/posix/vm.c b/posix/vm.c
@@ -326,7 +326,7 @@ static void RSGET() { // op: 22
static void RDROP() { // op: 23
dword a = rpop();
- ppop();
+ rpop();
rpush(a);
}
@@ -363,11 +363,15 @@ static void ADEC() { // op: 2b
}
static void A2RS() { // op: 2c
+ dword a = rpop();
rpush(vm.areg);
+ rpush(a);
}
static void RS2A() { // op: 2d
+ dword a = rpop();
vm.areg = rpop();
+ rpush(a);
}
static void TOSET() { // op: 2e
@@ -587,7 +591,7 @@ static void PARSE() { // op: 53
dword s = ppop();
byte len = gb(s++);
dword n = 0;
- dword neg = 0;
+ byte neg = 0;
byte c;
if (!len) goto err;
switch (gb(s)) {
@@ -611,7 +615,7 @@ static void PARSE() { // op: 53
}
break;
case '-':
- neg = 0x80000000;
+ neg = 1;
s++; len--;
if (!len) goto err;
default: // decimal
@@ -621,7 +625,7 @@ static void PARSE() { // op: 53
n *= 10;
n += c;
}
- n |= neg;
+ if (neg) n *= -1;
}
ppush(n); ppush(1);
return;
@@ -811,9 +815,11 @@ static void FREADBUF () { // op: 5f
static void FCLOSE () { // op: 60
dword hdl = ppop();
int fd = getfiledesc(hdl);
- close(fd);
- sd(hdl+20, 0);
- sd(hdl+24, 0);
+ if (fd) {
+ close(fd);
+ sd(hdl+20, 0);
+ sd(hdl+24, 0);
+ }
}
#define OPCNT 0x61
@@ -918,6 +924,8 @@ static void buildsysdict() {
sysval("current", CURRENT);
sysval("compiling", COMPILING);
sysconst("heremax", HEREMAX);
+ sysconst("curword", CURWORD);
+ entry("mainloop");
sd(MAINLOOP, here());
callwr(find("word"));
callwr(find("runword"));
@@ -928,7 +936,7 @@ static void buildsysdict() {
// Interpret loop
int main() {
strcpy(fsids[0], "fs"); // Set FS root path
- bootfp = fopen("posix/tmpboot.fs", "r");
+ bootfp = fopen("posix/boot.fs", "r");
if (!bootfp) {
printf("Can't open boot file.\n");
return 1;
@@ -937,5 +945,11 @@ int main() {
vm.PC = find("(abort)");
while (vm.PC < MEMSZ) oprun1();
fclose(bootfp);
+ if (vm.PC > MEMSZ) {
+ fprintf(stderr, "Dumping memory to memdump.\n");
+ FILE *fp = fopen("memdump", "w");
+ fwrite(vm.mem, MEMSZ, 1, fp);
+ fclose(fp);
+ }
return MEMSZ - vm.PC;
}
