# Updating all heap objects in the world (i.e. in the heap and stack).

# ------------------------------ Specification --------------------------------

# For the following macros, the macro update(objptr) must be defined, with the
# signature:  local void update (object* objptr);

# Update all the world, except the heaps and the stacks.
#   update_tables();

# Update the cons heaps.
#   #define update_conspage ...
#   update_conses();
#   #undef update_conspage
# Some possible implementation of update_conspage.
#   update_conspage_normal

# Update the varobject heaps.
#   #define update_ht_invalid ...
#   #define update_fpointer_invalid ...
#   #define update_fp_invalid ...
#   #define update_fsubr_function ...
#   #define update_fs_function ...
#   #define update_page ...
#   update_varobjects();
#   #undef update_page
#   #undef update_fs_function
#   #undef update_fsubr_function
#   #undef update_fp_invalid
#   #undef update_fpointer_invalid
#   #undef update_ht_invalid
# Some possible implementation of update_page.
#   update_page_normal

# Update the list of pending weak pointers.
#   update_weakpointers();
# Same, but here update(objptr) may modify *objptr. and the
# value before update should be taken while following the list.
#   update_weakpointers_mod();
# ditto for weak key-value tables:
#   update_weakkvtables() and update_weakkvtables_mod()

# Update the stacks.
#   #define update_stackobj ...
#   update_stacks();
#   #undef update_stackobj
# Some possible implementation of update_stackobj.
#   update_stackobj_normal

/* update back_trace's: update_back_traces() */

# ------------------------------ Implementation -------------------------------

# update program constants:
#define update_subr_tab()                                               \
  for_all_subrs({                                                       \
    var gcv_object_t* p = (gcv_object_t*)((aint)ptr+subr_const_offset); \
    var uintC c;                                                        \
    dotimespC(c,subr_const_anz, { update(p); p++; } );                  \
  })
#define update_symbol_tab()                     \
  for_all_constsyms({ # traverse symbol_tab     \
    var gcv_object_t* p;                        \
    p = &ptr->symvalue; update(p);              \
    p = &ptr->symfunction; update(p);           \
    p = &ptr->proplist; update(p);              \
    p = &ptr->pname; update(p);                 \
    p = &ptr->homepackage; update(p);           \
  })
#define update_object_tab()                                             \
  do { for_all_constobjs( update(objptr); ); # traverse object_tab      \
       for_all_threadobjs( update(objptr); ); # traverse threads        \
  } while(0)
#define update_tables()                         \
  do { update_subr_tab();                       \
       update_symbol_tab();                     \
       update_object_tab();                     \
  } while(0)

# update the pointers in the Cons-cells:
#define update_conspage_normal(page)                                          \
  do { var aint objptr = page->page_start;                                    \
       var aint objptrend = page->page_end;                                   \
       # update all pointers in the (new) CONS-region start <= address < end: \
       while (objptr != objptrend) {                                          \
         update((gcv_object_t*)objptr);                                       \
         objptr += sizeof(gcv_object_t);                                      \
         update((gcv_object_t*)objptr);                                       \
         objptr += sizeof(gcv_object_t);                                      \
  }} while(0)
#define update_conses() for_each_cons_page(page, update_conspage(page) )

# update pointers in the objects of variable length:
#define update_page_normal(page,updater)                        \
  do { var aint ptr = page->page_start;                         \
       var aint ptrend = page->page_end;                        \
       # traverse all objects with address >=ptr, <ptrend :     \
       while (ptr != ptrend) { # until ptr has reached the end  \
         # traverse next object with address ptr (< ptrend) :   \
         updater(typecode_at(ptr)); # and advance               \
  }} while(0)
# subroutines:
#define do_update_symbol()                                                          \
  do { var gcv_object_t* p = (gcv_object_t*)pointerplus(ptr,symbol_objects_offset); \
    var uintC count;                                                                \
    dotimespC(count,((sizeof(symbol_)-symbol_objects_offset)/sizeof(gcv_object_t)), \
      { update(p); p++; } );                                                        \
  } while(0)
#define do_update_svector()                              \
  do { var uintL count = svector_length((Svector)ptr);   \
       if (count != 0) {                                 \
         var gcv_object_t* p = &((Svector)ptr)->data[0]; \
         dotimespL(count,count, { update(p); p++; } );   \
  }} while(0)
#define do_update_iarray()  \
  do { var gcv_object_t* p = &((Iarray)ptr)->data; update(p); } while(0)
