library improvements II: extra instructions

This commit is contained in:
ESL 2023-03-25 11:30:30 -04:00
parent af543d10a6
commit 7ef7b1857e
2 changed files with 114 additions and 28 deletions

102
i.c
View file

@ -1672,6 +1672,24 @@ define_instruction(jabs) {
gonexti();
}
define_instruction(jgcd) {
obj x = ac, y = spop(); ckj(x); ckj(y);
ac = obj_from_flonum(sp-r, flgcd(flonum_from_obj(x), flonum_from_obj(y)));
gonexti();
}
define_instruction(jpow) {
obj x = ac, y = spop(); ckj(x); ckj(y);
ac = obj_from_flonum(sp-r, pow(flonum_from_obj(x), flonum_from_obj(y)));
gonexti();
}
define_instruction(jsqrt) {
ckj(ac);
ac = obj_from_flonum(sp-r, sqrt(flonum_from_obj(ac)));
gonexti();
}
define_instruction(jtoi) {
ckj(ac);
ac = obj_from_fixnum(fxflo(flonum_from_obj(ac)));
@ -2025,6 +2043,52 @@ define_instruction(max) {
gonexti();
}
define_instruction(gcd) {
obj x = ac, y = spop();
if (likely(are_fixnum_objs(x, y))) {
ac = obj_from_fixnum(fxgcd(fixnum_from_obj(x), fixnum_from_obj(y)));
} else {
double dx, dy;
if (likely(is_flonum_obj(x))) dx = flonum_from_obj(x);
else if (likely(is_fixnum_obj(x))) dx = (double)fixnum_from_obj(x);
else failtype(x, "number");
if (likely(is_flonum_obj(y))) dy = flonum_from_obj(y);
else if (likely(is_fixnum_obj(y))) dy = (double)fixnum_from_obj(y);
else failtype(y, "number");
ac = obj_from_flonum(sp-r, flgcd(dx, dy));
}
gonexti();
}
define_instruction(pow) {
obj x = ac, y = spop();
if (likely(are_fixnum_objs(x, y))) {
/* fixme: this will either overflow, or fail on negative y */
ac = obj_from_fixnum(fxpow(fixnum_from_obj(x), fixnum_from_obj(y)));
} else {
double dx, dy;
if (likely(is_flonum_obj(x))) dx = flonum_from_obj(x);
else if (likely(is_fixnum_obj(x))) dx = (double)fixnum_from_obj(x);
else failtype(x, "number");
if (likely(is_flonum_obj(y))) dy = flonum_from_obj(y);
else if (likely(is_fixnum_obj(y))) dy = (double)fixnum_from_obj(y);
else failtype(y, "number");
ac = obj_from_flonum(sp-r, pow(dx, dy));
}
gonexti();
}
define_instruction(sqrt) {
if (likely(is_flonum_obj(ac))) {
ac = obj_from_flonum(sp-r, sqrt(flonum_from_obj(ac)));
} else if (likely(is_fixnum_obj(ac))) {
long x = fixnum_from_obj(ac), y;
if (x < 0) ac = obj_from_flonum(sp-r, (HUGE_VAL - HUGE_VAL));
else if (y = fxsqrt(x), y*y == x) ac = obj_from_fixnum(y);
else ac = obj_from_flonum(sp-r, sqrt((double)x));
} else failactype("number");
gonexti();
}
define_instruction(neg) {
if (likely(is_fixnum_obj(ac))) {
@ -2044,6 +2108,44 @@ define_instruction(abs) {
gonexti();
}
define_instruction(floor) {
if (likely(is_flonum_obj(ac))) {
ac = obj_from_flonum(sp-r, floor(flonum_from_obj(ac)));
} else if (unlikely(!is_fixnum_obj(ac))) {
failactype("number");
}
gonexti();
}
define_instruction(ceil) {
if (likely(is_flonum_obj(ac))) {
ac = obj_from_flonum(sp-r, ceil(flonum_from_obj(ac)));
} else if (unlikely(!is_fixnum_obj(ac))) {
failactype("number");
}
gonexti();
}
define_instruction(trunc) {
if (likely(is_flonum_obj(ac))) {
double x = flonum_from_obj(ac);
double i; modf(x, &i);
ac = obj_from_flonum(sp-r, i);
} else if (unlikely(!is_fixnum_obj(ac))) {
failactype("number");
}
gonexti();
}
define_instruction(round) {
if (likely(is_flonum_obj(ac))) {
ac = obj_from_flonum(sp-r, flround(flonum_from_obj(ac)));
} else if (unlikely(!is_fixnum_obj(ac))) {
failactype("number");
}
gonexti();
}
define_instruction(nump) {
ac = obj_from_bool(is_fixnum_obj(ac) || is_flonum_obj(ac));

40
i.h
View file

@ -257,17 +257,12 @@ declare_instruction(iabs, "Ia", 0, "fxabs", '1',
declare_instruction(itoj, "Ij", 0, "fixnum->flonum", '1', AUTOGL)
declare_instruction(fixp, "I0", 0, "fixnum?", '1', AUTOGL)
declare_instruction(imqu, "Il", 0, "fxmodquo", '2', AUTOGL)
//declare_instrshadow(imqu, "I3", 0, NULL, 0, NULL)
declare_instruction(imlo, "Im", 0, "fxmodulo", '2', AUTOGL)
//declare_instrshadow(imlo, "I4", 0, NULL, 0, NULL)
declare_instruction(ieuq, "I5", 0, "fxeucquo", '2', AUTOGL)
declare_instruction(ieur, "I6", 0, "fxeucrem", '2', AUTOGL)
declare_instruction(igcd, "Ig", 0, "fxgcd", '2', AUTOGL)
//declare_instrshadow(igcd, "I7", 0, NULL, 0, NULL)
declare_instruction(ipow, "Ip", 0, "fxexpt", '2', AUTOGL)
//declare_instrshadow(ipow, "I8", 0, NULL, 0, NULL)
declare_instruction(isqrt, "It", 0, "fxsqrt", '1', AUTOGL)
//declare_instrshadow(isqrt, "I9", 0, NULL, 0, NULL)
declare_instruction(inot, "D0", 0, "fxnot", '1', AUTOGL)
declare_instruction(iand, "D1\0'(i-1)", 0, "fxand", 'p', AUTOGL)
declare_instruction(iior, "D2\0'0", 0, "fxior", 'p', AUTOGL)
@ -299,20 +294,17 @@ declare_instruction(jmin, "Jn", 0, "flmin", 'x',
declare_instruction(jmax, "Jx", 0, "flmax", 'x', AUTOGL)
declare_instruction(jneg, "J-!", 0, "flneg", '1', AUTOGL)
declare_instruction(jabs, "Ja", 0, "flabs", '1', AUTOGL)
declare_instruction(jgcd, "Jg", 0, "flgcd", '2', AUTOGL)
declare_instruction(jpow, "Jp", 0, "flexpt", '2', AUTOGL)
declare_instruction(jsqrt, "Jt", 0, "flsqrt", '1', AUTOGL)
declare_instruction(jtoi, "Ji", 0, "flonum->fixnum", '1', AUTOGL)
declare_instruction(flop, "J0", 0, "flonum?", '1', AUTOGL)
declare_instruction(jmqu, "Jl", 0, "flmodquo", '2', AUTOGL)
//declare_instrshadow(jmqu, "J3", 0, NULL, 0, NULL)
declare_instruction(jmlo, "Jm", 0, "flmodulo", '2', AUTOGL)
//declare_instrshadow(jmlo, "J4", 0, NULL, 0, NULL)
declare_instruction(jfloor, "Jb", 0, "flfloor", '1', AUTOGL)
//declare_instrshadow(jfloor, "H0", 0, NULL, 0, NULL)
declare_instruction(jceil, "Jc", 0, "flceiling", '1', AUTOGL)
//declare_instrshadow(jceil, "H1", 0, NULL, 0, NULL)
declare_instruction(jtrunc, "Jk", 0, "fltruncate", '1', AUTOGL)
//declare_instrshadow(jtrunc, "H2", 0, NULL, 0, NULL)
declare_instruction(jround, "Jd", 0, "flround", '1', AUTOGL)
//declare_instrshadow(jround, "H3", 0, NULL, 0, NULL)
declare_instruction(zerop, "=0", 0, "zero?", '1', AUTOGL)
declare_instruction(posp, ">0", 0, "positive?", '1', AUTOGL)
declare_instruction(negp, "<0", 0, "negative?", '1', AUTOGL)
@ -326,38 +318,30 @@ declare_instruction(le, ">!", 0, "<=", 'c',
declare_instruction(ge, "<!", 0, ">=", 'c', AUTOGL)
declare_instruction(eq, "=", 0, "=", 'c', AUTOGL)
declare_instruction(ne, "=!", 0, "!=", '2', AUTOGL)
declare_instruction(min, "Gn", 0, "min", 'x', AUTOGL)
declare_instruction(max, "Gx", 0, "max", 'x', AUTOGL)
declare_instruction(neg, "-!", 0, "neg", '1', AUTOGL)
declare_instruction(abs, "Ga", 0, "abs", '1', AUTOGL)
//declare_instrshadow(abs, "G0", 0, NULL, 0, NULL)
declare_instruction(gcd, "Gg", 0, "gcd", '2', AUTOGL)
declare_instruction(pow, "Gp", 0, "expt", '2', AUTOGL)
declare_instruction(sqrt, "Gt", 0, "sqrt", '1', AUTOGL)
declare_instruction(mqu, "Gl", 0, "floor-quotient", '2', AUTOGL)
//declare_instrshadow(mqu, "G3", 0, NULL, 0, NULL)
declare_instruction(mlo, "Gm", 0, "floor-remainder", '2', AUTOGL)
//declare_instrshadow(mlo, "G4", 0, NULL, 0, NULL)
declare_instruction(quo, "Gq", 0, "truncate-quotient", '2', AUTOGL)
//declare_instrshadow(quo, "G5", 0, NULL, 0, NULL)
declare_instruction(rem, "Gr", 0, "truncate-remainder", '2', AUTOGL)
//declare_instrshadow(rem, "G6", 0, NULL, 0, NULL)
declare_instruction(nump, "N0", 0, "number?", '1', AUTOGL)
declare_instruction(intp, "Gw", 0, "integer?", '1', AUTOGL)
//declare_instrshadow(intp, "N4", 0, NULL, 0, NULL)
declare_instruction(nanp, "Gu", 0, "nan?", '1', AUTOGL)
//declare_instrshadow(nanp, "N5", 0, NULL, 0, NULL)
declare_instruction(finp, "Gf", 0, "finite?", '1', AUTOGL)
//declare_instrshadow(finp, "N6", 0, NULL, 0, NULL)
declare_instruction(infp, "Gh", 0, "infinite?", '1', AUTOGL)
//declare_instrshadow(infp, "N7", 0, NULL, 0, NULL)
declare_instruction(evnp, "Ge", 0, "even?", '1', AUTOGL)
//declare_instrshadow(evnp, "N8", 0, NULL, 0, NULL)
declare_instruction(oddp, "Go", 0, "odd?", '1', AUTOGL)
//declare_instrshadow(oddp, "N9", 0, NULL, 0, NULL)
declare_instruction(ntoi, "Gi", 0, "exact", '1', AUTOGL)
//declare_instrshadow(ntoi, "M0", 0, NULL, 0, NULL)
declare_instruction(ntoj, "Gj", 0, "inexact", '1', AUTOGL)
//declare_instrshadow(ntoj, "M1", 0, NULL, 0, NULL)
declare_instruction(min, "Gn", 0, "min", 'x', AUTOGL)
//declare_instrshadow(min, "M2", 0, NULL, 0, NULL)
declare_instruction(max, "Gx", 0, "max", 'x', AUTOGL)
//declare_instrshadow(max, "M3", 0, NULL, 0, NULL)
declare_instruction(floor, "Gb", 0, "floor", '1', AUTOGL)
declare_instruction(ceil, "Gc", 0, "ceiling", '1', AUTOGL)
declare_instruction(trunc, "Gk", 0, "truncate", '1', AUTOGL)
declare_instruction(round, "Gd", 0, "round", '1', AUTOGL)
declare_instruction(listp, "L0", 0, "list?", '1', AUTOGL)
declare_instruction(list, "l", 1, "list", '#', "%!0_!]0")
declare_instruction(lmk, "L2\0f", 0, "make-list", 'b', AUTOGL)