substrate-lang 0.9.4 → 0.10.1

package/substrate/host/node/net.mjs

@@ -50,7 +50,7 @@ export function netModule(grants, certificate) {
             });
           } else server.listen(port, host);
         } catch (e) {
-          caller.fail(err, e.message);
+          caller.fail(err, e.message, errorOf(e));
           return 0;
         }
         id = next++;
@@ -81,7 +81,7 @@ export function netModule(grants, certificate) {
             ? tls.connect({ host, port, servername, ca, allowHalfOpen: true, lookup })
             : net.connect({ host, port, allowHalfOpen: true, lookup });
         } catch (e) {
-          caller.fail(err, e.message);
+          caller.fail(err, e.message, errorOf(e));
           return 0;
         }
         let connected = false;

package/substrate/host/node/net.sub

@@ -14,12 +14,19 @@
 (const net-connected u32 3)
 (const net-failed u32 4)
 
-(define (net-listen [port u32] [host string] [secure bool] [most u32] [tag (ptr void)] [err (ptr string)]) -> u32
-  (cast u32 (listen (cast i32 port) (cast i32 (-> host bytes)) (cast i32 (-> host length)) secure (cast i32 most)
-                    (cast i32 tag) (cast i32 err))))
+(define (net-listen [port u32] [host string] [secure bool] [most u32] [tag (ptr void)] [id (ptr u32)]
+                    [err (ptr error)]) -> bool
+  (let ([why string] [n u32 0])
+    (set! n (cast u32 (listen (cast i32 port) (cast i32 (-> host bytes)) (cast i32 (-> host length)) secure
+                              (cast i32 most) (cast i32 tag) (cast i32 (& why)))))
+    (unless (== id 0) (set! (@ id) n))
+    (or (!= n 0) (host-failed! (& why) err))))
 
-(define (net-connect [port u32] [host string] [secure bool] [tag (ptr void)] [err (ptr string)]) -> u32
-  (cast u32 (connect (cast i32 port) (cast i32 (-> host bytes)) (cast i32 (-> host length)) secure (cast i32 tag)
-                     (cast i32 err))))
+(define (net-connect [port u32] [host string] [secure bool] [tag (ptr void)] [id (ptr u32)] [err (ptr error)]) -> bool
+  (let ([why string] [n u32 0])
+    (set! n (cast u32 (connect (cast i32 port) (cast i32 (-> host bytes)) (cast i32 (-> host length)) secure
+                               (cast i32 tag) (cast i32 (& why)))))
+    (unless (== id 0) (set! (@ id) n))
+    (or (!= n 0) (host-failed! (& why) err))))
 
 (define (net-close [id u32]) (close (cast i32 id)))

package/substrate/host/node/process.mjs

@@ -84,7 +84,7 @@ export function processes(grants, loader, setup = {}) {
           const l = launched(file ?? program, entries(caller.string(ap, al)));
           process = child.spawn(l.command, l.args, { cwd, env, stdio: modes });
         } catch (e) {
-          caller.fail(err, e.message);
+          caller.fail(err, e.message, errorOf(e));
           return 0;
         }
         const id = next++;
@@ -130,7 +130,7 @@ export function processes(grants, loader, setup = {}) {
           new DataView(caller.memory().buffer).setUint32(caller.u(op), p, true);
           return r.status !== null ? r.status : 128 + (os.constants.signals[r.signal] || 0);
         } catch (e) {
-          caller.fail(err, e.message);
+          caller.fail(err, e.message, errorOf(e));
           return -1;
         } finally {
           if (dir) fs.rmSync(dir, { recursive: true, force: true });
@@ -146,7 +146,7 @@ export function processes(grants, loader, setup = {}) {
           const l = launched(file ?? program, entries(caller.string(ap, al)), program);
           become(l.command, [l.argv0, ...l.args], env);
         } catch (e) {
-          caller.fail(err, e.message);
+          caller.fail(err, e.message, errorOf(e));
         }
         return -1;
       },
