1 /* Copyright (C) 1995,1996 Free Software Foundation, Inc.
3 * This program is free software; you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation; either version 2, or (at your option)
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this software; see the file COPYING. If not, write to
15 * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
17 * As a special exception, the Free Software Foundation gives permission
18 * for additional uses of the text contained in its release of GUILE.
20 * The exception is that, if you link the GUILE library with other files
21 * to produce an executable, this does not by itself cause the
22 * resulting executable to be covered by the GNU General Public License.
23 * Your use of that executable is in no way restricted on account of
24 * linking the GUILE library code into it.
26 * This exception does not however invalidate any other reasons why
27 * the executable file might be covered by the GNU General Public License.
29 * This exception applies only to the code released by the
30 * Free Software Foundation under the name GUILE. If you copy
31 * code from other Free Software Foundation releases into a copy of
32 * GUILE, as the General Public License permits, the exception does
33 * not apply to the code that you add in this way. To avoid misleading
34 * anyone as to the status of such modified files, you must delete
35 * this exception notice from them.
37 * If you write modifications of your own for GUILE, it is your choice
38 * whether to permit this exception to apply to your modifications.
39 * If you do not wish that, delete this exception notice.
65 #define var_start(x, y) va_start(x, y)
68 #define var_start(x, y) va_start(x)
72 /* {heap tuning parameters}
74 * These are parameters for controlling memory allocation. The heap
75 * is the area out of which scm_cons, and object headers are allocated.
77 * Each heap cell is 8 bytes on a 32 bit machine and 16 bytes on a
78 * 64 bit machine. The units of the _SIZE parameters are bytes.
79 * Cons pairs and object headers occupy one heap cell.
81 * SCM_INIT_HEAP_SIZE is the initial size of heap. If this much heap is
82 * allocated initially the heap will grow by half its current size
83 * each subsequent time more heap is needed.
85 * If SCM_INIT_HEAP_SIZE heap cannot be allocated initially, SCM_HEAP_SEG_SIZE
86 * will be used, and the heap will grow by SCM_HEAP_SEG_SIZE when more
87 * heap is needed. SCM_HEAP_SEG_SIZE must fit into type scm_sizet. This code
88 * is in scm_init_storage() and alloc_some_heap() in sys.c
90 * If SCM_INIT_HEAP_SIZE can be allocated initially, the heap will grow by
91 * SCM_EXPHEAP(scm_heap_size) when more heap is needed.
93 * SCM_MIN_HEAP_SEG_SIZE is minimum size of heap to accept when more heap
96 * INIT_MALLOC_LIMIT is the initial amount of malloc usage which will
99 * SCM_MTRIGGER_HYSTERESIS is the amount of malloc storage that must be
100 * reclaimed by a GC triggered by must_malloc. If less than this is
101 * reclaimed, the trigger threshold is raised. [I don't know what a
102 * good value is. I arbitrarily chose 1/10 of the INIT_MALLOC_LIMIT to
103 * work around a oscillation that caused almost constant GC.]
106 #define SCM_INIT_HEAP_SIZE (32768L*sizeof(scm_cell))
107 #define SCM_MIN_HEAP_SEG_SIZE (2048L*sizeof(scm_cell))
109 # define SCM_HEAP_SEG_SIZE 32768L
112 # define SCM_HEAP_SEG_SIZE (7000L*sizeof(scm_cell))
114 # define SCM_HEAP_SEG_SIZE (16384L*sizeof(scm_cell))
117 #define SCM_EXPHEAP(scm_heap_size) (scm_heap_size*2)
118 #define SCM_INIT_MALLOC_LIMIT 100000
119 #define SCM_MTRIGGER_HYSTERESIS (SCM_INIT_MALLOC_LIMIT/10)
121 /* CELL_UP and CELL_DN are used by scm_init_heap_seg to find scm_cell aligned inner
122 bounds for allocated storage */
125 /*in 386 protected mode we must only adjust the offset */
126 # define CELL_UP(p) MK_FP(FP_SEG(p), ~7&(FP_OFF(p)+7))
127 # define CELL_DN(p) MK_FP(FP_SEG(p), ~7&FP_OFF(p))
130 # define CELL_UP(p) (SCM_CELLPTR)(~1L & ((long)(p)+1L))
131 # define CELL_DN(p) (SCM_CELLPTR)(~1L & (long)(p))
133 # define CELL_UP(p) (SCM_CELLPTR)(~(sizeof(scm_cell)-1L) & ((long)(p)+sizeof(scm_cell)-1L))
134 # define CELL_DN(p) (SCM_CELLPTR)(~(sizeof(scm_cell)-1L) & (long)(p))
141 * is the head of freelist of cons pairs.
143 SCM scm_freelist
= SCM_EOL
;
146 * is the number of bytes of must_malloc allocation needed to trigger gc.
152 * If set, don't expand the heap. Set only during gc, during which no allocation
153 * is supposed to take place anyway.
155 int scm_gc_heap_lock
= 0;
158 * Don't pause for collection if this is set -- just
162 int scm_block_gc
= 1;
164 /* If fewer than MIN_GC_YIELD cells are recovered during a garbage
165 * collection (GC) more space is allocated for the heap.
167 #define MIN_GC_YIELD (scm_heap_size/4)
169 /* During collection, this accumulates objects holding
172 SCM
*scm_weak_vectors
;
176 /* GC Statistics Keeping
178 unsigned long scm_cells_allocated
= 0;
179 unsigned long scm_mallocated
= 0;
180 unsigned long scm_gc_cells_collected
;
181 unsigned long scm_gc_malloc_collected
;
182 unsigned long scm_gc_ports_collected
;
183 unsigned long scm_gc_rt
;
184 unsigned long scm_gc_time_taken
= 0;
186 SCM_SYMBOL (sym_cells_allocated
, "cells-allocated");
187 SCM_SYMBOL (sym_heap_size
, "cell-heap-size");
188 SCM_SYMBOL (sym_mallocated
, "bytes-malloced");
189 SCM_SYMBOL (sym_mtrigger
, "gc-malloc-threshold");
190 SCM_SYMBOL (sym_heap_segments
, "cell-heap-segments");
191 SCM_SYMBOL (sym_gc_time_taken
, "gc-time-taken");
194 struct scm_heap_seg_data
196 /* lower and upper bounds of the segment */
197 SCM_CELLPTR bounds
[2];
199 /* address of the head-of-freelist pointer for this segment's cells.
200 All segments usually point to the same one, scm_freelist. */
203 /* number of SCM words per object in this segment */
206 /* If SEG_DATA->valid is non-zero, the conservative marking
207 functions will apply SEG_DATA->valid to the purported pointer and
208 SEG_DATA, and mark the object iff the function returns non-zero.
209 At the moment, I don't think anyone uses this. */
216 static void scm_mark_weak_vector_spines
SCM_P ((void));
217 static scm_sizet init_heap_seg
SCM_P ((SCM_CELLPTR
, scm_sizet
, int, SCM
*));
218 static void alloc_some_heap
SCM_P ((int, SCM
*));
222 /* Debugging functions. */
224 #ifdef DEBUG_FREELIST
226 /* Return the number of the heap segment containing CELL. */
232 for (i
= 0; i
< scm_n_heap_segs
; i
++)
233 if (SCM_PTR_LE (scm_heap_table
[i
].bounds
[0], (SCM_CELLPTR
) cell
)
234 && SCM_PTR_GT (scm_heap_table
[i
].bounds
[1], (SCM_CELLPTR
) cell
))
236 fprintf (stderr
, "which_seg: can't find segment containing cell %lx\n",
242 SCM_PROC (s_map_free_list
, "map-free-list", 0, 0, 0, scm_map_free_list
);
246 int last_seg
= -1, count
= 0;
249 fprintf (stderr
, "%d segments total\n", scm_n_heap_segs
);
250 for (f
= scm_freelist
; SCM_NIMP (f
); f
= SCM_CDR (f
))
252 int this_seg
= which_seg (f
);
254 if (this_seg
!= last_seg
)
257 fprintf (stderr
, " %5d cells in segment %d\n", count
, last_seg
);
264 fprintf (stderr
, " %5d cells in segment %d\n", count
, last_seg
);
268 return SCM_UNSPECIFIED
;
272 /* Number of calls to SCM_NEWCELL since startup. */
273 static unsigned long scm_newcell_count
;
275 /* Search freelist for anything that isn't marked as a free cell.
276 Abort if we find something. */
278 scm_check_freelist ()
283 for (f
= scm_freelist
; SCM_NIMP (f
); f
= SCM_CDR (f
), i
++)
284 if (SCM_CAR (f
) != (SCM
) scm_tc_free_cell
)
286 fprintf (stderr
, "Bad cell in freelist on newcell %lu: %d'th elt\n",
287 scm_newcell_count
, i
);
293 static int scm_debug_check_freelist
= 0;
295 scm_debug_newcell (SCM
*into
)
298 if (scm_debug_check_freelist
)
299 scm_check_freelist ();
301 /* The rest of this is supposed to be identical to the SCM_NEWCELL
303 if (SCM_IMP (scm_freelist
))
304 *into
= scm_gc_for_newcell ();
307 *into
= scm_freelist
;
308 scm_freelist
= SCM_CDR (scm_freelist
);
309 ++scm_cells_allocated
;
313 #endif /* DEBUG_FREELIST */
317 /* {Scheme Interface to GC}
320 SCM_PROC (s_gc_stats
, "gc-stats", 0, 0, 0, scm_gc_stats
);
327 SCM local_scm_mtrigger
;
328 SCM local_scm_mallocated
;
329 SCM local_scm_heap_size
;
330 SCM local_scm_cells_allocated
;
331 SCM local_scm_gc_time_taken
;
339 for (i
= scm_n_heap_segs
; i
--; )
340 heap_segs
= scm_cons (scm_cons (scm_ulong2num ((unsigned long)scm_heap_table
[i
].bounds
[1]),
341 scm_ulong2num ((unsigned long)scm_heap_table
[i
].bounds
[0])),
343 if (scm_n_heap_segs
!= n
)
347 local_scm_mtrigger
= scm_mtrigger
;
348 local_scm_mallocated
= scm_mallocated
;
349 local_scm_heap_size
= scm_heap_size
;
350 local_scm_cells_allocated
= scm_cells_allocated
;
351 local_scm_gc_time_taken
= scm_gc_time_taken
;
353 answer
= scm_listify (scm_cons (sym_gc_time_taken
, scm_ulong2num (local_scm_gc_time_taken
)),
354 scm_cons (sym_cells_allocated
, scm_ulong2num (local_scm_cells_allocated
)),
355 scm_cons (sym_heap_size
, scm_ulong2num (local_scm_heap_size
)),
356 scm_cons (sym_mallocated
, scm_ulong2num (local_scm_mallocated
)),
357 scm_cons (sym_mtrigger
, scm_ulong2num (local_scm_mtrigger
)),
358 scm_cons (sym_heap_segments
, heap_segs
),
369 scm_gc_rt
= SCM_INUM (scm_get_internal_run_time ());
370 scm_gc_cells_collected
= 0;
371 scm_gc_malloc_collected
= 0;
372 scm_gc_ports_collected
= 0;
378 scm_gc_rt
= SCM_INUM (scm_get_internal_run_time ()) - scm_gc_rt
;
379 scm_gc_time_taken
= scm_gc_time_taken
+ scm_gc_rt
;
380 scm_take_signal (SCM_GC_SIGNAL
);
384 SCM_PROC(s_object_address
, "object-address", 1, 0, 0, scm_object_addr
);
386 scm_object_addr (obj
)
389 return scm_ulong2num ((unsigned long)obj
);
393 SCM_PROC(s_gc
, "gc", 0, 0, 0, scm_gc
);
400 return SCM_UNSPECIFIED
;
405 /* {C Interface For When GC is Triggered}
409 scm_gc_for_alloc (ncells
, freelistp
)
415 if ((scm_gc_cells_collected
< MIN_GC_YIELD
) || SCM_IMP (*freelistp
))
417 alloc_some_heap (ncells
, freelistp
);
424 scm_gc_for_newcell ()
427 scm_gc_for_alloc (1, &scm_freelist
);
429 scm_freelist
= SCM_CDR (fl
);
440 /* During the critical section, only the current thread may run. */
441 SCM_THREAD_CRITICAL_SECTION_START
;
445 if (!scm_stack_base
|| scm_block_gc
)
454 /* unprotect any struct types with no instances */
460 pos
= &scm_type_obj_list
;
461 type_list
= scm_type_obj_list
;
462 while (type_list
!= SCM_EOL
)
463 if (SCM_VELTS (SCM_CAR (type_list
))[scm_struct_i_refcnt
])
465 pos
= SCM_CDRLOC (type_list
);
466 type_list
= SCM_CDR (type_list
);
470 *pos
= SCM_CDR (type_list
);
471 type_list
= SCM_CDR (type_list
);
476 /* flush dead entries from the continuation stack */
481 elts
= SCM_VELTS (scm_continuation_stack
);
482 bound
= SCM_LENGTH (scm_continuation_stack
);
483 x
= SCM_INUM (scm_continuation_stack_ptr
);
486 elts
[x
] = SCM_BOOL_F
;
493 /* Protect from the C stack. This must be the first marking
494 * done because it provides information about what objects
495 * are "in-use" by the C code. "in-use" objects are those
496 * for which the values from SCM_LENGTH and SCM_CHARS must remain
497 * usable. This requirement is stricter than a liveness
498 * requirement -- in particular, it constrains the implementation
499 * of scm_vector_set_length_x.
501 SCM_FLUSH_REGISTER_WINDOWS
;
502 /* This assumes that all registers are saved into the jmp_buf */
503 setjmp (scm_save_regs_gc_mark
);
504 scm_mark_locations ((SCM_STACKITEM
*) scm_save_regs_gc_mark
,
505 ( (scm_sizet
) (sizeof (SCM_STACKITEM
) - 1 +
506 sizeof scm_save_regs_gc_mark
)
507 / sizeof (SCM_STACKITEM
)));
510 /* stack_len is long rather than scm_sizet in order to guarantee that
511 &stack_len is long aligned */
512 #ifdef SCM_STACK_GROWS_UP
514 long stack_len
= (SCM_STACKITEM
*) (&stack_len
) - scm_stack_base
;
516 long stack_len
= scm_stack_size (scm_stack_base
);
518 scm_mark_locations (scm_stack_base
, (scm_sizet
) stack_len
);
521 long stack_len
= scm_stack_base
- (SCM_STACKITEM
*) (&stack_len
);
523 long stack_len
= scm_stack_size (scm_stack_base
);
525 scm_mark_locations ((scm_stack_base
- stack_len
), (scm_sizet
) stack_len
);
529 #else /* USE_THREADS */
531 /* Mark every thread's stack and registers */
532 scm_threads_mark_stacks();
534 #endif /* USE_THREADS */
536 /* FIXME: insert a phase to un-protect string-data preserved
537 * in scm_vector_set_length_x.
540 j
= SCM_NUM_PROTECTS
;
542 scm_gc_mark (scm_sys_protects
[j
]);
545 scm_gc_mark (scm_root
->handle
);
548 scm_mark_weak_vector_spines ();
556 SCM_THREAD_CRITICAL_SECTION_END
;
566 /* Mark an object precisely.
582 if (SCM_NCELLP (ptr
))
583 scm_wta (ptr
, "rogue pointer in ", "heap");
585 switch (SCM_TYP7 (ptr
))
587 case scm_tcs_cons_nimcar
:
588 if (SCM_GCMARKP (ptr
))
591 if (SCM_IMP (SCM_CDR (ptr
))) /* SCM_IMP works even with a GC mark */
596 scm_gc_mark (SCM_CAR (ptr
));
597 ptr
= SCM_GCCDR (ptr
);
599 case scm_tcs_cons_imcar
:
600 if (SCM_GCMARKP (ptr
))
603 ptr
= SCM_GCCDR (ptr
);
605 case scm_tcs_cons_gloc
:
606 if (SCM_GCMARKP (ptr
))
611 vcell
= SCM_CAR (ptr
) - 1L;
612 switch (SCM_CDR (vcell
))
616 ptr
= SCM_GCCDR (ptr
);
628 vtable_data
= (SCM
*)vcell
;
629 layout
= vtable_data
[scm_struct_i_layout
];
630 len
= SCM_LENGTH (layout
);
631 fields_desc
= SCM_CHARS (layout
);
632 /* We're using SCM_GCCDR here like STRUCT_DATA, except
633 that it removes the mark */
634 mem
= (SCM
*)SCM_GCCDR (ptr
);
638 for (x
= 0; x
< len
- 2; x
+= 2, ++mem
)
639 if (fields_desc
[x
] == 'p')
641 if (fields_desc
[x
] == 'p')
643 if (SCM_LAYOUT_TAILP (fields_desc
[x
+ 1]))
644 for (x
= *mem
; x
; --x
)
645 scm_gc_mark (*++mem
);
650 if (!SCM_CDR (vcell
))
652 SCM_SETGCMARK (vcell
);
653 ptr
= vtable_data
[scm_struct_i_vtable
];
660 case scm_tcs_closures
:
661 if (SCM_GCMARKP (ptr
))
664 if (SCM_IMP (SCM_CDR (ptr
)))
666 ptr
= SCM_CLOSCAR (ptr
);
669 scm_gc_mark (SCM_CLOSCAR (ptr
));
670 ptr
= SCM_GCCDR (ptr
);
673 case scm_tc7_lvector
:
677 if (SCM_GC8MARKP (ptr
))
679 SCM_SETGC8MARK (ptr
);
680 i
= SCM_LENGTH (ptr
);
684 if (SCM_NIMP (SCM_VELTS (ptr
)[i
]))
685 scm_gc_mark (SCM_VELTS (ptr
)[i
]);
686 ptr
= SCM_VELTS (ptr
)[0];
691 SCM_SETGC8MARK (ptr
);
692 scm_mark_locations (SCM_VELTS (ptr
),
695 (sizeof (SCM_STACKITEM
) + -1 + sizeof (scm_contregs
)) /
696 sizeof (SCM_STACKITEM
)));
711 case scm_tc7_mb_string
:
712 SCM_SETGC8MARK (ptr
);
715 case scm_tc7_substring
:
716 case scm_tc7_mb_substring
:
717 if (SCM_GC8MARKP(ptr
))
719 SCM_SETGC8MARK (ptr
);
724 if (SCM_GC8MARKP(ptr
))
726 scm_weak_vectors
[scm_n_weak
++] = ptr
;
727 if (scm_n_weak
>= scm_weak_size
)
729 SCM_SYSCALL (scm_weak_vectors
=
730 (SCM
*) realloc ((char *) scm_weak_vectors
,
731 sizeof (SCM
*) * (scm_weak_size
*= 2)));
732 if (scm_weak_vectors
== NULL
)
734 scm_gen_puts (scm_regular_string
,
737 scm_gen_puts (scm_regular_string
,
738 "\nFATAL ERROR DURING CRITICAL SCM_CODE SECTION\n",
740 exit(SCM_EXIT_FAILURE
);
743 SCM_SETGC8MARK (ptr
);
744 if (SCM_IS_WHVEC_ANY (ptr
))
751 len
= SCM_LENGTH (ptr
);
752 weak_keys
= SCM_IS_WHVEC (ptr
) || SCM_IS_WHVEC_B (ptr
);
753 weak_values
= SCM_IS_WHVEC_V (ptr
) || SCM_IS_WHVEC_B (ptr
);
755 for (x
= 0; x
< len
; ++x
)
758 alist
= SCM_VELTS (ptr
)[x
];
759 /* mark everything on the alist
760 * except the keys or values, according to weak_values and weak_keys.
762 while ( SCM_NIMP (alist
)
764 && !SCM_GCMARKP (alist
)
765 && SCM_NIMP (SCM_CAR (alist
))
766 && SCM_CONSP (SCM_CAR (alist
)))
771 kvpair
= SCM_CAR (alist
);
772 next_alist
= SCM_CDR (alist
);
775 * SCM_SETGCMARK (alist);
776 * SCM_SETGCMARK (kvpair);
778 * It may be that either the key or value is protected by
779 * an escaped reference to part of the spine of this alist.
780 * If we mark the spine here, and only mark one or neither of the
781 * key and value, they may never be properly marked.
782 * This leads to a horrible situation in which an alist containing
783 * freelist cells is exported.
785 * So only mark the spines of these arrays last of all marking.
786 * If somebody confuses us by constructing a weak vector
787 * with a circular alist then we are hosed, but at least we
788 * won't prematurely drop table entries.
791 scm_gc_mark (SCM_CAR (kvpair
));
793 scm_gc_mark (SCM_GCCDR (kvpair
));
796 if (SCM_NIMP (alist
))
802 case scm_tc7_msymbol
:
803 if (SCM_GC8MARKP(ptr
))
805 SCM_SETGC8MARK (ptr
);
806 scm_gc_mark (SCM_SYMBOL_FUNC (ptr
));
807 ptr
= SCM_SYMBOL_PROPS (ptr
);
809 case scm_tc7_ssymbol
:
810 if (SCM_GC8MARKP(ptr
))
812 SCM_SETGC8MARK (ptr
);
815 ptr
= (SCM
)(scm_heap_org
+ (((unsigned long)SCM_CAR (ptr
)) >> 8));
818 i
= SCM_PTOBNUM (ptr
);
819 if (!(i
< scm_numptob
))
821 if (SCM_GC8MARKP (ptr
))
823 if (SCM_PTAB_ENTRY(ptr
))
824 scm_gc_mark (SCM_PTAB_ENTRY(ptr
)->file_name
);
825 ptr
= (scm_ptobs
[i
].mark
) (ptr
);
829 if (SCM_GC8MARKP (ptr
))
831 switch SCM_TYP16 (ptr
)
832 { /* should be faster than going through scm_smobs */
833 case scm_tc_free_cell
:
834 /* printf("found free_cell %X ", ptr); fflush(stdout); */
835 SCM_SETGC8MARK (ptr
);
836 SCM_SETCDR (ptr
, SCM_EOL
);
838 case scm_tcs_bignums
:
840 SCM_SETGC8MARK (ptr
);
843 i
= SCM_SMOBNUM (ptr
);
844 if (!(i
< scm_numsmob
))
846 ptr
= (scm_smobs
[i
].mark
) (ptr
);
851 def
:scm_wta (ptr
, "unknown type in ", "gc_mark");
856 /* Mark a Region Conservatively
860 scm_mark_locations (x
, n
)
866 register SCM_CELLPTR ptr
;
869 if SCM_CELLP (*(SCM
**) & x
[m
])
871 ptr
= (SCM_CELLPTR
) SCM2PTR ((*(SCM
**) & x
[m
]));
873 j
= scm_n_heap_segs
- 1;
874 if ( SCM_PTR_LE (scm_heap_table
[i
].bounds
[0], ptr
)
875 && SCM_PTR_GT (scm_heap_table
[j
].bounds
[1], ptr
))
882 || SCM_PTR_GT (scm_heap_table
[i
].bounds
[1], ptr
))
884 else if (SCM_PTR_LE (scm_heap_table
[j
].bounds
[0], ptr
))
892 if (SCM_PTR_GT (scm_heap_table
[k
].bounds
[1], ptr
))
896 if (SCM_PTR_LE (scm_heap_table
[i
].bounds
[0], ptr
))
901 else if (SCM_PTR_LE (scm_heap_table
[k
].bounds
[0], ptr
))
905 if (SCM_PTR_GT (scm_heap_table
[j
].bounds
[1], ptr
))
911 if ( !scm_heap_table
[seg_id
].valid
912 || scm_heap_table
[seg_id
].valid (ptr
,
913 &scm_heap_table
[seg_id
]))
914 scm_gc_mark (*(SCM
*) & x
[m
]);
923 /* The following is a C predicate which determines if an SCM value can be
924 regarded as a pointer to a cell on the heap. The code is duplicated
925 from scm_mark_locations. */
933 register SCM_CELLPTR ptr
;
935 if SCM_CELLP (*(SCM
**) & value
)
937 ptr
= (SCM_CELLPTR
) SCM2PTR ((*(SCM
**) & value
));
939 j
= scm_n_heap_segs
- 1;
940 if ( SCM_PTR_LE (scm_heap_table
[i
].bounds
[0], ptr
)
941 && SCM_PTR_GT (scm_heap_table
[j
].bounds
[1], ptr
))
948 || SCM_PTR_GT (scm_heap_table
[i
].bounds
[1], ptr
))
950 else if (SCM_PTR_LE (scm_heap_table
[j
].bounds
[0], ptr
))
958 if (SCM_PTR_GT (scm_heap_table
[k
].bounds
[1], ptr
))
962 if (SCM_PTR_LE (scm_heap_table
[i
].bounds
[0], ptr
))
967 else if (SCM_PTR_LE (scm_heap_table
[k
].bounds
[0], ptr
))
971 if (SCM_PTR_GT (scm_heap_table
[j
].bounds
[1], ptr
))
977 if ( !scm_heap_table
[seg_id
].valid
978 || scm_heap_table
[seg_id
].valid (ptr
,
979 &scm_heap_table
[seg_id
]))
991 scm_mark_weak_vector_spines ()
995 for (i
= 0; i
< scm_n_weak
; ++i
)
997 if (SCM_IS_WHVEC_ANY (scm_weak_vectors
[i
]))
1004 obj
= scm_weak_vectors
[i
];
1005 ptr
= SCM_VELTS (scm_weak_vectors
[i
]);
1006 n
= SCM_LENGTH (scm_weak_vectors
[i
]);
1007 for (j
= 0; j
< n
; ++j
)
1012 while ( SCM_NIMP (alist
)
1013 && SCM_CONSP (alist
)
1014 && !SCM_GCMARKP (alist
)
1015 && SCM_NIMP (SCM_CAR (alist
))
1016 && SCM_CONSP (SCM_CAR (alist
)))
1018 SCM_SETGCMARK (alist
);
1019 SCM_SETGCMARK (SCM_CAR (alist
));
1020 alist
= SCM_GCCDR (alist
);
1032 register SCM_CELLPTR ptr
;
1033 #ifdef SCM_POINTERS_MUNGED
1034 register SCM scmptr
;
1037 #define scmptr (SCM)ptr
1039 register SCM nfreelist
;
1040 register SCM
*hp_freelist
;
1043 register scm_sizet j
;
1051 /* Reset all free list pointers. We'll reconstruct them completely
1053 for (i
= 0; i
< scm_n_heap_segs
; i
++)
1054 *scm_heap_table
[i
].freelistp
= SCM_EOL
;
1056 for (i
= 0; i
< scm_n_heap_segs
; i
++)
1058 /* Unmarked cells go onto the front of the freelist this heap
1059 segment points to. Rather than updating the real freelist
1060 pointer as we go along, we accumulate the new head in
1061 nfreelist. Then, if it turns out that the entire segment is
1062 free, we free (i.e., malloc's free) the whole segment, and
1063 simply don't assign nfreelist back into the real freelist. */
1064 hp_freelist
= scm_heap_table
[i
].freelistp
;
1065 nfreelist
= *hp_freelist
;
1067 span
= scm_heap_table
[i
].ncells
;
1068 ptr
= CELL_UP (scm_heap_table
[i
].bounds
[0]);
1069 seg_size
= CELL_DN (scm_heap_table
[i
].bounds
[1]) - ptr
;
1070 for (j
= seg_size
+ span
; j
-= span
; ptr
+= span
)
1072 #ifdef SCM_POINTERS_MUNGED
1073 scmptr
= PTR2SCM (ptr
);
1075 switch SCM_TYP7 (scmptr
)
1077 case scm_tcs_cons_gloc
:
1078 if (SCM_GCMARKP (scmptr
))
1080 if (SCM_CDR (SCM_CAR (scmptr
) - 1) == (SCM
)1)
1081 SCM_SETCDR (SCM_CAR (scmptr
) - 1, (SCM
) 0);
1086 vcell
= SCM_CAR (scmptr
) - 1L;
1088 if ((SCM_CDR (vcell
) == 0) || (SCM_CDR (vcell
) == 1))
1090 SCM
*p
= (SCM
*) SCM_GCCDR (scmptr
);
1091 m
+= p
[scm_struct_i_n_words
] * sizeof (SCM
);
1092 /* I feel like I'm programming in BCPL here... */
1093 free ((char *) p
[scm_struct_i_ptr
]);
1097 case scm_tcs_cons_imcar
:
1098 case scm_tcs_cons_nimcar
:
1099 case scm_tcs_closures
:
1100 if (SCM_GCMARKP (scmptr
))
1104 if (SCM_GC8MARKP (scmptr
))
1110 m
+= (1 + SCM_LENGTH (scmptr
)) * sizeof (SCM
);
1111 scm_must_free ((char *)(SCM_VELTS (scmptr
) - 1));
1115 case scm_tc7_vector
:
1116 case scm_tc7_lvector
:
1120 if (SCM_GC8MARKP (scmptr
))
1123 m
+= (SCM_LENGTH (scmptr
) * sizeof (SCM
));
1125 scm_must_free (SCM_CHARS (scmptr
));
1126 /* SCM_SETCHARS(scmptr, 0);*/
1129 if SCM_GC8MARKP (scmptr
)
1131 m
+= sizeof (long) * ((SCM_HUGE_LENGTH (scmptr
) + SCM_LONG_BIT
- 1) / SCM_LONG_BIT
);
1133 case scm_tc7_byvect
:
1134 if SCM_GC8MARKP (scmptr
)
1136 m
+= SCM_HUGE_LENGTH (scmptr
) * sizeof (char);
1140 if SCM_GC8MARKP (scmptr
)
1142 m
+= SCM_HUGE_LENGTH (scmptr
) * sizeof (long);
1145 if SCM_GC8MARKP (scmptr
)
1147 m
+= SCM_HUGE_LENGTH (scmptr
) * sizeof (short);
1150 case scm_tc7_llvect
:
1151 if SCM_GC8MARKP (scmptr
)
1153 m
+= SCM_HUGE_LENGTH (scmptr
) * sizeof (long_long
);
1157 if SCM_GC8MARKP (scmptr
)
1159 m
+= SCM_HUGE_LENGTH (scmptr
) * sizeof (float);
1162 if SCM_GC8MARKP (scmptr
)
1164 m
+= SCM_HUGE_LENGTH (scmptr
) * sizeof (double);
1167 if SCM_GC8MARKP (scmptr
)
1169 m
+= SCM_HUGE_LENGTH (scmptr
) * 2 * sizeof (double);
1171 case scm_tc7_substring
:
1172 case scm_tc7_mb_substring
:
1173 if (SCM_GC8MARKP (scmptr
))
1176 case scm_tc7_string
:
1177 case scm_tc7_mb_string
:
1178 if (SCM_GC8MARKP (scmptr
))
1180 m
+= SCM_HUGE_LENGTH (scmptr
) + 1;
1182 case scm_tc7_msymbol
:
1183 if (SCM_GC8MARKP (scmptr
))
1185 m
+= ( SCM_LENGTH (scmptr
)
1187 + sizeof (SCM
) * ((SCM
*)SCM_CHARS (scmptr
) - SCM_SLOTS(scmptr
)));
1188 scm_must_free ((char *)SCM_SLOTS (scmptr
));
1190 case scm_tc7_contin
:
1191 if SCM_GC8MARKP (scmptr
)
1193 m
+= SCM_LENGTH (scmptr
) * sizeof (SCM_STACKITEM
) + sizeof (scm_contregs
);
1195 case scm_tc7_ssymbol
:
1196 if SCM_GC8MARKP(scmptr
)
1202 if SCM_GC8MARKP (scmptr
)
1204 if SCM_OPENP (scmptr
)
1206 int k
= SCM_PTOBNUM (scmptr
);
1207 if (!(k
< scm_numptob
))
1209 /* Keep "revealed" ports alive. */
1210 if (scm_revealed_count(scmptr
) > 0)
1212 /* Yes, I really do mean scm_ptobs[k].free */
1213 /* rather than ftobs[k].close. .close */
1214 /* is for explicit CLOSE-PORT by user */
1215 (scm_ptobs
[k
].free
) (SCM_STREAM (scmptr
));
1216 SCM_SETSTREAM (scmptr
, 0);
1217 scm_remove_from_port_table (scmptr
);
1218 scm_gc_ports_collected
++;
1219 SCM_SETAND_CAR (scmptr
, ~SCM_OPN
);
1223 switch SCM_GCTYP16 (scmptr
)
1225 case scm_tc_free_cell
:
1226 if SCM_GC8MARKP (scmptr
)
1230 case scm_tcs_bignums
:
1231 if SCM_GC8MARKP (scmptr
)
1233 m
+= (SCM_NUMDIGS (scmptr
) * SCM_BITSPERDIG
/ SCM_CHAR_BIT
);
1235 #endif /* def SCM_BIGDIG */
1237 if SCM_GC8MARKP (scmptr
)
1239 switch ((int) (SCM_CAR (scmptr
) >> 16))
1241 case (SCM_IMAG_PART
| SCM_REAL_PART
) >> 16:
1242 m
+= sizeof (double);
1243 case SCM_REAL_PART
>> 16:
1244 case SCM_IMAG_PART
>> 16:
1245 m
+= sizeof (double);
1254 if SCM_GC8MARKP (scmptr
)
1259 k
= SCM_SMOBNUM (scmptr
);
1260 if (!(k
< scm_numsmob
))
1262 m
+= (scm_smobs
[k
].free
) ((SCM
) scmptr
);
1268 sweeperr
:scm_wta (scmptr
, "unknown type in ", "gc_sweep");
1272 if (SCM_CAR (scmptr
) == (SCM
) scm_tc_free_cell
)
1275 /* Stick the new cell on the front of nfreelist. */
1276 SCM_SETCAR (scmptr
, (SCM
) scm_tc_free_cell
);
1277 SCM_SETCDR (scmptr
, nfreelist
);
1282 SCM_CLRGC8MARK (scmptr
);
1285 SCM_CLRGCMARK (scmptr
);
1287 #ifdef GC_FREE_SEGMENTS
1290 scm_heap_size
-= seg_size
;
1291 free ((char *) scm_heap_table
[i
].bounds
[0]);
1292 scm_heap_table
[i
].bounds
[0] = 0;
1293 for (j
= i
+ 1; j
< scm_n_heap_segs
; j
++)
1294 scm_heap_table
[j
- 1] = scm_heap_table
[j
];
1295 scm_n_heap_segs
-= 1;
1296 i
--; /* We need to scan the segment just moved. */
1299 #endif /* ifdef GC_FREE_SEGMENTS */
1300 /* Update the real freelist pointer to point to the head of
1301 the list of free cells we've built for this segment. */
1302 *hp_freelist
= nfreelist
;
1304 #ifdef DEBUG_FREELIST
1305 scm_check_freelist ();
1306 scm_map_free_list ();
1309 scm_gc_cells_collected
+= n
;
1312 /* Scan weak vectors. */
1315 for (i
= 0; i
< scm_n_weak
; ++i
)
1317 if (!SCM_IS_WHVEC_ANY (scm_weak_vectors
[i
]))
1319 ptr
= SCM_VELTS (scm_weak_vectors
[i
]);
1320 n
= SCM_LENGTH (scm_weak_vectors
[i
]);
1321 for (j
= 0; j
< n
; ++j
)
1322 if (SCM_NIMP (ptr
[j
]) && SCM_FREEP (ptr
[j
]))
1323 ptr
[j
] = SCM_BOOL_F
;
1325 else /* if (SCM_IS_WHVEC_ANY (scm_weak_vectors[i])) */
1328 obj
= scm_weak_vectors
[i
];
1329 ptr
= SCM_VELTS (scm_weak_vectors
[i
]);
1330 n
= SCM_LENGTH (scm_weak_vectors
[i
]);
1331 for (j
= 0; j
< n
; ++j
)
1338 weak_keys
= SCM_IS_WHVEC (obj
) || SCM_IS_WHVEC_B (obj
);
1339 weak_values
= SCM_IS_WHVEC_V (obj
) || SCM_IS_WHVEC_B (obj
);
1344 while (SCM_NIMP (alist
)
1345 && SCM_CONSP (alist
)
1346 && SCM_NIMP (SCM_CAR (alist
))
1347 && SCM_CONSP (SCM_CAR (alist
)))
1352 key
= SCM_CAAR (alist
);
1353 value
= SCM_CDAR (alist
);
1354 if ( (weak_keys
&& SCM_NIMP (key
) && SCM_FREEP (key
))
1355 || (weak_values
&& SCM_NIMP (value
) && SCM_FREEP (value
)))
1357 *fixup
= SCM_CDR (alist
);
1360 fixup
= SCM_CDRLOC (alist
);
1361 alist
= SCM_CDR (alist
);
1367 scm_cells_allocated
= (scm_heap_size
- scm_gc_cells_collected
);
1368 scm_mallocated
-= m
;
1369 scm_gc_malloc_collected
= m
;
1375 /* {Front end to malloc}
1377 * scm_must_malloc, scm_must_realloc, scm_must_free
1379 * These functions provide services comperable to malloc, realloc, and
1380 * free. They are for allocating malloced parts of scheme objects.
1381 * The primary purpose of the front end is to impose calls to gc.
1385 * Return newly malloced storage or throw an error.
1387 * The parameter WHAT is a string for error reporting.
1388 * If the threshold scm_mtrigger will be passed by this
1389 * allocation, or if the first call to malloc fails,
1390 * garbage collect -- on the presumption that some objects
1391 * using malloced storage may be collected.
1393 * The limit scm_mtrigger may be raised by this allocation.
1396 scm_must_malloc (len
, what
)
1401 scm_sizet size
= len
;
1402 long nm
= scm_mallocated
+ size
;
1405 scm_wta (SCM_MAKINUM (len
), (char *) SCM_NALLOC
, what
);
1406 if ((nm
<= scm_mtrigger
))
1408 SCM_SYSCALL (ptr
= (char *) malloc (size
));
1411 scm_mallocated
= nm
;
1417 nm
= scm_mallocated
+ size
;
1418 SCM_SYSCALL (ptr
= (char *) malloc (size
));
1421 scm_mallocated
= nm
;
1422 if (nm
> scm_mtrigger
- SCM_MTRIGGER_HYSTERESIS
) {
1423 if (nm
> scm_mtrigger
)
1424 scm_mtrigger
= nm
+ nm
/ 2;
1426 scm_mtrigger
+= scm_mtrigger
/ 2;
1435 * is similar to scm_must_malloc.
1438 scm_must_realloc (where
, olen
, len
, what
)
1445 scm_sizet size
= len
;
1446 long nm
= scm_mallocated
+ size
- olen
;
1449 scm_wta (SCM_MAKINUM (len
), (char *) SCM_NALLOC
, what
);
1450 if ((nm
<= scm_mtrigger
))
1452 SCM_SYSCALL (ptr
= (char *) realloc (where
, size
));
1455 scm_mallocated
= nm
;
1460 nm
= scm_mallocated
+ size
- olen
;
1461 SCM_SYSCALL (ptr
= (char *) realloc (where
, size
));
1464 scm_mallocated
= nm
;
1465 if (nm
> scm_mtrigger
- SCM_MTRIGGER_HYSTERESIS
) {
1466 if (nm
> scm_mtrigger
)
1467 scm_mtrigger
= nm
+ nm
/ 2;
1469 scm_mtrigger
+= scm_mtrigger
/ 2;
1483 scm_wta (SCM_INUM0
, "already free", "");
1491 * Each heap segment is an array of objects of a particular size.
1492 * Every segment has an associated (possibly shared) freelist.
1493 * A table of segment records is kept that records the upper and
1494 * lower extents of the segment; this is used during the conservative
1495 * phase of gc to identify probably gc roots (because they point
1496 * into valid segments at reasonable offsets).
1500 * is true if the first segment was smaller than INIT_HEAP_SEG.
1501 * If scm_expmem is set to one, subsequent segment allocations will
1502 * allocate segments of size SCM_EXPHEAP(scm_heap_size).
1507 * is the lowest base address of any heap segment.
1509 SCM_CELLPTR scm_heap_org
;
1511 struct scm_heap_seg_data
* scm_heap_table
= 0;
1512 int scm_n_heap_segs
= 0;
1515 * is the total number of cells in heap segments.
1517 long scm_heap_size
= 0;
1520 * initializes a new heap segment and return the number of objects it contains.
1522 * The segment origin, segment size in bytes, and the span of objects
1523 * in cells are input parameters. The freelist is both input and output.
1525 * This function presume that the scm_heap_table has already been expanded
1526 * to accomodate a new segment record.
1531 init_heap_seg (seg_org
, size
, ncells
, freelistp
)
1532 SCM_CELLPTR seg_org
;
1537 register SCM_CELLPTR ptr
;
1538 #ifdef SCM_POINTERS_MUNGED
1539 register SCM scmptr
;
1544 SCM_CELLPTR seg_end
;
1545 scm_sizet new_seg_index
;
1546 scm_sizet n_new_objects
;
1548 if (seg_org
== NULL
)
1553 /* Compute the ceiling on valid object pointers w/in this segment.
1555 seg_end
= CELL_DN ((char *) ptr
+ size
);
1557 /* Find the right place and insert the segment record.
1560 for (new_seg_index
= 0;
1561 ( (new_seg_index
< scm_n_heap_segs
)
1562 && SCM_PTR_LE (scm_heap_table
[new_seg_index
].bounds
[0], seg_org
));
1568 for (i
= scm_n_heap_segs
; i
> new_seg_index
; --i
)
1569 scm_heap_table
[i
] = scm_heap_table
[i
- 1];
1574 scm_heap_table
[new_seg_index
].valid
= 0;
1575 scm_heap_table
[new_seg_index
].ncells
= ncells
;
1576 scm_heap_table
[new_seg_index
].freelistp
= freelistp
;
1577 scm_heap_table
[new_seg_index
].bounds
[0] = (SCM_CELLPTR
)ptr
;
1578 scm_heap_table
[new_seg_index
].bounds
[1] = (SCM_CELLPTR
)seg_end
;
1581 /* Compute the least valid object pointer w/in this segment
1583 ptr
= CELL_UP (ptr
);
1586 n_new_objects
= seg_end
- ptr
;
1588 /* Prepend objects in this segment to the freelist.
1590 while (ptr
< seg_end
)
1592 #ifdef SCM_POINTERS_MUNGED
1593 scmptr
= PTR2SCM (ptr
);
1595 SCM_SETCAR (scmptr
, (SCM
) scm_tc_free_cell
);
1596 SCM_SETCDR (scmptr
, PTR2SCM (ptr
+ ncells
));
1602 /* Patch up the last freelist pointer in the segment
1603 * to join it to the input freelist.
1605 SCM_SETCDR (PTR2SCM (ptr
), *freelistp
);
1606 *freelistp
= PTR2SCM (CELL_UP (seg_org
));
1608 scm_heap_size
+= (ncells
* n_new_objects
);
1617 alloc_some_heap (ncells
, freelistp
)
1621 struct scm_heap_seg_data
* tmptable
;
1625 /* Critical code sections (such as the garbage collector)
1626 * aren't supposed to add heap segments.
1628 if (scm_gc_heap_lock
)
1629 scm_wta (SCM_UNDEFINED
, "need larger initial", "heap");
1631 /* Expand the heap tables to have room for the new segment.
1632 * Do not yet increment scm_n_heap_segs -- that is done by init_heap_seg
1633 * only if the allocation of the segment itself succeeds.
1635 len
= (1 + scm_n_heap_segs
) * sizeof (struct scm_heap_seg_data
);
1637 SCM_SYSCALL (tmptable
= ((struct scm_heap_seg_data
*)
1638 realloc ((char *)scm_heap_table
, len
)));
1640 scm_wta (SCM_UNDEFINED
, "could not grow", "hplims");
1642 scm_heap_table
= tmptable
;
1645 /* Pick a size for the new heap segment.
1646 * The rule for picking the size of a segment is explained in
1651 len
= (scm_sizet
) (SCM_EXPHEAP (scm_heap_size
) * sizeof (scm_cell
));
1652 if ((scm_sizet
) (SCM_EXPHEAP (scm_heap_size
) * sizeof (scm_cell
)) != len
)
1656 len
= SCM_HEAP_SEG_SIZE
;
1661 smallest
= (ncells
* sizeof (scm_cell
));
1663 len
= (ncells
* sizeof (scm_cell
));
1665 /* Allocate with decaying ambition. */
1666 while ((len
>= SCM_MIN_HEAP_SEG_SIZE
)
1667 && (len
>= smallest
))
1669 SCM_SYSCALL (ptr
= (SCM_CELLPTR
) malloc (len
));
1672 init_heap_seg (ptr
, len
, ncells
, freelistp
);
1679 scm_wta (SCM_UNDEFINED
, "could not grow", "heap");
1684 SCM_PROC (s_unhash_name
, "unhash-name", 1, 0, 0, scm_unhash_name
);
1686 scm_unhash_name (name
)
1691 SCM_ASSERT (SCM_NIMP (name
) && SCM_SYMBOLP (name
), name
, SCM_ARG1
, s_unhash_name
);
1693 bound
= scm_n_heap_segs
;
1694 for (x
= 0; x
< bound
; ++x
)
1698 p
= (SCM_CELLPTR
)scm_heap_table
[x
].bounds
[0];
1699 pbound
= (SCM_CELLPTR
)scm_heap_table
[x
].bounds
[1];
1704 if (1 == (7 & (int)incar
))
1707 if ( ((name
== SCM_BOOL_T
) || (SCM_CAR (incar
) == name
))
1708 && (SCM_CDR (incar
) != 0)
1709 && (SCM_CDR (incar
) != 1))
1723 /* {GC Protection Helper Functions}
1735 scm_return_first (SCM elt
, ...)
1738 scm_return_first (elt
, va_alist
)
1748 scm_permanent_object (obj
)
1752 scm_permobjs
= scm_cons (obj
, scm_permobjs
);
1758 /* Protect OBJ from the garbage collector. OBJ will not be freed,
1759 even if all other references are dropped, until someone applies
1760 scm_unprotect_object to it. This function returns OBJ.
1762 Note that calls to scm_protect_object do not nest. You can call
1763 scm_protect_object any number of times on a given object, and the
1764 next call to scm_unprotect_object will unprotect it completely.
1766 Basically, scm_protect_object and scm_unprotect_object just
1767 maintain a list of references to things. Since the GC knows about
1768 this list, all objects it mentions stay alive. scm_protect_object
1769 adds its argument to the list; scm_unprotect_object remove its
1770 argument from the list. */
1772 scm_protect_object (obj
)
1775 /* This function really should use address hashing tables, but I
1776 don't know how to use them yet. For now we just use a list. */
1777 scm_protects
= scm_cons (obj
, scm_protects
);
1783 /* Remove any protection for OBJ established by a prior call to
1784 scm_protect_obj. This function returns OBJ.
1786 See scm_protect_obj for more information. */
1788 scm_unprotect_object (obj
)
1791 scm_protects
= scm_delq_x (obj
, scm_protects
);
1799 scm_init_storage (init_heap_size
)
1800 long init_heap_size
;
1804 j
= SCM_NUM_PROTECTS
;
1806 scm_sys_protects
[--j
] = SCM_BOOL_F
;
1808 scm_freelist
= SCM_EOL
;
1811 j
= SCM_HEAP_SEG_SIZE
;
1812 scm_mtrigger
= SCM_INIT_MALLOC_LIMIT
;
1813 scm_heap_table
= ((struct scm_heap_seg_data
*)
1814 scm_must_malloc (sizeof (struct scm_heap_seg_data
), "hplims"));
1815 if (0L == init_heap_size
)
1816 init_heap_size
= SCM_INIT_HEAP_SIZE
;
1818 if ((init_heap_size
!= j
)
1819 || !init_heap_seg ((SCM_CELLPTR
) malloc (j
), j
, 1, &scm_freelist
))
1821 j
= SCM_HEAP_SEG_SIZE
;
1822 if (!init_heap_seg ((SCM_CELLPTR
) malloc (j
), j
, 1, &scm_freelist
))
1827 scm_heap_org
= CELL_UP (scm_heap_table
[0].bounds
[0]);
1828 /* scm_hplims[0] can change. do not remove scm_heap_org */
1829 if (!(scm_weak_vectors
= (SCM
*) malloc ((scm_weak_size
= 32) * sizeof(SCM
*))))
1832 /* Initialise the list of ports. */
1833 scm_port_table
= (struct scm_port_table
**) malloc ((long) (sizeof (struct scm_port_table
)
1834 * scm_port_table_room
));
1835 if (!scm_port_table
)
1839 scm_undefineds
= scm_cons (SCM_UNDEFINED
, SCM_EOL
);
1840 SCM_SETCDR (scm_undefineds
, scm_undefineds
);
1842 scm_listofnull
= scm_cons (SCM_EOL
, SCM_EOL
);
1843 scm_nullstr
= scm_makstr (0L, 0);
1844 scm_nullvect
= scm_make_vector (SCM_INUM0
, SCM_UNDEFINED
, SCM_UNDEFINED
);
1845 scm_symhash
= scm_make_vector ((SCM
) SCM_MAKINUM (scm_symhash_dim
), SCM_EOL
, SCM_UNDEFINED
);
1846 scm_weak_symhash
= scm_make_weak_key_hash_table ((SCM
) SCM_MAKINUM (scm_symhash_dim
));
1847 scm_symhash_vars
= scm_make_vector ((SCM
) SCM_MAKINUM (scm_symhash_dim
), SCM_EOL
, SCM_UNDEFINED
);
1848 scm_stand_in_procs
= SCM_EOL
;
1849 scm_permobjs
= SCM_EOL
;
1850 scm_protects
= SCM_EOL
;
1851 scm_asyncs
= SCM_EOL
;
1852 scm_sysintern ("most-positive-fixnum", (SCM
) SCM_MAKINUM (SCM_MOST_POSITIVE_FIXNUM
));
1853 scm_sysintern ("most-negative-fixnum", (SCM
) SCM_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM
));
1855 scm_sysintern ("bignum-radix", SCM_MAKINUM (SCM_BIGRAD
));