#+HTML_HEAD: #+TITLE: 小蟬 / cicada-nymph #+AUTHOR: 謝宇恆 / XIE Yuheng * todo *** add length field into jo in assembly code :maybe: *** memory :limit: * need to protect the overloading of a variety of memories *** reading-stack :limit: * need to find a better way to protect reading-stack * now "1 2 3 add add . jo" eval-string will crush the interpreter *** div :bug: * div can not handle the following -8 2 div . *** stack :limit: * there are 64 positions below the all those stacks when you are belowing-stack so much bad things happen *** string-reverse! :bug: * string-reverse! can not apply on empty-string * prolog *** note conditional preprocessing * flower bar-ket can not be nested in fasm's "match" so 1. when defining macro conditionally one should use "if eq" & "finish if" 2. when doing "define" or "equ" one should use "match { }" *** platform configuration #+begin_src fasm :tangle cicada-nymph.fasm ;;;; before you compile the code ;;;; do not forget to choose your platform ;;;; in the following file include "platform-configuration.inc" #+end_src *** misc #+begin_src fasm :tangle cicada-nymph.fasm ;; in fasm, "dup" is a reserved word dup equ duplicate ;; in fasm, "end" is a reserved word finish equ end end equ exit #+end_src *** cell_size :64bit: #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { cell_size = 8 ;; (byte) xx equ dq } #+end_src *** cell_size :32bit: #+begin_src fasm :tangle cicada-nymph.fasm match =32bit, machine { cell_size = 4 ;; (byte) xx equ dd rax equ eax rbx equ ebx rcx equ ecx rdx equ edx rsp equ esp rbp equ ebp rsi equ esi rdi equ edi syscall equ int 80h } #+end_src *** header :64bit:linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =64bit, platform machine { define linux64_sys_6_r8 r8 define linux64_sys_5_r9 r9 define linux64_sys_4_r10 r10 define linux64_sys_3_rdx rdx define linux64_sys_2_rsi rsi define linux64_sys_1_rdi rdi define linux64_sys_n_rax rax define linux64_syscall_read 0 define linux64_syscall_write 1 define linux64_syscall_open 2 define linux64_syscall_close 3 define linux64_syscall_exit 60 ;; about open & read & write } #+end_src *** format :64bit:linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =64bit, platform machine { format ELF64 executable 3 } #+end_src *** entry :64bit:linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =64bit, platform machine { entry begin_to_interpret_threaded_code segment readable executable writeable } #+end_src *** header :32bit:linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =32bit, platform machine { define linux32_sys_6_ebp ebp define linux32_sys_5_edi edi define linux32_sys_4_esi esi define linux32_sys_3_edx edx define linux32_sys_2_ecx ecx define linux32_sys_1_ebx ebx define linux32_sys_n_eax eax define linux32_syscall_exit 1 define linux32_syscall_read 3 define linux32_syscall_write 4 define linux32_syscall_open 5 define linux32_syscall_close 6 } #+end_src *** format :32bit:linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =32bit, platform machine { format ELF executable 3 } #+end_src *** entry :32bit:linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =32bit, platform machine { entry begin_to_interpret_threaded_code segment readable executable writeable } #+end_src *** memory allocation in un_initialized_memory * implemented as a memory map #+begin_src fasm :tangle cicada-nymph.fasm current_free_address$un_initialized_memory = address$un_initialized_memory labeling equ = current_free_address$un_initialized_memory preserve equ current_free_address$un_initialized_memory = current_free_address$un_initialized_memory + #+end_src * argument-stack *** note stack * when doing "push" a stack-pointer moves to lower address * note that another style is that when doing "push" a stack-pointer moves to higher address * the stack-pointer always stores the address of current-free-address of the stack * note that another style is that under the stack-pointer there always stores the value of the-top-of-the-stack *** memory allocation * for we do not build border-check into the interface of pop and push we allocation some memory below the stacks #+begin_src fasm :tangle cicada-nymph.fasm size$argument_stack = 1024 * 1024 * cell_size preserve 64 * cell_size address$argument_stack labeling preserve size$argument_stack #+end_src *** pointer :64bit: #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { ;; if you want to extend cicada in assembly ;; the following registers must NOT be used define pointer$argument_stack r15 } #+end_src *** push & pop :64bit: #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { macro push_argument_stack register \{ mov [pointer$argument_stack], register add pointer$argument_stack, cell_size \} macro pop_argument_stack register \{ sub pointer$argument_stack, cell_size mov register, [pointer$argument_stack] \} } #+end_src *** pointer :32bit: #+begin_src fasm :tangle cicada-nymph.fasm match =32bit, machine { pointer$argument_stack: xx address$argument_stack } #+end_src *** push & pop :32bit: #+begin_src fasm :tangle cicada-nymph.fasm match =32bit, machine { macro push_argument_stack register \{ if register in push ebx mov ebx, [pointer$argument_stack] mov [ebx], register add ebx, cell_size mov [pointer$argument_stack], ebx pop ebx else push eax mov eax, [pointer$argument_stack] mov [eax], register add eax, cell_size mov [pointer$argument_stack], eax pop eax finish if \} macro pop_argument_stack register \{ if register in push ebx mov ebx, [pointer$argument_stack] sub ebx, cell_size mov register, [ebx] mov [pointer$argument_stack], ebx pop ebx else push eax mov eax, [pointer$argument_stack] sub eax, cell_size mov register, [eax] mov [pointer$argument_stack], eax pop eax finish if \} } #+end_src * return-stack *** 記 * jo 的詮釋者決定了如何入這個棧 * 結尾詞決定了如何出這個棧 *** memory allocation #+begin_src fasm :tangle cicada-nymph.fasm size$return_stack = 1024 * 1024 * cell_size preserve 64 * cell_size address$return_stack labeling preserve size$return_stack #+end_src *** pointer :64bit: #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { ;; if you want to extend cicada in assembly ;; the following registers must NOT be used define pointer$return_stack r14 } #+end_src *** push & pop :64bit: #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { macro push_return_stack register \{ mov [pointer$return_stack], register add pointer$return_stack, cell_size \} macro pop_return_stack register \{ sub pointer$return_stack, cell_size mov register, [pointer$return_stack] \} } #+end_src *** pointer :32bit: #+begin_src fasm :tangle cicada-nymph.fasm match =32bit, machine { pointer$return_stack: xx address$return_stack } #+end_src *** push & pop :32bit: #+begin_src fasm :tangle cicada-nymph.fasm match =32bit, machine { macro push_return_stack register \{ if register in push ebx mov ebx, [pointer$return_stack] mov [ebx], register add ebx, cell_size mov [pointer$return_stack], ebx pop ebx else push eax mov eax, [pointer$return_stack] mov [eax], register add eax, cell_size mov [pointer$return_stack], eax pop eax finish if \} macro pop_return_stack register \{ if register in push ebx mov ebx, [pointer$return_stack] sub ebx, cell_size mov register, [ebx] mov [pointer$return_stack], ebx pop ebx else push eax mov eax, [pointer$return_stack] sub eax, cell_size mov register, [eax] mov [pointer$return_stack], eax pop eax finish if \} } #+end_src * next *** macro next #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { macro next \{ pop_return_stack rbx mov rax, [rbx] add rbx, cell_size push_return_stack rbx jmp qword [rax] \} } match =32bit, machine { macro next \{ pop_return_stack rbx mov rax, [rbx] add rbx, cell_size push_return_stack rbx jmp dword [rax] \} } #+end_src *** note play with jo & jojo 1. at the beginning * argument-stack << 2 >> * return-stack #+begin_src return-stack - [@][@][ (square) ] (square) (end) #+end_src 2. next * argument-stack << 2 >> * return-stack #+begin_src return-stack (square) - [@][@][ (square) ] - [@][@][ (dup) ] (end) (mul) (end) #+end_src 3. next * argument-stack << 2, 2 >> * return-stack #+begin_src return-stack (square) (dup) - [@][@][ (square) ] - [@][@][ (mul) ] (end) (end) #+end_src 4. next * argument-stack << 4 >> * return-stack #+begin_src return-stack (dup) (square) (mul) - [@][@][ (square) ] - [@][@][ (end) ] (end) #+end_src 5. next * argument-stack << 4 >> * return-stack #+begin_src return-stack (square) (square) - [@][@][ (end) ] - [@][@][ (dup) ] (mul) (end) #+end_src 6. next * argument-stack << 4, 4 >> * return-stack #+begin_src return-stack (square) (square) (dup) - [@][@][ (end) ] - [@][@][ (mul) ] (end) #+end_src 7. next * argument-stack << 16 >> * return-stack #+begin_src return-stack (square) (dup) (square) (mul) - [@][@][ (end) ] - [@][@][ (end) ] #+end_src 8. next * argument-stack << 16 >> * return-stack #+begin_src return-stack (square) (square) - [@][@][ (end) ] #+end_src 9. next * argument-stack << 16 >> * return-stack #+begin_src return-stack - [ ] #+end_src 10. it is really simple ^-^ is it not ? * function-jo *** note jo * jo as data-structure |----+----------------| | | length | | jo | explainer | | | body | |----+----------------| * the body for * primitive-function-jo assembly code * function-jo jojo * variable-jo value-list *** offset of jo #+begin_src fasm :tangle cicada-nymph.fasm offset__jo$other = - (cell_size * 2) offset__jo$length = - (cell_size * 1) offset__jo$body = (cell_size * 1) #+end_src *** note link * link as data-structure |------+----------------| | link | link | |------+----------------| | | jo | | | string-address | | | string-length | |------+----------------| * if the link field of a link is 0 the link is the last-link *** offset of link #+begin_src fasm :tangle cicada-nymph.fasm offset__link$jo = (cell_size * 1) offset__link$string_address = (cell_size * 2) offset__link$string_length = (cell_size * 3) #+end_src *** null link #+begin_src fasm :tangle cicada-nymph.fasm ;; initial link to point to 0 (as null) link = 0 #+end_src *** *string-area* ***** memory allocation #+begin_src fasm :tangle cicada-nymph.fasm address$string_area: times 64 * 1024 db 0 address$core_file: file "core/core.cn" end$core_file: end$string_area: current_free_address$string_area = address$string_area #+end_src ***** ASSEMBLY__length_string #+begin_src fasm :tangle cicada-nymph.fasm macro ASSEMBLY__length_string string { virtual at 0 .start$string: db string .end$string: dw (.end$string - .start$string) load .length word from (.end$string) finish virtual } #+end_src ***** ASSEMBLY__make_string * note that the following is using local label #+begin_src fasm :tangle cicada-nymph.fasm macro ASSEMBLY__make_string string { repeat .length virtual at 0 db string load .char byte from (% - 1) finish virtual store byte .char at (current_free_address$string_area) current_free_address$string_area = current_free_address$string_area + 1 finish repeat store byte 0 at (current_free_address$string_area) current_free_address$string_area = current_free_address$string_area + 1 } #+end_src *** note * note that after a "next" "jmp" to a explainer the "rax" stores the value of the jo to be explained so "rax" is used as an inexplicit argument of the following functions * explain$function is used as jojo-head and explains the meaning of the jojo as function * a jojo-head identifies one type of jo *** define_function #+begin_src fasm :tangle cicada-nymph.fasm macro define_function string, jo { link__#jo: xx link link = link__#jo xx jo ASSEMBLY__length_string string .address = current_free_address$string_area xx .address xx .length ASSEMBLY__make_string string ;; xx (end__#jo - jo)/cell_size xx 0 jo: xx explain$function ;; here follows a jojo as function-body } #+end_src *** explain$function * push the jojo of a jo to return-stack * a jojo can not be of size 0 * use rax as an argument which stores a jo #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { explain$function: mov rbx, pointer$return_stack sub rbx, address$return_stack test rbx, unit__return_point jz .return_stack_even mov rbx, [V__local_memory_odd__current_free_address + cell_size] push_return_stack rbx mov rbx, [V__local_memory_even__current_free_address + cell_size] push_return_stack rbx mov rbx, [local_variable$current_free_address] push_return_stack rbx add rax, cell_size push_return_stack rax next .return_stack_even: mov rbx, [V__local_memory_even__current_free_address + cell_size] push_return_stack rbx mov rbx, [V__local_memory_odd__current_free_address + cell_size] push_return_stack rbx mov rbx, [local_variable$current_free_address] push_return_stack rbx add rax, cell_size push_return_stack rax next } match =32bit, machine { explain$function: mov rbx, [pointer$return_stack] sub rbx, address$return_stack test rbx, unit__return_point jz .return_stack_even mov rbx, [V__local_memory_odd__current_free_address + cell_size] push_return_stack rbx mov rbx, [V__local_memory_even__current_free_address + cell_size] push_return_stack rbx mov rbx, [local_variable$current_free_address] push_return_stack rbx add rax, cell_size push_return_stack rax next .return_stack_even: mov rbx, [V__local_memory_even__current_free_address + cell_size] push_return_stack rbx mov rbx, [V__local_memory_odd__current_free_address + cell_size] push_return_stack rbx mov rbx, [local_variable$current_free_address] push_return_stack rbx add rax, cell_size push_return_stack rax next } #+end_src * primitive-function-jo *** note * primitive functions are special they explain themself and their type is not identified by jojo-head *** define_primitive_function #+begin_src fasm :tangle cicada-nymph.fasm macro define_primitive_function string, jo { link__#jo: xx link link = link__#jo xx jo ASSEMBLY__length_string string .address = current_free_address$string_area xx .address xx .length ASSEMBLY__make_string string ;; xx (end__#jo - jo) xx 0 jo: xx assembly_code__#jo assembly_code__#jo: ;; here follows assembly code ;; as primitive function body } #+end_src * variable-jo *** note * no constant only variable * when a variable jo in the jojo it push the value of the variable to argument_stack * when wish to change a variable's value use key_word "address" to get the address of the variable *** define_variable #+begin_src fasm :tangle cicada-nymph.fasm macro define_variable string, jo { link__#jo: xx link link = link__#jo xx jo ASSEMBLY__length_string string .address = current_free_address$string_area xx .address xx .length ASSEMBLY__make_string string ;; length xx 1 jo: xx explain$variable ;; here follows a value of cell_size ;; only one value is allowed } #+end_src *** explain$variable :64bit: * in memory | value-1 | | ... | | value-n | #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { explain$variable: mov rcx, [rax + offset__jo$length] add rax, cell_size .loop: mov rdx, qword [rax] push_argument_stack rdx add rax, cell_size loop .loop next } #+end_src *** explain$variable :32bit: * in memory | value-1 | | ... | | value-n | #+begin_src fasm :tangle cicada-nymph.fasm match =32bit, machine { explain$variable: mov rcx, [rax + offset__jo$length] add rax, cell_size .loop: mov rdx, dword [rax] push_argument_stack rdx add rax, cell_size loop .loop next } #+end_src * jo *** apply #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "apply", apply ;; << jo -- unknown >> pop_argument_stack rax jmp qword [rax] } match =32bit, machine { define_primitive_function "apply", apply ;; << jo -- unknown >> pop_argument_stack eax jmp dword [eax] } #+end_src *** *cell-size* #+begin_src fasm :tangle cicada-nymph.fasm define_variable "*cell-size*", V__cell_size xx cell_size #+end_src *** jo->explainer * the type of primitive function jo is encoded by 0 * other types of jo are encoded by their explainers #+begin_src fasm :tangle cicada-nymph.fasm define_function "jo->explainer", jo_to_explainer ;; << jo -- type >> xx dup xx dup, get xx swap, subtraction, literal, cell_size, equal?, false?branch, 4 xx drop, zero xx end xx get xx end #+end_src *** jo->length #+begin_src fasm :tangle cicada-nymph.fasm define_function "jo->length", jo_to_length ;; << jo -- length >> xx literal, offset__jo$length, addition xx get xx end #+end_src *** jo,set-length #+begin_src fasm :tangle cicada-nymph.fasm define_function "jo,set-length", jo__set_length ;; << length, jo -- >> xx literal, offset__jo$length, addition xx set xx end #+end_src *** jo->body #+begin_src fasm :tangle cicada-nymph.fasm define_function "jo->body", jo_to_body ;; << jo -- body >> xx literal, offset__jo$body xx addition xx end #+end_src *** primitive-function-jo? #+begin_src fasm :tangle cicada-nymph.fasm define_function "primitive-function-jo?", primitive_function_jo? ;; << jo -- bool >> xx jo_to_explainer xx zero? xx end #+end_src *** function-jo? #+begin_src fasm :tangle cicada-nymph.fasm define_function "function-jo?", function_jo? ;; << jo -- bool >> xx jo_to_explainer xx literal, explain$function xx equal? xx end #+end_src *** variable-jo? #+begin_src fasm :tangle cicada-nymph.fasm define_function "variable-jo?", variable_jo? ;; << jo -- bool >> xx jo_to_explainer xx literal, explain$variable xx equal? xx end #+end_src *** variable-jo->address #+begin_src fasm :tangle cicada-nymph.fasm define_function "variable-jo->address", variable_jo_to_address ;; << jo -- body >> xx literal, offset__jo$body xx addition xx end #+end_src * string-area *** note interface * the interface of string-area is not good one can NOT use n-get and n-set to get and set value from the address *** *string-area* #+begin_src fasm :tangle cicada-nymph.fasm define_variable "*string-area*", V__string_area xx address$string_area define_variable "*string-area,size*", V__string_area__size xx (end$string_area - address$string_area) ;; *string-area,current-free-address* ;; is at epilog #+end_src *** string-area,stay #+begin_src fasm :tangle cicada-nymph.fasm define_function "string-area,stay", string_area__stay ;; << string[address, length] -- >> xx tuck xx V__string_area__current_free_address xx string_to_buffer! xx address, V__string_area__current_free_address xx add_set xx end #+end_src *** make-string #+begin_src fasm :tangle cicada-nymph.fasm define_function "make-string", make_string ;; << string[address, length] -- string-copy[address, length] >> xx V__string_area__current_free_address xx xxswapx xx tuck xx string_area__stay xx end #+end_src * return-stack *** note return-point * structure | return-point | conjugate-local-memory | | | local-memory | | | local-variable | | | jojo | * the interface is implemented by needs *** offset of return-point #+begin_src fasm :tangle cicada-nymph.fasm offset__return_point$conjugate_local_memory = (cell_size * 0) offset__return_point$local_memory = (cell_size * 1) offset__return_point$local_variable = (cell_size * 2) offset__return_point$jojo = (cell_size * 3) unit__return_point = (cell_size * 4) #+end_src *** return-stack:*unit* #+begin_src fasm :tangle cicada-nymph.fasm define_variable "return-stack:*unit*", V__return_stack__unit xx unit__return_point #+end_src *** 記插珠珠人返回棧到某珠珠的前面 [等效替換法以理解] * 有了下面的 (return-stack:insert-jo) 這個素函數之後即便是在非素函數中也能夠對返回棧進行有限的操作了 * before insert-jo |----------------+--------------------------| | return-point-1 | conjugate-local-memory-1 | | | local-memory-1 | | | local-variable-1 | | | jojo-1 | |----------------+--------------------------| | return-point-2 | conjugate-local-memory-2 | | | local-memory-2 | | | local-variable-2 | | | jojo-2 | |----------------+--------------------------| * after jo return-point-2 (return-stack:insert-jo) |-----------------+--------------------------| | return-point-1 | conjugate-local-memory-1 | | | local-memory-1 | | | local-variable-1 | | | jojo-1 | |-----------------+--------------------------| | return-point-in | conjugate-local-memory-2 | | | local-memory-2 | | | local-variable-2 | | | jojo of jo | |-----------------+--------------------------| | return-point-no | local-memory-2 | | | conjugate-local-memory-2 | | | local-variable-2 | | | jojo of nothing | |-----------------+--------------------------| | return-point-2 | conjugate-local-memory-2 | | | local-memory-2 | | | local-variable-2 | | | jojo-2 | |-----------------+--------------------------| * 之所以有這樣的效果是因爲這個素函數是爲了實現 expect 而作它可能不具有一般性這要看能不能在被插入的珠珠中使用局部變元答案看來是肯定的但是這想來並不合理爲什麼我能夠隨意在返回棧中插入珠珠並且還能在這個珠珠中使用局部變元呢下面的考慮方式能夠讓人放心即返回棧中的各個返回點是在展開函數體的過程中用以記錄調用子函數之後應該返回的地址的其中返回點的序關係記錄了函數之間的調用關係 (1) 調用 (2) 因而 (1) 在 (2) 之前然而插入而得的效果 (1) (in) (2) 並不是 (1) 調用 (in) 調用 (2) (in) 與周圍的兩個函數之間並沒有調用關係但是我可以假想出等效的調用關係 [等效替換法或等量代換法] 即插入而得的效果 (1) (in) (2) 可以被想爲是 (1) 調用 (in) (in) 調用 (2) 並且 (in) 在調用 (2) 之前沒有使用局部數據區域來爲任何局部變元分配空間 * 上面的討論就證明了這種實現方式性質良好 *** nothing #+begin_src fasm :tangle cicada-nymph.fasm define_function "nothing", nothing xx end #+end_src *** return-stack:insert-jo * 先在個循環中複製 return-stack 之後的部分以空出一個位置然後把 jo 插入到空位 #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "return-stack:insert-jo", return_stack__insert_jo ;; << jo, return-stack-pointer -- >> pop_argument_stack rbx mov rsi, pointer$return_stack add pointer$return_stack, (cell_size * 4 * 2) mov rdi, pointer$return_stack .loop: cmp rbx, rsi je .end sub rsi, cell_size sub rdi, cell_size mov rax, qword [rsi] mov qword [rdi], rax jmp .loop .end: pop_argument_stack rax add rax, cell_size mov qword [rsi + (cell_size * 3)], rax mov rax, qword [rsi + (cell_size * 1)] mov qword [rsi + (cell_size * 4)], rax mov rax, qword [rsi + (cell_size * 0)] mov qword [rsi + (cell_size * 5)], rax mov rax, qword [rsi + (cell_size * 2)] mov qword [rsi + (cell_size * 6)], rax mov rax, nothing + cell_size mov qword [rsi + (cell_size * 7)], rax next } match =32bit, machine { define_primitive_function "return-stack:insert-jo", return_stack__insert_jo ;; << jo, return-stack-pointer -- >> pop_argument_stack rbx mov rcx, [pointer$return_stack] mov rsi, rcx add rcx, (cell_size * 4 * 2) mov rdi, rcx mov [pointer$return_stack], rcx .loop: cmp rbx, rsi je .end sub rsi, cell_size sub rdi, cell_size mov rax, dword [rsi] mov dword [rdi], rax jmp .loop .end: pop_argument_stack rax add rax, cell_size mov dword [rsi + (cell_size * 3)], rax mov rax, dword [rsi + (cell_size * 1)] mov dword [rsi + (cell_size * 4)], rax mov rax, dword [rsi + (cell_size * 0)] mov dword [rsi + (cell_size * 5)], rax mov rax, dword [rsi + (cell_size * 2)] mov dword [rsi + (cell_size * 6)], rax mov rax, nothing + cell_size mov dword [rsi + (cell_size * 7)], rax next } #+end_src *** get-return-stack-pointer #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "get-return-stack-pointer", get_return_stack_pointer push_argument_stack pointer$return_stack next } match =32bit, machine { define_primitive_function "get-return-stack-pointer", get_return_stack_pointer mov rax, [pointer$return_stack] push_argument_stack rax next } #+end_src *** apply-with-return-point #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "apply-with-return-point", apply_with_return_point ;; << return-point, function -- >> pop_argument_stack rax pop_argument_stack rbx mov pointer$return_stack, rbx jmp qword [rax] } match =32bit, machine { define_primitive_function "apply-with-return-point", apply_with_return_point ;; << return-point, function -- >> pop_argument_stack rax pop_argument_stack rbx mov [pointer$return_stack], rbx jmp dword [rax] } #+end_src * end & tail-call *** end #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "end", end mov rax, pointer$return_stack sub rax, address$return_stack test rax, unit__return_point jnz .return_stack_even pop_return_stack rbx pop_return_stack rax mov [local_variable$current_free_address], rax pop_return_stack rax pop_return_stack rax mov [V__local_memory_odd__current_free_address + cell_size], rax next .return_stack_even: pop_return_stack rbx pop_return_stack rax mov [local_variable$current_free_address], rax pop_return_stack rax pop_return_stack rax mov [V__local_memory_even__current_free_address + cell_size], rax next } match =32bit, machine { define_primitive_function "end", end mov rax, [pointer$return_stack] sub rax, address$return_stack test rax, unit__return_point jnz .return_stack_even pop_return_stack rbx pop_return_stack rax mov [local_variable$current_free_address], rax pop_return_stack rax pop_return_stack rax mov [V__local_memory_odd__current_free_address + cell_size], rax next .return_stack_even: pop_return_stack rbx pop_return_stack rax mov [local_variable$current_free_address], rax pop_return_stack rax pop_return_stack rax mov [V__local_memory_even__current_free_address + cell_size], rax next } #+end_src *** tail-call * tail-call #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "tail-call", tail_call mov rax, pointer$return_stack sub rax, address$return_stack test rax, unit__return_point jnz .return_stack_even pop_return_stack rbx pop_return_stack rax mov [local_variable$current_free_address], rax pop_return_stack rax pop_return_stack rax mov [V__local_memory_odd__current_free_address + cell_size], rax mov rax, [rbx] jmp qword [rax] .return_stack_even: pop_return_stack rbx pop_return_stack rax mov [local_variable$current_free_address], rax pop_return_stack rax pop_return_stack rax mov [V__local_memory_even__current_free_address + cell_size], rax mov rax, [rbx] jmp qword [rax] } match =32bit, machine { define_primitive_function "tail-call", tail_call mov rax, [pointer$return_stack] sub rax, address$return_stack test rax, unit__return_point jnz .return_stack_even pop_return_stack rbx pop_return_stack rax mov [local_variable$current_free_address], rax pop_return_stack rax pop_return_stack rax mov [V__local_memory_odd__current_free_address + cell_size], rax mov rax, [rbx] jmp dword [rax] .return_stack_even: pop_return_stack rbx pop_return_stack rax mov [local_variable$current_free_address], rax pop_return_stack rax pop_return_stack rax mov [V__local_memory_even__current_free_address + cell_size], rax mov rax, [rbx] jmp dword [rax] } #+end_src *** note explicit tail call in action 1. the tail position of a function body must be recognized explicit tail call is used to achieve this 2. thus tail-recursive-call can be use to do loop without pushing too many address into return-stack 3. for example if we have a function which is called "example" #+begin_src fasm define_function "example", example xx fun1 xx fun2 xx tail_call, example #+end_src 4. and we have the following jojo in return-stack #+begin_src return-stack - [@][@][ (example) ] (end) #+end_src 5. next #+begin_src return-stack (example) - [@][@][ (end) ] - [@][@][ (fun1) ] (fun2) (tail-call) (example) #+end_src 6. next #+begin_src return-stack (example) (fun1) - [@][@][ (end) ] - [@][@][ (fun2) ] (tail-call) (example) #+end_src 7. next #+begin_src return-stack (fun1) (example) (fun2) - [@][@][ (end) ] - [@][@][ (tail-call) ] (example) #+end_src 8. next by the definition of tail_call #+begin_src return-stack (example) - [@][@][ (end) ] - [@][@][ (fun1) ] (fun2) (tail-call) (example) #+end_src 9. you can see return-stack of (8.) is the same as (5.) it is clear how the example function is actually a loop now * helper function in assembly code *** __exit_with_tos :linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =64bit, platform machine { __exit_with_tos: ;; << exit-code -- >> pop_argument_stack linux64_sys_1_rdi mov linux64_sys_n_rax, linux64_syscall_exit syscall } match =linux =32bit, platform machine { __exit_with_tos: ;; << exit-code -- >> pop_argument_stack linux32_sys_1_ebx mov linux32_sys_n_eax, linux32_syscall_exit syscall } #+end_src *** __exit_with_zero :linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =64bit, platform machine { __exit_with_zero: ;; << -- >> xor linux64_sys_1_rdi, linux64_sys_1_rdi mov linux64_sys_n_rax, linux64_syscall_exit syscall } match =linux =32bit, platform machine { __exit_with_zero: ;; << -- >> xor linux32_sys_1_ebx, linux32_sys_1_ebx mov linux32_sys_n_eax, linux32_syscall_exit syscall } #+end_src *** __exit_with_six :linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =64bit, platform machine { __exit_with_six: ;; << -- >> mov linux64_sys_1_rdi, 6 mov linux64_sys_n_rax, linux64_syscall_exit syscall } match =linux =32bit, platform machine { __exit_with_six: ;; << -- >> mov linux32_sys_1_ebx, 6 mov linux32_sys_n_eax, linux32_syscall_exit syscall } #+end_src *** __write_string :linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =64bit, platform machine { __write_string: ;; << address, length -- >> pop_argument_stack linux64_sys_3_rdx ;; max length to be write pop_argument_stack linux64_sys_2_rsi ;; address mov linux64_sys_1_rdi, 1 ;; stdout mov linux64_sys_n_rax, linux64_syscall_write syscall ret } match =linux =32bit, platform machine { __write_string: ;; << address, length -- >> pop_argument_stack linux32_sys_3_edx ;; max length to be write pop_argument_stack linux32_sys_2_ecx ;; address mov linux32_sys_1_ebx, 1 ;; stdout mov linux32_sys_n_eax, linux32_syscall_write syscall ret } #+end_src *** __reset_argument_stack :linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =64bit, platform machine { __reset_argument_stack: ;; << -- >> mov pointer$argument_stack, address$argument_stack ret } match =linux =32bit, platform machine { __reset_argument_stack: ;; << -- >> mov rax, address$argument_stack mov [pointer$argument_stack], rax ret } #+end_src *** __reset_return_stack :linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =64bit, platform machine { __reset_return_stack: ;; << -- >> mov pointer$return_stack, address$return_stack ret } match =linux =32bit, platform machine { __reset_return_stack: ;; << -- >> mov rax, address$return_stack mov [pointer$return_stack], rax ret } #+end_src *** __reset_syntax_stack :linux: #+begin_src fasm :tangle cicada-nymph.fasm __reset_syntax_stack: ;; << -- >> mov rax, address$syntax_stack mov [V__syntax_stack__pointer + cell_size], rax ret #+end_src *** __reset_local_variable #+begin_src fasm :tangle cicada-nymph.fasm __reset_local_variable: ;; << -- >> mov rax, address$local_variable mov [local_variable$current_free_address], rax ret #+end_src *** __reset_local_memory #+begin_src fasm :tangle cicada-nymph.fasm __reset_local_memory: ;; << -- >> mov rax, address$local_memory_even mov [V__local_memory_even__current_free_address + cell_size], rax mov rax, address$local_memory_odd mov [V__local_memory_odd__current_free_address + cell_size], rax ret #+end_src * *the-story-begin* *** 記匯編代碼中的初始化 * 注意所入返回棧的應該是 jojo 而不是 jo *** begin_to_interpret_threaded_code :linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux, platform { begin_to_interpret_threaded_code: cld ;; set DF = 0, then rsi and rdi are incremented call __reset_argument_stack call __reset_return_stack pop_return_stack rax pop_return_stack rax pop_return_stack rax pop_return_stack rax mov rax, address$local_memory_odd push_return_stack rax mov rax, address$local_memory_even push_return_stack rax mov rax, address$local_variable push_return_stack rax mov rax, jojo_for__report_return_stack_is_empty_and_exit push_return_stack rax mov rax, address$local_memory_even push_return_stack rax mov rax, address$local_memory_odd push_return_stack rax mov rax, address$local_variable push_return_stack rax mov rax, first_jojo push_return_stack rax next first_jojo: ;; xx little_test xx initialization xx load_core_file xx tail_call, basic_REPL } #+end_src *** initialization #+begin_src fasm :tangle cicada-nymph.fasm define_function "initialization", initialization ;; << -- >> xx init__syntax_rule_set__jojo_compiler xx end #+end_src *** note top-level-REPL * a top-level-REPL always lives at the bottom of return-stack #+begin_src return-stack (function) (function) - [@][@][ (tail-call) ] (top-level-REPL) #+end_src * right below the return-stack there is a (report-return-stack-is-empty-and-exit) so actually #+begin_src return-stack (function) (function) - [ (report-return-stack-is-empty-and-exit) ] - [@][@][ (tail-call) ] (top-level-REPL) #+end_src * when you say bye to a top-level-REPL (report-return-stack-is-empty-and-exit) will be executed *** report-return-stack-is-empty-and-exit #+begin_src fasm :tangle cicada-nymph.fasm string$report_return_stack_is_empty_and_exit: db "* the return-stack is empty now", 10 db " good bye ^-^/", 10 .end: length$report_return_stack_is_empty_and_exit = (.end - string$report_return_stack_is_empty_and_exit) define_primitive_function "report-return-stack-is-empty-and-exit", report_return_stack_is_empty_and_exit ;; << -- >> mov rax, string$report_return_stack_is_empty_and_exit mov rcx, length$report_return_stack_is_empty_and_exit push_argument_stack rax push_argument_stack rcx call __write_string call __exit_with_zero jojo_for__report_return_stack_is_empty_and_exit: xx report_return_stack_is_empty_and_exit #+end_src *** reset-top-level-REPL * local_variable & local_memory will get reseted in by this function #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "reset-top-level-REPL", reset_top_level_REPL ;; << top_level_REPL [jo] -- >> call __reset_return_stack call __reset_syntax_stack call __reset_local_variable call __reset_local_memory pop_argument_stack rax jmp qword [rax] } match =32bit, machine { define_primitive_function "reset-top-level-REPL", reset_top_level_REPL ;; << top_level_REPL [jo] -- >> call __reset_return_stack call __reset_syntax_stack call __reset_local_variable call __reset_local_memory pop_argument_stack rax jmp dword [rax] } #+end_src *** exit_with_tos a.k.a. bye #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "bye", exit_with_tos call __exit_with_tos #+end_src *** little_test #+begin_src fasm :tangle cicada-nymph.fasm define_variable "", V__little_test_number xx 3 define_function "little_test", little_test ;;;; variable ;; xx V__little_test_number ;; xx exit_with_tos ;;;; exit ocde : 3 ;;;; literal ;; xx literal, 4 ;; xx exit_with_tos ;;;; exit ocde : 4 ;;;; address ;; xx address, V__little_test_number, get, add2 ;; xx address, V__little_test_number, set ;; xx V__little_test_number ;; xx exit_with_tos ;;;; exit ocde : 5 ;;;; end ;; xx literal, 2, negate ;; xx literal, 8 ;; xx addition ;; xx exit_with_tos ;;;; 6 ;;;; tail_call ;; xx literal, 2 ;; xx literal, 4 ;; xx power ;; xx exit_with_tos ;;;; exit ocde : 16 ;;;; write_byte ;; xx literal, 64, write_byte ;; xx literal, 10, write_byte ;; xx zero ;; xx exit_with_tos ;;;; @ ;;;; read_byte ;; xx read_byte, write_byte ;; xx exit_with_tos ;;;; ;;;; branch ;; xx read_byte, write_byte ;; xx branch, -3 ;;;; read a string that ended by ;;;; write the readed string ;;;; or we can say ;;;; read line and write line ;;;; or we can say ;;;; echo line ;;;; false?branch ;; xx false, false?branch, 9 ;; xx literal, 64, write_byte ;; xx literal, 10, write_byte ;; xx zero ;; xx exit_with_tos ;; xx true, false?branch, 9 ;; xx literal, 65, write_byte ;; xx literal, 10, write_byte ;; xx zero ;; xx exit_with_tos ;; xx zero ;; xx exit_with_tos ;;;; A ;;;; read_word & write_string ;; xx read_word, write_string ;; xx literal, 10, write_byte ;; xx read_word, write_string ;; xx literal, 10, write_byte ;; xx zero ;; xx exit_with_tos ;;;; read line ;;;; write first two words of the line ;;;; string->integer ;; xx read_word, string_to_integer ;; xx exit_with_tos ;;;; type 123 ;;;; exit code 123 ;;;; xxoverxx ;; xx literal, 1 ;; xx literal, 2 ;; xx literal, 3 ;; xx literal, 4 ;; xx xxoverxx ;; xx pretty_write_integer ;; xx pretty_write_integer ;; xx pretty_write_integer ;; xx pretty_write_integer ;; xx pretty_write_integer ;; xx pretty_write_integer ;; xx zero ;; xx exit_with_tos ;;;; 2 1 4 3 2 1 ;;;; find_link ;; xx read_word, string_to_integer ;; number ;; xx read_word, string_to_integer ;; number ;; xx read_word, V__link, find_link ;; add ;; xx drop ;; true ;; xx link_to_jo ;; xx apply ;; xx write_integer ;; xx zero ;; xx exit_with_tos ;;;; 1 2 add ;;;; print "3" ;;;; basic-REPL (without the ability to define function) ;;;; after this test ;;;; we will use basic-REPL to do further tests ;; xx basic_REPL ;;;; 1 2 add . #+end_src * instruction *** note side-effect * an instruction is a special primitive function which does special side-effect on return-stack * note that side-effect on return-stack should all be done in primitive functions *** note naming * the naming convention in assembly code of instruction is the same as it of jo *** instruction,literal #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "instruction,literal", literal ;; << -- fixnum >> pop_return_stack rbx mov rax, [rbx] push_argument_stack rax add rbx, cell_size push_return_stack rbx next #+end_src *** instruction,address #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "instruction,address", address ;; << -- address >> pop_return_stack rbx mov rax, [rbx] add rax, cell_size push_argument_stack rax add rbx, cell_size push_return_stack rbx next #+end_src *** instruction,branch #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "instruction,branch", branch pop_return_stack rbx mov rax, [rbx] imul rax, cell_size add rbx, rax push_return_stack rbx next #+end_src *** instruction,false?branch #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "instruction,false?branch", false?branch ;; << true of false -- >> pop_argument_stack rax test rax, rax jnz help__false?branch__not_to_branch pop_return_stack rbx mov rax, [rbx] imul rax, cell_size add rbx, rax push_return_stack rbx next help__false?branch__not_to_branch: pop_return_stack rbx add rbx, cell_size push_return_stack rbx next #+end_src * the stack *** note * the stack is the argument-stack *** drop #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "drop", drop ;; << a -- >> pop_argument_stack rax next define_primitive_function "drop2", drop2 ;; << a b -- >> pop_argument_stack rax pop_argument_stack rax next #+end_src *** dup :64bit: #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "dup", dup ;; << a -- a, a >> mov rax, [pointer$argument_stack - (1 * cell_size)] push_argument_stack rax next define_primitive_function "dup2", dup2 ;; << a b -- a b a b >> mov rbx, [pointer$argument_stack - (1 * cell_size)] mov rax, [pointer$argument_stack - (2 * cell_size)] push_argument_stack rax push_argument_stack rbx next } #+end_src *** dup :32bit: #+begin_src fasm :tangle cicada-nymph.fasm match =32bit, machine { define_primitive_function "dup", dup ;; << a -- a a >> pop_argument_stack rax push_argument_stack rax push_argument_stack rax next define_primitive_function "dup2", dup2 ;; << a b -- a b a b >> pop_argument_stack rbx pop_argument_stack rax push_argument_stack rax push_argument_stack rbx push_argument_stack rax push_argument_stack rbx next } #+end_src *** over :64bit: #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "over", over ;; << a b -- a b | a >> mov rax, [pointer$argument_stack - (2 * cell_size)] push_argument_stack rax next define_primitive_function "x|over|xx", xoverxx ;; << a | b c -- a | b c | a >> mov rax, [pointer$argument_stack - (3 * cell_size)] push_argument_stack rax next define_primitive_function "xx|over|x", xxoverx ;; << a b | c -- a b | c | a b >> mov rax, [pointer$argument_stack - (3 * cell_size)] push_argument_stack rax mov rax, [pointer$argument_stack - (3 * cell_size)] push_argument_stack rax next define_primitive_function "xx|over|xx", xxoverxx ;; << a b | c d -- a b | c d | a b >> mov rax, [pointer$argument_stack - (4 * cell_size)] push_argument_stack rax mov rax, [pointer$argument_stack - (4 * cell_size)] push_argument_stack rax next define_primitive_function "x|over|xxx", xoverxxx ;; << a | b c d -- a | b c d | a >> mov rax, [pointer$argument_stack - (4 * cell_size)] push_argument_stack rax next define_primitive_function "x|over|xxxx", xoverxxxx ;; << a | b c d -- a | b c d | a >> mov rax, [pointer$argument_stack - (5 * cell_size)] push_argument_stack rax next define_primitive_function "xx|over|xxxx", xxoverxxxx ;; << a b | c d e f -- a b | c d e f | a b >> mov rax, [pointer$argument_stack - (6 * cell_size)] push_argument_stack rax mov rax, [pointer$argument_stack - (6 * cell_size)] push_argument_stack rax next } #+end_src *** over :32bit: #+begin_src fasm :tangle cicada-nymph.fasm match =32bit, machine { define_primitive_function "over", over ;; << a b -- a b | a >> mov rbx, [pointer$argument_stack] mov rax, [rbx - (2 * cell_size)] push_argument_stack rax next define_primitive_function "x|over|xx", xoverxx ;; << a | b c -- a | b c | a >> mov rbx, [pointer$argument_stack] mov rax, [rbx - (3 * cell_size)] push_argument_stack rax next define_primitive_function "xx|over|x", xxoverx ;; << a b | c -- a b | c | a b >> mov rbx, [pointer$argument_stack] mov rax, [rbx - (3 * cell_size)] push_argument_stack rax mov rax, [rbx - (2 * cell_size)] push_argument_stack rax next define_primitive_function "xx|over|xx", xxoverxx ;; << a b | c d -- a b | c d | a b >> mov rbx, [pointer$argument_stack] mov rax, [rbx - (4 * cell_size)] push_argument_stack rax mov rax, [rbx - (3 * cell_size)] push_argument_stack rax next define_primitive_function "x|over|xxx", xoverxxx ;; << a | b c d -- a | b c d | a >> mov rbx, [pointer$argument_stack] mov rax, [rbx - (4 * cell_size)] push_argument_stack rax next define_primitive_function "x|over|xxxx", xoverxxxx ;; << a | b c d -- a | b c d | a >> mov rbx, [pointer$argument_stack] mov rax, [rbx - (5 * cell_size)] push_argument_stack rax next define_primitive_function "xx|over|xxxx", xxoverxxxx ;; << a b | c d e f -- a b | c d e f | a b >> mov rbx, [pointer$argument_stack] mov rax, [rbx - (6 * cell_size)] push_argument_stack rax mov rax, [rbx - (5 * cell_size)] push_argument_stack rax next } #+end_src *** tuck #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "tuck", tuck ;; << a b -- b | a b >> pop_argument_stack rbx pop_argument_stack rax push_argument_stack rbx push_argument_stack rax push_argument_stack rbx next define_primitive_function "x|tuck|xx", xtuckxx ;; << a | b c -- b c | a | b c >> pop_argument_stack rcx pop_argument_stack rbx pop_argument_stack rax push_argument_stack rbx push_argument_stack rcx push_argument_stack rax push_argument_stack rbx push_argument_stack rcx next define_primitive_function "xx|tuck|x", xxtuckx ;; << a b | c -- c | a b | c >> pop_argument_stack rcx pop_argument_stack rbx pop_argument_stack rax push_argument_stack rcx push_argument_stack rax push_argument_stack rbx push_argument_stack rcx next define_primitive_function "xx|tuck|xx", xxtuckxx ;; << a b | c d -- c d | a b | c d >> pop_argument_stack rdx pop_argument_stack rcx pop_argument_stack rbx pop_argument_stack rax push_argument_stack rcx push_argument_stack rdx push_argument_stack rax push_argument_stack rbx push_argument_stack rcx push_argument_stack rdx next define_primitive_function "xxx|tuck|x", xxxtuckx ;; << a b c | d -- d | a b c | d >> pop_argument_stack rdx pop_argument_stack rcx pop_argument_stack rbx pop_argument_stack rax push_argument_stack rdx push_argument_stack rax push_argument_stack rbx push_argument_stack rcx push_argument_stack rdx next define_primitive_function "xxxx|tuck|x", xxxxtuckx ;; << a b c d | e -- e | a b c d | e >> pop_argument_stack rdi ;; e pop_argument_stack rdx pop_argument_stack rcx pop_argument_stack rbx pop_argument_stack rax push_argument_stack rdi ;; e push_argument_stack rax push_argument_stack rbx push_argument_stack rcx push_argument_stack rdx push_argument_stack rdi ;; e next #+end_src *** swap #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "swap", swap ;; << a b -- b a >> pop_argument_stack rbx pop_argument_stack rax push_argument_stack rbx push_argument_stack rax next define_primitive_function "x|swap|xx", xswapxx ;; << a | b c -- b c | a >> pop_argument_stack rcx pop_argument_stack rbx pop_argument_stack rax push_argument_stack rbx push_argument_stack rcx push_argument_stack rax next define_primitive_function "xx|swap|x", xxswapx ;; << a b | c -- c | a b >> pop_argument_stack rcx pop_argument_stack rbx pop_argument_stack rax push_argument_stack rcx push_argument_stack rax push_argument_stack rbx next define_primitive_function "x|swap|xxx", xswapxxx ;; << a | b c d -- b c d | a >> pop_argument_stack rdx pop_argument_stack rcx pop_argument_stack rbx pop_argument_stack rax push_argument_stack rbx push_argument_stack rcx push_argument_stack rdx push_argument_stack rax next define_primitive_function "xxx|swap|x", xxxswapx ;; << a b c | d -- d | a b c >> pop_argument_stack rdx pop_argument_stack rcx pop_argument_stack rbx pop_argument_stack rax push_argument_stack rdx push_argument_stack rax push_argument_stack rbx push_argument_stack rcx next define_primitive_function "xx|swap|xx", xxswapxx ;; << a b | c d -- c d | a b >> pop_argument_stack rdx pop_argument_stack rcx pop_argument_stack rbx pop_argument_stack rax push_argument_stack rcx push_argument_stack rdx push_argument_stack rax push_argument_stack rbx next define_primitive_function "x|swap|xxxx", xswapxxxx ;; << a | b c d e -- b c d e | a >> pop_argument_stack rsi ;; e pop_argument_stack rdx pop_argument_stack rcx pop_argument_stack rbx pop_argument_stack rax push_argument_stack rbx push_argument_stack rcx push_argument_stack rdx push_argument_stack rsi ;; e push_argument_stack rax next define_primitive_function "xxxx|swap|x", xxxxswapx ;; << a b c d | e -- e | a b c d >> pop_argument_stack rsi ;; e pop_argument_stack rdx pop_argument_stack rcx pop_argument_stack rbx pop_argument_stack rax push_argument_stack rsi ;; e push_argument_stack rax push_argument_stack rbx push_argument_stack rcx push_argument_stack rdx next define_primitive_function "xx|swap|xxxx", xxswapxxxx ;; << a b | c d e f -- c d e f | a b >> pop_argument_stack rsi ;; f pop_argument_stack rdi ;; e pop_argument_stack rdx pop_argument_stack rcx pop_argument_stack rbx pop_argument_stack rax push_argument_stack rcx push_argument_stack rdx push_argument_stack rdi ;; e push_argument_stack rsi ;; f push_argument_stack rax push_argument_stack rbx next define_primitive_function "xxxx|swap|xx", xxxxswapxx ;; << a b c d | e f -- e f | a b c d >> pop_argument_stack rsi ;; f pop_argument_stack rdi ;; e pop_argument_stack rdx pop_argument_stack rcx pop_argument_stack rbx pop_argument_stack rax push_argument_stack rdi ;; e push_argument_stack rsi ;; f push_argument_stack rax push_argument_stack rbx push_argument_stack rcx push_argument_stack rdx next #+end_src *** address #+begin_src fasm :tangle cicada-nymph.fasm define_variable "*the-stack*", V__the_stack xx address$argument_stack #+end_src *** pointer #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_variable "*the-stack-pointer-snapshot*", V__the_stack_pointer_snapshot xx address$argument_stack define_primitive_function "snapshot-the-stack-pointer", snapshot_the_stack_pointer ;; << -- >> mov [V__the_stack_pointer_snapshot + cell_size], pointer$argument_stack next } match =32bit, machine { define_variable "*the-stack-pointer-snapshot*", V__the_stack_pointer_snapshot xx address$argument_stack define_primitive_function "snapshot-the-stack-pointer", snapshot_the_stack_pointer ;; << -- >> mov eax, [pointer$argument_stack] mov [V__the_stack_pointer_snapshot + cell_size], eax next } #+end_src *** set-argument-stack-pointer #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "set-argument-stack-pointer", set_argument_stack_pointer ;; << address -- >> pop_argument_stack pointer$argument_stack next } match =32bit, machine { define_primitive_function "set-argument-stack-pointer", set_argument_stack_pointer ;; << address -- >> pop_argument_stack rbx mov [pointer$argument_stack], rbx next } #+end_src * bool *** false & true * they are defined as function and viewed as constant #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "false", false ;; << -- false >> xor rax, rax push_argument_stack rax next define_primitive_function "true", true ;; << -- true >> xor rax, rax inc rax push_argument_stack rax next #+end_src *** false? & true? #+begin_src fasm :tangle cicada-nymph.fasm define_function "false?", false? ;; << bool -- bool >> xx false, equal? xx end define_function "true?", true? ;; << bool -- bool >> xx true, equal? xx end #+end_src *** and & or & not & xor * the following two functions are for bool value #+begin_src fasm :tangle cicada-nymph.fasm define_function "not", CICADA__not ;; << bool -- bool >> xx false, equal? xx end define_function "and", CICADA__and ;; << bool, bool -- bool >> xx false?, false?branch, (.true-$)/cell_size xx drop xx false xx end .true: xx false?branch, 3 xx true xx end xx false xx end define_function "or", CICADA__or ;; << bool, bool -- bool >> xx false?branch, (.false-$)/cell_size xx drop xx true xx end .false: xx false?branch, 3 xx true xx end xx false xx end define_function "xor", CICADA__xor ;; << bool, bool -- bool >> xx false?branch, (.false-$)/cell_size xx CICADA__not xx end .false: xx end #+end_src * fixnum *** zero & one * they are defined as function and viewed as constant #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "zero", zero ;; << -- 0 >> xor rax, rax push_argument_stack rax next define_primitive_function "one", one ;; << -- 1 >> xor rax, rax inc rax push_argument_stack rax next #+end_src *** zero? & one? #+begin_src fasm :tangle cicada-nymph.fasm define_function "zero?", zero? ;; << bool -- bool >> xx zero, equal? xx end define_function "one?", one? ;; << bool -- bool >> xx one, equal? xx end #+end_src *** add & sub :64bit: #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "add1", add1 ;; << n -- n+1 >> inc qword [pointer$argument_stack - (1 * cell_size)] next define_primitive_function "add2", add2 ;; << n -- n+2 >> add qword [pointer$argument_stack - (1 * cell_size)], 2 next define_primitive_function "add3", add3 ;; << n -- n+3 >> add qword [pointer$argument_stack - (1 * cell_size)], 3 next define_primitive_function "add4", add4 ;; << n -- n+4 >> add qword [pointer$argument_stack - (1 * cell_size)], 4 next define_primitive_function "add8", add8 ;; << n -- n+8 >> add qword [pointer$argument_stack - (1 * cell_size)], 8 next define_primitive_function "sub1", sub1 ;; << n -- n-1 >> dec qword [pointer$argument_stack - (1 * cell_size)] next define_primitive_function "sub2", sub2 ;; << n -- n-2 >> sub qword [pointer$argument_stack - (1 * cell_size)], 2 next define_primitive_function "sub3", sub3 ;; << n -- n-3 >> sub qword [pointer$argument_stack - (1 * cell_size)], 3 next define_primitive_function "sub4", sub4 ;; << n -- n-4 >> sub qword [pointer$argument_stack - (1 * cell_size)], 4 next define_primitive_function "sub8", sub8 ;; << n -- n-8 >> sub qword [pointer$argument_stack - (1 * cell_size)], 8 next define_primitive_function "add", addition ;; << a b -- a+b >> pop_argument_stack rax add qword [pointer$argument_stack - (1 * cell_size)], rax next define_primitive_function "sub", subtraction ;; << a b -- a-b >> pop_argument_stack rax sub qword [pointer$argument_stack - (1 * cell_size)], rax next } #+end_src *** add & sub :32bit: #+begin_src fasm :tangle cicada-nymph.fasm match =32bit, machine { define_primitive_function "add1", add1 ;; << n -- n+1 >> pop_argument_stack rax inc rax push_argument_stack rax next define_primitive_function "add2", add2 ;; << n -- n+2 >> pop_argument_stack rax inc rax inc rax push_argument_stack rax next define_primitive_function "add3", add3 ;; << n -- n+3 >> pop_argument_stack rax inc rax inc rax inc rax push_argument_stack rax next define_primitive_function "add4", add4 ;; << n -- n+4 >> pop_argument_stack rax inc rax inc rax inc rax inc rax push_argument_stack rax next define_primitive_function "add8", add8 ;; << n -- n+8 >> pop_argument_stack rax add rax, 8 push_argument_stack rax next define_primitive_function "sub1", sub1 ;; << n -- n-1 >> pop_argument_stack rax dec rax push_argument_stack rax next define_primitive_function "sub2", sub2 ;; << n -- n-2 >> pop_argument_stack rax dec rax dec rax push_argument_stack rax next define_primitive_function "sub3", sub3 ;; << n -- n-3 >> pop_argument_stack rax dec rax dec rax dec rax push_argument_stack rax next define_primitive_function "sub4", sub4 ;; << n -- n-4 >> pop_argument_stack rax dec rax dec rax dec rax dec rax push_argument_stack rax next define_primitive_function "sub8", sub8 ;; << n -- n-8 >> pop_argument_stack rax sub rax, 8 push_argument_stack rax next define_primitive_function "add", addition ;; << a b -- a+b >> pop_argument_stack rbx pop_argument_stack rax add rax, rbx push_argument_stack rax next define_primitive_function "sub", subtraction ;; << a b -- a-b >> pop_argument_stack rbx pop_argument_stack rax sub rax, rbx push_argument_stack rax next } #+end_src *** mul #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "mul", multiple ;; << a b -- a*b >> pop_argument_stack rbx ;; 2ed arg pop_argument_stack rax ;; 1st arg imul rbx, rax ;; imul will ignore overflow ;; when there are two registers as arg ;; imul will set the result into the first register push_argument_stack rbx next #+end_src *** negate #+begin_src fasm :tangle cicada-nymph.fasm define_function "negate", negate ;; << n -- -n >> xx zero xx swap, subtraction xx end #+end_src *** power #+begin_src fasm :tangle cicada-nymph.fasm define_function "power", power ;; n must be nature number for now ;; << a, n -- a^n >> ;; 1. when a = 0, n =/= 0 ;; the power__loop returns 0 ;; 2. when a = 0, n = 0 ;; the power__loop returns 1 ;; but I need it to return 0 xx over, zero?, false?branch, 3 xx drop xx end xx literal, 1, swap ;; leave product xx power__loop xx end define_function "power,loop", power__loop ;; << a, product, n -- a^n >> xx dup, zero?, false?branch, 5 xx drop, swap, drop xx end xx sub1 xx swap xx xoverxx, multiple xx swap xx tail_call, power__loop #+end_src *** div & mod #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "moddiv", moddiv ;; << a, b -- a mod b, quotient >> ;; << dividend, divisor -- remainder, quotient >> ;; the arg of idiv is divisor ;; the lower half of dividend is taken from rax ;; the upper half of dividend is taken from rdx xor rdx, rdx ;; high-part of dividend is not used pop_argument_stack rbx ;; 2ed arg pop_argument_stack rax ;; 1st arg idiv rbx ;; the remainder is stored in rdx ;; the quotient is stored in rax push_argument_stack rdx ;; remainder push_argument_stack rax ;; quotient next define_function "divmod", divmod ;; << a, b -- quotient, a mod b >> xx moddiv, swap xx end define_function "div", division ;; << a, b -- quotient >> xx divmod, drop xx end define_function "mod", modulo ;; << a, b -- a mod b >> xx moddiv, drop xx end #+end_src *** equal? & greater-than? & less-than? #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "equal?", equal? ;; << a, b -- bool >> pop_argument_stack rbx pop_argument_stack rax cmp rbx, rax sete al movzx rax, al push_argument_stack rax next define_primitive_function "less-than?", less_than? pop_argument_stack rbx pop_argument_stack rax cmp rax, rbx setl al movzx rax, al push_argument_stack rax next define_primitive_function "greater-than?", greater_than? pop_argument_stack rbx pop_argument_stack rax cmp rax, rbx setg al movzx rax, al push_argument_stack rax next define_primitive_function "less-or-equal?", less_or_equal? pop_argument_stack rbx pop_argument_stack rax cmp rax, rbx setle al movzx rax, al push_argument_stack rax next define_primitive_function "greater-or-equal?", greater_or_equal? pop_argument_stack rbx pop_argument_stack rax cmp rax, rbx setge al movzx rax, al push_argument_stack rax next #+end_src *** equal2? #+begin_src fasm :tangle cicada-nymph.fasm define_function "equal2?", equal2? ;; << a1, b1, a2, b2 -- bool >> xx xswapxx xx equal?, false?, false?branch, 4 xx drop2, false xx end xx equal? xx end #+end_src *** negative? & positive? #+begin_src fasm :tangle cicada-nymph.fasm define_function "negative?", negative? ;; << integer -- bool >> xx zero, less_than? xx end define_function "positive?", positive? ;; << integer -- bool >> xx zero, greater_than? xx end #+end_src *** within? 0 1 2 3 are within 0 3 #+begin_src fasm :tangle cicada-nymph.fasm define_function "within?", within? ;; << x, a, b -- bool >> xx xoverxx xx greater_or_equal?, CICADA__not, false?branch, 4 xx drop2 xx false xx end xx greater_or_equal? xx end #+end_src *** test #+begin_src cicada-nymph : test,within? << -- >> 0 0 3 within? . 1 0 3 within? . 2 0 3 within? . 3 0 3 within? . .l 4 0 3 within? . -1 0 3 within? . .l end ; define-function test,within? #+end_src * memory *** note get & set * although the following functions are all side-effect but I use "set" instead of "set!" * (get) and (set) default to a cell_size *** note endianness of n-get & n-set * big-endian is used in memory | value-1 | | value-2 | | value-3 | on stack << value-1, value-2, value-3 >> * thus what setd into the address will re-occur when geting through the address * thus I do not implement n-get-byte & n-set-byte for the endianness of machine might not be big-endian *** get :64bit: #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "get", get ;; ( address -- value ) pop_argument_stack rbx mov rax, [rbx] push_argument_stack rax next define_primitive_function "get-byte", get_byte ;; ( address -- value ) pop_argument_stack rbx xor rax, rax mov al, byte[rbx] push_argument_stack rax next define_primitive_function "get-two-bytes", get_two_bytes ;; ( address -- value ) pop_argument_stack rbx xor rax, rax mov ax, word [rbx] push_argument_stack rax next define_primitive_function "get-four-bytes", get_four_bytes ;; ( address -- value ) pop_argument_stack rbx xor rax, rax mov eax, dword [rbx] push_argument_stack rax next define_primitive_function "n-get", n_get ;; << address, n -- value-1, ..., value-n >> pop_argument_stack rcx pop_argument_stack rdx .loop: mov rax, qword [rdx] push_argument_stack rax add rdx, cell_size loop .loop next } #+end_src *** set :64bit: #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "set", set ;; ( value, address -- ) pop_argument_stack rbx pop_argument_stack rax mov [rbx], rax next define_primitive_function "set-byte", set_byte ;; ( value, address -- ) pop_argument_stack rbx pop_argument_stack rax mov byte[rbx], al next define_primitive_function "set-two-bytes", set_two_bytes ;; ( value, address -- ) pop_argument_stack rbx pop_argument_stack rax mov word [rbx], ax next define_primitive_function "set-four-bytes", set_four_bytes ;; ( value, address -- ) pop_argument_stack rbx pop_argument_stack rax mov dword [rbx], eax next define_primitive_function "n-set", n_set ;; << value-n, ..., value-1, address, n -- >> pop_argument_stack rcx pop_argument_stack rdx mov rax, cell_size imul rax, rcx add rdx, rax ;; for address is based on 0 ;; but n is based on 1 sub rdx, cell_size .loop: pop_argument_stack rax mov qword [rdx], rax sub rdx, cell_size loop .loop next define_primitive_function "add-set", add_set ;; ( number to add, address -- ) pop_argument_stack rbx pop_argument_stack rax add qword [rbx], rax next define_primitive_function "sub-set", sub_set ;; ( number to sub, address -- ) pop_argument_stack rbx pop_argument_stack rax sub qword [rbx], rax next } #+end_src *** get :32bit: #+begin_src fasm :tangle cicada-nymph.fasm match =32bit, machine { define_primitive_function "get", get ;; ( address -- value ) pop_argument_stack rbx mov rax, [rbx] push_argument_stack rax next define_primitive_function "get-byte", get_byte ;; ( address -- value ) pop_argument_stack rbx xor rax, rax mov al, byte[rbx] push_argument_stack rax next define_primitive_function "get-two-bytes", get_two_bytes ;; ( address -- value ) pop_argument_stack rbx xor rax, rax mov ax, word [rbx] push_argument_stack rax next define_primitive_function "get-four-bytes", get_four_bytes ;; ( address -- value ) pop_argument_stack rbx xor rax, rax mov eax, dword [rbx] push_argument_stack rax next define_primitive_function "n-get", n_get ;; << address, n -- value-1, ..., value-n >> pop_argument_stack rcx pop_argument_stack rdx .loop: mov rax, dword [rdx] push_argument_stack rax add rdx, cell_size loop .loop next } #+end_src *** set :32bit: #+begin_src fasm :tangle cicada-nymph.fasm match =32bit, machine { define_primitive_function "set", set ;; ( value, address -- ) pop_argument_stack rbx pop_argument_stack rax mov [rbx], rax next define_primitive_function "set-byte", set_byte ;; ( value, address -- ) pop_argument_stack rbx pop_argument_stack rax mov byte[rbx], al next define_primitive_function "set-two-bytes", set_two_bytes ;; ( value, address -- ) pop_argument_stack rbx pop_argument_stack rax mov word [rbx], ax next define_primitive_function "set-four-bytes", set_four_bytes ;; ( value, address -- ) pop_argument_stack rbx pop_argument_stack rax mov dword [rbx], eax next define_primitive_function "n-set", n_set ;; << value-n, ..., value-1, address, n -- >> pop_argument_stack rcx pop_argument_stack rdx mov rax, cell_size imul rax, rcx add rdx, rax ;; for address is based on 0 ;; but n is based on 1 sub rdx, cell_size .loop: pop_argument_stack rax mov dword [rdx], rax sub rdx, cell_size loop .loop next define_primitive_function "add-set", add_set ;; ( number to add, address -- ) pop_argument_stack rbx pop_argument_stack rax add dword [rbx], rax next define_primitive_function "sub-set", sub_set ;; ( number to sub, address -- ) pop_argument_stack rbx pop_argument_stack rax sub dword [rbx], rax next } #+end_src *** clear #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "clear-memory", clear_memory ;; << size, address -- >> pop_argument_stack rdx pop_argument_stack rcx xor rax, rax .loop: mov byte [rdx], al inc rdx dec rcx loop .loop next #+end_src * bit *** note * xor a.k.a. diff *** or & and & xor & invert :64bit: #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "bit-and", bit_and ;; << a, b -- a and b >> pop_argument_stack rbx and [pointer$argument_stack - (1 * cell_size)], rbx next define_primitive_function "bit-or", bit_or ;; << a, b -- a or b >> pop_argument_stack rbx or [pointer$argument_stack - (1 * cell_size)], rbx next define_primitive_function "bit-xor", bit_xor ;; << a, b -- a xor b >> pop_argument_stack rbx xor [pointer$argument_stack - (1 * cell_size)], rbx next define_primitive_function "bit-invert", bit_invert ;; << a -- invert a >> not qword [pointer$argument_stack - (1 * cell_size)] next } #+end_src *** or & and & xor & invert :32bit: #+begin_src fasm :tangle cicada-nymph.fasm match =32bit, machine { define_primitive_function "bit-and", bit_and ;; << a, b -- a and b >> pop_argument_stack rbx mov rax, [pointer$argument_stack] and [rax - (1 * cell_size)], rbx next define_primitive_function "bit-or", bit_or ;; << a, b -- a or b >> pop_argument_stack rbx mov rax, [pointer$argument_stack] or [rax - (1 * cell_size)], rbx next define_primitive_function "bit-xor", bit_xor ;; << a, b -- a xor b >> pop_argument_stack rbx mov rax, [pointer$argument_stack] xor [rax - (1 * cell_size)], rbx next define_primitive_function "bit-invert", bit_invert ;; << a -- invert a >> mov rax, [pointer$argument_stack] not dword [rax - (1 * cell_size)] next } #+end_src *** left & right[,sign] * "shl" shifts the destination operand left by the number of bits specified in the second operand The destination operand can be general register or memory The second operand can be an immediate value or the CL register as bits exit from the left, zeros in from the right The last bit that exited is stored in CF "sal" is a synonym for "shl" #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "bit-left", bit_left ;; ( fixnum, step -- fixnum * 2^step ) pop_argument_stack rcx pop_argument_stack rax shl rax, cl push_argument_stack rax next define_primitive_function "bit-right", bit_right ;; ( fixnum, step -- fixnum / 2^step ) pop_argument_stack rcx pop_argument_stack rax shr rax, cl push_argument_stack rax next define_primitive_function "bit-right,sign", bit_right__sign ;; ( fixnum, step -- new fixnum ) pop_argument_stack rcx pop_argument_stack rax sar rax, cl push_argument_stack rax next #+end_src *** get & set & clear & invert 1. offset is of LSB 2. offset in [0, ..., 63] 3. step in [1, ..., 64] 4. >< need error handling on them #+begin_src fasm :tangle cicada-nymph.fasm ;; BT copies a bit from a given register to the carry flag define_primitive_function "get-bit", get_bit ;; ( fixnum, offset -- bit ) pop_argument_stack rbx pop_argument_stack rax bt rax, rbx setc al movzx rax, al push_argument_stack rax next define_primitive_function "set-bit", set_bit ;; ( fixnum, offset -- fixnum ) pop_argument_stack rbx pop_argument_stack rax bts rax, rbx push_argument_stack rax next define_primitive_function "clear-bit", clear_bit ;; ( fixnum, offset -- fixnum ) pop_argument_stack rbx pop_argument_stack rax btr rax, rbx push_argument_stack rax next define_primitive_function "invert-bit", invert_bit ;; ( fixnum, offset -- fixnum ) pop_argument_stack rbx pop_argument_stack rax btc rax, rbx push_argument_stack rax next #+end_src *** find-[lowest|highest]-set-bit * "bsf" "bsr" instructions scan a word or double word for first set bit and store the index of this bit into destination operand which must be general register The bit string being scanned is specified by source operand it may be either general register or memory The ZF flag is set if the entire string is zero (no set bits are found) otherwise it is cleared * If no set bit is found the value of the destination register is undefined "bsf" scans from low order to high order (starting from bit index zero) "bsr" scans from high order to low order * note that if can not find set-bit the following functions will return -1 #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "find-lowest-set-bit", find_lowest_set_bit ;; ( fixnum -- offset ) pop_argument_stack rax bsf rax, rax jz @f push_argument_stack rax next @@: mov rax, -1 push_argument_stack rax next define_primitive_function "find-highest-set-bit", find_highest_set_bit ;; ( fixnum -- offset ) pop_argument_stack rax bsr rax, rax jz @f push_argument_stack rax next @@: mov rax, -1 push_argument_stack rax next #+end_src *** test * test is written in cicada-nymph for these primitive-functions are added lately #+begin_src cicada-nymph 2#10011001 2#01100110 bit-or .#2 2#10011001 2#01100110 bit-and .#2 2#10011001 2#11111111 bit-xor .#2 2#10011001 2#10011001 bit-xor .#2 2#10011001 4 bit-left .#2 2#10011001 4 bit-right .#2 2#-10011001 4 bit-right,sign .#2 2#10011001 0 get-bit . 2#10011001 1 get-bit . 2#10011001 2 get-bit . 2#10011001 3 get-bit . 2#10011001 0 clear-bit .#2 2#10011001 1 set-bit .#2 2#10011001 2 set-bit .#2 2#10011001 3 clear-bit .#2 2#10011001 0 invert-bit .#2 2#10011001 1 invert-bit .#2 2#10011001 2 invert-bit .#2 2#10011001 3 invert-bit .#2 2#10011000 find-lowest-set-bit 2#10011000 find-highest-set-bit 2#00000000 find-lowest-set-bit 2#00000000 find-highest-set-bit #+end_src * write-byte *** write-byte :64bit:linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =64bit, platform machine { buffer$write_byte: db 0 define_primitive_function "write-byte", write_byte ;; << byte -- >> pop_argument_stack rax ;; write can not just write the byte in al to stdout ;; write needs the address of the byte to write mov [buffer$write_byte], al mov linux64_sys_3_rdx, 1 ;; max length to be write mov linux64_sys_2_rsi, buffer$write_byte ;; address mov linux64_sys_1_rdi, 1 ;; stdout mov linux64_sys_n_rax, linux64_syscall_write syscall next } #+end_src *** write-byte :32bit:linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =32bit, platform machine { buffer$write_byte: db 0 define_primitive_function "write-byte", write_byte ;; << byte -- >> ;; just calls the Linux write system call pop_argument_stack rax ;; write can not just write the byte in al to stdout ;; write needs the address of the byte to write mov [buffer$write_byte], al mov linux32_sys_3_edx, 1 ;; max length to be write mov linux32_sys_2_ecx, buffer$write_byte ;; address mov linux32_sys_1_ebx, 1 ;; stdout mov linux32_sys_n_eax, linux32_syscall_write syscall next } #+end_src * reading-stack *** note * for we do not build border-check into the interface of pop and push we allocation some memory below the stacks * (read-byte) only sees the tos of reading-stack * reading-stack helps to implement (eval-string) push and pop of reading-stack happens in the function (eval-string) * the interface action on string i.e. two values *** memory allocation #+begin_src fasm :tangle cicada-nymph.fasm size$reading_stack = 1024 * cell_size preserve 64 * cell_size address$reading_stack labeling preserve size$reading_stack define_variable "reading-stack:*pointer*", V__reading_stack__pointer xx address$reading_stack #+end_src *** push & pop & drop :64bit: #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "push-reading-stack", push_reading_stack ;; << string[address, length] -- >> pop_argument_stack rax mov rbx, [V__reading_stack__pointer + cell_size] mov [rbx], rax add qword [V__reading_stack__pointer + cell_size], cell_size pop_argument_stack rax mov rbx, [V__reading_stack__pointer + cell_size] mov [rbx], rax add qword [V__reading_stack__pointer + cell_size], cell_size next define_primitive_function "pop-reading-stack", pop_reading_stack ;; << -- string[address, length] >> sub qword [V__reading_stack__pointer + cell_size], cell_size mov rbx, [V__reading_stack__pointer + cell_size] mov rax, [rbx] push_argument_stack rax sub qword [V__reading_stack__pointer + cell_size], cell_size mov rbx, [V__reading_stack__pointer + cell_size] mov rax, [rbx] push_argument_stack rax next define_primitive_function "drop-reading-stack", drop_reading_stack ;; << -- >> sub qword [V__reading_stack__pointer + cell_size], (cell_size * 2) next } #+end_src *** push & pop & drop :32bit: #+begin_src fasm :tangle cicada-nymph.fasm match =32bit, machine { define_primitive_function "push-reading-stack", push_reading_stack ;; << string[address, length] -- >> pop_argument_stack rax mov rsi, [V__reading_stack__pointer + cell_size] mov [rsi], rax add dword [V__reading_stack__pointer + cell_size], cell_size pop_argument_stack rax mov rsi, [V__reading_stack__pointer + cell_size] mov [rsi], rax add dword [V__reading_stack__pointer + cell_size], cell_size next define_primitive_function "pop-reading-stack", pop_reading_stack ;; << -- string[address, length] >> sub dword [V__reading_stack__pointer + cell_size], cell_size mov rsi, [V__reading_stack__pointer + cell_size] mov rax, [rsi] push_argument_stack rax sub dword [V__reading_stack__pointer + cell_size], cell_size mov rsi, [V__reading_stack__pointer + cell_size] mov rax, [rsi] push_argument_stack rax next define_primitive_function "drop-reading-stack", drop_reading_stack ;; << -- >> sub dword [V__reading_stack__pointer + cell_size], (cell_size * 2) next } #+end_src *** tos #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "tos-reading-stack", tos_reading_stack ;; << -- string[address, length] >> mov rbx, [V__reading_stack__pointer + cell_size] sub rbx, cell_size mov rax, [rbx] push_argument_stack rax mov rbx, [V__reading_stack__pointer + cell_size] sub rbx, cell_size sub rbx, cell_size mov rax, [rbx] push_argument_stack rax next #+end_src *** reading-stack-empty? * only one string is in reading-stack and it length is zero #+begin_src fasm :tangle cicada-nymph.fasm define_function "reading-stack-empty?", reading_stack_empty? ;; << -- bool >> xx literal, V__reading_stack__pointer + cell_size, get xx literal, address$reading_stack xx equal? xx end #+end_src * read-byte *** note end of file * do not exit the program when meeting so when you hit some you will not exit the interpreter *** note factoring * reading from file of stdin is slow thus 1. when reading from file a whole file is readed at a time and setd to a buffer 2. when reading from stdin a whole line is readed at a time 3. note that reading line instead of keyboard-code will limit the design of the user interface * by factoring out the low-level calls that read a line from stdin we are able to implement eval-string easily *** read-line-from-stdin :64bit:linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =64bit, platform machine { define_primitive_function "read-line-from-stdin", read_line_from_stdin ;; << buffer address, max length -- counter >> pop_argument_stack linux64_sys_3_rdx pop_argument_stack linux64_sys_2_rsi xor linux64_sys_1_rdi, linux64_sys_1_rdi ;; stdin mov linux64_sys_n_rax, linux64_syscall_read syscall ;; the return value ;; is a count of the number of bytes transferred push_argument_stack rax next } #+end_src *** read-line-from-stdin :32bit:linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =32bit, platform machine { define_primitive_function "read-line-from-stdin", read_line_from_stdin ;; << buffer address, max length -- counter >> pop_argument_stack linux32_sys_3_edx pop_argument_stack linux32_sys_2_ecx xor linux32_sys_1_ebx, linux32_sys_1_ebx ;; stdin mov linux32_sys_n_eax, linux32_syscall_read syscall ;; the return value ;; is a count of the number of bytes transferred push_argument_stack rax next } #+end_src *** test read-line-from-stdin #+begin_src fasm define_function "", test__read_line_from_stdin xx literal, buffer$reading xx literal, max_input_length xx read_line_from_stdin xx pretty_write_integer xx literal, buffer$reading xx literal, 10 xx write_string xx exit_with_tos xx end #+end_src *** read-byte #+begin_src fasm :tangle cicada-nymph.fasm max_input_length = 64 * 1024 buffer$reading labeling preserve max_input_length replace$reading labeling preserve 1024 define_function "read-byte", read_byte ;; << -- byte >> xx pop_reading_stack xx dup2, empty_string?, CICADA__not, false?branch, (.bad_tos-$)/cell_size xx sub1, swap xx tuck xx add1, swap xx push_reading_stack xx get_byte xx end .bad_tos: xx reading_stack_empty?, false?branch, (.not_empty-$)/cell_size xx drop2 xx literal, buffer$reading xx literal, max_input_length xx read_line_from_stdin xx dup, positive?, false?branch, (.read_error-$)/cell_size xx literal, buffer$reading xx swap xx push_reading_stack xx tail_call, read_byte .read_error: ;; ignore ;; ignore reading error xx drop xx literal, buffer$reading xx literal, 0 xx push_reading_stack xx tail_call, read_byte .not_empty: xx literal, error$read_byte xx literal, length$read_byte xx write_string xx literal, replace$reading xx literal, 1024 xx read_line_from_stdin xx literal, replace$reading xx swap xx push_reading_stack xx tail_call, read_byte error$read_byte: db "* (read-byte) meets empty-string in reading-stack", 10 db " and this empty-stack is not at the bottom of the reading-stack", 10 db " you can type a line to replace this empty string", 10 .end: length$read_byte = (.end - error$read_byte) #+end_src * load-core-file #+begin_src fasm :tangle cicada-nymph.fasm define_function "load-core-file", load_core_file ;; << unknown -- unknown >> xx literal, address$core_file xx literal, (end$core_file - address$core_file) xx push_reading_stack xx end #+end_src * byte *** space-byte? * as for space-byte I only use two ASCII 10 (newline) ASCII 32 (whitespace) * note that I use the term "whitespace" to denotes the byte I use the term "space" to denotes the set of bytes * I will simply view number less-or-equal 32 as space-byte #+begin_src fasm :tangle cicada-nymph.fasm define_function "space-byte?", space_byte? ;; << byte -- bool >> xx literal, 0 xx literal, 32 xx within? xx end #+end_src *** bar-ket-byte? * () [] {} but not <> * double-quote is viewed as special bar-ket-byte #+begin_src fasm :tangle cicada-nymph.fasm define_function "bar-ket-byte?", bar_ket_byte? ;; << byte -- bool >> xx dup, literal, '(', equal?, false?branch, 4 xx drop, true xx end xx dup, literal, ')', equal?, false?branch, 4 xx drop, true xx end xx dup, literal, '[', equal?, false?branch, 4 xx drop, true xx end xx dup, literal, ']', equal?, false?branch, 4 xx drop, true xx end xx dup, literal, '{', equal?, false?branch, 4 xx drop, true xx end xx dup, literal, '}', equal?, false?branch, 4 xx drop, true xx end xx dup, literal, '"', equal?, false?branch, 4 xx drop, true xx end xx drop, false xx end #+end_src *** digit-byte? #+begin_src fasm :tangle cicada-nymph.fasm define_function "digit-byte?", digit_byte? ;; << byte -- bool >> xx literal, '0' xx literal, '9' xx within? xx end #+end_src *** digit-byte->number & number->digit-byte #+begin_src fasm :tangle cicada-nymph.fasm define_function "digit-byte->number", digit_byte_to_number ;; << byte -- number >> xx literal, '0' xx subtraction xx end define_function "number->digit-byte", number_to_digit_byte ;; << number -- byte >> xx literal, '0' xx addition xx end #+end_src * buffer *** note * a buffer is a large vector and some functions do not care about how large it is *** compare-buffer #+begin_src fasm :tangle cicada-nymph.fasm ;; return false when length == 0 define_primitive_function "compare-buffer", compare_buffer ;; << address, address, length -- bool >> pop_argument_stack rcx pop_argument_stack rdi pop_argument_stack rsi repe cmpsb sete al movzx rax, al push_argument_stack rax next #+end_src *** cursor->next-matching-byte * note that it is the NEXT matching-byte #+begin_src fasm :tangle cicada-nymph.fasm define_function "cursor->next-matching-byte", cursor_to_next_matching_byte ;; << cursor, byte -- cursor new address >> xx over, add1, get_byte xx over, equal?, false?branch, 4 xx drop, add1 xx end xx swap xx add1, swap xx tail_call, cursor_to_next_matching_byte #+end_src * string *** note io about string *** write-string #+begin_src fasm :tangle cicada-nymph.fasm define_function "write-string", write_string ;; << string[address, length] -- >> xx dup, zero?, false?branch, 3 xx drop2 xx end xx sub1, swap xx dup, get_byte, write_byte xx add1, swap xx tail_call, write_string define_function ".s", ALIAS__write_string ;; << integer -- >> xx write_string xx end #+end_src *** pretty_write_string #+begin_src fasm :tangle cicada-nymph.fasm define_function "pretty-write-string", pretty_write_string ;; << integer -- >> xx write_string xx literal, 10 xx write_byte xx end #+end_src *** string:empty? #+begin_src fasm :tangle cicada-nymph.fasm define_function "string:empty?", empty_string? ;; << string[address, length] -- bool >> xx swap, drop xx zero? xx end #+end_src *** string:equal? #+begin_src fasm :tangle cicada-nymph.fasm define_function "string:equal?", string_equal? ;; << string[address, length], string[address, length] -- bool >> xx xoverxx, equal?, false?branch, 4 xx swap xx compare_buffer xx end xx drop, drop2 xx false xx end #+end_src *** string:byte #+begin_src fasm :tangle cicada-nymph.fasm define_function "string:byte", string__byte ;; << string[address, length] -- byte >> xx drop, get_byte xx end #+end_src *** string:byte-tail #+begin_src fasm :tangle cicada-nymph.fasm define_function "string:byte-tail", string__byte_tail ;; << string[address, length] -- [address + 1, length - 1] >> xx sub1, swap xx add1 xx swap xx end #+end_src *** string:byte-back #+begin_src fasm :tangle cicada-nymph.fasm define_function "string:byte-back", string__byte_back ;; << string[address, length] -- [address - 1, length + 1] >> xx add1, swap xx sub1 xx swap xx end #+end_src *** string->buffer! #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "string->buffer!", string_to_buffer! ;; ( string[address, length], buffer[address] -- ) pop_argument_stack rdi ;; destination pop_argument_stack rcx ;; counter pop_argument_stack rsi ;; source rep movsb next #+end_src *** string-reverse! :64bit: #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { buffer$string_reverse! labeling preserve 1024 define_primitive_function "string-reverse!", string_reverse! ;; << string[address, length] -- string[address, length] >> mov rdi, buffer$string_reverse! mov rcx, [pointer$argument_stack - (1 * cell_size)] mov rsi, [pointer$argument_stack - (2 * cell_size)] rep movsb mov rcx, [pointer$argument_stack - (1 * cell_size)] dec rdi ;; cursor back into string in buffer$string_reverse! mov rsi, [pointer$argument_stack - (2 * cell_size)] .loop: mov al, byte [rdi] mov byte [rsi], al dec rdi inc rsi loop .loop next } #+end_src *** string-reverse! :32bit: #+begin_src fasm :tangle cicada-nymph.fasm match =32bit, machine { buffer$string_reverse! labeling preserve 1024 define_primitive_function "string-reverse!", string_reverse! ;; << string[address, length] -- string[address, length] >> mov rbx, [pointer$argument_stack] mov rdi, buffer$string_reverse! mov rcx, [rbx - (1 * cell_size)] mov rsi, [rbx - (2 * cell_size)] rep movsb mov rcx, [rbx - (1 * cell_size)] dec rdi ;; cursor back into string in buffer$string_reverse! mov rsi, [rbx - (2 * cell_size)] .loop: mov al, byte [rdi] mov byte [rsi], al dec rdi inc rsi loop .loop next } #+end_src *** one-byte-string? #+begin_src fasm :tangle cicada-nymph.fasm define_function "one-byte-string?", one_byte_string? ;; << string[address, length], byte -- bool >> xx xxswapx xx dup, one?, false?, false?branch, 5 xx drop2, drop xx false xx end xx string__byte, equal?, false?branch, 3 xx true xx end xx false xx end #+end_src *** zero-string? * "0" or "-0" 0 is special when compiling literal number for we are using 0 as "end" #+begin_src fasm :tangle cicada-nymph.fasm define_function "zero-string?", zero_string? ;; << string[address, length] -- bool >> xx dup2, literal, '0', one_byte_string?, false?branch, 4 xx drop2, true xx end xx dup2 xx string__byte, literal, '-', equal?, false?, false?branch, 4 xx drop2, false xx end xx string__byte_tail, literal, '0', one_byte_string? xx end #+end_src *** digit-string? #+begin_src fasm :tangle cicada-nymph.fasm define_function "digit-string?", digit_string? ;; << string[address, length] -- bool >> xx dup, zero?, false?branch, 4 xx drop2, true xx end xx over, get_byte, digit_byte?, false?branch, 4 xx string__byte_tail xx tail_call, digit_string? xx drop2, false xx end #+end_src *** integer-string? #+begin_src fasm :tangle cicada-nymph.fasm define_function "integer-string?", integer_string? ;; << string[address, length] -- bool >> xx dup, zero?, false?branch, 4 xx drop2, false xx end xx dup2, literal, '-', one_byte_string?, false?branch, 4 xx drop2, false xx end xx dup2, string__byte, literal, '-', equal?, false?branch, 4 xx string__byte_tail xx digit_string? xx end xx digit_string? xx end #+end_src *** digit-string->number #+begin_src fasm :tangle cicada-nymph.fasm sum$digit_string_to_number: xx 0 counter$digit_string_to_number: xx 0 define_function "digit-string->number", digit_string_to_number ;; << string[address, length] -- integer >> xx zero, literal, sum$digit_string_to_number, set xx zero, literal, counter$digit_string_to_number, set xx dup2, string_reverse! xx help__digit_string_to_number xx string_reverse!, drop2 xx literal, sum$digit_string_to_number xx get xx end define_function "help,digit-string->number", help__digit_string_to_number ;; << reversed-string[address, length] -- >> xx dup, zero?, false?branch, 3 xx drop2 xx end xx dup2, string__byte, digit_byte_to_number xx literal, 10 xx literal, counter$digit_string_to_number, get xx one xx literal, counter$digit_string_to_number xx add_set xx power xx multiple xx literal, sum$digit_string_to_number xx add_set xx string__byte_tail xx tail_call, help__digit_string_to_number #+end_src *** string->integer #+begin_src fasm :tangle cicada-nymph.fasm define_function "string->integer", string_to_integer ;; << string[address, length] -- integer >> xx dup2, string__byte, literal, '-', equal?, false?, false?branch, 3 xx digit_string_to_number xx end xx string__byte_tail xx digit_string_to_number xx negate xx end #+end_src *** string:find-byte #+begin_src fasm :tangle cicada-nymph.fasm define_function "string:find-byte", string__find_byte ;; << string[address, length], byte ;; -- address, true ;; -- false >> xx over, zero?, false?branch, 5 xx drop, drop2 xx false xx end xx xoverxx, get_byte xx over, equal?, false?branch, 4 xx drop2 xx true xx end xx xxswapx xx string__byte_tail xx xswapxx xx tail_call, string__find_byte #+end_src *** test #+begin_src cicada-nymph : XIE Yuheng ; 32 string:find-byte . << 1 >> get-byte . << 32 >> #+end_src *** string-end,byte #+begin_src fasm :tangle cicada-nymph.fasm define_function "string-end,byte", string_end__byte ;; << string[address, length] -- byte >> xx addition, sub1, get_byte xx end #+end_src *** note * one should use string:space? to make sure that the string is not space-string before calling the following functions *** string:space? #+begin_src fasm :tangle cicada-nymph.fasm define_function "string:space?", space_string? ;; << string[address, length] -- bool >> xx dup, zero?, false?branch, 4 xx drop2, true xx end xx dup2, string__byte, space_byte?, false?branch, 4 xx string__byte_tail xx tail_call, space_string? xx drop2, false xx end #+end_src *** string:word-begin #+begin_src fasm :tangle cicada-nymph.fasm define_function "string:word-begin", string__word_begin ;; << string[address, length] -- string[address, length] >> xx dup, zero?, false?branch, 2 ;; no error handling ;; the same empty-string is returned xx end xx dup2 xx string__byte, space_byte?, false?, false?branch, 2 xx end xx string__byte_tail xx tail_call, string__word_begin #+end_src *** string:word-end #+begin_src fasm :tangle cicada-nymph.fasm define_function "string:word-end,loop", string__word_end__loop ;; << string[address, length] -- string[address, length] >> xx dup, zero?, false?branch, 2 ;; no error handling ;; the current empty-string is returned xx end xx dup2 xx string__byte, space_byte?, false?branch, 2 xx end xx dup2 xx string__byte, bar_ket_byte?, false?branch, 2 xx end xx string__byte_tail xx tail_call, string__word_end__loop define_function "string:word-end", string__word_end ;; << string[address, length] -- string[address, length] >> xx dup, zero?, false?branch, 2 ;; no error handling ;; the same empty-string is returned xx end xx dup2 xx string__byte, bar_ket_byte?, false?branch, 3 xx string__byte_tail xx end xx string__word_end__loop xx end #+end_src *** string:word #+begin_src fasm :tangle cicada-nymph.fasm define_function "string:word", string__word ;; << string[address, length] -- word[address, length] >> xx string__word_begin xx dup2, string__word_end xx swap, drop xx subtraction xx end #+end_src *** string:word-tail #+begin_src fasm :tangle cicada-nymph.fasm define_function "string:word-tail", string__word_tail ;; << string[address, length] -- string[address, length] >> xx string__word_begin xx string__word_end xx end #+end_src * write number *** write-number #+begin_src fasm :tangle cicada-nymph.fasm ;; 2 ^ 64 = 18446744073709551616 ;; which is of length 20 ;; so ;; I use 32 to align to 16 buffer$write_number labeling preserve 32 counter$write_number: xx 0 define_function "write-number", write_number ;; << number -- >> xx write_number__fill_buffer xx write_string xx end define_function "write-number,fill-buffer", write_number__fill_buffer ;; << number -- string[address, length] >> xx zero xx literal, counter$write_number, set xx write_number__loop xx literal, buffer$write_number xx literal, counter$write_number, get xx string_reverse! xx end define_function "write-number,loop", write_number__loop ;; << rest-number -- >> xx literal, 10, divmod xx number_to_digit_byte xx literal, buffer$write_number xx literal, counter$write_number, get xx addition xx set_byte xx one xx literal, counter$write_number xx add_set xx dup, zero?, false?branch, 3 xx drop xx end xx tail_call, write_number__loop #+end_src *** write-integer #+begin_src fasm :tangle cicada-nymph.fasm define_function "write-integer", write_integer ;; << integer -- >> xx dup, negative?, false?, false?branch, 3 xx write_number xx end xx literal, '-', write_byte xx negate xx write_number xx end #+end_src *** pretty_write_integer #+begin_src fasm :tangle cicada-nymph.fasm define_function "pretty-write-integer", pretty_write_integer ;; << integer -- >> xx write_integer xx literal, 32 xx write_byte xx end define_function ".", ALIAS__pretty_write_integer ;; << integer -- >> xx pretty_write_integer xx end #+end_src * word *** note io about word * words are separated by spaces * a bar-ket is a word even when there are no spaces around it *** note bar-ket * (read-word) is not implemented by (read-byte) instead it is implemented directly by side-effect on reading-stack [just like (read-byte)] thus we can implement bar-ket as word easily and nothing like un-read is needed and it is (string:word) and (string:word-tail) these two functions are maintaining the "bar-ket as word" feature * otherwise the implementation of (eval-string) will meet problems *** memory allocation #+begin_src fasm :tangle cicada-nymph.fasm max_word_length = 512 buffer$read_word labeling preserve max_word_length #+end_src *** read-word->buffer #+begin_src fasm :tangle cicada-nymph.fasm define_function "read-word->buffer", read_word_to_buffer ;; << buffer -- word[address, length] >> xx pop_reading_stack xx dup2, space_string?, CICADA__not, false?branch, (.bad_tos-$)/cell_size xx dup2, string__word_tail, push_reading_stack xx string__word xx xoverxx, xxoverx xx xswapxx xx string_to_buffer! xx swap, drop xx end .bad_tos: xx reading_stack_empty?, false?branch, (.not_empty-$)/cell_size xx drop2 xx literal, buffer$reading xx literal, max_input_length xx read_line_from_stdin xx dup, positive?, false?branch, (.read_error-$)/cell_size xx literal, buffer$reading xx swap xx push_reading_stack xx tail_call, read_word_to_buffer .read_error: ;; ignore ;; ignore reading error xx drop xx literal, buffer$reading xx literal, 0 xx push_reading_stack xx tail_call, read_word_to_buffer .not_empty: xx literal, error$read_word_to_buffer xx literal, length$read_word_to_buffer xx write_string xx literal, replace$reading xx literal, 1024 xx read_line_from_stdin xx literal, replace$reading xx swap xx push_reading_stack xx tail_call, read_word_to_buffer error$read_word_to_buffer: db "* (read-word->buffer) meets empty-string in reading-stack", 10 db " and this empty-stack is not at the bottom of the reading-stack", 10 db " you can type a line to replace this empty string", 10 .end: length$read_word_to_buffer = (.end - error$read_word_to_buffer) #+end_src *** read-word * read-word will override the word readed before #+begin_src fasm :tangle cicada-nymph.fasm define_function "read-word", read_word ;; << -- word[address of buffer$read_word, length] >> xx literal, buffer$read_word, read_word_to_buffer xx end #+end_src * link *** last-link? * fatal error on zero * the last-link is not zero but is a link of which the link field is zero #+begin_src fasm :tangle cicada-nymph.fasm define_function "last-link?", last_link? ;; << link -- bool >> xx get, zero? xx end #+end_src *** link->next-link * fatal error on zero * the test of zero? is for less core dump #+begin_src fasm :tangle cicada-nymph.fasm define_function "link->next-link", link_to_next_link ;; << link -- next-link >> xx get xx end #+end_src *** link->name-string #+begin_src fasm :tangle cicada-nymph.fasm define_function "link->name-string", link_to_name_string ;; << link -- string[address, length] >> xx literal, offset__link$string_address, addition xx literal, 2 xx n_get xx end #+end_src *** link->jo #+begin_src fasm :tangle cicada-nymph.fasm define_function "link->jo", link_to_jo ;; << link -- jo >> xx literal, offset__link$jo, addition, get xx end #+end_src *** link,set-jo #+begin_src fasm :tangle cicada-nymph.fasm define_function "link,set-jo", link__set_jo ;; << jo, link -- >> xx literal, offset__link$jo, addition xx set xx end #+end_src *** *link* * a link is the first jo in the link #+begin_src fasm :tangle cicada-nymph.fasm define_variable "*link*", V__link xx the_last_link_in_assembly_code #+end_src *** note about find * a function whoes name is prefixed by "find" maybe fail to find and maybe returns a signal to inform the function who calls it *** 記遍歷鏈表的方式 * 循環進行的方式是 1. 保證循環開始時所得到的 jo 不是最後一個 2. 處理這個 jo 3. 看看這個 jo 是否是最後一個 * 如果是退出 * 如果不是取下一個 jo 以循環 *** find-link #+begin_src fasm :tangle cicada-nymph.fasm define_function "find-link", find_link ;; << word[address, length], link ;; -- link, true ;; -- false >> xx xxtuckx xx link_to_name_string, xxoverxx ;; xx xxoverxx ;; xx xxoverxx ;; xx write_string, literal, 32, write_byte ;; xx write_string, literal, 10, write_byte xx string_equal?, false?branch, 4 xx drop2, true xx end xx xswapxx xx dup, last_link?, false?branch, 5 xx drop, drop2 xx false xx end xx link_to_next_link xx tail_call, find_link #+end_src * basic-REPL *** word-interpreter #+begin_src fasm :tangle cicada-nymph.fasm define_function "word-interpreter", word_interpreter ;; << word[address, length] -- unknown >> xx dup2, integer_string?, false?branch, 3 xx string_to_integer xx end ;; maybe more xx dup2 ;; for to report undefined word xx V__link xx find_link, false?branch, 6 xx xxswapx, drop2 xx link_to_jo, apply xx end xx write_undefined_word_report__for_word_interpreter xx write_string xx literal, 10 xx write_byte xx end define_function "write-undefined-word-report,for-word-interpreter", write_undefined_word_report__for_word_interpreter ;; << -- >> xx literal, string$undefined_word_report__for_word_interpreter xx literal, length$undefined_word_report__for_word_interpreter xx write_string xx end string$undefined_word_report__for_word_interpreter: db "* (word-interpreter) meets undefined word : " .end: length$undefined_word_report__for_word_interpreter = (.end - string$undefined_word_report__for_word_interpreter) #+end_src *** basic-REPL #+begin_src fasm :tangle cicada-nymph.fasm define_function "basic-REPL", basic_REPL ;; << unknown -- unknown >> xx read_word xx word_interpreter xx tail_call, basic_REPL #+end_src * colon semicolon *** note * from the aesthetics point of view I do NOT think which of the following is better then the other but I choose the second one * first #+begin_src cicada-nymph define-function factorial << n -- n! >> dup one? if end then dup sub1 factorial mul end end #+end_src * second #+begin_src cicada-nymph : factorial << n -- n! >> dup one? if end then dup sub1 factorial mul end ; define-function #+end_src *** [colon|semicolon]-string? #+begin_src fasm :tangle cicada-nymph.fasm define_function "colon-string?", colon_string? ;; << string[address, length] -- bool >> xx literal, ':' xx one_byte_string? xx end define_function "semicolon-string?", semicolon_string? ;; << string[address, length] -- bool >> xx literal, ';' xx one_byte_string? xx end #+end_src *** comment-[begin|end]-string? #+begin_src fasm :tangle cicada-nymph.fasm string$comment_begin: db "<<" define_function "comment-begin-string?", comment_begin_string? ;; << string[address, length] -- bool >> xx literal, string$comment_begin xx literal, 2 xx string_equal? xx end string$comment_end: db ">>" define_function "comment-end-string?", comment_end_string? ;; << -- >> xx literal, string$comment_end xx literal, 2 xx string_equal? xx end #+end_src *** colon & semicolon * nested : ; is NOT allow and no error check for it #+begin_src fasm :tangle cicada-nymph.fasm buffer$colon labeling preserve 1024 * 1024 cursor$colon: xx 0 length$colon: xx 0 define_function ":", colon ;; << -- string[address of buffer$colon, length] >> xx literal, buffer$colon xx literal, cursor$colon, set xx colon__loop ;; address xx literal, buffer$colon ;; length xx literal, cursor$colon, get xx literal, buffer$colon xx subtraction xx dup, literal, length$colon, set xx end define_function "colon,loop", colon__loop ;; << -- >> xx read_byte xx colon__set_byte xx colon__meet_end?, false?branch, 7 xx literal, 3 ;; for the string " ; " xx literal, cursor$colon xx sub_set xx end xx tail_call, colon__loop define_function "colon,set-byte", colon__set_byte ;; << byte -- >> xx literal, cursor$colon, get xx set_byte xx one xx literal, cursor$colon xx add_set xx end define_function "colon,meet-end?", colon__meet_end? ;; << -- bool >> xx literal, cursor$colon, get xx literal, 3, subtraction xx get_byte, space_byte? xx false?, false?branch, 3 xx false xx end xx literal, cursor$colon, get xx literal, 2, subtraction xx get_byte, literal, ';', equal? xx false?, false?branch, 3 xx false xx end xx literal, cursor$colon, get xx literal, 1, subtraction xx get_byte, space_byte? xx false?, false?branch, 3 xx false xx end xx true xx end #+end_src *** ignore-comment * this function is for basic-REPL but it is reused by colon #+begin_src fasm :tangle cicada-nymph.fasm define_function "<<", ignore_comment ;; << -- >> xx read_word xx dup2, comment_begin_string?, false?branch, 5 xx drop2 xx ignore_comment ;; for the new nested-comment xx tail_call, ignore_comment ;; for the rest-comment xx dup2, comment_end_string?, false?branch, 3 xx drop2 xx end xx drop2 xx tail_call, ignore_comment #+end_src *** test #+begin_src cicada-nymph 1 << 989 >> 64 add . << 65 >> : kkk << 989 << 989 >> >> ; .s << kkk >> #+end_src * jojo-area *** note * you can see how the naming convention is used for functions that create structured data into memory *** memory allocation #+begin_src fasm :tangle cicada-nymph.fasm size$jojo_area = 1024 * 1024 * cell_size define_variable "*jojo-area*", V__jojo_area xx address$jojo_area define_variable "*jojo-area,size*", V__jojo_area__size xx size$jojo_area address$jojo_area labeling preserve size$jojo_area define_variable "*jojo-area,current-free-address*", V__jojo_area__current_free_address xx address$jojo_area #+end_src *** jojo-area,stay #+begin_src fasm :tangle cicada-nymph.fasm define_function "jojo-area,stay", jojo_area__stay ;; << number -- >> xx V__jojo_area__current_free_address xx set xx literal, cell_size xx address, V__jojo_area__current_free_address xx add_set xx end #+end_src * make-link * link as data-structure |------+----------------| | link | next-link | |------+----------------| | | jo | | | string-address | | | string-length | |------+----------------| #+begin_src fasm :tangle cicada-nymph.fasm define_function "make-link", make_link ;; << string[address, length], next-link, jo -- link >> xx V__jojo_area__current_free_address xx xxxxswapx xx swap xx jojo_area__stay xx jojo_area__stay xx swap xx jojo_area__stay xx jojo_area__stay xx end #+end_src * make-jo-head * jo as data-structure |----+----------------| | | length | |----+----------------| | jo | explainer | |----+----------------| | | body | |----+----------------| #+begin_src fasm :tangle cicada-nymph.fasm define_function "make-jo-head", make_jo_head ;; << explainer, length -- jo >> xx jojo_area__stay xx V__jojo_area__current_free_address xx swap xx jojo_area__stay xx end #+end_src * syntax-stack *** 記 * *syntax-stack* 轉換語境 * *syntax-rule-set:...* 添加語法 *** memory allocate #+begin_src fasm :tangle cicada-nymph.fasm preserve cell_size * 64 address$syntax_stack labeling preserve cell_size * 1024 define_variable "syntax-stack:*address*", V__syntax_stack__address xx address$syntax_stack define_variable "syntax-stack:*pointer*", V__syntax_stack__pointer xx address$syntax_stack #+end_src *** push-syntax-stack #+begin_src fasm :tangle cicada-nymph.fasm define_function "push-syntax-stack", push_syntax_stack ;; << syntax-set[address] -- >> xx V__syntax_stack__pointer xx set xx V__cell_size xx address, V__syntax_stack__pointer xx add_set xx end #+end_src *** pop-syntax-stack #+begin_src fasm :tangle cicada-nymph.fasm define_function "pop-syntax-stack", pop_syntax_stack ;; << -- syntax-set[address] >> xx V__cell_size xx address, V__syntax_stack__pointer xx sub_set xx V__syntax_stack__pointer, get xx end #+end_src *** tos-syntax-stack #+begin_src fasm :tangle cicada-nymph.fasm define_function "tos-syntax-stack", tos_syntax_stack ;; << -- syntax-set[address] >> xx V__syntax_stack__pointer xx V__cell_size xx subtraction xx get xx end #+end_src *** drop-syntax-stack #+begin_src fasm :tangle cicada-nymph.fasm define_function "drop-syntax-stack", drop_syntax_stack ;; << -- >> xx V__cell_size xx address, V__syntax_stack__pointer xx sub_set xx end #+end_src *** syntax-stack-empty? #+begin_src fasm :tangle cicada-nymph.fasm define_function "syntax-stack-empty?", syntax_stack_empty? ;; << -- bool >> xx V__syntax_stack__pointer xx literal, address$syntax_stack xx equal? xx end #+end_src *** find-syntax * only search the first syntax-rule-set in syntax-stack thus a switch of syntax will get you a clean syntax #+begin_src fasm :tangle cicada-nymph.fasm define_function "find-syntax", find_syntax ;; << word[address, length] ;; -- function, true ;; -- false >> xx syntax_stack_empty?, false?branch, 4 xx drop2 xx false xx end xx tos_syntax_stack xx syntax_rule_set__find xx end #+end_src * syntax-rule-set *** 記使用 * syntax-rule-set:jojo-compiler 是語法謂詞還有語法函數這種對子所形成的有序集合這樣就可以形成簡單的語境概念了 * 每個語境都有責任在進入和退出時維護好 syntax-rule-set:jojo-compiler * 以 syntax 爲前綴的 function 的類型常常是 1. 以 jojo-compiler 爲後綴時 << jo, string[address, length], word[address, length] -- jo, string[address, length] >> 2. 在 REPL 中使用時又可以是 << word[address, length] -- integer >> 所以在使用時一定要注意維護棧中的值的良好性 *** note border * border is current-free-address of syntax-rule-set *** 記 interface * structure | syntax-rule | predicate | | | function | * on stack << syntax-rule[predicate, function] >> * set is an ordered set its interface is as the following 1. (add-syntax-rule) add a syntax-rule into syntax-rule-set 2. (sub-syntax-rule) try to sub a syntax-rule from syntax-rule-set once a time if can not find the syntax-rule in the syntax-rule-set do nothing 3. (find-syntax-rule) find a function from a word 4. (list-syntax-rule) *** syntax-rule:*unit* #+begin_src fasm :tangle cicada-nymph.fasm define_variable "syntax-rule:*unit*", V__syntax_rule__unit xx (cell_size * 2) #+end_src *** syntax-rule:get-predicate #+begin_src fasm :tangle cicada-nymph.fasm define_function "syntax-rule:get-predicate", syntax_rule__get_predicate ;; << syntax-rule[address] -- predicate >> xx get xx end #+end_src *** syntax-rule:get-function #+begin_src fasm :tangle cicada-nymph.fasm define_function "syntax-rule:get-function", syntax_rule__get_function ;; << syntax-rule[address] -- function >> xx V__cell_size, addition xx get xx end #+end_src *** syntax-rule:get #+begin_src fasm :tangle cicada-nymph.fasm define_function "syntax-rule:get", syntax_rule__get ;; << syntax-rule[address] -- syntax-rule[predicate, function] >> xx V__syntax_rule__unit, V__cell_size, division xx n_get xx end #+end_src *** syntax-rule-set:get-border #+begin_src fasm :tangle cicada-nymph.fasm define_function "syntax-rule-set:get-border", syntax_rule_set__get_border ;; << syntax-rule-set -- border >> xx V__cell_size, subtraction xx get xx end #+end_src *** syntax-rule-set:set-border #+begin_src fasm :tangle cicada-nymph.fasm define_function "syntax-rule-set:set-border", syntax_rule_set__set_border ;; << border, syntax-rule-set -- >> xx V__cell_size, subtraction xx set xx end #+end_src *** syntax-rule:add #+begin_src fasm :tangle cicada-nymph.fasm define_function "syntax-rule:add", syntax_rule__add ;; << syntax-rule-set: syntax-rule[predicate, function] -- >> xx xoverxx xx syntax_rule_set__get_border xx literal, 2 xx n_set xx dup xx syntax_rule_set__get_border xx V__cell_size, addition xx V__cell_size, addition xx swap xx syntax_rule_set__set_border xx end #+end_src *** syntax-rule-set:find #+begin_src fasm :tangle cicada-nymph.fasm cursor$syntax_rule_set__find: xx 0 define_function "syntax-rule-set:find", syntax_rule_set__find ;; << word[address, length], syntax-rule-set ;; -- function, true ;; -- false >> xx dup, syntax_rule_set__get_border xx literal, cursor$syntax_rule_set__find, set xx syntax_rule_set__find__loop xx end define_function "syntax-rule-set:find,loop", syntax_rule_set__find__loop ;; << word[address, length], syntax-rule-set ;; -- function, true ;; -- false >> xx literal, cursor$syntax_rule_set__find, get xx over, equal?, false?branch, 5 xx drop, drop2 xx false xx end xx xxoverx xx literal, cursor$syntax_rule_set__find, get xx V__syntax_rule__unit, subtraction xx syntax_rule__get_predicate xx apply, false?branch, (.not_found-$)/cell_size xx drop, drop2 xx literal, cursor$syntax_rule_set__find, get xx V__syntax_rule__unit, subtraction xx syntax_rule__get_function xx true xx end .not_found: xx literal, cursor$syntax_rule_set__find, get xx V__cell_size, subtraction xx V__cell_size, subtraction xx literal, cursor$syntax_rule_set__find, set xx tail_call, syntax_rule_set__find__loop #+end_src * jojo-compiler:*syntax-rule-set* *** note * a syntax is a function to be called at compile time with a string to be compiled as one argument and do side-effect to store data into memory and return a shorter string [this can be viewed as moving a cursor forward] *** jojo-compiler-syntax:integer-string #+begin_src fasm :tangle cicada-nymph.fasm define_function "jojo-compiler-syntax:integer-string", jojo_compiler_syntax__integer_string ;; << string[address, length], word[address, length] -- ;; string[address, length] >> xx literal, literal xx jojo_area__stay xx string_to_integer xx jojo_area__stay xx end #+end_src *** literal-word:address? #+begin_src fasm :tangle cicada-nymph.fasm string$word_is_address?: db "address" .end: length$word_is_address? = (.end - string$word_is_address?) define_function "literal-word:address?", word_is_address? ;; << word[address, length] -- bool >> xx literal, string$word_is_address? xx literal, length$word_is_address? xx string_equal? xx end #+end_src *** jojo-compiler-syntax:address #+begin_src fasm :tangle cicada-nymph.fasm define_function "jojo-compiler-syntax:address", jojo_compiler_syntax__address ;; << string[address, length], literal-word:address -- ;; string[address, length] >> xx drop2 xx literal, address xx jojo_area__stay xx end #+end_src *** literal-word:jo? #+begin_src fasm :tangle cicada-nymph.fasm string$word_is_jo?: db "jo" .end: length$word_is_jo? = (.end - string$word_is_jo?) define_function "literal-word:jo?", word_is_jo? ;; << word[address, length] -- bool >> xx literal, string$word_is_jo? xx literal, length$word_is_jo? xx string_equal? xx end #+end_src *** jojo-compiler-syntax:jo #+begin_src fasm :tangle cicada-nymph.fasm define_function "jojo-compiler-syntax:jo", jojo_compiler_syntax__jo ;; << string[address, length], literal-word:jo -- ;; string[address, length] >> xx drop2 xx literal, literal xx jojo_area__stay xx end #+end_src *** literal-word:double-quote? #+begin_src fasm :tangle cicada-nymph.fasm string$word_is_double_quote?: db '"' .end: length$word_is_double_quote? = (.end - string$word_is_double_quote?) define_function "literal-word:double-quote?", word_is_double_quote? ;; << word[double-quote, length] -- bool >> xx literal, string$word_is_double_quote? xx literal, length$word_is_double_quote? xx string_equal? xx end #+end_src *** syntax,double-quote,jojo-compiler * string-area is used to allocate string literal in function body * in ASCII encode double-quote is 34 #+begin_src fasm :tangle cicada-nymph.fasm define_function "syntax,double-quote,jojo-compiler", syntax__double_quote__jojo_compiler ;; << string[address, length], literal-word:double-quote -- ;; string[address, length] >> xx drop2 xx dup2 xx literal, '"', string__find_byte xx false?branch, (.not_found-$)/cell_size xx xoverxx, subtraction ;; << string[address, length], new-length >> xx xxtuckx xx xoverxx, swap xx make_string ;; << new-length ;; string[address, length] ;; string[address, new-length] >> xx swap ;; address xx literal, literal xx jojo_area__stay xx jojo_area__stay ;; new-length xx literal, literal xx jojo_area__stay xx jojo_area__stay ;; << new-length ;; string[address, length] >> xx xoverxx, subtraction xx xxswapx xx addition xx swap xx string__byte_tail ;; over the ending double-quote xx end .not_found: xx write_not_integer_string_report__for_double_quote xx literal, 10, write_byte xx end define_function "write-not-integer-string-report,for-double-quote", write_not_integer_string_report__for_double_quote ;; << -- >> xx literal, string$not_integer_string_report__for_double_quote xx literal, length$not_integer_string_report__for_double_quote xx write_string xx end string$not_integer_string_report__for_double_quote: db "* (syntax,double-quote,jojo-compiler) can not find the ending double-quote" .end: length$not_integer_string_report__for_double_quote = (.end - string$not_integer_string_report__for_double_quote) #+end_src *** note * comment can not cross ";" *** syntax,comment,jojo-compiler * nested << >> must be handled * note that syntax,comment,jojo-compiler is a syntax its interface is special thus when implement it as one recursive function the structure of the function is special otherwise just implement it by two functions #+begin_src fasm :tangle cicada-nymph.fasm define_function "syntax,comment,jojo-compiler", syntax__comment__jojo_compiler ;; << string[address, length], word -- ;; string[address, length] >> xx drop2 xx dup2, space_string?, false?branch, 2 xx end xx dup2 xx string__word_tail, xxswapxx xx string__word xx dup2, comment_end_string?, false?branch, 3 xx drop2 xx end xx dup2, comment_begin_string?, CICADA__not, false?branch, 3 xx tail_call, syntax__comment__jojo_compiler ;; nested xx syntax__comment__jojo_compiler xx dup2, space_string?, false?branch, 2 xx end xx dup2 xx string__word_tail, xxswapxx xx string__word xx tail_call, syntax__comment__jojo_compiler #+end_src *** memory allocation #+begin_src fasm :tangle cicada-nymph.fasm size$syntax_rule_set__jojo_compiler = 1024 * cell_size cursor$syntax_rule_set__jojo_compiler: xx address$syntax_rule_set__jojo_compiler address$syntax_rule_set__jojo_compiler: times size$syntax_rule_set__jojo_compiler db 0 #+end_src *** jojo-compiler:*syntax-rule-set* #+begin_src fasm :tangle cicada-nymph.fasm define_variable "jojo-compiler:*syntax-rule-set*", V__syntax_rule_set__jojo_compiler xx address$syntax_rule_set__jojo_compiler #+end_src *** init,syntax-rule-set:jojo-compiler #+begin_src fasm :tangle cicada-nymph.fasm define_function "init,syntax-rule-set:jojo-compiler", init__syntax_rule_set__jojo_compiler ;; << -- >> xx V__syntax_rule_set__jojo_compiler xx dup xx literal, integer_string? xx literal, jojo_compiler_syntax__integer_string xx syntax_rule__add xx dup xx literal, word_is_address? xx literal, jojo_compiler_syntax__address xx syntax_rule__add xx dup xx literal, word_is_jo? xx literal, jojo_compiler_syntax__jo xx syntax_rule__add xx dup xx literal, word_is_double_quote? xx literal, syntax__double_quote__jojo_compiler xx syntax_rule__add xx dup xx literal, local_variable_set_word? xx literal, jojo_compiler_syntax__local_variable_set xx syntax_rule__add xx dup xx literal, local_variable_get_word? xx literal, jojo_compiler_syntax__local_variable_get xx syntax_rule__add xx literal, comment_begin_string? xx literal, syntax__comment__jojo_compiler xx syntax_rule__add xx end #+end_src * jojo-compiler *** note * the jojo-compiler is a macro dispatcher it can be viewed as make-function-body it gets next word and use predicates on word to do dispatch * note that jojo-compiler can be viewed as the "compiler" of the cicada-nymph it does NOT (can not) compile file to file but creates structured data directly into memory *** jojo-compiler,dispatch-word #+begin_src fasm :tangle cicada-nymph.fasm define_function "jojo-compiler,dispatch-word", jojo_compiler__dispatch_word ;; << jo, string[address, length], word[address, length] -- ;; jo, string[address, length] >> xx dup2 xx find_syntax, false?branch, 3 xx apply xx end xx dup2 xx V__link xx find_link, false?branch, 6 xx xxswapx, drop2 xx link_to_jo xx jojo_area__stay xx end xx write_undefined_word_report__for_jojo_compiler xx write_string xx literal, 10, write_byte xx end define_function "write-undefined-word-report,for-jojo-compiler", write_undefined_word_report__for_jojo_compiler ;; << -- >> xx literal, string$undefined_word_report__for_jojo_compiler xx literal, length$undefined_word_report__for_jojo_compiler xx write_string xx end string$undefined_word_report__for_jojo_compiler: db "* (jojo-compiler) meets undefined word : " .end: length$undefined_word_report__for_jojo_compiler = (.end - string$undefined_word_report__for_jojo_compiler) #+end_src *** jojo-compiler #+begin_src fasm :tangle cicada-nymph.fasm define_function "jojo-compiler", jojo_compiler ;; << jo, string[address, length] -- >> xx local_variable_table__clear xx V__syntax_rule_set__jojo_compiler, push_syntax_stack xx jojo_compiler__loop xx drop_syntax_stack xx end define_function "jojo-compiler,loop", jojo_compiler__loop ;; << jo, string[address, length] -- >> xx dup2, space_string?, false?branch, 4 xx drop2, drop xx end xx dup2 xx string__word_tail xx xxswapxx xx string__word ;; << tail[address, length], head[address, length] >> xx jojo_compiler__dispatch_word xx tail_call, jojo_compiler__loop #+end_src * define-function *** note * for the following function I add the "CICADA__" as prefix to distinguish from their assembly code version *** define-function #+begin_src fasm :tangle cicada-nymph.fasm define_function "define-function", CICADA__define_function ;; << string[address, length] -- >> xx dup2, string__word ;; << string[address, length] ;; name-string[address, length] >> xx make_string ;; << string[address, length] ;; name-string[address, length] >> xx dup2 xx V__link xx literal, 0 ;; << string[address, length] ;; name-string[address, length] ;; name-string[address, length], next-link, jo >> xx make_link ;; << string[address, length] ;; name-string[address, length] ;; link >> xx xxtuckx xx address, V__link, set xx drop2 xx literal, explain$function xx literal, 0 ;; << string[address, length] ;; link ;; name-string[address, length], explainer, 0 >> xx make_jo_head ;; << string[address, length] ;; link ;; jo >> xx tuck xx swap ;; << string[address, length] ;; jo ;; jo ;; link >> xx link__set_jo ;; << string[address, length] ;; jo >> xx dup xx xxswapxx xx string__word_tail xx V__jojo_area__current_free_address xx xxxswapx ;; << jo ;; V__jojo_area__current_free_address ;; jo ;; body[address, length] >> xx jojo_compiler ;; << jo ;; V__jojo_area__current_free_address >> xx V__jojo_area__current_free_address xx swap, subtraction xx V__cell_size, division xx swap, jo__set_length xx end #+end_src *** test #+begin_src cicada-nymph : addadd add add end ; define-function 1 2 3 addadd . << 6 >> : addadd ; string:word *link* find-link drop link->jo dup jo->length . << 3 >> 1 2 3 x|swap|xxx apply . << 6 >> : add1 1 add end ; define-function 1 add1 . << 2 >> : negate 0 swap sub end ; define-function 1 negate . << -1 >> #+end_src *** test double-quote #+begin_src cicada-nymph : test,double-quote << -- >> "test,double-quote" write-string end ; define-function test,double-quote #+end_src * define-variable,with-tos *** define-variable,with-tos * not undo is needed for define-variable,with-tos #+begin_src fasm :tangle cicada-nymph.fasm define_function "define-variable,with-tos", CICADA__define_variable__with_tos ;; << value, string[address, length] -- >> xx dup2, string__word ;; << string[address, length] ;; name-string[address, length] >> xx make_string ;; << string[address, length] ;; name-string[address, length] >> xx dup2 xx V__link xx literal, 0 ;; << string[address, length] ;; name-string[address, length] ;; name-string[address, length], next-link, jo >> xx make_link ;; << string[address, length] ;; name-string[address, length] ;; link >> xx xxtuckx xx address, V__link, set xx drop2 xx literal, explain$variable xx literal, 0 ;; << string[address, length] ;; link ;; name-string[address, length], explainer, 0 >> xx make_jo_head ;; << string[address, length] ;; link ;; jo >> xx tuck xx swap ;; << string[address, length] ;; jo ;; jo ;; link >> xx link__set_jo ;; << string[address, length] ;; jo >> xx literal, 1 xx swap ;; << string[address, length] ;; 1 ;; jo >> xx jo__set_length ;; << string[address, length] >> xx drop2 xx jojo_area__stay xx end #+end_src *** test #+begin_src cicada-nymph 233 : *three* ; define-variable,with-tos : add-three *three* add end ; define-function 1 add-three . << 234 >> << you get the address of the variable *three* by add "address" in front of it >> : fix-*three* 3 address *three* set end ; define-function fix-*three* 1 add-three . << 4 >> : jo-*three* jo *three* apply . end ; define-function jo-*three* #+end_src * *local-variable* *** 記有名字的局部變量與變長的局部數據 * local-variable 用來實現有名字的局部變量在編譯時計算 offset 到這個 local-variable 中的 offset 做爲變量的值有 *local-variable-table* 這個數據結構幫助計算 offset * local-memory 用來分配變長的局部數據在運行時計算 offset * 兩個機制配合使用 *** 記再增加局部變元支持之後需要重寫的部分 ***** 詮釋者與收尾詞 * 在進行時每次進入一個函數體的執行即每次將一串珠珠入棧時同時在這串珠子底部加上 local_variable$current_free_address 即在 explain$function 中需要做特殊處理 * 這個值在函數退出時 [即在 end 這個函數中] 用以重置 local_variable$current_free_address 也就是釋放在這次函數作用過程中所分配的內存 * 每次 >:name 的時候都更新 local_variable$current_free_address 以分配內存就行了 * 也就是說 return-stack 中的大多數有效值都是以兩個值一對的方式存在的 * 兩個結尾詞是 end 和 tail_call 對於 tail_call 即對於明顯的尾遞歸調用需要利用棧中的值重置 local_variable$current_free_address 但是並不入棧新值 ***** 語法擴展方面的支持 * 這裏需要識別 >:name 還有 :name 等等並對它們做特殊處理這些東西應該藉助設計良好的語法擴展機制來實現 * 我將使用一個語法謂詞的棧可以發現這樣的話我就能很容易地臨時改變語法了 *** 記總結 ***** interface * 首先要滿足最基本的長度爲 *cell-size* 的倍數的局部變量的需求其次還要能夠在所申請的局部空間裏使用字符串這兩種長度的數據結構需要共存使用 offset 就行了 * 底層 local-data-allocate,jo 這個只讓 local_variable$current_free_address 前進而不後退 * 注意最爲重要的特點是所有的對局部數據堆的使用都必須在編譯時期被靜態地算出來所以必須設計語法幫助編譯器作計算 >:name :name 用以分配和使用 *cell-size* 倍數大小的內存 * 語義方面 >:name 的重複出現有兩種語義 1. 更新這個局部變元的值 2. 覆蓋上一個局部變元綁定我選擇第一種因爲這樣我就不必設計額外的語法來更新局部變元的值了比較簡潔 ***** 語義特點總結 * 所有有名局部變元的名字與值的對應都由編譯器處理 * 每個函數體就是一個非常線性的東西函數體中不能嵌套別的函數體 ***** 語用特點總結 * 所有的函數都是全局的包括輔助函數 * 所以設計輔助函數的時候應該格外小心儘量使得輔助函數能夠被重用 * 改代碼並調整對輔助函數的使用就被稱作是 "re-factoring" 即函數的因子的重新分解 *** 記關於分支結構 * 對包含 >:name 的函數體的處理是純線性的根本沒有考慮到函數體中因 if else then 而產生的分支結構但是這並不會引起錯誤原因如下 * 對 >:name 和 :name 的處理是純粹在編譯時期進行的 * 所保證的特性是 1. 每一個 name 在一個函數體中的出現都是在編譯時期對 local-variable 的一個 offset 的分配 2. 同一個 name 在一個函數體中的出現會得到相同的 offset *** memory allocation #+begin_src fasm :tangle cicada-nymph.fasm size$local_variable = 1024 * 1024 * cell_size address$local_variable labeling preserve size$local_variable local_variable$current_free_address: xx address$local_variable #+end_src *** 記注意結尾詞會初始化局部變量指針 * 下面的接口函數必須是 primitive-function 因爲否則遇到 end 和 tail_call 的時候 local_variable$current_free_address 就又被初始化了 *** allocate-local-variable #+begin_src fasm :tangle cicada-nymph.fasm define_primitive_function "allocate-local-variable", allocate_local_variable ;; << number -- >> pop_argument_stack rax imul rax, cell_size add [local_variable$current_free_address], rax next #+end_src *** note many get & set * in memory | 1 : value-1 | | 1 : value-2 | | 1 : value-3 | * on stack << value-1, value-2, value-3, ... >> *** instruction,local-variable,[n-get|n-set] :64bit: #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "instruction,local-variable,n-get", instruction__local_variable__n_get ;; << -- value-1, ..., value-n >> pop_return_stack rbx mov rdx, [rbx] ;; offset mov rcx, [rbx + cell_size] ;; numebr add rbx, (cell_size * 2) push_return_stack rbx mov rbx, [pointer$return_stack - unit__return_point + offset__return_point$local_variable] add rbx, rdx .loop: mov rax, [rbx] push_argument_stack rax add rbx, cell_size loop .loop next define_primitive_function "instruction,local-variable,n-set", instruction__local_variable__n_set ;; << value-n, ..., value-1 -- >> pop_return_stack rbx mov rdx, [rbx] ;; offset mov rcx, [rbx + cell_size] ;; numebr add rbx, (cell_size * 2) push_return_stack rbx mov rbx, [pointer$return_stack - unit__return_point + offset__return_point$local_variable] add rbx, rdx mov rax, cell_size imul rax, rcx add rbx, rax ;; for address is based on 0 ;; but n is based on 1 sub rbx, cell_size .loop: pop_argument_stack rax mov [rbx], rax sub rbx, cell_size loop .loop next } #+end_src *** instruction,local-variable,[n-get|n-set] :32bit: #+begin_src fasm :tangle cicada-nymph.fasm match =32bit, machine { define_primitive_function "instruction,local-variable,n-get", instruction__local_variable__n_get ;; << -- value-1, ..., value-n >> pop_return_stack rbx mov rdx, [rbx] ;; offset mov rcx, [rbx + cell_size] ;; numebr add rbx, (cell_size * 2) push_return_stack rbx mov rax, [pointer$return_stack] mov rbx, [rax - unit__return_point + offset__return_point$local_variable] add rbx, rdx .loop: mov rax, [rbx] push_argument_stack rax add rbx, cell_size loop .loop next define_primitive_function "instruction,local-variable,n-set", instruction__local_variable__n_set ;; << value-n, ..., value-1 -- >> pop_return_stack rbx mov rdx, [rbx] ;; offset mov rcx, [rbx + cell_size] ;; numebr add rbx, (cell_size * 2) push_return_stack rbx mov rax, [pointer$return_stack] mov rbx, [rax - unit__return_point + offset__return_point$local_variable] add rbx, rdx mov rax, cell_size imul rax, rcx add rbx, rax ;; for address is based on 0 ;; but n is based on 1 sub rbx, cell_size .loop: pop_argument_stack rax mov [rbx], rax sub rbx, cell_size loop .loop next } #+end_src *** note example result * example #+begin_src cicada-nymph : example << number1, number2, number3, number4 -- number1, number2 >> >::var2 >::var2 ::var2 end ; define-function #+end_src * result #+begin_src fasm define_function "example", example ;; >::var2 xx literal, 2, allocate_local_variable xx instruction__local_variable__n_set, 0, 2 ;; >::var2 xx instruction__local_variable__n_set, 0, 2 ;; ::var2 xx instruction__local_variable__n_get, 0, 2 xx end #+end_src *** test #+begin_src cicada-nymph : local-variable,test >:var1 :var1 end ; define-function 1 local-variable,test . << 1 >> : local-variable,test >:var1 >:var2 >:var3 >:var4 :var4 :var3 :var2 :var1 end ; define-function 1 2 3 4 local-variable,test . . . . << 4 3 2 1 >> : local-variable,test >:var2 >:var2 >:var1 :var1 :var2 add end ; define-function 1 2 4 local-variable,test . << 3 >> : local-variable,test,2 << number1, number2 -- number2 + number3 >> >::var2 ::var2 end ; define-function 1 2 local-variable,test,2 . . << 1 2 >> : local-variable,test,3 << number1, number2, number3 -- number2 + number3 >> >::var2 >:var1 ::var2 add end ; define-function 1 2 4 local-variable,test,3 . << 6 >> #+end_src *** test nested call #+begin_src cicada-nymph : k1 9 >:k :k . end ; define-function k1 << 9 >> : k2 10 >:k k1 :k . end ; define-function k2 << 9 10 >> #+end_src *** 記問題 ***** nested block * 因爲使用全局的 local-variable-table 所以沒法在 nested block 中使用 local-variable ***** branch * example #+begin_src cicada-nymph : example << number1, number2, number3, number4 -- number1, number2 >> >::var2 >::var2 ::var2 end ; define-function #+end_src * result #+begin_src fasm define_function "example", example ;; >::var2 xx literal, 2, allocate_local_variable xx instruction__local_variable__n_set, 0, 2 ;; >::var2 xx instruction__local_variable__n_set, 0, 2 ;; ::var2 xx instruction__local_variable__n_get, 0, 2 xx end #+end_src * 看上面的例子可以發現 #+begin_src cicada-nymph : example if >::var2 else >::var2 then ::var2 end ; define-function #+end_src 不同分支下局部變元的編譯效果不等同了 *** local-variable-table ***** 記 * 只有一個 local-variable-table 用以在編譯時期解決局部變元的名與值的對應這個數據結構被 jojo_compiler_syntax__local_variable_set 和 jojo_compiler_syntax__local_variable_get 所使用 * 其中保存 * offset-in-local-variable * length-of-string * address-of-string * 並且每次在定義一個新的函數體的時候這個 local-variable-table 會被初始化 ***** 記接口 * (clear) 清空 offset 和 border * (insert) 插入字符串和 offset-in-local-variable * (find) 通過字符串尋找 offset-in-local-variable * 有兩個全局變量幫助實現這些接口 * (cursor) 每次 find 的時候使用一個新的 cursor 來做循環 * (border) insert 會擴大 border find 以 border 爲邊界 * 另外還有一個全局變量 * (offset) 用以計算 offset-in-local-variable ***** memory allocation #+begin_src fasm :tangle cicada-nymph.fasm size$local_variable_table = 100 * 1024 address$local_variable_table labeling preserve size$local_variable_table #+end_src ***** local-variable-table,clear #+begin_src fasm :tangle cicada-nymph.fasm border$local_variable_table: xx address$local_variable_table offset$local_variable_table: xx 0 define_function "local-variable-table,clear", local_variable_table__clear ;; << -- >> xx literal, address$local_variable_table xx literal, border$local_variable_table, set xx literal, 0 xx literal, offset$local_variable_table, set xx end #+end_src ***** local-variable-table,insert #+begin_src fasm :tangle cicada-nymph.fasm define_function "local-variable-table,insert", local_variable_table__insert ;; << string[address, length] -- offset >> ;; leave offset xx literal, offset$local_variable_table, get xx xxtuckx ;; return value xx literal, border$local_variable_table, get, set xx V__cell_size xx literal, border$local_variable_table, add_set ;; update offset$local_variable_table xx dup2 xx count_front_colon xx V__cell_size, multiple xx literal, offset$local_variable_table, add_set ;; leave length xx dup xx literal, border$local_variable_table, get, set xx V__cell_size xx literal, border$local_variable_table, add_set xx tuck ;; for to update border$local_variable_table ;; leave string xx literal, border$local_variable_table, get xx string_to_buffer! ;; update border$local_variable_table xx literal, border$local_variable_table, add_set xx end #+end_src ***** local-variable-table,find #+begin_src fasm :tangle cicada-nymph.fasm cursor$local_variable_table: xx address$local_variable_table define_function "local-variable-table,find", local_variable_table__find ;; << string[address, length] ;; -- offset, true ;; -- false >> xx literal, address$local_variable_table xx literal, cursor$local_variable_table, set xx local_variable_table__find__loop xx end define_function "local-variable-table,find,loop", local_variable_table__find__loop ;; << string[address, length] ;; -- offset, true ;; -- false >> xx literal, cursor$local_variable_table, get xx literal, border$local_variable_table, get xx greater_or_equal?, false?branch, 4 xx drop2 xx false xx end xx dup2 xx literal, cursor$local_variable_table, get xx V__cell_size, addition xx V__cell_size, addition ;; address of string xx literal, cursor$local_variable_table, get xx V__cell_size, addition xx get ;; length of string xx string_equal?, false?branch, 8 xx drop2 xx literal, cursor$local_variable_table, get xx get ;; offset xx true xx end xx literal, cursor$local_variable_table, get xx V__cell_size, addition xx get ;; length of string xx V__cell_size, addition xx V__cell_size, addition xx literal, cursor$local_variable_table, add_set xx tail_call, local_variable_table__find__loop #+end_src ***** count-front-colon #+begin_src fasm :tangle cicada-nymph.fasm define_function "count-front-colon", count_front_colon ;; << string[address, length] -- number >> xx literal, 0 ;; counter xx count_front_colon__loop xx end define_function "count-front-colon,loop", count_front_colon__loop ;; << string[address, length], counter -- number >> xx over, zero?, false?branch, 4 xx xxswapx, drop2 xx end xx xxoverx, string__byte xx literal, ':', equal?, false?, false?branch, 4 xx xxswapx, drop2 xx end xx add1, xxswapx xx string__byte_tail, xswapxx xx tail_call, count_front_colon__loop #+end_src *** two syntaxes ***** local-variable-get-word? * :name ::name * but not :name: ::name: #+begin_src fasm :tangle cicada-nymph.fasm define_function "local-variable-get-word?", local_variable_get_word? ;; << string[address, length] -- bool >> xx dup, zero?, false?branch, 4 xx drop2, false xx end xx dup2, addition, sub1 xx get_byte, literal, ':' xx equal?, false?branch, 4 xx drop2, false xx end xx dup2, count_front_colon xx dup, literal, 0, greater_than?, false?, false?branch, 5 xx drop, drop2, false xx end xx subtraction xx swap, drop xx literal, 0, greater_than? xx end #+end_src ***** jojo-compiler-syntax:local-variable-get #+begin_src fasm :tangle cicada-nymph.fasm define_function "jojo-compiler-syntax:local-variable-get", jojo_compiler_syntax__local_variable_get ;; << string[address, length], word[address, length] -- ;; string[address, length] >> xx dup2 xx local_variable_table__find, false?branch, (.not_found-$)/cell_size ;; instruction__local_variable__n_get, , n xx literal, instruction__local_variable__n_get xx jojo_area__stay ;; offset xx jojo_area__stay ;; n xx count_front_colon xx jojo_area__stay xx end .not_found: xx write_local_variable_not_bound_report xx write_string xx literal, 10, write_byte xx end define_function "write-local-variable-not-bound-report", write_local_variable_not_bound_report xx literal, string$local_variable_not_bound_report xx literal, length$local_variable_not_bound_report xx write_string xx end string$local_variable_not_bound_report: db "* local-variable not bound : " .end: length$local_variable_not_bound_report = (.end - string$local_variable_not_bound_report) #+end_src ***** local-variable-set-word? * >:name >::name * but not >:name: >::name: #+begin_src fasm :tangle cicada-nymph.fasm define_function "local-variable-set-word?", local_variable_set_word? ;; << string[address, length] -- bool >> xx dup, zero?, false?branch, 4 xx drop2, false xx end xx dup2, addition, sub1 xx get_byte, literal, ':' xx equal?, false?branch, 4 xx drop2, false xx end xx dup2, string__byte xx literal, '>', equal?, false?, false?branch, 4 xx drop2, false xx end xx string__byte_tail xx dup2, count_front_colon xx dup, literal, 0, greater_than?, false?, false?branch, 5 xx drop, drop2, false xx end xx subtraction xx swap, drop xx literal, 0, greater_than? xx end #+end_src ***** jojo-compiler-syntax:local-variable-set #+begin_src fasm :tangle cicada-nymph.fasm define_function "jojo-compiler-syntax:local-variable-set", jojo_compiler_syntax__local_variable_set ;; << string[address, length], word[address, length] -- ;; string[address, length] >> xx string__byte_tail xx dup2 xx local_variable_table__find, false?branch, (.not_found-$)/cell_size ;; instruction__local_variable__n_set, , n xx literal, instruction__local_variable__n_set xx jojo_area__stay ;; offset xx jojo_area__stay ;; n xx count_front_colon xx jojo_area__stay xx end .not_found: xx dup2 xx local_variable_table__insert xx xxswapx xx count_front_colon ;; literal, , allocate_local_variable xx literal, literal xx jojo_area__stay ;; number of jo xx dup, jojo_area__stay xx literal, allocate_local_variable xx jojo_area__stay ;; instruction__local_variable__n_set, , n xx literal, instruction__local_variable__n_set xx jojo_area__stay ;; offset xx swap xx jojo_area__stay ;; n xx jojo_area__stay xx end #+end_src * *local-memory* *** 記 * 並不需要給這裏的接口設計特殊的語法擴展直接使用函數就可以了 * 但是接口必須是 primitive-function 因爲否則遇到 end 和 tail_call 的時候 local_memory 就又被初始化了 *** 記使用 * 在一個函數內用 allocate-local-memory 所申請的局部數據空間是可以被這個函數內所調用的函數所使用的但是當函數退出的時候其所申請的空間就被結尾珠 (end) 收回了而沒法重用了而用 (tail-call) 來實現循環的時候下一次函數的執行過程中所申請的 allocate-local-memory 和上一次函數執行過程中所申請的 allocate-local-memory 是相同的 *** *local-memory-even* #+begin_src fasm :tangle cicada-nymph.fasm size$local_memory_even = 1024 * 1024 * 6 address$local_memory_even labeling preserve size$local_memory_even define_variable "*local-memory-even,current-free-address*", V__local_memory_even__current_free_address xx address$local_memory_even #+end_src *** *local-memory-odd* #+begin_src fasm :tangle cicada-nymph.fasm size$local_memory_odd = 1024 * 1024 * 6 address$local_memory_odd labeling preserve size$local_memory_odd define_variable "*local-memory-odd,current-free-address*", V__local_memory_odd__current_free_address xx address$local_memory_odd #+end_src *** 記奇偶性 * 用返回棧指針來判斷奇偶性對 explain$function 來說當前的 return-point 就是返回棧指針對結尾珠還有下面的兩個函數來說當前的 return-point 就是返回棧指針之前的一個單位 * 在偶的 return-point 其中 local-memory 域是 local-memory-even 其中 conjugate-local-memory 域是 local-memory-odd 在奇的 return-point 則相反 * 函數退出時只重置 local-memory 而不重置 conjugate-local-memory *** allocate-local-memory #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "allocate-local-memory", allocate_local_memory ;; << size -- address >> mov rax, pointer$return_stack sub rax, address$return_stack test rax, unit__return_point jnz .return_stack_even pop_argument_stack rbx mov rax, [V__local_memory_odd__current_free_address + cell_size] push_argument_stack rax add [V__local_memory_odd__current_free_address + cell_size], rbx next .return_stack_even: pop_argument_stack rbx mov rax, [V__local_memory_even__current_free_address + cell_size] push_argument_stack rax add [V__local_memory_even__current_free_address + cell_size], rbx next } match =32bit, machine { define_primitive_function "allocate-local-memory", allocate_local_memory ;; << size -- address >> mov rax, [pointer$return_stack] sub rax, address$return_stack test rax, unit__return_point jnz .return_stack_even pop_argument_stack rbx mov rax, [V__local_memory_odd__current_free_address + cell_size] push_argument_stack rax add [V__local_memory_odd__current_free_address + cell_size], rbx next .return_stack_even: pop_argument_stack rbx mov rax, [V__local_memory_even__current_free_address + cell_size] push_argument_stack rax add [V__local_memory_even__current_free_address + cell_size], rbx next } #+end_src *** allocate-conjugate-local-memory #+begin_src fasm :tangle cicada-nymph.fasm match =64bit, machine { define_primitive_function "allocate-conjugate-local-memory", allocate_conjugate_local_memory ;; << size -- address >> mov rax, pointer$return_stack sub rax, address$return_stack test rax, unit__return_point jnz .return_stack_even pop_argument_stack rbx mov rax, [V__local_memory_even__current_free_address + cell_size] push_argument_stack rax add [V__local_memory_even__current_free_address + cell_size], rbx next .return_stack_even: pop_argument_stack rbx mov rax, [V__local_memory_odd__current_free_address + cell_size] push_argument_stack rax add [V__local_memory_odd__current_free_address + cell_size], rbx next } match =32bit, machine { define_primitive_function "allocate-conjugate-local-memory", allocate_conjugate_local_memory ;; << size -- address >> mov rax, [pointer$return_stack] sub rax, address$return_stack test rax, unit__return_point jnz .return_stack_even pop_argument_stack rbx mov rax, [V__local_memory_even__current_free_address + cell_size] push_argument_stack rax add [V__local_memory_even__current_free_address + cell_size], rbx next .return_stack_even: pop_argument_stack rbx mov rax, [V__local_memory_odd__current_free_address + cell_size] push_argument_stack rax add [V__local_memory_odd__current_free_address + cell_size], rbx next } #+end_src *** test #+begin_src cicada-nymph : test,allocate-local-memory << -- address, address >> 16 allocate-local-memory 16 allocate-local-memory end ; define-function test,allocate-local-memory << 40218513 40218529 >> : test,allocate-local-memory,2 << -- address, address >> 16 allocate-local-memory test,allocate-local-memory 16 allocate-local-memory test,allocate-local-memory 16 allocate-local-memory end ; define-function test,allocate-local-memory,2 << 40218513 40218529 40218545 40218529 40218545 40218561 40218545 >> #+end_src * syscall *** note * there are two ways to treat the syscall 1. syscall is NOT expose to cicada-nymph system functions are wraped in assembly code thus make cicada-nymph code be more clean 2. syscall is expose to cicada-nymph system functions are wraped in cicada-nymph code thus more easy to wraped more system functions and make assembly code be more clean [only needs some system functions to load core file] * I choose the second way for now *** string->syscall-string #+begin_src fasm :tangle cicada-nymph.fasm string$string_to_syscall_string: times 256 db 0 define_function "string->syscall-string", string_to_syscall_string ;; << string[address, length] -- syscall-string[address] >> xx dup xx literal, string$string_to_syscall_string xx addition xx literal, 0 xx swap, set_byte xx literal, string$string_to_syscall_string xx string_to_buffer! xx literal, string$string_to_syscall_string xx end #+end_src *** string->syscall-string-2 #+begin_src fasm :tangle cicada-nymph.fasm string$string_to_syscall_string_2: times 256 db 0 define_function "string->syscall-string-2", string_to_syscall_string_2 ;; << string[address, length] -- syscall-string[address] >> xx dup xx literal, string$string_to_syscall_string_2 xx addition xx literal, 0 xx swap, set_byte xx literal, string$string_to_syscall_string_2 xx string_to_buffer! xx literal, string$string_to_syscall_string_2 xx end #+end_src *** syscall :64bit:linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =64bit, platform machine { define_primitive_function "syscall", CICADA__syscall ;; << ..., argument2, argument1, ;; syscall-number, ;; number-of-arguments ;; -- return-value >> pop_argument_stack rax cmp rax, 0 je __syscall_with_0 cmp rax, 1 je __syscall_with_1 cmp rax, 2 je __syscall_with_2 cmp rax, 3 je __syscall_with_3 cmp rax, 4 je __syscall_with_4 cmp rax, 5 je __syscall_with_5 cmp rax, 6 je __syscall_with_6 jmp __syscall_with_too_many __syscall_with_0: pop_argument_stack linux64_sys_n_rax syscall push_argument_stack rax next __syscall_with_1: pop_argument_stack linux64_sys_n_rax pop_argument_stack linux64_sys_1_rdi syscall push_argument_stack rax next __syscall_with_2: pop_argument_stack linux64_sys_n_rax pop_argument_stack linux64_sys_1_rdi pop_argument_stack linux64_sys_2_rsi syscall push_argument_stack rax next __syscall_with_3: pop_argument_stack linux64_sys_n_rax pop_argument_stack linux64_sys_1_rdi pop_argument_stack linux64_sys_2_rsi pop_argument_stack linux64_sys_3_rdx syscall push_argument_stack rax next __syscall_with_4: pop_argument_stack linux64_sys_n_rax pop_argument_stack linux64_sys_1_rdi pop_argument_stack linux64_sys_2_rsi pop_argument_stack linux64_sys_3_rdx pop_argument_stack linux64_sys_4_r10 syscall push_argument_stack rax next __syscall_with_5: pop_argument_stack linux64_sys_n_rax pop_argument_stack linux64_sys_1_rdi pop_argument_stack linux64_sys_2_rsi pop_argument_stack linux64_sys_3_rdx pop_argument_stack linux64_sys_4_r10 pop_argument_stack linux64_sys_5_r9 syscall push_argument_stack rax next __syscall_with_6: pop_argument_stack linux64_sys_n_rax pop_argument_stack linux64_sys_1_rdi pop_argument_stack linux64_sys_2_rsi pop_argument_stack linux64_sys_3_rdx pop_argument_stack linux64_sys_4_r10 pop_argument_stack linux64_sys_5_r9 pop_argument_stack linux64_sys_6_r8 syscall push_argument_stack rax next __syscall_with_too_many: call __exit_with_six } #+end_src *** syscall :32bit:linux: #+begin_src fasm :tangle cicada-nymph.fasm match =linux =32bit, platform machine { define_primitive_function "syscall", CICADA__syscall ;; << ..., argument2, argument1, ;; syscall-number, ;; number-of-arguments ;; -- return-value >> pop_argument_stack rax cmp rax, 0 je __syscall_with_0 cmp rax, 1 je __syscall_with_1 cmp rax, 2 je __syscall_with_2 cmp rax, 3 je __syscall_with_3 cmp rax, 4 je __syscall_with_4 cmp rax, 5 je __syscall_with_5 jmp __syscall_with_too_many __syscall_with_0: pop_argument_stack linux32_sys_n_eax syscall push_argument_stack rax next __syscall_with_1: pop_argument_stack linux32_sys_n_eax pop_argument_stack linux32_sys_1_ebx syscall push_argument_stack rax next __syscall_with_2: pop_argument_stack linux32_sys_n_eax pop_argument_stack linux32_sys_1_ebx pop_argument_stack linux32_sys_2_ecx syscall push_argument_stack rax next __syscall_with_3: pop_argument_stack linux32_sys_n_eax pop_argument_stack linux32_sys_1_ebx pop_argument_stack linux32_sys_2_ecx pop_argument_stack linux32_sys_3_edx syscall push_argument_stack rax next __syscall_with_4: pop_argument_stack linux32_sys_n_eax pop_argument_stack linux32_sys_1_ebx pop_argument_stack linux32_sys_2_ecx pop_argument_stack linux32_sys_3_edx pop_argument_stack linux32_sys_4_esi syscall push_argument_stack rax next __syscall_with_5: pop_argument_stack linux32_sys_n_eax pop_argument_stack linux32_sys_1_ebx pop_argument_stack linux32_sys_2_ecx pop_argument_stack linux32_sys_3_edx pop_argument_stack linux32_sys_4_esi pop_argument_stack linux32_sys_5_edi syscall push_argument_stack rax next __syscall_with_too_many: call __exit_with_six } #+end_src * epilog *** constant #+begin_src fasm :tangle cicada-nymph.fasm define_variable "*explainer,function*", CICADA__explain$function xx explain$function define_variable "*explainer,variable*", CICADA__explain$variable xx explain$variable #+end_src *** platform * this word is implemented as a function #+begin_src fasm :tangle cicada-nymph.fasm define_function "platform", the_platform xx literal, string$platform xx literal, length$platform xx end string$platform: match =linux, platform { db "linux" } .end: length$platform = (.end - string$platform) #+end_src *** *un-initialized-memory* #+begin_src fasm :tangle cicada-nymph.fasm define_variable "*un-initialized-memory*", V__un_initialized_memory xx address$un_initialized_memory define_variable "*un-initialized-memory,size*", V__un_initialized_memory__size xx size$un_initialized_memory define_variable "*un-initialized-memory,current-free-address*", V__un_initialized_memory__current_free_address xx current_free_address$un_initialized_memory #+end_src *** *string-area,current-free-address* * the last_name_string_in_assembly is just "*string-area,current-free-address*" #+begin_src fasm :tangle cicada-nymph.fasm define_variable "*string-area,current-free-address*", V__string_area__current_free_address xx current_free_address$string_area #+end_src *** the_last_link_in_assembly_code * this word helps to initialize V__link #+begin_src fasm :tangle cicada-nymph.fasm the_last_link_in_assembly_code = link #+end_src *** un_initialized_memory :linux: #+begin_src fasm :tangle cicada-nymph.fasm size$un_initialized_memory = 88 * 1024 * 1024 ;; (byte) match =linux, platform { segment readable writeable address$un_initialized_memory: rb size$un_initialized_memory } #+end_src