stepA_mal.asm

;; 
;; nasm -felf64 stepA_mal.asm && ld stepA_mal.o && ./a.out
;;
;; Calling convention: Address of input is in RSI
;;                     Address of return value is in RAX
;;
        
global  _start
        
%include "types.asm"            ; Data types, memory
%include "env.asm"              ; Environment type
%include "system.asm"           ; System calls
%include "reader.asm"           ; String -> Data structures
%include "core.asm"             ; Core functions
%include "printer.asm"          ; Data structures -> String
        
section .bss
        
;; Top-level (REPL) environment
repl_env:resq 1

;; Error handler list
error_handler: resq 1
        
section .data

;; ------------------------------------------
;; Fixed strings for printing
        
        static prompt_string, db 10,"user> "      ; The string to print at the prompt

        static error_string, db 27,'[31m',"Error",27,'[0m',": "

        static not_found_string, db " not found"

        static def_missing_arg_string, db "missing argument to def!",10

        static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10

        static defmacro_expecting_function_string, db "defmacro expects function",10
        
        static let_missing_bindings_string, db "let* missing bindings",10

        static let_bindings_list_string, db "let* expected a list or vector of bindings",10

        static let_bind_symbol_string, db "let* expected a symbol in bindings list",10

        static let_bind_value_string, db "let* missing value in bindings list",10

        static let_missing_body_string, db "let* missing body",10
        static eval_list_not_function, db "list does not begin with a function",10

        static if_missing_condition_string, db "missing condition in if expression",10

        static try_missing_catch, db "try* missing catch*"
        static catch_missing_symbol, db "catch* missing symbol"
        static catch_missing_form, db "catch* missing form"
        
;; Symbols used for comparison

        ; Special symbols
        static_symbol def_symbol, 'def!'
        static_symbol let_symbol, 'let*'
        static_symbol do_symbol, 'do'
        static_symbol if_symbol, 'if'
        static_symbol fn_symbol, 'fn*'
        static_symbol defmacro_symbol, 'defmacro!'
        static_symbol macroexpand_symbol, 'macroexpand'
        static_symbol try_symbol, 'try*'
        static_symbol catch_symbol, 'catch*'
        
        static_symbol argv_symbol, '*ARGV*'

        static_symbol quote_symbol, 'quote'
        static_symbol quasiquote_symbol, 'quasiquote'
        static_symbol unquote_symbol, 'unquote'
        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)))))))   (def! *gensym-counter* (atom 0))   (def! gensym (fn* [] (symbol (str ",34,"G__",34," (swap! *gensym-counter* (fn* [x] (+ 1 x))))))) (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))   (def! *host-language* ",34,"nasm",34,") (def! conj nil) )"

;; Command to run, appending the name of the script to run
        static run_script_string, db "(load-file ",34

;; Command to run at start of REPL
        static mal_startup_header, db "(println (str ",34,"Mal [",34," *host-language* ",34,"]",34,"))"
section .text

;; ----------------------------------------------
;; 
;; Error handling
;;
;; A handler consists of:
;;  - A stack pointer address to reset to
;;  - An address to jump to
;;  - An optional data structure to pass
;;
;; When jumped to, an error handler will be given:
;;   - the object thrown in RSI
;;   - the optional data structure in RDI
;; 
        

;; Add an error handler to the front of the list
;;
;; Input: RSI - Stack pointer
;;        RDI - Address to jump to
;;        RCX - Data structure. Set to zero for none.
;;            If not zero, reference count incremented
;;
;; Modifies registers:
;;    RAX
;;    RBX
error_handler_push:
        call alloc_cons
        ; car will point to a list (stack, addr, data)
        ; cdr will point to the previous handler
        mov [rax], BYTE (block_cons + container_list + content_pointer)
        mov rbx, [error_handler]
        cmp rbx, 0              ; Check if previous handler was zero
        je .create_handler      ; Zero, so leave null
        ; Not zero, so create pointer to it
        mov [rax + Cons.typecdr], BYTE content_pointer
        mov [rax + Cons.cdr], rbx

        ; note: not incrementing reference count, since
        ; we're replacing one reference with another
.create_handler:
        mov [error_handler], rax ; new error handler
        
        mov rdx, rax
        call alloc_cons
        mov [rdx + Cons.car], rax
        ; Store stack pointer
        mov [rax], BYTE (block_cons + container_list + content_function)
        mov [rax + Cons.car], rsi ; stack pointer
        
        mov rdx, rax
        call alloc_cons
        mov [rdx + Cons.typecdr], BYTE content_pointer
        mov [rdx + Cons.cdr], rax
        ; Store function pointer to jump to
        ; Note: This can't use content_pointer or release
        ; will try to release this memory address
        mov [rax], BYTE (block_cons + container_list + content_function)
        mov [rax + Cons.car], rdi

        ; Check if there is an object to pass to handler
        cmp rcx, 0
        je .done

        ; Set the final CDR to point to the object
        mov [rax + Cons.typecdr], BYTE content_pointer
        mov [rax + Cons.cdr], rcx

        mov rsi, rcx
        call incref_object
        
.done:
        ret
        
        
;; Removes an error handler from the list
;;
;; Modifies registers:
;;    RSI
;;    RAX
;;    RCX
error_handler_pop:
        ; get the address
        mov rsi, [error_handler]
        cmp rsi, 0
        je .done                ; Nothing to remove
        
        push rsi
        mov rsi, [rsi + Cons.cdr] ; next handler
        mov [error_handler], rsi
        ;call incref_object        ; needed because releasing soon
        
        pop rsi                 ; handler being removed
        mov [rsi + Cons.typecdr], BYTE 0
        call release_cons
        
.done:
        ret
        
        
;; Throw an error
;;   Object to pass to handler should be in RSI
error_throw:
        ; Get the next error handler
        mov rax, [error_handler]
        cmp rax, 0
        je .no_handler
        
        ; Got a handler
        mov rax, [rax + Cons.car] ; handler
        mov rbx, [rax + Cons.car] ; stack pointer
        mov rax, [rax + Cons.cdr]
        mov rcx, [rax + Cons.car] ; function
        mov rdi, [rax + Cons.cdr] ; data structure

        ; Reset stack
        mov rsp, rbx

        ; Jump to the handler
        jmp rcx
        
.no_handler:
        ; Print the object in RSI then quit
        cmp rsi, 0
        je .done                ; nothing to print
        mov rdi, 1              ; print_readably
        call pr_str
        mov rsi, rax
        call print_string
.done:
        jmp quit_error
        
;; ----------------------------------------------
;; Evaluates a form
;;
;; Inputs: RSI   Form to evaluate
;;         RDI   Environment
;; 
eval_ast:
        mov r15, rdi             ; Save Env in r15
        
        ; Check the type
        mov al, BYTE [rsi]

        ; Check if this is a list
        mov ah, al
        and ah, container_mask
        cmp ah, container_list
        je .list
        
        cmp ah, container_map
        je .map
        
        cmp ah, container_vector
        je .vector
        
        ; Not a list, map or vector
        cmp ah, container_symbol
        je .symbol
        
        ; Not a symbol, list, map or vector
        call incref_object      ; Increment reference count
        
        mov rax, rsi
        ret
        
.symbol:
        ; Check if first character of symbol is ':'
        mov al, BYTE [rsi + Array.data]
        cmp al, ':'
        je .keyword
        
        ; look in environment
        push rsi
        xchg rsi, rdi
        ; symbol is the key in rdi
        ; Environment in rsi
        call env_get
        pop rsi
        je .done                ; result in RAX
        
        ; Not found, throw an error
        mov r11, rsi        ; Symbol in R11
        
        call string_new
        mov rsi, rax            ; New string in RSI

        mov cl, 39              ; quote '
        call string_append_char

        mov rdx, r11            ; symbol
        call string_append_string

        mov cl, 39
        call string_append_char

        mov r11, rsi

        mov rsi, not_found_string
        mov edx, not_found_string.len
        call raw_to_string ; ' not found'

        mov r12, rax
        
        mov rdx, rax
        mov rsi, r11
        call string_append_string

        mov r11, rsi
        mov rsi, r12
        call release_array
        mov rsi, r11
        
        jmp error_throw
        
        ; ------------------------------
        
.keyword:
        ; Just return keywords unaltered
        call incref_object
        mov rax, rsi
        ret
        
        ; ------------------------------
.list:
        ; Evaluate each element of the list
        ;        
        xor r8, r8              ; The list to return
        ; r9 contains head of list

