ref: 962acb87f81bc9ccdd5428c6561dd9cf6f696895
parent: a88cd71d79e142d686b01ff33624a4cc8febb268
author: aap <[email protected]>
date: Tue Aug 23 15:20:27 EDT 2022
implemented multics strings
--- a/subr.c
+++ b/subr.c
@@ -1011,6 +1011,80 @@
return l;
}
+/*
+ * Strings
+ */
+
+C *catenate_lsubr(void){+ int i, n;
+ char *s;
+ C *str;
+
+ n = 0;
+ for(i = 1; i <= largs.nargs; i++){+ NEEDNAME(largs.alist[i]);
+ n += strlen(largs.alist[i]->str);
+ }
+ n++;
+ s = malloc(n);
+ n = 0;
+ for(i = 1; i <= largs.nargs; i++){+ strcpy(s+n, largs.alist[i]->str);
+ n += strlen(largs.alist[i]->str);
+ }
+ s[n] = '\0';
+ str = mkstr(s);
+ free(s);
+ return str;
+}
+C *index_subr(void){+ char *p;
+ NEEDNAME(alist[0]);
+ NEEDNAME(alist[1]);
+ p = strstr(alist[0]->str, alist[1]->str);
+ return p == nil ? mkfix(0) : mkfix(p - alist[0]->str + 1);
+}
+C *stringlength_subr(void){+ NEEDNAME(alist[0]);
+ return mkfix(strlen(alist[0]->str));
+}
+C *substr_lsubr(void){+ char *s, c;
+ C *str;
+ int n;
+ if(largs.nargs < 2) err("error: arg count");+ NEEDNAME(largs.alist[1]);
+ if(!fixnump(largs.alist[2])) err("error: need fixnum");+ s = largs.alist[1]->str;
+ if(largs.alist[2]->fix >= 1 && largs.alist[2]->fix <= strlen(s))
+ s += largs.alist[2]->fix-1;
+ if(largs.nargs < 3)
+ return mkstr(s);
+ if(!fixnump(largs.alist[3])) err("error: need fixnum");+ n = strlen(s);
+ if(largs.alist[3]->fix < n)
+ n = largs.alist[3]->fix;
+ c = s[n];
+ s[n] = '\0';
+ str = mkstr(s);
+ s[n] = c;
+ return str;
+}
+C *getpname_subr(void){+ if(!symbolp(alist[0])) err("error: need symbol");+ return getpname(alist[0]);
+}
+C *makeatom_subr(void){+ NEEDNAME(alist[0]);
+ return mksym(alist[0]->str);
+}
+C *CtoI_subr(void){+ return nil;
+}
+C *ItoC_subr(void){+ return nil;
+}
+
/* Mapping */
/* zip is for internal use.
@@ -1312,6 +1386,15 @@
SUBR("FLATC", flatc_subr, 1) SUBR("FLATSIZE", flatsize_subr, 1) SUBR("READLIST", readlist_subr, 1)+
+ LSUBR("CATENATE", catenate_lsubr)+ SUBR("INDEX", index_subr, 2)+ SUBR("STRINGLENGTH", stringlength_subr, 1)+ LSUBR("SUBSTR", substr_lsubr)+ SUBR("GET_PNAME", getpname_subr, 1)+ SUBR("MAKE_ATOM", makeatom_subr, 1)+ SUBR("CTOI", CtoI_subr, 1)+ SUBR("ITOC", ItoC_subr, 1) LSUBR("MAPLIST", maplist_lsubr) LSUBR("MAPCAR", mapcar_lsubr)