- Convert sources to much more concise wam syntax supported by wamp.
- Rename sources from *.wast to *.wam and generate *.wast files by
translating via wamp.
elm/*.js
!elm/node_readline.js
!elm/bootstrap.js
-wasm/*.wat
+wasm/*.wast
wasm/*.wasm
-STEP0_DEPS = util.wast
-STEP1_DEPS = $(STEP0_DEPS) types.wast mem.wast debug.wast reader.wast printer.wast
-STEP2_DEPS = $(STEP1_DEPS)
-STEP3_DEPS = $(STEP2_DEPS) env.wast
-
-STEPS = step0_repl step1_read_print step2_eval step3_env \
- step4_if_fn_do step5_tco step6_file step7_quote \
- step8_macros step9_try stepA_mal
-
-all: $(foreach s,$(STEPS),$(s).wasm)
-
-%.wasm:
- ./wastpp.py $^ > $*.wat
- wasm-as $*.wat -o $@
-
-step0_repl.wasm: $(STEP0_DEPS) step0_repl.wast
-step1_read_print.wasm: $(STEP1_DEPS) step1_read_print.wast
-step2_eval.wasm: $(STEP2_DEPS) step2_eval.wast
-step3_env.wasm: $(STEP3_DEPS) step3_env.wast
-
-.PHONY: clean
-
-clean:
- rm -f *.wat *.wasm
+STEP0_DEPS = util.wam
+STEP1_DEPS = $(STEP0_DEPS) types.wam mem.wam debug.wam reader.wam printer.wam
+STEP2_DEPS = $(STEP1_DEPS)
+STEP3_DEPS = $(STEP2_DEPS) env.wam
+
+STEPS = step0_repl step1_read_print step2_eval step3_env \
+ step4_if_fn_do step5_tco step6_file step7_quote \
+ step8_macros step9_try stepA_mal
+
+all: $(foreach s,$(STEPS),$(s).wasm)
+
+%.wasm:
+ wamp $^ > $*.wast
+ wasm-as $*.wast -o $@
+
+step0_repl.wasm: $(STEP0_DEPS) step0_repl.wam
+step1_read_print.wasm: $(STEP1_DEPS) step1_read_print.wam
+step2_eval.wasm: $(STEP2_DEPS) step2_eval.wam
+step3_env.wasm: $(STEP3_DEPS) step3_env.wam
+
+.PHONY: clean
+
+clean:
+ rm -f *.wast *.wasm
--- /dev/null
+(module $debug
+
+ (func $PR_VALUE (param $fmt i32) (param $mv i32)
+ (local $temp i32)
+ (set_local $temp ($pr_str $mv))
+ ($printf_1 $fmt ($to_String $temp))
+ ($RELEASE $temp)
+ )
+
+ (func $PR_MEMORY_VALUE (param $idx i32) (result i32)
+ (local $mv i32)
+ (local $type i32)
+ (local $size i32)
+ (local $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))
+
+ ;;; printf(" %3d: type: %2d", idx, type)
+ ($printf_2 " 0x%x: type: %d" $idx $type)
+
+ (if (i32.eq $type 15)
+ (then
+ ;;; printf(", size: %2d", size)
+ ($printf_1 ", size: %d" $size))
+ (else
+ ;;; printf(", refs: %2d", (mv->refcnt_type - type)>>5)
+ ($printf_1 ", refs: %d" ($REFS $mv))))
+
+ ;;; printf(", [ %3d | %3d", mv->refcnt_type, val0)
+ ($printf_2 ", [ 0x%x | 0x%x" ($MalVal_refcnt_type $idx) $val0)
+
+ (if (i32.eq $size 2)
+ (then
+ ($print " | --- | --- ]"))
+ (else
+ ;;; printf(" | %3d", mv->val[1])
+ ($printf_1 " | 0x%x" ($MalVal_val $idx 1))
+ (if (i32.eq $size 3)
+ (then
+ ($print " | --- ]"))
+ (else
+ ;;; printf(" | %3d ]", mv->val[2])
+ ($printf_1 " | 0x%x ]" ($MalVal_val $idx 2))))))
+
+ ;;; printf(" >> ")
+ ($print " >> ")
+
+ (block $done (block $unknown
+ (block (block (block (block (block (block (block (block
+ (block (block (block (block (block (block (block (block
+ (br_table 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ $unknown $type))
+ ;; 0: nil
+ ($print "nil")
+ (br $done))
+ ;; 1: boolean
+ (if (i32.eq $val0 0)
+ ;; true
+ ($print "false")
+ ;; false
+ ($print "true"))
+ (br $done))
+ ;; 2: integer
+ ($printf_1 "%d" $val0)
+ (br $done))
+ ;; 3: float/ERROR
+ ($print " *** GOT FLOAT *** ")
+ (br $done))
+ ;; 4: string/kw
+ ($printf_1 "'%s'" ($to_String $mv))
+ (br $done))
+ ;; 5: symbol
+ ($print ($to_String $mv))
+ (br $done))
+ ;; 6: list
+ (if (i32.le_u $mv (get_global $EMPTY_HASHMAP))
+ (then
+ ($print "()"))
+ (else
+ ;;; printf("(... %d ...), next: %d\n", mv->val[1], mv->val[0])
+ ($printf_2 "(... 0x%x ...), next: 0x%x"
+ ($MalVal_val $idx 1)
+ ($MalVal_val $idx 0))))
+ (br $done))
+ ;; 7: vector
+ (if (i32.le_u $mv (get_global $EMPTY_HASHMAP))
+ (then
+ ($print "[]"))
+ (else
+ ;;; printf("[... %d ...], next: %d\n", mv->val[1], mv->val[0])val
+ ($printf_2 "[... %d ...], next: %d"
+ ($MalVal_val $idx 1)
+ ($MalVal_val $idx 0))))
+ (br $done))
+ ;; 8: hashmap
+ (if (i32.le_u $mv (get_global $EMPTY_HASHMAP))
+ (then
+ ($print "{}"))
+ (else
+ ;;; printf("{... '%s'(%d) : %d ...}\n",
+ ;; to_String(mem + mv->val[1]), mv->val[1], mv->val[2])
+ ($printf_3 "{... '%s'(%d) : %d ...}"
+ ($to_String ($MalVal_ptr ($MalVal_val $idx 1)))
+ ($MalVal_val $idx 1)
+ ($MalVal_val $idx 2))))
+ (br $done))
+ ;; 9: function
+ ($print "function")
+ (br $done))
+ ;; 10: mal function
+ ($print "mal function")
+ (br $done))
+ ;; 11: macro fn
+ ($print "macro fn")
+ (br $done))
+ ;; 12: atom
+ ($print "atom")
+ (br $done))
+ ;; 13: environment
+ ($print "environment")
+ (br $done))
+ ;; 14: metadata
+ ($print "metadata")
+ (br $done))
+ ;; 15: FREE
+ ($printf_1 "FREE next: 0x%x" $val0)
+ (if (i32.eq $idx (get_global $mem_free_list))
+ ($print " (free start)"))
+ (if (i32.eq $val0 (get_global $mem_unused_start))
+ ($print " (free end)"))
+ (br $done))
+ ;; 16: unknown
+ ($print "unknown")
+ )
+
+ (drop ($putchar 0xA))
+
+ (i32.add $size $idx)
+ )
+
+ (func $PR_MEMORY (param $start i32) (param $end i32)
+ (local $idx i32)
+ (if (i32.lt_s $start 0)
+ (set_local $start (get_global $mem_user_start)))
+ (if (i32.lt_s $end 0)
+ (set_local $end (get_global $mem_unused_start)))
+ ;;; printf("Values - (mem) showing %d -> %d", start, end)
+ ;;; printf(" (unused start: %d, free list: %d):\n",
+ ;;; mem_unused_start, mem_free_list)
+ ($printf_4 "Values - (mem) showing 0x%x -> 0x%x (unused start: 0x%x, free list: 0x%x):\n"
+ $start
+ $end
+ (get_global $mem_unused_start)
+ (get_global $mem_free_list))
+
+ (if (i32.le_s $end $start)
+ (then
+ ($print " ---\n")
+ (set_local $end (get_global $mem_unused_start)))
+ (else
+ (set_local $idx $start)
+ ;;; while (idx < end)
+ (block $loopvals_exit
+ (loop $loopvals
+ (if (i32.ge_s $idx $end)
+ (br $loopvals_exit))
+ (set_local $idx ($PR_MEMORY_VALUE $idx))
+ (br $loopvals)
+ )
+ )))
+ )
+
+ (func $PR_MEMORY_RAW (param $start i32) (param $end i32)
+ (block $loop_exit
+ (loop $loop
+ (if (i32.ge_u $start $end) (br $loop_exit))
+ ($printf_2 "0x%x 0x%x\n" $start (i32.load $start))
+ (set_local $start (i32.add 4 $start))
+ (br $loop)
+ )
+ )
+ )
+)
+++ /dev/null
-(module $debug
-
- (func $PR_VALUE (param $fmt i32) (param $mv i32)
- (local $temp i32)
- (set_local $temp (call $pr_str (get_local $mv)))
- (call $printf_1 (get_local $fmt) (call $to_String (get_local $temp)))
- (call $RELEASE (get_local $temp))
- )
-
- (func $PR_MEMORY_VALUE (param $idx i32) (result i32)
- (local $mv i32)
- (local $type i32)
- (local $size i32)
- (local $val0 i32)
- ;;; mv = mem + idx
- (set_local $mv (call $MalVal_ptr (get_local $idx)))
- (set_local $type (call $TYPE (get_local $mv)))
- (set_local $size (call $MalVal_size (get_local $mv)))
- (set_local $val0 (call $MalVal_val (get_local $idx) (i32.const 0)))
-
- ;;; printf(" %3d: type: %2d", idx, type)
- (call $printf_2 (STRING " 0x%x: type: %d")
- (get_local $idx) (get_local $type))
-
- (if (i32.eq (get_local $type) (i32.const 15))
- (then
- ;;; printf(", size: %2d", size)
- (call $printf_1 (STRING ", size: %d") (get_local $size)))
- (else
- ;;; printf(", refs: %2d", (mv->refcnt_type - type)>>5)
- (call $printf_1 (STRING ", refs: %d") (call $REFS (get_local $mv)))))
-
- ;;; printf(", [ %3d | %3d", mv->refcnt_type, val0)
- (call $printf_2 (STRING ", [ 0x%x | 0x%x")
- (call $MalVal_refcnt_type (get_local $idx))
- (get_local $val0))
-
- (if (i32.eq (get_local $size) (i32.const 2))
- (then
- (call $print (STRING " | --- | --- ]")))
- (else
- ;;; printf(" | %3d", mv->val[1])
- (call $printf_1 (STRING " | 0x%x")
- (call $MalVal_val (get_local $idx) (i32.const 1)))
- (if (i32.eq (get_local $size) (i32.const 3))
- (then
- (call $print (STRING " | --- ]")))
- (else
- ;;; printf(" | %3d ]", mv->val[2])
- (call $printf_1 (STRING " | 0x%x ]")
- (call $MalVal_val (get_local $idx) (i32.const 2)))))))
-
- ;;; printf(" >> ")
- (call $print (STRING " >> "))
-
- (block $done (block $unknown
- (block (block (block (block (block (block (block (block
- (block (block (block (block (block (block (block (block
- (br_table 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 $unknown (get_local $type)))
- ;; 0: nil
- (call $print (STRING "nil"))
- (br $done))
- ;; 1: boolean
- (if (i32.eq (get_local $val0) (i32.const 0))
- ;; true
- (call $print (STRING "false"))
- ;; false
- (call $print (STRING "true")))
- (br $done))
- ;; 2: integer
- (call $printf_1 (STRING "%d") (get_local $val0))
- (br $done))
- ;; 3: float/ERROR
- (call $print (STRING " *** GOT FLOAT *** "))
- (br $done))
- ;; 4: string/kw
- (call $printf_1 (STRING "'%s'") (call $to_String (get_local $mv)))
- (br $done))
- ;; 5: symbol
- (call $print (call $to_String (get_local $mv)))
- (br $done))
- ;; 6: list
- (if (i32.le_u (get_local $mv) (get_global $EMPTY_HASHMAP))
- (then
- (call $print (STRING "()")))
- (else
- ;;; printf("(... %d ...), next: %d\n", mv->val[1], mv->val[0])
- (call $printf_2 (STRING "(... 0x%x ...), next: 0x%x")
- (call $MalVal_val (get_local $idx) (i32.const 1))
- (call $MalVal_val (get_local $idx) (i32.const 0)))))
- (br $done))
- ;; 7: vector
- (if (i32.le_u (get_local $mv) (get_global $EMPTY_HASHMAP))
- (then
- (call $print (STRING "[]")))
- (else
- ;;; printf("[... %d ...], next: %d\n", mv->val[1], mv->val[0])val
- (call $printf_2 (STRING "[... %d ...], next: %d")
- (call $MalVal_val (get_local $idx) (i32.const 1))
- (call $MalVal_val (get_local $idx) (i32.const 0)))))
- (br $done))
- ;; 8: hashmap
- (if (i32.le_u (get_local $mv) (get_global $EMPTY_HASHMAP))
- (then
- (call $print (STRING "{}")))
- (else
- ;;; printf("{... '%s'(%d) : %d ...}\n",
- ;; to_String(mem + mv->val[1]), mv->val[1], mv->val[2])
- (call $printf_3 (STRING "{... '%s'(%d) : %d ...}")
- (call $to_String
- (call $MalVal_ptr
- (call $MalVal_val (get_local $idx) (i32.const 1))))
- (call $MalVal_val (get_local $idx) (i32.const 1))
- (call $MalVal_val (get_local $idx) (i32.const 2)))))
- (br $done))
- ;; 9: function
- (call $print (STRING "function"))
- (br $done))
- ;; 10: mal function
- (call $print (STRING "mal function"))
- (br $done))
- ;; 11: macro fn
- (call $print (STRING "macro fn"))
- (br $done))
- ;; 12: atom
- (call $print (STRING "atom"))
- (br $done))
- ;; 13: environment
- (call $print (STRING "environment"))
- (br $done))
- ;; 14: metadata
- (call $print (STRING "metadata"))
- (br $done))
- ;; 15: FREE
- (call $printf_1 (STRING "FREE next: 0x%x") (get_local $val0))
- (if (i32.eq (get_local $idx) (get_global $mem_free_list))
- (call $print (STRING " (free start)")))
- (if (i32.eq (get_local $val0) (get_global $mem_unused_start))
- (call $print (STRING " (free end)")))
- (br $done))
- ;; 16: unknown
- (call $print (STRING "unknown"))
- )
-
- (drop (call $putchar (i32.const 0xA)))
-
- (i32.add (get_local $size) (get_local $idx))
- )
-
- (func $PR_MEMORY (param $start i32) (param $end i32)
- (local $idx i32)
- (if (i32.lt_s (get_local $start) (i32.const 0))
- (set_local $start (get_global $mem_user_start)))
- (if (i32.lt_s (get_local $end) (i32.const 0))
- (set_local $end (get_global $mem_unused_start)))
- ;;; printf("Values - (mem) showing %d -> %d", start, end)
- ;;; printf(" (unused start: %d, free list: %d):\n",
- ;;; mem_unused_start, mem_free_list)
- (call $printf_4 (STRING "Values - (mem) showing 0x%x -> 0x%x (unused start: 0x%x, free list: 0x%x):\n")
- (get_local $start)
- (get_local $end)
- (get_global $mem_unused_start)
- (get_global $mem_free_list))
-
- (if (i32.le_s (get_local $end) (get_local $start))
- (then
- (call $print (STRING " ---\n"))
- (set_local $end (get_global $mem_unused_start)))
- (else
- (set_local $idx (get_local $start))
- ;;; while (idx < end)
- (block $loopvals_exit
- (loop $loopvals
- (if (i32.ge_s (get_local $idx) (get_local $end))
- (br $loopvals_exit))
- (set_local $idx (call $PR_MEMORY_VALUE (get_local $idx)))
- (br $loopvals)
- )
- )))
- )
-
- (func $PR_MEMORY_RAW (param $start i32) (param $end i32)
- (block $loop_exit
- (loop $loop
- (if (i32.ge_u (get_local $start) (get_local $end))
- (br $loop_exit))
- (call $printf_2 (STRING "0x%x 0x%x\n")
- (get_local $start) (i32.load (get_local $start)))
- (set_local $start (i32.add (i32.const 4) (get_local $start)))
- (br $loop)
- )
- )
- )
-)
--- /dev/null
+(module $env
+
+ (func $ENV_NEW (param $outer i32) (result i32)
+ (local $data i32)
+ (local $env i32)
+
+ ;; allocate the data hashmap
+ (set_local $data ($HASHMAP))
+
+ (set_local $env ($ALLOC (get_global $ENVIRONMENT_T) $data $outer 0))
+ ;; environment takes ownership
+ ($RELEASE $data)
+ $env
+ )
+
+ (func $ENV_SET (param $env i32) (param $key i32) (param $value i32)
+ (result i32)
+ (local $data i32)
+ (set_local $data ($MEM_VAL0_ptr $env))
+ (i32.store ($VAL0_ptr $env) ($MalVal_index ($ASSOC1 $data $key $value)))
+ $value
+ )
+
+ (func $ENV_SET_S (param $env i32) (param $key i32) (param $value i32)
+ (result i32)
+ (local $data i32)
+ (set_local $data ($MEM_VAL0_ptr $env))
+ (i32.store ($VAL0_ptr $env) ($MalVal_index ($ASSOC1_S $data $key $value)))
+ $value
+ )
+
+ (func $ENV_FIND (param $env i32) (param $key i32) (result i64)
+ (local $res i32)
+ (local $data i32)
+ (local $found_res i64)
+
+ (set_local $res 0)
+
+ (block $done
+ (loop $loop
+ (set_local $data ($MEM_VAL0_ptr $env))
+ (set_local $found_res ($HASHMAP_GET $data
+ $key))
+ ;;; if (found)
+ (if (i32.wrap/i64 (i64.shr_u $found_res (i64.const 32)))
+ (then
+ (set_local $res (i32.wrap/i64 $found_res))
+ (br $done)))
+ (set_local $env ($MEM_VAL1_ptr $env))
+ (if (i32.eq $env (get_global $NIL))
+ (then
+ (set_local $env 0)
+ (br $done)))
+ (br $loop)
+ )
+ )
+
+ ;; combine res/env as hi 32/low 32 of i64
+ (i64.or
+ (i64.shl_u (i64.extend_u/i32 $res) (i64.const 32))
+ (i64.extend_u/i32 $env))
+ )
+
+ (func $ENV_GET (param $env i32) (param $key i32) (result i32)
+ (local $res i32)
+ (local $res_env i64)
+ (set_local $res 0)
+
+ (set_local $res_env ($ENV_FIND $env $key))
+ (set_local $env (i32.wrap/i64 $res_env))
+ (set_local $res (i32.wrap/i64 (i64.shr_u $res_env (i64.const 32))))
+
+ (if (i32.eqz $env)
+ (then
+ ($THROW_STR_1 "'%s' not found" ($to_String $key))
+ (return $res)))
+ (return ($INC_REF $res))
+ )
+)
+++ /dev/null
-(module $env
-
- (func $ENV_NEW (param $outer i32) (result i32)
- (local $data i32)
- (local $env i32)
-
- ;; allocate the data hashmap
- (set_local $data (call $HASHMAP))
-
- (set_local $env (call $ALLOC (get_global $ENVIRONMENT_T)
- (get_local $data) (get_local $outer) (i32.const 0)))
- ;; environment takes ownership
- (call $RELEASE (get_local $data))
- (get_local $env)
- )
-
- (func $ENV_SET (param $env i32) (param $key i32) (param $value i32)
- (result i32)
- (local $data i32)
- (set_local $data (call $MEM_VAL0_ptr (get_local $env)))
- (i32.store (call $VAL0_ptr (get_local $env))
- (call $MalVal_index
- (call $ASSOC1 (get_local $data)
- (get_local $key) (get_local $value))))
- (get_local $value)
- )
-
- (func $ENV_SET_S (param $env i32) (param $key i32) (param $value i32)
- (result i32)
- (local $data i32)
- (set_local $data (call $MEM_VAL0_ptr (get_local $env)))
- (i32.store (call $VAL0_ptr (get_local $env))
- (call $MalVal_index
- (call $ASSOC1_S (get_local $data)
- (get_local $key) (get_local $value))))
- (get_local $value)
- )
-
- (func $ENV_FIND (param $env i32) (param $key i32) (result i64)
- (local $res i32)
- (local $data i32)
- (local $found_res i64)
-
- (set_local $res (i32.const 0))
-
- (block $done
- (loop $loop
- (set_local $data (call $MEM_VAL0_ptr (get_local $env)))
- (set_local $found_res (call $HASHMAP_GET (get_local $data)
- (get_local $key)))
- ;;; if (found)
- (if (i32.wrap/i64 (i64.shr_u (get_local $found_res)
- (i64.const 32)))
- (then
- (set_local $res (i32.wrap/i64 (get_local $found_res)))
- (br $done)))
- (set_local $env (call $MEM_VAL1_ptr (get_local $env)))
- (if (i32.eq (get_local $env) (get_global $NIL))
- (then
- (set_local $env (i32.const 0))
- (br $done)))
- (br $loop)
- )
- )
-
- ;; combine res/env as hi 32/low 32 of i64
- (i64.or
- (i64.shl_u (i64.extend_u/i32 (get_local $res))
- (i64.const 32))
- (i64.extend_u/i32 (get_local $env)))
- )
-
- (func $ENV_GET (param $env i32) (param $key i32) (result i32)
- (local $res i32)
- (local $res_env i64)
- (set_local $res (i32.const 0))
-
- (set_local $res_env (call $ENV_FIND (get_local $env) (get_local $key)))
- (set_local $env (i32.wrap/i64 (get_local $res_env)))
- (set_local $res (i32.wrap/i64 (i64.shr_u (get_local $res_env)
- (i64.const 32))))
-
- (if (i32.eqz (get_local $env))
- (then
- (call $THROW_STR_1 (STRING "'%s' not found")
- (call $to_String (get_local $key)))
- (return (get_local $res))))
- (return (call $INC_REF (get_local $res)))
- )
-)
--- /dev/null
+(module $mem
+ (global $MEM_SIZE i32 1048576)
+ (global $STRING_MEM_SIZE i32 1048576)
+
+ (global $heap_start (mut i32) 0)
+ (global $heap_end (mut i32) 0)
+
+ (global $mem (mut i32) 0)
+ (global $mem_unused_start (mut i32) 0)
+ (global $mem_free_list (mut i32) 0)
+ (global $mem_user_start (mut i32) 0)
+
+;; (global $string_mem (mut i32) 0)
+;; (global $string_mem_next (mut i32) 0)
+;; (global $string_mem_user_start (mut i32) 0)
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; General type storage/pointer functions
+
+ (func $VAL0_ptr (param $mv i32) (result i32)
+ (i32.add $mv 4))
+ (func $VAL1_ptr (param $mv i32) (result i32)
+ (i32.add $mv 8))
+
+ (func $VAL0 (param $mv i32) (result i32)
+ (i32.load (i32.add $mv 4)))
+ (func $VAL1 (param $mv i32) (result i32)
+ (i32.load (i32.add $mv 8)))
+
+
+ (func $MEM_VAL0_ptr (param $mv i32) (result i32)
+ (i32.add (get_global $mem)
+ (i32.mul_u (i32.load (i32.add $mv 4)) 8)))
+ (func $MEM_VAL1_ptr (param $mv i32) (result i32)
+ (i32.add (get_global $mem)
+ (i32.mul_u (i32.load (i32.add $mv 8)) 8)))
+ (func $MEM_VAL2_ptr (param $mv i32) (result i32)
+ (i32.add (get_global $mem)
+ (i32.mul_u (i32.load (i32.add $mv 12)) 8)))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ ;; Returns the address of 'mem[mv_idx]'
+ (func $MalVal_ptr (param $mv_idx i32) (result i32)
+ ;; MalVal memory 64 bit (2 * i32) aligned
+ ;;; mem[mv_idx].refcnt_type
+ (i32.add (get_global $mem) (i32.mul_u $mv_idx 8)))
+
+ ;; Returns the memory index mem of mv
+ ;; Will usually be used with a load or store by the caller
+ (func $MalVal_index (param $mv i32) (result i32)
+ ;; MalVal memory 64 bit (2 * i32) aligned
+ (i32.div_u (i32.sub_u $mv (get_global $mem)) 8))
+
+ ;; Returns the address of 'mem[mv_idx].refcnt_type'
+ (func $MalVal_refcnt_type (param $mv_idx i32) (result i32)
+ (i32.load ($MalVal_ptr $mv_idx)))
+
+ (func $TYPE (param $mv i32) (result i32)
+ ;;; type = mv->refcnt_type & 31
+ (i32.and (i32.load $mv) 0x1f)) ;; 0x1f == 31
+
+ (func $REFS (param $mv i32) (result i32)
+ ;;; type = mv->refcnt_type & 31
+ (i32.shr_u (i32.load $mv) 5)) ;; / 32
+
+ ;; Returns the address of 'mem[mv_idx].val[val]'
+ ;; Will usually be used with a load or store by the caller
+ (func $MalVal_val_ptr (param $mv_idx i32) (param $val i32) (result i32)
+ (i32.add (i32.add ($MalVal_ptr $mv_idx) 4)
+ (i32.mul_u $val 4)))
+
+ ;; Returns the value of 'mem[mv_idx].val[val]'
+ (func $MalVal_val (param $mv_idx i32) (param $val i32) (result i32)
+ (i32.load ($MalVal_val_ptr $mv_idx $val)))
+
+ (func $MalType_size (param $type i32) (result i32)
+ ;;; if (type <= 5 || type == 9 || type == 12)
+ (if i32 (i32.or (i32.le_u $type 5)
+ (i32.or (i32.eq $type 9)
+ (i32.eq $type 12)))
+ (then 2)
+ (else
+ ;;; else if (type == 8 || type == 10 || type == 11)
+ (if i32 (i32.or (i32.eq $type 8)
+ (i32.or (i32.eq $type 10)
+ (i32.eq $type 11)))
+ (then 4)
+ (else 3)))))
+
+ (func $MalVal_size (param $mv i32) (result i32)
+ (local $type i32)
+ (set_local $type ($TYPE $mv))
+ ;; if (type == FREE_T)
+ (if i32 (i32.eq $type (get_global $FREE_T))
+ (then
+ ;;; return (mv->refcnt_type & 0xffe0)>>5
+ (i32.shr_u (i32.and (i32.load $mv) 0xffe0) 5)) ;;; / 32
+ (else
+ ;;; return MalType_size(type)
+ ($MalType_size $type))))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; init_memory
+
+ (func $init_memory
+ (local $heap_size i32)
+
+;; ($print ">>> init_memory\n")
+
+ ($init_sprintf_mem)
+
+ ;; 100 character error_str static buffer
+ (set_global $error_str " ")
+ ;; 256 character token static buffer
+ (set_global $token " ")
+
+ (set_local $heap_size (i32.add (get_global $MEM_SIZE)
+ (get_global $STRING_MEM_SIZE)))
+ (set_global $heap_start (i32.add (get_global $memoryBase)
+ (get_global $S_STRING_END)))
+ (set_global $heap_end (i32.add (get_global $heap_start)
+ $heap_size))
+
+ (set_global $mem (get_global $heap_start))
+ (set_global $mem_unused_start 0)
+ (set_global $mem_free_list 0)
+
+;; (set_global $string_mem (i32.add (get_global $heap_start)
+;; (get_global $MEM_SIZE)))
+;; (set_global $string_mem_next (get_global $string_mem))
+
+ ;; Empty values
+ (set_global $NIL
+ ($ALLOC_SCALAR (get_global $NIL_T) 0))
+ (set_global $FALSE
+ ($ALLOC_SCALAR (get_global $BOOLEAN_T) 0))
+ (set_global $TRUE
+ ($ALLOC_SCALAR (get_global $BOOLEAN_T) 1))
+ (set_global $EMPTY_LIST
+ ($ALLOC (get_global $LIST_T)
+ (get_global $NIL) (get_global $NIL) (get_global $NIL)))
+ (set_global $EMPTY_VECTOR
+ ($ALLOC (get_global $VECTOR_T)
+ (get_global $NIL) (get_global $NIL) (get_global $NIL)))
+ (set_global $EMPTY_HASHMAP
+ ($ALLOC (get_global $HASHMAP_T)
+ (get_global $NIL) (get_global $NIL) (get_global $NIL)))
+
+;; ($print "<<< init_memory\n")
+
+ )
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; memory management
+
+ (func $ALLOC_INTERNAL (param $type i32) (param $val1 i32)
+ (param $val2 i32) (param $val3 i32) (result i32)
+ (local $prev i32)
+ (local $res i32)
+ (local $size i32)
+ (set_local $prev (get_global $mem_free_list))
+ (set_local $res (get_global $mem_free_list))
+ (set_local $size ($MalType_size $type))
+
+ (block $loop_done
+ (loop $loop
+ ;; res == mem_unused_start
+ (if (i32.eq $res (get_global $mem_unused_start))
+ (then
+ ;; ALLOC_UNUSED
+ ;;; if (res + size > MEM_SIZE)
+ (if (i32.gt_u (i32.add $res $size) (get_global $MEM_SIZE))
+ (then
+ ;; Out of memory, exit
+ ($print "Out of mal memory!\n")
+ ($exit 1)))
+ ;;; if (mem_unused_start += size)
+ (set_global $mem_unused_start
+ (i32.add (get_global $mem_unused_start) $size))
+ ;;; if (prev == res)
+ (if (i32.eq $prev $res)
+ (then
+ (set_global $mem_free_list (get_global $mem_unused_start)))
+ (else
+ ;;; mem[prev].val[0] = mem_unused_start
+ (i32.store
+ ($MalVal_val_ptr $prev 0)
+ (get_global $mem_unused_start))))
+ (br $loop_done)))
+ ;; if (MalVal_size(mem+res) == size)
+ (if (i32.eq ($MalVal_size ($MalVal_ptr $res))
+ $size)
+ (then
+ ;; ALLOC_MIDDLE
+ ;;; if (res == mem_free_list)
+ (if (i32.eq $res (get_global $mem_free_list))
+ ;; set free pointer (mem_free_list) to next free
+ ;;; mem_free_list = mem[res].val[0];
+ (set_global $mem_free_list ($MalVal_val $res 0)))
+ ;; if (res != mem_free_list)
+ (if (i32.ne $res (get_global $mem_free_list))
+ ;; set previous free to next free
+ ;;; mem[prev].val[0] = mem[res].val[0]
+ (i32.store ($MalVal_val_ptr $prev 0) ($MalVal_val $res 0)))
+ (br $loop_done)))
+ ;;; prev = res
+ (set_local $prev $res)
+ ;;; res = mem[res].val[0]
+ (set_local $res ($MalVal_val $res 0))
+ (br $loop)
+ )
+ )
+ ;; ALLOC_DONE
+ ;;; mem[res].refcnt_type = type + 32
+ (i32.store ($MalVal_ptr $res) (i32.add $type 32))
+ ;; set val to default val1
+ ;;; mem[res].val[0] = val1
+ (i32.store ($MalVal_val_ptr $res 0) $val1)
+ ;;; if (type > 5 && type != 9)
+ (if (i32.and (i32.gt_u $type 5) (i32.ne $type 9))
+ (then
+ ;; inc refcnt of referenced value
+ ;;; mem[val1].refcnt_type += 32
+ (i32.store ($MalVal_ptr $val1)
+ (i32.add ($MalVal_refcnt_type $val1) 32))))
+ ;;; if (size > 2)
+ (if (i32.gt_u $size 2)
+ (then
+ ;; inc refcnt of referenced value
+ ;;; mem[val2].refcnt_type += 32
+ (i32.store ($MalVal_ptr $val2)
+ (i32.add ($MalVal_refcnt_type $val2) 32))
+ ;;; mem[res].val[1] = val2
+ (i32.store ($MalVal_val_ptr $res 1) $val2)))
+ ;;; if (size > 3)
+ (if (i32.gt_u $size 3)
+ (then
+ ;; inc refcnt of referenced value
+ ;;; mem[val3].refcnt_type += 32
+ (i32.store ($MalVal_ptr $val3)
+ (i32.add ($MalVal_refcnt_type $val3) 32))
+ ;;; mem[res].val[2] = val3
+ (i32.store ($MalVal_val_ptr $res 2) $val3)))
+
+ ;;; return mem + res
+ ($MalVal_ptr $res)
+ )
+
+ (func $ALLOC_SCALAR (param $type i32) (param $val1 i32) (result i32)
+ ($ALLOC_INTERNAL $type $val1 0 0)
+ )
+
+ (func $ALLOC (param $type i32) (param $val1 i32)
+ (param $val2 i32) (param $val3 i32) (result i32)
+ ($ALLOC_INTERNAL $type
+ ($MalVal_index $val1)
+ ($MalVal_index $val2)
+ ($MalVal_index $val3))
+ )
+
+ (func $RELEASE (param $mv i32)
+ (local $idx i32)
+ (local $type i32)
+ (local $size i32)
+
+ ;; Ignore NULLs
+ ;;; if (mv == NULL) { return; }
+ (if (i32.eqz $mv) (return))
+ ;;; idx = mv - mem
+ (set_local $idx ($MalVal_index $mv))
+ ;;; type = mv->refcnt_type & 31
+ (set_local $type (i32.and (i32.load $mv) 0x1f)) ;; 0x1f == 31
+ ;;; size = MalType_size(type)
+ (set_local $size ($MalType_size $type))
+
+ ;; DEBUG
+ ;;; printf(">>> RELEASE idx: %d, type: %d, size: %d\n", idx, type, size)
+
+ (if (i32.eq 0 $mv)
+ (then
+ ($print "RELEASE of NULL!\n")
+ ($exit 1)))
+
+ (if (i32.eq (get_global $FREE_T) $type)
+ (then
+ ($printf_2 "RELEASE of already free mv: 0x%x, idx: 0x%x\n" $mv $idx)
+ ($exit 1)))
+ (if (i32.lt_u ($MalVal_refcnt_type $idx) 15)
+ (then
+ ($printf_2 "RELEASE of unowned mv: 0x%x, idx: 0x%x\n" $mv $idx)
+ ($exit 1)))
+
+ ;; decrease reference count by one
+ (i32.store ($MalVal_ptr $idx)
+ (i32.sub_u ($MalVal_refcnt_type $idx) 32))
+
+ ;; nil, false, true, empty sequences
+ (if (i32.le_u $mv (get_global $EMPTY_HASHMAP))
+ (then
+ (if (i32.lt_u ($MalVal_refcnt_type $idx) 32)
+ (then
+ ($printf_2 "RELEASE of unowned mv: 0x%x, idx: 0x%x\n" $mv $idx)
+ ($exit 1)))
+ (return)))
+
+ ;; our reference count is not 0, so don't release
+ (if (i32.ge_u ($MalVal_refcnt_type $idx) 32)
+ (return))
+
+ (block $done
+ (block (block (block (block (block (block
+ (br_table 0 0 0 0 1 1 2 2 3 5 5 5 5 4 5 5 5 $type))
+ ;; nil, boolean, integer, float
+ (br $done))
+ ;; string, kw, symbol
+ ;; release string, then FREE reference
+ ($RELEASE_STRING $mv)
+ (br $done))
+ ;; list, vector
+ (if (i32.ne ($MalVal_val $idx 0) 0)
+ (then
+ ;; release next element and value
+ ($RELEASE ($MEM_VAL0_ptr $mv))
+ ($RELEASE ($MEM_VAL1_ptr $mv))))
+ (br $done))
+ ;; hashmap
+ (if (i32.ne ($MalVal_val $idx 0) 0)
+ (then
+ ;; release next element, value, and key
+ ($RELEASE ($MEM_VAL0_ptr $mv))
+ ($RELEASE ($MEM_VAL2_ptr $mv))
+ ($RELEASE ($MEM_VAL1_ptr $mv))))
+ (br $done))
+ ;; env
+ ;; if outer is set then release outer
+ (if (i32.ne ($MalVal_val $idx 1) 0)
+ ($RELEASE ($MEM_VAL1_ptr $mv)))
+ ;; release the hashmap data
+ ($RELEASE ($MEM_VAL0_ptr $mv))
+ (br $done))
+ ;; default/unknown
+ )
+
+ ;; FREE, free the current element
+
+ ;; set type(FREE/15) and size
+ ;;; mv->refcnt_type = size*32 + FREE_T
+ (i32.store $mv (i32.add (i32.mul_u $size 32) (get_global $FREE_T)))
+ (i32.store ($MalVal_val_ptr $idx 0) (get_global $mem_free_list))
+ (set_global $mem_free_list $idx)
+ (if (i32.ge_u $size 3) (i32.store ($MalVal_val_ptr $idx 1) 0))
+ (if (i32.eq $size 4) (i32.store ($MalVal_val_ptr $idx 2) 0))
+ )
+
+ ;; Allocate a string as follows:
+ ;; refcnt (i32 set to 1), string data, NULL byte
+ (func $STRING_DUPE (param $str i32) (result i32)
+ (local $len i32)
+ (local $cur i32)
+ (local $new i32)
+ (local $idx i32)
+
+ ;; Calculate length of string needed
+ (set_local $len ($STRING_LEN $str))
+
+ ;; leading i32 refcnt + trailing NULL
+ (set_local $new ($malloc (i32.add 5 $len)))
+
+ ;; set initial refcnt to 1
+ (i32.store $new 1)
+ ;; skip refcnt
+ (set_local $cur (i32.add $new 4))
+ ;; Set NULL terminator
+ (i32.store8_u (i32.add $cur $len) 0)
+
+ ;; Copy the characters
+ ($MEM_COPY $cur $str $len)
+ $new
+ )
+
+ ;; Duplicate regular character array string into a Mal string and
+ ;; return the MalVal pointer
+ (func $STRING (param $type i32) (param $str i32) (result i32)
+ ($ALLOC_SCALAR
+ $type
+ ($STRING_DUPE $str))
+ )
+
+ (func $RELEASE_STRING (param $mv i32)
+ (local $str i32)
+ (set_local $str ($MalVal_val
+ ($MalVal_index $mv)
+ 0))
+
+ ;; DEBUG
+;; ($printf_1 "RELEASE_STRING - calling free on: %d" $str)
+
+ ($free $str)
+ )
+)
+++ /dev/null
-(module $mem
- (global $MEM_SIZE i32 (i32.const 1048576))
- (global $STRING_MEM_SIZE i32 (i32.const 1048576))
-
- (global $heap_start (mut i32) (i32.const 0))
- (global $heap_end (mut i32) (i32.const 0))
-
- (global $mem (mut i32) (i32.const 0))
- (global $mem_unused_start (mut i32) (i32.const 0))
- (global $mem_free_list (mut i32) (i32.const 0))
- (global $mem_user_start (mut i32) (i32.const 0))
-
-;; (global $string_mem (mut i32) (i32.const 0))
-;; (global $string_mem_next (mut i32) (i32.const 0))
-;; (global $string_mem_user_start (mut i32) (i32.const 0))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; General type storage/pointer functions
-
- (func $VAL0_ptr (param $mv i32) (result i32)
- (i32.add (get_local $mv) (i32.const 4)))
- (func $VAL1_ptr (param $mv i32) (result i32)
- (i32.add (get_local $mv) (i32.const 8)))
-
- (func $VAL0 (param $mv i32) (result i32)
- (i32.load (i32.add (get_local $mv) (i32.const 4))))
- (func $VAL1 (param $mv i32) (result i32)
- (i32.load (i32.add (get_local $mv) (i32.const 8))))
-
-
- (func $MEM_VAL0_ptr (param $mv i32) (result i32)
- (i32.add (get_global $mem)
- (i32.mul_u (i32.load (i32.add (get_local $mv) (i32.const 4)))
- (i32.const 8))))
- (func $MEM_VAL1_ptr (param $mv i32) (result i32)
- (i32.add (get_global $mem)
- (i32.mul_u (i32.load (i32.add (get_local $mv) (i32.const 8)))
- (i32.const 8))))
- (func $MEM_VAL2_ptr (param $mv i32) (result i32)
- (i32.add (get_global $mem)
- (i32.mul_u (i32.load (i32.add (get_local $mv) (i32.const 12)))
- (i32.const 8))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;; Returns the address of 'mem[mv_idx]'
- (func $MalVal_ptr (param $mv_idx i32) (result i32)
- ;; MalVal memory 64 bit (2 * i32) aligned
- ;;; mem[mv_idx].refcnt_type
- (i32.add (get_global $mem)
- (i32.mul_u (get_local $mv_idx) (i32.const 8))))
-
- ;; Returns the memory index mem of mv
- ;; Will usually be used with a load or store by the caller
- (func $MalVal_index (param $mv i32) (result i32)
- ;; MalVal memory 64 bit (2 * i32) aligned
- (i32.div_u (i32.sub_u (get_local $mv) (get_global $mem))
- (i32.const 8)))
-
- ;; Returns the address of 'mem[mv_idx].refcnt_type'
- (func $MalVal_refcnt_type (param $mv_idx i32) (result i32)
- (i32.load (call $MalVal_ptr (get_local $mv_idx))))
-
- (func $TYPE (param $mv i32) (result i32)
- ;;; type = mv->refcnt_type & 31
- (i32.and (i32.load (get_local $mv))
- (i32.const 0x1f))) ;; 0x1f == 31
-
- (func $REFS (param $mv i32) (result i32)
- ;;; type = mv->refcnt_type & 31
- (i32.shr_u (i32.load (get_local $mv))
- (i32.const 5))) ;; / 32
-
- ;; Returns the address of 'mem[mv_idx].val[val]'
- ;; Will usually be used with a load or store by the caller
- (func $MalVal_val_ptr (param $mv_idx i32) (param $val i32) (result i32)
- (i32.add (i32.add (call $MalVal_ptr (get_local $mv_idx))
- (i32.const 4))
- (i32.mul_u (get_local $val)
- (i32.const 4))))
-
- ;; Returns the value of 'mem[mv_idx].val[val]'
- (func $MalVal_val (param $mv_idx i32) (param $val i32) (result i32)
- (i32.load (call $MalVal_val_ptr (get_local $mv_idx) (get_local $val))))
-
- (func $MalType_size (param $type i32) (result i32)
- ;;; if (type <= 5 || type == 9 || type == 12)
- (if i32 (i32.or (i32.le_u (get_local $type) (i32.const 5))
- (i32.or (i32.eq (get_local $type) (i32.const 9))
- (i32.eq (get_local $type) (i32.const 12))))
- (then (i32.const 2))
- (else
- ;;; else if (type == 8 || type == 10 || type == 11)
- (if i32 (i32.or (i32.eq (get_local $type) (i32.const 8))
- (i32.or (i32.eq (get_local $type) (i32.const 10))
- (i32.eq (get_local $type) (i32.const 11))))
- (then (i32.const 4))
- (else (i32.const 3))))))
-
- (func $MalVal_size (param $mv i32) (result i32)
- (local $type i32)
- (set_local $type (call $TYPE (get_local $mv)))
- ;; if (type == FREE_T)
- (if i32 (i32.eq (get_local $type) (get_global $FREE_T))
- (then
- ;;; return (mv->refcnt_type & 0xffe0)>>5
- (i32.shr_u
- (i32.and
- (i32.load (get_local $mv))
- (i32.const 0xffe0))
- (i32.const 5))) ;;; / 32
- (else
- ;;; return MalType_size(type)
- (call $MalType_size (get_local $type)))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; init_memory
-
- (func $init_memory
- (local $heap_size i32)
-
-;; (call $print (STRING ">>> init_memory\n"))
-
- (call $init_sprintf_mem)
-
- ;; 100 character error_str static buffer
- (set_global $error_str (STRING " "))
- ;; 256 character token static buffer
- (set_global $token (STRING " "))
-
- (set_local $heap_size (i32.add (get_global $MEM_SIZE)
- (get_global $STRING_MEM_SIZE)))
- (set_global $heap_start (i32.add (get_global $memoryBase)
- (get_global $S_STRING_END)))
- (set_global $heap_end (i32.add (get_global $heap_start)
- (get_local $heap_size)))
-
- (set_global $mem (get_global $heap_start))
- (set_global $mem_unused_start (i32.const 0))
- (set_global $mem_free_list (i32.const 0))
-
-;; (set_global $string_mem (i32.add (get_global $heap_start)
-;; (get_global $MEM_SIZE)))
-;; (set_global $string_mem_next (get_global $string_mem))
-
- ;; Empty values
- (set_global $NIL
- (call $ALLOC_SCALAR (get_global $NIL_T) (i32.const 0)))
- (set_global $FALSE
- (call $ALLOC_SCALAR (get_global $BOOLEAN_T) (i32.const 0)))
- (set_global $TRUE
- (call $ALLOC_SCALAR (get_global $BOOLEAN_T) (i32.const 1)))
- (set_global $EMPTY_LIST
- (call $ALLOC (get_global $LIST_T)
- (get_global $NIL) (get_global $NIL) (get_global $NIL)))
- (set_global $EMPTY_VECTOR
- (call $ALLOC (get_global $VECTOR_T)
- (get_global $NIL) (get_global $NIL) (get_global $NIL)))
- (set_global $EMPTY_HASHMAP
- (call $ALLOC (get_global $HASHMAP_T)
- (get_global $NIL) (get_global $NIL) (get_global $NIL)))
-
-;; (call $print (STRING "<<< init_memory\n"))
-
- )
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; memory management
-
- (func $ALLOC_INTERNAL (param $type i32) (param $val1 i32)
- (param $val2 i32) (param $val3 i32) (result i32)
- (local $prev i32)
- (local $res i32)
- (local $size i32)
- (set_local $prev (get_global $mem_free_list))
- (set_local $res (get_global $mem_free_list))
- (set_local $size (call $MalType_size (get_local $type)))
-
- (block $loop_done
- (loop $loop
- ;; res == mem_unused_start
- (if (i32.eq (get_local $res) (get_global $mem_unused_start))
- (then
- ;; ALLOC_UNUSED
- ;;; if (res + size > MEM_SIZE)
- (if (i32.gt_u (i32.add (get_local $res) (get_local $size))
- (get_global $MEM_SIZE))
- (then
- ;; Out of memory, exit
- (call $print (STRING "Out of mal memory!\n"))
- (call $exit (i32.const 1))))
- ;;; if (mem_unused_start += size)
- (set_global $mem_unused_start
- (i32.add (get_global $mem_unused_start)
- (get_local $size)))
- ;;; if (prev == res)
- (if (i32.eq (get_local $prev) (get_local $res))
- (then
- (set_global $mem_free_list (get_global $mem_unused_start)))
- (else
- ;;; mem[prev].val[0] = mem_unused_start
- (i32.store
- (call $MalVal_val_ptr (get_local $prev) (i32.const 0))
- (get_global $mem_unused_start))))
- (br $loop_done)))
- ;; if (MalVal_size(mem+res) == size)
- (if (i32.eq (call $MalVal_size (call $MalVal_ptr (get_local $res)))
- (get_local $size))
- (then
- ;; ALLOC_MIDDLE
- ;;; if (res == mem_free_list)
- (if (i32.eq (get_local $res) (get_global $mem_free_list))
- ;; set free pointer (mem_free_list) to next free
- ;;; mem_free_list = mem[res].val[0];
- (set_global $mem_free_list
- (call $MalVal_val (get_local $res) (i32.const 0))))
- ;; if (res != mem_free_list)
- (if (i32.ne (get_local $res) (get_global $mem_free_list))
- ;; set previous free to next free
- ;;; mem[prev].val[0] = mem[res].val[0]
- (i32.store (call $MalVal_val_ptr (get_local $prev) (i32.const 0))
- (call $MalVal_val (get_local $res) (i32.const 0))))
- (br $loop_done)))
- ;;; prev = res
- (set_local $prev (get_local $res))
- ;;; res = mem[res].val[0]
- (set_local $res (call $MalVal_val (get_local $res) (i32.const 0)))
- (br $loop)
- )
- )
- ;; ALLOC_DONE
- ;;; mem[res].refcnt_type = type + 32
- (i32.store (call $MalVal_ptr (get_local $res))
- (i32.add (get_local $type) (i32.const 32)))
- ;; set val to default val1
- ;;; mem[res].val[0] = val1
- (i32.store (call $MalVal_val_ptr (get_local $res) (i32.const 0))
- (get_local $val1))
- ;;; if (type > 5 && type != 9)
- (if (i32.and (i32.gt_u (get_local $type) (i32.const 5))
- (i32.ne (get_local $type) (i32.const 9)))
- (then
- ;; inc refcnt of referenced value
- ;;; mem[val1].refcnt_type += 32
- (i32.store (call $MalVal_ptr (get_local $val1))
- (i32.add (call $MalVal_refcnt_type (get_local $val1))
- (i32.const 32)))))
- ;;; if (size > 2)
- (if (i32.gt_u (get_local $size) (i32.const 2))
- (then
- ;; inc refcnt of referenced value
- ;;; mem[val2].refcnt_type += 32
- (i32.store (call $MalVal_ptr (get_local $val2))
- (i32.add (call $MalVal_refcnt_type (get_local $val2))
- (i32.const 32)))
- ;;; mem[res].val[1] = val2
- (i32.store (call $MalVal_val_ptr (get_local $res) (i32.const 1))
- (get_local $val2))))
- ;;; if (size > 3)
- (if (i32.gt_u (get_local $size) (i32.const 3))
- (then
- ;; inc refcnt of referenced value
- ;;; mem[val3].refcnt_type += 32
- (i32.store (call $MalVal_ptr (get_local $val3))
- (i32.add (call $MalVal_refcnt_type (get_local $val3))
- (i32.const 32)))
- ;;; mem[res].val[2] = val3
- (i32.store (call $MalVal_val_ptr (get_local $res) (i32.const 2))
- (get_local $val3))))
-
- ;;; return mem + res
- (call $MalVal_ptr (get_local $res))
- )
-
- (func $ALLOC_SCALAR (param $type i32) (param $val1 i32)
- (result i32)
- (call $ALLOC_INTERNAL
- (get_local $type)
- (get_local $val1)
- (i32.const 0)
- (i32.const 0))
- )
-
- (func $ALLOC (param $type i32) (param $val1 i32)
- (param $val2 i32) (param $val3 i32) (result i32)
- (call $ALLOC_INTERNAL
- (get_local $type)
- (call $MalVal_index (get_local $val1))
- (call $MalVal_index (get_local $val2))
- (call $MalVal_index (get_local $val3)))
- )
-
- (func $RELEASE (param $mv i32)
- (local $idx i32)
- (local $type i32)
- (local $size i32)
-
- ;; Ignore NULLs
- ;;; if (mv == NULL) { return; }
- (if (i32.eqz (get_local $mv)) (return))
- ;;; idx = mv - mem
- (set_local $idx (call $MalVal_index (get_local $mv)))
- ;;; type = mv->refcnt_type & 31
- (set_local $type (i32.and (i32.load (get_local $mv))
- (i32.const 0x1f))) ;; 0x1f == 31
- ;;; size = MalType_size(type)
- (set_local $size (call $MalType_size (get_local $type)))
-
- ;; DEBUG
- ;;; printf(">>> RELEASE idx: %d, type: %d, size: %d\n", idx, type, size)
-;; (call $print (STRING ">>> RELEASE idx: "))
-;; (call $printhex (get_local $idx))
-;; (call $print (STRING ", type: "))
-;; (call $printnum (get_local $type) (i32.const 10))
-;; (call $print (STRING ", size: "))
-;; (call $printnum (get_local $size) (i32.const 10))
-;; (call $print (STRING "\n"))
-
- (if (i32.eq (i32.const 0) (get_local $mv))
- (then
- (call $print (STRING "RELEASE of NULL!\n"))
- (call $exit (i32.const 1))))
-
- (if (i32.eq (get_global $FREE_T) (get_local $type))
- (then
- (call $printf_2 (STRING "RELEASE of already free mv: 0x%x, idx: 0x%x\n")
- (get_local $mv) (get_local $idx))
- (call $exit (i32.const 1))))
- (if (i32.lt_u (call $MalVal_refcnt_type (get_local $idx))
- (i32.const 15))
- (then
- (call $printf_2 (STRING "RELEASE of unowned mv: 0x%x, idx: 0x%x\n")
- (get_local $mv) (get_local $idx))
- (call $exit (i32.const 1))))
-
- ;; decrease reference count by one
- (i32.store (call $MalVal_ptr (get_local $idx))
- (i32.sub_u (call $MalVal_refcnt_type (get_local $idx))
- (i32.const 32)))
-
- ;; nil, false, true, empty sequences
- (if (i32.le_u (get_local $mv) (get_global $EMPTY_HASHMAP))
- (then
- (if (i32.lt_u (call $MalVal_refcnt_type (get_local $idx))
- (i32.const 32))
- (then
- (call $printf_2 (STRING "RELEASE of unowned mv: 0x%x, idx: 0x%x\n")
- (get_local $mv) (get_local $idx))
- (call $exit (i32.const 1))))
- (return)))
-
- ;; our reference count is not 0, so don't release
- (if (i32.ge_u (call $MalVal_refcnt_type (get_local $idx))
- (i32.const 32))
- (return))
-
- (block $done
- (block (block (block (block (block (block
- (br_table 0 0 0 0 1 1 2 2 3 5 5 5 5 4 5 5 5 (get_local $type)))
- ;; nil, boolean, integer, float
- (br $done))
- ;; string, kw, symbol
- ;; release string, then FREE reference
- (call $RELEASE_STRING (get_local $mv))
- (br $done))
- ;; list, vector
- (if (i32.ne (call $MalVal_val (get_local $idx) (i32.const 0))
- (i32.const 0))
- (then
- ;; release next element and value
- (call $RELEASE (call $MEM_VAL0_ptr (get_local $mv)))
- (call $RELEASE (call $MEM_VAL1_ptr (get_local $mv)))))
- (br $done))
- ;; hashmap
- (if (i32.ne (call $MalVal_val (get_local $idx) (i32.const 0))
- (i32.const 0))
- (then
- ;; release next element, value, and key
- (call $RELEASE (call $MEM_VAL0_ptr (get_local $mv)))
- (call $RELEASE (call $MEM_VAL2_ptr (get_local $mv)))
- (call $RELEASE (call $MEM_VAL1_ptr (get_local $mv)))))
- (br $done))
- ;; env
- ;; if outer is set then release outer
- (if (i32.ne (call $MalVal_val (get_local $idx) (i32.const 1))
- (i32.const 0))
- (call $RELEASE (call $MEM_VAL1_ptr (get_local $mv))))
- ;; release the hashmap data
- (call $RELEASE (call $MEM_VAL0_ptr (get_local $mv)))
- (br $done))
- ;; default/unknown
- )
-
- ;; FREE, free the current element
-
- ;; set type(FREE/15) and size
- ;;; mv->refcnt_type = size*32 + FREE_T
- (i32.store (get_local $mv)
- (i32.add (i32.mul_u (get_local $size)
- (i32.const 32))
- (get_global $FREE_T)))
- (i32.store (call $MalVal_val_ptr (get_local $idx) (i32.const 0))
- (get_global $mem_free_list))
- (set_global $mem_free_list (get_local $idx))
- (if (i32.ge_u (get_local $size) (i32.const 3))
- (i32.store (call $MalVal_val_ptr (get_local $idx) (i32.const 1))
- (i32.const 0)))
- (if (i32.eq (get_local $size) (i32.const 4))
- (i32.store (call $MalVal_val_ptr (get_local $idx) (i32.const 2))
- (i32.const 0)))
- )
-
- ;; Allocate a string as follows:
- ;; refcnt (i32 set to 1), string data, NULL byte
- (func $STRING_DUPE (param $str i32) (result i32)
- (local $len i32)
- (local $cur i32)
- (local $new i32)
- (local $idx i32)
-
- ;; Calculate length of string needed
- (set_local $len (call $STRING_LEN (get_local $str)))
-
- ;; leading i32 refcnt + trailing NULL
- (set_local $new (call $malloc (i32.add (i32.const 5) (get_local $len))))
-
- ;; DEBUG
-;; (call $debug (STRING "STRING_DUPE - malloc returned: ") (get_local $new))
-
- ;; set initial refcnt to 1
- (i32.store (get_local $new) (i32.const 1))
- ;; skip refcnt
- (set_local $cur (i32.add (get_local $new) (i32.const 4)))
- ;; Set NULL terminator
- (i32.store8_u (i32.add (get_local $cur) (get_local $len)) (i32.const 0))
-
- ;; Copy the characters
- (call $MEM_COPY (get_local $cur) (get_local $str) (get_local $len))
- (get_local $new)
- )
-
- ;; Duplicate regular character array string into a Mal string and
- ;; return the MalVal pointer
- (func $STRING (param $type i32) (param $str i32) (result i32)
- (call $ALLOC_SCALAR
- (get_local $type)
- (call $STRING_DUPE (get_local $str)))
- )
-
- (func $RELEASE_STRING (param $mv i32)
- (local $str i32)
- (set_local $str (call $MalVal_val
- (call $MalVal_index (get_local $mv))
- (i32.const 0)))
-
- ;; DEBUG
-;; (call $debug (STRING "RELEASE_STRING - calling free on: ") (get_local $str))
-
- (call $free (get_local $str))
- )
-)
--- /dev/null
+(module $printer
+
+ (func $pr_str_val (param $res i32) (param $mv i32) (result i32)
+ (local $type i32)
+ (local $val0 i32)
+ (local $sval i32)
+ (set_local $type ($TYPE $mv))
+ (set_local $val0 ($MalVal_val ($MalVal_index $mv)
+ 0))
+
+ ;;; switch(type)
+ (block $done
+ (block $default
+ (block (block (block (block (block (block (block (block
+ (block (block (block (block (block (block (block (block
+ (br_table 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 $type))
+ ;; 0: nil
+ ($MEM_COPY $res "nil" 4)
+ (set_local $res (i32.add 3 $res))
+ (br $done))
+ ;; 1: boolean
+ (if (i32.eq $val0 0)
+ (then
+ ;; false
+ ($MEM_COPY $res "false" 5)
+ (set_local $res (i32.add 5 $res)))
+ (else
+ ;; true
+ ($MEM_COPY $res "true" 4)
+ (set_local $res (i32.add 4 $res))))
+ (br $done))
+ ;; 2: integer
+ (set_local $res ($sprintf_1 $res "%d" $val0))
+ (br $done))
+ ;; 3: float/ERROR
+ (set_local $res ($sprintf_1 $res "%d" " *** GOT FLOAT *** "))
+ (br $done))
+ ;; 4: string/kw
+ (set_local $sval ($to_String $mv))
+ (if (i32.eq (i32.load8_u $sval) (CHR "\x7f"))
+ (then
+ (set_local $res ($sprintf_1 $res ":%s" (i32.add $sval 1))))
+ (else
+ (set_local $res ($sprintf_1 $res "\"%s\"" ($to_String $mv)))))
+ (br $done))
+ ;; 5: symbol
+ (set_local $res ($sprintf_1 $res "%s" ($to_String $mv)))
+ (br $done))
+ ;; 6: list, fallthrouogh
+ )
+ ;; 7: vector, fallthrough
+ )
+ ;; 8: hashmap
+ (set_local
+ $res ($sprintf_1 $res "%c"
+ (if i32 (i32.eq $type (get_global $LIST_T))
+ (CHR "(")
+ (else (if i32 (i32.eq $type (get_global $VECTOR_T))
+ (CHR "[")
+ (else (CHR "{")))))))
+ ;; PR_SEQ_LOOP
+ ;;; while (VAL0(mv) != 0)
+ (block $done_seq
+ (loop $seq_loop
+ (if (i32.eq ($VAL0 $mv) 0)
+ (br $done_seq))
+ ;;; res = pr_str_val(res, MEM_VAL1(mv), print_readably)
+ (set_local $res ($pr_str_val $res ($MEM_VAL1_ptr $mv)))
+
+ ;; if this is a hash-map, print the next element
+ (if (i32.eq $type (get_global $HASHMAP_T))
+ (then
+ ;;; res += snprintf(res, 2, " ")
+ (set_local $res ($sprintf_1 $res " " 0))
+ (set_local $res ($pr_str_val $res ($MEM_VAL2_ptr $mv)))))
+ ;;; mv = MEM_VAL0(mv)
+ (set_local $mv ($MEM_VAL0_ptr $mv))
+ ;;; if (VAL0(mv) != 0)
+ (if (i32.ne ($VAL0 $mv) 0)
+ ;;; res += snprintf(res, 2, " ")
+ (set_local $res ($sprintf_1 $res " " 0)))
+ ;;($print "here4\n")
+ (br $seq_loop)
+ )
+ )
+
+ (set_local
+ $res ($sprintf_1 $res "%c"
+ (if i32 (i32.eq $type (get_global $LIST_T))
+ (CHR ")")
+ (else (if i32 (i32.eq $type (get_global $VECTOR_T))
+ (CHR "]")
+ (else (CHR "}")))))))
+ (br $done))
+ ;; 9: function
+ ($MEM_COPY $res "#<fn ...>" 10)
+ (set_local $res (i32.add 9 $res))
+ (br $done))
+ ;; 10: mal function
+ ($MEM_COPY $res "(fn* ...)" 10)
+ (set_local $res (i32.add 9 $res))
+ (br $done))
+ ;; 11: macro fn
+ ($print "macro fn")
+ ($MEM_COPY $res "#<macro ...>" 13)
+ (set_local $res (i32.add 12 $res))
+ (br $done))
+ ;; 12: atom
+ ($MEM_COPY $res "(atom ...)" 11)
+ (set_local $res (i32.add 10 $res))
+ (br $done))
+ ;; 13: environment
+ ($MEM_COPY $res "#<mem ...>" 11)
+ (set_local $res (i32.add 10 $res))
+ (br $done))
+ ;; 14: metadata
+ ($MEM_COPY $res "#<meta ...>" 12)
+ (set_local $res (i32.add 11 $res))
+ (br $done))
+ ;; 15: FREE
+ ($MEM_COPY $res "#<free ...>" 12)
+ (set_local $res (i32.add 11 $res))
+ (br $done))
+ ;; 16: default
+ ($MEM_COPY $res "#<unknown>" 11)
+ (set_local $res (i32.add 10 $res))
+ )
+
+ $res
+ )
+
+ (func $pr_str (param $mv i32) (result i32)
+ (drop ($pr_str_val (get_global $sprintf_buf) $mv))
+ ($STRING (get_global $STRING_T) (get_global $sprintf_buf))
+ )
+
+ (export "pr_str" (func $pr_str))
+
+)
+++ /dev/null
-(module $printer
-
- (func $pr_str_val (param $res i32) (param $mv i32) (result i32)
- (local $type i32)
- (local $val0 i32)
- (local $sval i32)
- (set_local $type (call $TYPE (get_local $mv)))
- (set_local $val0 (call $MalVal_val (call $MalVal_index (get_local $mv))
- (i32.const 0)))
-
- ;;; switch(type)
- (block $done
- (block $default
- (block (block (block (block (block (block (block (block
- (block (block (block (block (block (block (block (block
- (br_table 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 (get_local $type)))
- ;; 0: nil
- (call $MEM_COPY (get_local $res) (STRING "nil") (i32.const 4))
- (set_local $res (i32.add (i32.const 3) (get_local $res)))
- (br $done))
- ;; 1: boolean
- (if (i32.eq (get_local $val0) (i32.const 0))
- (then
- ;; false
- (call $MEM_COPY (get_local $res) (STRING "false") (i32.const 5))
- (set_local $res (i32.add (i32.const 5) (get_local $res))))
- (else
- ;; true
- (call $MEM_COPY (get_local $res) (STRING "true") (i32.const 4))
- (set_local $res (i32.add (i32.const 4) (get_local $res)))))
- (br $done))
- ;; 2: integer
- (set_local $res (call $sprintf_1 (get_local $res) (STRING "%d")
- (get_local $val0)))
- (br $done))
- ;; 3: float/ERROR
- (set_local $res (call $sprintf_1 (get_local $res) (STRING "%d")
- (STRING " *** GOT FLOAT *** ")))
- (br $done))
- ;; 4: string/kw
- (set_local $sval (call $to_String (get_local $mv)))
- (if (i32.eq (i32.load8_u (get_local $sval)) (CHAR "\x7f"))
- (then
- (set_local $res (call $sprintf_1 (get_local $res) (STRING ":%s")
- (i32.add (get_local $sval) (i32.const 1)))))
- (else
- (set_local $res (call $sprintf_1 (get_local $res) (STRING "\"%s\"")
- (call $to_String (get_local $mv))))))
- (br $done))
- ;; 5: symbol
- (set_local $res (call $sprintf_1 (get_local $res) (STRING "%s")
- (call $to_String (get_local $mv))))
- (br $done))
- ;; 6: list, fallthrouogh
- )
- ;; 7: vector, fallthrough
- )
- ;; 8: hashmap
- (set_local
- $res (call $sprintf_1 (get_local $res) (STRING "%c")
- (if i32 (i32.eq (get_local $type) (get_global $LIST_T))
- (CHAR "(")
- (else (if i32 (i32.eq (get_local $type) (get_global $VECTOR_T))
- (CHAR "[")
- (else (CHAR "{")))))))
- ;; PR_SEQ_LOOP
- ;;; while (VAL0(mv) != 0)
- (block $done_seq
- (loop $seq_loop
- (if (i32.eq (call $VAL0 (get_local $mv)) (i32.const 0))
- (br $done_seq))
- ;;; res = pr_str_val(res, MEM_VAL1(mv), print_readably)
- (set_local $res (call $pr_str_val (get_local $res)
- (call $MEM_VAL1_ptr (get_local $mv))))
-
- ;; if this is a hash-map, print the next element
- (if (i32.eq (get_local $type) (get_global $HASHMAP_T))
- (then
- ;;; res += snprintf(res, 2, " ")
- (set_local $res (call $sprintf_1 (get_local $res) (STRING " ")
- (i32.const 0)))
- (set_local $res (call $pr_str_val (get_local $res)
- (call $MEM_VAL2_ptr (get_local $mv))))))
- ;;; mv = MEM_VAL0(mv)
- (set_local $mv (call $MEM_VAL0_ptr (get_local $mv)))
- ;;; if (VAL0(mv) != 0)
- (if (i32.ne (call $VAL0 (get_local $mv)) (i32.const 0))
- ;;; res += snprintf(res, 2, " ")
- (set_local $res (call $sprintf_1 (get_local $res) (STRING " ")
- (i32.const 0))))
- ;;(call $print (STRING "here4\n"))
- (br $seq_loop)
- )
- )
-
- (set_local
- $res (call $sprintf_1 (get_local $res) (STRING "%c")
- (if i32 (i32.eq (get_local $type) (get_global $LIST_T))
- (CHAR ")")
- (else (if i32 (i32.eq (get_local $type) (get_global $VECTOR_T))
- (CHAR "]")
- (else (CHAR "}")))))))
- (br $done))
- ;; 9: function
- (call $MEM_COPY (get_local $res) (STRING "#<fn ...>") (i32.const 10))
- (set_local $res (i32.add (i32.const 9) (get_local $res)))
- (br $done))
- ;; 10: mal function
- (call $MEM_COPY (get_local $res) (STRING "(fn* ...)") (i32.const 10))
- (set_local $res (i32.add (i32.const 9) (get_local $res)))
- (br $done))
- ;; 11: macro fn
- (call $print (STRING "macro fn"))
- (call $MEM_COPY (get_local $res) (STRING "#<macro ...>") (i32.const 13))
- (set_local $res (i32.add (i32.const 12) (get_local $res)))
- (br $done))
- ;; 12: atom
- (call $MEM_COPY (get_local $res) (STRING "(atom ...)") (i32.const 11))
- (set_local $res (i32.add (i32.const 10) (get_local $res)))
- (br $done))
- ;; 13: environment
- (call $MEM_COPY (get_local $res) (STRING "#<mem ...>") (i32.const 11))
- (set_local $res (i32.add (i32.const 10) (get_local $res)))
- (br $done))
- ;; 14: metadata
- (call $MEM_COPY (get_local $res) (STRING "#<meta ...>") (i32.const 12))
- (set_local $res (i32.add (i32.const 11) (get_local $res)))
- (br $done))
- ;; 15: FREE
- (call $MEM_COPY (get_local $res) (STRING "#<free ...>") (i32.const 12))
- (set_local $res (i32.add (i32.const 11) (get_local $res)))
- (br $done))
- ;; 16: default
- (call $MEM_COPY (get_local $res) (STRING "#<unknown>") (i32.const 11))
- (set_local $res (i32.add (i32.const 10) (get_local $res)))
- )
-
- (get_local $res)
- )
-
- (func $pr_str (param $mv i32) (result i32)
- (drop (call $pr_str_val (get_global $sprintf_buf) (get_local $mv)))
- (call $STRING (get_global $STRING_T) (get_global $sprintf_buf))
- )
-
- (export "pr_str" (func $pr_str))
-
-)
--- /dev/null
+(module $reader
+
+ ;; TODO: global warning
+ (global $token (mut i32) 0)
+ (global $read_index (mut i32) 0)
+
+ (func $skip_spaces (param $str i32) (result i32)
+ (local $found i32)
+ (local $c i32)
+ (set_local $found 0)
+ (set_local $c (i32.load8_u (i32.add $str (get_global $read_index))))
+ (block $done
+ (loop $loop
+ ;;; while (c == ' ' || c == ',' || c == '\n')
+ (if (i32.and (i32.and
+ (i32.ne $c (CHR " "))
+ (i32.ne $c (CHR ",")))
+ (i32.ne $c (CHR "\n")))
+ (br $done))
+ (set_local $found 1)
+ ;;; c=str[++(*index)]
+ (set_global $read_index (i32.add (get_global $read_index) 1))
+ (set_local $c (i32.load8_u (i32.add $str (get_global $read_index))))
+ (br $loop)
+ )
+ )
+;; ($debug ">>> skip_spaces:" $found)
+ $found
+ )
+
+ (func $skip_to_eol (param $str i32) (result i32)
+ (local $found i32)
+ (local $c i32)
+ (set_local $found 0)
+ (set_local $c (i32.load8_c (i32.add $str (get_global $read_index))))
+ (if (i32.eq $c (CHR ";"))
+ (then
+ (set_local $found 1)
+ (block $done
+ (loop $loop
+ ;;; c=str[++(*index)]
+ (set_global $read_index (i32.add (get_global $read_index) 1))
+ (set_local $c (i32.load8_u (i32.add $str
+ (get_global $read_index))))
+ ;;; while (c != '\0' && c != '\n')
+ (if (i32.and (i32.ne $c (CHR "\x00")) (i32.ne $c (CHR "\n")))
+ (br $loop))
+ )
+ )))
+;; ($debug ">>> skip_to_eol:" $found)
+ $found
+ )
+
+ (func $skip_spaces_comments (param $str i32)
+ (loop $loop
+ ;; skip spaces
+ (if ($skip_spaces $str) (br $loop))
+ ;; skip comments
+ (if ($skip_to_eol $str) (br $loop))
+ )
+ )
+
+ (func $read_token (param $str i32) (result i32)
+ (local $token_index i32)
+ (local $instring i32)
+ (local $escaped i32)
+ (local $c i32)
+ (set_local $token_index 0)
+ (set_local $instring 0)
+ (set_local $escaped 0)
+
+ ($skip_spaces_comments $str)
+
+ ;; read first character
+ ;;; c=str[++(*index)]
+ (set_local $c (i32.load8_u (i32.add $str (get_global $read_index))))
+ (set_global $read_index (i32.add (get_global $read_index) 1))
+ ;; read first character
+ ;;; token[token_index++] = c
+ (i32.store8_u (i32.add (get_global $token) $token_index) $c)
+ (set_local $token_index (i32.add $token_index 1))
+ ;; single/double character token
+ (if (i32.or (i32.eq $c (CHR "("))
+ (i32.or (i32.eq $c (CHR ")"))
+ (i32.or (i32.eq $c (CHR "["))
+ (i32.or (i32.eq $c (CHR "]"))
+ (i32.or (i32.eq $c (CHR "{"))
+ (i32.or (i32.eq $c (CHR "}"))
+ (i32.or (i32.eq $c (CHR "'"))
+ (i32.or (i32.eq $c (CHR "`"))
+ (i32.or (i32.eq $c (CHR "@"))
+ (i32.and (i32.eq $c (CHR "~"))
+ (i32.eq (i32.load8_u (i32.add $str (get_global $read_index)))
+ (CHR "@"))))))))))))
+
+ (then
+ ;; continue
+ (nop))
+ (else
+ ;;; if (c == '"') instring = true
+ (set_local $instring (i32.eq $c (CHR "\"")))
+ (block $done
+ (loop $loop
+ ;; peek at next character
+ ;;; c = str[*index]
+ (set_local $c (i32.load8_u
+ (i32.add $str (get_global $read_index))))
+ ;;; if (c == '\0') break
+ (if (i32.eq $c 0) (br $done))
+ ;;; if (!instring)
+ (if (i32.eqz $instring)
+ (then
+ ;; next character is token delimiter
+ (if (i32.or (i32.eq $c (CHR "("))
+ (i32.or (i32.eq $c (CHR ")"))
+ (i32.or (i32.eq $c (CHR "["))
+ (i32.or (i32.eq $c (CHR "]"))
+ (i32.or (i32.eq $c (CHR "{"))
+ (i32.or (i32.eq $c (CHR "}"))
+ (i32.or (i32.eq $c (CHR " "))
+ (i32.or (i32.eq $c (CHR ","))
+ (i32.eq $c (CHR "\n"))))))))))
+ (br $done))))
+ ;; read next character
+ ;;; token[token_index++] = str[(*index)++]
+ (i32.store8_u (i32.add (get_global $token) $token_index)
+ (i32.load8_u
+ (i32.add $str (get_global $read_index))))
+ (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 (i32.and (i32.eq (i32.load8_u (i32.add (get_global $token) 0))
+ (CHR "~"))
+ (i32.eq (i32.load8_u (i32.add (get_global $token) 1))
+ 0x40))
+ (br $done))
+
+ ;;; if ((!instring) || escaped)
+ (if (i32.or (i32.eqz $instring) $escaped)
+ (then
+ (set_local $escaped 0)
+ (br $loop)))
+ (if (i32.eq $c (CHR "\\"))
+ (set_local $escaped 1))
+ (if (i32.eq $c (CHR "\""))
+ (br $done))
+ (br $loop)
+ )
+ )))
+
+ ;;; token[token_index] = '\0'
+ (i32.store8_u (i32.add (get_global $token) $token_index) 0)
+ (get_global $token)
+ )
+
+ (func $read_seq (param $str i32) (param $type i32) (param $end i32)
+ (result i32)
+ (local $res i32)
+ (local $val2 i32)
+ (local $val3 i32)
+ (local $c i32)
+
+ ;; MAP_LOOP stack
+ (local $ret i32)
+ (local $empty i32)
+ (local $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)
+
+ ;; READ_SEQ_LOOP
+ (block $done
+ (loop $loop
+ ($skip_spaces_comments $str)
+
+ ;; peek at next character
+ ;;; c = str[*index]
+ (set_local $c (i32.load8_u (i32.add $str (get_global $read_index))))
+ (if (i32.eq $c (CHR "\x00"))
+ (then
+ ($THROW_STR_0 "unexpected EOF")
+ (br $done)))
+ (if (i32.eq $c $end)
+ (then
+ ;; read next character
+ ;;; c = str[(*index)++]
+ (set_local $c (i32.load8_u (i32.add $str (get_global $read_index))))
+ (set_global $read_index (i32.add (get_global $read_index) 1))
+ (br $done)))
+
+ ;; value (or key for hash-maps)
+ (set_local $val2 ($read_form $str))
+
+ ;; if error, release the unattached element
+ (if (get_global $error_type)
+ (then
+ ($RELEASE $val2)
+ (br $done)))
+
+ ;; if this is a hash-map, READ_FORM again
+ (if (i32.eq $type (get_global $HASHMAP_T))
+ (set_local $val3 ($read_form $str)))
+
+ ;; update the return sequence structure
+ ;; MAP_LOOP_UPDATE
+ (set_local $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3))
+ (if (i32.le_u $current (get_global $EMPTY_HASHMAP))
+ ;; if first element, set return to new element
+ (set_local $ret $res))
+ ;; update current to point to new element
+ (set_local $current $res)
+
+ (br $loop)
+ )
+ )
+
+ ;; MAP_LOOP_DONE
+ $ret
+ )
+
+ (func $read_form (param $str i32) (result i32)
+ ;;($STRING (get_global $STRING_T) $str)
+ (local $tok i32)
+ (local $c0 i32)
+ (local $c1 i32)
+ (local $res i32)
+
+ (if (get_global $error_type) (return 0))
+
+ (set_local $tok ($read_token $str))
+;; ($debug ">>> read_form 1:" $tok)
+ ;;; c0 = token[0]
+ (set_local $c0 (i32.load8_u $tok))
+ (set_local $c1 (i32.load8_u (i32.add $tok 1)))
+
+ (if (i32.eq $c0 0)
+ (then
+ (return ($INC_REF (get_global $NIL))))
+ (else (if (i32.or (i32.and (i32.ge_u $c0 (CHR "0"))
+ (i32.le_u $c0 (CHR "9")))
+ (i32.and (i32.eq $c0 (CHR "-"))
+ (i32.and (i32.ge_u $c1 (CHR "0"))
+ (i32.le_u $c1 (CHR "9")))))
+ (then
+ (return ($INTEGER ($ATOI $tok))))
+ (else (if (i32.eq $c0 (CHR ":"))
+ (then
+ (i32.store8_u $tok (CHR "\x7f"))
+ (return ($STRING (get_global $STRING_T) $tok)))
+ (else (if (i32.eq $c0 (CHR "\""))
+ (then
+ ;; TODO: unescape
+ (i32.store8_u (i32.sub_u (i32.add $tok ($STRING_LEN $tok)) 1)
+ (CHR "\x00"))
+ (return ($STRING (get_global $STRING_T) (i32.add $tok 1))))
+ (else (if (i32.eq $c0 (CHR "("))
+ (then
+ (return ($read_seq $str (get_global $LIST_T) (CHR ")"))))
+ (else (if (i32.eq $c0 (CHR "["))
+ (then
+ (return ($read_seq $str (get_global $VECTOR_T) (CHR "]"))))
+ (else (if (i32.eq $c0 (CHR "{"))
+ (then
+ (return ($read_seq $str (get_global $HASHMAP_T) (CHR "}"))))
+ (else (if (i32.or (i32.eq $c0 (CHR ")"))
+ (i32.or (i32.eq $c0 (CHR "]"))
+ (i32.eq $c0 (CHR "}"))))
+ (then
+ ($THROW_STR_1 "unexpected '%c'" $c0)
+ (return 0))
+ (else
+ (return ($STRING (get_global $SYMBOL_T) $tok))))))))))))))))))
+ )
+
+ (func $read_str (param $str i32) (result i32)
+ (set_global $read_index 0)
+ ($read_form $str)
+ )
+
+ (export "read_str" (func $read_str))
+
+)
+++ /dev/null
-(module $reader
-
- ;; TODO: global warning
- (global $token (mut i32) (i32.const 0))
- (global $read_index (mut i32) (i32.const 0))
-
- (func $skip_spaces (param $str i32) (result i32)
- (local $found i32)
- (local $c i32)
- (set_local $found (i32.const 0))
- (set_local $c (i32.load8_u (i32.add (get_local $str)
- (get_global $read_index))))
- (block $done
- (loop $loop
- ;;; while (c == ' ' || c == ',' || c == '\n')
- (if (i32.and (i32.and
- (i32.ne (get_local $c) (CHAR " "))
- (i32.ne (get_local $c) (CHAR ",")))
- (i32.ne (get_local $c) (CHAR "\n")))
- (br $done))
- (set_local $found (i32.const 1))
- ;;; c=str[++(*index)]
- (set_global $read_index (i32.add (get_global $read_index)
- (i32.const 1)))
- (set_local $c (i32.load8_u (i32.add (get_local $str)
- (get_global $read_index))))
- (br $loop)
- )
- )
-;; (call $debug (STRING ">>> skip_spaces:") (get_local $found))
- (get_local $found)
- )
-
- (func $skip_to_eol (param $str i32) (result i32)
- (local $found i32)
- (local $c i32)
- (set_local $found (i32.const 0))
- (set_local $c (i32.load8_c (i32.add (get_local $str)
- (get_global $read_index))))
- (if (i32.eq (get_local $c) (CHAR ";"))
- (then
- (set_local $found (i32.const 1))
- (block $done
- (loop $loop
- ;;; c=str[++(*index)]
- (set_global $read_index (i32.add (get_global $read_index)
- (i32.const 1)))
- (set_local $c (i32.load8_u (i32.add (get_local $str)
- (get_global $read_index))))
- ;;; while (c != '\0' && c != '\n')
- (if (i32.and (i32.ne (get_local $c) (CHAR "\x00"))
- (i32.ne (get_local $c) (CHAR "\n")))
- (br $loop))
- )
- )))
-;; (call $debug (STRING ">>> skip_to_eol:") (get_local $found))
- (get_local $found)
- )
-
- (func $skip_spaces_comments (param $str i32)
- (loop $loop
- ;; skip spaces
- (if (call $skip_spaces (get_local $str)) (br $loop))
- ;; skip comments
- (if (call $skip_to_eol (get_local $str)) (br $loop))
- )
- )
-
- (func $read_token (param $str i32) (result i32)
- (local $token_index i32)
- (local $instring i32)
- (local $escaped i32)
- (local $c i32)
- (set_local $token_index (i32.const 0))
- (set_local $instring (i32.const 0))
- (set_local $escaped (i32.const 0))
-
- (call $skip_spaces_comments (get_local $str))
-
- ;; read first character
- ;;; c=str[++(*index)]
- (set_local $c (i32.load8_u (i32.add (get_local $str)
- (get_global $read_index))))
- (set_global $read_index (i32.add (get_global $read_index)
- (i32.const 1)))
- ;; read first character
- ;;; token[token_index++] = c
- (i32.store8_u (i32.add (get_global $token) (get_local $token_index))
- (get_local $c))
- (set_local $token_index (i32.add (get_local $token_index)
- (i32.const 1)))
- ;; single/double character token
- (if (i32.or (i32.eq (get_local $c) (CHAR "("))
- (i32.or (i32.eq (get_local $c) (CHAR ")"))
- (i32.or (i32.eq (get_local $c) (CHAR "["))
- (i32.or (i32.eq (get_local $c) (CHAR "]"))
- (i32.or (i32.eq (get_local $c) (CHAR "{"))
- (i32.or (i32.eq (get_local $c) (CHAR "}"))
- (i32.or (i32.eq (get_local $c) (CHAR "'"))
- (i32.or (i32.eq (get_local $c) (CHAR "`"))
- (i32.or (i32.eq (get_local $c) (CHAR "@"))
- (i32.and (i32.eq (get_local $c) (CHAR "~"))
- (i32.eq (i32.load8_u (i32.add (get_local $str)
- (get_global $read_index)))
- (CHAR "@"))))))))))))
-
- (then
- ;; continue
- (nop))
- (else
- ;;; if (c == '"') instring = true
- (set_local $instring (i32.eq (get_local $c) (CHAR "\"")))
- (block $done
- (loop $loop
- ;; peek at next character
- ;;; c = str[*index]
- (set_local $c (i32.load8_u (i32.add (get_local $str)
- (get_global $read_index))))
- ;;; if (c == '\0') break
- (if (i32.eq (get_local $c) (i32.const 0)) (br $done))
- ;;; if (!instring)
- (if (i32.eqz (get_local $instring))
- (then
- ;; next character is token delimiter
- (if (i32.or (i32.eq (get_local $c) (CHAR "("))
- (i32.or (i32.eq (get_local $c) (CHAR ")"))
- (i32.or (i32.eq (get_local $c) (CHAR "["))
- (i32.or (i32.eq (get_local $c) (CHAR "]"))
- (i32.or (i32.eq (get_local $c) (CHAR "{"))
- (i32.or (i32.eq (get_local $c) (CHAR "}"))
- (i32.or (i32.eq (get_local $c) (CHAR " "))
- (i32.or (i32.eq (get_local $c) (CHAR ","))
- (i32.eq (get_local $c) (CHAR "\n"))))))))))
- (br $done))))
- ;; read next character
- ;;; token[token_index++] = str[(*index)++]
- (i32.store8_u (i32.add (get_global $token)
- (get_local $token_index))
- (i32.load8_u (i32.add (get_local $str)
- (get_global $read_index))))
- (set_local $token_index (i32.add (get_local $token_index)
- (i32.const 1)))
- (set_global $read_index (i32.add (get_global $read_index)
- (i32.const 1)))
- ;;; if (token[0] == '~' && token[1] == '@') break
- (if (i32.and (i32.eq (i32.load8_u (i32.add (get_global $token)
- (i32.const 0)))
- (CHAR "~"))
- (i32.eq (i32.load8_u (i32.add (get_global $token)
- (i32.const 1)))
- (i32.const 0x40)))
- (br $done))
-
- ;;; if ((!instring) || escaped)
- (if (i32.or (i32.eqz (get_local $instring))
- (get_local $escaped))
- (then
- (set_local $escaped (i32.const 0))
- (br $loop)))
- (if (i32.eq (get_local $c) (CHAR "\\"))
- (set_local $escaped (i32.const 1)))
- (if (i32.eq (get_local $c) (CHAR "\""))
- (br $done))
- (br $loop)
- )
- )))
-
- ;;; token[token_index] = '\0'
- (i32.store8_u (i32.add (get_global $token) (get_local $token_index))
- (i32.const 0))
- (get_global $token)
- )
-
- (func $read_seq (param $str i32) (param $type i32) (param $end i32)
- (result i32)
- (local $res i32)
- (local $val2 i32)
- (local $val3 i32)
- (local $c i32)
-
- ;; MAP_LOOP stack
- (local $ret i32)
- (local $empty i32)
- (local $current i32)
-
- ;; MAP_LOOP_START
- (set_local $res (call $MAP_LOOP_START (get_local $type)))
- ;; push MAP_LOOP stack
- ;;; empty = current = ret = res
- (set_local $ret (get_local $res))
- (set_local $current (get_local $res))
- (set_local $empty (get_local $res))
-
- ;; READ_SEQ_LOOP
- (block $done
- (loop $loop
- (call $skip_spaces_comments (get_local $str))
-
- ;; peek at next character
- ;;; c = str[*index]
- (set_local $c (i32.load8_u (i32.add (get_local $str)
- (get_global $read_index))))
- (if (i32.eq (get_local $c) (CHAR "\x00"))
- (then
- (call $THROW_STR_0 (STRING "unexpected EOF"))
- (br $done)))
- (if (i32.eq (get_local $c) (get_local $end))
- (then
- ;; read next character
- ;;; c = str[(*index)++]
- (set_local $c (i32.load8_u (i32.add (get_local $str)
- (get_global $read_index))))
- (set_global $read_index (i32.add (get_global $read_index)
- (i32.const 1)))
- (br $done)))
-
- ;; value (or key for hash-maps)
- (set_local $val2 (call $read_form (get_local $str)))
-
- ;; if error, release the unattached element
- (if (get_global $error_type)
- (then
- (call $RELEASE (get_local $val2))
- (br $done)))
-
- ;; if this is a hash-map, READ_FORM again
- (if (i32.eq (get_local $type) (get_global $HASHMAP_T))
- (set_local $val3 (call $read_form (get_local $str))))
-
- ;; update the return sequence structure
- ;; MAP_LOOP_UPDATE
- (set_local $res (call $MAP_LOOP_UPDATE (get_local $type)
- (get_local $empty) (get_local $current)
- (get_local $val2) (get_local $val3)))
- (if (i32.le_u (get_local $current) (get_global $EMPTY_HASHMAP))
- ;; if first element, set return to new element
- (set_local $ret (get_local $res)))
- ;; update current to point to new element
- (set_local $current (get_local $res))
-
- (br $loop)
- )
- )
-
- ;; MAP_LOOP_DONE
- (get_local $ret)
- )
-
- (func $read_form (param $str i32) (result i32)
- ;;(call $STRING (get_global $STRING_T) (get_local $str))
- (local $tok i32)
- (local $c0 i32)
- (local $c1 i32)
- (local $res i32)
-
- (if (get_global $error_type) (return (i32.const 0)))
-
- (set_local $tok (call $read_token (get_local $str)))
-;; (call $debug (STRING ">>> read_form 1:") (get_local $tok))
- ;;; c0 = token[0]
- (set_local $c0 (i32.load8_u (get_local $tok)))
- (set_local $c1 (i32.load8_u (i32.add (get_local $tok) (i32.const 1))))
-
- (if (i32.eq (get_local $c0) (i32.const 0))
- (then
- (return (call $INC_REF (get_global $NIL))))
- (else (if (i32.or
- (i32.and
- (i32.ge_u (get_local $c0) (CHAR "0"))
- (i32.le_u (get_local $c0) (CHAR "9")))
- (i32.and
- (i32.eq (get_local $c0) (CHAR "-"))
- (i32.and (i32.ge_u (get_local $c1) (CHAR "0"))
- (i32.le_u (get_local $c1) (CHAR "9")))))
- (then
- (return (call $INTEGER (call $ATOI (get_local $tok)))))
- (else (if (i32.eq (get_local $c0) (CHAR ":"))
- (then
- (i32.store8_u (get_local $tok) (CHAR "\x7f"))
- (return (call $STRING (get_global $STRING_T) (get_local $tok))))
- (else (if (i32.eq (get_local $c0) (CHAR "\""))
- (then
- ;; TODO: unescape
- (i32.store8_u (i32.sub_u
- (i32.add (get_local $tok)
- (call $STRING_LEN (get_local $tok)))
- (i32.const 1))
- (CHAR "\x00"))
- (return (call $STRING (get_global $STRING_T) (i32.add (get_local $tok)
- (i32.const 1)))))
- (else (if (i32.eq (get_local $c0) (CHAR "("))
- (then
- (return (call $read_seq (get_local $str)
- (get_global $LIST_T) (CHAR ")"))))
- (else (if (i32.eq (get_local $c0) (CHAR "["))
- (then
- (return (call $read_seq (get_local $str)
- (get_global $VECTOR_T) (CHAR "]"))))
- (else (if (i32.eq (get_local $c0) (CHAR "{"))
- (then
- (return (call $read_seq (get_local $str)
- (get_global $HASHMAP_T) (CHAR "}"))))
- (else (if (i32.or (i32.eq (get_local $c0) (CHAR ")"))
- (i32.or (i32.eq (get_local $c0) (CHAR "]"))
- (i32.eq (get_local $c0) (CHAR "}"))))
- (then
- (call $THROW_STR_1 (STRING "unexpected '%c'") (get_local $c0))
- (return (i32.const 0)))
- (else
- (return (call $STRING (get_global $SYMBOL_T)
- (get_local $tok)))))))))))))))))))
- )
-
- (func $read_str (param $str i32) (result i32)
- (set_global $read_index (i32.const 0))
- (call $read_form (get_local $str))
- )
-
- (export "read_str" (func $read_str))
-
-)
(import "env" "memory" (memory $0 256))
(import "env" "memoryBase" (global $memoryBase i32))
+ ;; READ
(func $READ (param $str i32) (result i32)
- (get_local $str))
+ $str
+ )
(func $EVAL (param $ast i32) (param $env i32) (result i32)
- (get_local $ast))
+ $ast
+ )
+ ;; PRINT
(func $PRINT (param $ast i32) (result i32)
- (get_local $ast))
+ $ast
+ )
- (func $rep (param $str i32) (result i32)
- (call $PRINT
- (call $EVAL
- (call $READ (get_local $str))
- (i32.const 0))))
+ ;; REPL
+ (func $rep (param $line i32) (result i32)
+ ($PRINT ($EVAL ($READ $line) 0))
+ )
(func $main (result i32)
;; Constant location/value definitions
;; Start
(block $repl_done
(loop $repl_loop
- (set_local $line (call $readline (STRING "user> ")))
- (if (i32.eqz (get_local $line)) (br $repl_done))
- (call $printf_1 (STRING "%s\n") (call $rep (get_local $line)))
- (call $free (get_local $line))
+ (set_local $line ($readline "user> "))
+ (if (i32.eqz $line) (br $repl_done))
+ ($printf_1 "%s\n" ($rep $line))
+ ($free $line)
(br $repl_loop)))
- (call $print (STRING "\n"))
- (i32.const 0)
+ ($print "\n")
+ 0
)
--- /dev/null
+(module $step1_read_print
+ (import "env" "memory" (memory $0 256))
+ (import "env" "memoryBase" (global $memoryBase i32))
+
+ ;; READ
+ (func $READ (param $str i32) (result i32)
+ ($read_str $str)
+ )
+
+ ;; EVAL
+ (func $EVAL (param $ast i32) (param $env i32) (result i32)
+ $ast
+ )
+
+ ;; PRINT
+ (func $PRINT (param $ast i32) (result i32)
+ ($pr_str $ast)
+ )
+
+ ;; REPL
+ (func $rep (param $line i32) (param $env i32) (result i32)
+ (local $mv1 i32)
+ (local $mv2 i32)
+ (local $ms i32)
+ (block $rep_done
+ (set_local $mv1 ($READ $line))
+ (if (get_global $error_type) (br $rep_done))
+
+ (set_local $mv2 ($EVAL $mv1 $env))
+ (if (get_global $error_type) (br $rep_done))
+
+;; ($PR_MEMORY -1 -1)
+ (set_local $ms ($PRINT $mv2))
+ )
+
+;; ($PR_MEMORY -1 -1)
+ ($RELEASE $mv1)
+ $ms
+ )
+
+ (func $main (result i32)
+ ;; Constant location/value definitions
+ (local $line i32)
+ (local $res i32)
+
+ ;; 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 "string_mem: %d\n" (get_global $string_mem))
+ ($PR_MEMORY -1 -1)
+;; ($PR_MEMORY_RAW (get_global $mem)
+;; (i32.add (get_global $mem)
+;; (i32.mul_u (get_global $mem_unused_start)
+;; 8)))
+
+ ;; Start
+ (block $repl_done
+ (loop $repl_loop
+ (set_local $line ($readline "user> "))
+ (if (i32.eqz $line) (br $repl_done))
+ (if (i32.eq (i32.load8_u $line) 0)
+ (then
+ ($free $line)
+ (br $repl_loop)))
+ (set_local $res ($rep $line 0))
+ (if (get_global $error_type)
+ (then
+ ($printf_1 "Error: %s\n" (get_global $error_str))
+ (set_global $error_type 0))
+ (else
+ ($printf_1 "%s\n" ($to_String $res))))
+ ($RELEASE $res)
+;; ($PR_MEMORY -1 -1)
+ ($free $line)
+ (br $repl_loop)))
+
+ ($print "\n")
+ ($PR_MEMORY -1 -1)
+ 0
+ )
+
+
+ (export "_main" (func $main))
+ (export "__post_instantiate" (func $init_memory))
+)
+
+++ /dev/null
-(module $step1_read_print
- (import "env" "memory" (memory $0 256))
- (import "env" "memoryBase" (global $memoryBase i32))
-
- (func $READ (param $str i32) (result i32)
- (call $read_str (get_local $str)))
-
- (func $EVAL (param $ast i32) (param $env i32) (result i32)
- (get_local $ast))
-
- (func $PRINT (param $ast i32) (result i32)
- (call $pr_str (get_local $ast)))
-
- (func $rep (param $line i32) (param $env i32) (result i32)
- (local $mv1 i32)
- (local $mv2 i32)
- (local $ms i32)
- (block $rep_done
- (set_local $mv1 (call $READ (get_local $line)))
- (if (get_global $error_type) (br $rep_done))
-
- (set_local $mv2 (call $EVAL (get_local $mv1) (get_local $env)))
- (if (get_global $error_type) (br $rep_done))
-
-;; (call $PR_MEMORY (i32.const -1) (i32.const -1))
- (set_local $ms (call $PRINT (get_local $mv2)))
- )
-
-;; (call $PR_MEMORY (i32.const -1) (i32.const -1))
- (call $RELEASE (get_local $mv1))
- (get_local $ms)
- )
-
- (func $main (result i32)
- ;; Constant location/value definitions
- (local $line i32)
- (local $res i32)
-
- ;; DEBUG
- (call $printf_1 (STRING "memoryBase: %d\n") (get_global $memoryBase))
- (call $printf_1 (STRING "heap_start: %d\n") (get_global $heap_start))
- (call $printf_1 (STRING "heap_end: %d\n") (get_global $heap_end))
- (call $printf_1 (STRING "mem: %d\n") (get_global $mem))
-;; (call $printf_1 (STRING "string_mem: %d\n") (get_global $string_mem))
- (call $PR_MEMORY (i32.const -1) (i32.const -1))
-;; (call $PR_MEMORY_RAW (get_global $mem)
-;; (i32.add (get_global $mem)
-;; (i32.mul_u (get_global $mem_unused_start)
-;; (i32.const 8))))
-
- ;; Start
- (block $repl_done
- (loop $repl_loop
- (set_local $line (call $readline (STRING "user> ")))
- (if (i32.eqz (get_local $line)) (br $repl_done))
- (if (i32.eq (i32.load8_u (get_local $line)) (i32.const 0))
- (then
- (call $free (get_local $line))
- (br $repl_loop)))
- (set_local $res (call $rep (get_local $line) (i32.const 0)))
- (if (get_global $error_type)
- (then
- (call $printf_1 (STRING "Error: %s\n") (get_global $error_str))
- (set_global $error_type (i32.const 0)))
- (else
- (call $printf_1 (STRING "%s\n") (call $to_String (get_local $res)))))
- (call $RELEASE (get_local $res))
-;; (call $PR_MEMORY (i32.const -1) (i32.const -1))
- (call $free (get_local $line))
- (br $repl_loop)))
-
- (call $print (STRING "\n"))
- (call $PR_MEMORY (i32.const -1) (i32.const -1))
- (i32.const 0)
- )
-
-
- (export "_main" (func $main))
- (export "__post_instantiate" (func $init_memory))
-)
-
--- /dev/null
+(module $step1_read_print
+ (import "env" "memory" (memory $0 256))
+ (import "env" "memoryBase" (global $memoryBase i32))
+
+ ;; READ
+ (func $READ (param $str i32) (result i32)
+ ($read_str $str)
+ )
+
+ ;; EVAL
+ (func $EVAL_AST (param $ast i32) (param $env i32) (result i32)
+ (local $res i32)
+ (local $val2 i32)
+ (local $val3 i32)
+ (local $ret i32)
+ (local $empty i32)
+ (local $current i32)
+ (local $type i32)
+ (local $res2 i64)
+ (local $found i32)
+
+ (if (get_global $error_type) (return 0))
+ (set_local $type ($TYPE $ast))
+
+ ;;; switch(type)
+ (block $done
+ (block $default (block (block
+ (br_table 2 2 2 2 2 0 1 1 1 2 2 2 2 2 2 2 $type))
+ ;; symbol
+ ;; found/res returned as hi 32/lo 32 of i64
+ (set_local $res2 ($HASHMAP_GET $env $ast))
+ (set_local $res (i32.wrap/i64 $res2))
+ (set_local $found (i32.wrap/i64 (i64.shr_u $res2
+ (i64.const 32))))
+ (if (i32.eqz $found)
+ ($THROW_STR_1 "'%s' not found"
+ ($to_String $ast)))
+ (set_local $res ($INC_REF $res))
+
+ (br $done))
+ ;; list, vector, hashmap
+ ;; 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)
+
+ (block $done
+ (loop $loop
+ ;; check if we are done evaluating the source sequence
+ (if (i32.eq ($VAL0 $ast) 0)
+ (br $done))
+
+ (if (i32.eq $type (get_global $HASHMAP_T))
+ (then
+ (set_local $res ($EVAL ($MEM_VAL2_ptr $ast) $env)))
+ (else
+ (set_local $res ($EVAL ($MEM_VAL1_ptr $ast) $env))))
+ (set_local $val2 $res)
+
+ ;; if error, release the unattached element
+ (if (get_global $error_type)
+ (then
+ ($RELEASE $res)
+ (set_local $res 0)
+ (br $done)))
+
+ ;; for hash-maps, copy the key (inc ref since we are going
+ ;; to release it below)
+ (if (i32.eq $type (get_global $HASHMAP_T))
+ (then
+ (set_local $val3 $val2)
+ (set_local $val2 ($MEM_VAL1_ptr $ast))
+ (drop ($INC_REF $ast))))
+
+ ;; MAP_LOOP_UPDATE
+ (set_local $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3))
+ (if (i32.le_u $current (get_global $EMPTY_HASHMAP))
+ ;; if first element, set return to new element
+ (set_local $ret $res))
+ ;; update current to point to new element
+ (set_local $current $res)
+
+ (set_local $ast ($MEM_VAL0_ptr $ast))
+
+ (br $loop)
+ )
+ )
+ ;; MAP_LOOP_DONE
+ (set_local $res $ret)
+ ;; EVAL_AST_RETURN: nothing to do
+ (br $done))
+ ;; default
+ (set_local $res ($INC_REF $ast))
+ )
+
+ $res
+ )
+
+ (type $fnT (func (param i32) (result i32)))
+
+ (table anyfunc
+ (elem
+ $add $subtract $multiply $divide))
+
+ (func $EVAL (param $ast i32) (param $env i32) (result i32)
+ (local $res i32)
+ (local $f_args i32)
+ (local $f i32)
+ (local $args i32)
+ (local $type i32)
+ (local $ftype i32)
+
+ (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))
+
+ (if (i32.ne $type (get_global $LIST_T))
+ (return ($EVAL_AST $ast $env)))
+
+ ;; APPLY_LIST
+ (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))
+
+ ;; rest
+ (set_local $args ($MEM_VAL0_ptr $f_args))
+ ;; value
+ (set_local $f ($MEM_VAL1_ptr $f_args))
+
+ (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)
+ (set_local $res 0)))
+
+ ($RELEASE $f_args)
+
+ $res
+ )
+
+ ;; PRINT
+ (func $PRINT (param $ast i32) (result i32)
+ ($pr_str $ast)
+ )
+
+ ;; REPL
+ (func $rep (param $line i32) (param $env i32) (result i32)
+ (local $mv1 i32)
+ (local $mv2 i32)
+ (local $ms i32)
+ (block $rep_done
+ (set_local $mv1 ($READ $line))
+ (if (get_global $error_type) (br $rep_done))
+
+ (set_local $mv2 ($EVAL $mv1 $env))
+ (if (get_global $error_type) (br $rep_done))
+
+;; ($PR_MEMORY -1 -1)
+ (set_local $ms ($PRINT $mv2))
+ )
+
+ ;; release memory from MAL_READ and EVAL
+ ($RELEASE $mv2)
+ ($RELEASE $mv1)
+ $ms
+ )
+
+ (func $add (param $args i32) (result i32)
+ ($INTEGER
+ (i32.add ($VAL0 ($MEM_VAL1_ptr $args))
+ ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
+ (func $subtract (param $args i32) (result i32)
+ ($INTEGER
+ (i32.sub_s ($VAL0 ($MEM_VAL1_ptr $args))
+ ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
+ (func $multiply (param $args i32) (result i32)
+ ($INTEGER
+ (i32.mul_s ($VAL0 ($MEM_VAL1_ptr $args))
+ ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
+ (func $divide (param $args i32) (result i32)
+ ($INTEGER
+ (i32.div_s ($VAL0 ($MEM_VAL1_ptr $args))
+ ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
+
+ (func $main (result i32)
+ ;; Constant location/value definitions
+ (local $line i32)
+ (local $res i32)
+ (local $repl_env i32)
+
+ ;; 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 "string_mem: %d\n" (get_global $string_mem))
+
+ (set_local $repl_env ($HASHMAP))
+
+ (set_local $repl_env ($ASSOC1_S $repl_env "+" ($FUNCTION 0)))
+ (set_local $repl_env ($ASSOC1_S $repl_env "-" ($FUNCTION 1)))
+ (set_local $repl_env ($ASSOC1_S $repl_env "*" ($FUNCTION 2)))
+ (set_local $repl_env ($ASSOC1_S $repl_env "/" ($FUNCTION 3)))
+
+ ($PR_MEMORY -1 -1)
+;; ($PR_MEMORY_RAW (get_global $mem)
+;; (i32.add (get_global $mem)
+;; (i32.mul_u (get_global $mem_unused_start)
+;; 8)))
+
+ ;; Start
+ (block $repl_done
+ (loop $repl_loop
+ (set_local $line ($readline "user> "))
+ (if (i32.eqz $line) (br $repl_done))
+ (if (i32.eq (i32.load8_u $line) 0)
+ (then
+ ($free $line)
+ (br $repl_loop)))
+ (set_local $res ($rep $line $repl_env))
+ (if (get_global $error_type)
+ (then
+ ($printf_1 "Error: %s\n" (get_global $error_str))
+ (set_global $error_type 0))
+ (else
+ ($printf_1 "%s\n" ($to_String $res))))
+ ($RELEASE $res)
+;; ($PR_MEMORY -1 -1)
+ ($free $line)
+ (br $repl_loop)))
+
+ ($print "\n")
+ ($PR_MEMORY -1 -1)
+ 0
+ )
+
+
+ (export "_main" (func $main))
+ (export "__post_instantiate" (func $init_memory))
+)
+
+++ /dev/null
-(module $step1_read_print
- (import "env" "memory" (memory $0 256))
- (import "env" "memoryBase" (global $memoryBase i32))
-
- ;; READ
- (func $READ (param $str i32) (result i32)
- (call $read_str (get_local $str))
- )
-
- ;; EVAL
- (func $EVAL_AST (param $ast i32) (param $env i32) (result i32)
- (local $res i32)
- (local $val2 i32)
- (local $val3 i32)
- (local $ret i32)
- (local $empty i32)
- (local $current i32)
- (local $type i32)
- (local $res2 i64)
- (local $found i32)
-
- (if (get_global $error_type) (return (i32.const 0)))
- (set_local $type (call $TYPE (get_local $ast)))
-
- ;;; switch(type)
- (block $done
- (block $default (block (block
- (br_table 2 2 2 2 2 0 1 1 1 2 2 2 2 2 2 2 (get_local $type)))
- ;; symbol
- ;; found/res returned as hi 32/lo 32 of i64
- (set_local $res2 (call $HASHMAP_GET (get_local $env) (get_local $ast)))
- (set_local $res (i32.wrap/i64 (get_local $res2)))
- (set_local $found (i32.wrap/i64 (i64.shr_u (get_local $res2)
- (i64.const 32))))
- (if (i32.eqz (get_local $found))
- (call $THROW_STR_1 (STRING "'%s' not found")
- (call $to_String (get_local $ast))))
- (set_local $res (call $INC_REF (get_local $res)))
-
- (br $done))
- ;; list, vector, hashmap
- ;; MAP_LOOP_START
- (set_local $res (call $MAP_LOOP_START (get_local $type)))
- ;; push MAP_LOOP stack
- ;;; empty = current = ret = res
- (set_local $ret (get_local $res))
- (set_local $current (get_local $res))
- (set_local $empty (get_local $res))
-
- (block $done
- (loop $loop
- ;; check if we are done evaluating the source sequence
- (if (i32.eq (call $VAL0 (get_local $ast)) (i32.const 0))
- (br $done))
-
- (if (i32.eq (get_local $type) (get_global $HASHMAP_T))
- (then
- (set_local $res (call $EVAL (call $MEM_VAL2_ptr (get_local $ast))
- (get_local $env))))
- (else
- (set_local $res (call $EVAL (call $MEM_VAL1_ptr (get_local $ast))
- (get_local $env)))))
- (set_local $val2 (get_local $res))
-
- ;; if error, release the unattached element
- (if (get_global $error_type)
- (then
- (call $RELEASE (get_local $res))
- (set_local $res (i32.const 0))
- (br $done)))
-
- ;; for hash-maps, copy the key (inc ref since we are going
- ;; to release it below)
- (if (i32.eq (get_local $type) (get_global $HASHMAP_T))
- (then
- (set_local $val3 (get_local $val2))
- (set_local $val2 (call $MEM_VAL1_ptr (get_local $ast)))
- (drop (call $INC_REF (get_local $ast)))))
-
- ;; MAP_LOOP_UPDATE
- (set_local $res (call $MAP_LOOP_UPDATE (get_local $type)
- (get_local $empty) (get_local $current)
- (get_local $val2) (get_local $val3)))
- (if (i32.le_u (get_local $current) (get_global $EMPTY_HASHMAP))
- ;; if first element, set return to new element
- (set_local $ret (get_local $res)))
- ;; update current to point to new element
- (set_local $current (get_local $res))
-
- (set_local $ast (call $MEM_VAL0_ptr (get_local $ast)))
-
- (br $loop)
- )
- )
- ;; MAP_LOOP_DONE
- (set_local $res (get_local $ret))
- ;; EVAL_AST_RETURN: nothing to do
- (br $done))
- ;; default
- (set_local $res (call $INC_REF (get_local $ast)))
- )
-
- (get_local $res)
- )
-
- (type $fnT (func (param i32) (result i32)))
-
- (table anyfunc
- (elem
- $add $subtract $multiply $divide))
-
- (func $EVAL (param $ast i32) (param $env i32) (result i32)
- (local $res i32)
- (local $f_args i32)
- (local $f i32)
- (local $args i32)
- (local $type i32)
- (local $ftype i32)
-
- (set_local $res (i32.const 0))
- (set_local $f_args (i32.const 0))
- (set_local $f (i32.const 0))
- (set_local $args (i32.const 0))
- (set_local $type (call $TYPE (get_local $ast)))
-
- (if (get_global $error_type) (return (i32.const 0)))
-
- (if (i32.ne (get_local $type) (get_global $LIST_T))
- (return (call $EVAL_AST (get_local $ast) (get_local $env))))
-
- ;; APPLY_LIST
- (if (call $EMPTY_Q (get_local $ast))
- (return (call $INC_REF (get_local $ast))))
-
- ;; EVAL_INVOKE
- (set_local $res (call $EVAL_AST (get_local $ast) (get_local $env)))
- (set_local $f_args (get_local $res))
-
- ;; if error, return f/args for release by caller
- (if (get_global $error_type) (return (get_local $f_args)))
-
- ;; rest
- (set_local $args (call $MEM_VAL0_ptr (get_local $f_args)))
- ;; value
- (set_local $f (call $MEM_VAL1_ptr (get_local $f_args)))
-
- (set_local $ftype (call $TYPE (get_local $f)))
- (if (i32.eq (get_local $ftype) (get_global $FUNCTION_T))
- (then
- (set_local $res (call_indirect (type $fnT) (get_local $args)
- (call $VAL0 (get_local $f)))))
- (else
- (call $THROW_STR_1 (STRING "apply of non-function type: %d\n")
- (get_local $type))
- (set_local $res (i32.const 0))))
-
- (call $RELEASE (get_local $f_args))
-
- (get_local $res)
- )
-
- (func $PRINT (param $ast i32) (result i32)
- (call $pr_str (get_local $ast))
- )
-
- ;; REPL
- (func $rep (param $line i32) (param $env i32) (result i32)
- (local $mv1 i32)
- (local $mv2 i32)
- (local $ms i32)
- (block $rep_done
- (set_local $mv1 (call $READ (get_local $line)))
- (if (get_global $error_type) (br $rep_done))
-
- (set_local $mv2 (call $EVAL (get_local $mv1) (get_local $env)))
- (if (get_global $error_type) (br $rep_done))
-
-;; (call $PR_MEMORY (i32.const -1) (i32.const -1))
- (set_local $ms (call $PRINT (get_local $mv2)))
- )
-
- ;; release memory from MAL_READ and EVAL
- (call $RELEASE (get_local $mv2))
- (call $RELEASE (get_local $mv1))
- (get_local $ms)
- )
-
- (func $add (param $args i32) (result i32)
- (call $INTEGER
- (i32.add (call $VAL0 (call $MEM_VAL1_ptr (get_local $args)))
- (call $VAL0 (call $MEM_VAL1_ptr
- (call $MEM_VAL0_ptr (get_local $args)))))))
- (func $subtract (param $args i32) (result i32)
- (call $INTEGER
- (i32.sub_s (call $VAL0 (call $MEM_VAL1_ptr (get_local $args)))
- (call $VAL0 (call $MEM_VAL1_ptr
- (call $MEM_VAL0_ptr (get_local $args)))))))
- (func $multiply (param $args i32) (result i32)
- (call $INTEGER
- (i32.mul_s (call $VAL0 (call $MEM_VAL1_ptr (get_local $args)))
- (call $VAL0 (call $MEM_VAL1_ptr
- (call $MEM_VAL0_ptr (get_local $args)))))))
- (func $divide (param $args i32) (result i32)
- (call $INTEGER
- (i32.div_s (call $VAL0 (call $MEM_VAL1_ptr (get_local $args)))
- (call $VAL0 (call $MEM_VAL1_ptr
- (call $MEM_VAL0_ptr (get_local $args)))))))
-
- (func $main (result i32)
- ;; Constant location/value definitions
- (local $line i32)
- (local $res i32)
- (local $repl_env i32)
-
- ;; DEBUG
- (call $printf_1 (STRING "memoryBase: %d\n") (get_global $memoryBase))
- (call $printf_1 (STRING "heap_start: %d\n") (get_global $heap_start))
- (call $printf_1 (STRING "heap_end: %d\n") (get_global $heap_end))
- (call $printf_1 (STRING "mem: %d\n") (get_global $mem))
-;; (call $printf_1 (STRING "string_mem: %d\n") (get_global $string_mem))
-
- (set_local $repl_env (call $HASHMAP))
-
- (set_local $repl_env (call $ASSOC1_S (get_local $repl_env)
- (STRING "+") (call $FUNCTION (i32.const 0))))
- (set_local $repl_env (call $ASSOC1_S (get_local $repl_env)
- (STRING "-") (call $FUNCTION (i32.const 1))))
- (set_local $repl_env (call $ASSOC1_S (get_local $repl_env)
- (STRING "*") (call $FUNCTION (i32.const 2))))
- (set_local $repl_env (call $ASSOC1_S (get_local $repl_env)
- (STRING "/") (call $FUNCTION (i32.const 3))))
-
- (call $PR_MEMORY (i32.const -1) (i32.const -1))
-;; (call $PR_MEMORY_RAW (get_global $mem)
-;; (i32.add (get_global $mem)
-;; (i32.mul_u (get_global $mem_unused_start)
-;; (i32.const 8))))
-
- ;; Start
- (block $repl_done
- (loop $repl_loop
- (set_local $line (call $readline (STRING "user> ")))
- (if (i32.eqz (get_local $line)) (br $repl_done))
- (if (i32.eq (i32.load8_u (get_local $line)) (i32.const 0))
- (then
- (call $free (get_local $line))
- (br $repl_loop)))
- (set_local $res (call $rep (get_local $line) (get_local $repl_env)))
- (if (get_global $error_type)
- (then
- (call $printf_1 (STRING "Error: %s\n") (get_global $error_str))
- (set_global $error_type (i32.const 0)))
- (else
- (call $printf_1 (STRING "%s\n") (call $to_String (get_local $res)))))
- (call $RELEASE (get_local $res))
-;; (call $PR_MEMORY (i32.const -1) (i32.const -1))
- (call $free (get_local $line))
- (br $repl_loop)))
-
- (call $print (STRING "\n"))
- (call $PR_MEMORY (i32.const -1) (i32.const -1))
- (i32.const 0)
- )
-
-
- (export "_main" (func $main))
- (export "__post_instantiate" (func $init_memory))
-)
-
--- /dev/null
+(module $step1_read_print
+ (import "env" "memory" (memory $0 256))
+ (import "env" "memoryBase" (global $memoryBase i32))
+
+ ;; READ
+ (func $READ (param $str i32) (result i32)
+ ($read_str $str)
+ )
+
+ ;; EVAL
+ (func $EVAL_AST (param $ast i32) (param $env i32) (result i32)
+ (local $res i32)
+ (local $val2 i32)
+ (local $val3 i32)
+ (local $ret i32)
+ (local $empty i32)
+ (local $current i32)
+ (local $type i32)
+ (local $found i32)
+
+ (if (get_global $error_type) (return 0))
+ (set_local $type ($TYPE $ast))
+
+ ;;; switch(type)
+ (block $done
+ (block $default (block (block
+ (br_table 2 2 2 2 2 0 1 1 1 2 2 2 2 2 2 2 $type))
+ ;; symbol
+ ;; found/res returned as hi 32/lo 32 of i64
+ (set_local $res ($ENV_GET $env $ast))
+ (br $done))
+ ;; list, vector, hashmap
+ ;; 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)
+
+ (block $done
+ (loop $loop
+ ;; check if we are done evaluating the source sequence
+ (if (i32.eq ($VAL0 $ast) 0)
+ (br $done))
+
+ (if (i32.eq $type (get_global $HASHMAP_T))
+ (then
+ (set_local $res ($EVAL ($MEM_VAL2_ptr $ast) $env)))
+ (else
+ (set_local $res ($EVAL ($MEM_VAL1_ptr $ast) $env))))
+ (set_local $val2 $res)
+
+ ;; if error, release the unattached element
+ (if (get_global $error_type)
+ (then
+ ($RELEASE $res)
+ (set_local $res 0)
+ (br $done)))
+
+ ;; for hash-maps, copy the key (inc ref since we are going
+ ;; to release it below)
+ (if (i32.eq $type (get_global $HASHMAP_T))
+ (then
+ (set_local $val3 $val2)
+ (set_local $val2 ($MEM_VAL1_ptr $ast))
+ (drop ($INC_REF $ast))))
+
+ ;; MAP_LOOP_UPDATE
+ (set_local $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3))
+ (if (i32.le_u $current (get_global $EMPTY_HASHMAP))
+ ;; if first element, set return to new element
+ (set_local $ret $res))
+ ;; update current to point to new element
+ (set_local $current $res)
+
+ (set_local $ast ($MEM_VAL0_ptr $ast))
+
+ (br $loop)
+ )
+ )
+ ;; MAP_LOOP_DONE
+ (set_local $res $ret)
+ ;; EVAL_AST_RETURN: nothing to do
+ (br $done))
+ ;; default
+ (set_local $res ($INC_REF $ast))
+ )
+
+ $res
+ )
+
+ (type $fnT (func (param i32) (result i32)))
+
+ (table anyfunc
+ (elem
+ $add $subtract $multiply $divide))
+
+ (func $MAL_GET_A1 (param $ast i32) (result i32)
+ ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))
+ (func $MAL_GET_A2 (param $ast i32) (result i32)
+ ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))
+ (func $MAL_GET_A3 (param $ast i32) (result i32)
+ ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))))
+
+ (func $EVAL (param $ast i32) (param $env i32) (result i32)
+ (local $res i32)
+ (local $f_args i32)
+ (local $f i32)
+ (local $args i32)
+ (local $type i32)
+ (local $ftype i32)
+ (local $a0 i32)
+ (local $a0sym i32)
+ (local $a1 i32)
+ (local $a2 i32)
+ (local $let_env i32)
+
+ (set_local $res 0)
+ (set_local $f_args 0)
+ (set_local $f 0)
+ (set_local $args 0)
+ (set_local $type ($TYPE $ast))
+
+ ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
+
+ (if (get_global $error_type) (return 0))
+
+ (if (i32.ne $type (get_global $LIST_T))
+ (return ($EVAL_AST $ast $env)))
+
+ ;; APPLY_LIST
+ (if ($EMPTY_Q $ast) (return ($INC_REF $ast)))
+
+ (set_local $a0 ($MEM_VAL1_ptr $ast))
+ (set_local $a0sym "")
+ (if (i32.eq ($TYPE $a0) (get_global $SYMBOL_T))
+ (set_local $a0sym ($to_String $a0)))
+
+ (if (i32.eqz ($strcmp "def!" $a0sym))
+ (then
+ (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) (return $res))
+
+ ;; set a1 in env to a2
+ (set_local $res ($ENV_SET $env $a1 $res)))
+ (else (if (i32.eqz ($strcmp "let*" $a0sym))
+ (then
+ (set_local $a1 ($MAL_GET_A1 $ast))
+ (set_local $a2 ($MAL_GET_A2 $ast))
+
+ ;; create new environment with outer as current environment
+ (set_local $let_env ($ENV_NEW $env))
+
+ (block $done
+ (loop $loop
+ (if (i32.eqz ($VAL0 $a1))
+ (br $done))
+ ;; 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))
+
+ ;; set key/value in the let environment
+ (set_local $res ($ENV_SET $let_env ($MEM_VAL1_ptr $a1) $res))
+ ;; release our use, ENV_SET took ownership
+ ($RELEASE $res)
+
+ ;; skip to the next pair of a1 elements
+ (set_local $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1)))
+ (br $loop)
+ )
+ )
+ (set_local $res ($EVAL $a2 $let_env))
+ ;; EVAL_RETURN
+ ($RELEASE $let_env))
+ (else
+ ;; 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))
+
+ ;; rest
+ (set_local $args ($MEM_VAL0_ptr $f_args))
+ ;; value
+ (set_local $f ($MEM_VAL1_ptr $f_args))
+
+ (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)
+ (set_local $res 0)))
+
+ ($RELEASE $f_args)))))
+
+ $res
+ )
+
+ (func $PRINT (param $ast i32) (result i32)
+ ($pr_str $ast)
+ )
+
+ ;; REPL
+ (func $rep (param $line i32) (param $env i32) (result i32)
+ (local $mv1 i32)
+ (local $mv2 i32)
+ (local $ms i32)
+ (block $rep_done
+ (set_local $mv1 ($READ $line))
+ (if (get_global $error_type) (br $rep_done))
+
+ (set_local $mv2 ($EVAL $mv1 $env))
+ (if (get_global $error_type) (br $rep_done))
+
+;; ($PR_MEMORY -1 -1)
+ (set_local $ms ($PRINT $mv2))
+ )
+
+ ;; release memory from MAL_READ and EVAL
+ ($RELEASE $mv2)
+ ($RELEASE $mv1)
+ $ms
+ )
+
+ (func $add (param $args i32) (result i32)
+ ($INTEGER
+ (i32.add ($VAL0 ($MEM_VAL1_ptr $args))
+ ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
+ (func $subtract (param $args i32) (result i32)
+ ($INTEGER
+ (i32.sub_s ($VAL0 ($MEM_VAL1_ptr $args))
+ ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
+ (func $multiply (param $args i32) (result i32)
+ ($INTEGER
+ (i32.mul_s ($VAL0 ($MEM_VAL1_ptr $args))
+ ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
+ (func $divide (param $args i32) (result i32)
+ ($INTEGER
+ (i32.div_s ($VAL0 ($MEM_VAL1_ptr $args))
+ ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
+ (func $pr_memory (param $args i32) (result i32)
+ ($PR_MEMORY -1 -1)
+ ($INC_REF (get_global $NIL)))
+
+ (func $main (result i32)
+ ;; Constant location/value definitions
+ (local $line i32)
+ (local $res i32)
+ (local $repl_env i32)
+
+ ;; 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 "string_mem: %d\n" (get_global $string_mem))
+
+ (set_local $repl_env ($ENV_NEW (get_global $NIL)))
+
+ (drop ($ENV_SET_S $repl_env "+" ($FUNCTION 0)))
+ (drop ($ENV_SET_S $repl_env "-" ($FUNCTION 1)))
+ (drop ($ENV_SET_S $repl_env "*" ($FUNCTION 2)))
+ (drop ($ENV_SET_S $repl_env "/" ($FUNCTION 3)))
+
+ ($PR_MEMORY -1 -1)
+;; ($PR_MEMORY_RAW (get_global $mem)
+;; (i32.add (get_global $mem)
+;; (i32.mul_u (get_global $mem_unused_start)
+;; 8)))
+
+ ;; Start
+ (block $repl_done
+ (loop $repl_loop
+ (set_local $line ($readline "user> "))
+ (if (i32.eqz $line) (br $repl_done))
+ (if (i32.eq (i32.load8_u $line) 0)
+ (then
+ ($free $line)
+ (br $repl_loop)))
+ (set_local $res ($rep $line $repl_env))
+ (if (get_global $error_type)
+ (then
+ ($printf_1 "Error: %s\n" (get_global $error_str))
+ (set_global $error_type 0))
+ (else
+ ($printf_1 "%s\n" ($to_String $res))))
+ ($RELEASE $res)
+;; ($PR_MEMORY -1 -1)
+ ($free $line)
+ (br $repl_loop)))
+
+ ($print "\n")
+ ($PR_MEMORY -1 -1)
+ 0
+ )
+
+
+ (export "_main" (func $main))
+ (export "__post_instantiate" (func $init_memory))
+)
+
+++ /dev/null
-(module $step1_read_print
- (import "env" "memory" (memory $0 256))
- (import "env" "memoryBase" (global $memoryBase i32))
-
- ;; READ
- (func $READ (param $str i32) (result i32)
- (call $read_str (get_local $str))
- )
-
- ;; EVAL
- (func $EVAL_AST (param $ast i32) (param $env i32) (result i32)
- (local $res i32)
- (local $val2 i32)
- (local $val3 i32)
- (local $ret i32)
- (local $empty i32)
- (local $current i32)
- (local $type i32)
- (local $found i32)
-
- (if (get_global $error_type) (return (i32.const 0)))
- (set_local $type (call $TYPE (get_local $ast)))
-
- ;;; switch(type)
- (block $done
- (block $default (block (block
- (br_table 2 2 2 2 2 0 1 1 1 2 2 2 2 2 2 2 (get_local $type)))
- ;; symbol
- ;; found/res returned as hi 32/lo 32 of i64
- (set_local $res (call $ENV_GET (get_local $env) (get_local $ast)))
- (br $done))
- ;; list, vector, hashmap
- ;; MAP_LOOP_START
- (set_local $res (call $MAP_LOOP_START (get_local $type)))
- ;; push MAP_LOOP stack
- ;;; empty = current = ret = res
- (set_local $ret (get_local $res))
- (set_local $current (get_local $res))
- (set_local $empty (get_local $res))
-
- (block $done
- (loop $loop
- ;; check if we are done evaluating the source sequence
- (if (i32.eq (call $VAL0 (get_local $ast)) (i32.const 0))
- (br $done))
-
- (if (i32.eq (get_local $type) (get_global $HASHMAP_T))
- (then
- (set_local $res (call $EVAL (call $MEM_VAL2_ptr (get_local $ast))
- (get_local $env))))
- (else
- (set_local $res (call $EVAL (call $MEM_VAL1_ptr (get_local $ast))
- (get_local $env)))))
- (set_local $val2 (get_local $res))
-
- ;; if error, release the unattached element
- (if (get_global $error_type)
- (then
- (call $RELEASE (get_local $res))
- (set_local $res (i32.const 0))
- (br $done)))
-
- ;; for hash-maps, copy the key (inc ref since we are going
- ;; to release it below)
- (if (i32.eq (get_local $type) (get_global $HASHMAP_T))
- (then
- (set_local $val3 (get_local $val2))
- (set_local $val2 (call $MEM_VAL1_ptr (get_local $ast)))
- (drop (call $INC_REF (get_local $ast)))))
-
- ;; MAP_LOOP_UPDATE
- (set_local $res (call $MAP_LOOP_UPDATE (get_local $type)
- (get_local $empty) (get_local $current)
- (get_local $val2) (get_local $val3)))
- (if (i32.le_u (get_local $current) (get_global $EMPTY_HASHMAP))
- ;; if first element, set return to new element
- (set_local $ret (get_local $res)))
- ;; update current to point to new element
- (set_local $current (get_local $res))
-
- (set_local $ast (call $MEM_VAL0_ptr (get_local $ast)))
-
- (br $loop)
- )
- )
- ;; MAP_LOOP_DONE
- (set_local $res (get_local $ret))
- ;; EVAL_AST_RETURN: nothing to do
- (br $done))
- ;; default
- (set_local $res (call $INC_REF (get_local $ast)))
- )
-
- (get_local $res)
- )
-
- (type $fnT (func (param i32) (result i32)))
-
- (table anyfunc
- (elem
- $add $subtract $multiply $divide))
-
- (func $MAL_GET_A1 (param $ast i32) (result i32)
- (call $MEM_VAL1_ptr (call $MEM_VAL0_ptr (get_local $ast))))
- (func $MAL_GET_A2 (param $ast i32) (result i32)
- (call $MEM_VAL1_ptr (call $MEM_VAL0_ptr (call $MEM_VAL0_ptr (get_local $ast)))))
- (func $MAL_GET_A3 (param $ast i32) (result i32)
- (call $MEM_VAL1_ptr (call $MEM_VAL0_ptr (call $MEM_VAL0_ptr (call $MEM_VAL0_ptr (get_local $ast))))))
-
- (func $EVAL (param $ast i32) (param $env i32) (result i32)
- (local $res i32)
- (local $f_args i32)
- (local $f i32)
- (local $args i32)
- (local $type i32)
- (local $ftype i32)
- (local $a0 i32)
- (local $a0sym i32)
- (local $a1 i32)
- (local $a2 i32)
- (local $let_env i32)
-
- (set_local $res (i32.const 0))
- (set_local $f_args (i32.const 0))
- (set_local $f (i32.const 0))
- (set_local $args (i32.const 0))
- (set_local $type (call $TYPE (get_local $ast)))
-
- ;;(call $PR_VALUE (STRING ">>> EVAL ast: '%s'\n") (get_local $ast))
-
- (if (get_global $error_type) (return (i32.const 0)))
-
- (if (i32.ne (get_local $type) (get_global $LIST_T))
- (return (call $EVAL_AST (get_local $ast) (get_local $env))))
-
- ;; APPLY_LIST
- (if (call $EMPTY_Q (get_local $ast))
- (return (call $INC_REF (get_local $ast))))
-
- (set_local $a0 (call $MEM_VAL1_ptr (get_local $ast)))
- (set_local $a0sym (STRING ""))
- (if (i32.eq (call $TYPE (get_local $a0)) (get_global $SYMBOL_T))
- (set_local $a0sym (call $to_String (get_local $a0))))
-
- (if (i32.eqz (call $strcmp (STRING "def!") (get_local $a0sym)))
- (then
- (set_local $a1 (call $MAL_GET_A1 (get_local $ast)))
- (set_local $a2 (call $MAL_GET_A2 (get_local $ast)))
- (set_local $res (call $EVAL (get_local $a2) (get_local $env)))
- (if (get_global $error_type) (return (get_local $res)))
-
- ;; set a1 in env to a2
- (set_local $res (call $ENV_SET (get_local $env)
- (get_local $a1) (get_local $res))))
- (else (if (i32.eqz (call $strcmp (STRING "let*") (get_local $a0sym)))
- (then
- (set_local $a1 (call $MAL_GET_A1 (get_local $ast)))
- (set_local $a2 (call $MAL_GET_A2 (get_local $ast)))
-
- ;; create new environment with outer as current environment
- (set_local $let_env (call $ENV_NEW (get_local $env)))
-
- (block $done
- (loop $loop
- (if (i32.eqz (call $VAL0 (get_local $a1)))
- (br $done))
- ;; eval current A1 odd element
- (set_local $res (call $EVAL (call $MEM_VAL1_ptr
- (call $MEM_VAL0_ptr
- (get_local $a1)))
- (get_local $let_env)))
-
- (if (get_global $error_type) (br $done))
-
- ;; set key/value in the let environment
- (set_local $res (call $ENV_SET (get_local $let_env)
- (call $MEM_VAL1_ptr (get_local $a1))
- (get_local $res)))
- ;; release our use, ENV_SET took ownership
- (call $RELEASE (get_local $res))
-
- ;; skip to the next pair of a1 elements
- (set_local $a1 (call $MEM_VAL0_ptr
- (call $MEM_VAL0_ptr (get_local $a1))))
- (br $loop)
- )
- )
- (set_local $res (call $EVAL (get_local $a2) (get_local $let_env)))
- ;; EVAL_RETURN
- (call $RELEASE (get_local $let_env)))
- (else
- ;; EVAL_INVOKE
- (set_local $res (call $EVAL_AST (get_local $ast) (get_local $env)))
- (set_local $f_args (get_local $res))
-
- ;; if error, return f/args for release by caller
- (if (get_global $error_type) (return (get_local $f_args)))
-
- ;; rest
- (set_local $args (call $MEM_VAL0_ptr (get_local $f_args)))
- ;; value
- (set_local $f (call $MEM_VAL1_ptr (get_local $f_args)))
-
- (set_local $ftype (call $TYPE (get_local $f)))
- (if (i32.eq (get_local $ftype) (get_global $FUNCTION_T))
- (then
- (set_local $res (call_indirect (type $fnT) (get_local $args)
- (call $VAL0 (get_local $f)))))
- (else
- (call $THROW_STR_1 (STRING "apply of non-function type: %d\n")
- (get_local $type))
- (set_local $res (i32.const 0))))
-
- (call $RELEASE (get_local $f_args))))))
-
- (get_local $res)
- )
-
- (func $PRINT (param $ast i32) (result i32)
- (call $pr_str (get_local $ast))
- )
-
- ;; REPL
- (func $rep (param $line i32) (param $env i32) (result i32)
- (local $mv1 i32)
- (local $mv2 i32)
- (local $ms i32)
- (block $rep_done
- (set_local $mv1 (call $READ (get_local $line)))
- (if (get_global $error_type) (br $rep_done))
-
- (set_local $mv2 (call $EVAL (get_local $mv1) (get_local $env)))
- (if (get_global $error_type) (br $rep_done))
-
-;; (call $PR_MEMORY (i32.const -1) (i32.const -1))
- (set_local $ms (call $PRINT (get_local $mv2)))
- )
-
- ;; release memory from MAL_READ and EVAL
- (call $RELEASE (get_local $mv2))
- (call $RELEASE (get_local $mv1))
- (get_local $ms)
- )
-
- (func $add (param $args i32) (result i32)
- (call $INTEGER
- (i32.add (call $VAL0 (call $MEM_VAL1_ptr (get_local $args)))
- (call $VAL0 (call $MEM_VAL1_ptr
- (call $MEM_VAL0_ptr (get_local $args)))))))
- (func $subtract (param $args i32) (result i32)
- (call $INTEGER
- (i32.sub_s (call $VAL0 (call $MEM_VAL1_ptr (get_local $args)))
- (call $VAL0 (call $MEM_VAL1_ptr
- (call $MEM_VAL0_ptr (get_local $args)))))))
- (func $multiply (param $args i32) (result i32)
- (call $INTEGER
- (i32.mul_s (call $VAL0 (call $MEM_VAL1_ptr (get_local $args)))
- (call $VAL0 (call $MEM_VAL1_ptr
- (call $MEM_VAL0_ptr (get_local $args)))))))
- (func $divide (param $args i32) (result i32)
- (call $INTEGER
- (i32.div_s (call $VAL0 (call $MEM_VAL1_ptr (get_local $args)))
- (call $VAL0 (call $MEM_VAL1_ptr
- (call $MEM_VAL0_ptr (get_local $args)))))))
- (func $pr_memory (param $args i32) (result i32)
- (call $PR_MEMORY (i32.const -1) (i32.const -1))
- (call $INC_REF (get_global $NIL)))
-
- (func $main (result i32)
- ;; Constant location/value definitions
- (local $line i32)
- (local $res i32)
- (local $repl_env i32)
-
- ;; DEBUG
- (call $printf_1 (STRING "memoryBase: 0x%x\n") (get_global $memoryBase))
- (call $printf_1 (STRING "heap_start: 0x%x\n") (get_global $heap_start))
- (call $printf_1 (STRING "heap_end: 0x%x\n") (get_global $heap_end))
- (call $printf_1 (STRING "mem: 0x%x\n") (get_global $mem))
-;; (call $printf_1 (STRING "string_mem: %d\n") (get_global $string_mem))
-
- (set_local $repl_env (call $ENV_NEW (get_global $NIL)))
-
- (drop (call $ENV_SET_S (get_local $repl_env)
- (STRING "+") (call $FUNCTION (i32.const 0))))
- (drop (call $ENV_SET_S (get_local $repl_env)
- (STRING "-") (call $FUNCTION (i32.const 1))))
- (drop (call $ENV_SET_S (get_local $repl_env)
- (STRING "*") (call $FUNCTION (i32.const 2))))
- (drop (call $ENV_SET_S (get_local $repl_env)
- (STRING "/") (call $FUNCTION (i32.const 3))))
-
- (call $PR_MEMORY (i32.const -1) (i32.const -1))
-;; (call $PR_MEMORY_RAW (get_global $mem)
-;; (i32.add (get_global $mem)
-;; (i32.mul_u (get_global $mem_unused_start)
-;; (i32.const 8))))
-
- ;; Start
- (block $repl_done
- (loop $repl_loop
- (set_local $line (call $readline (STRING "user> ")))
- (if (i32.eqz (get_local $line)) (br $repl_done))
- (if (i32.eq (i32.load8_u (get_local $line)) (i32.const 0))
- (then
- (call $free (get_local $line))
- (br $repl_loop)))
- (set_local $res (call $rep (get_local $line) (get_local $repl_env)))
- (if (get_global $error_type)
- (then
- (call $printf_1 (STRING "Error: %s\n") (get_global $error_str))
- (set_global $error_type (i32.const 0)))
- (else
- (call $printf_1 (STRING "%s\n") (call $to_String (get_local $res)))))
- (call $RELEASE (get_local $res))
-;; (call $PR_MEMORY (i32.const -1) (i32.const -1))
- (call $free (get_local $line))
- (br $repl_loop)))
-
- (call $print (STRING "\n"))
- (call $PR_MEMORY (i32.const -1) (i32.const -1))
- (i32.const 0)
- )
-
-
- (export "_main" (func $main))
- (export "__post_instantiate" (func $init_memory))
-)
-
--- /dev/null
+;; Mal value memory layout
+;; type words
+;; ---------- ----------
+;; nil ref/ 0 | 0 | |
+;; false ref/ 1 | 0 | |
+;; true ref/ 1 | 1 | |
+;; integer ref/ 2 | int | |
+;; float ref/ 3 | ??? | |
+;; string/kw ref/ 4 | string ptr | |
+;; symbol ref/ 5 | string ptr | |
+;; list ref/ 6 | next mem idx | val mem idx |
+;; vector ref/ 7 | next mem idx | val mem idx |
+;; hashmap ref/ 8 | next mem idx | key mem idx | val mem idx
+;; function ref/ 9 | fn idx | |
+;; mal function ref/10 | body mem idx | param mem idx | env mem idx
+;; macro fn ref/11 | body mem idx | param mem idx | env mem idx
+;; atom ref/12 | val mem idx | |
+;; environment ref/13 | hmap mem idx | outer mem idx |
+;; metadata ref/14 | obj mem idx | meta mem idx |
+;; FREE sz/15 | next mem idx | |
+
+(module $types
+
+ (global $NIL_T i32 0)
+ (global $BOOLEAN_T i32 1)
+ (global $INTEGER_T i32 2)
+ (global $FLOAT_T i32 3)
+ (global $STRING_T i32 4)
+ (global $SYMBOL_T i32 5)
+ (global $LIST_T i32 6)
+ (global $VECTOR_T i32 7)
+ (global $HASHMAP_T i32 8)
+ (global $FUNCTION_T i32 9)
+ (global $MALFUNC_T i32 10)
+ (global $MACRO_T i32 11)
+ (global $ATOM_T i32 12)
+ (global $ENVIRONMENT_T i32 13)
+ (global $METADATA_T i32 14)
+ (global $FREE_T i32 15)
+
+ (global $error_type (mut i32) 0)
+ (global $error_val (mut i32) 0)
+ ;; Index into static string memory (static.wast)
+ (global $error_str (mut i32) 0)
+
+ (global $NIL (mut i32) 0)
+ (global $FALSE (mut i32) 0)
+ (global $TRUE (mut i32) 0)
+ (global $EMPTY_LIST (mut i32) 0)
+ (global $EMPTY_VECTOR (mut i32) 0)
+ (global $EMPTY_HASHMAP (mut i32) 0)
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; General functions
+
+ (func $INC_REF (param $mv i32) (result i32)
+ (i32.store $mv (i32.add (i32.load $mv) 32))
+ $mv)
+
+ (func $THROW_STR_0 (param $fmt i32)
+ (drop ($sprintf_1 (get_global $error_str) $fmt ""))
+ (set_global $error_type 1))
+
+ (func $THROW_STR_1 (param $fmt i32) (param $v0 i32)
+ (drop ($sprintf_1 (get_global $error_str) $fmt $v0))
+ (set_global $error_type 1))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; numeric functions
+
+ (func $INTEGER (param $val i32) (result i32)
+ ($ALLOC_SCALAR (get_global $INTEGER_T) $val))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; 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)))))))
+
+ ($INC_REF $res)
+ )
+
+ (func $MAP_LOOP_UPDATE (param $type i32) (param $empty i32)
+ (param $current i32) (param $val2 i32) (param $val3 i32)
+ (result i32)
+ (local $res i32)
+
+ (set_local $res ($ALLOC $type $empty $val2 $val3))
+ ;; sequence took ownership
+ ($RELEASE $empty)
+ ($RELEASE $val2)
+ (if (i32.eq $type (get_global $HASHMAP_T))
+ ($RELEASE $val3))
+ (if (i32.gt_u $current (get_global $EMPTY_HASHMAP))
+ ;; if not first element, set current next to point to new element
+ (i32.store ($VAL0_ptr $current) ($MalVal_index $res)))
+
+ $res
+ )
+
+ (func $EMPTY_Q (param $mv i32) (result i32)
+ (i32.eq ($VAL0 $mv) 0)
+ )
+
+ (func $HASHMAP (result i32)
+ ;; just point to static empty hash-map
+ ($INC_REF (get_global $EMPTY_HASHMAP))
+ )
+
+ (func $ASSOC1 (param $hm i32) (param $k i32) (param $v i32) (result i32)
+ (local $res i32)
+ (set_local $res ($ALLOC (get_global $HASHMAP_T) $hm $k $v))
+ ;; we took ownership of previous release
+ ($RELEASE $hm)
+ $res
+ )
+
+ (func $ASSOC1_S (param $hm i32) (param $k i32) (param $v i32) (result i32)
+ (local $kmv i32)
+ (local $res i32)
+ (set_local $kmv ($STRING (get_global $STRING_T) $k))
+ (set_local $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)
+ (local $found i32)
+ (local $key i32)
+ (local $test_key_mv i32)
+
+ (set_local $key ($to_String $key_mv))
+ (set_local $found 0)
+
+
+ (block $done
+ (loop $loop
+ ;;; if (VAL0(hm) == 0)
+ (if (i32.eq ($VAL0 $hm) 0)
+ (then
+ (set_local $res (get_global $NIL))
+ (br $done)))
+ ;;; test_key_mv = MEM_VAL1(hm)
+ (set_local $test_key_mv ($MEM_VAL1_ptr $hm))
+ ;;; if (strcmp(key, to_String(test_key_mv)) == 0)
+ (if (i32.eq ($strcmp $key ($to_String $test_key_mv)) 0)
+ (then
+ (set_local $found 1)
+ (set_local $res ($MEM_VAL2_ptr $hm))
+ (br $done)))
+ (set_local $hm ($MEM_VAL0_ptr $hm))
+
+ (br $loop)
+ )
+ )
+
+ ;; combine found/res as hi 32/low 32 of i64
+ (i64.or (i64.shl_u (i64.extend_u/i32 $found) (i64.const 32))
+ (i64.extend_u/i32 $res))
+ )
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; function functions
+
+ (func $FUNCTION (param $index i32) (result i32)
+ ($ALLOC_SCALAR (get_global $FUNCTION_T) $index)
+ )
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; string functions
+
+ (func $to_String (param $mv i32) (result i32)
+ ;; skip string refcnt
+ (i32.add 4 ($MalVal_val ($MalVal_index $mv) 0)))
+)
+++ /dev/null
-;; Mal value memory layout
-;; type words
-;; ---------- ----------
-;; nil ref/ 0 | 0 | |
-;; false ref/ 1 | 0 | |
-;; true ref/ 1 | 1 | |
-;; integer ref/ 2 | int | |
-;; float ref/ 3 | ??? | |
-;; string/kw ref/ 4 | string ptr | |
-;; symbol ref/ 5 | string ptr | |
-;; list ref/ 6 | next mem idx | val mem idx |
-;; vector ref/ 7 | next mem idx | val mem idx |
-;; hashmap ref/ 8 | next mem idx | key mem idx | val mem idx
-;; function ref/ 9 | fn idx | |
-;; mal function ref/10 | body mem idx | param mem idx | env mem idx
-;; macro fn ref/11 | body mem idx | param mem idx | env mem idx
-;; atom ref/12 | val mem idx | |
-;; environment ref/13 | hmap mem idx | outer mem idx |
-;; metadata ref/14 | obj mem idx | meta mem idx |
-;; FREE sz/15 | next mem idx | |
-
-(module $types
-
- (global $NIL_T i32 (i32.const 0))
- (global $BOOLEAN_T i32 (i32.const 1))
- (global $INTEGER_T i32 (i32.const 2))
- (global $FLOAT_T i32 (i32.const 3))
- (global $STRING_T i32 (i32.const 4))
- (global $SYMBOL_T i32 (i32.const 5))
- (global $LIST_T i32 (i32.const 6))
- (global $VECTOR_T i32 (i32.const 7))
- (global $HASHMAP_T i32 (i32.const 8))
- (global $FUNCTION_T i32 (i32.const 9))
- (global $MALFUNC_T i32 (i32.const 10))
- (global $MACRO_T i32 (i32.const 11))
- (global $ATOM_T i32 (i32.const 12))
- (global $ENVIRONMENT_T i32 (i32.const 13))
- (global $METADATA_T i32 (i32.const 14))
- (global $FREE_T i32 (i32.const 15))
-
- (global $error_type (mut i32) (i32.const 0))
- (global $error_val (mut i32) (i32.const 0))
- ;; Index into static string memory (static.wast)
- (global $error_str (mut i32) (i32.const 0))
-
- (global $NIL (mut i32) (i32.const 0))
- (global $FALSE (mut i32) (i32.const 0))
- (global $TRUE (mut i32) (i32.const 0))
- (global $EMPTY_LIST (mut i32) (i32.const 0))
- (global $EMPTY_VECTOR (mut i32) (i32.const 0))
- (global $EMPTY_HASHMAP (mut i32) (i32.const 0))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; General functions
-
- (func $INC_REF (param $mv i32) (result i32)
- (i32.store (get_local $mv)
- (i32.add (i32.load (get_local $mv))
- (i32.const 32)))
- (get_local $mv))
-
- (func $THROW_STR_0 (param $fmt i32)
- (drop (call $sprintf_1 (get_global $error_str) (get_local $fmt) (STRING "")))
- (set_global $error_type (i32.const 1)))
-
- (func $THROW_STR_1 (param $fmt i32) (param $v0 i32)
- (drop (call $sprintf_1 (get_global $error_str) (get_local $fmt) (get_local $v0)))
- (set_global $error_type (i32.const 1)))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; numeric functions
-
- (func $INTEGER (param $val i32) (result i32)
- (call $ALLOC_SCALAR (get_global $INTEGER_T) (get_local $val)))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; sequence functions
-
- (func $MAP_LOOP_START (param $type i32) (result i32)
- (local $res i32)
- (set_local $res (if i32 (i32.eq (get_local $type)
- (get_global $LIST_T))
- (get_global $EMPTY_LIST)
- (else (if i32 (i32.eq (get_local $type)
- (get_global $VECTOR_T))
- (get_global $EMPTY_VECTOR)
- (else (if i32 (i32.eq (get_local $type)
- (get_global $HASHMAP_T))
- (get_global $EMPTY_HASHMAP)
- (else
- (call $THROW_STR_1 (STRING "read_seq invalid type %d")
- (get_local $type))
- (i32.const 0))))))))
-
- (call $INC_REF (get_local $res))
- )
-
- (func $MAP_LOOP_UPDATE (param $type i32) (param $empty i32)
- (param $current i32) (param $val2 i32) (param $val3 i32)
- (result i32)
- (local $res i32)
-
- (set_local $res (call $ALLOC (get_local $type) (get_local $empty)
- (get_local $val2) (get_local $val3)))
- ;; sequence took ownership
- (call $RELEASE (get_local $empty))
- (call $RELEASE (get_local $val2))
- (if (i32.eq (get_local $type) (get_global $HASHMAP_T))
- (call $RELEASE (get_local $val3)))
- (if (i32.gt_u (get_local $current) (get_global $EMPTY_HASHMAP))
- ;; if not first element, set current next to point to new element
- (i32.store (call $VAL0_ptr (get_local $current))
- (call $MalVal_index (get_local $res))))
-
- (get_local $res)
- )
-
- (func $EMPTY_Q (param $mv i32) (result i32)
- (i32.eq (call $VAL0 (get_local $mv)) (i32.const 0))
- )
-
- (func $HASHMAP (result i32)
- ;; just point to static empty hash-map
- (call $INC_REF (get_global $EMPTY_HASHMAP))
- )
-
- (func $ASSOC1 (param $hm i32) (param $k i32) (param $v i32) (result i32)
- (local $res i32)
- (set_local $res (call $ALLOC (get_global $HASHMAP_T) (get_local $hm)
- (get_local $k) (get_local $v)))
- ;; we took ownership of previous release
- (call $RELEASE (get_local $hm))
- (get_local $res)
- )
-
- (func $ASSOC1_S (param $hm i32) (param $k i32) (param $v i32) (result i32)
- (local $kmv i32)
- (local $res i32)
- (set_local $kmv (call $STRING (get_global $STRING_T) (get_local $k)))
- (set_local $res (call $ASSOC1 (get_local $hm)
- (get_local $kmv) (get_local $v)))
- ;; map took ownership of key
- (call $RELEASE (get_local $kmv))
- (get_local $res)
- )
-
- (func $HASHMAP_GET (param $hm i32) (param $key_mv i32) (result i64)
- (local $res i32)
- (local $found i32)
- (local $key i32)
- (local $test_key_mv i32)
-
- (set_local $key (call $to_String (get_local $key_mv)))
- (set_local $found (i32.const 0))
-
-
- (block $done
- (loop $loop
- ;;; if (VAL0(hm) == 0)
- (if (i32.eq (call $VAL0 (get_local $hm)) (i32.const 0))
- (then
- (set_local $res (get_global $NIL))
- (br $done)))
- ;;; test_key_mv = MEM_VAL1(hm)
- (set_local $test_key_mv (call $MEM_VAL1_ptr (get_local $hm)))
- ;;; if (strcmp(key, to_String(test_key_mv)) == 0)
- (if (i32.eq (call $strcmp (get_local $key)
- (call $to_String (get_local $test_key_mv)))
- (i32.const 0))
- (then
- (set_local $found (i32.const 1))
- (set_local $res (call $MEM_VAL2_ptr (get_local $hm)))
- (br $done)))
- (set_local $hm (call $MEM_VAL0_ptr (get_local $hm)))
-
- (br $loop)
- )
- )
-
- ;; combine found/res as hi 32/low 32 of i64
- (i64.or
- (i64.shl_u (i64.extend_u/i32 (get_local $found))
- (i64.const 32))
- (i64.extend_u/i32 (get_local $res)))
- )
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; function functions
-
- (func $FUNCTION (param $index i32) (result i32)
- (call $ALLOC_SCALAR (get_global $FUNCTION_T) (get_local $index))
- )
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; string functions
-
- (func $to_String (param $mv i32) (result i32)
- (i32.add (i32.const 4) ;; skip string refcnt
- (call $MalVal_val
- (call $MalVal_index (get_local $mv))
- (i32.const 0))))
-)
--- /dev/null
+(module $util
+ (import "env" "malloc" (func $malloc (param i32) (result i32)))
+ (import "env" "free" (func $free (param i32)))
+ (import "env" "exit" (func $exit (param i32)))
+
+ (import "env" "stdout" (global $stdout i32))
+ (import "env" "putchar" (func $putchar (param i32) (result i32)))
+ (import "env" "fputs" (func $fputs (param i32 i32) (result i32)))
+ ;;(import "env" "readline" (func $readline (param i32) (result i32)))
+ (import "libedit.so" "readline" (func $readline (param i32) (result i32)))
+ ;;(import "libreadline.so" "readline" (func $readline (param i32) (result i32)))
+
+ (global $sprintf_buf (mut i32) 0)
+
+ (func $init_sprintf_mem
+ ;; 256 character sprintf static buffer
+ (set_global $sprintf_buf " ")
+ )
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ ;; Copy len chatacters from src to dst
+ ;; Returns len
+ (func $MEM_COPY (param $dst i32) (param $src i32) (param $len i32)
+ (local $idx i32)
+ (set_local $idx 0)
+ (loop $copy
+ (i32.store8_u (i32.add $idx $dst)
+ (i32.load8_u (i32.add $idx $src)))
+ (set_local $idx (i32.add 1 $idx))
+ (br_if $copy (i32.lt_u $idx $len))
+ )
+ )
+
+ (func $STRING_LEN (param $str i32) (result i32)
+ (local $cur i32)
+ (set_local $cur $str)
+ (loop $count
+ (if (i32.ne 0 (i32.load8_u $cur))
+ (then
+ (set_local $cur (i32.add $cur 1))
+ (br $count)))
+ )
+ (i32.sub_u $cur $str)
+ )
+
+ (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)
+ (block $done
+ (loop $loop
+ (set_local $ch (i32.load8_u (i32.add $str $i)))
+ (if (i32.and (i32.ne $ch (CHR "-"))
+ (i32.or (i32.lt_u $ch (CHR "0"))
+ (i32.gt_u $ch (CHR "9"))))
+ (br $done))
+ (set_local $i (i32.add $i 1))
+ (if (i32.eq $ch (CHR "-"))
+ (then
+ (set_local $neg 1))
+ (else
+ (set_local $acc (i32.add (i32.mul_u $acc 10)
+ (i32.sub_u $ch (CHR "0"))))))
+ (br $loop)
+ )
+ )
+ (if i32 $neg
+ (then (i32.sub_s 0 $acc))
+ (else $acc))
+ )
+
+ (func $strcmp (param $s1 i32) (param $s2 i32) (result i32)
+ (block $done
+ (loop $loop
+ (if (i32.or (i32.eqz (i32.load8_u $s1))
+ (i32.eqz (i32.load8_u $s2)))
+ (br $done))
+ (if (i32.ne (i32.load8_u $s1)
+ (i32.load8_u $s2))
+ (br $done))
+ (set_local $s1 (i32.add $s1 1))
+ (set_local $s2 (i32.add $s2 1))
+ (br $loop)
+ )
+ )
+ (if i32 (i32.eq (i32.load8_u $s1)
+ (i32.load8_u $s2))
+ (then 0)
+ (else
+ (if i32 (i32.lt_u (i32.load8_u $s1)
+ (i32.load8_u $s2))
+ (then -1)
+ (else 1))))
+ )
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ (func $print (param $addr i32)
+ (drop ($fputs $addr (get_global $stdout))))
+
+ (func $printf_1 (param $fmt i32)
+ (param $v0 i32)
+ (drop ($sprintf_6 (get_global $sprintf_buf) $fmt $v0 0 0 0 0 0))
+ ($print (get_global $sprintf_buf))
+ )
+
+ (func $printf_2 (param $fmt i32)
+ (param $v0 i32) (param $v1 i32)
+ (drop ($sprintf_6 (get_global $sprintf_buf) $fmt $v0 $v1 0 0 0 0))
+ ($print (get_global $sprintf_buf))
+ )
+
+ (func $printf_3 (param $fmt i32)
+ (param $v0 i32) (param $v1 i32) (param $v2 i32)
+ (drop ($sprintf_6 (get_global $sprintf_buf) $fmt $v0 $v1 $v2 0 0 0))
+ ($print (get_global $sprintf_buf))
+ )
+
+ (func $printf_4 (param $fmt i32)
+ (param $v0 i32) (param $v1 i32) (param $v2 i32)
+ (param $v3 i32)
+ (drop ($sprintf_6 (get_global $sprintf_buf) $fmt $v0 $v1 $v2 $v3 0 0))
+ ($print (get_global $sprintf_buf))
+ )
+
+ (func $printf_5 (param $fmt i32)
+ (param $v0 i32) (param $v1 i32) (param $v2 i32)
+ (param $v3 i32) (param $v4 i32)
+ (drop ($sprintf_6 (get_global $sprintf_buf) $fmt $v0 $v1 $v2 $v3 $v4 0))
+ ($print (get_global $sprintf_buf))
+ )
+
+ (func $printf_6 (param $fmt i32)
+ (param $v0 i32) (param $v1 i32) (param $v2 i32)
+ (param $v3 i32) (param $v4 i32) (param $v5 i32)
+ (drop ($sprintf_6 (get_global $sprintf_buf) $fmt $v0 $v1 $v2 $v3 $v4 $v5))
+ ($print (get_global $sprintf_buf))
+ )
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ (func $_sprintdigit (param $str i32) (param $num i32) (param $base i32)
+ (local $n i32)
+ (local $ch i32)
+ (set_local $n (i32.rem_u $num $base))
+ (set_local $ch (if (result i32) (i32.lt_u $n 10)
+ 48
+ 55))
+ (i32.store8_u $str (i32.add $n $ch))
+ )
+
+ ;; TODO: switch to snprint* (add buffer len)
+ (func $_sprintnum (param $str i32) (param $num i32) (param $base i32)
+ (result i32)
+ (if (i32.and (i32.eq $base 10)
+ (i32.lt_s $num 0))
+ (then
+ ;; Print '-' if negative
+ (i32.store8_u $str (CHR "-"))
+ (set_local $str (i32.add $str 1))
+ ;; Reverse the sign
+ (set_local $num (i32.sub_s 0 $num))))
+ (if (i32.gt_u (i32.div_u $num $base) 0)
+ (set_local
+ $str
+ ($_sprintnum $str (i32.div_u $num $base) $base)))
+ ($_sprintdigit $str $num $base)
+ (i32.add 1 $str)
+ )
+
+ ;; TODO: switch to snprint* (add buffer len)
+ (func $sprintf_1 (param $str i32) (param $fmt i32)
+ (param $v0 i32) (result i32)
+ ($sprintf_6 $str $fmt $v0 0 0 0 0 0)
+ )
+
+ (func $sprintf_6 (param $str i32) (param $fmt i32)
+ (param $v0 i32) (param $v1 i32) (param $v2 i32)
+ (param $v3 i32) (param $v4 i32) (param $v5 i32)
+ (result i32)
+ (local $ch i32)
+ (local $pstr i32)
+ (local $v i32)
+ (local $vidx i32)
+ (local $len i32)
+ (set_local $pstr $str)
+ (set_local $vidx 0)
+
+ (block $done
+ (loop $loop
+ (block $after_v
+ (block (block (block (block (block (block
+ (br_table 0 1 2 3 4 5 0 $vidx))
+ (; 0 ;) (set_local $v $v0) (br $after_v))
+ (; 1 ;) (set_local $v $v1) (br $after_v))
+ (; 2 ;) (set_local $v $v2) (br $after_v))
+ (; 3 ;) (set_local $v $v3) (br $after_v))
+ (; 4 ;) (set_local $v $v4) (br $after_v))
+ (; 5 ;) (set_local $v $v5) (br $after_v)
+ )
+
+ ;;; while ((ch=*(fmt++)))
+ (set_local $ch (i32.load8_u $fmt))
+ (set_local $fmt (i32.add 1 $fmt))
+ (if (i32.eqz $ch) (br $done))
+ ;; TODO: check buffer length
+
+ (if (i32.ne $ch (CHR "%"))
+ (then
+ ;; TODO: check buffer length
+ (i32.store8_u $pstr $ch)
+ (set_local $pstr (i32.add 1 $pstr))
+ (br $loop)))
+
+ ;;; ch=*(fmt++)
+ (set_local $ch (i32.load8_u $fmt))
+ (set_local $fmt (i32.add 1 $fmt))
+
+ (if (i32.eq (CHR "d") $ch)
+ (then
+ (set_local $pstr ($_sprintnum $pstr $v 10)))
+ (else (if (i32.eq (CHR "x") $ch)
+ (then
+ (set_local $pstr ($_sprintnum $pstr $v 10)))
+ (else (if (i32.eq (CHR "s") $ch)
+ (then
+ (set_local $len ($STRING_LEN $v))
+ ($MEM_COPY $pstr $v $len)
+ (set_local $pstr (i32.add $pstr $len)))
+ (else (if (i32.eq (CHR "c") $ch)
+ (then
+ (i32.store8_u $pstr $v)
+ (set_local $pstr (i32.add $pstr 1)))
+ (else
+ ($print "Illegal format character: ")
+ (drop ($putchar $ch))
+ (drop ($putchar (CHR "\n")))
+ ($exit 3)))))))))
+
+ (set_local $vidx (i32.add 1 $vidx))
+ (br $loop)
+ )
+ )
+
+ (i32.store8_u $pstr (CHR "\x00"))
+ $pstr
+ )
+
+)
+
+++ /dev/null
-(module $util
- (import "env" "malloc" (func $malloc (param i32) (result i32)))
- (import "env" "free" (func $free (param i32)))
- (import "env" "exit" (func $exit (param i32)))
-
- (import "env" "stdout" (global $stdout i32))
- (import "env" "putchar" (func $putchar (param i32) (result i32)))
- (import "env" "fputs" (func $fputs (param i32 i32) (result i32)))
- ;;(import "env" "readline" (func $readline (param i32) (result i32)))
- (import "libedit.so" "readline" (func $readline (param i32) (result i32)))
- ;;(import "libreadline.so" "readline" (func $readline (param i32) (result i32)))
-
- (global $sprintf_buf (mut i32) (i32.const 0))
-
- (func $init_sprintf_mem
- ;; 256 character sprintf static buffer
- (set_global $sprintf_buf (STRING " "))
- )
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;; Copy len chatacters from src to dst
- ;; Returns len
- (func $MEM_COPY (param $dst i32) (param $src i32) (param $len i32)
- (local $idx i32)
- (set_local $idx (i32.const 0))
- (loop $copy
- (i32.store8_u (i32.add (get_local $idx) (get_local $dst))
- (i32.load8_u (i32.add (get_local $idx)
- (get_local $src))))
- (set_local $idx (i32.add (i32.const 1) (get_local $idx)))
- (br_if $copy (i32.lt_u (get_local $idx) (get_local $len)))
- )
- )
-
- (func $STRING_LEN (param $str i32) (result i32)
- (local $cur i32)
- (set_local $cur (get_local $str))
- (loop $count
- (if (i32.ne (i32.const 0) (i32.load8_u (get_local $cur)))
- (then
- (set_local $cur (i32.add (get_local $cur) (i32.const 1)))
- (br $count)))
- )
- (i32.sub_u (get_local $cur) (get_local $str))
- )
-
- (func $ATOI (param $str i32) (result i32)
- (local $acc i32)
- (local $i i32)
- (local $neg i32)
- (local $ch i32)
- (set_local $acc (i32.const 0))
- (set_local $i (i32.const 0))
- (set_local $neg (i32.const 0))
- (block $done
- (loop $loop
- (set_local $ch (i32.load8_u (i32.add (get_local $str)
- (get_local $i))))
- (if (i32.and (i32.ne (get_local $ch) (CHAR '-'))
- (i32.or (i32.lt_u (get_local $ch) (CHAR '0'))
- (i32.gt_u (get_local $ch) (CHAR '9'))))
- (br $done))
- (set_local $i (i32.add (get_local $i) (i32.const 1)))
- (if (i32.eq (get_local $ch) (CHAR '-'))
- (then
- (set_local $neg (i32.const 1)))
- (else
- (set_local $acc (i32.add (i32.mul_u (get_local $acc) (i32.const 10))
- (i32.sub_u (get_local $ch) (CHAR '0'))))))
- (br $loop)
- )
- )
- (if i32 (get_local $neg)
- (then (i32.sub_s (i32.const 0) (get_local $acc)))
- (else (get_local $acc)))
- )
-
- (func $strcmp (param $s1 i32) (param $s2 i32) (result i32)
- (block $done
- (loop $loop
- (if (i32.or (i32.eqz (i32.load8_u (get_local $s1)))
- (i32.eqz (i32.load8_u (get_local $s2))))
- (br $done))
- (if (i32.ne (i32.load8_u (get_local $s1))
- (i32.load8_u (get_local $s2)))
- (br $done))
- (set_local $s1 (i32.add (get_local $s1) (i32.const 1)))
- (set_local $s2 (i32.add (get_local $s2) (i32.const 1)))
- (br $loop)
- )
- )
- (if i32 (i32.eq (i32.load8_u (get_local $s1))
- (i32.load8_u (get_local $s2)))
- (then (i32.const 0))
- (else
- (if i32 (i32.lt_u (i32.load8_u (get_local $s1))
- (i32.load8_u (get_local $s2)))
- (then (i32.const -1))
- (else (i32.const 1)))))
- )
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- (func $print (param $addr i32)
- (drop (call $fputs (get_local $addr) (get_global $stdout))))
-
- (func $printf_1 (param $fmt i32)
- (param $v0 i32)
- (drop (call $sprintf_6 (get_global $sprintf_buf) (get_local $fmt)
- (get_local $v0) (i32.const 0) (i32.const 0)
- (i32.const 0) (i32.const 0) (i32.const 0)))
- (call $print (get_global $sprintf_buf))
- )
-
- (func $printf_2 (param $fmt i32)
- (param $v0 i32) (param $v1 i32)
- (drop (call $sprintf_6 (get_global $sprintf_buf) (get_local $fmt)
- (get_local $v0) (get_local $v1) (i32.const 0)
- (i32.const 0) (i32.const 0) (i32.const 0)))
- (call $print (get_global $sprintf_buf))
- )
-
- (func $printf_3 (param $fmt i32)
- (param $v0 i32) (param $v1 i32) (param $v2 i32)
- (drop (call $sprintf_6 (get_global $sprintf_buf) (get_local $fmt)
- (get_local $v0) (get_local $v1) (get_local $v2)
- (i32.const 0) (i32.const 0) (i32.const 0)))
- (call $print (get_global $sprintf_buf))
- )
-
- (func $printf_4 (param $fmt i32)
- (param $v0 i32) (param $v1 i32) (param $v2 i32)
- (param $v3 i32)
- (drop (call $sprintf_6 (get_global $sprintf_buf) (get_local $fmt)
- (get_local $v0) (get_local $v1) (get_local $v2)
- (get_local $v3) (i32.const 0) (i32.const 0)))
- (call $print (get_global $sprintf_buf))
- )
-
- (func $printf_5 (param $fmt i32)
- (param $v0 i32) (param $v1 i32) (param $v2 i32)
- (param $v3 i32) (param $v4 i32)
- (drop (call $sprintf_6 (get_global $sprintf_buf) (get_local $fmt)
- (get_local $v0) (get_local $v1) (get_local $v2)
- (get_local $v3) (get_local $v4) (i32.const 0)))
- (call $print (get_global $sprintf_buf))
- )
-
- (func $printf_6 (param $fmt i32)
- (param $v0 i32) (param $v1 i32) (param $v2 i32)
- (param $v3 i32) (param $v4 i32) (param $v5 i32)
- (drop (call $sprintf_6 (get_global $sprintf_buf) (get_local $fmt)
- (get_local $v0) (get_local $v1) (get_local $v2)
- (get_local $v3) (get_local $v4) (get_local $v5)))
- (call $print (get_global $sprintf_buf))
- )
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- (func $_sprintdigit (param $str i32) (param $num i32) (param $base i32)
- (local $n i32)
- (local $ch i32)
- (set_local $n (i32.rem_u (get_local $num) (get_local $base)))
- (set_local $ch (if (result i32) (i32.lt_u (get_local $n) (i32.const 10))
- (i32.const 48)
- (i32.const 55)))
- (i32.store8_u (get_local $str) (i32.add (get_local $n) (get_local $ch)))
- )
-
- ;; TODO: switch to snprint* (add buffer len)
- (func $_sprintnum (param $str i32) (param $num i32) (param $base i32)
- (result i32)
- (if (i32.and (i32.eq (get_local $base) (i32.const 10))
- (i32.lt_s (get_local $num) (i32.const 0)))
- (then
- ;; Print '-' if negative
- (i32.store8_u (get_local $str) (CHAR '-'))
- (set_local $str (i32.add (get_local $str) (i32.const 1)))
- ;; Reverse the sign
- (set_local $num (i32.sub_s (i32.const 0) (get_local $num)))))
- (if (i32.gt_u (i32.div_u (get_local $num) (get_local $base))
- (i32.const 0))
- (set_local
- $str
- (call $_sprintnum (get_local $str)
- (i32.div_u (get_local $num) (get_local $base))
- (get_local $base))))
- (call $_sprintdigit (get_local $str) (get_local $num) (get_local $base))
- (i32.add (i32.const 1) (get_local $str))
- )
-
- ;; TODO: switch to snprint* (add buffer len)
- (func $sprintf_1 (param $str i32) (param $fmt i32)
- (param $v0 i32) (result i32)
- (call $sprintf_6 (get_local $str) (get_local $fmt)
- (get_local $v0) (i32.const 0) (i32.const 0)
- (i32.const 0) (i32.const 0) (i32.const 0))
- )
-
- (func $sprintf_6 (param $str i32) (param $fmt i32)
- (param $v0 i32) (param $v1 i32) (param $v2 i32)
- (param $v3 i32) (param $v4 i32) (param $v5 i32)
- (result i32)
- (local $ch i32)
- (local $pstr i32)
- (local $v i32)
- (local $vidx i32)
- (local $len i32)
- (set_local $pstr (get_local $str))
- (set_local $vidx (i32.const 0))
-
- (block $done
- (loop $loop
- (block $after_v
- (block (block (block (block (block (block
- (br_table 0 1 2 3 4 5 0 (get_local $vidx)))
- (; 0 ;) (set_local $v (get_local $v0)) (br $after_v))
- (; 1 ;) (set_local $v (get_local $v1)) (br $after_v))
- (; 2 ;) (set_local $v (get_local $v2)) (br $after_v))
- (; 3 ;) (set_local $v (get_local $v3)) (br $after_v))
- (; 4 ;) (set_local $v (get_local $v4)) (br $after_v))
- (; 5 ;) (set_local $v (get_local $v5)) (br $after_v)
- )
-
- ;;; while ((ch=*(fmt++)))
- (set_local $ch (i32.load8_u (get_local $fmt)))
- (set_local $fmt (i32.add (i32.const 1) (get_local $fmt)))
- (if (i32.eqz (get_local $ch)) (br $done))
- ;; TODO: check buffer length
-
- (if (i32.ne (get_local $ch) (CHAR '%'))
- (then
- ;; TODO: check buffer length
- (i32.store8_u (get_local $pstr) (get_local $ch))
- (set_local $pstr (i32.add (i32.const 1) (get_local $pstr)))
- (br $loop)))
-
- ;;; ch=*(fmt++)
- (set_local $ch (i32.load8_u (get_local $fmt)))
- (set_local $fmt (i32.add (i32.const 1) (get_local $fmt)))
-
- (if (i32.eq (CHAR 'd') (get_local $ch))
- (then
- (set_local $pstr (call $_sprintnum (get_local $pstr)
- (get_local $v) (i32.const 10))))
- (else (if (i32.eq (CHAR 'x') (get_local $ch))
- (then
- (set_local $pstr (call $_sprintnum (get_local $pstr)
- (get_local $v) (i32.const 16))))
- (else (if (i32.eq (CHAR 's') (get_local $ch))
- (then
- (set_local $len (call $STRING_LEN (get_local $v)))
- (call $MEM_COPY (get_local $pstr) (get_local $v) (get_local $len))
- (set_local $pstr (i32.add (get_local $pstr) (get_local $len))))
- (else (if (i32.eq (CHAR 'c') (get_local $ch))
- (then
- (i32.store8_u (get_local $pstr) (get_local $v))
- (set_local $pstr (i32.add (get_local $pstr) (i32.const 1))))
- (else
- (call $print (STRING "Illegal format character: "))
- (drop (call $putchar (get_local $ch)))
- (drop (call $putchar (CHAR '\n')))
- (call $exit (i32.const 3))))))))))
-
- (set_local $vidx (i32.add (i32.const 1) (get_local $vidx)))
- (br $loop)
- )
- )
-
- (i32.store8_u (get_local $pstr) (CHAR '\x00'))
- (get_local $pstr)
- )
-
-)
-
+++ /dev/null
-#!/usr/bin/env python3
-
-from itertools import tee
-from ast import literal_eval
-import os
-import pprint
-import re
-import sys
-
-def pairwise(iterable):
- "s -> (s0,s1), (s1,s2), (s2, s3), ..."
- a, b = tee(iterable)
- next(b, None)
- return zip(a, b)
-
-def _escape(s):
- return s.replace('\\', '\\\\').replace('"', '\\"').replace('\n', '\\n')
-
-
-tokre = re.compile(r"""([\s][\s]*|[(];|;[)]|[\[\]{}()`~^@]|'(?:[\\].|[^\\'])*'?|"(?:[\\].|[^\\"])*"?|;;.*|[^\s\[\]{}()'"`@,;]+)""")
-
-file_tokens = []
-strings = []
-string_map = {}
-
-depth = 0
-module = None
-type = None
-
-for f in sys.argv[1:]:
- content = open(f).read()
- tokens = [t for t in re.findall(tokre, content)]
- #print(tokens[0:100], file=sys.stderr)
- pairs = ["".join(p) for p in pairwise(tokens)]
- pairs.append("")
-
- index = 0
- while index < len(tokens):
- token = tokens[index]
- pair = pairs[index]
- if pair in ["(STRING", "(CHAR"]:
- arg = tokens[index+3]
- #print("arg: %s" % arg, file=sys.stderr)
- if tokens[index+4] != ')':
- raise Exception("Invalid %s) macro, too many/few args" % pair)
- if arg.startswith('"') and arg.endswith('"'):
- pass
- elif arg.startswith("'") and arg.endswith("'"):
- pass
- else:
- raise Exception ("Invalid %s) macro, invalid string arg" % pair)
- if pair == "(STRING":
- str = literal_eval(arg)
- if str in string_map:
- # Duplicate string, re-use address
- file_tokens.append("(i32.add (get_global $memoryBase) (get_global %s))" % string_map[str])
- else:
- str_name = "$S_STRING_%d" % len(strings)
- file_tokens.append("(i32.add (get_global $memoryBase) (get_global %s))" % str_name)
- strings.append(str)
- string_map[str] = str_name
- if pair == "(CHAR":
- c = literal_eval(arg)
- if len(c) != 1:
- raise Exception ("Invalid (CHAR) macro, must be 1 character")
- file_tokens.append("(i32.const 0x%x (; %s ;))" % (ord(c), arg))
- # Skip the rest of the macro
- index += 5
- continue
- index += 1
- if token == '(':
- depth += 1
- if token == ')':
- depth -= 1
- if depth == 0:
- module = None
- if token == ')': continue
- if depth == 1:
- type = None
- if pair == '(module':
- index += 1
- continue
- if token.startswith('$'):
- module = token[1:]
- #print("module:", module, file=sys.stderr)
- file_tokens.append('\n ;;\n ;; module "%s"\n ;;\n' % module)
- continue
- if depth == 2:
- if token == '(':
- type = tokens[index]
- if type == 'data':
- raise Exception("User data section not supported")
- #print(" type:", type, file=sys.stderr)
- file_tokens.append(token)
-
-# TODO: remove duplicates
-# Create data section with static strings
-string_tokens = []
-if strings:
- string_tokens.append(" (data\n (get_global $memoryBase)\n")
- string_offset = 0
- for string in strings:
- string_tokens.append(' %-30s ;; %d\n' % (
- '"'+_escape(string)+'\\00"', string_offset))
- string_offset += len(string)+1
- string_tokens.append(" )\n\n")
-
- # Create string names/pointers
- string_offset = 0
- for index, string in enumerate(strings):
- string_tokens.append(' (global $S_STRING_%d i32 (i32.const %d))\n' % (
- index, string_offset))
- string_offset += len(string)+1
- # Terminator so we know how much memory we took
- string_tokens.append(' (global $S_STRING_END i32 (i32.const %d))\n' % (
- string_offset))
-
-all_tokens = ["(module\n"]
-all_tokens.extend(string_tokens)
-all_tokens.extend(file_tokens)
-all_tokens.append("\n)")
-
-print("".join(all_tokens))
HCoop / jackhill / mal.git / commitdiff