Also split platform out.
-STEP0_DEPS = string.wam util.wam
+MODE ?= libc
+
+STEP0_DEPS = platform_$(MODE).wam string.wam printf.wam
STEP1_DEPS = $(STEP0_DEPS) types.wam mem.wam debug.wam reader.wam printer.wam
STEP3_DEPS = $(STEP1_DEPS) env.wam
STEP4_DEPS = $(STEP3_DEPS) core.wam
(if i32 (i32.eq (i32.load8_u $str) (CHR "\x7f"))
(then ($INC_REF ($MEM_VAL1_ptr $args)))
(else
- (drop ($sprintf_1 (get_global $util_buf) "\x7f%s" $str))
- ($STRING (get_global $STRING_T) (get_global $util_buf))))
+ (drop ($sprintf_1 (get_global $printf_buf) "\x7f%s" $str))
+ ($STRING (get_global $STRING_T) (get_global $printf_buf))))
)
(func $keyword_Q (param $args i32) (result i32)
(func $core_readline (param $args i32) (result i32)
(local $line i32 $mv i32)
- (set_local $line ($readline ($to_String ($MEM_VAL1_ptr $args))))
- (if (i32.eqz $line) (return ($INC_REF (get_global $NIL))))
+ (set_local $line (STATIC_ARRAY 201))
+ (if (i32.eqz ($readline ($to_String ($MEM_VAL1_ptr $args)) $line))
+ (return ($INC_REF (get_global $NIL))))
(set_local $mv ($STRING (get_global $STRING_T) $line))
- ($free $line)
$mv
)
($read_str ($to_String ($MEM_VAL1_ptr $args))))
(func $slurp (param $args i32) (result i32)
- (local $content i32 $mv i32)
- (set_local $content ($read_file ($to_String ($MEM_VAL1_ptr $args))))
- (if (i32.le_s $content 0)
+ (local $mv i32 $size i32)
+ (set_local $mv ($STRING_INIT (get_global $STRING_T)))
+ (set_local $size ($read_file ($to_String ($MEM_VAL1_ptr $args))
+ ($to_String $mv)))
+ (if (i32.eqz $size)
(then
($THROW_STR_1 "failed to read file '%s'" ($to_String ($MEM_VAL1_ptr $args)))
(return ($INC_REF (get_global $NIL)))))
- (set_local $mv ($STRING (get_global $STRING_T) $content))
- ($free $content)
+ (set_local $mv ($STRING_FINALIZE $mv $size))
$mv
)
(func $checkpoint_user_memory
(set_global $mem_user_start (get_global $mem_unused_start))
+ (set_global $string_mem_user_start (get_global $string_mem_next))
)
(func $CHECK_FREE_LIST (result i32)
(i32.add $size $idx)
)
+ (func $PR_STRINGS (param $start i32)
+ (local $ms i32 $idx i32)
+ ($printf_2 "String - showing %d -> %d:\n"
+ $start (i32.sub_s (get_global $string_mem_next)
+ (get_global $string_mem)))
+ (if (i32.le_s (i32.sub_s (get_global $string_mem_next)
+ (get_global $string_mem))
+ $start)
+ (then ($print " ---\n"))
+ (else
+ (set_local $ms (get_global $string_mem))
+ (block $done
+ (loop $loop
+ (if (i32.ge_u $ms (get_global $string_mem_next))
+ (br $done))
+ (set_local $idx (i32.sub_u $ms (get_global $string_mem)))
+ (if (i32.ge_s $idx $start)
+ ($printf_4 "%4d: refs %2d, size %2d >> '%s'\n"
+ $idx
+ (i32.load16_u $ms)
+ (i32.load16_u (i32.add $ms 2))
+ (i32.add $ms 4)))
+
+ (set_local $ms (i32.add $ms (i32.load16_u (i32.add $ms 2))))
+ (br $loop)
+ )
+ )))
+ )
+
(func $PR_MEMORY (param $start i32 $end i32)
- (local $idx i32)
+ (local $string_start i32 $idx i32)
(if (i32.lt_s $start 0)
- (set_local $start (get_global $mem_user_start)))
+ (then
+ (set_local $start (get_global $mem_user_start))
+ (set_local $string_start (i32.sub_s (get_global $string_mem_user_start)
+ (get_global $string_mem)))))
(if (i32.lt_s $end 0)
(set_local $end (get_global $mem_unused_start)))
;;; printf("Values - (mem) showing %d -> %d", start, end)
(br $loopvals)
)
)))
+ ($PR_STRINGS $string_start)
($PR_MEMORY_SUMMARY_SMALL)
)
(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)
+ (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
;; ($print ">>> init_memory\n")
- ($init_sprintf_mem)
+ ($init_printf_mem)
;; error_str string buffer
(set_global $error_str (STATIC_ARRAY 100))
(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))
+ (set_global $string_mem (i32.add (get_global $heap_start)
+ (get_global $MEM_SIZE)))
+ (set_global $string_mem_next (get_global $string_mem))
+
+ (set_global $mem_user_start (get_global $mem_unused_start))
+ (set_global $string_mem_user_start (get_global $string_mem_next))
;; Empty values
(set_global $NIL
;; 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)))
+ ;; Out of memory, exit
+ ($fatal 7 "Out of mal memory!\n"))
;;; if (mem_unused_start += size)
(set_global $mem_unused_start
(i32.add (get_global $mem_unused_start) $size))
;;; 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)))
+ ($fatal 7 "RELEASE of NULL!\n"))
(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)))
+ ($fatal 1 "")))
(if (i32.lt_u ($MalVal_refcnt_type $idx) 15)
(then
($printf_2 "RELEASE of unowned mv: 0x%x, idx: 0x%x\n" $mv $idx)
- ($exit 1)))
+ ($fatal 1 "")))
;; decrease reference count by one
(i32.store ($MalVal_ptr $idx)
(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)))
+ ($fatal 1 "")))
(return)))
;; our reference count is not 0, so don't release
(br $done))
;; string, kw, symbol
;; release string, then FREE reference
- ($RELEASE_STRING $mv)
+ ($RELEASE_STRING (i32.add (get_global $string_mem) ($VAL0 $mv)))
(br $done))
;; list, vector
(if (i32.ne ($MalVal_val $idx 0) 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 $cur i32 $new i32 $idx i32)
-
- ;; Calculate length of string needed
- (set_local $len ($strlen $str))
+ ;; find string in string memory or 0 if not found
+ (func $FIND_STRING (param $str i32) (result i32)
+ (local $ms i32)
+ (set_local $ms (get_global $string_mem))
+ (block $done
+ (loop $loop
+ (br_if $done (i32.ge_s $ms (get_global $string_mem_next)))
+ (if (i32.eqz ($strcmp $str (i32.add $ms 4)))
+ (return $ms))
- ;; leading i32 refcnt + trailing NULL
- (set_local $new ($malloc (i32.add 5 $len)))
+ (set_local $ms (i32.add $ms (i32.load16_u (i32.add $ms 2))))
+ (br $loop)
+ )
+ )
+ 0
+ )
- ;; 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)
+ ;; str is a NULL terminated string
+ ;; size is number of characters in the string not including the
+ ;; trailing NULL
+ (func $ALLOC_STRING (param $str i32 $size i32 $intern i32) (result i32)
+ (local $ms i32)
- ;; Copy the characters
- ($memmove $cur $str $len)
- $new
+ ;; search for matching string in string_mem
+ (if $intern
+ (then
+ (set_local $ms ($FIND_STRING $str))
+ (if $ms
+ (then
+ ;;; ms->refcnt += 1
+ (i32.store16_u $ms (i32.add (i32.load16_u $ms) 1))
+ (return $ms)))))
+
+ ;; no existing matching string so create a new one
+ (set_local $ms (get_global $string_mem_next))
+ (i32.store16_u $ms 1)
+ ;;; ms->size = sizeof(MalString)+size+1
+ (i32.store16_u offset=2 $ms (i32.add (i32.add 4 $size) 1))
+ ($memmove (i32.add $ms 4) $str (i32.add $size 1))
+ ;;; string_mem_next = (void *)ms + ms->size
+ (set_global $string_mem_next
+ ;;(i32.add $ms (i32.load16_u (i32.add $ms 2))))
+ (i32.add $ms (i32.load16_u offset=2 $ms)))
+
+;;($printf_2 "ALLOC_STRING 6 ms 0x%x, refs: %d\n" $ms (i32.load16_u $ms))
+ $ms
)
- ;; Duplicate regular character array string into a Mal string and
- ;; return the MalVal pointer
- (func $STRING (param $type i32 $str i32) (result i32)
- ($ALLOC_SCALAR $type ($STRING_DUPE $str))
- )
+ (func $RELEASE_STRING (param $ms i32)
+ (local $size i32 $next i32 $ms_idx i32 $idx i32 $type i32 $mv i32)
- (func $RELEASE_STRING (param $mv i32)
- (local $str i32)
- (set_local $str ($MalVal_val ($IDX $mv) 0))
+ (if (i32.le_s (i32.load16_u $ms) 0)
+ (then
+ ($printf_2 "Release of already free string: %d (0x%x)\n"
+ (i32.sub_s $ms (get_global $string_mem)) $ms)
+ ($fatal 1 "")))
- ;; DEBUG
-;; ($printf_1 "RELEASE_STRING - calling free on: %d" $str)
+ ;;; size = ms->size
+ (set_local $size (i32.load16_u (i32.add $ms 2)))
+ ;;; *next = (void *)ms + size
+ (set_local $next (i32.add $ms $size))
+
+ ;;; ms->refcnt -= 1
+ (i32.store16_u $ms (i32.sub_u (i32.load16_u $ms) 1))
- ($free $str)
+ (if (i32.eqz (i32.load16_u $ms))
+ (then
+ (if (i32.gt_s (get_global $string_mem_next) $next)
+ (then
+ ;; If no more references to this string then free it up by
+ ;; shifting up every string afterwards to fill the gap
+ ;; (splice).
+ ($memmove $ms $next (i32.sub_s (get_global $string_mem_next)
+ $next))
+
+ ;; Scan the mem values for string types after the freed
+ ;; string and shift their indexes by size
+ (set_local $ms_idx (i32.sub_s $ms (get_global $string_mem)))
+ (set_local $idx ($IDX (get_global $EMPTY_HASHMAP)))
+ (loop $loop
+ (set_local $mv ($MalVal_ptr $idx))
+ (set_local $type ($TYPE $mv))
+ (if (AND (i32.gt_s ($VAL0 $mv) $ms_idx)
+ (OR (i32.eq $type (get_global $STRING_T))
+ (i32.eq $type (get_global $SYMBOL_T))))
+ (i32.store ($VAL0_ptr $mv) (i32.sub_s ($VAL0 $mv) $size)))
+ (set_local $idx (i32.add $idx ($MalVal_size $mv)))
+
+ (br_if $loop (i32.lt_s $idx (get_global $mem_unused_start)))
+ )))
+
+ (set_global $string_mem_next
+ (i32.sub_s (get_global $string_mem_next) $size))))
)
)
--- /dev/null
+(module $platform_libc
+
+ (import "env" "exit" (func $lib_exit (param i32)))
+
+ (import "env" "stdout" (global $lib_stdout i32))
+ (import "env" "fputs" (func $lib_fputs (param i32 i32) (result i32)))
+
+ (import "env" "free" (func $lib_free (param i32)))
+ (import "env" "readline" (func $lib_readline (param i32) (result i32)))
+ (import "env" "add_history" (func $lib_add_history (param i32)))
+
+ ;; read_file defintions / FFI information
+ (global $STAT_SIZE i32 88)
+ (global $STAT_ST_SIZE_OFFSET i32 44)
+ (global $STAT_VER_LINUX i32 3)
+ (global $O_RDONLY i32 0)
+ (import "env" "open" (func $lib_open (param i32 i32 i32) (result i32)))
+ (import "env" "read" (func $lib_read (param i32 i32 i32) (result i32)))
+ (import "env" "__fxstat" (func $lib___fxstat (param i32 i32 i32) (result i32)))
+ (global $TIMEVAL_SIZE i32 8)
+ (global $TV_SEC_OFFSET i32 0)
+ (global $TV_USEC_OFFSET i32 4)
+ (import "env" "gettimeofday" (func $lib_gettimeofday (param i32 i32) (result i32)))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ (func $fatal (param $code i32 $msg i32)
+ ($print $msg)
+ ($lib_exit $code)
+ )
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ (func $print (param $addr i32)
+ (drop ($lib_fputs $addr (get_global $lib_stdout))))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ (func $readline (param $prompt i32 $buf i32) (result i32)
+ (local $line i32 $len i32)
+ (set_local $len 0)
+
+ (set_local $line ($lib_readline $prompt))
+ (if $line
+ (then
+ ($lib_add_history $line)
+ (set_local $len ($strlen $line))
+ ($memmove $buf $line $len)
+ ($lib_free $line)))
+ (i32.store8_u (i32.add $buf $len) (CHR "\x00"))
+ (return (if i32 $line 1 0))
+ )
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ ;; Returns malloc'd string. Must be free by caller
+ (func $read_file (param $path i32 $buf i32) (result i32)
+ (local $fst i32 $fd i32 $st_size i32 $sz i32)
+ (set_local $fst (STATIC_ARRAY 100)) ;; at least STAT_SIZE
+
+ (set_local $fd ($lib_open $path (get_global $O_RDONLY) 0))
+ (if (i32.lt_s $fd 0)
+ (then
+ ($printf_1 "ERROR: slurp failed to open '%s'\n" $path)
+ (return 0)))
+ (if (i32.lt_s ($lib___fxstat (get_global $STAT_VER_LINUX) $fd $fst) 0)
+ (then
+ ($printf_1 "ERROR: slurp failed to stat '%s'\n" $path)
+ (return 0)))
+ (set_local $st_size (i32.load
+ (i32.add $fst (get_global $STAT_ST_SIZE_OFFSET))))
+ (set_local $sz ($lib_read $fd $buf $st_size))
+ (if (i32.ne $sz $st_size)
+ (then
+ ($printf_1 "ERROR: slurp failed to stat '%s'\n" $path)
+ (return 0)))
+ ;; Add null to string
+ (i32.store8_u (i32.add $buf $st_size) 0)
+ (i32.add 1 $st_size)
+ )
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+ (func $get_time_ms (result i32)
+ (local $tv i32 $secs i32 $usecs i32 $msecs i32)
+ (set_local $tv (STATIC_ARRAY 10)) ;; at least TIMEVAL_SIZE
+ (drop ($lib_gettimeofday $tv 0))
+ (set_local $secs (i32.load (i32.add $tv (get_global $TV_SEC_OFFSET))))
+ ;; subtract 30 years to make sure secs is positive and can be
+ ;; multiplied by 1000
+ (set_local $secs (i32.sub_s $secs 0x38640900))
+ (set_local $usecs (i32.load (i32.add $tv (get_global $TV_USEC_OFFSET))))
+ (set_local $msecs (i32.add (i32.mul_u $secs 1000)
+ (i32.div_u $usecs 1000)))
+ $msecs
+ )
+)
--- /dev/null
+(module $platform_os
+
+ (import "env" "exit" (func $lib_exit (param i32)))
+
+ (import "env" "stdout" (global $lib_stdout i32))
+ (import "env" "fputs" (func $lib_fputs (param i32 i32) (result i32)))
+
+ (import "env" "readline" (func $lib_readline (param i32 i32 i32) (result i32)))
+ (import "env" "add_history" (func $lib_add_history (param i32)))
+
+ (import "env" "read_file" (func $lib_read_file (param i32 i32) (result i32)))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ (func $fatal (param $code i32 $msg i32)
+ ($print $msg)
+ ($lib_exit $code)
+ )
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ (func $print (param $addr i32)
+ (drop ($lib_fputs $addr (get_global $lib_stdout))))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ (func $readline (param $prompt i32 $buf i32) (result i32)
+ (local $res i32)
+
+ ;; TODO: don't hardcode count to 200
+ (set_local $res ($lib_readline $prompt $buf 200))
+ (if $res
+ ($lib_add_history $buf))
+ $res
+ )
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ (func $read_file (param $path i32 $buf i32) (result i32)
+ (local $size i32)
+ (set_local $size ($lib_read_file $path $buf))
+ ;; Add null to string
+ (i32.store8_u (i32.add $buf $size) 0)
+ (i32.add $size 1)
+ )
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+ (func $get_time_ms (result i32)
+ 0
+ )
+
+)
(func $pr_str_internal (param $seq i32) (param $mv i32)
(param $print_readably i32) (param $sep i32) (result i32)
- (local $res i32)
- (set_local $res (get_global $printer_buf))
- (i32.store8_u $res 0)
+ (local $res i32 $res_str i32)
+ (set_local $res ($STRING_INIT (get_global $STRING_T)))
+ (set_local $res_str ($to_String $res))
(if $seq
(then
(block $done
(loop $loop
- (if (i32.eqz ($VAL0 $mv)) (br $done))
- (set_local $res ($pr_str_val $res ($MEM_VAL1_ptr $mv) $print_readably))
+ (br_if $done (i32.eqz ($VAL0 $mv)))
+ (set_local $res_str ($pr_str_val $res_str ($MEM_VAL1_ptr $mv) $print_readably))
(set_local $mv ($MEM_VAL0_ptr $mv))
(if (i32.ne ($VAL0 $mv) 0)
- (set_local $res ($sprintf_1 $res "%s" $sep)))
+ (set_local $res_str ($sprintf_1 $res_str "%s" $sep)))
(br $loop)
)
))
(else
- (set_local $res ($pr_str_val $res $mv $print_readably))))
+ (set_local $res_str ($pr_str_val $res_str $mv $print_readably))))
- ($STRING (get_global $STRING_T) (get_global $printer_buf))
+ (set_local $res ($STRING_FINALIZE $res (i32.sub_s $res_str ($to_String $res))))
+
+ $res
)
(func $pr_str (param $mv i32 $print_readably i32) (result i32)
-(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)))
+(module $printf
- (import "env" "stdout" (global $stdout 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 $printf_buf (mut i32) 0)
- (global $util_buf (mut i32) 0)
-
- ;; read_file defintions / FFI information
- (global $STAT_SIZE i32 88)
- (global $STAT_ST_SIZE_OFFSET i32 44)
- (global $STAT_VER_LINUX i32 3)
- (global $O_RDONLY i32 0)
- (import "env" "open" (func $open (param i32 i32 i32) (result i32)))
- (import "env" "read" (func $read (param i32 i32 i32) (result i32)))
- (import "env" "__fxstat" (func $__fxstat (param i32 i32 i32) (result i32)))
- (global $TIMEVAL_SIZE i32 8)
- (global $TV_SEC_OFFSET i32 0)
- (global $TV_USEC_OFFSET i32 4)
- (import "env" "gettimeofday" (func $gettimeofday (param i32 i32) (result i32)))
-
- (func $init_sprintf_mem
+ (func $init_printf_mem
;; sprintf static buffer
- (set_global $util_buf (STATIC_ARRAY 256))
- )
+ (set_global $printf_buf (STATIC_ARRAY 256))
+ )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (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 $util_buf) $fmt $v0 0 0 0 0 0))
- ($print (get_global $util_buf))
+ (drop ($sprintf_6 (get_global $printf_buf) $fmt $v0 0 0 0 0 0))
+ ($print (get_global $printf_buf))
)
(func $printf_2 (param $fmt i32 $v0 i32 $v1 i32)
- (drop ($sprintf_6 (get_global $util_buf) $fmt $v0 $v1 0 0 0 0))
- ($print (get_global $util_buf))
+ (drop ($sprintf_6 (get_global $printf_buf) $fmt $v0 $v1 0 0 0 0))
+ ($print (get_global $printf_buf))
)
(func $printf_3 (param $fmt i32)
(param $v0 i32) (param $v1 i32) (param $v2 i32)
- (drop ($sprintf_6 (get_global $util_buf) $fmt $v0 $v1 $v2 0 0 0))
- ($print (get_global $util_buf))
+ (drop ($sprintf_6 (get_global $printf_buf) $fmt $v0 $v1 $v2 0 0 0))
+ ($print (get_global $printf_buf))
)
(func $printf_4 (param $fmt i32)
(param $v0 i32) (param $v1 i32) (param $v2 i32)
(param $v3 i32)
- (drop ($sprintf_6 (get_global $util_buf) $fmt $v0 $v1 $v2 $v3 0 0))
- ($print (get_global $util_buf))
+ (drop ($sprintf_6 (get_global $printf_buf) $fmt $v0 $v1 $v2 $v3 0 0))
+ ($print (get_global $printf_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 $util_buf) $fmt $v0 $v1 $v2 $v3 $v4 0))
- ($print (get_global $util_buf))
+ (drop ($sprintf_6 (get_global $printf_buf) $fmt $v0 $v1 $v2 $v3 $v4 0))
+ ($print (get_global $printf_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 $util_buf) $fmt $v0 $v1 $v2 $v3 $v4 $v5))
- ($print (get_global $util_buf))
+ (drop ($sprintf_6 (get_global $printf_buf) $fmt $v0 $v1 $v2 $v3 $v4 $v5))
+ ($print (get_global $printf_buf))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Calculate smallest to most significant digit
(loop $loop
(set_local $digit (i32.rem_u $val $radix))
- (i32.store8_u $pbuf (if i32 (i32.lt_s $digit 10)
+ (i32.store8_u $pbuf (if i32 (i32.lt_u $digit 10)
(i32.add (CHR "0") $digit)
- (i32.sub_s (i32.add (CHR "A") $digit) 10)))
+ (i32.sub_u (i32.add (CHR "A") $digit) 10)))
(set_local $pbuf (i32.add $pbuf 1))
- (set_local $val (i32.div_s $val $radix))
- (if (i32.gt_s $val 0) (br $loop))
+ (set_local $val (i32.div_u $val $radix))
+ (if (i32.gt_u $val 0) (br $loop))
)
- (set_local $i (i32.sub_s $pbuf $buf))
+ (set_local $i (i32.sub_u $pbuf $buf))
(block $done
(loop $loop
- (if (i32.ge_s $i $pad_cnt) (br $done))
+ (if (i32.ge_u $i $pad_cnt) (br $done))
(i32.store8_u $pbuf $pad_char)
(set_local $pbuf (i32.add $pbuf 1))
(set_local $i (i32.add $i 1))
(i32.store8_u $pbuf (CHR "\x00"))
;; now reverse it
- (set_local $len (i32.sub_s $pbuf $buf))
+ (set_local $len (i32.sub_u $pbuf $buf))
(set_local $i 0)
(block $done
(loop $loop
- (if (i32.ge_s $i (i32.div_s $len 2))
+ (if (i32.ge_u $i (i32.div_u $len 2))
(br $done))
(set_local $j (i32.load8_u (i32.add $buf $i)))
- (set_local $k (i32.add $buf (i32.sub_s (i32.sub_s $len $i) 1)))
+ (set_local $k (i32.add $buf (i32.sub_u (i32.sub_u $len $i) 1)))
(i32.store8_u (i32.add $buf $i) (i32.load8_u $k))
(i32.store8_u $k $j)
(set_local $i (i32.add $i 1))
(br $loop)) ;; don't increase vidx
(else
($printf_1 "Illegal format character: '%c'\n" $ch)
- ($exit 3)))))))))))
+ ($fatal 3 "")))))))))))
(set_local $vidx (i32.add 1 $vidx))
(br $loop)
$pstr
)
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;; Returns malloc'd string. Must be free by caller
- (func $read_file (param $path i32) (result i32)
- (local $fst i32 $fd i32 $str i32 $st_size i32 $sz i32)
- (set_local $str 0)
- (set_local $fst ($malloc (get_global $STAT_SIZE)))
- (if (i32.le_s $fst 0)
- (then
- ($printf_1 "ERROR: malloc of %d bytes failed\n"
- (get_global $STAT_SIZE))
- (return 0)))
-
- (block $free_fst
- (set_local $fd ($open $path (get_global $O_RDONLY) 0))
- (if (i32.lt_s $fd 0)
- (then
- ($printf_1 "ERROR: slurp failed to open '%s'\n" $path)
- (br $free_fst)))
- (if (i32.lt_s ($__fxstat (get_global $STAT_VER_LINUX) $fd $fst) 0)
- (then
- ($printf_1 "ERROR: slurp failed to stat '%s'\n" $path)
- (br $free_fst)))
- (set_local $st_size (i32.load
- (i32.add $fst (get_global $STAT_ST_SIZE_OFFSET))))
- (set_local $str ($malloc (i32.add 1 $st_size)))
- (if (i32.le_s $str 0)
- (then
- ($printf_1 "ERROR: malloc of %d bytes failed\n" $st_size)
- (br $free_fst)))
- (set_local $sz ($read $fd $str $st_size))
- (if (i32.ne $sz $st_size)
- (then
- ($free $str)
- (set_local $str 0)
- ($printf_1 "ERROR: slurp failed to stat '%s'\n" $path)
- (br $free_fst)))
- ;; Add null to string
- (i32.store8_u (i32.add $str $st_size) 0)
- )
- ($free $fst)
- $str
- )
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
- (func $get_time_ms (result i32)
- (local $tv i32 $secs i32 $usecs i32 $msecs i32)
- (set_local $tv ($malloc (get_global $TIMEVAL_SIZE)))
- (drop ($gettimeofday $tv 0))
- (set_local $secs (i32.load (i32.add $tv (get_global $TV_SEC_OFFSET))))
- ;; subtract 30 years to make sure secs is positive and can be
- ;; multiplied by 1000
- (set_local $secs (i32.sub_s $secs 0x38640900))
- (set_local $usecs (i32.load (i32.add $tv (get_global $TV_USEC_OFFSET))))
- (set_local $msecs (i32.add (i32.mul_u $secs 1000)
- (i32.div_u $usecs 1000)))
- ($free $tv)
- $msecs
- )
)
(func $main (result i32)
;; Constant location/value definitions
(local $line i32)
+ (set_local $line (STATIC_ARRAY 201))
+
+ ;; DEBUG
+ ($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
;; Start REPL
(block $repl_done
(loop $repl_loop
- (set_local $line ($readline "user> "))
- (if (i32.eqz $line) (br $repl_done))
+ (br_if $repl_done (i32.eqz ($readline "user> " $line)))
+ (br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
+ ;;($printf_1 "here1 %d\n", 7);
($printf_1 "%s\n" ($rep $line))
- ($free $line)
- (br $repl_loop)))
+ (br $repl_loop)
+ )
+ )
($print "\n")
0
(export "_main" (func $main))
- (export "__post_instantiate" (func $init_sprintf_mem))
+ (export "__post_instantiate" (func $init_printf_mem))
)
(local $mv1 i32 $mv2 i32 $ms i32)
(block $rep_done
(set_local $mv1 ($READ $line))
- (if (get_global $error_type) (br $rep_done))
+ (br_if $rep_done (get_global $error_type))
(set_local $mv2 ($EVAL $mv1 $env))
- (if (get_global $error_type) (br $rep_done))
+ (br_if $rep_done (get_global $error_type))
;; ($PR_MEMORY -1 -1)
(set_local $ms ($PRINT $mv2))
+
)
;; release memory from MAL_READ
(func $main (result i32)
(local $line i32 $res i32)
+ (set_local $line (STATIC_ARRAY 201))
;; DEBUG
($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
($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)
- ;; Start
+;; ($PR_MEMORY_RAW
+;; (get_global $mem) (i32.add (get_global $mem)
+;; (i32.mul_u (get_global $mem_unused_start) 4)))
+
+ ($PR_MEMORY -1 -1)
+
+ ;; Start REPL
(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)))
+ (br_if $repl_done (i32.eqz ($readline "user> " $line)))
+ (br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
(set_local $res ($REP $line 0))
(if (get_global $error_type)
(then
(else
($printf_1 "%s\n" ($to_String $res))))
($RELEASE $res)
-;; ($PR_MEMORY -1 -1)
- ($free $line)
- (br $repl_loop)))
+ ;;($PR_MEMORY_SUMMARY_SMALL)
+ (br $repl_loop)
+ )
+ )
($print "\n")
;;($PR_MEMORY -1 -1)
(if (get_global $error_type) (return 0))
- (if (i32.ne $type (get_global $LIST_T))
- (return ($EVAL_AST $ast $env)))
+ ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
+
+ (if (i32.ne $type (get_global $LIST_T)) (return ($EVAL_AST $ast $env)))
;; APPLY_LIST
(if ($EMPTY_Q $ast) (return ($INC_REF $ast)))
(func $main (result i32)
(local $line i32 $res i32 $repl_env i32)
+ (set_local $line (STATIC_ARRAY 201))
;; DEBUG
($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
;; Start REPL
(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)))
+ (br_if $repl_done (i32.eqz ($readline "user> " $line)))
+ (br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
(set_local $res ($REP $line $repl_env))
(if (get_global $error_type)
(then
(else
($printf_1 "%s\n" ($to_String $res))))
($RELEASE $res)
-;; ($PR_MEMORY -1 -1)
- ($free $line)
- (br $repl_loop)))
+ ;;($PR_MEMORY_SUMMARY_SMALL)
+ (br $repl_loop)
+ )
+ )
($print "\n")
;;($PR_MEMORY -1 -1)
(func $EVAL (param $ast i32 $env i32) (result i32)
(local $res i32)
- (local $type i32 $ftype i32 $f_args i32 $f i32 $args i32)
+ (local $ftype i32 $f_args i32 $f i32 $args i32)
(local $a0 i32 $a0sym i32 $a1 i32 $a2 i32)
(local $let_env i32)
(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)))
+ ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
+
+ (if (i32.ne ($TYPE $ast) (get_global $LIST_T))
+ (return ($EVAL_AST $ast $env)))
;; APPLY_LIST
(if ($EMPTY_Q $ast) (return ($INC_REF $ast)))
(then
(set_local $res (call_indirect (type $fnT) $args ($VAL0 $f))))
(else
- ($THROW_STR_1 "apply of non-function type: %d\n" $type)
+ ($THROW_STR_1 "apply of non-function type: %d\n" $ftype)
(set_local $res 0)))
($RELEASE $f_args)))))
(func $main (result i32)
(local $line i32 $res i32 $repl_env i32)
+ (set_local $line (STATIC_ARRAY 201))
;; DEBUG
($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
;; Start REPL
(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)))
+ (br_if $repl_done (i32.eqz ($readline "user> " $line)))
+ (br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
(set_local $res ($REP $line $repl_env))
(if (get_global $error_type)
(then
(else
($printf_1 "%s\n" ($to_String $res))))
($RELEASE $res)
-;; ($PR_MEMORY -1 -1)
- ($free $line)
- (br $repl_loop)))
+ ;;($PR_MEMORY_SUMMARY_SMALL)
+ (br $repl_loop)
+ )
+ )
($print "\n")
;;($PR_MEMORY -1 -1)
(func $EVAL (param $ast i32 $env i32) (result i32)
(local $res i32 $el i32)
- (local $type i32 $ftype i32 $f_args i32 $f i32 $args i32)
+ (local $ftype i32 $f_args i32 $f i32 $args i32)
(local $a0 i32 $a0sym i32 $a1 i32 $a2 i32 $a3 i32)
(local $let_env i32 $fn_env i32 $a i32)
(set_local $f 0)
(set_local $args 0)
- ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
+ (if (get_global $error_type) (return 0))
- (if (get_global $error_type)
- (return 0))
+ ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
(if (i32.ne ($TYPE $ast) (get_global $LIST_T))
(return ($EVAL_AST $ast $env)))
($RELEASE $a))
(else
;; create new environment using env and params stored in function
- ($THROW_STR_1 "apply of non-function type: %d\n" $type)
+ ($THROW_STR_1 "apply of non-function type: %d\n" $ftype)
(set_local $res 0)
($RELEASE $f_args)))))))))))))))
(func $main (result i32)
(local $line i32 $res i32 $repl_env i32)
+ (set_local $line (STATIC_ARRAY 201))
;; DEBUG
($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
;; Start REPL
(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)))
+ (br_if $repl_done (i32.eqz ($readline "user> " $line)))
+ (br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
(set_local $res ($REP $line $repl_env))
(if (get_global $error_type)
(then
(else
($printf_1 "%s\n" ($to_String $res))))
($RELEASE $res)
-;; ($PR_MEMORY -1 -1)
- ($free $line)
- (br $repl_loop)))
+ ;;($PR_MEMORY_SUMMARY_SMALL)
+ (br $repl_loop)
+ )
+ )
($print "\n")
;;($PR_MEMORY -1 -1)
(set_local $f 0)
(set_local $args 0)
- ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
-
(if (get_global $error_type)
(then
(set_local $res 0)
(br $EVAL_return)))
+ ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
+
(if (i32.ne ($TYPE $ast) (get_global $LIST_T))
(then
(set_local $res ($EVAL_AST $ast $env 0))
;; EVAL the rest through second to last
(set_local $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1))
(set_local $ast ($LAST $ast))
+ ($RELEASE $ast) ;; we already own it via ast
($RELEASE $el)
(br $TCO_loop))
(else (if (i32.eqz ($strcmp "if" $a0sym))
(func $main (result i32)
(local $line i32 $res i32 $repl_env i32)
+ (set_local $line (STATIC_ARRAY 201))
;; DEBUG
- ($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
- ($printf_1 "heap_start: 0x%x\n" (get_global $heap_start))
- ($printf_1 "heap_end: 0x%x\n" (get_global $heap_end))
- ($printf_1 "mem: 0x%x\n" (get_global $mem))
+;; ($printf_1 "argc: 0x%x\n" $argc)
+;; ($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
+;; ($printf_1 "heap_start: 0x%x\n" (get_global $heap_start))
+;; ($printf_1 "heap_end: 0x%x\n" (get_global $heap_end))
+;; ($printf_1 "mem: 0x%x\n" (get_global $mem))
;; ($printf_1 "string_mem: %d\n" (get_global $string_mem))
(set_global $repl_env ($ENV_NEW (get_global $NIL)))
;; core.EXT: defined in wasm
($add_core_ns $repl_env)
+ ($checkpoint_user_memory)
+
;; core.mal: defined using the language itself
($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env))
;; Start REPL
(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)))
+ (br_if $repl_done (i32.eqz ($readline "user> " $line)))
+ (br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
(set_local $res ($REP $line $repl_env))
(if (get_global $error_type)
(then
(else
($printf_1 "%s\n" ($to_String $res))))
($RELEASE $res)
-;; ($PR_MEMORY -1 -1)
- ($free $line)
- (br $repl_loop)))
+ ;;($PR_MEMORY_SUMMARY_SMALL)
+ (br $repl_loop)
+ )
+ )
($print "\n")
;;($PR_MEMORY -1 -1)
(set_local $f 0)
(set_local $args 0)
- ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
-
(if (get_global $error_type)
(then
(set_local $res 0)
(br $EVAL_return)))
+ ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
+
(if (i32.ne ($TYPE $ast) (get_global $LIST_T))
(then
(set_local $res ($EVAL_AST $ast $env 0))
;; EVAL the rest through second to last
(set_local $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1))
(set_local $ast ($LAST $ast))
+ ($RELEASE $ast) ;; we already own it via ast
($RELEASE $el)
(br $TCO_loop))
(else (if (i32.eqz ($strcmp "if" $a0sym))
(local $line i32 $res i32 $repl_env i32)
;; argument processing
(local $i i32 $ret i32 $empty i32 $current i32 $tmp i32 $val2 i32)
+ (set_local $line (STATIC_ARRAY 201))
;; DEBUG
;; ($printf_1 "argc: 0x%x\n" $argc)
($add_core_ns $repl_env)
(drop ($ENV_SET_S $repl_env "eval" ($FUNCTION 0)))
+ ($checkpoint_user_memory)
+
;; core.mal: defined using the language itself
($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env))
($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" $repl_env))
;; Start REPL
(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)))
+ (br_if $repl_done (i32.eqz ($readline "user> " $line)))
+ (br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
(set_local $res ($REP $line $repl_env))
(if (get_global $error_type)
(then
(else
($printf_1 "%s\n" ($to_String $res))))
($RELEASE $res)
-;; ($PR_MEMORY -1 -1)
- ($free $line)
- (br $repl_loop)))
+ ;;($PR_MEMORY_SUMMARY_SMALL)
+ (br $repl_loop)
+ )
+ )
($print "\n")
;;($PR_MEMORY -1 -1)
(set_local $f 0)
(set_local $args 0)
- ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
-
(if (get_global $error_type)
(then
(set_local $res 0)
(br $EVAL_return)))
+ ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
+
(if (i32.ne ($TYPE $ast) (get_global $LIST_T))
(then
(set_local $res ($EVAL_AST $ast $env 0))
;; EVAL the rest through second to last
(set_local $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1))
(set_local $ast ($LAST $ast))
+ ($RELEASE $ast) ;; we already own it via ast
($RELEASE $el)
(br $TCO_loop))
(else (if (i32.eqz ($strcmp "quote" $a0sym))
(local $line i32 $res i32 $repl_env i32)
;; argument processing
(local $i i32 $ret i32 $empty i32 $current i32 $tmp i32 $val2 i32)
+ (set_local $line (STATIC_ARRAY 201))
;; DEBUG
;; ($printf_1 "argc: 0x%x\n" $argc)
($add_core_ns $repl_env)
(drop ($ENV_SET_S $repl_env "eval" ($FUNCTION 0)))
+ ($checkpoint_user_memory)
+
;; core.mal: defined using the language itself
($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env))
($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" $repl_env))
;; Start REPL
(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)))
+ (br_if $repl_done (i32.eqz ($readline "user> " $line)))
+ (br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
(set_local $res ($REP $line $repl_env))
(if (get_global $error_type)
(then
(else
($printf_1 "%s\n" ($to_String $res))))
($RELEASE $res)
-;; ($PR_MEMORY -1 -1)
- ($free $line)
- (br $repl_loop)))
+ ;;($PR_MEMORY_SUMMARY_SMALL)
+ (br $repl_loop)
+ )
+ )
($print "\n")
;;($PR_MEMORY -1 -1)
$res
)
- (global $mac_ast_stack (mut i32) (i32.const 0))
- (global $mac_ast_stack_top (mut i32) (i32.const -1))
+ (global $mac_stack (mut i32) (i32.const 0))
+ (global $mac_stack_top (mut i32) (i32.const -1))
(func $MACROEXPAND (param $orig_ast i32 $env i32) (result i32)
(local $ast i32 $mac i32 $mac_env i64)
- (set_global $mac_ast_stack (STATIC_ARRAY 128))
+ (set_global $mac_stack (STATIC_ARRAY 1024)) ;; 256 * 4
(set_local $ast $orig_ast)
(set_local $mac 0)
(block $done
;; to the pending release list.
(if (i32.ne $ast $orig_ast)
(then
- (set_global $mac_ast_stack_top
- (i32.add (get_global $mac_ast_stack_top) 1))
+ (set_global $mac_stack_top
+ (i32.add (get_global $mac_stack_top) 1))
+ (if (i32.ge_s (i32.mul_s (get_global $mac_stack_top) 4) 1024) ;; 256 * 4
+ ($fatal 7 "Exhausted mac_stack!\n"))
(i32.store (i32.add
- (get_global $mac_ast_stack)
- (i32.mul_s (get_global $mac_ast_stack_top) 4))
+ (get_global $mac_stack)
+ (i32.mul_s (get_global $mac_stack_top) 4))
$ast)))
(if (get_global $error_type)
(br $done))
- (br $loop)
+ (br $loop)
)
)
$ast
(local $ast i32 $env i32 $prev_ast i32 $prev_env i32 $res i32 $el i32)
(local $ftype i32 $f_args i32 $f i32 $args i32)
(local $a0 i32 $a0sym i32 $a1 i32 $a2 i32)
+ (local $orig_mac_stack_top i32)
(set_local $ast $orig_ast)
(set_local $env $orig_env)
(set_local $prev_ast 0)
(set_local $prev_env 0)
(set_local $res 0)
+ (set_local $orig_mac_stack_top (get_global $mac_stack_top))
(block $EVAL_return
(loop $TCO_loop
(set_local $f 0)
(set_local $args 0)
- ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
-
(if (get_global $error_type)
(then
(set_local $res 0)
(br $EVAL_return)))
+ ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
+
(if (i32.ne ($TYPE $ast) (get_global $LIST_T))
(then
(set_local $res ($EVAL_AST $ast $env 0))
;; EVAL the rest through second to last
(set_local $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1))
(set_local $ast ($LAST $ast))
+ ($RELEASE $ast) ;; we already own it via ast
($RELEASE $el)
(br $TCO_loop))
(else (if (i32.eqz ($strcmp "quote" $a0sym))
(if (i32.ne $env $orig_env) ($RELEASE $env))
(if $prev_ast ($RELEASE $prev_ast))
+ ;; release memory from MACROEXPAND
+ ;; TODO: needs to happen here so self-hosting doesn't leak
+ (block $done
+ (loop $loop
+ (if (i32.le_s (get_global $mac_stack_top) $orig_mac_stack_top)
+ (br $done))
+;;($printf_1 "free orig_mac_stack_top: %d\n" $orig_mac_stack_top)
+;;($printf_1 "free mac_stack_top: %d\n" (get_global $mac_stack_top))
+ ($RELEASE (i32.load (i32.add
+ (get_global $mac_stack)
+ (i32.mul_s (get_global $mac_stack_top) 4))))
+ (set_global $mac_stack_top
+ (i32.sub_s (get_global $mac_stack_top) 1))
+ (br $loop)
+ )
+ )
+
$res
)
;; release memory from MAL_READ
($RELEASE $mv1)
- ;; release memory from MACROEXPAND
- ;; TODO: needs to happen in EVAL
- (block $done
- (loop $loop
- (if (i32.lt_s (get_global $mac_ast_stack_top) 0)
- (br $done))
- ($RELEASE (i32.load (i32.add
- (get_global $mac_ast_stack)
- (i32.mul_s (get_global $mac_ast_stack_top) 4))))
- (set_global $mac_ast_stack_top
- (i32.sub_s (get_global $mac_ast_stack_top) 1))
- (br $loop)
- )
- )
$res
)
(local $line i32 $res i32 $repl_env i32)
;; argument processing
(local $i i32 $ret i32 $empty i32 $current i32 $tmp i32 $val2 i32)
+ (set_local $line (STATIC_ARRAY 201))
;; DEBUG
;; ($printf_1 "argc: 0x%x\n" $argc)
($add_core_ns $repl_env)
(drop ($ENV_SET_S $repl_env "eval" ($FUNCTION 0)))
+ ($checkpoint_user_memory)
+
;; core.mal: defined using the language itself
($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env))
($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" $repl_env))
;; Start REPL
(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)))
+ (br_if $repl_done (i32.eqz ($readline "user> " $line)))
+ (br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
(set_local $res ($REP $line $repl_env))
(if (get_global $error_type)
(then
(else
($printf_1 "%s\n" ($to_String $res))))
($RELEASE $res)
-;; ($PR_MEMORY -1 -1)
- ($free $line)
- (br $repl_loop)))
+ ;;($PR_MEMORY_SUMMARY_SMALL)
+ (br $repl_loop)
+ )
+ )
($print "\n")
;;($PR_MEMORY -1 -1)
-(module $step8_macros
+(module $step9_try
(global $repl_env (mut i32) (i32.const 0))
$res
)
- (global $mac_ast_stack (mut i32) (i32.const 0))
- (global $mac_ast_stack_top (mut i32) (i32.const -1))
+ (global $mac_stack (mut i32) (i32.const 0))
+ (global $mac_stack_top (mut i32) (i32.const -1))
(func $MACROEXPAND (param $orig_ast i32 $env i32) (result i32)
(local $ast i32 $mac i32 $mac_env i64)
- (set_global $mac_ast_stack (STATIC_ARRAY 128))
+ (set_global $mac_stack (STATIC_ARRAY 1024)) ;; 256 * 4
(set_local $ast $orig_ast)
(set_local $mac 0)
(block $done
;; to the pending release list.
(if (i32.ne $ast $orig_ast)
(then
- (set_global $mac_ast_stack_top
- (i32.add (get_global $mac_ast_stack_top) 1))
+ (set_global $mac_stack_top
+ (i32.add (get_global $mac_stack_top) 1))
+ (if (i32.ge_s (i32.mul_s (get_global $mac_stack_top) 4) 1024) ;; 256 * 4
+ ($fatal 7 "Exhausted mac_stack!\n"))
(i32.store (i32.add
- (get_global $mac_ast_stack)
- (i32.mul_s (get_global $mac_ast_stack_top) 4))
+ (get_global $mac_stack)
+ (i32.mul_s (get_global $mac_stack_top) 4))
$ast)))
(if (get_global $error_type)
(br $done))
- (br $loop)
+ (br $loop)
)
)
$ast
(local $ftype i32 $f_args i32 $f i32 $args i32)
(local $a0 i32 $a0sym i32 $a1 i32 $a2 i32)
(local $err i32)
+ (local $orig_mac_stack_top i32)
(set_local $ast $orig_ast)
(set_local $env $orig_env)
(set_local $prev_ast 0)
(set_local $prev_env 0)
(set_local $res 0)
+ (set_local $orig_mac_stack_top (get_global $mac_stack_top))
(block $EVAL_return
(loop $TCO_loop
(set_local $f 0)
(set_local $args 0)
- ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
-
(if (get_global $error_type)
(then
(set_local $res 0)
(br $EVAL_return)))
+ ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
+
(if (i32.ne ($TYPE $ast) (get_global $LIST_T))
(then
(set_local $res ($EVAL_AST $ast $env 0))
;; EVAL the rest through second to last
(set_local $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1))
(set_local $ast ($LAST $ast))
+ ($RELEASE $ast) ;; we already own it via ast
($RELEASE $el)
(br $TCO_loop))
(else (if (i32.eqz ($strcmp "quote" $a0sym))
(if (i32.eqz (get_global $error_type))
(br $EVAL_return))
;; if there is an error and res is set, we need to free it
- ($printf_1 "res value: %d\n" $res)
($RELEASE $res)
;; if there is no catch block then return
(if (i32.eqz ($VAL0 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))
(if (i32.ne $env $orig_env) ($RELEASE $env))
(if $prev_ast ($RELEASE $prev_ast))
+ ;; release memory from MACROEXPAND
+ ;; TODO: needs to happen here so self-hosting doesn't leak
+ (block $done
+ (loop $loop
+ (if (i32.le_s (get_global $mac_stack_top) $orig_mac_stack_top)
+ (br $done))
+;;($printf_1 "free orig_mac_stack_top: %d\n" $orig_mac_stack_top)
+;;($printf_1 "free mac_stack_top: %d\n" (get_global $mac_stack_top))
+ ($RELEASE (i32.load (i32.add
+ (get_global $mac_stack)
+ (i32.mul_s (get_global $mac_stack_top) 4))))
+ (set_global $mac_stack_top
+ (i32.sub_s (get_global $mac_stack_top) 1))
+ (br $loop)
+ )
+ )
+
$res
)
;; release memory from MAL_READ
($RELEASE $mv1)
- ;; release memory from MACROEXPAND
- ;; TODO: needs to happen in EVAL
- (block $done
- (loop $loop
- (if (i32.lt_s (get_global $mac_ast_stack_top) 0)
- (br $done))
- ($RELEASE (i32.load (i32.add
- (get_global $mac_ast_stack)
- (i32.mul_s (get_global $mac_ast_stack_top) 4))))
- (set_global $mac_ast_stack_top
- (i32.sub_s (get_global $mac_ast_stack_top) 1))
- (br $loop)
- )
- )
$res
)
(local $line i32 $res i32 $repl_env i32)
;; argument processing
(local $i i32 $ret i32 $empty i32 $current i32 $tmp i32 $val2 i32)
+ (set_local $line (STATIC_ARRAY 201))
;; DEBUG
;; ($printf_1 "argc: 0x%x\n" $argc)
($add_core_ns $repl_env)
(drop ($ENV_SET_S $repl_env "eval" ($FUNCTION 0)))
+ ($checkpoint_user_memory)
;; core.mal: defined using the language itself
($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env))
;; Start REPL
(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)))
+ (br_if $repl_done (i32.eqz ($readline "user> " $line)))
+ (br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
(set_local $res ($REP $line $repl_env))
(if (get_global $error_type)
(then
(else
($printf_1 "%s\n" ($to_String $res))))
($RELEASE $res)
-;; ($PR_MEMORY -1 -1)
- ($free $line)
- (br $repl_loop)))
+ ;;($PR_MEMORY_SUMMARY_SMALL)
+ (br $repl_loop)
+ )
+ )
($print "\n")
;;($PR_MEMORY -1 -1)
-(module $step8_macros
+(module $stepA_mal
(global $repl_env (mut i32) (i32.const 0))
$res
)
- (global $mac_ast_stack (mut i32) (i32.const 0))
- (global $mac_ast_stack_top (mut i32) (i32.const -1))
+ (global $mac_stack (mut i32) (i32.const 0))
+ (global $mac_stack_top (mut i32) (i32.const -1))
(func $MACROEXPAND (param $orig_ast i32 $env i32) (result i32)
(local $ast i32 $mac i32 $mac_env i64)
- (set_global $mac_ast_stack (STATIC_ARRAY 128))
+ (set_global $mac_stack (STATIC_ARRAY 1024)) ;; 256 * 4
(set_local $ast $orig_ast)
(set_local $mac 0)
(block $done
;; to the pending release list.
(if (i32.ne $ast $orig_ast)
(then
- (set_global $mac_ast_stack_top
- (i32.add (get_global $mac_ast_stack_top) 1))
+ (set_global $mac_stack_top
+ (i32.add (get_global $mac_stack_top) 1))
+ (if (i32.ge_s (i32.mul_s (get_global $mac_stack_top) 4) 1024) ;; 256 * 4
+ ($fatal 7 "Exhausted mac_stack!\n"))
(i32.store (i32.add
- (get_global $mac_ast_stack)
- (i32.mul_s (get_global $mac_ast_stack_top) 4))
+ (get_global $mac_stack)
+ (i32.mul_s (get_global $mac_stack_top) 4))
$ast)))
(if (get_global $error_type)
(br $done))
- (br $loop)
+ (br $loop)
)
)
$ast
(local $ftype i32 $f_args i32 $f i32 $args i32)
(local $a0 i32 $a0sym i32 $a1 i32 $a2 i32)
(local $err i32)
+ (local $orig_mac_stack_top i32)
(set_local $ast $orig_ast)
(set_local $env $orig_env)
(set_local $prev_ast 0)
(set_local $prev_env 0)
(set_local $res 0)
+ (set_local $orig_mac_stack_top (get_global $mac_stack_top))
(block $EVAL_return
(loop $TCO_loop
(set_local $f 0)
(set_local $args 0)
- ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
-
(if (get_global $error_type)
(then
(set_local $res 0)
(br $EVAL_return)))
+ ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
+
(if (i32.ne ($TYPE $ast) (get_global $LIST_T))
(then
(set_local $res ($EVAL_AST $ast $env 0))
;; EVAL the rest through second to last
(set_local $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1))
(set_local $ast ($LAST $ast))
+ ($RELEASE $ast) ;; we already own it via ast
($RELEASE $el)
(br $TCO_loop))
(else (if (i32.eqz ($strcmp "quote" $a0sym))
(if (i32.eqz (get_global $error_type))
(br $EVAL_return))
;; if there is an error and res is set, we need to free it
- ($printf_1 "res value: %d\n" $res)
($RELEASE $res)
;; if there is no catch block then return
(if (i32.eqz ($VAL0 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))
(if (i32.ne $env $orig_env) ($RELEASE $env))
(if $prev_ast ($RELEASE $prev_ast))
+ ;; release memory from MACROEXPAND
+ ;; TODO: needs to happen here so self-hosting doesn't leak
+ (block $done
+ (loop $loop
+ (if (i32.le_s (get_global $mac_stack_top) $orig_mac_stack_top)
+ (br $done))
+;;($printf_1 "free orig_mac_stack_top: %d\n" $orig_mac_stack_top)
+;;($printf_1 "free mac_stack_top: %d\n" (get_global $mac_stack_top))
+ ($RELEASE (i32.load (i32.add
+ (get_global $mac_stack)
+ (i32.mul_s (get_global $mac_stack_top) 4))))
+ (set_global $mac_stack_top
+ (i32.sub_s (get_global $mac_stack_top) 1))
+ (br $loop)
+ )
+ )
+
$res
)
;; release memory from MAL_READ
($RELEASE $mv1)
- ;; release memory from MACROEXPAND
- ;; TODO: needs to happen in EVAL
- (block $done
- (loop $loop
- (if (i32.lt_s (get_global $mac_ast_stack_top) 0)
- (br $done))
- ($RELEASE (i32.load (i32.add
- (get_global $mac_ast_stack)
- (i32.mul_s (get_global $mac_ast_stack_top) 4))))
- (set_global $mac_ast_stack_top
- (i32.sub_s (get_global $mac_ast_stack_top) 1))
- (br $loop)
- )
- )
$res
)
(local $line i32 $res i32 $repl_env i32)
;; argument processing
(local $i i32 $ret i32 $empty i32 $current i32 $tmp i32 $val2 i32)
+ (set_local $line (STATIC_ARRAY 201))
;; DEBUG
;; ($printf_1 "argc: 0x%x\n" $argc)
;; Start REPL
(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)))
+ (br_if $repl_done (i32.eqz ($readline "user> " $line)))
+ (br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
(set_local $res ($REP $line $repl_env))
(if (get_global $error_type)
(then
(else
($printf_1 "%s\n" ($to_String $res))))
($RELEASE $res)
- ($free $line)
;;($PR_MEMORY_SUMMARY_SMALL)
- (br $repl_loop)))
+ (br $repl_loop)
+ )
+ )
($print "\n")
;;($PR_MEMORY -1 -1)
(set_local $needle_len ($strlen $needle))
(set_local $replace_len ($strlen $replace))
(if (i32.gt_u $replace_len $needle_len)
- (then
- ($print "REPLACE: invalid expanding in-place call\n")
- ($exit 1)))
+ ($fatal 7 "REPLACE: invalid expanding in-place call\n"))
(set_local $s (i32.add $s 1))
(br $loop)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; string functions
+ (func $to_MalString (param $mv i32) (result i32)
+ ;; TODO: assert mv is a string/keyword/symbol
+ (i32.add (get_global $string_mem) ($VAL0 $mv))
+ )
+
(func $to_String (param $mv i32) (result i32)
- ;; skip string refcnt
- (i32.add 4 ($VAL0 $mv))
+ ;; skip string refcnt and size
+ (i32.add 4 ($to_MalString $mv))
+ )
+
+ ;; Duplicate regular character array string into a Mal string and
+ ;; return the MalVal pointer
+ (func $STRING (param $type i32 $str i32) (result i32)
+ (local $ms i32)
+ ;; TODO: assert mv is a string/keyword/symbol
+ (set_local $ms ($ALLOC_STRING $str ($strlen $str) 1))
+ ($ALLOC_SCALAR $type (i32.sub_u $ms (get_global $string_mem)))
+ )
+
+ ;; Find first duplicate (internet) of mv. If one is found, free up
+ ;; mv and return the interned version. If no duplicate is found,
+ ;; return NULL.
+ (func $INTERN_STRING (param $mv i32) (result i32)
+ (local $res i32 $ms i32 $existing_ms i32 $tmp i32)
+ (set_local $res 0)
+ (set_local $ms ($to_MalString $mv))
+ (set_local $existing_ms ($FIND_STRING (i32.add $ms 4)))
+ (if (AND $existing_ms (i32.lt_s $existing_ms $ms))
+ (then
+ (set_local $tmp $mv)
+ (set_local $res ($ALLOC_SCALAR (get_global $STRING_T)
+ (i32.sub_s $existing_ms
+ (get_global $string_mem))))
+ (i32.store16_u $existing_ms (i32.add (i32.load16_u $existing_ms) 1))
+ ($RELEASE $tmp)))
+ $res
+ )
+
+ (func $STRING_INIT (param $type i32) (result i32)
+ (local $ms i32)
+ (set_local $ms ($ALLOC_STRING "" 0 0))
+ ($ALLOC_SCALAR $type (i32.sub_s $ms (get_global $string_mem)))
+ )
+
+ (func $STRING_FINALIZE (param $mv i32 $size i32) (result i32)
+ (local $tmp i32 $ms i32)
+ ;; Check if the new string can be interned.
+ (set_local $tmp ($INTERN_STRING $mv))
+ (set_local $ms ($to_MalString $mv))
+ (if $tmp
+ (then
+ (set_local $mv $tmp))
+ (else
+ ;;; ms->size = sizeof(MalString) + size + 1
+ (i32.store16_u (i32.add $ms 2)
+ (i32.add (i32.add 4 $size) 1))
+ ;;; string_mem_next = (void *)ms + ms->size
+ (set_global $string_mem_next
+ (i32.add $ms (i32.load16_u (i32.add $ms 2))))))
+ $mv
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
HCoop / jackhill / mal.git / commitdiff