hello.
From: Tom McKay <Tom_Mckay@avanticorp.com>
Subject: more on the gc problem
Date: Tue, 28 May 1996 20:57:57 -0400 (EDT)
> 1) initialize it once at the beginning?
> 2) should I set it whenever I enter / re-enter the C world from Scheme?
> 3) or something totally different?
you can call the function GC_get_stack_base() to get stack base. and
you can call init_scm() to initialize SCM like follows.
----Next_Part(Wed_May_29_11:27:10_1996)--
Content-Type: text/plain; charset=us-ascii
/**
Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved.
THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
Permission is hereby granted to use or copy this program
for any purpose, provided the above notices are retained on all copies.
Permission to modify the code and to distribute modified code is granted,
provided the above notices are retained, and a notice that the code was
modified is included with the above copyright notice.
**/
/**
modified by kuroda@msi.co.jp 1996/05/28
for scheme interpreter using conservative GC.
ex. SCM, STk
**/
/*** $Id: stkbase.c,v 1.4 1996/05/29 02:13:36 kuroda Exp $ ***/
GC_noop() {}
# include <stdio.h>
# include <signal.h>
# define VOLATILE volatile
typedef int word;
typedef int bool;
typedef char * ptr_t;
# ifdef _WINDOWS
# define WIN32_LEAN_AND_MEAN
# define NOSERVICE
# include <windows.h>
/* Get the page size. */
word GC_page_size = 0;
word GC_getpagesize()
{
SYSTEM_INFO sysinfo;
if (GC_page_size == 0) {
GetSystemInfo(&sysinfo);
GC_page_size = sysinfo.dwPageSize;
}
return(GC_page_size);
}
# define is_writable(prot) ((prot) == PAGE_READWRITE \
|| (prot) == PAGE_WRITECOPY \
|| (prot) == PAGE_EXECUTE_READWRITE \
|| (prot) == PAGE_EXECUTE_WRITECOPY)
/* Return the number of bytes that are writable starting at p. */
/* The pointer p is assumed to be page aligned. */
/* If base is not 0, *base becomes the beginning of the */
/* allocation region containing p. */
word GC_get_writable_length(ptr_t p, ptr_t *base)
{
MEMORY_BASIC_INFORMATION buf;
word result;
word protect;
result = VirtualQuery(p, &buf, sizeof(buf));
if (result != sizeof(buf)) {
printf(stderr,"Weird VirtualQuery result");
exit(-1);
}
if (base != 0) *base = (ptr_t)(buf.AllocationBase);
protect = (buf.Protect & ~(PAGE_GUARD | PAGE_NOCACHE));
if (!is_writable(protect)) {
return(0);
}
if (buf.State != MEM_COMMIT) return(0);
return(buf.RegionSize);
}
ptr_t GC_get_stack_base()
{
int dummy;
ptr_t sp = (ptr_t)(&dummy);
ptr_t trunc_sp = (ptr_t)((word)sp & ~(GC_getpagesize() - 1));
word size = GC_get_writable_length(trunc_sp, 0);
return(trunc_sp + size);
}
# else
# define NEED_FIND_LIMIT
# ifdef NEED_FIND_LIMIT
/* Some tools to implement HEURISTIC2 */
# define MIN_PAGE_SIZE 256 /* Smallest conceivable page size, bytes */
# include <setjmp.h>
/* static */ jmp_buf GC_jmp_buf;
/*ARGSUSED*/
void GC_fault_handler(sig)
int sig;
{
longjmp(GC_jmp_buf, 1);
}
# ifdef __STDC__
typedef void (*handler)(int);
# else
typedef void (*handler)();
# endif
/* Return the first nonaddressible location > p (up) or */
/* the smallest location q s.t. [q,p] is addressible (!up). */
ptr_t GC_find_limit(p, up)
ptr_t p;
bool up;
{
static VOLATILE ptr_t result;
/* Needs to be static, since otherwise it may not be */
/* preserved across the longjmp. Can safely be */
/* static since it's only called once, with the */
/* allocation lock held. */
static handler old_segv_handler, old_bus_handler;
/* See above for static declaration. */
old_segv_handler = signal(SIGSEGV, GC_fault_handler);
# ifdef SIGBUS
old_bus_handler = signal(SIGBUS, GC_fault_handler);
# endif
if (setjmp(GC_jmp_buf) == 0) {
result = (ptr_t)(((word)(p))
& ~(MIN_PAGE_SIZE-1));
for (;;) {
if (up) {
result += MIN_PAGE_SIZE;
} else {
result -= MIN_PAGE_SIZE;
}
GC_noop(*result);
}
}
(void) signal(SIGSEGV, old_segv_handler);
# ifdef SIGBUS
(void) signal(SIGBUS, old_bus_handler);
# endif
if (!up) {
result += MIN_PAGE_SIZE;
}
return(result);
}
# endif
ptr_t GC_get_stack_base()
{
word dummy;
ptr_t result;
# define TRUE 1
# define FALSE 0
# define STACKBOTTOM_ALIGNMENT_M1 ((word)STACK_GRAN - 1)
result = GC_find_limit((ptr_t)(&dummy), TRUE);
return(result);
}
# endif /* ! _WINDOWS */
int
__g()
{
int base;
printf("stack base at __g() = %x\n", &base);
printf("GC_get_stack_base() at __g() = %x\n", GC_get_stack_base());
}
int
__f()
{
int base;
printf("stack base at __f() = %x\n", &base);
printf("GC_get_stack_base() at __f() = %x\n", GC_get_stack_base());
__g();
}
/**
int
main()
{
int stack_base;
int val[100];
printf("stack base at main() = %x\n", &stack_base);
__f();
printf("GC_get_stack_base() at main() = %x\n", GC_get_stack_base());
}
**/
----Next_Part(Wed_May_29_11:27:10_1996)--
Content-Type: text/plain; charset=iso-2022-jp
/* Copyright (C) 1995 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
/*
* original code is gscm.c for guile-iii
* cut and modified by kuroda@msi.co.jp May 28 1996
*/
#include "gscm.h"
#include "_scm.h"
static _init_scm (in, out, err, initfn, initfile, initcmd, stack_base)
FILE * in;
FILE * out;
FILE * err;
GSCM_status (*initfn)();
char * initfile;
char * initcmd;
void * stack_base;
{
extern __declspec(dllimport) gscm_default_verbosity;
extern __declspec(dllimport) STACKITEM * scm_stack_base;
SCM_STACKITEM i;
GSCM_status status;
GSCM_top_level top;
scm_ports_prehistory ();
scm_smob_prehistory ();
scm_tables_prehistory ();
scm_init_storage (stack_base, 0/* init_heap_size */, in, out, err);
/* BASE (rootcont) gets set here */
scm_init_gsubr ();
scm_init_arbiters ();
scm_init_boolean ();
scm_init_chars ();
scm_init_continuations ();
scm_init_dynwind ();
scm_init_eq ();
scm_init_error ();
scm_init_feature ();
scm_init_fports ();
scm_init_files ();
scm_init_gc ();
scm_init_hash ();
scm_init_kw ();
scm_init_lvectors ();
scm_init_numbers ();
scm_init_pairs ();
scm_init_ports ();
scm_init_procs ();
scm_init_record ();
scm_init_repl (gscm_default_verbosity);
scm_init_scmsigs ();
scm_init_stackchk ();
scm_init_strports ();
scm_init_struct ();
scm_init_symbols ();
scm_init_time ();
scm_init_strings ();
scm_init_strop ();
scm_init_throw ();
scm_init_variable ();
scm_init_vectors ();
scm_init_vports ();
scm_init_eval ();
scm_init_ramap ();
scm_init_unif ();
scm_init_simpos ();
scm_init_guile ();
initfn ();
scm_exitval = MAKINUM (EXIT_SUCCESS);
scm_errjmp_bad = 0;
errno = 0;
scm_alrm_deferred = 0;
scm_sig_deferred = 0;
scm_ints_disabled = 1;
scm_stack_base = stack_base; /* $B%,!<%Y%C%8!&%3%l%/%?$K(B */
/* $B%9%?%C%/%Y!<%9$r65$($k!#(B*/
return status=GSCM_OK;
}
init_scm()
{
extern __declspec(DLL_SPEC) int scm_take_stdin;
GSCM_status status;
extern int * GC_get_stack_base();
scm_take_stdin = 1;
status = _init_scm (stdin, stdout, stderr,
guile_init,
0,
"()",
GC_get_stack_base()-1);
return status;
}
----Next_Part(Wed_May_29_11:27:10_1996)----