commit 3c9ee4c634e74e1871c7bb0f745aedc9282ad5fb
parent 6460c48c6a0f90ab29172f62e946f364dd01bfd5
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 1 Jun 2022 13:51:41 -0400
Almost there!
Diffstat:
5 files changed, 131 insertions(+), 80 deletions(-)
diff --git a/aliases.txt b/aliases.txt
@@ -2,6 +2,9 @@
r> rs2ps
r@ rsget
r~ rsdrop
+(cell) cellroutine
+(alias) aliasroutine
+(s) strlit
+ add
- sub
* mul
@@ -26,7 +29,6 @@ in> inptr
>>c shrc
<< shl
>> shr
-move, movewr
boot< bootrd
in<? inrdc
in< inrd
@@ -34,3 +36,5 @@ in< inrd
[]= rangeeq
(wnf) wnf
' apos
+; compstop
+: docolon
diff --git a/dusk.asm b/dusk.asm
@@ -35,25 +35,6 @@ pspush %1
ret
%endmacro
-%macro ps2rs 0
-push dword [ebp]
-add ebp,4
-%endmacro
-
-%macro rs2ps 0
-sub ebp,4
-pop dword [ebp]
-%endmacro
-
-%define rsdrop pop eax
-
-%define A2rs push dword [areg]
-%define rs2A pop dword [areg]
-%macro rsget 0
-mov eax, [esp]
-mov [areg], eax
-%endmacro
-
%macro _begin_ 0
%push begin
%$begin:
@@ -120,15 +101,35 @@ SECTION .text
GLOBAL _start
_start:
+ mov dword [here], herestart
+ mov dword [current], bootsrc
+ mov dword [inptr], bootsrc
+ 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
+
+defword 'quit', 4, word_quit, word_bye
cld
- mov esp, rs_top
- mov ebp, ps_top
mov byte [toflag], 0
- mov dword [here], herestart
- mov dword [current], word_lastxcomp
- jmp word_boot
+ mov esi, rs_top
+ jmp word_mainloop
-cellword:
+defword 'abort', 5, word_abort, word_quit
+ mov ebp, ps_top
+ jmp word_quit
+
+defword 'exit', 4, word_exit, word_abort
+ pop eax
+ ret
+
+defword 'execute', 8, word_execute, word_exit
+ pspop eax
+ jmp eax
+
+defword '(cell)', 6, word_cellroutine, word_execute
pop eax
pspush eax
ret
@@ -139,13 +140,13 @@ to_is_set: ; eax=cell addr
mov [eax], ebx
ret
-aliasword:
+defword '(alias)', 7, word_aliasroutine, word_cellroutine
pop eax
test byte [toflag], 0xff
jnz to_is_set
jmp [eax]
-strlit:
+defword '(s)', 3, word_strlit, word_aliasroutine
pop esi ; addr of str
mov eax, 0
lodsb ; len
@@ -154,24 +155,7 @@ strlit:
add esi, eax ; ret to PC right after str
jmp esi
-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
-
-defword 'quit', 4, word_quit, word_bye
- mov esi, rs_top
- jmp word_mainloop
-
-defword 'abort', 5, word_abort, word_quit
- mov ebp, ps_top
- jmp word_quit
-
-defword 'exit', 4, word_exit, word_abort
- pop eax
- ret
-
-defword 'emit', 4, word_emit, word_exit
+defword 'emit', 4, word_emit, word_strlit
mov eax,4 ; 'write' syscall
mov ebx,1 ; stdout
mov ecx,ebp ; top of PS, little endian
@@ -216,7 +200,46 @@ defword 'rot', 3, word_rot, word_over
mov [ebp+8], ebx
ret
-defword '>A', 2, word_Aset, word_rot
+; 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, word_rot
+ pop eax
+ sub ebp,4
+ pop dword [ebp]
+ jmp eax
+
+defword '>r', 2, word_ps2rs, word_rs2ps
+ pspop eax
+ xchg eax, [esp]
+ jmp eax
+
+defword 'r@', 2, word_rsget, word_ps2rs
+ mov eax, [esp+4]
+ mov [areg], eax
+ ret
+
+defword 'r~', 2, word_rsdrop, word_rsget
+ pop eax
+ add esp, 4
+ jmp eax
+
+defword 'scnt', 4, word_scnt, word_rsdrop
+ mov eax, ps_top
+ sub eax, ebp
+ shr eax, 2 ; div by 4
+ pspush eax
+ ret
+
+defword 'rcnt', 4, word_rcnt, word_scnt
+ mov eax, rs_top
+ sub eax, esp
+ shr eax, 2 ; div by 4
+ dec eax ; ignore this call
+ pspush eax
+ ret
+
+defword '>A', 2, word_Aset, word_rcnt
pspop eax
mov [areg], eax
ret
@@ -246,7 +269,17 @@ defword 'A-', 2, word_Adec, word_Ainc
dec dword [areg]
ret
-defword 'to', 2, word_to, word_Adec
+defword 'A>r', 3, word_A2rs, word_Adec
+ pop eax
+ push dword [areg]
+ jmp eax
+
+defword 'r>A', 3, word_rs2A, word_A2rs
+ pop eax
+ pop dword [areg]
+ jmp eax
+
+defword 'to', 2, word_to, word_rs2A
mov byte [toflag], 1
ret
@@ -316,7 +349,6 @@ defword 'xor', 3, word_xor, word_or
ret
defword 'not', 3, word_not, word_xor
-word_asmlast:
sub dword [ebp],1 ; carry=1 if 0
set_PS_to_carry: ; set PS top to 0 or one depending on CF
lahf ; c = bit 0
@@ -339,3 +371,26 @@ defword '>>c', 3, word_shrc, word_lt
sub ebp,4
shr dword [ebp+4], 1
jmp set_PS_to_carry
+
+litncode:
+ pspush 0
+litncode_end:
+defword 'litn', 4, word_litn, word_shrc
+ pspush litncode ; src
+ pspush litncode_end-litncode ; len
+ call word_movewrite
+ call word_write
+ ret
+
+defword 'call,', 5, word_callwrite, word_litn
+ pspop eax ; absolute addr
+ sub eax, [here] ; displacement
+ add eax, 5 ; ... from *after* call op
+ pspush 0xe8 ; call opcode
+ call word_cwrite
+ call word_write
+
+defword 'exit,', 5, word_exitwrite, word_callwrite
+word_asmlast:
+ pspush 0xc3 ; ret opcode
+ call word_cwrite
diff --git a/f2asm.py b/f2asm.py
@@ -7,7 +7,6 @@ import struct
fp = open(sys.argv[1], 'r')
prevword = 'asmlast'
-nasmmacros = {'ps2rs', 'rs2ps', 'rsget', 'rsdrop', 'A2rs', 'rs2A'}
anoncount = 0 # avoid label redefinitions
pairs = (line.split() for line in open('aliases.txt', 'r').read().splitlines())
aliases = {name: alias for name, alias in pairs}
@@ -113,12 +112,12 @@ def strwr():
def slitwr():
s = rdstr()
- out(f'call strlit\n')
+ out(f'call word_strlit\n')
out(f'db {len(s)}, `{s}`\n')
def _create_():
newword()
- out('call cellword\n')
+ out('call word_cellroutine\n')
def _sysval_():
alias = newword()
@@ -136,22 +135,10 @@ def _syscell_():
def _alias_():
newword()
- out('call aliasword\n')
+ out('call word_aliasroutine\n')
initial_tgt = getalias(nextt())
out(f'dd word_{initial_tgt}\n')
-def _opwriter_():
- out('TODO\n')
-
-def _callop_():
- out('TODO\n')
-
-def _pspushop_():
- out('TODO\n')
-
-def _exitop_():
- out('TODO\n')
-
special = {
':': newword,
':imm': newwordimm,
@@ -172,10 +159,6 @@ special = {
'syscell': _syscell_,
'const': _const_,
'alias': _alias_,
- 'opwriter': _opwriter_,
- 'callop': _callop_,
- 'pspushop': _pspushop_,
- 'exitop': _exitop_,
}
t = nextt()
while t:
@@ -185,17 +168,13 @@ while t:
n = litparse(t)
if n is None:
name = getalias(t)
- if name in nasmmacros:
- out(f'{name}\n')
- else:
- if name == '_':
- name = f'_{anoncount}'
- out(f'call word_{name}\n')
+ if name == '_':
+ name = f'_{anoncount}'
+ out(f'call word_{name}\n')
else:
out(f'pspush {n}\n')
t = nextt()
fp.close()
newword('_')
-out("EXTERN word_lastxcomp\n")
-out("word_lastxcomp:\n")
+out("bootsrc:\n")
diff --git a/xcomp.txt b/xcomp.txt
@@ -126,7 +126,7 @@ create tbl-0-f ," 0123456789abcdef"
dup 1- c@ $80 and ( imm? ) if execute else call, then
else (wnf) then then
compiling not until
- _i_ exitop c, ;
+ exit, ;
:imm ; 0 to compiling ;
: : entry xtcomp ;
: create entry _i_ lblcell call, ;
diff --git a/xcomp2.txt b/xcomp2.txt
@@ -70,5 +70,18 @@ create tbl-0-f ," 0123456789abcdef"
5 - ( prev field ) @ ?dup not until r~ 0 r>A ( not found ) ;
: (wnf) curword stype S" word not found" stype abort ;
: ' word find not if (wnf) then ;
-: boot S" Dusk OS" stype bye ;
-: mainloop bye ;
+: entry word tuck move, ( len )
+ current , c, here to current ;
+: xtcomp 1 to compiling begin
+ word parse if litn else curword find if
+ dup 1- c@ $80 and ( imm? ) if execute else call, then
+ else (wnf) then then
+ compiling not until
+ exit, ;
+:imm ; 0 to compiling ;
+: : entry xtcomp ;
+: stack? scnt 0< if S" stack underflow" stype abort then ;
+: run1 ( -- ) \ interpret next word
+ word parse not if
+ curword find not if (wnf) then execute stack? then ;
+: mainloop 'X' emit 0 'curword 5 + c! bye begin run1 again ;
