From 20a142839f0757b5942b4d280bb1605996044f6d Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Tue, 25 Mar 2008 18:44:49 +0000
Subject: [PATCH] Added the beginnings of list support for CCSP (using glib)

---
 backends/GenerateC.hs      | 35 ++++++++++++++++++++-----
 support/tock_support_cif.h | 53 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 82 insertions(+), 6 deletions(-)

diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs
index c12cb43..230a5b0 100644
--- a/backends/GenerateC.hs
+++ b/backends/GenerateC.hs
@@ -348,8 +348,7 @@ cgenType (A.Chan _ _ t) = tell ["Channel*"]
 -- Any -- not used
 --cgenType (A.Port t) =
 
---TODO have a pass that declares these list types:
-cgenType t@(A.List {}) = tell [subRegex (mkRegex "[^A-Za-z0-9]") (show t) ""]
+cgenType (A.List {}) = tell ["GQueue*"]
 
 cgenType t
  = do f <- fget getScalarType
@@ -532,14 +531,33 @@ genLitSuffix A.UInt64 = tell ["ULL"]
 genLitSuffix A.Real32 = tell ["F"]
 genLitSuffix _ = return ()
 
+-- TODO don't allocate for things less than 64-bits in size
 cgenListLiteral :: [A.Expression] -> A.Type -> CGen ()
-cgenListLiteral _ _ = call genMissing "C backend does not yet support lists"
+cgenListLiteral es t
+  = foldl addItem (tell ["g_queue_new()"]) es
+  where
+    addItem :: CGen () -> A.Expression -> CGen ()
+    addItem prev add
+      = do tell ["g_queue_push_head("]
+           prev
+           tell [","]
+           call genExpression add
+           tell [")"]
 
 cgenListSize :: A.Variable -> CGen ()
-cgenListSize _ = call genMissing "C backend does not yet support lists"
+cgenListSize v = do tell ["g_queue_get_length("]
+                    call genVariable v
+                    tell [")"]
 
 cgenListAssign :: A.Variable -> A.Expression -> CGen ()
-cgenListAssign _ _ = call genMissing "C backend does not yet support lists"
+cgenListAssign v e
+  = do tell ["tock_free_queue("]
+       call genVariable v
+       tell [");"]
+       call genVariable v
+       tell ["="]
+       call genExpression e
+       tell [";"]
 
 cgenLiteralRepr :: A.LiteralRepr -> A.Type -> CGen ()
 cgenLiteralRepr (A.RealLiteral m s) t = tell [s] >> genLitSuffix t
@@ -979,7 +997,12 @@ cgenDyadic _ A.Concat e f = call genListConcat e f
 --}}}
 
 cgenListConcat :: A.Expression -> A.Expression -> CGen ()
-cgenListConcat _ _ = call genMissing "C backend does not yet support lists"
+cgenListConcat a b
+  = do tell ["tock_queue_concat("]
+       call genExpression a
+       tell [","]
+       call genExpression b
+       tell [")"]
 
 --{{{  input/output items
 cgenInputItem :: A.Variable -> A.InputItem -> CGen ()
diff --git a/support/tock_support_cif.h b/support/tock_support_cif.h
index 363b00d..8d16b69 100644
--- a/support/tock_support_cif.h
+++ b/support/tock_support_cif.h
@@ -20,8 +20,10 @@
 #define TOCK_SUPPORT_CIF_H
 
 #include <cif.h>
+#include <glib.h>
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 #include <sys/ioctl.h>
 #include <termios.h>
 #include <unistd.h>
@@ -141,4 +143,55 @@ static void tock_init_ccsp (bool uses_stdin) {
 }
 //}}}
 
+//{{{ Helpers for lists
+
+//Just like g_queue_push_tail, but returns the queue pointer:
+static inline GQueue* tock_push_tail(GQueue*, gpointer) occam_unused;
+static inline GQueue* tock_push_tail(GQueue* queue, gpointer data)
+{
+	g_queue_push_tail(queue,data);
+	return queue;
+}
+
+static void tock_free_helper(gpointer, gpointer) occam_unused;
+static void tock_free_helper(gpointer data, gpointer _unused)
+{
+	free(data);
+}
+
+//This should go away once we start using mobiles properly:
+static gpointer tock_new_helper(gpointer, guint) occam_unused;
+static gpointer tock_new_helper(gpointer src, guint sz)
+{
+	gpointer ret = malloc(sz);
+	memcpy(ret,src,sz);
+	return ret;
+}
+
+//Deletes everything in the queue and frees it:
+static inline void tock_free_queue(GQueue*) occam_unused;
+static inline void tock_free_queue(GQueue* queue)
+{
+	g_queue_foreach(queue, tock_free_helper, NULL);
+	g_queue_free(queue);
+}
+
+//Moves both queues into a concatenated new queue.
+//Don't rely on either of the passed arguments being
+//valid afterwards
+static inline GQueue* tock_queue_concat(GQueue*,GQueue*) occam_unused;
+static inline GQueue* tock_queue_concat(GQueue* a, GQueue* b)
+{
+	a->length += b->length;
+	a->head = g_list_concat(a->head, b-> head);
+	a->tail = b->tail;
+	b->head = NULL;
+	b->tail = NULL;
+	b->length = 0;
+	g_queue_free(b);
+	return a;
+}
+
+//}}}
+
 #endif