5cc3becf16
Changes are mostly to the dir structures and build system for ScriptFu. Some changes to the outer plugin source to call the library. Why: so that other executables (future gimp-scheme-interpreter, or a future separated script-fu-server) can exist in separate directories, and share the library in memory (when built shared.) Whether the library is built shared and installed on its own (versus static and not installed) is a compile time option (both automake LibTool and meson abstract it away) The default is shared and installed, say as libgimp-scriptfu-3.0.so. Installed alongside other shared libraries (e.g. wherever libgimp is installed) to simplify packaging. A preliminary refactoring which helps enable MR gimp!647
233 lines
9.3 KiB
Text
233 lines
9.3 KiB
Text
|
|
How to hack TinyScheme
|
|
----------------------
|
|
|
|
TinyScheme is easy to learn and modify. It is structured like a
|
|
meta-interpreter, only it is written in C. All data are Scheme
|
|
objects, which facilitates both understanding/modifying the
|
|
code and reifying the interpreter workings.
|
|
|
|
In place of a dry description, we will pace through the addition
|
|
of a useful new datatype: garbage-collected memory blocks.
|
|
The interface will be:
|
|
|
|
(make-block <n> [<fill>]) makes a new block of the specified size
|
|
optionally filling it with a specified byte
|
|
(block? <obj>)
|
|
(block-length <block>)
|
|
(block-ref <block> <index>) retrieves byte at location
|
|
(block-set! <block> <index> <byte>) modifies byte at location
|
|
|
|
In the sequel, lines that begin with '>' denote lines to add to the
|
|
code. Lines that begin with '|' are just citations of existing code.
|
|
Lines that begin with X are deleted.
|
|
|
|
First of all, we need to assign a typeid to our new type. Typeids
|
|
in TinyScheme are small integers declared in an enum, very close to
|
|
the top of scheme.c; it begins with T_STRING. Add a new one before the
|
|
end, call it T_MEMBLOCK. Adjust T_LAST_SYSTEM_TYPE.
|
|
|
|
| T_ENVIRONMENT=14,
|
|
X T_LAST_SYSTEM_TYPE=14
|
|
> T_MEMBLOCK=15,
|
|
> T_LAST_SYSTEM_TYPE=15
|
|
| };
|
|
|
|
Then, some helper macros would be useful. Go to where is_string() and
|
|
the rest are defined and define:
|
|
|
|
> int is_memblock(pointer p) { return (type(p)==T_MEMBLOCK); }
|
|
|
|
This actually is a function, because it is meant to be exported by
|
|
scheme.h. If no foreign function will ever manipulate a memory block,
|
|
you can instead define it as a macro
|
|
|
|
> #define is_memblock(p) (type(p)==T_MEMBLOCK)
|
|
|
|
Then we make space for the new type in the main data structure:
|
|
struct cell. As it happens, the _string part of the union _object
|
|
(that is used to hold character strings) has two fields that suit us:
|
|
|
|
| struct {
|
|
| char *_svalue;
|
|
| int _keynum;
|
|
| } _string;
|
|
|
|
We can use _svalue to hold the actual pointer and _keynum to hold its
|
|
length. If we couldn't reuse existing fields, we could always add other
|
|
alternatives in union _object.
|
|
|
|
We then proceed to write the function that actually makes a new block.
|
|
For conformance reasons, we name it mk_memblock
|
|
|
|
> static pointer mk_memblock(scheme *sc, int len, char fill) {
|
|
> pointer x;
|
|
> char *p=(char*)sc->malloc(len);
|
|
>
|
|
> if(p==0) {
|
|
> return sc->NIL;
|
|
> }
|
|
> x = get_cell(sc, sc->NIL, sc->NIL);
|
|
>
|
|
> typeflag(x) = T_MEMBLOCK|T_ATOM;
|
|
> strvalue(x)=p;
|
|
> keynum(x)=len;
|
|
> memset(p,fill,len);
|
|
> return (x);
|
|
> }
|
|
|
|
The memory used by the MEMBLOCK will have to be freed when the cell
|
|
is reclaimed during garbage collection. There is a placeholder for
|
|
that staff, function finalize_cell(), currently handling strings only.
|
|
|
|
| static void finalize_cell(scheme *sc, pointer a) {
|
|
| if(is_string(a)) {
|
|
| sc->free(strvalue(a));
|
|
> else if(is_memblock(a)) {
|
|
> sc->free(strvalue(a));
|
|
| } else if(is_port(a)) {
|
|
|
|
There are no MEMBLOCK literals, so we don't concern ourselves with
|
|
the READER part (yet!). We must cater to the PRINTER, though. We
|
|
add one case more in atom2str().
|
|
|
|
| } else if (is_foreign(l)) {
|
|
| p = sc->strbuff;
|
|
| snprintf(p,STRBUFFSIZE,"#<FOREIGN PROCEDURE %ld>", procnum(l));
|
|
> } else if (ismemblock(l)) {
|
|
> p = "#<MEMBLOCK>";
|
|
| } else if (is_continuation(l)) {
|
|
| p = "#<CONTINUATION>";
|
|
| } else {
|
|
|
|
Whenever a MEMBLOCK is displayed, it will look like that.
|
|
|
|
Now, we must add the interface functions: constructor, predicate,
|
|
accessor, modifier. We must in fact create new op-codes for the
|
|
virtual machine underlying TinyScheme. Since version 1.30, TinyScheme
|
|
uses macros and a single source text to keep the enums and the
|
|
dispatch table in sync. That's where the op-codes are declared. Note
|
|
that the opdefines.h file uses unusually long lines to accommodate
|
|
all the information; adjust your editor to handle this. The file has
|
|
six columns: A to Z. they contain:
|
|
- Column A is the name of a routine to handle the scheme function.
|
|
- Column B is the name the scheme function.
|
|
- Columns C and D are the minimum and maximum number of arguments
|
|
that are accepted by the scheme function.
|
|
- Column E is a set of flags that are used when the interpreter
|
|
verifies that the passed parameters are of the correct type.
|
|
- Column F is used to create a set of enums. The enum is used in a
|
|
switch in the routine listed in column A to get to the code that
|
|
does the work needed for the scheme function.
|
|
For reasons of cohesion, we add the new op-codes right after those
|
|
for vectors:
|
|
|
|
| _OP_DEF(opexe_2, "vector-set!", 3, 3, TST_VECTOR TST_NATURAL TST_ANY, OP_VECSET )
|
|
> _OP_DEF(opexe_2, "make-block", 1, 2, TST_NATURAL TST_CHAR, OP_MKBLOCK )
|
|
> _OP_DEF(opexe_2, "block-length", 1, 1, T_MEMBLOCK, OP_BLOCKLEN )
|
|
> _OP_DEF(opexe_2, "block-ref", 2, 2, T_MEMBLOCK TST_NATURAL, OP_BLOCKREF )
|
|
> _OP_DEF(opexe_2, "block-set!", 1, 1, T_MEMBLOCK TST_NATURAL TST_CHAR, OP_BLOCKSET )
|
|
| _OP_DEF(opexe_3, "not", 1, 1, TST_NONE, OP_NOT )
|
|
|
|
We add the predicate along the other predicates:
|
|
|
|
| _OP_DEF(opexe_3, "vector?", 1, 1, TST_ANY, OP_VECTORP )
|
|
> _OP_DEF(opexe_3, "block?", 1, 1, TST_ANY, OP_BLOCKP )
|
|
| _OP_DEF(opexe_3, "eq?", 2, 2, TST_ANY, OP_EQ )
|
|
|
|
All that remains is to write the actual processing in opexe_2, right
|
|
after OP_VECSET.
|
|
|
|
> case OP_MKBLOCK: { /* make-block */
|
|
> int fill=0;
|
|
> int len;
|
|
>
|
|
> if(!isnumber(car(sc->args))) {
|
|
> Error_1(sc,"make-block: not a number:",car(sc->args));
|
|
> }
|
|
> len=ivalue(car(sc->args));
|
|
> if(len<=0) {
|
|
> Error_1(sc,"make-block: not positive:",car(sc->args));
|
|
> }
|
|
>
|
|
> if(cdr(sc->args)!=sc->NIL) {
|
|
> if(!isnumber(cadr(sc->args)) || ivalue(cadr(sc->args))<0) {
|
|
> Error_1(sc,"make-block: not a positive number:",cadr(sc->args));
|
|
> }
|
|
> fill=charvalue(cadr(sc->args))%255;
|
|
> }
|
|
> s_return(sc,mk_memblock(sc,len,(char)fill));
|
|
> }
|
|
>
|
|
> case OP_BLOCKLEN: /* block-length */
|
|
> if(!ismemblock(car(sc->args))) {
|
|
> Error_1(sc,"block-length: not a memory block:",car(sc->args));
|
|
> }
|
|
> s_return(sc,mk_integer(sc,keynum(car(sc->args))));
|
|
>
|
|
> case OP_BLOCKREF: { /* block-ref */
|
|
> char *str;
|
|
> int index;
|
|
>
|
|
> if(!ismemblock(car(sc->args))) {
|
|
> Error_1(sc,"block-ref: not a memory block:",car(sc->args));
|
|
> }
|
|
> str=strvalue(car(sc->args));
|
|
>
|
|
> if(cdr(sc->args)==sc->NIL) {
|
|
> Error_0(sc,"block-ref: needs two arguments");
|
|
> }
|
|
> if(!isnumber(cadr(sc->args))) {
|
|
> Error_1(sc,"block-ref: not a number:",cadr(sc->args));
|
|
> }
|
|
> index=ivalue(cadr(sc->args));
|
|
>
|
|
> if(index<0 || index>=keynum(car(sc->args))) {
|
|
> Error_1(sc,"block-ref: out of bounds:",cadr(sc->args));
|
|
> }
|
|
>
|
|
> s_return(sc,mk_integer(sc,str[index]));
|
|
> }
|
|
>
|
|
> case OP_BLOCKSET: { /* block-set! */
|
|
> char *str;
|
|
> int index;
|
|
> int c;
|
|
>
|
|
> if(!ismemblock(car(sc->args))) {
|
|
> Error_1(sc,"block-set!: not a memory block:",car(sc->args));
|
|
> }
|
|
> if(isimmutable(car(sc->args))) {
|
|
> Error_1(sc,"block-set!: unable to alter immutable memory block:",car(sc->args));
|
|
> }
|
|
> str=strvalue(car(sc->args));
|
|
>
|
|
> if(cdr(sc->args)==sc->NIL) {
|
|
> Error_0(sc,"block-set!: needs three arguments");
|
|
> }
|
|
> if(!isnumber(cadr(sc->args))) {
|
|
> Error_1(sc,"block-set!: not a number:",cadr(sc->args));
|
|
> }
|
|
> index=ivalue(cadr(sc->args));
|
|
> if(index<0 || index>=keynum(car(sc->args))) {
|
|
> Error_1(sc,"block-set!: out of bounds:",cadr(sc->args));
|
|
> }
|
|
>
|
|
> if(cddr(sc->args)==sc->NIL) {
|
|
> Error_0(sc,"block-set!: needs three arguments");
|
|
> }
|
|
> if(!isinteger(caddr(sc->args))) {
|
|
> Error_1(sc,"block-set!: not an integer:",caddr(sc->args));
|
|
> }
|
|
> c=ivalue(caddr(sc->args))%255;
|
|
>
|
|
> str[index]=(char)c;
|
|
> s_return(sc,car(sc->args));
|
|
> }
|
|
|
|
Same for the predicate in opexe_3.
|
|
|
|
| case OP_VECTORP: /* vector? */
|
|
| s_retbool(isvector(car(sc->args)));
|
|
> case OP_BLOCKP: /* block? */
|
|
> s_retbool(ismemblock(car(sc->args)));
|