~burner/xsb/debianized-xsb

« back to all changes in this revision

Viewing changes to emu/heap_xsb.c

  • Committer: Michael R. Head
  • Date: 2006-09-06 22:11:55 UTC
  • Revision ID: burner@n23-20060906221155-7e398d23438a7ee4
Add the files from the 3.0.1 release package

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
/* File:      heap_xsb.c
 
2
** Author(s): Bart Demoen, Kostis Sagonas
 
3
** Contact:   xsb-contact@cs.sunysb.edu
 
4
** 
 
5
** Copyright (C) The Research Foundation of SUNY, 1998
 
6
** Copyright (C) K.U. Leuven, 1998-1999
 
7
** 
 
8
** XSB is free software; you can redistribute it and/or modify it under the
 
9
** terms of the GNU Library General Public License as published by the Free
 
10
** Software Foundation; either version 2 of the License, or (at your option)
 
11
** any later version.
 
12
** 
 
13
** XSB is distributed in the hope that it will be useful, but WITHOUT ANY
 
14
** WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 
15
** FOR A PARTICULAR PURPOSE.  See the GNU Library General Public License for
 
16
** more details.
 
17
** 
 
18
** You should have received a copy of the GNU Library General Public License
 
19
** along with XSB; if not, write to the Free Software Foundation,
 
20
** Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
21
**
 
22
** $Id: heap_xsb.c,v 1.52 2006/06/21 20:17:11 dwarren Exp $
 
23
** 
 
24
*/
 
25
 
 
26
 
 
27
/*************************************************************************
 
28
 * This module provides:
 
29
 
 
30
        reallocation of the heap/environment area
 
31
        -----------------------------------------
 
32
        Function glstack_realloc(new_size,arity)
 
33
                originally written by E. Johnson in file
 
34
                memory_xsb.c, but completely redone by Bart Demoen
 
35
 
 
36
        heap garbage collection
 
37
        -----------------------
 
38
        Function gc_heap(arity,IfStringGC) - 
 
39
           To understand the usefulness logic, see paper:
 
40
                B. Demoen and K. Sagonas.
 
41
                Memory Management for Prolog with Tabling.
 
42
                in Proceedings of the 1998 ACM SIGPLAN International
 
43
                Symposium on Memory Management, Vancouver, B.C., Canada,
 
44
                Oct. 1998. ACM Press. p. 97-106
 
45
 
 
46
           To understand the implementation and for additional information see:
 
47
                B. Demoen and K. Sagonas.
 
48
                Heap Garbage Collection in XSB: Practice and Experience.
 
49
                CW report 272, September 1998; finished February 1999.
 
50
 
 
51
 
 
52
        Function slide_heap() implements a sliding collector a la Morris
 
53
           It was mostly written by Bart Demoen
 
54
               for a Prolog specific one see paper:
 
55
               K. Appleby, M. Carlsson, S. Haridi, and D. Sahlin.
 
56
               Garbage Collection for Prolog Based on WAM.
 
57
               Communications of the ACM, 31(6):719--741, June 1988.
 
58
 
 
59
 
 
60
        Function copy_heap() implements a copying collector a la Cheney
 
61
           It was mostly written by Kostis Sagonas
 
62
               for a Prolog specific one see paper:
 
63
               J. Bevemyr and T. Lindgren.
 
64
               A Simple and Efficient Copying Garbage Collector for Prolog.
 
65
               In M. Hermenegildo and J. Penjam, editors,
 
66
               Proceedings of the Sixth International Symposium on
 
67
               Programming Language Implementation and Logic Programming,
 
68
               number 844 in LNCS, pages 88--101, Madrid, Spain, Sept.  1994.
 
69
               Springer-Verlag.
 
70
 
 
71
 
 
72
        printing routines for some areas
 
73
                print_heap
 
74
                print_ls
 
75
                print_cp
 
76
                print_regs
 
77
                print_tr
 
78
                print_all_stacks: does all of the above
 
79
        some - maybe all - of these were somewhere in the system already
 
80
                but weren't entirely what we needed
 
81
 
 
82
 
 
83
Todo:
 
84
        adapt the garbage collectors to SLG-WAM
 
85
        provide a decent user interface to the garbage collector
 
86
        integrate with compiler
 
87
 
 
88
****************************************************************************/
 
