commit 94efeaba0d5875aa55fb33da77d7accc402aa4e8
parent 14a9f6fd2e6919d523effc10a148a73cd2fcbb58
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 7 Jun 2022 06:34:34 -0400
Use nasm context stack to avoid prev_word repetition in defword macro
Diffstat:
| M | dusk.asm | | | 194 | ++++++++++++++++++++++++++++++++++++++++++------------------------------------- |
1 file changed, 103 insertions(+), 91 deletions(-)
diff --git a/dusk.asm b/dusk.asm
@@ -18,10 +18,22 @@ BITS 32
add ebp, 4
%endmacro
-%macro defword 4 ; name namelen lbl prevlbl
+%macro firstword 3 ; name namelen lbl
db %1
-dd %4
+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
@@ -79,22 +91,22 @@ _start:
int 0x80
jmp word_abort
-defword 'bye', 3, word_bye, 0
+firstword 'bye', 3, word_bye
mov eax, SYSCALL_EXIT
mov ebx, 0 ; error code
int 0x80
-defword 'noop', 4, word_noop, word_bye
+defword 'noop', 4, word_noop
ret
-defword 'quit', 4, word_quit, word_noop
+defword 'quit', 4, word_quit
cld
mov byte [toflag], 0
mov dword [inrd], word_iinrd ; make sure input is interactive after a quit
mov esp, rs_top
jmp word_mainloop
-defword 'abort', 5, word_abort, word_quit
+defword 'abort', 5, word_abort
test byte [exitonabort], -1
jz _abort_no_exit
mov eax, SYSCALL_EXIT
@@ -104,19 +116,19 @@ _abort_no_exit:
mov ebp, ps_top
jmp word_quit
-defword 'exitonabort', 11, word_exitonabort, word_abort
+defword 'exitonabort', 11, word_exitonabort
mov byte [exitonabort], 1
ret
-defword 'exit', 4, word_exit, word_exitonabort
+defword 'exit', 4, word_exit
pop eax
ret
-defword 'execute', 7, word_execute, word_exit
+defword 'execute', 7, word_execute
pspop eax
jmp eax
-defword '(cell)', 6, word_cellroutine, word_execute
+defword '(cell)', 6, word_cellroutine
pop eax
pspush eax
ret
@@ -127,7 +139,7 @@ to_is_set: ; eax=cell addr
mov [eax], ebx
ret
-defword '(val)', 5, word_valroutine, word_cellroutine
+defword '(val)', 5, word_valroutine
pop eax
test byte [toflag], 0xff
jnz to_is_set
@@ -135,13 +147,13 @@ defword '(val)', 5, word_valroutine, word_cellroutine
pspush ebx
ret
-defword '(alias)', 7, word_aliasroutine, word_valroutine
+defword '(alias)', 7, word_aliasroutine
pop eax
test byte [toflag], 0xff
jnz to_is_set
jmp [eax]
-defword '(s)', 3, word_strlit, word_aliasroutine
+defword '(s)', 3, word_strlit
pop esi ; addr of str
mov eax, 0
lodsb ; len
@@ -150,11 +162,11 @@ defword '(s)', 3, word_strlit, word_aliasroutine
add esi, eax ; ret to PC right after str
jmp esi
-defword '(br)', 4, word_brroutine, word_strlit
+defword '(br)', 4, word_brroutine
pop eax
jmp dword [eax]
-defword '(?br)', 5, word_condbrroutine, word_brroutine
+defword '(?br)', 5, word_condbrroutine
pspop eax
or eax, eax
jz word_brroutine
@@ -162,7 +174,7 @@ defword '(?br)', 5, word_condbrroutine, word_brroutine
add eax, 4
jmp eax
-defword '(next)', 6, word_nextroutine, word_condbrroutine
+defword '(next)', 6, word_nextroutine
dec dword [esp+4]
jnz word_brroutine
pop eax
@@ -170,7 +182,7 @@ defword '(next)', 6, word_nextroutine, word_condbrroutine
add eax, 4
jmp eax
-defword 'boot<', 5, word_bootrd, word_nextroutine
+defword 'boot<', 5, word_bootrd
mov esi, [bootptr]
xor eax,eax
mov al, [esi]
@@ -178,7 +190,7 @@ defword 'boot<', 5, word_bootrd, word_nextroutine
pspush eax
ret
-defword 'emit', 4, word_emit, word_bootrd
+defword 'emit', 4, word_emit
mov eax, SYSCALL_WRITE
mov ebx, 1 ; stdout
mov ecx, ebp ; buffer: top of PS, little endian
@@ -187,7 +199,7 @@ defword 'emit', 4, word_emit, word_bootrd
pspop eax
ret
-defword 'key', 3, word_key, word_emit
+defword 'key', 3, word_key
pspush 0
mov eax, SYSCALL_READ
mov ebx, 0 ; stdin
@@ -197,7 +209,7 @@ defword 'key', 3, word_key, word_emit
ret
; ( eax ebx ecx edx -- eax )
-defword 'lnxcall', 7, word_lnxcall, word_key
+defword 'lnxcall', 7, word_lnxcall
pspop edx
pspop ecx
pspop ebx
@@ -206,35 +218,35 @@ defword 'lnxcall', 7, word_lnxcall, word_key
pspush eax
ret
-defword 'drop', 4, word_drop, word_lnxcall
+defword 'drop', 4, word_drop
add ebp, 4
ret
-defword 'dup', 3, word_dup, word_drop
+defword 'dup', 3, word_dup
mov eax, [ebp]
sub ebp, 4
mov [ebp], eax
ret
-defword '?dup', 4, word_conddup, word_dup
+defword '?dup', 4, word_conddup
test dword [ebp], -1
jnz word_dup
ret
-defword 'swap', 4, word_swap, word_conddup
+defword 'swap', 4, word_swap
mov eax, [ebp]
mov ebx, [ebp+4]
mov [ebp], ebx
mov [ebp+4], eax
ret
-defword 'over', 4, word_over, word_swap
+defword 'over', 4, word_over
mov eax, [ebp+4]
sub ebp, 4
mov [ebp], eax
ret
-defword 'rot', 3, word_rot, word_over
+defword 'rot', 3, word_rot
mov eax, [ebp]
mov ebx, [ebp+4]
mov ecx, [ebp+8]
@@ -243,12 +255,12 @@ defword 'rot', 3, word_rot, word_over
mov [ebp+8], ebx
ret
-defword 'nip', 3, word_nip, word_rot
+defword 'nip', 3, word_nip
pspop eax
mov [ebp], eax
ret
-defword 'tuck', 4, word_tuck, word_nip
+defword 'tuck', 4, word_tuck
mov eax, [ebp]
mov ebx, [ebp+4]
mov [ebp], ebx
@@ -256,7 +268,7 @@ defword 'tuck', 4, word_tuck, word_nip
pspush eax
ret
-defword 'rot>', 4, word_rotr, word_tuck
+defword 'rot>', 4, word_rotr
mov eax, [ebp]
mov ebx, [ebp+4]
mov ecx, [ebp+8]
@@ -268,35 +280,35 @@ defword 'rot>', 4, word_rotr, word_tuck
; 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_rotr
+defword 'r>', 2, word_rs2ps
pop eax
sub ebp,4
pop dword [ebp]
jmp eax
-defword '>r', 2, word_ps2rs, word_rs2ps
+defword '>r', 2, word_ps2rs
pspop eax
xchg eax, [esp]
jmp eax
-defword 'r@', 2, word_rsget, word_ps2rs
+defword 'r@', 2, word_rsget
mov eax, [esp+4]
pspush eax
ret
-defword 'r~', 2, word_rsdrop, word_rsget
+defword 'r~', 2, word_rsdrop
pop eax
add esp, 4
jmp eax
-defword 'scnt', 4, word_scnt, word_rsdrop
+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, word_scnt
+defword 'rcnt', 4, word_rcnt
mov eax, rs_top
sub eax, esp
shr ax, 2 ; div by 4, preserve neg
@@ -304,170 +316,170 @@ defword 'rcnt', 4, word_rcnt, word_scnt
pspush eax
ret
-defword '>A', 2, word_Aset, word_rcnt
+defword '>A', 2, word_Aset
pspop eax
mov [areg], eax
ret
-defword 'A>', 2, word_Aget, word_Aset
+defword 'A>', 2, word_Aget
mov eax, [areg]
pspush eax
ret
-defword 'Ac@', 3, word_Acfetch, word_Aget
+defword 'Ac@', 3, word_Acfetch
mov eax, 0
mov esi, [areg]
mov al, [esi]
pspush eax
ret
-defword 'Ac!', 3, word_Acstore, word_Acfetch
+defword 'Ac!', 3, word_Acstore
pspop eax
mov esi, [areg]
mov [esi], al
ret
-defword 'A+', 2, word_Ainc, word_Acstore
+defword 'A+', 2, word_Ainc
inc dword [areg]
ret
-defword 'A-', 2, word_Adec, word_Ainc
+defword 'A-', 2, word_Adec
dec dword [areg]
ret
-defword 'A>r', 3, word_A2rs, word_Adec
+defword 'A>r', 3, word_A2rs
pop eax
push dword [areg]
jmp eax
-defword 'r>A', 3, word_rs2A, word_A2rs
+defword 'r>A', 3, word_rs2A
pop eax
pop dword [areg]
jmp eax
-defword 'to', 2, word_to, word_rs2A
+defword 'to', 2, word_to
mov byte [toflag], 1
ret
-defword 'to?', 3, word_tocond, word_to
+defword 'to?', 3, word_tocond
xor eax, eax
mov al, [toflag]
pspush eax
mov byte [toflag], 0
ret
-defword '1+', 2, word_inc, word_to
+defword '1+', 2, word_inc
inc dword [ebp]
ret
-defword '1-', 2, word_dec, word_inc
+defword '1-', 2, word_dec
dec dword [ebp]
ret
-defword 'c@', 2, word_cfetch, word_dec
+defword 'c@', 2, word_cfetch
mov esi, [ebp]
mov eax, 0
mov al, [esi]
mov [ebp], eax
ret
-defword 'c!', 2, word_cstore, word_cfetch
+defword 'c!', 2, word_cstore
pspop eax
pspop ebx
mov [eax], bl
ret
-defword 'c,', 2, word_cwrite, word_cstore
+defword 'c,', 2, word_cwrite
pspop eax
mov esi, [here]
mov [esi], al
inc dword [here]
ret
-defword '@', 1, word_fetch, word_cwrite
+defword '@', 1, word_fetch
mov esi, [ebp]
mov eax, [esi]
mov [ebp], eax
ret
-defword '!', 1, word_store, word_fetch
+defword '!', 1, word_store
pspop eax
pspop ebx
mov [eax], ebx
ret
-defword ',', 1, word_write, word_store
+defword ',', 1, word_write
pspop eax
mov esi, [here]
mov [esi], eax
add dword [here], 4
ret
-defword '+', 1, word_add, word_write
+defword '+', 1, word_add
pspop eax
add [ebp], eax
ret
-defword '-', 1, word_sub, word_add
+defword '-', 1, word_sub
pspop eax
sub [ebp], eax
ret
-defword '*', 1, word_mul, word_sub
+defword '*', 1, word_mul
pspop eax
mov ebx, [ebp]
mul ebx
mov [ebp], eax
ret
-defword 'and', 3, word_and, word_mul
+defword 'and', 3, word_and
pspop eax
and [ebp], eax
ret
-defword 'or', 2, word_or, word_and
+defword 'or', 2, word_or
pspop eax
or [ebp], eax
ret
-defword 'xor', 3, word_xor, word_or
+defword 'xor', 3, word_xor
pspop eax
xor [ebp], eax
ret
-defword 'not', 3, word_not, word_xor
+defword 'not', 3, word_not
mov eax, [ebp]
mov dword [ebp], 0
test eax, eax
setz byte [ebp]
ret
-defword '<', 1, word_lt, word_not
+defword '<', 1, word_lt
pspop eax
sub [ebp], eax
mov dword [ebp], 0
setc byte [ebp]
ret
-defword '<<c', 3, word_shlc, word_lt
+defword '<<c', 3, word_shlc
pspush 0
shl dword [ebp+4], 1
setc byte [ebp]
ret
-defword '>>c', 3, word_shrc, word_shlc
+defword '>>c', 3, word_shrc
pspush 0
shr dword [ebp+4], 1
setc byte [ebp]
ret
; ( n u -- n )
-defword 'lshift', 6, word_lshift, word_shrc
+defword 'lshift', 6, word_lshift
pspop ecx
shl dword [ebp], cl
ret
-defword 'rshift', 6, word_rshift, word_lshift
+defword 'rshift', 6, word_rshift
pspop ecx
shr dword [ebp], cl
ret
@@ -475,13 +487,13 @@ defword 'rshift', 6, word_rshift, word_lshift
litncode:
pspush 0
litncode_end:
-defword 'litn', 4, word_litn, word_rshift
+defword 'litn', 4, word_litn
pspush litncode ; src
pspush litncode_end-litncode-4 ; len_of_code-len-of-imm
call word_movewrite
jmp word_write
-defword 'call,', 5, word_callwrite, word_litn
+defword 'call,', 5, word_callwrite
pspush 0xe8 ; call opcode
call word_cwrite
mov eax, [ebp] ; absolute addr
@@ -490,35 +502,35 @@ defword 'call,', 5, word_callwrite, word_litn
mov [ebp], eax
jmp word_write
-defword 'exit,', 5, word_exitwrite, word_callwrite
+defword 'exit,', 5, word_exitwrite
pspush 0xc3 ; ret opcode
jmp word_cwrite
-defword 'current', 7, word_current, word_exitwrite
+defword 'current', 7, word_current
sysval current
-defword 'here', 4, word_here, word_current
+defword 'here', 4, word_here
sysval here
-defword 'compiling', 9, word_compiling, word_here
+defword 'compiling', 9, word_compiling
sysval compiling
; interactive in<
-defword 'iin<', 4, word_iinrd, word_compiling
+defword 'iin<', 4, word_iinrd
sysalias iinrd
; where "word" feeds itself
-defword 'in<', 3, word_inrd, word_iinrd
+defword 'in<', 3, word_inrd
sysalias inrd
-defword 'allot', 5, word_allot, word_inrd
+defword 'allot', 5, word_allot
pspop eax
add dword [here], eax
ret
; : move ( src dst u -- ) ?dup if
; A>r >r >A begin ( src ) c@+ Ac!+ next drop r>A then ;
-defword 'move', 4, word_move, word_allot
+defword 'move', 4, word_move
pspop ecx
pspop edi
pspop esi
@@ -529,7 +541,7 @@ _ret:
ret
; ( a u -- )
-defword 'move,', 5, word_movewrite, word_move
+defword 'move,', 5, word_movewrite
pspop ecx
pspop esi
test ecx, ecx
@@ -540,7 +552,7 @@ defword 'move,', 5, word_movewrite, word_move
ret
; ( -- sa sl )
-defword 'stype', 5, word_stype, word_movewrite
+defword 'stype', 5, word_stype
pspop ecx
pspop esi
_stype_loop:
@@ -558,7 +570,7 @@ _stype_loop:
ret
; ( -- )
-defword '(wnf)', 5, word_wnf, word_stype
+defword '(wnf)', 5, word_wnf
call word_curword
call word_stype
mov ecx, 15
@@ -566,7 +578,7 @@ defword '(wnf)', 5, word_wnf, word_stype
call _stype_loop
jmp word_abort
-defword 'stack?', 6, word_stackcond, word_wnf
+defword 'stack?', 6, word_stackcond
cmp ebp, ps_top
jna _ret
mov ecx, 15
@@ -575,7 +587,7 @@ defword 'stack?', 6, word_stackcond, word_wnf
jmp word_abort
; ( -- sa sl )
-defword 'curword', 7, word_curword, word_stackcond
+defword 'curword', 7, word_curword
xor eax, eax
mov al, [curword]
pspush curword+1
@@ -583,7 +595,7 @@ defword 'curword', 7, word_curword, word_stackcond
ret
; ( -- sa sl )
-defword 'word', 4, word_word, word_curword
+defword 'word', 4, word_word
_word_loop1:
call [inrd] ; ( -- c )
pspop eax
@@ -670,7 +682,7 @@ _parse_ud_loop:
ret
; ( sa sl -- n? f )
-defword 'parse', 5, word_parse, word_word
+defword 'parse', 5, word_parse
pspop ecx
mov esi, [ebp]
cmp byte [esi], "'"
@@ -691,7 +703,7 @@ _parse_no:
ret
; ( a1 a2 u -- f )
-defword '[]=', 3, word_rangeeq, word_parse
+defword '[]=', 3, word_rangeeq
pspop ecx
pspop edi
pspop esi
@@ -702,7 +714,7 @@ defword '[]=', 3, word_rangeeq, word_parse
ret
; ( sa sl -- w? f )
-defword 'find', 4, word_find, word_rangeeq
+defword 'find', 4, word_find
pspop ecx
mov edx, [current]
_find_loop:
@@ -734,7 +746,7 @@ _find_skip1:
ret
; ( -- w )
-defword "'", 1, word_apos, word_find
+defword "'", 1, word_apos
call word_word
call word_find
pspop eax
@@ -744,7 +756,7 @@ defword "'", 1, word_apos, word_find
; : entry ( sa sl -- )
; tuck move, ( len ) current , c, here to current ;
-defword 'entry', 5, word_entry, word_apos
+defword 'entry', 5, word_entry
call word_tuck
call word_movewrite
call word_current
@@ -760,7 +772,7 @@ defword 'entry', 5, word_entry, word_apos
; else (wnf) then then
; compiling not until
; exit, ;
-defword 'xtcomp', 6, word_xtcomp, word_entry
+defword 'xtcomp', 6, word_xtcomp
mov dword [compiling], 1
_xtcomp_loop:
call word_word
@@ -791,16 +803,16 @@ _xtcomp_imm:
jnz _xtcomp_loop
jmp word_exitwrite
-defword ':', 1, word_docol, word_xtcomp
+defword ':', 1, word_docol
call word_word
call word_entry
jmp word_xtcomp
-defword ';', 0x81, word_compstop, word_docol
+defword ';', 0x81, word_compstop
mov dword [compiling], 0
ret
-defword 'run1', 4, word_run1, word_compstop
+defword 'run1', 4, word_run1
; save toflag so that it doesn't mess word/parse/find
xor eax, eax
mov al, [toflag]
@@ -826,6 +838,6 @@ _run1_notlit:
call word_execute
jmp word_stackcond
-defword 'mainloop', 8, word_mainloop, word_run1
+defword 'mainloop', 8, word_mainloop
call word_run1
jmp word_mainloop
