cicada-nymph.fasm

;;;; before you compile the code
;;;; do not forget to choose your platform
;;;; in the following code

include "platform-configuration.inc"

;; define platform linux or windows
;; define machine  64bit or 32bit

;; in fasm, "dup" is a reserved word
dup equ duplicate

;; in fasm, "end" is a reserved word
finish equ end
end equ exit

match =64bit, machine {

jo_size = 8 ;; (byte)
xx equ dq

}

match =32bit, machine {

jo_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

}

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_getpid 39
define linux64_syscall_exit   60
;; about open & read & write

open_read         = 0
open_write        = 1
open_readAndWrite = 2

open_creat      = 0100o
open_rewrite    = 1000o ;; rewrite if file exist
open_append     = 2000o

open_excl       = 0200o ;; ensure that THIS call creates the file
open_noctty     = 0400o
open_nonblock   = 4000o
open_nondelay   = open_nonblock
open_sync       = 10000o
open_async      = 20000o
open_direct     = 40000o
    ;; to minimize cache effects of the I/O to and from this file.

open_largefile  = 100000o
open_directory  = 200000o
open_nofollow   = 400000o ;; If pathname is a symbolic link, then the open fails.

}

match =linux =64bit, platform machine {

format ELF64 executable 3

}

match =linux =64bit, platform machine {

entry begin_to_interpret_threaded_code
segment readable executable writeable

}

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
define linux32_syscall_getpid  20

open_read         = 0
open_write        = 1
open_readAndWrite = 2

open_creat      = 0100o
open_rewrite    = 1000o ;; rewrite if file exist
open_append     = 2000o

}

match =linux =32bit, platform machine {

format ELF executable 3

}

match =linux =32bit, platform machine {

entry begin_to_interpret_threaded_code
segment readable executable writeable

}

match =windows =64bit, platform machine {

define windows64_fun_4_r9  r9
define windows64_fun_3_r8  r8
define windows64_fun_2_rdx rdx
define windows64_fun_1_rcx rcx

define STD_INPUT_HANDLE  -10
define STD_OUTPUT_HANDLE -11

}

match =windows =64bit, platform machine {

format PE64 console

}

match =windows =64bit, platform machine {

entry begin_to_interpret_threaded_code
section '.text' code writeable readable executable

}

match =windows =64bit, platform machine {


;; 這裏的 number_of_arguments 其實代表
;; 在對齊棧之後
;; 你還想要將棧的指針 向下移動多少個單位
;; 根據 windows calling convention
;; 這個數字最少是 4

macro windows64_function number_of_arguments \{
   push rbp
   mov rbp, rsp

   mov rax, rsp
   add rax, 8*number_of_arguments
   mov rbx, 1111b
   and rbx, rax

   sub rsp, 16
   add rsp, rbx
\}

macro end_windows64_function \{
   mov rsp, rbp
   pop rbp
\}


}

match =windows =32bit, platform machine {

define STD_INPUT_HANDLE  -10
define STD_OUTPUT_HANDLE -11

}

match =windows =32bit, platform machine {

format PE console

}

match =windows =32bit, platform machine {

entry begin_to_interpret_threaded_code
section '.text' code writeable readable executable

}

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 +

preserve 64 * jo_size
address$argument_stack labeling
   preserve 1024 * 1024 * jo_size

match =64bit, machine {

;; if you want to extend cicada in assembly
;; the following registers must NOT be used

define pointer$argument_stack r15

}

match =64bit, machine {

macro push_argument_stack register \{
   mov [pointer$argument_stack], register
   add pointer$argument_stack, jo_size
\}

macro pop_argument_stack register \{
   sub pointer$argument_stack, jo_size
   mov register, [pointer$argument_stack]
\}

}

match =32bit, machine {

pointer$argument_stack:
   xx address$argument_stack

}

match =32bit, machine {

macro push_argument_stack register \{
   if register in <eax>
   push ebx
   mov ebx, [pointer$argument_stack]
   mov [ebx], register
   add ebx, jo_size
   mov [pointer$argument_stack], ebx
   pop ebx
   else
   push eax
   mov eax, [pointer$argument_stack]
   mov [eax], register
   add eax, jo_size
   mov [pointer$argument_stack], eax
   pop eax
   finish if
\}

macro pop_argument_stack register \{
   if register in <eax>
   push ebx
   mov ebx, [pointer$argument_stack]
   sub ebx, jo_size
   mov register, [ebx]
   mov [pointer$argument_stack], ebx
   pop ebx
   else
   push eax
   mov eax, [pointer$argument_stack]
   sub eax, jo_size
   mov register, [eax]
   mov [pointer$argument_stack], eax
   pop eax
   finish if
\}

}

preserve 64 * jo_size
address$return_stack labeling
   preserve 1024 * 1024 * jo_size

match =64bit, machine {

;; if you want to extend cicada in assembly
;; the following registers must NOT be used

define pointer$return_stack r14

}

match =64bit, machine {

macro push_return_stack register \{
   mov [pointer$return_stack], register
   add pointer$return_stack, jo_size
\}

macro pop_return_stack register \{
   sub pointer$return_stack, jo_size
   mov register, [pointer$return_stack]
\}

}

match =32bit, machine {

pointer$return_stack:
   xx address$return_stack

}

match =32bit, machine {

macro push_return_stack register \{
   if register in <eax>
   push ebx
   mov ebx, [pointer$return_stack]
   mov [ebx], register
   add ebx, jo_size
   mov [pointer$return_stack], ebx
   pop ebx
   else
   push eax
   mov eax, [pointer$return_stack]
   mov [eax], register
   add eax, jo_size
   mov [pointer$return_stack], eax
   pop eax
   finish if
\}

macro pop_return_stack register \{
   if register in <eax>
   mov ebx, [pointer$return_stack]
   sub ebx, jo_size
   mov register, [ebx]
   mov [pointer$return_stack], ebx
   else
   mov eax, [pointer$return_stack]
   sub eax, jo_size
   mov register, [eax]
   mov [pointer$return_stack], eax
   finish if
\}

}

match =64bit, machine {

macro next \{
   pop_return_stack rbx
     mov rax, [rbx]
   add rbx, jo_size
   push_return_stack rbx
     jmp qword [rax]
\}

}


match =32bit, machine {

macro next \{
   pop_return_stack rbx
     mov rax, [rbx]
   add rbx, jo_size
   push_return_stack rbx
     jmp dword [rax]
\}

}

match =linux =64bit, platform machine {

__exit_with_TOS:
   pop_argument_stack linux64_sys_1_rdi
   mov linux64_sys_n_rax, linux64_syscall_exit
   syscall

}

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 =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_TOS:
   pop_argument_stack linux32_sys_1_ebx
   mov linux32_sys_n_eax, linux32_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

}

match =linux =32bit, platform machine {

__exit_with_six:
   mov linux32_sys_1_ebx, 6
   mov linux32_sys_n_eax, linux32_syscall_exit
   syscall

}

match =windows =64bit, platform machine {

__exit_with_TOS:

windows64_function 4
   sub rsp, 8*4
   pop_argument_stack windows64_fun_1_rcx
   call [ExitProcess]
end_windows64_function

}

match =windows =64bit, platform machine {

__exit_with_zero:

windows64_function 4
   sub rsp, 8*4
   xor windows64_fun_1_rcx, windows64_fun_1_rcx
   call [ExitProcess]
end_windows64_function

}

match =windows =64bit, platform machine {

__exit_with_six:

windows64_function 4
   sub rsp, 8*4
   mov windows64_fun_1_rcx, 6
   call [ExitProcess]
end_windows64_function

}

match =windows =32bit, platform machine {

__exit_with_TOS:

   pop_argument_stack rax
   push rax
   call [ExitProcess]

}

match =windows =32bit, platform machine {

__exit_with_zero:

   push 0
   call [ExitProcess]

}

match =windows =32bit, platform machine {

__exit_with_six:

   push 6
   call [ExitProcess]

}

;; initial link to point to 0 (as null)
link = 0

size$primitive_string_heap = 64 * 1024 ;; (byte)

address$primitive_string_heap:
   times size$primitive_string_heap db 0

current_free_address$primitive_string_heap = address$primitive_string_heap

macro make_primitive_string string {

virtual at 0
.start$string:
   db string
.end$string:
   dw (.end$string - .start$string)
   load .length word from (.end$string)
finish virtual
store word .length at (current_free_address$primitive_string_heap)

current_free_address$primitive_string_heap = current_free_address$primitive_string_heap + 2

repeat .length
   virtual at 0
      db string
      load .char byte from (% - 1)
   finish virtual
   store byte .char at (current_free_address$primitive_string_heap)
   current_free_address$primitive_string_heap = current_free_address$primitive_string_heap + 1
finish repeat

}

macro define_function string, jo {

define_function__#jo:

name__#jo:
   xx current_free_address$primitive_string_heap

   make_primitive_string string

link__#jo:
   xx link
   link = link__#jo

jo:
   xx explain$function

   ;; here follows a jojo as function-body

}

explain$function:
   mov rbx, [current_free_address$local_data_heap]
   push_return_stack rbx
   add rax, jo_size
   push_return_stack rax
   next

macro define_primitive_function string, jo {

define_primitive_function__#jo:

name__#jo:
   xx current_free_address$primitive_string_heap

   make_primitive_string string

link__#jo:
   xx link
   link = link__#jo

jo:
   xx assembly_code__#jo

assembly_code__#jo:

   ;; here follows assembly code
   ;; as primitive function body

}

macro define_variable string, jo {

define_variable__#jo:

name__#jo:
   xx current_free_address$primitive_string_heap

   make_primitive_string string

link__#jo:
   xx link
   link = link__#jo

jo:
   xx explain$variable

   ;; here follows a value of jo_size
   ;; only one value is allowed

}

explain$variable:
   add rax, jo_size
   mov rbx, [rax]
   push_argument_stack rbx
   next

macro define_macro string, jo {

define_macro__#jo:

name__#jo:
   xx current_free_address$primitive_string_heap

   make_primitive_string string

link__#jo:
   xx link
   link = link__#jo

jo:
   xx explain$macro

   ;; here follows a jojo as function-body

}

explain$macro:
   mov rbx, [current_free_address$local_data_heap]
   push_return_stack rbx
   add rax, jo_size
   push_return_stack rax
   next

macro define_exception string, jo {

define_exception__#jo:

name__#jo:
   xx current_free_address$primitive_string_heap

   make_primitive_string string

link__#jo:
   xx link
   link = link__#jo

jo:
   xx explain$exception

   ;; here follows a jojo as function-body

}

match =64bit, machine {

explain$exception:
   mov rsi, rax

.next_jojo:
   pop_return_stack rbx
   mov rax, qword [rbx]
   cmp rax, exception_head
   je .next_jo
   cmp pointer$return_stack, address$return_stack
   je .not_found
   jmp .next_jojo


.next_jo:
   ;; expecting
   ;;   rbx jojo
   ;;   rsi jo (to cmp)
   add rbx, jo_size
   mov rax, qword [rbx]
   cmp rax, rsi
   je .found
   test rax, rax
   jz .next_jojo
   jmp .next_jo


.found:
   ;; expecting
   ;;   pointer$return_stack
   ;;   rsi jo
   pop_return_stack rax
   mov pointer$argument_stack, rax

   mov rbx, [current_free_address$local_data_heap]
   push_return_stack rbx

   add rsi, jo_size
   push_return_stack rsi
   next

.not_found:
   call __exit_with_six

}

match =32bit, machine {

explain$exception:
   mov rsi, rax

.next_jojo:
   pop_return_stack rbx
   mov rax, dword [rbx]
   cmp rax, exception_head
   je .next_jo
   mov rdx, [pointer$return_stack]
   cmp rdx, address$return_stack
   je .not_found
   jmp .next_jojo


.next_jo:
   ;; expecting
   ;;   rbx jojo
   ;;   rsi jo (to cmp)
   add rbx, jo_size
   mov rax, dword [rbx]
   cmp rax, rsi
   je .found
   test rax, rax
   jz .next_jojo
   jmp .next_jo


.found:
   ;; expecting
   ;;   pointer$return_stack
   ;;   rsi jo
   pop_return_stack rax
   mov [pointer$argument_stack], rax

   mov rbx, [current_free_address$local_data_heap]
   push_return_stack rbx

   add rsi, jo_size
   push_return_stack rsi
   next

.not_found:
   call __exit_with_six

   }

match =64bit, machine {

define_primitive_function "execute-jo", execute_jo
   ;; << jo -- UNKNOWN >>
   pop_argument_stack rax
   jmp qword [rax]

}


match =32bit, machine {

define_primitive_function "execute-jo", execute_jo
   ;; << jo -- UNKNOWN >>
   pop_argument_stack eax
   jmp dword [eax]

}

define_variable "*jo-size*", V__jo_size
   xx jo_size

define_function "jo->name", jo_to_name
   ;; << jo -- string[address, length] >>
   xx literal, jo_size, subtraction
   xx literal, jo_size, subtraction
   xx fetch
   xx address_to_primitive_string
   xx end

define_function "jo->link", jo_to_link
   ;; << jo -- link >>
   xx literal, jo_size
   xx subtraction
   xx end

define_function "last-jo,dictionary?", last_jo__dictionary?
   ;; << jo -- bool >>
   xx jo_to_link
   xx fetch
   xx zero?
   xx end

define_function "jo->pre-jo", jo_to_pre_jo
   ;; << jo -- pre-jo >>
   xx jo_to_link
   xx fetch
   xx dup, zero?, false?branch, 2
   xx   end
   xx literal, jo_size
   xx addition
   xx end

define_function "jo->type", jo_to_type
   ;; << jo -- type >>
   xx dup

   xx dup, fetch
   xx swap, subtraction, literal, jo_size, equal?, false?branch, 4
   xx   drop, zero
   xx   end

   xx fetch
   xx end

define_variable "*primitive-string-heap*", V__primitive_string_heap
   xx address$primitive_string_heap

define_variable "*size,primitive-string-heap*", V__size__primitive_string_heap
   xx size$primitive_string_heap

;; *current-free-address,primitive-string-heap*
;; is at epilog

define_function "address->primitive-string", address_to_primitive_string
   ;; << address -- string[address, length] >>
   xx dup
   xx literal, 2, addition  ;; address
   xx swap, fetch_two_bytes ;; length
   xx end

define_function "primitive-function-jo?", primitive_function_jo?
   ;; << jo -- bool >>
   xx jo_to_type
   xx zero?
   xx end

define_function "function-jo?", function_jo?
   ;; << jo -- bool >>
   xx jo_to_type
   xx literal, explain$function
   xx equal?
   xx end

define_function "macro-jo?", macro_jo?
   ;; << jo -- bool >>
   xx jo_to_type
   xx literal, explain$macro
   xx equal?
   xx end

