peter
/
UNSLISP
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

miniscm: add string-ref

This commit is contained in:
Peter McGoron 2024-09-08 09:48:52 -04:00
parent 775eb863ef
commit f26ab0db3f
1 changed files with 26 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
miniscm/miniscm.c
View File

@ -1215,6 +1215,7 @@ register pointer a, b;
#define OP_WRITEOUT 110 #define OP_WRITEOUT 110
#define OP_CHAR2INT 111 #define OP_CHAR2INT 111
#define OP_STRINGREF 112
static FILE *tmpfp; static FILE *tmpfp;
static int tok; static int tok;
@ -1955,6 +1956,27 @@ register short op;
fprintf(outfp, "allocate %d new segments\n", fprintf(outfp, "allocate %d new segments\n",
alloc_cellseg((int) ivalue(car(args)))); alloc_cellseg((int) ivalue(car(args))));
s_return(T); 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_CLOSEOUT */
opexe_7, /* OP_WRITEOUT */ 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_WRITEOUT, "write-char");
mk_proc(OP_CHAR2INT, "char->integer"); mk_proc(OP_CHAR2INT, "char->integer");
mk_proc(OP_STRINGREF, "string-ref");
} }