Commit c87b47e5db2f4f00d94c77e9e3b6b67a180a889d

Thomas de Grivel 2023-06-16T17:38:09

work in progress: buf_parse

diff --git a/Makefile b/Makefile
index 59d0b39..dab64e5 100644
--- a/Makefile
+++ b/Makefile
@@ -119,6 +119,12 @@ licence:
 	update_header Makefile ${C3_MAKEFILES}
 	update_header libc3/c3.h ${C3_C_SOURCES}
 
+lldb_ic3: debug
+	${MAKE} -C ic3 lldb_ic3
+
+lldb_test: debug
+	${MAKE} -C test lldb_test
+
 test: build
 	${MAKE} -C test test
 
diff --git a/c3s/configure b/c3s/configure
index 0aa1f9e..cf8ceb1 100755
--- a/c3s/configure
+++ b/c3s/configure
@@ -42,8 +42,10 @@ echo "OBJECTS_DEBUG = $OBJECTS_DEBUG" >> ${CONFIG_MK}
 CPPFLAGS="${CPPFLAGS:=}"
 ENV_CFLAGS="${CFLAGS:=}"
 DEFAULT_CFLAGS="-O2 -pipe -fPIC"
-LDFLAGS="-Wl,--allow-shlib-undefined ${LDFLAGS:=}"
-#LDFLAGS="${LDFLAGS:=}"
+LDFLAGS="${LDFLAGS}"
+if [ "x$CC" != "xtcc" ]; then
+    LDFLAGS="-Wl,--allow-shlib-undefined ${LDFLAGS}"
+fi
 LIBS="${LIBS:=-lm}"
 
 # Common config for all targets
diff --git a/ic3/configure b/ic3/configure
index d224494..c6e0ef4 100755
--- a/ic3/configure
+++ b/ic3/configure
@@ -42,8 +42,10 @@ echo "OBJECTS_DEBUG = $OBJECTS_DEBUG" >> ${CONFIG_MK}
 CPPFLAGS="${CPPFLAGS:=}"
 ENV_CFLAGS="${CFLAGS:=}"
 DEFAULT_CFLAGS="-O2 -pipe -fPIC"
-LDFLAGS="-Wl,--allow-shlib-undefined ${LDFLAGS:-}"
-#LDFLAGS="${LDFLAGS:-}"
+LDFLAGS="${LDFLAGS}"
+if [ "x$CC" != "xtcc" ]; then
+    LDFLAGS="-Wl,--allow-shlib-undefined ${LDFLAGS}"
+fi
 LIBS="${LIBS:=-lm}"
 
 # Common config for all targets
diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index 2f33332..bdb318b 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -321,15 +321,16 @@ sw buf_parse_array_type (s_buf *buf, e_tag_type *dest)
   if (! ident_to_tag_type(&type_ident, &tmp))
     goto restore;
   if ((r = buf_ignore_spaces(buf)) < 0)
-    goto clean;
+    goto restore;
   result += r;
   if ((r = buf_read_1(buf, ")")) <= 0)
-    goto clean;
+    goto restore;
   result += r;
-  *dest = tmp;
   r = result;
+  *dest = tmp;
   goto clean;
  restore:
+  r = 0;
   buf_save_restore_rpos(buf, &save);
  clean:
   buf_save_clean(buf, &save);
@@ -349,20 +350,22 @@ sw buf_parse_array (s_buf *buf, s_array *dest)
   s_buf_save save_data;
   s_tag tag;
   s_array tmp;
-  e_tag_type type;
+  e_tag_type tag_type;
   assert(buf);
   assert(dest);
   buf_save_init(buf, &save);
-  if ((r = buf_parse_array_type(buf, &type)) < 0)
+  if ((r = buf_parse_array_type(buf, &tag_type)) <= 0)
     goto clean;
   result += r;
   if ((r = buf_ignore_spaces(buf)) < 0)
     goto restore;
   result += r;
-  item_size = tag_type_size(type);
-  item = tag_to_pointer(&tag, type);
+  item_size = tag_type_size(tag_type);
+  tag_init(&tag);
+  tag.type = tag_type;
+  tmp.type = tag_type;
+  item = tag_to_pointer(&tag, tag_type);
   tmp.dimension = 0;
-  buf_save_init(buf, &save_data);
   while ((r = buf_read_1(buf, "[")) > 0) {
     result += r;
     tmp.dimension++;
@@ -372,8 +375,7 @@ sw buf_parse_array (s_buf *buf, s_array *dest)
   }
   if (r < 0)
     goto restore;