define_function "exception-jo?", exception_jo?
   ;; << jo -- bool >>
   xx jo_to_type
   xx literal, explain$exception
   xx equal?
   xx end

define_function "variable-jo?", variable_jo?
   ;; << jo -- bool >>
   xx jo_to_type
   xx literal, explain$variable
   xx equal?
   xx end

define_primitive_function "end", end
   pop_return_stack rbx
   pop_return_stack rax
   mov [current_free_address$local_data_heap], rax
   next

match =64bit, machine {

define_primitive_function "<>", taca
   pop_return_stack rbx
   pop_return_stack rax
   mov [current_free_address$local_data_heap], rax
   mov rax, [rbx]
   jmp qword [rax]
}


match =32bit, machine {

define_primitive_function "<>", taca
   pop_return_stack ebx
   pop_return_stack ecx
   mov [current_free_address$local_data_heap], ecx
   mov eax, [ebx]
   jmp dword [eax]

;; ><><>< can not be the following
;; maybe still something wrong with pop_return_stack
;; but I care less about this now
;; define_primitive_function "<>", taca
;;    pop_return_stack ebx
;;    pop_return_stack eax
;;    mov [current_free_address$local_data_heap], eax
;;    mov eax, [ebx]
;;    jmp dword [eax]

}

match =linux =64bit, platform machine {

begin_to_interpret_threaded_code:

   cld ;; set DF = 0, then rsi and rdi are incremented

   mov pointer$argument_stack,  address$argument_stack
   mov pointer$return_stack,    address$return_stack

   mov rax, first_jojo
   push_return_stack rax
   next

}

match =linux =32bit, platform machine {

begin_to_interpret_threaded_code:

   cld ;; set DF = 0, then rsi and rdi are incremented

   mov eax, first_jojo
   push_return_stack eax
   next

}

match =windows =64bit, platform machine {

_output_handle:
   xx 0
_input_handle:
   xx 0

begin_to_interpret_threaded_code:

   cld ;; set DF = 0, then rsi and rdi are incremented

windows64_function 4
   sub rsp, 8*4
   mov windows64_fun_1_rcx, STD_INPUT_HANDLE
   call [GetStdHandle]
   mov [_input_handle], rax
end_windows64_function

windows64_function 4
   sub rsp, 8*4
   mov windows64_fun_1_rcx, STD_OUTPUT_HANDLE
   call [GetStdHandle]
   mov [_output_handle], rax
end_windows64_function

   mov pointer$argument_stack,  address$argument_stack
   mov pointer$return_stack,    address$return_stack

   mov rax, first_jojo
   push_return_stack rax
   next

}

match =windows =32bit, platform machine {

_output_handle:
   xx 0
_input_handle:
   xx 0

begin_to_interpret_threaded_code:

   cld ;; set DF = 0, then rsi and rdi are incremented

   push STD_INPUT_HANDLE
   call [GetStdHandle]
   mov [_input_handle], rax

   push STD_OUTPUT_HANDLE
   call [GetStdHandle]
   mov [_output_handle], rax

   mov rax, first_jojo
   push_return_stack rax
   next

}

first_jojo:
   xx welcome
   ;; xx little_test
   xx initialize_dispatch_word_stack
   xx initialize_local_variable
match =linux, platform {
   xx init_operating_system_environment
}
   xx load_core_file
   xx basic_REPL

define_function "welcome", welcome
   ;; << -- >>
   xx literal, string$welcome_to_cicada_nymph
   xx literal, length$welcome_to_cicada_nymph
   xx write_string
   xx end

string$welcome_to_cicada_nymph:
   db 10
   db "* welcome to cicada-nymph ^-^"
   db 10
.end:
length$welcome_to_cicada_nymph = (.end - string$welcome_to_cicada_nymph)

define_primitive_function "bye", exit_with_TOS
   call __exit_with_TOS

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, fetch, add2
   ;; xx address, V__little_test_number, save
   ;; 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

   ;;;; taca
   ;; 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 <return>
   ;;;; 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_for_REPL, 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

   ;;;; use jo_to_name to test the macro make_primitive_string
   ;; xx literal, jo_to_name, jo_to_name, write_string
   ;; xx literal, 10, write_byte
   ;; xx literal, addition, jo_to_name, write_string
   ;; xx literal, 10, write_byte
   ;; xx zero
   ;; xx exit_with_TOS
   ;;;; print "jo->name"
   ;;;; print "add"

   ;;;; 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
   ;; xx read_word, string_to_integer ;; number
   ;; xx read_word, string_to_integer ;; number
   ;; xx read_word, find ;; add
   ;; xx drop ;; true
   ;; xx execute_jo
   ;; 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 .

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

match =64bit, machine {

define_primitive_function "dup", dup
   ;; << a -- a, a >>
   mov  rax, [pointer$argument_stack - (1 * jo_size)]
   push_argument_stack rax
   next

define_primitive_function "dup2", dup2
   ;; << a b -- a b a b >>
   mov  rbx, [pointer$argument_stack - (1 * jo_size)]
   mov  rax, [pointer$argument_stack - (2 * jo_size)]
   push_argument_stack rax
   push_argument_stack rbx
   next

}

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

}

match =64bit, machine {

define_primitive_function "over", over
   ;; << a b -- a b | a >>
   mov  rax, [pointer$argument_stack - (2 * jo_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 * jo_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 * jo_size)]
   push_argument_stack rax
   mov  rax, [pointer$argument_stack - (3 * jo_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 * jo_size)]
   push_argument_stack rax
   mov  rax, [pointer$argument_stack - (4 * jo_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 * jo_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 * jo_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 * jo_size)]
   push_argument_stack rax
   mov  rax, [pointer$argument_stack - (6 * jo_size)]
   push_argument_stack rax
   next

}

match =32bit, machine {

define_primitive_function "over", over
   ;; << a b -- a b | a >>
   mov rbx, [pointer$argument_stack]
   mov rax, [rbx - (2 * jo_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 * jo_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 * jo_size)]
   push_argument_stack rax
   mov rax, [rbx - (2 * jo_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 * jo_size)]
   push_argument_stack rax
   mov rax, [rbx - (3 * jo_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 * jo_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 * jo_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 * jo_size)]
   push_argument_stack rax
   mov rax, [rbx - (5 * jo_size)]
   push_argument_stack rax
   next

}

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

match =64bit, machine {

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 r8 ;; 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 r8 ;; 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 r8 ;; e
   pop_argument_stack rdx
   pop_argument_stack rcx
   pop_argument_stack rbx
   pop_argument_stack rax
   push_argument_stack r8 ;; 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 r9 ;; f
   pop_argument_stack r8 ;; 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 r8 ;; e
   push_argument_stack r9 ;; 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 r9 ;; f
   pop_argument_stack r8 ;; e
   pop_argument_stack rdx
   pop_argument_stack rcx
   pop_argument_stack rbx
   pop_argument_stack rax
   push_argument_stack r8 ;; e
   push_argument_stack r9 ;; f
   push_argument_stack rax
   push_argument_stack rbx
   push_argument_stack rcx
   push_argument_stack rdx
   next

}

match =32bit, machine {

define_primitive_function "swap", swap
   ;; << a b -- b a >>
   pop_argument_stack ebx
   pop_argument_stack eax
   push_argument_stack ebx
   push_argument_stack eax
   next

define_primitive_function "x|swap|xx", xswapxx
   ;; << a | b c -- b c | a >>
   pop_argument_stack ecx
   pop_argument_stack ebx
   pop_argument_stack eax
   push_argument_stack ebx
   push_argument_stack ecx
   push_argument_stack eax
   next

define_primitive_function "xx|swap|x", xxswapx
   ;; << a b | c -- c | a b >>
   pop_argument_stack ecx
   pop_argument_stack ebx
   pop_argument_stack eax
   push_argument_stack ecx
   push_argument_stack eax
   push_argument_stack ebx
   next

define_primitive_function "x|swap|xxx", xswapxxx
   ;; << a | b c d -- b c d | a >>
   pop_argument_stack edx
   pop_argument_stack ecx
   pop_argument_stack ebx
   pop_argument_stack eax
   push_argument_stack ebx
   push_argument_stack ecx
   push_argument_stack edx
   push_argument_stack eax
   next

define_primitive_function "xxx|swap|x", xxxswapx
   ;; << a b c | d -- d | a b c >>
   pop_argument_stack edx
   pop_argument_stack ecx
   pop_argument_stack ebx
   pop_argument_stack eax
   push_argument_stack edx
   push_argument_stack eax
   push_argument_stack ebx
   push_argument_stack ecx
   next

define_primitive_function "xx|swap|xx", xxswapxx
   ;; << a b | c d -- c d | a b >>
   pop_argument_stack edx
   pop_argument_stack ecx
   pop_argument_stack ebx
   pop_argument_stack eax
   push_argument_stack ecx
   push_argument_stack edx
   push_argument_stack eax
   push_argument_stack ebx
   next


define_primitive_function "x|swap|xxxx", xswapxxxx
   ;; << a | b c d e -- b c d e | a >>
   pop_argument_stack eax ;; e
   push eax

   pop_argument_stack edx
   pop_argument_stack ecx
   pop_argument_stack ebx
   pop_argument_stack eax
   push_argument_stack ebx
   push_argument_stack ecx
   push_argument_stack edx

   pop eax
   push_argument_stack eax ;; e

   push_argument_stack eax
   next

define_primitive_function "xxxx|swap|x", xxxxswapx
   ;; << a b c d | e --  e | a b c d >>
   pop_argument_stack eax ;; e
   push eax

   pop_argument_stack edx
   pop_argument_stack ecx
   pop_argument_stack ebx
   pop_argument_stack eax

   pop eax
   push_argument_stack eax ;; e

   push_argument_stack eax
   push_argument_stack ebx
   push_argument_stack ecx
   push_argument_stack edx
   next


define_primitive_function "xx|swap|xxxx", xxswapxxxx
   ;; << a b | c d e f -- c d e f | a b >>
   pop_argument_stack eax ;; f
   push eax

   pop_argument_stack eax ;; e
   push eax

   pop_argument_stack edx
   pop_argument_stack ecx
   pop_argument_stack ebx
   pop_argument_stack eax
   push_argument_stack ecx
   push_argument_stack edx

   pop eax
   push_argument_stack eax ;; e

   pop eax
   push_argument_stack eax ;; f

   push_argument_stack eax
   push_argument_stack ebx
   next

define_primitive_function "xxxx|swap|xx", xxxxswapxx
   ;; << a b c d | e f --  e f | a b c d >>
   pop_argument_stack eax ;; f
   push eax

   pop_argument_stack eax ;; e
   push eax

   pop_argument_stack edx
   pop_argument_stack ecx
   pop_argument_stack ebx
   pop_argument_stack eax

   pop eax
   push_argument_stack eax ;; e

   pop eax
   push_argument_stack eax ;; f

   push_argument_stack eax
   push_argument_stack ebx
   push_argument_stack ecx
   push_argument_stack edx
   next

}

define_variable "*the-stack*", V__the_stack
   xx address$argument_stack

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 + jo_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 + jo_size], eax
   next

}

define_variable "*literal*", V__literal
   xx literal

define_primitive_function "", literal
   ;; << -- fixnum >>
   pop_return_stack rbx
     mov rax, [rbx]
     push_argument_stack rax
   add rbx, jo_size
   push_return_stack rbx
   next

define_variable "*address*", V__address
   xx address

define_primitive_function "", address
   ;; << -- address >>
   pop_return_stack rbx
     mov rax, [rbx]
     add rax, jo_size
     push_argument_stack rax
   add rbx, jo_size
   push_return_stack rbx
   next

define_variable "*branch*", V__branch
   xx branch

define_primitive_function "", branch
   pop_return_stack rbx
   mov rax, [rbx]
   imul rax, jo_size
   add rbx, rax
   push_return_stack rbx
   next

define_variable "*false?branch*", V__false?branch
   xx false?branch

define_primitive_function "", 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, jo_size
   add rbx, rax
   push_return_stack rbx
   next

help__false?branch__not_to_branch:
   pop_return_stack rbx
   add rbx, jo_size
   push_return_stack rbx
   next

match =64bit, machine {

define_primitive_function "", prepare_for
   ;; << -- >>
   pop_return_stack rbx
   pop_return_stack rcx
   push_return_stack pointer$argument_stack
   push_return_stack rbx
   push_return_stack rcx
.next:
   add rbx, jo_size
   mov rax, qword [rbx]
   cmp rax, end_of_prepare
   je .then
   jmp .next
.then:
   add rbx, jo_size
   push_return_stack rbx
   next

}

match =32bit, machine {

define_primitive_function "", prepare_for
   ;; << -- >>
   pop_return_stack ebx
   pop_return_stack ecx
   mov eax, [pointer$argument_stack]
   push_return_stack eax
   push_return_stack ebx
   push_return_stack ecx
.next:
   add ebx, jo_size
   mov eax, dword [ebx]
   cmp eax, end_of_prepare
   je .then
   jmp .next
.then:
   add ebx, jo_size
   push_return_stack ebx
   next

}

define_variable "*end-of-prepare*", V__end_of_prepare

end_of_prepare:
   xx 0

define_primitive_function "", exception_head
   ;; << -- >>
   pop_return_stack rax
   pop_return_stack rax
   next

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

define_function "false?", false?
   ;; << bool -- bool >>
   xx false, equal?
   xx end

define_function "true?", true?
   ;; << bool -- bool >>
   xx true, equal?
   xx end

match =64bit, machine {

define_primitive_function "bitwise-and", bitwise_and
   ;; << a, b -- a and b >>
   pop_argument_stack rbx
   and [pointer$argument_stack - (1 * jo_size)], rbx
   next

define_primitive_function "bitwise-or", bitwise_or
   ;; << a, b -- a or b >>
   pop_argument_stack rbx
   or  [pointer$argument_stack - (1 * jo_size)], rbx
   next

define_primitive_function "bitwise-xor", bitwise_xor
   ;; << a, b -- a xor b >>
   pop_argument_stack rbx
   xor [pointer$argument_stack - (1 * jo_size)], rbx
   next

define_primitive_function "bitwise-invert", bitwise_invert
   ;; << a -- invert a >>
   not qword [pointer$argument_stack - (1 * jo_size)]
   next

}

match =32bit, machine {

define_primitive_function "bitwise-and", bitwise_and
   ;; << a, b -- a and b >>
   pop_argument_stack rbx
   mov rax, [pointer$argument_stack]
   and [rax - (1 * jo_size)], rbx
   next

define_primitive_function "bitwise-or", bitwise_or
   ;; << a, b -- a or b >>
   pop_argument_stack rbx
   mov rax, [pointer$argument_stack]
   or  [rax - (1 * jo_size)], rbx
   next

define_primitive_function "bitwise-xor", bitwise_xor
   ;; << a, b -- a xor b >>
   pop_argument_stack rbx
   mov rax, [pointer$argument_stack]
   xor [rax - (1 * jo_size)], rbx
   next

define_primitive_function "bitwise-invert", bitwise_invert
   ;; << a -- invert a >>
   mov rax, [pointer$argument_stack]
   not dword [rax - (1 * jo_size)]
   next

}

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

