525 - 'fork' now returns a routine id

2 files changed, 35 insertions, 3 deletions

diff --git a/mu.arc b/mu.arc
index 4b269552..7212f5bd 100644
--- a/mu.arc
+++ b/mu.arc
@@ -112,15 +112,15 @@
 ; things that a future assembler will need separate memory for:
 ;   code; types; args channel
 ;   at compile time: mapping names to locations
-(def clear ()
+(on-init
   (= type* (table))  ; name -> type info
   (= memory* (table))  ; address -> value
   (= function* (table))  ; name -> [instructions]
   (= location* (table))  ; function -> {name -> index into default-space}
   (= next-space-generator* (table))  ; function -> name of function generating next space
   ; each function's next space will usually always come from a single function
+  (= next-routine-id* 0)
   )
-(enq clear initialization-fns*)
 
 (on-init
   (= type* (obj
@@ -575,9 +575,11 @@
                 fork
                   ; args: fn globals-table args ...
                   (let routine  (apply make-routine (m arg.0) (map m (nthcdr 3 arg)))
+                    (= rep.routine!id ++.next-routine-id*)
                     (= rep.routine!globals (when (len> arg 1) (m arg.1)))
                     (= rep.routine!limit (when (len> arg 2) (m arg.2)))
-                    (enq routine running-routines*))
+                    (enq routine running-routines*)
+                    rep.routine!id)
                 assert
                   (unless (m arg.0)
                     (die (v arg.1)))
diff --git a/mu.arc.t b/mu.arc.t
index ab015c42..b9ce4dbe 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -2788,6 +2788,36 @@
   (prn "F - fork works"))
 
 (reset)
+(new-trace "fork-returns-id")
+(add-code
+  '((function f1 [
+      (1:integer <- copy 4:literal)
+     ])
+    (function main [
+      (2:integer <- fork f1:fn)
+     ])))
+(run 'main)
+;? (prn memory*)
+(if (no memory*.2)
+  (prn "F - fork returns a pid for the new routine"))
+
+(reset)
+(new-trace "fork-returns-unique-id")
+(add-code
+  '((function f1 [
+      (1:integer <- copy 4:literal)
+     ])
+    (function main [
+      (2:integer <- fork f1:fn)
+      (3:integer <- fork f1:fn)
+     ])))
+(run 'main)
+(if (or (no memory*.2)
+        (no memory*.3)
+        (is memory*.2 memory*.3))
+  (prn "F - fork returns a unique pid everytime"))
+
+(reset)
 (new-trace "fork-with-args")
 (add-code
   '((function f1 [