# HG changeset patch
# User telesto
# Date 1682356030 -7200
#      Mon Apr 24 19:07:10 2023 +0200
# Node ID 7571c2b55fecbc9778e24dcc62557fc06e9ecc44
# Parent  ddf9da4d036c7104acc7efb28d301f61334e7855
system, mandelbrot-tm: add forth versions of control structures, makes writing asm code easier

diff --git a/Makefile b/Makefile
--- a/Makefile
+++ b/Makefile
@@ -2,7 +2,7 @@
 ASFLAGS = -f elf64
 
 bins = fox swapwm avx foxx \
-		mandelbrot mandelbrot-mt mandelbrot-asm asm-test
+		mandelbrot mandelbrot-mt mandelbrot-asm asmtest
 		
 all: $(bins)
 
@@ -59,8 +59,8 @@
 foxx.o: fox $(srcs-foxx)
 			cat $(srcs-foxx) | ./fox
 
-srcs-asmtest = system.fox asm.fox fileio.fox elf64.fox \
-			bootstrap2.fox asmtest.fox bye.fox
+srcs-asmtest = system.fox fileio.fox elf64.fox \
+			asm.fox bootstrap2.fox asmtest.fox bye.fox
 asmtest.o: fox $(srcs-asmtest)
 			cat $(srcs-asmtest) | ./fox
 
diff --git a/asm.fox b/asm.fox
--- a/asm.fox
+++ b/asm.fox
@@ -78,6 +78,7 @@
 \ REX.W +	05 id		ADD RAX, imm32		Add imm32 sign-extended to 64-bits to RAX
 \ REX.W +	83 /0 ib	ADD r/m64, imm8		Add sign-extended imm8 to r/m64
 
+
 \ addressing modes (acting also as registers)
 \ can be assigned to the first operand of an instruction by using the
 \ mod and r/m field of the modrm byte.
@@ -97,27 +98,35 @@
 \ 		can not be assembled for rax, because [rcx] is 32 bit.
 \ 9:	1: extended register; 0: x86-based register; used for
 \		rex.[rxb] field
+\ 31:	set to one so we distinguish address modes/registers from
+\ 		addresses, which are <= 7fffffff.
 
-\ no support for [eax] etc., because this would require a 0x67 prefix			
+\ no support for [eax] etc., because this would require a 0x67 prefix
+			
+		80000000
+const noaddr
 
 \ modr/m.mod = 00b
-00 const [rax]	01 const [rcx]	02 const [rdx]	03 const [rbx]
+80000000 const [rax]	80000001 const [rcx]
+80000002 const [rdx]	80000003 const [rbx]
 \ 04 (would be [RSP]) and 05 (would be [EBP]) are special
-06 const [rsi]	07 const [rdi]
-200 const [r8]	201 const [r9]	202 const [r10]	203 const [r11]
-204 const [r12]	205 const [r13]	206 const [r14]	207 const [r15]
+80000006 const [rsi]	80000007 const [rdi]
+80000200 const [r8]		80000201 const [r9]
+80000202 const [r10]	80000203 const [r11]
+80000204 const [r12]	80000205 const [r13]
+80000206 const [r14]	80000207 const [r15]
 
 \ modr/m.mod = 11b
-c0 const eax	c1 const ecx	c2 const edx	c3 const ebx
-c4 const esp	c5 const ebp	c6 const esi	c7 const edi
-2c0 const r8d	2c1 const r9d	2c2 const r10d	2c3 const r11d
-2c4 const r12d	2c5 const r13d	2c6 const r14d	2c7 const r15d
+800000c0 const eax	800000c1 const ecx	800000c2 const edx	800000c3 const ebx
+800000c4 const esp	800000c5 const ebp	800000c6 const esi	800000c7 const edi
+800002c0 const r8d	800002c1 const r9d	800002c2 const r10d	800002c3 const r11d
+800002c4 const r12d	800002c5 const r13d	800002c6 const r14d	800002c7 const r15d
 
 \ modr/m.mod = 11b
