lassik
/
upscheme
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Replace cprim_t with struct

This commit is contained in:
Lassi Kortela 2019-08-09 19:25:43 +03:00
parent fdcdd865b4
commit d6f1579e17
8 changed files with 73 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
c/builtins.c
View File

@ -109,7 +109,8 @@ static value_t fl_length(value_t *args, u_int32_t nargs)
if (cp_class(cv) == bytetype)
return fixnum(1);
else if (cp_class(cv) == wchartype)
return fixnum(u8_charlen(*(uint32_t *)cp_data((cprim_t *)cv)));
return fixnum(
u8_charlen(*(uint32_t *)cp_data((struct cprim *)cv)));
} else if (iscvalue(a)) {
cv = (cvalue_t *)ptr(a);
if (cv_class(cv)->eltype != NULL)
@ -215,10 +216,10 @@ static value_t fl_integer_valuedp(value_t *args, u_int32_t nargs)
if (isfixnum(v)) {
return FL_T;
} else if (iscprim(v)) {
numerictype_t nt = cp_numtype((cprim_t *)ptr(v));
numerictype_t nt = cp_numtype((struct cprim *)ptr(v));
if (nt < T_FLOAT)
return FL_T;
void *data = cp_data((cprim_t *)ptr(v));
void *data = cp_data((struct cprim *)ptr(v));
if (nt == T_FLOAT) {
float f = *(float *)data;
if (f < 0)
@ -242,7 +243,7 @@ static value_t fl_integerp(value_t *args, u_int32_t nargs)
argcount("integer?", nargs, 1);
value_t v = args[0];
return (isfixnum(v) ||
(iscprim(v) && cp_numtype((cprim_t *)ptr(v)) < T_FLOAT))
(iscprim(v) && cp_numtype((struct cprim *)ptr(v)) < T_FLOAT))
? FL_T
: FL_F;
}
@ -253,7 +254,7 @@ static value_t fl_fixnum(value_t *args, u_int32_t nargs)
if (isfixnum(args[0])) {
return args[0];
} else if (iscprim(args[0])) {
cprim_t *cp = (cprim_t *)ptr(args[0]);
struct cprim *cp = (struct cprim *)ptr(args[0]);
return fixnum(conv_to_long(cp_data(cp), cp_numtype(cp)));
}
type_error("fixnum", "number", args[0]);
@ -265,7 +266,7 @@ static value_t fl_truncate(value_t *args, u_int32_t nargs)
if (isfixnum(args[0]))
return args[0];
if (iscprim(args[0])) {
cprim_t *cp = (cprim_t *)ptr(args[0]);
struct cprim *cp = (struct cprim *)ptr(args[0]);
void *data = cp_data(cp);
numerictype_t nt = cp_numtype(cp);
double d;
@ -319,7 +320,7 @@ static double todouble(value_t a, char *fname)
if (isfixnum(a))
return (double)numval(a);
if (iscprim(a)) {
cprim_t *cp = (cprim_t *)ptr(a);
struct cprim *cp = (struct cprim *)ptr(a);
numerictype_t nt = cp_numtype(cp);
return conv_to_double(cp_data(cp), nt);
}
@ -455,7 +456,7 @@ static value_t fl_randf(value_t *args, u_int32_t nargs)
{ \
argcount(#name, nargs, 1); \
if (iscprim(args[0])) { \
cprim_t *cp = (cprim_t *)ptr(args[0]); \
struct cprim *cp = (struct cprim *)ptr(args[0]); \
numerictype_t nt = cp_numtype(cp); \
if (nt == T_FLOAT) \
return mk_float(name##f(*(float *)cp_data(cp))); \

57
c/cvalues.h
View File

@ -121,7 +121,8 @@ static value_t cprim(fltype_t *type, size_t sz)
{
assert(!ismanaged((uptrint_t)type));
assert(sz == type->size);
cprim_t *pcp = (cprim_t *)alloc_words(CPRIM_NWORDS - 1 + NWORDS(sz));
struct cprim *pcp =
(struct cprim *)alloc_words(CPRIM_NWORDS - 1 + NWORDS(sz));
pcp->type = type;
return tagptr(pcp, TAG_CPRIM);
}
@ -244,7 +245,7 @@ void cv_pin(cvalue_t *cv)
if (isfixnum(arg)) { \
n = numval(arg); \
} else if (iscprim(arg)) { \
cprim_t *cp = (cprim_t *)ptr(arg); \
struct cprim *cp = (struct cprim *)ptr(arg); \
void *p = cp_data(cp); \
n = (fl_##ctype##_t)conv_to_##cnvt(p, cp_numtype(cp)); \
} else { \
@ -259,25 +260,25 @@ num_init(int32, int32, T_INT32) num_init(uint32, uint32, T_UINT32)
num_init(int64, int64, T_INT64) num_init(uint64, uint64, T_UINT64)
num_init(float, double, T_FLOAT) num_init(double, double, T_DOUBLE)
#define num_ctor_init(typenam, ctype, tag) \
value_t cvalue_##typenam(value_t *args, u_int32_t nargs) \
{ \
if (nargs == 0) { \
PUSH(fixnum(0)); \
args = &Stack[SP - 1]; \
} \
value_t cp = cprim(typenam##type, sizeof(fl_##ctype##_t)); \
if (cvalue_##ctype##_init(typenam##type, args[0], \
cp_data((cprim_t *)ptr(cp)))) \
type_error(#typenam, "number", args[0]); \
return cp; \
#define num_ctor_init(typenam, ctype, tag) \
value_t cvalue_##typenam(value_t *args, u_int32_t nargs) \
{ \
if (nargs == 0) { \
PUSH(fixnum(0)); \
args = &Stack[SP - 1]; \
} \
value_t cp = cprim(typenam##type, sizeof(fl_##ctype##_t)); \
if (cvalue_##ctype##_init(typenam##type, args[0], \
cp_data((struct cprim *)ptr(cp)))) \
type_error(#typenam, "number", args[0]); \
return cp; \
}
#define num_ctor_ctor(typenam, ctype, tag) \
value_t mk_##typenam(fl_##ctype##_t n) \
{ \
value_t cp = cprim(typenam##type, sizeof(fl_##ctype##_t)); \
*(fl_##ctype##_t *)cp_data((cprim_t *)ptr(cp)) = n; \
*(fl_##ctype##_t *)cp_data((struct cprim *)ptr(cp)) = n; \
return cp; \
}
@ -309,7 +310,7 @@ size_t toulong(value_t n, char *fname)
if (isfixnum(n))
return numval(n);
if (iscprim(n)) {
cprim_t *cp = (cprim_t *)ptr(n);
struct cprim *cp = (struct cprim *)ptr(n);
return conv_to_ulong(cp_data(cp), cp_numtype(cp));
}
type_error(fname, "number", n);
@ -337,7 +338,7 @@ static int cvalue_enum_init(fltype_t *ft, value_t arg, void *dest)
if (isfixnum(arg)) {
n = (int)numval(arg);
} else if (iscprim(arg)) {
cprim_t *cp = (cprim_t *)ptr(arg);
struct cprim *cp = (struct cprim *)ptr(arg);
n = conv_to_int32(cp_data(cp), cp_numtype(cp));
} else {
type_error("enum", "number", arg);
@ -354,7 +355,7 @@ value_t cvalue_enum(value_t *args, u_int32_t nargs)
value_t type = fl_list2(enumsym, args[0]);
fltype_t *ft = get_type(type);
value_t cv = cvalue(ft, sizeof(int32_t));
cvalue_enum_init(ft, args[1], cp_data((cprim_t *)ptr(cv)));
cvalue_enum_init(ft, args[1], cp_data((struct cprim *)ptr(cv)));
return cv;
}
@ -585,7 +586,7 @@ void to_sized_ptr(value_t v, char *fname, char **pdata, size_t *psz)
return;
}
} else if (iscprim(v)) {
cprim_t *pcp = (cprim_t *)ptr(v);
struct cprim *pcp = (struct cprim *)ptr(v);
*pdata = cp_data(pcp);
*psz = cp_class(pcp)->size;
return;
@ -1058,7 +1059,7 @@ static value_t fl_add_any(value_t *args, u_int32_t nargs, fixnum_t carryIn)
Saccum += numval(arg);
continue;
} else if (iscprim(arg)) {
cprim_t *cp = (cprim_t *)ptr(arg);
struct cprim *cp = (struct cprim *)ptr(arg);
void *a = cp_data(cp);
int64_t i64;
switch (cp_numtype(cp)) {
@ -1140,7 +1141,7 @@ static value_t fl_neg(value_t n)
else
return s;
} else if (iscprim(n)) {
cprim_t *cp = (cprim_t *)ptr(n);
struct cprim *cp = (struct cprim *)ptr(n);
void *a = cp_data(cp);
uint32_t ui32;
int32_t i32;
@ -1195,7 +1196,7 @@ static value_t fl_mul_any(value_t *args, u_int32_t nargs, int64_t Saccum)
Saccum *= numval(arg);
continue;
} else if (iscprim(arg)) {
cprim_t *cp = (cprim_t *)ptr(arg);
struct cprim *cp = (struct cprim *)ptr(arg);
void *a = cp_data(cp);
int64_t i64;
switch (cp_numtype(cp)) {
@ -1264,13 +1265,13 @@ static value_t fl_mul_any(value_t *args, u_int32_t nargs, int64_t Saccum)
static int num_to_ptr(value_t a, fixnum_t *pi, numerictype_t *pt, void **pp)
{
cprim_t *cp;
struct cprim *cp;
if (isfixnum(a)) {
*pi = numval(a);
*pp = pi;
*pt = T_FIXNUM;
} else if (iscprim(a)) {
cp = (cprim_t *)ptr(a);
cp = (struct cprim *)ptr(a);
*pp = cp_data(cp);
*pt = cp_numtype(cp);
} else {
@ -1554,12 +1555,12 @@ static value_t fl_lognot(value_t *args, u_int32_t nargs)
value_t a = args[0];
if (isfixnum(a))
return fixnum(~numval(a));
cprim_t *cp;
struct cprim *cp;
int ta;
void *aptr;
if (iscprim(a)) {
cp = (cprim_t *)ptr(a);
cp = (struct cprim *)ptr(a);
ta = cp_numtype(cp);
aptr = cp_data(cp);
switch (ta) {
@ -1600,13 +1601,13 @@ static value_t fl_ash(value_t *args, u_int32_t nargs)
else
return return_from_int64(accum);
}
cprim_t *cp;
struct cprim *cp;
int ta;
void *aptr;
if (iscprim(a)) {
if (n == 0)
return a;
cp = (cprim_t *)ptr(a);
cp = (struct cprim *)ptr(a);
ta = cp_numtype(cp);
aptr = cp_data(cp);
if (n < 0) {

13
c/equal.h
View File

@ -70,7 +70,7 @@ compare_top:
return (numval(a) < numval(b)) ? fixnum(-1) : fixnum(1);
}
if (iscprim(b)) {
if (cp_class((cprim_t *)ptr(b)) == wchartype)
if (cp_class((struct cprim *)ptr(b)) == wchartype)
return fixnum(1);
return fixnum(numeric_compare(a, b, eq, 1, NULL));
}
@ -88,10 +88,11 @@ compare_top:
return bounded_vector_compare(a, b, bound, eq);
break;
case TAG_CPRIM:
if (cp_class((cprim_t *)ptr(a)) == wchartype) {
if (!iscprim(b) || cp_class((cprim_t *)ptr(b)) != wchartype)
if (cp_class((struct cprim *)ptr(a)) == wchartype) {
if (!iscprim(b) || cp_class((struct cprim *)ptr(b)) != wchartype)
return fixnum(-1);
} else if (iscprim(b) && cp_class((cprim_t *)ptr(b)) == wchartype) {
} else if (iscprim(b) &&
cp_class((struct cprim *)ptr(b)) == wchartype) {
return fixnum(1);
}
c = numeric_compare(a, b, eq, 1, NULL);
@ -311,7 +312,7 @@ static uptrint_t bounded_hash(value_t a, int bound, int *oob)
numerictype_t nt;
size_t i, len;
cvalue_t *cv;
cprim_t *cp;
struct cprim *cp;
void *data;
uptrint_t h = 0;
int oob2, tg = tag(a);
@ -328,7 +329,7 @@ static uptrint_t bounded_hash(value_t a, int bound, int *oob)
case TAG_SYM:
return ((symbol_t *)ptr(a))->hash;
case TAG_CPRIM:
cp = (cprim_t *)ptr(a);
cp = (struct cprim *)ptr(a);
data = cp_data(cp);
if (cp_class(cp) == wchartype)
return inthash(*(int32_t *)data);

6
c/flisp.c
View File

@ -499,9 +499,9 @@ static value_t relocate(value_t v)
}
return nc;
} else if (t == TAG_CPRIM) {
cprim_t *pcp = (cprim_t *)ptr(v);
struct cprim *pcp = (struct cprim *)ptr(v);
size_t nw = CPRIM_NWORDS - 1 + NWORDS(cp_class(pcp)->size);
cprim_t *ncp = (cprim_t *)alloc_words(nw);
struct cprim *ncp = (struct cprim *)alloc_words(nw);
while (nw--)
((value_t *)ncp)[nw] = ((value_t *)pcp)[nw];
nc = tagptr(ncp, TAG_CPRIM);
@ -763,7 +763,7 @@ int fl_isnumber(value_t v)
if (isfixnum(v))
return 1;
if (iscprim(v)) {
cprim_t *c = (cprim_t *)ptr(v);
struct cprim *c = (struct cprim *)ptr(v);
return c->type != wchartype;
}
return 0;

9
c/flisp.h
View File

@ -274,10 +274,10 @@ typedef struct {
#define CVALUE_NWORDS 4
typedef struct {
struct cprim {
fltype_t *type;
char _space[1];
} cprim_t;
};
struct function {
value_t bcode;
@ -312,8 +312,9 @@ struct function {
#define cp_data(cp) (&(cp)->_space[0])
// WARNING: multiple evaluation!
#define cptr(v) \
(iscprim(v) ? cp_data((cprim_t *)ptr(v)) : cv_data((cvalue_t *)ptr(v)))
#define cptr(v) \
(iscprim(v) ? cp_data((struct cprim *)ptr(v)) \
: cv_data((cvalue_t *)ptr(v)))
/* C type names corresponding to cvalues type names */
typedef int8_t fl_int8_t;

20
c/iostream.c
View File

@ -174,9 +174,10 @@ value_t fl_ioputc(value_t *args, u_int32_t nargs)
{
argcount("io.putc", nargs, 2);
struct ios *s = toiostream(args[0], "io.putc");
if (!iscprim(args[1]) || ((cprim_t *)ptr(args[1]))->type != wchartype)
if (!iscprim(args[1]) ||
((struct cprim *)ptr(args[1]))->type != wchartype)
type_error("io.putc", "wchar", args[1]);
uint32_t wc = *(uint32_t *)cp_data((cprim_t *)ptr(args[1]));
uint32_t wc = *(uint32_t *)cp_data((struct cprim *)ptr(args[1]));
return fixnum(ios_pututf8(s, wc));
}
@ -184,9 +185,10 @@ value_t fl_ioungetc(value_t *args, u_int32_t nargs)
{
argcount("io.ungetc", nargs, 2);
struct ios *s = toiostream(args[0], "io.ungetc");
if (!iscprim(args[1]) || ((cprim_t *)ptr(args[1]))->type != wchartype)
if (!iscprim(args[1]) ||
((struct cprim *)ptr(args[1]))->type != wchartype)
type_error("io.ungetc", "wchar", args[1]);
uint32_t wc = *(uint32_t *)cp_data((cprim_t *)ptr(args[1]));
uint32_t wc = *(uint32_t *)cp_data((struct cprim *)ptr(args[1]));
if (wc >= 0x80) {
lerror(ArgError, "io_ungetc: unicode not yet supported");
}
@ -281,7 +283,7 @@ value_t fl_ioread(value_t *args, u_int32_t nargs)
if (iscvalue(cv))
data = cv_data((cvalue_t *)ptr(cv));
else
data = cp_data((cprim_t *)ptr(cv));
data = cp_data((struct cprim *)ptr(cv));
size_t got = ios_read(value2c(struct ios *, args[0]), data, n);
if (got < n)
// lerror(IOError, "io.read: end of input reached");
@ -309,11 +311,12 @@ value_t fl_iowrite(value_t *args, u_int32_t nargs)
if (nargs < 2 || nargs > 4)
argcount("io.write", nargs, 2);
struct ios *s = toiostream(args[0], "io.write");
if (iscprim(args[1]) && ((cprim_t *)ptr(args[1]))->type == wchartype) {
if (iscprim(args[1]) &&
((struct cprim *)ptr(args[1]))->type == wchartype) {
if (nargs > 2)
lerror(ArgError,
"io.write: offset argument not supported for characters");
uint32_t wc = *(uint32_t *)cp_data((cprim_t *)ptr(args[1]));
uint32_t wc = *(uint32_t *)cp_data((struct cprim *)ptr(args[1]));
return fixnum(ios_pututf8(s, wc));
}
char *data;
@ -349,7 +352,8 @@ static char get_delim_arg(value_t arg, char *fname)
size_t uldelim = toulong(arg, fname);
if (uldelim > 0x7f) {
// wchars > 0x7f, or anything else > 0xff, are out of range
if ((iscprim(arg) && cp_class((cprim_t *)ptr(arg)) == wchartype) ||
if ((iscprim(arg) &&
cp_class((struct cprim *)ptr(arg)) == wchartype) ||
uldelim > 0xff)
lerrorf(ArgError, "%s: delimiter out of range", fname);
}

2
c/print.h
View File

@ -190,7 +190,7 @@ static int lengthestimate(value_t v)
// get the width of an expression if we can do so cheaply
if (issymbol(v))
return u8_strwidth(symbol_name(v));
if (iscprim(v) && cp_class((cprim_t *)ptr(v)) == wchartype)
if (iscprim(v) && cp_class((struct cprim *)ptr(v)) == wchartype)
return 4;
return -1;
}

14
c/string.c
View File

@ -67,7 +67,7 @@ value_t fl_string_width(value_t *args, u_int32_t nargs)
{
argcount("string.width", nargs, 1);
if (iscprim(args[0])) {
cprim_t *cp = (cprim_t *)ptr(args[0]);
struct cprim *cp = (struct cprim *)ptr(args[0]);
if (cp_class(cp) == wchartype) {
int w = wcwidth(*(uint32_t *)cp_data(cp));
if (w < 0)
@ -243,7 +243,7 @@ value_t fl_string_char(value_t *args, u_int32_t nargs)
value_t fl_char_upcase(value_t *args, u_int32_t nargs)
{
argcount("char.upcase", nargs, 1);
cprim_t *cp = (cprim_t *)ptr(args[0]);
struct cprim *cp = (struct cprim *)ptr(args[0]);
if (!iscprim(args[0]) || cp_class(cp) != wchartype)
type_error("char.upcase", "wchar", args[0]);
return mk_wchar(towupper(*(int32_t *)cp_data(cp)));
@ -251,7 +251,7 @@ value_t fl_char_upcase(value_t *args, u_int32_t nargs)
value_t fl_char_downcase(value_t *args, u_int32_t nargs)
{
argcount("char.downcase", nargs, 1);
cprim_t *cp = (cprim_t *)ptr(args[0]);
struct cprim *cp = (struct cprim *)ptr(args[0]);
if (!iscprim(args[0]) || cp_class(cp) != wchartype)
type_error("char.downcase", "wchar", args[0]);
return mk_wchar(towlower(*(int32_t *)cp_data(cp)));
@ -260,7 +260,7 @@ value_t fl_char_downcase(value_t *args, u_int32_t nargs)
value_t fl_char_alpha(value_t *args, u_int32_t nargs)
{
argcount("char-alphabetic?", nargs, 1);
cprim_t *cp = (cprim_t *)ptr(args[0]);
struct cprim *cp = (struct cprim *)ptr(args[0]);
if (!iscprim(args[0]) || cp_class(cp) != wchartype)
type_error("char-alphabetic?", "wchar", args[0]);
return iswalpha(*(int32_t *)cp_data(cp)) ? FL_T : FL_F;
@ -290,7 +290,7 @@ value_t fl_string_find(value_t *args, u_int32_t nargs)
size_t needlesz;
value_t v = args[1];
cprim_t *cp = (cprim_t *)ptr(v);
struct cprim *cp = (struct cprim *)ptr(v);
if (iscprim(v) && cp_class(cp) == wchartype) {
uint32_t c = *(uint32_t *)cp_data(cp);
if (c <= 0x7f)
@ -381,8 +381,8 @@ value_t fl_numbertostring(value_t *args, u_int32_t nargs)
else if (!iscprim(n))
type_error("number->string", "integer", n);
else
num = conv_to_uint64(cp_data((cprim_t *)ptr(n)),
cp_numtype((cprim_t *)ptr(n)));
num = conv_to_uint64(cp_data((struct cprim *)ptr(n)),
cp_numtype((struct cprim *)ptr(n)));
if (numval(fl_compare(args[0], fixnum(0))) < 0) {
num = -num;
neg = 1;