@@ -161,7 +161,7 @@ export function processes(grants, loader, setup = {}) {
           const l = launched(file ?? program, entries(caller.string(ap, al)), program);
           setup.atEnd = { file: l.command, argv: [l.argv0, ...l.args], env };
         } catch (e) {
-          caller.fail(err, e.message);
+          caller.fail(err, e.message, errorOf(e));
           return -1;
         }
         return 0;

package/substrate/host/node/process.sub

@@ -33,54 +33,55 @@
   (set! (-> o stdout) process-pipe)
   (set! (-> o stderr) process-pipe))
 
-(define (process-spawn [program string] [args (slice string)] [o (ptr process-options)] [tag (ptr void)]
-                       [err (ptr string)]) -> u32
-  (let ([defaults process-options] [p o] [a (make-buffer)] [e (make-buffer)] [id u32 0])
+(define (process-spawn [program string] [args (slice string)] [o (ptr process-options)] [tag (ptr void)] [id (ptr u32)]
+                       [err (ptr error)]) -> bool
+  (let ([defaults process-options] [p o] [a (make-buffer)] [e (make-buffer)] [why string] [n u32 0])
     (when (== p 0)
       (process-options-init! (& defaults))
       (set! p (& defaults)))
     (buffer-add-entries! (& a) args)
     (buffer-add-entries! (& e) (-> p env))
-    (set! id (cast u32 (spawn (cast i32 (-> program bytes)) (cast i32 (-> program length)) (cast i32 (-> a bytes))
-                              (cast i32 (-> a length)) (cast i32 (-> p dir bytes)) (cast i32 (-> p dir length))
-                              (cast i32 (-> e bytes)) (cast i32 (-> e length)) (-> p clear) (cast i32 (-> p stdin))
-                              (cast i32 (-> p stdout)) (cast i32 (-> p stderr)) (cast i32 tag) (cast i32 err))))
+    (set! n (cast u32 (spawn (cast i32 (-> program bytes)) (cast i32 (-> program length)) (cast i32 (-> a bytes))
+                             (cast i32 (-> a length)) (cast i32 (-> p dir bytes)) (cast i32 (-> p dir length))
+                             (cast i32 (-> e bytes)) (cast i32 (-> e length)) (-> p clear) (cast i32 (-> p stdin))
+                             (cast i32 (-> p stdout)) (cast i32 (-> p stderr)) (cast i32 tag) (cast i32 (& why)))))
     (buffer-free! (& a))
     (buffer-free! (& e))
-    id))
+    (unless (== id 0) (set! (@ id) n))
+    (or (!= n 0) (host-failed! (& why) err))))
 
 (define (process-run [program string] [args (slice string)] [o (ptr process-options)] [input (slice u8)] [timeout u32]
-                     [output (ptr (slice u8))] [err (ptr string)]) -> i32
-  (let ([defaults process-options] [p o] [a (make-buffer)] [e (make-buffer)] [code i32 0])
+                     [output (ptr (slice u8))] [status (ptr i32)] [err (ptr error)]) -> bool
+  (let ([defaults process-options] [p o] [a (make-buffer)] [e (make-buffer)] [why string])
     (when (== p 0)
       (process-options-init! (& defaults))
       (set! p (& defaults)))
     (set! (@ output) (slice (cast (ptr u8) 0) 0))
     (buffer-add-entries! (& a) args)
     (buffer-add-entries! (& e) (-> p env))
-    (set! code (run (cast i32 (-> program bytes)) (cast i32 (-> program length)) (cast i32 (-> a bytes)) (cast i32 (-> a length))
-                    (cast i32 (-> p dir bytes)) (cast i32 (-> p dir length)) (cast i32 (-> e bytes)) (cast i32 (-> e length))
-                    (-> p clear) (cast i32 (-> input items)) (cast i32 (-> input length)) (cast i32 timeout)
-                    (cast i32 output) (cast i32 err)))
+    (set! (@ status) (run (cast i32 (-> program bytes)) (cast i32 (-> program length)) (cast i32 (-> a bytes))
+                          (cast i32 (-> a length)) (cast i32 (-> p dir bytes)) (cast i32 (-> p dir length))
+                          (cast i32 (-> e bytes)) (cast i32 (-> e length)) (-> p clear) (cast i32 (-> input items))
+                          (cast i32 (-> input length)) (cast i32 timeout) (cast i32 output) (cast i32 (& why))))
     (buffer-free! (& a))
     (buffer-free! (& e))
-    code))
+    (or (>= (@ status) 0) (host-failed! (& why) err))))
 
