section .bss
    buf resb 0x100
    align 8,db 0
    atoms times 2 resb 8
    env resq 1
;;
section .text

    ;; converts char $dil to a digit with radix $rsi, returning it in $edx. $al is set to 1 if the char is a valid digit, and 0 otherwise.
to_digit:
    lea eax, [rsi - 2]
    cmp eax, 35
    jae .invalid
    movzx rdi, dil
    lea edx, [rdi - 65] ; 'A' = 65
    and edx, -33        ; convert to uppercase
    add edx, 10         ; 'A' should map to 10
    lea eax, [rdi - 48] ; '0' = 48
    cmp esi, 11
    cmovb edx, eax              ; if radix <= 10, then take the difference from '0'
    cmp edi, 58                  
    cmovb edx, eax              ; or if char < '9', then take the difference from '0'
    xor eax, eax
    cmp edx, esi
    setb al                     ; al = edx < radix
    ret
.invalid:
    xor eax, eax
    ret

;; rdi: *u8
strlen:
    xor rax, rax
.strlen_loop:
    cmp byte [rdi + rax], 0
    je .strlen_done
    inc rax
    jmp .strlen_loop
.strlen_done:
    ret

;; rdi: src
;; rsi: dst
;; rdx: len
memcpy:
    .memcpy_loop:
    test rdx, rdx
    jz .memcpy_done
    mov al, byte [rdi]
    mov byte [rsi], al
    inc rsi
    inc rdi
    dec rdx
    jmp .memcpy_loop

    .memcpy_done:
    ret


;; fn getc(*const opaque) -> u8
extern getc
;; fn peekc(*const opaque) -> u8
extern peekc
;; fn panic(msg: *const u8) -> !
extern panic_abort
;; fn alloc(size: usize, align: usize) -> *mut u8
extern alloc
;; fn dealloc(ptr: *mut u8, size: usize, align: usize)
extern dealloc

    align 8,db 0
    nil dq 1                    ; the nil object, with refcount = 1
    OBJ_NIL equ 0
    OBJ_CONS equ 1
    OBJ_CLOS equ 2
    OBJ_ATOM equ 3
    OBJ_NUM equ 4
    OBJ_PRIM equ 5
    OBJ_STR equ 6

    ATOM_QUOTE equ 0
    ATOM_TRUE equ 1

    QUOTE_STR db "quote", 0
    QUOTE_STR_LEN equ $ - QUOTE_STR
    TRUE_STR db "t", 0
    TRUE_STR_LEN equ $ - TRUE_STR

global init_env
init_env:
    call init_atoms

    lea rdi, [rel atoms]
    mov rsi, [rdi + ATOM_TRUE * 8] ; get the "t" atom
    mov rdi, rsi
    call cons                   ; (t . t)
    mov rdi, rax                ; $rdi = (t . t)
    lea rsi, [rel nil]
    call cons                   ; ((t . t) . nil)
    mov qword [rel env], rax             ; env = ((t . t) . nil)
    ret

global init_atoms
init_atoms:
    mov rdi, 16
    mov rsi, 8
    call alloc
    mov dword [rax], 1          ; refcount = 1
    mov dword [rax + 4], QUOTE_STR_LEN ; length of "quote
    lea rcx, [rel QUOTE_STR]
    mov qword [rax + 8], rcx           ; pointer to "quote"
    mov rdi, rax
    mov rsi, OBJ_ATOM
    call obj_set_tag
    lea rcx, [rel atoms]
    mov qword [rcx], rax                ; atoms[0] = "quote"

    mov rdi, 16
    mov rsi, 8
    call alloc
    mov dword [rax], 1          ; refcount = 1
    mov dword [rax + 4], TRUE_STR_LEN ; length of "t"
    lea rcx, [rel TRUE_STR]
    mov qword [rax + 8], rcx           ; pointer to "t"
    mov rdi, rax
    mov rsi, OBJ_ATOM
    call obj_set_tag
    lea rcx, [rel atoms]
    mov qword [rcx + 8], rax            ; atoms[1] = "t"
    ret
    
    

dtor_table:
    dd dtor_table - dtor_nil
    dd dtor_table - dtor_cons
    dd dtor_table - dtor_clos
    dd dtor_table - dtor_atom
    dd dtor_table - dtor_num
    dd dtor_table - dtor_prim
    dd dtor_table - dtor_str
    dd 0

dtor_nil:
dtor_prim:
    ret
dtor_cons:
dtor_clos:
    push rdi
    mov rdi, qword [rdi + 8]    ; car
    call obj_addr_part
    mov rdi, rax
    call obj_dec_ref
    mov rdi, qword [rsp]
    mov rdi, qword [rdi + 16]   ; cdr
    call obj_addr_part
    mov rdi, rax
    call obj_dec_ref
    pop rdi
    mov rsi, 24
    mov rdx, 8
    call dealloc
    ret

dtor_atom:
dtor_str:
    push rdi
    mov rax, rdi
    mov rdi, qword [rax + 8]    ; pointer to string
    movzx rsi, dword [rax + 4]    ; length of string
    mov rdx, 1
    call dealloc
    pop rdi