.list_loop:
        mov al, BYTE [rsi]      ; Check type
        mov ah, al
        and ah, content_mask
        cmp ah, content_pointer
        je .list_pointer
        
        ; A value in RSI, so copy
        
        call alloc_cons
        mov bl, BYTE [rsi]
        and bl, content_mask
        add bl, (block_cons + container_list)
        mov [rax], BYTE bl      ; set type
        mov rbx, [rsi + Cons.car]
        mov [rax + Cons.car], rbx ; copy value

        ; Result in RAX
        jmp .list_append
        
.list_pointer:
        ; List element is a pointer to something
        push rsi
        push r8
        push r9
        push r15                  ; Env
        mov rdi, [rsi + Cons.car] ; Get the address
        mov rsi, r15

        call incref_object      ; Environment increment refs
        xchg rsi, rdi           ; Env in RDI, AST in RSI
        
        call incref_object      ; AST increment refs
        
        call eval             ; Evaluate it, result in rax
        pop r15
        pop r9
        pop r8
        pop rsi
        
        ; Check the type it's evaluated to
        mov bl, BYTE [rax]
        mov bh, bl
        and bh, (block_mask + container_mask)
        cmp bh, (block_cons + container_value)
        je .list_eval_value
        
        ; Not a value, so need a pointer to it
        push rax
        call alloc_cons
        mov [rax], BYTE (block_cons + container_list + content_pointer)
        pop rbx                 ; Address to point to
        mov [rax + Cons.car], rbx
        jmp .list_append
        
.list_eval_value:
        ; Got value in RAX, so copy
        push rax
        call alloc_cons         ; Copy in RAX
        pop rbx                 ; Value to copy in RBX
        mov cl, BYTE [rbx]
        and cl, content_mask
        or  cl, (block_cons + container_list)
        mov [rax], BYTE cl      ; set type
        mov rcx, [rbx + Cons.car]
        mov [rax + Cons.car], rcx ; copy value

        ; Release the value in RBX
        push rsi
        push rax
        mov rsi, rbx
        call release_cons
        pop rax
        pop rsi
        
        ; Fall through to .list_append
.list_append:
        ; In RAX
        
        cmp r8, 0               ; Check if this is the first
        je .list_first

        ; append to r9
        mov [r9 + Cons.cdr], rax
        mov [r9 + Cons.typecdr], BYTE content_pointer
        mov r9, rax
        jmp .list_next
        
.list_first:
        mov r8, rax
        mov r9, rax
        ; fall through to .list_next
        
.list_next:
        ; Check if there's another
        mov al, BYTE [rsi + Cons.typecdr]
        cmp al, content_pointer
        jne .list_done          ; finished list
        mov rsi, [rsi + Cons.cdr] ; next in list
        jmp .list_loop
        
.list_done:
        mov rax, r8            ; Return the list
        ret
        
        ; ---------------------
.map:
        ; Create a new map, evaluating all the values
        
        ; Check if the map is empty
        cmp al, maltype_empty_map
        jne .map_not_empty

        ; map empty. Just return it
        call incref_object
        mov rax, rsi
        ret
        
.map_not_empty:
        
        mov r10, rsi            ; input in R10
        xor r12, r12            ; New map in r12
        
        ; Now loop through each key-value pair
        ; NOTE: This method relies on the implementation
        ; of map as a list    

.map_loop:
        ; Copy the key
        call alloc_cons         ; New Cons in RAX

        mov bl, [r10 + Cons.typecar] ; Type in BL
        mov [rax + Cons.typecar], bl
        mov rcx, [r10 + Cons.car] ; Value in RCX
        mov [rax + Cons.car], rcx

        ; Check the type of the key
        and bl, content_mask
        cmp bl, content_pointer
        jne .map_got_key        ; a value

        ; a pointer, so increment reference count
        mov bx, WORD [rcx + Cons.refcount]
        inc bx
        mov [rcx + Cons.refcount], WORD bx
        
.map_got_key:
        cmp r12,0
        jne .append_key

        ; First key
        mov r12, rax
        mov r13, rax
        jmp .map_value
        
.append_key:
        ; Appending to previous value in r13
        mov [r13 + Cons.typecdr], BYTE content_pointer
        mov [r13 + Cons.cdr], rax
        mov r13, rax
        
.map_value:
        ; Check that we have a value
        mov al, BYTE [r10 + Cons.typecdr]
        cmp al, content_pointer
        jne .map_error_missing_value
        mov r10, [r10 + Cons.cdr]

        ; Now got value in r10

        ; Check the type of the value
        mov bl, [r10 + Cons.typecar] ; Type in BL
        and bl, content_mask
        cmp bl, content_pointer
        je .map_value_pointer

        ; Not a pointer, so make a copy
        call alloc_cons
        mov bl, [r10 + Cons.typecar]
        mov [rax + Cons.typecar], bl
        mov rcx, [r10 + Cons.car]
        mov [rax + Cons.car], rcx
        
        jmp .map_got_value
.map_value_pointer:
        ; A pointer, so need to evaluate
        push r10                ; Input
        push r12                ; start of result
        push r13                ; Current head of result
        push r15                ; Env
        mov rsi, [r10 + Cons.car] ; Get the address
        mov rdi, r15

        xchg rsi, rdi
        call incref_object      ; Environment increment refs
        xchg rsi, rdi

        call incref_object
        
        call eval               ; Evaluate it, result in rax
        pop r15
        pop r13
        pop r12
        pop r10
        
        ; Check the type it's evaluated to
        mov bl, BYTE [rax]
        mov bh, bl
        and bh, (block_mask + container_mask)
        cmp bh, (block_cons + container_value)
        
        jne .map_eval_pointer

        ; A value, so just change the type to a map
        and bl, content_mask
        add bl, (block_cons + container_map)
        mov [rax], BYTE bl
        jmp .map_got_value
        
.map_eval_pointer:
        ; Not a value, so need a pointer to it
        push rax
        call alloc_cons
        mov [rax], BYTE (block_cons + container_map + content_pointer)
        pop rbx                 ; Address to point to
        mov [rax + Cons.car], rbx
        
.map_got_value:
        ; Append RAX to list in R13
        mov [r13 + Cons.typecdr], BYTE content_pointer
        mov [r13 + Cons.cdr], rax
        mov r13, rax
        
        ; Check if there's another key
        mov al, BYTE [r10 + Cons.typecdr]
        cmp al, content_pointer
        jne .map_done          ; finished map
        mov r10, [r10 + Cons.cdr] ; next in map
        jmp .map_loop

.map_done:
        mov rax, r12
        ret
        
.map_error_missing_value:
        mov rax, r12
        ret
        
        ; ------------------------------
.vector:
        ; Evaluate each element of the vector
        ;        
        xor r8, r8              ; The vector to return
        ; r9 contains head of vector

.vector_loop:
        mov al, BYTE [rsi]      ; Check type
        mov ah, al
        and ah, content_mask
        cmp ah, content_pointer
        je .vector_pointer
        
        ; A value, so copy
        call alloc_cons
        mov bl, BYTE [rsi]
        and bl, content_mask
        add bl, (block_cons + container_vector)
        mov [rax], BYTE bl      ; set type
        mov rbx, [rsi + Cons.car]
        mov [rax + Cons.car], rbx ; copy value

        ; Result in RAX
        jmp .vector_append
        
.vector_pointer:
        ; Vector element is a pointer to something
        push rsi
        push r8
        push r9
        push r15                  ; Env
        mov rsi, [rsi + Cons.car] ; Get the address
        mov rdi, r15

        xchg rsi, rdi
        call incref_object      ; Environment increment refs
        xchg rsi, rdi

        call incref_object
        
        call eval             ; Evaluate it, result in rax
        pop r15
        pop r9
        pop r8
        pop rsi
        
        ; Check the type it's evaluated to
        mov bl, BYTE [rax]
        mov bh, bl
        and bh, (block_mask + container_mask)
        cmp bh, (block_cons + container_value)
        je .vector_eval_value
        
        ; Not a value, so need a pointer to it
        push rax
        call alloc_cons
        mov [rax], BYTE (block_cons + container_vector + content_pointer)
        pop rbx                 ; Address to point to
        mov [rax + Cons.car], rbx
        jmp .vector_append

.vector_eval_value:
        ; Got value in RAX, so copy
        push rax
        call alloc_cons         ; Copy in RAX
        pop rbx                 ; Value to copy in RBX
        mov cl, BYTE [rbx]
        and cl, content_mask
        or  cl, (block_cons + container_vector)
        mov [rax], BYTE cl      ; set type
        mov rcx, [rbx + Cons.car]
        mov [rax + Cons.car], rcx ; copy value

        ; Release the value in RBX
        push rsi
        push rax
        mov rsi, rbx
        call release_cons
        pop rax
        pop rsi
        
