;; Top-level (REPL) environment
repl_env:resq 1
-
+
section .data
;; ------------------------------------------
;; Symbols used for comparison
- ; Special symbols
static_symbol def_symbol, 'def!'
static_symbol let_symbol, 'let*'
static_symbol do_symbol, 'do'
static_symbol splice_unquote_symbol, 'splice-unquote'
static_symbol concat_symbol, 'concat'
static_symbol cons_symbol, 'cons'
- ;
;; Startup string. This is evaluated on startup
- static mal_startup_string, db "(do (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str ",34,"(do",34," (slurp f) ",34,")",34," ))))) (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ",34,"odd number of forms to cond",34,")) (cons 'cond (rest (rest xs))))))) (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs)))))))) )"
+ static mal_startup_string, db "(do \
+(def! not (fn* (a) (if a false true))) \
+(def! load-file (fn* (f) (eval (read-string (str ",34,"(do",34," (slurp f) ",34,")",34," ))))) \
+(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ",34,"odd number of forms to cond",34,")) (cons 'cond (rest (rest xs))))))) \
+(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs)))))))) \
+)"
;; Command to run, appending the name of the script to run
static run_script_string, db "(load-file ",34
; Check type
mov al, BYTE [rsi]
cmp al, maltype_empty_list
- je .return_nil
+ je .empty_list ; empty list, return unchanged
and al, container_mask
cmp al, container_list
; the first element is a symbol
mov al, BYTE [rsi]
+ ; Check type
+ mov al, BYTE [rsi]
+ cmp al, maltype_empty_list
+ je .empty_list ; empty list, return unchanged
+
mov ah, al
and ah, container_mask
cmp ah, container_list
.quasiquote_pointer:
; RSI contains a pointer, so get the object pointed to
mov rsi, [rsi + Cons.car]
-
- ; Uncomment these two lines to test quasiquote
- ;call quasiquote
- ;ret
push r15 ; Environment
; Original AST already on stack
call macroexpand ; May release and replace RSI
mov rax, rsi
- jmp .return ; Releases original AST
+ jmp .return ; Releases original AST
; -----------------------------
; Check second arg B
mov al, BYTE [rsi + Cons.typecdr]
+ ; If nil (catchless try)
+ cmp al, content_nil
+ je .catchless_try
+
cmp al, content_pointer
jne .try_missing_catch
; Now have extracted from (try* A (catch* B C))
; A in R8
; B in R10
- ; C in T9
+ ; C in R9
push R9
push R10
call error_handler_pop
mov rax, r8
jmp .return
+
+.catchless_try:
+ ;; Evaluate the form in R8
+ push r15 ; Environment
+
+ mov rsi, r15
+ call incref_object ; Env released by eval
+ mov rdi, r15 ; Env in RDI
+
+ mov rsi, r8 ; The form to evaluate (A)
+
+ call incref_object ; AST released by eval
+
+ call eval ; Result in RAX
+
+ pop r15 ; Environment
+ jmp .return
.catch:
; Jumps here on error
; Value thrown in RSI
je .list_got_args
; No arguments
- push rbx
+
+ push rbx ; Function object
+
+ mov rsi, rax ; List with function first
+ call release_object ; Can be freed now
+
+ ; Create an empty list for the arguments
call alloc_cons
mov [rax], BYTE maltype_empty_list
+
pop rbx
mov rsi, rax
jmp .list_function_call
print_str_mac eval_list_not_function
pop rsi
jmp error_throw
-
+
+.empty_list:
+ mov rax, rsi
+ jmp .return
;; Applies a user-defined function
;;
.done:
pop r15
ret
+
+;; Read and eval
+read_eval:
+ ; -------------
+ ; Read
+ call read_str
+
+ ; -------------
+ ; Eval
+ mov rsi, rax ; Form to evaluate
+ mov rdi, [repl_env] ; Environment
+
+ xchg rsi, rdi
+ call incref_object ; Environment increment refs
+ xchg rsi, rdi ; since it will be decremented by eval
+
+ jmp eval ; This releases Env and Form/AST
+
;; Read-Eval-Print in sequence
;;
; -------------
; Print
-
- ; Put into pr_str
- mov rsi, rax
- mov rdi, 1 ; print_readably
- call pr_str
- push rax ; Save output string
-
- mov rsi, rax ; Put into input of print_string
- call print_string
- ; Release string from pr_str
- pop rsi
- call release_array
+ mov rsi, rax ; Output of eval into input of print
+ mov rdi, 1 ; print readably
+ call pr_str ; String in RAX
- ; Release result of eval
- pop rsi
+ mov r8, rax ; Save output
+
+ pop rsi ; Result from eval
call release_object
-
- ; The AST from read_str is released by eval
+ mov rax, r8
ret
cmp DWORD [rax+Array.length], 0
je .mainLoopEnd
- push rax ; Save address of the input string
-
- ; Put into read_str
+ push rax ; Save address of the string
+
mov rsi, rax
- call rep_seq
+ call rep_seq ; Read-Eval-Print
+
+ push rax ; Save returned string
+
+ mov rsi, rax ; Put into input of print_string
+ call print_string
+
+ ; Release string from rep_seq
+ pop rsi
+ call release_array
; Release the input string
pop rsi
; Check if an object was thrown
cmp rsi, 0
je .catch_done_print ; nothing to print
+
+ push rsi
+ print_str_mac error_string ; print 'Error: '
+ pop rsi
+
mov rdi, 1
call pr_str
mov rsi, rax
mov cl, ')'
call string_append_char ; closing brace
- ; Read-Eval-Print "(load-file <file>)"
- call rep_seq
+ ; Read-Eval "(load-file <file>)"
+ call read_eval
jmp quit
HCoop / jackhill / mal.git / blobdiff