Adding upstream version 2.10.22.upstream/2.10.22upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

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