adding copy and string.count

femtolisp/cvalues.c

@@ -633,19 +633,35 @@ value_t cvalue_copy(value_t v)
     PUSH(v);
     cvalue_t *cv = (cvalue_t*)ptr(v);
     size_t nw = cv_nwords(cv);
-    value_t *pnv = alloc_words(nw);
+    cvalue_t *ncv = (cvalue_t*)alloc_words(nw);
     v = POP(); cv = (cvalue_t*)ptr(v);
-    memcpy(pnv, cv, nw * sizeof(value_t));
+    memcpy(ncv, cv, nw * sizeof(value_t));
     if (!isinlined(cv)) {
         size_t len = cv_len(cv);
         if (cv_isstr(cv)) len++;
-        void *data = malloc(len);
+        ncv->data = malloc(len);
-        memcpy(data, cv_data(cv), len);
+        memcpy(ncv->data, cv_data(cv), len);
-        ((cvalue_t*)pnv)->data = data;
+        autorelease(ncv);
-        autorelease((cvalue_t*)pnv);
+        if (hasparent(cv)) {
+            ncv->type = (fltype_t*)(((uptrint_t)ncv->type) & ~CV_PARENT_BIT);
+            ncv->parent = NIL;
+        }
+    }
+    else {
+        ncv->data = &ncv->_space[0];
     }
 
-    return tagptr(pnv, TAG_CVALUE);
+    return tagptr(ncv, TAG_CVALUE);
+}
+
+value_t fl_copy(value_t *args, u_int32_t nargs)
+{
+    argcount("copy", nargs, 1);
+    if (iscons(args[0]) || isvector(args[0]))
+        lerror(ArgError, "copy: argument must be a leaf atom");
+    if (!iscvalue(args[0]))
+        return args[0];
+    return cvalue_copy(args[0]);
 }
 
 static void cvalue_init(fltype_t *type, value_t v, void *dest)
@@ -828,6 +844,16 @@ value_t cbuiltin(char *name, builtin_t f)
     */
 }
 
+static builtinspec_t cvalues_builtin_info[] = {
+    { "c-value", cvalue_new },
+    { "typeof", cvalue_typeof },
+    { "sizeof", cvalue_sizeof },
+    { "builtin", fl_builtin },
+    { "copy", fl_copy },
+    // todo: autorelease
+    { NULL, NULL }
+};
+
 #define cv_intern(tok) tok##sym = symbol(#tok)
 #define ctor_cv_intern(tok) \
     cv_intern(tok);set(tok##sym, cbuiltin(#tok, cvalue_##tok))
@@ -873,11 +899,7 @@ void cvalues_init()
     cv_intern(union);
     cv_intern(void);
 
-    set(symbol("c-value"), cbuiltin("c-value", cvalue_new));
+    assign_global_builtins(cvalues_builtin_info);
-    set(symbol("typeof"), cbuiltin("typeof", cvalue_typeof));
-    set(symbol("sizeof"), cbuiltin("sizeof", cvalue_sizeof));
-    set(symbol("builtin"), cbuiltin("builtin", fl_builtin));
-    // todo: autorelease
 
     stringtypesym = symbol("*string-type*");
     setc(stringtypesym, list2(arraysym, bytesym));

femtolisp/string.c

@@ -41,13 +41,29 @@ value_t fl_stringp(value_t *args, u_int32_t nargs)
     return isstring(args[0]) ? FL_T : FL_F;
 }
 
-value_t fl_string_length(value_t *args, u_int32_t nargs)
+value_t fl_string_count(value_t *args, u_int32_t nargs)
 {
-    argcount("string.length", nargs, 1);
+    size_t start = 0;
+    if (nargs < 1 || nargs > 3)
+        argcount("string.count", nargs, 1);
     if (!isstring(args[0]))
-        type_error("string.length", "string", args[0]);
+        type_error("string.count", "string", args[0]);
     size_t len = cv_len((cvalue_t*)ptr(args[0]));
-    return size_wrap(u8_charnum(cvalue_data(args[0]), len));
+    size_t stop = len;
+    if (nargs > 1) {
+        start = toulong(args[1], "string.count");
+        if (start > len)
+            bounds_error("string.count", args[0], args[1]);
+        if (nargs > 2) {
+            stop = toulong(args[2], "string.count");
+            if (stop > len)
+                bounds_error("string.count", args[0], args[2]);
+            if (stop <= start)
+                return fixnum(0);
+        }
+    }
+    char *str = cvalue_data(args[0]);
+    return size_wrap(u8_charnum(str+start, stop-start));
 }
 
 value_t fl_string_reverse(value_t *args, u_int32_t nargs)
@@ -371,7 +387,7 @@ value_t fl_numbertostring(value_t *args, u_int32_t nargs)
 static builtinspec_t stringfunc_info[] = {
     { "string", fl_string },
     { "string?", fl_stringp },
-    { "string.length", fl_string_length },
+    { "string.count", fl_string_count },
     { "string.split", fl_string_split },
     { "string.sub", fl_string_sub },
     { "string.find", fl_string_find },

femtolisp/system.lsp

@@ -196,6 +196,8 @@
       (get-defined-vars B)))
    (f-body- e)))
 
+(define-macro (body . forms) (f-body forms))
+
 (define =   eqv)
 (define eql eqv)
 (define (/= a b) (not (equal a b)))
@@ -527,13 +529,13 @@
 (define (load filename)
   (let ((F (file filename :read)))
     (trycatch
-     (prog1
+     (let next (prev E v)
-      (let next (E v)
        (if (not (io.eof? F))
 	   (next (read F)
+                 prev
 		 (eval E))
-	    v))
+	   (begin (io.close F)
-      (io.close F))
+		  (eval E)))) ; evaluate last form in almost-tail position
      (lambda (e)
        (begin
 	 (io.close F)

femtolisp/todo

@@ -629,7 +629,7 @@ low-level functions:
 - (cset cvalue key value)   ; key is field name, index, or struct offset
   . write&use conv_from_long to put fixnums into typed locations
   . aset is the same
-- (copy cv)
+* (copy cv)
 - (offset type|cvalue field [field ...])
 - (eltype type field [field ...])
 - (memcpy dest-cv src-cv)
@@ -814,7 +814,7 @@ String API
 *string         - append/construct
 *string.inc     - (string.inc s i [nchars])
 *string.dec
- string.count   - # of chars between 2 byte offsets
+*string.count   - # of chars between 2 byte offsets
  string.width   - # columns
 *string.char    - char at byte offset
 *string.sub     - substring between 2 byte offsets