.vector_append:
        ; In RAX
        
        cmp r8, 0               ; Check if this is the first
        je .vector_first

        ; append to r9
        mov [r9 + Cons.cdr], rax
        mov [r9 + Cons.typecdr], BYTE content_pointer
        mov r9, rax
        jmp .vector_next
        
.vector_first:
        mov r8, rax
        mov r9, rax
        ; fall through to .vector_next
        
.vector_next:
        ; Check if there's another
        mov al, BYTE [rsi + Cons.typecdr]
        cmp al, content_pointer
        jne .vector_done          ; finished vector
        mov rsi, [rsi + Cons.cdr] ; next in vector
        jmp .vector_loop
        
.vector_done:
        mov rax, r8            ; Return the vector
        ret
        
        ; ---------------------
.done:
        ret


        
;; Comparison of symbols for eval function
;; Compares the symbol in RSI with specified symbol
;; Preserves RSI and RBX
;; Modifies RDI
%macro eval_cmp_symbol 1
        push rsi
        push rbx
        mov rsi, rbx
        mov rdi, %1
        call compare_char_array
        pop rbx
        pop rsi
        test rax, rax           ; ZF set if rax = 0 (equal)
%endmacro
        
;; ----------------------------------------------------
;; Evaluates a form
;;      
;; Input: RSI   AST to evaluate   [ Released ]
;;        RDI   Environment       [ Released ]
;;
;; Returns: Result in RAX
;;
;; Note: Both the form and environment will have their reference count
;; reduced by one (released). This is for tail call optimisation (Env),
;; quasiquote and macroexpand (AST)
;; 
eval:
        mov r15, rdi            ; Env

        push rsi                ; AST pushed, must be popped before return
        
        ; Check type
        mov al, BYTE [rsi]
        cmp al, maltype_empty_list
        je .return_nil

        and al, container_mask
        cmp al, container_list
        je .list
        
        ; Not a list. Evaluate and return
        call eval_ast
        jmp .return             ; Releases Env

        ; --------------------
.list:
        ; A list
        
        ; Macro expand
	pop rax ; Old AST, discard from stack
        call macroexpand        ; Replaces RSI
        push rsi ; New AST

        ; Check if RSI is a list, and if 
        ; the first element is a symbol
        mov al, BYTE [rsi]

        mov ah, al
        and ah, container_mask
        cmp ah, container_list
        je .list_still_list

        ; Not a list, so call eval_ast on it
        mov rdi, r15            ; Environment
        call eval_ast
        jmp .return

.list_still_list:
        and al, content_mask
        cmp al, content_pointer
        jne .list_eval

        mov rbx, [rsi + Cons.car]
        mov al, BYTE [rbx]
        cmp al, maltype_symbol
        jne .list_eval
        
        ; Is a symbol, address in RBX
        
        ; Compare against special form symbols
        
        eval_cmp_symbol def_symbol ; def!
        je .def_symbol
        
        eval_cmp_symbol let_symbol ; let*
        je .let_symbol

        eval_cmp_symbol do_symbol ; do
        je .do_symbol

        eval_cmp_symbol if_symbol ; if
        je .if_symbol

        eval_cmp_symbol fn_symbol ; fn
        je .fn_symbol

        eval_cmp_symbol quote_symbol ; quote
        je .quote_symbol

        eval_cmp_symbol quasiquote_symbol ; quasiquote
        je .quasiquote_symbol

        eval_cmp_symbol defmacro_symbol ; defmacro!
        je .defmacro_symbol

        eval_cmp_symbol macroexpand_symbol ; macroexpand
        je .macroexpand_symbol

        eval_cmp_symbol try_symbol ; try*
        je .try_symbol
        
        ; Unrecognised
        jmp .list_eval

              
        ; -----------------------------
        
.defmacro_symbol:
        mov r9, 1
        jmp .def_common
.def_symbol:
        xor r9, r9        ; Set R9 to 0
.def_common:
        ; Define a new symbol in current environment
        ; If R9 is set to 1 then defmacro
        
        ; Next item should be a symbol
        mov al, BYTE [rsi + Cons.typecdr]
        cmp al, content_pointer
        jne .def_error_missing_arg
        mov rsi, [rsi + Cons.cdr]
        
        ; Now should have a symbol
        
        mov al, BYTE [rsi + Cons.typecar]
        and al, content_mask
        cmp al, content_pointer
        jne .def_error_expecting_symbol
        mov r8, [rsi + Cons.car] ; Symbol (?)

        mov al, BYTE [r8]
        cmp al, maltype_symbol
        jne .def_error_expecting_symbol

        ; R8 now contains a symbol
        
        ; expecting a value or pointer next
        mov al, BYTE [rsi + Cons.typecdr]
        cmp al, content_pointer
        jne .def_error_missing_arg
        mov rsi, [rsi + Cons.cdr]

        ; Check if this is a pointer
        mov al, BYTE [rsi]
        mov ah, al
        and ah, content_mask
        cmp ah, content_pointer
        je .def_pointer

        ; A value, so copy

        ; Test if this is defmacro!
        test r9, r9
        jnz .defmacro_not_function
        
        push rax
        call alloc_cons
        pop rbx                 ; BL now contains type
        and bl, content_mask
        add bl, (block_cons + container_value)
        mov [rax], BYTE bl
        mov rcx, [rsi + Cons.car]
        mov [rax + Cons.car], rcx
        mov rsi, rax
        
        jmp .def_got_value

.def_pointer:
        ; A pointer, so evaluate
        
        ; This may throw an error, so define a handler
        
        push r8                 ; the symbol
        push r15                ; Env
        push r9
        mov rsi, [rsi + Cons.car] ; Pointer
        mov rdi, r15

        xchg rsi, rdi
        call incref_object      ; Environment increment refs
        xchg rsi, rdi           ; since it will be decremented by eval

        call incref_object      ; AST increment refs
        
        call eval
        mov rsi, rax

        pop r9
        
        ; If this is defmacro, and the object in RSI is a function,
        ; then change to a macro
        test r9, r9
        jz .def_not_macro       ; Not defmacro
        
        ; Check RSI
        mov al, BYTE [rsi]
        cmp al, maltype_function
        jne .defmacro_not_function

        ; Got a function, change to macro
        mov [rsi], BYTE maltype_macro
        
.def_not_macro:
        
        pop r15
        pop r8
        
.def_got_value:
        ; Symbol in R8, value in RSI
        mov rdi, r8             ; key (symbol)
        mov rcx, rsi            ; Value
        mov rsi, r15            ; Environment
        call env_set

        mov rax, rcx
        jmp .return
       
.def_error_missing_arg:
        mov rsi, def_missing_arg_string
        mov rdx, def_missing_arg_string.len
        jmp .def_handle_error
        
.def_error_expecting_symbol:
        mov rsi, def_expecting_symbol_string
        mov rdx, def_expecting_symbol_string.len
        jmp .def_handle_error

.defmacro_not_function:
        mov rsi, defmacro_expecting_function_string
        mov rdx, defmacro_expecting_function_string.len
        jmp .def_handle_error
        
.def_handle_error:
        push rsi
        push rdx
        print_str_mac error_string   ; print 'Error: '
        
        pop rdx
        pop rsi
        call print_rawstring    ; print message

        xor rsi, rsi            ; no object to throw
        jmp error_throw         ; No return
        
        ; -----------------------------
.let_symbol:
        ; Create a new environment

        mov r11, rsi            ; Let form in R11
        
        mov rsi, r15            ; Outer env
        call env_new            ; Increments R15's ref count
        mov r14, rax            ; New environment in R14

        mov rsi, r15
        call release_object     ; Decrement R15 ref count
        
        ; Second element should be the bindings
        
        mov al, BYTE [r11 + Cons.typecdr]
        cmp al, content_pointer
        jne .let_error_missing_bindings
        mov r11, [r11 + Cons.cdr]
        
        mov al, BYTE [r11]
        and al, content_mask
        cmp al, content_pointer
        jne .let_error_bindings_list
        
        mov r12, [r11 + Cons.car] ; should be bindings list
        mov al, BYTE [r12]
        and al, (block_mask + container_mask)
        ; Can be either a list or vector
        cmp al, block_cons + container_list
        je .let_bind_loop
        cmp al, block_cons + container_vector
        je .let_bind_loop
        
        ; Not a list or vector
        jmp .let_error_bindings_list
        
