drygdryg/calc
1
0
Fork 0
mirror of https://github.com/lcn2/calc.git synced 2025-08-16 01:03:29 +03:00
Code Issues Packages Projects Releases Wiki Activity

Release calc version 2.10.3t5.45

Browse Source
This commit is contained in:
Landon Curt Noll
1997-10-04 20:06:29 -07:00
parent 4618313a82
commit 6e10e97592
300 changed files with 38279 additions and 8584 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
lib/Makefile
View File

@@ -1,7 +1,7 @@
#
# lib - makefile for calc library scripts
#
# Copyright (c) 1996 David I. Bell and Landon Curt Noll
# Copyright (c) 1997 David I. Bell and Landon Curt Noll
# Permission is granted to use, distribute, or modify this source,
# provided that this copyright notice remains intact.
#
@@ -36,20 +36,20 @@ Q=@
# The calc files to install
#
CALC_FILES= README bigprime.cal deg.cal ellip.cal lucas.cal lucas_chk.cal \
lucas_tbl.cal mersenne.cal mod.cal pell.cal pi.cal \
lucas_tbl.cal mersenne.cal mod.cal pell.cal pi.cal pix.cal \
pollard.cal poly.cal psqrt.cal quat.cal regress.cal solve.cal \
sumsq.cal surd.cal unitfrac.cal varargs.cal chrem.cal mfactor.cal \
bindings altbind randmprime.cal test1700.cal randrun.cal \
randbitrun.cal cryrand.cal bernoulli.cal test2300.cal test2600.cal \
randbitrun.cal bernoulli.cal test2300.cal test2600.cal \
test2700.cal test3100.cal test3300.cal test3400.cal prompt.cal \
test3500.cal seedrandom.cal test4000.cal test4100.cal test4600.cal
test3500.cal seedrandom.cal test4000.cal test4100.cal test4600.cal \
beer.cal hello.cal test5100.cal test5200.cal randombitrun.cal \
randomrun.cal xx_print.cal natnumset.cal
# These files are found (but not built) in the distribution
#
DISTLIST= ${CALC_FILES} ${MAKE_FILE}
SHELL= /bin/sh
all: ${CALC_FILES} ${MAKE_FILE} .all
# used by the upper level Makefile to determine of we have done all
@@ -113,4 +113,4 @@ install: all
-rm -f nextprime.cal nextprim.cal
-rm -f test1000.cal test2000.cal ${LIBDIR}/test2000.cal
-rm -f ${LIBDIR}/nextprime.cal ${LIBDIR}/nextprim.cal
-rm -f ${LIBDIR}/test1000.cal
-rm -f ${LIBDIR}/test1000.cal ${LIBDIR}/cryrand.cal

199
lib/README
View File

@@ -1,9 +1,9 @@
# Copyright (c) 1996 David I. Bell and Landon Curt Noll
# Copyright (c) 1997 David I. Bell and Landon Curt Noll
# Permission is granted to use, distribute, or modify this source,
# provided that this copyright notice remains intact.
The following calc library files are provided because they serve as
examples of how use the calc language, and because the authors thought
examples of how use the calc language, and/or because the authors thought
them to be useful!
If you write something that you think is useful, please send it to:
@@ -26,26 +26,43 @@ version of read:
This will cause the needed library files to be read once. If these
files have already been read, the read -once will act as a noop.
By convention, the global variable lib_debug is used to control
By convention, the config parameter "lib_debug" is used to control
the verbosity of debug information printed by lib files. By default,
the lib_debug has a value of 0. If lib_debug < 0, then no debug
messages are printed. If lib_debug >= 0, then only usage message
regarding each important object are printed at the time of the read.
If lib_debug == 0, then only such usage messages are printed; no
other debug information is printed.
the "lib_debug" has a value of 0.
The "lib_debug" config parameter takes the place of the lib_debug
global variable. By convention, "lib_debug" has the following meanings:
<-1 no debug messages are printed though some internal
debug actions and information may be collected
-1 no debug messages are printed, no debug actions will be taken
0 only usage message regarding each important object are
printed at the time of the read (default)
>0 messages regarding each important object are
printed at the time of the read in addition
to other debug messages
To conform to the above convention, your lib files should end with
lines of the form:
global lib_debug;
if (lib_debug >= 0) {
print "funcA(side_a, side_b, side_c) defined";
print "funcB(size, mass) defined";
if (config("lib_debug") >= 0) {
print "obj xyz defined";
print "funcA(side_a, side_b, side_c) defined";
print "funcB(size, mass) defined";
}
=-=
beer.cal
Calc's contribution to the 99 Bottles of Beer web page:
http://www.ionet.net/~timtroyr/funhouse/beer.html#calc
bernoulli.cal
@@ -69,19 +86,6 @@ chrem.cal
Chinese remainder theorem/problem solver.
cryrand.cal
obj cryobj
cryrand(len)
scryrand([seed, [len1, len2]])
scryrand(seed, ip, iq, ir)
random([a, [b]])
srandom(seed)
randstate([cryobj | 0])
cryptographically strong pseudo-romandom number generator
deg.cal
dms(deg, min, sec)
@@ -101,6 +105,14 @@ ellip.cal
Attempt to factor using the elliptic functions: y^2 = x^3 + a*x + b.
hello.cal
Calc's contribution to the Hello World! page:
http://www.latech.edu/~acm/HelloWorld.shtml
http://www.latech.edu/~acm/helloworld/calc.html
lucas.cal
lucas(h, n)
@@ -132,14 +144,19 @@ mersenne.cal
mfactor.cal
mfactor(n [, start_k [, rept_loop])
mfactor(n [, start_k=1 [, rept_loop=10000 [, p_elim=17]]])
Return the lowest factor of 2^n-1, for n > 0. Starts looking for factors
at 2*start_k*n+1. By default, start_k == 1.
at 2*start_k*n+1. Skips values that are multiples of primes <= p_elim.
By default, start_k == 1, rept_loop = 10000 and p_elim = 17.
Be default, mfactor() does not report the search progress. When
rept_loop > 0, then a report is given every 4*rept_loop loops.
The p_elim == 17 overhead takes ~3 minutes on an 200 Mhz r4k CPU and
requires about ~13 Megs of memory. The p_elim == 13 overhead
takes about 3 seconds and requires ~1.5 Megs of memory.
The value p_elim == 17 is best for long factorizations. It is the
fastest even thought the initial startup overhead is larger than
for p_elim == 13.
mod.cal
@@ -162,6 +179,49 @@ mod.cal
Routines to handle numbers modulo a specified number.
natnumset.cal
isset(a)
setbound(n)
empty()
full()
isin(a, b)
addmember(a, n)
rmmember(a, n)
set()
mkset(s)
primes(a, b)
set_max(a)
set_min(a)
set_not(a)
set_cmp(a, b)
set_rel(a, b)
set_or(a, b)
set_and(a, b)
set_comp(a)
set_setminus(a, b)
set_diff(a,b)
set_content(a)
set_add(a, b)
set_sub(a, b)
set_mul(a, b)
set_square(a)
set_pow(a, n)
set_sum(a)
set_plus(a)
interval(a, b)
isinterval(a)
set_mod(a, b)
randset(n, a, b)
polyvals(L, A)
polyvals2(L, A, B)
set_print(a)
Demonstration of how the string operators and functions may be used
for defining and working with sets of natural numbers not exceeding a
user-specified bound.
pell.cal
pellx(D)
@@ -179,6 +239,15 @@ pi.cal
iteration.
pix.cal
pi_of_x(x)
Calculate the number of primes < x using A(n+1)=A(n-1)+A(n-2). This
is a SLOW painful method ... the builtin pix(x) is much faster.
Still, this method is interesting.
pollard.cal
factor(N, N, ai, af)
@@ -238,6 +307,8 @@ randbitrun.cal
the number and kength of identical bits runs match what is expected.
By default, run_cnt is to test the next 65536 random values.
This tests the a55 generator.
randmprime.cal
@@ -249,6 +320,30 @@ randmprime.cal
turn on various debugging print statements.
randombitrun.cal
randombitrun([run_cnt])
Using randombit(1) to generate a sequence of random bits, determine if
the number and kength of identical bits runs match what is expected.
By default, run_cnt is to test the next 65536 random values.
This tests the Blum-Blum-Shub generator.
randomrun.cal
randomrun([run_cnt])
Perform the "G. Run test" (pp. 65-68) as found in Knuth's "Art of
Computer Programming - 2nd edition", Volume 2, Section 3.3.2 on
the builtin rand() function. This function will generate run_cnt
64 bit values. By default, run_cnt is to test the next 65536
random values.
This tests the Blum-Blum-Shub generator.
randrun.cal
randrun([run_cnt])
@@ -259,6 +354,8 @@ randrun.cal
64 bit values. By default, run_cnt is to test the next 65536
random values.
This tests the a55 generator.
regress.cal
@@ -474,6 +571,36 @@ test4100.cal
This script is used by regress.cal to test REDC operations.
test4600.cal
stest(str [, verbose]) defined
ttest([m, [n [,verbose]]]) defined
sprint(x) defined
findline(f,s) defined
findlineold(f,s) defined
test4600(verbose, tnum) defined
This script is used by regress.cal to test searching in files.
test5100.cal
global a5100
global b5100
test5100(x) defined
This script is used by regress.cal to test the new code generator
declaration scope and order.
test5200.cal
global a5200
static a5200
f5200(x) defined
g5200(x) defined
h5200(x) defined
This script is used by regress.cal to test the fix of a global/static bug.
unitfrac.cal
unitfrac(x)
@@ -487,3 +614,17 @@ varargs.cal
Example program to use 'varargs'. Program to sum the cubes of all
the specified numbers.
xx_print.cal
isoctet(a) defined
list_print(a) defined
mat_print (a) defined
octet_print(a) defined
blk_print(a) defined
nblk_print (a) defined
strchar(a) defined
file_print(a) defined
error_print(a) defined
Demo for the xx_print object routines.

26
lib/beer.cal Normal file
View File

@@ -0,0 +1,26 @@
/*
* 99 bottles of beer
*
* See:
* http://www.ionet.net/~timtroyr/funhouse/beer.html#calc
*/
for (i=99; i > 0;) {
/* current wall state */
some_bottles = (i != 1) ? "bottles" : "bottle";
print i, some_bottles, "of beer on the wall,",;
print i, some_bottles, "of beer!";
/* glug, glug */
--i;
print "Take one down and pass it around,",;
/* new wall state */
less = (i > 0) ? i : "no";
bottles = (i!=1) ? "bottles" : "bottle";
print less, bottles, "of beer on the wall!\n";
}
if (config("lib_debug") >= 0) {
/* nothing to do! */
}

3
lib/bernoulli.cal
View File

@@ -61,7 +61,6 @@ define B(n)
return Bn[n];
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "B(n) defined";
}

3
lib/bigprime.cal
View File

@@ -26,7 +26,6 @@ define bigprime(a, m, p)
}
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "bigprime(a, m, p) defined";
}

