summaryrefslogtreecommitdiffstats
path: root/plug-ins/script-fu/tinyscheme/hack.txt
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--plug-ins/script-fu/tinyscheme/hack.txt233
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)));