stdlib-data := λ .(
'load_file_bsz: \n
\t '.quad \s '1024 \n
'load_file_buf: \n
\t '.zero \s '1024 \n
'argv: \n
\t '.zero \s '16 \n
'nil_literal: \n
\t '.ascii \s " \[ \] " \n
\t '.zero \s 1 \n
'newline: \n
\t '.ascii \s " \\n " \n
'left_paren: \n
\t '.ascii \s " \[ " \n
'right_paren: \n
\t '.ascii \s " \] " \n
'space: \n
\t '.ascii \s " \s " \n
'true: \n
\t '.ascii \s "True" \n
\t '.zero \s '1 \n
'__digit: \n
\t '.zero \s '2 \n
'hex_buffer: \n
\t '.ascii \s "0123456789abcdef" \n
'__mutable_char: \n
\t '.zero \s '2 \n
'__dump_i: \n
\t '.ascii \s '"0000000000000000" \n
\t '.zero \s '1 \n
'err_fopen: \n
\t '.ascii \s '"Could \s 'not \s 'open \s 'file." \n
\t '.zero \s '1 \n
);
stdlib-functions := λ . (
'print_s: \n
# if .head is zero, then this is Nil
\t 'cmp \s '$0, \s '%r12 \n
\t 'je \s 'print_s_nil \n
# if only .tail is zero, then this is an Atom
\t 'cmp \s '$0, \s '%r13 \n
\t 'je \s 'print_s_atom \n
# if .head and .tail are non-zero, then this is a Cons
(system-call( '$1 '$1 '$left_paren '$1 ))
(push-this())
\t 'call \s 'head \n
\t 'call \s 'print_s \n
(pop-this())
(system-call( '$1 '$1 '$space '$1 ))
(push-this())
\t 'call \s 'tail \n
\t 'call \s 'print_s \n
(pop-this())
(system-call( '$1 '$1 '$right_paren '$1 ))
\t 'ret \n
'print_s_nil: \n
# nil is two bytes "()" located in the data section at $nil_literal
(system-call( '$1 '$1 '$nil_literal '$2 ))
\t 'ret \n
'print_s_atom: \n
\t 'call \s 'strlen \n # '%r8 is string length of this atom
(system-call( '$1 '$1 '%r12 '%r8 )) \n
\t 'ret \n
'is_atom: \n
\t 'cmp \s '$0, '%r12 \n
\t 'je \s 'return_nil \n
\t 'cmp \s '$0, '%r13 \n
\t 'jne \s 'return_nil \n
\t 'jmp \s 'return_true \n
'is_cons: \n
\t 'cmp \s '$0, '%r12 \n
\t 'je \s 'return_nil \n
\t 'cmp \s '$0, '%r13 \n
\t 'je \s 'return_nil \n
\t 'jmp \s 'return_true \n
'head_string: \n
\t 'cmp \s '$0, \s '%r13 \n
\t 'jne \s 'return_nil \n
\t 'cmp \s '$0, \s '%r12 \n
\t 'je \s 'return_nil \n
\t 'cmpb \s '$0, \s '0 \[ '%r12 \] \n
\t 'je \s 'return_nil \n
\t 'movb \s '0 \[ '%r12 \] , \s '%bl \n
\t 'mov \s '$__mutable_char, \s '%r12 \n
\t 'movb \s '%bl, \s '0 \[ '%r12 \] \n
\t 'ret \n
'tail_string: \n
\t 'cmp \s '$0, \s '%r13 \n
\t 'jne \s 'return_nil \n
\t 'cmp \s '$0, \s '%r12 \n
\t 'je \s 'return_nil \n
\t 'cmpb \s '$0, \s '0 \[ '%r12 \] \n
\t 'je \s 'return_nil \n
\t 'inc \s '%r12 \n
\t 'cmpb \s '$0, \s '0 \[ '%r12 \] \n
\t 'je \s 'return_nil \n
\t 'ret \n
'head: \n
\t 'cmp \s '$0, \s '%r13 \n
\t 'je \s 'return_nil \n
\t 'mov \s '8 \[ '%r12 \] , \s '%r13 \n
\t 'mov \s '0 \[ '%r12 \] , \s '%r12 \n
\t 'ret \n
'tail: \n
\t 'cmp \s '$0, \s '%r13 \n
\t 'je \s 'return_nil \n
\t 'mov \s '0 \[ '%r13 \] , \s '%r12 \n
\t 'mov \s '8 \[ '%r13 \] , \s '%r13 \n
\t 'ret \n
'strlen: \n
\t 'xor \s '%r8, \s '%r8 \n
\t 'mov \s '%r12, \s '%rax \n
'strlen_loop: \n
\t 'cmpb \s '$0, \s '0 \[ '%rax \] \n
\t 'jz \s 'strlen_exit \n
\t 'inc \s '%r8 \n
\t 'inc \s '%rax \n
\t 'jmp \s 'strlen_loop \n
'strlen_exit: \n
\t 'ret \n
'streq: \n
'streq_loop: \n
\t 'cmp \s '$0, \s '%rax \n
\t 'je \s 'return_nil \n
\t 'cmp \s '$0, \s '%rbx \n
\t 'je \s 'return_nil \n
\t 'mov \s '0 \[ '%rax \] , \s '%cl \n
\t 'mov \s '0 \[ '%rbx \] , \s '%dl \n
\t 'cmp \s '%cl, \s '%dl \n
\t 'jne \s 'return_nil \n
\t 'cmp \s '$0, \s '%cl \n
\t 'je \s 'streq_true \n
\t 'inc \s '%rax \n
\t 'inc \s '%rbx \n
\t 'jmp \s 'streq_loop \n
'streq_true: \n
\t 'mov \s '$true, \s '%r12 \n
\t 'mov \s '$0, \s '%r13 \n
\t 'ret \n
'return_nil: \n
\t 'mov \s '$0, \s '%r12 \n
\t 'mov \s '$0, \s '%r13 \n
\t 'ret \n
'return_true: \n
\t 'mov \s '$true, \s '%r12 \n
\t 'mov \s '$0, \s '%r13 \n
\t 'ret \n
'not: \n
\t 'cmp \s '$0, \s '%r12 \n
\t 'jne \s 'not_yield_nil \n
\t 'mov \s '$true, \s '%r12 \n
\t 'mov \s '$0, \s '%r13 \n
\t 'ret \n
'not_yield_nil: \n
\t 'mov \s '$0, \s '%r12 \n
\t 'mov \s '$0, \s '%r13 \n
\t 'ret \n
'clone_rope: \n
\t 'mov \s '$0, \s '%r8 \n
\t 'mov \s '$0, \s '%r9 \n
(allocate-atom-grow '$0)
\t 'call \s '__clone_rope \n
(allocate-atom-grow '$1)
\t 'movb \s '$0, \s '0 \[ '%r9 \] \n
\t 'inc \s '%r9 \n
\t 'mov \s '%r8, \s '%r12 \n
\t 'mov \s '$0, \s '%r13 \n
\t 'ret \n
'__clone_rope: \n
#if this is a cons, recurse
\t 'cmp \s '$0, \s '%r13 \n
\t 'je \s '__clone_rope_notcons \n
\t 'push \s '%r12 \n
\t 'push \s '%r13 \n
\t 'mov \s '8 \[ '%r12 \] , '%r13 \n
\t 'mov \s '0 \[ '%r12 \] , '%r12 \n
\t 'call \s '__clone_rope \n
\t 'pop \s '%r13 \n
\t 'pop \s '%r12 \n
\t 'mov \s '0 \[ '%r13 \] , '%r12 \n
\t 'mov \s '8 \[ '%r13 \] , '%r13 \n
\t 'push \s '%r12 \n
\t 'push \s '%r13 \n
\t 'call \s '__clone_rope \n
\t 'pop \s '%r13 \n
\t 'pop \s '%r12 \n
\t 'jmp \s '__clone_rope_end \n
#if not cons, concat
'__clone_rope_notcons: \n
#if nil, return
\t 'cmp \s '$0, \s '%r12 \n
\t 'je \s '__clone_rope_end \n
#if atom, break into characters and concat
'__clone_rope_small: \n
\t 'cmpb \s '$0, \s '0 \[ '%r12 \] \n
\t 'je \s '__clone_rope_end \n
(allocate-atom-grow '$1)
\t 'movb \s '0 \[ '%r12 \] , \s '%bl \n
\t 'movb \s '%bl, \s '0 \[ '%r9 \] \n
\t 'inc \s '%r9 \n
\t 'inc \s '%r12 \n
\t 'jmp \s '__clone_rope_small \n
'__clone_rope_end: \n
\t 'ret \n
'is_neg: \n
\t 'cmp \s '$0, \s '%r12 \n
\t 'jge \s 'return_nil \n
\t 'mov \s '$true, \s '%r12 \n
\t 'mov \s '$0, \s '%r13 \n
\t 'ret \n
'inc: \n
\t 'inc \s '%r12 \n
\t 'ret \n
'dec: \n
\t 'dec \s '%r12 \n
\t 'ret \n
'inv: \n
\t 'neg \s '%r12 \n
\t 'ret \n
'mul: \n
\t 'cmp \s '$0, \s '%r12 \n
\t 'je \s 'return_nil \n
\t 'cmp \s '$0, \s '%r13 \n
\t 'je \s 'return_nil \n
\t 'mov \s '0 \[ '%r12 \] , '%rax \n
\t 'mov \s '0 \[ '%r13 \] , '%rbx \n
\t 'imul \s '%rax, \s '%rbx \n
\t 'mov \s '%rbx, \s '%r12 \n
\t 'ret \n
'add: \n
\t 'cmp \s '$0, \s '%r12 \n
\t 'je \s 'return_nil \n
\t 'cmp \s '$0, \s '%r13 \n
\t 'je \s 'return_nil \n
\t 'mov \s '0 \[ '%r12 \] , '%rax \n
\t 'mov \s '0 \[ '%r13 \] , '%rbx \n
\t 'add \s '%rax, \s '%rbx \n
\t 'mov \s '%rbx, \s '%r12 \n
\t 'ret \n
'div: \n
\t 'cmp \s '$0, \s '%r12 \n
\t 'je \s 'return_nil \n
\t 'cmp \s '$0, \s '%r13 \n
\t 'je \s 'return_nil \n
\t 'mov \s '0 \[ '%r12 \] , '%rax \n #dividend
\t 'mov \s '$0, \s '%rdx \n
\t 'mov \s '0 \[ '%r13 \] , '%rcx \n #divisor
\t 'idiv \s '%rcx \n
\t 'mov \s '%rax, \s '%r12 \n
\t 'ret \n
'mod: \n
\t 'cmp \s '$0, \s '%r12 \n
\t 'je \s 'return_nil \n
\t 'cmp \s '$0, \s '%r13 \n
\t 'je \s 'return_nil \n
\t 'mov \s '0 \[ '%r12 \] , '%rax \n #dividend
\t 'mov \s '$0, \s '%rdx \n
\t 'mov \s '0 \[ '%r13 \] , '%rcx \n #divisor
\t 'idiv \s '%rcx \n
\t 'mov \s '%rdx, \s '%r12 \n
\t 'ret \n
'dump_i: \n
\t 'mov \s '%r12, \s '%r8 \n
\t 'mov \s '$__dump_i, \s '%r12 \n
\t 'mov \s '$0, \s '%r13 \n
\t 'mov \s '$__dump_i, \s '%r11 \n
\t 'cmp \s '$0, \s '%r8 \n
\t 'jge \s 'dump_i_positive \n
\t 'jmp \s 'dump_i_negative \n
'dump_i_positive: \n
\t 'call \s 'dump_i_digits \n
\t 'movb \s '$48, \s '0 \[ '%r11 \] \n
\t 'ret \n
'dump_i_negative: \n
\t 'neg \s '%r8 \n
\t 'call \s 'dump_i_digits \n
\t 'movb \s '$45, \s '0 \[ '%r11 \] \n
\t 'ret \n
# if return value is positive then open was a success
'dump_i_digits: \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[0]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '0 \[ '%r11 \] \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[1]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '1 \[ '%r11 \] \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[2]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '2 \[ '%r11 \] \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[3]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '3 \[ '%r11 \] \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[4]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '4 \[ '%r11 \] \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[5]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '5 \[ '%r11 \] \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[6]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '6 \[ '%r11 \] \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[7]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '7 \[ '%r11 \] \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[8]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '8 \[ '%r11 \] \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[9]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '9 \[ '%r11 \] \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[10]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '10 \[ '%r11 \] \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[11]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '11 \[ '%r11 \] \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[12]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '12 \[ '%r11 \] \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[13]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '13 \[ '%r11 \] \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[14]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '14 \[ '%r11 \] \n
\t 'rol \s '$4, \s '%r8 \n # '%r8[15]
\t 'call \s 'put8 \n
\t 'mov \s '%cl, \s '15 \[ '%r11 \] \n
\t 'ret \n
#move ascii representation of lower byte of '%r8 into '%cl
'put8: \n
\t 'mov \s '%r8b, \s '%al \n # lower byte of '%r11 goes into '%rax
\t 'and \s '$0xf, \s '%al \n # only show lower 4 bits
\t 'mov \s '$hex_buffer, '%r10 \n # '%r10 is index into hex buffer
\t 'add \s '%al, \s '%r10b \n # '%r10 is index into char in hex buffer
\t 'mov \s '0 \[ '%r10 \] , \s '%cl \n # '%cl is a hexadecimal char
\t 'ret \n
'digit: \n
\t 'mov \s '%r12, \s '%rax \n
\t 'add \s '$48, \s '%rax \n
\t 'mov \s '$__digit, \s '%r12 \n
\t 'mov \s '%al, \s '0 \[ '%r12 \] \n
\t 'mov \s '$0, \s '%r13 \n
\t 'ret \n
'write_file: \n
#open file
\t 'mov \s '0 \[ '%r12 \] , \s '%rdi \n # file name
\t 'pushq \s '0 \[ '%r13 \] \n # data to write
\t 'mov \s '$2, \s '%rax \n # syscall open
\t 'mov \s '$577, \s '%rsi \n
\t 'mov \s '$420, \s '%rdx \n # mode
\t 'syscall \n
\t 'mov \s '%rax, \s '%r8 \n # r8 now holds file descriptor
#write to file
\t 'pop \s '%rax \n
\t 'mov \s '%rax, \s '%r12 \n
\t 'mov \s '%r8, \s '%r10 \n # '%r10 has file descriptor
\t 'call \s 'strlen \n
(system-call( '$1 '%r10 '%r12 '%r8 ))
#close file
(system-call( '$3 '%r10 '$0 '$0 ))
\t 'mov \s '$0, \s '%r12 \n
\t 'mov \s '$0, \s '%r13 \n
\t 'ret \n
'load_file: \n
# open file
(system-call( '$2 '%r12 '$0 '$0 ))
# file descriptor is in '%rax
\t 'cmp \s '$0, \s '%rax \n
# if return value is positive then open was a success
\t 'jge \s 'load_file_contents \n
\t 'mov \s '$err_fopen, \s '%r12 \n
\t 'mov \s '$0, \s '%r13 \n
\t 'ret \n
'load_file_contents: \n
\t 'mov \s '$0, \s '%r8 \n
\t 'mov \s '$0, \s '%r9 \n
(allocate-atom-grow '$0)
# r8 holds pointer to head of new data
# r9 holds pointer to tail of new data
\t 'mov \s '$0, \s '%r10 \n # r10 holds amount of data on buffer currently
\t 'mov \s '$load_file_buf, \s '%r11 \n # r11 holds pointer to head of buffer
# move data from buffer into string
'load_file_loop: \n
\t 'cmp \s '$0, \s '%r10 \n
\t 'je \s 'load_file_bufempty \n
(allocate-atom-grow '$1)
\t 'movb \s '0 \[ '%r11 \] , \s '%bl \n
\t 'mov \s '%bl, \s '0 \[ '%r9 \] \n
\t 'inc \s '%r9 \n
\t 'inc \s '%r11 \n
\t 'dec \s '%r10 \n
\t 'jmp \s 'load_file_loop \n
# read file
'load_file_bufempty: \n
\t 'push \s '%rax \n
\t 'mov \s '%rax, \s '%r10 \n
\t 'mov \s '$load_file_bsz, \s '%rdx \n
\t 'mov \s '0 \[ '%rdx \] , \s '%rdx \n
(system-call( '$0 '%r10 '$load_file_buf () ))
\t 'mov \s '%rax, \s '%r10 \n
\t 'pop \s '%rax \n
\t 'mov \s '$load_file_buf, \s '%r11 \n
\t 'cmp \s '$0, \s '%r10 \n
\t 'jne \s 'load_file_loop \n
# close file
(system-call( '$3 '%rax '$0 '$0 ))
(allocate-atom-grow '$1)
\t 'movb \s '$0, \s '0 \[ '%r9 \] \n
\t 'inc \s '%r9 \n
\t 'mov \s '%r8, \s '%r12 \n
\t 'mov \s '$0, \s '%r13 \n
\t 'ret \n
);
inline-head := λ . (
\t 'mov \s '8 \[ '%r12 \] , \s '%r13 \n
\t 'mov \s '0 \[ '%r12 \] , \s '%r12 \n
);
inline-tail := λ . (
\t 'mov \s '0 \[ '%r13 \] , \s '%r12 \n
\t 'mov \s '8 \[ '%r13 \] , \s '%r13 \n
);
enter-function := λ .(
\t 'push \s '%rbp \n
\t 'mov \s '%rsp, \s '%rbp \n
);
exit-function := λ .(
\t 'mov \s '%rbp, \s '%rsp \n
\t 'pop \s '%rbp \n
\t 'ret \n
);
push-this := λ .(
\t 'push \s '%r12 \n
\t 'push \s '%r13 \n
);
push-zero := λ .(
\t 'pushq \s '$0 \n
\t 'pushq \s '$0 \n
);
pop-this := λ .(
\t 'pop \s '%r13 \n
\t 'pop \s '%r12 \n
);
yield-nil := λ . (
\t 'mov \s '$0, \s '%r12 \n
\t 'mov \s '$0, \s '%r13 \n
);
close := λe . (
e
(allocate-cons ())
(\t 'mov \s '%r12, \s '0 \[ '%r8 \] \n)
(\t 'mov \s '%r13, \s '8 \[ '%r8 \] \n)
);
system-call := λrax rdi rsi rdx . (
(if rax (\t 'mov \s rax , \s '%rax \n) ())
(if rdi (\t 'mov \s rdi , \s '%rdi \n) ())
(if rsi (\t 'mov \s rsi , \s '%rsi \n) ())
(if rdx (\t 'mov \s rdx , \s '%rdx \n) ())
\t 'syscall \n
);
before-main := λ .(
# before_main_argv:
# argv = ()
# let t = argv
# for a in argv:
# t.tail = (a ())
# t = t.tail
'main: \n
compile-argv-hook
);
exit-cleanup := λ . (system-call( '$60 '$0 '$0 '$0 ));