3
lib/chrem.cal
View File

@@ -174,8 +174,7 @@ define chrem()
}
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "chrem(r1,m1 [,r2,m2 ...]) defined";
print "chrem(rlist [,mlist]) defined";
}

1645
lib/cryrand.cal
View File

File diff suppressed because it is too large Load Diff

3
lib/deg.cal
View File

@@ -111,8 +111,7 @@ define fixdms(a)
a.deg %= 360;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "obj dms {deg, min, sec} defined";
print "dms(deg, min, sec) defined";
print "dms_add(a, b) defined";

3
lib/ellip.cal
View File

@@ -166,7 +166,6 @@ define point_pow(p, pow)
return r;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "factor(N, I, B, force) defined";
}

12
lib/hello.cal Normal file
View File

@@ -0,0 +1,12 @@
/*
* Hello world
*
* See:
* http://www.latech.edu/~acm/helloworld/calc.html
*/
while(1) print "Hello World!";
if (config("lib_debug") >= 0) {
/* nothing to do */
}

50
lib/lucas.cal
View File

@@ -37,7 +37,7 @@
* The primality was demonstrated by a program implementing the test
* found in these routines. An Amdahl 1200 takes 1987 seconds to test
* the primality of this number. A Cray 2 took several hours to
* confirm this prime. As of 28 Aug 1993, this prime was the 2nd
* confirm this prime. As of 31 Dec 1995, this prime was the 3rd
* largest known prime and the largest known non-Mersenne prime.
*
* The same team also discovered the following twin prime pair:
@@ -75,7 +75,7 @@
*
* The Mersenne test for '2^n-1' is the fastest known primality test
* for a given large numbers. However, it is faster to search for
* primes of the form 'h*2^n-1'. When n is around 20000, one can find
* primes of the form 'h*2^n-1'. When n is around 200000, one can find
* a prime of the form 'h*2^n-1' in about 1/2 the time.
*
* Critical to understanding why 'h*2^n-1' is to observe that primes of
@@ -122,7 +122,6 @@
*/
global pprod256; /* product of "primes up to 256" / "primes up to 46" */
global lib_debug; /* 1 => print debug statements */
/*
* lucas - lucas primality test on h*2^n-1
@@ -172,6 +171,10 @@ global lib_debug; /* 1 => print debug statements */
* any number that is divisible by a prime less than 257. Valid prime
* candidates less than 257 are declared prime as a special case.
*
* In real life, you would eliminate candidates by checking for
* divisibility by a prime much larger than 257 (perhaps as high
* as 2^39).
*
* The condition 'h mod 2 == 1' is not a problem. Say one is testing
* 'j*2^m-1', where j is even. If we note that:
*
@@ -351,20 +354,21 @@ lucas(h, n)
* the number is not prime, even though if we had a larger
* table, we might have been able to show that it is prime.
*/
v1 = gen_v1(h, n, testval);
v1 = gen_v1(h, n);
if (v1 < 0) {
/* failure to test number */
print "unable to compute v(1) for", h : "*2^" : n : "-1";
ldebug("lucas", "unknown: no v(1)");
return -1;
}
u = gen_u0(h, n, testval, v1);
u = gen_u0(h, n, v1);
/*
* compute u(n-2)
*/
for (i=3; i <= n; ++i) {
u = (u^2 - 2) % testval;
/* u = (u^2 - 2) % testval; */
u = hnrmod(u^2 - 2, h, n, -1);
}
/*
@@ -417,7 +421,6 @@ lucas(h, n)
* input:
* h - h as in h*2^n-1 (h mod 2 != 0)
* n - n as in h*2^n-1
* testval - h*2^n-1
* v1 - gen_v1(h,n) (see function below)
*
* returns:
@@ -425,7 +428,7 @@ lucas(h, n)
* -1 - failed to generate u(0)
*/
define
gen_u0(h, n, testval, v1)
gen_u0(h, n, v1)
{
local shiftdown; /* the power of 2 that divides h */
local r; /* low value: v(n) */
@@ -442,15 +445,9 @@ gen_u0(h, n, testval, v1)
if (!isint(n)) {
quit "bad args: n must be an integer";
}
if (!isint(testval)) {
quit "bad args: testval must be an integer";
}
if (!isint(v1)) {
quit "bad args: v1 must be an integer";
}
if (testval <= 0) {
quit "bogus arg: testval is <= 0";
}
if (v1 <= 0) {
quit "bogus arg: v1 is <= 0";
}
@@ -488,34 +485,40 @@ gen_u0(h, n, testval, v1)
*/
if (h == 1) {
ldebug("gen_u0", "quick h == 1 case");
return r%testval;
/* return r%(h*2^n-1); */
return hnrmod(r, h, n, -1);
}
/* cycle from second highest bit to second lowest bit of h */
for (i=hbits-1; i > 0; --i) {
/* bit(i) is 1 */
if (isset(h,i)) {
if (bit(h,i)) {
/* compute v(2n+1) = v(r+1)*v(r)-v1 */
r = (r*s - v1) % testval;
/* r = (r*s - v1) % (h*2^n-1); */
r = hnrmod((r*s - v1), h, n, -1);
/* compute v(2n+2) = v(r+1)^2-2 */
s = (s^2 - 2) % testval;
/* s = (s^2 - 2) % (h*2^n-1); */
s = hnrmod((s^2 - 2), h, n, -1);
/* bit(i) is 0 */
} else {
/* compute v(2n+1) = v(r+1)*v(r)-v1 */
s = (r*s - v1) % testval;
/* s = (r*s - v1) % (h*2^n-1); */
s = hnrmod((r*s - v1), h, n, -1);
/* compute v(2n) = v(r)^-2 */
r = (r^2 - 2) % testval;
/* r = (r^2 - 2) % (h*2^n-1); */
r = hnrmod((r^2 - 2), h, n, -1);
}
}
/* we know that h is odd, so the final bit(0) is 1 */
r = (r*s - v1) % testval;
/* r = (r*s - v1) % (h*2^n-1); */
r = hnrmod((r*s - v1), h, n, -1);
/* compute the final u2 return value */
return r;
@@ -1021,13 +1024,12 @@ gen_v1(h, n)
define
ldebug(funct, str)
{
if (lib_debug > 0) {
if (config("lib_debug") > 0) {
print "DEBUG:", funct:":", str;
}
return;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "lucas(h, n) defined";
}

5
lib/lucas_chk.cal
View File

@@ -328,7 +328,7 @@ lucas_chk(high_n, quiet)
/* skip primes where h>=2^n */
if (highbit(h_p[i]) >= n_p[i]) {
if (lib_debug > 0) {
if (config("lib_debug") > 0) {
print "h>=2^n skip:", h_p[i]:"*2^":n_p[i]:"-1";
}
continue;
@@ -375,7 +375,6 @@ lucas_chk(high_n, quiet)
}
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "lucas_chk(high_n) defined";
}

3
lib/lucas_tbl.cal
View File

@@ -149,8 +149,7 @@ d_val[97]=1045; a_val[97]=33; b_val[97]=1; r_val[97]=44;
d_val[99]=9797; a_val[99]=97; b_val[99]=1; r_val[99]=388;
d_val[100]= 51; a_val[100]= 7; b_val[100]=1; r_val[100]=2;
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "d_val[100] defined";
print "a_val[100] defined";
print "b_val[100] defined";

17
lib/mersenne.cal
View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 1995 David I. Bell
* Copyright (c) 1997 David I. Bell
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*
@@ -19,26 +19,19 @@ define mersenne(p)
return 1;
/* if p is not prime, then 2^p-1 is not prime */
if (! ptest(p,10))
if (! ptest(p,1))
return 0;
/* calculate 2^p-1 for later mods */
p_mask = 2^p - 1;
/* lltest: u(i+1) = u(i)^2 - 2 mod 2^p-1 */
u = 4;
for (i = 2; i < p; ++i) {
u = u^2 - 2;
u = u&p_mask + u>>p;
if (u > p_mask)
u = u&p_mask + 1;
u = hnrmod(u^2 - 2, 1, p, -1);
}
/* 2^p-1 is prime iff u(p) = 0 mod 2^p-1 */
return (u == p_mask);
return (u == 0);
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "mersenne(p) defined";
}

309
lib/mfactor.cal
View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 1996 Landon Curt Noll
* Copyright (c) 1997 Landon Curt Noll
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted,
@@ -23,6 +23,95 @@
*/
/*
* hset method
*
* We will assume that mfactor is called with p_elim == 17.
*
* n = (the Mersenne exponent we are testing)
* Q = 4*2*3*5*7*11*13*17 (4 * pfact(of some reasonable integer))
*
* We first determine all values of h mod Q such that:
*
* gcd(h*n+1, Q) == 1 and h*n+1 == +/-1 mod 8
*
* There will be 2*1*2*4*6*10*12*16 such values of h.
*
* For efficiency, we keep the difference between consecutive h values
* in the hset[] difference array with hset[0] being the first h value.
* Last, we multiply the hset[] values by n so that we only need
* to add sequential values of hset[] to get factor candidates.
*
* We need only test factors of the form:
*
* (Q*g*n + hx) + 1
*
* where:
*
* g is an integer >= 0
* hx is computed from hset[] difference value described above
*
* Note that (Q*g*n + hx) is always even and that hx is a multiple
* of n. Thus the typical factor form:
*
* 2*k*n + 1
*
* implies that:
*
* k = (Q*g + hx/n)/2
*
* This allows us to quickly eliminate factor values that are divisible
* by 2, 3, 5, 7, 11, 13 or 17. (well <= p value found below)
*
* The following loop shows how test_factor is advanced to higher test
* values using hset[]. Here, hcount is the number of elements in hset[].
* It can be shown that hset[0] == 0. We add hset[hcount] to the hset[]
* array for looping control convenience.
*
* (* increase test_factor thru other possible test values *)
* test_factor = 0;
* hindx = 0;
* do {
* while (++hindx <= hcount) {
* test_factor += hset[hindx];
* }
* hindx = 0;
* } while (test_factor < some_limit);
*
* The test, mfactor(67, 1, 10000) took on an 200 Mhz r4k (user CPU seconds):
*
* 210.83 (prior to use of hset[])
* 78.35 (hset[] for p_elim = 7)
* 73.87 (hset[] for p_elim = 11)
* 73.92 (hset[] for p_elim = 13)
* 234.16 (hset[] for p_elim = 17)
* p_elim == 19 requires over 190 Megs of memory
*
* Over a long period of time, the call to load_hset() becomes insignificant.
* If we look at the user CPU seconds from the first 10000 cycle to the
* end of the test we find:
*
* 205.00 (prior to use of hset[])
* 75.89 (hset[] for p_elim = 7)
* 73.74 (hset[] for p_elim = 11)
* 70.61 (hset[] for p_elim = 13)
* 57.78 (hset[] for p_elim = 17)
* p_elim == 19 rejected because of memory size
*
* The p_elim == 17 overhead takes ~3 minutes on an 200 Mhz r4k CPU and
* requires about ~13 Megs of memory. The p_elim == 13 overhead
* takes about 3 seconds and requires ~1.5 Megs of memory.
*
* The value p_elim == 17 is best for long factorizations. It is the
* fastest even thought the initial startup overhead is larger than
* for p_elim == 13.
*
* NOTE: The values above are prior to optimizations where hset[] was
* multiplied by n plus other optimizations. Thus, the CPU
* times you may get will not likely match the above values.
*/
/*
* mfactor - find a factor of a Mersenne Number
*
@@ -34,22 +123,33 @@
*
* 2*k*n+1 and +/- 1 mod 8
*
* We make use of the hset[] difference array to eliminate factor
* candidates that would otherwise be divisible by 2, 3, 5, 7 ... p_elim.
*
* given:
* n attempt to factor M(n) = 2^n-1
* start_k the value k in 2*k*n+1 to start the search
* rept_loop loop cycle reporting, 0 => none
* start_k the value k in 2*k*n+1 to start the search (def: 1)
* rept_loop loop cycle reporting (def: 10000)
* p_elim largest prime to eliminate from test factors (def: 17)
*
* returns:
* factor of M(n)
* factor of (2^n)-1
*
* NOTE: The p_elim argument is optional and defaults to 17. A p_elim value
* of 17 is faster than 13 for even medium length runs. However 13
* uses less memory and has a shorter startup time.
*/
define mfactor(n, start_k, rept_loop)
define mfactor(n, start_k, rept_loop, p_elim)
{
local q; /* test factor 2*k*n+1 */
local k; /* k in 2*k*n+1 */
local step2; /* 2*n */
local step6; /* 6*n */
local mod8; /* q mod 8 */
local Q; /* 4*pfact(p_elim), hset[] cycle size */
local hcount; /* elements in the hset[] difference array */
local loop; /* report loop count */
local q; /* test factor of 2^n-1 */
local g; /* g as in test candidate form: (Q*g*hset[i])*n + 1 */
local hindx; /* hset[] index */
local i;
local tmp;
local tmp2;
/*
* firewall
@@ -57,101 +157,158 @@ define mfactor(n, start_k, rept_loop)
if (!isint(n) || n <= 0) {
quit "n must be an integer > 0";
}
if (isnull(start_k)) {
if (!isint(start_k)) {
start_k = 1;
} else if (!isint(start_k) || start_k <= 0) {
quit "start_k must be an integer > 0";
}
if (!isint(rept_loop)) {
rept_loop = 0;
rept_loop = 10000;
}
if (rept_loop < 1) {
quit "rept_loop must be an integer > 0";
}
if (!isint(p_elim)) {
p_elim = 17;
}
if (p_elim < 3) {
quit "p_elim must be an integer > 2 (try 13 or 17)";
}
/*
* declare our global values
*/
Q = 4*pfact(p_elim);
hcount = 2;
/* allocate the h difference array */
for (i=2; i <= p_elim; i = nextcand(i)) {
hcount *= (i-1);
}
local mat hset[hcount+1];
/*
* load the hset[] difference array
*/
{
local x; /* h*n+1 mod 8 */
local h; /* potential h value */
local last_h; /* previous valid h value */
last_h = 0;
for (i=0,h=0; h < Q; ++h) {
if (gcd(h*n+1,Q) == 1) {
x = (h*n+1) % 8;
if (x == 1 || x == 7) {
hset[i++] = (h-last_h) * n;
last_h = h;
}
}
}
hset[hcount] = Q*n - last_h*n;
}
/*
* setup
*/
step2 = 2*n;
step6 = 6*n;
k = start_k - 1;
q = 2*k*n+1;
/* step2 to the first factor candidate */
do {
q += step2;
mod8 = mod(q,8);
++k;
} while (mod8 != 1 && mod8 != 7);
/*
* At this point we are at either at the first or second
* of two consequtive factor candidates depending on if
* the next to k values are 1 and 7 mod 8.
*
* The loops below assume that we will test, bump k by 1
* (move to the 2nd consequtive factor candidate), test and
* bump k by 3 (move to the first of the next consequtive
* factor candidate pair).
* determine the next g and hset[] index (hindx) values such that:
*
* In order to prepair, we need to move to the first of
* a consequtive factor candidate pair. If we happen to
* be on a the 2nd of a pair, we will test it outside
* of the loop and bump to the first of the next pair.
* 2*start_k <= (Q*g + hset[hindx])
*
* and (Q*g + hset[hindx]) is a minimum and where:
*
* Q = (4 * pfact(of some reasonable integer))
* g = (some integer) (hset[] cycle number)
*
* We also compute 'q', the next test candidate.
*/
mod8 = mod(q+step2,8);
if (mod8 != 1 && mod8 != 7) {
/*
* q is the 2nd of a consequtive factor candidate pair
* so we test q now and bump k by 3.
*/
if (pmod(2,n,q) == 1) {
/* q was a factor afterall, no need to do more! */
return q;
}
q += step6;
k += 3;
g = (2*start_k) // Q;
tmp = 2*start_k - Q*g;
for (tmp2=0, hindx=0;
hindx < hcount && (tmp2 += hset[hindx]/n) < tmp;
++hindx) {
}
if (hindx == hcount) {
/* we are beyond the end of a hset[] cycle, start at the next */
++g;
hindx = 0;
tmp2 = hset[0]/n;
}
q = (Q*g + tmp2)*n + 1;
/*
* look for a factor
*
* We ignore factors that themselves are divisible by a prime <=
* some small prime p.
*
* This process is guaranteed to find the smallest factor
* of 2^n-1. A smallest factor of 2^n-1 must be prime, otherwise
* the divisors of that factor would also be factors of 2^n-1.
* Thus we know that if a test factor itself is not prime, it
* cannot be the smallest factor of 2^n-1.
*
* Eliminating all non-prime test factors would take too long.
* However we can eliminate 80.81% of the test factors
* by not using test factors that are divisible by a prime <= 17.
*/
loop = k;
while (pmod(2,n,q) != 1) {
if (pmod(2,n,q) == 1) {
return q;
} else {
/* report this loop */
printf("at 2*%d*%d+1, cpu: %f\n",
(q-1)/(2*n), n, runtime());
fflush(files(1));
loop = 0;
}
do {
/*
* determine if we need to report
*
* NOTE: (q-1)/(2*n) is the k value from 2*k*n + 1.
*/
if (rept_loop > 0) {
if (rept_loop <= ++loop) {
/* report this loop */
printf("at 2*%d*%d+1, cpu: %f\n",
k, n, runtime());
fflush(files(1));
loop = 0;
}
k += 4;
}
/*
* 1st of a consequtive factor candidate pair is not
* a factor, try the 2nd of that pair
*/
q += step2;
if (pmod(2,n,q) == 1) {
break; /* factor found */
if (rept_loop <= ++loop) {
/* report this loop */
printf("at 2*%d*%d+1, cpu: %f\n",
(q-1)/(2*n), n, runtime());
fflush(files(1));
loop = 0;
}
/*
* 2nd of a consequtive factor candidate pair is not
* a factor, try the next pair
* skip if divisable by a prime <= 449
*
* The value 281 was determined by timing loops
* which found that 281 was at or near the
* minimum time to factor 2^(2^127-1)-1.
*
* The addition of the do { ... } while (factor(q, 449)>1);
* loop reduced the factoring loop time (36504 k values with
* the hset[] initialization time removed) from 25.69 sec to
* 15.62 sec of CPU time on a 200Mhz r4k.
*/
q += step6;
}
do {
/*
* determine the next factor candidate
*/
q += hset[++hindx];
if (hindx >= hcount) {
hindx = 0;
/*
* if we cared about g,
* then we wound ++g here too
*/
}
} while (factor(q, 449) > 1);
} while (pmod(2,n,q) != 1);
/*
* return the factor found
*
* q is a factor of (2^n)-1
*/
return q;
}
global lib_debug;
if (lib_debug >= 0) {
print "mfactor(n [, start_k [, rept_loop]])"
if (config("lib_debug") >= 0) {
print "mfactor(n [, start_k=1 [, rept_loop=10000 [, p_elim=17]]])"
}

3
lib/mod.cal
View File

@@ -189,8 +189,7 @@ define mod_pow(a, b)
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "obj mod {a} defined";
print "mod(a) defined";
print "mod_print(a) defined";

632
lib/natnumset.cal Normal file
View File

@@ -0,0 +1,632 @@
/*
* Copyright (c) 1997 Ernest Bowen
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*
* By: Ernest Bowen <ernie@neumann.une.edu.au>
*/
/*
* Functions for sets of natural numbers not exceeding a fixed bound B.
*
* The default value for B is 100; B may be assigned another
* value n by setbound(n); with no argument, setbound() returns the current
* upper bound.
*
* A set S is stored as an object with one element with one component S.s;
* This component is a string of just sufficient size to include m bits,
* where m is the maximum integer in S.
*
* With zero or more integer arguments, set(a, b, ...) returns the set
* whose elements are those of a, b, ... in [0, B]. Note that arguments
* < 0 or > B are ignored.
*
* In an assignment of a set-valued lvalue to an lvalue, as in
*
* A = set(1,2,3);
* B = A;
*
* the sets share the same data string, so a change to either has the effect
* of changing both. A set equal to A but with a different string can be
* created by
*
* B = A | set()
*
* The functions empty() and full() return the empty set and the set of all
* integers in [0,B] respectively.
*
* isset(A) returns 1 or 0 according as A is or is not a set
*
* test(A) returns 0 or 1 according as A is or is not the empty set
*
* isin(A, n) for set A and integer n returns 1 if n is in A, 0 if
* 0 <= n <= B and n is not in A, the null value if n < 0 or n > B.
*
* addmember(A, n) adds n as a member of A, provided n is in [0, B];
* this is also achieved by A |= n.
*
* rmmember(A, n) removes n from A if it is a member; this is also achieved
* by A \= n.
*
* The following unary and binary operations are defined for sets A, B.
* For binary operations with one argument a set and the other an
* integer n, the integer taken to represent set(n).
*
* A | B = union of A and B, integers in at least one of A and B
* A & B = intersection of A and B, integers in both A and B
* A ~ B = symmetric difference (boolean sum) of A and Bi, integers
* in exactly one of A and B
* A \ B = set difference, integers in A but not in B
*
* ~A = complement of A, integers not in A
* #A = number ofintegers in A
* !A = 1 or 0 according as A is empty or not empty
* +A = sum of the members of A
*
* min(A) = least member of A, -1 for empty set
* max(A) = greatest member of A, -1 for empty set
* sum(A) = sum of the members of A
*
* In the following a and b denote arbitrary members of A and B:
*
* A + B = set of sums a + b
* A - B = set of differences a - b
* A * B = set of products a * b
* A ^ n = set of powers a ^ n
* A % m = set of integers congruent to a mod m
*
* A == B returns 1 or not according as A and B are equal or not
* A != B = !(A == B)
* A <= B returns 1 if A is a subset of B, i.e. every member of A is
* a member of B
* A < B = ((A <= B) && (A != B))
* A >= B = (B <= A)
* A > B = (B < A)
*
* Expresssions may be formed from the above "arithmetic" operations in
* the usual way, with parentheses for variations from the usual precedence
* rules. For example
*
* A + 3 * A ^ 2 + (A - B) ^ 3
*
* returns the set of integers expressible as
*
* a_1 + 3 * a_2 ^ 2 + (a_3 - b) ^3
*
* where a_1, a_2, a_3 are in A, and b is in B.
*
* primes(a, b) returns the set of primes between a and b inclusive.
*
* interval(a, b) returns the integers between a and b inclusive
*
* isinterval(A) returns 1 if A is a non-empty interval, 0 otherwise.
*
* randset(n, a, b) returns a random set of n integers between a and b
* inclusive; a defaults to 0, b to N-1. An error occurs if
* n is too large.
*
* polyvals(L, A) for L = list(c_0, c_1, c_2, ...) returns the set of
* values of
*
* c_0 + c_1 * a + c_2 * a^2 + ...
*
* for a in the set A.
*
* polyvals2(L, A, B) returns the set of values of poly(L, i, j) for i in
* A and j in B. Here L is a list whose members are integers or
* lists of integers, the latter representing polynomials in the
* second variable. For example, with L = list(0, list(0, 1), 1),
* polyvals2(L, A, B) will return the values of i^2 + i * j for
* i in A, j in B.
*
*/
static N; /* Number of integers in [0,B], = B + 1 */
static M; /* Maximum string size required, = N // 8 */
obj set {s};
define isset(a) = istype(a, obj set);
define setbound(n)
{
local v;
v = N - 1;
if (isnull(n))
return v;
if (!isint(n) || n < 0)
quit "Bad argument for setbound";
N = n + 1;
M = quo(N, 8, 1); /* M // 8 rounded up */
if (v >= 0)
return v;
}
setbound(100);
define empty() = obj set = {""};
define full()
{
local v;
obj set v;
v.s = M * char(-1);
if (!ismult(N, 8)) v.s[M-1] = 255 >> (8 - N & 7);
return v;
}
define isin(a, b)
{
if (!isset(a) || !isint(b))
quit "Bad argument for isin";
return bit(a.s, b);
}
define addmember(a, n)
{
if (!isset(a) || !isint(n))
quit "Bad argument for addmember";
if (n < N && n >= 0)
setbit(a.s, n);
}
define rmmember(a, n)
{
if (n < N && n >= 0)
setbit(a.s, n, 0);
}
define set()
{
local i, v, s;
s = M * char(0);
for (i = 1; i <= param(0); i++) {
v = param(i);
if (!isint(v))
quit "Non-integral argument for set";
if (v >= 0 && v < N)
setbit(s, v);
}
return mkset(s);
}
define mkset(s)
{
local h, m;
if (!isstr(s))
quit "Non-string argument for mkset";
h = highbit(s);
if (h >= N)
quit "Too-long string for mkset";
m = quo(h + 1, 8, 1);
return obj set = {head(s, m)};
}
define primes(a,b)
{
local i, s, m;
if (isnull(b)) {
if (isnull(a)) {
a = 0;
b = N - 1;
}
else b = 0;
}
if (!isint(a) || !isint(b))
quit "Non-integer argument for primes";
if (a > b)
swap(a,b);
if (b < 0 || a >= N)
return empty();
a = max(a, 0);
b = min(b, N-1);
s = M * char(0);
for (i = a; i <= b; i++)
if (isprime(i))
setbit(s, i);
return mkset(s);
}
define set_max(a) = highbit(a.s);
define set_min(a) = lowbit(a.s);
define set_not(a) = !a.s;
define set_cmp(a,b)
{
if (isset(a) && isset(b))
return a.s != b.s;
return 1;
}
define set_rel(a,b)
{
local c;
if (a == b)
return 0;
if (isset(a)) {
if (isset(b)) {
c = a & b;
if (c == a)
return -1;
if (c == b)
return 1;
return;
}
if (!isint(b))
return set_rel(a, set(b));
}
if (isint(a))
return set_rel(set(a), b);
}
define set_or(a, b)
{
if (isset(a)) {
if (isset(b))
return obj set = {a.s | b.s};
if (isint(b))
return a | set(b);
}
if (isint(a))
return set(a) | b;
return newerror("Bad argument for set_or");
}
define set_and(a, b)
{
if (isint(a))
return set(a) & b;
if (isint(b))
return a & set(b);
if (!isset(a) || !isset(b))
return newerror("Bad argument for set_and");
return mkset(a.s & b.s);
}
define set_comp(a) = full() \ a;
define set_setminus(a,b)
{
if (isint(a))
return set(a) \ b;
if (isint(b))
return a \ set(b);
if (!isset(a) || !isset(b))
return newerror("Bad argument for set_setminus");
return mkset(a.s \ b.s);
}
define set_xor(a,b)
{
if (isint(a))
return set(a) ~ b;
if (isint(b))
return a ~ set(b);
if (!isset(a) || !isset(b))
return newerror("Bad argument for set_xor");
return mkset(a.s ~ b.s);
}
define set_content(a) = #a.s;
define set_add(a, b)
{
local s, i, j, m, n;
if (isint(a))
return set(a) + b;
if (isint(b))
return a + set(b);
if (!isset(a) || !isset(b))
return newerror("Bad argument for set_add");
if (!a || !b)
return empty();
m = highbit(a.s);
n = highbit(b.s);
s = M * char(0);
for (i = 0; i <= m; i++)
if (isin(a, i))
for (j = 0; j <= n && i + j < N; j++)
if (isin(b, j))
setbit(s, i + j);
return mkset(s);
}
define set_sub(a,b)
{
local s, i, j, m, n;
if (isint(b))
return a - set(b);
if (isint(a))
return set(a) - b;
if (isset(a) && isset(b)) {
if (!a || !b)
return empty();
m = highbit(a.s);
n = highbit(b.s);
s = M * char(0);
for (i = 0; i <= m; i++)
if (isin(a, i))
for (j = 0; j <= n && j <= i; j++)
if (isin(b, j))
setbit(s, i - j);
return mkset(s);
}
return newerror("Bad argument for set_sub");
}
define set_mul(a, b)
{
local s, i, j, m, n;
if (isset(a)) {
s = M * char(0);
m = highbit(a.s);
if (isset(b)) {
if (!a || !b)
return empty();
n = highbit(b.s);
for (i = 0; i <= m; ++i)
if (isin(a, i))
for (j = 1; j <= n && i * j < N; ++j)
if (isin(b, j))
setbit(s, i * j);
return mkset(s);
}
if (isint(b)) {
if (b == 0) {
if (a)
return set(0);
return empty();
}
s = M * char(0);
for (i = 0; i <= m && b * i < N; ++i)
if (isin(a, i))
setbit(s, b * i);
return mkset(s);
}
}
if (isint(a))
return b * a;
return newerror("Bad argument for set_mul");
}
define set_square(a)
{
local s, i, m;
s = M * char(0);
m = highbit(a.s);
for (i = 0; i <= m && i^2 < N; ++i)
if (bit(a.s, i))
setbit(s, i^2);
return mkset(s);
}
define set_pow(a, n)
{
local s, i, m;
if (!isint(n) || n < 0)
quit "Bad exponent for set_power";
s = M * char(0);
m = highbit(a.s);
for (i = 0; i <= m && i^n < N; ++i)
if (bit(a.s, i))
setbit(s, i^n);
return mkset(s);
}
define set_sum(a)
{
local v, m, i;
v = 0;
m = highbit(a.s);
for (i = 0; i <= m; ++i)
if (bit(a.s, i))
v += i;
return v;
}
define set_plus(a) = set_sum(a);
define interval(a, b)
{
local i, j, s;
static tail = str("\0\1\3\7\17\37\77\177\377");
if (!isint(a) || !isint(b))
quit "Non-integer argument for interval";
if (a > b)
swap(a, b);
if (b < 0 || a >= N)
return empty();
a = max(a, 0);
b = min(b, N-1);
i = quo(a, 8, 0);
j = quo(b, 8, 0);
s = M * char(0);
if (i == j) {
s[i] = tail[b + 1 - 8 * i] \ tail[a - 8 * i];
return mkset(s);
}
s[i] = ~tail[a - 8 * i];
while (++i < j)
s[i] = -1;
s[j] = tail[b + 1 - 8 * j];
return mkset(s);
}
define isinterval(a)
{
local i, max, s;
if (!isset(a))
quit "Non-set argument for isinterval";
s = a.s;
if (!s)
return 0;
for (i = lowbit(s) + 1, max = highbit(s); i < max; i++)
if (!bit(s, i))
return 0;
return 1;
}
define set_mod(a, b)
{
local s, m, i, j;
if (isset(a) && isint(b)) {
s = M * char(0);
m = highbit(a.s);
for (i = 0; i <= m; i++)
if (bit(a.s, i))
for (j = 0; j < N; j++)
if (meq(i, j, b))
setbit(s, j);
return mkset(s);
}
return newerror("Bad argument for set_mod");
}
define randset(n, a, b)
{
local m, s, i;
if (isnull(a))
a = 0;
if (isnull(b))
b = N - 1;
if (!isint(n) || !isint(a) || !isint(b) || n < 0 || a < 0 || b < 0)
quit "Bad argument for randset";
if (a > b)
swap(a, b);
m = b - a + 1;
if (n > m)
return newerror("Too many numbers specified for randset");
if (2 * n > m)
return interval(a,b) \ randset(m - n, a, b);
++b;
s = M * char(0);
while (n-- > 0) {
do
i = rand(a, b);
while
(bit(s, i));
setbit(s, i);
}
return mkset(s);
}
define polyvals(L, A)
{
local s, m, v, i;
if (!islist(L))
quit "Non-list first argument for polyvals";
if (!isset(A))
quit "Non-set second argument for polyvals";
m = highbit(A.s);
s = M * char(0);
for (i = 0; i <= m; i++)
if (bit(A.s, i)) {
v = poly(L,i);
if (v >> 0 && v < N)
setbit(s, v);
}
return mkset(s);
}
define polyvals2(L, A, B)
{
local s1, s2, s, m, n, i, j, v;
s1 = A.s;
s2 = B.s;
m = highbit(s1);
n = highbit(s2);
s = M * char(0);
for (i = 0; i <= m; i++)
if (bit(s1, i))
for (j = 0; j <= n; j++)
if (bit(s2, j)) {
v = poly(L, i, j);
if (v >= 0 && v < N)
setbit(s, v);
}
return mkset(s);
}
define set_print(a)
{
local i, s, m;
s = a.s;
i = lowbit(s);
print "set(":;
if (i >= 0) {
print i:;
m = highbit(s);
while (++i <= m)
if (bit(s, i))
print ",":i:;
}
print ")",;
}
local N, M; /* End scope of static variables N, M */
if (config("lib_debug") >= 0) {
print "isset(a) defined";
print "setbound(n) defined";
print "empty() defined";
print "full() defined";
print "isin(a, b) defined";
print "addmember(a, n) defined";
print "rmmember(a, n) defined";
print "set() defined";
print "mkset(s) defined";
print "primes(a, b) defined";
print "set_max(a) defined";
print "set_min(a) defined";
print "set_not(a) defined";
print "set_cmp(a, b) defined";
print "set_rel(a, b) defined";
print "set_or(a, b) defined";
print "set_and(a, b) defined";
print "set_comp(a) defined";
print "set_setminus(a, b) defined";
print "set_xor(a,b) defined";
print "set_content(a) defined";
print "set_add(a, b) defined";
print "set_sub(a, b) defined";
print "set_mul(a, b) defined";
print "set_square(a) defined";
print "set_pow(a, n) defined";
print "set_sum(a) defined";
print "set_plus(a) defined";
print "interval(a, b) defined";
print "isinterval(a) defined";
print "set_mod(a, b) defined";
print "randset(n, a, b) defined";
print "polyvals(L, A) defined";
print "polyvals2(L, A, B) defined";
print "set_print(a) defined";
}

3
lib/pell.cal
View File

@@ -67,8 +67,7 @@ define pellx(D)
return Q1;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "pell(D) defined";
print "pellx(D) defined";
}

3
lib/pi.cal
View File

@@ -48,7 +48,6 @@ define qpi(epsilon)
return (bround(1/an, bits));
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "qpi(epsilon) defined";
}

44
lib/pix.cal Normal file
View File

@@ -0,0 +1,44 @@
/*
* Here is an iterative method of finding the number of primes less than
* or equal to a given number. This method is from "Computer Recreations"
* June 1996 issue of Scientific American.
*
* NOTE: For reasonable values of x, the builtin function pix(x) is
* much faster. This code is provided because the method
* is interesting.
*/
define pi_of_x(x)
{
local An; /* A(n) */
local An1; /* A(n-1) */
local An2; /* A(n-2) */
local An3; /* A(n-3) */
local primes; /* number of primes found */
local n; /* loop counter */
/*
* setup
*/
An1 = 2;
An2 = 0;
An3 = 3;
primes = 1;
/*
* main A(n+1)=A(n-1)+A(n-2) sequence loop
*/
for (n = 3; n < x; ++n) {
An = An2 + An3;
An3 = An2;
An2 = An1;
An1 = An;
if (An % n == 0)
++primes;
}
return primes;
}
if (config("lib_debug") >= 0) {
print "pi_of_x(x) defined";
}

3
lib/pollard.cal
View File

@@ -29,7 +29,6 @@ define factor(N, B, ai, af)
return 1;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "factor(N, B, ai, af) defined";
}

3
lib/poly.cal
View File

@@ -687,8 +687,7 @@ a=pol(1,4,4,2,3,1);
b=pol(5,16,8,1);
c=pol(1+2i,3+4i,5+6i);
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "obj poly {p} defined";
print "pol() defined";
print "poly_print(a) defined";

3
lib/prompt.cal
View File

@@ -95,8 +95,7 @@ define showvalues(str) {
}
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "adder() defined";
print "showvalues(str) defined";
}

3
lib/psqrt.cal
View File

@@ -50,7 +50,6 @@ define psqrt(u, p)
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "psqrt(u, p) defined";
}

