shithub: femtolisp

Info  •  Files  •  Log  •  Branches

adding copy and string.count

--- a/femtolisp/cvalues.c

+++ b/femtolisp/cvalues.c

@@ -633,21 +633,37 @@

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

-        memcpy(data, cv_data(cv), len);

-        ((cvalue_t*)pnv)->data = data;

-        autorelease((cvalue_t*)pnv);

+        ncv->data = malloc(len);

+        memcpy(ncv->data, cv_data(cv), len);

+        autorelease(ncv);

+        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)

 {

     cvinitfunc_t f=type->init;

@@ -828,6 +844,16 @@

     */

 }

+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 @@

     cv_intern(union);

     cv_intern(void);

-    set(symbol("c-value"), cbuiltin("c-value", cvalue_new));

-    set(symbol("typeof"), cbuiltin("typeof", cvalue_typeof));

-    set(symbol("sizeof"), cbuiltin("sizeof", cvalue_sizeof));

-    set(symbol("builtin"), cbuiltin("builtin", fl_builtin));

-    // todo: autorelease

+    assign_global_builtins(cvalues_builtin_info);

     stringtypesym = symbol("*string-type*");

     setc(stringtypesym, list2(arraysym, bytesym));

--- a/femtolisp/string.c

+++ b/femtolisp/string.c

@@ -41,13 +41,29 @@

     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 @@

 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 },

--- a/femtolisp/system.lsp

+++ b/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 (E v)

-	(if (not (io.eof? F))

-	    (next (read F)

-		  (eval E))

-	    v))

-      (io.close F))

+     (let next (prev E v)

+       (if (not (io.eof? F))

+	   (next (read F)

+                 prev

+		 (eval E))

+	   (begin (io.close F)

+		  (eval E)))) ; evaluate last form in almost-tail position

      (lambda (e)

        (begin

 	 (io.close F)

--- a/femtolisp/todo

+++ b/femtolisp/todo

@@ -629,7 +629,7 @@

 - (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         - 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