Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume27/calc-2.9.0/part19

Text File | 1993-12-07 | 43.9 KB | 1,840 lines

Newsgroups: comp.sources.unix
From: [e-mail] (David I. Bell)
Subject: v27i146: calc-2.9.0 - arbitrary precision C-like programmable calculator, Part19/19
References: <[e-mail]>
Sender: [e-mail]
Approved: [e-mail]

Submitted-By: [e-mail] (David I. Bell)
Posting-Number: Volume 27, Issue 146
Archive-Name: calc-2.9.0/part19

#!/bin/sh
# this is part 19 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file calc2.9.0/lib/poly.cal continued
#
CurArch=19
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
     exit 1; fi
( read Scheck
  if test "$Scheck" != $CurArch
  then echo "Please unpack part $Scheck next!"
       exit 1;
  else exit 0; fi
) < s2_seq_.tmp || exit 1
echo "x - Continuing file calc2.9.0/lib/poly.cal"
sed 's/^X//' << 'SHAR_EOF' >> calc2.9.0/lib/poly.cal
X    if (n==0) {
X        pcoeff(a);
X        return;
X    }
X    if (n==1) {
X        if (a!=1) {
X            pcoeff(a);
X            if (ims) print"*":;
X        }
X        print varname:;
X        return;
X    }
X    if (a!=1) {
X        pcoeff(a);
X        if (ims) print"*":;
X    }
X    print varname:"^":n:;
X}
X
Xdefine plist(s) {
X    local i, n;
X    n = size(s);
X    print "( ":;
X    if (order == "up") {
X        for (i=0; i< n-1 ; i++)
X            print s[[i]]:",",:;
X        if (n) print s[[i]],")":;
X        else print "0 )":;
X    }
X    else {
X        if (n) print s[[n-1]]:;
X        for (i = n - 2; i >= 0; i--)
X            print ", ":s[[i]]:;
X        print " )":;
X    }
X}
X
Xdefine deg(a) = size(a.p) - 1;
X
Xdefine polydiv(a,b) {
X    local q, r, d, u, i, m, n, sa, sb, sq;
X    obj poly q, r;
X    sa=findlist(a); sb = findlist(b); sq = list();
X    m=size(sa)-1; n=size(sb)-1;
X    if (n<0) quit "Zero divisor";
X    if (m<n) return list(pzero, a);
X    d = sb[[n]];
X    while ( m >= n) { u = sa[[m]]/d;
X        for (i = 0; i< n; i++) sa[[m-n+i]] -= u*sb[[i]];
X        push(sq,u); remove(sa); m--;
X        while (m>=n && sa[[m]]==0) { m--; remove(sa); push(sq,0)}}
X    while (m>=0 && sa[[m]]==0) { m--; remove(sa);}
X    q.p = sq;  r.p = sa;
X    return list(q, r);}
X
Xdefine poly_mod(a,b)  {
X    local u;
X    u=polydiv(a,b);
X    return u[[1]];
X}
X
Xdefine poly_quo(a,b) {
X    local p;
X    p = polydiv(a,b);
X    return p[[0]];
X}
X
Xdefine ispmult(a,b) = iszero(a % b);
X
Xdefine poly_div(a,b) {
X    if (!ispmult(a,b)) quit "Result not a polynomial";
X    return poly_quo(a,b);
X}
X
Xdefine pgcd(a,b) {
X    local r;
X    if (iszero(a) && iszero(b)) return pzero;
X    while (!iszero(b)) {
X        r = a % b;
X        a = b;
X        b = r;
X    }
X    return monic(a);
X}
X
Xdefine plcm(a,b) = monic( a * b // pgcd(a,b));
X
Xdefine pfgcd(a,b) {
X    local u, v, u1, v1, s, q, r, d, w;
X    u = v1 = pol(1); v = u1 = pol(0);
X    while (size(b.p) > 0) {s = polydiv(a,b);
X        q = s[[0]];
X        a = b; b = s[[1]]; u -= q*u1; v -= -q*v1;
X        swap(u,u1); swap(v,v1);}
X    d=size(a.p)-1; if (d>=0 && (w= 1/a.p[[d]]) !=1)
X         { a *= w; u *= w; v *= w;}
X    return list(a,u,v);
X}
X
Xdefine monic(a) {
X    local s, c, i, d, y;
X    if (iszero(a)) return pzero;
X    obj poly y;
X    s = findlist(a);
X    d = size(s)-1;
X    for (i=0; i<=d; i++) s[[i]] /= s[[d]];
X    y.p = s;
X    return y;
X}
X
Xdefine coefficient(a,n) = (n < size(a.p)) ? a.p[[n]] : 0;
X
Xdefine D(a, n) {
X    local i,j,v;
X    if (isnull(n)) n = 1;
X    if (!isint(n) || n < 1) quit "Bad order for derivative";
X     if (ismat(a)) {
X        v = a;
X        for (i = matmin(a,1); i <= matmax(a,1); i++)
X            for (j = matmin(a,2); j <= matmax(a,2); j++)
X                v[i,j] = D(a[i,j], n);
X        return v;
X    }
X    if (!ispoly(a)) return 0;
X    return Dp(a,n);
X}
X
Xdefine Dp(a,n) {
X    local i, v;
X    if (n > 1) return Dp(Dp(a, n-1), 1);
X     obj poly v;
X    v.p=list();
X    for (i=1; i<size(a.p); i++) append (v.p, i*a.p[[i]]);
X    return v;
X}
X
X
Xdefine cgcd(a,b) {
X    if (isreal(a) && isreal(b)) return gcd(a,b);
X    while (a) {
X        b -= bround(b/a) * a;
X        swap(a,b);
X    }
X    if (re(b) < 0) b = -b;
X    if (im(b) > re(b)) b *= -1i;
X    else if (im(b) <= -re(b)) b *= 1i;
X    return b;
X}
X
Xdefine gcdcoeffs(a) {
X    local s,i,g, c;
X    s = a.p;
X    g=0;
X    for (i=0; i < size(s) && g != 1; i++)
X        if (c = s[[i]]) g = cgcd(g, c);
X    return g;
X}
X
Xdefine interp(X, Y, t) = evalfd(makediffs(X,Y), t);
X
Xdefine makediffs(X,Y) {
X    local U, D, d, x, y, i, j, k, m, n, s;
X    U = D = list();
X    n = size(X);
X    if (size(Y) != n) quit"Arguments to be lists of same size";
X    for (i = n-1; i >= 0; i--) {
X        x = X[[i]];
X        y = Y[[i]];
X        m = size(U);
X        if (isnum(y)) {
X            d = y;
X            for (j = 0; j < m; j++) {
X                d = D[[j]] = (D[[j]]-d)/(U[[j]] - x);
X            }
X            push(U, x);
X            push(D, y);
X        }
X        else {
X            s = size(y);
X            for (k = 0; k < s ; k++) {
X                d = y[[k]];
X                for (j = 0; j < m; j++) {
X                    d = D[[j]] = (D[[j]] - d)/(U[[j]] - x);
X                }
X            }
X            for (j=s-1; j >=0; j--) {
X                push(U,x);
X                push(D, y[[j]]);
X            }
X        }
X    }
X    return list(U, D);
X}
X
Xdefine evalfd(T, t) {
X    local U, D, n, i, v;
X    if (isnull(t)) t = pol(0,1);
X    U = T[[0]];
X    D = T[[1]];
X    n = size(U);
X    v = D[[n-1]];
X    for (i = n-2; i >= 0; i--)
X        v = v * (t - U[[i]]) + D[[i]];
X    return v;
X}
X
X
Xdefine mdet(A) {
X    local n, i, j, k, I, J;
X    n = matmax(A,1) - (i = matmin(A,1));
X    if (matmax(A,2) - (j = matmin(A,2)) != n)
X        quit "Non-square matrix for mdet";
X    I = J = list();
X    k = n + 1;
X    while (k--) {
X        append(I,i++);
X        append(J,j++);
X    }
X    return M(A, n+1, I, J);
X}
X
Xdefine M(A, n, I, J) {
X    local v, J0, i, j, j1;
X    if (n == 1) return A[ I[[0]], J[[0]] ];
X    v = 0;
X    i = remove(I);
X    for (j = 0; j < n; j++) {
X        J0 = J;
X        j1 = delete(J0, j);
X        v += (-1)^(n-1+j) * A[i, j1] * M(A, n-1, I, J0);
X    }
X    return v;
X}
X
Xdefine mprint(A) {
X    local i,j;
X    if (!ismat(A)) quit "Argument to be a matrix";
X    for (i = matmin(A,1); i <= matmax(A,1); i++) {
X        for (j = matmin(A,2); j <= matmax(A,2); j++)
X            printf("%8.4d ", A[i,j]);
X        printf("\n");
X    }
X}
X
Xobj poly a;
Xobj poly b;
Xobj poly c;
X
Xdefine a(t) = ev(a,t);
Xdefine b(t) = ev(b,t);
Xdefine c(t) = ev(c,t);
X
Xa=pol(1,4,4,2,3,1);
Xb=pol(5,16,8,1);
Xc=pol(1+2i,3+4i,5+6i);
X
Xglobal lib_debug;
Xif (lib_debug >= 0) {
X    print "obj poly {p} defined";
X    print "pol() defined";
X    print "poly_print(a) defined";
X    print "poly_add(a, b) defined";
X    print "poly_sub(a, b) defined";
X    print "poly_mul(a, b) defined";
X    print "poly_div(a, b) defined";
X    print "poly_quo(a,b) defined";
X    print "poly_mod(a,b) defined";
X    print "poly_neg(a) defined";
X    print "poly_conj(a) defined";
X    print "poly_cmp(a,b) defined";
X    print "iszero(a) defined";
X    print "plist(a) defined";
X    print "listmul(a,b) defined";
X    print "ev(a,t) defined";
X    print "evp(s,t) defined";
X    print "ispoly(a) defined";
X    print "isstring(a) defined";
X    print "var(name) defined";
X    print "pcoeff(a) defined";
X    print "pterm(a,n) defined";
X    print "deg(a) defined";
X    print "polydiv(a,b) defined";
X    print "D(a,n) defined";
X    print "Dp(a,n) defined";
X    print "pgcd(a,b) defined";
X    print "plcm(a,b) defined";
X    print "monic(a) defined";
X    print "pfgcd(a,b) defined";
X    print "interp(X,Y,x) defined";
X    print "makediffs(X,Y) defined";
X    print "evalfd(T,x) defined";
X    print "mdet(A) defined";
X    print "M(A,n,I,J) defined";
X    print "mprint(A) defined";
X}
SHAR_EOF
echo "File calc2.9.0/lib/poly.cal is complete"
chmod 0644 calc2.9.0/lib/poly.cal || echo "restore of calc2.9.0/lib/poly.cal fails"
set `wc -c calc2.9.0/lib/poly.cal`;Sum=$1
if test "$Sum" != "18070"
then echo original size 18070, current size $Sum;fi
echo "x - extracting calc2.9.0/lib/psqrt.cal (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/psqrt.cal &&
X/*
X * Copyright (c) 1993 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X *
X * Calculate square roots modulo a prime.
X *
X * Returns null if number is not prime or if there is no square root.
X * The smaller square root is always returned.
X */
X
Xdefine psqrt(u, p)
X{
X    local    p1, q, n, y, r, v, w, t, k;
X
X    p1 = p - 1;
X    r = lowbit(p1);
X    q = p >> r;
X    t = 1 << (r - 1);
X    for (n = 2; ; n++) {
X        if (ptest(n, 1) == 0)
X            continue;
X        y = pmod(n, q, p);
X        k = pmod(y, t, p);
X        if (k == 1)
X            continue;
X        if (k != p1)
X            return;
X        break;
X    }
X    t = pmod(u, (q - 1) / 2, p);
X    v = (t * u) % p;
X    w = (t^2 * u) % p;
X    while (w != 1) {
X        k = 0;
X        t = w;
X        do {
X            k++;
X            t = t^2 % p;
X        } while (t != 1);
X        if (k == r)
X            return;
X        t = pmod(y, 1 << (r - k - 1), p);
X        y = t^2 % p;
X        v = (v * t) % p;
X        w = (w * y) % p;
X        r = k;
X    }
X    return min(v, p - v);
X}
X
X
Xglobal lib_debug;
Xif (lib_debug >= 0) {
X    print "psqrt(u, p) defined";
X}
SHAR_EOF
chmod 0644 calc2.9.0/lib/psqrt.cal || echo "restore of calc2.9.0/lib/psqrt.cal fails"
set `wc -c calc2.9.0/lib/psqrt.cal`;Sum=$1
if test "$Sum" != "1000"
then echo original size 1000, current size $Sum;fi
echo "x - extracting calc2.9.0/lib/quat.cal (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/quat.cal &&
X/*
X * Copyright (c) 1993 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X *
X * Routines to handle quaternions of the form:
X *    a + bi + cj + dk
X *
X * Note: In this module, quaternians are manipulated in the form:
X *    s + v
X * Where s is a scalar and v is a vector of size 3.
X */
X
Xobj quat {s, v};        /* definition of the quaternion object */
X
X
Xdefine quat(a,b,c,d)
X{
X    local obj quat    x;
X
X    x.s = isnull(a) ? 0 : a;
X    mat x.v[3];
X    x.v[0] = isnull(b) ? 0 : b;
X    x.v[1] = isnull(c) ? 0 : c;
X    x.v[2] = isnull(d) ? 0 : d;
X    return x;
X}
X
X
Xdefine quat_print(a)
X{
X    print "quat(" : a.s : ", " : a.v[0] : ", " : a.v[1] : ", " : a.v[2] : ")" :;
X}
X
X
Xdefine quat_norm(a)
X{
X    return a.s^2 + dp(a.v, a.v);
X}
X
X
Xdefine quat_abs(a, e)
X{
X    return sqrt(a.s^2 + dp(a.v, a.v), e);
X}
X
X
Xdefine quat_conj(a)
X{
X    local obj quat    x;
X
X    x.s = a.s;
X    x.v = -a.v;
X    return x;
X}
X
X
Xdefine quat_add(a, b)
X{
X    local obj quat    x;
X
X    if (!istype(b, x)) {
X        x.s = a.s + b;
X        x.v = a.v;
X        return x;
X    }
X    if (!istype(a, x)) {
X        x.s = a + b.s;
X        x.v = b.v;
X        return x;
X    }
X    x.s = a.s + b.s;
X    x.v = a.v + b.v;
X    if (x.v)
X        return x;
X    return x.s;
X}
X
X
Xdefine quat_sub(a, b)
X{
X    local obj quat    x;
X
X    if (!istype(b, x)) {
X        x.s = a.s - b;
X        x.v = a.v;
X        return x;
X    }
X    if (!istype(a, x)) {
X        x.s = a - b.s;
X        x.v = -b.v;
X        return x;
X    }
X    x.s = a.s - b.s;
X    x.v = a.v - b.v;
X    if (x.v)
X        return x;
X    return x.s;
X}
X
X
Xdefine quat_inc(a)
X{
X    local    x;
X
X    x = a;
X    x.s++;
X    return x;
X}
X
X
Xdefine quat_dec(a)
X{
X    local    x;
X
X    x = a;
X    x.s--;
X    return x;
X}
X
X
Xdefine quat_neg(a)
X{
X    local obj quat    x;
X
X    x.s = -a.s;
X    x.v = -a.v;
X    return x;
X}
X
X
Xdefine quat_mul(a, b)
X{
X    local obj quat    x;
X
X    if (!istype(b, x)) {
X        x.s = a.s * b;
X        x.v = a.v * b;
X    } else if (!istype(a, x)) {
X        x.s = b.s * a;
X        x.v = b.v * a;
X    } else {
X        x.s = a.s * b.s - dp(a.v, b.v);
X        x.v = a.s * b.v + b.s * a.v + cp(a.v, b.v);
X    }
X    if (x.v)
X        return x;
X    return x.s;
X}
X
X
Xdefine quat_div(a, b)
X{
X    local obj quat    x;
X
X    if (!istype(b, x)) {
X        x.s = a.s / b;
X        x.v = a.v / b;
X        return x;
X    }
X    return a * quat_inv(b);
X}
X
X
Xdefine quat_inv(a)
X{
X    local    x, q2;
X
X    obj quat x;
X    q2 = a.s^2 + dp(a.v, a.v);
X    x.s = a.s / q2;
X    x.v = a.v / (-q2);
X    return x;
X}
X
X
Xdefine quat_scale(a, b)
X{
X    local obj quat    x;
X
X    x.s = scale(a.s, b);
X    x.v = scale(a.v, b);
X    return x;
X}
X
X
Xdefine quat_shift(a, b)
X{
X    local obj quat    x;
X
X    x.s = a.s << b;
X    x.v = a.v << b;
X    if (x.v)
X        return x;
X    return x.s;
X}
X
Xglobal lib_debug;
Xif (lib_debug >= 0) {
X    print "obj quat {s, v} defined";
X    print "quat(a, b, c, d) defined";
X    print "quat_print(a) defined";
X    print "quat_norm(a) defined";
X    print "quat_abs(a, e) defined";
X    print "quat_conj(a) defined";
X    print "quat_add(a, e) defined";
X    print "quat_sub(a, e) defined";
X    print "quat_inc(a) defined";
X    print "quat_dec(a) defined";
X    print "quat_neg(a) defined";
X    print "quat_mul(a, b) defined";
X    print "quat_div(a, b) defined";
X    print "quat_inv(a) defined";
X    print "quat_scale(a, b) defined";
X    print "quat_shift(a, b) defined";
X}
SHAR_EOF
chmod 0644 calc2.9.0/lib/quat.cal || echo "restore of calc2.9.0/lib/quat.cal fails"
set `wc -c calc2.9.0/lib/quat.cal`;Sum=$1
if test "$Sum" != "3037"
then echo original size 3037, current size $Sum;fi
echo "x - extracting calc2.9.0/lib/regress.cal (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/regress.cal &&
X/*
X * Copyright (c) 1993 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X *
X * Test the correct execution of the calculator by reading this library file.
X * Errors are reported with '****' messages, or worse.  :-)
X *
X * NOTE: Unlike most calc lib files, this one performs its work when
X *       it is read.  Normally one would just define functions and
X *     values for later use.  In the case of the regression test,
X *     we do not want to do this.
X */
X
Xstatic err;
X
X
Xdefine verify(test, str)
X{
X    if (test != 1) {
X        print '**** Non-true result (' : test : '): ' : str;
X        ++err;
X        return;
X    }
X    print str;
X}
X
X
Xdefine error(str)
X{
X    print '****' , str;
X    ++err;
X}
X
X
Xdefine getglobalvar()
X{
X    global    globalvar;
X
X    return globalvar;
X}
X
X
X/*
X * Test boolean operations and IF tests.
X *
X * Some of these tests are done twice, once to print the message and
X * once to count any errors.  This means that some successful tests
X * will display a passing message twice.  Oh well, no biggie.
X */
Xdefine test_booleans()
X{
X    local    x;
X    local    y;
X    local    t1, t2, t3;
X
X    print '100: Beginning test_booleans';
X
X    if (0)
X        print '**** if (0)';
X    if (0)
X        err = err + 1;
X
X    if (1)
X        print '101: if (1)';
X
X    if (2)
X        print '102: if (2)';
X
X    if (1)
X        print '103: if (1) else';
X    else
X        print '**** if (1) else';
X    if (1)
X        print '104: if (1) else';
X    else
X        err = err + 1;
X
X    if (0)
X        print '**** if (0) else';
X    else
X        print '105: if (0) else';
X    if (0)
X        err = err + 1;
X    else
X        print '106: if (0) else';
X
X    if (1 == 1)
X        print '107: if 1 == 1';
X    else
X        print '**** if 1 == 1';
X    if (1 == 1)
X        print '108: if 1 == 1';
X    else
X        err = err + 1;
X
X    if (1 != 2)
X        print '109: if 1 != 2';
X    else
X        print '**** if 1 != 2';
X    if (1 != 2)
X        print '110: if 1 != 2';
X    else
X        err = err + 1;
X
X    verify(1,      '111: verify 1');
X    verify(2 == 2, '112: verify 2 == 2');
X    verify(2 != 3, '113: verify 2 != 3');
X    verify(2 <  3, '114: verify 2 <  3');
X    verify(2 <= 2, '115: verify 2 <= 2');
X    verify(2 <= 3, '116: verify 2 <= 3');
X    verify(3 >  2, '117: verify 3 >  2');
X    verify(2 >= 2, '118: verify 2 >= 2');
X    verify(3 >= 2, '119: verify 3 >= 2');
X    verify(!0,     '120: verify !0');
X    verify(!1 == 0,'121: verify !1 == 0');
X    print '122: Ending test_booleans';
X}
X
X
X/*
X * Test variables and simple assignments.
X */
Xdefine test_variables()
X{
X    local    x1, x2, x3;
X    global    g1, g2;
X    local    t;
X    global    globalvar;
X
X    print '200: Beginning test_variables';
X    x1 = 5;
X    x3 = 7 * 2;
X    x2 = 9 + 1;
X    globalvar = 22;
X    g1 = 19 - 3;
X    g2 = 79;
X    verify(x1 == 5,  '201: x1 == 5');
X    verify(x2 == 10, '202: x2 == 10');
X    verify(x3 == 14, '203: x3 == 14');
X    verify(g1 == 16, '204: g1 == 16');
X    verify(g2 == 79, '205: g2 == 79');
X    verify(globalvar == 22, '204: globalvar == 22');
X    verify(getglobalvar() == 22, '205: getglobalvar() == 22');
X    x1 = x2 + x3 + g1;
X    verify(x1 == 40, '206: x1 == 40');
X    g1 = x3 + g2;
X    verify(g1 == 93, '207: g1 == 207');
X    x1 = 5;
X    verify(x1++ == 5, '208: x1++ == 5');
X    verify(x1 == 6, '209: x1 == 6');
X    verify(++x1 == 7, '210: ++x1 == 7');
X    x1 += 3;
X    verify(x1 == 10, '211: x1 == 10');
X    x1 -= 6;
X    verify(x1 == 4, '212: x1 == 4');
X    x1 *= 3;
X    verify(x1 == 12, '213: x1 == 12');
X    x1 /= 4;
X    verify(x1 == 3, '214: x1 == 3');
X    x1 = x2 = x3;
X    verify(x2 == 14, '215: x2 == 14');
X    verify(x1 == 14, '216: x1 == 14');
X    print '217: Ending test_variables';
X}
X
X
X/*
X * Test logical AND and OR operators and short-circuit evaluation.
X */
Xdefine test_logicals()
X{
X    local    x;
X
X    print '300: Beginning test_logicals';
X
X    if (2 && 3) {
X        print '301: if (2 && 3)';
X    } else {
X        print '**** if (2 && 3)';
X        ++err;
X    }
X
X    if (2 && 0) {
X        print '**** if (2 && 0)';
X        ++err;
X    } else {
X        print '302: if (2 && 0)';
X    }
X
X    if (0 && 2) {
X        print '**** if (0 && 2)';
X        ++err;
X    } else {
X        print '303: if (0 && 2)';
X    }
X
X    if (0 && 0) {
X        print '**** if (0 && 0)';
X        ++err;
X    } else {
X        print '304: if (0 && 0)';
X    }
X
X    if (2 || 0) {
X        print '305: if (2 || 0)';
X    } else {
X        print '**** if (2 || 0)';
X        ++err;
X    }
X
X    if (0 || 2) {
X        print '306: if (0 || 2)';
X    } else {
X        print '**** if (0 || 2)';
X        ++err;
X    }
X
X    if (0 || 0) {
X        print '**** if (0 || 0)';
X        ++err;
X    } else {
X        print '307: if (0 || 0)';
X    }
X
X    x = 2 || 3; verify(x == 2, '308: (2 || 3) == 2');
X    x = 2 || 0; verify(x == 2, '309: (2 || 0) == 2');
X    x = 0 || 3; verify(x == 3, '310: (0 || 3) == 3');
X    x = 0 || 0; verify(x == 0, '311: (0 || 0) == 0');
X    x = 2 && 3; verify(x == 3, '312: (2 && 3) == 3');
X    x = 2 && 0; verify(x == 0, '313: (2 && 0) == 0');
X    x = 0 && 3; verify(x == 0, '314: (0 && 3) == 0');
X    x = 2 || error('2 || error()');
X    x = 0 && error('0 && error()');
X    print '315: Ending test_logicals';
X}
X
X
X/*
X * Test simple arithmetic operations and expressions.
X */
Xdefine test_arithmetic()
X{
X    print '400: Beginning test_arithmetic';
X    verify(3+4==7, '401: 3 + 4 == 7');
X    verify(4-1==3, '402: 4 - 1 == 3');
X    verify(2*3==6, '403: 2 * 3 == 6');
X    verify(8/4==2, '404: 8 / 4 == 2');
X    verify(2^3==8, '405: 2 ^ 3 == 8');
X    verify(9-4-2==3, '406: 9-4-2 == 3');
X    verify(9-4+2==7, '407: 9-4+2 == 6');
X    verify(-5+2==-3,  '408: -5+2 == -3');
X    verify(2*3+1==7, '409: 2*3+1 == 7');
X    verify(1+2*3==7, '410: 1+2*3 == 7');
X    verify((1+2)*3==9, '411: (1+2)*3 == 9');
X    verify(2*(3+1)==8, '412: 2*(3+1) == 8');
X    verify(9-(2+3)==4, '413: 9-(2+3) == 4');
X    verify(9+(2-3)==8, '414: 9+(2-3) == 8');
X    verify((2+3)*(4+5)==45, '415: (2+3)*(4+5) == 45');
X    verify(10/(2+3)==2, '416: 10/(2+3) == 2');
X    verify(12/3+4==8, '417: 12/3+4 == 8');
X    verify(6+12/3==10, '418: 6+12/3 == 10');
X    verify(2+3==1+4, '419: 2+3 == 1+4');
X    verify(-(2+3)==-5, '420: -(2+3) == -5');
X    verify(7&18==2,    '421: 7&18 == 2');
X    verify(3|17==19,   '422: 3|17 == 19');
X    verify(2&3|1==3,   '423: 2&3|1 == 3');
X    verify(2&(3|1)==2, '424: 2&(3|1) == 2');
X    verify(3<<4==48,   '425: 3<<4 == 48');
X    verify(5>>1==2,    '426: 5>>1 == 2');
X    verify(3<<-1==1,   '427: 3<<-1 == 1');
X    verify(5>>-2==20,  '428: 5>>-2 == 20');
X    verify(1<<2<<3==65536, '429: 1<<2<<3 == 65536');
X    verify((1<<2)<<3==32, '430: (1<<2)<<3 == 32');
X    verify(2^3^2==512, '431: 2^3^2 == 512');
X    verify((2^3)^2==64,'432: (2^3)^2 == 64');
X    verify(4//3==1, '433: 4//3==1');
X    verify(4//-3==-1, '434: 4//-3==-1');
X    verify(0.75//-0.51==-1, '435: 0.75//-0.51==-1');
X    verify(0.75//-0.50==-1, '436: 0.75//-0.50==-1');
X    verify(0.75//-0.49==-1, '437: 0.75//-0.49==-1');
X    verify((3/4)//(-1/4)==-3, '438: (3/4)//(-1/4)==-3');
X    verify(7%3==1,     '439: 7%3==1');
X/* The following is pending a proposed change to allow neg mods
X    verify(7%-3==1,    '440: 7%-3==1');
X */
X    print '441: Ending test_arithmetic';
X}
X
X
X/*
X * Test string constants and comparisons
X */
Xdefine test_strings()
X{
X    local x, y, z;
X
X    print '500: Beginning test_strings';
X    x = 'string';
X    y = "string";
X    z = x;
X    verify(z == "string", '501: z == "string"');
X    verify(z != "foo", '502: z != "foo"');
X    verify(z != 3, '503: z != 3');
X    verify('' == "", '504: \'\' == ""');
X    verify("a" == "a", '505: "a" == "a"');
X    verify("c" != "d", '506: "c" != "d"');
X    verify("" != "a", '507: "" != "a"');
X    verify("rs" < "rt", '508: "rs" < "rt"');
X    verify("rs" < "ss", '509: "rs < "ss"');
X    verify("rs" <= "rs", '510: "rs" <= "rs"');
X    verify("rs" <= "tu", '511: "rs" <= "tu"');
X    verify("rs" > "cd", '512: "rs" > "cd"');
X    verify("rs" >= "rs", '513: "rs" >= "rs"');
X    verify("rs" >= "cd", '514: "rs" >= "cd"');
X    verify("abc" > "ab", '515: "abc" > "ab"');
X    print '516: Ending test_strings';
X}
X
X
X/*
X * Do multiplication and division on three numbers in various ways
X * and verify the results agree.
X */
Xdefine muldivcheck(a, b, c, str)
X{
X    local    abc, acb, bac, bca, cab, cba;
X
X    abc = (a * b) * c;
X    acb = (a * c) * b;
X    bac = (b * a) * c;
X    bca = (b * c) * a;
X    cab = (c * a) * b;
X    cba = (c * b) * a;
X
X    if (abc != acb) {print '**** abc != acb:', str; ++err;}
X    if (acb != bac) {print '**** acb != bac:', str; ++err;}
X    if (bac != bca) {print '**** bac != bca:', str; ++err;}
X    if (bca != cab) {print '**** bca != cab:', str; ++err;}
X    if (cab != cba) {print '**** cab != cba:', str; ++err;}
X    if (abc/a != b*c) {print '**** abc/a != bc:', str; ++err;}
X    if (abc/b != a*c) {print '**** abc/b != ac:', str; ++err;}
X    if (abc/c != a*b) {print '**** abc/c != ab:', str; ++err;}
X    print str;
X}
X
X
X/*
X * Use the identity for squaring the sum of two squares to check
X * multiplication and squaring.
X */
Xdefine squarecheck(a, b, str)
X{
X    local    a2, b2, tab, apb, apb2, t;
X
X    a2 = a^2;
X    b2 = b^2;
X    tab = a * b * 2;
X    apb = a + b;
X    apb2 = apb^2;
X    if (a2 != a*a) {print '**** a^2 != a*a:', str; ++err;}
X    if (b2 != b*b) {print '**** b^2 != b*b:', str; ++err;}
X    if (apb2 != apb*apb) {
X        print '**** (a+b)^2 != (a+b)*(a+b):', str;
X        ++err;
X    }
X    if (a2+tab+b2 != apb2) {
X        print '**** (a+b)^2 != a^2 + 2ab + b^2:', str;
X        ++err;
X    }
X    if (a2/a != a) {print '**** a^2/a != a:', str; ++err;}
X    if (b2/b != b) {print '**** b^2/b != b:', str; ++err;}
X    if (apb2/apb != apb) {print '**** (a+b)^2/(a+b) != a+b:', str; ++err;}
X    if (a2*b2 != (a*b)^2) {print '**** a^2*b^2 != (ab)^2:', str; ++err;}
X    print str;
X}
X
X
X/*
X * Use the raising of numbers to large powers to check multiplication
X * and exponentiation.
X */
Xdefine powercheck(a, p1, p2, str)
X{
X    local    a1, a2, a3;
X
X    a1 = (a^p1)^p2;
X    a2 = (a^p2)^p1;
X    a3 = a^(p1*p2);
X    if (a1 != a2) {print '**** (a^p1)^p2 != (a^p2)^p1:', str; ++err;}
X    if (a1 != a3) {print '**** (a^p1)^p2 != a^(p1*p2):', str; ++err;}
X    print str;
X}
X
X
X/*
X * Test fraction reductions.
X * Arguments MUST be relatively prime.
X */
Xdefine fraccheck(a, b, c, str)
X{
X    local    ab, bc, ca, aoc, boc, aob;
X
X    ab = a * b;
X    bc = b * c;
X    ca = c * a;
X    aoc = ab / bc;
X    if (num(aoc) != a) {print '**** num(aoc) != a:', str; ++err;}
X    if (den(aoc) != c) {print '**** den(aoc) != c:', str; ++err;}
X    boc = ab / ca;
X    if (num(boc) != b) {print '**** num(boc) != b:', str; ++err;}
X    if (den(boc) != c) {print '**** den(boc) != c:', str; ++err;}
X    aob = ca / bc;
X    if (num(aob) != a) {print '**** num(aob) != a:', str; ++err;}
X    if (den(aob) != b) {print '**** den(aob) != b:', str; ++err;}
X    if (aob*boc != aoc) {print '**** aob*boc != aoc;', str; ++err;}
X    print str;
X}
X
X
X/*
X * Test multiplication and squaring algorithms.
X */
Xdefine algcheck(a, b, str)
X{
X    local    ss, ms, t1, t2, t3, t4, t5, t6, t7;
X    local    a1, a2, a3, a4, a5, a6, a7;
X    local    oldmul2, oldsq2;
X
X    oldmul2 = config("mul2", 2);
X    oldsq2 = config("sq2", 2);
X    a1 = a * b;
X    a2 = a * a;
X    a3 = b * b;
X    a4 = a^2;
X    a5 = b^2;
X    a6 = a2^2;
X    a7 = pmod(3,a-1,a);
X    for (ms = 2; ms < 20; ms++) {
X        for (ss = 2; ss < 20; ss++) {
X            config("mul2", ms);
X            config("sq2", ss);
X            t1 = a * b;
X            t2 = a * a;
X            t3 = b * b;
X            t4 = a^2;
X            t5 = b^2;
X            t6 = t2^2;
X            if (((ms + ss) % 37) == 4)
X                t7 = pmod(3,a-1,a);
X            if (t1 != a1) {print '**** t1 != a1:', str; ++err;}
X            if (t2 != a2) {print '**** t2 != a2:', str; ++err;}
X            if (t3 != a3) {print '**** t3 != a3:', str; ++err;}
X            if (t4 != a4) {print '**** t4 != a4:', str; ++err;}
X            if (t5 != a5) {print '**** t5 != a5:', str; ++err;}
X            if (t6 != a6) {print '**** t6 != a6:', str; ++err;}
X            if (t7 != a7) {print '**** t7 != a7:', str; ++err;}
X        }
X    }
X    config("mul2", oldmul2);
X    config("sq2", oldsq2);
X    print str;
X}
X
X
X/*
X * Test big numbers using some identities.
X */
Xdefine test_bignums()
X{
X    local    a, b, c, d;
X
X    print '600: Beginning test_bignums';
X    a = 64357824568234938591;
X    b = 12764632632458756817;
X    c = 43578234973856347982;
X    muldivcheck(a, b, c, '601: muldivcheck 1');
X    a = 3^100;
X    b = 5^97;
X    c = 7^88;
X    muldivcheck(a, b, c, '602: muldivcheck 2');
X    a = 2^160 - 1;
X    b = 2^161 - 1;
X    c = 2^162 - 1;
X    muldivcheck(a, b, c, '603: muldivcheck 3');
X    a = 3^35 / 5^35;
X    b = 7^35 / 11^35;
X    c = 13^35 / 17^35;
X    muldivcheck(a, b, c, '604: muldivcheck 4');
X    a = (10^97-1) / 9;
X    b = (10^53-1) / 9;
X    c = (10^37-1) / 9;
X    muldivcheck(a, b, c, '605: muldivcheck 5');
X    a = 17^50;
X    b = 19^47;
X    squarecheck(a, b, '606: squarecheck 1');
X    a = 2^111-1;
X    b = 2^17;
X    squarecheck(a, b, '607: squarecheck 2');
X    a = 23^43 / 29^43;
X    b = 31^42 / 37^29;
X    squarecheck(a, b, '608: squarecheck 3');
X    a = 4657892345743659834657238947854639;
X    b = 43784356784365893467659347867689;
X    squarecheck(a, b, '609: squarecheck 4');
X    a = (10^80-1) / 9;
X    b = (10^50-1) / 9;
X    squarecheck(a, b, '610: squarecheck 5');
X    a = 101^99;
X    b = 2 * a;
X    squarecheck(a, b, '611: squarecheck 6');
X    a = (10^19-1) / 9;
X    verify(ptest(a, 20), '612: primetest R19');
X    a = (10^23-1) / 9;
X    verify(ptest(a, 20), '613: primetest R23');
X    a = 2^127 - 1;
X    verify(ptest(a, 1), '614: primetest M127');
X    a = 2^521 - 1;
X    verify(ptest(a, 1), '615: primetest M521');
X    powercheck(17, 127, 30, '616: powercheck 1');
X    powercheck(111, 899, 6, '617: powercheck 2');
X    powercheck(3, 87, 89, '618: powercheck 3');
X    fraccheck(3^200, 5^173, 7^138, '619: fraccheck 1');
X    fraccheck(11^100, 12^98, 13^121, '620: fraccheck 2');
X    fraccheck(101^270, 103^111, 105^200, '621: fraccheck 3');
X    a = 0xffff0000ffffffff00000000ffff0000000000000000ffff;
X    b = 0x555544440000000000000000000000000000000011112222333344440000;
X    c = 0x999911113333000011111111000022220000000000000000333300000000ffff;
X    d = 0x3333ffffffff0000000000000000ffffffffffffffff000000000000;
X    algcheck(a, a, '622: algcheck 1');
X    algcheck(a, b, '623: algcheck 2');
X    algcheck(a, c, '624: algcheck 3');
X    algcheck(a, d, '625: algcheck 4');
X    algcheck(b, b, '626: algcheck 5');
X    algcheck(b, c, '627: algcheck 6');
X    algcheck(b, d, '628: algcheck 7');
X    algcheck(c, c, '629: algcheck 8');
X    algcheck(c, d, '630: algcheck 9');
X    algcheck(d, d, '631: algcheck 10');
X/* The following are pending consideration of the 'nearest' arg to sqrt()
X    a = 2e150;
X    b = 0x3206aa0707c6c1d483b62c784c9371eb507e3ab9b2d511c4bd648e52a5277fe;
X    verify(sqrt(a,1) == b, '632: sqrt(a,1) == b');
X    verify(sqrt(4e1000,1) == 2e500, '633: sqrt(4e1000,1) == 2e500');
X */
X    print '634: Ending test_bignums';
X}
X
X
X/*
X * Test many of the built-in functions.
X */
Xdefine test_functions()
X{
X    print '700: Beginning test_functions';
X    verify(abs(3) == 3,    '701: abs(3) == 3');
X    verify(abs(-4) == 4,   '702: abs(-4) == 4');
X    verify(avg(7) == 7,    '703: avg(7) == 7');
X    verify(avg(3,5) == 4,  '704: avg(3,5) == 4');
X    verify(cmp(2,3) == -1, '705: cmp(2,3) == -1');
X    verify(cmp(6,6) == 0,  '706: cmp(6,6) == 0');
X    verify(cmp(7,4) == 1,  '707: cmp(7,4) == 1');
X    verify(comb(9,9) == 1, '708: comb(9,9) == 1');
X    verify(comb(5,2) == 10,'709: comb(5,2) == 10');
X    verify(conj(4) == 4,   '710: conj(4) == 4');
X    verify(conj(2-3i) == 2+3i, '711: conj(2-3i) == 2+3i');
X    verify(den(17) == 1,   '712: den(17) == 1');
X    verify(den(3/7) == 7,  '713: den(3/7) == 7');
X    verify(den(-2/3) == 3, '714: den(-2/3) == 3');
X    verify(digits(0) == 1, '715: digits(0) == 1');
X    verify(digits(9) == 1, '716: digits(9) == 1');
X    verify(digits(10) == 2,'717: digits(10) == 2');
X    verify(digits(-691) == 3, '718: digits(-691) == 3');
X    verify(eval('2+3') == 5, "719: eval('2+3') == 5");
X    verify(fcnt(11,3) == 0,'720: fcnt(11,3) == 0');
X    verify(fcnt(18,3) == 2,'721: fcnt(18,3) == 2');
X    verify(fib(0) == 0,    '722: fib(0) == 0');
X    verify(fib(1) == 1,    '723: fib(1) == 1');
X    verify(fib(9) == 34,   '724: fib(9) == 34');
X    verify(frem(12,5) == 12, '725: frem(12,5) == 12');
X    verify(frem(45,3) == 5, '726: frem(45,3) == 5');
X    verify(fact(0) == 1,   '727: fact(0) == 1');
X    verify(fact(1) == 1,   '728: fact(1) == 1');
X    verify(fact(5) == 120, '729: fact(5) == 120');
X    verify(frac(3) == 0,   '730: frac(3) == 0');
X    verify(frac(2/3) == 2/3, '731: frac(2/3) == 2/3');
X    verify(frac(17/3) == 2/3, '732: frac(17/3) == 2/3');
X    verify(gcd(0,3) == 3,  '733: gcd(0,3) == 3');
X    verify(gcd(1,12) == 1, '734: gcd(1,12) == 1');
X    verify(gcd(11,7) == 1, '735: gcd(11,7) == 1');
X    verify(gcd(20,65) == 5, '736: gcd(20,65) == 5');
X    verify(gcdrem(20,3) == 20, '737: gcdrem(20,3) == 20');
X    verify(gcdrem(100,6) == 25, '738: gcdrem(100,6) == 25');
X    verify(highbit(1) == 0, '739: highbit(1) == 0');
X    verify(highbit(15) == 3, '740: highbit(15) == 3');
X    verify(hypot(3,4) == 5, '741: hypot(3,4) == 5');
X    verify(ilog(90,3) == 4, '742: ilog(90,3) == 4');
X    verify(ilog10(123) == 2, '743: ilog10(123) == 2');
X    verify(ilog2(17) == 4, '744: ilog2(17) == 4');
X    verify(im(3) == 0,     '745: im(3) == 0');
X    verify(im(2+3i) == 3,  '746: im(2+3i) == 3');
X    verify(int(5) == 5,    '757: int(5) == 5');
X    verify(int(19/3) == 6, '758: int(19/3) == 6');
X    verify(inverse(3/2) == 2/3, '759: inverse(3/2) == 2/3');
X    verify(iroot(18,2) == 4, '760: iroot(18,2) == 4');
X    verify(iroot(100,3) == 4, '761: iroot(100,3) == 4');
X    verify(iseven(10) == 1, '762: iseven(10) == 1');
X    verify(iseven(13) == 0, '763: iseven(13) == 0');
X    verify(iseven('a') == 0, "764: iseven('a') == 0");
X    verify(isint(7) == 1,  '765: isint(7) == 1');
X    verify(isint(19/2) == 0, '766: isint(19/2) == 0');
X    verify(isint('a') == 0, "767: isint('a') == 0");
X    verify(islist(3) == 0, '768: islist(3) == 0');
X    verify(islist(list(2,3)) == 1, '769: islist(list(2,3)) == 1');
X    verify(ismat(3) == 0, '770: ismat(3) == 0');
X    verify(ismult(7,3) == 0, '771: ismult(7,3) == 0');
X    verify(ismult(15,5) == 1, '772: ismult(15,5) == 1');
X    verify(isnull(3) == 0, '773: isnull(3) == 0');
X    verify(isnull(null()) == 1, '774: isnull(null()) == 1');
X    verify(isnum(2/3) == 1, '775: isnum(2/3) == 1');
X    verify(isnum('xx') == 0, "776: isnum('xx') == 0");
X    verify(isobj(3) == 0, '777: isobj(3) == 0');
X    verify(isodd(7) == 1, '778: isodd(7) == 1');
X    verify(isodd(8) == 0, '779: isodd(8) == 0');
X    verify(isodd('x') == 0, "780: isodd('a') == 0");
X    verify(isqrt(27) == 5, '781: isqrt(27) == 5');
X    verify(isreal(3) == 1, '782: isreal(3) == 1');
X    verify(isreal('x') == 0, "783: isreal('x') == 0");
X    verify(isreal(2+3i) == 0, '784: isreal(2+3i) == 0');
X    verify(isstr(5) == 0,  '785: isstr(5) == 0');
X    verify(isstr('foo') == 1, "786: isstr('foo') == 1");
X    verify(isrel(10,14) == 0, '787: isrel(10,14) == 0');
X    verify(isrel(15,22) == 1, '788: isrel(15,22) == 1');
X    verify(issimple(6) == 1, '789: issimple(6) == 1');
X    verify(issimple(3-2i) == 1, '790: issimple(3-2i) == 1');
X    verify(issimple(list(5)) == 0, '791: issimple(list(5)) == 0');
X    verify(issq(26) == 0, '792: issq(26) == 0');
X    verify(issq(9/4) == 1, '793: issq(9/4) == 1');
X    verify(istype(9,4) == 1, '795: istype(9,4) == 1');
X    verify(istype(3,'xx') == 0, "796: istype(3,'xx') == 0");
X    verify(jacobi(5,11) == 1, '797: jacobi(2,7) == 1');
X    verify(jacobi(6,13) == -1, '798: jacobi(6,13) == 0');
X    verify(lcm(3,4,5,6) == 60, '799: lcm(3,4,5,6) == 60');
X    verify(lcmfact(8) == 840, '800: lcmfact(8) == 840');
X    verify(lfactor(21,5) == 3, '801: lfactor(21,5) == 3');
X    verify(lfactor(97,20) == 1, '802: lfactor(97,20) == 1');
X    verify(lowbit(12) == 2, '803: lowbit(12) == 2');
X    verify(lowbit(17) == 0, '804: lowbit(17) == 0');
X    verify(ltol(1) == 0, '805: ltol(1) == 0');
X    verify(max(3,-9,7,4) == 7, '806: max(3,-9,7,4) == 7');
X    verify(meq(13,33,10) == 1, '807: meq(13,33,10) == 1');
X    verify(meq(7,19,11) == 0, '808: meq(7,19,11) == 0');
X    verify(min(9,5,12) == 5, '809: min(9,5,12) == 5');
X    verify(minv(13,97) == 15, '810: minv(13,97) == 15');
X    verify(mne(16,37,10) == 1, '811: mne(16,37,10) == 1');
X    verify(mne(46,79,11) == 0, '812: mne(46,79,11) == 0');
X    verify(norm(4) == 16,   '813: norm(4) == 16');
X    verify(norm(2-3i) == 13, '814: norm(2-3i) == 13');
X    verify(num(7) == 7,     '815: num(7) == 7');
X    verify(num(11/4) == 11, '816: num(11/4) == 11');
X    verify(num(-9/5) == -9, '817: num(-9/5) == -9');
X    verify(char(ord('a')+2) == 'c', "818: char(ord('a')+2) == 'c'");
X    verify(perm(7,3) == 210, '819: perm(7,3) == 210');
X    verify(pfact(10) == 210, '820: pfact(10) == 210');
X    verify(places(3/7) == -1, '821: places(3/7) == -1');
X    verify(places(.347) == 3, '822: places(.347) == 3');
X    verify(places(17) == 0, '823: places(17) == 0');
X    verify(pmod(3,36,37) == 1, '824: pmod(3,36,37) == 1');
X    verify(poly(2,3,5,2) == 19, '825; poly(2,3,5,2) == 19');
X    verify(ptest(101,10) == 1, '826: ptest(101,10) == 1');
X    verify(ptest(221,30) == 0, '827: ptest(221,30) == 0');
X    verify(re(9) == 9,       '828: re(9) == 9');
X    verify(re(-7+3i) == -7,  '829: re(-7+3i) == -7');
X    verify(scale(3,4) == 48, '830: scale(3,4) == 48');
X    verify(sgn(-4) == -1,    '831: sgn(-4) == -1');
X    verify(sgn(0) == 0,      '832: sgn(0) == 0');
X    verify(sgn(3) == 1,      '833: sgn(3) == 1');
X    verify(size(7) == 1,     '834: size(7) == 1');
X    verify(sqrt(121) == 11,  '835: sqrt(121) == 11');
X    verify(ssq(2,3,4) == 29, '836: ssq(2,3,4) == 29');
X    verify(str(45) == '45',  "837; str(45) == '45'");
X    verify(strcat('a','bc','def')=='abcdef',"838; strcat('a','bc','def')=='abcdef'");
X    verify(strlen('') == 0,  "839: strlen('') == 0");
X    verify(strlen('abcd') == 4, "840: strlen('abcd') == 4");
X    verify(substr('abcd',2,1) == 'b', "841: substr('abcd',2,1) == 'b'");
X    verify(substr('abcd',3,4) == 'cd', "842: substr('abcd',3,4) == 'cd'");
X    verify(substr('abcd',1,3) == 'abc', "843: substr('abcd',1,3) == 'abc'");
X    verify(xor(17,17) == 0,  '844: xor(17,17) == 0');
X    verify(xor(12,5) == 9,   '845: xor(12,5) == 9');
X    verify(mmin(3,7) == 3, '846: mmin(3,7) == 3');
X    verify(mmin(4,7) == -3, '847: mmin(4,7) == -3');
X    verify(digit(123,2) == 1, '848: digit(123,2) == 1');
X    verify(ismult(3/4, 1/7) == 0, '849: ismult(3/4, 1/7) == 0');
X    verify(gcd(3/4, 1/7) == 1/28, '850: gcd(3/4,1/7) == 1/28');
X/* The following are pending consideration of the 'nearest' arg to sqrt()
X    verify(sqrt(122,1) == 11,  '851: sqrt(122,1) == 11');
X    verify(sqrt(110,1) == 10,  '852: sqrt(110,1) == 10');
X    verify(sqrt(110,0.1) == 10.5,  '853: sqrt(110,0.1) == 10.5');
X    verify(sqrt(115,0.1) == 10.75,  '854: sqrt(115,0.1) == 10.75');
X */
X    print '855: Ending test_functions';
X}
X
X
X/*
X * Report the number of errors found.
X */
Xdefine count_errors()
X{
X    if (err == 0) {
X        print "999: passed all tests  /\\../\\";
X    } else {
X        print "****", err, "error(s) found  \\/++\\/";
X    }
X}
X
X
Xprint '001: Beginning regression tests';
Xprint '002: Within each section, output should be numbered sequentially';
Xprint;
Xreturn test_booleans();
Xprint;
Xreturn test_variables();
Xprint;
Xreturn test_logicals();
Xprint;
Xreturn test_arithmetic();
Xprint;
Xreturn test_strings();
Xprint;
Xreturn test_bignums();
Xprint;
Xreturn test_functions();
Xprint;
Xreturn count_errors();
SHAR_EOF
chmod 0644 calc2.9.0/lib/regress.cal || echo "restore of calc2.9.0/lib/regress.cal fails"
set `wc -c calc2.9.0/lib/regress.cal`;Sum=$1
if test "$Sum" != "21846"
then echo original size 21846, current size $Sum;fi
echo "x - extracting calc2.9.0/lib/solve.cal (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/solve.cal &&
X/*
X * Copyright (c) 1993 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X *
X * Solve the equation f(x) = 0 to within the desired error value for x.
X * The function 'f' must be defined outside of this routine, and the low
X * and high values are guesses which must produce values with opposite signs.
X */
X
Xdefine solve(low, high, epsilon)
X{
X    local flow, fhigh, fmid, mid, places;
X
X    if (isnull(epsilon))
X        epsilon = epsilon();
X    if (epsilon <= 0)
X        quit "Non-positive epsilon value";
X    places = highbit(1 + int(1/epsilon)) + 1;
X    flow = f(low);
X    if (abs(flow) < epsilon)
X        return low;
X    fhigh = f(high);
X    if (abs(flow) < epsilon)
X        return high;
X    if (sgn(flow) == sgn(fhigh))
X        quit "Non-opposite signs";
X    while (1) {
X        mid = bround(high - fhigh * (high - low) / (fhigh - flow), places);
X        if ((mid == low) || (mid == high))
X            places++;
X        fmid = f(mid);
X        if (abs(fmid) < epsilon)
X            return mid;
X        if (sgn(fmid) == sgn(flow)) {
X            low = mid;
X            flow = fmid;
X        } else {
X            high = mid;
X            fhigh = fmid;
X        }
X    }
X}
X
Xglobal lib_debug;
Xif (lib_debug >= 0) {
X    print "solve(low, high, epsilon) defined";
X}
SHAR_EOF
chmod 0644 calc2.9.0/lib/solve.cal || echo "restore of calc2.9.0/lib/solve.cal fails"
set `wc -c calc2.9.0/lib/solve.cal`;Sum=$1
if test "$Sum" != "1182"
then echo original size 1182, current size $Sum;fi
echo "x - extracting calc2.9.0/lib/sumsq.cal (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/sumsq.cal &&
X/*
X * Copyright (c) 1993 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X *
X * Determine the unique two positive integers whose squares sum to the
X * specified prime.  This is always possible for all primes of the form
X * 4N+1, and always impossible for primes of the form 4N-1.
X */
X
Xdefine ss(p)
X{
X    local a, b, i, p4;
X
X    if (p == 2) {
X        print "1^2 + 1^2 = 2";
X        return;
X    }
X    if ((p % 4) != 1) {
X        print p, "is not of the form 4N+1";
X        return;
X    }
X    if (!ptest(p, min(p-2, 10))) {
X        print p, "is not a prime";
X        return;
X    }
X    p4 = (p - 1) / 4;
X    i = 2;
X    do {
X        a = pmod(i++, p4, p);
X    } while ((a^2 % p) == 1);
X    b = p;
X    while (b^2 > p) {
X        i = b % a;
X        b = a;
X        a = i;
X    }
X    print a : "^2 +" , b : "^2 =" , a^2 + b^2;
X}
X
Xglobal lib_debug;
Xif (lib_debug >= 0) {
X    print "ss(p) defined";
X}
SHAR_EOF
chmod 0644 calc2.9.0/lib/sumsq.cal || echo "restore of calc2.9.0/lib/sumsq.cal fails"
set `wc -c calc2.9.0/lib/sumsq.cal`;Sum=$1
if test "$Sum" != "869"
then echo original size 869, current size $Sum;fi
echo "x - extracting calc2.9.0/lib/surd.cal (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/surd.cal &&
X/*
X * Copyright (c) 1993 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X *
X * Calculate using quadratic surds of the form: a + b * sqrt(D).
X */
X
Xobj surd {a, b};        /* definition of the surd object */
X
Xglobal surd_type = -1;        /* type of surd (value of D) */
Xstatic obj surd surd__;        /* example surd for testing against */
X
X
Xdefine surd(a,b)
X{
X    local x;
X
X    obj surd x;
X    x.a = a;
X    x.b = b;
X    return x;
X}
X
X
Xdefine surd_print(a)
X{
X    print "surd(" : a.a : ", " : a.b : ")" :;
X}
X
X
Xdefine surd_conj(a)
X{
X    local    x;
X
X    obj surd x;
X    x.a = a.a;
X    x.b = -a.b;
X    return x;
X}
X
X
Xdefine surd_norm(a)
X{
X    return a.a^2 + abs(surd_type) * a.b^2;
X}
X
X
Xdefine surd_value(a, xepsilon)
X{
X    local    epsilon;
X
X    epsilon = xepsilon;
X    if (isnull(epsilon))
X        epsilon = epsilon();
X    return a.a + a.b * sqrt(surd_type, epsilon);
X}
X
Xdefine surd_add(a, b)
X{
X    local obj surd    x;
X
X    if (!istype(b, x)) {
X        x.a = a.a + b;
X        x.b = a.b;
X        return x;
X    }
X    if (!istype(a, x)) {
X        x.a = a + b.a;
X        x.b = b.b;
X        return x;
X    }
X    x.a = a.a + b.a;
X    x.b = a.b + b.b;
X    if (x.b)
X        return x;
X    return x.a;
X}
X
X
Xdefine surd_sub(a, b)
X{
X    local obj surd    x;
X
X    if (!istype(b, x)) {
X        x.a = a.a - b;
X        x.b = a.b;
X        return x;
X    }
X    if (!istype(a, x)) {
X        x.a = a - b.a;
X        x.b = -b.b;
X        return x;
X    }
X    x.a = a.a - b.a;
X    x.b = a.b - b.b;
X    if (x.b)
X        return x;
X    return x.a;
X}
X
X
Xdefine surd_inc(a)
X{
X    local    x;
X
X    x = a;
X    x.a++;
X    return x;
X}
X
X
Xdefine surd_dec(a)
X{
X    local    x;
X
X    x = a;
X    x.a--;
X    return x;
X}
X
X
Xdefine surd_neg(a)
X{
X    local obj surd    x;
X
X    x.a = -a.a;
X    x.b = -a.b;
X    return x;
X}
X
X
Xdefine surd_mul(a, b)
X{
X    local obj surd    x;
X
X    if (!istype(b, x)) {
X        x.a = a.a * b;
X        x.b = a.b * b;
X    } else if (!istype(a, x)) {
X        x.a = b.a * a;
X        x.b = b.b * a;
X    } else {
X        x.a = a.a * b.a + surd_type * a.b * b.b;
X        x.b = a.a * b.b + a.b * b.a;
X    }
X    if (x.b)
X        return x;
X    return x.a;
X}
X
X
Xdefine surd_square(a)
X{
X    local obj surd    x;
X
X    x.a = a.a^2 + a.b^2 * surd_type;
X    x.b = a.a * a.b * 2;
X    if (x.b)
X        return x;
X    return x.a;
X}
X
X
Xdefine surd_scale(a, b)
X{
X    local obj surd    x;
X
X    x.a = scale(a.a, b);
X    x.b = scale(a.b, b);
X    return x;
X}
X
X
Xdefine surd_shift(a, b)
X{
X    local obj surd    x;
X
X    x.a = a.a << b;
X    x.b = a.b << b;
X    if (x.b)
X        return x;
X    return x.a;
X}
X
X
Xdefine surd_div(a, b)
X{
X    local x, y;
X
X    if ((a == 0) && b)
X        return 0;
X    obj surd x;
X    if (!istype(b, x)) {
X        x.a = a.a / b;
X        x.b = a.b / b;
X        return x;
X    }
X    y = b;
X    y.b = -b.b;
X    return (a * y) / (b.a^2 - surd_type * b.b^2);
X}
X
X
Xdefine surd_inv(a)
X{
X    return 1 / a;
X}
X
X
Xdefine surd_sgn(a)
X{
X    if (surd_type < 0)
X        quit "Taking sign of complex surd";
X    if (a.a == 0)
X        return sgn(a.b);
X    if (a.b == 0)
X        return sgn(a.a);
X    if ((a.a > 0) && (a.b > 0))
X        return 1;
X    if ((a.a < 0) && (a.b < 0))
X        return -1;
X    return sgn(a.a^2 - a.b^2 * surd_type) * sgn(a.a);
X}
X
X
Xdefine surd_cmp(a, b)
X{
X    if (!istype(a, surd__))
X        return ((b.b != 0) || (a != b.a));
X    if (!istype(b, surd__))
X        return ((a.b != 0) || (b != a.a));
X    return ((a.a != b.a) || (a.b != b.b));
X}
X
X
Xdefine surd_rel(a, b)
X{
X    local x, y;
X
X    if (surd_type < 0)
X        quit "Relative comparison of complex surds";
X    if (!istype(a, surd__)) {
X        x = a - b.a;
X        y = -b.b;
X    } else if (!istype(b, surd__)) {
X        x = a.a - b;
X        y = a.b;
X    } else {
X        x = a.a - b.a;
X        y = a.b - b.b;
X    }
X    if (y == 0)
X        return sgn(x);
X    if (x == 0)
X        return sgn(y);
X    if ((x < 0) && (y < 0))
X        return -1;
X    if ((x > 0) && (y > 0))
X        return 1;
X    return sgn(x^2 - y^2 * surd_type) * sgn(x);
X}
X
Xglobal lib_debug;
Xif (lib_debug >= 0) {
X    print "obj surd {a, b} defined";
X    print "surd(a, b) defined";
X    print "surd_print(a) defined";
X    print "surd_conj(a) defined";
X    print "surd_norm(a) defined";
X    print "surd_value(a, xepsilon) defined";
X    print "surd_add(a, b) defined";
X    print "surd_sub(a, b) defined";
X    print "surd_inc(a) defined";
X    print "surd_dec(a) defined";
X    print "surd_neg(a) defined";
X    print "surd_mul(a, b) defined";
X    print "surd_square(a) defined";
X    print "surd_scale(a, b) defined";
X    print "surd_shift(a, b) defined";
X    print "surd_div(a, b) defined";
X    print "surd_inv(a) defined";
X    print "surd_sgn(a) defined";
X    print "surd_cmp(a, b) defined";
X    print "surd_rel(a, b) defined";
X    print "surd_type defined";
X    print "set surd_type as needed";
X}
SHAR_EOF
chmod 0644 calc2.9.0/lib/surd.cal || echo "restore of calc2.9.0/lib/surd.cal fails"
set `wc -c calc2.9.0/lib/surd.cal`;Sum=$1
if test "$Sum" != "4256"
then echo original size 4256, current size $Sum;fi
echo "x - extracting calc2.9.0/lib/unitfrac.cal (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/unitfrac.cal &&
X/*
X * Copyright (c) 1993 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X *
X * Represent a fraction as sum of distinct unit fractions.
X * The output is the unit fractions themselves, and in square brackets,
X * the number of digits in the numerator and denominator of the value left
X * to be found.  Numbers larger than 3.5 become very difficult to calculate.
X */
X
Xdefine unitfrac(x)
X{
X    local    d, di, n;
X
X    if (x <= 0)
X        quit "Non-positive argument";
X    d = 2;
X    do {
X        n = int(1 / x) + 1;
X        if (n > d)
X            d = n;
X        di = 1/d;
X        print '  [': digits(num(x)): '/': digits(den(x)): ']',, di;
X        x -= di;
X        d++;
X    } while ((num(x) > 1) || (x == di) || (x == 1));
X    print '  [1/1]',, x;
X}
X
X
Xglobal lib_debug;
Xif (lib_debug >= 0) {
X    print "unitfrac(x) defined";
X}
SHAR_EOF
chmod 0644 calc2.9.0/lib/unitfrac.cal || echo "restore of calc2.9.0/lib/unitfrac.cal fails"
set `wc -c calc2.9.0/lib/unitfrac.cal`;Sum=$1
if test "$Sum" != "839"
then echo original size 839, current size $Sum;fi
echo "x - extracting calc2.9.0/lib/varargs.cal (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/varargs.cal &&
X/*
X * Copyright (c) 1993 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X *
X * Example program to use 'varargs'.
X *
X * Program to sum the cubes of all the specified numbers.
X */
X
Xdefine sc()
X{
X    local s, i;
X
X    s = 0;
X    for (i = 1; i <= param(0); i++) {
X        if (!isnum(param(i))) {
X            print "parameter",i,"is not a number";
X            continue;
X        }
X        s += param(i)^3;
X    }
X    return s;
X}
X
Xglobal lib_debug;
Xif (lib_debug >= 0) {
X    print "sc(a, b, ...) defined";
X}
SHAR_EOF
chmod 0644 calc2.9.0/lib/varargs.cal || echo "restore of calc2.9.0/lib/varargs.cal fails"
set `wc -c calc2.9.0/lib/varargs.cal`;Sum=$1
if test "$Sum" != "537"
then echo original size 537, current size $Sum;fi
rm -f s2_seq_.tmp
echo "You have unpacked the last part"
exit 0