diff --git a/eval.c b/eval.c index e1380da4..3da2615c 100644 --- a/eval.c +++ b/eval.c @@ -378,11 +378,10 @@ static void sexp_add_path (sexp ctx, const char *str) { } } -void sexp_init_eval_context_globals (sexp ctx) { - sexp_gc_var3(tmp, vec, ctx2); - ctx = sexp_make_child_context(ctx, NULL); - sexp_gc_preserve3(ctx, tmp, vec, ctx2); #if ! SEXP_USE_NATIVE_X86 +static void sexp_init_eval_context_bytecodes (sexp ctx) { + sexp_gc_var3(tmp, vec, ctx2); + sexp_gc_preserve3(ctx, tmp, vec, ctx2); emit(ctx, SEXP_OP_RESUMECC); sexp_global(ctx, SEXP_G_RESUMECC_BYTECODE) = finalize_bytecode(ctx); ctx2 = sexp_make_child_context(ctx, NULL); @@ -393,6 +392,16 @@ void sexp_init_eval_context_globals (sexp ctx) { = sexp_make_procedure(ctx, SEXP_ZERO, SEXP_ZERO, tmp, vec); sexp_bytecode_name(sexp_procedure_code(sexp_global(ctx, SEXP_G_FINAL_RESUMER))) = sexp_intern(ctx, "final-resumer", -1); + sexp_gc_release3(ctx); +} +#endif + +void sexp_init_eval_context_globals (sexp ctx) { + sexp_gc_var1(tmp); + ctx = sexp_make_child_context(ctx, NULL); + sexp_gc_preserve1(ctx, tmp); +#if ! SEXP_USE_NATIVE_X86 + sexp_init_eval_context_bytecodes(ctx); #endif sexp_global(ctx, SEXP_G_MODULE_PATH) = SEXP_NULL; sexp_add_path(ctx, sexp_default_module_dir); @@ -409,7 +418,7 @@ void sexp_init_eval_context_globals (sexp ctx) { sexp_global(ctx, SEXP_G_THREADS_SIGNALS) = SEXP_ZERO; sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER) = SEXP_FALSE; #endif - sexp_gc_release3(ctx); + sexp_gc_release1(ctx); } sexp sexp_make_eval_context (sexp ctx, sexp stack, sexp env, sexp_uint_t size, sexp_uint_t max_size) { diff --git a/include/chibi/features.h b/include/chibi/features.h index 6c34b4a7..31884e94 100644 --- a/include/chibi/features.h +++ b/include/chibi/features.h @@ -421,6 +421,10 @@ #define SEXP_USE_OBJECT_BRACE_LITERALS ! SEXP_USE_NO_FEATURES #endif +#ifndef SEXP_USE_BYTEVECTOR_LITERALS +#define SEXP_USE_BYTEVECTOR_LITERALS ! SEXP_USE_NO_FEATURES +#endif + #ifndef SEXP_USE_SELF_PARAMETER #define SEXP_USE_SELF_PARAMETER 1 #endif diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index b35bd4c9..ac8db259 100755 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -562,6 +562,7 @@ sexp sexp_make_flonum(sexp ctx, double f); #define sexp_pairp(x) (sexp_check_tag(x, SEXP_PAIR)) #define sexp_stringp(x) (sexp_check_tag(x, SEXP_STRING)) #define sexp_lsymbolp(x) (sexp_check_tag(x, SEXP_SYMBOL)) +#define sexp_bytesp(x) (sexp_check_tag(x, SEXP_BYTES)) #define sexp_vectorp(x) (sexp_check_tag(x, SEXP_VECTOR)) #define sexp_iportp(x) (sexp_check_tag(x, SEXP_IPORT)) #define sexp_oportp(x) (sexp_check_tag(x, SEXP_OPORT)) diff --git a/sexp.c b/sexp.c index a7b1e95b..03bf3246 100644 --- a/sexp.c +++ b/sexp.c @@ -1452,6 +1452,18 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) { sexp_write_string(ctx, sexp_opcode_name(obj), out); sexp_write_char(ctx, '>', out); break; +#if SEXP_USE_BYTEVECTOR_LITERALS + case SEXP_BYTES: + sexp_write_string(ctx, "#u8(", out); + str = sexp_bytes_data(obj); + len = sexp_bytes_length(obj); + for (i=0; i= sexp_context_num_types(ctx)) { @@ -2120,6 +2132,39 @@ sexp sexp_read_raw (sexp ctx, sexp in) { res = sexp_read_error(ctx, "invalid syntax #%c%c", tmp, in); } break; +#if SEXP_USE_BYTEVECTOR_LITERALS + case 'v': case 'V': + c1 = sexp_read_char(ctx, in); + if (!(c1=='u'||c1=='U')) { + res = sexp_read_error(ctx, "invalid syntax #v%c", sexp_make_character(c1), in); + break; + } + /* ... FALLTHROUGH ... */ + case 'u': case 'U': + if ((c1 = sexp_read_char(ctx, in)) == '8') { + tmp = sexp_read(ctx, in); + if (!sexp_listp(ctx, tmp)) { + res = sexp_exceptionp(tmp) ? tmp + : sexp_read_error(ctx, "invalid syntax object after #u8", tmp, in); + } else { + res = sexp_make_bytes(ctx, sexp_length(ctx, tmp), SEXP_VOID); + for (c1=0; sexp_pairp(tmp); tmp=sexp_cdr(tmp), c1++) { + tmp2 = sexp_car(tmp); + if (!(sexp_fixnump(tmp2) && sexp_unbox_fixnum(tmp2) >= 0 + && sexp_unbox_fixnum(tmp2) < 0x100)) { + res = sexp_read_error(ctx, "invalid bytevector value", tmp2, in); + break; + } else { + sexp_bytes_set(res, sexp_make_fixnum(c1), tmp2); + } + } + } + } else { + tmp = sexp_list2(ctx, sexp_make_character('u'), sexp_make_character(c1)); + res = sexp_read_error(ctx, "invalid syntax #%c%c", tmp, in); + } + break; +#endif /* case '0': case '1': case '2': case '3': case '4': */ /* case '5': case '6': case '7': case '8': case '9': */ case ';': diff --git a/vm.c b/vm.c index 5ba69d59..c6232f8b 100644 --- a/vm.c +++ b/vm.c @@ -1171,6 +1171,16 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) { _ARG1 = sexp_make_fixnum(sexp_vector_length(_ARG1)); break; case SEXP_OP_BYTES_REF: + if (! sexp_bytesp(_ARG1)) + sexp_raise("byte-vector-ref: not a byte-vector", sexp_list1(ctx, _ARG1)); + if (! sexp_fixnump(_ARG2)) + sexp_raise("byte-vector-ref: not an integer", sexp_list1(ctx, _ARG2)); + i = sexp_unbox_fixnum(_ARG2); + if ((i < 0) || (i >= sexp_bytes_length(_ARG1))) + sexp_raise("byte-vector-ref: index out of range", sexp_list2(ctx, _ARG1, _ARG2)); + _ARG2 = sexp_bytes_ref(_ARG1, _ARG2); + top--; + break; case SEXP_OP_STRING_REF: if (! sexp_stringp(_ARG1)) sexp_raise("string-ref: not a string", sexp_list1(ctx, _ARG1)); @@ -1179,9 +1189,6 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) { i = sexp_unbox_fixnum(_ARG2); if ((i < 0) || (i >= sexp_string_length(_ARG1))) sexp_raise("string-ref: index out of range", sexp_list2(ctx, _ARG1, _ARG2)); - if (ip[-1] == SEXP_OP_BYTES_REF) - _ARG2 = sexp_bytes_ref(_ARG1, _ARG2); - else #if SEXP_USE_UTF8_STRINGS _ARG2 = sexp_string_utf8_ref(ctx, _ARG1, _ARG2); #else @@ -1193,6 +1200,22 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) { #endif break; case SEXP_OP_BYTES_SET: + if (! sexp_bytesp(_ARG1)) + sexp_raise("byte-vector-set!: not a byte-vector", sexp_list1(ctx, _ARG1)); + else if (sexp_immutablep(_ARG1)) + sexp_raise("byte-vector-set!: immutable byte-vector", sexp_list1(ctx, _ARG1)); + else if (! sexp_fixnump(_ARG2)) + sexp_raise("byte-vector-set!: not an integer", sexp_list1(ctx, _ARG2)); + else if (!(sexp_fixnump(_ARG3) && sexp_unbox_fixnum(_ARG3)>=0 + && sexp_unbox_fixnum(_ARG3)<0x100)) + sexp_raise("byte-vector-set!: not an octet", sexp_list1(ctx, _ARG3)); + i = sexp_unbox_fixnum(_ARG2); + if ((i < 0) || (i >= sexp_bytes_length(_ARG1))) + sexp_raise("byte-vector-set!: index out of range", sexp_list2(ctx, _ARG1, _ARG2)); + sexp_bytes_set(_ARG1, _ARG2, _ARG3); + top-=3; + _ARG1 = SEXP_VOID; + break; case SEXP_OP_STRING_SET: if (! sexp_stringp(_ARG1)) sexp_raise("string-set!: not a string", sexp_list1(ctx, _ARG1)); @@ -1205,18 +1228,14 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) { i = sexp_unbox_fixnum(_ARG2); if ((i < 0) || (i >= sexp_string_length(_ARG1))) sexp_raise("string-set!: index out of range", sexp_list2(ctx, _ARG1, _ARG2)); - if (ip[-1] == SEXP_OP_BYTES_SET) - sexp_bytes_set(_ARG1, _ARG2, _ARG3); - else #if SEXP_USE_UTF8_STRINGS - { - sexp_context_top(ctx) = top; - sexp_string_utf8_set(ctx, _ARG1, _ARG2, _ARG3); - } + sexp_context_top(ctx) = top; + sexp_string_utf8_set(ctx, _ARG1, _ARG2, _ARG3); #else - sexp_string_set(_ARG1, _ARG2, _ARG3); + sexp_string_set(_ARG1, _ARG2, _ARG3); #endif top-=3; + _ARG1 = SEXP_VOID; break; #if SEXP_USE_UTF8_STRINGS case SEXP_OP_STRING_CURSOR_NEXT: @@ -1246,7 +1265,7 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) { break; #endif case SEXP_OP_BYTES_LENGTH: - if (! sexp_stringp(_ARG1)) + if (! sexp_bytesp(_ARG1)) sexp_raise("bytes-length: not a byte-vector", sexp_list1(ctx, _ARG1)); _ARG1 = sexp_make_fixnum(sexp_bytes_length(_ARG1)); break;