miniscm: add string-ref

1 files changed, 26 insertions, 1 deletions

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