X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=rrqforth.asm;h=894e4b440bcb5e2d890020dd87a2577e7890aa9d;hb=036306101f72c2f8033c4422abcb1436f0bde97e;hp=f7f310af30754fd9f506a5ee51c1dc6f7b069853;hpb=bf67023324b2a0c5723dd3167ef757209ba62e01;p=rrq%2Frrqforth.git diff --git a/rrqforth.asm b/rrqforth.asm index f7f310a..894e4b4 100644 --- a/rrqforth.asm +++ b/rrqforth.asm @@ -73,7 +73,7 @@ dostring: pushpname rax next - WORD p_calltrace,'calltrace',dovalue + WORD p_calltrace,'[calltrace]',dovalue ;; Common call point for debugging ;; rax = cfa of called word ;; rsi = cell* of next forth word @@ -106,6 +106,8 @@ DS_TOP: ; The initial rsp ;segment readable executable +include 'signals.asm' + ;;; At fasm compilation: reset previous_word to make a new word list ;;; Words above belong to the SYSTEM wordlist, and the following ;;; belong to the FORTH wordlist. @@ -159,10 +161,11 @@ include 'stack.asm' include 'math.asm' include 'logic.asm' include 'stdio.asm' +include 'temp.asm' include 'compile.asm' WORD p_program_version,'PROGRAM_VERSION',dostring - STRING 'RRQ Forth version 0.1 - 2021-05-22',10 + STRING 'RRQ Forth version 0.1 - 2021-06-05',10 WORD p_stdin,'STDIN',dovalue ;; Initialised to hold a STREAM for fd 0 @@ -179,7 +182,7 @@ include 'compile.asm' WORD p_lparen,'(',fasm,IMMEDIATE pushr rsi p_lparen_loop: - DOFORTH p_stdin, p_read_word + DOFORTH p_input, p_get, p_read_word pop rax pop rbx cmp rax,0 ; end of stream @@ -187,7 +190,7 @@ p_lparen_loop: cmp rax,1 jne p_lparen_loop push rbx - push qword ')' + push p_lparen_rparen push 1 DOFORTH p_strncmp pop rax @@ -196,7 +199,8 @@ p_lparen_loop: p_lparen_exit: popr rsi next - +p_lparen_rparen: db ')',0 + ;;; ******** The main entry point. ******** ;;; This could be set up as a WORD but it isn't @@ -204,6 +208,8 @@ main: ;; Initial rsp points to the arguments block of size (64 bits) ;; followed by the argument pointers. mov qword [p_args_DFA],rsp + mov rbp,RS_TOP + call p_setup_signals_DFA call main_is_verbose mov qword [p_verboseQ_DFA],rdx jmp p_quit_DFA ; QUIT @@ -212,13 +218,11 @@ main: ;; return boolean in rdx ;; implementation for that 2 byte asciiz string main_is_verbose_data: - dq main_is_verbose_data_end - $ ; length of data db '-v',0 -main_is_verbose_data_end: main_is_verbose: mov rbx,qword [p_args_DFA] ; Pointer to main arguments - mov r8,qword [rbx] + mov r8,qword [rbx] ; r8 = count of pointers xor rdx,rdx cld main_is_verbose_next: @@ -227,22 +231,52 @@ main_is_verbose_next: add rbx,8 mov rsi,qword [rbx] mov rdi,main_is_verbose_data - lodsq - mov rcx,rax main_is_verbose_loop: cmpsb jne main_is_verbose_next - dec rcx - jg main_is_verbose_loop + cmp byte[rsi-1],0 + jne main_is_verbose_loop not rdx main_is_not_verbose: ret + WORD p_process_args_var,'PROCESS-ARGS-VAR',dovariable + ;; ( -- a ) + ;; Two cells for iterating and load the main args +p_process_args_ptr: dq 0 +p_process_args_end: dq 0 + + WORD p_process_args,'PROCESS-ARGS',fasm + pushr rsi + mov rax,qword [p_args_DFA] ; args* + mov rbx,qword [rax] ; count + shl rbx,3 + add rax,8 + add rbx,rax ; end + mov qword [p_process_args_end],rbx + add rax,8 + mov qword [p_process_args_ptr],rax +p_process_args_loop: + mov rax,qword [p_process_args_ptr] + cmp rax,qword [p_process_args_end] + jge p_process_args_done + add qword [p_process_args_ptr],8 + mov rax,qword [rax] + mov bl,[rax] + cmp bl,'-' + je p_process_args_loop + push rax + push rax + DOFORTH p_strlen, p_load_file, p_drop + jmp p_process_args_loop +p_process_args_done: + popr rsi + next + ;;; This word is also the last word before syscalls last_forth_word: WORD p_quit,'QUIT',fasm ;; QUIT is the program entry point ******************** - mov rsp,DS_TOP mov rbp,RS_TOP cmp qword [p_stdin_DFA],0 @@ -252,9 +286,10 @@ last_forth_word: push 10000 DOFORTH p_stream pop qword [p_stdin_DFA] ; Assign STDIN + DOFORTH p_process_args p_quit_INITIALIZED: - ;; Initial blurb + ;; Setup INPUT from STDIN FORTH dq p_verboseQ dq p_get @@ -262,8 +297,7 @@ p_quit_INITIALIZED: dq p_program_version dq p_tell p_quit_EVAL: - dq p_stdin - dq p_evaluate_stream + dq p_stdin, p_evaluate_stream BRANCH 0,p_quit_ERROR dq p_false dq sys_exit @@ -279,7 +313,7 @@ p_quit_ERROR: dq p_tell ENDFORTH mov rbp,RS_TOP ; reset the return stack - jmp main + jmp p_quit_INITIALIZED ;;; ========================================