.let_bind_loop:
        ; R12 now contains a list with an even number of items
        ; The first should be a symbol, then a value to evaluate
        
        ; Get the symbol
        mov al, BYTE [r12]
        and al, content_mask
        cmp al, content_pointer
        jne .let_error_bind_symbol

        mov r13, [r12 + Cons.car] ; Symbol (?)
        mov al, BYTE [r13]
        cmp al, maltype_symbol
        jne .let_error_bind_symbol

        ; R13 now contains a symbol to bind
        ; The next item in the bindings list (R12)
        ; should be a value or expression to evaluate

        mov al, BYTE [r12 + Cons.typecdr]
        and al, content_mask
        cmp al, content_pointer
        jne .let_error_bind_value
        mov r12, [r12 + Cons.cdr]
        
        ; got value in R12
        
        ; Check the type of the value
        mov bl, [r12 + Cons.typecar] ; Type in BL
        and bl, content_mask
        cmp bl, content_pointer
        je .let_value_pointer

        ; Not a pointer, so make a copy
        call alloc_cons
        mov bl, [r12 + Cons.typecar]
        and bl, content_mask
        ;or bl, (block_cons + container_value) ; 0
        mov [rax + Cons.typecar], bl
        mov rcx, [r12 + Cons.car]
        mov [rax + Cons.car], rcx

        jmp .let_got_value
        
.let_value_pointer:
        ; A pointer, so need to evaluate
        push r11                 ; let* form list
        push r12                 ; Position in bindings list
        push r13                 ; symbol to bind
        push r14                 ; new environment

        mov rsi, r14
        call incref_object
        mov rdi, r14
        
        mov rsi, [r12 + Cons.car] ; Get the address
        
        call incref_object      ; Increment ref count of AST
        
        call eval               ; Evaluate it, result in rax
        pop r14
        pop r13
        pop r12
        pop r11
        
.let_got_value:

        mov rsi, r14            ; Env
        mov rdi, r13            ; key
        mov rcx, rax            ; value
        call env_set

        ; Release the value
        mov rsi, rcx            ; The value
        call release_object
        
        ; Check if there are more bindings
        mov al, BYTE [r12 + Cons.typecdr]
        cmp al, content_pointer
        jne .let_done_binding
        mov r12, [r12 + Cons.cdr] ; Next
        jmp .let_bind_loop
        
.let_done_binding:
        ; Done bindings.
        ; Evaluate next item in let* form in new environment

        mov al, BYTE [r11 + Cons.typecdr]
        cmp al, content_pointer
        jne .let_error_missing_body
        mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate
        ; Check type of the value
        mov al, BYTE [r11]
        and al, block_mask + content_mask
        cmp al, content_pointer
        je .body_pointer

        ; Just a value, so copy
        call alloc_cons
        mov bl, BYTE [r11]
        and bl, content_mask
        mov [rax], BYTE bl      ; set type
        mov rbx, [r11 + Cons.car]
        mov [rax + Cons.car], rbx ; copy value
        jmp .let_done
        
.body_pointer:
        ; Evaluate using new environment
        
        mov rsi, [r11 + Cons.car] ; Object pointed to
        call incref_object        ; will be released by eval
        
        mov r11, rsi              ; save new AST
        pop rsi                   ; Old AST
        call release_object
        mov rsi, r11            ; New AST
        
        mov rdi, r14            ; New environment

        jmp eval                ; Tail call
        ; Note: eval will release the new environment on return
        
.let_done:
        ; Release the new environment
        push rax
        mov rsi, r14
        call release_object
        pop rax

        ; Release the AST
        pop rsi
        push rax
        call release_object
        pop rax
        ret                     ; already released env
        
.let_error_missing_bindings:
        mov rsi, let_missing_bindings_string
        mov rdx, let_missing_bindings_string.len
        jmp .let_handle_error
        
.let_error_bindings_list:       ; expected a list or vector, got something else
        mov rsi, let_bindings_list_string
        mov rdx, let_bindings_list_string.len
        jmp .let_handle_error
        
.let_error_bind_symbol:         ; expected a symbol, got something else
        mov rsi, let_bind_symbol_string
        mov rdx, let_bind_symbol_string.len
        jmp .let_handle_error
        
.let_error_bind_value:          ; Missing value in binding list
        mov rsi, let_bind_value_string
        mov rdx, let_bind_value_string.len
        jmp .let_handle_error
        
.let_error_missing_body:        ; Missing body to evaluate
        mov rsi, let_missing_body_string
        mov rdx, let_missing_body_string.len
        jmp .let_handle_error
        
.let_handle_error:
        push r11                ; For printing later
        
        push rsi
        push rdx
        
        print_str_mac error_string   ; print 'Error: '

        pop rdx
        pop rsi
        call print_rawstring    ; print message
        
        pop rsi                 ; let* form
        jmp error_throw         ; No return
        
        ; -----------------------------

.do_symbol:
        mov r11, rsi            ; do form in RSI
        ; Environment in R15

        ; Check if there is a body
        mov al, BYTE [r11 + Cons.typecdr]
        cmp al, content_pointer
        jne .do_no_body         ; error

        mov r11, [r11 + Cons.cdr] ; Body in R11
        
.do_symbol_loop:

        ; Need to test if this is the last form
        ; so we can handle tail call
        
        mov bl, BYTE [r11 + Cons.typecdr]
        cmp bl, content_pointer
        jne .do_body_last ; Last expression

        ; not the last expression
        
        ; Check if this is a value or pointer
        mov al, BYTE [r11]
        and al, block_mask + content_mask
        cmp al, content_pointer
        jne .do_next            ; A value, so skip
        
        ; A pointer, so evaluate
        
        push r15
        push r11
        
        mov rsi, r15
        call incref_object      ; Increase Env reference
                                ; since eval will release Env
        
        mov rsi, [r11 + Cons.car]  ; Form
        call incref_object         ; Increment ref count since eval will release
        
        mov rdi, r15            ; Env
        call eval               ; Result in RAX
        
        ; Another form after this.
        ; Discard the result of the last eval
        mov rsi, rax
        call release_object
        
        pop r11
        pop r15
        
.do_next:
        mov r11, [r11 + Cons.cdr] ; Next in list
        
        jmp .do_symbol_loop
                
.do_body_last:
        ; The last form is in R11, which will be returned
        
        ; Check if this is a value or pointer
        mov al, BYTE [r11]
        and al, block_mask + content_mask
        cmp al, content_pointer
        jne .do_body_value_return
        jmp .do_body_expr_return

.do_body_value_return:
        ; Got a value as last form (in R11).
        ; Copy and return

        push rax                ; Type of value to return

        ; release Env
        mov rsi, r15
        call release_object

        ; Allocate a Cons object to hold value
        call alloc_cons
        pop rbx                 ; type in BL
        mov [rax], BYTE bl
        mov rbx, [r11 + Cons.car]
        mov [rax + Cons.car], rbx

        ; release the AST
        pop rsi
        mov r15, rax            ; not modified by release
        call release_object
        mov rax, r15
        
        ret

.do_body_expr_return:
        ; An expression to evaluate as the last form
        ; Tail call optimise, jumping to eval
        ; Don't increment Env reference count
        
        mov rsi, [r11 + Cons.car]  ; new AST form
        call incref_object         ; This will be released by eval

        mov r11, rsi              ; Save new AST
        pop rsi                   ; Remove old AST from stack
        call release_object
        mov rsi, r11
        
        mov rdi, r15            ; Env
        jmp eval                ; Tail call
        
.do_no_body:
        ; No expressions to evaluate. Return nil

        mov rsi, r15
        call release_object     ; Release Env

        ; release the AST
        pop rsi
        call release_object
        
        call alloc_cons
        mov [rax], BYTE maltype_nil
        mov [rax + Cons.typecdr], BYTE content_nil
        ret
        
        ; -----------------------------
        
.if_symbol:
        mov r11, rsi            ; if form in R11
        ; Environment in R15

        mov al, BYTE [r11 + Cons.typecdr]
        cmp al, content_pointer
        jne .if_no_condition
        
        mov r11, [r11 + Cons.cdr] ; Should be a condition

        ; Check if value or pointer
        mov al, BYTE [r11]
        and al, content_mask
        cmp al, content_pointer
        jne .if_cond_value

        ; A pointer, so evaluate

        push r15
        push r11

        mov rsi, r15
        call incref_object      ; Increase Env reference
        
        mov rsi, [r11 + Cons.car]  ; Form
        call incref_object         ; Increase Form/AST ref count
        
        mov rdi, r15            ; Env
        call eval               ; Result in RAX
        pop r11
        pop r15

        ; Get type of result
        mov bl, BYTE [rax]

        ; release value
        push rbx
        mov rsi, rax
        call release_object
        pop rbx

        ; Check type
        cmp bl, maltype_nil
        je .if_false
        cmp bl, maltype_false
        je .if_false
        
        jmp .if_true
        