define_function "zero?", zero?
   ;; << bool -- bool >>
   xx zero, equal?
   xx end

define_function "one?", one?
   ;; << bool -- bool >>
   xx one, equal?
   xx end

match =64bit, machine {

define_primitive_function "add1", add1
   ;; << n -- n+1 >>
   inc qword [pointer$argument_stack - (1 * jo_size)]
   next

define_primitive_function "add2", add2
   ;; << n -- n+2 >>
   add qword [pointer$argument_stack - (1 * jo_size)], 2
   next

define_primitive_function "add3", add3
   ;; << n -- n+3 >>
   add qword [pointer$argument_stack - (1 * jo_size)], 3
   next

define_primitive_function "add4", add4
   ;; << n -- n+4 >>
   add qword [pointer$argument_stack - (1 * jo_size)], 4
   next

define_primitive_function "add8", add8
   ;; << n -- n+8 >>
   add qword [pointer$argument_stack - (1 * jo_size)], 8
   next


define_primitive_function "sub1", sub1
   ;; << n -- n-1 >>
   dec qword [pointer$argument_stack - (1 * jo_size)]
   next

define_primitive_function "sub2", sub2
   ;; << n -- n-2 >>
   sub qword [pointer$argument_stack - (1 * jo_size)], 2
   next

define_primitive_function "sub3", sub3
   ;; << n -- n-3 >>
   sub qword [pointer$argument_stack - (1 * jo_size)], 3
   next

define_primitive_function "sub4", sub4
   ;; << n -- n-4 >>
   sub qword [pointer$argument_stack - (1 * jo_size)], 4
   next

define_primitive_function "sub8", sub8
   ;; << n -- n-8 >>
   sub qword [pointer$argument_stack - (1 * jo_size)], 8
   next


define_primitive_function "add", addition
   ;; << a b -- a+b >>
   pop_argument_stack rax
   add qword [pointer$argument_stack - (1 * jo_size)], rax
   next

define_primitive_function "sub", subtraction
   ;; << a b -- a-b >>
   pop_argument_stack rax
   sub qword [pointer$argument_stack - (1 * jo_size)], rax
   next

}

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

}

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 save the result into the first register
   push_argument_stack rbx
   next

define_function "negate", negate
   ;; << n --  -n >>
   xx zero
   xx swap, subtraction
   xx end

define_function "power", power
   ;; n must be nature number for now
   ;; << a, n -- a^n >>
   xx literal, 1, swap ;; leave product
   xx help__power
   xx end

define_function "help,power", help__power
   ;; << 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 taca, help__power

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

define_primitive_function "equal?", equal?
   ;; << a, b -- a, b, true of false >>
   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

define_function "negative?", negative?
   ;; << integer -- bool >>
   xx zero, less_than?
   xx end

define_function "positive?", positive?
   ;; << integer -- bool >>
   xx negative?, false?
   xx end

match =64bit, machine {

;; "save" and "fetch" default to a jo_size
;; the rule of "fetch2" and so on are:
;;   in memory:
;;     ||  1 : value-1  ||
;;     ||  1 : value-2  ||
;;     ||  1 : value-3  ||
;;     ...
;;   on stack:
;;     << value-1, value-2, value-3, ... >>
;; of course we have:
;;   fetch2 : memory=copy=>stack
;;   save2  : stack->memory

define_primitive_function "save", save
   ;; ( value, address -- )
   pop_argument_stack rbx
   pop_argument_stack rax
   mov [rbx], rax
   next

define_primitive_function "save-byte", save_byte
   ;; ( value, address -- )
   pop_argument_stack rbx
   pop_argument_stack rax
   mov byte[rbx], al
   next

define_primitive_function "save-two-bytes", save_two_bytes
   ;; ( value, address -- )
   pop_argument_stack rbx
   pop_argument_stack rax
   mov word [rbx], ax
   next

define_primitive_function "save-four-bytes", save_four_bytes
   ;; ( value, address -- )
   pop_argument_stack rbx
   pop_argument_stack rax
   mov dword [rbx], eax
   next

define_primitive_function "n-save", n_save
   ;; << value-n, ..., value-1, address, n -- >>
   pop_argument_stack rcx
   pop_argument_stack rdx
   mov rax, jo_size
   imul rax, rcx
   add rdx, rax
   ;; for address is based on 0
   ;; but n is based on 1
   sub rdx, jo_size
.loop:
   pop_argument_stack rax
   mov qword [rdx], rax
   sub rdx, jo_size
   loop .loop
   next

define_function "save2", save2
   ;; << value-2, value-1, address -- >>
   xx literal, 2
   xx n_save
   xx end

define_primitive_function "n-save-byte", n_save_byte
   ;; << value-n, ..., value-1, address, n -- >>
   pop_argument_stack rcx
   pop_argument_stack rdx
   add rdx, rcx
   dec rdx
.loop:
   pop_argument_stack rax
   mov byte [rdx], al
   dec rdx
   loop .loop
   next

define_primitive_function "add-save", add_save
   ;; ( number to add, address -- )
   pop_argument_stack rbx
   pop_argument_stack rax
   add qword [rbx], rax
   next

define_primitive_function "sub-save", sub_save
   ;; ( number to add, address -- )
   pop_argument_stack rbx
   pop_argument_stack rax
   sub qword [rbx], rax
   next

}

match =64bit, machine {

define_primitive_function "fetch", fetch
   ;; ( address -- value )
   pop_argument_stack  rbx
   mov rax, [rbx]
   push_argument_stack rax
   next

define_primitive_function "fetch-byte", fetch_byte
   ;; ( address -- value )
   pop_argument_stack rbx
   xor rax, rax
   mov al, byte[rbx]
   push_argument_stack rax
   next

define_primitive_function "fetch-two-bytes", fetch_two_bytes
   ;; ( address -- value )
   pop_argument_stack rbx
   xor rax, rax
   mov ax, word [rbx]
   push_argument_stack rax
   next

define_primitive_function "fetch-four-bytes", fetch_four_bytes
   ;; ( address -- value )
   pop_argument_stack rbx
   xor rax, rax
   mov eax, dword [rbx]
   push_argument_stack rax
   next

;;   in memory:
;;     ||  1 : value-1  ||
;;     ...
;;     ||  1 : value-n  ||
define_primitive_function "n-fetch", n_fetch
   ;; << 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, jo_size
   loop .loop
   next

define_primitive_function "n-fetch-byte", n_fetch_byte
   ;; << address, n -- byte-1, ..., byte-n >>
   pop_argument_stack  rcx
   pop_argument_stack  rdx
   xor rax, rax
.loop:
   mov al, byte [rdx]
   push_argument_stack rax
   inc rdx
   loop .loop
   next

define_function "fetch2", fetch2
   ;; << address -- value-1, value-2 >>
   xx literal, 2
   xx n_fetch
   xx end

}

match =32bit, machine {

;; "save" and "fetch" default to a jo_size
;; the rule of "fetch2" and so on are:
;;   in memory:
;;     ||  1 : value-1  ||
;;     ||  1 : value-2  ||
;;     ||  1 : value-3  ||
;;     ...
;;   on stack:
;;     << value-1, value-2, value-3, ... >>
;; of course we have:
;;   fetch2 : memory=copy=>stack
;;   save2  : stack->memory

define_primitive_function "save", save
   ;; ( value, address -- )
   pop_argument_stack rbx
   pop_argument_stack rax
   mov [rbx], rax
   next

define_primitive_function "save-byte", save_byte
   ;; ( value, address -- )
   pop_argument_stack rbx
   pop_argument_stack rax
   mov byte[rbx], al
   next

define_primitive_function "save-two-bytes", save_two_bytes
   ;; ( value, address -- )
   pop_argument_stack rbx
   pop_argument_stack rax
   mov word [rbx], ax
   next

define_primitive_function "save-four-bytes", save_four_bytes
   ;; ( value, address -- )
   pop_argument_stack rbx
   pop_argument_stack rax
   mov dword [rbx], eax
   next

define_primitive_function "n-save", n_save
   ;; << value-n, ..., value-1, address, n -- >>
   pop_argument_stack rcx
   pop_argument_stack rdx
   mov rax, jo_size
   imul rax, rcx
   add rdx, rax
   ;; for address is based on 0
   ;; but n is based on 1
   sub rdx, jo_size
.loop:
   pop_argument_stack rax
   mov dword [rdx], rax
   sub rdx, jo_size
   loop .loop
   next

define_function "save2", save2
   ;; << value-2, value-1, address -- >>
   xx literal, 2
   xx n_save
   xx end

define_primitive_function "n-save-byte", n_save_byte
   ;; << value-n, ..., value-1, address, n -- >>
   pop_argument_stack rcx
   pop_argument_stack rdx
   add rdx, rcx
   dec rdx
.loop:
   pop_argument_stack rax
   mov byte [rdx], al
   dec rdx
   loop .loop
   next

define_primitive_function "add-save", add_save
   ;; ( number to add, address -- )
   pop_argument_stack rbx
   pop_argument_stack rax
   add dword [rbx], rax
   next

define_primitive_function "sub-save", sub_save
   ;; ( number to add, address -- )
   pop_argument_stack rbx
   pop_argument_stack rax
   sub dword [rbx], rax
   next

}

match =32bit, machine {

define_primitive_function "fetch", fetch
   ;; ( address -- value )
   pop_argument_stack  rbx
   mov rax, [rbx]
   push_argument_stack rax
   next

define_primitive_function "fetch-byte", fetch_byte
   ;; ( address -- value )
   pop_argument_stack rbx
   xor rax, rax
   mov al, byte[rbx]
   push_argument_stack rax
   next

define_primitive_function "fetch-two-bytes", fetch_two_bytes
   ;; ( address -- value )
   pop_argument_stack rbx
   xor rax, rax
   mov ax, word [rbx]
   push_argument_stack rax
   next

define_primitive_function "fetch-four-bytes", fetch_four_bytes
   ;; ( address -- value )
   pop_argument_stack rbx
   xor rax, rax
   mov eax, dword [rbx]
   push_argument_stack rax
   next

;;   in memory:
;;     ||  1 : value-1  ||
;;     ...
;;     ||  1 : value-n  ||
define_primitive_function "n-fetch", n_fetch
   ;; << 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, jo_size
   loop .loop
   next

define_primitive_function "n-fetch-byte", n_fetch_byte
   ;; << address, n -- byte-1, ..., byte-n >>
   pop_argument_stack  rcx
   pop_argument_stack  rdx
   xor rax, rax
.loop:
   mov al, byte [rdx]
   push_argument_stack rax
   inc rdx
   loop .loop
   next

define_function "fetch2", fetch2
   ;; << address -- value-1, value-2 >>
   xx literal, 2
   xx n_fetch
   xx end

}

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

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

}

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

}

match =windows =64bit, platform machine {

buffer$write_byte:
   db 0

__counter$write_byte:
   xx 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 char in al to stdout
   ;; write needs the address of the byte to write
   mov [buffer$write_byte], al

windows64_function 5
   push 0
   sub rsp, 8*4
   mov windows64_fun_4_r9, __counter$write_byte
   mov windows64_fun_3_r8, 1
   mov windows64_fun_2_rdx, buffer$write_byte
   mov windows64_fun_1_rcx, [_output_handle]
   call [WriteFile]
end_windows64_function

   next

}

match =windows =32bit, platform machine {

buffer$write_byte:
   db 0

__counter$write_byte:
   xx 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 char in al to stdout
   ;; write needs the address of the byte to write
   mov [buffer$write_byte], al

   push 0
   push __counter$write_byte
   push 1
   push buffer$write_byte
   mov rax, [_output_handle]
   push rax
   call [WriteFile]

   next

}

max_input_length = 1024 * 1024

buffer$read_byte labeling
   preserve max_input_length

size$eval_string_stack = 1024 * jo_size

   preserve 64 * jo_size
address$eval_string_stack labeling
   preserve size$eval_string_stack

pointer$eval_string_stack:
   xx address$eval_string_stack

match =64bit, machine {

 define_primitive_function "push-eval-string-stack", push_eval_string_stack
    ;; argument-stack -> eval-string-stack
    pop_argument_stack rax
    mov rbx, [pointer$eval_string_stack]
    mov [rbx], rax
    add qword [pointer$eval_string_stack], jo_size
    next

 define_primitive_function "pop-eval-string-stack", pop_eval_string_stack
    ;; eval-string-stack -> argument-stack
    sub qword [pointer$eval_string_stack], jo_size
    mov rbx, [pointer$eval_string_stack]
    mov rax, [rbx]
    push_argument_stack rax
    next

}

match =32bit, machine {

 define_primitive_function "push-eval-string-stack", push_eval_string_stack
    ;; argument-stack -> eval-string-stack
    pop_argument_stack rax
    mov rsi, [pointer$eval_string_stack]
    mov [rsi], rax
    add dword [pointer$eval_string_stack], jo_size
    next

 define_primitive_function "pop-eval-string-stack", pop_eval_string_stack
    ;; eval-string-stack -> argument-stack
    sub dword [pointer$eval_string_stack], jo_size
    mov rsi, [pointer$eval_string_stack]
    mov rax, [rsi]
    push_argument_stack rax
    next

}

match =64bit, machine {

define_primitive_function "clear-eval-string-stack", clear_eval_string_stack
   ;; << -- >>
   mov qword [pointer$eval_string_stack], address$eval_string_stack
   next

}

match =32bit, machine {

define_primitive_function "clear-eval-string-stack", clear_eval_string_stack
   ;; << -- >>
   mov eax, address$eval_string_stack
   mov dword [pointer$eval_string_stack], eax;address$eval_string_stack
   next

}

define_primitive_function "eval-string-stack-empty?", eval_string_stack_empty?
   ;; << -- bool >>
   mov rax, [pointer$eval_string_stack]
   cmp rax, address$eval_string_stack
   ;; less-than is treated as equal
   setle al
   movzx rax, al
   push_argument_stack rax
   next

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

}

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

}

match =windows =64bit, platform machine {

__counter$read_line_from_stdin:
   xx 0

define_primitive_function "read-line-from-stdin", read_line_from_stdin
   ;; << buffer address, max length -- counter >>
windows64_function 5
   push 0
   sub rsp, 8*4
   mov windows64_fun_4_r9, __counter$read_line_from_stdin
   pop_argument_stack windows64_fun_3_r8
   pop_argument_stack windows64_fun_2_rdx
   mov windows64_fun_1_rcx, [_input_handle]
   call [ReadFile]
   ;; the return value
   ;; is a count of the number of bytes transferred
   mov rax, [__counter$read_line_from_stdin]
   push_argument_stack rax
end_windows64_function
   next

}

