Translate some memory code.

f/loom.c

@@ -574,6 +574,7 @@ _frag_phat(u2_noun a, u2_noun b)
   return b;
 }
 
+#if 0
 /* code generated */
 static u2_noun _fragbyte(u2_noun b, c3_w byt) {
     switch(byt) {
@@ -834,10 +835,11 @@ static u2_noun _fragbyte(u2_noun b, c3_w byt) {
         case 254: b = u2_t(u2_t(u2_t(u2_t(u2_t(u2_t(u2_t(u2_h(b)))))))); break;
         case 255: b = u2_t(u2_t(u2_t(u2_t(u2_t(u2_t(u2_t(u2_t(b)))))))); break;
     }
-
     return u2_none;
 }
+#endif
 
+#if 0
 /* code generated */
 static u2_noun _fragbit(u2_noun b, c3_w bits, c3_w nbits) {
   switch(nbits) {
@@ -1117,10 +1119,9 @@ static u2_noun _fragbit(u2_noun b, c3_w bits, c3_w nbits) {
         case 127: return u2_t(u2_t(u2_t(u2_t(u2_t(u2_t(u2_t(b)))))));
       }
   }
-
   return u2_none;
 }
-
+#endif
 
 /* u2_frag():
 **

f/meme.c

@@ -132,7 +132,7 @@ u2_me_leap()
     rod_u = _me_boot_south(u2R->hat_w, (u2R->cap_w - u2R->hat_w));
   } 
   else {
-    rod_u = _me_boot_south(u2R->cap_w, (u2R->hat_w - u2R->cap_w));
+    rod_u = _me_boot_north(u2R->cap_w, (u2R->hat_w - u2R->cap_w));
   }
 
   c3_assert(0 == u2R->kid_u);
@@ -152,7 +152,6 @@ u2_me_fall()
   u2R = u2R->par_u;
 }
 
-
 /* u2_me_golf(): record cap_w length for u2_flog().
 */
 c3_w
@@ -440,59 +439,76 @@ u2_me_free(void* tox_v)
   }
 }
 
-/* _me_north_senior(): yes iff only in the senior region.
+/* _me_north_is_senior(): yes iff only in the senior region.
 */
 static u2_bean
-_me_north_senior(u2_noun dog)
+_me_north_is_senior(u2_noun dog)
 {
   c3_w* dog_w = u2_me_to_ptr(dog);
 
   return u2_say((dog_w < u2R->rut_w) || (dog_w >= u2R->mat_w));
 }
 
-/* _me_north_junior(): yes iff only in the junior section.
+/* _me_north_is_junior(): yes iff only in the junior section.
 */
 static u2_bean
-_me_north_junior(u2_noun dog)
+_me_north_is_junior(u2_noun dog)
 {
   c3_w* dog_w = u2_me_to_ptr(dog);
 
   return u2_say((dog_w >= u2R->cap_w) && (dog_w < u2R->mat_w));
 }
-/* _me_north_normal(): yes iff only in the normal heap.
+/* _me_north_is_normal(): yes iff only in the normal heap.
 */
 static u2_bean
-_me_north_normal(u2_noun dog)
+_me_north_is_normal(u2_noun dog)
 {
-  return u2_and(u2_not(_me_north_senior(dog)), 
+  return u2_and(u2_not(_me_north_is_senior(dog)), 
-                u2_not(_me_north_junior(dog)));
+                u2_not(_me_north_is_junior(dog)));
 }
 
-/* _me_south_senior(): yes iff only in the senior region.
+/* _me_south_is_senior(): yes iff only in the senior region.
 */
 static u2_bean
-_me_south_senior(u2_noun dog)
+_me_south_is_senior(u2_noun dog)
 {
   c3_w* dog_w = u2_me_to_ptr(dog);
 
   return u2_say((dog_w >= u2R->mat_w) || (dog_w < u2R->cap_w));
 }
-/* _me_south_junior(): yes iff only in the junior section.
+/* _me_south_is_junior(): yes iff only in the junior section.
 */
 static u2_bean
-_me_south_junior(u2_noun dog)
+_me_south_is_junior(u2_noun dog)
 {
   c3_w* dog_w = u2_me_to_ptr(dog);
 
   return u2_say((dog_w >= u2R->cap_w) && (dog_w < u2R->mat_w));
 }
-/* _me_south_normal(): yes iff only in the normal heap.
+/* _me_south_is_normal(): yes iff only in the normal heap.
 */
 static u2_bean