89
/****************************************************************************
 
90
String table garbage collection, by mark and collect.  
 
91
 
 
92
First mark all strings in use.  A string Cell is a tagged pointer to a
 
93
sequence of chars, word aligned.  The previous word is the link
 
94
pointer in the hash bucket chain.  Use the lowest bit in that pointer
 
95
as the mark bit.  When marking what looks like a string, be sure it is
 
96
a indeed a string by comparing it to the result of calling
 
97
string_find.
 
98
 
 
99
Mark: 
 
100
 
 
101
a) Piggyback on marking of heap gc to mark all strings accessible
 
102
from stacks and trail.
 
103
 
 
104
b) Mark tries by running trie-node blocks rooted at smTableBTN,
 
105
smTSTN, and smAssertBTN.  Changed trie-node free to set 2nd word in
 
106
trie node to distinctive pattern (-1), so know to skip those nodes.
 
107
(NOT DONE: At the same time could free blocks all of whose nodes are free.  
 
108
Mark 2nd work in freed nodes in to-be-freed blocks (-2?), and run free
 
109
chain to remove them.  Then free the blocks.)
 
110
 
 
111
c) Mark all strings in code by running atom-table to get entry points,
 
112
including through private dispatch tables, and then scanning the code
 
113
for instructions containing strings.
 
114
 
 
115
d) Mark all strings in findall buffers by running them.
 
116
 
 
117
e) Mark strings that are used as filenames for open files.
 
118
 
 
119
f) Mark strings used as hash-keys in hashtables.
 
120
 
 
121
g) NOT DONE: Consider ways to deal with string pointers given to C programs in
 
122
ptoc_string.
 
123
 
 
124
Collect: run through the string table, freeing unmarked strings and
 
125
unmarking marked strings.
 
126
 
 
127
****************************************************************************/
 
128
 
 
129
/* xsb_config.h must be the first #include. Pls don't move it. */
 
130
#include "xsb_config.h"
 
131
#include "xsb_debug.h"
 
132
 
 
133
#include <string.h>
 
134
#include <stdlib.h>
 
135
#include <sys/stat.h>
 
136
 
 
137
/* Take care of the time.h business */
 
138
/* #include "xsb_time.h" */
 
139
/* But I need time.h, not sys/time.h here! -lfcastro */
 
140
#include <time.h>
 
141
 
 
142
#include "auxlry.h"
 
143
#include "cell_xsb.h"
 
144
#include "memory_xsb.h"
 
145
#include "inst_xsb.h"
 
146
 
 
147
/* For Reallocation Routines
 
148
   ------------------------- */
 
149
#include <stdio.h>         /* for printf and friends */
 
150
 
 
151
#include "register.h"      /* breg, trreg */
 
152
#include "psc_xsb.h"       /* needed by "tries.h" and "macro_xsb.h" */
 
153
#include "tries.h"         /* needed by "choice.h" */
 
154
#include "choice.h"        /* choice point structures and macros */
 
155
#include "error_xsb.h"     /* xsb_exit() and friends */
 
156
#include "macro_xsb.h"     /* Completion Stack and Subgoal Frame def's */
 
157
#include "realloc.h"       /* Heap - ls reallocation macros */
 
158
#include "flags_xsb.h"     /* for checking whether functionality is enabled */
 
159
#include "heap_xsb.h"
 
160
#include "io_builtins_xsb.h"
 
161
#include "subp.h"          /* for attv_interrupts[][] */
 
162
#include "binding.h"       /* for PRE_IMAGE_TRAIL */
 
163
#include "thread_xsb.h"    /* for mutex definitions */
 
164
#include "debug_xsb.h"
 
165
#include "loader_xsb.h" /* for ZOOM_FACTOR, used in stack expansion */
 
166
#include "struct_manager.h"
 
167
#include "hash_xsb.h"
 
168
/*=========================================================================*/
 
169
 
 
170
/* this might belong somewhere else (or should be accessible to init.c),
 
171
   but in the meantime, this will do */
 
172
#ifdef GC
 
173
static float mark_threshold = 0.9F;
 
174
#endif
 
175
 
 
176
#ifdef DEBUG_VM
 
177
#define GC_PROFILE
 
178
#endif
 
179
 
 
180
#ifdef GC_PROFILE
 
181
 
 
182
static char count_chains=0, examine_data=0, verbose_gc=0;
 
183
unsigned long chains[64];
 
184
unsigned long tag_examined[9];
 
185
unsigned long deep_mark;
 
186
unsigned long current_mark;
 
187
unsigned long old_gens;
 
188
unsigned long current_gen;
 
189
CPtr start_hbreg;
 
190
unsigned long functor;
 
191
unsigned long chain_from_ls;
 
192
unsigned long active_cps, frozen_cps;
 
193
void print_cpf_pred(CPtr cpf);
 
194
 
 
195
#endif /* GC_PROFILE */
 
196
 
 
197
extern void extend_enc_dec_as_nec(void *,void *);
 
198
extern void free_unused_strings();
 
199
extern void mark_nonheap_strings(CTXTdecl);
 
200
 
 
201
/*=========================================================================*/
 
202
 
 
203
/* to choose between copying or sliding collector:
 
204
   its value is determined based on the the value of pflags[GARBAGE_COLLECT] */
 
205
static xsbBool slide;
 
206
 
 
207
#ifdef GC
 
208
/* measuring fragmentation without collection - it also sets slide = 0 */
 
209
static const int fragmentation_only = 0;
 
210
#endif
 
211
                      
 
212
/* choose to do early reset or not */
 
