diff options
Diffstat (limited to 'plug-ins/script-fu/tinyscheme/hack.txt')
| -rw-r--r-- | plug-ins/script-fu/tinyscheme/hack.txt | 233 |
1 files changed, 233 insertions, 0 deletions
diff --git a/plug-ins/script-fu/tinyscheme/hack.txt b/plug-ins/script-fu/tinyscheme/hack.txt new file mode 100644 index 0000000..6aba7a7 --- /dev/null +++ b/plug-ins/script-fu/tinyscheme/hack.txt @@ -0,0 +1,233 @@ + + 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))); |