5
TinyScheme is easy to learn and modify. It is structured like a
6
meta-interpreter, only it is written in C. All data are Scheme
7
objects, which facilitates both understanding/modifying the
8
code and reifying the interpreter workings.
10
In place of a dry description, we will pace through the addition
11
of a useful new datatype: garbage-collected memory blocks.
12
The interface will be:
14
(make-block <n> [<fill>]) makes a new block of the specified size
15
optionally filling it with a specified byte
17
(block-length <block>)
18
(block-ref <block> <index>) retrieves byte at location
19
(block-set! <block> <index> <byte>) modifies byte at location
21
In the sequel, lines that begin with '>' denote lines to add to the
22
code. Lines that begin with '|' are just citations of existing code.
24
First of all, we need to assign a typeid to our new type. Typeids
25
in TinyScheme are small integers declared in an enum, very close to
26
the top; it begins with T_STRING. Add a new one at the end, say
27
T_MEMBLOCK. There can be at most 31 types, but you don't have to
28
worry about that limit yet.
32
| T_VECTOR, /* remember to add a comma to the preceding item! */
36
Then, some helper macros would be useful. Go to where isstring() and
37
the rest are defined and define:
39
> int ismemblock(pointer p) { return (type(p)==T_MEMBLOCK); }
41
This actually is a function, because it is meant to be exported by
42
scheme.h. If no foreign function will ever manipulate a memory block,
43
you can instead define it as a macro
45
> #define ismemblock(p) (type(p)==T_MEMBLOCK)
47
Then we make space for the new type in the main data structure:
48
struct cell. As it happens, the _string part of the union _object
49
(that is used to hold character strings) has two fields that suit us:
56
We can use _svalue to hold the actual pointer and _keynum to hold its
57
length. If we couln't reuse existing fields, we could always add other
58
alternatives in union _object.
60
We then procede to write the function that actually makes a new block.
61
For conformance reasons, we name it mk_memblock
63
> static pointer mk_memblock(scheme *sc, int len, char fill) {
65
> char *p=(char*)sc->malloc(len);
70
> x = get_cell(sc, sc->NIL, sc->NIL);
72
> typeflag(x) = T_MEMBLOCK|T_ATOM;
79
The memory used by the MEMBLOCK will have to be freed when the cell
80
is reclaimed during garbage collection. There is a placeholder for
81
that staff, function finalize_cell(), currently handling strings only.
83
| static void finalize_cell(scheme *sc, pointer a) {
85
| sc->free(strvalue(a));
87
> else if(ismemblock(a)) {
88
> sc->free(strvalue(x));
92
There are no MEMBLOCK literals, so we don't concern ourselfs with
93
the READER part (yet!). We must cater to the PRINTER, though. We
94
add one case more in printatom().
96
| } else if (iscontinuation(l)) {
97
| p = "#<CONTINUATION>";
98
> } else if (ismemblock(l)) {
99
> p = "#<MEMORY BLOCK>";
102
Whenever a MEMBLOCK is displayed, it will look like that.
103
Now, we must add the interface functions: constructor, predicate,
104
accessor, modifier. We must in fact create new op-codes for the virtual
105
machine underlying TinyScheme. There is a huge enum with OP_XXX values.
106
That's where the op-codes are declared. For reasons of cohesion, we add
107
the new op-codes right after those for vectors:
117
We add the predicate along the other predicates:
123
Op-codes are really just tags for a huge C switch, only this switch
124
is broke up in a number of different opexe_X functions. The
125
correspondence is made in table "dispatch_table". There, we assign
126
the new op-codes to opexe_2, where the equivalent ones for vectors
127
are situated. We also assign a name for them, and specify the minimum
128
and maximum arity. INF_ARG as a maximum arity means "unlimited".
130
| {opexe_2, "vector-set!", 3, 3}, /* OP_VECSET */
131
> {opexe_2, "make-block", 1, 2}, /* OP_MKBLOCK */
132
> {opexe_2, "block-length", 1, 1}, /* OP_BLOCKLEN */
133
> {opexe_2, "block-ref", 2, 2}, /* OP_BLOCKREF */
134
> {opexe_2, "block-set!",3 ,3}, /* OP_BLOCKSET */
136
The predicate goes with the other predicates, in opexe_3.
138
| {opexe_3, "vector?", 1, 1}, /* OP_VECTORP, */
139
> {opexe_3, "block?", 1, 1}, /* OP_BLOCKP, */
141
All that remains is to write the actual processing in opexe_2, right
144
> case OP_MKBLOCK: { /* make-block */
148
> if(!isnumber(car(sc->args))) {
149
> Error_1(sc,"make-block: not a number:",car(sc->args));
151
> len=ivalue(car(sc->args));
153
> Error_1(sc,"make-block: not positive:",car(sc->args));
156
> if(cdr(sc->args)!=sc->NIL) {
157
> if(!isnumber(cadr(sc->args)) || ivalue(cadr(sc->args))<0) {
158
> Error_1(sc,"make-block: not a positive number:",cadr(sc->args));
160
> fill=charvalue(cadr(sc->args))%255;
162
> s_return(sc,mk_memblock(sc,len,(char)fill));
165
> case OP_BLOCKLEN: /* block-length */
166
> if(!ismemblock(car(sc->args))) {
167
> Error_1(sc,"block-length: not a memory block:",car(sc->args));
169
> s_return(sc,mk_integer(sc,keynum(car(sc->args))));
171
> case OP_BLOCKREF: { /* block-ref */
175
> if(!ismemblock(car(sc->args))) {
176
> Error_1(sc,"block-ref: not a memory block:",car(sc->args));
178
> str=strvalue(car(sc->args));
180
> if(cdr(sc->args)==sc->NIL) {
181
> Error_0(sc,"block-ref: needs two arguments");
183
> if(!isnumber(cadr(sc->args))) {
184
> Error_1(sc,"block-ref: not a number:",cadr(sc->args));
186
> index=ivalue(cadr(sc->args));
188
> if(index<0 || index>=keynum(car(sc->args))) {
189
> Error_1(sc,"block-ref: out of bounds:",cadr(sc->args));
192
> s_return(sc,mk_integer(sc,str[index]));
195
> case OP_BLOCKSET: { /* block-set! */
200
> if(!ismemblock(car(sc->args))) {
201
> Error_1(sc,"block-set!: not a memory block:",car(sc->args));
203
> if(isimmutable(car(sc->args))) {
204
> Error_1(sc,"block-set!: unable to alter immutable memory block:",car(sc->args));
206
> str=strvalue(car(sc->args));
208
> if(cdr(sc->args)==sc->NIL) {
209
> Error_0(sc,"block-set!: needs three arguments");
211
> if(!isnumber(cadr(sc->args))) {
212
> Error_1(sc,"block-set!: not a number:",cadr(sc->args));
214
> index=ivalue(cadr(sc->args));
215
> if(index<0 || index>=keynum(car(sc->args))) {
216
> Error_1(sc,"block-set!: out of bounds:",cadr(sc->args));
219
> if(cddr(sc->args)==sc->NIL) {
220
> Error_0(sc,"block-set!: needs three arguments");
222
> if(!isinteger(caddr(sc->args))) {
223
> Error_1(sc,"block-set!: not an integer:",caddr(sc->args));
225
> c=ivalue(caddr(sc->args))%255;
227
> str[index]=(char)c;
228
> s_return(sc,car(sc->args));
231
Same for the predicate in opexe_3.
233
| case OP_VECTORP: /* vector? */
234
| s_retbool(isvector(car(sc->args)));
235
> case OP_BLOCKP: /* block? */
236
> s_retbool(ismemblock(car(sc->args)));
added
removed
plug-ins/script-fu/tinyscheme/hack.txt
