X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=rrqforth.asm;h=db4fe33e1b3df0e3ca777aae77a69fa0c905a97f;hb=804451765cdb9caf8f75c1fe9a4c0ab01fa244a8;hp=f06c158bd5a9879f64f804185a7292861a307d38;hpb=f3bc3b97f37dd7bc012c152374d4185c734b3a7e;p=rrq%2Frrqforth.git diff --git a/rrqforth.asm b/rrqforth.asm index f06c158..db4fe33 100644 --- a/rrqforth.asm +++ b/rrqforth.asm @@ -2,104 +2,47 @@ format elf64 executable entry main -;;; ======================================== -;;; The pushr macro pushes x onto the return stack -;;; The popr macro pops x from the return stack -macro pushr x { - sub rbp, 8 - mov [rbp], x -} - -macro popr x { - mov x, [rbp] - add rbp, 8 -} - -;;; ======================================== -;;; The next macro "moves" execution to the next FORTH instruction, -;;; using rsi as instruction pointer. It points to the doer field of a -;;; word, which points to the assembly code that implements the -;;; execution effect of the word. That doer code is entered with rsi -;;; referring to the subsequent address in the colling word, and rax -;;; referring to the doer field of the called word. - -macro next { - lodsq ; mov rax, [rsi] + add rsi,8 - jmp qword [rax] ; goto code of that FORTH word (64 bit jump) -} +include 'machine.asm' -;;; ======================================== -;;; The FORTH macro transitions to inline FORTH execution. -macro FORTH { - local forthcode - mov rsi,forthcode - next - ;; align 8 -forthcode: -} - -;;; ======================================== -;;; The ENDFORTH macro transitions back to inline assembler after FORTH -;;; ======================================== -macro ENDFORTH { - dq inline_code -} +;;; ============================================================ -;;; ======================================== -;;; The DOFORTH lays out a single FORTH call -;;; ======================================== -macro DOFORTH label { - FORTH - dq label - ENDFORTH -} - -;;; Macro WORD starts a FORTH word definition in this code -;;; - previous_word = 0 ; Used for chaining the words - - IMMEDIATE = 1 ; optional flag - -macro WORD label, name, doer, flags { - ;; align 8 -label#_TFA: - ;; TFA - dq previous_word - previous_word = label#_TFA - ;; PFA -label#_PFA: - db flags + 0 - db label - $ - 2 - db name - db 0 - ;; align 8 - -label#_OFF: - dq 0 ; The DOES offset. Defaults to 0. - ;; also CFA = pointer to "doer" -label: - if doer eq - dq doforth - else - if doer in - dq label#_DFA - else - dq doer - end if - end if - ;; DFA -label#_DFA: -} + segment readable writable executable -;;; ============================================================ -;;; FORTH machine model -;;; rsp = data stack pointer -;;; rbp = return stack pointer -;;; rsi = instruction pointer +;;; 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 + 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 + next - segment readable writable executable +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 + next + +include 'wordlists.asm' WORD return_stack,'RS',dovariable ;; The return stack @@ -119,6 +62,54 @@ DS_TOP: ; The initial rsp ;; exit to the calling definition via "jmp exit". jmp qword rsi + WORD p_execute,'EXECUTE',fasm + ;; ( tfa -- ) + ;; Execute the word + pop rax + tfa2cfa rax + jmp qword [rax] ; goto code of that FORTH word (64 bit jump) + + WORD p_exit, 'EXIT',fasm + ;; ( -- ) ( R: addr -- ) + ;; Returns execution to the calling definition as per the + ;; return stack. +exit: + popr rsi + next + + ;; TERMINATE0 terminates the program with code 0 + ;; ( -- ) + WORD 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 @@ -128,93 +119,99 @@ doforth: lea rsi, [rax+8] ; rsi = the DFA of the rax word next - WORD p_exit, 'EXIT',fasm - ;; ( -- ) ( R: addr -- ) - ;; Returns execution to the calling definition as per the - ;; return stack. -exit: - popr rsi +;;; 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 doer field + ;; rax points to CFA field dovariable: - push rax+16 + add rax,8 + push rax next ;; Execution semantics for a constant ( -- v ) - ;; rax points to doer field + ;; rax points to CFA field dovalue: - push qword [rax+16] + push qword [rax+8] next ;; Execution semantics for a string constant ( -- addr n ) - ;; rax points to doer field + ;; rax points to CFA field dostring: - add rax,16 - mov bl,[rax] - mov byte [rsp],bl - push rax+1 + cfa2dfa rax + pushpname rax next -include 'wordlists.fasm' -include 'syscalls.fasm' -include 'memory.fasm' -include 'stack.fasm' -include 'math.fasm' -include 'stdio.fasm' +include 'memory.asm' +include 'stack.asm' +include 'math.asm' +include 'logic.asm' +include 'stdio.asm' +include 'compile.asm' WORD p_program_version,'PROGRAM_VERSION',dostring - db length -program_version_string: - db 'RRQ Forth version 0.1 - 2021-05-13',10 - length = $ - program_version_string + STRING 'RRQ Forth version 0.1 - 2021-05-13',10 WORD p_stdin,'STDIN',dovalue ;; Initialised to hold a STREAM for fd 0 dq 0 - + +;;; The main entry point. +;;; 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 - ;; Initialize STREAM STDIN + cmp qword [p_stdin_DFA],0 + jne p_quit_INITIALIZED + ;; Initialize STDIN push 0 push 10000 DOFORTH p_stream - pop qword [p_stdin_DFA] + pop qword [p_stdin_DFA] ; Assign STDIN - ;; read a word - push qword 1 ; ( fd ) =stdout - push qword [p_stdin_DFA] +p_quit_INITIALIZED: + ;; Initial blurb FORTH - dq p_read_word ; ( fd s n ) - dq sys_write + dq p_program_version + dq p_tell + dq p_stdin + dq p_clear_stream + dq p_stdin + dq p_evaluate_stream + BRANCH 0,p_quit_ERROR + dq p_false + dq 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 ENDFORTH + mov rbp,RS_TOP ; reset the return stack + jmp main - push qword 1 ; stdout - push qword program_version_string ; address of string - push qword length ; length of string (cheating) - DOFORTH sys_write ; printout - pop rax ; ignore errors - - push 0 - DOFORTH sys_exit + ;; At fasm compilation: reset to make a new word list + previous_word = last_wordlists_word - ;; TERMINATE0 terminates the program with code 0 - ;; ( v -- ) - WORD terminate, 'TERMINATE',fasm - pop rdx -terminate_special: - mov eax,60 - syscall +include 'syscalls.asm' + last_word: - ;; FORTH is the last word of VOCABULARY FORTH - WORD forth,'FORTH',dovalue - dq forth_TFA - dq 0 - heap_start: + rb 1048576 ; +1 Mb heap + rb 1048576 ; +1 Mb heap + rb 1048576 ; +1 Mb heap