.if_cond_value:

        ; A value
        cmp al, content_nil
        je .if_false
        cmp al, content_false
        je .if_false
        
        jmp .if_true

.if_false:
        ; Skip the next item
        mov al, BYTE [r11 + Cons.typecdr]
        cmp al, content_pointer
        jne .return_nil
        
        mov r11, [r11 + Cons.cdr]
        
.if_true:
        ; Get the next item in the list and evaluate it
        mov al, BYTE [r11 + Cons.typecdr]
        cmp al, content_pointer
        jne .return_nil         ; Nothing to return

        mov r11, [r11 + Cons.cdr]
        
        ; Check if value or pointer
        mov al, BYTE [r11]
        and al, content_mask
        cmp al, content_pointer
        je .if_got_pointer
        
.if_got_value:
        ; copy value in r11
        call alloc_cons
        mov bl, BYTE [r11]
        and bl, content_mask
        mov [rax], BYTE bl
        mov rbx, [r11 + Cons.car]
        mov [rax + Cons.car], rbx

        jmp .return
        
.if_got_pointer:
        mov rsi, [r11 + Cons.car]  ; Form
        call incref_object        ; Will be released by eval

        mov r11, rsi
        pop rsi
        call release_object     ; Release old AST
        mov rsi, r11            ; New AST
        
        mov rdi, r15            ; Env
        jmp eval                ; Tail call
        
.if_no_condition:               ; just (if) without a condition
        
        print_str_mac error_string
        print_str_mac if_missing_condition_string
        
        ; Release environment
        mov rsi, r15
        call release_object
        xor rsi, rsi            ; No object to throw
        jmp error_throw

.return_nil:
        call alloc_cons
        mov [rax], BYTE maltype_nil
        mov [rax + Cons.typecdr], BYTE content_nil

.return:
        ; Release environment
        mov rsi, r15
        mov r15, rax            ; Save RAX (return value)
        call release_object

        ; Release the AST
        pop rsi                 ; Pushed at start of eval
        call release_object

        mov rax, r15            ; return value
        ret
        
        ; -----------------------------
        
.fn_symbol:
        mov r11, rsi            ; fn form in R11
        ; Environment in R15

        ; Get the binds and body of the function
        mov al, BYTE [r11 + Cons.typecdr]
        cmp al, content_pointer
        jne .fn_empty
        
        mov r11, [r11 + Cons.cdr]
        mov al, BYTE [r11]
        and al, content_mask
        cmp al, content_pointer
        jne .fn_binds_not_list
        
        mov r12, [r11 + Cons.car]  ; Should be binds list
        mov al, BYTE [r12]
        and al, (block_mask + container_mask)
        cmp al, (block_cons + container_list) 
        je .fn_got_binds        ; Can be list
        cmp al, (block_cons + container_vector)
        je .fn_got_binds        ; or vector
        jmp .fn_binds_not_list
        
.fn_got_binds:

        ; Next get the body of the function
        mov al, BYTE [r11 + Cons.typecdr]
        cmp al, content_pointer
        jne .fn_no_body

        mov r11, [r11 + Cons.cdr]
        ; Check value or pointer
        mov al, BYTE [r11]
        and al, content_mask
        cmp al, content_pointer
        jne .fn_is_value        ; Body in r11
        mov r11, [r11 + Cons.car]
        jmp .fn_got_body

.fn_is_value:
        ; Body is just a value, no expression
        mov [r11], BYTE al      ; Mark as value, not list
        
.fn_got_body:

        ; Now put into function type
        ;   Addr is "apply_fn", the address to call
        ;   Env in R15
        ;   Binds in R12
        ;   Body in R11

        call alloc_cons
        mov [rax], BYTE (block_cons + container_function + content_function)
        mov rbx, apply_fn
        mov [rax + Cons.car], rbx ; Address of apply function
        mov [rax + Cons.typecdr], BYTE content_pointer
        
        mov r13, rax            ; Return list in R13

        ; Meta

        call alloc_cons
        mov [rax], BYTE maltype_nil
        mov [rax + Cons.typecdr], BYTE content_pointer

        mov [r13 + Cons.cdr], rax ; Append
        mov r14, rax
        
        ; Env
        
        call alloc_cons
        mov [rax], BYTE (block_cons + container_function + content_pointer)
        mov [rax + Cons.car], r15 ; Environment
        mov [rax + Cons.typecdr], BYTE content_pointer
        
        mov [r14 + Cons.cdr], rax ; Append to list
        mov r14, rax
        
        push rax
        mov rsi, r15
        call incref_object
        pop rax

        ; Binds
        
        call alloc_cons
        mov [rax], BYTE (block_cons + container_function + content_pointer)
        mov [rax + Cons.car], r12 ; Binds list
        mov [rax + Cons.typecdr], BYTE content_pointer
        
        mov [r14 + Cons.cdr], rax ; Append to list
        mov r14, rax

        push rax
        mov rsi, r12
        call incref_object
        pop rax
        
        call alloc_cons
        mov [rax], BYTE (block_cons + container_function + content_pointer)
        mov [rax + Cons.car], r11 ; Body of function
        
        mov [r14 + Cons.cdr], rax

        mov rsi, r11
        call incref_object
        
        mov rax, r13
        jmp .return
        
.fn_empty:
.fn_binds_not_list:
.fn_no_body:
        
        call alloc_cons
        mov [rax], BYTE maltype_nil
        mov [rax + Cons.typecdr], BYTE content_nil
        jmp .return
        
        ; -----------------------------

.quote_symbol:
        ; Just return the arguments in rsi cdr

        mov al, BYTE [rsi + Cons.typecdr]
        cmp al, content_pointer
        jne .return_nil         ; quote empty, so return nil

        mov rsi, [rsi + Cons.cdr]

        ; Check if this is a value or pointer
        mov al, BYTE [rsi + Cons.typecar]
        and al, content_mask
        cmp al, content_pointer
        je .quote_pointer
        
        ; RSI contains a value. Remove the list container
        mov [rsi + Cons.typecar], BYTE al
        call incref_object
        mov rax, rsi
        jmp .return
        
.quote_pointer:
        ; RSI contains a pointer, so get the object pointed to
        mov rsi, [rsi + Cons.car]
        call incref_object
        mov rax, rsi
        jmp .return
        
        ; -----------------------------
        
.quasiquote_symbol:
        ; call quasiquote function with first argument
        
        mov al, BYTE [rsi + Cons.typecdr]
        cmp al, content_pointer
        jne .return_nil         ; quasiquote empty, so return nil

        mov r11, rsi            ; Save original AST in R11
        
        mov rsi, [rsi + Cons.cdr]

        ; Check if this is a value or pointer
        mov al, BYTE [rsi + Cons.typecar]
        and al, content_mask
        cmp al, content_pointer
        je .quasiquote_pointer
        
        ; RSI contains a value. Remove the list container
        mov [rsi + Cons.typecar], BYTE al
        call incref_object
        mov rax, rsi
        jmp .return
        
.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 quasiquote
        ; New AST in RAX
        pop rdi                 ; Environment
        pop rsi                 ; Old AST

        mov r11, rax            ; New AST
        call release_object     ; Release old AST
        mov rsi, r11            ; New AST in RSI
        
        jmp eval                ; Tail call
        
        ; -----------------------------
.macroexpand_symbol:
        ; Check if we have a second list element
        
        mov al, BYTE [rsi + Cons.typecdr]
        cmp al, content_pointer
        jne .return_nil         ; No argument

        mov rsi, [rsi + Cons.cdr]
        
        ; Check if this is a value or pointer
        mov al, BYTE [rsi + Cons.typecar]
        and al, content_mask
        cmp al, content_pointer
        je .macroexpand_pointer
        
        ; RSI contains a value. Remove the list container
        mov [rsi + Cons.typecar], BYTE al
        call incref_object
        mov rax, rsi
        jmp .return

.macroexpand_pointer:
        mov rsi, [rsi + Cons.car]
        call incref_object      ; Since RSI will be released
        
        call macroexpand   ; May release and replace RSI
        
        mov rax, rsi
        jmp .return ; Releases original AST        
        
        ; -----------------------------
        
.try_symbol:
        ; Should have the form
        ;
        ;   (try* A (catch* B C))
        ; 
        ; where B is a symbol, A and C are forms to evaluate
        
        ; Check first arg A
        mov al, BYTE [rsi + Cons.typecdr]
        cmp al, content_pointer
        jne .return_nil         ; No argument
        
        mov rsi, [rsi + Cons.cdr]
        
        ; Check if this is a value or pointer
        mov al, BYTE [rsi + Cons.typecar]
        and al, content_mask
        cmp al, content_pointer
        je .try_pointer
        
        ; RSI contains a value. Copy and return
        mov cl, al
        call alloc_cons
        mov [rax], BYTE cl      ; Set type
        mov rbx, [rsi + Cons.car]
        mov [rax + Cons.car], rbx
        jmp .return