213
/* #define EARLY_RESET 1 */
 
214
 
 
215
 
 
216
/* expresses how often early reset of a trailed heap cell occurs */
 
217
static int heap_early_reset;
 
218
 
 
219
/* expresses how often early reset of a trailed local stack cell occurs */
 
220
static int ls_early_reset;
 
221
 
 
222
 
 
223
/* ways to count gc and control the output during a gc */
 
224
static int printnum = 0 ;
 
225
 
 
226
#ifdef DEBUG_VERBOSE
 
227
static int print_at = 0 ; /* at the print_at-th gc, the stacks are printed */
 
228
static int print_after = 0 ; /* if non zero, print all after this numgc */
 
229
static int print_anyway = 0 ;
 
230
 
 
231
#define print_on_gc \
 
232
        ((print_at == num_gc) \
 
233
         || ((print_after > 0) && (print_after <= num_gc)) \
 
234
         || print_anyway)
 
235
#else
 
236
#define print_on_gc 0
 
237
#endif
 
238
 
 
239
/* Whether to garbage collect strings on this heap gc or not. */
 
240
int gc_strings = FALSE;
 
241
 
 
242
static long last_string_space_size = 10000;
 
243
static long last_assert_space_size = 10000;
 
244
#define AUTO_STRING_GC_NTH 10
 
245
 
 
246
/******* When to GC string space? *************/
 
247
int should_gc_strings() {
 
248
  static int till_forced_string_gc = 1;  /* string collect first time */
 
249
 
 
250
  /* every AUTO_STRING_GC_NTH time that heap gc is done, regardless */
 
251
  if (!(--till_forced_string_gc)) {
 
252
    till_forced_string_gc = AUTO_STRING_GC_NTH;
 
253
    //    printf("should_gc_strings: cycle\n");
 
254
    return TRUE;
 
255
  }
 
256
  /* if already requested by someone else, do it. */
 
257
  if (gc_strings) {
 
258
    till_forced_string_gc = AUTO_STRING_GC_NTH;
 
259
    //    printf("should_gc_strings: requested\n");
 
260
    return TRUE;
 
261
  }
 
262
  /* if string_space has doubled, but assert space hasn't, since last string gc */
 
263
  if ((pspacesize[STRING_SPACE] > 2*last_string_space_size) &&
 
264
      (pspacesize[ASSERT_SPACE] < 2*last_assert_space_size)) {
 
265
    till_forced_string_gc = AUTO_STRING_GC_NTH;
 
266
    //    printf("should_gc_strings: strings grew\n");
 
267
    return TRUE;
 
268
  }
 
269
  /* if assert space has shrunk alot */
 
270
  if (pspacesize[ASSERT_SPACE] < last_assert_space_size/4 ||
 
271
      (last_assert_space_size - pspacesize[ASSERT_SPACE]) > 1000000) {
 
272
    till_forced_string_gc = AUTO_STRING_GC_NTH;
 
273
    //    printf("should_gc_strings: assert shrunk\n");
 
274
    return TRUE;
 
275
  }
 
276
  return FALSE;
 
277
}
 
278
 
 
279
 
 
280
/* if SAFE_GC is defined, some more checks are made after gargage collection */
 
281
/* #define SAFE_GC */
 
282
/* #define DEBUG_ASSERTIONS */
 
283
 
 
284
/* if VERBOSE_GC is defined, garbage collection prints its statistics */
 
285
/* #define VERBOSE_GC */
 
286
 
 
287
 
 
288
/*---------------------------------------------------------------------------*/
 
289
/* global variables for top and bottom of some areas + macro to compute them */
 
290
/*---------------------------------------------------------------------------*/
 
291
 
 
292
static CPtr heap_bot,heap_top,
 
293
  ls_bot,ls_top,
 
294
  tr_bot,tr_top,
 
295
  cp_bot,cp_top,
 
296
  compl_top,compl_bot;
 
297
static unsigned long heap_marks_size;
 
298
 
 
299
 
 
300
#define stack_boundaries \
 
301
  heap_top = hreg; \
 
302
  ls_top = top_of_localstk - 256;  /* extra space for environment above top */ \
 
303
  if (ls_top < heap_top) xsb_exit("Heap and local stack are clobbered"); \
 
304
  heap_bot = (CPtr)glstack.low ; \
 
305
  ls_bot = (CPtr)glstack.high - 1 ; \
 
306
  tr_top = (CPtr)(top_of_trail) /*- 1*/ ; \
 
307
  tr_bot = (CPtr)tcpstack.low ; \
 
308
  cp_bot = (CPtr)tcpstack.high - 1 ; \
 
309
  cp_top = top_of_cpstack ; \
 
310
  compl_top = (CPtr)complstack.low ; /* NOT top_of_complstk !!! */\
 
311
  compl_bot = (CPtr)complstack.high ;
 
312
 
 
313
#define points_into_heap(p)  ((heap_bot <= p) && (p < heap_top))
 