-(define (process-exec [program string] [args (slice string)] [err (ptr string)]) -> i32
-  (let ([a (make-buffer)] [r i32 0])
+(define (process-exec [program string] [args (slice string)] [err (ptr error)]) -> bool
+  (let ([a (make-buffer)] [why string])
     (buffer-add-entries! (& a) args)
-    (set! r (exec (cast i32 (-> program bytes)) (cast i32 (-> program length)) (cast i32 (-> a bytes)) (cast i32 (-> a length))
-                  (cast i32 err)))
+    (exec (cast i32 (-> program bytes)) (cast i32 (-> program length)) (cast i32 (-> a bytes)) (cast i32 (-> a length))
+          (cast i32 (& why)))
     (buffer-free! (& a))
-    r))
+    (host-failed! (& why) err)))
 
-(define (process-exec-at-end [program string] [args (slice string)] [err (ptr string)]) -> i32
-  (let ([a (make-buffer)] [r i32 0])
+(define (process-exec-at-end [program string] [args (slice string)] [err (ptr error)]) -> bool
+  (let ([a (make-buffer)] [r i32 0] [why string])
     (buffer-add-entries! (& a) args)
     (set! r (exec-at-end (cast i32 (-> program bytes)) (cast i32 (-> program length)) (cast i32 (-> a bytes))
-                         (cast i32 (-> a length)) (cast i32 err)))
+                         (cast i32 (-> a length)) (cast i32 (& why))))
     (buffer-free! (& a))
-    r))
+    (or (== r 0) (host-failed! (& why) err))))
 
 (define (process-stdin [id u32]) -> u32 (cast u32 (stdin (cast i32 id))))
 

package/substrate/host/node/signal.mjs

@@ -1,5 +1,6 @@
 // The host module "signal" (signal.sub) on Node.
 import os from 'node:os';
+import { errors } from '../errors.mjs';
 
 const SOURCE = 16;
 const RECEIVED = 1;