match =windows =32bit, platform machine {

__counter$read_line_from_stdin:
   xx 0

define_primitive_function "read-line-from-stdin", read_line_from_stdin
   ;; << buffer address, max length -- counter >>
   push 0
   push __counter$read_line_from_stdin
   pop_argument_stack rax
   push rax
   pop_argument_stack rax
   push rax
   mov rax, [_input_handle]
   push rax
   call [ReadFile]
   ;; the return value
   ;; is a count of the number of bytes transferred
   mov rax, [__counter$read_line_from_stdin]
   push_argument_stack rax

   next

}

define_function "read-byte", read_byte
   ;; << -- byte >>
   xx have_unreaded_ket_char?, false?branch, 9
   xx   literal, char$unreaded_ket_char, fetch_byte
   xx   zero, literal, flag$unreaded_ket_char
   xx   save
   xx   end
   xx read_byte__without_unread
   xx end

define_function "read-byte,without-unread", read_byte__without_unread
   ;; << -- byte >>
   xx eval_string_stack_empty?, false?branch, (.not_empty-$)/jo_size
   xx   literal, buffer$read_byte
   xx   literal, max_input_length
   xx   read_line_from_stdin
   xx     dup, positive?, false?, false?branch, 4
   ;;     ignore <end-of-file>
   ;;     ignore reading error
   xx     drop
   xx     taca, read_byte__without_unread
   xx   push_eval_string_stack
   xx   literal, buffer$read_byte
   xx   push_eval_string_stack
   xx   taca, read_byte__without_unread
   .not_empty:
   xx pop_eval_string_stack
   xx pop_eval_string_stack
   xx dup, zero?, false?branch, 4
   xx   drop2
   xx   taca, read_byte__without_unread
   xx sub1, push_eval_string_stack
   xx dup
   xx add1, push_eval_string_stack
   xx fetch_byte
   xx end

flag$unreaded_ket_char:
   xx 0

char$unreaded_ket_char:
   xx 0

define_function "have-unreaded-ket-char?", have_unreaded_ket_char?
   ;; << -- bool >>
   xx literal, flag$unreaded_ket_char
   xx fetch
   xx end

define_function "unread-ket-char", unread_ket_char
   ;; << char -- >>
   xx literal, char$unreaded_ket_char, save
   xx true, literal, flag$unreaded_ket_char
   xx save
   xx end

define_function "eval-string", eval_string
   ;; << string[address, length] -- UNKNOWN >>
   xx push_eval_string_stack
   xx push_eval_string_stack
   xx end

match =linux =64bit, platform machine {

name_buffer$open_file__to_read labeling
   preserve 512

define_primitive_function "open-file,to-read", open_file__to_read
   ;; << file-name-string[address, length] --
   ;;    [file handle] or [error code] >>
   pop_argument_stack rcx
   pop_argument_stack rsi
   ;; copy file-name as a null-terminal string
   mov rdi, name_buffer$open_file__to_read
   rep movsb
   xor rax, rax
   mov byte [rdi], al
   mov linux64_sys_2_rsi, open_read ;; read only
   mov linux64_sys_1_rdi, name_buffer$open_file__to_read
   mov linux64_sys_n_rax, linux64_syscall_open
   syscall
   push_argument_stack rax
   next

}

match =linux =64bit, platform machine {

name_buffer$open_file__to_write labeling
   preserve 512

define_primitive_function "open-file,to-write", open_file__to_write
   ;; << file-name-string[address, length] --
   ;;    [file handle] or [error code] >>
   pop_argument_stack rcx
   pop_argument_stack rsi
   ;; copy file-name as a null-terminal string
   mov rdi, name_buffer$open_file__to_write
   rep movsb
   xor rax, rax
   mov byte [rdi], al
   mov linux64_sys_3_rdx, 110100100b
   mov linux64_sys_2_rsi, open_readAndWrite or open_creat or open_rewrite
   mov linux64_sys_1_rdi, name_buffer$open_file__to_write
   mov linux64_sys_n_rax, linux64_syscall_open
   syscall
   push_argument_stack rax
   next

}

match =linux =64bit, platform machine {

define_primitive_function "close-file", close_file
   ;; << file-handle -- >>
   pop_argument_stack linux64_sys_1_rdi
   mov linux64_sys_n_rax, linux64_syscall_close
   syscall
   next

}

match =linux =64bit, platform machine {

define_primitive_function "read-file", read_file
   ;; << [file handle], buffer[address, length] --
   ;;    [number of char] or [error code] >>
   pop_argument_stack linux64_sys_3_rdx
   pop_argument_stack linux64_sys_2_rsi
   pop_argument_stack linux64_sys_1_rdi
   mov linux64_sys_n_rax, linux64_syscall_read
   syscall
   push_argument_stack rax
   next

}

match =linux =64bit, platform machine {

define_primitive_function "write-file", write_file
   ;; << [file handle], buffer[address, length] --
   ;;    [number of char] or [error code] >>
   pop_argument_stack linux64_sys_3_rdx
   pop_argument_stack linux64_sys_2_rsi
   pop_argument_stack linux64_sys_1_rdi
   mov linux64_sys_n_rax, linux64_syscall_write
   syscall
   push_argument_stack rax
   next

}

match =linux =32bit, platform machine {

name_buffer$open_file__to_read labeling
   preserve 512

define_primitive_function "open-file,to-read", open_file__to_read
   ;; << file-name-string[address, length] --
   ;;    [file handle] or [error code] >>
   pop_argument_stack rcx
   pop_argument_stack rsi
   ;; copy file-name as a null-terminal string
   mov rdi, name_buffer$open_file__to_read
   rep movsb
   xor rax, rax
   mov byte [rdi], al
   mov linux32_sys_2_ecx, open_read ;; read only
   mov linux32_sys_1_ebx, name_buffer$open_file__to_read
   mov linux32_sys_n_eax, linux32_syscall_open
   syscall
   push_argument_stack rax
   next

}

match =linux =32bit, platform machine {

name_buffer$open_file__to_write labeling
   preserve 512

define_primitive_function "open-file,to-write", open_file__to_write
   ;; << file-name-string[address, length] --
   ;;    [file handle] or [error code] >>
   pop_argument_stack rcx
   pop_argument_stack rsi
   ;; copy file-name as a null-terminal string
   mov rdi, name_buffer$open_file__to_write
   rep movsb
   xor rax, rax
   mov byte [rdi], al
   mov linux32_sys_3_edx, 110100100b
   mov linux32_sys_2_ecx, open_readAndWrite or open_creat or open_rewrite
   mov linux32_sys_1_ebx, name_buffer$open_file__to_write
   mov linux32_sys_n_eax, linux32_syscall_open
   syscall
   push_argument_stack rax
   next

}

match =linux =32bit, platform machine {

define_primitive_function "close-file", close_file
   ;; << file-handle -- >>
   pop_argument_stack linux32_sys_1_ebx
   mov linux32_sys_n_eax, linux32_syscall_close
   syscall
   next

}

match =linux =32bit, platform machine {

define_primitive_function "read-file", read_file
   ;; << [file handle], buffer[address, length] --
   ;;    [number of char] or [error code] >>
   pop_argument_stack linux32_sys_3_edx
   pop_argument_stack linux32_sys_2_ecx
   pop_argument_stack linux32_sys_1_ebx
   mov linux32_sys_n_eax, linux32_syscall_read
   syscall
   push_argument_stack rax
   next

}

match =linux =32bit, platform machine {

define_primitive_function "write-file", write_file
   ;; << [file handle], buffer[address, length] --
   ;;    [number of char] or [error code] >>
   pop_argument_stack linux32_sys_3_edx
   pop_argument_stack linux32_sys_2_ecx
   pop_argument_stack linux32_sys_1_ebx
   mov linux32_sys_n_eax, linux32_syscall_write
   syscall
   push_argument_stack rax
   next

}

match =windows =64bit, platform machine {

; Access rights

DELETE_RIGHT              = 00010000h
READ_CONTROL              = 00020000h
WRITE_DAC                 = 00040000h
WRITE_OWNER               = 00080000h
SYNCHRONIZE               = 00100000h
STANDARD_RIGHTS_READ      = READ_CONTROL
STANDARD_RIGHTS_WRITE     = READ_CONTROL
STANDARD_RIGHTS_EXECUTE   = READ_CONTROL
STANDARD_RIGHTS_REQUIRED  = 000F0000h
STANDARD_RIGHTS_ALL       = 001F0000h
SPECIFIC_RIGHTS_ALL       = 0000FFFFh
ACCESS_SYSTEM_SECURITY    = 01000000h
MAXIMUM_ALLOWED           = 02000000h
GENERIC_READ              = 80000000h
GENERIC_WRITE             = 40000000h
GENERIC_EXECUTE           = 20000000h
GENERIC_ALL               = 10000000h
PROCESS_TERMINATE         = 00000001h
PROCESS_CREATE_THREAD     = 00000002h
PROCESS_VM_OPERATION      = 00000008h
PROCESS_VM_READ           = 00000010h
PROCESS_VM_WRITE          = 00000020h
PROCESS_DUP_HANDLE        = 00000040h
PROCESS_CREATE_PROCESS    = 00000080h
PROCESS_SET_QUOTA         = 00000100h
PROCESS_SET_INFORMATION   = 00000200h
PROCESS_QUERY_INFORMATION = 00000400h
PROCESS_ALL_ACCESS        = STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or 0FFFh
FILE_SHARE_READ           = 00000001h
FILE_SHARE_WRITE          = 00000002h
FILE_SHARE_DELETE         = 00000004h

; CreateFile actions

CREATE_NEW        = 1
CREATE_ALWAYS     = 2
OPEN_EXISTING     = 3
OPEN_ALWAYS       = 4
TRUNCATE_EXISTING = 5

; File attributes

FILE_ATTRIBUTE_READONLY   = 001h
FILE_ATTRIBUTE_HIDDEN     = 002h
FILE_ATTRIBUTE_SYSTEM     = 004h
FILE_ATTRIBUTE_DIRECTORY  = 010h
FILE_ATTRIBUTE_ARCHIVE    = 020h
FILE_ATTRIBUTE_NORMAL     = 080h
FILE_ATTRIBUTE_TEMPORARY  = 100h
FILE_ATTRIBUTE_COMPRESSED = 800h

}

match =windows =64bit, platform machine {

name_buffer$open_file__to_read labeling
   preserve 512

define_primitive_function "open-file,to-read", open_file__to_read
   ;; << file-name-string[address, length] --
   ;;    [file handle] or [error code] >>
   pop_argument_stack rcx
   pop_argument_stack rsi
   ;; copy file-name as a null-terminal string
   mov rdi, name_buffer$open_file__to_read
   rep movsb
   xor rax, rax
   mov byte [rdi], al
windows64_function 7
   push 0 ;; null
   push FILE_ATTRIBUTE_NORMAL
   push OPEN_EXISTING
   sub rsp, 8*4
   mov windows64_fun_4_r9, 0 ;; null
   mov windows64_fun_3_r8, 0 ;; no sharing
   mov windows64_fun_2_rdx, GENERIC_READ
   mov windows64_fun_1_rcx, name_buffer$open_file__to_read
   call [CreateFileA]
   push_argument_stack rax
end_windows64_function
   next

}

match =windows =64bit, platform machine {

name_buffer$open_file__to_write labeling
   preserve 512

define_primitive_function "open-file,to-write", open_file__to_write
   ;; << file-name-string[address, length] --
   ;;    [file handle] or [error code] >>
   pop_argument_stack rcx
   pop_argument_stack rsi
   ;; copy file-name as a null-terminal string
   mov rdi, name_buffer$open_file__to_write
   rep movsb
   xor rax, rax
   mov byte [rdi], al
windows64_function 7
   push 0 ;; null
   push FILE_ATTRIBUTE_NORMAL
   push CREATE_ALWAYS
   sub rsp, 8*4
   mov windows64_fun_4_r9, 0 ;; null
   mov windows64_fun_3_r8, 0 ;; no sharing
   mov windows64_fun_2_rdx, GENERIC_WRITE
   mov windows64_fun_1_rcx, name_buffer$open_file__to_write
   call [CreateFileA]
   push_argument_stack rax
end_windows64_function
   next

}

match =windows =64bit, platform machine {

define_primitive_function "close-file", close_file
   ;; << file-handle -- >>
windows64_function 4
   sub rsp, 8*4
   pop_argument_stack windows64_fun_1_rcx
   call [CloseHandle]
end_windows64_function
   next

}

match =windows =64bit, platform machine {

__counter$read_file:
   xx 0

define_primitive_function "read-file", read_file
   ;; << [file handle], buffer[address, length] --
   ;;    [number of char] or [error code] >>
windows64_function 5
   push 0
   sub rsp, 8*4
   mov windows64_fun_4_r9, __counter$read_file
   pop_argument_stack windows64_fun_3_r8
   pop_argument_stack windows64_fun_2_rdx
   pop_argument_stack windows64_fun_1_rcx
   call [ReadFile]
end_windows64_function

   mov rax, [__counter$read_file]
   push_argument_stack rax

   next

}

match =windows =64bit, platform machine {

__counter$write_file:
   xx 0

define_primitive_function "write-file", write_file
   ;; << [file handle], buffer[address, length] --
   ;;    [number of char] or [error code] >>
windows64_function 5
   push 0
   sub rsp, 8*4
   mov windows64_fun_4_r9, __counter$write_file
   pop_argument_stack windows64_fun_3_r8
   pop_argument_stack windows64_fun_2_rdx
   pop_argument_stack windows64_fun_1_rcx
   call [WriteFile]
   mov rax, [__counter$write_file]
   push_argument_stack rax
end_windows64_function

   next

}

