X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=rrqforth.asm;h=18009d41bfba8f75f5b7afef2463f89988bf10e6;hb=83a89e9e9793e18d26f9d8e67ab6385d31256346;hp=5d360306df30648ac9d94d9d5a9618dd5b85a096;hpb=d5a8f559318ac57934871a48e964bac18557b601;p=rrq%2Frrqforth.git diff --git a/rrqforth.asm b/rrqforth.asm index 5d36030..18009d4 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. @@ -131,7 +133,12 @@ previous_word = 0 pop rax jmp qword [rax] ; goto code of that FORTH word (64 bit jump) - WORD p_exit, 'EXIT',fasm + WORD p_sysexit, 'EXIT', + ;; ( v -- ) + ;; Terminate RRQFORTH with error code + dq sys_exit + + WORD p_return, 'RETURN',fasm ;; ( -- ) ( R: addr -- ) ;; Returns execution to the calling definition as per the ;; return stack. @@ -159,23 +166,28 @@ 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 dq 0 - WORD p_args,'ARGS',dostring + WORD p_args,'MAIN-ARGS',dovalue ;; Pointer to initial argument block dq 0 ; *(int argc,(char*[argc]) argv) + WORD p_verboseQ,'VERBOSE?',dovariable + ;; Flags whether the running is in verbose mode ot not + dq 0 ; + 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 @@ -183,7 +195,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 @@ -192,19 +204,87 @@ 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 + 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 + ;; Subroutine to check the command line for a "-v" + ;; return boolean in rdx + ;; implementation for that 2 byte asciiz string +main_is_verbose_data: + db '-v',0 + +main_is_verbose: + mov rbx,qword [p_args_DFA] ; Pointer to main arguments + mov r8,qword [rbx] ; r8 = count of pointers + xor rdx,rdx + cld +main_is_verbose_next: + dec r8 + jl main_is_not_verbose + add rbx,8 + mov rsi,qword [rbx] + mov rdi,main_is_verbose_data +main_is_verbose_loop: + cmpsb + jne main_is_verbose_next + 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 + FORTH + dq p_strlen, p_load_file + BRANCH 0, p_quit_ERROR + ENDFORTH + 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 @@ -214,30 +294,27 @@ 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_program_version - dq p_tell - dq p_stdin - dq p_evaluate_stream + dq p_verboseQ, p_get + BRANCH 0,p_quit_EVAL + dq p_program_version, p_tell +p_quit_EVAL: + dq p_stdin, p_evaluate_stream BRANCH 0,p_quit_ERROR - dq p_false - dq sys_exit + dq p_false, sys_exit p_quit_ERROR: dq p_literal_string STRING 10,'*** Unknown word: ' dq p_tell - dq p_this_word - dq p_2get - dq p_tell - dq p_literal_string - STRING 10 - dq p_tell + dq p_this_word, p_2get, p_tell + dq p_nl, p_emit ENDFORTH mov rbp,RS_TOP ; reset the return stack - jmp main + jmp p_quit_INITIALIZED ;;; ========================================