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
;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.
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.
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
cmp rax,1
jne p_lparen_loop
push rbx
- push qword ')'
+ push p_lparen_rparen
push 1
DOFORTH p_strncmp
pop rax
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
+ 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
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
+ BRANCH 0,p_quit_EVAL
dq p_program_version
dq p_tell
- dq p_stdin
- dq p_evaluate_stream
+p_quit_EVAL:
+ dq p_stdin, p_evaluate_stream
BRANCH 0,p_quit_ERROR
dq p_false
dq sys_exit
dq p_tell
ENDFORTH
mov rbp,RS_TOP ; reset the return stack
- jmp main
+ jmp p_quit_INITIALIZED
;;; ========================================
projects / rrq / rrqforth.git / blobdiff