Removed extra word in sexp

runtime/TODO.md

@@ -0,0 +1,18 @@
+### TODO list
+
+- [x] Fix heap&stack&extra_roots dump
+- [x] Remove extra and dead code
+- [x] Debug print -> DEBUG_PRINT mode
+- [x] Check `mmap`/`remap`/...
+- [x] Check: `__gc_stack_bot`: same issue as `__gc_stack_top`?
+- [x] Check: Can we get rid of `__gc_init` (as an assembly (implement in C instead))? (answer: if we make main in which every Lama file is compiled set `__gc_stack_bottom` to current `ebp` then yes, otherwise we need access to registers)
+- [x] Check: runtime tags: should always the last bit be 1? (Answer: not really, however, we still need to distinguish between 5 different options (because unboxed values should have its own value to be returned from `LkindOf`))
+- [x] Fix warnings in ML code
+- [x] TODO: debug flag doesn't compile
+- [x] Sexp: move the tag to be `contents[0]` instead of the word in sexp header; i.e. get rid of sexp as separate data structure
+- [ ] Magic constants
+- [ ] Normal documentation: a-la doxygen
+- [ ] Think: normal debug mode
+- [ ] Fix warnings in C code
+- [ ] Add more stress tests to `stdlib/regression` and unit tests
+- [ ] Modes (like FULL_INVARIANTS) -> separate files

runtime/gc.c