3
lib/quat.cal
View File

@@ -195,8 +195,7 @@ define quat_shift(a, b)
return x.s;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "obj quat {s, v} defined";
print "quat(a, b, c, d) defined";
print "quat_print(a) defined";

5
lib/randbitrun.cal
View File

@@ -1,5 +1,5 @@
/*
* randbitrun - check rand bit run lengths
* randbitrun - check rand bit run lengths of the a55 generator
*
* We will use randbit(1) to generate a stream if single bits.
* The odds that we will have n bits the same in a row is 1/2^n.
@@ -113,7 +113,6 @@ define randbitrun(run_cnt)
printf("max length=%d\n", max_run);
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "randbitrun([run_length]) defined";
}

12
lib/randmprime.cal
View File

@@ -1,7 +1,7 @@
/*
* randmprime - generate a random prime of the form h*2^n-1
*
* Copyright (c) 1995 by Landon Curt Noll. All Rights Reserved.
* Copyright (c) 1997 by Landon Curt Noll. All Rights Reserved.
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted,
@@ -25,7 +25,6 @@
*/
/* obtain our required libs */
read -once "cryrand.cal"
read -once "lucas.cal"
/*
@@ -33,7 +32,7 @@ read -once "lucas.cal"
*
* given:
* bits minimum bits in prime to return
* seed random seed for scryrand()
* seed random seed for srandom()
* [dbg] if given, enable debugging
*
* returns:
@@ -66,11 +65,11 @@ randmprime(bits, seed, dbg)
}
/* seed generator */
tmp = scryrand(seed);
tmp = srandom(seed, 13);
/* determine initial h and n values */
n = random(bits>>1, highbit(bits)+bits>>1+1);
h = cryrand(n);
h = randombit(n);
h += iseven(h);
while (highbit(h) >= n) {
++n;
@@ -131,7 +130,6 @@ randmprime(bits, seed, dbg)
return ret;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "randmprime(bits, seed [,dbg]) defined";
}