#define do_update_record()                                                    \
  do { # on update of pointers, the hash-tables are invalidated               \
       # (because the hash function of an object depends on its address,      \
       # which is now changed).                                               \
    if (record_type((Record)ptr) == Rectype_Hashtable) # a hash-table ?       \
      { update_ht_invalid((Hashtable)ptr); } # yes -> note for reorganisation \
    else if (update_fpointer_invalid &&  # foreign-pointer ?                  \
             (record_type((Record)ptr) == Rectype_Fpointer))                  \
      { update_fp_invalid((Record)ptr); } # yes -> poss. invalidate           \
    else if (update_fsubr_function &&  # Fsubr ?                              \
             (record_type((Record)ptr) == Rectype_Fsubr))                     \
      { update_fs_function((Fsubr)ptr); } # yes -> poss. update address       \
   {var uintC count = (record_type((Record)ptr) < rectype_limit               \
                       ? srecord_length((Srecord)ptr)                         \
                       : xrecord_length((Xrecord)ptr));                       \
    if (count != 0) {                                                         \
      var gcv_object_t* p = &((Record)ptr)->recdata[0];                       \
      dotimespC(count,count, { update(p); p++; } );                           \
  }}} while(0)
# updates the object at 'ptr', whose typecode is given by 'type_expr'
# and advances ptr:
#ifdef SPVW_MIXED
 #ifdef TYPECODES
  #define update_varobject(type_expr)                                     \
   do { var tint type = (type_expr); # typeinfo                           \
        var uintL laenge = objsize((Varobject)ptr); # determine length    \
        var aint newptr = ptr+laenge; # pointer to next object            \
        # fall differentiation according to:                              \
        # symbol; simple-vector; non-simple array;                        \
        # Record (esp. hash-table); rest.                                 \
        switch (type) {                                                   \
         case_symbolwithflags: # Symbol: update all pointers              \
           do_update_symbol();                                            \
           break;                                                         \
          case_svector: # Simple-vector: update all pointers              \
           do_update_svector();                                           \
           break;                                                         \
          case_mdarray: case_obvector: case_ob2vector: case_ob4vector:    \
          case_ob8vector: case_ob16vector: case_ob32vector: case_ostring: \
          case_ovector: # non-simple array: update data vector            \
           do_update_iarray();                                            \
           break;                                                         \
          case_record: # Record: update all pointers                      \
           do_update_record();                                            \
           break;                                                         \
          default:  # all others contain no pointer that need update      \
           break; # -> do nothing                                         \
        }                                                                 \
        # advance to the next object                                      \
        ptr = newptr;                                                     \
   } while(0)
 #else # TYPECODES
  #define update_varobject(type_expr)                                   \
   do { var uintL laenge = objsize((Varobject)ptr); # determine length  \
        var aint newptr = ptr+laenge; # pointer to the next object      \
        switch (record_type((Record)ptr)) { # type of the next object   \
         case Rectype_mdarray:                                          \
         case Rectype_bvector:                                          \
         case Rectype_b2vector:                                         \
         case Rectype_b4vector:                                         \
         case Rectype_b8vector:                                         \
         case Rectype_b16vector:                                        \
         case Rectype_b32vector:                                        \
         case Rectype_reallocstring:                                    \
         case Rectype_string:                                           \
         case Rectype_vector:                                           \
         case Rectype_nilvector:                                        \
          # non-simple array: update data vector                        \
          do_update_iarray();                                           \
          break;                                                        \
         case Rectype_Svector:                                          \
          # Simple-vector: update all pointers                          \
          do_update_svector();                                          \
          break;                                                        \
         case Rectype_Sbvector:                                         \
         case Rectype_Sb2vector:                                        \
         case Rectype_Sb4vector:                                        \
         case Rectype_Sb8vector:                                        \
         case Rectype_Sb16vector:                                       \
         case Rectype_Sb32vector:                                       \
         case Rectype_S8string: case Rectype_Imm_S8string:              \
         case Rectype_S16string: case Rectype_Imm_S16string:            \
         case Rectype_S32string: case Rectype_Imm_S32string:            \
         case Rectype_Bignum: case Rectype_Ffloat:                      \
         case Rectype_Dfloat: case Rectype_Lfloat:                      \
         case Rectype_Snilvector:                                       \
          # these contain no pointers that need update -> do nothing    \
          break;                                                        \
         default: # Record: update all pointers                         \
          do_update_record();                                           \
          break;                                                        \
        }                                                               \
        # advance to the next object                                    \
        ptr = newptr;                                                   \
   } while(0)
 #endif # TYPECODES
 #define update_varobjects()  \
   for_each_varobject_page(page, update_page(page,update_varobject); )
