342 - strcat

2 files changed, 79 insertions, 2 deletions

diff --git a/mu.arc b/mu.arc
index 32f7d8e4..2884ffdd 100644
--- a/mu.arc
+++ b/mu.arc
@@ -9,7 +9,9 @@
         initialization-fns*))
 
 (mac init-fn (name . body)
-  `(enq (fn () (= (function* ',name) (convert-names:convert-braces:insert-code ',body ',name)))
+  `(enq (fn ()
+;?           (prn ',name)
+          (= (function* ',name) (convert-names:convert-braces:insert-code ',body ',name)))
         initialization-fns*))
 
 ;; persisting and checking traces for each test
@@ -97,6 +99,7 @@
               boolean (obj size 1)
               boolean-address (obj size 1  address t  elem 'boolean)
               byte (obj size 1)
+              byte-address (obj  size 1  address t  elem 'byte)
               string (obj array t  elem 'byte)  ; inspired by Go
               string-address (obj size 1  address t  elem 'string)
               character (obj size 1)  ; int32 like a Go rune
@@ -823,6 +826,7 @@
               (assert (~isa-field v.arg) "oarg @arg is also a field name")
               (when (maybe-add arg location idx)
                 (trace "cn0" "location for arg " arg ": " idx)
+                ; todo: can't allocate arrays on the stack
                 (++ idx (sizeof ty.arg)))))))))
     (trace "cn1" "update names " canon.location " " canon.isa-field)
     (each instr instrs
@@ -1070,6 +1074,51 @@
   ((result boolean) <- eq (full integer) (curr integer))
   (reply (result boolean)))
 
+(init-fn strcat
+  ((default-scope scope-address) <- new (scope literal) (30 literal))
+  ; result = new string[a.length + b.length]
+  ((a string-address) <- arg)
+  ((a-len integer) <- len (a string-address deref))
+  ((b string-address) <- arg)
+  ((b-len integer) <- len (b string-address deref))
+  ((result-len integer) <- add (a-len integer) (b-len integer))
+  ((result string-address) <- new (string literal) (result-len integer))
+  ; result-idx = i = 0
+  ((result-idx integer) <- copy (0 literal))
+  ; copy a into result
+  ((i integer) <- copy (0 literal))
+  { begin
+    ; while (i < a.length)
+    ((a-done? boolean) <- lt (i integer) (a-len integer))
+    (break-unless (a-done? boolean))
+    ; result[result-idx] = a[i]
+    ((out byte-address) <- index-address (result string-address deref) (result-idx integer))
+    ((in byte) <- index (a string-address deref) (i integer))
+    ((out byte-address deref) <- copy (in byte))
+    ; ++i
+    ((i integer) <- add (i integer) (1 literal))
+    ; ++result-idx
+    ((result-idx integer) <- add (result-idx integer) (1 literal))
+    (loop)
+  }
+  ; copy b into result
+  ((i integer) <- copy (0 literal))
+  { begin
+    ; while (i < b.length)
+    ((b-done? boolean) <- lt (i integer) (b-len integer))
+    (break-unless (b-done? boolean))
+    ; result[result-idx] = a[i]
+    ((out byte-address) <- index-address (result string-address deref) (result-idx integer))
+    ((in byte) <- index (b string-address deref) (i integer))
+    ((out byte-address deref) <- copy (in byte))
+    ; ++i
+    ((i integer) <- add (i integer) (1 literal))
+    ; ++result-idx
+    ((result-idx integer) <- add (result-idx integer) (1 literal))
+    (loop)
+  }
+  (reply (result string-address)))
+
 (def canon (table)
   (sort (compare < [tostring (prn:car _)]) (as cons table)))
 
diff --git a/mu.arc.t b/mu.arc.t
index 609498fe..485c2634 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -2946,6 +2946,34 @@
           (~is #\l (memory* (+ before 3)))
           (~is #\l (memory* (+ before 4)))
           (~is #\o (memory* (+ before 5))))
-    (prn "F - 'new' initializes allocated memory to string literal")))
+    (prn "F - 'new' initializes allocated memory to string literal"))
+
+; helper
+(def memory-contains (addr value)
+  (and (is memory*.addr len.value)
+       (loop (addr (+ addr 1)
+              idx  0)
+         (if (> addr len.value)
+               t
+             (~is memory*.addr value.idx)
+               (do1 nil
+                    (prn "@addr should contain @value.idx but contains @memory*.addr"))
+             :else
+               (recur (+ addr 1) (+ idx 1))))))
+
+  ; test the helper
+  (if (~memory-contains before "hello")
+    (prn "F - 'memory-contains' helper is broken")))
+
+(reset)
+(new-trace "strcat")
+(add-code '((def main [
+              ((1 string-address) <- new "hello,")
+              ((2 string-address) <- new " world!")
+              ((3 string-address) <- strcat (1 string-address) (2 string-address))
+             ])))
+(run 'main)
+(if (~memory-contains memory*.3 "hello, world!")
+  (prn "F - 'strcat' concatenates strings"))
 
 (reset)  ; end file with this to persist the trace for the final test