mirror of https://github.com/GNOME/gimp.git
plug-ins/script-fu/tinyscheme/scheme-private.h Changed tinyscheme to
2006-11-23 Simon Budig <simon@gimp.org> * plug-ins/script-fu/tinyscheme/scheme-private.h * plug-ins/script-fu/tinyscheme/scheme.[ch]: Changed tinyscheme to provide a safe spot to protect intermediate values from the garbage collector. Fixes some really ugly problems with arrays. Most likely not the best solution, we need to discuss this with the tinyscheme maintainers. * plug-ins/script-fu/scheme-wrapper.c: changed accordingly, plus reordering some stuff to protect it from the eager GC.
This commit is contained in:
parent
804b7953a4
commit
dce782a6b8
13
ChangeLog
13
ChangeLog
|
@ -1,3 +1,16 @@
|
|||
2006-11-23 Simon Budig <simon@gimp.org>
|
||||
|
||||
* plug-ins/script-fu/tinyscheme/scheme-private.h
|
||||
* plug-ins/script-fu/tinyscheme/scheme.[ch]: Changed tinyscheme
|
||||
to provide a safe spot to protect intermediate values from the
|
||||
garbage collector. Fixes some really ugly problems with arrays.
|
||||
|
||||
Most likely not the best solution, we need to discuss this with
|
||||
the tinyscheme maintainers.
|
||||
|
||||
* plug-ins/script-fu/scheme-wrapper.c: changed accordingly, plus
|
||||
reordering some stuff to protect it from the eager GC.
|
||||
|
||||
2006-11-23 Sven Neumann <sven@gimp.org>
|
||||
|
||||
* cursors/Makefile.am (EXTRA_DIST): added xbm/cursor-mouse-mask.xbm.
|
||||
|
|
|
@ -978,7 +978,7 @@ if (count > 0)
|
|||
{
|
||||
fprintf (stderr, " ");
|
||||
for (j = 0; j < count; ++j)
|
||||
fprintf (stderr, " %u",
|
||||
fprintf (stderr, " %ld",
|
||||
sc->vptr->ivalue ( sc->vptr->vector_elem (vector, j) ));
|
||||
fprintf (stderr, "\n");
|
||||
}
|
||||
|
@ -1310,6 +1310,7 @@ fprintf (stderr, " value %d is type %s (%d)\n",
|
|||
sc->vptr->mk_integer (sc,
|
||||
values[i + 1].data.d_int32),
|
||||
return_val);
|
||||
set_safe_foreign (sc, return_val);
|
||||
break;
|
||||
|
||||
case GIMP_PDB_INT16:
|
||||
|
@ -1317,6 +1318,7 @@ fprintf (stderr, " value %d is type %s (%d)\n",
|
|||
sc->vptr->mk_integer (sc,
|
||||
values[i + 1].data.d_int16),
|
||||
return_val);
|
||||
set_safe_foreign (sc, return_val);
|
||||
break;
|
||||
|
||||
case GIMP_PDB_INT8:
|
||||
|
@ -1324,6 +1326,7 @@ fprintf (stderr, " value %d is type %s (%d)\n",
|
|||
sc->vptr->mk_integer (sc,
|
||||
values[i + 1].data.d_int8),
|
||||
return_val);
|
||||
set_safe_foreign (sc, return_val);
|
||||
break;
|
||||
|
||||
case GIMP_PDB_FLOAT:
|
||||
|
@ -1331,6 +1334,7 @@ fprintf (stderr, " value %d is type %s (%d)\n",
|
|||
sc->vptr->mk_real (sc,
|
||||
values[i + 1].data.d_float),
|
||||
return_val);
|
||||
set_safe_foreign (sc, return_val);
|
||||
break;
|
||||
|
||||
case GIMP_PDB_STRING:
|
||||
|
@ -1340,6 +1344,7 @@ fprintf (stderr, " value %d is type %s (%d)\n",
|
|||
return_val = sc->vptr->cons (sc,
|
||||
sc->vptr->mk_string (sc, string),
|
||||
return_val);
|
||||
set_safe_foreign (sc, return_val);
|
||||
break;
|
||||
|
||||
case GIMP_PDB_INT32ARRAY:
|
||||
|
@ -1351,14 +1356,15 @@ fprintf (stderr, " value %d is type %s (%d)\n",
|
|||
gint32 *array = (gint32 *) values[i + 1].data.d_int32array;
|
||||
pointer vector = sc->vptr->mk_vector (sc, num_int32s);
|
||||
|
||||
return_val = sc->vptr->cons (sc, vector, return_val);
|
||||
set_safe_foreign (sc, return_val);
|
||||
|
||||
for (j = 0; j < num_int32s; j++)
|
||||
{
|
||||
sc->vptr->set_vector_elem (vector, j,
|
||||
sc->vptr->mk_integer (sc,
|
||||
array[j]));
|
||||
}
|
||||
|
||||
return_val = sc->vptr->cons (sc, vector, return_val);
|
||||
}
|
||||
break;
|
||||
|
||||
|
@ -1371,13 +1377,15 @@ fprintf (stderr, " value %d is type %s (%d)\n",
|
|||
gint16 *array = (gint16 *) values[i + 1].data.d_int16array;
|
||||
pointer vector = sc->vptr->mk_vector (sc, num_int16s);
|
||||
|
||||
return_val = sc->vptr->cons (sc, vector, return_val);
|
||||
set_safe_foreign (sc, return_val);
|
||||
|
||||
for (j = 0; j < num_int16s; j++)
|
||||
{
|
||||
sc->vptr->set_vector_elem (vector, j,
|
||||
sc->vptr->mk_integer (sc,
|
||||
array[j]));
|
||||
}
|
||||
return_val = sc->vptr->cons (sc, vector, return_val);
|
||||
}
|
||||
break;
|
||||
|
||||
|
@ -1390,14 +1398,15 @@ fprintf (stderr, " value %d is type %s (%d)\n",
|
|||
guint8 *array = (guint8 *) values[i + 1].data.d_int8array;
|
||||
pointer vector = sc->vptr->mk_vector (sc, num_int8s);
|
||||
|
||||
return_val = sc->vptr->cons (sc, vector, return_val);
|
||||
set_safe_foreign (sc, return_val);
|
||||
|
||||
for (j = 0; j < num_int8s; j++)
|
||||
{
|
||||
sc->vptr->set_vector_elem (vector, j,
|
||||
sc->vptr->mk_integer (sc,
|
||||
array[j]));
|
||||
}
|
||||
|
||||
return_val = sc->vptr->cons (sc, vector, return_val);
|
||||
}
|
||||
break;
|
||||
|
||||
|
@ -1410,14 +1419,15 @@ fprintf (stderr, " value %d is type %s (%d)\n",
|
|||
gdouble *array = (gdouble *) values[i + 1].data.d_floatarray;
|
||||
pointer vector = sc->vptr->mk_vector (sc, num_floats);
|
||||
|
||||
return_val = sc->vptr->cons (sc, vector, return_val);
|
||||
set_safe_foreign (sc, return_val);
|
||||
|
||||
for (j = 0; j < num_floats; j++)
|
||||
{
|
||||
sc->vptr->set_vector_elem (vector, j,
|
||||
sc->vptr->mk_real (sc,
|
||||
array[j]));
|
||||
}
|
||||
|
||||
return_val = sc->vptr->cons (sc, vector, return_val);
|
||||
}
|
||||
break;
|
||||
|
||||
|
@ -1430,14 +1440,15 @@ fprintf (stderr, " value %d is type %s (%d)\n",
|
|||
gchar **array = (gchar **) values[i + 1].data.d_stringarray;
|
||||
pointer vector = sc->vptr->mk_vector (sc, num_strings);
|
||||
|
||||
return_val = sc->vptr->cons (sc, vector, return_val);
|
||||
set_safe_foreign (sc, return_val);
|
||||
|
||||
for (j = 0; j < num_strings; j++)
|
||||
{
|
||||
sc->vptr->set_vector_elem (vector, j,
|
||||
sc->vptr->mk_string (sc,
|
||||
array[j]));
|
||||
}
|
||||
|
||||
return_val = sc->vptr->cons (sc, vector, return_val);
|
||||
}
|
||||
break;
|
||||
|
||||
|
@ -1447,11 +1458,17 @@ fprintf (stderr, " value %d is type %s (%d)\n",
|
|||
|
||||
gimp_rgb_get_uchar (&values[i + 1].data.d_color, &r, &g, &b);
|
||||
|
||||
intermediate_val = sc->vptr->cons (sc, sc->vptr->mk_integer (sc, r),
|
||||
sc->vptr->cons (sc, sc->vptr->mk_integer (sc, g),
|
||||
sc->vptr->cons (sc, sc->vptr->mk_integer (sc, b),
|
||||
sc->NIL)));
|
||||
return_val = sc->vptr->cons (sc, intermediate_val, return_val);
|
||||
intermediate_val = sc->vptr->cons (sc,
|
||||
sc->vptr->mk_integer (sc, r),
|
||||
sc->vptr->cons (sc,
|
||||
sc->vptr->mk_integer (sc, g),
|
||||
sc->vptr->cons (sc,
|
||||
sc->vptr->mk_integer (sc, b),
|
||||
sc->NIL)));
|
||||
return_val = sc->vptr->cons (sc,
|
||||
intermediate_val,
|
||||
return_val);
|
||||
set_safe_foreign (sc, return_val);
|
||||
break;
|
||||
}
|
||||
|
||||
|
@ -1465,39 +1482,46 @@ fprintf (stderr, " value %d is type %s (%d)\n",
|
|||
h = values[i + 1].data.d_region.height;
|
||||
|
||||
intermediate_val = sc->vptr->cons (sc,
|
||||
sc->vptr->mk_integer (sc, x),
|
||||
sc->vptr->cons (sc, sc->vptr->mk_integer (sc, y),
|
||||
sc->vptr->cons (sc, sc->vptr->mk_integer (sc, w),
|
||||
sc->vptr->cons (sc, sc->vptr->mk_integer (sc, h),
|
||||
sc->NIL))));
|
||||
return_val = sc->vptr->cons (sc, intermediate_val, return_val);
|
||||
sc->vptr->mk_integer (sc, x),
|
||||
sc->vptr->cons (sc,
|
||||
sc->vptr->mk_integer (sc, y),
|
||||
sc->vptr->cons (sc,
|
||||
sc->vptr->mk_integer (sc, w),
|
||||
sc->vptr->cons (sc,
|
||||
sc->vptr->mk_integer (sc, h),
|
||||
sc->NIL))));
|
||||
return_val = sc->vptr->cons (sc,
|
||||
intermediate_val,
|
||||
return_val);
|
||||
set_safe_foreign (sc, return_val);
|
||||
break;
|
||||
}
|
||||
break;
|
||||
|
||||
case GIMP_PDB_PARASITE:
|
||||
{
|
||||
pointer name, flags, data;
|
||||
|
||||
if (values[i + 1].data.d_parasite.name == NULL)
|
||||
return_val = my_err ("Error: null parasite", sc->NIL);
|
||||
else
|
||||
{
|
||||
name = sc->vptr->mk_string (sc,
|
||||
values[i + 1].data.d_parasite.name);
|
||||
/* don't move the mk_foo() calls outside this function call,
|
||||
* otherwise they might be garbage collected away! */
|
||||
intermediate_val = sc->vptr->cons (sc,
|
||||
sc->vptr->mk_string (sc,
|
||||
values[i + 1].data.d_parasite.name),
|
||||
sc->vptr->cons (sc,
|
||||
sc->vptr->mk_integer (sc,
|
||||
values[i + 1].data.d_parasite.flags),
|
||||
sc->vptr->cons (sc,
|
||||
sc->vptr->mk_counted_string (sc,
|
||||
values[i + 1].data.d_parasite.data,
|
||||
values[i + 1].data.d_parasite.size),
|
||||
sc->NIL)));
|
||||
return_val = sc->vptr->cons (sc,
|
||||
intermediate_val,
|
||||
return_val);
|
||||
set_safe_foreign (sc, return_val);
|
||||
|
||||
flags = sc->vptr->mk_integer (sc,
|
||||
values[i + 1].data.d_parasite.flags);
|
||||
|
||||
data = sc->vptr->mk_counted_string (sc,
|
||||
values[i + 1].data.d_parasite.data,
|
||||
values[i + 1].data.d_parasite.size);
|
||||
|
||||
intermediate_val = sc->vptr->cons (sc, name,
|
||||
sc->vptr->cons (sc, flags,
|
||||
sc->vptr->cons (sc, data,
|
||||
sc->NIL)));
|
||||
return_val = sc->vptr->cons (sc, intermediate_val, return_val);
|
||||
#if DEBUG_MARSHALL
|
||||
fprintf (stderr, " name '%s'\n", values[i+1].data.d_parasite.name);
|
||||
fprintf (stderr, " flags %d", values[i+1].data.d_parasite.flags);
|
||||
|
|
|
@ -63,11 +63,12 @@ char *alloc_seg[CELL_NSEGMENT];
|
|||
pointer cell_seg[CELL_NSEGMENT];
|
||||
int last_cell_seg;
|
||||
|
||||
/* We use 4 registers. */
|
||||
/* We use 5 registers. */
|
||||
pointer args; /* register for arguments of function */
|
||||
pointer envir; /* stack register for current environment */
|
||||
pointer code; /* register for current code */
|
||||
pointer dump; /* stack register for next evaluation */
|
||||
pointer safe_foreign; /* register to avoid gc problems */
|
||||
|
||||
int interactive_repl; /* are we in an interactive REPL? */
|
||||
int print_output; /* set to 1 to print results and error messages */
|
||||
|
|
|
@ -912,6 +912,15 @@ static pointer mk_number(scheme *sc, num n) {
|
|||
}
|
||||
}
|
||||
|
||||
void set_safe_foreign (scheme *sc, pointer data) {
|
||||
if (sc->safe_foreign == sc->NIL) {
|
||||
fprintf (stderr, "get_safe_foreign called outside a foreign function\n");
|
||||
} else {
|
||||
car (sc->safe_foreign) = data;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* char_cnt is length of string in chars. */
|
||||
/* str points to a NUL terminated string. */
|
||||
/* Only uses fill_char if str is NULL. */
|
||||
|
@ -1248,6 +1257,7 @@ static void gc(scheme *sc, pointer a, pointer b) {
|
|||
mark(sc->code);
|
||||
dump_stack_mark(sc);
|
||||
mark(sc->value);
|
||||
mark(sc->safe_foreign);
|
||||
mark(sc->inport);
|
||||
mark(sc->save_inport);
|
||||
mark(sc->outport);
|
||||
|
@ -2524,7 +2534,9 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
|
|||
if (is_proc(sc->code)) {
|
||||
s_goto(sc,procnum(sc->code)); /* PROCEDURE */
|
||||
} else if (is_foreign(sc->code)) {
|
||||
sc->safe_foreign = cons (sc, sc->NIL, sc->safe_foreign);
|
||||
x=sc->code->_object._ff(sc,sc->args);
|
||||
sc->safe_foreign = cdr (sc->safe_foreign);
|
||||
s_return(sc,x);
|
||||
} else if (is_closure(sc->code) || is_macro(sc->code)
|
||||
|| is_promise(sc->code)) { /* CLOSURE */
|
||||
|
@ -4487,6 +4499,7 @@ int scheme_init_custom_alloc(scheme *sc, func_alloc malloc, func_dealloc free) {
|
|||
sc->code = sc->NIL;
|
||||
sc->tracing=0;
|
||||
sc->bc_flag = 0;
|
||||
sc->safe_foreign = sc->NIL;
|
||||
|
||||
/* init sc->NIL */
|
||||
typeflag(sc->NIL) = (T_ATOM | MARK);
|
||||
|
|
|
@ -140,6 +140,7 @@ pointer mk_character(scheme *sc, gunichar c);
|
|||
pointer mk_foreign_func(scheme *sc, foreign_func f);
|
||||
void putstr(scheme *sc, const char *s);
|
||||
|
||||
void set_safe_foreign (scheme *sc, pointer data);
|
||||
|
||||
#if USE_INTERFACE
|
||||
struct scheme_interface {
|
||||
|
|
Loading…
Reference in New Issue