@@ -18,11 +19,11 @@ export function signals() {
     listen(np, nl, tag, err) {
       const name = caller.string(np, nl);
       if (!Object.hasOwn(os.constants.signals, name)) {
-        caller.fail(err, `signal.listen: ${name} is not a signal`);
+        caller.fail(err, `signal.listen: ${name} is not a signal`, errors.invalid);
         return 0;
       }
       if (forbidden.has(name)) {
-        caller.fail(err, `signal.listen: ${name} cannot be listened for`);
+        caller.fail(err, `signal.listen: ${name} cannot be listened for`, errors.invalid);
         return 0;
       }
       const id = next++;

package/substrate/host/node/signal.sub

@@ -1,8 +1,7 @@
 ;; Signals to the program: the host module "signal", after Deno's addSignalListener. signal-listen listens for the
-;; signal named, such as "SIGINT" or "SIGTERM", and returns the listener's number, or 0 with the reason at err; while
-;; any listener is there, the signal no longer ends the program, and a listener alone does not keep it running. A
-;; received event comes each time the signal arrives. SIGKILL, SIGSTOP, SIGILL, SIGFPE and SIGSEGV cannot be listened
-;; for, and a worker has no signals.
+;; signal named, such as "SIGINT" or "SIGTERM". While any listener is there, the signal no longer ends the program, and
+;; a listener alone does not keep it running. A received event comes each time the signal arrives. SIGKILL, SIGSTOP,
+;; SIGILL, SIGFPE and SIGSEGV cannot be listened for, and a worker has no signals.
 (provide signal-source signal-received signal-listen signal-stop)
 
 (import listen "signal" "listen" (i32 i32 i32 i32 -> i32))
@@ -11,7 +10,11 @@
 (const signal-source u32 16)
 (const signal-received u32 1)
 
-(define (signal-listen [name string] [tag (ptr void)] [err (ptr string)]) -> u32
-  (cast u32 (listen (cast i32 (-> name bytes)) (cast i32 (-> name length)) (cast i32 tag) (cast i32 err))))
+(define (signal-listen [name string] [tag (ptr void)] [id (ptr u32)] [err (ptr error)]) -> bool
+  (let ([why string] [n u32 0])
+    (set! n (cast u32 (listen (cast i32 (-> name bytes)) (cast i32 (-> name length)) (cast i32 tag)
+                              (cast i32 (& why)))))
+    (unless (== id 0) (set! (@ id) n))
+    (or (!= n 0) (host-failed! (& why) err))))
 
 (define (signal-stop [id u32]) (stop (cast i32 id)))

package/substrate/host/node/watch.mjs

@@ -60,7 +60,7 @@ export function watchModule(grants) {
         return id;
       } catch (e) {
         close(w);
-        caller.fail(err, `watch.start: ${at}: ${plainMessage(e)}`);
+        caller.fail(err, `watch.start: ${at}: ${plainMessage(e)}`, errorOf(e));
         return 0;
       }
     },

package/substrate/host/node/watch.sub

@@ -1,8 +1,7 @@
 ;; Watching files: the host module "watch", after Deno's watchFs. watch-start watches the paths, and everything under
-;; them unless the options' recursive is #f, and returns the watch's number, or 0 with the reason at err. A changed
-;; event's value is watch-create, watch-modify or watch-remove, and its bytes are the absolute paths it is about, as
-;; entries; a rename comes as a remove and a create. Changes under the options' ignore paths are left out. A failed
-;; event ends the watch.
+;; them unless the options' recursive is #f. A changed event's value is watch-create, watch-modify or watch-remove, and
+;; its bytes are the absolute paths it is about, as entries; a rename comes as a remove and a create. Changes under the
+;; options' ignore paths are left out. A failed event ends the watch.
 (provide watch-source watch-changed watch-failed watch-create watch-modify watch-remove watch-options
          watch-options-init! watch-start watch-stop)
 
@@ -23,17 +22,20 @@
   (set! (-> o recursive) #t)
   (set! (-> o ignore) 0))
 
-(define (watch-start [paths (slice string)] [o (ptr watch-options)] [tag (ptr void)] [err (ptr string)]) -> u32
-  (let ([defaults watch-options] [p o] [watched (make-buffer)] [ignored (make-buffer)] [id u32 0])
+(define (watch-start [paths (slice string)] [o (ptr watch-options)] [tag (ptr void)] [id (ptr u32)] [err (ptr error)])
+  -> bool
+  (let ([defaults watch-options] [p o] [watched (make-buffer)] [ignored (make-buffer)] [why string] [n u32 0])
     (when (== p 0)
       (watch-options-init! (& defaults))
       (set! p (& defaults)))
     (buffer-add-entries! (& watched) paths)
     (buffer-add-entries! (& ignored) (-> p ignore))
-    (set! id (cast u32 (start (cast i32 (-> watched bytes)) (cast i32 (-> watched length)) (-> p recursive)
-                              (cast i32 (-> ignored bytes)) (cast i32 (-> ignored length)) (cast i32 tag) (cast i32 err))))
+    (set! n (cast u32 (start (cast i32 (-> watched bytes)) (cast i32 (-> watched length)) (-> p recursive)
+                             (cast i32 (-> ignored bytes)) (cast i32 (-> ignored length)) (cast i32 tag)
+                             (cast i32 (& why)))))
     (buffer-free! (& watched))
     (buffer-free! (& ignored))
-    id))
+    (unless (== id 0) (set! (@ id) n))
+    (or (!= n 0) (host-failed! (& why) err))))
 
 (define (watch-stop [w u32]) (stop (cast i32 w)))

package/substrate/host/stream.sub

@@ -1,6 +1,8 @@
 ;; Byte streams: the host module "stream", whose ids other modules give out. A read event's value is how many bytes
 ;; were read, or 0 at the end. A read that stream-take! posts holds no room: its event carries the bytes, at most
 ;; most of them, for events-take. A finished event comes once everything written before stream-finish has been sent.
+;; stream-write returns 0 when the stream can take more, and 1 when it is full. It takes the bytes in both cases. After
+;; a 1, wait for a drained event before writing again. It returns -1 when the stream is not open.
 (require-unqualified "events.sub")
 
 (provide stream-source stream-read stream-drained stream-failed stream-finished

package/substrate/host/subhost-core.mjs

@@ -1,6 +1,7 @@
 // The JavaScript host, shared by Node (subhost.mjs) and the browser (web/subhost-web.mjs).
 import { createStreams, STREAM } from './streams.mjs';
 import { joined } from './entries.mjs';
+import { errors } from './errors.mjs';
 
 const utf8 = new TextEncoder();
 const text = new TextDecoder();
@@ -174,6 +175,7 @@ export function createHost(platform) {
   // A memory's malloc, from the module that exports both.
   const allocators = new WeakMap();
   let lastError = '';
+  let failureCode = errors.other;
   // The running program: its module names in load order, a function that returns a module's bytes, and the files of
   // the compiled modules its build wrote, keyed by file name (null if it wrote none).
   let programNames = [];
@@ -330,7 +332,8 @@ export function createHost(platform) {
       trap: hostTrap,
       write: (fd, bytes) => platform.write(fd === 2 ? 2 : 1, bytes),
       give,
-      fail(err, message) {
+      fail(err, message, code = errors.other) {
+        failureCode = code;
         if (!err) return;
         const p = give(utf8.encode(message), u(err) + 4);
         new DataView(memory().buffer).setUint32(u(err), p, true);
@@ -377,6 +380,11 @@ export function createHost(platform) {
         platform.write(fd === 2 ? 2 : 1, memory().subarray(u(ptr), u(ptr) + len));
         return len;
       },
+      failure_code() {
+        const code = failureCode;
+        failureCode = errors.other;
+        return code;
+      },
       trap(ptr, len) {
         hostTrap(string(ptr, len));
       },

package/substrate/host/web/audio.mjs

@@ -14,7 +14,13 @@ export function audio() {
   let started = 0;
 
   const sounds = new Map();
-  let loading = 0;
+  let nextSound = 1;
+  const loading = new Map();
+  const counted = (tag, n) => {
+    const k = (loading.get(tag) || 0) + n;
+    if (k === 0) loading.delete(tag);
+    else loading.set(tag, k);
+  };
   let decoder = null;
 
   const voices = new Map();
@@ -60,11 +66,12 @@ export function audio() {
 
   const module = (caller, app) => ({
     source: SOURCE,
-    load(id, ptr, length) {
+    load(ptr, length, tag) {
+      const id = nextSound++;
       const name = caller.string(ptr, length);
       const bytes = app.files.get(resolvePath(app.cwd, name));
       if (!decoder) decoder = new OfflineAudioContext(1, 1, 44100);
-      loading++;
+      counted(tag, 1);
       const data = bytes
         ? Promise.resolve(bytes.slice().buffer)
         : fetch(name).then((response) => {
@@ -74,21 +81,22 @@ export function audio() {
       data.then((buffer) => decoder.decodeAudioData(buffer)).then(
         (decoded) => {
           sounds.set(id, decoded);
-          loading--;
+          counted(tag, -1);
           startWaiting();
-          caller.event(LOADED, id, 0, 0);
+          caller.event(LOADED, id, tag, 0);
         },
         (e) => {
           console.error(`audio: cannot load the sound ${name}: ${e.message}`);
-          loading--;
+          counted(tag, -1);
           startWaiting();
-          caller.event(FAILED, id, 0, e.name === 'EncodingError' ? errors.invalid : errors.missing,
+          caller.event(FAILED, id, tag, e.name === 'EncodingError' ? errors.invalid : errors.missing,
             utf8.encode(`cannot load the sound ${name}: ${e.message}`));
         },
       );
+      return id;
     },
-    loading() {
-      return loading;
+    loading(tag) {
+      return loading.get(tag) || 0;
     },
     play(id, volume, rate, loop) {
       played++;

package/substrate/host/web/audio.sub

@@ -1,4 +1,5 @@
-;; Sound: the host module "audio".
+;; Sound: the host module "audio". audio-load gives the sound's number, and its loaded or failed event goes to tag.
+;; audio-loading counts the sounds loading for a tag.
 (provide audio-source audio-loaded audio-failed audio-tone audio-load audio-loading audio-play audio-stop)
 
 (const audio-source u32 4)
@@ -6,7 +7,12 @@
 (const audio-failed u32 2)
 
 (import audio-tone "audio" "tone" (i32 f64 f64 f64 f64 ->))
-(import audio-load "audio" "load" (i32 i32 i32 ->))
-(import audio-loading "audio" "loading" (-> i32))
+(import load "audio" "load" (i32 i32 i32 -> i32))
+(import loading "audio" "loading" (i32 -> i32))
 (import audio-play "audio" "play" (i32 f64 f64 i32 -> i32))
 (import audio-stop "audio" "stop" (i32 ->))
+
+(define (audio-load [path string] [tag (ptr void)]) -> u32
+  (cast u32 (load (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 tag))))
+
+(define (audio-loading [tag (ptr void)]) -> u32 (cast u32 (loading (cast i32 tag))))

package/substrate/host/web/clipboard.mjs

@@ -1,5 +1,5 @@
 // The host module "clipboard" (clipboard.sub).
-import { errorOf, reasonOf } from '../errors.mjs';
+import { errors, errorOf, reasonOf } from '../errors.mjs';
 
 const utf8 = new TextEncoder();
 
@@ -14,7 +14,7 @@ export function clipboard() {
     let ended = false;
     const attempt = (tag, err, ask, answer) => {
       if (!navigator.clipboard) {
-        caller.fail(err, 'clipboard: none');
+        caller.fail(err, 'clipboard: none', errors.other);
         return 0;
       }
       const id = next++;

package/substrate/host/web/clipboard.sub

@@ -9,7 +9,14 @@
 (const clipboard-written u32 2)
 (const clipboard-failed u32 3)
 
-(define (clipboard-read [tag (ptr void)] [err (ptr string)]) -> u32 (cast u32 (read (cast i32 tag) (cast i32 err))))
+(define (clipboard-read [tag (ptr void)] [id (ptr u32)] [err (ptr error)]) -> bool
+  (let ([why string] [n u32 0])
+    (set! n (cast u32 (read (cast i32 tag) (cast i32 (& why)))))
+    (unless (== id 0) (set! (@ id) n))
+    (or (!= n 0) (host-failed! (& why) err))))
 
-(define (clipboard-write [text string] [tag (ptr void)] [err (ptr string)]) -> u32
-  (cast u32 (write (cast i32 (-> text bytes)) (cast i32 (-> text length)) (cast i32 tag) (cast i32 err))))
+(define (clipboard-write [text string] [tag (ptr void)] [id (ptr u32)] [err (ptr error)]) -> bool
+  (let ([why string] [n u32 0])
+    (set! n (cast u32 (write (cast i32 (-> text bytes)) (cast i32 (-> text length)) (cast i32 tag) (cast i32 (& why)))))
+    (unless (== id 0) (set! (@ id) n))
+    (or (!= n 0) (host-failed! (& why) err))))