source: release/1.7/source/lisp-kernel/gc.h @ 15267

Last change on this file since 15267 was 14807, checked in by gb, 8 years ago

Define and export the functions ALLOW-HEAP-ALLOCATION and
HEAP-ALLOCATION-ALLOWED-P and the condition type ALLOCATION-DISABLED.

(ALLOW-HEAP-ALLOCATION arg) : when ARG is NIL, causes any subsequent
attempts to heap-allocate lisp memory to signal (as if by CERROR)
an ALLOCATION-DISABLED condition. (Allocaton is enabled globally at
the point where the error is signaled.) Continuing from the CERROR
restarts the allocation attempt.

This is intended to help verify that code that's not expected to
cons doesn't do so.

(This is only implemented on the ARM at the moment, but the intent
is that it be supported on all platforms.)

Note that calling (ALLOW-HEAP-ALLOCATION NIL) in the REPL CERRORs
immediately, since the REPL will cons to create the new value of CL:/.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.8 KB
Line 
1/*
2   Copyright (C) 2009 Clozure Associates
3   Copyright (C) 1994-2001 Digitool, Inc
4   This file is part of Clozure CL. 
5
6   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
7   License , known as the LLGPL and distributed with Clozure CL as the
8   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9   which is distributed with Clozure CL as the file "LGPL".  Where these
10   conflict, the preamble takes precedence. 
11
12   Clozure CL is referenced in the preamble as the "LIBRARY."
13
14   The LLGPL is also available online at
15   http://opensource.franz.com/preamble.html
16*/
17
18#ifndef __GC_H__
19#define __GC_H__ 1
20
21#include "lisp.h"
22#include "bits.h"
23#include "lisp-exceptions.h"
24#include "memprotect.h"
25
26
27
28#ifdef PPC
29#define is_node_fulltag(f)  ((1<<(f))&((1<<fulltag_cons)|(1<<fulltag_misc)))
30#ifdef PPC64
31#define PPC64_CODE_VECTOR_PREFIX (('C'<< 24) | ('O' << 16) | ('D' << 8) | 'E')
32#else
33/*
34  A code-vector's header can't look like a valid instruction or UUO:
35  the low 8 bits must be subtag_code_vector, and the top 6 bits
36  must be 0.  That means that the maximum length of a code vector
37  is 18 bits worth of elements (~1MB.)
38*/
39
40#define code_header_mask ((0x3f<<26) | subtag_code_vector)
41#endif
42#endif
43
44#ifdef X86
45#ifdef X8664
46#define is_node_fulltag(f)  ((1<<(f))&((1<<fulltag_cons)    | \
47                                       (1<<fulltag_tra_0)   | \
48                                       (1<<fulltag_tra_1)   | \
49                                       (1<<fulltag_misc)    | \
50                                       (1<<fulltag_symbol)  | \
51                                       (1<<fulltag_function)))
52#else
53#define is_node_fulltag(f)  ((1<<(f))&((1<<fulltag_cons) | \
54                                       (1<<fulltag_misc) | \
55                                       (1<<fulltag_tra)))
56#endif
57#endif
58
59#ifdef ARM
60#define is_node_fulltag(f)  ((1<<(f))&((1<<fulltag_cons)|(1<<fulltag_misc)))
61#endif
62
63extern void zero_memory_range(BytePtr,BytePtr);
64extern LispObj GCarealow, GCareadynamiclow;
65extern natural GCndnodes_in_area, GCndynamic_dnodes_in_area;
66extern bitvector GCmarkbits, GCdynamic_markbits;
67LispObj *global_reloctab, *GCrelocptr;
68LispObj GCfirstunmarked;
69
70extern natural lisp_heap_gc_threshold;
71extern natural lisp_heap_notify_threshold;
72void mark_root(LispObj);
73void mark_pc_root(LispObj);
74void mark_locative_root(LispObj);
75void rmark(LispObj);
76void postGCfree(void *);
77LispObj *skip_over_ivector(LispObj, LispObj);
78void mark_simple_area_range(LispObj *,LispObj *);
79LispObj calculate_relocation();
80LispObj locative_forwarding_address(LispObj);
81LispObj node_forwarding_address(LispObj);
82void forward_range(LispObj *, LispObj *);
83void forward_tcr_xframes(TCR *);
84void note_memoized_references(ExceptionInformation *,LogicalAddress, LogicalAddress, BytePtr *, BytePtr *);
85void gc(TCR *, signed_natural);
86int change_hons_area_size(TCR *, signed_natural);
87void delete_protected_area(protected_area_ptr);
88Boolean egc_control(Boolean, BytePtr);
89Boolean free_segments_zero_filled_by_OS;
90
91/* an type representing 1/4 of a natural word */
92#if WORD_SIZE == 64
93typedef unsigned short qnode;
94#else
95typedef unsigned char qnode;
96#endif
97
98
99#ifdef fulltag_symbol
100#define is_symbol_fulltag(x) (fulltag_of(x) == fulltag_symbol)
101#else
102#define is_symbol_fulltag(x) (fulltag_of(x) == fulltag_misc)
103#endif
104
105#define area_dnode(w,low) ((natural)(((ptr_to_lispobj(w)) - ptr_to_lispobj(low))>>dnode_shift))
106#define gc_area_dnode(w)  area_dnode(w,GCarealow)
107#define gc_dynamic_area_dnode(w) area_dnode(w,GCareadynamiclow)
108
109#if defined(PPC64) || defined(X8632)
110#define forward_marker subtag_forward_marker
111#else
112#ifdef ARM
113#define forward_marker (0xe7fffff0|uuo_format_unary)
114#else
115#define forward_marker fulltag_nil
116#endif
117#endif
118
119#ifdef PPC64
120#define VOID_ALLOCPTR ((LispObj)(0x8000000000000000-dnode_size))
121#else
122#define VOID_ALLOCPTR ((LispObj)(-dnode_size))
123#endif
124
125#ifdef DARWIN
126#include <mach/task_info.h>
127typedef struct task_events_info paging_info;
128#else
129#ifndef WINDOWS
130#include <sys/resource.h>
131typedef struct rusage paging_info;
132#else
133typedef natural paging_info;
134#endif
135#endif
136
137#undef __argv
138#include <stdio.h>
139
140void sample_paging_info(paging_info *);
141void report_paging_info_delta(FILE*, paging_info *, paging_info *);
142
143
144#define GC_TRAP_FUNCTION_IMMEDIATE_GC (-1)
145#define GC_TRAP_FUNCTION_GC 0
146#define GC_TRAP_FUNCTION_PURIFY 1
147#define GC_TRAP_FUNCTION_IMPURIFY 2
148#define GC_TRAP_FUNCTION_FLASH_FREEZE 4
149#define GC_TRAP_FUNCTION_SAVE_APPLICATION 8
150
151#define GC_TRAP_FUNCTION_GET_LISP_HEAP_THRESHOLD 16
152#define GC_TRAP_FUNCTION_SET_LISP_HEAP_THRESHOLD 17
153#define GC_TRAP_FUNCTION_USE_LISP_HEAP_THRESHOLD 18
154#define GC_TRAP_FUNCTION_ENSURE_STATIC_CONSES 19
155#define GC_TRAP_FUNCTION_GET_GC_NOTIFICATION_THRESHOLD 20
156#define GC_TRAP_FUNCTION_SET_GC_NOTIFICATION_THRESHOLD 21
157#define GC_TRAP_FUNCTION_ALLOCATION_CONTROL 22
158#define GC_TRAP_FUNCTION_EGC_CONTROL 32
159#define GC_TRAP_FUNCTION_CONFIGURE_EGC 64
160#define GC_TRAP_FUNCTION_FREEZE 129
161#define GC_TRAP_FUNCTION_THAW 130
162
163Boolean GCDebug, GCverbose, just_purified_p;
164bitvector GCmarkbits, GCdynamic_markbits;
165LispObj GCarealow, GCareadynamiclow;
166natural GCndnodes_in_area, GCndynamic_dnodes_in_area;
167LispObj GCweakvll,GCdwsweakvll;
168LispObj GCephemeral_low;
169natural GCn_ephemeral_dnodes;
170natural GCstack_limit;
171
172#if WORD_SIZE == 64
173unsigned short *_one_bits;
174#else
175const unsigned char _one_bits[256];
176#endif
177
178#define one_bits(x) _one_bits[x]
179
180natural static_dnodes_for_area(area *a);
181void reapweakv(LispObj weakv);
182void reaphashv(LispObj hashv);
183Boolean mark_weak_hash_vector(hash_table_vector_header *hashp, natural elements);
184Boolean mark_weak_alist(LispObj weak_alist, int weak_type);
185void mark_tcr_tlb(TCR *);
186void mark_tcr_xframes(TCR *);
187void freeGCptrs(void);
188void reap_gcable_ptrs(void);
189unsigned short logcount16(unsigned short);
190void gc_init(void);
191LispObj node_forwarding_address(LispObj);
192Boolean update_noderef(LispObj *);
193void update_locref(LispObj *);
194void forward_gcable_ptrs(void);
195void forward_memoized_area(area *, natural);
196void forward_tcr_tlb(TCR *);
197void reclaim_static_dnodes(void);
198Boolean youngest_non_null_area_p(area *);
199void gc(TCR *, signed_natural);
200
201/* backend-interface */
202
203typedef void (*weak_mark_fun) (LispObj);
204weak_mark_fun mark_weak_htabv, dws_mark_weak_htabv;
205
206typedef void (*weak_process_fun)(void);
207
208weak_process_fun markhtabvs;
209
210
211#define hash_table_vector_header_count (sizeof(hash_table_vector_header)/sizeof(LispObj))
212
213void mark_root(LispObj);
214void rmark(LispObj);
215#ifdef X8632
216void mark_xp(ExceptionInformation *, natural);
217#else
218void mark_xp(ExceptionInformation *);
219#endif
220LispObj dnode_forwarding_address(natural, int);
221LispObj locative_forwarding_address(LispObj);
222void check_refmap_consistency(LispObj *, LispObj *, bitvector);
223void check_all_areas(TCR *);
224void mark_tstack_area(area *);
225void mark_vstack_area(area *);
226void mark_cstack_area(area *);
227void mark_simple_area_range(LispObj *, LispObj *);
228void mark_memoized_area(area *, natural);
229LispObj calculate_relocation(void);
230void forward_range(LispObj *, LispObj *);
231void forward_tstack_area(area *);
232void forward_vstack_area(area *);
233void forward_cstack_area(area *);
234LispObj compact_dynamic_heap(void);
235signed_natural purify(TCR *, signed_natural);
236signed_natural impurify(TCR *, signed_natural);
237signed_natural gc_like_from_xp(ExceptionInformation *, signed_natural(*fun)(TCR *, signed_natural), signed_natural);
238
239
240typedef enum {
241  xmacptr_flag_none = 0,        /* Maybe already disposed by Lisp */
242  xmacptr_flag_recursive_lock,  /* recursive-lock */
243  xmacptr_flag_ptr,             /* malloc/free */
244  xmacptr_flag_rwlock,          /* read/write lock */
245  xmacptr_flag_semaphore,        /* semaphore */
246  xmacptr_flag_user_first = 8,  /* first user-defined dispose fn */
247  xmacptr_flag_user_last = 16   /* exclusive upper bound */
248} xmacptr_flag;
249
250
251typedef void (*xmacptr_dispose_fn)(void *);
252
253extern xmacptr_dispose_fn xmacptr_dispose_functions[];
254
255extern bitvector global_mark_ref_bits, dynamic_mark_ref_bits, relocatable_mark_ref_bits;
256
257extern Boolean
258did_gc_notification_since_last_full_gc;
259
260#endif                          /* __GC_H__ */
Note: See TracBrowser for help on using the repository browser.