Commit 62d27cc9 authored by Camil Staps's avatar Camil Staps 🚀

Merge branch 'cheney' into 'master'

Rewrite garbage collection algorithm

See merge request !99
parents 96f1d808 838c8518
Pipeline #20225 passed with stages
in 9 minutes and 49 seconds
......@@ -31,14 +31,6 @@ build-windows:
script:
- CC=x86_64-w64-mingw32-gcc OS=Windows_NT make -B -C src ByteCodeGenerator.exe ByteCodeLinker.exe interpret.exe
test-gc:
extends: .base
stage: test-interpreter
script:
- cd test
- CFLAGS=-DDEBUG_GARBAGE_COLLECTOR_MARKING ./run_tests.sh -o weird_types
- CFLAGS=-DDEBUG_GARBAGE_COLLECTOR_MARKING ./run_tests.sh -3 -o weird_types
benchmark-x64:
extends: .base
stage: test-interpreter
......
......@@ -44,12 +44,6 @@ preprocessor options on Windows.
As with `DEBUG_CLEAN_LINKS`, a higher value increases verbosity, with 0
turning off debugging output.
- `DEBUG_GARBAGE_COLLECTOR_MARKING`:
Try the garbage collector marking phase after each instruction cycle, to test
that it can deal (does not crash) with many different kinds of types. This is
very slow, and is only meant to be used in CI (see
[.gitlab-ci.yml](/.gitlab-ci.yml)).
- `STDERR_TO_FILE`:
Write output to `stderr` to a file called `stderr`. This is useful on
platforms with a slow console (e.g. Windows) to read back debugging
......
......@@ -105,7 +105,7 @@ deserialize` strict dsets {graph,descinfo,modules,bytecode} thisexe w
# graph_node = string_to_interpreter int_syms graph ie_settings
#! (ie,_) = make_finalizer ie_settings
# ie = {ie_finalizer=ie, ie_snode_ptr=0, ie_snodes=create_array_ 1}
= (Just (interpret ie (Finalizer 0 0 (graph_node + if strict 1 0))), w)
= (Just (interpret ie (Finalizer 0 0 (graph_node + if strict 2 0))), w)
where
getInterpreterSymbols :: !Pointer -> [Symbol]
getInterpreterSymbols pgm = takeWhile (\s -> size s.symbol_name <> 0)
......
......@@ -14,12 +14,10 @@ import code from "bcgen_instructions."
import code from "bytecode."
import code from "copy_host_to_interpreter."
import code from "copy_interpreter_to_host."
import code from "copy."
import code from "finalizers."
import code from "gc."
import code from "interface."
import code from "interpret."
import code from "mark."
import code from "parse."
import code from "strip."
import code from "util."
......
......@@ -91,14 +91,12 @@ DEP_BCSTRIP:=$(subst .c,.h,$(SRC_BCSTRIP)) settings.h
SRC_INTERPRET:=\
abc_instructions.c\
bytecode.c\
debug_find_nodes.c\
gc.c\
gc/copy.c\
gc/mark.c\
interpret.c\
parse.c\
util.c
DEP_INTERPRET:=$(subst .c,.h,$(SRC_INTERPRET))\
gc/util.h\
interpret_instructions.h\
interpret_instructions_interworking.h\
settings.h
......@@ -112,7 +110,6 @@ SRC_INTERPRET_LIB:=$(SRC_INTERPRET)\
ASM_INTERPRET_LIB:=$(subst .c,.s,$(SRC_INTERPRET_LIB))
OBJ_INTERPRET_LIB:=$(subst .c,.o,$(SRC_INTERPRET_LIB))
DEP_INTERPRET_LIB:=$(subst .c,.h,$(SRC_INTERPRET_LIB))\
gc/util.h\
interpret_instructions.h\
interpret_instructions_interworking.h\
settings.h
......
......@@ -48,8 +48,6 @@ library: .FORCE
copy_interpreter_to_host.c \
finalizers.c \
gc.c \
gc\copy.c \
gc\mark.c \
interpret.c \
parse.c \
strip.c \
......@@ -63,8 +61,6 @@ library: .FORCE
move copy_interpreter_to_host.obj "..\lib\Clean System Files" >nul
move finalizers.obj "..\lib\Clean System Files" >nul
move gc.obj "..\lib\Clean System Files" >nul
move copy.obj "..\lib\Clean System Files" >nul
move mark.obj "..\lib\Clean System Files" >nul
move interface.obj "..\lib\Clean System Files" >nul
move interpret.obj "..\lib\Clean System Files" >nul
move parse.obj "..\lib\Clean System Files" >nul
......
......@@ -12,7 +12,6 @@
#include "copy_interpreter_to_host.h"
#include "finalizers.h"
#include "gc.h"
#include "gc/util.h"
#include "interpret.h"
#include "util.h"
......@@ -994,7 +993,8 @@ int copy_to_host_or_garbage_collect(struct interpretation_environment *ie,
EXIT(NULL,1);
}
restore_and_translate_descriptors(ie->host->clean_ie, ie->program, node, hyperstrict_if_requested && ie->options.hyperstrict);
restore_and_translate_descriptors(ie->host->clean_ie, ie->program, node,
(hyperstrict_if_requested && ie->options.hyperstrict) ? 2 : 0);
return words_used;
}
......@@ -1013,8 +1013,8 @@ BC_WORD copy_interpreter_to_host(void *__dummy_0, void *__dummy_1,
struct InterpretationEnvironment *clean_ie, struct finalizers *node_finalizer) {
#endif
struct interpretation_environment *ie = (struct interpretation_environment*) clean_ie->__ie_finalizer->cur->arg;
int with_error_reporting=node_finalizer->cur->arg&1;
BC_WORD *node = (BC_WORD*)(node_finalizer->cur->arg&-2);
int with_error_reporting=(node_finalizer->cur->arg&2)>>1;
BC_WORD *node = (BC_WORD*)(node_finalizer->cur->arg&-3);
BC_WORD *old_asp=ie->asp;
......@@ -1074,8 +1074,8 @@ BC_WORD copy_interpreter_to_host_n(void *__dummy_0, void *__dummy_1,
struct InterpretationEnvironment *clean_ie, int n_args) {
#endif
struct interpretation_environment *ie = (struct interpretation_environment*) clean_ie->__ie_finalizer->cur->arg;
int with_error_reporting=node_finalizer->cur->arg&1;
BC_WORD *node = (BC_WORD*)(node_finalizer->cur->arg&-2);
int with_error_reporting=(node_finalizer->cur->arg&2)>>1;
BC_WORD *node = (BC_WORD*)(node_finalizer->cur->arg&-3);
BC_WORD *old_asp=ie->asp;
......@@ -1100,7 +1100,7 @@ BC_WORD copy_interpreter_to_host_n(void *__dummy_0, void *__dummy_1,
}
/* Update address since garbage collection may have run during copying */
node=(BC_WORD*)(node_finalizer->cur->arg&-2);
node=(BC_WORD*)(node_finalizer->cur->arg&-3);
*++ie->asp=(BC_WORD)node;
BC_WORD bootstrap;
......
......@@ -5,8 +5,7 @@
#include <string.h>
#include "abc_instructions.h"
#include "gc/mark.h"
#include "gc/util.h"
#include "debug_find_nodes.h"
#include "interpret.h"
#include "util.h"
......@@ -323,7 +322,7 @@ void wprint_node(WINDOW *win, BC_WORD *node, int with_arguments) {
wprintw(win, "CHAR '%c'", node[1]);
else if ((node[0]&-4)==(BC_WORD)&REAL)
wprintw(win, "REAL %f", *(BC_REAL*)&node[1]);
else if ((node[0]&-4)==(BC_WORD)&__cycle__in__spine)
else if ((node[0]&-4)==(BC_WORD)&__interpreter_cycle_in_spine)
wprintw(win, "_cycle_in_spine");
else {
char _tmp[256];
......@@ -511,7 +510,7 @@ void debugger_show_node_as_tree_(WINDOW *win, BC_WORD *node, int indent, uint64_
return;
}
if (node[0] == (BC_WORD) &__cycle__in__spine) {
if (node[0] == (BC_WORD) &__interpreter_cycle_in_spine) {
wprintw(win, " _cycle_in_spine");
return;
}
......@@ -561,7 +560,7 @@ void debugger_show_node_as_tree_(WINDOW *win, BC_WORD *node, int indent, uint64_
wprintw(win, " %s", _tmp);
}
if (on_heap((BC_WORD) node, hp, heap_size))
if (hp<=node && node<hp+heap_size)
wprintw(win, " {%d}", node - hp);
waddch(win, '\n');
......
#include <stdlib.h>
#include "mark.h"
#include "debug_find_nodes.h"
#include "interpret.h"
#include "util.h"
#include "../interpret.h"
#include "../util.h"
#ifdef LINK_CLEAN_RUNTIME
# include "../copy_interpreter_to_host.h"
# include "../finalizers.h"
#endif
#define GREY_NODES_INITIAL 100
#define GREY_NODES_ENLARGE 2
......@@ -22,9 +16,6 @@ void init_nodes_set(struct nodes_set *set, size_t heap_size) {
set->black.bitmap = safe_calloc(1, (heap_size / 8 / sizeof(BC_WORD) + 2) * sizeof(BC_WORD));
set->black.size = heap_size / 8 / sizeof(BC_WORD) + 1;
#if DEBUG_GARBAGE_COLLECTOR > 4
EPRINTF("\tBitmap size = %d\n", (int) set->black.size);
#endif
set->black.ptr_i = 0;
set->black.ptr_j = 0;
}
......@@ -34,19 +25,11 @@ void free_nodes_set(struct nodes_set *set) {
free(set->black.bitmap);
}
void reset_black_nodes_set(struct nodes_set *set) {
set->black.ptr_i = 0;
set->black.ptr_j = 0;
}
/* Returns 1 if the node is new; 0 if it was already black */
int add_black_node(struct nodes_set *set, BC_WORD *node, BC_WORD *heap) {
BC_WORD val = ((BC_WORD) node - (BC_WORD) heap) / sizeof(BC_WORD);
BC_WORD i = val / 8 / sizeof(BC_WORD);
BC_WORD m = (BC_WORD) 1 << (val % (8 * sizeof(BC_WORD)));
#if DEBUG_GARBAGE_COLLECTOR > 4
EPRINTF("\t\tbitmap[%d] |= %x\n", (int) i, (int) m);
#endif
if (set->black.bitmap[i] & m) {
return 0;
} else {
......@@ -56,9 +39,6 @@ int add_black_node(struct nodes_set *set, BC_WORD *node, BC_WORD *heap) {
}
BC_WORD next_black_node(struct nodes_set *set) {
#if DEBUG_GARBAGE_COLLECTOR > 4
EPRINTF("\tSearching with %d/%d\n", (int) set->black.ptr_i, (int) set->black.ptr_j);
#endif
if (set->black.ptr_i > set->black.size)
return -1;
while (!(set->black.bitmap[set->black.ptr_i] & ((BC_WORD) 1 << set->black.ptr_j))) {
......@@ -71,9 +51,6 @@ BC_WORD next_black_node(struct nodes_set *set) {
return -1;
} while (!set->black.bitmap[set->black.ptr_i]);
}
#if DEBUG_GARBAGE_COLLECTOR > 4
EPRINTF("\tSearching with %d/%d\n", (int) set->black.ptr_i, (int) set->black.ptr_j);
#endif
}
BC_WORD ret = 8 * sizeof(BC_WORD) * set->black.ptr_i + set->black.ptr_j;
......@@ -88,9 +65,6 @@ BC_WORD next_black_node(struct nodes_set *set) {
}
void realloc_grey_nodes_set(struct nodes_set *set) {
#if DEBUG_GARBAGE_COLLECTOR > 1
EPRINTF("\tReallocating grey nodes set\n");
#endif
set->grey.write_ptr = set->grey.size;
set->grey.read_ptr = 0;
set->grey.size *= GREY_NODES_ENLARGE;
......@@ -99,16 +73,10 @@ void realloc_grey_nodes_set(struct nodes_set *set) {
void add_grey_node(struct nodes_set *set, BC_WORD *node, BC_WORD *heap, size_t heap_size) {
if (node < heap || node >= heap + heap_size) {
#if DEBUG_GARBAGE_COLLECTOR > 2
EPRINTF("\t%p is not on the heap...\n", (void*) node);
#endif
return;
}
if (!add_black_node(set, node, heap)) { /* Already black */
#if DEBUG_GARBAGE_COLLECTOR > 2
EPRINTF("\t%p is already black...\n", (void*) node);
#endif
return;
}
......@@ -116,9 +84,6 @@ void add_grey_node(struct nodes_set *set, BC_WORD *node, BC_WORD *heap, size_t h
realloc_grey_nodes_set(set);
}
#if DEBUG_GARBAGE_COLLECTOR > 2
EPRINTF("\t%p -> grey\n", (void*) node);
#endif
set->grey.nodes[set->grey.write_ptr++] = node;
if (set->grey.write_ptr == set->grey.size)
set->grey.write_ptr = 0;
......@@ -143,32 +108,10 @@ BC_WORD *get_grey_node(struct nodes_set *set) {
void mark_a_stack(BC_WORD *stack, BC_WORD *asp, BC_WORD *heap, size_t heap_size, struct nodes_set *set) {
BC_WORD *asp_temp;
#ifdef LINK_CLEAN_RUNTIME
for (asp_temp = asp; asp_temp >= stack; asp_temp--)
#else
for (asp_temp = asp; asp_temp > stack; asp_temp--)
#endif
add_grey_node(set, (BC_WORD*) *asp_temp, heap, heap_size);
}
void mark_cafs(void **cafs, BC_WORD *heap, size_t heap_size, struct nodes_set *set) {
BC_WORD **cafptr=(BC_WORD**)&cafs[1];
while (cafptr[-1]!=0) {
cafptr=(BC_WORD**)cafptr[-1];
int n_a=(int)(BC_WORD)cafptr[0];
for (; n_a>0; n_a--)
add_grey_node(set, cafptr[n_a], heap, heap_size);
}
}
#ifdef LINK_CLEAN_RUNTIME
void mark_host_references(BC_WORD *heap, size_t heap_size, struct nodes_set *set) {
struct finalizers *finalizers = NULL;
while ((finalizers = next_interpreter_finalizer(finalizers)) != NULL)
add_grey_node(set, (BC_WORD*)(finalizers->cur->arg&-2), heap, heap_size);
}
#endif
void evaluate_grey_nodes(BC_WORD *heap, size_t heap_size, struct nodes_set *set) {
BC_WORD *node;
while ((node = get_grey_node(set)) != NULL) {
......@@ -182,10 +125,6 @@ void evaluate_grey_nodes(BC_WORD *heap, size_t heap_size, struct nodes_set *set)
b_arity = ((int16_t*)(node[0]))[-1] - 256 - a_arity;
}
#if DEBUG_GARBAGE_COLLECTOR > 2
EPRINTF("\t%p -> black: "BC_WORD_FMT_HEX"; HNF with arity %d/%d\n", (void*) node, node[0], a_arity, b_arity);
#endif
if (node[0] == (BC_WORD) &INT + 2 ||
node[0] == (BC_WORD) &CHAR + 2 ||
node[0] == (BC_WORD) &BOOL + 2 ||
......@@ -225,9 +164,6 @@ void evaluate_grey_nodes(BC_WORD *heap, size_t heap_size, struct nodes_set *set)
}
}
} else { /* thunk */
if (node[0]==(BC_WORD)&__cycle__in__spine)
continue;
int16_t arity = ((int16_t*)(node[0]))[-1];
if (arity < 0) {
a_arity = 1;
......@@ -237,10 +173,6 @@ void evaluate_grey_nodes(BC_WORD *heap, size_t heap_size, struct nodes_set *set)
a_arity = (arity & 0xff) - b_arity;
}
#if DEBUG_GARBAGE_COLLECTOR > 2
EPRINTF("\t%p -> black: "BC_WORD_FMT_HEX"; thunk with arity %d/%d\n", (void*) node, node[0], a_arity, b_arity);
#endif
int i;
for (i = 1; i <= a_arity; i++)
add_grey_node(set, (BC_WORD*) node[i], heap, heap_size);
......
#pragma once
#include "../bytecode.h"
#include "bytecode.h"
struct nodes_set {
struct {
......@@ -22,18 +22,7 @@ struct nodes_set {
void init_nodes_set(struct nodes_set *set, size_t heap_size);
void free_nodes_set(struct nodes_set *set);
void reset_black_nodes_set(struct nodes_set *set);
/* Returns 1 if the node is new; 0 if it was already black */
int add_black_node(struct nodes_set *set, BC_WORD *node, BC_WORD *heap);
BC_WORD next_black_node(struct nodes_set *set);
void add_grey_node(struct nodes_set *set, BC_WORD *node, BC_WORD *heap, size_t heap_size);
BC_WORD *get_grey_node(struct nodes_set *set);
void mark_a_stack(BC_WORD *stack, BC_WORD *asp, BC_WORD *heap, size_t heap_size, struct nodes_set *set);
void mark_cafs(void **cafs, BC_WORD *heap, size_t heap_size, struct nodes_set *set);
#ifdef LINK_CLEAN_RUNTIME
void mark_host_references(BC_WORD *heap, size_t heap_size, struct nodes_set *set);
#endif
void evaluate_grey_nodes(BC_WORD *heap, size_t heap_size, struct nodes_set *set);
#include <stdlib.h>
#include <string.h>
#include "gc.h"
#include "gc/copy.h"
#if DEBUG_GARBAGE_COLLECTOR > 0
# include "util.h"
#endif
#ifdef LINK_CLEAN_RUNTIME
# define UPDATE_REF update_ref
#else
# define UPDATE_REF(old,heap_size,ref,hp,snoh) update_ref(old,heap_size,ref,hp)
#endif
static inline BC_WORD *update_ref(BC_WORD *old, size_t heap_size,
BC_WORD **ref, BC_WORD *hp
#ifdef LINK_CLEAN_RUNTIME
, BC_WORD **shared_nodes_of_host
#endif
) {
BC_WORD *n,d;
int16_t ab_arity;
n=*ref;
if (!(old<=n && n<old+heap_size))
return hp;
d=n[0];
if (d & 1) {
*ref=(BC_WORD*)(d-1);
return hp;
}
*ref=hp;
hp[0]=d;
*n=(BC_WORD)hp+1;
#if DEBUG_GARBAGE_COLLECTOR > 1
EPRINTF ("%p <- %p (d %p)\n",hp,n,(void*)d);
#endif
if (d & 2) {
if (d == (BC_WORD)&INT+2
|| d == (BC_WORD)&BOOL+2
|| d == (BC_WORD)&CHAR+2
|| d == (BC_WORD)&REAL+2) {
hp[1]=n[1];
return &hp[2];
} else if (d == (BC_WORD)&__STRING__+2) {
unsigned int size=n[1];
size=(size+IF_INT_64_OR_32(7,3))/IF_INT_64_OR_32(8,4);
memcpy (&hp[1],&n[1],(size+1)*sizeof(BC_WORD));
return &hp[2+size];
} else if (d == (BC_WORD)&__ARRAY__+2) {
unsigned int size=n[1];
d=n[2];
if (d == (BC_WORD)&INT+2
|| d == (BC_WORD)&REAL+2
|| d == 0) {
/* size is correct */
} else if (d == (BC_WORD)&BOOL+2) {
size=(size+IF_INT_64_OR_32(7,3))/IF_INT_64_OR_32(8,4);
} else {
size*=(((int16_t*)d)[-1]-256);
}
memcpy (&hp[1],&n[1],(size+2)*sizeof(BC_WORD));
return &hp[3+size];
}
#ifdef LINK_CLEAN_RUNTIME
if ((BC_WORD)HOST_NODE_DESCRIPTORS <= d &&
d <= (BC_WORD)HOST_NODE_DESCRIPTORS+sizeof(HOST_NODE_DESCRIPTORS)) {
int host_nodeid=((BC_WORD*)n[1])[1];
shared_nodes_of_host[host_nodeid]=(BC_WORD*)((BC_WORD)shared_nodes_of_host[host_nodeid]|1);
}
#endif
/* Not a built-in type */
ab_arity=((int16_t*)d)[-1];
if (ab_arity>256) /* records */
ab_arity-=256;
#if DEBUG_GARBAGE_COLLECTOR > 2
EPRINTF ("\thnf %d\n",ab_arity);
#endif
hp[1]=n[1];
if (ab_arity>2) { /* hnf spread over two blocks */
hp[2]=(BC_WORD)&hp[3];
hp+=3;
n=(BC_WORD*)n[2];
ab_arity--;
for (int i=0; i<ab_arity; i++)
hp[i]=n[i];
return &hp[ab_arity];
} else {
hp[2]=n[2];
return &hp[ab_arity+1];
}
} else {
ab_arity=((int16_t*)d)[-1];
#if DEBUG_GARBAGE_COLLECTOR > 2
EPRINTF ("\tthunk %d\n",ab_arity);
#endif
if (ab_arity<0) /* negative for selectors etc. */
ab_arity=1;
ab_arity&=0xff;
#ifdef LINK_CLEAN_RUNTIME
if (d == (BC_WORD)&HOST_NODE_INSTRUCTIONS[1]) {
int host_nodeid=n[1];
shared_nodes_of_host[host_nodeid]=(BC_WORD*)((BC_WORD)shared_nodes_of_host[host_nodeid]|1);
}
#endif
for (int i=1; i<=ab_arity; i++)
hp[i]=n[i];
return &hp[ab_arity>2 ? (ab_arity+1) : 3];
}
}
BC_WORD *garbage_collect(BC_WORD *stack, BC_WORD *asp,
BC_WORD *heap, size_t heap_size, BC_WORD_S *heap_free,
void **cafs, struct interpretation_options *options
......@@ -16,13 +134,168 @@ BC_WORD *garbage_collect(BC_WORD *stack, BC_WORD *asp,
#endif
) {
#if DEBUG_GARBAGE_COLLECTOR > 0
EPRINTF("Collecting trash... stack @ %p; heap @ %p; code @ %p; data @ %p\n",
EPRINTF ("Collecting trash... stack @ %p; heap @ %p; code @ %p; data @ %p\n",
(void*) stack, (void*) heap, (void*) code, (void*) data);
#endif
return collect_copy(stack, asp, heap, heap_size, heap_free, cafs, options
BC_WORD *old=options->in_first_semispace ? heap : heap+heap_size;
BC_WORD *new=options->in_first_semispace ? heap+heap_size : heap;
BC_WORD *n,d;
int16_t ab_arity,a_arity;
#if DEBUG_GARBAGE_COLLECTOR > 1
EPRINTF ("Copying A stack roots...\n");
#endif
for (;
#ifdef LINK_CLEAN_RUNTIME
asp>=stack;
#else
asp!=stack;
#endif
asp--)
new=UPDATE_REF (old,heap_size,(BC_WORD**)asp,new,shared_nodes_of_host);
#if DEBUG_GARBAGE_COLLECTOR > 1
EPRINTF ("Copying CAF roots...\n");
#endif
BC_WORD **cafptr=(BC_WORD**)&cafs[1];
while (cafptr[-1]!=0) {
cafptr=(BC_WORD**)cafptr[-1];
for (a_arity=(int16_t)(BC_WORD)cafptr[0]; a_arity>0; a_arity--)
new=UPDATE_REF (old,heap_size,(BC_WORD**)&cafptr[a_arity],new,shared_nodes_of_host);
}
#ifdef LINK_CLEAN_RUNTIME
#if DEBUG_GARBAGE_COLLECTOR > 1
EPRINTF ("Copying shared node roots (%p)...\n",interpreter_finalizer);
#endif
struct finalizers *finalizers=NULL;
while ((finalizers=next_interpreter_finalizer(finalizers)) != NULL) {
BC_WORD ref=finalizers->cur->arg;
if (ref & 2) { /* hyperstrict reference */
ref-=2;
new=UPDATE_REF (old,heap_size,(BC_WORD**)&ref,new,shared_nodes_of_host);
finalizers->cur->arg=ref+2;
} else {
new=UPDATE_REF (old,heap_size,(BC_WORD**)&finalizers->cur->arg,new,shared_nodes_of_host);
}
}
#endif
#if DEBUG_GARBAGE_COLLECTOR > 1
EPRINTF ("Breadth-first search of child nodes...\n");
#endif
n=options->in_first_semispace ? heap+heap_size : heap;
while (n<new) {
d=n[0];
#if DEBUG_GARBAGE_COLLECTOR > 1
EPRINTF ("%p Update %p (d %p)\n",new,n,(void*)d);
#endif
if (d & 2) {
if (d == (BC_WORD)&INT+2
|| d == (BC_WORD)&BOOL+2
|| d == (BC_WORD)&CHAR+2
|| d == (BC_WORD)&REAL+2) {
n+=2;
continue;
} else if (d == (BC_WORD)&__STRING__+2) {
unsigned int size=n[1];
size=(size+IF_INT_64_OR_32(7,3))/IF_INT_64_OR_32(8,4);
n=&n[2+size];
continue;
} else if (d == (BC_WORD)&__ARRAY__+2) {
unsigned int size;
size=n[1];
d=n[2];
if (d == 0) {
ab_arity=a_arity=1;
} else if (d == (BC_WORD)&INT+2
|| d == (BC_WORD)&REAL+2) {
n=&n[3+size];
continue;
} else if (d == (BC_WORD)&BOOL+2) {
size=(size+IF_INT_64_OR_32(7,3))/IF_INT_64_OR_32(8,4);
n=&n[3+size];
continue;
} else {
ab_arity=((int16_t*)d)[-1]-256;
a_arity=((int16_t*)d)[0];
}
if (a_arity==0) {
n=&n[3+size*ab_arity];
continue;
}
n=&n[3];
for (; size>0; size--) {
for (d=0; d<a_arity; d++)
new=UPDATE_REF (old,heap_size,(BC_WORD**)&n[d],new,shared_nodes_of_host);
n=&n[ab_arity];
}
continue;
}
/* Not a built-in type */
a_arity=ab_arity=((int16_t*)d)[-1];
if (ab_arity>256) { /* records */
ab_arity-=256;
a_arity=((int16_t*)d)[0];
}
if (ab_arity>2) { /* hnf spread over two blocks */
if (a_arity>0) {
new=UPDATE_REF (old,heap_size,(BC_WORD**)&n[1],new,shared_nodes_of_host);
while (--a_arity)
new=UPDATE_REF (old,heap_size,(BC_WORD**)&n[2+a_arity],new,shared_nodes_of_host);
}
n+=2+ab_arity;
continue;
} else {
if (a_arity>0) {
new=UPDATE_REF (old,heap_size,(BC_WORD**)&n[1],new,shared_nodes_of_host);
if (a_arity==2)