Miroirs/skint
1
0
Fork 0
mirror of https://github.com/false-schemers/skint.git synced 2024-11-16 07:47:54 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

bug fixes

Browse source
This commit is contained in:
ESL 2023-03-24 16:34:11 -04:00
parent 71eeb37a35
commit c5fb756ea6
5 changed files with 24 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
i.c
View file

@ -1136,6 +1136,7 @@ define_instruction(vput) {
obj x = spop(), y = spop(); int i;
ckv(ac); ckk(x);
i = fixnum_from_obj(x);
if (i >= vectorlen(ac)) failtype(x, "valid vector index");
vectorref(ac, i) = y;
gonexti();
}
@ -1145,8 +1146,9 @@ define_instruction(vcat) {
ckv(x); ckv(y);
n1 = vectorlen(x), n2 = vectorlen(y), n = n1 + n2;
hp_reserve(hbsz(n+1));
hp -= n2; memcpy(hp, &vectorref(y, 0), n2*sizeof(obj));
hp -= n1; memcpy(hp, &vectorref(x, 0), n1*sizeof(obj));
/* NB: vectorref fails to return pointer to empty vector's start */
hp -= n2; if (n2) memcpy(hp, &vectorref(y, 0), n2*sizeof(obj));
hp -= n1; if (n1) memcpy(hp, &vectorref(x, 0), n1*sizeof(obj));
*--hp = obj_from_size(VECTOR_BTAG);
ac = hendblk(n+1);
sdrop(1);
@ -2125,7 +2127,7 @@ define_instruction(ntoi) {
}
define_instruction(ntoj) {
if (likely(is_fixnum_obj(ac))) ac = obj_from_flonum(sp-r, (flonum_t)flonum_from_obj(ac));
if (likely(is_fixnum_obj(ac))) ac = obj_from_flonum(sp-r, (flonum_t)fixnum_from_obj(ac));
else if (likely(is_flonum_obj(ac))) /* keep ac as-is */ ;
else failactype("number");
gonexti();
@ -2834,7 +2836,7 @@ define_instruction(scall34) {
}
define_instruction(scall4) {
int m = 3, n = fixnum_from_obj(*ip++);
int m = 4, n = fixnum_from_obj(*ip++);
ckx(ac); rd = ac; rx = obj_from_fixnum(0);
ac = obj_from_fixnum(n);
memmove((void*)(sp-n-m), (void*)(sp-n), (size_t)n*sizeof(obj));
@ -3043,16 +3045,22 @@ static int rds_int(obj port)
static double rds_real(obj port)
{
char buf[60], *p = buf, *e = p+59;
char buf[60], *p = buf, *e = p+59, *s; double d;
while (p < e) {
int c = iportpeekc(port);
if (c == '-' || c == '+' || c == '.' || c == 'e' || c == 'E' || (c >= '0' && c <= '9')) {
if (c == '-' || c == '+' || c == '.' || isalnum(c)) {
iportgetc(port);
*p++ = c;
} else break;
}
*p = 0;
return strtod(buf, NULL);
errno = 0; s = buf; e = "";
if (*s != '+' && *s != '-') d = strtod(s, &e);
else if (strcmp_ci(s+1, "inf.0") == 0) d = (*s == '-' ? -HUGE_VAL : HUGE_VAL);
else if (strcmp_ci(s+1, "nan.0") == 0) d = HUGE_VAL - HUGE_VAL;
else d = strtod(s, &e);
if (errno || e == s || *e) assert(0);
return d;
}
static size_t rds_size(obj port)

6
i.h
View file

@ -220,11 +220,11 @@ declare_instruction(isv, "v", 0, "eqv?", '2',
declare_instruction(ise, "e", 0, "equal?", '2', AUTOGL)
declare_instruction(box, "b", 0, "box", '1', AUTOGL)
declare_instruction(unbox, "z", 0, "unbox", '1', AUTOGL)
declare_instruction(setbox, "z!", 0, "set-box!", '2', AUTOGL)
declare_instruction(setbox, "sz", 0, "set-box!", '2', AUTOGL)
declare_instruction(car, "a", 0, "car", '1', AUTOGL)
declare_instruction(setcar, "a!", 0, "set-car!", '2', AUTOGL)
declare_instruction(setcar, "sa", 0, "set-car!", '2', AUTOGL)
declare_instruction(cdr, "d", 0, "cdr", '1', AUTOGL)
declare_instruction(setcdr, "d!", 0, "set-cdr!", '2', AUTOGL)
declare_instruction(setcdr, "sd", 0, "set-cdr!", '2', AUTOGL)
declare_instruction(caar, "aa", 0, "caar", '1', AUTOGL)
declare_instruction(cadr, "da", 0, "cadr", '1', AUTOGL)
declare_instruction(cdar, "ad", 0, "cdar", '1', AUTOGL)

2
k.c
View file

@ -1281,7 +1281,7 @@ case 0: /* load module */
*--hp = obj_from_size(PAIR_BTAG);
cx__231747 = (hendblk(3)); }
cx__231824 = (hpushstr(0, newstring("compiler: ")));
cx__231863 = (hpushstr(0, newstring("cannot encode literal: ~s")));
cx__231863 = (hpushstr(0, newstring("cannot encode literal")));
cx__231943 = (hpushstr(0, newstring("0123456789")));
cx__231964 = (hpushstr(0, newstring("misplaced define form")));
cx__232311 = (hpushstr(0, newstring("unsupported integrable type")));

2
src/k.sf
View file

@ -777,7 +777,7 @@
(write-serialized-size (string-length x) port)
(do ([i 0 (fx+ i 1)]) [(fx=? i (string-length x))]
(write-serialized-char (string-ref x i) port)))]
[else (c-error "cannot encode literal: ~s" x)]))
[else (c-error "cannot encode literal" x)]))
(define (write-serialized-arg arg port)
(if (and (number? arg) (exact? arg) (fx<=? 0 arg) (fx<=? arg 9))

8
t.c
View file

@ -161,7 +161,7 @@ char *t_code[] = {
"P", "xform-set!",
"%2${.2,@(y6:list2?)[01}?{${.2a,@(y3:id?)[01}}{f}?{${.3,.3da,f,@(y5:xfo"
"rm)[03},${.3a,.5[01},.0Y0?{.1,.1,'(y4:set!),l3]4}${.2,@(y16:binding-sp"
"ecial?)[01}?{.1,.1d!'(l1:y5:begin;)]4}.0d,'(y3:ref),.1aq?{.2,.1da,'(y4"
"ecial?)[01}?{.1,.1sd'(l1:y5:begin;)]4}.0d,'(y3:ref),.1aq?{.2,.1da,'(y4"
":set!),l3]5}'(s27:set! to non-identifier form),@(y7:x-error)[51}.0,'(y"
"4:set!)c,'(s18:improper set! form),@(y7:x-error)[22",
@ -254,7 +254,7 @@ char *t_code[] = {
")c},.6u?{.0]7}${.8,&0{%1'(l1:y5:begin;)]1},@(y5:%25map1)[02},.1,.8A8,'"
"(y6:lambda),l3,'(y4:call),@(y5:pair*)[73}.2aY0?{.4,.3ac,.4,${:1,.6a,.6"
"a,l2,@(y10:xform-set!)[02}c,.4d,.4d,.4d,:2^[55}${:1,.4a,t,@(y5:xform)["
"03},${.3a,:1[01}d!.4,.4,.4d,.4d,.4d,:2^[55}.!0.0^_1[55",
"03},${.3a,:1[01}sd.4,.4,.4d,.4d,.4d,:2^[55}.!0.0^_1[55",
"P", "xform-define",
"%2${.2,@(y6:list2?)[01}?{${.2a,@(y3:id?)[01}}{f}?{${.3,.3da,f,@(y5:xfo"
@ -281,12 +281,12 @@ char *t_code[] = {
"P", "top-transformer-env",
"%1@(y14:*transformers*),.1A3,.0p?{.0d,.0p?{'(y12:syntax-rules),.1aq}{f"
"}?{${.2,t,@(y9:transform)[02},.2d!}_1.0]2}.1Y0?{.1U5,.0?{.0}{.2,'(y3:r"
"}?{${.2,t,@(y9:transform)[02},.2sd}_1.0]2}.1Y0?{.1U5,.0?{.0}{.2,'(y3:r"
"ef),l2}_1,.2c,@(y14:*transformers*),.1c@!(y14:*transformers*).0]3}.1,@"
"(y7:old-den)[21",
"P", "install-transformer!",
"%2.1,${.3,@(y19:top-transformer-env)[01}d!]2",
"%2.1,${.3,@(y19:top-transformer-env)[01}sd]2",
"P", "install-transformer-rules!",
"%4${.5,.5,.5,@(y19:top-transformer-env),@(y13:syntax-rules*)[04},.1,@("