match =windows =32bit, platform machine {

; Access rights

DELETE_RIGHT              = 00010000h
READ_CONTROL              = 00020000h
WRITE_DAC                 = 00040000h
WRITE_OWNER               = 00080000h
SYNCHRONIZE               = 00100000h
STANDARD_RIGHTS_READ      = READ_CONTROL
STANDARD_RIGHTS_WRITE     = READ_CONTROL
STANDARD_RIGHTS_EXECUTE   = READ_CONTROL
STANDARD_RIGHTS_REQUIRED  = 000F0000h
STANDARD_RIGHTS_ALL       = 001F0000h
SPECIFIC_RIGHTS_ALL       = 0000FFFFh
ACCESS_SYSTEM_SECURITY    = 01000000h
MAXIMUM_ALLOWED           = 02000000h
GENERIC_READ              = 80000000h
GENERIC_WRITE             = 40000000h
GENERIC_EXECUTE           = 20000000h
GENERIC_ALL               = 10000000h
PROCESS_TERMINATE         = 00000001h
PROCESS_CREATE_THREAD     = 00000002h
PROCESS_VM_OPERATION      = 00000008h
PROCESS_VM_READ           = 00000010h
PROCESS_VM_WRITE          = 00000020h
PROCESS_DUP_HANDLE        = 00000040h
PROCESS_CREATE_PROCESS    = 00000080h
PROCESS_SET_QUOTA         = 00000100h
PROCESS_SET_INFORMATION   = 00000200h
PROCESS_QUERY_INFORMATION = 00000400h
PROCESS_ALL_ACCESS        = STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or 0FFFh
FILE_SHARE_READ           = 00000001h
FILE_SHARE_WRITE          = 00000002h
FILE_SHARE_DELETE         = 00000004h

; CreateFile actions

CREATE_NEW        = 1
CREATE_ALWAYS     = 2
OPEN_EXISTING     = 3
OPEN_ALWAYS       = 4
TRUNCATE_EXISTING = 5

; File attributes

FILE_ATTRIBUTE_READONLY   = 001h
FILE_ATTRIBUTE_HIDDEN     = 002h
FILE_ATTRIBUTE_SYSTEM     = 004h
FILE_ATTRIBUTE_DIRECTORY  = 010h
FILE_ATTRIBUTE_ARCHIVE    = 020h
FILE_ATTRIBUTE_NORMAL     = 080h
FILE_ATTRIBUTE_TEMPORARY  = 100h
FILE_ATTRIBUTE_COMPRESSED = 800h

}

match =windows =32bit, platform machine {

name_buffer$open_file__to_read labeling
   preserve 512

define_primitive_function "open-file,to-read", open_file__to_read
   ;; << file-name-string[address, length] --
   ;;    [file handle] or [error code] >>
   pop_argument_stack rcx
   pop_argument_stack rsi
   ;; copy file-name as a null-terminal string
   mov rdi, name_buffer$open_file__to_read
   rep movsb
   xor rax, rax
   mov byte [rdi], al

   push 0 ;; null
   push FILE_ATTRIBUTE_NORMAL
   push OPEN_EXISTING
   push 0 ;; null
   push 0 ;; no sharing
   push GENERIC_READ
   push name_buffer$open_file__to_read
   call [CreateFileA]
   push_argument_stack rax

   next

}

match =windows =32bit, platform machine {

name_buffer$open_file__to_write labeling
   preserve 512

define_primitive_function "open-file,to-write", open_file__to_write
   ;; << file-name-string[address, length] --
   ;;    [file handle] or [error code] >>
   pop_argument_stack rcx
   pop_argument_stack rsi
   ;; copy file-name as a null-terminal string
   mov rdi, name_buffer$open_file__to_write
   rep movsb
   xor rax, rax
   mov byte [rdi], al

   push 0 ;; null
   push FILE_ATTRIBUTE_NORMAL
   push CREATE_ALWAYS
   push 0 ;; null
   push 0 ;; no sharing
   push GENERIC_WRITE
   push name_buffer$open_file__to_write
   call [CreateFileA]
   push_argument_stack rax

   next

}

match =windows =32bit, platform machine {

define_primitive_function "close-file", close_file
   ;; << file-handle -- >>

   pop_argument_stack rax
   push rax
   call [CloseHandle]

   next

}

match =windows =32bit, platform machine {

__counter$read_file:
   xx 0

define_primitive_function "read-file", read_file
   ;; << [file handle], buffer[address, length] --
   ;;    [number of char] or [error code] >>

   push 0
   push __counter$read_file
   pop_argument_stack rax
   push rax
   pop_argument_stack rax
   push rax
   pop_argument_stack rax
   push rax
   call [ReadFile]

   mov rax, [__counter$read_file]
   push_argument_stack rax

   next

}

match =windows =32bit, platform machine {

__counter$write_file:
   xx 0

define_primitive_function "write-file", write_file
   ;; << [file handle], buffer[address, length] --
   ;;    [number of char] or [error code] >>

   push 0
   push __counter$write_file
   pop_argument_stack rax
   push rax
   pop_argument_stack rax
   push rax
   pop_argument_stack rax
   push rax
   call [WriteFile]
   mov rax, [__counter$write_file]
   push_argument_stack rax

   next

}

define_function "path-exist?", path_exist?
   ;; << path[address, length] -- bool >>
   xx open_file__to_read
   xx dup, negative?, false?, false?branch, 4
   xx   close_file
   xx   true
   xx   end
   xx literal, -2, equal?, false?branch, 3
   xx   false
   xx   end
   ;; ><><><
   xx true
   xx end

address$path_directory?:
   db 0

define_function "path-directory?", path_directory?
   ;; << path[address, length] -- bool >>
   xx open_file__to_read
   xx dup, negative?, false?branch, 4
   xx   drop
   xx   false
   xx   end
   xx dup
   xx literal, address$path_directory?
   xx literal, 1
   xx read_file
   xx swap, close_file
   xx dup, positive?, false?branch, 4
   xx   drop
   xx   false
   xx   end
   xx literal, -21, equal?, false?branch, 3
   xx   true
   xx   end
   ;; ><><><
   xx false
   xx end

address$path_file?:
   db 0

define_function "path-file?", path_file?
   ;; << path[address, length] -- bool >>
   xx open_file__to_read
   xx dup, negative?, false?branch, 4
   xx   drop
   xx   false
   xx   end
   xx dup
   xx literal, address$path_file?
   xx literal, 1
   xx read_file
   xx swap, close_file
   xx positive?, false?branch, 3
   xx   true
   xx   end
   xx false
   xx end

buffer$load_file labeling
  preserve 1024 * 1024

define_function "report,load-file", report__load_file
   ;; << -- >>
   xx literal, string$report__load_file
   xx literal, length$report__load_file
   xx write_string
   xx end

string$report__load_file:
   db "* LOADING : "
.end:
length$report__load_file = (.end - string$report__load_file)

define_function "load-file", load_file
   ;; << name-string[address, length] -- UNKNOWN >>
   xx report__load_file
   xx dup2, write_string
   xx literal, 10, write_byte

   xx open_file__to_read
   xx dup
   xx   literal, buffer$load_file ;; buffer
   xx   literal, 1024 * 1024      ;; length
   xx   read_file
   xx swap, close_file
   xx dup, positive?, false?branch, (.error-$)/jo_size
   xx   literal, buffer$load_file
   xx   swap
   xx   push_eval_string_stack
   xx   push_eval_string_stack
   xx   end
   .error:
   xx error_report__load_file
   xx write_integer
   xx literal, 10, write_byte
   xx end

define_function "error-report,load-file", error_report__load_file
   ;; << -- >>
   xx literal, string$error_report__load_file
   xx literal, length$error_report__load_file
   xx write_string
   xx end

string$error_report__load_file:
   db "* (load-file) MEETS ERROR  (read-file) ERROR CODE : "
.end:
length$error_report__load_file = (.end - string$error_report__load_file)

match =linux, platform {

define_function "init-operating-system-environment", init_operating_system_environment
   ;; << -- >>
   xx init_pid
   xx init_command_line
   xx init_environment_string_variable_list
   xx end

}

match =linux =64bit, platform machine {

define_primitive_function "init-pid", init_pid
   ;; << -- pid >>
   mov linux64_sys_n_rax, linux64_syscall_getpid
   syscall
   mov [value$get_pid], rax
   next

}

match =linux =32bit, platform machine {

define_primitive_function "init-pid", init_pid
   ;; << -- pid >>
   mov linux32_sys_n_eax, linux32_syscall_getpid
   syscall
   mov [value$get_pid], rax
   next

}

match =linux, platform {

file$init_command_line:
   db "/cmdline" ;; length of 8

path$init_command_line:
   db "/proc/"   ;; length of 6
pid$init_command_line:
   db "********************************"

address$init_command_line:
   times 512 db 0
length$init_command_line:
   xx 0

define_function "init-command-line", init_command_line
   ;; << -- >>
   xx get_pid
   xx write_nature_number__fill_buffer
   xx tuck
   xx literal, pid$init_command_line
   xx string_to_buffer!
   xx literal, file$init_command_line
   xx literal, 8
   xx literal, pid$init_command_line
   xx xoverxxx, addition
   xx string_to_buffer!
   xx literal, path$init_command_line
   xx swap
   xx literal, 8, addition
   xx literal, 6, addition
   xx open_file__to_read
   xx literal, address$init_command_line
   xx literal, 512
   xx read_file
   xx literal, length$init_command_line
   xx save
   xx end

}

match =linux, platform {

file$init_environment_string_variable_list:
   db "/environ" ;; length of 8

path$init_environment_string_variable_list:
   db "/proc/"   ;; length of 6
pid$init_environment_string_variable_list:
   db "********************************"

address$init_environment_string_variable_list:
   times (4 * 1024) db 0
length$init_environment_string_variable_list:
   xx 0

define_function "init-environment-string-variable-list", init_environment_string_variable_list
   ;; << -- >>
   xx get_pid
   xx write_nature_number__fill_buffer
   xx tuck
   xx literal, pid$init_environment_string_variable_list
   xx string_to_buffer!
   xx literal, file$init_environment_string_variable_list
   xx literal, 8
   xx literal, pid$init_environment_string_variable_list
   xx xoverxxx, addition
   xx string_to_buffer!
   xx literal, path$init_environment_string_variable_list
   xx swap
   xx literal, 8, addition
   xx literal, 6, addition
   xx open_file__to_read
   xx literal, address$init_environment_string_variable_list
   xx literal, (4 * 1024)
   xx read_file
   xx literal, length$init_environment_string_variable_list
   xx save
   xx end

}

match =linux, platform {

value$get_pid:
   xx 2

define_function "get-pid", get_pid
   ;; << -- pid >>
   xx literal, value$get_pid, fetch
   xx end

}

match =linux, platform {

define_function "get-command-line", get_command_line
   ;; << -- string[address, length] >>
   xx literal, address$init_command_line
   xx literal, length$init_command_line, fetch
   xx end

}

match =linux, platform {

define_function "get-environment-string-variable-list", get_environment_string_variable_list
   ;; << -- string[address, length] >>
   xx literal, address$init_environment_string_variable_list
   xx literal, length$init_environment_string_variable_list, fetch
   xx end

}

match =linux, platform {

define_function "find-environment-string-variable", find_environment_string_variable
   ;; << string[address, length]
   ;;    -- string[address, length], true
   ;;    -- false >>
   xx literal, address$init_environment_string_variable_list ;; cursor
   xx find_environment_string_variable__loop
   xx end

define_function "find-environment-string-variable,loop", find_environment_string_variable__loop
   ;; << string[address, length], cursor
   ;;    -- string[address, length], true
   ;;    -- false >>
   xx dup
   xx literal, address$init_environment_string_variable_list
   xx literal, length$init_environment_string_variable_list, fetch
   xx addition
   xx greater_than?, false?branch, 5
   xx   drop, drop2
   xx   false
   xx   end
   xx xxoverx, xoverxx, swap
   xx compare_buffer, false?, false?branch, 7
   xx   literal, 0
   xx   cursor_to_next_matching_byte
   xx   add1
   xx   taca, find_environment_string_variable__loop
   xx dup, xoverxx, addition, fetch_byte
   xx literal, '=', equal?, false?, false?branch, 7
   xx   literal, 0
   xx   cursor_to_next_matching_byte
   xx   add1
   xx   taca, find_environment_string_variable__loop
   xx xswapxx, drop
   xx addition, add1
   xx dup
   xx literal, 0
   xx cursor_to_next_matching_byte
   xx over, subtraction
   xx true
   xx end

}

match =linux, platform {

string$get_home_path:
   db "HOME"

define_function "get-home-path", get_home_path
   ;; << -- string[address, length] >>
   xx literal, string$get_home_path
   xx literal, 4
   xx find_environment_string_variable
   xx drop
   xx end

}

match =linux, platform {

path$load_core_file:
   times 512 db 0


string$load_core_file:
   db "/.cicada/core.cn"
.end:
length$load_core_file = (.end - string$load_core_file)

string$load_core_file__system_wide:
   db "/etc/cicada/core.cn"
.end:
length$load_core_file__system_wide = (.end - string$load_core_file__system_wide)


define_function "load-core-file", load_core_file
   ;; << UNKNOWN -- UNKNOWN >>
   xx get_home_path
   xx tuck
   xx literal, path$load_core_file
   xx string_to_buffer!

   xx literal, string$load_core_file
   xx literal, length$load_core_file
   xx xoverxx
   xx literal, path$load_core_file
   xx addition
   xx string_to_buffer!

   xx literal, length$load_core_file
   xx addition
   xx literal, path$load_core_file
   xx swap

   xx dup2, path_file?, false?branch, 3
   xx   load_file
   xx   end
   xx literal, string$load_core_file__report
   xx literal, length$load_core_file__report
   xx write_string
   xx write_string
   xx literal, 10, write_byte

   xx literal, string$load_core_file__system_wide
   xx literal, length$load_core_file__system_wide
   xx dup2, path_file?, false?branch, 3
   xx   load_file
   xx   end
   xx drop2
   xx literal, string$load_core_file__report2
   xx literal, length$load_core_file__report2
   xx write_string
   xx literal, 10, write_byte
   xx end

string$load_core_file__report:
   db "* (load-core-file)", 10
   db "  * FALLING BACK TO SYSTEM-WIDE CORE FILE : /etc/cicada/core.cn", 10
   db "  * BECAUSE CAN NOT LOAD USER'S CORE FILE : "
.end:
length$load_core_file__report = (.end - string$load_core_file__report)

string$load_core_file__report2:
   db "* (load-core-file) ", 10
   db "  * CAN NOT LOAD SYSTEM-WIDE CORE FILE : /etc/cicada/core.cn", 10
   db "  * NO CORE FILE IS LOADED"
.end:
length$load_core_file__report2 = (.end - string$load_core_file__report2)

}

match =windows, platform {

string$name_of_init_file:
   db "core.cn"
.end:
length$name_of_init_file = (.end - string$name_of_init_file)


define_function "load-core-file", load_core_file
   ;; << -- >>
   xx literal, string$name_of_init_file
   xx literal, length$name_of_init_file
   xx load_file
   xx end

}

define_function "space-char?", space_char?
   ;; << char -- bool >>
   xx literal, 32
   xx less_or_equal?
   xx end

define_function "bar-ket-char?", bar_ket_char?
   ;; << char -- 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

define_function "digital-char?", decimal_digital_char?
   ;; << char -- bool >>
   xx dup, literal, '0', less_than?, false?branch, 4
   xx   drop, false
   xx   end
   xx dup, literal, '9', less_or_equal?, false?branch, 4
   xx   drop, true
   xx   end
   xx drop, false
   xx end