-1c0 const rax	1c1 const rcx	1c2 const rdx	1c3 const rbx
-1c4 const rsp	1c5 const rbp	1c6 const rsi	1c7 const rdi
-3c0 const  r8	3c1 const  r9	3c2 const r10	3c3 const r11
-3c4 const r12	3c5 const r13	3c6 const r14	3c7 const r15
+800001c0 const rax	800001c1 const rcx	800001c2 const rdx	800001c3 const rbx
+800001c4 const rsp	800001c5 const rbp	800001c6 const rsi	800001c7 const rdi
+800003c0 const  r8	800003c1 const  r9	800003c2 const r10	800003c3 const r11
+800003c4 const r12	800003c5 const r13	800003c6 const r14	800003c7 const r15
 
 			( r/m32|64 -- r/m64 )
 : qword		100 or ;
@@ -145,7 +154,7 @@
 			( r1 -- n )
 : r.rex.w	100 and 20 / ;
 : r.rex.r	200 and 80 / ;
-: r.rex.b	200 / ;
+: r.rex.b	200 / 1 and ;
 
 			\ apply rex.w to both operands so we can use reg.opcode as r
 			\ argument in /digit addressing mode
@@ -268,7 +277,6 @@
 			( r32/r64 n -- )
 : movi,		over b8 +ro swap regsize cp (,) ;
 
-
 		( r1 -- )
 : reg@	mcreate # mfind dup # lit call, rax ^ lit  ^ lit 
 			# ffind mov, # lit call, ret, ;
@@ -286,7 +294,7 @@
 		( r1 -- )
 : reg! mcreate  ^ lit  rax ^ lit  # ffind mov, # lit call,
 		# mfind drop # lit call, ret, ;
-		
+
 ( n -- )
 rcx reg! rcx!	rdx reg! rdx!	rbx reg! rbx!	rsp reg! rsp!
 rbp reg! rbp!	rsi reg! rsi!	rdi reg! rdi!	 r8 reg!  r8!
diff --git a/elf64.fox b/elf64.fox
--- a/elf64.fox
+++ b/elf64.fox
@@ -230,8 +230,8 @@
 		a000 buffer
 db		
 
- \ init rp
-db rp !
+: initrp	db rp ! ;
+initrp
 
 : rhere	rp @ ;
 
@@ -662,6 +662,8 @@
 			( *string -- )
 : write-obj	arrange write-all ;
 
+: resetdb	( initrp 0 strtab-idx ! 0 lsymtab-idx !  ) ;
+
 : start-app	vhere .datav !  here .textv ! ;
 : end-app	vhere .data-endv !  here .text-endv ! ;
 
diff --git a/mandelbrot-mt.fox b/mandelbrot-mt.fox
--- a/mandelbrot-mt.fox
+++ b/mandelbrot-mt.fox
@@ -61,7 +61,7 @@
   0   0   0 c,	\ black
 hex
 
-		\ choose color for iteration n
+		\ choose color for iteration count n
 		( n -- addr )
 : color	# max-iter cmpeaxi, #
 		0if
@@ -77,11 +77,13 @@
 0 var y1
 0 var delta
 
-			\ calculate delta, a step in x- or y-direction, represented by one pixel
+			\ calculate delta, a step in x- or y-direction, represented 
+			\ by one pixel
 : setdelta	() x2 @ x1 @ - cols @ / delta ! ;
 
 			\ adjust x2 and x1, according to delta
-			\ take center of x-axis, and go x/2 to the left and right using delta
+			\ take center of x-axis, and go x/2 to the left and right 
+			\ using delta
 : xc 		() x2 @ x1 @ + 2 / ;
 : adjustx	() xc cols @ 2 / delta @ *
 				over over + x2 !  - x1 ! ;
@@ -99,9 +101,8 @@
 			( number -- )
 : nwrite	a itoa swrite ;
 
-( do not remove the trailing space after the first '"' - '"' is a word
-  and needs this trailing space! )
-
+\ do not remove the trailing space after the first '"' - '"' is a word
+\ and needs this trailing space!
 " 
 " string nl
 : writenl	() nl swrite ;