#endif # SPVW_MIXED
#ifdef SPVW_PURE
 #define update_symbol(type_expr)  # ignores type_expr                    \
   do { var uintL laenge = objsize_symbol((void*)ptr); # determine length \
        var aint newptr = ptr+laenge; # pointer to the next object        \
        # Symbol: update all pointers                                     \
        do_update_symbol();                                               \
        ptr = newptr; # advance to the next object                        \
   } while(0)
 #define update_svector(type_expr)  # ignores type_expr                    \
   do { var uintL laenge = objsize_svector((void*)ptr); # determine length \
        var aint newptr = ptr+laenge; # pointer to the next object         \
        # Simple-vector: update all pointers                               \
        do_update_svector();                                               \
        ptr = newptr; # advance to the next object                         \
   } while(0)
 #define update_iarray(type_expr)  # ignores type_expr                    \
   do { var uintL laenge = objsize_iarray((void*)ptr); # determine length \
        var aint newptr = ptr+laenge; # pointer to the next object        \
        # non-simple array: update data vector                            \
        do_update_iarray();                                               \
        ptr = newptr; # advance to the next object                        \
   } while(0)
 #define update_record(type_expr)  # ignores type_expr                    \
   do { var uintL laenge = objsize_record((void*)ptr); # determine length \
        var aint newptr = ptr+laenge; # pointer to the next object        \
        # Record: update all pointers                                     \
        do_update_record();                                               \
        ptr = newptr; # advance to the next object                        \
   } while(0)
 #define update_varobjects()                                            \
   for_each_varobject_page(page,{                                       \
     # fall differentiation according to:                               \
     # symbol; simple-vector; non-simpler array;                        \
     # Record (esp. hash-table); rest.                                  \
     switch (heapnr) {                                                  \
      case_symbol: update_page(page,update_symbol); break;              \
      case_svector: update_page(page,update_svector); break;            \
      case_mdarray: case_obvector: case_ob2vector: case_ob4vector:      \
      case_ob8vector: case_ob16vector: case_ob32vector: case_ostring:   \
      case_ovector: update_page(page,update_iarray); break;             \
      case_record: update_page(page,update_record); break;              \
      default: # all others contain no pointer that need update         \
       break; # -> do nothing                                           \
   }})
#endif # SPVW_PURE

# update weak-pointer-list:
#define update_weakpointer(ww)                                            \
  do { var gcv_object_t* p = &TheRecord(ww)->recdata[weakpointer_length]; \
       var uintC count = weakpointer_xlength/sizeof(gcv_object_t);        \
       dotimespC(count,count,{ update(p); p++; });                        \
  } while(0)
#define update_weakpointers()                     \
  do { var object L = O(all_weakpointers);        \
       while (!eq(L,Fixnum_0)) {                  \
         update_weakpointer(L);                   \
         L = TheWeakpointer(L)->wp_cdr;           \
  }    } while(0)
#define update_weakpointers_mod()                         \
  do { var object L = O(all_weakpointers);                \
       while (!eq(L,Fixnum_0)) {                          \
         var object next = TheWeakpointer(L)->wp_cdr;     \
         update_weakpointer(L);                           \
         L = next;                                        \
  }    } while(0)

    # update weak key-value tables
#define update_weakkvtable(wkvt)                                       \
  do { # weak key-value table is just another fancy svector            \
    var gcv_object_t* p = TheSvector(wkvt)->data; # nothing GC-visible \
    var uintL count = Svector_length(wkvt);                            \
    dotimespL(count,count,{ update(p); p++; });                        \
  } while(0)
#define update_weakkvtables()                     \
  do { var object L = O(all_weakkvtables);        \
       while (!eq(L,Fixnum_0)) {                  \
         update_weakkvtable(L);                   \
         L = TheWeakKVT(L)->wkvt_cdr;             \
  }    } while(0)
#define update_weakkvtables_mod()                         \
  do { var object L = O(all_weakkvtables);                \
       while (!eq(L,Fixnum_0)) {                          \
         var object next = TheWeakKVT(L)->wkvt_cdr;       \
         update_weakkvtable(L);                           \
         L = next;                                        \
  }    } while(0)


# update STACKs :
#define update_stackobj_normal(objptr)    update(objptr);
#define update_STACKs()                                                       \
  for_all_STACKs(while (!eq(*objptr,nullobj)) { # until STACK is finished:    \
    if ( as_oint(*objptr) & wbit(frame_bit_o) ) { # here starts a frame?      \
      if (( as_oint(*objptr) & wbit(skip2_bit_o) ) == 0) # without skip2-Bit? \
        objptr skipSTACKop 2; # yes -> advance by 2                           \
      else                                                                    \
        objptr skipSTACKop 1; # no -> advance by 1                            \
    } else { # normal object, update:                                         \
      update_stackobj(objptr);                                                \
      objptr skipSTACKop 1; # advance                                         \
   }                                                                          \
  })

/* update back_traces */
#define update_back_traces()                                            \
  for_all_back_traces(for (;bt; bt=bt->bt_next)                         \
                        update((gcv_object_t*)&(bt->bt_caller)))
