commit 35151beaa7aca48027994e9918d8683b11b0ba32
parent d6d3dc1f15c9f52c01fe19d37e61138512032ce2
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 1 Jun 2022 13:51:41 -0400
We have a winner!
Diffstat:
| M | boot2.fs | | | 56 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++- |
| M | dusk.asm | | | 91 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------- |
| M | f2asm.py | | | 10 | ++++------ |
| M | xcomp.txt | | | 4 | ++-- |
4 files changed, 134 insertions(+), 27 deletions(-)
diff --git a/boot2.fs b/boot2.fs
@@ -1 +1,55 @@
-: foo 'X' emit ; foo bye
+: immediate current 1- dup c@ $80 or swap c! ;
+: ['] ' litn ; immediate
+: compile ' litn ['] call, call, ; immediate
+: if compile (?br) here 4 allot ; immediate
+: then here swap ! ; immediate
+: else compile (br) here 4 allot here rot ! ; immediate
+: begin here ; immediate
+: again compile (br) , ; immediate
+: until compile (?br) , ; immediate
+: next compile (next) , ; immediate
+: \ begin in< LF = until ; immediate
+\ hello, this is a comment!
+: ," begin in< dup '"' = if drop exit then c, again ;
+: S" compile (br) here 4 allot here ," tuck here -^ swap
+ here swap ! swap litn litn ; immediate
+: S= \ sa1 sl1 sa2 sl2 -- f
+ rot over = if \ same len, s2 s1 l )
+ []= else drop 2drop 0 then ;
+: waitw \ sa sl --
+ begin 2dup word S= until 2drop ;
+: ( S" )" waitw ; immediate
+( hello, another comment! )
+: <> ( n n -- l h ) 2dup > if swap then ;
+: min <> drop ; : max <> nip ;
+: fill ( a u b -- *A* ) rot> >r >A begin dup Ac!+ next drop ;
+: .h $f and tbl-0-f + c@ emit ;
+: .x dup >> >> >> >> .h .h ;
+: nl> CR emit LF emit ; : spc> SPC emit ;
+: psdump scnt not if exit then
+ scnt >A begin dup .x spc> >r scnt not until
+ begin r> scnt A> = until ;
+: .S ( -- )
+ S" SP " stype scnt .x spc> S" RS " stype rcnt .x spc>
+ S" -- " stype stack? psdump ;
+: create entry compile (cell) ;
+: value entry compile (val) , ;
+64 value LNSZ
+create in( LNSZ allot
+: in) in( 64 + ;
+: bs? BS over = swap $7f = or ;
+: lntype ( ptr c -- ptr+1 f )
+ dup bs? if ( ptr c )
+ drop dup in( > if 1- BS emit then spc> BS emit 0
+ else ( ptr c ) \ non-BS
+ dup SPC < if drop dup in) over - 0 fill 1 else
+ tuck emit c!+ dup in) = then then ;
+: rdln S" ok" stype nl> in( begin key lntype until drop nl> ;
+: rdln<? ( -- c-or-0 )
+ in> in) < if in> c@+ swap to in> else 0 then ;
+: rdln< ( -- c ) rdln<? ?dup not if
+ rdln in( to in> SPC then ;
+: rdln$ ['] rdln< to in< ['] rdln<? to in<?
+ in) to in> 'curword 6 0 fill ;
+: init S" Dusk OS" stype rdln$ ;
+init
diff --git a/dusk.asm b/dusk.asm
@@ -3,6 +3,9 @@ BITS 32
%define PS_SZ 0x1000
%define RS_SZ 0x1000
%define MEMSIZE 0x40000
+%define SYSCALL_EXIT 1
+%define SYSCALL_READ 3
+%define SYSCALL_WRITE 4
%macro pspush 1 ; src
sub ebp, 4
@@ -30,6 +33,13 @@ pspush eax
ret
%endmacro
+%macro sysalias 1 ; lbl
+mov eax,%1
+test byte [toflag], 0xff
+jnz to_is_set
+jmp [eax]
+%endmacro
+
%macro constant 1 ; val
pspush %1
ret
@@ -86,12 +96,14 @@ jz %$if
SECTION .bss
areg: resd 1
toflag: resb 1
- resd RS_SZ
current: resd 1
here: resd 1
compiling: resd 1
curword: resb 6
inptr: resd 1
+inrd: resd 1
+inrdc: resd 1
+ resd RS_SZ
rs_top:
resd PS_SZ
ps_top:
@@ -106,17 +118,19 @@ _start:
mov dword [here], herestart
mov dword [current], word_lastxcomp
mov dword [inptr], bootsrc
+ mov dword [inrd], word_bootrd
+ mov dword [inrdc], word_bootrd
jmp word_abort
defword 'bye', 3, word_bye, 0
- mov eax,1 ; 'exit' system call
- mov ebx,0 ; exit with error code 0
- int 80h ; call the kernel
+ mov eax, SYSCALL_EXIT
+ mov ebx, 0 ; error code
+ int 0x80
defword 'quit', 4, word_quit, word_bye
cld
mov byte [toflag], 0
- mov esi, rs_top
+ mov esp, rs_top
jmp word_mainloop
defword 'abort', 5, word_abort, word_quit
@@ -142,7 +156,15 @@ to_is_set: ; eax=cell addr
mov [eax], ebx
ret
-defword '(alias)', 7, word_aliasroutine, word_cellroutine
+defword '(val)', 5, word_valroutine, word_cellroutine
+ pop eax
+ test byte [toflag], 0xff
+ jnz to_is_set
+ mov ebx, [eax]
+ pspush ebx
+ ret
+
+defword '(alias)', 7, word_aliasroutine, word_valroutine
pop eax
test byte [toflag], 0xff
jnz to_is_set
@@ -157,16 +179,45 @@ defword '(s)', 3, word_strlit, word_aliasroutine
add esi, eax ; ret to PC right after str
jmp esi
-defword 'emit', 4, word_emit, word_strlit
- mov eax,4 ; 'write' syscall
- mov ebx,1 ; stdout
- mov ecx,ebp ; top of PS, little endian
- mov edx,1
- int 80h
+defword '(br)', 4, word_brroutine, word_strlit
+ pop eax
+ jmp dword [eax]
+
+defword '(?br)', 5, word_condbrroutine, word_brroutine
+ pspop eax
+ or eax, eax
+ jz word_brroutine
+ pop eax
+ add eax, 4
+ jmp eax
+
+defword '(next)', 6, word_nextroutine, word_condbrroutine
+ dec dword [esp+4]
+ jnz word_brroutine
+ pop eax
+ pop ebx
+ add eax, 4
+ jmp eax
+
+defword 'emit', 4, word_emit, word_nextroutine
+ 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 'drop', 4, word_drop, word_emit
+defword 'key', 3, word_key, word_emit
+ pspush 0
+ mov eax, SYSCALL_READ
+ xor ebx, ebx ; stdin
+ mov ecx, ebp ; buffer
+ mov edx, 1 ; len
+ int 0x80
+ ret
+
+defword 'drop', 4, word_drop, word_key
add ebp, 4
ret
@@ -176,7 +227,7 @@ defword 'dup', 3, word_dup, word_drop
mov [ebp], eax
ret
-defword '?dup', 4, word_conddup, word_drop
+defword '?dup', 4, word_conddup, word_dup
test dword [ebp], -1
jnz word_dup
ret
@@ -386,18 +437,22 @@ defword 'litn', 4, word_litn, word_shrc
call word_write
ret
-defword 'call,', 5, word_callwrite, word_litn
+write_displacement:
mov eax, [ebp] ; absolute addr
sub eax, [here] ; displacement
- sub eax, 5 ; ... from *after* call op
+ sub eax, 4 ; ... from *after* call/jmp op
mov [ebp], eax
- pspush 0xe8 ; call opcode
- call word_cwrite
call word_write
ret
+defword 'call,', 5, word_callwrite, word_litn
+ pspush 0xe8 ; call opcode
+ call word_cwrite
+ jmp write_displacement
+
defword 'exit,', 5, word_exitwrite, word_callwrite
word_asmlast:
pspush 0xc3 ; ret opcode
call word_cwrite
ret
+
diff --git a/f2asm.py b/f2asm.py
@@ -133,11 +133,9 @@ def _syscell_():
lbl = nextt()
out(f'constant {lbl}\n')
-def _alias_():
- newword()
- out('call word_aliasroutine\n')
- initial_tgt = getalias(nextt())
- out(f'dd word_{initial_tgt}\n')
+def _sysalias_():
+ alias = newword()
+ out(f'sysalias {alias}\n')
special = {
':': newword,
@@ -158,7 +156,7 @@ special = {
'sysval': _sysval_,
'syscell': _syscell_,
'const': _const_,
- 'alias': _alias_,
+ 'alias': _sysalias_,
}
t = nextt()
while t:
diff --git a/xcomp.txt b/xcomp.txt
@@ -30,8 +30,8 @@ syscell 'curword curword
: stype >r begin c@+ emit next drop ;
: ws? SPC <= ;
: boot< in> c@+ swap to in> ;
-alias in<? boot<
-alias in< boot<
+alias in<?
+alias in<
: toword ( -- ) begin in< ws? not until ;
: curword ( -- sa sl ) 'curword 1+ @ 'curword c@ ;
: _ ( f sa sl -- ) 'curword c!+ tuck ! 4 + c! ;
