diff --git a/femtolisp/cvalues.c b/femtolisp/cvalues.c index 1100853..f4bc44b 100644 --- a/femtolisp/cvalues.c +++ b/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); - 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) @@ -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)); - 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)); diff --git a/femtolisp/string.c b/femtolisp/string.c index 39f09eb..8baf66b 100644 --- a/femtolisp/string.c +++ b/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 }, diff --git a/femtolisp/system.lsp b/femtolisp/system.lsp index 88a8b9f..0399213 100644 --- 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) diff --git a/femtolisp/todo b/femtolisp/todo index 7f35200..f8bc363 100644 --- a/femtolisp/todo +++ b/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