Merge pull request #379 from bjh21/bjh21-unterminated-string-fixes
[jackhill/mal.git] / wasm / platform_wasi.wam
1 (module $platform_wasi
2
3 (memory 256)
4 (export "memory" (memory 0))
5 (global $memoryBase i32 0)
6
7 (global $WASI_RIGHT_FD_READ i64 (i64.const 2))
8 (global $WASI_ESUCCESS i32 0)
9 (global $WASI_EBADF i32 8)
10 (global $WASI_PREOPENTYPE_DIR i32 0)
11
12 (import "wasi_unstable" "args_get" (func $args_get (param i32 i32) (result i32)))
13 (import "wasi_unstable" "args_sizes_get" (func $args_sizes_get (param i32 i32) (result i32)))
14 (import "wasi_unstable" "clock_time_get" (func $clock_time_get (param i32 i64 i32) (result i32)))
15 (import "wasi_unstable" "fd_prestat_get" (func $fd_prestat_get (param i32 i32) (result i32)))
16 (import "wasi_unstable" "fd_prestat_dir_name" (func $fd_prestat_dir_name (param i32 i32 i32) (result i32)))
17 (import "wasi_unstable" "fd_read" (func $fd_read (param i32 i32 i32 i32) (result i32)))
18 (import "wasi_unstable" "fd_write" (func $fd_write (param i32 i32 i32 i32) (result i32)))
19 (import "wasi_unstable" "path_open" (func $path_open (param i32 i32 i32 i32 i32 i64 i64 i32 i32) (result i32)))
20 (import "wasi_unstable" "proc_exit" (func $proc_exit (param i32)))
21
22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23
24 (func $fatal (param $code i32 $msg i32)
25 ($print $msg)
26 ($proc_exit $code)
27 )
28
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30
31 (func $print (param $addr i32)
32 (LET $ret 0
33 $nwritten_ptr (STATIC_ARRAY 4 4)
34 $iovec (STATIC_ARRAY 8 8))
35 (i32.store $iovec $addr)
36 (i32.store offset=4 $iovec ($strlen $addr))
37 (local.set $ret ($fd_write 1 $iovec 1 $nwritten_ptr))
38 )
39
40 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
41
42 (func $readline (param $prompt i32 $buf i32) (result i32)
43 (LET $ret 0
44 $nread_ptr (STATIC_ARRAY 4 4)
45 $iovec (STATIC_ARRAY 8 8))
46 ($print $prompt)
47 (i32.store $iovec $buf)
48 (i32.store offset=4 $iovec 200) ;; TODO: not hardcoded length
49 (local.set $ret ($fd_read 0 $iovec 1 $nread_ptr))
50 (if (i32.le_s (i32.load $nread_ptr) 0)
51 (return 0))
52 ;; Replace ending newline with NULL
53 (i32.store8 (i32.add $buf (i32.sub (i32.load $nread_ptr) 1)) 0)
54 1
55 )
56
57 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
58
59 (func $read_file (param $path i32 $buf i32) (result i32)
60 (LET $orig_path $path
61 $ret 0
62 $prestat_ptr (STATIC_ARRAY 8 4)
63 $pr_type 0
64 $pr_name_len 0
65 $prepath (STATIC_ARRAY 1024)
66 $dirfd -1
67 $fd 3
68 $fd_ptr (STATIC_ARRAY 4 4)
69 $nread_ptr (STATIC_ARRAY 4 4)
70 $iovec (STATIC_ARRAY 8 8))
71
72 ;; Find the pre-opened dir fd with the same prefix as the our path
73 ;; following the algorithm at:
74 ;; https://github.com/CraneStation/wasi-sysroot/blob/1cc98f27f5ab8afdc033e16eac8799ee606eb769/libc-bottom-half/crt/crt1.c#L71
75 ;; The matching dir fd is then used to open and read the path.
76 (block $loop_done
77 (loop $loop
78 ;; prestat the fd from 3 onward until EBADF is returned
79 (local.set $ret ($fd_prestat_get $fd $prestat_ptr))
80 (if (i32.eq (global.get $WASI_EBADF) $ret)
81 (br $loop_done))
82 (if (i32.ne (global.get $WASI_ESUCCESS) $ret)
83 (then
84 (local.set $fd (i32.add 1 $fd))
85 (br $loop)))
86 ;;(br $loop_done))
87 (local.set $pr_type (i32.load $prestat_ptr))
88 (local.set $pr_name_len (i32.load offset=4 $prestat_ptr))
89 ;; Read the pre-opened path name
90 (local.set $ret ($fd_prestat_dir_name $fd $prepath $pr_name_len))
91 (if (i32.ne (global.get $WASI_ESUCCESS) $ret)
92 (br $loop_done))
93 ;; if pr_name_len includes a null, exclude it from the compare
94 ;;($printf_2 "here1 pr_name_len: %d, char is %d\n" $pr_name_len (i32.load8_u (i32.add $prepath (i32.sub $pr_name_len 1))))
95 (if (i32.eqz (i32.load8_u (i32.add $prepath (i32.sub $pr_name_len 1))))
96 (then
97 (local.set $pr_name_len (i32.sub $pr_name_len 1))))
98 ;; if it is a dir and the path prefix matches, use it
99 ;;($printf_5 "fd: %d, ret: %d, pr_type: %d, pr_name_len: %d, prepath: %s\n"
100 ;; $fd $ret $pr_type $pr_name_len $prepath)
101 (if (AND (i32.eq $pr_type (global.get $WASI_PREOPENTYPE_DIR))
102 (i32.eqz ($strncmp $prepath $path $pr_name_len)))
103 (then
104 (local.set $path (i32.add $pr_name_len $path))
105 (local.set $dirfd $fd)
106 (br $loop_done)))
107 (local.set $fd (i32.add 1 $fd))
108 (br $loop)
109 )
110 )
111
112 ;;($printf_3 "final dirfd: %d, adjusted path: %s (%d)\n" $dirfd $path ($strlen $path))
113
114 (if (i32.eq $dirfd -1)
115 (then
116 ($printf_1 "ERROR: could not find permission for '%s'\n" $orig_path)
117 (return 0)))
118
119 (local.set $ret ($path_open $dirfd
120 1 ;; dirflags (symlink follow)
121 $path
122 ($strlen $path)
123 0 ;; o_flags
124 (global.get $WASI_RIGHT_FD_READ)
125 (global.get $WASI_RIGHT_FD_READ)
126 0 ;; fs_flags
127 $fd_ptr))
128 (if (i32.ne (global.get $WASI_ESUCCESS) $ret)
129 (then
130 ($printf_2 "ERROR: failed to open '%s', error %d\n" $orig_path $ret)
131 (return 0)))
132
133 (i32.store $iovec $buf)
134 ;; TODO: use stat result instead of not hardcoded length
135 (i32.store offset=4 $iovec 16384)
136 (local.set $ret ($fd_read (i32.load $fd_ptr) $iovec 1 $nread_ptr))
137 (if (i32.ne (global.get $WASI_ESUCCESS) $ret)
138 (then
139 ($printf_2 "ERROR: failed to read '%s', error %d\n" $orig_path $ret)
140 (return 0)))
141
142 ;; Add null to string
143 (i32.store8 (i32.add $buf (i32.load $nread_ptr)) 0)
144 (i32.add 1 (i32.load $nread_ptr))
145 )
146
147 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
148
149 (func $get_time_ms (result i32)
150 (LET $tv (STATIC_ARRAY 8 8))
151 (drop (call $clock_time_get 0 (i64.const 0) $tv))
152 (i32.wrap_i64
153 ;; convert nanoseconds to milliseconds
154 (i64.div_u (i64.load $tv) (i64.const 1000000)))
155 )
156
157 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
158
159 ;; Returns an i64 with argc in high 32 and argv in low 32.
160 ;; String memory is: argv + (argc * 4)
161 (func $get_argc_argv (result i64)
162 (LET $argc_ptr (STATIC_ARRAY 4 4)
163 $argv_size_ptr (STATIC_ARRAY 4 4)
164 $argc 0
165 $argv (STATIC_ARRAY 1024 4))
166 (drop ($args_sizes_get $argc_ptr $argv_size_ptr))
167 (local.set $argc (i32.load $argc_ptr))
168 (if (i32.gt_u (i32.add (i32.mul 4 $argc)
169 (i32.load $argv_size_ptr))
170 1024)
171 ($fatal 2 "Command line arguments memory exceeds 1024 bytes"))
172 (drop ($args_get $argv (i32.add $argv (i32.mul 4 $argc))))
173 (i64.or (i64.shl (i64.extend_i32_u $argc) (i64.const 32))
174 (i64.extend_i32_u $argv))
175 )
176
177 (func $entry
178 (local $argc_argv i64)
179 ($init_memory)
180 (local.set $argc_argv ($get_argc_argv))
181 ($proc_exit
182 ($main (i32.wrap_i64 (i64.shr_u $argc_argv (i64.const 32)))
183 (i32.wrap_i64 $argc_argv)))
184 )
185 ;;(start $entry)
186
187 (export "_start" (func $entry))
188
189 )