118
lib/randombitrun.cal Normal file
View File

@@ -0,0 +1,118 @@
/*
* randombitrun - check rand bit run lengths of random()
*
* We will use randombit(1) to generate a stream if single bits.
* The odds that we will have n bits the same in a row is 1/2^n.
*/
/*
* Copyright 1997 by Landon Curt Noll. All Rights Reserved.
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted,
* provided that the above copyright, this permission notice, and the
* disclaimer below appear in all of the following:
*
* * supporting documentation
* * source copies
* * source works derived from this source
* * binaries derived from this source or from derived source
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*/
define randombitrun(run_cnt)
{
local i; /* index */
local max_run; /* longest run */
local long_run_cnt; /* number of runs longer than MAX_RUN */
local run; /* current run length */
local tally_sum; /* sum of all tally values */
local last; /* last random number */
local current; /* current random number */
local MAX_RUN = 18; /* max run we will keep track of */
local mat tally[1:MAX_RUN]; /* tally of length of a rise run of 'x' */
local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */
/*
* parse args
*/
if (param(0) == 0) {
run_cnt = 65536;
}
/*
* run setup
*/
max_run = 0; /* no runs yet */
long_run_cnt = 0; /* no long runs set */
current = randombit(1); /* our first number */
run = 1;
/*
* compute the run length probabilities
*
* A bit run length of 'r' occurs with a probability of:
*
* 1/2^n;
*/
for (i=1; i <= MAX_RUN; ++i) {
prob[i] = 1.0/(1<<i);
}
/*
* look at a number of random number trials
*/
for (i=0; i < run_cnt; ++i) {
/* get our current number */
last = current;
current = randombit(1);
/* look for a run break */
if (current != last) {
/* record the stats */
if (run > max_run) {
max_run = run;
}
if (run > MAX_RUN) {
++long_run_cnt;
} else {
++tally[run];
}
/* start a new run */
current = randombit(1);
run = 1;
/* note the continuing run */
} else {
++run;
}
}
/* determine the number of runs found */
tally_sum = matsum(tally) + long_run_cnt;
/*
* print the stats
*/
printf("random runbit test used %d values to produce %d runs\n",
run_cnt, tally_sum);
for (i=1; i <= MAX_RUN; ++i) {
printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n",
i, prob[i], round(tally_sum*prob[i]), tally[i],
(tally[i] - round(tally_sum*prob[i]))/tally_sum);
}
printf("length>%d\t\t\t\t\tcount=%d\n", MAX_RUN, long_run_cnt);
printf("max length=%d\n", max_run);
}
if (config("lib_debug") >= 0) {
print "randombitrun([run_length]) defined";
}