dtor_num:
    mov rsi, 16
    mov rdx, 8
    call dealloc
    ret

obj_inc_ref:
    call obj_tag_part
    cmp al, OBJ_NIL
    je .done           ; nil is immortal, so we're done
    call obj_addr_part
    inc dword [rax]    ; increment the refcount
.done:
    ret

obj_dec_ref:
    call obj_tag_part
    cmp al, OBJ_NIL
    je .done           ; nil is immortal, so we're done
    mov rsi, rax
    call obj_addr_part
    dec dword [rax]    ; decrement the refcount
    jnz .done           ; if refcount != 0, we're done
    lea rcx, qword [rel dtor_table]
    movsxd rsi, [rcx + rsi * 4] ; get the offset of the destructor
    add rcx, rsi                  ; calculate the address of the destructor
    mov rdi, rax                  ; set the argument for the destructor (the object pointer)
    call rcx                      ; call the destructor
    .done:
    ret

    ;; returns the tag part of the object handle in $rdi
obj_tag_part:
    mov rax, rdi
    and al, 0x7
    movzx rax, al
    ret
    
    ;; returns the address part of the object handle in $rdi
obj_addr_part:
    mov rax, rdi
    and rax, -8
    ret

obj_set_tag:
    mov rax, rdi
    and rax, -8          ; clear the tag bits
    or rax, rsi          ; set the new tag bits
    ret

    ;; constructs a cons cell ($rdi . $rsi) and returns an object pointer to it
cons:
    push rdi
    push rsi
    mov rdi, 24                 ; struct { refcount: usize, car: *const Object, cdr: *const Object }
    mov rsi, 8
    call alloc
    pop rsi
    pop rdi
    mov dword [rax], 1           ; refcount = 1
    mov qword [rax +  8], rdi    ; car = a
    mov qword [rax + 16], rsi ; cdr = b
    mov rdi, rax
    mov rsi, OBJ_CONS
    call obj_set_tag
    ret


get_car:
    call obj_tag_part
    cmp al, OBJ_CONS
    jne .invalid
    call obj_addr_part
    mov rax, qword [rax + 8]    ; return the car
    ret
.invalid:
    xor rdi, rdi
    call panic_abort

get_cdr:
    call obj_tag_part
    cmp al, OBJ_CONS
    jne .invalid
    call obj_addr_part
    mov rax, qword [rax + 16]   ; return the cdr
    ret
.invalid:
    xor rdi, rdi
    call panic_abort

set_cdr:
    call obj_tag_part
    cmp al, OBJ_CONS
    jne .invalid
    call obj_addr_part
    mov qword [rax + 16], rsi   ; set the cdr to
    ret
.invalid:
    xor rdi, rdi
    call panic_abort

;; returns 1 if the result of `peekc($rdi)` is $sil
;; treats all characters less than ' ' as spaces.
is_ch:
    push rsi
    call peekc
    pop rsi
    cmp al, ' '
    setbe cl                    ; cl = al <= ' '
    movzx ecx, cl
    mov edx, ' '
    mul ecx, edx                ; cl = (al < ' ') ? ' ' : 0
    cmp sil, ' '
    cmove ax, cx                ; al = (sil < ' ') ? cl : al
    cmp al, sil
    setz al                     ; al = al == sil
    ret
    
next_token:
    push r14
    push rdi
    xor r14, r14
.skip_spaces:
    mov rsi, ' '
    call is_ch
    test al, al
    mov rdi, qword [rsp]
    jz .skip_spaces_done
    call getc
    mov rdi, qword [rsp]
    jmp .skip_spaces
.skip_spaces_done:
    call peekc
    cmp al, '('
    je .leading_kw
    cmp al, ')'
    je .leading_kw
    cmp al, "'"
    jne .eat
.leading_kw:
    mov rdi, qword [rsp]
    call getc
    lea rcx, [rel buf]
    lea rcx, [rcx + r14]
    mov byte [rcx], al
    inc r14
    jmp .done
.eat:
    mov rdi, qword [rsp]
    call getc
    lea rcx, [rel buf]
    lea rcx, [rcx + r14]
    mov byte [rcx], al
    inc r14

    mov rdi, qword [rsp]
    mov rsi, ' '
    call is_ch
    test al, al
    jnz .done

    mov rdi, qword [rsp]
    mov rsi, '('
    call is_ch
    test al, al
    jnz .done

    mov rdi, qword [rsp]
    mov rsi, ')'
    call is_ch
    test al, al
    jnz .done

    jmp .eat
.done:
    lea rcx, [rel buf]
    lea rax, [rcx + r14]
    mov byte [rax], 0
    pop rdi
    pop r14
    mov al, byte [rel buf]
    ret
    
parse_cur_token:
    push rdi
    cmp byte [rel buf], '('
    je .list
    cmp byte [rel buf], "'"
    je .quote
    pop rdi
    call parse_atom
    ret
.list:
    pop rdi
    call parse_list
    ret
.quote:
    pop rdi
    call parse_quote
    ret

