dnrops
/
gimp
mirror of https://github.com/GNOME/gimp.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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:
Simon Budig 2006-11-23 21:14:01 +00:00 committed by Simon Budig
parent 804b7953a4
commit dce782a6b8
5 changed files with 90 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
ChangeLog
View File

@ -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.

90
plug-ins/script-fu/scheme-wrapper.c
View File

@ -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),
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);
return_val = sc->vptr->cons (sc,
intermediate_val,
return_val);
set_safe_foreign (sc, return_val);
break;
}
@ -1466,38 +1483,45 @@ fprintf (stderr, " value %d is type %s (%d)\n",
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->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);
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);
flags = sc->vptr->mk_integer (sc,
values[i + 1].data.d_parasite.flags);
data = sc->vptr->mk_counted_string (sc,
/* 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);
intermediate_val = sc->vptr->cons (sc, name,
sc->vptr->cons (sc, flags,
sc->vptr->cons (sc, data,
values[i + 1].data.d_parasite.size),
sc->NIL)));
return_val = sc->vptr->cons (sc, intermediate_val, return_val);
return_val = sc->vptr->cons (sc,
intermediate_val,
return_val);
set_safe_foreign (sc, 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);

3
plug-ins/script-fu/tinyscheme/scheme-private.h
View File

@ -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 */

13
plug-ins/script-fu/tinyscheme/scheme.c
View File

@ -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);

1
plug-ins/script-fu/tinyscheme/scheme.h
View File

@ -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 {