raw
asciilifeform_shi...    1 
asciilifeform_shi... 2 How to hack TinyScheme
asciilifeform_shi... 3 ----------------------
asciilifeform_shi... 4
asciilifeform_shi... 5 TinyScheme is easy to learn and modify. It is structured like a
asciilifeform_shi... 6 meta-interpreter, only it is written in C. All data are Scheme
asciilifeform_shi... 7 objects, which facilitates both understanding/modifying the
asciilifeform_shi... 8 code and reifying the interpreter workings.
asciilifeform_shi... 9
asciilifeform_shi... 10 In place of a dry description, we will pace through the addition
asciilifeform_shi... 11 of a useful new datatype: garbage-collected memory blocks.
asciilifeform_shi... 12 The interface will be:
asciilifeform_shi... 13
asciilifeform_shi... 14 (make-block <n> [<fill>]) makes a new block of the specified size
asciilifeform_shi... 15 optionally filling it with a specified byte
asciilifeform_shi... 16 (block? <obj>)
asciilifeform_shi... 17 (block-length <block>)
asciilifeform_shi... 18 (block-ref <block> <index>) retrieves byte at location
asciilifeform_shi... 19 (block-set! <block> <index> <byte>) modifies byte at location
asciilifeform_shi... 20
asciilifeform_shi... 21 In the sequel, lines that begin with '>' denote lines to add to the
asciilifeform_shi... 22 code. Lines that begin with '|' are just citations of existing code.
asciilifeform_shi... 23 Lines that begin with X denote lines to be removed from the code.
asciilifeform_shi... 24
asciilifeform_shi... 25 First of all, we need to assign a typeid to our new type. Typeids
asciilifeform_shi... 26 in TinyScheme are small integers declared in the scheme_types enum
asciilifeform_shi... 27 located near the top of the scheme.c file; it begins with T_STRING.
asciilifeform_shi... 28 Add a new entry at the end, say T_MEMBLOCK. Remember to adjust the
asciilifeform_shi... 29 value of T_LAST_SYTEM_TYPE when adding new entries. There can be at
asciilifeform_shi... 30 most 31 types, but you don't have to worry about that limit yet.
asciilifeform_shi... 31
asciilifeform_shi... 32 | T_ENVIRONMENT=14,
asciilifeform_shi... 33 X T_LAST_SYSTEM_TYPE=14
asciilifeform_shi... 34 > T_MEMBLOCK=15,
asciilifeform_shi... 35 > T_LAST_SYSTEM_TYPE=15
asciilifeform_shi... 36 | };
asciilifeform_shi... 37
asciilifeform_shi... 38
asciilifeform_shi... 39 Then, some helper macros would be useful. Go to where is_string()
asciilifeform_shi... 40 and the rest are defined and add:
asciilifeform_shi... 41
asciilifeform_shi... 42 > INTERFACE INLINE int is_memblock(pointer p) { return (type(p)==T_MEMBLOCK); }
asciilifeform_shi... 43
asciilifeform_shi... 44 This actually is a function, because it is meant to be exported by
asciilifeform_shi... 45 scheme.h. If no foreign function will ever manipulate a memory block,
asciilifeform_shi... 46 you can instead define it as a macro:
asciilifeform_shi... 47
asciilifeform_shi... 48 > #define is_memblock(p) (type(p)==T_MEMBLOCK)
asciilifeform_shi... 49
asciilifeform_shi... 50 Then we make space for the new type in the main data structure:
asciilifeform_shi... 51 struct cell. As it happens, the _string part of the union _object
asciilifeform_shi... 52 (that is used to hold character strings) has two fields that suit us:
asciilifeform_shi... 53
asciilifeform_shi... 54 | struct {
asciilifeform_shi... 55 | char *_svalue;
asciilifeform_shi... 56 | int _keynum;
asciilifeform_shi... 57 | } _string;
asciilifeform_shi... 58
asciilifeform_shi... 59 We can use _svalue to hold the actual pointer and _keynum to hold its
asciilifeform_shi... 60 length. If we couln't reuse existing fields, we could always add other
asciilifeform_shi... 61 alternatives in union _object.
asciilifeform_shi... 62
asciilifeform_shi... 63 We then proceed to write the function that actually makes a new block.
asciilifeform_shi... 64 For conformance reasons, we name it mk_memblock
asciilifeform_shi... 65
asciilifeform_shi... 66 > static pointer mk_memblock(scheme *sc, int len, char fill) {
asciilifeform_shi... 67 > pointer x;
asciilifeform_shi... 68 > char *p=(char*)sc->malloc(len);
asciilifeform_shi... 69 >
asciilifeform_shi... 70 > if(p==0) {
asciilifeform_shi... 71 > return sc->NIL;
asciilifeform_shi... 72 > }
asciilifeform_shi... 73 > x = get_cell(sc, sc->NIL, sc->NIL);
asciilifeform_shi... 74 >
asciilifeform_shi... 75 > typeflag(x) = T_MEMBLOCK|T_ATOM;
asciilifeform_shi... 76 > strvalue(x)=p;
asciilifeform_shi... 77 > keynum(x)=len;
asciilifeform_shi... 78 > memset(p,fill,len);
asciilifeform_shi... 79 > return (x);
asciilifeform_shi... 80 > }
asciilifeform_shi... 81
asciilifeform_shi... 82 The memory used by the MEMBLOCK will have to be freed when the cell
asciilifeform_shi... 83 is reclaimed during garbage collection. There is a placeholder for
asciilifeform_shi... 84 that staff, function finalize_cell(), currently handling strings only.
asciilifeform_shi... 85
asciilifeform_shi... 86 | static void finalize_cell(scheme *sc, pointer a) {
asciilifeform_shi... 87 | if(is_string(a)) {
asciilifeform_shi... 88 | sc->free(strvalue(a));
asciilifeform_shi... 89 > } else if(is_memblock(a)) {
asciilifeform_shi... 90 > sc->free(strvalue(a));
asciilifeform_shi... 91 | } else if(is_port(a)) {
asciilifeform_shi... 92
asciilifeform_shi... 93 There are no MEMBLOCK literals, so we don't concern ourselves with
asciilifeform_shi... 94 the READER part (yet!). We must cater to the PRINTER, though. We
asciilifeform_shi... 95 add one case more in atom2str().
asciilifeform_shi... 96
asciilifeform_shi... 97 | } else if (iscontinuation(l)) {
asciilifeform_shi... 98 | p = "#<CONTINUATION>";
asciilifeform_shi... 99 > } else if (is_memblock(l)) {
asciilifeform_shi... 100 > p = "#<MEMORY BLOCK>";
asciilifeform_shi... 101 | } else {
asciilifeform_shi... 102
asciilifeform_shi... 103 Whenever a MEMBLOCK is displayed, it will look like that.
asciilifeform_shi... 104 Now, we must add the interface functions: constructor, predicate,
asciilifeform_shi... 105 accessor, modifier. We must in fact create new op-codes for the virtual
asciilifeform_shi... 106 machine underlying TinyScheme. Since version 1.30, TinyScheme uses
asciilifeform_shi... 107 macros and a single source text to keep the enums and the dispatch table
asciilifeform_shi... 108 in sync. The op-codes are defined in the opdefines.h file with one line
asciilifeform_shi... 109 for each op-code. The lines in the file have six columns between the
asciilifeform_shi... 110 starting _OPDEF( and ending ): A, B, C, D, E, and OP.
asciilifeform_shi... 111 Note that this file uses unusually long lines to accomodate all the
asciilifeform_shi... 112 information; adjust your editor to handle this.
asciilifeform_shi... 113
asciilifeform_shi... 114 The purpose of the columns is:
asciilifeform_shi... 115 - Column A is the name of the subroutine that handles the op-code.
asciilifeform_shi... 116 - Column B is the name of the op-code function.
asciilifeform_shi... 117 - Columns C and D are the minimum and maximum number of arguments
asciilifeform_shi... 118 that are accepted by the op-code.
asciilifeform_shi... 119 - Column E is a set of flags that tells the interpreter the type of
asciilifeform_shi... 120 each of the arguments expected by the op-code.
asciilifeform_shi... 121 - Column OP is used in the scheme_opcodes enum located in the
asciilifeform_shi... 122 scheme-private.h file.
asciilifeform_shi... 123
asciilifeform_shi... 124 Op-codes are really just tags for a huge C switch, only this switch
asciilifeform_shi... 125 is broken up in to a number of different opexe_X functions. The
asciilifeform_shi... 126 correspondence is made in table "dispatch_table". There, we assign
asciilifeform_shi... 127 the new op-codes to opexe_2, where the equivalent ones for vectors
asciilifeform_shi... 128 are situated. We also assign a name for them, and specify the minimum
asciilifeform_shi... 129 and maximum arity (number of expected arguments). INF_ARG as a maximum
asciilifeform_shi... 130 arity means "unlimited".
asciilifeform_shi... 131
asciilifeform_shi... 132 For reasons of consistency, we add the new op-codes right after those
asciilifeform_shi... 133 for vectors:
asciilifeform_shi... 134
asciilifeform_shi... 135 | _OP_DEF(opexe_2, "vector-set!", 3, 3, TST_VECTOR TST_NATURAL TST_ANY, OP_VECSET )
asciilifeform_shi... 136 > _OP_DEF(opexe_2, "make-block", 1, 2, TST_NATURAL TST_CHAR, OP_MKBLOCK )
asciilifeform_shi... 137 > _OP_DEF(opexe_2, "block-length", 1, 1, T_MEMBLOCK, OP_BLOCKLEN )
asciilifeform_shi... 138 > _OP_DEF(opexe_2, "block-ref", 2, 2, T_MEMBLOCK TST_NATURAL, OP_BLOCKREF )
asciilifeform_shi... 139 > _OP_DEF(opexe_2, "block-set!", 1, 1, T_MEMBLOCK TST_NATURAL TST_CHAR, OP_BLOCKSET )
asciilifeform_shi... 140 | _OP_DEF(opexe_3, "not", 1, 1, TST_NONE, OP_NOT )
asciilifeform_shi... 141
asciilifeform_shi... 142 We add the predicate along with the other predicates in opexe_3:
asciilifeform_shi... 143
asciilifeform_shi... 144 | _OP_DEF(opexe_3, "vector?", 1, 1, TST_ANY, OP_VECTORP )
asciilifeform_shi... 145 > _OP_DEF(opexe_3, "block?", 1, 1, TST_ANY, OP_BLOCKP )
asciilifeform_shi... 146 | _OP_DEF(opexe_3, "eq?", 2, 2, TST_ANY, OP_EQ )
asciilifeform_shi... 147
asciilifeform_shi... 148 All that remains is to write the actual code to do the processing and
asciilifeform_shi... 149 add it to the switch statement in opexe_2, after the OP_VECSET case.
asciilifeform_shi... 150
asciilifeform_shi... 151 > case OP_MKBLOCK: { /* make-block */
asciilifeform_shi... 152 > int fill=0;
asciilifeform_shi... 153 > int len;
asciilifeform_shi... 154 >
asciilifeform_shi... 155 > if(!isnumber(car(sc->args))) {
asciilifeform_shi... 156 > Error_1(sc,"make-block: not a number:",car(sc->args));
asciilifeform_shi... 157 > }
asciilifeform_shi... 158 > len=ivalue(car(sc->args));
asciilifeform_shi... 159 > if(len<=0) {
asciilifeform_shi... 160 > Error_1(sc,"make-block: not positive:",car(sc->args));
asciilifeform_shi... 161 > }
asciilifeform_shi... 162 >
asciilifeform_shi... 163 > if(cdr(sc->args)!=sc->NIL) {
asciilifeform_shi... 164 > if(!isnumber(cadr(sc->args)) || ivalue(cadr(sc->args))<0) {
asciilifeform_shi... 165 > Error_1(sc,"make-block: not a positive number:",cadr(sc->args));
asciilifeform_shi... 166 > }
asciilifeform_shi... 167 > fill=charvalue(cadr(sc->args))%255;
asciilifeform_shi... 168 > }
asciilifeform_shi... 169 > s_return(sc,mk_memblock(sc,len,(char)fill));
asciilifeform_shi... 170 > }
asciilifeform_shi... 171 >
asciilifeform_shi... 172 > case OP_BLOCKLEN: /* block-length */
asciilifeform_shi... 173 > if(!ismemblock(car(sc->args))) {
asciilifeform_shi... 174 > Error_1(sc,"block-length: not a memory block:",car(sc->args));
asciilifeform_shi... 175 > }
asciilifeform_shi... 176 > s_return(sc,mk_integer(sc,keynum(car(sc->args))));
asciilifeform_shi... 177 >
asciilifeform_shi... 178 > case OP_BLOCKREF: { /* block-ref */
asciilifeform_shi... 179 > char *str;
asciilifeform_shi... 180 > int index;
asciilifeform_shi... 181 >
asciilifeform_shi... 182 > if(!ismemblock(car(sc->args))) {
asciilifeform_shi... 183 > Error_1(sc,"block-ref: not a memory block:",car(sc->args));
asciilifeform_shi... 184 > }
asciilifeform_shi... 185 > str=strvalue(car(sc->args));
asciilifeform_shi... 186 >
asciilifeform_shi... 187 > if(cdr(sc->args)==sc->NIL) {
asciilifeform_shi... 188 > Error_0(sc,"block-ref: needs two arguments");
asciilifeform_shi... 189 > }
asciilifeform_shi... 190 > if(!isnumber(cadr(sc->args))) {
asciilifeform_shi... 191 > Error_1(sc,"block-ref: not a number:",cadr(sc->args));
asciilifeform_shi... 192 > }
asciilifeform_shi... 193 > index=ivalue(cadr(sc->args));
asciilifeform_shi... 194 >
asciilifeform_shi... 195 > if(index<0 || index>=keynum(car(sc->args))) {
asciilifeform_shi... 196 > Error_1(sc,"block-ref: out of bounds:",cadr(sc->args));
asciilifeform_shi... 197 > }
asciilifeform_shi... 198 >
asciilifeform_shi... 199 > s_return(sc,mk_integer(sc,str[index]));
asciilifeform_shi... 200 > }
asciilifeform_shi... 201 >
asciilifeform_shi... 202 > case OP_BLOCKSET: { /* block-set! */
asciilifeform_shi... 203 > char *str;
asciilifeform_shi... 204 > int index;
asciilifeform_shi... 205 > int c;
asciilifeform_shi... 206 >
asciilifeform_shi... 207 > if(!ismemblock(car(sc->args))) {
asciilifeform_shi... 208 > Error_1(sc,"block-set!: not a memory block:",car(sc->args));
asciilifeform_shi... 209 > }
asciilifeform_shi... 210 > if(isimmutable(car(sc->args))) {
asciilifeform_shi... 211 > Error_1(sc,"block-set!: unable to alter immutable memory block:",car(sc->args));
asciilifeform_shi... 212 > }
asciilifeform_shi... 213 > str=strvalue(car(sc->args));
asciilifeform_shi... 214 >
asciilifeform_shi... 215 > if(cdr(sc->args)==sc->NIL) {
asciilifeform_shi... 216 > Error_0(sc,"block-set!: needs three arguments");
asciilifeform_shi... 217 > }
asciilifeform_shi... 218 > if(!isnumber(cadr(sc->args))) {
asciilifeform_shi... 219 > Error_1(sc,"block-set!: not a number:",cadr(sc->args));
asciilifeform_shi... 220 > }
asciilifeform_shi... 221 > index=ivalue(cadr(sc->args));
asciilifeform_shi... 222 > if(index<0 || index>=keynum(car(sc->args))) {
asciilifeform_shi... 223 > Error_1(sc,"block-set!: out of bounds:",cadr(sc->args));
asciilifeform_shi... 224 > }
asciilifeform_shi... 225 >
asciilifeform_shi... 226 > if(cddr(sc->args)==sc->NIL) {
asciilifeform_shi... 227 > Error_0(sc,"block-set!: needs three arguments");
asciilifeform_shi... 228 > }
asciilifeform_shi... 229 > if(!isinteger(caddr(sc->args))) {
asciilifeform_shi... 230 > Error_1(sc,"block-set!: not an integer:",caddr(sc->args));
asciilifeform_shi... 231 > }
asciilifeform_shi... 232 > c=ivalue(caddr(sc->args))%255;
asciilifeform_shi... 233 >
asciilifeform_shi... 234 > str[index]=(char)c;
asciilifeform_shi... 235 > s_return(sc,car(sc->args));
asciilifeform_shi... 236 > }
asciilifeform_shi... 237
asciilifeform_shi... 238 Finally, do the same for the predicate in opexe_3.
asciilifeform_shi... 239
asciilifeform_shi... 240 | case OP_VECTORP: /* vector? */
asciilifeform_shi... 241 | s_retbool(is_vector(car(sc->args)));
asciilifeform_shi... 242 > case OP_BLOCKP: /* block? */
asciilifeform_shi... 243 > s_retbool(is_memblock(car(sc->args)));
asciilifeform_shi... 244 | case OP_EQ: /* eq? */