314
#define points_into_ls(p)    ((ls_top <= p) && (p <= ls_bot))
 
315
#define points_into_cp(p)    ((cp_top <= p) && (p <= cp_bot))
 
316
#define points_into_tr(p)    ((tr_bot <= p) && (p <= tr_top))
 
317
#define points_into_compl(p) ((compl_top <= p) && (p <= compl_bot))
 
318
 
 
319
/*======================================================================*/
 
320
/* global variables used for statistics.                                */
 
321
/*======================================================================*/
 
322
 
 
323
#ifndef MULTI_THREAD
 
324
static double total_time_gc = 0 ;
 
325
static unsigned long total_collected = 0 ;
 
326
static int num_gc = 0 ;
 
327
#endif
 
328
 
 
329
/*----------------------------------------------------------------------*/
 
330
/* marker bits in different areas.                                      */
 
331
/*----------------------------------------------------------------------*/
 
332
 
 
333
static char *heap_marks  = NULL ;
 
334
static char *ls_marks    = NULL ;
 
335
static char *tr_marks    = NULL ;
 
336
static char *cp_marks    = NULL ;
 
337
 
 
338
#define INDIRECTION_SLIDE
 
339
#ifdef INDIRECTION_SLIDE
 
340
static CPtr *slide_buf= NULL;
 
341
static unsigned long slide_top = 0;
 
342
static int slide_buffering = 0;
 
343
static unsigned long slide_buf_size = 0;
 
344
#endif
 
345
 
 
346
#define MARKED    1
 
347
#define TRAIL_PRE 2
 
348
#define CHAIN_BIT 4                            
 
349
 
 
350
/* in the absence of serious bugs, the test is an invariant of the WAM */
 
351
#ifdef DEBUG_ASSERTIONS
 
352
#define testreturnit(retp)   if (points_into_heap(retp)) return(retp)
 
353
#else
 
354
#define testreturnit(retp)   return(retp)
 
355
#endif
 
356
 
 
357
/*=========================================================================*/
 
358
/* GC-specific includes */
 
359
#include "gc_profile.h"
 
360
#include "gc_mark.h"
 
361
#include "gc_print.h"
 
362
#include "gc_slide.h"
 
363
#include "gc_copy.h"
 
364
/*=========================================================================*/
 
365
 
 
366
 
 
367
/*==========================================================================
 
368
        new_size = new size of heap + environmentstack
 
369
        arity = number of argument registers in use at moment of call
 
370
 
 
371
        assumption: the argument registers in use are
 
372
                        reg+1 up to reg+arity included
 
373
 
 
374
        if you call glstack_realloc with new_size == the current size,
 
375
                you will get a reallocated area !
 
376
 
 
377
        Re-allocate the space for the Global and Local Stacks' data area
 
378
        to "new_size" K-byte blocks.
 
379
 
 
380
 
 
381
        Optimizations:
 
382
                if the heap hasn't been moved, then there is no need to change:
 
383
                        o pointers INTO the heap;
 
384
                        o pointers IN the heap (because there shouldn't be
 
385
                                any pointing into the local stack).
 
386
*/
 
387
/*----------------------------------------------------------------------*/
 
388
 
 
389
xsbBool glstack_realloc(CTXTdeclc int new_size, int arity)
 
