duskos

commit c6d32810613ae6b115ddb95bc968dd6fe5b25775
parent 7414efe4b501bfa7e18c6fda66dc40a552d313b2
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Wed,  1 Jun 2022 13:51:41 -0400

Add a bunch of words

Diffstat:
M
Makefile
 | 
2
+-
M
aliases.txt
 | 
1
+
M
dusk.asm
 | 
67
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---
M
xcomp2.txt
 | 
12
+++++++++++-

4 files changed, 77 insertions(+), 5 deletions(-)
diff --git a/Makefile b/Makefile
@@ -1,7 +1,7 @@
 TARGETS = dusk
 all: $(TARGETS)
 
-xcomp.asm: dusk.asm xcomp2.txt f2asm.py
+xcomp.asm: dusk.asm xcomp2.txt f2asm.py aliases.txt
 	echo "; This file is autogenerated" > $@
 	cat dusk.asm >> $@ 
 	./f2asm.py xcomp2.txt >> $@
diff --git a/aliases.txt b/aliases.txt
@@ -40,3 +40,4 @@ c, cwrite
 << shl
 >> shr
 move, movewr
+?dup cdup
diff --git a/dusk.asm b/dusk.asm
@@ -52,6 +52,18 @@ pop dword [ebp]
 %$begin:
 %endmacro
 
+%macro _again_ 0
+jmp %$begin
+%pop
+%endmacro
+
+%macro _until_ 0
+pspop eax
+or eax, eax
+jz %$begin
+%pop
+%endmacro
+
 %macro _next_ 0
 dec dword [esp]
 jnz %$begin
@@ -59,6 +71,18 @@ jnz %$begin
 pop eax
 %endmacro
 
+%macro _if_ 0
+%push if
+pspop eax
+or eax, eax
+jz %$if
+%endmacro
+
+%macro _then_ 0
+%$if:
+%pop
+%endmacro
+
 SECTION .bss
 areg: resd 1
 toflag: resb 1
@@ -126,7 +150,11 @@ defword 'dup', 3, word_dup, word_drop
     mov [ebp], eax
     ret
 
-defword 'swap', 4, word_swap, word_dup
+defword '?dup', 4, word_cdup, word_drop
+    test dword [ebp], -1
+    jnz word_dup
+
+defword 'swap', 4, word_swap, word_cdup
     mov eax, [ebp]
     mov ebx, [ebp+4]
     mov [ebp], ebx
@@ -148,7 +176,17 @@ defword 'rot', 3, word_rot, word_over
     mov [ebp+8], ebx
     ret
 
-defword 'Ac@', 3, word_acfetch, word_rot
+defword '>A', 2, word_aset, word_rot
+    pspop eax
+    mov [areg], eax
+    ret
+
+defword 'A>', 2, word_aget, word_aset
+    mov eax, [areg]
+    pspush eax
+    net
+
+defword 'Ac@', 3, word_acfetch, word_aget
     mov eax, [areg]
     mov eax, [eax]
     pspush eax
@@ -211,8 +249,31 @@ defword '+', 1, word_add, word_store
     ret
 
 defword '-', 1, word_sub, word_add
-word_asmlast:
     pspop eax
     sub [ebp], eax
     ret
 
+defword 'not', 3, word_not, word_sub
+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
+    mov al, ah
+    and eax, 1
+    mov [ebp], eax
+    ret
+
+defword '<', 1, word_lt, word_not
+    pspop eax
+    sub [ebp], eax
+    jmp set_PS_to_carry
+    
+defword '<<c', 3, word_shlc, word_lt
+    sub ebp,4
+    shl dword [ebp+4], 1
+    jmp set_PS_to_carry
+
+defword '>>c', 3, word_shrc, word_lt
+    sub ebp,4
+    shr dword [ebp+4], 1
+    jmp set_PS_to_carry
diff --git a/xcomp2.txt b/xcomp2.txt
@@ -16,7 +16,17 @@ syscell 'curword curword
 : c@+ dup 1+ swap c@ ;
 : c!+ tuck c! 1+ ;
 : allot here + to here ;
-
+: , here ! 4 allot ;
+: c, here c! 1 allot ;
+: = - not ;
+: > swap < ;
+: 0< <<c nip ; : 0>= 0< not ; : >= < not ; : <= > not ;
+: -^ swap - ;
+: << <<c drop ;
+: >> >>c drop ;
+: move ( src dst u -- ) ?dup if
+  >r >A begin ( src ) c@+ Ac!+ next drop then ;
+: move, ( a u -- ) here over allot swap move ;
 : stype >r begin c@+ emit next drop ;
 create _ ," foo"
 : boot _ 3 stype bye ;