X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=rrqforth.asm;h=7c1b5ca1ed314decfdfb7dbec0176ca2eecb40fb;hb=85117fe5745fabdf5e221bb7eaa65bee7ba9f751;hp=765b8fc26497555fb3c2a6373344cd0c3eaabf1f;hpb=00cfafed408853dee1e60d4a5ec7651c218134a7;p=rrq%2Frrqforth.git

diff --git a/rrqforth.asm b/rrqforth.asm
index 765b8fc..7c1b5ca 100644
--- a/rrqforth.asm
+++ b/rrqforth.asm
@@ -73,6 +73,13 @@ dostring:
 	pushpname rax
 	next
 
+	WORD p_calltrace,'calltrace',dovalue
+	;; Common call point for debugging
+	;; rax = cfa of called word
+	;; rsi = cell* of next forth word
+	;; [$rsp] = from where the call was
+	ret
+
 include 'syscalls.asm'
 
 ;;; ========================================
@@ -186,7 +193,28 @@ include 'compile.asm'
 	;; Pointer to initial argument block
 	dq 0	   ; *(int argc,(char*[argc]) argv)
 
-;;; The main entry point.
+	WORD p_lparen,'(',fasm,IMMEDIATE
+	pushr rsi
+p_lparen_loop:
+	DOFORTH  p_stdin, p_read_word
+	pop rax
+	pop rbx
+	cmp rax,0 ; end of stream
+	je p_lparen_exit
+	cmp rax,1
+	jne p_lparen_loop
+	push rbx
+	push qword ')'
+	push 1
+	DOFORTH p_strncmp
+	pop rax
+	cmp rax,0
+	jne p_lparen_loop
+p_lparen_exit:
+	popr rsi
+	next
+	
+;;; ******** The main entry point. ********
 main:	
 	;; Initial rsp points to the arguments block of size (64 bits)
 	;; followed by the argument pointers.
@@ -211,13 +239,21 @@ last_forth_word:
 p_quit_INITIALIZED:
 	;; Initial blurb
 	FORTH
-	dq p_program_version, p_tell, p_stdin, p_evaluate_stream
+	dq p_program_version
+	dq p_tell
+	dq p_stdin
+	dq p_evaluate_stream
 	BRANCH 0,p_quit_ERROR
-	dq p_false, sys_exit
+	dq p_false
+	dq sys_exit
 p_quit_ERROR:
 	dq p_literal_string
 	STRING 10,'*** Unknown word: '
-	dq p_tell, p_this_word, p_2get, p_tell, p_literal_string
+	dq p_tell
+	dq p_this_word
+	dq p_2get
+	dq p_tell
+	dq p_literal_string
 	STRING 10
 	dq p_tell
 	ENDFORTH