(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)))) ) )