about summary refs log tree commit diff stats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--mu.arc18
-rw-r--r--mu.arc.t41
2 files changed, 53 insertions, 6 deletions
diff --git a/mu.arc b/mu.arc
index b728c51a..afcd1620 100644
--- a/mu.arc
+++ b/mu.arc
@@ -128,13 +128,15 @@
 
 (def run (fn-name)
 ;?   (prn "AAA")
+  (point return
   (let context (list (obj fn-name fn-name  pc 0  caller-arg-idx 0))
 ;?     (prn "BBB")
     (for ninstrs 0 (< ninstrs scheduling-interval*) (++ ninstrs)
 ;?       (prn "CCC " pc.context " " context " " (len body.context))
-      (if (>= pc.context (len body.context))
-        (pop context))
-      (if (no context) (break))
+      (while (>= pc.context (len body.context))
+        (pop context)
+        (if no.context (return ninstrs))
+        (++ pc.context))
 ;?       (prn "--- " context.0!fn-name " " pc.context ": " (body.context pc.context))
 ;?       (prn "  " memory*)
       (let (oarg op arg)  (parse-instr (body.context pc.context))
@@ -215,11 +217,15 @@
                   (array-ref arg.0 (v arg.1))
                 reply
                   (do (pop context)
-                      (if no.context (break))
+                      (if no.context (return ninstrs))
                       (let (caller-oargs _ _)  (parse-instr (body.context pc.context))
                         (each (dest src)  (zip caller-oargs arg)
                           (setm dest  (m src))))
                       (++ pc.context)
+                      (while (>= pc.context (len body.context))
+                        (pop context)
+                        (if no.context (return ninstrs))
+                        (++ pc.context))
                       (continue))
                 new
                   (let type (v arg.0)
@@ -239,8 +245,8 @@
 ;?                   (prn oarg.0)
                   (setm oarg.0 tmp)))
               )
-        (++ pc.context))))
-  nil)
+        (++ pc.context)))
+    (return scheduling-interval*))))
 
 (enq (fn () (= Memory-in-use-until 1000))
      initialization-fns*)
diff --git a/mu.arc.t b/mu.arc.t
index 0b89873f..7974bf4d 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -31,6 +31,17 @@
 ;? (prn memory*)
 (if (~iso memory* (obj 1 1  2 3  3 4))
   (prn "F - calling a user-defined function runs its instructions"))