127
lib/randomrun.cal Normal file
View File

@@ -0,0 +1,127 @@
/*
* randomrun - perform a run test on random()
*
* If X(j) < X(j+1) < ... X(j+k) >= X(j+k+1), then we have a run of 'k'.
* We ignore the run breaker, X(j+k+1), and start with X(j+k+2) when
* considering a new run in order to make our runs chi independent.
*
* See Knuth's "Art of Computer Programming - 2nd edition",
* Volume 2 ("Seminumerical Algorithms"), Section 3.3.2.
* "G. Run test", pp. 65-68,
* "problem #14", pp. 74, 536.
*
* We use the suggestion in problem #14 to allow an application of the
* chi-square test and to make estimating the run length probs easy.
*/
/*
* Copyright 1997 by Landon Curt Noll. All Rights Reserved.
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted,
* provided that the above copyright, this permission notice, and the
* disclaimer below appear in all of the following:
*
* * supporting documentation
* * source copies
* * source works derived from this source
* * binaries derived from this source or from derived source
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*/
define randomrun(run_cnt)
{
local i; /* index */
local max_run; /* longest run */
local long_run_cnt; /* number of runs longer than MAX_RUN */
local run; /* current run length */
local tally_sum; /* sum of all tally values */
local last; /* last random number */
local current; /* current random number */
local MAX_RUN = 9; /* max run we will keep track of */
local mat tally[1:MAX_RUN]; /* tally of length of a rise run of 'x' */
local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */
/*
* parse args
*/
if (param(0) == 0) {
run_cnt = 65536;
}
/*
* run setup
*/
max_run = 0; /* no runs yet */
long_run_cnt = 0; /* no long runs set */
current = random(); /* our first number */
run = 1;
/*
* compute the run length probabilities
*
* A run length of 'r' occurs with a probability of:
*
* 1/r! - 1/(r+1)!
*/
for (i=1; i <= MAX_RUN; ++i) {
prob[i] = 1.0/fact(i) - 1.0/fact(i+1);
}
/*
* look at a number of random number trials
*/
for (i=0; i < run_cnt; ++i) {
/* get our current number */
last = current;
current = random();
/* look for a run break */
if (current < last) {
/* record the stats */
if (run > max_run) {
max_run = run;
}
if (run > MAX_RUN) {
++long_run_cnt;
} else {
++tally[run];
}
/* start a new run */
current = random();
run = 1;
/* note the continuing run */
} else {
++run;
}
}
/* determine the number of runs found */
tally_sum = matsum(tally) + long_run_cnt;
/*
* print the stats
*/
printf("random run test used %d values to produce %d runs\n",
run_cnt, tally_sum);
for (i=1; i <= MAX_RUN; ++i) {
printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n",
i, prob[i], round(tally_sum*prob[i]), tally[i],
(tally[i] - round(tally_sum*prob[i]))/tally_sum);
}
printf("length>%d\t\t\t\t\tcount=%d\n", MAX_RUN, long_run_cnt);
printf("max length=%d\n", max_run);
}
if (config("lib_debug") >= 0) {
print "randomrun([run_length]) defined";
}

