diff --git a/miniscm/miniscm.c b/miniscm/miniscm.c index 6708a1a..e2b062d 100644 --- a/miniscm/miniscm.c +++ b/miniscm/miniscm.c @@ -1215,6 +1215,7 @@ register pointer a, b; #define OP_WRITEOUT 110 #define OP_CHAR2INT 111 +#define OP_STRINGREF 112 static FILE *tmpfp; static int tok; @@ -1955,6 +1956,27 @@ register short op; fprintf(outfp, "allocate %d new segments\n", alloc_cellseg((int) ivalue(car(args)))); s_return(T); + + case OP_STRINGREF: + if (!isstring(car(args))) { + Error_0("string-ref -- argument must be string"); + } + x = car(args); + + if (!isnumber(cadr(args))) { + Error_0("string-ref -- second argument must be int"); + } + y = cadr(args); + + if (strlen(strvalue(x)) <= ivalue(y)) { + Error_0("string-ref -- index out of range"); + } + + if (ivalue(y) < 0) { + Error_0("string-ref -- index cannot be negative"); + } + + s_return(mk_char_c(strvalue(x)[ivalue(y)])); } } @@ -2458,7 +2480,8 @@ pointer (*dispatch_table[])() = { opexe_7, /* OP_CLOSEOUT */ opexe_7, /* OP_WRITEOUT */ - opexe_2 /* OP_CHAR2INT */ + opexe_2, /* OP_CHAR2INT */ + opexe_4 /* OP_STRINGREF */ }; @@ -2617,6 +2640,8 @@ init_procs() mk_proc(OP_WRITEOUT, "write-char"); mk_proc(OP_CHAR2INT, "char->integer"); + + mk_proc(OP_STRINGREF, "string-ref"); }