-_me_south_normal(u2_noun dog)
+_me_south_is_normal(u2_noun dog)
 {
-  return u2_and(u2_not(_me_south_senior(dog)), 
+  return u2_and(u2_not(_me_south_is_senior(dog)), 
-                u2_not(_me_south_junior(dog)));
+                u2_not(_me_south_is_junior(dog)));
+}
+
+/* u2_me_is_junior(): yes iff (som) is junior.
+*/
+u2_bean
+u2_me_is_junior(u2_noun som)
+{
+  if ( u2_so(u2_me_is_cat(som)) ) {
+    return u2_no;
+  }
+  else { 
+    if ( u2_so(u2_me_is_north) ) {
+      return _me_north_is_junior(som);
+    } else {
+      return _me_south_is_junior(som);
+    }
+  }
 }
 
 /* _me_wash_north(): clean up mug slots after copy.
@@ -502,7 +518,7 @@ static void
 _me_wash_north_in(u2_noun som)
 {
   if ( u2_so(u2_me_is_cat(som)) ) return;
-  if ( u2_ne(_me_north_junior(som)) ) return;
+  if ( u2_ne(_me_north_is_junior(som)) ) return;
 
   _me_wash_north(som);
 }
@@ -510,7 +526,7 @@ static void
 _me_wash_north(u2_noun dog)
 {
   c3_assert(u2_me_is_dog(dog));
-  c3_assert(u2_yes == _me_north_junior(dog));
+  c3_assert(u2_yes == _me_north_is_junior(dog));
   {
     u2_me_noun* dog_u = u2_me_to_ptr(dog);
 
@@ -532,7 +548,7 @@ static void
 _me_wash_south_in(u2_noun som)
 {
   if ( u2_so(u2_me_is_cat(som)) ) return;
-  if ( u2_ne(_me_south_junior(som)) ) return;
+  if ( u2_ne(_me_south_is_junior(som)) ) return;
 
   _me_wash_south(som);
 }
@@ -540,7 +556,7 @@ static void
 _me_wash_south(u2_noun dog)
 {
   c3_assert(u2_me_is_dog(dog));
-  c3_assert(u2_yes == _me_south_junior(dog));
+  c3_assert(u2_yes == _me_south_is_junior(dog));
   {
     u2_me_noun* dog_u = u2_me_to_ptr(dog);
 
@@ -563,7 +579,6 @@ _me_gain_use(u2_noun dog)
   c3_w* dog_w      = u2_me_to_ptr(dog);
   u2_me_box* box_u = u2_me_botox(dog_w);
 
-  box_u = u2_me_botox(dog_w);
   if ( 0xffffffff == box_u->use_w ) {
     u2_me_bail(c3__fail);
   }
@@ -572,6 +587,25 @@ _me_gain_use(u2_noun dog)
   }
 }
 
+/* _me_lose_use(): increment use count.
+*/
+static void
+_me_lose_use(u2_noun dog)
+{
+  c3_w* dog_w      = u2_me_to_ptr(dog);
+  u2_me_box* box_u = u2_me_botox(dog_w);
+
+  if ( box_u->use_w > 1 ) {
+    box_u->use_w -= 1;
+  }
+  else {
+    if ( 0 == box_u->use_w ) {
+      u2_me_bail(c3__foul);
+    }
+    else u2_me_free(dog_w);
+  }
+}
+
 /* _me_copy_north_in(): copy subjuniors on a north road.
 */
 static u2_noun _me_copy_north(u2_noun);