3
lib/randrun.cal
View File

@@ -122,7 +122,6 @@ define randrun(run_cnt)
printf("max length=%d\n", max_run);
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "randrun([run_length]) defined";
}

4446
lib/regress.cal
View File

File diff suppressed because it is too large Load Diff

82
lib/seedrandom.cal
View File

@@ -22,27 +22,33 @@
* chongo was here /\../\ chongo@toad.com
*/
global lib_debug; /* 1 => print debug statements */
/*
* seedrandom - seed the cryptographically strong Blum generator
*
* This function will seed the random() generator using a method
* similar to method suggested for the paranoid in the zrand.c source
* file and random help file.
*
* The period of a Blum generators with modulus 'n=p*q' (where p and
* q are primes 3 mod 4) is:
*
* lambda(n) = lcm(factors of p-1 & q-1)
*
* One can construct a generator with a maximal period when
* 'p' and 'q' have the fewest possible factors in common.
* The quickest way to select such primes is only use 'p'
* and 'q' when '(p-1)/2' and '(q-1)/2' are both primes.
* This function will seed the random() generator that uses
* such primes.
*
* given:
* seed1 - a large random value (at least 10^20 and perhaps < 10^93)
* seed2 - a large random value (at least 10^20 and perhaps < 10^93)
* size - min Blum modulus as a power of 2 (at least 100, perhaps > 1024)
* seed1 - a large random value (at least 10^20 and perhaps < 10^314)
* seed2 - a large random value (at least 10^20 and perhaps < 10^314)
* size - min Blum modulus as a power of 2 (at least 32, perhaps >= 512)
* trials - number of ptest() trials (default 25)
*
* returns:
* the previous random state
*
* NOTE: The [10^20, 10^93) range comes from [2^64, 2^64*fact(55)) range
* where seeds are effective for srand(). All we really need to
* do is to insist that a seed is > 2^64, which the 10^20 limit does.
* NOTE: The [10^20, 10^314) range comes from the fact that the 13th internal
* modulus is ~10^315. We want the lower bound seed to be reasonably big.
*/
define seedrandom(seed1, seed2, size, trials)
{
@@ -55,10 +61,9 @@ define seedrandom(seed1, seed2, size, trials)
local n; /* Blum modulus */
local binsize; /* smallest power of 2 > n=p*q */
local r; /* initial quadratic residue */
local rand_state; /* the initial rand state */
local rand_junk; /* rand state that is not needed */
local random_state; /* the initial rand state */
local random_junk; /* rand state that is not needed */
local old_state; /* old random state to return */
local random_cfg; /* old srandom configuration value */
/*
* firewall
@@ -76,14 +81,13 @@ define seedrandom(seed1, seed2, size, trials)
trials = 25;
}
if (digits(seed1) <= 20) {
quit "1st arg (seed1) must be > 10^20 and perhaps < 10^93";
quit "1st arg (seed1) must be > 10^20 and perhaps < 10^314";
}
if (digits(seed2) <= 20) {
quit "2nd arg (seed2) must be > 10^20 and perhaps < 10^93";
quit "2nd arg (seed2) must be > 10^20 and perhaps < 10^314";
}
if (size < 100) {
/* 3% of 100 is 2.97 < 3 whereas 3% of 100 is 3 */
quit "3rd arg (size) needs to be > 66 (perhaps >= 1024)";
if (size < 32) {
quit "3rd arg (size) needs to be >= 32 (perhaps >= 512)";
}
if (trials < 1) {
quit "4th arg (trials) must be > 0";
@@ -99,38 +103,54 @@ define seedrandom(seed1, seed2, size, trials)
/*
* find the first Blum prime
*/
rand_state = srand(seed1);
random_state = srandom(seed1, 13);
do {
fp = nextcand(2^sp+randbit(sp), trials, 0, 3, 4);
p = 2*fp+1;
} while (ptest(p,trials) == 0);
do {
fp = nextcand(2^sp+randombit(sp), 1, 1, 3, 4);
p = 2*fp+1;
} while (ptest(p,1,0) == 0);
} while(ptest(p, trials) == 0 || ptest(fp, trials) == 0);
if (config("lib_debug") > 0) {
print "/* 1st Blum prime */ p=", p;
}
/*
* find the 2nd Blum prime
*/
rand_junk = srand(seed2);
random_junk = srandom(seed2, 13);
do {
fq = nextcand(2^sq+randbit(sq), trials, 0, 3, 4);
q = 2*fq+1;
} while (ptest(q,trials) == 0);
do {
fq = nextcand(2^sq+randombit(sq), 1, 1, 3, 4);
q = 2*fq+1;
} while (ptest(q,1,0) == 0);
} while(ptest(q, trials) == 0 || ptest(fq, trials) == 0);
if (config("lib_debug") > 0) {
print "/* 2nd Blum prime */ q=", q;
}
/*
* seed the Blum generator
*/
n = p*q; /* the Blum modulus */
binsize = higbbit(n)+1; /* smallest power of 2 > p*q */
binsize = highbit(n)+1; /* smallest power of 2 > p*q */
r = pmod(rand(1<<ceil(binsize*4/5), 1<<(binsize-2)), 2, n);
random_cfg = config("srandom", 0); /* no checks are needed */
if (config("lib_debug") >= 0) {
print "/* seed quadratic residue */ r=", r;
print "/* newn", binsize, "bit quadratic residue*/ newn=", n;
}
old_state = srandom(r, n);
/*
* restore other states that we altered
*/
rand_junk = srand(rand_state);
rand_junk = config("srandom", random_cfg);
random_junk = srandom(random_state);
/*
* return the previous random state
*/
return old_state;
}
if (config("lib_debug") >= 0) {
print "seedrandom(seed1, seed2, size [, trials]) defined";
}

