mirror of
https://github.com/kanaka/mal.git
synced 2024-11-09 18:06:35 +03:00
wasm: use LET macro and br_if.
This commit is contained in:
Joel Martin
parent
50eea9ad9c
commit
349faa83e3
188
wasm/core.wam
188
wasm/core.wam
@ -58,14 +58,12 @@
|
||||
($TRUE_FALSE (i32.eq ($TYPE ($MEM_VAL1_ptr $args))
|
||||
(get_global $NIL_T))))
|
||||
(func $true_Q (param $args i32) (result i32)
|
||||
(local $ast i32)
|
||||
(set_local $ast ($MEM_VAL1_ptr $args))
|
||||
(LET $ast ($MEM_VAL1_ptr $args))
|
||||
($TRUE_FALSE (AND (i32.eq ($TYPE $ast) (get_global $BOOLEAN_T))
|
||||
(i32.eq ($VAL0 $ast) 1)))
|
||||
)
|
||||
(func $false_Q (param $args i32) (result i32)
|
||||
(local $ast i32)
|
||||
(set_local $ast ($MEM_VAL1_ptr $args))
|
||||
(LET $ast ($MEM_VAL1_ptr $args))
|
||||
($TRUE_FALSE (AND (i32.eq ($TYPE $ast) (get_global $BOOLEAN_T))
|
||||
(i32.eq ($VAL0 $ast) 0)))
|
||||
)
|
||||
@ -73,16 +71,14 @@
|
||||
($TRUE_FALSE (i32.eq ($TYPE ($MEM_VAL1_ptr $args))
|
||||
(get_global $INTEGER_T))))
|
||||
(func $string_Q (param $args i32) (result i32)
|
||||
(local $mv i32)
|
||||
(set_local $mv ($MEM_VAL1_ptr $args))
|
||||
(LET $mv ($MEM_VAL1_ptr $args))
|
||||
($TRUE_FALSE (AND (i32.eq ($TYPE $mv) (get_global $STRING_T))
|
||||
(i32.ne (i32.load8_u ($to_String $mv))
|
||||
(CHR "\x7f"))))
|
||||
)
|
||||
|
||||
(func $keyword (param $args i32) (result i32)
|
||||
(local $str i32)
|
||||
(set_local $str ($to_String ($MEM_VAL1_ptr $args)))
|
||||
(LET $str ($to_String ($MEM_VAL1_ptr $args)))
|
||||
(if i32 (i32.eq (i32.load8_u $str) (CHR "\x7f"))
|
||||
(then ($INC_REF ($MEM_VAL1_ptr $args)))
|
||||
(else
|
||||
@ -91,15 +87,13 @@
|
||||
)
|
||||
|
||||
(func $keyword_Q (param $args i32) (result i32)
|
||||
(local $ast i32)
|
||||
(set_local $ast ($MEM_VAL1_ptr $args))
|
||||
(LET $ast ($MEM_VAL1_ptr $args))
|
||||
($TRUE_FALSE (AND (i32.eq ($TYPE $ast) (get_global $STRING_T))
|
||||
(i32.eq (i32.load8_u ($to_String $ast))
|
||||
(CHR "\x7f"))))
|
||||
)
|
||||
(func $fn_Q (param $args i32) (result i32)
|
||||
(local $type i32)
|
||||
(set_local $type ($TYPE ($MEM_VAL1_ptr $args)))
|
||||
(LET $type ($TYPE ($MEM_VAL1_ptr $args)))
|
||||
($TRUE_FALSE (OR (i32.eq $type (get_global $FUNCTION_T))
|
||||
(i32.eq $type (get_global $MALFUNC_T)))))
|
||||
(func $macro_Q (param $args i32) (result i32)
|
||||
@ -118,23 +112,21 @@
|
||||
(func $str (param $args i32) (result i32)
|
||||
($pr_str_seq $args 0 ""))
|
||||
(func $prn (param $args i32) (result i32)
|
||||
(local $res i32)
|
||||
(set_local $res ($pr_str_seq $args 1 " "))
|
||||
(LET $res ($pr_str_seq $args 1 " "))
|
||||
($printf_1 "%s\n" ($to_String $res))
|
||||
($RELEASE $res)
|
||||
($INC_REF (get_global $NIL))
|
||||
)
|
||||
(func $println (param $args i32) (result i32)
|
||||
(local $res i32)
|
||||
(set_local $res ($pr_str_seq $args 0 " "))
|
||||
(LET $res ($pr_str_seq $args 0 " "))
|
||||
($printf_1 "%s\n" ($to_String $res))
|
||||
($RELEASE $res)
|
||||
($INC_REF (get_global $NIL))
|
||||
)
|
||||
|
||||
(func $core_readline (param $args i32) (result i32)
|
||||
(local $line i32 $mv i32)
|
||||
(set_local $line (STATIC_ARRAY 201))
|
||||
(LET $line (STATIC_ARRAY 201)
|
||||
$mv 0)
|
||||
(if (i32.eqz ($readline ($to_String ($MEM_VAL1_ptr $args)) $line))
|
||||
(return ($INC_REF (get_global $NIL))))
|
||||
(set_local $mv ($STRING (get_global $STRING_T) $line))
|
||||
@ -145,10 +137,9 @@
|
||||
($read_str ($to_String ($MEM_VAL1_ptr $args))))
|
||||
|
||||
(func $slurp (param $args i32) (result i32)
|
||||
(local $mv i32 $size i32)
|
||||
(set_local $mv ($STRING_INIT (get_global $STRING_T)))
|
||||
(set_local $size ($read_file ($to_String ($MEM_VAL1_ptr $args))
|
||||
($to_String $mv)))
|
||||
(LET $mv ($STRING_INIT (get_global $STRING_T))
|
||||
$size ($read_file ($to_String ($MEM_VAL1_ptr $args))
|
||||
($to_String $mv)))
|
||||
(if (i32.eqz $size)
|
||||
(then
|
||||
($THROW_STR_1 "failed to read file '%s'" ($to_String ($MEM_VAL1_ptr $args)))
|
||||
@ -210,22 +201,20 @@
|
||||
(get_global $VECTOR_T))))
|
||||
|
||||
(func $hash_map (param $args i32) (result i32)
|
||||
(local $res i32 $type i32 $val2 i32 $val3 i32 $c i32)
|
||||
(local $ret i32 $empty i32 $current i32) ;; MAP_LOOP stack
|
||||
(set_local $type (get_global $HASHMAP_T))
|
||||
|
||||
;; MAP_LOOP_START
|
||||
(set_local $res ($MAP_LOOP_START $type))
|
||||
;; push MAP_LOOP stack
|
||||
;;; empty = current = ret = res
|
||||
(set_local $ret $res)
|
||||
(set_local $current $res)
|
||||
(set_local $empty $res)
|
||||
(LET $type (get_global $HASHMAP_T)
|
||||
$res ($MAP_LOOP_START $type)
|
||||
$val2 0
|
||||
$val3 0
|
||||
$c 0
|
||||
;; push MAP_LOOP stack
|
||||
$ret $res
|
||||
$current $res
|
||||
$empty $res)
|
||||
|
||||
;; READ_SEQ_LOOP
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.eqz ($VAL0 $args)) (br $done))
|
||||
(br_if $done (i32.eqz ($VAL0 $args)))
|
||||
|
||||
(set_local $val2 ($INC_REF ($MEM_VAL1_ptr $args)))
|
||||
(set_local $val3 ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))
|
||||
@ -256,15 +245,15 @@
|
||||
(get_global $HASHMAP_T))))
|
||||
|
||||
(func $assoc (param $args i32) (result i32)
|
||||
(local $hm i32 $key i32)
|
||||
(set_local $hm ($MEM_VAL1_ptr $args))
|
||||
(LET $hm ($MEM_VAL1_ptr $args)
|
||||
$key 0)
|
||||
(set_local $args ($MEM_VAL0_ptr $args))
|
||||
|
||||
(drop ($INC_REF $hm))
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (OR (i32.eqz ($VAL0 $args))
|
||||
(i32.eqz ($VAL0 ($MEM_VAL0_ptr $args))))
|
||||
(br $done))
|
||||
(br_if $done (OR (i32.eqz ($VAL0 $args))
|
||||
(i32.eqz ($VAL0 ($MEM_VAL0_ptr $args)))))
|
||||
(set_local $hm ($ASSOC1 $hm ($MEM_VAL1_ptr $args)
|
||||
($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))
|
||||
(set_local $args ($MEM_VAL0_ptr ($MEM_VAL0_ptr $args)))
|
||||
@ -276,18 +265,16 @@
|
||||
)
|
||||
|
||||
(func $get (param $args i32) (result i32)
|
||||
(local $hm i32 $key i32)
|
||||
(set_local $hm ($MEM_VAL1_ptr $args))
|
||||
(set_local $key ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))
|
||||
(LET $hm ($MEM_VAL1_ptr $args)
|
||||
$key ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))
|
||||
(if i32 (i32.eq $hm (get_global $NIL))
|
||||
(then ($INC_REF (get_global $NIL)))
|
||||
(else ($INC_REF (i32.wrap/i64 ($HASHMAP_GET $hm $key)))))
|
||||
)
|
||||
|
||||
(func $contains_Q (param $args i32) (result i32)
|
||||
(local $hm i32 $key i32)
|
||||
(set_local $hm ($MEM_VAL1_ptr $args))
|
||||
(set_local $key ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))
|
||||
(LET $hm ($MEM_VAL1_ptr $args)
|
||||
$key ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))
|
||||
($TRUE_FALSE
|
||||
(if i32 (i32.eq $hm (get_global $NIL))
|
||||
(then 0)
|
||||
@ -296,20 +283,16 @@
|
||||
)
|
||||
|
||||
(func $keys_or_vals (param $hm i32 $keys i32) (result i32)
|
||||
(local $res i32 $val2 i32)
|
||||
(local $ret i32 $empty i32 $current i32) ;; MAP_LOOP stack
|
||||
|
||||
;; MAP_LOOP_START
|
||||
(set_local $res ($MAP_LOOP_START (get_global $LIST_T)))
|
||||
;; push MAP_LOOP stack
|
||||
;;; empty = current = ret = res
|
||||
(set_local $ret $res)
|
||||
(set_local $current $res)
|
||||
(set_local $empty $res)
|
||||
(LET $res ($MAP_LOOP_START (get_global $LIST_T))
|
||||
$val2 0
|
||||
;; MAP_LOOP stack
|
||||
$ret $res
|
||||
$current $res
|
||||
$empty $res)
|
||||
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.eqz ($VAL0 $hm)) (br $done))
|
||||
(br_if $done (i32.eqz ($VAL0 $hm)))
|
||||
|
||||
(if $keys
|
||||
(then (set_local $val2 ($INC_REF ($MEM_VAL1_ptr $hm))))
|
||||
@ -354,15 +337,15 @@
|
||||
($LIST ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)) ($MEM_VAL1_ptr $args)))
|
||||
|
||||
(func $concat (param $args i32) (result i32)
|
||||
(local $res i32 $current i32 $sl i32 $last i32 $last_sl i64 $arg i32)
|
||||
(set_local $res ($INC_REF (get_global $EMPTY_LIST)))
|
||||
(set_local $current $res)
|
||||
(set_local $sl 0)
|
||||
(set_local $last 0)
|
||||
(local $last_sl i64)
|
||||
(LET $res ($INC_REF (get_global $EMPTY_LIST))
|
||||
$current $res
|
||||
$sl 0
|
||||
$last 0
|
||||
$arg 0)
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.le_u $args (get_global $EMPTY_HASHMAP))
|
||||
(br $done))
|
||||
(br_if $done (i32.le_u $args (get_global $EMPTY_HASHMAP)))
|
||||
(set_local $arg ($MEM_VAL1_ptr $args))
|
||||
;; skip empty elements
|
||||
(if (i32.le_s $arg (get_global $EMPTY_HASHMAP))
|
||||
@ -392,15 +375,13 @@
|
||||
)
|
||||
|
||||
(func $nth (param $args i32) (result i32)
|
||||
(local $a i32 $idx i32 $i i32)
|
||||
(set_local $a ($MEM_VAL1_ptr $args))
|
||||
(set_local $idx ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))
|
||||
(LET $a ($MEM_VAL1_ptr $args)
|
||||
$idx ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))
|
||||
$i 0)
|
||||
|
||||
(set_local $i 0)
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (OR (i32.ge_s $i $idx) (i32.eqz ($VAL0 $a)))
|
||||
(br $done))
|
||||
(br_if $done (OR (i32.ge_s $i $idx) (i32.eqz ($VAL0 $a))))
|
||||
(set_local $i (i32.add $i 1))
|
||||
(set_local $a ($MEM_VAL0_ptr $a))
|
||||
(br $loop)
|
||||
@ -415,9 +396,8 @@
|
||||
)
|
||||
|
||||
(func $first (param $args i32) (result i32)
|
||||
(local $res i32 $a i32)
|
||||
(set_local $res (get_global $NIL))
|
||||
(set_local $a ($MEM_VAL1_ptr $args))
|
||||
(LET $res (get_global $NIL)
|
||||
$a ($MEM_VAL1_ptr $args))
|
||||
(if (AND (i32.ne $a (get_global $NIL))
|
||||
(i32.ne ($VAL0 $a) 0))
|
||||
(set_local $res ($MEM_VAL1_ptr $a)))
|
||||
@ -425,8 +405,7 @@
|
||||
)
|
||||
|
||||
(func $rest (param $args i32) (result i32)
|
||||
(local $a i32)
|
||||
(set_local $a ($MEM_VAL1_ptr $args))
|
||||
(LET $a ($MEM_VAL1_ptr $args))
|
||||
(if (i32.eq $a (get_global $NIL))
|
||||
(return ($INC_REF (get_global $EMPTY_LIST))))
|
||||
(if (i32.ne ($VAL0 $a) 0)
|
||||
@ -443,12 +422,13 @@
|
||||
($INTEGER ($COUNT ($MEM_VAL1_ptr $args))))
|
||||
|
||||
(func $apply (param $args i32) (result i32)
|
||||
(local $f i32 $f_args i32 $rest_args i32 $rest_count i32)
|
||||
(local $last_sl i64 $last i32 $res i32)
|
||||
|
||||
(set_local $f ($MEM_VAL1_ptr $args))
|
||||
(set_local $rest_args ($MEM_VAL0_ptr $args))
|
||||
(set_local $rest_count ($COUNT $rest_args))
|
||||
(local $last_sl i64)
|
||||
(LET $f ($MEM_VAL1_ptr $args)
|
||||
$f_args 0
|
||||
$rest_args ($MEM_VAL0_ptr $args)
|
||||
$rest_count ($COUNT $rest_args)
|
||||
$last 0
|
||||
$res 0)
|
||||
|
||||
(if (i32.le_s $rest_count 1)
|
||||
(then
|
||||
@ -482,23 +462,18 @@
|
||||
)
|
||||
|
||||
(func $map (param $args i32) (result i32)
|
||||
(local $f i32 $rest_args i32 $f_args i32 $res i32)
|
||||
(local $ret i32 $empty i32 $current i32) ;; MAP_LOOP stack
|
||||
|
||||
(set_local $f ($MEM_VAL1_ptr $args))
|
||||
(set_local $rest_args ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))
|
||||
|
||||
;; MAP_LOOP_START
|
||||
(set_local $res ($MAP_LOOP_START (get_global $LIST_T)))
|
||||
;; push MAP_LOOP stack
|
||||
;;; empty = current = ret = res
|
||||
(set_local $ret $res)
|
||||
(set_local $current $res)
|
||||
(set_local $empty $res)
|
||||
(LET $f ($MEM_VAL1_ptr $args)
|
||||
$rest_args ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))
|
||||
$f_args 0
|
||||
$res ($MAP_LOOP_START (get_global $LIST_T))
|
||||
;; push MAP_LOOP stack
|
||||
$ret $res
|
||||
$current $res
|
||||
$empty $res)
|
||||
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.eqz ($VAL1 $rest_args)) (br $done))
|
||||
(br_if $done (i32.eqz ($VAL1 $rest_args)))
|
||||
|
||||
;; create argument list for apply
|
||||
(set_local $f_args ($ALLOC (get_global $LIST_T)
|
||||
@ -539,9 +514,8 @@
|
||||
;;;
|
||||
|
||||
(func $with_meta (param $args i32) (result i32)
|
||||
(local $mv i32 $meta i32)
|
||||
(set_local $mv ($MEM_VAL1_ptr $args))
|
||||
(set_local $meta ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))
|
||||
(LET $mv ($MEM_VAL1_ptr $args)
|
||||
$meta ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))
|
||||
;; remove existing metadata first
|
||||
($ALLOC (get_global $METADATA_T) ($DEREF_META $mv) $meta 0)
|
||||
)
|
||||
@ -572,21 +546,19 @@
|
||||
|
||||
(func $reset_BANG (param $args i32) (result i32)
|
||||
(local $atom i32 $val i32)
|
||||
(set_local $atom ($MEM_VAL1_ptr $args))
|
||||
(set_local $val ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))
|
||||
(LET $atom ($MEM_VAL1_ptr $args)
|
||||
$val ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))
|
||||
($_reset_BANG $atom $val)
|
||||
)
|
||||
|
||||
(func $swap_BANG (param $args i32) (result i32)
|
||||
(local $atom i32 $f_args i32 $s_args i32 $rest_args i32 $f i32 $res i32)
|
||||
(set_local $atom ($MEM_VAL1_ptr $args))
|
||||
(set_local $f_args ($MEM_VAL0_ptr $args))
|
||||
(set_local $rest_args ($MEM_VAL0_ptr $f_args))
|
||||
(set_local $f ($MEM_VAL1_ptr $f_args))
|
||||
(set_local $res 0)
|
||||
;; add atom value to front of the args list
|
||||
(set_local $s_args ($LIST $rest_args ($MEM_VAL0_ptr $atom))) ;; cons
|
||||
(set_local $res ($APPLY $f $s_args))
|
||||
(LET $atom ($MEM_VAL1_ptr $args)
|
||||
$f_args ($MEM_VAL0_ptr $args)
|
||||
$rest_args ($MEM_VAL0_ptr $f_args)
|
||||
;; add atom value to front of the args list
|
||||
$s_args ($LIST $rest_args ($MEM_VAL0_ptr $atom)) ;; cons
|
||||
$f ($MEM_VAL1_ptr $f_args)
|
||||
$res ($APPLY $f $s_args))
|
||||
;; release args
|
||||
($RELEASE $s_args)
|
||||
;; use reset to update the value
|
||||
|
||||
@ -6,20 +6,18 @@
|
||||
)
|
||||
|
||||
(func $CHECK_FREE_LIST (result i32)
|
||||
(local $first i32 $count i32)
|
||||
(set_local $first (i32.add
|
||||
(get_global $mem)
|
||||
(i32.mul_u (get_global $mem_free_list)
|
||||
4)))
|
||||
(set_local $count 0)
|
||||
(LET $first (i32.add
|
||||
(get_global $mem)
|
||||
(i32.mul_u (get_global $mem_free_list) 4))
|
||||
$count 0)
|
||||
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.ge_s $first (i32.add
|
||||
(get_global $mem)
|
||||
(i32.mul_u (get_global $mem_unused_start)
|
||||
4)))
|
||||
(br $done))
|
||||
(br_if $done
|
||||
(i32.ge_s $first
|
||||
(i32.add (get_global $mem)
|
||||
(i32.mul_u (get_global $mem_unused_start)
|
||||
4))))
|
||||
(set_local $count (i32.add $count ($MalVal_size $first)))
|
||||
(set_local $first (i32.add (get_global $mem) (i32.mul_u 4 ($VAL0 $first))))
|
||||
(br $loop)
|
||||
@ -29,20 +27,18 @@
|
||||
)
|
||||
|
||||
(func $PR_MEMORY_SUMMARY_SMALL
|
||||
(local $free i32 $free_list_count i32 $mv i32 $mem_ref_count i32)
|
||||
(LET $free (i32.sub_s (get_global $MEM_SIZE)
|
||||
(i32.mul_u (get_global $mem_unused_start) 4))
|
||||
$free_list_count ($CHECK_FREE_LIST)
|
||||
$mv (get_global $NIL)
|
||||
$mem_ref_count 0)
|
||||
|
||||
(set_local $free (i32.sub_s (get_global $MEM_SIZE)
|
||||
(i32.mul_u (get_global $mem_unused_start) 4)))
|
||||
(set_local $free_list_count ($CHECK_FREE_LIST))
|
||||
(set_local $mem_ref_count 0)
|
||||
|
||||
(set_local $mv (get_global $NIL))
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.ge_s $mv (i32.add
|
||||
(get_global $mem)
|
||||
(i32.mul_u (get_global $mem_unused_start) 4)))
|
||||
(br $done))
|
||||
(br_if $done (i32.ge_s $mv (i32.add
|
||||
(get_global $mem)
|
||||
(i32.mul_u (get_global $mem_unused_start)
|
||||
4))))
|
||||
(if (i32.ne ($TYPE $mv) (get_global $FREE_T))
|
||||
(set_local $mem_ref_count (i32.add $mem_ref_count
|
||||
(i32.shr_u
|
||||
@ -62,7 +58,7 @@
|
||||
(set_local $mv (get_global $NIL))
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.gt_s $mv (get_global $TRUE)) (br $done))
|
||||
(br_if $done (i32.gt_s $mv (get_global $TRUE)))
|
||||
($printf_1 "%d," (i32.div_s (i32.load $mv) 32))
|
||||
(set_local $mv (i32.add $mv 8))
|
||||
(br $loop)
|
||||
@ -71,7 +67,7 @@
|
||||
(set_local $mv (get_global $EMPTY_LIST))
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.gt_s $mv (get_global $EMPTY_HASHMAP)) (br $done))
|
||||
(br_if $done (i32.gt_s $mv (get_global $EMPTY_HASHMAP)))
|
||||
($printf_1 "%d," (i32.div_s (i32.load $mv) 32))
|
||||
(set_local $mv (i32.add $mv 12))
|
||||
(br $loop)
|
||||
@ -81,19 +77,17 @@
|
||||
)
|
||||
|
||||
(func $PR_VALUE (param $fmt i32 $mv i32)
|
||||
(local $temp i32)
|
||||
(set_local $temp ($pr_str $mv 1))
|
||||
(LET $temp ($pr_str $mv 1))
|
||||
($printf_1 $fmt ($to_String $temp))
|
||||
($RELEASE $temp)
|
||||
)
|
||||
|
||||
(func $PR_MEMORY_VALUE (param $idx i32) (result i32)
|
||||
(local $mv i32 $type i32 $size i32 $val0 i32)
|
||||
;;; mv = mem + idx
|
||||
(set_local $mv ($MalVal_ptr $idx))
|
||||
(set_local $type ($TYPE $mv))
|
||||
(set_local $size ($MalVal_size $mv))
|
||||
(set_local $val0 ($MalVal_val $idx 0))
|
||||
(LET $mv ($MalVal_ptr $idx)
|
||||
$type ($TYPE $mv)
|
||||
$size ($MalVal_size $mv)
|
||||
$val0 ($MalVal_val $idx 0))
|
||||
|
||||
($printf_2 "%4d: type %2d" $idx $type)
|
||||
|
||||
@ -213,7 +207,8 @@
|
||||
)
|
||||
|
||||
(func $PR_STRINGS (param $start i32)
|
||||
(local $ms i32 $idx i32)
|
||||
(LET $ms 0
|
||||
$idx 0)
|
||||
($printf_2 "String - showing %d -> %d:\n"
|
||||
$start (i32.sub_s (get_global $string_mem_next)
|
||||
(get_global $string_mem)))
|
||||
@ -225,8 +220,7 @@
|
||||
(set_local $ms (get_global $string_mem))
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.ge_u $ms (get_global $string_mem_next))
|
||||
(br $done))
|
||||
(br_if $done (i32.ge_u $ms (get_global $string_mem_next)))
|
||||
(set_local $idx (i32.sub_u $ms (get_global $string_mem)))
|
||||
(if (i32.ge_s $idx $start)
|
||||
($printf_4 "%4d: refs %2d, size %2d >> '%s'\n"
|
||||
@ -242,7 +236,8 @@
|
||||
)
|
||||
|
||||
(func $PR_MEMORY (param $start i32 $end i32)
|
||||
(local $string_start i32 $idx i32)
|
||||
(LET $string_start 0
|
||||
$idx 0)
|
||||
(if (i32.lt_s $start 0)
|
||||
(then
|
||||
(set_local $start (get_global $mem_user_start))
|
||||
@ -268,8 +263,7 @@
|
||||
;;; while (idx < end)
|
||||
(block $loopvals_exit
|
||||
(loop $loopvals
|
||||
(if (i32.ge_s $idx $end)
|
||||
(br $loopvals_exit))
|
||||
(br_if $loopvals_exit (i32.ge_s $idx $end))
|
||||
(set_local $idx ($PR_MEMORY_VALUE $idx))
|
||||
(br $loopvals)
|
||||
)
|
||||
@ -281,7 +275,7 @@
|
||||
(func $PR_MEMORY_RAW (param $start i32 $end i32)
|
||||
(block $loop_exit
|
||||
(loop $loop
|
||||
(if (i32.ge_u $start $end) (br $loop_exit))
|
||||
(br_if $loop_exit (i32.ge_u $start $end))
|
||||
($printf_2 "0x%x 0x%x\n" $start (i32.load $start))
|
||||
(set_local $start (i32.add 4 $start))
|
||||
(br $loop)
|
||||
|
||||
31
wasm/env.wam
31
wasm/env.wam
@ -3,23 +3,21 @@
|
||||
(func $ENV_NEW (param $outer i32) (result i32)
|
||||
(local $data i32 $env i32)
|
||||
|
||||
;; allocate the data hashmap
|
||||
(set_local $data ($HASHMAP))
|
||||
|
||||
(set_local $env ($ALLOC (get_global $ENVIRONMENT_T) $data $outer 0))
|
||||
(LET $data ($HASHMAP) ;; allocate the data hashmap
|
||||
$env ($ALLOC (get_global $ENVIRONMENT_T) $data $outer 0))
|
||||
;; environment takes ownership
|
||||
($RELEASE $data)
|
||||
$env
|
||||
)
|
||||
|
||||
(func $ENV_NEW_BINDS (param $outer i32 $binds i32 $exprs i32) (result i32)
|
||||
(local $env i32 $key i32)
|
||||
(set_local $env ($ENV_NEW $outer))
|
||||
(LET $env ($ENV_NEW $outer)
|
||||
$key 0)
|
||||
|
||||
;; process bindings
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.eqz ($VAL0 $binds)) (br $done))
|
||||
(br_if $done (i32.eqz ($VAL0 $binds)))
|
||||
|
||||
;; get/deref the key from binds
|
||||
(set_local $key ($MEM_VAL1_ptr $binds))
|
||||
@ -51,29 +49,26 @@
|
||||
)
|
||||
|
||||
(func $ENV_SET (param $env i32 $key i32 $value i32) (result i32)
|
||||
(local $data i32)
|
||||
(set_local $data ($MEM_VAL0_ptr $env))
|
||||
(LET $data ($MEM_VAL0_ptr $env))
|
||||
(i32.store ($VAL0_ptr $env) ($IDX ($ASSOC1 $data $key $value)))
|
||||
$value
|
||||
)
|
||||
|
||||
(func $ENV_SET_S (param $env i32 $key i32 $value i32) (result i32)
|
||||
(local $data i32)
|
||||
(set_local $data ($MEM_VAL0_ptr $env))
|
||||
(LET $data ($MEM_VAL0_ptr $env))
|
||||
(i32.store ($VAL0_ptr $env) ($IDX ($ASSOC1_S $data $key $value)))
|
||||
$value
|
||||
)
|
||||
|
||||
(func $ENV_FIND (param $env i32 $key i32) (result i64)
|
||||
(local $res i32 $data i32 $found_res i64)
|
||||
|
||||
(set_local $res 0)
|
||||
(local $found_res i64)
|
||||
(LET $res 0
|
||||
$data 0)
|
||||
|
||||
(block $done
|
||||
(loop $loop
|
||||
(set_local $data ($MEM_VAL0_ptr $env))
|
||||
(set_local $found_res ($HASHMAP_GET $data
|
||||
$key))
|
||||
(set_local $found_res ($HASHMAP_GET $data $key))
|
||||
;;; if (found)
|
||||
(if (i32.wrap/i64 (i64.shr_u $found_res (i64.const 32)))
|
||||
(then
|
||||
@ -95,8 +90,8 @@
|
||||
)
|
||||
|
||||
(func $ENV_GET (param $env i32 $key i32) (result i32)
|
||||
(local $res i32 $res_env i64)
|
||||
(set_local $res 0)
|
||||
(local $res_env i64)
|
||||
(LET $res 0)
|
||||
|
||||
(set_local $res_env ($ENV_FIND $env $key))
|
||||
(set_local $env (i32.wrap/i64 $res_env))
|
||||
|
||||
21
wasm/mem.wam
21
wasm/mem.wam
@ -98,8 +98,7 @@
|
||||
(else 3)))))
|
||||
|
||||
(func $MalVal_size (param $mv i32) (result i32)
|
||||
(local $type i32)
|
||||
(set_local $type ($TYPE $mv))
|
||||
(LET $type ($TYPE $mv))
|
||||
;; if (type == FREE_T)
|
||||
(if i32 (i32.eq $type (get_global $FREE_T))
|
||||
(then
|
||||
@ -113,7 +112,7 @@
|
||||
;; init_memory
|
||||
|
||||
(func $init_memory
|
||||
(local $heap_size i32)
|
||||
(LET $heap_size 0)
|
||||
|
||||
;; ($print ">>> init_memory\n")
|
||||
|
||||
@ -170,10 +169,9 @@
|
||||
|
||||
(func $ALLOC_INTERNAL (param $type i32
|
||||
$val1 i32 $val2 i32 $val3 i32) (result i32)
|
||||
(local $prev i32 $res i32 $size i32)
|
||||
(set_local $prev (get_global $mem_free_list))
|
||||
(set_local $res (get_global $mem_free_list))
|
||||
(set_local $size ($MalType_size $type))
|
||||
(LET $prev (get_global $mem_free_list)
|
||||
$res (get_global $mem_free_list)
|
||||
$size ($MalType_size $type))
|
||||
|
||||
(block $loop_done
|
||||
(loop $loop
|
||||
@ -267,7 +265,7 @@
|
||||
)
|
||||
|
||||
(func $RELEASE (param $mv i32)
|
||||
(local $idx i32 $type i32 $size i32)
|
||||
(LET $idx 0 $type 0 $size 0)
|
||||
|
||||
;; Ignore NULLs
|
||||
;;; if (mv == NULL) { return; }
|
||||
@ -373,8 +371,7 @@
|
||||
|
||||
;; find string in string memory or 0 if not found
|
||||
(func $FIND_STRING (param $str i32) (result i32)
|
||||
(local $ms i32)
|
||||
(set_local $ms (get_global $string_mem))
|
||||
(LET $ms (get_global $string_mem))
|
||||
(block $done
|
||||
(loop $loop
|
||||
(br_if $done (i32.ge_s $ms (get_global $string_mem_next)))
|
||||
@ -392,7 +389,7 @@
|
||||
;; 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)
|
||||
(local $ms i32)
|
||||
(LET $ms 0)
|
||||
|
||||
;; search for matching string in string_mem
|
||||
(if $intern
|
||||
@ -420,7 +417,7 @@
|
||||
)
|
||||
|
||||
(func $RELEASE_STRING (param $ms i32)
|
||||
(local $size i32 $next i32 $ms_idx i32 $idx i32 $type i32 $mv 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
|
||||
|
||||
@ -37,10 +37,9 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(func $readline (param $prompt i32 $buf i32) (result i32)
|
||||
(local $line i32 $len i32)
|
||||
(set_local $len 0)
|
||||
(LET $line ($lib_readline $prompt)
|
||||
$len 0)
|
||||
|
||||
(set_local $line ($lib_readline $prompt))
|
||||
(if $line
|
||||
(then
|
||||
($lib_add_history $line)
|
||||
@ -55,10 +54,11 @@
|
||||
|
||||
;; Returns malloc'd string. Must be free by caller
|
||||
(func $read_file (param $path i32 $buf i32) (result i32)
|
||||
(local $fst i32 $fd i32 $st_size i32 $sz i32)
|
||||
(set_local $fst (STATIC_ARRAY 100)) ;; at least STAT_SIZE
|
||||
(LET $fst (STATIC_ARRAY 100) ;; at least STAT_SIZE
|
||||
$fd ($lib_open $path (get_global $O_RDONLY) 0)
|
||||
$st_size 0
|
||||
$sz 0)
|
||||
|
||||
(set_local $fd ($lib_open $path (get_global $O_RDONLY) 0))
|
||||
(if (i32.lt_s $fd 0)
|
||||
(then
|
||||
($printf_1 "ERROR: slurp failed to open '%s'\n" $path)
|
||||
@ -83,8 +83,10 @@
|
||||
|
||||
|
||||
(func $get_time_ms (result i32)
|
||||
(local $tv i32 $secs i32 $usecs i32 $msecs i32)
|
||||
(set_local $tv (STATIC_ARRAY 10)) ;; at least TIMEVAL_SIZE
|
||||
(LET $tv (STATIC_ARRAY 10) ;; at least TIMEVAL_SIZE
|
||||
$secs 0
|
||||
$usecs 0
|
||||
$msecs 0)
|
||||
(drop ($lib_gettimeofday $tv 0))
|
||||
(set_local $secs (i32.load (i32.add $tv (get_global $TV_SEC_OFFSET))))
|
||||
;; subtract 30 years to make sure secs is positive and can be
|
||||
|
||||
@ -25,10 +25,8 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(func $readline (param $prompt i32 $buf i32) (result i32)
|
||||
(local $res i32)
|
||||
|
||||
;; TODO: don't hardcode count to 200
|
||||
(set_local $res ($lib_readline $prompt $buf 200))
|
||||
(LET $res ($lib_readline $prompt $buf 200))
|
||||
(if $res
|
||||
($lib_add_history $buf))
|
||||
$res
|
||||
@ -37,8 +35,7 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(func $read_file (param $path i32 $buf i32) (result i32)
|
||||
(local $size i32)
|
||||
(set_local $size ($lib_read_file $path $buf))
|
||||
(LET $size ($lib_read_file $path $buf))
|
||||
;; Add null to string
|
||||
(i32.store8_u (i32.add $buf $size) 0)
|
||||
(i32.add $size 1)
|
||||
|
||||
@ -3,9 +3,9 @@
|
||||
(global $printer_buf (mut i32) 0)
|
||||
|
||||
(func $pr_str_val (param $res i32 $mv i32 $print_readably i32) (result i32)
|
||||
(local $type i32 $val0 i32 $sval i32)
|
||||
(set_local $type ($TYPE $mv))
|
||||
(set_local $val0 ($VAL0 $mv))
|
||||
(LET $type ($TYPE $mv)
|
||||
$val0 ($VAL0 $mv)
|
||||
$sval 0)
|
||||
|
||||
;;; switch(type)
|
||||
(block $done
|
||||
@ -70,8 +70,7 @@
|
||||
;;; while (VAL0(mv) != 0)
|
||||
(block $done_seq
|
||||
(loop $seq_loop
|
||||
(if (i32.eq ($VAL0 $mv) 0)
|
||||
(br $done_seq))
|
||||
(br_if $done_seq (i32.eq ($VAL0 $mv) 0))
|
||||
;;; res = pr_str_val(res, MEM_VAL1(mv), print_readably)
|
||||
(set_local $res ($pr_str_val $res ($MEM_VAL1_ptr $mv) $print_readably))
|
||||
|
||||
@ -147,9 +146,8 @@
|
||||
|
||||
(func $pr_str_internal (param $seq i32) (param $mv i32)
|
||||
(param $print_readably i32) (param $sep i32) (result i32)
|
||||
(local $res i32 $res_str i32)
|
||||
(set_local $res ($STRING_INIT (get_global $STRING_T)))
|
||||
(set_local $res_str ($to_String $res))
|
||||
(LET $res ($STRING_INIT (get_global $STRING_T))
|
||||
$res_str ($to_String $res))
|
||||
|
||||
(if $seq
|
||||
(then
|
||||
|
||||
@ -49,18 +49,16 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(func $_sprintdigit (param $str i32) (param $num i32) (param $base i32)
|
||||
(local $n i32 $ch i32)
|
||||
(set_local $n (i32.rem_u $num $base))
|
||||
(set_local $ch (if (result i32) (i32.lt_u $n 10) 48 55))
|
||||
(LET $n (i32.rem_u $num $base)
|
||||
$ch (if (result i32) (i32.lt_u $n 10) 48 55))
|
||||
(i32.store8_u $str (i32.add $n $ch))
|
||||
)
|
||||
|
||||
;; TODO: add max buf length (i.e. snprintnum)
|
||||
(func $_sprintnum (param $buf i32) (param $val i32) (param $radix i32)
|
||||
(param $pad_cnt i32) (param $pad_char i32) (result i32)
|
||||
(local $pbuf i32 $i i32 $j i32 $k i32 $len i32 $neg i32 $digit i32)
|
||||
(set_local $pbuf $buf)
|
||||
(set_local $neg 0)
|
||||
(LET $pbuf $buf
|
||||
$neg 0 $i 0 $j 0 $k 0 $len 0 $digit 0)
|
||||
|
||||
(if (AND (i32.lt_s $val 0) (i32.eq $radix 10))
|
||||
(then
|
||||
@ -75,13 +73,13 @@
|
||||
(i32.sub_u (i32.add (CHR "A") $digit) 10)))
|
||||
(set_local $pbuf (i32.add $pbuf 1))
|
||||
(set_local $val (i32.div_u $val $radix))
|
||||
(if (i32.gt_u $val 0) (br $loop))
|
||||
(br_if $loop (i32.gt_u $val 0))
|
||||
)
|
||||
|
||||
(set_local $i (i32.sub_u $pbuf $buf))
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.ge_u $i $pad_cnt) (br $done))
|
||||
(br_if $done (i32.ge_u $i $pad_cnt))
|
||||
(i32.store8_u $pbuf $pad_char)
|
||||
(set_local $pbuf (i32.add $pbuf 1))
|
||||
(set_local $i (i32.add $i 1))
|
||||
@ -101,8 +99,7 @@
|
||||
(set_local $i 0)
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.ge_u $i (i32.div_u $len 2))
|
||||
(br $done))
|
||||
(br_if $done (i32.ge_u $i (i32.div_u $len 2)))
|
||||
|
||||
(set_local $j (i32.load8_u (i32.add $buf $i)))
|
||||
(set_local $k (i32.add $buf (i32.sub_u (i32.sub_u $len $i) 1)))
|
||||
@ -126,10 +123,8 @@
|
||||
(param $v0 i32) (param $v1 i32) (param $v2 i32)
|
||||
(param $v3 i32) (param $v4 i32) (param $v5 i32)
|
||||
(result i32)
|
||||
(local $ch i32 $pstr i32 $v i32 $vidx i32 $len i32)
|
||||
(local $pad_cnt i32 $pad_char i32)
|
||||
(set_local $pstr $str)
|
||||
(set_local $vidx 0)
|
||||
(LET $pstr $str
|
||||
$vidx 0 $ch 0 $v 0 $len 0 $pad_cnt 0 $pad_char 0)
|
||||
|
||||
(block $done
|
||||
(loop $loop
|
||||
@ -148,7 +143,7 @@
|
||||
;;; while ((ch=*(fmt++)))
|
||||
(set_local $ch (i32.load8_u $fmt))
|
||||
(set_local $fmt (i32.add 1 $fmt))
|
||||
(if (i32.eqz $ch) (br $done))
|
||||
(br_if $done (i32.eqz $ch))
|
||||
;; TODO: check buffer length
|
||||
|
||||
(if (i32.ne $ch (CHR "%"))
|
||||
@ -161,7 +156,7 @@
|
||||
;;; ch=*(fmt++)
|
||||
(set_local $ch (i32.load8_u $fmt))
|
||||
(set_local $fmt (i32.add 1 $fmt))
|
||||
(if (i32.eqz $ch) (br $done))
|
||||
(br_if $done (i32.eqz $ch))
|
||||
|
||||
(set_local $pad_cnt 0)
|
||||
(set_local $pad_char (CHR " "))
|
||||
@ -175,15 +170,15 @@
|
||||
;;; ch=*(fmt++)
|
||||
(set_local $ch (i32.load8_u $fmt))
|
||||
(set_local $fmt (i32.add 1 $fmt))
|
||||
(if (i32.eqz $ch) (br $done))))
|
||||
(br_if $done (i32.eqz $ch))))
|
||||
(loop $loop
|
||||
(set_local $pad_cnt (i32.mul_s $pad_cnt 10))
|
||||
(set_local $pad_cnt (i32.add $pad_cnt
|
||||
(i32.sub_s $ch (CHR "0"))))
|
||||
(set_local $ch (i32.load8_u $fmt))
|
||||
(set_local $fmt (i32.add 1 $fmt))
|
||||
(if (AND (i32.ge_s $ch (CHR "0")) (i32.le_s $ch (CHR "9")))
|
||||
(br $loop))
|
||||
(br_if $loop (AND (i32.ge_s $ch (CHR "0"))
|
||||
(i32.le_s $ch (CHR "9"))))
|
||||
)))
|
||||
|
||||
(if (i32.eq (CHR "d") $ch)
|
||||
@ -197,8 +192,7 @@
|
||||
(set_local $len ($strlen $v))
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.le_s $pad_cnt $len)
|
||||
(br $done))
|
||||
(br_if $done (i32.le_s $pad_cnt $len))
|
||||
(i32.store8_u $pstr (CHR " "))
|
||||
(set_local $pstr (i32.add $pstr 1))
|
||||
(set_local $pad_cnt (i32.sub_s $pad_cnt 1))
|
||||
|
||||
@ -5,16 +5,14 @@
|
||||
(global $read_index (mut i32) 0)
|
||||
|
||||
(func $skip_spaces (param $str i32) (result i32)
|
||||
(local $found i32 $c i32)
|
||||
(set_local $found 0)
|
||||
(set_local $c (i32.load8_u (i32.add $str (get_global $read_index))))
|
||||
(LET $found 0
|
||||
$c (i32.load8_u (i32.add $str (get_global $read_index))))
|
||||
(block $done
|
||||
(loop $loop
|
||||
;;; while (c == ' ' || c == ',' || c == '\n')
|
||||
(if (AND (i32.ne $c (CHR " "))
|
||||
(i32.ne $c (CHR ","))
|
||||
(i32.ne $c (CHR "\n")))
|
||||
(br $done))
|
||||
(br_if $done (AND (i32.ne $c (CHR " "))
|
||||
(i32.ne $c (CHR ","))
|
||||
(i32.ne $c (CHR "\n"))))
|
||||
(set_local $found 1)
|
||||
;;; c=str[++(*index)]
|
||||
(set_global $read_index (i32.add (get_global $read_index) 1))
|
||||
@ -27,9 +25,8 @@
|
||||
)
|
||||
|
||||
(func $skip_to_eol (param $str i32) (result i32)
|
||||
(local $found i32 $c i32)
|
||||
(set_local $found 0)
|
||||
(set_local $c (i32.load8_c (i32.add $str (get_global $read_index))))
|
||||
(LET $found 0
|
||||
$c (i32.load8_c (i32.add $str (get_global $read_index))))
|
||||
(if (i32.eq $c (CHR ";"))
|
||||
(then
|
||||
(set_local $found 1)
|
||||
@ -40,9 +37,8 @@
|
||||
(set_local $c (i32.load8_u (i32.add $str
|
||||
(get_global $read_index))))
|
||||
;;; while (c != '\0' && c != '\n')
|
||||
(if (AND (i32.ne $c (CHR "\x00"))
|
||||
(i32.ne $c (CHR "\n")))
|
||||
(br $loop))
|
||||
(br_if $loop (AND (i32.ne $c (CHR "\x00"))
|
||||
(i32.ne $c (CHR "\n"))))
|
||||
)
|
||||
)))
|
||||
;; ($debug ">>> skip_to_eol:" $found)
|
||||
@ -52,17 +48,17 @@
|
||||
(func $skip_spaces_comments (param $str i32)
|
||||
(loop $loop
|
||||
;; skip spaces
|
||||
(if ($skip_spaces $str) (br $loop))
|
||||
(br_if $loop ($skip_spaces $str))
|
||||
;; skip comments
|
||||
(if ($skip_to_eol $str) (br $loop))
|
||||
(br_if $loop ($skip_to_eol $str))
|
||||
)
|
||||
)
|
||||
|
||||
(func $read_token (param $str i32) (result i32)
|
||||
(local $token_index i32 $instring i32 $escaped i32 $c i32)
|
||||
(set_local $token_index 0)
|
||||
(set_local $instring 0)
|
||||
(set_local $escaped 0)
|
||||
(LET $token_index 0
|
||||
$instring 0
|
||||
$escaped 0
|
||||
$c 0)
|
||||
|
||||
($skip_spaces_comments $str)
|
||||
|
||||
@ -101,21 +97,20 @@
|
||||
(set_local $c (i32.load8_u
|
||||
(i32.add $str (get_global $read_index))))
|
||||
;;; if (c == '\0') break
|
||||
(if (i32.eq $c 0) (br $done))
|
||||
(br_if $done (i32.eq $c 0))
|
||||
;;; if (!instring)
|
||||
(if (i32.eqz $instring)
|
||||
(then
|
||||
;; next character is token delimiter
|
||||
(if (OR (i32.eq $c (CHR "("))
|
||||
(i32.eq $c (CHR ")"))
|
||||
(i32.eq $c (CHR "["))
|
||||
(i32.eq $c (CHR "]"))
|
||||
(i32.eq $c (CHR "{"))
|
||||
(i32.eq $c (CHR "}"))
|
||||
(i32.eq $c (CHR " "))
|
||||
(i32.eq $c (CHR ","))
|
||||
(i32.eq $c (CHR "\n")))
|
||||
(br $done))))
|
||||
(br_if $done (OR (i32.eq $c (CHR "("))
|
||||
(i32.eq $c (CHR ")"))
|
||||
(i32.eq $c (CHR "["))
|
||||
(i32.eq $c (CHR "]"))
|
||||
(i32.eq $c (CHR "{"))
|
||||
(i32.eq $c (CHR "}"))
|
||||
(i32.eq $c (CHR " "))
|
||||
(i32.eq $c (CHR ","))
|
||||
(i32.eq $c (CHR "\n"))))))
|
||||
;; read next character
|
||||
;;; token[token_index++] = str[(*index)++]
|
||||
(i32.store8_u (i32.add (get_global $token_buf) $token_index)
|
||||
@ -124,11 +119,12 @@
|
||||
(set_local $token_index (i32.add $token_index 1))
|
||||
(set_global $read_index (i32.add (get_global $read_index) 1))
|
||||
;;; if (token[0] == '~' && token[1] == '@') break
|
||||
(if (AND (i32.eq (i32.load8_u (i32.add (get_global $token_buf) 0))
|
||||
(CHR "~"))
|
||||
(i32.eq (i32.load8_u (i32.add (get_global $token_buf) 1))
|
||||
(CHR "@")))
|
||||
(br $done))
|
||||
(br_if $done (AND (i32.eq (i32.load8_u
|
||||
(i32.add (get_global $token_buf) 0))
|
||||
(CHR "~"))
|
||||
(i32.eq (i32.load8_u
|
||||
(i32.add (get_global $token_buf) 1))
|
||||
(CHR "@"))))
|
||||
|
||||
;;; if ((!instring) || escaped)
|
||||
(if (OR (i32.eqz $instring) $escaped)
|
||||
@ -137,8 +133,7 @@
|
||||
(br $loop)))
|
||||
(if (i32.eq $c (CHR "\\"))
|
||||
(set_local $escaped 1))
|
||||
(if (i32.eq $c (CHR "\""))
|
||||
(br $done))
|
||||
(br_if $done (i32.eq $c (CHR "\"")))
|
||||
(br $loop)
|
||||
)
|
||||
)))
|
||||
@ -149,18 +144,14 @@
|
||||
)
|
||||
|
||||
(func $read_seq (param $str i32 $type i32 $end i32) (result i32)
|
||||
(local $res i32 $val2 i32 $val3 i32 $c i32)
|
||||
|
||||
;; MAP_LOOP stack
|
||||
(local $ret i32 $empty i32 $current i32)
|
||||
|
||||
;; MAP_LOOP_START
|
||||
(set_local $res ($MAP_LOOP_START $type))
|
||||
;; push MAP_LOOP stack
|
||||
;;; empty = current = ret = res
|
||||
(set_local $ret $res)
|
||||
(set_local $current $res)
|
||||
(set_local $empty $res)
|
||||
(LET $res ($MAP_LOOP_START $type)
|
||||
$val2 0
|
||||
$val3 0
|
||||
$c 0
|
||||
;; MAP_LOOP stack
|
||||
$ret $res
|
||||
$empty $res
|
||||
$current $res)
|
||||
|
||||
;; READ_SEQ_LOOP
|
||||
(block $done
|
||||
@ -213,10 +204,10 @@
|
||||
)
|
||||
|
||||
(func $read_macro (param $str i32 $sym i32 $with_meta i32) (result i32)
|
||||
(local $first i32 $second i32 $third i32 $res i32)
|
||||
(set_local $first ($STRING (get_global $SYMBOL_T) $sym))
|
||||
(set_local $second ($read_form $str))
|
||||
(set_local $res $second)
|
||||
(LET $first ($STRING (get_global $SYMBOL_T) $sym)
|
||||
$second ($read_form $str)
|
||||
$third 0
|
||||
$res $second)
|
||||
(if (get_global $error_type) (return $res))
|
||||
(if (i32.eqz $with_meta)
|
||||
(then
|
||||
@ -233,7 +224,7 @@
|
||||
)
|
||||
|
||||
(func $read_form (param $str i32) (result i32)
|
||||
(local $tok i32 $c0 i32 $c1 i32 $res i32 $slen i32)
|
||||
(LET $tok 0 $c0 0 $c1 0 $res 0 $slen 0)
|
||||
|
||||
(if (get_global $error_type) (return 0))
|
||||
|
||||
|
||||
@ -21,8 +21,7 @@
|
||||
|
||||
(func $main (result i32)
|
||||
;; Constant location/value definitions
|
||||
(local $line i32)
|
||||
(set_local $line (STATIC_ARRAY 201))
|
||||
(LET $line (STATIC_ARRAY 201))
|
||||
|
||||
;; DEBUG
|
||||
($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
|
||||
@ -32,7 +31,6 @@
|
||||
(loop $repl_loop
|
||||
(br_if $repl_done (i32.eqz ($readline "user> " $line)))
|
||||
(br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
|
||||
;;($printf_1 "here1 %d\n", 7);
|
||||
($printf_1 "%s\n" ($rep $line))
|
||||
(br $repl_loop)
|
||||
)
|
||||
|
||||
@ -17,17 +17,16 @@
|
||||
|
||||
;; REPL
|
||||
(func $REP (param $line i32 $env i32) (result i32)
|
||||
(local $mv1 i32 $mv2 i32 $ms i32)
|
||||
(block $rep_done
|
||||
(LET $mv1 0 $mv2 0 $ms 0)
|
||||
(block $done
|
||||
(set_local $mv1 ($READ $line))
|
||||
(br_if $rep_done (get_global $error_type))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
(set_local $mv2 ($EVAL $mv1 $env))
|
||||
(br_if $rep_done (get_global $error_type))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; ($PR_MEMORY -1 -1)
|
||||
(set_local $ms ($PRINT $mv2))
|
||||
|
||||
)
|
||||
|
||||
;; release memory from MAL_READ
|
||||
@ -36,21 +35,25 @@
|
||||
)
|
||||
|
||||
(func $main (result i32)
|
||||
(local $line i32 $res i32)
|
||||
(set_local $line (STATIC_ARRAY 201))
|
||||
(LET $line (STATIC_ARRAY 201)
|
||||
$res 0)
|
||||
|
||||
;; DEBUG
|
||||
($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
|
||||
($printf_1 "heap_start: 0x%x\n" (get_global $heap_start))
|
||||
($printf_1 "heap_end: 0x%x\n" (get_global $heap_end))
|
||||
($printf_1 "mem: 0x%x\n" (get_global $mem))
|
||||
;; ($printf_1 "argc: 0x%x\n" $argc)
|
||||
;; ($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
|
||||
;; ($printf_1 "heap_start: 0x%x\n" (get_global $heap_start))
|
||||
;; ($printf_1 "heap_end: 0x%x\n" (get_global $heap_end))
|
||||
;; ($printf_1 "mem: 0x%x\n" (get_global $mem))
|
||||
;; ($printf_1 "string_mem: %d\n" (get_global $string_mem))
|
||||
|
||||
;; ($PR_MEMORY_RAW
|
||||
;; (get_global $mem) (i32.add (get_global $mem)
|
||||
;; (i32.mul_u (get_global $mem_unused_start) 4)))
|
||||
|
||||
($PR_MEMORY -1 -1)
|
||||
(drop ($STRING (get_global $STRING_T) "uvw"))
|
||||
(drop ($STRING (get_global $STRING_T) "xyz"))
|
||||
|
||||
;;($PR_MEMORY -1 -1)
|
||||
|
||||
;; Start REPL
|
||||
(block $repl_done
|
||||
|
||||
@ -9,9 +9,9 @@
|
||||
|
||||
;; EVAL
|
||||
(func $EVAL_AST (param $ast i32 $env i32) (result i32)
|
||||
(local $res i32 $val2 i32 $val3 i32 $type i32 $found i32)
|
||||
(local $ret i32 $empty i32 $current i32)
|
||||
(local $res2 i64)
|
||||
(LET $res 0 $val2 0 $val3 0 $type 0 $found 0
|
||||
$ret 0 $empty 0 $current 0)
|
||||
|
||||
(if (get_global $error_type) (return 0))
|
||||
(set_local $type ($TYPE $ast))
|
||||
@ -46,7 +46,7 @@
|
||||
(block $done
|
||||
(loop $loop
|
||||
;; check if we are done evaluating the source sequence
|
||||
(if (i32.eq ($VAL0 $ast) 0) (br $done))
|
||||
(br_if $done (i32.eq ($VAL0 $ast) 0))
|
||||
|
||||
(if (i32.eq $type (get_global $HASHMAP_T))
|
||||
(then
|
||||
@ -101,42 +101,41 @@
|
||||
$add $subtract $multiply $divide))
|
||||
|
||||
(func $EVAL (param $ast i32 $env i32) (result i32)
|
||||
(local $res i32)
|
||||
(local $type i32 $ftype i32 $f_args i32 $f i32 $args i32)
|
||||
(LET $res 0
|
||||
$ftype 0 $f_args 0 $f 0 $args 0)
|
||||
|
||||
(set_local $res 0)
|
||||
(set_local $f_args 0)
|
||||
(set_local $f 0)
|
||||
(set_local $args 0)
|
||||
(set_local $type ($TYPE $ast))
|
||||
|
||||
(if (get_global $error_type) (return 0))
|
||||
|
||||
;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
|
||||
|
||||
(if (i32.ne $type (get_global $LIST_T)) (return ($EVAL_AST $ast $env)))
|
||||
(if (i32.ne ($TYPE $ast) (get_global $LIST_T))
|
||||
(return ($EVAL_AST $ast $env)))
|
||||
|
||||
;; APPLY_LIST
|
||||
(if ($EMPTY_Q $ast) (return ($INC_REF $ast)))
|
||||
(if ($EMPTY_Q $ast)
|
||||
(return ($INC_REF $ast)))
|
||||
|
||||
;; EVAL_INVOKE
|
||||
(set_local $res ($EVAL_AST $ast $env))
|
||||
(set_local $f_args $res)
|
||||
|
||||
;; if error, return f/args for release by caller
|
||||
(if (get_global $error_type) (return $f_args))
|
||||
(if (get_global $error_type)
|
||||
(return $f_args))
|
||||
|
||||
;; rest
|
||||
(set_local $args ($MEM_VAL0_ptr $f_args))
|
||||
;; value
|
||||
(set_local $f ($MEM_VAL1_ptr $f_args))
|
||||
(set_local $args ($MEM_VAL0_ptr $f_args)) ;; rest
|
||||
(set_local $f ($MEM_VAL1_ptr $f_args)) ;; value
|
||||
|
||||
(set_local $ftype ($TYPE $f))
|
||||
(if (i32.eq $ftype (get_global $FUNCTION_T))
|
||||
(then
|
||||
(set_local $res (call_indirect (type $fnT) $args ($VAL0 $f))))
|
||||
(else
|
||||
($THROW_STR_1 "apply of non-function type: %d\n" $type)
|
||||
($THROW_STR_1 "apply of non-function type: %d\n" $ftype)
|
||||
(set_local $res 0)))
|
||||
|
||||
($RELEASE $f_args)
|
||||
@ -151,13 +150,13 @@
|
||||
|
||||
;; REPL
|
||||
(func $REP (param $line i32 $env i32) (result i32)
|
||||
(local $mv1 i32 $mv2 i32 $ms i32)
|
||||
(block $rep_done
|
||||
(LET $mv1 0 $mv2 0 $ms 0)
|
||||
(block $done
|
||||
(set_local $mv1 ($READ $line))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
(set_local $mv2 ($EVAL $mv1 $env))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; ($PR_MEMORY -1 -1)
|
||||
(set_local $ms ($PRINT $mv2))
|
||||
@ -187,14 +186,15 @@
|
||||
($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
|
||||
|
||||
(func $main (result i32)
|
||||
(local $line i32 $res i32 $repl_env i32)
|
||||
(set_local $line (STATIC_ARRAY 201))
|
||||
(LET $line (STATIC_ARRAY 201)
|
||||
$res 0 $repl_env 0)
|
||||
|
||||
;; DEBUG
|
||||
($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
|
||||
($printf_1 "heap_start: 0x%x\n" (get_global $heap_start))
|
||||
($printf_1 "heap_end: 0x%x\n" (get_global $heap_end))
|
||||
($printf_1 "mem: 0x%x\n" (get_global $mem))
|
||||
;; ($printf_1 "argc: 0x%x\n" $argc)
|
||||
;; ($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
|
||||
;; ($printf_1 "heap_start: 0x%x\n" (get_global $heap_start))
|
||||
;; ($printf_1 "heap_end: 0x%x\n" (get_global $heap_end))
|
||||
;; ($printf_1 "mem: 0x%x\n" (get_global $mem))
|
||||
;; ($printf_1 "string_mem: %d\n" (get_global $string_mem))
|
||||
|
||||
(set_global $repl_env ($HASHMAP))
|
||||
|
||||
@ -9,8 +9,8 @@
|
||||
|
||||
;; EVAL
|
||||
(func $EVAL_AST (param $ast i32 $env i32) (result i32)
|
||||
(local $res i32 $val2 i32 $val3 i32 $type i32 $found i32)
|
||||
(local $ret i32 $empty i32 $current i32)
|
||||
(LET $res 0 $val2 0 $val3 0 $type 0 $found 0
|
||||
$ret 0 $empty 0 $current 0)
|
||||
|
||||
(if (get_global $error_type) (return 0))
|
||||
(set_local $type ($TYPE $ast))
|
||||
@ -37,7 +37,7 @@
|
||||
(block $done
|
||||
(loop $loop
|
||||
;; check if we are done evaluating the source sequence
|
||||
(if (i32.eq ($VAL0 $ast) 0) (br $done))
|
||||
(br_if $done (i32.eq ($VAL0 $ast) 0))
|
||||
|
||||
(if (i32.eq $type (get_global $HASHMAP_T))
|
||||
(then
|
||||
@ -99,12 +99,11 @@
|
||||
($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))))
|
||||
|
||||
(func $EVAL (param $ast i32 $env i32) (result i32)
|
||||
(local $res i32)
|
||||
(local $ftype i32 $f_args i32 $f i32 $args i32)
|
||||
(local $a0 i32 $a0sym i32 $a1 i32 $a2 i32)
|
||||
(local $let_env i32)
|
||||
(LET $res 0
|
||||
$ftype 0 $f_args 0 $f 0 $args 0
|
||||
$a0 0 $a0sym 0 $a1 0 $a2 0
|
||||
$let_env 0)
|
||||
|
||||
(set_local $res 0)
|
||||
(set_local $f_args 0)
|
||||
(set_local $f 0)
|
||||
(set_local $args 0)
|
||||
@ -117,7 +116,8 @@
|
||||
(return ($EVAL_AST $ast $env)))
|
||||
|
||||
;; APPLY_LIST
|
||||
(if ($EMPTY_Q $ast) (return ($INC_REF $ast)))
|
||||
(if ($EMPTY_Q $ast)
|
||||
(return ($INC_REF $ast)))
|
||||
|
||||
(set_local $a0 ($MEM_VAL1_ptr $ast))
|
||||
(set_local $a0sym "")
|
||||
@ -143,13 +143,12 @@
|
||||
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.eqz ($VAL0 $a1))
|
||||
(br $done))
|
||||
(br_if $done (i32.eqz ($VAL0 $a1)))
|
||||
;; eval current A1 odd element
|
||||
(set_local $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1))
|
||||
$let_env))
|
||||
|
||||
(if (get_global $error_type) (br $done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; set key/value in the let environment
|
||||
(set_local $res ($ENV_SET $let_env ($MEM_VAL1_ptr $a1) $res))
|
||||
@ -170,12 +169,11 @@
|
||||
(set_local $f_args $res)
|
||||
|
||||
;; if error, return f/args for release by caller
|
||||
(if (get_global $error_type) (return $f_args))
|
||||
(if (get_global $error_type)
|
||||
(return $f_args))
|
||||
|
||||
;; rest
|
||||
(set_local $args ($MEM_VAL0_ptr $f_args))
|
||||
;; value
|
||||
(set_local $f ($MEM_VAL1_ptr $f_args))
|
||||
(set_local $args ($MEM_VAL0_ptr $f_args)) ;; rest
|
||||
(set_local $f ($MEM_VAL1_ptr $f_args)) ;; value
|
||||
|
||||
(set_local $ftype ($TYPE $f))
|
||||
(if (i32.eq $ftype (get_global $FUNCTION_T))
|
||||
@ -197,13 +195,13 @@
|
||||
|
||||
;; REPL
|
||||
(func $REP (param $line i32 $env i32) (result i32)
|
||||
(local $mv1 i32 $mv2 i32 $ms i32)
|
||||
(block $rep_done
|
||||
(LET $mv1 0 $mv2 0 $ms 0)
|
||||
(block $done
|
||||
(set_local $mv1 ($READ $line))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
(set_local $mv2 ($EVAL $mv1 $env))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; ($PR_MEMORY -1 -1)
|
||||
(set_local $ms ($PRINT $mv2))
|
||||
@ -236,14 +234,15 @@
|
||||
($INC_REF (get_global $NIL)))
|
||||
|
||||
(func $main (result i32)
|
||||
(local $line i32 $res i32 $repl_env i32)
|
||||
(set_local $line (STATIC_ARRAY 201))
|
||||
(LET $line (STATIC_ARRAY 201)
|
||||
$res 0 $repl_env 0)
|
||||
|
||||
;; DEBUG
|
||||
($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
|
||||
($printf_1 "heap_start: 0x%x\n" (get_global $heap_start))
|
||||
($printf_1 "heap_end: 0x%x\n" (get_global $heap_end))
|
||||
($printf_1 "mem: 0x%x\n" (get_global $mem))
|
||||
;; ($printf_1 "argc: 0x%x\n" $argc)
|
||||
;; ($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
|
||||
;; ($printf_1 "heap_start: 0x%x\n" (get_global $heap_start))
|
||||
;; ($printf_1 "heap_end: 0x%x\n" (get_global $heap_end))
|
||||
;; ($printf_1 "mem: 0x%x\n" (get_global $mem))
|
||||
;; ($printf_1 "string_mem: %d\n" (get_global $string_mem))
|
||||
|
||||
(set_global $repl_env ($ENV_NEW (get_global $NIL)))
|
||||
|
||||
@ -9,8 +9,8 @@
|
||||
|
||||
;; EVAL
|
||||
(func $EVAL_AST (param $ast i32 $env i32) (result i32)
|
||||
(local $res i32 $val2 i32 $val3 i32 $type i32 $found i32)
|
||||
(local $ret i32 $empty i32 $current i32)
|
||||
(LET $res 0 $val2 0 $val3 0 $type 0 $found 0
|
||||
$ret 0 $empty 0 $current 0)
|
||||
|
||||
(if (get_global $error_type) (return 0))
|
||||
(set_local $type ($TYPE $ast))
|
||||
@ -37,7 +37,7 @@
|
||||
(block $done
|
||||
(loop $loop
|
||||
;; check if we are done evaluating the source sequence
|
||||
(if (i32.eq ($VAL0 $ast) 0) (br $done))
|
||||
(br_if $done (i32.eq ($VAL0 $ast) 0))
|
||||
|
||||
(if (i32.eq $type (get_global $HASHMAP_T))
|
||||
(then
|
||||
@ -93,12 +93,11 @@
|
||||
($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))))
|
||||
|
||||
(func $EVAL (param $ast i32 $env i32) (result i32)
|
||||
(local $res i32 $el i32)
|
||||
(local $ftype i32 $f_args i32 $f i32 $args i32)
|
||||
(local $a0 i32 $a0sym i32 $a1 i32 $a2 i32 $a3 i32)
|
||||
(local $let_env i32 $fn_env i32 $a i32)
|
||||
(LET $res 0 $el 0
|
||||
$ftype 0 $f_args 0 $f 0 $args 0
|
||||
$a0 0 $a0sym 0 $a1 0 $a2 0 $a3 0
|
||||
$let_env 0 $fn_env 0 $a 0)
|
||||
|
||||
(set_local $res 0)
|
||||
(set_local $f_args 0)
|
||||
(set_local $f 0)
|
||||
(set_local $args 0)
|
||||
@ -138,13 +137,12 @@
|
||||
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.eqz ($VAL0 $a1))
|
||||
(br $done))
|
||||
(br_if $done (i32.eqz ($VAL0 $a1)))
|
||||
;; eval current A1 odd element
|
||||
(set_local $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1))
|
||||
$let_env))
|
||||
|
||||
(if (get_global $error_type) (br $done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; set key/value in the let environment
|
||||
(set_local $res ($ENV_SET $let_env ($MEM_VAL1_ptr $a1) $res))
|
||||
@ -197,12 +195,11 @@
|
||||
(set_local $f_args $res)
|
||||
|
||||
;; if error, return f/args for release by caller
|
||||
(if (get_global $error_type) (return $f_args))
|
||||
(if (get_global $error_type)
|
||||
(return $f_args))
|
||||
|
||||
;; rest
|
||||
(set_local $args ($MEM_VAL0_ptr $f_args))
|
||||
;; value
|
||||
(set_local $f ($MEM_VAL1_ptr $f_args))
|
||||
(set_local $args ($MEM_VAL0_ptr $f_args)) ;; rest
|
||||
(set_local $f ($MEM_VAL1_ptr $f_args)) ;; value
|
||||
|
||||
(set_local $ftype ($TYPE $f))
|
||||
(if (i32.eq $ftype (get_global $FUNCTION_T))
|
||||
@ -242,10 +239,10 @@
|
||||
|
||||
;; REPL
|
||||
(func $RE (param $line i32 $env i32) (result i32)
|
||||
(local $mv1 i32 $res i32)
|
||||
(block $rep_done
|
||||
(LET $mv1 0 $res 0)
|
||||
(block $done
|
||||
(set_local $mv1 ($READ $line))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
(set_local $res ($EVAL $mv1 $env))
|
||||
)
|
||||
@ -256,10 +253,10 @@
|
||||
)
|
||||
|
||||
(func $REP (param $line i32 $env i32) (result i32)
|
||||
(local $mv2 i32 $ms i32)
|
||||
(block $rep_done
|
||||
(LET $mv2 0 $ms 0)
|
||||
(block $done
|
||||
(set_local $mv2 ($RE $line $env))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; ($PR_MEMORY -1 -1)
|
||||
(set_local $ms ($PRINT $mv2))
|
||||
@ -271,14 +268,15 @@
|
||||
)
|
||||
|
||||
(func $main (result i32)
|
||||
(local $line i32 $res i32 $repl_env i32)
|
||||
(set_local $line (STATIC_ARRAY 201))
|
||||
(LET $line (STATIC_ARRAY 201)
|
||||
$res 0 $repl_env 0)
|
||||
|
||||
;; DEBUG
|
||||
($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
|
||||
($printf_1 "heap_start: 0x%x\n" (get_global $heap_start))
|
||||
($printf_1 "heap_end: 0x%x\n" (get_global $heap_end))
|
||||
($printf_1 "mem: 0x%x\n" (get_global $mem))
|
||||
;; ($printf_1 "argc: 0x%x\n" $argc)
|
||||
;; ($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
|
||||
;; ($printf_1 "heap_start: 0x%x\n" (get_global $heap_start))
|
||||
;; ($printf_1 "heap_end: 0x%x\n" (get_global $heap_end))
|
||||
;; ($printf_1 "mem: 0x%x\n" (get_global $mem))
|
||||
;; ($printf_1 "string_mem: %d\n" (get_global $string_mem))
|
||||
|
||||
(set_global $repl_env ($ENV_NEW (get_global $NIL)))
|
||||
@ -287,6 +285,8 @@
|
||||
;; core.EXT: defined in wasm
|
||||
($add_core_ns $repl_env)
|
||||
|
||||
($checkpoint_user_memory)
|
||||
|
||||
;; core.mal: defined using the language itself
|
||||
($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env))
|
||||
|
||||
|
||||
@ -9,8 +9,8 @@
|
||||
|
||||
;; EVAL
|
||||
(func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32)
|
||||
(local $res i32 $val2 i32 $val3 i32 $type i32 $found i32)
|
||||
(local $ret i32 $empty i32 $current i32)
|
||||
(LET $res 0 $val2 0 $val3 0 $type 0 $found 0
|
||||
$ret 0 $empty 0 $current 0)
|
||||
|
||||
(if (get_global $error_type) (return 0))
|
||||
(set_local $type ($TYPE $ast))
|
||||
@ -37,10 +37,10 @@
|
||||
(block $done
|
||||
(loop $loop
|
||||
;; check if we are done evaluating the source sequence
|
||||
(if (i32.eq ($VAL0 $ast) 0) (br $done))
|
||||
(br_if $done (i32.eq ($VAL0 $ast) 0))
|
||||
|
||||
(if $skiplast
|
||||
(if (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast)) 0) (br $done)))
|
||||
(br_if $done (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast)) 0)))
|
||||
|
||||
(if (i32.eq $type (get_global $HASHMAP_T))
|
||||
(then
|
||||
@ -96,15 +96,11 @@
|
||||
($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))))
|
||||
|
||||
(func $EVAL (param $orig_ast i32 $orig_env i32) (result i32)
|
||||
(local $ast i32 $env i32 $prev_ast i32 $prev_env i32 $res i32 $el i32)
|
||||
(local $type i32 $ftype i32 $f_args i32 $f i32 $args i32)
|
||||
(local $a0 i32 $a0sym i32 $a1 i32 $a2 i32)
|
||||
|
||||
(set_local $ast $orig_ast)
|
||||
(set_local $env $orig_env)
|
||||
(set_local $prev_ast 0)
|
||||
(set_local $prev_env 0)
|
||||
(set_local $res 0)
|
||||
(LET $ast $orig_ast
|
||||
$env $orig_env
|
||||
$prev_ast 0 $prev_env 0 $res 0 $el 0
|
||||
$ftype 0 $f_args 0 $f 0 $args 0
|
||||
$a0 0 $a0sym 0 $a1 0 $a2 0)
|
||||
|
||||
(block $EVAL_return
|
||||
(loop $TCO_loop
|
||||
@ -141,7 +137,7 @@
|
||||
(set_local $a1 ($MAL_GET_A1 $ast))
|
||||
(set_local $a2 ($MAL_GET_A2 $ast))
|
||||
(set_local $res ($EVAL $a2 $env))
|
||||
(if (get_global $error_type) (br $EVAL_return))
|
||||
(br_if $EVAL_return (get_global $error_type))
|
||||
|
||||
;; set a1 in env to a2
|
||||
(set_local $res ($ENV_SET $env $a1 $res))
|
||||
@ -157,12 +153,11 @@
|
||||
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.eqz ($VAL0 $a1))
|
||||
(br $done))
|
||||
(br_if $done (i32.eqz ($VAL0 $a1)))
|
||||
;; eval current A1 odd element
|
||||
(set_local $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env))
|
||||
|
||||
(if (get_global $error_type) (br $done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; set key/value in the let environment
|
||||
(set_local $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res))
|
||||
@ -293,10 +288,10 @@
|
||||
|
||||
;; REPL
|
||||
(func $RE (param $line i32 $env i32) (result i32)
|
||||
(local $mv1 i32 $res i32)
|
||||
(block $rep_done
|
||||
(LET $mv1 0 $res 0)
|
||||
(block $done
|
||||
(set_local $mv1 ($READ $line))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
(set_local $res ($EVAL $mv1 $env))
|
||||
)
|
||||
@ -307,10 +302,10 @@
|
||||
)
|
||||
|
||||
(func $REP (param $line i32 $env i32) (result i32)
|
||||
(local $mv2 i32 $ms i32)
|
||||
(block $rep_done
|
||||
(LET $mv2 0 $ms 0)
|
||||
(block $done
|
||||
(set_local $mv2 ($RE $line $env))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; ($PR_MEMORY -1 -1)
|
||||
(set_local $ms ($PRINT $mv2))
|
||||
@ -322,8 +317,8 @@
|
||||
)
|
||||
|
||||
(func $main (result i32)
|
||||
(local $line i32 $res i32 $repl_env i32)
|
||||
(set_local $line (STATIC_ARRAY 201))
|
||||
(LET $line (STATIC_ARRAY 201)
|
||||
$res 0 $repl_env 0)
|
||||
|
||||
;; DEBUG
|
||||
;; ($printf_1 "argc: 0x%x\n" $argc)
|
||||
|
||||
@ -9,8 +9,8 @@
|
||||
|
||||
;; EVAL
|
||||
(func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32)
|
||||
(local $res i32 $val2 i32 $val3 i32 $type i32 $found i32)
|
||||
(local $ret i32 $empty i32 $current i32)
|
||||
(LET $res 0 $val2 0 $val3 0 $type 0 $found 0
|
||||
$ret 0 $empty 0 $current 0)
|
||||
|
||||
(if (get_global $error_type) (return 0))
|
||||
(set_local $type ($TYPE $ast))
|
||||
@ -37,10 +37,10 @@
|
||||
(block $done
|
||||
(loop $loop
|
||||
;; check if we are done evaluating the source sequence
|
||||
(if (i32.eq ($VAL0 $ast) 0) (br $done))
|
||||
(br_if $done (i32.eq ($VAL0 $ast) 0))
|
||||
|
||||
(if $skiplast
|
||||
(if (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast)) 0) (br $done)))
|
||||
(br_if $done (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast)) 0)))
|
||||
|
||||
(if (i32.eq $type (get_global $HASHMAP_T))
|
||||
(then
|
||||
@ -96,15 +96,11 @@
|
||||
($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))))
|
||||
|
||||
(func $EVAL (param $orig_ast i32 $orig_env i32) (result i32)
|
||||
(local $ast i32 $env i32 $prev_ast i32 $prev_env i32 $res i32 $el i32)
|
||||
(local $type i32 $ftype i32 $f_args i32 $f i32 $args i32)
|
||||
(local $a0 i32 $a0sym i32 $a1 i32 $a2 i32)
|
||||
|
||||
(set_local $ast $orig_ast)
|
||||
(set_local $env $orig_env)
|
||||
(set_local $prev_ast 0)
|
||||
(set_local $prev_env 0)
|
||||
(set_local $res 0)
|
||||
(LET $ast $orig_ast
|
||||
$env $orig_env
|
||||
$prev_ast 0 $prev_env 0 $res 0 $el 0
|
||||
$ftype 0 $f_args 0 $f 0 $args 0
|
||||
$a0 0 $a0sym 0 $a1 0 $a2 0)
|
||||
|
||||
(block $EVAL_return
|
||||
(loop $TCO_loop
|
||||
@ -141,7 +137,7 @@
|
||||
(set_local $a1 ($MAL_GET_A1 $ast))
|
||||
(set_local $a2 ($MAL_GET_A2 $ast))
|
||||
(set_local $res ($EVAL $a2 $env))
|
||||
(if (get_global $error_type) (br $EVAL_return))
|
||||
(br_if $EVAL_return (get_global $error_type))
|
||||
|
||||
;; set a1 in env to a2
|
||||
(set_local $res ($ENV_SET $env $a1 $res))
|
||||
@ -157,12 +153,11 @@
|
||||
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.eqz ($VAL0 $a1))
|
||||
(br $done))
|
||||
(br_if $done (i32.eqz ($VAL0 $a1)))
|
||||
;; eval current A1 odd element
|
||||
(set_local $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env))
|
||||
|
||||
(if (get_global $error_type) (br $done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; set key/value in the let environment
|
||||
(set_local $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res))
|
||||
@ -298,10 +293,10 @@
|
||||
|
||||
;; REPL
|
||||
(func $RE (param $line i32 $env i32) (result i32)
|
||||
(local $mv1 i32 $res i32)
|
||||
(block $rep_done
|
||||
(LET $mv1 0 $res 0)
|
||||
(block $done
|
||||
(set_local $mv1 ($READ $line))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
(set_local $res ($EVAL $mv1 $env))
|
||||
)
|
||||
@ -312,10 +307,10 @@
|
||||
)
|
||||
|
||||
(func $REP (param $line i32 $env i32) (result i32)
|
||||
(local $mv2 i32 $ms i32)
|
||||
(block $rep_done
|
||||
(LET $mv2 0 $ms 0)
|
||||
(block $done
|
||||
(set_local $mv2 ($RE $line $env))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; ($PR_MEMORY -1 -1)
|
||||
(set_local $ms ($PRINT $mv2))
|
||||
@ -327,10 +322,10 @@
|
||||
)
|
||||
|
||||
(func $main (param $argc i32 $argv i32) (result i32)
|
||||
(local $line i32 $res i32 $repl_env i32)
|
||||
;; argument processing
|
||||
(local $i i32 $ret i32 $empty i32 $current i32 $tmp i32 $val2 i32)
|
||||
(set_local $line (STATIC_ARRAY 201))
|
||||
(LET $line (STATIC_ARRAY 201)
|
||||
$res 0 $repl_env 0
|
||||
;; argument processing
|
||||
$i 0 $ret 0 $empty 0 $current 0 $tmp 0 $val2 0)
|
||||
|
||||
;; DEBUG
|
||||
;; ($printf_1 "argc: 0x%x\n" $argc)
|
||||
@ -365,7 +360,7 @@
|
||||
(set_local $i 2)
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.ge_u $i $argc) (br $done))
|
||||
(br_if $done (i32.ge_u $i $argc))
|
||||
|
||||
(set_local $val2 ($STRING (get_global $STRING_T)
|
||||
(i32.load (i32.add $argv (i32.mul_u $i 4)))))
|
||||
|
||||
@ -9,16 +9,14 @@
|
||||
|
||||
;; EVAL
|
||||
(func $is_pair (param $ast i32) (result i32)
|
||||
(local $type i32)
|
||||
(set_local $type ($TYPE $ast))
|
||||
(LET $type ($TYPE $ast))
|
||||
(AND (OR (i32.eq $type (get_global $LIST_T))
|
||||
(i32.eq $type (get_global $VECTOR_T)))
|
||||
(i32.ne ($VAL0 $ast) 0))
|
||||
)
|
||||
|
||||
(func $QUASIQUOTE (param $ast i32) (result i32)
|
||||
(local $sym i32 $res i32 $second i32 $third i32)
|
||||
(set_local $res 0)
|
||||
(LET $res 0 $sym 0 $second 0 $third 0)
|
||||
(if (i32.eqz ($is_pair $ast)) ;; QQ_QUOTE
|
||||
(then
|
||||
(set_local $sym ($STRING (get_global $SYMBOL_T) "quote"))
|
||||
@ -61,8 +59,8 @@
|
||||
)
|
||||
|
||||
(func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32)
|
||||
(local $res i32 $val2 i32 $val3 i32 $type i32 $found i32)
|
||||
(local $ret i32 $empty i32 $current i32)
|
||||
(LET $res 0 $val2 0 $val3 0 $type 0 $found 0
|
||||
$ret 0 $empty 0 $current 0)
|
||||
|
||||
(if (get_global $error_type) (return 0))
|
||||
(set_local $type ($TYPE $ast))
|
||||
@ -89,10 +87,10 @@
|
||||
(block $done
|
||||
(loop $loop
|
||||
;; check if we are done evaluating the source sequence
|
||||
(if (i32.eq ($VAL0 $ast) 0) (br $done))
|
||||
(br_if $done (i32.eq ($VAL0 $ast) 0))
|
||||
|
||||
(if $skiplast
|
||||
(if (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast)) 0) (br $done)))
|
||||
(br_if $done (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast)) 0)))
|
||||
|
||||
(if (i32.eq $type (get_global $HASHMAP_T))
|
||||
(then
|
||||
@ -148,15 +146,11 @@
|
||||
($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))))
|
||||
|
||||
(func $EVAL (param $orig_ast i32 $orig_env i32) (result i32)
|
||||
(local $ast i32 $env i32 $prev_ast i32 $prev_env i32 $res i32 $el i32)
|
||||
(local $type i32 $ftype i32 $f_args i32 $f i32 $args i32)
|
||||
(local $a0 i32 $a0sym i32 $a1 i32 $a2 i32)
|
||||
|
||||
(set_local $ast $orig_ast)
|
||||
(set_local $env $orig_env)
|
||||
(set_local $prev_ast 0)
|
||||
(set_local $prev_env 0)
|
||||
(set_local $res 0)
|
||||
(LET $ast $orig_ast
|
||||
$env $orig_env
|
||||
$prev_ast 0 $prev_env 0 $res 0 $el 0
|
||||
$ftype 0 $f_args 0 $f 0 $args 0
|
||||
$a0 0 $a0sym 0 $a1 0 $a2 0)
|
||||
|
||||
(block $EVAL_return
|
||||
(loop $TCO_loop
|
||||
@ -193,7 +187,7 @@
|
||||
(set_local $a1 ($MAL_GET_A1 $ast))
|
||||
(set_local $a2 ($MAL_GET_A2 $ast))
|
||||
(set_local $res ($EVAL $a2 $env))
|
||||
(if (get_global $error_type) (br $EVAL_return))
|
||||
(br_if $EVAL_return (get_global $error_type))
|
||||
|
||||
;; set a1 in env to a2
|
||||
(set_local $res ($ENV_SET $env $a1 $res))
|
||||
@ -209,12 +203,11 @@
|
||||
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.eqz ($VAL0 $a1))
|
||||
(br $done))
|
||||
(br_if $done (i32.eqz ($VAL0 $a1)))
|
||||
;; eval current A1 odd element
|
||||
(set_local $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env))
|
||||
|
||||
(if (get_global $error_type) (br $done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; set key/value in the let environment
|
||||
(set_local $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res))
|
||||
@ -362,10 +355,10 @@
|
||||
|
||||
;; REPL
|
||||
(func $RE (param $line i32 $env i32) (result i32)
|
||||
(local $mv1 i32 $res i32)
|
||||
(block $rep_done
|
||||
(LET $mv1 0 $res 0)
|
||||
(block $done
|
||||
(set_local $mv1 ($READ $line))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
(set_local $res ($EVAL $mv1 $env))
|
||||
)
|
||||
@ -376,10 +369,10 @@
|
||||
)
|
||||
|
||||
(func $REP (param $line i32 $env i32) (result i32)
|
||||
(local $mv2 i32 $ms i32)
|
||||
(block $rep_done
|
||||
(LET $mv2 0 $ms 0)
|
||||
(block $done
|
||||
(set_local $mv2 ($RE $line $env))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; ($PR_MEMORY -1 -1)
|
||||
(set_local $ms ($PRINT $mv2))
|
||||
@ -391,10 +384,10 @@
|
||||
)
|
||||
|
||||
(func $main (param $argc i32 $argv i32) (result i32)
|
||||
(local $line i32 $res i32 $repl_env i32)
|
||||
;; argument processing
|
||||
(local $i i32 $ret i32 $empty i32 $current i32 $tmp i32 $val2 i32)
|
||||
(set_local $line (STATIC_ARRAY 201))
|
||||
(LET $line (STATIC_ARRAY 201)
|
||||
$res 0 $repl_env 0
|
||||
;; argument processing
|
||||
$i 0 $ret 0 $empty 0 $current 0 $tmp 0 $val2 0)
|
||||
|
||||
;; DEBUG
|
||||
;; ($printf_1 "argc: 0x%x\n" $argc)
|
||||
@ -429,7 +422,7 @@
|
||||
(set_local $i 2)
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.ge_u $i $argc) (br $done))
|
||||
(br_if $done (i32.ge_u $i $argc))
|
||||
|
||||
(set_local $val2 ($STRING (get_global $STRING_T)
|
||||
(i32.load (i32.add $argv (i32.mul_u $i 4)))))
|
||||
|
||||
@ -9,16 +9,14 @@
|
||||
|
||||
;; EVAL
|
||||
(func $is_pair (param $ast i32) (result i32)
|
||||
(local $type i32)
|
||||
(set_local $type ($TYPE $ast))
|
||||
(LET $type ($TYPE $ast))
|
||||
(AND (OR (i32.eq $type (get_global $LIST_T))
|
||||
(i32.eq $type (get_global $VECTOR_T)))
|
||||
(i32.ne ($VAL0 $ast) 0))
|
||||
)
|
||||
|
||||
(func $QUASIQUOTE (param $ast i32) (result i32)
|
||||
(local $sym i32 $res i32 $second i32 $third i32)
|
||||
(set_local $res 0)
|
||||
(LET $res 0 $sym 0 $second 0 $third 0)
|
||||
(if (i32.eqz ($is_pair $ast)) ;; QQ_QUOTE
|
||||
(then
|
||||
(set_local $sym ($STRING (get_global $SYMBOL_T) "quote"))
|
||||
@ -64,24 +62,22 @@
|
||||
(global $mac_stack_top (mut i32) (i32.const -1))
|
||||
|
||||
(func $MACROEXPAND (param $orig_ast i32 $env i32) (result i32)
|
||||
(local $ast i32 $mac i32 $mac_env i64)
|
||||
(set_global $mac_stack (STATIC_ARRAY 1024)) ;; 256 * 4
|
||||
(set_local $ast $orig_ast)
|
||||
(set_local $mac 0)
|
||||
(local $mac_env i64)
|
||||
(LET $ast $orig_ast
|
||||
$mac 0)
|
||||
(set_global $mac_stack (STATIC_ARRAY 1024)) ;; 256 * 4, TODO: move to init
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (OR (i32.ne ($TYPE $ast) (get_global $LIST_T)) ;; a list
|
||||
(i32.eqz ($VAL0 $ast)) ;; non-empty
|
||||
(i32.ne ($TYPE ($MEM_VAL1_ptr $ast)) ;; leading symbol
|
||||
(get_global $SYMBOL_T)))
|
||||
(br $done))
|
||||
(br_if $done
|
||||
(OR (i32.ne ($TYPE $ast) (get_global $LIST_T)) ;; a list
|
||||
(i32.eqz ($VAL0 $ast)) ;; non-empty
|
||||
(i32.ne ($TYPE ($MEM_VAL1_ptr $ast)) ;; leading symbol
|
||||
(get_global $SYMBOL_T))))
|
||||
(set_local $mac_env ($ENV_FIND $env ($MEM_VAL1_ptr $ast)))
|
||||
(set_local $mac (i32.wrap/i64 (i64.shr_u $mac_env (i64.const 32))))
|
||||
(if (OR (i32.eqz (i32.wrap/i64 $mac_env)) ;; defined in env
|
||||
(i32.ne ($TYPE $mac) ;; a macro
|
||||
(get_global $MACRO_T)))
|
||||
(then
|
||||
(br $done)))
|
||||
(br_if $done (OR (i32.eqz (i32.wrap/i64 $mac_env)) ;; defined in env
|
||||
(i32.ne ($TYPE $mac) ;; a macro
|
||||
(get_global $MACRO_T))))
|
||||
|
||||
(set_local $ast ($APPLY $mac ($MEM_VAL0_ptr $ast)))
|
||||
;; PEND_A_LV
|
||||
@ -97,8 +93,7 @@
|
||||
(get_global $mac_stack)
|
||||
(i32.mul_s (get_global $mac_stack_top) 4))
|
||||
$ast)))
|
||||
(if (get_global $error_type)
|
||||
(br $done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
(br $loop)
|
||||
)
|
||||
@ -107,8 +102,8 @@
|
||||
)
|
||||
|
||||
(func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32)
|
||||
(local $res i32 $val2 i32 $val3 i32 $type i32 $found i32)
|
||||
(local $ret i32 $empty i32 $current i32)
|
||||
(LET $res 0 $val2 0 $val3 0 $type 0 $found 0
|
||||
$ret 0 $empty 0 $current 0)
|
||||
|
||||
(if (get_global $error_type) (return 0))
|
||||
(set_local $type ($TYPE $ast))
|
||||
@ -135,10 +130,10 @@
|
||||
(block $done
|
||||
(loop $loop
|
||||
;; check if we are done evaluating the source sequence
|
||||
(if (i32.eq ($VAL0 $ast) 0) (br $done))
|
||||
(br_if $done (i32.eq ($VAL0 $ast) 0))
|
||||
|
||||
(if $skiplast
|
||||
(if (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast)) 0) (br $done)))
|
||||
(br_if $done (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast)) 0)))
|
||||
|
||||
(if (i32.eq $type (get_global $HASHMAP_T))
|
||||
(then
|
||||
@ -194,17 +189,12 @@
|
||||
($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))))
|
||||
|
||||
(func $EVAL (param $orig_ast i32 $orig_env i32) (result i32)
|
||||
(local $ast i32 $env i32 $prev_ast i32 $prev_env i32 $res i32 $el i32)
|
||||
(local $ftype i32 $f_args i32 $f i32 $args i32)
|
||||
(local $a0 i32 $a0sym i32 $a1 i32 $a2 i32)
|
||||
(local $orig_mac_stack_top i32)
|
||||
|
||||
(set_local $ast $orig_ast)
|
||||
(set_local $env $orig_env)
|
||||
(set_local $prev_ast 0)
|
||||
(set_local $prev_env 0)
|
||||
(set_local $res 0)
|
||||
(set_local $orig_mac_stack_top (get_global $mac_stack_top))
|
||||
(LET $ast $orig_ast
|
||||
$env $orig_env
|
||||
$orig_mac_stack_top (get_global $mac_stack_top)
|
||||
$prev_ast 0 $prev_env 0 $res 0 $el 0
|
||||
$ftype 0 $f_args 0 $f 0 $args 0
|
||||
$a0 0 $a0sym 0 $a1 0 $a2 0)
|
||||
|
||||
(block $EVAL_return
|
||||
(loop $TCO_loop
|
||||
@ -249,7 +239,7 @@
|
||||
(set_local $a1 ($MAL_GET_A1 $ast))
|
||||
(set_local $a2 ($MAL_GET_A2 $ast))
|
||||
(set_local $res ($EVAL $a2 $env))
|
||||
(if (get_global $error_type) (br $EVAL_return))
|
||||
(br_if $EVAL_return (get_global $error_type))
|
||||
|
||||
;; set a1 in env to a2
|
||||
(set_local $res ($ENV_SET $env $a1 $res))
|
||||
@ -265,12 +255,11 @@
|
||||
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.eqz ($VAL0 $a1))
|
||||
(br $done))
|
||||
(br_if $done (i32.eqz ($VAL0 $a1)))
|
||||
;; eval current A1 odd element
|
||||
(set_local $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env))
|
||||
|
||||
(if (get_global $error_type) (br $done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; set key/value in the let environment
|
||||
(set_local $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res))
|
||||
@ -317,8 +306,7 @@
|
||||
(set_local $a2 ($MAL_GET_A2 $ast))
|
||||
(set_local $res ($EVAL $a2 $env))
|
||||
($SET_TYPE $res (get_global $MACRO_T))
|
||||
(if (get_global $error_type)
|
||||
(br $EVAL_return))
|
||||
(br_if $EVAL_return (get_global $error_type))
|
||||
|
||||
;; set a1 in env to a2
|
||||
(set_local $res ($ENV_SET $env $a1 $res))
|
||||
@ -430,10 +418,7 @@
|
||||
;; TODO: needs to happen here so self-hosting doesn't leak
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.le_s (get_global $mac_stack_top) $orig_mac_stack_top)
|
||||
(br $done))
|
||||
;;($printf_1 "free orig_mac_stack_top: %d\n" $orig_mac_stack_top)
|
||||
;;($printf_1 "free mac_stack_top: %d\n" (get_global $mac_stack_top))
|
||||
(br_if $done (i32.le_s (get_global $mac_stack_top) $orig_mac_stack_top))
|
||||
($RELEASE (i32.load (i32.add
|
||||
(get_global $mac_stack)
|
||||
(i32.mul_s (get_global $mac_stack_top) 4))))
|
||||
@ -453,10 +438,10 @@
|
||||
|
||||
;; REPL
|
||||
(func $RE (param $line i32 $env i32) (result i32)
|
||||
(local $mv1 i32 $res i32)
|
||||
(block $rep_done
|
||||
(LET $mv1 0 $res 0)
|
||||
(block $done
|
||||
(set_local $mv1 ($READ $line))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
(set_local $res ($EVAL $mv1 $env))
|
||||
)
|
||||
@ -467,10 +452,10 @@
|
||||
)
|
||||
|
||||
(func $REP (param $line i32 $env i32) (result i32)
|
||||
(local $mv2 i32 $ms i32)
|
||||
(block $rep_done
|
||||
(LET $mv2 0 $ms 0)
|
||||
(block $done
|
||||
(set_local $mv2 ($RE $line $env))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; ($PR_MEMORY -1 -1)
|
||||
(set_local $ms ($PRINT $mv2))
|
||||
@ -482,10 +467,10 @@
|
||||
)
|
||||
|
||||
(func $main (param $argc i32 $argv i32) (result i32)
|
||||
(local $line i32 $res i32 $repl_env i32)
|
||||
;; argument processing
|
||||
(local $i i32 $ret i32 $empty i32 $current i32 $tmp i32 $val2 i32)
|
||||
(set_local $line (STATIC_ARRAY 201))
|
||||
(LET $line (STATIC_ARRAY 201)
|
||||
$res 0 $repl_env 0
|
||||
;; argument processing
|
||||
$i 0 $ret 0 $empty 0 $current 0 $tmp 0 $val2 0)
|
||||
|
||||
;; DEBUG
|
||||
;; ($printf_1 "argc: 0x%x\n" $argc)
|
||||
@ -522,7 +507,7 @@
|
||||
(set_local $i 2)
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.ge_u $i $argc) (br $done))
|
||||
(br_if $done (i32.ge_u $i $argc))
|
||||
|
||||
(set_local $val2 ($STRING (get_global $STRING_T)
|
||||
(i32.load (i32.add $argv (i32.mul_u $i 4)))))
|
||||
|
||||
@ -9,16 +9,14 @@
|
||||
|
||||
;; EVAL
|
||||
(func $is_pair (param $ast i32) (result i32)
|
||||
(local $type i32)
|
||||
(set_local $type ($TYPE $ast))
|
||||
(LET $type ($TYPE $ast))
|
||||
(AND (OR (i32.eq $type (get_global $LIST_T))
|
||||
(i32.eq $type (get_global $VECTOR_T)))
|
||||
(i32.ne ($VAL0 $ast) 0))
|
||||
)
|
||||
|
||||
(func $QUASIQUOTE (param $ast i32) (result i32)
|
||||
(local $sym i32 $res i32 $second i32 $third i32)
|
||||
(set_local $res 0)
|
||||
(LET $res 0 $sym 0 $second 0 $third 0)
|
||||
(if (i32.eqz ($is_pair $ast)) ;; QQ_QUOTE
|
||||
(then
|
||||
(set_local $sym ($STRING (get_global $SYMBOL_T) "quote"))
|
||||
@ -64,24 +62,22 @@
|
||||
(global $mac_stack_top (mut i32) (i32.const -1))
|
||||
|
||||
(func $MACROEXPAND (param $orig_ast i32 $env i32) (result i32)
|
||||
(local $ast i32 $mac i32 $mac_env i64)
|
||||
(set_global $mac_stack (STATIC_ARRAY 1024)) ;; 256 * 4
|
||||
(set_local $ast $orig_ast)
|
||||
(set_local $mac 0)
|
||||
(local $mac_env i64)
|
||||
(LET $ast $orig_ast
|
||||
$mac 0)
|
||||
(set_global $mac_stack (STATIC_ARRAY 1024)) ;; 256 * 4, TODO: move to init
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (OR (i32.ne ($TYPE $ast) (get_global $LIST_T)) ;; a list
|
||||
(i32.eqz ($VAL0 $ast)) ;; non-empty
|
||||
(i32.ne ($TYPE ($MEM_VAL1_ptr $ast)) ;; leading symbol
|
||||
(get_global $SYMBOL_T)))
|
||||
(br $done))
|
||||
(br_if $done
|
||||
(OR (i32.ne ($TYPE $ast) (get_global $LIST_T)) ;; a list
|
||||
(i32.eqz ($VAL0 $ast)) ;; non-empty
|
||||
(i32.ne ($TYPE ($MEM_VAL1_ptr $ast)) ;; leading symbol
|
||||
(get_global $SYMBOL_T))))
|
||||
(set_local $mac_env ($ENV_FIND $env ($MEM_VAL1_ptr $ast)))
|
||||
(set_local $mac (i32.wrap/i64 (i64.shr_u $mac_env (i64.const 32))))
|
||||
(if (OR (i32.eqz (i32.wrap/i64 $mac_env)) ;; defined in env
|
||||
(i32.ne ($TYPE $mac) ;; a macro
|
||||
(get_global $MACRO_T)))
|
||||
(then
|
||||
(br $done)))
|
||||
(br_if $done (OR (i32.eqz (i32.wrap/i64 $mac_env)) ;; defined in env
|
||||
(i32.ne ($TYPE $mac) ;; a macro
|
||||
(get_global $MACRO_T))))
|
||||
|
||||
(set_local $ast ($APPLY $mac ($MEM_VAL0_ptr $ast)))
|
||||
;; PEND_A_LV
|
||||
@ -97,8 +93,7 @@
|
||||
(get_global $mac_stack)
|
||||
(i32.mul_s (get_global $mac_stack_top) 4))
|
||||
$ast)))
|
||||
(if (get_global $error_type)
|
||||
(br $done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
(br $loop)
|
||||
)
|
||||
@ -107,8 +102,8 @@
|
||||
)
|
||||
|
||||
(func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32)
|
||||
(local $res i32 $val2 i32 $val3 i32 $type i32 $found i32)
|
||||
(local $ret i32 $empty i32 $current i32)
|
||||
(LET $res 0 $val2 0 $val3 0 $type 0 $found 0
|
||||
$ret 0 $empty 0 $current 0)
|
||||
|
||||
(if (get_global $error_type) (return 0))
|
||||
(set_local $type ($TYPE $ast))
|
||||
@ -135,10 +130,10 @@
|
||||
(block $done
|
||||
(loop $loop
|
||||
;; check if we are done evaluating the source sequence
|
||||
(if (i32.eq ($VAL0 $ast) 0) (br $done))
|
||||
(br_if $done (i32.eq ($VAL0 $ast) 0))
|
||||
|
||||
(if $skiplast
|
||||
(if (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast)) 0) (br $done)))
|
||||
(br_if $done (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast)) 0)))
|
||||
|
||||
(if (i32.eq $type (get_global $HASHMAP_T))
|
||||
(then
|
||||
@ -194,18 +189,13 @@
|
||||
($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))))
|
||||
|
||||
(func $EVAL (param $orig_ast i32 $orig_env i32) (result i32)
|
||||
(local $ast i32 $env i32 $prev_ast i32 $prev_env i32 $res i32 $el i32)
|
||||
(local $ftype i32 $f_args i32 $f i32 $args i32)
|
||||
(local $a0 i32 $a0sym i32 $a1 i32 $a2 i32)
|
||||
(local $err i32)
|
||||
(local $orig_mac_stack_top i32)
|
||||
|
||||
(set_local $ast $orig_ast)
|
||||
(set_local $env $orig_env)
|
||||
(set_local $prev_ast 0)
|
||||
(set_local $prev_env 0)
|
||||
(set_local $res 0)
|
||||
(set_local $orig_mac_stack_top (get_global $mac_stack_top))
|
||||
(LET $ast $orig_ast
|
||||
$env $orig_env
|
||||
$orig_mac_stack_top (get_global $mac_stack_top)
|
||||
$prev_ast 0 $prev_env 0 $res 0 $el 0
|
||||
$ftype 0 $f_args 0 $f 0 $args 0
|
||||
$a0 0 $a0sym 0 $a1 0 $a2 0
|
||||
$err 0)
|
||||
|
||||
(block $EVAL_return
|
||||
(loop $TCO_loop
|
||||
@ -250,7 +240,7 @@
|
||||
(set_local $a1 ($MAL_GET_A1 $ast))
|
||||
(set_local $a2 ($MAL_GET_A2 $ast))
|
||||
(set_local $res ($EVAL $a2 $env))
|
||||
(if (get_global $error_type) (br $EVAL_return))
|
||||
(br_if $EVAL_return (get_global $error_type))
|
||||
|
||||
;; set a1 in env to a2
|
||||
(set_local $res ($ENV_SET $env $a1 $res))
|
||||
@ -266,12 +256,11 @@
|
||||
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.eqz ($VAL0 $a1))
|
||||
(br $done))
|
||||
(br_if $done (i32.eqz ($VAL0 $a1)))
|
||||
;; eval current A1 odd element
|
||||
(set_local $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env))
|
||||
|
||||
(if (get_global $error_type) (br $done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; set key/value in the let environment
|
||||
(set_local $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res))
|
||||
@ -318,8 +307,7 @@
|
||||
(set_local $a2 ($MAL_GET_A2 $ast))
|
||||
(set_local $res ($EVAL $a2 $env))
|
||||
($SET_TYPE $res (get_global $MACRO_T))
|
||||
(if (get_global $error_type)
|
||||
(br $EVAL_return))
|
||||
(br_if $EVAL_return (get_global $error_type))
|
||||
|
||||
;; set a1 in env to a2
|
||||
(set_local $res ($ENV_SET $env $a1 $res))
|
||||
@ -336,13 +324,12 @@
|
||||
(set_local $res ($EVAL $a1 $env))
|
||||
|
||||
;; if there is no error, return
|
||||
(if (i32.eqz (get_global $error_type))
|
||||
(br $EVAL_return))
|
||||
(br_if $EVAL_return (i32.eqz (get_global $error_type)))
|
||||
;; if there is an error and res is set, we need to free it
|
||||
($RELEASE $res)
|
||||
;; if there is no catch block then return
|
||||
(if (i32.eqz ($VAL0 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))
|
||||
(br $EVAL_return))
|
||||
(br_if $EVAL_return
|
||||
(i32.eqz ($VAL0 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))))
|
||||
|
||||
;; save the current environment for release
|
||||
(set_local $prev_env $env)
|
||||
@ -478,10 +465,7 @@
|
||||
;; TODO: needs to happen here so self-hosting doesn't leak
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.le_s (get_global $mac_stack_top) $orig_mac_stack_top)
|
||||
(br $done))
|
||||
;;($printf_1 "free orig_mac_stack_top: %d\n" $orig_mac_stack_top)
|
||||
;;($printf_1 "free mac_stack_top: %d\n" (get_global $mac_stack_top))
|
||||
(br_if $done (i32.le_s (get_global $mac_stack_top) $orig_mac_stack_top))
|
||||
($RELEASE (i32.load (i32.add
|
||||
(get_global $mac_stack)
|
||||
(i32.mul_s (get_global $mac_stack_top) 4))))
|
||||
@ -501,10 +485,10 @@
|
||||
|
||||
;; REPL
|
||||
(func $RE (param $line i32 $env i32) (result i32)
|
||||
(local $mv1 i32 $res i32)
|
||||
(block $rep_done
|
||||
(LET $mv1 0 $res 0)
|
||||
(block $done
|
||||
(set_local $mv1 ($READ $line))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
(set_local $res ($EVAL $mv1 $env))
|
||||
)
|
||||
@ -515,10 +499,10 @@
|
||||
)
|
||||
|
||||
(func $REP (param $line i32 $env i32) (result i32)
|
||||
(local $mv2 i32 $ms i32)
|
||||
(block $rep_done
|
||||
(LET $mv2 0 $ms 0)
|
||||
(block $done
|
||||
(set_local $mv2 ($RE $line $env))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; ($PR_MEMORY -1 -1)
|
||||
(set_local $ms ($PRINT $mv2))
|
||||
@ -530,10 +514,10 @@
|
||||
)
|
||||
|
||||
(func $main (param $argc i32 $argv i32) (result i32)
|
||||
(local $line i32 $res i32 $repl_env i32)
|
||||
;; argument processing
|
||||
(local $i i32 $ret i32 $empty i32 $current i32 $tmp i32 $val2 i32)
|
||||
(set_local $line (STATIC_ARRAY 201))
|
||||
(LET $line (STATIC_ARRAY 201)
|
||||
$res 0 $repl_env 0
|
||||
;; argument processing
|
||||
$i 0 $ret 0 $empty 0 $current 0 $tmp 0 $val2 0)
|
||||
|
||||
;; DEBUG
|
||||
;; ($printf_1 "argc: 0x%x\n" $argc)
|
||||
@ -570,7 +554,7 @@
|
||||
(set_local $i 2)
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.ge_u $i $argc) (br $done))
|
||||
(br_if $done (i32.ge_u $i $argc))
|
||||
|
||||
(set_local $val2 ($STRING (get_global $STRING_T)
|
||||
(i32.load (i32.add $argv (i32.mul_u $i 4)))))
|
||||
|
||||
@ -9,16 +9,14 @@
|
||||
|
||||
;; EVAL
|
||||
(func $is_pair (param $ast i32) (result i32)
|
||||
(local $type i32)
|
||||
(set_local $type ($TYPE $ast))
|
||||
(LET $type ($TYPE $ast))
|
||||
(AND (OR (i32.eq $type (get_global $LIST_T))
|
||||
(i32.eq $type (get_global $VECTOR_T)))
|
||||
(i32.ne ($VAL0 $ast) 0))
|
||||
)
|
||||
|
||||
(func $QUASIQUOTE (param $ast i32) (result i32)
|
||||
(local $sym i32 $res i32 $second i32 $third i32)
|
||||
(set_local $res 0)
|
||||
(LET $res 0 $sym 0 $second 0 $third 0)
|
||||
(if (i32.eqz ($is_pair $ast)) ;; QQ_QUOTE
|
||||
(then
|
||||
(set_local $sym ($STRING (get_global $SYMBOL_T) "quote"))
|
||||
@ -64,24 +62,22 @@
|
||||
(global $mac_stack_top (mut i32) (i32.const -1))
|
||||
|
||||
(func $MACROEXPAND (param $orig_ast i32 $env i32) (result i32)
|
||||
(local $ast i32 $mac i32 $mac_env i64)
|
||||
(set_global $mac_stack (STATIC_ARRAY 1024)) ;; 256 * 4
|
||||
(set_local $ast $orig_ast)
|
||||
(set_local $mac 0)
|
||||
(local $mac_env i64)
|
||||
(LET $ast $orig_ast
|
||||
$mac 0)
|
||||
(set_global $mac_stack (STATIC_ARRAY 1024)) ;; 256 * 4, TODO: move to init
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (OR (i32.ne ($TYPE $ast) (get_global $LIST_T)) ;; a list
|
||||
(i32.eqz ($VAL0 $ast)) ;; non-empty
|
||||
(i32.ne ($TYPE ($MEM_VAL1_ptr $ast)) ;; leading symbol
|
||||
(get_global $SYMBOL_T)))
|
||||
(br $done))
|
||||
(br_if $done
|
||||
(OR (i32.ne ($TYPE $ast) (get_global $LIST_T)) ;; a list
|
||||
(i32.eqz ($VAL0 $ast)) ;; non-empty
|
||||
(i32.ne ($TYPE ($MEM_VAL1_ptr $ast)) ;; leading symbol
|
||||
(get_global $SYMBOL_T))))
|
||||
(set_local $mac_env ($ENV_FIND $env ($MEM_VAL1_ptr $ast)))
|
||||
(set_local $mac (i32.wrap/i64 (i64.shr_u $mac_env (i64.const 32))))
|
||||
(if (OR (i32.eqz (i32.wrap/i64 $mac_env)) ;; defined in env
|
||||
(i32.ne ($TYPE $mac) ;; a macro
|
||||
(get_global $MACRO_T)))
|
||||
(then
|
||||
(br $done)))
|
||||
(br_if $done (OR (i32.eqz (i32.wrap/i64 $mac_env)) ;; defined in env
|
||||
(i32.ne ($TYPE $mac) ;; a macro
|
||||
(get_global $MACRO_T))))
|
||||
|
||||
(set_local $ast ($APPLY $mac ($MEM_VAL0_ptr $ast)))
|
||||
;; PEND_A_LV
|
||||
@ -97,8 +93,7 @@
|
||||
(get_global $mac_stack)
|
||||
(i32.mul_s (get_global $mac_stack_top) 4))
|
||||
$ast)))
|
||||
(if (get_global $error_type)
|
||||
(br $done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
(br $loop)
|
||||
)
|
||||
@ -107,8 +102,8 @@
|
||||
)
|
||||
|
||||
(func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32)
|
||||
(local $res i32 $val2 i32 $val3 i32 $type i32 $found i32)
|
||||
(local $ret i32 $empty i32 $current i32)
|
||||
(LET $res 0 $val2 0 $val3 0 $type 0 $found 0
|
||||
$ret 0 $empty 0 $current 0)
|
||||
|
||||
(if (get_global $error_type) (return 0))
|
||||
(set_local $type ($TYPE $ast))
|
||||
@ -135,10 +130,10 @@
|
||||
(block $done
|
||||
(loop $loop
|
||||
;; check if we are done evaluating the source sequence
|
||||
(if (i32.eq ($VAL0 $ast) 0) (br $done))
|
||||
(br_if $done (i32.eq ($VAL0 $ast) 0))
|
||||
|
||||
(if $skiplast
|
||||
(if (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast)) 0) (br $done)))
|
||||
(br_if $done (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast)) 0)))
|
||||
|
||||
(if (i32.eq $type (get_global $HASHMAP_T))
|
||||
(then
|
||||
@ -194,18 +189,13 @@
|
||||
($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))))
|
||||
|
||||
(func $EVAL (param $orig_ast i32 $orig_env i32) (result i32)
|
||||
(local $ast i32 $env i32 $prev_ast i32 $prev_env i32 $res i32 $el i32)
|
||||
(local $ftype i32 $f_args i32 $f i32 $args i32)
|
||||
(local $a0 i32 $a0sym i32 $a1 i32 $a2 i32)
|
||||
(local $err i32)
|
||||
(local $orig_mac_stack_top i32)
|
||||
|
||||
(set_local $ast $orig_ast)
|
||||
(set_local $env $orig_env)
|
||||
(set_local $prev_ast 0)
|
||||
(set_local $prev_env 0)
|
||||
(set_local $res 0)
|
||||
(set_local $orig_mac_stack_top (get_global $mac_stack_top))
|
||||
(LET $ast $orig_ast
|
||||
$env $orig_env
|
||||
$orig_mac_stack_top (get_global $mac_stack_top)
|
||||
$prev_ast 0 $prev_env 0 $res 0 $el 0
|
||||
$ftype 0 $f_args 0 $f 0 $args 0
|
||||
$a0 0 $a0sym 0 $a1 0 $a2 0
|
||||
$err 0)
|
||||
|
||||
(block $EVAL_return
|
||||
(loop $TCO_loop
|
||||
@ -250,7 +240,7 @@
|
||||
(set_local $a1 ($MAL_GET_A1 $ast))
|
||||
(set_local $a2 ($MAL_GET_A2 $ast))
|
||||
(set_local $res ($EVAL $a2 $env))
|
||||
(if (get_global $error_type) (br $EVAL_return))
|
||||
(br_if $EVAL_return (get_global $error_type))
|
||||
|
||||
;; set a1 in env to a2
|
||||
(set_local $res ($ENV_SET $env $a1 $res))
|
||||
@ -266,12 +256,11 @@
|
||||
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.eqz ($VAL0 $a1))
|
||||
(br $done))
|
||||
(br_if $done (i32.eqz ($VAL0 $a1)))
|
||||
;; eval current A1 odd element
|
||||
(set_local $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env))
|
||||
|
||||
(if (get_global $error_type) (br $done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; set key/value in the let environment
|
||||
(set_local $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res))
|
||||
@ -318,8 +307,7 @@
|
||||
(set_local $a2 ($MAL_GET_A2 $ast))
|
||||
(set_local $res ($EVAL $a2 $env))
|
||||
($SET_TYPE $res (get_global $MACRO_T))
|
||||
(if (get_global $error_type)
|
||||
(br $EVAL_return))
|
||||
(br_if $EVAL_return (get_global $error_type))
|
||||
|
||||
;; set a1 in env to a2
|
||||
(set_local $res ($ENV_SET $env $a1 $res))
|
||||
@ -336,13 +324,12 @@
|
||||
(set_local $res ($EVAL $a1 $env))
|
||||
|
||||
;; if there is no error, return
|
||||
(if (i32.eqz (get_global $error_type))
|
||||
(br $EVAL_return))
|
||||
(br_if $EVAL_return (i32.eqz (get_global $error_type)))
|
||||
;; if there is an error and res is set, we need to free it
|
||||
($RELEASE $res)
|
||||
;; if there is no catch block then return
|
||||
(if (i32.eqz ($VAL0 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))
|
||||
(br $EVAL_return))
|
||||
(br_if $EVAL_return
|
||||
(i32.eqz ($VAL0 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))))
|
||||
|
||||
;; save the current environment for release
|
||||
(set_local $prev_env $env)
|
||||
@ -478,10 +465,7 @@
|
||||
;; TODO: needs to happen here so self-hosting doesn't leak
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.le_s (get_global $mac_stack_top) $orig_mac_stack_top)
|
||||
(br $done))
|
||||
;;($printf_1 "free orig_mac_stack_top: %d\n" $orig_mac_stack_top)
|
||||
;;($printf_1 "free mac_stack_top: %d\n" (get_global $mac_stack_top))
|
||||
(br_if $done (i32.le_s (get_global $mac_stack_top) $orig_mac_stack_top))
|
||||
($RELEASE (i32.load (i32.add
|
||||
(get_global $mac_stack)
|
||||
(i32.mul_s (get_global $mac_stack_top) 4))))
|
||||
@ -501,10 +485,10 @@
|
||||
|
||||
;; REPL
|
||||
(func $RE (param $line i32 $env i32) (result i32)
|
||||
(local $mv1 i32 $res i32)
|
||||
(block $rep_done
|
||||
(LET $mv1 0 $res 0)
|
||||
(block $done
|
||||
(set_local $mv1 ($READ $line))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
(set_local $res ($EVAL $mv1 $env))
|
||||
)
|
||||
@ -515,10 +499,10 @@
|
||||
)
|
||||
|
||||
(func $REP (param $line i32 $env i32) (result i32)
|
||||
(local $mv2 i32 $ms i32)
|
||||
(block $rep_done
|
||||
(LET $mv2 0 $ms 0)
|
||||
(block $done
|
||||
(set_local $mv2 ($RE $line $env))
|
||||
(if (get_global $error_type) (br $rep_done))
|
||||
(br_if $done (get_global $error_type))
|
||||
|
||||
;; ($PR_MEMORY -1 -1)
|
||||
(set_local $ms ($PRINT $mv2))
|
||||
@ -530,10 +514,10 @@
|
||||
)
|
||||
|
||||
(func $main (param $argc i32 $argv i32) (result i32)
|
||||
(local $line i32 $res i32 $repl_env i32)
|
||||
;; argument processing
|
||||
(local $i i32 $ret i32 $empty i32 $current i32 $tmp i32 $val2 i32)
|
||||
(set_local $line (STATIC_ARRAY 201))
|
||||
(LET $line (STATIC_ARRAY 201)
|
||||
$res 0 $repl_env 0
|
||||
;; argument processing
|
||||
$i 0 $ret 0 $empty 0 $current 0 $tmp 0 $val2 0)
|
||||
|
||||
;; DEBUG
|
||||
;; ($printf_1 "argc: 0x%x\n" $argc)
|
||||
@ -572,7 +556,7 @@
|
||||
(set_local $i 2)
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.ge_u $i $argc) (br $done))
|
||||
(br_if $done (i32.ge_u $i $argc))
|
||||
|
||||
(set_local $val2 ($STRING (get_global $STRING_T)
|
||||
(i32.load (i32.add $argv (i32.mul_u $i 4)))))
|
||||
|
||||
@ -5,8 +5,7 @@
|
||||
;; Copy len bytes from src to dst
|
||||
;; Returns len
|
||||
(func $memmove (param $dst i32 $src i32 $len i32)
|
||||
(local $idx i32)
|
||||
(set_local $idx 0)
|
||||
(LET $idx 0)
|
||||
(loop $copy
|
||||
(i32.store8_u (i32.add $idx $dst)
|
||||
(i32.load8_u (i32.add $idx $src)))
|
||||
@ -16,8 +15,7 @@
|
||||
)
|
||||
|
||||
(func $strlen (param $str i32) (result i32)
|
||||
(local $cur i32)
|
||||
(set_local $cur $str)
|
||||
(LET $cur $str)
|
||||
(loop $count
|
||||
(if (i32.ne 0 (i32.load8_u $cur))
|
||||
(then
|
||||
@ -30,10 +28,9 @@
|
||||
;; Based on https://stackoverflow.com/a/25705264/471795
|
||||
;; This could be made much more efficient
|
||||
(func $strstr (param $haystack i32 $needle i32) (result i32)
|
||||
(local $i i32 $needle_len i32 $len i32)
|
||||
|
||||
(set_local $needle_len ($strlen $needle))
|
||||
(set_local $len ($strlen $haystack))
|
||||
(LET $i 0
|
||||
$needle_len ($strlen $needle)
|
||||
$len ($strlen $haystack))
|
||||
|
||||
(if (i32.eq $needle_len 0) (return $haystack))
|
||||
|
||||
@ -55,13 +52,10 @@
|
||||
)
|
||||
|
||||
(func $atoi (param $str i32) (result i32)
|
||||
(local $acc i32)
|
||||
(local $i i32)
|
||||
(local $neg i32)
|
||||
(local $ch i32)
|
||||
(set_local $acc 0)
|
||||
(set_local $i 0)
|
||||
(set_local $neg 0)
|
||||
(LET $acc 0
|
||||
$i 0
|
||||
$neg 0
|
||||
$ch 0)
|
||||
(block $done
|
||||
(loop $loop
|
||||
(set_local $ch (i32.load8_u (i32.add $str $i)))
|
||||
@ -105,8 +99,7 @@
|
||||
)
|
||||
|
||||
(func $strncmp (param $s1 i32 $s2 i32 $len i32) (result i32)
|
||||
(local $i i32)
|
||||
(set_local $i 0)
|
||||
(LET $i 0)
|
||||
(if (i32.eq $len 0) (return 0))
|
||||
(block $done
|
||||
(loop $loop
|
||||
@ -136,14 +129,12 @@
|
||||
$needle0 i32 $replace0 i32
|
||||
$needle1 i32 $replace1 i32
|
||||
$needle2 i32 $replace2 i32) (result i32)
|
||||
(local $needle i32 $replace i32)
|
||||
(local $haystack_len i32 $needle_len i32 $replace_len i32)
|
||||
(local $src_str i32 $dst_str i32 $s i32 $found_tmp i32 $found i32)
|
||||
(local $replace_s i32 $replace_len_s i32 $needle_len_s i32)
|
||||
|
||||
(set_local $haystack_len ($strlen $haystack))
|
||||
(set_local $src_str $haystack)
|
||||
(set_local $dst_str $grass)
|
||||
(LET $haystack_len ($strlen $haystack)
|
||||
$src_str $haystack
|
||||
$dst_str $grass
|
||||
$s 0 $found_tmp 0 $found 0
|
||||
$needle 0 $replace 0 $needle_len 0 $replace_len 0
|
||||
$replace_s 0 $replace_len_s 0 $needle_len_s 0)
|
||||
|
||||
;; in-place
|
||||
(if (i32.eqz $grass)
|
||||
|
||||
@ -73,9 +73,8 @@
|
||||
)
|
||||
|
||||
(func $EQUAL_Q (param $a i32 $b i32) (result i32)
|
||||
(local $ta i32 $tb i32)
|
||||
(set_local $ta ($TYPE $a))
|
||||
(set_local $tb ($TYPE $b))
|
||||
(LET $ta ($TYPE $a)
|
||||
$tb ($TYPE $b))
|
||||
|
||||
(if (AND (OR (i32.eq $ta (get_global $LIST_T))
|
||||
(i32.eq $ta (get_global $VECTOR_T)))
|
||||
@ -138,9 +137,7 @@
|
||||
;; Duplicate regular character array string into a Mal string and
|
||||
;; return the MalVal pointer
|
||||
(func $STRING (param $type i32 $str i32) (result i32)
|
||||
(local $ms i32)
|
||||
;; TODO: assert mv is a string/keyword/symbol
|
||||
(set_local $ms ($ALLOC_STRING $str ($strlen $str) 1))
|
||||
(LET $ms ($ALLOC_STRING $str ($strlen $str) 1))
|
||||
($ALLOC_SCALAR $type (i32.sub_u $ms (get_global $string_mem)))
|
||||
)
|
||||
|
||||
@ -148,10 +145,10 @@
|
||||
;; mv and return the interned version. If no duplicate is found,
|
||||
;; return NULL.
|
||||
(func $INTERN_STRING (param $mv i32) (result i32)
|
||||
(local $res i32 $ms i32 $existing_ms i32 $tmp i32)
|
||||
(set_local $res 0)
|
||||
(set_local $ms ($to_MalString $mv))
|
||||
(set_local $existing_ms ($FIND_STRING (i32.add $ms 4)))
|
||||
(LET $res 0
|
||||
$ms ($to_MalString $mv)
|
||||
$existing_ms ($FIND_STRING (i32.add $ms 4))
|
||||
$tmp 0)
|
||||
(if (AND $existing_ms (i32.lt_s $existing_ms $ms))
|
||||
(then
|
||||
(set_local $tmp $mv)
|
||||
@ -164,16 +161,14 @@
|
||||
)
|
||||
|
||||
(func $STRING_INIT (param $type i32) (result i32)
|
||||
(local $ms i32)
|
||||
(set_local $ms ($ALLOC_STRING "" 0 0))
|
||||
(LET $ms ($ALLOC_STRING "" 0 0))
|
||||
($ALLOC_SCALAR $type (i32.sub_s $ms (get_global $string_mem)))
|
||||
)
|
||||
|
||||
(func $STRING_FINALIZE (param $mv i32 $size i32) (result i32)
|
||||
(local $tmp i32 $ms i32)
|
||||
;; Check if the new string can be interned.
|
||||
(set_local $tmp ($INTERN_STRING $mv))
|
||||
(set_local $ms ($to_MalString $mv))
|
||||
(LET $tmp ($INTERN_STRING $mv)
|
||||
$ms ($to_MalString $mv))
|
||||
(if $tmp
|
||||
(then
|
||||
(set_local $mv $tmp))
|
||||
@ -198,16 +193,15 @@
|
||||
;; sequence functions
|
||||
|
||||
(func $MAP_LOOP_START (param $type i32) (result i32)
|
||||
(local $res i32)
|
||||
(set_local $res (if i32 (i32.eq $type (get_global $LIST_T))
|
||||
(get_global $EMPTY_LIST)
|
||||
(else (if i32 (i32.eq $type (get_global $VECTOR_T))
|
||||
(get_global $EMPTY_VECTOR)
|
||||
(else (if i32 (i32.eq $type (get_global $HASHMAP_T))
|
||||
(get_global $EMPTY_HASHMAP)
|
||||
(else
|
||||
($THROW_STR_1 "read_seq invalid type %d" $type)
|
||||
0)))))))
|
||||
(LET $res (if i32 (i32.eq $type (get_global $LIST_T))
|
||||
(get_global $EMPTY_LIST)
|
||||
(else (if i32 (i32.eq $type (get_global $VECTOR_T))
|
||||
(get_global $EMPTY_VECTOR)
|
||||
(else (if i32 (i32.eq $type (get_global $HASHMAP_T))
|
||||
(get_global $EMPTY_HASHMAP)
|
||||
(else
|
||||
($THROW_STR_1 "read_seq invalid type %d" $type)
|
||||
0)))))))
|
||||
|
||||
($INC_REF $res)
|
||||
)
|
||||
@ -215,9 +209,8 @@
|
||||
(func $MAP_LOOP_UPDATE (param $type i32) (param $empty i32)
|
||||
(param $current i32) (param $val2 i32) (param $val3 i32)
|
||||
(result i32)
|
||||
(local $res i32)
|
||||
(LET $res ($ALLOC $type $empty $val2 $val3))
|
||||
|
||||
(set_local $res ($ALLOC $type $empty $val2 $val3))
|
||||
;; sequence took ownership
|
||||
($RELEASE $empty)
|
||||
($RELEASE $val2)
|
||||
@ -231,7 +224,7 @@
|
||||
)
|
||||
|
||||
(func $FORCE_SEQ_TYPE (param $type i32) (param $mv i32) (result i32)
|
||||
(local $res i32)
|
||||
(LET $res 0)
|
||||
;; if it's already the right type, inc ref cnt and return it
|
||||
(if (i32.eq $type ($TYPE $mv)) (return ($INC_REF $mv)))
|
||||
;; if it's empty, return the sequence match
|
||||
@ -247,17 +240,15 @@
|
||||
|
||||
(func $LIST2 (param $first i32 $second i32) (result i32)
|
||||
;; last element is empty list
|
||||
(local $tmp i32 $res i32)
|
||||
(set_local $tmp ($LIST (get_global $EMPTY_LIST) $second))
|
||||
(set_local $res ($LIST $tmp $first))
|
||||
(LET $tmp ($LIST (get_global $EMPTY_LIST) $second)
|
||||
$res ($LIST $tmp $first))
|
||||
($RELEASE $tmp) ;; new list takes ownership of previous
|
||||
$res
|
||||
)
|
||||
|
||||
(func $LIST3 (param $first i32 $second i32 $third i32) (result i32)
|
||||
(local $tmp i32 $res i32)
|
||||
(set_local $tmp ($LIST2 $second $third))
|
||||
(set_local $res ($LIST $tmp $first))
|
||||
(LET $tmp ($LIST2 $second $third)
|
||||
$res ($LIST $tmp $first))
|
||||
($RELEASE $tmp) ;; new list takes ownership of previous
|
||||
$res
|
||||
)
|
||||
@ -271,8 +262,7 @@
|
||||
)
|
||||
|
||||
(func $COUNT (param $mv i32) (result i32)
|
||||
(local $cnt i32)
|
||||
(set_local $cnt 0)
|
||||
(LET $cnt 0)
|
||||
(block $done
|
||||
(loop $loop
|
||||
(if (i32.eq ($VAL0 $mv) 0) (br $done))
|
||||
@ -285,7 +275,7 @@
|
||||
)
|
||||
|
||||
(func $LAST (param $mv i32) (result i32)
|
||||
(local $cur i32)
|
||||
(LET $cur 0)
|
||||
;; TODO: check that actually a list/vector
|
||||
(if (i32.eq ($VAL0 $mv) 0)
|
||||
;; empty seq, return nil
|
||||
@ -309,11 +299,10 @@
|
||||
;; set after to element following slice (or original)
|
||||
(func $SLICE (param $seq i32) (param $start i32) (param $end i32)
|
||||
(result i64)
|
||||
(local $idx i32 $res i32 $tmp i32 $last i32)
|
||||
(set_local $idx 0)
|
||||
(set_local $res ($INC_REF (get_global $EMPTY_LIST)))
|
||||
(set_local $last 0)
|
||||
(set_local $tmp $res)
|
||||
(LET $idx 0
|
||||
$res ($INC_REF (get_global $EMPTY_LIST))
|
||||
$last 0
|
||||
$tmp $res)
|
||||
;; advance seq to start
|
||||
(block $done
|
||||
(loop $loop
|
||||
@ -367,28 +356,25 @@
|
||||
)
|
||||
|
||||
(func $ASSOC1 (param $hm i32 $k i32 $v i32) (result i32)
|
||||
(local $res i32)
|
||||
(set_local $res ($ALLOC (get_global $HASHMAP_T) $hm $k $v))
|
||||
(LET $res ($ALLOC (get_global $HASHMAP_T) $hm $k $v))
|
||||
;; we took ownership of previous release
|
||||
($RELEASE $hm)
|
||||
$res
|
||||
)
|
||||
|
||||
(func $ASSOC1_S (param $hm i32 $k i32 $v i32) (result i32)
|
||||
(local $kmv i32 $res i32)
|
||||
(set_local $kmv ($STRING (get_global $STRING_T) $k))
|
||||
(set_local $res ($ASSOC1 $hm $kmv $v))
|
||||
(LET $kmv ($STRING (get_global $STRING_T) $k)
|
||||
$res ($ASSOC1 $hm $kmv $v))
|
||||
;; map took ownership of key
|
||||
($RELEASE $kmv)
|
||||
$res
|
||||
)
|
||||
|
||||
(func $HASHMAP_GET (param $hm i32) (param $key_mv i32) (result i64)
|
||||
(local $res i32 $found i32 $key i32 $test_key_mv i32)
|
||||
|
||||
(set_local $key ($to_String $key_mv))
|
||||
(set_local $found 0)
|
||||
|
||||
(LET $key ($to_String $key_mv)
|
||||
$found 0
|
||||
$res 0
|
||||
$test_key_mv 0)
|
||||
|
||||
(block $done
|
||||
(loop $loop
|
||||
|
||||
Loading…
Reference in New Issue
Block a user