[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Stratagus-CVS] stratagus/src clone/ccl.c include/siod.h includ...
From: |
ludovic pollet |
Subject: |
[Stratagus-CVS] stratagus/src clone/ccl.c include/siod.h includ... |
Date: |
Tue, 11 Nov 2003 07:45:25 -0500 |
CVSROOT: /cvsroot/stratagus
Module name: stratagus
Branch:
Changes by: ludovic pollet <address@hidden> 03/11/11 07:45:25
Modified files:
src/clone : ccl.c
src/include : siod.h siodp.h
src/siod : slib.c sliba.c
Log message:
SIOD now uses dynamic heap size
Patches:
Index: stratagus/src/clone/ccl.c
diff -u stratagus/src/clone/ccl.c:1.127 stratagus/src/clone/ccl.c:1.128
--- stratagus/src/clone/ccl.c:1.127 Mon Nov 10 14:25:33 2003
+++ stratagus/src/clone/ccl.c Tue Nov 11 07:45:24 2003
@@ -26,7 +26,7 @@
// Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
// 02111-1307, USA.
//
-// $Id: ccl.c,v 1.127 2003/11/10 19:25:33 pludov Exp $
+// $Id: ccl.c,v 1.128 2003/11/11 12:45:24 pludov Exp $
//@{
@@ -271,7 +271,11 @@
local void CheckProtectedCell(SCM* obj,int id)
{
#ifdef CHECK_GC_VALUES
+ int i;
DebugCheck(ProtectedCellValues[id] != *obj);
+ for (i = 0; i < ProtectedCellCount; i++) {
+ DebugCheck(ProtectedCellValues[i] != (*ProtectedCells[i]));
+ }
#endif
}
@@ -419,6 +423,7 @@
*/
global void CclGarbageCollect(int fast)
{
+
#ifdef USE_GUILE
if (!fast) {
// GUILE handle gc nicely by itself
@@ -428,13 +433,24 @@
#ifdef SIOD_HEAP_GC
static int cpt=0;
- // Very slow, so differ...
+ // Very slow, so differ as much as possible...
if (!(++cpt & 15)) {
user_gc(SCM_BOOL_F);
}
#else
+ static int default_used_cells=0;
+ int new_used_cells;
+ int cur_used_cells=0;
+
// stop and copy iterates only the allocated SCM
- gc_stop_and_copy();
+ if (!fast || (cur_used_cells=siod_used_cells()) > default_used_cells +
10000) {
+ gc_stop_and_copy();
+ new_used_cells = siod_used_cells();
+ if (fast) {
+ DebugLevel2Fn("GC reduced %d cells to %d\n" _C_ cur_used_cells _C_
new_used_cells);
+ }
+ default_used_cells = new_used_cells;
+ }
#endif
#endif
}
@@ -1034,7 +1050,8 @@
#else
// Stop & copy GC : scan only allocated cells
sargv[2] = "-g1";
- sargv[3] = "-h4000000";
+ // Cells are allocated in chunck of 40000 cells ( => 160Ko )
+ sargv[3] = "-h40000";
#endif
buf = malloc(strlen(StratagusLibPath) + 4);
sprintf(buf, "-l%s", StratagusLibPath);
@@ -1245,7 +1262,7 @@
}
fprintf(fd, ";;; -----------------------------------------\n");
- fprintf(fd, ";;; $Id: ccl.c,v 1.127 2003/11/10 19:25:33 pludov Exp $\n");
+ fprintf(fd, ";;; $Id: ccl.c,v 1.128 2003/11/11 12:45:24 pludov Exp $\n");
fprintf(fd, "(set-video-resolution! %d %d)\n", VideoWidth, VideoHeight);
@@ -1270,7 +1287,7 @@
}
fprintf(fd, ";;; -----------------------------------------\n");
- fprintf(fd, ";;; $Id: ccl.c,v 1.127 2003/11/10 19:25:33 pludov Exp $\n");
+ fprintf(fd, ";;; $Id: ccl.c,v 1.128 2003/11/11 12:45:24 pludov Exp $\n");
// Global options
if (OriginalFogOfWar) {
@@ -1381,7 +1398,7 @@
extern SCM oblistvar;
CLprintf(file, "\n;;; -----------------------------------------\n");
- CLprintf(file, ";;; MODULE: CCL $Id: ccl.c,v 1.127 2003/11/10 19:25:33
pludov Exp $\n\n");
+ CLprintf(file, ";;; MODULE: CCL $Id: ccl.c,v 1.128 2003/11/11 12:45:24
pludov Exp $\n\n");
for (list = oblistvar; gh_list_p(list); list = gh_cdr(list)) {
SCM sym;
Index: stratagus/src/include/siod.h
diff -u stratagus/src/include/siod.h:1.9 stratagus/src/include/siod.h:1.10
--- stratagus/src/include/siod.h:1.9 Mon Nov 3 06:21:41 2003
+++ stratagus/src/include/siod.h Tue Nov 11 07:45:24 2003
@@ -4,7 +4,7 @@
* PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS. *
* See the source file SLIB.C for more information. *
- $Id: siod.h,v 1.9 2003/11/03 11:21:41 pludov Exp $
+ $Id: siod.h,v 1.10 2003/11/11 12:45:24 pludov Exp $
*/
@@ -209,6 +209,7 @@
void gc_unprotect(LISP *location);
void gc_protect_n(LISP *location,long n);
void gc_protect_sym(LISP *location,char *st);
+long siod_used_cells(void);
void __stdcall init_storage(void);
void __stdcall init_slibu(void);
Index: stratagus/src/include/siodp.h
diff -u stratagus/src/include/siodp.h:1.5 stratagus/src/include/siodp.h:1.6
--- stratagus/src/include/siodp.h:1.5 Sat Aug 2 09:34:25 2003
+++ stratagus/src/include/siodp.h Tue Nov 11 07:45:24 2003
@@ -7,14 +7,20 @@
Declarations which are private to SLIB.C internals.
However, some of these should be moved to siod.h
- $Id: siodp.h,v 1.5 2003/08/02 13:34:25 grumbel Exp $
+ $Id: siodp.h,v 1.6 2003/11/11 12:45:24 pludov Exp $
*/
#include <setjmp.h>
extern char *tkbuffer;
+#define MAX_HEAPS_CHUNCK 256
+extern LISP dyn_heaps[MAX_HEAPS_CHUNCK];
+extern int dyn_heaps_pos[MAX_HEAPS_CHUNCK];
+extern int cur_dyn_heap;
+
extern LISP heap,heap_end,heap_org;
+extern long heap_size;
extern LISP sym_t;
extern long siod_verbose_level;
@@ -49,11 +55,16 @@
long length;
struct gc_protected *next;};
+#define ALLOCATED_CELLS (gc_kind_copying?\
+ (cur_dyn_heap*heap_size)+dyn_heaps_pos[cur_dyn_heap]:\
+ heap-heap_org)
+
#define NEWCELL(_into,_type) \
{if (gc_kind_copying == 1) \
- {if ((_into = heap) >= heap_end) \
- gc_fatal_error(); \
- heap = _into+1;} \
+ {if (dyn_heaps_pos[cur_dyn_heap]>=heap_size) \
+ { new_dyn_heap();} \
+ _into = dyn_heaps[cur_dyn_heap]+(dyn_heaps_pos[cur_dyn_heap]++); \
+ } \
else \
{if NULLP(freelist) \
gc_for_newcell(); \
@@ -103,8 +114,9 @@
void init_storage_1(void);
struct user_type_hooks *get_user_type_hooks(long type);
LISP get_newspace(void);
-void scan_newspace(LISP newspace);
+void scan_newspace(LISP newspace,int start,int end);
void free_oldspace(LISP space,LISP end);
+void new_dyn_heap(void);
void gc_stop_and_copy(void);
void gc_for_newcell(void);
void gc_mark_and_sweep(void);
Index: stratagus/src/siod/slib.c
diff -u stratagus/src/siod/slib.c:1.32 stratagus/src/siod/slib.c:1.33
--- stratagus/src/siod/slib.c:1.32 Mon Nov 3 06:21:41 2003
+++ stratagus/src/siod/slib.c Tue Nov 11 07:45:25 2003
@@ -91,7 +91,7 @@
static void init_slib_version(void)
{setvar(cintern("*slib-version*"),
- cintern("$Id: slib.c,v 1.32 2003/11/03 11:21:41 pludov Exp $"),
+ cintern("$Id: slib.c,v 1.33 2003/11/11 12:45:25 pludov Exp $"),
NIL);}
char * __stdcall siod_version(void)
@@ -99,6 +99,10 @@
char current_filename[256];
long *current_lineno;
+LISP dyn_heaps[MAX_HEAPS_CHUNCK];
+int dyn_heaps_pos[MAX_HEAPS_CHUNCK];
+int cur_dyn_heap;
+
long nheaps = 2;
LISP *heaps;
LISP heap,heap_end,heap_org;
@@ -254,6 +258,7 @@
void __stdcall print_hs_2(void)
{if (siod_verbose_level >= 2)
{if (gc_kind_copying == 1)
+ // FIXME : update.
printf("heaps[0] at %p, heaps[1] at %p\n",heaps[0],heaps[1]);
else
printf("heaps[0] at %p\n",heaps[0]);}}
@@ -546,6 +551,11 @@
return((double) x);}
#endif
+long siod_used_cells(void)
+{
+ return ALLOCATED_CELLS;
+}
+
void set_repl_hooks(void (*puts_f)(char *),
LISP (*read_f)(void),
LISP (*eval_f)(LISP),
@@ -584,17 +594,18 @@
long repl(struct repl_hooks *h)
{
- LISP x, cw = 0;
+ LISP x;
double rt,ct;
+ int allocated=0;
assert(h != NULL);
while(1) {
if ((gc_kind_copying == 1) &&
- ((gc_status_flag) || heap >= heap_end)) {
+ ((gc_status_flag) || (dyn_heaps_pos[cur_dyn_heap] >=
heap_size))) {
rt = myruntime();
gc_stop_and_copy();
if (siod_verbose_level >= 2) {
sprintf(tkbuffer,"GC took %g seconds, %ld compressed to %ld,
%ld free\n",
-
myruntime()-rt,old_heap_used,(long)(heap-heap_org),(long)(heap_end-heap));
+
myruntime()-rt,old_heap_used,(long)(ALLOCATED_CELLS),(long)(heap_size-dyn_heaps_pos[cur_dyn_heap]));
grepl_puts(tkbuffer, h->repl_puts);
}
}
@@ -612,7 +623,7 @@
rt = myruntime();
ct = myrealtime();
if (gc_kind_copying == 1) {
- cw = heap;
+ allocated = ALLOCATED_CELLS;
} else {
gc_cells_allocated = 0;
gc_time_taken = 0.0;
@@ -625,7 +636,7 @@
if (gc_kind_copying == 1)
{
sprintf(tkbuffer,"Evaluation took %g seconds %ld cons work, %g
real.\n",
- myruntime()-rt,(long)(heap-cw),myrealtime()-ct);
+
myruntime()-rt,(long)(ALLOCATED_CELLS-allocated),myrealtime()-ct);
} else {
sprintf(tkbuffer, "Evaluation took %g seconds (%g in gc) %ld cons
work, %g real.\n",
myruntime()-rt,gc_time_taken,gc_cells_allocated,myrealtime()-ct);
@@ -1048,55 +1059,69 @@
set_print_hooks(tc_c_file,file_prin1);}
void init_storage_1(void)
-{LISP ptr;
- long j;
- tkbuffer = (char *) must_malloc(TKBUFFERN+1);
- if (((gc_kind_copying == 1) && (nheaps != 2)) || (nheaps < 1))
- errl("invalid number of heaps",NIL);
- heaps = (LISP *) must_malloc(sizeof(LISP) * nheaps);
- for(j=0;j<nheaps;++j) heaps[j] = NULL;
- heaps[0] = (LISP) must_malloc(sizeof(struct obj)*heap_size);
- heap = heaps[0];
- heap_org = heap;
- heap_end = heap + heap_size;
- if (gc_kind_copying == 1)
- heaps[1] = (LISP) must_malloc(sizeof(struct obj)*heap_size);
- else
- freelist = NIL;
- gc_protect(&oblistvar);
- if (obarray_dim > 1)
- {obarray = (LISP *) must_malloc(sizeof(LISP) * obarray_dim);
- for(j=0;j<obarray_dim;++j)
- obarray[j] = NIL;
- gc_protect_n(obarray,obarray_dim);}
- unbound_marker = cons(cintern("**unbound-marker**"),NIL);
- gc_protect(&unbound_marker);
- eof_val = cons(cintern("eof"),NIL);
- gc_protect(&eof_val);
- gc_protect_sym(&sym_t,"t");
- setvar(sym_t,sym_t,NIL);
- setvar(cintern("nil"),NIL,NIL);
- setvar(cintern("let"),cintern("let-internal-macro"),NIL);
- setvar(cintern("let*"),cintern("let*-macro"),NIL);
- setvar(cintern("letrec"),cintern("letrec-macro"),NIL);
- gc_protect_sym(&sym_errobj,"errobj");
- setvar(sym_errobj,NIL,NIL);
- gc_protect_sym(&sym_catchall,"all");
- gc_protect_sym(&sym_progn,"begin");
- gc_protect_sym(&sym_lambda,"lambda");
- gc_protect_sym(&sym_quote,"quote");
- gc_protect_sym(&sym_dot,".");
- gc_protect_sym(&sym_after_gc,"*after-gc*");
- setvar(sym_after_gc,NIL,NIL);
- gc_protect_sym(&sym_eval_history_ptr,"*eval-history-ptr*");
- setvar(sym_eval_history_ptr,NIL,NIL);
- if (inums_dim > 0)
- {inums = (LISP *) must_malloc(sizeof(LISP) * inums_dim);
- for(j=0;j<inums_dim;++j)
- {NEWCELL(ptr,tc_flonum);
- FLONM(ptr) = j;
- inums[j] = ptr;}
- gc_protect_n(inums,inums_dim);}}
+{
+ LISP ptr;
+ long j;
+ tkbuffer = (char *) must_malloc(TKBUFFERN+1);
+
+ if (gc_kind_copying == 1) {
+ if ((nheaps != 2) || (nheaps < 1))
+ errl("invalid number of heaps",NIL);
+ cur_dyn_heap=-1;
+ new_dyn_heap();
+ heaps=0;
+ heap=0;
+ heap_org=0;
+ heap_end=0;
+ }else{
+ heaps = (LISP *) must_malloc(sizeof(LISP) * nheaps);
+ for(j=0;j<nheaps;++j) heaps[j] = NULL;
+ heaps[0] = (LISP) must_malloc(sizeof(struct obj)*heap_size);
+ heap = heaps[0];
+ heap_org = heap;
+ heap_end = heap + heap_size;
+
+ freelist = NIL;
+ }
+ gc_protect(&oblistvar);
+ if (obarray_dim > 1){
+ obarray = (LISP *) must_malloc(sizeof(LISP) * obarray_dim);
+ for(j=0;j<obarray_dim;++j)
+ obarray[j] = NIL;
+ gc_protect_n(obarray,obarray_dim);
+ }
+
+ unbound_marker = cons(cintern("**unbound-marker**"),NIL);
+ gc_protect(&unbound_marker);
+ eof_val = cons(cintern("eof"),NIL);
+ gc_protect(&eof_val);
+ gc_protect_sym(&sym_t,"t");
+ setvar(sym_t,sym_t,NIL);
+ setvar(cintern("nil"),NIL,NIL);
+ setvar(cintern("let"),cintern("let-internal-macro"),NIL);
+ setvar(cintern("let*"),cintern("let*-macro"),NIL);
+ setvar(cintern("letrec"),cintern("letrec-macro"),NIL);
+ gc_protect_sym(&sym_errobj,"errobj");
+ setvar(sym_errobj,NIL,NIL);
+ gc_protect_sym(&sym_catchall,"all");
+ gc_protect_sym(&sym_progn,"begin");
+ gc_protect_sym(&sym_lambda,"lambda");
+ gc_protect_sym(&sym_quote,"quote");
+ gc_protect_sym(&sym_dot,".");
+ gc_protect_sym(&sym_after_gc,"*after-gc*");
+ setvar(sym_after_gc,NIL,NIL);
+ gc_protect_sym(&sym_eval_history_ptr,"*eval-history-ptr*");
+ setvar(sym_eval_history_ptr,NIL,NIL);
+ if (inums_dim > 0){
+ inums = (LISP *) must_malloc(sizeof(LISP) * inums_dim);
+ for(j=0;j<inums_dim;++j){
+ NEWCELL(ptr,tc_flonum);
+ FLONM(ptr) = j;
+ inums[j] = ptr;
+ }
+ gc_protect_n(inums,inums_dim);
+ }
+}
void init_subr(char *name, long type, SUBR_FUNC fcn)
{setvar(cintern(name),subrcons(type,name,fcn),NIL);}
@@ -1194,8 +1219,9 @@
case tc_lsubr:
case tc_fsubr:
case tc_msubr:
- if ((nw = heap) >= heap_end) gc_fatal_error();
- heap = nw+1;
+ NEWCELL(nw,0);
+ /*if ((nw = heap) >= heap_end) gc_fatal_error();
+ heap = nw+1;*/
memcpy(nw,x,sizeof(struct obj));
break;
default:
@@ -1203,8 +1229,7 @@
if (p->gc_relocate)
nw = (*p->gc_relocate)(x);
else
- {if ((nw = heap) >= heap_end) gc_fatal_error();
- heap = nw+1;
+ {NEWCELL(nw,0);
memcpy(nw,x,sizeof(struct obj));}}
(*x).gc_mark = 1;
CAR(x) = nw;
@@ -1212,6 +1237,7 @@
LISP get_newspace(void)
{LISP newspace;
+ gc_kind_check();
if (heap_org == heaps[0])
newspace = heaps[1];
else
@@ -1221,10 +1247,10 @@
heap_end = heap + heap_size;
return(newspace);}
-void scan_newspace(LISP newspace)
+void scan_newspace(LISP newspace,int start,int end)
{LISP ptr;
struct user_type_hooks *p;
- for(ptr=newspace; ptr < heap; ++ptr)
+ for(ptr=newspace + start; ptr < newspace + end; ++ptr)
{switch TYPE(ptr)
{case tc_cons:
case tc_closure:
@@ -1275,22 +1301,61 @@
p = get_user_type_hooks(TYPE(ptr));
if (p->gc_free) (*p->gc_free)(ptr);}}
+void new_dyn_heap(void)
+{
+ cur_dyn_heap++;
+
+ dyn_heaps[cur_dyn_heap]=(LISP)must_malloc(sizeof(struct obj)*heap_size);
+ dyn_heaps_pos[cur_dyn_heap]=0;
+}
+
void gc_stop_and_copy(void)
-{LISP newspace,oldspace,end;
- long flag;
+{
+ int flag,i;
+ int oldspace_count;
+ LISP oldspace[MAX_HEAPS_CHUNCK];
+ int oldspace_size[MAX_HEAPS_CHUNCK];
+
+ int scan_heap_id,scan_heap_pos,scan_next_pos;
flag = no_interrupt(1);
errjmp_ok = 0;
- oldspace = heap_org;
- end = heap;
- old_heap_used = end - oldspace;
- newspace = get_newspace();
+
+ // Copy full_heaps into oldspace
+ for(i=0;i<=cur_dyn_heap;i++){
+ oldspace[i]=dyn_heaps[i];
+ oldspace_size[i]=dyn_heaps_pos[i];
+ }
+ oldspace_count=cur_dyn_heap+1;
+
+ // Allocate new space
+ cur_dyn_heap=-1;
+ new_dyn_heap();
+
scan_registers();
- scan_newspace(newspace);
- free_oldspace(oldspace,end);
+
+ scan_heap_id=0;
+ scan_heap_pos=0;
+
while((scan_heap_id<cur_dyn_heap)||(scan_heap_id==cur_dyn_heap&&scan_heap_pos<dyn_heaps_pos[cur_dyn_heap])){
+ scan_next_pos=dyn_heaps_pos[scan_heap_id];
+ if(scan_heap_pos>=scan_next_pos){
+ // next heap
+ scan_heap_id++;
+ scan_heap_pos=0;
+ scan_next_pos=dyn_heaps_pos[scan_heap_id];
+ }
+ scan_newspace(dyn_heaps[scan_heap_id],scan_heap_pos,scan_next_pos);
+ scan_heap_pos=scan_next_pos;
+ }
+
+ for(i=0;i<oldspace_count;i++){
+ free_oldspace(oldspace[i],oldspace[i]+oldspace_size[i]);
+ free(oldspace[i]);
+ }
errjmp_ok = 1;
no_interrupt(flag);}
+/* MARK & SWEEP stuffs */
LISP allocate_aheap(void)
{long j,flag;
LISP ptr,end,next;
@@ -1317,6 +1382,7 @@
return(sym_t);}
return(NIL);}
+/* MARK & SWEEP stuffs */
void gc_for_newcell(void)
{long flag,n;
LISP l;
@@ -1340,6 +1406,7 @@
else
allocate_aheap();}
+/* MARK & SWEEP stuffs */
void gc_mark_and_sweep(void)
{LISP stack_end;
gc_ms_stats_start();
@@ -1375,7 +1442,8 @@
printf("[GC took %g cpu seconds, %ld cells collected]\n",
gc_rt,
gc_cells_collected);}
-
+
+/* MARK & SWEEP stuffs */
void gc_mark(LISP ptr)
{struct user_type_hooks *p;
gc_mark_loop:
@@ -1411,7 +1479,8 @@
p = get_user_type_hooks(TYPE(ptr));
if (p->gc_mark)
ptr = (*p->gc_mark)(ptr);}}
-
+
+/* MARK & SWEEP stuffs */
void mark_protected_registers(void)
{struct gc_protected *reg;
LISP *location;
@@ -1421,7 +1490,8 @@
n = (*reg).length;
for(j=0;j<n;++j)
gc_mark(location[j]);}}
-
+
+/* MARK & SWEEP stuffs */
void mark_locations(LISP *start,LISP *end)
{LISP *tmp;
long n;
@@ -1432,6 +1502,7 @@
n = end - start;
mark_locations_array(start,n);}
+/* MARK & SWEEP stuffs */
long looks_pointerp(LISP p)
{long j;
LISP h;
@@ -1445,6 +1516,7 @@
}
return(0);}
+/* MARK & SWEEP stuffs */
void mark_locations_array(LISP *x,long n)
{int j;
LISP p;
@@ -1453,6 +1525,7 @@
if (looks_pointerp(p))
gc_mark(p);}}
+/* MARK & SWEEP stuffs */
void gc_sweep(void)
{LISP ptr,end,nfreelist,org;
long n,k;
@@ -1539,7 +1612,7 @@
else
put_st("garbage collection is off\n");
sprintf(tkbuffer,"%ld allocated %ld free\n",
- (long)(heap - heap_org), (long)(heap_end - heap));
+ (long)(heap_size*(cur_dyn_heap+1)),
(long)(heap_size-dyn_heaps_pos[cur_dyn_heap]));
put_st(tkbuffer);}
else
{if (gc_status_flag)
@@ -1565,7 +1638,7 @@
return(flocons(heap_size));
case 4:
return(flocons((gc_kind_copying == 1)
- ? (long) (heap_end - heap)
+ ? (long) (heap_size-dyn_heaps_pos[cur_dyn_heap])
: freelist_length()));
default:
return(NIL);}}
Index: stratagus/src/siod/sliba.c
diff -u stratagus/src/siod/sliba.c:1.9 stratagus/src/siod/sliba.c:1.10
--- stratagus/src/siod/sliba.c:1.9 Fri Sep 5 14:10:56 2003
+++ stratagus/src/siod/sliba.c Tue Nov 11 07:45:25 2003
@@ -27,7 +27,7 @@
static void init_sliba_version(void)
{setvar(cintern("*sliba-version*"),
- cintern("$Id: sliba.c,v 1.9 2003/09/05 18:10:56 n0body Exp $"),
+ cintern("$Id: sliba.c,v 1.10 2003/11/11 12:45:25 pludov Exp $"),
NIL);}
static LISP sym_plists = NIL;
@@ -62,8 +62,7 @@
LISP array_gc_relocate(LISP ptr)
{LISP nw;
- if ((nw = heap) >= heap_end) gc_fatal_error();
- heap = nw+1;
+ nw=newcell(0);
memcpy(nw,ptr,sizeof(struct obj));
return(nw);}
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Stratagus-CVS] stratagus/src clone/ccl.c include/siod.h includ...,
ludovic pollet <=