390
{
 
391
  CPtr   new_heap_bot ;       /* bottom of new Global Stack area */
 
392
  CPtr   new_ls_bot ;         /* bottom of new Local Stack area */
 
393
 
 
394
  long   heap_offset ;        /* offsets between the old and new */
 
395
  long   local_offset ;       /* stack bottoms, measured in Cells */
 
396
 
 
397
  CPtr   *cell_ptr ;
 
398
  Cell   cell_val ;
 
399
 
 
400
  size_t new_size_in_bytes, new_size_in_cells ; /* what a mess ! */
 
401
  double   expandtime ;
 
402
 
 
403
  if (new_size <= glstack.size) return 0;
 
404
 
 
405
  SYS_MUTEX_LOCK( MUTEX_STACKS ) ;
 
406
 
 
407
  xsb_dbgmsg((LOG_REALLOC, 
 
408
             "Reallocating the Heap and Local Stack data area"));
 
409
#ifdef DEBUG_VERBOSE
 
410
  if (LOG_REALLOC <= cur_log_level) {
 
411
    if (glstack.size == glstack.init_size) {
 
412
      xsb_dbgmsg((LOG_REALLOC,"\tBottom:\t\t%p\t\tInitial Size: %ldK",
 
413
                 glstack.low, glstack.size));
 
414
      xsb_dbgmsg((LOG_REALLOC,"\tTop:\t\t%p", glstack.high));
 
415
    }
 
416
  }
 
417
#endif
 
418
 
 
419
  expandtime = cpu_time();
 
420
 
 
421
  new_size_in_bytes = new_size*K ;
 
422
  new_size_in_cells = new_size_in_bytes/sizeof(Cell) ;
 
423
                /* and let's hope K stays divisible by sizeof(Cell) */
 
424
 
 
425
  stack_boundaries ;
 
426
 
 
427
  /* Expand the data area and push the Local Stack to the high end. */
 
428
 
 
429
  new_heap_bot = (CPtr)realloc(heap_bot, new_size_in_bytes);
 
430
  if (new_heap_bot == NULL) {
 
431
    if (2*glstack.size == new_size) { /* if trying to double, try backing off, may not help */
 
432
      int increment = new_size;
 
433
      while (new_heap_bot == NULL && increment > 40) {
 
434
        increment = increment/2;
 
435
        new_size = glstack.size + increment;
 
436
        new_size_in_bytes = new_size*K ;
 
437
        new_size_in_cells = new_size_in_bytes/sizeof(Cell) ;
 
438
        new_heap_bot = (CPtr)realloc(heap_bot, new_size_in_bytes);
 
439
      }
 
440
      if (new_heap_bot == NULL) {
 
441
        xsb_mesg("Not enough core to resize the Heap and Local Stack!");
 
442
        SYS_MUTEX_UNLOCK( MUTEX_STACKS ) ;
 
443
        return 1; /* return an error output -- will be picked up later */
 
444
      }
 
445
    } else {
 
446
      xsb_mesg("Not enough core to resize the Heap and Local Stack!");
 
447
      SYS_MUTEX_UNLOCK( MUTEX_STACKS ) ;
 
448
      return 1; /* return an error output -- will be picked up later */
 
449
    }
 
450
  }
 
451
  heap_offset = new_heap_bot - heap_bot ;
 
452
  new_ls_bot = new_heap_bot + new_size_in_cells - 1 ;
 
453
  local_offset = new_ls_bot - ls_bot ;
 
454
 
 
455
#if defined(GENERAL_TAGGING)
 
456
  //  printf("glstack expand %p %p\n",(void *)new_heap_bot,(void *)new_ls_bot+1);
 
457
  extend_enc_dec_as_nec(new_heap_bot,new_ls_bot+1);
 
458
#endif
 
459
 
 
460
  memmove(ls_top + local_offset,             /* move to */
 
461
          ls_top + heap_offset,              /* move from */
 
462
          (ls_bot - ls_top + 1)*sizeof(Cell) );      /* number of bytes */
 
463
 
 
464
  /* Update the Heap links */
 
465
  for (cell_ptr = (CPtr *)(heap_top + heap_offset);
 
466
       cell_ptr-- > (CPtr *)new_heap_bot;
 
467
      )
 
468
  { reallocate_heap_or_ls_pointer(cell_ptr) ; }
 
469
 
 
470
  /* Update the pointers in the Local Stack */
 
471
  for (cell_ptr = (CPtr *)(ls_top + local_offset);
 
472
       cell_ptr <= (CPtr *)new_ls_bot;
 
473
       cell_ptr++)
 
474
  { reallocate_heap_or_ls_pointer(cell_ptr) ; }
 
475
 
 
476
  /* Update the trailed variable pointers */
 
477
  for (cell_ptr = (CPtr *)top_of_trail - 1;
 
478
       cell_ptr > (CPtr *)tcpstack.low;
 
479
       cell_ptr = cell_ptr - 2)
 
480
  { /* first the value */
 
481
    reallocate_heap_or_ls_pointer(cell_ptr);
 
482
    /* now the address */
 
483
    cell_ptr-- ;
 
484
    cell_val = (Cell)*cell_ptr ;
 
485
#ifdef PRE_IMAGE_TRAIL
 
486
    if ((unsigned long) cell_val & PRE_IMAGE_MARK) {
 
487
      /* remove tag */
 
488
      cell_val = (Cell) ((Cell) cell_val & ~PRE_IMAGE_MARK);
 
489
      /* realloc and tag */
 
490
      realloc_ref_pre_image(cell_ptr,(CPtr)cell_val) ;
 
491
      cell_ptr--;
 
492
      /* realoc pre-image */
 
493
      reallocate_heap_or_ls_pointer(cell_ptr);
 
494
    } else
 
495
#endif
 
496
      realloc_ref(cell_ptr,(CPtr)cell_val) ;
 
497
  }
 
498
 
 
499
  /* Update the CP Stack pointers */
 
500
  for (cell_ptr = (CPtr *)top_of_cpstack;
 
501
       cell_ptr < (CPtr *)tcpstack.high;
 
502
       cell_ptr++)
 
503
  { reallocate_heap_or_ls_pointer(cell_ptr) ; }
 
504
 
 
505
  /* Update the argument registers */
 
506
  while (arity)
 
507
  { cell_ptr = (CPtr *)(reg+arity) ;
 
508
    reallocate_heap_or_ls_pointer(cell_ptr) ;
 
509
    arity-- ;  
 
510
  }
 
511
 
 
512
  /* Update the attributed variables interrupt list --lfcastro */
 
513
  { 
 
514
    int size = int_val(cell(interrupt_reg));
 
515
    int i;
 
516
    for (i=0; i<size; i++) {
 
517
      reallocate_heap_or_ls_pointer(((CPtr *)&(attv_interrupts[i][0])));
 
518
      reallocate_heap_or_ls_pointer(((CPtr *)&(attv_interrupts[i][1])));
 
519
    }
 
520
  }
 
521
 
 
522
  /* Update the system variables */
 
523
  glstack.low = (byte *)new_heap_bot ;
 
524
  glstack.high = (byte *)(new_ls_bot + 1) ;
 
525
  glstack.size = new_size ;
 
526
 
 
527
  hreg = (CPtr)hreg + heap_offset ;
 
528
  hbreg = (CPtr)hbreg + heap_offset ;
 
529
  hfreg = (CPtr)hfreg + heap_offset ;
 
530
  ereg = (CPtr)ereg + local_offset ;
 
531
  ebreg = (CPtr)ebreg + local_offset ;
 
532
  efreg = (CPtr)efreg + local_offset ;
 
533
 
 
534
  if (islist(delayreg))
 
535
    delayreg = (CPtr)makelist(clref_val(delayreg) + heap_offset);
 
536
 
 
537
  expandtime = cpu_time() - expandtime;
 
538
 
 
539
  xsb_dbgmsg((LOG_REALLOC,"\tNew Bottom:\t%p\t\tNew Size: %ldK",
 
540
             glstack.low, glstack.size));
 
541
  xsb_dbgmsg((LOG_REALLOC,"\tNew Top:\t%p", glstack.high));
 
542
  xsb_dbgmsg((LOG_REALLOC,
 
543
             "Heap/Local Stack data area expansion - finished in %lf secs\n",
 
544
             expandtime));
 
545
 
 
546
  SYS_MUTEX_UNLOCK( MUTEX_STACKS ) ;
 
547
 
 
548
  return 0;
 
549
} /* glstack_realloc */
 
