From 1f543baf3f196e68858b1b72dd3df0b1707188ee Mon Sep 17 00:00:00 2001 From: Bob Burger Date: Wed, 15 Apr 2026 16:59:19 -0400 Subject: [PATCH 1/5] clean up uptrin uses and guard allocators in alloc.c --- c/alloc.c | 27 +++++++++----- c/fasl.c | 105 ++++++++++++++++++++++++++++++++---------------------- 2 files changed, 82 insertions(+), 50 deletions(-) diff --git a/c/alloc.c b/c/alloc.c index baf4bcc6b..50b15b273 100644 --- a/c/alloc.c +++ b/c/alloc.c @@ -799,16 +799,21 @@ ptr S_null_immutable_string(void) { } static ptr stencil_vector(uptr type, uptr mask) { - ptr tc; - ptr p; iptr d; - iptr n = Spopcount(mask); + ptr tc; + ptr p; + iptr d; + iptr n; - tc = get_thread_context(); + if (mask >= ((uptr)1 << stencil_vector_mask_bits)) + S_error("", "invalid stencil vector mask request"); - d = size_stencil_vector(n); - newspace_find_room(tc, type_typed_object, d, p); - VECTTYPE(p) = (mask << stencil_vector_mask_offset) | type; - return p; + n = Spopcount(mask); + tc = get_thread_context(); + + d = size_stencil_vector(n); + newspace_find_room(tc, type_typed_object, d, p); + VECTTYPE(p) = (mask << stencil_vector_mask_offset) | type; + return p; } ptr S_stencil_vector(uptr mask) { @@ -1088,6 +1093,9 @@ ptr S_bignum(ptr tc, iptr n, IBOOL sign) { ptr S_code(ptr tc, iptr type, iptr n) { ptr p; iptr d; + if ((uptr)n > (uptr)most_positive_fixnum) + S_error("", "invalid code size request"); + d = size_code(n); find_room(tc, space_code, 0, type_typed_object, d, p); CODETYPE(p) = type; @@ -1103,6 +1111,9 @@ ptr S_relocation_table(iptr n) { ptr tc = get_thread_context(); ptr p; iptr d; + if ((uptr)n > (uptr)most_positive_fixnum) + S_error("", "invalid relocation table size request"); + d = size_reloc_table(n); newspace_find_room(tc, type_untyped, d, p); RELOCSIZE(p) = n; diff --git a/c/fasl.c b/c/fasl.c index d6d8d972a..387a80294 100644 --- a/c/fasl.c +++ b/c/fasl.c @@ -78,7 +78,7 @@ * * -> {library-code} * - * -> {graph} + * -> {graph} * * -> {graph-def} * @@ -220,11 +220,12 @@ static void toolarge(ptr path); static iptr iptrin(faslFile f); static int must_bytein(faslFile f); static void skipbytes(iptr n, faslFile f); +static iptr sizein(faslFile f); static float singlein(faslFile f); static double doublein(faslFile f); static iptr stringin(ptr *pstrbuf, iptr start, faslFile f); static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f); -static void fasl_record(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f, uptr size); +static void fasl_record(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f, iptr size); static IBOOL rtd_equiv(ptr x, ptr y); static IBOOL rtd_extras_equiv(ptr x, ptr y); static IBOOL equalp(ptr x, ptr y); @@ -436,7 +437,7 @@ static ptr fasl_entry(ptr tc, IFASLCODE situation, faslFile f, ptr externals) { return (ptr)0; } - size = S_fasl_uptrin(f, NULL); + size = sizein(f); if (ty == situation || situation == fasl_type_visit_revisit || ty == fasl_type_visit_revisit) { struct faslFileObj bv_ffo; @@ -460,6 +461,8 @@ static ptr fasl_entry(ptr tc, IFASLCODE situation, faslFile f, ptr externals) { case fasl_type_lz4: { ptr result; INT bytes_consumed; iptr dest_size = S_fasl_uptrin(f, &bytes_consumed); + if ((uptr)dest_size > (uptr)most_positive_fixnum) + toolarge(f->uf.path); iptr src_size = size - (2 + bytes_consumed); /* adjust for u8 compression type, u8 fasl type, and uptr dest_size */ PREPARE_BYTEVECTOR(SRCBV(tc), src_size); @@ -481,6 +484,8 @@ static ptr fasl_entry(ptr tc, IFASLCODE situation, faslFile f, ptr externals) { in_f = f; old_mode = f->buffer_mode; size -= 2; /* adjust for u8 compression type and u8 fasl type */ + if (size < 0) + toolarge(f->uf.path); if (old_mode == FASL_BUFFER_READ_MINIMAL) { f->buffer_mode = FASL_BUFFER_READ_REMAINING; f->remaining = size; @@ -731,6 +736,13 @@ uptr S_fasl_uptrin(faslFile f, INT *bytes_consumed) { #define uptrin(f) S_fasl_uptrin(f, NULL) +static iptr sizein(faslFile f) { + iptr n = S_fasl_uptrin(f, NULL); + if ((uptr)n > (uptr)most_positive_fixnum) + toolarge(f->uf.path); + return n; +} + static float singlein(faslFile f) { union { float f; U32 u; } val; @@ -755,7 +767,7 @@ static double doublein(faslFile f) { static iptr stringin(ptr *pstrbuf, iptr start, faslFile f) { iptr end, n, i; ptr p = *pstrbuf; - end = start + (n = uptrin(f)); + end = start + (n = sizein(f)); if (Sstring_length(*pstrbuf) < end) { ptr newp = S_string((char *)0, end); for (i = 0; i != start; i += 1) Sstring_set(newp, i, Sstring_ref(p, i)); @@ -770,7 +782,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { switch (ty) { case fasl_type_pair: { iptr n; ptr p; - n = uptrin(f); + n = sizein(f); *x = p = Scons(FIX(0), FIX(0)); faslin(tc, &INITCAR(p), t, pstrbuf, f); while (--n) { @@ -804,7 +816,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { case fasl_type_uninterned_symbol: { iptr i, n; ptr str; - n = uptrin(f); + n = sizein(f); str = S_string((char *)0, n); for (i = 0; i != n; i += 1) Sstring_set(str, i, uptrin(f)); STRTYPE(str) |= string_immutable_flag; @@ -824,10 +836,10 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { case fasl_type_vector: case fasl_type_immutable_vector: { iptr n; ptr *p; - n = uptrin(f); + n = sizein(f); *x = S_vector(n); p = &INITVECTIT(*x, 0); - while (n--) faslin(tc, p++, t, pstrbuf, f); + while (--n >= 0) faslin(tc, p++, t, pstrbuf, f); if (ty == fasl_type_immutable_vector) { if (Svector_length(*x) == 0) *x = S_G.null_immutable_vector; @@ -838,10 +850,10 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { } case fasl_type_fxvector: { iptr n; ptr *p; - n = uptrin(f); + n = sizein(f); *x = S_fxvector(n); p = &FXVECTIT(*x, 0); - while (n--) { + while (--n >= 0) { iptr t = iptrin(f); if (!FIXRANGE(t)) toolarge(f->uf.path); *p++ = FIX(t); @@ -850,10 +862,10 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { } case fasl_type_flvector: { iptr n; double *p; - n = uptrin(f); + n = sizein(f); *x = S_flvector(n); p = &FLVECTIT(*x, 0); - while (n--) { + while (--n >= 0) { ptr fl; faslin(tc, &fl, t, pstrbuf, f); if (!Sflonump(fl)) @@ -865,7 +877,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { case fasl_type_bytevector: case fasl_type_immutable_bytevector: { iptr n; - n = uptrin(f); + n = sizein(f); *x = S_bytevector(n); S_fasl_bytesin(&BVIT(*x,0), n, f); if (ty == fasl_type_immutable_bytevector) { @@ -886,7 +898,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { *x = S_system_stencil_vector(mask); p = &INITSTENVECTIT(*x, 0); n = Spopcount(mask); - while (n--) faslin(tc, p++, t, pstrbuf, f); + while (--n >= 0) faslin(tc, p++, t, pstrbuf, f); return; } case fasl_type_base_rtd: { @@ -897,7 +909,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { *x = rtd; return; } case fasl_type_rtd: { - ptr rtd, rtd_uid, plist, ls; uptr size; + ptr rtd, rtd_uid, plist, ls; iptr size; faslin(tc, &rtd_uid, t, pstrbuf, f); @@ -910,7 +922,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { ptr tmp; *x = rtd = Scar(Scdr(ls)); - size = uptrin(f); + size = sizein(f); if (size != 0) { fasl_record(tc, &tmp, t, pstrbuf, f, size); if (!rtd_equiv(tmp, rtd)) @@ -921,7 +933,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { } } - size = uptrin(f); + size = sizein(f); if (size == 0) S_error2("", "unregistered record type ~s in ~a", rtd_uid, f->uf.path); fasl_record(tc, x, t, pstrbuf, f, size); @@ -935,12 +947,12 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { return; } case fasl_type_record: { - uptr size = uptrin(f); + iptr size = sizein(f); fasl_record(tc, x, t, pstrbuf, f, size); return; } case fasl_type_eq_hashtable: { - ptr rtd, ht, v; uptr subtype; uptr veclen, i, n; + ptr rtd, ht, v; uptr subtype; iptr veclen, i, n; if ((rtd = S_G.eq_ht_rtd) == Sfalse) { S_G.eq_ht_rtd = rtd = SYMVAL(S_intern((const unsigned char *)"$eq-ht-rtd")); if (!Srecordp(rtd)) S_error_abort("$eq-ht-rtd has not been set"); @@ -958,10 +970,10 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { default: S_error2("", "invalid eq-hashtable subtype code", FIX(subtype), f->uf.path); } - INITPTRFIELD(ht,eq_hashtable_minlen_disp) = FIX(uptrin(f)); - veclen = uptrin(f); + INITPTRFIELD(ht,eq_hashtable_minlen_disp) = FIX(sizein(f)); + veclen = sizein(f); INITPTRFIELD(ht,eq_hashtable_vec_disp) = v = S_vector(veclen); - n = uptrin(f); + n = sizein(f); INITPTRFIELD(ht,eq_hashtable_size_disp) = FIX(n); for (i = 0; i < veclen ; i += 1) { INITVECTIT(v, i) = FIX(i); } while (n > 0) { @@ -987,7 +999,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { return; } case fasl_type_symbol_hashtable: { - ptr rtd, ht, equiv, v; uptr equiv_code, veclen, i, n; + ptr rtd, ht, equiv, v; uptr equiv_code; iptr veclen, i, n; if ((rtd = S_G.symbol_ht_rtd) == Sfalse) { S_G.symbol_ht_rtd = rtd = SYMVAL(S_intern((const unsigned char *)"$symbol-ht-rtd")); if (!Srecordp(rtd)) S_error_abort("$symbol-ht-rtd has not been set"); @@ -996,7 +1008,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { RECORDINSTTYPE(ht) = rtd; INITPTRFIELD(ht,symbol_hashtable_type_disp) = S_G.symbol_symbol; INITPTRFIELD(ht,symbol_hashtable_mutablep_disp) = bytein(f) ? Strue : Sfalse; - INITPTRFIELD(ht,symbol_hashtable_minlen_disp) = FIX(uptrin(f)); + INITPTRFIELD(ht,symbol_hashtable_minlen_disp) = FIX(sizein(f)); equiv_code = bytein(f); switch (equiv_code) { case 0: @@ -1029,9 +1041,9 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { equiv = Sfalse; } INITPTRFIELD(ht,symbol_hashtable_equivp_disp) = equiv; - veclen = uptrin(f); + veclen = sizein(f); INITPTRFIELD(ht,symbol_hashtable_vec_disp) = v = S_vector(veclen); - n = uptrin(f); + n = sizein(f); INITPTRFIELD(ht,symbol_hashtable_size_disp) = FIX(n); for (i = 0; i < veclen ; i += 1) { INITVECTIT(v, i) = Snil; } while (n > 0) { @@ -1050,6 +1062,8 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { offset = uptrin(f); *x = S_closure((ptr)0, 0); faslin(tc, &cod, t, pstrbuf, f); + if (offset != code_data_disp || !Scodep(cod)) + S_error1("", "malformed fasl closure found in ~a", f->uf.path); CLOSENTRY(*x) = (ptr)((uptr)cod + offset); return; } @@ -1067,7 +1081,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { case fasl_type_string: case fasl_type_immutable_string: { iptr i, n; ptr str; - n = uptrin(f); + n = sizein(f); str = S_string((char *)0, n); for (i = 0; i != n; i += 1) Sstring_set(str, i, uptrin(f)); if (ty == fasl_type_immutable_string) { @@ -1085,10 +1099,10 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { case fasl_type_large_integer: { IBOOL sign; iptr n; ptr t; bigit *p; sign = bytein(f); - n = uptrin(f); + n = sizein(f); t = S_bignum(tc, n, sign); p = &BIGIT(t, 0); - while (n--) *p++ = (bigit)uptrin(f); + while (--n >= 0) *p++ = (bigit)uptrin(f); *x = S_normalize_bignum(t); return; } @@ -1106,8 +1120,8 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { iptr n, m, a; INT flags; iptr free; ptr co, reloc, name, pinfos; flags = bytein(f); - free = uptrin(f); - n = uptrin(f) /* length in bytes of code */; + free = sizein(f); + n = sizein(f) /* length in bytes of code */; *x = co = S_code(tc, type_code | (flags << code_flags_offset), n); CODEFREE(co) = free; faslin(tc, &name, t, pstrbuf, f); @@ -1124,7 +1138,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { #ifdef PORTABLE_BYTECODE_SWAPENDIAN swap_code_endian((octet *)&CODEIT(co, 0), n); #endif - m = uptrin(f); + m = sizein(f); CODERELOC(co) = reloc = S_relocation_table(m); RELOCCODE(reloc) = co; a = 0; @@ -1165,7 +1179,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { *x = S_phantom_bytevector(uptrin(f)); return; case fasl_type_graph: { - uptr len = uptrin(f), len2 = uptrin(f), tlen = (uptr)Svector_length(t), i; + iptr len = sizein(f), len2 = sizein(f), tlen = Svector_length(t), i; ptr new_t = S_vector(len); if ((tlen < len2) && (len2 != 0)) /* allowing a vector when not needed helps with `load-compiled-from-port` */ S_error2("", "incompatible external vector length ~d, expected ~d", FIX(tlen), FIX(len2)); @@ -1176,18 +1190,25 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { return; } case fasl_type_graph_def: { - ptr *p; - p = &INITVECTIT(t, uptrin(f)); + uptr i; ptr *p; + i = uptrin(f); + if (i >= (uptr)Svector_length(t)) + S_error1("", "invalid fasl graph def index found in ~a", f->uf.path); + p = &INITVECTIT(t, i); faslin(tc, p, t, pstrbuf, f); *x = *p; return; } - case fasl_type_graph_ref: - *x = Svector_ref(t, uptrin(f)); + case fasl_type_graph_ref: { + uptr i = uptrin(f); + if (i >= (uptr)Svector_length(t)) + S_error1("", "invalid fasl graph ref index found in ~a", f->uf.path); + *x = Svector_ref(t, i); return; + } case fasl_type_begin: { - uptr n = uptrin(f) - 1; ptr v; - while (n--) + iptr n = sizein(f) - 1; ptr v; + while (--n >= 0) faslin(tc, &v, t, pstrbuf, f); faslin(tc, x, t, pstrbuf, f); return; @@ -1208,10 +1229,10 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { #else # define unknown 3 #endif -static void fasl_record(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f, uptr size) { - uptr n, addr; ptr p; UINT padty; +static void fasl_record(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f, iptr size) { + iptr n; uptr addr; ptr p; UINT padty; - n = uptrin(f); + n = sizein(f); *x = p = S_record(size_record_inst(size)); faslin(tc, &RECORDINSTTYPE(p), t, pstrbuf, f); addr = (uptr)TO_PTR(&RECORDINSTIT(p, 0)); From c1d6732791413d527e3ef5462b71779a705a99a2 Mon Sep 17 00:00:00 2001 From: Bob Burger Date: Thu, 16 Apr 2026 11:24:00 -0400 Subject: [PATCH 2/5] more type checks and error message updates --- c/fasl.c | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/c/fasl.c b/c/fasl.c index 387a80294..5f4330285 100644 --- a/c/fasl.c +++ b/c/fasl.c @@ -529,7 +529,7 @@ static ptr bv_fasl_entry(ptr tc, ptr bv, int ty, uptr offset, uptr len, faslFile f->next += offset; faslin(tc, &x, externals, &strbuf, f); } else { - S_error1("", "bad entry type (got ~s)", FIX(ty)); + S_error2("", "bad fasl entry type (got ~s) found in ~a", FIX(ty), f->uf.path); } S_flush_instruction_cache(tc); @@ -869,7 +869,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { ptr fl; faslin(tc, &fl, t, pstrbuf, f); if (!Sflonump(fl)) - S_error1("", "not a flonum in flvector ~a", f->uf.path); + S_error1("", "invalid fasl flvector element found in ~a", f->uf.path); *p++ = Sflonum_value(fl); } return; @@ -912,6 +912,8 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { ptr rtd, rtd_uid, plist, ls; iptr size; faslin(tc, &rtd_uid, t, pstrbuf, f); + if (!Ssymbolp(rtd_uid)) + S_error1("", "invalid fasl rtd found in ~a", f->uf.path); tc_mutex_acquire(); @@ -1036,7 +1038,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { } break; default: - S_error2("", "invalid symbol-hashtable equiv code", FIX(equiv_code), f->uf.path); + S_error2("", "invalid fasl symbol-hashtable equiv code ~a found in ~a", FIX(equiv_code), f->uf.path); /* make compiler happy */ equiv = Sfalse; } @@ -1050,6 +1052,8 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { ptr keyval; keyval = Scons(FIX(0), FIX(0)); faslin(tc, &INITCAR(keyval), t, pstrbuf, f); + if (!Ssymbolp(Scar(keyval))) + S_error1("", "invalid fasl symbol-hashtable key found in ~a", f->uf.path); faslin(tc, &INITCDR(keyval), t, pstrbuf, f); i = UNFIX(SYMHASH(Scar(keyval))) & (veclen - 1); INITVECTIT(v, i) = Scons(keyval, Svector_ref(v, i)); @@ -1075,6 +1079,8 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { ptr rp, ip; faslin(tc, &rp, t, pstrbuf, f); faslin(tc, &ip, t, pstrbuf, f); + if (!Sflonump(rp) || !Sflonump(ip)) + S_error1("", "malformed fasl inexactnum found in ~a", f->uf.path); *x = S_inexactnum(FLODAT(rp), FLODAT(ip)); return; } @@ -1182,7 +1188,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { iptr len = sizein(f), len2 = sizein(f), tlen = Svector_length(t), i; ptr new_t = S_vector(len); if ((tlen < len2) && (len2 != 0)) /* allowing a vector when not needed helps with `load-compiled-from-port` */ - S_error2("", "incompatible external vector length ~d, expected ~d", FIX(tlen), FIX(len2)); + S_error2("", "incompatible fasl graph external vector length ~d, expected ~d", FIX(tlen), FIX(len2)); if (len2 > len) len2 = len; for (i = 0; i < len2; i++) INITVECTIT(new_t, i+(len-len2)) = Svector_ref(t, i); @@ -1214,7 +1220,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { return; } default: - S_error2("", "invalid object type ~d in fasl file ~a", FIX(ty), f->uf.path); + S_error2("", "invalid fasl object type ~d found in ~a", FIX(ty), f->uf.path); } } From 11a1d413e4e1deea1909f25c5153bdb6a4394571 Mon Sep 17 00:00:00 2001 From: Bob Burger Date: Thu, 16 Apr 2026 11:53:41 -0400 Subject: [PATCH 3/5] better size checks for gzip & lz4 --- c/fasl.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/c/fasl.c b/c/fasl.c index 5f4330285..ba61f85f3 100644 --- a/c/fasl.c +++ b/c/fasl.c @@ -461,10 +461,11 @@ static ptr fasl_entry(ptr tc, IFASLCODE situation, faslFile f, ptr externals) { case fasl_type_lz4: { ptr result; INT bytes_consumed; iptr dest_size = S_fasl_uptrin(f, &bytes_consumed); - if ((uptr)dest_size > (uptr)most_positive_fixnum) - toolarge(f->uf.path); iptr src_size = size - (2 + bytes_consumed); /* adjust for u8 compression type, u8 fasl type, and uptr dest_size */ + if ((uptr)src_size > (uptr)maximum_bytevector_length || + (uptr)dest_size > (uptr)maximum_bytevector_length) + toolarge(f->uf.path); PREPARE_BYTEVECTOR(SRCBV(tc), src_size); PREPARE_BYTEVECTOR(DSTBV(tc), dest_size); S_fasl_bytesin(&BVIT(SRCBV(tc),0), src_size, f); From 312697a966304f7e09d46508e084c80bcc4e75b2 Mon Sep 17 00:00:00 2001 From: Bob Burger Date: Thu, 16 Apr 2026 12:07:15 -0400 Subject: [PATCH 4/5] more consistent error messages, handle empty fasl_type_begin --- c/fasl.c | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/c/fasl.c b/c/fasl.c index ba61f85f3..016548aad 100644 --- a/c/fasl.c +++ b/c/fasl.c @@ -486,7 +486,7 @@ static ptr fasl_entry(ptr tc, IFASLCODE situation, faslFile f, ptr externals) { old_mode = f->buffer_mode; size -= 2; /* adjust for u8 compression type and u8 fasl type */ if (size < 0) - toolarge(f->uf.path); + S_error1("", "invalid fasl uncompressed size found in ~a", f->uf.path); if (old_mode == FASL_BUFFER_READ_MINIMAL) { f->buffer_mode = FASL_BUFFER_READ_REMAINING; f->remaining = size; @@ -530,7 +530,7 @@ static ptr bv_fasl_entry(ptr tc, ptr bv, int ty, uptr offset, uptr len, faslFile f->next += offset; faslin(tc, &x, externals, &strbuf, f); } else { - S_error2("", "bad fasl entry type (got ~s) found in ~a", FIX(ty), f->uf.path); + S_error2("", "bad fasl entry type ~d found in ~a", FIX(ty), f->uf.path); } S_flush_instruction_cache(tc); @@ -1039,7 +1039,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { } break; default: - S_error2("", "invalid fasl symbol-hashtable equiv code ~a found in ~a", FIX(equiv_code), f->uf.path); + S_error2("", "invalid fasl symbol-hashtable equiv code ~d found in ~a", FIX(equiv_code), f->uf.path); /* make compiler happy */ equiv = Sfalse; } @@ -1189,7 +1189,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { iptr len = sizein(f), len2 = sizein(f), tlen = Svector_length(t), i; ptr new_t = S_vector(len); if ((tlen < len2) && (len2 != 0)) /* allowing a vector when not needed helps with `load-compiled-from-port` */ - S_error2("", "incompatible fasl graph external vector length ~d, expected ~d", FIX(tlen), FIX(len2)); + S_error3("", "incompatible fasl graph external vector length ~d (expected ~d) found in ~a", FIX(tlen), FIX(len2), f->uf.path); if (len2 > len) len2 = len; for (i = 0; i < len2; i++) INITVECTIT(new_t, i+(len-len2)) = Svector_ref(t, i); @@ -1214,10 +1214,10 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) { return; } case fasl_type_begin: { - iptr n = sizein(f) - 1; ptr v; + iptr n = sizein(f); + *x = Svoid; /* in case n == 0 */ while (--n >= 0) - faslin(tc, &v, t, pstrbuf, f); - faslin(tc, x, t, pstrbuf, f); + faslin(tc, x, t, pstrbuf, f); return; } default: From 1983039361c230d9cd08e0c12eaf0fca207381d7 Mon Sep 17 00:00:00 2001 From: Bob Burger Date: Thu, 16 Apr 2026 13:45:04 -0400 Subject: [PATCH 5/5] update expected errors --- mats/root-experr-compile-0-f-f-f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mats/root-experr-compile-0-f-f-f b/mats/root-experr-compile-0-f-f-f index bef2477c6..536fbd043 100644 --- a/mats/root-experr-compile-0-f-f-f +++ b/mats/root-experr-compile-0-f-f-f @@ -4718,8 +4718,8 @@ cp0.mo:Expected error in mat expand/optimize-output: "expand/optimize-output: #< 6.mo:Expected error in mat fasl: "fasl-write: 10 is not #f or a procedure". 6.mo:Expected error in mat fasl: "fasl-read: not a vector #f". 6.mo:Expected error in mat fasl: "fasl-read: not a vector 10". -6.mo:Expected error in mat fasl: "incompatible external vector length 0, expected 1". -6.mo:Expected error in mat fasl: "incompatible external vector length 1, expected 2". +6.mo:Expected error in mat fasl: "incompatible fasl graph external vector length 0 (expected 1) found in bytevector". +6.mo:Expected error in mat fasl: "incompatible fasl graph external vector length 1 (expected 2) found in bytevector". 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "~a~~~s" in call to format". 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too many arguments for control string "~a~a~a~s" in call to format". 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "~a~~~s" in call to format at line 1, char 28 of testfile.ss".