[plt-scheme] embedding with 3m

From: Matthew Flatt (mflatt at cs.utah.edu)
Date: Sat Jan 27 17:04:13 EST 2007

In the "Inside MzScheme" manual, I've added an example that shows the
CGC embedding ported to 3m. The example will appear in the next
document build, but I've also appended it to the end of this message.

Meanwhile, I have some comments on your current code...

At Sat, 27 Jan 2007 19:42:35 +0000, dave wrote:
> void interpret(Scheme_Env *e, char *code)
> {
> 	MZ_GC_DECL_REG(0);
> 	mz_jmp_buf * volatile save, fresh;
> 	save = scheme_current_thread->error_buf;
>     	scheme_current_thread->error_buf = &fresh;
> 	
> 	if (scheme_setjmp(scheme_error_buf)) 
> 	{
> 		scheme_current_thread->error_buf = save;
> 		exit(-1);
> 	} 
> 	else 
> 	{
> 		scheme_eval_string_all(code, e, 1);
> 		scheme_current_thread->error_buf = save;
> 	}
> }

When there's no MZ_GC_REG(), then MZ_GC_DECL_REG() is not needed.

This function is actually fine without any 3m instrumentation, but only
because of the current implementation of things like scheme_setjmp().
You should assume that scheme_setjmp() might allocate (so `e' needs to
be registered), and you should assume that the value of
`scheme_current_thread->error_buf' might be GCable. Depending on how
you use this function in the long run, it's probably also better to
assume that `code' might be GCable. So, that's 3 things to save (and
`save' needs to be initialized):

void interpret(Scheme_Env *e, char *code)
{
	mz_jmp_buf * volatile save = NULL, fresh;

	MZ_GC_DECL_REG(3);
        MZ_GC_VAR_IN_REG(0, e);
        MZ_GC_VAR_IN_REG(1, code);
        MZ_GC_VAR_IN_REG(2, save);

        MZ_GC_REG();

	save = scheme_current_thread->error_buf;
    	scheme_current_thread->error_buf = &fresh;
	
	if (scheme_setjmp(scheme_error_buf)) 
	{
		scheme_current_thread->error_buf = save;
		exit(-1);
	} 
	else 
	{
		scheme_eval_string_all(code, e, 1);
		scheme_current_thread->error_buf = save;
	}


        MZ_GC_UNREG();
}

How do you know that you don't need to register `fresh'? The "Inside
MzScheme" manual should have told you, and I've fixed that.

Instead of doing this by hand, you could put the above function in
"i.c", then then run `mzc --xform i.c' to get "i.3m.c".

> int main(int argc, char *argv[])
> {
> 	void *stack_start;
> 	stack_start = (void *)&stack_start;
> 
> 	static Scheme_Env *e = NULL;
> 	#ifdef MZ_PRECISE_GC
> 	MZ_GC_DECL_REG(0);
> 	GC_init_type_tags(_scheme_last_type_, scheme_pair_type,
> scheme_weak_box_type, scheme_ephemeron_type, scheme_rt_weak_array);
> 	scheme_set_stack_base( &__gc_var_stack__, 1);
> 	#else
> 	scheme_set_stack_base( NULL, 1);
> 	#endif
>  
> 	MZ_REGISTER_STATIC(e);
> 	e = scheme_basic_env();
> 	scheme_set_can_break(1);	
> 
> 	while(1)
> 	{
> 		interpret(e,"(display \"hello\")(newline)");
> 	}
> 		
> 	return 0;
> }

The GC_init_type_tags() call is not needed in 369.5 and later. That
step is handled by scheme_set_stack_base().


The `e' variable should be registered as in interpret(), not using
MZ_REGISTER_STATIC(). Although `e' is static in the sense that it
exists for the entire program run, swapping in a MzScheme thread might
move `e' from the stack into the heap temporarily.

Again, because of the current implementation of MzScheme threads, this
program won't actually crash (because a thread will never start as low
a `e' on the stack), but you shouldn't rely on that.


I'm not sure that running main() though `mzc --xform' would work right.
To use mzc --xform', I recommend a minimal main() that includes
`MZ_GC_DECL_REG(0)' and `scheme_set_stack_base( &__gc_var_stack__, 1)'
and that calls another function to do all the interesting work (which
can be sent through `mzc --xform').

Matthew

----------------------------------------
/* Works with both CGC and 3m, depending on whether -DMZ_PRECISE_GC
   is specified on the compiler command line: */

#include "scheme.h"

int main(int argc, char *argv[])
{
  Scheme_Env *e = NULL;
  Scheme_Object *curout = NULL, *v = NULL;
  Scheme_Config *config = NULL;
  int i;
  mz_jmp_buf * volatile save = NULL, fresh;

  MZ_GC_DECL_REG(5);
  MZ_GC_VAR_IN_REG(0, e);
  MZ_GC_VAR_IN_REG(1, curout);
  MZ_GC_VAR_IN_REG(2, save);
  MZ_GC_VAR_IN_REG(3, config);
  MZ_GC_VAR_IN_REG(4, v);

# ifdef MZ_PRECISE_GC
#  define STACK_BASE &__gc_var_stack__
# else
#  define STACK_BASE NULL
# endif

  scheme_set_stack_base(STACK_BASE, 1);

  MZ_GC_REG();

  e = scheme_basic_env();

  config = scheme_current_config();
  curout = scheme_get_param(config, MZCONFIG_OUTPUT_PORT);

  for (i = 1; i < argc; i++) {
    save = scheme_current_thread->error_buf;
    scheme_current_thread->error_buf = &fresh;
    if (scheme_setjmp(scheme_error_buf)) {
      scheme_current_thread->error_buf = save;
      return -1; /* There was an error */
    } else {
      v = scheme_eval_string(argv[i], e);
      scheme_display(v, curout);
      v = scheme_make_character('\n');
      scheme_display(v, curout);
      /* read-eval-print loop, implicitly uses the initial Scheme_Env: */
      v = scheme_builtin_value("read-eval-print-loop");
      scheme_apply(v, 0, NULL);
      scheme_current_thread->error_buf = save;
    }
  }

  MZ_GC_UNREG();

  return 0;
}



Posted on the users mailing list.