ref: a9541f71c451036fce7df6656b5f04780a34bd55
parent: bbfee60f6716dce8cf7a802c044cf7d0fe8bb6f2
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Fri Mar 21 21:44:36 EDT 2025
add and use cv_numtype to handle mpint
--- a/src/cvalues.c
+++ b/src/cvalues.c
@@ -276,7 +276,7 @@
}else if(iscvalue(arg)){sl_cv *cv = ptr(arg);
void *p = cv_data(cv);
- n = conv_to_mp(p, cp_numtype(cv));
+ n = conv_to_mp(p, cv_numtype(cv));
}else if(iscprim(arg)){sl_cprim *cp = ptr(arg);
void *p = cp_data(cp);
@@ -881,9 +881,9 @@
switch(pt){case T_DOUBLE: return mk_double(-*(double*)a);
case T_FLOAT: return mk_float(-*(float*)a);
- case T_S8: return fixnum(-(sl_fx)*(s8int*)a);
+ case T_S8: return fixnum(-(sl_fx)*(s8int*)a);
case T_U8: return fixnum(-(sl_fx)*(u8int*)a);
- case T_S16: return fixnum(-(sl_fx)*(s16int*)a);
+ case T_S16: return fixnum(-(sl_fx)*(s16int*)a);
case T_U16: return fixnum(-(sl_fx)*(u16int*)a);
case T_U32:
i64 = -(s64int)*(u32int*)a;
@@ -935,7 +935,7 @@
}else if(iscvalue(a)){cv = ptr(a);
*pp = cv_data(cv);
- *pt = cv_class(cv)->numtype;
+ *pt = cv_numtype(cv);
return valid_numtype(*pt);
}
return false;
@@ -1110,13 +1110,13 @@
switch(opcode){case 0:
switch(ta){- case T_S8: return fixnum( *(s8int *)aptr & (s8int )b64);
- case T_U8: return fixnum( *(u8int *)aptr & (u8int )b64);
- case T_S16: return fixnum( *(s16int*)aptr & (s16int )b64);
- case T_U16: return fixnum( *(u16int*)aptr & (u16int)b64);
- case T_S32: return mk_s32( *(s32int*)aptr & (s32int )b64);
+ case T_S8: return fixnum(*(s8int *)aptr & (s8int )b64);
+ case T_U8: return fixnum(*(u8int *)aptr & (u8int )b64);
+ case T_S16: return fixnum(*(s16int*)aptr & (s16int)b64);
+ case T_U16: return fixnum(*(u16int*)aptr & (u16int)b64);
+ case T_S32: return mk_s32(*(s32int*)aptr & (s32int)b64);
case T_U32: return mk_u32(*(u32int*)aptr & (u32int)b64);
- case T_S64: return mk_s64( *(s64int*)aptr & (s64int )b64);
+ case T_S64: return mk_s64(*(s64int*)aptr & (s64int)b64);
case T_U64: return mk_u64(*(u64int*)aptr & (u64int)b64);
case T_MP: mpand(*(mpint**)aptr, bmp, resmp); return mk_mp(resmp);
case T_FLOAT:
@@ -1125,13 +1125,13 @@
break;
case 1:
switch(ta){- case T_S8: return fixnum( *(s8int *)aptr | (s8int )b64);
- case T_U8: return fixnum( *(u8int *)aptr | (u8int )b64);
- case T_S16: return fixnum( *(s16int*)aptr | (s16int )b64);
- case T_U16: return fixnum( *(u16int*)aptr | (u16int)b64);
- case T_S32: return mk_s32( *(s32int*)aptr | (s32int )b64);
+ case T_S8: return fixnum(*(s8int *)aptr | (s8int )b64);
+ case T_U8: return fixnum(*(u8int *)aptr | (u8int )b64);
+ case T_S16: return fixnum(*(s16int*)aptr | (s16int)b64);
+ case T_U16: return fixnum(*(u16int*)aptr | (u16int)b64);
+ case T_S32: return mk_s32(*(s32int*)aptr | (s32int)b64);
case T_U32: return mk_u32(*(u32int*)aptr | (u32int)b64);
- case T_S64: return mk_s64( *(s64int*)aptr | (s64int )b64);
+ case T_S64: return mk_s64(*(s64int*)aptr | (s64int)b64);
case T_U64: return mk_u64(*(u64int*)aptr | (u64int)b64);
case T_MP: mpor(*(mpint**)aptr, bmp, resmp); return mk_mp(resmp);
case T_FLOAT:
@@ -1140,13 +1140,13 @@
break;
case 2:
switch(ta){- case T_S8: return fixnum( *(s8int *)aptr ^ (s8int )b64);
- case T_U8: return fixnum( *(u8int *)aptr ^ (u8int )b64);
- case T_S16: return fixnum( *(s16int*)aptr ^ (s16int )b64);
- case T_U16: return fixnum( *(u16int*)aptr ^ (u16int)b64);
- case T_S32: return mk_s32( *(s32int*)aptr ^ (s32int )b64);
+ case T_S8: return fixnum(*(s8int *)aptr ^ (s8int )b64);
+ case T_U8: return fixnum(*(u8int *)aptr ^ (u8int )b64);
+ case T_S16: return fixnum(*(s16int*)aptr ^ (s16int)b64);
+ case T_U16: return fixnum(*(u16int*)aptr ^ (u16int)b64);
+ case T_S32: return mk_s32(*(s32int*)aptr ^ (s32int)b64);
case T_U32: return mk_u32(*(u32int*)aptr ^ (u32int)b64);
- case T_S64: return mk_s64( *(s64int*)aptr ^ (s64int )b64);
+ case T_S64: return mk_s64(*(s64int*)aptr ^ (s64int)b64);
case T_U64: return mk_u64(*(u64int*)aptr ^ (u64int)b64);
case T_MP: mpxor(*(mpint**)aptr, bmp, resmp); return mk_mp(resmp);
case T_FLOAT:
@@ -1220,26 +1220,21 @@
ta = cp_numtype(cp);
aptr = cp_data(cp);
switch(ta){- case T_S8: return fixnum(~*(s8int *)aptr);
+ case T_S8: return fixnum(~*(s8int *)aptr);
case T_U8: return fixnum(~*(u8int *)aptr & 0xff);
- case T_S16: return fixnum(~*(s16int *)aptr);
+ case T_S16: return fixnum(~*(s16int*)aptr);
case T_U16: return fixnum(~*(u16int*)aptr & 0xffff);
- case T_S32: return mk_s32(~*(s32int *)aptr);
+ case T_S32: return mk_s32(~*(s32int*)aptr);
case T_U32: return mk_u32(~*(u32int*)aptr);
- case T_S64: return mk_s64(~*(s64int *)aptr);
+ case T_S64: return mk_s64(~*(s64int*)aptr);
case T_U64: return mk_u64(~*(u64int*)aptr);
}
+ }else if(ismp(a)){+ aptr = cv_data(ptr(a));
+ mpint *m = mpnew(0);
+ mpnot(*(mpint**)aptr, m);
+ return mk_mp(m);
}
- if(iscvalue(a)){- sl_cv *cv = ptr(a);
- ta = cp_numtype(cv);
- aptr = cv_data(cv);
- if(ta == T_MP){- mpint *m = mpnew(0);
- mpnot(*(mpint**)aptr, m);
- return mk_mp(m);
- }
- }
type_error("int", a);}
@@ -1261,7 +1256,7 @@
accum = ((s64int)numval(a))<<n;
return fits_fixnum(accum) ? fixnum(accum) : return_from_s64(accum);
}
- if(iscprim(a) || iscvalue(a)){+ if(iscprim(a)){if(n == 0)
return a;
cp = ptr(a);
@@ -1270,31 +1265,29 @@
if(n < 0){n = -n;
switch(ta){- case T_S8: return fixnum((*(s8int *)aptr) >> n);
+ case T_S8: return fixnum((*(s8int *)aptr) >> n);
case T_U8: return fixnum((*(u8int *)aptr) >> n);
- case T_S16: return fixnum((*(s16int *)aptr) >> n);
+ case T_S16: return fixnum((*(s16int*)aptr) >> n);
case T_U16: return fixnum((*(u16int*)aptr) >> n);
- case T_S32: return mk_s32((*(s32int *)aptr) >> n);
+ case T_S32: return mk_s32((*(s32int*)aptr) >> n);
case T_U32: return mk_u32((*(u32int*)aptr) >> n);
- case T_S64: return mk_s64((*(s64int *)aptr) >> n);
+ case T_S64: return mk_s64((*(s64int*)aptr) >> n);
case T_U64: return mk_u64((*(u64int*)aptr) >> n);
- case T_MP:
- aptr = cv_data(cp);
- mp = mpnew(0);
- mpright(*(mpint**)aptr, n, mp);
- return mk_mp(mp);
}
- }
- if(ta == T_MP){- aptr = cv_data(cp);
- mp = mpnew(0);
- mpleft(*(mpint**)aptr, n, mp);
- return mk_mp(mp);
- }
- if(ta == T_U64)
+ }else if(ta == T_U64)
return return_from_u64((*(u64int*)aptr)<<n);
- if(ta < T_FLOAT)
+ else if(ta < T_FLOAT)
return return_from_s64(conv_to_s64(aptr, ta)<<n);
+ }else if(ismp(a)){+ if(n == 0)
+ return a;
+ aptr = cv_data(ptr(a));
+ mp = mpnew(0);
+ if(n < 0)
+ mpright(*(mpint**)aptr, -n, mp);
+ else
+ mpleft(*(mpint**)aptr, n, mp);
+ return mk_mp(mp);
}
type_error("int", a);}
--- a/src/equal.c
+++ b/src/equal.c
@@ -91,7 +91,7 @@
}
if(iscvalue(b)){cv = ptr(b);
- if(valid_numtype(cv_class(cv)->numtype))
+ if(valid_numtype(cv_numtype(cv)))
return fixnum(numeric_compare(a, b, eq, true, false));
}
return fixnum(-1);
@@ -117,7 +117,7 @@
break;
case TAG_CVALUE:
cv = ptr(a);
- if(valid_numtype(cv_class(cv)->numtype)){+ if(valid_numtype(cv_numtype(cv))){if((c = numeric_compare(a, b, eq, true, false)) != 2)
return fixnum(c);
}
--- a/src/read.c
+++ b/src/read.c
@@ -101,7 +101,7 @@
ch = ios_getc(RS);
if(ch == IOS_EOF)
return 0;
- c = (char)ch;
+ c = ch;
if(c == ';'){// single-line comment
do{@@ -108,8 +108,8 @@
ch = ios_getc(f);
if(ch == IOS_EOF)
return 0;
- }while((char)ch != '\n');
- c = (char)ch;
+ }while(ch != '\n');
+ c = ch;
}
}while(c == ' ' || isspace(c));
return c;
@@ -162,7 +162,7 @@
ch = ios_peekc(RS);
if(ch == IOS_EOF)
goto terminate;
- c = (char)ch;
+ c = ch;
}
if(c == '|'){issym = true;
@@ -173,7 +173,7 @@
ch = ios_peekc(RS);
if(ch == IOS_EOF)
goto terminate;
- accumchar(ctx, (char)ch, &i);
+ accumchar(ctx, ch, &i);
}else if(!escaped && !(symchar(c) && (!digits || isdigit(c)))){break;
}else{@@ -228,7 +228,7 @@
else if(c == '"')
ctx->toktype = TOK_DOUBLEQUOTE;
else if(c == '#'){- ch = ios_getc(RS); c = (char)ch;
+ c = ch = ios_getc(RS);
if(ch == IOS_EOF)
parse_error(&ctx->loc, "invalid read macro");
if(c == '.')
@@ -247,7 +247,7 @@
cval = numval(ctx->tokval);
}
}else if(cval >= 'a' && cval <= 'z'){- read_token(ctx, (char)cval, 0);
+ read_token(ctx, cval, 0);
ctx->tokval = mk_sym(ctx->buf, true);
if(ctx->buf[1] == '\0') USED(cval); /* one character */
else if(ctx->tokval == sl_nulsym) cval = 0x00;
@@ -273,7 +273,7 @@
parse_error(&ctx->loc, "unreadable object");
}else if(isdigit(c)){read_token(ctx, c, 1);
- c = (char)ios_getc(RS);
+ c = ios_getc(RS);
if(c == '#')
ctx->toktype = TOK_BACKREF;
else if(c == '=')
@@ -288,7 +288,7 @@
// #! single line comment for shbang script support
do{ch = ios_getc(RS);
- }while(ch != IOS_EOF && (char)ch != '\n');
+ }while(ch != IOS_EOF && ch != '\n');
return peek(ctx);
}else if(c == '|'){// multiline comment
@@ -298,9 +298,9 @@
hashpipe_gotc:
if(ch == IOS_EOF)
parse_error(&ctx->loc, "eof within comment");
- if((char)ch == '|'){+ if(ch == '|'){ch = ios_getc(RS);
- if((char)ch == '#'){+ if(ch == '#'){commentlevel--;
if(commentlevel == 0)
break;
@@ -308,9 +308,9 @@
continue;
}
goto hashpipe_gotc;
- }else if((char)ch == '#'){+ }else if(ch == '#'){ch = ios_getc(RS);
- if((char)ch == '|')
+ if(ch == '|')
commentlevel++;
else
goto hashpipe_gotc;
@@ -325,9 +325,9 @@
}else if(c == ':'){// gensym
ch = ios_getc(RS);
- if((char)ch == 'g')
+ if(ch == 'g')
ch = ios_getc(RS);
- read_token(ctx, (char)ch, 0);
+ read_token(ctx, ch, 0);
x = strtol(ctx->buf, &end, 10);
if(*end != '\0' || ctx->buf[0] == '\0')
parse_error(&ctx->loc, "invalid gensym label");
@@ -355,9 +355,9 @@
ch = ios_peekc(RS);
if(ch == IOS_EOF)
return ctx->toktype;
- if((char)ch == '@')
+ if(ch == '@')
ctx->toktype = TOK_COMMAAT;
- else if((char)ch == '.')
+ else if(ch == '.')
ctx->toktype = TOK_COMMADOT;
else
return ctx->toktype;
@@ -493,7 +493,7 @@
eseq[j] = '\0';
r = strtol(eseq, nil, 8);
// \DDD and \xXX read bytes, not characters
- buf[i++] = (char)r;
+ buf[i++] = r;
}else if((c == 'x' && (ndig = 2)) || (c == 'u' && (ndig = 4)) || (c == 'U' && (ndig = 8))){ while(1){c = ios_peekc(RS);
@@ -511,14 +511,14 @@
parse_error(&ctx->loc, "invalid escape sequence");
}
if(ndig == 2)
- buf[i++] = (char)r;
+ buf[i++] = r;
else
i += runetochar(&buf[i], &r);
}else if(c == '\n'){/* do nothing */
}else{- char esc = read_escape_control_char((char)c);
- if(esc == (char)c && !strchr("\\'\"`", esc)){+ char esc = read_escape_control_char(c);
+ if(esc == c && !strchr("\\'\"`", esc)){if(buf != ctx->buf)
MEM_FREE(buf);
sl_loc *l = &RS->loc;
@@ -525,7 +525,7 @@
parse_error(
&ctx->loc,
"invalid escape sequence \\%c "PAtLoc,
- (char)c,
+ c,
l->lineno,
l->colno
);
--- a/src/sl.h
+++ b/src/sl.h
@@ -331,8 +331,9 @@
#define cp_data(cp) (((sl_cprim*)(cp))->_space)
// WARNING: multiple evaluation!
#define cptr(v) (iscprim(v) ? cp_data(ptr(v)) : cvalue_data(v))
+#define cv_numtype(cv) (cv_class(cv)->numtype)
-#define ismp(v) (iscvalue(v) && cp_numtype(ptr(v)) == T_MP)
+#define ismp(v) (iscvalue(v) && cv_numtype(ptr(v)) == T_MP)
#define tomp(v) (*(mpint**)cv_data(ptr(v)))
#define BUILTIN(lname, cname) \
--- a/src/sl_arith_any.h
+++ b/src/sl_arith_any.h
@@ -27,7 +27,7 @@
}else if(iscvalue(arg)){cv = ptr(arg);
a = cv_data(cv);
- pt = cv_class(cv)->numtype;
+ pt = cv_numtype(cv);
}else{typeerr:
mpfree(Maccum);
@@ -100,7 +100,7 @@
}else if(iscvalue(arg)){cv = ptr(arg);
a = cv_data(cv);
- pt = cv_class(cv)->numtype;
+ pt = cv_numtype(cv);
}else{goto typeerr;
}