home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume27 / calc-2.9.0 / part19 < prev    next >
Text File  |  1993-12-07  |  45KB  |  1,840 lines
  1. Newsgroups: comp.sources.unix
  2. From: dbell@canb.auug.org.au (David I. Bell)
  3. Subject: v27i146: calc-2.9.0 - arbitrary precision C-like programmable calculator, Part19/19
  4. References: <1.755316719.21314@gw.home.vix.com>
  5. Sender: unix-sources-moderator@gw.home.vix.com
  6. Approved: vixie@gw.home.vix.com
  7.  
  8. Submitted-By: dbell@canb.auug.org.au (David I. Bell)
  9. Posting-Number: Volume 27, Issue 146
  10. Archive-Name: calc-2.9.0/part19
  11.  
  12. #!/bin/sh
  13. # this is part 19 of a multipart archive
  14. # do not concatenate these parts, unpack them in order with /bin/sh
  15. # file calc2.9.0/lib/poly.cal continued
  16. #
  17. CurArch=19
  18. if test ! -r s2_seq_.tmp
  19. then echo "Please unpack part 1 first!"
  20.      exit 1; fi
  21. ( read Scheck
  22.   if test "$Scheck" != $CurArch
  23.   then echo "Please unpack part $Scheck next!"
  24.        exit 1;
  25.   else exit 0; fi
  26. ) < s2_seq_.tmp || exit 1
  27. echo "x - Continuing file calc2.9.0/lib/poly.cal"
  28. sed 's/^X//' << 'SHAR_EOF' >> calc2.9.0/lib/poly.cal
  29. X    if (n==0) {
  30. X        pcoeff(a);
  31. X        return;
  32. X    }
  33. X    if (n==1) {
  34. X        if (a!=1) {
  35. X            pcoeff(a);
  36. X            if (ims) print"*":;
  37. X        }
  38. X        print varname:;
  39. X        return;
  40. X    }
  41. X    if (a!=1) {
  42. X        pcoeff(a);
  43. X        if (ims) print"*":;
  44. X    }
  45. X    print varname:"^":n:;
  46. X} 
  47. X
  48. Xdefine plist(s) {
  49. X    local i, n;
  50. X    n = size(s);
  51. X    print "( ":;
  52. X    if (order == "up") {
  53. X        for (i=0; i< n-1 ; i++)
  54. X            print s[[i]]:",",:;
  55. X        if (n) print s[[i]],")":;
  56. X        else print "0 )":;
  57. X    }
  58. X    else {
  59. X        if (n) print s[[n-1]]:;
  60. X        for (i = n - 2; i >= 0; i--)
  61. X            print ", ":s[[i]]:;
  62. X        print " )":;
  63. X    }
  64. X}
  65. X
  66. Xdefine deg(a) = size(a.p) - 1;
  67. X
  68. Xdefine polydiv(a,b) {
  69. X    local q, r, d, u, i, m, n, sa, sb, sq;
  70. X    obj poly q, r;
  71. X    sa=findlist(a); sb = findlist(b); sq = list();
  72. X    m=size(sa)-1; n=size(sb)-1;
  73. X    if (n<0) quit "Zero divisor";
  74. X    if (m<n) return list(pzero, a);
  75. X    d = sb[[n]]; 
  76. X    while ( m >= n) { u = sa[[m]]/d;
  77. X        for (i = 0; i< n; i++) sa[[m-n+i]] -= u*sb[[i]];
  78. X        push(sq,u); remove(sa); m--;
  79. X        while (m>=n && sa[[m]]==0) { m--; remove(sa); push(sq,0)}}
  80. X    while (m>=0 && sa[[m]]==0) { m--; remove(sa);}
  81. X    q.p = sq;  r.p = sa;
  82. X    return list(q, r);}
  83. X        
  84. Xdefine poly_mod(a,b)  {
  85. X    local u;
  86. X    u=polydiv(a,b);
  87. X    return u[[1]];
  88. X}
  89. X
  90. Xdefine poly_quo(a,b) {
  91. X    local p;
  92. X    p = polydiv(a,b);
  93. X    return p[[0]];
  94. X}
  95. X
  96. Xdefine ispmult(a,b) = iszero(a % b);
  97. X
  98. Xdefine poly_div(a,b) {
  99. X    if (!ispmult(a,b)) quit "Result not a polynomial";
  100. X    return poly_quo(a,b);
  101. X}
  102. X
  103. Xdefine pgcd(a,b) {
  104. X    local r;
  105. X    if (iszero(a) && iszero(b)) return pzero;
  106. X    while (!iszero(b)) {
  107. X        r = a % b;
  108. X        a = b;
  109. X        b = r;
  110. X    }
  111. X    return monic(a);
  112. X}
  113. X
  114. Xdefine plcm(a,b) = monic( a * b // pgcd(a,b));
  115. X  
  116. Xdefine pfgcd(a,b) {
  117. X    local u, v, u1, v1, s, q, r, d, w;
  118. X    u = v1 = pol(1); v = u1 = pol(0);
  119. X    while (size(b.p) > 0) {s = polydiv(a,b);
  120. X        q = s[[0]];
  121. X        a = b; b = s[[1]]; u -= q*u1; v -= -q*v1;
  122. X        swap(u,u1); swap(v,v1);}
  123. X    d=size(a.p)-1; if (d>=0 && (w= 1/a.p[[d]]) !=1)
  124. X         { a *= w; u *= w; v *= w;}
  125. X    return list(a,u,v);
  126. X}
  127. X  
  128. Xdefine monic(a) {
  129. X    local s, c, i, d, y;
  130. X    if (iszero(a)) return pzero;
  131. X    obj poly y;
  132. X    s = findlist(a);
  133. X    d = size(s)-1;
  134. X    for (i=0; i<=d; i++) s[[i]] /= s[[d]];
  135. X    y.p = s;
  136. X    return y;
  137. X}
  138. X
  139. Xdefine coefficient(a,n) = (n < size(a.p)) ? a.p[[n]] : 0;
  140. X
  141. Xdefine D(a, n) {
  142. X    local i,j,v;
  143. X    if (isnull(n)) n = 1;
  144. X    if (!isint(n) || n < 1) quit "Bad order for derivative";
  145. X     if (ismat(a)) {
  146. X        v = a;
  147. X        for (i = matmin(a,1); i <= matmax(a,1); i++)
  148. X            for (j = matmin(a,2); j <= matmax(a,2); j++)
  149. X                v[i,j] = D(a[i,j], n);
  150. X        return v;
  151. X    }
  152. X    if (!ispoly(a)) return 0;
  153. X    return Dp(a,n);
  154. X}
  155. X
  156. Xdefine Dp(a,n) {
  157. X    local i, v;
  158. X    if (n > 1) return Dp(Dp(a, n-1), 1);
  159. X     obj poly v;
  160. X    v.p=list();    
  161. X    for (i=1; i<size(a.p); i++) append (v.p, i*a.p[[i]]);
  162. X    return v;
  163. X}
  164. X
  165. X
  166. Xdefine cgcd(a,b) {
  167. X    if (isreal(a) && isreal(b)) return gcd(a,b);
  168. X    while (a) {
  169. X        b -= bround(b/a) * a;
  170. X        swap(a,b);
  171. X    }
  172. X    if (re(b) < 0) b = -b; 
  173. X    if (im(b) > re(b)) b *= -1i;
  174. X    else if (im(b) <= -re(b)) b *= 1i;
  175. X    return b;
  176. X}
  177. X
  178. Xdefine gcdcoeffs(a) {
  179. X    local s,i,g, c;
  180. X    s = a.p;
  181. X    g=0;
  182. X    for (i=0; i < size(s) && g != 1; i++)
  183. X        if (c = s[[i]]) g = cgcd(g, c);
  184. X    return g;
  185. X}
  186. X
  187. Xdefine interp(X, Y, t) = evalfd(makediffs(X,Y), t);
  188. X
  189. Xdefine makediffs(X,Y) {
  190. X    local U, D, d, x, y, i, j, k, m, n, s;
  191. X    U = D = list();
  192. X    n = size(X);
  193. X    if (size(Y) != n) quit"Arguments to be lists of same size";
  194. X    for (i = n-1; i >= 0; i--) {
  195. X        x = X[[i]];
  196. X        y = Y[[i]];
  197. X        m = size(U);
  198. X        if (isnum(y)) {
  199. X            d = y;
  200. X            for (j = 0; j < m; j++) {
  201. X                d = D[[j]] = (D[[j]]-d)/(U[[j]] - x);
  202. X            }
  203. X            push(U, x);
  204. X            push(D, y);
  205. X        }
  206. X        else {
  207. X            s = size(y);
  208. X            for (k = 0; k < s ; k++) {
  209. X                d = y[[k]];
  210. X                for (j = 0; j < m; j++) {
  211. X                    d = D[[j]] = (D[[j]] - d)/(U[[j]] - x);
  212. X                }
  213. X            }
  214. X            for (j=s-1; j >=0; j--) {
  215. X                push(U,x);
  216. X                push(D, y[[j]]);
  217. X            }
  218. X        }
  219. X    }
  220. X    return list(U, D);
  221. X}
  222. X    
  223. Xdefine evalfd(T, t) {
  224. X    local U, D, n, i, v;
  225. X    if (isnull(t)) t = pol(0,1);
  226. X    U = T[[0]];
  227. X    D = T[[1]];
  228. X    n = size(U);
  229. X    v = D[[n-1]];
  230. X    for (i = n-2; i >= 0; i--) 
  231. X        v = v * (t - U[[i]]) + D[[i]];
  232. X    return v;
  233. X}
  234. X
  235. X
  236. Xdefine mdet(A) {
  237. X    local n, i, j, k, I, J;
  238. X    n = matmax(A,1) - (i = matmin(A,1));
  239. X    if (matmax(A,2) - (j = matmin(A,2)) != n)
  240. X        quit "Non-square matrix for mdet";
  241. X    I = J = list();
  242. X    k = n + 1;
  243. X    while (k--) {
  244. X        append(I,i++);
  245. X        append(J,j++);
  246. X    }
  247. X    return M(A, n+1, I, J);
  248. X}
  249. X
  250. Xdefine M(A, n, I, J) {
  251. X    local v, J0, i, j, j1;
  252. X    if (n == 1) return A[ I[[0]], J[[0]] ];
  253. X    v = 0;
  254. X    i = remove(I);
  255. X    for (j = 0; j < n; j++) {
  256. X        J0 = J;
  257. X        j1 = delete(J0, j);
  258. X        v += (-1)^(n-1+j) * A[i, j1] * M(A, n-1, I, J0);
  259. X    }
  260. X    return v;
  261. X}
  262. X
  263. Xdefine mprint(A) {
  264. X    local i,j;
  265. X    if (!ismat(A)) quit "Argument to be a matrix";
  266. X    for (i = matmin(A,1); i <= matmax(A,1); i++) {
  267. X        for (j = matmin(A,2); j <= matmax(A,2); j++)
  268. X            printf("%8.4d ", A[i,j]);
  269. X        printf("\n");
  270. X    }
  271. X}
  272. X    
  273. Xobj poly a;
  274. Xobj poly b;
  275. Xobj poly c;
  276. X
  277. Xdefine a(t) = ev(a,t);
  278. Xdefine b(t) = ev(b,t);
  279. Xdefine c(t) = ev(c,t);
  280. X
  281. Xa=pol(1,4,4,2,3,1);
  282. Xb=pol(5,16,8,1);
  283. Xc=pol(1+2i,3+4i,5+6i);
  284. X
  285. Xglobal lib_debug;
  286. Xif (lib_debug >= 0) {
  287. X    print "obj poly {p} defined";
  288. X    print "pol() defined";
  289. X    print "poly_print(a) defined";
  290. X    print "poly_add(a, b) defined";
  291. X    print "poly_sub(a, b) defined";
  292. X    print "poly_mul(a, b) defined";
  293. X    print "poly_div(a, b) defined";
  294. X    print "poly_quo(a,b) defined";
  295. X    print "poly_mod(a,b) defined";
  296. X    print "poly_neg(a) defined";
  297. X    print "poly_conj(a) defined";
  298. X    print "poly_cmp(a,b) defined";
  299. X    print "iszero(a) defined";
  300. X    print "plist(a) defined";
  301. X    print "listmul(a,b) defined";
  302. X    print "ev(a,t) defined";
  303. X    print "evp(s,t) defined";
  304. X    print "ispoly(a) defined";
  305. X    print "isstring(a) defined";
  306. X    print "var(name) defined";
  307. X    print "pcoeff(a) defined";
  308. X    print "pterm(a,n) defined";
  309. X    print "deg(a) defined";
  310. X    print "polydiv(a,b) defined";
  311. X    print "D(a,n) defined";
  312. X    print "Dp(a,n) defined";
  313. X    print "pgcd(a,b) defined";
  314. X    print "plcm(a,b) defined";
  315. X    print "monic(a) defined";
  316. X    print "pfgcd(a,b) defined";
  317. X    print "interp(X,Y,x) defined";
  318. X    print "makediffs(X,Y) defined";
  319. X    print "evalfd(T,x) defined";
  320. X    print "mdet(A) defined";
  321. X    print "M(A,n,I,J) defined";
  322. X    print "mprint(A) defined";
  323. X}
  324. SHAR_EOF
  325. echo "File calc2.9.0/lib/poly.cal is complete"
  326. chmod 0644 calc2.9.0/lib/poly.cal || echo "restore of calc2.9.0/lib/poly.cal fails"
  327. set `wc -c calc2.9.0/lib/poly.cal`;Sum=$1
  328. if test "$Sum" != "18070"
  329. then echo original size 18070, current size $Sum;fi
  330. echo "x - extracting calc2.9.0/lib/psqrt.cal (Text)"
  331. sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/psqrt.cal &&
  332. X/*
  333. X * Copyright (c) 1993 David I. Bell
  334. X * Permission is granted to use, distribute, or modify this source,
  335. X * provided that this copyright notice remains intact.
  336. X *
  337. X * Calculate square roots modulo a prime.
  338. X *
  339. X * Returns null if number is not prime or if there is no square root.
  340. X * The smaller square root is always returned.
  341. X */
  342. X
  343. Xdefine psqrt(u, p)
  344. X{
  345. X    local    p1, q, n, y, r, v, w, t, k;
  346. X
  347. X    p1 = p - 1;
  348. X    r = lowbit(p1);
  349. X    q = p >> r;
  350. X    t = 1 << (r - 1);
  351. X    for (n = 2; ; n++) {
  352. X        if (ptest(n, 1) == 0)
  353. X            continue;
  354. X        y = pmod(n, q, p);
  355. X        k = pmod(y, t, p);
  356. X        if (k == 1)
  357. X            continue;
  358. X        if (k != p1)
  359. X            return;
  360. X        break;
  361. X    }
  362. X    t = pmod(u, (q - 1) / 2, p);
  363. X    v = (t * u) % p;
  364. X    w = (t^2 * u) % p;
  365. X    while (w != 1) {
  366. X        k = 0;
  367. X        t = w;
  368. X        do {
  369. X            k++;
  370. X            t = t^2 % p;
  371. X        } while (t != 1);
  372. X        if (k == r)
  373. X            return;
  374. X        t = pmod(y, 1 << (r - k - 1), p);
  375. X        y = t^2 % p;
  376. X        v = (v * t) % p;
  377. X        w = (w * y) % p;
  378. X        r = k;
  379. X    }
  380. X    return min(v, p - v);
  381. X}
  382. X
  383. X
  384. Xglobal lib_debug;
  385. Xif (lib_debug >= 0) {
  386. X    print "psqrt(u, p) defined";
  387. X}
  388. SHAR_EOF
  389. chmod 0644 calc2.9.0/lib/psqrt.cal || echo "restore of calc2.9.0/lib/psqrt.cal fails"
  390. set `wc -c calc2.9.0/lib/psqrt.cal`;Sum=$1
  391. if test "$Sum" != "1000"
  392. then echo original size 1000, current size $Sum;fi
  393. echo "x - extracting calc2.9.0/lib/quat.cal (Text)"
  394. sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/quat.cal &&
  395. X/*
  396. X * Copyright (c) 1993 David I. Bell
  397. X * Permission is granted to use, distribute, or modify this source,
  398. X * provided that this copyright notice remains intact.
  399. X *
  400. X * Routines to handle quaternions of the form:
  401. X *    a + bi + cj + dk
  402. X *
  403. X * Note: In this module, quaternians are manipulated in the form:
  404. X *    s + v
  405. X * Where s is a scalar and v is a vector of size 3.
  406. X */
  407. X
  408. Xobj quat {s, v};        /* definition of the quaternion object */
  409. X
  410. X
  411. Xdefine quat(a,b,c,d)
  412. X{
  413. X    local obj quat    x;
  414. X
  415. X    x.s = isnull(a) ? 0 : a;
  416. X    mat x.v[3];
  417. X    x.v[0] = isnull(b) ? 0 : b;
  418. X    x.v[1] = isnull(c) ? 0 : c;
  419. X    x.v[2] = isnull(d) ? 0 : d;
  420. X    return x;
  421. X}
  422. X
  423. X
  424. Xdefine quat_print(a)
  425. X{
  426. X    print "quat(" : a.s : ", " : a.v[0] : ", " : a.v[1] : ", " : a.v[2] : ")" :;
  427. X}
  428. X
  429. X
  430. Xdefine quat_norm(a)
  431. X{
  432. X    return a.s^2 + dp(a.v, a.v);
  433. X}
  434. X
  435. X
  436. Xdefine quat_abs(a, e)
  437. X{
  438. X    return sqrt(a.s^2 + dp(a.v, a.v), e);
  439. X}
  440. X
  441. X
  442. Xdefine quat_conj(a)
  443. X{
  444. X    local obj quat    x;
  445. X
  446. X    x.s = a.s;
  447. X    x.v = -a.v;
  448. X    return x;
  449. X}
  450. X
  451. X
  452. Xdefine quat_add(a, b)
  453. X{
  454. X    local obj quat    x;
  455. X
  456. X    if (!istype(b, x)) {
  457. X        x.s = a.s + b;
  458. X        x.v = a.v;
  459. X        return x;
  460. X    }
  461. X    if (!istype(a, x)) {
  462. X        x.s = a + b.s;
  463. X        x.v = b.v;
  464. X        return x;
  465. X    }
  466. X    x.s = a.s + b.s;
  467. X    x.v = a.v + b.v;
  468. X    if (x.v)
  469. X        return x;
  470. X    return x.s;
  471. X}
  472. X
  473. X
  474. Xdefine quat_sub(a, b)
  475. X{
  476. X    local obj quat    x;
  477. X
  478. X    if (!istype(b, x)) {
  479. X        x.s = a.s - b;
  480. X        x.v = a.v;
  481. X        return x;
  482. X    }
  483. X    if (!istype(a, x)) {
  484. X        x.s = a - b.s;
  485. X        x.v = -b.v;
  486. X        return x;
  487. X    }
  488. X    x.s = a.s - b.s;
  489. X    x.v = a.v - b.v;
  490. X    if (x.v)
  491. X        return x;
  492. X    return x.s;
  493. X}
  494. X
  495. X
  496. Xdefine quat_inc(a)
  497. X{
  498. X    local    x;
  499. X
  500. X    x = a;
  501. X    x.s++;
  502. X    return x;
  503. X}
  504. X
  505. X
  506. Xdefine quat_dec(a)
  507. X{
  508. X    local    x;
  509. X
  510. X    x = a;
  511. X    x.s--;
  512. X    return x;
  513. X}
  514. X
  515. X
  516. Xdefine quat_neg(a)
  517. X{
  518. X    local obj quat    x;
  519. X
  520. X    x.s = -a.s;
  521. X    x.v = -a.v;
  522. X    return x;
  523. X}
  524. X
  525. X
  526. Xdefine quat_mul(a, b)
  527. X{
  528. X    local obj quat    x;
  529. X
  530. X    if (!istype(b, x)) {
  531. X        x.s = a.s * b;
  532. X        x.v = a.v * b;
  533. X    } else if (!istype(a, x)) {
  534. X        x.s = b.s * a;
  535. X        x.v = b.v * a;
  536. X    } else {
  537. X        x.s = a.s * b.s - dp(a.v, b.v);
  538. X        x.v = a.s * b.v + b.s * a.v + cp(a.v, b.v);
  539. X    }
  540. X    if (x.v)
  541. X        return x;
  542. X    return x.s;
  543. X}
  544. X
  545. X
  546. Xdefine quat_div(a, b)
  547. X{
  548. X    local obj quat    x;
  549. X
  550. X    if (!istype(b, x)) {
  551. X        x.s = a.s / b;
  552. X        x.v = a.v / b;
  553. X        return x;
  554. X    }
  555. X    return a * quat_inv(b);
  556. X}
  557. X
  558. X
  559. Xdefine quat_inv(a)
  560. X{
  561. X    local    x, q2;
  562. X
  563. X    obj quat x;
  564. X    q2 = a.s^2 + dp(a.v, a.v);
  565. X    x.s = a.s / q2;
  566. X    x.v = a.v / (-q2);
  567. X    return x;
  568. X}
  569. X
  570. X
  571. Xdefine quat_scale(a, b)
  572. X{
  573. X    local obj quat    x;
  574. X
  575. X    x.s = scale(a.s, b);
  576. X    x.v = scale(a.v, b);
  577. X    return x;
  578. X}
  579. X
  580. X
  581. Xdefine quat_shift(a, b)
  582. X{
  583. X    local obj quat    x;
  584. X
  585. X    x.s = a.s << b;
  586. X    x.v = a.v << b;
  587. X    if (x.v)
  588. X        return x;
  589. X    return x.s;
  590. X}
  591. X
  592. Xglobal lib_debug;
  593. Xif (lib_debug >= 0) {
  594. X    print "obj quat {s, v} defined";
  595. X    print "quat(a, b, c, d) defined";
  596. X    print "quat_print(a) defined";
  597. X    print "quat_norm(a) defined";
  598. X    print "quat_abs(a, e) defined";
  599. X    print "quat_conj(a) defined";
  600. X    print "quat_add(a, e) defined";
  601. X    print "quat_sub(a, e) defined";
  602. X    print "quat_inc(a) defined";
  603. X    print "quat_dec(a) defined";
  604. X    print "quat_neg(a) defined";
  605. X    print "quat_mul(a, b) defined";
  606. X    print "quat_div(a, b) defined";
  607. X    print "quat_inv(a) defined";
  608. X    print "quat_scale(a, b) defined";
  609. X    print "quat_shift(a, b) defined";
  610. X}
  611. SHAR_EOF
  612. chmod 0644 calc2.9.0/lib/quat.cal || echo "restore of calc2.9.0/lib/quat.cal fails"
  613. set `wc -c calc2.9.0/lib/quat.cal`;Sum=$1
  614. if test "$Sum" != "3037"
  615. then echo original size 3037, current size $Sum;fi
  616. echo "x - extracting calc2.9.0/lib/regress.cal (Text)"
  617. sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/regress.cal &&
  618. X/*
  619. X * Copyright (c) 1993 David I. Bell
  620. X * Permission is granted to use, distribute, or modify this source,
  621. X * provided that this copyright notice remains intact.
  622. X *
  623. X * Test the correct execution of the calculator by reading this library file.
  624. X * Errors are reported with '****' messages, or worse.  :-)
  625. X *
  626. X * NOTE: Unlike most calc lib files, this one performs its work when
  627. X *       it is read.  Normally one would just define functions and
  628. X *     values for later use.  In the case of the regression test,
  629. X *     we do not want to do this.
  630. X */
  631. X
  632. Xstatic err;
  633. X
  634. X
  635. Xdefine verify(test, str)
  636. X{
  637. X    if (test != 1) {
  638. X        print '**** Non-true result (' : test : '): ' : str;
  639. X        ++err;
  640. X        return;
  641. X    }
  642. X    print str;
  643. X}
  644. X
  645. X
  646. Xdefine error(str)
  647. X{
  648. X    print '****' , str;
  649. X    ++err;
  650. X}
  651. X
  652. X
  653. Xdefine getglobalvar()
  654. X{
  655. X    global    globalvar;
  656. X
  657. X    return globalvar;
  658. X}
  659. X
  660. X
  661. X/*
  662. X * Test boolean operations and IF tests.
  663. X *
  664. X * Some of these tests are done twice, once to print the message and
  665. X * once to count any errors.  This means that some successful tests
  666. X * will display a passing message twice.  Oh well, no biggie.
  667. X */
  668. Xdefine test_booleans()
  669. X{
  670. X    local    x;
  671. X    local    y;
  672. X    local    t1, t2, t3;
  673. X
  674. X    print '100: Beginning test_booleans';
  675. X
  676. X    if (0)
  677. X        print '**** if (0)';
  678. X    if (0)
  679. X        err = err + 1;
  680. X
  681. X    if (1)
  682. X        print '101: if (1)';
  683. X
  684. X    if (2)
  685. X        print '102: if (2)';
  686. X
  687. X    if (1)
  688. X        print '103: if (1) else';
  689. X    else
  690. X        print '**** if (1) else';
  691. X    if (1)
  692. X        print '104: if (1) else';
  693. X    else
  694. X        err = err + 1;
  695. X
  696. X    if (0)
  697. X        print '**** if (0) else';
  698. X    else
  699. X        print '105: if (0) else';
  700. X    if (0)
  701. X        err = err + 1;
  702. X    else
  703. X        print '106: if (0) else';
  704. X
  705. X    if (1 == 1)
  706. X        print '107: if 1 == 1';
  707. X    else
  708. X        print '**** if 1 == 1';
  709. X    if (1 == 1)
  710. X        print '108: if 1 == 1';
  711. X    else
  712. X        err = err + 1;
  713. X
  714. X    if (1 != 2)
  715. X        print '109: if 1 != 2';
  716. X    else
  717. X        print '**** if 1 != 2';
  718. X    if (1 != 2)
  719. X        print '110: if 1 != 2';
  720. X    else
  721. X        err = err + 1;
  722. X
  723. X    verify(1,      '111: verify 1');
  724. X    verify(2 == 2, '112: verify 2 == 2');
  725. X    verify(2 != 3, '113: verify 2 != 3');
  726. X    verify(2 <  3, '114: verify 2 <  3');
  727. X    verify(2 <= 2, '115: verify 2 <= 2');
  728. X    verify(2 <= 3, '116: verify 2 <= 3');
  729. X    verify(3 >  2, '117: verify 3 >  2');
  730. X    verify(2 >= 2, '118: verify 2 >= 2');
  731. X    verify(3 >= 2, '119: verify 3 >= 2');
  732. X    verify(!0,     '120: verify !0');
  733. X    verify(!1 == 0,'121: verify !1 == 0');
  734. X    print '122: Ending test_booleans';
  735. X}
  736. X
  737. X
  738. X/*
  739. X * Test variables and simple assignments.
  740. X */
  741. Xdefine test_variables()
  742. X{
  743. X    local    x1, x2, x3;
  744. X    global    g1, g2;
  745. X    local    t;
  746. X    global    globalvar;
  747. X
  748. X    print '200: Beginning test_variables';
  749. X    x1 = 5;
  750. X    x3 = 7 * 2;
  751. X    x2 = 9 + 1;
  752. X    globalvar = 22;
  753. X    g1 = 19 - 3;
  754. X    g2 = 79;
  755. X    verify(x1 == 5,  '201: x1 == 5');
  756. X    verify(x2 == 10, '202: x2 == 10');
  757. X    verify(x3 == 14, '203: x3 == 14');
  758. X    verify(g1 == 16, '204: g1 == 16');
  759. X    verify(g2 == 79, '205: g2 == 79');
  760. X    verify(globalvar == 22, '204: globalvar == 22');
  761. X    verify(getglobalvar() == 22, '205: getglobalvar() == 22');
  762. X    x1 = x2 + x3 + g1;
  763. X    verify(x1 == 40, '206: x1 == 40');
  764. X    g1 = x3 + g2;
  765. X    verify(g1 == 93, '207: g1 == 207');
  766. X    x1 = 5;
  767. X    verify(x1++ == 5, '208: x1++ == 5');
  768. X    verify(x1 == 6, '209: x1 == 6');
  769. X    verify(++x1 == 7, '210: ++x1 == 7');
  770. X    x1 += 3;
  771. X    verify(x1 == 10, '211: x1 == 10');
  772. X    x1 -= 6;
  773. X    verify(x1 == 4, '212: x1 == 4');
  774. X    x1 *= 3;
  775. X    verify(x1 == 12, '213: x1 == 12');
  776. X    x1 /= 4;
  777. X    verify(x1 == 3, '214: x1 == 3');
  778. X    x1 = x2 = x3;
  779. X    verify(x2 == 14, '215: x2 == 14');
  780. X    verify(x1 == 14, '216: x1 == 14');
  781. X    print '217: Ending test_variables';
  782. X}
  783. X
  784. X
  785. X/*
  786. X * Test logical AND and OR operators and short-circuit evaluation.
  787. X */
  788. Xdefine test_logicals()
  789. X{
  790. X    local    x;
  791. X
  792. X    print '300: Beginning test_logicals';
  793. X
  794. X    if (2 && 3) {
  795. X        print '301: if (2 && 3)';
  796. X    } else {
  797. X        print '**** if (2 && 3)';
  798. X        ++err;
  799. X    }
  800. X
  801. X    if (2 && 0) {
  802. X        print '**** if (2 && 0)';
  803. X        ++err;
  804. X    } else {
  805. X        print '302: if (2 && 0)';
  806. X    }
  807. X
  808. X    if (0 && 2) {
  809. X        print '**** if (0 && 2)';
  810. X        ++err;
  811. X    } else {
  812. X        print '303: if (0 && 2)';
  813. X    }
  814. X
  815. X    if (0 && 0) {
  816. X        print '**** if (0 && 0)';
  817. X        ++err;
  818. X    } else {
  819. X        print '304: if (0 && 0)';
  820. X    }
  821. X
  822. X    if (2 || 0) {
  823. X        print '305: if (2 || 0)';
  824. X    } else {
  825. X        print '**** if (2 || 0)';
  826. X        ++err;
  827. X    }
  828. X    
  829. X    if (0 || 2) {
  830. X        print '306: if (0 || 2)';
  831. X    } else {
  832. X        print '**** if (0 || 2)';
  833. X        ++err;
  834. X    }
  835. X
  836. X    if (0 || 0) {
  837. X        print '**** if (0 || 0)';
  838. X        ++err;
  839. X    } else {
  840. X        print '307: if (0 || 0)';
  841. X    }
  842. X
  843. X    x = 2 || 3; verify(x == 2, '308: (2 || 3) == 2');
  844. X    x = 2 || 0; verify(x == 2, '309: (2 || 0) == 2');
  845. X    x = 0 || 3; verify(x == 3, '310: (0 || 3) == 3');
  846. X    x = 0 || 0; verify(x == 0, '311: (0 || 0) == 0');
  847. X    x = 2 && 3; verify(x == 3, '312: (2 && 3) == 3');
  848. X    x = 2 && 0; verify(x == 0, '313: (2 && 0) == 0');
  849. X    x = 0 && 3; verify(x == 0, '314: (0 && 3) == 0');
  850. X    x = 2 || error('2 || error()');
  851. X    x = 0 && error('0 && error()');
  852. X    print '315: Ending test_logicals';
  853. X}
  854. X
  855. X
  856. X/*
  857. X * Test simple arithmetic operations and expressions.
  858. X */
  859. Xdefine test_arithmetic()
  860. X{
  861. X    print '400: Beginning test_arithmetic';
  862. X    verify(3+4==7, '401: 3 + 4 == 7');
  863. X    verify(4-1==3, '402: 4 - 1 == 3');
  864. X    verify(2*3==6, '403: 2 * 3 == 6');
  865. X    verify(8/4==2, '404: 8 / 4 == 2');
  866. X    verify(2^3==8, '405: 2 ^ 3 == 8');
  867. X    verify(9-4-2==3, '406: 9-4-2 == 3');
  868. X    verify(9-4+2==7, '407: 9-4+2 == 6');
  869. X    verify(-5+2==-3,  '408: -5+2 == -3');
  870. X    verify(2*3+1==7, '409: 2*3+1 == 7');
  871. X    verify(1+2*3==7, '410: 1+2*3 == 7');
  872. X    verify((1+2)*3==9, '411: (1+2)*3 == 9');
  873. X    verify(2*(3+1)==8, '412: 2*(3+1) == 8');
  874. X    verify(9-(2+3)==4, '413: 9-(2+3) == 4');
  875. X    verify(9+(2-3)==8, '414: 9+(2-3) == 8');
  876. X    verify((2+3)*(4+5)==45, '415: (2+3)*(4+5) == 45');
  877. X    verify(10/(2+3)==2, '416: 10/(2+3) == 2');
  878. X    verify(12/3+4==8, '417: 12/3+4 == 8');
  879. X    verify(6+12/3==10, '418: 6+12/3 == 10');
  880. X    verify(2+3==1+4, '419: 2+3 == 1+4');
  881. X    verify(-(2+3)==-5, '420: -(2+3) == -5');
  882. X    verify(7&18==2,    '421: 7&18 == 2');
  883. X    verify(3|17==19,   '422: 3|17 == 19');
  884. X    verify(2&3|1==3,   '423: 2&3|1 == 3');
  885. X    verify(2&(3|1)==2, '424: 2&(3|1) == 2');
  886. X    verify(3<<4==48,   '425: 3<<4 == 48');
  887. X    verify(5>>1==2,    '426: 5>>1 == 2');
  888. X    verify(3<<-1==1,   '427: 3<<-1 == 1');
  889. X    verify(5>>-2==20,  '428: 5>>-2 == 20');
  890. X    verify(1<<2<<3==65536, '429: 1<<2<<3 == 65536');
  891. X    verify((1<<2)<<3==32, '430: (1<<2)<<3 == 32');
  892. X    verify(2^3^2==512, '431: 2^3^2 == 512');
  893. X    verify((2^3)^2==64,'432: (2^3)^2 == 64');
  894. X    verify(4//3==1, '433: 4//3==1');
  895. X    verify(4//-3==-1, '434: 4//-3==-1');
  896. X    verify(0.75//-0.51==-1, '435: 0.75//-0.51==-1');
  897. X    verify(0.75//-0.50==-1, '436: 0.75//-0.50==-1');
  898. X    verify(0.75//-0.49==-1, '437: 0.75//-0.49==-1');
  899. X    verify((3/4)//(-1/4)==-3, '438: (3/4)//(-1/4)==-3');
  900. X    verify(7%3==1,     '439: 7%3==1');
  901. X/* The following is pending a proposed change to allow neg mods
  902. X    verify(7%-3==1,    '440: 7%-3==1');
  903. X */
  904. X    print '441: Ending test_arithmetic';
  905. X}
  906. X
  907. X
  908. X/*
  909. X * Test string constants and comparisons
  910. X */
  911. Xdefine test_strings()
  912. X{
  913. X    local x, y, z;
  914. X
  915. X    print '500: Beginning test_strings';
  916. X    x = 'string';
  917. X    y = "string";
  918. X    z = x;
  919. X    verify(z == "string", '501: z == "string"');
  920. X    verify(z != "foo", '502: z != "foo"');
  921. X    verify(z != 3, '503: z != 3');
  922. X    verify('' == "", '504: \'\' == ""');
  923. X    verify("a" == "a", '505: "a" == "a"');
  924. X    verify("c" != "d", '506: "c" != "d"');
  925. X    verify("" != "a", '507: "" != "a"');
  926. X    verify("rs" < "rt", '508: "rs" < "rt"');
  927. X    verify("rs" < "ss", '509: "rs < "ss"');
  928. X    verify("rs" <= "rs", '510: "rs" <= "rs"');
  929. X    verify("rs" <= "tu", '511: "rs" <= "tu"');
  930. X    verify("rs" > "cd", '512: "rs" > "cd"');
  931. X    verify("rs" >= "rs", '513: "rs" >= "rs"');
  932. X    verify("rs" >= "cd", '514: "rs" >= "cd"'); 
  933. X    verify("abc" > "ab", '515: "abc" > "ab"');
  934. X    print '516: Ending test_strings';
  935. X}
  936. X
  937. X
  938. X/*
  939. X * Do multiplication and division on three numbers in various ways
  940. X * and verify the results agree.
  941. X */
  942. Xdefine muldivcheck(a, b, c, str)
  943. X{
  944. X    local    abc, acb, bac, bca, cab, cba;
  945. X
  946. X    abc = (a * b) * c;
  947. X    acb = (a * c) * b;
  948. X    bac = (b * a) * c;
  949. X    bca = (b * c) * a;
  950. X    cab = (c * a) * b;
  951. X    cba = (c * b) * a;
  952. X
  953. X    if (abc != acb) {print '**** abc != acb:', str; ++err;}
  954. X    if (acb != bac) {print '**** acb != bac:', str; ++err;}
  955. X    if (bac != bca) {print '**** bac != bca:', str; ++err;}
  956. X    if (bca != cab) {print '**** bca != cab:', str; ++err;}
  957. X    if (cab != cba) {print '**** cab != cba:', str; ++err;}
  958. X    if (abc/a != b*c) {print '**** abc/a != bc:', str; ++err;}
  959. X    if (abc/b != a*c) {print '**** abc/b != ac:', str; ++err;}
  960. X    if (abc/c != a*b) {print '**** abc/c != ab:', str; ++err;}
  961. X    print str;
  962. X}
  963. X
  964. X
  965. X/*
  966. X * Use the identity for squaring the sum of two squares to check
  967. X * multiplication and squaring.
  968. X */
  969. Xdefine squarecheck(a, b, str)
  970. X{
  971. X    local    a2, b2, tab, apb, apb2, t;
  972. X
  973. X    a2 = a^2;
  974. X    b2 = b^2;
  975. X    tab = a * b * 2;
  976. X    apb = a + b;
  977. X    apb2 = apb^2;
  978. X    if (a2 != a*a) {print '**** a^2 != a*a:', str; ++err;}
  979. X    if (b2 != b*b) {print '**** b^2 != b*b:', str; ++err;}
  980. X    if (apb2 != apb*apb) {
  981. X        print '**** (a+b)^2 != (a+b)*(a+b):', str; 
  982. X        ++err;
  983. X    }
  984. X    if (a2+tab+b2 != apb2) {
  985. X        print '**** (a+b)^2 != a^2 + 2ab + b^2:', str; 
  986. X        ++err;
  987. X    }
  988. X    if (a2/a != a) {print '**** a^2/a != a:', str; ++err;}
  989. X    if (b2/b != b) {print '**** b^2/b != b:', str; ++err;}
  990. X    if (apb2/apb != apb) {print '**** (a+b)^2/(a+b) != a+b:', str; ++err;}
  991. X    if (a2*b2 != (a*b)^2) {print '**** a^2*b^2 != (ab)^2:', str; ++err;}
  992. X    print str;
  993. X}
  994. X
  995. X
  996. X/*
  997. X * Use the raising of numbers to large powers to check multiplication
  998. X * and exponentiation.
  999. X */
  1000. Xdefine powercheck(a, p1, p2, str)
  1001. X{
  1002. X    local    a1, a2, a3;
  1003. X
  1004. X    a1 = (a^p1)^p2;
  1005. X    a2 = (a^p2)^p1;
  1006. X    a3 = a^(p1*p2);
  1007. X    if (a1 != a2) {print '**** (a^p1)^p2 != (a^p2)^p1:', str; ++err;}
  1008. X    if (a1 != a3) {print '**** (a^p1)^p2 != a^(p1*p2):', str; ++err;}
  1009. X    print str;
  1010. X}
  1011. X
  1012. X
  1013. X/*
  1014. X * Test fraction reductions.
  1015. X * Arguments MUST be relatively prime.
  1016. X */
  1017. Xdefine fraccheck(a, b, c, str)
  1018. X{
  1019. X    local    ab, bc, ca, aoc, boc, aob;
  1020. X
  1021. X    ab = a * b;
  1022. X    bc = b * c;
  1023. X    ca = c * a;
  1024. X    aoc = ab / bc;
  1025. X    if (num(aoc) != a) {print '**** num(aoc) != a:', str; ++err;}
  1026. X    if (den(aoc) != c) {print '**** den(aoc) != c:', str; ++err;}
  1027. X    boc = ab / ca;
  1028. X    if (num(boc) != b) {print '**** num(boc) != b:', str; ++err;}
  1029. X    if (den(boc) != c) {print '**** den(boc) != c:', str; ++err;}
  1030. X    aob = ca / bc;
  1031. X    if (num(aob) != a) {print '**** num(aob) != a:', str; ++err;}
  1032. X    if (den(aob) != b) {print '**** den(aob) != b:', str; ++err;}
  1033. X    if (aob*boc != aoc) {print '**** aob*boc != aoc;', str; ++err;}
  1034. X    print str;
  1035. X}
  1036. X
  1037. X
  1038. X/*
  1039. X * Test multiplication and squaring algorithms.
  1040. X */
  1041. Xdefine algcheck(a, b, str)
  1042. X{
  1043. X    local    ss, ms, t1, t2, t3, t4, t5, t6, t7;
  1044. X    local    a1, a2, a3, a4, a5, a6, a7;
  1045. X    local    oldmul2, oldsq2;
  1046. X
  1047. X    oldmul2 = config("mul2", 2);
  1048. X    oldsq2 = config("sq2", 2);
  1049. X    a1 = a * b;
  1050. X    a2 = a * a;
  1051. X    a3 = b * b;
  1052. X    a4 = a^2;
  1053. X    a5 = b^2;
  1054. X    a6 = a2^2;
  1055. X    a7 = pmod(3,a-1,a);
  1056. X    for (ms = 2; ms < 20; ms++) {
  1057. X        for (ss = 2; ss < 20; ss++) {
  1058. X            config("mul2", ms);
  1059. X            config("sq2", ss);
  1060. X            t1 = a * b;
  1061. X            t2 = a * a;
  1062. X            t3 = b * b;
  1063. X            t4 = a^2;
  1064. X            t5 = b^2;
  1065. X            t6 = t2^2;
  1066. X            if (((ms + ss) % 37) == 4)
  1067. X                t7 = pmod(3,a-1,a);
  1068. X            if (t1 != a1) {print '**** t1 != a1:', str; ++err;}
  1069. X            if (t2 != a2) {print '**** t2 != a2:', str; ++err;}
  1070. X            if (t3 != a3) {print '**** t3 != a3:', str; ++err;}
  1071. X            if (t4 != a4) {print '**** t4 != a4:', str; ++err;}
  1072. X            if (t5 != a5) {print '**** t5 != a5:', str; ++err;}
  1073. X            if (t6 != a6) {print '**** t6 != a6:', str; ++err;}
  1074. X            if (t7 != a7) {print '**** t7 != a7:', str; ++err;}
  1075. X        }
  1076. X    }
  1077. X    config("mul2", oldmul2);
  1078. X    config("sq2", oldsq2);
  1079. X    print str;
  1080. X}
  1081. X
  1082. X
  1083. X/*
  1084. X * Test big numbers using some identities.
  1085. X */
  1086. Xdefine test_bignums()
  1087. X{
  1088. X    local    a, b, c, d;
  1089. X
  1090. X    print '600: Beginning test_bignums';
  1091. X    a = 64357824568234938591;
  1092. X    b = 12764632632458756817;
  1093. X    c = 43578234973856347982;
  1094. X    muldivcheck(a, b, c, '601: muldivcheck 1');
  1095. X    a = 3^100;
  1096. X    b = 5^97;
  1097. X    c = 7^88;
  1098. X    muldivcheck(a, b, c, '602: muldivcheck 2');
  1099. X    a = 2^160 - 1;
  1100. X    b = 2^161 - 1;
  1101. X    c = 2^162 - 1;
  1102. X    muldivcheck(a, b, c, '603: muldivcheck 3');
  1103. X    a = 3^35 / 5^35;
  1104. X    b = 7^35 / 11^35;
  1105. X    c = 13^35 / 17^35;
  1106. X    muldivcheck(a, b, c, '604: muldivcheck 4');
  1107. X    a = (10^97-1) / 9;
  1108. X    b = (10^53-1) / 9;
  1109. X    c = (10^37-1) / 9;
  1110. X    muldivcheck(a, b, c, '605: muldivcheck 5');
  1111. X    a = 17^50;
  1112. X    b = 19^47;
  1113. X    squarecheck(a, b, '606: squarecheck 1');
  1114. X    a = 2^111-1;
  1115. X    b = 2^17;
  1116. X    squarecheck(a, b, '607: squarecheck 2');
  1117. X    a = 23^43 / 29^43;
  1118. X    b = 31^42 / 37^29;
  1119. X    squarecheck(a, b, '608: squarecheck 3');
  1120. X    a = 4657892345743659834657238947854639;
  1121. X    b = 43784356784365893467659347867689;
  1122. X    squarecheck(a, b, '609: squarecheck 4');
  1123. X    a = (10^80-1) / 9;
  1124. X    b = (10^50-1) / 9;
  1125. X    squarecheck(a, b, '610: squarecheck 5');
  1126. X    a = 101^99;
  1127. X    b = 2 * a;
  1128. X    squarecheck(a, b, '611: squarecheck 6');
  1129. X    a = (10^19-1) / 9;
  1130. X    verify(ptest(a, 20), '612: primetest R19');
  1131. X    a = (10^23-1) / 9;
  1132. X    verify(ptest(a, 20), '613: primetest R23');
  1133. X    a = 2^127 - 1;
  1134. X    verify(ptest(a, 1), '614: primetest M127');
  1135. X    a = 2^521 - 1;
  1136. X    verify(ptest(a, 1), '615: primetest M521');
  1137. X    powercheck(17, 127, 30, '616: powercheck 1');
  1138. X    powercheck(111, 899, 6, '617: powercheck 2');
  1139. X    powercheck(3, 87, 89, '618: powercheck 3');
  1140. X    fraccheck(3^200, 5^173, 7^138, '619: fraccheck 1');
  1141. X    fraccheck(11^100, 12^98, 13^121, '620: fraccheck 2');
  1142. X    fraccheck(101^270, 103^111, 105^200, '621: fraccheck 3');
  1143. X    a = 0xffff0000ffffffff00000000ffff0000000000000000ffff;
  1144. X    b = 0x555544440000000000000000000000000000000011112222333344440000;
  1145. X    c = 0x999911113333000011111111000022220000000000000000333300000000ffff;
  1146. X    d = 0x3333ffffffff0000000000000000ffffffffffffffff000000000000;
  1147. X    algcheck(a, a, '622: algcheck 1');
  1148. X    algcheck(a, b, '623: algcheck 2');
  1149. X    algcheck(a, c, '624: algcheck 3');
  1150. X    algcheck(a, d, '625: algcheck 4');
  1151. X    algcheck(b, b, '626: algcheck 5');
  1152. X    algcheck(b, c, '627: algcheck 6');
  1153. X    algcheck(b, d, '628: algcheck 7');
  1154. X    algcheck(c, c, '629: algcheck 8');
  1155. X    algcheck(c, d, '630: algcheck 9');
  1156. X    algcheck(d, d, '631: algcheck 10');
  1157. X/* The following are pending consideration of the 'nearest' arg to sqrt()
  1158. X    a = 2e150;
  1159. X    b = 0x3206aa0707c6c1d483b62c784c9371eb507e3ab9b2d511c4bd648e52a5277fe;
  1160. X    verify(sqrt(a,1) == b, '632: sqrt(a,1) == b');
  1161. X    verify(sqrt(4e1000,1) == 2e500, '633: sqrt(4e1000,1) == 2e500');
  1162. X */
  1163. X    print '634: Ending test_bignums';
  1164. X}
  1165. X
  1166. X
  1167. X/*
  1168. X * Test many of the built-in functions.
  1169. X */
  1170. Xdefine test_functions()
  1171. X{
  1172. X    print '700: Beginning test_functions';
  1173. X    verify(abs(3) == 3,    '701: abs(3) == 3');
  1174. X    verify(abs(-4) == 4,   '702: abs(-4) == 4');
  1175. X    verify(avg(7) == 7,    '703: avg(7) == 7');
  1176. X    verify(avg(3,5) == 4,  '704: avg(3,5) == 4');
  1177. X    verify(cmp(2,3) == -1, '705: cmp(2,3) == -1');
  1178. X    verify(cmp(6,6) == 0,  '706: cmp(6,6) == 0');
  1179. X    verify(cmp(7,4) == 1,  '707: cmp(7,4) == 1');
  1180. X    verify(comb(9,9) == 1, '708: comb(9,9) == 1');
  1181. X    verify(comb(5,2) == 10,'709: comb(5,2) == 10');
  1182. X    verify(conj(4) == 4,   '710: conj(4) == 4');
  1183. X    verify(conj(2-3i) == 2+3i, '711: conj(2-3i) == 2+3i');
  1184. X    verify(den(17) == 1,   '712: den(17) == 1');
  1185. X    verify(den(3/7) == 7,  '713: den(3/7) == 7');
  1186. X    verify(den(-2/3) == 3, '714: den(-2/3) == 3');
  1187. X    verify(digits(0) == 1, '715: digits(0) == 1');
  1188. X    verify(digits(9) == 1, '716: digits(9) == 1');
  1189. X    verify(digits(10) == 2,'717: digits(10) == 2');
  1190. X    verify(digits(-691) == 3, '718: digits(-691) == 3');
  1191. X    verify(eval('2+3') == 5, "719: eval('2+3') == 5");
  1192. X    verify(fcnt(11,3) == 0,'720: fcnt(11,3) == 0');
  1193. X    verify(fcnt(18,3) == 2,'721: fcnt(18,3) == 2');
  1194. X    verify(fib(0) == 0,    '722: fib(0) == 0');
  1195. X    verify(fib(1) == 1,    '723: fib(1) == 1');
  1196. X    verify(fib(9) == 34,   '724: fib(9) == 34');
  1197. X    verify(frem(12,5) == 12, '725: frem(12,5) == 12');
  1198. X    verify(frem(45,3) == 5, '726: frem(45,3) == 5');
  1199. X    verify(fact(0) == 1,   '727: fact(0) == 1');
  1200. X    verify(fact(1) == 1,   '728: fact(1) == 1');
  1201. X    verify(fact(5) == 120, '729: fact(5) == 120');
  1202. X    verify(frac(3) == 0,   '730: frac(3) == 0');
  1203. X    verify(frac(2/3) == 2/3, '731: frac(2/3) == 2/3');
  1204. X    verify(frac(17/3) == 2/3, '732: frac(17/3) == 2/3');
  1205. X    verify(gcd(0,3) == 3,  '733: gcd(0,3) == 3');
  1206. X    verify(gcd(1,12) == 1, '734: gcd(1,12) == 1');
  1207. X    verify(gcd(11,7) == 1, '735: gcd(11,7) == 1');
  1208. X    verify(gcd(20,65) == 5, '736: gcd(20,65) == 5');
  1209. X    verify(gcdrem(20,3) == 20, '737: gcdrem(20,3) == 20');
  1210. X    verify(gcdrem(100,6) == 25, '738: gcdrem(100,6) == 25');
  1211. X    verify(highbit(1) == 0, '739: highbit(1) == 0');
  1212. X    verify(highbit(15) == 3, '740: highbit(15) == 3');
  1213. X    verify(hypot(3,4) == 5, '741: hypot(3,4) == 5');
  1214. X    verify(ilog(90,3) == 4, '742: ilog(90,3) == 4');
  1215. X    verify(ilog10(123) == 2, '743: ilog10(123) == 2');
  1216. X    verify(ilog2(17) == 4, '744: ilog2(17) == 4');
  1217. X    verify(im(3) == 0,     '745: im(3) == 0');
  1218. X    verify(im(2+3i) == 3,  '746: im(2+3i) == 3');
  1219. X    verify(int(5) == 5,    '757: int(5) == 5');
  1220. X    verify(int(19/3) == 6, '758: int(19/3) == 6');
  1221. X    verify(inverse(3/2) == 2/3, '759: inverse(3/2) == 2/3');
  1222. X    verify(iroot(18,2) == 4, '760: iroot(18,2) == 4');
  1223. X    verify(iroot(100,3) == 4, '761: iroot(100,3) == 4');
  1224. X    verify(iseven(10) == 1, '762: iseven(10) == 1');
  1225. X    verify(iseven(13) == 0, '763: iseven(13) == 0');
  1226. X    verify(iseven('a') == 0, "764: iseven('a') == 0");
  1227. X    verify(isint(7) == 1,  '765: isint(7) == 1');
  1228. X    verify(isint(19/2) == 0, '766: isint(19/2) == 0');
  1229. X    verify(isint('a') == 0, "767: isint('a') == 0");
  1230. X    verify(islist(3) == 0, '768: islist(3) == 0');
  1231. X    verify(islist(list(2,3)) == 1, '769: islist(list(2,3)) == 1');
  1232. X    verify(ismat(3) == 0, '770: ismat(3) == 0');
  1233. X    verify(ismult(7,3) == 0, '771: ismult(7,3) == 0');
  1234. X    verify(ismult(15,5) == 1, '772: ismult(15,5) == 1');
  1235. X    verify(isnull(3) == 0, '773: isnull(3) == 0');
  1236. X    verify(isnull(null()) == 1, '774: isnull(null()) == 1');
  1237. X    verify(isnum(2/3) == 1, '775: isnum(2/3) == 1');
  1238. X    verify(isnum('xx') == 0, "776: isnum('xx') == 0");
  1239. X    verify(isobj(3) == 0, '777: isobj(3) == 0');
  1240. X    verify(isodd(7) == 1, '778: isodd(7) == 1');
  1241. X    verify(isodd(8) == 0, '779: isodd(8) == 0');
  1242. X    verify(isodd('x') == 0, "780: isodd('a') == 0");
  1243. X    verify(isqrt(27) == 5, '781: isqrt(27) == 5');
  1244. X    verify(isreal(3) == 1, '782: isreal(3) == 1');
  1245. X    verify(isreal('x') == 0, "783: isreal('x') == 0");
  1246. X    verify(isreal(2+3i) == 0, '784: isreal(2+3i) == 0');
  1247. X    verify(isstr(5) == 0,  '785: isstr(5) == 0');
  1248. X    verify(isstr('foo') == 1, "786: isstr('foo') == 1");
  1249. X    verify(isrel(10,14) == 0, '787: isrel(10,14) == 0');
  1250. X    verify(isrel(15,22) == 1, '788: isrel(15,22) == 1');
  1251. X    verify(issimple(6) == 1, '789: issimple(6) == 1');
  1252. X    verify(issimple(3-2i) == 1, '790: issimple(3-2i) == 1');
  1253. X    verify(issimple(list(5)) == 0, '791: issimple(list(5)) == 0');
  1254. X    verify(issq(26) == 0, '792: issq(26) == 0');
  1255. X    verify(issq(9/4) == 1, '793: issq(9/4) == 1');
  1256. X    verify(istype(9,4) == 1, '795: istype(9,4) == 1');
  1257. X    verify(istype(3,'xx') == 0, "796: istype(3,'xx') == 0");
  1258. X    verify(jacobi(5,11) == 1, '797: jacobi(2,7) == 1');
  1259. X    verify(jacobi(6,13) == -1, '798: jacobi(6,13) == 0');
  1260. X    verify(lcm(3,4,5,6) == 60, '799: lcm(3,4,5,6) == 60');
  1261. X    verify(lcmfact(8) == 840, '800: lcmfact(8) == 840');
  1262. X    verify(lfactor(21,5) == 3, '801: lfactor(21,5) == 3');
  1263. X    verify(lfactor(97,20) == 1, '802: lfactor(97,20) == 1');
  1264. X    verify(lowbit(12) == 2, '803: lowbit(12) == 2');
  1265. X    verify(lowbit(17) == 0, '804: lowbit(17) == 0');
  1266. X    verify(ltol(1) == 0, '805: ltol(1) == 0');
  1267. X    verify(max(3,-9,7,4) == 7, '806: max(3,-9,7,4) == 7');
  1268. X    verify(meq(13,33,10) == 1, '807: meq(13,33,10) == 1');
  1269. X    verify(meq(7,19,11) == 0, '808: meq(7,19,11) == 0');
  1270. X    verify(min(9,5,12) == 5, '809: min(9,5,12) == 5');
  1271. X    verify(minv(13,97) == 15, '810: minv(13,97) == 15');
  1272. X    verify(mne(16,37,10) == 1, '811: mne(16,37,10) == 1');
  1273. X    verify(mne(46,79,11) == 0, '812: mne(46,79,11) == 0');
  1274. X    verify(norm(4) == 16,   '813: norm(4) == 16');
  1275. X    verify(norm(2-3i) == 13, '814: norm(2-3i) == 13');
  1276. X    verify(num(7) == 7,     '815: num(7) == 7');
  1277. X    verify(num(11/4) == 11, '816: num(11/4) == 11');
  1278. X    verify(num(-9/5) == -9, '817: num(-9/5) == -9');
  1279. X    verify(char(ord('a')+2) == 'c', "818: char(ord('a')+2) == 'c'");
  1280. X    verify(perm(7,3) == 210, '819: perm(7,3) == 210');
  1281. X    verify(pfact(10) == 210, '820: pfact(10) == 210');
  1282. X    verify(places(3/7) == -1, '821: places(3/7) == -1');
  1283. X    verify(places(.347) == 3, '822: places(.347) == 3');
  1284. X    verify(places(17) == 0, '823: places(17) == 0');
  1285. X    verify(pmod(3,36,37) == 1, '824: pmod(3,36,37) == 1');
  1286. X    verify(poly(2,3,5,2) == 19, '825; poly(2,3,5,2) == 19');
  1287. X    verify(ptest(101,10) == 1, '826: ptest(101,10) == 1');
  1288. X    verify(ptest(221,30) == 0, '827: ptest(221,30) == 0');
  1289. X    verify(re(9) == 9,       '828: re(9) == 9');
  1290. X    verify(re(-7+3i) == -7,  '829: re(-7+3i) == -7');
  1291. X    verify(scale(3,4) == 48, '830: scale(3,4) == 48');
  1292. X    verify(sgn(-4) == -1,    '831: sgn(-4) == -1');
  1293. X    verify(sgn(0) == 0,      '832: sgn(0) == 0');
  1294. X    verify(sgn(3) == 1,      '833: sgn(3) == 1');
  1295. X    verify(size(7) == 1,     '834: size(7) == 1');
  1296. X    verify(sqrt(121) == 11,  '835: sqrt(121) == 11');
  1297. X    verify(ssq(2,3,4) == 29, '836: ssq(2,3,4) == 29');
  1298. X    verify(str(45) == '45',  "837; str(45) == '45'");
  1299. X    verify(strcat('a','bc','def')=='abcdef',"838; strcat('a','bc','def')=='abcdef'");
  1300. X    verify(strlen('') == 0,  "839: strlen('') == 0");
  1301. X    verify(strlen('abcd') == 4, "840: strlen('abcd') == 4");
  1302. X    verify(substr('abcd',2,1) == 'b', "841: substr('abcd',2,1) == 'b'");
  1303. X    verify(substr('abcd',3,4) == 'cd', "842: substr('abcd',3,4) == 'cd'");
  1304. X    verify(substr('abcd',1,3) == 'abc', "843: substr('abcd',1,3) == 'abc'");
  1305. X    verify(xor(17,17) == 0,  '844: xor(17,17) == 0');
  1306. X    verify(xor(12,5) == 9,   '845: xor(12,5) == 9');
  1307. X    verify(mmin(3,7) == 3, '846: mmin(3,7) == 3');
  1308. X    verify(mmin(4,7) == -3, '847: mmin(4,7) == -3');
  1309. X    verify(digit(123,2) == 1, '848: digit(123,2) == 1');
  1310. X    verify(ismult(3/4, 1/7) == 0, '849: ismult(3/4, 1/7) == 0');
  1311. X    verify(gcd(3/4, 1/7) == 1/28, '850: gcd(3/4,1/7) == 1/28');
  1312. X/* The following are pending consideration of the 'nearest' arg to sqrt()
  1313. X    verify(sqrt(122,1) == 11,  '851: sqrt(122,1) == 11');
  1314. X    verify(sqrt(110,1) == 10,  '852: sqrt(110,1) == 10');
  1315. X    verify(sqrt(110,0.1) == 10.5,  '853: sqrt(110,0.1) == 10.5');
  1316. X    verify(sqrt(115,0.1) == 10.75,  '854: sqrt(115,0.1) == 10.75');
  1317. X */
  1318. X    print '855: Ending test_functions';
  1319. X}
  1320. X
  1321. X
  1322. X/*
  1323. X * Report the number of errors found.
  1324. X */
  1325. Xdefine count_errors()
  1326. X{
  1327. X    if (err == 0) {
  1328. X        print "999: passed all tests  /\\../\\";
  1329. X    } else {
  1330. X        print "****", err, "error(s) found  \\/++\\/";
  1331. X    }
  1332. X}
  1333. X
  1334. X
  1335. Xprint '001: Beginning regression tests';
  1336. Xprint '002: Within each section, output should be numbered sequentially';
  1337. Xprint;
  1338. Xreturn test_booleans();
  1339. Xprint;
  1340. Xreturn test_variables();
  1341. Xprint;
  1342. Xreturn test_logicals();
  1343. Xprint;
  1344. Xreturn test_arithmetic();
  1345. Xprint;
  1346. Xreturn test_strings();
  1347. Xprint;
  1348. Xreturn test_bignums();
  1349. Xprint;
  1350. Xreturn test_functions();
  1351. Xprint;
  1352. Xreturn count_errors();
  1353. SHAR_EOF
  1354. chmod 0644 calc2.9.0/lib/regress.cal || echo "restore of calc2.9.0/lib/regress.cal fails"
  1355. set `wc -c calc2.9.0/lib/regress.cal`;Sum=$1
  1356. if test "$Sum" != "21846"
  1357. then echo original size 21846, current size $Sum;fi
  1358. echo "x - extracting calc2.9.0/lib/solve.cal (Text)"
  1359. sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/solve.cal &&
  1360. X/*
  1361. X * Copyright (c) 1993 David I. Bell
  1362. X * Permission is granted to use, distribute, or modify this source,
  1363. X * provided that this copyright notice remains intact.
  1364. X *
  1365. X * Solve the equation f(x) = 0 to within the desired error value for x.
  1366. X * The function 'f' must be defined outside of this routine, and the low
  1367. X * and high values are guesses which must produce values with opposite signs.
  1368. X */
  1369. X
  1370. Xdefine solve(low, high, epsilon)
  1371. X{
  1372. X    local flow, fhigh, fmid, mid, places;
  1373. X
  1374. X    if (isnull(epsilon))
  1375. X        epsilon = epsilon();
  1376. X    if (epsilon <= 0)
  1377. X        quit "Non-positive epsilon value";
  1378. X    places = highbit(1 + int(1/epsilon)) + 1;
  1379. X    flow = f(low);
  1380. X    if (abs(flow) < epsilon)
  1381. X        return low;
  1382. X    fhigh = f(high);
  1383. X    if (abs(flow) < epsilon)
  1384. X        return high;
  1385. X    if (sgn(flow) == sgn(fhigh))
  1386. X        quit "Non-opposite signs";
  1387. X    while (1) {
  1388. X        mid = bround(high - fhigh * (high - low) / (fhigh - flow), places);
  1389. X        if ((mid == low) || (mid == high))
  1390. X            places++;
  1391. X        fmid = f(mid);
  1392. X        if (abs(fmid) < epsilon)
  1393. X            return mid;
  1394. X        if (sgn(fmid) == sgn(flow)) {
  1395. X            low = mid;
  1396. X            flow = fmid;
  1397. X        } else {
  1398. X            high = mid;
  1399. X            fhigh = fmid;
  1400. X        }
  1401. X    }
  1402. X}
  1403. X
  1404. Xglobal lib_debug;
  1405. Xif (lib_debug >= 0) {
  1406. X    print "solve(low, high, epsilon) defined";
  1407. X}
  1408. SHAR_EOF
  1409. chmod 0644 calc2.9.0/lib/solve.cal || echo "restore of calc2.9.0/lib/solve.cal fails"
  1410. set `wc -c calc2.9.0/lib/solve.cal`;Sum=$1
  1411. if test "$Sum" != "1182"
  1412. then echo original size 1182, current size $Sum;fi
  1413. echo "x - extracting calc2.9.0/lib/sumsq.cal (Text)"
  1414. sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/sumsq.cal &&
  1415. X/*
  1416. X * Copyright (c) 1993 David I. Bell
  1417. X * Permission is granted to use, distribute, or modify this source,
  1418. X * provided that this copyright notice remains intact.
  1419. X *
  1420. X * Determine the unique two positive integers whose squares sum to the
  1421. X * specified prime.  This is always possible for all primes of the form
  1422. X * 4N+1, and always impossible for primes of the form 4N-1.
  1423. X */
  1424. X
  1425. Xdefine ss(p)
  1426. X{
  1427. X    local a, b, i, p4;
  1428. X
  1429. X    if (p == 2) {
  1430. X        print "1^2 + 1^2 = 2";
  1431. X        return;
  1432. X    }
  1433. X    if ((p % 4) != 1) {
  1434. X        print p, "is not of the form 4N+1";
  1435. X        return;
  1436. X    }
  1437. X    if (!ptest(p, min(p-2, 10))) {
  1438. X        print p, "is not a prime";
  1439. X        return;
  1440. X    }
  1441. X    p4 = (p - 1) / 4;
  1442. X    i = 2;
  1443. X    do {
  1444. X        a = pmod(i++, p4, p);
  1445. X    } while ((a^2 % p) == 1);
  1446. X    b = p;
  1447. X    while (b^2 > p) {
  1448. X        i = b % a;
  1449. X        b = a;
  1450. X        a = i;
  1451. X    }
  1452. X    print a : "^2 +" , b : "^2 =" , a^2 + b^2;
  1453. X}
  1454. X
  1455. Xglobal lib_debug;
  1456. Xif (lib_debug >= 0) {
  1457. X    print "ss(p) defined";
  1458. X}
  1459. SHAR_EOF
  1460. chmod 0644 calc2.9.0/lib/sumsq.cal || echo "restore of calc2.9.0/lib/sumsq.cal fails"
  1461. set `wc -c calc2.9.0/lib/sumsq.cal`;Sum=$1
  1462. if test "$Sum" != "869"
  1463. then echo original size 869, current size $Sum;fi
  1464. echo "x - extracting calc2.9.0/lib/surd.cal (Text)"
  1465. sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/surd.cal &&
  1466. X/*
  1467. X * Copyright (c) 1993 David I. Bell
  1468. X * Permission is granted to use, distribute, or modify this source,
  1469. X * provided that this copyright notice remains intact.
  1470. X *
  1471. X * Calculate using quadratic surds of the form: a + b * sqrt(D).
  1472. X */
  1473. X
  1474. Xobj surd {a, b};        /* definition of the surd object */
  1475. X
  1476. Xglobal surd_type = -1;        /* type of surd (value of D) */
  1477. Xstatic obj surd surd__;        /* example surd for testing against */
  1478. X
  1479. X
  1480. Xdefine surd(a,b)
  1481. X{
  1482. X    local x;
  1483. X
  1484. X    obj surd x;
  1485. X    x.a = a;
  1486. X    x.b = b;
  1487. X    return x;
  1488. X}
  1489. X
  1490. X
  1491. Xdefine surd_print(a)
  1492. X{
  1493. X    print "surd(" : a.a : ", " : a.b : ")" :;
  1494. X}
  1495. X
  1496. X
  1497. Xdefine surd_conj(a)
  1498. X{
  1499. X    local    x;
  1500. X
  1501. X    obj surd x;
  1502. X    x.a = a.a;
  1503. X    x.b = -a.b;
  1504. X    return x;
  1505. X}
  1506. X
  1507. X
  1508. Xdefine surd_norm(a)
  1509. X{
  1510. X    return a.a^2 + abs(surd_type) * a.b^2;
  1511. X}
  1512. X
  1513. X
  1514. Xdefine surd_value(a, xepsilon)
  1515. X{
  1516. X    local    epsilon;
  1517. X
  1518. X    epsilon = xepsilon;
  1519. X    if (isnull(epsilon))
  1520. X        epsilon = epsilon();
  1521. X    return a.a + a.b * sqrt(surd_type, epsilon);
  1522. X}
  1523. X
  1524. Xdefine surd_add(a, b)
  1525. X{
  1526. X    local obj surd    x;
  1527. X
  1528. X    if (!istype(b, x)) {
  1529. X        x.a = a.a + b;
  1530. X        x.b = a.b;
  1531. X        return x;
  1532. X    }
  1533. X    if (!istype(a, x)) {
  1534. X        x.a = a + b.a;
  1535. X        x.b = b.b;
  1536. X        return x;
  1537. X    }
  1538. X    x.a = a.a + b.a;
  1539. X    x.b = a.b + b.b;
  1540. X    if (x.b)
  1541. X        return x;
  1542. X    return x.a;
  1543. X}
  1544. X
  1545. X
  1546. Xdefine surd_sub(a, b)
  1547. X{
  1548. X    local obj surd    x;
  1549. X
  1550. X    if (!istype(b, x)) {
  1551. X        x.a = a.a - b;
  1552. X        x.b = a.b;
  1553. X        return x;
  1554. X    }
  1555. X    if (!istype(a, x)) {
  1556. X        x.a = a - b.a;
  1557. X        x.b = -b.b;
  1558. X        return x;
  1559. X    }
  1560. X    x.a = a.a - b.a;
  1561. X    x.b = a.b - b.b;
  1562. X    if (x.b)
  1563. X        return x;
  1564. X    return x.a;
  1565. X}
  1566. X
  1567. X
  1568. Xdefine surd_inc(a)
  1569. X{
  1570. X    local    x;
  1571. X
  1572. X    x = a;
  1573. X    x.a++;
  1574. X    return x;
  1575. X}
  1576. X
  1577. X
  1578. Xdefine surd_dec(a)
  1579. X{
  1580. X    local    x;
  1581. X
  1582. X    x = a;
  1583. X    x.a--;
  1584. X    return x;
  1585. X}
  1586. X
  1587. X
  1588. Xdefine surd_neg(a)
  1589. X{
  1590. X    local obj surd    x;
  1591. X
  1592. X    x.a = -a.a;
  1593. X    x.b = -a.b;
  1594. X    return x;
  1595. X}
  1596. X
  1597. X
  1598. Xdefine surd_mul(a, b)
  1599. X{
  1600. X    local obj surd    x;
  1601. X
  1602. X    if (!istype(b, x)) {
  1603. X        x.a = a.a * b;
  1604. X        x.b = a.b * b;
  1605. X    } else if (!istype(a, x)) {
  1606. X        x.a = b.a * a;
  1607. X        x.b = b.b * a;
  1608. X    } else {
  1609. X        x.a = a.a * b.a + surd_type * a.b * b.b;
  1610. X        x.b = a.a * b.b + a.b * b.a;
  1611. X    }
  1612. X    if (x.b)
  1613. X        return x;
  1614. X    return x.a;
  1615. X}
  1616. X
  1617. X
  1618. Xdefine surd_square(a)
  1619. X{
  1620. X    local obj surd    x;
  1621. X
  1622. X    x.a = a.a^2 + a.b^2 * surd_type;
  1623. X    x.b = a.a * a.b * 2;
  1624. X    if (x.b)
  1625. X        return x;
  1626. X    return x.a;
  1627. X}
  1628. X
  1629. X
  1630. Xdefine surd_scale(a, b)
  1631. X{
  1632. X    local obj surd    x;
  1633. X
  1634. X    x.a = scale(a.a, b);
  1635. X    x.b = scale(a.b, b);
  1636. X    return x;
  1637. X}
  1638. X
  1639. X
  1640. Xdefine surd_shift(a, b)
  1641. X{
  1642. X    local obj surd    x;
  1643. X
  1644. X    x.a = a.a << b;
  1645. X    x.b = a.b << b;
  1646. X    if (x.b)
  1647. X        return x;
  1648. X    return x.a;
  1649. X}
  1650. X
  1651. X
  1652. Xdefine surd_div(a, b)
  1653. X{
  1654. X    local x, y;
  1655. X
  1656. X    if ((a == 0) && b)
  1657. X        return 0;
  1658. X    obj surd x;
  1659. X    if (!istype(b, x)) {
  1660. X        x.a = a.a / b;
  1661. X        x.b = a.b / b;
  1662. X        return x;
  1663. X    }
  1664. X    y = b;
  1665. X    y.b = -b.b;
  1666. X    return (a * y) / (b.a^2 - surd_type * b.b^2);
  1667. X}
  1668. X
  1669. X
  1670. Xdefine surd_inv(a)
  1671. X{
  1672. X    return 1 / a;
  1673. X}
  1674. X
  1675. X
  1676. Xdefine surd_sgn(a)
  1677. X{
  1678. X    if (surd_type < 0)
  1679. X        quit "Taking sign of complex surd";
  1680. X    if (a.a == 0)
  1681. X        return sgn(a.b);
  1682. X    if (a.b == 0)
  1683. X        return sgn(a.a);
  1684. X    if ((a.a > 0) && (a.b > 0))
  1685. X        return 1;
  1686. X    if ((a.a < 0) && (a.b < 0))
  1687. X        return -1;
  1688. X    return sgn(a.a^2 - a.b^2 * surd_type) * sgn(a.a);
  1689. X}
  1690. X
  1691. X
  1692. Xdefine surd_cmp(a, b)
  1693. X{
  1694. X    if (!istype(a, surd__))
  1695. X        return ((b.b != 0) || (a != b.a));
  1696. X    if (!istype(b, surd__))
  1697. X        return ((a.b != 0) || (b != a.a));
  1698. X    return ((a.a != b.a) || (a.b != b.b));
  1699. X}
  1700. X
  1701. X
  1702. Xdefine surd_rel(a, b)
  1703. X{
  1704. X    local x, y;
  1705. X
  1706. X    if (surd_type < 0)
  1707. X        quit "Relative comparison of complex surds";
  1708. X    if (!istype(a, surd__)) {
  1709. X        x = a - b.a;
  1710. X        y = -b.b;
  1711. X    } else if (!istype(b, surd__)) {
  1712. X        x = a.a - b;
  1713. X        y = a.b;
  1714. X    } else {
  1715. X        x = a.a - b.a;
  1716. X        y = a.b - b.b;
  1717. X    }
  1718. X    if (y == 0)
  1719. X        return sgn(x);
  1720. X    if (x == 0)
  1721. X        return sgn(y);
  1722. X    if ((x < 0) && (y < 0))
  1723. X        return -1;
  1724. X    if ((x > 0) && (y > 0))
  1725. X        return 1;
  1726. X    return sgn(x^2 - y^2 * surd_type) * sgn(x);
  1727. X}
  1728. X
  1729. Xglobal lib_debug;
  1730. Xif (lib_debug >= 0) {
  1731. X    print "obj surd {a, b} defined";
  1732. X    print "surd(a, b) defined";
  1733. X    print "surd_print(a) defined";
  1734. X    print "surd_conj(a) defined";
  1735. X    print "surd_norm(a) defined";
  1736. X    print "surd_value(a, xepsilon) defined";
  1737. X    print "surd_add(a, b) defined";
  1738. X    print "surd_sub(a, b) defined";
  1739. X    print "surd_inc(a) defined";
  1740. X    print "surd_dec(a) defined";
  1741. X    print "surd_neg(a) defined";
  1742. X    print "surd_mul(a, b) defined";
  1743. X    print "surd_square(a) defined";
  1744. X    print "surd_scale(a, b) defined";
  1745. X    print "surd_shift(a, b) defined";
  1746. X    print "surd_div(a, b) defined";
  1747. X    print "surd_inv(a) defined";
  1748. X    print "surd_sgn(a) defined";
  1749. X    print "surd_cmp(a, b) defined";
  1750. X    print "surd_rel(a, b) defined";
  1751. X    print "surd_type defined";
  1752. X    print "set surd_type as needed";
  1753. X}
  1754. SHAR_EOF
  1755. chmod 0644 calc2.9.0/lib/surd.cal || echo "restore of calc2.9.0/lib/surd.cal fails"
  1756. set `wc -c calc2.9.0/lib/surd.cal`;Sum=$1
  1757. if test "$Sum" != "4256"
  1758. then echo original size 4256, current size $Sum;fi
  1759. echo "x - extracting calc2.9.0/lib/unitfrac.cal (Text)"
  1760. sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/unitfrac.cal &&
  1761. X/*
  1762. X * Copyright (c) 1993 David I. Bell
  1763. X * Permission is granted to use, distribute, or modify this source,
  1764. X * provided that this copyright notice remains intact.
  1765. X *
  1766. X * Represent a fraction as sum of distinct unit fractions.
  1767. X * The output is the unit fractions themselves, and in square brackets,
  1768. X * the number of digits in the numerator and denominator of the value left
  1769. X * to be found.  Numbers larger than 3.5 become very difficult to calculate.
  1770. X */
  1771. X
  1772. Xdefine unitfrac(x)
  1773. X{
  1774. X    local    d, di, n;
  1775. X
  1776. X    if (x <= 0)
  1777. X        quit "Non-positive argument";
  1778. X    d = 2;
  1779. X    do {
  1780. X        n = int(1 / x) + 1;
  1781. X        if (n > d)
  1782. X            d = n;
  1783. X        di = 1/d;
  1784. X        print '  [': digits(num(x)): '/': digits(den(x)): ']',, di;
  1785. X        x -= di;
  1786. X        d++;
  1787. X    } while ((num(x) > 1) || (x == di) || (x == 1));
  1788. X    print '  [1/1]',, x;
  1789. X}
  1790. X
  1791. X
  1792. Xglobal lib_debug;
  1793. Xif (lib_debug >= 0) {
  1794. X    print "unitfrac(x) defined";
  1795. X}
  1796. SHAR_EOF
  1797. chmod 0644 calc2.9.0/lib/unitfrac.cal || echo "restore of calc2.9.0/lib/unitfrac.cal fails"
  1798. set `wc -c calc2.9.0/lib/unitfrac.cal`;Sum=$1
  1799. if test "$Sum" != "839"
  1800. then echo original size 839, current size $Sum;fi
  1801. echo "x - extracting calc2.9.0/lib/varargs.cal (Text)"
  1802. sed 's/^X//' << 'SHAR_EOF' > calc2.9.0/lib/varargs.cal &&
  1803. X/*
  1804. X * Copyright (c) 1993 David I. Bell
  1805. X * Permission is granted to use, distribute, or modify this source,
  1806. X * provided that this copyright notice remains intact.
  1807. X *
  1808. X * Example program to use 'varargs'.
  1809. X *
  1810. X * Program to sum the cubes of all the specified numbers.
  1811. X */
  1812. X
  1813. Xdefine sc()
  1814. X{
  1815. X    local s, i;
  1816. X
  1817. X    s = 0;
  1818. X    for (i = 1; i <= param(0); i++) {
  1819. X        if (!isnum(param(i))) {
  1820. X            print "parameter",i,"is not a number";
  1821. X            continue;
  1822. X        }
  1823. X        s += param(i)^3;
  1824. X    }
  1825. X    return s;
  1826. X}
  1827. X
  1828. Xglobal lib_debug;
  1829. Xif (lib_debug >= 0) {
  1830. X    print "sc(a, b, ...) defined";
  1831. X}
  1832. SHAR_EOF
  1833. chmod 0644 calc2.9.0/lib/varargs.cal || echo "restore of calc2.9.0/lib/varargs.cal fails"
  1834. set `wc -c calc2.9.0/lib/varargs.cal`;Sum=$1
  1835. if test "$Sum" != "537"
  1836. then echo original size 537, current size $Sum;fi
  1837. rm -f s2_seq_.tmp
  1838. echo "You have unpacked the last part"
  1839. exit 0
  1840.