@@ -585,10 +619,10 @@ _me_copy_north_in(u2_noun som)
   else { 
     u2_noun dog = som;
 
-    if ( u2_so(_me_north_senior(dog)) ) {
+    if ( u2_so(_me_north_is_senior(dog)) ) {
       return dog;
     }
-    else if ( u2_so(_me_north_junior(dog)) ) {
+    else if ( u2_so(_me_north_is_junior(dog)) ) {
       return _me_copy_north(dog);
     }
     else {
@@ -602,10 +636,10 @@ _me_copy_north_in(u2_noun som)
 static u2_noun
 _me_copy_north(u2_noun dog)
 {
-  c3_assert(u2_yes == _me_north_junior(dog));
+  c3_assert(u2_yes == _me_north_is_junior(dog));
 
-  if ( u2_ne(_me_north_junior(dog)) ) {
+  if ( u2_ne(_me_north_is_junior(dog)) ) {
-    if ( u2_ne(_me_north_senior(dog)) ) {
+    if ( u2_ne(_me_north_is_senior(dog)) ) {
       _me_gain_use(dog);
     }
     return dog;
@@ -618,7 +652,7 @@ _me_copy_north(u2_noun dog)
     if ( dog_u->mug_w >> 31 ) {
       u2_noun nov = (u2_noun) dog_u->mug_w;
 
-      c3_assert(u2_so(_me_north_normal(nov)));
+      c3_assert(u2_so(_me_north_is_normal(nov)));
       _me_gain_use(nov);
 
       return nov;
@@ -677,10 +711,10 @@ _me_copy_south_in(u2_noun som)
   else { 
     u2_noun dog = som;
 
-    if ( u2_so(_me_south_senior(dog)) ) {
+    if ( u2_so(_me_south_is_senior(dog)) ) {
       return dog;
     }
-    else if ( u2_so(_me_south_junior(dog)) ) {
+    else if ( u2_so(_me_south_is_junior(dog)) ) {
       return _me_copy_south(dog);
     }
     else {
@@ -694,10 +728,10 @@ _me_copy_south_in(u2_noun som)
 static u2_noun
 _me_copy_south(u2_noun dog)
 {
-  c3_assert(u2_yes == _me_south_junior(dog));
+  c3_assert(u2_yes == _me_south_is_junior(dog));
 
-  if ( u2_ne(_me_south_junior(dog)) ) {
+  if ( u2_ne(_me_south_is_junior(dog)) ) {
-    if ( u2_ne(_me_south_senior(dog)) ) {
+    if ( u2_ne(_me_south_is_senior(dog)) ) {
       _me_gain_use(dog);
     }
     return dog;
@@ -710,7 +744,7 @@ _me_copy_south(u2_noun dog)
     if ( dog_u->mug_w >> 31 ) {
       u2_noun nov = (u2_noun) dog_u->mug_w;
 
-      c3_assert(u2_so(_me_south_normal(nov)));
+      c3_assert(u2_so(_me_south_is_normal(nov)));
       _me_gain_use(nov);
 
       return nov;
@@ -761,13 +795,12 @@ _me_copy_south(u2_noun dog)
 static u2_noun
 _me_gain_north(u2_noun dog)
 {
-  c3_assert(u2_none != dog);
+  if ( u2_yes == _me_north_is_senior(dog) ) {
-  if ( u2_yes == _me_north_senior(dog) ) {
     /*  senior pointers are not refcounted
     */
     return dog;
   }
-  else if ( u2_yes == _me_north_junior(dog) ) {
+  else if ( u2_yes == _me_north_is_junior(dog) ) {
     /* junior pointers are copied
     */
     u2_noun mos = _me_copy_north(dog);
@@ -788,12 +821,12 @@ _me_gain_north(u2_noun dog)
 static u2_noun
 _me_gain_south(u2_noun dog)
 {
-  if ( u2_yes == _me_south_senior(dog) ) {
+  if ( u2_yes == _me_south_is_senior(dog) ) {
     /*  senior pointers are not refcounted
     */
     return dog;
   }
-  else if ( u2_yes == _me_south_junior(dog) ) {
+  else if ( u2_yes == _me_south_is_junior(dog) ) {
     /* junior pointers are copied
     */
     u2_noun mos = _me_copy_south(dog);
@@ -809,7 +842,29 @@ _me_gain_south(u2_noun dog)
   }
 }
 
-/* u2_me_gain(): gain and/or copy juniors.
+/* _me_lose_north(): lose on a north road.
+*/
+static u2_noun
+_me_lose_north(u2_noun dog)
+{
+  if ( u2_yes == _me_north_is_normal(dog) ) {
+    _me_lose_use(dog);
+  }
+  return dog;
+}
+
+/* _me_lose_south(): lose on a south road.
+*/
+static u2_noun
+_me_lose_south(u2_noun dog)
+{
+  if ( u2_yes == _me_north_is_normal(dog) ) {
+    _me_lose_use(dog);
+  }
+  return dog;
+}
+
+/* u2_me_gain(): gain a reference count, and/or copy juniors.
 */
 u2_noun
 u2_me_gain(u2_noun som)
@@ -825,3 +880,478 @@ u2_me_gain(u2_noun som)
               : _me_gain_south(som);
   }
 }
+
+/* u2_me_lose(): lose a reference count.
+*/
+void
+u2_me_lose(u2_noun som)
+{
+  if ( u2_ne(u2_me_is_cat(som)) ) {
+    if ( u2_so(u2_me_is_north) ) {
+      _me_lose_north(som);
+      _me_lose_south(som);
+    }
+  }
+}
+
+/* u2_me_use(): reference count.
+*/
+c3_w
+u2_me_use(u2_noun som)
+{
+  if ( u2_so(u2_me_is_cat(som)) ) {
+    return 1;
+  } 
+  else {
+    c3_w* dog_w      = u2_me_to_ptr(som);
+    u2_me_box* box_u = u2_me_botox(dog_w);
+
+    return box_u->use_w;
+  }
+}
+
+/* u2_me_slab(): create a length-bounded proto-atom.
+*/
+c3_w*
+u2_me_slab(c3_w len_w)
+{
+  c3_w*       nov_w = u2_me_walloc(len_w + c3_wiseof(u2_me_atom));
+  u2_me_atom* pug_u = (void *)nov_w;
+
+  pug_u->mug_w = 0;
+  pug_u->len_w = len_w;
+
+  /* Clear teh slab.
+  */
+  {
+    c3_w i_w;
+
+    for ( i_w=0; i_w < len_w; i_w++ ) {
+      pug_u->buf_w[i_w] = 0;
+    }
+  }
+  return pug_u->buf_w;
+}
+
+/* u2_me_slaq(): u2_me_slaq() with a defined blocksize.
+*/
+c3_w*
+u2_me_slaq(c3_g met_g, c3_w len_w)
+{
+  return u2_me_slab(((len_w << met_g) + 31) >> 5);
+}
+
+/* u2_me_malt(): measure and finish a proto-atom.
+*/
+u2_noun
+u2_me_malt(c3_w* sal_w)
+{
+  c3_w*       nov_w = (sal_w - c3_wiseof(u2_me_atom));
+  u2_me_atom* nov_u = (void *)nov_w;
+  c3_w        len_w;
+
+  for ( len_w = nov_u->len_w; len_w; len_w-- ) {
+    if ( 0 != nov_u->buf_w[len_w - 1] ) {
+      break;
+    }
+  }
+  return u2_me_mint(sal_w, len_w);
+}
+
+/* u2_me_moot(): finish a pre-measured proto-atom; dangerous.
+*/
+u2_noun
+u2_me_moot(c3_w* sal_w)
+{
+  c3_w*       nov_w = (sal_w - c3_wiseof(u2_me_atom));
+  u2_me_atom* nov_u = (void*)nov_w;
+  c3_w        len_w = nov_u->len_w;
+  c3_w        las_w = nov_u->buf_w[len_w - 1];
+
+  c3_assert(0 != len_w);
+  c3_assert(0 != las_w);
+
+  if ( 1 == len_w ) {
+    if ( u2_so(u2_me_is_cat(las_w)) ) {
+      u2_me_free(nov_w);
+
+      return las_w;
+    }
+  }
+  return u2_me_to_pug(u2_me_outa(nov_w));
+}
+
+/* u2_me_mint(): finish a measured proto-atom.
+*/
+u2_noun
+u2_me_mint(c3_w* sal_w, c3_w len_w)
+{
+  c3_w*       nov_w = (sal_w - c3_wiseof(u2_me_atom));
+  u2_me_atom* nov_u = (void*)nov_w;
+
+  /* See if we can free the slab entirely.
+  */
+  if ( len_w == 0 ) {
+    u2_me_free(nov_w);
+
+    return 0;
+  }
+  else if ( len_w == 1 ) {
+    c3_w low_w = nov_u->buf_w[0];
+
+    if ( u2_so(u2_me_is_cat(low_w)) ) {
+      u2_me_free(nov_w);
+
+      return low_w;
+    }
+  }
+
+  /* See if we can strip off a block on the end.
+  */
+  {
+    c3_w old_w = nov_u->len_w;
+    c3_w dif_w = (old_w - len_w);
+
+    if ( dif_w >= u2_me_minimum ) {
+      c3_w* box_w = (void *)u2_me_botox(nov_w);
+      c3_w* end_w = (nov_w + c3_wiseof(u2_me_atom) + len_w + 1);
+      c3_w  asz_w = (end_w - box_w);
+      c3_w  bsz_w = box_w[0] - asz_w;
+
+      _me_box_attach(_me_box_make(end_w, bsz_w, 0));
+
+      box_w[0] = asz_w;
+      box_w[asz_w - 1] = asz_w;
+    }
+    nov_u->len_w = len_w;
+  }
+  return u2_me_to_pug(u2_me_outa(nov_w));
+}
+
+/* u2_me_words():
+**
+**   Copy [a] words from [b] into an atom.
+*/
+u2_noun
+u2_me_words(c3_w        a_w,
+            const c3_w* b_w)
+{
+  /* Strip trailing zeroes.
+  */
+  while ( a_w && !b_w[a_w - 1] ) {
+    a_w--;
+  }
+
+  /* Check for cat.
+  */
+  if ( !a_w ) {
+    return 0;
+  }
+  else if ( (a_w == 1) && !(b_w[0] >> 31) ) {
+    return b_w[0];
+  }
+
+  /* Allocate, fill, return.
+  */
+  {
+    c3_w*       nov_w = u2_me_walloc(a_w + c3_wiseof(u2_me_atom));
+    u2_me_atom* nov_u = (void*)nov_w;
+
+    nov_u->mug_w = 0;
+    nov_u->len_w = a_w;
+
+    /* Fill the words.
+    */
+    {
+      c3_w i_w;
+
+      for ( i_w=0; i_w < a_w; i_w++ ) {
+        nov_u->buf_w[i_w] = b_w[i_w];
+      }
+    }
+    return u2_me_to_pug(u2_me_outa(nov_w));
+  }
+}
+
+/* u2_me_bytes():
+**
+**   Copy `a` bytes from `b` to an LSB first atom.
+*/
+u2_noun
+u2_me_bytes(c3_w        a_w,
+            const c3_y* b_y)
+{
+  /* Strip trailing zeroes.
+  */
+  while ( a_w && !b_y[a_w - 1] ) {
+    a_w--;
+  }
+
+  /* Check for cat.
+  */
+  if ( a_w <= 4 ) {
+    if ( !a_w ) {
+      return 0;
+    }
+    else if ( a_w == 1 ) {
+      return b_y[0];
+    }
+    else if ( a_w == 2 ) {
+      return (b_y[0] | (b_y[1] << 8));
+    }
+    else if ( a_w == 3 ) {
+      return (b_y[0] | (b_y[1] << 8) | (b_y[2] << 16));
+    }
+    else if ( (b_y[3] <= 0x7f) ) {
+      return (b_y[0] | (b_y[1] << 8) | (b_y[2] << 16) | (b_y[3] << 24));
+    }
+  }
+
+  /* Allocate, fill, return.
+  */
+  {
+    c3_w        len_w = (a_w + 3) >> 2;
+    c3_w*       nov_w = u2_me_walloc((len_w + c3_wiseof(u2_me_atom)));
+    u2_me_atom* nov_u = (void*)nov_w;
+
+    nov_u->mug_w = 0;
+    nov_u->len_w = len_w;
+
+    /* Clear the words.
+    */
+    {
+      c3_w i_w;
+
+      for ( i_w=0; i_w < len_w; i_w++ ) {
+        nov_u->buf_w[i_w] = 0;
+      }
+    }
+
+    /* Fill the bytes.
+    */
+    {
+      c3_w i_w;
+
+      for ( i_w=0; i_w < a_w; i_w++ ) {
+        nov_u->buf_w[i_w >> 2] |= (b_y[i_w] << ((i_w & 3) * 8));
+      }
+    }
+    return u2_me_to_pug(u2_me_outa(nov_w));
+  }
+}
+
+/* u2_me_mp():
+**
+**   Copy the GMP integer `a` into an atom, and clear it.
+*/
+u2_noun
+u2_me_mp(mpz_t a_mp)
+{
+  /* Efficiency: unnecessary copy.
+  */
+  {
+    c3_w pyg_w  = mpz_size(a_mp) * ((sizeof(mp_limb_t)) / 4);
+    c3_w *buz_w = alloca(pyg_w * 4);
+    c3_w i_w;
+
+    for ( i_w = 0; i_w < pyg_w; i_w++ ) {
+      buz_w[i_w] = 0;
+    }
+    mpz_export(buz_w, 0, -1, 4, 0, 0, a_mp);
+    mpz_clear(a_mp);
+
+    return u2_me_words(pyg_w, buz_w);
+  }
+}
+
+/* u2_mr_mp():
+**
+**   Copy (b) into (a_mp).
+*/
+void
+u2_mr_mp(mpz_t   a_mp,
+         u2_atom b)
+{
+  c3_assert(u2_none != b);
+  c3_assert(u2_so(u2_me_is_atom(b)));
+
+  if ( u2_so(u2_me_is_cat(b)) ) {
+    mpz_init_set_ui(a_mp, b);
+  }
+  else {
+    u2_me_atom* b_u   = u2_me_to_ptr(b);
+    c3_w        len_w = b_u->len_w;
+
+    /* Slight deficiency in the GMP API.
+    */
+    c3_assert(!(len_w >> 27));
+    mpz_init2(a_mp, len_w << 5);
+
+    /* Efficiency: horrible.
+    */
+    {
+      c3_w *buf_w = alloca(len_w << 2);
+      c3_w i_w;
+
+      for ( i_w=0; i_w < len_w; i_w++ ) {
+        buf_w[i_w] = b_u->buf_w[i_w];
+      }
+      mpz_import(a_mp, len_w, -1, 4, 0, 0, buf_w);
+    }
+  }
+}
+
+/* u2_me_vint():
+**
+**   Create `a + 1`.
+*/
+u2_noun
+u2_me_vint(u2_noun a)
+{
+  c3_assert(u2_none != a);
+
+  if ( u2_so(u2_me_is_cat(a)) ) {
+    c3_w vin_w = (a + 1);
+
+    if ( a == 0x7fffffff ) {
+      return u2_me_words(1, &vin_w);
+    }
+    else return vin_w;
+  }
+  else if ( u2_so(u2_me_is_cell(a)) ) {
+    return u2_me_bail(c3__exit);
+  }
+  else {
+    mpz_t a_mp;
+
+    u2_mr_mp(a_mp, a);
+    u2_me_lose(a);
+
+    mpz_add_ui(a_mp, a_mp, 1);
+    return u2_me_mp(a_mp);
+  }
+}
+
+/* u2_me_cons():
+**
+**   Produce the cell `[a b]`.
+*/
+u2_noun
+u2_me_cons(u2_noun a, u2_noun b)
+{
+  c3_assert(u2_none != a);
+  c3_assert(u2_none != b);
+
+  c3_assert(u2_ne(u2_me_is_junior(a)));
+  c3_assert(u2_ne(u2_me_is_junior(b)));
+
+  {
+    c3_w*       nov_w = u2_me_walloc(c3_wiseof(u2_me_cell));
+    u2_me_cell* nov_u = (void *)nov_w;
+
+    nov_u->mug_w = 0;
+    nov_u->hed = a;
+    nov_u->tel = b;
+
+    return u2_me_to_pom(u2_me_outa(nov_w));
+  }
+}
+
+/* u2_me_molt():
+**
+**   Mutate `som` with a 0-terminated list of axis, noun pairs.
+**   Axes must be cats (31 bit).
+*/
+  struct _molt_pair {
+    c3_w    axe_w;
+    u2_noun som;
+  };
+
+  static c3_w
+  _molt_cut(c3_w               len_w,
+            struct _molt_pair* pms_m)
+  {
+    c3_w i_w, cut_t, cut_w;
+
+    cut_t = c3_false;
+    cut_w = 0;
+    for ( i_w = 0; i_w < len_w; i_w++ ) {
+      c3_w axe_w = pms_m[i_w].axe_w;
+
+      if ( (cut_t == c3_false) && (3 == u2_ax_cap(axe_w)) ) {
+        cut_t = c3_true;
+        cut_w = i_w;
+      }
+      pms_m[i_w].axe_w = u2_ax_mas(axe_w);
+    }
+    return cut_t ? cut_w : i_w;
+  }
+
+  static u2_noun                            //  transfer
+  _molt_apply(u2_noun            som,       //  retain
+              c3_w               len_w,
+              struct _molt_pair* pms_m)     //  transfer
+  {
+    if ( len_w == 0 ) {
+      return u2_me_gain(som);
+    }
+    else if ( (len_w == 1) && (1 == pms_m[0].axe_w) ) {
+      return pms_m[0].som;
+    }
+    else {
+      c3_w cut_w = _molt_cut(len_w, pms_m);
+
+      if ( u2_no == u2_me_is_cell(som) ) {
+        return u2_me_bail(c3__exit);
+      } 
+      else {
+        return u2_me_cons
+           (_molt_apply(u2_h(som), cut_w, pms_m),
+            _molt_apply(u2_t(som), (len_w - cut_w), (pms_m + cut_w)));
+      }
+    }
+  }
+u2_noun 
+u2_me_molt(u2_noun som, ...)
+{
+  va_list            ap;
+  c3_w               len_w;
+  struct _molt_pair* pms_m;
+  u2_noun            pro;
+
+  /* Count.
+  */
+  len_w = 0;
+  {
+    va_start(ap, som);
+    while ( 1 ) {
+      if ( 0 == va_arg(ap, c3_w) ) {
+        break;
+      }
+      va_arg(ap, u2_weak*);
+      len_w++;
+    }
+    va_end(ap);
+  }
+  pms_m = alloca(len_w * sizeof(struct _molt_pair));
+
+  /* Install.
+  */
+  {
+    c3_w i_w;
+
+    va_start(ap, som);
+    for ( i_w = 0; i_w < len_w; i_w++ ) {
+      pms_m[i_w].axe_w = va_arg(ap, c3_w);
+      pms_m[i_w].som = va_arg(ap, u2_noun);
+    }
+    va_end(ap);
+  }
+
+  /* Apply.
+  */
+  pro = _molt_apply(som, len_w, pms_m);
+  u2_me_lose(som);
+  return pro;
+}
+

include/c/motes.h

@@ -388,6 +388,7 @@
 #   define c3__fore   c3_s4('f','o','r','e')
 #   define c3__fork   c3_s4('f','o','r','k')
 #   define c3__forq   c3_s4('f','o','r','q')
+#   define c3__foul   c3_s4('f','o','u','l')
 #   define c3__frag   c3_s4('f','r','a','g')
 #   define c3__free   c3_s4('f','r','e','e')
 #   define c3__frez   c3_s4('f','r','e','z')

include/f/meme.h

@@ -85,25 +85,60 @@
 
 #     define u2_me_is_pug(som)    (2 == (som >> 30))
 #     define u2_me_is_pom(som)    (3 == (som >> 30))
-#     define u2_me_to_ptr(som)    ((void *)(u2_me_into(som & 0x3fffffff)))
+#     define u2_me_to_off(som)    ((som) & 0x3fffffff)
+#     define u2_me_to_ptr(som)    ((void *)(u2_me_into(u2_me_to_off(som))))
+#     define u2_me_to_pug(off)    (off | 0x40000000)
+#     define u2_me_to_pom(off)    (off | 0xc0000000)
 
-#     define u2_me_is_atom(som)    u2_or(u2_noun_is_cat(som), \
+#     define u2_me_is_atom(som)    u2_or(u2_me_is_cat(som), \
-                                         u2_noun_is_pug(som))
+                                         u2_me_is_pug(som))
-#     define u2_me_is_cell(som)    u2_noun_is_pom(som)
+#     define u2_me_is_cell(som)    u2_me_is_pom(som)
 #     define u2_me_de_twin(dog, dog_w)  ((dog & 0xc0000000) | u2_me_outa(dog_w))
 
+#     define u2_h(som) \
+        ( u2_so(u2_me_is_cell(som)) \
+           ? ( ((u2_me_cell *)u2_me_to_ptr(som))->hed )\
+           : u2_me_bail(c3__exit) )
+
+#     define u2_t(som) \
+        ( u2_so(u2_me_is_cell(som)) \
+           ? ( ((u2_me_cell *)u2_me_to_ptr(som))->tel )\
+           : u2_me_bail(c3__exit) )
 
     /* More typedefs.
     */
-      typedef u2_noun u2_atom;            //  must be atom
+      typedef u2_noun u2_atom;              //  must be atom
-      typedef u2_noun u2_term;            //  @tas
+      typedef u2_noun u2_term;              //  @tas
-      typedef u2_noun u2_mote;            //  @tas
+      typedef u2_noun u2_mote;              //  @tas
-      typedef u2_noun u2_cell;            //  must be cell
+      typedef u2_noun u2_cell;              //  must be cell
-      typedef u2_noun u2_trel;            //  must be triple
+      typedef u2_noun u2_trel;              //  must be triple
-      typedef u2_noun u2_qual;            //  must be quadruple
+      typedef u2_noun u2_qual;              //  must be quadruple
-      typedef u2_noun u2_quin;            //  must be quintuple
+      typedef u2_noun u2_quin;              //  must be quintuple
-      typedef u2_noun u2_bean;            //  loobean: 0 == u2_yes, 1 == u2_no
+      typedef u2_noun u2_bean;              //  loobean: 0 == u2_yes, 1 == u2_no
-      typedef u2_noun u2_weak;            //  may be u2_none
+      typedef u2_noun u2_weak;              //  may be u2_none
+      typedef u2_noun (*u2_gate)(u2_noun);  //  function pointer
+
+    /*** Word axis macros.
+    ****
+    **** Use these on axes known to be in 31-bit range.
+    ***/
+      /* u2_ax_dep(): number of axis bits.
+      */
+#       define u2_ax_dep(a_w)   (c3_bits_word(a_w) - 1)
+
+      /* u2_ax_cap(): root axis, 2 or 3.
+      */
+#       define u2_ax_cap(a_w)   (0x2 | (a_w >> (u2_ax_dep(a_w) - 1)))
+
+      /* u2_ax_mas(): remainder after cap.
+      */
+#       define u2_ax_mas(a_w) \
+          ( (a_w & ~(1 << u2_ax_dep(a_w))) | (1 << (u2_ax_dep(a_w) - 1)) )
+
+      /* u2_ax_peg(): connect two axes.
+      */
+#       define u2_ax_peg(a_w, b_w) \
+          ( (a_w << u2_ax_dep(b_w)) | (b_w &~ (1 << u2_ax_dep(b_w))) )
 
 
     /* u2_me_box: classic allocation box.
@@ -151,6 +186,38 @@
 
     /* u2_me_road: contiguous allocation and execution context.
     **
+    **  A road is a normal heap-stack system, except that the heap
+    **  and stack can point in either direction.  Therefore, inside
+    **  a road, we can nest another road in the opposite direction.
+    **
+    **  When the opposite road completes, its heap is left on top of
+    **  the opposite heap's stack.  It's no more than the normal 
+    **  behavior of a stack machine for all subcomputations to push
+    **  their results, internally durable, on the stack.
+    **
+    **  The performance tradeoff of "leaping" - reversing directions 
+    **  in the road - is that if the outer computation wants to
+    **  preserve the results of the inner one, not just use them for
+    **  temporary purposes, it has to copy them.  
+    **
+    **  This is a trivial cost in some cases, a prohibitive case in 
+    **  others.  The upside, of course, is that all garbage accrued
+    **  in the inner computation is discarded at zero cost.
+    **
+    **  The goal of the road system is the ability to *layer* memory
+    **  models.  If you are allocating on a road, you have no idea
+    **  how deep within a nested road system you are - in other words,
+    **  you have no idea exactly how durable your result may be.
+    **  But free space is never fragmented within a road.
+    **
+    **  Roads do not reduce the generality or performance of a memory
+    **  system, since even the most complex GC system can be nested
+    **  within a road at no particular loss of performance - a road
+    **  is just a block of memory.  The cost of road allocation is,
+    **  at least in theory, the branch prediction hits when we try to
+    **  decide which side of the road we're allocating on.  The road
+    **  system imposes no pointer read or write barriers, of course.
+    **
     **  The road can point in either direction.  If cap > hat, it
     **  looks like this ("north"):
     **
@@ -285,7 +352,7 @@
         u2_bean
         u2_me_trap(void);
 #else
-#       define u2_me_trap() (u2_bean)(setjmp(u2R->esc.buf))
+#       define u2_me_trap() (u2_noun)(setjmp(u2R->esc.buf))
 #endif
 
       /* u2_me_bail(): bail out.  Does not return.
@@ -293,8 +360,10 @@
       **  Bail motes:
       **
       **    %exit               ::  semantic failure
+      **    %evil               ::  bad crypto
       **    %intr               ::  interrupt
       **    %fail               ::  execution failure
+      **    %foul               ::  assert failure
       **    %need               ::  network block
       **    %meme               ::  out of memory
       */ 
@@ -380,20 +449,10 @@
           void
           u2_me_lose(u2_weak som);
 
-        /* u2_me_junior(): yes iff reference cannot be saved.
+        /* u2_me_use(): reference count.
-        */
-          u2_bean
-          u2_me_junior(u2_noun som);
-
-        /* u2_me_senior(): yes iff references need not be counted.
-        */
-          u2_bean
-          u2_me_senior(u2_noun som);
-
-        /* u2_me_refs(): reference count.
         */
           c3_w
-          u2_me_refs(u2_noun som);
+          u2_me_use(u2_noun som);
 
 
       /* Atoms from proto-atoms.
@@ -423,6 +482,53 @@
           u2_noun
           u2_me_mint(c3_w* sal_w, c3_w len_w);
 
+      /* General constructors.
+      */
+        /* u2_me_words():
+        **
+        **   Copy [a] words from [b] into an atom.
+        */
+          u2_noun
+          u2_me_words(c3_w        a_w,
+                      const c3_w* b_w);
+
+        /* u2_me_bytes():
+        **
+        **   Copy `a` bytes from `b` to an LSB first atom.
+        */
+          u2_noun
+          u2_me_bytes(c3_w        a_w,
+                      const c3_y* b_y);
+
+        /* u2_me_mp():
+        **
+        **   Copy the GMP integer `a` into an atom, and clear it.
+        */
+          u2_noun
+          u2_me_mp(mpz_t a_mp);
+
+        /* u2_me_vint():
+        **
+        **   Create `a + 1`.
+        */
+          u2_noun
+          u2_me_vint(u2_noun a);
+
+        /* u2_me_cons():
+        **
+        **   Produce the cell `[a b]`.
+        */
+          u2_noun
+          u2_me_cons(u2_noun a, u2_noun b);
+
+        /* u2_me_molt():
+        **
+        **   Mutate `som` with a 0-terminated list of axis, noun pairs.
+        **   Axes must be cats (31 bit).
+        */
+          u2_noun 
+          u2_me_molt(u2_noun som, ...);
+
       /* Garbage collection (for debugging only).
       */
         /* u2_me_mark(): mark for gc, returning allocated words.
@@ -496,4 +602,3 @@
       */
         u2_weak 
         u2_me_uniq(u2_noun som);
-