@@ -120,8 +121,8 @@
 
 		\ branch if signed, non consuming
 		( -- branch-addr )
-m: +if	78 ,1				( js )
-		here 0 ,1 ;			( push branch address and leave space )
+: +if	78 ,1				\ js
+		here 0 ,1 ;			\ push branch address and leave space
 
 r8 const x0		: x0! r8! ;
 r9 const y0		: y0! r9! ;
@@ -138,21 +139,21 @@
 
 : plot	( y0 x0 -- )
 	x0! y0!						\ start with z = x0 + iy0
-	0 \ make room for rax used below
+	0 							\ make room for rax used below
 	# x x0 mov, y y0 mov,
 	ecx max-iter movi, 			\ counter
-	# begin #
+	begin
 		rax x mov,   sq   x^2 rax mov,
 		rax y mov,   sq   y^2 rax mov,
 		\ x^2 + y^2 < boundary?
 		\ rax has y^2
 		rax x^2 add,
-		rax boundary cmp, #
+		rax boundary cmp,
 		+if
-			drop rcx@ color	color, ;;
+			# drop rcx@ color color, ;; #
 		then
 		\ y = 2xy + y0
-		# rax y mov,
+		rax y mov,
 		x imulrax,
 		scalef 1- rax rdx shrd,	 \ unscale, -1 because 2*xy
 		y rax mov,
@@ -161,9 +162,9 @@
 		x x^2 mov,
 		x y^2 sub, 
 		x x0 add,
-		ecx dec, # 	\ counter--
+		ecx dec, 	\ counter--
 	until
-	drop black color, ;
+	# drop black color, ;
 
 			\ next x- or y value
 			( x -- x )
@@ -204,8 +205,8 @@
 		( task -- )
 : set-iptr	rt img-cols *  image @ +  rdi! ;
 
-		( task -- )
-: render-block
+		
+: render-block	( task -- )
 	dup set-iptr
 	yt dup dy + swap
 	begin =?  for
@@ -219,11 +220,11 @@
 		down 0=? -if drop bye ;; then render-block
 	loop ;	
 
-: image-size	img-cols rows @ * ;
+: image-size	( -- n ) img-cols rows @ * ;
 
-: alloc-space	() image-size malloc dup throw  image ! ;
+: alloc-image	() image-size malloc dup throw  image ! ;
 
-: setup 		() setdelta adjustx adjusty alloc-space 
+: setup 		() setdelta adjustx adjusty alloc-image 
 					\ boundary for calculation, is fixed
 					# boundary 4 scale movi, #  ;
 
diff --git a/playground.asm b/playground.asm
--- a/playground.asm
+++ b/playground.asm
@@ -125,6 +125,8 @@
 
 lea rax, [c]
 lea eax, [c]
+mov rax, [c]
+mov rax, 0
 mov rax, c
 mov eax, c
 
diff --git a/system.fox b/system.fox
--- a/system.fox
+++ b/system.fox
@@ -39,7 +39,8 @@
 : ,2	2 cp (,) ;
 : ,3	3 cp (,) ;
 : ,4	4 cp (,) ;
-: ,		8 cp (,) ;
+: ,	#
+: ,8	8 cp (,) ;
 
 			( append rex.w prefix )
 : rex.w,	() 48 ,1 ;
@@ -199,11 +200,13 @@
 
 			( branch-addr -- )
 			( max offset == 0x7f! )
+: then #			
 m: then		here over 1+ - 
 			( branch-addr offset )
 			dup !forw swap !1 ;
 
 			( -- cp )
+: begin #
 m: begin	here ;
 
 			( print "\nback!\n" )
@@ -224,6 +227,7 @@
 
 			( until, begin...until )
 			( begin -- )
+: until #			
 m: until	75 ( jnz ) ,1 back! ;
 
 			( begin -- begin cp  )
@@ -417,4 +421,3 @@
 : start-with word drop ;
 : write-obj drop ;
 
-