mirror of
https://github.com/kanaka/mal.git
synced 2024-09-21 02:27:10 +03:00
0a19c2f1c7
wasm: update to wat syntax as of Jan 2019. Examples: - get_local -> local.get - i32.wrap/i64 -> i32.warp_i64 - etc The distinction between wat and wast has been clarified: - wat: textual format for web assembly modules - wast: superset of wat used in the specification to define tests.
466 lines
16 KiB
Plaintext
466 lines
16 KiB
Plaintext
(module $mem
|
|
(global $MEM_SIZE i32 1048576)
|
|
(global $STRING_MEM_SIZE i32 1048576)
|
|
|
|
(global $heap_start (mut i32) 0)
|
|
(global $heap_end (mut i32) 0)
|
|
|
|
(global $mem (mut i32) 0)
|
|
(global $mem_unused_start (mut i32) 0)
|
|
(global $mem_free_list (mut i32) 0)
|
|
(global $mem_user_start (mut i32) 0)
|
|
|
|
(global $string_mem (mut i32) 0)
|
|
(global $string_mem_next (mut i32) 0)
|
|
(global $string_mem_user_start (mut i32) 0)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; General type storage/pointer functions
|
|
|
|
(func $VAL0_ptr (param $mv i32) (result i32)
|
|
(i32.add $mv 4))
|
|
(func $VAL1_ptr (param $mv i32) (result i32)
|
|
(i32.add $mv 8))
|
|
|
|
(func $VAL0 (param $mv i32) (result i32)
|
|
(i32.load (i32.add $mv 4)))
|
|
(func $VAL1 (param $mv i32) (result i32)
|
|
(i32.load (i32.add $mv 8)))
|
|
|
|
|
|
(func $MEM_VAL0_ptr (param $mv i32) (result i32)
|
|
(i32.add (global.get $mem)
|
|
(i32.mul (i32.load (i32.add $mv 4)) 4)))
|
|
(func $MEM_VAL1_ptr (param $mv i32) (result i32)
|
|
(i32.add (global.get $mem)
|
|
(i32.mul (i32.load (i32.add $mv 8)) 4)))
|
|
(func $MEM_VAL2_ptr (param $mv i32) (result i32)
|
|
(i32.add (global.get $mem)
|
|
(i32.mul (i32.load (i32.add $mv 12)) 4)))
|
|
|
|
;; Returns the memory index mem of mv
|
|
;; Will usually be used with a load or store by the caller
|
|
(func $IDX (param $mv i32) (result i32)
|
|
;; MalVal memory 64 bit (2 * i32) aligned
|
|
(i32.div_u (i32.sub $mv (global.get $mem)) 4))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; Returns the address of 'mem[mv_idx]'
|
|
(func $MalVal_ptr (param $mv_idx i32) (result i32)
|
|
;; MalVal memory 64 bit (2 * i32) aligned
|
|
;;; mem[mv_idx].refcnt_type
|
|
(i32.add (global.get $mem) (i32.mul $mv_idx 4)))
|
|
|
|
;; Returns the address of 'mem[mv_idx].refcnt_type'
|
|
(func $MalVal_refcnt_type (param $mv_idx i32) (result i32)
|
|
(i32.load ($MalVal_ptr $mv_idx)))
|
|
|
|
(func $TYPE (param $mv i32) (result i32)
|
|
;;; type = mv->refcnt_type & 31
|
|
(i32.and (i32.load $mv) 0x1f)) ;; 0x1f == 31
|
|
|
|
(func $SET_TYPE (param $mv i32 $type i32)
|
|
;;; type = mv->refcnt_type & 31
|
|
;;; mv->refcnt_type += - (mv->refcnt_type & 31) + type
|
|
(i32.store $mv (i32.or
|
|
(i32.and $type 0x1f) ;; 0x1f == 31
|
|
(i32.and (i32.load $mv) 0xffffffe1)))
|
|
)
|
|
|
|
|
|
(func $REFS (param $mv i32) (result i32)
|
|
;;; type = mv->refcnt_type & 31
|
|
(i32.shr_u (i32.load $mv) 5)) ;; / 32
|
|
|
|
;; Returns the address of 'mem[mv_idx].val[val]'
|
|
;; Will usually be used with a load or store by the caller
|
|
(func $MalVal_val_ptr (param $mv_idx i32 $val i32) (result i32)
|
|
(i32.add (i32.add ($MalVal_ptr $mv_idx) 4)
|
|
(i32.mul $val 4)))
|
|
|
|
;; Returns the value of 'mem[mv_idx].val[val]'
|
|
(func $MalVal_val (param $mv_idx i32 $val i32) (result i32)
|
|
(i32.load ($MalVal_val_ptr $mv_idx $val)))
|
|
|
|
(func $MalType_size (param $type i32) (result i32)
|
|
;;; if (type <= 5 || type == 9 || type == 12)
|
|
(if (result i32) (OR (i32.le_u $type 5)
|
|
(i32.eq $type 9)
|
|
(i32.eq $type 12))
|
|
(then 2)
|
|
(else
|
|
;;; else if (type == 8 || type == 10 || type == 11)
|
|
(if (result i32) (OR (i32.eq $type 8)
|
|
(i32.eq $type 10)
|
|
(i32.eq $type 11))
|
|
(then 4)
|
|
(else 3)))))
|
|
|
|
(func $MalVal_size (param $mv i32) (result i32)
|
|
(LET $type ($TYPE $mv))
|
|
;; if (type == FREE_T)
|
|
(if (result i32) (i32.eq $type (global.get $FREE_T))
|
|
(then
|
|
;;; return (mv->refcnt_type & 0xffe0)>>5
|
|
(i32.shr_u (i32.and (i32.load $mv) 0xffe0) 5)) ;;; / 32
|
|
(else
|
|
;;; return MalType_size(type)
|
|
($MalType_size $type))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; init_memory
|
|
|
|
(func $init_memory
|
|
(LET $heap_size 0)
|
|
|
|
;; ($print ">>> init_memory\n")
|
|
|
|
($init_printf_mem)
|
|
|
|
;; error_str string buffer
|
|
(global.set $error_str (STATIC_ARRAY 100))
|
|
;; reader token string buffer
|
|
(global.set $token_buf (STATIC_ARRAY 256))
|
|
;; printer string buffer
|
|
(global.set $printer_buf (STATIC_ARRAY 4096))
|
|
|
|
(local.set $heap_size (i32.add (global.get $MEM_SIZE)
|
|
(global.get $STRING_MEM_SIZE)))
|
|
(global.set $heap_start (i32.add (global.get $memoryBase)
|
|
(global.get $S_STRING_END)))
|
|
(global.set $heap_end (i32.add (global.get $heap_start)
|
|
$heap_size))
|
|
|
|
(global.set $mem (global.get $heap_start))
|
|
(global.set $mem_unused_start 0)
|
|
(global.set $mem_free_list 0)
|
|
|
|
(global.set $string_mem (i32.add (global.get $heap_start)
|
|
(global.get $MEM_SIZE)))
|
|
(global.set $string_mem_next (global.get $string_mem))
|
|
|
|
(global.set $mem_user_start (global.get $mem_unused_start))
|
|
(global.set $string_mem_user_start (global.get $string_mem_next))
|
|
|
|
;; Empty values
|
|
(global.set $NIL
|
|
($ALLOC_SCALAR (global.get $NIL_T) 0))
|
|
(global.set $FALSE
|
|
($ALLOC_SCALAR (global.get $BOOLEAN_T) 0))
|
|
(global.set $TRUE
|
|
($ALLOC_SCALAR (global.get $BOOLEAN_T) 1))
|
|
(global.set $EMPTY_LIST
|
|
($ALLOC (global.get $LIST_T)
|
|
(global.get $NIL) (global.get $NIL) (global.get $NIL)))
|
|
(global.set $EMPTY_VECTOR
|
|
($ALLOC (global.get $VECTOR_T)
|
|
(global.get $NIL) (global.get $NIL) (global.get $NIL)))
|
|
(global.set $EMPTY_HASHMAP
|
|
($ALLOC (global.get $HASHMAP_T)
|
|
(global.get $NIL) (global.get $NIL) (global.get $NIL)))
|
|
|
|
;; ($print "<<< init_memory\n")
|
|
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; memory management
|
|
|
|
(func $ALLOC_INTERNAL (param $type i32
|
|
$val1 i32 $val2 i32 $val3 i32) (result i32)
|
|
(LET $prev (global.get $mem_free_list)
|
|
$res (global.get $mem_free_list)
|
|
$size ($MalType_size $type))
|
|
|
|
(block $loop_done
|
|
(loop $loop
|
|
;; res == mem_unused_start
|
|
(if (i32.eq $res (global.get $mem_unused_start))
|
|
(then
|
|
;; ALLOC_UNUSED
|
|
;;; if (res + size > MEM_SIZE)
|
|
(if (i32.gt_u (i32.add $res $size) (global.get $MEM_SIZE))
|
|
;; Out of memory, exit
|
|
($fatal 7 "Out of mal memory!\n"))
|
|
;;; if (mem_unused_start += size)
|
|
(global.set $mem_unused_start
|
|
(i32.add (global.get $mem_unused_start) $size))
|
|
;;; if (prev == res)
|
|
(if (i32.eq $prev $res)
|
|
(then
|
|
(global.set $mem_free_list (global.get $mem_unused_start)))
|
|
(else
|
|
;;; mem[prev].val[0] = mem_unused_start
|
|
(i32.store
|
|
($MalVal_val_ptr $prev 0)
|
|
(global.get $mem_unused_start))))
|
|
(br $loop_done)))
|
|
;; if (MalVal_size(mem+res) == size)
|
|
(if (i32.eq ($MalVal_size ($MalVal_ptr $res))
|
|
$size)
|
|
(then
|
|
;; ALLOC_MIDDLE
|
|
;;; if (res == mem_free_list)
|
|
(if (i32.eq $res (global.get $mem_free_list))
|
|
;; set free pointer (mem_free_list) to next free
|
|
;;; mem_free_list = mem[res].val[0];
|
|
(global.set $mem_free_list ($MalVal_val $res 0)))
|
|
;; if (res != mem_free_list)
|
|
(if (i32.ne $res (global.get $mem_free_list))
|
|
;; set previous free to next free
|
|
;;; mem[prev].val[0] = mem[res].val[0]
|
|
(i32.store ($MalVal_val_ptr $prev 0) ($MalVal_val $res 0)))
|
|
(br $loop_done)))
|
|
;;; prev = res
|
|
(local.set $prev $res)
|
|
;;; res = mem[res].val[0]
|
|
(local.set $res ($MalVal_val $res 0))
|
|
(br $loop)
|
|
)
|
|
)
|
|
;; ALLOC_DONE
|
|
;;; mem[res].refcnt_type = type + 32
|
|
(i32.store ($MalVal_ptr $res) (i32.add $type 32))
|
|
;; set val to default val1
|
|
;;; mem[res].val[0] = val1
|
|
(i32.store ($MalVal_val_ptr $res 0) $val1)
|
|
;;; if (type > 5 && type != 9)
|
|
(if (AND (i32.gt_u $type 5)
|
|
(i32.ne $type 9))
|
|
(then
|
|
;; inc refcnt of referenced value
|
|
;;; mem[val1].refcnt_type += 32
|
|
(i32.store ($MalVal_ptr $val1)
|
|
(i32.add ($MalVal_refcnt_type $val1) 32))))
|
|
;;; if (size > 2)
|
|
(if (i32.gt_u $size 2)
|
|
(then
|
|
;; inc refcnt of referenced value
|
|
;;; mem[val2].refcnt_type += 32
|
|
(i32.store ($MalVal_ptr $val2)
|
|
(i32.add ($MalVal_refcnt_type $val2) 32))
|
|
;;; mem[res].val[1] = val2
|
|
(i32.store ($MalVal_val_ptr $res 1) $val2)))
|
|
;;; if (size > 3)
|
|
(if (i32.gt_u $size 3)
|
|
(then
|
|
;; inc refcnt of referenced value
|
|
;;; mem[val3].refcnt_type += 32
|
|
(i32.store ($MalVal_ptr $val3)
|
|
(i32.add ($MalVal_refcnt_type $val3) 32))
|
|
;;; mem[res].val[2] = val3
|
|
(i32.store ($MalVal_val_ptr $res 2) $val3)))
|
|
|
|
;;; return mem + res
|
|
($MalVal_ptr $res)
|
|
)
|
|
|
|
(func $ALLOC_SCALAR (param $type i32 $val1 i32) (result i32)
|
|
($ALLOC_INTERNAL $type $val1 0 0)
|
|
)
|
|
|
|
(func $ALLOC (param $type i32 $val1 i32 $val2 i32 $val3 i32) (result i32)
|
|
($ALLOC_INTERNAL $type ($IDX $val1) ($IDX $val2) ($IDX $val3))
|
|
)
|
|
|
|
(func $RELEASE (param $mv i32)
|
|
(LET $idx 0 $type 0 $size 0)
|
|
|
|
;; Ignore NULLs
|
|
;;; if (mv == NULL) { return; }
|
|
(if (i32.eqz $mv) (return))
|
|
;;; idx = mv - mem
|
|
(local.set $idx ($IDX $mv))
|
|
;;; type = mv->refcnt_type & 31
|
|
(local.set $type (i32.and (i32.load $mv) 0x1f)) ;; 0x1f == 31
|
|
;;; size = MalType_size(type)
|
|
(local.set $size ($MalType_size $type))
|
|
|
|
;; DEBUG
|
|
;;; printf(">>> RELEASE idx: %d, type: %d, size: %d\n", idx, type, size)
|
|
|
|
(if (i32.eq 0 $mv)
|
|
($fatal 7 "RELEASE of NULL!\n"))
|
|
|
|
(if (i32.eq (global.get $FREE_T) $type)
|
|
(then
|
|
($printf_2 "RELEASE of already free mv: 0x%x, idx: 0x%x\n" $mv $idx)
|
|
($fatal 1 "")))
|
|
(if (i32.lt_u ($MalVal_refcnt_type $idx) 15)
|
|
(then
|
|
($printf_2 "RELEASE of unowned mv: 0x%x, idx: 0x%x\n" $mv $idx)
|
|
($fatal 1 "")))
|
|
|
|
;; decrease reference count by one
|
|
(i32.store ($MalVal_ptr $idx)
|
|
(i32.sub ($MalVal_refcnt_type $idx) 32))
|
|
|
|
;; nil, false, true, empty sequences
|
|
(if (i32.le_u $mv (global.get $EMPTY_HASHMAP))
|
|
(then
|
|
(if (i32.lt_u ($MalVal_refcnt_type $idx) 32)
|
|
(then
|
|
($printf_2 "RELEASE of unowned mv: 0x%x, idx: 0x%x\n" $mv $idx)
|
|
($fatal 1 "")))
|
|
(return)))
|
|
|
|
;; our reference count is not 0, so don't release
|
|
(if (i32.ge_u ($MalVal_refcnt_type $idx) 32)
|
|
(return))
|
|
|
|
(block $done
|
|
(block (block (block (block (block (block (block (block (block
|
|
(br_table 0 0 0 0 1 1 2 2 3 0 4 4 5 6 7 8 8 $type))
|
|
;; nil, boolean, integer, float
|
|
(br $done))
|
|
;; string, kw, symbol
|
|
;; release string, then FREE reference
|
|
($RELEASE_STRING (i32.add (global.get $string_mem) ($VAL0 $mv)))
|
|
(br $done))
|
|
;; list, vector
|
|
(if (i32.ne ($MalVal_val $idx 0) 0)
|
|
(then
|
|
;; release next element and value
|
|
($RELEASE ($MEM_VAL0_ptr $mv))
|
|
($RELEASE ($MEM_VAL1_ptr $mv))))
|
|
(br $done))
|
|
;; hashmap
|
|
(if (i32.ne ($MalVal_val $idx 0) 0)
|
|
(then
|
|
;; release next element, value, and key
|
|
($RELEASE ($MEM_VAL0_ptr $mv))
|
|
($RELEASE ($MEM_VAL2_ptr $mv))
|
|
($RELEASE ($MEM_VAL1_ptr $mv))))
|
|
(br $done))
|
|
;; mal / macro function
|
|
;; release ast, params, and environment
|
|
($RELEASE ($MEM_VAL2_ptr $mv))
|
|
($RELEASE ($MEM_VAL1_ptr $mv))
|
|
($RELEASE ($MEM_VAL0_ptr $mv))
|
|
(br $done))
|
|
;; atom
|
|
;; release contained/referred value
|
|
($RELEASE ($MEM_VAL0_ptr $mv))
|
|
(br $done))
|
|
;; env
|
|
;; if outer is set then release outer
|
|
(if (i32.ne ($MalVal_val $idx 1) 0)
|
|
($RELEASE ($MEM_VAL1_ptr $mv)))
|
|
;; release the env data (hashmap)
|
|
($RELEASE ($MEM_VAL0_ptr $mv))
|
|
(br $done))
|
|
;; metadata
|
|
;; release object and metdata object
|
|
($RELEASE ($MEM_VAL0_ptr $mv))
|
|
($RELEASE ($MEM_VAL1_ptr $mv))
|
|
(br $done))
|
|
;; default/unknown
|
|
)
|
|
|
|
;; FREE, free the current element
|
|
|
|
;; set type(FREE/15) and size
|
|
;;; mv->refcnt_type = size*32 + FREE_T
|
|
(i32.store $mv (i32.add (i32.mul $size 32) (global.get $FREE_T)))
|
|
(i32.store ($MalVal_val_ptr $idx 0) (global.get $mem_free_list))
|
|
(global.set $mem_free_list $idx)
|
|
(if (i32.ge_u $size 3) (i32.store ($MalVal_val_ptr $idx 1) 0))
|
|
(if (i32.eq $size 4) (i32.store ($MalVal_val_ptr $idx 2) 0))
|
|
)
|
|
|
|
;; find string in string memory or 0 if not found
|
|
(func $FIND_STRING (param $str i32) (result i32)
|
|
(LET $ms (global.get $string_mem))
|
|
(block $done
|
|
(loop $loop
|
|
(br_if $done (i32.ge_s $ms (global.get $string_mem_next)))
|
|
(if (i32.eqz ($strcmp $str (i32.add $ms 4)))
|
|
(return $ms))
|
|
|
|
(local.set $ms (i32.add $ms (i32.load16_u (i32.add $ms 2))))
|
|
(br $loop)
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
;; str is a NULL terminated string
|
|
;; size is number of characters in the string not including the
|
|
;; trailing NULL
|
|
(func $ALLOC_STRING (param $str i32 $size i32 $intern i32) (result i32)
|
|
(LET $ms 0)
|
|
|
|
;; search for matching string in string_mem
|
|
(if $intern
|
|
(then
|
|
(local.set $ms ($FIND_STRING $str))
|
|
(if $ms
|
|
(then
|
|
;;; ms->refcnt += 1
|
|
(i32.store16 $ms (i32.add (i32.load16_u $ms) 1))
|
|
(return $ms)))))
|
|
|
|
;; no existing matching string so create a new one
|
|
(local.set $ms (global.get $string_mem_next))
|
|
(i32.store16 $ms 1)
|
|
;;; ms->size = sizeof(MalString)+size+1
|
|
(i32.store16 offset=2 $ms (i32.add (i32.add 4 $size) 1))
|
|
($memmove (i32.add $ms 4) $str (i32.add $size 1))
|
|
;;; string_mem_next = (void *)ms + ms->size
|
|
(global.set $string_mem_next
|
|
;;(i32.add $ms (i32.load16_u (i32.add $ms 2))))
|
|
(i32.add $ms (i32.load16_u offset=2 $ms)))
|
|
|
|
;;($printf_2 "ALLOC_STRING 6 ms 0x%x, refs: %d\n" $ms (i32.load16_u $ms))
|
|
$ms
|
|
)
|
|
|
|
(func $RELEASE_STRING (param $ms i32)
|
|
(LET $size 0 $next 0 $ms_idx 0 $idx 0 $type 0 $mv 0)
|
|
|
|
(if (i32.le_s (i32.load16_u $ms) 0)
|
|
(then
|
|
($printf_2 "Release of already free string: %d (0x%x)\n"
|
|
(i32.sub $ms (global.get $string_mem)) $ms)
|
|
($fatal 1 "")))
|
|
|
|
;;; size = ms->size
|
|
(local.set $size (i32.load16_u (i32.add $ms 2)))
|
|
;;; *next = (void *)ms + size
|
|
(local.set $next (i32.add $ms $size))
|
|
|
|
;;; ms->refcnt -= 1
|
|
(i32.store16 $ms (i32.sub (i32.load16_u $ms) 1))
|
|
|
|
(if (i32.eqz (i32.load16_u $ms))
|
|
(then
|
|
(if (i32.gt_s (global.get $string_mem_next) $next)
|
|
(then
|
|
;; If no more references to this string then free it up by
|
|
;; shifting up every string afterwards to fill the gap
|
|
;; (splice).
|
|
($memmove $ms $next (i32.sub (global.get $string_mem_next)
|
|
$next))
|
|
|
|
;; Scan the mem values for string types after the freed
|
|
;; string and shift their indexes by size
|
|
(local.set $ms_idx (i32.sub $ms (global.get $string_mem)))
|
|
(local.set $idx ($IDX (global.get $EMPTY_HASHMAP)))
|
|
(loop $loop
|
|
(local.set $mv ($MalVal_ptr $idx))
|
|
(local.set $type ($TYPE $mv))
|
|
(if (AND (i32.gt_s ($VAL0 $mv) $ms_idx)
|
|
(OR (i32.eq $type (global.get $STRING_T))
|
|
(i32.eq $type (global.get $SYMBOL_T))))
|
|
(i32.store ($VAL0_ptr $mv) (i32.sub ($VAL0 $mv) $size)))
|
|
(local.set $idx (i32.add $idx ($MalVal_size $mv)))
|
|
|
|
(br_if $loop (i32.lt_s $idx (global.get $mem_unused_start)))
|
|
)))
|
|
|
|
(global.set $string_mem_next
|
|
(i32.sub (global.get $string_mem_next) $size))))
|
|
)
|
|
)
|