3
lib/solve.cal
View File

@@ -42,7 +42,6 @@ define solve(low, high, epsilon)
}
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "solve(low, high, epsilon) defined";
}

3
lib/sumsq.cal
View File

@@ -38,7 +38,6 @@ define ss(p)
print a : "^2 +" , b : "^2 =" , a^2 + b^2;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "ss(p) defined";
}

3
lib/surd.cal
View File

@@ -261,8 +261,7 @@ define surd_rel(a, b)
return sgn(x^2 - y^2 * surd_type) * sgn(x);
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "obj surd {a, b} defined";
print "surd(a, b) defined";
print "surd_print(a) defined";

4
lib/test1700.cal
View File

@@ -10,3 +10,7 @@
*/
++value;
if (config("lib_debug") >= 0) {
/* nothing to do */
}

4
lib/test2300.cal
View File

@@ -95,3 +95,7 @@ define ckmat()
/* args match the matrix in the object */
return 1;
}
if (config("lib_debug") >= 0) {
/* nothing to do */
}

3
lib/test2600.cal
View File

@@ -492,8 +492,7 @@ define test2600(verbose, tnum)
return tnum;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "global defaultverbose defined";
print "global err defined";
print "testismult(str,n,verbose) defined";

3
lib/test2700.cal
View File

@@ -309,8 +309,7 @@ define test2700(verbose, tnum)
return tnum;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "global defaultverbose defined";
print "global err defined";
print "mknonnegreal() defined";

3
lib/test3100.cal
View File

@@ -18,8 +18,7 @@ define res_neg(a) {local obj res v = {(-a.r) % md}; return v;};
define res_inv(a) {local obj res v = {minv(a.r, md)}; return v;};
define res(x) {local obj res v = {x % md}; return v;};
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "obj res defined";
print "global md defined";
print "res_test(a) defined";

4
lib/test3300.cal
View File

@@ -123,9 +123,7 @@ define test3300(verbose, tnum)
return tnum;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "global defaultverbose defined";
print "global err defined";
print "testi(str, n, N, verbose) defined";

4
lib/test3400.cal
View File

@@ -300,9 +300,7 @@ define test3400(verbose, tnum)
return tnum;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "global defaultverbose defined";
print "global err defined";
print "test3401(str, n, eps, verbose) defined";

3
lib/test3500.cal
View File

@@ -273,8 +273,7 @@ define test3500(verbose, tnum, n, N)
return tnum;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "global defaultverbose defined";
print "global err defined";
print "testfrem(x, y, verbose) defined";

4
lib/test4000.cal
View File

@@ -454,9 +454,7 @@ define test4000(v, tnum)
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "global defaultverbose";
print "global err";
print "global BASEB";

4
lib/test4100.cal
View File

@@ -473,9 +473,7 @@ define test4100(v, tnum)
return tnum;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "global defaultverbose";
print "global err";
print "global K1";

29
lib/test4600.cal
View File

