1 /* heap.c: Code that is common to both garbage collectors.
2 *
3 * $Id$
4 *
5 * Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
6 * Copyright 2002, 2003 Sam Hocevar <sam@hocevar.net>, Paris
7 *
8 * This software was derived from Elk 1.2, which was Copyright 1987, 1988,
9 * 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
10 * by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
11 * between TELES and Nixdorf Microprocessor Engineering, Berlin).
12 *
13 * Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
14 * owners or individual owners of copyright in this software, grant to any
15 * person or company a worldwide, royalty free, license to
16 *
17 * i) copy this software,
18 * ii) prepare derivative works based on this software,
19 * iii) distribute copies of this software or derivative works,
20 * iv) perform this software, or
21 * v) display this software,
22 *
23 * provided that this notice is not removed and that neither Oliver Laumann
24 * nor Teles nor Nixdorf are deemed to have made any representations as to
25 * the suitability of this software for any purpose nor are held responsible
26 * for any defects of this software.
27 *
28 * THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
29 */
30
31 #include "config.h"
32
33 #include "kernel.h"
34
35 int GC_In_Progress;
36
37 GCNODE *GC_List;
38
39 static GCNODE *Global_GC_Obj;
40
41 static FUNCT *Before_GC_Funcs, *After_GC_Funcs;
42
43 static Object V_Garbage_Collect_Notifyp;
44 static Object Sym_Stop_And_Copy_GC, Sym_Generational_GC, Sym_Incremental_GC;
45
Init_Heap()46 void Init_Heap () {
47 Define_Variable (&V_Garbage_Collect_Notifyp, "garbage-collect-notify?",
48 False);
49
50 Define_Symbol (&Sym_Stop_And_Copy_GC, "stop-and-copy");
51 Define_Symbol (&Sym_Generational_GC, "generational");
52 Define_Symbol (&Sym_Incremental_GC, "incremental");
53 }
54
Register_Before_GC(void (* f)(void))55 void Register_Before_GC (void (*f)(void)) {
56 FUNCT *p;
57
58 p = (FUNCT *)Safe_Malloc (sizeof (*p));
59 p->func = f;
60 p->next = Before_GC_Funcs;
61 Before_GC_Funcs = p;
62 }
63
Call_Before_GC()64 void Call_Before_GC () {
65 FUNCT *p;
66
67 for (p = Before_GC_Funcs; p; p = p->next)
68 p->func();
69 }
70
Register_After_GC(void (* f)(void))71 void Register_After_GC (void (*f)(void)) {
72 FUNCT *p;
73
74 p = (FUNCT *)Safe_Malloc (sizeof (*p));
75 p->func = f;
76 p->next = After_GC_Funcs;
77 After_GC_Funcs = p;
78 }
79
Call_After_GC()80 void Call_After_GC () {
81 FUNCT *p;
82
83 for (p = After_GC_Funcs; p; p = p->next)
84 p->func();
85 }
86
Visit_GC_List(GCNODE * list,intptr_t delta)87 void Visit_GC_List (GCNODE *list, intptr_t delta) {
88 register GCNODE *gp, *p;
89 register int n;
90 register Object *vec;
91
92 for (gp = list; gp; gp = p->next) {
93 p = (GCNODE *)NORM(gp);
94 if (p->gclen <= 0) {
95 Visit ((Object *)NORM(p->gcobj));
96 } else {
97 vec = (Object *)NORM(p->gcobj);
98 for (n = 0; n < p->gclen-1; n++)
99 Visit (&vec[n]);
100 }
101 }
102 }
103
Visit_Wind(WIND * list,intptr_t delta)104 void Visit_Wind (WIND *list, intptr_t delta) {
105 register WIND *wp, *p;
106
107 for (wp = list; wp; wp = p->next) {
108 p = (WIND *)NORM(wp);
109 Visit (&p->inout);
110 }
111 }
112
Func_Global_GC_Link(Object * x)113 void Func_Global_GC_Link (Object *x) {
114 GCNODE *p;
115
116 p = (GCNODE *)Safe_Malloc (sizeof (*p));
117 p->gclen = 0;
118 p->gcobj = x;
119 p->next = Global_GC_Obj;
120 Global_GC_Obj = p;
121 }
122
123 #define GC_STRAT_SAC 1
124 #define GC_STRAT_GEN 2
125
126 #define GC_FLAGS_INCR 1
127
128 Object Internal_GC_Status();
129
P_Garbage_Collect_Status(int argc,Object * argv)130 Object P_Garbage_Collect_Status (int argc, Object* argv) {
131 int strat = 0, flags = 0;
132
133 if (argc > 0) {
134 Check_Type (argv[0], T_Symbol);
135 if (EQ (argv[0], Sym_Stop_And_Copy_GC))
136 strat = GC_STRAT_SAC;
137 else if (EQ (argv[0], Sym_Generational_GC))
138 strat = GC_STRAT_GEN;
139 else Primitive_Error ("unknown GC strategy: ~s", argv[0]);
140 if (argc == 2) {
141 Check_Type (argv[1], T_Symbol);
142 if (EQ (argv[1], Sym_Incremental_GC))
143 flags = GC_FLAGS_INCR;
144 else Primitive_Error ("unknown GC strategy: ~s", argv[1]);
145 }
146 }
147 return Internal_GC_Status (strat, flags);
148 }
149
150 #ifdef GENERATIONAL_GC
151 # include "heap-gen.c"
152 #else
153 # include "heap-sc.c"
154 #endif
155