.try_pointer:

        mov r8, [rsi + Cons.car]      ; form A in R8
        
        ; Check second arg B

        mov al, BYTE [rsi + Cons.typecdr]
        cmp al, content_pointer
        jne .try_missing_catch

        mov rsi, [rsi + Cons.cdr]

        mov al, BYTE [rsi]
        and al, content_mask
        cmp al, content_pointer
        jne .try_missing_catch

        mov r9, [rsi + Cons.car] ; (catch* B C) in R9
        
        mov al, BYTE [r9]
        cmp al, (container_list + content_pointer)
        jne .try_missing_catch

        mov rsi, [r9 + Cons.car] ; Should be catch* symbol
        mov al, BYTE [rsi]
        cmp al, maltype_symbol
        jne .try_missing_catch
        
        mov rdi, catch_symbol
        call compare_char_array
        test rax, rax           ; ZF set if rax = 0 (equal)
        jnz .try_missing_catch

        ; Check that B is a symbol
        mov al, [r9 + Cons.typecdr]
        cmp al, content_pointer
        jne .catch_missing_symbol

        mov r9, [r9 + Cons.cdr] ; (B C) in R9

        mov al, BYTE [r9]
        and al, content_mask
        cmp al, content_pointer
        jne .catch_missing_symbol

        mov r10, [r9 + Cons.car] ; B in R10
        mov al, BYTE [r10]
        cmp al, maltype_symbol
        jne .catch_missing_symbol

        mov al, BYTE [r9 + Cons.typecdr]
        cmp al, content_pointer
        jne .catch_missing_form
        mov r9, [r9 + Cons.cdr] ; C in R9

        ; Now have extracted from (try* A (catch* B C))
        ; A in R8
        ; B in R10
        ; C in T9
        
        push R9
        push R10
        push r15                ; Env
        
        ; Set the error handler
        mov rsi, rsp            ; Stack pointer
        mov rdi, .catch         ; Address to jump to
        xor rcx, rcx            ; No data
        call error_handler_push

        ; Evaluate the form in R8
        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
        
        mov r8, rax             ; Result in R8
        
        pop r15                 ; Environment
        ; Discard B and C
        ;add rsi, 8             ; pop R10 and R9
        pop r10
        pop r9
        
        ; Remove error handler
        call error_handler_pop
        mov rax, r8
        jmp .return
        
.catch:
        ; Jumps here on error
        ; Value thrown in RSI
        ;

        push rsi
        call error_handler_pop
        pop rsi

        pop r15                 ; Env
        pop r12                 ; B (symbol to bind)
        pop r13                 ; C (form to evaluate)

        ; Check if C is a value or pointer

        mov cl, BYTE [r13]
        and cl, content_mask
        cmp cl, content_pointer
        je .catch_C_pointer

        ; A value, so copy and return
        call alloc_cons
        mov [rax], BYTE cl      ; Set type
        mov rbx, [r13 + Cons.car]
        mov [rax + Cons.car], rbx ; Set value
        
        jmp .return
        
.catch_C_pointer:
        
        mov r11, rsi            ; Value thrown in R11
        
        mov rsi, r15            ; Outer env
        call env_new            ; Increments R15's ref count
        
        mov rsi, rax            ; New environment in RSI
        mov rdi, r12            ; key (symbol)
        mov rcx, r11            ; value
        call env_set
        
        mov rdi, rsi            ; Env in RDI (will be released)
        mov rsi, [r13 + Cons.car] ; Form to evaluate
        call incref_object      ; will be released

        push r15
        call eval
        pop r15
        
        jmp .return
        
.try_missing_catch:
        load_static try_missing_catch
        call raw_to_string
        mov rsi, rax
        jmp error_throw

.catch_missing_symbol:
        load_static catch_missing_symbol
        call raw_to_string
        mov rsi, rax
        jmp error_throw

.catch_missing_form:
        load_static catch_missing_form
        call raw_to_string
        mov rsi, rax
        jmp error_throw
        
        ; -----------------------------
        
.list_eval:
        push rsi
        mov rdi, r15            ; Environment
        push r15
        call eval_ast           ; List of evaluated forms in RAX
        pop r15
        pop rsi
        
.list_exec:
        ; This point can be called to run a function
        ; used by swap!
        ; 
        ; Inputs: RAX - List with function as first element
        ;               NOTE: This list is released
        ; 
        ; Check that the first element of the return is a function
        mov bl, BYTE [rax]
        and bl, content_mask
        cmp bl, content_pointer
        jne .list_not_function
        
        mov rbx, [rax + Cons.car] ; Get the address
        mov cl, BYTE [rbx]
        cmp cl, maltype_function
        jne .list_not_function

        ; Check the rest of the args
        mov cl, BYTE [rax + Cons.typecdr]
        cmp cl, content_pointer
        je .list_got_args
        
        ; No arguments
        push rbx
        call alloc_cons
        mov [rax], BYTE maltype_empty_list
        pop rbx
        mov rsi, rax
        jmp  .list_function_call
.list_got_args:
        mov rsi, [rax + Cons.cdr] ; Rest of list
.list_function_call:
        ; Call the function with the rest of the list in RSI
        
        mov rdx, rax            ; List to release
        mov rdi, rbx ; Function object in RDI

        mov rbx, [rbx + Cons.car]   ; Call function
        cmp rbx, apply_fn
        je apply_fn_jmp             ; Jump to user function apply
        
        ; A built-in function, so call (no recursion)
        push rax
        push r15

        call rbx
        
        ; Result in rax
        pop r15
        pop rsi                 ; eval'ed list
        
        push rax
        call release_cons
        pop rax 
        jmp .return             ; Releases Env

.list_not_function:
        ; Not a function. Probably an error
        push rsi

        mov rsi, rax
        call release_object
        
        print_str_mac error_string
        print_str_mac eval_list_not_function
        pop rsi
        jmp error_throw
        

;; Applies a user-defined function
;;
;; Input: RSI - Arguments to bind
;;        RDI - Function object
;;        RDX - list to release after binding
;;        R15 - Env (will be released)
;;        R13 - AST released before return
;;
;; 
;; Output: Result in RAX
;;
;; This is jumped to from eval, so if it returns
;; then it will return to the caller of eval, not to eval
apply_fn_jmp:
        ; This is jumped to from eval with AST on the stack
        pop r13