+;? (quit)
+
+(reset)
+(add-fns
+  '((test1
+      ((1 integer) <- literal 1))
+    (main
+      (test1))))
+(if (~iso 2 (run 'main))
+  (prn "F - calling a user-defined function runs its instructions exactly once"))
+;? (quit)
 
 (reset)
 (add-fns
@@ -50,6 +61,35 @@
 
 (reset)
 (add-fns
+  `((test1
+      ((3 integer) <- test2))
+    (test2
+      (reply (2 integer)))
+    (main
+      ((2 integer) <- literal 34)
+      (test1))))
+(run 'main)
+;? (prn memory*)
+(if (~iso memory* (obj 2 34  3 34))
+  (prn "F - 'reply' stops executing any callers as necessary"))
+;? (quit)
+
+(reset)
+(add-fns
+  '((test1
+      ((3 integer) <- add (1 integer) (2 integer))
+      (reply)
+      ((4 integer) <- literal 34))
+    (main
+      ((1 integer) <- literal 1)
+      ((2 integer) <- literal 3)
+      (test1))))
+(if (~iso 4 (run 'main))  ; last reply sometimes not counted. worth fixing?
+  (prn "F - 'reply' executes instructions exactly once"))
+;? (quit)
+
+(reset)
+(add-fns
   '((test1
       ((4 integer) <- arg)
       ((5 integer) <- arg)
@@ -254,6 +294,7 @@
 ;? (prn memory*)
 (if (~iso memory* (obj 1 8))
   (prn "F - 'jmp' doesn't skip too many instructions"))
+;? (quit)
 
 (reset)
 (add-fns
generated by cgit-pink 1.4.1-2-gfad0 (git 2.36.2.497.gbbea4dcf42) at 2024-12-04 17:44:57 +0000
*/ .highlight .kt { color: #888888; font-weight: bold } /* Keyword.Type */ .highlight .m { color: #0000DD; font-weight: bold } /* Literal.Number */ .highlight .s { color: #dd2200; background-color: #fff0f0 } /* Literal.String */ .highlight .na { color: #336699 } /* Name.Attribute */ .highlight .nb { color: #003388 } /* Name.Builtin */ .highlight .nc { color: #bb0066; font-weight: bold } /* Name.Class */ .highlight .no { color: #003366; font-weight: bold } /* Name.Constant */ .highlight .nd { color: #555555 } /* Name.Decorator */ .highlight .ne { color: #bb0066; font-weight: bold } /* Name.Exception */ .highlight .nf { color: #0066bb; font-weight: bold } /* Name.Function */ .highlight .nl { color: #336699; font-style: italic } /* Name.Label */ .highlight .nn { color: #bb0066; font-weight: bold } /* Name.Namespace */ .highlight .py { color: #336699; font-weight: bold } /* Name.Property */ .highlight .nt { color: #bb0066; font-weight: bold } /* Name.Tag */ .highlight .nv { color: #336699 } /* Name.Variable */ .highlight .ow { color: #008800 } /* Operator.Word */ .highlight .w { color: #bbbbbb } /* Text.Whitespace */ .highlight .mb { color: #0000DD; font-weight: bold } /* Literal.Number.Bin */ .highlight .mf { color: #0000DD; font-weight: bold } /* Literal.Number.Float */ .highlight .mh { color: #0000DD; font-weight: bold } /* Literal.Number.Hex */ .highlight .mi { color: #0000DD; font-weight: bold } /* Literal.Number.Integer */ .highlight .mo { color: #0000DD; font-weight: bold } /* Literal.Number.Oct */ .highlight .sa { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Affix */ .highlight .sb { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Backtick */ .highlight .sc { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Char */ .highlight .dl { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Delimiter */ .highlight .sd { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Doc */ .highlight .s2 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Double */ .highlight .se { color: #0044dd; background-color: #fff0f0 } /* Literal.String.Escape */ .highlight .sh { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Heredoc */ .highlight .si { color: #3333bb; background-color: #fff0f0 } /* Literal.String.Interpol */ .highlight .sx { color: #22bb22; background-color: #f0fff0 } /* Literal.String.Other */ .highlight .sr { color: #008800; background-color: #fff0ff } /* Literal.String.Regex */ .highlight .s1 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Single */ .highlight .ss { color: #aa6600; background-color: #fff0f0 } /* Literal.String.Symbol */ .highlight .bp { color: #003388 } /* Name.Builtin.Pseudo */ .highlight .fm { color: #0066bb; font-weight: bold } /* Name.Function.Magic */ .highlight .vc { color: #336699 } /* Name.Variable.Class */ .highlight .vg { color: #dd7700 } /* Name.Variable.Global */ .highlight .vi { color: #3333bb } /* Name.Variable.Instance */ .highlight .vm { color: #336699 } /* Name.Variable.Magic */ .highlight .il { color: #0000DD; font-weight: bold } /* Literal.Number.Integer.Long */
# Wrappers around file system primitives that take a 'resources' object and
# are thus easier to test.
#
# - start-reading - asynchronously open a file, returning a channel source for
#   receiving the results
# - start-writing - asynchronously open a file, returning a channel sink for
#   the data to write
# - slurp - synchronously read from a file
# - dump - synchronously write to a file

container resources [
  lock:bool
  data:&:@:resource
]

container resource [
  name:text
  contents:text
]

def start-reading resources:&:resources, filename:text -> contents:&:source:char, error?:bool [
  local-scope
  load-ingredients
  error? <- copy 0/false
  {
    break-unless resources
    # fake file system
    contents, error? <- start-reading-from-fake-resource resources, filename
    return
  }
  # real file system
  file:num <- $open-file-for-reading filename
  return-unless file, 0/contents, 1/error?
  contents:&:source:char, sink:&:sink:char <- new-channel 30
  start-running receive-from-file file, sink
]

def slurp resources:&:resources, filename:text -> contents:text, error?:bool [
  local-scope
  load-ingredients
  source:&:source:char, error?:bool <- start-reading resources, filename
  return-if error?, 0/contents
  buf:&:buffer:char <- new-buffer 30/capacity
  {
    c:char, done?:bool, source <- read source
    break-if done?
    buf <- append buf, c
    loop
  }
  contents <- buffer-to-array buf
]

def start-reading-from-fake-resource resources:&:resources, resource:text -> contents:&:source:char, error?:bool [
  local-scope
  load-ingredients
  error? <- copy 0/no-error
  i:num <- copy 0
  data:&:@:resource <- get *resources, data:offset
  len:num <- length *data
  {
    done?:bool <- greater-or-equal i, len
    break-if done?
    tmp:resource <- index *data, i
    i <- add i, 1
    curr-resource:text <- get tmp, name:offset
    found?:bool <- equal resource, curr-resource
    loop-unless found?
    contents:&:source:char, sink:&:sink:char <- new-channel 30
    curr-contents:text <- get tmp, contents:offset
    start-running receive-from-text curr-contents, sink
    return
  }
  return 0/not-found, 1/error
]

def receive-from-file file:num, sink:&:sink:char -> sink:&:sink:char [
  local-scope
  load-ingredients
  {
    c:char, eof?:bool <- $read-from-file file
    break-if eof?
    sink <- write sink, c
    loop
  }
  sink <- close sink
  file <- $close-file file
]

def receive-from-text contents:text, sink:&:sink:char -> sink:&:sink:char [
  local-scope
  load-ingredients
  i:num <- copy 0
  len:num <- length *contents
  {
    done?:bool <- greater-or-equal i, len
    break-if done?
    c:char <- index *contents, i
    sink <- write sink, c
    i <- add i, 1
    loop
  }
  sink <- close sink
]

def start-writing resources:&:resources, filename:text -> sink:&:sink:char, routine-id:num, error?:bool [
  local-scope
  load-ingredients
  error? <- copy 0/false
  source:&:source:char, sink:&:sink:char <- new-channel 30
  {
    break-unless resources
    # fake file system
    routine-id <- start-running transmit-to-fake-resource resources, filename, source
    return
  }
  # real file system
  file:num <- $open-file-for-writing filename
  return-unless file, 0/sink, 0/routine-id, 1/error?
  {
    break-if file
    msg:text <- append [no such file: ] filename
    assert file, msg
  }
  routine-id <- start-running transmit-to-file file, source
]

def dump resources:&:resources, filename:text, contents:text -> resources:&:resources, error?:bool [
  local-scope
  load-ingredients
  # todo: really create an empty file
  return-unless contents, resources, 0/no-error
  sink-file:&:sink:char, write-routine:num, error?:bool <- start-writing resources, filename
  return-if error?
  i:num <- copy 0
  len:num <- length *contents
  {
    done?:bool <- greater-or-equal i, len
    break-if done?
    c:char <- index *contents, i
    sink-file <- write sink-file, c
    i <- add i, 1
    loop
  }
  close sink-file
  # make sure to wait for the file to be actually written to disk
  # (Mu practices structured concurrency: http://250bpm.com/blog:71)
  wait-for-routine write-routine
]

def transmit-to-file file:num, source:&:source:char -> source:&:source:char [
  local-scope
  load-ingredients
  {
    c:char, done?:bool, source <- read source
    break-if done?
    $write-to-file file, c
    loop
  }
  file <- $close-file file
]

def transmit-to-fake-resource resources:&:resources, filename:text, source:&:source:char -> resources:&:resources, source:&:source:char [
  local-scope
  load-ingredients
  lock:location <- get-location *resources, lock:offset
  wait-for-reset-then-set lock
  # compute new file contents
  buf:&:buffer:char <- new-buffer 30
  {
    c:char, done?:bool, source <- read source
    break-if done?
    buf <- append buf, c
    loop
  }
  contents:text <- buffer-to-array buf
  new-resource:resource <- merge filename, contents
  # write to resources
  curr-filename:text <- copy 0
  data:&:@:resource <- get *resources, data:offset
  # replace file contents if it already exists
  i:num <- copy 0
  len:num <- length *data
  {
    done?:bool <- greater-or-equal i, len
    break-if done?
    tmp:resource <- index *data, i
    curr-filename <- get tmp, name:offset
    found?:bool <- equal filename, curr-filename
    {
      break-unless found?
      put-index *data, i, new-resource
      jump +unlock-and-exit
    }
    i <- add i, 1
    loop
  }
  # if file didn't already exist, make room for it
  new-len:num <- add len, 1
  new-data:&:@:resource <- new resource:type, new-len
  put *resources, data:offset, new-data
  # copy over old files
  i:num <- copy 0
  {
    done?:bool <- greater-or-equal i, len
    break-if done?
    tmp:resource <- index *data, i
    put-index *new-data, i, tmp
  }
  # write new file
  put-index *new-data, len, new-resource
  +unlock-and-exit
  reset lock
]