define_function "latin-char?", latin_char?
   ;; << char -- bool >>
   xx dup, literal, 'A', less_than?, false?branch, 4
   xx   drop, false
   xx   end
   xx dup, literal, 'Z', less_or_equal?, false?branch, 4
   xx   drop, true
   xx   end
   xx dup, literal, 'a', less_than?, false?branch, 4
   xx   drop, false
   xx   end
   xx dup, literal, 'z', less_or_equal?, false?branch, 4
   xx   drop, true
   xx   end
   xx drop, false
   xx end

define_function "char->decimal-digital", char_to_decimal_digital
   ;; << char -- decimal-digital >>
   xx literal, '0'
   xx subtraction
   xx end

define_function "decimal-digital->char", decimal_digital_to_char
   ;; << decimal-digital -- char >>
   xx literal, '0'
   xx addition
   xx end

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

define_function "cursor->next-matching-byte", cursor_to_next_matching_byte
   ;; << cursor, byte -- cursor new address >>
   xx over, add1, fetch_byte
   xx over, equal?, false?branch, 4
   xx   drop, add1
   xx   end
   xx swap
   xx add1, swap
   xx taca, cursor_to_next_matching_byte

define_function "write-string", write_string
   ;; << string[address, length] -- >>
   xx dup, zero?, false?branch, 3
   xx   drop2
   xx   end
   xx sub1, swap
   xx dup, fetch_byte, write_byte
   xx add1, swap
   xx taca, write_string

define_function ".s", pretty_write_string
   ;; << integer -- >>
   xx write_string
   xx literal, 10
   xx write_byte
   xx end

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

define_function "string-head,char", string_head__char
   ;; << string[address, length] -- char >>
   xx drop, fetch_byte
   xx end

define_function "string-tail,char", string_tail__char
   ;; << string[address, length] -- [address + 1, length + 1] >>
   xx sub1, swap
   xx add1
   xx swap
   xx end

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

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 * jo_size)]
   mov rsi, [pointer$argument_stack - (2 * jo_size)]
   rep movsb

   mov rcx, [pointer$argument_stack - (1 * jo_size)]
   dec rdi ;; cursor back into string in buffer$string_reverse!
   mov rsi, [pointer$argument_stack - (2 * jo_size)]
.loop:
   mov al, byte [rdi]
   mov byte [rsi], al
   dec rdi
   inc rsi
   loop .loop

   next

}

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 * jo_size)]
   mov rsi, [rbx - (2 * jo_size)]
   rep movsb

   mov rcx, [rbx - (1 * jo_size)]
   dec rdi ;; cursor back into string in buffer$string_reverse!
   mov rsi, [rbx - (2 * jo_size)]
.loop:
   mov al, byte [rdi]
   mov byte [rsi], al
   dec rdi
   inc rsi
   loop .loop

   next

}

define_function "digital-string?", digital_string?
   ;; << string[address, length] -- bool >>
   xx dup, zero?, false?branch, 4
   xx   drop2, true
   xx   end
   xx over, fetch_byte, decimal_digital_char?, false?branch, 4
   xx   string_tail__char
   xx   taca, digital_string?
   xx drop2, false
   xx end

define_function "char-string?", char_string?
   ;; << string[address, length], char -- bool >>
   xx xxswapx
   xx dup, one?, false?, false?branch, 5
   xx   drop2, drop
   xx   false
   xx   end
   xx string_head__char, equal?, false?branch, 3
   xx   true
   xx   end
   xx false
   xx end

define_function "zero-string?", zero_string?
   ;; << string[address, length] -- bool >>
   xx dup2, literal, '0', char_string?, false?branch, 4
   xx   drop2, true
   xx   end
   xx dup2
   xx string_head__char, literal, '-', equal?, false?, false?branch, 4
   xx   drop2, false
   xx   end
   xx string_tail__char, literal, '0', char_string?
   xx end

define_function "integer-string?", integer_string?
   ;; << string[address, length] -- bool >>
   xx dup, zero?, false?branch, 4
   xx   drop2, false
   xx   end
   xx dup2, literal, '-', char_string?, false?branch, 4
   xx   drop2, false
   xx   end
   xx dup2, string_head__char, literal, '-', equal?, false?branch, 4
   xx   string_tail__char
   xx   digital_string?
   xx   end
   xx digital_string?
   xx end

define_function "string->integer", string_to_integer
   ;; << string[address, length] -- integer >>
   xx dup2, string_head__char, literal, '-', equal?, false?, false?branch, 3
   xx   digital_string_to_integer
   xx   end
   xx string_tail__char
   xx digital_string_to_integer
   xx negate
   xx end


sum$digital_string_to_integer:
   xx 0

counter$digital_string_to_integer:
   xx 0

define_function "digital-string->integer", digital_string_to_integer
   ;; << string[address, length] -- integer >>
   xx zero, literal, sum$digital_string_to_integer, save
   xx zero, literal, counter$digital_string_to_integer, save

   xx dup2, string_reverse!
   xx   help__digital_string_to_integer
   xx string_reverse!, drop2

   xx literal, sum$digital_string_to_integer
   xx fetch
   xx end

define_function "help,digital-string->integer", help__digital_string_to_integer
   ;; << reversed-string[address, length] -- >>
   xx dup, zero?, false?branch, 3
   xx   drop2
   xx   end

   xx dup2, string_head__char, char_to_decimal_digital
   xx   literal, 10
   xx   literal, counter$digital_string_to_integer, fetch
   xx     one
   xx     literal, counter$digital_string_to_integer
   xx     add_save
   xx   power
   xx multiple

   xx literal, sum$digital_string_to_integer
   xx add_save

   xx string_tail__char
   xx taca, help__digital_string_to_integer

define_function "find-char,string", find_char__string
  ;; << found:
  ;;      string[address, length], char -- address, true >>
  ;; << not found:
  ;;      string[address, length], char -- false >>
  xx over, zero?, false?branch, 5
  xx   drop, drop2
  xx   false
  xx   end
  xx xoverxx, fetch_byte
  xx over, equal?, false?branch, 4
  xx   drop2
  xx   true
  xx   end
  xx xxswapx
  xx string_tail__char
  xx xswapxx
  xx taca, find_char__string

;; 2 ^ 64 = 18446744073709551616
;; which is of length 20
;; so
;; I use 32 to align to 16

buffer$write_nature_number labeling
   preserve 32

counter$write_nature_number:
   xx 0

define_function "write-nature-number", write_nature_number
   ;; << nature-number -- >>
   xx write_nature_number__fill_buffer
   xx write_string
   xx end

define_function "write-nature-number,fill-buffer", write_nature_number__fill_buffer
   ;; << nature-number -- >>
   xx zero
   xx literal, counter$write_nature_number, save

   xx write_nature_number__loop

   xx literal, buffer$write_nature_number
   xx literal, counter$write_nature_number, fetch
   xx string_reverse!
   xx end


define_function "write-nature-number,loop", write_nature_number__loop
   ;; << rest-number -- >>
   xx literal, 10, divmod

   xx decimal_digital_to_char
   xx literal, buffer$write_nature_number
   xx literal, counter$write_nature_number, fetch
   xx addition
   xx save_byte

   xx one
   xx literal, counter$write_nature_number
   xx add_save

   xx dup, zero?, false?branch, 3
   xx   drop
   xx   end
   xx taca, write_nature_number__loop

define_function "write-integer", write_integer
   ;; << integer -- >>
   xx dup, positive?, false?branch, 3
   xx   write_nature_number
   xx   end
   xx literal, '-', write_byte
   xx negate
   xx write_nature_number
   xx end

define_function ".", pretty_write_integer
   ;; << integer -- >>
   xx write_integer
   xx literal, 32
   xx write_byte
   xx end

max_word_length = 1024

buffer$read_word labeling
   preserve max_word_length

buffer$read_word_for_REPL labeling
   preserve max_word_length

define_function "read-word-begin-char", read_word_begin_char
   ;; << -- non-blank-char >>
   xx read_byte
   xx dup, literal, 32 ;; ascii.space
   xx greater_than?, false?branch, 2
   xx   end
   xx drop
   xx taca, read_word_begin_char

define_function "read-word->buffer", read_word_to_buffer
   ;; << buffer -- word[address, length] >>
   xx read_word_begin_char
   ;; no metter what the begin char is
   ;; save it into buffer
   xx dup2, swap, save_byte
   xx swap, add1, swap
   xx one, swap ;; leave length counter
   ;; << cursor[address in buffer], counter, begin char >>
   xx dup, bar_ket_char?, false?branch, 4
   xx   drop
   xx   help__read_word_to_buffer__bar_ket
   xx   end
   ;; maybe add other type of chars
   xx drop
   xx help__read_word_to_buffer__regular
   xx end

define_function "help,read-word->buffer,bar-ket", help__read_word_to_buffer__bar_ket
   ;; << cursor[address in buffer], counter -- word[address, length] >>
   xx tuck, subtraction
   xx swap
   xx end


define_function "help,read-word->buffer,regular", help__read_word_to_buffer__regular
   ;; << cursor[address in buffer], counter -- word[address, length] >>
   xx read_byte
   xx dup, bar_ket_char?, false?branch, 6
   xx   unread_ket_char
   xx   tuck, subtraction
   xx   swap
   xx   end
   xx dup, space_char?, false?branch, 6
   xx   drop
   xx   tuck, subtraction
   xx   swap
   xx   end
   xx xoverxx, save_byte
   xx add1
   xx swap, add1, swap
   xx taca, help__read_word_to_buffer__regular

define_function "read-word", read_word
   ;; << -- word[address of buffer$read_word, length] >>
   xx literal, buffer$read_word, read_word_to_buffer
   xx end

define_function "read-word-for-REPL", read_word_for_REPL
   ;; << -- word[address of buffer$read_word_for_REPL, length] >>
   xx literal, buffer$read_word_for_REPL, read_word_to_buffer
   xx end

define_function "space-string?", space_string?
   ;; << string[address, length] -- bool >>
   xx dup, zero?, false?branch, 4
   xx   drop2, true
   xx   end
   xx dup2, string_head__char, space_char?, false?branch, 4
   xx   string_tail__char
   xx   taca, space_string?
   xx drop2, false
   xx end

define_function "string->word-begin", string_to_word_begin
   ;; << string[address, length] -- string[address, length] >>
   xx dup, zero?, false?branch, 2
   ;;   no error handling
   xx   end
   xx dup2, string_head__char
   xx space_char?, false?, false?branch, 2
   xx   end
   xx string_tail__char
   xx taca, string_to_word_begin

define_function "string->word-end", string_to_word_end
   ;; << string[address, length] -- string[address, length] >>
   xx dup, zero?, false?branch, 2
   ;;   no error handling
   xx   end
   xx dup2, string_head__char
   xx bar_ket_char?, false?branch, 3
   xx   string_tail__char
   xx   end
   xx help__string_to_word_end
   xx end

define_function "help,string->word-end", help__string_to_word_end
   ;; << string[address, length] -- address >>
   xx dup, zero?, false?branch, 2
   ;;   no error handling
   xx   end
   xx dup2, string_head__char
   xx space_char?, false?branch, 2
   xx   end
   xx dup2, string_head__char
   xx bar_ket_char?, false?branch, 2
   xx   end
   xx string_tail__char
   xx taca, help__string_to_word_end

define_function "string-head,word", string_head__word
   ;; << string[address, length] -- word[address, length] >>
   xx string_to_word_begin
   xx dup2, string_to_word_end
   xx swap, drop
   xx subtraction
   xx end

define_function "string-tail,word", string_tail__word
   ;; << string[address, length] -- string[address, length] >>
   xx string_to_word_begin
   xx string_to_word_end
   xx end

define_variable "*first-jo-in-dictionary*", V__first_jo_in_dictionary
   xx (last_link + jo_size)

define_function "find", find
   ;; found :
   ;; << word[address, length] -- jo, true >>
   ;; not found :
   ;; << word[address, length] -- false >>
   xx V__first_jo_in_dictionary
   xx help__find
   xx end

define_function "help,find", help__find
   ;; found :
   ;; << word[address, length], jo -- jo, true >>
   ;; not found :
   ;; << word[address, length], jo -- false >>
   xx xxtuckx


   xx jo_to_name, xxoverxx

   ;; for debug
   ;; xx jo_to_name
   ;; xx   dup2
   ;; xx   dup, write_integer, literal, 32, write_byte
   ;; xx   write_string, literal, 10, write_byte
   ;; xx xxoverxx
   ;; xx   dup2
   ;; xx   dup, write_integer, 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_jo__dictionary?, false?branch, 5
   xx   drop, drop2
   xx   false
   xx   end
   xx jo_to_pre_jo
   xx taca, help__find

define_function "execute-word", execute_word
   ;; << 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 find, false?branch, 5
   xx   xxswapx, drop2
   xx   execute_jo
   xx   end

   xx write_undefined_word_report__for_execute_word
   xx write_string
   xx literal, 10
   xx write_byte
   xx end


define_function "write-undefined-word-report,for-execute-word", write_undefined_word_report__for_execute_word
   ;; << -- >>
   xx literal, string$undefined_word_report__for_execute_word
   xx literal, length$undefined_word_report__for_execute_word
   xx write_string
   xx end

string$undefined_word_report__for_execute_word:
   db "* (execute-word) MEETS UNDEFINED WORD : "
.end:
length$undefined_word_report__for_execute_word = (.end - string$undefined_word_report__for_execute_word)

define_function "basic-REPL", basic_REPL
   ;; << UNKNOWN -- UNKNOWN >>
   xx read_word_for_REPL
   xx execute_word
   xx taca, basic_REPL

define_function "colon-string?", colon_string?
   ;; << string[address, length] -- bool >>
   xx literal, ':'
   xx char_string?
   xx end

define_function "semicolon-string?", semicolon_string?
   ;; << string[address, length] -- bool >>
   xx literal, ';'
   xx char_string?
   xx end

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

buffer$colon labeling
   preserve 1024 * 1024

cursor$colon:
   xx 0


define_function ":", colon
   ;; << -- string[address of buffer$colon, length] >>
   xx literal, buffer$colon
   xx literal, cursor$colon, save
   xx help__loop__colon
   ;; address
   xx literal, buffer$colon
   ;; length
   xx literal, cursor$colon, fetch
   xx literal, buffer$colon
   xx subtraction
   xx end


define_function "", help__loop__colon
   ;; << -- >>
   xx read_byte
   xx help__save_byte__colon
   xx help__meet_end__colon?, false?branch, 7
   xx   literal, 3 ;; for the string " ; "
   xx   literal, cursor$colon
   xx   sub_save
   xx   end
   xx help__meet_comment__colon?, false?branch, 9
   xx   literal, 4 ;; for the string " << "
   xx   literal, cursor$colon
   xx   sub_save
   xx   ignore_comment
   xx   taca, help__loop__colon
   xx taca, help__loop__colon