@@ -256,8 +256,6 @@ void compact_phase (size_t additional_size) {
       MAX(live_size * EXTRA_ROOM_HEAP_COEFFICIENT + additional_size, MINIMUM_HEAP_CAPACITY);
   size_t next_heap_pseudo_size =
       MAX(next_heap_size, heap.size);   // this is weird but here is why it happens:
-  // if we allocate too little heap right now, we may lose access to some alive objects
-  // however, after we physically relocate all of our objects we will shrink allocated memory if it is possible
 
   memory_chunk old_heap = heap;
   heap.begin            = mremap(
@@ -273,21 +271,6 @@ void compact_phase (size_t additional_size) {
   update_references(&old_heap);
   physically_relocate(&old_heap);
 
-  /*  // shrink it if possible, otherwise this code won't do anything, in both cases references
-  // will remain valid
-  heap.begin = mremap(
-      heap.begin,
-      WORDS_TO_BYTES(heap.size),
-      WORDS_TO_BYTES(next_heap_size),
-      0   // in this case we don't set MREMAP_MAYMOVE because it shouldn't move :)
-  );
-  if (heap.begin == MAP_FAILED) {
-    perror("ERROR: compact_phase: mremap failed\n");
-    exit(1);
-  }
-  heap.end     = heap.begin + next_heap_size;
-  heap.size    = next_heap_size;
-*/
   heap.current = heap.begin + live_size;
 }
 
@@ -794,15 +777,23 @@ size_t string_size (size_t len) {
 
 size_t closure_size (size_t sz) { return get_header_size(CLOSURE) + MEMBER_SIZE * sz; }
 
-size_t sexp_size (size_t members) { return get_header_size(SEXP) + MEMBER_SIZE * members; }
+size_t sexp_size (size_t members) { return get_header_size(SEXP) + MEMBER_SIZE * (members + 1); }
 
 obj_field_iterator field_begin_iterator (void *obj) {
   lama_type          type = get_type_header_ptr(obj);
   obj_field_iterator it = {.type = type, .obj_ptr = obj, .cur_field = get_object_content_ptr(obj)};
-  // since string doesn't have any actual fields we set cur_field to the end of object
+  switch (type) {
-  if (type == STRING) { it.cur_field = get_end_of_obj(it.obj_ptr); }
+    case STRING: {
-  // skip first member which is basically pointer to the code
+      it.cur_field = get_end_of_obj(it.obj_ptr);
-  if (type == CLOSURE) { it.cur_field += MEMBER_SIZE; }
+      break;
+    }
+    case CLOSURE:
+    case SEXP: {
+      it.cur_field += MEMBER_SIZE;
+      break;
+    }
+    default: break;
+  }
   return it;
 }
 
@@ -843,8 +834,8 @@ size_t get_header_size (lama_type type) {
   switch (type) {
     case STRING:
     case CLOSURE:
-    case ARRAY: return DATA_HEADER_SZ;
+    case ARRAY:
-    case SEXP: return SEXP_ONLY_HEADER_SZ + DATA_HEADER_SZ;
+    case SEXP: return DATA_HEADER_SZ;
     default: perror("ERROR: get_header_size: unknown object type\n");
 #ifdef DEBUG_VERSION
       raise(SIGINT);   // only for debug purposes
@@ -881,14 +872,14 @@ void *alloc_array (int len) {
 
 void *alloc_sexp (int members) {
   sexp *obj        = alloc(sexp_size(members));
-  obj->sexp_header = obj->contents.data_header = SEXP_TAG | (members << 3);
+  obj->data_header = SEXP_TAG | (members << 3);
 #ifdef DEBUG_VERSION
-  fprintf(stderr, "%p, SEXP tag=%zu\n", obj, TAG(obj->contents.data_header));
+  fprintf(stderr, "%p, SEXP tag=%zu\n", obj, TAG(obj->data_header));
 #endif
 #ifdef FULL_INVARIANT_CHECKS
-  obj->contents.id = cur_id;
+  obj->id = cur_id;
 #endif
-  obj->contents.forward_address = 0;
+  obj->forward_address = 0;
   obj->tag             = 0;
   return obj;
 }

runtime/runtime.c

@@ -354,7 +354,8 @@ static void printValue (void *p) {
     switch (TAG(a->data_header)) {
       case STRING_TAG: printStringBuf("\"%s\"", a->contents); break;
 
-      case CLOSURE_TAG:
+      case CLOSURE_TAG: {
+
         printStringBuf("<closure ");
         for (i = 0; i < LEN(a->data_header); i++) {
           if (i) printValue((void *)((int *)a->contents)[i]);
@@ -363,8 +364,8 @@ static void printValue (void *p) {
         }
         printStringBuf(">");
         break;
-
+      }
-      case ARRAY_TAG:
+      case ARRAY_TAG: {
         printStringBuf("[");
         for (i = 0; i < LEN(a->data_header); i++) {
           printValue((void *)((int *)a->contents)[i]);
@@ -372,28 +373,31 @@ static void printValue (void *p) {
         }
         printStringBuf("]");
         break;
+      }
 
       case SEXP_TAG: {
-        char *tag = de_hash(TO_SEXP(p)->tag);
+        sexp *sa  = (sexp *)a;
+        char *tag = de_hash(sa->tag);
         if (strcmp(tag, "cons") == 0) {
-          data *b = a;
+          sexp *sb = sa;
           printStringBuf("{");
-          while (LEN(b->data_header)) {
+          while (LEN(sb->data_header)) {
-            printValue((void *)((int *)b->contents)[0]);
+            printValue((void *)((int *)sb->contents)[0]);
-            b = (data *)((int *)b->contents)[1];
+            int list_next = ((int *)sb->contents)[1];
-            if (!UNBOXED(b)) {
+            if (!UNBOXED(list_next)) {
               printStringBuf(", ");
-              b = TO_DATA(b);
+              sb = TO_SEXP(list_next);
             } else break;
           }
           printStringBuf("}");
         } else {
           printStringBuf("%s", tag);
+          sexp *sexp_a = (sexp *)a;
           if (LEN(a->data_header)) {
             printStringBuf(" (");
-            for (i = 0; i < LEN(a->data_header); i++) {
+            for (i = 0; i < LEN(sexp_a->data_header); i++) {
-              printValue((void *)((int *)a->contents)[i]);
+              printValue((void *)((int *)sexp_a->contents)[i]);
-              if (i != LEN(a->data_header) - 1) printStringBuf(", ");
+              if (i != LEN(sexp_a->data_header) - 1) printStringBuf(", ");
             }
             printStringBuf(")");
           }
@@ -554,9 +558,9 @@ void *Lclone (void *p) {
       break;
 
     case SEXP_TAG:
-      sobj = (sexp *)alloc_sexp(l);
+      obj = (data *)alloc_sexp(l);
-      memcpy(sobj, TO_SEXP(p), sexp_size(l));
+      memcpy(obj, TO_DATA(p), sexp_size(l));
-      res = (void *)sobj->contents.contents;
+      res = (void *)obj->contents;
       break;
 
     default: failure("invalid data_header %d in clone *****\n", t);
@@ -604,7 +608,8 @@ int inner_hash (int depth, unsigned acc, void *p) {
       case SEXP_TAG: {
         int ta = TO_SEXP(p)->tag;
         acc    = HASH_APPEND(acc, ta);
-        i      = 0;
+        i      = 1;
+        ++l;
         break;
       }
 
@@ -654,6 +659,7 @@ extern int Lcompare (void *p, void *q) {
         int   ta = TAG(a->data_header), tb = TAG(b->data_header);
         int   la = LEN(a->data_header), lb = LEN(b->data_header);
         int   i;
+        int   shift = 0;
 
         COMPARE_AND_RETURN(ta, tb);
 
@@ -672,10 +678,11 @@ extern int Lcompare (void *p, void *q) {
             break;
 
           case SEXP_TAG: {
-            int ta = TO_SEXP(p)->tag, tb = TO_SEXP(q)->tag;
+            int tag_a = TO_SEXP(p)->tag, tag_b = TO_SEXP(q)->tag;
-            COMPARE_AND_RETURN(ta, tb);
+            COMPARE_AND_RETURN(tag_a, tag_b);
             COMPARE_AND_RETURN(la, lb);
             i     = 0;
+            shift = 1;
             break;
           }
 
@@ -683,7 +690,7 @@ extern int Lcompare (void *p, void *q) {
         }
 
         for (; i < la; i++) {
-          int c = Lcompare(((void **)a->contents)[i], ((void **)b->contents)[i]);
+          int c = Lcompare(((void **)a->contents)[i + shift], ((void **)b->contents)[i + shift]);
           if (c != BOX(0)) return BOX(c);
         }
 
@@ -697,15 +704,17 @@ extern int Lcompare (void *p, void *q) {
 extern void *Belem (void *p, int i) {
   data *a = (data *)BOX(NULL);
 
-  ASSERT_BOXED(".elem:1", p);
+  if (UNBOXED(p)) { ASSERT_BOXED(".elem:1", p); }
   ASSERT_UNBOXED(".elem:2", i);
 
   a = TO_DATA(p);
   i = UNBOX(i);
 
-  if (TAG(a->data_header) == STRING_TAG) { return (void *)BOX(a->contents[i]); }
+  switch (TAG(a->data_header)) {
-
+    case STRING_TAG: return (void *)BOX(a->contents[i]);
-  return (void *)((int *)a->contents)[i];
+    case SEXP_TAG: return (void *)((int *)a->contents)[i + 1];
+    default: return (void *)((int *)a->contents)[i];
+  }
 }
 
 extern void *LmakeArray (int length) {
@@ -864,32 +873,29 @@ extern void *Bsexp (int bn, ...) {
   int     i;
   int     ai;
   size_t *p;
-  sexp   *r;
+  data   *r;
-  data   *d;
   int     n = UNBOX(bn);
 
   PRE_GC();
 
   int fields_cnt   = n - 1;
-  r              = (sexp *)alloc_sexp(fields_cnt);
+  r                = (data *)alloc_sexp(fields_cnt);
-  d              = &(r->contents);
+  ((sexp *)r)->tag = 0;
-  r->tag         = 0;
 
   va_start(args, bn);
 
-  for (i = 0; i < n - 1; i++) {
+  for (i = 1; i < n; i++) {
     ai                      = va_arg(args, int);
-
     p                       = (size_t *)ai;
-    ((int *)d->contents)[i] = ai;
+    ((int *)r->contents)[i] = ai;
   }
 
-  r->tag = UNBOX(va_arg(args, int));
+  ((sexp *)r)->tag = UNBOX(va_arg(args, int));
 
   va_end(args);
 
   POST_GC();
-  return d->contents;
+  return (int *)r->contents;
 }
 
 extern int Btag (void *d, int t, int n) {
@@ -964,14 +970,24 @@ extern int Bsexp_tag_patt (void *x) {
 extern void *Bsta (void *v, int i, void *x) {
   if (UNBOXED(i)) {
     ASSERT_BOXED(".sta:3", x);
+    data *d = TO_DATA(x);
 
-    if (TAG(TO_DATA(x)->data_header) == STRING_TAG) ((char *)x)[UNBOX(i)] = (char)UNBOX(v);
+    switch (TAG(d->data_header)) {
-    else ((int *)x)[UNBOX(i)] = (int)v;
+      case STRING_TAG: {
-
+        ((char *)x)[UNBOX(i)] = (char)UNBOX(v);
-    return v;
+        break;
       }
-
+      case SEXP_TAG: {
+        ((int *)x)[UNBOX(i) + 1] = (int)v;
+        break;
+      }
+      default: {
+        ((int *)x)[UNBOX(i)] = (int)v;
+      }
+    }
+  } else {
     *(void **)x = v;
+  }
 
   return v;
 }

runtime/runtime_common.h

@@ -7,20 +7,15 @@
 //#define FULL_INVARIANT_CHECKS
 
 #define STRING_TAG 0x00000001
-//# define STRING_TAG  0x00000000
 #define ARRAY_TAG 0x00000003
-//# define ARRAY_TAG   0x00000002
 #define SEXP_TAG 0x00000005
-//# define SEXP_TAG    0x00000004
 #define CLOSURE_TAG 0x00000007
-//# define CLOSURE_TAG 0x00000006
 #define UNBOXED_TAG 0x00000009   // Not actually a data_header; used to return from LkindOf
 
 #define LEN(x) ((x & 0xFFFFFFF8) >> 3)
 #define TAG(x) (x & 0x00000007)
-//# define TAG(x)  (x & 0x00000006)
 
-#define SEXP_ONLY_HEADER_SZ (2 * sizeof(int))
+#define SEXP_ONLY_HEADER_SZ (sizeof(int))
 
 #ifndef FULL_INVARIANT_CHECKS
 #  define DATA_HEADER_SZ (sizeof(size_t) + sizeof(int))
@@ -31,7 +26,7 @@
 #define MEMBER_SIZE sizeof(int)
 
 #define TO_DATA(x) ((data *)((char *)(x)-DATA_HEADER_SZ))
-#define TO_SEXP(x) ((sexp *)((char *)(x)-DATA_HEADER_SZ - SEXP_ONLY_HEADER_SZ))
+#define TO_SEXP(x) ((sexp *)((char *)(x)-DATA_HEADER_SZ))
 
 #define UNBOXED(x) (((int)(x)) & 0x0001)
 #define UNBOX(x) (((int)(x)) >> 1)
@@ -60,11 +55,19 @@ typedef struct {
 } data;
 
 typedef struct {
-  // duplicates contents.data_header in order to be able to understand if it is s-exp during iteration over heap
+  // store tag in the last three bits to understand what structure this is, other bits are filled with
-  int sexp_header;
+  // other utility info (i.e., size for array, number of fields for s-expression)
-  // stores hashed s-expression constructor name
+  int data_header;
+
+#ifdef FULL_INVARIANT_CHECKS
+  size_t id;
+#endif
+
+  // last bit is used as MARK-BIT, the rest are used to store address where object should move
+  // last bit can be used because due to alignment we can assume that last two bits are always 0's
+  size_t forward_address;
   int    tag;
-  data contents;
+  int    contents[0];
 } sexp;
 
 #endif