-  if (! (i = tmp.dimension))
-    goto restore;
+  i = tmp.dimension;
   tmp.dimension++;
   if (! (address = calloc(tmp.dimension, sizeof(uw))))
     err(1, "buf_parse_array: address");
@@ -426,7 +428,7 @@ sw buf_parse_array (s_buf *buf, s_array *dest)
     err(1, "buf_parse_array: tmp.data");
     return -1;
   }
-  buf_save_restore_rpos(buf, &save_data);
+  buf_save_restore_rpos(buf, &save);
   i = 0;
   while ((r = buf_read_1(buf, "[")) > 0) {
     result += r;
@@ -487,8 +489,8 @@ sw buf_parse_array (s_buf *buf, s_array *dest)
     if (r < 0)
       goto restore;
   }
-
  restore:
+  r = 0;
   buf_save_restore_rpos(buf, &save);
  clean:
   buf_save_clean(buf, &save);
@@ -1140,9 +1142,12 @@ sw buf_parse_fact (s_buf *buf, s_fact_w *dest)
   goto clean;
  restore:
   buf_save_restore_rpos(buf, &save);
-  tag_delete(subject);
-  tag_delete(predicate);
-  tag_delete(object);
+  if (subject)
+    tag_delete(subject);
+  if (predicate)
+    tag_delete(predicate);
+  if (object)
+    tag_delete(object);
  clean:
   buf_save_clean(buf, &save);
   return r;
diff --git a/libc3/facts.c b/libc3/facts.c
index 8a48970..65fb3d7 100644
--- a/libc3/facts.c
+++ b/libc3/facts.c
@@ -302,13 +302,15 @@ sw facts_load (s_facts *facts, s_buf *buf, const s_str *path)
   return -1;
  ko_fact:
   facts_lock_unlock_w(facts);
-  warnx("facts_load: %s: %s fact line %lu", r ? "invalid" : "missing",
+  warnx("facts_load: %s: %s fact line %lu",
         path->ptr.ps8,
+        r ? "invalid" : "missing",
         (unsigned long) i + 5);
   return -1;
  ko_hash:
-  warnx("facts_load: %s: %s hash line %lu", r ? "invalid" : "missing",
+  warnx("facts_load: %s: %s hash line %lu",
         path->ptr.ps8,
+        r ? "invalid" : "missing",
         (unsigned long) i + 5);
   return -1;
 }
diff --git a/libc3/ident.c b/libc3/ident.c
index 42f3ce8..e2aceeb 100644
--- a/libc3/ident.c
+++ b/libc3/ident.c
@@ -118,3 +118,9 @@ void ident_resolve_module (s_ident *ident, const s_env *env)
   }
 }
 
+bool ident_to_tag_type (const s_ident *ident, e_tag_type *dest)
+{
+  assert(ident);
+  assert(dest);
+  return sym_to_tag_type(ident->sym, dest);
+}
diff --git a/libc3/sym.c b/libc3/sym.c
index 48e06f8..cbfa817 100644
--- a/libc3/sym.c
+++ b/libc3/sym.c
@@ -289,7 +289,9 @@ bool sym_to_tag_type (const s_sym *sym, e_tag_type *dest)
     *dest = TAG_TUPLE;
     return true;
   }
+  /*
   assert(! "sym_to_tag_type: unknown type");
   errx(1, "sym_to_tag_type: unknown type: %s", sym->str.ptr.ps8);
+  */
   return false;
 }
diff --git a/libc3/tag.c b/libc3/tag.c
index bf4f32f..ea9ed6b 100644
--- a/libc3/tag.c
+++ b/libc3/tag.c
@@ -1933,14 +1933,91 @@ void * tag_to_ffi_pointer (s_tag *tag, const s_sym *type)
   case TAG_VAR:
     goto invalid_type;
   }