define_function "", help__save_byte__colon
   ;; << byte -- >>
   xx literal, cursor$colon, fetch
   xx save_byte
   xx one
   xx literal, cursor$colon
   xx add_save
   xx end


define_function "", help__meet_end__colon?
   ;; << -- bool >>
   xx literal, cursor$colon, fetch
   xx literal, 3, subtraction
   xx fetch_byte, space_char?
   xx false?, false?branch, 3
   xx   false
   xx   end
   xx literal, cursor$colon, fetch
   xx literal, 2, subtraction
   xx fetch_byte, literal, ';', equal?
   xx false?, false?branch, 3
   xx   false
   xx   end
   xx literal, cursor$colon, fetch
   xx literal, 1, subtraction
   xx fetch_byte, space_char?
   xx false?, false?branch, 3
   xx   false
   xx   end
   xx true
   xx end

define_function "", help__meet_comment__colon?
   ;; << -- bool >>
   xx literal, cursor$colon, fetch
   xx literal, 4, subtraction
   xx fetch_byte, space_char?
   xx false?, false?branch, 3
   xx   false
   xx   end
   xx literal, cursor$colon, fetch
   xx literal, 3, subtraction
   xx fetch_byte, literal, '<', equal?
   xx false?, false?branch, 3
   xx   false
   xx   end
   xx literal, cursor$colon, fetch
   xx literal, 2, subtraction
   xx fetch_byte, literal, '<', equal?
   xx false?, false?branch, 3
   xx   false
   xx   end
   xx literal, cursor$colon, fetch
   xx literal, 1, subtraction
   xx fetch_byte, space_char?
   xx false?, false?branch, 3
   xx   false
   xx   end
   xx true
   xx end

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   taca, ignore_comment ;; for the rest-comment
   xx dup2, comment_end_string?, false?branch, 3
   xx   drop2
   xx   end
   xx drop2
   xx taca, ignore_comment

size$jo_heap = 1024 * 1024 * jo_size

define_variable "*jo-heap*", V__jo_heap
  xx address$jo_heap

define_variable "*size,jo-heap*", V__size__jo_heap
  xx size$jo_heap


address$jo_heap labeling
   preserve size$jo_heap

define_variable "*current-free-address,jo-heap*", V__current_free_address__jo_heap
   xx address$jo_heap

define_exception "!undo-make-jojo", !undo_make_jojo
   ;; << old V__current_free_address__primitive_string
   ;;    old V__current_free_address__jo_heap
   ;;    old V__first_jo_in_dictionary
   ;;    string[address, length]
   ;;    -- >>
   xx literal, string$undo_make_jojo_report
   xx literal, length$undo_make_jojo_report
   xx write_string

   xx write_string
   xx literal, 10, write_byte
   xx literal, ';', write_byte
   xx literal, 10, write_byte

   xx address, V__first_jo_in_dictionary, save
   xx address, V__current_free_address__jo_heap, save
   xx address, V__current_free_address__primitive_string
   xx save
   xx end


string$undo_make_jojo_report:
   db "  THE FOLLOWING JOJO IS NOT MADE :"
   db 10
   db ": "
.end:
length$undo_make_jojo_report = (.end - string$undo_make_jojo_report)

define_function "make-jojo", make_jojo
   ;; << string[address, length] -- >>
   xx local_variable_table__clear
   xx make_jojo__loop
   xx end

define_function "make-jojo,loop", make_jojo__loop
   ;; << string[address, length] -- >>
   xx dup2, space_string?, false?branch, 3
   xx   drop2
   xx   end
   xx dup2
   xx string_tail__word
   xx xxswapxx
   xx string_head__word
   ;; << tail[address, length], head[address, length] >>
   xx make_jojo__dispatch_word
   xx taca, make_jojo__loop

define_function "make-jojo,dispatch-word", make_jojo__dispatch_word
   ;; << string[address, length], word[address, length] --
   ;;    string[address, length] >>
   xx dup2
   xx find_dispatch_word_stack, true?, false?branch, 3
   xx   execute_jo
   xx   end
   xx dup2
   xx find, false?
   xx false?branch, 7
   xx   write_undefined_word_report__for_make_jojo
   xx   write_string
   xx   literal, 10, write_byte
   xx   !undo_make_jojo
   xx xxswapx, drop2 ;; word
   xx make_jojo__dispatch_jo
   xx end

define_function "make-jojo,dispatch-jo", make_jojo__dispatch_jo
   ;; << string[address, length], jo --
   ;;    string[address, length] >>
   xx dup, macro_jo?, false?branch, 3
   xx   execute_jo
   xx   end

   ;; the same to
   ;;   function
   ;;   primitive-function
   ;;   variable
   ;;   exception
   xx save_into__jo_heap
   xx end


define_function "write-undefined-word-report,for-make-jojo", write_undefined_word_report__for_make_jojo
   ;; << -- >>
   xx literal, string$undefined_word_report__for_make_jojo
   xx literal, length$undefined_word_report__for_make_jojo
   xx write_string
   xx end

string$undefined_word_report__for_make_jojo:
   db "* (make-jojo) MEETS UNDEFINED WORD : "
.end:
length$undefined_word_report__for_make_jojo = (.end - string$undefined_word_report__for_make_jojo)

size$dispatch_word_stack = 1024 * jo_size

   preserve 64 * jo_size
address$dispatch_word_stack labeling
   preserve size$dispatch_word_stack

pointer$dispatch_word_stack:
   xx address$dispatch_word_stack

match =64bit, machine {

define_primitive_function "push-dispatch-word-stack", push_dispatch_word_stack
   ;; argument-stack -> dispatch-word-stack
   pop_argument_stack rax
   mov rbx, [pointer$dispatch_word_stack]
   mov [rbx], rax
   add qword [pointer$dispatch_word_stack], jo_size
   next

define_primitive_function "pop-dispatch-word-stack", pop_dispatch_word_stack
   ;; dispatch-word-stack -> argument-stack
   sub qword [pointer$dispatch_word_stack], jo_size
   mov rbx, [pointer$dispatch_word_stack]
   mov rax, [rbx]
   push_argument_stack rax
   next

}

match =32bit, machine {

define_primitive_function "push-dispatch-word-stack", push_dispatch_word_stack
   ;; argument-stack -> dispatch-word-stack
   pop_argument_stack rax
   mov rsi, [pointer$dispatch_word_stack]
   mov [rsi], rax
   add dword [pointer$dispatch_word_stack], jo_size
   next

define_primitive_function "pop-dispatch-word-stack", pop_dispatch_word_stack
   ;; dispatch-word-stack -> argument-stack
   sub dword [pointer$dispatch_word_stack], jo_size
   mov rsi, [pointer$dispatch_word_stack]
   mov rax, [rsi]
   push_argument_stack rax
   next

}

match =64bit, machine {

define_primitive_function "clear-dispatch-word-stack", clear_dispatch_word_stack
   ;; << -- >>
   mov qword [pointer$dispatch_word_stack], address$dispatch_word_stack
   next

}

match =32bit, machine {

define_primitive_function "clear-dispatch-word-stack", clear_dispatch_word_stack
   ;; << -- >>
   mov eax, address$dispatch_word_stack
   mov dword [pointer$dispatch_word_stack], eax;address$dispatch_word_stack
   next

}

define_function "find-dispatch-word-stack", find_dispatch_word_stack
   ;; << word[address, length]
   ;;    -- jo, true
   ;;    -- false >>
   xx literal, pointer$dispatch_word_stack, fetch
   xx literal, cursor$find_dispatch_word_stack, save
   xx find_dispatch_word_stack__loop
   xx end

cursor$find_dispatch_word_stack:
   xx 0

define_function "find-dispatch-word-stack,loop", find_dispatch_word_stack__loop
   ;; << word[address, length]
   ;;    -- jo, true
   ;;    -- false >>
   xx literal, cursor$find_dispatch_word_stack, fetch
   xx literal, address$dispatch_word_stack
   xx equal?, false?branch, 4
   xx   drop2
   xx   false
   xx   end
   xx dup2
   xx literal, cursor$find_dispatch_word_stack, fetch
   xx V__jo_size, subtraction, fetch
   xx execute_jo, true?, false?branch, (.not_found-$)/jo_size
   xx   drop2
   xx   literal, cursor$find_dispatch_word_stack, fetch
   xx   V__jo_size, subtraction
   xx   V__jo_size, subtraction, fetch
   xx   true
   xx   end
.not_found:
   xx literal, cursor$find_dispatch_word_stack, fetch
   xx V__jo_size, subtraction
   xx V__jo_size, subtraction
   xx literal, cursor$find_dispatch_word_stack, save
   xx taca, find_dispatch_word_stack__loop

define_function "initialize-dispatch-word-stack", initialize_dispatch_word_stack
   ;; << -- >>
   xx clear_dispatch_word_stack
   xx literal, M__integer_string, push_dispatch_word_stack
   xx literal, integer_string?, push_dispatch_word_stack
   xx end

define_macro "address", M__address
   ;; << string[address, length] -- string[address, length] >>
   xx literal, address
   xx save_into__jo_heap

   xx dup2
   xx string_head__word
   xx find, false?branch, 4
   xx   save_into__jo_heap
   xx   string_tail__word
   xx   end

   xx write_undefined_word_report__for_address
   xx dup2, string_head__word, write_string
   xx literal, 10, write_byte
   xx !undo_make_jojo


define_function "write-undefined-word-report,for-address", write_undefined_word_report__for_address
   ;; << -- >>
   xx literal, string$undefined_word_report__for_address
   xx literal, length$undefined_word_report__for_address
   xx write_string
   xx end

string$undefined_word_report__for_address:
   db "* (make-jojo (address)) THE WORD FOLLOWS (address) IS UNDEFINED : "
.end:
length$undefined_word_report__for_address = (.end - string$undefined_word_report__for_address)

define_macro "branch", M__branch
   ;; << string[address, length] -- string[address, length] >>
   xx literal, branch
   xx save_into__jo_heap

   xx dup2
   xx string_head__word
   xx dup2, integer_string?, false?branch, 5
   xx   string_to_integer
   xx   save_into__jo_heap
   xx   string_tail__word
   xx   end

   xx write_not_integer_string_report__for_branch
   xx dup2, string_head__word, write_string
   xx literal, 10, write_byte
   xx !undo_make_jojo


define_function "write-not-integer-string-report,for-branch", write_not_integer_string_report__for_branch
   ;; << -- >>
   xx literal, string$not_integer_string_report__for_branch
   xx literal, length$not_integer_string_report__for_branch
   xx write_string
   xx end

string$not_integer_string_report__for_branch:
   db "* (make-jojo (branch)) THE WORD FOLLOWS (branch) MUST BE A INTEGER STRING : "
.end:
length$not_integer_string_report__for_branch = (.end - string$not_integer_string_report__for_branch)

define_macro "false?branch", M__false?branch
   ;; << string[address, length] -- string[address, length] >>
   xx literal, false?branch
   xx save_into__jo_heap

   xx dup2
   xx string_head__word
   xx dup2, integer_string?, false?branch, 5
   xx   string_to_integer
   xx   save_into__jo_heap
   xx   string_tail__word
   xx   end

   xx write_not_integer_string_report__for_false?branch
   xx dup2, string_head__word, write_string
   xx literal, 10, write_byte
   xx !undo_make_jojo


define_function "write-not-integer-string-report,for-false?branch", write_not_integer_string_report__for_false?branch
   ;; << -- >>
   xx literal, string$not_integer_string_report__for_false?branch
   xx literal, length$not_integer_string_report__for_false?branch
   xx write_string
   xx end

string$not_integer_string_report__for_false?branch:
   db "* (make-jojo (false?branch)) THE WORD FOLLOWS (false?branch) MUST BE A INTEGER STRING : "
.end:
length$not_integer_string_report__for_false?branch = (.end - string$not_integer_string_report__for_false?branch)

define_macro '"', M__double_quote
   ;; << string[address, length] -- string[address, length] >>
   xx dup2
   xx literal, '"', find_char__string
   xx false?branch, (.not_found-$)/jo_size
   xx   xoverxx, subtraction
   ;;   << string[address, length], length >>

   ;; address
   xx   literal, literal
   xx     save_into__jo_heap
   xx   V__current_free_address__primitive_string, add2
   xx     save_into__jo_heap
   xx   xoverxx, over
   xx     save_into__primitive_string_heap

   ;; length
   xx   literal, literal
   xx     save_into__jo_heap
   xx   dup
   xx     save_into__jo_heap

   xx   tuck, subtraction
   xx   xxswapx
   xx   addition
   xx   swap

   xx   string_tail__char ;; over the ending double-quote
   xx   end

   .not_found:
   xx write_not_integer_string_report__for_double_quote
   xx literal, 10, write_byte
   xx !undo_make_jojo


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 "* (make-jojo (double-quote)) 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)

define_macro "", M__integer_string
   ;; << string[address, length], word[address, length] --
   ;;    string[address, length] >>
   xx literal, literal
   xx   save_into__jo_heap
   xx string_to_integer
   xx   save_into__jo_heap
   xx end

define_function "define-function", CICADA__define_function
   ;; << string[address, length] -- >>
   xx V__current_free_address__primitive_string, xxswapx
   xx V__current_free_address__jo_heap, xxswapx
   xx V__first_jo_in_dictionary, xxswapx
   xx prepare_for
   xx   exception_head
   xx   !undo_make_jojo
   xx   end_of_prepare


   xx V__current_free_address__primitive_string
   xx   save_into__jo_heap
   xx dup2, string_head__word
   xx   save_into__primitive_string_heap

   xx V__first_jo_in_dictionary
   xx jo_to_link
   xx   save_into__jo_heap

   xx V__current_free_address__jo_heap
   xx address, V__first_jo_in_dictionary
   xx save

   xx literal, explain$function
   xx   save_into__jo_heap

   xx dup2, string_tail__word
   xx   make_jojo


   xx drop2
   xx drop, drop, drop
   xx end

define_function "define-macro", CICADA__define_macro
   ;; << string[address, length] -- >>
   xx V__current_free_address__primitive_string, xxswapx
   xx V__current_free_address__jo_heap, xxswapx
   xx V__first_jo_in_dictionary, xxswapx
   xx prepare_for
   xx   exception_head
   xx   !undo_make_jojo
   xx   end_of_prepare


   xx V__current_free_address__primitive_string
   xx   save_into__jo_heap
   xx dup2, string_head__word
   xx   save_into__primitive_string_heap

   xx V__first_jo_in_dictionary
   xx jo_to_link
   xx   save_into__jo_heap

   xx V__current_free_address__jo_heap
   xx address, V__first_jo_in_dictionary
   xx save

   xx literal, explain$macro
   xx   save_into__jo_heap

   xx dup2, string_tail__word
   xx   make_jojo


   xx drop2
   xx drop, drop, drop
   xx end

