X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=rrqforth.asm;h=f5d6269191cdce57edef6f335b440c0fce4c75f9;hb=0520f31ccfaa9bf44bb41db3c2a1ca9d309ec21e;hp=b6df047efaa30e720e174f2f9022ecd9233115cc;hpb=e086c1738e84f6952008d1d2efa4e36b31b061b3;p=rrq%2Frrqforth.git diff --git a/rrqforth.asm b/rrqforth.asm index b6df047..f5d6269 100644 --- a/rrqforth.asm +++ b/rrqforth.asm @@ -2,36 +2,12 @@ format elf64 executable entry main -previous_word = 0 ; Used for chaining the words - include 'machine.asm' ;;; ============================================================ - segment readable executable - -;;; This is the very first word + segment readable writable executable - ;; FORTH is the last word of WORDLIST FORTH - WORD p_forth,'FORTH',dowordlist - ;; ( -- ) - ;; Change to use this wordlist - dq last_forth_word - dq inline_code - - WORD p_system,'SYSTEM',dowordlist - ;; ( -- ) - ;; Change to use this wordlist - dq last_system_word - dq inline_code - -last_wordlists_word: - WORD p_wordlists,'WORDLISTS',dowordlist - ;; ( -- ) - ;; Change to use this wordlist - dq p_wordlists_TFA - dq inline_code - ;;; ======================================== ;;; These are the core "execution semantics" words, which are placed ;;; first so as to remain at the same binary address at successive @@ -49,6 +25,8 @@ last_wordlists_word: ;;; rbp = return stack pointer ;;; +previous_word = 0 ; Used for chaining the words + WORD p_dofasm,'doFASM',dovariable ;; Execution semantics for assembly words. dofasm: @@ -95,22 +73,19 @@ dostring: pushpname rax next - WORD p_dowordlist,'doWORDLIST',dovariable - ;; Execution semantics for DOES> - ;; [cfa-8] holds the adjustment offset ("does offset") -dowordlist: - pushr rsi - lea rsi, [rax+8] ; rsi = the DFA of the rax word - add rsi,qword [rax-8] ; adjust rsi by the "does offset' - 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' ;;; ======================================== ;;; The stacks are placed here. - segment readable writable + ;segment readable writable WORD return_stack,'RETURN-STACK',dovariable ;; The return stack @@ -125,13 +100,22 @@ last_system_word: rb 1048576 ; 1 Mb data stack DS_TOP: ; The initial rsp + ;;; ======================================== ;;; Core execution control words - segment readable executable + ;segment readable executable + +;;; 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. +previous_word = 0 -; At fasm compilation: reset previous_word to make a new word list -previous_word = last_wordlists_word + WORD p_system,'SYSTEM',dovariable + ;; ( -- dfa ) + ;; The SYSTEM word list + dq last_system_word ; tfa of last SYSTEM word + dq p_forth_DFA ; dfa of successor word list WORD inline_code,'[ASM]',fasm ;; ( -- ) @@ -142,10 +126,9 @@ previous_word = last_wordlists_word jmp qword rsi WORD p_execute,'EXECUTE',fasm - ;; ( tfa -- ) + ;; ( cfa -- ) ;; Execute the word pop rax - tfa2cfa rax jmp qword [rax] ; goto code of that FORTH word (64 bit jump) WORD p_exit, 'EXIT',fasm @@ -164,32 +147,12 @@ terminate_special: mov eax,60 syscall - WORD p_branch,'BRANCH',fasm - ;; ( -- ) - ;; Using subsequent inline cell as branch offset, branch - ;; accordingly - add rsi,qword [rsi] - add rsi,8 - next - - WORD p_zero_branch,'0BRANCH',fasm - ;; ( v -- ) - ;; Using subsequent inline cell as branch offset, branch - ;; accordingly if the stacked value is zero, otherwise just - ;; skip over the branch offset - pop rax - cmp rax,0 - jne p_zero_branch_SKIP - add rsi,qword [rsi] -p_zero_branch_SKIP: - add rsi,8 - next - ;;; ======================================== ;;; Core extension(s) - segment readable writable executable + ;segment readable writable executable +include 'control.asm' include 'wordlists.asm' include 'memory.asm' include 'stack.asm' @@ -199,18 +162,83 @@ include 'stdio.asm' include 'compile.asm' WORD p_program_version,'PROGRAM_VERSION',dostring - STRING 'RRQ Forth version 0.1 - 2021-05-13',10 + STRING 'RRQ Forth version 0.1 - 2021-05-22',10 WORD p_stdin,'STDIN',dovalue ;; Initialised to hold a STREAM for fd 0 dq 0 -;;; The main entry point. + 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 + 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. ******** +;;; 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 + 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 + ;;; This word is also the last word before syscalls last_forth_word: WORD p_quit,'QUIT',fasm ;; QUIT is the program entry point ******************** -main: + mov rsp,DS_TOP mov rbp,RS_TOP cmp qword [p_stdin_DFA],0 @@ -224,10 +252,12 @@ main: p_quit_INITIALIZED: ;; Initial blurb FORTH + dq p_verboseQ + dq p_get + BRANCH 0,p_quit_EVAL dq p_program_version dq p_tell - dq p_stdin - dq p_clear_stream +p_quit_EVAL: dq p_stdin dq p_evaluate_stream BRANCH 0,p_quit_ERROR @@ -249,7 +279,7 @@ p_quit_ERROR: ;;; ======================================== - segment readable writable + ;segment readable writable heap_start: rb 1048576 ; +1 Mb heap