@@ -28,7 +28,7 @@ define stest(str, verbose)
if (verbose > 0) {
print str:":",:;
}
x = rm("junk4600");
x = rm("-f", "junk4600");
/*
* do file operations
@@ -92,14 +92,14 @@ define stest(str, verbose)
print '**** rsearch(f, "and") != 109 failed';
return 1;
}
if (ftell(f) != 112) {
if (ftell(f) != 111) {
print 'failed';
print '**** ftell(f) != 112 failed';
print '**** ftell(f) != 111 failed';
return 1;
}
if (iserror(fseek(f, -1, 1))) {
if (iserror(fseek(f, -4, 1))) {
print 'failed';
print '**** iserror(fseek(f, -1, 1)) failed';
print '**** iserror(fseek(f, -4, 1)) failed';
return 1;
}
if (rsearch(f, "and") != 10) {
@@ -107,14 +107,14 @@ define stest(str, verbose)
print '**** rsearch(f, "and") != 10 failed';
return 1;
}
if (ftell(f) != 13) {
if (ftell(f) != 12) {
print 'failed';
print '**** ftell(f) != 13 failed';
print '**** ftell(f) != 12 failed';
return 1;
}
if (iserror(fseek(f, -1, 1))) {
if (iserror(fseek(f, -4, 1))) {
print 'failed';
print '**** iserror(fseek(f, -1, 1)) failed';
print '**** iserror(fseek(f, -4, 1)) failed';
return 1;
}
if (!isnull(rsearch(f, "and"))) {
@@ -152,7 +152,7 @@ define ttest(str, m, n, verbose)
if (verbose > 0) {
print str:":",:;
}
i = rm("junk4600");
i = rm("-f", "junk4600");
f = fopen("junk4600", "w");
if (isnull(n))
@@ -168,13 +168,14 @@ define ttest(str, m, n, verbose)
j = 1 + randbit(n);
a = "";
while (j-- > 0)
a = strcat(a, char(rand(1, 256)));
a = strcat(a, char(rand(32, 127)));
A[i] = a;
fputs(f, a);
pos[i+1] = ftell(f);
if (verbose > 1)
printf("A[%d] has length %d\n", i, strlen(a));
}
fflush(f);
if (verbose > 1)
printf("File has size %d\n", pos[i]);
freopen(f, "r");
@@ -216,7 +217,7 @@ define ttest(str, m, n, verbose)
break;
fseek(f, -1, 1);
}
if (ftell(f) != pos[i + 1]) {
if (ftell(f) != pos[i + 1] - 1) {
print 'failed';
printf("**** Failure 5 for i = %d\n", i);
return 1;
@@ -299,9 +300,7 @@ define test4600(v, tnum)
return tnum;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "stest(str [, verbose]) defined";
print "ttest([m, [n [,verbose]]]) defined";
print "sprint(x) defined";

56
lib/test5100.cal Normal file
View File

@@ -0,0 +1,56 @@
/*
* Copyright (c) 1996 Ernest Bowen and Landon Curt Noll
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*
* By: Ernest Bowen and Landon Curt Noll
* ernie@neumann.une.edu.au and chongo@toad.com
*
* This library is used by the 5100 series of the regress.cal test suite.
*/
global defaultverbose = 1; /* default verbose value */
global err;
/*
* test5100 - test the new code generator declaration scope and order
*
* In this function two static variables a5100 and b5100 are created,
* with zero value, when the definition is read.
*
* The variable a5100 is initialized with the value x if and when this
* function is first called with a positive even x. The varable b5100
* is similarly initialized if and when this function is first called positive
* odd x.
*
* Each time this function is called with positive integer x, a5100 or
* b5100 is incremented.
*
* Finally the values of the static variables are assigned to the global
* variables a5100 and b5100.
*
* Immediately after the last of several calls to this function
* a5100 = 0 if none of the x's have been positive even, otherwise
* a5100 = the first positive even x + the number of positive even x's,
* and b5100 = 0 if none of the x's have been positive odd, otherwise
* b5100 = the first positive odd x + the number of positive odd x's.
*/
define test5100(x)
{
if (isint(x) && x > 0) {
if (iseven(x)) {
static a5100 = x;
a5100++;
} else {
static b5100 = x;
b5100++;
}
}
global a5100 = a5100, b5100 = b5100;
}
if (config("lib_debug") >= 0) {
print "global a5100";
print "global b5100";
print "test5100(x) defined";
}

40
lib/test5200.cal Normal file
View File

@@ -0,0 +1,40 @@
/*
* Copyright (c) 1996 Ernest Bowen and Landon Curt Noll
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*
* By: Ernest Bowen and Landon Curt Noll
* ernie@neumann.une.edu.au and chongo@toad.com
*
* This library is used by the 5200 series of the regress.cal test suite.
*/
global defaultverbose = 1; /* default verbose value */
global err;
/*
* test the fix of a global/static bug
*
* Given the following:
*
* global a = 10;
* static a = 20;
* define f(x) = a + x;
* define g(x) {global a = 30; return a + x;}
* define h(x) = a + x;
*
* Older versions of
*/
global a5200 = 10;
static a5200 = 20;
define f5200(x) = a5200 + x;
define g5200(x) {global a5200 = 30; return a5200 + x;}
define h5200(x) = a5200 + x;
if (config("lib_debug") >= 0) {
print "global a5200";
print "static a5200";
print "f5200(x) defined";
print "g5200(x) defined";
print "h5200(x) defined";
}

3
lib/unitfrac.cal
View File

@@ -29,7 +29,6 @@ define unitfrac(x)
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "unitfrac(x) defined";
}

3
lib/varargs.cal
View File

@@ -23,7 +23,6 @@ define sc()
return s;
}
global lib_debug;
if (lib_debug >= 0) {
if (config("lib_debug") >= 0) {
print "sc(a, b, ...) defined";
}

283
lib/xx_print.cal Normal file
View File

@@ -0,0 +1,283 @@
/*
* Copyright (c) 1997 Ernest Bowen
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*
* By: Ernest Bowen <ernie@neumann.une.edu.au>
*/
/*
* xx_print - demo print object routines
*/
global listmax = 3;
global matrowmax = 3;
global matcolmax = 3;
print "globals listmax, matrowmax, matcolmax defined; all assigned value 3";
print;
global blkmax = 8;
print "global blkmax defined, assigned value 8";
print;
B = blk();
define isoctet(a) = istype(a, B[0]);
define list_print(a) {
local i;
print "(":;
for (i = 0; i < size(a); i++) {
if (i > 0)
print ",":;
if (i >= listmax) {
print "...":;
break;
}
print a[[i]]:;
}
print ")":;
}
define mat_print (a) {
local i, j;
if (matdim(a) == 1) {
for (i = 0; i < size(a); i++) {
if (i >= matrowmax) {
printf(" ...");
break;
}
printf("%8d", a[i]);
}
return;
}
if (matdim(a) > 2)
quit "Dimension for mat_print greater than 2";
for (i = matmin(a,1); i <= matmax(a,1); i++) {
if (i >= matmin(a,1) + matcolmax) {
print " ...";
break;
}
for (j = matmin(a,2); j <= matmax(a,2); j++) {
if (j >= matmin(a,2) + matrowmax) {
printf(" ...");
break;
}
printf("%8d", a[i,j]);
}
print;
}
}
define octet_print(a) {
switch(a) {
case 8: print "BS":;
return;
case 9: print "HT":;
return;
case 10: print "NL":;
return;
case 12: print "FF":;
return;
case 13: print "CR":;
return;
case 27: print "ESC":;
return;
}
if (a > 31 && a < 127)
print char(a):;
else
print "Non-print":;
}
define blk_print(a) {
local i, n;
n = size(a);
printf("Unnamed block with %d bytes of data\n", n);
print "First few characters: ":;
for (i = 0; i < n; i++) {
if (i >= blkmax) {
print "...",;
break;
}
print a[i],;
}
}
define nblk_print (a) {
local n, i;
n = size(a);
printf("Block named \"%s\" with %d bytes of data\n", name(a), n);
print "First few characters: ":;
for (i = 0; i < n; i++) {
if (i >= blkmax) {
print "...",;
break;
}
print a[i],;
}
}
define strchar(a) {
if (isstr(a))
a = ord(a);
else if (isoctet(a))
a = a; /* This converts octet to number */
else if (!isint(a) || a < 0 || a > 255)
quit "Bad argument for strchar";
switch (a) {
case 7: print "\\a":;
return;
case 8: print "\\b":;
return;
case 9: print "\\t":;
return;
case 10: print "\\n":;
return;
case 11: print "\\v":;
return;
case 12: print "\\f":;
return;
case 13: print "\\r":;
return;
case 27: print "\\e":;
return;
case 34: print "\\\"":;
return;
case 39: print "\\\'":;
return;
case 92: print "\\\\":;
return;
}
if (a > 31 && a < 127) {
print char(a):;
return;
}
print "\\":;
if (a >= 64) print a // 64:;
a = a % 64;
if (a >= 8) print a // 8:;
a = a % 8;
print a:;
}
define file_print(a) {
local c;
rewind(a);
for (;;) {
c = fgetc(a);
if (iserror(c))
quit "Failure when reading from file";
if (isnull(c))
break;
strchar(c);
}
print;
}
define error_print(a) {
local n = iserror(a);
if (n == 10001) {
print "1/0":;
return;
}
if (n == 10002) {
print "0/0":;
return;
}
print strerror(a):;
}
L = list(1,2,3,4,5);
mat M1[5] = {1,2,3,4,5};
mat M2[4,4] = {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16};
B1 = blk() = {"A", "B", "C", "D"};
B2 = blk("sample") = {77, 102, 29, 13, 126, 8, 100, 27, 0, 1};
dummy = rm("-f", "xx_print.foo");
f = fopen("xx_print.foo", "w+");
fputstr(f, "alpha\nbeta\f\"gamma\"");
fputstr(f, "\x09delta\n");
fputstr(f, "\1\2\3");
fflush(f);
print "Here is a list:";
print L;
print;
print "A one-dimensional matrix:";
print M1;
print;
print "A two-dimensional matrix:";
print M2;
print;
print "An unnamed block:";
print B1;
print;
print "A named block with some special octets:";
print B2;
print;
print "A file:";
print f;
print;
undefine mat_print;
fclose(f);
print "f closed";
print;
dummy = rm("-f", "xx_print.foo");
mat M[7] = {1, 2, 3/0, 0/0, eval(2+3), fgetc(f), 7};
print "Here is a matrix with some \"errors\" as elements":
print M;
print;
define octet_print(a) {
local b, x;
x = a;
for (b = 128; b; b >>= 1)
print (x >= b ? (x -= b, 1) : 0):;
}
print "Here is the earlier block with a new octet_print()";
print B1;
print;
if (config("lib_debug") >= 0) {
print "isoctet(a) defined";
print "list_print(a) defined";
print "mat_print (a) defined";
print "octet_print(a) defined";
print "blk_print(a) defined";
print "nblk_print (a) defined";
print "strchar(a) defined";
print "file_print(a) defined";
print "error_print(a) defined";
}