define_function "define-exception", CICADA__define_exception
   ;; << string[address, length] -- >>
   xx V__current_free_address__primitive_string, xxswapx
   xx V__current_free_address__jo_heap, xxswapx
   xx V__first_jo_in_dictionary, xxswapx
   xx prepare_for
   xx   exception_head
   xx   !undo_make_jojo
   xx   end_of_prepare


   xx V__current_free_address__primitive_string
   xx   save_into__jo_heap
   xx dup2, string_head__word
   xx   save_into__primitive_string_heap

   xx V__first_jo_in_dictionary
   xx jo_to_link
   xx   save_into__jo_heap

   xx V__current_free_address__jo_heap
   xx address, V__first_jo_in_dictionary
   xx save

   xx literal, explain$exception
   xx   save_into__jo_heap

   xx dup2, string_tail__word
   xx   make_jojo


   xx drop2
   xx drop, drop, drop
   xx end

define_function "define-variable", CICADA__define_variable
   ;; << variable, string[address, length] -- >>
   xx V__current_free_address__primitive_string
   xx   save_into__jo_heap
   xx dup2, string_head__word
   xx   save_into__primitive_string_heap

   xx V__first_jo_in_dictionary
   xx jo_to_link
   xx   save_into__jo_heap

   xx V__current_free_address__jo_heap
   xx address, V__first_jo_in_dictionary
   xx save

   xx literal, explain$variable
   xx   save_into__jo_heap

   ;; when debugging
   ;; instead of drop2
   ;; one may wish to do some thing to the string
   xx drop2
   xx save_into__jo_heap
   xx end

define_function "save-into,primitive-string-heap", save_into__primitive_string_heap
   ;; << string[address, length] -- >>
   xx dup, V__current_free_address__primitive_string
   xx save_two_bytes

   xx literal, 2
   xx address, V__current_free_address__primitive_string
   xx add_save

   xx tuck
   xx V__current_free_address__primitive_string
   xx string_to_buffer!

   xx address, V__current_free_address__primitive_string
   xx add_save
   xx end

define_function "save-into,jo-heap", save_into__jo_heap
   ;; << number -- >>
   xx V__current_free_address__jo_heap
   xx save

   xx literal, jo_size
   xx address, V__current_free_address__jo_heap
   xx add_save
   xx end

size$local_data_heap = 3 * 1024 * 1024

address$local_data_heap labeling
   preserve size$local_data_heap

current_free_address$local_data_heap:
   xx address$local_data_heap

define_function "local-data-allocate,byte", local_data_allocate__byte
   ;; << number -- >>
   xx literal, current_free_address$local_data_heap
   xx add_save
   xx end

define_function "local-data-allocate,jo", local_data_allocate__jo
   ;; << number -- >>
   xx V__jo_size, multiple
   xx literal, current_free_address$local_data_heap
   xx add_save
   xx end

match =64bit, machine {

define_primitive_function "n-fetch-local-data", n_fetch_local_data
   ;; << offset, n -- value-1, ..., value-n >>
   mov rbx, [pointer$return_stack - (2 * jo_size)]

   pop_argument_stack rcx
   pop_argument_stack rdx
   add rbx, rdx
.loop:
   mov rax, [rbx]
   push_argument_stack rax
   add rbx, jo_size
   loop .loop
   next

define_primitive_function "n-save-local-data", n_save_local_data
   ;; << value-n, ..., value-1, offset, n -- >>
   mov rbx, [pointer$return_stack - (2 * jo_size)]

   pop_argument_stack rcx
   pop_argument_stack rdx
   add rbx, rdx
     mov rax, jo_size
     imul rax, rcx
     add rbx, rax
     ;; for address is based on 0
     ;; but n is based on 1
     sub rbx, jo_size
.loop:
   pop_argument_stack rax
   mov [rbx], rax
   sub rbx, jo_size
   loop .loop
   next

}

match =32bit, machine {

define_primitive_function "n-fetch-local-data", n_fetch_local_data
   ;; << offset, n -- value-1, ..., value-n >>
   mov rax, [pointer$return_stack]
   mov rbx, [rax - (2 * jo_size)]

   pop_argument_stack rcx
   pop_argument_stack rdx
   add rbx, rdx
.loop:
   mov rax, [rbx]
   push_argument_stack rax
   add rbx, jo_size
   loop .loop
   next

define_primitive_function "n-save-local-data", n_save_local_data
   ;; << value-n, ..., value-1, offset, n -- >>
   mov rax, [pointer$return_stack]
   mov rbx, [rax - (2 * jo_size)]

   pop_argument_stack rcx
   pop_argument_stack rdx
   add rbx, rdx
     mov rax, jo_size
     imul rax, rcx
     add rbx, rax
     ;; for address is based on 0
     ;; but n is based on 1
     sub rbx, jo_size
.loop:
   pop_argument_stack rax
   mov [rbx], rax
   sub rbx, jo_size
   loop .loop
   next

}

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_head__char
   xx literal, ':', equal?, false?, false?branch, 4
   xx   xxswapx, drop2
   xx   end
   xx add1, xxswapx
   xx string_tail__char, xswapxx
   xx taca, count_front_colon__loop

define_function "local-variable-fetch-string?", local_variable_fetch_string?
   ;; << string[address, length] -- bool >>
   xx dup, zero?, 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

define_macro "", M__local_variable_fetch_string
   ;; << string[address, length], word[address, length] --
   ;;    string[address, length] >>
   xx dup2
   xx local_variable_table__find, false?branch, (.not_found-$)/jo_size
   ;;   literal, <offese>, literal, n, n_fetch_local_data
   xx     literal, literal
   xx       save_into__jo_heap
   ;;     offset
   xx       save_into__jo_heap
   xx     literal, literal
   xx       save_into__jo_heap
   ;;     n
   xx     count_front_colon
   xx       save_into__jo_heap
   xx     literal, n_fetch_local_data
   xx       save_into__jo_heap
   xx   end
.not_found:
   ;; ><><>< exception handling
   xx write_local_variable_not_bound_report
   xx write_string
   xx literal, 10, write_byte
   xx !undo_make_jojo


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)

define_function "local-variable-save-string?", local_variable_save_string?
   ;; << string[address, length] -- bool >>
   xx dup, zero?, false?branch, 4
   xx   drop2, false
   xx   end
   xx dup2, string_head__char
   xx literal, '>', equal?, false?, false?branch, 4
   xx   drop2, false
   xx   end
   xx string_tail__char
   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

define_macro "", M__local_variable_save_string
   ;; << string[address, length], word[address, length] --
   ;;    string[address, length] >>
   xx string_tail__char
   xx dup2
   xx local_variable_table__find, false?branch, (.not_found-$)/jo_size
   ;;   literal, <offese>, literal, n, n_save_local_data
   xx     literal, literal
   xx       save_into__jo_heap
   ;;     offset
   xx       save_into__jo_heap
   xx     literal, literal
   xx       save_into__jo_heap
   ;;     n
   xx     count_front_colon
   xx       save_into__jo_heap
   xx     literal, n_save_local_data
   xx       save_into__jo_heap
   xx   end
.not_found:
   xx dup2
   xx local_variable_table__insert
   xx xxswapx
   xx count_front_colon
   ;; literal, <number>, local_data_allocate__jo
   xx   literal, literal
   xx     save_into__jo_heap
   ;;   number of jo
   xx     dup, save_into__jo_heap
   xx   literal, local_data_allocate__jo
   xx     save_into__jo_heap
   ;; literal, <offese>, literal, n, save_local_data
   xx   literal, literal
   xx     save_into__jo_heap
   ;;   offset
   xx   swap
   xx     save_into__jo_heap
   xx   literal, literal
   xx     save_into__jo_heap
   ;;   n
   xx     save_into__jo_heap
   xx   literal, n_save_local_data
   xx     save_into__jo_heap
   xx end

size$local_variable_table = 100 * 1024

address$local_variable_table labeling
   preserve size$local_variable_table

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, save
   xx literal, 0
   xx literal, offset$local_variable_table, save
   xx end

define_function "local-variable-table,insert", local_variable_table__insert
   ;; << string[address, length] -- offset >>

   ;; leave offset
   xx literal, offset$local_variable_table, fetch
   xx   xxtuckx ;; return value
   xx literal, border$local_variable_table, fetch, save
   xx V__jo_size
   xx literal, border$local_variable_table, add_save

   ;; update offset$local_variable_table
   xx dup2
   xx   count_front_colon
   xx   V__jo_size, multiple
   xx   literal, offset$local_variable_table, add_save

   ;; leave length
   xx dup
   xx literal, border$local_variable_table, fetch, save
   xx V__jo_size
   xx literal, border$local_variable_table, add_save

   xx tuck ;; for to update border$local_variable_table

   ;; leave string
   xx literal, border$local_variable_table, fetch
   xx string_to_buffer!

   ;; update border$local_variable_table
   xx literal, border$local_variable_table, add_save

   xx end

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, save
   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, fetch
   xx literal, border$local_variable_table, fetch
   xx greater_or_equal?, false?branch, 4
   xx   drop2
   xx   false
   xx   end
   xx dup2
   xx literal, cursor$local_variable_table, fetch
   xx   V__jo_size, addition
   xx   V__jo_size, addition ;; address of string
   xx literal, cursor$local_variable_table, fetch
   xx   V__jo_size, addition
   xx   fetch ;; length of string
   xx string_equal?, false?branch, 8
   xx   drop2
   xx   literal, cursor$local_variable_table, fetch
   xx     fetch ;; offset
   xx   true
   xx   end
   xx literal, cursor$local_variable_table, fetch
   xx   V__jo_size, addition
   xx   fetch ;; length of string
   xx V__jo_size, addition
   xx V__jo_size, addition
   xx literal, cursor$local_variable_table, add_save
   xx taca, local_variable_table__find__loop

define_function "initialize-local-variable", initialize_local_variable
   ;; << -- >>
   xx literal, M__local_variable_save_string,  push_dispatch_word_stack
   xx literal, local_variable_save_string?,    push_dispatch_word_stack
   xx literal, M__local_variable_fetch_string, push_dispatch_word_stack
   xx literal, local_variable_fetch_string?,   push_dispatch_word_stack
   xx end

define_function "platform", the_platform
   xx literal, string$platform
   xx literal, length$platform
   xx end

string$platform:

match =linux, platform {
   db "linux"
}

match =windows, platform {
   db "windows"
}

.end:
length$platform = (.end - string$platform)

define_variable "*un-initialized-memory*", V__un_initialized_memory
  xx address$un_initialized_memory

define_variable "*size,un-initialized-memory*", V__size__un_initialized_memory
  xx size$un_initialized_memory

define_variable "*current-free-address,un-initialized-memory*", V__current_free_address__un_initialized_memory
  xx current_free_address$un_initialized_memory

define_variable "*current-free-address,primitive-string-heap*", V__current_free_address__primitive_string
   xx current_free_address$primitive_string_heap

last_link = link

size$un_initialized_memory = 64 * 1024 * 1024 ;; (byte)

match =linux =64bit, platform machine {

segment readable writeable
address$un_initialized_memory:
   rb size$un_initialized_memory

}

match =linux =32bit, platform machine {

segment readable writeable
address$un_initialized_memory:
   rb size$un_initialized_memory

}

match =windows =64bit, platform machine {

section '.data' data readable writeable
address$un_initialized_memory:
   rb size$un_initialized_memory

}

if platform eq windows
if machine eq 64bit

;; Macroinstructions for making import section (64-bit)

macro library [name,string] {
   common
    import.data:
   forward
    local _label
    if defined name#.redundant
     if ~ name#.redundant
      dd RVA name#.lookup,0,0,RVA _label,RVA name#.address
     finish if
    finish if
    name#.referred = 1
   common
    dd 0,0,0,0,0
   forward
    if defined name#.redundant
     if ~ name#.redundant
      _label db string,0
             rb RVA $ and 1
     finish if
    finish if
}

macro import name,[label,string] {
  common
    rb (- rva $) and 7
    if defined name#.referred
     name#.lookup:
   forward
     if used label
      if string eqtype ''
       local _label
       dq RVA _label
      else
       dq 8000000000000000h + string
      finish if
     finish if
   common
     if $ > name#.lookup
      name#.redundant = 0
      dq 0
     else
      name#.redundant = 1
     finish if
     name#.address:
   forward
     if used label
      if string eqtype ''
       label dq RVA _label
      else
       label dq 8000000000000000h + string
      finish if
     finish if
   common
     if ~ name#.redundant
      dq 0
     finish if
   forward
     if used label & string eqtype ''
     _label dw 0
            db string,0
            rb RVA $ and 1
     finish if
   common
    finish if
}


finish if
finish if

match =windows =64bit, platform machine {

section '.idata' import data readable writeable

library kernel32,'KERNEL32.DLL'

import kernel32,\
       ExitProcess,'ExitProcess',\
       ReadFile,'ReadFile',\
       WriteFile,'WriteFile',\
       GetStdHandle,'GetStdHandle',\
       CloseHandle, 'CloseHandle',\
       CreateFileA, 'CreateFileA'

}

match =windows =32bit, platform machine {

section '.data' data readable writeable
address$un_initialized_memory:
   rb size$un_initialized_memory

}

if platform eq windows
if machine eq 32bit

; Macroinstructions for making import section

macro library [name,string] {
   common
    import.data:
   forward
    local _label
    if defined name#.redundant
     if ~ name#.redundant
      dd RVA name#.lookup,0,0,RVA _label,RVA name#.address
     finish if
    finish if
    name#.referred = 1
   common
    dd 0,0,0,0,0
   forward
    if defined name#.redundant
     if ~ name#.redundant
      _label db string,0
             rb RVA $ and 1
     finish if
    finish if
}

macro import name,[label,string]
 { common
    rb (- rva $) and 3
    if defined name#.referred
     name#.lookup:
   forward
     if used label
      if string eqtype ''
       local _label
       dd RVA _label
      else
       dd 80000000h + string
      finish if
     finish if
   common
     if $ > name#.lookup
      name#.redundant = 0
      dd 0
     else
      name#.redundant = 1
     finish if
     name#.address:
   forward
     if used label
      if string eqtype ''
       label dd RVA _label
      else
       label dd 80000000h + string
      finish if
     finish if
   common
     if ~ name#.redundant
      dd 0
     finish if
   forward
     if used label & string eqtype ''
     _label dw 0
            db string,0
            rb RVA $ and 1
     finish if
   common
    finish if
}

finish if
finish if

match =windows =32bit, platform machine {

section '.idata' import data readable writeable

library kernel32,'KERNEL32.DLL'

import kernel32,\
       ExitProcess,'ExitProcess',\
       ReadFile,'ReadFile',\
       WriteFile,'WriteFile',\
       GetStdHandle,'GetStdHandle',\
       CloseHandle, 'CloseHandle',\
       CreateFileA, 'CreateFileA'

}