X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=rrqforth.asm;h=18009d41bfba8f75f5b7afef2463f89988bf10e6;hb=83a89e9e9793e18d26f9d8e67ab6385d31256346;hp=db4fe33e1b3df0e3ca777aae77a69fa0c905a97f;hpb=804451765cdb9caf8f75c1fe9a4c0ab01fa244a8;p=rrq%2Frrqforth.git diff --git a/rrqforth.asm b/rrqforth.asm index db4fe33..18009d4 100644 --- a/rrqforth.asm +++ b/rrqforth.asm @@ -7,53 +7,118 @@ include 'machine.asm' ;;; ============================================================ segment readable writable executable - -;;; This is the very first word - ;; FORTH is the last word of WORDLIST FORTH - WORD p_forth,'FORTH',dovalue - ;; ( -- ) - ;; Change to use this wordlist - dq last_forth_word - dq inline_code - mov rax,qword [p_forth_DFA] - mov qword [p_wordlist],rax - popr rsi +;;; ======================================== +;;; These are the core "execution semantics" words, which are placed +;;; first so as to remain at the same binary address at successive +;;; compilations, which is helful for declaring special debugging gdb +;;; aliases. +;;; +;;; The DO* words are declared as "variables" to provide their +;;; assembled address when used in FORTH. +;;; +;;; The register context at entry to an "execution semantcs" code +;;; snippets is: +;;; rax = cfa* of word to execute +;;; rsi = cell* in the calling definition, after calling cell +;;; rsp = data stack pointer +;;; rbp = return stack pointer +;;; + +previous_word = 0 ; Used for chaining the words + + WORD p_dofasm,'doFASM',dovariable + ;; Execution semantics for assembly words. +dofasm: + add rax,8 + jmp rax + + WORD p_doforth,'doFORTH',dovariable ; + ;; Execution semantics for FORTH defition word. +doforth: + pushr rsi + lea rsi, [rax+8] ; rsi = the DFA of the rax word next - WORD p_syscall,'SYSCALL',dodoes,,,8 - ;; ( -- ) - ;; Change to use this wordlist - dq last_syscall_word - dq inline_code - mov rax,qword [p_syscall_DFA] - mov qword [p_wordlist],rax - popr rsi + WORD p_dodoes,'doDOES',dovariable + ;; Execution semantics for DOES> + ;; [cfa-8] holds the adjustment offset ("does offset") +dodoes: + 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 -last_wordlists_word: - WORD p_wordlists,'WORDLISTS',dodoes,,,8 - ;; ( -- ) - ;; Change to use this wordlist - dq p_wordlists_TFA - dq inline_code - mov rax,qword [p_wordlists_DFA] - mov qword [p_wordlist],rax - popr rsi + WORD p_dovariable,'doVARIABLE',dovariable + ;; Execution semantics for a variable ( -- addr ) + ;; rax points to CFA field +dovariable: + lea rax, [rax+8] ; rsi = the DFA of the rax word + push rax next + + WORD p_dovalue,'doVALUE',dovariable + ;; Execution semantics for a value constant ( -- v ) + ;; rax points to CFA field +dovalue: + lea rax, [rax+8] ; rsi = the DFA of the rax word + push qword [rax] + next + + WORD p_dostring,'doSTRING',dovariable + ;; Execution semantics for a string constant ( -- addr n ) + ;; rax points to CFA field +dostring: + lea rax, [rax+8] ; rsi = the DFA of the rax word + 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' + +;;; ======================================== +;;; The stacks are placed here. -include 'wordlists.asm' + ;segment readable writable - WORD return_stack,'RS',dovariable + WORD return_stack,'RETURN-STACK',dovariable ;; The return stack + BLOCK RS_TOP rb 1048576 ; 1 Mb return stack RS_TOP: ; The initial rbp - WORD data_stack,'DS',dovariable +last_system_word: + WORD data_stack,'DATA-STACK',dovariable ;; The data stack + BLOCK DS_TOP rb 1048576 ; 1 Mb data stack DS_TOP: ; The initial rsp + +;;; ======================================== +;;; Core execution control words + + ;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. +previous_word = 0 + + 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 ;; ( -- ) ;; This transitions execution into inline assembler in the @@ -63,13 +128,17 @@ DS_TOP: ; The initial rsp 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 + 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. @@ -79,94 +148,143 @@ exit: ;; TERMINATE0 terminates the program with code 0 ;; ( -- ) - WORD terminate, 'TERMINATE0',fasm + WORD p_terminate, 'TERMINATE0',fasm pop rdx 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 - -;;; Execution semantics for a "fasm" WORD -dofasm: - add rax,8 - jmp rax -;;; Execution semantics for FORTH defition word -;;; At entry, rsi points into the calling definition, at the cell -;;; following the cell indicating this word, rax points to the CFA of -;;; this word. -doforth: - pushr rsi - lea rsi, [rax+8] ; rsi = the DFA of the rax word - next - -;;; Execution semantics for DOES> -;;; The cell at [cfa-8] holds an adjustment offset. -dodoes: - pushr rsi - lea rsi, [rax+8] ; rsi = the DFA of the rax word - add rsi,[rax-8] ; adjust rsi to the DOES> part - next - - ;; Execution semantics for a variable ( -- addr ) - ;; rax points to CFA field -dovariable: - add rax,8 - push rax - next - - ;; Execution semantics for a constant ( -- v ) - ;; rax points to CFA field -dovalue: - push qword [rax+8] - next - - ;; Execution semantics for a string constant ( -- addr n ) - ;; rax points to CFA field -dostring: - cfa2dfa rax - pushpname rax - next +;;; ======================================== +;;; Core extension(s) + ;segment readable writable executable + +include 'control.asm' +include 'wordlists.asm' include 'memory.asm' 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-13',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 -;;; 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_input, p_get, 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 p_lparen_rparen + push 1 + DOFORTH p_strncmp + pop rax + cmp rax,0 + jne 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 ******************** -main: mov rsp,DS_TOP mov rbp,RS_TOP cmp qword [p_stdin_DFA],0 @@ -176,42 +294,35 @@ main: 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_clear_stream - 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 - ;; At fasm compilation: reset to make a new word list - previous_word = last_wordlists_word - -include 'syscalls.asm' +;;; ======================================== - -last_word: + ;segment readable writable heap_start: rb 1048576 ; +1 Mb heap rb 1048576 ; +1 Mb heap rb 1048576 ; +1 Mb heap + rb 1048576 ; +1 Mb heap + rb 1048576 ; +1 Mb heap