550
 
 
551
 
 
552
/*======================================================================*/
 
553
/* The main routine that performs garbage collection.                   */
 
554
/*======================================================================*/
 
555
 
 
556
int gc_heap(CTXTdeclc int arity, int ifStringGC)
 
557
{
 
558
#ifdef GC
 
559
  CPtr p;
 
560
  double  begin_marktime, end_marktime,
 
561
    end_slidetime, end_copy_time,
 
562
    begin_stringtime, end_stringtime;
 
563
  int  marked = 0, marked_dregs = 0, i;
 
564
  int  start_heap_size;
 
565
  DECL_GC_PROFILE;
 
566
 
 
567
  SYS_MUTEX_LOCK( MUTEX_STACKS ) ;
 
568
  
 
569
  INIT_GC_PROFILE;
 
570
  if (pflags[GARBAGE_COLLECT] != NO_GC) {
 
571
    num_gc++ ;
 
572
    GC_PROFILE_PRE_REPORT;
 
573
    slide = (pflags[GARBAGE_COLLECT] == SLIDING_GC) | 
 
574
      (pflags[GARBAGE_COLLECT] == INDIRECTION_SLIDE_GC);
 
575
    
 
576
    if (fragmentation_only) 
 
577
      slide = FALSE;
 
578
    heap_early_reset = ls_early_reset = 0;
 
579
    
 
580
    GC_PROFILE_START_SUMMARY;
 
581
    
 
582
    begin_marktime = cpu_time();
 
583
    start_heap_size = hreg+1-(CPtr)glstack.low;
 
584
    
 
585
    /* make sure the top choice point heap pointer 
 
586
       that might not point into heap, does */
 
587
    if (hreg == cp_hreg(breg)) {
 
588
      *hreg = makeint(666) ;
 
589
      hreg++ ;
 
590
    }
 
591
#ifdef SLG_GC
 
592
    /* same for the freeze heap pointer */
 
593
    if (hfreg == hreg && hreg == cp_hreg(bfreg)) {
 
594
      *hreg = makeint(66600);
 
595
      hreg++;
 
596
    }
 
597
#endif
 
598
    
 
599
    /* copy the aregs to the top of the heap - only if sliding */
 
600
    /* just hope there is enough space */
 
601
    /* this happens best before the stack_boundaries are computed */
 
602
    if (slide) {
 
603
      if (delayreg != NULL) {
 
604
        arity++;
 
605
        reg[arity] = (Cell)delayreg;
 
606
      }
 
607
      for (i = 1; i <= arity; i++) {
 
608
        *hreg = reg[i];
 
609
        hreg++;
 
610
      }
 
611
    }
 
612
    
 
613
#ifdef SLG_GC
 
614
    /* in SLGWAM, copy hfreg to the heap */
 
615
    if (slide) {
 
616
      *hreg = (unsigned long) hfreg;
 
617
      hreg++;
 
618
    }
 
619
#endif
 
620
 
 
621
    gc_strings = ifStringGC; /* default */
 
622
    gc_strings = should_gc_strings();
 
623
    marked = mark_heap(CTXTc arity, &marked_dregs);
 
624
    
 
625
    end_marktime = cpu_time();
 
626
    
 
627
    if (fragmentation_only) {
 
628
      /* fragmentation is expressed as ratio not-marked/total heap in use
 
629
         this is internal fragmentation only.  we print marked and total,
 
630
         so that postprocessing can do what it wants with this info. */
 
631
      xsb_dbgmsg((LOG_GC, "marked_used_missed(%d,%d,%d,%d).",
 
632
                 marked,hreg+1-(CPtr)glstack.low,
 
633
                 heap_early_reset,ls_early_reset));
 
634
 
 
635
    free_marks:
 
636
 
 
637
#ifdef PRE_IMAGE_TRAIL
 
638
      /* re-tag pre image cells in trail */
 
639
      for (p = tr_bot; p <= tr_top ; p++ ) {
 
640
        if (tr_pre_marked(p-tr_bot)) {
 
641
          *p = *p | PRE_IMAGE_MARK;
 
642
          tr_clear_pre_mark(p-tr_bot);
 
643
        }
 
644
      }
 
645
#endif
 
646
 
 
647
      /* get rid of the marking areas - if they exist */
 
648
      if (heap_marks)  { mem_dealloc((heap_marks-1),heap_marks_size,GC_SPACE); heap_marks = NULL; }
 
649
      if (tr_marks)    { mem_dealloc(tr_marks,tr_top-tr_bot+1,GC_SPACE); tr_marks = NULL; }
 
650
      if (ls_marks)    { mem_dealloc(ls_marks,ls_bot - ls_top + 1,GC_SPACE); ls_marks = NULL; }
 
651
      if (cp_marks)    { mem_dealloc(cp_marks,cp_bot - cp_top + 1,GC_SPACE); cp_marks = NULL; }
 
652
      if (slide_buf)   { mem_dealloc(slide_buf,(slide_buf_size+1)*sizeof(CPtr),GC_SPACE); slide_buf = NULL; }
 
653
      goto end;
 
654
    }
 
655
    
 
656
    GC_PROFILE_MARK_SUMMARY;
 
657
    
 
658
    /* An attempt to add some gc/expansion policy;
 
659
       ideally this should be user-controlled */
 
660
#if (! defined(GC_TEST))
 
661
    if (marked > ((hreg+1-(CPtr)glstack.low)*mark_threshold))
 
662
      {
 
663
        GC_PROFILE_QUIT_MSG;
 
664
        if (slide)
 
665
          hreg -= arity;
 
666
        total_time_gc += (double) 
 
667
          (end_marktime-begin_marktime);
 
668
        goto free_marks; /* clean-up temp areas and get out of here... */
 
669
      }
 
670
#endif
 
671
    
 
672
    total_collected += (start_heap_size - marked);
 
673
 
 
674
    if (slide)
 
675
      {
 
676
        GC_PROFILE_SLIDE_START_TIME;
 
677
 
 
678
        hreg = slide_heap(marked) ;
 
679
 
 
680
        if (hreg != (heap_bot+marked))
 
681
          xsb_dbgmsg((LOG_GC, "heap sliding gc - inconsistent hreg"));
 
682
#ifdef SLG_GC
 
683
        /* copy hfreg back from the heap */
 
684
        hreg--;
 
685
        hfreg = (unsigned long*) *hreg;
 
686
#endif
 
687
 
 
688
        /* copy the aregs from the top of the heap back */
 
689
        hreg -= arity;
 
690
        hbreg = cp_hreg(breg);
 
691
        
 
692
        p = hreg;
 
693
        
 
694
        for (i = 1; i <= arity; i++)
 
695
          reg[i] = *p++ ;
 
696
        if (delayreg != NULL)
 
697
          delayreg = (CPtr)reg[arity--];
 
698
 
 
699
        end_slidetime = cpu_time();
 
700
        
 
701
        total_time_gc += (double) 
 
702
          (end_slidetime - begin_marktime);
 
703
        
 
704
        GC_PROFILE_SLIDE_FINAL_SUMMARY;
 
705
      }
 
706
    else
 
707
      { /* else we call the copying collector a la Cheney */
 
708
        CPtr begin_new_heap, end_new_heap;
 
709
        
 
710
        GC_PROFILE_COPY_START_TIME;
 
711
        
 
712
        begin_new_heap = (CPtr)mem_alloc(marked*sizeof(Cell),GC_SPACE);
 
713
        if (begin_new_heap == NULL)
 
714
          xsb_exit("copying garbage collection could not allocate new heap");
 
715
        end_new_heap = begin_new_heap+marked;
 
716
 
 
717
        hreg = copy_heap(CTXTc marked,begin_new_heap,end_new_heap,arity);
 
718
 
 
719
        mem_dealloc(begin_new_heap,marked*sizeof(Cell),GC_SPACE);
 
720
        adapt_hfreg_from_choicepoints(CTXTc hreg);
 
721
        hbreg = cp_hreg(breg);
 
722
 
 
723
#ifdef SLG_GC
 
724
        hfreg = hreg;
 
725
#endif
 
726
        end_copy_time = cpu_time();
 
727
        
 
728
        total_time_gc += (double) 
 
729
          (end_copy_time - begin_marktime);
 
730
        
 
731
        GC_PROFILE_COPY_FINAL_SUMMARY;
 
732
      }
 
733
    
 
734
    if (print_on_gc) print_all_stacks(CTXTc arity);
 
735
    
 
736
    /* get rid of the marking areas - if they exist */
 
737
    if (heap_marks)  { 
 
738
      check_zero(heap_marks,(heap_top - heap_bot),"heap") ;
 
739
      mem_dealloc((heap_marks-1),heap_marks_size,GC_SPACE) ; /* see its calloc */
 
740
      heap_marks = NULL ;
 
741
    }
 
742
    if (tr_marks)    { 
 
743
      check_zero(tr_marks,(tr_top - tr_bot + 1),"tr") ;
 
744
      mem_dealloc(tr_marks,tr_top-tr_bot+1,GC_SPACE) ;
 
745
      tr_marks = NULL ;
 
746
    }
 
747
    if (ls_marks)    { 
 
748
      check_zero(ls_marks,(ls_bot - ls_top + 1),"ls") ;
 
749
      mem_dealloc(ls_marks,ls_bot - ls_top + 1,GC_SPACE) ;
 
750
      ls_marks = NULL ;
 
751
    }
 
752
    if (cp_marks)    {  
 
753
      check_zero(cp_marks,(cp_bot - cp_top + 1),"cp") ;
 
754
      mem_dealloc(cp_marks,cp_bot - cp_top + 1,GC_SPACE) ;
 
755
      cp_marks = NULL ;
 
756
    }
 
757
    if (slide_buf)   { 
 
758
      mem_dealloc(slide_buf,(slide_buf_size+1)*sizeof(CPtr),GC_SPACE); 
 
759
      slide_buf = NULL; 
 
760
    }
 
761
#ifdef SAFE_GC
 
762
    p = hreg;
 
763
    while (p < heap_top)
 
764
      *p++ = 0;
 
765
#endif
 
766
    
 
767
  } /* if (pflags[GARBAGE_COLLECT]) */
 
768
#else
 
769
  /* for no-GC, there is no gc, but stack expansion can be done */
 
770
#endif
 
771
  
 
772
#ifdef GC
 
773
 end:
 
774
  
 
775
  /*************** GC STRING-TABLE (already marked from heap) *******************/
 
776
#ifndef NO_STRING_GC
 
777
#ifdef MULTI_THREAD
 
778
  if (flags[NUM_THREADS] == 1) {
 
779
#endif
 
780
    if (gc_strings) {
 
781
      //      long beg_string_space_size = pspacesize[STRING_SPACE];
 
782
      begin_stringtime = cpu_time();
 
783
      mark_nonheap_strings(CTXT);
 
784
      free_unused_strings();
 
785
      //      printf("String GC reclaimed: %d bytes\n",beg_string_space_size - pspacesize[STRING_SPACE]);
 
786
      last_string_space_size = pspacesize[STRING_SPACE];
 
787
      last_assert_space_size = pspacesize[ASSERT_SPACE];
 
788
      gc_strings = FALSE;
 
789
      end_stringtime = cpu_time();
 
790
      total_time_gc += end_stringtime - begin_stringtime;
 
791
    }
 
792
#ifdef MULTI_THREAD
 
793
  }
 
794
#endif
 
795
#endif /* ndef NO_STRING_GC */
 
796
 
 
797
  GC_PROFILE_POST_REPORT;
 
798
  
 
799
#endif /* GC */
 
800
 
 
801
  SYS_MUTEX_UNLOCK( MUTEX_STACKS ) ;
 
802
 
 
803
  return(TRUE);
 
804
 
 
805
} /* gc_heap */
 
806
 
 
807
/*--------------------------------------------------------------------------*/
 
808
 
 
809
xsbBool glstack_ensure_space(CTXTdeclc int extra, int arity) {
 
810
  if (pflags[GARBAGE_COLLECT] != NO_GC && arity < 255) {
 
811
    gc_heap(CTXTc arity,FALSE);
 
812
  }
 
813
  if ((pb)top_of_localstk < (pb)top_of_heap + OVERFLOW_MARGIN + extra) {
 
814
    return glstack_realloc(CTXTc resize_stack(glstack.size,extra+OVERFLOW_MARGIN),arity);
 
815
  }
 
816
  else return FALSE;
 
817
}
 
818
 
 
819
/*--------------------------------------------------------------------------*/
 
820
 
 
821