+  assert(! "tag_to_ffi_pointer: invalid tag type");
+  errx(1, "tag_to_ffi_pointer: invalid tag type");
+  return NULL;
+ invalid_type:
+  warnx("tag_to_ffi_pointer: cannot cast %s to %s",
+        tag_type_to_sym(tag->type)->str.ptr.ps8,
+        type->str.ptr.ps8);
+  return NULL;
+}
+
+void * tag_to_pointer (s_tag *tag, e_tag_type type)
+{
+  if (tag->type != type) {
+    warnx("tag_to_pointer: cannot cast %s to %s",
+          tag_type_to_sym(tag->type)->str.ptr.ps8,
+          tag_type_to_sym(type)->str.ptr.ps8);
+    return NULL;
+  }
+  switch (tag->type) {
+  case TAG_VOID:
+    return NULL;
+  case TAG_ARRAY:
+    return tag->data.array.data;
+  case TAG_BOOL:
+    return &tag->data.bool;
+  case TAG_CALL:
+    return &tag->data.call;
+  case TAG_CALL_FN:
+    return &tag->data.call;
+  case TAG_CALL_MACRO:
+    return &tag->data.call;
+  case TAG_CFN:
+    return &tag->data.cfn;
+  case TAG_CHARACTER:
+    return &tag->data.character;
+  case TAG_F32:
+    return &tag->data.f32;
+  case TAG_F64:
+    return &tag->data.f64;
+  case TAG_FN:
+    return tag->data.fn;
+  case TAG_IDENT:
+    return &tag->data.ident;
+  case TAG_INTEGER:
+    return &tag->data.integer;
+  case TAG_S64:
+    return &tag->data.s64;
+  case TAG_S32:
+    return &tag->data.s32;
+  case TAG_S16:
+    return &tag->data.s16;
+  case TAG_S8:
+    return &tag->data.s8;
+  case TAG_U8:
+    return &tag->data.u8;
+  case TAG_U16:
+    return &tag->data.u16;
+  case TAG_U32:
+    return &tag->data.u32;
+  case TAG_U64:
+    return &tag->data.u64;
+  case TAG_LIST:
+    return tag->data.list;
+  case TAG_PTAG:
+    return (void *) tag->data.ptag;
+  case TAG_QUOTE:
+    return &tag->data.quote;
+  case TAG_STR:
+    return &tag->data.str;
+  case TAG_SYM:
+    return (void *) tag->data.sym;
+  case TAG_TUPLE:
+    return &tag->data.tuple;
+  case TAG_VAR:
+    goto invalid_type;
+  }
   assert(! "tag_to_pointer: invalid tag type");
   errx(1, "tag_to_pointer: invalid tag type");
   return NULL;
  invalid_type:
   warnx("tag_to_pointer: cannot cast %s to %s",
         tag_type_to_sym(tag->type)->str.ptr.ps8,
-        type->str.ptr.ps8);
-  return NULL;  
+        tag_type_to_sym(type)->str.ptr.ps8);
+  return NULL;
+  
 }
 
 sw tag_type_size (e_tag_type type)
@@ -2169,8 +2246,8 @@ const s_sym * tag_type_to_sym (e_tag_type tag_type)
   case TAG_TUPLE:      return sym_1("tuple");
   case TAG_VAR:        return sym_1("var");
   }
-  assert(! "cfn_tag_type_to_sym: invalid tag type");
-  errx(1, "cfn_tag_type_to_sym: invalid tag type");
+  assert(! "tag_type_to_sym: invalid tag type");
+  errx(1, "tag_type_to_sym: invalid tag type: %d", tag_type);
   return NULL;
 }
 
diff --git a/test/Makefile b/test/Makefile
index 2169dbe..2b898b6 100644
--- a/test/Makefile
+++ b/test/Makefile
@@ -72,6 +72,9 @@ ic3_test_cov:
 libc3_test_cov: libc3_test_cov
 	time ./libc3_test_cov
 
+lldb_test: debug
+	if [ -f libc3_test_debug.core ]; then lldb .libs/libc3_test_debug libc3_test_debug.core; else lldb .libs/libc3_test_debug; fi
+
 test: libc3_test
 	time ./libc3_test
 	IC3=${SRC_TOP}/ic3/ic3 time ./ic3_test
diff --git a/test/configure b/test/configure
index 413e534..33195bc 100755
--- a/test/configure
+++ b/test/configure
@@ -42,8 +42,10 @@ echo "OBJECTS_DEBUG = $OBJECTS_DEBUG" >> ${CONFIG_MK}
 CPPFLAGS="${CPPFLAGS:=}"
 ENV_CFLAGS="${CFLAGS:=}"
 DEFAULT_CFLAGS="-O2 -pipe"
-LDFLAGS="-Wl,--allow-shlib-undefined ${LDFLAGS:=}"
-#LDFLAGS="${LDFLAGS:=}"
+LDFLAGS="${LDFLAGS}"
+if [ "x$CC" != "xtcc" ]; then
+    LDFLAGS="-Wl,--allow-shlib-undefined ${LDFLAGS}"
+fi
 LIBS="${LIBS:=} -lm"
 
 # Common config for all targets