parse_num:
    push r12
    sub rsp, 16
    mov qword [rsp], 0          ; acc = 0
    mov dword [rsp + 4], 10     ; radix = 10
    lea r12, [rel buf]
    cmp byte [r12], '-'   ; check for optional leading '-'
    jne .skip_sign
    mov qword [rsp], -1
    inc r12                     ; index++
.skip_sign:
    cmp byte [r12], '0'
    jne .skip_radix
    inc r12                     ; index++
    mov dil, byte [r12]
    cmp dil, 'x'
    jne .skip_radix
    inc r12                     ; index++
    mov qword [rsp + 4], 16     ; radix = 16
.skip_radix:
    mov dil, byte [r12]
    test dil, dil
    jz .done

    movzx rsi, dword [rsp + 4]     ; radix
    call to_digit
    test al, al
    jz .done
    mov rax, [rsp]          ; acc
    mov rcx, rdx            ; digit
    imul rax, rsi           ; acc *= radix
    add rax, rcx            ; acc += digit
    mov [rsp], rcx
    inc r12                 ; index++
    jmp .skip_radix
.done:
    cmp byte [r12 + 1], 0
    setz al
    lea rcx, [rel buf]
    sub r12, rcx                ; r12 = count
    mul rax, r12
    mov rdx, [rsp]          ; acc
    add rsp, 16
    pop r12
    ret

parse_atom:
    call parse_num
    test al, al
    jz .not_num
    push rdx
    mov rdi, 16                 ; struct { refcount: usize, value: i64 }
    mov rsi, 8
    call alloc
    pop rdx
    mov dword [rax], 1           ; refcount = 1
    mov qword [rax + 8], rdx     ; value = acc
    mov rdi, rax
    mov rsi, OBJ_NUM
    call obj_set_tag
    ret
.not_num:
    lea rdi, [rel buf]
    call strlen
    push rax                    ; len
    mov rdi, rax
    mov rsi, 1
    call alloc                  ; allocate memory for the string
    pop rdx                     ; len
    push rax                    ; ptr
    push rdx                    ; len
    lea rdi, [rel buf]
    mov rsi, rax
    call memcpy                 ; memcpy(ptr, buf, len)
    mov rdi, 16                 ; struct { refcount: u32, length: u32, ptr: *const u8 }
    mov rsi, 8
    call alloc                  ; allocate the atom object
    pop rdx                     ; length of string
    pop rcx                     ; pointer to string
    mov dword [rax], 1           ; refcount = 1
    mov dword [rax + 4], edx     ; length of string
    mov qword [rax + 8], rcx     ; pointer to string
    mov rdi, rax
    mov rsi, OBJ_ATOM
    call obj_set_tag
    ret

parse_quote:
    call parse_next_token
    mov rdi, rax
    lea rsi, [rel nil]
    call cons                   ; (t . nil)
    push rax
    lea rdi, [rel atoms] 
    mov rdi, [rdi + ATOM_QUOTE * 8] ; get the "quote" atom
    push rdi
    call obj_addr_part
    call obj_inc_ref
    pop rdi                     ; $rdi = "quote" atom
    pop rsi                     ; $rsi = (t . nil)
    call cons                   ; ("quote" . (t . nil))
    ret

parse_list:
    sub rsp, 24
    mov qword [rsp], rdi
    lea rax, [rel nil]
    mov qword [rsp + 8], rax      ;  head = nil
    mov qword [rsp + 16], rax     ;  tail = nil
.tailcall:
    mov rdi, qword [rsp]
    call next_token
    cmp al, ')'
    je .finish
    cmp al, '.'
    mov rdi, qword [rsp]
    jnz .list
    ; dotted_pair:
    call parse_next_token ; if (a . b), return b since we're in the recursive call for (cons a b)
    mov rsi, rax                ; $rsi = b
    mov rdi, qword [rsp + 8]    ; $rdi = (a . nil)
    call set_cdr                ; set_cdr((a . nil), b) => (a . b)
    mov qword [rsp + 8], rax    ; update the tail of the list to (a . b)
    mov rdi, qword [rsp]
    call next_token
    cmp al, ')'
    jnz .invalid
    jmp .finish
.list:
    call parse_cur_token
    mov rdi, rax
    lea rsi, [rel nil] 
    call cons                   ; (t . nil)
    xchg rax, qword [rsp + 16]  ; replace(&mut tail, new_tail)
    lea rsi, [rel nil]
    cmp rax, rsi
    je .init_tail               ; if tail was nil, set head = tail = (t . nil)
    mov rdi, rax                ; $rdi = old tail
    mov rsi, qword [rsp + 16]   ; $rsi = new tail
    call set_cdr                ; set_cdr(old_tail, new_tail) => (old_tail . (t . nil))
    jmp .tailcall
.init_tail:
    mov rax, qword [rsp + 16]    ; $rax = (t . nil)
    mov qword [rsp + 8], rax     ; head = (t . nil)
    jmp .tailcall
.invalid:
    xor rdi, rdi
    call panic_abort
.finish:
    mov rax, [rsp + 8]          ; the list we've been building up
    add rsp, 24
    ret

global parse_next_token
parse_next_token:
    push rdi
    call next_token
    pop rdi
    call parse_cur_token
    ret