apply_fn:
        push rsi
        ; Extract values from the list in RDI
        mov rax, [rdi + Cons.cdr]
        mov rax, [rax + Cons.cdr] ; Meta (don't need)
        mov rsi, [rax + Cons.car] ; Env
        mov rax, [rax + Cons.cdr]
        mov rdi, [rax + Cons.car] ; Binds
        mov rax, [rax + Cons.cdr]
        mov rax, [rax + Cons.car] ; Body
        pop rcx                   ; Exprs
        
        ; Check the type of the body
        mov bl, BYTE [rax]
        and bl, block_mask + container_mask
        jnz .bind               
        ; Just a value (in RAX). No eval needed
        
        mov r14, rax            ; Save return value in R14
        
        mov rsi, rax
        call incref_object

        ; Release the list passed in RDX
        mov rsi, rdx
        call release_object

        ; Release the environment
        mov rsi, r15
        call release_object

        ; Release the AST
        mov rsi, r13
        call release_object
        
        mov rax, r14
        ret
.bind:
        ; Create a new environment, binding arguments
        push rax                ; Body
        
        mov r14, r13            ; Old AST. R13 used by env_new_bind
        
        push rdx
        call env_new_bind
        pop rdx

        mov rdi, rax       ; New environment in RDI

        ; Note: Need to increment the reference count
        ; of the function body before releasing anything,
        ; since if the function was defined in-place (lambda)
        ; then the body may be released early
        
        pop rsi            ; Body
        call incref_object ; Will be released by eval
        mov r8, rsi        ; Body in R8
        
        ; Release the list passed in RDX
        mov rsi, rdx
        call release_cons

        ; Release the environment
        mov rsi, r15
        call release_object

        ; Release the old AST
        mov rsi, r14
        call release_object

        mov rsi, r8             ; Body
        
        jmp eval           ; Tail call
        ; The new environment (in RDI) will be released by eval


;; Set ZF if RSI is a non-empty list or vector
;; Modifies RAX, does not modify RSI
is_pair:
        mov al, BYTE [rsi]
        test al, block_mask
        jnz .false              ; Not a Cons
        cmp al, maltype_empty_list
        je .false               ; Empty list
        cmp al, maltype_empty_vector
        je .false               ; Empty vector
        
        ; Something non empty
        and al, container_mask
        cmp al, container_list
        je .true
        cmp al, container_vector
        je .true
        ; Not a list or vector -> false
        
.false:
        lahf                    ; flags in AH
        and ah, 255-64          ; clear zero flag
        sahf
        ret
.true:
        lahf                    ; flags in AH
        or ah, 64               ; set zero flag
        sahf
        ret
        
;; Called by eval with AST in RSI [ modified ]
;; Returns new AST in RAX
quasiquote:
        ; i. Check if AST is an empty list
        call is_pair
        jne .quote_ast
        
        ; ii. Check if the first element of RSI is the symbol
        ;     'unquote'

        mov al, BYTE [rsi]
        and al, content_mask
        cmp al, content_pointer
        jne .not_unquote        ; Not a pointer
        
        mov rdi, [rsi + Cons.car] ; Get the pointer
        mov cl, BYTE [rdi]
        cmp cl, maltype_symbol
        jne .not_unquote

        ; Compare against 'unquote'
        mov r8, rsi
        mov r9, rax
        
        mov rsi, unquote_symbol
        call compare_char_array
        test rax, rax

        mov rax, r9
        mov rsi, r8
        
        je .unquote
        
.not_unquote:
        ; iii. Handle splice-unquote
        ;      RSI -> ( ( splice-unquote ? ) ? )
        
        ; Test if RSI contains a pointer
        
        cmp al, content_pointer
        jne .not_splice
        
        mov rbx, [rsi + Cons.car] ; Get the object pointer
        
        ; RBX -> ( splice-unquote ? )
        
        xchg rbx, rsi
        call is_pair
        xchg rbx, rsi
        jne .not_splice         ; First element not a pair
        
        ; Check if this list in RBX starts with 'splice-unquote' symbol
        mov al, BYTE [rbx]
        and al, content_mask
        cmp al, content_pointer
        jne .not_splice
        
        
        mov rdi, [rbx + Cons.car] ; Get the pointer
        mov al, BYTE [rdi]
        cmp al, maltype_symbol
        jne .not_splice
        
        mov r8, rsi
        mov r9, rbx
        
        ; Compare against 'splice-unquote'
        mov rsi, splice_unquote_symbol
        call compare_char_array
        test rax, rax

        mov rbx, r9
        mov rsi, r8

        je .splice_unquote
        
.not_splice:

        ; iv. Cons first and rest of AST in RSI

        ; check if pointer or value
        mov cl, BYTE [rsi]
        and cl, content_mask
        cmp cl, content_pointer
        je .cons_pointer

        ; a value, so copy
        call alloc_cons
        or cl, container_list
        mov [rax], BYTE cl      ; List + Content
        mov rbx, [rsi + Cons.car]
        mov [rax + Cons.car], rbx
        mov rcx, rax
        jmp .cons_first
        
.cons_pointer:
        ; Get the pointer and call quasiquote
        push rsi
        mov rsi, [rsi + Cons.car]
        call quasiquote
        mov rcx, rax
        pop rsi
        
        call alloc_cons
        mov [rax], BYTE (container_list + content_pointer)
        mov [rax + Cons.car], rcx
        mov rcx, rax
        
.cons_first:
        ; Have Cons with first object in RCX

        ; Call quasiquote on the rest of the AST
        ; Check if this is the end of the list
        mov al, BYTE [rsi + Cons.typecdr]
        cmp al, content_pointer
        jne .cons_ast_end
        
        mov rsi, [rsi + Cons.cdr] ; Rest of the list

        call incref_object      ; Will release after quasiquote call
        
        jmp .cons_quasiquote_ast
        
.cons_ast_end:
        ; End of the AST, so make an empty list
        call alloc_cons
        mov [rax], BYTE maltype_empty_list
        mov rsi, rax
        
.cons_quasiquote_ast:
        push rcx
        push rsi
        call quasiquote
        mov rdx, rax            ; List in RDX
        
        pop rsi
        call release_object     ; Release input
        
        pop rcx                 ; Value in RCX
        
        ; cons RCX and RDX
        ; Work from the end of the list to the front

        call alloc_cons
        mov [rax], BYTE (container_list + content_pointer)
        mov [rax + Cons.car], rdx ; The rest of AST

        ; Link to the RCX Cons
        mov [rcx + Cons.typecdr], BYTE content_pointer
        mov [rcx + Cons.cdr], rax
        mov rdx, rcx
        
        call alloc_cons         ; Cons for cons symbol
        mov [rax + Cons.typecdr], BYTE content_pointer
        mov [rax + Cons.cdr], rdx
        mov rdx, rax
        
        ; Get the cons symbol
        mov rsi, cons_symbol
        call incref_object

        mov [rdx], BYTE (container_list + content_pointer)
        mov [rdx + Cons.car], rsi
        
        mov rax, rdx
        ret
        
.quote_ast:
        ; Return (quote RSI)

        call incref_object      ; RSI reference count
        
        ; Cons for RSI
        call alloc_cons
        mov [rax], BYTE (block_cons + container_list + content_pointer)
        mov [rax + Cons.car], rsi
        mov rsi, rax

        ; Cons for quote symbol
        call alloc_cons
        mov rbx, rax
        mov [rbx + Cons.typecdr], BYTE content_pointer
        mov [rbx + Cons.cdr], rsi

        ; Get a quote symbol, incrementing references
        mov rsi, quote_symbol
        call incref_object

        ; Put into the Cons in RBX
        mov [rbx + Cons.car], rsi
        mov [rbx], BYTE (block_cons + container_list + content_pointer)
        mov rax, rbx
        ret
        ; -----------------------
        
.unquote:

        ; Got unquote symbol. Return second element of RSI
        mov al, BYTE [rsi + Cons.typecdr]
        cmp al, content_pointer
        jne .empty_list              ; No second element
        
        mov rsi, [rsi + Cons.cdr]

        ; Check if it's a value or pointer
        mov cl, BYTE [rsi]
        and cl, content_mask
        cmp cl, content_pointer
        je .unquote_pointer

        ; A value, so need a new Cons
        call alloc_cons
        mov [rax], BYTE cl      ; content
        mov rbx, [rsi + Cons.car]
        mov [rax + Cons.car], rbx ; Copy content
        ret
       
.unquote_pointer:
        mov rsi, [rsi + Cons.car]
        call incref_object
        mov rax, rsi
        ret

        ; -----------------------
.splice_unquote:
        ; RSI -> ( RBX->( splice-unquote A ) B )
        ; 
        ; RBX Car points to splice-unquote symbol

        ; Check if there is anything after the symbol
        mov al, BYTE [rbx + Cons.typecdr]
        cmp al, content_pointer
        jne .splice_unquote_empty

        ; Point to the second element of the splice-unquote list
        mov rcx, [rbx + Cons.cdr]
        
        ; Check whether it's a value or pointer
        mov al, BYTE [rcx]
        and al, content_mask
        cmp al, content_pointer
        je .splice_unquote_pointer

        ; A value, so change the container to a value
        mov [rcx], BYTE al
        ; Remove pointer from RBX
        mov [rbx + Cons.typecdr], BYTE 0
        jmp .splice_unquote_first ; Got the value in RCX
        
.splice_unquote_pointer:
        mov rcx, [rcx + Cons.car] ; Get the object pointed to
        xchg rcx, rsi
        call incref_object
        xchg rcx, rsi           ; Object in RCX
        
.splice_unquote_first:          ; Got the first object in RCX

        ; Check if RSI contains anything else
        mov al, BYTE [rsi + Cons.typecdr]
        cmp al, content_pointer
        jne .splice_unquote_notail

        mov rsi, [rsi + Cons.cdr]
        
        ; Now have:
        ; ( ( splice-unquote A ) B )
        ; RCX->A RSI->( B )
        ; Need to call quasiquote on the rest of the list
        push rcx
        call quasiquote
        mov rdx, rax
        pop rcx
        ; Need to concat rcx and rdx
        ; Work from the end of the list to the front
        
        call alloc_cons
        mov [rax], BYTE (container_list + content_pointer)
        mov [rax + Cons.car], rdx ; The rest of AST
        mov rdx, rax              ; Push list into RDX

        call alloc_cons
        mov [rax], BYTE (container_list + content_pointer)
        mov [rax + Cons.car], rcx ; The splice-unquote object
        mov [rax + Cons.typecdr], BYTE content_pointer
        mov [rax + Cons.cdr], rdx
        mov rdx, rax
        
        call alloc_cons         ; Cons for concat symbol
        mov [rax + Cons.typecdr], BYTE content_pointer
        mov [rax + Cons.cdr], rdx
        mov rdx, rax

        ; Get the concat symbol
        mov rsi, concat_symbol
        call incref_object

        mov [rdx], BYTE (container_list + content_pointer)
        mov [rdx + Cons.car], rsi
        
        mov rax, rdx
        ret
        
.splice_unquote_notail:
        ; Just return the object in RCX
        ; since nothing to concatenate with
        mov rax, rcx
        ret

.splice_unquote_empty:
        ; Nothing in the (splice-unquote) list, so ignore
        ; Just call quasiquote on the rest of RSI

        mov al, BYTE [rsi + Cons.typecdr]
        cmp al, content_pointer
        jne .empty_list         ; Nothing else

        mov rsi, [rsi + Cons.cdr]
        jmp quasiquote          ; Tail call
        
.empty_list:
        ; Return an empty list
        call alloc_cons
        mov [rax], BYTE maltype_empty_list
.return:
        ret

        
;; Tests if an AST in RSI is a list containing
;; a macro defined in the ENV in R15
;;
;; Inputs: AST in RSI (not modified)
;;         ENV in R15 (not modified)
;;
;; Returns: Sets ZF if macro call. If set (true),
;;          then the macro object is in RAX
;;
;; Modifies:
;;    RAX
;;    RBX
;;    RCX
;;    RDX
;;    R8
;;    R9
is_macro_call:
        ; Test if RSI is a list which contains a pointer
        mov al, BYTE [rsi]
        cmp al, (block_cons + container_list + content_pointer)
        jne .false

        ; Test if this is a symbol
        mov rbx, [rsi + Cons.car]
        mov al, BYTE [rbx]
        cmp al, maltype_symbol
        jne .false

        ; Look up symbol in Env
        push rsi
        push r15
        mov rdi, rbx            ; symbol in RDI
        mov rsi, r15            ; Environment in RSI
        call env_get
        pop r15
        pop rsi
        jne .false              ; Not in environment
        
        ; Object in RAX
        ; If this is not a macro then needs to be released
        mov dl, BYTE [rax]

        cmp dl, maltype_macro
        je .true

        ; Not a macro, so release
        mov r8, rsi
        mov rsi, rax
        call release_object
        mov rsi, r8
        
.false:
        lahf                    ; flags in AH
        and ah, 255-64          ; clear zero flag
        sahf
        ret
.true:
        mov rbx, rax            ; Returning Macro object
        lahf                    ; flags in AH
        or ah, 64               ; set zero flag
        sahf
        mov rax, rbx
        ret

;; Expands macro calls
;;
;; Input: AST in RSI (released and replaced)
;;        Env in R15 (not modified)
;; 
;; Result: New AST in RSI
macroexpand:
        push r15
        
        call is_macro_call
        jne .done

        mov r13, rsi
        
        mov rdi, rax  ; Macro in RDI
        
        ; Check the rest of the args
        mov cl, BYTE [rsi + Cons.typecdr]
        cmp cl, content_pointer
        je .got_args
        
        ; No arguments. Create an empty list
        call alloc_cons
        mov [rax], BYTE maltype_empty_list
        mov rdx, rax
        
        mov rsi, rdx            ; Arguments (empty list)
        call incref_object
        jmp .macro_call
.got_args:
        mov rsi, [rsi + Cons.cdr] ; Rest of list
        call incref_object
        mov rdx, rsi            ; Released
.macro_call:
        ; Here have:
        ;   RSI - Arguments
        ;   RDI - Macro object
        ;   RDX - List to release
        ;   R15 - Environment
        ;   R13 - AST

        ; Increment reference for Environment
        ; since this will be released by apply_fn
        xchg rsi, r15
        call incref_object
        xchg rsi, r15
        
        call apply_fn
        
        mov rsi, rax ; Result in RSI

        pop r15
        jmp macroexpand
.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
;;
;; Input string in RSI
rep_seq:
        ; -------------
        ; 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
        
        call eval               ; This releases Env and Form/AST
        push rax                ; Save result of eval

        ; -------------
        ; 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

        ; Release result of eval
        pop rsi
        call release_object
        
        ; The AST from read_str is released by eval
        
        ret


_start:
        ; Create and print the core environment
        call core_environment   ; Environment in RAX

        mov [repl_env], rax     ; store in memory

        ; Set the error handler
        mov rsi, rsp            ; Stack pointer
        mov rdi, .catch         ; Address to jump to
        xor rcx, rcx            ; No data
        call error_handler_push

        ; Evaluate the startup string

        mov rsi, mal_startup_string
        mov edx, mal_startup_string.len
        call raw_to_string      ; String in RAX
        
        push rax
        mov rsi, rax
        call read_str           ; AST in RAX
        pop rsi                 ; string

        push rax                ; AST
        call release_array      ; string
        pop rdi                 ; AST in RDI
        
        mov rsi, [repl_env]     ; Environment in RSI
        
        call incref_object      ; Environment increment refs
        xchg rsi, rdi           ; Env in RDI, AST in RSI
        
        call eval
        
        mov rsi, rax
        call release_object     ; Return from eval

        ; -----------------------------
        ; Check command-line arguments

        pop rax                 ; Number of arguments
        cmp rax, 1              ; Always have at least one, the path to executable
        jg run_script

        ; No extra arguments, so just set *ARGV* to an empty list
        call alloc_cons         ; in RAX
        mov [rax], BYTE maltype_empty_list
        mov rcx, rax            ; value (empty list)
        mov rdi, argv_symbol    ; symbol (*ARGV*)
        mov rsi, [repl_env]     ; environment
        call env_set

        ; -----------------------------
        ; Header

        load_static mal_startup_header
        call raw_to_string
        push rax
        
        mov rsi, rax
        call read_eval          ; no print ('nil')
        mov rsi, rax
        call release_object     ; Release result of eval
        
        ; Release the input string
        pop rsi
        call release_array
        
        ; -----------------------------
        ; Main loop
        
.mainLoop:
        ; print the prompt
        print_str_mac prompt_string

        call read_line
        
        ; Check if we have a zero-length string
        cmp DWORD [rax+Array.length], 0
        je .mainLoopEnd

        push rax                ; Save address of the input string
        
        ; Put into read_str
        mov rsi, rax
        call rep_seq
        
        ; Release the input string
        pop rsi
        call release_array
        
        jmp .mainLoop
.mainLoopEnd:
        
        jmp quit
        
.catch:
        ; Jumps here on error

        ; Check if an object was thrown
        cmp rsi, 0
        je .catch_done_print                ; nothing to print
        mov rdi, 1
        call pr_str
        mov rsi, rax
        call print_string
.catch_done_print:
        jmp .mainLoop           ; Go back to the prompt
        

        
run_script:
        ; Called with number of command-line arguments in RAX
        mov r8, rax
        pop rbx                 ; executable
        dec r8
        
        pop rsi                  ; Address of first arg
        call cstring_to_string   ; string in RAX
        mov r9, rax
        
        ; get the rest of the args
        xor r10, r10            ; Zero       
        dec r8
        jz .no_args
        
        ; Got some arguments
.arg_loop:  
        ; Got an argument left. 
        pop rsi                 ; Address of C string
        call cstring_to_string  ; String in RAX
        mov r12, rax
        
        ;Make a Cons to point to the string
        call alloc_cons         ; in RAX
        mov [rax], BYTE (block_cons + container_list + content_pointer)
        mov [rax + Cons.car], r12
        
        test r10, r10
        jnz .append

        ; R10 zero, so first arg
        mov r10, rax            ; Head of list
        mov r11, rax            ; Tail of list
        jmp .next
.append:
        ; R10 not zero, so append to list tail
        mov [r11 + Cons.cdr], rax
        mov [r11 + Cons.typecdr], BYTE content_pointer
        mov r11, rax
.next:
        dec r8
        jnz .arg_loop
        jmp .got_args
        
.no_args:
        ; No arguments. Create an emoty list
        call alloc_cons         ; in RAX
        mov [rax], BYTE maltype_empty_list
        mov r10, rax
        
.got_args:
        push r9                 ; File name string
        
        mov rcx, r10            ; value (list)
        mov rdi, argv_symbol    ; symbol (*ARGV*)
        mov rsi, [repl_env]     ; environment
        call env_set
        
        mov rsi, run_script_string ; load-file function
        mov edx, run_script_string.len
        call raw_to_string      ; String in RAX

        mov rsi, rax
        pop rdx                 ; File name string
        call string_append_string

        mov cl, 34              ; "
        call string_append_char
        mov cl, ')'
        call string_append_char ; closing brace

        ; Read-Eval "(load-file <file>)"
        call read_eval 

        jmp quit