diff -uNr a/gscm/doc/CHANGES b/gscm/doc/CHANGES --- a/gscm/doc/CHANGES fdb8da8eb5e1f8b0c2b551319fb20d1d3ec2704c7ee5b81b851978321c679da440a7b35c567854bde6262c6a084ef15e2e7be7886c2a2a5de3927a8ea8ae6ffa +++ b/gscm/doc/CHANGES a2f9ce5639f00109fef32124a595e66ae84730e12e95590829c54c84f63612eafea7cb1475185cb227477b2d86872f1e485716a9e08665c882169eb06088912e @@ -759,3 +759,10 @@ Packaging: - Fix version symlink update steps. (When a previous version existed, /package/gscm was being followed rather than replaced. djb got this right but apparently I tried to 'improve' it.) - Placeholder file doesn't need to be hidden. + +October 2020: + +40.maint5. + +Core: +- Bugfix: the string-fill! and vector-fill! builtins didn't enforce immutability. (I hadn't originally implemented immutable subtypes, which are hinted at but not specified in R5RS; when adding them I put checks in the obvious "set!" family of mutators, but missed the bulk fill operations. This might allow subversion of downstream checks that depend on immutability, though the only example coming to mind is the structural checking of expression trees passed to EVAL, and the parts of those that matter are all pairs which aren't affected here.) diff -uNr a/gscm/manifest b/gscm/manifest --- a/gscm/manifest 5b5c5ac9da85b7fd7e81154f6454f2fb1aa229c900332ef1f07044e8ad3def44e0ffa7bf6ce0bd0b4e21abb85675ccda277c5cbf818886d2bb75739f3f445335 +++ b/gscm/manifest b064224d5af55d27fcb85309f1b90851c79f8a0c0ca00fbbbe7d8de1c6164233da856b2cb7c5eddf596a361f19c6fb65acdc74dd9c3ad032bd4526b307468e8c @@ -1,2 +1,3 @@ 648626 gscm_subdir_genesis jfw The Gales Scheme interpreter. (Reground from gscm_genesis to follow the project subdir and manifest naming conventions.) 648629 gscm_fix_m_whitespace_package_install jfw The -m argument to set heap memory allocation was broken; the control characters allowed as whitespace by the lexer were inconsistent; package installation was broken in the case of an existing version. +654058 gscm_immutable_fill jfw The string-fill! and vector-fill! builtins failed to catch the errors of operating on immutable strings or vectors respectively. diff -uNr a/gscm/package/README b/gscm/package/README --- a/gscm/package/README d82a416831f0f56194fc9cbcd99d1f31c92b13f4ecbad19b4b3d4e9e99a75a455766a1cfce0c2188183a4fa1ec68275bd6628faa85e452e7713d3280d627c872 +++ b/gscm/package/README fc94f496057ee0ae318e9f1ba769f62c78878d4c5f14584c723dcdfc6f8671d4bb1a592c71b46088f0d13ba8471b8a40290d5828fc5187f8bdc058613d69c026 @@ -17,7 +17,7 @@ 1. Press or otherwise install the tree at the path: - /package/gscm-0.40.4 + /package/gscm-0.40.5 The installation path is not configurable. This amounts to a claim on the global namespace, as command names always do. People and programs can count on finding components at known paths if they are to be found at all, as surely as with /bin/sh. This doesn't mean the files must physically exist under /package; for example, a symlink from there could ease working on the code as a non-root user. diff -uNr a/gscm/package/install b/gscm/package/install --- a/gscm/package/install b84e6e172b451eac5ec40c0dfe77ddd44229abbbe04c818d7935cf2e6ddfa4b62bf1ab4f697779e44bf229852015f44dc04411881e26a9cf257b1645ddc51721 +++ b/gscm/package/install 8e38ce417ad133b5c926b722f625c3ae8132b86512c00b5b31dcc6d55f004763047e3ec8bece2e22d563be467fa5779d2233d80734f9a0135a181d27d63192d4 @@ -2,7 +2,7 @@ set -e P=gscm -V=0.40.4 +V=0.40.5 cd /package/$P-$V # Versioned path duplicated in: diff -uNr a/gscm/src/Makefile b/gscm/src/Makefile --- a/gscm/src/Makefile 8358d6ac63a514ff6cdf2c69af4c8cc24dd40f5dae23a9593ed078cd7da2a1255c9df8e704f3ef052c831dfd9114b0bc11d4e117e7e880e3a5333486635ce5a2 +++ b/gscm/src/Makefile 5821c76e074f6537abcd14399660a56af8eefdc7d0041699de0603fe8697f69a19e985c6e20d5c396f520295ca792cc718c7065c7e8dcf68d1ef32cc12fa6253 @@ -1,4 +1,4 @@ -PREFIX := /package/gscm-0.40.4 +PREFIX := /package/gscm-0.40.5 ASM_ARCH := x86_64 CFLAGS := -std=c99 -pedantic -Wall -Wextra -Winit-self -Wstrict-aliasing=1 -g -O2 diff -uNr a/gscm/src/gscm.c b/gscm/src/gscm.c --- a/gscm/src/gscm.c ddbd6074b63bc27cfda3bb7389d71dc00f859250965846965268685a3b1470165739d4851b3320c8eb401abe9bb2181e8a19bc2775e129d301cfe39bb669dd91 +++ b/gscm/src/gscm.c 27041dc8a3fa1511bb10b6bd122fa21ae975857c5aba2e16081d74c6d0e9713bec0620677f61f2200230219591747e2d145f4a5e7b07935c7ecf71c4604e6b37 @@ -765,6 +765,9 @@ static int is_string(value v) { return tag(v) == T_EXTENDED && (ext_tag(heap[untag(v)]) | 1) == T_STRING; } +static int is_mutable_string(value v) { + return tag(v) == T_EXTENDED && ext_tag(heap[untag(v)]) == T_STRING; +} static int is_symbol(value); static uchar * string_buf(value s) { assert(is_string(s) || is_symbol(s)); @@ -909,6 +912,9 @@ static int is_vector(value v) { return tag(v) == T_EXTENDED && (ext_tag(heap[untag(v)]) | 1) == T_VECTOR; } +static int is_mutable_vector(value v) { + return tag(v) == T_EXTENDED && ext_tag(heap[untag(v)]) == T_VECTOR; +} static value vector_len(value v) { assert(is_vector(v)); return ext_untag(heap[untag(v)]); @@ -2507,6 +2513,14 @@ return arg; } +static value require_mutable_string(value arg) { + if (!is_mutable_string(arg)) { + if (is_string(arg)) sc_error1("immutable string:", arg); + sc_error1("not a string:", arg); + } + return arg; +} + static value require_stringlike(value arg) { if (!(is_string(arg) || is_symbol(arg))) sc_error1("not a string or symbol:", arg); @@ -2518,6 +2532,14 @@ return arg; } +static value require_mutable_vector(value arg) { + if (!is_mutable_vector(arg)) { + if (is_vector(arg)) sc_error1("immutable vector:", arg); + sc_error1("not a vector:", arg); + } + return arg; +} + static value require_fixnum(value arg) { if (!is_fixnum(arg)) sc_error1("not a fixnum:", arg); return arg; @@ -2709,13 +2731,9 @@ if (k_unsigned >= string_len(s)) sc_error1("out of bounds:", k); return character(string_buf(s)[k_unsigned]); } - + BUILTIN(builtin_str_set) { - value s = extract_arg(&args); - if (tag(s) != T_EXTENDED || ext_tag(heap[untag(s)]) != T_STRING) { - if (is_string(s)) sc_error1("immutable string:", s); - sc_error1("not a string:", s); - } + value s = require_mutable_string(extract_arg(&args)); value k = extract_arg(&args); uchar new_char = safe_char_val(final_arg(args)); value k_unsigned = safe_fixnum_val(k); @@ -2842,7 +2860,7 @@ } BUILTIN(builtin_str_fill) { - value s = require_string(extract_arg(&args)); + value s = require_mutable_string(extract_arg(&args)); memset(string_buf(s), safe_char_val(final_arg(args)), string_len(s)); return SC_NULL; } @@ -2875,14 +2893,10 @@ } BUILTIN(builtin_vec_set) { - value vec = extract_arg(&args); + value vec = require_mutable_vector(extract_arg(&args)); value k = extract_arg(&args); value obj = final_arg(args); value k_unsigned = safe_fixnum_val(k); - if (tag(vec) != T_EXTENDED || ext_tag(heap[untag(vec)]) != T_VECTOR) { - if (is_vector(vec)) sc_error1("immutable vector:", vec); - sc_error1("not a vector:", vec); - } if (k_unsigned >= vector_len(vec)) sc_error1("out of bounds:", k); vector_set(vec, k_unsigned, obj); return SC_NULL; @@ -2901,7 +2915,7 @@ } BUILTIN(builtin_vec_fill) { - value vec = require_vector(extract_arg(&args)); + value vec = require_mutable_vector(extract_arg(&args)); value fill = final_arg(args); value len = vector_len(vec), i; for (i = 0; i < len; i++) vector_set(vec, i, fill);