diff --git a/BUGS b/BUGS index f4d08f9..3cc7839 100644 --- a/BUGS +++ b/BUGS @@ -10,7 +10,8 @@ If that does not help, cd to the calc source directory and try: Look at the end of the output, it should say something like: - 9999: passed all tests /\../\ + 9998: passed all tests /\../\ + 9999: Ending regression tests If it does not, then something is really broken! @@ -79,16 +80,11 @@ of a context diff patch) to: Known problems or mis-features: - * In calc2.10.2t3, when scan() reads characters from stdin, they - are not echoed. This also happens with fgets(files(0)) and - fgetline(files(0)). Reports indicate that this did not happen in - calc.2.10.1t20 but did in 2.10.2t0. - - * Many of LIBRARY, LIMITS and SEE ALSO sections of help files + * Many of and SEE ALSO sections of help files for builtins are either inconsistent or missing information. - * The functions filepos2z() and z2filepos() do not work (or - worse do not compile) when FILEPOS is 64 bits long. + * Many of the LIBRARY sections are incorrect now that libcalc.a + contains most of the calc system. * There is some places in the source with obscure variable names and not much in the way of comments. We need some major cleanup diff --git a/CHANGES b/CHANGES index 868310f..2c5bf3b 100644 --- a/CHANGES +++ b/CHANGES @@ -1,4 +1,1889 @@ -Following is the change from calc version 2.10.2t25 to date: +Following is the change from calc version 2.10.3t5.38 to date: + + Fixed a bug discovered by Ernest Bowen related to matrix-to-matrix copies. + + Bitwise operations on integers have been extended so that negative + integers are treated in the same way as the integer types in C. + + Some changes have been made to lib/regress.cal and lib/natnumset.cal. + + Removed V_STRLITERAL and V_STRALLOC string type constants and + renumbered the V_protection types. + + Added popcnt(x, bitval) builtin which counts the number of + bits in x that match bitval. + + Misc compiler warning fixes. + + Fixed improper use of putchar() and printf() when printing rationals + (inside qio.c). + + Fixed previously reported bug in popcnt() in relation to . values. + + Calc man page changes per suggestion from Martin Buck + . The calc man page is + edited with a few more parameters from the Makefile. + + Misc Makefile changes per Martin Buck . + + Removed trailing blanks from files. + + Consolidated in the Makefile, where the debug and check rules are found. + Fixed the regress.cal dependency list. + + Make chk and check will exit with an error if check.awk detects + a problem in the regression output. (Martin Buck) + + Fixed print line for test #4404. + + Moved custom.c and custom.h to the upper level to fix unresolved symbols. + + Moved help function processing into help.c. + + Moved nearly everything into libcalc.a to allow programs access to + higher level calc objects (e.g., list, assoc, matrix, block, ...). + + Renamed PATCH_LEVEL to MAJOR_PATCH and SUB_PATCH_LEVEL to MINOR_PATCH. + Added integers calc_major_ver, calc_minor_ver, calc_major_patch + and string calc_minor_patch to libcalc.a. Added CALC_TITLE to hold + the "C-style arbitrary precision calculator" string. + + The function version(), now returns a malloced version string + without the title. + + +Following is the change from calc version 2.10.3t5.34 to 2.10.3t5.37: + + Per request from David I Bell, the README line: + + I am allowing this calculator to be freely distributed for personal uses + + to: + + I am allowing this calculator to be freely distributed for your enjoyment + + Added help files for: + + address agd arrow dereference free freeglobals freeredc freestatics + gd isptr mattrace oldvalue saveval & * -> and . + + Fixed blkcpy() and copy() arg order and processing. Now: + + A = blk() = {1,2,3,4} + B = blk() + blkcpy(B,A) + blkcpy(B,A) + + will result in B being twice as long as A. + + Since "make chk" pipes the regression output to awk, we cannot + assume that stdout and stderr are ttys. Tests #5985 and #5986 + have been removed for this reason. (thanks to Martin Buck + for this report) + + Fixed the order of prints in regress.cal. By convention, a print + of a test line happens after the test. This is because function + parsed messages occur after the function is parsed. Also the + boolean tesrt of vrfy happens before any print statement. + Therefore a non-test line is tested and printed as follows: + + y = sha(); + print '7125: y = sha()'; + + The perm(a,b) and comb(a,b) have been extented to arbitrary real a and + integer b. + + Fixed a bug in minv(). + + Moved string.c into libcalc.a. + + The NUMBER union was converted back into a flat structure. Changes + where 'num' and 'next' symbols were changed to avoid #define conflicts + were reverse since the #define's needed to support the union went away. + + Removed trailing blanks from files. + + Ernest Bowen sent in the following patch + which is described in the next 34 points: + + (0) In the past: + + A = B = strcat("abc", "def"); + + would store "abc" and "def" as literal strings never to be freed, and + store "abcdef" once each for both A and B. Now the "abc" and "bcd" + are freed immediately after they are concatenated and "abcdef" is stored + only once, just as the number 47 would be stored only once for + + A = B = 47; + + The new STRING structure that achieves this stores not only the + address of the first character in the string, but also the "length" + with which the string was created, the current "links" count, and + when links == 0 (which indicates the string has been freed) the + address of the next freed STRING. Except for the null string "", + all string values are "allocated"; the concept of literal string + remains for names of variables, object types and elements, etc. + + (1) strings may now include '\0', as in A = "abc\0def". In normal printing + this prints as "abc" and strlen(A) returns 3, but its "real" length + of 7 is given by size(A). (As before there is an 8th zero character + and sizeof(A) returns 8.) + + (2) If A is an lvalue whose current value is a string of size n, then + for 0 <= i < n, A[i] returns the character with index i as an addressed + octet using the same structure as for blocks, i.e. there is no + distinction between a string-octet and a block-octet. The same + operations and functions can be used for both, and as before, an octet + is in some respects a number in [0,256) and in others a one-character + string. For example, for A = "abc\0def" one will have both A[0] == "a" + and A[0] == 97. Assignments to octets can be used to change + characters in the string, e.g. A[0] = "A", A[1] = 0, A[2] -= 32, + A[3] = " " will change the above A to "A\0C def". + + (3) "show strings" now displays the indices, links, length, and some or all + of the early and late characters in all unfreed strings which are values + of lvalues or occur as "constants" in function definitions, + using "\n", "\t", "\0", "\252", etc. when appropriate. For example, + the string A in (1) would be displayed as in the definition there. + Only one line is used for each string. I've also changed the + analogous "show numbers" so that only some digits of numbers that + would require more than one line are displayed. + + (4) "show literals" is analogous to "show constants" for number "constants" + in that it displays only the strings that have been introduced by + literal strings as in A = "abc". There is a major difference between + strings and numbers in that there are operations by which characters + in any string may be changed. For example, after A = "abc", + A[0] = "X" changes A to "Xbc". It follows that if a literal string + is to be constant in the sense of never changing, such a character- + changing operation should never be applied to that string. + + In this connection, it should be noted that if B is string-valued, then + + A = B + + results in A referring to exactly the same string as B rather than to + a copy of what is in B. Thie is like the use of character-pointers in + C, as in + + char *s1, *s2; + s1 = "abc"; + s2 = s1; + + To achieve the effect of + + s2 = (char *) malloc(4); + strcpy(s2, s1); + + I have extended the str() function to accept a string as argument. Then + + A = str(B); + + will create a new string at a different location from that of B but + with the same length and characters. One will then have A == B, + *A == *B, but &*A != &*B, &A[0] != &B[0]. + + To assist in analyzing this sort of thing, I have defined a links() + function which for number or string valued argument returns the number + of links to the occurrence of that argument that is being referred to. + For example, supposing "abc" has not been used earlier: + + > A = "abc" + > links(A) + 2 + > links(A) + 1 + + The two links in the first call are to A and the current "oldvalue"; + in the second call, the only link is to A, the oldvalue now being 2. + + + (5) strcat(S1, S2, ...) works as before; contribution of a string stops when + '\0' is encountered. E.g. + + strcat("abc\0def", "ghi") + + will return "abcghi". + + (6) For concatenation of full strings I have chosen to follow + some other languages (like Java, but not Mathematica which uses "<>") + and use "+" so that, e.g. + + "abc\0def" + "ghi" + + returns the string "abc\0defghi". This immediately gives obvious + meanings to multiplication by positive integers as in + + 2 * "abc" = "abc" + "abc" = "abcabc", + + to negation to reverse as string as in + + - "abc" = "cba", + + to multiplication by fractions as in + + 0.5 * "abcd" = "ab", + + (where the length is int(0.5 * size("abcd")), and finally, by combining + these to + + k * A and A * k + + for any real number k and any string A. In the case of k == 1, these + return a new string rather than A itself. (This differs from + "" + A and A + "" which return A.) + + (7) char(x) has been changed so that it will accept any integer x or octet + as argument and return a string of size one with character value + x % 256. In the past calc has required 0 <= x < 256; now negative + x is acceptable; for example, 1000 * char(-1) will now produce the + same as 1000 * "\377" or 1000 * "\xff". + + (8) For a string s, test(s) now returns zero not only for the null string + "" but also for a string all of whose characters are '\0'. + + (9) Similarly <, <=, etc. now compare all characters including occurrences + of '\0' until a difference is encountered or the end of a string is + reached. If no difference is encountered but one string is longer than + the other, the longer string is considered as greater even if the + remaining characters are all '\0'. + + (10) To retain the C sense of comparison of null-terminated strings I have + defined strcmp(S1, S2), and then, for completeness, strncmp(S1, S2, n). + For similar reasons, strcpy(S1, S2) and strncpy(S1, S2, n) have been + defined. + + (11) For strings, I have defined | and & as bitwise "or" and "and" + functions, with S1 | S2 having the size of the larger of S1 and S2, + S1 & S2 having the size of the smaller of S1 and S2. By using, say, + 4-character strings, one can simulate a C integral type so far as the + | and & operations are concerned. It then seemed appropriate to + use the operator ~ for a "bitwise complement" as in C. Thus I have + defined ~s for a string s to be the string of the same size as s + with each character being complemented by the C ~ operation. + + (12) For boolean algebra work on strings it is convenient also to have + the bitwise xor and setminus binary operations. Using C's '^' for xor + would be confusing when this is used elsewhere for powers, so I + decided to use ~. For setminus, I adopted the commonly used '\'. + Strings of fixed size n can now be used for a boolean algebra + structure with 8 * n elements. The zero element is n * char(0), + the unity is n * char(-1), and one have all of the usual laws like + A & (B | C) == A & B | A * C, A \ B = A & ~B, etc. + + (13) Having extended the bitwise operations for strings, it was appropriate + to do the same for integers. Definitions of the binary ~ and \ + operations for non-negative integers are straightforward. For + the unary ~ operation, I decided to do what C does with integer + types, and defined ~N to be -N - 1. With the appropriate extensions of + |, &, \ and the binary ~, one gets in effect the boolean algebra of + finite sets of natural numbers and their complements, by identifying + the set with distinct integer elements i_1, i_2, ... with the integer + + 2^i_1 + 2^i_2 + ... + + For ~N for non-integer real N, I have simply used -N. There is some + logic in this and it is certainly better than an error value. + I have not defined the binary operations |, &, ~, \ for non-integral + arguments. + + The use of ~N in this way conflicts with calc's method of displaying + a number when it has to be rounded to config("display") decimals. + To resolve this, my preference would be to replace the printing of + "~" as a prefix by a trailing ellipsis "...", the rounding always + being towards zero. E.g. with config("display", 5), 1/7 would print + as ".14285..." rather than "~.14285". The config("outround") + parameter would determine the type of rounding only for the + equivalent of config("tilde", 0). + + (14) For objects, users may create their own definitions for binary |, + &, ~ and \ with xx_or, xx_and, xx_xor, xx_setminus functions. + For unary ~ and \ operations, I have used the names xx_comp and + xx_backslash. + + (15) For the obviously useful feature corresponding to cardinality of a + set, I have defined #S for a string S to be the number of nonzero bits + in S. For a degree of consistency, it was then appropriate to + define #N for a nonnegative integer N to be the number of nonzero bits + in the binary representation of N. I've extended this to arbitrary + real N by using in effect #(abs(num(N))). I feel it is better to make + this available to users rather than having #N invoke an error message + or return an error value. For defining #X for an xx-object X, I + have used the name xx_content to suggest that it is appropriate for + something which has the sense of a content (like number of members of, + area, etc.). + + (16) Having recognized # as a token, it seemed appropriate to permit its + use for a binary operation. For real numbers x and y I have defined + x # y to be abs(x - y). (This is often symbolized by x ~ y, but it + would be confusing to have x ~ y meaning xor(x,y) for strings and + abs(x-y) for numbers.) Because '#' is commonly called the hash symbol, + I have used xx_hashop to permit definition of x # y for xx-objects. + + (17) For a similar reason I've added one line of code to codegen.c so that + /A returns the inverse of A. + + (18) Also for a list L, +L now returns the sum of the elements of L. For + an xx object A, +A requires and uses the definition of xx_plus. + + (19) I have given the unary operators ~, #, /, \, and except at the + beginning of an expression + and -, the same precedence with + right-to-left associativity. This precedence is now weaker than + unary * and &, but stronger than binary & and the shift and power + operators. One difference from before is that now + + a ^ - b ^ c + + evaluates as a ^ (- (b ^ c)) rather than a ^ ((- b) ^ c). + + + (20) For octets o1, o2, I've defined o1 | o2, o1 & o2, o1 ~ o2, ~o1 so + that they return 1-character strings. #o for an octet o returns the + number of nonzero bits in o. + + (21) For substrings I've left substr() essentially as before, but + for consistency with the normal block/matrix indexing, I've extended + the segment function to accept a string as first argument. Then + + segment(A, m, n) + + returns essentially the string formed from the character with index m + to the character with index n, ignoring indices < 0 and indices >= + len(A); thus, if m and n are both in [0, size(A)) + the string is of length abs(m - n) + 1, the order of the characters + being reversed if n < m. Here the indices for a list of size len are + 0, 1, ..., len - 1. As it makes some sense, if 0 <= n < size(A), + + segment(A, n) + + now returns the one-character string with its character being that with + index n in A. (I've made a corresponding modification to the segment + function for lists.) Some examples, if A = "abcdef", + + segment(A,2,4) = "cde", + + segment(A,4,2) = "edc", + + segment(A,3) = "d", + + segment(A, -2, 8) = "abcdef", + + segment(A,7,8) = "". + + (22) As essentially particular cases of segment(), I've defined + head(A, n) and tail(A, n) to be the strings formed by the first + or last abs(n) characters of A, the strings being4]5O~? reversed ' + if n is negative. I've changed the definitions of head and tail for + lists to be consistent with this interpretation of negative n. + + (23) Similarly I've left strpos ezsentially as at present, but search + and rsearch have been extended to strings. For example, + + search(A, B, m, n) + + returns the index i of the first occurrence of the string B in A + if m <= i < n, or the null value if there is no such occurrence. + As for other uses of search, negative m is interpreted as + size(A) + m, negative n as size(A) + n. For a match in this + search, all size(B) characters, including occurrences of '\0', + in B must match successive characters in A. + + The function rsearch() behaves similarly but searches in reverse order + of the indices. + + (24) A string A of length N determines in obvious ways arrays of M = 8 * N + bits. If the characters in increasing index order are c_0, c_1, ... + and the bits in increasing order in c_i are b_j, b_j+1, ..., b_j+7 + where j = 8 * i, I've taken the array of bits determined by A to be + + b_0, b_1, ..., b_M-1 + + For example, since "a" = char(97) and 97 = 0b01100001, and + "b" = char(98) = 0b01100010, the string "ab" determines the 16-bit + array + + 1000011001000110 + + in which the bits in the binary representations of "a" and "b" have + been reversed. + + bit with index n in this array. This is consistent with the use of + bit for a number ch in [0,256), i.e. bit(char(ch), n) = bit(ch, n). + For n < 0 or n >= size(A), bit(A,n) returns the null value. + + (25) For assigning values to specified bits in a string, I've defined + setbit(A, n) and setbit(A, n, v). The first assigns the value 1 to + bit(A, n), the second assigns test(v) to bit(A, n). + + (26) For consistency with the corresponding number operations, the shift + operations A << n and A >> n have been defined to give what look + like right- and left-shifts, respectively. For example, "ab" << 2 + returns the 16-bit array + + 0010000110010001 + + in which the array for "ab" has been moved 2 bits to the right. + + (27) To achieve much the same as the C strcpy and strncpy functions for + null-terminated strings, strcpy(S1, S2) and strncpy(S1, S2, n) have + been defined. Unlike the blkcpy() and copy() functions, the copying + for these is only from the beginning of the strings. Also, unlike C, + no memory overflow can occur as the copying ceases when size(S1) is + reached. Note that these overwrite the content of S1 (which affects + all strings linked to it) as well as returning S1. Examples: + + S = strcpy(6 * "x", "abc") <=> S = "abc\0xx" + + S = strcpy(3 * "x", "abcdef") <=> S = "abc" + + S = strncpy(6 * "x", "abcd", 2) <=> S = "ab\0xxx" + + S = strncpy(6 * "x", "ab", 4) <=> S = "ab\0\0xx" + + S = strncpy(6 * "x", "ab", 20) <=> S = "ab\0\0\0\0" + + If a new string S not linked to S1 is to be created, this can be + achieved by using str(S1) in place of S1. For example, the strcpy in + + A = "xxxxxx" + S = strcpy(str("xxxxxx"), "abc") + + would not change the value of A. + + (28) I've extended the definitions of copy(A, B, ssi, num, dsi) and + blkcpy(B, A, num, ssi, dsi) to allow for string-to-string copying + and block-to-string copying, but num is now an upper bound for the + number of characters to be copied - copying will cease before num + characters are copied if the end of the data in the source A or the + end of the destination B is reached. As with other character-changing + operations, copying to a string B will not change the locations of + B[0], B[1], ... or the size of B. + + In the case of copying a string to itself, characters are copied in + order of increasing index, which is different from block-to-block + copying where a memmove is used. This affects only copy from a + string to itself. For example, + + A = "abcdefg"; + copy(A, A, , , 2); + + will result in A == "abababa". If the overwriting that occurs here + is not wanted, one may use + + A = "abcdefg"; + copy(str(A), A, , , 2); + + which results in A == "ababcde". + + (29) perm(a,b) and comb(a,b) have been extended to accept any real a and + any integer b except for perm(a, b) with integer a such that b <= a < 0 + which gives a "division by zero" error. For positive b, both functions + are polynomials in a of degree b; for negative b, perm(a,b) is a + rational function (1/((a + 1) * (a+2) ...) with abs(b) factors in the + denominator), and comb(a,b) = 0. (An obvious "todo" is to extend this + to complex or other types of a.) + + (30) Although it is not illegal, it seems pointless to use a comma operator + with a constant or simple variable as in + + > 2 * 3,14159 + 14159 + > a = 4; b = 5; + > A = (a , b + 2); + > A + 7 + + I have added a few lines to addop.c so that when this occurs a + "unused value ignored" message and the relevant line number are + displayed. I have found this useful as I occasionally type ',' + when I mean '.'. + + There may be one or two other changes resulting from the way I have + rewritten the optimization code in addop.c. I think there was a bug + that assumed that PTR_SIZE would be the same as sizeof(long). By + the way, the new OP_STRING is now of index rather than pointer type. + It follows that pointers are now used in opcodes only for global + variables. By introducing a table of addresses of global variables + like those used for "constants" and "literal strings", the use of + pointers in opcodes could be eliminated. + + (31) When calc has executed a quit (or exit) statement in a function or + eval evaluation, it has invoked a call to math_error() which causes + a long jump to an initial state without freeing any data on the + stack, etc. Maybe more detail should be added to math_error(), but + to achieve the freeing of memory for a quit statement and at the same + time give more information about its occurrence I have changed the + way opcodes.c handles OP_QUIT. Now it should free the local variables + and whatever is on the stack, and display the name and line-number, + for each of the functions currently being evaluated. The last + function listed should be the "top-level" one with name "*". + Strings being eval-ed will have name "**". + + Here is a demo: + + > global a; + > + > define f(x) {local i = x^2; a++; + >> if (x > 5) quit "Too large!"; return i;} + f() defined + > define g(x) = f(x) + f(2*x); + g() defined + > g(2) + 20 + > g(3) + Too large! + "f": line 3 + "g": line 0 + "*": line 6 + > eval("g(3)") + Too large! + "f": line 3 + "g": line 0 + "**": line 1 + "*": line 7 + > a + 6 + + (32) I've made several small changes like removing + + if (vp->v_type == V_NUM) { + q = qinv(vp->v_num); + if (stack->v_type == V_NUM) + qfree(stack->v_num); + stack->v_num = q; + stack->v_type = V_NUM; + return; + } + + from the definition of o_invert. Presumably these lines were intended + to speed up execution for the common case of numerical argument. + Comparing the runtimes with and without these lines for inverting + thousands of large random numbers in a matrix suggest that execution + for real numbers is slightly faster without these lines. + + Maybe this and other similar treatment of "special cases" should be + looked at more closely. + + (33) The new lib script lib/natnumset.cal demonstrates how the new + string operators and functions may be used for defining and + working with sets of natural numbers not exceeding a + user-specified bound. + + +Following is the change from calc version 2.10.3t5.28 to 2.10.3t5.33: + + Added hnrmod(v, h, n, r) builtin to compute: + + v % (h * 2^n + r), h>0, n>0, r = -1, 0 or 1 + + Changed lucas.cal and mersenne.cal to make use of hnrmod(). + + A number of changes from Ernest Bowen: + + (1) introduction of unary & and * analogous to those in C; + + For an lvalue var, &var returns what I call a + value-pointer; this is a constant which may be assigned to + a variable as in p = &var, and then *p in expressions has + the same effect as var. Here is a simple example of their use: + + > define s(L) {local v=0; while (size(L)) v+= *pop(L);return v;} + s() defined + > global a = 1, b = 2; + > L = list(&a, &b); + > print s(L) + 3 + > b = 3; + > print s(L) + 4 + + Octet-pointers, number-pointers, and string-pointers in + much the same way, but have not attempted to do much with + the latter two. + + To print a pointer, use the "%p" specifier. + + Some arithmetic operations has been defined for corresponding + C operations. For example: + + > A = mat[4]; + > p = &A[0]; + > *(p+2) == A[2] + > ++p + > *p == A[1] + + There is at present no protection against "illegal" use of & + and *, e.g. if one attempts here to assign a value to *(p+5), + or to use p after assigning another value to A. + + NOTE: Unlike C, in calc &A[0] and A are quite different things. + + NOTE: If the current value of a variable X is an octet, + number or string, *X may be used to to return the value of + X; in effect X is an address and *X is the value at X. + + Added isptr(p) builtin to return 0 is p is not a pointer, + >0 if it is a pointer. The value of isptr(p) comes from the + V_XYZ #define (see the top of value.h) of the value to which + p points. + + To allow & to be used as a C-like address operator, use of it + has been dropped in calls to user-defined functions. For the + time being I have replaced it by the back-quote `. For example: + + > global a + > define f(a,b) = a = b + > f(&a,5) + > print a + 0 + > f(`a,5) + > print a + 5 + + However, one may use & in a similar way as in: + + > define g(a,b) = *a = b + > g(&a, 7) + > print a + 7 + + There is no hashvalue for pointers. Thus, like error values, + they cannot be used as indices in an association. + + The -> also works in calc. For example: + + > obj xy {x,y} + > obj uvw {u, v, w} + > obj xy A = {1,2} + > obj uvw B = {3,4,5} + > p = &A + > q = &B + > p->x + 1 + > p->y = 6 + > A + obj xy {1, 6} + > q -> u + 3 + > p->y = q + > A + obj xy {1, v-ptr: 1400474c0} + > p->y->u + 3 + > p->y->u = 7 + > B + obj uvw {7, 4, 5} + > p -> y = p + > A + obj xy {1, v-ptr: 140047490} + > p -> y -> x + 1 + > p->y->y + v-ptr: 140047490 + > p->y->y-> x + 1 + > p->y->y->x = 8 + > A + obj xy {8, v-ptr: 140047490} + + + (2) a method of "protecting" variables; + + For the various kinds of "protection", of an l_value var, + bits of var->v_subtype, of which only bits 0 and 1 have been + used in the past to indicate literal and allocated strings. + This has meant initialization of var->v_subtype when a new var + is introduced, and for assignments, etc., examination of the + appropriate bits to confirm that the operation is to be permitted. + + See help/protect for details. + + (3) automatic "freeing" of constants that are no longer required. + + For the "freeing" of constants, the definition of a NUMBER + structure so that a NUMBER * q could be regarded as a + pointing to a "freed number" if q->links = 0. + + The old q->num was changed to a union q->nu which had a pointer + to the old q->num if q->links > 0 and to the next freed number + if q->links = 0. The old "num" is #defined to "nu->n_num". + + The prior method calc has used for handling "constants" amounted + to leakage. After: + + > define f(x) = 27 + x; + > a = 27; + + It is of course necessary for the constant 27 to be stored, but + if one now redefines f and a by: + + > define f(x) = 45 + x; + > a = 45; + + There seems little point in retaining 27 as a constant and + therefore using up memory. If this example seems trivial, + replace 27 with a few larger numbers like 2e12345, or better, + -2e12345, for which calc needs memory for both 2e12345 and + -2e12345! + + Constants are automatically freed a definition when a + function is re- or un-defined. + + The qalloc(q) and qfree(q) functions have been changed so + that that q->links = 0 is permitted and indicates that q + has been freed. If a number has been introduced as a + constant, i.e. by a literal numeral as in the above + examples, its links becoming zero indicates that it is no + longer required and its position in the table of constants + becomes available for a later new constant. + + (4) extension of transcendental functions like tan, tanh, etc. + to complex arguments + + (5) definition of gd(z) and agd(z), i.e. the gudermannian and + inverse gudermannian + + (6) introduction of show options for displaying information about + current constants, global variables, static variables, and cached + redc moduli. + + To help you follow what is going on, the following show + items have been introduced: + + show constants ==> display the currently stored constants + show numbers ==> display the currently stored numbers + show redcdata ==> display the currently stored redc moduli + show statics ==> display info about static variables + show real ==> display only real-valued variables + + The constants are automatically initialized as constants and + should always appear, with links >= 1, in in the list of constants. + + The show command: + + show globals + + has been redefined so that it gives information about all + current global and still active static variables. + + (7) definition of functions for freeing globals, statics, redc values + + To free memory used by different kinds of variable, the following + builtins have been added: + + freeglobals(); /* free all globals */ + freestatics(); /* free all statics */ + freeredc(); /* free redc moduli */ + free(a, b, ...); /* free specific variables */ + + NOTE: These functions do not "undefine" the variables, but + have the effect of assigning the null value to them, and so + frees the memory used for elements of a list, matrix or object. + + See 10) below for info about "undefine *". + + (8) enhancement of handling of "old value": having it return an + lvalue and giving option of disabling updating. + + Now, by default, "." return an lvalue with the appropriate + value instead of copying the old value. + + So that a string of commands may be given without changing + the "oldvalue", the new builtin: + + saveval(0) + + function simply disables the updating of the "." value. + The default updating can be resumed by calling: + + saveval(1) + + The "." value: + + > 2 + 2 + 4 + > . + 4 + + can now be treated as an unnamed variable. For example: + + > mat x[3,3]={1,2,3,4,5,6,7,8,9} + > x + > print .[1,2] + 6 + + (9) for a list L defining L[i] to be same as L[[i]] + + (10) extending undefine to permit its application to all user-defined + functions by using "undefine *". + + The command: + + undefine * + + undefines all current user-defined functions. After + executing all the above freeing functions (and if + necessary free(.) to free the current "old value"), the + only remaining numbers as displayed by: + + show numbers + + should be those associated with epsilon(), and if it has been + called, qpi(). + + (11) storing the most recently calculated value of qpi(epsilon)i and + epsilon so that when called again with the same epsilon it + is copied rather than recalculateed. + + (12) defining trace() for square matrices + + (13) expression in parentheses may now be followed by a qualifier + computible with its type + + When an expression in parentheses evaluates to an lvalue + whose current value is a matrix, list or object, it may + now be followed by a qualifier computible with its type. + + For example: + + > A = list(1,2,4); + > B = mat[2,2] = {5,6,7,8}; + > define f(x) = (x ? A : B)[[1]]; + > print f(1), f(0) + 2 6 + + > obj xy {x,y} + > C = obj xy = {4,5} + > p = &C + > *p.x + Not indexing matrix or object + > (*p).x + 4 + + (14) swap(a,b) now permits swapping of octets in the same or different + blocks. + + For example: + + > A = blk() = {1,2,3} + > B = blk() = {4,5,6} + > swap(A[0], B[2]) + > A + chunksize = 256, maxsize = 256, datalen = 3 + 060203 + + A few bug fixes from Ernest Bowen: + + B1: qcmpi(q, n) in qmath.c sometimes gave the wrong result if + LONG_BITS > BASEB, len = 1 and nf = 0, since it then + reduces to the value of (nf != q->num.v[1]) in which + q->num.v[1] is not part of the size-1 array of HALFs for + q->num. At present this is used only for changing opcodes + for ^2 and ^4 from sequences involving OP_POWER to + sequences using OP_SQUARE, which has no effect on the + results of calculations. + + B2: in matdet(m) in matfunc.c, a copy of the matrix m was not freed + when the determinant turned out have zero value. + + B3: in f_search() in func.c, a qlinking of the NUMBER * storing the + the size of a file was not qfreed. + + B4: in comalloc() in commath.c the initial zero values for real and + imag parts are qlinked but not qfreed when nonzero values are + assigned to them. Rather than changing + the definition of comalloc(), I have included any relevant + qfrees with the calls to comalloc() as in + c = comalloc(); + qfree(c->real); + c->real = ... + + B5: in calls to matsum(), zeros are qlinked but not qfreed. Rather + than changing addnumeric(), I have changed the definition + of matsum(m) so that it simply adds the components of m, + which requires only that the relevant additions be defined, + not that all components of m be numbers. + + + Simple arithmetic expressions with literal numbers are evaluated + during compilation rather than execution. So: + + define f(x) = 2 + 3 + x; + + will be stored as if defined by: + + define f(x) = 5 + x; + + Fixed bug with lowhex2bin converstion in lib_util.c. It did not + correctly convert from hex ASCII to binary values due to a table + loading error. + + Fixed porting problem for NetBSD and FreeBSD by renaming the + qdiv() function in qmath.c to qqdiv(). + + Improved the speed of mfactor (from mfactor.cal library) for + long Mersenne factorizations. The default reporting loop + is now 10000 cycles. + + SGI Mips r10k compile set is speced for IRIX6.5 with v7.2 + compilers. A note for pre-IRIX6.5 and/or pre-v7.2 compilers + is given in the compile set. + + Added regression tests related to saveval(), dot and pointers. + + +Following is the change from calc version 2.10.3t5.11 to 2.10.3t5.27: + + The todo help file as been updated with the in-progress items: + + XXX - block print function is not written yet ... + + Expanded the role of blk() to produce unnamed blocks as in: + + B = blk(len, chunk) + + and named blocks as in: + + B = blk(str, len, chunk) + + A block may be changed (with possible loss of data only if len is less + than the old len) by: + + C = blk(B, len, chunk) + + For an unnamed block B, this creates a new block C and copies + min(len, oldlen) octets to it, B remaining unchanged. For a named + block, the block B is changed and C refers to the same block as B, + so that for example, C[i] = x will result in B[i] == x. Thus, for a + named block, "B = " does nothing (other than B = B) in: + + B = blk(B, len, chunk) + + but is necessary for changing an unnamed block. + + Renamed rmblk() to blkfree(). + + The builtin function blkfree(val) will free memory allocated to block. + If val is a named block, or the name of a named block, or the + identifying index for a named block, blkfree(val) frees the + memory block allocated to this named block. The block remains + in existence with the same name, identifying index, and chunksize, + but its size and maxsize becomes zero and the pointer for the start + of its data block null. + + The builtin function blocks() returns the number of blocks that + have been created but not freed by the blkfree() function. When called + as blocks(id) and the argument id less than the number of named + blocks that have been created, blocks(id) returns the named block + with identifying index id. + + Removed the artifical limit of 20 named blocks. + + Added name() builtin to return the name of a type of value + as a string. + + Added isdefined() to determine of a value is defined. + + Added isobjtype() to determine the type of an object. + + The isatty(v) builtin will return 1 if v is a file that associated + with a tty (terminal, xterm, etc.) and 0 otherwise. The isatty(v) + builtin will no longer return an error if v is not a file or + is a closed file. + + The isident(m) builtin will return 1 if m is a identity matrix + and 0 otherwise. The isident(m) builtin will no longer return an + error if m is not a matrix. + + Added extensive testing of isxxx() builtins and their operations + on various types. + + Added md5() builtin to perform the MD5 Message-Digest Algorithm. + + Renamed isset() to bit(). + + Blocks will expand when required by the copy() builtin function: + + > f = fopen("help/full", "r") + > B = blk() + > B + chunksize = 256, maxsize = 256, datalen = 0 + > copy(B, f) + > B + chunksize = 256, maxsize = 310272, datalen = 310084 + 2a2a2a2a2a2a2a2a2a2a2a2a2a0a2a20696e74726f0a2a2a2a2a2a2a2a2a... + + NOTE: Your results will differ because changes to help/full. + + The blkcpy() builtin args now more closely match that + of memcpy(), strncpy: + + blkcpy(dst, src [, num [, dsi [, ssi]]]) + + The copy() builtin args now more closely match that the cp command: + + copy(src, dst [, num [, ssi [, dsi]]]) + + but otherwise does the same thing as blkcpy. + + Fixed lint problems for SunOS. + + Added have_memmv.c and HAVE_MEMMOVE Makefile variable to control + use of memmove(). If empty, then memmove() is tested for and if + not found, or if HAVE_MEMMOVE= -DHAVE_NO_MEMMOVE then an internal + version of memmove() is used instead. + + Added regression tests for sha, sha1 and md5 builtin hash functions. + + Added xx_print to to the list of object routines are definable. + Added xx_print.cal to the library to demo this feature. + + Moved blkcpy() routines have been moved to blkcpy.[ch]. + + The blkcpy() & copy() builtings can not copy to/from numbers. + For purposes of the copy, only the numerator is ignored. + + Resolved a number of missing symbols for libcalc users. + + Added lib_util.{c,h} to the calc source to support users of + libcalc.a. These utility routines are not directly used by + calc but are otherwise have utility to those programmers who + directly use libcalc.a instead. + + Added sample sub-directory. This sub-directory contains a few + sample programs that use libcalc.a. These sample programs are + built via the all rule because they will help check to see that + libcalc.a library does not contain external references that + cannot be resolved. At the current time none of these sample + programs are installed. + + Added a libcalc_call_me_last() call to return storage created + by the libcalc_call_me_first() call. This allows users of libcalc.a + to free up a small amount of storage. + + Fixed some memory leaks associated with the random() Blum generator. + + Fixed fseek() file operations for SunOS. + + Fixed convz2hex() fencepost error. It also removes leading 0's. + + Plugged a memory leak relating to pmod. The following calculation: + + pmod(2, x, something) + + where x was not 2^n-1 would leak memory. This has been fixed. + + +Following is the change from calc version 2.10.3t5.1 to 2.10.3t5.10: + + Misc printf warning bug fixes. + + Calc now permits chains of initializations as in: + + obj point {x,y} P = {1,2} = {3,4} = {5,6} + + Here the initializations are applied from left to right. It may + look silly, but the 1, 2, ... could be replaced by expressions with + side effects. As an example of its use suppose A and B are + expressions with side effects: + + P = {A, B} + + has the effect of P.x = A; P.y = B. Sometimes one might want these in + the reverse order: P.y = B; P.x = A. This is achieved by: + + P = { , B} = {A} + + Another example of its use: + + obj point Q = {P, P} = {{1, 2}, {3, 4}} + + which results in Q having Q.x.x = 1, Q.x.y = 2, etc. + + The role of the comma in has been changed. Expressions such as: + + mat A[2], B[3] + + are equivalent to: + + (mat A[2]), (mat B[3]) + + Now, expr1, expr2 returns type of expr2 rather than EXPR_RVALUE. This + permits expressions such as: + + (a = 2, b) = 3 + + Also, expr1 ? expr2 : expr3 returns type(expr2) | type(expr3). + This will make the result an lvalue (i.e. EXPR_RVALUE bit not set) + For example, if both expr2 and expr3 are lvalues. Then: + + a ? b : c = d + + has the effect of b = d if a is "nonzero", otherwise c = d. + + This may be compared with + + d = a ? b : c + + which does d = b if a is "nonzero", otherwise d = c. + + And now, expr1 || expr2 and expr1 && expr2 each return + htype(expr1)| type(expr2). So for example: + + a || b = c + + has the effect of a = c if a is "nonzero", otherwise b = c. + And for example: + + a && b = c + + has the effect of a = c if a is "zero", otherwise b = c. + + At top level, newlines are neglected between '(' and the matching + ')' in expressions and function calls. For example, if f() has been + already defined, then: + + + a = ( + 2 + + + f + ( + 3 + ) + ) + + and + + b = sqrt ( + 20 + , + 1 + ) + + will be accepted, and in interactive mode the continue-line prompt + will be displayed. + + When calc sees a "for", "while", "do", or "switch", newlines will be + ignored (and the line-continuation prompt displayed in interactive mode) + until the expected conditions and statements are completed. + For example: + + s = 0; + for (i = 0; i < 5; i++) + { + s += i; + } + print s; + + Now 's' will print '10' instead of '5'. + + Added more regression tests to regress.cal. Changed the error + counter from 'err' to 'prob'. The errmax() is set very high and + the expected value of errcount() is kept in ecnt. + + Added the 'unexpected' help file which gives some unexpected + surprises that C programmers may encounter. + + Updated the 'help', 'intro' and 'overview' to reflect the + full ilst of non-builtin function help files. Reorered the + 'full' help file. + + The blkalloc() builtin has been renamed blk(). + + Only a "fixed" type of BLOCK will be used. Other types of + blocks in the future will be different VALUE types. + + Introduced an undefine command so that + + undefine f, g, ... + + frees the memory used to store code for user-defined functions f, + g, ..., effectively removing them from the list of defined + functions. + + When working from a terminal or when config("lib_debug") > 0 advice + that a function has been defined, undefined, or redefined is + displayed in format "f() defined". + + Some experimental changes to block and octet handling, so that after: + + B = blk(N) + + B[i] for 0 <= i < N behaves for some operations like an lvalue for + a USB8 in B. + + xx_assign added to object functions to permit the possibility of + specifying what A = B will do if A is an xx-object. Normal + assignment use of = is restored by the command: undefine + xx_assign. + + For error-value err, errno(err) returns the error-code for err and + stores this in calc_errno; error(err) returns err as if + error(errno(err)) were called. + + Anticipating probable future use, names have been introduced for + the four characters @, #, $, `. This completes the coverage of + printable characters on a standard keyboard. + + Added sha() builtin to perform the old Secure Hash Algorithm + (SHS FIPS Pub 180). + + Added sha1() builtin to perform the new Secure Hash Standard-1 + (SHS-1 FIPS Pub 180-1). + + Added ${LD_DEBUG} Makefile variable to allow for additional + libraries to be compiled into calc ... for debugging purposes. + In most cases, LD_DEBUG= is sufficent. + + Added ${CALC_ENV} makefile variable to allow for particular + environment variables to be supplied for make {check,chk,debug}. + In most cases, CALC_ENV= CALCPATH=./lib is sufficent. + + Added ${CALC_LIBS} to list the libaraies created and used to + build calc. The CALC_LIBS= custom/libcustcalc.a libcalc.a + is standard for everyone. + + Improved how 'make calc' and 'make all' rules work with respect + to building .h files. + + Added 'make run' to only run calc interactively with the + ${CALC_ENV} calc environment. Added 'make cvd', 'make dbx' + and 'make gdb' rules to run debug calc with the respective + debugger with the ${CALC_ENV} calc environment. + + Added cvmalloc_error() function to lib_calc.c as a hook for + users of the SGI Workshop malloc debugging library. + + Cut down on places where *.h files include system files. + The *.c should do that instead where it is reasonable. + + To avoid symbol conflicts, *.h files produced and shipped + with calc are inclosed that as similar to the following: + + #if !defined(__CALC_H__) + #define __CALC_H__ + .. + #endif /* !__CALC_H__ */ + + Added memsize(x) builtin to print the best aproximation of the + size of 'x' including overhead. The sizeof(x) builtin attempts + to cover just the storage of the value and not the overhead. + Because -1, 0 and 1 ZVALUES are static common values, sizeof(x) + ignores their storage. Also sizeof(x) ignores the denominator of + integers, and the imaginary parts of pure real numbers. Added + regression tests for memsize(), sizeof() and size(). + + +Following is the change from calc version 2.10.3t4.16 to 2.10.3t5.0: + + The calc source now comes with a custom sub-directory which + contains the custom interface code. The main Makefile now + drives the building and installing of this code in a similar + way that it drives the lib and help sub-directories. (see below) + + Made minor edits to most help files beginning with a thru e. + + The errno(n) sets a C-like errno to the value n; errno() returns + the current errno value. The argument for strerror() and error() + defaults to this errno. + + Added more error() and errno() regression tests. + + The convention of using the global variable lib_debug at the + end of calc librar scripts has been replaced with config("lib_debug"). + The "lib_debug" is reserved by convention for calc library scripts. + This 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 + + The "calc_debug" is reserved by convention for internal calc routines. + The output of "calc_debug" will change from release to release. + Generally this value is used by calc wizards and by the regress.cal + routine (make check). By convention, "calc_debug" has the following + meanings: + + <-1 reserved for future use + + -1 no debug messages are printed, no debug actions will be taken + + 0 very little, if any debugging is performed (and then mostly + in alpha test code). The only output is as a result of + internal fatal errors (typically either math_error() or + exit() will be called). (default) + + >0 a greater degree of debugging is performed and more + verbose messages are printed (regress.cal uses 1). + + The "user_debug" is provided for use by users. Calc ignores this value + other than to set it to 0 by default (for both "oldstd" and "newstd"). + No calc code or shipped library will change this value other than + during startup or during a config("all", xyz) call. + + The following is suggested as a convention for use of "user_debug". + These are only suggestions: feel free to use it as you like: + + <-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 very little, if any debugging is performed. The only output + are from fatal errors. (default) + + >0 a greater degree of debugging is performed and more + verbose messages are printed + + Added more code that is deading with the BLOCK type. + + Added blkalloc() builtin. + + Split NAMETYPE definition out into nametype.h. + + Added OCTET type for use in processing block[i]. + + Added free, copy, cmp, quickhash and print functions for + HASH, BLOCK and OCTET. + + Added notes to config.h about what needs to be looked at when + new configuration items are added. + + The null() builtin now takes arguments. + + Given the following: + + obj point {x,y} + obj point P, Q + + will will now create P and Q as obj point objects. + + Added xx_or, xx_and, xx_not and xx_fact objfuncs. + + Added the custom() builtin function. The custom() builtin + interface is designed to make it easier for local custom + modification to be added to calc. Custom functions are + non-standard or non-portable code. For these reasons, one must can + only execute custom() code by way of an explicit action. + + By default, custom() returns an error. A new calc command line + option of '-C' is required (as well as ALLOW_CUSTOM= -DCUSTOM + Makefile variable set) to enable it. + + Added -C as a calc command line option. This permits the + custom() interface to be used. + + Added ALLOW_CUSTOM Makefile variable to permanently disable + or selective enable the custom builtin interface. + + The rm() builtin now takes multiple filenames. If the first + arg is "-f", then 'no-such-file' errors are ignored. + + Added errcount([count]) builtin to return or set the error + counter. Added errmax([limit]) to rturn or set the error + count limiter. + + Added -n as a calc command line option. This has the effect + of calling config("all", "newstd") at startup time. + + Added -e as a calc command line option to ignore all environment + varialbes at startup time. The getenv() builtin function will + still return values, however. + + Added -i as a calc command line option. This has the effect + ignoring when errcount() exceeds errmax(). + + Changed the config("maxerr") name to config("maxscan"). The + old name of "maxerr" is kept for backward compatibility. + + Using an unknown -flag on the calc command like will + generate a short usage message. + + Doing a 'help calc' displays the same info as 'help usage'. + + The 'make check' rule now uses the -i calc command line flag + so that regress.cal can continue beyond when errcount exceeds + errmax. In regress.cal, vrfy() reports when errcount exceeds + errmax and resets errmax to match errcount. This check + and report is independent of the test success of failure. + + Fixed missing or out of order tests in regress.cal. + + Misc Makefile cleanup in lib/Makefile and help/Makefile. + + The default errmax() value on startup is now 20. + + The custom() interface is now complete. See help/custom and + custom/HOW_TO_ADD files, which show up as the custom and new_custom + help files, for more information. + + The help command will search ${LIBDIR}/custhelp if it fails to find + a file in ${LIBDIR}. This allows the help command to also print + help for a custom function. However if a standard help file and a + custom help file share the same name, help will only print the + standard help file. One can skip the standard help file and print + the custom help file by: + + help custhelp/name + + or by: + + custom("help", "name") + + Added minor sanity checks the help command's filename. + + Added show custom to display custom function information. + + Added the contrib help page to give information on how + and where to submit new calc code, modes or custom functions. + + Added comment information to value.h about what needs to be + checked or modified when a new value type is added. + + Both size(x) and sizeof(x) return information on all value types. + Moved size and sizeof information from func.c and into new file: size.c. + + Added custom("devnull") to serve as a do-nothing interface tester. + + Added custom("argv" [,arg ...]) to print information about args. + + Added custom("sysinfo", "item") to print an internal calc #define + parameter. + + The make depend rule also processes the custom/Makefile. + + Added xx_max and xx_min for objfuncs. + + The max(), min() builtins work for lists. + + +Following is the change from calc version 2.10.3t3 to 2.10.3t4.15: + + The priority of unary + and - to that of binary + and - when they are + applied to a first or only term. Thus: + + -16^-2 == -1/256 + -7^2 == -49 + -3! == -6 + + Running ranlib is no longer the default. Systems that need RANLIB + should edit the Makefile and comment back in: + + RANLIB=ranlib + + Dropped support of SGI r8k. + + Added support for the SGI r5k. + + Added support for SGI Mips compiler version 7.1 or later. + + Removed "random" as a config() option. + + Removed CCZPRIME Makefile variable. + + Added zsquaremod() back into zmod.c to be used by the Blum-Blum-Shub + generator for the special case of needing x^2 mod y. + + Moved the Blum-Blum-Shub code and defines from zrand.c and zrand.h + into zrandom.c and zrandom.h. Now only the a55 generator resides + in zrand.c and zrand.h. + + Added random, srandom and randombit help files. + + Added random(), srandom() and randombit() builtin functions. The + cryptographically strong random number generator is code complete! + + Removed cryrand.cal now that a Blum-Blum-Shub generator is builtin. + + Improved the speed of seedrandom.cal. It now uses the 13th + builtin Blum-Blum-Shub seed. + + The randmprime.cal script makes use of the Blum-Blum-Shub generator. + + Added randombitrun.cal and randomrun.cal calc library files. + These are the Blum-Blum-Shub analogs to the randbitrun.cal + and randrun.cal a55 tests. + + Improved hash.c interface to lower level hash functions. The hash + interface does not yet have a func.c interface ... it is still + under test. + + Added randombitrun.cal to test the Blum-Blum-Shub generator. + + Added calc.h, hash.h, shs.h and value.h to LIB_H_SRC because some + of the libcalc.a files need them. + + In the original version, each call to newerror(str) created a new + error-value. Now a new value will be created only if str has not + been used in a previous call to newerror(). In effect, the string + serves to identify the error-value; for example: + + return newerror("Non-integer argument"); + + can be used in one or more functions, some of which may be + repeatedly called, but after it has been called once, it will + always return the same value as if one had initially used the + assignment: + + non_integer_argument_error = newerror("Non-integer argument") + + and then in each function used: + + return non_integer_argument_error; + + The new definition of newerror() permits its freer use in cases like: + + define foo(a) { + + if (!isint(a)) + return newerror("Non-integer argument"); + ... + } + + One might say that "new" in "newerror" used to mean being different + from any earlier error-value. Now it means being not one of the + "original" or "old" error-values defined internally by calc. + + As newerror() and newerror("") specify no non-null string, it has + been arranged that they return the same as newerror("???"). + + Added "show errors" command analogous to "show functions" for + user-defined functions. One difference is that whereas the + functions are created by explicit definitions, a new described + error is created only when a newerror(...) is executed. + + Fixed macro symbol substitution problem uncovered by HPUX cpp bug in + HVAL and related zrand.h macros. + + Added +e to CCMISC for HP-UX users. + + Fixed the prompt bug. + + Eliminated the hash_init() initialization function. + + The 'struct block' has been moved from value.c to a new file: block.h. + + Added "blkmaxprint" config value, which limits the octets to print + for a block. A "blkmaxprint" of 0 means to print all octets of a + block, regardless of size. The default is to print only the first + 256 octets. + + The "blkverbose" determines if all lines, including duplicates + should be printed. If TRUE, then all lines are printed. If false, + duplicate lines are skipped and only a "*" is printed in a sytle + similar to od. This config value has not meaning if "blkfmt" is + "str". The default value for "blkverbose" is FALSE: duplicate + lines are not printed. + + The "blkbase" determines the base in which octets of a block + are printed. Possible values are: + + "hexadecimal" Octets printed in 2 digit hex + "hex" + + "octal" Octets printed in 3 digit octal + "oct" + + "character" Octets printed as chars with non-printing + "char" chars as \123 or \n, \t, \r + + "binary" Octets printed as 0 or 1 chars + "bin" + + "raw" Octets printed as is, i.e. raw binary + "none" + + The default "blkbase" is "hex". + + The "blkfmt" determines for format of how block are printed: + + "line" print in lines of up to 79 chars + newline + "lines" + + "str" print as one long string + "string" + "strings" + + "od" print in od-like format, with leading offset, + "odstyle" followed by octets in the given base + "od_style" + + "hd" print in hex dump format, with leading offset, + "hdstyle" followed by octets in the given base, followed + "hd_style" by chars or '.' if no-printable or blank + + The default "blkfmt" is "hd". + + Fixed a bug in coth() when testing acoth using coth(acoth(x)) == x + within the rounding error. + + Assignments to matrices and objects has been changed. The assignments in: + + A = list(1,2,3,4); + B = makelist(4) = {1,2,3,4}; + + will result in A == B. Then: + + A = {,,5} + + will result in A == list(1,2,5,4). + + Made minor edits to most help files beginning with a thru d. + + Fixed error in using cmdbuf(""). + + +Following is the change from calc version 2.10.3t0 to 2.10.3t2: + + Bumped to version 2.10.3 due to the amount of changes. + + Renamed qabs() to qqabs() to avoid conflicts with stdlib.h. + + Fixed a casting problem in label.c. + + A lot of work was performed on the code generation by Ernest Bowen + . Declarations no longer need to precese code: + + define f(x) { + local i = x^2; + print "i = ":i; + local j = i; + ... + } + + The scope of a variable extends from the end of the declaration (including + initialization code for the variable) at which it is first created + to the limit given by the following rules: + + local variable: to the end of the function being defined + + global variable: to the end of the session with calc + + static within a function definition: to the the first of: + + an end of a global, static or local declaration (including + initialization code) with the same identifier + + the end of the definition + + static at top level within a file: to the first of: + + the next static declaration of the identifier at top level + in the file, + + the next global declaration of the identifier at top level + in the file or in any function definition in the file, + + the next global declaration of the identifier at any level + in a file being read as a result of a "read" command, + + the end of the file. + + The scope of a top-level global or static variable may be + interrupted by the use of the identifier as a parameter or local or + static variable within a function definition in the file being + read; it is restored (without change of value) after the definition. + + For example, The two static variables a and b are created, + with zero value, when the definition is read; a is initialized + with the value x if and when f(x) is first called with a positive + even x, b is similarly initialized if and when f(x) is first called + positive odd x. Each time f(x) is called with positive integer x, + a or b is incremented. Finally the values of the static variables + are assigned to the global variables a and b, and the resulting + values displayed. Immediately after the last of several calls to + f(x), a = 0 if none of the x's have been positive even, otherwise + a = the first positive even x + the number of positive even x's, + and b = 0 if none of the x's have been positive odd, otherwise + b = the first positive odd x + the number of positive odd x's: + + define f(x) { + if (isint(x) && x > 0) { + if (iseven(x)) { + static a = x; + a++; + } else { + static b = x; + b++; + } + } + global a = a, b = b; + print "a =",a,"b =",b; + } + + Fixed some faults in the handling of syntax errors for the matrix + and object creation operators mat and obj. In previous versions of calc: + + mat; <- Bad dimension 0 for matrix + mat A; <- Bad dimension 0 for matrix + global mat A; <- Bad dimension 0 for matrix + mat A[2], mat B[3] <- Semicolon expected + global mat A[2], mat B[3] <- Bad syntax in declaration statement + + Now: + + this statement has the same effect as + -------------- ---------------------- + mat A[2], B[3] (A = mat[2]), B[3] + + global mat A[2], B[3] global A, B; A = mat[2]; B = mat[3]; + + Initialization remains essentially as before except that for objects, + spaces between identifiers indicate assignments as in simple variable + declarations. Thus, after: + + obj point {x,y}; + obj point P, Q R = {1,2} + + P has {0,0}, Q and R have {1,2}. In the corresponding expression with + matrices commas between identifiers before the initialization are ignored. + For example: + + this statement has the same effect as + -------------- ---------------------- + mat A, B C [2] = {1,2} A = B = C = (mat[2] = {1,2}) + + One can also do things like: + + L = list(mat[2] = {1,2}, obj point = {3,4}, mat[2] = {5,6}) + A = mat[2,2] = {1,2,3,4}^2 + B = mat[2,2] = {1,2,3,4} * mat[2,2] = {5,6,7,8} + + where the initialization = has stronger binding than the assignment = and + the * sign. + + Matrices and objects can be mixed in declarations after any simple + variables as in: + + global a, b, mat A, B[2] = {3,4}, C[2] = {4,5}, obj point P = {5,6}, Q + + Fixed some bugs related to global and static scoping. See the the + 5200 regress test and lib/test5200.cal for details. + + Optimized opcode generator so that functions defined using '=' do not + have two unreached opcodes. I.e.,: + + define f(x) = x^2 + show opcodes f + + Also unreachable opcodes UNDEF and RETURN are now not included at + the end of any user-defined function. + + Changed the "no offset" indicator in label.c from 0 to -1; this + permits goto jumps to the zero opcode position. + + Changed the opcode generation for "if (...)" followed by + "break", "continue", or "goto", so that only one jump opcode is + required. + + A label can now be immediately by a rightbrace. For example: + + define test_newop3(x) {if (x < 0) goto l132; ++x; l132: return x;} + + The LONG_BITS make variable, if set, will force the size of a long + as well as forcing the USB8, SB8, USB16, SB16, USB32, SB32, + HAVE_B64, USB64, SB64, U(x) and L(x) types. If the longbits + program is given an arg (of 32 or 64), then it will output + based on a generic 32 or 64 bit machine where the long is + the same size as the wordsize. + + Fixed how the SVAL and HVAL macros were formed for BASEB==16 machines. + + Dropped explicit Makefile support for MIPS r8k since these processors + no longer need special compiler flags. + + SGI 6.2 and later uses -xansi. + + +Following is the change from calc version 2.10.2t33 to 2.10.2t34: + + Fixed a bug related to fact(). + + Thanks to Ernest Bowen , for two or three + arguments, + + search(x, val, start); + rsearch(x, val, start); + + and for matrix, list or association x: + + search(f, str, start); + rsearch(f, str, start); + + for a file stream f open for reading, behave as before except for a few + differences: + + (1) there are no limits on the integer-valued start. + + (2) negative values of start are interpreted as offsets from the size of + x and f. For example, + + search(x, val, -100) + + searches the last 100 elements of x for the first i for which + x[[i]] = val. + + (3) for a file f, when start + strlen(str) >= size(f) and + search(f, str, start) returns null, i.e. str is + not found, the file position after the search will be + + size(f) - strlen(str) + 1 + + rather than size(f). + + For four arguments: + + search(a, b, c, d) + rsearch(a, b, c, d), + + a has the role of x or f, and b the role of val or str as described + above for the three-argument case, and for search(), c is + essentially "start" as before, but for rsearch() is better for c + and d to be the same as for search(). For a non-file case, if: + + 0 <= c < d <= size(a), + + the index-interval over which the search is to take place is: + + c <= i < d. + + If the user has defined a function accept(v,b), this is used rather + than the test v == b to decide for matrix, list, or association + searches when a "match" of v = a[[i]] with b occurs. E.g. after: + + define accept(v,b) = (v >= b); + + then calling: + + search(a, 5, 100, 200) + + will return, if it exists, the smallest index i for which + 100 <= i < 200 and a[[i]] >= 5. To restore the effect of + the original "match" function, one would then have to: + + define accept(v,b) == (v == b). + + Renamed the calc symbol BYTE_ORDER to CALC_BYTE_ORDER in order + to avoid conflict. + + Added beer.cal and hello.cal lib progs in support of: :-) + + http://www.ionet.net/~timtroyr/funhouse/beer.html + http://www.latech.edu/~acm/HelloWorld.shtml + + +Following is the change from calc version 2.10.2t25 to 2.10.2t32: Eliminated use of VARARG and . Calc supports only . The VARARGS Makefile variable has been eliminated. @@ -26,11 +1911,163 @@ Following is the change from calc version 2.10.2t25 to date: Fixes for compiling under BSDI's BSD/OS 2.0. Added a Makefile section for BSD/OS. - Added a Makefile compile section for Dec Alpha without gcc ... + Added a Makefile compile section for Dec Alpha without gcc ... provides a hack-a-round for Dec Alpha cc bug. + Minor comment changes to lucas.cal. -Following is the change from calc version 2.10.2t4 to 2.10.2t25: + Added pix.cal, a slow painful but interesting way to compute pix(x). + + Confusion over the scope of static and global values has been reduced + by a patch from Ernest Bowen . + + The change introduced by the following patch terminates the + scope of a static variable at any static declaration with the + same name at the same level, or at any global declaration with + the same name at any level. With the example above, the scope + of the static "a" introduced in the third line ends when the + "global a" is read in the last line. Thus one may now use the + same name in several "static" areas as in: + + > static a = 10; + > define f(x) = a + x; + > static a = 20; + > define g(x) = a + x; + > global a; + + The first "a" exists only for the definition of f(); the second + "a" only for the definition of g(). At the end one has only + the global "a". + + Ending the scope of a static variable in this way is consistent + with the normal use of static variables as in: + + > static a = 10; + > define f(x) {static a = 20; return a++ + x;} + > define g(x) = a + x; + > global a; + + The scope of the first "a" is temporarily interrupted by the + "static a" in the second line; the second "a" remains active + until its scope ends with the ending of the definition of f(). + Thus one ends with g(x) = 10 + x and on successive calls to + f(), f(x) returns 20 + x, 21 + x, etc. With successive "static + a" declarations at the same level, the active one at any stage + is the most recent; if the instructions are being read from a + file, the scope of the last "static a" ends at the end-of-file. + + Here I have assumed that no "global a" is encountered. As + there can be only one global variable with name "a", it seems + to me that its use must end the scope of any static "a". Thus + the changes I introduce are such that after: + + > global a = 10; + > define f(x) = a + x; + > static a = 20; + > define g(x) = a + x; + > define h(x) {global a = 30; return a + x;} + > define i(x) = a + x; + + g(x) will always return 20 + x, and until h(x) has been called, + f(x) and i(x) will return 10 + x; when h(x) is called, it + returns 30 + x and any later call to f(x) or i(x) will return + 30 + x. It is the reading of "global a" in the definition of + h() that terminates the scope of the static a = 20, so that the + "a" for the last line is the global variable defined in the + first line. The "a = 30" is executed only when h() is called. + + Users who find this confusing might be well advised to use + different names for different variables at the same scope level. + + The other changes produced by the patch are more straightforward, + but some tricky programming was needed to get the possibility of + multiple assignments and what seems to be the appropriate order + of executions and assignments. For example, the order for the + declaration: + + global a, b = expr1, c, d = expr2, e, f + + will be: + + evaluation of expr1; + assignment to b; + evaluation of expr2; + assignment to d; + + Thus the effect is the same as for: + + a = 0; b = expr1; c = 0; d = expr2; e = 0; f = 0; + + The order is important when the same name is used for different + variables in the same context. E.g. one may have: + + define f(x) { + global a = 10; + static a = a; + local a = a--; + + while (--a > 0) + x++; + return x; + } + + Every time this is called, the global "a" is assigned the value + 10. The first time it is called, the value 10 is passed on to + the static "a" and then to the local "a". In each later call + the "static a = a" is ignored and the static "a" is one less than + it was in the preceding call. I'm not recommending this style of + programming but it is good that calc will be able to handle it. + + I've also changed dumpop to do something recent versions do not do: + distinguish between static and global variables with the same name. + + Other changes: commas may be replaced by spaces in a sequence of + identifiers in a declaration. so one may now write: + + global a b c = 10, d e = 20 + + The comma after the 10 is still required. Multiple occurrences + of an identifier in a local declaration are now acceptable as + they are for global or static declarations: + + local a b c = 10, a = 20; + + does the same as: + + local a b c; + a = b = c = 10; + a = 20; + + The static case is different in that: + + static a b c = 10, a = 20; + + creates four static variables, the first "a" having a very short and + useless life. + + Added new tests to verify the new assugnments above. + + Added the builtin test(x) which returns 1 or 0 according as x tests + as true or false for conditions. + + Added have_posscl.c which attempts to determine if FILEPOS is + a scalar and defines HAVE_FILEPOS_SCALAR in have_posscl.h + accordingly. The Makefile variable HAVE_POSSCL determines + if have_posscl.c will test this condition or assume non-scalar. + + Added have_offscl.c which attempts to determine if off_t is + a scalar and defines HAVE_OFF_T_SCALAR in have_posscl.h + accordingly. The Makefile variable HAVE_OFFSCL determines + if have_offscl.c will test this condition or assume non-scalar. + + Reading to EOF leaves you positioned one character beyond + the last character in the file, just like Un*x read behavior. + + Calc supports files and offsets up to 2^64 bytes, if the OS + and file system permits. + + +Following is the change from calc version 2.10.2t4 to 2.10.2t24: Added makefile debugging rules: @@ -225,7 +2262,7 @@ Following is the change from calc version 2.10.2t4 to 2.10.2t25: LCFLAGS are CC-style flags for ${LINT} LDFLAGS are flags given to ${CC} for linking .o files - ILDFLAGS are flags given to ${CC} for linking .o files + ILDFLAGS are flags given to ${CC} for linking .o files for intermediate progs CC is how the the C compiler is invoked @@ -255,7 +2292,7 @@ Following is the change from calc version 2.10.2t4 to 2.10.2t25: ANY OTHER libcalc.a functions! Added support for the SGI IRIX6.2 (or later) Mongoose 7.0 (or later) - C Compiler for the r4k, r8k and r10k. Added LD_NO_SHARED for + C Compiler for the r4k, r8k and r10k. Added LD_NO_SHARED for non-shared linker support. Re-ordered and expanded options for the DEBUG make variable. @@ -307,12 +2344,15 @@ Following is the change from calc version 2.10.2t4 to 2.10.2t25: Fixed bug associated with read of a long string variable. - Renumbered some of the early regress.cal test numbers to make room + Renumbered some of the early regress.cal test numbers to make room for more tests. Fixed all out of sequence test numbers. Fixed some malformatted regression reports. + Renamed STSIZE_BITS to OFF_T_BITS. Renamed SWAP_HALF_IN_STSIZE to + SWAP_HALF_IN_OFF_T. -Following is the change from calc version 2.10.2t0 to 2.10.2t4: + +Following is the change from calc version 2.10.2t1 to 2.10.2t3: Fixed bug in the regression suite that made test3400 and test4100 fail on correct computations. @@ -570,7 +2610,7 @@ Following is the change from calc version 2.10.1t21 to 2.10.2t0: mat D[] = { } -Following is the change from calc version 2.10.1t20 to 2.10.1t21: +Following is the change from calc version 2.10.1t20 to 2.10.1t20: Changes made in preparation for Blum Blum Shub random number generator. @@ -647,7 +2687,7 @@ Following is the change from calc version 2.10.1t20 to 2.10.1t21: -Following is the change from calc version 2.10.1t11 to 2.10.1t20: +Following is the change from calc version 2.10.1t11 to 2.10.1t19: Added many more regression tests to lib/regress.cal. Some due to . @@ -754,7 +2794,6 @@ Following is the change from calc version 2.10.1t11 to 2.10.1t20: factors used to formt he Blum modulus. The default modulus has been expanded to 1062 bits product of two Blum primes. - Added shs hash code, though it is not currently used. - XXX The function hash_init() is called to initialize the hash function interface. @@ -848,7 +2887,7 @@ Following is the change from calc version 2.10.1t11 to 2.10.1t20: Ha Lam -Following is the change from calc version 2.10.0t13 to 2.10.1t11: +Following is the change from calc version 2.10.0t13 to 2.10.1t10: Added SB8, USB8, SB16, USB16, SB32, USB32 typedefs, determined by longbits and declared in longbits.h, to deal with 8, 16 and 32 bit @@ -965,7 +3004,7 @@ Following is the change from calc version 2.10.0t13 to 2.10.1t11: digits or bits rather than places, e.g. round(.00238, 2, 32) returns .0023, round(.00238, 2, 56) returns .0024. -Following is the change from calc version 2.9.3t11 to 2.10.0t13: +Following is the change from calc version 2.9.3t11 to 2.10.0t12: The default ${LIBDIR}/bindings CALCBINDINGS uses ^D for editing. The alternate CALCBINDINGS ${LIBDIR}/altbind uses ^D for EOF. @@ -1019,7 +3058,7 @@ Following is the change from calc version 2.9.3t11 to 2.10.0t13: to provide a more extensive test suite for some builtin numeric functions. -Following is the change from calc version 2.9.3t9.2+ to 2.9.3t11: +Following is the change from calc version 2.9.3t9.2+ to 2.9.3t10: Added many help files for builtin functions and some symbols. More help files are needed, see help/todo. @@ -1122,7 +3161,7 @@ Following is the change from calc version 2.9.3t9.2+ to 2.9.3t11: { } -Following is the change from calc version 2.9.3t8 to 2.9.3t9.2+: +Following is the change from calc version 2.9.3t8 to 2.9.3t9.2: Use of the macro zisleone(z) has been clarified. The zisleone(z) macro tests if z <= 1. The macro zisabsleone(z) tests of z is 1, 0 or -1. @@ -1330,7 +3369,7 @@ Following is the change from calc version 2.9.3t8 to 2.9.3t9.2+: Fixed bug where reserved keyword used as symbol name caused a core dump. -Following is the change from calc version 2.9.3t7 to 2.9.3t8: +Following is the change from calc version 2.9.3t7 to 2.9.3t7: WARNING: This patch is an beta test patch by chongo@toad.com (Landon Curt Noll). @@ -1504,7 +3543,7 @@ Following is the change from calc version 2.9.2 to 2.9.3t7: Updated the help/todo list. A BUGS file was added. Volunteers are welcome to send in patches! -Following is the change from calc version 2.9.1 to 2.9.2: +Following is the change from calc version 2.9.1 to 2.9.1: Fixed floor() for values -1 < x < 0. @@ -1518,12 +3557,12 @@ Following is the change from calc version 2.9.1 to 2.9.2: Added more regression test code. -Following is the change from calc version 2.9.0 to 2.9.1: +Following is the change from calc version 2.9.0 to 2.9.0: A major bug was fixed in subtracting two numbers when the first number was zero. The problem caused wrong answers and core dumps. -Following is a list of visible changes to calc from version 1.27.0 to 2.9.0: +Following is a list of visible changes to calc from version 1.27.0 to 2.8.0: Full prototypes have been provided for all C functions, and are used if calc is compiled with an ANSI compiler. @@ -1571,7 +3610,7 @@ Following is a list of visible changes to calc from version 1.27.0 to 2.9.0: the calculator. The "math.h" include file has been split into three include files: "zmath.h", "qmath.h", and "cmath.h". -Following is a list of visible changes to calc from version 1.26.4 to 1.27.0: +Following is a list of visible changes to calc from version 1.26.4 to 1.26.4: Added an assoc function to return a new type of value called an association. Such values are indexed by one or more arbitrary values. @@ -1590,7 +3629,7 @@ Following is a list of visible changes to calc from version 1.26.2 to 1.26.4: Misc typo and working fixes to comments, help files and the man page. -Following is a list of visible changes to calc from version 1.24.7 to 1.26.2: +Following is a list of visible changes to calc from version 1.24.7 to 1.26.1: There is a new emacs-like command line editing and edit history feature. The old history mechanism has been removed. The key diff --git a/LIBRARY b/LIBRARY index 951556d..076b1c5 100644 --- a/LIBRARY +++ b/LIBRARY @@ -10,13 +10,19 @@ precision arithmetic with integers, rational numbers, or complex numbers. There are also many numeric functions such as factorial and gcd, along with some transcendental functions such as sin and exp. +Take a look at the sample sub-directory. It contains a few simple +examples of how to use libcalc.a that might be helpful to look at +after you have read this file. + ------------------ FIRST THINGS FIRST ------------------ -******************************************************************************* -* You MUST call libcalc_call_me_first() prior to using libcalc lib functions! * -******************************************************************************* +............................................................................... +. . +. You MUST call libcalc_call_me_first() prior to using libcalc lib functions! . +. . +............................................................................... The function libcalc_call_me_first() takes no args and returns void. You need call libcalc_call_me_first() only once. @@ -98,7 +104,11 @@ For example: ... if ((error = setjmp(calc_jmp_buf)) != 0) { - /* handle error */ + + /* reinitialize calc after a longjmp */ + reinitialize(); + + /* report the error */ printf("Ouch: %s\n", calc_error); } calc_jmp = 1; @@ -434,3 +444,14 @@ for equality. The ccmp function returns TRUE if two complex numbers differ. There are three predefined values for complex numbers. You should clink them when you want to use them. They are _czero_, _cone_, and _conei_. These have the values 0, 1, and i. + +---------------- +LAST THINGS LAST +---------------- + +If you wish, when you are all doen you can call libcalc_call_me_last() +to free a small amount of storage associated with the libcalc_call_me_first() +call. This is not required, but is does bring things to a closure. + +The function libcalc_call_me_last() takes no args and returns void. You +need call libcalc_call_me_last() only once. diff --git a/Makefile b/Makefile index 7f6cabd..2704ffe 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ #!/bin/make # -# (Gerneric calc makefile) +# (Generic calc makefile) # # Copyright (c) 1995 David I. Bell and Landon Curt Noll # Permission is granted to use, distribute, or modify this source, @@ -72,9 +72,12 @@ BYTE_ORDER= # If in doubt, leave LONG_BITS empty. This makefile will run # the longbits program to determine the length. # +# In order to avoid make brain damage in some systems, we avoid placing +# a space after the ='s below. +# LONG_BITS= -#LONG_BITS= 32 -#LONG_BITS= 64 +#LONG_BITS=32 +#LONG_BITS=64 # Determine if your compiler supports the long long type and if so, its length # @@ -108,6 +111,36 @@ LONGLONG_BITS= HAVE_FPOS= #HAVE_FPOS= -DHAVE_NO_FPOS +# Determine if we have an off_t which one can perform arithmetic operations, +# assignments and comparisons. On some systems off_t is some sort of union +# or struct. +# +# If HAVE_OFFSCL is empty, this makefile will run the have_offscl program +# to determine if off_t is a scalar. If HAVE_OFFSCL is set to the value +# -DOFF_T_NON_SCALAR when calc will assume that off_t some sort of +# union or struct which. +# +# If in doubt, leave HAVE_OFFSCL empty. +# +HAVE_OFFSCL= +#HAVE_OFFSCL= -DOFF_T_NON_SCALAR + +# Determine if we have an fpos_t which one can perform arithmetic operations, +# assignments and comparisons. On some systems fpos_t is some sort of union +# or struct. Some systems do not have an fpos_t and long is as a file +# offset instead. +# +# If HAVE_POSSCL is empty, this makefile will run the have_offscl program +# to determine if off_t is a scalar, or if there is no off_t and long +# (a scalar) should be used instead. If HAVE_POSSCL is set to the value +# -DFILEPOS_NON_SCALAR when calc will assume that fpos_t exists and is +# some sort of union or struct which. +# +# If in doubt, leave HAVE_POSSCL empty. +# +HAVE_POSSCL= +#HAVE_POSSCL= -DFILEPOS_NON_SCALAR + # Determine if we have ANSI C const. # # If HAVE_CONST is empty, this makefile will run the have_const program @@ -144,6 +177,18 @@ HAVE_UID_T= HAVE_NEWSTR= #HAVE_NEWSTR= -DHAVE_NO_NEWSTR +# Determine if we have memmove() +# +# If HAVE_MEMMOVE is empty, this makefile will run the have_memmv program +# to determine if memmove() is supported. If HAVE_MEMMOVE is set to +# -DHAVE_NO_MEMMOVE, then calc will use internal functions to simulate +# the memory move function that does correct overlapping memory modes. +# +# If in doubt, leave HAVE_MEMMOVE empty. +# +HAVE_MEMMOVE= +#HAVE_MEMMOVE= -DHAVE_NO_MEMMOVE + # Some architectures such as Sparc do not allow one to access 32 bit values # that are not alligned on a 32 bit boundary. # @@ -153,7 +198,7 @@ HAVE_NEWSTR= # # ALIGN32= let align32.c figure out if alignment is needed # ALIGN32= -DMUST_ALIGN32 force 32 bit alignment -# ALIGN32= -UMUST_ALIGN32 allow non-aligment of 32 bit accesses +# ALIGN32= -UMUST_ALIGN32 allow non-alignment of 32 bit accesses # # When in doubt, be safe and pick ALIGN32=-DMUST_ALIGN32. # @@ -168,7 +213,7 @@ ALIGN32= -DMUST_ALIGN32 # MAIN= -DMAIN=void main() is of type void # MAIN= -DMAIN=int main() is of type int # -# When in dobut, try MAIN= -DMAIN=void. If you get a warning try the other. +# When in doubt, try MAIN= -DMAIN=void. If you get a warning try the other. # MAIN= -DMAIN=void #MAIN= -DMAIN=int @@ -184,6 +229,8 @@ BINDIR= /usr/local/bin # ${TOPDIR} is the directory under which the calc directory will be placed. # ${LIBDIR} is where the *.cal, *.h, *.a, bindings and help dir are installed. # ${HELPDIR} is where the help directory is installed. +# ${CUSTOMLIBDIR} is where custom lib files are installed. +# ${CUSTOMHELPDIR} is where custom help files are installed. # TOPDIR= /usr/local/lib #TOPDIR= /usr/lib @@ -192,6 +239,8 @@ TOPDIR= /usr/local/lib # LIBDIR= ${TOPDIR}/calc HELPDIR= ${LIBDIR}/help +CUSTOMLIBDIR= ${LIBDIR}/custom +CUSTOMHELPDIR= ${HELPDIR}/custhelp # where man pages are installed # @@ -216,14 +265,14 @@ CATDIR= #CATDIR= /usr/man/u_man/cat1 #CATDIR= /usr/contrib/man/cat1 -# extenstion to add on to the calc man page filename +# extension to add on to the calc man page filename # # This is ignored if CATDIR is empty. # MANEXT= 1 #MANEXT= l -# extenstion to add on to the calc man page filename +# extension to add on to the calc man page filename # # This is ignored if CATDIR is empty. # @@ -257,7 +306,7 @@ MANMAKE= /usr/local/bin/manmake # If the $CALCPATH environment variable is not defined, then the following # path will be search for calc lib routines. # -CALCPATH= .:./lib:~/lib:${LIBDIR} +CALCPATH= .:./lib:~/lib:${LIBDIR}:${CUSTOMLIBDIR} # If the $CALCRC environment variable is not defined, then the following # path will be search for calc lib routines. @@ -308,7 +357,7 @@ DEBUG= -O # On systems that have dynamic shared libs, you may want want to disable them # for faster calc startup. # -# System type NO_SHARED recomendation +# System type NO_SHARED recommendation # # BSD NO_SHARED= # SYSV NO_SHARED= -dn @@ -324,7 +373,7 @@ NO_SHARED= # On some systems where you are disabling dynamic shared libs, you may # need to pass a special flag to ${CC} during linking stage. # -# System type NO_SHARED recomendation +# System type NO_SHARED recommendation # # IRIX with NO_SHARED= -non_shared LD_NO_SHARED= -Wl,-rdata_shared # IRIX with NO_SHARED= LD_NO_SHARED= @@ -339,14 +388,14 @@ LD_NO_SHARED= # a *.a library. Set RANLIB to the utility that performs this action. # Set RANLIB to : if your system does not need such a utility. # -RANLIB=ranlib -#RANLIB=: +#RANLIB=ranlib +RANLIB=: # Some systems are able to form lint libs. How it is formed depends # on your system. If you do not care about lint, use : as the # LINTLIB value. # -# System type LINTLIB recomendation +# System type LINTLIB recommendation # # BSD ${LINT} ${LCFLAGS} ${LINTFLAGS} -u -Ccalc # SYSV ${LINT} ${LCFLAGS} ${LINTFLAGS} -u -o calc @@ -362,7 +411,7 @@ LINTLIB= : # opposite meaning for the flags below. Other systems change flag # meaning altogether. # -# System LINTFLAGS recomendation +# System LINTFLAGS recommendation # # SunOs -a -h -v -z # @@ -385,8 +434,54 @@ MAKE_FILE= Makefile # # If in doubt, leave PURIFY commented out. # -#PURIFY= purify -logfile=pure.out #PURIFY= purify +#PURIFY= purify -m71-engine +#PURIFY= purify -logfile=pure.out +#PURIFY= purify -m71-engine -logfile=pure.out + +# If you want to use a debugging library such as a malloc debug library, +# or need to add special ld flags after the calc libraries are included, +# set ${LD_DEBUG} below. +# +# If in doubt, set LD_DEBUG to empty. +# +#LD_DEBUG= -lmalloc_cv +LD_DEBUG= + +# When doing a: +# +# make check +# make chk +# make debug +# +# the ${CALC_ENV} is used to supply the proper environment variables +# to calc. Most people will simply need 'CALCPATH=./lib' to ensure +# that these debug rules will only use calc lib files under the +# local source directory. The longer lines (with MALLOC_VERBOSE=1 ...) +# are useful for SGI IRIX people who have 'WorkShop Performance Tools' +# and who also set 'LD_DEBUG= -lmalloc_cv' above. +# +# If in doubt, use CALC_ENV= CALCPATH=./lib. +# +CALC_ENV= CALCPATH=./lib +#CALC_ENV= CALCPATH=./lib MALLOC_VERBOSE=1 MALLOC_TRACING=1 \ +# MALLOC_FASTCHK=1 MALLOC_FULLWARN=1 +#CALC_ENV= CALCPATH=./lib MALLOC_VERBOSE=1 MALLOC_TRACING=1 \ +# MALLOC_FASTCHK=1 MALLOC_FULLWARN=1 MALLOC_CLEAR_FREE=1 \ +# MALLOC_CLEAR_MALLOC=1 + +# By default, custom builtin functions may only be executed if calc +# is given the -C option. This is because custom builtin functions +# may invoke non-standard or non-portable code. One may completely +# disable custom builtin functions by not compiling any of code +# +# ALLOW_CUSTOM= -DCUSTOM # allow custom only if -C is given +# ALLOW_CUSTOM= # disable custom even if -C is given +# +# If in doubt, use ALLOW_CUSTOM= -DCUSTOM +# +ALLOW_CUSTOM= -DCUSTOM +#ALLOW_CUSTOM= ### # @@ -400,8 +495,7 @@ MAKE_FILE= Makefile # ICFLAGS are given to ${CC} for intermediate progs # # CCMAIN are flags for ${CC} when files with main() instead of CFLAGS -# CCSHS are flags given to ${CC} for compiling shs.c instead of CFLAGS -# CCZPRIME are flags given to ${CC} for compiling zprime.c instead of CFLAGS +# CCSHS are flags given to ${CC} for compiling shs.c & shs1.c instead of CFLAGS # # LCFLAGS are CC-style flags for ${LINT} # LDFLAGS are flags given to ${CC} for linking .o files @@ -422,7 +516,6 @@ ICFLAGS= ${CCWARN} ${CCMISC} # CCMAIN= ${ICFLAGS} ${MAIN} CCSHS= ${CFLAGS} -CCZPRIME= ${CFLAGS} # LCFLAGS= LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED} @@ -432,7 +525,7 @@ CC= ${PURIFY} cc # ### # -# SGI IRIX5.3 (or earlier) C Compiler +# SGI IRIX5.3 (or earlier) -o32 C Compiler # # You must set above: # RANLIB=: @@ -454,7 +547,6 @@ CC= ${PURIFY} cc # #CCMAIN= ${ICFLAGS} ${MAIN} #CCSHS= ${CFLAGS} -#CCZPRIME= ${CFLAGS} # #LCFLAGS= #LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED} @@ -464,7 +556,7 @@ CC= ${PURIFY} cc # ### # -# SGI IRIX6.2 (or later) Mongoose 7.0 (or later) C Compiler for the R4k +# SGI IRIX6.2 (or later) -n32 (v7.1 or later) Compiler for the R4k # # You must set above: # RANLIB=: @@ -487,17 +579,16 @@ CC= ${PURIFY} cc # #CCMAIN= ${ICFLAGS} ${MAIN} #CCSHS= ${CFLAGS} -#CCZPRIME= ${CCWARN} ${NO_SHARED} ${CCMISC} -O1 # #LCFLAGS= #LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED} #ILDFLAGS= # -#CC= ${PURIFY} cc -n32 -r4000 +#CC= ${PURIFY} cc -n32 -r4000 -xansi # ### # -# SGI IRIX6.2 (or later) Mongoose 7.0 (or later) C Compiler for the R8k +# SGI IRIX6.2 (or later) -n32 (v7.1 or later) Compiler for the R5k # # You must set above: # RANLIB=: @@ -520,17 +611,20 @@ CC= ${PURIFY} cc # #CCMAIN= ${ICFLAGS} ${MAIN} #CCSHS= ${CFLAGS} -#CCZPRIME= ${CCWARN} ${NO_SHARED} ${CCMISC} -O1 # #LCFLAGS= #LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED} #ILDFLAGS= # -#CC= ${PURIFY} cc -n32 -r8000 +#CC= ${PURIFY} cc -n32 -r5000 -xansi # ### # -# SGI IRIX6.2 (or later) Mongoose 7.0 (or later) C Compiler for the R10k +# SGI IRIX6.5 (or later) -n32 (v7.2 or later) Compiler for the R10k +# +# NOTE: For Pre IRIX6.5 and pre v7.2 compilers, use: +# +# CCSHS= ${CFLAGS} -OPT:fold_arith_limit=1668 # # You must set above: # RANLIB=: @@ -553,13 +647,12 @@ CC= ${PURIFY} cc # #CCMAIN= ${ICFLAGS} ${MAIN} #CCSHS= ${CFLAGS} -#CCZPRIME= ${CCWARN} ${NO_SHARED} ${CCMISC} -O1 # #LCFLAGS= #LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED} #ILDFLAGS= # -#CC= ${PURIFY} cc -n32 -r10000 +#CC= ${PURIFY} cc -n32 -r10000 -mips4 -xansi # ### # @@ -573,14 +666,13 @@ CC= ${PURIFY} cc # #CCWARN= #CCOPT= ${DEBUG} ${NO_SHARED} -#CCMISC= +#CCMISC= +e # #CFLAGS= ${CCWARN} ${CCOPT} ${CCMISC} #ICFLAGS= ${CCWARN} ${CCMISC} # #CCMAIN= ${ICFLAGS} ${MAIN} #CCSHS= ${CFLAGS} -#CCZPRIME= ${CFLAGS} # #LCFLAGS= #LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED} @@ -601,28 +693,6 @@ CC= ${PURIFY} cc # #CCMAIN= ${ICFLAGS} ${MAIN} #CCSHS= ${CFLAGS} -#CCZPRIME= ${CFLAGS} -# -#LCFLAGS= -#LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED} -#ILDFLAGS= -# -#CC= ${PURIFY} cc -# -### -# -# Dec Alpha without gcc set -# -#CCWARN= -#CCOPT= ${DEBUG} ${NO_SHARED} -#CCMISC= -DFUNCT_DECL_BUG -# -#CFLAGS= ${CCWARN} ${CCOPT} ${CCMISC} -#ICFLAGS= ${CCWARN} ${CCMISC} -# -#CCMAIN= ${ICFLAGS} ${MAIN} -#CCSHS= ${CFLAGS} -#CCZPRIME= ${CFLAGS} # #LCFLAGS= #LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED} @@ -646,7 +716,6 @@ CC= ${PURIFY} cc # #CCMAIN= ${ICFLAGS} ${MAIN} #CCSHS= ${CFLAGS} -#CCZPRIME= ${CFLAGS} # #LCFLAGS= #LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED} @@ -670,7 +739,6 @@ CC= ${PURIFY} cc # #CCMAIN= ${ICFLAGS} ${MAIN} #CCSHS= ${CFLAGS} -#CCZPRIME= ${CFLAGS} # #LCFLAGS= #LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED} @@ -694,7 +762,6 @@ CC= ${PURIFY} cc # #CCMAIN= ${ICFLAGS} ${MAIN} #CCSHS= ${CFLAGS} -#CCZPRIME= ${CFLAGS} # #LCFLAGS= #LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED} @@ -718,7 +785,6 @@ CC= ${PURIFY} cc # #CCMAIN= ${ICFLAGS} ${MAIN} #CCSHS= ${CFLAGS} -#CCZPRIME= ${CFLAGS} # #LCFLAGS= #LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED} @@ -743,7 +809,6 @@ CC= ${PURIFY} cc # #CCMAIN= ${ICFLAGS} ${MAIN} #CCSHS= ${CFLAGS} -#CCZPRIME= ${CFLAGS} # #LCFLAGS= #LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED} @@ -768,6 +833,8 @@ LINT= lint CTAGS= ctags # assume the X11 makedepend tool for the depend rule MAKEDEPEND= makedepend +# echo command location +ECHO= /bin/echo # Makefile debug # @@ -784,47 +851,58 @@ V=@: # the source files which are built into a math library # -# There MUST be a .o for every .c in LIBOBJS. +# There MUST be a .o for every .c in LIBOBJS # -# NOTE: calcerr.c is built by this Makefile so it is not a real source. -# -LIBSRC= byteswap.c comfunc.c commath.c config.c jump.c lib_calc.c \ - math_error.c pix.c poly.c prime.c qfunc.c qio.c qmath.c qmod.c \ - qtrans.c zfunc.c zio.c zmath.c zmod.c zmul.c zprime.c zrand.c +LIBSRC= addop.c assocfunc.c blkcpy.c block.c byteswap.c \ + codegen.c comfunc.c commath.c config.c const.c custom.c \ + file.c func.c hash.c help.c hist.c input.c jump.c label.c \ + lib_calc.c lib_util.c listfunc.c matfunc.c math_error.c \ + md5.c obj.c opcodes.c pix.c poly.c prime.c qfunc.c qio.c \ + qmath.c qmod.c qtrans.c quickhash.c shs.c shs1.c size.c \ + string.c symbol.c token.c value.c version.c zfunc.c zio.c \ + zmath.c zmod.c zmul.c zprime.c zrand.c zrandom.c # the object files which are built into a math library # -# There MUST be a .o for every .c in LIBSRC. +# There MUST be a .o for every .c in LIBSRC plus calcerr.o +# which is built via this Makefile. # -# NOTE: calcerr.o comes from calcerr.c which is built -# -LIBOBJS= byteswap.o comfunc.o commath.o config.o jump.o lib_calc.o \ - math_error.o pix.o poly.o prime.o qfunc.o qio.o qmath.o qmod.o \ - qtrans.o zfunc.o zio.o zmath.o zmod.o zmul.o zprime.o zrand.o \ - calcerr.o +LIBOBJS= addop.o assocfunc.o blkcpy.o block.o byteswap.o calcerr.o \ + codegen.o comfunc.o commath.o config.o const.o custom.o \ + file.o func.o hash.o help.o hist.o input.o jump.o label.o \ + lib_calc.o lib_util.o listfunc.o matfunc.o math_error.o \ + md5.o obj.o opcodes.o pix.o poly.o prime.o qfunc.o qio.o \ + qmath.o qmod.o qtrans.o quickhash.o shs.o shs1.o size.o \ + string.o symbol.o token.o value.o version.o zfunc.o zio.o \ + zmath.o zmod.o zmul.o zprime.o zrand.o zrandom.o # the calculator source files # # There MUST be a .c for every .o in CALCOBJS. # -CALCSRC= addop.c assocfunc.c calc.c codegen.c const.c file.c hash.c \ - quickhash.c func.c hist.c input.c label.c listfunc.c matfunc.c obj.c \ - opcodes.c shs.c string.c symbol.c token.c value.c version.c +CALCSRC= calc.c # we build these .o files for calc # # There MUST be a .o for every .c in CALCSRC. # -CALCOBJS= addop.o assocfunc.o calc.o codegen.o const.o file.o hash.o \ - quickhash.o func.o hist.o input.o label.o listfunc.o matfunc.o obj.o \ - opcodes.o shs.o string.o symbol.o token.o value.o version.o +CALCOBJS= calc.o + +# these .h files are needed by programs that use libcalc.a +# +LIB_H_SRC= alloc.h blkcpy.h block.h byteswap.h calc.h cmath.h \ + config.h custom.h file.h func.h hash.h hist.h jump.h \ + label.h lib_util.h math_error.h md5.h nametype.h \ + opcodes.h prime.h qmath.h shs.h shs1.h string.h \ + symbol.h token.h value.h zmath.h zrand.h zrandom.h # we build these .h files during the make # -BUILD_H_SRC= align32.h args.h calcerr.h conf.h endian_calc.h fposval.h \ - have_const.h have_fpos.h have_malloc.h have_newstr.h have_stdlib.h \ - have_string.h have_uid_t.h have_unistd.h longbits.h longlong.h \ - terminal.h have_times.h +BUILD_H_SRC= align32.h args.h calcerr.h conf.h endian_calc.h \ + fposval.h have_const.h have_fpos.h have_malloc.h \ + have_memmv.h have_newstr.h have_offscl.h have_posscl.h \ + have_stdlib.h have_string.h have_times.h have_uid_t.h \ + have_unistd.h longbits.h longlong.h terminal.h # we build these .c files during the make # @@ -835,7 +913,8 @@ BUILD_C_SRC= calcerr.c # There MUST be a .c for every .o in UTIL_OBJS. # UTIL_C_SRC= align32.c endian.c longbits.c have_newstr.c have_uid_t.c \ - have_const.c have_stdvs.c have_varvs.c fposval.c have_fpos.c longlong.c + have_const.c have_stdvs.c have_varvs.c fposval.c have_fpos.c \ + longlong.c have_offscl.c have_posscl.c have_memmv.c # these awk and sed tools are used in the process of building BUILD_H_SRC # and BUILD_C_SRC @@ -849,7 +928,7 @@ UTIL_MISC_SRC= calcerr_h.sed calcerr_h.awk calcerr_c.sed calcerr_c.awk \ # UTIL_OBJS= endian.o longbits.o have_newstr.o have_uid_t.o \ have_const.o fposval.o have_fpos.o longlong.o try_strarg.o \ - have_stdvs.o have_varvs.o + have_stdvs.o have_varvs.o have_posscl.o have_memmv.o # these temp files may be created (and removed) during the build of BUILD_C_SRC # @@ -860,19 +939,73 @@ UTIL_TMP= ll_tmp fpos_tmp fposv_tmp const_tmp uid_tmp newstr_tmp vs_tmp UTIL_PROGS= align32 fposval have_uid_t longlong have_const \ endian longbits have_newstr have_stdvs have_varvs -# these .h files are needed by programs that use libcalc.a +# These files are required by the regress.cal regression test. # -LIB_H_SRC= alloc.h byteswap.h cmath.h config.h jump.h \ - prime.h qmath.h zmath.h zrand.h +REGRESS_CAL= ./lib/lucas_chk.cal ./lib/natnumset.cal ./lib/surd.cal \ + ./lib/test1700.cal ./lib/test2300.cal ./lib/test2600.cal \ + ./lib/test2700.cal ./lib/test3100.cal ./lib/test3300.cal \ + ./lib/test3400.cal ./lib/test3500.cal ./lib/test4000.cal \ + ./lib/test4100.cal ./lib/test4600.cal ./lib/test5100.cal \ + ./lib/test5200.cal -# these .h files are neither built, nor required by libcalc.a +# The complete list of makefile vars passed down to custom/Makefile. # -CALC_H_SRC= calc.h file.h func.h hash.h hist.h label.h opcodes.h \ - shs.h string.h symbol.h token.h value.h +CUSTOM_PASSDOWN= Q="${Q}" \ + TOPDIR="${TOPDIR}" \ + LIBDIR="${LIBDIR}" \ + HELPDIR="${HELPDIR}" \ + CUSTOMLIBDIR="${CUSTOMLIBDIR}" \ + CUSTOMHELPDIR="${CUSTOMHELPDIR}" \ + DEBUG="${DEBUG}" \ + NO_SHARED="${NO_SHARED}" \ + RANLIB="${RANLIB}" \ + PURIFY="${PURIFY}" \ + ALLOW_CUSTOM="${ALLOW_CUSTOM}" \ + CCWARN="${CCWARN}" \ + CCOPT="${CCOPT}" \ + CCMISC="${CCMISC}" \ + CFLAGS="${CFLAGS} ${ALLOW_CUSTOM}" \ + ICFLAGS="${ICFLAGS}" \ + LCFLAGS="${LCFLAGS}" \ + LDFLAGS="${LDFLAGS}" \ + ILDFLAGS="${ILDFLAGS}" \ + CC="${CC}" \ + MAKE_FILE=${MAKE_FILE} \ + SED=${SED} \ + MAKEDEPEND=${MAKEDEPEND} \ + SORT=${SORT} + +# The complete list of makefile vars passed down to sample/Makefile. +# +SAMPLE_PASSDOWN= Q="${Q}" \ + TOPDIR="${TOPDIR}" \ + LIBDIR="${LIBDIR}" \ + HELPDIR="${HELPDIR}" \ + MAIN="${MAIN}" \ + DEBUG="${DEBUG}" \ + NO_SHARED="${NO_SHARED}" \ + RANLIB="${RANLIB}" \ + PURIFY="${PURIFY}" \ + ALLOW_CUSTOM="${ALLOW_CUSTOM}" \ + CCWARN="${CCWARN}" \ + CCOPT="${CCOPT}" \ + CCMISC="${CCMISC}" \ + CFLAGS="${CFLAGS} ${ALLOW_CUSTOM}" \ + ICFLAGS="${ICFLAGS}" \ + CCMAIN="${CCMAIN}" \ + LCFLAGS="${LCFLAGS}" \ + LDFLAGS="${LDFLAGS}" \ + ILDFLAGS="${ILDFLAGS}" \ + CALC_LIBS="../libcalc.a ../custom/libcustcalc.a" \ + CC="${CC}" \ + MAKE_FILE=${MAKE_FILE} \ + SED=${SED} \ + MAKEDEPEND=${MAKEDEPEND} \ + SORT=${SORT} # complete list of .h files found (but not built) in the distribution # -H_SRC= ${CALC_H_SRC} ${LIB_H_SRC} +H_SRC= ${LIB_H_SRC} # complete list of .c files found (but not built) in the distribution # @@ -887,13 +1020,18 @@ DISTLIST= ${C_SRC} ${H_SRC} ${MAKE_FILE} BUGS CHANGES LIBRARY README \ # OBJS= ${LIBOBJS} ${CALCOBJS} ${UTIL_OBJS} +# Libaraies created and used to build calc +# +CALC_LIBS= libcalc.a custom/libcustcalc.a + # complete list of progs built # PROGS= calc ${UTIL_PROGS} # complete list of targets # -TARGETS= calc calc.1 lib/.all help/.all help/builtin +TARGETS= ${CALC_LIBS} custom/.all calc sample/sample \ + lib/.all help/.all help/builtin calc.1 ### @@ -902,10 +1040,10 @@ TARGETS= calc calc.1 lib/.all help/.all help/builtin # ### -all: ${TARGETS} +all: .hsrc ${TARGETS} -calc: libcalc.a ${CALCOBJS} - ${CC} ${LDFLAGS} ${CALCOBJS} libcalc.a -o calc +calc: .hsrc ${CALC_LIBS} ${CALCOBJS} + ${CC} ${LDFLAGS} ${CALCOBJS} ${CALC_LIBS} ${LD_DEBUG} -o calc libcalc.a: ${LIBOBJS} ${MAKE_FILE} -rm -f libcalc.a @@ -914,7 +1052,10 @@ libcalc.a: ${LIBOBJS} ${MAKE_FILE} calc.1: calc.man ${MAKE_FILE} -rm -f calc.1 - ${SED} -e 's:$${LIBDIR}:${LIBDIR}:g' < calc.man > calc.1 + ${SED} -e 's:$${LIBDIR}:${LIBDIR}:g' \ + -e 's,$${CALCPATH},${CALCPATH},g' \ + -e 's,$${CALCRC},${CALCRC},g' \ + -e 's,$${CALCBINDINGS},${CALCBINDINGS},g' < calc.man > calc.1 ## # @@ -923,7 +1064,10 @@ calc.1: calc.man ${MAKE_FILE} ## calc.o: calc.c ${MAKE_FILE} - ${CC} ${CCMAIN} ${CCOPT} -c calc.c + ${CC} ${CCMAIN} ${CCOPT} ${ALLOW_CUSTOM} -c calc.c + +custom.o: custom.c ${MAKE_FILE} + ${CC} ${CCOPT} ${ALLOW_CUSTOM} -c custom.c hist.o: hist.c ${MAKE_FILE} ${CC} ${CFLAGS} ${TERMCONTROL} -c hist.c @@ -931,49 +1075,23 @@ hist.o: hist.c ${MAKE_FILE} shs.o: shs.c ${MAKE_FILE} ${CC} ${CCSHS} -c shs.c -zprime.o: zprime.c ${MAKE_FILE} - ${CC} ${CCZPRIME} -c zprime.c +shs1.o: shs1.c ${MAKE_FILE} + ${CC} ${CCSHS} -c shs1.c - -## -# -# Doing a 'make check' will cause the regression test suite to be executed. -# This rule will try to build anything that needs to be built as well. -# -# Doing a 'make chk' will cause only the context around interesting -# (and error) messages to be printed. Unlike 'make check', this -# rule does not cause things to be built. I.e., the all rule is -# not invoked. -# -## - -check: all ./lib/regress.cal ./lib/lucas.cal ./lib/lucas_chk.cal \ - ./lib/test1700.cal ./lib/test2300.cal ./lib/test2600.cal \ - ./lib/test2700.cal ./lib/test3100.cal ./lib/test3300.cal \ - ./lib/test3400.cal ./lib/test3500.cal ./lib/test4000.cal \ - ./lib/test4100.cal ./lib/surd.cal - CALCPATH="./lib" ./calc -q read regress - -chk: ./lib/regress.cal ./lib/lucas.cal ./lib/lucas_chk.cal \ - ./lib/test1700.cal ./lib/test2300.cal ./lib/test2600.cal \ - ./lib/test2700.cal ./lib/test3100.cal ./lib/test3300.cal \ - ./lib/test3400.cal ./lib/test3500.cal ./lib/test4000.cal \ - ./lib/test4100.cal ./lib/surd.cal check.awk - ${V} echo '=-=-=-=-= start of $@ rule =-=-=-=-=' - CALCPATH="./lib" ./calc -q read regress 2>&1 | ${AWK} -f check.awk - ${V} echo '=-=-=-=-= end of $@ rule =-=-=-=-=' +func.o: func.c ${MAKE_FILE} + ${CC} ${CFLAGS} ${ALLOW_CUSTOM} -c func.c ## # # The next set of rules cause the .h files BUILD_H_SRC files to be built # according tot he system and the Makefile variables above. The hsrc rule -# is a conveient rule to invoke to built all of the BUILD_H_SRC. +# is a convenient rule to invoke to built all of the BUILD_H_SRC. # # We add in the BUILD_C_SRC files because they are similar to the # BUILD_H_SRC files in terms of the build process. # # NOTE: Due to bogus shells found on one common system we must have -# an non-emoty else clause for every if condition. *sigh* +# an non-empty else clause for every if condition. *sigh* # We also place ; true at the end of some commands to avoid # meaningless cosmetic messages by the same system. # @@ -981,6 +1099,10 @@ chk: ./lib/regress.cal ./lib/lucas.cal ./lib/lucas_chk.cal \ hsrc: ${BUILD_H_SRC} ${BUILD_C_SRC} +.hsrc: ${BUILD_H_SRC} ${BUILD_C_SRC} + -${Q}rm -f .hsrc + -${Q}touch .hsrc + conf.h: ${MAKE_FILE} -${Q}rm -f conf.h ${Q}echo 'forming conf.h' @@ -988,8 +1110,10 @@ conf.h: ${MAKE_FILE} ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> conf.h ${Q}echo ' */' >> conf.h ${Q}echo '' >> conf.h - ${Q}echo '#if !defined(_CONF_H_)' >> conf.h - ${Q}echo '#define _CONF_H_' >> conf.h + ${Q}echo '' >> conf.h + ${Q}echo '#if !defined(__CONF_H__)' >> conf.h + ${Q}echo '#define __CONF_H__' >> conf.h + ${Q}echo '' >> conf.h ${Q}echo '' >> conf.h ${Q}echo '/* the default :-separated search path */' >> conf.h ${Q}echo '#ifndef DEFAULTCALCPATH' >> conf.h @@ -1011,12 +1135,23 @@ conf.h: ${MAKE_FILE} ${Q}echo '#define HELPDIR "${HELPDIR}"' >> conf.h ${Q}echo '#endif /* HELPDIR */' >> conf.h ${Q}echo '' >> conf.h + ${Q}echo '/* the location of the custom help directory */' >> conf.h + ${Q}echo '#ifndef CUSTOMHELPDIR' >> conf.h + ${Q}echo '#define CUSTOMHELPDIR "${CUSTOMHELPDIR}"' >> conf.h + ${Q}echo '#endif /* CUSTOMHELPDIR */' >> conf.h + ${Q}echo '' >> conf.h ${Q}echo '/* the default pager to use */' >> conf.h ${Q}echo '#ifndef DEFAULTCALCPAGER' >> conf.h ${Q}echo '#define DEFAULTCALCPAGER "${CALCPAGER}"' >> conf.h ${Q}echo '#endif /* DEFAULTCALCPAGER */' >> conf.h ${Q}echo '' >> conf.h - ${Q}echo '#endif /* _CONF_H_ */' >> conf.h + ${Q}echo '/* where the echo command is located */' >> conf.h + ${Q}echo '#ifndef ECHO' >> conf.h + ${Q}echo '#define ECHO "${ECHO}"' >> conf.h + ${Q}echo '#endif /* ECHO */' >> conf.h + ${Q}echo '' >> conf.h + ${Q}echo '' >> conf.h + ${Q}echo '#endif /* !__CONF_H__ */' >> conf.h ${Q}echo 'conf.h formed' -@if [ -z "${Q}" ]; then \ echo ''; \ @@ -1035,21 +1170,31 @@ endian_calc.h: endian ${MAKE_FILE} ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> endian_calc.h ${Q}echo ' */' >> endian_calc.h ${Q}echo '' >> endian_calc.h - ${Q}echo '#if !defined(_ENDIAN_CALC_H_)' >> endian_calc.h - ${Q}echo '#define _ENDIAN_CALC_H_' >> endian_calc.h + ${Q}echo '' >> endian_calc.h + ${Q}echo '#if !defined(__ENDIAN_CALC_H__)' >> endian_calc.h + ${Q}echo '#define __ENDIAN_CALC_H__' >> endian_calc.h + ${Q}echo '' >> endian_calc.h ${Q}echo '' >> endian_calc.h ${Q}echo '/* what byte order are we? */' >> endian_calc.h -${Q}if [ X"${BYTE_ORDER}" = X ]; then \ - if [ -f /usr/include/machine/endian.h ]; then \ + if [ -f /usr/include/endian.h ]; then \ + echo '#include ' >> endian_calc.h; \ + echo '#define CALC_BYTE_ORDER BYTE_ORDER' >> endian_calc.h; \ + elif [ -f /usr/include/machine/endian.h ]; then \ echo '#include ' >> endian_calc.h; \ + echo '#define CALC_BYTE_ORDER BYTE_ORDER' >> endian_calc.h; \ + elif [ -f /usr/include/sys/endian.h ]; then \ + echo '#include ' >> endian_calc.h; \ + echo '#define CALC_BYTE_ORDER BYTE_ORDER' >> endian_calc.h; \ else \ ./endian >> endian_calc.h; \ fi; \ else \ - echo "#define BYTE_ORDER ${BYTE_ORDER}" >> endian_calc.h; \ + echo "#define CALC_BYTE_ORDER ${BYTE_ORDER}" >> endian_calc.h; \ fi ${Q}echo '' >> endian_calc.h - ${Q}echo '#endif /* _ENDIAN_CALC_H_ */' >> endian_calc.h + ${Q}echo '' >> endian_calc.h + ${Q}echo '#endif /* !__ENDIAN_CALC_H__ */' >> endian_calc.h ${Q}echo 'endian_calc.h formed' -@if [ -z "${Q}" ]; then \ echo ''; \ @@ -1068,16 +1213,15 @@ longbits.h: longbits ${MAKE_FILE} ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> longbits.h ${Q}echo ' */' >> longbits.h ${Q}echo '' >> longbits.h - ${Q}echo '#if !defined(_LONGBITS_H_)' >> longbits.h - ${Q}echo '#define _LONGBITS_H_' >> longbits.h ${Q}echo '' >> longbits.h - -${Q}if [ X"${LONG_BITS}" = X ]; then \ - ./longbits >> longbits.h; \ - else \ - echo "#define LONG_BITS ${LONG_BITS}" >> longbits.h; \ - fi + ${Q}echo '#if !defined(__LONGBITS_H__)' >> longbits.h + ${Q}echo '#define __LONGBITS_H__' >> longbits.h ${Q}echo '' >> longbits.h - ${Q}echo '#endif /* _LONGBITS_H_ */' >> longbits.h + ${Q}echo '' >> longbits.h + ${Q}./longbits ${LONG_BITS} >> longbits.h + ${Q}echo '' >> longbits.h + ${Q}echo '' >> longbits.h + ${Q}echo '#endif /* !__LONGBITS_H__ */' >> longbits.h ${Q}echo 'longbits.h formed' -@if [ -z "${Q}" ]; then \ echo ''; \ @@ -1096,8 +1240,10 @@ have_malloc.h: ${MAKE_FILE} ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> have_malloc.h ${Q}echo ' */' >> have_malloc.h ${Q}echo '' >> have_malloc.h - ${Q}echo '#if !defined(_HAVE_MALLOC_H_)' >> have_malloc.h - ${Q}echo '#define _HAVE_MALLOC_H_' >> have_malloc.h + ${Q}echo '' >> have_malloc.h + ${Q}echo '#if !defined(__HAVE_MALLOC_H__)' >> have_malloc.h + ${Q}echo '#define __HAVE_MALLOC_H__' >> have_malloc.h + ${Q}echo '' >> have_malloc.h ${Q}echo '' >> have_malloc.h ${Q}echo '/* do we have /usr/include/malloc.h? */' >> have_malloc.h -${Q}if [ -f /usr/include/malloc.h ]; then \ @@ -1106,7 +1252,8 @@ have_malloc.h: ${MAKE_FILE} echo '#undef HAVE_MALLOC_H /* no */' >> have_malloc.h; \ fi ${Q}echo '' >> have_malloc.h - ${Q}echo '#endif /* _HAVE_MALLOC_H_ */' >> have_malloc.h + ${Q}echo '' >> have_malloc.h + ${Q}echo '#endif /* !__HAVE_MALLOC_H__ */' >> have_malloc.h ${Q}echo 'have_malloc.h formed' -@if [ -z "${Q}" ]; then \ echo ''; \ @@ -1125,8 +1272,10 @@ have_times.h: ${MAKE_FILE} ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> have_times.h ${Q}echo ' */' >> have_times.h ${Q}echo '' >> have_times.h - ${Q}echo '#if !defined(_HAVE_TIMES_H_)' >> have_times.h - ${Q}echo '#define _HAVE_TIMES_H_' >> have_times.h + ${Q}echo '' >> have_times.h + ${Q}echo '#if !defined(__HAVE_TIMES_H__)' >> have_times.h + ${Q}echo '#define __HAVE_TIMES_H__' >> have_times.h + ${Q}echo '' >> have_times.h ${Q}echo '' >> have_times.h ${Q}echo '/* do we have /usr/include/times.h? */' >> have_times.h -${Q}if [ -f /usr/include/times.h ]; then \ @@ -1150,7 +1299,8 @@ have_times.h: ${MAKE_FILE} echo '#undef HAVE_SYS_TIME_H /* no */' >> have_times.h; \ fi ${Q}echo '' >> have_times.h - ${Q}echo '#endif /* _HAVE_TIMES_H_ */' >> have_times.h + ${Q}echo '' >> have_times.h + ${Q}echo '#endif /* !__HAVE_TIMES_H__ */' >> have_times.h ${Q}echo 'have_times.h formed' -@if [ -z "${Q}" ]; then \ echo ''; \ @@ -1169,8 +1319,10 @@ have_stdlib.h: ${MAKE_FILE} ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> have_stdlib.h ${Q}echo ' */' >> have_stdlib.h ${Q}echo '' >> have_stdlib.h - ${Q}echo '#if !defined(_HAVE_STDLIB_H_)' >> have_stdlib.h - ${Q}echo '#define _HAVE_STDLIB_H_' >> have_stdlib.h + ${Q}echo '' >> have_stdlib.h + ${Q}echo '#if !defined(__HAVE_STDLIB_H__)' >> have_stdlib.h + ${Q}echo '#define __HAVE_STDLIB_H__' >> have_stdlib.h + ${Q}echo '' >> have_stdlib.h ${Q}echo '' >> have_stdlib.h ${Q}echo '/* do we have /usr/include/stdlib.h? */' >> have_stdlib.h -${Q}if [ -f /usr/include/stdlib.h ]; then \ @@ -1179,7 +1331,8 @@ have_stdlib.h: ${MAKE_FILE} echo '#undef HAVE_STDLIB_H /* no */' >> have_stdlib.h; \ fi ${Q}echo '' >> have_stdlib.h - ${Q}echo '#endif /* _HAVE_STDLIB_H_ */' >> have_stdlib.h + ${Q}echo '' >> have_stdlib.h + ${Q}echo '#endif /* !__HAVE_STDLIB_H__ */' >> have_stdlib.h ${Q}echo 'have_stdlib.h formed' -@if [ -z "${Q}" ]; then \ echo ''; \ @@ -1198,8 +1351,10 @@ have_unistd.h: ${MAKE_FILE} ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> have_unistd.h ${Q}echo ' */' >> have_unistd.h ${Q}echo '' >> have_unistd.h - ${Q}echo '#if !defined(_HAVE_UNISTD_H_)' >> have_unistd.h - ${Q}echo '#define _HAVE_UNISTD_H_' >> have_unistd.h + ${Q}echo '' >> have_unistd.h + ${Q}echo '#if !defined(__HAVE_UNISTD_H__)' >> have_unistd.h + ${Q}echo '#define __HAVE_UNISTD_H__' >> have_unistd.h + ${Q}echo '' >> have_unistd.h ${Q}echo '' >> have_unistd.h ${Q}echo '/* do we have /usr/include/unistd.h? */' >> have_unistd.h -${Q}if [ -f /usr/include/unistd.h ]; then \ @@ -1208,7 +1363,8 @@ have_unistd.h: ${MAKE_FILE} echo '#undef HAVE_UNISTD_H /* no */' >> have_unistd.h; \ fi ${Q}echo '' >> have_unistd.h - ${Q}echo '#endif /* _HAVE_UNISTD_H_ */' >> have_unistd.h + ${Q}echo '' >> have_unistd.h + ${Q}echo '#endif /* !__HAVE_UNISTD_H__ */' >> have_unistd.h ${Q}echo 'have_unistd.h formed' -@if [ -z "${Q}" ]; then \ echo ''; \ @@ -1227,8 +1383,10 @@ have_string.h: ${MAKE_FILE} ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> have_string.h ${Q}echo ' */' >> have_string.h ${Q}echo '' >> have_string.h - ${Q}echo '#if !defined(_HAVE_STRING_H_)' >> have_string.h - ${Q}echo '#define _HAVE_STRING_H_' >> have_string.h + ${Q}echo '' >> have_string.h + ${Q}echo '#if !defined(__HAVE_STRING_H__)' >> have_string.h + ${Q}echo '#define __HAVE_STRING_H__' >> have_string.h + ${Q}echo '' >> have_string.h ${Q}echo '' >> have_string.h ${Q}echo '/* do we have /usr/include/string.h? */' >> have_string.h -${Q}if [ -f /usr/include/string.h ]; then \ @@ -1237,7 +1395,8 @@ have_string.h: ${MAKE_FILE} echo '#undef HAVE_STRING_H /* no */' >> have_string.h; \ fi ${Q}echo '' >> have_string.h - ${Q}echo '#endif /* _HAVE_STRING_H_ */' >> have_string.h + ${Q}echo '' >> have_string.h + ${Q}echo '#endif /* !__HAVE_STRING_H__ */' >> have_string.h ${Q}echo 'have_string.h formed' -@if [ -z "${Q}" ]; then \ echo ''; \ @@ -1256,8 +1415,10 @@ terminal.h: ${MAKE_FILE} ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> terminal.h ${Q}echo ' */' >> terminal.h ${Q}echo '' >> terminal.h - ${Q}echo '#if !defined(_TERMINAL_H_)' >> terminal.h - ${Q}echo '#define _TERMINAL_H_' >> terminal.h + ${Q}echo '' >> terminal.h + ${Q}echo '#if !defined(__TERMINAL_H__)' >> terminal.h + ${Q}echo '#define __TERMINAL_H__' >> terminal.h + ${Q}echo '' >> terminal.h ${Q}echo '' >> terminal.h ${Q}echo '/* determine the type of terminal interface */' >> terminal.h ${Q}echo '#if !defined(USE_TERMIOS)' >> terminal.h @@ -1280,7 +1441,8 @@ terminal.h: ${MAKE_FILE} ${Q}echo '#endif' >> terminal.h ${Q}echo '#endif' >> terminal.h ${Q}echo '' >> terminal.h - ${Q}echo '#endif /* _TERMINAL_H_ */' >> terminal.h + ${Q}echo '' >> terminal.h + ${Q}echo '#endif /* !__TERMINAL_H__ */' >> terminal.h ${Q}echo 'terminal.h formed' -@if [ -z "${Q}" ]; then \ echo ''; \ @@ -1299,8 +1461,10 @@ longlong.h: longlong.c have_stdlib.h have_string.h ${MAKE_FILE} ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> longlong.h ${Q}echo ' */' >> longlong.h ${Q}echo '' >> longlong.h - ${Q}echo '#if !defined(_LONGLONG_H_)' >> longlong.h - ${Q}echo '#define _LONGLONG_H_' >> longlong.h + ${Q}echo '' >> longlong.h + ${Q}echo '#if !defined(__LONGLONG_H__)' >> longlong.h + ${Q}echo '#define __LONGLONG_H__' >> longlong.h + ${Q}echo '' >> longlong.h ${Q}echo '' >> longlong.h ${Q}echo '/* do we have/want to use a long long type? */' >> longlong.h -${Q}rm -f longlong.o longlong @@ -1315,7 +1479,8 @@ longlong.h: longlong.c have_stdlib.h have_string.h ${MAKE_FILE} echo '#define LONGLONG_BITS 0 /* no */' >> longlong.h; \ fi ${Q}echo '' >> longlong.h - ${Q}echo '#endif /* _LONGLONG_H_ */' >> longlong.h + ${Q}echo '' >> longlong.h + ${Q}echo '#endif /* !__LONGLONG_H__ */' >> longlong.h -${Q}rm -f longlong longlong.o ll_tmp ${Q}echo 'longlong.h formed' -@if [ -z "${Q}" ]; then \ @@ -1335,8 +1500,10 @@ have_fpos.h: have_fpos.c ${MAKE_FILE} ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> have_fpos.h ${Q}echo ' */' >> have_fpos.h ${Q}echo '' >> have_fpos.h - ${Q}echo '#if !defined(_HAVE_FPOS_H_)' >> have_fpos.h - ${Q}echo '#define _HAVE_FPOS_H_' >> have_fpos.h + ${Q}echo '' >> have_fpos.h + ${Q}echo '#if !defined(__HAVE_FPOS_H__)' >> have_fpos.h + ${Q}echo '#define __HAVE_FPOS_H__' >> have_fpos.h + ${Q}echo '' >> have_fpos.h ${Q}echo '' >> have_fpos.h ${Q}echo '/* do we have fgetpos & fsetpos functions? */' >> have_fpos.h -${Q}rm -f have_fpos.o have_fpos @@ -1352,7 +1519,8 @@ have_fpos.h: have_fpos.c ${MAKE_FILE} echo 'typedef long FILEPOS;' >> have_fpos.h; \ fi ${Q}echo '' >> have_fpos.h - ${Q}echo '#endif /* _HAVE_FPOS_H_ */' >> have_fpos.h + ${Q}echo '' >> have_fpos.h + ${Q}echo '#endif /* !__HAVE_FPOS_H__ */' >> have_fpos.h -${Q}rm -f have_fpos have_fpos.o fpos_tmp ${Q}echo 'have_fpos.h formed' -@if [ -z "${Q}" ]; then \ @@ -1365,15 +1533,18 @@ have_fpos.h: have_fpos.c ${MAKE_FILE} true; \ fi -fposval.h: fposval.c have_fpos.h endian_calc.h ${MAKE_FILE} +fposval.h: fposval.c have_fpos.h have_offscl.h have_posscl.h \ + endian_calc.h ${MAKE_FILE} -${Q}rm -f fposv_tmp fposval fposval.o fposval.h ${Q}echo 'forming fposval.h' ${Q}echo '/*' > fposval.h ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> fposval.h ${Q}echo ' */' >> fposval.h ${Q}echo '' >> fposval.h - ${Q}echo '#if !defined(_FPOSVAL_H_)' >> fposval.h - ${Q}echo '#define _FPOSVAL_H_' >> fposval.h + ${Q}echo '' >> fposval.h + ${Q}echo '#if !defined(__FPOSVAL_H__)' >> fposval.h + ${Q}echo '#define __FPOSVAL_H__' >> fposval.h + ${Q}echo '' >> fposval.h ${Q}echo '' >> fposval.h ${Q}echo '/* what are our file position & size types? */' >> fposval.h -${Q}rm -f fposval.o fposval @@ -1382,7 +1553,8 @@ fposval.h: fposval.c have_fpos.h endian_calc.h ${MAKE_FILE} ${Q}${SHELL} -c "./fposval fposv_tmp >> fposval.h 2>/dev/null" \ >/dev/null 2>&1; true ${Q}echo '' >> fposval.h - ${Q}echo '#endif /* _FPOSVAL_H_ */' >> fposval.h + ${Q}echo '' >> fposval.h + ${Q}echo '#endif /* !__FPOSVAL_H__ */' >> fposval.h -${Q}rm -f fposval fposval.o fposv_tmp ${Q}echo 'fposval.h formed' -@if [ -z "${Q}" ]; then \ @@ -1402,8 +1574,10 @@ have_const.h: have_const.c ${MAKE_FILE} ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> have_const.h ${Q}echo ' */' >> have_const.h ${Q}echo '' >> have_const.h - ${Q}echo '#if !defined(_HAVE_CONST_H_)' >> have_const.h - ${Q}echo '#define _HAVE_CONST_H_' >> have_const.h + ${Q}echo '' >> have_const.h + ${Q}echo '#if !defined(__HAVE_CONST_H__)' >> have_const.h + ${Q}echo '#define __HAVE_CONST_H__' >> have_const.h + ${Q}echo '' >> have_const.h ${Q}echo '' >> have_const.h ${Q}echo '/* do we have or want const? */' >> have_const.h -${Q}rm -f have_const.o have_const @@ -1417,10 +1591,10 @@ have_const.h: have_const.c ${MAKE_FILE} echo '#undef HAVE_CONST /* no */' >> have_const.h; \ echo '#undef CONST' >> have_const.h; \ echo '#define CONST /* no */' >> have_const.h; \ - echo '' >> have_const.h; \ fi ${Q}echo '' >> have_const.h - ${Q}echo '#endif /* _HAVE_CONST_H_ */' >> have_const.h + ${Q}echo '' >> have_const.h + ${Q}echo '#endif /* !__HAVE_CONST_H__ */' >> have_const.h -${Q}rm -f have_const have_const.o const_tmp ${Q}echo 'have_const.h formed' -@if [ -z "${Q}" ]; then \ @@ -1433,6 +1607,82 @@ have_const.h: have_const.c ${MAKE_FILE} true; \ fi +have_offscl.h: have_offscl.c ${MAKE_FILE} + -${Q}rm -f have_offscl have_offscl.o offscl_tmp have_offscl.h + ${Q}echo 'forming have_offscl.h' + ${Q}echo '/*' > have_offscl.h + ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> have_offscl.h + ${Q}echo ' */' >> have_offscl.h + ${Q}echo '' >> have_offscl.h + ${Q}echo '' >> have_offscl.h + ${Q}echo '#if !defined(__HAVE_OFFSCL_H__)' >> have_offscl.h + ${Q}echo '#define __HAVE_OFFSCL_H__' >> have_offscl.h + ${Q}echo '' >> have_offscl.h + ${Q}echo '' >> have_offscl.h + -${Q}rm -f have_offscl.o have_offscl + -${Q}${CC} ${CCMAIN} ${HAVE_OFFSCL} have_offscl.c -c 2>/dev/null; true + -${Q}${CC} ${ILDFLAGS} have_offscl.o -o have_offscl 2>/dev/null; true + -${Q}${SHELL} -c "./have_offscl > offscl_tmp 2>/dev/null" \ + >/dev/null 2>&1; true + -${Q}if [ -s offscl_tmp ]; then \ + cat offscl_tmp >> have_offscl.h; \ + else \ + echo '#undef HAVE_OFF_T_SCALAR /* off_t is not a simple value */' \ + >> have_offscl.h; \ + fi + ${Q}echo '' >> have_offscl.h + ${Q}echo '' >> have_offscl.h + ${Q}echo '#endif /* !__HAVE_OFFSCL_H__ */' >> have_offscl.h + -${Q}rm -f have_offscl have_offscl.o offscl_tmp + ${Q}echo 'have_offscl.h formed' + -@if [ -z "${Q}" ]; then \ + echo ''; \ + echo '=-=-= start of $@ =-=-='; \ + cat $@; \ + echo '=-=-= end of $@ =-=-='; \ + echo ''; \ + else \ + true; \ + fi + +have_posscl.h: have_posscl.c have_fpos.h ${MAKE_FILE} + -${Q}rm -f have_posscl have_posscl.o posscl_tmp have_posscl.h + ${Q}echo 'forming have_posscl.h' + ${Q}echo '/*' > have_posscl.h + ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> have_posscl.h + ${Q}echo ' */' >> have_posscl.h + ${Q}echo '' >> have_posscl.h + ${Q}echo '' >> have_posscl.h + ${Q}echo '#if !defined(__HAVE_POSSCL_H__)' >> have_posscl.h + ${Q}echo '#define __HAVE_POSSCL_H__' >> have_posscl.h + ${Q}echo '' >> have_posscl.h + ${Q}echo '' >> have_posscl.h + -${Q}rm -f have_posscl.o have_posscl + -${Q}${CC} ${CCMAIN} ${HAVE_POSSCL} have_posscl.c -c 2>/dev/null; true + -${Q}${CC} ${ILDFLAGS} have_posscl.o -o have_posscl 2>/dev/null; true + -${Q}${SHELL} -c "./have_posscl > posscl_tmp 2>/dev/null" \ + >/dev/null 2>&1; true + -${Q}if [ -s posscl_tmp ]; then \ + cat posscl_tmp >> have_posscl.h; \ + else \ + echo '/* FILEPOS is not a simple value */' >> have_posscl.h; \ + echo '#undef HAVE_FILEPOS_SCALAR' >> have_posscl.h; \ + fi + ${Q}echo '' >> have_posscl.h + ${Q}echo '' >> have_posscl.h + ${Q}echo '#endif /* !__HAVE_POSSCL_H__ */' >> have_posscl.h + -${Q}rm -f have_posscl have_posscl.o posscl_tmp + ${Q}echo 'have_posscl.h formed' + -@if [ -z "${Q}" ]; then \ + echo ''; \ + echo '=-=-= start of $@ =-=-='; \ + cat $@; \ + echo '=-=-= end of $@ =-=-='; \ + echo ''; \ + else \ + true; \ + fi + align32.h: align32.c longbits.h have_unistd.h ${MAKE_FILE} -${Q}rm -f align32 align32.o align32_tmp align32.h ${Q}echo 'forming align32.h' @@ -1440,8 +1690,10 @@ align32.h: align32.c longbits.h have_unistd.h ${MAKE_FILE} ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> align32.h ${Q}echo ' */' >> align32.h ${Q}echo '' >> align32.h - ${Q}echo '#if !defined(_MUST_ALIGN32_H_)' >> align32.h - ${Q}echo '#define _MUST_ALIGN32_H_' >> align32.h + ${Q}echo '' >> align32.h + ${Q}echo '#if !defined(__MUST_ALIGN32_H__)' >> align32.h + ${Q}echo '#define __MUST_ALIGN32_H__' >> align32.h + ${Q}echo '' >> align32.h ${Q}echo '' >> align32.h ${Q}echo '/* must we always align 32 bit accesses? */' >> align32.h -${Q}if [ X"-DMUST_ALIGN32" = X${ALIGN32} ]; then \ @@ -1472,7 +1724,8 @@ align32.h: align32.c longbits.h have_unistd.h ${MAKE_FILE} true; \ fi ${Q}echo '' >> align32.h - ${Q}echo '#endif /* _MUST_ALIGN32_H_ */' >> align32.h + ${Q}echo '' >> align32.h + ${Q}echo '#endif /* !__MUST_ALIGN32_H__ */' >> align32.h ${Q}echo 'align32.h formed' -@if [ -z "${Q}" ]; then \ echo ''; \ @@ -1491,8 +1744,10 @@ have_uid_t.h: have_uid_t.c have_unistd.h ${MAKE_FILE} ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> have_uid_t.h ${Q}echo ' */' >> have_uid_t.h ${Q}echo '' >> have_uid_t.h - ${Q}echo '#if !defined(_HAVE_UID_T_H_)' >> have_uid_t.h - ${Q}echo '#define _HAVE_UID_T_H_' >> have_uid_t.h + ${Q}echo '' >> have_uid_t.h + ${Q}echo '#if !defined(__HAVE_UID_T_H__)' >> have_uid_t.h + ${Q}echo '#define __HAVE_UID_T_H__' >> have_uid_t.h + ${Q}echo '' >> have_uid_t.h ${Q}echo '' >> have_uid_t.h ${Q}echo '/* do we have or want uid_t? */' >> have_uid_t.h -${Q}rm -f have_uid_t.o have_uid_t @@ -1504,10 +1759,10 @@ have_uid_t.h: have_uid_t.c have_unistd.h ${MAKE_FILE} cat uid_tmp >> have_uid_t.h; \ else \ echo '#undef HAVE_UID_T /* no */' >> have_uid_t.h; \ - echo '' >> have_uid_t.h; \ fi ${Q}echo '' >> have_uid_t.h - ${Q}echo '#endif /* _HAVE_UID_T_H_ */' >> have_uid_t.h + ${Q}echo '' >> have_uid_t.h + ${Q}echo '#endif /* !__HAVE_UID_T_H__ */' >> have_uid_t.h -${Q}rm -f have_uid_t have_uid_t.o uid_tmp ${Q}echo 'have_uid_t.h formed' -@if [ -z "${Q}" ]; then \ @@ -1527,8 +1782,10 @@ have_newstr.h: have_newstr.c ${MAKE_FILE} ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> have_newstr.h ${Q}echo ' */' >> have_newstr.h ${Q}echo '' >> have_newstr.h - ${Q}echo '#if !defined(_HAVE_NEWSTR_H_)' >> have_newstr.h - ${Q}echo '#define _HAVE_NEWSTR_H_' >> have_newstr.h + ${Q}echo '' >> have_newstr.h + ${Q}echo '#if !defined(__HAVE_NEWSTR_H__)' >> have_newstr.h + ${Q}echo '#define __HAVE_NEWSTR_H__' >> have_newstr.h + ${Q}echo '' >> have_newstr.h ${Q}echo '' >> have_newstr.h ${Q}echo '/* do we have or want memcpy(), memset() & strchr()? */' \ >> have_newstr.h @@ -1541,10 +1798,10 @@ have_newstr.h: have_newstr.c ${MAKE_FILE} cat newstr_tmp >> have_newstr.h; \ else \ echo '#undef HAVE_NEWSTR /* no */' >> have_newstr.h; \ - echo '' >> have_newstr.h; \ fi ${Q}echo '' >> have_newstr.h - ${Q}echo '#endif /* _HAVE_NEWSTR_H_ */' >> have_newstr.h + ${Q}echo '' >> have_newstr.h + ${Q}echo '#endif /* !__HAVE_NEWSTR_H__ */' >> have_newstr.h -${Q}rm -f have_newstr have_newstr.o newstr_tmp ${Q}echo 'have_newstr.h formed' -@if [ -z "${Q}" ]; then \ @@ -1557,6 +1814,44 @@ have_newstr.h: have_newstr.c ${MAKE_FILE} true; \ fi +have_memmv.h: have_memmv.c ${MAKE_FILE} + -${Q}rm -f have_memmv have_memmv.o newstr_tmp have_memmv.h + ${Q}echo 'forming have_memmv.h' + ${Q}echo '/*' > have_memmv.h + ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> have_memmv.h + ${Q}echo ' */' >> have_memmv.h + ${Q}echo '' >> have_memmv.h + ${Q}echo '' >> have_memmv.h + ${Q}echo '#if !defined(__HAVE_MEMMV_H__)' >> have_memmv.h + ${Q}echo '#define __HAVE_MEMMV_H__' >> have_memmv.h + ${Q}echo '' >> have_memmv.h + ${Q}echo '' >> have_memmv.h + ${Q}echo '/* do we have or want memmove()? */' >> have_memmv.h + -${Q}rm -f have_memmv.o have_memmv + -${Q}${CC} ${CCMAIN} ${HAVE_MEMMOVE} have_memmv.c -c 2>/dev/null; true + -${Q}${CC} ${ILDFLAGS} have_memmv.o -o have_memmv 2>/dev/null; true + -${Q}${SHELL} -c "./have_memmv > newstr_tmp 2>/dev/null" \ + >/dev/null 2>&1; true + -${Q}if [ -s newstr_tmp ]; then \ + cat newstr_tmp >> have_memmv.h; \ + else \ + echo '#undef HAVE_MEMMOVE /* no */' >> have_memmv.h; \ + fi + ${Q}echo '' >> have_memmv.h + ${Q}echo '' >> have_memmv.h + ${Q}echo '#endif /* !__HAVE_MEMMV_H__ */' >> have_memmv.h + -${Q}rm -f have_memmv have_memmv.o newstr_tmp + ${Q}echo 'have_memmv.h formed' + -@if [ -z "${Q}" ]; then \ + echo ''; \ + echo '=-=-= start of $@ =-=-='; \ + cat $@; \ + echo '=-=-= end of $@ =-=-='; \ + echo ''; \ + else \ + true; \ + fi + args.h: have_stdvs.c have_varvs.c have_string.h have_unistd.h have_string.h -${Q}rm -f args.h have_args ${Q}echo 'forming args.h' @@ -1564,8 +1859,10 @@ args.h: have_stdvs.c have_varvs.c have_string.h have_unistd.h have_string.h ${Q}echo ' * DO NOT EDIT -- generated by the Makefile' >> args.h ${Q}echo ' */' >> args.h ${Q}echo '' >> args.h - ${Q}echo '#if !defined(_ARGS_H_)' >> args.h - ${Q}echo '#define _ARGS_H_' >> args.h + ${Q}echo '' >> args.h + ${Q}echo '#if !defined(__ARGS_H__)' >> args.h + ${Q}echo '#define __ARGS_H__' >> args.h + ${Q}echo '' >> args.h ${Q}echo '' >> args.h -${Q}rm -f have_stdvs.o have_stdvs -${Q}${CC} ${CCMAIN} ${HAVE_VSPRINTF} have_stdvs.c -c 2>/dev/null; true @@ -1597,7 +1894,8 @@ args.h: have_stdvs.c have_varvs.c have_string.h have_unistd.h have_string.h fi ${Q}sh ./have_args ${Q}echo '' >> args.h - ${Q}echo '#endif /* _ARGS_H_ */' >> args.h + ${Q}echo '' >> args.h + ${Q}echo '#endif /* !__ARGS_H__ */' >> args.h -${Q}rm -f have_stdvs.o have_varvs.o have_stdvs -${Q}rm -f have_varvs have_args core ${Q}echo 'args.h formed' @@ -1620,13 +1918,16 @@ calcerr.h: calcerr.tbl calcerr_h.sed calcerr_h.awk ${MAKE_FILE} ${Q}echo ' * generated by calcerr.tbl via Makefile' >> calcerr.h ${Q}echo ' */' >> calcerr.h ${Q}echo '' >> calcerr.h - ${Q}echo '#if !defined(_CALCERR_H_)' >> calcerr.h - ${Q}echo '#define _CALCERR_H_' >> calcerr.h + ${Q}echo '' >> calcerr.h + ${Q}echo '#if !defined(__CALCERR_H__)' >> calcerr.h + ${Q}echo '#define __CALCERR_H__' >> calcerr.h + ${Q}echo '' >> calcerr.h ${Q}echo '' >> calcerr.h ${Q}${SED} -f calcerr_h.sed < calcerr.tbl | \ ${AWK} -f calcerr_h.awk >> calcerr.h ${Q}echo '' >> calcerr.h - ${Q}echo '#endif /* _CALCERR_H_ */' >> calcerr.h + ${Q}echo '' >> calcerr.h + ${Q}echo '#endif /* !__CALCERR_H__ */' >> calcerr.h ${Q}echo 'calcerr.h formed' -@if [ -z "${Q}" ]; then \ echo ''; \ @@ -1712,6 +2013,78 @@ help/builtin: func.c help/builtin.top help/builtin.end help/funclist.sed ${V} echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' ${V} echo '=-=-=-=-= end of $@ rule =-=-=-=-=' +# This is a special rule that first tries to determine of a lower level +# make is needed, and it so a make will be performed. Because it is +# triggered as the first dependent of the all rule, it will ensure +# that custom/libcustcalc.a is ready. +# +custom/libcustcalc: + ${V} echo '=-=-=-=-= start of $@ rule =-=-=-=-=' + ${V} echo '=-=-=-=-= Invoking all rule for custom =-=-=-=-=' + -${Q}rm -f .libcustcalc_error + -${Q}NEED="`cd custom; ${MAKE} -n -f Makefile all`"; \ + if [ ! -z "$$NEED" ]; then \ + echo " cd custom; ${MAKE} -f Makefile ${CUSTOM_PASSDOWN} all";\ + cd custom; ${MAKE} -f Makefile ${CUSTOM_PASSDOWN} all; \ + status="$$?"; \ + if [ "$$status" -ne 0 ]; then \ + echo "$$status" > ../.libcustcalc_error; \ + fi; \ + fi + ${Q}if [ -f .libcustcalc_error ]; then \ + echo "custom make failed, code: `cat .libcustcalc_error`" 1>&2; \ + exit "`cat .libcustcalc_error`"; \ + else \ + true ; \ + fi + ${V} echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' + ${V} echo '=-=-=-=-= end of $@ rule =-=-=-=-=' + +# This is the real custom/libcustcalc.a rule. +# +custom/libcustcalc.a: + ${V} echo '=-=-=-=-= start of $@ rule =-=-=-=-=' + ${V} echo '=-=-=-=-= Invoking all rule for custom =-=-=-=-=' + cd custom; ${MAKE} -f Makefile ${CUSTOM_PASSDOWN} all + ${V} echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' + ${V} echo '=-=-=-=-= end of $@ rule =-=-=-=-=' + +# This is a special rule that first tries to determine of a lower level +# make is needed, and it so a make will be performed. Because it is +# triggered as a dependent of the all rule, it will ensure the sample +# routines get built. +# +sample/sample: + ${V} echo '=-=-=-=-= start of $@ rule =-=-=-=-=' + ${V} echo '=-=-=-=-= Invoking all rule for sample =-=-=-=-=' + -${Q}rm -f .sample_error + -${Q}NEED="`cd sample; ${MAKE} -n -f Makefile all`"; \ + if [ ! -z "$$NEED" ]; then \ + echo " cd sample; ${MAKE} -f Makefile ${SAMPLE_PASSDOWN} all";\ + cd sample; ${MAKE} -f Makefile ${SAMPLE_PASSDOWN} all; \ + status="$$?"; \ + if [ "$$status" -ne 0 ]; then \ + echo "$$status" > ../.sample_error; \ + fi; \ + fi + ${Q}if [ -f .sample_error ]; then \ + echo "sample make failed, code: `cat .sample_error`" 1>&2; \ + exit "`cat .sample_error`"; \ + else \ + true ; \ + fi + ${V} echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' + ${V} echo '=-=-=-=-= end of $@ rule =-=-=-=-=' + +# This is the real sample/all rule. +# +sample/all: + ${V} echo '=-=-=-=-= start of $@ rule =-=-=-=-=' + ${V} echo '=-=-=-=-= Invoking all rule for sample =-=-=-=-=' + cd sample; ${MAKE} -f Makefile ${SAMPLE_PASSDOWN} all + ${V} echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' + ${V} echo '=-=-=-=-= end of $@ rule =-=-=-=-=' + ## # # The BSDI cdrom makefile expects certain files to be pre-built in a sub-dir @@ -1777,13 +2150,20 @@ depend: hsrc else \ true; \ fi + ${V} echo '=-=-=-=-= Invoking depend rule for custom =-=-=-=-=' + -${Q}(cd custom; ${MAKE} -f Makefile ${CUSTOM_PASSDOWN} depend) + ${V} echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' + ${V} echo '=-=-=-=-= Invoking depend rule for sample =-=-=-=-=' + -${Q}(cd sample; ${MAKE} -f Makefile ${SAMPLE_PASSDOWN} depend) + ${V} echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' ${Q}echo forming skel -${Q}rm -rf skel ${Q}mkdir skel -${Q}for i in ${C_SRC} ${BUILD_C_SRC}; do \ ${SED} -n '/^#[ ]*include[ ]*"/p' "$$i" > "skel/$$i"; \ done - -${Q}for i in ${H_SRC} ${BUILD_H_SRC}; do \ + ${Q}mkdir skel/custom + -${Q}for i in ${H_SRC} ${BUILD_H_SRC} custom.h; do \ tag="`echo $$i | ${SED} 's/[\.+,:]/_/g'`"; \ echo "#ifndef $$tag" > "skel/$$i"; \ echo "#define $$tag" >> "skel/$$i"; \ @@ -1809,7 +2189,19 @@ depend: hsrc ${Q}echo "" >> Makefile ${Q}${SED} -n '3,$$p' skel/makedep.out | ${SORT} -u >> Makefile -${Q}rm -rf skel - ${Q}echo new Makefile formed + -${Q}if cmp -s Makefile.bak Makefile; then \ + echo 'Makefile was already up to date'; \ + mv -f Makefile.bak Makefile; \ + else \ + echo 'new Makefile formed'; \ + fi + +# generate the list of h files for lower level depend use +# +h_list: + -${Q}for i in ${H_SRC} ${BUILD_H_SRC}; do \ + echo $$i; \ + done ## # @@ -1829,7 +2221,9 @@ distlist: ${DISTLIST} HELPDIR=${HELPDIR} SORT=${SORT}); \ (cd lib; ${MAKE} distlist \ MAKE_FILE=${MAKE_FILE} TOPDIR=${TOPDIR} LIBDIR=${LIBDIR} \ - HELPDIR=${HELPDIR} SORT=${SORT}) ) | ${SORT} + HELPDIR=${HELPDIR} SORT=${SORT}) ) | ${SORT}; \ + (cd custom; ${MAKE} ${CUSTOM_PASSDOWN} distlist); \ + (cd sample; ${MAKE} ${SAMPLE_PASSDOWN} distlist) | ${SORT} # The bsdi distribution has generated files as well as distributed files. # The the .h files are placed under calc/gen_h. @@ -1849,6 +2243,26 @@ bsdilist: ${DISTLIST} ${BUILD_H_SRC} calc.1 MAKE_FILE=${MAKE_FILE} TOPDIR=${TOPDIR} LIBDIR=${LIBDIR} \ HELPDIR=${HELPDIR} SORT=${SORT}) ) | ${SORT} +## +# +# Doing a 'make check' will cause the regression test suite to be executed. +# This rule will try to build anything that needs to be built as well. +# +# Doing a 'make chk' will cause only the context around interesting +# (and error) messages to be printed. Unlike 'make check', this +# rule does not cause things to be built. I.e., the all rule is +# not invoked. +# +## + +check: all ./lib/regress.cal ${REGRESS_CAL} + ${CALC_ENV} ./calc -i -q read regress + +chk: ./lib/regress.cal ${REGRESS_CAL} + ${V} echo '=-=-=-=-= start of $@ rule =-=-=-=-=' + ${CALC_ENV} ./calc -i -q read regress 2>&1 | ${AWK} -f check.awk + ${V} echo '=-=-=-=-= end of $@ rule =-=-=-=-=' + ## # # debug @@ -1875,14 +2289,19 @@ env: @echo "LONG_BITS=${LONG_BITS}"; echo "" @echo "LONGLONG_BITS=${LONGLONG_BITS}"; echo "" @echo "HAVE_FPOS=${HAVE_FPOS}"; echo "" + @echo "HAVE_OFFSCL=${HAVE_OFFSCL}"; echo "" + @echo "HAVE_POSSCL=${HAVE_POSSCL}"; echo "" @echo "HAVE_CONST=${HAVE_CONST}"; echo "" @echo "HAVE_UID_T=${HAVE_UID_T}"; echo "" @echo "HAVE_NEWSTR=${HAVE_NEWSTR}"; echo "" @echo "ALIGN32=${ALIGN32}"; echo "" + @echo "MAIN=${MAIN}"; echo "" @echo "BINDIR=${BINDIR}"; echo "" @echo "TOPDIR=${TOPDIR}"; echo "" @echo "LIBDIR=${LIBDIR}"; echo "" @echo "HELPDIR=${HELPDIR}"; echo "" + @echo "CUSTOMLIBDIR=${CUSTOMLIBDIR}"; echo "" + @echo "CUSTOMHELPDIR=${CUSTOMHELPDIR}"; echo "" @echo "MANDIR=${MANDIR}"; echo "" @echo "CATDIR=${CATDIR}"; echo "" @echo "MANEXT=${MANEXT}"; echo "" @@ -1901,14 +2320,17 @@ env: @echo "LINTLIB=${LINTLIB}"; echo "" @echo "LINTFLAGS=${LINTFLAGS}"; echo "" @echo "MAKE_FILE=${MAKE_FILE}"; echo "" - @echo "CCMAIN=${CCMAIN}"; echo "" - @echo "CCWARN=${CCWARN}"; echo "" + @echo "PURIFY=${PURIFY}"; echo "" + @echo "LD_DEBUG=${LD_DEBUG}"; echo "" + @echo "CALC_ENV=${CALC_ENV}"; echo "" + @echo "ALLOW_CUSTOM=${ALLOW_CUSTOM}"; echo "" @echo "CCOPT=${CCOPT}"; echo "" + @echo "CCWARN=${CCWARN}"; echo "" @echo "CCMISC=${CCMISC}"; echo "" - @echo "CCSHS=${CCSHS}"; echo "" @echo "CFLAGS=${CFLAGS}"; echo "" - @echo "CNOWARN=${CNOWARN}"; echo "" @echo "ICFLAGS=${ICFLAGS}"; echo "" + @echo "CCMAIN=${CCMAIN}"; echo "" + @echo "CCSHS=${CCSHS}"; echo "" @echo "LCFLAGS=${LCFLAGS}"; echo "" @echo "LDFLAGS=${LDFLAGS}"; echo "" @echo "ILDFLAGS=${ILDFLAGS}"; echo "" @@ -1936,11 +2358,14 @@ env: @echo "UTIL_TMP=${UTIL_TMP}"; echo "" @echo "UTIL_PROGS=${UTIL_PROGS}"; echo "" @echo "LIB_H_SRC=${LIB_H_SRC}"; echo "" - @echo "CALC_H_SRC=${CALC_H_SRC}"; echo "" + @echo "REGRESS_CAL=${REGRESS_CAL}"; echo "" + @echo "CUSTOM_PASSDOWN=${CUSTOM_PASSDOWN}"; echo "" + @echo "SAMPLE_PASSDOWN=${SAMPLE_PASSDOWN}"; echo "" @echo "H_SRC=${H_SRC}"; echo "" @echo "C_SRC=${C_SRC}"; echo "" @echo "DISTLIST=${DISTLIST}"; echo "" @echo "OBJS=${OBJS}"; echo "" + @echo "CALC_LIBS=${CALC_LIBS}"; echo "" @echo "PROGS=${PROGS}"; echo "" @echo "TARGETS=${TARGETS}"; echo "" @echo '=-=-=-=-= end of major make variable dump =-=-=-=-=' @@ -1955,7 +2380,7 @@ mkdebug: env version.c HELPDIR=${HELPDIR} Q= V=@ all @echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' @echo '=-=-=-=-= Determining the binary version =-=-=-=-=' - -@./calc -v + -@./calc -e -q -v @echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' @echo '=-=-=-=-= end of $@ rule =-=-=-=-=' @@ -1973,7 +2398,7 @@ debug: env MAKE_FILE=${MAKE_FILE} TOPDIR=${TOPDIR} LIBDIR=${LIBDIR} \ HELPDIR=${HELPDIR} Q= V=@ all @echo '=-=-=-=-= Determining the binary version =-=-=-=-=' - -@./calc -v + -@./calc -e -q -v @echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' @echo '=-=-=-=-= Invoking ${MAKE} -f Makefile Q= V=@ chk =-=-=-=-=' @echo '=-=-=-=-= this may take a while =-=-=-=-=' @@ -1983,6 +2408,34 @@ debug: env @echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' @echo '=-=-=-=-= end of $@ rule =-=-=-=-=' +## +# +# make run +# * only run calc interactively with the ${CALC_ENV} environment +# +# make cvd +# * run the SGI WorkShop debugger on calc with the ${CALC_ENV} environment +# +# make dbx +# * run the dbx debugger on calc with the ${CALC_ENV} environment +# +# make gdb +# * run the gdb debugger on calc with the ${CALC_ENV} environment +# +## + +run: + ${CALC_ENV} ./calc + +cvd: + ${CALC_ENV} cvd ./calc + +dbx: + ${CALC_ENV} dbx ./calc + +gdb: + ${CALC_ENV} gdb ./calc + ## # # Utility rules @@ -1990,7 +2443,8 @@ debug: env ## tags: ${CALCSRC} ${LIBSRC} ${H_SRC} ${BUILD_H_SRC} ${MAKE_FILE} - ${CTAGS} ${CALCSRC} ${LIBSRC} ${H_SRC} ${BUILD_H_SRC} + -${CTAGS} ${CALCSRC} ${LIBSRC} ${H_SRC} ${BUILD_H_SRC} 2>&1 | \ + egrep -v 'Duplicate entry|Second entry ignored' lintclean: -rm -f llib-lcalc.ln llib.out lint.out @@ -2002,6 +2456,7 @@ clean: -rm -f ${UTIL_OBJS} -rm -f ${UTIL_TMP} -rm -f ${UTIL_PROGS} + -rm -f .libcustcalc_error ${Q}echo '=-=-=-=-= Invoking $@ rule for help =-=-=-=-=' -cd help; ${MAKE} -f Makefile \ MAKE_FILE=${MAKE_FILE} TOPDIR=${TOPDIR} LIBDIR=${LIBDIR} \ @@ -2012,6 +2467,12 @@ clean: MAKE_FILE=${MAKE_FILE} TOPDIR=${TOPDIR} LIBDIR=${LIBDIR} \ HELPDIR=${HELPDIR} clean ${Q}echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' + ${V} echo '=-=-=-=-= Invoking $@ rule for custom =-=-=-=-=' + cd custom; ${MAKE} -f Makefile ${CUSTOM_PASSDOWN} clean + ${V} echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' + ${V} echo '=-=-=-=-= Invoking $@ rule for sample =-=-=-=-=' + cd sample; ${MAKE} -f Makefile ${SAMPLE_PASSDOWN} clean + ${V} echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' -rm -f funclist.o funclist.c ${Q}echo remove files that are obsolete -rm -f endian.h stdarg.h libcalcerr.a lib/obj help/obj @@ -2025,7 +2486,7 @@ clobber: lintclean -rm -f ${UTIL_OBJS} -rm -f ${UTIL_TMP} -rm -f ${UTIL_PROGS} - -rm -f tags + -rm -f tags .hsrc hsrc -rm -f ${BUILD_H_SRC} -rm -f ${BUILD_C_SRC} -rm -f calc *_pure_*.[oa] @@ -2044,6 +2505,12 @@ clobber: lintclean MAKE_FILE=${MAKE_FILE} TOPDIR=${TOPDIR} LIBDIR=${LIBDIR} \ HELPDIR=${HELPDIR} clobber ${V} echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' + ${V} echo '=-=-=-=-= Invoking $@ rule for custom =-=-=-=-=' + cd custom; ${MAKE} -f Makefile ${CUSTOM_PASSDOWN} clobber + ${V} echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' + ${V} echo '=-=-=-=-= Invoking $@ rule for sample =-=-=-=-=' + cd sample; ${MAKE} -f Makefile ${SAMPLE_PASSDOWN} clobber + ${V} echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' ${V} echo remove files that are obsolete -rm -f endian.h stdarg.h libcalcerr.a lib/obj help/obj -rm -f have_vs.c std_arg.h try_stdarg.c fnvhash.c @@ -2092,6 +2559,12 @@ install: calc libcalc.a ${LIB_H_SRC} ${BUILD_H_SRC} calc.1 MAKE_FILE=${MAKE_FILE} TOPDIR=${TOPDIR} LIBDIR=${LIBDIR} \ HELPDIR=${HELPDIR} install ${V} echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' + ${V} echo '=-=-=-=-= Invoking $@ rule for custom =-=-=-=-=' + cd custom; ${MAKE} -f Makefile ${CUSTOM_PASSDOWN} install + ${V} echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' + ${V} echo '=-=-=-=-= Invoking $@ rule for sample =-=-=-=-=' + cd sample; ${MAKE} -f Makefile ${SAMPLE_PASSDOWN} install + ${V} echo '=-=-=-=-= Back to the main Makefile for $@ rule =-=-=-=-=' -rm -f ${LIBDIR}/libcalc.a cp libcalc.a ${LIBDIR}/libcalc.a -chmod 0644 ${LIBDIR}/libcalc.a @@ -2157,6 +2630,7 @@ install: calc libcalc.a ${LIB_H_SRC} ${BUILD_H_SRC} calc.1 addop.o: addop.c addop.o: alloc.h +addop.o: block.h addop.o: byteswap.h addop.o: calc.h addop.o: calcerr.h @@ -2166,14 +2640,18 @@ addop.o: endian_calc.h addop.o: func.h addop.o: hash.h addop.o: have_malloc.h +addop.o: have_memmv.h addop.o: have_newstr.h addop.o: have_stdlib.h addop.o: have_string.h addop.o: label.h addop.o: longbits.h +addop.o: md5.h +addop.o: nametype.h addop.o: opcodes.h addop.o: qmath.h addop.o: shs.h +addop.o: shs1.h addop.o: string.h addop.o: symbol.h addop.o: token.h @@ -2184,6 +2662,7 @@ align32.o: have_unistd.h align32.o: longbits.h assocfunc.o: alloc.h assocfunc.o: assocfunc.c +assocfunc.o: block.h assocfunc.o: byteswap.h assocfunc.o: calcerr.h assocfunc.o: cmath.h @@ -2191,20 +2670,76 @@ assocfunc.o: config.h assocfunc.o: endian_calc.h assocfunc.o: hash.h assocfunc.o: have_malloc.h +assocfunc.o: have_memmv.h assocfunc.o: have_newstr.h assocfunc.o: have_stdlib.h assocfunc.o: have_string.h assocfunc.o: longbits.h +assocfunc.o: md5.h +assocfunc.o: nametype.h assocfunc.o: qmath.h assocfunc.o: shs.h +assocfunc.o: shs1.h +assocfunc.o: string.h assocfunc.o: value.h assocfunc.o: zmath.h +blkcpy.o: alloc.h +blkcpy.o: blkcpy.c +blkcpy.o: blkcpy.h +blkcpy.o: block.h +blkcpy.o: byteswap.h +blkcpy.o: calc.h +blkcpy.o: calcerr.h +blkcpy.o: cmath.h +blkcpy.o: config.h +blkcpy.o: endian_calc.h +blkcpy.o: file.h +blkcpy.o: hash.h +blkcpy.o: have_fpos.h +blkcpy.o: have_malloc.h +blkcpy.o: have_memmv.h +blkcpy.o: have_newstr.h +blkcpy.o: have_stdlib.h +blkcpy.o: have_string.h +blkcpy.o: longbits.h +blkcpy.o: md5.h +blkcpy.o: nametype.h +blkcpy.o: qmath.h +blkcpy.o: shs.h +blkcpy.o: shs1.h +blkcpy.o: string.h +blkcpy.o: value.h +blkcpy.o: zmath.h +block.o: alloc.h +block.o: block.c +block.o: block.h +block.o: byteswap.h +block.o: calcerr.h +block.o: cmath.h +block.o: config.h +block.o: endian_calc.h +block.o: hash.h +block.o: have_malloc.h +block.o: have_memmv.h +block.o: have_newstr.h +block.o: have_stdlib.h +block.o: have_string.h +block.o: longbits.h +block.o: md5.h +block.o: nametype.h +block.o: qmath.h +block.o: shs.h +block.o: shs1.h +block.o: string.h +block.o: value.h +block.o: zmath.h byteswap.o: alloc.h byteswap.o: byteswap.c byteswap.o: byteswap.h byteswap.o: cmath.h byteswap.o: endian_calc.h byteswap.o: have_malloc.h +byteswap.o: have_memmv.h byteswap.o: have_newstr.h byteswap.o: have_stdlib.h byteswap.o: have_string.h @@ -2212,6 +2747,7 @@ byteswap.o: longbits.h byteswap.o: qmath.h byteswap.o: zmath.h calc.o: alloc.h +calc.o: block.h calc.o: byteswap.h calc.o: calc.c calc.o: calc.h @@ -2219,10 +2755,13 @@ calc.o: calcerr.h calc.o: cmath.h calc.o: conf.h calc.o: config.h +calc.o: custom.h calc.o: endian_calc.h calc.o: func.h calc.o: hash.h +calc.o: have_const.h calc.o: have_malloc.h +calc.o: have_memmv.h calc.o: have_newstr.h calc.o: have_stdlib.h calc.o: have_string.h @@ -2231,9 +2770,14 @@ calc.o: have_unistd.h calc.o: hist.h calc.o: label.h calc.o: longbits.h +calc.o: math_error.h +calc.o: md5.h +calc.o: nametype.h calc.o: opcodes.h calc.o: qmath.h calc.o: shs.h +calc.o: shs1.h +calc.o: string.h calc.o: symbol.h calc.o: token.h calc.o: value.h @@ -2242,6 +2786,7 @@ calcerr.o: calcerr.c calcerr.o: calcerr.h calcerr.o: have_const.h codegen.o: alloc.h +codegen.o: block.h codegen.o: byteswap.h codegen.o: calc.h codegen.o: calcerr.h @@ -2253,15 +2798,19 @@ codegen.o: endian_calc.h codegen.o: func.h codegen.o: hash.h codegen.o: have_malloc.h +codegen.o: have_memmv.h codegen.o: have_newstr.h codegen.o: have_stdlib.h codegen.o: have_string.h codegen.o: have_unistd.h codegen.o: label.h codegen.o: longbits.h +codegen.o: md5.h +codegen.o: nametype.h codegen.o: opcodes.h codegen.o: qmath.h codegen.o: shs.h +codegen.o: shs1.h codegen.o: string.h codegen.o: symbol.h codegen.o: token.h @@ -2274,10 +2823,12 @@ comfunc.o: comfunc.c comfunc.o: config.h comfunc.o: endian_calc.h comfunc.o: have_malloc.h +comfunc.o: have_memmv.h comfunc.o: have_newstr.h comfunc.o: have_stdlib.h comfunc.o: have_string.h comfunc.o: longbits.h +comfunc.o: nametype.h comfunc.o: qmath.h comfunc.o: zmath.h commath.o: alloc.h @@ -2286,6 +2837,7 @@ commath.o: cmath.h commath.o: commath.c commath.o: endian_calc.h commath.o: have_malloc.h +commath.o: have_memmv.h commath.o: have_newstr.h commath.o: have_stdlib.h commath.o: have_string.h @@ -2293,6 +2845,7 @@ commath.o: longbits.h commath.o: qmath.h commath.o: zmath.h config.o: alloc.h +config.o: block.h config.o: byteswap.h config.o: calc.h config.o: calcerr.h @@ -2303,17 +2856,23 @@ config.o: endian_calc.h config.o: hash.h config.o: have_const.h config.o: have_malloc.h +config.o: have_memmv.h config.o: have_newstr.h config.o: have_stdlib.h config.o: have_string.h config.o: longbits.h +config.o: md5.h +config.o: nametype.h config.o: qmath.h config.o: shs.h +config.o: shs1.h +config.o: string.h config.o: token.h config.o: value.h config.o: zmath.h config.o: zrand.h const.o: alloc.h +const.o: block.h const.o: byteswap.h const.o: calc.h const.o: calcerr.h @@ -2323,17 +2882,49 @@ const.o: const.c const.o: endian_calc.h const.o: hash.h const.o: have_malloc.h +const.o: have_memmv.h const.o: have_newstr.h const.o: have_stdlib.h const.o: have_string.h const.o: longbits.h +const.o: md5.h +const.o: nametype.h const.o: qmath.h const.o: shs.h +const.o: shs1.h +const.o: string.h const.o: value.h const.o: zmath.h +custom.o: alloc.h +custom.o: block.h +custom.o: byteswap.h +custom.o: calc.h +custom.o: calcerr.h +custom.o: cmath.h +custom.o: config.h +custom.o: custom.c +custom.o: custom.h +custom.o: endian_calc.h +custom.o: hash.h +custom.o: have_const.h +custom.o: have_malloc.h +custom.o: have_memmv.h +custom.o: have_newstr.h +custom.o: have_stdlib.h +custom.o: have_string.h +custom.o: longbits.h +custom.o: md5.h +custom.o: nametype.h +custom.o: qmath.h +custom.o: shs.h +custom.o: shs1.h +custom.o: string.h +custom.o: value.h +custom.o: zmath.h endian.o: endian.c endian.o: have_unistd.h file.o: alloc.h +file.o: block.h file.o: byteswap.h file.o: calc.h file.o: calcerr.h @@ -2346,23 +2937,32 @@ file.o: fposval.h file.o: hash.h file.o: have_fpos.h file.o: have_malloc.h +file.o: have_memmv.h file.o: have_newstr.h file.o: have_stdlib.h file.o: have_string.h file.o: longbits.h +file.o: md5.h +file.o: nametype.h file.o: qmath.h file.o: shs.h +file.o: shs1.h +file.o: string.h file.o: value.h file.o: zmath.h fposval.o: endian_calc.h fposval.o: fposval.c fposval.o: have_fpos.h +fposval.o: have_offscl.h +fposval.o: have_posscl.h func.o: alloc.h +func.o: block.h func.o: byteswap.h func.o: calc.h func.o: calcerr.h func.o: cmath.h func.o: config.h +func.o: custom.h func.o: endian_calc.h func.o: file.h func.o: func.c @@ -2371,6 +2971,7 @@ func.o: hash.h func.o: have_const.h func.o: have_fpos.h func.o: have_malloc.h +func.o: have_memmv.h func.o: have_newstr.h func.o: have_stdlib.h func.o: have_string.h @@ -2378,36 +2979,54 @@ func.o: have_times.h func.o: have_unistd.h func.o: label.h func.o: longbits.h +func.o: md5.h +func.o: nametype.h func.o: opcodes.h func.o: prime.h func.o: qmath.h func.o: shs.h +func.o: shs1.h func.o: string.h func.o: symbol.h func.o: token.h func.o: value.h func.o: zmath.h func.o: zrand.h +func.o: zrandom.h hash.o: alloc.h +hash.o: block.h hash.o: byteswap.h +hash.o: calc.h hash.o: calcerr.h hash.o: cmath.h hash.o: config.h hash.o: endian_calc.h hash.o: hash.c hash.o: hash.h +hash.o: have_const.h hash.o: have_malloc.h +hash.o: have_memmv.h hash.o: have_newstr.h hash.o: have_stdlib.h hash.o: have_string.h hash.o: longbits.h +hash.o: md5.h +hash.o: nametype.h hash.o: qmath.h hash.o: shs.h +hash.o: shs1.h +hash.o: string.h hash.o: value.h hash.o: zmath.h +hash.o: zrand.h +hash.o: zrandom.h have_const.o: have_const.c have_fpos.o: have_fpos.c +have_memmv.o: have_memmv.c have_newstr.o: have_newstr.c +have_offscl.o: have_offscl.c +have_posscl.o: have_fpos.h +have_posscl.o: have_posscl.c have_stdvs.o: have_stdvs.c have_stdvs.o: have_string.h have_stdvs.o: have_unistd.h @@ -2416,7 +3035,34 @@ have_uid_t.o: have_unistd.h have_varvs.o: have_string.h have_varvs.o: have_unistd.h have_varvs.o: have_varvs.c +help.o: alloc.h +help.o: block.h +help.o: byteswap.h +help.o: calc.h +help.o: calcerr.h +help.o: cmath.h +help.o: conf.h +help.o: config.h +help.o: endian_calc.h +help.o: hash.h +help.o: have_malloc.h +help.o: have_memmv.h +help.o: have_newstr.h +help.o: have_stdlib.h +help.o: have_string.h +help.o: have_unistd.h +help.o: help.c +help.o: longbits.h +help.o: md5.h +help.o: nametype.h +help.o: qmath.h +help.o: shs.h +help.o: shs1.h +help.o: string.h +help.o: value.h +help.o: zmath.h hist.o: alloc.h +hist.o: block.h hist.o: byteswap.h hist.o: calc.h hist.o: calcerr.h @@ -2425,6 +3071,7 @@ hist.o: config.h hist.o: endian_calc.h hist.o: hash.h hist.o: have_malloc.h +hist.o: have_memmv.h hist.o: have_newstr.h hist.o: have_stdlib.h hist.o: have_string.h @@ -2432,12 +3079,17 @@ hist.o: have_unistd.h hist.o: hist.c hist.o: hist.h hist.o: longbits.h +hist.o: md5.h +hist.o: nametype.h hist.o: qmath.h hist.o: shs.h +hist.o: shs1.h +hist.o: string.h hist.o: terminal.h hist.o: value.h hist.o: zmath.h input.o: alloc.h +input.o: block.h input.o: byteswap.h input.o: calc.h input.o: calcerr.h @@ -2447,20 +3099,26 @@ input.o: config.h input.o: endian_calc.h input.o: hash.h input.o: have_malloc.h +input.o: have_memmv.h input.o: have_newstr.h input.o: have_stdlib.h input.o: have_string.h input.o: hist.h input.o: input.c input.o: longbits.h +input.o: md5.h +input.o: nametype.h input.o: qmath.h input.o: shs.h +input.o: shs1.h +input.o: string.h input.o: value.h input.o: zmath.h jump.o: have_const.h jump.o: jump.c jump.o: jump.h label.o: alloc.h +label.o: block.h label.o: byteswap.h label.o: calc.h label.o: calcerr.h @@ -2470,38 +3128,69 @@ label.o: endian_calc.h label.o: func.h label.o: hash.h label.o: have_malloc.h +label.o: have_memmv.h label.o: have_newstr.h label.o: have_stdlib.h label.o: have_string.h label.o: label.c label.o: label.h label.o: longbits.h +label.o: md5.h +label.o: nametype.h label.o: opcodes.h label.o: qmath.h label.o: shs.h +label.o: shs1.h label.o: string.h label.o: token.h label.o: value.h label.o: zmath.h lib_calc.o: alloc.h +lib_calc.o: block.h lib_calc.o: byteswap.h lib_calc.o: calc.h lib_calc.o: calcerr.h lib_calc.o: cmath.h +lib_calc.o: conf.h lib_calc.o: config.h lib_calc.o: endian_calc.h +lib_calc.o: func.h lib_calc.o: hash.h +lib_calc.o: have_const.h lib_calc.o: have_malloc.h +lib_calc.o: have_memmv.h lib_calc.o: have_newstr.h lib_calc.o: have_stdlib.h lib_calc.o: have_string.h +lib_calc.o: have_unistd.h +lib_calc.o: label.h lib_calc.o: lib_calc.c lib_calc.o: longbits.h +lib_calc.o: md5.h +lib_calc.o: nametype.h lib_calc.o: qmath.h lib_calc.o: shs.h +lib_calc.o: shs1.h +lib_calc.o: string.h +lib_calc.o: symbol.h +lib_calc.o: token.h lib_calc.o: value.h lib_calc.o: zmath.h +lib_calc.o: zrandom.h +lib_util.o: alloc.h +lib_util.o: byteswap.h +lib_util.o: endian_calc.h +lib_util.o: have_malloc.h +lib_util.o: have_memmv.h +lib_util.o: have_newstr.h +lib_util.o: have_stdlib.h +lib_util.o: have_string.h +lib_util.o: lib_util.c +lib_util.o: lib_util.h +lib_util.o: longbits.h +lib_util.o: zmath.h listfunc.o: alloc.h +listfunc.o: block.h listfunc.o: byteswap.h listfunc.o: calcerr.h listfunc.o: cmath.h @@ -2510,16 +3199,22 @@ listfunc.o: endian_calc.h listfunc.o: hash.h listfunc.o: have_const.h listfunc.o: have_malloc.h +listfunc.o: have_memmv.h listfunc.o: have_newstr.h listfunc.o: have_stdlib.h listfunc.o: have_string.h listfunc.o: listfunc.c listfunc.o: longbits.h +listfunc.o: md5.h +listfunc.o: nametype.h listfunc.o: qmath.h listfunc.o: shs.h +listfunc.o: shs1.h +listfunc.o: string.h listfunc.o: value.h listfunc.o: zmath.h listfunc.o: zrand.h +longbits.o: have_stdlib.h longbits.o: have_unistd.h longbits.o: longbits.c longbits.o: longlong.h @@ -2527,6 +3222,7 @@ longlong.o: have_stdlib.h longlong.o: have_string.h longlong.o: longlong.c matfunc.o: alloc.h +matfunc.o: block.h matfunc.o: byteswap.h matfunc.o: calcerr.h matfunc.o: cmath.h @@ -2535,18 +3231,24 @@ matfunc.o: endian_calc.h matfunc.o: hash.h matfunc.o: have_const.h matfunc.o: have_malloc.h +matfunc.o: have_memmv.h matfunc.o: have_newstr.h matfunc.o: have_stdlib.h matfunc.o: have_string.h matfunc.o: longbits.h matfunc.o: matfunc.c +matfunc.o: md5.h +matfunc.o: nametype.h matfunc.o: qmath.h matfunc.o: shs.h +matfunc.o: shs1.h +matfunc.o: string.h matfunc.o: value.h matfunc.o: zmath.h matfunc.o: zrand.h math_error.o: alloc.h math_error.o: args.h +math_error.o: block.h math_error.o: byteswap.h math_error.o: calc.h math_error.o: calcerr.h @@ -2555,16 +3257,47 @@ math_error.o: config.h math_error.o: endian_calc.h math_error.o: hash.h math_error.o: have_malloc.h +math_error.o: have_memmv.h math_error.o: have_newstr.h math_error.o: have_stdlib.h math_error.o: have_string.h math_error.o: longbits.h math_error.o: math_error.c +math_error.o: math_error.h +math_error.o: md5.h +math_error.o: nametype.h math_error.o: qmath.h math_error.o: shs.h +math_error.o: shs1.h +math_error.o: string.h math_error.o: value.h math_error.o: zmath.h +md5.o: align32.h +md5.o: alloc.h +md5.o: block.h +md5.o: byteswap.h +md5.o: calcerr.h +md5.o: cmath.h +md5.o: config.h +md5.o: endian_calc.h +md5.o: hash.h +md5.o: have_malloc.h +md5.o: have_memmv.h +md5.o: have_newstr.h +md5.o: have_stdlib.h +md5.o: have_string.h +md5.o: longbits.h +md5.o: md5.c +md5.o: md5.h +md5.o: nametype.h +md5.o: qmath.h +md5.o: shs.h +md5.o: shs1.h +md5.o: string.h +md5.o: value.h +md5.o: zmath.h obj.o: alloc.h +obj.o: block.h obj.o: byteswap.h obj.o: calc.h obj.o: calcerr.h @@ -2574,26 +3307,32 @@ obj.o: endian_calc.h obj.o: func.h obj.o: hash.h obj.o: have_malloc.h +obj.o: have_memmv.h obj.o: have_newstr.h obj.o: have_stdlib.h obj.o: have_string.h obj.o: label.h obj.o: longbits.h +obj.o: md5.h +obj.o: nametype.h obj.o: obj.c obj.o: opcodes.h obj.o: qmath.h obj.o: shs.h +obj.o: shs1.h obj.o: string.h obj.o: symbol.h obj.o: value.h obj.o: zmath.h opcodes.o: alloc.h opcodes.o: args.h +opcodes.o: block.h opcodes.o: byteswap.h opcodes.o: calc.h opcodes.o: calcerr.h opcodes.o: cmath.h opcodes.o: config.h +opcodes.o: custom.h opcodes.o: endian_calc.h opcodes.o: file.h opcodes.o: func.h @@ -2601,25 +3340,33 @@ opcodes.o: hash.h opcodes.o: have_const.h opcodes.o: have_fpos.h opcodes.o: have_malloc.h +opcodes.o: have_memmv.h opcodes.o: have_newstr.h opcodes.o: have_stdlib.h opcodes.o: have_string.h opcodes.o: hist.h opcodes.o: label.h opcodes.o: longbits.h +opcodes.o: math_error.h +opcodes.o: md5.h +opcodes.o: nametype.h opcodes.o: opcodes.c opcodes.o: opcodes.h opcodes.o: qmath.h opcodes.o: shs.h +opcodes.o: shs1.h +opcodes.o: string.h opcodes.o: symbol.h opcodes.o: value.h opcodes.o: zmath.h opcodes.o: zrand.h +opcodes.o: zrandom.h pix.o: alloc.h pix.o: byteswap.h pix.o: endian_calc.h pix.o: have_const.h pix.o: have_malloc.h +pix.o: have_memmv.h pix.o: have_newstr.h pix.o: have_stdlib.h pix.o: have_string.h @@ -2629,6 +3376,7 @@ pix.o: prime.h pix.o: qmath.h pix.o: zmath.h poly.o: alloc.h +poly.o: block.h poly.o: byteswap.h poly.o: calcerr.h poly.o: cmath.h @@ -2636,13 +3384,18 @@ poly.o: config.h poly.o: endian_calc.h poly.o: hash.h poly.o: have_malloc.h +poly.o: have_memmv.h poly.o: have_newstr.h poly.o: have_stdlib.h poly.o: have_string.h poly.o: longbits.h +poly.o: md5.h +poly.o: nametype.h poly.o: poly.c poly.o: qmath.h poly.o: shs.h +poly.o: shs1.h +poly.o: string.h poly.o: value.h poly.o: zmath.h prime.o: alloc.h @@ -2650,6 +3403,7 @@ prime.o: byteswap.h prime.o: endian_calc.h prime.o: have_const.h prime.o: have_malloc.h +prime.o: have_memmv.h prime.o: have_newstr.h prime.o: have_stdlib.h prime.o: have_string.h @@ -2665,10 +3419,12 @@ qfunc.o: config.h qfunc.o: endian_calc.h qfunc.o: have_const.h qfunc.o: have_malloc.h +qfunc.o: have_memmv.h qfunc.o: have_newstr.h qfunc.o: have_stdlib.h qfunc.o: have_string.h qfunc.o: longbits.h +qfunc.o: nametype.h qfunc.o: prime.h qfunc.o: qfunc.c qfunc.o: qmath.h @@ -2679,10 +3435,12 @@ qio.o: byteswap.h qio.o: config.h qio.o: endian_calc.h qio.o: have_malloc.h +qio.o: have_memmv.h qio.o: have_newstr.h qio.o: have_stdlib.h qio.o: have_string.h qio.o: longbits.h +qio.o: nametype.h qio.o: qio.c qio.o: qmath.h qio.o: zmath.h @@ -2691,10 +3449,12 @@ qmath.o: byteswap.h qmath.o: config.h qmath.o: endian_calc.h qmath.o: have_malloc.h +qmath.o: have_memmv.h qmath.o: have_newstr.h qmath.o: have_stdlib.h qmath.o: have_string.h qmath.o: longbits.h +qmath.o: nametype.h qmath.o: qmath.c qmath.o: qmath.h qmath.o: zmath.h @@ -2703,10 +3463,12 @@ qmod.o: byteswap.h qmod.o: config.h qmod.o: endian_calc.h qmod.o: have_malloc.h +qmod.o: have_memmv.h qmod.o: have_newstr.h qmod.o: have_stdlib.h qmod.o: have_string.h qmod.o: longbits.h +qmod.o: nametype.h qmod.o: qmath.h qmod.o: qmod.c qmod.o: zmath.h @@ -2714,6 +3476,7 @@ qtrans.o: alloc.h qtrans.o: byteswap.h qtrans.o: endian_calc.h qtrans.o: have_malloc.h +qtrans.o: have_memmv.h qtrans.o: have_newstr.h qtrans.o: have_stdlib.h qtrans.o: have_string.h @@ -2722,6 +3485,7 @@ qtrans.o: qmath.h qtrans.o: qtrans.c qtrans.o: zmath.h quickhash.o: alloc.h +quickhash.o: block.h quickhash.o: byteswap.h quickhash.o: calcerr.h quickhash.o: cmath.h @@ -2730,38 +3494,98 @@ quickhash.o: endian_calc.h quickhash.o: hash.h quickhash.o: have_const.h quickhash.o: have_malloc.h +quickhash.o: have_memmv.h quickhash.o: have_newstr.h quickhash.o: have_stdlib.h quickhash.o: have_string.h quickhash.o: longbits.h +quickhash.o: md5.h +quickhash.o: nametype.h quickhash.o: qmath.h quickhash.o: quickhash.c quickhash.o: shs.h +quickhash.o: shs1.h +quickhash.o: string.h quickhash.o: value.h quickhash.o: zmath.h quickhash.o: zrand.h +quickhash.o: zrandom.h shs.o: align32.h shs.o: alloc.h +shs.o: block.h shs.o: byteswap.h -shs.o: calc.h shs.o: calcerr.h shs.o: cmath.h shs.o: config.h shs.o: endian_calc.h shs.o: hash.h -shs.o: have_const.h shs.o: have_malloc.h +shs.o: have_memmv.h shs.o: have_newstr.h shs.o: have_stdlib.h shs.o: have_string.h shs.o: longbits.h +shs.o: md5.h +shs.o: nametype.h shs.o: qmath.h shs.o: shs.c shs.o: shs.h +shs.o: shs1.h +shs.o: string.h shs.o: value.h shs.o: zmath.h -shs.o: zrand.h +shs1.o: align32.h +shs1.o: alloc.h +shs1.o: block.h +shs1.o: byteswap.h +shs1.o: calcerr.h +shs1.o: cmath.h +shs1.o: config.h +shs1.o: endian_calc.h +shs1.o: hash.h +shs1.o: have_malloc.h +shs1.o: have_memmv.h +shs1.o: have_newstr.h +shs1.o: have_stdlib.h +shs1.o: have_string.h +shs1.o: longbits.h +shs1.o: md5.h +shs1.o: nametype.h +shs1.o: qmath.h +shs1.o: shs.h +shs1.o: shs1.c +shs1.o: shs1.h +shs1.o: string.h +shs1.o: value.h +shs1.o: zmath.h +size.o: alloc.h +size.o: block.h +size.o: byteswap.h +size.o: calcerr.h +size.o: cmath.h +size.o: config.h +size.o: endian_calc.h +size.o: hash.h +size.o: have_const.h +size.o: have_malloc.h +size.o: have_memmv.h +size.o: have_newstr.h +size.o: have_stdlib.h +size.o: have_string.h +size.o: longbits.h +size.o: md5.h +size.o: nametype.h +size.o: qmath.h +size.o: shs.h +size.o: shs1.h +size.o: size.c +size.o: string.h +size.o: value.h +size.o: zmath.h +size.o: zrand.h +size.o: zrandom.h string.o: alloc.h +string.o: block.h string.o: byteswap.h string.o: calc.h string.o: calcerr.h @@ -2770,17 +3594,22 @@ string.o: config.h string.o: endian_calc.h string.o: hash.h string.o: have_malloc.h +string.o: have_memmv.h string.o: have_newstr.h string.o: have_stdlib.h string.o: have_string.h string.o: longbits.h +string.o: md5.h +string.o: nametype.h string.o: qmath.h string.o: shs.h +string.o: shs1.h string.o: string.c string.o: string.h string.o: value.h string.o: zmath.h symbol.o: alloc.h +symbol.o: block.h symbol.o: byteswap.h symbol.o: calc.h symbol.o: calcerr.h @@ -2790,14 +3619,18 @@ symbol.o: endian_calc.h symbol.o: func.h symbol.o: hash.h symbol.o: have_malloc.h +symbol.o: have_memmv.h symbol.o: have_newstr.h symbol.o: have_stdlib.h symbol.o: have_string.h symbol.o: label.h symbol.o: longbits.h +symbol.o: md5.h +symbol.o: nametype.h symbol.o: opcodes.h symbol.o: qmath.h symbol.o: shs.h +symbol.o: shs1.h symbol.o: string.h symbol.o: symbol.c symbol.o: symbol.h @@ -2806,6 +3639,7 @@ symbol.o: value.h symbol.o: zmath.h token.o: alloc.h token.o: args.h +token.o: block.h token.o: byteswap.h token.o: calc.h token.o: calcerr.h @@ -2814,43 +3648,57 @@ token.o: config.h token.o: endian_calc.h token.o: hash.h token.o: have_malloc.h +token.o: have_memmv.h token.o: have_newstr.h token.o: have_stdlib.h token.o: have_string.h token.o: longbits.h +token.o: math_error.h +token.o: md5.h +token.o: nametype.h token.o: qmath.h token.o: shs.h +token.o: shs1.h token.o: string.h token.o: token.c token.o: token.h token.o: value.h token.o: zmath.h value.o: alloc.h +value.o: block.h value.o: byteswap.h value.o: calc.h value.o: calcerr.h value.o: cmath.h value.o: config.h value.o: endian_calc.h +value.o: file.h value.o: func.h value.o: hash.h value.o: have_const.h +value.o: have_fpos.h value.o: have_malloc.h +value.o: have_memmv.h value.o: have_newstr.h value.o: have_stdlib.h value.o: have_string.h value.o: label.h value.o: longbits.h +value.o: md5.h +value.o: nametype.h value.o: opcodes.h value.o: qmath.h value.o: shs.h +value.o: shs1.h value.o: string.h value.o: symbol.h value.o: value.c value.o: value.h value.o: zmath.h value.o: zrand.h +value.o: zrandom.h version.o: alloc.h +version.o: block.h version.o: byteswap.h version.o: calc.h version.o: calcerr.h @@ -2859,12 +3707,17 @@ version.o: config.h version.o: endian_calc.h version.o: hash.h version.o: have_malloc.h +version.o: have_memmv.h version.o: have_newstr.h version.o: have_stdlib.h version.o: have_string.h version.o: longbits.h +version.o: md5.h +version.o: nametype.h version.o: qmath.h version.o: shs.h +version.o: shs1.h +version.o: string.h version.o: value.h version.o: version.c version.o: zmath.h @@ -2872,6 +3725,7 @@ zfunc.o: alloc.h zfunc.o: byteswap.h zfunc.o: endian_calc.h zfunc.o: have_malloc.h +zfunc.o: have_memmv.h zfunc.o: have_newstr.h zfunc.o: have_stdlib.h zfunc.o: have_string.h @@ -2884,10 +3738,12 @@ zio.o: byteswap.h zio.o: config.h zio.o: endian_calc.h zio.o: have_malloc.h +zio.o: have_memmv.h zio.o: have_newstr.h zio.o: have_stdlib.h zio.o: have_string.h zio.o: longbits.h +zio.o: nametype.h zio.o: qmath.h zio.o: zio.c zio.o: zmath.h @@ -2895,6 +3751,7 @@ zmath.o: alloc.h zmath.o: byteswap.h zmath.o: endian_calc.h zmath.o: have_malloc.h +zmath.o: have_memmv.h zmath.o: have_newstr.h zmath.o: have_stdlib.h zmath.o: have_string.h @@ -2906,10 +3763,12 @@ zmod.o: byteswap.h zmod.o: config.h zmod.o: endian_calc.h zmod.o: have_malloc.h +zmod.o: have_memmv.h zmod.o: have_newstr.h zmod.o: have_stdlib.h zmod.o: have_string.h zmod.o: longbits.h +zmod.o: nametype.h zmod.o: qmath.h zmod.o: zmath.h zmod.o: zmod.c @@ -2918,14 +3777,17 @@ zmul.o: byteswap.h zmul.o: config.h zmul.o: endian_calc.h zmul.o: have_malloc.h +zmul.o: have_memmv.h zmul.o: have_newstr.h zmul.o: have_stdlib.h zmul.o: have_string.h zmul.o: longbits.h +zmul.o: nametype.h zmul.o: qmath.h zmul.o: zmath.h zmul.o: zmul.c zprime.o: alloc.h +zprime.o: block.h zprime.o: byteswap.h zprime.o: calcerr.h zprime.o: cmath.h @@ -2934,19 +3796,25 @@ zprime.o: endian_calc.h zprime.o: hash.h zprime.o: have_const.h zprime.o: have_malloc.h +zprime.o: have_memmv.h zprime.o: have_newstr.h zprime.o: have_stdlib.h zprime.o: have_string.h zprime.o: jump.h zprime.o: longbits.h +zprime.o: md5.h +zprime.o: nametype.h zprime.o: prime.h zprime.o: qmath.h zprime.o: shs.h +zprime.o: shs1.h +zprime.o: string.h zprime.o: value.h zprime.o: zmath.h zprime.o: zprime.c zprime.o: zrand.h zrand.o: alloc.h +zrand.o: block.h zrand.o: byteswap.h zrand.o: calcerr.h zrand.o: cmath.h @@ -2955,13 +3823,43 @@ zrand.o: endian_calc.h zrand.o: hash.h zrand.o: have_const.h zrand.o: have_malloc.h +zrand.o: have_memmv.h zrand.o: have_newstr.h zrand.o: have_stdlib.h zrand.o: have_string.h zrand.o: longbits.h +zrand.o: md5.h +zrand.o: nametype.h zrand.o: qmath.h zrand.o: shs.h +zrand.o: shs1.h +zrand.o: string.h zrand.o: value.h zrand.o: zmath.h zrand.o: zrand.c zrand.o: zrand.h +zrandom.o: alloc.h +zrandom.o: block.h +zrandom.o: byteswap.h +zrandom.o: calcerr.h +zrandom.o: cmath.h +zrandom.o: config.h +zrandom.o: endian_calc.h +zrandom.o: hash.h +zrandom.o: have_const.h +zrandom.o: have_malloc.h +zrandom.o: have_memmv.h +zrandom.o: have_newstr.h +zrandom.o: have_stdlib.h +zrandom.o: have_string.h +zrandom.o: longbits.h +zrandom.o: md5.h +zrandom.o: nametype.h +zrandom.o: qmath.h +zrandom.o: shs.h +zrandom.o: shs1.h +zrandom.o: string.h +zrandom.o: value.h +zrandom.o: zmath.h +zrandom.o: zrandom.c +zrandom.o: zrandom.h diff --git a/README b/README index 91fc26d..35e7b23 100644 --- a/README +++ b/README @@ -1,10 +1,10 @@ -# Copyright (c) 1994 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. # # Arbitrary precision calculator. -I am allowing this calculator to be freely distributed for personal uses. +I am allowing this calculator to be freely distributed for your enjoyment. Like all multi-precision programs, you should not depend absolutely on its results, since bugs in such programs can be insidious and only rarely show up. diff --git a/addop.c b/addop.c index 6ea7a49..b82287f 100644 --- a/addop.c +++ b/addop.c @@ -1,11 +1,12 @@ /* - * 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. * * Add opcodes to a function being compiled. */ +#include #include "calc.h" #include "opcodes.h" #include "string.h" @@ -22,6 +23,7 @@ static long maxopcodes; /* number of opcodes available */ static long newindex; /* index of new function */ static long oldop; /* previous opcode */ +static long oldoldop; /* opcode before previous opcode */ static long debugline; /* line number of latest debug opcode */ static long funccount; /* number of functions */ static long funcavail; /* available number of functions */ @@ -61,20 +63,25 @@ showfunctions(void) { FUNC **fpp; /* pointer into function table */ FUNC *fp; /* current function */ + long count; - if (funccount == 0) { - printf("No user functions defined.\n"); - return; + count = 0; + if (funccount > 0) { + for (fpp = &functions[funccount - 1]; fpp >= functions; fpp--) { + fp = *fpp; + if (fp == NULL) + continue; + if (count++ == 0) { + printf("Name Arguments\n---- ---------\n"); + } + printf("%-12s %-2d\n", fp->f_name, fp->f_paramcount); + } } - printf("Name Arguments\n"); - printf("---- ---------\n"); - for (fpp = &functions[funccount - 1]; fpp >= functions; fpp--) { - fp = *fpp; - if (fp == NULL) - continue; - printf("%-12s %-2d\n", fp->f_name, fp->f_paramcount); + if (count > 0) { + printf("\nNumber: %ld\n", count); + } else { + printf("No user functions defined\n"); } - printf("\n"); } @@ -112,6 +119,7 @@ beginfunc(char *name, BOOL newflag) initlocals(); initlabels(); oldop = OP_NOP; + oldoldop = OP_NOP; debugline = 0; errorcount = 0; } @@ -128,8 +136,13 @@ endfunc(void) register FUNC *fp; /* function just finished */ unsigned long size; /* size of just created function */ + if (oldop != OP_RETURN) { + addop(OP_UNDEF); + addop(OP_RETURN); + } checklabels(); if (errorcount) { + freefunc(curfunc); printf("\"%s\": %ld error%s\n", curfunc->f_name, errorcount, ((errorcount == 1) ? "" : "s")); return; @@ -151,13 +164,15 @@ endfunc(void) } } if (functions[newindex]) { + freenumbers(functions[newindex]); free(functions[newindex]); - fprintf(stderr, "**** %s() has been redefined\n", fp->f_name); + if (inputisterminal() || conf->lib_debug >= 0) + printf("%s() redefined\n", fp->f_name); } + else if (inputisterminal() || conf->lib_debug >= 0) + printf("%s() defined\n", fp->f_name); functions[newindex] = fp; objuncache(); - if (inputisterminal()) - printf("\"%s\" defined\n", fp->f_name); } @@ -195,6 +210,83 @@ adduserfunc(char *name) return index; } +/* + * Remove user defined function + */ +void +rmuserfunc(char *name) +{ + long index; /* index of function */ + + index = findstr(&funcnames, name); + if (index < 0) { + printf("%s() has never been defined\n", + name); + return; + } + if (functions[index] == NULL) + return; + freenumbers(functions[index]); + free(functions[index]); + if (!inputisterminal() && conf->lib_debug >= 0) + printf("%s() undefined\n", name); + functions[index] = NULL; +} + + +/* + * Free memory used to store function and its constants + */ +void +freefunc(FUNC *fp) +{ + long i; + + if (fp == NULL) + return; + if (conf->traceflags & TRACE_FNCODES) { + printf("Freeing function \"%s\"\n", fp->f_name); + dumpnames = FALSE; + for (i = 0; i < fp->f_opcodecount; ) { + printf("%ld: ", i); + i += dumpop(&fp->f_opcodes[i]); + } + } + freenumbers(fp); + if (fp != functemplate) + free(fp); +} + + +void +rmalluserfunc(void) +{ + FUNC **fpp; + + for (fpp = functions; fpp < &functions[funccount]; fpp++) { + if (*fpp) { + freefunc(*fpp); + *fpp = NULL; + } + } +} + + +/* + * get index of defined user function with specified name, or -1 if there + * is none or if it has been undefined + */ +long +getuserfunc(char *name) +{ + long index; + + index = findstr(&funcnames, name); + if (index >= 0 && functions[index] != NULL) + return index; + return -1L; +} + /* * Clear any optimization that may be done for the next opcode. @@ -204,6 +296,7 @@ void clearopt(void) { oldop = OP_NOP; + oldoldop = OP_NOP; debugline = 0; } @@ -253,10 +346,17 @@ void addop(long op) { register FUNC *fp; /* current function */ - NUMBER *q; + NUMBER *q, *q1, *q2; + unsigned long count; + BOOL cut; + int diff; fp = curfunc; - if ((fp->f_opcodecount + 5) >= maxopcodes) { + count = fp->f_opcodecount; + cut = TRUE; + diff = 2; + q = NULL; + if ((count + 5) >= maxopcodes) { maxopcodes += OPCODEALLOCSIZE; fp = (FUNC *) malloc(funcsize(maxopcodes)); if (fp == NULL) { @@ -269,73 +369,169 @@ addop(long op) free(curfunc); curfunc = fp; } + /* * Check the current opcode against the previous opcode and try to * slightly optimize the code depending on the various combinations. */ - if (op == OP_GETVALUE) { - switch (oldop) { + switch (op) { + case OP_GETVALUE: + switch (oldop) { + case OP_NUMBER: + case OP_ZERO: + case OP_ONE: + case OP_IMAGINARY: + case OP_GETEPSILON: + case OP_SETEPSILON: + case OP_STRING: + case OP_UNDEF: + case OP_GETCONFIG: + case OP_SETCONFIG: + return; + case OP_DUPLICATE: + diff = 1; + oldop = OP_DUPVALUE; + break; + case OP_FIADDR: + diff = 1; + oldop = OP_FIVALUE; + break; + case OP_GLOBALADDR: + diff = 1 + PTR_SIZE; + oldop = OP_GLOBALVALUE; + break; + case OP_LOCALADDR: + oldop = OP_LOCALVALUE; + break; + case OP_PARAMADDR: + oldop = OP_PARAMVALUE; + break; + case OP_ELEMADDR: + oldop = OP_ELEMVALUE; + break; + default: + cut = FALSE; - case OP_NUMBER: case OP_ZERO: case OP_ONE: case OP_IMAGINARY: - case OP_GETEPSILON: case OP_SETEPSILON: case OP_STRING: - case OP_UNDEF: case OP_GETCONFIG: case OP_SETCONFIG: - return; - case OP_DUPLICATE: - fp->f_opcodes[fp->f_opcodecount - 1] = OP_DUPVALUE; - oldop = OP_DUPVALUE; - return; - case OP_FIADDR: - fp->f_opcodes[fp->f_opcodecount - 1] = OP_FIVALUE; - oldop = OP_FIVALUE; - return; - case OP_GLOBALADDR: - fp->f_opcodes[fp->f_opcodecount - 2] = OP_GLOBALVALUE; - oldop = OP_GLOBALVALUE; - return; - case OP_LOCALADDR: - fp->f_opcodes[fp->f_opcodecount - 2] = OP_LOCALVALUE; - oldop = OP_LOCALVALUE; - return; - case OP_PARAMADDR: - fp->f_opcodes[fp->f_opcodecount - 2] = OP_PARAMVALUE; - oldop = OP_PARAMVALUE; - return; - case OP_ELEMADDR: - fp->f_opcodes[fp->f_opcodecount - 2] = OP_ELEMVALUE; - oldop = OP_ELEMVALUE; - return; - } + } + if (cut) { + fp->f_opcodes[count - diff] = oldop; + return; + } + break; + case OP_POP: + switch (oldop) { + case OP_ASSIGN: + fp->f_opcodes[count-1] = OP_ASSIGNPOP; + oldop = OP_ASSIGNPOP; + return; + case OP_NUMBER: + case OP_IMAGINARY: + q = constvalue(fp->f_opcodes[count-1]); + qfree(q); + break; + case OP_STRING: + sfree(findstring((long)fp->f_opcodes[count-1])); + break; + case OP_LOCALADDR: + case OP_PARAMADDR: + break; + case OP_GLOBALADDR: + diff = 1 + PTR_SIZE; + break; + default: + cut = FALSE; + } + if (cut) { + fp->f_opcodecount -= diff; + oldop = OP_NOP; + oldoldop = OP_NOP; + fprintf(stderr, "%ld: unused value ignored\n", + linenumber()); + return; + } + break; + case OP_NEGATE: + if (oldop == OP_NUMBER) { + q = constvalue(fp->f_opcodes[count-1]); + fp->f_opcodes[count-1] = addqconstant(qneg(q)); + qfree(q); + return; + } } - if ((op == OP_NEGATE) && (oldop == OP_NUMBER)) { - q = constvalue(fp->f_opcodes[fp->f_opcodecount - 1]); - fp->f_opcodes[fp->f_opcodecount - 1] = addqconstant(qneg(q)); - oldop = OP_NUMBER; - return; - } - if ((op == OP_POWER) && (oldop == OP_NUMBER)) { - if (qcmpi(constvalue(fp->f_opcodes[fp->f_opcodecount - 1]), 2L) == 0) { - fp->f_opcodecount--; - fp->f_opcodes[fp->f_opcodecount - 1] = OP_SQUARE; - oldop = OP_SQUARE; - return; + if (oldop == OP_NUMBER) { + if (oldoldop == OP_NUMBER) { + q1 = constvalue(fp->f_opcodes[count - 3]); + q2 = constvalue(fp->f_opcodes[count - 1]); + switch (op) { + case OP_DIV: + if (qiszero(q2)) { + cut = FALSE; + break; + } + q = qqdiv(q1,q2); + break; + case OP_MUL: + q = qmul(q1,q2); + break; + case OP_ADD: + q = qqadd(q1,q2); + break; + case OP_SUB: + q = qsub(q1,q2); + break; + case OP_POWER: + if (qisfrac(q2) || qisneg(q2)) + cut = FALSE; + else + q = qpowi(q1,q2); + break; + default: + cut = FALSE; + } + if (cut) { + qfree(q1); + qfree(q2); + fp->f_opcodes[count - 3] = addqconstant(q); + fp->f_opcodecount -= 2; + oldoldop = OP_NOP; + return; + } + } else if (op != OP_NUMBER) { + q = constvalue(fp->f_opcodes[count - 1]); + if (op == OP_POWER) { + if (qcmpi(q, 2L) == 0) { + fp->f_opcodecount--; + fp->f_opcodes[count - 2] = OP_SQUARE; + qfree(q); + oldop = OP_SQUARE; + return; + } + if (qcmpi(q, 4L) == 0) { + fp->f_opcodes[count - 2] = OP_SQUARE; + fp->f_opcodes[count - 1] = OP_SQUARE; + qfree(q); + oldop = OP_SQUARE; + return; + } + } + if (qiszero(q)) { + qfree(q); + fp->f_opcodes[count - 2] = OP_ZERO; + fp->f_opcodecount--; + } + else if (qisone(q)) { + qfree(q); + fp->f_opcodes[count - 2] = OP_ONE; + fp->f_opcodecount--; + } } - if (qcmpi(constvalue(fp->f_opcodes[fp->f_opcodecount - 1]), 4L) == 0) { - fp->f_opcodes[fp->f_opcodecount - 2] = OP_SQUARE; - fp->f_opcodes[fp->f_opcodecount - 1] = OP_SQUARE; - oldop = OP_SQUARE; - return; - } - } - if ((op == OP_POP) && (oldop == OP_ASSIGN)) { /* optimize */ - fp->f_opcodes[fp->f_opcodecount - 1] = OP_ASSIGNPOP; - oldop = OP_ASSIGNPOP; - return; } /* * No optimization possible, so store the opcode. */ fp->f_opcodes[fp->f_opcodecount] = op; fp->f_opcodecount++; + oldoldop = oldop; oldop = op; } @@ -347,24 +543,7 @@ addop(long op) void addopone(long op, long arg) { - NUMBER *q; - - switch (op) { - case OP_NUMBER: - q = constvalue(arg); - if (q == NULL) - break; - if (qiszero(q)) { - addop(OP_ZERO); - return; - } - if (qisone(q)) { - addop(OP_ONE); - return; - } - break; - - case OP_DEBUG: + if (op == OP_DEBUG) { if ((conf->traceflags & TRACE_NODEBUG) || (arg == debugline)) return; debugline = arg; @@ -372,7 +551,6 @@ addopone(long op, long arg) curfunc->f_opcodes[curfunc->f_opcodecount - 1] = arg; return; } - break; } addop(op); curfunc->f_opcodes[curfunc->f_opcodecount] = arg; diff --git a/alloc.h b/alloc.h index a43e620..c2bbebc 100644 --- a/alloc.h +++ b/alloc.h @@ -1,16 +1,18 @@ /* - * 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. */ -#if !defined(ALLOC_H) -#define ALLOC_H +#if !defined(__ALLOC_H__) +#define __ALLOC_H__ + #include "have_malloc.h" #include "have_newstr.h" #include "have_string.h" +#include "have_memmv.h" #ifdef HAVE_MALLOC_H # include @@ -37,7 +39,7 @@ extern void *memset(); # if defined(__STDC__) && __STDC__ != 0 extern size_t strlen(); # else -extern long strlen(); /* should be size_t, but old systems don't have it */ +extern long strlen(); # endif # else /* HAVE_NEWSTR */ extern void bcopy(); @@ -61,4 +63,14 @@ extern int strcmp(); #define strchr(s, c) index(s, c) #endif /* HAVE_NEWSTR */ -#endif /* !ALLOC_H */ +#if !defined(HAVE_MEMMOVE) +# undef CALC_SIZE_T +# if defined(__STDC__) && __STDC__ != 0 +# define CALC_SIZE_T size_t +# else +# define CALC_SIZE_T long +# endif +extern void *memmove(void *s1, const void *s2, CALC_SIZE_T n); +#endif + +#endif /* !__ALLOC_H__ */ diff --git a/assocfunc.c b/assocfunc.c index d3d54ef..d5e276f 100644 --- a/assocfunc.c +++ b/assocfunc.c @@ -91,6 +91,7 @@ associndex(ASSOC *ap, BOOL create, long dim, VALUE *indices) ep->e_dim = dim; ep->e_hash = hash; ep->e_value.v_type = V_NULL; + ep->e_value.v_subtype = V_NOSUBTYPE; for (i = 0; i < dim; i++) copyvalue(&indices[i], &ep->e_indices[i]); ep->e_next = *listhead; @@ -105,47 +106,62 @@ associndex(ASSOC *ap, BOOL create, long dim, VALUE *indices) /* * Search an association for the specified value starting at the - * specified index. Returns the element number (zero based) of the - * found value, or -1 if the value was not found. + * specified index. Returns 0 and stores index if value found, + * otherwise returns 1. */ -long -assocsearch(ASSOC *ap, VALUE *vp, long index) +int +assocsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index) { ASSOCELEM *ep; - if (index < 0) - index = 0; - while (TRUE) { - ep = elemindex(ap, index); - if (ep == NULL) - return -1; - if (!comparevalue(&ep->e_value, vp)) - return index; - index++; + if (i < 0 || j > ap->a_count) { + math_error("This should not happen in assocsearch"); + /*NOTREACHED*/ } + while (i < j) { + ep = elemindex(ap, i); + if (ep == NULL) { + math_error("This should not happen in assocsearch"); + /*NOTREACHED*/ + } + if (acceptvalue(&ep->e_value, vp)) { + utoz(i, index); + return 0; + } + i++; + } + return 1; } /* * Search an association backwards for the specified value starting at the - * specified index. Returns the element number (zero based) of the - * found value, or -1 if the value was not found. + * specified index. Returns 0 and stores the index if the value is + * found; otherwise returns 1. */ -long -assocrsearch(ASSOC *ap, VALUE *vp, long index) +int +assocrsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index) { ASSOCELEM *ep; - if (index >= ap->a_count) - index = ap->a_count - 1; - while (TRUE) { - ep = elemindex(ap, index); - if (ep == NULL) - return -1; - if (!comparevalue(&ep->e_value, vp)) - return index; - index--; + if (i < 0 || j > ap->a_count) { + math_error("This should not happen in assocsearch"); + /*NOTREACHED*/ } + j--; + while (j >= i) { + ep = elemindex(ap, j); + if (ep == NULL) { + math_error("This should not happen in assocsearch"); + /*NOTREACHED*/ + } + if (acceptvalue(&ep->e_value, vp)) { + utoz(j, index); + return 0; + } + j--; + } + return 1; } diff --git a/blkcpy.c b/blkcpy.c new file mode 100644 index 0000000..0876447 --- /dev/null +++ b/blkcpy.c @@ -0,0 +1,1077 @@ +/* + * Copyright (c) 1997 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 + */ + +#include +#include +#include "calc.h" +#include "value.h" +#include "file.h" +#include "blkcpy.h" +#include "string.h" + + +/* + * copystod - copy num indexed items from source value to destination value + * + * given: + * ssi = source starting index + * num = number of items (octets or values) to be copied + * sdi = destination starting index + * + * returns: + * zero if successful, otherwise error-code number + */ +int +copystod(VALUE *svp, long ssi, long num, VALUE *dvp, long dsi) +{ + BLOCK *sblk; + BLOCK *dblk; + BOOL noreloc; + + sblk = NULL; + dblk = NULL; + + /* + * check protections + */ + if (svp->v_subtype & V_NOCOPYFROM) + return E_COPY13; + if (dvp->v_subtype & V_NOCOPYTO) + return E_COPY14; + noreloc = ((dvp->v_subtype & V_NOREALLOC) != 0); + + /* + * determine/check source type + */ + switch(svp->v_type) { + case V_NBLOCK: + if (svp->v_nblock->subtype & V_NOCOPYFROM) + return E_COPY15; + sblk = svp->v_nblock->blk; + if (sblk->data == NULL) + return E_COPY8; + break; + case V_BLOCK: + sblk = svp->v_block; + break; + case V_STR: + case V_OCTET: + case V_NUM: + case V_FILE: + case V_MAT: + case V_LIST: + break; + default: + return E_COPY9; + } + + /* + * determine/check destination type + */ + switch(dvp->v_type) { + case V_NBLOCK: + if (dvp->v_nblock->subtype & V_NOCOPYTO) + return E_COPY16; + noreloc |=((dvp->v_nblock->subtype & V_NOREALLOC) != 0); + dblk = dvp->v_nblock->blk; + if (dblk->data == NULL) + return E_COPY10; + break; + case V_BLOCK: + noreloc = ((dvp->v_subtype & V_NOREALLOC) != 0); + dblk = dvp->v_block; + break; + case V_STR: + case V_NUM: + case V_FILE: + case V_MAT: + case V_LIST: + break; + default: + return E_COPY11; + } + + /* + * copy based on source + */ + switch (svp->v_type) { + case V_BLOCK: + case V_NBLOCK: + /* + * copy from a block + */ + switch(dvp->v_type) { + case V_BLOCK: + case V_NBLOCK: + return copyblk2blk(sblk, ssi, num, dblk, dsi, noreloc); + case V_NUM: + { + NUMBER *n; /* modified number */ + int rt; /* return code */ + + /* copy to a number */ + rt = copyblk2num(sblk, ssi, num, dvp->v_num, dsi, &n); + if (rt == 0) { + qfree(dvp->v_num); + dvp->v_num = n; + } + return rt; + } + case V_FILE: + return copyblk2file(sblk, ssi, num, dvp->v_file, dsi); + case V_MAT: + return copyblk2mat(sblk, ssi, num, dvp->v_mat, dsi); + case V_STR: + return copyblk2str(sblk, ssi, num, dvp->v_str, dsi); + } + return E_COPY12; + + case V_STR: + switch(dvp->v_type) { + case V_BLOCK: + case V_NBLOCK: + /* copy to a block */ + return copystr2blk(svp->v_str, ssi, num, dblk, dsi, + noreloc); + case V_FILE: + return copystr2file(svp->v_str, ssi, num, + dvp->v_file, dsi); + case V_STR: + return copystr2str(svp->v_str, ssi, num, dvp->v_str, + dsi); + } + return E_COPY12; + + case V_OCTET: + switch(dvp->v_type) { + case V_BLOCK: + case V_NBLOCK: + return copyostr2blk((char *) svp->v_octet, ssi, num, + dblk, dsi, noreloc); + case V_STR: + return copyostr2str((char *) svp->v_octet, ssi, num, + dvp->v_str, dsi); + } + return E_COPY12; + + case V_NUM: + + /* + * copy from a number + */ + if (dblk != NULL) { + /* copy to a block */ + return copynum2blk(svp->v_num, ssi, num, dblk, + dsi, noreloc); + } + switch (dvp->v_type) { + case V_MAT: + /* copy to a matrix */ + return E_COPY12; /* not yet - XXX */ + case V_LIST: + /* copy to a list */ + return E_COPY12; /* not yet - XXX */ + } + break; + case V_FILE: + + /* + * copy from a file + */ + if (dblk != NULL) { + /* copy to a block */ + return copyfile2blk(svp->v_file, ssi, num, + dblk, dsi, noreloc); + } + switch (dvp->v_type) { + case V_NUM: + /* copy to a number */ + return E_COPY12; /* not yet - XXX */ + } + break; + + case V_MAT: + + /* + * copy from a matrix + */ + if (dblk != NULL) { + /* copy to a block */ + return copymat2blk(svp->v_mat, ssi, num, dblk, + dsi, noreloc); + } + switch (dvp->v_type) { + case V_MAT: + /* copy to a matrix */ + return copymat2mat(svp->v_mat, ssi, num, + dvp->v_mat, dsi); + case V_LIST: + /* copy to a list */ + return copymat2list(svp->v_mat, ssi, num, + dvp->v_list, dsi); + } + break; + + case V_LIST: + + /* + * copy from a list + */ + if (dblk != NULL) { + /* copy to a block */ + return E_COPY12; /* not yet - XXX */ + } + switch (dvp->v_type) { + case V_MAT: + /* copy to a matrix */ + return copylist2mat(svp->v_list, ssi, num, + dvp->v_mat, dsi); + case V_LIST: + /* copy to a list */ + return copylist2list(svp->v_list, ssi, num, + dvp->v_list, dsi); + } + break; + } + + /* + * unsupported copy combination + */ + return E_COPY12; +} + + +/* + * copymat2mat - copy matrix to matrix + */ +int +copymat2mat(MATRIX *smat, long ssi, long num, MATRIX *dmat, long dsi) +{ + long i; + VALUE *vp; + VALUE *vq; + VALUE *vtemp; + short subtype; + + if (ssi > smat->m_size) + return E_COPY2; + + if (num < 0) + num = smat->m_size - ssi; + if ((USB32) ssi + num > smat->m_size) + return E_COPY5; + if (num == 0) + return 0; + if (dsi < 0) + dsi = 0; + if ((USB32) dsi + num > dmat->m_size) + return E_COPY7; + vtemp = (VALUE *) malloc(num * sizeof(VALUE)); + if (vtemp == NULL) { + math_error("Out of memory for mat-to-mat copy"); + /*NOTREACHED*/ + } + vp = smat->m_table + ssi; + vq = vtemp; + i = num; + while (i-- > 0) + copyvalue(vp++, vq++); + vp = vtemp; + vq = dmat->m_table + dsi; + for (i = num; i > 0; i--, vp++, vq++) { + subtype = vq->v_subtype; + freevalue(vq); + *vq = *vp; + vq->v_subtype = subtype; + } + free(vtemp); + return 0; +} + + +/* + * copyblk2mat - copy block to matrix + */ +int +copyblk2mat(BLOCK *blk, long ssi, long num, MATRIX *dmat, long dsi) +{ + OCTET *op; + VALUE *vp; + VALUE *vq; + VALUE *vtemp; + long i; + short subtype; + + if (ssi > blk->datalen) + return E_COPY2; + if (num < 0) + num = blk->datalen - ssi; + if ((USB32) ssi + num > blk->datalen) + return E_COPY5; + if (num == 0) + return 0; + if (dsi < 0) + dsi = 0; + if ((USB32) dsi + num > dmat->m_size) + return E_COPY7; + op = blk->data + ssi; + vtemp = (VALUE *) malloc(num * sizeof(VALUE)); + if (vtemp == NULL) { + math_error("Out of memory for block-to-matrix copy"); + /*NOTREACHED*/ + } + vp = vtemp; + i = num; + while (i-- > 0) { + vp->v_type = V_NUM; + vp->v_num = itoq((long) *op++); + vp++; + } + vp = vtemp; + vq = dmat->m_table + dsi; + for (i = num; i > 0; i--, vp++, vq++) { + subtype = vq->v_subtype; + freevalue(vq); + *vq = *vp; + vq->v_subtype = subtype; + } + free(vtemp); + return 0; +} + + +/* + * copymat2blk - copy matrix to block + */ +int +copymat2blk(MATRIX *smat, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc) +{ + long i; + long newlen; + long newsize; + USB8 *newdata; + VALUE *vp; + OCTET *op; + + if (ssi > smat->m_size) + return E_COPY2; + if (num < 0) + num = smat->m_size - ssi; + if (num == 0) + return 0; + if ((USB32) ssi + num > smat->m_size) + return E_COPY5; + if (dsi < 0) + dsi = dblk->datalen; + newlen = dsi + num; + if (newlen <= 0) + return E_COPY7; + if (newlen >= dblk->maxsize) { + if (noreloc) + return E_COPY17; + newsize = (1 + newlen/dblk->blkchunk) * dblk->blkchunk; + newdata = (USB8*) realloc(dblk->data, newsize); + if (newdata == NULL) { + math_error("Out of memory for matrix-to-block copy"); + /*NOTREACHED*/ + } + dblk->data = newdata; + dblk->maxsize = newsize; + } + vp = smat->m_table + ssi; + op = dblk->data + dsi; + for (i = num; i > 0; i--) + copy2octet(vp++, op++); + if (newlen > dblk->datalen) + dblk->datalen = newlen; + return 0; +} + + +/* + * copymat2list - copy matrix to list + */ +int +copymat2list(MATRIX *smat, long ssi, long num, LIST *lp, long dsi) +{ + VALUE *vp; + VALUE *vq; + LISTELEM *ep; + VALUE *vtemp; + long i; + + if (ssi > smat->m_size) + return E_COPY2; + if (num < 0) + num = smat->m_size - ssi; + if (num == 0) + return 0; + if ((USB32) ssi + num > smat->m_size) + return E_COPY5; + if (dsi < 0) + dsi = 0; + if ((USB32) dsi + num > lp->l_count) + return E_COPY7; + vtemp = (VALUE *) malloc(num * sizeof(VALUE)); + if (vtemp == NULL) { + math_error("Out of memory for matrix-to-list copy"); + /*NOTREACHED*/ + } + vp = smat->m_table + ssi; + vq = vtemp; + i = num; + while (i-- > 0) + copyvalue(vp++, vq++); + vq = vtemp; + ep = listelement(lp, (long) dsi); + i = num; + while (i-- > 0) { + freevalue(&ep->e_value); + ep->e_value = *vq++; + ep = ep->e_next; + } + free(vtemp); + return 0; +} + + +/* + * copymat2list - copy list to matrix + */ +int +copylist2mat(LIST *lp, long ssi, long num, MATRIX *dmat, long dsi) +{ + VALUE *vp; + VALUE *vq; + LISTELEM *ep; + VALUE *vtemp; + long i; + short subtype; + + if (ssi > lp->l_count) + return E_COPY2; + if (num < 0) + num = lp->l_count - ssi; + if (num == 0) + return 0; + if ((USB32) ssi + num > lp->l_count) + return E_COPY5; + if (dsi < 0) + dsi = 0; + if ((USB32) dsi + num > dmat->m_size) + return E_COPY7; + vtemp = (VALUE *) malloc(num * sizeof(VALUE)); + if (vtemp == NULL) { + math_error("Out of memory for list-to-matrix copy"); + /*NOTREACHED*/ + } + ep = listelement(lp, (long) ssi); + vp = vtemp; + i = num; + while (i-- > 0) { + copyvalue(&ep->e_value, vp++); + ep = ep->e_next; + } + vp = vtemp; + vq = dmat->m_table + dsi; + for (i = num; i > 0; i--, vp++, vq++) { + subtype = vq->v_subtype; + freevalue(vq); + *vq = *vp; + vq->v_subtype = subtype; + } + free(vtemp); + return 0; +} + + +/* + * copylist2list - copy list to list + */ +int +copylist2list(LIST *slp, long ssi, long num, LIST *dlp, long dsi) +{ + long i; + LISTELEM *sep; + LISTELEM *dep; + VALUE *vtemp; + VALUE *vp; + + if (ssi > slp->l_count) + return E_COPY2; + if (num < 0) + num = slp->l_count - ssi; + if (num == 0) + return 0; + if ((USB32) ssi + num > slp->l_count) + return E_COPY5; + if (dsi < 0) + dsi = 0; + if ((USB32) dsi + num > dlp->l_count) + return E_COPY7; + vtemp = (VALUE *) malloc(num * sizeof(VALUE)); + if (vtemp == NULL) { + math_error("Out of memory for list-to-list copy"); + /*NOTREACHED*/ + } + sep = listelement(slp, (long) ssi); + vp = vtemp; + i = num; + while (i-- > 0) { + copyvalue(&sep->e_value, vp++); + sep = sep->e_next; + } + dep = listelement(dlp, (long) dsi); + vp = vtemp; + i = num; + while (i-- > 0) { + freevalue(&dep->e_value); + dep->e_value = *vp++; + dep = dep->e_next; + } + free(vtemp); + return 0; +} + + +/* + * copyblk2file - copy block to file + */ +int +copyblk2file(BLOCK *sblk, long ssi, long num, FILEID id, long dsi) +{ + FILEIO *fiop; + FILE *fp; + unsigned int numw; + + if (ssi > sblk->datalen) + return E_COPY2; + if (num < 0) + num = sblk->datalen - ssi; + if (num == 0) + return 0; + + fiop = findid(id, 'w'); + if (fiop == NULL) + return E_COPYF1; + fp = fiop->fp; + if (id == 1 || id == 2) { + numw = idfputstr(id, (char *)sblk->data + ssi); /* XXX */ + return 0; + } + if (dsi >= 0) { + if (fseek(fp, dsi, 0)) + return E_COPYF2; + } + numw = fwrite(sblk->data + ssi, 1, num, fp); + if (numw < num) + return E_COPYF3; + fflush(fp); + return 0; +} + + +/* + * copyfile2blk - copy file to block + */ +int +copyfile2blk(FILEID id, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc) +{ + FILEIO *fiop; + FILE *fp; + unsigned int numw; + ZVALUE fsize; + long filelen; + long newlen; + long newsize; + OCTET *newdata; + + if (id < 3) /* excludes copying from stdin */ + return E_COPYF1; + fiop = findid(id, 'r'); + if (fiop == NULL) + return E_COPYF1; + + fp = fiop->fp; + + if (get_open_siz(fp, &fsize)) + return E_COPYF2; + if (zge31b(fsize)) { + zfree(fsize); + return E_COPY5; + } + filelen = ztoi(fsize); + zfree(fsize); + + if (ssi > filelen) + return E_COPY2; + if (num < 0) + num = filelen - ssi; + if (num == 0) + return 0; + if ((USB32) ssi + num > filelen) + return E_COPY5; + if (fseek(fp, ssi, 0)) /* using system fseek XXX */ + return E_COPYF2; + if (dsi < 0) + dsi = dblk->datalen; + newlen = dsi + num; + if (newlen <= 0) + return E_COPY7; + if (newlen >= dblk->maxsize) { + if (noreloc) + return E_COPY17; + newsize = (1 + newlen/dblk->blkchunk) * dblk->blkchunk; + newdata = (USB8*) realloc(dblk->data, newsize); + if (newdata == NULL) { + math_error("Out of memory for block-to-block copy"); + /*NOTREACHED*/ + } + dblk->data = newdata; + dblk->maxsize = newsize; + } + numw = fread(dblk->data + dsi, 1, num, fp); + if (numw < num) + return E_COPYF4; + if (newlen > dblk->datalen) + dblk->datalen = newlen; + return 0; +} + + +/* + * copystr2file - copy string to file + */ +int +copystr2file(STRING *str, long ssi, long num, FILEID id, long dsi) +{ + long len; + FILEIO *fiop; + unsigned int numw; + FILE *fp; + + len = str->s_len; + + if (ssi >= len) + return E_COPY2; + if (num < 0) + num = len - ssi; + if (num <= 0) /* Nothing to be copied */ + return 0; + if ((USB32) ssi + num > len) + return E_COPY5; /* Insufficient memory in str */ + fiop = findid(id, 'w'); + if (fiop == NULL) + return E_COPYF1; + fp = fiop->fp; + if (id == 1 || id == 2) { + numw = idfputstr(id, str->s_str + ssi); /* XXX */ + return 0; + } + if (dsi >= 0) { + if (fseek(fp, dsi, 0)) + return E_COPYF2; + } + numw = fwrite(str->s_str + ssi, 1, num, fp); + if (numw < num) + return E_COPYF3; + fflush(fp); + return 0; +} + + +/* + * copyblk2blk - copy block to block + */ +int +copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc) +{ + long newlen; + long newsize; + USB8 *newdata; + + if (ssi > sblk->datalen) + return E_COPY2; + if (num < 0) + num = sblk->datalen - ssi; + if (num == 0) /* Nothing to be copied */ + return 0; + if ((unsigned int) ssi + num > sblk->datalen) + return E_COPY5; + if (dsi < 0) + dsi = dblk->datalen; + newlen = dsi + num; + if (newlen <= 0) + return E_COPY7; + if (newlen >= dblk->maxsize) { + if (noreloc) + return E_COPY17; + newsize = (1 + newlen/dblk->blkchunk) * dblk->blkchunk; + newdata = (USB8*) realloc(dblk->data, newsize); + if (newdata == NULL) { + math_error("Out of memory for block-to-block copy"); + /*NOTREACHED*/ + } + dblk->data = newdata; + dblk->maxsize = newsize; + } + memmove(dblk->data + dsi, sblk->data + ssi, num); + if (newlen > dblk->datalen) + dblk->datalen = newlen; + return 0; +} + + +/* + * copystr2blk - copy string to block + */ +int +copystr2blk(STRING *str, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc) +{ + long len; + long newlen; + long newsize; + USB8 *newdata; + + len = str->s_len; + + if (ssi >= len) + return E_COPY2; + if (num < 0) + num = len - ssi; + if (num <= 0) /* Nothing to be copied */ + return 0; + if (dsi < 0) + dsi = dblk->datalen; + newlen = dsi + num + 1; + if (newlen <= 0) + return E_COPY7; + if (newlen >= dblk->maxsize) { + if (noreloc) + return E_COPY17; + newsize = (1 + newlen/dblk->blkchunk) * dblk->blkchunk; + newdata = (USB8*) realloc(dblk->data, newsize); + if (newdata == NULL) { + math_error("Out of memory for string-to-block copy"); + /*NOTREACHED*/ + } + dblk->data = newdata; + dblk->maxsize = newsize; + } + memmove(dblk->data + dsi, str->s_str + ssi, num); + dblk->data[dsi + num] = '\0'; + if (newlen > dblk->datalen) + dblk->datalen = newlen; + return 0; +} + + +/* + * copystr2str - copy up to num characters from sstr (starting at + * index ssi) to dstr (starting at index dsi); num is reduced if there + * are insufficient characters in sstr or insufficient space in dstr. + */ +int +copystr2str(STRING *sstr, long ssi, long num, STRING *dstr, long dsi) +{ + char *c, *c1; + + if (num < 0 || ssi + num > sstr->s_len) + num = sstr->s_len - ssi; + if (num <= 0) + return 0; /* Nothing to be copied */ + if (dsi < 0) /* default destination index */ + dsi = 0; + if (dsi + num > dstr->s_len) + num = dstr->s_len - dsi; + c1 = sstr->s_str + ssi; + c = dstr->s_str + dsi; + while (num-- > 0) + *c++ = *c1++; + return 0; +} + + +/* + * copyblk2str - copy up to num characters from sblk (starting at + * index ssi) to str (starting at index dsi); num is reduced if there + * is insufficient data in blk or insufficient space in str + */ +int +copyblk2str(BLOCK *sblk, long ssi, long num, STRING *dstr, long dsi) +{ + USB8 *c, *c1; + + if (num < 0 || ssi + num > sblk->datalen) + num = sblk->datalen - ssi; + if (num <= 0) + return 0; /* Nothing to be copied */ + if (dsi < 0) /* default destination index */ + dsi = 0; + if (dsi + num > dstr->s_len) + num = dstr->s_len - dsi; + c1 = sblk->data + ssi; + c = (USB8 *)dstr->s_str + dsi; + while (num-- > 0) + *c++ = *c1++; + return 0; +} +/* + * copyostr2str - copy octet-specified string to string + */ +int +copyostr2str(char *sstr, long ssi, long num, STRING *dstr, long dsi) +{ + long len; + char *c, *c1; + + len = (long)strlen(sstr); + + if (num < 0 || ssi + num > len) + num = len - ssi; + if (num <= 0) /* Nothing to be copied */ + return 0; + if (dsi < 0) + dsi = 0; /* Default destination index */ + if (dsi + num > dstr->s_len) + num = dstr->s_len - dsi; + c1 = sstr + ssi; + c = dstr->s_str + dsi; + while (num-- > 0) + *c++ = *c1++; + return 0; +} + + +/* + * copyostr2blk - copy octet-specified string to block + */ +int +copyostr2blk(char *str,long ssi,long num,BLOCK *dblk,long dsi,BOOL noreloc) +{ + int len; + int newlen; + int newsize; + USB8 *newdata; + + len = strlen(str) + 1; + + if (ssi > len) + return E_COPY2; + if (num < 0 || (unsigned long) ssi + num > len) + num = len - ssi; + if (num <= 0) /* Nothing to be copied */ + return 0; + if (dsi < 0) + dsi = dblk->datalen; /* Default destination index */ + newlen = dsi + num; + if (newlen <= 0) + return E_COPY7; + if (newlen >= dblk->maxsize) { + if (noreloc) + return E_COPY17; + newsize = (1 + newlen/dblk->blkchunk) * dblk->blkchunk; + newdata = (USB8*) realloc(dblk->data, newsize); + if (newdata == NULL) { + math_error("Out of memory for string-to-block copy"); + /*NOTREACHED*/ + } + dblk->data = newdata; + dblk->maxsize = newsize; + } + memmove(dblk->data + dsi, str + ssi, num); + if (newlen > dblk->datalen) + dblk->datalen = newlen; + return 0; +} +#if !defined(HAVE_MEMMOVE) +/* + * memmove - simulate the memory move function that deals with overlap + * + * Copying between objects that overlap will take place correctly. + * + * given: + * s1 destination + * s2 source + * n octet count + * + * returns: + * s1 + */ +void * +memmove(void *s1, const void *s2, CALC_SIZE_T n) +{ + /* + * firewall + */ + if (s1 == NULL || s2 == NULL) { + math_error("bogus memmove NULL ptr"); + /*NOTREACHED*/ + } + if (n <= 0) { + /* neg or 0 count does nothing */ + return s1; + } + if ((char *)s1 == (char *)s2) { + /* copy to same location does nothing */ + return s1; + } + + /* + * determine if we need to deal with overlap copy + */ + if ((char *)s1 > (char *)s2 && (char *)s1 < (char *)s2+n) { + + /* + * we have to copy backwards ... slowly + */ + while (n-- > 0) { + ((char *)s1)[n] = ((char *)s2)[n]; + } + + } else { + + /* + * safe ... no overlap problems + */ + (void) memcpy(s1, s2, n); + + } + return s1; +} +#endif + + +/* + * copynum2blk - copy number numerator to block + */ +int +copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc) +{ + long newlen; + long newsize; + USB8 *newdata; +#if CALC_BYTE_ORDER == BIG_ENDIAN + ZVALUE *swnum; /* byte swapped numerator */ +#endif + + if (ssi > snum->num.len) + return E_COPY2; + if (num < 0) + num = snum->num.len - ssi; + if (num == 0) /* Nothing to be copied */ + return 0; + if ((unsigned long) ssi + num > snum->num.len) + return E_COPY5; + if (dsi < 0) + dsi = dblk->datalen; + newlen = dsi + (long)(num*sizeof(HALF)); + if (newlen <= 0) + return E_COPY7; + if (newlen >= dblk->maxsize) { + if (noreloc) + return E_COPY17; + newsize = (1 + newlen/dblk->blkchunk) * dblk->blkchunk; + newdata = (USB8*) realloc(dblk->data, newsize); + if (newdata == NULL) { + math_error("Out of memory for num-to-block copy"); + /*NOTREACHED*/ + } + dblk->data = newdata; + dblk->maxsize = newsize; + } +#if CALC_BYTE_ORDER == LITTLE_ENDIAN + memmove(dblk->data+dsi, (char *)(snum->num.v+ssi), num*sizeof(HALF)); +#else + swnum = swap_b8_in_ZVALUE(NULL, &(snum->num), FALSE); + memmove(dblk->data+dsi, (char *)(swnum->v+ssi), num*sizeof(HALF)); + zfree(*swnum); +#endif + if (newlen > dblk->datalen) + dblk->datalen = newlen; + return 0; +} + + +/* + * copyblk2num - copy block to number + */ +int +copyblk2num(BLOCK *sblk, long ssi, long num, NUMBER *dnum, long dsi, NUMBER **res) +{ + long newlen; + NUMBER *ret; /* cloned and modified numerator */ +#if CALC_BYTE_ORDER == BIG_ENDIAN + HALF *swapped; /* byte swapped input data */ + unsigned long halflen; /* length of the input ounded up to HALFs */ + HALF *h; /* copy byteswap pointer */ + unsigned long i; +#endif + + if (ssi > sblk->datalen) + return E_COPY2; + if (num < 0) + num = sblk->datalen - ssi; + if (num == 0) /* Nothing to be copied */ + return 0; + if ((unsigned long) ssi + num > sblk->datalen) + return E_COPY5; + if (dsi < 0) + dsi = dnum->num.len; + newlen = dsi + (long)((num+sizeof(HALF)-1)/sizeof(HALF)); + if (newlen <= 0) + return E_COPY7; + + /* quasi-clone the numerator to the new size */ + ret = qalloc(); + ret->num.sign = dnum->num.sign; + ret->num.v = alloc(newlen); + ret->num.len = newlen; + /* ensure that any trailing octets will be zero filled */ + ret->num.v[newlen-1] = 0; + zcopyval(dnum->num, ret->num); + if (!zisunit(ret->den)) { + ret->den.len = dnum->den.len; + ret->den.v = alloc(dnum->den.len); + zcopyval(dnum->den, ret->den); + } + + /* move the data */ +#if CALC_BYTE_ORDER == LITTLE_ENDIAN + memmove((char *)(ret->num.v + dsi), sblk->data + ssi, num); +#else + /* form a HALF aligned copy of the input */ + halflen = (num+sizeof(HALF)-1) / sizeof(HALF); + swapped = (HALF *)malloc(halflen * sizeof(HALF)); + if (swapped == NULL) { + math_error("Out of memory for block-to-num copy"); + /*NOTREACHED*/ + } + /* ensure that any trailing octets will be zero filled */ + swapped[halflen-1] = 0; + memcpy(swapped, sblk->data + ssi, num); + /* byte swap the copy of the input */ + for (i=0, h=swapped; i < halflen; ++i, ++h) { + SWAP_B8_IN_HALF(h, h); + } + /* copy over whole byte-swapped HALFs */ + memcpy((char *)(ret->num.v + dsi), swapped, + (num/sizeof(HALF))*sizeof(HALF)); + /* copy over any octets in the last partial HALF */ + i = num % sizeof(HALF); + if (i != 0) { + memcpy((char *)(ret->num.v + dsi)+num-i, + (char *)swapped + num-i, i); + } + free(swapped); +#endif + /* save new number */ + *res = ret; + return 0; +} diff --git a/blkcpy.h b/blkcpy.h new file mode 100644 index 0000000..6443732 --- /dev/null +++ b/blkcpy.h @@ -0,0 +1,39 @@ +/* + * Copyright (c) 1997 David I. Bell + * Permission is granted to use, distribute, or modify this source, + * provided that this copyright notice remains intact. + * + * Definitions of general values and related routines used by the calculator. + */ + + +#if !defined(__BLKCPY_H__) +#define __BLKCPY_H__ + +/* + * the main copy gateway function + */ +extern int copystod(VALUE *, long, long, VALUE *, long); + +/* + * specific copy functions + */ +extern int copyblk2blk(BLOCK *, long, long, BLOCK *, long, BOOL); +extern int copyblk2file(BLOCK *, long, long, FILEID, long); +extern int copyblk2mat(BLOCK *, long, long, MATRIX *, long); +extern int copyblk2num(BLOCK *, long, long, NUMBER *, long, NUMBER **); +extern int copyblk2str(BLOCK *, long, long, STRING *, long); +extern int copyfile2blk(FILEID, long, long, BLOCK *, long, BOOL); +extern int copylist2list(LIST *, long, long, LIST *, long); +extern int copylist2mat(LIST *, long, long, MATRIX *, long); +extern int copymat2blk(MATRIX *, long, long, BLOCK *, long, BOOL); +extern int copymat2list(MATRIX *, long, long, LIST *, long); +extern int copymat2mat(MATRIX *, long, long, MATRIX *, long); +extern int copynum2blk(NUMBER *, long, long, BLOCK *, long, BOOL); +extern int copyostr2blk(char *, long, long, BLOCK *, long, BOOL); +extern int copyostr2str(char *, long, long, STRING *, long); +extern int copystr2blk(STRING *, long, long, BLOCK *, long, BOOL); +extern int copystr2file(STRING *, long, long, FILEID, long); +extern int copystr2str(STRING *, long, long, STRING *, long); + +#endif /* !__BLKCPY_H__ */ diff --git a/block.c b/block.c new file mode 100644 index 0000000..2d24f29 --- /dev/null +++ b/block.c @@ -0,0 +1,755 @@ +/* + * block - fixed, dynamic, fifo and circular memory blocks + */ +/* + * 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, + * provided that the above copyright, this permission notice and text + * this comment, 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. + * + * Comments, suggestions, bug fixes and questions about these routines + * are welcome. Send EMail to the address given below. + * + * Happy bit twiddling, + * + * Landon Curt Noll + * + * chongo@toad.com + * ...!{pyramid,sun,uunet}!hoptoad!chongo + * + * chongo was here /\../\ + */ + + +#include +#include "value.h" +#include "zmath.h" +#include "config.h" +#include "block.h" +#include "nametype.h" +#include "string.h" +#include "calcerr.h" + +#define NBLOCKCHUNK 16 + +static long nblockcount = 0; +static long maxnblockcount = 0; +static STRINGHEAD nblocknames; +static NBLOCK **nblocks; + + +/* forward declarations */ +static void blkchk(BLOCK*); + + +/* + * blkalloc - allocate a block + * + * given: + * len - initial memory length of the block + * type - BLK_TYPE_XXX + * chunk - allocation chunk size + * + * returns: + * pointer to a newly allocated BLOCK + */ +BLOCK * +blkalloc(int len, int chunk) +{ + BLOCK *new; /* new block allocated */ + + /* + * firewall + */ + if (len < 0) + len = 0; + if (chunk <= 0) + chunk = BLK_CHUNKSIZE; + + /* + * allocate BLOCK + */ + new = (BLOCK *)malloc(sizeof(BLOCK)); + if (new == NULL) { + math_error("cannot allocate block"); + /*NOTREACHED*/ + } + + /* + * initialize BLOCK + */ + new->blkchunk = chunk; + new->maxsize = ((len+chunk)/chunk)*chunk; + new->data = (USB8*)malloc(new->maxsize); + if (new->data == NULL) { + math_error("cannot allocate block data storage"); + /*NOTREACHED*/ + } + memset(new->data, 0, new->maxsize); + new->datalen = len; + + /* + * return BLOCK + */ + if (conf->calc_debug > 0) { + blkchk(new); + } + return new; +} + + +/* + * blk_free - free a block + * + * NOTE: THIS IS NOT THE CALC blktrunc() BUILTIN FUNCTION!! This + * is what is called to free block storage. + * + * given: + * blk - the block to free + */ +void +blk_free(BLOCK *blk) +{ + /* free if non-NULL */ + if (blk != NULL) { + + /* free data storage */ + if (blk->data != NULL) { + free(blk->data); + } + + /* free the block */ + free(blk); + } + return; +} + + +/* + * blkchk - check the sanity of a block + * + * These checks should never fail if calc is working correctly. During + * debug time, we plan to call this function often. Once we are satisfied, + * we will normally call this code only in a few places. + * + * This function is normally called whenever the following builtins are called: + * + * alloc(), realloc(), free() + * + * unless the "calc_debug" is set to -1. If "calc_debug" is > 0, then + * most blk builtins will call this function. + * + * given: + * blk - the BLOCK to check + * + * returns: + * if all is ok, otherwise math_error() is called and this + * function does not return + */ +static void +blkchk(BLOCK *blk) +{ + + /* + * firewall - general sanity check + */ + if (conf->calc_debug == -1) { + /* do nothing when debugging is disabled */ + return; + } + if (blk == NULL) { + math_error("internal: blk ptr is NULL"); + /*NOTREACHED*/ + } + + /* + * pointers must not be NULL + */ + if (blk->data == NULL) { + math_error("internal: blk->data ptr is NULL"); + /*NOTREACHED*/ + } + + /* + * check data lengths + */ + if (blk->datalen < 0) { + math_error("internal: blk->datalen < 0"); + /*NOTREACHED*/ + } + + /* + * check the datalen and datalen2 values + */ + if (blk->datalen < 0) { + math_error("internal: blk->datalen < 0"); + /*NOTREACHED*/ + } + return; +} + + +/* + * blkrealloc - reallocate a block + * + * Reallocation of a block can change several aspects of a block. + * + * It can change the much data it holds or can hold. + * + * It can change the memory footprint (in terms of + * how much storage is malloced for current or future use). + * + * It can change the chunk size used to grow malloced size + * as the data size grows. + * + * Each of the len and chunksize may be kept the same. + * + * given: + * blk - old BLOCK to reallocate + * newlen - how much data the block holds + * newchunk - allocation chunk size (<0 ==> no change, 0 == default) + */ +BLOCK * +blkrealloc(BLOCK *blk, int newlen, int newchunk) +{ + USB8 *new; /* realloced storage */ + int newmax; /* new maximum stoage size */ + + /* + * firewall + */ + if (conf->calc_debug != -1) { + blkchk(blk); + } + + /* + * process args + */ + /* newlen < 0 means do not change the length */ + if (newlen < 0) { + newlen = blk->datalen; + } + /* newchunk <= 0 means do not change the chunk size */ + if (newchunk < 0) { + newchunk = blk->blkchunk; + } else if (newchunk == 0) { + newchunk = BLK_CHUNKSIZE; + } + + /* + * reallocate storage if we have a different allocation size + */ + newmax = ((newlen+newchunk)/newchunk)*newchunk; + if (newmax != blk->maxsize) { + + /* reallocate new storage */ + new = (USB8*)realloc(blk->data, newmax); + if (new == NULL) { + math_error("cannot reallocate block storage"); + /*NOTREACHED*/ + } + + /* clear any new storage */ + if (newmax > blk->maxsize) { + memset(new + blk->maxsize, 0, (newmax - blk->maxsize)); + } + blk->maxsize = newmax; + + /* restore the data pointers */ + blk->data = new; + } + + /* + * deal the case of a newlen == 0 early and return + */ + if (newlen == 0) { + + /* + * setup the empty buffer + * + * We know that newtype is not circular since we force + * newlen to be at least 1 (because circular blocks + * always have at least one unused octet). + */ + if (blk->datalen < blk->maxsize) { + memset(blk->data, 0, blk->datalen); + } else { + memset(blk->data, 0, blk->maxsize); + } + blk->datalen = 0; + if (conf->calc_debug > 0) { + blkchk(blk); + } + return blk; + } + + /* + * Set the data length + * + * We also know that the new block is not empty since we have + * already dealth with that case above. + * + * After this section of code, limit and datalen will be + * correct in terms of the new type. + */ + if (newlen > blk->datalen) { + + /* there is new storage, clear it */ + memset(blk->data + blk->datalen, 0, newlen-blk->datalen); + /* growing storage for blocks grows the data */ + blk->datalen = newlen; + + } else if (newlen <= blk->datalen) { + + /* the block will be full */ + blk->datalen = newlen; + } + + /* + * return realloced type + */ + if (conf->calc_debug > 0) { + blkchk(blk); + } + return blk; +} + + +/* + * blktrunc - truncate a BLOCK down to a minimal fixed block + * + * NOTE: THIS IS NOT THE INTERNAL CALC FREE FUNCTION!! This + * is what blktrunc() builtin calls to reduce storage of a block + * down to an absolute minimum. + * + * This actually forms a zero length fixed block with a chunk of 1. + * + * given: + * blk - the BLOCK to shrink + * + * returns: + * pointer to a newly allocated BLOCK + */ +void +blktrunc(BLOCK *blk) +{ + /* + * firewall + */ + if (conf->calc_debug != -1) { + blkchk(blk); + } + + /* + * free the old storage + */ + free(blk->data); + + /* + * setup as a zero length fixed block + */ + blk->blkchunk = 1; + blk->maxsize = 1; + blk->datalen = 0; + blk->data = (USB8*)malloc(1); + if (blk->data == NULL) { + math_error("cannot allocate truncated block storage"); + /*NOTREACHED*/ + } + blk->data[0] = (USB8)0; + if (conf->calc_debug > 0) { + blkchk(blk); + } + return; +} + + +/* + * blk_copy - copy a block + * + * given: + * blk - the block to copy + * + * returns: + * pointer to copy of blk + */ +BLOCK * +blk_copy(BLOCK *blk) +{ + BLOCK *new; /* copy of blk */ + + /* + * malloc new block + */ + new = (BLOCK *)malloc(sizeof(BLOCK)); + if (new == NULL) { + math_error("blk_copy: cannot malloc BLOCK"); + /*NOTREACHED*/ + } + + /* + * duplicate most of the block + */ + *new = *blk; + + /* + * duplicate block data + */ + new->data = (USB8 *)malloc(blk->maxsize); + if (new->data == NULL) { + math_error("blk_copy: cannot duplicate block data"); + /*NOTREACHED*/ + } + memcpy(new->data, blk->data, blk->maxsize); + return new; +} + + +/* + * blk_cmp - compare blocks + * + * given: + * a first BLOCK + * b second BLOCK + * + * returns: + * TRUE => BLOCKs are different + * FALSE => BLOCKs are the same + */ +int +blk_cmp(BLOCK *a, BLOCK *b) +{ + /* + * firewall and quick check + */ + if (a == b) { + /* pointers to the same object */ + return FALSE; + } + if (a == NULL || b == NULL) { + /* one pointer is NULL, so they differ */ + return TRUE; + } + + /* + * compare lengths + */ + if (a->datalen != b->datalen) { + /* different lengths are different */ + return TRUE; + } + + /* + * compare the section + * + * We have the same lengths and types, so compare the data sections. + */ + if (memcmp(a->data, b->data, a->datalen) != 0) { + /* different sections are different */ + return TRUE; + } + + /* + * the blocks are the same + */ + return FALSE; +} + + +/* + * Print chunksize, maxsize, datalen on line line and if datalen > 0, + * up to * 30 octets on the following line, with ... if datalen exceeds 30. + */ +/*ARGSUSED*/ +void +blk_print(BLOCK *blk) +{ + long i; + BOOL havetail; + USB8 *ptr; + + /* XXX - use the config parameters for better print control */ + + printf("chunksize = %d, maxsize = %d, datalen = %d\n\t", + (int)blk->blkchunk, (int)blk->maxsize, (int)blk->datalen); + i = blk->datalen; + havetail = (i > 30); + if (havetail) + i = 30; + ptr = blk->data; + while (i-- > 0) + printf("%02x", *ptr++); + if (havetail) + printf("..."); +} + + +/* + * Routine to print id and name of a named block and details of its + * block component. + */ +void +nblock_print(NBLOCK *nblk) +{ + BLOCK *blk; + + /* XXX - use the config parameters for better print control */ + + blk = nblk->blk; + printf("block %d: %s\n\t", nblk->id, nblk->name); + if (blk->data == NULL) { + printf("chunksize = %d, maxsize = %d, datalen = %d\n\t", + (int)blk->blkchunk, (int)blk->maxsize, (int)blk->datalen); + printf("NULL"); + } + else + blk_print(blk); +} + + +/* + * realloc a named block specified by its id. The new datalen and + * chunksize are specified by len >= 0 and chunk > 0. If len < 0 + * or chunk <= 0, these values used are the current datalen and + * chunksize, so there is no point in calling this unless len >= 0 + * and/or chunk > 0. + * No reallocation occurs if the new maxsize is equal to the old maxsize. + */ +NBLOCK * +reallocnblock(int id, int len, int chunk) +{ + BLOCK *blk; + int newsize; + int oldsize; + USB8* newdata; + + /* Fire wall */ + if (id < 0 || id >= nblockcount) { + math_error("Bad id in call to reallocnblock"); + /*NOTREACHED*/ + } + + blk = nblocks[id]->blk; + if (len < 0) + len = blk->datalen; + if (chunk < 0) + chunk = blk->blkchunk; + else if (chunk == 0) + chunk = BLK_CHUNKSIZE; + newsize = (1 + len/chunk) * chunk; + oldsize = blk->maxsize; + newdata = blk->data; + if (newdata == NULL) { + newdata = malloc(newsize); + if (newdata == NULL) { + math_error("Allocation failed"); + /*NOTREACHED*/ + } + } + else if (newsize != oldsize) { + newdata = realloc(blk->data, newsize); + if (newdata == NULL) { + math_error("Reallocation failed"); + /*NOTREACHED*/ + } + } + memset(newdata + len, 0, newsize - len); + + blk->maxsize = newsize; + blk->datalen = len; + blk->blkchunk = chunk; + blk->data = newdata; + return nblocks[id]; +} + + +/* + * Create and return a new namedblock with specified name, len and + * chunksize. + */ +NBLOCK * +createnblock(char *name, int len, int chunk) +{ + NBLOCK *res; + char *newname; + + if (nblockcount >= maxnblockcount) { + if (maxnblockcount <= 0) { + maxnblockcount = NBLOCKCHUNK; + nblocks = (NBLOCK **)malloc(NBLOCKCHUNK * + sizeof(NBLOCK *)); + if (nblocks == NULL) { + maxnblockcount = 0; + math_error("unable to malloc new named blocks"); + /*NOTREACHED*/ + } + } else { + maxnblockcount += NBLOCKCHUNK; + nblocks = (NBLOCK **)realloc(nblocks, maxnblockcount * + sizeof(NBLOCK *)); + if (nblocks == NULL) { + maxnblockcount = 0; + math_error("cannot malloc more named blocks"); + /*NOTREACHED*/ + } + } + } + if (nblockcount == 0) + initstr(&nblocknames); + if (findstr(&nblocknames, name) >= 0) { + math_error("Named block already exists!!!"); + /*NOTREACHED*/ + } + newname = addstr(&nblocknames, name); + if (newname == NULL) { + math_error("Block name allocation failed"); + /*NOTREACHED*/ + } + + res = (NBLOCK *) malloc(sizeof(NBLOCK)); + if (res == NULL) { + math_error("Named block allocation failed"); + /*NOTREACHED*/ + } + + nblocks[nblockcount] = res; + res->name = newname; + res->subtype = V_NOSUBTYPE; + res->id = nblockcount++; + res->blk = blkalloc(len, chunk); + return res; +} + + +/* + * find a named block + */ +int +findnblockid(char * name) +{ + return findstr(&nblocknames, name); +} + + +/* + * free data block for named block with specified id + */ +int +removenblock(int id) +{ + NBLOCK *nblk; + + if (id < 0 || id >= nblockcount) + return E_BLKFREE3; + nblk = nblocks[id]; + if (nblk->blk->data == NULL) + return 0; + if (nblk->subtype & V_NOREALLOC) + return E_BLKFREE5; + free(nblk->blk->data); + nblk->blk->data = NULL; + nblk->blk->maxsize = 0; + nblk->blk->datalen = 0; + return 0; +} + + +/* + * count number of current unfreed named blocks + */ +int +countnblocks(void) +{ + int n; + int id; + + for (n = 0, id = 0; id < nblockcount; id++) { + if (nblocks[id]->blk->data != NULL) + n++; + } + return n; +} + + +/* + * display id and name for each unfreed named block + */ +void +shownblocks(void) +{ + int id; + + if (countnblocks() == 0) { + printf("No unfreed named blocks\n\n"); + return; + } + printf(" id name\n"); + printf("---- -----\n"); + for (id = 0; id < nblockcount; id++) { + if (nblocks[id]->blk->data != NULL) + printf("%3d %s\n", id, nblocks[id]->name); + } + printf("\n"); +} + + +/* + * Return pointer to nblock with specified id, NULL if never created. + * The memory for the nblock found may have been freed. + */ +NBLOCK * +findnblock(int id) +{ + if (id < 0 || id >= nblockcount) + return NULL; + return nblocks[id]; +} + + +/* + * Create a new block with specified newlen and new chunksize and copy + * min(newlen, oldlen) octets to the new block. The old block is + * not changed. + */ +BLOCK * +copyrealloc(BLOCK *blk, int newlen, int newchunk) +{ + BLOCK * newblk; + int oldlen; + + oldlen = blk->datalen; + + if (newlen < 0) /* retain length */ + newlen = oldlen; + + if (newchunk < 0) /* retain chunksize */ + newchunk = blk->blkchunk; + else if (newchunk == 0) /* use default chunksize */ + newchunk = BLK_CHUNKSIZE; + + + newblk = blkalloc(newlen, newchunk); + + if (newlen < oldlen) + oldlen = newlen; + + if (newlen > 0) + memcpy(newblk->data, blk->data, oldlen); + + return newblk; +} diff --git a/block.h b/block.h new file mode 100644 index 0000000..8eb34ec --- /dev/null +++ b/block.h @@ -0,0 +1,230 @@ +/* + * block - fixed, dynamic, fifo and circular memory blocks + */ +/* + * 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, + * provided that the above copyright, this permission notice and text + * this comment, 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. + * + * Comments, suggestions, bug fixes and questions about these routines + * are welcome. Send EMail to the address given below. + * + * Happy bit twiddling, + * + * Landon Curt Noll + * + * chongo@toad.com + * ...!{pyramid,sun,uunet}!hoptoad!chongo + * + * chongo was here /\../\ + */ + + +#if !defined(__BLOCK_H__) +#define __BLOCK_H__ + + +/* + * block - the basic block structure + * + * A block comes is one of several types. At the moment, only fixed + * types are defined. + * + *** + * + * Block functions and operations: + * + * x[i] + * (i-1)th octet + * + * blk(len [, blkchunk]) + * unnamed block + * len > 0 + * blkchunk defaults to BLK_CHUNKSIZE + * + * blk(name, [len [, blkchunk]]) + * named block + * len > 0 + * blkchunk defaults to BLK_CHUNKSIZE + * + * blkfree(x) + * Reduce storage down to 0 octetes. + * + * size(x) + * The length of data stored in the block. + * + * sizeof(x) == blk->maxsize + * Allocation size in memory + * + * isblk(x) + * returns 0 is x is not a BLOCK, 1 if x is an + * unnamed block, 2 if x is a named BLOCK + * + * blkread(x, size, count, fd [, offset]) + * blkwrite(x, size, count, fd [, offset]) + * returns number of items written + * offset is restricted in value by block type + * + * blkset(x, val, length [, offset]) + * only the lower octet of val is used + * offset is restricted in value by block type + * + * blkchr(x, val, length [, offset]) + * only the lower octet of val is used + * offset is restricted in value by block type + * + * blkcpy(dest, src, length [, dest_offset [, src_offset]]) + * 0 <= length <= blksize(x) + * offset's are restricted in value by block type + * dest may not == src + * + * blkmove(dest, src, length [, dest_offset [, src_offset]]) + * 0 <= length <= blksize(x) + * offset's are restricted in value by block type + * overlapping moves are handeled correctly + * + * blkccpy(dest, src, stopval, length [, dest_offset [, src_offset]]) + * 0 <= length <= blksize(x) + * offset's are restricted in value by block type + * + * blkcmp(dest, src, length [, dest_offset [, src_offset]]) + * 0 <= length <= blksize(x) + * offset's are restricted in value by block type + * + * blkswap(x, a, b) + * swaps groups of 'a' octets within each 'b' octets + * b == a is a noop + * b = a*k for some integer k >= 1 + * + * scatter(src, dest1, dest2 [, dest3 ] ...) + * copy sucessive octets from src into dest1, dest2, ... + * restarting with dest1 after end of list + * stops at end of src + * + * gather(dest, src1, src2 [, src3 ] ...) + * copy first octet from src1, src2, ... + * copy next octet from src1, src2, ... + * ... + * copy last octet from src1, src2, ... + * copy 0 when there is no more data from a given source + * + * blkseek(x, offset, {"in","out"}) + * some seeks may not be allowed by block type + * + * config("blkmaxprint", count) + * number of octets of a block to print, 0 means all + * + * config("blkverbose", boolean) + * TRUE => print all lines, FALSE => skip dup lines + * + * config("blkbase", "base") + * output block base = { "hex", "octal", "char", "binary", "raw" } + * binary is base 2, raw is just octet values + * + * config("blkfmt", "style") + * style of output = { + * "line", lines in blkbase with no spaces between octets + * "string", as one long line with no spaces between octets + * "od_style", position, spaces between octets + * "hd_style"} position, spaces between octets, chars on end + */ +struct block { + LEN blkchunk; /* allocation chunk size */ + LEN maxsize; /* octets actually malloced for this block */ + LEN datalen; /* octets of data held this block */ + USB8 *data; /* pointer to the 1st octet of the allocated data */ +}; +typedef struct block BLOCK; + + +struct nblock { + char *name; + int subtype; + int id; + BLOCK *blk; +}; +typedef struct nblock NBLOCK; + + +/* + * block debug + */ +extern int blk_debug; /* 0 => debug off */ + + +/* + * block defaults + */ +#define BLK_CHUNKSIZE 256 /* default allocation chunk size for blocks */ + +#define BLK_DEF_MAXPRINT 256 /* default octets to print */ + +#define BLK_BASE_HEX 0 /* output octets in a block in hex */ +#define BLK_BASE_OCT 1 /* output octets in a block in octal */ +#define BLK_BASE_CHAR 2 /* output octets in a block in characters */ +#define BLK_BASE_BINARY 3 /* output octets in a block in base 2 chars */ +#define BLK_BASE_RAW 4 /* output octets in a block in raw binary */ + +#define BLK_FMT_HD_STYLE 0 /* output in base with chars on end of line */ +#define BLK_FMT_LINE 1 /* output is lines of up to 79 chars */ +#define BLK_FMT_STRING 2 /* output is one long string */ +#define BLK_FMT_OD_STYLE 3 /* output in base with chars */ + + +/* + * block macros + */ +/* length of data stored in a block */ +#define blklen(blk) ((blk)->datalen) + +/* block footpint in memory */ +#define blksizeof(blk) ((blk)->maxsize) + +/* block allocation chunk size */ +#define blkchunk(blk) ((blk)->blkchunk) + + +/* + * OCTET - what the INDEXADDR produces from a blk[offset] + */ +typedef USB8 OCTET; + + +/* + * external functions + */ +extern BLOCK *blkalloc(int, int); +extern void blk_free(BLOCK*); +extern BLOCK *blkrealloc(BLOCK*, int, int); +extern void blktrunc(BLOCK*); +extern BLOCK *blk_copy(BLOCK*); +extern int blk_cmp(BLOCK*, BLOCK*); +extern void blk_print(BLOCK*); +extern void nblock_print(NBLOCK *); +extern NBLOCK *createnblock(char *, int, int); +extern NBLOCK *reallocnblock(int, int, int); +extern int removenblock(int); +extern int findnblockid(char *); +extern NBLOCK *findnblock(int); +extern BLOCK *copyrealloc(BLOCK*, int, int); +extern int countnblocks(void); +extern void shownblocks(void); + + +#endif /* !__BLOCK_H__ */ diff --git a/byteswap.c b/byteswap.c index e55ce70..25888fb 100644 --- a/byteswap.c +++ b/byteswap.c @@ -39,6 +39,7 @@ HALF * swap_b8_in_HALFs(HALF *dest, HALF *src, LEN len) { + HALF *ret; LEN i; /* @@ -47,6 +48,7 @@ swap_b8_in_HALFs(HALF *dest, HALF *src, LEN len) if (dest == NULL) { dest = alloc(len); } + ret = dest; /* * swap the array @@ -58,7 +60,7 @@ swap_b8_in_HALFs(HALF *dest, HALF *src, LEN len) /* * return the result */ - return dest; + return ret; } @@ -272,6 +274,7 @@ swap_b8_in_COMPLEX(COMPLEX *dest, COMPLEX *src, BOOL all) HALF * swap_b16_in_HALFs(HALF *dest, HALF *src, LEN len) { + HALF *ret; LEN i; /* @@ -280,6 +283,7 @@ swap_b16_in_HALFs(HALF *dest, HALF *src, LEN len) if (dest == NULL) { dest = alloc(len); } + ret = dest; /* * swap the array @@ -291,7 +295,7 @@ swap_b16_in_HALFs(HALF *dest, HALF *src, LEN len) /* * return the result */ - return dest; + return ret; } diff --git a/byteswap.h b/byteswap.h index fd31a83..dd52d79 100644 --- a/byteswap.h +++ b/byteswap.h @@ -1,5 +1,5 @@ /* - * 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, @@ -20,8 +20,10 @@ * PERFORMANCE OF THIS SOFTWARE. */ -#if !defined(BYTESWAP_H) -#define BYTESWAP_H + +#if !defined(__BYTESWAP_H__) +#define __BYTESWAP_H__ + #include "longbits.h" @@ -163,4 +165,5 @@ #endif /* LONG_BITS == 64 */ -#endif /* !BYTESWAP_H */ + +#endif /* !__BYTESWAP_H__ */ diff --git a/calc.c b/calc.c index 00257fe..7357886 100644 --- a/calc.c +++ b/calc.c @@ -1,14 +1,17 @@ /* - * 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. * * Arbitrary precision calculator. */ +#include #include #include #include +#include +#include #define CALC_C #include "calc.h" @@ -19,6 +22,10 @@ #include "token.h" #include "symbol.h" #include "have_uid_t.h" +#include "have_const.h" +#include "custom.h" +#include "math_error.h" +#include "args.h" #include "have_unistd.h" #if defined(HAVE_UNISTD_H) @@ -30,69 +37,32 @@ #include #endif -/* - * in case we do not have certain .h files - */ -#if !defined(HAVE_STDLIB_H) && !defined(HAVE_UNISTD_H) -#if !defined(HAVE_UID_T) && !defined(_UID_T) -typedef unsigned short uid_t; -#endif -extern char *getenv(); -extern uid_t geteuid(); -#endif /* - * Common definitions + * external and static definitions */ -int abortlevel; /* current level of aborts */ -BOOL inputwait; /* TRUE if in a terminal input wait */ -jmp_buf jmpbuf; /* for errors */ -int start_done = FALSE; /* TRUE => start up processing finished */ - +extern int abortlevel; /* current level of aborts */ +extern BOOL inputwait; /* TRUE if in a terminal input wait */ +extern jmp_buf jmpbuf; /* for errors */ extern int isatty(int tty); /* TRUE if fd is a tty */ -static int p_flag = FALSE; /* TRUE => pipe mode */ -static int q_flag = FALSE; /* TRUE => don't execute rc files */ -static int u_flag = FALSE; /* TRUE => unbuffer stdin and stdout */ +extern int p_flag; /* TRUE => pipe mode */ +extern int q_flag; /* TRUE => don't execute rc files */ +extern int u_flag; /* TRUE => unbuffer stdin and stdout */ + +extern char *pager; /* $PAGER or default */ +extern int stdin_tty; /* TRUE if stdin is a tty */ +extern char *program; /* our name */ +extern char cmdbuf[]; /* command line expression */ + +extern char *version(void); /* return version string */ + /* - * global permissions + * forward static functions */ -int allow_read = TRUE; /* FALSE => may not open any files for reading */ -int allow_write = TRUE; /* FALSE => may not open any files for writing */ -int allow_exec = TRUE; /* FALSE => may not execute any commands */ - -char *calcpath; /* $CALCPATH or default */ -char *calcrc; /* $CALCRC or default */ -char *calcbindings; /* $CALCBINDINGS or default */ -char *home; /* $HOME or default */ -static char *pager; /* $PAGER or default */ -char *shell; /* $SHELL or default */ -int stdin_tty = TRUE; /* TRUE if stdin is a tty */ -int post_init = FALSE; /* TRUE setjmp for math_error is readready */ - -/* - * some help topics are symbols, so we alias them to nice filenames - */ -static struct help_alias { - char *topic; - char *filename; -} halias[] = { - {"=", "assign"}, - {"%", "mod"}, - {"//", "quo"}, - {NULL, NULL} -}; - -NUMBER *epsilon_default; /* default allowed error for float calcs */ - static void intint(int arg); /* interrupt routine */ -static void initenv(void); /* initialize environment vars */ -extern void file_init(void); -extern void zio_init(void); - -char cmdbuf[MAXCMD+1]; /* command line expression */ /* * Top level calculator routine. @@ -108,13 +78,34 @@ main(int argc, char **argv) /* * parse args */ + program = argv[0]; argc--; argv++; while ((argc > 0) && (**argv == '-')) { for (str = &argv[0][1]; *str; str++) switch (*str) { + case 'C': +#if defined(CUSTOM) + allow_custom = TRUE; + break; +#else + fprintf(stderr, + "Calc was built with custom functions " + "disabled, -C usage is disallowed\n"); + /* + * we are too early in processing to call + * libcalc_call_me_last() - nothing to cleanup + */ + exit(1); +#endif /* CUSTOM */ + case 'e': + no_env = TRUE; + break; case 'h': want_defhelp = 1; break; + case 'i': + ign_errmax = TRUE; + break; case 'm': if (argv[0][2]) { p = &argv[0][2]; @@ -124,16 +115,29 @@ main(int argc, char **argv) argv++; } else { fprintf(stderr, "-m requires an arg\n"); + /* + * we are too early in processing to + * call libcalc_call_me_last() + * nothing to cleanup + */ exit(1); } if (p[1] != '\0' || *p < '0' || *p > '7') { fprintf(stderr, "unknown -m arg\n"); + /* + * we are too early in processing to + * call libcalc_call_me_last() + * nothing to cleanup + */ exit(1); } allow_read = (((*p-'0') & 04) > 0); allow_write = (((*p-'0') & 02) > 0); allow_exec = (((*p-'0') & 01) > 0); break; + case 'n': + new_std = TRUE; + break; case 'p': p_flag = TRUE; break; @@ -144,21 +148,37 @@ main(int argc, char **argv) u_flag = TRUE; break; case 'v': - version(stdout); + printf("%s (version %s)\n", + CALC_TITLE, version()); + /* + * we are too early in processing to call + * libcalc_call_me_last() - nothing to cleanup + */ exit(0); default: - fprintf(stderr, "Unknown option\n"); + fprintf(stderr, + "usage: %s [-C] [-e] [-h] [-i] [-m mode] [-n] [-p]\n", + program); + fprintf(stderr, "\t[-q] [-u] [calc_cmd ...]\n"); + /* + * we are too early in processing to call + * libcalc_call_me_last() - nothing to cleanup + */ exit(1); } argc--; argv++; } + cmdbuf[0] = '\0'; str = cmdbuf; - *str = '\0'; while (--argc >= 0) { i = (long)strlen(*argv); - if (str+1+i+2 >= cmdbuf+MAXCMD) { + if (i+3 >= MAXCMD) { fprintf(stderr, "command in arg list too long\n"); + /* + * we are too early in processing to call + * libcalc_call_me_last() - nothing to cleanup + */ exit(1); } *str++ = ' '; @@ -181,12 +201,11 @@ main(int argc, char **argv) * initialize */ libcalc_call_me_first(); - hash_init(); - file_init(); - initenv(); - resetinput(); + stdin_tty = TRUE; /* assume internactive default */ + conf->tab_ok = TRUE; /* assume internactive default */ if (want_defhelp) { givehelp(DEFAULTCALCHELP); + libcalc_call_me_last(); exit(0); } @@ -197,10 +216,7 @@ main(int argc, char **argv) /* * check for pipe mode and/or non-tty stdin */ - if (p_flag) { - stdin_tty = FALSE; /* stdin not a tty in pipe mode */ - conf->tab_ok = FALSE; /* config("tab",0) if pipe mode */ - } else { + if (!p_flag) { stdin_tty = isatty(0); /* assume stdin is on fd 0 */ } @@ -213,11 +229,9 @@ main(int argc, char **argv) * if tty, setup bindings */ if (stdin_tty) { - version(stdout); + printf("%s (version %s)\n", CALC_TITLE, version()); printf("[%s]\n\n", "Type \"exit\" to exit, or \"help\" for help."); - } - if (stdin_tty) { switch (hist_init(calcbindings)) { case HIST_NOFILE: fprintf(stderr, @@ -232,13 +246,6 @@ main(int argc, char **argv) break; } } - } else { - - /* - * process args, not stdin - */ - stdin_tty = FALSE; /* stdin not a tty in arg mode */ - conf->tab_ok = FALSE; /* config("tab",0) if pipe mode */ } /* @@ -249,17 +256,12 @@ main(int argc, char **argv) /* * reset/initialize the computing environment */ - post_init = TRUE; /* jmpbuf is ready for math_error() */ - inittokens(); - initglobals(); - initfunctions(); - initstack(); - resetinput(); - math_cleardiversions(); - math_setfp(stdout); - math_setmode(MODE_INITIAL); - math_setdigits((long)DISPLAY_DEFAULT); - conf->maxprint = MAXPRINT_DEFAULT; + if (post_init) { + initialize(); + } else { + /* initialize already done, jmpbuf is ready */ + post_init = TRUE; + } /* * if arg mode or non-tty mode, just do the work and be gone @@ -275,149 +277,35 @@ main(int argc, char **argv) (void) openterminal(); start_done = TRUE; getcommands(FALSE); + libcalc_call_me_last(); exit(0); } } - start_done = TRUE; - - /* - * if in arg mode, we should not get here - */ - if (str) + /* if in arg mode, we should not get here */ + if (str) { + libcalc_call_me_last(); exit(1); + } /* - * process commands (from stdin, not the command line) + * process commands */ - abortlevel = 0; - _math_abort_ = FALSE; - inputwait = FALSE; - (void) signal(SIGINT, intint); - math_cleardiversions(); - math_setfp(stdout); - resetscopes(); - resetinput(); - if (q_flag == FALSE && allow_read) { - q_flag = TRUE; - runrcfiles(); + if (!start_done) { + reinitialize(); } - (void) openterminal(); + (void) signal(SIGINT, intint); + start_done = TRUE; getcommands(TRUE); /* * all done */ + libcalc_call_me_last(); exit(0); /*NOTREACHED*/ } -/* - * initenv - obtain $CALCPATH, $CALCRC, $CALCBINDINGS, $HOME, $PAGER - * and $SHELL values - * - * If $CALCPATH, $CALCRC, $CALCBINDINGS, $PAGER or $SHELL do not exist, - * use the default values. If $PAGER or $SHELL is an empty string, also - * use a default value. If $HOME does not exist, or is empty, use the home - * directory information from the password file. - */ -static void -initenv(void) -{ - struct passwd *ent; /* our password entry */ - - /* determine the $CALCPATH value */ - calcpath = getenv(CALCPATH); - if (calcpath == NULL) - calcpath = DEFAULTCALCPATH; - - /* determine the $CALCRC value */ - calcrc = getenv(CALCRC); - if (calcrc == NULL) { - calcrc = DEFAULTCALCRC; - } - - /* determine the $CALCBINDINGS value */ - calcbindings = getenv(CALCBINDINGS); - if (calcbindings == NULL) { - calcbindings = DEFAULTCALCBINDINGS; - } - - /* determine the $HOME value */ - home = getenv(HOME); - if (home == NULL || home[0] == '\0') { - ent = (struct passwd *)getpwuid(geteuid()); - if (ent == NULL) { - /* just assume . is home if all else fails */ - home = "."; - } - home = (char *)malloc(strlen(ent->pw_dir)+1); - strcpy(home, ent->pw_dir); - } - - /* determine the $PAGER value */ - pager = getenv(PAGER); - if (pager == NULL || *pager == '\0') { - pager = DEFAULTCALCPAGER; - } - - /* determine the $SHELL value */ - shell = getenv(SHELL); - if (shell == NULL) - shell = DEFAULTSHELL; -} - - -/* - * givehelp - display a help file - * - * given: - * type the type of help to give, NULL => index - */ -void -givehelp(char *type) -{ - struct help_alias *p; /* help alias being considered */ - char *helpcmd; /* what to execute to print help */ - - /* - * check permissions to see if we are allowed to help - */ - if (!allow_exec || !allow_read) { - fprintf(stderr, - "sorry, help is only allowed with -m mode 5 or 7\n"); - return; - } - - /* catch the case where we just print the index */ - if (type == NULL) { - type = DEFAULTCALCHELP; /* the help index file */ - } - - /* alias the type of help, if needed */ - for (p=halias; p->topic; ++p) { - if (strcmp(type, p->topic) == 0) { - type = p->filename; - break; - } - } - - /* form the help command name */ - helpcmd = (char *)malloc( - sizeof("if [ ! -d \"")+sizeof(HELPDIR)+1+strlen(type)+ - sizeof("\" ];then ")+ - strlen(pager)+1+1+sizeof(HELPDIR)+1+strlen(type)+1+1+ - sizeof(";else echo no such help;fi")); - sprintf(helpcmd, - "if [ -r \"%s/%s\" ];then %s \"%s/%s\";else echo no such help;fi", - HELPDIR, type, pager, HELPDIR, type); - - /* execute the help command */ - system(helpcmd); - free(helpcmd); -} - - /* * Interrupt routine. * @@ -438,4 +326,34 @@ intint(int arg) printf("\n[Abort level %d]\n", abortlevel); } -/* END CODE */ + +/* + * Routine called on any runtime error, to complain about it (with possible + * arguments), and then longjump back to the top level command scanner. + */ +void +math_error(char *fmt, ...) +{ + va_list ap; + char buf[MAXERROR+1]; + + if (funcname && (*funcname != '*')) + fprintf(stderr, "\"%s\": ", funcname); + if (funcline && ((funcname && (*funcname != '*')) || !inputisterminal())) + fprintf(stderr, "line %ld: ", funcline); + va_start(ap, fmt); + vsprintf(buf, fmt, ap); + va_end(ap); + fprintf(stderr, "%s\n", buf); + funcname = NULL; + if (post_init) { + longjmp(jmpbuf, 1); + } else { + fprintf(stderr, "no jmpbuf jumpback point - ABORTING!!!\n"); + /* + * don't call libcalc_call_me_last() -- we might loop + * and besides ... this is an unusual internal error case + */ + exit(3); + } +} diff --git a/calc.h b/calc.h index e0e7f23..d7a6ce4 100644 --- a/calc.h +++ b/calc.h @@ -1,17 +1,16 @@ /* - * 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. * * Definitions for calculator program. */ -#ifndef CALC_H -#define CALC_H + +#if !defined(__CALC_H__) +#define __CALC_H__ -#include -#include #include "value.h" @@ -94,20 +93,23 @@ extern int flushall(void); extern int idfputstr(FILEID id, char *str); extern int rewindid(FILEID id); extern void rewindall(void); -extern long filesize(FILEID id); +extern ZVALUE zfilesize(FILEID id); extern void showfiles(void); extern int fscanfid(FILEID id, char *fmt, int count, VALUE **vals); extern int scanfstr(char *str, char *fmt, int count, VALUE **vals); -extern long ftellid(FILEID id); -extern long fseekid(FILEID id, long offset, int whence); +extern int ftellid(FILEID id, ZVALUE *res); +extern int fseekid(FILEID id, ZVALUE offset, int whence); extern int isattyid(FILEID id); -long fsearch(FILEID id, char *str, long pos); -long frsearch(FILEID id, char *str, long pos); +extern int fsearch(FILEID id, char *str, ZVALUE start, ZVALUE end, ZVALUE *res); +extern int frsearch(FILEID id, char *str, ZVALUE first, ZVALUE last, ZVALUE *res); +extern void showconstants(void); +extern void freeconstant(unsigned long); +extern void freestringconstant(long); +extern void trimconstants(void); /* * Input routines. */ -extern FILE *f_open(char *name, char *mode); extern int openstring(char *str); extern int openterminal(void); extern int opensearchfile(char *name, char *pathlist, char *exten, int reopen_ok); @@ -121,7 +123,6 @@ extern char *inputname(void); extern long linenumber(void); extern void runrcfiles(void); extern void closeinput(void); -extern FILE *curstream(void); /* @@ -131,11 +132,18 @@ extern NUMBER *constvalue(unsigned long index); extern long addnumber(char *str); extern long addqconstant(NUMBER *q); extern void initstack(void); -extern void version(FILE *stream); extern void getcommands(BOOL toplevel); extern void givehelp(char *type); -extern void hash_init(void); extern void libcalc_call_me_first(void); +extern void libcalc_call_me_last(void); +extern void showerrors(void); + + +/* + * Initialization + */ +extern void initialize(void); +extern void reinitialize(void); /* @@ -144,7 +152,6 @@ extern void libcalc_call_me_first(void); extern int abortlevel; /* current level of aborts */ extern BOOL inputwait; /* TRUE if in a terminal input wait */ extern VALUE *stack; /* execution stack */ -extern jmp_buf jmpbuf; /* for errors */ extern int start_done; /* TRUE => start up processing finished */ extern int dumpnames; /* TRUE => dump names rather than indices */ @@ -153,6 +160,11 @@ extern char *calcrc; /* $CALCRC or default */ extern char *calcbindings; /* $CALCBINDINGS or default */ extern char *home; /* $HOME or default */ extern char *shell; /* $SHELL or default */ +extern char *program; /* our name (argv[0]) */ + +extern int no_env; /* TRUE (-e) => ignore env vars on startup */ +extern int ign_errmax; /* TRUE (-i) => ignore when errcount exceeds errmax */ +extern int new_std; /* TRUE (-n) => use newstd configuration */ extern int allow_read; /* FALSE => may not open any files for reading */ extern int allow_write; /* FALSE => may not open any files for writing */ @@ -160,6 +172,16 @@ extern int allow_exec; /* FALSE => may not execute any commands */ extern int post_init; /* TRUE => setjmp for math_error is ready */ -#endif -/* END CODE */ +/* + * calc version information + */ +#define CALC_TITLE "C-style arbitrary precision calculator" +extern int calc_major_ver; +extern int calc_minor_ver; +extern int calc_major_patch; +extern char *calc_minor_patch; +extern char *version(void); /* return version string */ + + +#endif /* !__CALC_H__ */ diff --git a/calc.man b/calc.man index d1a1ebe..ae534d1 100644 --- a/calc.man +++ b/calc.man @@ -317,7 +317,7 @@ A :-separated list of directories used to search for scripts filenames that do not begin with /, ./ or ~. .br .sp -Default value: .:./lib:~/lib:${LIBDIR} +Default value: ${CALCPATH} .br .sp .TP 5 @@ -327,7 +327,7 @@ line), calc searches for files along this :-separated environment variable. .br .sp -Default value: ${LIBDIR}/startup:~/.calcrc +Default value: ${CALCRC} .br .sp .TP 5 @@ -338,7 +338,7 @@ key bindings from the filename specified by this environment variable. .br .sp -Default value: ${LIBDIR}/bindings +Default value: ${CALCBINDINGS} .sp .SH CREDIT \& diff --git a/calcerr.tbl b/calcerr.tbl index b6782b8..63b2a47 100644 --- a/calcerr.tbl +++ b/calcerr.tbl @@ -120,16 +120,22 @@ E_UNGETC1 Non-file argument for ungetc E_UNGETC2 File not open for reading for ungetc E_UNGETC3 Bad second argument or other error for ungetc E_BIGEXP Exponent too big in scanning -E_ISATTY1 Non-file argument for isatty -E_ISATTY2 File not open for isatty +E_ISATTY1 E_ISATTY1 is no longer used +E_ISATTY2 E_ISATTY2 is no longer used E_ACCESS1 Non-string first argument for access E_ACCESS2 Bad second argument for access E_SEARCH1 Bad first argument for search E_SEARCH2 Bad second argument for search E_SEARCH3 Bad third argument for search +E_SEARCH4 Bad fourth argument for search +E_SEARCH5 Cannot find fsize or fpos for search +E_SEARCH6 File not readable for search E_RSEARCH1 Bad first argument for rsearch E_RSEARCH2 Bad second argument for rsearch E_RSEARCH3 Bad third argument for rsearch +E_RSEARCH4 Bad fourth argument for rsearch +E_RSEARCH5 Cannot find fsize or fpos for rsearch +E_RSEARCH6 File not readable for rsearch E_FOPEN3 Too many open files E_REWIND2 Attempt to rewind a file that is not open E_STRERROR1 Bad argument type for strerror @@ -148,7 +154,7 @@ E_MATFILL1 Non-variable first argument for matfill E_MATFILL2 Non-matrix first argument-value for matfill E_MATDIM Non-matrix argument for matdim E_MATSUM Non-matrix argument for matsum -E_ISIDENT Non-matrix argument for isident +E_ISIDENT E_ISIDENT is no longer used E_MATTRANS1 Non-matrix argument for mattrans E_MATTRANS2 Non-two-dimensional matrix for mattrans E_DET1 Non-matrix argument for det @@ -191,3 +197,142 @@ E_RM2 Unable to remove a file E_RDPERM Operation allowed because calc mode disallows read operations E_WRPERM Operation allowed because calc mode disallows write operations E_EXPERM Operation allowed because calc mode disallows exec operations +E_MIN Unordered arguments for min +E_MAX Unordered arguments for max +E_LISTMIN Unordered items for minimum of list +E_LISTMAX Unordered items for maximum of list +E_SIZE Size undefined for argument type +E_NO_C_ARG Calc must be run with a -C argument to use custom function +E_NO_CUSTOM Calc was built with custom functions disabled +E_UNK_CUSTOM Custom function unknown, try: show custom +E_BLK1 Non-integral length for block +E_BLK2 Negative or too-large length for block +E_BLK3 Non-integral chunksize for block +E_BLK4 Negative or too-large chunksize for block +E_BLKFREE1 Named block does not exist for blkfree +E_BLKFREE2 Non-integral id specification for blkfree +E_BLKFREE3 Block with specified id does not exist +E_BLKFREE4 Block already freed +E_BLKFREE5 No-realloc protection prevents blkfree +E_BLOCKS1 Non-integer argument for blocks +E_BLOCKS2 Non-allocated index number for blocks +E_COPY1 Non-integer or negative source index for copy +E_COPY2 Source index too large for copy +E_COPY3 E_COPY3 is no longer used +E_COPY4 Non-integer or negative number for copy +E_COPY5 Number too large for copy +E_COPY6 Non-integer or negative destination index for copy +E_COPY7 Destination index too large for copy +E_COPY8 Freed block source for copy +E_COPY9 Unsuitable source type for copy +E_COPY10 Freed block destinction for copy +E_COPY11 Unsuitable destination type for copy +E_COPY12 Incompatible source and destination for copy +E_COPY13 No-copy-from source variable +E_COPY14 No-copy-to destination variable +E_COPY15 No-copy-from source named block +E_COPY16 No-copy-to destination named block +E_COPY17 No-relocation destination for copy +E_COPYF1 File not open for copy +E_COPYF2 fseek or fsize failure for copy +E_COPYF3 fwrite error for copy +E_COPYF4 fread error for copy +E_PROTECT1 Non-variable first argument for protect +E_PROTECT2 Non-integer second argument for protect +E_PROTECT3 Out-of-range second argument for protect +E_MATFILL3 No-copy-to destination for matfill +E_MATFILL4 No-assign-from source for matfill +E_MATTRACE1 Non-matrix argument for mattrace +E_MATTRACE2 Non-two-dimensional argument for mattrace +E_MATTRACE3 Non-square argument for mattrace +E_TAN1 Bad epsilon for tan +E_TAN2 Bad argument for tan +E_COT1 Bad epsilon for cot +E_COT2 Bad argument for cot +E_SEC1 Bad epsilon for sec +E_SEC2 Bad argument for sec +E_CSC1 Bad epsilon for csc +E_CSC2 Bad argument for csc +E_SINH1 Bad epsilon for sinh +E_SINH2 Bad argument for sinh +E_COSH1 Bad epsilon for cosh +E_COSH2 Bad argument for cosh +E_TANH1 Bad epsilon for tanh +E_TANH2 Bad argument for tanh +E_COTH1 Bad epsilon for coth +E_COTH2 Bad argument for coth +E_SECH1 Bad epsilon for sech +E_SECH2 Bad argument for sech +E_CSCH1 Bad epsilon for csch +E_CSCH2 Bad argument for csch +E_ASIN1 Bad epsilon for asin +E_ASIN2 Bad argument for asin +E_ACOS1 Bad epsilon for acos +E_ACOS2 Bad argument for acos +E_ATAN1 Bad epsilon for atan +E_ATAN2 Bad argument for atan +E_ACOT1 Bad epsilon for acot +E_ACOT2 Bad argument for acot +E_ASEC1 Bad epsilon for asec +E_ASEC2 Bad argument for asec +E_ACSC1 Bad epsilon for acsc +E_ACSC2 Bad argument for acsc +E_ASINH1 Bad epsilon for asin +E_ASINH2 Bad argument for asinh +E_ACOSH1 Bad epsilon for acosh +E_ACOSH2 Bad argument for acosh +E_ATANH1 Bad epsilon for atanh +E_ATANH2 Bad argument for atanh +E_ACOTH1 Bad epsilon for acoth +E_ACOTH2 Bad argument for acoth +E_ASECH1 Bad epsilon for asech +E_ASECH2 Bad argument for asech +E_ACSCH1 Bad epsilon for acsch +E_ACSCH2 Bad argument for acsch +E_GD1 Bad epsilon for gd +E_GD2 Bad argument for gd +E_AGD1 Bad epsilon for agd +E_AGD2 Bad argument for agd +E_LOGINF Log of zero or infinity +E_STRADD String addition failure +E_STRMUL String multiplication failure +E_STRNEG String reversal failure +E_STRSUB String subtraction failure +E_BIT1 Bad argument type for bit +E_BIT2 Index too large for bit +E_SETBIT1 Non-integer second argument for setbit +E_SETBIT2 Out-of-range index for setbit +E_SETBIT3 Non-string first argument for setbit +E_OR Bad argument for or +E_AND Bad argument for and +E_STROR Allocation failure for string or +E_STRAND Allocation failure for string and +E_XOR Bad argument for xorvalue +E_COMP Bad argument for comp +E_STRDIFF Allocation failure for string diff +E_STRCOMP Allocation failure for string comp +E_SEG1 Bad first argument for segment +E_SEG2 Bad second argument for segment +E_SEG3 Bad third argument for segment +E_STRSEG Failure for string segment +E_HIGHBIT1 Bad argument type for highbit +E_HIGHBIT2 Non-integer argument for highbit +E_LOWBIT1 Bad argument type for lowbit +E_LOWBIT2 Non-integer argument for lowbit +E_CONTENT Bad argument type for unary hash op +E_HASHOP Bad argument type for binary hash op +E_HEAD1 Bad first argument for head +E_HEAD2 Bad second argument for head +E_STRHEAD Failure for strhead +E_TAIL1 Bad first argument for tail +E_TAIL2 Bad second argument for tail +E_STRTAIL Failure for strtail +E_STRSHIFT Failure for strshift +E_STRCMP Non-string argument for strcmp +E_STRNCMP Bad argument type for strncmp +E_XOR1 Varying types of argument for xor +E_XOR2 Bad argument type for xor +E_STRCPY Bad argument type for strcpy +E_STRNCPY Bad argument type for strncpy +E_BACKSLASH Bad argument type for unary backslash +E_SETMINUS Bad argument type for setminus diff --git a/check.awk b/check.awk index b321d16..3b0ba9e 100644 --- a/check.awk +++ b/check.awk @@ -29,7 +29,7 @@ NF == 0 { next; } -$1 ~ /^[0-9]/ { +$1 ~ /^[0-9]+:/ { if (error > 0) { if (havebuf2) { print buf2; @@ -71,4 +71,5 @@ END { if (error > 0 && havebuf0) { print buf0; } + exit (error > 0); } diff --git a/cmath.h b/cmath.h index 076e3d8..f4ffebe 100644 --- a/cmath.h +++ b/cmath.h @@ -1,13 +1,15 @@ /* - * Copyright (c) 1993 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. * * Data structure declarations for extended precision complex arithmetic. */ -#ifndef CMATH_H -#define CMATH_H + +#if !defined(__CMATH_H__) +#define __CMATH_H__ + #include "qmath.h" @@ -73,8 +75,25 @@ extern COMPLEX *cexp(COMPLEX *c, NUMBER *epsilon); extern COMPLEX *cln(COMPLEX *c, NUMBER *epsilon); extern COMPLEX *ccos(COMPLEX *c, NUMBER *epsilon); extern COMPLEX *csin(COMPLEX *c, NUMBER *epsilon); +extern COMPLEX *ccosh(COMPLEX *c, NUMBER *epsilon); +extern COMPLEX *csinh(COMPLEX *c, NUMBER *epsilon); extern COMPLEX *cpolar(NUMBER *q1, NUMBER *q2, NUMBER *epsilon); extern COMPLEX *crel(COMPLEX *c1, COMPLEX *c2); +extern COMPLEX *casin(COMPLEX *c, NUMBER *epsilon); +extern COMPLEX *cacos(COMPLEX *c, NUMBER *epsilon); +extern COMPLEX *catan(COMPLEX *c, NUMBER *epsilon); +extern COMPLEX *cacot(COMPLEX *c, NUMBER *epsilon); +extern COMPLEX *casec(COMPLEX *c, NUMBER *epsilon); +extern COMPLEX *cacsc(COMPLEX *c, NUMBER *epsilon); +extern COMPLEX *casinh(COMPLEX *c, NUMBER *epsilon); +extern COMPLEX *cacosh(COMPLEX *c, NUMBER *epsilon); +extern COMPLEX *catanh(COMPLEX *c, NUMBER *epsilon); +extern COMPLEX *cacoth(COMPLEX *c, NUMBER *epsilon); +extern COMPLEX *casech(COMPLEX *c, NUMBER *epsilon); +extern COMPLEX *cacsch(COMPLEX *c, NUMBER *epsilon); +extern COMPLEX *cgd(COMPLEX *c, NUMBER *epsilon); +extern COMPLEX *cagd(COMPLEX *c, NUMBER *epsilon); + /* @@ -108,6 +127,5 @@ extern COMPLEX *swap_HALF_in_COMPLEX(COMPLEX *dest, COMPLEX *src, BOOL all); */ extern COMPLEX _czero_, _cone_, _conei_; -#endif -/* END CODE */ +#endif /* !__CMATH_H__ */ diff --git a/codegen.c b/codegen.c index e6da9eb..cd6e9a2 100644 --- a/codegen.c +++ b/codegen.c @@ -1,11 +1,12 @@ /* - * Copyright (c) 1996 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. * * Module to generate opcodes from the input tokens. */ +#include #include "have_unistd.h" #if defined(HAVE_UNISTD_H) #include @@ -28,9 +29,12 @@ static BOOL getfilename(char *name, BOOL msg_ok, BOOL *once); static BOOL getid(char *buf); static void getshowstatement(void); static void getfunction(void); +static void ungetfunction(void); static void getbody(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *defaultlabel, BOOL toplevel); -static void getdeclarations(void); +static void getdeclarations(int symtype); +static void getsimpledeclaration (int symtype); +static int getonevariable (int symtype); static void getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *defaultlabel); static void getobjdeclaration(int symtype); @@ -40,7 +44,6 @@ static void getmatdeclaration(int symtype); static void getonematrix(int symtype); static void creatematrix(void); static void getsimplebody(void); -static void getonedeclaration(int type); static void getcondition(void); static void getmatargs(void); static void getelement(void); @@ -49,6 +52,7 @@ static void definesymbol(char *name, int symtype); static void getcallargs(char *name); static void do_changedir(void); static int getexprlist(void); +static int getopassignment(void); static int getassignment(void); static int getaltcond(void); static int getorcond(void); @@ -59,6 +63,8 @@ static int getproduct(void); static int getorexpr(void); static int getandexpr(void); static int getshiftexpr(void); +static int getreference(void); +static int getincdecexpr(void); static int getterm(void); static int getidexpr(BOOL okmat, BOOL autodef); static long getinitlist(void); @@ -87,6 +93,10 @@ getcommands(BOOL toplevel) getfunction(); break; + case T_UNDEFINE: + ungetfunction(); + break; + case T_EOF: if (!toplevel) exitfilescope(); @@ -147,6 +157,7 @@ getcommands(BOOL toplevel) initstack(); if (evaluate(FALSE)) updateoldvalue(curfunc); + freefunc(curfunc); } } } @@ -169,12 +180,10 @@ BOOL evaluate(BOOL nestflag) { char *funcname; - BOOL gotstatement; int loop = 1; /* 0 => end the main while loop */ funcname = (nestflag ? "**" : "*"); beginfunc(funcname, nestflag); - gotstatement = FALSE; if (nestflag) (void) tokenmode(TM_DEFAULT); while (loop) { @@ -187,22 +196,10 @@ evaluate(BOOL nestflag) loop = 0; break; - case T_GLOBAL: - case T_LOCAL: - case T_STATIC: - if (gotstatement) { - scanerror(T_SEMICOLON, "Declarations must be used before code"); - return FALSE; - } - rescantoken(); - getdeclarations(); - break; - default: rescantoken(); getstatement(NULL_LABEL, NULL_LABEL, NULL_LABEL, NULL_LABEL); - gotstatement = TRUE; } } addop(OP_UNDEF); @@ -214,6 +211,40 @@ evaluate(BOOL nestflag) return TRUE; } +/* + * Undefine one or more functions + */ +static void +ungetfunction(void) +{ + char *name; + int type; + + for (;;) { + switch (gettoken()) { + case T_COMMA: + continue; + case T_SYMBOL: + name = tokensymbol(); + type = getbuiltinfunc(name); + if (type >= 0) { + fprintf(stderr, + "Attempt to undefine builtin function \"%s\" ignored\n", + name); + continue; + } + rmuserfunc(name); + continue; + case T_MULT: + rmalluserfunc(); + continue; + default: + rescantoken(); + return; + } + } +} + /* * Get a function declaration. @@ -228,10 +259,10 @@ getfunction(void) (void) tokenmode(TM_DEFAULT); if (gettoken() != T_SYMBOL) { - scanerror(T_NULL, "Function name expected"); + scanerror(T_NULL, "Function name was expected"); return; } - name = tokenstring(); + name = tokensymbol(); type = getbuiltinfunc(name); if (type >= 0) { scanerror(T_SEMICOLON, "Using builtin function name"); @@ -251,7 +282,7 @@ getfunction(void) scanerror(T_COMMA, "Bad function definition"); return; } - name = tokenstring(); + name = tokensymbol(); switch (symboltype(name)) { case SYM_UNDEFINED: case SYM_GLOBAL: @@ -284,8 +315,6 @@ getfunction(void) "Left brace or equals sign expected for function"); return; } - addop(OP_UNDEF); - addop(OP_RETURN); endfunc(); exitfuncscope(); } @@ -318,10 +347,10 @@ getsimplebody(void) * body = '{' [ declarations ] ... [ statement ] ... '}' * | [ declarations ] ... [statement ] ... '\n' */ +/*ARGSUSED*/ static void getbody(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *defaultlabel, BOOL toplevel) { - BOOL gotstatement; /* TRUE if seen a real statement yet */ int oldmode; if (gettoken() != T_LEFTBRACE) { @@ -329,32 +358,15 @@ getbody(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *defaul return; } oldmode = tokenmode(TM_DEFAULT); - gotstatement = FALSE; while (TRUE) { switch (gettoken()) { case T_RIGHTBRACE: (void) tokenmode(oldmode); return; - case T_GLOBAL: - case T_LOCAL: - case T_STATIC: - if (!toplevel) { - scanerror(T_SEMICOLON, "Declarations must be at the top of the function"); - return; - } - if (gotstatement) { - scanerror(T_SEMICOLON, "Declarations must be used before code"); - return; - } - rescantoken(); - getdeclarations(); - break; - default: rescantoken(); getstatement(contlabel, breaklabel, nextcaselabel, defaultlabel); - gotstatement = TRUE; } } } @@ -366,28 +378,36 @@ getbody(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *defaul * [ ',' onedeclaration ] ... ';'. */ static void -getdeclarations(void) +getdeclarations(int symtype) { - int type; - - type = gettoken(); - - if ((type != T_LOCAL) && (type != T_GLOBAL) && (type != T_STATIC)) { - rescantoken(); - return; - } - while (TRUE) { - getonedeclaration(type); - switch (gettoken()) { case T_COMMA: continue; + case T_NEWLINE: - rescantoken(); case T_SEMICOLON: + case T_RIGHTBRACE: + rescantoken(); return; + case T_SYMBOL: + addopone(OP_DEBUG, linenumber()); + rescantoken(); + getsimpledeclaration(symtype); + break; + + case T_MAT: + addopone(OP_DEBUG, linenumber()); + getmatdeclaration(symtype); + break; + + case T_OBJ: + addopone(OP_DEBUG, linenumber()); + getobjdeclaration(symtype); + addop(OP_POP); + break; + default: scanerror(T_SEMICOLON, "Bad syntax in declaration statement"); return; @@ -397,84 +417,64 @@ getdeclarations(void) /* - * Get a single declaration of a symbol of the specified type. - * onedeclaration = name [ '=' getassignment ] - * | 'obj' type name [ '=' objvalues ] - * | 'mat' name '[' matargs ']' [ '=' matvalues ]. + * Get declaration of a sequence of simple identifiers, as in + * global a, b = 1, c d = 2, d; + * Subsequences end with "," or at end of line; spaces indicate + * repeated assignment, e.g. "c d = 2" has the effect of "c = 2, d = 2". */ static void -getonedeclaration(int type) +getsimpledeclaration(int symtype) { - char *name; /* name of symbol seen */ - int symtype; /* type of symbol */ - int vartype; /* type of variable being defined */ - LABEL label; - switch (type) { - case T_LOCAL: - symtype = SYM_LOCAL; - break; - case T_GLOBAL: - symtype = SYM_GLOBAL; - break; - case T_STATIC: - symtype = SYM_STATIC; - clearlabel(&label); - addoplabel(OP_INITSTATIC, &label); - break; - default: - symtype = SYM_UNDEFINED; - break; + for (;;) { + switch (gettoken()) { + case T_SYMBOL: + rescantoken(); + if (getonevariable(symtype)) + addop(OP_POP); + continue; + case T_COMMA: + continue; + default: + rescantoken(); + return; + } } - - vartype = gettoken(); - switch (vartype) { - case T_SYMBOL: - name = tokenstring(); - definesymbol(name, symtype); - break; - - case T_MAT: - addopone(OP_DEBUG, linenumber()); - getmatdeclaration(symtype); - addop(OP_POP); - if (symtype == SYM_STATIC) - setlabel(&label); - return; - - case T_OBJ: - addopone(OP_DEBUG, linenumber()); - getobjdeclaration(symtype); - addop(OP_POP); - if (symtype == SYM_STATIC) - setlabel(&label); - return; - - default: - scanerror(T_COMMA, "Bad syntax for declaration"); - return; - } - - if (gettoken() != T_ASSIGN) { - rescantoken(); - if (symtype == SYM_STATIC) - setlabel(&label); - return; - } - - /* - * Initialize the variable with the expression. If the variable is - * static, arrange for the initialization to only be done once. - */ - addopone(OP_DEBUG, linenumber()); - usesymbol(name, FALSE); - getassignment(); - addop(OP_ASSIGNPOP); - if (symtype == SYM_STATIC) - setlabel(&label); } +/* + * Get one variable in a sequence of simple identifiers. + * Returns 1 if the subsequence in which the variable occurs ends with + * an assignment, e.g. for the variables b, c, d, in + * static a, b = 1, c d = 2, d; + */ +static int +getonevariable(int symtype) +{ + char *name; + int res = 0; + + switch(gettoken()) { + case T_SYMBOL: + name = addliteral(tokensymbol()); + res = getonevariable(symtype); + definesymbol(name, symtype); + if (res) { + usesymbol(name, FALSE); + addop(OP_ASSIGNBACK); + } + return res; + case T_ASSIGN: + getopassignment(); + rescantoken(); + return 1; + default: + rescantoken(); + return 0; + } +} + /* * Get a statement. * statement = IF condition statement [ELSE statement] @@ -506,9 +506,11 @@ getonedeclaration(int type) static void getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *defaultlabel) { + LABEL label; LABEL label1, label2, label3, label4; /* locations for jumps */ int type; BOOL printeol; + int oldmode; addopone(OP_DEBUG, linenumber()); switch (gettoken()) { @@ -516,6 +518,21 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d case T_SEMICOLON: return; + case T_GLOBAL: + getdeclarations(SYM_GLOBAL); + break; + + case T_STATIC: + clearlabel(&label); + addoplabel(OP_INITSTATIC, &label); + getdeclarations(SYM_STATIC); + setlabel(&label); + break; + + case T_LOCAL: + getdeclarations(SYM_LOCAL); + break; + case T_RIGHTBRACE: scanerror(T_NULL, "Extraneous right brace"); return; @@ -542,7 +559,7 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d return; } addop(OP_JUMP); - addlabel(tokenstring()); + addlabel(tokensymbol()); break; case T_RETURN: @@ -570,20 +587,55 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d clearlabel(&label1); clearlabel(&label2); getcondition(); - addoplabel(OP_JUMPEQ, &label1); - getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL); + switch(gettoken()) { + case T_CONTINUE: + if (contlabel == NULL_LABEL) { + scanerror(T_SEMICOLON, "CONTINUE not within FOR, WHILE, or DO"); + return; + } + addoplabel(OP_JUMPNE, contlabel); + break; + case T_BREAK: + if (breaklabel == NULL_LABEL) { + scanerror(T_SEMICOLON, "BREAK not within FOR, WHILE, or DO"); + return; + } + addoplabel(OP_JUMPNE, breaklabel); + break; + case T_GOTO: + if (gettoken() != T_SYMBOL) { + scanerror(T_SEMICOLON, "Missing label in goto"); + return; + } + addop(OP_JUMPNE); + addlabel(tokensymbol()); + break; + default: + addoplabel(OP_JUMPEQ, &label1); + rescantoken(); + getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL); + if (gettoken() != T_ELSE) { + setlabel(&label1); + rescantoken(); + return; + } + addoplabel(OP_JUMP, &label2); + setlabel(&label1); + getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL); + setlabel(&label2); + return; + } + if (gettoken() != T_SEMICOLON) /* This makes ';' optional */ + rescantoken(); if (gettoken() != T_ELSE) { - setlabel(&label1); rescantoken(); return; } - addoplabel(OP_JUMP, &label2); - setlabel(&label1); getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL); - setlabel(&label2); return; case T_FOR: /* for (a; b; c) x */ + oldmode = tokenmode(TM_DEFAULT); clearlabel(&label1); clearlabel(&label2); clearlabel(&label3); @@ -591,6 +643,7 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d contlabel = NULL_LABEL; breaklabel = &label4; if (gettoken() != T_LEFTPAREN) { + (void) tokenmode(oldmode); scanerror(T_SEMICOLON, "Left parenthesis expected"); return; } @@ -599,6 +652,7 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d (void) getexprlist(); addop(OP_POP); if (gettoken() != T_SEMICOLON) { + (void) tokenmode(oldmode); scanerror(T_SEMICOLON, "Missing semicolon"); return; } @@ -611,6 +665,7 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d addoplabel(OP_JUMPNE, &label3); addoplabel(OP_JUMP, breaklabel); if (gettoken() != T_SEMICOLON) { + (void) tokenmode(oldmode); scanerror(T_SEMICOLON, "Missing semicolon"); return; } @@ -626,6 +681,7 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d if (label1.l_offset > 0) addoplabel(OP_JUMP, &label1); if (gettoken() != T_RIGHTPAREN) { + (void) tokenmode(oldmode); scanerror(T_SEMICOLON, "Right parenthesis expected"); return; } @@ -636,9 +692,11 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL); addoplabel(OP_JUMP, contlabel); setlabel(breaklabel); + (void) tokenmode(oldmode); return; case T_WHILE: + oldmode = tokenmode(TM_DEFAULT); contlabel = &label1; breaklabel = &label2; clearlabel(contlabel); @@ -649,9 +707,11 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL); addoplabel(OP_JUMP, contlabel); setlabel(breaklabel); + (void) tokenmode(oldmode); return; case T_DO: + oldmode = tokenmode(TM_DEFAULT); contlabel = &label1; breaklabel = &label2; clearlabel(contlabel); @@ -660,6 +720,7 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d setlabel(&label3); getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL); if (gettoken() != T_WHILE) { + (void) tokenmode(oldmode); scanerror(T_SEMICOLON, "WHILE keyword expected for DO statement"); return; } @@ -667,9 +728,11 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d getcondition(); addoplabel(OP_JUMPNE, &label3); setlabel(breaklabel); + (void) tokenmode(oldmode); return; case T_SWITCH: + oldmode = tokenmode(TM_DEFAULT); breaklabel = &label1; nextcaselabel = &label2; defaultlabel = &label3; @@ -678,6 +741,7 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d clearlabel(defaultlabel); getcondition(); if (gettoken() != T_LEFTBRACE) { + (void) tokenmode(oldmode); scanerror(T_SEMICOLON, "Missing left brace for switch statement"); return; } @@ -691,6 +755,7 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d else addop(OP_POP); setlabel(breaklabel); + (void) tokenmode(oldmode); return; case T_CASE: @@ -762,12 +827,12 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d break; case T_STRING: printeol = TRUE; - addopptr(OP_PRINTSTRING, tokenstring()); + addopone(OP_PRINTSTRING, tokenstring()); break; default: printeol = TRUE; rescantoken(); - (void) getassignment(); + (void) getopassignment(); addopone(OP_PRINT, (long) PRINT_NORMAL); } } @@ -775,17 +840,22 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d case T_QUIT: switch (gettoken()) { case T_STRING: - addopptr(OP_QUIT, tokenstring()); + addopone(OP_QUIT, tokenstring()); break; default: - addopptr(OP_QUIT, NULL); + addopone(OP_QUIT, -1); rescantoken(); } break; case T_SYMBOL: if (nextchar() == ':') { /****HACK HACK ****/ - definelabel(tokenstring()); + definelabel(tokensymbol()); + if (gettoken() == T_RIGHTBRACE) { + rescantoken(); + return; + } + rescantoken(); getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL); return; @@ -808,17 +878,24 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d addop(OP_PRINTRESULT); break; } - switch (gettoken()) { - case T_RIGHTBRACE: - case T_NEWLINE: - case T_EOF: - rescantoken(); - break; - case T_SEMICOLON: - break; - default: - scanerror(T_SEMICOLON, "Semicolon expected"); - break; + for (;;) { + switch (gettoken()) { + case T_RIGHTBRACE: + case T_NEWLINE: + case T_EOF: + rescantoken(); + return; + case T_SEMICOLON: + return; + case T_NUMBER: + case T_IMAGINARY: + addopone(OP_NUMBER, tokennumber()); + scanerror(T_NULL, "Unexpected number"); + continue; + default: + scanerror(T_NULL, "Semicolon expected"); + return; + } } } @@ -838,15 +915,14 @@ getobjdeclaration(int symtype) int count; /* number of elements */ int index; /* current index */ int i; /* loop counter */ - BOOL err; /* error flag */ int indices[MAXINDICES]; /* indices for elements */ + int oldmode; - err = FALSE; if (gettoken() != T_SYMBOL) { scanerror(T_SEMICOLON, "Object type name missing"); return; } - name = addliteral(tokenstring()); + name = addliteral(tokensymbol()); if (gettoken() != T_LEFTBRACE) { rescantoken(); getobjvars(name, symtype); @@ -856,34 +932,43 @@ getobjdeclaration(int symtype) * Read in the definition of the elements of the object. */ count = 0; + oldmode = tokenmode(TM_DEFAULT); for (;;) { - if (gettoken() != T_SYMBOL) { - scanerror(T_SEMICOLON, "Missing element name in OBJ statement"); - return; - } - index = addelement(tokenstring()); - for (i = 0; i < count; i++) { - if (indices[i] == index) { - scanerror(T_NULL, "Duplicate element name \"%s\"", tokenstring()); - err = TRUE; - break; - } - } - indices[count++] = index; switch (gettoken()) { - case T_RIGHTBRACE: - if (!err) { - (void) defineobject(name, indices, count); - getobjvars(name, symtype); + case T_SYMBOL: + if (count == MAXINDICES) { + scanerror(T_SEMICOLON, "Too many elements in OBJ statement"); + (void) tokenmode(oldmode); return; } - scanerror(T_SEMICOLON, "Error in object definition"); - case T_COMMA: - case T_SEMICOLON: + index = addelement(tokensymbol()); + for (i = 0; i < count; i++) { + if (indices[i] == index) { + scanerror(T_SEMICOLON, "Duplicate element name \"%s\"", tokensymbol()); + (void) tokenmode(oldmode); + return; + } + } + indices[count++] = index; + if (gettoken() == T_COMMA) + continue; + rescantoken(); + if (gettoken() != T_RIGHTBRACE) { + scanerror(T_SEMICOLON, "Bad object type definition"); + (void) tokenmode(oldmode); + return; + } + /*FALLTHRU*/ + case T_RIGHTBRACE: + (void) tokenmode(oldmode); + (void) defineobject(name, indices, count); + getobjvars(name, symtype); + return; case T_NEWLINE: - break; + continue; default: - scanerror(T_SEMICOLON, "Bad object element definition"); + scanerror(T_SEMICOLON, "Bad object type definition"); + (void) tokenmode(oldmode); return; } } @@ -897,25 +982,22 @@ getoneobj(long index, int symtype) if (gettoken() == T_SYMBOL) { if (symtype == SYM_UNDEFINED) { rescantoken(); - (void) getidexpr(FALSE, TRUE); + (void) getidexpr(TRUE, TRUE); } else { - symname = tokenstring(); + symname = tokensymbol(); definesymbol(symname, symtype); usesymbol(symname, FALSE); } - while (gettoken() == T_COMMA); - rescantoken(); getoneobj(index, symtype); addop(OP_ASSIGN); return; } rescantoken(); addopone(OP_OBJCREATE, index); - if (gettoken() == T_ASSIGN) + while (gettoken() == T_ASSIGN) (void) getinitlist(); - else - rescantoken(); + rescantoken(); } /* @@ -956,20 +1038,25 @@ getobjvars(char *name, int symtype) static void getmatdeclaration(int symtype) { - - - for(;;) { - getonematrix(symtype); - if (gettoken() != T_COMMA) { - rescantoken(); - return; + for (;;) { + switch (gettoken()) { + case T_SYMBOL: + rescantoken(); + getonematrix(symtype); + addop(OP_POP); + continue; + case T_COMMA: + continue; + default: + rescantoken(); + return; } - addop(OP_POP); } } -static -void getonematrix(int symtype) + +static void +getonematrix(int symtype) { long dim; long index; @@ -983,7 +1070,7 @@ void getonematrix(int symtype) (void) getidexpr(FALSE, TRUE); } else { - name = tokenstring(); + name = tokensymbol(); definesymbol(name, symtype); usesymbol(name, FALSE); } @@ -996,8 +1083,8 @@ void getonematrix(int symtype) rescantoken(); if (gettoken() != T_LEFTBRACKET) { - addopone(OP_MATCREATE, 0); rescantoken(); + scanerror(T_SEMICOLON, "Left-bracket expected"); return; } dim = 1; @@ -1035,23 +1122,21 @@ void getonematrix(int symtype) */ rescantoken(); creatematrix(); - if (gettoken() == T_ASSIGN) + while (gettoken() == T_ASSIGN) (void) getinitlist(); - else - rescantoken(); - return; + rescantoken(); } - + static void -creatematrix(void) +creatematrix(void) { long dim; dim = 1; while (TRUE) { - (void) getassignment(); + (void) getopassignment(); switch (gettoken()) { case T_RIGHTBRACKET: case T_COMMA: @@ -1061,7 +1146,7 @@ creatematrix(void) addop(OP_ZERO); break; case T_COLON: - (void) getassignment(); + (void) getopassignment(); break; default: rescantoken(); @@ -1112,6 +1197,7 @@ getinitlist(void) for (index = 0; ; index++) { switch(gettoken()) { case T_COMMA: + case T_NEWLINE: continue; case T_RIGHTBRACE: (void) tokenmode(oldmode); @@ -1124,11 +1210,12 @@ getinitlist(void) break; default: rescantoken(); - getassignment(); + getopassignment(); } addopone(OP_ELEMINIT, index); switch (gettoken()) { case T_COMMA: + case T_NEWLINE: continue; case T_RIGHTBRACE: @@ -1167,7 +1254,7 @@ getcondition(void) * Get an expression list consisting of one or more expressions, * separated by commas. The value of the list is that of the final expression. * This is the top level routine for parsing expressions. - * Returns flags describing the type of assignment or expression found. + * Returns flags describing the type of the last assignment or expression found. * exprlist = assignment [ ',' assignment ] ... */ static int @@ -1175,11 +1262,10 @@ getexprlist(void) { int type; - type = getassignment(); + type = getopassignment(); while (gettoken() == T_COMMA) { addop(OP_POP); - (void) getassignment(); - type = EXPR_RVALUE; + type = getopassignment(); } rescantoken(); return type; @@ -1187,7 +1273,7 @@ getexprlist(void) /* - * Get an assignment (or possibly just an expression). + * Get an opassignment or possibly just an assignment or expression. * Returns flags describing the type of assignment or expression found. * assignment = lvalue '=' assignment * | lvalue '+=' assignment @@ -1205,14 +1291,13 @@ getexprlist(void) * | orcond. */ static int -getassignment(void) +getopassignment(void) { int type; /* type of expression */ long op; /* opcode to generate */ - type = getaltcond(); + type = getassignment(); switch (gettoken()) { - case T_ASSIGN: op = 0; break; case T_PLUSEQUALS: op = OP_ADD; break; case T_MINUSEQUALS: op = OP_SUB; break; case T_MULTEQUALS: op = OP_MUL; break; @@ -1224,9 +1309,77 @@ getassignment(void) case T_LSHIFTEQUALS: op = OP_LEFTSHIFT; break; case T_RSHIFTEQUALS: op = OP_RIGHTSHIFT; break; case T_POWEREQUALS: op = OP_POWER; break; + case T_HASHEQUALS: op = OP_HASHOP; break; + case T_TILDEEQUALS: op = OP_XOR; break; + case T_BACKSLASHEQUALS: op = OP_SETMINUS; break; + default: + rescantoken(); + return type; + } + if (isrvalue(type)) { + scanerror(T_NULL, "Illegal assignment in getopassignment"); + (void) getopassignment(); + return (EXPR_RVALUE | EXPR_ASSIGN); + } + writeindexop(); + for(;;) { + addop(OP_DUPLICATE); + if (gettoken() == T_LEFTBRACE) { + rescantoken(); + addop(OP_DUPVALUE); + getinitlist(); + while (gettoken() == T_ASSIGN) + getinitlist(); + rescantoken(); + } + else { + rescantoken(); + (void) getassignment(); + } + addop(op); + addop(OP_ASSIGN); + switch (gettoken()) { + case T_PLUSEQUALS: op = OP_ADD; break; + case T_MINUSEQUALS: op = OP_SUB; break; + case T_MULTEQUALS: op = OP_MUL; break; + case T_DIVEQUALS: op = OP_DIV; break; + case T_SLASHSLASHEQUALS: op = OP_QUO; break; + case T_MODEQUALS: op = OP_MOD; break; + case T_ANDEQUALS: op = OP_AND; break; + case T_OREQUALS: op = OP_OR; break; + case T_LSHIFTEQUALS: op = OP_LEFTSHIFT; break; + case T_RSHIFTEQUALS: op = OP_RIGHTSHIFT; break; + case T_POWEREQUALS: op = OP_POWER; break; + case T_HASHEQUALS: op = OP_HASHOP; break; + case T_TILDEEQUALS: op = OP_XOR; break; + case T_BACKSLASHEQUALS: op = OP_SETMINUS; break; + + default: + rescantoken(); + return EXPR_ASSIGN; + } + } +} + + +/* + * Get an assignment (lvalue = ...) or possibly just an expression + */ + +static int +getassignment (void) +{ + int type; /* type of expression */ + + type = getaltcond(); + + switch (gettoken()) { case T_NUMBER: case T_IMAGINARY: + addopone(OP_NUMBER, tokennumber()); + type = (EXPR_RVALUE | EXPR_CONST); + /*FALLTHRU*/ case T_STRING: case T_SYMBOL: case T_OLDVALUE: @@ -1236,36 +1389,29 @@ getassignment(void) case T_NOT: scanerror(T_NULL, "Missing operator"); return type; + case T_ASSIGN: + break; default: rescantoken(); return type; } if (isrvalue(type)) { - scanerror(T_NULL, "Illegal assignment"); + scanerror(T_SEMICOLON, "Illegal assignment in getassignment"); (void) getassignment(); return (EXPR_RVALUE | EXPR_ASSIGN); } writeindexop(); - if (op) - addop(OP_DUPLICATE); if (gettoken() == T_LEFTBRACE) { rescantoken(); - if (op) { - addop(OP_DUPVALUE); - getinitlist(); - addop(op); - addop(OP_ASSIGN); - } - else + getinitlist(); + while (gettoken() == T_ASSIGN) getinitlist(); + rescantoken(); return EXPR_ASSIGN; } rescantoken(); (void) getassignment(); - if (op) { - addop(op); - } addop(OP_ASSIGN); return EXPR_ASSIGN; } @@ -1291,16 +1437,16 @@ getaltcond(void) clearlabel(&donelab); clearlabel(&altlab); addoplabel(OP_JUMPEQ, &altlab); - (void) getaltcond(); + type = getaltcond(); if (gettoken() != T_COLON) { scanerror(T_SEMICOLON, "Missing colon for conditional expression"); return EXPR_RVALUE; } addoplabel(OP_JUMP, &donelab); setlabel(&altlab); - (void) getaltcond(); + type |= getaltcond(); setlabel(&donelab); - return EXPR_RVALUE; + return type; } @@ -1319,11 +1465,10 @@ getorcond(void) type = getandcond(); while (gettoken() == T_OROR) { addoplabel(OP_CONDORJUMP, &donelab); - (void) getandcond(); - type = EXPR_RVALUE; + type |= getandcond(); } rescantoken(); - if (donelab.l_chain > 0) + if (donelab.l_chain >= 0) setlabel(&donelab); return type; } @@ -1344,11 +1489,10 @@ getandcond(void) type = getrelation(); while (gettoken() == T_ANDAND) { addoplabel(OP_CONDANDJUMP, &donelab); - (void) getrelation(); - type = EXPR_RVALUE; + type |= getrelation(); } rescantoken(); - if (donelab.l_chain > 0) + if (donelab.l_chain >= 0) setlabel(&donelab); return type; } @@ -1400,7 +1544,20 @@ getsum(void) int type; /* type of expression found */ long op; /* opcode to generate */ - type = getproduct(); + type = EXPR_RVALUE; + switch(gettoken()) { + case T_PLUS: + (void) getproduct(); + addop(OP_PLUS); + break; + case T_MINUS: + (void) getproduct(); + addop(OP_NEGATE); + break; + default: + rescantoken(); + type = getproduct(); + } for (;;) { switch (gettoken()) { case T_PLUS: op = OP_ADD; break; @@ -1475,31 +1632,122 @@ static int getandexpr(void) { int type; /* type of value found */ + long op; type = getshiftexpr(); - while (gettoken() == T_AND) { + for (;;) { + switch (gettoken()) { + case T_AND: op = OP_AND; break; + case T_HASH: op = OP_HASHOP; break; + case T_TILDE: op = OP_XOR; break; + case T_BACKSLASH: op = OP_SETMINUS; break; + default: + rescantoken(); + return type; + } (void) getshiftexpr(); - addop(OP_AND); + addop(op); type = EXPR_RVALUE; } - rescantoken(); - return type; } /* * Get a shift or power expression. * Flags indicating the type of expression found are returned. - * shift = term '^' shiftexpr - * | term '<<' shiftexpr - * | term '>>' shiftexpr - * | term. + * shift = '+' shift + * | '-' shift + * | '/' shift + * | '\' shift + * | '~' shift + * | '#' shift + * | reference '^' shiftexpr + * | reference '<<' shiftexpr + * | reference '>>' shiftexpr + * | reference. */ static int getshiftexpr(void) { int type; /* type of value found */ long op; /* opcode to generate */ + + op = 0; + switch (gettoken()) { + case T_PLUS: op = OP_PLUS; break; + case T_MINUS: op = OP_NEGATE; break; + case T_NOT: op = OP_NOT; break; + case T_DIV: op = OP_INVERT; break; + case T_BACKSLASH: op = OP_BACKSLASH; break; + case T_TILDE: op = OP_COMP; break; + case T_HASH: op = OP_CONTENT; break; + } + if (op) { + (void) getshiftexpr(); + addop(op); + return EXPR_RVALUE; + } + rescantoken(); + type = getreference(); + switch (gettoken()) { + case T_POWER: op = OP_POWER; break; + case T_LEFTSHIFT: op = OP_LEFTSHIFT; break; + case T_RIGHTSHIFT: op = OP_RIGHTSHIFT; break; + default: + rescantoken(); + return type; + } + (void) getshiftexpr(); + addop(op); + return EXPR_RVALUE; +} + + +/* + * set an address or dereference indicator + * address = '&' term + * dereference = '*' term + */ +static int +getreference(void) +{ + int type; + + switch(gettoken()) { + case T_ANDAND: + scanerror(T_NULL, "Non-variable operand for &"); + case T_AND: + type = getreference(); + addop(OP_PTR); + type = EXPR_RVALUE; + break; + case T_MULT: + (void) getreference(); + addop(OP_DEREF); + type = 0; + break; + case T_POWER: /* '**' or '^' */ + (void) getreference(); + addop(OP_DEREF); + addop(OP_DEREF); + type = 0; + break; + default: + rescantoken(); + type = getincdecexpr(); + } + return type; +} + + +/* + * get an increment or decrement expression + * ++expr, --expr, expr++, expr-- + */ +static int +getincdecexpr(void) +{ + int type; int tok; type = getterm(); @@ -1523,27 +1771,19 @@ getshiftexpr(void) continue; default: addop(OP_POP); - goto done; + break; } + break; } -done: type = EXPR_RVALUE | EXPR_ASSIGN; + type = EXPR_RVALUE | EXPR_ASSIGN; } if (tok == T_NOT) { addopfunction(OP_CALL, getbuiltinfunc("fact"), 1); tok = gettoken(); type = EXPR_RVALUE; } - switch (tok) { - case T_POWER: op = OP_POWER; break; - case T_LEFTSHIFT: op = OP_LEFTSHIFT; break; - case T_RIGHTSHIFT: op = OP_RIGHTSHIFT; break; - default: - rescantoken(); - return type; - } - (void) getshiftexpr(); - addop(op); - return EXPR_RVALUE; + rescantoken(); + return type; } @@ -1554,8 +1794,6 @@ done: type = EXPR_RVALUE | EXPR_ASSIGN; * | lvalue '[' assignment ']' * | lvalue '++' * | lvalue '--' - * | '++' lvalue - * | '--' lvalue * | real_number * | imaginary_number * | '.' @@ -1563,16 +1801,15 @@ done: type = EXPR_RVALUE | EXPR_ASSIGN; * | '(' assignment ')' * | function [ '(' [assignment [',' assignment] ] ')' ] * | '!' term - * | '+' term - * | '-' term. */ static int getterm(void) { int type; /* type of term found */ + int oldmode; - type = gettoken(); - switch (type) { + type = 0; + switch (gettoken()) { case T_NUMBER: addopone(OP_NUMBER, tokennumber()); type = (EXPR_RVALUE | EXPR_CONST); @@ -1589,8 +1826,8 @@ getterm(void) break; case T_STRING: - addopptr(OP_STRING, tokenstring()); - type = (EXPR_RVALUE | EXPR_CONST); + addopone(OP_STRING, tokenstring()); + type = EXPR_RVALUE; break; case T_PLUSPLUS: @@ -1609,31 +1846,21 @@ getterm(void) type = EXPR_ASSIGN; break; - case T_NOT: - (void) getterm(); - addop(OP_NOT); - type = EXPR_RVALUE; - break; - - case T_MINUS: - (void) getterm(); - addop(OP_NEGATE); - type = EXPR_RVALUE; - break; - - case T_PLUS: - (void) getterm(); - type = EXPR_RVALUE; - break; - case T_LEFTPAREN: + oldmode = tokenmode(TM_DEFAULT); type = getexprlist(); if (gettoken() != T_RIGHTPAREN) scanerror(T_SEMICOLON, "Missing right parenthesis"); + (void) tokenmode(oldmode); break; case T_MAT: - getmatdeclaration(SYM_UNDEFINED); + getonematrix(SYM_UNDEFINED); + while (gettoken() == T_COMMA) { + addop(OP_POP); + getonematrix(SYM_UNDEFINED); + } + rescantoken(); type = EXPR_ASSIGN; break; @@ -1649,23 +1876,39 @@ getterm(void) case T_LEFTBRACKET: scanerror(T_NULL, "Bad index usage"); - type = 0; break; case T_PERIOD: scanerror(T_NULL, "Bad element reference"); - type = 0; break; default: if (iskeyword(type)) { scanerror(T_NULL, "Expression contains reserved keyword"); - type = 0; break; } rescantoken(); scanerror(T_COMMA, "Missing expression"); - type = 0; + } + if (type == 0) { + for (;;) { + switch (gettoken()) { + case T_LEFTBRACKET: + rescantoken(); + getmatargs(); + type = 0; + break; + case T_PERIOD: + getelement(); + type = 0; + break; + case T_LEFTPAREN: + scanerror(T_NULL, "Function calls not allowed as expressions"); + default: + rescantoken(); + return type; + } + } } return type; } @@ -1682,13 +1925,16 @@ getidexpr(BOOL okmat, BOOL autodef) { int type; char name[SYMBOLSIZE+1]; /* symbol name */ + int oldmode; type = 0; if (!getid(name)) return type; switch (gettoken()) { case T_LEFTPAREN: + oldmode = tokenmode(TM_DEFAULT); getcallargs(name); + (void) tokenmode(oldmode); type = 0; break; case T_ASSIGN: @@ -1711,6 +1957,9 @@ getidexpr(BOOL okmat, BOOL autodef) getmatargs(); type = 0; break; + case T_ARROW: + addop(OP_DEREF); + /*FALLTHRU*/ case T_PERIOD: getelement(); type = 0; @@ -1734,23 +1983,29 @@ getidexpr(BOOL okmat, BOOL autodef) * given: * name filename to read * msg_ok TRUE => ok to print error messages - * once non-NULL => set to TRUE of -once read + * once non-NULL => set to TRUE of -once read */ static BOOL getfilename(char *name, BOOL msg_ok, BOOL *once) { + STRING *s; + /* look at the next token */ (void) tokenmode(TM_NEWLINES | TM_ALLSYMS); switch (gettoken()) { case T_STRING: + s = findstring(tokenstring()); + strcpy(name, s->s_str); + sfree(s); + break; case T_SYMBOL: + strcpy(name, tokensymbol()); break; default: if (msg_ok) scanerror(T_SEMICOLON, "Filename expected"); return FALSE; } - strcpy(name, tokenstring()); /* determine if we care about a possible -once option */ if (once != NULL) { @@ -1761,7 +2016,12 @@ getfilename(char *name, BOOL msg_ok, BOOL *once) /* look for the filename */ switch (gettoken()) { case T_STRING: + s = findstring(tokenstring()); + strcpy(name, s->s_str); + sfree(s); + break; case T_SYMBOL: + strcpy(name, tokensymbol()); break; default: if (msg_ok) @@ -1769,7 +2029,6 @@ getfilename(char *name, BOOL msg_ok, BOOL *once) "Filename expected"); return FALSE; } - strcpy(name, tokenstring()); } else { *once = FALSE; } @@ -1802,29 +2061,32 @@ getshowstatement(void) switch (gettoken()) { case T_SYMBOL: - strncpy(name, tokenstring(), 4); + strncpy(name, tokensymbol(), 4); name[4] = '\0'; - arg = stringindex("buil\000glob\000func\000objf\000conf\000objt\000file\000size\000opco\0", name); - if (arg == 9) { + arg = stringindex("buil\000real\000func\000objf\000conf\000objt\000file\000size\000erro\000cust\000bloc\000cons\000glob\000stat\000numb\000redc\000stri\000lite\000opco\000", name); + if (arg == 19) { if (gettoken() != T_SYMBOL) { rescantoken(); scanerror(T_SEMICOLON, "Function name expected"); return; } - index = adduserfunc(tokenstring()); - addopone(OP_SHOW, index + 9); + index = adduserfunc(tokensymbol()); + addopone(OP_SHOW, index + 19); return; } if (arg > 0) addopone(OP_SHOW, arg); else - printf("Unknown SHOW parameter ignored"); + printf("Unknown SHOW parameter ignored\n"); return; default: printf("SHOW command to be followed by at least "); printf("four letters of one of:\n"); - printf("\tbuiltin, global, function, objfunc, "); - printf("config, objtype, files, sizes\n"); + printf("\tblocks, builtin, config, constants, "); + printf("custom, errors, files, functions,\n"); + printf("\tglobaltypes, objfunctions, objtypes, opcodes, sizes, "); + printf("realglobals,\n"); + printf("\tstatics, numbers, redcdata, strings, literals\n"); rescantoken(); return; @@ -1850,7 +2112,7 @@ getmatargs(void) * Look for the 'fast index' first. */ if (gettoken() == T_LEFTBRACKET) { - (void) getassignment(); + (void) getopassignment(); if ((gettoken() != T_RIGHTBRACKET) || (gettoken() != T_RIGHTBRACKET)) { scanerror(T_NULL, "Bad fast index usage"); @@ -1869,7 +2131,7 @@ getmatargs(void) */ dim = 1; for (;;) { - (void) getassignment(); + (void) getopassignment(); switch (gettoken()) { case T_RIGHTBRACKET: addoptwo(OP_INDEXADDR, (long) dim, @@ -1930,31 +2192,40 @@ getid(char *buf) *buf = '\0'; return FALSE; } - strncpy(buf, tokenstring(), SYMBOLSIZE); + strncpy(buf, tokensymbol(), SYMBOLSIZE); buf[SYMBOLSIZE] = '\0'; return TRUE; } /* - * Define a symbol name to be of the specified symbol type. This also checks - * to see if the symbol was already defined in an incompatible manner. + * Define a symbol name to be of the specified symbol type. The scope + * of a static variable with the same name is terminated if symtype is + * global or if symtype is static and the old variable is at the same + * level. A scan error occurs if the name is already in use in an + * incompatible manner. */ static void definesymbol(char *name, int symtype) { switch (symboltype(name)) { + case SYM_STATIC: + if (symtype == SYM_GLOBAL || symtype == SYM_STATIC) + endscope(name, symtype == SYM_GLOBAL); + /*FALLTHRU*/ case SYM_UNDEFINED: case SYM_GLOBAL: - case SYM_STATIC: if (symtype == SYM_LOCAL) (void) addlocal(name); else (void) addglobal(name, (symtype == SYM_STATIC)); break; - case SYM_PARAM: case SYM_LOCAL: + if (symtype == SYM_LOCAL) + return; + /*FALLTHRU*/ + case SYM_PARAM: scanerror(T_COMMA, "Variable \"%s\" is already defined", name); return; } @@ -2014,7 +2285,6 @@ getcallargs(char *name) long index; /* function index */ long op; /* opcode to add */ int argcount; /* number of arguments */ - int type; BOOL addrflag; op = OP_CALL; @@ -2046,13 +2316,11 @@ getcallargs(char *name) continue; } rescantoken(); - addrflag = (gettoken() == T_AND); + addrflag = (gettoken() == T_BACKQUOTE); if (!addrflag) rescantoken(); - type = getassignment(); + (void) getopassignment(); if (addrflag) { - if (isrvalue(type)) - scanerror(T_NULL, "Taking address of non-variable"); writeindexop(); } if (!addrflag && (op != OP_CALL)) @@ -2091,12 +2359,12 @@ do_changedir(void) case T_NULL: case T_NEWLINE: case T_SEMICOLON: - p = getenv("HOME"); + p = home; break; default: - p = tokenstring(); + p = tokensymbol(); /* This is not enough XXX */ if (p == NULL) { - p = getenv("HOME"); + p = home; } break; } diff --git a/comfunc.c b/comfunc.c index c61aed5..6b0bc0a 100644 --- a/comfunc.c +++ b/comfunc.c @@ -125,10 +125,12 @@ csqrt(COMPLEX *c, NUMBER *epsilon, long R) if (cisreal(c)) { r = comalloc(); if (!qisneg(c->real)) { + qfree(r->real); r->real = qsqrt(c->real, epsilon, R); return r; } ntmp = qneg(c->real); + qfree(r->imag); r->imag = qsqrt(ntmp, epsilon, R); qfree(ntmp); return r; @@ -160,7 +162,7 @@ csqrt(COMPLEX *c, NUMBER *epsilon, long R) return clink(&_czero_); } aes = qscale(c->imag, -1); - v = qdiv(aes, u); + v = qqdiv(aes, u); qfree(aes); r = comalloc(); r->real = u; @@ -170,8 +172,8 @@ csqrt(COMPLEX *c, NUMBER *epsilon, long R) #endif imsign = c->imag->num.sign; es = qsquare(epsilon); - aes = qdiv(c->real, es); - bes = qdiv(c->imag, es); + aes = qqdiv(c->real, es); + bes = qqdiv(c->imag, es); qfree(es); zgcd(aes->den, bes->den, &g); zequo(bes->den, g, &tmp1); @@ -217,12 +219,14 @@ csqrt(COMPLEX *c, NUMBER *epsilon, long R) r = comalloc(); qtemp = *aes; qtemp.num.sign = sign; + qfree(r->real); r->real = qmul(&qtemp, epsilon); qfree(aes); bes = qscale(r->real, 1); qtemp = *bes; qtemp.num.sign = sign ^ imsign; - r->imag = qdiv(c->imag, &qtemp); + qfree(r->imag); + r->imag = qqdiv(c->imag, &qtemp); qfree(bes); return r; } @@ -272,12 +276,14 @@ csqrt(COMPLEX *c, NUMBER *epsilon, long R) r = comalloc(); qtemp = *aes; qtemp.num.sign = sign; + qfree(r->real); r->real = qmul(&qtemp, epsilon); qfree(aes); bes = qscale(r->real, 1); qtemp = *bes; qtemp.num.sign = sign ^ imsign; - r->imag = qdiv(c->imag, &qtemp); + qfree(r->imag); + r->imag = qqdiv(c->imag, &qtemp); qfree(bes); return r; } @@ -355,10 +361,10 @@ csqrt(COMPLEX *c, NUMBER *epsilon, long R) return clink(&_czero_); } r = comalloc(); - if (!qiszero(u)) - r->real = u; - if (!qiszero(v)) - r->imag = v; + qfree(r->real); + qfree(r->imag); + r->real = u; + r->imag = v; return r; } @@ -384,6 +390,7 @@ croot(COMPLEX *c, NUMBER *q, NUMBER *epsilon) return csqrt(c, epsilon, 24L); if (cisreal(c) && !qisneg(c->real)) { r = comalloc(); + qfree(r->real); r->real = qroot(c->real, q, epsilon); return r; } @@ -412,7 +419,7 @@ croot(COMPLEX *c, NUMBER *q, NUMBER *epsilon) epsilon2 = qbitvalue(n - m - 4); tmp1 = qatan2(c->imag, c->real, epsilon2); qfree(epsilon2); - tmp2 = qdiv(tmp1, q); + tmp2 = qqdiv(tmp1, q); qfree(tmp1); r = cpolar(root, tmp2, epsilon); qfree(root); @@ -437,8 +444,9 @@ cexp(COMPLEX *c, NUMBER *epsilon) math_error("Zero epsilon for cexp"); /*NOTREACHED*/ } - r = comalloc(); if (cisreal(c)) { + r = comalloc(); + qfree(r->real); r->real = qexp(c->real, epsilon); return r; } @@ -458,11 +466,14 @@ cexp(COMPLEX *c, NUMBER *epsilon) qsincos(c->imag, k - n + 2, &sin, &cos); tmp2 = qmul(tmp1, cos); qfree(cos); + r = comalloc(); + qfree(r->real); r->real = qmappr(tmp2, epsilon, 24L); qfree(tmp2); tmp2 = qmul(tmp1, sin); qfree(tmp1); qfree(sin); + qfree(r->imag); r->imag = qmappr(tmp2, epsilon, 24L); qfree(tmp2); return r; @@ -488,6 +499,7 @@ cln(COMPLEX *c, NUMBER *epsilon) return clink(&_czero_); r = comalloc(); if (cisreal(c) && !qisneg(c->real)) { + qfree(r->real); r->real = qln(c->real, epsilon); return r; } @@ -500,8 +512,10 @@ cln(COMPLEX *c, NUMBER *epsilon) tmp1 = qln(a2b2, epsilon1); qfree(a2b2); qfree(epsilon1); + qfree(r->real); r->real = qscale(tmp1, -1L); qfree(tmp1); + qfree(r->imag); r->imag = qatan2(c->imag, c->real, epsilon); return r; } @@ -526,6 +540,8 @@ ccos(COMPLEX *c, NUMBER *epsilon) } n = qilog2(epsilon); ctmp1 = comalloc(); + qfree(ctmp1->real); + qfree(ctmp1->imag); neg = qisneg(c->imag); ctmp1->real = neg ? qneg(c->imag) : qlink(c->imag); ctmp1->imag = neg ? qlink(c->real) : qneg(c->real); @@ -544,7 +560,9 @@ ccos(COMPLEX *c, NUMBER *epsilon) ctmp1 = cscale(ctmp3, -1); comfree(ctmp3); r = comalloc(); + qfree(r->real); r->real = qmappr(ctmp1->real, epsilon, 24L); + qfree(r->imag); r->imag = qmappr(ctmp1->imag, epsilon, 24L); comfree(ctmp1); return r; @@ -573,6 +591,8 @@ csin(COMPLEX *c, NUMBER *epsilon) n = qilog2(epsilon); ctmp1 = comalloc(); neg = qisneg(c->imag); + qfree(ctmp1->real); + qfree(ctmp1->imag); ctmp1->real = neg ? qneg(c->imag) : qlink(c->imag); ctmp1->imag = neg ? qlink(c->real) : qneg(c->real); epsilon1 = qbitvalue(n - 2); @@ -591,9 +611,11 @@ csin(COMPLEX *c, NUMBER *epsilon) comfree(ctmp3); r = comalloc(); qtmp = neg ? qlink(ctmp1->imag) : qneg(ctmp1->imag); + qfree(r->real); r->real = qmappr(qtmp, epsilon, 24L); qfree(qtmp); qtmp = neg ? qneg(ctmp1->real) : qlink(ctmp1->real); + qfree(r->imag); r->imag = qmappr(qtmp, epsilon, 24L); qfree(qtmp); comfree(ctmp1); @@ -601,6 +623,364 @@ csin(COMPLEX *c, NUMBER *epsilon) } +COMPLEX * +ccosh(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2, *tmp3; + + tmp1 = cexp(c, epsilon); + tmp2 = cneg(c); + tmp3 = cexp(tmp2, epsilon); + comfree(tmp2); + tmp2 = cadd(tmp1, tmp3); + comfree(tmp1); + comfree(tmp3); + tmp1 = cscale(tmp2, -1); + comfree(tmp2); + return tmp1; +} + + +COMPLEX * +csinh(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2, *tmp3; + + tmp1 = cexp(c, epsilon); + tmp2 = cneg(c); + tmp3 = cexp(tmp2, epsilon); + comfree(tmp2); + tmp2 = csub(tmp1, tmp3); + comfree(tmp1); + comfree(tmp3); + tmp1 = cscale(tmp2, -1); + comfree(tmp2); + return tmp1; +} + + +COMPLEX * +casin(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2; + + tmp1 = cmul(&_conei_, c); + tmp2 = casinh(tmp1, epsilon); + comfree(tmp1); + tmp1 = cdiv(tmp2, &_conei_); + comfree(tmp2); + return tmp1; +} + + +COMPLEX * +cacos(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2; + + tmp1 = csquare(c); + tmp2 = csub(&_cone_, tmp1); + comfree(tmp1); + tmp1 = csqrt(tmp2, epsilon, 24); + comfree(tmp2); + tmp2 = cmul(&_conei_, tmp1); + comfree(tmp1); + tmp1 = cadd(c, tmp2); + comfree(tmp2); + tmp2 = cln(tmp1, epsilon); + comfree(tmp1); + tmp1 = cdiv(tmp2, &_conei_); + comfree(tmp2); + return tmp1; +} + + +COMPLEX * +casinh(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2, *tmp3; + BOOL neg; + + neg = qisneg(c->real); + tmp1 = neg ? cneg(c) : clink(c); + tmp2 = csquare(tmp1); + tmp3 = cadd(&_cone_, tmp2); + comfree(tmp2); + tmp2 = csqrt(tmp3, epsilon, 24); + comfree(tmp3); + tmp3 = cadd(tmp2, tmp1); + comfree(tmp1); + comfree(tmp2); + tmp1 = cln(tmp3, epsilon); + comfree(tmp3); + if (neg) { + tmp2 = cneg(tmp1); + comfree(tmp1); + return tmp2; + } + return tmp1; +} + + +COMPLEX * +cacosh(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2; + + tmp1 = csquare(c); + tmp2 = csub(tmp1, &_cone_); + comfree(tmp1); + tmp1 = csqrt(tmp2, epsilon, 24); + comfree(tmp2); + tmp2 = cadd(c, tmp1); + comfree(tmp1); + tmp1 = cln(tmp2, epsilon); + comfree(tmp2); + return tmp1; +} + + +COMPLEX * +catan(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2, *tmp3; + + if (qiszero(c->real) && qisunit(c->imag)) + return NULL; + tmp1 = csub(&_conei_, c); + tmp2 = cadd(&_conei_, c); + tmp3 = cdiv(tmp1, tmp2); + comfree(tmp1); + comfree(tmp2); + tmp1 = cln(tmp3, epsilon); + comfree(tmp3); + tmp2 = cscale(tmp1, -1); + comfree(tmp1); + tmp1 = cdiv(tmp2, &_conei_); + comfree(tmp2); + return tmp1; +} + + +COMPLEX * +cacot(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2, *tmp3; + + if (qiszero(c->real) && qisunit(c->imag)) + return NULL; + tmp1 = cadd(c, &_conei_); + tmp2 = csub(c, &_conei_); + tmp3 = cdiv(tmp1, tmp2); + comfree(tmp1); + comfree(tmp2); + tmp1 = cln(tmp3, epsilon); + comfree(tmp3); + tmp2 = cscale(tmp1, -1); + comfree(tmp1); + tmp1 = cdiv(tmp2, &_conei_); + comfree(tmp2); + return tmp1; +} + +COMPLEX * +casec(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2; + + tmp1 = cinv(c); + tmp2 = cacos(tmp1, epsilon); + comfree(tmp1); + return tmp2; +} + +COMPLEX * +cacsc(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2; + + tmp1 = cinv(c); + tmp2 = casin(tmp1, epsilon); + comfree(tmp1); + return tmp2; +} + + +COMPLEX * +catanh(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2, *tmp3; + + if (qiszero(c->imag) && qisunit(c->real)) + return NULL; + tmp1 = cadd(&_cone_, c); + tmp2 = csub(&_cone_, c); + tmp3 = cdiv(tmp1, tmp2); + comfree(tmp1); + comfree(tmp2); + tmp1 = cln(tmp3, epsilon); + comfree(tmp3); + tmp2 = cscale(tmp1, -1); + comfree(tmp1); + return tmp2; +} + + +COMPLEX * +cacoth(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2, *tmp3; + + if (qiszero(c->imag) && qisunit(c->real)) + return NULL; + tmp1 = cadd(c, &_cone_); + tmp2 = csub(c, &_cone_); + tmp3 = cdiv(tmp1, tmp2); + comfree(tmp1); + comfree(tmp2); + tmp1 = cln(tmp3, epsilon); + comfree(tmp3); + tmp2 = cscale(tmp1, -1); + comfree(tmp1); + return tmp2; +} + +COMPLEX * +casech(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2; + + tmp1 = cinv(c); + tmp2 = cacosh(tmp1, epsilon); + comfree(tmp1); + return tmp2; +} + +COMPLEX * +cacsch(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2; + + tmp1 = cinv(c); + tmp2 = casinh(tmp1, epsilon); + comfree(tmp1); + return tmp2; +} + + +COMPLEX * +cgd(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2, *tmp3; + NUMBER *q1, *q2; + NUMBER *sin, *cos; + NUMBER *eps; + int n, n1; + BOOL neg; + + if (cisreal(c)) { + q1 = qscale(c->real, -1); + eps = qscale(epsilon, -1); + q2 = qtanh(q1, eps); + qfree(q1); + q1 = qatan(q2, eps); + qfree(eps); + qfree(q2); + tmp1 = comalloc(); + qfree(tmp1->real); + tmp1->real = qscale(q1, 1); + qfree(q1); + return tmp1; + } + if (qiszero(c->real)) { + n = - qilog2(epsilon); + qsincos(c->imag, n + 8, &sin, &cos); + if (qiszero(cos) || (n1 = -qilog2(cos)) > n) { + qfree(sin); + qfree(cos); + return NULL; + } + neg = qisneg(sin); + q1 = neg ? qsub(&_qone_, sin) : qqadd(&_qone_, sin); + qfree(sin); + if (n1 > 8) { + qfree(q1); + qfree(cos); + qsincos(c->imag, n + n1, &sin, &cos); + q1 = neg ? qsub(&_qone_, sin) : qqadd(&_qone_, sin); + qfree(sin); + } + q2 = qqdiv(q1, cos); + qfree(q1); + q1 = qln(q2, epsilon); + qfree(q2); + if (neg) { + q2 = qneg(q1); + qfree(q1); + q1 = q2; + } + tmp1 = comalloc(); + qfree(tmp1->imag); + tmp1->imag = q1; + if (qisneg(cos)) { + qfree(tmp1->real); + q1 = qpi(epsilon); + if (qisneg(c->imag)) { + q2 = qneg(q1); + qfree(q1); + q1 = q2; + } + tmp1->real = q1; + } + qfree(cos); + return tmp1; + } + neg = qisneg(c->real); + tmp1 = neg ? cneg(c) : clink(c); + tmp2 = cexp(tmp1, epsilon); + comfree(tmp1); + tmp1 = cmul(&_conei_, tmp2); + tmp3 = cadd(&_conei_, tmp2); + comfree(tmp2); + tmp2 = cadd(tmp1, &_cone_); + comfree(tmp1); + if (ciszero(tmp2) || ciszero(tmp3)) { + comfree(tmp2); + comfree(tmp3); + return NULL; + } + tmp1 = cdiv(tmp2, tmp3); + comfree(tmp2); + comfree(tmp3); + tmp2 = cln(tmp1, epsilon); + comfree(tmp1); + tmp1 = cdiv(tmp2, &_conei_); + comfree(tmp2); + if (neg) { + tmp2 = cneg(tmp1); + comfree(tmp1); + return tmp2; + } + return tmp1; +} + + +COMPLEX * +cagd(COMPLEX *c, NUMBER *epsilon) +{ + COMPLEX *tmp1, *tmp2; + + tmp1 = cmul(&_conei_, c); + tmp2 = cgd(tmp1, epsilon); + comfree(tmp1); + if (tmp2 == NULL) + return NULL; + tmp1 = cdiv(tmp2, &_conei_); + comfree(tmp2); + return tmp1; +} + + /* * Convert a number from polar coordinates to normal complex number form * within the specified accuracy. This produces the value: @@ -625,16 +1005,19 @@ cpolar(NUMBER *q1, NUMBER *q2, NUMBER *epsilon) return qlink(&_czero_); r = comalloc(); if (qiszero(q2)) { + qfree(r->real); r->real = qlink(q1); return r; } qsincos(q2, m - n + 2, &sin, &cos); tmp = qmul(q1, cos); qfree(cos); + qfree(r->real); r->real = qmappr(tmp, epsilon, 24L); qfree(tmp); tmp = qmul(q1, sin); qfree(sin); + qfree(r->imag); r->imag = qmappr(tmp, epsilon, 24L); qfree(tmp); return r; @@ -666,12 +1049,12 @@ cpower(COMPLEX *c1, COMPLEX *c2, NUMBER *epsilon) n = qilog2(epsilon); m1 = m2 = -1000000; k1 = k2 = 0; - qtmp1 = qsquare(c1->real); - qtmp2 = qsquare(c1->imag); - a2b2 = qqadd(qtmp1, qtmp2); - qfree(qtmp1); - qfree(qtmp2); if (!qiszero(c2->real)) { + qtmp1 = qsquare(c1->real); + qtmp2 = qsquare(c1->imag); + a2b2 = qqadd(qtmp1, qtmp2); + qfree(qtmp1); + qfree(qtmp2); m1 = qilog2(c2->real); epsilon1 = qbitvalue(-m1 - 1); qtmp1 = qln(a2b2, epsilon1); diff --git a/commath.c b/commath.c index a644a19..65f57ea 100644 --- a/commath.c +++ b/commath.c @@ -29,10 +29,14 @@ cadd(COMPLEX *c1, COMPLEX *c2) if (ciszero(c2)) return clink(c1); r = comalloc(); - if (!qiszero(c1->real) || !qiszero(c2->real)) + if (!qiszero(c1->real) || !qiszero(c2->real)) { + qfree(r->real); r->real = qqadd(c1->real, c2->real); - if (!qiszero(c1->imag) || !qiszero(c2->imag)) + } + if (!qiszero(c1->imag) || !qiszero(c2->imag)) { + qfree(r->imag); r->imag = qqadd(c1->imag, c2->imag); + } return r; } @@ -50,10 +54,14 @@ csub(COMPLEX *c1, COMPLEX *c2) if (ciszero(c2)) return clink(c1); r = comalloc(); - if (!qiszero(c1->real) || !qiszero(c2->real)) + if (!qiszero(c1->real) || !qiszero(c2->real)) { + qfree(r->real); r->real = qsub(c1->real, c2->real); - if (!qiszero(c1->imag) || !qiszero(c2->imag)) + } + if (!qiszero(c1->imag) || !qiszero(c2->imag)) { + qfree(r->imag); r->imag = qsub(c1->imag, c2->imag); + } return r; } @@ -95,7 +103,9 @@ cmul(COMPLEX *c1, COMPLEX *c2) q2 = qmul(c1->real, c2->real); q3 = qmul(c1->imag, c2->imag); q4 = qqadd(q2, q3); + qfree(r->real); r->real = qsub(q2, q3); + qfree(r->imag); r->imag = qsub(q1, q4); qfree(q1); qfree(q2); @@ -122,10 +132,12 @@ csquare(COMPLEX *c) return clink(&_cnegone_); r = comalloc(); if (cisreal(c)) { + qfree(r->real); r->real = qsquare(c->real); return r; } if (cisimag(c)) { + qfree(r->real); q1 = qsquare(c->imag); r->real = qneg(q1); qfree(q1); @@ -133,9 +145,11 @@ csquare(COMPLEX *c) } q1 = qsquare(c->real); q2 = qsquare(c->imag); + qfree(r->real); r->real = qsub(q1, q2); qfree(q1); qfree(q2); + qfree(r->imag); q1 = qmul(c->real, c->imag); r->imag = qscale(q1, 1L); qfree(q1); @@ -160,26 +174,32 @@ cdiv(COMPLEX *c1, COMPLEX *c2) return clink(&_cone_); r = comalloc(); if (cisreal(c1) && cisreal(c2)) { - r->real = qdiv(c1->real, c2->real); + qfree(r->real); + r->real = qqdiv(c1->real, c2->real); return r; } if (cisimag(c1) && cisimag(c2)) { - r->real = qdiv(c1->imag, c2->imag); + qfree(r->real); + r->real = qqdiv(c1->imag, c2->imag); return r; } if (cisimag(c1) && cisreal(c2)) { - r->imag = qdiv(c1->imag, c2->real); + qfree(r->imag); + r->imag = qqdiv(c1->imag, c2->real); return r; } if (cisreal(c1) && cisimag(c2)) { - q1 = qdiv(c1->real, c2->imag); + qfree(r->imag); + q1 = qqdiv(c1->real, c2->imag); r->imag = qneg(q1); qfree(q1); return r; } if (cisreal(c2)) { - r->real = qdiv(c1->real, c2->real); - r->imag = qdiv(c1->imag, c2->real); + qfree(r->real); + qfree(r->imag); + r->real = qqdiv(c1->real, c2->real); + r->imag = qqdiv(c1->imag, c2->real); return r; } q1 = qsquare(c2->real); @@ -192,14 +212,16 @@ cdiv(COMPLEX *c1, COMPLEX *c2) q3 = qqadd(q1, q2); qfree(q1); qfree(q2); - r->real = qdiv(q3, den); + qfree(r->real); + r->real = qqdiv(q3, den); qfree(q3); q1 = qmul(c1->real, c2->imag); q2 = qmul(c1->imag, c2->real); q3 = qsub(q2, q1); qfree(q1); qfree(q2); - r->imag = qdiv(q3, den); + qfree(r->imag); + r->imag = qqdiv(q3, den); qfree(q3); qfree(den); return r; @@ -221,11 +243,13 @@ cinv(COMPLEX *c) } r = comalloc(); if (cisreal(c)) { + qfree(r->real); r->real = qinv(c->real); return r; } if (cisimag(c)) { q1 = qinv(c->imag); + qfree(r->imag); r->imag = qneg(q1); qfree(q1); return r; @@ -235,8 +259,10 @@ cinv(COMPLEX *c) den = qqadd(q1, q2); qfree(q1); qfree(q2); - r->real = qdiv(c->real, den); - q1 = qdiv(c->imag, den); + qfree(r->real); + r->real = qqdiv(c->real, den); + q1 = qqdiv(c->imag, den); + qfree(r->imag); r->imag = qneg(q1); qfree(q1); qfree(den); @@ -255,10 +281,14 @@ cneg(COMPLEX *c) if (ciszero(c)) return clink(&_czero_); r = comalloc(); - if (!qiszero(c->real)) + if (!qiszero(c->real)) { + qfree(r->real); r->real = qneg(c->real); - if (!qiszero(c->imag)) + } + if (!qiszero(c->imag)) { + qfree(r->imag); r->imag = qneg(c->imag); + } return r; } @@ -275,7 +305,9 @@ cint(COMPLEX *c) if (cisint(c)) return clink(c); r = comalloc(); + qfree(r->real); r->real = qint(c->real); + qfree(r->imag); r->imag = qint(c->imag); return r; } @@ -293,7 +325,9 @@ cfrac(COMPLEX *c) if (cisint(c)) return clink(&_czero_); r = comalloc(); + qfree(r->real); r->real = qfrac(c->real); + qfree(r->imag); r->imag = qfrac(c->imag); return r; } @@ -311,8 +345,11 @@ cconj(COMPLEX *c) if (cisreal(c)) return clink(c); r = comalloc(); - if (!qiszero(c->real)) + if (!qiszero(c->real)) { + qfree(r->real); r->real = qlink(c->real); + } + qfree(r->imag); r->imag = qneg(c->imag); return r; } @@ -329,8 +366,10 @@ creal(COMPLEX *c) if (cisreal(c)) return clink(c); r = comalloc(); - if (!qiszero(c->real)) + if (!qiszero(c->real)) { + qfree(r->real); r->real = qlink(c->real); + } return r; } @@ -346,6 +385,7 @@ cimag(COMPLEX *c) if (cisreal(c)) return clink(&_czero_); r = comalloc(); + qfree(r->real); r->real = qlink(c->imag); return r; } @@ -362,6 +402,8 @@ caddq(COMPLEX *c, NUMBER *q) if (qiszero(q)) return clink(c); r = comalloc(); + qfree(r->real); + qfree(r->imag); r->real = qqadd(c->real, q); r->imag = qlink(c->imag); return r; @@ -379,6 +421,8 @@ csubq(COMPLEX *c, NUMBER *q) if (qiszero(q)) return clink(c); r = comalloc(); + qfree(r->real); + qfree(r->imag); r->real = qsub(c->real, q); r->imag = qlink(c->imag); return r; @@ -397,6 +441,8 @@ cshift(COMPLEX *c, long n) if (ciszero(c) || (n == 0)) return clink(c); r = comalloc(); + qfree(r->real); + qfree(r->imag); r->real = qshift(c->real, n); r->imag = qshift(c->imag, n); return r; @@ -414,6 +460,8 @@ cscale(COMPLEX *c, long n) if (ciszero(c) || (n == 0)) return clink(c); r = comalloc(); + qfree(r->real); + qfree(r->imag); r->real = qscale(c->real, n); r->imag = qscale(c->imag, n); return r; @@ -435,6 +483,8 @@ cmulq(COMPLEX *c, NUMBER *q) if (qisnegone(q)) return cneg(c); r = comalloc(); + qfree(r->real); + qfree(r->imag); r->real = qmul(c->real, q); r->imag = qmul(c->imag, q); return r; @@ -458,8 +508,10 @@ cdivq(COMPLEX *c, NUMBER *q) if (qisnegone(q)) return cneg(c); r = comalloc(); - r->real = qdiv(c->real, q); - r->imag = qdiv(c->imag, q); + qfree(r->real); + qfree(r->imag); + r->real = qqdiv(c->real, q); + r->imag = qqdiv(c->imag, q); return r; } @@ -477,10 +529,10 @@ qqtoc(NUMBER *q1, NUMBER *q2) if (qiszero(q1) && qiszero(q2)) return clink(&_czero_); r = comalloc(); - if (!qiszero(q1)) - r->real = qlink(q1); - if (!qiszero(q2)) - r->imag = qlink(q2); + qfree(r->real); + qfree(r->imag); + r->real = qlink(q1); + r->imag = qlink(q2); return r; } @@ -512,6 +564,8 @@ crel(COMPLEX *c1, COMPLEX *c2) COMPLEX *c; c = comalloc(); + qfree(c->real); + qfree(c->imag); c->real = itoq((long) qrel(c1->real, c2->real)); c->imag = itoq((long) qrel(c1->imag, c2->imag)); diff --git a/config.c b/config.c index 382efbf..28cdbe5 100644 --- a/config.c +++ b/config.c @@ -1,14 +1,19 @@ /* - * 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. * * Configuration routines. */ +#include #include "calc.h" #include "token.h" #include "zrand.h" +#include "block.h" +#include "nametype.h" +#include "config.h" +#include "string.h" /* @@ -39,10 +44,17 @@ NAMETYPE configs[] = { {"round", CONFIG_ROUND}, {"leadzero", CONFIG_LEADZERO}, {"fullzero", CONFIG_FULLZERO}, - {"maxerr", CONFIG_MAXERR}, + {"maxscan", CONFIG_MAXSCAN}, + {"maxerr", CONFIG_MAXSCAN}, /* old name for maxscan */ {"prompt", CONFIG_PROMPT}, {"more", CONFIG_MORE}, - {"random", CONFIG_RANDOM}, + {"blkmaxprint", CONFIG_BLKMAXPRINT}, + {"blkverbose", CONFIG_BLKVERBOSE}, + {"blkbase", CONFIG_BLKBASE}, + {"blkfmt", CONFIG_BLKFMT}, + {"lib_debug", CONFIG_LIB_DEBUG}, + {"calc_debug", CONFIG_CALC_DEBUG}, + {"user_debug", CONFIG_USER_DEBUG}, {NULL, 0} }; @@ -74,10 +86,16 @@ CONFIG oldstd = { /* backward compatible standard configuration */ 24, /* round()/bround() default rounding mode */ FALSE, /* ok to print leading 0 before decimal pt */ 0, /* ok to print trailing 0's */ - MAXERRORCOUNT, /* max errors before abort */ + MAXSCANCOUNT, /* max scan errors before abort */ PROMPT1, /* normal prompt */ PROMPT2, /* prompt when inside multi-line input */ - 3 /* require 1 mod 4 and to pass ptest(newn,1) */ + BLK_DEF_MAXPRINT, /* number of octets of a block to print */ + FALSE, /* skip duplicate block output lines */ + BLK_BASE_HEX, /* block octet print base */ + BLK_FMT_HD_STYLE, /* block output format */ + 0, /* calc library debug level */ + 0, /* internal calc debug level */ + 0 /* user defined debug level */ }; CONFIG newstd = { /* new non-backward compatible configuration */ MODE_INITIAL, /* current output mode */ @@ -103,10 +121,16 @@ CONFIG newstd = { /* new non-backward compatible configuration */ 24, /* round()/bround() default rounding mode */ TRUE, /* ok to print leading 0 before decimal pt */ 1, /* ok to print trailing 0's */ - MAXERRORCOUNT, /* max errors before abort */ + MAXSCANCOUNT, /* max scan errors before abort */ "; ", /* normal prompt */ ";; ", /* prompt when inside multi-line input */ - 3 /* require 1 mod 4 and to pass ptest(newn,1) */ + BLK_DEF_MAXPRINT, /* number of octets of a block to print */ + FALSE, /* skip duplicate block output lines */ + BLK_BASE_HEX, /* block octet print base */ + BLK_FMT_HD_STYLE, /* block output format */ + 0, /* calc library debug level */ + 0, /* internal calc debug level */ + 0 /* user defined debug level */ }; CONFIG *conf = NULL; /* loaded in at startup - current configuration */ @@ -153,10 +177,49 @@ static NAMETYPE truth[] = { }; +/* + * Possible block base output modes + */ +static NAMETYPE blk_base[] = { + {"hexadecimal", BLK_BASE_HEX}, + {"hex", BLK_BASE_HEX}, + {"octal", BLK_BASE_OCT}, + {"oct", BLK_BASE_OCT}, + {"character", BLK_BASE_CHAR}, + {"char", BLK_BASE_CHAR}, + {"binary", BLK_BASE_BINARY}, + {"bin", BLK_BASE_BINARY}, + {"raw", BLK_BASE_RAW}, + {"none", BLK_BASE_RAW}, + {NULL, 0} +}; + + +/* + * Possible block output formats + */ +static NAMETYPE blk_fmt[] = { + {"line", BLK_FMT_LINE}, + {"lines", BLK_FMT_LINE}, + {"str", BLK_FMT_STRING}, + {"string", BLK_FMT_STRING}, + {"strings", BLK_FMT_STRING}, + {"od", BLK_FMT_OD_STYLE}, + {"odstyle", BLK_FMT_OD_STYLE}, + {"od_style", BLK_FMT_OD_STYLE}, + {"hd", BLK_FMT_HD_STYLE}, + {"hdstyle", BLK_FMT_HD_STYLE}, + {"hd_style", BLK_FMT_HD_STYLE}, + {NULL, 0} +}; + + /* * declate static functions */ static int modetype(char *name); +static int blkbase(char *name); +static int blkfmt(char *name); static int truthtype(char *name); static char *modename(int type); @@ -202,6 +265,46 @@ modetype(char *name) } +/* + * Given the name of a block output base, convert it to the internal format. + * Returns -1 if the string is unknown. + * + * given: + * name mode name + */ +static int +blkbase(char *name) +{ + NAMETYPE *cp; /* current config pointer */ + + for (cp = blk_base; cp->name; cp++) { + if (strcmp(cp->name, name) == 0) + return cp->type; + } + return -1; +} + + +/* + * Given the name of a block output format, convert it to the internal format. + * Returns -1 if the string is unknown. + * + * given: + * name mode name + */ +static int +blkfmt(char *name) +{ + NAMETYPE *cp; /* current config pointer */ + + for (cp = blk_fmt; cp->name; cp++) { + if (strcmp(cp->name, name) == 0) + return cp->type; + } + return -1; +} + + /* * Given the name of a truth value, convert it to a BOOL or -1. * Returns -1 if the string is unknown. @@ -257,9 +360,9 @@ setconfig(int type, VALUE *vp) case CONFIG_ALL: newconf = NULL; /* firewall */ if (vp->v_type == V_STR) { - if (strcmp(vp->v_str, "oldstd") == 0) { + if (strcmp(vp->v_str->s_str, "oldstd") == 0) { newconf = &oldstd; - } else if (strcmp(vp->v_str, "newstd") == 0) { + } else if (strcmp(vp->v_str->s_str, "newstd") == 0) { newconf = &newstd; } else { math_error("CONFIG alias not oldstd or newstd"); @@ -311,7 +414,7 @@ setconfig(int type, VALUE *vp) math_error("Non-string for mode"); /*NOTREACHED*/ } - temp = modetype(vp->v_str); + temp = modetype(vp->v_str->s_str); if (temp < 0) { math_error("Unknown mode \"%s\"", vp->v_str); /*NOTREACHED*/ @@ -415,15 +518,14 @@ setconfig(int type, VALUE *vp) conf->redc2 = (int)temp; break; - case CONFIG_TILDE: if (vp->v_type == V_NUM) { q = vp->v_num; conf->tilde_ok = !qiszero(q); } else if (vp->v_type == V_STR) { - temp = truthtype(vp->v_str); + temp = truthtype(vp->v_str->s_str); if (temp < 0) { - math_error("Illegal truth value"); + math_error("Illegal truth value for tilde"); /*NOTREACHED*/ } conf->tilde_ok = (int)temp; @@ -435,9 +537,9 @@ setconfig(int type, VALUE *vp) q = vp->v_num; conf->tab_ok = !qiszero(q); } else if (vp->v_type == V_STR) { - temp = truthtype(vp->v_str); + temp = truthtype(vp->v_str->s_str); if (temp < 0) { - math_error("Illegal truth value"); + math_error("Illegal truth value for tab"); /*NOTREACHED*/ } conf->tab_ok = (int)temp; @@ -575,9 +677,9 @@ setconfig(int type, VALUE *vp) q = vp->v_num; conf->leadzero = !qiszero(q); } else if (vp->v_type == V_STR) { - temp = truthtype(vp->v_str); + temp = truthtype(vp->v_str->s_str); if (temp < 0) { { - math_error("Illegal truth value"); + math_error("Illegal truth value for leadzero"); /*NOTREACHED*/ } } @@ -590,9 +692,9 @@ setconfig(int type, VALUE *vp) q = vp->v_num; conf->fullzero = !qiszero(q); } else if (vp->v_type == V_STR) { - temp = truthtype(vp->v_str); + temp = truthtype(vp->v_str->s_str); if (temp < 0) { { - math_error("Illegal truth value"); + math_error("Illegal truth value for fullzero"); /*NOTREACHED*/ } } @@ -600,9 +702,9 @@ setconfig(int type, VALUE *vp) } break; - case CONFIG_MAXERR: + case CONFIG_MAXSCAN: if (vp->v_type != V_NUM) { - math_error("Non-numeric for maxerr"); + math_error("Non-numeric for maxscancount"); /*NOTREACHED*/ } q = vp->v_num; @@ -610,10 +712,10 @@ setconfig(int type, VALUE *vp) if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) temp = -1; if (temp < 0) { - math_error("Maxerr value is out of range"); + math_error("Maxscan value is out of range"); /*NOTREACHED*/ } - conf->maxerrorcount = temp; + conf->maxscancount = temp; break; case CONFIG_PROMPT: @@ -621,12 +723,12 @@ setconfig(int type, VALUE *vp) math_error("Non-string for prompt"); /*NOTREACHED*/ } - p = (char *)malloc(strlen(vp->v_str) + 1); + p = (char *)malloc(vp->v_str->s_len + 1); if (p == NULL) { math_error("Cannot duplicate new prompt"); /*NOTREACHED*/ } - strcpy(p, vp->v_str); + strcpy(p, vp->v_str->s_str); free(conf->prompt1); conf->prompt1 = p; break; @@ -636,30 +738,114 @@ setconfig(int type, VALUE *vp) math_error("Non-string for more prompt"); /*NOTREACHED*/ } - p = (char *)malloc(strlen(vp->v_str) + 1); + p = (char *)malloc(vp->v_str->s_len + 1); if (p == NULL) { math_error("Cannot duplicate new more prompt"); /*NOTREACHED*/ } - strcpy(p, vp->v_str); + strcpy(p, vp->v_str->s_str); free(conf->prompt2); conf->prompt2 = p; break; - case CONFIG_RANDOM: + case CONFIG_BLKMAXPRINT: if (vp->v_type != V_NUM) { - math_error("Non-numeric for random config value"); + math_error("Non-numeric for blkmaxprint"); /*NOTREACHED*/ } q = vp->v_num; temp = qtoi(q); if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) temp = -1; - if (temp < BLUM_CFG_MIN || temp > BLUM_CFG_MAX) { - math_error("Random config value is out of range"); + if (temp < 0) { + math_error("Blkmaxprint value is out of range"); /*NOTREACHED*/ } - conf->random = temp; + conf->blkmaxprint = temp; + break; + + case CONFIG_BLKVERBOSE: + if (vp->v_type == V_NUM) { + q = vp->v_num; + conf->blkverbose = !qiszero(q); + } else if (vp->v_type == V_STR) { + temp = truthtype(vp->v_str->s_str); + if (temp < 0) { + math_error("Illegal truth value for blkverbose"); + /*NOTREACHED*/ + } + conf->blkverbose = (int)temp; + } + break; + + case CONFIG_BLKBASE: + if (vp->v_type != V_STR) { + math_error("Non-string for blkbase"); + /*NOTREACHED*/ + } + temp = blkbase(vp->v_str->s_str); + if (temp < 0) { + math_error("Unknown mode \"%s\" for blkbase", + vp->v_str->s_str); + /*NOTREACHED*/ + } + conf->blkbase = temp; + break; + + case CONFIG_BLKFMT: + if (vp->v_type != V_STR) { + math_error("Non-string for blkfmt"); + /*NOTREACHED*/ + } + temp = blkfmt(vp->v_str->s_str); + if (temp < 0) { + math_error("Unknown mode \"%s\" for blkfmt", + vp->v_str->s_str); + /*NOTREACHED*/ + } + conf->blkfmt = temp; + break; + + case CONFIG_LIB_DEBUG: + if (vp->v_type != V_NUM) { + math_error("Non numeric for lib_debug"); + /*NOTREACHED*/ + } + q = vp->v_num; + temp = qtoi(q); + if (qisfrac(q) || !zistiny(q->num)) { + math_error("Illegal lib_debug parameter value"); + /*NOTREACHED*/ + } + conf->lib_debug = temp; + break; + + case CONFIG_CALC_DEBUG: + if (vp->v_type != V_NUM) { + math_error("Non numeric for calc_debug"); + /*NOTREACHED*/ + } + q = vp->v_num; + temp = qtoi(q); + if (qisfrac(q) || !zistiny(q->num)) { + math_error("Illegal calc_debug parameter value"); + /*NOTREACHED*/ + } + conf->calc_debug = temp; + break; + + case CONFIG_USER_DEBUG: + if (vp->v_type != V_NUM) { + math_error("Non numeric for user_debug"); + /*NOTREACHED*/ + } + q = vp->v_num; + temp = qtoi(q); + if (qisfrac(q) || !zistiny(q->num)) { + math_error("Illegal user_debug parameter value"); + /*NOTREACHED*/ + } + conf->user_debug = temp; break; default: @@ -676,7 +862,7 @@ setconfig(int type, VALUE *vp) * src copy this configuration * * returns: - * prointer to the configuration copy + * pointer to the configuration copy */ CONFIG * config_copy(CONFIG *src) @@ -747,7 +933,7 @@ config_free(CONFIG *cfg) } /* - * free prointer values + * free pointer values */ if (cfg->epsilon != NULL) { qfree(cfg->epsilon); @@ -812,8 +998,7 @@ config_value(CONFIG *cfg, int type, VALUE *vp) case CONFIG_MODE: vp->v_type = V_STR; - vp->v_subtype = V_STRLITERAL; - vp->v_str = modename(cfg->outmode); + vp->v_str = makenewstring(modename(cfg->outmode)); return; case CONFIG_EPSILON: @@ -892,24 +1077,46 @@ config_value(CONFIG *cfg, int type, VALUE *vp) i = cfg->fullzero; break; - case CONFIG_MAXERR: - i = cfg->maxerrorcount; + case CONFIG_MAXSCAN: + i = cfg->maxscancount; break; case CONFIG_PROMPT: vp->v_type = V_STR; - vp->v_subtype = V_STRLITERAL; - vp->v_str = cfg->prompt1; + vp->v_str = makenewstring(cfg->prompt1); return; case CONFIG_MORE: vp->v_type = V_STR; - vp->v_subtype = V_STRLITERAL; - vp->v_str = cfg->prompt2; + vp->v_str = makenewstring(cfg->prompt2); return; - case CONFIG_RANDOM: - i = cfg->random; + case CONFIG_BLKMAXPRINT: + i = cfg->blkmaxprint; + break; + + case CONFIG_BLKVERBOSE: + i = cfg->blkverbose; + break; + + case CONFIG_BLKBASE: + i = cfg->blkbase; + break; + + case CONFIG_BLKFMT: + i = cfg->blkfmt; + break; + + case CONFIG_LIB_DEBUG: + i = cfg->lib_debug; + break; + + case CONFIG_CALC_DEBUG: + i = cfg->calc_debug; + break; + + case CONFIG_USER_DEBUG: + i = cfg->user_debug; break; default: @@ -978,8 +1185,14 @@ config_cmp(CONFIG *cfg1, CONFIG *cfg2) cfg1->round != cfg2->round || cfg1->leadzero != cfg2->leadzero || cfg1->fullzero != cfg2->fullzero || - cfg1->maxerrorcount != cfg2->maxerrorcount || + cfg1->maxscancount != cfg2->maxscancount || strcmp(cfg1->prompt1, cfg2->prompt1) != 0 || strcmp(cfg1->prompt2, cfg2->prompt2) != 0 || - cfg1->random != cfg2->random; + cfg1->blkmaxprint != cfg2->blkmaxprint || + cfg1->blkverbose != cfg2->blkverbose || + cfg1->blkbase != cfg2->blkbase || + cfg1->blkfmt != cfg2->blkfmt || + cfg1->lib_debug != cfg2->lib_debug || + cfg1->calc_debug != cfg2->calc_debug || + cfg1->user_debug != cfg2->user_debug; } diff --git a/config.h b/config.h index c44be3c..920e940 100644 --- a/config.h +++ b/config.h @@ -1,5 +1,5 @@ /* - * 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, @@ -36,9 +36,12 @@ * chongo was here /\../\ */ -#if !defined(CONFIG_H) -#define CONFIG_H +#if !defined(__CONFIG_H__) +#define __CONFIG_H__ + + +#include "nametype.h" #include "qmath.h" @@ -69,10 +72,16 @@ #define CONFIG_ROUND 20 #define CONFIG_LEADZERO 21 #define CONFIG_FULLZERO 22 -#define CONFIG_MAXERR 23 +#define CONFIG_MAXSCAN 23 #define CONFIG_PROMPT 24 #define CONFIG_MORE 25 -#define CONFIG_RANDOM 26 +#define CONFIG_BLKMAXPRINT 26 +#define CONFIG_BLKVERBOSE 27 +#define CONFIG_BLKBASE 28 +#define CONFIG_BLKFMT 29 +#define CONFIG_LIB_DEBUG 30 +#define CONFIG_CALC_DEBUG 31 +#define CONFIG_USER_DEBUG 32 /* @@ -84,11 +93,19 @@ #define NEW_EPSILON_DEFAULT "1e-10" /* newstd EPSILON_DEFAULT */ #define NEW_EPSILONPREC_DEFAULT 34 /* 34 ==> 2^-34 <= 1e-10 < 2^-33 */ #define MAXPRINT_DEFAULT 16 /* default number of elements printed */ -#define MAXERRORCOUNT 20 /* default max errors before an abort */ +#define MAXSCANCOUNT 20 /* default max scan errors before an abort */ + +#define ERRMAX 20 /* default errmax value */ /* * configuration object + * + * If you add elements to this structure, you need to also update: + * + * quickhash.c - config_hash() + * hash.c - hash_value() + * config.c - setconfig(), config_value(), config_cmp() */ struct config { int outmode; /* current output mode */ @@ -113,11 +130,17 @@ struct config { long outround; /* output default rounding mode */ long round; /* round()/bround() default rounding mode */ int leadzero; /* ok to print leading 0 before decimal pt */ - int fullzero; /* ok to print trailing 0's -- XXX ??? */ - long maxerrorcount; /* max errors before abort */ + int fullzero; /* ok to print trailing 0's */ + long maxscancount; /* max scan errors before abort */ char *prompt1; /* normal prompt */ char *prompt2; /* prompt when inside multi-line input */ - int random; /* random mode */ + int blkmaxprint; /* octets of a block to print, 0 => all */ + int blkverbose; /* TRUE => print all lines if a block */ + int blkbase; /* block output base */ + int blkfmt; /* block output style */ + int lib_debug; /* library debug: <0 none, 0 default, >0 more */ + int calc_debug; /* internal debug: <0 none, 0 default,>0 more */ + int user_debug; /* user defined debug value: 0 default */ }; typedef struct config CONFIG; @@ -131,13 +154,14 @@ extern CONFIG newstd; /* new non-backward compatible configuration */ /* - * configuration functions + * configuration externals */ extern CONFIG *config_copy(CONFIG *src); extern void config_free(CONFIG *cfg); extern void config_print(CONFIG *cfg); -extern BOOL config_cmp(CONFIG *cfg1, CONFIG *cfg2); -extern int configtype(char *name); +extern int configtype(char*); +extern void config_print(CONFIG*); +extern BOOL config_cmp(CONFIG*, CONFIG*); -#endif +#endif /* !__CONFIG_H__ */ diff --git a/const.c b/const.c index dfa24ab..28ca771 100644 --- a/const.c +++ b/const.c @@ -1,27 +1,44 @@ /* - * Copyright (c) 1993 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. * * Constant number storage module. */ +#include #include "calc.h" +#include "qmath.h" #define CONSTALLOCSIZE 400 /* number of constants to allocate */ - static long constcount; /* number of constants defined */ static long constavail; /* number of constants available */ static NUMBER **consttable; /* table of constants */ +void +initconstants(void) +{ + int i; + + consttable = (NUMBER **) malloc(sizeof(NUMBER *) * CONSTALLOCSIZE); + if (consttable == NULL) { + math_error("Unable to allocate constant table"); + /*NOTREACHED*/ + } + for (i = 0; i < 8; i++) + consttable[i] = initnumbs[i]; + constcount = 8; + constavail = CONSTALLOCSIZE - 8; +} + + /* - * Read in a constant number and add it to the table of constant numbers, + * Read in a literal real number and add it to the table of constant numbers, * creating a new entry if necessary. The incoming number is a string - * value which must have a correct format, otherwise an undefined number - * will result. Returns the index of the number in the constant table. - * Returns zero if the number could not be saved. + * value which must have a correct format. + * Returns the index of the number in the constant table. * * given: * str string representation of number @@ -32,8 +49,6 @@ addnumber(char *str) NUMBER *q; q = str2q(str); - if (q == NULL) - return 0; return addqconstant(q); } @@ -59,14 +74,53 @@ addqconstant(NUMBER *q) long denlen; /* denominator length */ HALF numlow; /* bottom value of numerator */ HALF denlow; /* bottom value of denominator */ + long first; /* first non-null position found */ + BOOL havefirst; + if (constavail <= 0) { + if (consttable == NULL) { + initconstants(); + } else { + tp = (NUMBER **) realloc((char *) consttable, + sizeof(NUMBER *) * (constcount + CONSTALLOCSIZE)); + if (tp == NULL) { + math_error("Unable to reallocate const table"); + /*NOTREACHED*/ + } + consttable = tp; + constavail = CONSTALLOCSIZE; + } + } numlen = q->num.len; denlen = q->den.len; numlow = q->num.v[0]; denlow = q->den.v[0]; - tp = &consttable[1]; - for (index = 1; index <= constcount; index++) { - t = *tp++; + first = 0; + havefirst = FALSE; + tp = consttable; + for (index = 0; index < constcount; index++, tp++) { + t = *tp; + if (t->links == 0) { + if (!havefirst) { + havefirst = TRUE; + first = index; + } + continue; + } + if (q == t) { + if (q->links == 1) { + if (havefirst) { + *tp = consttable[first]; + consttable[first] = q; + } else { + havefirst = TRUE; + first = index; + } + continue; + } + return index; + } + if ((numlen != t->num.len) || (numlow != t->num.v[0])) continue; if ((denlen != t->den.len) || (denlow != t->den.v[0])) @@ -74,40 +128,95 @@ addqconstant(NUMBER *q) if (q->num.sign != t->num.sign) continue; if (qcmp(q, t) == 0) { + t->links++; qfree(q); return index; } } - if (constavail <= 0) { - if (consttable == NULL) { - tp = (NUMBER **) - malloc(sizeof(NUMBER *) * (CONSTALLOCSIZE + 1)); - *tp = NULL; - } else - tp = (NUMBER **) realloc((char *) consttable, - sizeof(NUMBER *) * (constcount+CONSTALLOCSIZE + 1)); - if (tp == NULL) - return 0; - consttable = tp; - constavail = CONSTALLOCSIZE; + if (havefirst) { + consttable[first] = q; + return first; } constavail--; - constcount++; - consttable[constcount] = q; - return constcount; + consttable[constcount++] = q; + return index; } /* * Return the value of a constant number given its index. - * Returns address of the number, or NULL if the index is illegal. + * Returns address of the number, or NULL if the index is illegal + * or points to freed position. */ NUMBER * constvalue(unsigned long index) { - if ((index <= 0) || (index > constcount)) - return NULL; + if (index >= constcount) { + math_error("Bad index value for constvalue"); + /*NOTREACHED*/ + } + if (consttable[index]->links == 0) { + math_error("Constvalue has been freed!!!"); + /*NOTREACHED*/ + } return consttable[index]; } + +void +freeconstant(unsigned long index) +{ + NUMBER *q; + + if (index >= constcount) { + math_error("Bad index value for freeconst"); + /*NOTREACHED*/ + } + q = consttable[index]; + if (q->links == 0) { + math_error("Attempting to free freed const location"); + /*NOTREACHED*/ + } + qfree(q); + if (index == constcount - 1) { + trimconstants(); + } +} + + +void +trimconstants(void) +{ + NUMBER **qp; + + qp = &consttable[constcount]; + while (constcount > 0 && (*--qp)->links == 0) { + constcount--; + constavail++; + } +} + +void +showconstants(void) +{ + long index; + NUMBER **qp; + long count; + + qp = consttable; + count = 0; + for (index = 0; index < constcount; index++, qp++) { + if ((*qp)->links) { + if (!count) { + printf("\n Index Links Value\n"); + } + count++; + printf("\n%8ld%8ld ", index, (*qp)->links); + fitprint(*qp, 40); + } + } + printf("\n\nNumber = %ld\n", count); +} + + /* END CODE */ diff --git a/custom.c b/custom.c new file mode 100644 index 0000000..d0e3ff8 --- /dev/null +++ b/custom.c @@ -0,0 +1,220 @@ +/* + * 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, + * provided that the above copyright, this permission notice and text + * this comment, 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. + * + * Comments, suggestions, bug fixes and questions about these routines + * are welcome. Send EMail to the address given below. + * + * Happy bit twiddling, + * + * Landon Curt Noll + * + * chongo@toad.com + * ...!{pyramid,sun,uunet}!hoptoad!chongo + * + * chongo was here /\../\ + */ + +/* these include files are needed regardless of CUSTOM */ +#include "have_const.h" +#include "value.h" +#include "custom.h" + + +#if defined(CUSTOM) + +#include + +#include "calc.h" + +#include "have_string.h" +#ifdef HAVE_STRING_H +# include +#endif + +#else /* CUSTOM */ + +#include "config.h" + +#endif /* CUSTOM */ + +int allow_custom = FALSE; /* TRUE => custom builtins allowed */ + + +/* + * custom - custom callout function + */ +/*ARGSUSED*/ +VALUE +custom(char *name, int count, VALUE **vals) +{ +#if defined(CUSTOM) + + CONST struct custom *p; /* current function */ + + /* + * search the custom interface table for a function + */ + for (p = cust; p->name != NULL; ++p) { + + /* look for the first match */ + if (strcmp(name, p->name) == 0) { + + /* arg count check */ + if (count < p->minargs) { + math_error("Too few arguments for custom " + "function \"%s\"", p->name); + /*NOTREACHED*/ + } + if (count > p->maxargs) { + math_error("Too many arguments for custom " + "function \"%s\"", p->name); + /*NOTREACHED*/ + } + + /* call the custom function */ + return p->func(name, count, vals); + } + } + + /* + * no such custom function + */ + return error_value(E_UNK_CUSTOM); + +#else /* CUSTOM */ + + fprintf(stderr, + "%sCalc was built with custom functions disabled\n", + (conf->tab_ok ? "\t" : "")); + return error_value(E_NO_CUSTOM); + +#endif /* CUSTOM */ +} + + +/* + * showcustom - display the names and brief descriptins of custom functions + */ +/*ARGSUSED*/ +void +showcustom(void) +{ +#if defined(CUSTOM) + + CONST struct custom *p; /* current function */ + + /* + * disable custom functions unless -C was given + */ + if (!allow_custom) { + fprintf(stderr, + "%sCalc must be run with a -C argument to " + "show custom functions\n", + (conf->tab_ok ? "\t" : "")); + return; + } + + /* + * print header + */ + printf("\nName\tArgs\tDescription\n\n"); + for (p = cust; p->name != NULL; ++p) { + printf("%-9s ", p->name); + if (p->maxargs == MAX_CUSTOM_ARGS) + printf("%d+ ", p->minargs); + else if (p->minargs == p->maxargs) + printf("%-6d", p->minargs); + else + printf("%d-%-4d", p->minargs, p->maxargs); + printf("%s\n", p->desc); + } + printf("\n"); + +#else /* CUSTOM */ + + fprintf(stderr, + "%sCalc was built with custom functions disabled\n", + (conf->tab_ok ? "\t" : "")); + +#endif /* CUSTOM */ +} + + +/* + * customhelp - standard help interface to a custom function + * + * This function assumes that a help file with the same name as + * the custom function has been installed by the custom/Makefile + * (as listed in the CUSTOM_HELP makefile variable) under the + * CUSTOMHELPDIR == HELPDIR/custhelp directory. + * + * The help command first does a search in HELPDIR and later + * in CUSTOMHELPDIR. If a custom help file has the same name + * as a file under HELPDIR then help will display the HELPDIR + * file and NOT the custom file. This function will ignore + * and HELPDIR file and work directly with the custom help file. + * + * given: + * name name of the custom help file to directly access + */ +/*ARGSUSED*/ +void +customhelp(char *name) +{ +#if defined(CUSTOM) + + char *customname; /* a string of the form: custom/name */ + + /* + * firewall + */ + if (name == NULL) { + name = "help"; + } + + /* + * form the custom help name + */ + customname = (char *)malloc(sizeof("custhelp")+strlen(name)+1); + if (customname == NULL) { + math_error("bad malloc of customname"); + /*NOTREACHED*/ + } + sprintf(customname, "custhelp/%s", name); + + /* + * give help directly to the custom file + */ + givehelp(customname); + + /* + * all done + */ + free(customname); + +#else /* CUSTOM */ + + fprintf(stderr, + "%sCalc was built with custom functions disabled\n", + (conf->tab_ok ? "\t" : "")); + +#endif /* CUSTOM */ +} diff --git a/custom.h b/custom.h new file mode 100644 index 0000000..a8384b6 --- /dev/null +++ b/custom.h @@ -0,0 +1,89 @@ +/* + * 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, + * provided that the above copyright, this permission notice and text + * this comment, 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. + * + * Prior to calc 2.9.3t9, these routines existed as a calc library called + * cryrand.cal. They have been rewritten in C for performance as well + * as to make them available directly from libcalc.a. + * + * Comments, suggestions, bug fixes and questions about these routines + * are welcome. Send EMail to the address given below. + * + * Happy bit twiddling, + * + * Landon Curt Noll + * + * chongo@toad.com + * ...!{pyramid,sun,uunet}!hoptoad!chongo + * + * chongo was here /\../\ + */ + + +/* + * Be careful what you put in this file, upper .c files include + * this file even when CUSTOM is not defined (ALLOW_CUSTOM is empty). + * + * Don't include anything, let the including .c file bring in: + * + * have_const.h + * value.h + * + * before they include this file. + * + * Keep this file down to a minimum. Don't put custom builtin funcion + * stuff in this file! + */ + + +#if !defined(CUSTOM_H) +#define CUSTOM_H + + +/* + * arg count definitons + */ +#define MAX_CUSTOM_ARGS 100 /* maximum number of custom arguments */ + + +/* + * custom function interface + */ +struct custom { + char *name; /* name of the custom builtin */ + char *desc; /* very brief description of custom builtin */ + short minargs; /* minimum number of arguments */ + short maxargs; /* maximum number of arguments */ + VALUE (*func)(char *name, int argc, VALUE **argv); /* custom func */ +}; + + +/* + * external declarations + * + * These are the required interfaces. The dummy.c stubs these interfaces too. + */ +extern VALUE custom(char*, int, VALUE**); /* master custom interface */ +extern int allow_custom; /* TRUE => custom builtins allowed */ +extern void showcustom(void); /* print custom functions */ +extern void customhelp(char *); /* direct custom help */ +extern CONST struct custom cust[]; /* custom interface table */ + +#endif /* !CUSTOM_H */ diff --git a/custom/CUSTOM_CAL b/custom/CUSTOM_CAL new file mode 100644 index 0000000..2504d9c --- /dev/null +++ b/custom/CUSTOM_CAL @@ -0,0 +1,51 @@ +# +# 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, +# provided that the above copyright, this permission notice and text +# this comment, 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. +# +# chongo was here /\../\ chongo@toad.com + +The following custom calc library files are provided because they serve +as examples of how use the custom interface. The custom interface +allows for machine dependent and/or non-portable code to be added as +builtins to the calc program. A few example custom functions and +library files are shipped with calc to provide you with examples. + +By default, the custom builtin returns an error. Calc have been +built with: + + ALLOW_CUSTOM= -DCUSTOM + +in the top level Makefile (this is the shipped default) and calc +must be invoked with a -C argument: + + calc -C + +when it is run. + +See the ../lib/README or "help stdlib" for information about +calc library standards and guidelines. + +=-= + +halflen.cal + + halflen(num) + + Calculate the length of a numeric value in HALF's. diff --git a/custom/HOW_TO_ADD b/custom/HOW_TO_ADD new file mode 100644 index 0000000..318e6e7 --- /dev/null +++ b/custom/HOW_TO_ADD @@ -0,0 +1,606 @@ +Guidelines for adding custom functions + +Step 0: Determine if is should it be done? + + The main focus for calc is to provide a portable platform for + multi-precision calculations in a C-like environment. You should + consider implementing algorithms in the calc language as a first + choice. Sometimes an algorithm requires use of special hardware, a + non-portable OS or pre-compiled C library. In these cases a custom + interface may be needed. + + The custom function interface is intended to make is easy for + programmers to add functionality that would be otherwise + un-suitable for general distribution. Functions that are + non-portable (machine, hardware or OS dependent) or highly + specialized are possible candidates for custom functions. + + So before you go to step 1, ask yourself: + + + Can I implement this as a calc library script? + + If Yes, write the script and be done with it. + If No, continue to the next question ... + + + Does it require the use of non-portable features, + OS specific support or special hardware? + + If No, write it as a regular builtin function. + If Yes, continue to step 1 ... + + +Step 1: Do some background work + + First ... read this file ALL THE WAY THROUGH before implementing + anything in Steps 2 and beyond! + + If you are not familiar with calc internals, we recommend that + you look at some examples of custom functions. Check out + the following source files: + + ../custom.c + custom.h + custtbl.c + c_*.[ch] + ../help/custom + + You would be well advised to look at a more recent calc source + such as one available in from the calc alpha test archive. + See the following for more details: + + ../help/archive + + +Step 2: Name your custom function + + We suggest that you pick a name that does not conflict with + one of the builtin names. It makes it easier to get help + via the help interface and avoid confusion down the road. + + You should avoid picking a name that matches a file or + directory name under ${HELPDIR} as well. Not all help + files are associated with builtin function names. + + For purposes of this file, we will use the name 'curds' + as our example custom function name. + + +Step 3: Document your custom function + + No this step is NOT out of order. We recommend that you write the + help file associated with your new custom function EARLY. By + experience we have found that the small amount of effort made to + write "how the custom function will be used" into a help file pays + off in a big way when it comes to coding. Often the effort of + writing a help file will clarify fuzzy aspects of your design. + Besides, unless you write the help file first, it will likely never + be written later on. :-( + + OK ... we will stop preaching now ... + + [[ From now on we will give filenames relative to the custom directory ]] + + Take a look at one of the example custom help files: + + devnull + argv + help + sysinfo + + You can save time by using one of the custom help files + as a template. Copy one of these files to your own help file: + + cp sysinfo curds + + and edit it accordingly. + + +Step 4: Write your test code + + No this step is NOT out of order either. We recommend that you + write a simple calc script that will call your custom function and + check the results. + + This script will be useful while you are debugging your code. In + addition, if you wish to submit your code for distribution, this + test code will be an import part of your submission. Your test + code will also service as additional for your custom function. + + Coops ... we said we would stop preaching, sorry about that ... + + You can use one of the following as a template: + + argv.cal + halflen.cal + + Copy one of these to your own file: + + cp halflen.cal curds.cal + + and exit it accordingly. In particular you will want to: + + remove our header disclaimer (or put your own on) + + change the name from halflen() to curds() + + change the comment from 'halflen - determine the length ...' to + 'curds - brief description about ...' + + change the print statement near the very bottom from: + + print "halflen(num) defined"; + + to: + + print "curds( ... args description here ...) defined"; + + +Step 5: Write your custom function + + By convention, the files we ship that contain custom function + interface code in filenames of the form: + + c_*.c + + We suggest that you use filenames of the form: + + u_*.c + + to avoid filename conflicts. + + We recommend that you use one of the c_*.c files as a template. + Copy an appropriate file to your file: + + cp c_argv.c u_curds.c + + Before you edit it, you should note that there are several important + features of this file. + + a) All of the code in the file is found between #if ... #endif: + + /* + * only comments and blank lines at the top + */ + + #if defined(CUSTOM) + + ... all code, #includes, #defines etc. + + #endif /* CUSTOM */ + + This allows this code to 'go away' when the upper Makefile + disables the custom code (because ALLOW_CUSTOM no longer + has the -DCUSTOM define). + + b) The function type must be: + + /*ARGSUSED*/ + VALUE + u_curds(char *name, int count, VALUE **vals) + + The /*ARGSUSED*/ may be needed if you do not make use + of all 3 function parameters. + + The 3 args are passed in by the custom interface + and have the following meaning: + + name The name of the custom function that + was called. In particular, this is the first + string arg that was given to the custom() + builtin. This is the equivalent of argv[0] for + main() in C programming. + + The same code can be used for multiple custom + functions by processing off of this value. + + count This is the number of additional args that + was given to the custom() builtin. Note + that count does NOT include the name arg. + This is similar to argc except that count + is one less than the main() argc interface. + + For example, a call of: + + custom("curds", a, b, c) + + would cause count to be passed as 3. + + vals This is a pointer to an array of VALUEs. + This is the equivalent of argv+1 for + main() in C programming. The difference + here is that vals[0] refers to the 1st + parameter AFTER the same. + + For example, a call of: + + custom("curds", a, b, c) + + would cause vals to point to the following array: + + vals[0] points to a + vals[1] points to b + vals[2] points to c + + c) The return value is the function must be a VALUE. + + The typical way to form a VALUE to return is by declaring + the following local variable: + + VALUE result; /* what we will return */ + + d) You will need to include: + + #if defined(CUSTOM) + + /* any #include here */ + + #include "../have_const.h" + #include "../value.h" + #include "custom.h" + + Typically these will be included just below any system + includes and just below the #if defined(CUSTOM) line. + + To better understand the VALUE type, read: + + ../value.h + + The VALUE is a union of major value types found inside calc. + The v_type VALUE element determines which union element is + being used. Assume that we have: + + VALUE *vp; + + Then the value is determined according to v_type: + + vp->v_type the value is which is a type defined in + ---------- ------------ ---------- --------------- + V_NULL (none) n/a n/a + V_INT vp->v_int long n/a + V_NUM vp->v_num NUMBER * ../qmath.h + V_COM vp->v_com COMPLEX * ../cmath.h + V_ADDR vp->v_addr VALUE * ../value.h + V_STR vp->v_str char * n/a + V_MAT vp->v_mat MATRIX * ../value.h + V_LIST vp->v_list LIST * ../value.h + V_ASSOC vp->v_assoc ASSOC * ../value.h + V_OBJ vp->v_obj OBJECT * ../value.h + V_FILE vp->v_file FILEID ../value.h + V_RAND vp->v_rand RAND * ../zrand.h + V_RANDOM vp->v_random RANDOM * ../zrandom.h + V_CONFIG vp->v_config CONFIG * ../config.h + V_HASH vp->v_hash HASH * ../hash.h + V_BLOCK vp->v_block BLOCK * ../block.h + + The V_OCTET is under review and should not be used at this time. + + There are a number of macros that may be used to determine + information about the numerical values (ZVALUE, NUMBER and COMPLEX). + you might also want to read the following to understand + some of the numerical types of ZVALUE, NUMBER and COMPLEX: + + ../zmath.h + ../qmath.h + ../cmath.h + + While we cannot go into full detail here are some cookbook + code for manipulating VALUEs. For these examples assume + that we will manipulate the return value: + + VALUE result; /* what we will return */ + + To return NULL: + + result.v_type = V_NULL; + return result; + + To return a long you need to convert it to a NUMBER: + + long variable; + + result.v_type = V_NUM; + result.v_num = itoq(variable); /* see ../qmath.c */ + return result; + + To return a FULL you need to convert it to a NUMBER: + + FULL variable; + + result.v_type = V_NUM; + result.v_num = utoq(variable); /* see ../qmath.c */ + return result; + + To convert a ZVALUE to a NUMBER*: + + ZVALUE variable; + + result.v_type = V_NUM; + result.v_num = qalloc(); /* see ../qmath.c */ + result.v_num->num = variable; + return result; + + To convert a small NUMBER* into a long: + + NUMBER *num; + long variable; + + variable = qtoi(num); + + To obtain a ZVALUE from a NUMBER*, extract the numerator: + + NUMBER *num; + ZVALUE z_variable; + + if (qisint(num)) { + z_variable = num->num; + } + + To be sure that the value will fit, use the ZVALUE test macros: + + ZVALUE z_num; + long variable; + unsigned long u_variable; + FULL f_variable; + short very_tiny_variable; + + if (zgtmaxlong(z_num)) { /* see ../zmath.h */ + variable = ztolong(z_num); + } + if (zgtmaxulong(z_num)) { + u_variable = ztoulong(z_num); + } + if (zgtmaxufull(z_num)) { + f_variable = ztofull(z_num); + } + if (zistiny(z_num)) { + very_tiny_variable = z1tol(z_num); + } + + +Step 6: Register the function in the custom interface table + + To allow the custom() builtin to transfer control to your function, + you need to add an entry into the CONST struct custom cust table + found in custtbl.c: + + /* + * custom interface table + * + * The order of the elements in struct custom are: + * + * { "xyz", "brief description of the xyz custom function", + * minimum_args, maximum_args, c_xyz }, + * + * where: + * + * minimum_args an int >= 0 + * maximum_args an int >= minimum_args and <= MAX_CUSTOM_ARGS + * + * Use MAX_CUSTOM_ARGS for maximum_args is the maximum number of args + * is potentially 'unlimited'. + * + * If the brief description cannot fit on the same line as the name + * without wrapping on a 80 col window, the description is probably + * too long and will not look nice in the show custom output. + */ + CONST struct custom cust[] = { + + #if defined(CUSTOM) + + + /* + * add your own custom functions here + * + * We suggest that you sort the entries below by name + * so that show custom will produce a nice sorted list. + */ + + { "argv", "information about its args, returns arg count", + 0, MAX_CUSTOM_ARGS, c_argv }, + + { "devnull", "does nothing", + 0, MAX_CUSTOM_ARGS, c_devnull }, + + { "help", "help for custom functions", + 1, 1, c_help }, + + { "sysinfo", "return a calc #define value", + 0, 1, c_sysinfo }, + + + #endif /* CUSTOM */ + + /* + * This must be at the end of this table!!! + */ + {NULL, NULL, + 0, 0, NULL} + }; + + The definition of struct custom may be found in custom.h. + + It is important that your entry be placed inside the: + + #if defined(CUSTOM) ... #endif /* CUSTOM */ + + lines so that when the custom interface is disabled by the upper + level Makefile, one does not have unsatisfied symbols. + + The brief description should be brief so that 'show custom' looks well + formatted. If the brief description cannot fit on the same line as + the name without wrapping on a 80 col window, the description is + probably too long and will not look nice in the show custom output. + + The minargs places a lower bound on the number of args that + must be supplied to the interface. This does NOT count + the name argument given to custom(). So if minargs is 2: + + custom("curds") /* call blocked at high level interface */ + custom("curds", a) /* call blocked at high level interface */ + custom("curds", a, b) /* call passed down to "curds" interface */ + + The maxargs sets a limit on the number of args that may be passed. + If minargs == maxargs, then the call requires a fixed number of + argument. There is a upper limit on the number of args. If + one wants an effectively unlimited upper bound, use MAX_CUSTOM_ARGS. + + Note that one must have: + + 0 <= minargs <= maxargs <= MAX_CUSTOM_ARGS + + To allow the curds function to take at least 2 args and up + to 5 args, one would add the following entry to cust[]: + + { "curds", "brief description about curds interface", + 2, 5, u_curds }, + + It is recommended that the cust[] remain in alphabetical order, + so one would place it before the "devnull" and after "argv". + + Last, you must forward declare the u_curds near the top of the file: + + #if defined(CUSTOM) + + + /* + * add your forward custom function declarations here + * + * Declare custom functions as follows: + * + * extern VALUE c_xyz(char*, int, VALUE**); + * + * We suggest that you sort the entries below by name. + */ + extern VALUE c_argv(char*, int, VALUE**); + extern VALUE c_devnull(char*, int, VALUE**); + extern VALUE c_help(char*, int, VALUE**); + extern VALUE c_sysinfo(char*, int, VALUE**); + + For u_curds we would add the line: + + extern VALUE u_curds(char*, int, VALUE**); + + +Step 7: Add the required information to the Makefile + + The calc test script, curds.cal, should be added to the + CUSTOM_CALC_FILES Makefile variable: + + CUSTOM_CALC_FILES= argv.cal halflen.cal curds.cal + + The help file, curds, should be added to the CUSTOM_HELP + Makefile variable: + + CUSTOM_HELP= argv devnull help sysinfo curds + + If you needed to create any .h files to support u_curds.c, these + files should be added to the CUSTOM_H_SRC Makefile variable: + + CUSTOM_H_SRC= u_curds.h otherfile.h + + Your u_curds.c file MUST be added to the CUSTOM_SRC Makefile variable: + + CUSTOM_SRC= c_argv.c c_devnull.c c_help.c c_sysinfo.c u_curds.c + + and so must the associated .o file: + + CUSTOM_OBJ= c_argv.o c_devnull.o c_help.o c_sysinfo.o u_curds.o + + +Step 8: Compile and link in your code + + If your calc was not previously setup to compile custom code, + you should set it up now. The upper level Makefile (and + the custom Makefile) should have the following Makefile + variable defined: + + ALLOW_CUSTOM= -DCUSTOM + + It is recommended that you build your code from the top level + Makefile. It saves having to sync the other Makefile values. + To try and build the new libcustcalc.a that contains u_curds.c: + + (cd ..; make custom/libcustcalc.a) + + Fix any compile and syntax errors as needed. :-) + + Once libcustcalc.a successfully builds, compile calc: + + cd .. + make calc + + And check to be sure that the regression test suite still + works without errors: + + make check + + +Step 9: Add the Make dependency tools + + You should probably add the dependency lines to the bottom of + the Makefile. Given the required include files, you will at least + have the following entries placed at the bottom of the Makefile: + + u_curds.o: ../alloc.h + u_curds.o: ../block.h + u_curds.o: ../byteswap.h + u_curds.o: ../calcerr.h + u_curds.o: ../cmath.h + u_curds.o: ../config.h + u_curds.o: ../endian_calc.h + u_curds.o: ../hash.h + u_curds.o: ../have_const.h + u_curds.o: ../have_malloc.h + u_curds.o: ../have_newstr.h + u_curds.o: ../have_stdlib.h + u_curds.o: ../have_string.h + u_curds.o: ../longbits.h + u_curds.o: ../nametype.h + u_curds.o: ../qmath.h + u_curds.o: ../shs.h + u_curds.o: ../value.h + u_curds.o: ../zmath.h + u_curds.o: u_curds.c + u_curds.o: ../custom.h + + If you have the makedepend tool from the X11 development environment + (by Todd Brunhoff, Tektronix, Inc. and MIT Project Athena), you can + use the following to update your dependencies: + + # cd to the top level calc directory if you are not there already + + rm -f Makefile.bak custom/Makefile.bak + make depend + + diff -c Makefile.bak Makefile # look at the changes + diff -c custom/Makefile.bak custom/Makefile # look at the changes + + rm -f Makefile.bak custom/Makefile.bak # cleanup + +Step 10: Test + + Now that you have built calc with your new custom function, test it: + + ./calc -C # run the new calc with the -C arg + + And then try out our test suite: + + C-style arbitrary precision calculator (version 2.10.3t5.1) + [Type "exit" to exit, or "help" for help.] + + > read custom/curds.cal + curds(a, b, [c, d, e]) defined + + > custom("curds", 2, 3, 4) + + +Step 11: Install + + Once you are satisfied that everything works, install the new code: + + # cd to the top level calc directory if you are not there already + + make install + + Although calc does not run setuid, you may need to be root to install + the directories into which calc installs may be write protected. diff --git a/custom/Makefile b/custom/Makefile new file mode 100644 index 0000000..9b2be67 --- /dev/null +++ b/custom/Makefile @@ -0,0 +1,649 @@ +# +# custom - makefile for calc custom routines +# +# 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, +# provided that the above copyright, this permission notice and text +# this comment, 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. +# +# Comments, suggestions, bug fixes and questions about these routines +# are welcome. Send EMail to the address given below. +# +# Happy bit twiddling, +# +# Landon Curt Noll +# +# chongo@toad.com +# ...!{pyramid,sun,uunet}!hoptoad!chongo +# +# chongo was here /\../\ + +############################################################################## +#-=-=-=-=-=-=-=-=- You may want to change some values below -=-=-=-=-=-=-=-=-# +############################################################################## + +# The custom calc library files to install +# +# Put your custom calc library files here. +# +CUSTOM_CALC_FILES= argv.cal halflen.cal + +# The custom help files to install +# +# Put your custom help files here. +# +CUSTOM_HELP= argv devnull help sysinfo + +# Any .h files that are needed by programs that use libcustcalc.a +# +# Put any .h files that you add which might be useful to other +# programs here. +# +CUSTOM_H_SRC= + +# Any .c files that are needed to build libcustcalc.a. +# Don't put ${REQUIRED_SRC} files in this list. +# +# There MUST be a .c in CUSTOM_SRC for every .o in CUSTOM_OBJ. +# +# Put your custom .c files here. +# +CUSTOM_SRC= c_argv.c c_devnull.c c_help.c c_sysinfo.c + +# Any .o files that are needed by program that use libcustcalc.a. +# Don't put ${REQUIRED_OBJ} files in this list. +# +# There MUST be a .c in CUSTOM_SRC for every .o in CUSTOM_OBJ. +# +# Put your custom .o files here. +# +CUSTOM_OBJ= c_argv.o c_devnull.o c_help.o c_sysinfo.o + +############################################################################## +#-=-=-=-=-=-=- Defaults in case you want to build from this dir -=-=-=-=-=-=-# +############################################################################## + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# Makefile debug +# +# Q=@ do not echo internal makefile actions (quiet mode) +# Q= echo internal makefile actions (debug / verbose mode) +# +#Q= +Q=@ + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# where to install things +# +# ${TOPDIR} is the directory under which the calc directory will be placed. +# ${LIBDIR} is where the *.cal, *.h, *.a, bindings and help dir are installed. +# ${HELPDIR} is where the help directory is installed. +# ${CUSTOMLIBDIR} is where custom lib files are installed. +# ${CUSTOMHELPDIR} is where custom help files are installed. +# +TOPDIR= /usr/local/lib +#TOPDIR= /usr/lib +#TOPDIR= /usr/libdata +#TOPDIR= /usr/contrib/lib +# +LIBDIR= ${TOPDIR}/calc +HELPDIR= ${LIBDIR}/help +CUSTOMLIBDIR= ${LIBDIR}/custom +CUSTOMHELPDIR= ${HELPDIR}/custhelp + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# Debug/Optimize options for ${CC} +# +DEBUG= -O +#DEBUG= -O -g +#DEBUG= -O -g3 +#DEBUG= -O1 +#DEBUG= -O1 -g +#DEBUG= -O1 -g3 +#DEBUG= -O2 +#DEBUG= -O2 -g +#DEBUG= -O2 -g3 +#DEBUG= -O2 -ipa +#DEBUG= -O2 -g3 -ipa +#DEBUG= -O3 +#DEBUG= -O3 -g +#DEBUG= -O3 -g3 +#DEBUG= -O3 -ipa +#DEBUG= -O3 -g3 -ipa +#DEBUG= -g +#DEBUG= -g3 +#DEBUG= -gx +#DEBUG= -WM,-g +#DEBUG= + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# On systems that have dynamic shared libs, you may want want to disable them +# for faster calc startup. +# +# System type NO_SHARED recommendation +# +# BSD NO_SHARED= +# SYSV NO_SHARED= -dn +# IRIX NO_SHARED= -non_shared +# disable NO_SHARED= +# +# If in doubt, use NO_SHARED= +# +NO_SHARED= +#NO_SHARED= -dn +#NO_SHARED= -non_shared + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# Some systems require one to use ranlib to add a symbol table to +# a *.a library. Set RANLIB to the utility that performs this action. +# Set RANLIB to : if your system does not need such a utility. +# +#RANLIB=ranlib +RANLIB=: + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# Normally certain files depend on the Makefile. If the Makefile is +# changed, then certain steps should be redone. If MAKE_FILE is +# set to Makefile, then these files will depend on Makefile. If +# MAKE_FILE is empty, they they wont. +# +# If in doubt, set MAKE_FILE to Makefile +# +MAKE_FILE= Makefile +#MAKE_FILE= + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# If you do not wish to use purify, leave PURIFY commented out. +# +# If in doubt, leave PURIFY commented out. +# +#PURIFY= purify -logfile=pure.out +#PURIFY= purify + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# By default, custom builtin functions may only be executed if calc +# is given the -C option. This is because custom builtin functions +# may invoke non-standard or non-portable code. One may completely +# disable custom builtin functions by not compiling any of code +# +# ALLOW_CUSTOM= -DCUSTOM # allow custom only if -C is given +# ALLOW_CUSTOM= # disable custom even if -C is given +# +# If in doubt, use ALLOW_CUSTOM= -DCUSTOM +# +ALLOW_CUSTOM= -DCUSTOM +#ALLOW_CUSTOM= + +### +# +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# Select your compiler type by commenting out one of the cc sets below: +# +# CCOPT are flags given to ${CC} for optimization +# CCWARN are flags given to ${CC} for warning message control +# CCMISC are misc flags given to ${CC} +# +# CFLAGS are all flags given to ${CC} [[often includes CCOPT, CCWARN, CCMISC]] +# ICFLAGS are given to ${CC} for intermediate progs +# +# LCFLAGS are CC-style flags for ${LINT} +# LDFLAGS are flags given to ${CC} for linking .o files +# ILDFLAGS are flags given to ${CC} for linking .o files for intermediate progs +# +# CC is how the the C compiler is invoked +# +### +# +# common cc set +# +CCWARN= +CCOPT= ${DEBUG} ${NO_SHARED} +CCMISC= +# +CFLAGS= ${CCWARN} ${CCOPT} ${CCMISC} ${ALLOW_CUSTOM} +ICFLAGS= ${CCWARN} ${CCMISC} +# +LCFLAGS= +LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED} +ILDFLAGS= +# +CC= ${PURIFY} cc + +############################################################################## +#-=-=-=-=-=-=-=-=- Be careful if you change something below -=-=-=-=-=-=-=-=-# +############################################################################## + +# These .c files are required for the main custom interface and +# for the custom support functions. +# +# There MUST be a .c for every .o in REQUIRED_OBJ. +# +REQUIRED_SRC= custtbl.c + +# These .o files correspond to the .c files in REQUIRED_SRC +# +# There MUST be a .o for every .c in REQUIRED_SRC. +# +REQUIRED_OBJ= custtbl.o + +# These .h files are installed under ${CUSTOMLIBDIR} by the install rule. +# +INSTALL_H_SRC= ${CUSTOM_H_SRC} + +# These .c files are used to form libcustcalc.a. +# +CUSTCALC_SRC= ${REQUIRED_SRC} ${CUSTOM_SRC} + +# These .o files are used to form libcustcalc.a. +# +CUSTCALC_OBJ= ${REQUIRED_OBJ} ${CUSTOM_OBJ} + +# These .c files are used to build the dependency list +# +C_SRC= ${REQUIRED_SRC} ${CUSTOM_SRC} + +# These .h files are used to build the dependecy list +# +H_SRC= ${CUSTOM_H_SRC} + +# These files are found (but not built) in the distribution +# +# The CUSTOM_CAL and HOW_TO_ADD are files distributed from this +# directory but are installed as help files from the help/Makefile. +# +DISTLIST= ${CUSTCALC_SRC} ${CUSTOM_CALC_FILES} ${CUSTOM_HELP} \ + ${INSTALL_H_SRC} CUSTOM_CAL HOW_TO_ADD ${MAKE_FILE} + +# complete list of targets +# +TARGETS= libcustcalc.a ${CUSTCALC_OBJ} + +# required vars +# +SHELL = /bin/sh +SED= sed +MAKEDEPEND= makedepend +SORT= sort + +## +# +# Standard rules and targets +# +## + +all: ${TARGETS} ${INSTALL_H_SRC} ${CUSTOM_CALC_FILES} \ + ${CUSTOM_HELP} ${MAKE_FILE} .all + +libcustcalc.a: ${CUSTCALC_OBJ} ${MAKE_FILE} ../Makefile + -rm -f libcustcalc.a + ar qc libcustcalc.a ${CUSTCALC_OBJ} + ${RANLIB} libcustcalc.a + +## +# +# used by the upper level Makefile +# +## + +# to determine of we have done all +# +.all: + rm -f .all + touch .all + +## +# +# File list generation. You can ignore this section. +# +# +# We will form the names of source files as if they were in a +# sub-directory called calc/lib. +# +# NOTE: Due to bogus shells found on one common system we must have +# an non-emoty else clause for every if condition. *sigh* +# +## + +distlist: ${DISTLIST} + ${Q}for i in ${DISTLIST}; do \ + echo calc/custom/$$i; \ + done + +# The bsdi distribution has generated files as well as distributed files. +# +bsdilist: ${DISTLIST} + ${Q}for i in ${DISTLIST}; do \ + echo calc/custom/$$i; \ + done + +## +# +# Home grown make dependency rules. Your system make not support +# or have the needed tools. You can ignore this section. +# +# We will form a skelaton tree of *.c files containing only #include "foo.h" +# lines and .h files containing the same lines surrounded by multiple include +# prevention lines. This allows us to build a static depend list that will +# satisfy all possible cpp symbol definition combinations. +# +## + +depend: + ${Q}if [ -f Makefile.bak ]; then \ + echo "Makefile.bak exists, remove or move it out of the way"; \ + exit 1; \ + else \ + true; \ + fi + ${Q}echo forming custom/skel + -${Q}rm -rf skel + ${Q}mkdir skel + ${Q}mkdir skel/custom + -${Q}for i in ${C_SRC}; do \ + ${SED} -n '/^#[ ]*include[ ]*"/p' \ + "$$i" > "skel/custom/$$i"; \ + done + -${Q}for i in /dev/null ${H_SRC}; do \ + if [ "$$i" = "/dev/null" ]; then \ + continue; \ + fi; \ + tag="`echo $$i | ${SED} 's/[\.+,:]/_/g'`"; \ + echo "#ifndef $$tag" > "skel/custom/$$i"; \ + echo "#define $$tag" >> "skel/custom/$$i"; \ + ${SED} -n '/^#[ ]*include[ ]*"/p' "$$i" \ + >> "skel/custom/$$i"; \ + echo '#endif /* '"$$tag"' */' >> "skel/custom/$$i"; \ + done + ${Q}(cd ..; ${MAKE} hsrc) + ${Q}for i in `cd ..; ${MAKE} h_list`; do \ + tag="`echo $$i | ${SED} 's/[\.+,:]/_/g'`"; \ + echo "#ifndef $$tag" > "skel/$$i"; \ + echo "#define $$tag" >> "skel/$$i"; \ + ${SED} -n '/^#[ ]*include[ ]*"/p' "../$$i" \ + >> "skel/$$i"; \ + echo '#endif /* '"$$tag"' */' >> "skel/$$i"; \ + done + -${Q}rm -f skel/custom/makedep.out + ${Q}echo custom/skel formed + ${Q}echo forming custom dependency list + ${Q}echo "# DO NOT DELETE THIS LINE -- make depend depends on it." > \ + skel/custom/makedep.out + ${Q}cd skel/custom; ${MAKEDEPEND} -w 1 -m -f makedep.out ${C_SRC} + -${Q}for i in ${C_SRC}; do \ + echo "$$i" | \ + ${SED} 's/^\(.*\)\.c/\1.o: \1.c/' \ + >> skel/custom/makedep.out; \ + done + ${Q}echo custom dependency list formed + ${Q}echo forming new custom/Makefile + -${Q}rm -f Makefile.bak + ${Q}mv Makefile Makefile.bak + ${Q}${SED} -n '1,/^# DO NOT DELETE THIS LINE/p' Makefile.bak > Makefile + ${Q}echo "" >> Makefile + ${Q}${SED} -n '3,$$p' skel/custom/makedep.out | ${SORT} -u >> Makefile + -${Q}rm -rf skel + -${Q}if cmp -s Makefile.bak Makefile; then \ + echo 'custom Makefile was already up to date'; \ + mv -f Makefile.bak Makefile; \ + else \ + rm -f Makefile.tmp; \ + mv Makefile Makefile.tmp; \ + sccs edit Makefile; \ + mv Makefile.tmp Makefile; \ + echo new 'custom Makefile formed -- you need to check it in'; \ + fi + +## +# +# Utility rules +# +## + +clean: + -rm -f ${CUSTCALC_OBJ} + +clobber: + -rm -f ${TARGETS} + rm -f .all Makefile.tmp + +install: all + -${Q}if [ ! -d ${TOPDIR} ]; then \ + echo mkdir ${TOPDIR}; \ + mkdir ${TOPDIR}; \ + else \ + true; \ + fi + -${Q}if [ ! -d ${LIBDIR} ]; then \ + echo mkdir ${LIBDIR}; \ + mkdir ${LIBDIR}; \ + else \ + true; \ + fi + -${Q}if [ ! -d ${HELPDIR} ]; then \ + echo mkdir ${HELPDIR}; \ + mkdir ${HELPDIR}; \ + else \ + true; \ + fi + -${Q}if [ ! -d ${CUSTOMLIBDIR} ]; then \ + echo mkdir ${CUSTOMLIBDIR}; \ + mkdir ${CUSTOMLIBDIR}; \ + else \ + true; \ + fi + -${Q}if [ ! -d ${CUSTOMHELPDIR} ]; then \ + echo mkdir ${CUSTOMHELPDIR}; \ + mkdir ${CUSTOMHELPDIR}; \ + else \ + true; \ + fi + ${Q}for i in ${INSTALL_H_SRC}; do \ + echo rm -f ${CUSTOMLIBDIR}/$$i; \ + rm -f ${CUSTOMLIBDIR}/$$i; \ + echo cp $$i ${CUSTOMLIBDIR}; \ + cp $$i ${CUSTOMLIBDIR}; \ + echo chmod 0444 ${CUSTOMLIBDIR}/$$i; \ + chmod 0444 ${CUSTOMLIBDIR}/$$i; \ + done + ${Q}for i in ${CUSTOM_CALC_FILES}; do \ + echo rm -f ${CUSTOMLIBDIR}/$$i; \ + rm -f ${CUSTOMLIBDIR}/$$i; \ + echo cp $$i ${CUSTOMLIBDIR}; \ + cp $$i ${CUSTOMLIBDIR}; \ + echo chmod 0444 ${CUSTOMLIBDIR}/$$i; \ + chmod 0444 ${CUSTOMLIBDIR}/$$i; \ + done + ${Q}for i in ${CUSTOM_HELP}; do \ + echo rm -f ${CUSTOMHELPDIR}/$$i; \ + rm -f ${CUSTOMHELPDIR}/$$i; \ + echo cp $$i ${CUSTOMHELPDIR}; \ + cp $$i ${CUSTOMHELPDIR}; \ + echo chmod 0444 ${CUSTOMHELPDIR}/$$i; \ + chmod 0444 ${CUSTOMHELPDIR}/$$i; \ + done + -${Q}if [ ! -z ${ALLOW_CUSTOM} ]; then \ + echo "rm -f ${CUSTOMLIBDIR}/libcustcalc.a"; \ + rm -f ${CUSTOMLIBDIR}/libcustcalc.a; \ + echo "cp libcustcalc.a ${CUSTOMLIBDIR}/libcustcalc.a"; \ + cp libcustcalc.a ${CUSTOMLIBDIR}/libcustcalc.a; \ + echo "chmod 0644 ${CUSTOMLIBDIR}/libcustcalc.a"; \ + chmod 0644 ${CUSTOMLIBDIR}/libcustcalc.a; \ + echo "${RANLIB} ${CUSTOMLIBDIR}/libcustcalc.a"; \ + ${RANLIB} ${CUSTOMLIBDIR}/libcustcalc.a; \ + fi + +## +# +# make depend stuff +# +## + +# DO NOT DELETE THIS LINE + +c_argv.o: ../alloc.h +c_argv.o: ../block.h +c_argv.o: ../byteswap.h +c_argv.o: ../calc.h +c_argv.o: ../calcerr.h +c_argv.o: ../cmath.h +c_argv.o: ../config.h +c_argv.o: ../custom.h +c_argv.o: ../endian_calc.h +c_argv.o: ../hash.h +c_argv.o: ../have_const.h +c_argv.o: ../have_malloc.h +c_argv.o: ../have_memmv.h +c_argv.o: ../have_newstr.h +c_argv.o: ../have_stdlib.h +c_argv.o: ../have_string.h +c_argv.o: ../longbits.h +c_argv.o: ../md5.h +c_argv.o: ../nametype.h +c_argv.o: ../qmath.h +c_argv.o: ../shs.h +c_argv.o: ../shs1.h +c_argv.o: ../string.h +c_argv.o: ../value.h +c_argv.o: ../zmath.h +c_argv.o: c_argv.c +c_devnull.o: ../alloc.h +c_devnull.o: ../block.h +c_devnull.o: ../byteswap.h +c_devnull.o: ../calcerr.h +c_devnull.o: ../cmath.h +c_devnull.o: ../config.h +c_devnull.o: ../custom.h +c_devnull.o: ../endian_calc.h +c_devnull.o: ../hash.h +c_devnull.o: ../have_const.h +c_devnull.o: ../have_malloc.h +c_devnull.o: ../have_memmv.h +c_devnull.o: ../have_newstr.h +c_devnull.o: ../have_stdlib.h +c_devnull.o: ../have_string.h +c_devnull.o: ../longbits.h +c_devnull.o: ../md5.h +c_devnull.o: ../nametype.h +c_devnull.o: ../qmath.h +c_devnull.o: ../shs.h +c_devnull.o: ../shs1.h +c_devnull.o: ../string.h +c_devnull.o: ../value.h +c_devnull.o: ../zmath.h +c_devnull.o: c_devnull.c +c_help.o: ../alloc.h +c_help.o: ../block.h +c_help.o: ../byteswap.h +c_help.o: ../calcerr.h +c_help.o: ../cmath.h +c_help.o: ../config.h +c_help.o: ../custom.h +c_help.o: ../endian_calc.h +c_help.o: ../hash.h +c_help.o: ../have_const.h +c_help.o: ../have_malloc.h +c_help.o: ../have_memmv.h +c_help.o: ../have_newstr.h +c_help.o: ../have_stdlib.h +c_help.o: ../have_string.h +c_help.o: ../longbits.h +c_help.o: ../md5.h +c_help.o: ../nametype.h +c_help.o: ../qmath.h +c_help.o: ../shs.h +c_help.o: ../shs1.h +c_help.o: ../string.h +c_help.o: ../value.h +c_help.o: ../zmath.h +c_help.o: c_help.c +c_sysinfo.o: ../alloc.h +c_sysinfo.o: ../block.h +c_sysinfo.o: ../byteswap.h +c_sysinfo.o: ../calc.h +c_sysinfo.o: ../calcerr.h +c_sysinfo.o: ../cmath.h +c_sysinfo.o: ../conf.h +c_sysinfo.o: ../config.h +c_sysinfo.o: ../custom.h +c_sysinfo.o: ../endian_calc.h +c_sysinfo.o: ../fposval.h +c_sysinfo.o: ../hash.h +c_sysinfo.o: ../have_const.h +c_sysinfo.o: ../have_malloc.h +c_sysinfo.o: ../have_memmv.h +c_sysinfo.o: ../have_newstr.h +c_sysinfo.o: ../have_stdlib.h +c_sysinfo.o: ../have_string.h +c_sysinfo.o: ../hist.h +c_sysinfo.o: ../longbits.h +c_sysinfo.o: ../longlong.h +c_sysinfo.o: ../md5.h +c_sysinfo.o: ../nametype.h +c_sysinfo.o: ../prime.h +c_sysinfo.o: ../qmath.h +c_sysinfo.o: ../shs.h +c_sysinfo.o: ../shs1.h +c_sysinfo.o: ../string.h +c_sysinfo.o: ../value.h +c_sysinfo.o: ../zmath.h +c_sysinfo.o: ../zrand.h +c_sysinfo.o: ../zrandom.h +c_sysinfo.o: c_sysinfo.c +custtbl.o: ../alloc.h +custtbl.o: ../block.h +custtbl.o: ../byteswap.h +custtbl.o: ../calcerr.h +custtbl.o: ../cmath.h +custtbl.o: ../config.h +custtbl.o: ../custom.h +custtbl.o: ../endian_calc.h +custtbl.o: ../hash.h +custtbl.o: ../have_const.h +custtbl.o: ../have_malloc.h +custtbl.o: ../have_memmv.h +custtbl.o: ../have_newstr.h +custtbl.o: ../have_stdlib.h +custtbl.o: ../have_string.h +custtbl.o: ../longbits.h +custtbl.o: ../md5.h +custtbl.o: ../nametype.h +custtbl.o: ../qmath.h +custtbl.o: ../shs.h +custtbl.o: ../shs1.h +custtbl.o: ../string.h +custtbl.o: ../value.h +custtbl.o: ../zmath.h +custtbl.o: custtbl.c diff --git a/custom/argv b/custom/argv new file mode 100644 index 0000000..b2c18c8 --- /dev/null +++ b/custom/argv @@ -0,0 +1,41 @@ +NAME + argv - displays information about its args + +SYNOPSIS + custom("argv" [, arg ...]) + +TYPES + arg any + + return int + +DESCRIPTION + This custom function will, for each arg given print: + + arg number + arg type + number of elements (size()) + memory size (sizeof()) + + The number of args passed, not counting the initial "argv" name + arg is returned. + +EXAMPLE + > foo=5^713; bar=17; baz=list(2,3,4); + > custom("argv", foo, bar, baz, 3+4.5i, pi()) + arg[0] rational_value size=1 sizeof=272 + arg[1] rational_value size=1 sizeof=68 + arg[2] list size=3 sizeof=256 + arg[3] complex_value size=1 sizeof=140 + arg[4] rational_value size=1 sizeof=84 + 5 + +LIMITS + calc must be built with ALLOW_CUSTOM= -DCUSTOM + calc must be executed with a -C arg. + +LIBRARY + none + +SEE ALSO + custom diff --git a/custom/argv.cal b/custom/argv.cal new file mode 100644 index 0000000..ab94ff7 --- /dev/null +++ b/custom/argv.cal @@ -0,0 +1,44 @@ +/* + * Permission to use, copy, modify, and distribute this software and + * its documentation for any purpose and without fee is hereby granted. + * + * 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. + * + * chongo was here /\../\ chongo@toad.com + */ +/* + * argv - print information about various args + * + * This file is part of the custom sample calc files. + * + * NOTE: You must use a calc that was compiled with ALLOW_CUSTOM= -DCUSTOM + * and run with a -C arg. + */ +define argv() +{ + local i; /* arg number */ + local junk; /* throw away value */ + + /* + * process each arg passed to us + */ + for (i = 1; i <= param(0); ++i) { + /* + * This won't really work because all the arg numbers + * will be reported as arg[0] ... but what the heck + * this is only a demo! + */ + junk = custom("argv", param(i)); + } + return i-1; +} + +if (config("lib_debug") >= 0) { + print "argv(var, ...) defined"; +} diff --git a/custom/c_argv.c b/custom/c_argv.c new file mode 100644 index 0000000..9f16720 --- /dev/null +++ b/custom/c_argv.c @@ -0,0 +1,162 @@ +/* + * Permission to use, copy, modify, and distribute this software and + * its documentation for any purpose and without fee is hereby granted. + * + * 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. + * + * Comments, suggestions, bug fixes and questions about these routines + * are welcome. Send EMail to the address given below. + * + * Happy bit twiddling, + * + * Landon Curt Noll + * + * chongo@toad.com + * ...!{pyramid,sun,uunet}!hoptoad!chongo + * + * chongo was here /\../\ + */ + +#if defined(CUSTOM) + +#include + +#include "../have_const.h" +#include "../value.h" +#include "../custom.h" + +#include "../config.h" +#include "../calc.h" + +/* + * c_argv - a custom function display info about its args + * + * given: + * vals[i] and arg to display information about + * + * returns: + * count + */ +/*ARGSUSED*/ +VALUE +c_argv(char *name, int count, VALUE **vals) +{ + VALUE result; /* what we will return */ + ZVALUE zfilelen; /* length of a file as a ZVALUE */ + NUMBER *filelen; /* pointer to length of a file as a NUMER */ + char *type; /* the name of the arg type */ + int i; + + /* + * print info on each arg + */ + for (i=0; i < count; ++i) { + + /* + * print arg number with leading tab as configured + */ + printf("%sarg[%d]", (conf->tab_ok ? "\t" : ""), i); + + /* + * print the arg type + */ + switch (vals[i]->v_type) { + case V_NULL: /* null value */ + type = "null"; + break; + case V_INT: /* normal integer */ + type = "int"; + break; + case V_NUM: /* number */ + type = "rational_value"; + break; + case V_COM: /* complex number */ + type = "complex_value"; + break; + case V_ADDR: /* address of variable value */ + type = "address"; + break; + case V_STR: /* address of string */ + type = "string"; + break; + case V_MAT: /* address of matrix structure */ + type = "matrix"; + break; + case V_LIST: /* address of list structure */ + type = "list"; + break; + case V_ASSOC: /* address of association structure */ + type = "assoc"; + break; + case V_OBJ: /* address of object structure */ + type = "ocject"; + break; + case V_FILE: /* opened file id */ + type = "file"; + break; + case V_RAND: /* address of additive 55 random state */ + type = "rand_state"; + break; + case V_RANDOM: /* address of Blum random state */ + type = "random_state"; + break; + case V_CONFIG: /* configuration state */ + type = "config_state"; + break; + case V_HASH: /* hash state */ + type = "hash_state"; + break; + case V_BLOCK: /* memory block */ + type = "octet_block"; + break; +#if 0 + /* XXX - V_OCTET is subject to change */ + case V_OCTET: /* octet (unsigned char) */ + type = "octet"; + break; +#endif + default: + type = "unknown"; + break; + } + printf("\t%-16s", type); + + /* + * print size and sizeof information + * + * We have to treat files in a special way + * because their length can be very long. + */ + if (vals[i]->v_type == V_FILE) { + /* get the file length */ + if (getsize(vals[i]->v_file, &zfilelen) == 0) { + filelen = qalloc(); + filelen->num = zfilelen; + qprintfd(filelen, 0L); + qfree(filelen); + } else { + /* getsize error */ + printf("\tsize=unknown"); + } + printf("\tsizeof=%ld\n", lsizeof(vals[i])); + } else { + printf("\tsize=%ld\tsizeof=%ld\n", + elm_count(vals[i]), lsizeof(vals[i])); + } + } + + /* + * return count + */ + result.v_type = V_NUM; + result.v_num = itoq(count); + return result; +} + +#endif /* CUSTOM */ diff --git a/custom/c_devnull.c b/custom/c_devnull.c new file mode 100644 index 0000000..af64d33 --- /dev/null +++ b/custom/c_devnull.c @@ -0,0 +1,53 @@ +/* + * Permission to use, copy, modify, and distribute this software and + * its documentation for any purpose and without fee is hereby granted. + * + * 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. + * + * Comments, suggestions, bug fixes and questions about these routines + * are welcome. Send EMail to the address given below. + * + * Happy bit twiddling, + * + * Landon Curt Noll + * + * chongo@toad.com + * ...!{pyramid,sun,uunet}!hoptoad!chongo + * + * chongo was here /\../\ + */ + +#if defined(CUSTOM) + + +#include "../have_const.h" +#include "../value.h" +#include "../custom.h" + + +/* + * c_devnull - a custom function that does nothing + * + * This custom function does nothing. It is useful as a test hook + * for looking at the general interface. + */ +/*ARGSUSED*/ +VALUE +c_devnull(char *name, int count, VALUE **vals) +{ + VALUE result; /* what we will return */ + + /* + * return NULL + */ + result.v_type = V_NULL; + return result; +} + +#endif /* CUSTOM */ diff --git a/custom/c_help.c b/custom/c_help.c new file mode 100644 index 0000000..e11a653 --- /dev/null +++ b/custom/c_help.c @@ -0,0 +1,77 @@ +/* + * Permission to use, copy, modify, and distribute this software and + * its documentation for any purpose and without fee is hereby granted. + * + * 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. + * + * Comments, suggestions, bug fixes and questions about these routines + * are welcome. Send EMail to the address given below. + * + * Happy bit twiddling, + * + * Landon Curt Noll + * + * chongo@toad.com + * ...!{pyramid,sun,uunet}!hoptoad!chongo + * + * chongo was here /\../\ + */ + +#if defined(CUSTOM) + + +#include "../have_const.h" +#include "../value.h" +#include "../custom.h" + + +/* + * c_help - custom help function + * + * This function assumes that a help file with the same name as + * the custom function has been installed by the custom/Makefile + * (as listed in the CUSTOM_HELP makefile variable) under the + * CUSTOMHELPDIR == HELPDIR/custhelp directory. + * + * The help command first does a search in HELPDIR and later + * in CUSTOMHELPDIR. If a custom help file has the same name + * as a file under HELPDIR then help will display the HELPDIR + * file and NOT the custom file. This function will ignore + * and HELPDIR file and work directly with the custom help file. + * + * given: + * vals[0] name of the custom help file to directly access + */ +/*ARGSUSED*/ +VALUE +c_help(char *name, int count, VALUE **vals) +{ + VALUE result; /* what we will return */ + + /* + * parse args + */ + if (vals[0]->v_type != V_STR) { + math_error("custom help arg 1 must be a string"); + /*NOTREACHED*/ + } + + /* + * give the help + */ + customhelp((char *)vals[0]->v_str); + + /* + * return NULL + */ + result.v_type = V_NULL; + return result; +} + +#endif /* CUSTOM */ diff --git a/custom/c_sysinfo.c b/custom/c_sysinfo.c new file mode 100644 index 0000000..1e74b76 --- /dev/null +++ b/custom/c_sysinfo.c @@ -0,0 +1,366 @@ +/* + * Permission to use, copy, modify, and distribute this software and + * its documentation for any purpose and without fee is hereby granted. + * + * 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. + * + * Comments, suggestions, bug fixes and questions about these routines + * are welcome. Send EMail to the address given below. + * + * Happy bit twiddling, + * + * Landon Curt Noll + * + * chongo@toad.com + * ...!{pyramid,sun,uunet}!hoptoad!chongo + * + * chongo was here /\../\ + */ + +#if defined(CUSTOM) + +#include +#include + +#include "../have_const.h" +#include "../value.h" +#include "../custom.h" + +#include "../config.h" +#include "../calc.h" +#include "../longbits.h" +#include "../longlong.h" +#include "../block.h" +#include "../calcerr.h" +#include "../conf.h" +#include "../endian_calc.h" +#include "../fposval.h" +#include "../hist.h" +#include "../prime.h" +#include "../zrand.h" +#include "../zrandom.h" + + +/* + * sys_info - names and values of selected #defines + */ +struct infoname { + char *name; /* name of #define converted to all UPPER_CASE */ + char *meaning; /* brief explanation of the #define */ + char *str; /* non-NULL ==> value of #define is a string */ + FULL nmbr; /* if str==NULL ==> value fo #define as a FULL */ +}; +static struct infoname sys_info[] = { + {"A55", "slots in an additive 55 table", NULL, (FULL)A55}, + {"BASE", "base for calculations", NULL, (FULL)BASE}, + {"BASE1", "one less than base", NULL, (FULL)BASE}, + {"BASEB", "bits in the calculation base", NULL, (FULL)BASEB}, + {"BASEDIG", "number of digits in base", NULL, (FULL)BASEDIG}, + {"BIG_ENDIAN", "Most Significant Byte first symbol", NULL, (FULL)BIG_ENDIAN}, + {"BLK_CHUNKSIZE", "default allocation chunk size for blocks", NULL, (FULL)BLK_CHUNKSIZE}, + {"BLK_DEF_MAXPRINT", "default block octets to print", NULL, (FULL)BLK_DEF_MAXPRINT}, + {"BLUM_PREGEN", "non-default predefined Blum generators", NULL, (FULL)BLUM_PREGEN}, + {"BOOL_B64", "if we have 64 bit type (TRUE or FALSE)", NULL, (FULL)BOOL_B64}, + {"CALCEXT", "extension for files read in", CALCEXT, (FULL)0}, + {"CALC_BYTE_ORDER", "Byte order (LITTLE_ENDIAN or BIG_ENDIAN)", NULL, (FULL)CALC_BYTE_ORDER}, + {"CUSTOMHELPDIR", "location of the custom help directory", CUSTOMHELPDIR, (FULL)0}, + {"DEFAULTCALCBINDINGS", "default key bindings file", DEFAULTCALCBINDINGS, (FULL)0}, + {"DEFAULTCALCHELP", "help file that -h prints", DEFAULTCALCHELP, (FULL)0}, + {"DEFAULTCALCPAGER", "default pager", DEFAULTCALCPAGER, (FULL)0}, + {"DEFAULTCALCPATH", "default :-separated search path", DEFAULTCALCPATH, (FULL)0}, + {"DEFAULTCALCRC", "default :-separated startup file list", DEFAULTCALCRC, (FULL)0}, + {"DEFAULTSHELL", "default shell to use", DEFAULTSHELL, (FULL)0}, + {"DEV_BITS", "device number size in bits", NULL, (FULL)DEV_BITS}, + {"DISPLAY_DEFAULT", "default digits for float display", NULL, (FULL)DISPLAY_DEFAULT}, + {"ECHO", "where the echo command is located", ECHO, (FULL)0}, + {"EPSILONPREC_DEFAULT", "2^-EPSILON_DEFAULT <= EPSILON_DEFAULT", NULL, (FULL)EPSILONPREC_DEFAULT}, + {"EPSILON_DEFAULT", "allowed error for float calculations", EPSILON_DEFAULT, (FULL)0}, + {"ERRMAX", "default errmax value", NULL, (FULL)ERRMAX}, + {"E_USERDEF", "base of user defined errors", NULL, (FULL)E_USERDEF}, + {"E__BASE", "calc errors start above here", NULL, (FULL)E__BASE}, + {"E__COUNT", "number of calc errors", NULL, (FULL)E__COUNT}, + {"E__HIGHEST", "highest calc error", NULL, (FULL)E__HIGHEST}, + {"FALSE", "boolean false", NULL, (FULL)FALSE}, + {"FILEPOS_BITS", "file position size in bits", NULL, (FULL)FILEPOS_BITS}, + {"FULL_BITS", "bits in a FULL", NULL, (FULL)FULL_BITS}, + {"HELPDIR", "location of the help directory", HELPDIR, (FULL)0}, + {"HIST_BINDING_FILE", "Default binding file", HIST_BINDING_FILE, (FULL)0}, + {"HIST_SIZE", "Default history size", NULL, (FULL)HIST_SIZE}, + {"INIT_J", "initial 1st walking a55 table index", NULL, (FULL)INIT_J}, + {"INIT_K", "initial 2nd walking a55 table index", NULL, (FULL)INIT_K}, + {"INODE_BITS", "inode number size in bits", NULL, (FULL)INODE_BITS}, + {"LITTLE_ENDIAN", "Least Significant Byte first symbol", NULL, (FULL)LITTLE_ENDIAN}, + {"LONGLONG_BITS", "length of a long long, or 0", NULL, (FULL)LONGLONG_BITS}, + {"LONG_BITS", "bit length of a long", NULL, (FULL)LONG_BITS}, + {"MAP_POPCNT", "number of odd primes in pr_map", NULL, (FULL)MAP_POPCNT}, + {"MAXCMD", "max length of command invocation", NULL, (FULL)MAXCMD}, + {"MAXDIM", "max number of dimensions in matrices", NULL, (FULL)MAXDIM}, + {"MAXERROR", "max length of error message string", NULL, (FULL)MAXERROR}, + {"MAXFILES", "max number of opened files", NULL, (FULL)MAXFILES}, + {"MAXFULL", "largest SFULL value", NULL, (FULL)MAXFULL}, + {"MAXHALF", "largest SHALF value", NULL, (FULL)MAXHALF}, + {"MAXINDICES", "max number of indices for objects", NULL, (FULL)MAXINDICES}, + {"MAXLABELS", "max number of user labels in function", NULL, (FULL)MAXLABELS}, + {"MAXLEN", "longest storage size allowed", NULL, (FULL)MAXLEN}, + {"MAXLONG", "largest long val", NULL, (FULL)MAXLONG}, + {"MAXOBJECTS", "max number of object types", NULL, (FULL)MAXOBJECTS}, + {"MAXPRINT_DEFAULT", "default number of elements printed", NULL, (FULL)MAXPRINT_DEFAULT}, + {"MAXREDC", "number of entries in REDC cache", NULL, (FULL)MAXREDC}, + {"MAXSCANCOUNT", "default max scan errors before an abort", NULL, (FULL)MAXSCANCOUNT}, + {"MAXSTACK", "max depth of evaluation stack", NULL, (FULL)MAXSTACK}, + {"MAXSTRING", "max size of string constant", NULL, (FULL)MAXSTRING}, + {"MAXUFULL", "largest FULL value", NULL, (FULL)MAXUFULL}, + {"MAXULONG", "largest unsigned long val", NULL, (FULL)MAXULONG}, + {"MAX_MAP_PRIME", "larest prime in pr_map", NULL, (FULL)MAX_MAP_PRIME}, + {"MAX_MAP_VAL", "larest bit in pr_map", NULL, (FULL)MAX_MAP_VAL}, + {"MAX_PFACT_VAL", "max x, for which pfact(x) is a long", NULL, (FULL)MAX_PFACT_VAL}, + {"MAX_SM_PRIME", "larest 32 bit prime", NULL, (FULL)MAX_SM_PRIME}, + {"MAX_SM_VAL", "larest 32 bit value", NULL, (FULL)MAX_SM_VAL}, + {"MUL_ALG2", "default size for alternative multiply", NULL, (FULL)MUL_ALG2}, + {"NEW_EPSILONPREC_DEFAULT", "2^-EPSILON_DEFAULT <= EPSILON_DEFAULT", NULL, (FULL)NEW_EPSILONPREC_DEFAULT}, + {"NEW_EPSILON_DEFAULT", "newstd EPSILON_DEFAULT", NEW_EPSILON_DEFAULT, (FULL)0}, + {"NXT_MAP_PRIME", "smallest odd prime not in pr_map", NULL, (FULL)NXT_MAP_PRIME}, + {"NXT_PFACT_VAL", "next prime for higher pfact values", NULL, (FULL)NXT_PFACT_VAL}, + {"OFF_T_BITS", "file offset size in bits", NULL, (FULL)OFF_T_BITS}, + {"PATHSIZE", "max length of path name", NULL, (FULL)PATHSIZE}, + {"PATHSIZE", "max length of path name", NULL, (FULL)PATHSIZE}, + {"PIX_32B", "max pix() value", NULL, (FULL)PIX_32B}, + {"POW_ALG2", "default size for using REDC for powers", NULL, (FULL)POW_ALG2}, + {"REDC_ALG2", "default size using alternative REDC alg", NULL, (FULL)REDC_ALG2}, + {"SBITS", "size of additive or shuffle entry in bits", NULL, (FULL)SBITS}, + {"SBYTES", "size of additive or shuffle entry in bytes", NULL, (FULL)SBYTES}, + {"SCNT", "length of additive 55 table in FULLs", NULL, (FULL)SCNT}, + {"SEEDXORBITS", "low bits of a55 seed devoted to xor", NULL, (FULL)SEEDXORBITS}, + {"SHALFS", "size of additive or shuffle entry in HALFs", NULL, (FULL)SHALFS}, + {"SHUFCNT", "size of shuffle table in entries", NULL, (FULL)SHUFCNT}, + {"SHUFLEN", "length of shuffle table in FULLs", NULL, (FULL)SHUFLEN}, + {"SHUFMASK", "mask for shuffle table entry selection", NULL, (FULL)SHUFMASK}, + {"SHUFPOW", "power of 2 size of the shuffle table", NULL, (FULL)SHUFPOW}, + {"SLEN", "number of FULLs in a shuffle table entry", NULL, (FULL)SLEN}, + {"SQ_ALG2", "default size for alternative squaring", NULL, (FULL)SQ_ALG2}, + {"SYMBOLSIZE", "max symbol name size", NULL, (FULL)SYMBOLSIZE}, + {"TEN_MAX", "10^(2^TEN_MAX): largest base10 conversion const", NULL, (FULL)TEN_MAX}, + {"TOPFULL", "highest bit in FULL", NULL, (FULL)TOPFULL}, + {"TOPHALF", "highest bit in a HALF", NULL, (FULL)TOPHALF}, + {"TOPLONG", "top long bit", NULL, (FULL)TOPLONG}, + {"TRUE", "boolean true", NULL, (FULL)TRUE}, + {"USUAL_ELEMENTS", "usual number of elements for objects", NULL, (FULL)USUAL_ELEMENTS}, + + /* must be last */ + {NULL, NULL, NULL, (FULL)0} +}; + + +/* + * forward declarations + */ +static void dump_name_meaning(void); /* custom("sysinfo", 0) */ +static void dump_name_value(void); /* custom("sysinfo", 1) */ +static void dump_mening_value(void); /* custom("sysinfo", 2) */ + + +/* + * c_sysinfo - return a calc #define value + * + * given: + * vals[0] if given, name of #define to print + * otherwise a list of #defines are printed + * + * returns: + * value of #define if given (int or string) + * null if no #define arg was given + */ +/*ARGSUSED*/ +VALUE +c_sysinfo(char *name, int count, VALUE **vals) +{ + VALUE result; /* what we will return */ + struct infoname *p; /* current infoname */ + char *buf; /* upper case value of vals[0] */ + char *q; /* to upper case converter */ + char *r; /* to upper case converter */ + + /* + * we will return NULL if a value was not found + */ + result.v_type = V_NULL; + + /* + * case 0: if no args, then dump the table with no values + */ + if (count == 0) { + + /* dump the entire table */ + dump_name_meaning(); + + /* + * case 1: numeric arg is given + */ + } else if (vals[0]->v_type == V_NUM) { + + /* firewall - must be a tiny non-negative integer */ + if (qisneg(vals[0]->v_num) || + qisfrac(vals[0]->v_num) || + zge31b(vals[0]->v_num->num)) { + math_error("sysinfo: arg must be string, 0, 1 or 2"); + /*NOTREACHED*/ + } + + /* + * select action based on numeric value of arg + */ + switch (z1tol(vals[0]->v_num->num)) { + case 0: /* print all infonames and meanings */ + dump_name_meaning(); + break; + case 1: /* print all infonames and values */ + dump_name_value(); + break; + case 2: /* print all values and meanings */ + dump_mening_value(); + break; + default: + math_error("sysinfo: arg must be string, 0, 1 or 2"); + /*NOTREACHED*/ + } + + /* + * case 2: string arg is given + * + * The string is taken to be the infoname we want to print. + */ + } else if (vals[0]->v_type == V_STR) { + + /* convert vals[0] to upper case string */ + buf = (char *)malloc(strlen((char *)vals[0]->v_str)+1); + for (q = (char *)vals[0]->v_str, r = buf; *q; ++q, ++r) { + if (isascii(*q) && islower(*q)) { + *r = *q - 'a' + 'A'; + } else { + *r = *q; + } + } + *r = '\0'; + + /* search the table for the infoname */ + for (p = sys_info; p->name != NULL; ++p) { + + if (strcmp(p->name, buf) == 0) { + + /* found the infoname */ + if (p->str == NULL) { + /* return value as integer */ + result.v_type = V_NUM; + result.v_num = utoq( p->nmbr); + } else { + /* return value as string */ + result.v_type = V_STR; + result.v_subtype = V_NOSUBTYPE; + result.v_str = (STRING *)p->str; + } + + /* return found infotype as value */ + break; + } + } + + /* + * bad arg given + */ + } else { + math_error("sysinfo: arg must be string, 0, 1 or 2"); + /*NOTREACHED*/ + } + + /* + * return what we found or didn't find + */ + return result; +} + + +/* + * dump_name_meaning - print all infonames and meanings + */ +static void +dump_name_meaning(void) +{ + struct infoname *p; /* current infoname */ + + /* dump the entire table */ + for (p = sys_info; p->name != NULL; ++p) { + printf("%s%-23s\t%s\n", + (conf->tab_ok ? "\t" : ""), p->name, p->meaning); + } + +} + + +/* + * dump_name_value - print all infonames and values + */ +static void +dump_name_value(void) +{ + struct infoname *p; /* current infoname */ + + /* dump the entire table */ + for (p = sys_info; p->name != NULL; ++p) { + if (p->str == NULL) { +#if LONG_BITS == FULL_BITS || FULL_BITS == 32 || !defined(HAVE_LONGLONG) + printf("%s%-23s\t%-8lu\t(0x%lx)\n", + (conf->tab_ok ? "\t" : ""), p->name, + (unsigned long)p->nmbr, + (unsigned long)p->nmbr); +#else + printf("%s%-23s\t%-8llu\t(0x%llx)\n", + (conf->tab_ok ? "\t" : ""), p->name, + (unsigned long long)p->nmbr, + (unsigned long long)p->nmbr); +#endif + } else { + printf("%s%-23s\t\"%s\"\n", + (conf->tab_ok ? "\t" : ""), p->name, p->str); + } + } + +} + + +/* + * dump_mening_value - print all values and meanings + */ +static void +dump_mening_value(void) +{ + struct infoname *p; /* current infoname */ + + /* dump the entire table */ + for (p = sys_info; p->name != NULL; ++p) { + if (p->str == NULL) { +#if LONG_BITS == FULL_BITS || FULL_BITS == 32 || !defined(HAVE_LONGLONG) + printf("%s%-36.36s\t%-8lu\t(0x%lx)\n", + (conf->tab_ok ? "\t" : ""), p->meaning, + (unsigned long)p->nmbr, + (unsigned long)p->nmbr); +#else + printf("%s%-36.36s\t%-8llu\t(0x%llx)\n", + (conf->tab_ok ? "\t" : ""), p->meaning, + (unsigned long long)p->nmbr, + (unsigned long long)p->nmbr); +#endif + } else { + printf("%s%-36.36s\t\"%s\"\n", + (conf->tab_ok ? "\t" : ""), p->meaning, p->str); + } + } + +} + +#endif /* CUSTOM */ diff --git a/custom/custtbl.c b/custom/custtbl.c new file mode 100644 index 0000000..e0e5aa5 --- /dev/null +++ b/custom/custtbl.c @@ -0,0 +1,119 @@ +/* + * 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, + * provided that the above copyright, this permission notice and text + * this comment, 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. + * + * Comments, suggestions, bug fixes and questions about these routines + * are welcome. Send EMail to the address given below. + * + * Happy bit twiddling, + * + * Landon Curt Noll + * + * chongo@toad.com + * ...!{pyramid,sun,uunet}!hoptoad!chongo + * + * chongo was here /\../\ + */ + + +#include "../have_const.h" +#include "../value.h" +#include "../custom.h" + +/* + * NOTE: See the file CUSTOM for instructions on how to add + * custom functions. + */ + + +#if defined(CUSTOM) + + +/* + * add your forward custom function declaractions here + * + * Declare custom functions as follows: + * + * extern VALUE c_xyz(char*, int, VALUE**); + * + * We suggest that you sort the entries below by name. + */ +extern VALUE c_argv(char*, int, VALUE**); +extern VALUE c_devnull(char*, int, VALUE**); +extern VALUE c_help(char*, int, VALUE**); +extern VALUE c_sysinfo(char*, int, VALUE**); + + +#endif /* CUSTOM */ + + +/* + * custom interface table + * + * The order of the elements in struct custom are: + * + * { "xyz", "brief description of the xyz custom function", + * minimum_args, maximum_args, c_xyz }, + * + * where: + * + * minimum_args an int >= 0 + * maximum_args an int >= minimum_args and <= MAX_CUSTOM_ARGS + * + * Use MAX_CUSTOM_ARGS for maximum_args is the maximum number of args + * is potentially 'unlimited'. + * + * If the brief description cannot fit on the same line as the name + * without wrapping on a 80 col window, the description is probably + * too long and will not look nice in the show custom output. + */ +CONST struct custom cust[] = { + +#if defined(CUSTOM) + + + /* + * add your own custom functions here + * + * We suggest that you sort the entries below by name + * so that show custom will produce a nice sorted list. + */ + + { "argv", "information about its args, returns arg count", + 0, MAX_CUSTOM_ARGS, c_argv }, + + { "devnull", "does nothing", + 0, MAX_CUSTOM_ARGS, c_devnull }, + + { "help", "help for custom functions", + 1, 1, c_help }, + + { "sysinfo", "return a calc #define value", + 0, 1, c_sysinfo }, + + +#endif /* CUSTOM */ + + /* + * This must be at the end of this table!!! + */ + {NULL, NULL, + 0, 0, NULL} +}; diff --git a/custom/devnull b/custom/devnull new file mode 100644 index 0000000..4d97e54 --- /dev/null +++ b/custom/devnull @@ -0,0 +1,27 @@ +NAME + devnull - does nothing + +SYNOPSIS + custom("devnull" [, arg ...]) + +TYPES + arg any + + return null + +DESCRIPTION + This custom function does nothing. It is intented for testing + of the general custom interface. + +EXAMPLE + > custom("devnull", foo, bar, baz, 3+4.5i, pi()) + +LIMITS + calc must be built with ALLOW_CUSTOM= -DCUSTOM + calc must be executed with a -C arg. + +LIBRARY + none + +SEE ALSO + custom diff --git a/custom/halflen.cal b/custom/halflen.cal new file mode 100644 index 0000000..8f81810 --- /dev/null +++ b/custom/halflen.cal @@ -0,0 +1,53 @@ +/* + * Permission to use, copy, modify, and distribute this software and + * its documentation for any purpose and without fee is hereby granted. + * + * 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. + * + * chongo was here /\../\ chongo@toad.com + */ +/* + * halflen - determine the length of numeric value in HALFs + * + * This file is part of the custom sample calc files. + * + * NOTE: You must use a calc that was compiled with ALLOW_CUSTOM= -DCUSTOM + * and run with a -C arg. + */ +define halflen(num) +{ + local baseb = custom("sysinfo","BASEB"); /* bit len of a HALF */ + + /* + * firewall + */ + if (!isnum(num)) { + return newerror("halflen only works on numeric values"); + } + + /* + * determine the HALF length of a numeric value + */ + if (num == 0) { + /* consider 0 to be 1 HALF long */ + return 1; + } else if (isint(num)) { + return (highbit(num)+baseb-1)/baseb; + } else if (isreal(num)) { + return halflen(num(num)) + halflen(den(num)); + } else if (isnum(num)) { + return halflen(re(num)) + halflen(im(num)); + } else { + return newerror("halflen only works on numeric values"); + } +} + +if (config("lib_debug") >= 0) { + print "halflen(num) defined"; +} diff --git a/custom/help b/custom/help new file mode 100644 index 0000000..4be92de --- /dev/null +++ b/custom/help @@ -0,0 +1,28 @@ +NAME + help - help for custom functions + +SYNOPSIS + custom("help", name) + +TYPES + name string + + return null + +DESCRIPTION + This custom function will display the help for the builtin function + named by the name argument. + +EXAMPLE + > custom("help", "custom_cal") + ... output the same as is produced by help custhelp/custom_cal ... + +LIMITS + calc must be built with ALLOW_CUSTOM= -DCUSTOM + calc must be executed with a -C arg. + +LIBRARY + none + +SEE ALSO + custom diff --git a/custom/sysinfo b/custom/sysinfo new file mode 100644 index 0000000..17560ff --- /dev/null +++ b/custom/sysinfo @@ -0,0 +1,54 @@ +NAME + sysinfo - return a calc #define value + +SYNOPSIS + custom("sysinfo" [, infoname]); + +TYPES + infoname string or int + + return int, string or null + +DESCRIPTION + + This custom function will return the value certain selected #defile + values. The infoname arg must be a string that matches the given + #define name. For conveience, the case infoname does not matter, + so "baseb" and "BASEB" refer to the same #define value. + + The return value is either an integer or a string depending on + the type of #define selected. If infoname is unknown, NULL is returned. + + If no infoname is given then a list of infonames and meanings + are printed. In this case, null is returned. + + If infoname is a number, then it is interpreted as follows: + + 0 print all infonames and meanings (same as no infoname) + 1 print all infonames and values + 2 print all infoname meanings and values + +EXAMPLE + > custom("sysinfo", "baseb") + 32 + + > custom("sysinfo") + ... a list of infonames and meanings are printed ... + > custom("sysinfo", 0) + ... a list of infonames and meanings are printed ... + + > custom("sysinfo", 1) + ... a list of infonames and values are printed ... + + > custom("sysinfo", 2) + ... a list of infoname meanings and values are printed ... + +LIMITS + calc must be built with ALLOW_CUSTOM= -DCUSTOM + calc must be executed with a -C arg. + +LIBRARY + none + +SEE ALSO + custom diff --git a/endian.c b/endian.c index a1ce342..893ea10 100644 --- a/endian.c +++ b/endian.c @@ -66,12 +66,13 @@ main(void) /* Determine byte order */ if (intp[0] == 0x12364859) { /* Most Significant Byte first */ - printf("#define BYTE_ORDER\tBIG_ENDIAN\n"); + printf("#define CALC_BYTE_ORDER\tBIG_ENDIAN\n"); } else if (intp[0] == 0x59483612) { /* Least Significant Byte first */ - printf("#define BYTE_ORDER\tLITTLE_ENDIAN\n"); + printf("#define CALC_BYTE_ORDER\tLITTLE_ENDIAN\n"); } else { - fprintf(stderr, "Unknown int Byte Order, set BYTE_ORDER in Makefile\n"); + fprintf(stderr, + "Unknown int Byte Order, set CALC_BYTE_ORDER in Makefile\n"); exit(1); } exit(0); diff --git a/file.c b/file.c index d5b9104..d2d2f22 100644 --- a/file.c +++ b/file.c @@ -1,5 +1,5 @@ /* - * Copyright (c) 1996 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. * @@ -17,21 +17,16 @@ #include "have_fpos.h" #include "fposval.h" #include "file.h" - +#include "calcerr.h" #define READSIZE 1024 /* buffer size for reading */ - /* - * XXX - the seek / tell stuff needs to deal with: - * - * files larger than 2^32 bytes (at least as large as 2^40 bytes) - * use Posix conventions - * use Posix file position types - * not assume that a 'long' can hold a file position - * - * Should use fgetpos and fsetpos functions. + * external STDIO functions */ +extern void math_setfp(FILE *fp); +extern FILE *f_open(char *name, char *mode); + /* * Table of opened files. @@ -58,11 +53,9 @@ static ZVALUE filepos2z(FILEPOS pos); static FILEPOS z2filepos(ZVALUE pos); static int set_open_pos(FILE *fp, ZVALUE zpos); static int get_open_pos(FILE *fp, ZVALUE *res); -static ZVALUE stsize2z(off_t siz); +static ZVALUE off_t2z(off_t siz); static ZVALUE dev2z(dev_t dev); static ZVALUE inode2z(ino_t inode); -static int get_open_siz(FILE *fp, ZVALUE *res); -static FILEIO *findid(FILEID id, int mode); static void getscanfield(FILE *fp, BOOL skip, unsigned int width, int scannum, char *scanptr, char **strptr); static void getscanwhite(FILE *fp, BOOL skip, unsigned int width, @@ -338,7 +331,7 @@ reopenid(FILEID id, char *mode, char *name) * If mode is 0, then no open checks are made at all, and NULL is then * returned if the id represents a closed file. */ -static FILEIO * +FILEIO * findid(FILEID id, int mode) { FILEIO *fiop; /* file structure */ @@ -405,7 +398,6 @@ indexid(long index) } - /* * Close the specified file id. Returns TRUE if there was an error. * Closing of stdin, stdout, or stderr is illegal, but closing of already @@ -519,6 +511,7 @@ flushid(FILEID id) return fflush(fiop->fp); } + int flushall(void) { @@ -566,7 +559,7 @@ readid(FILEID id, int flags, char **retptr) char *b; int c; BOOL nlstop, nullstop, wsstop, rmstop, done; - long fpos; + FILEPOS fpos; totlen = 0; str = NULL; @@ -582,9 +575,9 @@ readid(FILEID id, int flags, char **retptr) fp = fiop->fp; if (fiop->action == 'w') { - fpos = ftell(fp); + f_tell(fp, &fpos); fflush(fp); - if (fseek(fp, fpos, 0) < 0) + if (f_seek_set(fp, &fpos) < 0) return 3; } fiop->action = 'r'; @@ -650,15 +643,15 @@ int getcharid(FILEID id) { FILEIO *fiop; - long fpos; + FILEPOS fpos; fiop = findid(id, 'r'); if (fiop == NULL) return -2; if (fiop->action == 'w') { - fpos = ftell(fiop->fp); + f_tell(fiop->fp, &fpos); fflush(fiop->fp); - if (fseek(fiop->fp, fpos, SEEK_SET) < 0) + if (f_seek_set(fiop->fp, &fpos) < 0) return -3; } fiop->action = 'r'; @@ -756,19 +749,23 @@ idprintf(FILEID id, char *fmt, int count, VALUE **vals) long olddigits, newdigits; long width, precision; BOOL didneg, didprecision; - long fpos; + FILEPOS fpos; + BOOL printstring; + BOOL printchar; fiop = findid(id, 'w'); if (fiop == NULL) return 1; if (fiop->action == 'r') { - fpos = ftell(fiop->fp); - if (fseek(fiop->fp, fpos, SEEK_SET) < 0) + f_tell(fiop->fp, &fpos); + if (f_seek_set(fiop->fp, &fpos) < 0) return 3; } fiop->action = 'w'; + printstring = FALSE; + printchar = FALSE; math_setfp(fiop->fp); @@ -814,9 +811,11 @@ idprintf(FILEID id, char *fmt, int count, VALUE **vals) newdigits = precision; switch (ch) { - case 'd': case 's': + printstring = TRUE; case 'c': + printchar = TRUE; + case 'd': break; case 'f': newmode = MODE_REAL; @@ -860,14 +859,50 @@ idprintf(FILEID id, char *fmt, int count, VALUE **vals) * value directly. */ if ((width == 0) || - (vp->v_type == V_MAT) || (vp->v_type == V_LIST)) - { - printvalue(vp, PRINT_NORMAL); + (vp->v_type == V_MAT) || (vp->v_type == V_LIST)) { + switch(vp->v_type) { + case V_OCTET: + if (printstring) + math_str((char *)vp->v_octet); + else if (printchar) + math_chr(*vp->v_octet); + else + printvalue(vp, PRINT_NORMAL); + break; + case V_BLOCK: + if (printstring) + math_str((char *) + vp->v_block->data); + else if (printchar) + math_chr(*vp->v_block->data); + else + printvalue(vp, PRINT_NORMAL); + break; + case V_NBLOCK: + if (printstring) { + if (vp->v_nblock->blk->data != + NULL) + math_str((char *) + vp->v_nblock + ->blk->data); + } else if (printchar) { + if (vp->v_nblock->blk->data != + NULL) + math_chr(*vp->v_nblock-> + blk->data); + } else + printvalue(vp, PRINT_NORMAL); + break; + default: + printvalue(vp, PRINT_NORMAL); + } + math_setmode(oldmode); math_setdigits(olddigits); continue; } + /* * There is a field width. Collect the output in a string, * print it padded appropriately with spaces, and free it. @@ -875,7 +910,39 @@ idprintf(FILEID id, char *fmt, int count, VALUE **vals) * the field width. */ math_divertio(); - printvalue(vp, PRINT_NORMAL); + switch(vp->v_type) { + case V_OCTET: + if (printstring) + math_str((char *)vp->v_octet); + else if (printchar) + math_chr(*vp->v_octet); + else + printvalue(vp, PRINT_NORMAL); + break; + case V_BLOCK: + if (printstring) + math_str((char *)vp->v_block->data); + else if (printchar) + math_chr(*vp->v_block->data); + else + printvalue(vp, PRINT_NORMAL); + break; + case V_NBLOCK: + if (printstring) { + if (vp->v_nblock->blk->data != NULL) + math_str((char *) + vp->v_nblock->blk->data); + } + else if (printchar) { + if (vp->v_nblock->blk->data != NULL) + math_chr(*vp->v_nblock->blk->data); + } + else + printvalue(vp, PRINT_NORMAL); + break; + default: + printvalue(vp, PRINT_NORMAL); + } str = math_getdivertedio(); if (strchr(str, '\n')) width = 0; @@ -909,15 +976,15 @@ int idfputc(FILEID id, int ch) { FILEIO *fiop; - long fpos; + FILEPOS fpos; /* get the file info pointer */ fiop = findid(id, 'w'); if (fiop == NULL) return 1; if (fiop->action == 'r') { - fpos = ftell(fiop->fp); - if (fseek(fiop->fp, fpos, SEEK_SET)) + f_tell(fiop->fp, &fpos); + if (f_seek_set(fiop->fp, &fpos) < 0) return 2; } @@ -967,7 +1034,7 @@ int idfputs(FILEID id, char *str) { FILEIO *fiop; - long fpos; + FILEPOS fpos; /* get the file info pointer */ fiop = findid(id, 'w'); @@ -975,8 +1042,8 @@ idfputs(FILEID id, char *str) return 1; if (fiop->action == 'r') { - fpos = ftell(fiop->fp); - if (fseek(fiop->fp, fpos, SEEK_SET)) + f_tell(fiop->fp, &fpos); + if (f_seek_set(fiop->fp, &fpos) < 0) return 2; } @@ -993,6 +1060,7 @@ idfputs(FILEID id, char *str) return 0; } + /* * Same as idfputs but writes a terminating null character * @@ -1004,7 +1072,7 @@ int idfputstr(FILEID id, char *str) { FILEIO *fiop; - long fpos; + FILEPOS fpos; /* get the file info pointer */ fiop = findid(id, 'w'); @@ -1012,8 +1080,8 @@ idfputstr(FILEID id, char *str) return 1; if (fiop->action == 'r') { - fpos = ftell(fiop->fp); - if (fseek(fiop->fp, fpos, SEEK_SET)) + f_tell(fiop->fp, &fpos); + if (f_seek_set(fiop->fp, &fpos) < 0) return 2; } @@ -1032,6 +1100,7 @@ idfputstr(FILEID id, char *str) return 0; } + int rewindid(FILEID id) { @@ -1044,6 +1113,7 @@ rewindid(FILEID id) return 0; } + void rewindall(void) { @@ -1111,7 +1181,11 @@ z2filepos(ZVALUE zpos) FILEPOS tmp; /* temp file position as a FILEPOS */ #endif FILEPOS ret; /* file position as a FILEPOS */ +#if FILEPOS_BITS < FULL_BITS + long pos; /* zpos as a long */ +#else FULL pos; /* zpos as a FULL */ +#endif /* * firewall @@ -1121,14 +1195,21 @@ z2filepos(ZVALUE zpos) /* * quick return if the position can fit into a long */ -#if FILEPOS_BITS <= FULL_BITS +#if FILEPOS_BITS == FULL_BITS /* ztofull puts the value into native byte order */ pos = ztofull(zpos); /* on some hosts, FILEPOS is not a scalar */ memset(&ret, 0, sizeof(FILEPOS)); memcpy((void *)&ret, (void *)&pos, sizeof(FILEPOS)); return ret; -#else /* FILEPOS_BITS <= FULL_BITS */ +#elif FILEPOS_BITS < FULL_BITS + /* ztofull puts the value into native byte order */ + pos = ztolong(zpos); + /* on some hosts, FILEPOS is not a scalar */ + memset(&ret, 0, sizeof(FILEPOS)); + memcpy((void *)&ret, (void *)&pos, sizeof(pos)); + return ret; +#else /* FILEPOS_BITS > FULL_BITS */ if (!zgtmaxfull(zpos)) { /* ztofull puts the value into native byte order */ pos = ztofull(zpos); @@ -1177,18 +1258,10 @@ get_open_pos(FILE *fp, ZVALUE *res) /* * get the file position */ -#if defined(HAVE_FPOS) - if (fgetpos(fp, (FILEPOS *)&pos) < 0) { + if (f_tell(fp, &pos) < 0) { /* cannot get file position, return -1 */ return -1; } -#else - pos = ftell(fp); - if (pos < 0) { - /* cannot get file position, return -1 */ - return -1; - } -#endif /* * update file position and return success @@ -1235,42 +1308,91 @@ getloc(FILEID id, ZVALUE *res) return get_open_pos(fp, res); } -long -ftellid(FILEID id) + +int +ftellid(FILEID id, ZVALUE *res) { FILEIO *fiop; + FILEPOS fpos; /* current file position */ - fiop = findid(id, 0); - if (fiop == NULL) - return -2L; - return ftell(fiop->fp); -} - - -long -fseekid(FILEID id, long offset, int whence) -{ - FILEIO *fiop; - long i = 0; - + /* get FILEIO */ fiop = findid(id, 0); if (fiop == NULL) return -2; + + /* get the file position */ + if (f_tell(fiop->fp, &fpos) < 0) + return -3; + + /* convert file position to ZVALUE */ + *res = filepos2z(fpos); + return 0; +} + + +int +fseekid(FILEID id, ZVALUE offset, int whence) +{ + FILEIO *fiop; /* FILEIO of file */ + FILEPOS off; /* offset as a FILEPOS */ + ZVALUE cur, tmp; /* current or end of file location */ + int ret = 0; /* return code */ + + /* setup */ + fiop = findid(id, 0); + if (fiop == NULL) + return -2; + + /* seek depending on whence */ switch (whence) { case 0: - i = fseek(fiop->fp, offset, SEEK_SET); + /* construct seek position, off = offset */ + if (zisneg(offset)) + return -3; + off = z2filepos(offset); + + /* seek there */ + ret = f_seek_set(fiop->fp, &off); break; + case 1: - i = fseek(fiop->fp, offset, SEEK_CUR); + /* construct seek position, off = cur+offset */ + f_tell(fiop->fp, &off); + cur = filepos2z(off); + zadd(cur, offset, &tmp); + zfree(cur); + if (zisneg(tmp)) { + zfree(tmp); + return -3; + } + off = z2filepos(tmp); + zfree(tmp); + + /* seek there */ + ret = f_seek_set(fiop->fp, &off); break; + case 2: - i = fseek(fiop->fp, offset, SEEK_END); + /* construct seek position, off = len+offset */ + if (get_open_siz(fiop->fp, &cur) < 0) + return -4; + zadd(cur, offset, &tmp); + zfree(cur); + if (zisneg(tmp)) { + zfree(tmp); + return -3; + } + off = z2filepos(tmp); + zfree(tmp); + + /* seek there */ + ret = f_seek_set(fiop->fp, &off); break; + default: - math_error("This should not happen in fseekid"); - /*NOTREACHED*/ + return -5; } - return i; + return ret; } @@ -1301,17 +1423,10 @@ set_open_pos(FILE *fp, ZVALUE zpos) /* * set the file position */ -#if defined(HAVE_FPOS) - if (fsetpos(fp, (FILEPOS *)&pos) < 0) { + if (f_seek_set(fp, &pos) < 0) { /* cannot set file position, return -1 */ return -1; } -#else - if (fseek(fp, pos, 0) < 0) { - /* cannot set file position, return -1 */ - return -1; - } -#endif /* * return sucess @@ -1330,9 +1445,6 @@ set_open_pos(FILE *fp, ZVALUE zpos) * returns: * 0 able to set file position * -1 unable to set file position - * - * NOTE: Due to fsetpos limitation, position is set relative to only - * the beginning of the file. */ int setloc(FILEID id, ZVALUE zpos) @@ -1373,7 +1485,7 @@ setloc(FILEID id, ZVALUE zpos) /* - * stsize2z - convert a file size into a ZVALUE + * off_t2z - convert an off_t into a ZVALUE * * given: * siz file size @@ -1382,17 +1494,17 @@ setloc(FILEID id, ZVALUE zpos) * file size as a ZVALUE */ static ZVALUE -stsize2z(off_t siz) +off_t2z(off_t siz) { ZVALUE ret; /* ZVALUE file size to return */ /* * store off_t in a ZVALUE as a positive value */ - ret.len = STSIZE_BITS/BASEB; + ret.len = OFF_T_BITS/BASEB; ret.v = alloc(ret.len); zclearval(ret); - SWAP_HALF_IN_STSIZE(ret.v, &siz); + SWAP_HALF_IN_OFF_T(ret.v, &siz); ret.sign = 0; ztrim(&ret); @@ -1476,7 +1588,7 @@ inode2z(ino_t inode) * 0 res points to the file size * -1 error */ -static int +int get_open_siz(FILE *fp, ZVALUE *res) { struct stat buf; /* file status */ @@ -1492,7 +1604,7 @@ get_open_siz(FILE *fp, ZVALUE *res) /* * update file size and return success */ - *res = stsize2z(buf.st_size); + *res = off_t2z(buf.st_size); return 0; } @@ -1502,11 +1614,12 @@ get_open_siz(FILE *fp, ZVALUE *res) * * given: * id file id of the file - * siz pointer to result + * res pointer to result * * returns: - * 0 able to get file size - * -1 unable to get file size + * 0 able to get file size + * EOF system error + * other nonzero file not open or other problem */ int getsize(FILEID id, ZVALUE *res) @@ -1520,11 +1633,11 @@ getsize(FILEID id, ZVALUE *res) fiop = findid(id, 0); if (fiop == NULL) { /* file not open */ - return -1; + return 1; } fp = fiop->fp; if (fp == NULL) { - return -2; + return 2; } /* @@ -1599,25 +1712,43 @@ get_inode(FILEID id, ZVALUE *inode) return 0; } -/* deal with file sizes > long */ -long -filesize(FILEID id) + +static off_t +filesize(FILEIO *fiop) { - FILEIO *fiop; struct stat sbuf; - fiop = findid(id, 0); - if (fiop == NULL) - return -1; - + /* return length */ if (fstat(fileno(fiop->fp), &sbuf) < 0) { math_error("bad fstat"); /*NOTREACHED*/ } - - return (long) sbuf.st_size; + return sbuf.st_size; } + +ZVALUE +zfilesize(FILEID id) +{ + FILEIO *fiop; + off_t len; /* file length */ + ZVALUE ret; /* file size as a ZVALUE return value */ + + /* file FILEIO */ + fiop = findid(id, 0); + if (fiop == NULL) { + /* return neg value for non-file error */ + itoz(-1, &ret); + return ret; + } + + /* get length */ + len = filesize(fiop); + ret = off_t2z(len); + return ret; +} + + void showfiles(void) { @@ -1824,6 +1955,7 @@ getscanwhite(FILE *fp, BOOL skip, unsigned int width, int scannum, char **strptr } } + static int fscanfile(FILE *fp, char *fmt, int count, VALUE **vals) { @@ -1837,6 +1969,8 @@ fscanfile(FILE *fp, char *fmt, int count, VALUE **vals) BOOL skip; /* True if string to be skipped rather than read */ int width; VALUE *var; /* lvalue to be assigned to */ + short subtype; /* for var->v_subtype */ + FILEPOS cur; /* current location */ if (feof(fp)) return EOF; @@ -1923,8 +2057,11 @@ fscanfile(FILE *fp, char *fmt, int count, VALUE **vals) if (var->v_type != V_ADDR) math_error("This should not happen!!"); var = var->v_addr; + subtype = var->v_subtype; + freevalue(var); count--; freadsum(fp, var); + var->v_subtype = subtype; continue; case 'n': assnum++; @@ -1933,8 +2070,13 @@ fscanfile(FILE *fp, char *fmt, int count, VALUE **vals) if (var->v_type != V_ADDR) math_error("This should not happen!!"); var = var->v_addr; + subtype = var->v_subtype; + freevalue(var); var->v_type = V_NUM; - var->v_num = itoq(ftell(fp)); + var->v_num = qalloc(); + f_tell(fp, &cur); + var->v_num->num = filepos2z(cur); + var->v_subtype = subtype; continue; default: fprintf(stderr, "Unsupported scan specifier"); @@ -1945,21 +2087,23 @@ fscanfile(FILE *fp, char *fmt, int count, VALUE **vals) var = *vals++; count--; if (var->v_type != V_ADDR) - math_error("Assigning to nonvariable XXX"); + math_error("Assigning to nonvariable"); var = var->v_addr; + subtype = var->v_subtype; + freevalue(var); var->v_type = V_STR; - var->v_subtype = V_STRALLOC; - var->v_str = str; + var->v_str = makestring(str); } } } + int fscanfid(FILEID id, char *fmt, int count, VALUE **vals) { FILEIO *fiop; FILE *fp; - long fpos; + FILEPOS fpos; fiop = findid(id, 'r'); if (fiop == NULL) @@ -1968,9 +2112,9 @@ fscanfid(FILEID id, char *fmt, int count, VALUE **vals) fp = fiop->fp; if (fiop->action == 'w') { - fpos = ftell(fp); + f_tell(fp, &fpos); fflush(fp); - if (fseek(fp, fpos, 0) < 0) + if (f_seek_set(fp, &fpos) < 0) return -4; } fiop->action = 'r'; @@ -2009,7 +2153,7 @@ scanfstr(char *str, char *fmt, int count, VALUE **vals) static void freadnum(FILE *fp, VALUE *valptr) { - ZVALUE num, den, newnum, newden, div, tmp; + ZVALUE num, zden, newnum, newden, div, tmp; NUMBER *q; COMPLEX *c; VALUE val; @@ -2099,13 +2243,13 @@ freadnum(FILE *fp, VALUE *valptr) *valptr = error_value(E_BIGEXP); return; } - ztenpow(decimals, &den); + ztenpow(decimals, &zden); if (exp) { ztenpow(exp, &tmp); if (negexp) { - zmul(den, tmp, &newden); - zfree(den); - den = newden; + zmul(zden, tmp, &newden); + zfree(zden); + zden = newden; } else { zmul(num, tmp, &newnum); zfree(num); @@ -2113,22 +2257,23 @@ freadnum(FILE *fp, VALUE *valptr) } zfree(tmp); } - if (!zisunit(num) && !zisunit(den)) { - zgcd(num, den, &div); + if (!zisunit(num) && !zisunit(zden)) { + zgcd(num, zden, &div); if (!zisunit(div)) { zequo(num, div, &newnum); zfree(num); - zequo(den, div, &newden); - zfree(den); + zequo(zden, div, &newden); + zfree(zden); num = newnum; - den = newden; + zden = newden; } } q = qalloc(); q->num = num; - q->den = den; + q->den = zden; if (imag) { c = comalloc(); + qfree(c->imag); c->imag = q; val.v_type = V_COM; val.v_com = c; @@ -2140,6 +2285,7 @@ freadnum(FILE *fp, VALUE *valptr) *valptr = val; } + static void freadsum(FILE *fp, VALUE *valptr) { @@ -2189,6 +2335,7 @@ freadprod(FILE *fp, VALUE *valptr) *valptr = v1; } + static void fskipnum(FILE *fp) { @@ -2214,6 +2361,7 @@ fskipnum(FILE *fp) ungetc(ch, fp); } + int isattyid(FILEID id) { @@ -2225,84 +2373,237 @@ isattyid(FILEID id) return isatty(fileno(fiop->fp)); } -long -fsearch(FILEID id, char *str, long pos) -{ - FILEIO *fiop; - FILE *fp; - long len, n, i; - char c; - char *s; +/* + * fsearch - search for a string in a file + * + * given: + * id FILEID to search + * str string to look for + * pos file postion to start at (NULL => current position) + * + * returns: + * EOF if system error + * other negative integer if file not open, etc. + * positive integer if string not found + * zero if string found, position stored at res + * + * XXX - This search is a translation of the original search that did not + * work with large files. The search algorithm used is slow and + * should be spead up much more. + */ +int +fsearch(FILEID id, char *str, ZVALUE start, ZVALUE end, ZVALUE *res) +{ + FILEIO *fiop; /* FILEIO of file id */ + FILEPOS cur; /* current file position */ + ZVALUE tmp, tmp2; /* temporary ZVALUEs */ + char c; /* str comparison character */ + int r; /* character read from file */ + char *s; /* str comparison pointer */ + long k = 0; + + /* get FILEIO */ fiop = findid(id, 'r'); if (fiop == NULL) return -2; - fp = fiop->fp; - if (pos < 0) - pos = ftell(fp); + + /* + * file setup + */ if (fiop->action == 'w') - fflush(fp); - fseek(fp, pos, SEEK_SET); - len = (long)strlen(str); - if (len == 0) - return pos; - c = *str++; - n = filesize(id) - pos - len; - while (n-- >= 0) { - if ((char) fgetc(fp) == c) { - s = str; - i = len; - while (--i > 0 && (char) fgetc(fp) == *s++); - if (i == 0) - return pos; - fseek(fp, pos + 1, SEEK_SET); - } - pos++; + fflush(fiop->fp); + + zsub(end, start, &tmp2); + + if (zisneg(tmp2)) { + zfree(tmp2); + return 1; } - return -1; + + tmp.sign = 0; + tmp.len = tmp2.len; + tmp.v = alloc(tmp.len); + zcopyval(tmp2, tmp); + zfree(tmp2); + + cur = z2filepos(start); + + if (f_seek_set(fiop->fp, &cur) < 0) { + zfree(tmp); + return EOF; + } + + /* + * search setup + */ + /* note the first str search character */ + c = *str++; + + if (c == '\0') { + zfree(tmp); + return 2; + } + clearerr(fiop->fp); + while ((r = fgetc(fiop->fp)) != EOF) { + if ((char)r == c) { + (void) f_tell(fiop->fp, &cur); + s = str; + while (*s) { + r = fgetc(fiop->fp); + if ((char)r != *s) + break; + s++; + } + if (r == EOF) + break; + if (*s == '\0') { + zfree(tmp); + tmp = filepos2z(cur); + zsub(tmp, _one_, res); + zfree(tmp); + return 0; + } + (void) f_seek_set(fiop->fp, &cur); + } + if (*tmp.v) + (*tmp.v)--; + else { + if (tmp.len == 1) + break; + k = 0; + do { + tmp.v[k++] = BASE1; + } + while (k < tmp.len && tmp.v[k] == 0); + if (k == tmp.len) { + math_error("This should not happen"); + /*NOTREACHED*/ + } + tmp.v[k]--; + if (tmp.v[tmp.len - 1] == 0) + tmp.len--; + } + } + zfree(tmp); + if (ferror(fiop->fp)) + return EOF; + return 1; } -long -frsearch(FILEID id, char *str, long pos) +/* + * frsearch - reverse search for a string in a file + * + * given: + * id FILEID to search + * str string to look for + * search starts at pos = first and continues for decreasing + * pos >= last + * + * returns: + * EOF if system error + * other negative integer if file not open, etc. + * positive integer if string not found + * zero if string found, position stored at res + * + * XXX - This search is a translation of the original search that did not + * work with large files. The search algorithm used is so slow + * as to be painful to the user and needs to be sped up much more. + */ +int +frsearch(FILEID id, char *str, ZVALUE first, ZVALUE last, ZVALUE *res) { - FILEIO *fiop; - FILE *fp; - long len, n, i; - char c; - char *s; + FILEIO *fiop; /* FILEIO of file id */ + FILEPOS cur; /* current file position */ + ZVALUE pos; /* current file position as ZVALUE */ + ZVALUE tmp; /* temporary ZVALUEs */ + char c; /* str comparison character */ + int r; /* character read from file */ + char *s; /* str comparison pointer */ + /* get FILEIO */ fiop = findid(id, 'r'); if (fiop == NULL) return -2; - fp = fiop->fp; - if (pos < 0) - pos = ftell(fp); + + /* + * file setup + */ if (fiop->action == 'w') - fflush(fp); - n = filesize(id); - if (pos > n) - pos = n; - len = (long)strlen(str); - if (pos < len) { - fseek(fp, pos, SEEK_SET); - return -1; - } - pos -= len; - if (len == 0) - return pos; + fflush(fiop->fp); + + zcopy(first, &pos); + + /* + * search setup + */ + /* note the first str search character */ c = *str++; - while (pos >= 0) { - fseek(fp, pos, SEEK_SET); - if ((char) fgetc(fp) == c) { - s = str; - i = len; - while (--i > 0 && (char) fgetc(fp) == *s++); - if (i == 0) - return pos; + + if (c == '\0') { + cur = z2filepos(pos); + if (f_seek_set(fiop->fp, &cur) < 0) { + zfree(pos); + return EOF; } - pos--; + *res = pos; + return 0; } - fseek(fp, 0, SEEK_SET); - return -1; + + clearerr(fiop->fp); + + while(zrel(pos, last) >= 0) { + cur = z2filepos(pos); + if (f_seek_set(fiop->fp, &cur) < 0) { + zfree(pos); + return EOF; + } + r = fgetc(fiop->fp); + if (r == EOF) { + zfree(pos); + return EOF; + } + if ((char) r == c) { + s = str; + while (*s) { + r = fgetc(fiop->fp); + if ((char)r != *s) + break; + s++; + } + if (r == EOF) { + zfree(pos); + return EOF; + } + if (*s == '\0') { + *res = pos; + ungetc(r, fiop->fp); + return 0; + } + } + zsub(pos, _one_, &tmp); + zfree(pos); + pos = tmp; + } + cur = z2filepos(last); + f_seek_set(fiop->fp, &cur); + zfree(pos); + if (ferror(fiop->fp)) + return EOF; + return 1; +} + + +char * +findfname(FILEID id) +{ + FILEIO *fiop; + + fiop = findid(id, 0); + + if (fiop == NULL) + return NULL; + + return fiop->name; } diff --git a/file.h b/file.h index 826e569..796f580 100644 --- a/file.h +++ b/file.h @@ -1,11 +1,16 @@ /* - * Copyright (c) 1996 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. * * File I/O routines callable by users. */ + +#if !defined(__FILE_H__) +#define __FILE_H__ + + #include "have_fpos.h" @@ -56,5 +61,11 @@ typedef struct { /* * external functions */ +extern FILEIO * findid(FILEID id, int mode); extern int fgetposid(FILEID id, FILEPOS *ptr); extern int fsetposid(FILEID id, FILEPOS *ptr); +extern int get_open_siz(FILE *fp, ZVALUE *res); +extern char* findfname(FILEID); + + +#endif /* !__FILE_H__ */ diff --git a/fposval.c b/fposval.c index f1de9e4..658ab3a 100644 --- a/fposval.c +++ b/fposval.c @@ -14,8 +14,8 @@ * * FILEPOS_BITS length in bits of the type FILEPOS * SWAP_HALF_IN_FILEPOS will copy/swap FILEPOS into an HALF array - * STSIZE_BITS length in bits of the st_size stat element - * SWAP_HALF_IN_STSIZE will copy/swap st_size into an HALF array + * OFF_T_BITS length in bits of the st_size stat element + * SWAP_HALF_IN_OFF_T will copy/swap st_size into an HALF array * DEV_BITS length in bits of the st_dev stat element * SWAP_HALF_IN_DEV will copy/swap st_dev into an HALF array * INODE_BITS length in bits of the st_ino stat element @@ -55,6 +55,8 @@ #include #include "have_fpos.h" #include "endian_calc.h" +#include "have_offscl.h" +#include "have_posscl.h" char *program; /* our name */ @@ -78,7 +80,7 @@ main(int argc, char **argv) fileposlen = sizeof(FILEPOS)*8; printf("#undef FILEPOS_BITS\n"); printf("#define FILEPOS_BITS %d\n", fileposlen); -#if BYTE_ORDER == BIG_ENDIAN +#if CALC_BYTE_ORDER == BIG_ENDIAN /* * Big Endian */ @@ -93,49 +95,64 @@ main(int argc, char **argv) program, fileposlen); exit(1); } -#else /* BYTE_ORDER == BIG_ENDIAN */ +#else /* CALC_BYTE_ORDER == BIG_ENDIAN */ /* * Little Endian - * + */ +#if defined(HAVE_FILEPOS_SCALAR) + printf("#define SWAP_HALF_IN_FILEPOS(dest, src)\t\t%s\n", + "(*(dest) = *(src))"); +#else /* HAVE_FILEPOS_SCALAR */ + /* * Normally a "(*(dest) = *(src))" would do, but on some - * systems, a FILEPOS is not a scalar hince we must memcpy. + * systems a FILEPOS is not a scalar hince we must memcpy. */ printf("#define SWAP_HALF_IN_FILEPOS(dest, src)\t%s%d%s\n", "memcpy((void *)(dest), (void *)(src), sizeof(",fileposlen,"))"); -#endif /* BYTE_ORDER == BIG_ENDIAN */ +#endif /* HAVE_FILEPOS_SCALAR */ +#endif /* CALC_BYTE_ORDER == BIG_ENDIAN */ putchar('\n'); /* * print the stat file size information */ stsizelen = sizeof(buf.st_size)*8; - printf("#undef STSIZE_BITS\n"); - printf("#define STSIZE_BITS %d\n", stsizelen); -#if BYTE_ORDER == BIG_ENDIAN + printf("#undef OFF_T_BITS\n"); + printf("#define OFF_T_BITS %d\n", stsizelen); +#if CALC_BYTE_ORDER == BIG_ENDIAN /* * Big Endian */ if (stsizelen == 64) { - printf("#define SWAP_HALF_IN_STSIZE(dest, src)\t\t%s\n", + printf("#define SWAP_HALF_IN_OFF_T(dest, src)\t\t%s\n", "SWAP_HALF_IN_B64(dest, src)"); } else if (stsizelen == 32) { - printf("#define SWAP_HALF_IN_STSIZE(dest, src)\t\t%s\n", + printf("#define SWAP_HALF_IN_OFF_T(dest, src)\t\t%s\n", "SWAP_HALF_IN_B32(dest, src)"); } else { fprintf(stderr, "%s: unexpected st_size bit size: %d\n", program, stsizelen); exit(2); } -#else /* BYTE_ORDER == BIG_ENDIAN */ +#else /* CALC_BYTE_ORDER == BIG_ENDIAN */ /* * Little Endian * * Normally a "(*(dest) = *(src))" would do, but on some - * systems, a STSIZE is not a scalar hince we must memcpy. + * systems an off_t is not a scalar hince we must memcpy. */ - printf("#define SWAP_HALF_IN_STSIZE(dest, src)\t%s%d%s\n", +#if defined(HAVE_OFF_T_SCALAR) + printf("#define SWAP_HALF_IN_OFF_T(dest, src)\t\t%s\n", + "(*(dest) = *(src))"); +#else /* HAVE_OFF_T_SCALAR */ + /* + * Normally a "(*(dest) = *(src))" would do, but on some + * systems, a off_t is not a scalar hince we must memcpy. + */ + printf("#define SWAP_HALF_IN_OFF_T(dest, src)\t%s%d%s\n", "memcpy((void *)(dest), (void *)(src), sizeof(",stsizelen,"))"); -#endif /* BYTE_ORDER == BIG_ENDIAN */ +#endif /* HAVE_OFF_T_SCALAR */ +#endif /* CALC_BYTE_ORDER == BIG_ENDIAN */ putchar('\n'); /* @@ -144,7 +161,7 @@ main(int argc, char **argv) devlen = sizeof(buf.st_dev)*8; printf("#undef DEV_BITS\n"); printf("#define DEV_BITS %d\n", devlen); -#if BYTE_ORDER == BIG_ENDIAN +#if CALC_BYTE_ORDER == BIG_ENDIAN /* * Big Endian */ @@ -162,7 +179,7 @@ main(int argc, char **argv) program, devlen); exit(3); } -#else /* BYTE_ORDER == BIG_ENDIAN */ +#else /* CALC_BYTE_ORDER == BIG_ENDIAN */ /* * Little Endian * @@ -171,7 +188,7 @@ main(int argc, char **argv) */ printf("#define SWAP_HALF_IN_DEV(dest, src)\t%s%d%s\n", "memcpy((void *)(dest), (void *)(src), sizeof(",devlen,"))"); -#endif /* BYTE_ORDER == BIG_ENDIAN */ +#endif /* CALC_BYTE_ORDER == BIG_ENDIAN */ putchar('\n'); /* @@ -180,7 +197,7 @@ main(int argc, char **argv) inodelen = sizeof(buf.st_ino)*8; printf("#undef INODE_BITS\n"); printf("#define INODE_BITS %d\n", inodelen); -#if BYTE_ORDER == BIG_ENDIAN +#if CALC_BYTE_ORDER == BIG_ENDIAN /* * Big Endian */ @@ -198,7 +215,7 @@ main(int argc, char **argv) program, inodelen); exit(4); } -#else /* BYTE_ORDER == BIG_ENDIAN */ +#else /* CALC_BYTE_ORDER == BIG_ENDIAN */ /* * Little Endian * @@ -207,6 +224,6 @@ main(int argc, char **argv) */ printf("#define SWAP_HALF_IN_INODE(dest, src)\t%s%d%s\n", "memcpy((void *)(dest), (void *)(src), sizeof(",inodelen,"))"); -#endif /* BYTE_ORDER == BIG_ENDIAN */ +#endif /* CALC_BYTE_ORDER == BIG_ENDIAN */ exit(0); } diff --git a/func.c b/func.c index 98abba6..0958b8b 100644 --- a/func.c +++ b/func.c @@ -1,5 +1,5 @@ /* - * Copyright (c) 1996 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. * @@ -7,6 +7,7 @@ */ +#include #include #include @@ -52,18 +53,24 @@ #include "prime.h" #include "file.h" #include "zrand.h" +#include "zrandom.h" +#include "custom.h" + +#if defined(CUSTOM) +# define E_CUSTOM_ERROR E_NO_C_ARG +#else +# define E_CUSTOM_ERROR E_NO_CUSTOM +#endif /* * forward declarations */ static NUMBER *base_value(long mode); -static long zsize(ZVALUE z); -static long qsize(NUMBER *q); -static long lsizeof(VALUE *vp); static int strscan(char *s, int count, VALUE **vals); static int filescan(FILEID id, int count, VALUE **vals); static VALUE f_eval(VALUE *vp); +static VALUE f_fsize(VALUE *vp); @@ -93,7 +100,7 @@ extern int idungetc(FILEID id, int ch); /* - * used defined error strings + * user-defined error strings */ static short nexterrnum = E_USERDEF; static STRINGHEAD newerrorstr; @@ -132,10 +139,12 @@ f_eval(VALUE *vp) FUNC *oldfunc; FUNC *newfunc; VALUE result; + char *cp; if (vp->v_type != V_STR) return error_value(E_EVAL2); - switch (openstring(vp->v_str)) { + cp = vp->v_str->s_str; + switch (openstring(cp)) { case -2: return error_value(E_EVAL3); case -1: @@ -150,6 +159,7 @@ f_eval(VALUE *vp) curfunc = oldfunc; result = newfunc->f_savedvalue; newfunc->f_savedvalue.v_type = V_NULL; + freenumbers(newfunc); if (newfunc != oldfunc) free(newfunc); return result; @@ -159,6 +169,7 @@ f_eval(VALUE *vp) curfunc = oldfunc; freevalue(&newfunc->f_savedvalue); newfunc->f_savedvalue.v_type = V_NULL; + freenumbers(newfunc); if (newfunc != oldfunc) free(newfunc); return error_value(E_EVAL); @@ -171,7 +182,9 @@ f_prompt(VALUE *vp) VALUE result; char *cp; char *newcp; + unsigned int len; + result.v_type = V_STR; if (inputisterminal()) { printvalue(vp, PRINT_SHORT); math_flush(); @@ -182,38 +195,49 @@ f_prompt(VALUE *vp) /*NOTREACHED*/ } if (*cp == '\0') { - result.v_type = V_STR; - result.v_subtype = V_STRLITERAL; - result.v_str = ""; + result.v_str = slink(&_nullstring_); return result; } - newcp = (char *)malloc(strlen(cp) + 1); + len = strlen(cp); + newcp = (char *) malloc(len + 1); if (newcp == NULL) { math_error("Cannot allocate string"); /*NOTREACHED*/ } strcpy(newcp, cp); - result.v_str = newcp; + result.v_str = makestring(newcp); result.v_type = V_STR; - result.v_subtype = V_STRALLOC; return result; } +/*ARGSUSED*/ +static VALUE +f_null(int count, VALUE **vals) +{ + VALUE res; + + res.v_type = 0; + return res; +} + + static VALUE f_str(VALUE *vp) { VALUE result; - static char *cp; + char *cp; + result.v_type = V_STR; switch (vp->v_type) { case V_STR: - copyvalue(vp, &result); + result.v_str = stringcopy(vp->v_str); return result; case V_NULL: - result.v_str = ""; - result.v_type = V_STR; - result.v_subtype = V_STRLITERAL; + result.v_str = slink(&_nullstring_); + return result; + case V_OCTET: + result.v_str = charstring(*vp->v_octet); return result; case V_NUM: math_divertio(); @@ -228,13 +252,45 @@ f_str(VALUE *vp) default: return error_value(E_STR); } - result.v_str = cp; - result.v_type = V_STR; - result.v_subtype = V_STRALLOC; + result.v_str = makestring(cp); return result; } +static VALUE +f_name (VALUE *vp) +{ + VALUE result; + char *cp; + char *name; + + result.v_type = V_STR; + switch (vp->v_type) { + case V_NBLOCK: + result.v_type = V_STR; + result.v_str = makenewstring(vp->v_nblock->name); + return result; + case V_FILE: + name = findfname(vp->v_file); + if (name == NULL) { + result.v_type = V_NULL; + return result; + } + math_divertio(); + math_str(name); + cp = math_getdivertedio(); + break; + default: + result.v_type = V_NULL; + return result; + } + result.v_str = makestring(cp); + result.v_type = V_STR; + return result; +} + + + static VALUE f_poly(int count, VALUE **vals) { @@ -721,7 +777,7 @@ f_rand(int count, NUMBER **vals) /* parse args */ switch (count) { case 0: /* rand() == rand(2^64) */ - /* generate a random number */ + /* generate an a55 random number */ ans = qalloc(); zrand(SBITS, &ans->num); break; @@ -755,7 +811,7 @@ f_rand(int count, NUMBER **vals) return NULL; } - /* return the random number */ + /* return the a55 random number */ return ans; } @@ -768,7 +824,6 @@ f_randbit(int count, NUMBER **vals) long cnt; /* bits needed or skipped */ /* parse args */ - if (count == 0) { zrand(1, &ztmp); ans = ziszero(ztmp) ? qlink(&_qzero_) : qlink(&_qone_); @@ -789,7 +844,7 @@ f_randbit(int count, NUMBER **vals) } /* - * generate a random number or skip random bits + * generate an a55 random number or skip random bits */ ans = qalloc(); cnt = ztolong(vals[0]->num); @@ -803,7 +858,7 @@ f_randbit(int count, NUMBER **vals) } /* - * return the random number + * return the a55 random number */ return ans; } @@ -862,6 +917,101 @@ f_srand(int count, VALUE **vals) } +static NUMBER * +f_random(int count, NUMBER **vals) +{ + NUMBER *ans; + + /* parse args */ + switch (count) { + case 0: /* random() == random(2^64) */ + /* generate a Blum-Blum-Shub random number */ + ans = qalloc(); + zrandom(SBITS, &ans->num); + break; + + case 1: /* random(limit) */ + if (!qisint(vals[0])) { + math_error("random limit must be an integer"); + /*NOTREACHED*/ + } + if (zislezero(vals[0]->num)) { + math_error("random limit must > 0"); + /*NOTREACHED*/ + } + ans = qalloc(); + zrandomrange(_zero_, vals[0]->num, &ans->num); + break; + + case 2: /* random(low, limit) */ + /* firewall */ + if (!qisint(vals[0]) || !qisint(vals[1])) { + math_error("random range must be integers"); + /*NOTREACHED*/ + } + ans = qalloc(); + zrandomrange(vals[0]->num, vals[1]->num, &ans->num); + break; + + default: + math_error("invalid number of args passed to random"); + /*NOTREACHED*/ + return NULL; + } + + /* return the Blum-Blum-Shub random number */ + return ans; +} + + +static NUMBER * +f_randombit(int count, NUMBER **vals) +{ + NUMBER *ans; + ZVALUE ztmp; + long cnt; /* bits needed or skipped */ + + /* parse args */ + if (count == 0) { + zrandom(1, &ztmp); + ans = ziszero(ztmp) ? qlink(&_qzero_) : qlink(&_qone_); + zfree(ztmp); + return ans; + } + + /* + * firewall + */ + if (!qisint(vals[0])) { + math_error("random bit count must be an integer"); + /*NOTREACHED*/ + } + if (zge31b(vals[0]->num)) { + math_error("huge random bit count"); + /*NOTREACHED*/ + } + + /* + * generate a Blum-Blum-Shub random number or skip random bits + */ + ans = qalloc(); + cnt = ztolong(vals[0]->num); + if (zisneg(vals[0]->num)) { + /* skip bits */ + zrandomskip(cnt); + itoz(cnt, &ans->num); + } else { + /* generate bits */ + zrandom(cnt, &ans->num); + } + + /* + * return the Blum-Blum-Shub random number + */ + return ans; +} + + static VALUE f_srandom(int count, VALUE **vals) { @@ -869,12 +1019,12 @@ f_srandom(int count, VALUE **vals) /* parse args */ switch (count) { - case 0: + case 0: /* srandom() */ /* get the current random state */ result.v_random = zsetrandom(NULL); break; - case 1: + case 1: /* srandom(seed) or srandom(state) */ switch (vals[0]->v_type) { case V_NUM: /* srand(seed) */ /* seed Blum and return previous state */ @@ -883,7 +1033,7 @@ f_srandom(int count, VALUE **vals) "srandom number seed must be an integer"); /*NOTREACHED*/ } - result.v_random = zsrandom(vals[0]->v_num->num, NULL); + result.v_random = zsrandom1(vals[0]->v_num->num, TRUE); break; case V_RANDOM: /* srandom(state) */ @@ -898,6 +1048,46 @@ f_srandom(int count, VALUE **vals) } break; + case 2: /* srandom(seed, newn) */ + if (vals[0]->v_type != V_NUM || !qisint(vals[0]->v_num)) { + math_error("srandom seed must be an integer"); + /*NOTREACHED*/ + } + if (vals[1]->v_type != V_NUM || !qisint(vals[1]->v_num)) { + math_error("srandom Blum modulus must be an integer"); + /*NOTREACHED*/ + } + result.v_random = zsrandom2(vals[0]->v_num->num, + vals[1]->v_num->num); + break; + + case 4: /* srandom(seed, ip, iq, trials) */ + if (vals[0]->v_type != V_NUM || !qisint(vals[0]->v_num)) { + math_error("srandom seed must be an integer"); + /*NOTREACHED*/ + } + if (vals[1]->v_type != V_NUM || !qisint(vals[1]->v_num)) { + math_error("srandom 2nd arg must be an integer"); + /*NOTREACHED*/ + } + if (vals[2]->v_type != V_NUM || !qisint(vals[2]->v_num)) { + math_error("srandom 3rd arg must be an integer"); + /*NOTREACHED*/ + } + if (vals[3]->v_type != V_NUM || !qisint(vals[3]->v_num)) { + math_error("srandom 4th arg must be an integer"); + /*NOTREACHED*/ + } + if (zge24b(vals[3]->v_num->num)) { + math_error("srandom trials count is excessive"); + /*NOTREACHED*/ + } + result.v_random = zsrandom4(vals[0]->v_num->num, + vals[1]->v_num->num, + vals[2]->v_num->num, + ztoi(vals[3]->v_num->num)); + break; + default: math_error("bad arg count to srandom()"); /*NOTREACHED*/ @@ -922,20 +1112,26 @@ f_primetest(int count, NUMBER **vals) } -static NUMBER * -f_isset(NUMBER *val1, NUMBER *val2) +static VALUE +f_setbit(int count, VALUE **vals) { - if (qisfrac(val2)) { - math_error("Non-integral bit position"); - /*NOTREACHED*/ - } - if (qiszero(val1) || (qisint(val1) && qisneg(val2))) - return qlink(&_qzero_); - if (zge31b(val2->num)) { - math_error("Very large bit position"); - /*NOTREACHED*/ - } - return itoq((long) qisset(val1, qtoi(val2))); + BOOL r; + long index; + VALUE result; + + r = (count == 3) ? testvalue(vals[2]) : 1; + + if (vals[1]->v_type != V_NUM || qisfrac(vals[1]->v_num)) + return error_value(E_SETBIT1); + if (zge31b(vals[1]->v_num->num)) + return error_value(E_SETBIT2); + if (vals[0]->v_type != V_STR) + return error_value(E_SETBIT3); + index = qtoi(vals[1]->v_num); + if (stringsetbit(vals[0]->v_str, index, r)) + return error_value(E_SETBIT2); + result.v_type = V_NULL; + return result; } @@ -974,47 +1170,268 @@ f_places(NUMBER *val) static NUMBER * -f_xor(int count, NUMBER **vals) +f_popcnt(int count, NUMBER **vals) { - NUMBER *val, *tmp; + int bitval = 1; - val = qlink(*vals); - while (--count > 0) { - tmp = qxor(val, *++vals); - qfree(val); - val = tmp; + /* + * parse args + */ + if (count == 2 && qiszero(vals[1])) { + bitval = 0; + } + + /* + * count bit values + */ + if (qisint(vals[0])) { + return itoq(zpopcnt(vals[0]->num, bitval)); + } else { + return itoq(zpopcnt(vals[0]->num, bitval) + + zpopcnt(vals[0]->den, bitval)); } - return val; } -static NUMBER * -f_min(int count, NUMBER **vals) +static VALUE +f_xor(int count, VALUE **vals) { - NUMBER *val, *tmp; + NUMBER *q, *qtmp; + STRING *s, *stmp; + VALUE result; + int i; + int type; - val = qlink(*vals); - while (--count > 0) { - tmp = qmin(val, *++vals); - qfree(val); - val = tmp; + type = vals[0]->v_type; + result.v_type = type; + for (i = 1; i < count; i++) { + if (vals[i]->v_type != type) + return error_value(E_XOR1); } - return val; + switch (type) { + case V_NUM: + q = qlink(vals[0]->v_num); + for (i = 1; i < count; i++) { + qtmp = qxor(q, vals[i]->v_num); + qfree(q); + q = qtmp; + } + result.v_num = q; + break; + case V_STR: + s = slink(vals[0]->v_str); + for (i = 1; i < count; i++) { + stmp = stringxor(s, vals[i]->v_str); + sfree(s); + s = stmp; + } + result.v_str = s; + break; + default: + return error_value(E_XOR2); + } + return result; } -static NUMBER * -f_max(int count, NUMBER **vals) +VALUE +minlistitems(LIST *lp) { - NUMBER *val, *tmp; + LISTELEM *ep; + VALUE *vp; + VALUE term; + VALUE rel; + VALUE min; - val = qlink(*vals); - while (--count > 0) { - tmp = qmax(val, *++vals); - qfree(val); - val = tmp; + min.v_type = V_NULL; + + for (ep = lp->l_first; ep; ep = ep->e_next) { + vp = &ep->e_value; + switch(vp->v_type) { + case V_LIST: + term = minlistitems(vp->v_list); + break; + case V_OBJ: + term = objcall(OBJ_MIN, vp, + NULL_VALUE, NULL_VALUE); + break; + default: + copyvalue(vp, &term); + } + if (min.v_type == V_NULL) { + min = term; + continue; + } + if (term.v_type == V_NULL) + continue; + relvalue(&term, &min, &rel); + if (rel.v_type != V_NUM) { + freevalue(&term); + freevalue(&min); + freevalue(&rel); + return error_value(E_LISTMIN); + } + if (qisneg(rel.v_num)) { + freevalue(&min); + min = term; + } + else + freevalue(&term); + freevalue(&rel); } - return val; + return min; +} + + +VALUE +maxlistitems(LIST *lp) +{ + LISTELEM *ep; + VALUE *vp; + VALUE term; + VALUE rel; + VALUE max; + + max.v_type = V_NULL; + + for (ep = lp->l_first; ep; ep = ep->e_next) { + vp = &ep->e_value; + switch(vp->v_type) { + case V_LIST: + term = maxlistitems(vp->v_list); + break; + case V_OBJ: + term = objcall(OBJ_MAX, vp, + NULL_VALUE, NULL_VALUE); + break; + default: + copyvalue(vp, &term); + } + if (max.v_type == V_NULL) { + max = term; + continue; + } + if (term.v_type == V_NULL) + continue; + relvalue(&max, &term, &rel); + if (rel.v_type != V_NUM) { + freevalue(&max); + freevalue(&term); + freevalue(&rel); + return error_value(E_LISTMAX); + } + if (qisneg(rel.v_num)) { + freevalue(&max); + max = term; + } + else + freevalue(&term); + freevalue(&rel); + } + return max; +} + + +static VALUE +f_min(int count, VALUE **vals) +{ + VALUE min; + VALUE term; + VALUE *vp; + VALUE rel; + + min.v_type = V_NULL; + while (count-- > 0) { + vp = *vals++; + switch(vp->v_type) { + case V_LIST: + term = minlistitems(vp->v_list); + break; + case V_OBJ: + term = objcall(OBJ_MIN, vp, + NULL_VALUE, NULL_VALUE); + break; + default: + copyvalue(vp, &term); + } + if (min.v_type == V_NULL) { + min = term; + continue; + } + if (term.v_type == V_NULL) + continue; + if (term.v_type < 0) { + freevalue(&min); + return term; + } + relvalue(&term, &min, &rel); + if (rel.v_type != V_NUM) { + freevalue(&min); + freevalue(&term); + freevalue(&rel); + return error_value(E_MIN); + } + if (qisneg(rel.v_num)) { + freevalue(&min); + min = term; + } + else + freevalue(&term); + freevalue(&rel); + } + return min; +} + + +static VALUE +f_max(int count, VALUE **vals) +{ + VALUE max; + VALUE term; + VALUE *vp; + VALUE rel; + + max.v_type = V_NULL; + + while (count-- > 0) { + vp = *vals++; + switch(vp->v_type) { + case V_LIST: + term = maxlistitems(vp->v_list); + break; + case V_OBJ: + term = objcall(OBJ_MAX, vp, + NULL_VALUE, NULL_VALUE); + break; + default: + copyvalue(vp, &term); + } + if (max.v_type == V_NULL) { + max = term; + continue; + } + if (term.v_type == V_NULL) + continue; + if (term.v_type < 0) { + freevalue(&max); + return term; + } + relvalue(&max, &term, &rel); + if (rel.v_type != V_NUM) { + freevalue(&max); + freevalue(&term); + freevalue(&rel); + return error_value(E_MAX); + } + if (qisneg(rel.v_num)) { + freevalue(&max); + max = term; + } + else + freevalue(&term); + freevalue(&rel); + } + return max; } @@ -1023,7 +1440,7 @@ f_gcd(int count, NUMBER **vals) { NUMBER *val, *tmp; - val = qabs(*vals); + val = qqabs(*vals); while (--count > 0) { tmp = qgcd(val, *++vals); qfree(val); @@ -1038,7 +1455,7 @@ f_lcm(int count, NUMBER **vals) { NUMBER *val, *tmp; - val = qabs(*vals); + val = qqabs(*vals); while (--count > 0) { tmp = qlcm(val, *++vals); qfree(val); @@ -1069,6 +1486,90 @@ f_hash(int count, VALUE **vals) } +VALUE +sumlistitems(LIST *lp) +{ + LISTELEM *ep; + VALUE *vp; + VALUE term; + VALUE tmp; + VALUE sum; + + sum.v_type = V_NULL; + + for (ep = lp->l_first; ep; ep = ep->e_next) { + vp = &ep->e_value; + switch(vp->v_type) { + case V_LIST: + term = sumlistitems(vp->v_list); + break; + case V_OBJ: + term = objcall(OBJ_SUM, vp, + NULL_VALUE, NULL_VALUE); + break; + default: + copyvalue(vp, &term); + } + if (sum.v_type == V_NULL) { + sum = term; + continue; + } + if (term.v_type == V_NULL) + continue; + addvalue(&sum, &term, &tmp); + freevalue(&sum); + freevalue(&term); + sum = tmp; + if (sum.v_type < 0) + break; + } + return sum; +} + + +static VALUE +f_sum(int count, VALUE **vals) +{ + VALUE tmp; + VALUE sum; + VALUE term; + VALUE *vp; + + sum.v_type = V_NULL; + while (count-- > 0) { + vp = *vals++; + switch(vp->v_type) { + case V_LIST: + term = sumlistitems(vp->v_list); + break; + case V_OBJ: + term = objcall(OBJ_SUM, vp, + NULL_VALUE, NULL_VALUE); + break; + default: + copyvalue(vp, &term); + } + if (sum.v_type == V_NULL) { + sum = term; + continue; + } + if (term.v_type == V_NULL) + continue; + if (term.v_type < 0) { + freevalue(&sum); + return term; + } + addvalue(&sum, &term, &tmp); + freevalue(&term); + freevalue(&sum); + sum = tmp; + if (sum.v_type < 0) + return sum; + } + return sum; +} + + static VALUE f_avg(int count, VALUE **vals) { @@ -1104,6 +1605,24 @@ f_avg(int count, VALUE **vals) } +static VALUE +f_fact(VALUE *vp) +{ + VALUE res; + + if (vp->v_type == V_OBJ) { + return objcall(OBJ_FACT, vp, NULL_VALUE, NULL_VALUE); + } + if (vp->v_type != V_NUM) { + math_error("Non-real argument for fact()"); + /*NOTREACHED*/ + } + res.v_type = V_NUM; + res.v_num = qfact(vp->v_num); + return res; +} + + static VALUE f_hmean(int count, VALUE **vals) { @@ -1136,6 +1655,46 @@ f_hmean(int count, VALUE **vals) } +static NUMBER * +f_hnrmod(NUMBER *val1, NUMBER *val2, NUMBER *val3, NUMBER *val4) +{ + ZVALUE answer; /* v mod h*2^n+r */ + NUMBER *res; /* v mod h*2^n+r */ + + /* + * firewall + */ + if (qisfrac(val1)) { + math_error("1st arg of hnrmod (v) must be an integer"); + /*NOTREACHED*/ + } + if (qisfrac(val2) || qisneg(val2) || qiszero(val2)) { + math_error("2nd arg of hnrmod (h) must be an integer > 0"); + /*NOTREACHED*/ + } + if (qisfrac(val3) || qisneg(val3) || qiszero(val3)) { + math_error("3rd arg of hnrmod (n) must be an integer > 0"); + /*NOTREACHED*/ + } + if (qisfrac(val4) || !zisabsleone(val4->num)) { + math_error("4th arg of hnrmod (r) must be -1, 0 or 1"); + /*NOTREACHED*/ + } + + /* + * perform the val1 mod (val2 * 2^val3 + val4) operation + */ + zhnrmod(val1->num, val2->num, val3->num, val4->num, &answer); + + /* + * return the answer + */ + res = qalloc(); + res->num = answer; + return res; +} + + static VALUE f_ssq(int count, VALUE **vals) { @@ -1319,6 +1878,968 @@ f_sin(int count, VALUE **vals) } +static VALUE +f_tan(int count, VALUE **vals) +{ + VALUE result; + VALUE tmp1, tmp2; + NUMBER *err; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_TAN1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + result.v_num = qtan(vals[0]->v_num, err); + result.v_type = V_NUM; + break; + case V_COM: + tmp1.v_type = V_COM; + tmp1.v_com = csin(vals[0]->v_com, err); + tmp2.v_type = V_COM; + tmp2.v_com = ccos(vals[0]->v_com, err); + divvalue(&tmp1, &tmp2, &result); + comfree(tmp1.v_com); + comfree(tmp2.v_com); + break; + default: + return error_value(E_TAN2); + } + return result; +} + +static VALUE +f_sec(int count, VALUE **vals) +{ + VALUE result; + VALUE tmp; + NUMBER *err; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_SEC1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + result.v_num = qsec(vals[0]->v_num, err); + result.v_type = V_NUM; + break; + case V_COM: + tmp.v_type = V_COM; + tmp.v_com = ccos(vals[0]->v_com, err); + invertvalue(&tmp, &result); + comfree(tmp.v_com); + break; + default: + return error_value(E_SEC2); + } + return result; +} + + +static VALUE +f_cot(int count, VALUE **vals) +{ + VALUE result; + VALUE tmp1, tmp2; + NUMBER *err; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_COT1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + if (qiszero(vals[0]->v_num)) + return error_value(E_1OVER0); + result.v_num = qcot(vals[0]->v_num, err); + result.v_type = V_NUM; + break; + case V_COM: + tmp1.v_type = V_COM; + tmp1.v_com = ccos(vals[0]->v_com, err); + tmp2.v_type = V_COM; + tmp2.v_com = csin(vals[0]->v_com, err); + divvalue(&tmp1, &tmp2, &result); + comfree(tmp1.v_com); + comfree(tmp2.v_com); + break; + default: + return error_value(E_COT2); + } + return result; +} + + +static VALUE +f_csc(int count, VALUE **vals) +{ + VALUE result; + VALUE tmp; + NUMBER *err; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_CSC1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + if (qiszero(vals[0]->v_num)) + return error_value(E_1OVER0); + result.v_num = qcsc(vals[0]->v_num, err); + result.v_type = V_NUM; + break; + case V_COM: + tmp.v_type = V_COM; + tmp.v_com = csin(vals[0]->v_com, err); + invertvalue(&tmp, &result); + comfree(tmp.v_com); + break; + default: + return error_value(E_CSC2); + } + return result; +} + +static VALUE +f_sinh(int count, VALUE **vals) +{ + VALUE result; + NUMBER *err; + NUMBER *q; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_SINH1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + result.v_num = qsinh(vals[0]->v_num, err); + result.v_type = V_NUM; + break; + case V_COM: + result.v_com = csinh(vals[0]->v_com, err); + result.v_type = V_COM; + if (cisreal(result.v_com)) { + q = qlink(result.v_com->real); + comfree(result.v_com); + result.v_num = q; + result.v_type = V_NUM; + } + break; + default: + return error_value(E_SINH2); + } + return result; +} + +static VALUE +f_cosh(int count, VALUE **vals) +{ + VALUE result; + NUMBER *err; + NUMBER *q; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_COSH1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + result.v_num = qcosh(vals[0]->v_num, err); + result.v_type = V_NUM; + break; + case V_COM: + result.v_com = ccosh(vals[0]->v_com, err); + result.v_type = V_COM; + if (cisreal(result.v_com)) { + q = qlink(result.v_com->real); + comfree(result.v_com); + result.v_num = q; + result.v_type = V_NUM; + } + break; + default: + return error_value(E_COSH2); + } + return result; +} + + +static VALUE +f_tanh(int count, VALUE **vals) +{ + VALUE result; + VALUE tmp1, tmp2; + NUMBER *err; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_TANH1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + result.v_num = qtanh(vals[0]->v_num, err); + result.v_type = V_NUM; + break; + case V_COM: + tmp1.v_type = V_COM; + tmp1.v_com = csinh(vals[0]->v_com, err); + tmp2.v_type = V_COM; + tmp2.v_com = ccosh(vals[0]->v_com, err); + divvalue(&tmp1, &tmp2, &result); + comfree(tmp1.v_com); + comfree(tmp2.v_com); + break; + default: + return error_value(E_TANH2); + } + return result; +} + + +static VALUE +f_coth(int count, VALUE **vals) +{ + VALUE result; + VALUE tmp1, tmp2; + NUMBER *err; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_COTH1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + if (qiszero(vals[0]->v_num)) + return error_value(E_1OVER0); + result.v_num = qcoth(vals[0]->v_num, err); + result.v_type = V_NUM; + break; + case V_COM: + tmp1.v_type = V_COM; + tmp1.v_com = ccosh(vals[0]->v_com, err); + tmp2.v_type = V_COM; + tmp2.v_com = csinh(vals[0]->v_com, err); + divvalue(&tmp1, &tmp2, &result); + comfree(tmp1.v_com); + comfree(tmp2.v_com); + break; + default: + return error_value(E_COTH2); + } + return result; +} + + +static VALUE +f_sech(int count, VALUE **vals) +{ + VALUE result; + VALUE tmp; + NUMBER *err; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_SECH1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + result.v_num = qsech(vals[0]->v_num, err); + result.v_type = V_NUM; + break; + case V_COM: + tmp.v_type = V_COM; + tmp.v_com = ccosh(vals[0]->v_com, err); + invertvalue(&tmp, &result); + comfree(tmp.v_com); + break; + default: + return error_value(E_SECH2); + } + return result; +} + + +static VALUE +f_csch(int count, VALUE **vals) +{ + VALUE result; + VALUE tmp; + NUMBER *err; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_CSCH1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + if (qiszero(vals[0]->v_num)) + return error_value(E_1OVER0); + result.v_num = qcsch(vals[0]->v_num, err); + result.v_type = V_NUM; + break; + case V_COM: + tmp.v_type = V_COM; + tmp.v_com = csinh(vals[0]->v_com, err); + invertvalue(&tmp, &result); + comfree(tmp.v_com); + break; + default: + return error_value(E_CSCH2); + } + return result; +} + + +static VALUE +f_atan(int count, VALUE **vals) +{ + VALUE result; + COMPLEX *tmp; + NUMBER *err; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_ATAN1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + result.v_num = qatan(vals[0]->v_num, err); + result.v_type = V_NUM; + break; + case V_COM: + tmp = catan(vals[0]->v_com, err); + if (tmp == NULL) + return error_value(E_LOGINF); + result.v_type = V_COM; + result.v_com = tmp; + if (cisreal(tmp)) { + result.v_num = qlink(tmp->real); + result.v_type = V_NUM; + comfree(tmp); + } + break; + default: + return error_value(E_ATAN2); + } + return result; +} + + +static VALUE +f_acot(int count, VALUE **vals) +{ + VALUE result; + COMPLEX *tmp; + NUMBER *err; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_ACOT1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + result.v_num = qacot(vals[0]->v_num, err); + result.v_type = V_NUM; + break; + case V_COM: + tmp = cacot(vals[0]->v_com, err); + if (tmp == NULL) + return error_value(E_LOGINF); + result.v_type = V_COM; + result.v_com = tmp; + if (cisreal(tmp)) { + result.v_num = qlink(tmp->real); + result.v_type = V_NUM; + comfree(tmp); + } + break; + default: + return error_value(E_ACOT2); + } + return result; +} + +static VALUE +f_asin(int count, VALUE **vals) +{ + VALUE result; + COMPLEX *tmp; + NUMBER *err; + NUMBER *q; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_ASIN1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + result.v_num = qasin(vals[0]->v_num, err); + result.v_type = V_NUM; + if (result.v_num == NULL) { + tmp = comalloc(); + qfree(tmp->real); + tmp->real = qlink(vals[0]->v_num); + result.v_type = V_COM; + result.v_com = casin(tmp, err); + comfree(tmp); + } + break; + case V_COM: + result.v_com = casin(vals[0]->v_com, err); + result.v_type = V_COM; + break; + default: + return error_value(E_ASIN2); + } + if (result.v_type == V_COM && cisreal(result.v_com)) { + q = qlink(result.v_com->real); + comfree(result.v_com); + result.v_type = V_NUM; + result.v_num = q; + } + return result; +} + +static VALUE +f_acos(int count, VALUE **vals) +{ + VALUE result; + COMPLEX *tmp; + NUMBER *err; + NUMBER *q; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_ACOS1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + result.v_num = qacos(vals[0]->v_num, err); + result.v_type = V_NUM; + if (result.v_num == NULL) { + tmp = comalloc(); + qfree(tmp->real); + tmp->real = qlink(vals[0]->v_num); + result.v_type = V_COM; + result.v_com = cacos(tmp, err); + comfree(tmp); + } + break; + case V_COM: + result.v_com = cacos(vals[0]->v_com, err); + result.v_type = V_COM; + break; + default: + return error_value(E_ACOS2); + } + if (result.v_type == V_COM && cisreal(result.v_com)) { + q = qlink(result.v_com->real); + comfree(result.v_com); + result.v_type = V_NUM; + result.v_num = q; + } + return result; +} + + +static VALUE +f_asec(int count, VALUE **vals) +{ + VALUE result; + COMPLEX *tmp; + NUMBER *err; + NUMBER *q; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_ASEC1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + if (qiszero(vals[0]->v_num)) + return error_value(E_LOGINF); + result.v_num = qasec(vals[0]->v_num, err); + result.v_type = V_NUM; + if (result.v_num == NULL) { + tmp = comalloc(); + qfree(tmp->real); + tmp->real = qlink(vals[0]->v_num); + result.v_com = casec(tmp, err); + result.v_type = V_COM; + comfree(tmp); + } + break; + case V_COM: + result.v_com = casec(vals[0]->v_com, err); + result.v_type = V_COM; + break; + default: + return error_value(E_ASEC2); + } + if (result.v_type == V_COM) { + if (result.v_com == NULL) + return error_value(E_LOGINF); + if (cisreal(result.v_com)) { + q = qlink(result.v_com->real); + comfree(result.v_com); + result.v_type = V_NUM; + result.v_num = q; + } + } + return result; +} + + +static VALUE +f_acsc(int count, VALUE **vals) +{ + VALUE result; + COMPLEX *tmp; + NUMBER *err; + NUMBER *q; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_ACSC1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + if (qiszero(vals[0]->v_num)) + return error_value(E_LOGINF); + result.v_num = qacsc(vals[0]->v_num, err); + result.v_type = V_NUM; + if (result.v_num == NULL) { + tmp = comalloc(); + qfree(tmp->real); + tmp->real = qlink(vals[0]->v_num); + result.v_com = cacsc(tmp, err); + result.v_type = V_COM; + comfree(tmp); + } + break; + case V_COM: + result.v_com = cacsc(vals[0]->v_com, err); + result.v_type = V_COM; + break; + default: + return error_value(E_ACSC2); + } + if (result.v_type == V_COM) { + if (result.v_com == NULL) + return error_value(E_LOGINF); + if (cisreal(result.v_com)) { + q = qlink(result.v_com->real); + comfree(result.v_com); + result.v_type = V_NUM; + result.v_num = q; + } + } + return result; +} + + +static VALUE +f_asinh(int count, VALUE **vals) +{ + VALUE result; + COMPLEX *tmp; + NUMBER *err; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_ASINH1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + result.v_num = qasinh(vals[0]->v_num, err); + result.v_type = V_NUM; + break; + case V_COM: + tmp = casinh(vals[0]->v_com, err); + result.v_type = V_COM; + result.v_com = tmp; + if (cisreal(tmp)) { + result.v_num = qlink(tmp->real); + result.v_type = V_NUM; + comfree(tmp); + } + break; + default: + return error_value(E_ASINH2); + } + return result; +} + + +static VALUE +f_acosh(int count, VALUE **vals) +{ + VALUE result; + COMPLEX *tmp; + NUMBER *err; + NUMBER *q; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_ACOSH1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + result.v_num = qacosh(vals[0]->v_num, err); + result.v_type = V_NUM; + if (result.v_num == NULL) { + tmp = comalloc(); + qfree(tmp->real); + tmp->real = qlink(vals[0]->v_num); + result.v_com = cacosh(tmp, err); + result.v_type = V_COM; + comfree(tmp); + } + break; + case V_COM: + result.v_com = cacosh(vals[0]->v_com, err); + result.v_type = V_COM; + break; + default: + return error_value(E_ACOSH2); + } + if (result.v_type == V_COM && cisreal(result.v_com)) { + q = qlink(result.v_com->real); + comfree(result.v_com); + result.v_type = V_NUM; + result.v_num = q; + } + return result; +} + + +static VALUE +f_atanh(int count, VALUE **vals) +{ + VALUE result; + COMPLEX *tmp; + NUMBER *err; + NUMBER *q; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_ATANH1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + result.v_num = qatanh(vals[0]->v_num, err); + result.v_type = V_NUM; + if (result.v_num == NULL) { + tmp = comalloc(); + qfree(tmp->real); + tmp->real = qlink(vals[0]->v_num); + result.v_com = catanh(tmp, err); + result.v_type = V_COM; + comfree(tmp); + } + break; + case V_COM: + result.v_com = catanh(vals[0]->v_com, err); + result.v_type = V_COM; + break; + default: + return error_value(E_ATANH2); + } + if (result.v_type == V_COM) { + if (result.v_com == NULL) + return error_value(E_LOGINF); + if (cisreal(result.v_com)) { + q = qlink(result.v_com->real); + comfree(result.v_com); + result.v_type = V_NUM; + result.v_num = q; + } + } + return result; +} + + +static VALUE +f_acoth(int count, VALUE **vals) +{ + VALUE result; + COMPLEX *tmp; + NUMBER *err; + NUMBER *q; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_ACOTH1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + result.v_num = qacoth(vals[0]->v_num, err); + result.v_type = V_NUM; + if (result.v_num == NULL) { + tmp = comalloc(); + qfree(tmp->real); + tmp->real = qlink(vals[0]->v_num); + result.v_com = cacoth(tmp, err); + result.v_type = V_COM; + comfree(tmp); + } + break; + case V_COM: + result.v_com = cacoth(vals[0]->v_com, err); + result.v_type = V_COM; + break; + default: + return error_value(E_ACOTH2); + } + if (result.v_type == V_COM) { + if (result.v_com == NULL) + return error_value(E_LOGINF); + if (cisreal(result.v_com)) { + q = qlink(result.v_com->real); + comfree(result.v_com); + result.v_type = V_NUM; + result.v_num = q; + } + } + return result; +} + + +static VALUE +f_asech(int count, VALUE **vals) +{ + VALUE result; + COMPLEX *tmp; + NUMBER *err; + NUMBER *q; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_SECH1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + if (qiszero(vals[0]->v_num)) + return error_value(E_LOGINF); + result.v_num = qasech(vals[0]->v_num, err); + result.v_type = V_NUM; + if (result.v_num == NULL) { + tmp = comalloc(); + qfree(tmp->real); + tmp->real = qlink(vals[0]->v_num); + result.v_com = casech(tmp, err); + result.v_type = V_COM; + comfree(tmp); + } + break; + case V_COM: + result.v_com = casech(vals[0]->v_com, err); + result.v_type = V_COM; + break; + default: + return error_value(E_ASECH2); + } + if (result.v_type == V_COM) { + if (result.v_com == NULL) + return error_value(E_LOGINF); + if (cisreal(result.v_com)) { + q = qlink(result.v_com->real); + comfree(result.v_com); + result.v_type = V_NUM; + result.v_num = q; + } + } + return result; +} + + +static VALUE +f_acsch(int count, VALUE **vals) +{ + VALUE result; + COMPLEX *tmp; + NUMBER *err; + NUMBER *q; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_ACSCH1); + err = vals[1]->v_num; + } + switch (vals[0]->v_type) { + case V_NUM: + if (qiszero(vals[0]->v_num)) + return error_value(E_LOGINF); + result.v_num = qacsch(vals[0]->v_num, err); + result.v_type = V_NUM; + if (result.v_num == NULL) { + tmp = comalloc(); + qfree(tmp->real); + tmp->real = qlink(vals[0]->v_num); + result.v_com = cacsch(tmp, err); + result.v_type = V_COM; + comfree(tmp); + } + break; + case V_COM: + result.v_com = cacsch(vals[0]->v_com, err); + result.v_type = V_COM; + break; + default: + return error_value(E_ACSCH2); + } + if (result.v_type == V_COM) { + if (result.v_com == NULL) + return error_value(E_LOGINF); + if (cisreal(result.v_com)) { + q = qlink(result.v_com->real); + comfree(result.v_com); + result.v_type = V_NUM; + result.v_num = q; + } + } + return result; +} + + +static VALUE +f_gd(int count, VALUE **vals) +{ + VALUE result; + NUMBER *err; + NUMBER *q; + COMPLEX *tmp; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_GD1); + err = vals[1]->v_num; + } + result.v_type = V_COM; + switch (vals[0]->v_type) { + case V_NUM: + if (qiszero(vals[0]->v_num)) { + result.v_type = V_NUM; + result.v_num = qlink(&_qzero_); + return result; + } + tmp = comalloc(); + qfree(tmp->real); + tmp->real = qlink(vals[0]->v_num); + result.v_com = cgd(tmp, err); + comfree(tmp); + break; + case V_COM: + result.v_com = cgd(vals[0]->v_com, err); + break; + default: + return error_value(E_GD2); + } + if (result.v_com == NULL) + return error_value(E_LOGINF); + if (cisreal(result.v_com)) { + q = qlink(result.v_com->real); + comfree(result.v_com); + result.v_num = q; + result.v_type = V_NUM; + } + return result; +} + + +static VALUE +f_agd(int count, VALUE **vals) +{ + VALUE result; + NUMBER *err; + NUMBER *q; + COMPLEX *tmp; + + err = conf->epsilon; + if (count == 2) { + if (vals[1]->v_type != V_NUM || qiszero(vals[1]->v_num)) + return error_value(E_AGD1); + err = vals[1]->v_num; + } + result.v_type = V_COM; + switch (vals[0]->v_type) { + case V_NUM: + if (qiszero(vals[0]->v_num)) { + result.v_type = V_NUM; + result.v_num = qlink(&_qzero_); + return result; + } + tmp = comalloc(); + qfree(tmp->real); + tmp->real = qlink(vals[0]->v_num); + result.v_com = cagd(tmp, err); + comfree(tmp); + break; + case V_COM: + result.v_com = cagd(vals[0]->v_com, err); + break; + default: + return error_value(E_AGD2); + } + if (result.v_com == NULL) + return error_value(E_LOGINF); + if (cisreal(result.v_com)) { + q = qlink(result.v_com->real); + comfree(result.v_com); + result.v_num = q; + result.v_type = V_NUM; + } + return result; +} + + static VALUE f_arg(int count, VALUE **vals) { @@ -1522,9 +3043,8 @@ f_ceil(VALUE *val) VALUE tmp, res; tmp.v_type = V_NUM; - tmp.v_num = qlink(&_qone_); + tmp.v_num = &_qone_; apprvalue(val, &tmp, &tmp, &res); - qfree(tmp.v_num); return res; } @@ -1535,46 +3055,14 @@ f_floor(VALUE *val) VALUE tmp1, tmp2, res; tmp1.v_type = V_NUM; - tmp1.v_num = qlink(&_qone_); + tmp1.v_num = &_qone_; tmp2.v_type = V_NUM; - tmp2.v_num = qlink(&_qzero_); + tmp2.v_num = &_qzero_; apprvalue(val, &tmp1, &tmp2, &res); - qfree(tmp1.v_num); - qfree(tmp2.v_num); return res; } -static NUMBER * -f_highbit(NUMBER *val) -{ - if (qiszero(val)) { - math_error("Highbit of zero"); - /*NOTREACHED*/ - } - if (qisfrac(val)) { - math_error("Highbit of non-integer"); - /*NOTREACHED*/ - } - return itoq(zhighbit(val->num)); -} - - -static NUMBER * -f_lowbit(NUMBER *val) -{ - if (qiszero(val)) { - math_error("Lowbit of zero"); - /*NOTREACHED*/ - } - if (qisfrac(val)) { - math_error("Lowbit of non-integer"); - /*NOTREACHED*/ - } - return itoq(zlowbit(val->num)); -} - - static VALUE f_sqrt(int count, VALUE **vals) { @@ -1697,14 +3185,20 @@ f_matfill(int count, VALUE **vals) if (v1->v_type != V_ADDR) return error_value(E_MATFILL1); v1 = v1->v_addr; + if (v1->v_subtype & V_NOCOPYTO) + return error_value(E_MATFILL3); if (v1->v_type != V_MAT) return error_value(E_MATFILL2); if (v2->v_type == V_ADDR) v2 = v2->v_addr; + if (v2->v_subtype & V_NOASSIGNFROM) + return error_value(E_MATFILL4); if (count == 3) { v3 = vals[2]; if (v3->v_type == V_ADDR) v3 = v3->v_addr; + if (v3->v_subtype & V_NOASSIGNFROM) + return error_value(E_MATFILL4); } else v3 = NULL; @@ -1734,14 +3228,25 @@ f_isident(VALUE *vp) { VALUE result; - if (vp->v_type != V_MAT) - return error_value(E_ISIDENT); result.v_type = V_NUM; - result.v_num = itoq((long) matisident(vp->v_mat)); + if (vp->v_type == V_MAT) { + result.v_num = itoq((long) matisident(vp->v_mat)); + } else { + result.v_num = itoq(0); + } return result; } +static VALUE +f_mattrace(VALUE *vp) +{ + if (vp->v_type != V_MAT) + return error_value(E_MATTRACE1); + return mattrace(vp->v_mat); +} + + static VALUE f_mattrans(VALUE *vp) { @@ -1779,10 +3284,18 @@ f_matdim(VALUE *vp) { VALUE result; - if (vp->v_type != V_MAT) - return error_value(E_MATDIM); result.v_type = V_NUM; - result.v_num = itoq((long) vp->v_mat->m_dim); + + switch(vp->v_type) { + case V_OBJ: + result.v_num = itoq(vp->v_obj->o_actions->count); + break; + case V_MAT: + result.v_num = itoq((long) vp->v_mat->m_dim); + break; + default: + return error_value(E_MATDIM); + } return result; } @@ -1874,11 +3387,67 @@ static VALUE f_strlen(VALUE *vp) { VALUE result; + long len = 0; + char *c; if (vp->v_type != V_STR) return error_value(E_STRLEN); + c = vp->v_str->s_str; + while (*c++) + len++; result.v_type = V_NUM; - result.v_num = itoq((long) strlen(vp->v_str)); + result.v_num = itoq(len); + return result; +} + + +static VALUE +f_strcmp(VALUE *v1, VALUE *v2) +{ + unsigned char *c1, *c2; + VALUE result; + + if (v1->v_type != V_STR || v2->v_type != V_STR) + return error_value(E_STRCMP); + + c1 = (unsigned char *)v1->v_str->s_str; + c2 = (unsigned char *)v2->v_str->s_str; + + result.v_type = V_NUM; + for (; *c1 == *c2; ++c1, ++c2) { + if (*c1 == '\0') { + result.v_num = qlink(&_qzero_); + return result; + } + } + result.v_num = (*c1 > *c2) ? qlink(&_qone_) : qlink(&_qnegone_); + return result; +} + + +static VALUE +f_strncmp(VALUE *v1, VALUE *v2, VALUE *v3) +{ + unsigned char *c1, *c2; + long i; + VALUE result; + + if (v1->v_type != V_STR || v2->v_type != V_STR || + v3->v_type != V_NUM || qisneg(v3->v_num) || + qisfrac(v3->v_num) || zge31b(v3->v_num->num)) + return error_value(E_STRNCMP); + i = qtoi(v3->v_num); + for (c1 = (unsigned char *)v1->v_str->s_str, + c2 = (unsigned char *)v2->v_str->s_str; + i > 0 && *c1 == *c2; ++c1, ++c2, --i) { + if (*c1 == '\0') + break; + } + result.v_type = V_NUM; + if (i == 0 || *c1 == *c2) + result.v_num = qlink(&_qzero_); + else + result.v_num = (*c1>*c2) ? qlink(&_qone_) : qlink(&_qnegone_); return result; } @@ -1886,35 +3455,72 @@ f_strlen(VALUE *vp) static VALUE f_strcat(int count, VALUE **vals) { - register VALUE **vp; - register char *cp; + VALUE **vp; + char *c, *c1; int i; long len; - long lengths[IN]; VALUE result; - len = 1; + len = 0; + result.v_type = V_STR; vp = vals; - for (i = 0; i < count; i++) { + for (i = 0; i < count; i++, vp++) { if ((*vp)->v_type != V_STR) return error_value(E_STRCAT); - lengths[i] = (long)strlen((*vp)->v_str); - len += lengths[i]; - vp++; + c = (*vp)->v_str->s_str; + while (*c++) + len++; } - cp = (char *)malloc(len); - if (cp == NULL) { + if (len == 0) { + result.v_str = slink(&_nullstring_); + return result; + } + c = (char *) malloc(len + 1) ; + if (c == NULL) { math_error("No memory for strcat"); /*NOTREACHED*/ } - result.v_str = cp; - result.v_type = V_STR; - result.v_subtype = V_STRALLOC; - i = 0; + result.v_str = stralloc(); + result.v_str->s_str = c; + result.v_str->s_len = len; for (vp = vals; count-- > 0; vp++) { - strcpy(cp, (*vp)->v_str); - cp += lengths[i++]; + c1 = (*vp)->v_str->s_str; + while (*c1) + *c++ = *c1++; } + *c = '\0'; + return result; +} + + +static VALUE +f_strcpy(VALUE *v1, VALUE *v2) +{ + VALUE result; + + if (v1->v_type != V_STR || v2->v_type != V_STR) + return error_value(E_STRCPY); + result.v_str = stringcpy(v1->v_str, v2->v_str); + result.v_type = V_STR; + return result; +} + + +static VALUE +f_strncpy(VALUE *v1, VALUE *v2, VALUE *v3) +{ + VALUE result; + long num; + + if (v1->v_type != V_STR || v2->v_type != V_STR || + v3->v_type != V_NUM || qisfrac(v3->v_num) || qisneg(v3->v_num)) + return error_value(E_STRNCPY); + if (zge31b(v3->v_num->num)) + num = v2->v_str->s_len; + else + num = qtoi(v3->v_num); + result.v_str = stringncpy(v1->v_str, v2->v_str, num); + result.v_type = V_STR; return result; } @@ -1925,6 +3531,7 @@ f_substr(VALUE *v1, VALUE *v2, VALUE *v3) NUMBER *q1, *q2; long i1, i2, len; char *cp; + char *ccp; VALUE result; if (v1->v_type != V_STR) @@ -1937,38 +3544,27 @@ f_substr(VALUE *v1, VALUE *v2, VALUE *v3) return error_value(E_SUBSTR2); i1 = qtoi(q1); i2 = qtoi(q2); - cp = v1->v_str; + cp = v1->v_str->s_str; len = (long)strlen(cp); result.v_type = V_STR; if (i1 > 0) i1--; if (i1 >= len) { /* indexing off of end */ - result.v_subtype = V_STRLITERAL; - result.v_str = ""; + result.v_str = slink(&_nullstring_); return result; } cp += i1; len -= i1; - if ((i2 >= len) && (v1->v_subtype == V_STRLITERAL)) { - result.v_subtype = V_STRLITERAL; - result.v_str = cp; - return result; - } if (len > i2) len = i2; - if (len == 1) { - result.v_subtype = V_STRLITERAL; - result.v_str = charstr(*cp); - return result; - } - result.v_subtype = V_STRALLOC; - result.v_str = (char *)malloc(len + 1); - if (result.v_str == NULL) { + ccp = (char *) malloc(len + 1); + if (ccp == NULL) { math_error("No memory for substr"); /*NOTREACHED*/ } - strncpy(result.v_str, cp, len); - result.v_str[len] = '\0'; + strncpy(ccp, cp, len); + ccp[len] = '\0'; + result.v_str = makestring(ccp); return result; } @@ -1976,19 +3572,28 @@ f_substr(VALUE *v1, VALUE *v2, VALUE *v3) static VALUE f_char(VALUE *vp) { - long num; - NUMBER *q; + char ch; VALUE result; - if (vp->v_type != V_NUM) - return error_value(E_CHAR); - q = vp->v_num; - num = qtoi(q); - if (qisneg(q) || qisfrac(q) || !zistiny(q->num) || (num > 255)) - return error_value(E_CHAR); + switch(vp->v_type) { + case V_NUM: + if (qisfrac(vp->v_num)) + return error_value(E_CHAR); + ch = (char) vp->v_num->num.v[0]; + if (qisneg(vp->v_num)) + ch = -ch; + break; + case V_OCTET: + ch = *vp->v_octet; + break; + case V_STR: + ch = *vp->v_str->s_str; + break; + default: + return error_value(E_CHAR); + } result.v_type = V_STR; - result.v_subtype = V_STRLITERAL; - result.v_str = charstr((int) num); + result.v_str = charstring(ch); return result; } @@ -1996,14 +3601,70 @@ f_char(VALUE *vp) static VALUE f_ord(VALUE *vp) { - char *str; + OCTET *c; VALUE result; - if (vp->v_type != V_STR) - return error_value(E_ORD); - str = vp->v_str; + switch(vp->v_type) { + case V_STR: + c = (OCTET *)vp->v_str->s_str; + break; + case V_OCTET: + c = vp->v_octet; + break; + default: + return error_value(E_ORD); + } + result.v_type = V_NUM; - result.v_num = itoq((long) (*str & 0xff)); + result.v_num = itoq((long) (*c & 0xff)); + return result; +} + + +static VALUE +f_protect(int count, VALUE **vals) +{ + int i; + VALUE *v1, *v2; + VALUE result; + BOOL have_nblock; + + result.v_subtype = V_NOSUBTYPE; + result.v_type = V_NULL; + v1 = vals[0]; + have_nblock = (v1->v_type == V_NBLOCK); + if (!have_nblock) { + if (v1->v_type != V_ADDR) + return error_value(E_PROTECT1); + v1 = v1->v_addr; + } + if (count == 1) { + result.v_type = V_NUM; + if (have_nblock) + result.v_num = itoq(v1->v_nblock->subtype); + else + result.v_num = itoq(v1->v_subtype); + return result; + } + v2 = vals[1]; + if (v2->v_type == V_ADDR) + v2 = v2->v_addr; + if (v2->v_type != V_NUM || qisfrac(v2->v_num)) + return error_value(E_PROTECT2); + if (qisneg(v2->v_num) || zge31b(v2->v_num->num)) + return error_value(E_PROTECT3); + i = qtoi(v2->v_num); + if (i > MAXPROTECT) + return error_value(E_PROTECT3); + if (have_nblock) { + v1->v_nblock->subtype |= i; + return result; + } + if (i & V_PROTECTALL) { + protectall(v1, i); + return result; + } + v1->v_subtype |= i; return result; } @@ -2011,179 +3672,220 @@ f_ord(VALUE *vp) static VALUE f_size(VALUE *vp) { - long count; VALUE result; - switch (vp->v_type) { - case V_NULL: count = 0; break; - case V_MAT: count = vp->v_mat->m_size; break; - case V_LIST: count = vp->v_list->l_count; break; - case V_ASSOC: count = vp->v_assoc->a_count; break; - case V_OBJ: count = vp->v_obj->o_actions->count; break; - case V_FILE: count = filesize(vp->v_file); break; - case V_STR: count = (long)strlen(vp->v_str); break; - default: count = 1; break; + /* + * return information about the number of elements + * + * This is not the sizeof, see f_sizeof() for that information. + * This is not the memsize, see f_memsize() for that information. + * + * The size of a file is treated in a special way ... we do + * not use the number of elements, but rather the length + * of the file as would be reported by fsize(). + */ + if (vp->v_type == V_FILE) { + return f_fsize(vp); + } else { + result.v_type = V_NUM; + result.v_num = itoq(elm_count(vp)); } - result.v_type = V_NUM; - result.v_num = itoq(count); return result; } -static long -zsize(ZVALUE z) -{ - return (long)sizeof(ZVALUE) + (long)z.len * (long)sizeof(HALF); -} - - -static long -qsize(NUMBER *q) -{ - return (long)sizeof(NUMBER) + (long)zsize(q->num) + (long)zsize(q->den); -} - - -static long -lsizeof(VALUE *vp) -{ - long s; - long i, j; - VALUE *p; - LISTELEM *ep; - OBJECTACTIONS *oap; - ASSOCELEM *aep; - ASSOCELEM **ept; - - i = j = 0; - s = (long) sizeof(VALUE); - if (vp->v_type > 0) { - switch(vp->v_type) { - case V_INT: - case V_ADDR: - break; - case V_NUM: - s += qsize(vp->v_num); - break; - case V_COM: - s += sizeof(COMPLEX) + - qsize(vp->v_com->real) + - qsize(vp->v_com->imag); - break; - case V_STR: - s += (long)strlen(vp->v_str) + 1; - break; - case V_MAT: - s += sizeof(MATRIX); - i = vp->v_mat->m_size; - p = vp->v_mat->m_table; - while (i-- > 0) - s += lsizeof(p++); - break; - case V_LIST: - s += sizeof(LIST); - for (ep = vp->v_list->l_first;ep;ep=ep->e_next) - s += sizeof(LISTELEM) - sizeof(VALUE) - + lsizeof(&ep->e_value); - break; - case V_OBJ: - s += sizeof(OBJECT); - oap = vp->v_obj->o_actions; - s += (long)strlen(oap->name) + 1; - i = oap->count; - s += (i + 2) * sizeof(int); - p = vp->v_obj->o_table; - while (i-- > 0) - s += lsizeof(p++); - break; - case V_FILE: - s += sizeof(vp->v_file); - break; - case V_RAND: - s += sizeof(RAND); - break; - case V_RANDOM: - s += sizeof(RANDOM); - break; - case V_ASSOC: - s += sizeof(ASSOC); - i = vp->v_assoc->a_size; - ept = vp->v_assoc->a_table; - while (i-- > 0) { - s += sizeof(ASSOCELEM *); - for (aep = *ept++;aep;aep=aep->e_next){ - s += sizeof(ASSOCELEM) - sizeof(VALUE); - s += lsizeof(&aep->e_value); - j = aep->e_dim; - p = aep->e_indices; - while (j-- > 0) - s += lsizeof(p++); - } - } - break; - default: - math_error("sizeof not defined for value type"); - /*NOTREACHED*/ - } - } - return s; -} - - static VALUE f_sizeof(VALUE *vp) { VALUE result; + /* + * return information about memory footprint + * + * This is not the number of elements, see f_size() for that info. + * This is not the memsize, see f_memsize() for that information. + */ result.v_type = V_NUM; result.v_num = itoq(lsizeof(vp)); return result; } +static VALUE +f_memsize(VALUE *vp) +{ + VALUE result; + + /* + * return information about memory footprint + * + * This is not the number of elements, see f_size() for that info. + * This is not the sizeof, see f_sizeof() for that information. + */ + result.v_type = V_NUM; + result.v_num = itoq(memsize(vp)); + return result; +} + + static VALUE f_search(int count, VALUE **vals) { - VALUE *v1, *v2; - NUMBER *q; - long start; - long index = -1; + VALUE *v1, *v2, *v3, *v4; + NUMBER *start, *end; + VALUE vsize; + NUMBER *size; + ZVALUE pos; + ZVALUE indx; + long len; + ZVALUE zlen, tmp; VALUE result; + long l_start = 0, l_end = 0; + int i = 0; v1 = *vals++; v2 = *vals++; - start = 0; - if (count == 3) { - if ((*vals)->v_type != V_NUM) + if ((v1->v_type == V_FILE || v1->v_type == V_STR) && + v2->v_type != V_STR) + return error_value(E_SEARCH2); + start = end = NULL; + if (count > 2) { + v3 = *vals++; + if (v3->v_type != V_NUM && v3->v_type != V_NULL) return error_value(E_SEARCH3); - q = (*vals)->v_num; - if (qisfrac(q) || qisneg(q)) - return error_value(E_SEARCH3); - start = qtoi(q); + if (v3->v_type == V_NUM) { + start = v3->v_num; + if (qisfrac(start)) + return error_value(E_SEARCH3); + } } - switch (v1->v_type) { - case V_MAT: - index = matsearch(v1->v_mat, v2, start); - break; - case V_LIST: - index = listsearch(v1->v_list, v2, start); - break; - case V_ASSOC: - index = assocsearch(v1->v_assoc, v2, start); - break; - case V_FILE: - if (v2->v_type != V_STR) - return error_value(E_SEARCH2); - if (count == 2) start = -1; - index = fsearch(v1->v_file, v2->v_str, start); - break; - default: - return error_value(E_SEARCH1); + if (count > 3) { + v4 = *vals; + if (v4->v_type != V_NUM && v4->v_type != V_NULL) + return error_value(E_SEARCH4); + if (v4->v_type == V_NUM) { + end = v4->v_num; + if (qisfrac(end)) + return error_value(E_SEARCH4); + } } result.v_type = V_NULL; - if (index >= 0) { + vsize = f_size(v1); + if (vsize.v_type != V_NUM) + return error_value(E_SEARCH5); + size = vsize.v_num; + if (start) { + if (qisneg(start)) { + start = qqadd(size, start); + if (qisneg(start)) { + qfree(start); + start = qlink(&_qzero_); + } + } + else + start = qlink(start); + } + if (end) { + if (!qispos(end)) + end = qqadd(size, end); + else { + if (qrel(end, size) > 0) + end = qlink(size); + else + end = qlink(end); + } + } + if (v1->v_type == V_FILE) { + if (count == 2|| (count == 4 && + (start == NULL || end == NULL))) { + i = ftellid(v1->v_file, &pos); + if (i < 0) { + qfree(size); + if (start) + qfree(start); + if (end) + qfree(end); + return error_value(E_SEARCH5); + } + if (count == 2 || (count == 4 && end != NULL)) { + start = qalloc(); + start->num = pos; + } + else { + end = qalloc(); + end->num = pos; + } + } + if (start == NULL) + start = qlink(&_qzero_); + if (end == NULL) + end = size; + else + qfree(size); + len = v2->v_str->s_len; + utoz(len, &zlen); + zsub(end->num, zlen, &tmp); + zfree(zlen); + i = fsearch(v1->v_file, v2->v_str->s_str, + start->num, tmp, &indx); + zfree(tmp); + if (i == 2) { + result.v_type = V_NUM; + result.v_num = start; + qfree(end); + return result; + } + qfree(start); + qfree(end); + if (i == EOF) + return error_value(errno); + if (i < 0) + return error_value(E_SEARCH6); + if (i == 0) { + result.v_type = V_NUM; + result.v_num = qalloc(); + result.v_num->num = indx; + } + return result; + } + if (start == NULL) + start = qlink(&_qzero_); + if (end == NULL) + end = qlink(size); + if (qrel(start, end) >= 0) { + qfree(size); + qfree(start); + qfree(end); + return result; + } + qfree(size); + l_start = ztolong(start->num); + l_end = ztolong(end->num); + switch (v1->v_type) { + case V_MAT: + i = matsearch(v1->v_mat, v2, l_start, l_end, &indx); + break; + case V_LIST: + i = listsearch(v1->v_list, v2, l_start, l_end, &indx); + break; + case V_ASSOC: + i = assocsearch(v1->v_assoc, v2, l_start, l_end, &indx); + break; + case V_STR: + i = stringsearch(v1->v_str, v2->v_str, l_start, l_end, + &indx); + break; + default: + qfree(start); + qfree(end); + return error_value(E_SEARCH1); + } + qfree(start); + qfree(end); + if (i == 0) { result.v_type = V_NUM; - result.v_num = itoq(index); + result.v_num = qalloc(); + result.v_num->num = indx; } return result; } @@ -2192,46 +3894,183 @@ f_search(int count, VALUE **vals) static VALUE f_rsearch(int count, VALUE **vals) { - VALUE *v1, *v2; - NUMBER *q; - long start; - long index = -1; + VALUE *v1, *v2, *v3, *v4; + NUMBER *start, *end; + VALUE vsize; + NUMBER *size; + NUMBER *qlen; + NUMBER *qtmp; + ZVALUE pos; + ZVALUE indx; VALUE result; + long l_start = 0, l_end = 0; + int i; v1 = *vals++; v2 = *vals++; - start = MAXLONG; - if (count == 3) { - if ((*vals)->v_type != V_NUM) + if ((v1->v_type == V_FILE || v1->v_type == V_STR) && + v2->v_type != V_STR) + return error_value(E_RSEARCH2); + start = end = NULL; + if (count > 2) { + v3 = *vals++; + if (v3->v_type != V_NUM && v3->v_type != V_NULL) return error_value(E_RSEARCH3); - q = (*vals)->v_num; - if (qisfrac(q) || qisneg(q)) - return error_value(E_RSEARCH3); - start = qtoi(q); + if (v3->v_type == V_NUM) { + start = v3->v_num; + if (qisfrac(start)) + return error_value(E_RSEARCH3); + } } - switch (v1->v_type) { - case V_MAT: - index = matrsearch(v1->v_mat, v2, start); - break; - case V_LIST: - index = listrsearch(v1->v_list, v2, start); - break; - case V_ASSOC: - index = assocrsearch(v1->v_assoc, v2, start); - break; - case V_FILE: - if (v2->v_type != V_STR) - return error_value(E_RSEARCH2); - if (count == 2) start = -1; - index = frsearch(v1->v_file, v2->v_str, start); - break; - default: - return error_value(E_RSEARCH1); + if (count > 3) { + v4 = *vals; + if (v4->v_type != V_NUM && v4->v_type != V_NULL) + return error_value(E_RSEARCH4); + if (v4->v_type == V_NUM) { + end = v4->v_num; + if (qisfrac(end)) + return error_value(E_RSEARCH3); + } } result.v_type = V_NULL; - if (index >= 0) { + vsize = f_size(v1); + if (vsize.v_type != V_NUM) + return error_value(E_RSEARCH5); + size = vsize.v_num; + if (start) { + if (qisneg(start)) { + start = qqadd(size, start); + if (qisneg(start)) { + qfree(start); + start = qlink(&_qzero_); + } + } + else + start = qlink(start); + } + if (end) { + if (!qispos(end)) + end = qqadd(size, end); + else { + if (qrel(end, size) > 0) + end = qlink(size); + else + end = qlink(end); + } + } + if (v1->v_type == V_FILE) { + if (count == 2 || (count == 4 && + (start == NULL || end == NULL))) { + i = ftellid(v1->v_file, &pos); + if (i < 0) { + qfree(size); + if (start) + qfree(start); + if (end) + qfree(end); + return error_value(E_RSEARCH5); + } + if (count == 2 || (count == 4 && end != NULL)) { + start = qalloc(); + start->num = pos; + } + else { + end = qalloc(); + end->num = pos; + } + } + qlen = utoq(v2->v_str->s_len); + qtmp = qsub(size, qlen); + qfree(size); + size = qtmp; + if (count < 4) { + end = start; + start = NULL; + } + else { + qtmp = qsub(end, qlen); + qfree(end); + end = qtmp; + } + if (end == NULL) + end = qlink(size); + if (start == NULL) + start = qlink(&_qzero_); + if (qrel(end, size) > 0) { + qfree(end); + end = qlink(size); + } + qfree(qlen); + qfree(size); + if (qrel(start, end) > 0) { + qfree(start); + qfree(end); + return result; + } + i = frsearch(v1->v_file, v2->v_str->s_str, + end->num,start->num, &indx); + qfree(start); + qfree(end); + if (i == EOF) + return error_value(errno); + if (i < 0) + return error_value(E_RSEARCH6); + if (i == 0) { + result.v_type = V_NUM; + result.v_num = qalloc(); + result.v_num->num = indx; + } + return result; + } + if (count < 4) { + if (start) { + end = qinc(start); + qfree(start); + } + else + end = qlink(size); + start = qlink(&_qzero_); + } + else { + if (start == NULL) + start = qlink(&_qzero_); + if (end == NULL) + end = qlink(size); + } + + qfree(size); + if (qrel(start, end) >= 0) { + qfree(start); + qfree(end); + return result; + } + l_start = ztolong(start->num); + l_end = ztolong(end->num); + switch (v1->v_type) { + case V_MAT: + i = matrsearch(v1->v_mat, v2, l_start, l_end, &indx); + break; + case V_LIST: + i = listrsearch(v1->v_list, v2, l_start, l_end, &indx); + break; + case V_ASSOC: + i = assocrsearch(v1->v_assoc, v2, l_start, l_end, &indx); + break; + case V_STR: + i = stringrsearch(v1->v_str, v2->v_str, l_start, + l_end, &indx); + break; + default: + qfree(start); + qfree(end); + return error_value(E_RSEARCH1); + } + qfree(start); + qfree(end); + if (i == 0) { result.v_type = V_NUM; - result.v_num = itoq(index); + result.v_num = qalloc(); + result.v_num->num = indx; } return result; } @@ -2257,6 +4096,7 @@ f_assoc(int count, VALUE **vals) VALUE result; result.v_type = V_ASSOC; + result.v_subtype = V_NOSUBTYPE; result.v_assoc = assocalloc(0L); return result; } @@ -2272,6 +4112,10 @@ f_listinsert(int count, VALUE **vals) v1 = *vals++; if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST)) return error_value(E_INSERT1); + if (v1->v_addr->v_subtype & V_NOREALLOC) { + math_error("No-relocate list for insert"); + /*NOTREACHED*/ + } v2 = *vals++; if (v2->v_type == V_ADDR) v2 = v2->v_addr; @@ -2299,6 +4143,10 @@ f_listpush(int count, VALUE **vals) v1 = *vals++; if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST)) return error_value(E_PUSH); + if (v1->v_addr->v_subtype & V_NOREALLOC) { + math_error("No-relocate list for push"); + /*NOTREACHED*/ + } while (--count > 0) { v2 = *vals++; if (v2->v_type == V_ADDR) @@ -2319,6 +4167,10 @@ f_listappend(int count, VALUE **vals) v1 = *vals++; if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST)) return error_value(E_APPEND); + if (v1->v_addr->v_subtype & V_NOREALLOC) { + math_error("No-relocate list for append"); + /*NOTREACHED*/ + } while (--count > 0) { v2 = *vals++; if (v2->v_type == V_ADDR) @@ -2337,6 +4189,10 @@ f_listdelete(VALUE *v1, VALUE *v2) if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST)) return error_value(E_DELETE1); + if (v1->v_addr->v_subtype & V_NOREALLOC) { + math_error("No-relocate list for delete"); + /*NOTREACHED*/ + } if (v2->v_type == V_ADDR) v2 = v2->v_addr; if ((v2->v_type != V_NUM) || qisfrac(v2->v_num)) @@ -2353,6 +4209,10 @@ f_listpop(VALUE *vp) if ((vp->v_type != V_ADDR) || (vp->v_addr->v_type != V_LIST)) return error_value(E_POP); + if (vp->v_addr->v_subtype & V_NOREALLOC) { + math_error("No-relocate list for pop"); + /*NOTREACHED*/ + } removelistfirst(vp->v_addr->v_list, &result); return result; } @@ -2365,6 +4225,10 @@ f_listremove(VALUE *vp) if ((vp->v_type != V_ADDR) || (vp->v_addr->v_type != V_LIST)) return error_value(E_REMOVE); + if (vp->v_addr->v_subtype & V_NOREALLOC) { + math_error("No-relocate list for remove"); + /*NOTREACHED*/ + } removelistlast(vp->v_addr->v_list, &result); return result; } @@ -2412,9 +4276,8 @@ f_ctime(void) systime = time(NULL); strcpy(str, ctime(&systime)); str[24] = '\0'; - res.v_str = str; + res.v_str = makestring(str); res.v_type = V_STR; - res.v_subtype = V_STRALLOC; return res; } @@ -2428,7 +4291,7 @@ f_fopen(VALUE *v1, VALUE *v2) if (v1->v_type != V_STR || v2->v_type != V_STR) return error_value(E_FOPEN1); - mode = v2->v_str; + mode = v2->v_str->s_str; if ((*mode != 'r') && (*mode != 'w') && (*mode != 'a')) return error_value(E_FOPEN2); @@ -2439,7 +4302,7 @@ f_fopen(VALUE *v1, VALUE *v2) return error_value(E_FOPEN2); } errno = 0; - id = openid(v1->v_str, v2->v_str); + id = openid(v1->v_str->s_str, v2->v_str->s_str); if (id == FILEID_NONE) return error_value(errno); if (id < 0) @@ -2462,7 +4325,7 @@ f_freopen(int count, VALUE **vals) if (vals[1]->v_type != V_STR) return error_value(E_FREOPEN2); - mode = vals[1]->v_str; + mode = vals[1]->v_str->s_str; if ((*mode != 'r') && (*mode != 'w') && (*mode != 'a')) return error_value(E_FREOPEN2); @@ -2478,7 +4341,8 @@ f_freopen(int count, VALUE **vals) else { if (vals[2]->v_type != V_STR) return error_value(E_FREOPEN3); - id = reopenid(vals[0]->v_file, mode, vals[2]->v_str); + id = reopenid(vals[0]->v_file, mode, + vals[2]->v_str->s_str); } if (id == FILEID_NONE) @@ -2489,27 +4353,95 @@ f_freopen(int count, VALUE **vals) static VALUE -f_errno(VALUE *v1) +f_errno(int count, VALUE **vals) { - long error; /* error number to look up */ + int newerr, olderr; + VALUE *vp; VALUE result; - /* arg must be an integer */ - if (v1->v_type != V_NUM || qisfrac(v1->v_num)) { - math_error("errno argument must be an integer"); - /*NOTREACHED*/ - } + newerr = -1; + result.v_type = V_NUM; - /* return the error string */ - result.v_type = V_STR; - result.v_subtype = V_STRLITERAL; - error = z1tol(v1->v_num->num); - if (qisneg(v1->v_num) || zge16b(v1->v_num->num) || - error < 0 || error >= sys_nerr) { - result.v_str = "Unknown error number"; - } else { - result.v_str = (char *)sys_errlist[error]; + if (count > 0) { + vp = vals[0]; + + if (vp->v_type <= 0) { + newerr = (int) -vp->v_type; + (void) set_errno(newerr); + result.v_num = itoq((long) newerr); + return result; + } + + /* arg must be an integer */ + if (vp->v_type != V_NUM || qisfrac(vp->v_num) || + qisneg(vp->v_num) || zge16b(vp->v_num->num)) { + math_error("errno argument out of range"); + /*NOTREACHED*/ + } + newerr = z1tol(vp->v_num->num); + if (newerr >= 32768) { + math_error("errno argument out of range"); + /*NOTREACHED*/ + } } + olderr = set_errno(newerr); + + result.v_num = itoq((long) olderr); + return result; +} + + + +static VALUE +f_errcount(int count, VALUE **vals) +{ + int newcount, oldcount; + VALUE *vp; + VALUE result; + + newcount = -1; + if (count > 0) { + vp = vals[0]; + + /* arg must be an integer */ + if (vp->v_type != V_NUM || qisfrac(vp->v_num) || + qisneg(vp->v_num) || zge31b(vp->v_num->num)) { + math_error("errcount argument out of range"); + /*NOTREACHED*/ + } + newcount = z1tol(vp->v_num->num); + } + oldcount = set_errcount(newcount); + + result.v_type = V_NUM; + result.v_num = itoq((long) oldcount); + return result; +} + + +static VALUE +f_errmax(int count, VALUE **vals) +{ + int newmax, oldmax; + VALUE *vp; + VALUE result; + + newmax = -1; + if (count > 0) { + vp = vals[0]; + + /* arg must be an integer */ + if (vp->v_type != V_NUM || qisfrac(vp->v_num) || + qisneg(vp->v_num) || zge31b(vp->v_num->num)) { + math_error("errcount argument out of range"); + /*NOTREACHED*/ + } + newmax = z1tol(vp->v_num->num); + } + oldmax = set_errmax(newmax); + + result.v_type = V_NUM; + result.v_num = itoq((long) oldmax); return result; } @@ -2545,10 +4477,12 @@ f_fclose(int count, VALUE **vals) static VALUE -f_rm(VALUE *v1) +f_rm(int count, VALUE **vals) { VALUE result; + int force; /* TRUE -> -f was given as 1st arg */ int i; + int j; /* * firewall @@ -2558,22 +4492,33 @@ f_rm(VALUE *v1) /* * check on each arg - * - * For now we will do just one arg ... worry about - * rm flags such as -r or -f maybe someday later ... */ - if (v1->v_type != V_STR) - return error_value(E_RM1); - if (v1->v_str[0] == '\0') - return error_value(E_RM1); + for (i=0; i < count; ++i) { + if (vals[i]->v_type != V_STR) + return error_value(E_RM1); + if (vals[i]->v_str->s_str[0] == '\0') + return error_value(E_RM1); + } /* - * unlink file(s) + * look for a leading -f option */ - i = unlink(v1->v_str); - if (i < 0) - return error_value(E_RM2); + force = (strcmp(vals[0]->v_str->s_str, "-f") == 0); + if (force) { + --count; + ++vals; + } + + /* + * remove file(s) + */ + for (i=0; i < count; ++i) { + j = remove(vals[i]->v_str->s_str); + if (!force && j < 0) + return error_value(errno); + } result.v_type = V_NULL; + result.v_subtype = V_NOSUBTYPE; return result; } @@ -2581,66 +4526,80 @@ f_rm(VALUE *v1) static VALUE f_newerror(int count, VALUE **vals) { - VALUE result; char *str; + int index; + int errnum; str = NULL; - if (count > 0 && vals[0]->v_type == V_STR) { - str = vals[0]->v_str; - if (*str == '\0') - str = NULL; - } + if (count > 0 && vals[0]->v_type == V_STR) + str = vals[0]->v_str->s_str; + if (str == NULL || str[0] == '\0') + str = "???"; if (nexterrnum == E_USERDEF) initstr(&newerrorstr); - if (str) + index = findstr(&newerrorstr, str); + if (index >= 0) + errnum = E_USERDEF + index; + else { + if (nexterrnum == 32767) + math_error("Too many new error values"); + errnum = nexterrnum++; addstr(&newerrorstr, str); - else - addstr(&newerrorstr, "???"); - result.v_type = - nexterrnum++; - return result; + } + return error_value(errnum); } static VALUE -f_strerror(VALUE *vp) +f_strerror(int count, VALUE **vals) { + VALUE *vp; VALUE result; long i; + char *cp; - /* firewall */ - if (vp->v_type < 0) - i = (long) -vp->v_type; - else { - if (vp->v_type != V_NUM || qisfrac(vp->v_num) || - qisneg(vp->v_num)) { - return error_value(E_STRERROR1); + if (count > 0) { + vp = vals[0]; + if (vp->v_type < 0) + i = (long) -vp->v_type; + else { + if (vp->v_type != V_NUM || qisfrac(vp->v_num)) + return error_value(E_STRERROR1); + i = qtoi(vp->v_num); + if (i < 0 || i > 32767) + return error_value(E_STRERROR2); } - i = qtoi(vp->v_num); } + else + i = set_errno(-1); - /* process system error messages */ - if (i < E__BASE) { - if (i >= sys_nerr) { - return error_value(E_STRERROR2); + result.v_type = V_STR; + + if (i == 0) + i = E__BASE; + + if (i >= nexterrnum || (i > E__HIGHEST && i < E_USERDEF) + || (i < E__BASE && i >= sys_nerr)) { + cp = (char *) malloc(12); + if (cp == NULL) { + math_error("Out of memory for strerror"); + /*NOTREACHED*/ } - result.v_str = (char *) sys_errlist[i]; - result.v_type = V_STR; - result.v_subtype = V_STRLITERAL; + sprintf(cp, "Error %ld", i); + result.v_str = makestring(cp); return result; } - /* more filewall */ - if (i <= 0 || i >= nexterrnum || (i > E__HIGHEST && i < E_USERDEF)) { - return error_value(E_STRERROR2); - } + if (i < E__BASE) /* system error */ + cp = (char *) sys_errlist[i]; - /* convert user or calc error */ - result.v_type = V_STR; - result.v_subtype = V_STRLITERAL; - if (i >= E_USERDEF) - result.v_str = namestr(&newerrorstr, i - E_USERDEF); - else - result.v_str = (char *)error_table[i - E__BASE]; + else if (i >= E_USERDEF) /* user-described error */ + cp = namestr(&newerrorstr, i - E_USERDEF); + + else /* calc-described error */ + cp = (char *)error_table[i - E__BASE]; + + result.v_str = makenewstring(cp); return result; } @@ -2706,19 +4665,30 @@ f_fflush(int count, VALUE **vals) static VALUE -f_error(VALUE *vp) +f_error(int count, VALUE **vals) { - VALUE res; + VALUE *vp; long r; - if (vp->v_type != V_NUM || qisfrac(vp->v_num) || - qisneg(vp->v_num)) - return error_value(E_ERROR1); - r = qtoi(vp->v_num); - if (r < 0 || r >= 32768) - return error_value(E_ERROR2); - res.v_type = (short) -r; - return res; + if (count > 0) { + vp = vals[0]; + + if (vp->v_type <= 0) + r = (long) -vp->v_type; + else { + if (vp->v_type != V_NUM || qisfrac(vp->v_num)) + r = E_ERROR1; + else { + r = qtoi(vp->v_num); + if (r < 0 || r >= 32768) + r = E_ERROR2; + } + } + } + else + r = set_errno(-1); + + return error_value(r); } @@ -2737,15 +4707,19 @@ static VALUE f_fsize(VALUE *vp) { VALUE result; - long i; + ZVALUE len; /* file length */ + int i; if (vp->v_type != V_FILE) return error_value(E_FSIZE1); - i = filesize(vp->v_file); - if (i < 0) + i = getsize(vp->v_file, &len); + if (i == EOF) + return error_value(errno); + if (i) return error_value(E_FSIZE2); result.v_type = V_NUM; - result.v_num = itoq(i); + result.v_num = qalloc(); + result.v_num->num = len; return result; } @@ -2755,7 +4729,6 @@ f_fseek(int count, VALUE **vals) { VALUE result; int whence; - long offset; int i; /* firewalls */ @@ -2776,9 +4749,8 @@ f_fseek(int count, VALUE **vals) if (whence > 2) return error_value (E_FSEEK2); } - offset = ztoi(vals[1]->v_num->num); - i = fseekid(vals[0]->v_file, offset, whence); + i = fseekid(vals[0]->v_file, vals[1]->v_num->num, whence); result.v_type = V_NULL; if (i == EOF) return error_value(errno); @@ -2792,19 +4764,19 @@ static VALUE f_ftell(VALUE *vp) { VALUE result; - long i; + ZVALUE pos; /* current file position */ + int i; errno = 0; if (vp->v_type != V_FILE) return error_value(E_FTELL1); - i = ftellid(vp->v_file); - if (i == EOF) - return error_value(errno); + i = ftellid(vp->v_file, &pos); if (i < 0) return error_value(E_FTELL2); result.v_type = V_NUM; - result.v_num = itoq(i); + result.v_num = qalloc(); + result.v_num->num = pos; return result; } @@ -2844,7 +4816,8 @@ f_fprintf(int count, VALUE **vals) return error_value(E_FPRINTF1); if (vals[1]->v_type != V_STR) return error_value(E_FPRINTF2); - i = idprintf(vals[0]->v_file, vals[1]->v_str, count - 2, vals + 2); + i = idprintf(vals[0]->v_file, vals[1]->v_str->s_str, + count - 2, vals + 2); if (i > 0) return error_value(E_FPRINTF3); result.v_type = V_NULL; @@ -2878,7 +4851,7 @@ strscan(char *s, int count, VALUE **vals) chtmp = ch; *s = '\0'; n++; - val.v_str = s0; + val.v_str = makenewstring(s0); result = f_eval(&val); var = *vals++; if (var->v_type == V_ADDR) { @@ -2913,7 +4886,7 @@ filescan(FILEID id, int count, VALUE **vals) if (i > 0) return EOF; n++; - val.v_str = str; + val.v_str = makenewstring(str); result = f_eval(&val); var = *vals++; if (var->v_type == V_ADDR) { @@ -2960,7 +4933,7 @@ f_strscan(int count, VALUE **vals) if (vp->v_type != V_STR) return error_value(E_STRSCAN); - i = strscan(vp->v_str, count - 1, vals + 1); + i = strscan(vp->v_str->s_str, count - 1, vals + 1); result.v_type = V_NUM; result.v_num = itoq((long) i); @@ -3011,7 +4984,7 @@ f_scanf(int count, VALUE **vals) if (vals[i]->v_type != V_ADDR) return error_value(E_SCANF2); } - i = fscanfid(FILEID_STDIN, vp->v_str, count - 1, vals + 1); + i = fscanfid(FILEID_STDIN, vp->v_str->s_str, count - 1, vals + 1); if (i < 0) return error_value(E_SCANF3); result.v_type = V_NUM; @@ -3042,7 +5015,8 @@ f_strscanf(int count, VALUE **vals) if (vals[i]->v_type != V_ADDR) return error_value(E_STRSCANF3); } - i = scanfstr(vp->v_str, vq->v_str, count - 2, vals + 2); + i = scanfstr(vp->v_str->s_str, vq->v_str->s_str, + count - 2, vals + 2); if (i == EOF) return error_value(errno); if (i < 0) @@ -3074,7 +5048,7 @@ f_fscanf(int count, VALUE **vals) if (vals[i]->v_type != V_ADDR) return error_value(E_FSCANF3); } - i = fscanfid(vp->v_file, sp->v_str, count - 2, vals); + i = fscanfid(vp->v_file, sp->v_str->s_str, count - 2, vals); if (i == EOF) { result.v_type = V_NULL; return result; @@ -3099,7 +5073,7 @@ f_fputc(VALUE *v1, VALUE *v2) return error_value(E_FPUTC1); switch (v2->v_type) { case V_STR: - ch = v2->v_str[0]; + ch = v2->v_str->s_str[0]; break; case V_NUM: q = v2->v_num; @@ -3136,7 +5110,7 @@ f_fputs(int count, VALUE **vals) return error_value(E_FPUTS2); } for (i = 1; i < count; i++) { - err = idfputs(vals[0]->v_file, vals[i]->v_str); + err = idfputs(vals[0]->v_file, vals[i]->v_str->s_str); if (err > 0) return error_value(E_FPUTS3); } @@ -3158,7 +5132,8 @@ f_fputstr(int count, VALUE **vals) return error_value(E_FPUTSTR2); } for (i = 1; i < count; i++) { - err = idfputstr(vals[0]->v_file, vals[i]->v_str); + err = idfputstr(vals[0]->v_file, + vals[i]->v_str->s_str); if (err > 0) return error_value(E_FPUTSTR3); } @@ -3175,7 +5150,8 @@ f_printf(int count, VALUE **vals) if (vals[0]->v_type != V_STR) return error_value(E_PRINTF1); - i = idprintf(FILEID_STDOUT, vals[0]->v_str, count - 1, vals + 1); + i = idprintf(FILEID_STDOUT, vals[0]->v_str->s_str, + count - 1, vals + 1); if (i) return error_value(E_PRINTF2); result.v_type = V_NULL; @@ -3188,16 +5164,18 @@ f_strprintf(int count, VALUE **vals) { VALUE result; int i; + char *cp; if (vals[0]->v_type != V_STR) return error_value(E_STRPRINTF1); math_divertio(); - i = idprintf(FILEID_STDOUT, vals[0]->v_str, count - 1, vals + 1); + i = idprintf(FILEID_STDOUT, vals[0]->v_str->s_str, + count - 1, vals + 1); if (i) return error_value(E_STRPRINTF2); - result.v_str = math_getdivertedio(); + cp = math_getdivertedio(); result.v_type = V_STR; - result.v_subtype = V_STRALLOC; + result.v_str = makenewstring(cp); return result; } @@ -3216,8 +5194,7 @@ f_fgetc(VALUE *vp) result.v_type = V_NULL; if (ch != EOF) { result.v_type = V_STR; - result.v_subtype = V_STRLITERAL; - result.v_str = charstr(ch); + result.v_str = charstring(ch); } return result; } @@ -3236,7 +5213,7 @@ f_ungetc(VALUE *v1, VALUE *v2) return error_value(E_UNGETC1); switch (v2->v_type) { case V_STR: - ch = v2->v_str[0]; + ch = v2->v_str->s_str[0]; break; case V_NUM: q = v2->v_num; @@ -3273,8 +5250,7 @@ f_fgetline(VALUE *vp) result.v_type = V_NULL; if (i == 0) { result.v_type = V_STR; - result.v_subtype = V_STRALLOC; - result.v_str = str; + result.v_str = makestring(str); } return result; } @@ -3295,8 +5271,7 @@ f_fgets(VALUE *vp) result.v_type = V_NULL; if (i == 0) { result.v_type = V_STR; - result.v_subtype = V_STRALLOC; - result.v_str = str; + result.v_str = makestring(str); } return result; } @@ -3317,8 +5292,7 @@ f_fgetstr(VALUE *vp) result.v_type = V_NULL; if (i == 0) { result.v_type = V_STR; - result.v_subtype = V_STRALLOC; - result.v_str = str; + result.v_str = makestring(str); } return result; } @@ -3339,8 +5313,7 @@ f_fgetfield(VALUE *vp) result.v_type = V_NULL; if (i == 0) { result.v_type = V_STR; - result.v_subtype = V_STRALLOC; - result.v_str = str; + result.v_str = makestring(str); } return result; } @@ -3381,6 +5354,11 @@ f_reverse(VALUE *val) res.v_list = listcopy(val->v_list); listreverse(res.v_list); break; + case V_STR: + res.v_str = stringneg(val->v_str); + if (res.v_str == NULL) + return error_value(E_STRNEG); + break; default: math_error("Bad argument type for reverse"); /*NOTREACHED*/ @@ -3440,113 +5418,122 @@ f_join(int count, VALUE **vals) static VALUE f_head(VALUE *v1, VALUE *v2) { - LIST *lp; - LISTELEM *ep; - long n; VALUE res; + long n; - if (v1->v_type != V_LIST) { - math_error("Non-list first argument for head"); - /*NOTREACHED*/ - } - if (v2->v_type != V_NUM || qisfrac(v2->v_num)) { - math_error("Non-integer second argument for head"); - /*NOTREACHED*/ - } + if (v2->v_type != V_NUM || qisfrac(v2->v_num) || + zge31b(v2->v_num->num)) + return error_value(E_HEAD2); n = qtoi(v2->v_num); - if (n < 0) - n += v1->v_list->l_count; - lp = listalloc(); - for (ep = v1->v_list->l_first; n-- > 0 && ep; ep = ep->e_next) - insertlistlast(lp, &ep->e_value); - res.v_type = V_LIST; - res.v_list = lp; - return res; + + res.v_type = v1->v_type; + switch (v1->v_type) { + case V_LIST: + if (n == 0) + res.v_list = listalloc(); + else if (n > 0) + res.v_list = listsegment(v1->v_list,0,n-1); + else + res.v_list = listsegment(v1->v_list,-n-1,0); + return res; + case V_STR: + if (n == 0) + res.v_str = slink(&_nullstring_); + else if (n > 0) + res.v_str = stringsegment(v1->v_str,0,n-1); + else + res.v_str = stringsegment(v1->v_str,-n-1,0); + if (res.v_str == NULL) + return error_value(E_STRHEAD); + return res; + default: + return error_value(E_HEAD1); + } } static VALUE f_tail(VALUE *v1, VALUE *v2) { - LIST *lp; - LISTELEM *ep; long n; VALUE res; - if (v1->v_type != V_LIST) { - math_error("Non-list first argument for tail"); - /*NOTREACHED*/ - } - if (v2->v_type != V_NUM || qisfrac(v2->v_num)) { - math_error("Non-integer second argument for tail"); - /*NOTREACHED*/ - } + if (v2->v_type != V_NUM || qisfrac(v2->v_num) || + zge31b(v2->v_num->num)) + return error_value(E_TAIL1); n = qtoi(v2->v_num); - if (n < 0) - n += v1->v_list->l_count; - lp = listalloc(); - for (ep = v1->v_list->l_last; n-- > 0 && ep; ep = ep->e_prev) - insertlistfirst(lp, &ep->e_value); - res.v_type = V_LIST; - res.v_list = lp; - return res; + res.v_type = v1->v_type; + switch (v1->v_type) { + case V_LIST: + if (n == 0) + res.v_list = listalloc(); + else if (n > 0) { + res.v_list = listsegment(v1->v_list, + v1->v_list->l_count - n, + v1->v_list->l_count - 1); + } + else { + res.v_list = listsegment(v1->v_list, + v1->v_list->l_count - 1, + v1->v_list->l_count + n); + } + return res; + case V_STR: + if (n == 0) + res.v_str = slink(&_nullstring_); + else if (n > 0) { + res.v_str = stringsegment(v1->v_str, + v1->v_str->s_len - n, + v1->v_str->s_len - 1); + } + else { + res.v_str = stringsegment(v1->v_str, + v1->v_str->s_len - 1, + v1->v_str->s_len + n); + } + if (res.v_str == V_NULL) + return error_value(E_STRTAIL); + return res; + default: + return error_value(E_TAIL1); + } } static VALUE -f_segment(VALUE *v1, VALUE *v2, VALUE *v3) +f_segment(int count, VALUE **vals) { - LIST *lp; - LISTELEM *ep; - long n1, n2, i; - VALUE res; + VALUE *vp; + long n1, n2; + VALUE result; - if (v1->v_type != V_LIST) { - math_error("Non-list first argument for segment"); - /*NOTREACHED*/ - } - if (v2->v_type != V_NUM || qisfrac(v2->v_num)) { - math_error("Non-integer second argument for segment"); - /*NOTREACHED*/ - } - if (v3->v_type != V_NUM || qisfrac(v3->v_num)) { - math_error("Non-integer third argument for segment"); - /*NOTREACHED*/ - } - n1 = qtoi(v2->v_num); - n2 = qtoi(v3->v_num); - if (n1 < 0 || n1 >= v1->v_list->l_count) { - math_error("Second argument out of range for segment"); - /*NOTREACHED*/ - } - if (n2 < 0 || n2 >= v1->v_list->l_count) { - math_error("Third argument out of range for segment"); - /*NOTREACHED*/ - } - lp = listalloc(); - ep = v1->v_list->l_first; - if (n1 <= n2) { - i = n2 - n1 + 1; - while(n1-- > 0 && ep) - ep = ep->e_next; - while(i-- > 0 && ep) { - insertlistlast(lp, &ep->e_value); - ep = ep->e_next; - } + vp = vals[1]; + if (vp->v_type != V_NUM || qisfrac(vp->v_num) || zge31b(vp->v_num->num)) + return error_value(E_SEG2); + n1 = qtoi(vp->v_num); + n2 = n1; + if (count == 3) { + vp = vals[2]; + if (vp->v_type != V_NUM || qisfrac(vp->v_num) || + zge31b(vp->v_num->num)) + return error_value(E_SEG3); + n2 = qtoi(vp->v_num); } - else { - i = n1 - n2 + 1; - while(n2-- > 0 && ep) - ep = ep->e_next; - while(i-- > 0 && ep) { - insertlistfirst(lp, &ep->e_value); - ep = ep->e_next; - } + vp = vals[0]; + result.v_type = vp->v_type; + switch (vp->v_type) { + case V_LIST: + result.v_list = listsegment(vp->v_list, n1, n2); + return result; + case V_STR: + result.v_str = stringsegment(vp->v_str, n1, n2); + if (result.v_str == NULL) + return error_value(E_STRSEG); + return result; + default: + return error_value(E_SEG1); } - res.v_type = V_LIST; - res.v_list = lp; - return res; } @@ -3570,7 +5557,7 @@ f_modify(VALUE *v1, VALUE *v2) math_error("Non-string second argument for modify"); /*NOTREACHED*/ } - fp = findfunc(adduserfunc(v2->v_str)); + fp = findfunc(adduserfunc(v2->v_str->s_str)); if (!fp) { math_error("Undefined function for modify"); /*NOTREACHED*/ @@ -3614,7 +5601,7 @@ f_forall(VALUE *v1, VALUE *v2) math_error("Non-string second argument for forall"); /*NOTREACHED*/ } - fp = findfunc(adduserfunc(v2->v_str)); + fp = findfunc(adduserfunc(v2->v_str->s_str)); if (!fp) { math_error("Undefined function for forall"); /*NOTREACHED*/ @@ -3661,7 +5648,7 @@ f_select(VALUE *v1, VALUE *v2) math_error("Non-string second argument for select"); /*NOTREACHED*/ } - fp = findfunc(adduserfunc(v2->v_str)); + fp = findfunc(adduserfunc(v2->v_str->s_str)); if (!fp) { math_error("Undefined function for select"); /*NOTREACHED*/ @@ -3694,7 +5681,7 @@ f_count(VALUE *v1, VALUE *v2) math_error("Non-string second argument for select"); /*NOTREACHED*/ } - fp = findfunc(adduserfunc(v2->v_str)); + fp = findfunc(adduserfunc(v2->v_str->s_str)); if (!fp) { math_error("Undefined function for select"); /*NOTREACHED*/ @@ -3748,6 +5735,7 @@ f_makelist(VALUE *v1) n = qtoi(v1->v_num); lp = listalloc(); res.v_type = V_NULL; + res.v_subtype = V_NOSUBTYPE; while (n-- > 0) insertlistlast(lp, &res); res.v_type = V_LIST; @@ -3788,8 +5776,7 @@ f_cmdbuf(void) newcp = (char *)malloc(strlen(cmdbuf) + 1); strcpy(newcp, cmdbuf); result.v_type = V_STR; - result.v_subtype = V_STRALLOC; - result.v_str = newcp; + result.v_str = makestring(newcp); return result; } @@ -3798,17 +5785,18 @@ static VALUE f_getenv(VALUE *v1) { VALUE result; + char *str; if (v1->v_type != V_STR) { math_error("Non-string argument for getenv"); /*NOTREACHED*/ } result.v_type = V_STR; - result.v_subtype = V_STRLITERAL; - result.v_str = getenv(v1->v_str); - if(result.v_str == NULL) { - result.v_type = V_NULL; - } + str = getenv(v1->v_str->s_str); + if (str == NULL) + result.v_type = V_NULL; + else + result.v_str = makenewstring(str); return result; } @@ -3817,15 +5805,13 @@ static VALUE f_isatty(VALUE *vp) { VALUE result; - int i; - if (vp->v_type != V_FILE) - return error_value(E_ISATTY1); - i = isattyid(vp->v_file); - if (i == -2) - return error_value(E_ISATTY2); result.v_type = V_NUM; - result.v_num = i ? qlink(&_qone_) : qlink(&_qzero_); + if (vp->v_type == V_FILE && isattyid(vp->v_file) == 1) { + result.v_num = itoq(1); + } else { + result.v_num = itoq(0); + } return result; } @@ -3842,7 +5828,7 @@ f_access(int count, VALUE **vals) errno = 0; if (vals[0]->v_type != V_STR) return error_value(E_ACCESS1); - fname = vals[0]->v_str; + fname = vals[0]->v_str->s_str; m = 0; if (count == 2) { switch (vals[1]->v_type) { @@ -3853,7 +5839,7 @@ f_access(int count, VALUE **vals) m = (int)(q->num.v[0] & 7); break; case V_STR: - s = vals[1]->v_str; + s = vals[1]->v_str->s_str; i = (long)strlen(s); while (i-- > 0) { switch (*s++) { @@ -3895,13 +5881,14 @@ f_putenv(int count, VALUE **vals) } /* convert putenv("foo","bar") into putenv("foo=bar") */ - putenv_str = (char *)malloc(strlen(vals[0]->v_str) + 1 + - strlen(vals[1]->v_str) + 1); + putenv_str = (char *)malloc(vals[0]->v_str->s_len + 1 + + vals[1]->v_str->s_len + 1); if (putenv_str == NULL) { math_error("Cannot allocate string in putenv"); /*NOTREACHED*/ } - sprintf(putenv_str, "%s=%s", vals[0]->v_str, vals[1]->v_str); + sprintf(putenv_str, "%s=%s", vals[0]->v_str->s_str, + vals[1]->v_str->s_str); } else { @@ -3912,7 +5899,7 @@ f_putenv(int count, VALUE **vals) } /* putenv(arg) must be of the form "foo=bar" */ - if ((char *)strchr(vals[0]->v_str, '=') == NULL) { + if ((char *)strchr(vals[0]->v_str->s_str, '=') == NULL) { math_error("putenv single arg string missing ="); /*NOTREACHED*/ } @@ -3921,12 +5908,12 @@ f_putenv(int count, VALUE **vals) * make a copy of the arg because subsequent changes * would change the environment. */ - putenv_str = (char *)malloc(strlen(vals[0]->v_str) + 1); + putenv_str = (char *)malloc(vals[0]->v_str->s_len + 1); if (putenv_str == NULL) { math_error("Cannot allocate string in putenv"); /*NOTREACHED*/ } - strcpy(putenv_str, vals[0]->v_str); + strcpy(putenv_str, vals[0]->v_str->s_str); } /* return putenv result */ @@ -3948,9 +5935,12 @@ f_strpos(VALUE *haystack, VALUE *needle) /*NOTREACHED*/ } result.v_type = V_NUM; - cpointer = strstr(haystack->v_str,needle->v_str); - if(cpointer == NULL) cindex=0; - else cindex=cpointer - haystack->v_str + 1; + cpointer = strstr(haystack->v_str->s_str, + needle->v_str->s_str); + if (cpointer == NULL) + cindex = 0; + else + cindex = cpointer - haystack->v_str->s_str + 1; result.v_num = itoq((long) cindex); return result; } @@ -3970,7 +5960,7 @@ f_system(VALUE *vp) /*NOTREACHED*/ } result.v_type = V_NUM; - result.v_num = itoq((long) system(vp->v_str)); + result.v_num = itoq((long) system(vp->v_str->s_str)); return result; } @@ -4100,6 +6090,556 @@ base_value(long mode) } +static VALUE +f_custom(int count, VALUE **vals) +{ + + VALUE result; + + /* + * disable custom functions unless -C was given + */ + if (!allow_custom) { + fprintf(stderr, +#if defined(CUSTOM) + "%sCalc must be run with a -C argument to " + "use custom function\n", +#else /* CUSTOM */ + "%sCalc was built with custom functions disabled\n", +#endif /* CUSTOM */ + (conf->tab_ok ? "\t" : "")); + return error_value(E_CUSTOM_ERROR); + } + + /* + * perform the custom operation + */ + if (count <= 0) { + /* perform the usage function function */ + showcustom(); + result.v_type = V_NULL; + } else { + /* firewall */ + if (vals[0]->v_type != V_STR) { + math_error("custom: 1st arg not a string name"); + /*NOTREACHED*/ + } + + /* perform the custom function */ + result = custom(vals[0]->v_str->s_str, count-1, vals+1); + } + + /* + * return the custom result + */ + return result; +} + + +static VALUE +f_blk(int count, VALUE **vals) +{ + int len; /* number of octets to malloc */ + int chunk; /* block chunk size */ + VALUE result; + int id; + VALUE *vp; + int type; + + vp = *vals; + type = 0; + result.v_subtype = V_NOSUBTYPE; + if (count > 0) { + type = vp->v_type; + if (type == V_STR || type == V_NBLOCK || type == V_BLOCK) { + vals++; + count--; + } + } + + len = -1; /* signal to use old or zero len */ + chunk = -1; /* signal to use old or default chunksize */ + if (count > 0 && vals[0]->v_type != V_NULL) { + /* parse len */ + if (vals[0]->v_type != V_NUM || qisfrac(vals[0]->v_num)) + return error_value(E_BLK1); + if (qisneg(vals[0]->v_num) || zge31b(vals[0]->v_num->num)) + return error_value(E_BLK2); + len = qtoi(vals[0]->v_num); + } + if (count > 1 && vals[1]->v_type != V_NULL) { + /* parse chunk */ + if (vals[1]->v_type != V_NUM || qisfrac(vals[1]->v_num)) + return error_value(E_BLK3); + if (qisneg(vals[1]->v_num) || zge31b(vals[1]->v_num->num)) + return error_value(E_BLK4); + chunk = qtoi(vals[1]->v_num); + } + + if (type == V_STR) { + result.v_type = V_NBLOCK; + id = findnblockid(vp->v_str->s_str); + if (id < 0) { + /* create new named block */ + result.v_nblock = createnblock(vp->v_str->s_str, + len, chunk); + return result; + } + /* reallocate nblock */ + result.v_nblock = reallocnblock(id, len, chunk); + return result; + } + + if (type == V_NBLOCK) { + /* reallocate nblock */ + result.v_type = V_NBLOCK; + id = vp->v_nblock->id; + result.v_nblock = reallocnblock(id, len, chunk); + return result; + } + if (type == V_BLOCK) { + /* reallocate block */ + result.v_type = V_BLOCK; + result.v_block = copyrealloc(vp->v_block, len, chunk); + return result; + } + + /* allocate block */ + result.v_block = blkalloc(len, chunk); + result.v_type = V_BLOCK; + return result; +} + + +static VALUE +f_blkfree(VALUE *vp) +{ + int id; + VALUE result; + + id = 0; + switch (vp->v_type) { + case V_NBLOCK: + id = vp->v_nblock->id; + break; + case V_STR: + id = findnblockid(vp->v_str->s_str); + if (id < 0) + return error_value(E_BLKFREE1); + break; + case V_NUM: + if (qisfrac(vp->v_num) || qisneg(vp->v_num)) + return error_value(E_BLKFREE2); + if (zge31b(vp->v_num->num)) + return error_value(E_BLKFREE3); + id = qtoi(vp->v_num); + break; + default: + return error_value(E_BLKFREE4); + } + id = removenblock(id); + if (id) + return error_value(id); + result.v_type = V_NULL; + return result; +} + + +static VALUE +f_blocks(int count, VALUE **vals) +{ + NBLOCK *nblk; + VALUE result; + int id; + + if (count == 0) { + result.v_type = V_NUM; + result.v_num = itoq((long) countnblocks()); + return result; + } + if (vals[0]->v_type != V_NUM || qisfrac(vals[0]->v_num)) + return error_value(E_BLOCKS1); + id = (int) qtoi(vals[0]->v_num); + + nblk = findnblock(id); + + if (nblk == NULL) + return error_value(E_BLOCKS2); + else { + result.v_type = V_NBLOCK; + result.v_nblock = nblk; + } + return result; +} + + +static VALUE +f_free(int count, VALUE **vals) +{ + VALUE result; + VALUE *val; + + result.v_type = V_NULL; + while (count-- > 0) { + val = *vals++; + if (val->v_type == V_ADDR) + freevalue(val->v_addr); + } + return result; +} + +static VALUE +f_freeglobals(void) +{ + VALUE result; + + freeglobals(); + result.v_type = V_NULL; + return result; +} + +static VALUE +f_freeredc(void) +{ + VALUE result; + freeredcdata(); + result.v_type = V_NULL; + return result; +} + + +static VALUE +f_freestatics(void) +{ + VALUE result; + + freestatics(); + result.v_type = V_NULL; + return result; +} + + +/* + * f_copy - copy consecutive items between values + * + * copy(src, dst [, ssi [, num [, dsi]]]) + * + * Copy 'num' consecutive items from 'src' with index 'ssi' to + * 'dest', starting at position with index 'dsi'. + */ +static VALUE +f_copy(int count, VALUE **vals) +{ + long ssi = 0; /* source start index */ + long num = -1; /* number of items to copy (-1 ==> all) */ + long dsi = -1; /* destination start index, -1 ==> default */ + int errtype; /* error type if unable to perform copy */ + VALUE result; /* null if successful */ + + /* + * parse args + */ + switch(count) { + case 5: + /* parse dsi */ + if (vals[4]->v_type != V_NULL) { + if (vals[4]->v_type != V_NUM || + qisfrac(vals[4]->v_num) || + qisneg(vals[4]->v_num)) { + return error_value(E_COPY6); + } + if (zge31b(vals[4]->v_num->num)) { + return error_value(E_COPY7); + } + dsi = qtoi(vals[4]->v_num); + } + /*FALLTHRU*/ + + case 4: + /* parse num */ + if (vals[3]->v_type != V_NULL) { + if (vals[3]->v_type != V_NUM || + qisfrac(vals[3]->v_num) || + qisneg(vals[3]->v_num)) { + return error_value(E_COPY1); + } + if (zge31b(vals[3]->v_num->num)) { + return error_value(E_COPY2); + } + num = qtoi(vals[3]->v_num); + } + /*FALLTHRU*/ + + case 3: + /* parse ssi */ + if (vals[2]->v_type != V_NULL) { + if (vals[2]->v_type != V_NUM || + qisfrac(vals[2]->v_num) || + qisneg(vals[2]->v_num)) { + return error_value(E_COPY4); + } + if (zge31b(vals[2]->v_num->num)) { + return error_value(E_COPY5); + } + ssi = qtoi(vals[2]->v_num); + } + break; + } + + /* + * copy + */ + errtype = copystod(vals[0], ssi, num, vals[1], dsi); + if (errtype > 0) + return error_value(errtype); + result.v_type = V_NULL; + return result; +} + + +/* + * f_blkcpy - copy consecutive items between values + * + * copy(dst, src [, num [, dsi [, ssi]]]) + * + * Copy 'num' consecutive items from 'src' with index 'ssi' to + * 'dest', starting at position with index 'dsi'. + */ +static VALUE +f_blkcpy(int count, VALUE **vals) +{ + VALUE *args[5]; /* args to re-order */ + VALUE null_value; /* dummy argument */ + + /* + * parse args into f_copy order + */ + args[0] = vals[1]; + args[1] = vals[0]; + switch(count) { + case 5: + args[2] = vals[4]; + args[4] = vals[3]; + args[3] = vals[2]; + break; + case 4: + count = 5; + args[4] = vals[3]; + args[3] = vals[2]; + null_value.v_type = V_NULL; + args[2] = &null_value; + break; + case 3: + count = 4; + args[3] = vals[2]; + null_value.v_type = V_NULL; + args[2] = &null_value; + break; + } + + /* + * copy + */ + return f_copy(count, args); +} + + +static VALUE +f_sha(int count, VALUE **vals) +{ + VALUE result; + HASH *state; /* pointer to hash state to use */ + int i; /* vals[i] to hash */ + + state = NULL; + + /* + * arg check + */ + if (count == 0) { + + /* return an initial hash state */ + result.v_type = V_HASH; + result.v_hash = hash_init(SHS_HASH_TYPE, NULL); + + } else if (count == 1 && vals[0]->v_type == V_HASH && + vals[0]->v_hash->hashtype == SHS_HASH_TYPE) { + + /* if just a hash value, finalize it */ + state = hash_copy(vals[0]->v_hash); + result.v_type = V_NUM; + result.v_num = qalloc(); + result.v_num->num = hash_final(state); + hash_free(state); + + } else { + + /* + * If the first value is a hash, use that as + * the initial hash state + */ + if (vals[0]->v_type == V_HASH && + vals[0]->v_hash->hashtype == SHS_HASH_TYPE) { + state = hash_copy(vals[0]->v_hash); + i = 1; + + /* + * otherwise use the default initial state + */ + } else { + state = hash_init(SHS_HASH_TYPE, NULL); + i = 0; + } + + /* + * hash the remaining values + */ + do { + state = hash_value(SHS_HASH_TYPE, vals[i], state); + } while (++i < count); + + /* + * return the current hash state + */ + result.v_type = V_HASH; + result.v_hash = state; + } + + /* return the result */ + return result; +} + + +static VALUE +f_sha1(int count, VALUE **vals) +{ + VALUE result; + HASH *state; /* pointer to hash state to use */ + int i; /* vals[i] to hash */ + + /* + * arg check + */ + if (count == 0) { + + /* return an initial hash state */ + result.v_type = V_HASH; + result.v_hash = hash_init(SHS1_HASH_TYPE, NULL); + + } else if (count == 1 && vals[0]->v_type == V_HASH && + vals[0]->v_hash->hashtype == SHS1_HASH_TYPE) { + + /* if just a hash value, finalize it */ + state = hash_copy(vals[0]->v_hash); + result.v_type = V_NUM; + result.v_num = qalloc(); + result.v_num->num = hash_final(state); + hash_free(state); + + } else { + + /* + * If the first value is a hash, use that as + * the initial hash state + */ + if (vals[0]->v_type == V_HASH && + vals[0]->v_hash->hashtype == SHS1_HASH_TYPE) { + state = hash_copy(vals[0]->v_hash); + i = 1; + + /* + * otherwise use the default initial state + */ + } else { + state = hash_init(SHS1_HASH_TYPE, NULL); + i = 0; + } + + /* + * hash the remaining values + */ + do { + state = hash_value(SHS1_HASH_TYPE, vals[i], state); + } while (++i < count); + + /* + * return the current hash state + */ + result.v_type = V_HASH; + result.v_hash = state; + } + + /* return the result */ + return result; +} + + +static VALUE +f_md5(int count, VALUE **vals) +{ + VALUE result; + HASH *state; /* pointer to hash state to use */ + int i; /* vals[i] to hash */ + + state = NULL; + + /* + * arg check + */ + if (count == 0) { + + /* return an initial hash state */ + result.v_type = V_HASH; + result.v_hash = hash_init(MD5_HASH_TYPE, NULL); + + } else if (count == 1 && vals[0]->v_type == V_HASH && + vals[0]->v_hash->hashtype == MD5_HASH_TYPE) { + + /* if just a hash value, finalize it */ + state = hash_copy(vals[0]->v_hash); + result.v_type = V_NUM; + result.v_num = qalloc(); + result.v_num->num = hash_final(state); + hash_free(state); + + } else { + + /* + * If the first value is a hash, use that as + * the initial hash state + */ + if (vals[0]->v_type == V_HASH && + vals[0]->v_hash->hashtype == MD5_HASH_TYPE) { + state = hash_copy(vals[0]->v_hash); + i = 1; + + /* + * otherwise use the default initial state + */ + } else { + state = hash_init(MD5_HASH_TYPE, NULL); + i = 0; + } + + /* + * hash the remaining values + */ + do { + state = hash_value(MD5_HASH_TYPE, vals[i], state); + } while (++i < count); + + /* + * return the current hash state + */ + result.v_type = V_HASH; + result.v_hash = state; + } + + /* return the result */ + return result; +} + + #endif /* !FUNCLIST */ @@ -4144,44 +6684,56 @@ static CONST struct builtin builtins[] = { "absolute value within accuracy b"}, {"access", 1, 2, 0, OP_NOP, 0, f_access, "determine accessibility of file a for mode b"}, - {"acos", 1, 2, FE, OP_NOP, qacos, 0, + {"acos", 1, 2, 0, OP_NOP, 0, f_acos, "arccosine of a within accuracy b"}, - {"acosh", 1, 2, FE, OP_NOP, qacosh, 0, + {"acosh", 1, 2, 0, OP_NOP, 0, f_acosh, "inverse hyperbolic cosine of a within accuracy b"}, - {"acot", 1, 2, FE, OP_NOP, qacot, 0, + {"acot", 1, 2, 0, OP_NOP, 0, f_acot, "arccotangent of a within accuracy b"}, - {"acoth", 1, 2, FE, OP_NOP, qacoth, 0, + {"acoth", 1, 2, 0, OP_NOP, 0, f_acoth, "inverse hyperbolic cotangent of a within accuracy b"}, - {"acsc", 1, 2, FE, OP_NOP, qacsc, 0, + {"acsc", 1, 2, 0, OP_NOP, 0, f_acsc, "arccosecant of a within accuracy b"}, - {"acsch", 1, 2, FE, OP_NOP, qacsch, 0, + {"acsch", 1, 2, 0, OP_NOP, 0, f_acsch, "inverse csch of a within accuracy b"}, + {"agd", 1, 2, 0, OP_NOP, 0, f_agd, + "inverse gudermannian function"}, {"append", 1, IN, FA, OP_NOP, 0, f_listappend, "append values to end of list"}, {"appr", 1, 3, 0, OP_NOP, 0, f_appr, "approximate a by multiple of b using rounding c"}, {"arg", 1, 2, 0, OP_NOP, 0, f_arg, "argument (the angle) of complex number"}, - {"asec", 1, 2, FE, OP_NOP, qasec, 0, + {"asec", 1, 2, 0, OP_NOP, 0, f_asec, "arcsecant of a within accuracy b"}, - {"asech", 1, 2, FE, OP_NOP, qasech, 0, + {"asech", 1, 2, 0, OP_NOP, 0, f_asech, "inverse hyperbolic secant of a within accuracy b"}, - {"asin", 1, 2, FE, OP_NOP, qasin, 0, + {"asin", 1, 2, 0, OP_NOP, 0, f_asin, "arcsine of a within accuracy b"}, - {"asinh", 1, 2, FE, OP_NOP, qasinh, 0, + {"asinh", 1, 2, 0, OP_NOP, 0, f_asinh, "inverse hyperbolic sine of a within accuracy b"}, {"assoc", 0, 0, 0, OP_NOP, 0, f_assoc, "create new association array"}, - {"atan", 1, 2, FE, OP_NOP, qatan, 0, + {"atan", 1, 2, 0, OP_NOP, 0, f_atan, "arctangent of a within accuracy b"}, {"atan2", 2, 3, FE, OP_NOP, qatan2, 0, "angle to point (b,a) within accuracy c"}, - {"atanh", 1, 2, FE, OP_NOP, qatanh, 0, + {"atanh", 1, 2, 0, OP_NOP, 0, f_atanh, "inverse hyperbolic tangent of a within accuracy b"}, {"avg", 0, IN, 0, OP_NOP, 0, f_avg, "arithmetic mean of values"}, {"base", 0, 1, 0, OP_NOP, f_base, 0, "set default output base"}, + {"bit", 2, 2, 0, OP_BIT, 0, 0, + "whether bit b in value a is set"}, + {"blk", 0, 3, 0, OP_NOP, 0, f_blk, + "block with or without name, octet number, chunksize"}, + {"blkcpy", 2, 5, 0, OP_NOP, 0, f_blkcpy, + "copy value to/from a block: blkcpy(d,s,len,di,si)"}, + {"blkfree", 1, 1, 0, OP_NOP, 0, f_blkfree, + "free all storage from a named block"}, + {"blocks", 0, 1, 0, OP_NOP, 0, f_blocks, + "named block with specified index, or null value"}, {"bround", 1, 3, 0, OP_NOP, 0, f_bround, "round value a to b number of binary places"}, {"btrunc", 1, 2, 0, OP_NOP, f_btrunc, 0, @@ -4204,24 +6756,28 @@ static CONST struct builtin builtins[] = { "set or read configuration value"}, {"conj", 1, 1, 0, OP_CONJUGATE, 0, 0, "complex conjugate of value"}, + {"copy", 2, 5, 0, OP_NOP, 0, f_copy, + "copy value to/from a block: copy(s,d,len,si,di)"}, {"cos", 1, 2, 0, OP_NOP, 0, f_cos, "cosine of value a within accuracy b"}, - {"cosh", 1, 2, FE, OP_NOP, qcosh, 0, + {"cosh", 1, 2, 0, OP_NOP, 0, f_cosh, "hyperbolic cosine of a within accuracy b"}, - {"cot", 1, 2, FE, OP_NOP, qcot, 0, + {"cot", 1, 2, 0, OP_NOP, 0, f_cot, "cotangent of a within accuracy b"}, - {"coth", 1, 2, FE, OP_NOP, qcoth, 0, + {"coth", 1, 2, 0, OP_NOP, 0, f_coth, "hyperbolic cotangent of a within accuracy b"}, {"count", 2, 2, 0, OP_NOP, 0, f_count, "count listr/matrix elements satisfying some condition"}, {"cp", 2, 2, 0, OP_NOP, 0, f_cp, "cross product of two vectors"}, - {"csc", 1, 2, FE, OP_NOP, qcsc, 0, + {"csc", 1, 2, 0, OP_NOP, 0, f_csc, "cosecant of a within accuracy b"}, - {"csch", 1, 2, FE, OP_NOP, qcsch, 0, + {"csch", 1, 2, 0, OP_NOP, 0, f_csch, "hyperbolic cosecant of a within accuracy b"}, {"ctime", 0, 0, 0, OP_NOP, 0, f_ctime, "date and time as string"}, + {"custom", 0, IN, 0, OP_NOP, 0, f_custom, + "custom builtin function interface"}, {"delete", 2, 2, FA, OP_NOP, 0, f_listdelete, "delete element from list a at position b"}, {"den", 1, 1, 0, OP_DENOMINATOR, qden, 0, @@ -4236,9 +6792,13 @@ static CONST struct builtin builtins[] = { "dot product of two vectors"}, {"epsilon", 0, 1, 0, OP_SETEPSILON, 0, 0, "set or read allowed error for real calculations"}, - {"errno", 1, 1, 0, OP_NOP, 0, f_errno, - "system error message"}, - {"error", 1, 1, 0, OP_NOP, 0, f_error, + {"errcount", 0, 1, 0, OP_NOP, 0, f_errcount, + "set or read error count"}, + {"errmax", 0, 1, 0, OP_NOP, 0, f_errmax, + "set or read maximum for error count"}, + {"errno", 0, 1, 0, OP_NOP, 0, f_errno, + "set or read calc_errno"}, + {"error", 0, 1, 0, OP_NOP, 0, f_error, "generate error value"}, {"eval", 1, 1, 0, OP_NOP, 0, f_eval, "evaluate expression from string to value"}, @@ -4254,7 +6814,7 @@ static CONST struct builtin builtins[] = { "do function for all elements of list or matrix"}, {"frem", 2, 2, 0, OP_NOP, qfacrem, 0, "number with all occurrences of factor removed"}, - {"fact", 1, 1, 0, OP_NOP, qfact, 0, + {"fact", 1, 1, 0, OP_NOP, 0, f_fact, "factorial"}, {"fclose", 0, IN, 0, OP_NOP, 0, f_fclose, "close file"}, @@ -4288,6 +6848,14 @@ static CONST struct builtin builtins[] = { "write one or more strings to a file"}, {"fputstr", 2, IN, 0, OP_NOP, 0, f_fputstr, "write one or more null-terminated strings to a file"}, + {"free", 0, IN, FA, OP_NOP, 0, f_free, + "free listed or all global variables"}, + {"freeglobals", 0, 0, 0, OP_NOP, 0, f_freeglobals, + "free all global and visible static variables"}, + {"freeredc", 0, 0, 0, OP_NOP, 0, f_freeredc, + "free redc data cache"}, + {"freestatics", 0, 0, 0, OP_NOP, 0, f_freestatics, + "free all unscoped static variables"}, {"freopen", 2, 3, 0, OP_NOP, 0, f_freopen, "reopen a file stream to a named file"}, {"fscan", 2, IN, FA, OP_NOP, 0, f_fscan, @@ -4306,16 +6874,20 @@ static CONST struct builtin builtins[] = { "greatest common divisor"}, {"gcdrem", 2, 2, 0, OP_NOP, qgcdrem, 0, "a divided repeatedly by gcd with b"}, + {"gd", 1, 2, 0, OP_NOP, 0, f_gd, + "gudermannian function"}, {"getenv", 1, 1, 0, OP_NOP, 0, f_getenv, "value of environment variable (or NULL)"}, {"hash", 1, IN, 0, OP_NOP, 0, f_hash, "return non-negative hash value for one or\n\t\t more values"}, {"head", 2, 2, 0, OP_NOP, 0, f_head, "return list of specified number at head of a list"}, - {"highbit", 1, 1, 0, OP_NOP, f_highbit, 0, + {"highbit", 1, 1, 0, OP_HIGHBIT, 0, 0, "high bit number in base 2 representation"}, {"hmean", 0, IN, 0, OP_NOP, 0, f_hmean, "harmonic mean of values"}, + {"hnrmod", 4, 4, 0, OP_NOP, f_hnrmod, 0, + "v mod h*2^n+r, h>0, n>0, r = -1, 0 or 1"}, {"hypot", 2, 3, FE, OP_NOP, qhypot, 0, "hypotenuse of right triangle within accuracy c"}, {"ilog", 2, 2, 0, OP_NOP, f_ilog, 0, @@ -4338,8 +6910,12 @@ static CONST struct builtin builtins[] = { "whether a value is an association"}, {"isatty", 1, 1, 0, OP_NOP, 0, f_isatty, "whether a file is a tty"}, + {"isblk", 1, 1, 0, OP_ISBLK, 0, 0, + "whether a value is a block"}, {"isconfig", 1, 1, 0, OP_ISCONFIG, 0, 0, "whether a value is a config state"}, + {"isdefined", 1, 1, 0, OP_ISDEFINED, 0, 0, + "whether a string names a function"}, {"iserror", 1, 1, 0, OP_NOP, 0, f_iserror, "where a value is an error"}, {"iseven", 1, 1, 0, OP_ISEVEN, 0, 0, @@ -4364,10 +6940,16 @@ static CONST struct builtin builtins[] = { "whether a value is a number"}, {"isobj", 1, 1, 0, OP_ISOBJ, 0, 0, "whether a value is an object"}, + {"isobjtype", 1, 1, 0, OP_ISOBJTYPE, 0,0, + "whether a string names an object type"}, {"isodd", 1, 1, 0, OP_ISODD, 0, 0, "whether a value is an odd integer"}, + {"isoctet", 1, 1, 0, OP_ISOCTET, 0, 0, + "whether a value is an octet"}, {"isprime", 1, 2, 0, OP_NOP, f_isprime, 0, "whether a is a small prime, return b if error"}, + {"isptr", 1, 1, 0, OP_ISPTR, 0, 0, + "whether a value is a pointer"}, {"isqrt", 1, 1, 0, OP_NOP, qisqrt, 0, "integer part of square root"}, {"isrand", 1, 1, 0, OP_ISRAND, 0, 0, @@ -4378,8 +6960,6 @@ static CONST struct builtin builtins[] = { "whether a value is a real number"}, {"isrel", 2, 2, 0, OP_NOP, f_isrel, 0, "whether two numbers are relatively prime"}, - {"isset", 2, 2, 0, OP_NOP, f_isset, 0, - "whether bit b of abs(a) (in base 2) is set"}, {"isstr", 1, 1, 0, OP_ISSTR, 0, 0, "whether a value is a string"}, {"issimple", 1, 1, 0, OP_ISSIMPLE, 0, 0, @@ -4398,11 +6978,13 @@ static CONST struct builtin builtins[] = { "lcm of all integers up till number"}, {"lfactor", 2, 2, 0, OP_NOP, qlowfactor, 0, "lowest prime factor of a in first b primes"}, + {"links", 1, 1, 0, OP_LINKS, 0, 0, + "links to number or string value"}, {"list", 0, IN, 0, OP_NOP, 0, f_list, "create list of specified values"}, {"ln", 1, 2, 0, OP_NOP, 0, f_ln, "natural logarithm of value a within accuracy b"}, - {"lowbit", 1, 1, 0, OP_NOP, f_lowbit, 0, + {"lowbit", 1, 1, 0, OP_LOWBIT, 0, 0, "low bit number in base 2 representation"}, {"ltol", 1, 2, FE, OP_NOP, f_legtoleg, 0, "leg-to-leg of unit right triangle (sqrt(1 - a^2))"}, @@ -4418,13 +7000,19 @@ static CONST struct builtin builtins[] = { "minimum index of matrix a dim b"}, {"matsum", 1, 1, 0, OP_NOP, 0, f_matsum, "sum the numeric values in a matrix"}, + {"mattrace", 1, 1, 0, OP_NOP, 0, f_mattrace, + "return the trace of a square matrix"}, {"mattrans", 1, 1, 0, OP_NOP, 0, f_mattrans, "transpose of matrix"}, - {"max", 1, IN, 0, OP_NOP, f_max, 0, + {"max", 0, IN, 0, OP_NOP, 0, f_max, "maximum value"}, + {"md5", 0, IN, 0, OP_NOP, 0, f_md5, + "MD5 Hash Algorithm"}, + {"memsize", 1, 1, 0, OP_NOP, 0, f_memsize, + "number of octets used by the value, including overhead"}, {"meq", 3, 3, 0, OP_NOP, f_meq, 0, "whether a and b are equal modulo c"}, - {"min", 1, IN, 0, OP_NOP, f_min, 0, + {"min", 0, IN, 0, OP_NOP, 0, f_min, "minimum value"}, {"minv", 2, 2, 0, OP_NOP, qminv, 0, "inverse of a modulo b"}, @@ -4436,6 +7024,8 @@ static CONST struct builtin builtins[] = { "residue of a modulo b, rounding type c"}, {"modify", 2, 2, FA, OP_NOP, 0, f_modify, "modify elements of a list or matrix"}, + {"name", 1, 1, 0, OP_NOP, 0, f_name, + "name assigned to block or file"}, {"near", 2, 3, 0, OP_NOP, f_near, 0, "sign of (abs(a-b) - c)"}, {"newerror", 0, 1, 0, OP_NOP, 0, f_newerror, @@ -4446,7 +7036,7 @@ static CONST struct builtin builtins[] = { "return next small prime, return b if err"}, {"norm", 1, 1, 0, OP_NORM, 0, 0, "norm of a value (square of absolute value)"}, - {"null", 0, 0, 0, OP_UNDEF, 0, 0, + {"null", 0, IN, 0, OP_NOP, 0, f_null, "null value"}, {"num", 1, 1, 0, OP_NUMERATOR, qnum, 0, "numerator of fraction"}, @@ -4476,8 +7066,12 @@ static CONST struct builtin builtins[] = { "evaluates a polynomial given its coefficients or coefficient-list"}, {"pop", 1, 1, FA, OP_NOP, 0, f_listpop, "pop value from front of list"}, + {"popcnt", 1, 2, 0, OP_NOP, f_popcnt, 0, + "number of bits in a that match b (or 1)"}, {"power", 2, 3, 0, OP_NOP, 0, f_power, "value a raised to the power b within accuracy c"}, + {"protect", 1, 2, FA, OP_NOP, 0, f_protect, + "read or set protection level for variable"}, {"ptest", 1, 3, 0, OP_NOP, f_primetest, 0, "probabilistic primality test"}, {"printf", 1, IN, 0, OP_NOP, 0, f_printf, @@ -4496,6 +7090,10 @@ static CONST struct builtin builtins[] = { "additive 55 random number [0,2^64), [0,a), or [a,b)"}, {"randbit", 0, 1, 0, OP_NOP, f_randbit, 0, "additive 55 random number [0,2^a)"}, + {"random", 0, 2, 0, OP_NOP, f_random, 0, + "Blum-Blum-Shub random number [0,2^64), [0,a), or [a,b)"}, + {"randombit", 0, 1, 0, OP_NOP, f_randombit, 0, + "Blum-Blum-Sub random number [0,2^a)"}, {"randperm", 1, 1, 0, OP_NOP, 0, f_randperm, "random permutation of a list or matrix"}, {"rcin", 2, 2, 0, OP_NOP, qredcin, 0, @@ -4516,49 +7114,57 @@ static CONST struct builtin builtins[] = { "reverse a copy of a matrix or list"}, {"rewind", 0, IN, 0, OP_NOP, 0, f_rewind, "rewind file(s)"}, - {"rm", 1, 1, 0, OP_NOP, 0, f_rm, - "remove a file"}, + {"rm", 1, IN, 0, OP_NOP, 0, f_rm, + "remove file(s), -f turns off no-such-file errors"}, {"root", 2, 3, 0, OP_NOP, 0, f_root, "value a taken to the b'th root within accuracy c"}, {"round", 1, 3, 0, OP_NOP, 0, f_round, "round value a to b number of decimal places"}, - {"rsearch", 2, 3, 0, OP_NOP, 0, f_rsearch, + {"rsearch", 2, 4, 0, OP_NOP, 0, f_rsearch, "reverse search matrix or list for value b\n\t\t starting at index c"}, {"runtime", 0, 0, 0, OP_NOP, f_runtime, 0, "user mode cpu time in seconds"}, + {"saveval", 1, 1, 0, OP_SAVEVAL, 0, 0, + "set flag for saving values"}, {"scale", 2, 2, 0, OP_SCALE, 0, 0, "scale value up or down by a power of two"}, {"scan", 1, IN, FA, OP_NOP, 0, f_scan, "scan standard input for assignment to one or more variables"}, {"scanf", 2, IN, FA, OP_NOP, 0, f_scanf, "formatted scan of standard input for assignment to variables"}, - {"search", 2, 3, 0, OP_NOP, 0, f_search, + {"search", 2, 4, 0, OP_NOP, 0, f_search, "search matrix or list for value b starting\n\t\t at index c"}, - {"sec", 1, 2, FE, OP_NOP, qsec, 0, + {"sec", 1, 2, 0, OP_NOP, 0, f_sec, "sec of a within accuracy b"}, - {"sech", 1, 2, FE, OP_NOP, qsech, 0, + {"sech", 1, 2, 0, OP_NOP, 0, f_sech, "hyperbolic secant of a within accuracy b"}, - {"segment", 3, 3, 0, OP_NOP, 0, f_segment, + {"segment", 2, 3, 0, OP_NOP, 0, f_segment, "specified segment of specified list"}, {"select", 2, 2, 0, OP_NOP, 0, f_select, "form sublist of selected elements from list"}, + {"setbit", 2, 3, 0, OP_NOP, 0, f_setbit, + "set specified bit in string"}, {"sgn", 1, 1, 0, OP_SGN, qsign, 0, "sign of value (-1, 0, 1)"}, + {"sha", 0, IN, 0, OP_NOP, 0, f_sha, + "old Secure Hash Algorithm (SHS FIPS Pub 180)"}, + {"sha1", 0, IN, 0, OP_NOP, 0, f_sha1, + "Secure Hash Algorithm (SHS-1 FIPS Pub 180-1)"}, {"sin", 1, 2, 0, OP_NOP, 0, f_sin, "sine of value a within accuracy b"}, - {"sinh", 1, 2, FE, OP_NOP, qsinh, 0, + {"sinh", 1, 2, 0, OP_NOP, 0, f_sinh, "hyperbolic sine of a within accuracy b"}, {"size", 1, 1, 0, OP_NOP, 0, f_size, "total number of elements in value"}, {"sizeof", 1, 1, 0, OP_NOP, 0, f_sizeof, - "number of bytes in memory storage for value"}, + "number of octets used to hold the value"}, {"sort", 1, 1, 0, OP_NOP, 0, f_sort, "sort a copy of a matrix or list"}, {"sqrt", 1, 3, 0, OP_NOP, 0, f_sqrt, "square root of value a within accuracy b"}, {"srand", 0, 1, 0, OP_NOP, 0, f_srand, "seed the rand() function"}, - {"srandom", 0, 1, 0, OP_NOP, 0, f_srandom, + {"srandom", 0, 4, 0, OP_NOP, 0, f_srandom, "seed the random() function"}, {"ssq", 1, IN, 0, OP_NOP, 0, f_ssq, "sum of squares of values"}, @@ -4566,10 +7172,18 @@ static CONST struct builtin builtins[] = { "simple value converted to string"}, {"strcat", 1,IN, 0, OP_NOP, 0, f_strcat, "concatenate strings together"}, - {"strerror", 1, 1, 0, OP_NOP, 0, f_strerror, + {"strcmp", 2, 2, 0, OP_NOP, 0, f_strcmp, + "compare two null-terminated strings"}, + {"strcpy", 2, 2, 0, OP_NOP, 0, f_strcpy, + "copy null-terminated string to string"}, + {"strerror", 0, 1, 0, OP_NOP, 0, f_strerror, "string describing error type"}, {"strlen", 1, 1, 0, OP_NOP, 0, f_strlen, "length of string"}, + {"strncmp", 3, 3, 0, OP_NOP, 0, f_strncmp, + "compare strings a, b to c characters"}, + {"strncpy", 3, 3, 0, OP_NOP, 0, f_strncpy, + "copy up to c characters from string to string"}, {"strpos", 2, 2, 0, OP_NOP, 0, f_strpos, "index of first occurrence of b in a"}, {"strprintf", 1, IN, 0, OP_NOP, 0, f_strprintf, @@ -4580,23 +7194,27 @@ static CONST struct builtin builtins[] = { "formatted scan of string for assignments to variables"}, {"substr", 3, 3, 0, OP_NOP, 0, f_substr, "substring of a from position b for c chars"}, + {"sum", 0, IN, 0, OP_NOP, 0, f_sum, + "sum of list or object sums and/or other terms"}, {"swap", 2, 2, 0, OP_SWAP, 0, 0, "swap values of variables a and b (can be dangerous)"}, {"system", 1, 1, 0, OP_NOP, 0, f_system, "call Unix command"}, {"tail", 2, 2, 0, OP_NOP, 0, f_tail, "retain list of specified number at tail of list"}, - {"tan", 1, 2, FE, OP_NOP, qtan, 0, + {"tan", 1, 2, 0, OP_NOP, 0, f_tan, "tangent of a within accuracy b"}, - {"tanh", 1, 2, FE, OP_NOP, qtanh, 0, + {"tanh", 1, 2, 0, OP_NOP, 0, f_tanh, "hyperbolic tangent of a within accuracy b"}, + {"test", 1, 1, 0, OP_TEST, 0, 0, + "test that value is nonzero"}, {"time", 0, 0, 0, OP_NOP, f_time, 0, "number of seconds since 00:00:00 1 Jan 1970 UTC"}, {"trunc", 1, 2, 0, OP_NOP, f_trunc, 0, "truncate a to b number of decimal places"}, {"ungetc", 2, 2, 0, OP_NOP, 0, f_ungetc, "unget char read from file"}, - {"xor", 1, IN, 0, OP_NOP, f_xor, 0, + {"xor", 1, IN, 0, OP_NOP, 0, f_xor, "logical xor"}, /* end of table */ @@ -4700,6 +7318,8 @@ builtinfunc(long index, int argcount, VALUE *stck) result = (*bp->b_valfunc)(vpp[0], vpp[1]); else if ((bp->b_minargs == 3) && (bp->b_maxargs == 3)) result = (*bp->b_valfunc)(vpp[0], vpp[1], vpp[2]); + else if ((bp->b_minargs == 4) && (bp->b_maxargs == 4)) + result = (*bp->b_valfunc)(vpp[0],vpp[1],vpp[2],vpp[3]); else result = (*bp->b_valfunc)(argcount, vpp); return result; @@ -4735,7 +7355,12 @@ builtinfunc(long index, int argcount, VALUE *stck) result.v_num = (*bp->b_numfunc)(numargs[0], numargs[1]); break; case 3: - result.v_num = (*bp->b_numfunc)(numargs[0], numargs[1], numargs[2]); + result.v_num = (*bp->b_numfunc)(numargs[0], + numargs[1], numargs[2]); + break; + case 4: + result.v_num = (*bp->b_numfunc)(numargs[0], numargs[1], + numargs[2], numargs[3]); break; default: math_error("Bad builtin function call"); @@ -4815,5 +7440,20 @@ builtinopcode(long index) return builtins[index].b_opcode; } +/* + * Show the error-values created by newerror(str). + */ +void +showerrors(void) +{ + int i; + + if (nexterrnum == E_USERDEF) + printf("No new error-values created\n"); + for (i = E_USERDEF; i < nexterrnum; i++) + printf("%d: %s\n", i, + namestr(&newerrorstr, i - E_USERDEF)); +} + #endif /* FUNCLIST */ diff --git a/func.h b/func.h index 7720575..188f122 100644 --- a/func.h +++ b/func.h @@ -1,12 +1,13 @@ /* - * Copyright (c) 1993 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. */ -#ifndef FUNC_H -#define FUNC_H +#if !defined(__FUNC_H__) +#define __FUNC_H__ + #include "calc.h" #include "label.h" @@ -53,6 +54,9 @@ extern FUNC *findfunc(long index); extern char *namefunc(long index); extern BOOL evaluate(BOOL nestflag); extern long adduserfunc(char *name); +extern void rmuserfunc(char *name); +extern void rmalluserfunc(void); +extern long getuserfunc(char *name); extern void beginfunc(char *name, BOOL newflag); extern int builtinopcode(long index); extern char *builtinname(long index); @@ -74,7 +78,8 @@ extern void clearopt(void); extern void updateoldvalue(FUNC *fp); extern void calculate(FUNC *fp, int argcount); extern VALUE builtinfunc(long index, int argcount, VALUE *stck); +extern void freenumbers(FUNC *); +extern void freefunc(FUNC *); -#endif -/* END CODE */ +#endif /* !__FUNC_H__ */ diff --git a/hash.c b/hash.c index 49cb6da..7749fd7 100644 --- a/hash.c +++ b/hash.c @@ -1,6 +1,5 @@ -/* XXX - this code is currently not really used, but it will be soon */ /* - * 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, @@ -21,97 +20,957 @@ * PERFORMANCE OF THIS SOFTWARE. */ +#include +#include +#include +#include +#include "calc.h" #include "value.h" +#include "zrand.h" +#include "zrandom.h" +#include "hash.h" /* - * hash function interface table - * - * htbl[i] is the interface for hash algorithm i + * external hash_setup functions */ -static HASHFUNC htbl[HASH_TYPE_MAX+1]; +extern void shs_init_state(HASH*); +extern void shs1_init_state(HASH*); +extern void MD5_init_state(HASH*); /* - * static functions + * hash_setup - setup the hash state for a given hash */ -static void load_htbl(void (*h_func)(HASHFUNC*), HASHFUNC*); +static struct hash_setup { + int type; /* hash type (see XYZ_HASH_TYPE below) */ + void (*init_state)(HASH*); /* initialize a hash state */ +} htbl[] = { + { SHS_HASH_TYPE, shs_init_state }, /* old SHS / SHA */ + { SHS1_HASH_TYPE, shs1_init_state }, /* SHS-1 / SHA-1 */ + { MD5_HASH_TYPE, MD5_init_state }, /* MD5 */ + { -1, NULL } /* must be last */ +}; /* - * hash_init - initialize hash function interface table + * hash_init - initialize a hash state * - * We will load the hash function interface table and ensure that it is - * completely filled. + * given: + * type - hash type (see hash.h) + * state - the state to initialize, or NULL to malloc it * - * This function does not return if an error is encountered. + * returns: + * initialized state */ -void -hash_init(void) +HASH * +hash_init(int type, HASH *state) { int i; /* - * setup + * malloc if needed */ - for (i=0; i <= HASH_TYPE_MAX; ++i) { - htbl[i].type = -1; - } - - /* - * setup the hash function interface for all hashes - */ - load_htbl(shs_hashfunc, htbl); - - /* - * verify that our interface table is fully populated - */ - for (i=0; i <= HASH_TYPE_MAX; ++i) { - if (htbl[i].type != i) { - fprintf(stderr, "htbl[%d] is bad\n", i); - exit(1); + if (state == NULL) { + state = (HASH *)malloc(sizeof(HASH)); + if (state == NULL) { + math_error("hash_init: cannot malloc HASH"); + /*NOTREACHED*/ } } + + /* + * clear hash value + */ + memset((void*)state, 0, sizeof(HASH)); + state->bytes = TRUE; + + /* + * search for the hash_setup function + */ + for (i=0; htbl[i].init_state != NULL; ++i) { + + /* if we found the state that we were looking for */ + if (type == htbl[i].type) { + + /* initialize state and return */ + (htbl[i].init_state)(state); + + /* firewall - MAX_CHUNKSIZE must be >= chunksize */ + if (state->chunksize > MAX_CHUNKSIZE) { + math_error( + "internal error: MAX_CHUNKSIZE is too small"); + /*NOTREACHED*/ + } + return state; + } + } + + /* + * no such hash state + */ + math_error("internal error: hash type not found in htbl[]"); + return NULL; } /* - * load_htbl - load a hash function interface table slot - * - * We will call the h_func function, sanity check the function type - * and check to be sure that the slot is unused. + * hash_free - free the hash state + */ +void +hash_free(HASH *state) +{ + /* + * do nothing if state is NULL + */ + if (state == NULL) { + return; + } + + /* + * free main state and return + */ + free(state); + return; +} + + +/* + * hash_copy - copy a hash state * * given: - * h_func - a function that returns a HASHFUNC entry - * h - a array of hash function interfaces + * state - the state to copy * - * This function does not return if an error is encountered. + * returns: + * pointer to copy of state */ -static void -load_htbl(void (*h_func)(HASHFUNC*), HASHFUNC *h) +HASH * +hash_copy(HASH *state) { - HASHFUNC hent; /* hash function interface entry */ + HASH *new; /* copy of state */ /* - * call the HASHFUNC interface function + * malloc new state */ - h_func(&hent); - - /* - * sanity check the type - */ - if (hent.type < 0 || hent.type > HASH_TYPE_MAX) { - fprintf(stderr, "bad HASHFUNC type: %d\n", hent.type); - exit(1); - } - if (h[hent.type].type >= 0) { - fprintf(stderr, "h[%d].type: %d already in use\n", - hent.type, h[hent.type].type); - exit(1); + new = (HASH *)malloc(sizeof(HASH)); + if (new == NULL) { + math_error("hash_init: cannot malloc HASH"); + /*NOTREACHED*/ } /* - * load the entry + * duplicate state */ - h[hent.type] = hent; + memcpy((void *)new, (void *)state, sizeof(HASH)); + return new; +} + + +/* + * hash_cmp - compare hash values + * + * given: + * a first hash state + * b second hash state + * + * returns: + * TRUE => hash states are different + * FALSE => hash states are the same + */ +int +hash_cmp(HASH *a, HASH *b) +{ + /* + * firewall and quick check + */ + if (a == b) { + /* pointers to the same object */ + return FALSE; + } + if (a == NULL || b == NULL) { + /* one pointer is NULL, so they differ */ + return TRUE; + } + if (a->cmp == NULL || b->cmp == NULL) { + /* one cmp function is NULL, so they differ */ + return TRUE; + } + + /* + * compare hash types + */ + if (a->hashtype != b->hashtype) { + /* different hash types are different */ + return TRUE; + } + + /* + * perform the hash specific comparison + */ + return ((a->cmp)(a,b)); +} + + +/* + * hash_print - print the name and value of a hash + * + * given: + * state the hash state to print name and value of + */ +void +hash_print(HASH *state) +{ + /* print the hash */ + (state->print)(state); + return; +} + + +/* + * hash_final - finalize the state of a hash and return a ZVALUE + * + * given: + * state the hash state to finalize + * + * returns: + * hash state as a ZVALUE + */ +ZVALUE +hash_final(HASH *state) +{ + /* return the finalized the hash value */ + return (state->final)(state); +} + + +/* + * hash_long - note a long value + * + * given: + * type - hash type (see hash.h) + * longval - a long value + * state - the state to hash + * + * returns: + * the new state + * + * This function will hash a long value as if it were a 64 bit value. + * The input is a long. If a long is smaller than 64 bits, we will + * hash a final 32 bits of zeros. + */ +HASH * +hash_long(int type, long longval, HASH *state) +{ + long lval[64/LONG_BITS]; /* 64 bits of longs */ + + /* + * initialize if state is NULL + */ + if (state == NULL) { + state = hash_init(type, NULL); + } + + /* + * setup for the hash_long + */ + (state->chkpt)(state); + state->bytes = FALSE; /* data to be read as words */ + + /* + * catch the zero numeric value special case + */ + if (longval == 0) { + /* note a zero numeric value and return */ + (state->note)(HASH_ZERO(state->base), state); + return state; + } + + /* + * prep for a long value hash + */ + (state->note)(state->base, state); + + /* + * hash as if we have a 64 bit value + */ + memset((char *)lval, 0, sizeof(lval)); + lval[0] = longval; + (state->update)(state, (USB8 *)lval, sizeof(lval)); + + /* + * all done + */ + return state; +} + + +/* + * hash_zvalue - hash a ZVALUE + * + * given: + * type - hash type (see hash.h) + * zval - the ZVALUE + * state - the state to hash or NULL + * + * returns: + * the new state + */ +HASH * +hash_zvalue(int type, ZVALUE zval, HASH *state) +{ + +#if CALC_BYTE_ORDER == BIG_ENDIAN && BASEB == 16 + int full_lim; /* HALFs in whole chunks in zval */ + int chunkhalf; /* size of half buffer in HALFs */ + int i; + int j; +#endif +#if BASEB == 16 + HALF half[MAX_CHUNKSIZE]; /* For endian reversal */ +#endif + + /* + * initialize if state is NULL + */ + if (state == NULL) { + state = hash_init(type, NULL); + } + + /* + * setup for the ZVALUE hash + */ + (state->chkpt)(state); + state->bytes = FALSE; /* data to be read as words */ + + /* + * catch the zero numeric value special case + */ + if (ziszero(zval)) { + /* note a zero numeric value and return */ + (state->note)(HASH_ZERO(state->base), state); + return state; + } + + /* + * prep for a ZVALUE hash + */ + (state->note)(HASH_ZVALUE(state->base), state); + /* note if we have a negative value */ + if (zisneg(zval)) { + (state->note)(HASH_NEG(state->base), state); + } + +#if CALC_BYTE_ORDER == BIG_ENDIAN && BASEB == 16 + + /* + * hash full chunks + * + * We need to convert the array of HALFs into canonical architectural + * independent form -- 32 bit arrays. Because we have 16 bit values + * in Big Endian form, we need to swap 16 bit values so that they + * appear as 32 bit Big Endian values. + */ + chunkhalf = state->chunksize/sizeof(HALF); + full_lim = (zval.len / chunkhalf) * chunkhalf; + for (i=0; i < full_lim; i += chunkhalf) { + /* HALF swap copy a chunk into a data buffer */ + for (j=0; j < chunkhalf; j += 2) { + half[j] = zval.v[i+j+1]; + half[j+1] = zval.v[i+j]; + } + (state->update)(state, (USB8*) half, state->chunksize); + } + + /* + * hash the final partial chunk (if any) + * + * We need to convert the array of HALFs into canonical architectural + * independent form -- 32 bit arrays. Because we have 16 bit values + * in Big Endian form, we need to swap 16 bit values so that they + * appear as 32 bit Big Endian values. + */ + if (zval.len > full_lim) { + for (j=0; j < zval.len-full_lim-1; j += 2) { + half[j] = zval.v[full_lim+i+1]; + half[j+1] = zval.v[full_lim+i]; + } + if (j < zval.len-full_lim) { + half[j] = (HALF)0; + half[j+1] = zval.v[zval.len-1]; + --full_lim; + } + (state->update)(state, (USB8 *) half, + (zval.len-full_lim)*sizeof(HALF)); + } + +#else + + /* + * hash the array of HALFs + * + * The array of HALFs is equivalent to the canonical architectural + * independent form. We either have 32 bit HALFs (in which case + * we do not case the byte order) or we have 16 bit HALFs in Little + * Endian order (which happens to be laid out in the same order as + * 32 bit values). + */ + (state->update)(state, (USB8 *)zval.v, zval.len*sizeof(HALF)); + +#if BASEB == 16 + if (zval.len & 1) { /* padding to complete word */ + half[0] = 0; + (state->update)(state, (USB8 *) half, 2); + } +#endif + +#endif + + /* + * all done + */ + return state; +} + + +/* + * hash_number - hash a NUMBER + * + * given: + * type - hash type (see hash.h) + * n - the NUMBER + * state - the state to hash or NULL + * + * returns: + * the new state + */ +HASH * +hash_number(int type, void *n, HASH *state) +{ + NUMBER *number = (NUMBER *)n; /* n as a NUMBER pointer */ + BOOL sign; /* sign of the denominator */ + + /* + * initialize if state is NULL + */ + if (state == NULL) { + state = hash_init(type, NULL); + } + + /* + * setup for the NUMBER hash + */ + (state->chkpt)(state); + state->bytes = FALSE; + + /* + * process the numerator + */ + state = hash_zvalue(type, number->num, state); + + /* + * if the NUMBER is not an integer, process the denominator + */ + if (qisfrac(number)) { + + /* note the division */ + (state->note)(HASH_DIV(state->base), state); + + /* hash denominator as positive -- just in case */ + sign = number->den.sign; + number->den.sign = 0; + + /* hash the denominator */ + state = hash_zvalue(type, number->den, state); + + /* restore the sign */ + number->den.sign = sign; + } + + /* + * all done + */ + return state; +} + + +/* + * hash_complex - hash a COMPLEX + * + * given: + * type - hash type (see hash.h) + * c - the COMPLEX + * state - the state to hash or NULL + * + * returns: + * the new state + */ +HASH * +hash_complex(int type, void *c, HASH *state) +{ + COMPLEX *complex = (COMPLEX *)c; /* c as a COMPLEX pointer */ + + /* + * initialize if state is NULL + */ + if (state == NULL) { + state = hash_init(type, NULL); + } + + /* + * setup for the COMPLEX hash + */ + (state->chkpt)(state); + state->bytes = FALSE; + + /* + * catch the zero special case + */ + if (ciszero(complex)) { + /* note a zero numeric value and return */ + (state->note)(HASH_ZERO(state->base), state); + return state; + } + + /* + * process the real value if not pure imaginary + * + * We will ignore the real part if the value is of the form 0+xi. + */ + if (!qiszero(complex->real)) { + state = hash_number(type, complex->real, state); + } + + /* + * if the NUMBER is not real, process the imaginary value + * + * We will ignore the imaginary part of the value is of the form x+0i. + */ + if (!cisreal(complex)) { + + /* note the sqrt(-1) */ + (state->note)(HASH_COMPLEX(state->base), state); + + /* hash the imaginary value */ + state = hash_number(type, complex->imag, state); + } + + /* + * all done + */ + return state; +} + + +/* + * hash_str - hash a string + * + * given: + * type - hash type (see hash.h) + * str - the string + * state - the state to hash or NULL + * + * returns: + * the new state + */ +HASH * +hash_str(int type, char *str, HASH *state) +{ + USB32 len; /* string length */ + + /* + * initialize if state is NULL + */ + if (state == NULL) { + state = hash_init(type, NULL); + } + + /* + * setup for the string hash + */ + if (!state->bytes) { + (state->chkpt)(state); + state->bytes = TRUE; + } + + len = strlen(str); + + /* + * hash the string + */ + (state->update)(state, (USB8*)str, len); + + /* + * all done + */ + return state; +} + + +/* + * hash_usb8 - hash an array of USB8s + * + * given: + * type - hash type (see hash.h) + * byte - pointer to an array of USB8s + * len - number of USB8s to hash + * state - the state to hash or NULL + * + * returns: + * the new state + */ +HASH * +hash_usb8(int type, USB8 *byte, int len, HASH *state) +{ + /* + * initialize if state is NULL + */ + if (state == NULL) { + state = hash_init(type, NULL); + } + + /* + * setup for the string hash + */ + if (!state->bytes) { + (state->chkpt)(state); + state->bytes = TRUE; + } + + /* + * hash the array of octets + */ + (state->update)(state, byte, (USB32)len); + + /* + * all done + */ + return state; +} + + +/* + * hash_value - hash a value + * + * given: + * type - hash type (see hash.h) + * v - the value + * state - the state to hash or NULL + * + * returns: + * the new state + */ +HASH * +hash_value(int type, void *v, HASH *state) +{ + LISTELEM *ep; /* list element pointer */ + ASSOCELEM **assochead; /* association chain head */ + ASSOCELEM *aep; /* current association value */ + ASSOCELEM *nextaep; /* next association value */ + VALUE *value = (VALUE *)v; /* v cast to a VALUE */ + VALUE *vp; /* pointer to next OBJ table value */ + ZVALUE fileval; /* size, position, dev, inode of a file */ + int i; + + /* + * initialize if state is NULL + */ + if (state == NULL) { + state = hash_init(type, NULL); + } + + /* + * process the value type + */ + switch (value->v_type) { + case V_NULL: + (state->chkpt)(state); + state->bytes = TRUE; + break; + + case V_INT: + /* setup for the this value type */ + (state->chkpt)(state); + (state->type)(value->v_type, state); + + /* hash as if we have a 64 bit value */ + state = hash_long(type, (long)value->v_int, state); + break; + + case V_NUM: + + /* hash this type */ + state = hash_number(type, value->v_num, state); + break; + + case V_COM: + /* setup for the this value type */ + (state->chkpt)(state); + (state->type)(value->v_type, state); + + /* hash this type */ + state = hash_complex(type, value->v_com, state); + break; + + case V_ADDR: + /* there is nothing to setup, simply hash what we point at */ + state = hash_value(type, value->v_addr, state); + break; + + case V_STR: + /* strings have no setup */ + + /* hash this type */ + state = hash_str(type, value->v_str->s_str, state); + break; + + case V_MAT: + /* setup for the this value type */ + (state->chkpt)(state); + (state->type)(value->v_type, state); + state->bytes = TRUE; + + /* hash all the elements of the matrix */ + for (i=0; i < value->v_mat->m_size; ++i) { + + /* hash the next matrix value */ + state = hash_value(type, + value->v_mat->m_table+i, state); + state->bytes = FALSE; /* as if reading words */ + } + break; + + case V_LIST: + /* setup for the this value type */ + (state->chkpt)(state); + (state->type)(value->v_type, state); + + /* hash all the elements of the list */ + for (i=0, ep = value->v_list->l_first; + ep != NULL && i < value->v_list->l_count; + ++i, ep = ep->e_next) { + + /* hash the next list value */ + state = hash_value(type, &ep->e_value, state); + state->bytes = FALSE; /* as if reading words */ + } + break; + + case V_ASSOC: + /* setup for the this value type */ + (state->chkpt)(state); + (state->type)(value->v_type, state); + state->bytes = TRUE; + + /* hash the association */ + assochead = value->v_assoc->a_table; + for (i = 0; i < value->v_assoc->a_size; i++) { + nextaep = *assochead; + while (nextaep) { + aep = nextaep; + nextaep = aep->e_next; + + /* hash the next association value */ + state = hash_value(type, &aep->e_value, state); + state->bytes = FALSE; /* as if reading words */ + } + assochead++; + } + break; + + case V_OBJ: + /* setup for the this value type */ + (state->chkpt)(state); + (state->type)(value->v_type, state); + state->bytes = TRUE; /* reading bytes */ + + /* hash the object name and then the element values */ + + state = hash_str(type, value->v_obj->o_actions->name, state); + (state->chkpt)(state); + + for (i=value->v_obj->o_actions->count, vp=value->v_obj->o_table; + i-- > 0; + vp++) { + + /* hash the next object value */ + state = hash_value(type, vp, state); + state->bytes = FALSE; /* as if reading words */ + } + break; + + case V_FILE: + /* setup for the this value type */ + (state->chkpt)(state); + (state->type)(value->v_type, state); + + /* hash file length if possible */ + if (getsize(value->v_file, &fileval) == 0) { + state = hash_zvalue(type, fileval, state); + zfree(fileval); + } else { + /* hash -1 for invalid length */ + state = hash_long(type, (long)-1, state); + } + /* hash the file position if possible */ + if (getloc(value->v_file, &fileval) == 0) { + state = hash_zvalue(type, fileval, state); + zfree(fileval); + } else { + /* hash -1 for invalid location */ + state = hash_long(type, (long)-1, state); + } + /* hash the file device if possible */ + if (get_device(value->v_file, &fileval) == 0) { + state = hash_zvalue(type, fileval, state); + zfree(fileval); + } else { + /* hash -1 for invalid device */ + state = hash_long(type, (long)-1, state); + } + /* hash the file inode if possible */ + if (get_inode(value->v_file, &fileval) == 0) { + state = hash_zvalue(type, fileval, state); + zfree(fileval); + } else { + /* hash -1 for invalid inode */ + state = hash_long(type, (long)-1, state); + } + break; + + case V_RAND: + /* setup for the this value type */ + (state->chkpt)(state); + (state->type)(value->v_type, state); + + /* hash the RAND state */ + state = hash_long(type, (long)value->v_rand->seeded, state); + state = hash_long(type, (long)value->v_rand->bits, state); + (state->update)(state, + (USB8 *)value->v_rand->buffer, SLEN*FULL_BITS/8); + state = hash_long(type, (long)value->v_rand->j, state); + state = hash_long(type, (long)value->v_rand->k, state); + (state->update)(state, + (USB8 *)value->v_rand->slot, SCNT*FULL_BITS/8); + (state->update)(state, + (USB8*)value->v_rand->shuf, SHUFLEN*FULL_BITS/8); + state->bytes = FALSE; /* as if reading words */ + break; + + case V_RANDOM: + /* setup for the this value type */ + (state->chkpt)(state); + (state->type)(value->v_type, state); + + /* hash the RANDOM state */ + state = hash_long(type, (long)value->v_random->seeded, state); + state = hash_long(type, (long)value->v_random->bits, state); + (state->update)(state, + (USB8 *)&(value->v_random->buffer), BASEB/8); + state = hash_zvalue(type, value->v_random->r, state); + state = hash_zvalue(type, value->v_random->n, state); + state->bytes = FALSE; /* as if reading words */ + break; + + case V_CONFIG: + /* setup for the this value type */ + (state->chkpt)(state); + (state->type)(value->v_type, state); + + /* hash the CONFIG state */ + state = hash_long(type, (long)value->v_config->outmode, state); + state = hash_long(type,(long)value->v_config->outdigits, state); + state = hash_number(type, value->v_config->epsilon, state); + state = hash_long(type, + (long)value->v_config->epsilonprec, state); + state = hash_long(type, + (long)value->v_config->traceflags, state); + state = hash_long(type, (long)value->v_config->maxprint, state); + state = hash_long(type, (long)value->v_config->mul2, state); + state = hash_long(type, (long)value->v_config->sq2, state); + state = hash_long(type, (long)value->v_config->pow2, state); + state = hash_long(type, (long)value->v_config->redc2, state); + state = hash_long(type, (long)value->v_config->tilde_ok, state); + state = hash_long(type, (long)value->v_config->tab_ok, state); + state = hash_long(type, (long)value->v_config->quomod, state); + state = hash_long(type, (long)value->v_config->quo, state); + state = hash_long(type, (long)value->v_config->mod, state); + state = hash_long(type, (long)value->v_config->sqrt, state); + state = hash_long(type, (long)value->v_config->appr, state); + state = hash_long(type, (long)value->v_config->cfappr, state); + state = hash_long(type, (long)value->v_config->cfsim, state); + state = hash_long(type, (long)value->v_config->outround, state); + state = hash_long(type, (long)value->v_config->round, state); + state = hash_long(type, (long)value->v_config->leadzero, state); + state = hash_long(type, (long)value->v_config->fullzero, state); + state = hash_long(type, + (long)value->v_config->maxscancount, state); + state = hash_str(type, value->v_config->prompt1, state); + state->bytes = FALSE; /* as if just read words */ + state = hash_str(type, value->v_config->prompt2, state); + state->bytes = FALSE; /* as if just read words */ + state = hash_long(type, + (long)value->v_config->blkmaxprint, state); + state = hash_long(type, + (long)value->v_config->blkverbose, state); + state = hash_long(type, + (long)value->v_config->blkbase, state); + state = hash_long(type, + (long)value->v_config->blkfmt, state); + state = hash_long(type, + (long)value->v_config->lib_debug, state); + state = hash_long(type, + (long)value->v_config->calc_debug, state); + state = hash_long(type, + (long)value->v_config->user_debug, state); + break; + + case V_HASH: + /* setup for the this value type */ + (state->chkpt)(state); + (state->type)(value->v_type, state); + + /* hash the HASH state */ + state = hash_long(type, (long)value->v_hash->type, state); + state = hash_long(type, (long)value->v_hash->bytes,state); + state = hash_long(type, (long)value->v_hash->base, state); + state = hash_long(type, (long)value->v_hash->chunksize, state); + state = hash_long(type, (long)value->v_hash->unionsize, state); + (state->update)(state, + value->v_hash->h_union.data, state->unionsize); + state->bytes = FALSE; /* as if reading words */ + break; + + case V_BLOCK: + /* there is no setup for a BLOCK */ + + /* hash the octets in the BLOCK */ + if (value->v_block->datalen > 0) { + state = hash_usb8(type, value->v_block->data, + value->v_block->datalen, state); + } + break; + + case V_OCTET: + /* there is no setup for an OCTET */ + + /* hash the OCTET */ + state = hash_usb8(type, value->v_octet, 1, state); + break; + + case V_NBLOCK: + /* there is no setup for a NBLOCK */ + + /* hash the octets in the NBLOCK */ + if (value->v_nblock->blk->datalen > 0) { + state = hash_usb8(type, value->v_nblock->blk->data, + value->v_nblock->blk->datalen, + state); + } + break; + + default: + math_error("hashing an unknown value"); + /*NOTREACHED*/ + } + return state; } diff --git a/hash.h b/hash.h index 85f3169..b5c877e 100644 --- a/hash.h +++ b/hash.h @@ -1,6 +1,5 @@ -/* XXX - this code is currently not really used, but it will be soon */ /* - * 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, @@ -21,30 +20,107 @@ * PERFORMANCE OF THIS SOFTWARE. */ -#if !defined(HASH_H) -#define HASH_H + +#if !defined(__HASH_H__) +#define __HASH_H__ + + +#include "shs.h" +#include "shs1.h" +#include "md5.h" +#include "zmath.h" + + +/* MAX_CHUNKSIZE is the largest chunksize of any hash */ +#define MAX_CHUNKSIZE (SHS1_CHUNKSIZE) + +/* max size of debugging strings in xyz_print() functions */ +#define DEBUG_SIZE 127 + /* * hashstate - state of a hash system + * + * Hashing some types of values requires a checkpoint (chkpt function call) + * to be performed, which pads buffered data with 0's and performs an + * update. The checkpoint thus causes the value to start on a new hash + * block boundary with no buffered data. + * + * Some data types (strings, BLOCKs and OCTETs) do not require a + * checkpoint as long as the previous value hashed was a string, + * BLOCK or OCTET. */ -struct hashstate { - int type; /* hash type (see XYZ_HASH_TYPE below) */ - BOOL prevstr; /* TRUE=>previous value hashed was a string */ - union { - SHS_INFO hh_shs; /* old Secure Hash Standard */ - } h_union; -}; typedef struct hashstate HASH; -/* For ease in referencing */ -#define h_shs h_union.hh_shs +struct hashstate { + int hashtype; /* XYZ_HASH_TYPE debug value */ + BOOL bytes; /* TRUE => reading bytes rather than words */ + void (*update)(HASH*, USB8*, USB32); /* update arbitrary length */ + void (*chkpt)(HASH*); /* checkpoint a state */ + void (*note)(int, HASH*); /* note a special value */ + void (*type)(int, HASH*); /* note a VALUE type */ + ZVALUE (*final)(HASH*); /* complete hash state */ + int (*cmp)(HASH*,HASH*); /* compare to states, TRUE => a!=b */ + void (*print)(HASH*); /* print the value of a hash */ + int base; /* XYZ_BASE special hash value */ + int chunksize; /* XYZ_CHUNKSIZE input chunk size */ + int unionsize; /* h_union element size */ + union { /* hash dependent states */ + USB8 data[1]; /* used by hash_value to hash below */ + SHS_INFO h_shs; /* old SHS/SHA internal state */ + SHS1_INFO h_shs1; /* new SHS-1/SHA-1 internal state */ + MD5_CTX h_md5; /* MD5 internal state */ + } h_union; +}; -/* +/* + * what to xor to digest value when hashing special values + * + * IMPORTANT: To avoid overlap due to the HASH_XYZ macros below, the + * XYZ_BASE values should be unique random hex values + * that end in 00 (i.e., 0 mod 256). + */ +#define SHS_BASE 0x12face00 /* old SHS / SHA */ +#define SHS1_BASE 0x23cafe00 /* new SHS-1 / SHA-1 */ +#define MD5_BASE 0x34feed00 /* MD5 */ + + +/* * XYZ_HASH_TYPE - hash types * - * we support these hash types - must start with 0 + * we support these hash types */ -#define SHS_HASH_TYPE 0 -#define HASH_TYPE_MAX 0 /* must be number of XYZ_HASH_TYPE values */ +#define SHS_HASH_TYPE 1 +#define SHS1_HASH_TYPE 2 +#define MD5_HASH_TYPE 3 -#endif /* !HASH_H */ + +/* + * Note a special value given the base value + */ +#define HASH_NEG(base) (1+base) /* note a negative value */ +#define HASH_COMPLEX(base) (2+base) /* note a complex value */ +#define HASH_DIV(base) (4+base) /* note a division by a value */ +#define HASH_ZERO(base) (8+base) /* note a zero numeric value */ +#define HASH_ZVALUE(base) (16+base) /* note a ZVALUE */ + + +/* + * external functions + */ +extern HASH* hash_init(int, HASH*); +extern void hash_free(HASH*); +extern HASH* hash_copy(HASH*); +extern int hash_cmp(HASH*, HASH*); +extern void hash_print(HASH*); +extern ZVALUE hash_final(HASH*); +extern HASH* hash_long(int, long, HASH*); +extern HASH* hash_zvalue(int, ZVALUE, HASH*); +extern HASH* hash_number(int, void*, HASH*); +extern HASH* hash_complex(int, void*, HASH*); +extern HASH* hash_str(int, char*, HASH*); +extern HASH* hash_usb8(int, USB8*, int, HASH*); +extern HASH* hash_value(int, void*, HASH*); + + +#endif /* !__HASH_H__ */ diff --git a/have_const.c b/have_const.c index daeef6f..3173d78 100644 --- a/have_const.c +++ b/have_const.c @@ -40,6 +40,8 @@ * chongo was here /\../\ */ +#include + MAIN main(void) { diff --git a/have_memmv.c b/have_memmv.c new file mode 100644 index 0000000..88bfbe5 --- /dev/null +++ b/have_memmv.c @@ -0,0 +1,58 @@ +/* + * have_memmv - Determine if we memmove() + * + * usage: + * have_newstr + * + * Not all systems with memcpy() have memmove() functions, so this may not + * compile on your system. + * + * This prog outputs several defines: + * + * HAVE_MEMMOVE + * defined ==> use memmove() + * undefined ==> use internal slow memmove() instead + */ +/* + * 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, + * provided that the above copyright, this permission notice and text + * this comment, 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. + * + * chongo was here /\../\ + */ + +#include + +#define MOVELEN 3 + +char src[] = "chongo was here"; +char dest[MOVELEN+1]; + +MAIN +main(void) +{ +#if defined(HAVE_NO_MEMMOVE) + printf("#undef HAVE_MEMMOVE /* no */\n"); +#else /* HAVE_NO_MEMMOVE */ + (void) memmove(dest, src, MOVELEN); + + printf("#define HAVE_MEMMOVE /* yes */\n"); +#endif /* HAVE_NO_MEMMOVE */ + exit(0); +} diff --git a/have_newstr.c b/have_newstr.c index 382c354..95e4909 100644 --- a/have_newstr.c +++ b/have_newstr.c @@ -39,6 +39,8 @@ * chongo was here /\../\ */ +#include + #define MOVELEN 3 char src[] = "chongo was here"; diff --git a/have_offscl.c b/have_offscl.c new file mode 100644 index 0000000..36fb344 --- /dev/null +++ b/have_offscl.c @@ -0,0 +1,83 @@ +/* + * have_offscl - determine if have a scalar off_t element + * + * usage: + * have_offscl + * + * On some systems, off_t is a scalar value on which one can perform + * arithmetic operations, assignments and comparisons. On some systems + * off_t is some sort of union or struct which must be converted into + * a ZVALUE in order to perform arithmetic operations, assignments and + * comparisons. + * + * + * This prog outputs several defines: + * + * HAVE_OFF_T_SCALAR + * defined ==> ok to perform arithmetic ops, = and comparisons + * undefined ==> convert to ZVALUE first + */ +/* + * Copyright (c) 1996 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 text + * this comment, 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. + * + * chongo was here /\../\ + */ + +#include +#include +#include + +MAIN +main(void) +{ +#if !defined(OFF_T_NON_SCALAR) + off_t value; /* an off_t to perform arithmatic on */ + off_t value2; /* an off_t to perform arithmatic on */ + + /* + * do some math opts on an off_t + */ + value = (off_t)getpid(); + value2 = (off_t)-1; + if (value > (off_t)1) { + --value; + } + if (value <= (off_t)getppid()) { + --value; + } + if (value == value2) { + value += value2; + } + value <<= 1; + if (!value) { + printf("/* something for the off_t to do */\n"); + } + + /* + * report off_t as a scalar + */ + printf("#undef HAVE_OFF_T_SCALAR\n"); + printf("#define HAVE_OFF_T_SCALAR /* off_t is a simple value */\n"); +#else + printf("#undef HAVE_OFF_T_SCALAR /* off_t is not a simple value */\n"); +#endif + exit(0); +} diff --git a/have_posscl.c b/have_posscl.c new file mode 100644 index 0000000..b07034a --- /dev/null +++ b/have_posscl.c @@ -0,0 +1,84 @@ +/* + * have_posscl - determine if have a scalar FILEPOS element + * + * usage: + * have_posscl + * + * On some systems, FILEPOS is a scalar value on which one can perform + * arithmetic operations, assignments and comparisons. On some systems + * FILEPOS is some sort of union or struct which must be converted into + * a ZVALUE in order to perform arithmetic operations, assignments and + * comparisons. + * + * + * This prog outputs several defines: + * + * HAVE_FILEPOS_SCALAR + * defined ==> ok to perform arithmetic ops, = and comparisons + * undefined ==> convert to ZVALUE first + */ +/* + * Copyright (c) 1996 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 text + * this comment, 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. + * + * chongo was here /\../\ + */ + +#include +#include +#include +#include "have_fpos.h" + +MAIN +main(void) +{ +#if !defined(FILEPOS_NON_SCALAR) + FILEPOS value; /* an FILEPOS to perform arithmatic on */ + FILEPOS value2; /* an FILEPOS to perform arithmatic on */ + + /* + * do some math opts on an FILEPOS + */ + value = (FILEPOS)getpid(); + value2 = (FILEPOS)-1; + if (value > (FILEPOS)1) { + --value; + } + if (value <= (FILEPOS)getppid()) { + --value; + } + if (value == value2) { + value += value2; + } + value <<= 1; + if (!value) { + printf("/* something for the FILEPOS to do */\n"); + } + + /* + * report FILEPOS as a scalar + */ + printf("#undef HAVE_FILEPOS_SCALAR\n"); + printf("#define HAVE_FILEPOS_SCALAR /* FILEPOS is a simple value */\n"); +#else + printf("#undef HAVE_FILEPOS_SCALAR /* FILEPOS is not a simple value */\n"); +#endif + exit(0); +} diff --git a/have_uid_t.c b/have_uid_t.c index b7144b9..88807a4 100644 --- a/have_uid_t.c +++ b/have_uid_t.c @@ -36,6 +36,8 @@ * chongo was here /\../\ */ +#include + #if !defined(HAVE_NO_UID_T) #include "have_unistd.h" #if defined(HAVE_UNISTD_H) diff --git a/help.c b/help.c new file mode 100644 index 0000000..2b35860 --- /dev/null +++ b/help.c @@ -0,0 +1,133 @@ +/* + * Copyright (c) 1997 David I. Bell + * Permission is granted to use, distribute, or modify this source, + * provided that this copyright notice remains intact. + * + * Arbitrary precision calculator. + */ + +#include +#include + +#include "calc.h" +#include "conf.h" + +#include "have_unistd.h" +#if defined(HAVE_UNISTD_H) +#include +#endif + + +/* + * some help topics are symbols, so we alias them to nice filenames + */ +static struct help_alias { + char *topic; + char *filename; +} halias[] = { + {"=", "address"}, + {"->", "arrow"}, + {"=", "assign"}, + {"*", "dereference"}, + {".", "oldvalue"}, + {"%", "mod"}, + {"//", "quo"}, + {NULL, NULL} +}; + + +/* + * external values + */ +extern char *pager; /* $PAGER or default */ + + +/* + * givehelp - display a help file + * + * given: + * type the type of help to give, NULL => index + */ +void +givehelp(char *type) +{ + struct help_alias *p; /* help alias being considered */ + char *helpcmd; /* what to execute to print help */ + char *c; + + /* + * check permissions to see if we are allowed to help + */ + if (!allow_exec || !allow_read) { + fprintf(stderr, + "sorry, help is only allowed with -m mode 5 or 7\n"); + return; + } + + /* catch the case where we just print the index */ + if (type == NULL) { + type = DEFAULTCALCHELP; /* the help index file */ + } + + /* alias the type of help, if needed */ + for (p=halias; p->topic; ++p) { + if (strcmp(type, p->topic) == 0) { + type = p->filename; + break; + } + } + + /* + * sanity check on name + */ + /* look for /. or a leading . */ + if (strstr(type, "/.") != NULL || type[0] == '.') { + fprintf(stderr, "bad help name\n"); + return; + } + /* look for chars that could be shell meta chars */ + for (c = type; *c; ++c) { + switch ((int)*c) { + case '+': + case ',': + case '-': + case '.': + case '/': + case '_': + break; + default: + if (!isascii((int)*c) || !isalnum((int)*c)) { + fprintf(stderr, "bogus char in help name\n"); + return; + } + break; + } + } + + + /* form the help command name */ + helpcmd = (char *)malloc( + sizeof("if [ ! -r \"")+sizeof(HELPDIR)+1+strlen(type)+ + sizeof("\" ];then ")+ + strlen(pager)+1+1+sizeof(HELPDIR)+1+strlen(type)+1+1+ + sizeof("elif [ ! -r \"")+sizeof(CUSTOMHELPDIR)+1+strlen(type)+ + sizeof("\" ];then ")+ + strlen(pager)+1+1+sizeof(CUSTOMHELPDIR)+1+strlen(type)+1+1+ + sizeof(";else ")+sizeof(ECHO)+ + sizeof("echo no such help, try: help help;fi")+1); + sprintf(helpcmd, + "if [ -r \"%s/%s\" ];then %s \"%s/%s\";" + "elif [ -r \"%s/%s\" ];then %s \"%s/%s\";" + "else %s no such help, try: help help;fi", + HELPDIR, type, pager, HELPDIR, type, + CUSTOMHELPDIR, type, pager, CUSTOMHELPDIR, type, ECHO); + if (conf->calc_debug > 0) { + printf("%s\n", helpcmd); + sleep(3); + } + + /* execute the help command */ + system(helpcmd); + free(helpcmd); +} + diff --git a/help/Makefile b/help/Makefile index f5266a3..1285e91 100644 --- a/help/Makefile +++ b/help/Makefile @@ -43,47 +43,96 @@ FMT= fmt CMP= cmp CAT= cat -# Standard help files +# Standard and Builtin help files # -# The obj.file is special and is not listed here. -# -STD_HELP_FILES1= intro overview help command config \ - define environment expression file history interrupt mat -STD_HELP_FILES2= operator statement types usage variable -STD_HELP_FILES3= todo credit -STD_HELP_FILES= ${STD_HELP_FILES1} ${STD_HELP_FILES2} ${STD_HELP_FILES3} -SYMBOL_HELP= assign +STD_HELP_FILES_1= intro overview help +STD_HELP_FILES_2= assoc -# These two lists are prodiced by the detaillist and missinglist rules -# when no WARNINGS are detected. +BLT_HELP_FILES_3= builtin + +STD_HELP_FILES_4= command config custom define environment expression + +BLT_HELP_FILES_5= errorcodes + +STD_HELP_FILES_6= file history interrupt list mat + +# beacuse obj is built special (due to confusion with it as +# a symlink for some built environments, we treat obj specially +# and call it obj.file # -DETAIL_HELP= abs access acos acosh acot acoth acsc acsch append appr archive \ - arg asec asech asin asinh assoc atan atan2 atanh avg base bround \ - btrunc ceil cfappr cfsim char cmdbuf cmp comb conj cos cosh cot coth \ - count cp csc csch ctime delete den det digit digits dp epsilon errno \ +SPECIAL_HELP_7= obj.file + +STD_HELP_FILES_8= operator statement + +BLT_HELP_FILES_9= stdlib + +STD_HELP_FILES_10= types usage unexpected variable + +BLT_HELP_FILES_11= altbind bindings custom_cal libcalc new_custom stdlib + +STD_HELP_FILES_12= archive + +BLT_HELP_FILES_13= bugs changes + +STD_HELP_FILES_14= contrib credit todo + +# These files are used in the following order to construct full +# +FULL_HELP_FILES= ${STD_HELP_FILES_1} ${STD_HELP_FILES_2} \ + ${BLT_HELP_FILES_3} ${STD_HELP_FILES_4} \ + ${BLT_HELP_FILES_5} ${STD_HELP_FILES_6} \ + ${SPECIAL_HELP_7} ${STD_HELP_FILES_8} \ + ${BLT_HELP_FILES_9} ${STD_HELP_FILES_10} \ + ${BLT_HELP_FILES_11} ${STD_HELP_FILES_12} \ + ${BLT_HELP_FILES_13} ${STD_HELP_FILES_14} + +# These full files are those who are not built or constrcuted +# +STD_HELP_FILES= ${STD_HELP_FILES_1} ${STD_HELP_FILES_2} \ + ${STD_HELP_FILES_4} ${STD_HELP_FILES_6} \ + ${STD_HELP_FILES_8} ${STD_HELP_FILES_10} \ + ${STD_HELP_FILES_12} ${STD_HELP_FILES_14} + +# These full files are those who are built by this Makefile +# +# Note that ${SPECIAL_HELP_7} is not included in this list +# because of problems with its name. +# +BLT_HELP_FILES= ${BLT_HELP_FILES_3} ${BLT_HELP_FILES_5} \ + ${BLT_HELP_FILES_9} \ + ${BLT_HELP_FILES_11} ${BLT_HELP_FILES_13} + +# This list is prodiced by the detaillist rule when no WARNINGS are detected. +# +DETAIL_HELP= abs access acos acosh acot acoth acsc acsch address agd append \ + appr arg arrow asec asech asin asinh assign atan atan2 atanh avg base \ + bit blk blkcpy blkfree blocks bround btrunc ceil cfappr cfsim char \ + cmdbuf cmp comb conj cos cosh cot coth count cp csc csch ctime delete \ + den dereference det digit digits dp epsilon errcount errmax errno \ error eval exp fact factor fclose fcnt feof ferror fflush fgetc \ fgetfield fgetline fgets fgetstr fib files floor fopen forall fprintf \ - fputc fputs fputstr frac frem freopen fscan fscanf fseek fsize ftell \ - gcd gcdrem getenv hash head highbit hmean hypot ilog ilog10 ilog2 im \ - insert int inverse iroot isassoc isatty isconfig iserror iseven \ - isfile ishash isident isint islist ismat ismult isnull isnum isobj \ - isodd isprime isqrt isrand israndom isreal isrel isset issimple issq \ - isstr istype jacobi join lcm lcmfact lfactor list ln lowbit ltol \ - makelist matdim matfill matmax matmin matsum mattrans max meq min \ - minv mmin mne mod modify near newerror nextcand nextprime norm null \ - num ord param perm pfact pi pix places pmod polar poly pop power \ - prevcand prevprime printf prompt ptest push putenv quo quomod rand \ - randbit randperm rcin rcmul rcout rcpow rcsq re rm remove reverse \ - rewind root round rsearch runtime scale scan scanf search sec sech \ - segment select sgn sin sinh size sizeof sort sqrt srand ssq str \ - strcat strerror strlen strpos strprintf strscan strscanf substr swap \ - system tail tan tanh time trunc xor + fputc fputs fputstr frac free freeglobals freeredc freestatics frem \ + freopen fscan fscanf fseek fsize ftell gcd gcdrem gd getenv hash head \ + highbit hmean hnrmod hypot ilog ilog10 ilog2 im insert int inverse \ + iroot isassoc isatty isblk isconfig isdefined iserror iseven isfile \ + ishash isident isint islist ismat ismult isnull isnum isobj isobjtype \ + isodd isprime isptr isqrt isrand israndom isreal isrel issimple issq \ + isstr istype jacobi join lcm lcmfact lfactor ln lowbit ltol makelist \ + matdim matfill matmax matmin matsum mattrace mattrans max md5 memsize \ + meq min minv mmin mne mod modify name near newerror nextcand \ + nextprime norm null num oldvalue ord param perm pfact pi pix places \ + pmod polar poly pop popcnt power prevcand prevprime printf prompt \ + protect ptest push putenv quo quomod rand randbit random randombit \ + randperm rcin rcmul rcout rcpow rcsq re remove reverse rewind rm root \ + round rsearch runtime saveval scale scan scanf search sec sech \ + segment select sgn sha sha1 sin sinh size sizeof sort sqrt srand \ + srandom ssq str strcat strerror strlen strpos strprintf strscan \ + strscanf substr sum swap system tail tan tanh test time trunc xor -# Help files that are constructed from other sources +# This list is of files that are clones of DETAIL_HELP files. They are +# built from DETAIL_HELP files. # -# The obj.file is special and is not listed here. -# -BUILT_HELP_FILES= bindings altbind changes libcalc stdlib bugs errorcodes +DETAIL_CLONE= copy # Singular files # @@ -94,12 +143,12 @@ SINGULAR_FILES= binding bug change errorcode type # These files are found (but not built) in the distribution # -DISTLIST= ${STD_HELP_FILES} ${DETAIL_HELP} ${SYMBOL_HELP} ${MAKE_FILE} \ +DISTLIST= ${STD_HELP_FILES} ${DETAIL_HELP} ${MAKE_FILE} \ obj.file builtin.top builtin.end funclist.sed \ errorcodes.hdr errorcodes.sed -all: ${STD_HELP_FILES} obj.file ${BUILT_HELP_FILES} full \ - ${DETAIL_HELP} ${SINGULAR_FILES} builtin .all +all: ${FULL_HELP_FILES} full ${DETAIL_HELP} ${DETAIL_CLONE} \ + ${SINGULAR_FILES} calc .all # used by the upper level Makefile to determine of we have done all # @@ -111,9 +160,9 @@ all: ${STD_HELP_FILES} obj.file ${BUILT_HELP_FILES} full \ touch .all bindings: ../lib/bindings - rm -f bindings - cp ../lib/bindings bindings - chmod 0444 bindings + rm -f $@ + cp ../lib/bindings $@ + chmod 0444 $@ -@if [ -z "${Q}" ]; then \ echo ''; \ echo '=-=-= skipping the cat of help/$@ =-=-='; \ @@ -123,9 +172,9 @@ bindings: ../lib/bindings fi altbind: ../lib/altbind - rm -f altbind - cp ../lib/altbind altbind - chmod 0444 altbind + rm -f $@ + cp ../lib/altbind $@ + chmod 0444 $@ -@if [ -z "${Q}" ]; then \ echo ''; \ echo '=-=-= skipping the cat of help/$@ =-=-='; \ @@ -135,9 +184,9 @@ altbind: ../lib/altbind fi stdlib: ../lib/README - rm -f stdlib - cp ../lib/README stdlib - chmod 0444 stdlib + rm -f $@ + cp ../lib/README $@ + chmod 0444 $@ -@if [ -z "${Q}" ]; then \ echo ''; \ echo '=-=-= skipping the cat of help/$@ =-=-='; \ @@ -147,9 +196,9 @@ stdlib: ../lib/README fi changes: ../CHANGES - rm -f changes - cp ../CHANGES changes - chmod 0444 changes + rm -f $@ + cp ../CHANGES $@ + chmod 0444 $@ -@if [ -z "${Q}" ]; then \ echo ''; \ echo '=-=-= skipping the cat of help/$@ =-=-='; \ @@ -159,9 +208,9 @@ changes: ../CHANGES fi libcalc: ../LIBRARY - rm -f libcalc - ${SED} -e 's:$${LIBDIR}:${LIBDIR}:g' < ../LIBRARY > libcalc - chmod 0444 libcalc + rm -f $@ + ${SED} -e 's:$${LIBDIR}:${LIBDIR}:g' < ../LIBRARY > $@ + chmod 0444 $@ -@if [ -z "${Q}" ]; then \ echo ''; \ echo '=-=-= skipping the cat of help/$@ =-=-='; \ @@ -171,9 +220,9 @@ libcalc: ../LIBRARY fi bugs: ../BUGS - rm -f bugs - cp ../BUGS bugs - chmod 0444 bugs + rm -f $@ + cp ../BUGS $@ + chmod 0444 $@ -@if [ -z "${Q}" ]; then \ echo ''; \ echo '=-=-= skipping the cat of help/$@ =-=-='; \ @@ -183,10 +232,10 @@ bugs: ../BUGS fi errorcodes: ../calcerr.h errorcodes.hdr errorcodes.sed - rm -f errorcodes - ${CAT} errorcodes.hdr > errorcodes - ${SED} -n -f errorcodes.sed < ../calcerr.h >> errorcodes - chmod 0444 errorcodes + rm -f $@ + ${CAT} errorcodes.hdr > $@ + ${SED} -n -f errorcodes.sed < ../calcerr.h >> $@ + chmod 0444 $@ -@if [ -z "${Q}" ]; then \ echo ''; \ echo '=-=-= skipping the cat of help/$@ =-=-='; \ @@ -195,11 +244,58 @@ errorcodes: ../calcerr.h errorcodes.hdr errorcodes.sed true; \ fi -full: ${STD_HELP_FILES} ${BUILT_HELP_FILES} ${MAKE_FILE} +calc: usage + rm -f $@ + cp usage $@ + chmod 0444 $@ + -@if [ -z "${Q}" ]; then \ + echo ''; \ + echo '=-=-= skipping the cat of help/$@ =-=-='; \ + echo ''; \ + else \ + true; \ + fi + +custom_cal: ../custom/CUSTOM_CAL + rm -f $@ + cp usage $@ + chmod 0444 $@ + -@if [ -z "${Q}" ]; then \ + echo ''; \ + echo '=-=-= skipping the cat of help/$@ =-=-='; \ + echo ''; \ + else \ + true; \ + fi + +new_custom: ../custom/HOW_TO_ADD + rm -f $@ + cp usage $@ + chmod 0444 $@ + -@if [ -z "${Q}" ]; then \ + echo ''; \ + echo '=-=-= skipping the cat of help/$@ =-=-='; \ + echo ''; \ + else \ + true; \ + fi + +copy: blkcpy + rm -f $@ + cp usage $@ + chmod 0444 $@ + -@if [ -z "${Q}" ]; then \ + echo ''; \ + echo '=-=-= skipping the cat of help/$@ =-=-='; \ + echo ''; \ + else \ + true; \ + fi + +full: ${FULL_HELP_FILES} ${MAKE_FILE} ${Q}echo "forming full" - -${Q}rm -f full - -${Q}for i in ${STD_HELP_FILES1} obj.file ${STD_HELP_FILES2} \ - ${BUILT_HELP_FILES} ${STD_HELP_FILES3}; do \ + -${Q}rm -f $@ + -${Q}for i in ${FULL_HELP_FILES}; do \ if [ Xintro != X"$$i" ]; then \ echo " "; \ else \ @@ -215,7 +311,7 @@ full: ${STD_HELP_FILES} ${BUILT_HELP_FILES} ${MAKE_FILE} echo "*************"; \ echo ""; \ cat $$i; \ - done > full + done > $@ ${Q}echo "full formed" -@if [ -z "${Q}" ]; then \ echo ''; \ @@ -302,8 +398,8 @@ distlist: ${DISTLIST} # The bsdi distribution has generated files as well as distributed files. # -bsdilist: ${DISTLIST} ${BUILT_HELP_FILES} - ${Q}for i in ${DISTLIST} ${BUILT_HELP_FILES}; do \ +bsdilist: ${DISTLIST} ${BLT_HELP_FILES} + ${Q}for i in ${DISTLIST} ${BLT_HELP_FILES}; do \ echo calc/help/$$i; \ done | ${SORT} @@ -333,8 +429,9 @@ clean: rm -f obj mkbuiltin funclist.c funclist.o funclist clobber: - rm -f ${BUILT_HELP_FILES} full builtin .all - rm -f obj mkbuiltin funclist.c funclist.o funclist ${SINGULAR_FILES} + rm -f ${BLT_HELP_FILES} full .all calc + rm -f obj mkbuiltin funclist.c funclist.o funclist + rm -f ${SINGULAR_FILES} ${DETAIL_CLONE} install: all -${Q}if [ ! -d ${TOPDIR} ]; then \ @@ -355,8 +452,8 @@ install: all else \ true; \ fi - ${Q}for i in ${STD_HELP_FILES} ${BUILT_HELP_FILES} builtin \ - full ${DETAIL_HELP} ${SINGULAR_FILES} ${SYMBOL_HELP}; do \ + ${Q}for i in ${STD_HELP_FILES} ${BLT_HELP_FILES} builtin \ + full ${DETAIL_HELP} ${SINGULAR_FILES}; do \ echo rm -f ${HELPDIR}/$$i; \ rm -f ${HELPDIR}/$$i; \ echo cp $$i ${HELPDIR}; \ @@ -367,3 +464,5 @@ install: all rm -f ${HELPDIR}/obj cp obj.file ${HELPDIR}/obj chmod 0444 ${HELPDIR}/obj + # remove dead files + -@rm -f rmblk block diff --git a/help/abs b/help/abs index 9ecf198..9b55ba5 100644 --- a/help/abs +++ b/help/abs @@ -15,14 +15,18 @@ TYPES eps ignored if x is real, nonzero real for complex x, defaults to epsilon(). - return real + return non-negative real DESCRIPTION - If x is real, returns x if x is positive or zero, -x if x is negative. + If x is real, returns the absolute value of x, i.e. x if x >= 0, + -x if x < 0. - For complex x, returns the multiple of eps nearest or next to nearest - to the absolute value of x. The result usually has error less in - absolute value than abs(eps), but should not exceed 0.75 * abs(eps). + For complex x with zero real part, returns the absolute value of im(x). + + For other complex x, returns the multiple of eps nearest to the absolute + value of x, or in the case of two equally near nearest values, the + the nearest even multiple of eps. In particular, with eps = 10^-n, + the result will be the absolute value correct to n decimal places. EXAMPLE > print abs(3.4), abs(-3.4) @@ -35,7 +39,7 @@ LIMITS none LIBRARY - none + NUMBER *qqabs(NUMBER *x) SEE ALSO cmp, epsilon, hypot, norm, near, obj diff --git a/help/access b/help/access index 27fa9d5..4f34901 100644 --- a/help/access +++ b/help/access @@ -20,27 +20,30 @@ DESCRIPTION 'w' or bit 1 for writing, 'x' or bit 0 for execution. EXAMPLE + The system error-numbers and messages may differ for different + implementations + > !rm -f junk > access("junk") - Error 10002 XXX This number will probably be changed + System error 2 + > strerror(.) + "No such file or directory" > f = fopen("junk", "w") > access("junk") - > fputs(f, "Now is the time"); - > freopen(f, "r"); + > fputs(f, "Alpha") + > fclose(f) > !chmod u-w junk - > fgets(f) - "Now is the time" > access("junk", "w") - Error 10013 XXX - > freopen(f, "w") - Error 10013 XXX + System error 13 + > strerror(.) + "Permission denied" LIMITS - none - XXX - is this correct? + There may be implementation-dependent limits inherited from the + system call "access" used by this function. LIBRARY - none - XXX - is this correct? + none SEE ALSO - errno, fclose, feof, ferror, fflush, fgetc, fgetline, fgets, files, fopen, - fprintf, fputc, fputs, fseek, fsize, ftell, isfile, printf, prompt + fopen, fclose, isfile, files diff --git a/help/acos b/help/acos index 881061e..79e9316 100644 --- a/help/acos +++ b/help/acos @@ -21,9 +21,7 @@ EXAMPLE 1.0472 1.0471975512 1.047197551196598 1.04719755119659774615 LIMITS - unlike sin and cos, x must be real - abs(x) <= 1 - eps > 0 + none LIBRARY NUMBER *qacos(NUMBER *x, NUMBER *eps) diff --git a/help/acosh b/help/acosh index 10c86c2..e723758 100644 --- a/help/acosh +++ b/help/acosh @@ -11,19 +11,20 @@ TYPES return nonnegative real DESCRIPTION - Returns the cosh of x to a multiple of eps with error less in + Returns the acosh of x to a multiple of eps with error less in absolute value than .75 * eps. - acosh(x) = ln(x + sqrt(x^2 - 1)) is the nonnegative real number v - for which cosh(v) = x. + acosh(x) is the nonnegative real number v for which cosh(v) = x. + It is given by + + acosh(x) = ln(x + sqrt(x^2 - 1)) EXAMPLE > print acosh(2, 1e-5), acosh(2, 1e-10), acosh(2, 1e-15), acosh(2, 1e-20) 1.31696 1.3169578969 1.316957896924817 1.31695789692481670862 LIMITS - unlike sin and cos, x must be real - eps > 0 + none LIBRARY NUMBER *qacosh(NUMBER *x, NUMBER *eps) diff --git a/help/acot b/help/acot index a573636..9c2ff90 100644 --- a/help/acot +++ b/help/acot @@ -21,8 +21,7 @@ EXAMPLE .46365 .463647609 .463647609000806 .46364760900080611621 LIMITS - unlike sin and cos, x must be real - eps > 0 + none LIBRARY NUMBER *qacot(NUMBER *x, NUMBER *eps) diff --git a/help/acoth b/help/acoth index 2fe77f1..5b2d39c 100644 --- a/help/acoth +++ b/help/acoth @@ -14,17 +14,16 @@ DESCRIPTION Returns the acoth of x to a multiple of eps with error less in absolute value than .75 * eps. - acoth(x) = ln((x + 1)/(x - 1))/2 is the real number v for which - coth(v) = x. + acoth(x) is the real number v for which coth(v) = x. + It is given by + acoth(x) = ln((x + 1)/(x - 1))/2 EXAMPLE > print acoth(2, 1e-5), acoth(2, 1e-10), acoth(2, 1e-15), acoth(2, 1e-20) .54931 .5493061443 .549306144334055 .5493061443340548457 LIMITS - unlike sin and cos, x must be real - abs(x) > 1 - eps > 0 + none LIBRARY NUMBER *qacoth(NUMBER *x, NUMBER *eps) diff --git a/help/acsc b/help/acsc index 7183166..cd1d3e0 100644 --- a/help/acsc +++ b/help/acsc @@ -21,9 +21,7 @@ EXAMPLE .5236 .5235987756 .523598775598299 .52359877559829887308 LIMITS - unlike sin and cos, x must be real - abs(x) >= 1 - eps > 0 + none LIBRARY NUMBER *qacsc(NUMBER *x, NUMBER *eps) diff --git a/help/acsch b/help/acsch index f6b127f..b81e1f9 100644 --- a/help/acsch +++ b/help/acsch @@ -14,17 +14,17 @@ DESCRIPTION Returns the acsch of x to a multiple of eps with error less in absolute value than .75 * eps. - acsch(x) = ln((1 + sqrt(1 + x^2))/x) is the real number v for - which csch(v) = x. + acsch(x) is the real number v for which csch(v) = x. It is given by + + acsch(x) = ln((1 + sqrt(1 + x^2))/x) + EXAMPLE > print acsch(2, 1e-5), acsch(2, 1e-10), acsch(2, 1e-15), acsch(2, 1e-20) .48121 .4812118251 .481211825059603 .4812118250596034475 LIMITS - unlike sin and cos, x must be real - x != 0 - eps > 0 + none LIBRARY NUMBER *qacsch(NUMBER *x, NUMBER *eps) diff --git a/help/address b/help/address new file mode 100644 index 0000000..7da6b6b --- /dev/null +++ b/help/address @@ -0,0 +1,161 @@ +NAME + & - address operator + +SYNOPSIS + &X + +TYPES + X expression specifying an octet, lvalue, string or number + + return pointer + +DESCRIPTION + &X returns the address at which information for determining the current + value of X is stored. After an assignment as in p = &X, the + value of X is accessible by *p so long as the connection between p + and the value is not broken by relocation of the information or by the + value ceasing to exist. Use of an address after the connection + is broken is unwise since the calculator may use that address for other + purposes; the consequences of attempting to write data to, or + otherwise accessing, such a vacated address may be catastrophic. + + An octet is normally expressed by B[i] where B is a block and + 0 <= i < sizeof(B). &B[i] then returns the address at which this + octet is located until the block is freed or relocated. Freeing + of an unnamed block B occurs when a new value is assigned to B or + when B ceases to exist; a named block B is freed by blkfree(B(). + A block is relocated when an operation like copying to B requires + a change of sizeof(B). + + An lvalue may be expressed by an identifier for a variable, or by + such an identifier followed by one or more qualifiers compatible with + the type of values associated with the variable and earlier qualifiers. + If an identifier A specifies a global or static variable, the address + &A is permanently associated with that variable. For a local variable + or function parameter A, the association of the variable with &A + is limited to each occasion when the function is called. If X specifies a + component or element of a matrix or object, connection of + &X with that component or element depends only on the continued existence + of the matrix or object. For example, after + + > mat A[3] + + the addresses &A[0], &A[1], &A[2] locate the three elements + of the matrix specified by A until another value is assigned to A, etc. + Note one difference from C in that &A[0] is not the same as A. + + An element of a list has a fixed address while the list exists and + the element is not removed by pop(), remove(), or delete(); the index + of the element changes if an element is pushed onto the list, or if + earlier elements are popped or deleted. + + Elements of an association have fixed addresses so long as the association + exists. If A[a,b,...] has not been defined for the association A, + &A[a,b,...] returns the constant address of a particular null value. + + Some other special values have fixed addresses; e.g. the old value (.). + + Some arithmetic operations are defined for addresses but these should + be used only for octets or components of a matrix or object where the + results refer to octets in the same block or existing components of the + same matrix or object. For example, immediately after + + > mat A[10] + > p = &A[5] + + it is permitted to use expressions like p + 4, p - 5, p++ . + + Strings defined literally have fixed addresses, e.g., after + + > p = &"abc" + > A = "abc" + + The address &*A of the value of A will be equal to p. + + Except in cases like strcat(A, "") when *A identified with a literal + string as above, definitions of string values using strcat() or substr() + will copy the relevant strings to newly allocated addresses which will + be useable only while the variables retain these defined values. + For example, + + > B = C = strcat("a", "bc"); + + &*B and &*C will be different. If p is defined by p = &*B, p should + not be used after a mew value is assigned to B, or B ceases to exist, + etc. + + When compilation of a function encounters for the first time a particular + literal number or the result of simple arithmetic operations (like +, -, *, + or /) on literal numbers, that number is assigned to a particular + address which is then used for later similar occurrences of that number + so long as the number remains associated with at least one function or + lvalue. For example, after + + > x = 27; + > y = 3 * 9; + > define f(a) = 27 + a; + + the three occurrences of 27 have the same address which may be displayed + by any of &27, &*x, &*y and &f(0). If x and y are assigned + other values and f is redefined or undefined and the 27 has not been + stored elsewhere (e.g. as the "old value" or in another function + definition or as an element in an association), the address assigned at + the first occurrence of 27 will be freed and calc may later use it for + another number. + + When a function returns a number value, that number value is usually + placed at a newly allocated address, even if an equal number is stored + elsewhere. For example calls to f(a), as defined above, with the same + non-zero value for a will be assigned to different addresses as can be + seen from printing &*A, &*B, &*C after + + > A = f(2); B = f(2); C = f(2); + + (the case of f(0) is exceptional since 27 + 0 simply copies the 27 + rather than creating a new number value). Here it is clearly more + efficient to use + + > A = B = C = f(2); + + which, not only performs the addition n f() only once, but stores the + number values for A, B and C at the same address. + + Whether a value V is a pointer and if so, its type, is indicated by the + value returned by isptr(V): 1, 2, 3, 4 for octet-, value-, string- + and number-pointer respectively, and 0 otherwise. + + The output when addresses are printed consists of a description (o_ptr, + v_ptr, s_ptr, n_ptr) followed by : and the address printed in + %p format. + + Iteration of & is not permitted; &&X causes a "non-variable operand" + scan error. + +EXAMPLE + Addresses for particular systems may differ from those displayed here. + + > mat A[3] + > B = blk() + + > print &A, &A[0], &A[1] + v-ptr: 1400470d0 v-ptr: 140044b70 v-ptr: 140044b80 + + > print &B, &B[0], &B[1] + v-ptr: 140047130 o-ptr: 140044d00 o-ptr: 140044d01 + + > a = A[0] = 27 + > print &*a, &*A[0]. &27 + n_ptr: 14003a850 n_ptr: 14003a850 n_ptr: 14003a850 + + > a = A[0] = "abc" + > print &*a, &*A[0], &"abc" + s_ptr: 14004cae0 s_ptr: 14004cae0 s_ptr: 14004cae0 + +LIMITS + none + +LIBRARY + none + +SEE ALSO + dereference, isptr diff --git a/help/agd b/help/agd new file mode 100644 index 0000000..dd74620 --- /dev/null +++ b/help/agd @@ -0,0 +1,57 @@ +NAME + agd - inverse gudermannian function + +SYNOPSIS + agd(z [,eps]) + +TYPES + z number (real or complex) + eps nonzero real, defaults to epsilon() + + return number or infinite error value + +DESCRIPTION + Calculate the inverse gudermannian of z to a nultiple of eps with + errors in real and imaginary parts less in absolute value than .75 * eps, + or an error value if z is very close to one of the one of the branch + points of agd(z).. + + agd(z) is usually defined initially for real z with abs(z) < pi/2 by + one of the formulae + + agd(z) = ln(sec(z) + tan(z)) + + = 2 * atanh(tan(z/2)) + + = asinh(tan(z)), + + or as the integral from 0 to z of (1/cos(t))dt. For complex z, the + principal branch, approximated by gd(z, eps), has cuts along the real + axis outside -pi/2 < z < pi/2. + + If z = x + i * y and abs(x) < pi/2, agd(z) is given by + + agd(z) = atanh(sin(x)/cosh(y)) + i * atan(sinh(y)/cos(x)> + + +EXAMPLE + > print agd(1, 1e-5), agd(1, 1e-10), agd(1, 1e-15) + 1.22619 1.2261911709 1.226191170883517 + + > print agd(2, 1e-5), agd(2, 1e-10) + 1.52345-3.14159i 1.5234524436-3.1415926536i + + > print agd(5, 1e-5), agd(5, 1e-10), agd(5, 1e-15) + -1.93237 -1.9323667197 -1.932366719745925 + + > print agd(1+2i, 1e-5), agd(1+2i, 1e-10) + .22751+1.42291i .2275106584+1.4229114625i + +LIMITS + none + +LIBRARY + COMPLEX *cagd(COMPLEX *x, NUMBER *eps) + +SEE ALSO + gd, exp, ln, sin, sinh, etc. diff --git a/help/appr b/help/appr index 0475277..6116096 100644 --- a/help/appr +++ b/help/appr @@ -22,7 +22,7 @@ DESCRIPTION there is no "approximation" - the result represents x exactly. In the following it is assumed y is nonzero and x is not a multiple of y. - For Real x: + For real x: appr(x,y,z) is either the nearest multiple of y greater than x or the nearest multiple of y less than x. Thus, if @@ -45,9 +45,9 @@ DESCRIPTION z = 3 round away from zero, sgn(r) = -sgn(x) - z = 4 round down + z = 4 round down, r > 0 - z = 5 round up + z = 5 round up, r < 0 z = 6 round towards or from zero according as y is positive or negative, sgn(r) = sgn(x/y) @@ -82,7 +82,9 @@ DESCRIPTION appr(x,y,z) returns the matrix or list indexed in the same way as x, in which each element t has been replaced by appr(t,y,z). - XXX - complex x needs to be documented + Complex x: + + Returns appr(re(x), y, z) + appr(im(x), y, z) * 1i PROPERTIES If appr(x,y,z) != x, then abs(x - appr(x,y,z)) < abs(y). @@ -134,6 +136,10 @@ EXAMPLES > print appr(-.44,-.1,15),appr(.44,-.1,15),appr(5.7,-1,15),appr(-5.7,-1,15) -.4 .5 5 -6 + > x = sqrt(7-3i, 1e-20) + > print appr(x,1e-5,0), appr(x,1e-5,1), appr(x,1e-5,2), appr(x,1e-6,3) + 2.70331-.55488i 2.70332-.55487i 2.70331-.55487i 2.70332-.55488i + LIMITS none diff --git a/help/archive b/help/archive index 2547034..b8c85ce 100644 --- a/help/archive +++ b/help/archive @@ -22,4 +22,10 @@ Where to get the the latest versions of calc where "address" is your EMail address and "your_full_name" is your full name. - Landon Curt Noll /\oo/\ + See: + + http://prime.corp.sgi.com/csp/ioccc/noll/noll.html#calc + + for details. + +Landon Curt Noll /\oo/\ diff --git a/help/arg b/help/arg index f41f7dc..6de8fcc 100644 --- a/help/arg +++ b/help/arg @@ -13,7 +13,7 @@ TYPES DESCRIPTION Returns the argument of x to the nearest or next to nearest multiple of eps; the error will be less in absolute value than 0.75 * abs(eps), - but usually less than 0.5 * abs(eps). By default, acc is epsilon(). + but usually less than 0.5 * abs(eps). EXAMPLE > print arg(2), arg(2+3i, 1e-5), arg(2+3i, 1e-10), arg(2+3i, 1e-20) diff --git a/help/arrow b/help/arrow new file mode 100644 index 0000000..319e43d --- /dev/null +++ b/help/arrow @@ -0,0 +1,51 @@ +SYMBOL and NAME + -> - arrow operator + +SYNOPSIS + p -> X + +TYPES + p pointer to an lvalue + X identifier + + return lvalue + +DESCRIPTION + p->X returns the same as (*p).X. Thus the current value of *p is + to be an object of a type for which X identifies one element. + p->X then returns the lvalue corresponding to that element of of the + value of *p. + + The expression *p.X will cause a runtime error since this is + interpreted as *(p.X) in which p is expected to be an object of + an appropriate type. + + Spaces or tabs on either side of -> are optional. + +EXAMPLES + > obj pair {one, two} + > obj pair A, B + > p = &A + > p->one = 1; p->two = 2 + > A + obj pair {1, 2} + + > A->two = &B + > p->two->one = 3; p->two->two = 4 + + > *p->ptwo + obj pair {3, 4} + + > B = {5,6} + > *p->two + obj pair {5, 6} + + +LIMITS + none + +LIBRARY + none + +SEE ALSO + address, dereference, isptr, dot diff --git a/help/asec b/help/asec index ee17874..570ead8 100644 --- a/help/asec +++ b/help/asec @@ -21,9 +21,7 @@ EXAMPLE 1.0472 1.0471975512 1.047197551196598 1.04719755119659774615 LIMITS - unlike sin and cos, x must be real - abs(x) >= 1 - eps > 0 + none LIBRARY NUMBER *qasec(NUMBER *x, NUMBER *eps) diff --git a/help/asech b/help/asech index e2c390a..186ad5d 100644 --- a/help/asech +++ b/help/asech @@ -14,17 +14,16 @@ DESCRIPTION Returns the asech of x to a multiple of eps with error less in absolute value than .75 * eps. - asech(x) = ln((1 + sqrt(1 - x^2))/x) is the real number v for which - sech(v) = x. + asech(x) is the real number v for which sech(v) = x. It is given by + + asech(x) = ln((1 + sqrt(1 - x^2))/x) EXAMPLE > print asech(.5,1e-5), asech(.5,1e-10), asech(.5,1e-15), asech(.5,1e-20) 1.31696 1.3169578969 1.316957896924817 1.31695789692481670862 LIMITS - unlike sin and cos, x must be real - 0 < x <= 1 - eps > 0 + none LIBRARY NUMBER *qasech(NUMBER *x, NUMBER *eps) diff --git a/help/asin b/help/asin index 1aa766d..28976bc 100644 --- a/help/asin +++ b/help/asin @@ -21,9 +21,7 @@ EXAMPLE .5236 .5235987756 .523598775598299 .52359877559829887308 LIMITS - unlike sin and cos, x must be real - abs(x) <= 1 - eps > 0 + none LIBRARY NUMBER *qasin(NUMBER *q, NUMBER *epsilon) diff --git a/help/asinh b/help/asinh index 9e38b81..48351b1 100644 --- a/help/asinh +++ b/help/asinh @@ -14,16 +14,16 @@ DESCRIPTION Returns the asinh of x to a multiple of eps with error less in absolute value than .75 * eps. - asinh(x) = ln(x + sqrt(1 + x^2)) is the real number v for which - sinh(v) = x. + asinh(x) is the real number v for which sinh(v) = x. It is given by + + asinh(x) = ln(x + sqrt(1 + x^2)) EXAMPLE > print asinh(2, 1e-5), asinh(2, 1e-10), asinh(2, 1e-15), asinh(2, 1e-20) 1.44363 1.4436354752 1.44363547517881 1.44363547517881034249 LIMITS - unlike sin and cos, x must be real - eps > 0 + none LIBRARY NUMBER *qasinh(NUMBER *x, NUMBER *eps) diff --git a/help/assign b/help/assign index 8c12f10..7e8a236 100644 --- a/help/assign +++ b/help/assign @@ -3,22 +3,111 @@ NAME SYNOPSIS a = b + a = {e_1, e_2, ...[ { ... } ] } TYPES - a lvalue - b expression + a lvalue, current value a structure in { } case - return lvalue + b expression + + e_0, e_1, ... expressions, blanks, or initializer lists + + + return lvalue (a) DESCRIPTION + Here an lvalue is either a simple variable specified by an identifier, + or an element of an existing structure specified by one or more + qualifiers following an identifier. + + An initializer list is a comma-separated list enclosed in braces as in + + {e_0, e_1, ... } + + where each e_i is an expression, blank or initializer list. + a = b evaluates b, assigns its value to a, and returns a. + a = {e_0, e_1, ... } where the e_i are expressions or blanks, + requires the current value of a to be a matrix, list + or object with at least as many elements as listed e_i. Each non-blank + e_i is evaluated and its value is assigned to a[[i]]; elements a[[i]] + corresponding to blank e_i are unchanged. + + If, in a = {e_0, e_1, ...}, e_i is an initializer list, as in + {e_i_0, e_1_1, ...}, the corresponding a[[i]] is to be a matrix, list + or object with at least as many elements as listed e_i_j. Depending on + whether e_i_j is an expression, blank, or initializer list, one, no, or + possibly more than one assignment, is made to a[[i]][[j]] or, if + relevant and possible, its elements. + + In simple assignments, = associates from right to left so that, for + example, + + a = b = c + + has the effect of a = (b = c) and results in assigning the value of c + to both a and b. The expression (a = b) = c is acceptable, but has the + effect of a = b; a = c; in which the first assignment is superseded by + the second. + + In initializations, = { ...} associates from left to right so that, + for example, + + a = {e_0, ... } = {v_0, ...} + + first assigns e_0, ... to the elements of a, and then assigns v_0, ... + to the result. + + If there are side effects in the evaluations involved in executing a = b, + it should be noted that the order of evaluations is: first the address + for a, then the value of b, and finally the assignment. For example if + A is a matrix and i = 0, then the assignment in A[i++] = A[i] is + that of A[0] = A[1]. + + If, in execution of a = b, a is changed by the evaluation of b, the + value of b may be stored in an unintended or inaccessible location. For + example, + mat A[2]= {1,2}; + A[0] = (A = 3); + + results in the value 3 being stored not only as the new value for A + but also at the now unnamed location earlier used for A[0]. + + EXAMPLE > b = 3+1 > a = b > print a, b 4 4 + > obj point {x,y} + > mat A[3] = {1, list(2,3), obj point = {4,5}} + + > A[1][[0]] = 6; A[2].x = 7 + > print A[1] + + list (2 elements, 2 nonzero): + [[0]] = 6 + [[1]] = 3 + + > print A[2] + obj point {7, 5} + + > A = {A[2], , {9,10}} + > print A[0] + obj point {7, 5} + + > print A[2] + obj point {9, 10} + + > A = {, {2}} + print A[1] + + list (2 elements, 2 nonzero): + [[0]] = 2 + [[1]] = 3 + LIMITS none @@ -26,4 +115,4 @@ LIBRARY none SEE ALSO - XXX - fill in + swap, quomod diff --git a/help/assoc b/help/assoc index 4d8ca18..8066859 100644 --- a/help/assoc +++ b/help/assoc @@ -8,38 +8,34 @@ TYPES return association DESCRIPTION - This functions returns an empty association array. + This function returns an empty association array. - Associations are special values that act like matrices, except - that they are more general (and slower) than normal matrices. - Unlike matrices, associations can be indexed by arbitrary values. - For example, if 'val' was an association, you could do the following: + After A = assoc(), elements can be added to the association by + assignments of the forms - val['hello'] = 11; - val[4.5] = val['hello']; - print val[9/2]; + A[a_1] = v_1 + A[a_1, a_2] = v_2 + A[a_1, a_2, a_3] = v_3 + A[a_1, a_2, a_3, a_4] = v_4 - and 11 would be printed. + There are no restrictions on the values of the "indices" a_i or + the "values" v_i. - Associations are created by the 'assoc' function. It takes no - arguments, and simply returns an empty association. You can then - insert elements into the association by indexing the returned value - as shown above. + After the above assignments, so long as no new values have been + assigned to A[a_i], etc., the expressions A[a_1], A[a_1, a_2], etc. + will return the values v_1, v_2, ... - Associations are multi-dimensional. You can index them using one to - four dimensions as desired, and the elements with different numbers - of dimensions will remain separated. For example, 'val[3]' and - 'val[3,0]' can both be used in the same association and will be - distinct elements. + Until A[a_1], A[a_1, a_2], ... are defined as described above, these + expressions return the null value. - When references are made to undefined elements of an association, - a null value is simply returned. Therefore no bounds errors can - occur when indexing an association. Assignments of a null value + Thus associations act like matrices except that different elements + may have different numbers (between 1 and 4 inclusive) of indices, + and these indices need not be integers in specified ranges. + + Assignments of a null value to an element of an association does not delete the element, but a later reference to that element will return the null value as if - the element was undefined. Elements with null values are implicitly - created on certain other operations which require an address to be - taken, such as the += operator and using & in a function call. + the element is undefined. The elements of an association are stored in a hash table for quick access. The index values are hashed to select the correct @@ -65,9 +61,18 @@ DESCRIPTION and are illegal. EXAMPLE - > print assoc() + > A = assoc(); print A + assoc (0 elements): - assoc (0 elements): + > A["zero"] = 0; A["one"] = 1; A["two"] = 2; A["three"] = 3; + > A["smallest", "prime"] = 2; + > print A + assoc (5 elements); + ["two"] = 2 + ["three"] = 3 + ["one"] = 1 + ["zero"] = 0 + ["smallest","prime"] = 2 LIMITS none diff --git a/help/atan b/help/atan index f35f18c..de9e50d 100644 --- a/help/atan +++ b/help/atan @@ -21,8 +21,7 @@ EXAMPLE 1.10715 1.1071487178 1.107148717794091 1.10714871779409050302 LIMITS - unlike sin and cos, x must be real - eps > 0 + none LIBRARY NUMBER *qatan(NUMBER *x, NUMBER *eps) diff --git a/help/atan2 b/help/atan2 index c495927..2ce6cea 100644 --- a/help/atan2 +++ b/help/atan2 @@ -2,32 +2,33 @@ NAME atan2 - angle to point SYNOPSIS - atan2(y, x, [,acc]) + atan2(y, x, [,eps]) TYPES y real x real - acc real + eps nonzero real, defaults to epsilon() return real DESCRIPTION - Return the angle which is determined by the point (x,y). This - function computes the arctangent of y/x in the range [-pi, pi]. - The value acc specifies the accuracy of the result. By default, acc - is epsilon(). + If x and y are not both zero, atan2(y, x, eps) returns, as a multiple of + eps with error less than abs(eps), the angle t such that + -pi < t <= pi and x = r * cos(t), y = r * sin(t), where + r > 0. Usually the error does not exceed abs(eps)/2. - Note that by convention, y is the first argument. + Note that by convention, y is the first argument; if x > 0, + atan2(y, x) = atan(y/x). - To conform to the 4.3BSD ANSI/IEEE 754-1985 math lib, atan2(0,0) is - defined to return 0. + To conform to the 4.3BSD ANSI/IEEE 754-1985 math lib, atan2(0,0) + returns 0. EXAMPLE > print atan2(0,0), atan2(1,sqrt(3)), atan2(17,53,1e-100) 0 ~.52359877559829887307 ~.31038740713235146535 LIMITS - acc > 0 + none LIBRARY NUMBER *qatan2(NUMBER *y, *x, *acc) diff --git a/help/atanh b/help/atanh index ae26622..f1dbb3e 100644 --- a/help/atanh +++ b/help/atanh @@ -14,16 +14,16 @@ DESCRIPTION Returns the atanh of x to a multiple of eps with error less in absolute value than .75 * eps. - atanh(x) = ln((1 + x)/(1 - x))/2 is the real number v for whichi - tanh(v) = x. + atanh(x) is the real number v for which tanh(v) = x. It is given by + + atanh(x) = ln((1 + x)/(1 - x))/2 EXAMPLE > print atanh(.5,1e-5), atanh(.5,1e-10), atanh(.5,1e-15), atanh(.5,1e-20) .54931 .5493061443 .549306144334055 .5493061443340548457 LIMITS - unlike sin and cos, x must be real - eps > 0 + none LIBRARY NUMBER *qatanh(NUMBER *x, NUMBER *eps) diff --git a/help/base b/help/base index f6dbbf8..fbefd60 100644 --- a/help/base +++ b/help/base @@ -11,7 +11,7 @@ TYPES DESCRIPTION The base function allows one to specify how numbers should be - printer. The base function provides a numeric shorthand to the + printed. The base function provides a numeric shorthand to the config("mode") interface. With no args, base() will return the current mode. With 1 arg, base(val) will set the mode according to the arg and return the previous mode. diff --git a/help/bit b/help/bit new file mode 100644 index 0000000..f84db40 --- /dev/null +++ b/help/bit @@ -0,0 +1,43 @@ +NAME + bit - whether a given binary bit is set in a value + +SYNOPSIS + bit(x, y) + +TYPES + x real + y int + + return int + +DESCRIPTION + Determine if the binary bit y is set in x. If: + + x + int(---) mod 2 == 1 + 2^y + + return 1, otherwise return 0. + +EXAMPLE + > print bit(9,0), bit(9,1), bit(9,2), bit(9,3) + 1 0 0 1 + + > print bit(9,4), bit(0,0), bit(9,-1) + 0 0 0 + + > print bit(1.25, -2), bit(1.25, -1), bit(1.25, 0) + 1 0 1 + + > p = pi() + > print bit(p, 1), bit(p, -2), bit(p, -3) + 1 0 1 + +LIMITS + -2^31 < y < 2^31 + +LIBRARY + BOOL qbit(NUMBER *x, long y) + +SEE ALSO + highbit, lowbit, digit diff --git a/help/blk b/help/blk new file mode 100644 index 0000000..c19b76b --- /dev/null +++ b/help/blk @@ -0,0 +1,219 @@ +NAME + blk - generate or modify block values + +SYNOPSIS + blk([len, chunk]); + blk(val [, len, chunk]); + +TYPES + len null or integer + chunk null or integer + val non-null string, block, or named block + + return block or named block + +DESCRIPTION + With only integer arguments, blk(len, chunk) attempts to + allocate a block of memory consisting of N octets (unsigned 8-bit + bytes). Allocation is always done in multiples of chunk + octets, so the actual allocation size of len rounded up + to the next multiple of chunk. + + The default value for len is 0. The default value for chunk is 256. + + If the allocation is successful, blk(len, chunk) returns a value B, say, + for which the octets in the block may be referenced by B[0], B[1], + ... , B[len-1], these all initially having zero value. + + The octets B[i] for i >= len always have zero value. If B[i] with + some i >= len is referenced, len is increased by 1. For example: + + B[i] = x + + has an effect like that of two operations on a file stream fs: + + fseek(fs, pos); + fputc(fs, x). + + Similarly: + + x = B[i] + + is like: + + fseek(fs, pos); + x = fgetc(fs). + + The value of chunk is stored as the "chunksize" for B. + + The size(B) builtin returns the current len for the block; sizeof(B) + returns its maxsize; memsize(B) returns maxsize + overhead for any block + value. Also size(B) is analogous to the length of a file stream in that + if size(B) < sizeof(B): + + B[size(B)] = x + + will append one octet to B and increment size(B). + + The builtin test(B) returns 1 or 0 according as at least one octet + is zero or all octets are zero. If B1 and B2 are blocks, they are + considered equal (B1 == B2) if they have the same length and the + same data, i.e. B1[i] == B2[i] for 0 <= i < len. Chunksizes + and maxsizes are ignored. + + The output for print B occupies two lines, the first line giving + the chunksize, number of octets allocated (len rounded up to the + next chunk) and len, and the second line up to 30 octets of data. + If the datalen is zero, the second line is blank. If the datalen + exceeds 30, this indicated by a trailing "...". + + If a block value B created by B = blk(len, chunk) is assigned to + another variable by C = B, a new block of the same structure as B + is created to become the value of C, and the octets in B are copied + to this new block. A block with possibly different length or + chunksize is created by C = blk(B, newlen, newchunk), only the first + min(len, newlen) octets being copied from B; later octets are + assigned zero value. If omitted, newlen and newchunk default to + the current datalen and chunk-size for B. The curent datalen, + chunksize and number of allocated octets for B may be changed by: + + B = blk(B, newlen, newchunk). + + No data is lost if newlen is greater than or equal to the old + size(B). + + The memory block allocated by blk(len, chunk) is freed at or before + termination of the statement in which this occurred, the memory + allocated in B = blk(len, chunk) is freed when B is assigned another + value. + + With a string str as its first argument, blk(str [, len, chunk]) + when called for the first time creates a block with str as its + name. Here there no restriction on the characters used in str; + thus the string may include white space or characters normally used + for punctuation or operators. Any subsequent call to blk(str, ...) + with the same str will refer to the same named block. + + A named block is assigned length and chunksize and consequent + maximum size in the same way as unnamed blocks. A major difference + is that in assignments, a named block is not copied. Thus, if a + block A has been created by: + + A = blk("foo") + any subsequent: + B = A + or: + B = blk("foo") + + will give a second variable B referring to the same block as A. + Either A[i] = x or B[i] = x may then be used to assign a value + to an octet in the book. Its length or chunksize may be changed by + instructions like: + + blk(A, len, chunk); + + A = blk(A, len, chunk); + + null(blk(A, len, chunk)). + + These have the same effect on A; when working interactively, the + last two avoid printing of the new value for A. + + Named blocks are assigned index numbers 0, 1, 2, ..., in the order + of their creation. The block with index id is returned by blocks(id). + With no argument, blocks() returns the number of current unfreed + named blocks. A named block may be used + + The memory allocated to a named block is freed by the blkfree() + function with argument the named block, its name, or its id number. + The block remains in existence but with a null data pointer, + its length and size being reduced to zero. A new block of memory + may be allocated to it, with possibly new length and chunksize by: + + blk(val [, len, chunk]) + + where val is either the named block or its name. + + The printing output for a named block is in three lines, the first + line displaying its id number and name, the other two as for an + unnamed block, except that "NULL" is printed if the memory has been + freed. + + The identifying numbers and names of the current named blocks are + displayed by: + show blocks + + If A and B are named blocks, A == B will be true only if they refer + to the same block of memory. Thus, blocks with the same data and + datalen will be considered unequal if they have different names. + + If A is a named block, str(A) returns the name of the block. + + Values may be assigned to the early octets of a named or unnamed + block by use of = { } initialization as for matrices. + +EXAMPLE + + > B = blk(15,10) + + > B[7] = 0xff + > B + chunksize = 10, maxsize = 20, datalen = 15 + 00000000000000ff00000000000000 + + > B[18] = 127 + > B + chunksize = 10, maxsize = 20, datalen = 18 + 00000000000000ff0000000000000000007f + + > B[20] = 2 + Index out of bounds for block + + > print size(B), sizeof(B) + 18 20 + + > B = blk(B, 100, 20) + > B + chunksize = 20, maxsize = 120, datalen = 100 + 00000000000000ff0000000000000000007f000000000000000000000000... + + > C = blk(B, 10} = {1,2,3} + > C + chunksize = 20, maxsize = 20, datalen = 10 + 01020300000000ff0000 + + > A1 = blk("alpha") + > A1 + block 0: alpha + chunksize = 256, maxsize = 256, datalen = 0 + + > A1[7] = 0xff + > A2 = A1 + > A2[17] = 127 + > A1 + block 0: alpha + chunksize = 256, maxsize = 256, datalen = 18 + 00000000000000ff0000000000000000007f + + > A1 = blk(A1, 1000) + > A1 + block 0: alpha + chunksize = 256, maxsize = 1024, datalen = 1000 + 00000000000000ff0000000000000000007f000000000000000000000000... + + > A1 = blk(A1, , 16) + > A1 + block 0: alpha + chunksize = 16, maxsize = 1008, datalen = 1000 + 00000000000000ff0000000000000000007f000000000000000000000000... + +LIMITS + 0 <= len < 2^31 + + 1 <= chunk < 2^31 + +LIBRARY + XXX + +SEE ALSO + blocks, blkfree diff --git a/help/blkcpy b/help/blkcpy new file mode 100644 index 0000000..d08f134 --- /dev/null +++ b/help/blkcpy @@ -0,0 +1,192 @@ +NAME + blkcpy, copy - copy items from a structure to a structure + +SYNOPSIS + blkcpy(dst, src [, num [, dsi [, ssi]]] + copy(src, dest [, [ssi [, num [, dsi]]]) + +TYPES + src block, file, string, matrix, or list + dest block, file, matrix or list - compatible with src + + ssi nonnegative integer, defaults to zero + num nonnegative integer, defaults to maximum possible + dsi nonnegative integer, defaults to datalen for a block, filepos + for a file, zero for other structures + + return null if successful, error value otherwise + +DESCRIPTION + A call to: + + blkcpy(dst, src, num, dsi, ssi) + + attempts to copy 'num' consecutive items (octets or values) starting + from the source item 'src' with index 'ssi'. By default, 'num' + is the maximum possible and 'ssi' is 0. + + A call to: + + copy(src, dst, ssi, num, dsi) + + does the same thing, but with a different arg order. + + A copy fails if ssi or num is too large for the number of items in + the source, if sdi is too large for the number of positions + available in the destination, or, in cases involving a file stream, + if the file is not open in the required mode. The source and + destination need not be of the same type, e.g. when a block is + copied to a matrix the octets are converted to numbers. + + The following pairs of source-type, destination-type are permitted: + + block to + int + block + matrix + file + + matrix to + block + matrix + list + + string to + block + file + + list to + list + matrix + + file to + block + + int to + block + + In the above table, int refers to integer values. However if a + rational value is supplied, only the numerator is copied. + + Each copied octet or value replaces the octet or value in the + corresponding place in the destination structure. When copying values + to values, the new values are stored in a buffer, the old values are + removed, and the new values copied from the buffer to the destination. + This permits movement of data within one matrix or list, and copying + of an element of structure to the structure. + + Except for copying to files or blocks, the destination is already to have + sufficient memory allocated for the copying. For example, to copy + a matrix M of size 100 to a newly created list, one may use: + + L = makelist(100); + copy(M, L); + or: + L = makelist(100); + blkcpy(L, M); + + For copying from a block B (named or unnamed), the total number of octets + available for copying is taken to the the datalen for that block, + so that num can be at most size(B) - ssi. + + For copying to a block B (named or unnamed), reallocation will be + required if dsi + num > sizeof(B). (This will not be permitted if + protect(B) has bit 4 set.) + + For copying from a file stream fs, num can be at most size(fs) - ssi. + + For copying from a string str, the string is taken to include the + terminating '\0', so the total number of octets available is + strlen(str) + 1 and num can be at most strlen(str) + 1 - ssi. + If num <= strlen(str) - ssi, the '\0' is not copied. + + For copying from or to a matrix M, the total number of values in + M is size(M), so in the source case, num <= size(M) - ssi, and + in the destination case, num <= size(M) - dsi. The indices ssi + and dsi refer to the double-bracket method of indexing, i.e. the + matrix is as if its elements were indexed 0, 1, ..., size(M) - 1. + + +EXAMPLE + > A = blk() = {1,2,3,4} + > B = blk() + > blkcpy(B,A) + > B + chunksize = 256, maxsize = 256, datalen = 4 + 01020304 + > + > blkcpy(B,A) + > B + chunksize = 256, maxsize = 256, datalen = 8 + 0102030401020304 + > blkcpy(B, A, 2, 10) + > B + chunksize = 256, maxsize = 256, datalen = 12 + 010203040102030400000102 + > blkcpy(B,32767) + > B + chunksize = 256, maxsize = 256, datalen = 16 + 010203040102030400000102ff7f0000 + > mat M[2,2] + > blkcpy(M, A) + > M + mat [2,2] (4 elements, 4 nonzero): + [0,0] = 1 + [0,1] = 2 + [1,0] = 3 + [1,1] = 4 + > blkcpy(M, A, 2, 2) + > M + mat [2,2] (4 elements, 4 nonzero): + [0,0] = 1 + [0,1] = 2 + [1,0] = 1 + [1,1] = 2 + + > A = blk() = {1,2,3,4} + > B = blk() + > copy(A,B) + > B + chunksize = 256, maxsize = 256, datalen = 4 + 01020304 + > copy(A,B) + > B + chunksize = 256, maxsize = 256, datalen = 8 + 0102030401020304 + > copy(A,B,1,2) + > B + chunksize = 256, maxsize = 256, datalen = 10 + 01020304010203040203 + > mat M[2,2] + > copy(A,M) + > M + mat [2,2] (4 elements, 4 nonzero): + [0,0] = 1 + [0,1] = 2 + [1,0] = 3 + [1,1] = 4 + + > copy(A,M,2) + > M + mat [2,2] (4 elements, 4 nonzero): + [0,0] = 3 + [0,1] = 4 + [1,0] = 3 + [1,1] = 4 + + > copy(A,M,0,2,2) + > M + mat [2,2] (4 elements, 4 nonzero): + [0,0] = 3 + [0,1] = 4 + [1,0] = 1 + [1,1] = 2 + +LIMITS + none + +LIBRARY + none + +SEE ALSO + blk, mat, file, list, str diff --git a/help/blkfree b/help/blkfree new file mode 100644 index 0000000..c2ece31 --- /dev/null +++ b/help/blkfree @@ -0,0 +1,58 @@ +NAME + blkfree - free memory allocated to named block + +SYNOPSIS + blkfree(val) + +TYPES + val named block, string, or integer + + return null value + +DESCRIPTION + If val is a named block, or the name of a named block, or the + identifying index for a named block, blkfree(val) frees the + memory block allocated to this named block. The block remains + in existence with the same name, identifying index, and chunksize, + but its size and maxsize becomes zero and the pointer for the start + of its data block null. + + A new block of memory may be allocated to a freed block B by + blk(B [, len, chunk]), len defaulting to zero and chunk to the + chunksize when the block was freed. + +EXAMPLE + + > B1 = blk("foo") + > B2 = blk("Second block") + show blocks + id name + ---- ----- + 0 foo + 1 Second block + + > blkfree(B1) + > show blocks + id name + ---- ----- + 1 Second block + + > B1 + block 0: foo + chunksize = 256, maxsize = 0, datalen = 0 + NULL + + > blk(B1); B[7] = 5 + > B1 + block 0: foo + chunksize = 256, maxsize = 256, datalen = 8 + 0000000000000005 + +LIMITS + none + +LIBRARY + none + +SEE ALSO + blk, blocks diff --git a/help/blocks b/help/blocks new file mode 100644 index 0000000..dff2682 --- /dev/null +++ b/help/blocks @@ -0,0 +1,43 @@ +NAME + blocks - return a named file or number of unfreed named blocks + +SYNOPSIS + blocks([id]) + +TYPES + id non-negative integer + + return named block or null value + +DESCRIPTION + With no argument blocks() returns the number of blocks that have + been created but not freed by the blkfree function. + + With argument id less than the number of named blocks that have been + created, blocks(id) returns the named block with identifying index id. + These indices 0, 1, 2, ... are assigned to named blocks in the order + of their creation. + +EXAMPLE + + > A = blk("alpha") + > B = blk("beta") = {1,2,3} + > blocks() + 2 + > blocks(1) + block 1: beta + chunksize = 256, maxsize = 256, datalen = 3 + 010203 + > blocks(2) + Error 10211 + > strerror() + "Non-allocated index number for blocks" + +LIMITS + none + +LIBRARY + none + +SEE ALSO + blk, blkfree diff --git a/help/btrunc b/help/btrunc index 59d746d..7326e81 100644 --- a/help/btrunc +++ b/help/btrunc @@ -2,19 +2,24 @@ NAME btrunc - truncate a value to a number of binary places SYNOPSIS - btrunc(x [,j]) + btrunc(x [,plcs]) TYPES x real - j int + plcs integer, defaults to zero return real DESCRIPTION - Truncate x to j binary places. If j is omitted, 0 places is assumed. - Specifying zero places makes the result identical to int(). + Truncate x to plcs binary places, rounding if necessary towards zero, + i.e. btrunc(x, plcs) is a multiple of 2^-plcs and the remainder + x - btrunc(x, plcs) is either zero or has the same sign as x and + absolute value less than 2^-plcs. Here plcs may be positive, zero or + negative. - Truncation of a non-integer prodcues values nearer to zero. + Except that it is defined only for real x, btrunc(x, plcs) is equivalent + to bround(x, plcs, 2). btrunc(x,0) and btrunc(x) are equivalent to + int(x). EXAMPLE > print btrunc(pi()), btrunc(pi(), 10) @@ -26,8 +31,11 @@ EXAMPLE > print btrunc(-3.3), btrunc(-3.7), btrunc(-3.3, 2), btrunc(-3.7, 2) -3 -3 -3.25 -3.5 + > print btrunc(55.123, -4), btrunc(-55.123, -4) + 48 -48 + LIMITS - 0 <= j < 2^31 + abs(j) < 2^31 LIBRARY NUMBER *qbtrunc(NUMBER *x, *j) diff --git a/help/builtin.end b/help/builtin.end index e791056..a3db868 100644 --- a/help/builtin.end +++ b/help/builtin.end @@ -35,10 +35,10 @@ the user. For example, x=eval(prompt("Number: ")) sets x to the value input by the user. - The digit and isset functions return individual digits of a number, + The digit and bit functions return individual digits of a number, either in base 10 or in base 2, where the lowest digit of a number is at digit position 0. For example, digit(5678, 3) is 5, and - isset(0b1000100, 2) is 1. Negative digit positions indicate places + bit(0b1000100, 2) is 1. Negative digit positions indicate places to the right of the decimal or binary point, so that for example, digit(3.456, -1) is 4. diff --git a/help/cmdbuf b/help/cmdbuf index 2c5a260..aacdf11 100644 --- a/help/cmdbuf +++ b/help/cmdbuf @@ -13,8 +13,11 @@ DESCRIPTION this function will return an empty string. EXAMPLE - > cmdbuf("") - "" + % calc "print cmdbuf(); a = 3; print a^2;" + print cmdbuf(); a = 3; print a^2; + + 9 + % LIMITS none diff --git a/help/cmp b/help/cmp index 40dcabe..4c9fe4e 100644 --- a/help/cmp +++ b/help/cmp @@ -1,71 +1,95 @@ NAME - cmp - compare two values + cmp - compare two values of certain simple or object types SYNOPSIS cmp(x, y) TYPES - If x is an object of type xx or x is not an object and y is an object - of type xx, the funcion xx_cmp has to have been defined; any + If x is an object of type xx, or x is not an object and y is an object + of type xx, the function xx_rel has to have been defined; any further conditions on x and y, and the type of the returned - value depends on the definition of xx_cmp. + value depends on the definition of xx_rel. For non-object x and y: - x number or string - y same as x + x any + y any - return -1, 0, 1 (real & string) - -1, 0, 1, -1+1i, 1i, 1+1i, -1-1i, -1i or 1-1i (complex) + return if x and y are both real: -1, 0, or 1 + if x and y are both numbers but not both real: + -1, 0, 1, -1+1i, 1i, 1+1i, -1-1i, -1i, or 1-1i + if x and y are both strings: -1, 0, or 1 + all other cases: the null value DESCRIPTION - Compare two values and return a value based on their relationship. - Comparison by type is indicated below. Where more than one test is - indicated, tests are performed in the order listed. If the test is - inconclusive, the next test is performed. If all tests are - inconclusive, the values are considered equivalent. - real (returns -1, 0, or 1) - the greater number is greater + x and y both real: cmp(x, y) = sgn(x - y), i.e. -1, 0, or 1 + according as x < y, x == y, or x > y - complex (returns -1, 0, 1, -1+1i, 1i, 1+1i, -1-1i, -1i or 1-1i) - sgn(re(x) - re(y)) + sgn(im(x) - im(y)) * 1i + x and y both numbers, at least one being complex: + cmp(x,y) = sgn(re(x) - re(y)) + sgn(im(x) - im(y)) * 1i - string (returns -1, 0, or 1) - the string with the greater first different character is greater - the longer string is greater + x and y both strings: successive characters are compared until either + different characters are encountered or at least one string is + completed. If the comparison ends because of different characters, + cmp(x,y) = 1 or -1 according as the greater character is in x or y. + If all characters compared in both strings are equal, then + cmp(x,y) = -1, 0 or 1 according as the length of x is less than, + equal to, or greater than the length of y. (This comparison + is performed via the strcmp() libc function.) - object (depends on xx_cmp) - the greater object as defined by xx_cmp is greater + objects: comparisons of objects are usually intended for some total or + partial ordering and appropriate definitions of cmp(a,b) may + make use of comparison of numerical or string components. + definitions using comparison of numbers or strings are usually + appropriate. For example, after - String comparison is performed via the strcmp() libc function. + obj point {x,y}; - Note that this function is not a substitution for equality. The == - operator always takes epsilon() into account when comparing numeric - values. For example: + if points with real components are to be partially ordered by their + euclidean distance from the origin, an appropriate point_rel + function may be that given by - > cmp(1, 1+epsilon()/2) - -1 - > 1 == 1+epsilon()/2 - 0 + define point_rel(a,b) = sgn(a.x^2 + a.y^2 - b.x^2 - b.y^2); - It should be noted epsilon() is used when comparing complex values. + A total "lexicographic" ordering is that given by: - Properties of cmp(a,b) for real or complex a and b are: + define point_rel(a,b) { + if (a.y != b.y) + return sgn(a.y - b.y); + return (a.x - b.x); + } - cmp(a + c, b + c) = cmp(a,b) + A comparison function that compares points analogously to + cmp(a,b) for real and complex numbers is that given by + + define point_rel(P1, P2) { + return obj point = {sgn(P1.x-P2.x), sgn(P1.y-P2.y)}; + } + + The range of this function is the set of nine points with zero + or unit components. + + + Some properties of cmp(a,b) for real or complex a and b are: + + cmp(a + c, b + c) = cmp(a, b) cmp(a, b) == 0 if and only if a == b - cmp(b, a) = -cmp(a,b) + cmp(b, a) = -cmp(a, b) if c is real or pure imaginary, cmp(c * a, c * b) = c * cmp(a,b) - cmp(a,b) == cmp(b,c) if and only if b is "between" a and c + Then a function that defines "b is between a and c" in an often useful + sense is - The numbers between 2 + 3i and 4 + 5i are those with real part between - 2 and 4, imaginary part between 3 and 5; the numbers between 2 + 3i - and 4 + 3i are those with real part between 2 and 4, imaginary part = 3. + define between(a,b,c) = (cmp(a,b) == cmp(b,c)). + + For example, in this sense, 3 + 4i is between 1 + 5i and 4 + 2i. + + Note that using cmp to compare non-object values of different types, + for example, cmp(2, "2"), returns the null value. EXAMPLE > print cmp(3,4), cmp(4,3), cmp(4,4), cmp("a","b"), cmp("abcd","abc") @@ -84,7 +108,8 @@ LIMITS none LIBRARY - none + FLAG qrel(NUMBER *q1, NUMBER *q2) + FLAG zrel(ZVALUE z1, ZVALUE z2) SEE ALSO - abs, epsilon, sgn + sgn, test, operator diff --git a/help/comb b/help/comb index c94f17d..062e428 100644 --- a/help/comb +++ b/help/comb @@ -5,10 +5,10 @@ SYNOPSIS comb(x, y) TYPES - x int - y int + x integer + y integer - return int + return integer DESCRIPTION Return the combinatorial number C(x,y) which is defined as: @@ -33,7 +33,7 @@ LIMITS x-y < 2^24 LIBRARY - void zcomb(NUMBER x, y, *ret) + void zcomb(ZVALUE x, ZVALUE y, ZVALUE *res) SEE ALSO fact, perm diff --git a/help/config b/help/config index 3c2cda7..cc90334 100644 --- a/help/config +++ b/help/config @@ -33,9 +33,16 @@ Configuration parameters "outround" sets rounding mode for printing of numbers "leadzero" enables/disables printing of 0 as in 0.5 "fullzero" enables/disables padding zeros as in .5000 - "maxerr" maximum number of scan errors before abort + "maxscan" maximum number of scan errors before abort "prompt" default interactive prompt "more" default interactive multi-line input prompt + "blkmaxprint" number of block octets to print, 0 means all + "blkverbose" TRUE=>print all lines, FALSE=>skip duplicates + "blkbase" block output base + "blkfmt" block output format + "lib_debug" calc library script debug level + "calc_debug" internal calc debug level + "user_debug" user defined debug level The "all" config value allows one to save/restore the configuration @@ -90,6 +97,8 @@ Configuration parameters 8: the opcodes for a new functions are displayed when the function is successfully defined. + See also lib_debug, calc_debug and user_debug below for more debug levels. + The "display" parameter specifies the maximum number of digits after the decimal point to be printed in real or exponential mode in normal unformatted printing (print, strprint, fprint) or in @@ -128,7 +137,6 @@ Configuration parameters "oct" octal fractions "bin" binary fractions - The "maxprint" parameter specifies the maximum number of elements to be displayed when a matrix or list is printed. The initial value is 16. @@ -172,7 +180,7 @@ Configuration parameters Config ("tab") controls the printing of a tab before results automatically displayed when working interactively. It does not - affect the printing by the functions print, printf, etc. The inital + affect the printing by the functions print, printf, etc. The initial "tab" value is 1. The "quomod", "quo", "mod", "sqrt", "appr", "cfappr", "cfsim", and @@ -232,11 +240,11 @@ Configuration parameters parameter is 0, so that, for example, if config("display") >= 2, 5/4 will print in "real" mode as 1.25. - The maxerr value controls how many scan errors are allowed + The maxscan value controls how many scan errors are allowed before the compiling phase of a computation is aborted. The initial - value of "maxerr" is 20. Setting maxerr to 0 disables this feature. + value of "maxscan" is 20. Setting maxscan to 0 disables this feature. - The default prompt when in teractive mode is "> ". One may change + The default prompt when in interactive mode is "> ". One may change this prompt to a more cut-and-paste friendly prompt by: config("prompt", "; ") @@ -250,6 +258,121 @@ Configuration parameters config("more", ";; ") + The "blkmaxprint" config value limits the number of octets to print + for a block. A "blkmaxprint" of 0 means to print all octets of a + block, regardless of size. + + The default is to print only the first 256 octets. + + The "blkverbose" determines if all lines, including duplicates + should be printed. If TRUE, then all lines are printed. If false, + duplicate lines are skipped and only a "*" is printed in a style + similar to od. This config value has not meaning if "blkfmt" is "str". + + The default value for "blkverbose" is FALSE: duplicate lines are + not printed. + + The "blkbase" determines the base in which octets of a block + are printed. Possible values are: + + "hexadecimal" Octets printed in 2 digit hex + "hex" + + "octal" Octets printed in 3 digit octal + "oct" + + "character" Octets printed as chars with non-printing + "char" chars as \123 or \n, \t, \r + + "binary" Octets printed as 0 or 1 chars + "bin" + + "raw" Octets printed as is, i.e. raw binary + "none" + + The default "blkbase" is "hex". + + The "blkfmt" determines for format of how block are printed: + + "line" print in lines of up to 79 chars + newline + "lines" + + "str" print as one long string + "string" + "strings" + + "od" print in od-like format, with leading offset, + "odstyle" followed by octets in the given base + "od_style" + + "hd" print in hex dump format, with leading offset, + "hdstyle" followed by octets in the given base, followed + "hd_style" by chars or '.' if no-printable or blank + + The default "blkfmt" is "hd". + + With regards to "lib_debug", "calc_debug" and "user_debug": + higher absolute values result in more detailed debugging and + more verbose debug messages. The default value is 0 in which + a very amount of debugging will be performed with nil messages. + The -1 value is reserved for no debugging or messages. Any + value <-1 will perform debugging silently (presumably collecting + data to be displayed at a later time). Values >0 result in a + greater degree of debugging and more verbose messages. + + The "lib_debug" is reserved by convention for calc library scripts. + This 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 + + The "calc_debug" is reserved by convention for internal calc routines. + The output of "calc_debug" will change from release to release. + Generally this value is used by calc wizards and by the regress.cal + routine (make check). By convention, "calc_debug" has the following + meanings: + + <-1 reserved for future use + + -1 no debug messages are printed, no debug actions will be taken + + 0 very little, if any debugging is performed (and then mostly + in alpha test code). The only output is as a result of + internal fatal errors (typically either math_error() or + exit() will be called). (default) + + >0 a greater degree of debugging is performed and more + verbose messages are printed (regress.cal uses 1). + + The "user_debug" is provided for use by users. Calc ignores this value + other than to set it to 0 by default (for both "oldstd" and "newstd"). + No calc code or shipped library will change this value other than + during startup or during a config("all", xyz) call. + + The following is suggested as a convention for use of "user_debug". + These are only suggestions: feel free to use it as you like: + + <-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 very little, if any debugging is performed. The only output + are from fatal errors. (default) + + >0 a greater degree of debugging is performed and more + verbose messages are printed + The following are synonyms for true: "on" "yes" "y" "true" "t" "1" any non-zero number diff --git a/help/conj b/help/conj index 817752f..8056ad8 100644 --- a/help/conj +++ b/help/conj @@ -14,6 +14,7 @@ TYPES return real, complex, or matrix DESCRIPTION + For real x, conj(x) returns x. For complex x, conj(x) returns re(x) - im(x) * 1i. @@ -21,6 +22,11 @@ DESCRIPTION For matrix x, conj(x) returns a matrix of the same structure as x in which each element t of x has been replaced by conj(t). + For xx objects, xx_conj(a) may return any type of value, but + for the properties usually expected of conjugates, xx_conj(a) + would return an xx object in which each number component is the + conjugate of the corresponding component of a. + EXAMPLE > print conj(3), conj(3 + 4i) 3 3-4i diff --git a/help/contrib b/help/contrib new file mode 100644 index 0000000..df6412b --- /dev/null +++ b/help/contrib @@ -0,0 +1,48 @@ +We welcome and encourage you to send us: + + * calc scripts + * any builtin functions that you have modified or written + * custom functions that you have modified or written + * any other source code modifications + +Prior to doing so, you should consider trying your changes on the most +recent alpha test code. To obtain the most recent code, look under + + http://reality.sgi.com/chongo/calc/ + +You should also consider joining the calc testing group by sending a +request to: + + calc-tester-request@postofc.corp.sgi.com + + Your message body (not the subject) should consist of: + + subscribe calc-tester address + end + name your_full_name + + where "address" is your EMail address and "your_full_name" + is your full name. + +In order to consider integrating your code, we need: + + * help files (documentation) + * CHANGES text (brief description of what it does) + * regress.cal test (to test non-custom code) + * your source code and/or source code changes (:-)) + +The best way to send us new code, if your changes are small, is +via a patch (diff -c from the latest alpha code to your code). +If your change is large, you should send entire files (either +as a diff -c /dev/null your-file patch, or as a uuencoded and +gziped (or compressed) tar file). + +You should send submissions to: + + calc-tester@postofc.corp.sgi.com + +Thanks for considering submitting code to calc. Calc is a collective +work by a number of people. It would not be what it is today without +your efforts and submissions! + +Landon Curt Noll /\oo/\ diff --git a/help/cos b/help/cos index 219706f..518faae 100644 --- a/help/cos +++ b/help/cos @@ -26,7 +26,7 @@ EXAMPLE .5 0 -1 LIMITS - eps > 0 + none LIBRARY NUMBER *qcos(NUMBER *x, NUMBER *eps) diff --git a/help/cosh b/help/cosh index e44b054..cf2fba4 100644 --- a/help/cosh +++ b/help/cosh @@ -21,8 +21,7 @@ EXAMPLE 1.54308 1.5430806348 1.543080634815244 1.54308063481524377848 LIMITS - unlike sin and cos, x must be real - eps > 0 + none LIBRARY NUMBER *qcosh(NUMBER *x, NUMBER *eps) diff --git a/help/cot b/help/cot index 6bbc0b7..d7ad156 100644 --- a/help/cot +++ b/help/cot @@ -19,12 +19,10 @@ EXAMPLE .64209 .6420926159 .642092615934331 .64209261593433070301 LIMITS - unlike sin and cos, x must be real - x != 0 - eps > 0 + none LIBRARY - NUMBER *qcot(NUMBER *x, *eps) + NUMBER *qcot(NUMBER *x, NUMBER *eps) SEE ALSO sin, cos, tan, sec, csc, epsilon diff --git a/help/coth b/help/coth index 2154820..6e90458 100644 --- a/help/coth +++ b/help/coth @@ -21,9 +21,7 @@ EXAMPLE 1.31304 1.3130352855 1.313035285499331 1.31303528549933130364 LIMITS - unlike sin and cos, x must be real - x != 0 - eps > 0 + none LIBRARY NUMBER *qcoth(NUMBER *x, NUMBER *eps) diff --git a/help/count b/help/count index 3e07f3d..5b73ff6 100644 --- a/help/count +++ b/help/count @@ -8,7 +8,7 @@ TYPES x list or matrix y string - return int + return integer DESCRIPTION For count(x, y), y is to be the name of a user-defined function; @@ -28,4 +28,4 @@ LIBRARY none SEE ALSO - XXX - fill in + select, modify diff --git a/help/cp b/help/cp index bf2ac37..35031fe 100644 --- a/help/cp +++ b/help/cp @@ -27,8 +27,8 @@ EXAMPLE [2] = -1 LIMITS - x 1-dimensional matrix with 3 elements - y 1-dimensional matrix with 3 elements + The components of the matrices are to be of types for which the + required algebraic operations have been defined. LIBRARY MATRIX *matcross(MATRIX *x, MATRIX *y) diff --git a/help/csc b/help/csc index c8ce2be..3fbadd0 100644 --- a/help/csc +++ b/help/csc @@ -19,8 +19,7 @@ EXAMPLE 1.1884 1.1883951058 1.188395105778121 1.18839510577812121626 LIMITS - unlike sin and cos, x must be real - eps > 0 + none LIBRARY NUMBER *qcsc(NUMBER *x, NUMBER *eps) diff --git a/help/csch b/help/csch index fe79c37..e898a64 100644 --- a/help/csch +++ b/help/csch @@ -21,9 +21,7 @@ EXAMPLE .85092 .8509181282 .850918128239322 .85091812823932154513 LIMITS - unlike sin and cos, x must be real - x != 0 - eps > 0 + none LIBRARY NUMBER *qcsch(NUMBER *x, NUMBER *eps) diff --git a/help/ctime b/help/ctime index df3c942..e2f9d5a 100644 --- a/help/ctime +++ b/help/ctime @@ -9,14 +9,14 @@ TYPES DESCRIPTION The ctime() builtin returns the string formed by the first 24 - characters returned by the C library function, ctime(): + characters returned by the C library function, ctime(): E.g. "Mon Oct 28 00:47:00 1996" The 25th ctime() character, '\n' is removed. EXAMPLE - > printf("The time is now %s.\n", time()) + > printf("The time is now %s.\n", ctime()) The time is now Mon Apr 15 12:41:44 1996. LIMITS diff --git a/help/custom b/help/custom new file mode 100644 index 0000000..d53968b --- /dev/null +++ b/help/custom @@ -0,0 +1,95 @@ +NAME + custom - custom builtin interface + +SYNOPSIS + custom([custname [, arg ...]]) + +TYPES + custname string + arg any + + return any + +DESCRIPTION + This function will invoke the custom function interface. Custom + functions are accessed by the custname argument. The remainder + of the args, if any, are passed to the custom function. The + custom function may return any value, including null. Calling + custom with no args is equivalent to the command 'show custom'. + + In order to use the custom interface, two things must happen: + + 1) Calc must be built to allow custom functions. By default, + the master Makefile is shipped with ALLOW_CUSTOM= -DCUSTOM + which causes custom functions to be compiled in. + + 2) Calc must be invoked with an argument of -C as in: + + calc -C + + In other words, explicit action must be taken in order to + enable the use of custom functions. By default (no -C arg) + custom functions are compiled in but disabled so that only + portable calc scripts may be used. + + The main focus for calc is to provide a portable platform for + multi-precision calculations in a C-like environment. You should + consider implementing algorithms in the calc language as a first + choice. Sometimes an algorithm requires use of special hardware, a + non-portable OS or pre-compiled C library. In these cases a custom + interface may be needed. + + The custom function interface is intended to make is easy for + programmers to add functionality that would be otherwise + un-suitable for general distribution. Functions that are + non-portable (machine, hardware or OS dependent) or highly + specialized are possible candidates for custom functions. + + To add a new custom function requires access to calc source. + For information on how to add a new custom function, try: + + help new_custom + + To serve as examples, calc is shipped with a few custom functions. + If calc if invoked with -C, then either of the following will + display information about the custom functions that are available: + + show custom + or: + + custom() + + A few library script that uses these function are also provided + to serve as usage examples. + + We welcome submissions for new custom functions. For information + on how to submit new custom functions for general distribution, see: + + help contrib + +EXAMPLE + If calc compiled with ALLOW_CUSTOM= (custom disabled): + + > print custom("sysinfo", "baseb") + Calc was built with custom functions disabled + Error 10195 + + If calc compiled with ALLOW_CUSTOM= -DCUSTOM and is invoked without -C: + + > print custom("sysinfo", "baseb") + Calc must be run with a -C argument to use custom function + Error 10194 + + If calc compiled with ALLOW_CUSTOM= -DCUSTOM and is invoked with -C: + + > print custom("sysinfo", "baseb") + 32 + +LIMITS + By default, custom is limited to 100 args. + +LIBRARY + none + +SEE ALSO + custom_cal, new_custom, contrib diff --git a/help/define b/help/define index b2ccdaf..7ef2ee3 100644 --- a/help/define +++ b/help/define @@ -1,21 +1,34 @@ Function definitions Function definitions are introduced by the 'define' keyword. - Other than this, the basic structure of a function is like in C. - That is, parameters are specified for the function within parenthesis, - the function body is introduced by a left brace, variables are - declared for the function, statements implementing the function - follow, and the function is ended with a right brace. + Other than this, the basic structure of an ordinary definition + is like in that in C: parameters are specified for the function + within parenthesis, the function body is introduced by a left brace, + variables may declared for the function, statements implementing the + function may follow, any value to be returned by the function is specified + by a return statement, and the function definition is ended with a + right brace. There are some subtle differences, however. The types of parameters - and variables are not defined at compile time, but instead are typed - at runtime. Thus there is no definitions needed to distinguish - between integers, fractions, complex numbers, matrices, and so on. - Thus when declaring parameters for a function, only the name of - the parameter is needed. Thus there are never any declarations - between the function parameter list and the body of the function. + and variables are not defined at compile time, and may vary during + execution and be different in different calls to the function. For + example, a two-argument function add may be defined by - For example, the following function computes a factorial: + define add(a,b) { + return a + b; + } + + and be called with integer, fractional, or complex number values for a + and b, or, under some compatibility conditions, matrices or objects. + Any variable, not already defined as global, used in a definition has + to be declared as local, global or static, and retains this character + until its scope is terminated by the end of the definition, the end of + the file being read or some other condition (see help variable for + details). + + For example, the following function computes the factorial of n, where + we may suppose it is to be called only with positive integral values + for n: define factorial(n) { @@ -27,22 +40,38 @@ Function definitions return ans; } - If a function is very simple and just returns a value, then the - function can be defined in shortened manner by using an equals sign - in place of the left brace. In this case, the function declaration - is terminated by a newline character, and its value is the specified - expression. Statements such as 'if' are not allowed. An optional - semicolon ending the expression is allowed. As an example, the + (In calc, this definition is unncessary since there is a built-in + function fact(n), also expressible as n!, which returns the factorial + of n.) + + Any functions used in the body of the definition need not have already + been defined; it is sufficient that they have been defined when they are + encountered during evaluation when the function is called. + + If a function definition is sufficiently simple and does not require + local or static variables, it may be defined in shortened manner by + using an equals sign following by an expression involving some or all + of the parameters and already existing global variables. + + In this case, the definition is terminated by a newline character + (which may be preceded by a semicolon), and the value the function + returns when called will be determined by the specified expression. + Loops and "if" statements are not allowed (but ? : expressions and the + logical operators ||, && and ! are permitted). As an example, the average of two numbers could be defined as: define average(a, b) = (a + b) / 2; - Functions can be defined which can be very complex. These can be + (Again, this function is not necessary, as the same result is + returned by the builtin function avg() when called with the + two arguments a, b.) + + Function definitions can be very complicated. Functions may be defined on the command line if desired, but editing of partial functions is not possible past a single line. If an error is made on a previous line, then the function must be finished (with probable errors) and reentered from the beginning. Thus for complicated - functions, it is best to use an editor to create the function in a + functions, it is best to use an editor to create the definition in a file, and then enter the calculator and read in the file containing the definition. @@ -52,7 +81,7 @@ Function definitions the parameters are numbered starting from 1. The total number of parameters to the function is returned by using 'param(0)'. Using this function allows you to implement varargs-like routines - which can handle any number of calling parameters. For example: + which can handle up to 100 calling parameters. For example: define sc() { @@ -64,5 +93,24 @@ Function definitions return s; } - defines a function which returns the sum of the cubes of all it's + defines a function which returns the sum of the cubes of all its parameters. + + Any identifier other than a reserved word (if, for, etc.) and the + name of a builtin function (abs, fact, sin, etc.) can be used when + defining a new function or redefining an existing function. + + An indication of how a user-defined function is stored may be obtained + by using the "show opcodes" command. For example: + + > global alpha + > define f(x) = 5 + alpha * x + "f" defined + > show opcodes f + 0: NUMBER 5 + 2: GLOBALADDR alpha + 4: PARAMADDR 0 + 6: MUL + 7: ADD + 8: RETURN + diff --git a/help/delete b/help/delete index d8648b8..8561857 100644 --- a/help/delete +++ b/help/delete @@ -1,20 +1,18 @@ NAME - delete - delete an element from a list at a given position + delete - delete an element from a list at a specified position SYNOPSIS - delete(lst, idx) + delete(lst, index) TYPES - lst list, &list - idx int, &int + lst list + index nonnegative integer less than the size of the list - return any + return type of the deleted element DESCRIPTION - Delete element at index idx from list lst. - - The index must refer to an element in the list. That is, idx must - be in the range [0, size(lst)-1]. + Deletes element at the specified index from list lst, and returns + the value of this element. EXAMPLE > lst = list(2,3,4,5) @@ -41,4 +39,4 @@ LIBRARY none SEE ALSO - append, insert, islist, list, pop, push, remove, rsearch, search, size + append, insert, pop, push, remove, size diff --git a/help/den b/help/den index 47aedf1..0d5bb6d 100644 --- a/help/den +++ b/help/den @@ -10,7 +10,8 @@ TYPES return integer DESCRIPTION - For real x, den(x) returns the denominator of x. In calc, + For real x, den(x) returns the denominator of x when x is expressed + in lowest terms with positive denominator. In calc, real values are actually rational values. Each calc real value can be uniquely expressed as: @@ -22,7 +23,7 @@ DESCRIPTION gcd(n,d) == 1 d > 0 - If x = n/x, then den(x) == d. + The denominator for this n/d is d. EXAMPLE > print den(7), den(-1.25), den(121/33) diff --git a/help/dereference b/help/dereference new file mode 100644 index 0000000..6bce97b --- /dev/null +++ b/help/dereference @@ -0,0 +1,82 @@ +NAME + * - dereference or indirection operator + +SYNOPSIS + * X + +TYPES + X address or lvalue + + return any + +DESCRIPTION + When used as a binary operator, '*' performs multiplication. When + used as a operator, '*' returns the value at a given address. + + If X is an address, *X returns the value at that address. This value + will be an octet, lvalue, string, or number, depending on the + type of address. Thus, for any addressable A, *&A is the same as A. + + If X is an lvalue, *X returns the current value at the address + considered to be specified by X. This value may be an lvalue or + octet, in which cases, for most operations except when X is the + destination of an assignment, *X will contribute the same as X to + the result of the operation. For example, if A and B are lvalues + whose current values are numbers, A + B, *A + B, A + *B and *A + *B + will all return the same result. However if C is an lvalue and A is + the result of the assignment A = &C, then A = B will assign the value + of B to A, *A = B will assign the value of B to C without affecting + the value of A. + + If X is an lvalue whose current value is a structure (matrix, object, + list, or association), the value returned by *X is a copy of the + structure rather than the structure identified by X. For example, + suppose B has been created by + + mat B[3] = {1,2,3} + + then + A = *B = {4,5,6} + + will assign the values 4,5,6 to the elements of a copy of B, which + will then become the value of A, so that the values of A and B will + be different. On the other hand, + + A = B = {4,5,6} + + will result in A and B having the same value. + + If X is an octet, *X returns the value of that octet as a number. + + The * operator may be iterated with suitable sequences of pointer-valued + lvalues. For example, after + + > global a, b, c; + > b = &a; + > c = &b; + + **c returns the lvalue a; ***c returns the value of a. + +EXAMPLE + > mat A[3] = {1,2,3} + > p = &A[0] + > print *p, *(p + 1), *(p + 2) + 1 2 3 + + > *(p + 1) = 4 + > print A[1] + 4 + + > A[0] = &a + > a = 7 + > print **p + 7 + +LIMITS + none + +LIBRARY + none + +SEE ALSO + address, isptr diff --git a/help/digit b/help/digit index 49057c3..3fb0e6f 100644 --- a/help/digit +++ b/help/digit @@ -29,7 +29,7 @@ EXAMPLE 0 1 4 2 8 LIMITS - none + If x is not an integer, y > -2^31 LIBRARY long qdigit(NUMBER *x, long y) diff --git a/help/digits b/help/digits index 8656a84..90ad245 100644 --- a/help/digits +++ b/help/digits @@ -11,7 +11,7 @@ TYPES DESCRIPTION For real x, digits(x) returns the number of digits in the decimal - representation of int(abs(x)). + representation of int(abs(x)). If x >= 1, digits(x) = 1 + ilog10(x). EXAMPLE > print digits(0), digits(0.0123), digits(3.7), digits(-27), digits(-99.7) diff --git a/help/dp b/help/dp index e184875..017f899 100644 --- a/help/dp +++ b/help/dp @@ -5,7 +5,7 @@ SYNOPSIS dp(x, y) TYPES - x, y 1-dimensional matrices with the same number of elements + x, y 1-dimensional matrices of the same size return depends on the nature of the elements of x and y @@ -23,13 +23,12 @@ DESCRIPTION EXAMPLE > mat x[3] = {2,3,4} - > mat y[3] = {3,4,5} + > mat y[1:3] = {3,4,5} > print dp(x,y) 38 LIMITS - x and y are 1-dimensional matrices - x and y have the same number of elements + none LIBRARY VALUE matdot(MATRIX *x, MATRIX *y) diff --git a/help/epsilon b/help/epsilon index 2063d9c..ce1993d 100644 --- a/help/epsilon +++ b/help/epsilon @@ -24,11 +24,11 @@ EXAMPLE > .000001 1.414214 .000001 1.4142 .0001 LIMITS - 0 < eps < 1 + none LIBRARY void setepsilon(NUMBER *eps) NUMBER *_epsilon_ SEE ALSO - XXX - fill in + config diff --git a/help/errcount b/help/errcount new file mode 100644 index 0000000..11b9f01 --- /dev/null +++ b/help/errcount @@ -0,0 +1,46 @@ +NAME + errcount - return or set the internal error count + +SYNOPSIS + errcount([num]) + +TYPES + num integer + + return integer + +DESCRIPTION + An internal variable keeps count of the number of functions + evaluating to an error value either internally or by a call to + error() or newerror(). + + The errcount() with no args returns the current error count. Calling + errcount(num) returns the current error count and resets it to num. + + If the count exceeds the current value of errmax, execution is aborted + with a message displaying the errno for the error. + + If an error value is assigned to a variable as in: + + infty = 1/0; + + then a function returning that variable does not contribute to + errcount. + +EXAMPLE + > errmax(10) + 0 + > errcount() + 0 + > a = 1/0; b = 2 + ""; c = error(27); d = newerror("a"); + > print errcount(), a, errcount(), errmax(); + 4 Error 10001 4 10 + +LIMITS + 0 <= num < 2^32 + +LIBRARY + none + +SEE ALSO + errmax, error, strerror, iserror, errno, newerror, errorcodes diff --git a/help/errmax b/help/errmax new file mode 100644 index 0000000..5c32ae2 --- /dev/null +++ b/help/errmax @@ -0,0 +1,40 @@ +NAME + errmax - return or set maximum error-count before execution stops + +SYNOPSIS + errmax([num]) + +TYPES + num integer + + return integer + +DESCRIPTION + Without an argument, errmax() returns the current value of an + internal variable errmax. Calling errmax(num) returns this value + but then resets its value to num. Execution is aborted if + evaluation of an error value if this makes errcount > errmax. + An error message displays the errno for the error. + +EXAMPLE + > errmax(2) + 0 + > errcount() + 0 + > a = 1/0; b = 2 + ""; c = error(27); d = newerror("alpha"); + Error 27 caused errcount to exceed errmax + + > print c, d + 0 0 + + Here global variables c and d were created when compiling the line + but execution was aborted before the intended assignments to c and d. + +LIMITS + 0 <= num < 2^32 + +LIBRARY + none + +SEE ALSO + errcount, error, strerror, iserror, errno, newerror, errorcodes diff --git a/help/errno b/help/errno index 95de508..df4928a 100644 --- a/help/errno +++ b/help/errno @@ -1,31 +1,48 @@ NAME - errno - return a system error message + errno - return or set a stored error-number SYNOPSIS - errno(errnum) + errno([errnum]) TYPES - errnum int + errnum integer, 0 <= errnum <= 32767 - return string + return integer DESCRIPTION - If a file builtin function such as fopen() encounters an error, - it will return an errno number. This function will convert this - number into a somewhat more meaningful string. - Note that errno() may return different strings on different systems. + Whenever an operation or evaluation of function returns an error-value, + the numerical code for that value is stored as calc_errno. + + errno() returns the current value of calc_errno. + + errno(errnum) sets calc_errno to the value errnum and returns its + previous value. + + To detect whether an error occurs during some sequence of operations, + one may immediately before that sequence set the stored error-number + to zero by errno(0), and then after the operations, whether or not + an error has occurred will be indicated by errno() being nonzero or + zero. If a non-zero value is returned, that value will be the code + for the most recent error encountered. + + The default argument for the functions error() and strerror() is the + currently stored error-number; in particular, if no error-value has + been returned after the last errno(0), strerror() will return + "No error". EXAMPLE + Assuming there is no file with name "not_a_file" + > errno(0) + > errmax(errcount()+4) + 0 > badfile = fopen("not_a_file", "r") - > if (!isfile(badfile)) print "error #" : badfile : ":", errno(badfile); - error #2: No such file or directory + > print errno(), error(), strerror() + 2 System error 2 No such file or directory - > print errno(13) - Permission denied - - > errno(31) - "Too many links" + > a = 1/0 + > print errno(), error(), strerror() + 10001 Error 10001 Division by zero LIMITS none @@ -34,5 +51,4 @@ LIBRARY none SEE ALSO - errno, fclose, feof, ferror, fflush, fgetc, fgetline, files, fopen, - fprintf, isfile, printf, prompt + errmax, errcount, error, strerror, iserror, newerror, errorcodes diff --git a/help/error b/help/error index 912745a..c4e5a8f 100644 --- a/help/error +++ b/help/error @@ -1,28 +1,41 @@ NAME - error - generate a value of an error type + error - generate a value of specified error type SYNOPSIS - error(n) + error([n]) TYPES - n integer less than 32768 + n integer, 0 <= n <= 32767; defaults to errno() return null value or error value DESCRIPTION - If n is zero or negative, error(n) returns the null value. + + If n is zero, error(n) returns the null value. + For positive n, error(n) returns a value of error type n. + error(n) sets calc_errno to n so that until another error-value + is returned by some function, errno() will return the value n. + EXAMPLE + Note that by default, errmax() is 0 so unless errmax() is + increased you will get: + + > ba = error(10009) + Error 10009 caused errcount to exceed errmax + + > errmax(errcount()+1) + 0 > a = error(10009) - a - Error 10009 + > a + Error 10009 LIMITS - 0 <= n < 32768 + none LIBRARY none SEE ALSO - errorcodes, iserror + errcount, errmax, errorcodes, iserror, errno, strerror, newerror diff --git a/help/eval b/help/eval index 5c7df80..f585e43 100644 --- a/help/eval +++ b/help/eval @@ -58,4 +58,4 @@ LIBRARY none SEE ALSO - XXX = fill in + command, expression, define, prompt diff --git a/help/free b/help/free new file mode 100644 index 0000000..b09a045 --- /dev/null +++ b/help/free @@ -0,0 +1,36 @@ +NAME + free - free the memory used to store values of lvalues + +SYNOPSIS + free(a, b, ...) + +TYPES + a, b, ... any + + return null value + +DESCRIPTION + Those of the arguments a, b, ... that specify lvalues are assigned + the null value, effectively freeing whatever memory is used to + store their current values. Other arguments are ignored. + + free(.) frees the current "old value". + +EXAMPLE + > a = 7 + > mat M[3] = {1, list(2,3,4), list(5,6)} + > print memsize(a), memsize(M) + 80 736 + + > free(a, M[1]) + > print memsize(a), memsize(M) + 16 424 + +LIMITS + none + +LIBRARY + none + +SEE ALSO + freeglobals, freestatics, freeredc diff --git a/help/freeglobals b/help/freeglobals new file mode 100644 index 0000000..51ed4e4 --- /dev/null +++ b/help/freeglobals @@ -0,0 +1,47 @@ +NAME + freeglobals - free memory used for values of global variabls + +SYNOPSIS + freeglobals() + +TYPES + return null value + +DESCRIPTION + This function frees the memory used for the values of all global + and not unscoped static variables by assigning null values. + The oldvalue (.) is not freed by this function. + +EXAMPLE + > global a = 1, b = list(2,3,4), c = mat[3] + > static a = 2 + > show globals + + Name Level Type + ---- ----- ----- + a 1 real = 2 + a 0 real = 1 + b 0 list + c 0 matrix + + Number: 4 + > freeglobals() + > show globals + + Name Level Type + ---- ----- ----- + a 1 null + a 0 null + b 0 null + c 0 null + + Number: 4 + +LIMITS + none + +LIBRARY + none + +SEE ALSO + free, freestatics, freeredc diff --git a/help/freeredc b/help/freeredc new file mode 100644 index 0000000..e6ea9bf --- /dev/null +++ b/help/freeredc @@ -0,0 +1,31 @@ +NAME + freeredc - free the memory used to store redc data + +SYNOPSIS + freeredc() + +TYPES + return null value + +DESCRIPTION + This function frees the memory used for any redc data currently stored by + calls to rcin, rcout, etc. + +EXAMPLE + > a = rcin(10,27) + > b = rcin(10,15) + > show redc + 0 1 27 + 1 2 15 + > freeredc() + > show redc + > + +LIMITS + none + +LIBRARY + none + +SEE ALSO + free, freeglobals, freestatics diff --git a/help/freestatics b/help/freestatics new file mode 100644 index 0000000..8d86343 --- /dev/null +++ b/help/freestatics @@ -0,0 +1,45 @@ +NAME + freestatics - free memory used for static variables + +SYNOPSIS + freestatics() + +TYPES + + return null value + +DESCRIPTION + This function frees the memory used for the values of all unscoped + static variables by in effect assigning null values to them. As this + will usually have significant effects of any functions in whose + definitions these variables have been used, it is primarily intended + for use when these functions are being undefined or redefined.. + +EXAMPLE + > static a = 5 + > define f(x) = a++ * x; + f() defined + > global a + > f(1) + 5 + > show statics + + Name Scopes Type + ---- ------ ----- + a 1 0 real = 6 + + Number: 1 + > freestatics() + > f(1) + Error 10005 + > strerror(.) + "Bad arguments for *" + +LIMITS + none + +LIBRARY + none + +SEE ALSO + free, freeglobals, freeredc diff --git a/help/gd b/help/gd new file mode 100644 index 0000000..fad927f --- /dev/null +++ b/help/gd @@ -0,0 +1,51 @@ +NAME + gd - gudermannian function + +SYNOPSIS + gd(z [,eps]) + +TYPES + z number (real or complex) + eps nonzero real, defaults to epsilon() + + return number or "Log of zero or infinity" error value + +DESCRIPTION + Calculate the gudermannian of z to a nultiple of eps with errors in + real and imaginary parts less in absolute value than .75 * eps, + or return an error value if z is close to one of the branch points + at odd multiples of (pi/2) * i. + + gd(z) is usually defined initially for real z by one of the formulae + + gd(z) = 2 * atan(exp(z)) - pi/2 + + = 2 * atan(tanh(z/2)) + + = atan(sinh(z)), + + or as the integral from 0 to z of (1/cosh(t))dt. For complex z, the + principal branch, approximated by gd(z, eps), has the cut: + re(z) = 0, abs(im(z)) >= pi/2; on the cut calc takes gd(z) to be + the limit as z is approached from the right or left according as + im(z) > or < 0. + + If z = x + y*i and abs(y) < pi/2, gd(z) is given by + + gd(z) = atan(sinh(x)/cos(y)) + i * atanh(sin(y)/cosh(x)). + +EXAMPLE + > print gd(1, 1e-5), gd(1, 1e-10), gd(1, 1e-15) + .86577 .8657694832 .865769483239659 + + > print gd(2+1i, 1e-5), gd(2+1i, 1e-10) + 1.42291+.22751i 1.4229114625+.2275106584i + +LIMITS + none + +LIBRARY + COMPLEX *cgd(COMPLEX *x, NUMBER *eps) + +SEE ALSO + agd, exp, ln, sin, sinh, etc. diff --git a/help/help b/help/help index 85ed57a..ad86b5d 100644 --- a/help/help +++ b/help/help @@ -11,6 +11,7 @@ following topics: builtin builtin functions command top level commands config configuration parameters + custom information about the custom builtin interface define how to define functions environment how environment variables effect calc errorcodes calc generated error codes @@ -25,21 +26,25 @@ following topics: statement flow control and declaration statements stdlib description of some lib files shipped with calc types builtin data types + unexpected unexpected syntax/usage surprises for C programmers usage how to invoke the calc command variable variables and variable declarations - bindings input & history character bindings altbind alternative input & history character bindings - changes recent changes to calc + bindings input & history character bindings + custom_cal information about custom calc library files libcalc using the arbitrary precision routines in a C program + new_custom information about how to add new custom functions stdlib standard calc library files and standards - bugs known bugs and mis-features - todo needed enhancements and wish list - credit who wrote calc and who helped archive where to get the latest versions of calc + bugs known bugs and mis-features + changes recent changes to calc + contrib how to contribute scripts, code or custom functions + credit who wrote calc and who helped + todo needed enhancements and wish list - full all of the above + full all of the above (in the above order) You can also ask for help on a particular function name. For example, @@ -67,3 +72,28 @@ then the help facility will be disabled. See: help usage for details of the -m mode. + +The help command is able to display installed help files for custom builtin +functions. However, if the custom name is the same as a standard help +file, the standard help file will be displayed instead. The custom help +builtin should be used to directly access the custom help file. + +For example, the custom help builtin has the same name as the standard +help file. That is: + + help help + +will print this file only. However the custom help builtin will print +only the custom builtin help file: + + custom("help", "help"); + +will by-pass a standard help file and look for the custom version directly. + +As a hack, the following: + + help custhelp/anything + +as the same effect as: + + custom("help", "anything"); diff --git a/help/hnrmod b/help/hnrmod new file mode 100644 index 0000000..3d8f6d1 --- /dev/null +++ b/help/hnrmod @@ -0,0 +1,43 @@ +NAME + hnrmod - compute mod h * 2^n +r + +SYNOPSIS + hnrmod(v, h, n, r) + +TYPES + v integer + h integer + n integer + r integer + + return integer + +DESCRIPTION + Compute the value: + + v % (h * 2^n +r) + + where: + + h > 0 + n > 0 + r == -1, 0 or 1 + + This builtin in faster than the standard mod in that is makes use + of shifts and additions when h == 1. When h > 1, a division by h + is also needed. + +EXAMPLE + > print hnrmod(2^177-1, 1, 177, -1), hnrmod(10^40, 17, 51, 1) + 0 33827019788296445 + +LIMITS + h > 0 + 2^31 > n > 0 + r == -1, 0 or 1 + +LIBRARY + void zhnrmod(ZVALUE v, ZVALUE h, ZVALUE zn, ZVALUE zr, ZVALUE *res) + +SEE ALSO + mod diff --git a/help/intro b/help/intro index be53f0c..a80d6d9 100644 --- a/help/intro +++ b/help/intro @@ -53,3 +53,7 @@ Quick introduction (2+3i) * (4-3i) prints "17+6i". + + For more information about the calc lauguage and features, try: + + help overview diff --git a/help/isassoc b/help/isassoc index 8db1177..8fbb8cf 100644 --- a/help/isassoc +++ b/help/isassoc @@ -25,5 +25,8 @@ LIBRARY none SEE ALSO - isfile, isident, isint, islist, ismat, isnull, isnum, isobj, - isreal, isstr, issimple, istype + assoc, + isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/isatty b/help/isatty index 99f3989..8596943 100644 --- a/help/isatty +++ b/help/isatty @@ -5,7 +5,7 @@ SYNOPSIS isatty(fd) TYPES - fd file + fd any return int @@ -21,10 +21,15 @@ EXAMPLE 0 LIMITS - fd must be associaed with an open file + none LIBRARY none SEE ALSO - XXX - fill in + errno, fclose, feof, ferror, fflush, fgetc, fgetline, fgets, files, fopen, + fprintf, fputc, fputs, fseek, fsize, ftell, isfile, printf, prompt, + isassoc, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/isblk b/help/isblk new file mode 100644 index 0000000..7d265f4 --- /dev/null +++ b/help/isblk @@ -0,0 +1,44 @@ +NAME + isblk - whether or not a value is a block + +SYNOPSIS + isblk(val) + +TYPES + val any + + return 0, 1, or 2 + +DESCRIPTION + isblk(val) returns 1 if val is an unnamed block, 2 if val is a + named block, 0 otherwise. + + Note that a named block B retains its name after its data block is + freed by rmblk(B). That a named block B has null data block may be + tested using sizeof(B); this returns 0 if and only if the memory + has been freed. + +EXAMPLE + > A = blk() + > isblk(A) + 1 + + > B = blk("beta") + > isblk(B) + 2 + + > isblk(3) + 0 + +LIMITS + none + +LIBRARY + none - XXX ??? + +SEE ALSO + blk, blocks, blkfree, + isassoc, isatty, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/isconfig b/help/isconfig index 78a688b..a4f9a1c 100644 --- a/help/isconfig +++ b/help/isconfig @@ -2,7 +2,7 @@ NAME isconfig - whether a value is a configuration state SYNOPSIS - isrand(x) + isconfig(x) TYPES x any, &any @@ -25,4 +25,8 @@ LIBRARY none SEE ALSO - config + config, + isassoc, isatty, isblk, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/isdefined b/help/isdefined new file mode 100644 index 0000000..3c4c2aa --- /dev/null +++ b/help/isdefined @@ -0,0 +1,44 @@ +NAME + isdefined - whether a string names a defined function + +SYNOPSIS + isdefined(str) + +TYPES + str string + + return 0, 1, or 2 + +DESCRIPTION + isdefined(str) returns 1 if str is the name of a builtin function, + 2 if str is the name of a user-defined function, 0 otherwise. + +EXAMPLE + > isdefined("abs") + 1 + + > isdefined("fun") + 0 + + > define fun() { } + fun() defined + + > isdefined("fun") + 2 + + > undefine fun + > isdefined("fun") + 0 + +LIMITS + none + +LIBRARY + none - XXX ? + +SEE ALSO + define, undefine, + isassoc, isatty, isblk, isconfig, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/iserror b/help/iserror index cf3c2b8..488e9c5 100644 --- a/help/iserror +++ b/help/iserror @@ -1,5 +1,5 @@ NAME - error - test whether a value is an error value + iserror - test whether a value is an error value SYNOPSIS iserror(x) @@ -25,4 +25,8 @@ LIBRARY none SEE ALSO - error, errorcodes + error, errorcodes, + isassoc, isatty, isblk, isconfig, isdefined, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/iseven b/help/iseven index 6a9812c..dc8d02b 100644 --- a/help/iseven +++ b/help/iseven @@ -27,4 +27,7 @@ LIBRARY none SEE ALSO - iseven, isint, isnum, isodd, isreal + isassoc, isatty, isblk, isconfig, isdefined, iserror, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/isfile b/help/isfile index 42186c5..2c0cbf5 100644 --- a/help/isfile +++ b/help/isfile @@ -5,7 +5,7 @@ SYNOPSIS isfile(x) TYPES - x any, &any + x any return int @@ -25,5 +25,7 @@ LIBRARY none SEE ALSO - isassoc, isident, isint, islist, ismat, isnull, isnum, isobj, - isreal, isstr, issimple, istype + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/ishash b/help/ishash index 5f7200a..0ad076e 100644 --- a/help/ishash +++ b/help/ishash @@ -5,18 +5,22 @@ SYNOPSIS ishash(x) TYPES - x any, &any + x any - return int + return integer DESCRIPTION - Determine if x is a hash state. This function will return 1 if x is - a file, 0 otherwise. + The value returned by ishash(x) is: + + 0 if x is not a hash state, + 1 if x is a sha hash state, + 2 if x is a sha1 hash state, + 3 if x is a md5 hash state. EXAMPLE - > a = shs(0) - > print ishash(a), ishash(0); - 1 0 + > a = shs(0), b = shs1(0), c = md5(0) + > print ishash(0), ishash(a), ishash(b), ishash(c); + 0 1 2 3 LIMITS none @@ -25,4 +29,8 @@ LIBRARY none SEE ALSO - XXX - fill in + sha, sha1, md5, + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/isident b/help/isident index d32b343..79b9152 100644 --- a/help/isident +++ b/help/isident @@ -5,22 +5,28 @@ SYNOPSIS isident(m) TYPES - m mat + m any return int DESCRIPTION - This function returns 1 if m is an identity matrix, 0 otherwise. + This function returns 1 if m is an 2 dimensional identity matrix, + 0 otherwise. EXAMPLE - XXX - fill in + > mat x[3,3] = {1,0,0,0,1,0,0,0,1}; + > isident(x) + 1 LIMITS - m must be a 2 dimensional matrix + none LIBRARY none SEE ALSO - isassoc, isfile, isint, islist, ismat, isnull, isnum, isobj, - isreal, isstr, issimple, istype + mat, matdim, matfill, matmax, matmin, matsum, mattrans, + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/isint b/help/isint index aeb9b01..7937694 100644 --- a/help/isint +++ b/help/isint @@ -27,5 +27,8 @@ LIBRARY none SEE ALSO - isassoc, isfile, isident, islist, ismat, isnull, isnum, isobj, - isreal, isstr, issimple, istype + int, + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/islist b/help/islist index ca25ed4..2cf50ae 100644 --- a/help/islist +++ b/help/islist @@ -25,5 +25,9 @@ LIBRARY none SEE ALSO - isassoc, isfile, isident, isint, ismat, isnull, isnum, isobj, - isreal, isstr, issimple, istype + append, delete, insert, islist, pop, push, remove, rsearch, + search, size, list, + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/ismat b/help/ismat index c7cf44a..ee1dc76 100644 --- a/help/ismat +++ b/help/ismat @@ -25,5 +25,8 @@ LIBRARY none SEE ALSO - isassoc, isfile, isident, isint, islist, isnull, isnum, isobj, - isreal, isstr, issimple, istype + mat, matdim, matfill, matmax, matmin, matsum, mattrans, + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/ismult b/help/ismult index 7bb8bc1..040e7d0 100644 --- a/help/ismult +++ b/help/ismult @@ -33,4 +33,7 @@ LIBRARY BOOL zdivides(ZVALUE x, y) SEE ALSO - ismult, isprime, isrel, issq + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/isnull b/help/isnull index 0d951cb..c62ccfa 100644 --- a/help/isnull +++ b/help/isnull @@ -25,5 +25,7 @@ LIBRARY none SEE ALSO - isassoc, isfile, isident, isint, islist, ismat, isnum, isobj, - isreal, isstr, issimple, istype + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/isnum b/help/isnum index e154e7f..d036559 100644 --- a/help/isnum +++ b/help/isnum @@ -27,5 +27,7 @@ LIBRARY none SEE ALSO - isassoc, isfile, isident, isint, islist, ismat, isnull, isobj, - isreal, isstr, issimple, istype + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/isobj b/help/isobj index f355a01..e399c71 100644 --- a/help/isobj +++ b/help/isobj @@ -25,5 +25,8 @@ LIBRARY none SEE ALSO - isassoc, isfile, isident, isint, islist, ismat, isnull, isnum, - isreal, isstr, issimple, istype + obj, + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/isobjtype b/help/isobjtype new file mode 100644 index 0000000..8c70e7e --- /dev/null +++ b/help/isobjtype @@ -0,0 +1,35 @@ +NAME + isobjtype - whether a string names an object type + +SYNOPSIS + isobjtype(str) + +TYPES + str string + + return 0 or 1 + +DESCRIPTION + isobjtype(str) returns 1 or 0 according as an object type with name + str has been defined or not defined. + +EXAMPLE + > isobjtype("xy") + 0 + + > obj xy {x, y} + > isobjtype("xy") + 1 + +LIMITS + none + +LIBRARY + none - XXX ??? + +SEE ALSO + obj, + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/isodd b/help/isodd index a59ea79..5c08a7d 100644 --- a/help/isodd +++ b/help/isodd @@ -27,4 +27,7 @@ LIBRARY none SEE ALSO - iseven, isint, isnum, isodd, isreal + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/isprime b/help/isprime index bc23d59..7f1a505 100644 --- a/help/isprime +++ b/help/isprime @@ -45,4 +45,8 @@ LIBRARY FLAG zisprime(ZVALUE x) (return 1 if prime, 0 not prime, -1 if >= 2^32) SEE ALSO - factor, lfactor, nextprime, prevprime, pfact, pix + factor, lfactor, nextprime, prevprime, pfact, pix, + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isrand, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/isptr b/help/isptr new file mode 100644 index 0000000..b9dbb2c --- /dev/null +++ b/help/isptr @@ -0,0 +1,41 @@ +NAME + isptr - whether a value is a pointer + +SYNOPSIS + isptr(x) + +TYPES + x any + + return 0, 1, 2, 3, or 4 + +DESCRIPTION + isptr(x) returns: + + 0 if x is a not pointer + 1 if x is an octet-pointer + 2 if x is a value-pointer + 3 if x is a string-pointer + 4 if x is a number-pointer + + Pointers are initially defined by using the addreess (&) operator + with an "addressable" value; currently, these are octets, lvalues, + strings and real numbers. + +EXAMPLE + > a = "abc", b = 3, B = blk() + > p1 = &B[1] + > p2 = &a + > p3 = &*a + > p4 = &*b + > print isptr(a), isptr(p1), isptr(p2), isptr(p3), isptr(p4) + 0 1 2 3 4 + +LIMITS + none + +LIBRARY + none + +SEE ALSO + isnum, isstr, isblk, isoctet diff --git a/help/isrand b/help/isrand index 89e0fcb..6cb03e1 100644 --- a/help/isrand +++ b/help/isrand @@ -25,4 +25,8 @@ LIBRARY none SEE ALSO - rand, srand + rand, srand, randbit, + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, israndom, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/israndom b/help/israndom index 8356e1d..1b94523 100644 --- a/help/israndom +++ b/help/israndom @@ -27,4 +27,8 @@ LIBRARY none SEE ALSO - XXX - fill in + random, srandom, randombit, + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, isreal, isrel, + issimple, issq, isstr, istype diff --git a/help/isreal b/help/isreal index abc1f29..7be1354 100644 --- a/help/isreal +++ b/help/isreal @@ -27,5 +27,7 @@ LIBRARY none SEE ALSO - isassoc, isfile, isident, isint, islist, ismat, isnull, isnum, isobj, - isstr, issimple, istype + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isrel, + issimple, issq, isstr, istype diff --git a/help/isrel b/help/isrel index 9d035d7..df6cd57 100644 --- a/help/isrel +++ b/help/isrel @@ -28,4 +28,8 @@ LIBRARY BOOL zrelprime(ZVALUE x, y) SEE ALSO - gcd, ismult, isprime, isrel, issq + gcd, + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, + issimple, issq, isstr, istype diff --git a/help/isset b/help/isset deleted file mode 100644 index 717dc82..0000000 --- a/help/isset +++ /dev/null @@ -1,43 +0,0 @@ -NAME - isset - whether a given binary bit is set in a value - -SYNOPSIS - isset(x, y) - -TYPES - x real - y int - - return int - -DESCRIPTION - Determine if the binary bit y is set in x. If: - - x - int(---) mod 2 == 1 - 2^y - - return 1, otherwise return 0. - -EXAMPLE - > print isset(9,0), isset(9,1), isset(9,2), isset(9,3) - 1 0 0 1 - - > print isset(9,4), isset(0,0), isset(9,-1) - 0 0 0 - - > print isset(1.25, -2), isset(1.25, -1), isset(1.25, 0) - 1 0 1 - - > p = pi() - > print isset(p, 1), isset(p, -2), isset(p, -3) - 1 0 1 - -LIMITS - -2^31 < y < 2^31 - -LIBRARY - BOOL qisset(NUMBER *x, long y) - -SEE ALSO - highbit, lowbit diff --git a/help/issimple b/help/issimple index 2f1fda1..fc122d4 100644 --- a/help/issimple +++ b/help/issimple @@ -35,5 +35,7 @@ LIBRARY none SEE ALSO - isassoc, isfile, isident, isint, islist, ismat, isnull, isnum, isobj, - isreal, isstr, istype + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issq, isstr, istype diff --git a/help/issq b/help/issq index a44add7..fa6748f 100644 --- a/help/issq +++ b/help/issq @@ -31,4 +31,7 @@ LIBRARY BOOL zissquare(ZVALUE x) SEE ALSO - ismult, isprime, isrel, issq + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, isstr, istype diff --git a/help/isstr b/help/isstr index 1f3ad5d..fc210f5 100644 --- a/help/isstr +++ b/help/isstr @@ -24,5 +24,7 @@ LIBRARY none SEE ALSO - isassoc, isfile, isident, isint, islist, ismat, isnull, isnum, isobj, - isreal, issimple, istype + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, istype diff --git a/help/istype b/help/istype index 933a34d..1a3d157 100644 --- a/help/istype +++ b/help/istype @@ -35,5 +35,7 @@ LIBRARY none SEE ALSO - isassoc, isfile, isident, isint, islist, ismat, isnull, isnum, isobj, - isreal, isstr, issimple + isassoc, isatty, isblk, isconfig, isdefined, iserror, iseven, isfile, + ishash, isident, isint, islist, ismat, ismult, isnull, isnum, isobj, + isobjtype, isodd, isprime, isrand, israndom, isreal, isrel, + issimple, issq, isstr diff --git a/help/mattrace b/help/mattrace new file mode 100644 index 0000000..d64d3a3 --- /dev/null +++ b/help/mattrace @@ -0,0 +1,31 @@ +NAME + mattrace - trace of a square matrix + +SYNOPSIS + mattrace(m) + +TYPES + m square matrix with summable diagonal elements + + return determined by addition of elements + +DESCRIPTION + For a two-dimensional square matrix, mattrace(m) returns the sum of + the elements on the principal diagonal. In particular, if m + has been created by mat m[N,N] where N > 0, mattrace(m) returns + + m[0,0] + m{1,1] + ... + m[N-1,N-1] + +EXAMPLE + > mat m[2,2] = {1,2,3,4} + > print mattrace(m), mattrace(m^2) + 5 29 + +LIMITS + none + +LIBRARY + none + +SEE ALSO + mat, mattrans diff --git a/help/max b/help/max index 4635455..5867974 100644 --- a/help/max +++ b/help/max @@ -1,26 +1,71 @@ NAME - max - maximum of a set of rational numbers + max - maximum, or maximum of defined maxima SYNOPSIS - max(x1, x2, ...) + max(x_1, x_2, ...) TYPES - x1, x2, ... rational number + x_1, x_2, ... any - return rational number + return any DESCRIPTION - Compute the maximum value of a set of rational numbers. + If an argument x_i is a list with elements e_1, e_2, ..., e_n, it + is treated as if x_i were replaced by e_1, e_2, ..., e_n; this may + continue recurively if any of the e_j is a list. + + If an argument x_i is an object of type xx, then x_i is replaced by + xx_max(x_i) if the function xx_max() has been defined. If the + type xx has been defined by: + + obj xx = {x, y, z}, + + an appropriate definition of xx_max(a) is sometimes max(a.x, a.y, a.z). + max(a) then returns the maximum of the elements of a. + + If x_i has the null value, it is ignored. Thus, sum(a, , b, , c) + + If x_i has the null value, it is ignored. Thus, max(a, , b, , c) + will return the same as max(a, b, c). + + Assuming the above replacements, and that the x_1, x_2, ..., are + of sufficently simple ordered types (e.g. real numbers or strings), + or, if some are objects, the relevant xx_rel(a,b) has been defined + and returns a real-number value for any comparison that has to be made, + max(x_1, x_2, ...) returns the value determined by max(x_1) = x_1, + and succesively for later arguments, by the use of the equivalent of + max(a,b) = (a < b) ? b : a. If the ordering determined by < is total, + max(x_1, ...) will be the maximum value among the arguments. For a + preorder relation it may be one of several maximal values. For + other relations, it may be difficult to predict the result. EXAMPLE > print max(2), max(5, 3, 7, 2, 9), max(3.2, -0.5, 8.7, -1.2, 2.5) 2 9 8.7 + > print max(list(3,5), 7, list(6, list(7,8), 2)) + 8 + + > print max("one", "two", "three", "four") + two + + > obj point {x, y} + > define point_rel(a,b) = sgn(a.x - b.x) + > obj point A = {1, 5} + > obj point B = {1, 4} + > obj point C = {3, 3} + > print max(A, B, C) + obj point {3, 3} + + > define point_max(a) = a.x + > print max(A, B, C) + 3 + LIMITS - The number of arguments may not to exceed 100. + The number of arguments is not to exceed 100. LIBRARY NUMBER *qmax(NUMBER *x1, NUMBER *x2) SEE ALSO - min + max, obj diff --git a/help/md5 b/help/md5 new file mode 100644 index 0000000..a5dc06e --- /dev/null +++ b/help/md5 @@ -0,0 +1,102 @@ +NAME + md5 - MD5 Message-Digest Algorithm + +SYNOPSIS + md5([arg1 [, val ...]]) + +TYPES + arg1 any + val any + + return HASH or number + +DESCRIPTION + The md5() builtin implements the MD5 Message-Digest Algorithm. + The SHA is a 128 bit hash. + + With no args, md5() returns the default initial md5 HASH state. + + If arg1 is a HASH state and no other val args are given, then the + HASH state is finalized and the numeric value of the hash is given. + + If arg1 is a HASH state and one or more val args are given, + then the val args are used to modify the arg1 HASH state. + The new arg1 HASH state is returned. + + If arg1 is not a a HASH state, then the initial HASH is + used and modifed by arg1 and any val args supplied. The + return value is the new HASH state. + + The following table gives a summary of actions and return values. + Here, assume that 'h' is a HASH state: + + md5() HASH returns initial HASH state + + md5(h) number h is put into final form and the + numeric value of the hash state + + md5(x) HASH modify the initial state by hashing 'x' + + md5(md5(), x) HASH the same as md5(x) + + md5(x, y) HASH the same as md5(md5(x), y) + + md5(h, x, y) HASH modify state 'h' by 'x' and then 'y' + + md5(md5(h,x,y)) number numeric value of the above call + + NOTE: These functions were "derived from the RSA Data Security, Inc. + MD5 Message-Digest Algorithm". + +EXAMPLE + > base(16) + 0xa + + > md5() + md5 hash state + > md5(md5()) + 0xd41d8cd98f00b204e9800998ecf8427e + + > md5("x", "y", "z") == md5("xyz") + 1 + > md5("x", "y", "z") == md5("xy") + 0 + + > md5(md5("this is", 7^19-8, "a composit", 3i+4.5, "hash")) + 0x5a90d942335b0dbbdce38d90e7cb6dac + + > x = md5(list(1,2,3), "curds and whey", 2^21701-1, pi()) + > x + md5 hash state + > md5(x) + 0x88790b3ea9eb0128134c103ac9b683ed + + > y = md5() + > y = md5(y, list(1,2,3), "curds and whey") + > y = md5(y, 2^21701-1) + > y = md5(y, pi()) + > y + md5 hash state + > md5(y) + 0x88790b3ea9eb0128134c103ac9b683ed + +LIMITS + none + +LIBRARY + HASH* hash_init(int, HASH*); + void hash_free(HASH*); + HASH* hash_copy(HASH*); + int hash_cmp(HASH*, HASH*); + void hash_print(HASH*); + ZVALUE hash_final(HASH*); + HASH* hash_long(int, long, HASH*); + HASH* hash_zvalue(int, ZVALUE, HASH*); + HASH* hash_number(int, void*, HASH*); + HASH* hash_complex(int, void*, HASH*); + HASH* hash_str(int, char*, HASH*); + HASH* hash_usb8(int, USB8*, int, HASH*); + HASH* hash_value(int, void*, HASH*); + +SEE ALSO + ishash, sha, sha1 diff --git a/help/memsize b/help/memsize new file mode 100644 index 0000000..e5b841a --- /dev/null +++ b/help/memsize @@ -0,0 +1,91 @@ +NAME + memsize - number of bytes required for value including overhead + +SYNOPSIS + memsize(x) + +TYPES + x any + + return integer + +DESCRIPTION + This is analogous to the C operator sizeof. It attempts to assess + the number of bytes in memory used to store a value and all its + components plus all of the related structue overhead. Unlike + sizeof(x), this builtin includes overhead. + + Unlike size(x), this builtin incldues the trailing \0 byte on the + end of strings. + + Unlike sizeof(x), this builtin includes the size demonitor for integers + and the imaginary part for complex values. Storage for holding + 0, 1 and -1 values are also included. + + The number returned by memsize(x) may be less than the actual number + used because, for example, more memory may have been allocated for + a string than is used: only the characters up to and including the + first '\0' are counted in calculating the contribution of the + string to memsize(x). + + The number returned by memsize(x) may be greater (and indeed + substantially greater) than the number of bytes actually used. + For example, after: + + a = sqrt(2); + mat A[3] = {a, a, a}; + + the numerical information for a, A[0], A[1], A[2] are stored in the + same memory, so the memory used for A is the same as if + its 3 elements were null values. The value returned by + memsize(A) is calculated as A were defined by: + + mat A[3] = {sqrt(2), sqrt(2), sqrt(2)}. + + Similar sharing of memory occurs with literal strings. + + For associative arrays, both the name part and the value part of + the name/value pair are counted. + + The minimum value for memsize(x) occurs for the null and error values. + +EXAMPLES + + The results for examples like these will depend to some extent on + the system being used. The following were for an SGI R4k machine + in 32-bit mode: + + > print memsize(null()) + 8 + + > print memsize(0), memsize(3), memsize(2^32 - 1), memsize(2^32) + 68 68 68 72 + + > x = sqrt(2, 1e-100); print memsize(x), memsize(num(x)), memsize(den(x)) + 148 108 108 + + > print memsize(list()), memsize(list(1)), memsize(list(1,2)) + 28 104 180 + + > print memsize(list()) + 28 + + > print ,memsize(list(1)),memsize(list(1,2)),memsize(list(1,2,3)) + 104 180 256 + + > mat A[] = {1}; mat B[] = {1,2}; mat C[] = {1,2,3}; mat D[100,100]; + > print memsize(A), memsize(B), memsize(C), memsize(D) + 124 192 260 680056 + + > obj point {x,y,z} + > obj point P = {1,2,3}; print memsize(P) + 274 + +LIMITS + It is assumed memsize(x) will fit into a system long integer. + +LIBRARY + none + +SEE ALSO + size, sizeof, fsize, strlen, digits diff --git a/help/min b/help/min index 1e7d6c7..57d0419 100644 --- a/help/min +++ b/help/min @@ -1,26 +1,71 @@ NAME - min - minimum of a set of rational numbers + min - minimum, or minimum of defined minima SYNOPSIS - min(x1, x2, ...) + min(x_1, x_2, ...) TYPES - x1, x2, ... rational number + x_1, x_2, ... any - return rational number + return any DESCRIPTION - Compute the minimum value of a set of rational numbers. + If an argument x_i is a list with elements e_1, e_2, ..., e_n, it + is treated as if x_i were replaced by e_1, e_2, ..., e_n; this may + continue recurively if any of the e_j is a list. + + If an argument x_i is an object of type xx, then x_i is replaced by + xx_min(x_i) if the function xx_min() has been defined. If the + type xx has been defined by: + + obj xx = {x, y, z}, + + an appropriate definition of xx_min(a) is sometimes min(a.x, a.y, a.z). + min(a) then returns the minimum of the elements of a. + + If x_i has the null value, it is ignored. Thus, sum(a, , b, , c) + + If x_i has the null value, it is ignored. Thus, min(a, , b, , c) + will return the same as min(a, b, c). + + Assuming the above replacements, and that the x_1, x_2, ..., are + of sufficently simple ordered types (e.g. real numbers or strings), + or, if some are objects, the relevant xx_rel(a,b) has been defined + and returns a real-number value for any comparison that has to be made, + min(x_1, x_2, ...) returns the value determined by min(x_1) = x_1, + and succesively for later arguments, by the use of the equivalent of + min(a,b) = (a < b) ? a : b. If the ordering determined by < is total, + min(x_1, ...) will be the minimum value among the arguments. For a + preorder relation it may be one of several minimal values. For other + relations, it may be difficult to predict the result. EXAMPLE > print min(2), min(5, 3, 7, 2, 9), min(3.2, -0.5, 8.7, -1.2, 2.5) 2 2 -1.2 + > print min(list(3,5), 7, list(6, list(7,8), 2)) + 2 + + > print min("one", "two", "three", "four") + four + + > obj point {x, y} + > define point_rel(a,b) = sgn(a.x - b.x) + > obj point A = {1, 5} + > obj point B = {1, 4} + > obj point C = {3, 3} + > print min(A, B, C) + obj point {1, 5} + + > define point_min(a) = a.x + > print min(A, B, C) + 1 + LIMITS - The number of arguments may not to exceed 100. + The number of arguments is not to exceed 100. LIBRARY NUMBER *qmin(NUMBER *x1, NUMBER *x2) SEE ALSO - max + max, obj diff --git a/help/name b/help/name new file mode 100644 index 0000000..0afd223 --- /dev/null +++ b/help/name @@ -0,0 +1,39 @@ +NAME + name - return name of some kinds of structure + +SYNOPSIS + name(val) + +TYPES + val any + + return string or null value + +DESCRIPTION + If val is a named block or open file stream, name(val) returns the + name associated with val. Otherwise the null value is returned. + + Since the name associated with a file stream is that used when the stream + was opened, different names may refer to the same file, e.g. "foo" + and "./foo". + +EXAMPLE + > A = blk("alpha"); + > name(A) + "alpha" + + > f = fopen("/tmp/beta", "w") + > name(f) + "/tmp/beta" + + > names(files(0)) + "(stdin)" + +LIMITS + none + +LIBRARY + none - XXX ??? + +SEE ALSO + blk, fopen diff --git a/help/newerror b/help/newerror index 51212ba..1d8962e 100644 --- a/help/newerror +++ b/help/newerror @@ -1,39 +1,70 @@ NAME - newerror - create a new error type + newerror - create or recall a described error-value SYNOPSIS newerror([str]) TYPES - str non-null string + str string return error-value DESCRIPTION - With or without an argument, newerror() creates an error-value - different from already existing error-values. With the argument - str, if x == newerror(str), strerror(iserror(x)) returns str. + If str is not "" and has not earlier been used as an argument for + this function, newerror(str) creates a new described error-value so + that any future use of newerror(str) with the same str will return + the same error-value. + + If x = newerror(str), both strerror(x) and strerror(iserro(x)) will + return str and iserror(x) will return the error code value of the + new error. + + The null cases newerror() and newerror("") are equivalent to + newerror("???"). EXAMPLE - > e1 = newerror("Non-positive side") - > e2 = newerror("Non-triangle sides") + Note that by default, errmax() is 0 so unless errmax() is + increased you will get: - > define area(a,b,c) {\ - > local s;\ - > if (!(a > 0) || !(b > 0) || !(c > 0)) return e1;\ - > s = (a + b + c)/2;\ - > if (s <= a || s <= b || s <= c) return e2;\ - > return sqrt(s * (s - a) * (s - b) * (s - c)); } + > ba = newerror("curds n' whey"); + Error 20000 caused errcount to exceed errmax - > print strerror(iserror(area(8,2,5))) + > errmax(errcount()+5) + 0 + > e1 = newerror("triangle side length <= 0") + > iserror(e1) + 20000 + > error(20000) + Error 20000 + > strerror(error(20000)) + "triangle side length <= 0" + > strerror(e1); + "triangle side length <= 0" + > strerror(error(iserror(e1))) + "triangle side length <= 0" - Non-triangle sides + > define area(a,b,c) { + >> local s; + >> if (!(a > 0) || !(b > 0) || !(c > 0)) return e1; + >> s = (a + b + c)/2; + >> if (s <= a || s <= b || s <= c) return newerror("Non-triangle sides"); + >> return sqrt(s * (s - a) * (s - b) * (s - c)); + >> } + "area" defined + + > A = area(8,2,5); + > if (iserror(A)) print strerror(A) : ":", iserror(A); + Non-triangle sides: 20001 + + > A = area(-3,4,5) + > if (iserror(A)) print strerror(A) : ":", iserror(A); + triangle side length <= 0: 20000 LIMITS - none - XXX - is this correct? + The number of new described error-values is not to exceed 12767. LIBRARY none SEE ALSO - errorcodes, iserror, error + errmax, errcount, error, strerror, iserror, errno, errorcodes diff --git a/help/nextcand b/help/nextcand index 18395c0..8bc9aa0 100644 --- a/help/nextcand +++ b/help/nextcand @@ -27,8 +27,6 @@ DESCRIPTION If skip == 0, and abs(n) >= 2^32 or count < 0, the probabilistic test with random bases is used so that if n is composite the probability that it passes ptest() is less than 4^-abs(count). - In any case, if the integer returned by nextcand() is not zero, - all integers between abs(n) and that integer are composite. If skip == 1 (the default value), the bases used in the probabilistic test are the first abs(count) primes 2, 3, 5, ... @@ -36,6 +34,9 @@ DESCRIPTION For other values of skip, the bases used in the probabilistic tests are the abs(count) consecutive integers, skip, skip + 1, skip + 2, ... + In any case, if the integer returned by nextcand() is not zero, + all integers between abs(n) and that integer are composite. + If modulus is zero, the value returned is that of residue if this is greater than abs(n) and ptest(residue,count,skip) = 1. Otherwise zero is returned. @@ -44,7 +45,7 @@ RUNTIME The runtime for v = nextcand(n, ...) will depend strongly on the number and nature of the integers between n and v. If this number is reasonably large the size of count is largely irrelevant as the - compositeness of the numbers betweeen n and v will usually be + compositeness of the numbers between n and v will usually be determined by the test for small prime factors or one pseudoprime test with some base b. If N > 1, count should be positive so that candidates divisible by small primes will be passed over quickly. diff --git a/help/null b/help/null index 1c0d1ef..9727457 100644 --- a/help/null +++ b/help/null @@ -2,48 +2,74 @@ NAME null - null value SYNOPSIS - null() + null([v_1, v_2,...]) TYPES - return null + v_1, v_2,... any + return null DESCRIPTION - There is only one value of null type. After x = null(), isnull(x) - returns 1 but isreal(x). isnum(x), etc. all return zero, and - x == y is true if and only if y is also null. The null value - tests as false in conditions. + After evaluating in order any arguments it may have, null(...) + returns the null value. This is a particular value, different from + all other types; it is the only value v for which isnull(v) returns + TRUE. The null value tests as FALSE in conditions, and normally + delivers no output in print statements, except that when a list or + matrix is printed, null elements are printed as "NULL". - The null value is the value returned by some functions, e.g. - x = printf("%d\n", 27) assigns to x the null value. If L is a - list with no elements (given by L = list()), then both pop(L) - and remove(L) return the null value. + A few builtin functions may return the null value, e.g. + printf(...) returns the null value; if L = list(), then both + pop(L) and remove(L) return the null value; when successful, + file-handling functions like fclose(fs), fflush(fs), fputs(fs, ...) + return the null value when successful (when they fail they return an + error-value). User-defined functions where execution ends + without a "return" statement or with "return ;" return the null + value. + + Missing expressions in argument lists are assigned the null value. + For example, after + define f(a,b,c) = ... + calling + f(1,2) + is as if c == null(). Similarly, f(1,,2) is as if b == null(). + (Note that this does not occur in initialization lists; missing + expressions there indicate no change.) The null value may be used as an argument in some operations, e.g. - for any x, x + null() returns x. + if v == null(), then for any x, x + v returns x. + + When calc is used interactively, a function that returns the null value + causes no printed output and does not change the "oldvalue". Thus, + null(config("mode", "frac")) may be used to change the output mode + without printing the current mode or changing the stored oldvalue. EXAMPLE - In a print statement like + > L = list(-1,0,1,2); + > while (!isnull(x = pop(L)) print x,; print + -1 0 1 2 - print 2, null(), 3; + > printf("%d %d %d\n", 2, , 3); + 2 3 - or + > L = list(,1,,2,) + > print L - printf("%d %d %d\n", 2, null(), 3); + list (5 elements, 5 nonzero): + [[0]] = NULL + [[1]] = 1 + [[2]] = NULL + [[3]] = 2 + [[4]] = NULL - the null value produces no output. Both of these examples - print the same as both - - print 2, null(), 3; - - and - - print "2 3"; + > a = 27 + > null(pi = pi(1e-1000)) + > . + 27 LIMITS - none + The number of arguments is not to exceed 100. LIBRARY none SEE ALSO - XXX - missing + isnull, test diff --git a/help/obj.file b/help/obj.file index 82f8190..05f99c2 100644 --- a/help/obj.file +++ b/help/obj.file @@ -165,6 +165,10 @@ Using objects xx_bround 2 round to given number of binary places xx_root 3 root of value within given error xx_sqrt 2 square root within given error + xx_or 2 boolean or + xx_and 2 boolean and + xx_not 1 boolean not + xx_fact 1 factorial Also see the library files: diff --git a/help/oldvalue b/help/oldvalue new file mode 100644 index 0000000..e3fe4da --- /dev/null +++ b/help/oldvalue @@ -0,0 +1,54 @@ +NAME + . - oldvalue + +SYNOPSIS + . (with no adjacent letters or digits or _ or .) + +TYPES + return any + +DESCRIPTION + The "old value" is essentially a global variable with identifier "." + which at top level when directly from a file or keyboard + is automatically assigned the saved value for a line + of statements when evaluation of that line is completed and this saved + value is not null. A line of statements is normally completed by a + '\n' not within a block bounded by braces or an expression bounded by + parentheses. + + Disabling of saving by calling saveval(0) causes lines to return a + null value and . then becomes in effect a global variable whose + value may be changed by assignments and operations like ++ and --. + + A null value may be assigned to . by . = null() or free(.). + +EXAMPLE + > saveval(1); + > a = 2 + > . + 2 + > . += 3; b = . + 4 + > print ., b + 9 9 + > . += 3; b = . + 4; null() + > print ., b + 12 16 + > list(a, b, a + b) + + list (3 elements, 3 nonzero): + [[0]] = 2 + [[1]] = 16 + [[2]] = 18 + + > saveval(0) + > print pop(.), .[[1]] + 2 18 + +LIMITS + none + +LIBRARY + none + +SEE ALSO + saveval diff --git a/help/operator b/help/operator index 3503275..5fc3518 100644 --- a/help/operator +++ b/help/operator @@ -1,14 +1,16 @@ operators - The operators are similar to C, but there are some differences - in the associativity and precedence rules for some operators. - In addition, there several operators not in C, and some C operators - are missing. Below is a list giving the operators arranged in - order of precedence, from the least tightly binding to the most - tightly binding. + The operators are similar to C, but there are some differences in + the associativity and precedence rules for some operators. In + addition, there are several operators not in C, and some C + operators are missing. A more detailed discussion of situations + that may be unexpected for the C programmer may be found in + the 'unexpected' help file. - Except where otherwise indicated, operators at the same level of - precedence associate from left to right. + Below is a list giving the operators arranged in order of + precedence, from the least tightly binding to the most tightly + binding. Except where otherwise indicated, operators at the same + level of precedence associate from left to right. Unlike C, calc has a definite order for evaluation of terms (addends in a sum, factors in a product, arguments for a function or a @@ -55,13 +57,24 @@ operators , Comma operator. + a, b returns the value of b. For situations in which a comma is used for another purpose (function arguments, array indexing, and the print statement), - parenthesis must be used around the comma operator. + parenthesis must be used around the comma operator expression. + E.g., if A is a matrix, A[(a, b), c] evaluates a, b, and c, and + returns the value of A[b, c]. - = += -= *= /= %= //= &= |= <<= >>= ^= **= - Assignments. As in C, these associate from right to left. + += -= *= /= %= //= &= |= <<= >>= ^= **= + Operator-with-assignments. + These associate from left to right, e.g. a += b *= c has the + effect of a = (a + b) * c, where only a is required to be an + lvalue. For the effect of b *= c; a += b; when both a and b + are lvalues, use a += (b *= c). + = Assignment. + As in C, this, when repeated, this associates from right to left, + e.g. a = b = c has the effect of a = (b = c). Here both a and b + are to be lvalues. ? : Conditional value. a ? b : c returns b if a tests as true (i.e. nonzero if @@ -90,7 +103,8 @@ operators Relations. + - - Binary plus and minus. + Binary plus and minus and unary plus and minus when applied to + a first or only term. * / // % Multiply, divide, and modulo. @@ -129,13 +143,19 @@ operators e.g. a << b ^ c = a << (b ^ c). + - ! - Unary operators. - The '!' is the logical NOT operator: !a returns 0 if - a is nonzero, and 1 if a is zero, i.e. it is + Plus (+) and minus (-) have their usual meanings as unary + prefix operators at this level of precedence when applied to + other than a first or only term. + + As a prefix operator, '!' is the logical NOT: !a returns 0 if + a tests as nonzero, and 1 if a tests as zero, i.e. it is equivalent to a ? 0 : 1. Be careful about using this as the first character of a top level command, since it is also used for executing shell commands. + As a postfix operator ! gives the factorial function, i.e. + a! = fact(a). + ++ -- Pre or post incrementing or decrementing. These are applicable only to variables. @@ -183,3 +203,8 @@ operators The shift amount must be an integer. The value being shifted must be an integer or a complex number with integral real and imaginary parts. + + + See the 'unexpected' help file for a list of unexpected + surprises in calc syntax/usage. Persons familiar with C should + read the 'unexpected' help file to avoid confusion. diff --git a/help/overview b/help/overview index 54c1a31..e59347e 100644 --- a/help/overview +++ b/help/overview @@ -36,6 +36,41 @@ type of variable to those functions and operators which only work for a subset of types. + Calc has a help command that will produce information about + every builtin function, command as well as a number of other + aspects of calc usage. Try the command: + + help help + + for and overview of the help system. The command: + + help builtins + + provides information on built-in mathematical functions, whereas: + + help asinh + + will provides information a specific function. The following + help files: + + help command + help define + help operator + help statement + help variable + + provide a good overview of the calc language. If you are familiar + with C, you should also try: + + help unexpected + + It contains information about differences between C and calc + that may surprize you. + + A full and extensive overview of calc may be obtained by: + + help full + By default, arguments to functions are passed by value (even matrices). For speed, you can put an ampersand before any variable argument in a function call, and that variable will be diff --git a/help/popcnt b/help/popcnt new file mode 100644 index 0000000..df1a440 --- /dev/null +++ b/help/popcnt @@ -0,0 +1,33 @@ +NAME + popcnt - number of bit that match a given value + +SYNOPSIS + popcnt(x [,bitval]) + +TYPES + x number (real or integer) + bitval 0 or 1 + + return number + +DESCRIPTION + Count the number of bits in abs(x) that match bitval. The default + bitval is 1 which counts the number of 1 bits. + + The popcnt function is equivalent to #x when x is an integer. + +EXAMPLE + > print popcnt(32767), popcnt(3/2), popcnt(pi(),0), popcnt(pi(),1) + 15 3 69 65 + + > print popcnt(randombit(128), 0), popcnt(randombit(128), 1) + 61 64 + +LIMITS + none + +LIBRARY + long zpopcnt(ZVALUE z, int bitval) + +SEE ALSO + none diff --git a/help/prevcand b/help/prevcand index 5b4ae1f..be55759 100644 --- a/help/prevcand +++ b/help/prevcand @@ -47,7 +47,7 @@ RUNTIME The runtime for v = prevcand(n, ...) will depend strongly on the number and nature of the integers between n and v. If this number is reasonably large the size of count is largely irrelevant as the - compositeness of the numbers betweeen n and v will usually be + compositeness of the numbers between n and v will usually be determined by the test for small prime factors or one pseudoprime test with some base b. If N > 1, count should be positive so that candidates divisible by small primes will be passed over quickly. diff --git a/help/protect b/help/protect new file mode 100644 index 0000000..38da6eb --- /dev/null +++ b/help/protect @@ -0,0 +1,188 @@ +NAME + protect - read or set protect status for a variable or named block + +SYNOPSIS + protect(var [, sts]) + protect(nblk [, sts]) + +TYPES + var lvalue + nblk named block + sts integer, 0 <= sts < 512 + + return null value + +DESCRIPTION + With one argument, protect(var) or protect(nblk) returns the current + protection status for var or nblk. + + With two arguments, protect(var, sts) or protect(nblk, sts) sets the + protection status for var or nblk to the value sts. Each nonzero bit + of sts corresponds to one kind of protection as follows: + + sts protection + + 1 no assign to var + 2 no change of value of var + 4 no change of type of var + 8 no error value for var + 16 no copy to var or nblk + 32 no relocation of var or nblk + 64 no assign from var + 128 no copy from var or nblk + 256 protect recursively all components of var + + + Here "assign" refers to use of '=' as in A = expr to assign the value + of expr to A, and in A = {..., expr, ...} to assign the value of expr + to some component of A, and to the assignments implicit in swap(A, B), + quomod(x, y, A, B), and pre or post ++ or --. + + For example, if A is a global variable, then after + + protect(A, 1); + + an error state is established if A = expr is attempted. It does + not imply constancy if, for example, the current value of A is a list + or matrix; such a value may be changed by assignments to the elements + of A, or by push or copy commands. + + If the current value of A is val, protect(A, 2) will prevent any + assignment to A other than + + A = expr + + where expr evaluates to val. + + Any such protection of A is cancelled by protect(A, 0). + + If A has components as in a matrix or list, components may be + protected independently from each other and from A by stateents like: + + protect(A[0], 1); + protect(A[1], 2); + + "Copy" refers to the use of copy(A, B, ...) or blkcpy(B, A, ...) to + copy A to B. For example if B is a block, then after + + protect(B, 16); + + attempts to copy to B will fail. + + The protection status of var refers to var as a variable, not to its + current value: if an operation like var = value is executed it may + change the value of var but not protect(var). + + A named block may be referred to by using the blocks() or blk() + functions, or by assigning it to a variable A and then using either + A or *A. In the latter cases, protect(A, sts) sets the status for + the variable A; protect(*A, sts) assigns the status for the named + block. For example, protect(*A,16) will prevent any copying to the + named block; protect(A,16) will prevent any copying to the named block + only when it is referred to by A. + + The protection provided by sts = 32 prevents relocation of the memory + used by a block, the freeing of a named block, and addition or removal + of one or more elements from a list. For example, if a block B has + maxsize 256, then after + + protect(B, 32); + + copy(A, B) will fail if the copying would cause size(B) to equal or + exceed 256; if B is a named block, blkfree(B) will not be permitted. + If the current value of L is a list, protect(L, 32) prevents the + execution of push, pop, append, remove, insert, and delete with first + argument L. + + With bit 8 of sts set, as with + + protect(A, 257); + + the protection provided by the lower order bits extends to any + elements A may have, and recursively to any elements of these elements, + etc. + + All protection of A as described above is removed by + + protect(A, 0). + + +EXAMPLE + > A = 27 + > protect(A,1) + > protect(A) + 1 + > A = 99 + No-assign-to destination for assign + + > protect(A,2) + > A = 45 + Change of value in assign not permitted + + > A = 27 + + > protect(A,4) + > A = 2 + 3i + Change of type in assign not permitted + + > protect(A,8) + > A = 1/0 + Error value in assign not permitted + + > A = mat[4] = {1,2,3,4} + > B = list(5,6,7,8) + > protect(A,16) + > copy(B,A) + Error 10226 + > strerror() + "No-copy-to destination variable" + + > A = blk(0,5) + > protect(A,32) + > copy("abc", A) + > copy("de",A) + Error 10229 + > strerror() + "No-relocation destination variable" + + > A = list(1,2,3) + > append(A, 4) + No-relocate list for push + + > protect(A, 64) + > X = A + No-assign-from source for assign + + > protect(A,128) + > copy(A,B) + Error 10225 + > strerror() + "No-copy-from source variable" + + > mat A[2] = {1, list(2, mat[2])} + > protect(A,257) + > A[1][[1]][1] = 4 + No-assign-to destination for assign + > protect(A,256) + > A[1][[1]][1] = 4 + > A[1][[1]] + + mat [2] (2 elements, 1 nonzero): + [0] = 0 + [1] = 4 + + > A = blk("alpha") = {1,2,3,4} + > protect(A, 0) + > protect(*A, 16) + copy("abc", A) + Error 10228 + No-copy-to destination named block + +LIMITS + none + +LIBRARY + none + +SEE ALSO + assign, copy, blk diff --git a/help/rand b/help/rand index 684620e..3269a6d 100644 --- a/help/rand +++ b/help/rand @@ -15,11 +15,29 @@ DESCRIPTION We return a pseudo-random number over the half closed interval [min,max). By default, min is 0 and max is 2^64. + The shuffle method is fast and serves as a fairly good standard + pseudo-random generator. If you need a fast generator and do not + need a cryptographically strong one, this generator is likely to do + the job. Casual direct use of the shuffle generator may be + acceptable. For a much higher quality cryptographically strong + (but slower) generator use the Blum-Blum-Shub generator (see the + random help page). + Other arg forms: rand() Same as rand(0, 2^64) rand(max) Same as rand(0, max) + The rand generator generates the highest order bit first. Thus: + + rand(256) + + will produce the save value as: + + (rand(8) << 5) + rand(32) + + when seeded with the same seed. + The rand generator has two distinct parts, the additive 55 method and the shuffle method. The additive 55 method is described in: @@ -37,11 +55,6 @@ DESCRIPTION by Knuth, Vol 2, 2nd edition (1981), Section 3.2.2, page 32, Algorithm B. - The shuffle method is fast and serves as a fairly good standard - pseudo-random generator. If you need a fast generator and do not - need a cryptographically strong one, this generator is likely to do - the job. Casual direct use of the shuffle generator may be acceptable. - The rand generator has a good period, and is fast. It is reasonable as generators go, though there are better ones available. The shuffle method has a very good period, and is fast. It is fairly good as @@ -89,13 +102,13 @@ DESCRIPTION The shuffle table size is longer than the 100 entries recommended by Knuth. We use a power of 2 shuffle table length so that the shuffle process can select a table entry from a new additive 55 - value by extracting its low order bits. The value 256 is conveient + value by extracting its low order bits. The value 256 is convenient in that it is the size of a byte which allows for easy extraction. We use the upper byte of the additive 55 value to select the shuffle table entry because it allows all of 64 bits to play a part in the entry selection. If we were to select a lower 8 bits in the - 64 bit value, carries that proprogate above our 8 bits would not + 64 bit value, carries that propagate above our 8 bits would not impact the additive 55 generator output. It is 'nice' when a seed of "n" produces a 'significantly different' @@ -172,7 +185,7 @@ DESCRIPTION lost or favored (used by more than one input seed). The randreseed64 process does not reduce the security of the rand - genertator. Every seed is converted into a different unique seed. + generator. Every seed is converted into a different unique seed. No seed is ignored or favored. The truly paranoid might suggest that my claims in the MAGIC NUMBERS @@ -196,7 +209,7 @@ DESCRIPTION srand(mat55) and avoid using my magic numbers. Of course, you must pick good - additive 55 values youself! + additive 55 values yourself! EXAMPLE > print srand(0), rand(), rand(), rand() diff --git a/help/randbit b/help/randbit index 7175fb4..e7b8e53 100644 --- a/help/randbit +++ b/help/randbit @@ -23,7 +23,7 @@ DESCRIPTION If x is omitted, it is assumed to have the value of 1. - See the rand help page for details on the additive 55 shuffle + See the rand() help page for details on the additive 55 shuffle pseudo-random number generator. EXAMPLE diff --git a/help/random b/help/random new file mode 100644 index 0000000..004624a --- /dev/null +++ b/help/random @@ -0,0 +1,157 @@ +NAME + random - Blum-Blum-Shub pseudo-random number generator + +SYNOPSIS + random([[min, ] max]) + +TYPES + min integer + max integer + + return integer + +DESCRIPTION + Generate a pseudo-random number using a Blum-Blum-Shub generator. + We return a pseudo-random number over the half closed interval [min,max). + By default, min is 0 and max is 2^64. + + While the Blum-Blum-Shub generator is not painfully slow, it is not + a fast generator. For a faster, but lesser quality generator + (non-cryptographically strong) see the additive 55 generator + (see the rand help page). + + Other arg forms: + + random() Same as rand(0, 2^64) + random(max) Same as rand(0, max) + + The random generator generates the highest order bit first. Thus: + + random(256) + + will produce the save value as: + + (random(8) << 5) + random(32) + + when seeded with the same seed. + + The basic idea behind the Blum-Blum-Shub generator is to use + the low bit bits of quadratic residues modulo a product of + two 3 mod 4 primes. The lowest int(log2(log2(p*q))) bits are used + where log2() is log base 2 and p,q are two primes 3 mod 4. + + The Blum-Blum-Shub generator is described in the papers: + + Blum, Blum, and Shub, "Comparison of Two Pseudorandom Number + Generators", in Chaum, D. et. al., "Advances in Cryptology: + Proceedings Crypto 82", pp. 61-79, Plenum Press, 1983. + + Blum, Blum, and Shub, "A Simple Unpredictable Pseudo-Random + Number Generator", SIAM Journal of Computing, v. 15, n. 2, + 1986, pp. 364-383. + + U. V. Vazirani and V. V. Vazirani, "Trapdoor Pseudo-Random + Number Generators with Applications to Protocol Design", + Proceedings of the 24th IEEE Symposium on the Foundations + of Computer Science, 1983, pp. 23-30. + + U. V. Vazirani and V. V. Vazirani, "Efficient and Secure + Pseudo-Random Number Generation", Proceedings of the 24th + IEEE Symposium on the Foundations of Computer Science, + 1984, pp. 458-463. + + U. V. Vazirani and V. V. Vazirani, "Efficient and Secure + Pseudo-Random Number Generation", Advances in Cryptology - + Proceedings of CRYPTO '84, Berlin: Springer-Verlag, 1985, + pp. 193-202. + + Sciences 28, pp. 270-299. + + Bruce Schneier, "Applied Cryptography", John Wiley & Sons, + 1st edition (1994), pp 365-366. + + This generator is considered 'strong' in that it passes all + polynomial-time statistical tests. The sequences produced are + random in an absolutely precise way. There is absolutely no better + way to predict the sequence than by tossing a coin (as with TRULY + random numbers) EVEN IF YOU KNOW THE MODULUS! Furthermore, having + a large chunk of output from the sequence does not help. The BITS + THAT FOLLOW OR PRECEDE A SEQUENCE ARE UNPREDICTABLE! + + Of course the Blum modulus should have a long period. The default + Blum modulus as well as the compiled in Blum moduli have very long + periods. When using your own Blum modulus, a little care is needed + to avoid generators with very short periods. See the srandom() + help page for information for more details. + + To compromise the generator, an adversary must either factor the + modulus or perform an exhaustive search just to determine the next + (or previous) bit. If we make the modulus hard to factor (such as + the product of two large well chosen primes) breaking the sequence + could be intractable for todays computers and methods. + + The Blum generator is the best generator in this package. It + produces a cryptographically strong pseudo-random bit sequence. + Internally, a fixed number of bits are generated after each + generator iteration. Any unused bits are saved for the next call + to the generator. The Blum generator is not too slow, though + seeding the generator via srandom(seed,plen,qlen) can be slow. + Shortcuts and pre-defined generators have been provided for this + reason. Use of Blum should be more than acceptable for many + applications. + + The goals of this package are: + + all magic numbers are explained + + I distrust systems with constants (magic numbers) and tables + that have no justification (e.g., DES). I believe that I have + done my best to justify all of the magic numbers used. + + full documentation + + You have this source file, plus background publications, + what more could you ask? + + large selection of seeds + + Seeds are not limited to a small number of bits. A seed + may be of any size. + + the strength of the generators may be tuned to meet the need + + By using the appropriate seed and other arguments, one may + increase the strength of the generator to suit the need of + the application. One does not have just a few levels. + + For a detailed discussion on seeds, see the srandom help page. + + It should be noted that the factors of the default Blum modulus + is given in the source. While this does not reduce the quality + of the generator, knowing the factors of the Blum modulus would + help someone determine the next or previous bit when they did + not know the seed. If this bothers you, feel free to use one + of the other compiled in Blum moduli or provide your own. See + the srandom help page for details. + + +EXAMPLE + > print srandom(0), random(), random(), random() + RANDOM state 9203168135432720454 13391974640168007611 13954330032848846793 + + > print random(123), random(123), random(123), random(123), random(123) + 22 83 66 88 67 + + > print random(2,12), random(2^50,3^50), random(0,2), random(-400000,120000) + 10 483381144668580304003305 0 -70235 + +LIMITS + min < max + +LIBRARY + void zrandom(long cnt, ZVALUE *res) + void zrandomrange(ZVALUE low, ZVALUE high, ZVALUE *res) + long irandom(long max) + +SEE ALSO + srand, randbit, isrand, rand, srandom, israndom diff --git a/help/randombit b/help/randombit new file mode 100644 index 0000000..5327f78 --- /dev/null +++ b/help/randombit @@ -0,0 +1,42 @@ +NAME + randbit - Blum-Blum-Shub pseudo-random number generator + +SYNOPSIS + randombit([x]) + +TYPES + x integer + + return integer + +DESCRIPTION + If x > 0, randombit(x) returns a pseudo-random integer in [0, 2^x), + i.e. the same as rand(2^x). If the integer returned is + + b_1 * 2^(x-1) + b_2 * 2^(x-2) + ... + b_n, + + where each b_i is 0 or 1, then b_1, b_2, ..., b_n may be + considered as a sequence of x random bits. + + If x <= 0, randombit(x) causes the random-number generator to skip + abs(x) bits, and returns abs(x). + + If x is omitted, it is assumed to have the value of 1. + + See the random() help page for details on the additive 55 shuffle + pseudo-random number generator. + +EXAMPLE + > print srandom(0), randombit(20), randombit(20), randombit(20) + RANDOM state 523139 567456 693508 + > print srandom(0), randombit(-20), randombit(20), randombit(-20) + RANDOM state 20 567456 20 + +LIMITS + x != 0 + +LIBRARY + void zrandom(long cnt, ZVALUE *res) + +SEE ALSO + srand, randbit, isrand, rand, srandom, israndom diff --git a/help/rm b/help/rm index f005bf8..7a19f1e 100644 --- a/help/rm +++ b/help/rm @@ -1,20 +1,21 @@ NAME - rm - remove a file + rm - remove file(s) SYNOPSIS - rm(name) + rm(["-f",] name, ...) TYPES - name name of a file + name name of a file(s) return nil DESCRIPTION - Removes a file. + Removes one or more files. If the first arg is "-f", then a forced + removal is performed and "no such file" errors are ignored. EXAMPLE > rm("junk") - > rm("more/junk.cal") + > rm("-f", "more/junk.cal", "curds", "whey") LIMITS name must be a non-zero length string diff --git a/help/rsearch b/help/rsearch index 72934ce..6ba2fea 100644 --- a/help/rsearch +++ b/help/rsearch @@ -1,33 +1,102 @@ NAME - rsearch - reverse search a matrix, list or association for a value + rsearch - reverse search for an element satisfying a specified condition SYNOPSIS - rsearch(x, val [,idx]) + rsearch(a, b [, [c] [, [d] ] ]) TYPES - x matrix, &matrix, list, &list, assoc, &assoc - val any, &any - idx int + a matrix, list, association, or file open for reading + b string if a is a file, otherwise any + c integer, defaults to zero, size(a) or the current file-position + d integer, defaults to size(a) or current file-position - return any + return nonnegative integer or null DESCRIPTION - Reverse search the matrix, list or association x for the value - val. By default, the search starts at the end. If idx is given, - the reverse search starts at index indx. - If the value is not found, this function returns nil. + Negative values of c and nonpositive values of d are treated as + offsets from size(a), i.e. as if c were replaced by size(a) + c + and d by size(a) + d. Any such adjustment is assumed to have been + made. + + The nature of the search depends on whether the rsearch() is called + with or without the fourth argument d. + +Four argument case: + + The search interval is as for search(a,b,c,d), i.e. the indices i + to be examined are to satisfy c <= i < d and 0 <= i < size(a) + for non-file a, and c <= i <= d - strlen(b), 0 <= i <= size(a) - strlen(b) + if a is a file stream. The difference from search(a,b,c,d) is that + the indices i, if any, are examined in decreasing order, so that + if a match is found, the returned integer i is the largest in the + search interval. The null value is returned if no match is found. + + The default value for d is size(a) for non-file cases, and the current + file-position if a is a file. The default for c is zero except if a + is a file and d is an integer. + + For non-file a, the search is for a[[i]] == b, except that if + the function accept() as been defined, it is for i such that + accept(a[[i]], b) tests as nonzero. Since the addresses (rather than + values) of a[[i]] and b are passed to accept(), the values of one or + both of a[[i]] and b may be changed during a call to rsearch(). + + In the file-stream case, if strlen(b) = n, a match at file-position i + corresponds to the n characters in the file starting at position i + matching those of the string b. The null value is returned if no + match is found. The final file position will correspond to the + last character if a match is found, or the start (lowest) position + of the search interval if no match is found, except that if no + reading of characters is required (e.g. if start > end), the original + file-position is not changed. + + + Two- or Three-argument case: + + If a is not a file, the default value for c is size(a). If a is a + file, rsearch(a,b) = rsearch(a, b, ftell(a)), and + rsearch(a,b,) = rsearch(a, b, size(a)). + + If a is not a file, the search starts, if at all, at the largest + non-negative index i for which i <= c and i < size(a), and continues + until a match a[[i]] == b is found, or if accept() has been defined, + accept(a[[i]], b) tests as nonzero; if no such i is found and returned, + the null value is returned. + + If a is a file, the first, if any, file-position tested has the greatest + nonnegative position i such that i <= c and i <= size(a) - strlen(b). + The returned value is either the first i at which a match is found or + the null value if no match with the string b is found. The final + file-position will correspond to the last character of b, or the zero + position, according as a match is found or not found. EXAMPLE - > lst = list(2,"three",4i) - > rsearch(lst,"three") + > L = list(2,"three",4i) + > rsearch(L,"three") 1 - > rsearch(lst,"threes") - > rsearch(lst, 4i, 4) - > rsearch(lst, 4i, 1) - > rsearch(lst, 4i, 3) + > rsearch(L,"threes") + > rsearch(L, 4i, 4) + > rsearch(L, 4i, 1) 2 + > f = fopen("foo", "w+") + > fputs(f, "This file has 28 characters.") + > fflush(f) + > rsearch(f, "ha") + 18 + > ftell(f) + 19 + > rsearch(f, "ha", 17) + 10 + > rsearch(f, "ha", 9) + > ftell(f) + 0 + > rsearch(f, "ha") + 18 + > rsearch(f, "ha", 5, 500) + 18 + LIMITS none diff --git a/help/saveval b/help/saveval new file mode 100644 index 0000000..2845da0 --- /dev/null +++ b/help/saveval @@ -0,0 +1,48 @@ +NAME + saveval - enable or disable saving of values + +SYNOPSIS + saveval(arg) + +TYPES + arg any + + return null value + +DESCRIPTION + When evaluation of a line of statements at top level starts, a + "saved value" for that line is assigned the null value. When saving + is enabled (the initial state) and a statement being evaluated is an + expression or a return statement, the value returned by that expression + or statement replaces the current saved value; on completion of + evaluation of the line, the saved value, if it is not null, updates + the "oldvalue". + + This saving of values is enabled or disabled by calling saveval(arg) + with an argument arg that tests as nonzero or zero, + + Whether saving is enabled or disabled does not affect the operation of + eval(str). + +EXAMPLE + > saveval(1); + > a = 27; + . + 27 + > saveval(0); + > a = 45 + . + 27 + > saveval(1); + > a = 63 + . + 63 + +LIMITS + none + +LIBRARY + none + +SEE ALSO + oldvalue, eval diff --git a/help/search b/help/search index 7965ae5..bd55556 100644 --- a/help/search +++ b/help/search @@ -1,32 +1,118 @@ NAME - search - search a matrix, list or association for a value + search - search for an element satisfying a specified condition SYNOPSIS - search(x, val [,idx]) + search(a, b [, [c] [, [d] ] ]) TYPES - x matrix, &matrix, list, &list, assoc, &assoc - val any, &any - idx int + a matrix, list, association or file + b string if a is a file, otherwise any + c integer, defaults to zero or current file-position + d integer, defaults to size(a) or current file-position - return any + return nonnegative integer or null value DESCRIPTION - Searchs the matrix, list or association x for the value val. By - default, the search starts at index 0. If idx is given, the search - starts at index indx. - If the value is not found, this function returns nil. + Negative values of c and nonpositive values for d are treated as + offsets from size(a), i.e. as if c were replaced by size(a) + c, + and d by size(a) + d. Any such adjustment is assumed in the following + description. + + + For Non-file a: + + For a matrix, list, or association a, + search(a, b, c, d) returns, if it exists, the least index i for which + c <= i < d, 0 <= i < size(a), and, if accept() has not been defined, + a[[i]] == b, or if accept() has been defined, accept(a[[i]], b) + tests as nonzero. The null value is returned if there is no such i. + + For example, to search for the first a[[i]] > b an appropriate + accept() function is given by: + + define accept(v,b) = (v > b); + + To restore the original behavior of search(), one may then use + + define accept(v, b) = (v == b). + + Since the addresses (rather than values) of a and b are passed, + the values of v = x[[i]] and b may be changed during execution + of search(a, b, c, d), e.g. if accept(v,b) has been defined by + + define accept(v,b) = (v > b ? v-- : b++); + + + For a is a file-stream: + + c defaults to the current file-position if there are just two + arguments (a,b) or if there are four arguments as in (a,b, ,d) + where d is an integer. Otherwise c defaults to zero. + + d defaults to the current file-position or size(a) according as + the number of arguments (indicated by commas) is four or less + than four. + + If a is a file, a string formed by n successive characters in a + is considered to occur at the file position + of the first character. E.g. if a has the characters "123456", + the string "345" is said to occur at position 2. + + The file is searched forwards from file-position pos = c for + a match with b (not including the terminating '\0'). + Only characters with file-positions less than d are considered, + so the effective interval for the first-character position pos + for a matching string is limited by both c <= pos <= d - strlen(b) + and 0 <= pos < size(a) - strlen(b). + + The function returns pos if a match is found, and the reading position + for the stream after the search will then correspond to the position of + the terminating '\0' for the string b. + + The null value is returned if no match is found. If c, d, size(a) + and strlen(b) are such that no match is possible, no reading of the + file occurs and the current file-position is not changed. In a case + where characters are read, the final file-position will be + min(d, size(a)) - strlen(b) + 1, + i.e. the file will be at the first position where a match is impossible + because the specified search region has insufficient remaining characters. EXAMPLE - > lst = list(2,"three",4i) - > search(lst,"three") + > L = list(2,"three",4i) + > search(L,"three") 1 - > search(lst,"threes") - > search(lst, 4i, 4) - > search(lst, 4i, 1) + > search(L,"threes") + > search(L, 4i, 4) + > search(L, 4i, 1) 2 + > f = fopen("foo", "w+") + > fputs(f, "This file has 28 characters.") + > rewind(f) + > search(f, "ha") + 10 + > ftell(f) + 12 + > search(f, "ha") + 18 + > search(f, "ha") + > search(f, "ha",) + 10 + > search(f, "ha", 12) + 18 + > search(f, "ha", -10) + 18 + > search(f, "ha", ,) + 10 + > search(f, "ha", 11, 19) + > ftell(f) + 18 + > search(f, "ha", 11, 20) + 18 + > search(f, "ha", 5, 500) + 10 + LIMITS none @@ -35,3 +121,4 @@ LIBRARY SEE ALSO assoc, list, mat, rsearch + diff --git a/help/sha b/help/sha new file mode 100644 index 0000000..5583198 --- /dev/null +++ b/help/sha @@ -0,0 +1,100 @@ +NAME + sha - old Secure Hash Algorithm (SHS FIPS Pub 180) + +SYNOPSIS + sha([arg1 [, val ...]]) + +TYPES + arg1 any + val any + + return HASH or number + +DESCRIPTION + The sha() builtin implements the old Secure Hash Algorithm + (SHA). The SHA is sometimes referenced as SHS. The SHA + is a 160 bit hash. + + With no args, sha() returns the default initial SHA-1 HASH state. + + If arg1 is a HASH state and no other val args are given, then the + HASH state is finalized and the numeric value of the hash is given. + + If arg1 is a HASH state and one or more val args are given, + then the val args are used to modify the arg1 HASH state. + The new arg1 HASH state is returned. + + If arg1 is not a a HASH state, then the initial HASH is + used and modifed by arg1 and any val args supplied. The + return value is the new HASH state. + + The following table gives a summary of actions and return values. + Here, assume that 'h' is a HASH state: + + sha() HASH returns initial HASH state + + sha(h) number h is put into final form and the + numeric value of the hash state + + sha(x) HASH modify the initial state by hashing 'x' + + sha(sha(), x) HASH the same as sha(x) + + sha(x, y) HASH the same as sha(sha(x), y) + + sha(h, x, y) HASH modify state 'h' by 'x' and then 'y' + + sha(sha(h,x,y)) number numeric value of the above call + +EXAMPLE + > base(16) + 0xa + + > sha() + sha hash state + > sha(sha()) + 0xf96cea198ad1dd5617ac084a3d92c6107708c0ef + + > sha("x", "y", "z") == sha("xyz") + 1 + > sha("x", "y", "z") == sha("xy") + 0 + + > sha(sha("this is", 7^19-8, "a composit", 3i+4.5, "hash")) + 0x21e42319a26787046c2b28b7ae70f1b54bf0ba2a + + > x = sha(list(1,2,3), "curds and whey", 2^21701-1, pi()) + > x + sha hash state + > sha(x) + 0xc9e155522ea4a38d85340e6f1c2e36636950ea7e + + > y = sha() + > y = sha(y, list(1,2,3), "curds and whey") + > y = sha(y, 2^21701-1) + > y = sha(y, pi()) + > y + sha hash state + > sha(y) + 0xc9e155522ea4a38d85340e6f1c2e36636950ea7e + +LIMITS + none + +LIBRARY + HASH* hash_init(int, HASH*); + void hash_free(HASH*); + HASH* hash_copy(HASH*); + int hash_cmp(HASH*, HASH*); + void hash_print(HASH*); + ZVALUE hash_final(HASH*); + HASH* hash_long(int, long, HASH*); + HASH* hash_zvalue(int, ZVALUE, HASH*); + HASH* hash_number(int, void*, HASH*); + HASH* hash_complex(int, void*, HASH*); + HASH* hash_str(int, char*, HASH*); + HASH* hash_usb8(int, USB8*, int, HASH*); + HASH* hash_value(int, void*, HASH*); + +SEE ALSO + ishash, sha1 diff --git a/help/sha1 b/help/sha1 new file mode 100644 index 0000000..3f26a85 --- /dev/null +++ b/help/sha1 @@ -0,0 +1,100 @@ +NAME + sha1 - Secure Hash Algorithm (SHS-1 FIPS Pub 180-1) + +SYNOPSIS + sha1([arg1 [, val ...]]) + +TYPES + arg1 any + val any + + return HASH or number + +DESCRIPTION + The sha1() builtin implements the old Secure Hash Algorithm + (SHA). The SHA is sometimes referenced as SHS. The SHA + is a 160 bit hash. + + With no args, sha1() returns the default initial SHA-1 HASH state. + + If arg1 is a HASH state and no other val args are given, then the + HASH state is finalized and the numeric value of the hash is given. + + If arg1 is a HASH state and one or more val args are given, + then the val args are used to modify the arg1 HASH state. + The new arg1 HASH state is returned. + + If arg1 is not a a HASH state, then the initial HASH is + used and modifed by arg1 and any val args supplied. The + return value is the new HASH state. + + The following table gives a summary of actions and return values. + Here, assume that 'h' is a HASH state: + + sha1() HASH returns initial HASH state + + sha1(h) number h is put into final form and the + numeric value of the hash state + + sha1(x) HASH modify the initial state by hashing 'x' + + sha1(sha1(), x) HASH the same as sha1(x) + + sha1(x, y) HASH the same as sha1(sha1(x), y) + + sha1(h, x, y) HASH modify state 'h' by 'x' and then 'y' + + sha1(sha1(h,x,y)) number numeric value of the above call + +EXAMPLE + > base(16) + 0xa + + > sha1() + sha1 hash state + > sha1(sha1()) + 0xda39a3ee5e6b4b0d3255bfef95601890afd80709 + + > sha1("x", "y", "z") == sha1("xyz") + 1 + > sha1("x", "y", "z") == sha1("xy") + 0 + + > sha1(sha1("this is", 7^19-8, "a composit", 3i+4.5, "hash")) + 0xc3e1b562bf45b3bcfc055ac65b5b39cdeb6a6c55 + + > x = sha1(list(1,2,3), "curds and whey", 2^21701-1, pi()) + > x + sha1 hash state + > sha1(x) + 0x988d2de4584b7536aa9a50a5749707a37affa1b5 + + > y = sha1() + > y = sha1(y, list(1,2,3), "curds and whey") + > y = sha1(y, 2^21701-1) + > y = sha1(y, pi()) + > y + sha1 hash state + > sha1(y) + 0x988d2de4584b7536aa9a50a5749707a37affa1b5 + +LIMITS + none + +LIBRARY + HASH* hash_init(int, HASH*); + void hash_free(HASH*); + HASH* hash_copy(HASH*); + int hash_cmp(HASH*, HASH*); + void hash_print(HASH*); + ZVALUE hash_final(HASH*); + HASH* hash_long(int, long, HASH*); + HASH* hash_zvalue(int, ZVALUE, HASH*); + HASH* hash_number(int, void*, HASH*); + HASH* hash_complex(int, void*, HASH*); + HASH* hash_str(int, char*, HASH*); + HASH* hash_usb8(int, USB8*, int, HASH*); + HASH* hash_value(int, void*, HASH*); + +SEE ALSO + ishash, sha diff --git a/help/size b/help/size index 8296fe2..09f8aa9 100644 --- a/help/size +++ b/help/size @@ -15,12 +15,19 @@ DESCRIPTION null 0 real number 1 complex number 1 - string 1 + string length of string (not counding the trailing \0) matrix number of elements list number of members association number of (elements, value) pairs - object number of elements for the object-type of x - + object value returned by xx_size(x) if x of type xx + file length of the file in octets + rand state 1 + random state 1 + config state 1 + hash state 1 + block numer of octets of data it currently holds + octet 1 + named block numer of octets of data it currently holds EXAMPLE > print size(null()), size(3), size(2 - 7i), size("abc") @@ -36,9 +43,10 @@ EXAMPLE 3 > obj point {x,y} - > obj point P = {4,5} + > obj point P = {4,-5} + > define point_size(a) = abs(a.x) + abs(a.y) > print size(P) - 2 + 9 LIMITS none @@ -47,4 +55,4 @@ LIBRARY none SEE ALSO - list, mat, assoc, obj + list, mat, assoc, obj, sizeof, memsize diff --git a/help/sizeof b/help/sizeof index 516b16e..d377c6c 100644 --- a/help/sizeof +++ b/help/sizeof @@ -10,9 +10,19 @@ TYPES return integer DESCRIPTION - This is analogous to the C operator sizeof. It attempts to assess - the number of bytes in memory used to store a value and all its - components. + This is analogous to the C operator sizeof for the value only. + It attempts to assess the number of bytes in memory used to store + a value and all of its components. Unlike memsize(x), this + builtin does not include the size of the overhead. + + Unlike size(x), this builtin incldues the trailing \0 byte on the + end of strings. + + For numeric values, sizeof(x) ignores the demoninator if 'x' is + an integer. For complex values, sizeof(x) ignores the imaginary + part if 'x' is real. Because the 0, 1 and -1 numeric values are + shared static values, sizeof(x) reports such values as having + 0 bytes of storage. The number returned by sizeof(x) may be less than the actual number used because, for example, more memory may have been allocated for @@ -36,10 +46,12 @@ DESCRIPTION Similar sharing of memory occurs with literal strings. + For associative arrays, only the value part of the name/value pair + is counted. + The minimum value for sizeof(x) occurs for the null and error values. EXAMPLES - The results for examples like these will depend to some extent on the system being used. The following were for an SGI R4k machine in 32-bit mode: diff --git a/help/srand b/help/srand index c3f6ec7..c858d0e 100644 --- a/help/srand +++ b/help/srand @@ -10,7 +10,7 @@ TYPES return rand state DESCRIPTION - See the pseudo-random number using an additive 55 shuffle generator. + Seed the pseudo-random number using an additive 55 shuffle generator. For integer seed != 0: @@ -22,7 +22,7 @@ DESCRIPTION The following calc code produces the same effect on the internal additive table: - /* reload default additive table xored with low 64 seed bits */ + /* reload default additive table xor-ed with low 64 seed bits */ seed_xor = seed & ((1<<64)-1); for (i=0; i < 55; ++i) { additive[i] = xor(default_additive[i], seed_xor); @@ -58,7 +58,7 @@ DESCRIPTION between the seed and the production of the generator. The randreseed64 process does not reduce the security of the - rand genertator. Every seed is converted into a different + rand generator. Every seed is converted into a different unique seed. No seed is ignored or favored. See the rand help file for details. @@ -81,7 +81,7 @@ DESCRIPTION For matrix arg: Any buffered random bits are flushed. The additive table with the - first 55 entries of the martix mod 2^64. + first 55 entries of the matrix mod 2^64. The additive 55 pointers are reset to additive[23] and additive[54]. Last the shuffle table is loaded with successive values from the @@ -148,4 +148,4 @@ LIBRARY RAND *zsetrand(RAND *state) SEE ALSO - srand, randbit, isrand, random, srandom, israndom + srandom, randbit, isrand, random, srandom, israndom diff --git a/help/srandom b/help/srandom new file mode 100644 index 0000000..df2c0d5 --- /dev/null +++ b/help/srandom @@ -0,0 +1,340 @@ +NAME + srandom - seed the Blum-Blum-Shub pseudo-random number generator + +SYNOPSIS + srandom([state]) + srandom(seed) + srandom(seed, newn) + srandom(seed, ip, iq, trials) + +TYPES + state random state + seed integer + newn integer + ip integer + iq integer + trails integer + + return random state + +DESCRIPTION + Seed the pseudo-random number using the Blum-Blum-Shub generator. + + There are two primary values contained inside generator state: + + Blum modulus: + + A product of two primes. Each prime is 3 mod 4. + + Quadratic residue: + + Some integer squared modulo the Blum modulus. + + Seeding the generator involves changing the Quadratic residue + and in most cases the Blum modulus as well. + + In addition to the two primary values values, an internal buffer of + unused random output is kept. When the generator is seeded, any + buffered random output is tossed. + + In each of the following cases, srandom returns the previous state + of the generator. Depending on what args are supplied, a new + generator state is established. The exception is the no-arg state. + + 0 args: srandom() + + Returns the current generator state. Unlike all of the other + srandom calls, this call does not modify the generator, nor + does it flush the internal bits. + + 1 arg (state arg): srandom(state) + + sets the generator to 'state', where 'state' is a previous + return of srandom(). + + 1 arg (0 seed): srandom(0) + + Sets the generator to the initial startup state. This a + call of srandom(0) will restore the generator to the state + found when calc starts. + + 1 arg (seed >= 2^32): srandom(21609139158123209^9+17) + + The seed value is used to compute the new quadratic residue. + The seed passed will be successively squared mod the Blum + modulus until we get a smaller value (modulus wrap). The + calc script produces an equivalent effect: + + /* assume n is the current Blum modulus */ + r = seed; + do { + last_r = r; + r = pmod(r, 2, n); + } while (r > last_r); + /* r is the new Quadratic residue */ + + In this form of srandom, the Blum modulus is not changed. + + NOTE: [1,2^32) seed values and seed<0 values + are reserved for future use. + + 2 args (seed, newn>=2^32): srandom(seed, newn) + + The newn value is used as the new Blum modulus. This modulus + is assumed to be a product of two primes that are both 3 mod + 4. The newn value is not factored, it is only checked to see + if it is 1 mod 4. + + In this call form, newn value must be >= 2^32. + + The seed arg is used to establish the initial quadratic value + once newn has been made the Blum moduli. The seed must + be either 0 or >= 2^32. If seed == 0, the initial quadratic + residue used with srandom(0) is used with the new Blum moduli. + If seed >= 2^32, then srandom(seed, newn) has the same effect as: + + srandom(0, newn); /* set Blum modulus & def quad res */ + srandom(seed); /* set quadratic residue */ + + Use of newn values that are not the product of two 3 mod 4 + primes will result in a non-cryptographically strong generator. + While the generator will produce values, their quality will + be suspect. + + The period of the generator determines how many bits will + be produced before it repeats. The period is determined + by the Blum modulus. Some newn values (that are a product + of two 3 mod 4 primes) can produce a generator with a + very short period making is useless for most applications. + + When Blum modulus is p*q, the period of a generator is: + + lcm(factors of p-1 and 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. Assuming that + fp=(p-1)/2, fq=(q-1)/2, p and q are all primes 3 mod 4, the + period of the generator is the longest possible: + + lcm(factors of p-1 and q-1) == lcm(2,fp,2,fq) = 2*fp*fq = ~n/2 + + The following calc script: + + /* find first Blum prime: p */ + fp = int((ip-1)/2); + do { + do { + fp = nextcand(fp+2, 1, 0, 3, 4); + p = 2*fp+1; + } while (ptest(p, 1, 0) == 0); + } while (ptest(p, trials) == 0 || ptest(fp, trials)); + + /* find second Blum prime: q */ + fq = int((iq-1)/2); + do { + do { + fq = nextcand(fq+2, 1, 0, 3, 4); + q = 2*fq+1; + } while (ptest(q, 1, 0) == 0); + } while (ptest(q, trials) == 0 || ptest(fq, trials)); + + /* seed the generator */ + srandom(ir, p*q); + + Where: + ip + initial search location for the Blum prime 'p' + iq + initial search location for the Blum prime 'q' + ir + initial Blum quadratic residue generator. The 'ir' + must be 0 or >= 2^32, preferably large some random + value < p*q. The following may be useful to set ir: + + srand(p+q); + ir = randbit(highbit(p)+highbit(q)) + trials + number of pseudo prime tests that a candidate must pass + before being considered a probable prime (must be >0, try 25) + + The calc library script seedrandom.cal will produce a seed a + generator. If the global value lib_debug is 0 or 1, then + the selected Blum modulus and quadratic residue will be printed. + If the global value is 1, then p and q are also printed. + The script defines the function: + + seedrandom(seed1, seed2, size [, trials]) + + Where: + seed1 + A random number >= 10^20 and perhaps < 10^93. + seed2 + A random number >= 10^20 and perhaps < 10^93. + size + Minimal Blum modulus size in bits, This must be >= 32. + A value of 512 might be a good choice. + trials + number of pseudo prime tests that a candidate must pass + before being considered a probable prime (must be >0, try 25). + Using the default value of 25 might be a good choice. + + Unfortunately finding optimal values can be very slow for large + values of 'p' and 'q'. On a 200Mhz r4k, it can take as long as + 1 minute at 512 bits, and 5 minutes at 1024 bits. + + For the sake of speed, you may want to use to use one of the + pre-compiled in Blum moduli via the [1 + If you don't want to use a pre-compiled in Blum moduli you can + compute your own values ahead of time. This can be done by a + method of your own choosing, or by using the seedrandom.cal + script in the following way: + + 1) calc # run calc + 2) read seedrandom # load seedrandom + 3) lib_debug=0 # we want the modulus and quad res only + 4) seedrandom( ~pound out 20-93 random digits on the keyboard~, + ~pound out 20-93 random digits on the keyboard~, + 512 ) + 5) save the seed and newn values for later use + + NOTE: [1,2^32) seed values, seed<0 values, [21,2^32) newn values + and newn<=0 values are reserved for future use. + + 2 args (seed, 1>=newn>=20): srandom(seed, newn) + + The newn is used to select one of 20 pre-computed Blum moduli. + + The seed arg is used to establish the initial quadratic value + once newn has been made the Blum moduli. The seed must be + either 0 or >= 2^32. If seed == 0, the pre-compiled quadratic + residue for the given newn is selected. If seed >= 2^32, then + srandom(seed, newn) has the same effect as: + + srandom(0, newn); /* set Blum modulus & def quad res */ + srandom(seed); /* set quadratic residue */ + + Note that unlike the newn>=2^32 case, a seed if 0 uses the + pre-compiled quadratic residue for the selected pre-compiled + Blum moduli. + + The pre-defined Blum moduli and quadratic residues were selected + by lavarand, a hardware random number generator. See the URL: + + http://lavarand.sgi.com + XXX - This URL is not available on 17Feb97 ... but will be soon. + + for an explanation of how the lavarand random number generator works. + For more information, see the comments at the top of the calc + source file, zrandom.c. + + The purpose of these pre-defined Blum moduli is to provide users with + an easy way to use a generator where the individual Blum primes used + are not well known. True, these values are in some way "MAGIC", on + the other hand that is their purpose! If this bothers you, don't + use them. + + The value 'newn' determines which pre-defined generator is used. + + newn == 1: (Blum modulus bit length 130) + newn == 2: (Blum modulus bit length 137) + newn == 3: (Blum modulus bit length 147) + newn == 4: (Blum modulus bit length 157) + newn == 5: (Blum modulus bit length 257) + newn == 6: (Blum modulus bit length 259) + newn == 7: (Blum modulus bit length 286) + newn == 8: (Blum modulus bit length 294) + newn == 9: (Blum modulus bit length 533) + newn == 10: (Blum modulus bit length 537) + newn == 11: (Blum modulus bit length 542) + newn == 12: (Blum modulus bit length 549) + newn == 13: (Blum modulus bit length 1048) + newn == 14: (Blum modulus bit length 1054) + newn == 15: (Blum modulus bit length 1055) + newn == 16: (Blum modulus bit length 1062) + newn == 17: (Blum modulus bit length 2062) + newn == 18: (Blum modulus bit length 2074) + newn == 19: (Blum modulus bit length 2133) + newn == 20: (Blum modulus bit length 2166) + + See the comments near the top of the source file, zrandom.c, for the + actual pre-compiled values. + + The Blum moduli associated with 1 <= newn < 9 are subject + to having their Blum moduli factored, depending in their size, + by small PCs in a reasonable to large supercomputers/highly + parallel processors over a long time. Their value lies in their + speed relative the the default Blum generator. As of Feb 1997, + the Blum moduli associated with 13 <= newn < 20 appear to + be well beyond the scope of hardware and algorithms, + and 9 <= newn < 12 might be factorable with extreme difficulty. + + The following table may be useful as a guide for how easy it + is to factor the modulus: + + 1 <= newn <= 4 PC using ECM in a short amount of time + 5 <= newn <= 8 Workstation using MPQS in a short amount of time + 8 <= newn <= 12 High end supercomputer or high parallel processor + using state of the art factoring over a long time + 12 <= newn <= 16 Beyond Feb 1997 systems and factoring methods + 17 <= newn <= 20 Well beyond Feb 1997 systems and factoring methods + + In other words, use of newn == 9, 10, 11 and 12 is likely to + work just fine for all but the truly paranoid. + + NOTE: [1,2^32) seed values, seed<0 values, [21,2^32) newn values + and newn<=0 values are reserved for future use. + + 4 args (seed, ip>=2^16, iq>=2^16, trials): srandom(seed, ip, iq, 25) + + The 'ip' and 'iq' args are used to find simples prime 3 mod 4 + + The call srandom(seed, ip, iq, trials) has the same effect as: + + srandom(seed, + nextcand(ip, trials,0, 3,4)*nextcand(iq, trials,0, 3,4)); + + Note that while the newn is very likely to be a product of + two primes both 3 mod 4, there is no guarantee that the period + of the generator will be long. The likelihood is that the + period will be long, however. See one of the 2 arg srandom + calls above for more information on this issue. + + NOTE: [1,2^32) seed values, seed<0 values, [21,2^32) newn values, + newn<=0 values, ip<2^16 and iq<2^16 are reserved for future use. + + See the random help file for details on the generator. + +EXAMPLE + > srandom(0x8d2dcb2bed3212844f4ad31) + RANDOM state + > state = srandom(); + > print random(123), random(123), random(123), random(123), random(123) + 42 58 57 82 15 + > print random(123), random(123), random(123), random(123), random(123) + 90 121 109 114 80 + > state2 = srandom(state); + > print random(123), random(123), random(123), random(123), random(123) + 42 58 57 82 15 + > print random(123), random(123), random(123), random(123), random(123) + 90 121 109 114 80 + > state3 = srandom(); + > print state3 == state2; + 1 + > print random(); + 2101582493746841221 + +LIMITS + integer seed == 0 or >= 2^32 + for newn >= 2^32: newn % 4 == 1 + for small newn: 1 <= newn <= 20 + ip >= 2^16 + iq >= 2^16 + +LIBRARY + RAND *zsrandom(ZVALUE *pseed, MATRIX *pmat55) + RAND *zsetrandom(RAND *state) + +SEE ALSO + srand, randbit, isrand, random, srandom, israndom diff --git a/help/strerror b/help/strerror index 984055b..861d2df 100644 --- a/help/strerror +++ b/help/strerror @@ -2,29 +2,46 @@ NAME strerror - returns a string describing an error value SYNOPSIS - strerror(x) + strerror([x]) TYPES - x error-value or non-negative integer + x error-value or integer in [0, 32767], defaults to errno() - return string or error-value + return string DESCRIPTION - If x is an error-value, strerror(x) returns a string describing that value. + If x is the error-value with index n, strerror(x) and strerror(n) + return one of: - If x is an integer within the ranges for system, builtin, and user - defined error codes, the string describing error(x) is returned. - For integers outside these ranges, an "index out of range for - strerror" error is returned. + a system-generated message, + a calc-generated description, + a user-defined description created by newerror(str), + the string "Error n", + + where, in the last form, n is represented decimally. EXAMPLE - > strerror(7) - "Bad argument for unary -" + System error messages may be different for different systems. + > errmax(errcount()+3) + 0 + > strerror(2) + "No such file or directory" > x = 3 * ("a" + "b") > print strerror(x) Bad arguments for + + > a = newerror("alpha") + > print strerror(a) + alpha + + > print strerror(999) + Error 999 + + > a = 1/0 + > print strerror() + Division by zero + LIMITS none @@ -32,4 +49,4 @@ LIBRARY none SEE ALSO - error, iserror, errno + errcount, errmax, error, iserror, errno, newerror, errorcodes diff --git a/help/sum b/help/sum new file mode 100644 index 0000000..c68653d --- /dev/null +++ b/help/sum @@ -0,0 +1,60 @@ +NAME + sum - sum, or sum of defined sums + +SYNOPSIS + sum(x_1, x_2, ...) + +TYPES + x_1, x_2, ... any + + return any + +DESCRIPTION + If an argument x_i is a list with elements e_1, e_2, ..., e_n, it + is treated as if x_i were replaced by e_1, e_2, ..., e_n; this may + continue recurively if any of the e_j is a list. + + If an argument x_i is an object of type xx, then x_i is replaced by + xx_sum(x_i) if the function xx_sum() has been defined. If the + type xx has been defined by: + + obj xx = {x, y, z}, + + an appropriate definition of xx_sum(a) is sometimes a.x + a.y + a.z. + sum(a) then returns the sum of the elements of a. + + If x_i has the null value, it is ignored. Thus, sum(a, , b, , c) + will return the same as sum(a, b, c). + + Assuming the above replacements, and that the x_1, x_2, ..., are + of types for which addition is defined, sum(x_1, x_2, ...) returns + the sum of the arguments. + +EXAMPLE + > print sum(2), sum(5, 3, 7, 2, 9), sum(3.2, -0.5, 8.7, -1.2, 2.5) + 2 26 12.7 + + > print sum(list(3,5), 7, list(6, list(7,8), 2)) + 38 + + + > obj point {x, y} + > define point_add(a,b) = obj point = {a.x + b.x, a.y + b.y} + > obj point A = {1, 5} + > obj point B = {1, 4} + > obj point C = {3, 3} + > print sum(A, B, C) + obj point {5, 12} + + > define point_sum(a) = a.x + > print sum(A, B, C) + 5 + +LIMITS + The number of arguments is not to exceed 100. + +LIBRARY + NUMBER *qmin(NUMBER *x1, NUMBER *x2) + +SEE ALSO + max, obj diff --git a/help/test b/help/test new file mode 100644 index 0000000..3fbb1f4 --- /dev/null +++ b/help/test @@ -0,0 +1,56 @@ +NAME + test - whether a value is deemed to be true or false + +SYNOPSIS + test(x) + +TYPES + x any + + return 0 or 1 + +DESCRIPTION + This function returns 1 or 0 according as x tests as "true" or "false". + + Conditions under which a value x is considered to be false are: + + Numbers (real or complex): x is zero + + String: x == "" + + Matrix: every component of x tests as false + + List: every element of x tests as false + + Association: x has no element + + File: x is not open + + Null: always + + Object of type xx: if xx_test has been defined, xx_test(x) + returns zero; if xx_test has not been defined, + every element of x tests as false. + + Error-value or other types: never + +EXAMPLE + > print test(27), test(0), test("abc"), test("") + 1 0 1 0 + + > print test(mat[3] = {1,,2}), test(mat[2][2]) + 1 0 + + > A = list(0, 2, 0) + > print test(A), test(pop(A)), test(A), test(pop(A)), test(A) + 1 0 1 1 0 + +LIMITS + none + +LIBRARY + none + +SEE ALSO + isassoc, isfile, isident, isnum, isint, islist, ismat, isnull, isobj, + isreal, isstr, issimple, istype diff --git a/help/todo b/help/todo index 90fd1b6..7cf144f 100644 --- a/help/todo +++ b/help/todo @@ -32,7 +32,9 @@ Needed enhancements * Figure out how to write all variables out to a file, including deeply nested arrays, lists, and objects. - * Implement pointers. + Add the ability to read and write a value in some binary form. + Clearly this is easy for non-neg integers. The question of + everything else is worth pondering. * Eliminate the need for the define keyword by doing smarter parsing. @@ -42,9 +44,6 @@ Needed enhancements * Add some kind of #include and #define facility. Perhaps use the C pre-processor itself? - * Allow one to undefine anything. Allow one to test if anything - is defined. - * Support a more general input and output base mode other than just dec, hex or octal. @@ -137,39 +136,6 @@ Needed enhancements could save the result of cmdnum() in a variable and later use it as an arg to the histval() or history() functions. - * Add a builtin to determine if an object as been defined. - For example: - - isobjdef("surd") - - would return true if one had previously defined the - surd object. I.e., if "obj surd {...};" had been - executed. - - One cannot redefine an object. If a script defines an object, - one cannot reload it without getting lots of already defined - errors. If two scripts needed the same object, both could - define it and use isobjdef() to avoid redefinition problems. - - * Add a builtin to determine if a function as been defined. - For example: - - isfunct("foo") - - would return true if foo has been defined as a function. - - * Permit one to destroy an object. - - What if one does want to redefine an object? Consider the case - where one it debugging a script and wants to reload it. If - that script defines an object you are doomed. Perhaps - destroying a object would undefine all of its related functions - and values? - - * Add NAN (Not A Number) to calc. Where is it reasonable, change - calc to process these values in way similar to that of the IEEE - floating point. - * Add a factoring builtin functions. Provide functions that perform multiple polynomial quadratic sieves, elliptic curve, difference of two squares, N-1 factoring as so on. Provide a easy general @@ -202,32 +168,12 @@ Needed enhancements fold output. Another option should be to append a trailing \ on folded lines (as some symbolic packages use). - * Add the ability to read and write a value in some binary form. - - Clearly this is easy for non-neg integers. The question of - everything else is worth pondering. - * Allow one to use the READ and WRITE commands inside a function. * Remove or increase limits on factor(), lfactor(), isprime(), nextprime(), and prevprime(). Currently these functions cannot search for factors > 2^32. - * Make the cryrand functions, or some useful subset builtin - functions. This is needed for speed reasons. - - The additive 55 / shuffle generators in cryrand.cal have - been turned into the rand() builtin function. The main - crypto / Blum-Blum-Shub generators still need to be - converted into builtin functions. - - * Add a builtin to generate random primes using methods suggested - by Ueli M. Maurer: "Fast Generation of Prime Numbers and - Secure Public-Key Cryptographic Parameters" 9 Sep 1991. - Such a builtin would be useful to generate large primes. - - * Be sure that regress.cal tests every builtin function. - * Add read -once -try "filename" which would do nothing if "filename" was not a readable file. @@ -250,3 +196,42 @@ Needed enhancements at by 'fizbin' and the HALF array pointer at by 'data' should be treated as read-only. + * Blocks should have the following features: + + + read/write to/from files (ala fread/fwrite) + + + misc memory functions (ala memcpy, memcmp, memset, + memchr, etc.) + + + scatter and gather functions (to send every n-th octet + to another block and to copy from n blocks, the 1st + then 2nd then 3rd ... octets) + + * Printing of blocks should be under the control of the + config() interface. This should allow one to select + from any of the following formats: + + + as one long string + + + as a series of lines (< 80 chars wide) + + + in od command style (offset: value value value ...) + + + in hex dump style (offset: val val val val ... 3hf.Uas.c) + + * In addition one should be able to control the following + aspects of printing blocks via the config() interface: + + + base (hex, octal, char, base 2) + + + amount of data (the first n octets or the entire block) + + + skipping printing of duplicate print lines (ala od) + + + have the ability to print the block as raw data + + * It is overkill to have nearly everything wind up in libcalc.a. + + One should make available a the fundimental math operations + on ZVALUE, NUMBER and perhaps COMPLEX (without all of the + other stuff) in a separate library. diff --git a/help/unexpected b/help/unexpected new file mode 100644 index 0000000..f3dc2b1 --- /dev/null +++ b/help/unexpected @@ -0,0 +1,242 @@ +Unexpected + + While calc is C-like, users of C will find some unexpected + surprises in calc syntax and usage. Persons familiar with C should + review this file. + + + The Comma + ========= + + The comma is also used for continuation of obj and mat creation + expressions and for separation of expressions to be used for + arguments or values in function calls or initialization lists. The + precedence order of these different uses is: continuation, + separator, comma operator. For example, assuming the variables a, + b, c, d, e, and object type xx have been defined, the arguments + passed to f in: + + f(a, b, c, obj xx d, e) + + are a, b, c, and e, with e having the value of a newly created xx + object. In: + + f((a, b), c, (obj xx d), e) + + the arguments of f are b, c, d, e, with only d being a newly + created xx object. + + In combination with other operators, the continuation use of the + comma has the same precedence as [] and ., the separator use the + same as the comma operator. For example, assuming xx.mul() has + been defined: + + f(a = b, obj xx c, d = {1,2} * obj xx e = {3,4}) + + passes two arguments: a (with value b) and the product d * e of two + initialized xx objects. + + + ^ is not xor + ============ + + In C, ^ is the xor operator. Like the '**', '^' is the + exponentiation operator. The expression: + + a^b + + yields "a to the b power", NOT "a xor b". + + Note that 'b' must be an integer. Also if 'a' == 0, 'b' + must be >= 0 as well. + + To raise to a non-integer power, use the power() builtin function. + + + ** is exponentiation + ==================== + + As was suggested in the '^ is not xor' section, the expression: + + a**b + + yields "a to the b power", NOT "a xor b". + + Note that 'b' must be an integer. Also if 'a' == 0, 'b' + must be >= 0 as well. + + To raise to a non-integer power, use the power() builtin function. + + + op= operators associate left to right + ===================================== + + Operator-with-assignments: + + += -= *= /= %= //= &= |= <<= >>= ^= **= + + associate from left to right instead of right to left as in C. + For example: + + a += b *= c + + has the effect of: + + a = (a + b) * c + + where only 'a' is required to be an lvalue. For the effect of: + + b *= c; a += b + + when both 'a' and 'b' are lvalues, use: + + a += (b *= c) + + + || yields values other than 0 or 1 + ================================== + + In C: + + a || b + + will produce 0 or 1 depending on the logical evaluation + of the expression. In calc, this expression will produce + either 'a' or 'b' and is equivalent to the expression: + + a ? a : b + + In other words, if 'a' is true, then 'a' is returned, otherwise + 'b' is returned. + + + && yields values other than 0 or 1 + ================================== + + In C: + + a && b + + will produce 0 or 1 depending on the logical evaluation + of the expression. In calc, this expression will produce + either 'a' or 'b' and is equivalent to the expression: + + a ? b : a + + In other words, if 'a' is true, then 'b' is returned, otherwise + 'a' is returned. + + + / is fractional divide, // is integral divide + ============================================= + + In C: + + x/y + + performs integer division when 'x' and 'y' are integer types. + In calc, this expression yields a rational number. + + Calc uses: + + x//y + + to perform division with integer truncation and is the equivalent to: + + int(x/y) + + + | and & have higher precedence than ==, +, -, *, / and % + ======================================================== + + Is C: + + a == b | c * d + + is interpreted as: + + (a == b) | (c * d) + + and calc it is interpreted as: + + a == ((b | c) * d) + + + calc always evaluates terms from left to right + ============================================== + + Calc has a definite order for evaluation of terms (addends in a + sum, factors in a product, arguments for a function or a matrix, + etc.). This order is always from left to right. but skipping of + terms may occur for ||, && and ? : . + + Consider, for example: + + A * B + C * D + + In calc above expression is evaluated in the following order: + + A + B + A * B + C + D + C * D + A * B + C * D + + This order of evaluation is significant if evaluation of a + term changes a variable on which a later term depends. For example: + + x++ * x++ + x++ * x++ + + in calc returns the value: + + x * (x + 1) + (x + 2) * (x + 3) + + and increments x as if by x += 4. Similarly, for functions f, g, + the expression: + + f(x++, x++) + g(x++) + + evaluates to: + + f(x, x + 1) + g(x + 2) + + and increments x three times. + + + &A[0] and A are different things in calc + ======================================== + + In calc, value of &A[0] is the address of the first element, whereas + A is the entire array. + + + *X may be used to to return the value of X + ========================================== + + If the current value of a variable X is an octet, number or string, + *X may be used to to return the value of X; in effect X is an + address and *X is the value at X. + + + freeing a variable has the effect of assigning the null value to it + =================================================================== + + The freeglobals(), freestatics(), freeredc() and free() free + builtins to not "undefine" the variables, but have the effect of + assigning the null value to them, and so frees the memory used for + elements of a list, matrix or object. + + Along the same lines: + + undefine * + + undefines all current user-defined functions. After executing + all the above freeing functions (and if necessary free(.) to free + the current "old value"), the only remaining numbers as displayed by + + show numbers + + should be those associated with epsilon(), and if it has been + called, qpi(). diff --git a/help/usage b/help/usage index 119d934..8053705 100644 --- a/help/usage +++ b/help/usage @@ -2,12 +2,25 @@ Calc command line Calc has the following command line: - calc [-h] [-m mode] [-p] [-q] [-u] [calc_command ...] + calc [-C] [-e] [-h] [-i] [-m mode] [-n] [-p] [-q] [-u] [calc_cmd ...] + + -C Permit the execution of custom builtin functions. Without + this flag, calling the custom() builtin function will + simply generate an error. + + Use if this flag may cause calc to execute functions that + are non-standard and that are not portable. Custom builtin + functions are disabled by default for this reason. + + -e Ignore any environment variables on startup. The + getenv() builtin will still return values, however. -h Print a help message. This option implies -q. This is equivalent to the calc command help help. The help facility is disabled unless the mode is 5 or 7. See -m. + -i Do not about if the error count exceeds maxerr(). + -m mode This flag sets the permission mode of calc. It controls the ability for calc to open files and execute @@ -46,6 +59,10 @@ Calc command line given. The reading of key bindings is also disabled when the mode disables opening of files for reading. + -n Use the new configutation defaults instead of the old + default classic defaults. This flag as the same effect + as executing config("all", "newcfg") at startup time. + -p Pipe processing is enabled by use of -p. For example: echo "print 2^21701-1, 2^23209-1" | calc -p | fizzbin @@ -57,8 +74,8 @@ Calc command line -u Disable buffering of stdin and stdout. - Without calc_cmds, calc operates interactively. If one or more - calc_cmds are given on the command line, calc will execute them and + Without `calc_cmd', calc operates interactively. If one or more + `calc_cmd' are given on the command line, calc will execute them and exit. The printing of leading tabs on output is disabled as if config("tab",0) had been executed. @@ -87,6 +104,8 @@ Calc command line For more information use the following calc commands: - help usage help help + help overview + help usage help environment + help config diff --git a/hist.c b/hist.c index 6b4514a..0239965 100644 --- a/hist.c +++ b/hist.c @@ -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. * @@ -48,6 +48,7 @@ # include #endif +extern FILE *curstream(void); #define STDIN 0 #define SAVE_SIZE 256 /* size of save buffer */ @@ -1135,11 +1136,11 @@ static void list_history(void) { HIST *hp; - int num; + int hnum; - for (num = 0; num < HS.histcount; num++) { - hp = get_event(num); - printf("\n%3d: ", HS.histcount - num); + for (hnum = 0; hnum < HS.histcount; hnum++) { + hp = get_event(hnum); + printf("\n%3d: ", HS.histcount - hnum); echo_string(hp->data, hp->len); } refresh_line(); @@ -1378,6 +1379,7 @@ quit_calc(void) { hist_term(); putchar('\n'); + libcalc_call_me_last(); exit(0); } diff --git a/hist.h b/hist.h index 12a7604..f66043b 100644 --- a/hist.h +++ b/hist.h @@ -1,13 +1,15 @@ /* - * Copyright (c) 1993 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. * * Definitions for command history module. */ -#if !defined(_HIST_H_) -#define _HIST_H_ + +#if !defined(__HIST_H__) +#define __HIST_H__ + /* * Default binding file and history size. @@ -47,4 +49,5 @@ extern void hist_term(void); extern int hist_getline(char *prompt, char *buf, int len); extern void hist_saveline(char *line, int len); -#endif /* _HIST_H_ */ + +#endif /* !__HIST_H__ */ diff --git a/input.c b/input.c index 56f2720..70eb38e 100644 --- a/input.c +++ b/input.c @@ -7,6 +7,7 @@ * For terminal input, this also provides a simple command stack. */ +#include #include #include #include @@ -16,6 +17,8 @@ #include "hist.h" extern int stdin_tty; /* TRUE if stdin is a tty */ +extern FILE *f_open(char *name, char *mode); +extern FILE *curstream(void); #define TTYSIZE 100 /* reallocation size for terminal buffers */ diff --git a/jump.h b/jump.h index 8340036..6d94078 100644 --- a/jump.h +++ b/jump.h @@ -1,5 +1,5 @@ /* - * Copyright (c) 1996 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, @@ -56,8 +56,8 @@ * average reduces the values we need to test by a factor of at least 2.4. */ -#if !defined(JUMP_H) -#define JUMP_H +#if !defined(__JUMP_H__) +#define __JUMP_H__ #include "have_const.h" @@ -93,4 +93,4 @@ extern CONST short jmpindx[]; extern CONST unsigned char jmp[]; extern CONST unsigned char *CONST lastjmp; -#endif /* !JUMP_H */ +#endif /* !__JUMP_H__ */ diff --git a/label.c b/label.c index 82ebb66..8d051e1 100644 --- a/label.c +++ b/label.c @@ -44,7 +44,7 @@ definelabel(char *name) i = findstr(&labelnames, name); if (i >= 0) { lp = &labels[i]; - if (lp->l_offset) { + if (lp->l_offset >= 0) { scanerror(T_NULL, "Label \"%s\" is multiply defined", name); return; @@ -57,7 +57,7 @@ definelabel(char *name) return; } lp = &labels[labelcount++]; - lp->l_chain = 0; + lp->l_chain = -1L; lp->l_offset = (long)curfunc->f_opcodecount; lp->l_name = addstr(&labelnames, name); clearopt(); @@ -90,8 +90,8 @@ addlabel(char *name) return; } lp = &labels[labelcount++]; - lp->l_offset = 0; - lp->l_chain = 0; + lp->l_offset = -1L; + lp->l_chain = -1L; lp->l_name = addstr(&labelnames, name); uselabel(lp); } @@ -107,7 +107,7 @@ checklabels(void) long i; /* counter */ for (i = labelcount, lp = labels; --i >= 0; lp++) { - if (lp->l_offset > 0) + if (lp->l_offset >= 0) continue; scanerror(T_NULL, "Label \"%s\" was never defined", lp->l_name); @@ -124,8 +124,8 @@ checklabels(void) void clearlabel(LABEL *lp) { - lp->l_offset = 0; - lp->l_chain = 0; + lp->l_offset = -1L; + lp->l_chain = -1L; lp->l_name = NULL; } @@ -142,19 +142,19 @@ void setlabel(LABEL *lp) { register FUNC *fp; /* current function */ - unsigned long curfix; /* offset of current location being fixed */ - unsigned long nextfix; /* offset of next location to fix up */ - unsigned long offset; /* offset of this label */ + long curfix; /* offset of current location being fixed */ + long nextfix; /* offset of next location to fix up */ + unsigned long offset; /* offset of this label */ fp = curfunc; offset = fp->f_opcodecount; - nextfix = lp->l_chain; - while (nextfix > 0) { + nextfix = (long)lp->l_chain; + while (nextfix >= 0) { curfix = nextfix; - nextfix = fp->f_opcodes[curfix]; + nextfix = (long)fp->f_opcodes[curfix]; fp->f_opcodes[curfix] = offset; } - lp->l_chain = 0; + lp->l_chain = -1L; lp->l_offset = (long)offset; clearopt(); } @@ -175,7 +175,7 @@ uselabel(LABEL *lp) unsigned long offset; /* offset being added */ offset = curfunc->f_opcodecount; - if (lp->l_offset > 0) { + if (lp->l_offset >= 0) { curfunc->f_opcodes[curfunc->f_opcodecount++] = lp->l_offset; return; } diff --git a/label.h b/label.h index e2cba65..bbcb34c 100644 --- a/label.h +++ b/label.h @@ -1,11 +1,12 @@ /* - * Copyright (c) 1993 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. */ -#ifndef LABEL_H -#define LABEL_H + +#if !defined(__LABEL_H__) +#define __LABEL_H__ #include "zmath.h" @@ -32,6 +33,5 @@ extern void setlabel(LABEL *lp); extern void uselabel(LABEL *lp); extern void checklabels(void); -#endif -/* END CODE */ +#endif /* !__LABEL_H__ */ diff --git a/lib/Makefile b/lib/Makefile index 99007df..a71eda2 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -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 diff --git a/lib/README b/lib/README index 08369bd..afd66c1 100644 --- a/lib/README +++ b/lib/README @@ -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. diff --git a/lib/beer.cal b/lib/beer.cal new file mode 100644 index 0000000..81f8343 --- /dev/null +++ b/lib/beer.cal @@ -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! */ +} diff --git a/lib/bernoulli.cal b/lib/bernoulli.cal index a5b0ec1..fcf7dad 100644 --- a/lib/bernoulli.cal +++ b/lib/bernoulli.cal @@ -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"; } diff --git a/lib/bigprime.cal b/lib/bigprime.cal index f11cb7a..0a1e9d6 100644 --- a/lib/bigprime.cal +++ b/lib/bigprime.cal @@ -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"; } diff --git a/lib/chrem.cal b/lib/chrem.cal index 458eed0..c4ffdff 100644 --- a/lib/chrem.cal +++ b/lib/chrem.cal @@ -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"; } diff --git a/lib/cryrand.cal b/lib/cryrand.cal deleted file mode 100644 index d96d778..0000000 --- a/lib/cryrand.cal +++ /dev/null @@ -1,1645 +0,0 @@ -/* - * cryrand - cryptographically strong pseudo-romandom number generator library - */ -/* - * Copyright (c) 1995 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 text - * this comment, 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. - * - * chongo was here /\../\ - */ - -/* - * XXX - Be sure that lambda(n) = lcm(factors of p-1 & q-1) is large - * for the default case. - * - * XXX - discuss lambda(n) - * - * XXX - In a future version of calc, these functions will become builtins. - * Some cleanup and simplification will also occur. - */ - -/* - * These routines are written in the calc language. At the time of this - * notice, calc was at version 2.9.2 (We refer to calc, as in the C - * program, not the Emacs subsystem). - * - * Calc is available by anonymous ftp from ftp.uu.net under the - * directory /pub/calc. - * - * If you can't get calc any other way, EMail a request to my EMail - * address as shown below. - * - * Comments, suggestions, bug fixes and questions about these routines - * are welcome. Send EMail to the address given below. - * - * Happy bit twiddling, - * - * Landon Curt Noll - * - * chongo@toad.com - * ...!{pyramid,sun,uunet}!hoptoad!chongo - */ - -/* - * AN OVERVIEW OF THE FUNCTIONS: - * - * This calc library contains a sample implementation of the crypto generator: - * - * cryrand - produce a cryptographically strong pseudo-random number - * scryrand - seed the crypto generator - * random - produce a cryptographically strong pseudo-random number - * over a given range - * srandom - seed random - * - * This generator is described in the papers: - * - * Blum, Blum, and Shub, "Comparison of Two Pseudorandom Number - * Generators", in Chaum, D. et. al., "Advances in Cryptology: - * Proceedings Crypto 82", pp. 61-79, Plenum Press, 1983. - * - * Blum, Blum, and Shub, "A Simple Unpredictable Pseudo-Random - * Number Generator", SIAM Journal of Computing, v. 15, n. 2, - * 1986, pp. 364-383. - * - * U. V. Vazirani and V. V. Vazirani, "Trapdoor Pseudo-Random - * Number Generators with Applications to Protocol Design", - * Proceedings of the 24th IEEE Symposium on the Foundations - * of Computer Science, 1983, pp. 23-30. - * - * U. V. Vazirani and V. V. Vazirani, "Efficient and Secure - * Pseudo-Random Number Generation", Proceedings of the 24th - * IEEE Symposium on the Foundations of Computer Science, - * 1984, pp. 458-463. - * - * U. V. Vazirani and V. V. Vazirani, "Efficient and Secure - * Pseudo-Random Number Generation", Advances in Cryptology - - * Proceedings of CRYPTO '84, Berlin: Springer-Verlag, 1985, - * pp. 193-202. - * - * "Probabilistic Encryption", Journal of Computer & System - * Sciences 28, pp. 270-299. - * - * We also refer to this generator as the 'Blum' generator. - * - * This generator is considered 'strong' in that it passes all - * polynomial-time statistical tests. The sequences produced - * are random in an absolutely precise way. There is absolutely - * no better way to predict the next bit in the sequence than by - * tossing a coin (as with TRULY random numbers) EVEN IF YOU KNOW - * THE MODULUS AND A LARGE PART OF THE PREVIOUSLY GENERATED BITS! - * An adversary would be far better advised to try to factor the - * modulus. And if we make the modulus hard to factor - * (such as the product of two large well chosen primes) this - * too can be made intractable for todays computers and methods. - * - * The crypto generator is not as fast as most generators, though - * it is not painfully slow either. - * - * One may fully seed this generator via scryrand(). Calling - * scryrand() with 1 or 3 arguments will result in the builtin - * rand() generator being seeded with the same seed. Calling - * scryrand() with 4 arguments, where the first argument - * is >= 0 will also result in the builtin rand() generator - * being seeded with the same seed. - * - * The random() generator is really another interface to the - * crypto generator. Unlike cryrand(), random() can return a - * value confined to either a half open (0 <= value < a) or closed - * interval (a <= value <= b). By default, a 64 bit value is - * returned. - * - * Calling srandom() simply calls scryrand(seed). The builtin - * rand() generator will be seeded with the same seed. - * - * The generator comes already seeded with precomputed initial constants. - * Thus, it is not required to seed a generator before using it. - * - * Using a seed of '0' will reload the generator with the initial state. - * In the case of scryrand(), lengths of -1 must also be supplied. - * - * scryrand(0,-1,-1) initializes all generators - * scryrand(0) initializes all generators - * srandom(0) initializes all generators - * randstate(0) initializes all generators - * - * All of the above single arg calls are fairly fast. In fact, passing - * seeding with a non-zero seed, in the above cases, where seed is - * not excessively large (many bits long), is also reasonably fast. - * - * The call: - * - * scryrand(-1, 0, in, ir) - * - * is fast because no checking is performed on the 'in', or 'ir' - * when seed is -1. NOTE: One must ensure that 'in' is the product of - * two Blum primes. To do this, one may use: - * - * nextcand(ip,cnt,0,3,4) * nextcand(ip+iq,cnt,0,3,4) - * - * where: - * - * ip is the initial search point for the 1st Blum prime - * iq is the initial search point for the 2nd Blum prime - * cnt is the pseudo test count (should be at least 1, - * this script uses 25) - * - * Note that the 4 arg call currently requires that the 2nd arg be 0. - * Non-zero 2nd arg values are reserved for future use. - * - * A call of scryrand(seed,len1,len2), with len1,len2 > 4, (3 args) - * is a somewhat slow as the length args increase. This type of - * call selects 2 primes that are used internally by the crypto - * generator. A call of scryrand(seed,ip,iq,ir) where seed >= 0 - * is as slow as the 3 arg case. See scryrand() for more information. - * - * A call of scryrand() (no args) may be used to quickly change the - * internal state of the crypto and builtin rand() generators. Only one - * major internal crypto generator value (a quadratic residue) is randomly - * selected via the builtin rand() generator. The other 2 major internal - * values (the 2 Blum primes) are preserved. In this form, the builtin - * rand() generator is not seeded. - * - * Calling scryrand(seed,[len1,len2]) (1 or 3 args), or calling - * srandom(seed) will leave the builtin rand() generator in a - * seeded state as if the builtin srand(seed) has been called. Calling - * scryrand(seed,0,in,ir) (4 args), with seed>0 will also leave - * the builtin rand() generator in the same scryrand(seed) state. - * - * Calling scryrand() (no args) will not seed the builtin rand() - * generator before or afterwards. The builtin rand() generator - * will be changed as a side effect of that call. - * - * Calling srandom(seed) produces the same results as calling scryrand(seed). - * - * The state of the crypto generator is saved and restored via the - * randstate() function. Saving the state just after seeding a generator - * and restoring it later as a very fast way to reseed a generator. - * - * TRUTH IN ADVERTISING: - * - * Instead of searching for a Blum prime, we actually search for a - * probable prime. We use the word 'probable' because of an extremely - * extremely small chance that a composite (a non-prime) may be returned. - * We use the builtin function nextcand in its 5 arg form: - * - * nextcand(p, 25, 0, 3, 4) - * - * The odds that a number returned by the above call is not prime is - * less than 1 in 4^25. For our purposes, this is sufficient as the - * chance of returning a composite is much smaller than the chance that - * a hardware glitch will cause nextcand() to return a bogus result. - * In practive, the chance of the number returned by the above call is - * much much less than 1 in 4^25. The 1 in 4^n is a upper bound that - * has been shown to be much more pessimistic that observations suggest. - * - * Another "truth in advertising" issue is the use of the term - * 'pseudo-random'. All deterministic generators are pseudo random. - * This is opposed to true random generators based on some special - * physical device. - * - * The crypto generator is 'pseudo-random'. There is no statistical - * test, which runs in polynomial time, that can distinguish the crypto - * generator from a truly random source. - * - * A final "truth in advertising" issue deals with how the magic numbers - * found in this library were generated. Detains can be found in the - * various functions, while a overview can be found in the SOURCE FOR - * MAGIC NUMBERS section below. - * - **** - * - * ON THE GENERATORS: - * - * The builtin rand() generator has a good period, and is fast. It is - * reasonable as generators go, though there are better ones available. - * We use it in seeding the crypto generator as its period and - * other statistical properties are good enough for our purposes. - * - * The crypto generator is the best generator in this package. It - * produces a cryptographically strong pseudo-random bit sequence. - * Internally, a fixed number of bits are generated after each - * generator iteration. Any unused bits are saved for the next call - * to the generator. The crypto generator is not too slow, though - * seeding the generator from scratch is slow. Shortcuts and - * pre-computer seeds have been provided for this reason. Use of - * crypto should be more than acceptable for many applications. - * - * The crypto seed is in 3 parts, the builtin rand() seed - * and two lengths. The two lengths specifies the minimum - * bit size of two primes used internal to the crypto generator. - * Not specifying the lengths, or using -1 will cause crypto to - * use the default minimum lengths of 504 and 541 bits, respectively. - * - * The random() function just another interface to the crypto - * generator. Like rand(), random() provides an interval capability - * (closed or open) as well as a 64 bit default return value. - * The random() function as good as crypto, and produces numbers - * that are equally cryptographically strong. One may use the - * seed functions srandom() or scryrand() for either the random() - * or cryrand() functions. - * - * The seed for the crypto generator may be of any size. Excessively - * large values of seed will result in increased memory usage as - * well as a larger seed time for the crypto generator. - * See REGARDING SEEDS below, for more information. - * - * One may save and restore the state of all generators via the - * randstate() function. - * - **** - * - * REGARDING SEEDS: - * - * Because the generators are interrelated, seeding the crypto generator - * will directly or indirectly affect the builtin rand() generator. - * Seeding the crypto generator seeds the builtin rand() generator. - * - * The seed of '0' implies that a generator should be seeded back - * to its initial default state. - * - * For the moment, seeds < -1 are reserved for future use. The - * value of -1 is used as a special indicator to the fourth form - * of scryrand(), and it not a real seed. - * - * A seed may be of any size. - * - * There is no limit on the size of a seed. On the other hand, - * extremely large seeds require large tables and long seed times. - * Using a seed in the range of [2^64, 2^64 * 128!) should be - * sufficient for most purposes. An easy way to stay within this - * range to to use seeds that are between 21 and 215 digits, or 64 to - * 780 bits long. - * - **** - * - * SOURCE OF MAGIC NUMBERS: - * - * Most of the magic constants used on this library ultimately are - * based on the Rand book of random numbers. The Rand book contains - * 10^6 decimal digits, generated by a physical process. This book, - * produced by the Rand corporation in the 1950's is considered - * a standard against which other generators may be measured. - * - * The Rand book of numbers was groups into groups of 20 digits. - * The first 55 groups < 2^64 were used to initialize add55_init_tbl. - * The size of 20 digits was used because 2^64 is 20 digits long. - * The restriction of < 2^64 was used to prevent modulus biasing. - * - * The additive 55 generator during seeding is used 128 times to help - * remove the initial seed state from the initial values produced. - * The loop count of 128 was a power of 2 that permits each of the - * 55 table entries to be processed at least twice. - * - * The quadratic residue search performed by cryres() starts at - * a value that is in the interval [2^sqrpow,n/2), where '2^sqrpow' - * is the smallest power of 2 >= 'n^(3/4)' where 'n=p*q'. We also - * reject any initial residue whose square (mod n) does not fit - * this same restriction. We reject any residue that is within - * 2^sqrpow of its square (mod n). Finally, we reject any quadratic - * residue or square mod n of a quadratic residue that is within - * 2^sqrpow of a simple fraction of n (n/k for some integer k). - * - * The use of 'n^(3/4)' insures that the quadratic residue is - * large, but not too large. We want to avoid residues that are - * near 0 or that are near 'n'. Such residues are trivial or - * semi-trivial. Applying the same restriction to the square - * of the initial residue avoid initial residues near 'sqrt(n)'. - * Such residues are trivial or semi-trivial as well. - * - * Avoiding residues whose squares (mod n) are not within 2^sqrpow of - * itself helps avoid selecting residue sequences (repeated - * squaring mod n) that initally do not change very much. - * Such residues might be somewhat trivial, so we play it safe. - * - * Taking some care to select a good initial residue helps - * eliminate cheep search attacks. It is true that a subsequent - * residue could be one of the residues that we would initially - * avoid. However such an occurance will happen after the - * generator is well underway and any such information - * has been lost. - * - * If we cannot find a good initial quadratic residue after - * 100 tries, we give up. The number '100' is somewhat arbitrary. - * For large 'n', a good quadratic residue is found after only - * a few tries. This value comes from the first 3 digits of the - * Rand book. Using a 4 digit count limit seemed excessive, - * and a 2 digit count (in this case 10) count be too small. - * - * Due to the initial quadratic residue selection process, - * the smallest of the larger Blum prime that is usable - * is 199. This is because 1393 = 7*199 is the smallest - * product of Blum primes that has a quadratic residue - * that is capable of passing the above restrictions. - * - * When searching for initial Blum primes, we do not know - * which initial search point will result in the larger - * Blum prime (due to possible random increments off of - * the search point). To be safe we will force both initial - * search points to be at lesast 199. This implies that the - * smallest usable n = p*q = 199*199 = 39601. - * - * Now since the lower bound for initial quadratic residues - * is '2^sqrpow', for the smallest n=39601 our lower bound - * is the value 2^12 or 4096. Thus we need not consider - * and initial starting quadratic value < 4096. - * - * The final magic numbers: '504' and '541' are the exponents the - * largest powers of 2 that are < the two default Blum primes 'p' - * and 'q' used by the crypto generator. The values of '504' and - * '541' implies that the product n=p*q > 2^1024. Each iteration - * of the crypto generator produces log2(log2(n=p*q)) random bits. - * The crypto generator is the most efficient when n is slightly > - * 2^(2^b). The product n > 2^(2^10)) produces 10 bits as efficiently - * as possible under the crypto generator process. - * - * Not being able to factor 'n=p*q' into 'p' and 'q' does not directly - * improve the quality crypto generator. On the other hand, it does - * improve the security of it. - * - * As we stated above, there is absolutely no better way to predict the - * sequence than by tossing a coin (as with TRULY random numbers) EVEN - * IF YOU KNOW THE MODULUS AND WHERE YOU ARE IN THE SEQUENCE! An - * adversary would be far better advised to try to factor the modulus - * and break the sequence that way. Thus we want to make 'n' hard - * to factor. - * - * The two len values differ slightly to avoid factorization attacks - * that work on numbers that are a perfect square, or where the two - * primes are nearly the same. I elected to have the sizes differ - * by 3% of the product size. The difference between '504' and - * '541', is '31', which is ~3.027% of '1024'. Now 3% of '1024' is - * '30.72', and the next largest whole number is '31'. - * - * The product n=p*q > 2^1024 implies a product if at least 309 digits. - * A product of two primes that is at least 309 digits is somewhat - * beyond Number Theory and computer power of Nov 1995, though this - * will likely change in the future. - * - * Again, the ability (or lack thereof) to factor 'n=p*q' does not - * directly relate to the strength of the crypto generator. We - * selected n=p*q > 2^1024 mainly because '1024 was a power of 2 and - * only slightly because it is up in the range where it is difficult - * to factor. - * - **** - * - * FOR THE PARANOID: - * - * The truly paranoid might suggest that my claims in the MAGIC NUMBERS - * section are a lie intended to entrap people. Well they are not, but - * you need not take my word for it. - * - * The random numbers from the Rand book of random numbers can be - * verified by anyone who obtains the book. As these numbers were - * created before I (Landon Curt Noll) was born (you can look up - * my birth record if you want), I claim to have no possible influence - * on their generation. - * - * There is a very slight chance that the electronic copy of the - * Rand book that I was given access to differs from the printed text. - * I am willing to provide access to this electronic copy should - * anyone wants to compare it to the printed text. - * - * One could take issue with my selection of the default sizes '504' - * and '541'. As far as I know, 309 digits (1024 bits) is beyond the - * state of the art of Number Theory and Computation as of 17 Nov 95. - * It will likely be true that 309 digit products of two primes could - * come within reach in the next few years, but so what? If you are - * truly paranoid, why would you want to use the default seed, which - * is well known? - * - * The paranoid today might consider using the lengths of at least '504' - * and '541' will produce a product of two primes that is 202 digits. - * (the 2nd and 3rd args of scryrand > 504 & >541 respectively) Factoring - * 200+ digit product of two primes is well beyond the current hopes of - * Number Theory and Computer power, though even this limit may be passed - * someday. - * - * One might ask if value of '100' is too small with respect to the - * initial residue selection. Showing that '100' is too small would - * be difficult. Even if one could make that case, the chance that - * a 'problem' initial reside would be used would be very very small - * for non-trivial values of 'p' and 'q'. - * - * If all the above fails to pacify the truly paranoid, then one may - * select by some independent means, 2 Blum primes (primes mod 4 == 3, - * p < q), and a quadratic residue if p*q. Then by calling: - * - * scryrand(-1, 0, p*q, r) - * - * and then calling cryrand() or random(), one may bypass all magic - * numbers and use the pure generator. - * - * Note that randstate() may also be used by the truly paranoid. - * Even though it holds state for the other generators, their states - * are independent. - * - **** - * - * GOALS: - * - * The goals of this package are: - * - * all magic numbers are explained - * - * I distrust systems with constants (magic numbers) and tables - * that have no justification (e.g., DES). I believe that I have - * done my best to justify all of the magic numbers used. - * - * full documentation - * - * You have this source file, plus background publications, - * what more could you ask? - * - * large selection of seeds - * - * Seeds are not limited to a small number of bits. A seed - * may be of any size. - * - * the strength of the generators may be tuned to meet the application need - * - * By using the appropriate seed arguments, one may increase - * the strength of the generator to suit the need of the - * application. One does not have just a few levels. - * - * This calc lib file is intended for demonstration purposes. Writing - * a C program (with possible assembly or libmp assist) would produce - * a faster generator. - * - * Even though I have done my best to implement a good system, you still - * must use these routines your own risk. - * - * Share and enjoy! :-) - */ - - -/* - * These constants are used by all of the generators in various direct and - * indirect forms. - */ -static cry_seed = 0; /* master seed */ - - -/* - * cryobj - cryptographic pseudo-random state object - */ -obj cryobj { \ - n, /* product of 2 Blum primes (prime 3 mod 4) */ \ - r, /* quadratic residue of n=p*q */ \ - exp, /* used in computing crypto good bits */ \ - left, /* bits unused from the last cryrand() call */ \ - bitcnt, /* left contains bitcnt crypto good bits */ \ - seed /* last seed set by srand() or 0 */ \ -} - - -/* - * initial cryptographic pseudo-random values - used by scryrand() - * - * These values are what the crypto generator is initialized with - * with this library first read. These values may be reproduced the - * hard way by calling scryrand(0,504,541) or scryrand(0,-1,-1). - * - * We will build up these values a piece at a time to avoid long lines - * that are difficult to send via EMail. - * - * NOTE: The primes that are used to compute the default value can - * be determined by examining this code. It is not intended that - * the default set of primes be hidden. If you want your product - * of two primes secret, then you need to seed the generator with - * an appropriate value. See the scryrand() function for details. - */ -/* product of 2 Blum primes (3 mod 4) */ -static cryrand_init_n = 0x1657a14d00510c5f704ec; -cryrand_init_n <<= 200; -cryrand_init_n |= 0xaad832b9295595c981ab6aa0cde87b12be032ee74f4c0b4007; -cryrand_init_n <<= 200; -cryrand_init_n |= 0x24191787d27b72b7b1b340fce7cf1158456e43a2940306046c; -cryrand_init_n <<= 200; -cryrand_init_n |= 0x6720979d12905a39dd12693b2ab52c8be109b791f71e66b069; -cryrand_init_n <<= 200; -cryrand_init_n |= 0x25aa8cf167c21650fc92716802722852601f3dc30bb2c1374e; -cryrand_init_n <<= 200; -cryrand_init_n |= 0x8bbb19c47c2bd12e3e43b93ba20e6047c07e29a89a34991309; -/* value to use as a quadratic residue of n=p*q */ -static cryrand_init_r = 0xc786ad03ebd254b3903f7e59d89b316d; -cryrand_init_r <<= 200; -cryrand_init_r |= 0x883ad980731281084d904323980830ec32ccb18af7faa070b7; -cryrand_init_r <<= 200; -cryrand_init_r |= 0x9a74dc95d0f61fc6ba3bc2599d952571bfb85081ffeec8995b; - -/* - * cryptographic pseudo-random values - used by cryrand() and scryrand() - */ -/* n = p*q */ -static cryrand_n = cryrand_init_n; -/* quad residue of n */ -static cryrand_r = pmod(cryrand_init_r, 2, cryrand_init_n); -/* this cryrand() running exp used in computing crypto good bits */ -static cryrand_exp = cryrand_r; -/* good crypto bits unused from the last cryrand() call */ -static cryrand_left = 0; -/* the value cryrand_left contains cryrand_bitcnt crypto good bits */ -static cryrand_bitcnt = 0; - - -/* - * cryrand - cryptographically strong pseudo-random number generator - * - * usage: - * cryrand(len) - * - * given: - * len number of pseudo-random bits to generate - * - * returns: - * a cryptographically strong pseudo-random number of len bits - * - * Internally, bits are produced log2(log2(n=p*q)) at a time. If a - * call to this function does not exhaust all of the collected bits, - * the unused bits will be saved away and used at a later call. - * Setting the seed via scryrand() or srandom() will clear out all - * unused bits. Thus: - * - * scryrand(0); <-- restore generator to initial state - * cryrand(16); <-- 16 bits - * - * will produce the same value as: - * - * scryrand(0); <-- restore generator to initial state - * cryrand(4)<<12 | cryrand(12); <-- 4+12 = 16 bits - * - * and will produce the same value as: - * - * scryrand(0); <-- restore generator to initial state - * cryrand(3)<<13 | cryrand(7)<<6 | cryrand(6); <-- 3+7+6 = 16 bits - * - * The crypto generator is not as fast as most generators, though it is not - * painfully slow either. - * - * NOTE: This function is the Blum cryptographically strong - * pseudo-random number generator. - */ -define -cryrand(len) -{ - local goodbits; /* the number of good bits generated each pass */ - local goodmask; /* mask for the low order good bits */ - local randval; /* pseudo-random value being generated */ - - /* - * firewall - */ - if (!isint(len) || len < 1) { - quit "bad arg: len must be an integer > 0"; - } - - /* - * Determine how many bits may be generated each pass. - * - * The result by Alexi et. al., says that the log2(log2(n=p*q)) - * least significant bits are secure, where log2(x) is log base 2. - */ - goodbits = highbit(highbit(cryrand_n)); - goodmask = (1 << goodbits)-1; - - /* - * If we have bits left over from the previous call, collect - * them now. - */ - if (cryrand_bitcnt > 0) { - - /* case where the left over bits are enough for this call */ - if (len <= cryrand_bitcnt) { - - /* we need only len bits */ - randval = (cryrand_left >> (cryrand_bitcnt-len)); - - /* save the unused bits for later use */ - cryrand_left &= ((1 << (cryrand_bitcnt-len))-1); - - /* save away the number of bits that we will not use */ - cryrand_bitcnt -= len; - - /* return our complete result */ - return(randval); - - /* case where we need more than just the left over bits */ - } else { - - /* clear out the number of left over bits */ - len -= cryrand_bitcnt; - cryrand_bitcnt = 0; - - /* collect all of the left over bits for now */ - randval = cryrand_left; - } - - /* case where we have no previously left over bits */ - } else { - randval = 0; - } - - /* - * Pump out len cryptographically strong pseudo-random bits, - * 'goodbits' at a time using Blum's process. - */ - while (len >= goodbits) { - - /* generate the bits */ - cryrand_exp = (cryrand_exp^2) % cryrand_n; - randval <<= goodbits; - randval |= (cryrand_exp & goodmask); - - /* reduce the need count */ - len -= goodbits; - } - - /* if needed, save the unused bits for later use */ - if (len > 0) { - - /* generate the bits */ - cryrand_exp = (cryrand_exp^2) % cryrand_n; - randval <<= len; - randval |= ((cryrand_exp&goodmask) >> (goodbits-len)); - - /* save away the number of bits that we will not use */ - cryrand_left = cryrand_exp & ((1 << (goodbits-len))-1); - cryrand_bitcnt = goodbits-len; - } - - /* - * return our pseudo-random bits - */ - return(randval); -} - - -/* - * scryrand - seed the cryptographically strong pseudo-random number generator - * - * usage: - * scryrand(seed) - * scryrand() - * scryrand(seed, len1, len2) - * scryrand(seed, 0, in, ir) - * - * input: - * [seed pseudo-random seed - * [len1 len2] minimum bit length of the Blum primes 'p' and 'q' - * -1 => default lengths - * [0 in ir] Initial values for Blum prime products 'p*q' and - * a quadratic residue 'r' - * - * returns: - * the previous seed - * - * - * This function will seed and setup the generator needed to produce - * cryptographically strong pseudo-random numbers. - * - * The first form of this function are fairly fast if the seed is not - * excessively large. The second form is also fairly fast if the internal - * primes are not too large. The third form, can take a long time to call. - * (see below) The fourth form, if the 'seed' arg is not -1, can take - * as long as the third form to call. If the fourth form is called with - * a 'seed' arg of -1, then it is fairly fast. - * - * Calling scryrand() with 1 or 3 args (first and third forms), or - * calling srandom(), or calling scryrand() with 4 args with the first - * arg >0, will leave the builtin rand() generator in a seeded state as if - * srand(seed) has been called. - * - * Calling scryrand() with no args will not seed the builtin rand() - * generator, before or afterwards, however the builtin rand() generator - * will have been changed as a side effect of that call. - * - * Calling scryrand() with 4 args where the first arg is 0 or '-1' - * will not change the other generators. - * - * - * First form of call: scryrand(seed) - * - * The first form of this function will seed the builtin rand() generator - * (via srand). The default precomputed constants will be used. - * - * - * Second form of call: scryrand() - * - * Only a new quadratic residue of n=p*q is recomputed. The previous prime - * values are kept. - * - * Unlike the first and second forms of this function, the builtin rand() - * generator function is not seeded before or after the call. The - * current state is used to generate a new quadratic residue of n=p*q. - * - * - * Third form of call: scryrand(seed, len1, len2) - * - * In the third form, 'len1' and 'len2' guide this function in selecting - * internally used prime numbers. The larger the lengths, the longer - * the time this function will take. The impact on execution time of - * cryrand() and random() may also be noticed, but not as much. - * - * If a length is '-1', then the default lengths (504 for len1, and 541 - * for len2) are used. The call scryrand(0,-1,-1) recreates the initial - * crypto state the slow and hard way. (use scryrand(0) or srandom(0)) - * - * This function can take a long time to call given reasonable values - * of len1 and len2. On an R4400, the time to seed was: - * - * Approx value digits seed time - * of len1+len2 in n=p*q in sec - * ------------ -------- ------ - * 32 10 too small to measure - * 64 20 0.06 - * 128 39 0.19 - * 200 61 0.37 - * 256 78 0.59 - * 322 100 0.80 - * 464 140 3.28 - * 512 155 3.67 - * 664 200 8.90 - * 830 250 26.07 - * 996 300 14.11 (Faster mult/square methods kick in - * 1024 309 40.44 in certain cases. Type help config - * 1328 400 158.52 in calc for more details.) - * 1586 478 96.54 (The time is also dependent on how - * 1660 500 296.84 many numbers we discard in during - * 2048 617 612.97 the search.) - * - * NOTE: The small lengths above are given for comparison - * purposes and are NOT recommended for actual use. - * - * NOTE: Generating crypto pseudo-random numbers is MUCH - * faster than seeding a crypto generator. - * - * NOTE: This calc lib file is intended for demonstration - * purposes. Writing a C program (with possible assembly - * or libmp assist) would produce a faster generator. - * - * - * Fourth form of call: scryrand(seed, 0, in, ir) - * - * In the fourth form, 'in' must be a product of two Blum primes. - * The arg 'ir' is the search point for the quadratic residue 'r'. - * - * As of this version, the 2nd arg of this 4 arg form must be 0. - * All other values are reserved for future use. - * - * WARNING: Pseudo prime checks are performed on the 'in' arg. - * Passing improper primes will likely produce poor results, - * or worse! A good way to ensure a quality 'in arg is - * to use the expression: - * - * nextcand(ip,cnt,0,3,4) * nextcand(ip+iq,cnt,0,3,4) - * - * where: - * - * ip is the initial search point for the 1st Blum prime - * iq is the initial search point for the 2nd Blum prime - * cnt is the pseudo test count (should be at least 1, - * this script uses 25) - * - * The 'seed' value is interpreted as follows: - * - * If seed > 0: - * - * Seed and use the builtin rand() generator to generate a search - * for a quadratic residue in the range '[0,ir)'. - * - * If seed == 0: - * - * Start searching for quadratic residue is 'ir'. - * - * This form does not change/seed the other generators. - * - * If seed == -1: - * - * Use 'ir' as the quadratic residue, do not search. - * - * This form does not change/seed the other generators. - * - * - * It should be noted that calling scryrand() while using the default - * primes took less than 0.01 seconds. Calling scryrand(0,-1,-1) took - * about 40 seconds. - * - * The paranoid, when giving explicit lengths, should keep in mind that - * len1 and len2 are the largest powers of 2 that are less than the two - * probable primes ('p' and 'q'). These two primes will be used - * internally to cryrand(). For simplicity, we refer to len1 and len2 - * as bit lengths, even though they are actually 1 less then the - * minimum possible prime length. - * - * The actual lengths may exceed the lengths by slightly more than 3%. - * Furthermore, part of the strength of this generator rests on the - * difficultly to factor 'p*q'. Thus one should select 'len1' and 'len2' - * (from which 'p' and 'q' are selected) such that factoring a 'len1+len2' - * bit number is difficult. - * - * Not being able to factor 'n=p*q' into 'p' and 'q' does not directly - * improve the crypto generator. On the other hand, it can't hurt. - * - * There is no limit on the size of a seed. On the other hand, - * extremely large seeds require large tables and long seed times. - * Using a seed in the range of [2^64, 2^64 * 128!) should be - * sufficient for most purposes. An easy way to stay within this - * range to to use seeds that are between 21 and 215 digits long, or - * 64 to 780 bits long. - * - * NOTE: This function will clear any internally buffer bits. See - * cryrand() for details. - * - * NOTE: This function seeds the Blum cryptographically strong - * pseudo-random number generator. - */ -define -scryrand(seed,len1,len2,arg4) -{ - local rval; /* a temporary pseudo-random value */ - local oldseed; /* the previous seed */ - local newres; /* the new quad res */ - local in; /* Blum prime product */ - local ir; /* initial quadratic residue search value */ - local sqir; /* square of ir mod n */ - local minres; /* minimum residue allowed */ - local maxres; /* maximum residue allowed */ - local cryrand_p; /* First Blum prime (3 mod 4) */ - local cryrand_q; /* Second Blum prime (3 mod 4) */ - - /* - * firewall - avoid bogus args and very trivial lengths - */ - /* catch the case of no args - compute a different quadratic residue */ - if (isnull(seed) && isnull(len1) && isnull(len2)) { - - /* generate the next quadratic residue */ - do { - newres = cryres(cryrand_n); - } while (newres == cryrand_r); - cryrand_r = newres; - cryrand_exp = cryrand_r; - - /* clear the internal bits */ - cryrand_left = 0; - cryrand_bitcnt = 0; - - /* return the current seed early */ - return (cry_seed); - } - if (!isint(seed)) { - quit "bad arg: seed arg (1st) must be an integer"; - } - if (param(0) == 4) { - if (seed < -1) { - quit "bad arg: with 4 args: a seed < -1 is reserved for future use"; - } - } else if (param(0) > 0 && seed < 0) { - quit "bad arg: a seed arg (1st) < 0 is reserved for future use"; - } - - /* - * 4 arg case: select or search for 'p', 'q' and 'r' from given values - */ - if (param(0) == 4) { - - /* set initial values */ - if (len1 != 0) { - quit "bad arg: 4 arg scryrand() call requires 2nd arg to be 0"; - } - in = len2; - ir = arg4; - - /* - * Unless prohibited by a seed of -1, force minimum values on - * 'in', and 'ir'. - */ - if (seed >= 0) { - /* - * Due to the initial quadratic residue selection process, - * the smallest of the larger Blum prime that is usable - * is 199. This is because 1393 = 7*199 is the smallest - * product of Blum primes that has a quadratic residue - * that is capable of passing thru cryres(). To be safe - * since we don't know which value (p or q) will end up - * being the larger Blum prime (due to the possible random - * increment below) we will force both initial search - * values to be at lesast 199. - * - * Now cryres() selects quadratic residues >= 2^sqrpow. - * '2^sqrpow' is the smallest power of 2 >= 'n^(3/4)' where - * 'n=p*q' is the product of two Blum primes. Since we - * force both Blum primes to be at least 199, the 2^sqrpow - * for the smallest n=199*199 is the value 2^12 or 4096. - * Thus we force the initial quadratic residue to be at - * least 4096. - */ - if (!isint(in) || in < 1393) { - in = 1393; - } - if (!isint(ir) || ir < 4096) { - ir = 4096; - } - } - /* remember our Blum prime product */ - cryrand_n = in; - - /* - * Determine our prime search points - * - * Unless we have a seed <= 0, we will add a random 64 bit - * value to the initial search points. - */ - if (seed > 0) { - /* add in a random value */ - oldseed = srand(seed); - } - - /* - * search for a quadratic residue - */ - if (seed >= 0) { - - /* - * add in a random value to 'ir' if seeded - * - * Unless we have a seed <= 0, we will add a random 64 bit - * value to the initial search point. - */ - if (seed > 0) { - ir += rand(); - } - } - - /* - * We will reject any quadratic residue whose square mod n - * is outside of the [2^sqrpow,n-100] range, or whose square mod n - * is within 100 of itself. - */ - if (seed >= 0) { - minres = 2^(highbit(floor(power(cryrand_n,0.75)))+1); - maxres = cryrand_n - 100; - sqir = pmod(ir, 2, cryrand_n); - while (sqir < minres || sqir > maxres || abs(sqir-ir) <= 100) { - /* consdier the next residue since we don't like this one */ - if (seed > 0) { - ir = sqir+rand()+1; - } else { - ir = sqir+1; - } - sqir = pmod(ir, 2, cryrand_n); - } - } - cryrand_r = pmod(ir, 2, cryrand_n); - - /* - * clear the previously unused cryrand bits & other misc setup - */ - cryrand_left = 0; - cryrand_bitcnt = 0; - cryrand_exp = cryrand_r; - - /* - * reseed the generator, if needed - * - * The crypto generator no longer needs the builtin rand() - * generator. We however, restore the builtin rand() - * generator back to its seeded state in order to be - * sure that it will be left in the same state. - * - * This will make more reproducible, calls to the builtin rand() - * generator; or more reproducible, calls to this function - * without args. - */ - if (seed > 0) { - ir = srand(seed); /* ignore this return value */ - return(oldseed); - } else { - /* no seed change, return the current seed */ - return (cry_seed); - } - } - - /* - * If not the 4 arg case: - * - * convert explicit -1 args into default values - * convert missing args into -1 values (use precomputed tables) - */ - if ((isint(len1) && len1 != -1 && len1 < 5) || - (isint(len2) && len2 != -1 && len2 < 5) || - (!isint(len1) && isint(len2)) || - (isint(len1) && !isint(len2))) { - quit "bad args: 2 & 3: if 2nd is given, must be -1 or ints > 4"; - } - if (isint(len1) && len1 == -1) { - len1 = 504; /* default len1 value */ - } - if (isint(len2) && len2 == -1) { - len2 = 541; /* default len2 value */ - } - if (!isint(len1) && !isint(len2)) { - /* from here down, -1 means use precomputed values */ - len1 = -1; - len2 = -1; - } - - /* - * force len1 <= len2 - */ - if (len1 > len2) { - swap(len1, len2); - } - - /* - * seed the generator - */ - oldseed = srand(seed); - - /* - * generate p and q Blum primes - * - * The Blum process requires the primes to be of the form 3 mod 4. - * We also generate n=p*q for future reference. - * - * We make sure that the lengths are the minimum lengths possible. - * We want some range to select a random prime from, so we - * go at least 3 bits higher, and as much as 3% plus 3 bits - * higher. Since the section is a random, how high really - * does not matter that much, but we want to avoid going to - * an extreme to keep the execution time from getting too long. - * - * Finally, we generate a quadratic residue of n=p*q. - */ - if (len1 > 0 && len2 > 0) { - /* generate a pseudo-random prime ~len1 bits long */ - rval = rand(2^(len1-1), 2^((int(len1*1.03))+3)); - cryrand_p = nextcand(rval,25,0,3,4); - - /* generate a pseudo-random prime ~len2 bits long */ - rval = rand(2^(len2-1), 2^((int(len2*1.03))+3)); - cryrand_q = nextcand(rval,25,0,3,4); - - /* here is our blum modulus */ - cryrand_n = cryrand_p*cryrand_q; - cryrand_p = 0; /* clear value */ - cryrand_q = 0; /* clear value */ - - } else { - - /* use precomputed 'n' value */ - cryrand_n = cryrand_init_n; - } - - /* - * find the quadratic residue - */ - if (len1 == 504 && len2 == 541 && seed == 0) { - cryrand_r = cryrand_init_r; - } else { - cryrand_r = cryres(cryrand_n); - } - - /* - * clear the previously unused cryrand bits & other misc setup - */ - cryrand_left = 0; - cryrand_bitcnt = 0; - - /* - * ensure that r is a quadratic residue - */ - cryrand_r = pmod(cryrand_r, 2, cryrand_n); - cryrand_exp = cryrand_r; - - /* - * reseed the generator - * - * The crypto generator no longer needs the builtin rand() - * generator. We however, restore the builtin rand() generator - * back to its seeded state in order to be sure that it - * will be left in the same state. - */ - /* we do not care about this old seed */ - rval = srand(seed); - - /* - * return the old seed - */ - return(oldseed); -} - - -/* - * random - a cryptographically strong pseudo-random number generator - * - * usage: - * random() - generate a pseudo-random integer >=0 and < 2^64 - * random(a) - generate a pseudo-random integer >=0 and < a - * random(a,b) - generate a pseudo-random integer >=a and <= b - * - * returns: - * a large cryptographically strong pseudo-random number (see usage) - * - * This function is just another interface to the crypto generator. - * (see the cryrand() function). - * - * When no arguments are given, a pseudo-random number in the half open - * interval [0,2^64) is produced. This form is identical to calling - * cryrand(64). - * - * When 1 argument is given, a pseudo-random number in the half open interval - * [0,a) is produced. - * - * When 2 arguments are given, a pseudo-random number in the closed interval - * [a,b] is produced. - * - * This generator uses the crypto to return a large pseudo-random number. - * - * The input values a and b, if given, must be integers. - * - * Internally, bits are produced log2(log2(n=p*q)) at a time. If a - * call to this function does not exhaust all of the collected bits, - * the unused bits will be saved away and used at a later call. - * Setting the seed via scryrand(), srandom() or cryrand(len,1) - * will clear out all unused bits. - * - * NOTE: The BSD random() function returns only 31 bits, while we return 64. - * - * NOTE: This function is the Blum cryptographically strong - * pseudo-random number generator. - */ -define -random(a,b) -{ - local range; /* we must generate [0,range) first */ - local offset; /* what to add to get a adjusted range */ - local rangebits; /* the number of bits in range */ - local ret; /* pseudo-random bit value */ - - /* - * setup and special cases - */ - /* deal with the rand() case */ - if (isnull(a) && isnull(b)) { - /* no args means return 64 bits */ - return(cryrand(64)); - } - /* firewall - args, if given must be in integers */ - if (!isint(a) || (!isnull(b) && !isint(b))) { - quit "bad args: args, if given, must be integers"; - } - /* convert random(x) into random(0,x-1) */ - if (isnull(b)) { - /* convert call into a closed interval */ - b = a-1; - a = 0; - /* firewall - random(0) should act like random(0,0) */ - if (b == -1) { - return(0); - } - } - /* determine the range and offset */ - if (a >= b) { - /* deal with the case of random(a,a) */ - if (a == b) { - /* not very random, but it is true! */ - return(a); - } - range = a-b+1; - offset = b; - } else { - /* convert random(a,b), where a= range and 2^(rangebits-1) < range. We - * will ignore any results that are > the range that we want. - * - * A note in modulus biasing: - * - * We will not fall into the trap of thinking that we can simply take - * a value mod 'range'. Consider the case where 'range' is '80' - * and we are given pseudo-random numbers [0,100). If we took them - * mod 80, then the numbers [0,20) would be produced more often - * because the numbers [81,100) mod 80 wrap back into [0,20). - */ - do { - /* obtain a pseudo-random value */ - ret = cryrand(rangebits); - } while (ret >= range); - - /* - * return the adjusted range value - */ - return(ret+offset); -} - - -/* - * srandom - seed the cryptographically strong pseudo-random number generator - * - * given: - * seed a random number seed - * - * returns: - * the previous seed - * - * This function is just another interface to the crypto generator. - * (see the scryrand() function). - * - * This function makes indirect use of the builtin rand() generator. - * - * There is no limit on the size of a seed. On the other hand, - * extremely large seeds require large tables and long seed times. - * Using a seed in the range of [2^64, 2^64 * 128!) should be - * sufficient for most purposes. An easy way to stay within this - * range to to use seeds that are between 21 and 215 digits long, or - * 64 to 780 bits long. - * - * NOTE: Calling this function will clear any internally buffer bits. - * See cryrand() for details. - * - * NOTE: This function seeds the Blum cryptographically strong - * pseudo-random number generator. - */ -define -srandom(seed) -{ - if (!isint(seed)) { - quit "bad arg: seed must be an integer"; - } - if (seed < 0) { - quit "bad arg: seed < 0 is reserved for future use"; - } - return(scryrand(seed)); -} - - -/* - * randstate - set/get the state of all of the generators - * - * usage: - * randstate() return the current state - * randstate(0) return the previous state, set the default state - * randstate(cobj) return the previous state, set a new state - * - * In the first form: randstate() - * - * This function returns an cryobj object containing information - * about the current state of all of the generators. - * - * In the second form: randstate(0) - * - * This function sets all of the generators to the default initial - * state (i.e., the state when this library was loaded). - * - * This function returns an cryobj object containing information - * about the previous state of all of the generators. - * - * In the third form: randstate(cobj) - * - * This function sets all of the generators to the state as found - * in the cryobj object. - * - * This function returns an cryobj object containing information - * about the previous state of all of the generators. - * - * This function may be used to save and restore cryrand() & random() - * generator states. For example: - * - * state = randstate() <-- save the current state - * random() <-- print the next 64 bits - * randstate(state) <-- restore previous state - * random() <-- print the same 64 bits - * - * One may quickly reseed a generator. For example: - * - * srandom(1,330,350) <-- seed the generator - * seed1state = randstate() <-- remember this 1st seeded state - * random() <-- print 1st 64 bits seed 1 generator - * srandom(2,331,351) <-- seed the generator again - * seed2state = randstate() <-- remember this 2nd seeded state - * random() <-- print 1st 64 bits seed 2 generator - * - * randstate(seed1state) <-- reseed to the 1st seeded state - * random() <-- reprint 1st 64 bits seed 1 generator - * randstate(seed2state) <-- reseed to the 2nd seeded state - * random() <-- reprint 1st 64 bits seed 2 generator - * - * given: - * cobj if a cryobj object, use that object to set the current state - * if 0, set to the default state - * - * return: - * return the state of the crypto pseudo-random number generator in - * the form of an cryobj object, as it was prior to this call - * - * NOTE: No checking is performed on the data the 3rd form (cryobj object - * arg) is used. The user must ensure that the arg represents a valid - * generator state. - * - * NOTE: When using the second form (passing an integer arg), only 0 is - * defined. All other integer values are reserved for future use. - */ -define -randstate(arg) -{ - /* declare our objects */ - local obj cryobj x; /* firewall comparator */ - local obj cryobj prev; /* previous states of the generators */ - local junk; /* dummy holder of random values */ - - /* firewall */ - if (!isint(arg) && !istype(arg,x) && !isnull(arg)) { - quit "bad arg: argument must be integer, an cryobj object or missing"; - } - if (isint(arg) && arg != 0) { - quit "bad arg: non-zero integer arguments are reserved for future use"; - } - - /* - * save the current state - */ - prev.n = cryrand_n; - prev.r = cryrand_r; - prev.exp = cryrand_exp; - prev.left = cryrand_left; - prev.bitcnt = cryrand_bitcnt; - prev.seed = cry_seed; - if (isnull(x)) { - /* if no args, just return current state */ - return (prev); - } - - /* - * deal with the cryobj arg - set the state - */ - if (istype(arg, x)) { - /* set the state from this object */ - cryrand_n = cryrand_n; - cryrand_r = arg.r; - cryrand_exp = arg.exp; - cryrand_left = arg.left; - cryrand_bitcnt = arg.bitcnt; - cry_seed = arg.seed; - - /* - * deal with the 0 integer arg - set the default initial state - */ - } else if (isint(arg) && arg == 0) { - cryrand_n = cryrand_init_n; - cryrand_r = pmod(cryrand_init_r, 2, cryrand_init_n); - cryrand_exp = cryrand_r; - cryrand_left = 0; - cryrand_bitcnt = 0; - cry_seed = srand(0); - } - - /* - * return the previous state - */ - return (prev); -} - - -/* - * cryobj - how to initialize a cryobj object - * - * given: - * n product of Blum primes - * r quadratic residue of n=p*q - * exp used in computing crypto good bits - * left bits unused from the last cryrand() call - * bitcnt left contains bitcnt crypto good bits - * seed last seed set by srand() or 0 - * - * return: - * an cryobj object - * - * NOTE: This function, by convention, returns an cryobj object. - */ -define -cryobj(n,r,exp,left,bitcnt,seed) -{ - /* declare our objects */ - local obj cryobj x; - - /* firewall */ - if (!isint(n) || !isint(r) || !isint(exp) || \ - !isint(left) || !isint(bitcnt) || !isint(seed)) { - quit "bad args: first 7 args must be integers"; - } - - /* initialize object with default startup values */ - x.n = n; - x.r = r; - x.exp = exp; - x.left = left; - x.bitcnt = bitcnt; - x.seed = seed; - - /* return the initialized object */ - return (x); -} - - -/* - * cmpobj - compare two cryrand objects - * - * usage: - * a an cryobj object - * b an cryobj object - * - * NOTE: This function is intended for debug purposes. - */ -define -cmpobj(a,b) -{ - local obj cryobj x; /* firewall comparator */ - - /* firewall */ - if (!istype(a, x)) { - quit "bad arg: 1st arg is not an cryobj object"; - } - if (!istype(b, x)) { - quit "bad arg: 2nd arg is not an cryobj object"; - } - - /* compare values */ - if (a.n != b.n) { - print "a.n - b.n:", a.n - b.n; - } - if (a.r != b.r) { - print "a.r - b.r:", a.r - b.r; - } - if (a.exp != b.exp) { - print "a.exp - b.exp:", a.exp - b.exp; - } - if (a.left != b.left) { - print "a.left - b.left:", a.left - b.left; - } - if (a.bitcnt != b.bitcnt) { - print "a.bitcnt - b.bitcnt:", a.bitcnt - b.bitcnt; - } - if (a.seed != b.seed) { - print "a.seed - b.seed:", a.seed - b.seed; - } -} - - -/* - * cryobj_print - print the value of a cryobj object - * - * usage: - * a an cryobj object - * - * NOTE: This function is called automatically when an cryobj object - * is displayed. - */ -define -cryobj_print(a) -{ - /* declare our objects */ - local obj cryobj x; /* firewall comparator */ - - /* firewall */ - if (!istype(a, x)) { - quit "bad arg: arg is not an cryobj object"; - } - - /* print the value */ - print "cryobj(" : a.n : "," : a.r : "," : a.exp : "," : \ - a.left : "," : a.bitcnt : "," : a.seed : ; -} - - -/* - * cryres - find a pseudo-random quadratic residue for scryrand() and cryrand() - * - * given: - * n product of two Blum primes - * - * returns: - * a number that is a quadratic residue of n=p*q - * - * This function is returns the pseudo-random quadratic residue of - * the product of two primes. Normally this function is called - * only by the crypto generator. - * - * NOTE: No check is made to ensure that the n is a product of Blum primes. - */ -define -cryres(n) -{ - local quadres; /* quadratic residue of n */ - local sqquadres; /* square of quadres mod n */ - local minres; /* minimum residue allowed */ - local maxres; /* maximum residue allowed */ - local frac; /* n/frac that quadres is nearest */ - local sqfrac; /* n/sqfrac that sqquadres is nearest */ - local near; /* within +/- sqrt(n) is considered near */ - local j; - - /* - * firewall - */ - if (!isint(n)) { - quit "bad arg: must an integer"; - } - if (n < 39601) { - /* see 'SOURCE OF MAGIC NUMBERS' for why we reject 39601=199*199 */ - quit "bad arg: n < 199*199"; - } - - /* - * find a pseudo-random quadratic residue of n = p*q - * - * We will start sequentially searching for quadratic residue - * values starting at the initial search point 'ir', while at - * same time confining our search to the interval [2^sqrpow,n/2), - * where 2^sqrpow is the smallest power of 2 >= n^(3/4). This - * range helps us avoid selecting trivial residues. - * - * We will also reject any quadratic residue whose square mod n - * is outside of the [2^sqrpow,n/2) range, or whose square mod n - * is within sqrt(n) of itself. - * - * Finally, we reject any quadratic residue or square mod n of a - * quadratic residue that is within sqrt(n) of a simple fraction - * of n (n/k for some integer k). - */ - minres = 2^(highbit(floor(power(n,0.75)))+1); - maxres = (n//3)-1; - near = isqrt(n); - if (maxres-near <= minres) { - quit "bad arg: arg is too small"; - } - j = 0; - do { - /* form a quadratic residue */ - quadres = pmod(rand(minres,maxres+1), 2, n); - sqquadres = pmod(quadres, 2, n); - } while (++j < 100 && \ - (quadres < minres || quadres > maxres || \ - sqquadres < minres || sqquadres > maxres || \ - abs((n//round(n/quadres)) - quadres) <= near || \ - abs((n//round(n/sqquadres)) - sqquadres) <= near || \ - abs(sqquadres-quadres) <= near)); - if (j >= 100) { - quit "could not find a good quadradic residue after 100 tries"; - } - - /* - * return the quadratic residue of n - */ - return (quadres); -} - - -/* - * Initial read execution code - */ -cry_seed = srand(0); /* pre-initialize the tables */ -global cryrand_ver = "25.3 95/11/17 05:33:31"; -/* XXX - Don't forget update version number when all changes are checked in */ - -global lib_debug; -if (lib_debug >= 0) { - print "cryrand_ver:", cryrand_ver; - print "cryrand(len) defined"; - print "scryrand([seed, [len1, len2]]) defined"; - print "scryrand(seed, 0, in, ir) defined"; - print "random([a, [b]]) defined"; - print "srandom(seed) defined"; - print "obj cryobj defined"; - print "randstate([cryobj | 0]) defined"; -} diff --git a/lib/deg.cal b/lib/deg.cal index 4f710df..c28daac 100644 --- a/lib/deg.cal +++ b/lib/deg.cal @@ -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"; diff --git a/lib/ellip.cal b/lib/ellip.cal index d2e1f16..b5f6a4c 100644 --- a/lib/ellip.cal +++ b/lib/ellip.cal @@ -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"; } diff --git a/lib/hello.cal b/lib/hello.cal new file mode 100644 index 0000000..de998b3 --- /dev/null +++ b/lib/hello.cal @@ -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 */ +} diff --git a/lib/lucas.cal b/lib/lucas.cal index 3ae1ebf..7577141 100644 --- a/lib/lucas.cal +++ b/lib/lucas.cal @@ -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"; } diff --git a/lib/lucas_chk.cal b/lib/lucas_chk.cal index c21ccc1..9f4e2d8 100644 --- a/lib/lucas_chk.cal +++ b/lib/lucas_chk.cal @@ -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"; } diff --git a/lib/lucas_tbl.cal b/lib/lucas_tbl.cal index dfbddd7..4d386da 100644 --- a/lib/lucas_tbl.cal +++ b/lib/lucas_tbl.cal @@ -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"; diff --git a/lib/mersenne.cal b/lib/mersenne.cal index 1be9860..105464b 100644 --- a/lib/mersenne.cal +++ b/lib/mersenne.cal @@ -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"; } diff --git a/lib/mfactor.cal b/lib/mfactor.cal index eda8f6d..fa4b08f 100644 --- a/lib/mfactor.cal +++ b/lib/mfactor.cal @@ -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]]])" } diff --git a/lib/mod.cal b/lib/mod.cal index db42138..5a3d18e 100644 --- a/lib/mod.cal +++ b/lib/mod.cal @@ -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"; diff --git a/lib/natnumset.cal b/lib/natnumset.cal new file mode 100644 index 0000000..415e7d1 --- /dev/null +++ b/lib/natnumset.cal @@ -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 + */ +/* + * 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"; +} diff --git a/lib/pell.cal b/lib/pell.cal index e0ec90d..1dbb106 100644 --- a/lib/pell.cal +++ b/lib/pell.cal @@ -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"; } diff --git a/lib/pi.cal b/lib/pi.cal index 8269cdf..d2a1ba5 100644 --- a/lib/pi.cal +++ b/lib/pi.cal @@ -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"; } diff --git a/lib/pix.cal b/lib/pix.cal new file mode 100644 index 0000000..967d4f8 --- /dev/null +++ b/lib/pix.cal @@ -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"; +} diff --git a/lib/pollard.cal b/lib/pollard.cal index 0d26d35..8c4e172 100644 --- a/lib/pollard.cal +++ b/lib/pollard.cal @@ -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"; } diff --git a/lib/poly.cal b/lib/poly.cal index 4a25a70..4569e9a 100644 --- a/lib/poly.cal +++ b/lib/poly.cal @@ -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"; diff --git a/lib/prompt.cal b/lib/prompt.cal index 199d5cb..71e3110 100644 --- a/lib/prompt.cal +++ b/lib/prompt.cal @@ -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"; } diff --git a/lib/psqrt.cal b/lib/psqrt.cal index 0ff1991..10ce7be 100644 --- a/lib/psqrt.cal +++ b/lib/psqrt.cal @@ -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"; } diff --git a/lib/quat.cal b/lib/quat.cal index 7198481..a8ca6b6 100644 --- a/lib/quat.cal +++ b/lib/quat.cal @@ -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"; diff --git a/lib/randbitrun.cal b/lib/randbitrun.cal index 4da1be1..1d72139 100644 --- a/lib/randbitrun.cal +++ b/lib/randbitrun.cal @@ -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"; } diff --git a/lib/randmprime.cal b/lib/randmprime.cal index 3d2620e..8679106 100644 --- a/lib/randmprime.cal +++ b/lib/randmprime.cal @@ -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"; } diff --git a/lib/randombitrun.cal b/lib/randombitrun.cal new file mode 100644 index 0000000..a51ac7e --- /dev/null +++ b/lib/randombitrun.cal @@ -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< 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"; +} diff --git a/lib/randomrun.cal b/lib/randomrun.cal new file mode 100644 index 0000000..a091c6b --- /dev/null +++ b/lib/randomrun.cal @@ -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"; +} diff --git a/lib/randrun.cal b/lib/randrun.cal index 4fe78db..f2b60f9 100644 --- a/lib/randrun.cal +++ b/lib/randrun.cal @@ -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"; } diff --git a/lib/regress.cal b/lib/regress.cal index a5ca9ad..eb1d23f 100644 --- a/lib/regress.cal +++ b/lib/regress.cal @@ -1,5 +1,5 @@ /* - * Copyright (c) 1996 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. * @@ -17,9 +17,21 @@ print '001: Some of these tests may take a while ...'; print '002: Within each section, output should be numbered sequentially'; -global err; -lib_debug = -1; /* disable lib startup messages */ +global prob; /* libregress.cal problem counter */ +prob = 0; /* clear problem counter */ + +global junk; /* throw away value */ +junk = errcount(0); /* clear error count */ +junk = errmax(0x7fffffff); /* set maximum error very high */ + +global ecnt; /* expected value of errcount() */ +ecnt = 0; /* clear expected errcount() value */ + initcfg = config("all", "oldstd"); /* set config to startup default */ +initcfg = config("lib_debug", -1); /* disable lib startup messages */ +initcfg = config("calc_debug", 1); /* enable more internal debugging */ +initcfg = config("all"); /* save state for later use */ + print '003: parsed global definitions'; @@ -27,28 +39,39 @@ print '003: parsed global definitions'; * vrfy - vrfy that a test is true * * Counts and reports errors or prints test string if successful. + * + * This function also detects when errcount() exceeds ecnt + * and reports when this happens. A side effect is that a + * new ecnt level is established. If errcount exceeds errcount + * but otherwise the test is successful, the string is still printed. */ define vrfy(test, str) { + if (errcount() > ecnt) { + print '**** errcount:' : errcount(), ' > ecnt:' : ecnt; + ecnt = errcount(); + ++prob; + } if (test != 1) { print '**** Non-true result (' : test : '): ' : str; - ++err; - return; + ++prob; + } else { + print str; } - print str; + return; } print '004: parsed vrfy()'; /* - * err - alternate error notification and count + * prob - alternate error notification and count */ -define err(str) +define prob(str) { print '****' , str; - ++err; + ++prob; } -print '005: parsed err(str)'; +print '005: parsed prob(str)'; /* @@ -76,69 +99,69 @@ define test_booleans() local y; local t1, t2, t3; - print '200: Beginning test_booleans'; + print '300: Beginning test_booleans'; if (0) print '**** if (0)'; if (0) - err = err + 1; + prob = prob + 1; if (1) - print '201: if (1)'; + print '301: if (1)'; if (2) - print '202: if (2)'; + print '302: if (2)'; if (1) - print '203: if (1) else'; + print '303: if (1) else'; else print '**** if (1) else'; if (1) - print '204: if (1) else'; + print '304: if (1) else'; else - err = err + 1; + prob = prob + 1; if (0) print '**** if (0) else'; else - print '205: if (0) else'; + print '305: if (0) else'; if (0) - err = err + 1; + prob = prob + 1; else - print '206: if (0) else'; + print '306: if (0) else'; if (1 == 1) - print '207: if 1 == 1'; + print '307: if 1 == 1'; else print '**** if 1 == 1'; if (1 == 1) - print '208: if 1 == 1'; + print '308: if 1 == 1'; else - err = err + 1; + prob = prob + 1; if (1 != 2) - print '209: if 1 != 2'; + print '309: if 1 != 2'; else print '**** if 1 != 2'; if (1 != 2) - print '210: if 1 != 2'; + print '310: if 1 != 2'; else - err = err + 1; + prob = prob + 1; - vrfy(1, '211: vrfy 1'); - vrfy(2 == 2, '212: vrfy 2 == 2'); - vrfy(2 != 3, '213: vrfy 2 != 3'); - vrfy(2 < 3, '214: vrfy 2 < 3'); - vrfy(2 <= 2, '215: vrfy 2 <= 2'); - vrfy(2 <= 3, '216: vrfy 2 <= 3'); - vrfy(3 > 2, '217: vrfy 3 > 2'); - vrfy(2 >= 2, '218: vrfy 2 >= 2'); - vrfy(3 >= 2, '219: vrfy 3 >= 2'); - vrfy(!0, '220: vrfy !0'); - vrfy(!1 == 0,'221: vrfy !1 == 0'); - vrfy((1 ? 2 ? 3 : 4 : 5) == 3, '222: (1 ? 2 ? 3 : 4 : 5) == 3'); + vrfy(1, '311: vrfy 1'); + vrfy(2 == 2, '312: vrfy 2 == 2'); + vrfy(2 != 3, '313: vrfy 2 != 3'); + vrfy(2 < 3, '314: vrfy 2 < 3'); + vrfy(2 <= 2, '315: vrfy 2 <= 2'); + vrfy(2 <= 3, '316: vrfy 2 <= 3'); + vrfy(3 > 2, '317: vrfy 3 > 2'); + vrfy(2 >= 2, '318: vrfy 2 >= 2'); + vrfy(3 >= 2, '319: vrfy 3 >= 2'); + vrfy(!0, '320: vrfy !0'); + vrfy(!1 == 0,'321: vrfy !1 == 0'); + vrfy((1 ? 2 ? 3 : 4 : 5) == 3, '322: (1 ? 2 ? 3 : 4 : 5) == 3'); - print '223: Ending test_booleans'; + print '323: Ending test_booleans'; } print '007: parsed test_booleans()'; @@ -154,7 +177,7 @@ define test_variables() global globalvar; local x; - print '300: Beginning test_variables'; + print '350: Beginning test_variables'; x1 = 5; x3 = 7 * 2; @@ -162,95 +185,95 @@ define test_variables() globalvar = 22; g1 = 19 - 3; g2 = 79; - vrfy(x1 == 5, '301: x1 == 5'); - vrfy(x2 == 10, '302: x2 == 10'); - vrfy(x3 == 14, '303: x3 == 14'); - vrfy(g1 == 16, '304: g1 == 16'); - vrfy(g2 == 79, '305: g2 == 79'); - vrfy(globalvar == 22, '306: globalvar == 22'); - vrfy(getglobalvar() == 22, '307: getglobalvar() == 22'); + vrfy(x1 == 5, '351: x1 == 5'); + vrfy(x2 == 10, '352: x2 == 10'); + vrfy(x3 == 14, '353: x3 == 14'); + vrfy(g1 == 16, '354: g1 == 16'); + vrfy(g2 == 79, '355: g2 == 79'); + vrfy(globalvar == 22, '356: globalvar == 22'); + vrfy(getglobalvar() == 22, '357: getglobalvar() == 22'); x1 = x2 + x3 + g1; - vrfy(x1 == 40, '308: x1 == 40'); + vrfy(x1 == 40, '358: x1 == 40'); g1 = x3 + g2; - vrfy(g1 == 93, '309: g1 == 207'); + vrfy(g1 == 93, '359: g1 == 207'); x1 = 5; - vrfy(x1++ == 5, '310: x1++ == 5'); - vrfy(x1 == 6, '311: x1 == 6'); - vrfy(++x1 == 7, '312: ++x1 == 7'); + vrfy(x1++ == 5, '360: x1++ == 5'); + vrfy(x1 == 6, '361: x1 == 6'); + vrfy(++x1 == 7, '362: ++x1 == 7'); x1 += 3; - vrfy(x1 == 10, '313: x1 == 10'); + vrfy(x1 == 10, '363: x1 == 10'); x1 -= 6; - vrfy(x1 == 4, '314: x1 == 4'); + vrfy(x1 == 4, '364: x1 == 4'); x1 *= 3; - vrfy(x1 == 12, '315: x1 == 12'); + vrfy(x1 == 12, '365: x1 == 12'); x1 /= 4; - vrfy(x1 == 3, '316: x1 == 3'); + vrfy(x1 == 3, '366: x1 == 3'); x1 = x2 = x3; - vrfy(x2 == 14, '317: x2 == 14'); - vrfy(x1 == 14, '318: x1 == 14'); + vrfy(x2 == 14, '367: x2 == 14'); + vrfy(x1 == 14, '368: x1 == 14'); if (2 && 3) { - print '319: if (2 && 3)'; + print '369: if (2 && 3)'; } else { print '**** if (2 && 3)'; - ++err; + ++prob; } if (2 && 0) { print '**** if (2 && 0)'; - ++err; + ++prob; } else { - print '320: if (2 && 0)'; + print '370: if (2 && 0)'; } if (0 && 2) { print '**** if (0 && 2)'; - ++err; + ++prob; } else { - print '321: if (0 && 2)'; + print '371: if (0 && 2)'; } if (0 && 0) { print '**** if (0 && 0)'; - ++err; + ++prob; } else { - print '322: if (0 && 0)'; + print '372: if (0 && 0)'; } if (2 || 0) { - print '323: if (2 || 0)'; + print '373: if (2 || 0)'; } else { print '**** if (2 || 0)'; - ++err; + ++prob; } if (0 || 2) { - print '324: if (0 || 2)'; + print '374: if (0 || 2)'; } else { print '**** if (0 || 2)'; - ++err; + ++prob; } if (0 || 0) { print '**** if (0 || 0)'; - ++err; + ++prob; } else { - print '325: if (0 || 0)'; + print '375: if (0 || 0)'; } - x = 2 || 3; vrfy(x == 2, '326: (2 || 3) == 2'); - x = 2 || 0; vrfy(x == 2, '327: (2 || 0) == 2'); - x = 0 || 3; vrfy(x == 3, '328: (0 || 3) == 3'); - x = 0 || 0; vrfy(x == 0, '329: (0 || 0) == 0'); - x = 2 && 3; vrfy(x == 3, '330: (2 && 3) == 3'); - x = 2 && 0; vrfy(x == 0, '331: (2 && 0) == 0'); - x = 0 && 3; vrfy(x == 0, '332: (0 && 3) == 0'); - x = 2 || err('2 || err()'); - print "333: x = 2 || err('2 || err()'"; - x = 0 && err('0 && err()'); - print "334: x = 0 && err('0 && err()'"; + x = 2 || 3; vrfy(x == 2, '376: (2 || 3) == 2'); + x = 2 || 0; vrfy(x == 2, '377: (2 || 0) == 2'); + x = 0 || 3; vrfy(x == 3, '378: (0 || 3) == 3'); + x = 0 || 0; vrfy(x == 0, '379: (0 || 0) == 0'); + x = 2 && 3; vrfy(x == 3, '380: (2 && 3) == 3'); + x = 2 && 0; vrfy(x == 0, '381: (2 && 0) == 0'); + x = 0 && 3; vrfy(x == 0, '382: (0 && 3) == 0'); + x = 2 || prob('2 || prob()'); + print "383: x = 2 || prob('2 || prob()'"; + x = 0 && prob('0 && prob()'); + print "384: x = 0 && prob('0 && prob()'"; - print '335: Ending test_variables'; + print '385: Ending test_variables'; } print '008: parsed test_variables()'; @@ -308,8 +331,11 @@ define test_arithmetic() vrfy(1^1 == 1, '444: 1^1 == 1'); vrfy(1/(.8+.8i)==.625-.625i, '445: 1/(.8+.8i)==.625-.625i'); vrfy((.6+.8i)*(3.6-4.8i)==6, '446: (.6+.8i)*(3.6-4.8i)==6'); + vrfy(-16^-2 == -1/256, '447: -16^-2 == -1/256'); + vrfy(-7^2 == -49, '448: -7^2 == -49'); + vrfy(-3! == -6, '449: -3! == -6'); - print '447: Ending test_arithmetic'; + print '450: Ending test_arithmetic'; } print '009: parsed test_arithmetic()'; @@ -332,7 +358,7 @@ define test_config() print '502: callcfg = config("all","oldstd")'; oldcfg = config("all", "newstd"); print '503: oldcfg = config("all","newstd")'; - vrfy(callcfg == oldcfg, '504: callcfg == oldcfg'); + vrfy(callcfg == initcfg, '504: callcfg == initcfg'); newcfg = config("all"); print '505: newcfg = config("all")'; vrfy(config("all") == newcfg, '506: config("all") == newcfg'); @@ -385,8 +411,8 @@ define test_config() '529: config("leadzero") == 0'); vrfy(config("fullzero") == 0, '530: config("fullzero") == 0'); - vrfy(config("maxerr") == 20, - '531: config("maxerr") == 20'); + vrfy(config("maxscan") == 20, + '531: config("maxscan") == 20'); vrfy(config("prompt") == "> ", '532: config("prompt") == "> "'); vrfy(config("more") == ">> ", @@ -430,7 +456,7 @@ define test_config() vrfy(config("all",callcfg) == oldcfg, '550: config("all",callcfg) == oldcfg'); vrfy(config("all") == callcfg, '551: config("all") == callcfg'); - vrfy(config("all") == oldcfg, '552: config("all") == oldcfg'); + vrfy(config("all") == initcfg, '552: config("all") == initcfg'); print '553: Ending test_config'; } @@ -453,14 +479,14 @@ define muldivcheck(a, b, c, str) cab = (c * a) * b; cba = (c * b) * a; - if (abc != acb) {print '**** abc != acb:', str; ++err;} - if (acb != bac) {print '**** acb != bac:', str; ++err;} - if (bac != bca) {print '**** bac != bca:', str; ++err;} - if (bca != cab) {print '**** bca != cab:', str; ++err;} - if (cab != cba) {print '**** cab != cba:', str; ++err;} - if (abc/a != b*c) {print '**** abc/a != bc:', str; ++err;} - if (abc/b != a*c) {print '**** abc/b != ac:', str; ++err;} - if (abc/c != a*b) {print '**** abc/c != ab:', str; ++err;} + if (abc != acb) {print '**** abc != acb:', str; ++prob;} + if (acb != bac) {print '**** acb != bac:', str; ++prob;} + if (bac != bca) {print '**** bac != bca:', str; ++prob;} + if (bca != cab) {print '**** bca != cab:', str; ++prob;} + if (cab != cba) {print '**** cab != cba:', str; ++prob;} + if (abc/a != b*c) {print '**** abc/a != bc:', str; ++prob;} + if (abc/b != a*c) {print '**** abc/b != ac:', str; ++prob;} + if (abc/c != a*b) {print '**** abc/c != ab:', str; ++prob;} print str; } print '011: parsed muldivcheck(a, b, c, str)'; @@ -479,20 +505,20 @@ define squarecheck(a, b, str) tab = a * b * 2; apb = a + b; apb2 = apb^2; - if (a2 != a*a) {print '**** a^2 != a*a:', str; ++err;} - if (b2 != b*b) {print '**** b^2 != b*b:', str; ++err;} + if (a2 != a*a) {print '**** a^2 != a*a:', str; ++prob;} + if (b2 != b*b) {print '**** b^2 != b*b:', str; ++prob;} if (apb2 != apb*apb) { print '**** (a+b)^2 != (a+b)*(a+b):', str; - ++err; + ++prob; } if (a2+tab+b2 != apb2) { print '**** (a+b)^2 != a^2 + 2ab + b^2:', str; - ++err; + ++prob; } - if (a2/a != a) {print '**** a^2/a != a:', str; ++err;} - if (b2/b != b) {print '**** b^2/b != b:', str; ++err;} - if (apb2/apb != apb) {print '**** (a+b)^2/(a+b) != a+b:', str; ++err;} - if (a2*b2 != (a*b)^2) {print '**** a^2*b^2 != (ab)^2:', str; ++err;} + if (a2/a != a) {print '**** a^2/a != a:', str; ++prob;} + if (b2/b != b) {print '**** b^2/b != b:', str; ++prob;} + if (apb2/apb != apb) {print '**** (a+b)^2/(a+b) != a+b:', str; ++prob;} + if (a2*b2 != (a*b)^2) {print '**** a^2*b^2 != (ab)^2:', str; ++prob;} print str; } print '012: parsed squarecheck(a, b, str)'; @@ -509,8 +535,8 @@ define powercheck(a, p1, p2, str) a1 = (a^p1)^p2; a2 = (a^p2)^p1; a3 = a^(p1*p2); - if (a1 != a2) {print '**** (a^p1)^p2 != (a^p2)^p1:', str; ++err;} - if (a1 != a3) {print '**** (a^p1)^p2 != a^(p1*p2):', str; ++err;} + if (a1 != a2) {print '**** (a^p1)^p2 != (a^p2)^p1:', str; ++prob;} + if (a1 != a3) {print '**** (a^p1)^p2 != a^(p1*p2):', str; ++prob;} print str; } print '013: parsed powercheck(a, p1, p2, str)'; @@ -528,15 +554,15 @@ define fraccheck(a, b, c, str) bc = b * c; ca = c * a; aoc = ab / bc; - if (num(aoc) != a) {print '**** num(aoc) != a:', str; ++err;} - if (den(aoc) != c) {print '**** den(aoc) != c:', str; ++err;} + if (num(aoc) != a) {print '**** num(aoc) != a:', str; ++prob;} + if (den(aoc) != c) {print '**** den(aoc) != c:', str; ++prob;} boc = ab / ca; - if (num(boc) != b) {print '**** num(boc) != b:', str; ++err;} - if (den(boc) != c) {print '**** den(boc) != c:', str; ++err;} + if (num(boc) != b) {print '**** num(boc) != b:', str; ++prob;} + if (den(boc) != c) {print '**** den(boc) != c:', str; ++prob;} aob = ca / bc; - if (num(aob) != a) {print '**** num(aob) != a:', str; ++err;} - if (den(aob) != b) {print '**** den(aob) != b:', str; ++err;} - if (aob*boc != aoc) {print '**** aob*boc != aoc;', str; ++err;} + if (num(aob) != a) {print '**** num(aob) != a:', str; ++prob;} + if (den(aob) != b) {print '**** den(aob) != b:', str; ++prob;} + if (aob*boc != aoc) {print '**** aob*boc != aoc;', str; ++prob;} print str; } print '014: parsed fraccheck(a, b, c, str)'; @@ -572,13 +598,13 @@ define algcheck(a, b, str) t6 = t2^2; if (((ms + ss) % 37) == 4) t7 = pmod(3,a-1,a); - if (t1 != a1) {print '**** t1 != a1:', str; ++err;} - if (t2 != a2) {print '**** t2 != a2:', str; ++err;} - if (t3 != a3) {print '**** t3 != a3:', str; ++err;} - if (t4 != a4) {print '**** t4 != a4:', str; ++err;} - if (t5 != a5) {print '**** t5 != a5:', str; ++err;} - if (t6 != a6) {print '**** t6 != a6:', str; ++err;} - if (t7 != a7) {print '**** t7 != a7:', str; ++err;} + if (t1 != a1) {print '**** t1 != a1:', str; ++prob;} + if (t2 != a2) {print '**** t2 != a2:', str; ++prob;} + if (t3 != a3) {print '**** t3 != a3:', str; ++prob;} + if (t4 != a4) {print '**** t4 != a4:', str; ++prob;} + if (t5 != a5) {print '**** t5 != a5:', str; ++prob;} + if (t6 != a6) {print '**** t6 != a6:', str; ++prob;} + if (t7 != a7) {print '**** t7 != a7:', str; ++prob;} } } config("mul2", oldmul2); @@ -725,10 +751,12 @@ define test_functions() vrfy(ilog2(17) == 4, '744: ilog2(17) == 4'); vrfy(im(3) == 0, '745: im(3) == 0'); vrfy(im(2+3i) == 3, '746: im(2+3i) == 3'); - print '747: test unused'; - print '748: test unused'; - print '749: test unused'; - print '750: test unused'; + vrfy(fact(20) == 2432902008176640000, + '747: fact(20) == 2432902008176640000'); + vrfy(fact(100) == 100*fact(99), '748: fact(100) == 100*fact(99)'); + vrfy(comb(100,25) == 100!/75!/25!, + '749: comb(100,25) == 100!/75!/25!'); + vrfy(perm(100,50) == 100!/50!, '750: perm(100,50) == 100!/50!'); print '751: test unused'; print '752: test unused'; print '753: test unused'; @@ -867,8 +895,8 @@ define test_functions() vrfy(cmp(3+4i,-4-5i) == 1+1i, '885: cmp(3+4i,-4-5i) == 1+1i'); vrfy(comb(7,0) == 1, '886: comb(7,0) == 1'); vrfy(comb(0,0) == 1, '887: comb(0,0) == 1'); - vrfy(perm(7,0) == 7, '888: perm(7,0) == 7'); - vrfy(perm(0,0) == 0, '889: perm(0,0) == 0'); + vrfy(perm(7,0) == 1, '888: perm(7,0) == 1'); + vrfy(perm(0,0) == 1, '889: perm(0,0) == 1'); vrfy(isfile(files(0)) == 1, '890: isfile(files(0)) == 1'); vrfy(isfile(0) == 0, '891: isfile(0) == 0'); vrfy(ismult(4^67, 2^59) == 1, '892: ismult(4^67, 2^59) == 1'); @@ -879,16 +907,16 @@ define test_functions() vrfy(isodd(1/3) == 0, '897: isodd(1/3) == 0'); vrfy(isrel(-5, 6) == 1, '898: isrel(-5, 6) == 1'); vrfy(isrel(-2, 6) == 0, '899: isrel(-2, 6) == 0'); - vrfy(isset(9,0) == 1, '900: isset(9,0) == 1'); - vrfy(isset(9,1) == 0, '901: isset(9,1) == 0'); - vrfy(isset(9,2) == 0, '902: isset(9,2) == 0'); - vrfy(isset(9,3) == 1, '903: isset(9,3) == 1'); - vrfy(isset(1.25, -2) == 1, '904: isset(1.25, -2) == 1'); - vrfy(isset(1.25, -1) == 0, '905: isset(1.25, -1) == 0'); - vrfy(isset(1.25, 0) == 1, '906: isset(1.25, 0) == 1'); - vrfy(isset(pi(), 1) == 1, '907: isset(pi(), 1) == 1'); - vrfy(isset(pi(), -2) == 0, '908: isset(pi(), -2) == 0'); - vrfy(isset(pi(), -3) == 1, '909: isset(pi(), -3) == 1'); + vrfy(bit(9,0) == 1, '900: bit(9,0) == 1'); + vrfy(bit(9,1) == 0, '901: bit(9,1) == 0'); + vrfy(bit(9,2) == 0, '902: bit(9,2) == 0'); + vrfy(bit(9,3) == 1, '903: bit(9,3) == 1'); + vrfy(bit(1.25, -2) == 1, '904: bit(1.25, -2) == 1'); + vrfy(bit(1.25, -1) == 0, '905: bit(1.25, -1) == 0'); + vrfy(bit(1.25, 0) == 1, '906: bit(1.25, 0) == 1'); + vrfy(bit(pi(), 1) == 1, '907: bit(pi(), 1) == 1'); + vrfy(bit(pi(), -2) == 0, '908: bit(pi(), -2) == 0'); + vrfy(bit(pi(), -3) == 1, '909: bit(pi(), -3) == 1'); vrfy(istype(2, 3.0) == 1, '910: istype(2, 3.0) == 1'); vrfy(istype(2, "2") == 0, '911: istype(2, "2") == 0'); vrfy(istype(2, 3i) == 0, '912: istype(2, 3i) == 0'); @@ -1019,13 +1047,13 @@ define test_functions() vrfy(strlen("a b\tc\\d") == 7, '1024: strlen("a b\tc\\d") == 7'); vrfy(xor(2) == 2, '1025: xor(2) == 2'); - vrfy(xor(5, 3, -7, 2, 9) == 10, - '1026: xor(5, 3, -7, 2, 9) == 10'); + vrfy(xor(5, 3, 7, 2, 9) == 10, + '1026: xor(5, 3, 7, 2, 9) == 10'); vrfy(xor(0,0) == 0, '1027: xor(0,0) == 0'); vrfy(xor(0,1) == 1, '1028: xor(0,1) == 1'); vrfy(xor(1,0) == 1, '1029: xor(1,0) == 1'); vrfy(xor(1,1) == 0, '1030: xor(1,1) == 0'); - vrfy(xor(5,3,-7,2,9) == 10, '1031: xor(5,3,-7,2,9) == 10'); + vrfy(xor(5,3,-7,2,9) == -12, '1031: xor(5,3,-7,2,9) == -12'); vrfy(fib(-2) == -1, '1032: fib(-2) == -1'); vrfy(fib(-1) == 1, '1033: fib(-1) == 1'); vrfy(fib(-10) == -55, '1034: fib(-10) == -55'); @@ -1047,7 +1075,7 @@ define test_functions() vrfy(pi == 3.1415926536, '1046: pi == 3.1415926536'); vrfy(polar(2,pi/2,1e-5)==2i, '1047: polar(2,pi/2,1e-5)==2i'); vrfy(power(exp(1,1e-20),pi(1e-20)*1i/2,1e-20) == 1i, - '1048: power(exp(1,1e-20),pi(1e-20)*1i/2,1e-20) == i1'); + '1048: power(exp(1,1e-20),pi(1e-20)*1i/2,1e-20) == 1i'); vrfy(ssq(1+2i, 3-4i, 5 +6i) == -21+40i, '1049: ssq(1+2i, 3-4i, 5 +6i) == -21+40i'); vrfy(isreal(ln(1 + 1e-10i, 1e-5)), @@ -1085,11 +1113,57 @@ define test_functions() vrfy(scale(2+3i,2)==8+12i, '1076: scale(2+3i,2) == 8+12i'); vrfy(frem(8,4) == 2, '1077: frem(8,4) == 2'); vrfy(jacobi(80,199) == 1, '1078: jacobi(80,199) == 1'); + vrfy(test(1), '1079: test(1)'); + vrfy(!test(0), '1080: !test(0)'); + vrfy(hnrmod(2^177-1,1,177,-1)==0, + '1081: hnrmod(2^177-1,1,177,-1)==0'); + vrfy(hnrmod(2^178-2,1,177,-1)==0, + '1082: hnrmod(2^178-2,1,177,-1)==0'); + vrfy(hnrmod(2^178-3,1,177,1)==2^177-4, + '1083: hnrmod(2^178-3,1,177,1)==2^177-4'); + vrfy(hnrmod(2^179-4,1,177,0)==2^177-4, + '1084: hnrmod(2^179-4,1,177,0)==2^177-4'); + vrfy(hnrmod(1234567^2,13,17,-1)==1155404, + '1085: hnrmod(1234567^2,13,17,-1)==1155404'); + vrfy(hnrmod(3276^54,45,415,1)==3276^54%(45*2^415+1), + '1086: hnrmod(3276^54,45,415,1)==3276^54%(45*2^415+1)'); + vrfy(hnrmod(3276^54,45,415,0)==3276^54%(45*2^415), + '1087: hnrmod(3276^54,45,415,0)==3276^54%(45*2^415)'); + vrfy(hnrmod(3276^54,45,415,-1)==3276^54%(45*2^415-1), + '1088: hnrmod(3276^54,45,415,-1)==3276^54%(45*2^415-1)'); + vrfy(hnrmod(10^40, 17, 51, 1) == 33827019788296445, + '1089: hnrmod(10^40, 17, 51, 1) == 33827019788296445'); + vrfy(hnrmod(3192487935759423423521,16,65,1)==241008883965895164956, + '1090: hnrmod(3192487935759423423521,16,65,1)==241008883965895164956'); - print '1079: Ending test_functions'; + /* + * minv bug fix + */ + a = 2868611690182699929873981931; + print '1091: a = 2868611690182699929873981931'; + b = 502922899875329926125584830; + print '1092: b = 502922899875329926125584830'; + vrfy(minv(b,a) == 1111092570983877189739032190, + '1093: minv(b,a) == 1111092570983877189739032190'); + vrfy(mod(minv(b,a)*b,a) == 1, + '1094: mod(minv(b,a)*b,a) == 1'); - print; - print '1100: reserved for future expansion of test_functions'; + /* + * more functions to test + */ + vrfy(popcnt(32767) == 15, '1095: popcnt(32767) == 15'); + vrfy(popcnt(3/2) == 3, '1096: popcnt(3/2) == 3'); + vrfy(popcnt(-237/39929,1) == 17, + '1097: popcnt(-237/39929,1) == 17'); + vrfy(popcnt(-237/39929,0) == 7, + '1098: popcnt(-237/39929,0) == 7'); + vrfy(popcnt(-237/39929) == 17, + '1099: popcnt(-237/39929) == 17'); + vrfy(popcnt(pi(1e-20)) == 65, '1100: popcnt(pi(1e-20)) == 65'); + vrfy(popcnt(pi(1e-20),0) == 69, '1101: popcnt(pi(1e-20),0) == 69'); + vrfy(popcnt(17^777) == 1593, '1102: popcnt(17^777) == 1593'); + + print '1103: Ending test_functions'; } print '017: parsed test_functions()'; @@ -1155,7 +1229,7 @@ define test_assoc() a["curds","whey"] = "spider"; print '1313: a["curds","whey"] = "spider"'; vrfy(a["curds","whey"] == "spider", '1314: a["curds","whey"] == "spider"'); - vrfy(a[[rsearch(a,"spider")]] == "spider", '1315: a[[search(a,"spider")]] == "spider"'); + vrfy(a[[rsearch(a,"spider")]] == "spider", '1315: a[[rsearch(a,"spider")]] == "spider"'); b = a; print '1316: b = a'; vrfy(b[17] == 19, '1317: b[17] == 19'); @@ -1241,17 +1315,17 @@ define test_list() vrfy(reverse(D) == E, '1437: reverse(D) == E'); vrfy(sort(list(1,3,5,2,4))==D,'1438: sort(list(1,3,5,2,4))==D'); vrfy(head(D,2) == list(1,2), '1439: head(D,2) == list(1,2)'); - vrfy(head(D,-2)==list(1,2,3), '1440: head(D,-2)==list(1,2,3)'); + vrfy(head(D,-2) == list(2,1), '1440: head(D,-2) == list(2,1)'); vrfy(head(D,5) == D, '1441: head(D,5) == D'); vrfy(head(D,6) == D, '1442: head(D,6) == D'); - vrfy(head(D,-5) == list(), '1443: head(D,-5) == list()'); - vrfy(head(D,-6) == list(), '1444: head(D,-6) == list()'); + vrfy(head(D,-5) == E, '1443: head(D,-5) == E'); + vrfy(head(D,-6) == E, '1444: head(D,-6) == E'); vrfy(tail(E,2) == list(2,1), '1445: tail(E,2) == list(2,1)'); - vrfy(tail(E,-2)==list(3,2,1), '1446: tail(E,-2)==list(3,2,1)'); + vrfy(tail(E,-2) == list(1,2), '1446: tail(E,-2) == list(1,2)'); vrfy(tail(E,5) == E, '1447: tail(E,5) == E'); vrfy(tail(E,6) == E, '1448: tail(E,6) == E'); - vrfy(tail(E,-5) == list(), '1449: tail(E,-5) == list()'); - vrfy(tail(E,-6) == list(), '1450: tail(E,-6) == list()'); + vrfy(tail(E,-5) == D, '1449: tail(E,-5) == D'); + vrfy(tail(E,-6) == D, '1450: tail(E,-6) == D'); vrfy(segment(D,1,3) == list(2,3,4), '1451: segment(D,1,3) == list(2,3,4)'); vrfy(segment(D,3,1) == list(4,3,2), @@ -1271,7 +1345,7 @@ define test_list() for (y=0; y < size(D); ++y) { for (z=y; z < size(D); ++z) { if (D != join(head(D,y), segment(D,y,z), tail(D,size(D)-z-1))) { - err(strcat("join loop failed at y=",str(y)," z=",str(z))); + prob(strcat("join loop failed at y=",str(y)," z=",str(z))); } } } @@ -1313,21 +1387,26 @@ define test_list() list2 = list(null(),1,2,3,"x"); print '1493: list2 = list(null(),1,2,3,"x")'; vrfy(sort(list1) == list2, '1494: sort(list1) == list2'); + A = list(1,2,3,4); + print '1495: A = list(1,2,3,4)'; + B = makelist(4) = {1,2,3,4}; + print '1496: B = makelist(4) = {1,2,3,4}'; + vrfy(A == B, '1497: A == B'); + vrfy((A = {,,5}) == list(1,2,5,4), + '1498: (A = {,,5}) == list(1,2,5,4)'); - print '1495: Ending list test'; + print '1499: Ending list test'; } print '024: parsed test_list()'; /* - * Test rand + * Test rand - a55 shuffle pseudo-random number generator */ define test_rand() { local init; /* initial generator state */ local state0; /* a generator state */ - local state1; /* a generator state */ - local state2; /* a generator state */ local tmp; local n; @@ -1399,15 +1478,15 @@ define test_rand() '1532: randbit(128) == 0xa8ed5b6203e2b1da32848cd9b3f1e3fa'); tmp = srand(0); print '1533: tmp = srand(0)'; - vrfy(randbit(32) == 0xc79ef743, '1534: randbit(64) == 0xc79ef743'); - vrfy(randbit(32) == 0xe2e6849c, '1535: randbit(64) == 0xe2e6849c'); + vrfy(randbit(32) == 0xc79ef743, '1534: randbit(32) == 0xc79ef743'); + vrfy(randbit(32) == 0xe2e6849c, '1535: randbit(32) == 0xe2e6849c'); vrfy(randbit(1) == 0x1, '1536: randbit(1) == 0x1'); vrfy(randbit(5) == 0x3, '1537: randbit(5) == 0x3'); vrfy(randbit(33) == 0x96e595f6, '1538: randbit(33) == 0x96e595f6'); vrfy(randbit(25) == 0x1321284, '1539: randbit(25) == 0x1321284'); vrfy(randbit(2) == 0x1, '1540: randbit(2) == 0x1'); vrfy(randbit(13) == 0x7a5, '1541: randbit(13) == 0x7a5'); - vrfy(randbit(18) == 0x1a63e, '1542: randbit(19) == 0x1a63e'); + vrfy(randbit(18) == 0x1a63e, '1542: randbit(18) == 0x1a63e'); vrfy(randbit(8) == 0x70, '1543: randbit(8) == 0x70'); vrfy(randbit(9) == 0x62, '1544: randbit(9) == 0x62'); vrfy(randbit(70) == 0x2f3423a252f60bae49, \ @@ -2657,33 +2736,33 @@ define test_poly() { print '3200: Beginning test_matobj'; - vrfy(poly(2,3,5,2) == 19, '3201: vrfy poly(2,3,5,2) == 19'); + vrfy(poly(2,3,5,2) == 19, '3201: poly(2,3,5,2) == 19'); vrfy(poly(list(5,3,2),2) == 19,\ - '3202: vrfy poly(list(5,3,2),2) == 19'); - vrfy(poly(list(5,3,2)) == 5, '3203: vrfy poly(list(5,3,2)) == 5'); - vrfy(poly(2) == 2, '3204: vrfy poly(2) == 2'); + '3202: poly(list(5,3,2),2) == 19'); + vrfy(poly(list(5,3,2)) == 5, '3203: poly(list(5,3,2)) == 5'); + vrfy(poly(2) == 2, '3204: poly(2) == 2'); vrfy(poly(list(5,3,2),2,3) == 19,\ - '3205: vrfy poly(list(5,3,2),2,3) == 19'); - vrfy(poly(list()) == 0, '3206: vrfy poly(list()) == 0'); - vrfy(poly(list(),2,3) == 0, '3207: vrfy poly(list(),2,3) == 0'); + '3205: poly(list(5,3,2),2,3) == 19'); + vrfy(poly(list()) == 0, '3206: poly(list()) == 0'); + vrfy(poly(list(),2,3) == 0, '3207: poly(list(),2,3) == 0'); vrfy(poly(list(list(5,3,2)),7,2) == 19,\ - '3208: vrfy poly(list(list(5,3,2)),7,2) == 19'); + '3208: poly(list(list(5,3,2)),7,2) == 19'); vrfy(poly(list(list(1,2,3),list(4,5),6),7) == 323,\ - '3209: vrfy poly(list(list(1,2,3),list(4,5),6),7) == 323'); + '3209: poly(list(list(1,2,3),list(4,5),6),7) == 323'); vrfy(poly(list(list(1,2,3),list(4,5),6),7,8) == 811,\ - '3210: vrfy poly(list(list(1,2,3),list(4,5),6),7,8) == 811'); + '3210: poly(list(list(1,2,3),list(4,5),6),7,8) == 811'); vrfy(poly(list(list(1,2,3),list(4,5),6),7,8,9) == 811,\ - '3211: vrfy poly(list(list(1,2,3),list(4,5),6),7,8,9)==811'); + '3211: poly(list(list(1,2,3),list(4,5),6),7,8,9)==811'); vrfy(poly(list(5,3,2), list()) == 5,\ - '3212: vrfy poly(list(5,3,2), list() == 5'); + '3212: poly(list(5,3,2), list() == 5'); vrfy(poly(list(5,3,2), list(2)) == 19,\ - '3213: vrfy poly(list(5,3,2), list(2)) == 19'); + '3213: poly(list(5,3,2), list(2)) == 19'); vrfy(poly(list(5,3,2), list(2,3)) == 19,\ - '3214: vrfy poly(list(5,3,2), list(2,3)) == 19'); + '3214: poly(list(5,3,2), list(2,3)) == 19'); vrfy(poly(list(list(list(0,0,0,0,0,1))),2,3,4) == 4^5,\ - '3215: vrfy poly(list(list(list(0,0,0,0,0,1))),2,3,4)==4^5'); + '3215: poly(list(list(list(0,0,0,0,0,1))),2,3,4)==4^5'); vrfy(poly(list(list(list(0,0,0,0,0,1))),2,list(3,4)) == 4^5,\ - '3216: vrfy poly(list(list(list(0,0,0,0,0,1))),2,list(3,4))==4^5'); + '3216: poly(list(list(list(0,0,0,0,0,1))),2,list(3,4))==4^5'); print '3217: Ending test_poly'; } @@ -2751,153 +2830,210 @@ print '053: parsed test_frem()'; /* * test_error - test the error() builtin + * + * This function is designed to trigger 148 errors, so we bump the + * errmax by 148 during this call. */ define test_error() { - local strx, e99, list1; + local strx, e99, list1, e999; + local a, b, c, n, x; /* used by newerror() */ print '3600: Beginning test_error'; + /* bump ecnt up by 148 */ + ecnt += 148; + print '3601: ecnt += 148'; + strx = "x"; - print '3601: strx = "x"'; + print '3602: strx = "x"'; e99 = error(99); - print '3602: e99 = error(99)'; - vrfy(1/0 == error(10001), '3603: 1/0 == error(10001)'); - vrfy(0/0 == error(10002), '3604: 0/0 == error(10002)'); - vrfy(2 + "x" == error(10003), '3605: 2 + "x" == error(10003)'); - vrfy("x" - 2 == error(10004), '3606: "x" - 2 == error(10004)'); - vrfy("x" * 2 == error(10005), '3607: "x" * 2 == error(10005)'); - vrfy("x" / 2 == error(10006), '3608: "x" / 2 == error(10006)'); - vrfy(-"x" == error(10007), '3609: -"x" == error(10007)'); - vrfy("x"^2 == error(10008), '3610: "x"^2 == error(10008)'); - vrfy(inverse("x")==error(10009),'3611: inverse("x") == error(10009)'); - vrfy(++strx == error(10010), '3612: ++strx == error(10010)'); - vrfy(strx == error(10010), '3613: strx == error(10010)'); + print '3603: e99 = error(99)'; + vrfy(1/0 == error(10001), '3604: 1/0 == error(10001)'); + vrfy(0/0 == error(10002), '3605: 0/0 == error(10002)'); + vrfy(2 + "x" == error(10003), '3606: 2 + "x" == error(10003)'); + vrfy("x" - 2 == error(10004), '3607: "x" - 2 == error(10004)'); + vrfy("x" * "y" == error(10005), '3608: "x" * "y" == error(10005)'); + vrfy("x" / "y" == error(10006), '3609: "x" / "y" == error(10006)'); + vrfy(-list(1) == error(10007), '3610: -list(1) == error(10007)'); + vrfy("x"^2 == error(10008), '3611: "x"^2 == error(10008)'); + vrfy(inverse("x")==error(10009),'3612: inverse("x") == error(10009)'); + vrfy(++strx == error(10010), '3613: ++strx == error(10010)'); + vrfy(strx == error(10010), '3614: strx == error(10010)'); strx = "x"; - print '3614: strx = "x"'; - vrfy(strx++ == "x", '3615: strx++ == "x"'); - vrfy(strx == error(10010), '3616: strx == error(10010)'); + print '3615: strx = "x"'; + vrfy(strx++ == "x", '3616: strx++ == "x"'); + vrfy(strx == error(10010), '3617: strx == error(10010)'); strx = "x"; - print '3617: strx = "x"'; - vrfy(--strx == error(10011), '3618: strx == error(10011)'); - vrfy(int("x") == error(10012), '3619: int("x") == error(10012)'); - vrfy(frac("x") == error(10013), '3620: frac("x") == error(10013)'); - vrfy(conj("x") == error(10014), '3621: conj("x") == error(10014)'); + print '3618: strx = "x"'; + vrfy(--strx == error(10011), '3619: strx == error(10011)'); + vrfy(int("x") == error(10012), '3620: int("x") == error(10012)'); + vrfy(frac("x") == error(10013), '3621: frac("x") == error(10013)'); + vrfy(conj("x") == error(10014), '3622: conj("x") == error(10014)'); vrfy(appr("x",.1) == error(10015), - '3622: appr("x",.1) == error(10015)'); + '3623: appr("x",.1) == error(10015)'); vrfy(appr(1.27,.1i) == error(10016), - '3623: appr(1.27,.1i) == error(10016)'); + '3624: appr(1.27,.1i) == error(10016)'); vrfy(appr(1.27,.1,.1) == error(10017), - '3624: appr(1.27,.1,.1) == error(10017)'); - vrfy(round("x") == error(10018), '3625: round("x") == error(10018)'); + '3625: appr(1.27,.1,.1) == error(10017)'); + vrfy(round("x") == error(10018), + '3626: round("x") == error(10018)'); vrfy(round(1.25,.1) == error(10019), - '3626: round(1.25,.1) == error(10019)'); + '3627: round(1.25,.1) == error(10019)'); vrfy(round(1.25,"x") == error(10019), - '3627: round(1.25,"x") == error(10019)'); + '3628: round(1.25,"x") == error(10019)'); vrfy(round(1.25,1,.1) == error(10020), - '3628: round(1.25,1,.1) == error(10020)'); - vrfy(bround("x") == error(10021), '3629: bround("x") == error(10021)'); + '3629: round(1.25,1,.1) == error(10020)'); + vrfy(bround("x") == error(10021), + '3630: bround("x") == error(10021)'); vrfy(bround(1.25,.1) == error(10022), - '3630: bround(1.25,.1) == error(10022)'); + '3631: bround(1.25,.1) == error(10022)'); vrfy(bround(1.25,"x") == error(10022), - '3631: bround(1.25,"x") == error(10022)'); + '3632: bround(1.25,"x") == error(10022)'); vrfy(bround(1.25,1,.1) == error(10023), - '3632: bround(1.25,1,.1) == error(10023)'); - vrfy(sqrt("x") == error(10024), '3633: sqrt("x") == error(10024)'); + '3633: bround(1.25,1,.1) == error(10023)'); + vrfy(sqrt("x") == error(10024), + '3634: sqrt("x") == error(10024)'); vrfy(sqrt(2,"x") == error(10025), - '3634: sqrt(2,"x") == error(10025)'); - vrfy(sqrt(2,0) == error(10025), '3635: sqrt(2,0) == error(10025)'); + '3635: sqrt(2,"x") == error(10025)'); + vrfy(sqrt(2,0) == error(10025), + '3636: sqrt(2,0) == error(10025)'); vrfy(sqrt(2,.1,.1) == error(10026), - '3636: sqrt(2,.1,.1) == error(10026)'); + '3637: sqrt(2,.1,.1) == error(10026)'); vrfy(root("x",3) == error(10027), - '3637: root("x",3) == error(10027)'); + '3638: root("x",3) == error(10027)'); vrfy(root(3,"x") == error(10028), - '3638: root(3,"x") == error(10028)'); + '3639: root(3,"x") == error(10028)'); vrfy(root(3,-2) == error(10028), - '3639: root(3,-2) == error(10028)'); - vrfy(root(3,0) == error(10028), '3640: root(3,0) == error(10028)'); + '3640: root(3,-2) == error(10028)'); + vrfy(root(3,0) == error(10028), + '3641: root(3,0) == error(10028)'); vrfy(root(3,.1) == error(10028), - '3641: root(3,.1) == error(10028)'); + '3642: root(3,.1) == error(10028)'); vrfy(root(3,2,"x") == error(10029), - '3642: root(3,2,"x") == error(10029)'); + '3643: root(3,2,"x") == error(10029)'); vrfy(root(3,2,0) == error(10029), - '3643: root(3,2,0) == error(10029)'); - vrfy(norm("x") == error(10030), '3644: norm("x") == error(10030)'); - vrfy("x" << 2 == error(10031), '3645: "x" << 2 == error(10031)'); - vrfy(1.5 << 2 == error(10031), '3646: 1.5 << 2 == error(10031)'); - vrfy(3 << "x" == error(10032), '3647: 3 << "x" == error(10032)'); - vrfy(3 << 1.5 == error(10032), '3648: 3 << 1.5 == error(10032)'); - vrfy(3 << 2^31 == error(10032), '3649: 3 << 2^31 == error(10032)'); + '3644: root(3,2,0) == error(10029)'); + vrfy(norm("x") == error(10030), '3645: norm("x") == error(10030)'); + vrfy(null() << 2 == error(10031),'3646: null() << 2 == error(10031)'); + vrfy(1.5 << 2 == error(10031), '3647: 1.5 << 2 == error(10031)'); + vrfy(3 << "x" == error(10032), '3648: 3 << "x" == error(10032)'); + vrfy(3 << 1.5 == error(10032), '3649: 3 << 1.5 == error(10032)'); + vrfy(3 << 2^31 == error(10032), '3650: 3 << 2^31 == error(10032)'); vrfy(scale("x",2) == error(10033), - '3650: scale("x",2) == error(10033)'); + '3651: scale("x",2) == error(10033)'); vrfy(scale(3,"x") == error(10034), - '3651: scale(3,"x") == error(10034)'); + '3652: scale(3,"x") == error(10034)'); vrfy(scale(3,1.5) == error(10034), - '3652: scale(3,1.5) == error(10034)'); + '3653: scale(3,1.5) == error(10034)'); vrfy(scale(3,2^31) == error(10034), - '3653: scale(3,2^31) == error(10034)'); - vrfy("x" ^ 3 == error(10035), '3654: "x" ^ 3 == error(10035)'); - vrfy(2 ^ "x" == error(10036), '3655: 2 ^ "x" == error(10036)'); - vrfy(2 ^ 2.5 == error(10036), '3656: 2 ^ 2.5 == error(10036)'); + '3654: scale(3,2^31) == error(10034)'); + vrfy("x" ^ 3 == error(10035), '3655: "x" ^ 3 == error(10035)'); + vrfy(2 ^ "x" == error(10036), '3656: 2 ^ "x" == error(10036)'); + vrfy(2 ^ 2.5 == error(10036), '3657: 2 ^ 2.5 == error(10036)'); vrfy(power("x",2.1) == error(10037), - '3657: power("x",2.1) == error(10037)'); + '3658: power("x",2.1) == error(10037)'); vrfy(power(2,"x") == error(10038), - '3658: power(2,"x") == error(10038)'); + '3659: power(2,"x") == error(10038)'); vrfy(power(2,2.1,"x") == error(10039), - '3659: power(2,2.1,"x") == error(10039)'); - vrfy(quo("x",3) == error(10040), '3660: quo("x",3) == error(10040)'); - vrfy(quo(8,"x") == error(10041), '3661: quo(8,"x") == error(10041)'); + '3660: power(2,2.1,"x") == error(10039)'); + vrfy(quo("x",3) == error(10040), + '3661: quo("x",3) == error(10040)'); + vrfy(quo(8,"x") == error(10041), + '3662: quo(8,"x") == error(10041)'); vrfy(quo(8,3,"x") == error(10042), - '3662: quo(8,3,"x") == error(10042)'); + '3663: quo(8,3,"x") == error(10042)'); vrfy(quo(8,3,2.1) == error(10042), - '3663: quo(8,3,2.1) == error(10042)'); - vrfy(mod("x",3) == error(10043), '3664: mod("x",3) == error(10043)'); - vrfy(mod(8,"x") == error(10044), '3665: mod(8,"x") == error(10044)'); + '3664: quo(8,3,2.1) == error(10042)'); + vrfy(mod("x",3) == error(10043), + '3665: mod("x",3) == error(10043)'); + vrfy(mod(8,"x") == error(10044), + '3666: mod(8,"x") == error(10044)'); vrfy(mod(8,3,"x") == error(10045), - '3666: mod(8,3,"x") == error(10045)'); + '3667: mod(8,3,"x") == error(10045)'); vrfy(mod(8,3,2.1) == error(10045), - '3667: mod(8,3,2.1) == error(10045)'); - vrfy(sgn("x") == error(10046), '3668: sgn("x") == error(10046)'); - vrfy(abs("x") == error(10047), '3669: abs("x") == error(10047)'); + '3668: mod(8,3,2.1) == error(10045)'); + vrfy(sgn("x") == error(10046), + '3669: sgn("x") == error(10046)'); + vrfy(abs("x") == error(10047), + '3670: abs("x") == error(10047)'); vrfy(abs(2+3i,"x") == error(10048), - '3670: abs(2+3i,"x") == error(10048)'); + '3671: abs(2+3i,"x") == error(10048)'); vrfy(abs(2+3i,0) == error(10048), - '3671: abs(2+3i,0) == error(10048)'); + '3672: abs(2+3i,0) == error(10048)'); list1 = list(2,3,"x",4,5); - print '3672: list1 = list(2,3,"x",4,5)'; + print '3673: list1 = list(2,3,"x",4,5)'; vrfy(avg(list1) == error(10003), - '3673: avg(list1) == error(10003)'); + '3674: avg(list1) == error(10003)'); - vrfy(iserror(e99)==99, '3674: iserror(e99) == 99'); - vrfy(e99 + 2 == e99, '3675: e99 + 2 == e99'); - vrfy(e99 - 2 == e99, '3676: e99 - 2 == e99'); - vrfy(e99 * 2 == e99, '3677: e99 * 2 == e99'); - vrfy(e99 / 2 == e99, '3678: e99 / 2 == e99'); - vrfy(e99 // 2 == e99, '3679: e99 // 2 == e99'); - vrfy(e99 % 2 == e99, '3680: e99 % 2 == e99'); - vrfy(e99 ^ 2 == e99, '3681: e99 ^ 2 == e99'); - vrfy(2 + e99 == e99, '3682: 2 + e99 == e99'); - vrfy(2 - e99 == e99, '3683: 2 - e99 == e99'); - vrfy(2 * e99 == e99, '3684: 2 * e99 == e99'); - vrfy(2 / e99 == e99, '3685: 2 / e99 == e99'); - vrfy(2 // e99 == e99, '3686: 2 // e99 == e99'); - vrfy(2 % e99 == e99, '3687: 2 % e99 == e99'); - vrfy(2 ^ e99 == e99, '3688: 2 ^ e99 == e99'); - vrfy(- e99 == e99, '3689: -e99 == e99'); - vrfy(inverse(e99) == e99, '3690: inverse(e99) == e99'); - vrfy(++e99 == e99, '3691: ++e99 == e99'); - vrfy(--e99 == e99, '3692: --e99 == e99'); - vrfy(int(e99) == e99, '3693: int(e99) == e99'); - vrfy(frac(e99) == e99, '3694: frac(e99) == e99'); - vrfy(conj(e99) == e99, '3695: conj(e99) == e99'); - vrfy(norm(e99) == e99, '3696: norm(e99) == e99'); - vrfy(sgn(e99) == e99, '3697: sgn(e99) == e99'); - vrfy(appr(e99,1,0) == e99, '3698: appr(e99,1,0) == e99'); - vrfy(round(e99) == e99, '3699: round(e99) == e99'); - vrfy(bround(e99) == e99, '3700: bround(e99) == e99'); - vrfy(sqrt(e99) == e99, '3701: sqrt(e99) == e99'); + vrfy(iserror(e99)==99, '3675: iserror(e99) == 99'); + vrfy(e99 + 2 == e99, '3676: e99 + 2 == e99'); + vrfy(e99 - 2 == e99, '3677: e99 - 2 == e99'); + vrfy(e99 * 2 == e99, '3678: e99 * 2 == e99'); + vrfy(e99 / 2 == e99, '3679: e99 / 2 == e99'); + vrfy(e99 // 2 == e99, '3680: e99 // 2 == e99'); + vrfy(e99 % 2 == e99, '3681: e99 % 2 == e99'); + vrfy(e99 ^ 2 == e99, '3682: e99 ^ 2 == e99'); + vrfy(2 + e99 == e99, '3683: 2 + e99 == e99'); + vrfy(2 - e99 == e99, '3684: 2 - e99 == e99'); + vrfy(2 * e99 == e99, '3685: 2 * e99 == e99'); + vrfy(2 / e99 == e99, '3686: 2 / e99 == e99'); + vrfy(2 // e99 == e99, '3687: 2 // e99 == e99'); + vrfy(2 % e99 == e99, '3688: 2 % e99 == e99'); + vrfy(2 ^ e99 == e99, '3689: 2 ^ e99 == e99'); + vrfy(- e99 == e99, '3690: -e99 == e99'); + vrfy(inverse(e99) == e99, '3691: inverse(e99) == e99'); + vrfy(++e99 == e99, '3692: ++e99 == e99'); + vrfy(--e99 == e99, '3693: --e99 == e99'); + vrfy(int(e99) == e99, '3694: int(e99) == e99'); + vrfy(frac(e99) == e99, '3695: frac(e99) == e99'); + vrfy(conj(e99) == e99, '3696: conj(e99) == e99'); + vrfy(norm(e99) == e99, '3697: norm(e99) == e99'); + vrfy(sgn(e99) == e99, '3698: sgn(e99) == e99'); + vrfy(appr(e99,1,0) == e99, '3699: appr(e99,1,0) == e99'); + vrfy(round(e99) == e99, '3700: round(e99) == e99'); + vrfy(bround(e99) == e99, '3701: bround(e99) == e99'); + vrfy(sqrt(e99) == e99, '3702: sqrt(e99) == e99'); + print '3703: a = newerror("alpha")'; + a = newerror("alpha"); + print '3704: b = newerror("beta")'; + b = newerror("beta"); + print '3705: c = newerror("alpha")'; + c = newerror("alpha"); + vrfy(a == c, '3706: a == c'); + vrfy(strerror(a) == "alpha", '3707: strerror(a) == "alpha"'); + print '3708: n = iserror(a)'; + n = iserror(a); + vrfy(a == error(n), '3709: a == error(n)'); + vrfy(newerror() == newerror("???"), + '3710: newerror() == newerror("???")'); + vrfy(newerror("") == newerror(), + '3711: newerror("") == newerror()'); + e999 = error(999); + print '3712: e999 = error(999)'; + vrfy(errno() == 999, '3713: errno() == 999'); + vrfy(error() == e999, '3714: error() == e999'); + vrfy(strerror() == "Error 999", '3715: strerror() == "Error 999"'); + x = newerror("Alpha"); + print '3716: x = newerror("Alpha")'; + n = iserror(x); + print '3717: n = iserror(x)'; + vrfy(errno() == n, '3718: errno() == n'); + vrfy(error() == x, '3719: error() == x'); + vrfy(strerror() == "Alpha", '3720: strerror() == "Alpha"'); + vrfy(errno(999) == n, '3721: errno() == n'); + vrfy(errno() == 999, '3722: errno() == 999'); + vrfy(error() == e999, '3723: error() == e999'); + vrfy(strerror() == "Error 999", '3724: strerror() == "Error 999"'); + a = 1/0; + print '3725: a = 1/0'; + vrfy(strerror() == "Division by zero", + '3726: strerror() == "Division by zero"'); - print '3702: Ending test_error'; + /* errmax and errcount should be bumped up the 148 errors above */ + vrfy(errcount() == ecnt, '3727: errcount() == ecnt'); + + print '3728: Ending test_error'; } print '054: parsed test_error()'; @@ -2914,10 +3050,10 @@ global u_glob = 5; print '057: global u_glob = 5'; global v_glob = 10; print '058: global v_glob = 10'; -vrfy(g_param(u_glob, &v_glob) == 5, '059: g_param(u_glob, &v_glob) == 5'); +vrfy(g_param(u_glob, `v_glob) == 5, '059: g_param(u_glob, `v_glob) == 5'); vrfy(u_glob == 5, '060: u_glob == 5'); vrfy(v_glob == 5, '061: v_glob == 5'); -vrfy(h_param(&u_glob, &v_glob) == 5, '062: h_param(&u_glob, &v_glob) == 5'); +vrfy(h_param(`u_glob, `v_glob) == 5, '062: h_param(`u_glob, `v_glob) == 5'); vrfy(u_glob == 6, '063: u_glob == 6'); vrfy(v_glob == 4, '064: v_glob == 4'); /**/ @@ -2931,10 +3067,10 @@ define test_param() print '3801: u = 5'; v = 10; print '3802: v = 10'; - vrfy(g_param(u, &v) == 5, '3803: g_param(u, &v) == 5'); + vrfy(g_param(u, `v) == 5, '3803: g_param(u, `v) == 5'); vrfy(u == 5, '3804: u == 5'); vrfy(v == 5, '3805: v == 5'); - vrfy(h_param(&u, &v) == 5, '3806: h_param(&u, &v) == 5'); + vrfy(h_param(`u, `v) == 5, '3806: h_param(`u, `v) == 5'); vrfy(u == 6, '3807: u == 6'); vrfy(v == 4, '3808: v == 4'); @@ -3036,102 +3172,102 @@ define test_fileops() /* * fputs tests */ - print '4201: x = rm("junk4200")'; - x = rm("junk4200"); + x = rm("-f", "junk4200"); + print '4201: x = rm("-f", "junk4200")'; vrfy(!iserror(f = fopen("junk4200", "w+")), '4202: !iserror(f = fopen("junk4200", "w+"))'); - vrfy(!iserror(fputs(f, LCN)), '4203: !iserror(fputs(f, LCN))'); - vrfy(isnull(rewind(f)), '4204: isnull(rewind(f))'); - vrfy(fgetfield(f) == L, '4205: fgetfield(f) == L'); - vrfy(fgetfield(f) == C, '4206: fgetfield(f) == C'); - vrfy(fgetfield(f) == N, '4207: fgetfield(f) == N'); - vrfy(isnull(fgetfield(f)), '4208: isnull(fgetfield(f))'); - vrfy(isnull(rewind(f)), '4209: isnull(rewind(f))'); - vrfy(fgetline(f) == L, '4210: fgetline(f) == L'); - vrfy(fgetline(f) == C, '4211: fgetline(f) == C'); - vrfy(fgetline(f) == N, '4212: fgetline(f) == N'); - vrfy(isnull(fgetline(f)), '4213: isnull(fgetline(f))'); - vrfy(isnull(rewind(f)), '4214: isnull(rewind(f))'); - vrfy(fgets(f) == strcat(L,"\n"),'4215: fgets(f) == strcat(L,"\\n")'); - vrfy(fgets(f) == strcat(C,"\n"),'4216: fgets(f) == strcat(C,"\\n")'); - vrfy(fgets(f) == strcat(N,"\n"),'4217: fgets(f) == strcat(N,"\\n")'); - vrfy(isnull(fgets(f)), '4218: isnull(fgets(f))'); - vrfy(isnull(rewind(f)), '4219: isnull(rewind(f))'); - vrfy(fgetstr(f) == LCN, '4220: fgetstr(f) == LCN'); - vrfy(isnull(fclose(f)), '4221: isnull(fclose(f))'); - vrfy(isnull(fclose(f)), '4222: isnull(fclose(f))'); + vrfy(!iserror(fputs(f, LCN)), '4203: !iserror(fputs(f, LCN))'); + vrfy(isnull(rewind(f)), '4204: isnull(rewind(f))'); + vrfy(fgetfield(f) == L, '4205: fgetfield(f) == L'); + vrfy(fgetfield(f) == C, '4206: fgetfield(f) == C'); + vrfy(fgetfield(f) == N, '4207: fgetfield(f) == N'); + vrfy(isnull(fgetfield(f)), '4208: isnull(fgetfield(f))'); + vrfy(isnull(rewind(f)), '4209: isnull(rewind(f))'); + vrfy(fgetline(f) == L, '4210: fgetline(f) == L'); + vrfy(fgetline(f) == C, '4211: fgetline(f) == C'); + vrfy(fgetline(f) == N, '4212: fgetline(f) == N'); + vrfy(isnull(fgetline(f)), '4213: isnull(fgetline(f))'); + vrfy(isnull(rewind(f)), '4214: isnull(rewind(f))'); + vrfy(fgets(f) == strcat(L,"\n"), '4215: fgets(f) == strcat(L,"\\n")'); + vrfy(fgets(f) == strcat(C,"\n"), '4216: fgets(f) == strcat(C,"\\n")'); + vrfy(fgets(f) == strcat(N,"\n"), '4217: fgets(f) == strcat(N,"\\n")'); + vrfy(isnull(fgets(f)), '4218: isnull(fgets(f))'); + vrfy(isnull(rewind(f)), '4219: isnull(rewind(f))'); + vrfy(fgetstr(f) == LCN, '4220: fgetstr(f) == LCN'); + vrfy(isnull(fclose(f)), '4221: isnull(fclose(f))'); + vrfy(isnull(fclose(f)), '4222: isnull(fclose(f))'); /* * fgetstr tests */ vrfy(!iserror(f = fopen("junk4200", "w+")), - '4223: !iserror(f)'); + '4223: !iserror(f)'); vrfy(isnull(fputstr(f, L, C, N)), - '4224: isnulll(fputstr(f, L, C, N))'); - vrfy(isnull(rewind(f)), '4225: isnull(rewind(f))'); - vrfy(fgetstr(f) == L, '4226: fgetstr(f) == L'); - vrfy(fgetstr(f) == C, '4227: fgetstr(f) == C'); - vrfy(fgetstr(f) == N, '4228: fgetstr(f) == N'); - vrfy(isnull(fgetstr(f)), '4229: isnull(fgetstr(f))'); + '4224: isnulll(fputstr(f, L, C, N))'); + vrfy(isnull(rewind(f)), '4225: isnull(rewind(f))'); + vrfy(fgetstr(f) == L, '4226: fgetstr(f) == L'); + vrfy(fgetstr(f) == C, '4227: fgetstr(f) == C'); + vrfy(fgetstr(f) == N, '4228: fgetstr(f) == N'); + vrfy(isnull(fgetstr(f)), '4229: isnull(fgetstr(f))'); n = ftell(f); - print '4230: n = ftell(f)'; + print '4230: n = ftell(f)'; vrfy(isnull(fputs(f,L,"\n",C,"\n",N,"\n")), '4231: isnull(fputs(f,L,"\\n",C,"\\n",N,"\\n"))'); fseek(f, n); - print '4232: fseek(f, n)'; - vrfy(fgetstr(f) == LCN, '4233: fgetstr(f) == LCN'); - vrfy(isnull(fclose(f)), '4234: isnull(fclose(f))'); + print '4232: fseek(f, n)'; + vrfy(fgetstr(f) == LCN, '4233: fgetstr(f) == LCN'); + vrfy(isnull(fclose(f)), '4234: isnull(fclose(f))'); /* * fscanf tests */ a = exp(27, 1e-1000); - print '4235: a = exp(27, 1e-1000)'; + print '4235: a = exp(27, 1e-1000)'; b = sqrt(7 + 5i, 1e-2000); - print '4236: b = sqrt(7 + 5i, 1e-2000)'; + print '4236: b = sqrt(7 + 5i, 1e-2000)'; c = config("display", 1000); - print '4237: c = config("display", 1000)'; + print '4237: c = config("display", 1000)'; vrfy(!iserror(f=fopen("junk4200","w+")), '4238: !iserror(f=fopen("junk4200","w+"))'); vrfy(!iserror(fprintf(f, "%f\n\tand\n\t%r",a,b)), '4239: !iserror(fprintf(f, "%f\\n\\tand\\n\\t%r",a,b))'); - vrfy(isnull(rewind(f)), '4240: isnull(rewind(f))'); - vrfy(fscanf(f,"%f and %r",x,y) == 2, - '4241: fscanf(f,"%f and %r",x,y) == 2'); - vrfy(x == a && y == b, '4242: x == a && y == b'); - vrfy(!iserror(freopen(f, "w+")),'4243: !iserror(freopen(f, "w+"))'); + vrfy(isnull(rewind(f)), '4240: isnull(rewind(f))'); + vrfy(fscanf(f,"%f and %r",x,y)==2, + '4241: fscanf(f,"%f and %r",x,y)==2'); + vrfy(x == a && y == b, '4242: x == a && y == b'); + vrfy(!iserror(freopen(f, "w+")), '4243: !iserror(freopen(f, "w+"))'); L = "Landon\n"; - print '4244: L = "Landon\\n"'; + print '4244: L = "Landon\\n"'; C = "\tCurt\n"; - print '4245: C = "\tCurt\\n"'; + print '4245: C = "\tCurt\\n"'; N = "\t\tNoll\n"; - print '4246: N = "\\t\\tNoll\\n"'; + print '4246: N = "\\t\\tNoll\\n"'; vrfy(isnull(fputs(f, L, "|", C, "[", N, "]" )), '4247: isnull(fputs(f, L, "|", C, "[", N, "]" ))'); - vrfy(isnull(rewind(f)), '4248: isnull(rewind(f))'); + vrfy(isnull(rewind(f)), '4248: isnull(rewind(f))'); vrfy(fscanf(f, "%[^|]%*c%[^[]%*c%[^]]", x,y,z) == 3, '4249: fscanf(f, "%[^|]%*c%[^[]%*c%[^]]", x,y,z) == 3'); vrfy(x == L && y == C && z == N, - '4250: x == L && y == C && z == N'); - vrfy(isnull(rewind(f)), '4251: isnull(rewind(f))'); + '4250: x == L && y == C && z == N'); + vrfy(isnull(rewind(f)), '4251: isnull(rewind(f))'); vrfy(fscanf(f, "%*[^|]%*c%n%*[^[]%*c%n", m, n) == 2, '4252: fscanf(f, "%*[^|]%*c%n%*[^[]%*c%n", m, n) == 2'); fseek(f, m); - print '4253: fseek(f, m)'; - vrfy(fscanf(f, "%3c", x) == 1, '4254: fscanf(f, "%3c", x) == 1'); - vrfy(x == "\tCu", '4255: x == "\tCu"'); + print '4253: fseek(f, m)'; + vrfy(fscanf(f, "%3c", x) == 1, '4254: fscanf(f, "%3c", x) == 1'); + vrfy(x == "\tCu", '4255: x == "\tCu"'); fseek(f, n); - print '4256: fseek(f, n)'; - vrfy(fscanf(f, "%s", y) == 1, '4257: fscanf(f, "%s", y) == 1'); - vrfy(y == "Noll", '4258: y == "Noll"'); - vrfy(isnull(fclose(f)), '4259: isnull(fclose(f))'); + print '4256: fseek(f, n)'; + vrfy(fscanf(f, "%s", y) == 1, '4257: fscanf(f, "%s", y) == 1'); + vrfy(y == "Noll", '4258: y == "Noll"'); + vrfy(isnull(fclose(f)), '4259: isnull(fclose(f))'); /* * cleanup */ - print '4260: x = rm("junk4200")'; x = rm("junk4200"); + print '4260: x = rm("junk4200")'; print '4261: Ending test_fileops'; } @@ -3143,8 +3279,8 @@ print '071: parsed test_redc()'; */ mat_X0 = mat[4]; print '072: mat_X = mat[4]'; -mat mat_X1, mat_X2[2], mat_X3[3]; -print '073: mat mat_X1, mat_X2[2], mat_X3[3]'; +mat mat_X1, mat_X2[2]; mat mat_X3[3]; +print '073: mat mat_X1, mat_X2[2]; mat mat_X3[3]'; mat mat_Z0, mat_Z1 [2] = {1,2}; print '074: mat mat_Z0, mat_Z1 [2] = {1,2}'; define test_matdcl() @@ -3201,44 +3337,47 @@ define test_matdcl() vrfy(mat_Y3[0] == 0, '4337: mat_Y3[0] == 0'); vrfy(mat_Y3[1] == 6, '4338: mat_Y3[1] == 6'); vrfy(mat_Y3[2] == 8, '4339: mat_Y3[2] == 8'); + ecnt += 2; + print '4340: ecnt += 2'; mat_Y3 += 2; - print '4340: mat_Y3 += 2'; - vrfy(mat_Y3 == error(10003), '4341: mat_Y3 == error(10003)'); + print '4341: mat_Y3 += 2'; + vrfy(mat_Y3 == error(10003), '4342: mat_Y3 == error(10003)'); + vrfy(errcount() == ecnt, '4343: errcount() == ecnt'); mat_Z0 += { }; - print '4342: mat_Z0 += { }'; - vrfy(mat_Z0[0] == 2, '4343: mat_Z0[0] == 2'); - vrfy(mat_Z0[1] == 4, '4344: mat_Z0[1] == 4'); + print '4344: mat_Z0 += { }'; + vrfy(mat_Z0[0] == 2, '4345: mat_Z0[0] == 2'); + vrfy(mat_Z0[1] == 4, '4346: mat_Z0[1] == 4'); mat_Y0 = {mat_Z0, ,mat_Z1, mat_X3}; - print '4345: mat_Y0 = {mat_Z0, ,mat_Z1, mat_X3}'; - vrfy(size(mat_Y0) == 4, '4346: size(mat_Y0) == 4'); + print '4347: mat_Y0 = {mat_Z0, ,mat_Z1, mat_X3}'; + vrfy(size(mat_Y0) == 4, '4348: size(mat_Y0) == 4'); for (i=0; i < 4; ++i) mat_X0[i] = size(mat_Y0[i]); - print '4347: for (i=0; i < 4; ++i) mat_X0[i] = size(mat_Y0[i])'; + print '4349: for (i=0; i < 4; ++i) mat_X0[i] = size(mat_Y0[i])'; mat_X0==(mat[4]={2,1,2,3}); - print '4348: mat_X0==(mat[4]={2,1,2,3})'; - vrfy(mat_Y0[0] == mat_Z0, '4349: mat_Y0[0] == mat_Z0'); - vrfy(mat_Y0[1] == 0, '4350: mat_Y0[1] == 0'); - vrfy(mat_Y0[2] == mat_Z1, '4351: mat_Y0[2] == mat_Z1'); - vrfy(mat_Y0[3] == mat_X3, '4352: mat_Y0[3] == mat_X3'); - vrfy(mat_Y0[0][0] == 2, '4353: mat_Y0[0][0] == 2'); - vrfy(mat_Y0[0][1] == 4, '4354: mat_Y0[0][1] == 4'); - vrfy(mat_Y0[2][0] == 1, '4355: mat_Y0[2][0] == 1'); - vrfy(mat_Y0[2][1] == 3, '4356: mat_Y0[2][1] == 3'); - vrfy(mat_Y0[3][0] == 5, '4357: mat_Y0[3][0] == 5'); - vrfy(mat_Y0[3][1] == 7, '4358: mat_Y0[3][1] == 7'); - vrfy(mat_Y0[3][2] == 10, '4359: mat_Y0[3][2] == 10'); + print '4350: mat_X0==(mat[4]={2,1,2,3})'; + vrfy(mat_Y0[0] == mat_Z0, '4351: mat_Y0[0] == mat_Z0'); + vrfy(mat_Y0[1] == 0, '4352: mat_Y0[1] == 0'); + vrfy(mat_Y0[2] == mat_Z1, '4353: mat_Y0[2] == mat_Z1'); + vrfy(mat_Y0[3] == mat_X3, '4354: mat_Y0[3] == mat_X3'); + vrfy(mat_Y0[0][0] == 2, '4355: mat_Y0[0][0] == 2'); + vrfy(mat_Y0[0][1] == 4, '4356: mat_Y0[0][1] == 4'); + vrfy(mat_Y0[2][0] == 1, '4357: mat_Y0[2][0] == 1'); + vrfy(mat_Y0[2][1] == 3, '4358: mat_Y0[2][1] == 3'); + vrfy(mat_Y0[3][0] == 5, '4359: mat_Y0[3][0] == 5'); + vrfy(mat_Y0[3][1] == 7, '4360: mat_Y0[3][1] == 7'); + vrfy(mat_Y0[3][2] == 10, '4361: mat_Y0[3][2] == 10'); M0 = {(mat[2]={5,17}),(mat[2]={3,4}),(mat[2]={2,3}),(mat[2]={1,2})}; - print '4360: M0 = {(mat[2]={5,17}), ...}'; + print '4362: M0 = {(mat[2]={5,17}), ...}'; M1 = {(mat[2]={5,3}),(mat[2]={2,5}),(mat[2]={1,5}),(mat[2]={3,2})}; - print '4361: M1 = {(mat[2]={5,3}), ...}'; + print '4363: M1 = {(mat[2]={5,3}), ...}'; M2 = M0+M1; - print '4362: M2 = M0+M1'; - vrfy(M2[0,0]==(mat[2]={10,20}), '4363: M2[0,0]==(mat[2]={10,20})'); - vrfy(M2[0,1]==(mat[2]={5,9}), '4364: M2[0,1]==(mat[2]={5,9})'); - vrfy(M2[1,0]==(mat[2]={3,8}), '4365: M2[1,0]==(mat[2]={3,20})'); - vrfy(M2[1,1]==(mat[2]={4,4}), '4366: M2[1,1]==(mat[2]={4,4})'); + print '4364: M2 = M0+M1'; + vrfy(M2[0,0]==(mat[2]={10,20}), '4365: M2[0,0]==(mat[2]={10,20})'); + vrfy(M2[0,1]==(mat[2]={5,9}), '4366: M2[0,1]==(mat[2]={5,9})'); + vrfy(M2[1,0]==(mat[2]={3,8}), '4367: M2[1,0]==(mat[2]={3,20})'); + vrfy(M2[1,1]==(mat[2]={4,4}), '4368: M2[1,1]==(mat[2]={4,4})'); - print '4367: Ending test_matdcl'; + print '4369: Ending test_matdcl'; } print '075: parsed test_matdcl()'; @@ -3265,7 +3404,7 @@ define test_objmat() P = {M0,M1}; print '4402: P = {M0,M1}'; vrfy(P == surd(M0,M1), '4403: P == surd(M0,M1)'); - vrfy(P != surd(M1,M0), '4404: P == surd(M1,M0)'); + vrfy(P != surd(M1,M0), '4404: P != surd(M1,M0)'); vrfy(conj(P)==surd(M0,-M1), '4405: conj(P)==surd(M0,-M1)'); Q = surd_value(P); print '4406: Q = surd_value(P)'; @@ -3388,7 +3527,7 @@ define test_objmat() print '4462: mat A[2,2][2,2]={{1,2,3,4},{5,6,7,8},{9,10,11,12},{13,14,15,16}}'; B = A^2; print '4463: B = A^2'; - + vrfy(B[0,0] == (mat[2,2] = {118, 132, 166, 188}), \ '4464: B[0,0] == (mat[2,2] = {118, 132, 166, 188})'); @@ -3425,8 +3564,8 @@ x_081 = isqrt(2e5000); print '079: x_081 = isqrt(2e5000)' s_x_081 = str(x_081); print '080: s_x_081 = str(x_081)'; -d_081 = rm("test082.cal"); -print '081: d_081 = rm("test082.cal")'; +d_081 = rm("-f", "test082.cal"); +print '081: d_081 = rm("-f", "test082.cal")'; write test082.cal; print '082: write test082.cal'; read "./test082.cal"; @@ -3563,9 +3702,3414 @@ print '088: parsed test_fileop()'; /* - * place holder for any print items + * global and static assignment tests */ -print '100: reserved for future use'; +global a = 10, b, c d = 20, e, f; +print '089: global a = 10, b, c d = 20, e, f'; +vrfy(a == 10, '090: a == 10'); +vrfy(b == 0, '091: b == 0'); +vrfy(c == 20, '092: c == 20'); +vrfy(d == 20, '093: d == 20'); +vrfy(e == 0, '094: e == 0'); +vrfy(f == 0, '095: f == 0'); +static a b = 30, c, e = 30; +print '096: static a b = 30, c, e = 30'; +vrfy(a == 30, '097: a == 30'); +vrfy(b == 30, '098: b == 30'); +vrfy(c == 0, '099: c == 0'); +vrfy(e == 30, '100: e == 30'); +global a, b; +print '101: global a, b'; +vrfy(a == 10, '102: a == 10'); +vrfy(b == 0, '103: b == 0'); +static mat A, B[2,2] = {1,2,3,4}; +print '104: static mat A, B[2,2] = {1,2,3,4}'; +define f100(x,y) = (mat [2,2] = {x,0,0,y}) * A; +print '105: define f100(x,y) = (mat [2,2] = {x,0,0,y}) * A'; +define g100(x) = (mat[2,2] = {x,x,x,x}) + B; +print '106: define g100(x) = (mat[2,2] = {x,x,x,x}) + B'; +define h100(a,b,c,d) = ((B = {a,b,c,d}), null()); +print '107: define h100(a,b,c,d) = ((B = {a,b,c,d}), null())'; +global A, B; +print '108: global A, B'; +vrfy(A == 0, '109: A == 0'); +vrfy(B == 0, '110: B == 0'); +x = test(f100(2,3) == (mat[2,2] = {2, 4, 9, 12})); +vrfy(x, '111: test(f100(2,3) == (mat[2,2] = {2, 4, 9, 12}))'); +x = test(g100(4) == (mat[2,2] = {5,6,7,8})); +vrfy(x, '112: test(g100(4) == (mat[2,2] = {5,6,7,8}))'); +x = test(h100(2,3,5,7) == null()); +vrfy(x, '113: test(h100(2,3,5,7) == null())'); +x = test(g100(4) == (mat[2,2] = {6,7,9,11})); +vrfy(x, '114: test(g100(4) == (mat[2,2] = {6,7,9,11}))'); +global obj point {x,y} P Q = {1,2}, R={3,4}, S; +print '115: global obj point {x,y} P, Q = {1,2}, R={3,4}, S'; +vrfy(P.x == 1, '116: P.x == 1'); +vrfy(P.y == 2, '117: P.y == 2'); +vrfy(Q.x == 1, '118: Q.x == 1'); +vrfy(Q.y == 2, '119: Q.y == 2'); +vrfy(R.x == 3, '120: R.x == 3'); +vrfy(R.y == 4, '121: R.y == 4'); +vrfy(S.x == 0, '122: S.x == 0'); +vrfy(S.y == 0, '123: S.y == 0'); + + +/* + * test_listsearch - test searching in lists + */ +define test_listsearch() +{ + local L; + + print '4900: Beginning test_listsearch'; + + L = list(); + print '4901: L = list()'; + vrfy(isnull(search(L,1)), '4902: isnull(search(L,1))'); + vrfy(isnull(rsearch(L,1)), '4903: isnull(search(L,1))'); + L = list(0,1,2,3,0,1,2,3,0,1); + print '4904: L = list(0,1,2,3,0,1,2,3,0,1)'; + vrfy(search(L,0) == 0, '4905: search(L,0) == 0'); + vrfy(rsearch(L,0) == 8, '4906: rsearch(L,0) == 8'); + vrfy(search(L,0,2) == 4, '4907: search(L,0,2) == 4'); + vrfy(rsearch(L,0,7) == 4, '4908: rsearch(L,0,7) == 4'); + vrfy(isnull(search(L,2,7)), '4909: isnull(search(L,2,7))'); + vrfy(isnull(rsearch(L,3,2)), '4910: isnull(rsearch(L,3,2))'); + vrfy(isnull(search(L,0,1,4)), '4911: isnull(search(L,0,1,4)'); + vrfy(isnull(rsearch(L,0,1,4)), '4912: isnull(rsearch(L,0,1,4)'); + vrfy(search(L,0,-5) == 8, '4913: search(L,0,-5) == 8'); + vrfy(rsearch(L,0,-9,-2) == 4, '4914: rsearch(L,0,-9,-2) == 4'); + vrfy(isnull(search(L,3,20)), '4915: isnull(search(L,3,20)'); + vrfy(isnull(search(L,3,0,-20)), '4916: isnull(search(L,3,0,-20)'); + vrfy(isnull(rsearch(L,3,20,2)), '4917: isnull(rsearch(L,3,20,2)'); + vrfy(rsearch(L,3,-20,20) == 7, '4918: rsearch(L,3,-20,20) == 7'); + + print '4919: Ending test_strprintf'; +} +print '124: parsed test_listsearch()'; + + +/* + * test_filesearch - test searching in files + * + * This function is designed to trigger 22 errors, so we bump the + * errmax by 22 during this call. + */ +define test_filesearch() +{ + local f, g; /* open files */ + local s; /* local string */ + local a, b, c, d; /* new error values */ + local x; + + print '5000: Beginning test_filesearch'; + + /* + * setup + */ + print '5001: x = rm("-f", "junk5000")'; + x = rm("-f", "junk5000"); + f = fopen("junk5000", "w"); + print '5002: f = fopen("junk5000", "w")'; + if (iserror(f)) { + prob("Unable to open \"junk5000\" for writing"); + return; + } + print '5003: if (iserror(f)) { ... }'; + s = "alpha beta gamma "; + print '5004: s = "alpha beta gamma "'; + + fputs(f, s); + print '5005: fputs(f, s)'; + fflush(f); + print '5006: fflush(f)'; + print '5007: test unused'; + + /* bump errmax up by 16 */ + ecnt += 16; + print '5008: ecnt += 16'; + + vrfy(search(f, 45) == error(10122), + '5009: search(f, 45) == error(10122)'); + vrfy(search(f, "a", 1/2) == error(10123), + '5010: search(f, "a", 1/2) == error(10123)'); + vrfy(search(f, "a", 0, "b") == error(10124), + '5011: search(f, "a", 0, "b") == error(10124)'); + vrfy(search(f, "a", 0) == error(10126), + '5012: search(f, "a") == error(10126)'); + vrfy(rsearch(f, 45) == error(10128), + '5013: rsearch(f, 45) == error(10128)'); + vrfy(rsearch(f, "a", "b") == error(10129), + '5014: rsearch(f, "a", "b") == error(10129)'); + vrfy(rsearch(f, "a", 0, "b") == error(10130), + '5015: rsearch(f, "a", 0, "b") == error(10130)'); + vrfy(rsearch(f, "a", 0) == error(10132), + '5016: rsearch(f,"a",0) == error(10132)'); + + /* errmax and errcount should be bumped up the 16 errors above */ + vrfy(errcount() == ecnt, '5017: errcount() == ecnt'); + + if (freopen(f, "r")) { + prob("Unable to reopen \"junk5000\" for reading"); + return; + } + print '5018: if (freopen(f, "r")) { ... }'; + vrfy(fsize(f) == 17, '5019: fsize(f) == 17'); + vrfy(search(f, s, 0) == 0, '5020: search(f, s, 0) == 0'); + vrfy(ftell(f) == 17, '5021: ftell(f) == 17'); + vrfy(rsearch(f, s, 0) == 0, '5022: rsearch(f, s, 0) == 0'); + vrfy(ftell(f) == 16, '5023: ftell(f) == 16'); + vrfy(search(f, "", 2) == 2, '5024: search(f, "", 2) == 2'); + vrfy(ftell(f) == 2, '5025: ftell(f) == 2'); + vrfy(search(f, "", 17) == 17, '5026: search(f, "", 17) == 17'); + vrfy(ftell(f) == 17, '5027: ftell(f) == 17'); + vrfy(isnull(search(f, "", 100)), + '5028: isnull(search(f, "", 100))'); + vrfy(ftell(f) == 17, '5029: ftell(f) == 17'); + vrfy(rsearch(f, "", 5) == 5, '5030: rsearch(f, "", 5) == 5'); + vrfy(ftell(f) == 5, '5031: ftell(f) == 5'); + vrfy(search(f, "beta", 0) == 6, '5032: search(f, "beta", 0) == 6'); + vrfy(ftell(f) == 10, '5033: ftell(f) == 10'); + vrfy(rsearch(f, "beta", 100) == 6, + '5034: rsearch(f, "beta", 100) == 6'); + vrfy(ftell(f) == 9, '5035: ftell(f) == 9'); + vrfy(search(f, "a", 2) == 4, '5036: search(f, "a", 2) == 4'); + vrfy(ftell(f) == 5, '5037: ftell(f) == 5'); + vrfy(search(f, "a", 4) == 4, '5038: search(f, "a", 4) == 4'); + vrfy(search(f, "m") == 13, '5039: search(f, "m") == 13'); + vrfy(search(f, "m") == 14, '5040: search(f, "m") == 14'); + vrfy(isnull(search(f, "m")), '5041: isnull(search(f, "m"))'); + vrfy(rsearch(f, "m", 15) == 14, '5042: rsearch(f, "m", 14) == 14'); + vrfy(isnull(search(f, "beta", 7)), + '5043: isnull(search(f, "beta", 7))'); + vrfy(ftell(f) == 14, '5044: ftell(f) == 14'); + vrfy(search(f,"a",2,15) == 4, '5045: search(f,"a",2,15) == 4'); + vrfy(ftell(f) == 5, '5046: ftell(f) == 5'); + vrfy(isnull(search(f,"a",2,4)), '5047: isnull(search(f,"a",2,4))'); + vrfy(ftell(f) == 4, '5048: ftell(f) == 4'); + vrfy(search(f,"a",,5) == 4, '5049: search(f,"a",,5) == 4'); + vrfy(rsearch(f,"a",2,15) == 12, '5050: rsearch(f,"a",2,15) == 12'); + vrfy(ftell(f) == 12, '5051: ftell(f) == 12'); + vrfy(rsearch(f,"a",2,12) == 9, '5052: rsearch(f,"a",2,12) == 9'); + + /* generate 2 more errors */ + ecnt += 2; + print '5053: ecnt += 2'; + a = 2 + ""; + print '5054: a = 2 + ""'; + g = fopen(3, "r"); + print '5055: g = fopen(3, "r")'; + c = 5^2; + print '5056: c = 5^2'; + vrfy(errcount() == ecnt, '5057: errcount() == ecnt'); + + /* generate 4 more errors by testing newerror */ + ecnt += 4; + print '5058: ecnt += 4'; + a = newerror("alpha"); + print '5059: a = newerror("alpha")'; + b = newerror("beta"); + print '5060: b = newerror("beta")'; + c = newerror("alpha"); + print '5061: c = newerror("alpha")'; + d = newerror("beta"); + print '5062: d = newerror("beta")'; + vrfy(errcount() == ecnt, '5063: errcount() == ecnt'); + vrfy(a == c, '5064: a == c'); + vrfy(b == d, '5065: b == d'); + + /* test error(0) */ + error(0); + print '5066: error(0)'; + vrfy(strerror() == "No error", '5067: strerror() == "No error"'); + + /* + * close down + */ + fclose(f); + print '5068: fclose(f)'; + rm("junk5000"); + print '5069: rm("junk5000")'; + + print '5070: Ending test_filesearch'; +} +print '125: parsed test_filesearch()'; + + +/* + * test_newdecl - test the new code generator declaration scope and order + */ +read -once "test5100"; +print '126: read -once test5100'; +/**/ +define test_newdecl() +{ + + print '5100: Beginning test_newdecl'; + + /* + * test5100 calls + */ + test5100(1); + print '5101: test5100(1)'; + vrfy(a5100 == 0, '5102: a5100 == 0'); + vrfy(b5100 == 2, '5103: b5100 == 2'); + test5100(1); + print '5104: test5100(1)'; + vrfy(a5100 == 0, '5105: a5100 == 0'); + vrfy(b5100 == 3, '5106: b5100 == 3'); + test5100(1); + print '5107: test5100(1)'; + vrfy(a5100 == 0, '5108: a5100 == 0'); + vrfy(b5100 == 4, '5109: b5100 == 4'); + test5100(2); + print '5110: test5100(2)'; + vrfy(a5100 == 3, '5111: a5100 == 3'); + vrfy(b5100 == 4, '5112: b5100 == 4'); + test5100(2); + print '5113: test5100(2)'; + vrfy(a5100 == 4, '5114: a5100 == 4'); + vrfy(b5100 == 4, '5115: b5100 == 4'); + test5100(2); + print '5116: test5100(2)'; + vrfy(a5100 == 5, '5117: a5100 == 5'); + vrfy(b5100 == 4, '5118: b5100 == 4'); + test5100(3); + print '5119: test5100(3)'; + vrfy(a5100 == 5, '5120: a5100 == 5'); + vrfy(b5100 == 5, '5121: b5100 == 5'); + test5100(9); + print '5122: test5100(9)'; + vrfy(a5100 == 5, '5123: a5100 == 5'); + vrfy(b5100 == 6, '5124: b5100 == 6'); + test5100(0); + print '5125: test5100(0)'; + vrfy(a5100 == 5, '5126: a5100 == 5'); + vrfy(b5100 == 6, '5127: b5100 == 6'); + test5100(-1); + print '5128: test5100(-1)'; + vrfy(a5100 == 5, '5129: a5100 == 5'); + vrfy(b5100 == 6, '5130: b5100 == 6'); + + print '5131: Ending test_newdecl'; + +} +print '127: parsed test_newdecl()'; + + +/* + * test_globstat - test the fix of a global/static bug + */ +read -once "test5200"; +print '128: read -once test5200'; +/**/ +define test_globstat() +{ + print '5200: Beginning test_globstat'; + + /* + * test {f,g,h}5200 calls + */ + vrfy(a5200 == 10, '5201: a5200 == 10'); + vrfy(eval("a5200") == 10, '5202: eval("a5200") == 10'); + vrfy(f5200(1) == 21, '5203: f5200(1) == 21'); + vrfy(a5200 == 10, '5204: a5200 == 10'); + vrfy(eval("a5200") == 10, '5205: eval("a5200") == 10'); + vrfy(h5200(2) == 12, '5206: h5200(2) == 12'); + vrfy(a5200 == 10, '5207: a5200 == 10'); + vrfy(eval("a5200") == 10, '5208: eval("a5200") == 10'); + vrfy(g5200(3) == 33, '5209: g5200(3) == 33'); + vrfy(a5200 == 30, '5210: a5200 == 30'); + vrfy(eval("a5200") == 30, '5211: eval("a5200") == 30'); + vrfy(h5200(4) == 34, '5212: h5200(4) == 34'); + vrfy(f5200(5) == 25, '5213: f5200(5) == 25'); + vrfy(h5200(6) == 36, '5214: h5200(6) == 36'); + vrfy(g5200(7) == 37, '5215: g5200(7) == 37'); + vrfy(f5200(8) == 28, '5216: f5200(8) == 28'); + vrfy(g5200(9) == 39, '5217: g5200(9) == 39'); + vrfy(a5200 == 30, '5218: a5200 == 30'); + vrfy(eval("a5200") == 30, '5219: eval("a5200") == 30'); + + print '5220: Ending test_globstat'; +} +print '129: parsed test_globstat()'; + + +/* + * test_newop2 - test new label stuff + */ +define test_newop2(x) {if (x < 0) goto l130; ++x; l130: return x;} +print '130: define test_newop3(x) {if (x < 0) goto l130; ++x; l130: return x;}' +vrfy(test_newop2(100) == 101, '131: test_newop2(100) == 101'); +vrfy(test_newop2(-100) == -100, '132: test_newop2(-100) == -100'); + + +/* + * test_newop3 - test new label stuff + */ +define test_newop3(x) { + if (x < 4) + if (iseven(x)) + goto l135; + else + return 2; + return 3; + l135: + return 1; +} +print '133: define test_newop3(x) ...'; +vrfy(test_newop3(2) == 1, '134: test_newop3(2) == 1'); +vrfy(test_newop3(3) == 2, '135: test_newop3(3) == 2'); +vrfy(test_newop3(4) == 3, '136: test_newop3(4) == 3'); + + +/* + * Test random - Blum-Blum-Shub pseudo-random number generator + */ +define test_random() +{ + local init; /* initial generator state */ + local state0; /* a generator state */ + local state1; /* a generator state */ + local tmp; + local n; + + print '5300: Beginning random test'; + + /* test save and restore of the initial state */ + tmp = srandom(0); + print '5301: tmp = srandom(0)'; + init = srandom(); + print '5302: init = srandom()'; + state0 = srandom(0); + print '5303: state0 = srandom(0)'; + vrfy(state0 == init, '5304: state0 == init'); + + /* test the additive 55 shuffle generator */ + tmp = srandom(0); + print '5305: tmp = srandom(0)'; + vrfy(random() == 0x7fb838a8a0a95046, \ + '5306: random() == 0x7fb838a8a0a95046'); + vrfy(random() == 0xb9d9d9fb4440f7bb, \ + '5307: random() == 0xb9d9d9fb4440f7bb'); + tmp = srandom(init); + print '5308: tmp = srandom(init)'; + vrfy(random() == 0x7fb838a8a0a95046, \ + '5309: random() == 0x7fb838a8a0a95046'); + vrfy(random() == 0xb9d9d9fb4440f7bb, \ + '5310: random() == 0xb9d9d9fb4440f7bb'); + + /* test range interface */ + tmp = srandom(0); + print '5311: tmp = srandom(0)'; + vrfy(random(12345678901234567890) == 0x7fb838a8a0a95046, \ + '5312: random(12345678901234567890) == 0x7fb838a8a0a95046'); + vrfy(random(216091) == 0x2e767, '5313: random(216091) == 0x2e767'); + vrfy(random(100) == 0x33, '5314: random(100) == 0x33'); + vrfy(random(-46,46) == -0xc, '5315: random(-46,46) == -0xc'); + tmp = srandom(0); + print '5316: tmp = srandom(0)'; + vrfy(random(2^64) == 0x7fb838a8a0a95046, \ + '5317: random(2^64) == 0x7fb838a8a0a95046'); + vrfy(random(0,2^64) == 0xb9d9d9fb4440f7bb, \ + '5318: random(0,2^64) == 0xb9d9d9fb4440f7bb'); + + /* test different forms of seeding the initial state */ + tmp = srandom(0); + print '5319: tmp = srandom(0)'; + vrfy(srandom() == init, '5320: srandom() == init'); + tmp = srandom(0x87e6ec938ff55aa5<<64); + print '5321: tmp = srandom(0x87e6ec938ff55aa5<<64)'; + vrfy(srandom() == init, '5322: srandom() == init'); + tmp = srandom(state0); + print '5323: tmp = srandom(state0)'; + vrfy(srandom() == init, '5324: srandom() == init'); + tmp = srandom(init); + print '5325: tmp = srandom(init)'; + vrfy(srandom() == init, '5326: srandom() == init'); + vrfy(tmp == init, '5327: tmp == init'); + + /* test the bit length interface */ + tmp = srandom(0); + print '5328: tmp = srandomom(0)'; + vrfy(randombit(64) == 0x7fb838a8a0a95046, \ + '5329: randombit(64) == 0x7fb838a8a0a95046'); + vrfy(randombit(128) == 0xb9d9d9fb4440f7bbc1a7bd3b4e853fc9, \ + '5330: randombit(128) == 0xb9d9d9fb4440f7bbc1a7bd3b4e853fc9'); + vrfy(randombit(64) == 0x2d4e1588719986aa, \ + '5331: randombit(64) == 0x2d4e1588719986aa'); + vrfy(randombit(128) == 0x8d68905434b020ccb849e17a03a5c441, \ + '5332: randombit(128) == 0x8d68905434b020ccb849e17a03a5c441'); + tmp = srandom(0); + print '5333: tmp = srandom(0)'; + vrfy(randombit(32) == 0x7fb838a8, '5334: randombit(32) == 0x7fb838a8'); + vrfy(randombit(32) == 0xa0a95046, '5335: randombit(32) == 0xa0a95046'); + vrfy(randombit(1) == 0x1, '5336: randombit(1) == 0x1'); + vrfy(randombit(5) == 0xe, '5337: randombit(5) == 0xe'); + vrfy(randombit(33) == 0xececfda2, '5338: randombit(33) == 0xececfda2'); + vrfy(randombit(25) == 0x40f7bb, '5339: randombit(25) == 0x40f7bb'); + vrfy(randombit(2) == 0x3, '5340: randombit(2) == 0x3'); + vrfy(randombit(13) == 0xd3, '5341: randombit(13) == 0xd3'); + vrfy(randombit(18) == 0x37a76, '5342: randombit(18) == 0x37a76'); + vrfy(randombit(8) == 0x9d, '5343: randombit(8) == 0x9d'); + vrfy(randombit(9) == 0x14, '5344: randombit(9) == 0x14'); + vrfy(randombit(70) == 0x3fc92d4e1588719986, \ + '5345: randombit(70) == 0x3fc92d4e1588719986'); + vrfy(randombit(123) == 0x5546b4482a1a5810665c24f0bd01d2e, \ + '5346: randombit(123) == 0x5546b4482a1a5810665c24f0bd01d2e'); + vrfy(randombit(8) == 0x22, '5347: randombit(8) == 0x22'); + vrfy(randombit(65) == 0x1d2a104aaf523699, \ + '5348: randombit(65) == 0x1d2a104aaf523699'); + vrfy(randombit(63) == 0x60e63d498ba690ec, \ + '5349: randombit(63) == 0x60e63d498ba690ec'); + vrfy(randombit(1) == 0x1, '5350: randombit(1) == 0x1'); + vrfy(randombit(2) == 0x3, '5351: randombit(2) == 0x3'); + vrfy(randombit(4) == 0x0, '5352: randombit(4) == 0x0'); + vrfy(randombit(3) == 0x0, '5353: randombit(3) == 0x0'); + state1 = srandom(); + print '5354: state1 = srandom()'; + + /* test randombit skip interface */ + tmp = srandom(0); + print '5355: tmp = srandom(0)'; + vrfy(randombit(20) == 523139, '5356: randombit(20) == 523139'); + vrfy(randombit(20) == 567456, '5357: randombit(20) == 567456'); + vrfy(randombit(20) == 693508, '5358: randombit(20) == 693508'); + vrfy(randombit(20) == 440793, '5359: randombit(20) == 440793'); + tmp = srandom(0); + print '5360: tmp = srandom(0)'; + vrfy(randombit(-20) == 20, '5361: randombit(-20) == 20'); + vrfy(randombit(20) == 567456, '5362: randombit(20) == 567456'); + vrfy(randombit(-20) == 20, '5363: randombit(-20) == 20'); + vrfy(randombit(20) == 440793, '5364: randombit(20) == 440793'); + + /* test randombit without and arg */ + tmp = srandom(0); + print '5365: tmp = srandom(0)'; + vrfy(randombit() == 0, '5366: randombit() == 0'); + vrfy(randombit() == 1, '5367: randombit() == 1'); + vrfy(randombit() == 1, '5368: randombit() == 1'); + + /* test range interface some more */ + tmp = srandom(state1); + print '5369: tmp = srandom(0)'; + vrfy(random(-46,46) == -0x7, '5370: random(-46,46) == -0x7'); + vrfy(random(21701,23209) == 23061, + '5371: random(21701,23209) == 23061'); + vrfy(random(0x22,0x1d2a104aaf523699) == 0x17c97dfa80bbdf1b, + '5372: random(0x22,0x1d2a104aaf523699) == 0x17c97dfa80bbdf1b'); + vrfy(random(0x2d4e16aa,0x7fb83046) == 0x48e98d92, + '5373: random(0x2d4e16aa,0x7fb83046) == 0x48e98d92'); + vrfy(random(-0x2d4986aa,0x7fb83846) == 0x3b3f6c0c, + '5374: random(-0x2d4986aa,0x7fb83846) == 0x3b3f6c0c'); + vrfy(random(-0x2d9986aa,-0x7fb9504) == -0x235f9ce1, + '5375: random(-0x2d9986aa,-0x7fb9504) == -0x235f9ce1'); + + + /* test pre-compiled random states */ + tmp = srandom(init); + print '5376: tmp = srandom(init)'; + state0 = srandom(0,1); + print '5377: state0 = srandom(0,1)'; + vrfy(randombit(123) == 0x4cf8834399f8832d5c1ec35f20095f0, \ + '5378: randombit(123) == 0x4cf8834399f8832d5c1ec35f20095f0'); + state1 = srandom(123455432112345,1); + print '5379: state1 = srandom(123455432112345,1)'; + vrfy(randombit(123) == 0x437c9618d5a9c07d935b0ff7cef7346, \ + '5380: randombit(123) == 0x437c9618d5a9c07d935b0ff7cef7346'); + tmp = srandom(0,1); + print '5381: tmp = srandom(0,1)'; + vrfy(randombit(-123) == 123, '5382: randombit(-123) == 123'); + vrfy(srandom() == state1, '5383: srandom() == state1'); + tmp = srandom(0,2); + print '5384: tmp = srandom(0,2)'; + vrfy(randombit(123) == 0x7d53b2dbfe1edcb07df84f7fe96d5e9, \ + '5385: randombit(123) == 0x7d53b2dbfe1edcb07df84f7fe96d5e9'); + tmp = srandom(0,3); + print '5386: tmp = srandom(0,3)'; + vrfy(randombit(123) == 0x365cbae1adb9a706816abe3b64c1f2a, \ + '5387: randombit(123) == 0x365cbae1adb9a706816abe3b64c1f2a'); + tmp = srandom(0,4); + print '5388: tmp = srandom(0,4)'; + vrfy(randombit(123) == 0x63d9621736e59a3a5a8311117a1ef01, \ + '5389: randombit(123) == 0x63d9621736e59a3a5a8311117a1ef01'); + tmp = srandom(0,5); + print '5390: tmp = srandom(0,5)'; + vrfy(randombit(123) == 0x38d90517d6d532d1efb6eaf26bf927, \ + '5391: randombit(123) == 0x38d90517d6d532d1efb6eaf26bf927'); + tmp = srandom(0,6); + print '5392: tmp = srandom(0,6)'; + vrfy(randombit(123) == 0x146f2a1ce8cabcc313ab24f73747fbc, \ + '5393: randombit(123) == 0x146f2a1ce8cabcc313ab24f73747fbc'); + tmp = srandom(0,7); + print '5394: tmp = srandom(0,7)'; + vrfy(randombit(123) == 0x7a4a2b4ed817e5267358ea2979155d8, \ + '5395: randombit(123) == 0x7a4a2b4ed817e5267358ea2979155d8'); + tmp = srandom(0,8); + print '5396: tmp = srandom(0,8)'; + vrfy(randombit(123) == 0x5f30f211464854a37989cca3a8ecd0a, \ + '5397: randombit(123) == 0x5f30f211464854a37989cca3a8ecd0a'); + tmp = srandom(0,9); + print '5398: tmp = srandom(0,9)'; + vrfy(randombit(123) == 0x73aa8e572ee77682ae317804ed8d6e5, \ + '5399: randombit(123) == 0x73aa8e572ee77682ae317804ed8d6e5'); + tmp = srandom(0,10); + print '5400: tmp = srandom(0,10)'; + vrfy(randombit(123) == 0x49c7acca8f461ad2edf4cb7651f18d3, \ + '5401: randombit(123) == 0x49c7acca8f461ad2edf4cb7651f18d3'); + tmp = srandom(0,11); + print '5402: tmp = srandom(0,11)'; + vrfy(randombit(123) == 0x6042e2169a73140ffab1881df99a0ee, \ + '5403: randombit(123) == 0x6042e2169a73140ffab1881df99a0ee'); + tmp = srandom(0,12); + print '5404: tmp = srandom(0,12)'; + vrfy(randombit(123) == 0x7b98097947d478611d96f4d7a1cd2af, \ + '5405: randombit(123) == 0x7b98097947d478611d96f4d7a1cd2af'); + tmp = srandom(0,13); + print '5406: tmp = srandom(0,13)'; + vrfy(randombit(123) == 0x12324fd76d7a4a5a979765be2d57cfa, \ + '5407: randombit(123) == 0x12324fd76d7a4a5a979765be2d57cfa'); + tmp = srandom(0,14); + print '5408: tmp = srandom(0,14)'; + vrfy(randombit(123) == 0x377ff9ef04ee24887984995f91489a3, \ + '5409: randombit(123) == 0x377ff9ef04ee24887984995f91489a3'); + tmp = srandom(0,15); + print '5410: tmp = srandom(0,15)'; + vrfy(randombit(123) == 0x7db2b6245c5a24a1a52f74c8f828c6f, \ + '5411: randombit(123) == 0x7db2b6245c5a24a1a52f74c8f828c6f'); + tmp = srandom(0,16); + print '5412: tmp = srandom(0,16)'; + vrfy(randombit(123) == 0x5958e6cc460c28a5e741706fd442f12, \ + '5413: randombit(123) == 0x5958e6cc460c28a5e741706fd442f12'); + tmp = srandom(0,17); + print '5414: tmp = srandom(0,17)'; + vrfy(randombit(123) == 0x68c40ccf3805b2734d0d2881ca268d, \ + '5415: randombit(123) == 0x68c40ccf3805b2734d0d2881ca268d'); + tmp = srandom(0,18); + print '5416: tmp = srandom(0,18)'; + vrfy(randombit(123) == 0x4afc6cd3b9e14dadc5b75c6a81602e5, \ + '5417: randombit(123) == 0x4afc6cd3b9e14dadc5b75c6a81602e5'); + tmp = srandom(0,19); + print '5418: tmp = srandom(0,19)'; + vrfy(randombit(123) == 0x3ea4d30abf7da6596d2425e0a9a6348, \ + '5419: randombit(123) == 0x3ea4d30abf7da6596d2425e0a9a6348'); + tmp = srandom(0,20); + print '5420: tmp = srandom(0,20)'; + vrfy(randombit(123) == 0x77f848c70d4622ed41956eceb3f15f6, \ + '5421: randombit(123) == 0x77f848c70d4622ed41956eceb3f15f6'); + vrfy(randombit(123) == 0x5bfa034925acaf7ad5ba5d8f7f32369, \ + '5422: randombit(123) == 0x5bfa034925acaf7ad5ba5d8f7f32369'); + vrfy(randombit(123) == 0x761100a4cecbdac8c8d539dee0e278e, \ + '5423: randombit(123) == 0x761100a4cecbdac8c8d539dee0e278e'); + + + tmp = srandom(7^23+19,2); + print '5424: tmp = srandom(7^23+19,2)'; + vrfy(randombit(123) == 0x89b7ec9413e8af84a0c64ffc64d5a8, \ + '5425: randombit(123) == 0x89b7ec9413e8af84a0c64ffc64d5a8'); + tmp = srandom(7^23+19,3); + print '5426: tmp = srandom(7^23+19,3)'; + vrfy(randombit(123) == 0x7a2b8a6ca93a29deb1c3a674a30bf26, \ + '5427: randombit(123) == 0x7a2b8a6ca93a29deb1c3a674a30bf26'); + tmp = srandom(7^23+19,4); + print '5428: tmp = srandom(7^23+19,4)'; + vrfy(randombit(123) == 0x5425c6614dffcc0f376de4e9355c7df, \ + '5429: randombit(123) == 0x5425c6614dffcc0f376de4e9355c7df'); + tmp = srandom(7^23+19,5); + print '5430: tmp = srandom(7^23+19,5)'; + vrfy(randombit(123) == 0x70fca502499fa3717e346df5438886d, \ + '5431: randombit(123) == 0x70fca502499fa3717e346df5438886d'); + tmp = srandom(7^23+19,6); + print '5432: tmp = srandom(7^23+19,6)'; + vrfy(randombit(123) == 0x6ff886ac0918ad503290544af2cbd03, \ + '5433: randombit(123) == 0x6ff886ac0918ad503290544af2cbd03'); + tmp = srandom(7^23+19,7); + print '5434: tmp = srandom(7^23+19,7)'; + vrfy(randombit(123) == 0x5747d8c33d6d6dc53357779dffcc430, \ + '5435: randombit(123) == 0x5747d8c33d6d6dc53357779dffcc430'); + tmp = srandom(7^23+19,8); + print '5436: tmp = srandom(7^23+19,8)'; + vrfy(randombit(123) == 0x12769f65324d5e7986120b0caf071ad, \ + '5437: randombit(123) == 0x12769f65324d5e7986120b0caf071ad'); + tmp = srandom(7^23+19,9); + print '5438: tmp = srandom(7^23+19,9)'; + vrfy(randombit(123) == 0x3f94d3585b986539158f6ccd97d261e, \ + '5439: randombit(123) == 0x3f94d3585b986539158f6ccd97d261e'); + tmp = srandom(7^23+19,10); + print '5440: tmp = srandom(7^23+19,10)'; + vrfy(randombit(123) == 0x12874c359fffc6c0eda2aebfea97c71, \ + '5441: randombit(123) == 0x12874c359fffc6c0eda2aebfea97c71'); + tmp = srandom(7^23+19,11); + print '5442: tmp = srandom(7^23+19,11)'; + vrfy(randombit(123) == 0x7e0480a70c6f32f6594db8fd58ada7, \ + '5443: randombit(123) == 0x7e0480a70c6f32f6594db8fd58ada7'); + tmp = srandom(7^23+19,12); + print '5444: tmp = srandom(7^23+19,12)'; + vrfy(randombit(123) == 0x7f900aa8c7b9dacb6bf4ca0f5f81cb8, \ + '5445: randombit(123) == 0x7f900aa8c7b9dacb6bf4ca0f5f81cb8'); + tmp = srandom(7^23+19,13); + print '5446: tmp = srandom(7^23+19,13)'; + vrfy(randombit(123) == 0x39311c5aa41e42bb5d7807bdb60aecc, \ + '5447: randombit(123) == 0x39311c5aa41e42bb5d7807bdb60aecc'); + tmp = srandom(7^23+19,14); + print '5448: tmp = srandom(7^23+19,14)'; + vrfy(randombit(123) == 0x508bc8c5bd4555262b7ecd32a1ecd8e, \ + '5449: randombit(123) == 0x508bc8c5bd4555262b7ecd32a1ecd8e'); + tmp = srandom(7^23+19,15); + print '5450: tmp = srandom(7^23+19,15)'; + vrfy(randombit(123) == 0x442d2076b8d58d3815841180e8401b6, \ + '5451: randombit(123) == 0x442d2076b8d58d3815841180e8401b6'); + tmp = srandom(7^23+19,16); + print '5452: tmp = srandom(7^23+19,16)'; + vrfy(randombit(123) == 0x38db53974de9d3eea82a6ba35d2dc53, \ + '5453: randombit(123) == 0x38db53974de9d3eea82a6ba35d2dc53'); + tmp = srandom(7^23+19,17); + print '5454: tmp = srandom(7^23+19,17)'; + vrfy(randombit(123) == 0x42c1d9d86c9c67acb518ee008ce8f38, \ + '5455: randombit(123) == 0x42c1d9d86c9c67acb518ee008ce8f38'); + tmp = srandom(7^23+19,18); + print '5456: tmp = srandom(7^23+19,18)'; + vrfy(randombit(123) == 0x10dc81d7ef0a7aeb4aea1d4ac1fac2a, \ + '5457: randombit(123) == 0x10dc81d7ef0a7aeb4aea1d4ac1fac2a'); + tmp = srandom(7^23+19,19); + print '5458: tmp = srandom(7^23+19,19)'; + vrfy(randombit(123) == 0x469f8d91b643e0bcc4b5d5c2fe61cfb, \ + '5459: randombit(123) == 0x469f8d91b643e0bcc4b5d5c2fe61cfb'); + tmp = srandom(7^23+19,20); + print '5460: tmp = srandom(7^23+19,20)'; + vrfy(randombit(123) == 0x7f056e87cfcbe04a072e17502ef38f5, \ + '5461: randombit(123) == 0x7f056e87cfcbe04a072e17502ef38f5'); + vrfy(randombit(123) == 0x5d10d7665e56dee0ec5ea7d918ba073, \ + '5462: randombit(123) == 0x5d10d7665e56dee0ec5ea7d918ba073'); + vrfy(randombit(123) == 0x2058f802dd42b3aee4e734eacc13057, \ + '5463: randombit(123) == 0x2058f802dd42b3aee4e734eacc13057'); + + print '5464: Ending test_random'; +} +print '137: parsed test_random()'; + + +/* + * test_newsyn - test new command completion syntax and scope rules + */ +for (s5500 = 0, i = 0; i < 5; i++) + s5500 += i; +print "138: for (s5500 = 0, i = 0; i < 5; i++) s5500 += i;"; +vrfy(s5500 == 10, '139: s5500 == 10'); +vrfy(i == 5, '140: i == 5'); +for (s5500 = 0, i = 0; i < 9; i++) +{ + s5500 += i; +} +print "141: for (s5500 = 0, i = 0; i < 9; i++) { s5500 += i; }"; +vrfy(s5500 == 36, '142: s5500 == 36'); +vrfy(i == 9, '143: i == 9'); +{ + local i; + for (s5500 = 0, i = 0; i < 10; i++) + s5500 += i; + vrfy(s5500 == 45, '144: s5500 == 45'); + vrfy(i == 10, '145: i == 10'); +} +print "146: { local i; for (s5500 = 0, i = 0; i < 10; i++) s5500 += i; ... }"; +vrfy(s5500 == 45, '147: s5500 == 45'); +vrfy(i == 9, '148: i == 9'); +/**/ +define test_newsyn() +{ + local i; /* loop counter */ + + print '5500: Beginning test_newsyn'; + + /* + * check basic for loop completion and scoping + */ + for (s5500 = 0, i = 0; i < 5; i++) + s5500 += i; + print "5501: for (s5500 = 0, i = 0; i < 5; i++) s5500 += i;"; + vrfy(s5500 == 10, '5502: s5500 == 10'); + vrfy(i == 5, '5503: i == 5'); + /**/ + for (s5500 = 0, i = 0; i < 6; i++) + { + s5500 += i; + } + print "5504: for (s5500 = 0, i = 0; i < 6; i++) { s5500 += i; }"; + vrfy(s5500 == 15, '5505: s5500 == 15'); + vrfy(i == 6, '5506: i == 6'); + /**/ + for (s5500 = 0, i = 0; i < 3; i++) { + s5500 += i; + } + print "5507: for (s5500 = 0, i = 0; i < 3; i++) { s5500 += i; }"; + vrfy(s5500 == 3, '5508: s5500 == 3'); + vrfy(i == 3, '5509: i == 3'); + /**/ + { + local i; + for (s5500 = 0, i = 0; i < 11; i++) + s5500 += i; + vrfy(s5500 == 55, '5510: s5500 == 45'); + vrfy(i == 11, '5511: i == 11'); + } + print "5512: { local i; for (s5500 = 0, i = 0; i < 10; i++) s5500 += i; ... }"; + vrfy(s5500 == 55, '5513: s5500 == 55'); + vrfy(i == 11, '5514: i == 11'); + + /* + * test completion of while loops + */ + i = 0; + print '5515: i = 0'; + s5500 = 0; + print '5516: s5500 = 0'; + while (++i < 4) + s5500 += i; + print "5517: while (++i < 4) s5500 += i;"; + vrfy(s5500 == 6, '5518: s5500 == 6'); + vrfy(i == 4, '5519: i == 4'); + /**/ + i = 0; + print '5520: i = 0'; + s5500 = 0; + print '5521: s5500 = 0'; + while (++i < 7) + { + s5500 += i; + } + print "5522: while (++i < 7) { s5500 += i; }"; + vrfy(s5500 == 21, '5523: s5500 == 21'); + vrfy(i == 7, '5524: i == 7'); + /**/ + i = 0; + print '5525: i = 0'; + s5500 = 0; + print '5526: s5500 = 0'; + while (++i < 8) { + s5500 += i; + } + print "5527: while (++i < 8) { s5500 += i; }"; + vrfy(s5500 == 28, '5528: s5500 == 28'); + vrfy(i == 8, '5529: i == 8'); + + /* + * test completion of do-while loops + */ + i = 0; + print '5530: i = 0'; + s5500 = 0; + print '5531: s5500 = 0'; + do + s5500 += i; + while (++i < 12); + print "5532: do s5500 += i; while (++i < 12);"; + vrfy(s5500 == 66, '5533: s5500 == 66'); + vrfy(i == 12, '5534: i == 12'); + /**/ + i = 0; + print '5535: i = 0'; + s5500 = 0; + print '5536: s5500 = 0'; + do { + s5500 += i; + } while (++i < 14) + print "5537: do { s5500 += i; } while (++i < 14);"; + vrfy(s5500 == 91, '5538: s5500 == 91'); + vrfy(i == 14, '5539: i == 14'); + /**/ + i = 0; + print '5540: i = 0'; + s5500 = 0; + print '5541: s5500 = 0'; + do + { + s5500 += i; + } + while (++i < 13) + ; + print "5542: do { s5500 += i; } while (++i < 13);"; + vrfy(s5500 == 78, '5543: s5500 == 78'); + vrfy(i == 13, '5544: i == 13'); + + /* + * test the completion of switch + */ + switch (i) { + case 12: prob("switch showed i was 12 instead of 13"); break; + case 13: + vrfy(i == 13, '5545: i == 13'); + break; + default: + prob("switch showed i was something other than 13"); + break; + } + switch + ( + i + ) + { + case + 1 + : + prob( + "switch showed i was 1 instead of 13" + ) + ; + break + ; + case + 2 + : + prob( + "switch showed i was 2 instead of 13" + ) + ; + break + ; + default + : + vrfy + ( + i + == + 13 + , + '5546: i == 13' + ) + ; + } + + print '5547: Ending test_newsyn'; +} +print '149: parsed test_newsyn()'; +vrfy(s5500 == 45, '150: s5500 == 45'); +vrfy(i == 9, '151: i == 9'); + + +/* + * test_commaeq - test changes to , and = + */ +obj xx5600 {} xx5600; +print '152: obj xx5600 {} xx5600'; +define xx5600_print() = printf("xx"); +print '153: xx5600_print() = printf("xx")'; +/**/ +define test_commaeq() +{ + local i; + local A, B, C, D; + local a5600 = 0, b5600 = 0; + obj xy5600 {x, y}; + + /* + * Calculations with i + */ + print '5600: Beginning test_commaeq'; + i = 5; + print '5601: i = 5'; + vrfy(i == 5, '5602: i == 5'); + i += 2 *= 3 -= 1; + print '5603: i += 2 *= 3 -= 1'; + vrfy(i == 20, '5604: i == 20'); + ++i /= 7; + print '5607: ++i /= 7'; + vrfy(i == 3, '5608: i == 3'); + + /* + * xx5600 object type + */ + mat A[3] = {1,2,xx5600}; + print '5609: mat A[3] = {1,2,xx5600}'; + vrfy(A[2] == xx5600, '5610: A[2] == xx5600'); + vrfy(strprintf("%d", xx5600) == "xx", + '5611: strprintf("%d", xx5600) == "xx"'); + + /* + * xy5600 object type + */ + obj xy5600 A = {1, 2} = {3, 4}; + print '5612: obj xy5600 A = {1, 2} = {3, 4}'; + vrfy(A.x == 3, '5613: A.x == 3'); + vrfy(A.y == 4, '5614: A.y == 4'); + obj xy5600 B = {A,A}; + print '5613: obj xy5600 B = {A,A}'; + vrfy(B.x.x == 3, '5615: B.x.x == 3'); + vrfy(B.y.y == 4, '5616: B.y.y == 4'); + obj xy5600 C; + print '5617: obj xy5600 C'; + C = {1, 2} = {C, C}; + print '5618: C = {1, 2} = {C, C}'; + vrfy(C.x.x == 1, '5619: C.x.x == 1'); + vrfy(C.y.x.y == 2, '5620: C.y.x.y == 2'); + D = 7; + print '5621: D = 7'; + obj xy5600 D = {1,2} = {D,D}; + print '5622: obj xy5600 D = {1,2} = {D,D}'; + vrfy(D.x == 7, '5623: D.x == 7'); + vrfy(D.y == 7, '5624: D.y == 7'); + + /* + * matrix assignment + */ + mat A[3] = {1,2,3}, B[2] = {1,2}; + print '5625: mat A[3] = {1,2,3}, B[2] = {1,2}'; + vrfy(A[0] == 1, '5626: A[0] == 1'); + vrfy(B[1] == 2, '5627: B[1] == 2'); + + /* + * misc = and , expressions + */ + vrfy(((a5600 = 2, b5600) = 3) && a5600 + b5600 == 5, + '5628: ((a5600 = 2, b5600) = 3) && a5600 + b5600 == 5'); + vrfy((2 ? a5600 : b5600 = 4) && a5600 == 4, + '5629: (2 ? a5600 : b5600 = 4) && a5600 == 4'); + vrfy((0 ? a5600 : b5600 = 5) && b5600 == 5, + '5630: (0 ? a5600 : b5600 = 5) && b5600 == 5'); + vrfy((a5600 || b5600 = 6) && a5600 == 6 && b5600 == 5, + '5631: (a5600 || b5600 = 6) && a5600 == 6 && b5600 == 5'); + vrfy((a5600 && b5600 = 7) && a5600 == 6 && b5600 == 7, + '5632: (a5600 && b5600 = 7) && a5600 == 6 && b5600 == 7'); + + print '5633: Ending test_commaeq'; +} +print '155: parsed test_commaeq()'; + + +/* + * test_size - test what we can about sizes + * + * Since sizeof() and memsize() deal with machine specific sizes and + * compiler structure layout issues, we cannot just determine if + * these builtin values return a specific value. + */ +define test_size() +{ + local z; /* test integer values */ + local q; /* test rational values */ + local c; /* test complex values */ + local m; /* test matrix */ + local l; /* test list */ + local a; /* test association */ + + print '5700: Beginning test_size'; + + /* + * 0, -1 and 1 values are reported as 0 sizeof + */ + vrfy(sizeof(0) == 0, '5701: sizeof(0) == 0'); + vrfy(sizeof(1) == 0, '5702: sizeof(1) == 0'); + vrfy(sizeof(-1) == 0, '5703: sizeof(-1) == 0'); + z = 0; + print '5704: z = 0'; + vrfy(sizeof(z) == 0, '5705: sizeof(z) == 0'); + z = 1; + print '5706: z = 1'; + vrfy(sizeof(z) == 0, '5707: sizeof(z) == 0'); + z = -1; + print '5708: z = -1'; + vrfy(sizeof(z) == 0, '5709: sizeof(z) == 0'); + + /* + * non-integer rationals are larger than integers + */ + q = 13/2; + print '5710: q = 13/2'; + vrfy(sizeof(13)*2 == sizeof(q), '5711: sizeof(13)*2 == sizeof(q)'); + q = 13; + print '5712: q = 13'; + vrfy(sizeof(13) == sizeof(q), '5713: sizeof(13) == sizeof(q)'); + q = (17^139 + 674) / (17^139 + 686); + print '5714: q = (17^139 + 674) / (17^139 + 686)'; + vrfy(sizeof(17^139 + 674)*2 == sizeof(q), + '5715: sizeof(17^139 + 674)*2 == sizeof(q)'); + + /* + * recipricals are the same size of their integer inverses + */ + q = 1/13; + print '5716: q = 1/13'; + vrfy(sizeof(13) == sizeof(q), '5717: sizeof(13) == sizeof(q)'); + q = 1/(17^139 + 674); + print '5718: q = 1/(17^139 + 674)'; + vrfy(sizeof(17^139 + 674) == sizeof(q), + '5717: sizeof(17^139 + 674) == sizeof(q)'); + + /* + * negative values are the same size as positive values + */ + vrfy(sizeof(17^139 + 674) == sizeof(-q), + '5718: sizeof(17^139 + 674) == sizeof(-q)'); + vrfy(sizeof(-(17^139 + 674)) == sizeof(-q), + '5719: sizeof(-(17^139 + 674)) == sizeof(-q)'); + q = 1/-13; + print '5720: q = 1/-13'; + vrfy(sizeof(13) == sizeof(q), '5721: sizeof(13) == sizeof(q)'); + + /* + * complex values with a real or imaginary part of 0, 1 or -1 + * are the same size as rationals + */ + c = 0 + 4i; + print '5722: c = 0 + 4i'; + vrfy(sizeof(3) == sizeof(c), '5723: sizeof(3) == sizeof(c)'); + c = 3 + 0i; + print '5724: c = 3 + 0i'; + vrfy(sizeof(3) == sizeof(c), '5725: sizeof(3) == sizeof(c)'); + c = 1 + 4i; + print '5726: c = 1 + 4i'; + vrfy(sizeof(3) == sizeof(c), '5727: sizeof(3) == sizeof(c)'); + c = 3 + 1i; + print '5728: c = 3 + 1i'; + vrfy(sizeof(3) == sizeof(c), '5729: sizeof(3) == sizeof(c)'); + c = -1 + 4i; + print '5730: c = -1 + 4i'; + vrfy(sizeof(3) == sizeof(c), '5731: sizeof(3) == sizeof(c)'); + c = 3 + -1i; + print '5732: c = 3 + -1i'; + vrfy(sizeof(3) == sizeof(c), '5733: sizeof(3) == sizeof(c)'); + + /* + * general complex values are twice the size as rationals + */ + c = 3 + 4i; + print '5734: c = 3 + 4i'; + vrfy(sizeof(3)*2 == sizeof(c), '5735: sizeof(3)*2 == sizeof(c)'); + z = 17^139 + 686; + print '5736: z = 17^139 + 686'; + c = z + z*1i; + print '5737: c = z + z*1i'; + vrfy(sizeof(z)*2 == sizeof(c), '5738: sizeof(z)*2 == sizeof(c)'); + q = 1/(17^139 + 674); + print '5739: q = 1/(17^139 + 674)'; + c = q + q*1i; + print '5740: c = q + q*1i'; + vrfy(sizeof(q)*2 == sizeof(c), '5741: sizeof(q)*2 == sizeof(c)'); + c = (z*q) + (1/(z*q))*1i; + print '5742: c = (z*q) + (1/(z*q))*1i'; + vrfy(sizeof(z*q)*2 == sizeof(c), '5743: sizeof(z*q)*2 == sizeof(c)'); + vrfy(sizeof(z)*4 == sizeof(c), '5744: sizeof(z)*4 == sizeof(c)'); + vrfy(sizeof(q)*4 == sizeof(c), '5745: sizeof(q)*4 == sizeof(c)'); + + /* + * size of numeric values is always 1 + */ + vrfy(size(0) == 1, '5746: size(0) == 1'); + vrfy(size(1) == 1, '5747: size(1) == 1'); + vrfy(size(13^10) == 1, '5748: size(13^10) == 1'); + vrfy(size(z) == 1, '5749: size(z) == 1'); + vrfy(size(q) == 1, '5750: size(q) == 1'); + vrfy(size(c) == 1, '5751: size(c) == 1'); + + /* + * size of a matrix is the sum of the sizes of the elements + * sizeof of a matrix is the sum of the sizeofs of the elements + */ + mat m[] = {z,q,c}; + print '5752: mat m[] = {z,q,c}'; + vrfy(size(m) == size(z)+size(q)+size(c), + '5753: size(m) == size(z)+size(q)+size(c)'); + vrfy(sizeof(m) == sizeof(z)+sizeof(q)+sizeof(c), + '5754: sizeof(m) == sizeof(z)+sizeof(q)+sizeof(c)'); + + /* + * size of a list is the number of elements + * sizeof of a list is the sum of the sizeof's of the elements + */ + l = list(z,q,c,m); + print '5755: list(z,q,c,m)'; + vrfy(size(l) == 4, '5756: size(l) == 4'); + vrfy(sizeof(l) == 2*sizeof(m), '5757: sizeof(l) == 2*sizeof(m)'); + + /* + * size of an assoc is the number of elements + * sizeof of an assoc is the sum of the sizeof's of the elements + */ + a = assoc(); + print '5758: a = assoc()'; + a["z"] = z+1; + print '5759: a["z"] = z+1'; + a["q"] = q+2; + print '5760: a["q"] = q+2'; + a["c"] = c+3; + print '5761: a["c"] = c+3'; + a[m] = m; + print '5762: a[m] = m'; + a[l] = l; + print '5763: a[l] = l'; + vrfy(size(a) == 5, '5764: size(a) == 5'); + vrfy(sizeof(a) == 25*sizeof(z), '5765: sizeof(a) == 25*sizeof(z)'); + + /* + * about all we can say about memsize is that it will always be + * larger than sizeof + */ + vrfy(sizeof(z) < memsize(z), '5766: sizeof(z) < memsize(z)'); + vrfy(sizeof(q) < memsize(q), '5767: sizeof(q) < memsize(q)'); + vrfy(sizeof(c) < memsize(c), '5768: sizeof(c) < memsize(c)'); + vrfy(sizeof(m) < memsize(m), '5769: sizeof(m) < memsize(m)'); + vrfy(sizeof(l) < memsize(l), '5770: sizeof(l) < memsize(l)'); + vrfy(sizeof(a) < memsize(a), '5771: sizeof(a) < memsize(a)'); + + print '5772: Ending test_size'; +} +print '156: parsed test_size()'; + + +/* + * test_assign - test assignment of constants and variables + */ +global A, B; /* A, B for "constants" */ +print '157: global A, B'; +global X5800, Y5800; /* X5800, Y5800 for "variables" */ +print '158: global X5800, Y5800'; +obj xy5800 {x, y}; +print '159: obj xy5800 {x, y}'; +/**/ +define test_assign(base, work) +{ + print base: ': Beginning test_assign'; + + /* + * value assignments + */ + A = base+1; + print base+1: ': A = base+1'; + B = base+2; + print base+2: ': B = base+2'; + X5800 = base+3; + print base+3: ': X5800 = base+3'; + Y5800 = base+4; + print base+4: ': Y5800 = base+4'; + obj xy5800 A={1,2}, B={3,4}; + print base+5: ': obj xy5800 A={1,2}, B={3,4}'; + + /* + * test assignment + */ + X5800 = A; + print base+6: ': X5800 = A'; + if (work) { + vrfy(X5800 == A, strprintf('%d: X5800 == A', base+7)); + X5800 = Y5800 = B; + print base+8: ': X5800 = Y5800 = B'; + } else { + vrfy(X5800 == B, strprintf('%d: X5800 == B', base+7)); + X5800 = Y5800 = A; + print base+8: ': X5800 = Y5800 = A'; + } + vrfy(X5800 == B, strprintf('%d: X5800 == B', base+9)); + vrfy(Y5800 == B, strprintf('%d: Y5800 == B', base+10)); + + print base+11: ': Ending test_assign'; +} +print '160: test_assign()'; + + +/* + * test_is - test is functions + */ +vrfy(isobjtype("xy5900") == 0, '161: isobjtype("xy5900") == 0'); +obj xy5900 {x, y}; +print '162: obj xy5900 {x, y}'; +vrfy(isobjtype("xy5900") == 1, '163: isobjtype("xy5900") == 1'); +/**/ +vrfy(isdefined("fun5900") == 0, '164: isdefined("fun5900") == 0'); +define fun5900() { return 1; }; +print '165: define fun5900() { return 1; }'; +vrfy(isdefined("fun5900") == 2, '166: isdefined("fun5900") == 2'); +undefine fun5900; +vrfy(isdefined("fun5900") == 0, '167: isdefined("fun5900") == 0'); +/**/ +define test_is() +{ + local loc; /* unassigned local variable */ + local a; /* assoc */ + local ofd; /* open file descriptor */ + local cfd; /* closed file descriptor */ + local blk; /* unnamed block */ + local nblk; /* named block */ + local cfg; /* config state */ + local serr; /* system value */ + local nerr; /* new error value */ + local odd; /* odd integer */ + local even; /* even integer that is 10 times odd */ + local hash; /* sha hash value */ + local id; /* identity matrix */ + local list; /* list value */ + local matrix; /* non-identity matrix */ + local nul; /* null value */ + local object; /* object */ + local rand; /* rand seed */ + local random; /* random seed */ + local real; /* real non-intger value */ + local prime; /* odd prime */ + local square; /* square of an odd prime */ + local string; /* string */ + local com; /* complex value */ + + print '5900: Beginning test_is'; + + /* + * setup values + */ + a = assoc(); + print '5901: a = assoc()'; + ofd = fopen("/dev/null", "r"); + print '5902: ofd = fopen("/dev/null", "r")'; + cfd = fopen("/dev/null", "r"); + print '5903: cfd = fopen("/dev/null", "r")'; + fclose(cfd); + print '5904: fclose(cfd)'; + blk = blk(); + print '5905: blk = blk()'; + nblk = blk("blk5900"); + print '5906: nblk = blk("blk5900")'; + cfg = config("all"); + print '5907: cfg = config("all")'; + ecnt += 2; + print '5908: ecnt += 2'; + serr = error(1); + print '5909: serr = error(1)'; + nerr = newerror("curds"); + print '5910: nerr = newerror("curds")'; + odd = 23209; + print '5911: odd = 23209'; + even = odd*10; + print '5912: even = odd*10'; + hash = sha(); + print '5913: hash = sha()'; + mat id[3,3] = {1,0,0,0,1,0,0,0,1}; + print '5914: id[3,3] = {1,0,0,0,1,0,0,0,1}'; + list = list(2,3,4); + print '5915: list = list(2,3,4)'; + mat matrix[2]; + print '5916: mat matrix[2]'; + nul = null(); + print '5917: nul = null()'; + obj xy5900 object; + print '5918: obj xy5900 object'; + rand = srand(0); + print '5919: rand = srand(0)'; + random = srandom(0); + print '5920: random = srandom(0)'; + real = 345.23045897; + print '5921: real = 345.23045897'; + prime = 3217; + print '5922: prime = 3217'; + square = prime^2; + print '5923: square = prine^2'; + string = "a string"; + print '5924: string = "a string"'; + com = 3+4i; + print '5925: com = 3+4i'; + + print '5926: test unused'; + print '5927: test unused'; + print '5928: test unused'; + print '5929: test unused'; + + /* + * test isassoc + */ + vrfy(isassoc(loc) == 0, '5930: isassoc(loc) == 0'); + vrfy(isassoc(a) == 1, '5931: isassoc(a) == 1'); + vrfy(isassoc(ofd) == 0, '5932: isassoc(ofd) == 0'); + vrfy(isassoc(cfd) == 0, '5933: isassoc(cfd) == 0'); + vrfy(isassoc(blk) == 0, '5934: isassoc(blk) == 0'); + vrfy(isassoc(nblk) == 0, '5935: isassoc(nblk) == 0'); + vrfy(isassoc(cfg) == 0, '5936: isassoc(cfg) == 0'); + vrfy(isassoc(serr) == 0, '5937: isassoc(serr) == 0'); + vrfy(isassoc(nerr) == 0, '5938: isassoc(nerr) == 0'); + vrfy(isassoc(odd) == 0, '5939: isassoc(odd) == 0'); + vrfy(isassoc(even) == 0, '5940: isassoc(even) == 0'); + vrfy(isassoc(hash) == 0, '5941: isassoc(hash) == 0'); + vrfy(isassoc(id) == 0, '5942: isassoc(id) == 0'); + vrfy(isassoc(list) == 0, '5943: isassoc(list) == 0'); + vrfy(isassoc(matrix) == 0, '5944: isassoc(matrix) == 0'); + vrfy(isassoc(nul) == 0, '5945: isassoc(nul) == 0'); + vrfy(isassoc(object) == 0, '5946: isassoc(object) == 0'); + vrfy(isassoc(rand) == 0, '5947: isassoc(rand) == 0'); + vrfy(isassoc(random) == 0, '5948: isassoc(random) == 0'); + vrfy(isassoc(real) == 0, '5949: isassoc(real) == 0'); + vrfy(isassoc(prime) == 0, '5950: isassoc(prime) == 0'); + vrfy(isassoc(square) == 0, '5951: isassoc(square) == 0'); + vrfy(isassoc(string) == 0, '5952: isassoc(string) == 0'); + vrfy(isassoc(com) == 0, '5953: isassoc(com) == 0'); + print '5954: test unused'; + print '5955: test unused'; + print '5955: test unused'; + print '5956: test unused'; + print '5957: test unused'; + print '5958: test unused'; + print '5959: test unused'; + + /* + * test isatty + */ + vrfy(isatty(loc) == 0, '5960: isatty(loc) == 0'); + vrfy(isatty(a) == 0, '5961: isatty(a) == 0'); + vrfy(isatty(ofd) == 0, '5962: isatty(ofd) == 0'); + vrfy(isatty(cfd) == 0, '5963: isatty(cfd) == 0'); + vrfy(isatty(blk) == 0, '5964: isatty(blk) == 0'); + vrfy(isatty(nblk) == 0, '5965: isatty(nblk) == 0'); + vrfy(isatty(cfg) == 0, '5966: isatty(cfg) == 0'); + vrfy(isatty(serr) == 0, '5967: isatty(serr) == 0'); + vrfy(isatty(nerr) == 0, '5968: isatty(nerr) == 0'); + vrfy(isatty(odd) == 0, '5969: isatty(odd) == 0'); + vrfy(isatty(even) == 0, '5970: isatty(even) == 0'); + vrfy(isatty(hash) == 0, '5971: isatty(hash) == 0'); + vrfy(isatty(id) == 0, '5972: isatty(id) == 0'); + vrfy(isatty(list) == 0, '5973: isatty(list) == 0'); + vrfy(isatty(matrix) == 0, '5974: isatty(matrix) == 0'); + vrfy(isatty(nul) == 0, '5975: isatty(nul) == 0'); + vrfy(isatty(object) == 0, '5976: isatty(object) == 0'); + vrfy(isatty(rand) == 0, '5977: isatty(rand) == 0'); + vrfy(isatty(random) == 0, '5978: isatty(random) == 0'); + vrfy(isatty(real) == 0, '5979: isatty(real) == 0'); + vrfy(isatty(prime) == 0, '5980: isatty(prime) == 0'); + vrfy(isatty(square) == 0, '5981: isatty(square) == 0'); + vrfy(isatty(string) == 0, '5982: isatty(string) == 0'); + vrfy(isatty(com) == 0, '5983: isatty(com) == 0'); + vrfy(isatty(files(0)) == 1, '5984: isatty(files(0)) == 1'); + /* if we pipe to awk (for make chk), stdout and stderr are not ttys */ + print '5985: test unused'; + print '5986: test unused'; + vrfy(isatty(files(3)) == 0, '5987: isatty(files(3)) == 0'); + print '5988: test unused'; + print '5989: test unused'; + + /* + * test isblk + */ + vrfy(isblk(loc) == 0, '5990: isblk(loc) == 0'); + vrfy(isblk(a) == 0, '5991: isblk(a) == 0'); + vrfy(isblk(ofd) == 0, '5992: isblk(ofd) == 0'); + vrfy(isblk(cfd) == 0, '5993: isblk(cfd) == 0'); + vrfy(isblk(blk) == 1, '5994: isblk(blk) == 1'); + vrfy(isblk(nblk) == 2, '5995: isblk(nblk) == 2'); + vrfy(isblk(cfg) == 0, '5996: isblk(cfg) == 0'); + vrfy(isblk(serr) == 0, '5997: isblk(serr) == 0'); + vrfy(isblk(nerr) == 0, '5998: isblk(nerr) == 0'); + vrfy(isblk(odd) == 0, '5999: isblk(odd) == 0'); + vrfy(isblk(even) == 0, '6000: isblk(even) == 0'); + vrfy(isblk(hash) == 0, '6001: isblk(hash) == 0'); + vrfy(isblk(id) == 0, '6002: isblk(id) == 0'); + vrfy(isblk(list) == 0, '6003: isblk(list) == 0'); + vrfy(isblk(matrix) == 0, '6004: isblk(matrix) == 0'); + vrfy(isblk(nul) == 0, '6005: isblk(nul) == 0'); + vrfy(isblk(object) == 0, '6006: isblk(object) == 0'); + vrfy(isblk(rand) == 0, '6007: isblk(rand) == 0'); + vrfy(isblk(random) == 0, '6008: isblk(random) == 0'); + vrfy(isblk(real) == 0, '6009: isblk(real) == 0'); + vrfy(isblk(prime) == 0, '6010: isblk(prime) == 0'); + vrfy(isblk(square) == 0, '6011: isblk(square) == 0'); + vrfy(isblk(string) == 0, '6012: isblk(string) == 0'); + vrfy(isblk(com) == 0, '6013: isblk(com) == 0'); + print '6014: test unused'; + print '6015: test unused'; + print '6015: test unused'; + print '6016: test unused'; + print '6017: test unused'; + print '6018: test unused'; + print '6019: test unused'; + + /* + * test isconfig + */ + vrfy(isconfig(loc) == 0, '6020: isconfig(loc) == 0'); + vrfy(isconfig(a) == 0, '6021: isconfig(a) == 0'); + vrfy(isconfig(ofd) == 0, '6022: isconfig(ofd) == 0'); + vrfy(isconfig(cfd) == 0, '6023: isconfig(cfd) == 0'); + vrfy(isconfig(blk) == 0, '6024: isconfig(blk) == 0'); + vrfy(isconfig(nblk) == 0, '6025: isconfig(nblk) == 0'); + vrfy(isconfig(cfg) == 1, '6026: isconfig(cfg) == 1'); + vrfy(isconfig(serr) == 0, '6027: isconfig(serr) == 0'); + vrfy(isconfig(nerr) == 0, '6028: isconfig(nerr) == 0'); + vrfy(isconfig(odd) == 0, '6029: isconfig(odd) == 0'); + vrfy(isconfig(even) == 0, '6030: isconfig(even) == 0'); + vrfy(isconfig(hash) == 0, '6031: isconfig(hash) == 0'); + vrfy(isconfig(id) == 0, '6032: isconfig(id) == 0'); + vrfy(isconfig(list) == 0, '6033: isconfig(list) == 0'); + vrfy(isconfig(matrix) == 0, '6034: isconfig(matrix) == 0'); + vrfy(isconfig(nul) == 0, '6035: isconfig(nul) == 0'); + vrfy(isconfig(object) == 0, '6036: isconfig(object) == 0'); + vrfy(isconfig(rand) == 0, '6037: isconfig(rand) == 0'); + vrfy(isconfig(random) == 0, '6038: isconfig(random) == 0'); + vrfy(isconfig(real) == 0, '6039: isconfig(real) == 0'); + vrfy(isconfig(prime) == 0, '6040: isconfig(prime) == 0'); + vrfy(isconfig(square) == 0, '6041: isconfig(square) == 0'); + vrfy(isconfig(string) == 0, '6042: isconfig(string) == 0'); + vrfy(isconfig(com) == 0, '6043: isconfig(com) == 0'); + print '6044: test unused'; + print '6045: test unused'; + print '6045: test unused'; + print '6046: test unused'; + print '6047: test unused'; + print '6048: test unused'; + print '6049: test unused'; + + /* + * test isdefined + */ + vrfy(isdefined("loc") == 0, '6050: isdefined("loc") == 0'); + vrfy(isdefined("a") == 0, '6051: isdefined("a") == 0'); + vrfy(isdefined("ofd") == 0, '6052: isdefined("ofd") == 0'); + vrfy(isdefined("cfd") == 0, '6053: isdefined("cfd") == 0'); + vrfy(isdefined("blk") == 1, '6054: isdefined("blk") == 1'); + vrfy(isdefined("nblk") == 0, '6055: isdefined("nblk") == 0'); + vrfy(isdefined("cfg") == 0, '6056: isdefined("cfg") == 0'); + vrfy(isdefined("serr") == 0, '6057: isdefined("serr") == 0'); + vrfy(isdefined("nerr") == 0, '6058: isdefined("nerr") == 0'); + vrfy(isdefined("odd") == 0, '6059: isdefined("odd") == 0'); + vrfy(isdefined("even") == 0, '6060: isdefined("even") == 0'); + vrfy(isdefined("hash") == 1, '6061: isdefined("hash") == 1'); + vrfy(isdefined("id") == 0, '6062: isdefined("id") == 0'); + vrfy(isdefined("list") == 1, '6063: isdefined("list") == 1'); + vrfy(isdefined("matrix") == 0, '6064: isdefined("matrix") == 0'); + vrfy(isdefined("nul") == 0, '6065: isdefined("nul") == 0'); + vrfy(isdefined("object") == 0, '6066: isdefined("object") == 0'); + vrfy(isdefined("rand") == 1, '6067: isdefined("rand") == 1'); + vrfy(isdefined("random") == 1, '6068: isdefined("random") == 1'); + vrfy(isdefined("real") == 0, '6069: isdefined("real") == 0'); + vrfy(isdefined("prime") == 0, '6070: isdefined("prime") == 0'); + vrfy(isdefined("square") == 0, '6071: isdefined("square") == 0'); + vrfy(isdefined("string") == 0, '6072: isdefined("string") == 0'); + vrfy(isdefined("abs") == 1, '6073: isdefined("abs") == 1'); + vrfy(isdefined("notafunc") == 0, '6074: isdefined("notafunc") == 0'); + vrfy(isdefined("com") == 0, '6075: isdefined("com") == 0'); + print '6076: test unused'; + print '6077: test unused'; + print '6078: test unused'; + print '6079: test unused'; + + /* + * test iserror + */ + vrfy(iserror(loc) == 0, '6080: iserror(loc) == 0'); + vrfy(iserror(a) == 0, '6081: iserror(a) == 0'); + vrfy(iserror(ofd) == 0, '6082: iserror(ofd) == 0'); + vrfy(iserror(cfd) == 0, '6083: iserror(cfd) == 0'); + vrfy(iserror(blk) == 0, '6084: iserror(blk) == 0'); + vrfy(iserror(nblk) == 0, '6085: iserror(nblk) == 0'); + vrfy(iserror(cfg) == 0, '6086: iserror(cfg) == 0'); + vrfy(iserror(serr) == 1, '6087: iserror(serr) == 1'); + vrfy(iserror(nerr) > 0, '6088: iserror(nerr) > 0'); + vrfy(iserror(odd) == 0, '6089: iserror(odd) == 0'); + vrfy(iserror(even) == 0, '6090: iserror(even) == 0'); + vrfy(iserror(hash) == 0, '6091: iserror(hash) == 0'); + vrfy(iserror(id) == 0, '6092: iserror(id) == 0'); + vrfy(iserror(list) == 0, '6093: iserror(list) == 0'); + vrfy(iserror(matrix) == 0, '6094: iserror(matrix) == 0'); + vrfy(iserror(nul) == 0, '6095: iserror(nul) == 0'); + vrfy(iserror(object) == 0, '6096: iserror(object) == 0'); + vrfy(iserror(rand) == 0, '6097: iserror(rand) == 0'); + vrfy(iserror(random) == 0, '6098: iserror(random) == 0'); + vrfy(iserror(real) == 0, '6099: iserror(real) == 0'); + vrfy(iserror(prime) == 0, '6100: iserror(prime) == 0'); + vrfy(iserror(square) == 0, '6101: iserror(square) == 0'); + vrfy(iserror(string) == 0, '6102: iserror(string) == 0'); + vrfy(iserror(com) == 0, '6103: iserror(com) == 0'); + print '6104: test unused'; + print '6105: test unused'; + print '6105: test unused'; + print '6106: test unused'; + print '6107: test unused'; + print '6108: test unused'; + print '6109: test unused'; + + /* + * test iseven + */ + vrfy(iseven(loc) == 1, '6110: iseven(loc) == 1'); + vrfy(iseven(a) == 0, '6111: iseven(a) == 0'); + vrfy(iseven(ofd) == 0, '6112: iseven(ofd) == 0'); + vrfy(iseven(cfd) == 0, '6113: iseven(cfd) == 0'); + vrfy(iseven(blk) == 0, '6114: iseven(blk) == 0'); + vrfy(iseven(nblk) == 0, '6115: iseven(nblk) == 0'); + vrfy(iseven(cfg) == 0, '6116: iseven(cfg) == 0'); + vrfy(iseven(serr) == 0, '6117: iseven(serr) == 0'); + vrfy(iseven(nerr) == 0, '6118: iseven(nerr) == 0'); + vrfy(iseven(odd) == 0, '6119: iseven(odd) == 0'); + vrfy(iseven(even) == 1, '6120: iseven(even) == 1'); + vrfy(iseven(hash) == 0, '6121: iseven(hash) == 0'); + vrfy(iseven(id) == 0, '6122: iseven(id) == 0'); + vrfy(iseven(list) == 0, '6123: iseven(list) == 0'); + vrfy(iseven(matrix) == 0, '6124: iseven(matrix) == 0'); + vrfy(iseven(nul) == 0, '6125: iseven(nul) == 0'); + vrfy(iseven(object) == 0, '6126: iseven(object) == 0'); + vrfy(iseven(rand) == 0, '6127: iseven(rand) == 0'); + vrfy(iseven(random) == 0, '6128: iseven(random) == 0'); + vrfy(iseven(real) == 0, '6129: iseven(real) == 0'); + vrfy(iseven(prime) == 0, '6130: iseven(prime) == 0'); + vrfy(iseven(square) == 0, '6131: iseven(square) == 0'); + vrfy(iseven(string) == 0, '6132: iseven(string) == 0'); + vrfy(iseven(com) == 0, '6133: iseven(com) == 0'); + print '6134: test unused'; + print '6135: test unused'; + print '6135: test unused'; + print '6136: test unused'; + print '6137: test unused'; + print '6138: test unused'; + print '6139: test unused'; + + /* + * test isfile + */ + vrfy(isfile(loc) == 0, '6140: isfile(loc) == 0'); + vrfy(isfile(a) == 0, '6141: isfile(a) == 0'); + vrfy(isfile(ofd) == 1, '6142: isfile(ofd) == 1'); + vrfy(isfile(cfd) == 1, '6143: isfile(cfd) == 1'); + vrfy(isfile(blk) == 0, '6144: isfile(blk) == 0'); + vrfy(isfile(nblk) == 0, '6145: isfile(nblk) == 0'); + vrfy(isfile(cfg) == 0, '6146: isfile(cfg) == 0'); + vrfy(isfile(serr) == 0, '6147: isfile(serr) == 0'); + vrfy(isfile(nerr) == 0, '6148: isfile(nerr) == 0'); + vrfy(isfile(odd) == 0, '6149: isfile(odd) == 0'); + vrfy(isfile(even) == 0, '6150: isfile(even) == 0'); + vrfy(isfile(hash) == 0, '6151: isfile(hash) == 0'); + vrfy(isfile(id) == 0, '6152: isfile(id) == 0'); + vrfy(isfile(list) == 0, '6153: isfile(list) == 0'); + vrfy(isfile(matrix) == 0, '6154: isfile(matrix) == 0'); + vrfy(isfile(nul) == 0, '6155: isfile(nul) == 0'); + vrfy(isfile(object) == 0, '6156: isfile(object) == 0'); + vrfy(isfile(rand) == 0, '6157: isfile(rand) == 0'); + vrfy(isfile(random) == 0, '6158: isfile(random) == 0'); + vrfy(isfile(real) == 0, '6159: isfile(real) == 0'); + vrfy(isfile(prime) == 0, '6160: isfile(prime) == 0'); + vrfy(isfile(square) == 0, '6161: isfile(square) == 0'); + vrfy(isfile(string) == 0, '6162: isfile(string) == 0'); + vrfy(isfile(com) == 0, '6163: isfile(com) == 0'); + vrfy(isfile(files(0)) == 1, '6164: isfile(files(0)) == 1'); + vrfy(isfile(files(1)) == 1, '6165: isfile(files(1)) == 1'); + vrfy(isfile(files(2)) == 1, '6166: isfile(files(2)) == 1'); + vrfy(isfile(files(3)) == 1, '6167: isfile(files(3)) == 1'); + print '6168: test unused'; + print '6169: test unused'; + + /* + * test ishash + */ + vrfy(ishash(loc) == 0, '6170: ishash(loc) == 0'); + vrfy(ishash(a) == 0, '6171: ishash(a) == 0'); + vrfy(ishash(ofd) == 0, '6172: ishash(ofd) == 0'); + vrfy(ishash(cfd) == 0, '6173: ishash(cfd) == 0'); + vrfy(ishash(blk) == 0, '6174: ishash(blk) == 0'); + vrfy(ishash(nblk) == 0, '6175: ishash(nblk) == 0'); + vrfy(ishash(cfg) == 0, '6176: ishash(cfg) == 0'); + vrfy(ishash(serr) == 0, '6177: ishash(serr) == 0'); + vrfy(ishash(nerr) == 0, '6178: ishash(nerr) == 0'); + vrfy(ishash(odd) == 0, '6179: ishash(odd) == 0'); + vrfy(ishash(even) == 0, '6180: ishash(even) == 0'); + vrfy(ishash(hash) == 1, '6181: ishash(hash) == 1'); + vrfy(ishash(id) == 0, '6182: ishash(id) == 0'); + vrfy(ishash(list) == 0, '6183: ishash(list) == 0'); + vrfy(ishash(matrix) == 0, '6184: ishash(matrix) == 0'); + vrfy(ishash(nul) == 0, '6185: ishash(nul) == 0'); + vrfy(ishash(object) == 0, '6186: ishash(object) == 0'); + vrfy(ishash(rand) == 0, '6187: ishash(rand) == 0'); + vrfy(ishash(random) == 0, '6188: ishash(random) == 0'); + vrfy(ishash(real) == 0, '6189: ishash(real) == 0'); + vrfy(ishash(prime) == 0, '6190: ishash(prime) == 0'); + vrfy(ishash(square) == 0, '6191: ishash(square) == 0'); + vrfy(ishash(string) == 0, '6192: ishash(string) == 0'); + vrfy(ishash(com) == 0, '6193: ishash(com) == 0'); + print '6194: test unused'; + print '6195: test unused'; + print '6196: test unused'; + print '6197: test unused'; + print '6198: test unused'; + print '6199: test unused'; + + /* + * test isident + */ + vrfy(isident(loc) == 0, '6200: isident(loc) == 0'); + vrfy(isident(a) == 0, '6201: isident(a) == 0'); + vrfy(isident(ofd) == 0, '6202: isident(ofd) == 0'); + vrfy(isident(cfd) == 0, '6203: isident(cfd) == 0'); + vrfy(isident(blk) == 0, '6204: isident(blk) == 0'); + vrfy(isident(nblk) == 0, '6205: isident(nblk) == 0'); + vrfy(isident(cfg) == 0, '6206: isident(cfg) == 0'); + vrfy(isident(serr) == 0, '6207: isident(serr) == 0'); + vrfy(isident(nerr) == 0, '6208: isident(nerr) == 0'); + vrfy(isident(odd) == 0, '6209: isident(odd) == 0'); + vrfy(isident(even) == 0, '6210: isident(even) == 0'); + vrfy(isident(hash) == 0, '6211: isident(hash) == 0'); + vrfy(isident(id) == 1, '6212: isident(id) == 1'); + vrfy(isident(list) == 0, '6213: isident(list) == 0'); + vrfy(isident(matrix) == 0, '6214: isident(matrix) == 0'); + vrfy(isident(nul) == 0, '6215: isident(nul) == 0'); + vrfy(isident(object) == 0, '6216: isident(object) == 0'); + vrfy(isident(rand) == 0, '6217: isident(rand) == 0'); + vrfy(isident(random) == 0, '6218: isident(random) == 0'); + vrfy(isident(real) == 0, '6219: isident(real) == 0'); + vrfy(isident(prime) == 0, '6220: isident(prime) == 0'); + vrfy(isident(square) == 0, '6221: isident(square) == 0'); + vrfy(isident(string) == 0, '6222: isident(string) == 0'); + vrfy(isident(com) == 0, '6223: isident(com) == 0'); + print '6224: test unused'; + print '6225: test unused'; + print '6226: test unused'; + print '6227: test unused'; + print '6228: test unused'; + print '6229: test unused'; + + /* + * test isint + */ + vrfy(isint(loc) == 1, '6230: isint(loc) == 1'); + vrfy(isint(a) == 0, '6231: isint(a) == 0'); + vrfy(isint(ofd) == 0, '6232: isint(ofd) == 0'); + vrfy(isint(cfd) == 0, '6233: isint(cfd) == 0'); + vrfy(isint(blk) == 0, '6234: isint(blk) == 0'); + vrfy(isint(nblk) == 0, '6235: isint(nblk) == 0'); + vrfy(isint(cfg) == 0, '6236: isint(cfg) == 0'); + vrfy(isint(serr) == 0, '6237: isint(serr) == 0'); + vrfy(isint(nerr) == 0, '6238: isint(nerr) == 0'); + vrfy(isint(odd) == 1, '6239: isint(odd) == 1'); + vrfy(isint(even) == 1, '6240: isint(even) == 1'); + vrfy(isint(hash) == 0, '6241: isint(hash) == 0'); + vrfy(isint(id) == 0, '6242: isint(id) == 0'); + vrfy(isint(list) == 0, '6243: isint(list) == 0'); + vrfy(isint(matrix) == 0, '6244: isint(matrix) == 0'); + vrfy(isint(nul) == 0, '6245: isint(nul) == 0'); + vrfy(isint(object) == 0, '6246: isint(object) == 0'); + vrfy(isint(rand) == 0, '6247: isint(rand) == 0'); + vrfy(isint(random) == 0, '6248: isint(random) == 0'); + vrfy(isint(real) == 0, '6249: isint(real) == 0'); + vrfy(isint(prime) == 1, '6250: isint(prime) == 1'); + vrfy(isint(square) == 1, '6251: isint(square) == 1'); + vrfy(isint(string) == 0, '6252: isint(string) == 0'); + vrfy(isint(com) == 0, '6253: isint(com) == 0'); + print '6254: test unused'; + print '6255: test unused'; + print '6255: test unused'; + print '6256: test unused'; + print '6257: test unused'; + print '6258: test unused'; + print '6259: test unused'; + + /* + * test islist + */ + vrfy(islist(loc) == 0, '6260: islist(loc) == 0'); + vrfy(islist(a) == 0, '6261: islist(a) == 0'); + vrfy(islist(ofd) == 0, '6262: islist(ofd) == 0'); + vrfy(islist(cfd) == 0, '6263: islist(cfd) == 0'); + vrfy(islist(blk) == 0, '6264: islist(blk) == 0'); + vrfy(islist(nblk) == 0, '6265: islist(nblk) == 0'); + vrfy(islist(cfg) == 0, '6266: islist(cfg) == 0'); + vrfy(islist(serr) == 0, '6267: islist(serr) == 0'); + vrfy(islist(nerr) == 0, '6268: islist(nerr) == 0'); + vrfy(islist(odd) == 0, '6269: islist(odd) == 0'); + vrfy(islist(even) == 0, '6270: islist(even) == 0'); + vrfy(islist(hash) == 0, '6271: islist(hash) == 0'); + vrfy(islist(id) == 0, '6272: islist(id) == 0'); + vrfy(islist(list) == 1, '6273: islist(list) == 1'); + vrfy(islist(matrix) == 0, '6274: islist(matrix) == 0'); + vrfy(islist(nul) == 0, '6275: islist(nul) == 0'); + vrfy(islist(object) == 0, '6276: islist(object) == 0'); + vrfy(islist(rand) == 0, '6277: islist(rand) == 0'); + vrfy(islist(random) == 0, '6278: islist(random) == 0'); + vrfy(islist(real) == 0, '6279: islist(real) == 0'); + vrfy(islist(prime) == 0, '6280: islist(prime) == 0'); + vrfy(islist(square) == 0, '6281: islist(square) == 0'); + vrfy(islist(string) == 0, '6282: islist(string) == 0'); + vrfy(islist(com) == 0, '6283: islist(com) == 0'); + print '6284: test unused'; + print '6255: test unused'; + print '6285: test unused'; + print '6286: test unused'; + print '6287: test unused'; + print '6288: test unused'; + print '6289: test unused'; + + /* + * test ismat + */ + vrfy(ismat(loc) == 0, '6290: ismat(loc) == 0'); + vrfy(ismat(a) == 0, '6291: ismat(a) == 0'); + vrfy(ismat(ofd) == 0, '6292: ismat(ofd) == 0'); + vrfy(ismat(cfd) == 0, '6293: ismat(cfd) == 0'); + vrfy(ismat(blk) == 0, '6294: ismat(blk) == 0'); + vrfy(ismat(nblk) == 0, '6295: ismat(nblk) == 0'); + vrfy(ismat(cfg) == 0, '6296: ismat(cfg) == 0'); + vrfy(ismat(serr) == 0, '6297: ismat(serr) == 0'); + vrfy(ismat(nerr) == 0, '6298: ismat(nerr) == 0'); + vrfy(ismat(odd) == 0, '6299: ismat(odd) == 0'); + vrfy(ismat(even) == 0, '6300: ismat(even) == 0'); + vrfy(ismat(hash) == 0, '6301: ismat(hash) == 0'); + vrfy(ismat(id) == 1, '6302: ismat(id) == 1'); + vrfy(ismat(list) == 0, '6303: ismat(list) == 0'); + vrfy(ismat(matrix) == 1, '6304: ismat(matrix) == 1'); + vrfy(ismat(nul) == 0, '6305: ismat(nul) == 0'); + vrfy(ismat(object) == 0, '6306: ismat(object) == 0'); + vrfy(ismat(rand) == 0, '6307: ismat(rand) == 0'); + vrfy(ismat(random) == 0, '6308: ismat(random) == 0'); + vrfy(ismat(real) == 0, '6309: ismat(real) == 0'); + vrfy(ismat(prime) == 0, '6310: ismat(prime) == 0'); + vrfy(ismat(square) == 0, '6311: ismat(square) == 0'); + vrfy(ismat(string) == 0, '6312: ismat(string) == 0'); + vrfy(ismat(com) == 0, '6313: ismat(com) == 0'); + print '6314: test unused'; + print '6215: test unused'; + print '6315: test unused'; + print '6316: test unused'; + print '6317: test unused'; + print '6318: test unused'; + print '6319: test unused'; + + /* + * test ismult + */ + vrfy(ismult(odd,even) == 0, '6320: ismult(odd,even) == 0'); + vrfy(ismult(even,odd) == 1, '6321: ismult(even,odd) == 1'); + vrfy(ismult(odd,odd) == 1, '6322: ismult(odd,odd) == 1'); + vrfy(ismult(even,prime) == 0, '6323: ismult(even,prime) == 0'); + vrfy(ismult(square,prime) == 1, '6324: ismult(square,prime) == 1'); + vrfy(ismult(real,prime) == 0, '6325: ismult(real,prime) == 0'); + vrfy(ismult(real,real*34) == 0, '6326: ismult(real,real*34) == 0'); + vrfy(ismult(real*34,real) == 1, '6327: ismult(real*34,real) == 1'); + print '6328: test unused'; + print '6329: test unused'; + + /* + * test isnull + */ + vrfy(isnull(loc) == 0, '6330: isnull(loc) == 0'); + vrfy(isnull(a) == 0, '6331: isnull(a) == 0'); + vrfy(isnull(ofd) == 0, '6332: isnull(ofd) == 0'); + vrfy(isnull(cfd) == 0, '6333: isnull(cfd) == 0'); + vrfy(isnull(blk) == 0, '6334: isnull(blk) == 0'); + vrfy(isnull(nblk) == 0, '6335: isnull(nblk) == 0'); + vrfy(isnull(cfg) == 0, '6336: isnull(cfg) == 0'); + vrfy(isnull(serr) == 0, '6337: isnull(serr) == 0'); + vrfy(isnull(nerr) == 0, '6338: isnull(nerr) == 0'); + vrfy(isnull(odd) == 0, '6339: isnull(odd) == 0'); + vrfy(isnull(even) == 0, '6340: isnull(even) == 0'); + vrfy(isnull(hash) == 0, '6341: isnull(hash) == 0'); + vrfy(isnull(id) == 0, '6342: isnull(id) == 0'); + vrfy(isnull(list) == 0, '6343: isnull(list) == 0'); + vrfy(isnull(matrix) == 0, '6344: isnull(matrix) == 0'); + vrfy(isnull(nul) == 1, '6345: isnull(nul) == 1'); + vrfy(isnull(object) == 0, '6346: isnull(object) == 0'); + vrfy(isnull(rand) == 0, '6347: isnull(rand) == 0'); + vrfy(isnull(random) == 0, '6348: isnull(random) == 0'); + vrfy(isnull(real) == 0, '6349: isnull(real) == 0'); + vrfy(isnull(prime) == 0, '6350: isnull(prime) == 0'); + vrfy(isnull(square) == 0, '6351: isnull(square) == 0'); + vrfy(isnull(string) == 0, '6352: isnull(string) == 0'); + vrfy(isnull(com) == 0, '6353: isnull(com) == 0'); + print '6354: test unused'; + print '6355: test unused'; + print '6355: test unused'; + print '6356: test unused'; + print '6357: test unused'; + print '6358: test unused'; + print '6359: test unused'; + + /* + * test isnum + */ + vrfy(isnum(loc) == 1, '6360: isnum(loc) == 1'); + vrfy(isnum(a) == 0, '6361: isnum(a) == 0'); + vrfy(isnum(ofd) == 0, '6362: isnum(ofd) == 0'); + vrfy(isnum(cfd) == 0, '6363: isnum(cfd) == 0'); + vrfy(isnum(blk) == 0, '6364: isnum(blk) == 0'); + vrfy(isnum(nblk) == 0, '6365: isnum(nblk) == 0'); + vrfy(isnum(cfg) == 0, '6366: isnum(cfg) == 0'); + vrfy(isnum(serr) == 0, '6367: isnum(serr) == 0'); + vrfy(isnum(nerr) == 0, '6368: isnum(nerr) == 0'); + vrfy(isnum(odd) == 1, '6369: isnum(odd) == 1'); + vrfy(isnum(even) == 1, '6370: isnum(even) == 1'); + vrfy(isnum(hash) == 0, '6371: isnum(hash) == 0'); + vrfy(isnum(id) == 0, '6372: isnum(id) == 0'); + vrfy(isnum(list) == 0, '6373: isnum(list) == 0'); + vrfy(isnum(matrix) == 0, '6374: isnum(matrix) == 0'); + vrfy(isnum(nul) == 0, '6375: isnum(nul) == 0'); + vrfy(isnum(object) == 0, '6376: isnum(object) == 0'); + vrfy(isnum(rand) == 0, '6377: isnum(rand) == 0'); + vrfy(isnum(random) == 0, '6378: isnum(random) == 0'); + vrfy(isnum(real) == 1, '6379: isnum(real) == 1'); + vrfy(isnum(prime) == 1, '6380: isnum(prime) == 1'); + vrfy(isnum(square) == 1, '6381: isnum(square) == 1'); + vrfy(isnum(string) == 0, '6382: isnum(string) == 0'); + vrfy(isnum(com) == 1, '6379: isnum(com) == 1'); + print '6384: test unused'; + print '6385: test unused'; + print '6385: test unused'; + print '6386: test unused'; + print '6387: test unused'; + print '6388: test unused'; + print '6389: test unused'; + + /* + * test isobj + */ + vrfy(isobj(loc) == 0, '6390: isobj(loc) == 0'); + vrfy(isobj(a) == 0, '6391: isobj(a) == 0'); + vrfy(isobj(ofd) == 0, '6392: isobj(ofd) == 0'); + vrfy(isobj(cfd) == 0, '6393: isobj(cfd) == 0'); + vrfy(isobj(blk) == 0, '6394: isobj(blk) == 0'); + vrfy(isobj(nblk) == 0, '6395: isobj(nblk) == 0'); + vrfy(isobj(cfg) == 0, '6396: isobj(cfg) == 0'); + vrfy(isobj(serr) == 0, '6397: isobj(serr) == 0'); + vrfy(isobj(nerr) == 0, '6398: isobj(nerr) == 0'); + vrfy(isobj(odd) == 0, '6399: isobj(odd) == 0'); + vrfy(isobj(even) == 0, '6400: isobj(even) == 0'); + vrfy(isobj(hash) == 0, '6401: isobj(hash) == 0'); + vrfy(isobj(id) == 0, '6402: isobj(id) == 0'); + vrfy(isobj(list) == 0, '6403: isobj(list) == 0'); + vrfy(isobj(matrix) == 0, '6404: isobj(matrix) == 0'); + vrfy(isobj(nul) == 0, '6405: isobj(nul) == 0'); + vrfy(isobj(object) == 1, '6406: isobj(object) == 1'); + vrfy(isobj(rand) == 0, '6407: isobj(rand) == 0'); + vrfy(isobj(random) == 0, '6408: isobj(random) == 0'); + vrfy(isobj(real) == 0, '6409: isobj(real) == 0'); + vrfy(isobj(prime) == 0, '6410: isobj(prime) == 0'); + vrfy(isobj(square) == 0, '6411: isobj(square) == 0'); + vrfy(isobj(string) == 0, '6412: isobj(string) == 0'); + vrfy(isobj(com) == 0, '6413: isobj(com) == 0'); + print '6414: test unused'; + print '6415: test unused'; + print '6415: test unused'; + print '6416: test unused'; + print '6417: test unused'; + print '6418: test unused'; + print '6419: test unused'; + + /* + * test isobjtype + */ + vrfy(isobjtype("loc") == 0, '6420: isobjtype("loc") == 0'); + vrfy(isobjtype("a") == 0, '6421: isobjtype("a") == 0'); + vrfy(isobjtype("ofd") == 0, '6422: isobjtype("ofd") == 0'); + vrfy(isobjtype("xy5800") == 1, '6423: isobjtype("xy5800") == 1'); + vrfy(isobjtype("xy5900") == 1, '6424: isobjtype("xy5900") == 1'); + print '6425: test unused'; + print '6426: test unused'; + print '6427: test unused'; + print '6428: test unused'; + print '6429: test unused'; + + /* + * test isodd + */ + vrfy(isodd(loc) == 0, '6430: isodd(loc) == 0'); + vrfy(isodd(a) == 0, '6431: isodd(a) == 0'); + vrfy(isodd(ofd) == 0, '6432: isodd(ofd) == 0'); + vrfy(isodd(cfd) == 0, '6433: isodd(cfd) == 0'); + vrfy(isodd(blk) == 0, '6434: isodd(blk) == 0'); + vrfy(isodd(nblk) == 0, '6435: isodd(nblk) == 0'); + vrfy(isodd(cfg) == 0, '6436: isodd(cfg) == 0'); + vrfy(isodd(serr) == 0, '6437: isodd(serr) == 0'); + vrfy(isodd(nerr) == 0, '6438: isodd(nerr) == 0'); + vrfy(isodd(odd) == 1, '6439: isodd(odd) == 1'); + vrfy(isodd(even) == 0, '6440: isodd(even) == 0'); + vrfy(isodd(hash) == 0, '6441: isodd(hash) == 0'); + vrfy(isodd(id) == 0, '6442: isodd(id) == 0'); + vrfy(isodd(list) == 0, '6443: isodd(list) == 0'); + vrfy(isodd(matrix) == 0, '6444: isodd(matrix) == 0'); + vrfy(isodd(nul) == 0, '6445: isodd(nul) == 0'); + vrfy(isodd(object) == 0, '6446: isodd(object) == 0'); + vrfy(isodd(rand) == 0, '6447: isodd(rand) == 0'); + vrfy(isodd(random) == 0, '6448: isodd(random) == 0'); + vrfy(isodd(real) == 0, '6449: isodd(real) == 0'); + vrfy(isodd(prime) == 1, '6450: isodd(prime) == 1'); + vrfy(isodd(square) == 1, '6451: isodd(square) == 1'); + vrfy(isodd(string) == 0, '6452: isodd(string) == 0'); + vrfy(isodd(com) == 0, '6453: isodd(com) == 0'); + print '6454: test unused'; + print '6455: test unused'; + print '6455: test unused'; + print '6456: test unused'; + print '6457: test unused'; + print '6458: test unused'; + print '6459: test unused'; + + /* + * test isprime + */ + vrfy(isprime(loc) == 0, '6460: isprime(loc) == 0'); + vrfy(isprime(odd) == 1, '6461: isprime(odd) == 1'); + vrfy(isprime(even) == 0, '6462: isprime(even) == 0'); + vrfy(isprime(prime) == 1, '6463: isprime(prime) == 1'); + vrfy(isprime(square) == 0, '6464: isprime(square) == 0'); + print '6465: test unused'; + print '6466: test unused'; + print '6468: test unused'; + print '6468: test unused'; + print '6469: test unused'; + + /* + * test isrand + */ + vrfy(isrand(loc) == 0, '6470: isrand(loc) == 0'); + vrfy(isrand(a) == 0, '6471: isrand(a) == 0'); + vrfy(isrand(ofd) == 0, '6472: isrand(ofd) == 0'); + vrfy(isrand(cfd) == 0, '6473: isrand(cfd) == 0'); + vrfy(isrand(blk) == 0, '6474: isrand(blk) == 0'); + vrfy(isrand(nblk) == 0, '6475: isrand(nblk) == 0'); + vrfy(isrand(cfg) == 0, '6476: isrand(cfg) == 0'); + vrfy(isrand(serr) == 0, '6477: isrand(serr) == 0'); + vrfy(isrand(nerr) == 0, '6478: isrand(nerr) == 0'); + vrfy(isrand(odd) == 0, '6479: isrand(odd) == 0'); + vrfy(isrand(even) == 0, '6480: isrand(even) == 0'); + vrfy(isrand(hash) == 0, '6481: isrand(hash) == 0'); + vrfy(isrand(id) == 0, '6482: isrand(id) == 0'); + vrfy(isrand(list) == 0, '6483: isrand(list) == 0'); + vrfy(isrand(matrix) == 0, '6484: isrand(matrix) == 0'); + vrfy(isrand(nul) == 0, '6485: isrand(nul) == 0'); + vrfy(isrand(object) == 0, '6486: isrand(object) == 0'); + vrfy(isrand(rand) == 1, '6487: isrand(rand) == 1'); + vrfy(isrand(random) == 0, '6488: isrand(random) == 0'); + vrfy(isrand(real) == 0, '6489: isrand(real) == 0'); + vrfy(isrand(prime) == 0, '6490: isrand(prime) == 0'); + vrfy(isrand(square) == 0, '6491: isrand(square) == 0'); + vrfy(isrand(string) == 0, '6492: isrand(string) == 0'); + vrfy(isrand(com) == 0, '6493: isrand(com) == 0'); + print '6494: test unused'; + print '6495: test unused'; + print '6495: test unused'; + print '6496: test unused'; + print '6497: test unused'; + print '6498: test unused'; + print '6499: test unused'; + + /* + * test israndom + */ + vrfy(israndom(loc) == 0, '6500: israndom(loc) == 0'); + vrfy(israndom(a) == 0, '6501: israndom(a) == 0'); + vrfy(israndom(ofd) == 0, '6502: israndom(ofd) == 0'); + vrfy(israndom(cfd) == 0, '6503: israndom(cfd) == 0'); + vrfy(israndom(blk) == 0, '6504: israndom(blk) == 0'); + vrfy(israndom(nblk) == 0, '6505: israndom(nblk) == 0'); + vrfy(israndom(cfg) == 0, '6506: israndom(cfg) == 0'); + vrfy(israndom(serr) == 0, '6507: israndom(serr) == 0'); + vrfy(israndom(nerr) == 0, '6508: israndom(nerr) == 0'); + vrfy(israndom(odd) == 0, '6509: israndom(odd) == 0'); + vrfy(israndom(even) == 0, '6510: israndom(even) == 0'); + vrfy(israndom(hash) == 0, '6511: israndom(hash) == 0'); + vrfy(israndom(id) == 0, '6512: israndom(id) == 0'); + vrfy(israndom(list) == 0, '6513: israndom(list) == 0'); + vrfy(israndom(matrix) == 0, '6514: israndom(matrix) == 0'); + vrfy(israndom(nul) == 0, '6515: israndom(nul) == 0'); + vrfy(israndom(object) == 0, '6516: israndom(object) == 0'); + vrfy(israndom(rand) == 0, '6517: israndom(rand) == 0'); + vrfy(israndom(random) == 1, '6518: israndom(random) == 1'); + vrfy(israndom(real) == 0, '6519: israndom(real) == 0'); + vrfy(israndom(prime) == 0, '6520: israndom(prime) == 0'); + vrfy(israndom(square) == 0, '6521: israndom(square) == 0'); + vrfy(israndom(string) == 0, '6522: israndom(string) == 0'); + vrfy(israndom(com) == 0, '6523: israndom(com) == 0'); + print '6524: test unused'; + print '6525: test unused'; + print '6526: test unused'; + print '6527: test unused'; + print '6528: test unused'; + print '6529: test unused'; + + /* + * test isreal + */ + vrfy(isreal(loc) == 1, '6530: isreal(loc) == 1'); + vrfy(isreal(a) == 0, '6531: isreal(a) == 0'); + vrfy(isreal(ofd) == 0, '6532: isreal(ofd) == 0'); + vrfy(isreal(cfd) == 0, '6533: isreal(cfd) == 0'); + vrfy(isreal(blk) == 0, '6534: isreal(blk) == 0'); + vrfy(isreal(nblk) == 0, '6535: isreal(nblk) == 0'); + vrfy(isreal(cfg) == 0, '6536: isreal(cfg) == 0'); + vrfy(isreal(serr) == 0, '6537: isreal(serr) == 0'); + vrfy(isreal(nerr) == 0, '6538: isreal(nerr) == 0'); + vrfy(isreal(odd) == 1, '6539: isreal(odd) == 1'); + vrfy(isreal(even) == 1, '6540: isreal(even) == 1'); + vrfy(isreal(hash) == 0, '6541: isreal(hash) == 0'); + vrfy(isreal(id) == 0, '6542: isreal(id) == 0'); + vrfy(isreal(list) == 0, '6543: isreal(list) == 0'); + vrfy(isreal(matrix) == 0, '6544: isreal(matrix) == 0'); + vrfy(isreal(nul) == 0, '6545: isreal(nul) == 0'); + vrfy(isreal(object) == 0, '6546: isreal(object) == 0'); + vrfy(isreal(rand) == 0, '6547: isreal(rand) == 0'); + vrfy(isreal(random) == 0, '6548: isreal(random) == 0'); + vrfy(isreal(real) == 1, '6549: isreal(real) == 1'); + vrfy(isreal(prime) == 1, '6550: isreal(prime) == 1'); + vrfy(isreal(square) == 1, '6551: isreal(square) == 1'); + vrfy(isreal(string) == 0, '6552: isreal(string) == 0'); + vrfy(isreal(com) == 0, '6553: isreal(com) == 0'); + print '6554: test unused'; + print '6555: test unused'; + print '6555: test unused'; + print '6556: test unused'; + print '6557: test unused'; + print '6558: test unused'; + print '6559: test unused'; + + /* + * test isrel + */ + vrfy(isrel(odd,even) == 0, '6560: isrel(odd,even) == 0'); + vrfy(isrel(even,odd) == 0, '6561: isrel(even,odd) == 0'); + vrfy(isrel(odd,odd) == 0, '6562: isrel(odd,odd) == 0'); + vrfy(isrel(even,prime) == 1, '6563: isrel(even,prime) == 1'); + vrfy(isrel(square,prime) == 0, '6564: isrel(square,prime) == 0'); + vrfy(isrel(prime,square) == 0, '6565: isrel(prime,square) == 0'); + vrfy(isrel(even,square) == 1, '6566: isrel(even,square) == 1'); + vrfy(isrel(prime,even) == 1, '6567: isrel(prime,even) == 1'); + print '6568: test unused'; + print '6569: test unused'; + + /* + * test bit (this was isset and thus was included here, however + * we leave it here for now rather than renumber + * the tests below) + */ + vrfy(bit(odd,0) == 1, '6570: bit(odd,0) == 1'); + vrfy(bit(odd,1) == 0, '6571: bit(odd,1) == 0'); + vrfy(bit(odd,2) == 0, '6572: bit(odd,2) == 0'); + vrfy(bit(odd,3) == 1, '6573: bit(odd,3) == 1'); + vrfy(bit(real,4) == 1, '6574: bit(real,4) == 1'); + vrfy(bit(real,5) == 0, '6575: bit(real,5) == 0'); + vrfy(bit(real,6) == 1, '6576: bit(real,6) == 1'); + vrfy(bit(real,7) == 0, '6577: bit(real,7) == 0'); + print '6578: test unused'; + print '6579: test unused'; + + /* + * test issimple + */ + vrfy(issimple(loc) == 1, '6580: issimple(loc) == 1'); + vrfy(issimple(a) == 0, '6581: issimple(a) == 0'); + vrfy(issimple(ofd) == 0, '6582: issimple(ofd) == 0'); + vrfy(issimple(cfd) == 0, '6583: issimple(cfd) == 0'); + vrfy(issimple(blk) == 0, '6584: issimple(blk) == 0'); + vrfy(issimple(nblk) == 0, '6585: issimple(nblk) == 0'); + vrfy(issimple(cfg) == 0, '6586: issimple(cfg) == 0'); + vrfy(issimple(serr) == 0, '6587: issimple(serr) == 0'); + vrfy(issimple(nerr) == 0, '6588: issimple(nerr) == 0'); + vrfy(issimple(odd) == 1, '6589: issimple(odd) == 1'); + vrfy(issimple(even) == 1, '6590: issimple(even) == 1'); + vrfy(issimple(hash) == 0, '6591: issimple(hash) == 0'); + vrfy(issimple(id) == 0, '6592: issimple(id) == 0'); + vrfy(issimple(list) == 0, '6593: issimple(list) == 0'); + vrfy(issimple(matrix) == 0, '6594: issimple(matrix) == 0'); + vrfy(issimple(nul) == 1, '6595: issimple(nul) == 1'); + vrfy(issimple(object) == 0, '6596: issimple(object) == 0'); + vrfy(issimple(rand) == 0, '6597: issimple(rand) == 0'); + vrfy(issimple(random) == 0, '6598: issimple(random) == 0'); + vrfy(issimple(real) == 1, '6599: issimple(real) == 1'); + vrfy(issimple(prime) == 1, '6600: issimple(prime) == 1'); + vrfy(issimple(square) == 1, '6601: issimple(square) == 1'); + vrfy(issimple(string) == 1, '6602: issimple(string) == 1'); + vrfy(issimple(com) == 1, '6603: issimple(com) == 1'); + print '6604: test unused'; + print '6605: test unused'; + print '6606: test unused'; + print '6607: test unused'; + print '6608: test unused'; + print '6609: test unused'; + + /* + * test issq + */ + vrfy(issq(loc) == 1, '6610: issq(loc) == 1'); + vrfy(issq(odd) == 0, '6611: issq(odd) == 0'); + vrfy(issq(even) == 0, '6612: issq(even) == 0'); + vrfy(issq(prime) == 0, '6613: issq(prime) == 0'); + vrfy(issq(square) == 1, '6614: issq(square) == 1'); + print '6615: test unused'; + print '6616: test unused'; + print '6618: test unused'; + print '6618: test unused'; + print '6619: test unused'; + + /* + * test isstr + */ + vrfy(isstr(loc) == 0, '6620: isstr(loc) == 0'); + vrfy(isstr(a) == 0, '6621: isstr(a) == 0'); + vrfy(isstr(ofd) == 0, '6622: isstr(ofd) == 0'); + vrfy(isstr(cfd) == 0, '6623: isstr(cfd) == 0'); + vrfy(isstr(blk) == 0, '6624: isstr(blk) == 0'); + vrfy(isstr(nblk) == 0, '6625: isstr(nblk) == 0'); + vrfy(isstr(cfg) == 0, '6626: isstr(cfg) == 0'); + vrfy(isstr(serr) == 0, '6627: isstr(serr) == 0'); + vrfy(isstr(nerr) == 0, '6628: isstr(nerr) == 0'); + vrfy(isstr(odd) == 0, '6629: isstr(odd) == 0'); + vrfy(isstr(even) == 0, '6630: isstr(even) == 0'); + vrfy(isstr(hash) == 0, '6631: isstr(hash) == 0'); + vrfy(isstr(id) == 0, '6632: isstr(id) == 0'); + vrfy(isstr(list) == 0, '6633: isstr(list) == 0'); + vrfy(isstr(matrix) == 0, '6634: isstr(matrix) == 0'); + vrfy(isstr(nul) == 0, '6635: isstr(nul) == 0'); + vrfy(isstr(object) == 0, '6636: isstr(object) == 0'); + vrfy(isstr(rand) == 0, '6637: isstr(rand) == 0'); + vrfy(isstr(random) == 0, '6638: isstr(random) == 0'); + vrfy(isstr(real) == 0, '6639: isstr(real) == 0'); + vrfy(isstr(prime) == 0, '6640: isstr(prime) == 0'); + vrfy(isstr(square) == 0, '6641: isstr(square) == 0'); + vrfy(isstr(string) == 1, '6642: isstr(string) == 1'); + vrfy(isstr(com) == 0, '6643: isstr(com) == 0'); + print '6644: test unused'; + print '6645: test unused'; + print '6645: test unused'; + print '6646: test unused'; + print '6647: test unused'; + print '6648: test unused'; + print '6649: test unused'; + + /* + * test istype + */ + vrfy(istype(odd,even) == 1, '6650: istype(odd,even) == 1'); + vrfy(istype(even,odd) == 1, '6651: istype(even,odd) == 1'); + vrfy(istype(odd,odd) == 1, '6652: istype(odd,odd) == 1'); + vrfy(istype(even,prime) == 1, '6653: istype(even,prime) == 1'); + vrfy(istype(square,prime) == 1, '6654: istype(square,prime) == 1'); + vrfy(istype(prime,square) == 1, '6655: istype(prime,square) == 1'); + vrfy(istype(even,square) == 1, '6656: istype(even,square) == 1'); + vrfy(istype(prime,even) == 1, '6657: istype(prime,even) == 1'); + vrfy(istype(prime,com) == 0, '6658: istype(prime,com) == 0'); + vrfy(istype(matrix,com) == 0, '6659: istype(matrix,com) == 0'); + + vrfy(istype(matrix,list) == 0, '6660: istype(matrix,list) == 0'); + vrfy(istype(matrix,odd) == 0, '6661: istype(matrix,odd) == 0'); + vrfy(istype(a,odd) == 0, '6662: istype(a,odd) == 0'); + + /* + * cleanup + */ + blkfree("blk5900"); + print '6663: blkfree("blk5900")'; + + print '6664: Ending test_is'; +} +print '168: test_is()'; + + +/* + * test_blk - test block of octets + */ +define test_blk() +{ + local A, B, C, A1, A2, B1; + + print '6700: Beginning test_blk'; + + A = blk(20); + print '6701: A = blk(20);'; + vrfy(size(A) == 20, '6702: size(A) == 20'); + vrfy(sizeof(A) == 256, '6703: sizeof(A) == 256'); + B = A; + print '6704: B = A;'; + vrfy(size(B) == 20, '6705: size(B) == 20'); + vrfy(A == B, '6706: A == B'); + + A[5] = 21; + print '6707: A[5] = 21;'; + vrfy(A[5] == 21, '6708: A[5] == 21'); + + A[6] = 'abc'; + print '6709: A[6] = "abc";'; + vrfy(A[6] == ord('a'), '6710: A[6] == ord("a")'); + + A[7] = 260; + print '6711: A[7] = 260;'; + vrfy(A[7] == 4, '6712: A[7] == 4'); + + A[8] = 3+4i; + print '6713: A[8] = 3+4i;'; + vrfy(A[8] == 3, '6714: A[8] == 3'); + + vrfy(A != B, '6715: A != B'); + + /* Equality of blocks of same data-length is unaffected by maxsizes */ + + C = blk(A, ,128); + print '6716: C = blk(A, ,128);'; + vrfy(size(C) == size(A), '6717: size(C) == size(A)'); + vrfy(sizeof(C) == 128, '6718: sizeof(C) == 128'); + vrfy(C == A, '6719: C == A'); + + /* Blocks of different lengths test as unequal */ + + C = blk(A,30); + print '6720: C = blk(A,30);'; + vrfy(size(C) == 30, '6721: size(C) == 30'); + vrfy(C != A, '6722: C != A;'); + + /* Reducing length to that of original data restores equality */ + + C = blk(C,20); + print '6723: C = blk(C,20);'; + vrfy(C == A, '6724: C == A'); + + /* Reading block beyond data length extends length */ + + A[29] = 7; + print '6725: A[29] = 7;'; + vrfy(A[29] == 7, '6726: A[29] == 7'); + vrfy(size(A) == 30, '6727: size(A) == 30'); + + /* Reducing length clears memory beyond new length */ + + A = blk(A, 20); + print '6728: A = blk(A, 20);'; + vrfy(A[29] == 0, '6729: A[29] == 0'); + + /* Reducing length to zero and initializing a few early values */ + + A = blk(A,0) = {1,,3,,5}; + print '6730: A = blk(A,0) = {1,,3,5};'; + + vrfy(A[4] == 5, '6731: A[4] == 5'); + vrfy(size(A) == 5, '6732: size(A) == 5'); + + /* Assignment of copy with initialization */ + + B = A; + print '6733: B = A;'; + C=blk(A)={,,,,,,,,,,0xbb}; + print '6734: C=blk(A)={,,,,,,,,,,0xbb};'; + + /* A has not been changed */ + + vrfy(A == B, '6735: A == B'); + vrfy(C[10] == 0xbb, '6736: C[10] == 0xbb'); + + /* Testing named blocks */ + + A1 = blk("blk6700"); + print '6737: A1 = blk("blk6700");'; + A2 = blk("blk6700"); + print '6738: A2 = blk("blk6700");'; + vrfy(A1 == A2, '6739: A1 == A2'); + vrfy(size(A1) == 0, '6740: size(A1) == 0'); + vrfy(sizeof(A1) == 256, '6741: sizeof(A1) == 256'); + print '6742: test disabled: test(A1) == 0'; + print '6743: test disabled: str(A1) == "blk6700"'; + vrfy(blocks() == 1, '6744: blocks() == 1'); + vrfy(blocks(1) == A1, '6745: blocks(1) == A1'); + + /* A second named block */ + + B1 = blk("+++6700", 15, 10) = {1,2,3,4,5}; + print '6746: B1 = blk("+++6700", , 10);'; + vrfy(size(B1) == 15, '6747: size(B1) == 15'); + vrfy(sizeof(B1) == 20, '6748: sizeof(B1) == 20'); + vrfy(test(B1) == 1, '6749: test(B1) == 1'); + print '6750: test disabled: str(B1) == "+++6700"'; + vrfy(blocks() == 2, '6751: blocks() == 2'); + vrfy(blocks(2) == B1, '6752: blocks(2) == B1'); + vrfy(B1 != A1, '6753: B1 != A1'); + + /* Referencing octets beyond datalen increases datalen */ + + A1[15] = 29; + print '6754: A1[15] = 29;'; + vrfy(A1[15] == 29, '6755: A1[15] == 29'); + vrfy(A2[15] == 29, '6756: A2[15] == 29'); + vrfy(size(A1) == 16, '6757: size(A1) == 16'); + vrfy(test(A1) == 1, '6758: test(A1) == 1'); + A1[99] = 11; + print '6759: A1[99] = 11;'; + vrfy(size(A1) == 100, '6760: size(A1) == 100'); + vrfy(A1[99] == 11, '6761: A1[99] == 11'); + + /* increasing chunksize */ + + null(blk(A1, , 1000)); + print '6762: null(blk(A1, , 1000));'; + vrfy(size(A1) == 100, '6763: size(A1) == 100'); + vrfy(sizeof(A1) == 1000, '6764: sizeof(A1) == 1000'); + vrfy(A1[99] == 11, '6765: A1[99] == 11'); + + /* reducing data-length */ + + A1 = blk(A1, 10); + print '6766: A1 = blk(A1, 10);'; + vrfy(size(A1) == 10, '6767: size(A1) == 10'); + + /* all octets now zero */ + + vrfy(test(A1) == 0, '6768: test(A1) == 0'); + vrfy(A1[99] == 0, '6769: A1[99] == 0'); + + /* freeing memory */ + + blkfree(A1); + print '6770: blkfree(A1);'; + + /* freeing named block memory reduces number of unfreed blocks */ + + vrfy(blocks() == 1, '6771: blocks() == 1'); + + /* 'removed' block still exists but has zero size and maxsize */ + + vrfy(blocks(1) == A1, '6772: blocks(1) == A1'); + vrfy(size(A1) == 0, '6773: size(A1) == 0'); + vrfy(sizeof(A1) == 0, '6774: sizeof(A1) == 0'); + vrfy(test(A1) == 0, '6775: test(A1) == 0'); + print '6776: test disabled: str(A1) == "blk6700"'; + + /* Equality of named blocks not affected by freeing of memory */ + + vrfy(A1 == A2, '6777: A1 == A2'); + + /* Executing blk('blk6700') reallocates memory for A1 */ + + null(blk('blk6700')); + print '6778: null(blk("blk6700"));'; + vrfy(size(A1) == 0, '6779: size(A1) == 0'); + vrfy(sizeof(A1) == 1000, '6780: sizeof(A1) == 1000'); + + /* A2 still refers to same block as A1 */ + + A1[100] = 0xff; + print '6781: A1[100] = 0xff;'; + vrfy(A2[100] == 0xff, '6782: A2[100] == 0xff'); + + /* A possibly confusing initialization and assignment */ + + mat A1[2] = {A1, B1}; + print '6783: mat A1[2] = {A1, B1};'; + vrfy(A1[0] == A2, '6784: A1[0] == A2'); + vrfy(A1[1] == B1, '6785: A1[1] == B1'); + vrfy(A1[0][100] == 0xff, '6786: A1[0][100] == 0xff'); + + print '6800: reserved for future expansion of test_blk'; + + print '6899: Ending test_blk'; +} +print '169: parsed test_blk()'; + + +/* + * test_blkcpy - test the new copy builtin function + */ +define test_blkcpy() +{ + local A, B, C, A1, A2, B1, fs, S, M1, M2, L1, L2, x; + + print '6800: Beginning test_blkcpy'; + + A = blk() = {1,2,3,4,5}; + print '6801: A = blk() = {1,2,3,4,5};'; + B = blk(); + print '6802: B = blk();'; + blkcpy(B, A); + print '6803: blkcpy(B, A);'; + vrfy(A == B, '6804: A == B'); + blkcpy(B, A, ,10); + print '6805: blkcpy(B, A, ,10)'; + vrfy(size(B) == 15, '6806: size(B) == 15'); + blkcpy(B, A, , 15, 3); + print '6807: blkcpy(A, 3, B, 15);'; + vrfy(size(B) == 17, '6808: size(B) == 17'); + vrfy(B[16] == 5, '6809: B[16] == 5'); + + /* create named block A1 and blkcpy A into B[0]... and B[100]... */ + + x = rm("-f", "blk6800"); + print '6810: x = rm("-f", "blk6800")'; + A1 = blk("blk6800"); + print '6811: A1 = blk("blk6800");'; + vrfy(size(A1) == 0, '6812: size(A1) == 0'); + blkcpy(A1, A); + print '6813: blkcpy(A1, A);'; + vrfy(size(A1) == 5, '6814: size(A1) == 5'); + blkcpy(A1, A, ,100); + print '6815: blkcpy(A1, A, ,100);'; + vrfy(size(A1) == 105, '6816: size(A1) == 105'); + + /* create named block B1 and blkcpy first 5 octets of A1 to B[100]... */ + + B1 = blk("beta"); + print '6817: B1 = blk("beta")'; + vrfy(size(B1) == 0, '6818: size(B1) == 0'); + blkcpy(B1, A1, 5, 100, 0); + print '6819: blkcpy(B1, A1, 5, 100, 0)'; + vrfy(size(B1) == 105, '6820: size(B1) == 105'); + + /* blkcpy the last 5 octets of B1 to a new block C */ + + blkcpy(C = blk(), B1, 5, ,100); + print '6821: blkcpy(C = blk(), B1, 5, ,100);'; + vrfy(C == A, '6822: C == A'); + + /* blkcpy to and from a file */ + + fs = fopen("junk6800", "w+"); + print '6823: fs = fopen("junk6800", "w+");'; + blkcpy(fs, A); + print '6824: blkcpy(fs, A);'; + vrfy(size(fs) == 5, '6825: size(f) == 5'); + blkcpy(B = blk(), fs); + print '6826: blkcpy(B = blk(), fs);'; + vrfy(B == A, '6827: B == A'); + blkcpy(fs, A, ,100); + print '6828: blkcpy(fs, A, ,100);'; + vrfy(size(fs) == 105, '6829: size(f) == 105'); + blkcpy(C = blk(), fs, 2, ,100); + print '6830: blkcpy(C = blk(), fs, 2, ,100)'; + vrfy(C == (blk() = {1,2}), '6831: C == (blk() = {1,2}'); + + /* blkcpy string to a block */ + + A = blk(); + print '6832: A = blk();'; + + /* Note that "blk6800" is not here considered to name a block */ + + blkcpy(A, "blk6800 "); + print '6833: blkcpy(A, "blk6800");'; + vrfy(size(A) == 9, '6834: size(A) == 9'); + blkcpy(A, "beta", , 7); + print '6835: blkcpy(A, "beta", , 7);'; + vrfy(size(A) == 12, '6836: size(A) == 12'); + + /* read strings from A */ + + S = strprintf("%s", A[0]); + print '6837: S = strprintf("%s", A[0]);'; + vrfy(S == "blk6800beta", '6838: S == "blk6800beta"'); + S = strprintf("%s", A[8]); + print '6839: S = strprintf("%s", A[8]);'; + vrfy(S == "eta", '6840: S == "eta"'); + + mat M1[2,2] = {1,2,3,4}; + print '6841: mat M1[2,2] = {1,2,3,4};'; + mat M2[4]; + print '6842: mat M2[4];'; + blkcpy(M2, M1); + print '6843: blkcpy(M2, M1)'; + vrfy(M2 == (mat[4]={1,2,3,4}), '6844: M2 == (mat[4]={1,2,3,4}'); + blkcpy(M2, M2, 2, 2, 0); + print '6845: blkcpy(M2, M2, 2, 2, 0);'; + vrfy(M2 == (mat[4]={1,2,1,2}), '6846: M2 == (mat[4]={1,2,1,2}'); + + /* blkcpy between blocks and matrices */ + + B = blk(); + print '6847: B = blk()'; + blkcpy(B, M1); + print '6848: blkcpy(B, M1)'; + vrfy(B == (blk() = {1,2,3,4}), '6849: B == (blk() = {1,2,3,4}'); + blkcpy(M2, B, 2, ,2); + print '6850: blkcpy(B,2,2,M2);'; + vrfy(M2 == (mat[4]={3,4,1,2}), '6851: M2 == (mat[4]={3,4,1,2})'); + + /* blkcpy between matrices and lists */ + + L1 = makelist(4); + print '6852: L1 = makelist(4);'; + blkcpy(L1, M2); + print '6853: blkcpy(L1, M2);'; + + blkcpy(M2, L1, 2, ,2); + print '6854: blkcpy(M2, L1, 2, ,2);'; + vrfy(M2 == (mat[4]={1,2,1,2}), '6855: M2 == (mat[4]={1,2,1,2}'); + + /* blkcpy lists to lists */ + + L2 = makelist(4); + print '6856: L2 = makelist(4);'; + blkcpy(L2, L1); + print '6857: blkcpy(L2, L1);'; + vrfy(L1 == L2, '6858: L1 == L2'); + blkcpy(L2, L1, 2, 2, 0); + print '6859: blkcpy(L2, L1, 2, 2, 0)'; + vrfy(L2 == list(3,4,3,4), '6860: L2 == list(3,4,3,4)'); + + /* blkcpy between structures and substructures */ + + M2[0] = L2; + print '6861: M2[0] = L2;'; + blkcpy(M2, M2[0]); + print '6862: blkcpy(M2, M2[0]);'; + vrfy(M2 == (mat[4]={3,4,3,4}), '6863: M2 == (mat[4]={3,4,3,4})'); + M2[2] = list(1,2,3,4); + print '6864: M2[2] = list(1,2,3,4);'; + blkcpy(M2[2], M2); + print '6865: blkcpy(M2[2], M2);'; + vrfy(M2[2][[2]][[2]] == 3, '6866: M2[2][[2]][[2]] == 3'); + + /* cleanup */ + fclose(fs); + print '6867: fclose(fs)'; + x = rm("junk6800"); + print '6868: x = rm("junk6800")'; + + print '6868: Ending test_blkcpy'; +} +print '170: parsed test_blkcpy()'; + + +/* + * test_name - test the name builtin + */ +define test_name() +{ + local f, A, x; + + print '6900: Beginning test_name'; + + x = rm("-f", "junk6900"); + print '6901: x = rm("-f", "junk6900")'; + f = fopen("junk6900", "w"); + print '6902: f = fopen("junk6900", "w")'; + vrfy(name(f) == "junk6900", '6903: name(f) == "junk6900"'); + + /* file stream loses name when file is closed */ + + fclose(f); + print '6904: fclose(f)'; + vrfy(name(f) == null(), '6905: name(f) == null()'); + A = blk("blk6900"); + print '6906: A = blk("blk6900")'; + vrfy(name(A) == "blk6900", '6907: name(A) == "blk6900"'); + + /* name of block is not lost when its data memory is freed */ + + blkfree("blk6900"); + print '6908: blkfree("blk6900");'; + vrfy(name(A) == "blk6900", '6909: name(A) == "blk6900"'); + + /* values other than named blocks and files have no name */ + + vrfy(name(27) == null(), '6910: name(27) == null()'); + + /* cleanup */ + + x = rm("junk6900"); + print '6911: x = rm("junk6900")'; + + print '6912: Ending test_name'; +} +print '171: parsed test_name()'; + + +/* + * test_blkprintf - test blk printf + */ +define test_blkprintf() +{ + local A, B; + + print '7000: Beginning test_blkprintf'; + A = blk("alpha"); + print '7001: A = blk("alpha")'; + B = blk(); + print '7002: B = blk();'; + copy("abc yz", A); + print '7003: copy("abc yz", A);'; + copy("defg", B); + print '7004: copy("defg", B);'; + vrfy(strprintf("%s", A) == "abc yz", + '7005: strprintf("%s", A) == "abc yz"'); + vrfy(strprintf("%s", A[2]) == "c yz", + '7006: strprintf("%s", A[2]) == "c yz"'); + vrfy(strprintf("%s", A[7]) == "", + '7007: strprintf("%s", A[7]) == ""'); + vrfy(strprintf("%c", A) == "a", + '7008: strprintf("%c", A == "a"'); + vrfy(strprintf("%c", A[4]) == "y", + '7009: strprintf("%c", A[4]) == "y"'); + vrfy(strprintf("%s", B) == "defg", + '7010: strprintf("%s", B) == "defg"'); + vrfy(strprintf("%s", B[1]) == "efg", + '7011: strprintf("%s", B[1]) == "efg"'); + vrfy(strprintf("%s", B[7]) == "", + '7012: strprintf("%s", B[7]) == ""'); + vrfy(strprintf("%c", B) == "d", + '7013: strprintf("%c", B == "d"'); + vrfy(strprintf("%c", B[2]) == "f", + '7014: strprintf("%c", B[2]) == "f"'); + + print '7015: Ending test_blkprintf'; +} +print '172: parsed test_blkprintf()'; + + +/* + * test_sha - test the sha hash + */ +define test_sha() +{ + local a, b, c, d, e, f, x, y, z, L, M, B1, B2, B; + + print '7100: Beginning test_sha'; + y = sha(); + print '7101: y = sha();'; + z = sha(); + print '7102: z = sha();'; + vrfy(y == z, '7103: y == z'); + vrfy(sha("") == y, '7104: sha("") == y'); + y = sha(y,1); + print '7105: y = sha(y,1);'; + vrfy(y == sha(1), '7106: y == sha(1)'); + vrfy(sha(y,2) == sha(1,2), '7107: sha(y,2) == sha(1,2)'); + + vrfy(sha(sha()) == 0xf96cea198ad1dd5617ac084a3d92c6107708c0ef, + '7108: sha(sha()) == 0xf96cea198ad1dd5617ac084a3d92c6107708c0ef'); + + vrfy(sha(sha("a"))==0x37f297772fae4cb1ba39b6cf9cf0381180bd62f2, + '7109: sha(sha("a"))==0x37f297772fae4cb1ba39b6cf9cf0381180bd62f2'); + + vrfy(sha(sha("ab"))==0x488373d362684af3d3f7a6a408b59dfe85419e09, + '7110: sha(sha("ab"))==0x488373d362684af3d3f7a6a408b59dfe85419e09'); + vrfy(sha(sha("abc"))==0x0164b8a914cd2a5e74c4f7ff082c4d97f1edf880, + '7111: sha(sha("abc"))==0x0164b8a914cd2a5e74c4f7ff082c4d97f1edf880'); + vrfy(sha(sha("abcd"))==0x082c73b06f71185d840fb4b28eb3abade67714bc, + '7112: sha(sha("abcd"))==0x082c73b06f71185d840fb4b28eb3abade67714bc'); + vrfy(sha(sha("abcde"))==0xd624e34951bb800f0acae773001df8cffe781ba8, + '7113: sha(sha("abcde"))==0xd624e34951bb800f0acae773001df8cffe781ba8'); + vrfy(sha(sha("abcdef"))==0x2a589f7750598dc0ea0a608719e04327f609279a, + '7114: sha(sha("abcdef"))==0x2a589f7750598dc0ea0a608719e04327f609279a'); + vrfy(sha(sha("abcdefg"))==0x5bdf01f9298e9d19d3f8d15520fd74eed600b497, + '7115: sha(sha("abcdefg"))==0x5bdf01f9298e9d19d3f8d15520fd74eed600b497'); + vrfy(sha(sha("abcdefgh"))==0x734ba8b31975d0dbae4d6e249f4e8da270796c94, + '7116: sha(sha("abcdefgh"))==0x734ba8b31975d0dbae4d6e249f4e8da270796c94'); + + vrfy(sha(sha(1)) == 0x864c8d09e828c7c31d62693736a5a9302c282777, + '7117: sha(sha(1)) == 0x864c8d09e828c7c31d62693736a5a9302c282777'); + + vrfy(sha(sha(2)) == 0x2c0b59c512cb20fad6bb0883b69c9f5a46545808, + '7118: sha(sha(2)) == 0x2c0b59c512cb20fad6bb0883b69c9f5a46545808'); + + vrfy(sha(sha(22/7))==0x7ddb7f8a7e9d70757f157744fddea7a6c6a6bcc6, + '7119: sha(sha(22/7)==0x7ddb7f8a7e9d70757f157744fddea7a6c6a6bcc6'); + vrfy(sha(sha(isqrt(2e1000))) == + 0x6db8d9cf0b018b8f9cbbf5aa1edb8066d19e1bb0, + '7120: sha(sha(isqrt(2e1000)==0x6db8d9cf0b018b8f9cbbf5aa1edb8066d19e1bb0'); + vrfy(sha("x", "y", "z") == sha("xyz"), + '7121: sha("x", "y", "z") == sha("xyz")'); + + vrfy(sha(sha("this is", 7^19-8, "a composit", 3i+4.5, "hash")) == + 0x21e42319a26787046c2b28b7ae70f1b54bf0ba2a, + '7122: sha(sha("this is", 7^19-8, ..., "hash")) == 0x21e4...'); + + z = sha(list(1,2,3), "curds and whey", 2^21701-1, pi()); + print '7123: z = sha(list(1,2,3), "curds and whey", 2^21701-1, pi());'; + vrfy(sha(z) == 0x36dcca3e51865c30a2cf738023cda446f1368340, + '7124: sha(z) == 0x36dcca3e51865c30a2cf738023cda446f1368340'); + + y = sha(); + print '7125: y = sha()'; + y = sha(y, list(1,2,3), "curds and whey"); + print '7126: y = sha(y, list(1,2,3), "curds and whey")'; + y = sha(y, 2^21701-1); + print '7127: y = sha(y, 2^21701-1)'; + y = sha(y, pi()); + print '7128: y = sha(y, pi())'; + vrfy(y == z, '7129: y == z'); + + B = blk() = {"a", "b", "c"}; + print '7130: B = blk() = {"a", "b", "c"};'; + vrfy(sha(B) == sha("abc"), '7131: sha(B) == sha("abc")'); + + B1 = blk() = {1,2,3,4}; + print '7132: B1 = blk() = {1,2,3,4};'; + B2 = blk() = {5,6,7,8}; + print '7133: B2 = blk() = {5,6,7,8};'; + B = blk() = {1,2,3,4,5,6,7,8}; + print '7134: B = blk() = {1,2,3,4,5,6,7,8};'; + + vrfy(sha(B1, B2) == sha(B), '7135: sha(B1, B2) == sha(B)'); + vrfy(sha(B[1], B[3], B[5]) == sha("\02\04\06"), + '7136: sha(B[1], B[3], B[5]) == sha("\02\04\06")'); + + L = list(1,2,3); + print '7137: L = list(1,2,3)'; + mat M[3] = {4,5,6}; + print '7138: mat M[3] = {4,5,6}'; + vrfy(sha(sha(L), M, B) == sha(L, M, B), + '7139: sha(sha(L), M, B) == sha(L, M, B)'); + vrfy(sha(sha(L,M), B) == sha(L, M, B), + '7140: sha(sha(L, M), B) == sha(L, M, B)'); + + print '7141: Ending test_sha'; +} +print '173: parsed test_sha()'; + + +/* + * test_sha1 - test the sha1 hash + */ +define test_sha1() +{ + local a, b, c, d, e, f, x, y, z, L, M, B; + + print '7200: Beginning test_sha1'; + y = sha1(); + print '7201: y = sha1();'; + z = sha1(); + print '7202: z = sha1();'; + vrfy(y == z, '7203: y == z'); + z = sha1(1); + print '7204: z = sha1(1);'; + vrfy(sha1(y,1) == z, '7205: sha1(y,1) == z'); + vrfy(sha1(z,2) == sha1(1,2), '7206: sha1(z,2) == sha1(1,2)'); + vrfy(sha1(sha1()) == 0xda39a3ee5e6b4b0d3255bfef95601890afd80709, + '7207: sha1(sha1()) == 0xda39a3ee5e6b4b0d3255bfef95601890afd80709'); + vrfy(sha1("x", "y", "z") == sha1("xyz"), + '7208: sha1("x", "y", "z") == sha1("xyz")'); + + vrfy(sha1(sha1("this is",7^19-8,"a composit",3i+4.5,"hash")) == + 0xc3e1b562bf45b3bcfc055ac65b5b39cdeb6a6c55, + '7209: sha1(sha1("this is",7^19-8,"a composit",3i+4.5,"hash")) == ...'); + + + z = sha1(list(1,2,3), "curds and whey", 2^21701-1, pi()); + print '7210: z = sha1(list(1,2,3), "curds and whey", 2^21701-1, pi());'; + vrfy(sha1(z) == 0xc19e7317675dbf71e293b4c41e117169e9da5b6f, + '7211: sha1(z) == 0xc19e7317675dbf71e293b4c41e117169e9da5b6f'); + + y = sha1(); + print '7212: y = sha1();'; + y = sha1(y, list(1,2,3), "curds and whey"); + print '7213: y = sha1(y, list(1,2,3), "curds and whey");'; + y = sha1(y, 2^21701-1); + print '7214: y = sha1(y, 2^21701-1);'; + y = sha1(y, pi()); + print '7215: y = sha1(y, pi());'; + vrfy(y == z, '7216: y == z'); + + vrfy(sha1(sha1("a"))==0x86f7e437faa5a7fce15d1ddcb9eaeaea377667b8, + '7217: sha1(sha1("a"))==0x86f7e437faa5a7fce15d1ddcb9eaeaea377667b8'); + + vrfy(sha1(sha1("ab"))==0xda23614e02469a0d7c7bd1bdab5c9c474b1904dc, + '7218: sha1(sha1("ab"))==0xda23614e02469a0d7c7bd1bdab5c9c474b1904dc'); + vrfy(sha1(sha1("abc"))==0xa9993e364706816aba3e25717850c26c9cd0d89d, + '7219: sha1(sha1("abc"))==0xa9993e364706816aba3e25717850c26c9cd0d89d' + ); + vrfy(sha1(sha1("abcd"))==0x81fe8bfe87576c3ecb22426f8e57847382917acf, + '7220: sha1(sha1("abcd"))==0x81fe8bfe87576c3ecb22426f8e57847382917acf'); + vrfy(sha1(sha1("abcde"))==0x03de6c570bfe24bfc328ccd7ca46b76eadaf4334, + '7221: sha1(sha1("abcde"))==0x03de6c570bfe24bfc328ccd7ca46b76eadaf4334'); + vrfy(sha1(sha1("abcdef"))== 0x1f8ac10f23c5b5bc1167bda84b833e5c057a77d2, + '7222: sha1(sha1("abcdef"))==0x1f8ac10f23c5b5bc1167bda84b833e5c057a77d2'); + vrfy(sha1(sha1("abcdefg"))==0x2fb5e13419fc89246865e7a324f476ec624e8740, + '7223: sha1(sha1("abcdefg"))==0x2fb5e13419fc89246865e7a324f476ec624e8740'); + vrfy(sha1(sha1("abcdefgh"))==0x425af12a0743502b322e93a015bcf868e324d56a, + '7224: sha1(sha1("abcdefgh"))==0x425af12a0743502b322e93a015bcf868e324d56a'); + + vrfy(sha1(sha1(1))==0x53dd4e1734ad47d45e41c23e4ce42d7f1f98c1e8, + '7225: sha1(sha1(1))==0x53dd4e1734ad47d45e41c23e4ce42d7f1f98c1e8'); + vrfy(sha1(sha1(22/7))==0xf8e2510f85f7b9bf088b321188e9f70620f44246, + '7226: sha1(sha1(22/7))==0xf8e2510f85f7b9bf088b321188e9f70620f44246'); + vrfy(sha1(sha1(isqrt(2e1000)))== + 0x6852a1365c51050c3d039e3c5d9cf29c12283ef4, + '7227: sha1(sha1(isqrt(2e1000)))==0x6852a1365c51050c3d039e3c5d9cf29c12283ef4' + ); + L = list(1,2,3); + print '7228: L = list(1,2,3)'; + mat M[3] = {4,5,6}; + print '7229: mat M[3] = {4,5,6}'; + B = blk() = {7,8,9}; + print '7230: B = blk() = {7,8,9}'; + vrfy(sha1(sha1(L), M, B) == sha1(L, M, B), + '7231: sha1(sha1(L), M, B) == sha1(L, M, B)'); + vrfy(sha1(sha1(L,M), B) == sha1(L, M, B), + '7232: sha1(sha1(L, M), B) == sha1(L, M, B)'); + + print '7233: Ending test_sha1'; +} +print '174: parsed test_sha1()'; + + +/* + * test_md5 - test the md5 hash + */ +define test_md5() +{ + local a, b, c, d, e, f, x, y, z, L, M, B; + + print '7300: Beginning test_md5'; + y = md5(); + print '7301: y = md5();'; + z = md5(); + print '7302: z = md5();'; + vrfy(y == z, '7303: y == z'); + y = md5(y,1); + print '7304: y = md5(y,1);'; + z = md5(1); + print '7305: z = md5(1);'; + vrfy(y == z, '7306: y == z'); + vrfy(md5(z,2) == md5(1,2), '7307: md5(z,2) == md5(1,2)'); + + vrfy(md5(md5()) == 0xd41d8cd98f00b204e9800998ecf8427e, + '7308: md5(md5()) == 0xd41d8cd98f00b204e9800998ecf8427e'); + vrfy(md5("x", "y", "z") == md5("xyz"), + '7309: md5("x", "y", "z") == md5("xyz")'); + + vrfy(md5(md5("this is", 7^19-8, "a composit", 3i+4.5, "hash")) == + 0x39a5a8e24a2eb65a51af462c8bdd5e3, + '7310: md5(md5("this is", 7^19-8, "a composit", 3i+4.5, "hash")) == ...'); + + + z = md5(list(1,2,3), "curds and whey", 2^21701-1, pi()); + print '7311: z = md5(list(1,2,3), "curds and whey", 2^21701-1, pi());'; + vrfy(md5(z) == 0x63d2b2fccae2de265227c30b05abb6b5, + '7312: md5(z) == 0x63d2b2fccae2de265227c30b05abb6b5'); + y = md5(); + print '7313: y = md5();'; + y = md5(y, list(1,2,3), "curds and whey"); + print '7314: y = md5(y, list(1,2,3), "curds and whey")'; + y = md5(y, 2^21701-1); + print '7315: y = md5(y, 2^21701-1);'; + y = md5(y, pi()); + print '7316: y = md5(y, pi());'; + vrfy(y == z, '7317: y == z'); + + vrfy(md5(md5("a")) == 0x0cc175b9c0f1b6a831c399e269772661, + '7318: md5(md5("a")) == 0x0cc175b9c0f1b6a831c399e269772661'); + vrfy(md5(md5("ab")) == 0x187ef4436122d1cc2f40dc2b92f0eba0, + '7319: md5(md5("ab")) == 0x187ef4436122d1cc2f40dc2b92f0eba0'); + vrfy(md5(md5("abc")) == 0x900150983cd24fb0d6963f7d28e17f72, + '7320: md5(md5("abc")) == 0x900150983cd24fb0d6963f7d28e17f72'); + vrfy(md5(md5("abcd")) == 0xe2fc714c4727ee9395f324cd2e7f331f, + '7321: md5(md5("abcd")) == 0xe2fc714c4727ee9395f324cd2e7f331f'); + vrfy(md5(md5("abcde")) == 0xab56b4d92b40713acc5af89985d4b786, + '7322: md5(md5("abcde")) == 0xab56b4d92b40713acc5af89985d4b786'); + vrfy(md5(md5("abcdef")) == 0xe80b5017098950fc58aad83c8c14978e, + '7323: md5(md5("abcdef")) == 0xe80b5017098950fc58aad83c8c14978e'); + vrfy(md5(md5("abcdefg")) == 0x7ac66c0f148de9519b8bd264312c4d64, + '7324: md5(md5("abcdefg")) == 0x7ac66c0f148de9519b8bd264312c4d64'); + vrfy(md5(md5("abcdefgh")) == 0xe8dc4081b13434b45189a720b77b6818, + '7325: md5(md5("abcdefgh")) == 0xe8dc4081b13434b45189a720b77b6818'); + vrfy(md5(md5(1)) == 0x44fe7987067ac45311c88772038f60d1, + '7326: md5(md5(1)) == 0x44fe7987067ac45311c88772038f60d1'); + vrfy(md5(md5(22/7)) == 0x9274b951e1dfb9cba22af1c127daa8e7, + '7327: md5(md5(22/7) == 0x9274b951e1dfb9cba22af1c127daa8e7'); + vrfy(md5(md5(isqrt(2e1000))) == 0xe56ac4b8cad869e738a04fedc97058f3, + '7328: md5(md5(isqrt(2e1000))) == 0xe56ac4b8cad869e738a04fedc97058f3'); + L = list(1,2,3); + print '7329: L = list(1,2,3)'; + mat M[3] = {4,5,6}; + print '7330: mat M[3] = {4,5,6}'; + B = blk() = {7,8,9}; + print '7331: B = blk() = {7,8,9}'; + vrfy(md5(md5(L), M, B) == md5(L, M, B), + '7332: md5(md5(L), M, B) == md5(L, M, B)'); + vrfy(md5(md5(L,M), B) == md5(L, M, B), + '7333: md5(md5(L, M), B) == md5(L, M, B)'); + + print '7334: Ending test_md5'; +} +print '175: parsed test_md5()'; + + +/* + * The 7400's contain tests for saveval and dot. These tests are + * done inline near the bottom. + */ + + +/* + * test_ptr - test pointers + */ +define g7500a(a,b) = a = b; +print '176: define g7500a(a,b) = a = b'; +define g7500b(a,b) = a + b; +print '177: define g7500b(a,b) = a + b'; +define g7500c(a,b) = *(a + b); +print '178: define g7500c(a,b) = *(a + b)'; +define g7500d(a) = &a; +print '179: define g7500d(a) = &a'; +define g7500e(a,b) = *a = b; +print '180: define g7500e(a,b) = *a = b' +define test_ptr() +{ + local a, b, c, A, B, B1, B2, M, L, p, q, p0, q0; + + print '7500: Beginning test_ptr'; + + vrfy(isoctet(27) == 0, '7501: isoctet(27) == 0'); + vrfy(isptr(27) == 0, '7502: isptr(27) == 0'); + + /* testing octet pointers */ + + B = blk() = {1,2,3,4,5,6}; + print '7503: B = blk() = {1,2,3,4,5,6};'; + vrfy(isoctet(B[0]) == 1, '7504: isoctet(B[0]) == 1'); + vrfy(isnum(B[0]) == 0, '7505: isnum(B[0]) == 0'); + vrfy(isptr(B[0]) == 0, '7506: isptr(B[0]) == 0'); + vrfy(isoctet(*B[0]) == 0, '7507: isoctet(*B[0]) == 0'); + vrfy(isnum(*B[0]) == 1, '7508: isnum(*B[0]) == 1'); + vrfy(isoctet(&B[0]) == 0, '7509: isoctet(&B[0]) == 0'); + vrfy(isptr(&B[0]) == 1, '7510: isptr(&B[0]) == 1'); + vrfy(*B[3] == B[3], '7511: *B[3]== B[3]'); + vrfy(*&B[3] == B[3], '7512: *&B[3] == B[3]'); + vrfy(&B[0] + 3 == &B[3], '7513: &B[0] + 3 == &B[3]'); + vrfy(&B[3] - &B[0] == 3, '7514: &B[3] - &B[0] == 3'); + vrfy(&B[3] - 3 == &B[0], '7515: &B[3 - 3 == &B[1]'); + vrfy(&B[3] > &B[0], '7516: &B[3] > &B[0]'); + swap(B[0], B[5]); + print '7517: swap(B[0], B[5]);'; + vrfy(B[0] == 6 && B[5] == 1, '7518: B[0] == 6 && B[5] == 1'); + + /* testing octet-pointer-valued variables */ + + p = &B[0], q = &B[5]; + print '7519: p = &B[0], q = &B[5]'; + vrfy(isoctet(p) == 0, '7520: isoctet(p) == 0'); + vrfy(isptr(p) == 1, '7521: isptr(p) == 1'); + vrfy(isoctet(*p) == 1, '7522: isoctet(*p) == 1'); + vrfy(isptr(*p) == 0, '7523: isptr(*p) == 0'); + vrfy(p == &B[0], '7524: p == &B[0]'); + vrfy(q != p, '7525: q != p'); + vrfy(q > p, '7526: q > p'); + vrfy(*p == B[0], '7527: *p == B[0]'); + vrfy(&B[1] == p + 1, '7528: &B[1] == p + 1'); + vrfy(q == p + 5, '7529: q == p + 5'); + *p = 1, *q = 6; + print '7530: *p = 1, *q = 6'; + vrfy(B[0] == 1 && B[5] == 6, '7531: B[0] == 1 && B[5] == 6'); + a = *p, b = *q; + print '7532: a = *p, b = *q'; + vrfy(a == 1 && b == 6, '7533: a == 1 && b == 6'); + *(p + 3) = 7; + print '7534: *(p + 3) = 7;'; + vrfy(B[3] == 7, '7535: B[3] == 7'); + *(q - 2) = 8; + print '7536: *(q - 2) = 8;'; + vrfy(B[3] == 8, '7537: B[3] == 8'); + p0 = p++; + print '7538: p0 = p++;'; + vrfy(p0 == &B[0] && p == &B[1], '7539: p0 == &B[0] && p == &B[1]'); + q0 = --q; + print '7540: q0 = --q'; + vrfy(q0 == &B[4] && q == q0, '7541: q0 == &B[4] && q == q0'); + a = *p++, b = *q--; + print '7542: a = *p++, b = *q--;'; + vrfy(a == 2 && b == 5, '7543: a == 2 && b == 5'); + vrfy(p - &B[0] == 2 && q == &B[0] + 3, + '7544: p - &B[0] == 2 && q == &B[0] + 3'); + a = *--q, b = *----q; + print '7545: a = *--q, b = *----q;'; + vrfy(q == &B[0], '7546: q == &B[0]'); + vrfy(a == 3 && b == 1, '7547: a == 3 && b == 1'); + a = (*p)++; + print '7548: a = (*p)++;'; + vrfy(a == 3 && B[2] == 4, '7549: a == 3 && B[2] == 4'); + a = ++(*++p)++; + print '7550: a = ++(*++p)++;'; + vrfy(a == 9 && B[3] == 10, '7551: a == 9 && B[3] == 10'); + + /* testing octets, & and * in arguments of user-defined functions */ + + A = blk() = {1,2,3}; + print '7552: A = blk() = {1,2,3};'; + vrfy(g7500a(A[0],5) == 5, '7553: g7500a(A[0],5) == 5'); + vrfy(A[0] == 5, '7554: A[0] == 5'); + vrfy(g7500a(`A[0],5) == 5, '7555: g7500a(`A[0],5) == 5'); + vrfy(A[0] == 5, '7556: A[0] == 5'); + vrfy(g7500b(&A[0],3) == &A[3], '7557: g7500b(&A[0],3) == &A[3]'); + vrfy(g7500c(&A[0],2) == 3, '7558: g7500c(&A[0], 2) == 3'); + vrfy(g7500d(`A[0]) == &A[0], '7559: g7500d(`A[0]) == &A[0]'); + p = &A[0]; + print '7560: p = &A[0];'; + vrfy(g7500a(*p, 6) == 6, '7561: g7500a(*p, 6) == 6'); + vrfy(*p == 6, '7562: *p == 6'); + vrfy(g7500a(`*p,6) == 6, '7563: g7500a(`*p,6) == 6'); + vrfy(*p == 6, '7564: *p == 6'); + vrfy(g7500b(p,3) == p + 3, '7565: g7500b(p,3) == p + 3'); + vrfy(g7500c(p,2) == 3, '7566: g7500c(p,2) == 3'); + vrfy(g7500d(`*p) == p, '7567: g7500d(`*p) == p'); + vrfy(g7500e(p,4) == 4, '7568: g7500e(p,4) == 4'); + vrfy(A[0] == 4, '7569: A[0] == 4'); + vrfy(g7500e(p+2,5) == 5, '7570: g7500e(p+2,5) == 5'); + vrfy(A[2] == 5, '7571: A[2] == 5'); + + /* testing pointers to values */ + + A = 27, p = &A; + print '7572: A = 27, p = &A;'; + vrfy(isptr(A) == 0, '7573: isptr(A) == 0'); + vrfy(isptr(&A) == 2, '7574: isptr(&A) == 2'); + vrfy(isptr(p) == 2, '7575: isptr(p) == 2'); + vrfy(*p == 27, '7576: *p == 27'); + vrfy(p == &A, '7577: p == &A'); + *p = 45; + print '7578: *p = 45;'; + vrfy(A == 45, '7579: A == 45'); + q = p; + print '7580: q = p;'; + vrfy(q == &A, '7581: q == &A'); + q = &p; + print '7582: q = &p'; + vrfy(*q == p, '7583: *q == p'); + vrfy(**q == A, '7584: **q == A'); + vrfy(***q == A, '7585: ***q == A'); + M = mat[4] = {1,2,3,4}; + print '7586: M = mat[4] = {1,2,3,4};'; + p = &M[0], *p = 5; + print '7587: p = &M[0], *p = 5;'; + vrfy(M[0] == 5, '7588: M[0] == 5'); + *++p = 6; + print '7589: *++p = 6;'; + vrfy(M[1] == 6, '7590: M[1] == 6'); + q = p++; + print '7591: q = p++;'; + vrfy(q == &M[1], '7592: q == &M[1]'); + vrfy(p == &M[2], '7593: p == &M[2]'); + quomod(17,5,*q,*p); + print '7594: quomod(17,5,*p,*q);'; + vrfy(M[1] == 3 && M[2] == 2, '7595: M[1] == 3 && M[2] == 2'); + swap(*p, *q); + print '7596: swap(*p, *q);'; + vrfy(M[1] == 2 && M[2] == 3, '7597: M[1] == 2 && M[2] == 3'); + A = *M = {7,8}; + print '7598: A = *M = {7,8};'; + vrfy(M == (mat[4] = {5,2,3,4}), '7599: M == (mat[4] = {5,2,3,4})'); + vrfy(A == (mat[4] = {7,8,3,4}), '7600: A == (mat[4] = {7,8,3,4})'); + + /* Values which point to themselves */ + + A = &A; + print '7601: A = &A;'; + vrfy(&A == A && *A == A, '7602: &A == A && *A == A'); + A = &B, B = &A; + print '7603: A = &B, B = &A;'; + vrfy(**A == A && ***A == B, '7604: **A == A && ***A == B'); + + /* Testing functions that return pointers */ + + M[3] = 7; + print '7605: M[3] = 7;'; + vrfy(*g7500b(&M[1], 2) == 7, '7606: *g7500b(&M[1], 2) == 7'); + + *g7500b(&M[1], 2) = 8; + print '7607: *g7500b(&M[1], 2) = 8;'; + vrfy(M[3] == 8, '7608: M[3] == 8'); + M[3] = list(9,10); + print '7609: M[3] = list(9,10);'; + vrfy((*g7500b(&M[1], 2))[[1]] == 10, + '7610: (*g7500b(&M[1], 2))[[1]] == 10'); + + /* Testing number and string pointers */ + + a = 24, b = 4 * 6, c = 4!; + print '7611: a = 24, b = 4 * 6, c= 4!;'; + vrfy(isptr(&*a) == 4, '7612: isptr(&*a) == 4'); + vrfy(&*a == &24, '7613: &*a == &24'); + vrfy(&*a == &*b, '7614: &*a == &*b'); + vrfy(&*a != &*c, '7615: &*a != &*c'); + + a = b = "abc", c = strcat("a", "bc"); + print '7616: a = b = "abc", c = strcat("a", "bc");'; + vrfy(isptr(&*a) == 3, '7617: isptr(&*a) == 3'); + vrfy(&*a == &"abc", '7618: &*a == &"abc"'); + vrfy(&*a == &*b, '7619: &*a == &*b'); + vrfy(&*a != &*c, '7620: &*a != &*c'); + a = c; + print '7621: a = c;'; + vrfy(&*a == &*c, '7622: &*a == &*c'); + + /* Verifying null-ness of freed numbers */ + + c = 4!, p = &*c, free(c); + print '7623: c = 4!, p = &*c, free(c)'; + vrfy(isnull(*p), '7624: isnull(*p)'); + + print '7625: Ending test_ptr'; +} +print '181: parsed test_ptr()'; + + +/* + * test_newstring - test new string operations + */ +define test_newstring() +{ + local A, B, C, D, S, p; + + print '7700: Beginning test_newstring'; + + A = "abcdef", B = "xyz"; + print '7701: A = "abcdef", B = "xyz";'; + vrfy(A + B == "abcdefxyz", '7702: A + B == "abcdefxyz"'); + vrfy(-A == "fedcba", '7703: -A == "fedcba"'); + vrfy(A - B == "abcdefzyx", '7704: A - B == "abcdefzyx"'); + vrfy(2 * B == "xyzxyz", '7705: 2 * B == "xyzxyz"'); + vrfy(-2 * B == "zyxzyx", '7706: -2 * B == "zyxzyx"'); + vrfy(B * 3 == "xyzxyzxyz", '7707: B * 3 == "xyzxyzxyz"'); + vrfy(2.5 * B == "xyzxyzx", '7708: 2.5 * B == "xyzxyzx"'); + vrfy(0 * B == "", '7709: 0 * B == ""'); + vrfy(3 * "12" == "121212", '7710: 2 * "12" == "121212"'); + vrfy(A/2 == "abc", '7711: A/2 == "abc"'); + vrfy(A | B == "y\173\173def", '7712: A | B == "y\\173\\173def"'); + vrfy(A & B == "``b", '7713: A & B == "``b"'); + vrfy(A \ B == "\1\2\1def", '7714: A \\ B == "\\1\\2\\1def"'); + vrfy(A ~ B == "\31\e\31def", '7715: A ~ B == "\\31\\e\\31def"'); + vrfy(~B == "\207\206\205", '7716: ~B == "\\207\\206\\205"'); + C = "abcdef"; + print '7717: C = "abcdef";'; + vrfy(&*A == &*C, '7718: &*A == &*C'); + D = "abc\0ef"; + print '7719: D = "abc\0ef;"'; + vrfy(size(D) == 6, '7720: size(D) == 6'); + vrfy(strlen(D) == 3, '7721: strlen(D) == 3'); + vrfy(strcat(D,B) == "abcxyz", '7722: strcat(D,B) == "abcxyz"'); + + vrfy(bit(A,0) == 1, '7723: bit(A,0) == 1'); + vrfy(!bit(A,12), '7724: !bit(A,12)'); + vrfy(bit(A,13), '7725: bit(A,13)'); + vrfy(lowbit(A) == 0, '7726: lowbit(A) == 0'); + vrfy(highbit(A) == 46, '7727: highbit(A) == 46'); + vrfy(#A == 21, '7728: #A == 21'); + + vrfy(A[2] == "c", '7729: A[2] == "c"'); + vrfy(char(A[2]) == "c", '7730: char(A[2]) == "c"'); + vrfy(A[2] == 99, '7731: A[2] == 99'); + vrfy(ord(A[2]) == 99, '7731: ord(A[2]) == 99'); + vrfy(A[2] == A[0] + 2, '7732: A[2] == A[0] + 2'); + vrfy(3 * A[2] == 297, '7733: 3 * A[2] == 297'); + vrfy(3 * char(A[2]) == "ccc", '7734: 3 * char(A[2]) == "ccc"'); + + vrfy(head(A,3) == "abc", '7735: head(A,3) == "abc"'); + vrfy(head(A,-3) == "cba", '7736: head(A,-3) == "cba"'); + vrfy(tail(A,3) == "def", '7737: tail(A,3) == "def"'); + vrfy(tail(A,-3) == "fed", '7738: tail(A,-3) == "fed"'); + vrfy(segment(A,2) == "c", '7739: segment(A,2) == "c"'); + vrfy(segment(A,2,4) == "cde", '7740: segment(A,2,4) == "cde"'); + vrfy(segment(A,4,2) == "edc", '7741: segment(A,4,2) == "edc"'); + + vrfy(search(A, "c") == 2, '7742: search(A, "c") == 2'); + vrfy(search(A, "x") == null(), '7743: search(A, "x") == null()'); + vrfy(search("abbcbc", "bc") == 2, + '7744: search("abbcbc", "bc") == 2'); + vrfy(search("abbcbc", "bc", 2) == 2, + '7745: search("abbcbc", "bc", 2) == 2'); + vrfy(search("abbcbc", "bc", 3) == 4, + '7746: search("abbcbc", "bc", 3) == 4'); + vrfy(search("abbcbc", "bc", -3) == 4, + '7747: search("abbcbc", "bc", -3) == 4'); + vrfy(search("abbcbc", "bc", -4) == 2, + '7748: search("abbcbc", "bc", -4) == 2'); + vrfy(search("abbcbc", "bc", , 3) == null(), + '7749: search("abbcbc", "bc", , 3) == null()'); + vrfy(search("abbcbc", "bc", , 4) == 2, + '7750: search("abbcbc", "bc", , 4) == 2'); + + vrfy(rsearch("abbcbc", "bc") == 4, + '7751: rsearch("abbcbc", "bc") == 4'); + + p = &A[0]; + print '7752: p = &A[0];'; + vrfy(-*p == -97, '7753: -*p == -97'); + vrfy(~*p == char(158), '7754: ~*p == char(158)'); + vrfy(/-#~*p == -1/5, '7755: /-#~*p == -1/5'); + + A[0] = "A"; + print '7756: A[0] = "A";'; + vrfy(A == "Abcdef", '7757: A == "Abcdef"'); + A[1] = 173; + print '7758: A[1] = 173;'; + vrfy(A == "A\255cdef", '7759: A == "A\\255cdef"'); + setbit(A, 18); + print '7760: setbit(A,10);'; + vrfy(A == "A\255gdef", '7761: A == "A\\255gdef"'); + setbit(A, 16, 0); + print '7762: setbit(A, 16, 0);'; + vrfy(A == "A\255fdef", '7763: A == "A\255fdef"'); + + print '7764: Ending test_newstring'; +} +print '182: parsed test_newstring()'; + + + +/* + * test_newcomb - test combinatoric and permutation functions + */ +define test_newcomb() +{ + print '7800: Beginning test_newcomb'; + vrfy(comb(2, 5) == 0, '7801: comb(2, 5) == 0'); + vrfy(comb(2, -2) == 0, '7802: comb(2, -2) == 0'); + vrfy(comb(1/2, 4) == -5/128, '7803: comb(1/2, 4) == -5/128'); + vrfy(comb(1/2, 5) == 7/256, '7804: comb(1/2, 5) == 7/256'); + + vrfy(perm(2, -1) == 1/3, '7805: perm(2, -1) == 1/3'); + vrfy(perm(2, -2) == 1/12, '7806: perm(2, -2) == 1/12'); + vrfy(perm(2, -3) == 1/60, '7807: perm(2, -3) == 1/60'); + vrfy(perm(1/2, 4) == -15/16, '7808: perm(1/2, 4) == -15/16'); + vrfy(perm(1/2, 5) == 105/32, '7809: perm(1/2, 5) == 105/32'); + vrfy(perm(1/2,-1) == 2/3, '7810: perm(1/2, -1) == 2/3'); + vrfy(perm(1/2,-2) == 4/15, '7811: perm(1/2, -2) == 4/15'); + + print '7812: Ending test_newcomb'; +} +print '183: parsed test_newcomb()'; + + +/* + * The following functions f, g should be equal when b-a is an + * integer, and n is any integer other than -1. + */ +define f7900(a,b,n) +{ + local s, x; + + if (a > b) + return -f7900(b, a, n); + for (s = 0, x = a; x < b; x++) + s += perm(x, n); + return s; +} +print '184: define f7900(a,b,n) {... }'; +/**/ +define g7900(a,b,n) = (perm(b, n + 1) - perm(a, n + 1))/(n + 1); +print '185: define g7900(a,b,n) = ...'; + + +/* + * test_bigcomb - test big combinations and permutations + */ +define test_bigcomb() +{ + local a, b, n, i, v1, v2; + + print '7900: Starting test_bigcomb()'; + a = 1234/4321; + print '7901: a = 1234/4321'; + b = 3456/6543; + print '7902: b = 3456/6543'; + n = 47; + print '7903: n = 47'; + v1 = perm(a + b, n); + print '7904: v1 = perm(a + b, n)'; + v2 = 0; + print '7905: v2 = 0'; + for (i = 0; i <= n; i++) + v2 += comb(n, i) * perm(a, i) * perm(b, n - i); + print '7906: for (i=0;i<=n;i++) v2 += comb(n,i)*perm(a,i)*perm(b,n-i)'; + vrfy(v1 == v2, '7910: v1 == v2'); + + vrfy(f7900(-10,10,5) == g7900(-10,10,5), + '7911: f7900(-10,10,5) == g7900(10,10,5)'); + vrfy(f7900(5,15,-4) == g7900(5,15,-4), + '7912: f7900(5,15,-4) == g7900(5,15,-4)'); + vrfy(f7900(-7/4,33/4,-2) == g7900(-7/4,33/4,-2), + '7913: f7900(-7/4,33/4,-2) == g7900(-7/4,33/4,-2)'); + + print '7914: Ending test_bigcomb()'; +} +print '186: parsed test_bigcomb()'; + + +/* + * natnumset - test natural numbers not exceeding a fixed bound + */ +read -once natnumset; +print '187: read -once natnumset;'; +/**/ +define test_natnumset() +{ + local A, B, C, D, P, P1, L1, L2; + + print '8000: Starting test_natnumset()'; + + A = set(17, 2, 0, 24, 2); + print '8101: A = set(17, 2, 0, 24, 2);'; + B = set(41, 17, 11, 2, 19, 17); + print '8102: B = set(41, 17, 11, 2, 19, 17);'; + vrfy(A | B == set(0,2,11,17,19,24,41), + '8103: A | B == set(0,2,11,17,19,24,41)'); + vrfy(A & B == set(2,17), '8104: A & B == set(2,17)'); + vrfy(A \ B == set(0,24), '8105: A \\ B == set(0, 24)'); + vrfy(B \ A == set(11,19,41), '8106: B \\ A == set(11,19,41)'); + vrfy(A ~ B == set(0,11,19,24,41), + '8107: A ~ B == set(0,11,19,24,41)'); + vrfy(#A == 4, '8108: #A == 4'); + vrfy(#~A == 97, '8109: #~A == 97'); + vrfy(A + 5 == set(5,7,22,29), '8110: A + 5 == set(5,7,22,29)'); + vrfy(A - 5 == set(12,19), '8111: A - 5 == set(12,19)'); + vrfy(30 - A == set(6,13,28,30), '8112: 30 - A == set(6,13,28,30)'); + vrfy(2 * A == set(0,4,34,48), '8113: 2 * A == set(0,4,34,48)'); + vrfy(10 * A == set(0,20), '8114: 10 * A == set(0,20)'); + vrfy(A + A == set(0,2,4,17,19,24,26,34,41,48), + '8115: A + A == set(0,2,4,17,19,24,26,34,41,48)'); + vrfy(A - A == set(0,2,7,15,17,22,24), + '8116: A - A == set(0,2,7,15,17,22,24)'); + vrfy(set(2,3,5,7)^2 == set(4,9,25,49), + '8117: set(2,3,5,7)^2 == set(4,9,25,49)'); + vrfy(interval(8,12) == set(8,9,10,11,12), + '8118: interval(8,12) == set(8,9,10,11,12)'); + vrfy(min(A) == 0, '8119: min(A) == 0'); + vrfy(max(A) == 24, '8120: max(A) == 24'); + P = primes(); + print '8121: P = primes();'; + vrfy(#P == 25, '8122: #P == 25'); + vrfy(+P == 1060, '8123: +P == 1060'); + vrfy(isin(P,31), '8124: isin(P,31)'); + vrfy(!isin(P,51), '8125: !isin(P,51)'); + P1 = primes(20,40); + print '8126: P1 = primes(20,40)'; + vrfy(P1 == set(23,29,31,37), '8127: P1 == set(23,29,31,37)'); + vrfy(P1 < P, '8128: P1 < P'); + vrfy(P1 & (set(3) % 4) == set(23,31), + '8129: P1 & (set(3) % 4) == set(23,31)'); + + L1 = list(3,2,1); + print '8130: L1 = list(3,2,1);'; + C = set(2,3,5,7); + print '8131: C = set(2,3,5,7);'; + vrfy(polyvals(L1, C) == set(11,18,38,66), + '8132: polyvals(L1, C) == set(11,18,38,66)'); + L2 = list(0,list(0,1),1); + print '8133: L2 = list(0,list(0,1),1);'; + D = set(4,6); + print '8134: D = set(4,6);'; + + vrfy(polyvals2(L2,C,D) == set(12,16,21,27,45,55,77,91), + '8135: polyvals(L2,C,D) == set(12,16,21,27,45,55,77,91)'); + + print '8136: Ending test_natnumset()'; +} +print '188: parsed test_natnumset()'; + + +/* + * test_somenew - test some new features + */ +define test_somenew() +{ + print '8200: Starting test_somenew()'; + + vrfy(char(-1) == char(255), '8201: char(-1) == char(255)'); + vrfy(char(258) == char(2), '8202: char(258) == char(2)'); + + vrfy(size(char(0)) == 1, '8203: size(char(0)) == 1'); + vrfy(strlen(char(0)) == 0, '8204: strlen(char(0)) == 0'); + vrfy(char(0) != "", '8205: char(0) != ""'); + vrfy(strcmp(char(0),"") == 0, '8206: strcmp(char(0),"") == 0'); + + vrfy(str("abc") == "abc", '8207: str("abc") == "abc"'); + + vrfy(2^-3^2 == 1/512, '8208: 2^-3^2 == 1/512'); + vrfy(/2 == .5, '8209: /2 == .5'); + vrfy(/-2 == -.5, '8210: /-2 == -.5'); + vrfy(1+/2 == 1.5, '8211: 1+/2 == 1.5'); + + ecnt += 6; + print '8212: ecnt += 6'; + vrfy(0^-2 == 1/0, '8213: 0^-2 == 1/0'); + vrfy(inverse(0) == 1/0, '8214: inverse(0) == 1/0'); + vrfy(1/(1/0) == 0, '8215: 1/(1/0) == 0'); + vrfy(inverse(1/0) == 0, '8216: inverse(1/0) == 0'); + + print '8217: Ending test_somenew()'; +} +print '189: parsed test_somenew()'; + + +/* + * Reserved for top level test use + */ +print '200: Reserved for top level test use'; /* @@ -3573,16 +7117,16 @@ print '100: reserved for future use'; */ define count_errors() { - if (err == 0) { + if (prob == 0) { print "9998: passed all tests /\\../\\"; } else { - print "****", err, "error(s) found \\/++\\/"; + print "****", prob, "error(s) found \\/++\\/"; } } -print '198: parsed count_errors()'; +print '298: parsed count_errors()'; -print '199: Ending main part of regression test suite read'; +print '299: Ending main part of regression test suite read'; print; @@ -3608,20 +7152,22 @@ return test_rand(); print; return test_mode(); print; + print '1700: Beginning read test'; value = 0; -vrfy(value == 0, '1701: value == 0'); +vrfy(value == 0, '1701: value == 0'); read "test1700"; -vrfy(value == 1, '1702: value == 1'); +vrfy(value == 1, '1702: value == 1'); read -once "test1700"; -vrfy(value == 1, '1703: value == 1'); +vrfy(value == 1, '1703: value == 1'); read "test1700.cal"; -vrfy(value == 2, '1704: value == 2'); +vrfy(value == 2, '1704: value == 2'); read -once "test1700.cal"; -vrfy(value == 2, '1705: value == 2'); +vrfy(value == 2, '1705: value == 2'); read "test1700.cal"; -vrfy(value == 3, '1706: value == 3'); +vrfy(value == 3, '1706: value == 3'); print '1707: Ending read test'; + print; return test_obj(); print; @@ -3674,6 +7220,140 @@ print; return test_charset(); print; return test_strprintf(); +print; +return test_listsearch(); +print; +return test_filesearch(); +print; +return test_newdecl(); +print; +return test_globstat(); +print; +return test_random(); +print; +return test_newsyn(); + +vrfy(s5500 == 78, '5548: s5500 == 78'); + +print; +return test_commaeq(); +print; +return test_size(); +print; + +return test_assign(5800, 1); +define xy5800_assign(a,b) { }; +print '5812: define xy5800_assign(a,b) { }'; +return test_assign(5820, 0); +undefine xy5800_assign; +print '5832: undefine xy5800_assign'; +return test_assign(5840, 1); +define xy5800_assign(a, b) = a.y = b; +print '5852: define xy5800_assign(a, b) = a.y = b'; +X5800 = 9; +print '5853: X5800 = 9'; +vrfy(X5800 == (obj xy5800 = {3,9}), + '5854: X5800 == (obj xy5800 = {3,9})'); +asserr = newerror("Incompatible types for ="); +print '5855: asserr = newerror("Incompatible types for =")'; +define xy5800_assign(a, b) { + if (istype(b, obj xy5800)) { + a.x = b.x; + a.y = b.y; + } else if (isreal(b)) { + a.x = b; + a.y = 0; + } else { + error(asserr); + } +} +print '5856: xy5800_assign(a, b) { ... };'; +ecnt += 2; +print '5857: ecnt += 2'; +X5800 = 2 + 3i; +print '5858: X5800 = 2 + 3i'; +vrfy(X5800 == (obj xy5800 = {3,9}), + '5859: X5800 == (obj xy5800 = {3,9})'); +vrfy(errno() > 0, '5860: errno() > 0'); +vrfy(strerror() == "Incompatible types for =", + '5861: strerror() == "Incompatible types for ="'); +X5800 = 2; +print '5862: X5800 = 2'; +vrfy(X5800 == (obj xy5800 = {2,0}), + '5863: X5800 == (obj xy5800 = {2,0})'); +X5800 = obj xy5800 = {1,2}; +print '5864: X5800 = obj xy5800 = {1,2}'; +vrfy(X5800 == (obj xy5800 = {1,2}), + '5865: X5800 == (obj xy5800 = {1,2})'); +print '5899: End of 5800 sequence'; + +print; +return test_is(); +print; +return test_blk(); +print; +return test_blkcpy(); +print; +return test_name(); +print; +return test_blkprintf(); +print; +return test_sha(); +print; +return test_sha1(); +print; +return test_md5(); +print; + +print '7400: Beginning test_savedot'; +print '7401: saveval(1);'; +saveval(1); +print '7402: a7400 = 2;'; +a7400 = 2; +vrfy(. == 2, '7403: . == 2;'); +vrfy((. += 3, . == 5), '7404: (. += 3, . == 5)'); +vrfy(. == 5, '7405: . == 5;'); +print '7406: a7400 = 5; b7400 = 6;'; +a7400 = 5; b7400 = 6; +vrfy(. == 6, '7407: . == 6'); +print '7408: a7400 = 7; b7400 = 8; null()'; +a7400 = 7; b7400 = 8; null(); +vrfy(. == 6, '7409: . == 6'); +print '7410: saveval(0);'; +saveval(0); +print '7411: a7400 = 9;'; +a7400 = 9; +vrfy(. == 6, '7412: . == 6'); +print '7413: a7400 = 2; saveval(1); b7400 = 3; saveval(0); c7400 = 4;'; +a7400 = 2; saveval(1); b7400 = 3; saveval(0); c7400 = 4; +vrfy(. == 3, '7414: . == 3'); +print '7415: free(.);'; +free(.); +vrfy(isnull(.), '7416: isnull(.)'); +print '7417: a7400 = 4;'; +a7400 = 4; +vrfy(isnull(.), '7418: isnull(.)'); +print '7419: saveval(1);'; +saveval(1); + +print '7420: obj pair7400 {one,two} = {1,2};'; +obj pair7400 {one,two} = {1,2}; +vrfy(. .one == 1, '7421: . .one == 1'); +print '7422: Ending test_savedot'; + +print; +return test_ptr(); +print; +return test_newstring(); +print; +return test_newcomb(); +print; +return test_bigcomb(); +print; +return test_natnumset(); +print; +return test_somenew(); + print; return count_errors(); print '9999: Ending regression tests'; diff --git a/lib/seedrandom.cal b/lib/seedrandom.cal index 88affec..6ad63f5 100644 --- a/lib/seedrandom.cal +++ b/lib/seedrandom.cal @@ -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<= 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"; +} diff --git a/lib/solve.cal b/lib/solve.cal index 7432c17..f6469bf 100644 --- a/lib/solve.cal +++ b/lib/solve.cal @@ -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"; } diff --git a/lib/sumsq.cal b/lib/sumsq.cal index 92754f6..ffc1374 100644 --- a/lib/sumsq.cal +++ b/lib/sumsq.cal @@ -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"; } diff --git a/lib/surd.cal b/lib/surd.cal index d1e5056..6d55b82 100644 --- a/lib/surd.cal +++ b/lib/surd.cal @@ -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"; diff --git a/lib/test1700.cal b/lib/test1700.cal index 081d8b3..47f9324 100644 --- a/lib/test1700.cal +++ b/lib/test1700.cal @@ -10,3 +10,7 @@ */ ++value; + +if (config("lib_debug") >= 0) { + /* nothing to do */ +} diff --git a/lib/test2300.cal b/lib/test2300.cal index d288339..a1a7956 100644 --- a/lib/test2300.cal +++ b/lib/test2300.cal @@ -95,3 +95,7 @@ define ckmat() /* args match the matrix in the object */ return 1; } + +if (config("lib_debug") >= 0) { + /* nothing to do */ +} diff --git a/lib/test2600.cal b/lib/test2600.cal index f3abc2e..ef54564 100644 --- a/lib/test2600.cal +++ b/lib/test2600.cal @@ -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"; diff --git a/lib/test2700.cal b/lib/test2700.cal index 18aa2b4..42b8be2 100644 --- a/lib/test2700.cal +++ b/lib/test2700.cal @@ -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"; diff --git a/lib/test3100.cal b/lib/test3100.cal index 7068fc8..45bad43 100644 --- a/lib/test3100.cal +++ b/lib/test3100.cal @@ -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"; diff --git a/lib/test3300.cal b/lib/test3300.cal index 9078a27..ef74f7c 100644 --- a/lib/test3300.cal +++ b/lib/test3300.cal @@ -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"; diff --git a/lib/test3400.cal b/lib/test3400.cal index 233cf63..0005059 100644 --- a/lib/test3400.cal +++ b/lib/test3400.cal @@ -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"; diff --git a/lib/test3500.cal b/lib/test3500.cal index 65dcbcc..7eca70b 100644 --- a/lib/test3500.cal +++ b/lib/test3500.cal @@ -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"; diff --git a/lib/test4000.cal b/lib/test4000.cal index 6bc452f..f2ae7c6 100644 --- a/lib/test4000.cal +++ b/lib/test4000.cal @@ -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"; diff --git a/lib/test4100.cal b/lib/test4100.cal index a855ccb..3ccacc4 100644 --- a/lib/test4100.cal +++ b/lib/test4100.cal @@ -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"; diff --git a/lib/test4600.cal b/lib/test4600.cal index 1af31c9..40b8af8 100644 --- a/lib/test4600.cal +++ b/lib/test4600.cal @@ -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"; diff --git a/lib/test5100.cal b/lib/test5100.cal new file mode 100644 index 0000000..140cb68 --- /dev/null +++ b/lib/test5100.cal @@ -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"; +} diff --git a/lib/test5200.cal b/lib/test5200.cal new file mode 100644 index 0000000..4e2d2cc --- /dev/null +++ b/lib/test5200.cal @@ -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"; +} diff --git a/lib/unitfrac.cal b/lib/unitfrac.cal index f98d2a5..dad7f17 100644 --- a/lib/unitfrac.cal +++ b/lib/unitfrac.cal @@ -29,7 +29,6 @@ define unitfrac(x) } -global lib_debug; -if (lib_debug >= 0) { +if (config("lib_debug") >= 0) { print "unitfrac(x) defined"; } diff --git a/lib/varargs.cal b/lib/varargs.cal index 52d27e4..b066c68 100644 --- a/lib/varargs.cal +++ b/lib/varargs.cal @@ -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"; } diff --git a/lib/xx_print.cal b/lib/xx_print.cal new file mode 100644 index 0000000..e660e5f --- /dev/null +++ b/lib/xx_print.cal @@ -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 + */ +/* + * 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"; +} diff --git a/lib_calc.c b/lib_calc.c index d5a5ae0..80d4e71 100644 --- a/lib_calc.c +++ b/lib_calc.c @@ -1,5 +1,5 @@ /* - * Copyright (c) 1996 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, @@ -22,15 +22,108 @@ * chongo was here /\../\ */ +#include +#include +#include #include "calc.h" #include "zmath.h" +#include "zrandom.h" +#include "conf.h" +#include "token.h" +#include "symbol.h" +#include "func.h" -static int init_done = 0; /* 1 => we already initialized */ +#include "have_unistd.h" +#if defined(HAVE_UNISTD_H) +#include +#endif + +#include "have_stdlib.h" +#if defined(HAVE_STDLIB_H) +#include +#endif + +/* + * in case we do not have certain .h files + */ +#if !defined(HAVE_STDLIB_H) && !defined(HAVE_UNISTD_H) +#if !defined(HAVE_UID_T) && !defined(_UID_T) +typedef unsigned short uid_t; +#endif +extern char *getenv(); +extern uid_t geteuid(); +#endif /* - * libcalc_call_me_first - users of libcalc.a must call this function + * Common definitions + */ +int new_std = FALSE; /* TRUE (-n) => use newstd configuration */ +int abortlevel; /* current level of aborts */ +BOOL inputwait; /* TRUE if in a terminal input wait */ +jmp_buf jmpbuf; /* for errors */ +int start_done = FALSE; /* TRUE => start up processing finished */ +char *program = "calc"; /* our name */ +char cmdbuf[MAXCMD+1]; /* command line expression */ + + +/* + * global permissions + */ +int allow_read = TRUE; /* FALSE => may not open any files for reading */ +int allow_write = TRUE; /* FALSE => may not open any files for writing */ +int allow_exec = TRUE; /* FALSE => may not execute any commands */ + + +/* + * global flags + */ +int p_flag = FALSE; /* TRUE => pipe mode */ +int q_flag = FALSE; /* TRUE => don't execute rc files */ +int u_flag = FALSE; /* TRUE => unbuffer stdin and stdout */ + + +/* + * global values + */ +char *calcpath; /* $CALCPATH or default */ +char *calcrc; /* $CALCRC or default */ +char *calcbindings; /* $CALCBINDINGS or default */ +char *home; /* $HOME or default */ +char *pager; /* $PAGER or default */ +char *shell; /* $SHELL or default */ +int stdin_tty = FALSE; /* TRUE if stdin is a tty */ +int post_init = FALSE; /* TRUE setjmp for math_error is readready */ + +int no_env = FALSE; /* TRUE (-e) => ignore env vars on startup */ +int ign_errmax = FALSE; /* TRUE (-i) => ignore when errcount exceeds errmax */ + +NUMBER *epsilon_default; /* default allowed error for float calcs */ + + +/* + * initialization functions + */ +extern void math_setfp(FILE *fp); +extern void file_init(void); +extern void zio_init(void); +extern void initialize(void); +extern void reinitialize(void); + + +/* + * static declarations + */ +static int init_done = 0; /* 1 => we already initialized */ +static void initenv(void); + + +/* + * libcalc_call_me_first - users of libcalc.a must call this function first! + * + * Anything that uses libcalc.a MUST call this function first before doing + * any other libcalc.a processing. */ void libcalc_call_me_first(void) @@ -42,23 +135,29 @@ libcalc_call_me_first(void) return; } - /* - * setup configuration values + /* + * setup configuration values */ oldstd.epsilon = &_qonesqbase_; /* magic to fake early str2q() */ conf = config_copy(&oldstd); /* more magic to fake early str2q() */ + conf->tab_ok = FALSE; oldstd.epsilon = str2q(EPSILON_DEFAULT); newstd.epsilon = str2q(NEW_EPSILON_DEFAULT); /* * make oldstd our default config */ - conf = config_copy(&oldstd); + config_free(conf); + if (new_std) { + conf = config_copy(&newstd); + } else { + conf = config_copy(&oldstd); + } /* - * ZVALUE io initialization + * initialize */ - zio_init(); + initialize(); /* * ready to rock & roll .. @@ -66,3 +165,187 @@ libcalc_call_me_first(void) init_done = 1; return; } + + +/* + * initialize - perform the required calc initializations + */ +void +initialize(void) +{ + /* + * ZVALUE io initialization + */ + zio_init(); + + /* + * process the environment + */ + initenv(); + + /* + * initialize I/O + */ + file_init(); + + /* + * initialize file I/O + */ + resetinput(); + + /* + * initialize calc internal data structures + */ + inittokens(); + initglobals(); + initfunctions(); + initstack(); + + /* + * initialize calc math + */ + math_cleardiversions(); + math_setfp(stdout); + math_setmode(MODE_INITIAL); + math_setdigits((long)DISPLAY_DEFAULT); + conf->maxprint = MAXPRINT_DEFAULT; +} + + +/* + * reinitialize - reinitialize after a longjmp + */ +void +reinitialize(void) +{ + /* + * process commands (from stdin, not the command line) + */ + abortlevel = 0; + _math_abort_ = FALSE; + inputwait = FALSE; + math_cleardiversions(); + math_setfp(stdout); + resetscopes(); + resetinput(); + if (q_flag == FALSE && allow_read) { + q_flag = TRUE; + runrcfiles(); + } + (void) openterminal(); +} + + +/* + * cvmalloc_error - for users of the SGI Workshop Debugger + * + * usage: + * message - error message passed along via libmalloc_cv.a + */ +void +cvmalloc_error(char *message) +{ + /* firewall */ + if (message == NULL) { + fprintf(stderr, "cvmalloc_error message is NULL\n"); + return; + } + + /* print message and return */ + fprintf(stderr, "cvmalloc_error: %s\n", message); + return; +} + + +/* + * initenv - obtain $CALCPATH, $CALCRC, $CALCBINDINGS, $HOME, $PAGER + * and $SHELL values + * + * If $CALCPATH, $CALCRC, $CALCBINDINGS, $PAGER or $SHELL do not exist, + * use the default values. If $PAGER or $SHELL is an empty string, also + * use a default value. If $HOME does not exist, or is empty, use the home + * directory information from the password file. + */ +static void +initenv(void) +{ + struct passwd *ent; /* our password entry */ + + /* determine the $CALCPATH value */ + calcpath = (no_env ? NULL : getenv(CALCPATH)); + if (calcpath == NULL) + calcpath = DEFAULTCALCPATH; + + /* determine the $CALCRC value */ + calcrc = (no_env ? NULL : getenv(CALCRC)); + if (calcrc == NULL) { + calcrc = DEFAULTCALCRC; + } + + /* determine the $CALCBINDINGS value */ + calcbindings = (no_env ? NULL : getenv(CALCBINDINGS)); + if (calcbindings == NULL) { + calcbindings = DEFAULTCALCBINDINGS; + } + + /* determine the $HOME value */ + home = (no_env ? NULL : getenv(HOME)); + if (home == NULL || home[0] == '\0') { + ent = (struct passwd *)getpwuid(geteuid()); + if (ent == NULL) { + /* just assume . is home if all else fails */ + home = "."; + } + home = (char *)malloc(strlen(ent->pw_dir)+1); + strcpy(home, ent->pw_dir); + } + + /* determine the $PAGER value */ + pager = (no_env ? NULL : getenv(PAGER)); + if (pager == NULL || *pager == '\0') { + pager = DEFAULTCALCPAGER; + } + + /* determine the $SHELL value */ + shell = (no_env ? NULL : getenv(SHELL)); + if (shell == NULL) + shell = DEFAULTSHELL; +} + + +/* + * libcalc_call_me_last - users of libcalc.a can call this function when done + * + * Anything that uses libcalc.a can call this function after they are + * completely finished with libcalc.a processing. The only effect of + * this funcion is to free storage that might otherwise go unused. + * + * NOTE: If, for any reason, you need to do more libcalc.a processing, + * then you will need to call libcalc_call_me_first() again. + */ +void +libcalc_call_me_last(void) +{ + /* + * firewall + */ + if (init_done == 0) { + return; + } + + /* + * free the configuration + */ + config_free(conf); + + /* + * free Blum generator state + */ + random_libcalc_cleanup(); + + /* + * all done + */ + init_done = 0; + return; +} diff --git a/lib_util.c b/lib_util.c new file mode 100644 index 0000000..10e2706 --- /dev/null +++ b/lib_util.c @@ -0,0 +1,367 @@ +/* + * lib_util - calc library utility routines + * + * These routines are here to support users of libcalc.a. These routines + * are not directly used by calc itself, however. + */ + +/* + * 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, + * provided that the above copyright, this permission notice and text + * this comment, 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. + * + * chongo was here /\../\ + */ + + +#include "zmath.h" +#include "lib_util.h" + + +/* + * lowhex2bin - quick low order ASCII hex to binary conversion + * + * We just use mod 16 for non-hex ASCII chars. We use just mod 128 + * for non-ASCII to ASCII conversion. + * + * | 00 nul | 01 soh | 02 stx | 03 etx | 04 eot | 05 enq | 06 ack | 07 bel | + * | 08 bs | 09 ht | 0a nl | 0b vt | 0c np | 0d cr | 0e so | 0f si | + * | 10 dle | 11 dc1 | 12 dc2 | 13 dc3 | 14 dc4 | 15 nak | 16 syn | 17 etb | + * | 18 can | 19 em | 1a sub | 1b esc | 1c fs | 1d gs | 1e rs | 1f us | + * | 20 sp | 21 ! | 22 " | 23 # | 24 $ | 25 % | 26 & | 27 ' | + * | 28 ( | 29 ) | 2a * | 2b + | 2c , | 2d - | 2e . | 2f / | + * | 30 0 | 31 1 | 32 2 | 33 3 | 34 4 | 35 5 | 36 6 | 37 7 | + * | 38 8 | 39 9 | 3a : | 3b ; | 3c < | 3d = | 3e > | 3f ? | + * | 40 @ | 41 A | 42 B | 43 C | 44 D | 45 E | 46 F | 47 G | + * | 48 H | 49 I | 4a J | 4b K | 4c L | 4d M | 4e N | 4f O | + * | 50 P | 51 Q | 52 R | 53 S | 54 T | 55 U | 56 V | 57 W | + * | 58 X | 59 Y | 5a Z | 5b [ | 5c \ | 5d ] | 5e ^ | 5f _ | + * | 60 ` | 61 a | 62 b | 63 c | 64 d | 65 e | 66 f | 67 g | + * | 68 h | 69 i | 6a j | 6b k | 6c l | 6d m | 6e n | 6f o | + * | 70 p | 71 q | 72 r | 73 s | 74 t | 75 u | 76 v | 77 w | + * | 78 x | 79 y | 7a z | 7b { | 7c | | 7d } | 7e ~ | 7f del | + */ +int lowhex2bin[256] = { + /* 0 1 2 3 4 5 6 7 8 9 a b c d e f */ + 0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf, /* 0 */ + 0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf, /* 1 */ + 0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf, /* 2 */ + 0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf, /* 3 */ + 0x0,0xa,0xb,0xc,0xd,0xe,0xf,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf, /* 4 */ + 0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf, /* 5 */ + 0x0,0xa,0xb,0xc,0xd,0xe,0xf,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf, /* 6 */ + 0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf, /* 7 */ + 0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf, /* 8 */ + 0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf, /* 9 */ + 0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf, /* a */ + 0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf, /* b */ + 0x0,0xa,0xb,0xc,0xd,0xe,0xf,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf, /* c */ + 0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf, /* d */ + 0x0,0xa,0xb,0xc,0xd,0xe,0xf,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf, /* e */ + 0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf /* f */ +}; + + +/* + * hex2bin - macro to convert two ASCII hex chars into binary value + * + * given: + * high - high order hex ASCII char + * low - low order hex ASCII char + * + * returns: + * numeric equivalent to 0x{high}{low} as an int + */ +#define hex2bin(high,low) \ + (lowhex2bin[(int)((char)(high))]<<4 | lowhex2bin[((int)(char)(low))]) + +/* + * lowbin2hex - quick low order binary conversion to ASCII hex + */ +char lowbin2hex[256] = { + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f', + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f', + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f', + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f', + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f', + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f', + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f', + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f', + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f', + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f', + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f', + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f', + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f', + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f', + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f', + '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f' +}; + + +/* + * convstr2z - convert a string into a ZVALUE + * + * NOTE: No attempt is make to deal with byte order. + * + * given: + * str string to convert + * + * returns: + * ZVALUE + */ +ZVALUE +convstr2z(char *str) +{ + HALF *v; /* storage for string as HALFs */ + ZVALUE ret; /* return value */ + int len; /* length in HALFs of our string rounded up */ + + /* + * firewall + */ + if (str == NULL || *str == '\0') { + /* NULL or empty strings return 0 */ + return _zero_; + } + + /* + * allocate HALF strorage + */ + len = (strlen(str)+sizeof(HALF)-1)/sizeof(HALF); + v = (HALF *)malloc(len * sizeof(HALF)); + if (v == NULL) { + math_error("convstr2z bad malloc"); + /*NOTREACHED*/ + } + v[len-1] = 0; /* deal with possible partial end of string HALF */ + + /* + * initialize HALF array with string value + */ + memcpy((void *)v, (void *)str, strlen(str)); + + /* + * setup the rest of the ZVALUE + */ + ret.v = v; + ret.len = len; + ret.sign = 0; + ztrim(&ret); + + /* + * return our result + */ + return ret; +} + + +/* + * convhex2z - convert hex string to ZVALUE + * + * usage: + * str hex ASCII string with optional leading 0x + * + * returns: + * ZVALUE + */ +ZVALUE +convhex2z(char *hex) +{ + HALF *v; /* storage for string as HALFs */ + HALF *hp; /* HALF pointer */ + char *sp; /* string pointer */ + ZVALUE ret; /* return value */ + int len; /* length in HALFs of our string rounded up */ + int slen; /* hex string length */ + int i; + + /* + * firewall + */ + if (hex == NULL || hex[0] == '\0') { + /* NULL or empty strings return 0 */ + return _zero_; + } + + /* + * skip leading 0X or 0x if needed + */ + if (hex[0] == '0' && (hex[1] == 'x' || hex[1] == 'X')) { + hex += 2; + } + if (hex[0] == '\0') { + /* just 0X or 0x returns 0 */ + return _zero_; + } + + /* + * allocate HALF strorage + */ + slen = strlen(hex); + len = ((slen*4)+BASEB-1)/BASEB; + v = (HALF *)malloc(len * sizeof(HALF)); + if (v == NULL) { + math_error("convhex2z bad malloc"); + /*NOTREACHED*/ + } + v[len-1] = 0; /* deal with possible partial end of string HALF */ + + /* + * deal with the upper partial HALF value + */ + hp = v+len-1; + sp = hex; + if ((slen % (BASEB/4)) != 0) { + + /* deal with a odd length hex string first */ + if (slen % 2 == 1) { + *hp = hex2bin('0', *sp++); + --slen; + + /* even length - top top hex char to process */ + } else { + *hp = 0; + } + /* slen is even now */ + + /* eat two hex chars at a time until the HALF is full */ + for (; (slen % (BASEB/4)) != 0; slen -= 2) { + *hp = ((*hp<<8) | hex2bin(*sp++, *sp++)); + } + + /* move on to the next HALF */ + --hp; + } + /* slen is now a multiple of BASEB/4 */ + + /* + * deal with full HALFs + */ + for (; slen > 0; slen -= (BASEB/4), --hp) { + + /* clear HALF */ + *hp = 0; + + /* eat two hex chars at a time until the HALF is full */ + for (i=0; i < (BASEB/4); i += 2) { + *hp = ((*hp<<8) | hex2bin(sp[i], sp[i+1])); + } + } + + /* + * setup the rest of the ZVALUE + */ + ret.v = v; + ret.len = len; + ret.sign = 0; + ztrim(&ret); + + /* + * return our result + */ + return ret; +} + + +/* + * convz2hex - convert ZVALUE to hex string + * + * We will ignore the sign of the value. + * + * usage: + * z ZVALUE + * + * returns: + * str hex ASCII malloced string (without a leading 0x) + */ +char * +convz2hex(ZVALUE z) +{ + char *ret; /* string to return */ + int slen; /* string length (not counting \0) */ + HALF half; /* HALF value to convert */ + int seen_nz; /* 0 => we have not seen a non-zero hex char (yet) */ + char *p; + int i; + int j; + + /* + * firewall + */ + if (z.v == NULL || ziszero(z)) { + /* malloc and return "0" */ + ret = (char *)malloc(sizeof("0")); + if (ret == NULL) { + math_error("convz2hex bad malloc of 0 value"); + /*NOTREACHED*/ + } + ret[0] = '0'; + ret[1] = '\0'; + return ret; + } + + /* + * malloc string storage + */ + slen = (z.len * BASEB/4); + ret = (char *)calloc(slen+1+1, sizeof(char)); + if (ret == NULL) { + math_error("convz2hex bad malloc of string"); + /*NOTREACHED*/ + } + + /* + * load in hex ASCII chars for each HALF + * + * We will not write leading '0' hex chars into the string. + */ + seen_nz = 0; + for (p=ret, i=z.len-1; i >= 0; --i) { + + /* + * load in ASCII hex by ASCII hex + */ + for (half=z.v[i], j=BASEB-4; j >= 0; j-=4) { + if (seen_nz) { + /* we saw a non-zero, just load the rest */ + *p++ = lowbin2hex[(half >> j) & 0xff]; + } else { + /* all zeros so far */ + *p = lowbin2hex[(half >> j) & 0xff]; + if (*p != '0') { + /* we found our first non-zero char */ + ++p; + seen_nz = 1; + } + } + } + } + if (seen_nz) { + *p = '\0'; + } else { + /* saw nothing but 0's, so just return 0 */ + *ret = '0'; + *(ret+1) = '\0'; + } + + /* + * return the new string + */ + return ret; +} diff --git a/lib_util.h b/lib_util.h new file mode 100644 index 0000000..3ade63b --- /dev/null +++ b/lib_util.h @@ -0,0 +1,43 @@ +/* + * lib_util - calc library utility routines + * + * These routines are here to support users of libcalc.a. These routines + * are not directly used by calc itself, however. + */ + +/* + * 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, + * provided that the above copyright, this permission notice and text + * this comment, 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. + * + * chongo was here /\../\ + */ + + +#if !defined(__LIB_UTIL_H__) +#define __LIB_UTIL_H__ + +/* external functions in lib_util.c */ +extern int lowhex2bin[256]; +extern char lowbin2hex[256]; +extern ZVALUE convstr2z(char*); +extern ZVALUE convhex2z(char *hex); +extern char *convz2hex(ZVALUE z); + +#endif /* __LIB_UTIL_H__ */ diff --git a/listfunc.c b/listfunc.c index 5c1f2ce..c38aabb 100644 --- a/listfunc.c +++ b/listfunc.c @@ -1,5 +1,5 @@ /* - * Copyright (c) 1993 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. * @@ -17,7 +17,6 @@ extern long irand(long s); static LISTELEM *elemalloc(void); -static LISTELEM *listelement(LIST *lp, long index); static void elemfree(LISTELEM *ep); static void removelistelement(LIST *lp, LISTELEM *ep); @@ -214,55 +213,113 @@ removelistelement(LIST *lp, LISTELEM *ep) } +LIST * +listsegment(LIST *lp, long n1, long n2) +{ + LIST *newlp; + LISTELEM *ep; + long i; + + newlp = listalloc(); + if ((n1 >= lp->l_count && n2 >= lp->l_count) || (n1 < 0 && n2 < 0)) + return newlp; + if (n1 >= lp->l_count) + n1 = lp->l_count - 1; + if (n2 >= lp->l_count) + n2 = lp->l_count - 1; + if (n1 < 0) + n1 = 0; + if (n2 < 0) + n2 = 0; + + ep = lp->l_first; + if (n1 <= n2) { + i = n2 - n1 + 1; + while(n1-- > 0 && ep) + ep = ep->e_next; + while(i-- > 0 && ep) { + insertlistlast(newlp, &ep->e_value); + ep = ep->e_next; + } + } + else { + i = n1 - n2 + 1; + while(n2-- > 0 && ep) + ep = ep->e_next; + while(i-- > 0 && ep) { + insertlistfirst(newlp, &ep->e_value); + ep = ep->e_next; + } + } + return newlp; +} + + /* * Search a list for the specified value starting at the specified index. - * Returns the element number (zero based) of the found value, or -1 if - * the value was not found. + * Returns 0 and stores the element number (zero based) if the value is + * found, otherwise returns 1. */ -long -listsearch(LIST *lp, VALUE *vp, long index) +int +listsearch(LIST *lp, VALUE *vp, long i, long j, ZVALUE *index) { register LISTELEM *ep; - if (index < 0) - index = 0; - ep = listelement(lp, index); - while (ep) { - if (!comparevalue(&ep->e_value, vp)) { + if (i < 0 || j > lp->l_count) { + math_error("This should not happen in call to listsearch"); + /*NOTREACHED*/ + } + + ep = listelement(lp, i); + while (i < j) { + if (!ep) { + math_error("This should not happen in listsearch"); + /*NOTREACHED*/ + } + if (acceptvalue(&ep->e_value, vp)) { lp->l_cache = ep; - lp->l_cacheindex = index; - return index; + lp->l_cacheindex = i; + utoz(i, index); + return 0; } ep = ep->e_next; - index++; + i++; } - return -1; + return 1; } /* * Search a list backwards for the specified value starting at the - * specified index. Returns the element number (zero based) of the - * found value, or -1 if the value was not found. + * specified index. Returns 0 and stores i if the value is found at + * index i; otherwise returns 1. */ -long -listrsearch(LIST *lp, VALUE *vp, long index) +int +listrsearch(LIST *lp, VALUE *vp, long i, long j, ZVALUE *index) { register LISTELEM *ep; - if (index >= lp->l_count) - index = lp->l_count - 1; - ep = listelement(lp, index); - while (ep) { - if (!comparevalue(&ep->e_value, vp)) { + if (i < 0 || j > lp->l_count) { + math_error("This should not happen in call to listrsearch"); + /*NOTREACHED*/ + } + + ep = listelement(lp, --j); + while (j >= i) { + if (!ep) { + math_error("This should not happen in listsearch"); + /*NOTREACHED*/ + } + if (acceptvalue(&ep->e_value, vp)) { lp->l_cache = ep; - lp->l_cacheindex = index; - return index; + lp->l_cacheindex = j; + utoz(j, index); + return 0; } ep = ep->e_prev; - index--; + j--; } - return -1; + return 1; } @@ -298,7 +355,7 @@ listfindex(LIST *lp, long index) * lp list to index into * index index of desired element */ -static LISTELEM * +LISTELEM * listelement(LIST *lp, long index) { register LISTELEM *ep; /* current list element */ @@ -726,6 +783,7 @@ elemalloc(void) ep->e_next = NULL; ep->e_prev = NULL; ep->e_value.v_type = V_NULL; + ep->e_value.v_subtype = V_NOSUBTYPE; return ep; } @@ -825,5 +883,3 @@ listprint(LIST *lp, long max_print) if (max_print < lp->l_count) math_str(" ...\n"); } - -/* END CODE */ diff --git a/longbits.c b/longbits.c index c6b3dc2..e655321 100644 --- a/longbits.c +++ b/longbits.c @@ -2,7 +2,13 @@ * longbits - Determine the number if bits in a char, short, int or long * * usage: - * longbits + * longbits [long_bit_size] + * + * long_bit_size force size of long (must be 32 or 64) + * + * NOTE: If long_bit_size arg is empty (0 chars long) or it begins with + * a whitespace character, it will be ignored and no forcing will + * be done. * * Not all (in fact very few) C pre-processors can do: * @@ -13,7 +19,7 @@ * This prog outputs several defines and typedefs: * * LONG_BITS - * Numbre of bits in a long. Not all (in fact very few) C + * Number of bits in a long. Not all (in fact very few) C * pre-processors can do #if sizeof(long) == 8. * * USB8 unsigned 8 bit value @@ -30,6 +36,10 @@ * and SB64 (signed 64 bit value) * undefined ==> do not use USB64 nor SB64 * + * BOOL_B84 + * If HAVE_B64 undefined ==> FALSE + * If HAVE_B64 defined ==> TRUE + * * USB64 unsigned 64 bit value if HAVE_B64 is defined * SB64 signed 64 bit value if HAVE_B64 is defined * @@ -73,12 +83,18 @@ */ #include +#include #include "have_unistd.h" #if defined(HAVE_UNISTD_H) #include #endif +#include "have_stdlib.h" +#ifdef HAVE_STDLIB_H +# include +#endif + #include "longlong.h" char *program; /* our name */ @@ -87,15 +103,37 @@ MAIN main(int argc, char **argv) { int exitcode = 0; /* how we will exit */ + int long_bits = 0; /* bit length of a long */ + int forced_size = 0; /* 1 => size of long was forced via arg */ char value; /* signed or maybe unsigned character */ /* * parse args */ program = argv[0]; - if (argc != 1) { - fprintf(stderr, "usage: %s\n", program); - exit(1); + switch (argc) { + case 1: + long_bits = sizeof(long)*8; + break; + case 2: + /* ignore empty or leading space args */ + if (argv[1][0] == '\0' || + (isascii(argv[1][0]) && isspace(argv[1][0]))) { + long_bits = sizeof(long)*8; + /* process the forced size arg */ + } else { + forced_size = 1; + long_bits = atoi(argv[1]); + if (long_bits != 32 && long_bits != 64) { + fprintf(stderr, + "usage: %s [32 or 64]\n", program); + exit(1); + } + } + break; + default: + fprintf(stderr, "usage: %s [32 or 64]\n", program); + exit(2); } /* @@ -103,9 +141,90 @@ main(int argc, char **argv) */ printf("#undef LONG_BITS\n"); printf("#define LONG_BITS %d\t\t%c%s%c\n", - (int)(sizeof(long)*8), '/', "* bit length of a long *", '/'); + long_bits, '/', "* bit length of a long *", '/'); putchar('\n'); + /* + * If we are forcing the size of a long, then do not check + * sizes of other values but instead assume that the user + * knows what they are doing. + */ + if (forced_size) { + + /* + * note that the size was forced + */ + printf("%c%s%c\n\n", '/', "* size of long was forced *", '/'); + + /* + * forced forming of USB8, SB8, USB16 and SB16 + */ + printf("typedef unsigned char USB8;\t%c%s%c\n", + '/', "* unsigned 8 bits *", '/'); + printf("typedef signed char SB8;\t%c%s%c\n\n", + '/', "* signed 8 bits *", '/'); + + printf("typedef unsigned short USB16;\t%c%s%c\n", + '/', "* unsigned 16 bits *", '/'); + printf("typedef short SB16;\t\t%c%s%c\n\n", + '/', "* signed 16 bits *", '/'); + + /* + * forced forming of USB32 and SB32 + */ + if (long_bits == 32) { + /* forced 32 bit long mode assumptions */ + printf("typedef unsigned long USB32;\t%c%s%c\n", + '/', "* unsigned 32 bits *", '/'); + printf("typedef long SB32;\t\t%c%s%c\n\n", + '/', "* signed 32 bits *", '/'); + } else { + /* forced 64 bit long mode assumptions */ + printf("typedef unsigned int USB32;\t%c%s%c\n", + '/', "* unsigned 32 bits *", '/'); + printf("typedef int SB32;\t\t%c%s%c\n\n", + '/', "* signed 32 bits *", '/'); + } + + /* + * forced forming of HAVE_B64, USB64, SB64, U(x) and L(x) + */ +#if defined(HAVE_LONGLONG) && LONGLONG_BITS == 64 + printf("#undef HAVE_B64\n"); + printf("#define HAVE_B64\t\t%c%s%c\n", + '/', "* have USB64 and SB64 types *", '/'); + printf("#define BOOL_B64 TRUE\n"); + printf("typedef unsigned long long USB64;\t%c%s%c\n", + '/', "* unsigned 64 bits *", '/'); + printf("typedef long long SB64;\t\t%c%s%c\n", + '/', "* signed 64 bits *", '/'); + putchar('\n'); + printf("%c%s%c\n", '/',"* how to form 64 bit constants *",'/'); +#if defined(__STDC__) && __STDC__ != 0 + printf("#define U(x) x ## ULL\n"); + printf("#define L(x) x ## LL\n"); +#else + printf("#define U(x) ((unsigned long long)x)\n"); + printf("#define L(x) ((long long)x)\n"); +#endif +#else + printf("#undef HAVE_B64\t\t\t%c%s%c\n", + '/', "* we have no USB64 and no SB64 types *", '/'); + printf("#define BOOL_B64 FALSE\n"); + putchar('\n'); + printf("%c%s%c\n", '/', "* no 64 bit constants *", '/'); + printf("#define U(x) no 33 to 64 bit constants %s\n", + "- do not use this macro!"); + printf("#define L(x) no 33 to 64 bit constants %s\n", + "- do not use this macro!"); +#endif + + /* + * all done + */ + exit(0); + } + /* * look for 8 bit values */ @@ -124,7 +243,7 @@ main(int argc, char **argv) printf("typedef signed char SB8;\t%c* XX%s%c -=*#*=-\n", '/', "X - should be 8 signed bits but is not *", '/'); } - exitcode = 2; + exitcode = 3; } else { printf("typedef unsigned char USB8;\t%c%s%c\n", '/', "* unsigned 8 bits *", '/'); @@ -150,7 +269,7 @@ main(int argc, char **argv) '/', "X - should be 16 unsigned bits but is not *", '/'); printf("typedef signed char SB16;\t%c* XX%s%c -=*#*=-\n", '/', "X - should be 16 signed bits but is not *", '/'); - exitcode = 3; + exitcode = 4; } else { printf("typedef unsigned short USB16;\t%c%s%c\n", '/', "* unsigned 16 bits *", '/'); @@ -179,7 +298,7 @@ main(int argc, char **argv) '/', "X - should be 32 unsigned bits but is not *", '/'); printf("typedef signed int SB32;\t%c* XX%s%c -=*#*=-\n", '/', "X - should be 32 signed bits but is not *", '/'); - exitcode = 4; + exitcode = 5; } putchar('\n'); @@ -190,6 +309,7 @@ main(int argc, char **argv) printf("#undef HAVE_B64\n"); printf("#define HAVE_B64\t\t%c%s%c\n", '/', "* have USB64 and SB64 types *", '/'); + printf("#define BOOL_B64 TRUE\n"); printf("typedef unsigned long USB64;\t%c%s%c\n", '/', "* unsigned 64 bits *", '/'); printf("typedef long SB64;\t\t%c%s%c\n", @@ -208,6 +328,7 @@ main(int argc, char **argv) printf("#undef HAVE_B64\n"); printf("#define HAVE_B64\t\t%c%s%c\n", '/', "* have USB64 and SB64 types *", '/'); + printf("#define BOOL_B64 TRUE\n"); printf("typedef unsigned long long USB64;\t%c%s%c\n", '/', "* unsigned 64 bits *", '/'); printf("typedef long long SB64;\t\t%c%s%c\n", @@ -224,6 +345,7 @@ main(int argc, char **argv) #else printf("#undef HAVE_B64\t\t\t%c%s%c\n", '/', "* we have no USB64 and no SB64 types *", '/'); + printf("#define BOOL_B64 FALSE\n"); putchar('\n'); printf("%c%s%c\n", '/', "* no 64 bit constants *", '/'); printf("#define U(x) no 33 to 64 bit constants %s\n", diff --git a/matfunc.c b/matfunc.c index ac70919..50aaf9e 100644 --- a/matfunc.c +++ b/matfunc.c @@ -9,6 +9,7 @@ #include "value.h" #include "zrand.h" +#include "calcerr.h" extern long irand(long s); @@ -397,21 +398,21 @@ MATRIX * matscale(MATRIX *m, long n) { register VALUE *val, *vres; - VALUE num; + VALUE temp; long index; MATRIX *res; /* resulting matrix */ if (n == 0) return matcopy(m); - num.v_type = V_NUM; - num.v_num = itoq(n); + temp.v_type = V_NUM; + temp.v_num = itoq(n); res = matalloc(m->m_size); *res = *m; val = m->m_table; vres = res->m_table; for (index = m->m_size; index > 0; index--) - scalevalue(val++, &num, vres++); - qfree(num.v_num); + scalevalue(val++, &temp, vres++); + qfree(temp.v_num); return res; } @@ -428,21 +429,21 @@ MATRIX * matshift(MATRIX *m, long n) { register VALUE *val, *vres; - VALUE num; + VALUE temp; long index; MATRIX *res; /* resulting matrix */ if (n == 0) return matcopy(m); - num.v_type = V_NUM; - num.v_num = itoq(n); + temp.v_type = V_NUM; + temp.v_num = itoq(n); res = matalloc(m->m_size); *res = *m; val = m->m_table; vres = res->m_table; for (index = m->m_size; index > 0; index--) - shiftvalue(val++, &num, FALSE, vres++); - qfree(num.v_num); + shiftvalue(val++, &temp, FALSE, vres++); + qfree(temp.v_num); return res; } @@ -531,6 +532,33 @@ matmodval(MATRIX *m, VALUE *vp, VALUE *v3) } +VALUE +mattrace(MATRIX *m) +{ + VALUE *vp; + VALUE sum; + VALUE tmp; + long i, j; + + if (m->m_dim != 2) + return error_value(E_MATTRACE2); + i = (m->m_max[0] - m->m_min[0] + 1); + j = (m->m_max[1] - m->m_min[1] + 1); + if (i != j) + return error_value(E_MATTRACE3); + vp = m->m_table; + copyvalue(vp, &sum); + j++; + while (--i > 0) { + vp += j; + addvalue(&sum, vp, &tmp); + freevalue(&sum); + sum = tmp; + } + return sum; +} + + /* * Transpose a 2-dimensional matrix */ @@ -755,49 +783,54 @@ matindex(MATRIX *mp, BOOL create, long dim, VALUE *indices) /* * Search a matrix for the specified value, starting with the specified index. - * Returns the index of the found value, or -1 if the value was not found. + * Returns 0 and stores index if value found; otherwise returns 1. */ -long -matsearch(MATRIX *m, VALUE *vp, long index) +int +matsearch(MATRIX *m, VALUE *vp, long i, long j, ZVALUE *index) { register VALUE *val; - if (index < 0) - index = 0; - val = &m->m_table[index]; - while (index < m->m_size) { - if (!comparevalue(vp, val)) - return index; - index++; - val++; + val = &m->m_table[i]; + if (i < 0 || j > m->m_size) { + math_error("This should not happen in call to matsearch"); + /*NOTREACHED*/ } - return -1; + while (i < j) { + if (acceptvalue(val++, vp)) { + utoz(i, index); + return 0; + } + i++; + } + return 1; } /* * Search a matrix backwards for the specified value, starting with the - * specified index. Returns the index of the found value, or -1 if the - * value was not found. + * specified index. Returns 0 and stores index if value found; otherwise + * returns 1. */ -long -matrsearch(MATRIX *m, VALUE *vp, long index) +int +matrsearch(MATRIX *m, VALUE *vp, long i, long j, ZVALUE *index) { register VALUE *val; - if (index >= m->m_size) - index = m->m_size - 1; - val = &m->m_table[index]; - while (index >= 0) { - if (!comparevalue(vp, val)) - return index; - index--; - val--; + if (i < 0 || j > m->m_size) { + math_error("This should not happen in call to matrsearch"); + /*NOTREACHED*/ } - return -1; + val = &m->m_table[--j]; + while (j >= i) { + if (acceptvalue(val--, vp)) { + utoz(j, index); + return 0; + } + j--; + } + return 1; } - /* * Fill all of the elements of a matrix with one of two specified values. * All entries are filled with the first specified value, except that if @@ -1030,6 +1063,7 @@ matdet(MATRIX *m) if (--i <= 0) { tmp1.v_type = V_NUM; tmp1.v_num = qlink(&_qzero_); + matfree(m); return tmp1; } val += n; @@ -1253,6 +1287,8 @@ MATRIX * matalloc(long size) { MATRIX *m; + long i; + VALUE *vp; m = (MATRIX *) malloc(matsize(size)); if (m == NULL) { @@ -1260,6 +1296,8 @@ matalloc(long size) /*NOTREACHED*/ } m->m_size = size; + for (i = size, vp = m->m_table; i > 0; i--, vp++) + vp->v_subtype = V_NOSUBTYPE; return m; } @@ -1275,20 +1313,14 @@ matfree(MATRIX *m) vp = m->m_table; i = m->m_size; - while (i-- > 0) { - if (vp->v_type == V_NUM) { - vp->v_type = V_NULL; - qfree(vp->v_num); - } else - freevalue(vp); - vp++; - } + while (i-- > 0) + freevalue(vp++); free(m); } /* - * Test whether a matrix has any nonzero values. + * Test whether a matrix has any "nonzero" values. * Returns TRUE if so. */ BOOL @@ -1300,50 +1332,33 @@ mattest(MATRIX *m) vp = m->m_table; i = m->m_size; while (i-- > 0) { - if ((vp->v_type != V_NUM) || (!qiszero(vp->v_num))) + if (testvalue(vp++)) return TRUE; - vp++; } return FALSE; } /* - * Sum the numeric values in a matrix. + * Sum the elements in a matrix. */ void matsum(MATRIX *m, VALUE *vres) { VALUE *vp; VALUE tmp; /* first sum value */ - VALUE sum; /* second sum value */ + VALUE sum; /* final sum value */ long i; - /* - * sum setup - */ vp = m->m_table; i = m->m_size; - sum.v_type = V_NUM; - sum.v_subtype = V_NOSUBTYPE; - sum.v_num = qlink(&_qzero_); + copyvalue(vp, &sum); - /* - * sum values - */ - while (i-- > 0) { - /* tmp = sum */ - copyvalue(&sum, &tmp); + while (--i > 0) { + addvalue(&sum, ++vp, &tmp); freevalue(&sum); - - /* add next matrix value */ - (void) addnumeric(vp++, &tmp, &sum); + sum = tmp; } - - /* - * return sum - */ - copyvalue(&sum, vres); - freevalue(&sum); + *vres = sum; } @@ -1525,8 +1540,8 @@ void matprint(MATRIX *m, long max_print) { VALUE *vp; - long fullsize, count, index, num; - long dim, i; + long fullsize, count, index; + long dim, i, j; char *msg; long sizes[MAXDIM]; @@ -1566,10 +1581,10 @@ matprint(MATRIX *m, long max_print) vp = m->m_table; for (index = 0; index < max_print; index++) { msg = " ["; - num = index; + j = index; for (i = 0; i < dim; i++) { - math_fmt("%s%ld", msg, m->m_min[i] + (num / sizes[i])); - num %= sizes[i]; + math_fmt("%s%ld", msg, m->m_min[i] + (j / sizes[i])); + j %= sizes[i]; msg = ","; } math_str("] = "); @@ -1579,5 +1594,3 @@ matprint(MATRIX *m, long max_print) if (max_print < fullsize) math_str(" ...\n"); } - -/* END CODE */ diff --git a/math_error.c b/math_error.c index e6db8a5..b0e2c2d 100644 --- a/math_error.c +++ b/math_error.c @@ -2,7 +2,7 @@ * math_error - a simple libcalc math error routine */ /* - * 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, @@ -49,15 +49,23 @@ * ... * * if ((error = setjmp(calc_jmp_buf)) != 0) { + * + * (* reinitialize calc after a longjmp *) + * reinitialize(); + * + * (* report the error *) * printf("Ouch: %s\n", calc_error); * } * calc_jmp = 1; */ + #include #include #include "args.h" #include "calc.h" +#include "math_error.h" + /* * error jump point we will longjmp to this jmp_buf if calc_jmp is non-zero @@ -100,5 +108,6 @@ math_error(char *fmt, ...) (void) fflush(stderr); fprintf(stderr, "%s\n", calc_error); fputc('\n', stderr); + libcalc_call_me_last(); exit(1); } diff --git a/math_error.h b/math_error.h new file mode 100644 index 0000000..d9b176a --- /dev/null +++ b/math_error.h @@ -0,0 +1,49 @@ +/* + * math_error - a simple libcalc math error routine + */ +/* + * 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, + * provided that the above copyright, this permission notice and text + * this comment, 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. + * + * Comments, suggestions, bug fixes and questions about these routines + * are welcome. Send EMail to the address given below. + * + * Happy bit twiddling, + * + * Landon Curt Noll + * + * chongo@toad.com + * ...!{pyramid,sun,uunet}!hoptoad!chongo + * + * chongo was here /\../\ + */ + + +#if !defined(__MATH_ERROR_H__) +#define __MATH_ERROR_H__ + + +/* + * Global data definitions. + */ +extern jmp_buf jmpbuf; /* for errors */ + + +#endif /* !__MATH_ERROR_H__ */ diff --git a/md5.c b/md5.c new file mode 100644 index 0000000..369794a --- /dev/null +++ b/md5.c @@ -0,0 +1,681 @@ +/* @(#)md5.c 12.1 17 Nov 1995 04:22:34 */ +/* + * md5 - RSA Data Security, Inc. MD5 Message-Digest Algorithm + * + * LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO + * THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MER- + * CHANTABILITY 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. + */ + +/* + *********************************************************************** + ** Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. ** + ** ** + ** License to copy and use this software is granted provided that ** + ** it is identified as the "RSA Data Security, Inc. MD5 Message- ** + ** Digest Algorithm" in all material mentioning or referencing this ** + ** software or this function. ** + ** ** + ** License is also granted to make and use derivative works ** + ** provided that such works are identified as "derived from the RSA ** + ** Data Security, Inc. MD5 Message-Digest Algorithm" in all ** + ** material mentioning or referencing the derived work. ** + ** ** + ** RSA Data Security, Inc. makes no representations concerning ** + ** either the merchantability of this software or the suitability ** + ** of this software for any particular purpose. It is provided "as ** + ** is" without express or implied warranty of any kind. ** + ** ** + ** These notices must be retained in any copies of any part of this ** + ** documentation and/or software. ** + *********************************************************************** + */ + +/* + *********************************************************************** + ** Message-digest routines: ** + ** To form the message digest for a message M ** + ** (1) Initialize a context buffer md5Ctx using MD5Init ** + ** (2) Call MD5Update on md5Ctx and M ** + ** (3) Call MD5Final on md5Ctx ** + ** The message digest is now in md5Ctx->digest[0...15] ** + *********************************************************************** + */ + + +#include +#include "longbits.h" +#include "align32.h" +#include "endian_calc.h" +#include "value.h" +#include "hash.h" +#include "md5.h" + + +/* + * The F, G, H and I are basic MD5 functions. The following + * identity saves one boolean operation. + * + * F: (((x) & (y)) | (~(x) & (z))) == ((z) ^ ((x) & ((y) ^ (z)))) + * G: (((x) & (z)) | ((y) & ~(z))) == ((y) ^ ((z) & ((x) ^ (y)))) + */ +/* F, G, H and I are basic MD5 functions */ +#define F(x, y, z) ((z) ^ ((x) & ((y) ^ (z)))) +#define G(x, y, z) ((y) ^ ((z) & ((x) ^ (y)))) +#define H(x, y, z) ((x) ^ (y) ^ (z)) +#define I(x, y, z) ((y) ^ ((x) | (~z))) + +/* rotate a 32 bit value */ +#define ROT(X,n) (((X)<<(n)) | ((X)>>(32-(n)))) + +/* FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4 */ +/* Rotation is separate from addition to prevent recomputation */ +#define S11 7 +#define S12 12 +#define S13 17 +#define S14 22 +#define FF(a, b, c, d, x, s, ac) \ + {(a) += F((b), (c), (d)) + (x) + (USB32)(ac); \ + (a) = ROT((a), (s)); \ + (a) += (b); \ + } +#define S21 5 +#define S22 9 +#define S23 14 +#define S24 20 +#define GG(a, b, c, d, x, s, ac) \ + {(a) += G((b), (c), (d)) + (x) + (USB32)(ac); \ + (a) = ROT((a), (s)); \ + (a) += (b); \ + } +#define S31 4 +#define S32 11 +#define S33 16 +#define S34 23 +#define HH(a, b, c, d, x, s, ac) \ + {(a) += H((b), (c), (d)) + (x) + (USB32)(ac); \ + (a) = ROT((a), (s)); \ + (a) += (b); \ + } +#define S41 6 +#define S42 10 +#define S43 15 +#define S44 21 +#define II(a, b, c, d, x, s, ac) \ + {(a) += I((b), (c), (d)) + (x) + (USB32)(ac); \ + (a) = ROT((a), (s)); \ + (a) += (b); \ + } + +/* forward declaration */ +static void MD5Init(HASH *state); +static void MD5Update(HASH *state, USB8 *inBuf, USB32 count); +static void MD5Transform(USB32*, USB32*); +static void MD5Final(HASH *state); +/* static USB32 in[MD5_CHUNKWORDS]; */ +static void MD5_chkpt(HASH *state); +static void MD5_note(int special, HASH *state); +static void MD5_type(int type, HASH *state); +static ZVALUE MD5_final_state(HASH *state); +static int MD5_cmp(HASH *a, HASH *b); +static void MD5_print(HASH *state); + + +/* + * MD5Init - initialize the message-digest context + * + * The routine MD5Init initializes the message-digest context + * md5Ctx. All fields are set to zero. + */ +static void +MD5Init(HASH *state) +{ + MD5_CTX *md5Ctx = &state->h_union.h_md5; /* digest state */ + + /* load magic initialization constants */ + md5Ctx->digest[0] = (USB32)0x67452301; + md5Ctx->digest[1] = (USB32)0xefcdab89; + md5Ctx->digest[2] = (USB32)0x98badcfe; + md5Ctx->digest[3] = (USB32)0x10325476; + + /* Initialise bit count */ + md5Ctx->countLo = 0L; + md5Ctx->countHi = 0L; + md5Ctx->datalen = 0L; +} + + +/* + * MD5Update - update message-digest context + */ +static void +MD5Update(HASH *state, USB8 *inBuf, USB32 count) +{ + MD5_CTX *md5Ctx = &state->h_union.h_md5; /* digest state */ + USB32 datalen = md5Ctx->datalen; + USB32 cpylen; +#if CALC_BYTE_ORDER == BIG_ENDIAN + int cnt; +#endif + + /* + * Update the full count, even if some of it is buffered for later + */ + MD5COUNT(md5Ctx, count); + + /* determine the size we need to copy */ + cpylen = MD5_CHUNKSIZE - datalen; + + /* case: new data will not fill the inBuf */ + if (cpylen > count) { + memcpy((char *)md5Ctx->data + datalen, + (char *)inBuf, count); + md5Ctx->datalen = datalen + count; + return; + } + + /* case: md5Ctx->in will be filled */ + memcpy((char *)md5Ctx->data + datalen, inBuf, cpylen); + + /* + * process data in MD5_CHUNKSIZE chunks + */ + for (;;) { +#if CALC_BYTE_ORDER == BIG_ENDIAN + if (state->bytes) { + /* byte swap data into little endian order */ + for (cnt=0; cnt < MD5_CHUNKWORDS; ++cnt) { + SWAP_B8_IN_B32(md5Ctx->data + cnt, + md5Ctx->data + cnt); + } + } +#endif + MD5Transform(md5Ctx->digest, md5Ctx->data); + inBuf += cpylen; + count -= cpylen; + if (count < MD5_CHUNKSIZE) + break; + cpylen = MD5_CHUNKSIZE; + memcpy(md5Ctx->data, inBuf, cpylen); + } + + /* + * Handle any remaining bytes of data. + * This should only happen once on the final lot of data + */ + if (count > 0) { + memcpy(md5Ctx->data, inBuf, count); + } + + md5Ctx->datalen = count; +} + + +/* + * MD5Final - terminate the message-digest computation + * + * The routine MD5Final terminates the message-digest computation and + * ends with the desired message digest in md5Ctx->digest[0...15]. + */ +static void +MD5Final(HASH *state) +{ + MD5_CTX *md5Ctx = &state->h_union.h_md5; /* digest state */ + USB32 count = md5Ctx->datalen; + USB32 lowBitcount = md5Ctx->countLo; + USB32 highBitcount = md5Ctx->countHi; + USB8 *data = (USB8 *)md5Ctx->data; +#if CALC_BYTE_ORDER == BIG_ENDIAN + int i; +#endif + + /* Pad to end of chunk */ + + memset(data + count, 0, MD5_CHUNKSIZE - count); + + /* + * If processing bytes, set the first byte of padding to 0x80. + * if processing words: on a big-endian machine set the first + * byte of padding to 0x80000000, on a little-endian machine set + * the first four bytes to 0x80. + * + * This is safe since there is always at least one byte or word free. + */ + +#if CALC_BYTE_ORDER == BIG_ENDIAN + if (state->bytes) { + data[count] = 0x80; + for (i=0; i < MD5_CHUNKWORDS; ++i) { + SWAP_B8_IN_B32(md5Ctx->data + i, + md5Ctx->data + i); + } + } + else { + if (count % 4) { + math_error("This should not happen in MD5Final"); + /*NOTREACHED*/ + } + data[count + 3] = 0x80; + } +#else + data[count] = 0x80; +#endif + + if (count >= MD5_CHUNKSIZE-8) { + MD5Transform(md5Ctx->digest, md5Ctx->data); + + /* Now load another chunk with 56 bytes of padding */ + memset(data, 0, MD5_CHUNKSIZE-8); + } + + /* append length in bits and transform */ + md5Ctx->data[MD5_LOW] = (lowBitcount << 3); + md5Ctx->data[MD5_HIGH] = (highBitcount << 3) | (lowBitcount >> 29); + + MD5Transform(md5Ctx->digest, md5Ctx->data); +} + + +/* + * Basic MD5 step. Transforms digest based on in. + */ +static void +MD5Transform(USB32 *digest, USB32 *in) +{ + USB32 a = digest[0], b = digest[1], c = digest[2], d = digest[3]; + + /* Round 1 */ + FF( a, b, c, d, in[ 0], S11, 3614090360UL); /* 1 */ + FF( d, a, b, c, in[ 1], S12, 3905402710UL); /* 2 */ + FF( c, d, a, b, in[ 2], S13, 606105819UL); /* 3 */ + FF( b, c, d, a, in[ 3], S14, 3250441966UL); /* 4 */ + FF( a, b, c, d, in[ 4], S11, 4118548399UL); /* 5 */ + FF( d, a, b, c, in[ 5], S12, 1200080426UL); /* 6 */ + FF( c, d, a, b, in[ 6], S13, 2821735955UL); /* 7 */ + FF( b, c, d, a, in[ 7], S14, 4249261313UL); /* 8 */ + FF( a, b, c, d, in[ 8], S11, 1770035416UL); /* 9 */ + FF( d, a, b, c, in[ 9], S12, 2336552879UL); /* 10 */ + FF( c, d, a, b, in[10], S13, 4294925233UL); /* 11 */ + FF( b, c, d, a, in[11], S14, 2304563134UL); /* 12 */ + FF( a, b, c, d, in[12], S11, 1804603682UL); /* 13 */ + FF( d, a, b, c, in[13], S12, 4254626195UL); /* 14 */ + FF( c, d, a, b, in[14], S13, 2792965006UL); /* 15 */ + FF( b, c, d, a, in[15], S14, 1236535329UL); /* 16 */ + + /* Round 2 */ + GG( a, b, c, d, in[ 1], S21, 4129170786UL); /* 17 */ + GG( d, a, b, c, in[ 6], S22, 3225465664UL); /* 18 */ + GG( c, d, a, b, in[11], S23, 643717713UL); /* 19 */ + GG( b, c, d, a, in[ 0], S24, 3921069994UL); /* 20 */ + GG( a, b, c, d, in[ 5], S21, 3593408605UL); /* 21 */ + GG( d, a, b, c, in[10], S22, 38016083UL); /* 22 */ + GG( c, d, a, b, in[15], S23, 3634488961UL); /* 23 */ + GG( b, c, d, a, in[ 4], S24, 3889429448UL); /* 24 */ + GG( a, b, c, d, in[ 9], S21, 568446438UL); /* 25 */ + GG( d, a, b, c, in[14], S22, 3275163606UL); /* 26 */ + GG( c, d, a, b, in[ 3], S23, 4107603335UL); /* 27 */ + GG( b, c, d, a, in[ 8], S24, 1163531501UL); /* 28 */ + GG( a, b, c, d, in[13], S21, 2850285829UL); /* 29 */ + GG( d, a, b, c, in[ 2], S22, 4243563512UL); /* 30 */ + GG( c, d, a, b, in[ 7], S23, 1735328473UL); /* 31 */ + GG( b, c, d, a, in[12], S24, 2368359562UL); /* 32 */ + + /* Round 3 */ + HH( a, b, c, d, in[ 5], S31, 4294588738UL); /* 33 */ + HH( d, a, b, c, in[ 8], S32, 2272392833UL); /* 34 */ + HH( c, d, a, b, in[11], S33, 1839030562UL); /* 35 */ + HH( b, c, d, a, in[14], S34, 4259657740UL); /* 36 */ + HH( a, b, c, d, in[ 1], S31, 2763975236UL); /* 37 */ + HH( d, a, b, c, in[ 4], S32, 1272893353UL); /* 38 */ + HH( c, d, a, b, in[ 7], S33, 4139469664UL); /* 39 */ + HH( b, c, d, a, in[10], S34, 3200236656UL); /* 40 */ + HH( a, b, c, d, in[13], S31, 681279174UL); /* 41 */ + HH( d, a, b, c, in[ 0], S32, 3936430074UL); /* 42 */ + HH( c, d, a, b, in[ 3], S33, 3572445317UL); /* 43 */ + HH( b, c, d, a, in[ 6], S34, 76029189UL); /* 44 */ + HH( a, b, c, d, in[ 9], S31, 3654602809UL); /* 45 */ + HH( d, a, b, c, in[12], S32, 3873151461UL); /* 46 */ + HH( c, d, a, b, in[15], S33, 530742520UL); /* 47 */ + HH( b, c, d, a, in[ 2], S34, 3299628645UL); /* 48 */ + + /* Round 4 */ + II( a, b, c, d, in[ 0], S41, 4096336452UL); /* 49 */ + II( d, a, b, c, in[ 7], S42, 1126891415UL); /* 50 */ + II( c, d, a, b, in[14], S43, 2878612391UL); /* 51 */ + II( b, c, d, a, in[ 5], S44, 4237533241UL); /* 52 */ + II( a, b, c, d, in[12], S41, 1700485571UL); /* 53 */ + II( d, a, b, c, in[ 3], S42, 2399980690UL); /* 54 */ + II( c, d, a, b, in[10], S43, 4293915773UL); /* 55 */ + II( b, c, d, a, in[ 1], S44, 2240044497UL); /* 56 */ + II( a, b, c, d, in[ 8], S41, 1873313359UL); /* 57 */ + II( d, a, b, c, in[15], S42, 4264355552UL); /* 58 */ + II( c, d, a, b, in[ 6], S43, 2734768916UL); /* 59 */ + II( b, c, d, a, in[13], S44, 1309151649UL); /* 60 */ + II( a, b, c, d, in[ 4], S41, 4149444226UL); /* 61 */ + II( d, a, b, c, in[11], S42, 3174756917UL); /* 62 */ + II( c, d, a, b, in[ 2], S43, 718787259UL); /* 63 */ + II( b, c, d, a, in[ 9], S44, 3951481745UL); /* 64 */ + + digest[0] += a; + digest[1] += b; + digest[2] += c; + digest[3] += d; +} + + +/* + * MD5_chkpt - checkpoint a MD5 state + * + * given: + * state the state to checkpoint + * + * This function will ensure that the the hash chunk buffer is empty. + * Any partially hashed data will be padded out with 0's and hashed. + */ +static void +MD5_chkpt(HASH *state) +{ + MD5_CTX *dig = &state->h_union.h_md5; /* digest state */ +#if CALC_BYTE_ORDER == BIG_ENDIAN + int cnt; +#endif + + /* + * checkpoint if partial buffer exists + */ + if (dig->datalen > 0) { + + /* pad to the end of the chunk */ + memset((USB8 *)dig->data + dig->datalen, 0, + MD5_CHUNKSIZE-dig->datalen); +#if CALC_BYTE_ORDER == BIG_ENDIAN + if (state->bytes) { + /* byte swap data into little endian order */ + for (cnt=0; cnt < MD5_CHUNKWORDS; ++cnt) { + SWAP_B8_IN_B32(dig->data + cnt, + dig->data + cnt); + } + } +#endif + + /* transform padded chunk */ + MD5Transform((USB32*)dig->digest, dig->data); + MD5COUNT(dig, MD5_CHUNKSIZE-dig->datalen); + + /* empty buffer */ + dig->datalen = 0; + } +} + + +/* + * MD5_note - note a special value + * + * given: + * state the state to hash + * special a special value (MD5_HASH_XYZ) to note + * + * This function will note that a special value is about to be hashed. + * Types include negative values, complex values, division, zero numeric + * and array of HALFs. + */ +static void +MD5_note(int special, HASH *state) +{ + MD5_CTX *dig = &state->h_union.h_md5; /* digest state */ + int i; + + /* + * change state to reflect a special value + */ + dig->digest[0] ^= special; + for (i=1; i < MD5_DIGESTWORDS; ++i) { + dig->digest[i] ^= (special + dig->digest[i-1] + i); + } + return; +} + + +/* + * MD5_type - note a VALUE type + * + * given: + * state the state to hash + * type the VALUE type to note + * + * This function will note that a type of value is about to be hashed. + * The type of a VALUE will be noted. For purposes of hash comparison, + * we will do nothing with V_NUM and V_COM so that the other functions + * can hash to the same value regardless of if MD5_value() is called + * or not. We also do nothing with V_STR so that a hash of a string + * will produce the same value as the standard hash function. + */ +static void +MD5_type(int type, HASH *state) +{ + MD5_CTX *dig = &state->h_union.h_md5; /* digest state */ + int i; + + /* + * ignore NUMBER and COMPLEX + */ + if (type == V_NUM || type == V_COM || type == V_STR) { + return; + } + + /* + * change state to reflect a VALUE type + */ + dig->digest[0] += type; + for (i=1; i < MD5_DIGESTWORDS; ++i) { + dig->digest[i] += ((type+i) ^ dig->digest[i-1]); + } + return; +} + + +/* + * MD5_init_state - initialize a hash state structure for this hash + * + * given: + * state - pointer to the hfunction element to initialize + */ +void +MD5_init_state(HASH *state) +{ + /* + * initalize state + */ + state->hashtype = MD5_HASH_TYPE; + state->bytes = TRUE; + state->update = MD5Update; + state->chkpt = MD5_chkpt; + state->note = MD5_note; + state->type = MD5_type; + state->final = MD5_final_state; + state->cmp = MD5_cmp; + state->print = MD5_print; + state->base = MD5_BASE; + state->chunksize = MD5_CHUNKSIZE; + state->unionsize = sizeof(MD5_CTX); + + /* + * perform the internal init function + */ + memset((void *)&(state->h_union.h_md5), 0, sizeof(MD5_CTX)); + MD5Init(state); + return; +} + + +/* + * MD5_final_state - complete hash state and return a ZVALUE + * + * given: + * state the state to complete and convert + * + * returns: + * a ZVALUE representing the state + */ +static ZVALUE +MD5_final_state(HASH *state) +{ + MD5_CTX *dig = &state->h_union.h_md5; /* digest state */ + ZVALUE ret; /* return ZVALUE of completed hash state */ + int i; + + /* + * malloc and initialize if state is NULL + */ + if (state == NULL) { + state = (HASH *)malloc(sizeof(HASH)); + if (state == NULL) { + math_error("cannot malloc HASH"); + /*NOTREACHED*/ + } + MD5_init_state(state); + } + + /* + * complete the hash state + */ + MD5Final(state); + + /* + * allocate storage for ZVALUE + */ + ret.len = MD5_DIGESTSIZE/sizeof(HALF); + ret.sign = 0; + ret.v = alloc(ret.len); + + /* + * load ZVALUE + */ +#if CALC_BYTE_ORDER == LITTLE_ENDIAN && BASEB == 16 + for (i = 0; i < MD5_DIGESTSIZE; i += 2) { + SWAP_B8_IN_B16(((USB8 *)dig->digest) + i, + ((USB8 *) dig->digest) + i); + } +#else + for (i = 0; i < MD5_DIGESTWORDS; ++i) { + SWAP_B8_IN_B32(dig->digest + i, dig->digest + i); + } +#endif + + for (i=0; i < ret.len; ++i) { + ret.v[ret.len-i-1] = ((HALF*)dig->digest)[i]; + } + + ztrim(&ret); + + /* + * return ZVALUE + */ + return ret; +} + + +/* + * MD5_cmp - compare two hash states + * + * given: + * a first hash state + * b second hash state + * + * returns: + * TRUE => hash states are different + * FALSE => hash states are the same + */ +static int +MD5_cmp(HASH *a, HASH *b) +{ + /* + * firewall and quick check + */ + if (a == b) { + /* pointers to the same object */ + return FALSE; + } + if (a == NULL || b == NULL) { + /* one is NULL, so they differ */ + return TRUE; + } + + /* + * compare concat states + */ + if (a->bytes != b->bytes) + return TRUE; + + /* + * compare bit counts + */ + if (a->h_union.h_md5.countLo != b->h_union.h_md5.countLo || + a->h_union.h_md5.countHi != b->h_union.h_md5.countHi) { + /* counts differ */ + return TRUE; + } + + /* + * compare pending buffers + */ + if (a->h_union.h_md5.datalen != b->h_union.h_md5.datalen) { + /* buffer lengths differ */ + return TRUE; + } + if (memcmp((char*)a->h_union.h_md5.data, + (char*)b->h_union.h_md5.data, + a->h_union.h_md5.datalen) != 0) { + /* buffer contents differ */ + return TRUE; + } + + /* + * compare digest + */ + return (memcmp((char*)(a->h_union.h_md5.digest), + (char*)(b->h_union.h_md5.digest), + MD5_DIGESTSIZE) != 0); +} + + +/* + * MD5_print - print a hash state + * + * given: + * state the hash state to print + */ +static void +MD5_print(HASH *state) +{ + /* + * form the hash value + */ + if (conf->calc_debug > 0) { + char buf[DEBUG_SIZE+1]; /* hash value buffer */ + + /* + * print numeric debug value + * + * NOTE: This value represents only the hash value as of + * the last full update or finalization. Thus it + * may NOT be the actual hash value. + */ + sprintf(buf, + "md5: 0x%08x%08x%08x%08x data: %d octets", + (int)state->h_union.h_md5.digest[0], + (int)state->h_union.h_md5.digest[1], + (int)state->h_union.h_md5.digest[2], + (int)state->h_union.h_md5.digest[3], + (int)state->h_union.h_md5.datalen); + math_str(buf); + } else { + math_str("md5 hash state"); + } + return; +} diff --git a/md5.h b/md5.h new file mode 100644 index 0000000..2e3dc7f --- /dev/null +++ b/md5.h @@ -0,0 +1,81 @@ +/* @(#)md5.h 12.1 17 Nov 1995 04:22:35 */ +/* + * md5 - RSA Data Security, Inc. MD5 Message-Digest Algorithm + * + * LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO + * THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MER- + * CHANTABILITY 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. + */ + +/* + *********************************************************************** + ** Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. ** + ** ** + ** License to copy and use this software is granted provided that ** + ** it is identified as the "RSA Data Security, Inc. MD5 Message- ** + ** Digest Algorithm" in all material mentioning or referencing this ** + ** software or this function. ** + ** ** + ** License is also granted to make and use derivative works ** + ** provided that such works are identified as "derived from the RSA ** + ** Data Security, Inc. MD5 Message-Digest Algorithm" in all ** + ** material mentioning or referencing the derived work. ** + ** ** + ** RSA Data Security, Inc. makes no representations concerning ** + ** either the merchantability of this software or the suitability ** + ** of this software for any particular purpose. It is provided "as ** + ** is" without express or implied warranty of any kind. ** + ** ** + ** These notices must be retained in any copies of any part of this ** + ** documentation and/or software. ** + *********************************************************************** + */ + +#if !defined(__MD5_H__) +#define __MD5_H__ + +/* MD5_CHUNKSIZE must be a power of 2 - fixed value defined by the algorithm */ +#define MD5_CHUNKSIZE (1<<6) +#define MD5_CHUNKWORDS (MD5_CHUNKSIZE/sizeof(USB32)) + +/* MD5_DIGESTSIZE is a the length of the digest as defined by the algorithm */ +#define MD5_DIGESTSIZE (16) +#define MD5_DIGESTWORDS (MD5_DIGESTSIZE/sizeof(USB32)) + +/* MD5_LOW - where low 32 bits of 64 bit count is stored during final */ +#define MD5_LOW 14 + +/* MD5_HIGH - where high 32 bits of 64 bit count is stored during final */ +#define MD5_HIGH 15 + +/* + * MD5COUNT(MD5_CTX*, USB32) - update the 64 bit count in an MD5_CTX + * + * We will count bytes and convert to bit count during the final + * transform. + */ +#define MD5COUNT(md5info, count) { \ + USB32 tmp_countLo; \ + tmp_countLo = (md5info)->countLo; \ + if (((md5info)->countLo += (count)) < tmp_countLo) { \ + (md5info)->countHi++; \ + } \ +} + +/* + * Data structure for MD5 (Message-Digest) computation + */ +typedef struct { + USB32 digest[MD5_DIGESTWORDS]; /* message digest */ + USB32 countLo; /* 64 bit count: bits 3-34 */ + USB32 countHi; /* 64 bit count: bits 35-63 (64-66 ignored) */ + USB32 datalen; /* length of data in inp.inp_USB8 */ + USB32 data[MD5_CHUNKWORDS]; /* USB32 chunk buffer */ +} MD5_CTX; + +#endif /* __MD5_H__ */ diff --git a/nametype.h b/nametype.h new file mode 100644 index 0000000..625909c --- /dev/null +++ b/nametype.h @@ -0,0 +1,53 @@ +/* + * 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, + * provided that the above copyright, this permission notice and text + * this comment, 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. + * + * Prior to calc 2.9.3t9, these routines existed as a calc library called + * cryrand.cal. They have been rewritten in C for performance as well + * as to make them available directly from libcalc.a. + * + * Comments, suggestions, bug fixes and questions about these routines + * are welcome. Send EMail to the address given below. + * + * Happy bit twiddling, + * + * Landon Curt Noll + * + * chongo@toad.com + * ...!{pyramid,sun,uunet}!hoptoad!chongo + * + * chongo was here /\../\ + */ + + +#if !defined(__NAMETYPE_H__) +#define __NAMETYPE_H__ + + +/* + * Configuration parameter name and type. + */ +typedef struct { + char *name; /* name of configuration string */ + int type; /* type for configuration */ +} NAMETYPE; + + +#endif /* !__NAMETYPE_H__ */ diff --git a/obj.c b/obj.c index 6b27909..7827e3d 100644 --- a/obj.c +++ b/obj.c @@ -1,13 +1,14 @@ /* - * 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. * - * "Object" handling primatives. + * "Object" handling primitives. * This simply means that user-specified routines are called to perform * the indicated operations. */ +#include #include "calc.h" #include "opcodes.h" #include "func.h" @@ -34,6 +35,8 @@ #define ERR_INC 6 /* increment by one */ #define ERR_DEC 7 /* decrement by one */ #define ERR_SQUARE 8 /* square value */ +#define ERR_VALUE 9 /* return value */ +#define ERR_ASSIGN 10 /* assign value */ static struct objectinfo { @@ -72,6 +75,21 @@ static struct objectinfo { {3, A_VALUE, ERR_NONE, "bround", "round to given number of binary places"}, {3, A_VALUE, ERR_NONE, "root", "root of value within given error"}, {3, A_VALUE, ERR_NONE, "sqrt", "square root within given error"}, + {2, A_VALUE, ERR_NONE, "or", "bitwise or"}, + {2, A_VALUE, ERR_NONE, "and", "bitwise and"}, + {1, A_VALUE, ERR_NONE, "not", "logical not"}, + {1, A_VALUE, ERR_NONE, "fact", "factorial or postfix !"}, + {1, A_VALUE, ERR_VALUE, "min", "value for min(...)"}, + {1, A_VALUE, ERR_VALUE, "max", "value for max(...)"}, + {1, A_VALUE, ERR_VALUE, "sum", "value for sum(...)"}, + {2, A_UNDEF, ERR_ASSIGN, "assign", "assign, defaults to a = b"}, + {2, A_VALUE, ERR_NONE, "xor", "value for binary ~"}, + {1, A_VALUE, ERR_NONE, "comp", "value for unary ~"}, + {1, A_VALUE, ERR_NONE, "content", "unary hash op"}, + {2, A_VALUE, ERR_NONE, "hashop", "binary hash op"}, + {1, A_VALUE, ERR_NONE, "backslash", "unary backslash op"}, + {2, A_VALUE, ERR_NONE, "setminus", "binary backslash op"}, + {1, A_VALUE, ERR_NONE, "plus", "unary + op"}, {0, 0, 0, NULL} }; @@ -187,6 +205,16 @@ objcall(int action, VALUE *v1, VALUE *v2, VALUE *v3) case ERR_SQUARE: val = objcall(OBJ_MUL, v1, v1, NULL_VALUE); break; + case ERR_VALUE: + copyvalue(v1, &val); + break; + case ERR_ASSIGN: + copyvalue(v2, &tmp); + tmp.v_subtype = v1->v_subtype; + freevalue(v1); + *v1 = tmp; + val.v_type = V_NULL; + break; default: math_error("Function \"%s\" is undefined", namefunc(index)); /*NOTREACHED*/ @@ -593,6 +621,7 @@ objalloc(long index) for (i = oap->count; i-- > 0; vp++) { vp->v_num = qlink(&_qzero_); vp->v_type = V_NUM; + vp->v_subtype = V_NOSUBTYPE; } return op; } @@ -651,6 +680,7 @@ objcopy(OBJECT *op) v2->v_type = V_NUM; } else copyvalue(v1, v2); + v2->v_subtype = V_NOSUBTYPE; } return np; } diff --git a/opcodes.c b/opcodes.c index 506b490..d0a8251 100644 --- a/opcodes.c +++ b/opcodes.c @@ -1,30 +1,47 @@ /* - * Copyright (c) 1996 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. * * Opcode execution module */ +#include +#include +#include + #include "calc.h" #include "opcodes.h" #include "func.h" #include "symbol.h" #include "hist.h" -#include "args.h" #include "file.h" #include "zrand.h" +#include "zrandom.h" #include "have_fpos.h" +#include "custom.h" +#include "math_error.h" +#include "block.h" +#include "string.h" #define QUICKLOCALS 20 /* local vars to handle quickly */ -VALUE *stack; /* current location of top of stack */ static VALUE stackarray[MAXSTACK]; /* storage for stack */ static VALUE oldvalue; /* previous calculation value */ -static char *funcname; /* function being executed */ -static long funcline; /* function line being executed */ -int dumpnames; /* names if TRUE, otherwise indices */ +static BOOL saveval = TRUE; /* to enable or disable saving */ +static int calc_errno; /* most recent error-number */ +static int errcount; /* counts calls to error_value */ +static int errmax = ERRMAX; /* maximum for errcount without abort */ +static BOOL go; + +/* + * global symbols + */ +VALUE *stack; /* current location of top of stack */ +int dumpnames; /* names if TRUE, otherwise indices */ +char *funcname; /* function being executed */ +long funcline; /* function line being executed */ /* @@ -113,6 +130,7 @@ o_localaddr(FUNC *fp, VALUE *locals, long index) stack++; stack->v_addr = locals; stack->v_type = V_ADDR; + stack->v_subtype = V_NOSUBTYPE; } @@ -127,6 +145,7 @@ o_globaladdr(FUNC *fp, GLOBAL *sp) stack++; stack->v_addr = &sp->g_value; stack->v_type = V_ADDR; + stack->v_subtype = V_NOSUBTYPE; } @@ -140,11 +159,13 @@ o_paramaddr(FUNC *fp, int argcount, VALUE *args, long index) } args += index; stack++; - if (args->v_type == V_ADDR) - stack->v_addr = args->v_addr; - else - stack->v_addr = args; + if (args->v_type == V_OCTET || args->v_type == V_ADDR) { + *stack = *args; + return; + } + stack->v_addr = args; stack->v_type = V_ADDR; + stack->v_subtype = V_NOSUBTYPE; } @@ -230,6 +251,7 @@ o_number(FUNC *fp, long arg) stack++; stack->v_num = qlink(q); stack->v_type = V_NUM; + stack->v_subtype = V_NOSUBTYPE; } @@ -246,13 +268,14 @@ o_imaginary(FUNC *fp, long arg) /*NOTREACHED*/ } stack++; + stack->v_subtype = V_NOSUBTYPE; if (qiszero(q)) { stack->v_num = qlink(q); stack->v_type = V_NUM; return; } c = comalloc(); - c->real = qlink(&_qzero_); + qfree(c->imag); c->imag = qlink(q); stack->v_com = c; stack->v_type = V_COM; @@ -261,12 +284,11 @@ o_imaginary(FUNC *fp, long arg) /*ARGSUSED*/ static void -o_string(FUNC *fp, char *cp) +o_string(FUNC *fp, long arg) { stack++; - stack->v_str = cp; + stack->v_str = slink(findstring(arg)); stack->v_type = V_STR; - stack->v_subtype = V_STRLITERAL; } @@ -341,6 +363,7 @@ o_matcreate(FUNC *fp, long dim) } stack++; stack->v_type = V_MAT; + stack->v_subtype = V_NOSUBTYPE; stack->v_mat = mp; } @@ -351,35 +374,79 @@ o_eleminit(FUNC *fp, long index) { VALUE *vp; static VALUE *oldvp; - MATRIX *mp; - OBJECT *op; VALUE tmp; + OCTET *ptr; + BLOCK *blk; + int subtype; vp = &stack[-1]; if (vp->v_type == V_ADDR) vp = vp->v_addr; switch (vp->v_type) { case V_MAT: - mp = vp->v_mat; - if ((index < 0) || (index >= mp->m_size)) { + if ((index < 0) || (index >= vp->v_mat->m_size)) { math_error("Too many initializer values"); /*NOTREACHED*/ } - oldvp = &mp->m_table[index]; + + oldvp = &vp->v_mat->m_table[index]; break; case V_OBJ: - op = vp->v_obj; - if ((index < 0) || (index >= op->o_actions->count)) { + if (index < 0 || index >= vp->v_obj->o_actions->count) { math_error("Too many initializer values"); /*NOTREACHED*/ } - oldvp = &op->o_table[index]; + oldvp = &vp->v_obj->o_table[index]; break; + case V_LIST: + oldvp = listfindex(vp->v_list, index); + if (oldvp == NULL) { + math_error("Too many initializer values"); + /*NOTREACHED*/ + } + break; + case V_STR: + if (index < 0 || index >= vp->v_str->s_len) { + math_error("Bad index for string initializing"); + /*NOTREACHED*/ + } + ptr = (OCTET *)(&vp->v_str->s_str[index]); + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + copy2octet(vp, ptr); + freevalue(stack--); + return; + case V_NBLOCK: + case V_BLOCK: + if (vp->v_type == V_NBLOCK) { + blk = vp->v_nblock->blk; + if (blk->data == NULL) { + math_error("Attempt to initialize freed block"); + /*NOTREACHED*/ + } + } + else + blk = vp->v_block; + if (index >= blk->maxsize) { + math_error("Too many initializer values"); + /*NOTREACHED*/ + } + ptr = blk->data + index; + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + copy2octet(vp, ptr); + if (index >= blk->datalen) + blk->datalen = index + 1; + freevalue(stack--); + return; default: - math_error("Attempt to initialize non matrix or object"); + math_error("Bad destination type for eleminit"); /*NOTREACHED*/ } vp = stack--; + subtype = oldvp->v_subtype; if (vp->v_type == V_ADDR) { vp = vp->v_addr; if (vp == oldvp) @@ -390,11 +457,12 @@ o_eleminit(FUNC *fp, long index) tmp = *vp; freevalue(oldvp); *oldvp = tmp; + oldvp->v_subtype = subtype; } /* - * o_indexaddr + * o_indexaddr * * given: * fp function to calculate @@ -410,6 +478,9 @@ o_indexaddr(FUNC *fp, long dim, long writeflag) VALUE *val; VALUE *vp; VALUE indices[MAXDIM]; /* index values */ + long index; /* single dimension index for blocks */ + VALUE ret; /* OCTET from as indexed from a block */ + BLOCK *blk; flag = (writeflag != 0); if (dim <= 0) { @@ -417,11 +488,14 @@ o_indexaddr(FUNC *fp, long dim, long writeflag) /*NOTREACHED*/ } val = &stack[-dim]; - if (val->v_type != V_ADDR) { - math_error("Non-pointer for indexaddr"); - /*NOTREACHED*/ + if (val->v_type != V_NBLOCK && val->v_type != V_FILE) { + if (val->v_type != V_ADDR) { + math_error("Non-pointer for indexaddr"); + /*NOTREACHED*/ + } + val = val->v_addr; } - val = val->v_addr; + blk = NULL; vp = &stack[-dim + 1]; for (i = 0; i < dim; i++) { if (vp->v_type == V_ADDR) @@ -437,6 +511,105 @@ o_indexaddr(FUNC *fp, long dim, long writeflag) case V_ASSOC: vp = associndex(val->v_assoc, flag, dim, indices); break; + case V_NBLOCK: + case V_BLOCK: + if (val->v_type == V_BLOCK) + blk = val->v_block; + else + blk = val->v_nblock->blk; + if (blk->data == NULL) { + math_error("Freed block"); + /*NOTREACHED*/ + } + + /* + * obtain single dimensional block index + */ + if (dim != 1) { + math_error("block has only one dimension"); + /*NOTREACHED*/ + } + if (indices[0].v_type != V_NUM) { + math_error("Non-numeric index for block"); + /*NOTREACHED*/ + } + if (qisfrac(indices[0].v_num)) { + math_error("Non-integral index for block"); + /*NOTREACHED*/ + } + if (zge31b(indices[0].v_num->num) || + zisneg(indices[0].v_num->num)) { + math_error("Index out of bounds for block"); + /*NOTREACHED*/ + } + index = ztoi(indices[0].v_num->num); + + if (index >= blk->maxsize) { + math_error("Index out of bounds for block"); + /*NOTREACHED*/ + } + if (index >= blk->datalen) + blk->datalen = index + 1; + ret.v_type = V_OCTET; + ret.v_subtype = V_NOSUBTYPE; + ret.v_octet = &blk->data[index]; + freevalue(stack--); + *stack = ret; + return; + case V_STR: + if (dim != 1) { + math_error("string has only one dimension"); + /*NOTREACHED*/ + } + if (indices[0].v_type != V_NUM) { + math_error("Non-numeric index for string"); + /*NOTREACHED*/ + } + if (qisfrac(indices[0].v_num)) { + math_error("Non-integral index for string"); + /*NOTREACHED*/ + } + if (zge31b(indices[0].v_num->num) || + zisneg(indices[0].v_num->num)) { + math_error("Index out of bounds for string"); + /*NOTREACHED*/ + } + index = ztoi(indices[0].v_num->num); + if (index >= val->v_str->s_len) { + math_error("Index out of bounds for string"); + /*NOTREACHED*/ + } + ret.v_type = V_OCTET; + ret.v_subtype = V_NOSUBTYPE; + ret.v_octet = (OCTET *)(val->v_str->s_str + index); + freevalue(stack--); + *stack = ret; + return; + case V_LIST: + if (dim != 1) { + math_error("list has only one dimension"); + /*NOTREACHED*/ + } + if (indices[0].v_type != V_NUM) { + math_error("Non-numeric index for list"); + /*NOTREACHED*/ + } + if (qisfrac(indices[0].v_num)) { + math_error("Non-integral index for list"); + /*NOTREACHED*/ + } + if (zge31b(indices[0].v_num->num) || + zisneg(indices[0].v_num->num)) { + math_error("Index out of bounds for list"); + /*NOTREACHED*/ + } + index = ztoi(indices[0].v_num->num); + vp = listfindex(val->v_list, index); + if (vp == NULL) { + math_error("Index out of bounds for list"); + /*NOTREACHED*/ + } + break; default: math_error("Illegal value for indexing"); /*NOTREACHED*/ @@ -502,6 +675,7 @@ o_objcreate(FUNC *fp, long arg) { stack++; stack->v_type = V_OBJ; + stack->v_subtype = V_NOSUBTYPE; stack->v_obj = objalloc(arg); } @@ -512,52 +686,211 @@ o_assign(void) VALUE *var; /* variable value */ VALUE *vp; VALUE tmp; + short subtype; + /* + * get what we will store into + */ var = &stack[-1]; + + /* + * If what we will store into is an OCTET, we must + * handle this specially. Only the bottom 8 bits of + * certain value types will be assigned ... not the + * entire value. + */ + if (var->v_type == V_OCTET) { + if (var->v_subtype & V_NOCOPYTO) { + math_error("No-copy-to octet destination"); + /*NOTREACHED*/ + } + copy2octet(stack, var->v_octet); + freevalue(stack--); + return; + } if (var->v_type != V_ADDR) { math_error("Assignment into non-variable"); /*NOTREACHED*/ } + var = var->v_addr; - vp = stack--; + subtype = var->v_subtype; + + if (subtype & V_NOASSIGNTO) { + math_error("No-assign-to destination for assign"); + /*NOTREACHED*/ + } + + vp = stack; + + if (var->v_type == V_OBJ) { + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + (void) objcall(OBJ_ASSIGN, var, vp, NULL_VALUE); + freevalue(stack--); + return; + } + + stack--; + + /* + * Get what we will store from + * If what will store from is an address, make a copy + * of the de-referenced address instead. + */ if (vp->v_type == V_ADDR) { vp = vp->v_addr; if (vp == var) return; + if (vp->v_subtype & V_NOASSIGNFROM) { + math_error("No-assign-from source for assign"); + /*NOTREACHED*/ + } copyvalue(vp, &tmp); - } - else + } else if (vp->v_type == V_OCTET) { + copyvalue(vp, &tmp); + } else { tmp = *vp; + } + + /* + * perform the assignment + */ + if ((subtype & V_NONEWVALUE) && comparevalue(var, &tmp)) { + freevalue(&tmp); + math_error("Change of value in assign not permitted"); + /*NOTREACHED*/ + } + if ((subtype & V_NONEWTYPE) && var->v_type != tmp.v_type) { + freevalue(&tmp); + math_error("Change of type in assign not permitted"); + /*NOTREACHED*/ + } + if ((subtype & V_NOERROR) && tmp.v_type < 0) { + math_error("Error value in assign not permitted"); + /*NOTREACHED*/ + } freevalue(var); *var = tmp; + var->v_subtype = subtype; +} + + +static void +o_assignback(void) +{ + VALUE tmp; + + tmp = stack[-1]; + stack[-1] = stack[0]; + stack[0] = tmp; + o_assign(); } static void o_assignpop(void) { - VALUE *var; /* variable value */ - VALUE *vp; - VALUE tmp; + o_assign(); + stack--; +} - var = &stack[-1]; - if (var->v_type != V_ADDR) { - math_error("Assignment into non-variable"); + +static void +o_ptr(void) +{ + switch (stack->v_type) { + case V_ADDR: + stack->v_type = V_VPTR; + break; + case V_OCTET: + stack->v_type = V_OPTR; + break; + case V_STR: + sfree(stack->v_str); + stack->v_type = V_SPTR; + break; + case V_NUM: + qfree(stack->v_num); + stack->v_type = V_NPTR; + break; + default: + math_error("Addressing non-addressable type"); + /*NOTREACHED*/ + } +} + + +static void +o_deref(void) +{ + VALUE *vp; + short subtype; + + vp = stack; + subtype = stack->v_subtype; + + if (stack->v_type == V_OCTET) { + stack->v_num = itoq(*vp->v_octet); + stack->v_type = V_NUM; + return; + } + if (stack->v_type == V_OPTR) { + stack->v_type = V_OCTET; + return; + } + if (stack->v_type == V_VPTR) { + stack->v_type = V_ADDR; + return; + } + if (stack->v_type == V_SPTR) { + stack->v_type = V_STR; + return; + } + if (stack->v_type == V_NPTR) { + if (stack->v_num->links == 0) { + stack->v_type = V_NULL; + return; + } + stack->v_type = V_NUM; + stack->v_num->links++; + return; + } + if (stack->v_type != V_ADDR) { + math_error("Deferencing a non-variable"); /*NOTREACHED*/ } - var = var->v_addr; - vp = &stack[0]; - stack -= 2; - if (vp->v_type == V_ADDR) { - vp = vp->v_addr; - if (vp == var) - return; - copyvalue(vp, &tmp); + vp = vp->v_addr; + switch (vp->v_type) { + case V_ADDR: + case V_OCTET: + *stack = *vp; + break; + case V_OPTR: + *stack = *vp; + stack->v_type = V_OCTET; + break; + case V_VPTR: + *stack = *vp; + stack->v_type = V_ADDR; + break; + case V_SPTR: + *stack = *vp; + stack->v_type = V_STR; + break; + case V_NPTR: + if (vp->v_num->links == 0) { + stack->v_type = V_NULL; + break; + } + stack->v_type = V_NUM; + stack->v_num = vp->v_num; + stack->v_num->links++; + break; + default: + copyvalue(vp, stack); } - else - tmp = *vp; - freevalue(var); - *var = tmp; + stack->v_subtype = subtype; } @@ -566,17 +899,34 @@ o_swap(void) { VALUE *v1, *v2; /* variables to be swapped */ VALUE tmp; + USB8 usb; + short s1, s2; /* for subtypes */ - v1 = &stack[-1]; - v2 = &stack[0]; - if ((v1->v_type != V_ADDR) || (v2->v_type != V_ADDR)) { - math_error("Swapping non-variables"); + v1 = stack--; + v2 = stack; + + if (v1->v_type == V_OCTET && v2->v_type == V_OCTET) { + usb = *v1->v_octet; + *v1->v_octet = *v2->v_octet; + *v2->v_octet = usb; + } else if (v1->v_type == V_ADDR && v2->v_type == V_ADDR) { + v1 = v1->v_addr; + v2 = v2->v_addr; + s1 = v1->v_subtype; + s2 = v2->v_subtype; + if ((s1 | s2) & (V_NOASSIGNTO | V_NOASSIGNFROM)) { + math_error("Swap not permitted by protection levels"); + /*NOTREACHED*/ + } + tmp = *v1; + *v1 = *v2; + *v2 = tmp; + v1->v_subtype = s1; + v2->v_subtype = s2; + } else { + math_error("Swapping values of non-variables"); /*NOTREACHED*/ } - tmp = v1->v_addr[0]; - v1->v_addr[0] = v2->v_addr[0]; - v2->v_addr[0] = tmp; - stack--; stack->v_type = V_NULL; } @@ -586,6 +936,7 @@ o_add(void) { VALUE *v1, *v2; VALUE tmp; + VALUE w1, w2; v1 = &stack[-1]; v2 = &stack[0]; @@ -593,7 +944,22 @@ o_add(void) v1 = v1->v_addr; if (v2->v_type == V_ADDR) v2 = v2->v_addr; + if (v1->v_type == V_OCTET) { + w1.v_type = V_NUM; + w1.v_num = itoq(*v1->v_octet); + v1 = &w1; + } + if (v2->v_type == V_OCTET) { + w2.v_type = V_NUM; + w2.v_num = itoq(*v2->v_octet); + v2 = &w2; + } + addvalue(v1, v2, &tmp); + if (v1 == &w1) + qfree(w1.v_num); + if (v2 == &w2) + qfree(w2.v_num); freevalue(stack--); freevalue(stack); *stack = tmp; @@ -605,6 +971,7 @@ o_sub(void) { VALUE *v1, *v2; VALUE tmp; + VALUE w1, w2; v1 = &stack[-1]; v2 = &stack[0]; @@ -612,7 +979,22 @@ o_sub(void) v1 = v1->v_addr; if (v2->v_type == V_ADDR) v2 = v2->v_addr; + if (v1->v_type == V_OCTET) { + w1.v_type = V_NUM; + w1.v_num = itoq((unsigned char) *v1->v_octet); + v1 = &w1; + } + if (v2->v_type == V_OCTET) { + w2.v_type = V_NUM; + w2.v_num = itoq((unsigned char) *v2->v_octet); + v2 = &w2; + } + subvalue(v1, v2, &tmp); + if (v1 == &w1) + qfree(w1.v_num); + if (v2 == &w2) + qfree(w2.v_num); freevalue(stack--); freevalue(stack); *stack = tmp; @@ -624,6 +1006,7 @@ o_mul(void) { VALUE *v1, *v2; VALUE tmp; + VALUE w1, w2; v1 = &stack[-1]; v2 = &stack[0]; @@ -631,7 +1014,21 @@ o_mul(void) v1 = v1->v_addr; if (v2->v_type == V_ADDR) v2 = v2->v_addr; + if (v1->v_type == V_OCTET) { + w1.v_type = V_NUM; + w1.v_num = itoq(*v1->v_octet); + v1 = &w1; + } + if (v2->v_type == V_OCTET) { + w2.v_type = V_NUM; + w2.v_num = itoq(*v2->v_octet); + v2 = &w2; + } mulvalue(v1, v2, &tmp); + if (v1 == &w1) + qfree(w1.v_num); + if (v2 == &w2) + qfree(w2.v_num); freevalue(stack--); freevalue(stack); *stack = tmp; @@ -662,6 +1059,7 @@ o_div(void) { VALUE *v1, *v2; VALUE tmp; + VALUE w1, w2; v1 = &stack[-1]; v2 = &stack[0]; @@ -669,7 +1067,21 @@ o_div(void) v1 = v1->v_addr; if (v2->v_type == V_ADDR) v2 = v2->v_addr; + if (v1->v_type == V_OCTET) { + w1.v_type = V_NUM; + w1.v_num = itoq(*v1->v_octet); + v1 = &w1; + } + if (v2->v_type == V_OCTET) { + w2.v_type = V_NUM; + w2.v_num = itoq(*v2->v_octet); + v2 = &w2; + } divvalue(v1, v2, &tmp); + if (v1 == &w1) + qfree(w1.v_num); + if (v2 == &w2) + qfree(w2.v_num); freevalue(stack--); freevalue(stack); *stack = tmp; @@ -741,6 +1153,15 @@ o_quomod(void) } v3 = v3->v_addr; v4 = v4->v_addr; + + valquo.v_subtype = v3->v_subtype; + valmod.v_subtype = v4->v_subtype; + + if ((v3->v_subtype | v4->v_subtype) & V_NOASSIGNTO) { + math_error("No-assign-to destination for quomod"); + /*NOTREACHED*/ + } + valquo.v_type = V_NUM; valmod.v_type = V_NUM; res = qquomod(v1->v_num, v2->v_num, &valquo.v_num, &valmod.v_num); @@ -752,8 +1173,10 @@ o_quomod(void) qfree(stack->v_num); stack->v_num = (res ? qlink(&_qone_) : qlink(&_qzero_)); stack->v_type = V_NUM; + freevalue(v3); freevalue(v4); + *v3 = valquo; *v4 = valmod; } @@ -763,7 +1186,7 @@ static void o_and(void) { VALUE *v1, *v2; - NUMBER *q; + VALUE tmp; v1 = &stack[-1]; v2 = &stack[0]; @@ -771,18 +1194,11 @@ o_and(void) v1 = v1->v_addr; if (v2->v_type == V_ADDR) v2 = v2->v_addr; - if ((v1->v_type != V_NUM) || (v2->v_type != V_NUM)) { - math_error("Non-numerics for and"); - /*NOTREACHED*/ - } - q = qand(v1->v_num, v2->v_num); - if (stack->v_type == V_NUM) - qfree(stack->v_num); - stack--; - if (stack->v_type == V_NUM) - qfree(stack->v_num); - stack->v_num = q; - stack->v_type = V_NUM; + + andvalue(v1, v2, &tmp); + freevalue(stack--); + freevalue(stack); + *stack = tmp; } @@ -790,7 +1206,7 @@ static void o_or(void) { VALUE *v1, *v2; - NUMBER *q; + VALUE tmp; v1 = &stack[-1]; v2 = &stack[0]; @@ -798,18 +1214,46 @@ o_or(void) v1 = v1->v_addr; if (v2->v_type == V_ADDR) v2 = v2->v_addr; - if ((v1->v_type != V_NUM) || (v2->v_type != V_NUM)) { - math_error("Non-numerics for or"); - /*NOTREACHED*/ - } - q = qor(v1->v_num, v2->v_num); - if (stack->v_type == V_NUM) - qfree(stack->v_num); - stack--; - if (stack->v_type == V_NUM) - qfree(stack->v_num); - stack->v_num = q; - stack->v_type = V_NUM; + + orvalue(v1, v2, &tmp); + freevalue(stack--); + freevalue(stack); + *stack = tmp; +} + +static void +o_xor (void) +{ + VALUE *v1, *v2; + VALUE tmp; + + v1 = &stack[-1]; + v2 = &stack[0]; + + if (v1->v_type == V_ADDR) + v1 = v1->v_addr; + if (v2->v_type == V_ADDR) + v2 = v2->v_addr; + + xorvalue(v1, v2, &tmp); + freevalue(stack--); + freevalue(stack); + *stack = tmp; +} + + +static void +o_comp (void) +{ + VALUE *vp; + VALUE tmp; + + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + compvalue(vp, &tmp); + freevalue(stack); + *stack = tmp; } @@ -817,11 +1261,18 @@ static void o_not(void) { VALUE *vp; - int r; + VALUE val; + int r = 0; vp = stack; if (vp->v_type == V_ADDR) vp = vp->v_addr; + if (vp->v_type == V_OBJ) { + val = objcall(OBJ_NOT, vp, NULL_VALUE, NULL_VALUE); + freevalue(stack); + *stack = val; + return; + } r = testvalue(vp); freevalue(stack); stack->v_num = (r ? qlink(&_qzero_) : qlink(&_qone_)); @@ -829,6 +1280,33 @@ o_not(void) } +static void +o_plus (void) +{ + VALUE *vp; + VALUE tmp; + + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + + tmp.v_type = V_NULL; + tmp.v_subtype = V_NOSUBTYPE; + switch (vp->v_type) { + case V_OBJ: + tmp = objcall(OBJ_PLUS, vp, NULL_VALUE, NULL_VALUE); + break; + case V_LIST: + addlistitems(vp->v_list, &tmp); + break; + default: + return; + } + freevalue(stack); + *stack = tmp; +} + + static void o_negate(void) { @@ -857,20 +1335,12 @@ static void o_invert(void) { VALUE *vp; - NUMBER *q; VALUE tmp; vp = stack; if (vp->v_type == V_ADDR) vp = vp->v_addr; - if (vp->v_type == V_NUM) { - q = qinv(vp->v_num); - if (stack->v_type == V_NUM) - qfree(stack->v_num); - stack->v_num = q; - stack->v_type = V_NUM; - return; - } + invertvalue(vp, &tmp); freevalue(stack); *stack = tmp; @@ -953,7 +1423,7 @@ o_abs(void) stack--; if ((stack->v_type == V_NUM) && !qisneg(v1->v_num)) return; - q = qabs(v1->v_num); + q = qqabs(v1->v_num); if (stack->v_type == V_NUM) qfree(stack->v_num); stack->v_num = q; @@ -1009,6 +1479,267 @@ o_square(void) } +static void +o_test(void) +{ + VALUE *vp; + int i; + + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + i = testvalue(vp); + freevalue(stack); + stack->v_type = V_NUM; + stack->v_num = i ? qlink(&_qone_) : qlink(&_qzero_); +} + + +static void +o_links(void) +{ + VALUE *vp; + long links; + BOOL haveaddress; + + vp = stack; + haveaddress = (vp->v_type == V_ADDR); + if (haveaddress) + vp = vp->v_addr; + switch (vp->v_type) { + case V_NUM: links = vp->v_num->links; break; + case V_COM: links = vp->v_com->links; break; + case V_STR: links = vp->v_str->s_links; break; + default: + freevalue(stack); + return; + } + if (links <= 0) { + math_error("Non-positive links!!!"); + /*NOTREACHED*/ + } + freevalue(stack); + if (!haveaddress) + links--; + stack->v_type = V_NUM; + stack->v_num = itoq(links); +} + + +static void +o_bit (void) +{ + VALUE *v1, *v2; + long index; + int r; + + v1 = &stack[-1]; + v2 = &stack[0]; + if (v1->v_type == V_ADDR) + v1 = v1->v_addr; + if (v2->v_type == V_ADDR) + v2 = v2->v_addr; + if (v2->v_type != V_NUM || qisfrac(v2->v_num)) { + freevalue(stack--); + freevalue(stack); + *stack = error_value(E_BIT1); + return; + } + if (zge31b(v2->v_num->num)) { + freevalue(stack--); + freevalue(stack); + *stack = error_value(E_BIT2); + return; + } + index = qtoi(v2->v_num); + switch (v1->v_type) { + case V_NUM: + r = qisset(v1->v_num, index); + break; + case V_STR: + r = stringbit(v1->v_str, index); + break; + default: + r = 2; + } + freevalue(stack--); + freevalue(stack); + if (r > 1) + *stack = error_value(E_BIT1); + else if (r < 0) + stack->v_type = V_NULL; + else { + stack->v_type = V_NUM; + stack->v_num = itoq(r); + } +} + +static void +o_highbit (void) +{ + VALUE *vp; + long index; + unsigned int u; + + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + switch (vp->v_type) { + case V_NUM: + if (qiszero(vp->v_num)) { + index = -1; + break; + } + if (qisfrac(vp->v_num)) { + index = -2; + break; + } + index = zhighbit(vp->v_num->num); + break; + case V_STR: + index = stringhighbit(vp->v_str); + break; + case V_OCTET: + u = *vp->v_octet; + for (index = -1; u; u >>= 1, ++index); + break; + default: + index = -3; + } + freevalue(stack); + switch (index) { + case -3: + *stack = error_value(E_HIGHBIT1); + return; + case -2: + *stack = error_value(E_HIGHBIT2); + return; + default: + stack->v_type = V_NUM; + stack->v_num = itoq(index); + } +} + + +static void +o_lowbit (void) +{ + VALUE *vp; + long index; + unsigned int u; + + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + switch (vp->v_type) { + case V_NUM: + if (qiszero(vp->v_num)) { + index = -1; + break; + } + if (qisfrac(vp->v_num)) { + index = -2; + break; + } + index = zlowbit(vp->v_num->num); + break; + case V_STR: + index = stringlowbit(vp->v_str); + break; + case V_OCTET: + u = *vp->v_octet; + index = -1; + if (u) do { + ++index; + u >>= 1; + } while (!(u & 1)); + break; + default: + index = -3; + } + freevalue(stack); + switch (index) { + case -3: + *stack = error_value(E_LOWBIT1); + return; + case -2: + *stack = error_value(E_LOWBIT2); + return; + default: + stack->v_type = V_NUM; + stack->v_num = itoq(index); + } +} + + +static void +o_content (void) +{ + VALUE *vp; + VALUE tmp; + + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + contentvalue(vp, &tmp); + freevalue(stack); + *stack = tmp; +} + + +static void +o_hashop (void) +{ + VALUE *v1, *v2; + VALUE tmp; + + v1 = &stack[-1]; + v2 = &stack[0]; + if (v1->v_type == V_ADDR) + v1 = v1->v_addr; + if (v2->v_type == V_ADDR) + v2 = v2->v_addr; + hashopvalue(v1, v2, &tmp); + freevalue(stack--); + freevalue(stack); + *stack = tmp; +} + + +static void +o_backslash (void) +{ + VALUE *vp; + VALUE tmp; + + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + backslashvalue(vp, &tmp); + freevalue(stack); + *stack = tmp; +} + + +static void +o_setminus (void) +{ + VALUE *v1, *v2; + VALUE tmp; + + v1 = &stack[-1]; + v2 = &stack[0]; + if (v1->v_type == V_ADDR) + v1 = v1->v_addr; + if (v2->v_type == V_ADDR) + v2 = v2->v_addr; + setminusvalue(v1, v2, &tmp); + freevalue(stack--); + freevalue(stack); + *stack = tmp; +} + + static void o_istype(void) { @@ -1228,8 +1959,10 @@ o_ishash(void) if (vp->v_type == V_ADDR) vp = vp->v_addr; r = (vp->v_type == V_HASH); + if (r != 0) + r = vp->v_hash->hashtype; freevalue(stack); - stack->v_num = (r ? qlink(&_qone_) : qlink(&_qzero_)); + stack->v_num = itoq((long) r); stack->v_type = V_NUM; } @@ -1250,6 +1983,113 @@ o_isassoc(void) } +static void +o_isblock(void) +{ + VALUE *vp; + long r; + + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + r = 0; + if (vp->v_type == V_NBLOCK) + r = 2; + else if (vp->v_type == V_BLOCK) + r = 1; + freevalue(stack); + stack->v_num = itoq(r); + stack->v_type = V_NUM; +} + + +static void +o_isoctet(void) +{ + VALUE *vp; + long r; + + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + r = (vp->v_type == V_OCTET); + freevalue(stack); + stack->v_num = itoq(r); + stack->v_type = V_NUM; +} + + +static void +o_isptr(void) +{ + VALUE *vp; + long r; + + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + r = 0; + switch(vp->v_type) { + case V_OPTR: r = 1; break; + case V_VPTR: r = 2; break; + case V_SPTR: r = 3; break; + case V_NPTR: r = 4; break; + } + freevalue(stack); + stack->v_num = itoq(r); + stack->v_type = V_NUM; +} + + +static void +o_isdefined(void) +{ + VALUE *vp; + long r; + long index; + + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + if (vp->v_type != V_STR) { + math_error("Non-string argument for isdefined"); + /*NOTREACHED*/ + } + r = 0; + index = getbuiltinfunc(vp->v_str->s_str); + if (index >= 0) + r = 1; + else { + index = getuserfunc(vp->v_str->s_str); + if (index >= 0) + r = 2; + } + freevalue(stack); + stack->v_num = itoq(r); + stack->v_type = V_NUM; +} + + +static void +o_isobjtype(void) +{ + VALUE *vp; + long index; + + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + if (vp->v_type != V_STR) { + math_error("Non-string argument for isobjtype"); + /*NOTREACHED*/ + } + index = checkobject(vp->v_str->s_str); + freevalue(stack); + stack->v_num = itoq(index >= 0); + stack->v_type = V_NUM; +} + + static void o_issimple(void) { @@ -1438,65 +2278,62 @@ static void o_fiaddr(void) { register MATRIX *m; /* current matrix element */ - NUMBER *q; /* index value */ LIST *lp; /* list header */ ASSOC *ap; /* association header */ VALUE *vp; /* stack value */ long index; /* index value as an integer */ + VALUE *res; vp = stack; + res = NULL; if (vp->v_type == V_ADDR) vp = vp->v_addr; - if (vp->v_type != V_NUM) { - math_error("Fast indexing by non-number"); - /*NOTREACHED*/ - } - q = vp->v_num; - if (qisfrac(q)) { + if (vp->v_type != V_NUM || qisfrac(vp->v_num)) { math_error("Fast indexing by non-integer"); /*NOTREACHED*/ } - index = qtoi(q); - if (zge31b(q->num) || (index < 0)) { + index = qtoi(vp->v_num); + if (zge31b(vp->v_num->num) || (index < 0)) { math_error("Index out of range for fast indexing"); /*NOTREACHED*/ } if (stack->v_type == V_NUM) - qfree(q); + qfree(stack->v_num); stack--; vp = stack; if (vp->v_type != V_ADDR) { - math_error("Bad value for fast indexing"); + math_error("Non-pointer for fast indexing"); /*NOTREACHED*/ } - switch (vp->v_addr->v_type) { + vp = vp->v_addr; + switch (vp->v_type) { case V_OBJ: - if (index >= vp->v_addr->v_obj->o_actions->count) { + if (index >= vp->v_obj->o_actions->count) { math_error("Index out of bounds for object"); /*NOTREACHED*/ } - vp->v_addr = vp->v_addr->v_obj->o_table + index; + res = vp->v_obj->o_table + index; break; case V_MAT: - m = vp->v_addr->v_mat; + m = vp->v_mat; if (index >= m->m_size) { math_error("Index out of bounds for matrix"); /*NOTREACHED*/ } - vp->v_addr = m->m_table + index; + res = m->m_table + index; break; case V_LIST: - lp = vp->v_addr->v_list; - vp->v_addr = listfindex(lp, index); - if (vp->v_addr == NULL) { + lp = vp->v_list; + res = listfindex(lp, index); + if (res == NULL) { math_error("Index out of bounds for list"); /*NOTREACHED*/ } break; case V_ASSOC: - ap = vp->v_addr->v_assoc; - vp->v_addr = assocfindex(ap, index); - if (vp->v_addr == NULL) { + ap = vp->v_assoc; + res = assocfindex(ap, index); + if (res == NULL) { math_error("Index out of bounds for association"); /*NOTREACHED*/ } @@ -1505,6 +2342,7 @@ o_fiaddr(void) math_error("Bad variable type for fast indexing"); /*NOTREACHED*/ } + stack->v_addr = res; } @@ -1861,12 +2699,18 @@ o_le(void) relvalue(v1, v2, &tmp); freevalue(stack--); freevalue(stack); - if (tmp.v_type == V_NUM && !qispos(tmp.v_num)) - stack->v_num = qlink(&_qone_); - else - stack->v_num = qlink(&_qzero_); - freevalue(&tmp); + stack->v_type = V_NUM; + if (tmp.v_type == V_NUM) { + stack->v_num = !qispos(tmp.v_num) ? qlink(&_qone_): + qlink(&_qzero_); + } + else if (tmp.v_type == V_COM) { + stack->v_num = qlink(&_qzero_); + } + else + stack->v_type = V_NULL; + freevalue(&tmp); } @@ -1885,12 +2729,18 @@ o_ge(void) relvalue(v1, v2, &tmp); freevalue(stack--); freevalue(stack); - if (tmp.v_type == V_NUM && !qisneg(tmp.v_num)) - stack->v_num = qlink(&_qone_); - else - stack->v_num = qlink(&_qzero_); - freevalue(&tmp); stack->v_type = V_NUM; + if (tmp.v_type == V_NUM) { + stack->v_num = !qisneg(tmp.v_num) ? qlink(&_qone_): + qlink(&_qzero_); + } + else if (tmp.v_type == V_COM) { + stack->v_num = qlink(&_qzero_); + } + else { + stack->v_type = V_NULL; + } + freevalue(&tmp); } @@ -1909,12 +2759,17 @@ o_lt(void) relvalue(v1, v2, &tmp); freevalue(stack--); freevalue(stack); - if (tmp.v_type == V_NUM && qisneg(tmp.v_num)) - stack->v_num = qlink(&_qone_); - else - stack->v_num = qlink(&_qzero_); - freevalue(&tmp); stack->v_type = V_NUM; + if (tmp.v_type == V_NUM) { + stack->v_num = qisneg(tmp.v_num) ? qlink(&_qone_): + qlink(&_qzero_); + } + else if (tmp.v_type == V_COM) { + stack->v_num = qlink(&_qzero_); + } + else + stack->v_type = V_NULL; + freevalue(&tmp); } @@ -1933,33 +2788,39 @@ o_gt(void) relvalue(v1, v2, &tmp); freevalue(stack--); freevalue(stack); - if (tmp.v_type == V_NUM && qispos(tmp.v_num)) - stack->v_num = qlink(&_qone_); - else - stack->v_num = qlink(&_qzero_); - freevalue(&tmp); stack->v_type = V_NUM; + if (tmp.v_type == V_NUM) { + stack->v_num = qispos(tmp.v_num) ? qlink(&_qone_): + qlink(&_qzero_); + } + else if (tmp.v_type == V_COM) { + stack->v_num = qlink(&_qzero_); + } + else + stack->v_type = V_NULL; + freevalue(&tmp); } static void o_preinc(void) { - NUMBER *q, **np; VALUE *vp, tmp; + if (stack->v_type == V_OCTET) { + stack->v_octet[0] = stack->v_octet[0] + 1; + return; + } if (stack->v_type != V_ADDR) { math_error("Preincrementing non-variable"); /*NOTREACHED*/ } - if (stack->v_addr->v_type == V_NUM) { - np = &stack->v_addr->v_num; - q = qinc(*np); - qfree(*np); - *np = q; - return; - } vp = stack->v_addr; + + if (vp->v_subtype & V_NOASSIGNTO) { + math_error("No-assign-to variable for pre ++"); + /*NOTREACHED*/ + } incvalue(vp, &tmp); freevalue(vp); *vp = tmp; @@ -1969,21 +2830,21 @@ o_preinc(void) static void o_predec(void) { - NUMBER *q, **np; VALUE *vp, tmp; + if (stack->v_type == V_OCTET) { + --(*stack->v_octet); + return; + } if (stack->v_type != V_ADDR) { math_error("Predecrementing non-variable"); /*NOTREACHED*/ } - if (stack->v_addr->v_type == V_NUM) { - np = &stack->v_addr->v_num; - q = qdec(*np); - qfree(*np); - *np = q; - return; - } vp = stack->v_addr; + if (vp->v_subtype & V_NOASSIGNTO) { + math_error("No-assign-to variable for pre --"); + /*NOTREACHED*/ + } decvalue(vp, &tmp); freevalue(vp); *vp = tmp; @@ -1996,16 +2857,29 @@ o_postinc(void) VALUE *vp; VALUE tmp; + if (stack->v_type == V_OCTET) { + stack[1] = stack[0]; + stack->v_type = V_NUM; + stack->v_num = itoq((long) stack->v_octet[0]); + stack++; + stack->v_octet[0]++; + return; + } if (stack->v_type != V_ADDR) { math_error("Postincrementing non-variable"); /*NOTREACHED*/ } vp = stack->v_addr; + if (vp->v_subtype & V_NOASSIGNTO) { + math_error("No-assign-to variable for post ++"); + /*NOTREACHED*/ + } copyvalue(vp, stack++); incvalue(vp, &tmp); freevalue(vp); *vp = tmp; stack->v_type = V_ADDR; + stack->v_subtype = V_NOSUBTYPE; stack->v_addr = vp; } @@ -2016,17 +2890,30 @@ o_postdec(void) VALUE *vp; VALUE tmp; + if (stack->v_type == V_OCTET) { + stack[1] = stack[0]; + stack->v_type = V_NUM; + stack->v_num = itoq((long) stack->v_octet[0]); + stack++; + stack->v_octet[0]--; + return; + } if (stack->v_type != V_ADDR) { math_error("Postdecrementing non-variable"); /*NOTREACHED*/ } vp = stack->v_addr; + if (vp->v_subtype & V_NOASSIGNTO) { + math_error("No-assign-to variable for post --"); + /*NOTREACHED*/ + } copyvalue(vp, stack++); decvalue(vp, &tmp); freevalue(vp); *vp = tmp; stack->v_type = V_ADDR; stack->v_addr = vp; + stack->v_subtype = V_NOSUBTYPE; } @@ -2135,8 +3022,13 @@ o_printspace(void) /*ARGSUSED*/ static void -o_printstring(FUNC *fp, char *cp) +o_printstring(FUNC *fp, long index) { + STRING *s; + char *cp; + + s = findstring(index); + cp = s->s_str; math_str(cp); if (conf->traceflags & TRACE_OPCODES) printf("\n"); @@ -2167,24 +3059,49 @@ o_save(FUNC *fp) { VALUE *vp; - vp = stack; - if (vp->v_type == V_ADDR) - vp = vp->v_addr; - freevalue(&fp->f_savedvalue); - copyvalue(vp, &fp->f_savedvalue); + if (saveval || fp->f_name[1] == '*') { + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + freevalue(&fp->f_savedvalue); + copyvalue(vp, &fp->f_savedvalue); + } } static void o_oldvalue(void) { - copyvalue(&oldvalue, ++stack); + ++stack; + stack->v_type = V_ADDR; + stack->v_addr = &oldvalue; +} + + +void +o_setsaveval(void) +{ + VALUE *vp; + + vp = stack; + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + saveval = testvalue(vp); + freevalue(stack); } static void -o_quit(FUNC *fp, char *cp) +o_quit(FUNC *fp, long index) { + STRING *s; + char *cp; + + cp = NULL; + if (index >= 0) { + s = findstring(index); + cp = s->s_str; + } if ((fp->f_name[0] == '*') && (fp->f_name[1] == '\0')) { if (cp) printf("%s\n", cp); @@ -2193,14 +3110,14 @@ o_quit(FUNC *fp, char *cp) freevalue(stack--); } freevalue(stackarray); + libcalc_call_me_last(); exit(0); } - if (cp) { - math_error("%s", cp); - /*NOTREACHED*/ - } - math_error("quit statement executed"); - /*NOTREACHED*/ + if (cp) + printf("%s\n", cp); + else + printf("Quit statement executed\n"); + go = FALSE; } @@ -2252,9 +3169,10 @@ o_setconfig(void) math_error("Non-string for config"); /*NOTREACHED*/ } - type = configtype(v1->v_str); + type = configtype(v1->v_str->s_str); if (type < 0) { - math_error("Unknown config name \"%s\"", v1->v_str); + math_error("Unknown config name \"%s\"", + v1->v_str->s_str); /*NOTREACHED*/ } config_value(conf, type, &tmp); @@ -2278,9 +3196,10 @@ o_getconfig(void) math_error("Non-string for config"); /*NOTREACHED*/ } - type = configtype(vp->v_str); + type = configtype(vp->v_str->s_str); if (type < 0) { - math_error("Unknown config name \"%s\"", vp->v_str); + math_error("Unknown config name \"%s\"", + vp->v_str->s_str); /*NOTREACHED*/ } freevalue(stack); @@ -2303,35 +3222,7 @@ updateoldvalue(FUNC *fp) /* - * Routine called on any runtime error, to complain about it (with possible - * arguments), and then longjump back to the top level command scanner. - */ -void -math_error(char *fmt, ...) -{ - va_list ap; - char buf[MAXERROR+1]; - - if (funcname && (*funcname != '*')) - fprintf(stderr, "\"%s\": ", funcname); - if (funcline && ((funcname && (*funcname != '*')) || !inputisterminal())) - fprintf(stderr, "line %ld: ", funcline); - va_start(ap, fmt); - vsprintf(buf, fmt, ap); - va_end(ap); - fprintf(stderr, "%s\n", buf); - funcname = NULL; - if (post_init) { - longjmp(jmpbuf, 1); - } else { - fprintf(stderr, "no jmpbuf jumpback point - ABORTING!!!\n"); - exit(3); - } -} - - -/* - * error_value - return error as a value + * error_value - return error as a value and store type in calc_errno */ VALUE error_value(int e) @@ -2340,7 +3231,58 @@ error_value(int e) if (-e > 0) e = 0; - res.v_type = -e; + calc_errno = e; + if (e > 0) + errcount++; + if (errcount > errmax && !ign_errmax) { + math_error("Error %d caused errcount to exceed errmax", e); + /*NOTREACHED*/ + } + res.v_type = (short) -e; + return res; +} + +/* + * set_errno - return and set calc_errno + */ +int +set_errno(int e) +{ + int res; + + res = calc_errno; + if (e >= 0) + calc_errno = e; + return res; +} + + +/* + * set_errcount - return and set errcount + */ +int +set_errcount(int e) +{ + int res; + + res = errcount; + if (e >= 0) + errcount = e; + return res; +} + + +/* + * set_errno - return and set errno + */ +int +set_errmax(int e) +{ + int res; + + res = errmax; + if (e >= 0) + errmax = e; return res; } @@ -2348,7 +3290,6 @@ error_value(int e) /* * Fill a newly created matrix at v1 with copies of value at v2. */ - static void o_initfill(void) { @@ -2373,7 +3314,7 @@ o_initfill(void) copyvalue(v2, vp++); freevalue(stack--); } - + /*ARGSUSED*/ static void @@ -2390,8 +3331,18 @@ o_show(FUNC *fp, long arg) case 6: showobjtypes(); return; case 7: showfiles(); return; case 8: showsizes(); return; + case 9: showerrors(); return; + case 10: showcustom(); return; + case 11: shownblocks(); return; + case 12: showconstants(); return; + case 13: showallglobals(); return; + case 14: showstatics(); return; + case 15: shownumbers(); return; + case 16: showredcdata(); return; + case 17: showstrings(); return; + case 18: showliterals(); return; } - fp = findfunc(arg - 9); + fp = findfunc(arg - 19); if (fp == NULL) { printf("Function not defined\n"); return; @@ -2420,6 +3371,7 @@ showsizes(void) printf("\tNUMBER\t\t%4ld\n", (long)sizeof(NUMBER)); printf("\tZVALUE\t\t%4ld\n", (long)sizeof(ZVALUE)); printf("\tCOMPLEX\t\t%4ld\n", (long)sizeof(COMPLEX)); + printf("\tSTRING\t\t%4ld\n", (long)sizeof(STRING)); printf("\tMATRIX\t\t%4ld\n", (long)sizeof(MATRIX)); printf("\tLIST\t\t%4ld\n", (long)sizeof(LIST)); printf("\tLISTELEM\t%4ld\n", (long)sizeof(LISTELEM)); @@ -2427,6 +3379,8 @@ showsizes(void) printf("\tOBJECTACTIONS\t%4ld\n", (long)sizeof(OBJECTACTIONS)); printf("\tASSOC\t\t%4ld\n", (long)sizeof(ASSOC)); printf("\tASSOCELEM\t%4ld\n", (long)sizeof(ASSOCELEM)); + printf("\tBLOCK\t\t%4ld\n", (long)sizeof(BLOCK)); + printf("\tNBLOCK\t\t%4ld\n", (long)sizeof(NBLOCK)); printf("\tCONFIG\t\t%4ld\n", (long)sizeof(CONFIG)); printf("\tFILEIO\t\t%4ld\n", (long)sizeof(FILEIO)); printf("\tRAND\t\t%4ld\n", (long)sizeof(RAND)); @@ -2486,12 +3440,12 @@ static struct opcode opcodes[MAX_OPCODE+1] = { {o_one, OPNUL, "ONE"}, /* put one on the stack */ {o_printeol, OPNUL, "PRINTEOL"}, /* print end of line */ {o_printspace, OPNUL, "PRINTSPACE"}, /* print a space */ - {o_printstring, OPSTR, "PRINTSTR"}, /* print constant string */ + {o_printstring, OPONE, "PRINTSTR"}, /* print constant string */ {o_dupvalue, OPNUL, "DUPVALUE"}, /* duplicate value of top value */ {o_oldvalue, OPNUL, "OLDVALUE"}, /* old value from previous calc */ {o_quo, OPNUL, "QUO"}, /* integer quotient of top values */ {o_power, OPNUL, "POWER"}, /* value raised to a power */ - {o_quit, OPSTR, "QUIT"}, /* quit program */ + {o_quit, OPONE, "QUIT"}, /* quit program */ {o_call, OPTWO, "CALL"}, /* call built-in routine */ {o_getepsilon, OPNUL, "GETEPSILON"}, /* get allowed error for calculations */ {o_and, OPNUL, "AND"}, /* arithmetic and or top two values */ @@ -2503,7 +3457,7 @@ static struct opcode opcodes[MAX_OPCODE+1] = { {o_condorjump, OPJMP, "CONDORJUMP"}, /* conditional or jump */ {o_condandjump, OPJMP, "CONDANDJUMP"}, /* conditional and jump */ {o_square, OPNUL, "SQUARE"}, /* square top value */ - {o_string, OPSTR, "STRING"}, /* string constant value */ + {o_string, OPONE, "STRING"}, /* string constant value */ {o_isnum, OPNUL, "ISNUM"}, /* whether value is a number */ {o_undef, OPNUL, "UNDEF"}, /* load undefined value on stack */ {o_isnull, OPNUL, "ISNULL"}, /* whether value is the null value */ @@ -2547,7 +3501,28 @@ static struct opcode opcodes[MAX_OPCODE+1] = { {o_isrand, OPNUL, "ISRAND"}, /* whether value is a rand element */ {o_israndom, OPNUL, "ISRANDOM"}, /* whether value is a random element */ {o_show, OPONE, "SHOW"}, /* show current state data */ - {o_initfill, OPNUL, "INITFILL"} /* initially fill matrix */ + {o_initfill, OPNUL, "INITFILL"}, /* initially fill matrix */ + {o_assignback, OPNUL, "ASSIGNBACK"}, /* assign in reverse order */ + {o_test, OPNUL, "TEST"}, /* test that value is "nonzero" */ + {o_isdefined, OPNUL, "ISDEFINED"}, /* whether a string names a function */ + {o_isobjtype, OPNUL, "ISOBJTYPE"}, /* whether a string names an object type */ + {o_isblock, OPNUL, "ISBLK"}, /* whether value is a block */ + {o_ptr, OPNUL, "PTR"}, /* octet pointer */ + {o_deref, OPNUL, "DEREF"}, /* dereference an octet pointer */ + {o_isoctet, OPNUL, "ISOCTET"}, /* whether a value is an octet */ + {o_isptr, OPNUL, "ISPTR"}, /* whether a value is a pointer */ + {o_setsaveval, OPNUL, "SAVEVAL"}, /* enable or disable saving */ + {o_links, OPNUL, "LINKS"}, /* links to number or string */ + {o_bit, OPNUL, "BIT"}, /* whether bit is set */ + {o_comp, OPNUL, "COMP"}, /* complement value */ + {o_xor, OPNUL, "XOR"}, /* xor (~) of values */ + {o_highbit, OPNUL, "HIGHBIT"}, /* highbit of value */ + {o_lowbit, OPNUL, "LOWBIT"}, /* lowbit of value */ + {o_content, OPNUL, "CONTENT"}, /* unary hash op */ + {o_hashop, OPNUL, "HASHOP"}, /* binary hash op */ + {o_backslash, OPNUL, "BACKSLASH"}, /* unary backslash op */ + {o_setminus, OPNUL, "SETMINUS"}, /* binary backslash op */ + {o_plus, OPNUL, "PLUS"} /* unary + op */ }; @@ -2580,10 +3555,12 @@ calculate(FUNC *fp, int argcount) oldline = funcline; funcname = fp->f_name; funcline = 0; + go = TRUE; origargcount = argcount; while (argcount < fp->f_paramcount) { stack++; stack->v_type = V_NULL; + stack->v_subtype = V_NOSUBTYPE; argcount++; } locals = localtable; @@ -2602,7 +3579,7 @@ calculate(FUNC *fp, int argcount) pc = 0; beginstack = stack; args = beginstack - (argcount - 1); - for (;;) { + while (go) { if (abortlevel >= ABORT_OPCODE) { math_error("Calculation aborted in opcode"); /*NOTREACHED*/ @@ -2657,7 +3634,6 @@ calculate(FUNC *fp, int argcount) break; case OPGLB: /* global symbol reference (pointer arg) */ - case OPSTR: /* string constant address */ /* ignore Saber-C warning #68 - benign type mismatch */ /* ok to ignore in proc calculate */ (*op->o_func)(fp, *((char **) &fp->f_opcodes[pc])); @@ -2687,15 +3663,12 @@ calculate(FUNC *fp, int argcount) math_error("Misaligned stack"); /*NOTREACHED*/ } - if (argcount <= 0) { - funcname = oldname; - funcline = oldline; - return; + if (argcount > 0) { + retval = *stack--; + while (--argcount >= 0) + freevalue(stack--); + *++stack = retval; } - retval = *stack--; - while (--argcount >= 0) - freevalue(stack--); - *++stack = retval; funcname = oldname; funcline = oldline; return; @@ -2709,6 +3682,16 @@ calculate(FUNC *fp, int argcount) /*NOTREACHED*/ } } + for (i = 0; i < fp->f_localcount; i++) + freevalue(&locals[i]); + if (locals != localtable) + free(locals); + printf("\t\"%s\": line %ld\n", funcname, funcline); + while (stack > beginstack) + freevalue(stack--); + funcname = oldname; + funcline = oldline; + return; } @@ -2722,6 +3705,7 @@ calculate(FUNC *fp, int argcount) int dumpop(unsigned long *pc) { + GLOBAL *sp; unsigned long op; /* opcode number */ op = *pc++; @@ -2737,7 +3721,11 @@ dumpop(unsigned long *pc) printf(" %ld\n", *pc); return 2; case OP_GLOBALADDR: case OP_GLOBALVALUE: - printf(" %s\n", globalname(*((GLOBAL **) pc))); + sp = * (GLOBAL **) pc; + printf(" %s", sp->g_name); + if (sp->g_filescope > SCOPE_GLOBAL) + printf(" %p", (void *) &sp->g_value); + putchar('\n'); return (1 + PTR_SIZE); case OP_PARAMADDR: case OP_PARAMVALUE: if (dumpnames) @@ -2746,14 +3734,11 @@ dumpop(unsigned long *pc) printf(" %ld\n", *pc); return 2; case OP_PRINTSTRING: case OP_STRING: - printf(" \"%s\"\n", *((char **) pc)); - return (1 + PTR_SIZE); + printf(" \"%s\"\n", findstring((long)(*pc))->s_str); + return 2; case OP_QUIT: - if (*(char **) pc) - printf(" \"%s\"\n", *((char **) pc)); - else - printf("\n"); - return (1 + PTR_SIZE); + printf(" \"%s\"\n", findstring((long)(*pc))->s_str); + return 2; case OP_INDEXADDR: printf(" %ld %ld\n", pc[0], pc[1]); return 3; @@ -2784,3 +3769,59 @@ dumpop(unsigned long *pc) return 1; } } + + +/* + * Free the constant numbers in a function definition + */ +void +freenumbers(FUNC *fp) +{ + unsigned long pc; + unsigned int opnum; + struct opcode *op; + + for (pc = 0; pc < fp->f_opcodecount; ) { + opnum = fp->f_opcodes[pc++]; + op = &opcodes[opnum]; + switch (op->o_type) { + case OPRET: + case OPARG: + case OPNUL: + continue; + case OPONE: + switch(opnum) { + case OP_NUMBER: + case OP_IMAGINARY: + freeconstant(fp->f_opcodes[pc]); + break; + case OP_PRINTSTRING: + case OP_STRING: + case OP_QUIT: + freestringconstant( + (long)fp->f_opcodes[pc]); + } + /*FALLTHRU*/ + case OPLOC: + case OPPAR: + case OPJMP: + case OPSTI: + pc++; + continue; + case OPTWO: + pc += 2; + continue; + case OPGLB: + pc += PTR_SIZE; + continue; + default: + math_error("Unknown opcode type for freeing"); + /*NOTREACHED*/ + } + } + if (pc != fp->f_opcodecount) { + math_error("Incorrect opcodecount ???"); + /*NOTREACHED*/ + } + trimconstants(); +} diff --git a/opcodes.h b/opcodes.h index 8a624e4..a0229dc 100644 --- a/opcodes.h +++ b/opcodes.h @@ -1,11 +1,12 @@ /* - * Copyright (c) 1993 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. */ -#ifndef OPCODES_H -#define OPCODES_H + +#if !defined(__OPCODES_H__) +#define __OPCODES_H__ /* @@ -121,8 +122,35 @@ #define OP_ISRANDOM 107L /* whether value is a Blum random state */ #define OP_SHOW 108L /* show data about current state */ #define OP_INITFILL 109L /* fill new matrix with copies of a value */ -#define MAX_OPCODE 109L /* highest legal opcode */ +#define OP_ASSIGNBACK 110L /* assign in reverse order */ +#define OP_TEST 111L /* test whether value is "nonzero" */ +#define OP_ISDEFINED 112L /* whether string names a function */ +#define OP_ISOBJTYPE 113L /* whether string names an object type */ +#define OP_ISBLK 114L /* whether value is a block */ +#define OP_PTR 115L /* octet pointer */ +#define OP_DEREF 116L /* dereference an octet pointer */ +#define OP_ISOCTET 117L /* whether value is an octet */ +#define OP_ISPTR 118L /* whether value is a pointer */ +#define OP_SAVEVAL 119L /* activate updating */ +#define OP_LINKS 120L /* return links for numbers and strings */ +#define OP_BIT 121L /* whether specified bit is set */ +#define OP_COMP 122L /* complement value */ +#define OP_XOR 123L /* xor (~) of values */ +#define OP_HIGHBIT 124L /* index of high bit of value */ +#define OP_LOWBIT 125L /* index of low bit of value */ +#define OP_CONTENT 126L /* value returned by unary # */ +#define OP_HASHOP 127L /* binary # */ +#define OP_BACKSLASH 128L /* unary backslash */ +#define OP_SETMINUS 129L /* binary backslash */ +#define OP_PLUS 130L /* unary + */ +#define MAX_OPCODE 130L /* highest legal opcode */ -#endif -/* END CODE */ +/* + * external declarations + */ +extern char *funcname; /* function being executed */ +extern long funcline; /* function line being executed */ + + +#endif /* !__OPCODES_H__ */ diff --git a/prime.c b/prime.c index 6d05335..6a93e15 100644 --- a/prime.c +++ b/prime.c @@ -911,11 +911,11 @@ CONST unsigned short prime[MAP_POPCNT+1] = { #if BASEB == 32 static CONST HALF _nxt_prime_val_[] = { 0xf, 0x1 }; ZVALUE CONST _nxt_prime_ = { (HALF *)_nxt_prime_val_, 2, 0 }; -NUMBER _nxtprime_ = { { (HALF *)_nxt_prime_val_, 2, 0}, { _oneval_, 1, 0 }, 1 }; +NUMBER _nxtprime_ = {{(HALF *)_nxt_prime_val_,2,0}, {_oneval_,1,0}, 1, NULL}; #else static CONST HALF _nxt_prime_val_[] = { 0xf, 0x0, 0x1 }; ZVALUE CONST _nxt_prime_ = { (HALF *)_nxt_prime_val_, 3, 0 }; -NUMBER _nxtprime_ = { { (HALF *)_nxt_prime_val_, 3, 0}, { _oneval_, 1, 0 }, 1 }; +NUMBER _nxtprime_ = {{(HALF *)_nxt_prime_val_,3,0}, {_oneval_,1,0}, 1, NULL}; #endif /* diff --git a/prime.h b/prime.h index f6516a7..2c8f5c4 100644 --- a/prime.h +++ b/prime.h @@ -1,5 +1,5 @@ /* - * 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, @@ -22,6 +22,11 @@ * chongo was here /\../\ */ + +#if !defined(__PRIME_H__) +#define __PRIME_H__ + + #include "qmath.h" #include "have_const.h" @@ -73,3 +78,6 @@ extern CONST unsigned short pi18b[]; extern NUMBER _nxtprime_; /* 2^32+15 - smallest prime > 2^32 */ extern CONST ZVALUE _nxt_prime_; /* 2^32+15 - smallest prime > 2^32 */ extern CONST ZVALUE _jmpmod2_; /* JMPMOD*2 as a ZVALUE */ + + +#endif /* !__PRIME_H__ */ diff --git a/qfunc.c b/qfunc.c index 4584722..17faadb 100644 --- a/qfunc.c +++ b/qfunc.c @@ -1,5 +1,5 @@ /* - * Copyright (c) 1996 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. * @@ -156,14 +156,14 @@ qpowi(NUMBER *q1, NUMBER *q2) { register NUMBER *r; BOOL invert, sign; - ZVALUE num, den, z2; + ZVALUE num, zden, z2; if (qisfrac(q2)) { math_error("Raising number to fractional power"); /*NOTREACHED*/ } num = q1->num; - den = q1->den; + zden = q1->den; z2 = q2->num; sign = (num.sign && zisodd(z2)); invert = z2.sign; @@ -179,7 +179,7 @@ qpowi(NUMBER *q1, NUMBER *q2) } return qlink(&_qzero_); } - if (zisunit(num) && zisunit(den)) { /* 1 or -1 raised to a power */ + if (zisunit(num) && zisunit(zden)) { /* 1 or -1 raised to a power */ r = (sign ? q1 : &_qone_); r->links++; return r; @@ -197,8 +197,8 @@ qpowi(NUMBER *q1, NUMBER *q2) r = qalloc(); if (!zisunit(num)) zpowi(num, z2, &r->num); - if (!zisunit(den)) - zpowi(den, z2, &r->den); + if (!zisunit(zden)) + zpowi(zden, z2, &r->den); if (invert) { z2 = r->num; r->num = r->den; @@ -223,9 +223,9 @@ qhypot(NUMBER *q1, NUMBER *q2, NUMBER *epsilon) /*NOTREACHED*/ } if (qiszero(q1)) - return qabs(q2); + return qqabs(q2); if (qiszero(q2)) - return qabs(q1); + return qqabs(q1); tmp1 = qsquare(q1); tmp2 = qsquare(q2); tmp3 = qqadd(tmp1, tmp2); @@ -788,37 +788,125 @@ qlcmfact(NUMBER *q) /* - * Compute the permutation function M! / (M - N)!. + * Compute the permutation function q1 * (q1-1) * ... * (q1-q2+1). */ NUMBER * qperm(NUMBER *q1, NUMBER *q2) { - register NUMBER *r; + NUMBER *r; + NUMBER *qtmp1, *qtmp2; + long i; - if (qisfrac(q1) || qisfrac(q2)) { - math_error("Non-integral arguments for permutation"); + if (qisfrac(q2)) { + math_error("Non-integral second arg for permutation"); /*NOTREACHED*/ } - r = qalloc(); - zperm(q1->num, q2->num, &r->num); + if (qiszero(q2)) + return qlink(&_qone_); + if (qisone(q2)) + return qlink(q1); + if (qisint(q1) && !qisneg(q1)) { + if (qrel(q2, q1) > 0) + return qlink(&_qzero_); + if (qispos(q2)) { + r = qalloc(); + zperm(q1->num, q2->num, &r->num); + return r; + } + } + if (zge31b(q2->num)) { + math_error("Too large arg2 for permutation"); + /*NOTREACHED*/ + } + i = qtoi(q2); + if (i > 0) { + q1 = qlink(q1); + r = qlink(q1); + while (--i > 0) { + qtmp1 = qdec(q1); + qtmp2 = qmul(r, qtmp1); + qfree(q1); + q1 = qtmp1; + qfree(r); + r = qtmp2; + } + qfree(q1); + return r; + } + i = -i; + qtmp1 = qinc(q1); + r = qinv(qtmp1); + while (--i > 0) { + qtmp2 = qinc(qtmp1); + qfree(qtmp1); + qtmp1 = qqdiv(r, qtmp2); + qfree(r); + r = qtmp1; + qtmp1 = qtmp2; + } + qfree(qtmp1); return r; } /* - * Compute the combinatorial function M! / (N! * (M - N)!). + * Compute the combinatorial function q1 * (q1-1) * ... * (q1-q2+1)/q2! */ NUMBER * qcomb(NUMBER *q1, NUMBER *q2) { - register NUMBER *r; + NUMBER *r; + NUMBER *qtmp1, *qtmp2; + long i, j; - if (qisfrac(q1) || qisfrac(q2)) { - math_error("Non-integral arguments for combinatorial"); + if (qisfrac(q2)) { + math_error("Non-integral second argument for comb"); /*NOTREACHED*/ } - r = qalloc(); - zcomb(q1->num, q2->num, &r->num); + if (qisneg(q2)) + return qlink(&_qzero_); + if (qiszero(q2) || qcmp(q1, q2) == 0) + return qlink(&_qone_); + if (qisone(q2)) + return qlink(q1); + if (qisint(q1)) { + if (qisneg(q1)) { + qtmp1 = qsub(q2, q1); + qtmp2 = qdec(qtmp1); + qfree(qtmp1); + r = qalloc(); + zcomb(qtmp2->num, q2->num, &r->num); + qfree(qtmp2); + if (qiseven(q2)) + return r; + qtmp2 = qneg(r); + qfree(r); + return qtmp2; + } + if (qrel(q2, q1) > 0) + return qlink(&_qzero_); + r = qalloc(); + zcomb(q1->num, q2->num, &r->num); + return r; + } + if (zge31b(q2->num)) { + math_error("Too large second argument for comb"); + /*NOTREACHED*/ + } + i = qtoi(q2); + q1 = qlink(q1); + r = qlink(q1); + j = 1; + while (--i > 0) { + qtmp1 = qdec(q1); + qfree(q1); + q1 = qtmp1; + qtmp2 = qmul(r, q1); + qfree(r); + r = qdivi(qtmp2, ++j); + qfree(qtmp2); + } + qfree(q1); return r; } @@ -871,7 +959,7 @@ qtrunc(NUMBER *q1, NUMBER *q2) math_error("Bad number of places for qtrunc"); /*NOTREACHED*/ } - places = z1tol(q2->num); + places = qtoi(q2); e = qtenpow(-places); r = qmappr(q1, e, 2); qfree(e); @@ -895,7 +983,7 @@ qbtrunc(NUMBER *q1, NUMBER *q2) math_error("Bad number of places for qtrunc"); /*NOTREACHED*/ } - places = z1tol(q2->num); + places = qtoi(q2); e = qbitvalue(-places); r = qmappr(q1, e, 2); qfree(e); @@ -984,7 +1072,7 @@ NUMBER * qcfappr(NUMBER *q, NUMBER *epsilon, long rnd) { NUMBER *res, etemp, *epsilon1; - ZVALUE num, den, oldnum, oldden; + ZVALUE num, zden, oldnum, oldden; ZVALUE rem, oldrem, quot; ZVALUE tmp1, tmp2, tmp3, tmp4; ZVALUE denbnd; @@ -1034,10 +1122,10 @@ qcfappr(NUMBER *q, NUMBER *epsilon, long rnd) oldden = _zero_; zcopy(q->den, &oldrem); zdiv(q->num, q->den, &num, &rem, 0); - den = _one_; + zden = _one_; for (;;) { if (!bnddencase) { - zmul(f, den, &tmp1); + zmul(f, zden, &tmp1); zmul(g, rem, &tmp2); if (ziszero(rem) || (s >= 0 && zrel(tmp1,tmp2) >= 0)) break; @@ -1048,12 +1136,12 @@ qcfappr(NUMBER *q, NUMBER *epsilon, long rnd) zfree(oldrem); oldrem = rem; rem = tmp1; - zmul(quot, den, &tmp1); + zmul(quot, zden, &tmp1); zadd(tmp1, oldden, &tmp2); zfree(tmp1); zfree(oldden); - oldden = den; - den = tmp2; + oldden = zden; + zden = tmp2; zmul(quot, num, &tmp1); zadd(tmp1, oldnum, &tmp2); zfree(tmp1); @@ -1062,7 +1150,7 @@ qcfappr(NUMBER *q, NUMBER *epsilon, long rnd) num = tmp2; zfree(quot); if (bnddencase) { - if (zrel(den, denbnd) >= 0) + if (zrel(zden, denbnd) >= 0) break; } s = -s; @@ -1071,7 +1159,7 @@ qcfappr(NUMBER *q, NUMBER *epsilon, long rnd) if (s > 0) useold = TRUE; else { - zsub(den, denbnd, &tmp1); + zsub(zden, denbnd, &tmp1); zquo(tmp1, oldden, &k, 1); zfree(tmp1); } @@ -1086,7 +1174,7 @@ qcfappr(NUMBER *q, NUMBER *epsilon, long rnd) zfree(oldnum); zfree(oldden); zfree(num); - zfree(den); + zfree(zden); zfree(oldrem); zfree(rem); return qlink(q); @@ -1112,10 +1200,10 @@ qcfappr(NUMBER *q, NUMBER *epsilon, long rnd) zfree(num); num = tmp2; zmul(k, oldden, &tmp1); - zsub(den, tmp1, &tmp2); + zsub(zden, tmp1, &tmp2); zfree(tmp1); - zfree(den); - den = tmp2; + zfree(zden); + zden = tmp2; } if (bnddencase && s == 0) { zmul(k, oldrem, &tmp1); @@ -1124,7 +1212,7 @@ qcfappr(NUMBER *q, NUMBER *epsilon, long rnd) zfree(rem); rem = tmp2; zmul(rem, oldden, &tmp1); - zmul(den, oldrem, &tmp2); + zmul(zden, oldrem, &tmp2); useold = (zrel(tmp1, tmp2) >= 0); zfree(tmp1); zfree(tmp2); @@ -1136,7 +1224,7 @@ qcfappr(NUMBER *q, NUMBER *epsilon, long rnd) res = qalloc(); if (useold) { zfree(num); - zfree(den); + zfree(zden); res->num = oldnum; res->den = oldden; return res; @@ -1144,7 +1232,7 @@ qcfappr(NUMBER *q, NUMBER *epsilon, long rnd) zfree(oldnum); zfree(oldden); res->num = num; - res->den = den; + res->den = zden; return res; } @@ -1271,7 +1359,7 @@ qgcd(NUMBER *q1, NUMBER *q2) NUMBER *q; if (q1 == q2) - return qabs(q1); + return qqabs(q1); if (qisfrac(q1) || qisfrac(q2)) { q = qalloc(); zgcd(q1->num, q2->num, &q->num); @@ -1279,9 +1367,9 @@ qgcd(NUMBER *q1, NUMBER *q2) return q; } if (qiszero(q1)) - return qabs(q2); + return qqabs(q2); if (qiszero(q2)) - return qabs(q1); + return qqabs(q1); if (qisunit(q1) || qisunit(q2)) return qlink(&_qone_); zgcd(q1->num, q2->num, &z); @@ -1307,11 +1395,11 @@ qlcm(NUMBER *q1, NUMBER *q2) if (qiszero(q1) || qiszero(q2)) return qlink(&_qzero_); if (q1 == q2) - return qabs(q1); + return qqabs(q1); if (qisunit(q1)) - return qabs(q2); + return qqabs(q2); if (qisunit(q2)) - return qabs(q1); + return qqabs(q1); q = qalloc(); zlcm(q1->num, q2->num, &q->num); if (qisfrac(q1) || qisfrac(q2)) @@ -1336,7 +1424,7 @@ qfacrem(NUMBER *q1, NUMBER *q2) /*NOTREACHED*/ } if (qiszero(q2)) - return qabs(q1); + return qqabs(q1); if (qiszero(q1)) return qlink(&_qzero_); count = zfacrem(q1->num, q2->num, &tmp); diff --git a/qio.c b/qio.c index 17a1e2f..81970f3 100644 --- a/qio.c +++ b/qio.c @@ -343,21 +343,21 @@ qprintfe(NUMBER *q, long width, long precision) { long exponent; NUMBER q2; - ZVALUE num, den, tenpow, tmp; + ZVALUE num, zden, tenpow, tmp; if (qiszero(q)) { PUTSTR("0.0"); return; } num = q->num; - den = q->den; + zden = q->den; num.sign = 0; - exponent = zdigits(num) - zdigits(den); + exponent = zdigits(num) - zdigits(zden); if (exponent > 0) { ztenpow(exponent, &tenpow); - zmul(den, tenpow, &tmp); + zmul(zden, tenpow, &tmp); zfree(tenpow); - den = tmp; + zden = tmp; } if (exponent < 0) { ztenpow(-exponent, &tenpow); @@ -365,7 +365,7 @@ qprintfe(NUMBER *q, long width, long precision) zfree(tenpow); num = tmp; } - if (zrel(num, den) < 0) { + if (zrel(num, zden) < 0) { zmuli(num, 10L, &tmp); if (num.v != q->num.v) zfree(num); @@ -373,15 +373,15 @@ qprintfe(NUMBER *q, long width, long precision) exponent--; } q2.num = num; - q2.den = den; + q2.den = zden; q2.num.sign = q->num.sign; qprintff(&q2, 0L, precision); if (exponent) PRINTF1("e%ld", exponent); if (num.v != q->num.v) zfree(num); - if (den.v != q->den.v) - zfree(den); + if (zden.v != q->den.v) + zfree(zden); } @@ -548,17 +548,17 @@ str2q(char *s) /* * Reduce the fraction to lowest terms */ - if (zisunit(q->num) || zisunit(q->den)) - return q; - zgcd(q->num, q->den, &div); - if (zisunit(div)) - return q; - zequo(q->num, div, &newnum); - zfree(q->num); - zequo(q->den, div, &newden); - zfree(q->den); - q->num = newnum; - q->den = newden; + if (!zisunit(q->num) && !zisunit(q->den)) { + zgcd(q->num, q->den, &div); + if (!zisunit(div)) { + zequo(q->num, div, &newnum); + zfree(q->num); + zequo(q->den, div, &newden); + zfree(q->den); + q->num = newnum; + q->den = newden; + } + } return q; } @@ -673,4 +673,64 @@ qparse(char *cp, int flags) return (cp - oldcp); } + +/* + * Print an integer which is guaranteed to fit in the specified number + * of columns, using imbedded '...' characters if numerator and/or + * denominator is too large. + */ +void +fitprint(NUMBER *q, long width) +{ + long numdigits, dendigits, digits; + long width1, width2; + long n, k; + + if (width < 8) + width = 8; + numdigits = zdigits(q->num); + n = numdigits; + k = 0; + while (++k, n) + n /= 10; + if (qisint(q)) { + width -= k; + k = 16 - k; + if (k < 2) + k = 2; + PRINTF1("(%ld)", numdigits); + while (k-- > 0) + PUTCHAR(' '); + fitzprint(q->num, numdigits, width); + return; + } + dendigits = zdigits(q->den); + PRINTF2("(%ld/%ld)", numdigits, dendigits); + digits = numdigits + dendigits; + n = dendigits; + while (++k, n) + n /= 10; + width -= k; + k = 16 - k; + if (k < 2) + k = 2; + while (k-- > 0) + PUTCHAR(' '); + if (digits <= width) { + qprintf("%r", q); + return; + } + width1 = (width * numdigits)/digits; + if (width1 < 8) + width1 = 8; + width2 = width - width1; + if (width2 < 8) { + width2 = 8; + width1 = width - width2; + } + fitzprint(q->num, numdigits, width1); + PUTCHAR('/'); + fitzprint(q->den, dendigits, width2); +} + /* END CODE */ diff --git a/qmath.c b/qmath.c index a9427eb..3b64953 100644 --- a/qmath.c +++ b/qmath.c @@ -1,23 +1,30 @@ /* - * 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. * * Extended precision rational arithmetic primitive routines */ +#include #include "qmath.h" #include "config.h" -NUMBER _qzero_ = { { _zeroval_, 1, 0 }, { _oneval_, 1, 0 }, 1 }; -NUMBER _qone_ = { { _oneval_, 1, 0 }, { _oneval_, 1, 0 }, 1 }; -static NUMBER _qtwo_ = { { _twoval_, 1, 0 }, { _oneval_, 1, 0 }, 1 }; -static NUMBER _qten_ = { { _tenval_, 1, 0 }, { _oneval_, 1, 0 }, 1 }; -NUMBER _qnegone_ = { { _oneval_, 1, 1 }, { _oneval_, 1, 0 }, 1 }; -NUMBER _qonehalf_ = { { _oneval_, 1, 0 }, { _twoval_, 1, 0 }, 1 }; -NUMBER _qonesqbase_ = { { _oneval_, 1, 0 }, { _sqbaseval_, 2, 0 }, 1 }; +NUMBER _qzero_ = { { _zeroval_, 1, 0 }, { _oneval_, 1, 0 }, 1, NULL }; +NUMBER _qone_ = { { _oneval_, 1, 0 }, { _oneval_, 1, 0 }, 1, NULL }; +NUMBER _qtwo_ = { { _twoval_, 1, 0 }, { _oneval_, 1, 0 }, 1, NULL }; +NUMBER _qthree_ = { { _threeval_, 1, 0 }, { _oneval_, 1, 0 }, 1, NULL }; +NUMBER _qfour_ = { { _fourval_, 1, 0 }, { _oneval_, 1, 0 }, 1, NULL }; +NUMBER _qten_ = { { _tenval_, 1, 0 }, { _oneval_, 1, 0 }, 1, NULL }; +NUMBER _qnegone_ = { { _oneval_, 1, 1 }, { _oneval_, 1, 0 }, 1, NULL }; +NUMBER _qonehalf_ = { { _oneval_, 1, 0 }, { _twoval_, 1, 0 }, 1, NULL }; +NUMBER _qonesqbase_ = { { _oneval_, 1, 0 }, { _sqbaseval_, 2, 0 }, 1, NULL }; +#define INITCONSTCOUNT 8 + +NUMBER * initnumbs[INITCONSTCOUNT] = {&_qzero_, &_qone_, &_qtwo_, &_qthree_, + &_qfour_, &_qten_, &_qnegone_, &_qonehalf_}; /* * Create another copy of a number. @@ -498,10 +505,10 @@ qmuli(NUMBER *q, long n) /* * Divide two numbers (as fractions). - * q3 = qdiv(q1, q2); + * q3 = qqdiv(q1, q2); */ NUMBER * -qdiv(NUMBER *q1, NUMBER *q2) +qqdiv(NUMBER *q1, NUMBER *q2) { NUMBER temp; @@ -589,10 +596,10 @@ qquo(NUMBER *q1, NUMBER *q2, long rnd) /* * Return the absolute value of a number. - * q2 = qabs(q1); + * q2 = qqabs(q1); */ NUMBER * -qabs(NUMBER *q) +qqabs(NUMBER *q) { register NUMBER *r; @@ -756,19 +763,19 @@ qint(NUMBER *q) NUMBER * qsquare(NUMBER *q) { - ZVALUE num, den; + ZVALUE num, zden; if (qiszero(q)) return qlink(&_qzero_); if (qisunit(q)) return qlink(&_qone_); num = q->num; - den = q->den; + zden = q->den; q = qalloc(); if (!zisunit(num)) zsquare(num, &q->num); - if (!zisunit(den)) - zsquare(den, &q->den); + if (!zisunit(zden)) + zsquare(zden, &q->den); return q; } @@ -872,21 +879,47 @@ qmax(NUMBER *q1, NUMBER *q2) /* - * Perform the logical OR of two integers. + * Perform the bitwise OR of two integers. */ NUMBER * qor(NUMBER *q1, NUMBER *q2) { register NUMBER *r; + NUMBER *q1tmp, *q2tmp, *q; if (qisfrac(q1) || qisfrac(q2)) { - math_error("Non-integers for logical or"); + math_error("Non-integers for bitwise or"); /*NOTREACHED*/ } - if ((q1 == q2) || qiszero(q2)) + if (qcmp(q1,q2) == 0 || qiszero(q2)) return qlink(q1); if (qiszero(q1)) return qlink(q2); + if (qisneg(q1)) { + q1tmp = qcomp(q1); + if (qisneg(q2)) { + q2tmp = qcomp(q2); + q = qand(q1tmp,q2tmp); + r = qcomp(q); + qfree(q1tmp); + qfree(q2tmp); + qfree(q); + return r; + } + q = qandnot(q1tmp, q2); + qfree(q1tmp); + r = qcomp(q); + qfree(q); + return r; + } + if (qisneg(q2)) { + q2tmp = qcomp(q2); + q = qandnot(q2tmp, q1); + qfree(q2tmp); + r = qcomp(q); + qfree(q); + return r; + } r = qalloc(); zor(q1->num, q2->num, &r->num); return r; @@ -894,22 +927,44 @@ qor(NUMBER *q1, NUMBER *q2) /* - * Perform the logical AND of two integers. + * Perform the bitwise AND of two integers. */ NUMBER * qand(NUMBER *q1, NUMBER *q2) { register NUMBER *r; + NUMBER *q1tmp, *q2tmp, *q; ZVALUE res; if (qisfrac(q1) || qisfrac(q2)) { - math_error("Non-integers for logical and"); + math_error("Non-integers for bitwise and"); /*NOTREACHED*/ } - if (q1 == q2) + if (qcmp(q1, q2) == 0) return qlink(q1); if (qiszero(q1) || qiszero(q2)) return qlink(&_qzero_); + if (qisneg(q1)) { + q1tmp = qcomp(q1); + if (qisneg(q2)) { + q2tmp = qcomp(q2); + q = qor(q1tmp, q2tmp); + qfree(q1tmp); + qfree(q2tmp); + r = qcomp(q); + qfree(q); + return r; + } + r = qandnot(q2, q1tmp); + qfree(q1tmp); + return r; + } + if (qisneg(q2)) { + q2tmp = qcomp(q2); + r = qandnot(q1, q2tmp); + qfree(q2tmp); + return r; + } zand(q1->num, q2->num, &res); if (ziszero(res)) { zfree(res); @@ -922,24 +977,48 @@ qand(NUMBER *q1, NUMBER *q2) /* - * Perform the logical XOR of two integers. + * Perform the bitwise XOR of two integers. */ NUMBER * qxor(NUMBER *q1, NUMBER *q2) { register NUMBER *r; + NUMBER *q1tmp, *q2tmp, *q; ZVALUE res; if (qisfrac(q1) || qisfrac(q2)) { - math_error("Non-integers for logical xor"); + math_error("Non-integers for bitwise xor"); /*NOTREACHED*/ } - if (q1 == q2) + if (qcmp(q1,q2) == 0) return qlink(&_qzero_); if (qiszero(q1)) return qlink(q2); if (qiszero(q2)) return qlink(q1); + if (qisneg(q1)) { + q1tmp = qcomp(q1); + if (qisneg(q2)) { + q2tmp = qcomp(q2); + r = qxor(q1tmp, q2tmp); + qfree(q1tmp); + qfree(q2tmp); + return r; + } + q = qxor(q1tmp, q2); + qfree(q1tmp); + r = qcomp(q); + qfree(q); + return r; + } + if (qisneg(q2)) { + q2tmp = qcomp(q2); + q = qxor(q1, q2tmp); + qfree(q2tmp); + r = qcomp(q); + qfree(q); + return r; + } zxor(q1->num, q2->num, &res); if (ziszero(res)) { zfree(res); @@ -951,6 +1030,72 @@ qxor(NUMBER *q1, NUMBER *q2) } +/* + * Perform the bitwise ANDNOT of two integers. + */ +NUMBER * +qandnot(NUMBER *q1, NUMBER *q2) +{ + register NUMBER *r; + NUMBER *q1tmp, *q2tmp, *q; + + if (qisfrac(q1) || qisfrac(q2)) { + math_error("Non-integers for bitwise xor"); + /*NOTREACHED*/ + } + if (qcmp(q1,q2) == 0 || qiszero(q1)) + return qlink(&_qzero_); + if (qiszero(q2)) + return qlink(q1); + if (qisneg(q1)) { + q1tmp = qcomp(q1); + if (qisneg(q2)) { + q2tmp = qcomp(q2); + r = qandnot(q2tmp, q1tmp); + qfree(q1tmp); + qfree(q2tmp); + return r; + } + q = qor(q1tmp, q2); + qfree(q1tmp); + r = qcomp(q); + qfree(q); + return r; + } + if (qisneg(q2)) { + q2tmp = qcomp(q2); + r = qand(q1, q2tmp); + qfree(q2tmp); + return r; + } + r = qalloc(); + zandnot(q1->num, q2->num, &r->num); + return r; +} + +/* + * Return the bitwise "complement" of a number. This is - q -1 if q is an + * integer, - q otherwise. + */ +NUMBER * +qcomp(NUMBER *q) +{ + NUMBER *qtmp; + NUMBER *res; + + if (qiszero(q)) + return qlink(&_qnegone_); + if (qisnegone(q)) + return qlink(&_qzero_); + qtmp = qneg(q); + if (qisfrac(q)) + return qtmp; + res = qdec(qtmp); + qfree(qtmp); + return res; +} + + /* * Return the number whose binary representation only has the specified * bit set (counting from zero). This thus produces a given power of two. @@ -1154,48 +1299,34 @@ qcmp(NUMBER *q1, NUMBER *q2) * Compare a number against a normal small integer. * Returns 1, 0, or -1, according to whether the first number is greater, * equal, or less than the second number. - * n = qreli(q, n); + * res = qreli(q, n); */ FLAG qreli(NUMBER *q, long n) { - int sign; - ZVALUE num; - HALF h2[2]; - NUMBER q2; + ZVALUE z1, z2; + FLAG res; - sign = ztest(q->num); /* do trivial sign checks */ - if (sign == 0) { - if (n > 0) - return -1; - return (n < 0); + if (qiszero(q)) + return ((n > 0) ? -1 : (n < 0)); + + if (n == 0) + return (q->num.sign ? -1 : 0); + + if (q->num.sign != n < 0) + return ((n < 0) ? 1 : -1); + + itoz(n, &z1); + + if (qisfrac(q)) { + zmul(q->den, z1, &z2); + zfree(z1); + z1 = z2; } - if ((sign < 0) && (n >= 0)) - return -1; - if ((sign > 0) && (n <= 0)) - return 1; - n *= sign; - if (n == 1) { /* quick check against 1 or -1 */ - num = q->num; - num.sign = 0; - return (sign * zrel(num, q->den)); - } - num.sign = (sign < 0); -#if LONG_BITS > BASEB - num.len = 1 + (n >= BASE); - h2[0] = (HALF)(n & BASE1); - h2[1] = (HALF)(n >> BASEB); -#else - num.len = 1; - h2[0] = n; -#endif - num.v = h2; - if (zisunit(q->den)) /* integer compare if no denominator */ - return zrel(q->num, num); - q2.num = num; - q2.den = _one_; - q2.links = 1; - return qrel(q, &q2); /* full fractional compare */ + + res = zrel(q->num, z1); + zfree(z1); + return res; } @@ -1206,11 +1337,13 @@ qreli(NUMBER *q, long n) BOOL qcmpi(NUMBER *q, long n) { - FULL nf; long len; +#if LONG_BITS > BASEB + FULL nf; +#endif len = q->num.len; - if ((len > 2) || qisfrac(q) || (q->num.sign != (n < 0))) + if (qisfrac(q) || (q->num.sign != (n < 0))) return TRUE; if (n < 0) n = -n; @@ -1218,10 +1351,10 @@ qcmpi(NUMBER *q, long n) return TRUE; #if LONG_BITS > BASEB nf = ((FULL) n) >> BASEB; + return ((nf != 0 || len > 1) && (len != 2 || nf != q->num.v[1])); #else - nf = 0; + return (len > 1); #endif - return (((nf != 0) != (len == 2)) || (nf != q->num.v[1])); } @@ -1231,52 +1364,96 @@ qcmpi(NUMBER *q, long n) #define NNALLOC 1000 -union allocNode { - NUMBER num; - union allocNode *link; -}; -static union allocNode *freeNum; +static NUMBER *freeNum; +static NUMBER **firstNums; +static long blockcount = 0; NUMBER * qalloc(void) { - register union allocNode *temp; + NUMBER *temp; + NUMBER ** newfn; if (freeNum == NULL) { - freeNum = (union allocNode *) - malloc(sizeof (NUMBER) * NNALLOC); + freeNum = (NUMBER *) malloc(sizeof (NUMBER) * NNALLOC); if (freeNum == NULL) { math_error("Not enough memory"); /*NOTREACHED*/ } - freeNum[NNALLOC-1].link = NULL; - for (temp=freeNum+NNALLOC-2; temp >= freeNum; --temp) { - temp->link = temp+1; + freeNum[NNALLOC - 1].next = NULL; + freeNum[NNALLOC - 1].links = 0; + for (temp = freeNum + NNALLOC - 2; temp >= freeNum; --temp) { + temp->next = temp + 1; + temp->links = 0; } + blockcount++; + newfn = (NUMBER **) + realloc(firstNums, blockcount * sizeof(NUMBER *)); + if (newfn == NULL) { + math_error("Cannot allocate new number block"); + /*NOTREACHED*/ + } + firstNums = newfn; + firstNums[blockcount - 1] = freeNum; } temp = freeNum; - freeNum = temp->link; - temp->num.links = 1; - temp->num.num = _one_; - temp->num.den = _one_; - return &temp->num; + freeNum = temp->next; + temp->links = 1; + temp->num = _one_; + temp->den = _one_; + return temp; } void qfreenum(NUMBER *q) { - union allocNode *a; - - if (q == NULL) - return; + if (q == NULL) { + math_error("Calling qfreenum with null argument!!!"); + /*NOTREACHED*/ + } + if (q->links != 0) { + math_error("Calling qfreenum with nozero links!!!"); + /*NOTREACHED*/ + } zfree(q->num); zfree(q->den); - a = (union allocNode *) q; - a->link = freeNum; - freeNum = a; + q->next = freeNum; + freeNum = q; +} + +void +shownumbers(void) +{ + NUMBER *vp; + long i, j, k; + long count = 0; + + printf("Index Links Digits Value\n"); + printf("----- ----- ------ -----\n"); + + for (i = 0, k = 0; i < INITCONSTCOUNT; i++) { + count++; + vp = initnumbs[i]; + printf("%6ld %4ld ", k++, vp->links); + fitprint(vp, 40); + printf("\n"); + } + + for (i = 0; i < blockcount; i++) { + vp = firstNums[i]; + for (j = 0; j < NNALLOC; j++, k++, vp++) { + if (vp->links > 0) { + count++; + printf("%6ld %4ld ", k, vp->links); + fitprint(vp, 40); + printf("\n"); + } + } + } + printf("\nNumber: %ld\n", count); } /* END CODE */ diff --git a/qmath.h b/qmath.h index 82140e7..019a354 100644 --- a/qmath.h +++ b/qmath.h @@ -1,13 +1,15 @@ /* - * 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. * * Data structure declarations for extended precision rational arithmetic. */ -#ifndef QMATH_H -#define QMATH_H + +#if !defined(__QMATH_H__) +#define __QMATH_H__ + #include "zmath.h" @@ -15,11 +17,14 @@ /* * Rational arithmetic definitions. */ -typedef struct { +struct number { ZVALUE num; /* numerator (containing sign) */ ZVALUE den; /* denominator (always positive) */ long links; /* number of links to this value */ -} NUMBER; + struct number *next; /* pointer to next number */ +}; + +typedef struct number NUMBER; extern NUMBER _qlge_; @@ -46,6 +51,10 @@ extern void qprintfx(NUMBER *q, long width); extern void qprintfb(NUMBER *q, long width); extern void qprintfo(NUMBER *q, long width); extern void qprintf(char *, ...); +extern void shownumbers(void); +extern void showredcdata(void); +extern void freeredcdata(void); +extern void fitprint(NUMBER *, long); @@ -58,7 +67,7 @@ extern NUMBER *qdivi(NUMBER *q, long i); extern NUMBER *qqadd(NUMBER *q1, NUMBER *q2); extern NUMBER *qsub(NUMBER *q1, NUMBER *q2); extern NUMBER *qmul(NUMBER *q1, NUMBER *q2); -extern NUMBER *qdiv(NUMBER *q1, NUMBER *q2); +extern NUMBER *qqdiv(NUMBER *q1, NUMBER *q2); extern NUMBER *qquo(NUMBER *q1, NUMBER *q2, long rnd); extern NUMBER *qmod(NUMBER *q1, NUMBER *q2, long rnd); extern NUMBER *qmin(NUMBER *q1, NUMBER *q2); @@ -66,6 +75,8 @@ extern NUMBER *qmax(NUMBER *q1, NUMBER *q2); extern NUMBER *qand(NUMBER *q1, NUMBER *q2); extern NUMBER *qor(NUMBER *q1, NUMBER *q2); extern NUMBER *qxor(NUMBER *q1, NUMBER *q2); +extern NUMBER *qandnot(NUMBER *q1, NUMBER *q2); +extern NUMBER *qcomp(NUMBER *q); extern NUMBER *qpowermod(NUMBER *q1, NUMBER *q2, NUMBER *q3); extern NUMBER *qpowi(NUMBER *q1, NUMBER *q2); extern NUMBER *qsquare(NUMBER *q); @@ -76,7 +87,7 @@ extern NUMBER *qfrac(NUMBER *q); extern NUMBER *qnum(NUMBER *q); extern NUMBER *qden(NUMBER *q); extern NUMBER *qinv(NUMBER *q); -extern NUMBER *qabs(NUMBER *q); +extern NUMBER *qqabs(NUMBER *q); extern NUMBER *qinc(NUMBER *q); extern NUMBER *qdec(NUMBER *q); extern NUMBER *qshift(NUMBER *q, long n); @@ -230,5 +241,8 @@ extern NUMBER *swap_HALF_in_NUMBER(NUMBER *dest, NUMBER *src, BOOL all); * constants used often by the arithmetic routines */ extern NUMBER _qzero_, _qone_, _qnegone_, _qonehalf_, _qonesqbase_; +extern NUMBER _qtwo_, _qthree_, _qfour_; +extern NUMBER * initnumbs[]; -#endif + +#endif /* !__QMATH_H__ */ diff --git a/qmod.c b/qmod.c index 1a0b5b6..8d916ad 100644 --- a/qmod.c +++ b/qmod.c @@ -7,6 +7,7 @@ * the faster REDC algorithm. */ +#include #include "qmath.h" #include "config.h" @@ -15,7 +16,7 @@ * Structure used for caching REDC information. */ typedef struct { - NUMBER *num; /* modulus being cached */ + NUMBER *rnum; /* modulus being cached */ REDC *redc; /* REDC information for modulus */ long age; /* age counter for reallocation */ } REDC_CACHE; @@ -445,7 +446,7 @@ qfindredc(NUMBER *q) * First try for an exact pointer match in the table. */ for (rcp = redc_cache; rcp < &redc_cache[MAXREDC]; rcp++) { - if (q == rcp->num) { + if (q == rcp->rnum) { rcp->age = ++redc_age; return rcp->redc; } @@ -455,7 +456,7 @@ qfindredc(NUMBER *q) * Search the table again looking for a value which matches. */ for (rcp = redc_cache; rcp < &redc_cache[MAXREDC]; rcp++) { - if (rcp->age && (qcmp(q, rcp->num) == 0)) { + if (rcp->age && (qcmp(q, rcp->rnum) == 0)) { rcp->age = ++redc_age; return rcp->redc; } @@ -485,14 +486,44 @@ qfindredc(NUMBER *q) rcp = bestrcp; if (rcp->age) { rcp->age = 0; - qfree(rcp->num); + qfree(rcp->rnum); zredcfree(rcp->redc); } rcp->redc = zredcalloc(q->num); - rcp->num = qlink(q); + rcp->rnum = qlink(q); rcp->age = ++redc_age; return rcp->redc; } +void +showredcdata(void) +{ + REDC_CACHE *rcp; + long i; + + for (i = 0, rcp = redc_cache; i < MAXREDC; i++, rcp++) { + if (rcp->age > 0) { + printf("%-8ld%-8ld", i, rcp->age); + qprintnum(rcp->rnum, 0); + printf("\n"); + } + } +} + +void +freeredcdata(void) +{ + REDC_CACHE *rcp; + long i; + + for (i = 0, rcp = redc_cache; i < MAXREDC; i++, rcp++) { + if (rcp->age > 0) { + rcp->age = 0; + qfree(rcp->rnum); + zredcfree(rcp->redc); + } + } +} + /* END CODE */ diff --git a/qtrans.c b/qtrans.c index f38b33e..accdeb1 100644 --- a/qtrans.c +++ b/qtrans.c @@ -11,9 +11,9 @@ HALF _qlgenum_[] = { 36744 }; HALF _qlgeden_[] = { 25469 }; -NUMBER _qlge_ = { { _qlgenum_, 1, 0 }, { _qlgeden_, 1, 0 }, 1 }; +NUMBER _qlge_ = { { _qlgenum_, 1, 0 }, { _qlgeden_, 1, 0 }, 1, NULL }; -NUMBER *qmappr(NUMBER *q, NUMBER *e, long R); +static NUMBER *pivalue[2]; static NUMBER *qexprel(NUMBER *q, long bitnum); /* @@ -27,7 +27,7 @@ qsincos(NUMBER *q, long bitnum, NUMBER **vs, NUMBER **vc) NUMBER *qtmp1, *qtmp2; ZVALUE X, cossum, sinsum, mul, ztmp1, ztmp2, ztmp3; - qtmp1 = qabs(q); + qtmp1 = qqabs(q); h = qilog2(qtmp1); qfree(qtmp1); k = bitnum + h + 1; @@ -214,7 +214,7 @@ qtan(NUMBER *q, NUMBER *epsilon) qfree(cos); k = m + 1; } - tan = qdiv(sin, cos); + tan = qqdiv(sin, cos); qfree(sin); qfree(cos); res = qmappr(tan, epsilon, 24); @@ -260,7 +260,7 @@ qcot(NUMBER *q, NUMBER *epsilon) qfree(cos); k = m + 1; } - cot = qdiv(cos, sin); + cot = qqdiv(cos, sin); qfree(sin); qfree(cos); res = qmappr(cot, epsilon, 24); @@ -362,7 +362,6 @@ qasin(NUMBER *q, NUMBER *epsilon) BOOL neg; FLAG r; - if (qiszero(epsilon)) { math_error("Zero epsilon value for asin"); /*NOTREACHED*/ @@ -373,10 +372,8 @@ qasin(NUMBER *q, NUMBER *epsilon) neg = ztmp.sign; ztmp.sign = 0; r = zrel(ztmp, q->den); - if (r > 0) { - math_error("Argument out of range for asin"); - /*NOTREACHED*/ - } + if (r > 0) + return NULL; if (r == 0) { epsilon1 = qscale(epsilon, 1L); qtmp2 = qpi(epsilon1); @@ -426,10 +423,8 @@ qacos(NUMBER *q, NUMBER *epsilon) z = q->num; z.sign = 0; - if (zrel(z, q->den) > 0) { - math_error("Argument out of range for acos"); - /*NOTREACHED*/ - } + if (zrel(z, q->den) > 0) + return NULL; epsilon1 = qscale(epsilon, -3L); /* ??? */ q1 = qalloc(); zsub(q->den, q->num, &q1->num); @@ -641,7 +636,7 @@ qatan2(NUMBER *qy, NUMBER *qx, NUMBER *epsilon) if (!qisneg(qx) && !qiszero(qx)) { if (qiszero(qy)) return qlink(&_qzero_); - tmp1 = qdiv(qy, qx); + tmp1 = qqdiv(qy, qx); tmp2 = qatan(tmp1, epsilon); qfree(tmp1); return tmp2; @@ -652,7 +647,7 @@ qatan2(NUMBER *qy, NUMBER *qx, NUMBER *epsilon) * atan2(y,x) = 2 * atan(sgn(y) * sqrt((x/y)^2 + 1) - x/y). */ epsilon2 = qscale(epsilon, -4L); - tmp1 = qdiv(qx, qy); + tmp1 = qqdiv(qx, qy); tmp2 = qsquare(tmp1); tmp3 = qqadd(tmp2, &_qone_); qfree(tmp2); @@ -699,6 +694,12 @@ qpi(NUMBER *epsilon) math_error("zero epsilon value for pi"); /*NOTREACHED*/ } + if (epsilon == pivalue[0]) + return qlink(pivalue[1]); + if (pivalue[0]) { + qfree(pivalue[0]); + qfree(pivalue[1]); + } bits = -qilog2(epsilon) + 4; if (bits < 4) bits = 4; @@ -731,6 +732,8 @@ qpi(NUMBER *epsilon) zfree(sum); r = qmappr(t1, epsilon, 24L); qfree(t1); + pivalue[0] = qlink(epsilon); + pivalue[1] = qlink(r); return r; } @@ -757,7 +760,7 @@ qexp(NUMBER *q, NUMBER *epsilon) n = qilog2(epsilon); /* 2^n <= epsilon < 2^(n+1) */ if (m < n) return qlink(&_qzero_); - tmp1 = qabs(q); + tmp1 = qqabs(q); tmp2 = qexprel(tmp1, m - n + 2); qfree(tmp1); if (qisneg(q)) { @@ -874,7 +877,7 @@ qln(NUMBER *q, NUMBER *epsilon) } if (qisunit(q)) return qlink(&_qzero_); - q = qabs(q); /* Ignore sign of q */ + q = qqabs(q); /* Ignore sign of q */ neg = (zrel(q->num, q->den) < 0); if (neg) { qtmp = qinv(q); @@ -984,10 +987,7 @@ qpower(NUMBER *q1, NUMBER *q2, NUMBER *epsilon) /*NOTREACHED*/ } if (qiszero(q2) || qisone(q1)) { - tmp1 = qlink(&_qone_); - tmp2 = qmappr(tmp1, epsilon, 24L); - qfree(tmp1); - return tmp2; + return qmappr(&_qone_, epsilon, 24L); } if (qiszero(q1)) return qlink(&_qzero_); @@ -1023,7 +1023,7 @@ qpower(NUMBER *q1, NUMBER *q2, NUMBER *epsilon) } else { tmp1 = qdec(q1tmp); - tmp2 = qdiv(tmp1, q1tmp); + tmp2 = qqdiv(tmp1, q1tmp); qfree(tmp1); tmp1 = qmul(tmp2, q2tmp); qfree(tmp2); @@ -1053,9 +1053,9 @@ qpower(NUMBER *q1, NUMBER *q2, NUMBER *epsilon) qfree(q2tmp); return qlink(&_qzero_); } - tmp1 = qdiv(epsilon, q2tmp); + tmp1 = qqdiv(epsilon, q2tmp); tmp2 = qscale(tmp1, -m - 4); - epsilon2 = qabs(tmp2); + epsilon2 = qqabs(tmp2); qfree(tmp1); qfree(tmp2); tmp1 = qln(q1tmp, epsilon2); @@ -1107,7 +1107,7 @@ qroot(NUMBER *q1, NUMBER *q2, NUMBER *epsilon) math_error("Taking even root of negative number"); /*NOTREACHED*/ } - q1 = qabs(q1); + q1 = qqabs(q1); } tmp2 = qinv(q2); tmp1 = qpower(q1, tmp2, epsilon); @@ -1131,7 +1131,7 @@ qcosh(NUMBER *q, NUMBER *epsilon) NUMBER *tmp1, *tmp2, *tmp3, *epsilon1; epsilon1 = qscale(epsilon, -2); - tmp1 = qabs(q); + tmp1 = qqabs(q); tmp2 = qexp(tmp1, epsilon1); qfree(tmp1); qfree(epsilon1); @@ -1160,7 +1160,7 @@ qsinh(NUMBER *q, NUMBER *epsilon) if (qiszero(q)) return qlink(&_qzero_); epsilon1 = qscale(epsilon, -3); - tmp1 = qabs(q); + tmp1 = qqabs(q); tmp2 = qexp(tmp1, epsilon1); qfree(tmp1); qfree(epsilon1); @@ -1191,7 +1191,7 @@ qtanh(NUMBER *q, NUMBER *epsilon) n = qilog2(epsilon); if (n > 0 || qiszero(q)) return qlink(&_qzero_); - tmp1 = qabs(q); + tmp1 = qqabs(q); tmp2 = qscale(tmp1, 1); qfree(tmp1); tmp1 = qexprel(tmp2, 2 - n); @@ -1199,7 +1199,7 @@ qtanh(NUMBER *q, NUMBER *epsilon) tmp2 = qdec(tmp1); tmp3 = qinc(tmp1); qfree(tmp1); - tmp1 = qdiv(tmp2, tmp3); + tmp1 = qqdiv(tmp2, tmp3); qfree(tmp2); qfree(tmp3); tmp2 = qmappr(tmp1, epsilon, 24L); @@ -1232,20 +1232,21 @@ qcoth(NUMBER *q, NUMBER *epsilon) /*NOTREACHED*/ } tmp1 = qscale(q, 1); - tmp2 = qabs(tmp1); + tmp2 = qqabs(tmp1); qfree(tmp1); - k = -qilog2(tmp2); - if (k < 0) { + k = qilog2(tmp2); + n = qilog2(epsilon); + if (k > 0) { tmp1 = qmul(&_qlge_, tmp2); - k = -qtoi(tmp1); + k = qtoi(tmp1); qfree(tmp1); } - n = qilog2(epsilon); - if (k + n > 1) { - qfree(tmp2); - return qlink(&_qzero_); - } - tmp1 = qexprel(tmp2, 4 - k - n); + else + k = 2 * k; + k = 4 - k - n; + if (k < 4) + k = 4; + tmp1 = qexprel(tmp2, k); qfree(tmp2); tmp2 = qdec(tmp1); qfree(tmp1); @@ -1283,7 +1284,7 @@ qsech(NUMBER *q, NUMBER *epsilon) if (qiszero(q)) return qmappr(&_qone_, epsilon, 24L); - tmp1 = qabs(q); + tmp1 = qqabs(q); k = 0; if (zrel(tmp1->num, tmp1->den) >= 0) { tmp2 = qmul(&_qlge_, tmp1); @@ -1327,7 +1328,7 @@ qcsch(NUMBER *q, NUMBER *epsilon) } n = qilog2(epsilon); - tmp1 = qabs(q); + tmp1 = qqabs(q); if (zrel(tmp1->num, tmp1->den) >= 0) { tmp2 = qmul(&_qlge_, tmp1); k = qtoi(tmp2); @@ -1375,10 +1376,8 @@ qacosh(NUMBER *q, NUMBER *epsilon) } if (qisone(q)) return qlink(&_qzero_); - if (zrel(q->num, q->den) < 0) { - math_error("Argument less than one for acosh"); - /*NOTREACHED*/ - } + if (zrel(q->num, q->den) < 0) + return NULL; n = qilog2(epsilon); epsilon1 = qbitvalue(n - 3); tmp1 = qsquare(q); @@ -1416,7 +1415,7 @@ qasinh(NUMBER *q, NUMBER *epsilon) if (qiszero(q)) return qlink(&_qzero_); neg = qisneg(q); - q = qabs(q); + q = qqabs(q); n = qilog2(epsilon); epsilon1 = qbitvalue(n - 3); tmp1 = qsquare(q); @@ -1459,13 +1458,11 @@ qatanh(NUMBER *q, NUMBER *epsilon) return qlink(&_qzero_); z = q->num; z.sign = 0; - if (zrel(z, q->den) >= 0) { - math_error("Argument not between -1 and 1 for atanh"); - /*NOTREACHED*/ - } + if (zrel(z, q->den) >= 0) + return NULL; tmp1 = qinc(q); tmp2 = qsub(&_qone_, q); - tmp3 = qdiv(tmp1, tmp2); + tmp3 = qqdiv(tmp1, tmp2); qfree(tmp1); qfree(tmp2); epsilon1 = qscale(epsilon, 1L); diff --git a/quickhash.c b/quickhash.c index f1b4a01..6312a65 100644 --- a/quickhash.c +++ b/quickhash.c @@ -1,5 +1,5 @@ /* - * Copyright (c) 1996 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, @@ -44,6 +44,7 @@ #include "value.h" #include "zrand.h" +#include "zrandom.h" #define ZMOST 2 /* most significant HALFs to hash */ #define ZLEAST 2 /* least significant HALFs to hash */ @@ -63,6 +64,8 @@ static QCKHASH config_hash(CONFIG *cfg, QCKHASH val); static QCKHASH fnv_strhash(char *str, QCKHASH val); static QCKHASH fnv_fullhash(FULL *v, LEN len, QCKHASH val); static QCKHASH fnv_zhash(ZVALUE z, QCKHASH val); +static QCKHASH hash_hash(HASH *hash, QCKHASH val); +static QCKHASH blk_hash(BLOCK *blk, QCKHASH val); /* @@ -142,7 +145,7 @@ hashvalue(VALUE *vp, QCKHASH val) case V_COM: return fnv_chash(vp->v_com, val); case V_STR: - return fnv_strhash(vp->v_str, val); + return fnv_strhash(vp->v_str->s_str, val); case V_NULL: return val; case V_OBJ: @@ -161,6 +164,14 @@ hashvalue(VALUE *vp, QCKHASH val) return randomhash(vp->v_random, val); case V_CONFIG: return config_hash(vp->v_config, val); + case V_HASH: + return hash_hash(vp->v_hash, val); + case V_BLOCK: + return blk_hash(vp->v_block, val); + case V_OCTET: + return fnv((int)*vp->v_octet, V_OCTET+val); + case V_NBLOCK: + return blk_hash(vp->v_nblock->blk, val); default: math_error("Hashing unknown value"); /*NOTREACHED*/ @@ -321,11 +332,11 @@ randomhash(RANDOM *state, QCKHASH val) * hash a seeded RANDOM state */ val = fnv(state->buffer+state->bits, V_RANDOM+val); - if (state->r != NULL && state->r->v != NULL) { - val = fnv_zhash(*(state->r), val); + if (state->r.v != NULL) { + val = fnv_zhash(state->r, val); } - if (state->n != NULL && state->n->v != NULL) { - val = fnv_zhash(*(state->n), val); + if (state->n.v != NULL) { + val = fnv_zhash(state->n, val); } return val; } @@ -337,16 +348,52 @@ randomhash(RANDOM *state, QCKHASH val) static QCKHASH config_hash(CONFIG *cfg, QCKHASH val) { + USB32 value; /* value to hash from hash elements */ + /* - * hash scalar values + * build up a scalar value + * + * We will rotate a value left 5 bits and xor in each scalar element */ - val = fnv(cfg->traceflags + cfg->outdigits + cfg->outmode + - cfg->epsilonprec + cfg->maxprint + cfg->mul2 + - cfg->sq2 + cfg->pow2 + cfg->redc2 + cfg->tilde_ok + - cfg->tab_ok + cfg->quomod + cfg->quo + cfg->mod + - cfg->sqrt + cfg->appr + cfg->cfappr + cfg->cfsim + - cfg->outround + cfg->round + cfg->leadzero + - cfg->fullzero + cfg->maxerrorcount, V_CONFIG+val); + value = cfg->outmode; + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->outmode); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->outdigits); + /* epsilon is handeled out of order */ + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->epsilonprec); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->traceflags); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->maxprint); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->mul2); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->sq2); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->pow2); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->redc2); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->tilde_ok); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->tab_ok); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->quomod); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->quo); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->mod); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->sqrt); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->appr); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->cfappr); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->cfsim); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->outround); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->round); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->leadzero); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->fullzero); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->maxscancount); + /* prompt1 is handeled out of order */ + /* prompt2 is handeled out of order */ + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->blkmaxprint); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->blkverbose); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->blkbase); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->blkfmt); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->lib_debug); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->calc_debug); + value = (((value>>5) | (value<<27)) ^ (USB32)cfg->user_debug); + + /* + * hash the built up scalar + */ + val = fnv(value, V_CONFIG+val); /* * hash the strings if possible @@ -385,7 +432,7 @@ fnv_strhash(char *str, QCKHASH val) * hash each character in the string */ while (*str) { - val = fnv(*str++, val); + val = fnv(*str++, val); } return val; } @@ -409,7 +456,7 @@ fnv_fullhash(FULL *v, LEN len, QCKHASH val) * hash each character in the string */ while (len-- > 0) { - val = fnv(*v++, val); + val = fnv(*v++, val); } return val; } @@ -472,3 +519,58 @@ fnv_zhash(ZVALUE z, QCKHASH val) } return val; } + + +/* + * hash_hash - Fowler/Noll/Vo 32 bit hash of a block + * + * given: + * hash the HASH to quickhash + * val initial hash value + * + * returns: + * a 32 bit QCKHASH value + */ +static QCKHASH +hash_hash(HASH *hash, QCKHASH val) +{ + int i; + + /* + * hash each USB8 in the BLOCK + */ + for (i=0; i < hash->unionsize; ++i) { + val = fnv(hash->h_union.data[i], val); + } + return val; +} + + +/* + * blk_hash - Fowler/Noll/Vo 32 bit hash of a block + * + * given: + * blk the BLOCK to hash + * val initial hash value + * + * returns: + * a 32 bit QCKHASH value + */ +static QCKHASH +blk_hash(BLOCK *blk, QCKHASH val) +{ + int i; + + if (blk == NULL) /* block has no data */ + return val; + + /* + * hash each USB8 in the BLOCK + */ + if (blk->datalen > 0) { + for (i=0; i < blk->datalen; ++i) { + val = fnv(blk->data[i], val); + } + } + return val; +} diff --git a/sample/Makefile b/sample/Makefile new file mode 100644 index 0000000..42cf4d5 --- /dev/null +++ b/sample/Makefile @@ -0,0 +1,503 @@ +# +# sample - makefile for calc sample programs +# +# 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, +# provided that the above copyright, this permission notice and text +# this comment, 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. +# +# Comments, suggestions, bug fixes and questions about these routines +# are welcome. Send EMail to the address given below. +# +# Happy bit twiddling, +# +# Landon Curt Noll +# +# chongo@toad.com +# ...!{pyramid,sun,uunet}!hoptoad!chongo +# +# chongo was here /\../\ + +############################################################################## +#-=-=-=-=-=-=-=-=- You may want to change some values below -=-=-=-=-=-=-=-=-# +############################################################################## + +# Any .h files that are needed by programs that use libcustcalc.a +# Don't put ${REQUIRED_H_SRC} files in this list. +# +# Put any .h files that you add which might be useful to other +# programs here. +# +SAMPLE_H_SRC= + +# Any .c files that are needed to build libcustcalc.a. +# Don't put ${REQUIRED_SRC} files in this list. +# +# There MUST be a .c in SAMPLE_SRC for every .o in SAMPLE_OBJ. +# +# Put your sample .c files here. +# +SAMPLE_SRC= many_random.c test_random.c + +# Any .o files that are needed by program that use libcustcalc.a. +# Don't put ${REQUIRED_OBJ} files in this list. +# +# There MUST be a .c in SAMPLE_SRC for every .o in SAMPLE_OBJ. +# +# Put your sample .o files here. +# +SAMPLE_OBJ= many_random.o test_random.o + +############################################################################## +#-=-=-=-=-=-=- Defaults in case you want to build from this dir -=-=-=-=-=-=-# +############################################################################## + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# Makefile debug +# +# Q=@ do not echo internal makefile actions (quiet mode) +# Q= echo internal makefile actions (debug / verbose mode) +# +#Q= +Q=@ + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# where to install things +# +# ${TOPDIR} is the directory under which the calc directory will be placed. +# ${LIBDIR} is where the *.cal, *.h, *.a, bindings and help dir are installed. +# ${HELPDIR} is where the help directory is installed. +# +TOPDIR= /usr/local/lib +#TOPDIR= /usr/lib +#TOPDIR= /usr/libdata +#TOPDIR= /usr/contrib/lib +# +LIBDIR= ${TOPDIR}/calc +HELPDIR= ${LIBDIR}/help + +# The return value type of main() differs from platform to platform. +# In some cases, a compiler warning is issued because main() does +# or does not return a value. +# +# MAIN= -DMAIN=void main() is of type void +# MAIN= -DMAIN=int main() is of type int +# +# When in doubt, try MAIN= -DMAIN=void. If you get a warning try the other. +# +MAIN= -DMAIN=void +#MAIN= -DMAIN=int + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# Debug/Optimize options for ${CC} +# +DEBUG= -O +#DEBUG= -O -g +#DEBUG= -O -g3 +#DEBUG= -O1 +#DEBUG= -O1 -g +#DEBUG= -O1 -g3 +#DEBUG= -O2 +#DEBUG= -O2 -g +#DEBUG= -O2 -g3 +#DEBUG= -O2 -ipa +#DEBUG= -O2 -g3 -ipa +#DEBUG= -O3 +#DEBUG= -O3 -g +#DEBUG= -O3 -g3 +#DEBUG= -O3 -ipa +#DEBUG= -O3 -g3 -ipa +#DEBUG= -g +#DEBUG= -g3 +#DEBUG= -gx +#DEBUG= -WM,-g +#DEBUG= + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# On systems that have dynamic shared libs, you may want want to disable them +# for faster calc startup. +# +# System type NO_SHARED recommendation +# +# BSD NO_SHARED= +# SYSV NO_SHARED= -dn +# IRIX NO_SHARED= -non_shared +# disable NO_SHARED= +# +# If in doubt, use NO_SHARED= +# +NO_SHARED= +#NO_SHARED= -dn +#NO_SHARED= -non_shared + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# Some systems require one to use ranlib to add a symbol table to +# a *.a library. Set RANLIB to the utility that performs this action. +# Set RANLIB to : if your system does not need such a utility. +# +#RANLIB=ranlib +RANLIB=: + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# Normally certain files depend on the Makefile. If the Makefile is +# changed, then certain steps should be redone. If MAKE_FILE is +# set to Makefile, then these files will depend on Makefile. If +# MAKE_FILE is empty, they they wont. +# +# If in doubt, set MAKE_FILE to Makefile +# +MAKE_FILE= Makefile +#MAKE_FILE= + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# If you do not wish to use purify, leave PURIFY commented out. +# +# If in doubt, leave PURIFY commented out. +# +#PURIFY= purify -logfile=pure.out +#PURIFY= purify + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# By default, custom builtin functions may only be executed if calc +# is given the -C option. This is because custom builtin functions +# may invoke non-standard or non-portable code. One may completely +# disable custom builtin functions by not compiling any of code +# +# ALLOW_CUSTOM= -DCUSTOM # allow custom only if -C is given +# ALLOW_CUSTOM= # disable custom even if -C is given +# +# If in doubt, use ALLOW_CUSTOM= -DCUSTOM +# +ALLOW_CUSTOM= -DCUSTOM +#ALLOW_CUSTOM= + +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# The sample routines need to be compiled with libcalc.a. The ${CALC_LIBS} +# variable tells where this library may be found +# +# CALC_LIBS= ../libcalc.a ... # compile with libcalc.a in dir above +# CALC_LIBS= ${LIBDIR}/libcalc.a ... # compile the installed libcalc.a +# CALC_LIBS= -lcalc ... # compile with the system libcalc.a +# +# If in doubt, use CALC_LIBS= ../libcalc.a +# +CALC_LIBS= ../libcalc.a ../custom/libcustcalc.a +#CALC_LIBS= ${LIBDIR}/libcalc.a ${LIBDIR}/libcustcalc.a +#CALC_LIBS= -lcalc -lcustcalc + +### +# +# Normally, the upper level makefile will set these values. We provide +# a default here just in case you want to build from this directory. +# +# Select your compiler type by commenting out one of the cc sets below: +# +# CCOPT are flags given to ${CC} for optimization +# CCWARN are flags given to ${CC} for warning message control +# CCMISC are misc flags given to ${CC} +# +# CFLAGS are all flags given to ${CC} [[often includes CCOPT, CCWARN, CCMISC]] +# ICFLAGS are given to ${CC} for intermediate progs +# +# CCMAIN are flags for ${CC} when files with main() instead of CFLAGS +# +# LCFLAGS are CC-style flags for ${LINT} +# LDFLAGS are flags given to ${CC} for linking .o files +# ILDFLAGS are flags given to ${CC} for linking .o files for intermediate progs +# +# CC is how the the C compiler is invoked +# +### +# +# common cc set +# +CCWARN= +CCOPT= ${DEBUG} ${NO_SHARED} +CCMISC= +# +CFLAGS= ${CCWARN} ${CCOPT} ${CCMISC} ${ALLOW_CUSTOM} +ICFLAGS= ${CCWARN} ${CCMISC} +# +CCMAIN= ${ICFLAGS} ${MAIN} +# +LCFLAGS= +LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED} +ILDFLAGS= +# +CC= ${PURIFY} cc + +############################################################################## +#-=-=-=-=-=-=-=-=- Be careful if you change something below -=-=-=-=-=-=-=-=-# +############################################################################## + +# These .c files are used to build the dependency list +# +C_SRC= ${SAMPLE_SRC} + +# These .h files are used to build the dependecy list +# +H_SRC= ${SAMPLE_H_SRC} + +# These files are found (but not built) in the distribution +# +# The SAMPLE_CAL and HOW_TO_ADD are files distributed from this +# directory but are installed as help files from the help/Makefile. +# +DISTLIST= ${C_SRC} ${H_SRC} ${MAKE_FILE} README_SAMPLE + +# complete list of targets +# +TARGETS= many_random test_random + +# required vars +# +SHELL = /bin/sh +SED= sed +MAKEDEPEND= makedepend +SORT= sort + +## +# +# Standard rules and targets +# +## + +all: ${TARGETS} .all + +test_random.o: test_random.c + ${CC} ${CCMAIN} ${CCOPT} ${ALLOW_CUSTOM} test_random.c -c + +test_random: test_random.o ../libcalc.a + ${CC} ${LDFLAGS} test_random.o ${CALC_LIBS} ${LD_DEBUG} -o test_random + +many_random.o: many_random.c + ${CC} ${CCMAIN} ${CCOPT} ${ALLOW_CUSTOM} many_random.c -c + +many_random: many_random.o ../libcalc.a + ${CC} ${LDFLAGS} many_random.o ${CALC_LIBS} ${LD_DEBUG} -o many_random + +## +# +# used by the upper level Makefile +# +## + +# to determine of we have done all +# +.all: + rm -f .all + touch .all + +## +# +# File list generation. You can ignore this section. +# +# +# We will form the names of source files as if they were in a +# sub-directory called calc/lib. +# +# NOTE: Due to bogus shells found on one common system we must have +# an non-emoty else clause for every if condition. *sigh* +# +## + +distlist: ${DISTLIST} + ${Q}for i in ${DISTLIST}; do \ + echo calc/sample/$$i; \ + done + +# The bsdi distribution has generated files as well as distributed files. +# +bsdilist: ${DISTLIST} + ${Q}for i in ${DISTLIST}; do \ + echo calc/sample/$$i; \ + done + +## +# +# Home grown make dependency rules. Your system make not support +# or have the needed tools. You can ignore this section. +# +# We will form a skelaton tree of *.c files containing only #include "foo.h" +# lines and .h files containing the same lines surrounded by multiple include +# prevention lines. This allows us to build a static depend list that will +# satisfy all possible cpp symbol definition combinations. +# +## + +depend: + ${Q}if [ -f Makefile.bak ]; then \ + echo "Makefile.bak exists, remove or move it out of the way"; \ + exit 1; \ + else \ + true; \ + fi + ${Q}echo forming sample/skel + -${Q}rm -rf skel + ${Q}mkdir skel + ${Q}mkdir skel/sample + -${Q}for i in ${C_SRC}; do \ + ${SED} -n '/^#[ ]*include[ ]*"/p' \ + "$$i" > "skel/sample/$$i"; \ + done + -${Q}for i in ${H_SRC} /dev/null; do \ + if [ X"$$i" != X"/dev/null" ]; then \ + tag="`echo $$i | ${SED} 's/[\.+,:]/_/g'`"; \ + echo "#ifndef $$tag" > "skel/sample/$$i"; \ + echo "#define $$tag" >> "skel/sample/$$i"; \ + ${SED} -n '/^#[ ]*include[ ]*"/p' "$$i" \ + >> "skel/sample/$$i"; \ + echo '#endif /* '"$$tag"' */' >> "skel/sample/$$i"; \ + fi; \ + done + ${Q}(cd ..; ${MAKE} hsrc) + ${Q}for i in `cd ..; ${MAKE} h_list`; do \ + tag="`echo $$i | ${SED} 's/[\.+,:]/_/g'`"; \ + echo "#ifndef $$tag" > "skel/$$i"; \ + echo "#define $$tag" >> "skel/$$i"; \ + ${SED} -n '/^#[ ]*include[ ]*"/p' "../$$i" \ + >> "skel/$$i"; \ + echo '#endif /* '"$$tag"' */' >> "skel/$$i"; \ + done + -${Q}rm -f skel/sample/makedep.out + ${Q}echo sample/skel formed + ${Q}echo forming sample dependency list + ${Q}echo "# DO NOT DELETE THIS LINE -- make depend depends on it." > \ + skel/sample/makedep.out + ${Q}cd skel/sample; ${MAKEDEPEND} -w 1 -m -f makedep.out -I.. ${C_SRC} + -${Q}for i in ${C_SRC}; do \ + echo "$$i" | \ + ${SED} 's/^\(.*\)\.c/\1.o: \1.c/' \ + >> skel/sample/makedep.out; \ + done + ${Q}echo sample dependency list formed + ${Q}echo forming new sample/Makefile + -${Q}rm -f Makefile.bak + ${Q}mv Makefile Makefile.bak + ${Q}${SED} -n '1,/^# DO NOT DELETE THIS LINE/p' Makefile.bak > Makefile + ${Q}echo "" >> Makefile + ${Q}${SED} -n '3,$$p' skel/sample/makedep.out | ${SORT} -u >> Makefile + -${Q}rm -rf skel + -${Q}if cmp -s Makefile.bak Makefile; then \ + echo 'sample Makefile was already up to date'; \ + mv -f Makefile.bak Makefile; \ + else \ + rm -f Makefile.tmp; \ + mv Makefile Makefile.tmp; \ + sccs edit Makefile; \ + mv Makefile.tmp Makefile; \ + echo new 'sample Makefile formed -- you need to check it in'; \ + fi + +## +# +# Utility rules +# +## + +clean: + -rm -f ${SAMPLE_OBJ} core + +clobber: + -rm -f ${SAMPLE_OBJ} + -rm -f ${TARGETS} + rm -f .all Makefile.tmp sample + +# for right now we will not install anything +install: all + +## +# +# make depend stuff +# +## + +# DO NOT DELETE THIS LINE + +many_random.o: ../alloc.h +many_random.o: ../block.h +many_random.o: ../byteswap.h +many_random.o: ../calc.h +many_random.o: ../calcerr.h +many_random.o: ../cmath.h +many_random.o: ../config.h +many_random.o: ../endian_calc.h +many_random.o: ../hash.h +many_random.o: ../have_const.h +many_random.o: ../have_malloc.h +many_random.o: ../have_memmv.h +many_random.o: ../have_newstr.h +many_random.o: ../have_stdlib.h +many_random.o: ../have_string.h +many_random.o: ../lib_util.h +many_random.o: ../longbits.h +many_random.o: ../md5.h +many_random.o: ../nametype.h +many_random.o: ../qmath.h +many_random.o: ../shs.h +many_random.o: ../shs1.h +many_random.o: ../string.h +many_random.o: ../value.h +many_random.o: ../zmath.h +many_random.o: ../zrandom.h +many_random.o: many_random.c +test_random.o: ../alloc.h +test_random.o: ../block.h +test_random.o: ../byteswap.h +test_random.o: ../calc.h +test_random.o: ../calcerr.h +test_random.o: ../cmath.h +test_random.o: ../config.h +test_random.o: ../endian_calc.h +test_random.o: ../hash.h +test_random.o: ../have_const.h +test_random.o: ../have_malloc.h +test_random.o: ../have_memmv.h +test_random.o: ../have_newstr.h +test_random.o: ../have_stdlib.h +test_random.o: ../have_string.h +test_random.o: ../lib_util.h +test_random.o: ../longbits.h +test_random.o: ../md5.h +test_random.o: ../nametype.h +test_random.o: ../qmath.h +test_random.o: ../shs.h +test_random.o: ../shs1.h +test_random.o: ../string.h +test_random.o: ../value.h +test_random.o: ../zmath.h +test_random.o: ../zrandom.h +test_random.o: test_random.c diff --git a/sample/README_SAMPLE b/sample/README_SAMPLE new file mode 100644 index 0000000..f66ef25 --- /dev/null +++ b/sample/README_SAMPLE @@ -0,0 +1,52 @@ +This directory contains a few examples of how to use libcalc.a. + +For more details on how to use libcalc.a, see the file ../LIBRARY. + +chongo /\oo/\ + +=-= + + +test_random +----------- + + Generate random bits using the Blum-Blum-Shub generator that + is used by the random() and srandom() builtin functions. + + This prog uses the 10th compiled in Blum modulus. + + This routine makes use of some of the lib_util.c routines. + + usage: + + test_random [bitlen [seed_string]] + + bitlen number of random bits to generate (default: 128 bits) + seed_string seed using this ASCII string (default: use default seed) + + +many_random +----------- + + Generate many (100000) sets random bits using the Blum-Blum-Shub + generator that is used by the random() and srandom() builtin functions. + + Output is one set per line. Unlike test_random, the seed is not + printed. There is no leading 0x on numbers and there is no prefix + strings. The only thing printed (normally) is ASCII hex chars and + newlines. + + Unlike test_random, this prog will execute for a while. It is + useful to watch the process size in order to determine of there + is a memory leak. + + This prog uses the 1st compiled in Blum modulus. + + This routine makes use of some of the lib_util.c routines. + + usage: + + many_random [bitlen [seed_string]] + + bitlen number of random bits per line set (default: 128 bits) + seed_string seed using this ASCII string (default: use default seed) diff --git a/sample/many_random.c b/sample/many_random.c new file mode 100644 index 0000000..273d0bc --- /dev/null +++ b/sample/many_random.c @@ -0,0 +1,180 @@ +/* + * many_random - generate many random values via random number generator + * + * usage: + * many_random [[bits] seed_string] + * + * seed_string something for which we can seed (def: default seed) + * bits number of bits to generate + */ + +/* + * 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, + * provided that the above copyright, this permission notice and text + * this comment, 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. + * + * chongo was here /\../\ + */ + + +#if defined(__sgi) +# include "../longbits.h" +# if defined(HAVE_B64) +typedef USB64 k_sigset_t; +# else +typedef struct { + USB32 sigbits[2]; +} k_sigset_t; +# endif +#endif + + +#include +#include +#include "../calc.h" +#include "../zrandom.h" +#include "../have_const.h" +#include "../lib_util.h" + +#define DEF_CNT 128 /* default number of bits to generate */ +#define RESEED 1000 /* number of random numbers to generate */ +#define MANY 100 /* number of random numbers to generate */ + +extern char *program; /* our name */ + + +MAIN +main(int argc, char **argv) +{ + RANDOM *prev_state; /* previous random number state */ + ZVALUE seed; /* seed for Blum-Blum-Shub */ + ZVALUE tmp; /* temp value */ + ZVALUE tmp2; /* temp value */ + ZVALUE random_val; /* random number produced */ + long cnt; /* number of bits to generate */ + char *hexstr; /* random number as hex string */ + int i; + int j; + + /* + * parse args + */ + program = argv[0]; + switch (argc) { + case 3: + seed = convstr2z(argv[2]); + cnt = strtol(argv[1], NULL, 0); + break; + case 2: + seed = _zero_; /* use the default seed */ + cnt = strtol(argv[1], NULL, 0); + break; + case 1: + seed = _zero_; /* use the default seed */ + cnt = DEF_CNT; + break; + default: + fprintf(stderr, "usage: %s [[bits] seed_string]\n", program); + exit(1); + } + if (cnt <= 0) { + fprintf(stderr, "%s: cnt:%d must be > 0\n", program, (int)cnt); + exit(2); + } + + /* + * libcalc setup + */ + libcalc_call_me_first(); + + /* + * reseed every so often + */ + for (j=0; j < RESEED; ++j) { + + /* + * seed the generator + */ + prev_state = zsrandom2(seed, zconst[1]); + if (prev_state == NULL) { + math_error("previous random state is NULL"); + /*NOTREACHED*/ + } + randomfree(prev_state); + + /* + * generate random values forever + */ + for (i=0; i < MANY; ++i) { + + /* + * generate random bits + */ + zrandom(cnt, &random_val); + + /* + * convert into hex string + */ + hexstr = convz2hex(random_val); + printf("%s\n", hexstr); + + /* + * free + */ + if (i < MANY-1) { + zfree(random_val); + } + free(hexstr); + } + + /* + * increment the seed to better test different seeds + * + * NOTE: It is generally a bad idea to use the + * same random number generator to modify + * the seed. We only do this below to + * try different seeds for debugging. + * + * Don't do this in real life applications! + * + * We want to add at least 2^32 to the seed, so + * we do the effect of: + * + * seed += ((last_val<<32) + last_val); + */ + zshift(random_val, 32, &tmp); + zadd(tmp, random_val, &tmp2); + zfree(random_val); + zfree(tmp); + zadd(seed, tmp2, &tmp); + zfree(tmp2); + zfree(seed); + seed = tmp; + } + + /* + * libcalc shutdown + */ + libcalc_call_me_last(); + + /* + * all done + */ + exit(0); +} diff --git a/sample/test_random.c b/sample/test_random.c new file mode 100644 index 0000000..ae60410 --- /dev/null +++ b/sample/test_random.c @@ -0,0 +1,125 @@ +/* + * test_random - test the libcalc random number generator + * + * usage: + * test_random [[bits] seed_string] + * + * seed_string something for which we can seed (def: default seed) + * bits number of bits to generate + */ + +/* + * 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, + * provided that the above copyright, this permission notice and text + * this comment, 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. + * + * chongo was here /\../\ + */ + + +#if defined(__sgi) +# include "../longbits.h" +# if defined(HAVE_B64) +typedef USB64 k_sigset_t; +# else +typedef struct { + USB32 sigbits[2]; +} k_sigset_t; +# endif +#endif + + +#include +#include +#include "../calc.h" +#include "../zrandom.h" +#include "../have_const.h" +#include "../lib_util.h" + +#define DEF_CNT 128 /* default number of bits to generate */ + +extern char *program; /* our name */ + + +MAIN +main(int argc, char **argv) +{ + RANDOM *prev_state; /* previous random number state */ + ZVALUE seed; /* seed for Blum-Blum-Shub */ + ZVALUE random_val; /* random number produced */ + long cnt; /* number of bits to generate */ + char *hexstr; /* random number as hex string */ + + /* + * parse args + */ + program = argv[0]; + switch (argc) { + case 3: + seed = convstr2z(argv[2]); + cnt = strtol(argv[1], NULL, 0); + break; + case 2: + seed = _zero_; /* use the default seed */ + cnt = strtol(argv[1], NULL, 0); + break; + case 1: + seed = _zero_; /* use the default seed */ + cnt = DEF_CNT; + break; + default: + fprintf(stderr, "usage: %s [[bits] seed_string]\n", program); + exit(1); + } + if (cnt <= 0) { + fprintf(stderr, "%s: cnt:%d must be > 0\n", program, (int)cnt); + exit(2); + } + printf("seed= 0x%s\n", convz2hex(seed)); + + /* + * libcalc setup + */ + libcalc_call_me_first(); + + /* + * seed the generator + */ + prev_state = zsrandom2(seed, zconst[10]); + if (prev_state == NULL) { + math_error("previous random state is NULL"); + /*NOTREACHED*/ + } + + /* + * generate random bits + */ + zrandom(cnt, &random_val); + + /* + * convert into hex string + */ + hexstr = convz2hex(random_val); + printf("random= 0x%s\n", hexstr); + + /* + * all done + */ + exit(0); +} diff --git a/shs.c b/shs.c index eb10607..0246f5a 100644 --- a/shs.c +++ b/shs.c @@ -1,4 +1,3 @@ -/* XXX - this code is currently not really used, but it will be soon */ /* * shs - old Secure Hash Standard * @@ -34,7 +33,7 @@ * The SHS algorithm hashes 32 bit unsigned values, 16 at a time. * It further specifies that strings are to be converted into * 32 bit values in BIG ENDIAN order. That is on little endian - * machines, strings are byte swaped into BIG ENDIAN order before + * machines, strings are byte swapped into BIG ENDIAN order before * they are taken 32 bit at a time. Even so, when hashing 32 bit * numeric values the byte order DOES NOT MATTER because the * algorithm works off of their numeric value, not their byte order. @@ -49,16 +48,12 @@ */ #include -#include -#include -#include -#include "calc.h" -#include "zrand.h" #include "longbits.h" #include "align32.h" #include "endian_calc.h" -#include "shs.h" #include "value.h" +#include "hash.h" +#include "shs.h" /* @@ -121,34 +116,30 @@ (e += LEFT_ROT(a,5) + f(b,c,d) + k + data, b = LEFT_ROT(b,30)) -/* forward declarations */ -#if defined(MUST_ALIGN32) -static USB32 in[SHS_CHUNKWORDS]; -#endif -static void shsInit(SHS_INFO*); +/* + * forward declarations + */ +static void shsInit(HASH*); static void shsTransform(USB32*, USB32*); -static void shsUpdate(SHS_INFO*, USB8*, USB32); -static void shsfullUpdate(SHS_INFO*, USB8*, USB32); -static void shsFinal(SHS_INFO*); +static void shsUpdate(HASH*, USB8*, USB32); +static void shsFinal(HASH*); static void shs_chkpt(HASH*); -static void shs_note(HASH*, int); -static void shs_type(HASH*, int); -static HASH *shs_init(HASH*); -static HASH *shs_long(HASH*, long); -static HASH *shs_zvalue(HASH*, ZVALUE); -static HASH *shs_number(HASH*, NUMBER*); -static HASH *shs_complex(HASH*, COMPLEX*); -static HASH *shs_str(HASH*, char*); -static HASH *shs_value(HASH*, VALUE*); -static ZVALUE shs_final(HASH*); +static void shs_note(int, HASH*); +static void shs_type(int, HASH*); +void shs_init_state(HASH*); +static ZVALUE shs_final_state(HASH*); +static int shs_cmp(HASH*, HASH*); +static void shs_print(HASH*); /* * shsInit - initialize the SHS state */ static void -shsInit(SHS_INFO *dig) +shsInit(HASH *state) { + SHS_INFO *dig = &state->h_union.h_shs; /* digest state */ + /* Set the h-vars to their initial values */ dig->digest[0] = h0init; dig->digest[1] = h1init; @@ -278,54 +269,60 @@ shsTransform(USB32 *digest, USB32 *W) /* * shsUpdate - update SHS with arbitrary length data - * - * This code does not assume that the buffer size is a multiple of - * SHS_CHUNKSIZE bytes long. This code handles partial chunk between - * calls to shsUpdate(). */ static void -shsUpdate(SHS_INFO *dig, USB8 *buffer, USB32 count) +shsUpdate(HASH *state, USB8 *buffer, USB32 count) { + SHS_INFO *dig = &state->h_union.h_shs; /* digest state */ USB32 datalen = dig->datalen; + USB32 cpylen; +#if CALC_BYTE_ORDER == LITTLE_ENDIAN + int i; +#endif /* - * Catch the case of a non-empty data buffer + * Update the full count, even if some of it is buffered for later */ - if (datalen > 0) { + SHSCOUNT(dig, count); - /* determine the size we need to copy */ - USB32 cpylen = SHS_CHUNKSIZE - datalen; - /* case: new data will not fill the buffer */ - if (cpylen > count) { - memcpy((char *)dig->data+datalen, - (char *)buffer, count); - dig->datalen = datalen+count; - return; + /* determine the size we need to copy */ + cpylen = SHS_CHUNKSIZE - datalen; - /* case: buffer will be filled */ - } else { - memcpy((char *)dig->data+datalen, - (char *)buffer, cpylen); - shsTransform(dig->digest, dig->data); - buffer += cpylen; - count -= cpylen; - dig->datalen = 0; - } + /* case: new data will not fill the buffer */ + if (cpylen > count) { + memcpy((char *)dig->data + datalen, + (char *)buffer, count); + dig->datalen = datalen+count; + return; } + /* case: buffer will be filled */ + memcpy((char *)dig->data + datalen, (char *)buffer, cpylen); + /* - * Process data in SHS_CHUNKSIZE chunks + * process data in SHS_CHUNKSIZE chunks */ - if (count >= SHS_CHUNKSIZE) { - shsfullUpdate(dig, buffer, count); - buffer += (count/SHS_CHUNKSIZE)*SHS_CHUNKSIZE; - count %= SHS_CHUNKSIZE; + for (;;) { + +#if CALC_BYTE_ORDER == LITTLE_ENDIAN + if (state->bytes) { + for (i=0; i < SHS_CHUNKWORDS; ++i) { + SWAP_B8_IN_B32(dig->data+i, dig->data+i); + } + } +#endif + shsTransform(dig->digest, dig->data); + buffer += cpylen; + count -= cpylen; + if (count < SHS_CHUNKSIZE) + break; + cpylen = SHS_CHUNKSIZE; + memcpy((char *) dig->data, (char *) buffer, cpylen); } /* * Handle any remaining bytes of data. - * This should only happen once on the final lot of data */ if (count > 0) { memcpy((char *)dig->data, (char *)buffer, count); @@ -334,35 +331,6 @@ shsUpdate(SHS_INFO *dig, USB8 *buffer, USB32 count) } -/* - * shsfullUpdate - update SHS with chunk multiple length data - * - * This function assumes that count is a multiple of SHS_CHUNKSIZE and that - * no partial chunk is left over from a previous call. - */ -static void -shsfullUpdate(SHS_INFO *dig, USB8 *buffer, USB32 count) -{ - /* - * Process data in SHS_CHUNKSIZE chunks - */ - while (count >= SHS_CHUNKSIZE) { -#if defined(MUST_ALIGN32) - if ((long)buffer & (sizeof(USB32)-1)) { - memcpy((char *)in, (char *)buffer, SHS_CHUNKSIZE); - shsTransform(dig->digest, in); - } else { - shsTransform(dig->digest, (USB32 *)buffer); - } -#else - shsTransform(dig->digest, (USB32 *)buffer); -#endif - buffer += SHS_CHUNKSIZE; - count -= SHS_CHUNKSIZE; - } -} - - /* * shsFinal - perform final SHS transforms * @@ -380,38 +348,53 @@ shsfullUpdate(SHS_INFO *dig, USB8 *buffer, USB32 count) * remaining. This final chunk is transformed. */ static void -shsFinal(SHS_INFO *dig) +shsFinal(HASH *state) { + SHS_INFO *dig = &state->h_union.h_shs; /* digest state */ long count = (long)(dig->datalen); - USB32 lowBitcount = dig->countLo; - USB32 highBitcount = dig->countHi; -#if BYTE_ORDER == LITTLE_ENDIAN + USB32 lowBitcount; + USB32 highBitcount; + USB8 *data = (USB8 *) dig->data; +#if CALC_BYTE_ORDER == LITTLE_ENDIAN int i; #endif /* - * Set the first char of padding to 0x80. - * This is safe since there is always at least one byte free + * If processing bytes, set the first byte of padding to 0x80. + * if processing words: on a big-endian machine set the first + * byte of padding to 0x80, on a little-endian machine set + * the first four bytes to 0x00000080 + * This is safe since there is always at least one byte or word free */ - ((USB8 *)dig->data)[count++] = 0x80; - /* Pad out to 56 mod SHS_CHUNKSIZE */ - if (count > SHS_CHUNKSIZE-8) { - /* Pad the first chunk to SHS_CHUNKSIZE bytes */ - memset((USB8 *)dig->data + count, 0, SHS_CHUNKSIZE - count); + /* Pad to end of chunk */ + + memset(data + count, 0, SHS_CHUNKSIZE - count); + +#if CALC_BYTE_ORDER == LITTLE_ENDIAN + if (state->bytes) { + data[count] = 0x80; + for (i=0; i < SHS_CHUNKWORDS; ++i) { + SWAP_B8_IN_B32(dig->data+i, dig->data+i); + } + } + else { + if (count % 4) { + math_error("This should not happen in shsFinal"); + /*NOTREACHED*/ + } + data[count + 3] = 0x80; + } +#else + data[count] = 0x80; +#endif + + if (count >= SHS_CHUNKSIZE-8) { shsTransform(dig->digest, dig->data); - /* Now fill the next chunk with 56 bytes */ - memset(dig->data, 0, SHS_CHUNKSIZE-8); - } else { - /* Pad chunk to 56 bytes */ - memset((USB8 *)dig->data + count, 0, SHS_CHUNKSIZE-8 - count); + /* Now fill another chunk with 56 bytes */ + memset(data, 0, SHS_CHUNKSIZE-8); } -#if BYTE_ORDER == LITTLE_ENDIAN - for (i=0; i < SHS_CHUNKWORDS; ++i) { - SWAP_B8_IN_B32(dig->data+i, dig->data+i); - } -#endif /* * Append length in bits and transform @@ -419,6 +402,8 @@ shsFinal(SHS_INFO *dig) * We assume that bit count is a multiple of 8 because we have * only processed full bytes. */ + highBitcount = dig->countHi; + lowBitcount = dig->countLo; dig->data[SHS_HIGH] = (highBitcount << 3) | (lowBitcount >> 29); dig->data[SHS_LOW] = (lowBitcount << 3); shsTransform(dig->digest, dig->data); @@ -438,7 +423,10 @@ shsFinal(SHS_INFO *dig) static void shs_chkpt(HASH *state) { - SHS_INFO *dig = &state->h_shs; /* digest state */ + SHS_INFO *dig = &state->h_union.h_shs; /* digest state */ +#if CALC_BYTE_ORDER == LITTLE_ENDIAN + int i; +#endif /* * checkpoint if partial buffer exists @@ -448,6 +436,13 @@ shs_chkpt(HASH *state) /* pad to the end of the chunk */ memset((USB8 *)dig->data + dig->datalen, 0, SHS_CHUNKSIZE-dig->datalen); +#if CALC_BYTE_ORDER == LITTLE_ENDIAN + if (state->bytes) { + for (i=0; i < SHS_CHUNKWORDS; ++i) { + SWAP_B8_IN_B32(dig->data+i, dig->data+i); + } + } +#endif /* transform padded chunk */ shsTransform(dig->digest, dig->data); @@ -455,9 +450,6 @@ shs_chkpt(HASH *state) /* empty buffer */ dig->datalen = 0; - - /* previous value is now not a string */ - state->prevstr = FALSE; } return; } @@ -475,9 +467,9 @@ shs_chkpt(HASH *state) * and array of HALFs. */ static void -shs_note(HASH *state, int special) +shs_note(int special, HASH *state) { - SHS_INFO *dig = &state->h_shs; /* digest state */ + SHS_INFO *dig = &state->h_union.h_shs; /* digest state */ int i; /* @@ -487,7 +479,6 @@ shs_note(HASH *state, int special) for (i=1; i < SHS_DIGESTWORDS; ++i) { dig->digest[i] ^= (special + dig->digest[i-1] + i); } - state->prevstr = FALSE; /* it is as we just hashed a non-string */ return; } @@ -502,14 +493,14 @@ shs_note(HASH *state, int special) * This function will note that a type of value is about to be hashed. * The type of a VALUE will be noted. For purposes of hash comparison, * we will do nothing with V_NUM and V_COM so that the other functions - * can hash to the same value reguardless of if shs_value() is called + * can hash to the same value regardless of if shs_value() is called * or not. We also do nothing with V_STR so that a hash of a string * will produce the same value as the standard hash function. */ static void -shs_type(HASH *state, int type) +shs_type(int type, HASH *state) { - SHS_INFO *dig = &state->h_shs; /* digest state */ + SHS_INFO *dig = &state->h_union.h_shs; /* digest state */ int i; /* @@ -526,647 +517,46 @@ shs_type(HASH *state, int type) for (i=1; i < SHS_DIGESTWORDS; ++i) { dig->digest[i] += ((type+i) ^ dig->digest[i-1]); } - state->prevstr = FALSE; /* it is as if we just hashed a non-string */ return; } /* - * shs_init - initialize SHS hash state + * shs_init_state - initialize a hash state structure for this hash * * given: - * state the state to initialize, or NULL to malloc it - * - * returns: - * initialized state + * state - pointer to the hfunction element to initialize */ -static HASH * -shs_init(HASH *state) +void +shs_init_state(HASH *state) { /* - * malloc if needed + * initalize state */ - if (state == NULL) { - state = (HASH *)malloc(sizeof(HASH)); - if (state == NULL) { - math_error("cannot malloc HASH"); - /*NOTREACHED*/ - } - } + state->hashtype = SHS_HASH_TYPE; + state->bytes = TRUE; + state->update = shsUpdate; + state->chkpt = shs_chkpt; + state->note = shs_note; + state->type = shs_type; + state->final = shs_final_state; + state->cmp = shs_cmp; + state->print = shs_print; + state->base = SHS_BASE; + state->chunksize = SHS_CHUNKSIZE; + state->unionsize = sizeof(SHS_INFO); /* - * initialize + * perform the internal init function */ - shsInit((SHS_INFO *)state); - state->prevstr = FALSE; - - /* - * return state - */ - return (HASH *)state; + memset((void *)&(state->h_union.h_shs), 0, sizeof(SHS_INFO)); + shsInit(state); + return; } /* - * shs_long - note a long value - * - * given: - * state the state to hash - * longval a long value - * - * returns: - * the new state - * - * This function will hash a long value as if it were a 64 bit value. - * The input is a long. If a long is smaller than 64 bits, we will - * hash a final 32 bits of zeros. - */ -static HASH * -shs_long(HASH *state, long longval) -{ - SHS_INFO *dig; /* digest state */ - long lval[64/LONG_BITS]; /* 64 bits of longs */ - - /* - * initialize if state is NULL - */ - if (state == NULL) { - state = shs_init(state); - } - - /* - * setup for the long value hash - */ - shs_chkpt(state); - - /* - * catch the zero numeric value special case - */ - if (longval == 0) { - /* note a zero numeric value and return */ - shs_note(state, SHS_HASH_ZERO); - state->prevstr = FALSE; /* we just hashed a non-string */ - return state; - } - - /* - * prep for a long value hash - */ - shs_note(state, SHS_BASE); - dig = &state->h_shs; - - /* - * hash as if we have a 64 bit value - */ - memset((char *)lval, 0, sizeof(lval)); - lval[0] = longval; - shsUpdate(dig, (USB8 *)lval, sizeof(lval)); - SHSCOUNT(dig, 64/8); - - /* - * all done - */ - state->prevstr = FALSE; /* we just hashed a non-string */ - return state; -} - - -/* - * shs_zvalue - hash a ZVALUE - * - * given: - * state the state to hash or NULL - * zval the ZVALUE - * - * returns: - * the new state - */ -static HASH * -shs_zvalue(HASH *state, ZVALUE zval) -{ - SHS_INFO *dig; /* digest state */ -#if BYTE_ORDER == BIG_ENDIAN && BASEB == 16 - HALF half[SHS_CHUNKHALFS]; /* SHS chunk buffer as HALFs */ - int full_lim; /* HALFs in whole chunks in zval */ - int i; - int j; -#endif - - /* - * initialize if state is NULL - */ - if (state == NULL) { - state = shs_init(state); - } - - /* - * setup for the ZVALUE hash - */ - shs_chkpt(state); - - /* - * catch the zero numeric value special case - */ - if (ziszero(zval)) { - /* note a zero numeric value and return */ - shs_note(state, SHS_HASH_ZERO); - state->prevstr = FALSE; /* we just hashed a non-string */ - return state; - } - - /* - * prep for a ZVALUE hash - */ - shs_note(state, SHS_HASH_ZVALUE); - /* note if we have a negative value */ - if (zisneg(zval)) { - shs_note(state, SHS_HASH_NEG); - } - dig = &state->h_shs; - -#if BYTE_ORDER == BIG_ENDIAN && BASEB == 16 - - /* - * hash full chunks - * - * We need to convert the array of HALFs into canonical architectural - * independent form -- 32 bit arrays. Because we have 16 bit values - * in Big Endian form, we need to swap 16 bit values so that they - * appear as 32 bit Big Endian values. - */ - full_lim = (zval.len / SHS_CHUNKHALFS) * SHS_CHUNKHALFS; - for (i=0; i < full_lim; i += SHS_CHUNKHALFS) { - /* HALF swap copy a chunk into a data buffer */ - for (j=0; j < SHS_CHUNKHALFS; j += 2) { - half[j] = zval.v[i+j+1]; - half[j+1] = zval.v[i+j]; - } - shsfullUpdate(dig, (USB8 *)half, SHS_CHUNKSIZE); - } - - /* - * hash the final partial chunk (if any) - * - * We need to convert the array of HALFs into canonical architectural - * independent form -- 32 bit arrays. Because we have 16 bit values - * in Big Endian form, we need to swap 16 bit values so that they - * appear as 32 bit Big Endian values. - */ - if (zval.len > full_lim) { - for (j=0; j < zval.len-full_lim-1; j += 2) { - half[j] = zval.v[full_lim+i+1]; - half[j+1] = zval.v[full_lim+i]; - } - if (j < zval.len-full_lim) { - half[j] = (HALF)0; - half[j+1] = zval.v[zval.len-1]; - --full_lim; - SHSCOUNT(dig, sizeof(HALF)); - } - shsUpdate(dig, (USB8 *)half, - (zval.len-full_lim)*sizeof(HALF)); - } - SHSCOUNT(dig, zval.len*sizeof(HALF)); - -#else - - /* - * hash the array of HALFs - * - * The array of HALFs is equivalent to the canonical architectural - * independent form. We either have 32 bit HALFs (in which case - * we do not case the byte order) or we have 16 bit HALFs in Little - * Endian order (which happens to be laid out in the same order as - * 32 bit values). - */ - shsUpdate(dig, (USB8 *)zval.v, zval.len*sizeof(HALF)); - SHSCOUNT(dig, zval.len*sizeof(HALF)); - -#endif - - /* - * all done - */ - state->prevstr = FALSE; /* we just hashed a non-string */ - return state; -} - - -/* - * shs_number - hash a NUMBER - * - * given: - * state the state to hash or NULL - * number the NUMBER - * - * returns: - * the new state - */ -static HASH * -shs_number(HASH *state, NUMBER *number) -{ - BOOL sign; /* sign of the denominator */ - - /* - * initialize if state is NULL - */ - if (state == NULL) { - state = shs_init(state); - } - - /* - * setup for the ZVALUE hash - */ - shs_chkpt(state); - - /* - * process the numerator - */ - state = shs_zvalue(state, number->num); - - /* - * if the NUMBER is not an integer, process the denominator - */ - if (qisfrac(number)) { - - /* note the division */ - shs_note(state, SHS_HASH_DIV); - - /* hash denominator as positive -- just in case */ - sign = number->den.sign; - number->den.sign = 0; - - /* hash the denominator */ - state = shs_zvalue(state, number->den); - - /* restore the sign */ - number->den.sign = sign; - } - - /* - * all done - */ - state->prevstr = FALSE; /* we just hashed a non-string */ - return state; -} - - -/* - * shs_complex - hash a COMPLEX - * - * given: - * state the state to hash or NULL - * complex the COMPLEX - * - * returns: - * the new state - */ -static HASH * -shs_complex(HASH *state, COMPLEX *complex) -{ - /* - * initialize if state is NULL - */ - if (state == NULL) { - state = shs_init(state); - } - - /* - * setup for the COMPLEX hash - */ - shs_chkpt(state); - - /* - * catch the zero special case - */ - if (ciszero(complex)) { - /* note a zero numeric value and return */ - shs_note(state, SHS_HASH_ZERO); - state->prevstr = FALSE; /* we just hashed a non-string */ - return state; - } - - /* - * process the real value if not pure imaginary - * - * We will ignore the real part if the value is of the form 0+xi. - */ - if (!qiszero(complex->real)) { - state = shs_number(state, complex->real); - } - - /* - * if the NUMBER is not real, process the imaginary value - * - * We will ignore the imaginary part of the value is of the form x+0i. - */ - if (!cisreal(complex)) { - - /* note the sqrt(-1) */ - shs_note(state, SHS_HASH_COMPLEX); - - /* hash the imaginary value */ - state = shs_number(state, complex->imag); - } - - /* - * all done - */ - state->prevstr = FALSE; /* we just hashed a non-string */ - return state; -} - - -/* - * shs_str - hash a string - * - * given: - * state the state to hash or NULL - * str the string - * - * returns: - * the new state - */ -static HASH * -shs_str(HASH *state, char *str) -{ - SHS_INFO *dig; /* digest state */ -#if BYTE_ORDER == LITTLE_ENDIAN - char *newstr; /* Big Endian version of str */ - USB32 newlen; /* newstr string length */ - int i; -#endif - USB32 len; /* string length */ - - /* - * initialize if state is NULL - */ - if (state == NULL) { - state = shs_init(state); - } - - /* - * setup for the string hash - */ - if (!state->prevstr) { - shs_chkpt(state); - } - len = strlen(str); - dig = &state->h_shs; - -#if BYTE_ORDER == BIG_ENDIAN - /* - * shs hashes in Big Endian form directly - */ - shsUpdate(dig, (USB8*)str, len); -#else - /* - * we must convert from Little Endian string to Big Endian string - */ - newlen = ((len+3)/4)*4; - newstr = (char *)malloc(newlen+1); - if (newstr) { - math_error("hash of string malloc failed"); - /*NOTREACHED*/ - } - strcpy(newstr, str); - newstr[len+1] = 0; - newstr[len+2] = 0; - newstr[len+3] = 0; - for (i=0; i < newlen; i += 4) { - SWAP_B8_IN_B32(newstr+i, newstr+i); - } - shsUpdate(dig, (USB8*)newstr, newlen); -#endif - SHSCOUNT((SHS_INFO *)dig, len); - - /* - * all done - */ - state->prevstr = TRUE; /* we just hashed a string */ - return state; -} - - -/* - * shs_value - hash a value - * - * given: - * state the state to hash or NULL - * value the value - * - * returns: - * the new state - */ -static HASH * -shs_value(HASH *state, VALUE *value) -{ - SHS_INFO *dig; /* digest state */ - LISTELEM *ep; /* list element pointer */ - ASSOCELEM **assochead; /* association chain head */ - ASSOCELEM *aep; /* current association value */ - ASSOCELEM *nextaep; /* next association value */ - VALUE *vp; /* pointer to next OBJ table value */ - ZVALUE fileval; /* size, position, dev, inode of a file */ - int i; - - /* - * initialize if state is NULL - */ - if (state == NULL) { - state = shs_init(state); - } - - /* - * setup for the next type of value - */ - shs_chkpt(state); - shs_type(state, value->v_type); - dig = &state->h_shs; - - /* - * process the value type - */ - switch (value->v_type) { - case V_INT: - /* hash as if we have a 64 bit value */ - state = shs_long(state, (long)value->v_int); - break; - case V_NUM: - state = shs_number(state, value->v_num); - break; - case V_COM: - state = shs_complex(state, value->v_com); - break; - case V_ADDR: - state = shs_value(state, value->v_addr); - break; - case V_STR: - state = shs_str(state, value->v_str); - break; - case V_MAT: - /* hash all the elements of the matrix */ - for (i=0; i < value->v_mat->m_size; ++i) { - /* force strings to not be concatinated */ - state->prevstr = FALSE; - /* hash the next matrix value */ - state = shs_value(state, value->v_mat->m_table+i); - } - /* don't allow the next string to concatinate to the matrix */ - state->prevstr = FALSE; - break; - case V_LIST: - /* hash all the elements of the list */ - for (i=0, ep = value->v_list->l_first; - ep != NULL && i < value->v_list->l_count; - ++i, ep = ep->e_next) { - /* force strings to not be concatinated */ - state->prevstr = FALSE; - /* hash the next list value */ - state = shs_value(state, &ep->e_value); - } - /* don't allow the next string to concatinate to the list */ - state->prevstr = FALSE; - break; - case V_ASSOC: - assochead = value->v_assoc->a_table; - for (i = 0; i < value->v_assoc->a_size; i++) { - nextaep = *assochead; - while (nextaep) { - aep = nextaep; - nextaep = aep->e_next; - /* force strings to not be concatinated */ - state->prevstr = FALSE; - /* hash the next association value */ - state = shs_value(state, &aep->e_value); - } - assochead++; - } - /* don't allow the next string to concatinate to the assoc */ - state->prevstr = FALSE; - break; - case V_OBJ: - for (i=value->v_obj->o_actions->count, vp=value->v_obj->o_table; - i-- > 0; - vp++) { - /* force strings to not be concatinated */ - state->prevstr = FALSE; - /* hash the next object value */ - shs_value(state, vp); - } - /* don't allow the next string to concatinate to the object */ - state->prevstr = FALSE; - break; - case V_FILE: - /* hash file length if possible */ - if (getsize(value->v_file, &fileval) == 0) { - state = shs_zvalue(state, fileval); - zfree(fileval); - } else { - /* hash -1 for invalid length */ - state = shs_long(state, (long)-1); - } - /* hash the file position if possible */ - if (getloc(value->v_file, &fileval) == 0) { - state = shs_zvalue(state, fileval); - zfree(fileval); - } else { - /* hash -1 for invalid location */ - state = shs_long(state, (long)-1); - } - /* hash the file device if possible */ - if (get_device(value->v_file, &fileval) == 0) { - state = shs_zvalue(state, fileval); - zfree(fileval); - } else { - /* hash -1 for invalid device */ - state = shs_long(state, (long)-1); - } - /* hash the file inode if possible */ - if (get_inode(value->v_file, &fileval) == 0) { - state = shs_zvalue(state, fileval); - zfree(fileval); - } else { - /* hash -1 for invalid inode */ - state = shs_long(state, (long)-1); - } - break; - case V_RAND: - state = shs_long(state, (long)value->v_rand->seeded); - state = shs_long(state, (long)value->v_rand->bits); - shsUpdate(dig, (USB8 *)value->v_rand->buffer, SLEN*FULL_BITS/8); - SHSCOUNT(dig, SLEN*FULL_BITS/8); - state = shs_long(state, (long)value->v_rand->j); - state = shs_long(state, (long)value->v_rand->k); - shsUpdate(dig, (USB8 *)value->v_rand->slot, SCNT*FULL_BITS/8); - SHSCOUNT(dig, SCNT*FULL_BITS/8); - shsUpdate(dig, (USB8*)value->v_rand->shuf, SHUFLEN*FULL_BITS/8); - SHSCOUNT(dig, SHUFLEN*FULL_BITS/8); - /* don't allow the next string to concatinate to the list */ - state->prevstr = FALSE; - break; - case V_RANDOM: - state = shs_long(state, (long)value->v_random->seeded); - state = shs_long(state, (long)value->v_random->bits); - shsUpdate(dig, (USB8 *)&(value->v_random->buffer), BASEB/8); - SHSCOUNT(dig, SLEN*FULL_BITS/8); - state = shs_zvalue(state, *(value->v_random->r)); - state = shs_zvalue(state, *(value->v_random->n)); - /* don't allow the next string to concatinate to the list */ - state->prevstr = FALSE; - break; - case V_CONFIG: - state = shs_long(state, (long)value->v_config->outmode); - state = shs_long(state, (long)value->v_config->outdigits); - state = shs_number(state, value->v_config->epsilon); - state = shs_long(state, (long)value->v_config->epsilonprec); - state = shs_long(state, (long)value->v_config->traceflags); - state = shs_long(state, (long)value->v_config->maxprint); - state = shs_long(state, (long)value->v_config->mul2); - state = shs_long(state, (long)value->v_config->sq2); - state = shs_long(state, (long)value->v_config->pow2); - state = shs_long(state, (long)value->v_config->redc2); - state = shs_long(state, (long)value->v_config->tilde_ok); - state = shs_long(state, (long)value->v_config->tab_ok); - state = shs_long(state, (long)value->v_config->quomod); - state = shs_long(state, (long)value->v_config->quo); - state = shs_long(state, (long)value->v_config->mod); - state = shs_long(state, (long)value->v_config->sqrt); - state = shs_long(state, (long)value->v_config->appr); - state = shs_long(state, (long)value->v_config->cfappr); - state = shs_long(state, (long)value->v_config->cfsim); - state = shs_long(state, (long)value->v_config->outround); - state = shs_long(state, (long)value->v_config->round); - state = shs_long(state, (long)value->v_config->leadzero); - state = shs_long(state, (long)value->v_config->fullzero); - state = shs_long(state, (long)value->v_config->maxerrorcount); - state = shs_str(state, value->v_config->prompt1); - state = shs_str(state, value->v_config->prompt2); - /* don't allow the next string to concatinate to the list */ - state->prevstr = FALSE; - break; - case V_HASH: - if (value->v_hash->type == SHS_HASH_TYPE) { - shsUpdate(dig, (USB8 *)&value->v_hash->h_shs, - sizeof(SHS_INFO)); - SHSCOUNT(dig, sizeof(SHS_INFO)); - } else { - math_error("SHS hashing a non-SHS hash state"); - /*NOTREACHED*/ - } - /* don't allow the next string to concatinate to the list */ - state->prevstr = FALSE; - break; - default: - math_error("hashing an unknown value"); - /*NOTREACHED*/ - } - return state; -} - - -/* - * shs_final - complete hash state and return a ZVALUE + * shs_final_state - complete hash state and return a ZVALUE * * given: * state the state to complete and convert @@ -1175,26 +565,28 @@ shs_value(HASH *state, VALUE *value) * a ZVALUE representing the state */ static ZVALUE -shs_final(HASH *state) +shs_final_state(HASH *state) { - SHS_INFO *dig; /* digest state */ + SHS_INFO *dig = &state->h_union.h_shs; /* digest state */ ZVALUE ret; /* return ZVALUE of completed hash state */ -#if BTYE_ORDER == BIG_ENDIAN && BASEB == 16 int i; -#endif /* - * initialize if state is NULL + * malloc and initialize if state is NULL */ if (state == NULL) { - state = shs_init(state); + state = (HASH *)malloc(sizeof(HASH)); + if (state == NULL) { + math_error("cannot malloc HASH"); + /*NOTREACHED*/ + } + shs_init_state(state); } /* * complete the hash state */ - dig = &state->h_shs; - shsFinal(dig); + shsFinal(state); /* * allocate storage for ZVALUE @@ -1206,14 +598,17 @@ shs_final(HASH *state) /* * load ZVALUE */ -#if BTYE_ORDER == BIG_ENDIAN && BASEB == 16 +#if BASEB == 16 for (i=0; i < ret.len; i+=2) { - rev.v[i+1] = ((HALF*)dig->digest)[i]; - rev.v[i] = ((HALF*)dig->digest)[i+1]; + ret.v[ret.len-i-1] = ((HALF*)dig->digest)[i+1]; + ret.v[ret.len-i-2] = ((HALF*)dig->digest)[i]; } #else - memcpy(ret.v, dig->digest, SHS_DIGESTSIZE); + for (i=0; i < ret.len; ++i) { + ret.v[ret.len-i-1] = ((HALF*)dig->digest)[i]; + } #endif + ztrim(&ret); /* * return ZVALUE @@ -1223,25 +618,102 @@ shs_final(HASH *state) /* - * shs_hashfunc - initialize a hashfunc for an interface for this hash + * shs_cmp - compare two hash states * * given: - * hfunc - pointer to the hfunction element to initialize + * a first hash state + * b second hash state + * + * returns: + * TRUE => hash states are different + * FALSE => hash states are the same */ -void -shs_hashfunc(HASHFUNC *hfunc) +static int +shs_cmp(HASH *a, HASH *b) { /* - * initalize + * firewall and quick check */ - hfunc->type = SHS_HASH_TYPE; - hfunc->init = shs_init; - hfunc->longval = shs_long; - hfunc->str = shs_str; - hfunc->value = shs_value; - hfunc->complex = shs_complex; - hfunc->number = shs_number; - hfunc->zvalue = shs_zvalue; - hfunc->final = shs_final; + if (a == b) { + /* pointers to the same object */ + return FALSE; + } + if (a == NULL || b == NULL) { + /* one is NULL, so they differ */ + return TRUE; + } + + /* + * compare data-reading modes + */ + if (a->bytes != b->bytes) + return TRUE; + + /* + * compare bit counts + */ + if (a->h_union.h_shs.countLo != b->h_union.h_shs.countLo || + a->h_union.h_shs.countHi != b->h_union.h_shs.countHi) { + /* counts differ */ + return TRUE; + } + + /* + * compare pending buffers + */ + if (a->h_union.h_shs.datalen != b->h_union.h_shs.datalen) { + /* buffer lengths differ */ + return TRUE; + } + if (memcmp((USB8*)a->h_union.h_shs.data, + (USB8*)b->h_union.h_shs.data, + a->h_union.h_shs.datalen) != 0) { + /* buffer contents differ */ + return TRUE; + } + + /* + * compare digest + */ + return (memcmp((USB8*)(a->h_union.h_shs.digest), + (USB8*)(b->h_union.h_shs.digest), + SHS_DIGESTSIZE) != 0); +} + + +/* + * shs_print - print a hash state + * + * given: + * state the hash state to print + */ +static void +shs_print(HASH *state) +{ + /* + * form the hash value + */ + if (conf->calc_debug > 0) { + char buf[DEBUG_SIZE+1]; /* hash value buffer */ + + /* + * print numeric debug value + * + * NOTE: This value represents only the hash value as of + * the last full update or finalization. Thus it + * may NOT be the actual hash value. + */ + sprintf(buf, + "sha: 0x%08x%08x%08x%08x%08x data: %d octets", + (int)state->h_union.h_shs.digest[0], + (int)state->h_union.h_shs.digest[1], + (int)state->h_union.h_shs.digest[2], + (int)state->h_union.h_shs.digest[3], + (int)state->h_union.h_shs.digest[4], + (int)state->h_union.h_shs.datalen); + math_str(buf); + } else { + math_str("sha hash state"); + } return; } diff --git a/shs.h b/shs.h index 65fa555..a1cb24d 100644 --- a/shs.h +++ b/shs.h @@ -1,4 +1,3 @@ -/* XXX - this code is currently not really used, but it will be soon */ /* * shs - old Secure Hash Standard * @@ -25,20 +24,16 @@ * 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. - * - * See shsdrvr.c for version and modification history. */ -#if !defined(SHS_H) -#define SHS_H -#include -#include +#if !defined(__SHS_H__) +#define __SHS_H__ + /* SHS_CHUNKSIZE must be a power of 2 - fixed value defined by the algorithm */ #define SHS_CHUNKSIZE (1<<6) #define SHS_CHUNKWORDS (SHS_CHUNKSIZE/sizeof(USB32)) -#define SHS_CHUNKHALFS (SHS_CHUNKSIZE/sizeof(HALF)) /* SHS_DIGESTSIZE is a the length of the digest as defined by the algorithm */ #define SHS_DIGESTSIZE (20) @@ -50,25 +45,17 @@ /* SHS_HIGH - where high 32 bits of 64 bit count is stored during final */ #define SHS_HIGH 14 -/* what to xor to digest value when hashing special values */ -#define SHS_BASE 0x1234face /* base special hash value */ -#define SHS_HASH_NEG (1+SHS_BASE) /* note a negative value */ -#define SHS_HASH_COMPLEX (2+SHS_BASE) /* note a complex value */ -#define SHS_HASH_DIV (4+SHS_BASE) /* note a division by a value */ -#define SHS_HASH_ZERO (8+SHS_BASE) /* note a zero numeric value */ -#define SHS_HASH_ZVALUE (16+SHS_BASE) /* note a ZVALUE */ - /* * The structure for storing SHS info * * We will assume that bit count is a multiple of 8. */ typedef struct { - USB32 digest[SHS_DIGESTWORDS]; /* message digest */ - USB32 countLo; /* 64 bit count: bits 3-34 */ - USB32 countHi; /* 64 bit count: bits 35-63 */ - USB32 datalen; /* length of data in data */ - USB32 data[SHS_CHUNKWORDS]; /* SHS chunk buffer */ + USB32 digest[SHS_DIGESTWORDS]; /* message digest */ + USB32 countLo; /* 64 bit count: bits 3-34 */ + USB32 countHi; /* 64 bit count: bits 35-63 */ + USB32 datalen; /* length of data in data */ + USB32 data[SHS_CHUNKWORDS]; /* SHS chunk buffer */ } SHS_INFO; /* @@ -77,12 +64,13 @@ typedef struct { * We will count bytes and convert to bit count during the final * transform. This assumes that the count is < 2^32. */ -#define SHSCOUNT(shsinfo, count) { \ - USB32 tmp_countLo; \ - tmp_countLo = (shsinfo)->countLo; \ - if (((shsinfo)->countLo += (count)) < tmp_countLo) { \ - (shsinfo)->countHi++; \ - } \ +#define SHSCOUNT(shsinfo, count) { \ + USB32 tmp_countLo; \ + tmp_countLo = (shsinfo)->countLo; \ + if (((shsinfo)->countLo += (count)) < tmp_countLo) { \ + (shsinfo)->countHi++; \ + } \ } -#endif + +#endif /* !__SHS_H__ */ diff --git a/shs1.c b/shs1.c new file mode 100644 index 0000000..305cf8c --- /dev/null +++ b/shs1.c @@ -0,0 +1,695 @@ +/* + * shs1 - implements new NIST Secure Hash Standard-1 (SHS1) + * + * Written 2 September 1992, Peter C. Gutmann. + * + * This file was Modified/Re-written by: + * + * Landon Curt Noll (chongo@toad.com) chongo /\../\ + * + * This code has been placed in the public domain. Please do not + * copyright this code. + * + * LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO + * THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MER- + * CHANTABILITY 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. + */ + +#include +#include "longbits.h" +#include "align32.h" +#include "endian_calc.h" +#include "value.h" +#include "hash.h" +#include "shs.h" + + +/* + * The SHS1 f()-functions. The f1 and f3 functions can be optimized + * to save one boolean operation each - thanks to Rich Schroeppel, + * rcs@cs.arizona.edu for discovering this. + * + * f1: ((x&y) | (~x&z)) == (z ^ (x&(y^z))) + * f3: ((x&y) | (x&z) | (y&z)) == ((x&y) | (z&(x|y))) + */ +#define f1(x,y,z) (z ^ (x&(y^z))) /* Rounds 0-19 */ +#define f2(x,y,z) (x^y^z) /* Rounds 20-39 */ +#define f3(x,y,z) ((x&y) | (z&(x|y))) /* Rounds 40-59 */ +#define f4(x,y,z) (x^y^z) /* Rounds 60-79 */ + +/* The SHS1 Mysterious Constants */ +#define K1 0x5A827999L /* Rounds 0-19 */ +#define K2 0x6ED9EBA1L /* Rounds 20-39 */ +#define K3 0x8F1BBCDCL /* Rounds 40-59 */ +#define K4 0xCA62C1D6L /* Rounds 60-79 */ + +/* SHS1 initial values */ +#define h0init 0x67452301L +#define h1init 0xEFCDAB89L +#define h2init 0x98BADCFEL +#define h3init 0x10325476L +#define h4init 0xC3D2E1F0L + +/* 32-bit rotate left - kludged with shifts */ +#define LEFT_ROT(X,n) (((X)<<(n)) | ((X)>>(32-(n)))) + +/* + * + * The initial expanding function. The hash function is defined over an + * 80-word expanded input array W, where the first 16 are copies of the input + * data, and the remaining 64 are defined by + * + * W[i] = LEFT_ROT(W[i-16] ^ W[i-14] ^ W[i-8] ^ W[i-3], 1) + * + * NOTE: The expanding function used in rounds 16 to 79 was changed from the + * original SHA (in FIPS Pub 180) to one that also left circular shifted + * by one bit for Secure Hash Algorithm-1 (FIPS Pub 180-1). + */ +#define exor(W,i,t) \ + (t = (W[i&15] ^ W[(i-14)&15] ^ W[(i-8)&15] ^ W[(i-3)&15]), \ + W[i&15] = LEFT_ROT(t, 1)) + +/* + * The prototype SHS1 sub-round. The fundamental sub-round is: + * + * a' = e + LEFT_ROT(a,5) + f(b,c,d) + k + data; + * b' = a; + * c' = LEFT_ROT(b,30); + * d' = c; + * e' = d; + * + * but this is implemented by unrolling the loop 5 times and renaming the + * variables ( e, a, b, c, d ) = ( a', b', c', d', e' ) each iteration. + * This code is then replicated 20 times for each of the 4 functions, using + * the next 20 values from the W[] array each time. + */ +#define subRound(a, b, c, d, e, f, k, data) \ + (e += LEFT_ROT(a,5) + f(b,c,d) + k + data, b = LEFT_ROT(b,30)) + +/* forward declarations */ +static void shs1Init(HASH*); +static void shs1Transform(USB32*, USB32*); +static void shs1Update(HASH*, USB8*, USB32); +static void shs1Final(HASH*); +static void shs1_chkpt(HASH*); +static void shs1_note(int, HASH*); +static void shs1_type(int, HASH*); +void shs1_init_state(HASH*); +static ZVALUE shs1_final_state(HASH*); +static int shs1_cmp(HASH*, HASH*); +static void shs1_print(HASH*); + + +/* + * shs1Init - initialize the SHS1 state + */ +static void +shs1Init(HASH *state) +{ + SHS1_INFO *dig = &state->h_union.h_shs1; /* digest state */ + + /* Set the h-vars to their initial values */ + dig->digest[0] = h0init; + dig->digest[1] = h1init; + dig->digest[2] = h2init; + dig->digest[3] = h3init; + dig->digest[4] = h4init; + + /* Initialise bit count */ + dig->countLo = 0; + dig->countHi = 0; + dig->datalen = 0; +} + + +/* + * shs1Transform - perform the SHS1 transformatio + * + * Note that this code, like MD5, seems to break some optimizing compilers. + * It may be necessary to split it into sections, eg based on the four + * subrounds. One may also want to roll each subround into a loop. + */ +static void +shs1Transform(USB32 *digest, USB32 *W) +{ + USB32 A, B, C, D, E; /* Local vars */ + USB32 t; /* temp storage for exor() */ + + /* Set up first buffer and local data buffer */ + A = digest[0]; + B = digest[1]; + C = digest[2]; + D = digest[3]; + E = digest[4]; + + /* Heavy mangling, in 4 sub-rounds of 20 interations each. */ + subRound(A, B, C, D, E, f1, K1, W[ 0]); + subRound(E, A, B, C, D, f1, K1, W[ 1]); + subRound(D, E, A, B, C, f1, K1, W[ 2]); + subRound(C, D, E, A, B, f1, K1, W[ 3]); + subRound(B, C, D, E, A, f1, K1, W[ 4]); + subRound(A, B, C, D, E, f1, K1, W[ 5]); + subRound(E, A, B, C, D, f1, K1, W[ 6]); + subRound(D, E, A, B, C, f1, K1, W[ 7]); + subRound(C, D, E, A, B, f1, K1, W[ 8]); + subRound(B, C, D, E, A, f1, K1, W[ 9]); + subRound(A, B, C, D, E, f1, K1, W[10]); + subRound(E, A, B, C, D, f1, K1, W[11]); + subRound(D, E, A, B, C, f1, K1, W[12]); + subRound(C, D, E, A, B, f1, K1, W[13]); + subRound(B, C, D, E, A, f1, K1, W[14]); + subRound(A, B, C, D, E, f1, K1, W[15]); + subRound(E, A, B, C, D, f1, K1, exor(W,16,t)); + subRound(D, E, A, B, C, f1, K1, exor(W,17,t)); + subRound(C, D, E, A, B, f1, K1, exor(W,18,t)); + subRound(B, C, D, E, A, f1, K1, exor(W,19,t)); + + subRound(A, B, C, D, E, f2, K2, exor(W,20,t)); + subRound(E, A, B, C, D, f2, K2, exor(W,21,t)); + subRound(D, E, A, B, C, f2, K2, exor(W,22,t)); + subRound(C, D, E, A, B, f2, K2, exor(W,23,t)); + subRound(B, C, D, E, A, f2, K2, exor(W,24,t)); + subRound(A, B, C, D, E, f2, K2, exor(W,25,t)); + subRound(E, A, B, C, D, f2, K2, exor(W,26,t)); + subRound(D, E, A, B, C, f2, K2, exor(W,27,t)); + subRound(C, D, E, A, B, f2, K2, exor(W,28,t)); + subRound(B, C, D, E, A, f2, K2, exor(W,29,t)); + subRound(A, B, C, D, E, f2, K2, exor(W,30,t)); + subRound(E, A, B, C, D, f2, K2, exor(W,31,t)); + subRound(D, E, A, B, C, f2, K2, exor(W,32,t)); + subRound(C, D, E, A, B, f2, K2, exor(W,33,t)); + subRound(B, C, D, E, A, f2, K2, exor(W,34,t)); + subRound(A, B, C, D, E, f2, K2, exor(W,35,t)); + subRound(E, A, B, C, D, f2, K2, exor(W,36,t)); + subRound(D, E, A, B, C, f2, K2, exor(W,37,t)); + subRound(C, D, E, A, B, f2, K2, exor(W,38,t)); + subRound(B, C, D, E, A, f2, K2, exor(W,39,t)); + + subRound(A, B, C, D, E, f3, K3, exor(W,40,t)); + subRound(E, A, B, C, D, f3, K3, exor(W,41,t)); + subRound(D, E, A, B, C, f3, K3, exor(W,42,t)); + subRound(C, D, E, A, B, f3, K3, exor(W,43,t)); + subRound(B, C, D, E, A, f3, K3, exor(W,44,t)); + subRound(A, B, C, D, E, f3, K3, exor(W,45,t)); + subRound(E, A, B, C, D, f3, K3, exor(W,46,t)); + subRound(D, E, A, B, C, f3, K3, exor(W,47,t)); + subRound(C, D, E, A, B, f3, K3, exor(W,48,t)); + subRound(B, C, D, E, A, f3, K3, exor(W,49,t)); + subRound(A, B, C, D, E, f3, K3, exor(W,50,t)); + subRound(E, A, B, C, D, f3, K3, exor(W,51,t)); + subRound(D, E, A, B, C, f3, K3, exor(W,52,t)); + subRound(C, D, E, A, B, f3, K3, exor(W,53,t)); + subRound(B, C, D, E, A, f3, K3, exor(W,54,t)); + subRound(A, B, C, D, E, f3, K3, exor(W,55,t)); + subRound(E, A, B, C, D, f3, K3, exor(W,56,t)); + subRound(D, E, A, B, C, f3, K3, exor(W,57,t)); + subRound(C, D, E, A, B, f3, K3, exor(W,58,t)); + subRound(B, C, D, E, A, f3, K3, exor(W,59,t)); + + subRound(A, B, C, D, E, f4, K4, exor(W,60,t)); + subRound(E, A, B, C, D, f4, K4, exor(W,61,t)); + subRound(D, E, A, B, C, f4, K4, exor(W,62,t)); + subRound(C, D, E, A, B, f4, K4, exor(W,63,t)); + subRound(B, C, D, E, A, f4, K4, exor(W,64,t)); + subRound(A, B, C, D, E, f4, K4, exor(W,65,t)); + subRound(E, A, B, C, D, f4, K4, exor(W,66,t)); + subRound(D, E, A, B, C, f4, K4, exor(W,67,t)); + subRound(C, D, E, A, B, f4, K4, exor(W,68,t)); + subRound(B, C, D, E, A, f4, K4, exor(W,69,t)); + subRound(A, B, C, D, E, f4, K4, exor(W,70,t)); + subRound(E, A, B, C, D, f4, K4, exor(W,71,t)); + subRound(D, E, A, B, C, f4, K4, exor(W,72,t)); + subRound(C, D, E, A, B, f4, K4, exor(W,73,t)); + subRound(B, C, D, E, A, f4, K4, exor(W,74,t)); + subRound(A, B, C, D, E, f4, K4, exor(W,75,t)); + subRound(E, A, B, C, D, f4, K4, exor(W,76,t)); + subRound(D, E, A, B, C, f4, K4, exor(W,77,t)); + subRound(C, D, E, A, B, f4, K4, exor(W,78,t)); + subRound(B, C, D, E, A, f4, K4, exor(W,79,t)); + + /* Build message digest */ + digest[0] += A; + digest[1] += B; + digest[2] += C; + digest[3] += D; + digest[4] += E; +} + + +/* + * shs1Update - update SHS1 with arbitrary length data + */ +void +shs1Update(HASH *state, USB8 *buffer, USB32 count) +{ + SHS1_INFO *dig = &state->h_union.h_shs1; /* digest state */ + USB32 datalen = dig->datalen; + USB32 cpylen; +#if CALC_BYTE_ORDER == LITTLE_ENDIAN + int i; +#endif + + /* + * Update the full count, even if some of it is buffered for later + */ + SHS1COUNT(dig, count); + + + /* determine the size we need to copy */ + cpylen = SHS1_CHUNKSIZE - datalen; + + /* case: new data will not fill the buffer */ + if (cpylen > count) { + memcpy((char *)dig->data+datalen, + (char *)buffer, count); + dig->datalen = datalen+count; + return; + } + + /* case: buffer will be filled */ + memcpy((char *)dig->data + datalen, (char *)buffer, cpylen); + + /* + * Process data in SHS1_CHUNKSIZE chunks + */ + for (;;) { +#if CALC_BYTE_ORDER == LITTLE_ENDIAN + if (state->bytes) { + for (i=0; i < SHS1_CHUNKWORDS; ++i) { + SWAP_B8_IN_B32(dig->data+i, dig->data+i); + } + } +#endif + shs1Transform(dig->digest, dig->data); + buffer += cpylen; + count -= cpylen; + if (count < SHS1_CHUNKSIZE) + break; + cpylen = SHS1_CHUNKSIZE; + memcpy(dig->data, buffer, cpylen); + } + + /* + * Handle any remaining bytes of data. + * This should only happen once on the final lot of data + */ + if (count > 0) { + memcpy((char *)dig->data, (char *)buffer, count); + } + dig->datalen = count; +} + + +/* + * shs1Final - perform final SHS1 transforms + * + * At this point we have less than a full chunk of data remaining + * (and possibly no data) in the shs1 state data buffer. + * + * First we append a final 0x80 byte. + * + * Next if we have more than 56 bytes, we will zero fill the remainder + * of the chunk, transform and then zero fill the first 56 bytes. + * If we have 56 or fewer bytes, we will zero fill out to the 56th + * chunk byte. Regardless, we wind up with 56 bytes data. + * + * Finally we append the 64 bit length on to the 56 bytes of data + * remaining. This final chunk is transformed. + */ + +void +shs1Final(HASH *state) +{ + SHS1_INFO *dig = &state->h_union.h_shs1; /* digest state */ + long count = (long)(dig->datalen); + USB32 lowBitcount; + USB32 highBitcount; + USB8 *data = (USB8 *) dig->data; +#if CALC_BYTE_ORDER == LITTLE_ENDIAN + int i; +#endif + + /* Pad to end of chunk */ + + memset(data + count, 0, SHS1_CHUNKSIZE - count); + + /* + * If processing bytes, set the first byte of padding to 0x80. + * if processing words: on a big-endian machine set the first + * byte of padding to 0x80, on a little-endian machine set + * the first four bytes to 0x00000080 + * This is safe since there is always at least one byte or word free + */ + + memset(data + count, 0, SHS1_CHUNKSIZE - count); + +#if CALC_BYTE_ORDER == LITTLE_ENDIAN + if (state->bytes) { + data[count] = 0x80; + for (i=0; i < SHS1_CHUNKWORDS; ++i) { + SWAP_B8_IN_B32(dig->data+i, dig->data+i); + } + } + else { + if (count % 4) { + math_error("This should not happen in shs1Final"); + /*NOTREACHED*/ + } + data[count + 3] = 0x80; + } +#else + data[count] = 0x80; +#endif + + if (count >= SHS1_CHUNKSIZE-8) { + shs1Transform(dig->digest, dig->data); + + /* Now load another chunk with 56 bytes of padding */ + memset(data, 0, SHS1_CHUNKSIZE-8); + } + + /* + * Append length in bits and transform + * + * We assume that bit count is a multiple of 8 because we have + * only processed full bytes. + */ + highBitcount = dig->countHi; + lowBitcount = dig->countLo; + dig->data[SHS1_HIGH] = (highBitcount << 3) | (lowBitcount >> 29); + dig->data[SHS1_LOW] = (lowBitcount << 3); + shs1Transform(dig->digest, dig->data); + dig->datalen = 0; +} + + +/* + * shs1_chkpt - checkpoint a SHS1 state + * + * given: + * state the state to checkpoint + * + * This function will ensure that the the hash chunk buffer is empty. + * Any partially hashed data will be padded out with 0's and hashed. + */ +static void +shs1_chkpt(HASH *state) +{ + SHS1_INFO *dig = &state->h_union.h_shs1; /* digest state */ +#if CALC_BYTE_ORDER == LITTLE_ENDIAN + int i; +#endif + + /* + * checkpoint if partial buffer exists + */ + if (dig->datalen > 0) { + + /* pad to the end of the chunk */ + memset((USB8 *)dig->data + dig->datalen, 0, + SHS1_CHUNKSIZE-dig->datalen); +#if CALC_BYTE_ORDER == LITTLE_ENDIAN + if (state->bytes) { + for (i=0; i < SHS1_CHUNKWORDS; ++i) { + SWAP_B8_IN_B32(dig->data+i, dig->data+i); + } + } +#endif + /* transform padded chunk */ + shs1Transform(dig->digest, dig->data); + SHS1COUNT(dig, SHS1_CHUNKSIZE-dig->datalen); + + /* empty buffer */ + dig->datalen = 0; + } + return; +} + + +/* + * shs1_note - note a special value + * + * given: + * state the state to hash + * special a special value (SHS1_HASH_XYZ) to note + * + * This function will note that a special value is about to be hashed. + * Types include negative values, complex values, division, zero numeric + * and array of HALFs. + */ +static void +shs1_note(int special, HASH *state) +{ + SHS1_INFO *dig = &state->h_union.h_shs1; /* digest state */ + int i; + + /* + * change state to reflect a special value + */ + dig->digest[0] ^= special; + for (i=1; i < SHS1_DIGESTWORDS; ++i) { + dig->digest[i] ^= (special + dig->digest[i-1] + i); + } + return; +} + + +/* + * shs1_type - note a VALUE type + * + * given: + * state the state to hash + * type the VALUE type to note + * + * This function will note that a type of value is about to be hashed. + * The type of a VALUE will be noted. For purposes of hash comparison, + * we will do nothing with V_NUM and V_COM so that the other functions + * can hash to the same value regardless of if shs1_value() is called + * or not. We also do nothing with V_STR so that a hash of a string + * will produce the same value as the standard hash function. + */ +static void +shs1_type(int type, HASH *state) +{ + SHS1_INFO *dig = &state->h_union.h_shs1; /* digest state */ + int i; + + /* + * ignore NUMBER and COMPLEX + */ + if (type == V_NUM || type == V_COM || type == V_STR) { + return; + } + + /* + * change state to reflect a VALUE type + */ + dig->digest[0] += type; + for (i=1; i < SHS1_DIGESTWORDS; ++i) { + dig->digest[i] += ((type+i) ^ dig->digest[i-1]); + } + return; +} + + +/* + * shs1_init_state - initialize a hash state structure for this hash + * + * given: + * state - pointer to the hfunction element to initialize + */ +void +shs1_init_state(HASH *state) +{ + /* + * initalize state + */ + state->hashtype = SHS1_HASH_TYPE; + state->bytes = TRUE; + state->update = shs1Update; + state->chkpt = shs1_chkpt; + state->note = shs1_note; + state->type = shs1_type; + state->final = shs1_final_state; + state->cmp = shs1_cmp; + state->print = shs1_print; + state->base = SHS1_BASE; + state->chunksize = SHS1_CHUNKSIZE; + state->unionsize = sizeof(SHS1_INFO); + + /* + * perform the internal init function + */ + memset((void *)&(state->h_union.h_shs), 0, sizeof(SHS1_INFO)); + shs1Init(state); + return; +} + + +/* + * shs1_final_state - complete hash state and return a ZVALUE + * + * given: + * state the state to complete and convert + * + * returns: + * a ZVALUE representing the state + */ +static ZVALUE +shs1_final_state(HASH *state) +{ + SHS1_INFO *dig = &state->h_union.h_shs1; /* digest state */ + ZVALUE ret; /* return ZVALUE of completed hash state */ + int i; + + /* + * malloc and initialize if state is NULL + */ + if (state == NULL) { + state = (HASH *)malloc(sizeof(HASH)); + if (state == NULL) { + math_error("cannot malloc HASH"); + /*NOTREACHED*/ + } + shs1_init_state(state); + } + + /* + * complete the hash state + */ + shs1Final(state); + + /* + * allocate storage for ZVALUE + */ + ret.len = SHS1_DIGESTSIZE/sizeof(HALF); + ret.sign = 0; + ret.v = alloc(ret.len); + + /* + * load ZVALUE + */ +#if BASEB == 16 + for (i=0; i < ret.len; i+=2) { + ret.v[ret.len-i-1] = ((HALF*)dig->digest)[i+1]; + ret.v[ret.len-i-2] = ((HALF*)dig->digest)[i]; + } +#else + for (i=0; i < ret.len; ++i) { + ret.v[ret.len-i-1] = ((HALF*)dig->digest)[i]; + } +#endif + ztrim(&ret); + + /* + * return ZVALUE + */ + return ret; +} + + +/* + * shs1_cmp - compare two hash states + * + * given: + * a first hash state + * b second hash state + * + * returns: + * TRUE => hash states are different + * FALSE => hash states are the same + */ +static int +shs1_cmp(HASH *a, HASH *b) +{ + /* + * firewall and quick check + */ + if (a == b) { + /* pointers to the same object */ + return FALSE; + } + if (a == NULL || b == NULL) { + /* one is NULL, so they differ */ + return TRUE; + } + + /* + * compare data-reading modes + */ + if (a->bytes != b->bytes) + return TRUE; + + /* + * compare bit counts + */ + if (a->h_union.h_shs.countLo != b->h_union.h_shs.countLo || + a->h_union.h_shs.countHi != b->h_union.h_shs.countHi) { + /* counts differ */ + return TRUE; + } + + /* + * compare pending buffers + */ + if (a->h_union.h_shs.datalen != b->h_union.h_shs.datalen) { + /* buffer lengths differ */ + return TRUE; + } + if (memcmp((USB8*)a->h_union.h_shs.data, + (USB8*)b->h_union.h_shs.data, + a->h_union.h_shs.datalen) != 0) { + /* buffer contents differ */ + return TRUE; + } + + /* + * compare digest + */ + return (memcmp((USB8*)(a->h_union.h_shs.digest), + (USB8*)(b->h_union.h_shs.digest), + SHS1_DIGESTSIZE) != 0); +} + + +/* + * shs1_print - print a hash state + * + * given: + * state the hash state to print + */ +static void +shs1_print(HASH *state) +{ + /* + * form the hash value + */ + if (conf->calc_debug > 0) { + char buf[DEBUG_SIZE+1]; /* hash value buffer */ + + /* + * print numeric debug value + * + * NOTE: This value represents only the hash value as of + * the last full update or finalization. Thus it + * may NOT be the actual hash value. + */ + sprintf(buf, + "sha1: 0x%08x%08x%08x%08x%08x data: %d octets", + (int)state->h_union.h_shs1.digest[0], + (int)state->h_union.h_shs1.digest[1], + (int)state->h_union.h_shs1.digest[2], + (int)state->h_union.h_shs1.digest[3], + (int)state->h_union.h_shs1.digest[4], + (int)state->h_union.h_shs1.datalen); + math_str(buf); + } else { + math_str("sha1 hash state"); + } + return; +} diff --git a/shs1.h b/shs1.h new file mode 100644 index 0000000..4553102 --- /dev/null +++ b/shs1.h @@ -0,0 +1,70 @@ +/* + * shs1 - new NIST Secure Hash Standard-1 (SHS1) + * + * Written 2 September 1992, Peter C. Gutmann. + * + * This file was Modified by: + * + * Landon Curt Noll (chongo@toad.com) chongo /\../\ + * + * This code has been placed in the public domain. Please do not + * copyright this code. + * + * LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO + * THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MER- + * CHANTABILITY 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. + */ + + +#if !defined(__SHS1_H__) +#define __SHS1_H__ + + +/* SHS1_CHUNKSIZE must be a power of 2 - fixed value defined by the algorithm */ +#define SHS1_CHUNKSIZE (1<<6) +#define SHS1_CHUNKWORDS (SHS1_CHUNKSIZE/sizeof(USB32)) + +/* SHS1_DIGESTSIZE is a the length of the digest as defined by the algorithm */ +#define SHS1_DIGESTSIZE (20) +#define SHS1_DIGESTWORDS (SHS1_DIGESTSIZE/sizeof(USB32)) + +/* SHS1_LOW - where low 32 bits of 64 bit count is stored during final */ +#define SHS1_LOW 15 + +/* SHS1_HIGH - where high 32 bits of 64 bit count is stored during final */ +#define SHS1_HIGH 14 + +/* + * The structure for storing SHS1 info + * + * We will assume that bit count is a multiple of 8. + */ +typedef struct { + USB32 digest[SHS1_DIGESTWORDS]; /* message digest */ + USB32 countLo; /* 64 bit count: bits 3-34 */ + USB32 countHi; /* 64 bit count: bits 35-63 */ + USB32 datalen; /* length of data in data */ + USB32 data[SHS1_CHUNKWORDS]; /* SHS1 chunk buffer */ +} SHS1_INFO; + +/* + * SHS1COUNT(SHS1_INFO*, USB32) - update the 64 bit count in an SHS1_INFO + * + * We will count bytes and convert to bit count during the final + * transform. + */ +#define SHS1COUNT(shs1info, count) { \ + USB32 tmp_countLo; \ + tmp_countLo = (shs1info)->countLo; \ + if (((shs1info)->countLo += (count)) < tmp_countLo) { \ + (shs1info)->countHi++; \ + } \ +} + + +#endif /* !__SHS1_H__ */ diff --git a/size.c b/size.c new file mode 100644 index 0000000..e484517 --- /dev/null +++ b/size.c @@ -0,0 +1,424 @@ +/* + * Copyright (c) 1997 David I. Bell + * Permission is granted to use, distribute, or modify this source, + * provided that this copyright notice remains intact. + * + * Size and sizeof functions are implemented here + */ + + +#include "value.h" +#include "zrand.h" +#include "zrandom.h" +#include "block.h" + + +/* + * forward declarations + */ +static long zsize(ZVALUE); +static long qsize(NUMBER*); +static long csize(COMPLEX*); +static long memzsize(ZVALUE); +static long memqsize(NUMBER*); + + +/* + * elm_count - return information about the number of elements + * + * Return information about the number of elements or part of + * a value. This is what the size() builtin returns with the + * exception of the V_FILE type. To get V_FILE size length, + * the getsize(vp->v_file, &len) should be called directly. + * + * This is not the sizeof, see lsizeof() for that information. + * + * given: + * vp pointer to a value + * + * return: + * number of elements + */ +long +elm_count(VALUE *vp) +{ + long result; + + /* + * return information about the number of elements + * + * This is not the sizeof, see lsizeof() for that information. + * This is does not include overhead, see memsize() for that info. + */ + + switch (vp->v_type) { + case V_NULL: + case V_INT: + case V_ADDR: + case V_OCTET: + result = 0; + break; + case V_MAT: + result = vp->v_mat->m_size; + break; + case V_LIST: + result = vp->v_list->l_count; + break; + case V_ASSOC: + result = vp->v_assoc->a_count; + break; + case V_OBJ: + result = vp->v_obj->o_actions->count; + break; + case V_STR: + result = vp->v_str->s_len; + break; + case V_BLOCK: + result = (long) vp->v_block->datalen; + break; + case V_NBLOCK: + result = (long) vp->v_nblock->blk->datalen; + break; + /* + * V_NUM, V_COM, V_RAND, V_RANDOM, V_CONFIG, V_HASH + * + * V_FILE (use getsize(vp->v_file, &len) for file length) + */ + default: + result = (vp->v_type > 0); + break; + } + return result; +} + + +/* + * zsize - calculate memory footprint of a ZVALUE (exlcuding overhead) + * + * The numeric -1, - and 1 storage values are ignored. + * + * given: + * z ZVALUE to examine + * + * returns: + * value size + */ +static long +zsize(ZVALUE z) +{ + /* ignore the size of 0, 1 and -1 */ + if (z.v != _zeroval_ && z.v != _oneval_ && !zisunit(z) && !ziszero(z)) { + return (long)z.len * (long)sizeof(HALF); + } else { + return (long)0; + } +} + + +/* + * qsize - calculate memory footprint of a NUMBER (exlcuding overhead) + * + * The numeric -1, - and 1 storage values are ignored. Denominator + * parts of integers are ignored. + * + * given: + * q pointer to NUMBER to examine + * + * returns: + * value size + */ +static long +qsize(NUMBER *q) +{ + /* ingore denominator parts of integers */ + if (qisint(q)) { + return zsize(q->num); + } else { + return (zsize(q->num) + zsize(q->den)); + } +} + + +/* + * csize - calculate memory footprint of a COMPLEX (exlcuding overhead) + * + * The numeric -1, - and 1 storage values are ignored. Denominator + * parts of integers are ignored. Imaginary parts of pure reals + * are ignored. + * + * given: + * c pointer to COMPLEX to examine + * + * returns: + * value size + */ +static long +csize(COMPLEX *c) +{ + /* ingore denominator parts of integers */ + if (cisreal(c)) { + return qsize(c->real); + } else { + return (qsize(c->real) + qsize(c->imag)); + } +} + + +/* + * memzsize - calculate memory footprint of a ZVALUE including overhead + * + * given: + * z ZVALUE to examine + * + * returns: + * memory footprint + */ +static long +memzsize(ZVALUE z) +{ + return (long)sizeof(ZVALUE) + ((long)z.len * (long)sizeof(HALF)); +} + + +/* + * memqsize - calculate memory footprint of a NUMBER including overhead + * + * given: + * q pointer of NUMBER to examine + * + * returns: + * memory footprint + */ +static long +memqsize(NUMBER *q) +{ + return (long)sizeof(NUMBER) + memzsize(q->num) + memzsize(q->den); +} + + +/* + * lsizeof - calculate memory footprint of a VALUE (not counting overhead) + * + * given: + * vp pointer of VALUE to examine + * + * returns: + * memory footprint + */ +long +lsizeof(VALUE *vp) +{ + VALUE *p; + LISTELEM *ep; + OBJECTACTIONS *oap; + ASSOCELEM *aep; + ASSOCELEM **ept; + long s; + long i; + + /* + * return information about memory footprint + * + * This is not the number of elements, see elm_count() for that info. + * This is does not include overhead, see memsize() for that info. + */ + i = 0; + s = 0; + if (vp->v_type > 0) { + switch(vp->v_type) { + case V_INT: + case V_ADDR: + case V_OCTET: + break; + case V_NUM: + s = qsize(vp->v_num); + break; + case V_COM: + s = csize(vp->v_com); + break; + case V_STR: + s = vp->v_str->s_len + 1; + break; + case V_MAT: + i = vp->v_mat->m_size; + p = vp->v_mat->m_table; + while (i-- > 0) + s += lsizeof(p++); + break; + case V_LIST: + for (ep = vp->v_list->l_first; ep; ep = ep->e_next) { + s += lsizeof(&ep->e_value); + } + break; + case V_ASSOC: + i = vp->v_assoc->a_size; + ept = vp->v_assoc->a_table; + while (i-- > 0) { + for (aep = ept[i]; aep; aep = aep->e_next) { + s += lsizeof(&aep->e_value); + } + } + break; + case V_OBJ: + oap = vp->v_obj->o_actions; + i = oap->count; + p = vp->v_obj->o_table; + while (i-- > 0) + s += lsizeof(p++); + break; + case V_FILE: + s = sizeof(vp->v_file); + break; + case V_RAND: + s = sizeof(RAND); + break; + case V_RANDOM: + s = (long)sizeof(RANDOM) + + zsize(vp->v_random->n) + + zsize(vp->v_random->r); + break; + case V_CONFIG: + s = (long)sizeof(CONFIG) + + (long)strlen(vp->v_config->prompt1) + + (long)strlen(vp->v_config->prompt2) + 2; + break; + case V_HASH: + /* ignore the unused part of the union */ + s = (long)sizeof(HASH) + + vp->v_hash->unionsize - + (long)sizeof(vp->v_hash->h_union); + break; + case V_BLOCK: + s = vp->v_block->maxsize; + break; + case V_NBLOCK: + s = vp->v_nblock->blk->maxsize; + break; + default: + math_error("sizeof not defined for value type"); + /*NOTREACHED*/ + } + } + return s; +} + + +/* + * memsize - calculate memory footprint of a VALUE including overhead + * + * given: + * vp pointer of VALUE to examine + * + * returns: + * memory footprint including overhead + */ +long +memsize(VALUE *vp) +{ + long s; + long i, j; + VALUE *p; + LISTELEM *ep; + OBJECTACTIONS *oap; + ASSOCELEM *aep; + ASSOCELEM **ept; + + /* + * return information about memory footprint + * + * This is not the sizeof, see memsize() for that information. + * This is not the number of elements, see elm_count() for that info. + */ + i = j = 0; + s = (long) sizeof(VALUE); + if (vp->v_type > 0) { + switch(vp->v_type) { + case V_INT: + case V_ADDR: + case V_OCTET: + break; + case V_NUM: + s = memqsize(vp->v_num); + break; + case V_COM: + s = (long)sizeof(COMPLEX) + + memqsize(vp->v_com->real) + + memqsize(vp->v_com->imag); + break; + case V_STR: + s = (long)sizeof(STRING) + vp->v_str->s_len + 1; + break; + case V_MAT: + s = sizeof(MATRIX); + i = vp->v_mat->m_size; + p = vp->v_mat->m_table; + while (i-- > 0) + s += memsize(p++); + break; + case V_LIST: + s = sizeof(LIST); + for (ep = vp->v_list->l_first; ep; ep = ep->e_next) { + s += sizeof(LISTELEM) - sizeof(VALUE) + + memsize(&ep->e_value); + } + break; + case V_ASSOC: + s = sizeof(ASSOC); + i = vp->v_assoc->a_size; + ept = vp->v_assoc->a_table; + while (i-- > 0) { + s += sizeof(ASSOCELEM *); + for (aep = *ept++; aep; aep = aep->e_next) { + s += sizeof(ASSOCELEM) - sizeof(VALUE) + + memsize(&aep->e_value); + j = aep->e_dim; + p = aep->e_indices; + while (j-- > 0) + s += memsize(p++); + } + } + break; + case V_OBJ: + s = sizeof(OBJECT); + oap = vp->v_obj->o_actions; + s += (long)strlen(oap->name) + 1; + i = oap->count; + s += (i + 2) * sizeof(int); + p = vp->v_obj->o_table; + while (i-- > 0) + s += memsize(p++); + break; + case V_FILE: + s = sizeof(vp->v_file); + break; + case V_RAND: + s = sizeof(RAND); + break; + case V_RANDOM: + s = (long)sizeof(RANDOM) + + memzsize(vp->v_random->n) + + memzsize(vp->v_random->r); + break; + case V_CONFIG: + s = (long)sizeof(CONFIG) + 2 + + (long)strlen(vp->v_config->prompt1) + + (long)strlen(vp->v_config->prompt2); + break; + case V_HASH: + s = sizeof(HASH); + break; + case V_BLOCK: + s = (long)sizeof(BLOCK) + vp->v_block->maxsize; + break; + case V_NBLOCK: + s = (long)sizeof(NBLOCK) + (long)sizeof(BLOCK) + + vp->v_nblock->blk->maxsize + + (long)strlen(vp->v_nblock->name) + 1; + break; + default: + math_error("memsize not defined for value type"); + /*NOTREACHED*/ + } + } + return s; +} diff --git a/string.c b/string.c index b6d2c67..7a71d1c 100644 --- a/string.c +++ b/string.c @@ -1,11 +1,12 @@ /* - * 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. * * String list routines. */ +#include #include "calc.h" #include "string.h" @@ -13,6 +14,7 @@ #define STR_CHUNK 2000 /* size of string storage allocation */ #define STR_UNIQUE 100 /* size of string to allocate separately */ +STRING _nullstring_ = {"", 0, 1, NULL}; static char *chartable; /* single character string table */ @@ -286,4 +288,1095 @@ addliteral(char *str) return newstr; } + +STRING * +stringadd(STRING *s1, STRING *s2) +{ + STRING *s; + char *cfrom, *c; + long len; + + if (s1->s_len == 0) + return slink(s2); + if (s2->s_len == 0) + return slink(s1); + len = s1->s_len + s2->s_len; + s = stralloc(); + s->s_len = len; + s->s_str = (char *) malloc(len + 1); + if (s->s_str == NULL) + return NULL; + len = s1->s_len; + cfrom = s1->s_str; + c = s->s_str; + while (len-- > 0) + *c++ = *cfrom++; + len = s2->s_len; + cfrom = s2->s_str; + while (len-- > 0) + *c++ = *cfrom++; + *c = '\0'; + return s; +} + +/* + * stringneg reverses the characters in a string, returns null if malloc fails + */ +STRING * +stringneg(STRING *str) +{ + long len; + STRING *s; + char *c, *cfrom; + + len = str->s_len; + if (len <= 1) + return slink(str); + c = (char *) malloc(len + 1); + if (c == NULL) + return NULL; + s = stralloc(); + s->s_len = len; + s->s_str = c; + cfrom = str->s_str + len; + while (len-- > 0) + *c++ = *--cfrom; + *c = '\0'; + return s; +} + +STRING * +stringsub(STRING *s1, STRING *s2) +{ + STRING *tmp, *s; + + tmp = stringneg(s2); + if (tmp == NULL) + return NULL; + s = stringadd(s1, tmp); + if (s != NULL) + sfree(tmp); + return s; +} + +/* + * stringmul: repeated concatenation, reverse if negative multiplier + * returns null if malloc fails + */ +STRING * +stringmul(NUMBER *q, STRING *str) +{ + long len; + long j; + NUMBER *tmp1, *tmp2; + char *c, *c1; + STRING *s; + BOOL neg; + + if (str->s_len == 0) + return slink(str); + neg = qisneg(q); + q = neg ? qneg(q): qlink(q); + tmp1 = itoq(str->s_len); + tmp2 = qmul(q, tmp1); + qfree(tmp1); + tmp1 = qint(tmp2); + qfree(tmp2); + if (zge31b(tmp1->num)) { + qfree(q); + qfree(tmp1); + return NULL; + } + len = qtoi(tmp1); + qfree(tmp1); + qfree(q); + if (len == 0) { + s = stralloc(); + s->s_len = 0; + s->s_str = charstr('\0'); + return s; + } + c = (char *) malloc(len + 1); + if (c == NULL) + return NULL; + str = neg ? stringneg(str) : slink(str); + s = stralloc(); + s->s_str = c; + s->s_len = len; + j = 0; + c1 = str->s_str; + while (len-- > 0) { + *c++ = *c1++; + if (++j == str->s_len) { + j = 0; + c1 = str->s_str; + } + } + *c = '\0'; + sfree(str); + return s; +} + +STRING * +stringand(STRING *s1, STRING *s2) +{ + STRING *s; + long len; + char *c1, *c2, *c; + + if (s1->s_len == 0 || s2->s_len == 0) + return slink(&_nullstring_); + len = s1->s_len; + if (s2->s_len < len) + len = s2->s_len; + s = stralloc(); + s->s_len = len; + c = malloc(len + 1); + if (c == NULL) + return NULL; + s->s_str = c; + c1 = s1->s_str; + c2 = s2->s_str; + while (len-- > 0) + *c++ = *c1++ & *c2++; + return s; +} + + +STRING * +stringor(STRING *s1, STRING *s2) +{ + STRING *s; + long len, i, j; + char *c1, *c2, *c; + + if (s1->s_len < s2->s_len) { + s = s1; + s1 = s2; + s2 = s; + } /* Now len(s1) >= len(s2) */ + if (s2->s_len == 0) + return slink(s1); + i = s1->s_len; + if (i == 0) + return slink(&_nullstring_); + len = s1->s_len; + s = stralloc(); + s->s_len = len; + c = malloc(len + 1); + if (c == NULL) + return NULL; + s->s_str = c; + c1 = s1->s_str; + c2 = s2->s_str; + i = s2->s_len; + j = s1->s_len - i; + while (i-- > 0) + *c++ = *c1++ | *c2++; + while (j-- > 0) + *c++ = *c1++; + return s; +} + + +STRING * +stringxor(STRING *s1, STRING *s2) +{ + STRING *s; + long len, i, j; + char *c1, *c2, *c; + + if (s1->s_len < s2->s_len) { + s = s1; + s1 = s2; + s2 = s; + } /* Now len(s1) >= len(s2) */ + if (s2->s_len == 0) + return slink(s1); + i = s1->s_len; + if (i == 0) + return slink(&_nullstring_); + len = s1->s_len; + s = stralloc(); + s->s_len = len; + c = malloc(len + 1); + if (c == NULL) + return NULL; + s->s_str = c; + c1 = s1->s_str; + c2 = s2->s_str; + i = s2->s_len; + j = s1->s_len - i; + while (i-- > 0) + *c++ = *c1++ ^ *c2++; + while (j-- > 0) + *c++ = *c1++; + return s; +} + + +STRING * +stringdiff(STRING *s1, STRING *s2) +{ + STRING *s; + long i; + char *c2, *c; + + i = s1->s_len; + if (i == 0) + return slink(s1); + s = stringcopy(s1); + if (i > s2->s_len) + i = s2->s_len; + c = s->s_str; + c2 = s2->s_str; + while (i-- > 0) + *c++ &= ~*c2++; + return s; +} + +STRING * +stringcomp(STRING *s1) +{ + long len; + STRING *s; + char *c1, *c; + + len = s1->s_len; + if (len == 0) + return slink(&_nullstring_); + c = malloc(len + 1); + if (c == NULL) + return NULL; + s = stralloc(); + s->s_len = len; + s->s_str = c; + c1 = s1->s_str; + while (len-- > 0) + *c++ = ~*c1++; + *c = '\0'; + return s; +} + +STRING * +stringsegment(STRING *s1, long n1, long n2) +{ + STRING *s; + char *c, *c1; + long len; + + if ((n1 < 0 && n2 < 0) || (n1 >= s1->s_len && n2 >= s1->s_len)) + return slink(&_nullstring_); + if (n1 < 0) + n1 = 0; + if (n2 < 0) + n2 = 0; + if (n1 >= s1->s_len) + n1 = s1->s_len - 1; + if (n2 >= s1->s_len) + n2 = s1->s_len - 1; + len = (n1 >= n2) ? n1 - n2 + 1 : n2 - n1 + 1; + s = stralloc(); + c = malloc(len + 1); + if (c == NULL) + return NULL; + s->s_len = len; + s->s_str = c; + c1 = s1->s_str + n1; + if (n1 >= n2) { + while (len-- > 0) + *c++ = *c1--; + } + else { + while (len-- > 0) + *c++ = *c1++; + } + *c = '\0'; + return s; +} + +/* + * stringshift shifts s1 n bits to left if n > 0, -n to the right if n < 0; + * octets in string considered to be in decreasing order of index, as in + * ... a_3 a_2 a_1 a_0. Returned string has same length as s1. + * Vacated bits are filled with '\0'; bits shifted off end are lost + */ +STRING * +stringshift(STRING *s1, long n) +{ + char *c1, *c; + STRING *s; + long len, i, j, k; + BOOL right; + char ch; + + len = s1->s_len; + if (len == 0 || n == 0) + return slink(s1); + right = (n < 0); + if (right) n = -n; + j = n & 7; + k = 8 - j; + n >>= 3; + c = malloc(len + 1); + if (c == NULL) + return NULL; + s = stralloc(); + s->s_len = len; + s->s_str = c; + c[len] = '\0'; + if (n > len) + n = len; + ch = '\0'; + c1 = s1->s_str; + i = n; + if (right) { + c += len; + c1 += len; + while (i-- > 0) + *--c = '\0'; + i = len - n; + while (i-- > 0) { + *--c = ((unsigned char) *--c1 >> j) | ch; + ch = (unsigned char) *c1 << k; + } + } + else { + while (i-- > 0) + *c++ = '\0'; + i = len - n; + while (i-- > 0) { + *c++ = ((unsigned char) *c1 << j) | ch; + ch = (unsigned char) *c1++ >> k; + } + } + return s; +} + +/* + * stringcpy copies as many characters as possible up to and including + * the first '\0' from s2 to s1 and returns s1 + */ +STRING * +stringcpy(STRING *s1, STRING *s2) +{ + char *c1, *c2; + long len; + + c1 = s1->s_str; + c2 = s2->s_str; + len = s1->s_len; + while (len-- > 0 && *c2 != 0) + *c1++ = *c2++; + *c1 = '\0'; + return slink(s1); +} + +/* + * stringncpy copies up to n characters from s2 to s1 and returns s1 + */ +STRING * +stringncpy(STRING *s1, STRING *s2, long num) +{ + char *c1, *c2; + + if (num > s1->s_len) + num = s1->s_len; + c1 = s1->s_str; + c2 = s2->s_str; + while (num-- > 0 && *c2 != 0) + *c1++ = *c2++; + while (num-- > 0) + *c1++ = '\0'; + *c1 = '\0'; + return slink(s1); +} + + +/* + * stringcontent counts the number of set bits in s + */ +long +stringcontent(STRING *s) +{ + char *c; + unsigned char ch; + long count; + long len; + + len = s->s_len; + count = 0; + c = s->s_str; + while (len-- > 0) { + ch = *c++; + while (ch) { + count += (ch & 1); + ch >>= 1; + } + } + return count; +} + +long +stringhighbit(STRING *s) +{ + char *c; + unsigned char ch; + long i; + + i = s->s_len; + c = s->s_str + i; + while (--i >= 0 && *--c == '\0'); + if (i < 0) + return -1; + i <<= 3; + for (ch = *c; ch >>= 1; i++); + return i; +} + +long +stringlowbit(STRING *s) +{ + char *c; + unsigned char ch; + long i; + + for (i = s->s_len, c = s->s_str; i > 0 && *c == '\0'; i--, c++); + if (i == 0) + return -1; + i = (s->s_len - i) << 3; + for (ch = *c; !(ch & 1); ch >>= 1, i++); + return i; +} + + +/* + * stringcompare compares first len characters of strings starting at c1, c2 + * Returns TRUE if and only if a difference is encountered. + * Essentially a local version of memcmp. + */ +static BOOL +stringcompare(char *c1, char *c2, long len) +{ + while (len-- > 0) { + if (*c1++ != *c2++) + return TRUE; + } + return FALSE; +} + +/* + * stringcmp returns TRUE if strings differ, FALSE if strings equal + */ +BOOL +stringcmp(STRING *s1, STRING *s2) +{ + if (s1->s_len != s2->s_len) + return TRUE; + return stringcompare(s1->s_str, s2->s_str, s1->s_len); +} + + +/* + * stringrel returns 0 if strings are equal; otherwise 1 or -1 according + * as the greater of the first unequal characters are in the first or + * second string, or in the case of unequal-length strings when the compared + * characters are all equal, 1 or -1 according as the first or second string + * is longer. + */ +FLAG +stringrel(STRING *s1, STRING *s2) +{ + char *c1, *c2; + long i1, i2; + + i1 = s1->s_len; + i2 = s2->s_len; + if (i1 == 0) + return (i2 > 0); + if (i2 == 0) + return -1; + c1 = s1->s_str; + c2 = s2->s_str; + while (i1 > 0 && i2 > 0 && *c1 == *c2) { + i1--; + i2--; + c1++; + c2++; + } + if ((unsigned char) *c1 > (unsigned char) *c2) return 1; + if ((unsigned char) *c1 < (unsigned char) *c2) return -1; + if (i1 < i2) return -1; + return (i1 > i2); +} + + +/* + * str with characters c0, c1, ... is considered as a bitstream, 8 bits + * per character; within a character the bits ordered from low order to + * high order. For 0 <= i < 8 * length of str, stringbit returns 1 or 0 + * according as the bit with index i is set or not set; other values of i + * return -1. + */ +int +stringbit(STRING *s, long index) +{ + unsigned int ch; + int res; + + if (index < 0) + return -1; + res = index & 7; + index >>= 3; + if (index >= s->s_len) + return -1; + ch = s->s_str[index]; + return (ch >> res) & 1; +} + + +BOOL +stringtest(STRING *s) +{ + long i; + char *c; + + i = s->s_len; + c = s->s_str; + while (i-- > 0) { + if (*c++) + return TRUE; + } + return FALSE; +} + +/* + * If index is in acceptable range, stringsetbit sets or resets specified + * bit in string s according as val is TRUE or FALSE, and returns 0. + * Returns 1 if index < 0; 2 if index too large. + */ +int +stringsetbit(STRING *s, long index, BOOL val) +{ + char *c; + int bit; + + if (index < 0) + return 1; + bit = 1 << (index & 7); + index >>= 3; + if (index >= s->s_len) + return 2; + c = &s->s_str[index]; + *c &= ~bit; + if (val) + *c |= bit; + return 0; +} + +/* + * stringsearch returns 0 and sets index = i if the first occurrence + * of s2 in s1 for start <= i < end is at index i. If no such occurrence + * is found, -1 is returned. + */ +int +stringsearch(STRING *s1, STRING *s2, long start, long end, ZVALUE *index) +{ + long len2, i, j; + char *c1, *c2, *c; + char ch; + + len2 = s2->s_len; + if (start < 0) + start = 0; + if (end < start + len2) + return -1; + if (len2 == 0) { + itoz(start, index); + return 0; + } + i = end - start - len2; + c1 = s1->s_str + start; + ch = *s2->s_str; + while (i-- >= 0) { + if (*c1++ == ch) { + c = c1; + c2 = s2->s_str; + j = len2; + while (--j > 0 && *c++ == *++c2); + if (j == 0) { + itoz(end - len2 - i - 1, index); + return 0; + } + } + } + return -1; +} + +int +stringrsearch(STRING *s1, STRING *s2, long start, long end, ZVALUE *index) +{ + long len1, len2, i, j; + char *c1, *c2, *c, *c2top; + char ch; + + len1 = s1->s_len; + len2 = s2->s_len; + if (start < 0) + start = 0; + if (end > len1) + end = len1; + if (end < start + len2) + return -1; + if (len2 == 0) { + itoz(start, index); + return 0; + } + i = end - start - len2 + 1; + c1 = s1->s_str + end - 1; + c2top = s2->s_str + len2 - 1; + ch = *c2top; + + while (--i >= 0) { + if (*c1-- == ch) { + c = c1; + j = len2; + c2 = c2top; + while (--j > 0 && *c-- == *--c2); + if (j == 0) { + itoz(start + i, index); + return 0; + } + } + } + return -1; +} + + +/* + * String allocation routines + */ + +#define STRALLOC 100 + + +static STRING *freeStr; +static STRING **firstStrs; +static long blockcount = 0; + + +STRING * +stralloc(void) +{ + STRING *temp; + STRING **newfn; + + if (freeStr == NULL) { + freeStr = (STRING *) malloc(sizeof (STRING) * STRALLOC); + if (freeStr == NULL) { + math_error("Unable to allocate memory for stralloc"); + /*NOTREACHED*/ + } + freeStr[STRALLOC - 1].s_next = NULL; + freeStr[STRALLOC - 1].s_links = 0; + for (temp = freeStr + STRALLOC - 2; temp >= freeStr; --temp) { + temp->s_next = temp + 1; + temp->s_links = 0; + } + blockcount++; + newfn = (STRING **) + realloc(firstStrs, blockcount * sizeof(STRING *)); + if (newfn == NULL) { + math_error("Cannot allocate new string block"); + /*NOTREACHED*/ + } + firstStrs = newfn; + firstStrs[blockcount - 1] = freeStr; + } + temp = freeStr; + freeStr = temp->s_next; + temp->s_links = 1; + temp->s_str = NULL; + return temp; +} + + +/* + * makestring to be called only when str is the result of a malloc + */ +STRING * +makestring(char *str) +{ + STRING *s; + long len; + + len = (long)strlen(str); + s = stralloc(); + s->s_str = str; + s->s_len = len; + return s; +} + +STRING * +charstring(int ch) +{ + STRING *s; + char *c; + + c = (char *) malloc(2); + if (c == NULL) { + math_error("Allocation failure for charstring"); + /*NOTREACHED*/ + } + s = stralloc(); + s->s_len = 1; + s->s_str = c; + *c++ = (char) ch; + *c = '\0'; + return s; +} + + +/* + * makenewstring creates a new string by copying null-terminated str; + * str is not freed + */ +STRING * +makenewstring(char *str) +{ + STRING *s; + char *c; + long len; + + len = (long)strlen(str); + if (len == 0) + return slink(&_nullstring_); + c = (char *) malloc(len + 1); + if (c == NULL) { + math_error("malloc for makenewstring failed"); + /*NOTREACHED*/ + } + s = stralloc(); + s->s_str = c; + s->s_len = len; + while (len-- > 0) + *c++ = *str++; + *c = '\0'; + return s; +} + + +STRING * +stringcopy (STRING *s1) +{ + STRING *s; + char *c, *c1; + long len; + + len = s1->s_len; + if (len == 0) + return slink(s1); + c = malloc(len + 1); + if (c == NULL) { + math_error("Malloc failed for stringcopy"); + /*NOTREACHED*/ + } + s = stralloc(); + s->s_len = len; + s->s_str = c; + c1 = s1->s_str; + while (len-- > 0) + *c++ = *c1++; + *c = '\0'; + return s; +} + + +STRING * +slink(STRING *s) +{ + if (s->s_links <= 0) { + math_error("Argument for slink has nonpositive links!!!"); + /*NOTREACHED*/ + } + ++s->s_links; + return s; +} + + +void +sfree(STRING *s) +{ + if (s->s_links <= 0) { + math_error("Argument for sfree has nonpositive links!!!"); + /*NOTREACHED*/ + } + if (--s->s_links > 0 || s->s_len == 0) + return; + free(s->s_str); + s->s_next = freeStr; + freeStr = s; +} + +static long stringconstcount = 0; +static long stringconstavail = 0; +static STRING **stringconsttable; +#define STRCONSTALLOC 100 + +void +initstrings(void) +{ + stringconsttable = (STRING **) malloc(sizeof(STRING *) * STRCONSTALLOC); + if (stringconsttable == NULL) { + math_error("Unable to allocate constant table"); + /*NOTREACHED*/ + } + stringconsttable[0] = &_nullstring_; + stringconstcount = 1; + stringconstavail = STRCONSTALLOC - 1; +} + +/* + * addstring is called only from token.c + * When called, len is length if string including '\0' + */ +long +addstring(char *str, long len) +{ + STRING **sp; + STRING *s; + char *c; + long index; /* index into constant table */ + long first; /* first non-null position found */ + BOOL havefirst; + + if (stringconstavail <= 0) { + if (stringconsttable == NULL) { + initstrings(); + } + else { + sp = (STRING **) realloc((char *) stringconsttable, + sizeof(STRING *) * (stringconstcount + STRCONSTALLOC)); + if (sp == NULL) { + math_error("Unable to reallocate string const table"); + /*NOTREACHED*/ + } + stringconsttable = sp; + stringconstavail = STRCONSTALLOC; + } + } + len--; + first = 0; + havefirst = FALSE; + sp = stringconsttable; + for (index = 0; index < stringconstcount; index++, sp++) { + s = *sp; + if (s->s_links == 0) { + if (!havefirst) { + havefirst = TRUE; + first = index; + } + continue; + } + if (s->s_len == len && stringcompare(s->s_str, str, len) == 0) { + s->s_links++; + return index; + } + } + s = stralloc(); + c = (char *) malloc(len + 1); + if (c == NULL) { + math_error("Unable to allocate string constant memory"); + /*NOTREACHED*/ + } + s->s_str = c; + s->s_len = len; + while (len-- >= 0) + *c++ = *str++; + if (havefirst) { + stringconsttable[first] = s; + return first; + } + stringconstavail--; + stringconsttable[stringconstcount++] = s; + return index; +} + + +STRING * +findstring(long index) +{ + if (index < 0 || index >= stringconstcount) { + math_error("Bad index for findstring"); + /*NOTREACHED*/ + } + return stringconsttable[index]; +} + + +void +freestringconstant(long index) +{ + STRING *s; + STRING **sp; + + if (index >= 0) { + s = findstring(index); + sfree(s); + if (index == stringconstcount - 1) { + sp = &stringconsttable[index]; + while (stringconstcount > 0 && (*sp)->s_links == 0) { + stringconstcount--; + stringconstavail++; + sp--; + } + } + } +} + +long +printechar(char *c) +{ + long n; + unsigned char ch; + unsigned char ech; /* for escape sequence */ + unsigned char nch; /* for next character */ + BOOL three; + + ch = *c; + if (ch >= ' ' && ch < 127 && ch != '\\' && ch != '\"') { + putchar(ch); + return 1; + } + putchar('\\'); + ech = 0; + switch (ch) { + case '\n': ech = 'n'; break; + case '\r': ech = 'r'; break; + case '\t': ech = 't'; break; + case '\b': ech = 'b'; break; + case '\f': ech = 'f'; break; + case '\v': ech = 'v'; break; + case '\\': ech = '\\'; break; + case '\"': ech = '\"'; break; + case 7: ech = 'a'; break; + case 27: ech = 'e'; break; + } + if (ech) { + putchar(ech); + return 2; + } + nch = *(c + 1); + three = (nch >= '0' && nch < '8'); + n = 2; + if (three || ch >= 64) { + putchar('0' + ch/64); + n++; + } + ch %= 64; + if (three || ch >= 8) { + putchar('0' + ch/8); + n++; + } + ch %= 8; + putchar('0' + ch); + return n; +} + + +void +fitstring(char *str, long len, long width) +{ + long i, j, n, max; + char *c; + unsigned char ch, nch; + + max = (width - 3)/2; + if (len == 0) + return; + c = str; + for (i = 0, n = 0; i < len && n < max; i++) { + n += printechar(c++); + } + if (i >= len) + return; + c = str + len; + nch = '\0'; + for (n = 0, j = len ; j > i && n < max ; --j, nch = ch) { + ch = *--c; + n++; + if (ch >= ' ' && ch <= 127 && ch != '\\' && ch != '\"') + continue; + n++; + switch (ch) { + case '\n': case '\r': case '\t': case '\b': case '\f': + case '\v': case '\\': case '\"': case 7: case 27: + continue; + } + if (ch >= 64 || (nch >= '0' && nch <= '7')) { + n += 2; + continue; + } + if (ch >= 8) + n++; + } + if (j > i) + printf("..."); + while (j++ < len) + (void) printechar(c++); +} + +void +showstrings(void) +{ + STRING *sp; + long i, j, k; + long count; + + + printf("Index Links Length String\n"); + printf("----- ----- ------ ------\n"); + sp = &_nullstring_; + printf(" 0 %5ld 0 \"\"\n", sp->s_links); + for (i = 0, k = 1, count = 1; i < blockcount; i++) { + sp = firstStrs[i]; + for (j = 0; j < STRALLOC; j++, k++, sp++) { + if (sp->s_links > 0) { + ++count; + printf("%5ld %5ld %6ld \"", + k, sp->s_links, sp->s_len); + fitstring(sp->s_str, sp->s_len, 50); + printf("\"\n"); + } + } + } + printf("\nNumber: %ld\n", count); +} + + +void +showliterals(void) +{ + STRING *sp; + long i; + long count = 0; + + + printf("Index Links Length String\n"); + printf("----- ----- ------ ------\n"); + for (i = 0; i < stringconstcount; i++) { + sp = stringconsttable[i]; + if (sp->s_links > 0) { + ++count; + printf("%5ld %5ld %6ld \"", + i, sp->s_links, sp->s_len); + fitstring(sp->s_str, sp->s_len, 50); + printf("\"\n"); + } + + } + printf("\nNumber: %ld\n", count); +} + + /* END CODE */ diff --git a/string.h b/string.h index 3ebebe4..cdb85c3 100644 --- a/string.h +++ b/string.h @@ -1,15 +1,27 @@ /* - * Copyright (c) 1993 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. */ -#ifndef CALCSTRING_H -#define CALCSTRING_H + +#if !defined(__CALCSTRING_H__) +#define __CALCSTRING_H__ + #include "zmath.h" +struct string { + char *s_str; + long s_len; + long s_links; + struct string *s_next; +}; + +typedef struct string STRING; + + typedef struct { char *h_list; /* list of strings separated by nulls */ long h_used; /* characters used so far */ @@ -25,7 +37,18 @@ extern int findstr(STRINGHEAD *hp, char *str); extern char *charstr(int ch); extern char *addliteral(char *str); extern long stringindex(char *str1, char *str2); +extern STRING *stralloc(void); +extern long addstring(char *str, long len); +extern STRING *charstring(int ch); +extern STRING *makestring(char *str); +extern STRING *makenewstring(char *str); +extern STRING *findstring(long index); +extern STRING *slink(STRING *); +extern void sfree(STRING *); +extern void fitstring(char *, long, long); +extern void showstrings(void); +extern void showliterals(void); +extern STRING _nullstring_; -#endif -/* END CODE */ +#endif /* !__CALCSTRING_H__ */ diff --git a/symbol.c b/symbol.c index ea12148..dd3d7c7 100644 --- a/symbol.c +++ b/symbol.c @@ -1,11 +1,12 @@ /* - * Copyright (c) 1996 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. * * Global and local symbol routines. */ +#include #include "calc.h" #include "token.h" #include "symbol.h" @@ -15,6 +16,7 @@ #define HASHSIZE 37 /* size of hash table */ +extern FILE *f_open(char *name, char *mode); static int filescope; /* file scope level for static variables */ static int funcscope; /* function scope level for static variables */ @@ -23,8 +25,12 @@ static STRINGHEAD globalnames; /* list of global variable names */ static STRINGHEAD paramnames; /* list of parameter variable names */ static GLOBAL *globalhash[HASHSIZE]; /* hash table for globals */ -static void fitprint(NUMBER *num, long digits, long width); +static void printtype(VALUE *); static void unscope(void); +static void addstatic(GLOBAL *); +static long staticcount = 0; +static long staticavail = 0; +static GLOBAL **statictable; /* @@ -93,6 +99,7 @@ addglobal(char *name, BOOL isstatic) sp->g_funcscope = newfuncscope; sp->g_value.v_num = qlink(&_qzero_); sp->g_value.v_type = V_NUM; + sp->g_value.v_subtype = V_NOSUBTYPE; sp->g_next = *hp; *hp = sp; return sp; @@ -100,14 +107,9 @@ addglobal(char *name, BOOL isstatic) /* - * Look up the name of a global variable and return its address. - * Since the same variable may appear in different scopes, we search - * for the one with the highest function scope value within the current - * file scope level (or which is global). Returns NULL if the symbol - * was not found. - * - * given: - * name name of global variable + * Look for the highest-scope global variable with a specified name. + * Returns the address of the variable or NULL according as the search + * succeeds or fails. */ GLOBAL * findglobal(char *name) @@ -117,19 +119,14 @@ findglobal(char *name) long len; /* length of string */ bestsp = NULL; - len = (long)strlen(name); + len = (long) strlen(name); for (sp = globalhash[HASHSYM(name, len)]; sp; sp = sp->g_next) { - if ((sp->g_len != len) || strcmp(sp->g_name, name)) - continue; - if (sp->g_filescope == SCOPE_GLOBAL) { - if (bestsp == NULL) + if ((sp->g_len == len) && !strcmp(sp->g_name, name)) { + if ((bestsp == NULL) || + (sp->g_filescope > bestsp->g_filescope) || + (sp->g_funcscope > bestsp->g_funcscope)) bestsp = sp; - continue; } - if (sp->g_filescope != filescope) - continue; - if ((bestsp == NULL) || (sp->g_funcscope > bestsp->g_funcscope)) - bestsp = sp; } return bestsp; } @@ -151,8 +148,9 @@ globalname(GLOBAL *sp) /* - * Show the value of all global variables, typing only the head and - * tail of very large numbers. Only truly global symbols are shown. + * Show the value of all real-number valued global variables, displaying + * only the head and tail of very large numerators and denominators. + * Static variables are not included. */ void showglobals(void) @@ -160,74 +158,136 @@ showglobals(void) GLOBAL **hp; /* hash table head address */ register GLOBAL *sp; /* current global symbol pointer */ long count; /* number of global variables shown */ - NUMBER *num, *den; - long digits; count = 0; for (hp = &globalhash[HASHSIZE-1]; hp >= globalhash; hp--) { for (sp = *hp; sp; sp = sp->g_next) { if (sp->g_value.v_type != V_NUM) continue; - if (sp->g_filescope != SCOPE_GLOBAL) - continue; if (count++ == 0) { - printf("\nName Digits Value\n"); - printf( "---- ------ -----\n"); - } - printf("%-8s ", sp->g_name); - num = qnum(sp->g_value.v_num); - digits = qdigits(num); - printf("%-7ld ", digits); - fitprint(num, digits, 60L); - qfree(num); - if (!qisint(sp->g_value.v_num)) { - den = qden(sp->g_value.v_num); - digits = qdigits(den); - printf("\n %-6ld /", digits); - fitprint(den, digits, 60L); - qfree(den); + printf("\nName Digits Value\n"); + printf( "---- ------ -----\n"); } + printf("%-8s", sp->g_name); + if (sp->g_filescope != SCOPE_GLOBAL) + printf(" (s)"); + fitprint(sp->g_value.v_num, 50); printf("\n"); } } - printf(count ? "\n" : "No global variables defined\n"); + printf(count ? "\n" : "No real-valued global variables\n"); } -/* - * Print an integer which is guaranteed to fit in the specified number - * of columns, using imbedded '...' characters if it is too large. - */ -static void -fitprint(NUMBER *num, long digits, long width) +void +showallglobals(void) { - long show, used; - NUMBER *p, *t, *div, *val; + GLOBAL **hp; /* hash table head address */ + register GLOBAL *sp; /* current global symbol pointer */ + long count; /* number of global variables shown */ - if (digits <= width) { - qprintf("%r", num); + count = 0; + for (hp = &globalhash[HASHSIZE-1]; hp >= globalhash; hp--) { + for (sp = *hp; sp; sp = sp->g_next) { + if (count++ == 0) { + printf("\nName Level Type\n"); + printf( "---- ----- -----\n"); + } + printf("%-8s%4d ", sp->g_name, sp->g_filescope); + printtype(&sp->g_value); + printf("\n"); + } + } + if (count > 0) + printf("\nNumber: %ld\n", count); + else + printf("No global variables\n"); +} + +static void +printtype(VALUE *vp) +{ + int type; + char *s; + + type = vp->v_type; + if (type < 0) { + printf("Error %d", -type); return; } - show = (width / 2) - 2; - t = itoq(10L); - p = itoq((long) (digits - show)); - div = qpowi(t, p); - val = qquo(num, div, 0); - qprintf("%r", val); - printf("..."); - qfree(p); - qfree(div); - qfree(val); - p = itoq(show); - div = qpowi(t, p); - val = qmod(num, div, 0); - used = qdigits(val); - while (used++ < show) printf("0"); - qprintf("%r", val); - qfree(p); - qfree(div); - qfree(val); - qfree(t); + switch (type) { + case V_NUM: + printf("real = "); + fitprint(vp->v_num, 32); + return; + case V_COM: + printf("complex = "); + fitprint(vp->v_com->real, 8); + if (!vp->v_com->imag->num.sign) + printf("+"); + fitprint(vp->v_com->imag, 8); + printf("i"); + return; + case V_STR: + printf("string = \""); + fitstring(vp->v_str->s_str, vp->v_str->s_len, 50); + printf("\""); + return; + case V_NULL: + s = "null"; + break; + case V_MAT: + s = "matrix"; + break; + case V_LIST: + s = "list"; + break; + case V_ASSOC: + s = "association"; + break; + case V_OBJ: + printf("%s ", + vp->v_obj->o_actions->name); + s = "object"; + break; + case V_FILE: + s = "file id"; + break; + case V_RAND: + s = "additive 55 random state"; + break; + case V_RANDOM: + s = "Blum random state"; + break; + case V_CONFIG: + s = "config state"; + break; + case V_HASH: + s = "hash state"; + break; + case V_BLOCK: + s = "unnamed block"; + break; + case V_NBLOCK: + s = "named block"; + break; + case V_VPTR: + s = "value pointer"; + break; + case V_OPTR: + s = "octet pointer"; + break; + case V_SPTR: + s = "string pointer"; + break; + case V_NPTR: + s = "number pointer"; + break; + default: + s = "???"; + break; + } + printf("%s", s); } @@ -243,6 +303,7 @@ writeglobals(char *name) GLOBAL **hp; /* hash table head address */ register GLOBAL *sp; /* current global symbol pointer */ int savemode; /* saved output mode */ + extern void math_setfp(FILE *fp); fp = f_open(name, "w"); if (fp == NULL) @@ -271,6 +332,45 @@ writeglobals(char *name) return 0; } +/* + * Free all non-null global and visible static variables + */ +void +freeglobals(void) +{ + GLOBAL **hp; /* hash table head address */ + GLOBAL *sp; /* current global symbol pointer */ + long count; /* number of global variables freed */ + + count = 0; + for (hp = &globalhash[HASHSIZE-1]; hp >= globalhash; hp--) { + for (sp = *hp; sp; sp = sp->g_next) { + if (sp->g_value.v_type != V_NULL) { + freevalue(&sp->g_value); + count++; + } + } + } +} + +/* + * Free all invisible static variables + */ +void +freestatics(void) +{ + GLOBAL **stp; + GLOBAL *sp; + long count; + + stp = statictable; + count = staticcount; + while (count-- > 0) { + sp = *stp++; + freevalue(&sp->g_value); + } +} + /* * Reset the file and function scope levels back to the original values. @@ -342,6 +442,91 @@ exitfuncscope(void) } +/* + * To end the scope of any static variable with identifier id when + * id is being declared as global, or when id is declared as static and the + * variable is at the same file and function level. + */ +void +endscope(char *name, BOOL isglobal) +{ + GLOBAL *sp; + GLOBAL *prevsp; + GLOBAL **hp; + int len; + + len = strlen(name); + prevsp = NULL; + hp = &globalhash[HASHSYM(name, len)]; + for (sp = *hp; sp; sp = sp->g_next) { + if (sp->g_len == len && !strcmp(sp->g_name, name) && + sp->g_filescope > SCOPE_GLOBAL) { + if (isglobal || (sp->g_filescope == filescope && + sp->g_funcscope == funcscope)) { + addstatic(sp); + if (prevsp) + prevsp->g_next = sp->g_next; + else + *hp = sp->g_next; + } + } + prevsp = sp; + } +} + +/* + * To store in a table a static variable whose scope is being ended + */ +void +addstatic(GLOBAL *sp) +{ + GLOBAL **stp; + + if (staticavail <= 0) { + if (staticcount <= 0) + stp = (GLOBAL **) malloc(20 * sizeof(GLOBAL *)); + else + stp = (GLOBAL **) realloc(statictable, + (20 + staticcount) * sizeof(GLOBAL *)); + if (stp == NULL) { + math_error("Cannot allocate static-variable table"); + /*NOTREACHED*/ + } + statictable = stp; + staticavail = 20; + } + statictable[staticcount++] = sp; + staticavail--; +} + +/* + * To display all static variables whose scope has been ended + */ +void +showstatics(void) +{ + long count; + GLOBAL **stp; + GLOBAL *sp; + + for (count = 0, stp = statictable; count < staticcount; count++) { + sp = *stp++; + if (count == 0) { + printf("\nName Scopes Type\n"); + printf( "---- ------ -----\n"); + } + printf("%-8s", sp->g_name); + printf("%3d", sp->g_filescope); + printf("%3d ", sp->g_funcscope); + printtype(&sp->g_value); + printf("\n"); + } + if (count > 0) + printf("\nNumber: %ld\n", count); + else + printf("No unscoped static variables\n"); +} + /* * Remove all the symbols from the global symbol table which have file or * function scopes larger than the current scope levels. Their memory @@ -369,6 +554,7 @@ unscope(void) /* * This symbol needs removing. */ + addstatic(sp); if (prevsp) prevsp->g_next = sp->g_next; else diff --git a/symbol.h b/symbol.h index 9cb01b0..079f708 100644 --- a/symbol.h +++ b/symbol.h @@ -1,11 +1,13 @@ /* - * Copyright (c) 1993 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. */ -#ifndef SYMBOL_H -#define SYMBOL_H + +#if !defined(__SYMBOL_H__) +#define __SYMBOL_H__ + #include "zmath.h" @@ -57,6 +59,7 @@ extern void enterfilescope(void); extern void exitfilescope(void); extern void enterfuncscope(void); extern void exitfuncscope(void); +extern void endscope (char *name, BOOL isglobal); /* @@ -71,7 +74,10 @@ extern void initglobals(void); extern int writeglobals(char *name); extern int symboltype(char *name); extern void showglobals(void); +extern void showallglobals(void); +extern void freeglobals(void); +extern void showstatics(void); +extern void freestatics(void); -#endif -/* END CODE */ +#endif /* !__SYMBOL_H__ */ diff --git a/token.c b/token.c index 820420a..fc8bc59 100644 --- a/token.c +++ b/token.c @@ -1,15 +1,20 @@ /* - * 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. * * Read input file characters into tokens */ + +#include +#include + #include "calc.h" #include "token.h" #include "string.h" #include "args.h" +#include "math_error.h" #define isletter(ch) ((((ch) >= 'a') && ((ch) <= 'z')) || \ @@ -26,7 +31,8 @@ */ static struct { short t_type; /* type of token */ - char *t_str; /* string value or symbol name */ + char *t_sym; /* symbol name */ + long t_strindex; /* index of string value */ long t_numindex; /* index of numeric value */ } curtoken; @@ -76,6 +82,7 @@ static struct keyword keywords[] = { {"obj", T_OBJ}, {"print", T_PRINT}, {"cd", T_CD}, + {"undefine", T_UNDEFINE}, {NULL, 0} }; @@ -140,7 +147,8 @@ gettoken(void) rescan = FALSE; return curtoken.t_type; } - curtoken.t_str = NULL; + curtoken.t_sym = NULL; + curtoken.t_strindex = 0; curtoken.t_numindex = 0; type = T_NULL; while (type == T_NULL) { @@ -170,6 +178,9 @@ gettoken(void) case ':': type = T_COLON; break; case ',': type = T_COMMA; break; case '?': type = T_QUESTIONMARK; break; + case '@': type = T_AT; break; + case '`': type = T_BACKQUOTE; break; + case '$': type = T_DOLLAR; break; case '"': case '\'': type = T_STRING; @@ -198,6 +209,7 @@ gettoken(void) switch (nextchar()) { case '-': type = T_MINUSMINUS; break; case '=': type = T_MINUSEQUALS; break; + case '>': type = T_ARROW; break; default: type = T_MINUS; reread(); } break; @@ -276,10 +288,23 @@ gettoken(void) default: type = T_NOT; reread(); break; } break; + case '#': + switch(nextchar()) { + case '=': type = T_HASHEQUALS; break; + default: type = T_HASH; reread(); + } + break; + case '~': + switch (nextchar()) { + case '=': type = T_TILDEEQUALS; break; + default: type = T_TILDE; reread(); + } + break; case '\\': switch (nextchar()) { case '\n': setprompt(conf->prompt2); break; - default: scanerror(T_NULL, "Unknown token character '%c'", ch); + case '=': type = T_BACKSLASHEQUALS; break; + default: type = T_BACKSLASH; reread(); } break; default: @@ -357,7 +382,6 @@ eatstring(int quotechar) case '\n': if (!newlines) break; - case '\0': case EOF: reread(); scanerror(T_NULL, "Unterminated string constant"); @@ -379,7 +403,7 @@ eatstring(int quotechar) if (i > 0) reread(); break; - } + } switch (ch) { case 'n': ch = '\n'; break; case 'r': ch = '\r'; break; @@ -419,7 +443,7 @@ eatstring(int quotechar) } break; } - + *cp++ = (char) ch; len++; } @@ -436,12 +460,12 @@ eatstring(int quotechar) totlen += len; } } - curtoken.t_str = addliteral(str); + curtoken.t_strindex = addstring(str, totlen + len); if (str != buf) free(str); } - - + + /* * Read in a symbol name which may or may not be a keyword. * If allsyms is set, keywords are not looked up and almost all chars @@ -470,7 +494,7 @@ eatsymbol(void) *cp = '\0'; if (cc < 0) scanerror(T_NULL, "Symbol too long"); - curtoken.t_str = buf; + curtoken.t_sym = buf; return T_SYMBOL; } for (;;) { @@ -487,7 +511,7 @@ eatsymbol(void) for (kp = keywords; kp->k_name; kp++) if (strcmp(kp->k_name, buf) == 0) return kp->k_token; - curtoken.t_str = buf; + curtoken.t_sym = buf; return T_SYMBOL; } @@ -559,12 +583,12 @@ eatnumber(void) /* - * Return the string value of the current token. + * Return the index for string value of the current token. */ -char * +long tokenstring(void) { - return curtoken.t_str; + return curtoken.t_strindex; } @@ -577,6 +601,14 @@ tokennumber(void) return curtoken.t_numindex; } +/* + * Return the address of a symbol + */ +char * +tokensymbol(void) +{ + return curtoken.t_sym; +} /* * Push back the token just read so that it will be seen again. @@ -612,7 +644,7 @@ scanerror(int skip, char *fmt, ...) fprintf(stderr, "%s\n", buf); /* bail out if too many errors */ - if (conf->maxerrorcount > 0 && errorcount > conf->maxerrorcount) { + if (conf->maxscancount > 0 && errorcount > conf->maxscancount) { fputs("Too many scan errors, compilation aborted.\n", stderr); longjmp(jmpbuf, 1); /*NOTREACHED*/ diff --git a/token.h b/token.h index 82ec11c..845a389 100644 --- a/token.h +++ b/token.h @@ -1,11 +1,13 @@ /* - * 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. */ -#ifndef TOKEN_H -#define TOKEN_H + +#if !defined(__TOKEN_H__) +#define __TOKEN_H__ + #include "zmath.h" @@ -67,6 +69,16 @@ #define T_IMAGINARY 51 /* numeric imaginary constant */ #define T_AMPERSAND 52 /* ampersand "&" */ #define T_QUESTIONMARK 53 /* question mark "?" */ +#define T_AT 54 /* at sign "@" */ +#define T_DOLLAR 55 /* dollar sign "$" */ +#define T_HASH 56 /* hash or pound sign "#" */ +#define T_HASHEQUALS 57 /* hash equals "#=" */ +#define T_BACKQUOTE 58 /* backquote sign "`" */ +#define T_ARROW 59 /* arrow "->" */ +#define T_TILDE 60 /* tilde "~" */ +#define T_TILDEEQUALS 61 /* tilde equals "~=" */ +#define T_BACKSLASH 62 /* backslash or setminus "\" */ +#define T_BACKSLASHEQUALS 63 /* backslash equals "\=" */ /* @@ -97,6 +109,7 @@ #define T_OBJ 123 /* obj keyword */ #define T_PRINT 124 /* print keyword */ #define T_CD 125 /* change directory keyword */ +#define T_UNDEFINE 126 /* undefine keyword */ #define iskeyword(n) ((n) > 100) /* TRUE if token is a keyword */ @@ -125,14 +138,14 @@ extern long errorcount; /* number of errors found */ -extern char *tokenstring(void); +extern long tokenstring(void); extern long tokennumber(void); +extern char *tokensymbol(void); extern void inittokens(void); extern int tokenmode(int flag); extern int gettoken(void); extern void rescantoken(void); extern void scanerror(int, char *, ...); -#endif -/* END CODE */ +#endif /* !__TOKEN_H__ */ diff --git a/value.c b/value.c index 6edd129..5d29d27 100644 --- a/value.c +++ b/value.c @@ -1,19 +1,28 @@ /* - * Copyright (c) 1996 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. * * Generic value manipulation routines. */ +#include +#include #include "value.h" #include "opcodes.h" #include "func.h" #include "symbol.h" #include "string.h" #include "zrand.h" +#include "zrandom.h" #include "cmath.h" +#include "nametype.h" +#include "file.h" +#include "config.h" +#define LINELEN 80 /* length of a typical tty line */ + +extern int sys_nerr; /* * Free a value and set its type to undefined. @@ -33,11 +42,17 @@ freevalue(VALUE *vp) switch (type) { case V_NULL: case V_ADDR: + case V_OCTET: + case V_NBLOCK: case V_FILE: + case V_VPTR: + case V_OPTR: + case V_SPTR: + case V_NPTR: + /* nothing to free */ break; case V_STR: - if (vp->v_subtype == V_STRALLOC) - free(vp->v_str); + sfree(vp->v_str); break; case V_NUM: qfree(vp->v_num); @@ -66,11 +81,12 @@ freevalue(VALUE *vp) case V_CONFIG: config_free(vp->v_config); break; -#if 0 /* XXX - write */ case V_HASH: hash_free(vp->v_hash); break; -#endif + case V_BLOCK: + blk_free(vp->v_block); + break; default: math_error("Freeing unknown value type"); /*NOTREACHED*/ @@ -79,6 +95,42 @@ freevalue(VALUE *vp) } +/* + * Set protection status for a value and all of its components + */ +void +protectall(VALUE *vp, int sts) +{ + VALUE *vq; + int i; + LISTELEM *ep; + + if (vp->v_type == V_NBLOCK) { + vp->v_nblock->subtype |= sts; + return; + } + vp->v_subtype |= sts; + switch(vp->v_type) { + case V_MAT: + vq = vp->v_mat->m_table; + i = vp->v_mat->m_size; + while (i-- > 0) + protectall(vq++, sts); + break; + case V_LIST: + for (ep = vp->v_list->l_first; ep; ep = ep->e_next) + protectall(&ep->e_value, sts); + break; + case V_OBJ: + vq = vp->v_obj->o_table; + i = vp->v_obj->o_actions->count; + while (i-- > 0) + protectall(vq++, sts); + break; + } +} + + /* * Copy a value from one location to another. * This overwrites the specified new value without checking it. @@ -90,13 +142,17 @@ freevalue(VALUE *vp) void copyvalue(VALUE *oldvp, VALUE *newvp) { - if (oldvp->v_type < 0) { - newvp->v_type = oldvp->v_type; - return; - } - newvp->v_type = V_NULL; - switch (oldvp->v_type) { + + newvp->v_type = oldvp->v_type; + if (oldvp->v_type >= 0) { + switch (oldvp->v_type) { case V_NULL: + case V_ADDR: + case V_VPTR: + case V_OPTR: + case V_SPTR: + case V_NPTR: + *newvp = *oldvp; break; case V_FILE: newvp->v_file = oldvp->v_file; @@ -108,15 +164,7 @@ copyvalue(VALUE *oldvp, VALUE *newvp) newvp->v_com = clink(oldvp->v_com); break; case V_STR: - newvp->v_str = oldvp->v_str; - if (oldvp->v_subtype == V_STRALLOC) { - newvp->v_str = (char *)malloc(strlen(oldvp->v_str) + 1); - if (newvp->v_str == NULL) { - math_error("Cannot get memory for string copy"); - /*NOTREACHED*/ - } - strcpy(newvp->v_str, oldvp->v_str); - } + newvp->v_str = slink(oldvp->v_str); break; case V_MAT: newvp->v_mat = matcopy(oldvp->v_mat); @@ -127,9 +175,6 @@ copyvalue(VALUE *oldvp, VALUE *newvp) case V_ASSOC: newvp->v_assoc = assoccopy(oldvp->v_assoc); break; - case V_ADDR: - newvp->v_addr = oldvp->v_addr; - break; case V_OBJ: newvp->v_obj = objcopy(oldvp->v_obj); break; @@ -142,22 +187,103 @@ copyvalue(VALUE *oldvp, VALUE *newvp) case V_CONFIG: newvp->v_config = config_copy(oldvp->v_config); break; -#if 0 /* XXX - write */ case V_HASH: newvp->v_hash = hash_copy(oldvp->v_hash); break; -#endif + case V_BLOCK: + newvp->v_block = blk_copy(oldvp->v_block); + break; + case V_OCTET: + newvp->v_type = V_NUM; + newvp->v_num = itoq((long) *oldvp->v_octet); + break; + case V_NBLOCK: + newvp->v_nblock = oldvp->v_nblock; + return; default: math_error("Copying unknown value type"); /*NOTREACHED*/ + } } - if (oldvp->v_type == V_STR) { - newvp->v_subtype = oldvp->v_subtype; - } else { - newvp->v_subtype = V_NOSUBTYPE; - } - newvp->v_type = oldvp->v_type; + newvp->v_subtype |= oldvp->v_subtype; +} + +/* + * copy the low order 8 bits of a value to an octet + */ +void +copy2octet(VALUE *vp, OCTET *op) +{ + USB8 oval; /* low order 8 bits to store into OCTET */ + NUMBER *q; + HALF h; + + if (vp->v_type == V_ADDR) + vp = vp->v_addr; + + oval = 0; + + /* + * we can (at the moment) only store certain types + * values into an OCTET, so get the low order 8 bits + * of these particular value types + */ + h = 0; + switch(vp->v_type) { + case V_NULL: + /* nothing to store ... so do nothing */ + return; + case V_INT: + oval = (USB8)(vp->v_int & 0xff); + break; + case V_NUM: + if (qisint(vp->v_num)) { + /* use low order 8 bits of integer value */ + h = vp->v_num->num.v[0]; + } else { + /* use low order 8 bits of int(value) */ + q = qint(vp->v_num); + h = q->num.v[0]; + qfree(q); + } + if (qisneg(vp->v_num)) + h = -h; + oval = (USB8) h; + break; + case V_COM: + if (cisint(vp->v_com)) { + /* use low order 8 bits of integer value */ + h = vp->v_com->real->num.v[0]; + } else { + /* use low order 8 bits of int(value) */ + q = qint(vp->v_com->real); + h = q->num.v[0]; + qfree(q); + } + if (qisneg(vp->v_com->real)) + h = -h; + oval = (USB8) h; + break; + case V_STR: + oval = (USB8) vp->v_str->s_str[0]; + break; + case V_BLOCK: + oval = (USB8) vp->v_block->data[0]; + break; + case V_OCTET: + oval = *vp->v_octet; + break; + case V_NBLOCK: + if (vp->v_nblock->blk->data == NULL) + return; + oval = (USB8) vp->v_nblock->blk->data[0]; + break; + default: + math_error("invalid assignment into an OCTET"); + break; + } + *op = oval; } @@ -169,6 +295,7 @@ void negvalue(VALUE *vp, VALUE *vres) { vres->v_type = vp->v_type; + vres->v_subtype = V_NOSUBTYPE; switch (vp->v_type) { case V_NUM: vres->v_num = qneg(vp->v_num); @@ -179,6 +306,16 @@ negvalue(VALUE *vp, VALUE *vres) case V_MAT: vres->v_mat = matneg(vp->v_mat); return; + case V_STR: + vres->v_str = stringneg(vp->v_str); + if (vres->v_str == NULL) + *vres = error_value(E_STRNEG); + return; + case V_OCTET: + vres->v_type = V_NUM; + vres->v_num = itoq(- (long) *vp->v_octet); + return; + case V_OBJ: *vres = objcall(OBJ_NEG, vp, NULL_VALUE, NULL_VALUE); return; @@ -207,7 +344,6 @@ addnumeric(VALUE *v1, VALUE *v2, VALUE *vres) /* * add numeric values */ - vres->v_subtype = V_NOSUBTYPE; switch (TWOVAL(v1->v_type, v2->v_type)) { case TWOVAL(V_NUM, V_NUM): vres->v_num = qqadd(v1->v_num, v2->v_num); @@ -270,7 +406,10 @@ addvalue(VALUE *v1, VALUE *v2, VALUE *vres) { COMPLEX *c; VALUE tmp; + NUMBER *q; + long i; + vres->v_subtype = V_NOSUBTYPE; if (v1->v_type == V_LIST) { tmp.v_type = V_NULL; addlistitems(v1->v_list, &tmp); @@ -314,6 +453,31 @@ addvalue(VALUE *v1, VALUE *v2, VALUE *vres) case TWOVAL(V_MAT, V_MAT): vres->v_mat = matadd(v1->v_mat, v2->v_mat); return; + case TWOVAL(V_STR, V_STR): + vres->v_str = stringadd(v1->v_str, v2->v_str); + if (vres->v_str == NULL) + *vres = error_value(E_STRADD); + return; + case TWOVAL(V_VPTR, V_NUM): + q = v2->v_num; + if (qisfrac(q)) { + math_error("Adding non-integer to address"); + /*NOTREACHED*/ + } + i = qtoi(q); + vres->v_addr = v1->v_addr + i; + vres->v_type = V_VPTR; + return; + case TWOVAL(V_OPTR, V_NUM): + q = v2->v_num; + if (qisfrac(q)) { + math_error("Adding non-integer to address"); + /*NOTREACHED*/ + } + i = qtoi(q); + vres->v_octet = v1->v_octet + i; + vres->v_type = V_OPTR; + return; default: if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) { if (v1->v_type < 0) { @@ -341,8 +505,11 @@ void subvalue(VALUE *v1, VALUE *v2, VALUE *vres) { COMPLEX *c; + NUMBER *q; + int i; vres->v_type = v1->v_type; + vres->v_subtype = V_NOSUBTYPE; switch (TWOVAL(v1->v_type, v2->v_type)) { case TWOVAL(V_NUM, V_NUM): vres->v_num = qsub(v1->v_num, v2->v_num); @@ -368,6 +535,39 @@ subvalue(VALUE *v1, VALUE *v2, VALUE *vres) case TWOVAL(V_MAT, V_MAT): vres->v_mat = matsub(v1->v_mat, v2->v_mat); return; + case TWOVAL(V_STR, V_STR): + vres->v_str = stringsub(v1->v_str, v2->v_str); + if (vres->v_str == NULL) + *vres = error_value(E_STRSUB); + return; + case TWOVAL(V_VPTR, V_NUM): + q = v2->v_num; + if (qisfrac(q)) { + math_error("Subtracting non-integer from address"); + /*NOTREACHED*/ + } + i = qtoi(q); + vres->v_addr = v1->v_addr - i; + vres->v_type = V_VPTR; + return; + case TWOVAL(V_OPTR, V_NUM): + q = v2->v_num; + if (qisfrac(q)) { + math_error("Adding non-integer to address"); + /*NOTREACHED*/ + } + i = qtoi(q); + vres->v_octet = v1->v_octet - i; + vres->v_type = V_OPTR; + return; + case TWOVAL(V_VPTR, V_VPTR): + vres->v_type = V_NUM; + vres->v_num = itoq(v1->v_addr - v2->v_addr); + return; + case TWOVAL(V_OPTR, V_OPTR): + vres->v_type = V_NUM; + vres->v_num = itoq(v1->v_octet - v2->v_octet); + return; default: if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) { if (v1->v_type < 0) { @@ -397,6 +597,7 @@ mulvalue(VALUE *v1, VALUE *v2, VALUE *vres) COMPLEX *c; vres->v_type = v1->v_type; + vres->v_subtype = V_NOSUBTYPE; switch (TWOVAL(v1->v_type, v2->v_type)) { case TWOVAL(V_NUM, V_NUM): vres->v_num = qmul(v1->v_num, v2->v_num); @@ -423,6 +624,17 @@ mulvalue(VALUE *v1, VALUE *v2, VALUE *vres) vres->v_mat = matmulval(v2->v_mat, v1); vres->v_type = V_MAT; return; + case TWOVAL(V_NUM, V_STR): + vres->v_type = V_STR; + vres->v_str = stringmul(v1->v_num, v2->v_str); + if (vres->v_str == NULL) + *vres = error_value(E_STRMUL); + return; + case TWOVAL(V_STR, V_NUM): + vres->v_str= stringmul(v2->v_num, v1->v_str); + if (vres->v_str == NULL) + *vres = error_value(E_STRMUL); + return; default: if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) { if (v1->v_type < 0) { @@ -458,6 +670,7 @@ squarevalue(VALUE *vp, VALUE *vres) COMPLEX *c; vres->v_type = vp->v_type; + vres->v_subtype = V_NOSUBTYPE; switch (vp->v_type) { case V_NUM: vres->v_num = qsquare(vp->v_num); @@ -495,10 +708,16 @@ squarevalue(VALUE *vp, VALUE *vres) void invertvalue(VALUE *vp, VALUE *vres) { + NUMBER *q1, *q2; + vres->v_type = vp->v_type; + vres->v_subtype = V_NOSUBTYPE; switch (vp->v_type) { case V_NUM: - vres->v_num = qinv(vp->v_num); + if (qiszero(vp->v_num)) + *vres = error_value(E_1OVER0); + else + vres->v_num = qinv(vp->v_num); return; case V_COM: vres->v_com = cinv(vp->v_com); @@ -506,10 +725,26 @@ invertvalue(VALUE *vp, VALUE *vres) case V_MAT: vres->v_mat = matinv(vp->v_mat); return; + case V_OCTET: + if (*vp->v_octet == 0) { + *vres = error_value(E_1OVER0); + return; + } + q1 = itoq((long) *vp->v_octet); + q2 = qinv(q1); + qfree(q1); + vres->v_num = q2; + vres->v_type = V_NUM; + return; case V_OBJ: *vres = objcall(OBJ_INV, vp, NULL_VALUE, NULL_VALUE); return; default: + if (vp->v_type == -E_1OVER0) { + vres->v_type = V_NUM; + vres->v_num = qlink(&_qzero_); + return; + } if (vp->v_type < 0) { copyvalue(vp, vres); return; @@ -520,6 +755,310 @@ invertvalue(VALUE *vp, VALUE *vres) } + +/* + * "AND" two arbitrary values together. + * Result is placed in the indicated location. + */ +void +andvalue(VALUE *v1, VALUE *v2, VALUE *vres) +{ + vres->v_subtype = V_NOSUBTYPE; + if (v1->v_type == V_NULL) { + copyvalue(v2, vres); + return; + } + if (v2->v_type == V_NULL) { + copyvalue(v1, vres); + return; + } + vres->v_type = v1->v_type; + switch (TWOVAL(v1->v_type, v2->v_type)) { + case TWOVAL(V_NUM, V_NUM): + vres->v_num = qand(v1->v_num, v2->v_num); + return; + case TWOVAL(V_STR, V_STR): + vres->v_str = stringand(v1->v_str, v2->v_str); + if (vres->v_str == NULL) + *vres = error_value(E_STRAND); + return; + case TWOVAL(V_OCTET, V_OCTET): + vres->v_type = V_STR; + vres->v_str = charstring(*v1->v_octet & *v2->v_octet); + return; + case TWOVAL(V_STR, V_OCTET): + vres->v_str = charstring(*v1->v_str->s_str & + *v2->v_octet); + return; + case TWOVAL(V_OCTET, V_STR): + vres->v_type = V_STR; + vres->v_str = charstring(*v1->v_octet & + *v2->v_str->s_str); + return; + default: + if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) { + if (v1->v_type < 0) { + copyvalue(v1, vres); + return; + } + if (v2->v_type < 0) { + copyvalue(v2, vres); + return; + } + *vres = error_value(E_AND); + return; + } + *vres = objcall(OBJ_AND, v1, v2, NULL_VALUE); + return; + } +} + + +/* + * "OR" two arbitrary values together. + * Result is placed in the indicated location. + */ +void +orvalue(VALUE *v1, VALUE *v2, VALUE *vres) +{ + if (v1->v_type == V_NULL) { + copyvalue(v2, vres); + return; + } + if (v2->v_type == V_NULL) { + copyvalue(v1, vres); + return; + } + vres->v_type = v1->v_type; + vres->v_subtype = V_NOSUBTYPE; + switch (TWOVAL(v1->v_type, v2->v_type)) { + case TWOVAL(V_NUM, V_NUM): + vres->v_num = qor(v1->v_num, v2->v_num); + return; + case TWOVAL(V_STR, V_STR): + vres->v_str = stringor(v1->v_str, v2->v_str); + if (vres->v_str == NULL) + *vres = error_value(E_STROR); + return; + case TWOVAL(V_OCTET, V_OCTET): + vres->v_type = V_STR; + vres->v_str = charstring(*v1->v_octet | *v2->v_octet); + return; + case TWOVAL(V_STR, V_OCTET): + vres->v_str = charstring(*v1->v_str->s_str | + *v2->v_octet); + return; + case TWOVAL(V_OCTET, V_STR): + vres->v_type = V_STR; + vres->v_str = charstring(*v1->v_octet | + *v2->v_str->s_str); + return; + default: + if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) { + if (v1->v_type < 0) { + copyvalue(v1, vres); + return; + } + if (v2->v_type < 0) { + copyvalue(v2, vres); + return; + } + *vres = error_value(E_OR); + return; + } + *vres = objcall(OBJ_OR, v1, v2, NULL_VALUE); + return; + } +} + + +/* + * "~" two values, returns the "symmetric difference" bitwise xor(v1, v2) for + * strings, octets and real numbers, and a user-defined function if at least + * one of v1 and v2 is an object. + */ +void +xorvalue(VALUE *v1, VALUE *v2, VALUE *vres) +{ + vres->v_type = v1->v_type; + vres->v_subtype = V_NOSUBTYPE; + switch (TWOVAL(v1->v_type, v2->v_type)) { + case (TWOVAL(V_NUM, V_NUM)): + vres->v_num = qxor(v1->v_num, v2->v_num); + return; + case (TWOVAL(V_STR, V_STR)): + vres->v_str = stringxor(v1->v_str, v2->v_str); + if (vres->v_str == NULL) + *vres = error_value(E_STRDIFF); + return; + case (TWOVAL(V_STR, V_OCTET)): + if (v1->v_str->s_len) { + vres->v_str = stringcopy(v1->v_str); + *vres->v_str->s_str ^= *v2->v_octet; + } else + vres->v_str = charstring(*v2->v_octet); + return; + case (TWOVAL(V_OCTET, V_STR)): + if (v2->v_str->s_len) { + vres->v_str = stringcopy(v2->v_str); + *vres->v_str->s_str ^= *v1->v_octet; + } else + vres->v_str = charstring(*v1->v_octet); + return; + case (TWOVAL(V_OCTET, V_OCTET)): + vres->v_type = V_STR; + vres->v_str = charstring(*v1->v_octet ^ *v2->v_octet); + return; + default: + if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) + *vres = objcall(OBJ_XOR, v1, v2, NULL_VALUE); + else + *vres = error_value(E_XOR); + } +} + + +/* + * "#" two values - abs(v1-v2) for numbers, user-defined for objects + */ +void +hashopvalue(VALUE *v1, VALUE *v2, VALUE *vres) +{ + NUMBER *q; + + vres->v_type = v1->v_type; + vres->v_subtype = V_NOSUBTYPE; + switch (TWOVAL(v1->v_type, v2->v_type)) { + case TWOVAL(V_NUM, V_NUM): + q = qsub(v1->v_num, v2->v_num); + vres->v_num = qqabs(q); + qfree(q); + return; + default: + if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) + *vres = objcall(OBJ_HASHOP, v1, v2, NULL_VALUE); + else + *vres = error_value(E_HASHOP); + } +} + + +void +compvalue(VALUE *vp, VALUE *vres) +{ + + vres->v_type = vp->v_type; + vres->v_subtype = V_NOSUBTYPE; + switch (vp->v_type) { + case V_NUM: + vres->v_num = qcomp(vp->v_num); + return; + case V_STR: + vres->v_str = stringcomp(vp->v_str); + if (vres->v_str == NULL) + *vres = error_value(E_STRCOMP); + return; + case V_OCTET: + vres->v_type = V_STR; + vres->v_str = charstring(~*vp->v_octet); + return; + case V_OBJ: + *vres = objcall(OBJ_COMP, vp, NULL_VALUE, NULL_VALUE); + return; + default: + *vres = error_value(E_COMP); + } +} + +/* + * "\" a value, user-defined only + */ +void +backslashvalue(VALUE *vp, VALUE *vres) +{ + if (vp->v_type == V_OBJ) + *vres = objcall(OBJ_BACKSLASH, vp, NULL_VALUE, NULL_VALUE); + else + *vres = error_value(E_BACKSLASH); +} + + +/* + * "\" two values, for strings performs bitwise "AND-NOT" operation + * User defined for objects + */ +void +setminusvalue(VALUE *v1, VALUE *v2, VALUE *vres) +{ + vres->v_type = v1->v_type; + vres->v_subtype = V_NOSUBTYPE; + switch (TWOVAL(v1->v_type, v2->v_type)) { + case TWOVAL(V_NUM, V_NUM): + vres->v_num = qandnot(v1->v_num, v2->v_num); + return; + case TWOVAL(V_STR, V_STR): + vres->v_str = stringdiff(v1->v_str, v2->v_str); + return; + case TWOVAL(V_STR, V_OCTET): + vres->v_str = charstring(*v1->v_str->s_str & + ~*v2->v_octet); + return; + case TWOVAL(V_OCTET, V_STR): + vres->v_type = V_STR; + vres->v_str = charstring(*v1->v_octet & + ~*v2->v_str->s_str); + return; + case TWOVAL(V_OCTET, V_OCTET): + vres->v_type = V_STR; + vres->v_str = charstring(*v1->v_octet & + ~*v2->v_octet); + return; + default: + if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) + *vres = objcall(OBJ_SETMINUS, v1, v2, + NULL_VALUE); + else + *vres = error_value(E_SETMINUS); + } +} + + +/* + * "#" a value, for strings and octets returns the number of nonzero bits + * in the value; user-defined for an object + */ +void +contentvalue(VALUE *vp, VALUE *vres) +{ + long count; + unsigned char u; + + vres->v_type = V_NUM; + vres->v_subtype = V_NOSUBTYPE; + count = 0; + switch (vp->v_type) { + case V_STR: + count = stringcontent(vp->v_str); + break; + case V_OCTET: + for (u = *vp->v_octet; u; u >>= 1) + count += (u & 1); + break; + case V_NUM: + count = zpopcnt(vp->v_num->num, 1); + break; + case V_OBJ: + *vres = objcall(OBJ_CONTENT, vp, NULL_VALUE, + NULL_VALUE); + return; + default: + *vres = error_value(E_CONTENT); + return; + } + vres->v_num = itoq(count); +} + + /* * Approximate numbers by multiples of v2 using rounding criterion v3. * Result is placed in the indicated location. @@ -533,6 +1072,7 @@ apprvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) COMPLEX *c; vres->v_type = v1->v_type; + vres->v_subtype = V_NOSUBTYPE; if (v1->v_type < 0) { copyvalue(v1, vres); return; @@ -585,6 +1125,8 @@ apprvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) return; } c = comalloc(); + qfree(c->real); + qfree(c->imag); c->real = q1; c->imag = q2; vres->v_com = c; @@ -608,6 +1150,7 @@ roundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) long places, rnd; vres->v_type = v1->v_type; + vres->v_subtype = V_NOSUBTYPE; if (v1->v_type == V_MAT) { vres->v_mat = matround(v1->v_mat, v2, v3); return; @@ -665,6 +1208,8 @@ roundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) return; } c = comalloc(); + qfree(c->real); + qfree(c->imag); c->real = q1; c->imag = q2; vres->v_com = c; @@ -693,6 +1238,7 @@ broundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) long places, rnd; vres->v_type = v1->v_type; + vres->v_subtype = V_NOSUBTYPE; if (v1->v_type == V_MAT) { vres->v_mat = matbround(v1->v_mat, v2, v3); return; @@ -750,6 +1296,8 @@ broundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) return; } c = comalloc(); + qfree(c->real); + qfree(c->imag); c->real = q1; c->imag = q2; vres->v_com = c; @@ -774,6 +1322,7 @@ intvalue(VALUE *vp, VALUE *vres) COMPLEX *c; vres->v_type = vp->v_type; + vres->v_subtype = V_NOSUBTYPE; switch (vp->v_type) { case V_NUM: if (qisint(vp->v_num)) @@ -821,6 +1370,7 @@ fracvalue(VALUE *vp, VALUE *vres) COMPLEX *c; vres->v_type = vp->v_type; + vres->v_subtype = V_NOSUBTYPE; switch (vp->v_type) { case V_NUM: if (qisint(vp->v_num)) @@ -870,21 +1420,28 @@ incvalue(VALUE *vp, VALUE *vres) switch (vp->v_type) { case V_NUM: vres->v_num = qinc(vp->v_num); - return; + break; case V_COM: vres->v_com = caddq(vp->v_com, &_qone_); - return; + break; case V_OBJ: *vres = objcall(OBJ_INC, vp, NULL_VALUE, NULL_VALUE); - return; + break; + case V_OCTET: + *vres->v_octet = *vp->v_octet + 1; + break; + case V_OPTR: + vres->v_octet = vp->v_octet + 1; + break; + case V_VPTR: + vres->v_addr = vp->v_addr + 1; + break; default: - if (vp->v_type < 0) { - copyvalue(vp, vres); - return; - } - *vres = error_value(E_INCV); - return; + if (vp->v_type >= 0) + *vres = error_value(E_INCV); + break; } + vres->v_subtype = vp->v_subtype; } @@ -899,21 +1456,28 @@ decvalue(VALUE *vp, VALUE *vres) switch (vp->v_type) { case V_NUM: vres->v_num = qdec(vp->v_num); - return; + break; case V_COM: vres->v_com = caddq(vp->v_com, &_qnegone_); - return; + break; case V_OBJ: *vres = objcall(OBJ_DEC, vp, NULL_VALUE, NULL_VALUE); - return; + break; + case V_OCTET: + *vres->v_octet = *vp->v_octet - 1; + break; + case V_OPTR: + vres->v_octet = vp->v_octet - 1; + break; + case V_VPTR: + vres->v_addr = vp->v_addr - 1; + break; default: - if (vp->v_type < 0) { - copyvalue(vp, vres); - return; - } - *vres = error_value(E_DECV); - return; + if (vp->v_type >= 0) + *vres = error_value(E_DECV); + break; } + vres->v_subtype = vp->v_subtype; } @@ -926,12 +1490,15 @@ void conjvalue(VALUE *vp, VALUE *vres) { vres->v_type = vp->v_type; + vres->v_subtype = V_NOSUBTYPE; switch (vp->v_type) { case V_NUM: vres->v_num = qlink(vp->v_num); return; case V_COM: vres->v_com = comalloc(); + qfree(vres->v_com->real); + qfree(vres->v_com->imag) vres->v_com->real = qlink(vp->v_com->real); vres->v_com->imag = qneg(vp->v_com->imag); return; @@ -968,6 +1535,7 @@ sqrtvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) return; } vres->v_type = v1->v_type; + vres->v_subtype = V_NOSUBTYPE; if (v1->v_type < 0) { copyvalue(v1, vres); return; @@ -998,6 +1566,7 @@ sqrtvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) } tmp = qneg(v1->v_num); c = comalloc(); + qfree(c->imag); c->imag = qsqrt(tmp, q, R); qfree(tmp); vres->v_com = c; @@ -1033,10 +1602,11 @@ void rootvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) { NUMBER *q1, *q2; - COMPLEX ctmp; + COMPLEX *ctmp; COMPLEX *c; vres->v_type = v1->v_type; + vres->v_subtype = V_NOSUBTYPE; if (v1->v_type < 0) { copyvalue(v1, vres); return; @@ -1061,10 +1631,11 @@ rootvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) vres->v_num = qroot(v1->v_num, q1, q2); return; } - ctmp.real = v1->v_num; - ctmp.imag = &_qzero_; - ctmp.links = 1; - vres->v_com = croot(&ctmp, q1, q2); + ctmp = comalloc(); + qfree(ctmp->real); + ctmp->real = v1->v_num; + vres->v_com = croot(ctmp, q1, q2); + comfree(ctmp); vres->v_type = V_COM; break; case V_COM: @@ -1099,6 +1670,7 @@ absvalue(VALUE *v1, VALUE *v2, VALUE *vres) *vres = objcall(OBJ_ABS, v1, v2, NULL_VALUE); return; } + vres->v_subtype = V_NOSUBTYPE; if (v1->v_type < 0) { copyvalue(v1, vres); return; @@ -1137,6 +1709,7 @@ normvalue(VALUE *vp, VALUE *vres) NUMBER *q1, *q2; vres->v_type = vp->v_type; + vres->v_subtype = V_NOSUBTYPE; if (vp->v_type < 0) { copyvalue(vp, vres); return; @@ -1171,7 +1744,7 @@ normvalue(VALUE *vp, VALUE *vres) * * given: * v1 value to shift - * v2 shirt amount + * v2 shift amount * rightshift TRUE if shift right instead of left * vres result */ @@ -1180,8 +1753,10 @@ shiftvalue(VALUE *v1, VALUE *v2, BOOL rightshift, VALUE *vres) { COMPLEX *c; long n = 0; + unsigned int ch; VALUE tmp; + vres->v_subtype = V_NOSUBTYPE; if (v1->v_type < 0) { copyvalue(v1, vres); return; @@ -1226,6 +1801,21 @@ shiftvalue(VALUE *v1, VALUE *v2, BOOL rightshift, VALUE *vres) case V_MAT: vres->v_mat = matshift(v1->v_mat, n); return; + case V_STR: + vres->v_str = stringshift(v1->v_str, n); + if (vres->v_str == NULL) + *vres = error_value(E_STRSHIFT); + return; + case V_OCTET: + vres->v_type = V_STR; + if (n >= 8 || n <= -8) + ch = 0; + else if (n >= 0) + ch = (unsigned int) *v1->v_octet << n; + else + ch = (unsigned int) *v1->v_octet >> -n; + vres->v_str = charstring(ch); + return; case V_OBJ: if (!rightshift) { *vres = objcall(OBJ_SHIFT, v1, v2, NULL_VALUE); @@ -1252,6 +1842,7 @@ scalevalue(VALUE *v1, VALUE *v2, VALUE *vres) { long n = 0; + vres->v_subtype = V_NOSUBTYPE; if (v1->v_type < 0) { copyvalue(v1, vres); return; @@ -1298,12 +1889,16 @@ powivalue(VALUE *v1, VALUE *v2, VALUE *vres) NUMBER *q; COMPLEX *c; - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) { + *vres = objcall(OBJ_POW, v1, v2, NULL_VALUE); return; } + vres->v_type = v1->v_type; + vres->v_subtype = V_NOSUBTYPE; + if (v1->v_type < 0 && v1->v_type != -E_1OVER0) + return; if (v2->v_type < 0) { - copyvalue(v2, vres); + vres->v_type = v2->v_type; return; } if (v2->v_type != V_NUM || qisfrac(v2->v_num)) { @@ -1311,9 +1906,21 @@ powivalue(VALUE *v1, VALUE *v2, VALUE *vres) return; } q = v2->v_num; - vres->v_type = v1->v_type; + if (v1->v_type == -E_1OVER0) { + if (qisneg(q)) { + vres->v_type = V_NUM; + vres->v_num = qlink(&_qzero_); + } + return; + } switch (v1->v_type) { case V_NUM: + if (qiszero(v1->v_num)) { + if (qisneg(q)) { + *vres = error_value(E_1OVER0); + return; + } + } vres->v_num = qpowi(v1->v_num, q); return; case V_COM: @@ -1328,9 +1935,6 @@ powivalue(VALUE *v1, VALUE *v2, VALUE *vres) case V_MAT: vres->v_mat = matpowi(v1->v_mat, q); return; - case V_OBJ: - *vres = objcall(OBJ_POW, v1, v2, NULL_VALUE); - return; default: *vres = error_value(E_POWI); return; @@ -1348,6 +1952,7 @@ powervalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) NUMBER *epsilon; COMPLEX *c, ctmp; + vres->v_subtype = V_NOSUBTYPE; if (v1->v_type < 0) { copyvalue(v1, vres); return; @@ -1412,14 +2017,20 @@ divvalue(VALUE *v1, VALUE *v2, VALUE *vres) { COMPLEX *c; COMPLEX ctmp; + NUMBER *q; VALUE tmpval; - if (v1->v_type < 0) { - copyvalue(v1, vres); + vres->v_type = v1->v_type; + vres->v_subtype = V_NOSUBTYPE; + if (v1->v_type < 0) return; - } if (v2->v_type < 0) { - copyvalue(v2, vres); + if (testvalue(v1) && v2->v_type == -E_1OVER0) { + vres->v_type = V_NUM; + vres->v_num = qlink(&_qzero_); + } + else + vres->v_type = v2->v_type; return; } if (!testvalue(v2)) { @@ -1432,7 +2043,7 @@ divvalue(VALUE *v1, VALUE *v2, VALUE *vres) vres->v_type = v1->v_type; switch (TWOVAL(v1->v_type, v2->v_type)) { case TWOVAL(V_NUM, V_NUM): - vres->v_num = qdiv(v1->v_num, v2->v_num); + vres->v_num = qqdiv(v1->v_num, v2->v_num); return; case TWOVAL(V_COM, V_NUM): vres->v_com = cdivq(v1->v_com, v2->v_num); @@ -1463,6 +2074,13 @@ divvalue(VALUE *v1, VALUE *v2, VALUE *vres) vres->v_mat = matmulval(v1->v_mat, &tmpval); freevalue(&tmpval); return; + case TWOVAL(V_STR, V_NUM): + q = qinv(v2->v_num); + vres->v_str = stringmul(q, v1->v_str); + qfree(q); + if (vres->v_str == NULL) + *vres = error_value(E_DIV); + return; default: if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) { *vres = error_value(E_DIV); @@ -1486,6 +2104,7 @@ quovalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) long rnd; vres->v_type = v1->v_type; + vres->v_subtype = V_NOSUBTYPE; if (v1->v_type < 0) { copyvalue(v1, vres); return; @@ -1540,6 +2159,8 @@ quovalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) return; } c = comalloc(); + qfree(c->real); + qfree(c->imag); c->real = q1; c->imag = q2; vres->v_com = c; @@ -1562,6 +2183,7 @@ modvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) NUMBER *q1, *q2; long rnd; + vres->v_subtype = V_NOSUBTYPE; if (v1->v_type < 0) { copyvalue(v1, vres); return; @@ -1617,6 +2239,8 @@ modvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) return; } c = comalloc(); + qfree(c->real); + qfree(c->imag); c->real = q1; c->imag = q2; vres->v_com = c; @@ -1638,6 +2262,8 @@ BOOL testvalue(VALUE *vp) { VALUE val; + LISTELEM *ep; + int i; switch (vp->v_type) { case V_NUM: @@ -1645,11 +2271,15 @@ testvalue(VALUE *vp) case V_COM: return !ciszero(vp->v_com); case V_STR: - return (vp->v_str[0] != '\0'); + return stringtest(vp->v_str); case V_MAT: return mattest(vp->v_mat); case V_LIST: - return (vp->v_list->l_count != 0); + for (ep = vp->v_list->l_first; ep; ep = ep->e_next) { + if (testvalue(&ep->e_value)) + return TRUE; + } + return FALSE; case V_ASSOC: return (vp->v_assoc->a_count != 0); case V_FILE: @@ -1659,9 +2289,26 @@ testvalue(VALUE *vp) case V_OBJ: val = objcall(OBJ_TEST, vp, NULL_VALUE, NULL_VALUE); return (val.v_int != 0); + case V_BLOCK: + for (i=0; i < vp->v_block->datalen; ++i) { + if (vp->v_block->data[i]) { + return TRUE; + } + } + return FALSE; + case V_OCTET: + return (*vp->v_octet != 0); + case V_NBLOCK: + if (vp->v_nblock->blk->data == NULL) + return FALSE; + for (i=0; i < vp->v_nblock->blk->datalen; ++i) { + if (vp->v_nblock->blk->data[i]) { + return TRUE; + } + } + return FALSE; default: - math_error("Testing improper type"); - /*NOTREACHED*/ + return TRUE; } /* hack to get gcc on SunOS to be quiet */ return FALSE; @@ -1684,6 +2331,19 @@ comparevalue(VALUE *v1, VALUE *v2) } if (v1 == v2) return FALSE; + if (v1->v_type == V_OCTET) { + if (v2->v_type == V_OCTET) + return (*v1->v_octet != *v2->v_octet); + if (v2->v_type == V_STR) + return (*v1->v_octet != (OCTET) *v2->v_str->s_str) + || (v2->v_str->s_len != 1); + if (v2->v_type != V_NUM || qisfrac(v2->v_num) || + qisneg(v2->v_num) || v2->v_num->num.len > 1) + return TRUE; + return (*v2->v_num->num.v != *v1->v_octet); + } + if (v2->v_type == V_OCTET) + return comparevalue(v2, v1); if (v1->v_type != v2->v_type) return TRUE; if (v1->v_type < 0) @@ -1696,9 +2356,7 @@ comparevalue(VALUE *v1, VALUE *v2) r = ccmp(v1->v_com, v2->v_com); break; case V_STR: - r = ((v1->v_str != v2->v_str) && - ((v1->v_str[0] - v2->v_str[0]) || - strcmp(v1->v_str, v2->v_str))); + r = stringcmp(v1->v_str, v2->v_str); break; case V_MAT: r = matcmp(v1->v_mat, v2->v_mat); @@ -1723,11 +2381,25 @@ comparevalue(VALUE *v1, VALUE *v2) case V_CONFIG: r = config_cmp(v1->v_config, v2->v_config); break; -#if 0 /* XXX - write */ case V_HASH: r = hash_cmp(v1->v_hash, v2->v_hash); break; -#endif + case V_BLOCK: + r = blk_cmp(v1->v_block, v2->v_block); + break; + case V_OCTET: + r = (v1->v_octet != v2->v_octet); + break; + case V_NBLOCK: + return (v1->v_nblock != v2->v_nblock); + case V_VPTR: + return (v1->v_addr != v2->v_addr); + case V_OPTR: + return (v1->v_octet != v2->v_octet); + case V_SPTR: + return (v1->v_str != v2->v_str); + case V_NPTR: + return (v1->v_num != v2->v_num); default: math_error("Illegal values for comparevalue"); /*NOTREACHED*/ @@ -1735,6 +2407,30 @@ comparevalue(VALUE *v1, VALUE *v2) return (r != 0); } +BOOL +acceptvalue(VALUE *v1, VALUE *v2) +{ + long index; + FUNC *fp; + BOOL ret; + + index = adduserfunc("accept"); + fp = findfunc(index); + if (fp) { + ++stack; + stack->v_type = V_ADDR; + stack->v_addr = v1; + ++stack; + stack->v_type = V_ADDR; + stack->v_addr = v2; + calculate(fp, 2); + ret = testvalue(stack); + freevalue(stack--); + return ret; + } + return (!comparevalue(v1, v2)); +} + BOOL precvalue(VALUE *v1, VALUE *v2) @@ -1743,6 +2439,7 @@ precvalue(VALUE *v1, VALUE *v2) long index; int r = 0; FUNC *fp; + BOOL ret; index = adduserfunc("precedes"); fp = findfunc(index); @@ -1754,12 +2451,9 @@ precvalue(VALUE *v1, VALUE *v2) stack->v_type = V_ADDR; stack->v_addr = v2; calculate(fp, 2); - val = *stack--; - if (val.v_type != V_NUM) { - math_error("Non-numeric value for precvalue()"); - /*NOTREACHED*/ - } - return (qtoi(val.v_num) ? TRUE : FALSE); + ret = testvalue(stack); + freevalue(stack--); + return ret; } relvalue(v1, v2, &val); if ((val.v_type == V_NUM && qisneg(val.v_num)) || @@ -1772,6 +2466,23 @@ precvalue(VALUE *v1, VALUE *v2) } +VALUE +signval(int r) +{ + VALUE val; + + val.v_type = V_NUM; + val.v_subtype = V_NOSUBTYPE; + if (r > 0) + val.v_num = qlink(&_qone_); + else if (r < 0) + val.v_num = qlink(&_qnegone_); + else + val.v_num = qlink(&_qzero_); + return val; +} + + /* * Compare two values for their relative values. * Result is placed in the indicated location. @@ -1780,56 +2491,130 @@ void relvalue(VALUE *v1, VALUE *v2, VALUE *vres) { int r = 0; - COMPLEX ctmp, *c; + int i = 0; + NUMBER *q; + COMPLEX *c; + vres->v_subtype = V_NOSUBTYPE; + vres->v_type = V_NULL; if ((v1->v_type == V_OBJ) || (v2->v_type == V_OBJ)) { *vres = objcall(OBJ_REL, v1, v2, NULL_VALUE); return; } - switch (TWOVAL(v1->v_type, v2->v_type)) { - case TWOVAL(V_NUM, V_NUM): - r = qrel(v1->v_num, v2->v_num); - vres->v_type = V_NUM; - vres->v_num = itoq((long) r); - return; - case TWOVAL(V_STR, V_STR): - r = strcmp(v1->v_str, v2->v_str); - vres->v_type = V_NUM; - if (r < 0) { - vres->v_num = itoq((long) -1); - } else if (r > 0) { - vres->v_num = itoq((long) 1); - } else { - vres->v_num = itoq((long) 0); + switch(v1->v_type) { + case V_NUM: + switch(v2->v_type) { + case V_NUM: + r = qrel(v1->v_num, v2->v_num); + break; + case V_OCTET: + q = itoq((long) *v2->v_octet); + r = qrel(v1->v_num, q); + qfree(q); + break; + case V_COM: + r = qrel(v1->v_num, v2->v_com->real); + i = qrel(&_qzero_, v2->v_com->imag); + break; + default: + return; } - return; - case TWOVAL(V_COM, V_COM): - c = crel(v1->v_com, v2->v_com); break; - case TWOVAL(V_COM, V_NUM): - ctmp.real = v2->v_num; - ctmp.imag = &_qzero_; - ctmp.links = 1; - c = crel(v1->v_com, &ctmp); + case V_COM: + switch(v2->v_type) { + case V_NUM: + r = qrel(v1->v_com->real, v2->v_num); + i = qrel(v1->v_com->imag, &_qzero_); + break; + case V_COM: + r = qrel(v1->v_com->real, v2->v_com->real); + i = qrel(v1->v_com->imag, v2->v_com->imag); + break; + case V_OCTET: + q = itoq((long) *v2->v_octet); + r = qrel(v1->v_com->real, q); + qfree(q); + i = qrel(v1->v_com->imag, &_qzero_); + break; + default: + return; + } break; - case TWOVAL(V_NUM, V_COM): - ctmp.real = v1->v_num; - ctmp.imag = &_qzero_; - ctmp.links = 1; - c = crel(&ctmp, v2->v_com); + case V_STR: + switch(v2->v_type) { + case V_STR: + r = stringrel(v1->v_str, v2->v_str); + break; + case V_OCTET: + r = (unsigned char) *v1->v_str->s_str + - *v2->v_octet; + if (r == 0) { + if (v1->v_str->s_len == 0) + r = -1; + else + r = (v1->v_str->s_len > 1); + } + break; + default: + return; + } + break; + case V_OCTET: + switch(v2->v_type) { + case V_NUM: + q = itoq((long) *v1->v_octet); + r = qrel(q, v2->v_num); + qfree(q); + break; + case V_COM: + q = itoq((long) *v1->v_octet); + r = qrel(q, v2->v_com->real); + qfree(q); + i = qrel(&_qzero_, v2->v_com->imag); + break; + case V_OCTET: + r = *v1->v_octet - *v2->v_octet; + break; + case V_STR: + r = *v1->v_octet - + (unsigned char) *v2->v_str->s_str; + if (r == 0) { + if (v2->v_str->s_len == 0) + r = 1; + else + r = -(v2->v_str->s_len > 1); + } + break; + default: + return; + } + break; + case V_VPTR: + if (v2->v_type != V_VPTR) + return; + r = (v1->v_addr - v2->v_addr); + break; + case V_OPTR: + if (v2->v_type != V_OPTR) + return; + r = (v1->v_octet - v2->v_octet); break; default: - vres->v_type = V_NULL; return; } - if (cisreal(c)) { - vres->v_num = qlink(c->real); - vres->v_type = V_NUM; - comfree(c); + vres->v_type = V_NUM; + *vres = signval(r); + if (i == 0) return; - } - vres->v_com = c; + c = comalloc(); + qfree(c->real); + c->real = vres->v_num; + *vres = signval(i); + qfree(c->imag); + c->imag = vres->v_num; vres->v_type = V_COM; + vres->v_com = c; + return; } @@ -1849,11 +2634,17 @@ sgnvalue(VALUE *vp, VALUE *vres) return; case V_COM: c = comalloc(); + qfree(c->real); + qfree(c->imag); c->real = qsign(vp->v_com->real); c->imag = qsign(vp->v_com->imag); vres->v_com = c; vres->v_type = V_COM; return; + case V_OCTET: + vres->v_type = V_NUM; + vres->v_num = itoq((long) (*vp->v_octet != 0)); + return; case V_OBJ: *vres = objcall(OBJ_SGN, vp, NULL_VALUE, NULL_VALUE); return; @@ -1868,6 +2659,24 @@ sgnvalue(VALUE *vp, VALUE *vres) } +int +userfunc(char *fname, VALUE *vp) +{ + FUNC *fp; + + fp = findfunc(adduserfunc(fname)); + if (fp == NULL) + return 0; + ++stack; + stack->v_addr = vp; + stack->v_type = V_ADDR; + stack->v_subtype = V_NOSUBTYPE; + calculate(fp, 1); + freevalue(stack--); + return 1; +} + + /* * Print the value of a descriptor in one of several formats. * If flags contains PRINT_SHORT, then elements of arrays and lists @@ -1877,11 +2686,14 @@ sgnvalue(VALUE *vp, VALUE *vres) void printvalue(VALUE *vp, int flags) { + NUMBER *qtemp; int type; type = vp->v_type; if (type < 0) { - if (-type > E__BASE) + if (userfunc("error_print", vp)) + return; + if (-type >= sys_nerr) printf("Error %d", -type); else printf("System error %d", -type); @@ -1901,7 +2713,7 @@ printvalue(VALUE *vp, int flags) case V_STR: if (flags & PRINT_UNAMBIG) math_chr('\"'); - math_str(vp->v_str); + math_str(vp->v_str->s_str); if (flags & PRINT_UNAMBIG) math_chr('\"'); break; @@ -1913,7 +2725,8 @@ printvalue(VALUE *vp, int flags) (void) objcall(OBJ_PRINT, vp, NULL_VALUE, NULL_VALUE); break; case V_LIST: - listprint(vp->v_list, + if (!userfunc("list_print", vp)) + listprint(vp->v_list, ((flags & PRINT_SHORT) ? 0L : conf->maxprint)); break; case V_ASSOC: @@ -1921,11 +2734,13 @@ printvalue(VALUE *vp, int flags) ((flags & PRINT_SHORT) ? 0L : conf->maxprint)); break; case V_MAT: - matprint(vp->v_mat, + if (!userfunc("mat_print", vp)) + matprint(vp->v_mat, ((flags & PRINT_SHORT) ? 0L : conf->maxprint)); break; case V_FILE: - printid(vp->v_file, flags); + if (!userfunc("file_print", vp)) + printid(vp->v_file, flags); break; case V_RAND: randprint(vp->v_rand, flags); @@ -1936,13 +2751,38 @@ printvalue(VALUE *vp, int flags) case V_CONFIG: config_print(vp->v_config); break; -#if 0 /* XXX - write */ case V_HASH: hash_print(vp->v_hash); break; -#endif + case V_BLOCK: + if (!userfunc("blk_print", vp)) + blk_print(vp->v_block); + break; + case V_OCTET: + if (userfunc("octet_print", vp)) + break; + qtemp = itoq((long) *vp->v_octet); + qprintnum(qtemp, MODE_DEFAULT); + qfree(qtemp); + break; + case V_OPTR: + printf("o-ptr: %p", vp->v_octet); + break; + case V_VPTR: + printf("v-ptr: %p", vp->v_addr); + break; + case V_SPTR: + printf("s_ptr: %p", vp->v_str); + break; + case V_NPTR: + printf("n_ptr: %p", vp->v_num); + break; + case V_NBLOCK: + if (!userfunc("nblk_print", vp)) + nblock_print(vp->v_nblock); + break; default: - math_error("Printing unknown value"); + math_error("Printing unrecognized type of value"); /*NOTREACHED*/ } } @@ -1977,8 +2817,8 @@ config_print(CONFIG *cfg) tab_over = FALSE; for (cp = configs; cp->name; cp++) { - /* skip if special all value */ - if (cp->type == CONFIG_ALL) + /* skip if special all or duplicate maxerr value */ + if (cp->type == CONFIG_ALL || strcmp(cp->name, "maxerr") == 0) continue; /* print tab if allowed */ @@ -2002,5 +2842,3 @@ config_print(CONFIG *cfg) printf("\n"); } } - -/* END CODE */ diff --git a/value.h b/value.h index 978e0e7..a050a0d 100644 --- a/value.h +++ b/value.h @@ -1,19 +1,24 @@ /* - * 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. * * Definitions of general values and related routines used by the calculator. */ -#ifndef VALUE_H -#define VALUE_H + +#if !defined(__VALUE_H__) +#define __VALUE_H__ + #include "cmath.h" #include "config.h" #include "shs.h" #include "calcerr.h" #include "hash.h" +#include "block.h" +#include "nametype.h" +#include "string.h" #define MAXDIM 4 /* maximum number of dimensions in matrices */ #define USUAL_ELEMENTS 4 /* usual number of elements for objects */ @@ -39,7 +44,6 @@ typedef struct assoc ASSOC; typedef long FILEID; typedef struct rand RAND; typedef struct random RANDOM; -typedef struct block BLOCK; /* @@ -52,10 +56,10 @@ struct value { short v_subtype; /* other data related to some types */ union { /* types of values (see V_XYZ below) */ long vv_int; /* 1: small integer value */ - NUMBER *vv_num; /* 2: arbitrary sized numeric value */ + NUMBER *vv_num; /* 2, 21: real number */ COMPLEX *vv_com; /* 3: complex number */ - VALUE *vv_addr; /* 4: address of variable value */ - char *vv_str; /* 5: string value */ + VALUE *vv_addr; /* 4, 18: address of variable value */ + STRING *vv_str; /* 5, 20: string value */ MATRIX *vv_mat; /* 6: address of matrix */ LIST *vv_list; /* 7: address of list */ ASSOC *vv_assoc; /* 8: address of association */ @@ -66,6 +70,8 @@ struct value { CONFIG *vv_config; /* 13: configuration state */ HASH *vv_hash; /* 14: hash state */ BLOCK *vv_block; /* 15: memory block */ + OCTET *vv_octet; /* 16, 19: octet addr (unsigned char) */ + NBLOCK *vv_nblock; /* 17: named memory block */ } v_union; }; @@ -89,6 +95,8 @@ struct value { #define v_config v_union.vv_config #define v_hash v_union.vv_hash #define v_block v_union.vv_block +#define v_octet v_union.vv_octet +#define v_nblock v_union.vv_nblock /* @@ -96,9 +104,13 @@ struct value { * * NOTE: The following files should be checked/adjusted for a new type: * - * quickhash.c - * shs.c - * value.c + * size.c - elm_count(), lsizeof() + * help/size - update what the size() builtin will report + * hash.c - hash_value() + * quickhash.c - hashvalue() + * value.c - freevalue(), copyvalue(), comparevalue(), + * printvalue(), + * and other as needed such as testvalue(), etc. * * There may be others, but at is at least a start. */ @@ -118,13 +130,35 @@ struct value { #define V_CONFIG 13 /* configuration state */ #define V_HASH 14 /* hash state */ #define V_BLOCK 15 /* memory block */ -#define V_MAX 15 /* highest legal value */ +#define V_OCTET 16 /* octet (unsigned char) */ +#define V_NBLOCK 17 /* named memory block */ +#define V_VPTR 18 /* value address as pointer */ +#define V_OPTR 19 /* octet address as pointer */ +#define V_SPTR 20 /* string address as pointer */ +#define V_NPTR 21 /* number address as pointer */ +#define V_MAX 21 /* highest legal value */ -#define V_NOSUBTYPE 0 /* subtype has no meaning */ -#define V_STRLITERAL 1 /* string subtype for literal str */ -#define V_STRALLOC 2 /* string subtype for allocated str */ +#define V_NOSUBTYPE 0 /* subtype has no meaning */ +#define V_NOASSIGNTO 1 /* protection status 1 */ +#define V_NONEWVALUE 2 /* protection status 2 */ +#define V_NONEWTYPE 4 /* protection status 4 */ +#define V_NOERROR 8 /* protection status 8 */ +#define V_NOCOPYTO 16 /* protection status 16 */ +#define V_NOREALLOC 32 /* protection status 32 */ +#define V_NOASSIGNFROM 64 /* protection status 64 */ +#define V_NOCOPYFROM 128 /* protection status 128 */ +#define V_PROTECTALL 256 /* protection status 256 */ -#define TWOVAL(a,b) ((a) << 4 | (b)) /* for switch of two values */ +#define MAXPROTECT 511 + +/* + * At present protect(var, sts) determines bits in var->v_subtype + * corresponding to 4 * sts. MAXPROTECT is the sum of the simple + * (power of two) protection status values. + */ + + +#define TWOVAL(a,b) ((a) << 5 | (b)) /* for switch of two values */ #define NULL_VALUE ((VALUE *) 0) @@ -139,10 +173,18 @@ extern void addvalue(VALUE *v1, VALUE *v2, VALUE *vres); extern void addnumeric(VALUE *v1, VALUE *v2, VALUE *vres); extern void subvalue(VALUE *v1, VALUE *v2, VALUE *vres); extern void mulvalue(VALUE *v1, VALUE *v2, VALUE *vres); +extern void orvalue(VALUE *v1, VALUE *v2, VALUE *vres); +extern void andvalue(VALUE *v1, VALUE *v2, VALUE *vres); +extern void compvalue(VALUE *vp, VALUE *vres); +extern void xorvalue(VALUE *v1, VALUE *v2, VALUE *vres); extern void squarevalue(VALUE *vp, VALUE *vres); extern void invertvalue(VALUE *vp, VALUE *vres); extern void roundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres); extern void broundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres); +extern void setminusvalue(VALUE *, VALUE *, VALUE *); +extern void backslashvalue(VALUE *, VALUE *); +extern void contentvalue(VALUE *, VALUE *); +extern void hashopvalue(VALUE *, VALUE *, VALUE *); extern void apprvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres); extern void intvalue(VALUE *vp, VALUE *vres); extern void fracvalue(VALUE *vp, VALUE *vres); @@ -162,16 +204,23 @@ extern void quovalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres); extern void modvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres); extern BOOL testvalue(VALUE *vp); extern BOOL comparevalue(VALUE *v1, VALUE *v2); +extern BOOL acceptvalue(VALUE *v1, VALUE *v2); extern void relvalue(VALUE *v1, VALUE *v2, VALUE *vres); extern void sgnvalue(VALUE *vp, VALUE *vres); extern QCKHASH hashvalue(VALUE *vp, QCKHASH val); extern void printvalue(VALUE *vp, int flags); extern BOOL precvalue(VALUE *v1, VALUE *v2); extern VALUE error_value(int e); +extern int set_errno(int e); +extern int set_errcount(int e); +extern int set_errmax(int e); extern long countlistitems(LIST *lp); extern void addlistitems(LIST *lp, VALUE *vres); extern void addlistinv(LIST *lp, VALUE *vres); - +extern void copy2octet(VALUE *, OCTET *); +extern int copystod(VALUE *, long, long, VALUE *, long); +extern void protectall(VALUE *, int); +extern void set_update(int); /* @@ -207,13 +256,14 @@ extern MATRIX *matmodval(MATRIX *m, VALUE *vp, VALUE *v3); extern MATRIX *matint(MATRIX *m); extern MATRIX *matfrac(MATRIX *m); extern MATRIX *matappr(MATRIX *m, VALUE *v2, VALUE *v3); +extern VALUE mattrace(MATRIX *m); extern MATRIX *mattrans(MATRIX *m); extern MATRIX *matcross(MATRIX *m1, MATRIX *m2); extern BOOL mattest(MATRIX *m); extern void matsum(MATRIX *m, VALUE *vres); extern BOOL matcmp(MATRIX *m1, MATRIX *m2); -extern long matsearch(MATRIX *m, VALUE *vp, long index); -extern long matrsearch(MATRIX *m, VALUE *vp, long index); +extern int matsearch(MATRIX *m, VALUE *vp, long start, long end, ZVALUE *index); +extern int matrsearch(MATRIX *m, VALUE *vp, long start, long end, ZVALUE *index); extern VALUE matdet(MATRIX *m); extern VALUE matdot(MATRIX *m1, MATRIX *m2); extern void matfill(MATRIX *m, VALUE *v1, VALUE *v2); @@ -227,7 +277,6 @@ extern MATRIX *matround(MATRIX *m, VALUE *v2, VALUE *v3); extern MATRIX *matbround(MATRIX *m, VALUE *v2, VALUE *v3); - /* * List definitions. * An individual list element. @@ -260,8 +309,8 @@ extern void removelistlast(LIST *lp, VALUE *vp); extern void removelistmiddle(LIST *lp, long index, VALUE *vp); extern void listfree(LIST *lp); extern void listprint(LIST *lp, long max_print); -extern long listsearch(LIST *lp, VALUE *vp, long index); -extern long listrsearch(LIST *lp, VALUE *vp, long index); +extern int listsearch(LIST *lp, VALUE *vp, long start, long end, ZVALUE *index); +extern int listrsearch(LIST *lp, VALUE *vp, long start, long end, ZVALUE *index); extern BOOL listcmp(LIST *lp1, LIST *lp2); extern VALUE *listfindex(LIST *lp, long index); extern LIST *listalloc(void); @@ -276,6 +325,8 @@ extern LIST *listmod(LIST *lp, VALUE *v2, VALUE *v3); extern BOOL evp(LISTELEM *cp, LISTELEM *x, VALUE *vres); extern BOOL evalpoly(LIST *clist, LISTELEM *x, VALUE *vres); extern void insertitems(LIST *lp1, LIST *lp2); +extern LISTELEM *listelement(LIST *, long); +extern LIST *listsegment(LIST *, long, long); /* @@ -304,8 +355,8 @@ extern ASSOC *assocalloc(long initsize); extern ASSOC *assoccopy(ASSOC *ap); extern void assocfree(ASSOC *ap); extern void assocprint(ASSOC *ap, long max_print); -extern long assocsearch(ASSOC *ap, VALUE *vp, long index); -extern long assocrsearch(ASSOC *ap, VALUE *vp, long index); +extern int assocsearch(ASSOC *ap, VALUE *vp, long start, long end, ZVALUE *index); +extern int assocrsearch(ASSOC *ap, VALUE *vp, long start, long end, ZVALUE *index); extern BOOL assoccmp(ASSOC *ap1, ASSOC *ap2); extern VALUE *assocfindex(ASSOC *ap, long index); extern VALUE *associndex(ASSOC *ap, BOOL create, long dim, VALUE *indices); @@ -343,7 +394,22 @@ extern VALUE *associndex(ASSOC *ap, BOOL create, long dim, VALUE *indices); #define OBJ_BROUND 26 /* round to specified binary places */ #define OBJ_ROOT 27 /* take nth root of value */ #define OBJ_SQRT 28 /* take square root of value */ -#define OBJ_MAXFUNC 28 /* highest function */ +#define OBJ_OR 29 /* take bitwise or of values */ +#define OBJ_AND 30 /* take bitwise and of values */ +#define OBJ_NOT 31 /* take logical not of value */ +#define OBJ_FACT 32 /* factorial or postfix ! */ +#define OBJ_MIN 33 /* minimum value */ +#define OBJ_MAX 34 /* maximum value */ +#define OBJ_SUM 35 /* sum value */ +#define OBJ_ASSIGN 36 /* assign value */ +#define OBJ_XOR 37 /* ~ difference of values */ +#define OBJ_COMP 38 /* ~ complement of value */ +#define OBJ_CONTENT 39 /* unary hash op */ +#define OBJ_HASHOP 40 /* binary hash op */ +#define OBJ_BACKSLASH 41 /* unary backslash op */ +#define OBJ_SETMINUS 42 /* binary backslash op */ +#define OBJ_PLUS 43 /* unary + op */ +#define OBJ_MAXFUNC 43 /* highest function */ /* @@ -392,10 +458,6 @@ extern int objoffset(OBJECT *op, long index); /* * Configuration parameter name and type. */ -typedef struct { - char *name; /* name of configuration string */ - int type; /* type for configuration */ -} NAMETYPE; extern NAMETYPE configs[]; extern void config_value(CONFIG *cfg, int type, VALUE *ret); extern void setconfig(int type, VALUE *vp); @@ -403,53 +465,38 @@ extern void config_print(CONFIG *cfg); /* the CONFIG to print */ /* - * hashfunc - interface for hashing hash objects + * size, memsize and sizeof support */ -struct hashfunc { - int type; /* hash type (see XYZ_HASH_TYPE below) */ - HASH *(*init)(HASH*); /* initialize hash state */ - HASH *(*longval)(HASH*, long); /* hash a long value */ - HASH *(*str)(HASH*, char*); /* hash a string */ -#if defined(FUNCT_DECL_BUG) - HASH *(*value)(HASH*, void*); /* hash a VALUE */ - HASH *(*complex)(HASH*, void*); /* hash a COMPLEX* */ - HASH *(*number)(HASH*, void*); /* hash a NUMBER* */ - HASH *(*zvalue)(HASH*, void); /* hash a ZVALUE */ -#else - HASH *(*value)(HASH*, VALUE*); /* hash a VALUE */ - HASH *(*complex)(HASH*, COMPLEX*); /* hash a COMPLEX* */ - HASH *(*number)(HASH*, NUMBER*); /* hash a NUMBER* */ - HASH *(*zvalue)(HASH*, ZVALUE); /* hash a ZVALUE */ -#endif - ZVALUE (*final)(HASH *); /* complete hash state and return a ZVALUE */ -}; -typedef struct hashfunc HASHFUNC; - -/* external HASHFUNC functions */ -extern void shs_hashfunc(HASHFUNC *); - +extern long elm_count(VALUE *vp); +extern long lsizeof(VALUE *vp); +extern long memsize(VALUE *vp); /* - * block - dynamic of fixed memory block - * - * There are two types of memory blocks: fixed memory blocks are fixed - * in size and dynamic memory blocks can grow in size. The max length - * (x.max) may be >= current (x.len), even in the fixed case. A fixed block - * can be shrunk instead of realloced. The (x.max) refers to the number - * of bytes malloced and 0 <= (x.len) <= (x.max). If (x.max) == 0, then - * (x.data) does not point to malloced storage. + * String functions */ -struct block { - int type; /* block type */ - int len; /* current block length in USB8's */ - int max; /* malloced block length in USB8's */ - USB8 *data; /* start of data block if max > 0 */ -}; +extern STRING *stringadd(STRING *, STRING *); +extern STRING *stringcopy(STRING *); +extern STRING *stringsub(STRING *, STRING *); +extern STRING *stringmul(NUMBER *, STRING *); +extern STRING *stringand(STRING *, STRING *); +extern STRING *stringor(STRING *, STRING *); +extern STRING *stringxor(STRING *, STRING *); +extern STRING *stringdiff(STRING *, STRING *); +extern STRING *stringsegment(STRING *, long, long); +extern STRING *stringshift(STRING *, long); +extern STRING *stringcomp(STRING *); +extern STRING *stringneg(STRING *); +extern STRING *stringcpy(STRING *, STRING *); +extern STRING *stringncpy(STRING *, STRING *, long); +extern long stringcontent(STRING *s); +extern long stringlowbit(STRING *s); +extern long stringhighbit(STRING *s); +extern BOOL stringcmp(STRING *, STRING *); +extern BOOL stringrel(STRING *, STRING *); +extern int stringbit(STRING *, long); +extern BOOL stringtest(STRING *); +extern int stringsetbit(STRING *, long, BOOL); +extern int stringsearch(STRING *, STRING *, long, long, ZVALUE *); +extern int stringrsearch(STRING *, STRING *, long, long, ZVALUE *); -#define V_FIXEDBLOCK 1 /* memory block is fixed in size */ -#define V_DYNAMBLOCK 2 /* memory block size is dynamic */ - -#define is_fixedblock(x) (((x)->type) == V_FIXEDBLOCK) -#define is_dynamblock(x) (((x)->type) == V_DYNAMBLOCK) - -#endif +#endif /* !__VALUE_H__ */ diff --git a/version.c b/version.c index 7067150..2567337 100644 --- a/version.c +++ b/version.c @@ -1,25 +1,86 @@ /* - * Copyright (c) 1996 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. * * version - determine the version of calc */ +#include #include "calc.h" #define MAJOR_VER 2 /* major version */ #define MINOR_VER 10 /* minor version */ -#define PATCH_LEVEL 2 /* patch level */ -#define SUB_PATCH_LEVEL "t30" /* test number or empty string */ +#define MAJOR_PATCH 3 /* patch level or 0 if no patch */ +#define MINOR_PATCH "t5.45" /* test number or empty string if no patch */ + +/* + * calc version constants + */ +int calc_major_ver = MAJOR_VER; +int calc_minor_ver = MINOR_VER; +int calc_major_patch = MAJOR_PATCH; +char *calc_minor_patch = MINOR_PATCH; -void -version(FILE *stream) +/* + * stored version + */ +static char *stored_version = NULL; /* version formed if != NULL */ + + +/* + * version - return version string + * + * This function returns a malloced version string. This version + * string does not contain the title, just: + * + * x.y.ztsomething + * x.y.z + * x.y + */ +char * +version(void) { - fprintf(stream, - "C-style arbitrary precision calculator (version %d.%d.%d%s)\n", - MAJOR_VER, MINOR_VER, PATCH_LEVEL, SUB_PATCH_LEVEL); + char verbuf[BUFSIZ+1]; /* form version string here */ + + /* + * return previously stored version if one exists + */ + if (stored_version) { + return stored_version; + } + + /* + * form the version buffer + */ + if (sizeof(MINOR_PATCH) > 1) { + sprintf(verbuf, + "%d.%d.%d%s", calc_major_ver, calc_minor_ver, + calc_major_patch, calc_minor_patch); + } else if (MAJOR_PATCH > 0) { + sprintf(verbuf, + "%d.%d.%s", calc_major_ver, calc_minor_ver, calc_minor_patch); + } else { + sprintf(verbuf, "%d.%d", calc_major_ver, calc_minor_ver); + } + + /* + * same the versions string into a newly malloced buffer + */ + stored_version = (char *)malloc(strlen(verbuf)+1); + if (stored_version == NULL) { + fprintf(stderr, "%s: version formation value\n", program); + exit(2); + } + strcpy(stored_version, verbuf); + + /* + * return the newly malloced buffer + */ + return stored_version; } + + /* END CODE */ diff --git a/zfunc.c b/zfunc.c index 2fb071a..776f2ef 100644 --- a/zfunc.c +++ b/zfunc.c @@ -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. * @@ -43,13 +43,14 @@ zfact(ZVALUE z, ZVALUE *dest) for (; n > 1; n--) { for (m = n; ((m & 0x1) == 0); m >>= 1) ptwo++; - mul *= m; - if (mul < BASE1/2) + if (mul <= MAXLONG/m) { + mul *= m; continue; + } zmuli(res, mul, &temp); zfree(res); res = temp; - mul = 1; + mul = m; } /* * Multiply by the remaining value, then scale result by @@ -456,7 +457,7 @@ ztenpow(long power, ZVALUE *res) BOOL zmodinv(ZVALUE u, ZVALUE v, ZVALUE *res) { - FULL q1, q2, ui3, vi3, uh, vh, A, B, C, D, T; + FULL q1, q2, ui3, vi3, uh, vh, A, B, C, D, T; ZVALUE u2, u3, v2, v3, qz, tmp1, tmp2, tmp3; v.sign = 0; @@ -470,15 +471,21 @@ zmodinv(ZVALUE u, ZVALUE v, ZVALUE *res) /* * Loop here while the size of the numbers remain above - * the size of a FULL. Throughout this loop u3 >= v3. + * the size of a HALF. Throughout this loop u3 >= v3. */ while ((u3.len > 1) && !ziszero(v3)) { - uh = (((FULL) u3.v[u3.len - 1]) << BASEB) + u3.v[u3.len - 2]; vh = 0; - if ((v3.len + 1) >= u3.len) - vh = v3.v[v3.len - 1]; +#if LONG_BITS == BASEB + uh = u3.v[u3.len - 1]; if (v3.len == u3.len) - vh = (vh << BASEB) + v3.v[v3.len - 2]; + vh = v3.v[v3.len - 1]; +#else + uh = (((FULL) u3.v[u3.len - 1]) << BASEB) + u3.v[u3.len - 2]; + if ((v3.len + 1) >= u3.len) + vh = v3.v[v3.len - 1]; + if (v3.len == u3.len) + vh = (vh << BASEB) + v3.v[v3.len - 2]; +#endif A = 1; B = 0; C = 0; diff --git a/zio.c b/zio.c index 59d379b..e8c30d9 100644 --- a/zio.c +++ b/zio.c @@ -6,6 +6,7 @@ * Scanf and printf routines for arbitrary precision integers. */ +#include #include "config.h" #include "zmath.h" #include "args.h" @@ -710,4 +711,32 @@ str2z(char *s, ZVALUE *res) *res = z; } + +void +fitzprint(ZVALUE z, long digits, long show) +{ + ZVALUE ztmp1, ztmp2; + long i; + + if (digits <= show) { + zprintval(z, 0, 0); + return; + } + show /= 2; + ztenpow(digits - show, &ztmp1); + (void) zquo(z, ztmp1, &ztmp2, 1); + zprintval(ztmp2, 0, 0); + zfree(ztmp1); + zfree(ztmp2); + printf("..."); + ztenpow(show, &ztmp1); + (void) zmod(z, ztmp1, &ztmp2, 0); + i = zdigits(ztmp2); + while (i++ < show) + printf("0"); + zprintval(ztmp2, 0, 0); + zfree(ztmp1); + zfree(ztmp2); +} + /* END CODE */ diff --git a/zmath.c b/zmath.c index bf38039..10b7147 100644 --- a/zmath.c +++ b/zmath.c @@ -1,11 +1,12 @@ /* - * Copyright (c) 1996 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. * * Extended precision integral arithmetic primitives */ +#include #include "zmath.h" HALF _zeroval_[] = { 0 }; @@ -24,7 +25,14 @@ HALF _twelveval_[] = { 12 }; HALF _thirteenval_[] = { 13 }; HALF _fourteenval_[] = { 14 }; HALF _fifteenval_[] = { 15 }; +HALF _sixteenval_[] = { 16 }; +HALF _seventeenval_[] = { 17 }; +HALF _eightteenval_[] = { 18 }; +HALF _nineteenval_[] = { 19 }; +HALF _twentyval_[] = { 20 }; HALF _sqbaseval_[] = { 0, 1 }; +HALF _pow4baseval_[] = { 0, 0, 1 }; +HALF _pow8baseval_[] = { 0, 0, 0, 0, 1 }; ZVALUE zconst[] = { { _zeroval_, 1, 0}, { _oneval_, 1, 0}, { _twoval_, 1, 0}, @@ -32,7 +40,8 @@ ZVALUE zconst[] = { { _sixval_, 1, 0}, { _sevenval_, 1, 0}, { _eightval_, 1, 0}, { _nineval_, 1, 0}, { _tenval_, 1, 0}, { _elevenval_, 1, 0}, { _twelveval_, 1, 0}, { _thirteenval_, 1, 0}, { _fourteenval_, 1, 0}, - { _fifteenval_, 1, 0} + { _fifteenval_, 1, 0}, { _sixteenval_, 1, 0}, { _seventeenval_, 1, 0}, + { _eightteenval_, 1, 0}, { _nineteenval_, 1, 0}, { _twentyval_, 1, 0} }; ZVALUE _zero_ = { _zeroval_, 1, 0}; @@ -40,11 +49,29 @@ ZVALUE _one_ = { _oneval_, 1, 0 }; ZVALUE _two_ = { _twoval_, 1, 0 }; ZVALUE _ten_ = { _tenval_, 1, 0 }; ZVALUE _sqbase_ = { _sqbaseval_, 2, 0 }; +ZVALUE _pow4base_ = { _pow4baseval_, 4, 0 }; +ZVALUE _pow8base_ = { _pow8baseval_, 4, 0 }; +ZVALUE _neg_one_ = { _oneval_, 1, 1 }; + +/* + * 2^64 as a ZVALUE + */ +#if BASEB == 32 +ZVALUE _b32_ = { _sqbaseval_, 2, 0 }; +ZVALUE _b64_ = { _pow4baseval_, 3, 0 }; +#elif BASEB == 16 +ZVALUE _b32_ = { _pow4baseval_, 3, 0 }; +ZVALUE _b64_ = { _pow8baseval_, 5, 0 }; +#else + -=@=- BASEB not 16 or 32 -=@=- +#endif /* * highhalf[i] - masks off the upper i bits of a HALF + * rhighhalf[i] - masks off the upper BASEB-i bits of a HALF * lowhalf[i] - masks off the upper i bits of a HALF + * rlowhalf[i] - masks off the upper BASEB-i bits of a HALF * bitmask[i] - (1 << i) for 0 <= i <= BASEB*2 */ HALF highhalf[BASEB+1] = { @@ -68,6 +95,27 @@ HALF highhalf[BASEB+1] = { -=@=- BASEB not 16 or 32 -=@=- #endif }; +HALF rhighhalf[BASEB+1] = { +#if BASEB == 32 + 0xFFFFFFFF, 0xFFFFFFFE, 0xFFFFFFFC, 0xFFFFFFF8, + 0xFFFFFFF0, 0xFFFFFFE0, 0xFFFFFFC0, 0xFFFFFF80, + 0xFFFFFF00, 0xFFFFFE00, 0xFFFFFC00, 0xFFFFF800, + 0xFFFFF000, 0xFFFFE000, 0xFFFFC000, 0xFFFF8000, + 0xFFFF0000, 0xFFFE0000, 0xFFFC0000, 0xFFF80000, + 0xFFF00000, 0xFFE00000, 0xFFC00000, 0xFF800000, + 0xFF000000, 0xFE000000, 0xFC000000, 0xF8000000, + 0xF0000000, 0xE0000000, 0xC0000000, 0x80000000, + 0x00000000 +#elif BASEB == 16 + 0xFFFF, 0xFFFE, 0xFFFC, 0xFFF8, + 0xFFF0, 0xFFE0, 0xFFC0, 0xFF80, + 0xFF00, 0xFE00, 0xFC00, 0xF800, + 0xF000, 0xE000, 0xC000, 0x8000, + 0x0000 +#else + -=@=- BASEB not 16 or 32 -=@=- +#endif +}; HALF lowhalf[BASEB+1] = { 0x0, 0x1, 0x3, 0x7, 0xF, @@ -81,6 +129,19 @@ HALF lowhalf[BASEB+1] = { 0x1FFFFFFF, 0x3FFFFFFF, 0x7FFFFFFF, 0xFFFFFFFF #endif }; +HALF rlowhalf[BASEB+1] = { +#if BASEB == 32 + 0xFFFFFFFF, 0x7FFFFFFF, 0x3FFFFFFF, 0x1FFFFFFF, + 0xFFFFFFF, 0x7FFFFFF, 0x3FFFFFF, 0x1FFFFFF, + 0xFFFFFF, 0x7FFFFF, 0x3FFFFF, 0x1FFFFF, + 0xFFFFF, 0x7FFFF, 0x3FFFF, 0x1FFFF, +#endif + 0xFFFF, 0x7FFF, 0x3FFF, 0x1FFF, + 0xFFF, 0x7FF, 0x3FF, 0x1FF, + 0xFF, 0x7F, 0x3F, 0x1F, + 0xF, 0x7, 0x3, 0x1, + 0x0 +}; HALF bitmask[(2*BASEB)+1] = { #if BASEB == 32 0x00000001, 0x00000002, 0x00000004, 0x00000008, @@ -118,6 +179,30 @@ HALF bitmask[(2*BASEB)+1] = { BOOL _math_abort_; /* nonzero to abort calculations */ +/* + * popcnt - popcnt[x] number of 1 bits in 0 <= x < 256 + */ +char popcnt[256] = { + 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4, + 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, + 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, + 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, + 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, + 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, + 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, + 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, + 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, + 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, + 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, + 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, + 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, + 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, + 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, + 4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8 +}; + + + #ifdef ALLOCTEST static long nalloc = 0; static long nfree = 0; @@ -1157,7 +1242,7 @@ zdivides(ZVALUE z1, ZVALUE z2) /* - * Compute the logical OR of two numbers + * Compute the bitwise OR of two integers */ void zor(ZVALUE z1, ZVALUE z2, ZVALUE *res) @@ -1187,7 +1272,7 @@ zor(ZVALUE z1, ZVALUE z2, ZVALUE *res) /* - * Compute the logical AND of two numbers. + * Compute the bitwise AND of two integers */ void zand(ZVALUE z1, ZVALUE z2, ZVALUE *res) @@ -1217,38 +1302,74 @@ zand(ZVALUE z1, ZVALUE z2, ZVALUE *res) /* - * Compute the logical XOR of two numbers. + * Compute the bitwise XOR of two integers. */ void zxor(ZVALUE z1, ZVALUE z2, ZVALUE *res) { - register HALF *sp, *dp; - LEN len; - ZVALUE bz, lz, dest; + HALF *dp, *h1, *h2; + LEN len, j, k; + ZVALUE dest; - if (z1.len == z2.len) { - /* ignore Saber-C warning #530 about empty for statement */ - /* ok to ignore in proc zxor */ - for (len = z1.len; ((len > 1) && (z1.v[len-1] == z2.v[len-1])); len--) ; - z1.len = len; - z2.len = len; + h1 = z1.v; + h2 = z2.v; + len = z1.len; + j = z2.len; + if (z1.len < z2.len) { + len = z2.len; + j = z1.len; + h1 = z2.v; + h2 = z1.v; } - if (z1.len >= z2.len) { - bz = z1; - lz = z2; - } else { - bz = z2; - lz = z1; + else if (z1.len == z2.len) { + while (len > 1 && z1.v[len-1] == z2.v[len-1]) + len--; + j = len; } - dest.len = bz.len; - dest.v = alloc(dest.len); + k = len - j; + dest.len = len; + dest.v = alloc(len); dest.sign = 0; - zcopyval(bz, dest); - len = lz.len; - sp = lz.v; dp = dest.v; - while (len--) - *dp++ ^= *sp++; + while (j-- > 0) + *dp++ = *h1++ ^ *h2++; + while (k-- > 0) + *dp++ = *h1++; + *res = dest; +} + + +/* + * Compute the bitwise ANDNOT of two integers. + */ +void +zandnot(ZVALUE z1, ZVALUE z2, ZVALUE *res) +{ + HALF *dp, *h1, *h2; + LEN len, j, k; + ZVALUE dest; + + len = z1.len; + if (z2.len >= len) { + while (len > 1 && (z1.v[len-1] & ~z2.v[len-1]) == 0) + len--; + j = len; + k = 0; + } + else { + j = z2.len; + k = len - z2.len; + } + dest.len = len; + dest.v = alloc(len); + dest.sign = 0; + dp = dest.v; + h1 = z1.v; + h2 = z2.v; + while (j-- > 0) + *dp++ = *h1++ & ~*h2++; + while (k-- > 0) + *dp++ = *h1++; *res = dest; } @@ -1580,6 +1701,44 @@ zrel(ZVALUE z1, ZVALUE z2) } +/* + * Compare the absolute value two numbers to see which is larger. + * Returns -1 if first number is smaller, 0 if they are equal, and 1 if + * first number is larger. This is the same result as ztest(abs(z2)-abs(z1)) + * or zrel(abs(z1), abs(z2)). + */ +FLAG +zabsrel(ZVALUE z1, ZVALUE z2) +{ + register HALF *h1, *h2; + register FULL len1, len2; + + len1 = z1.len; + len2 = z2.len; + h1 = z1.v + z1.len - 1; + h2 = z2.v + z2.len - 1; + while (len1 > len2) { + if (*h1--) + return 1; + len1--; + } + while (len2 > len1) { + if (*h2--) + return -1; + len2--; + } + while (len1--) { + if (*h1-- != *h2--) + break; + } + if ((len1 = *++h1) > (len2 = *++h2)) + return 1; + if (len1 < len2) + return -1; + return 0; +} + + /* * Compare two numbers to see if they are equal or not. * Returns TRUE if they differ. @@ -1739,4 +1898,64 @@ zshiftl(ZVALUE z, long n) } } -/* END CODE */ + +/* + * popcnt - count the number of 0 or 1 bits in an integer + * + * We ignore all 0 bits above the highest bit. + */ +long +zpopcnt(ZVALUE z, int bitval) +{ + long cnt = 0; /* number of times found */ + HALF h; /* HALF to count */ + int i; + + /* + * count 1's + */ + if (bitval) { + + /* + * count each HALF + */ + for (i=0; i < z.len; ++i) { + /* count each octet */ + for (h = z.v[i]; h; h >>= 8) { + cnt += (long)popcnt[h & 0xff]; + } + } + + /* + * count 0's + */ + } else { + + /* + * count each HALF up until the last + */ + for (i=0; i < z.len-1; ++i) { + + /* count each octet */ + cnt += BASEB; + for (h = z.v[i]; h; h >>= 8) { + cnt -= (long)popcnt[h & 0xff]; + } + } + + /* + * count the last octet up until the highest 1 bit + */ + for (h = z.v[z.len-1]; h; h>>=1) { + /* count each 0 bit */ + if ((h & 0x1) == 0) { + ++cnt; + } + } + } + + /* + * return count + */ + return cnt; +} diff --git a/zmath.h b/zmath.h index b46c92f..6945cbe 100644 --- a/zmath.h +++ b/zmath.h @@ -1,5 +1,5 @@ /* - * Copyright (c) 1996 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. * @@ -8,10 +8,11 @@ * and longs must be addressible on word boundaries. */ -#if !defined(ZMATH_H) -#define ZMATH_H -#include +#if !defined(__ZMATH_H__) +#define __ZMATH_H__ + + #include "alloc.h" #include "endian_calc.h" #include "longbits.h" @@ -24,13 +25,8 @@ #ifndef ALLOCTEST -# if defined(CALC_MALLOC) -# define freeh(p) (((void *)p == (void *)_zeroval_) || \ - ((void *)p == (void *)_oneval_) || free((void *)p)) -# else -# define freeh(p) { if (((void *)p != (void *)_zeroval_) && \ +# define freeh(p) { if (((void *)p != (void *)_zeroval_) && \ ((void *)p != (void *)_oneval_)) free((void *)p); } -# endif #endif @@ -177,10 +173,6 @@ typedef union { } SIUNION; -#if !defined(BYTE_ORDER) -#include -#endif - #if !defined(LITTLE_ENDIAN) #define LITTLE_ENDIAN 1234 /* Least Significant Byte first */ #endif @@ -189,15 +181,15 @@ typedef union { #endif /* PDP_ENDIAN - LSB in word, MSW in long is not supported */ -#if BYTE_ORDER == LITTLE_ENDIAN +#if CALC_BYTE_ORDER == LITTLE_ENDIAN # define silow sis.Svalue1 /* low order half of full value */ # define sihigh sis.Svalue2 /* high order half of full value */ #else -# if BYTE_ORDER == BIG_ENDIAN +# if CALC_BYTE_ORDER == BIG_ENDIAN # define silow sis.Svalue2 /* low order half of full value */ # define sihigh sis.Svalue1 /* high order half of full value */ # else - /\oo/\ BYTE_ORDER must be BIG_ENDIAN or LITTLE_ENDIAN /\oo/\ !!! + /\oo/\ CALC_BYTE_ORDER must be BIG_ENDIAN or LITTLE_ENDIAN /\oo/\ !!! # endif #endif @@ -232,6 +224,7 @@ extern void zprintval(ZVALUE z, long decimals, long width); extern void zprintx(ZVALUE z, long width); extern void zprintb(ZVALUE z, long width); extern void zprinto(ZVALUE z, long width); +extern void fitzprint(ZVALUE, long, long); /* @@ -251,6 +244,8 @@ extern BOOL zdivides(ZVALUE z1, ZVALUE z2); extern void zor(ZVALUE z1, ZVALUE z2, ZVALUE *res); extern void zand(ZVALUE z1, ZVALUE z2, ZVALUE *res); extern void zxor(ZVALUE z1, ZVALUE z2, ZVALUE *res); +extern void zandnot(ZVALUE z1, ZVALUE z2, ZVALUE *res); +extern long zpopcnt(ZVALUE z, int bitval); extern void zshift(ZVALUE z, long n, ZVALUE *res); extern void zsquare(ZVALUE z, ZVALUE *res); extern long zlowbit(ZVALUE z); @@ -261,6 +256,7 @@ extern BOOL zisonebit(ZVALUE z); extern BOOL zisallbits(ZVALUE z); extern FLAG ztest(ZVALUE z); extern FLAG zrel(ZVALUE z1, ZVALUE z2); +extern FLAG zabsrel(ZVALUE z1, ZVALUE z2); extern BOOL zcmp(ZVALUE z1, ZVALUE z2); @@ -292,6 +288,7 @@ extern long zdigit(ZVALUE z1, long n); extern FLAG zsqrt(ZVALUE z1, ZVALUE *dest, long R); extern void zroot(ZVALUE z1, ZVALUE z2, ZVALUE *dest); extern BOOL zissquare(ZVALUE z); +extern void zhnrmod(ZVALUE v, ZVALUE h, ZVALUE zn, ZVALUE zr, ZVALUE *res); /* @@ -318,9 +315,9 @@ extern void zlcmfact(ZVALUE z, ZVALUE *dest); #if 0 extern void zapprox(ZVALUE z1, ZVALUE z2, ZVALUE *res1, ZVALUE *res2); extern void zmulmod(ZVALUE z1, ZVALUE z2, ZVALUE z3, ZVALUE *res); -extern void zsquaremod(ZVALUE z1, ZVALUE z2, ZVALUE *res); extern void zsubmod(ZVALUE z1, ZVALUE z2, ZVALUE z3, ZVALUE *res); #endif +extern void zsquaremod(ZVALUE z1, ZVALUE z2, ZVALUE *res); extern void zminmod(ZVALUE z1, ZVALUE z2, ZVALUE *res); extern BOOL zcmpmod(ZVALUE z1, ZVALUE z2, ZVALUE z3); extern void zio_init(void); @@ -502,7 +499,6 @@ extern void math_fill(char *str, long width); extern void math_flush(void); extern void math_divertio(void); extern void math_cleardiversions(void); -extern void math_setfp(FILE *fp); extern char *math_getdivertedio(void); extern int math_setmode(int mode); extern long math_setdigits(long digits); @@ -533,15 +529,74 @@ extern HALF _fiveval_[], _sixval_[], _sevenval_[], _eightval_[], _nineval_[]; extern HALF _tenval_[], _elevenval_[], _twelveval_[], _thirteenval_[]; extern HALF _fourteenval_[], _fifteenval_[]; extern HALF _sqbaseval_[]; +extern HALF _fourthbaseval_[]; extern ZVALUE zconst[]; /* ZVALUE integers from 0 thru 15 */ -extern ZVALUE _zero_, _one_, _two_, _ten_, _sqbase_; +extern ZVALUE _zero_, _one_, _two_, _ten_, _neg_one_; +extern ZVALUE _sqbase_, _pow4base_, _pow8base_; + +extern ZVALUE _b32_, _b64_; extern BOOL _math_abort_; /* nonzero to abort calculations */ extern ZVALUE _tenpowers_[]; /* table of 10^2^n */ + +/* + * Bit fiddeling functions and types + */ extern HALF bitmask[]; /* bit rotation, norm 0 */ extern HALF lowhalf[]; /* bit masks from low end of HALF */ +extern HALF rlowhalf[]; /* reversed bit masks from low end of HALF */ extern HALF highhalf[]; /* bit masks from high end of HALF */ +extern HALF rhighhalf[]; /* reversed bit masks from high end of HALF */ +#define HAVE_REVERSED_MASKS /* allows old code to know libcalc.a has them */ + + +/* + * BITSTR - string of bits within an array of HALFs + * + * This typedef records a location of a bit in an array of HALFs. + * Bit 0 in a HALF is assumed to be the least significant bit in that HALF. + * + * The most significant bit is found at (loc,bit). Bits of lesser + * significance may be found in previous bits and HALFs. + */ +typedef struct { + HALF *loc; /* half address of most significant bit */ + int bit; /* bit position within half of most significant bit */ + int len; /* length of string in bits */ +} BITSTR; + + +/* + * HVAL(a,b) - form an array of HALFs given 8 hex digits + * a: up to 4 hex digits without the leading 0x (upper half) + * b: up to 4 hex digits without the leading 0x (lower half) + * + * NOTE: Due to a SunOS cc bug, don't put spaces in the HVAL call! + */ +#if FULL_BITS == 64 + +# if defined(__STDC__) && __STDC__ != 0 +# define HVAL(a,b) (HALF)(0x ## a ## b) +# else +# define HVAL(a,b) (HALF)(0x/**/a/**/b) +# endif + +#elif 2*FULL_BITS == 64 + +# if defined(__STDC__) && __STDC__ != 0 +# define HVAL(a,b) (HALF)0x##b, (HALF)0x##a +# else + /* NOTE: Due to a SunOS cc bug, don't put spaces in the HVAL call! */ +# define HVAL(a,b) (HALF)0x/**/b, (HALF)0x/**/a +# endif + +#else + + /\../\ FULL_BITS must be 32 or 64 /\../\ !!! #endif + + +#endif /* !__ZMATH_H__*/ diff --git a/zmod.c b/zmod.c index 5c716ed..100fe1a 100644 --- a/zmod.c +++ b/zmod.c @@ -1,5 +1,5 @@ /* - * Copyright (c) 1996 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. * @@ -98,6 +98,7 @@ zmulmod(ZVALUE z1, ZVALUE z2, ZVALUE z3, ZVALUE *res) zmod(tmp, z3, res, 0); zfree(tmp); } +#endif /* @@ -158,6 +159,7 @@ zsquaremod(ZVALUE z1, ZVALUE z2, ZVALUE *res) } +#if 0 /* * Add two numbers together and then mod the result with a third number. * The two numbers to be added can be negative or out of modulo range. @@ -1986,6 +1988,9 @@ zredcpower(REDC *rp, ZVALUE z1, ZVALUE z2, ZVALUE *res) } } pp = &lowpowers[curpow]; + if (pp->len > 0) { + zfree(*pp); + } *pp = modpow; } @@ -2036,4 +2041,316 @@ zredcpower(REDC *rp, ZVALUE z1, ZVALUE z2, ZVALUE *res) zfree(ztmp); } -/* END CODE */ + +/* + * zhnrmod - compute z mod h*2^n+r + * + * We compute v mod h*2^n+r, where h>0, n>0, abs(r) <= 1, as follows: + * + * Let v = b*2^n + a, where 0 <= a < 2^n + * + * Now v mod h*2^n+r == b*2^n + a mod h*2^n+r, + * and thus v mod h*2^n+r == b*2^n mod h*2^n+r + a mod h*2^n+r. + * + * Because 0 <= a < 2^n < h*2^n+r, a mod h*2^n+r == a. + * Thus v mod h*2^n+r == b*2^n mod h*2^n+r + a. + * + * It can be shown that b*2^n mod h*2^n == 2^n * (b mod h). + * + * Thus for r == 0, v mod h*2^n+r == (2^n)*(b mod h) + a. + * + * It can be shown that v mod 2^n-1 == a+b mod 2^n-1. + * + * Thus for r == -1, v mod h*2^n+r == (2^n)*(b mod h) + a + int(b/h). + * + * It can be shown that v mod 2^n+1 == a-b mod 2^n+1. + * + * Thus for r == +1, v mod h*2^n+r == (2^n)*(b mod h) + a - int(b/h). + * + * Therefore, v mod h*2^n+r == (2^n)*(b mod h) + a - r*int(b/h). + * + * The above proof leads to the following calc script which computes + * the value z mod h*2^n+r: + * + * define hnrmod(v,h,n,r) + * { + * local a,b,modulus,tquo,tmod,lbit,ret; + * + * if (!isint(h) || h < 1) { + * quit "h must be an integer be > 0"; + * } + * if (!isint(n) || n < 1) { + * quit "n must be an integer be > 0"; + * } + * if (r != 1 && r != 0 && r != -1) { + * quit "r must be -1, 0 or 1"; + * } + * + * lbit = lowbit(h); + * if (lbit > 0) { + * n += lbit; + * h >>= lbit; + * } + * + * modulus = h<>n; + * a = ret - (b< b) ? a-b : modulus+a-b); + * } else { + * quomod(b, h, tquo, tmod); + * tmod = tmod<= tquo) ? tmod-tquo : modulus+tmod-tquo); + * } + * break; + * } + * } while (ret > modulus); + * ret = ((ret < 0) ? ret+modlus : ((ret == modulus) ? 0 : ret)); + * + * return ret; + * } + * + * This function implements the above calc script. + * + * given: + * v take mod of this value, v >= 0 + * zh h from modulus h*2^n+r, h > 0 + * zn n from modulus h*2^n+r, n > 0 + * zr r from modulus h*2^n+r, abs(r) <= 1 + * res v mod h*2^n+r + */ +void +zhnrmod(ZVALUE v, ZVALUE zh, ZVALUE zn, ZVALUE zr, ZVALUE *res) +{ + ZVALUE a; /* lower n bits of v */ + ZVALUE b; /* bits above the lower n bits of v */ + ZVALUE h; /* working zh value */ + ZVALUE modulus; /* h^2^n + r */ + ZVALUE tquo; /* b // h */ + ZVALUE tmod; /* b % h or (b%h)< h == 1, 0 => h != 1 */ + + /* + * firewall + */ + if (zisneg(zh) || ziszero(zh)) { + math_error("h must be > 0"); + /*NOTREACHED*/ + } + if (zisneg(zn) || ziszero(zn)) { + math_error("n must be > 0"); + /*NOTREACHED*/ + } + if (zge31b(zn)) { + math_error("n must be < 2^31"); + /*NOTREACHED*/ + } + if (!zisabsleone(zr)) { + math_error("r must be -1, 0 or 1"); + /*NOTREACHED*/ + } + + + /* + * setup for loop + */ + n = ztolong(zn); + r = ztolong(zr); + if (zisneg(zr)) { + r = -r; + } + /* lbit = lowbit(h); */ + lbit = zlowbit(zh); + /* if (lbit > 0) { n += lbit; h >>= lbit; } */ + if (lbit > 0) { + n += lbit; + zshift(zh, -lbit, &h); + } else { + h = zh; + } + /* modulus = h< 0) { + zfree(h); + } + return; + } + /* ret = v; */ + zcopy(v, &ret); + + /* + * shift-add modulus loop + */ + hisone = zisone(h); + do { + + /* + * split ret into to chunks, the lower n bits + * and everything above the lower n bits + */ + /* if (highbit(ret) < n) { break; } */ + hbit = (long)zhighbit(ret); + if (hbit < n) { + zrelval = (zcmp(ret, modulus) ? -1 : 0); + break; + } + /* b = ret>>n; */ + zshift(ret, -n, &b); + b.sign = ret.sign; + /* a = ret - (b< modulus); */ + } while ((zrelval = zabsrel(ret, modulus)) > 0); + /* ret = ((ret < 0) ? ret+modlus : ((ret == modulus) ? 0 : ret)); */ + if (ret.sign) { + zadd(ret, modulus, &t); + zfree(t); + ret = t; + } else if (zrelval == 0) { + zfree(ret); + ret = _zero_; + } + zfree(modulus); + if (lbit > 0) { + zfree(h); + } + + /* + * return ret + */ + *res = ret; + return; +} diff --git a/zprime.c b/zprime.c index 1d61510..7a783c2 100644 --- a/zprime.c +++ b/zprime.c @@ -315,7 +315,7 @@ zpprime(ZVALUE z) /* deal with special case small values */ n = ztofull(z); - switch (n) { + switch ((int)n) { case 0: case 1: case 2: diff --git a/zrand.c b/zrand.c index a097a5b..2404981 100644 --- a/zrand.c +++ b/zrand.c @@ -1,5 +1,5 @@ /* - * Copyright (c) 1996 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, @@ -36,25 +36,11 @@ * chongo was here /\../\ */ -/* - * XXX - Add shs() and md5 hash functions. Ensure that any object can - * be hashed. Ensure that if a == b, hash of a == hash of b. - * This can be done by hashing all values of an value that - * are used in the equality test. Note that the value type should - * also be hashed to help distinguish different value types. - * Also note that objects should hash their name. The shs() and - * md5() should NOT replace the foohash() functions used by - * associative arrays as those functions need to be fast. - * - * XXX - write random() and srandom() help pages - */ - /* * AN OVERVIEW OF THE FUNCTIONS: * - * This module contains two pseudo-random number generators: - * - * Additive 55 shuffle generator: + * This module contains an Additive 55 shuffle generator wrapped inside + * of a shuffle generator. * * We refer to this generator as the a55 generator. * @@ -82,55 +68,7 @@ * * The shuffle generator is feed values by the additive 55 process. * - * Blum-Blum-Shub generator: - * - * We refer to this generator as the Blum generator. - * - * This generator is described in the papers: - * - * Blum, Blum, and Shub, "Comparison of Two Pseudorandom Number - * Generators", in Chaum, D. et. al., "Advances in Cryptology: - * Proceedings Crypto 82", pp. 61-79, Plenum Press, 1983. - * - * Blum, Blum, and Shub, "A Simple Unpredictable Pseudo-Random - * Number Generator", SIAM Journal of Computing, v. 15, n. 2, - * 1986, pp. 364-383. - * - * U. V. Vazirani and V. V. Vazirani, "Trapdoor Pseudo-Random - * Number Generators with Applications to Protocol Design", - * Proceedings of the 24th IEEE Symposium on the Foundations - * of Computer Science, 1983, pp. 23-30. - * - * U. V. Vazirani and V. V. Vazirani, "Efficient and Secure - * Pseudo-Random Number Generation", Proceedings of the 24th - * IEEE Symposium on the Foundations of Computer Science, - * 1984, pp. 458-463. - * - * U. V. Vazirani and V. V. Vazirani, "Efficient and Secure - * Pseudo-Random Number Generation", Advances in Cryptology - - * Proceedings of CRYPTO '84, Berlin: Springer-Verlag, 1985, - * pp. 193-202. - * - * Sciences 28, pp. 270-299. - * - * Bruce Schneier, "Applied Cryptography", John Wiley & Sons, - * 1st edition (1994), pp 365-366. - * - * This generator is considered 'strong' in that it passes all - * polynomial-time statistical tests. The sequences produced - * are random in an absolutely precise way. There is absolutely - * no better way to predict the sequence than by tossing a coin - * (as with TRULY random numbers) EVEN IF YOU KNOW THE MODULUS! - * Furthermore, having a large chunk of output from the sequence - * does not help. The BITS THAT FOLLOW OR PRECEDE A SEQUENCE - * ARE UNPREDICTABLE! - * - * To compromise the generator, an adversary must either factor the - * modulus or perform an exhaustive search just to determine the next - * (or previous) bit. If we make the modulus hard to factor - * (such as the product of two large well chosen primes) breaking - * the sequence could be intractable for todays computers and methods. - **** + ****************************************************************************** * * GOALS: * @@ -185,7 +123,7 @@ * * Casual direct use of the shuffle generator may be acceptable. If one * desires cryptographically strong random numbers, or if one is paranoid, - * one should use the Blum generator instead. + * one should use the Blum generator instead (see zrandom.c). * * The a55 generator as the following calc interfaces: * @@ -208,44 +146,6 @@ * randbit(skip) (where skip < 0) * * Skip random bits and return the bit skip count (-skip). - * - *** - * - * The Blum generator is the best generator in this package. It - * produces a cryptographically strong pseudo-random bit sequence. - * Internally, a fixed number of bits are generated after each - * generator iteration. Any unused bits are saved for the next call - * to the generator. The Blum generator is not too slow, though - * seeding the generator via srandom(seed,plen,qlen) can be slow. - * Shortcuts and pre-defined generators have been provided for this reason. - * Use of Blum should be more than acceptable for many applications. - * - * The Blum generator as the following calc interfaces: - * - * random(min, max) (where min < max) - * XXX - write this function - * - * Print a Blum generator random value over interval [min,max). - * - * random() - * XXX - write this function - * - * Same as random(0, 2^64). Print 64 bits. - * - * random(lim) (where 0 > lim) - * XXX - write this function - * - * Same as random(0, lim). - * - * randombit(x) (where x > 0) - * XXX - write this function - * - * Same as random(0, 2^x). Print x bits. - * - * randombit(skip) (where skip < 0) - * XXX - write this function - * - * Skip skip random bits and return the bit skip count (-skip). */ /* @@ -255,21 +155,13 @@ * Thus, it is not required to seed a generator before using it. * * The a55 generator may be initialized and seeded via srand(). - * The Blum generator may be initialized and seeded via srandom(). * * Using a seed of '0' will reload generators with their initial states. * * srand(0) restore additive 55 generator to the initial state - * srandom(0) restore Blum generator to the initial state * * The above single arg calls are fairly fast. * - * The call: - * - * srandom(seed, newn) - * - * is fast when the config value "srandom" is 0, 1 or 2. - * * Optimal seed range for the a55 generator: * * There is no limit on the size of a seed. On the other hand, @@ -292,27 +184,7 @@ * generators. Every seed is converted into a different unique seed. * No seed is ignored or favored. * - * Optimal seed range for the Blum generator: - * - * There is no limit on the size of a seed. On the other hand, - * in most cases the seed is taken modulo the Blum modulus. - * Using a seed that is too small (except for 0) results in - * an internal generator be used to increase its size. - * - * It is faster to use seeds that are in the half open internal - * [sqrt(n), n) where n is the Blum modulus. - * - * The default Blum modulus is 256 bits. The default - * optimal size of a seed is between 128 and 256 bits. - * - * The exception is when srandom(seed, plen, qlen) is used. - * When seed < 0, the seed is given to an internal a55 generator - * and the a55 generator range (negated) applies. When seed > 0, - * the seed is given to an internal Blum generator and the - * 128 to 256 bit range applies. The value seed == 0 may also - * be used in this type of call. - * - ***** + ****************************************************************************** * * srand(seed) * @@ -356,7 +228,7 @@ * Last the shuffle table is loaded with successive values from the * additive 55 generator. * - *** + ****************************************************************************** * * srand(mat55) * @@ -369,14 +241,14 @@ * Last the shuffle table is loaded with successive values from the * additive 55 generator. * - *** + ****************************************************************************** * * srand() * * Return current a55 generator state. This call does not alter * the generator state. * - *** + ****************************************************************************** * * srand(state) * @@ -396,451 +268,16 @@ * * Saving the state just after seeding a generator and restoring it later * as a very fast way to reseed a generator. - * - *** - * - * srandom(seed) - * XXX - write this function - * - * Seed the Blum generator using the current Blum modulus. - * - * Here we assume that the Blum modulus is n. Any internally buffered - * random bits are flushed. - * - * seed > 0: - * -------- - * Seed the an internal additive 55 shuffle generator, and use it - * to produce an initial quadratic residue in the range: - * - * [2^(binsize*4/5), 2^(binsize-2)) - * - * where 2^(binsize-1) < n <= 2^binsize and 'n' is the current Blum - * modulus. Here, binsize is the smallest power of 2 >= n. - * - * The follow calc script produces an equivalent effect: - * - * cur_state = srand(seed); - * binsize = highbit(n)+1; (* n is the current Blum modulus *) - * r = pmod(rand(1< 0, 1007 <= newn: - * ---------------------- - * If 'newn' passes the tests (if applicable) specified by the "srandom" - * config value, it becomes the Blum modulus. Once the Blum modulus - * is set, seed is used to seed an internal Additive 55 generator - * state which in turn is used to set the initial quadratic residue. - * - * While not as efficient, this call is equivalent to: - * - * srandom(0, newn); - * srandom(seed); - * - * seed < 0, 1007 <= newn: - * ---------------------- - * Reserved for future use. - * - * any seed, 20 < newn < 1007: - * -------------------------- - * Reserved for future use. - * - * seed == 0, 0 < newn <= 20: - * ------------------------- - * Seed with one of the predefined Blum moduli. - * - * The Blum moduli used by the pre-defined generators were generated - * using the above process. The initial search values for the Blum - * primes and the value used for selecting the initial quadratic - * residue (by squaring it mod the Blum modulus) were produced by - * special purpose hardware that produces cryptographically strong - * random numbers. - * - * See the URL: - * - * http://lavarand.sgi.com - * - * for an explination of how the search points of the generators - * were selected. - * - * XXX - This URL is not available on 16Jun96 ... but will be soon. - * - * The purpose of these pre-defined Blum moduli is to provide users with - * an easy way to use a generator where the individual Blum primes used - * are not well known. True, these values are in some way "MAGIC", on - * the other hand that is their purpose! If this bothers you, don't - * use them. See the section "FOR THE PARANOID" below for details. - * - * The value 'newn' determines which pre-defined generator is used. - * For a given 'newn' the Blum modulus 'n' (product of 2 Blum primes) - * and initial quadratic residue 'r' is set as follows: - * - * newn == 1: (Blum modulus bit length 130) - * n = 0x5049440736fe328caf0db722d83de9361 - * r = 0xb226980f11d952e74e5dbb01a4cc42ec - * - * newn == 2: (Blum modulus bit length 137) - * n = 0x2c5348a2555dd374a18eb286ea9353443f1 - * r = 0x40f3d643446cd710e3e893616b21e3a218 - * - * newn == 3: (Blum modulus bit length 147) - * n = 0x9cfd959d6ce4e3a81f1e0f2ca661f11d001f1 - * r = 0xfae5b44d9b64ff5cea4f3e142de2a0d7d76a - * - * newn == 4: (Blum modulus bit length 157) - * n = 0x3070f9245c894ed75df12a1a2decc680dfcc0751 - * r = 0x20c2d8131b2bdca2c0af8aa220ddba4b984570 - * - * newn == 5: (Blum modulus bit length 257) - * n = 0x2109b1822db81a85b38f75aac680bc2fa5d3fe1118769a0108b99e5e799 - * 166ef1 - * r = 0x5e9b890eae33b792e821a9605f5df6db234f7b7d1e70aeed0e6c77c859e - * 2efa9 - * - * newn == 6: (Blum modulus bit length 259) - * n = 0xa7bfd9d7d9ada2c79f2dbf2185c6440263a38db775ee732dad85557f1e1 - * ddf431 - * r = 0x5e94a02f88667154e097aedece1c925ce1f3495d2c98eccfc5dc2e80c94 - * 04daf - * - * newn == 7: (Blum modulus bit length 286) - * n = 0x43d87de8f2399ef237801cd5628643fcff569d6b0dcf53ce52882e7f602 - * f9125cf9ec751 - * r = 0x13522d1ee014c7bfbe90767acced049d876aefcf18d4dd64f0b58c3992d - * 2e5098d25e6 - * - * newn == 8: (Blum modulus bit length 294) - * n = 0x5847126ca7eb4699b7f13c9ce7bdc91fed5bdbd2f99ad4a6c2b59cd9f0b - * c42e66a26742f11 - * r = 0x853016dca3269116b7e661fa3d344f9a28e9c9475597b4b8a35da929aae - * 95f3a489dc674 - * - * newn == 9: (Blum modulus bit length 533) - * n = 0x39e8be52322fd3218d923814e81b003d267bb0562157a3c1797b4f4a867 - * 52a84d895c3e08eb61c36a6ff096061c6fd0fdece0d62b16b66b980f95112 - * 745db4ab27e3d1 - * r = 0xb458f8ad1e6bbab915bfc01508864b787343bc42a8aa82d9d2880107e3f - * d8357c0bd02de3222796b2545e5ab7d81309a89baedaa5d9e8e59f959601e - * f2b87d4ed20d - * - * newn == 10: (Blum modulus bit length 537) - * n = 0x25f2435c9055666c23ef596882d7f98bd1448bf23b50e88250d3cc952c8 - * 1b3ba524a02fd38582de74511c4008d4957302abe36c6092ce222ef9c73cc - * 3cdc363b7e64b89 - * r = 0x66bb7e47b20e0c18401468787e2b707ca81ec9250df8cfc24b5ffbaaf2c - * f3008ed8b408d075d56f62c669fadc4f1751baf950d145f40ce23442aee59 - * 4f5ad494cfc482 - * - * newn == 11: (Blum modulus bit length 542) - * n = 0x497864de82bdb3094217d56b874ecd7769a791ea5ec5446757f3f9b6286 - * e58704499daa2dd37a74925873cfa68f27533920ee1a9a729cf522014dab2 - * 2e1a530c546ee069 - * r = 0x8684881cb5e630264a4465ae3af8b69ce3163f806549a7732339eea2c54 - * d5c590f47fbcedfa07c1ef5628134d918fee5333fed9c094d65461d88b13a - * 0aded356e38b04 - * - * newn == 12: (Blum modulus bit length 549) - * n = 0x3457582ab3c0ccb15f08b8911665b18ca92bb7c2a12b4a1a66ee4251da1 - * 90b15934c94e315a1bf41e048c7c7ce812fdd25d653416557d3f09887efad - * 2b7f66d151f14c7b99 - * r = 0xdf719bd1f648ed935870babd55490137758ca3b20add520da4c5e8cdcbf - * c4333a13f72a10b604eb7eeb07c573dd2c0208e736fe56ed081aa9488fbc4 - * 5227dd68e207b4a0 - * - * newn == 13: (Blum modulus bit length 1048) - * n = 0x1517c19166b7dd21b5af734ed03d833daf66d82959a553563f4345bd439 - * 510a7bda8ee0cb6bf6a94286bfd66e49e25678c1ee99ceec891da8b18e843 - * 7575113aaf83c638c07137fdd3a76c3a49322a11b5a1a84c32d99cbb2b056 - * 671589917ed14cc7f1b5915f6495dd1892b4ed7417d79a63cc8aaa503a208 - * e3420cca200323314fc49 - * r = 0xd42e8e9a560d1263fa648b04f6a69b706d2bc4918c3317ddd162cb4be7a - * 5e3bbdd1564a4aadae9fd9f00548f730d5a68dc146f05216fe509f0b8f404 - * 902692de080bbeda0a11f445ff063935ce78a67445eae5c9cea5a8f6b9883 - * faeda1bbe5f1ad3ef6409600e2f67b92ed007aba432b567cc26cf3e965e20 - * 722407bfe46b7736f5 - * - * newn == 14: (Blum modulus bit length 1054) - * n = 0x5e56a00e93c6f4e87479ac07b9d983d01f564618b314b4bfec7931eee85 - * eb909179161e23e78d32110560b22956b22f3bc7e4a034b0586e463fd40c6 - * f01a33e30ede912acb86a0c1e03483c45f289a271d14bd52792d0a076fdfe - * fe32159054b217092237f0767434b3db112fee83005b33f925bacb3185cc4 - * 409a1abdef8c0fc116af01 - * r = 0xf7aa7cb67335096ef0c5d09b18f15415b9a564b609913f75f627fc6b0c5 - * b686c86563fe86134c5a0ea19d243350dfc6b9936ba1512abafb81a0a6856 - * c9ae7816bf2073c0fb58d8138352b261a704b3ce64d69dee6339010186b98 - * 3677c84167d4973444194649ad6d71f8fa8f1f1c313edfbbbb6b1b220913c - * c8ea47a4db680ff9f190 - * - * newn == 15: (Blum modulus bit length 1055) - * n = 0x97dd840b9edfbcdb02c46c175ba81ca845352ebe470be6075326a26770c - * ab84bfc0f2e82aa95aac14f40de42a0590445b902c2b8ebb916753e72ab86 - * c3278cccc1a783b3e962d81b80df03e4380a8fa08b0d86ed0caa515c196a5 - * 30e49c558ddb53082310b1d0c7aee6f92b619798624ffe6c337299bc51ff5 - * d2c721061e7597c8d97079 - * r = 0xb8220703b8c75869ab99f9b50025daa8d77ca6df8cef423ede521f55b1c - * 25d74fbf6d6cc31f5ef45e3b29660ef43797f226860a4aa1023dbe522b1fe - * 6224d01eb77dee9ad97e8970e4a9e28e7391a6a70557fa0e46eca78866241 - * ba3c126fc0c5469f8a2f65c33db95d1749d3f0381f401b9201e6abd43d98d - * b92e808f0aaa6c3e2110 - * - * newn == 16: (Blum modulus bit length 1062) - * n = 0x456e348549b82fbb12b56f84c39f544cb89e43536ae8b2b497d426512c7 - * f3c9cc2311e0503928284391959e379587bc173e6bc51ba51c856ba557fee - * 8dd69cee4bd40845bd34691046534d967e40fe15b6d7cf61e30e283c05be9 - * 93c44b6a2ea8ade0f5578bd3f618336d9731fed1f1c5996a5828d4ca857ac - * 2dc9bd36184183f6d84346e1 - * r = 0xb0d7dcb19fb27a07973e921a4a4b6dcd7895ae8fced828de8a81a3dbf25 - * 24def719225404bfd4977a1508c4bac0f3bc356e9d83b9404b5bf86f6d19f - * f75645dffc9c5cc153a41772670a5e1ae87a9521416e117a0c0d415fb15d2 - * 454809bad45d6972f1ab367137e55ad0560d29ada9a2bcda8f4a70fbe04a1 - * abe4a570605db87b4e8830 - * - * newn == 17: (Blum modulus bit length 2062) - * n = 0x6177813aeac0ffa3040b33be3c0f96e0faf97ca54266bfedd7be68494f7 - * 6a7a91144598bf28b3a5a9dc35a6c9f58d0e5fb19839814bc9d456bff7f29 - * 953bdac7cafd66e2fc30531b8d544d2720b97025e22b1c71fa0b2eb9a499d - * 49484615d07af7a3c23b568531e9b8507543362027ec5ebe0209b4647b7ff - * 54be530e9ef50aa819c8ff11f6d7d0a00b25e88f2e6e9de4a7747022b949a - * b2c2e1ab0876e2f1177105718c60196f6c3ac0bde26e6cd4e5b8a20e9f0f6 - * 0974f0b3868ff772ab2ceaf77f328d7244c9ad30e11a2700a120a314aff74 - * c7f14396e2a39cc14a9fa6922ca0fce40304166b249b574ffd9cbb927f766 - * c9b150e970a8d1edc24ebf72b72051 - * r = 0x53720b6eaf3bc3b8adf1dd665324c2d2fc5b2a62f32920c4e167537284d - * a802fc106be4b0399caf97519486f31e0fa45a3a677c6cb265c5551ba4a51 - * 68a7ce3c29731a4e9345eac052ee1b84b7b3a82f906a67aaf7b35949fd7fc - * 2f9f4fbc8c18689694c8d30810fff31ebee99b1cf029a33bd736750e7fe0a - * 56f7e1d2a9b5321b5117fe9a10e46bf43c896e4a33faebd584f7431e7edbe - * bd1703ccee5771b44f0c149888af1a4264cb9cf2e0294ea7719ed6fda1b09 - * fa6e016c039aeb6d02a03281bcea8c278dd2a807eacae6e52ade048f58f2e - * b5193f4ffb9dd68467bc6f8e9d14286bfef09b0aec414c9dadfbf5c46d945 - * d147b52aa1e0cbd625800522b41dac - * - * newn == 18: (Blum modulus bit length 2074) - * n= 0x68f2a38fb61b42af07cb724fec0c7c65378efcbafb3514e268d7ee38e21 - * a5680de03f4e63e1e52bde1218f689900be4e5407950539b9d28e9730e8e6 - * ad6438008aa956b259cd965f3a9d02e1711e6b344b033de6425625b6346d2 - * ca62e41605e8eae0a7e2f45c25119ef9eece4d3b18369e753419d94118d51 - * 803842f4de5956b8349e6a0a330145aa4cd1a72afd4ef9db5d8233068e691 - * 18ff4b93bcc67859f211886bb660033f8170640c6e3d61471c3b7dd62c595 - * b156d77f317dc272d6b7e7f4fdc20ed82f172fe29776f3bddf697fb673c70 - * defd6476198a408642ed62081447886a625812ac6576310f23036a7cd3c93 - * 1c96f7df128ad4ed841351b18c8b78629 - * r= 0x4735e921f1ac6c3f0d5cda84cd835d75358be8966b99ff5e5d36bdb4be1 - * 2c5e1df70ac249c0540a99113a8962778dc75dac65af9f3ab4672b4c575c4 - * 9926f7f3f306fd122ac033961d042c416c3aa43b13ef51b764d505bb1f369 - * ac7340f8913ddd812e9e75e8fde8c98700e1d3353da18f255e7303db3bcbb - * eda4bc5b8d472fbc9697f952cfc243c6f32f3f1bb4541e73ca03f5109df80 - * 37219a06430e88a6e94be870f8d36dbcc381a1c449c357753a535aa5666db - * 92af2aaf1f50a3ddde95024d9161548c263973665a909bd325441a3c18fc7 - * 0502f2c9a1c944adda164e84a8f3f0230ff2aef8304b5af333077e04920db - * a179158f6a2b3afb78df2ef9735ea3c63 - * - * newn == 19: (Blum modulus bit length 2133) - * n= 0x230d7ab23bb9e8d6788b252ad6534bdde276540721c3152e410ad4244de - * b0df28f4a6de063ba1e51d7cd1736c3d8410e2516b4eb903b8d9206b92026 - * 64cacbd0425c516833770d118bd5011f3de57e8f607684088255bf7da7530 - * 56bf373715ed9a7ab85f698b965593fe2b674225fa0a02ebd87402ffb3d97 - * 172acadaa841664c361f7c11b2af47a472512ee815c970af831f95b737c34 - * 2508e4c23f3148f3cdf622744c1dcfb69a43fd535e55eebcdc992ee62f2b5 - * 2c94ac02e0921884fe275b3a528bdb14167b7dec3f3f390cd5a82d80c6c30 - * 6624cc7a7814fb567cd4d687eede573358f43adfcf1e32f4ee7a2dc4af029 - * 6435ade8099bf0001d4ae0c7d204df490239c12d6b659a79 - * r= 0x8f1725f21e245e4fc17982196605b999518b4e21f65126fa6fa759332c8 - * e27d80158b7537da39d001cc62b83bbef0713b1e82f8293dad522993f86d1 - * 761015414b2900e74fa23f3eaaa55b31cffd2e801fefb0ac73fd99b5d0cf9 - * a635c3f4c73d8892d36ad053fc17a423cdcbcf07967a8608c7735e287d784 - * ae089b3ddea9f2d2bb5d43d2ee25be346832e8dd186fc7a88d82847c03d1c - * 05ee52c1f2a51a85f733338547fdbab657cb64b43d44d41148eb32ea68c7e - * 66a8d47806f460cd6573b6ca1dd3eeaf1ce8db9621f1e121d2bb4a1878621 - * dd2dbdd7b5390ab06a5dcd9307d6662eb4248dff2ee263ef2ab778e77724a - * 14c62406967daa0d9ad4445064483193d53a5b7698ef473 - * - * newn == 20: (Blum modulus bit length 2166) - * n= 0x4fd2b820e0d8b13322e890dddc63a0267e5b3a648b03276066a3f356d79 - * 660c67704c1be6803b8e7590ee8a962c8331a05778d010e9ba10804d661f3 - * 354be1932f90babb741bd4302a07a92c42253fd4921864729fb0f0b1e0a42 - * d66b6777893195abd2ee2141925624bf71ad7328360135c565064ee502773 - * 6f42a78b988f47407ba4f7996892ffdc5cf9e7ab78ac95734dbf4e3a3def1 - * 615b5b4341cfbf6c3d0a61b75f4974080bbac03ee9de55221302b40da0c50 - * ded31d28a2f04921a532b3a486ae36e0bb5273e811d119adf90299a74e623 - * 3ccce7069676db00a3e8ce255a82fd9748b26546b98c8f4430a8db2a4b230 - * fa365c51e0985801abba4bbcf3727f7c8765cc914d262fcec3c1d081 - * r= 0x46ef0184445feaa3099293ee960da14b0f8b046fa9f608241bc08ddeef1 - * 7ee49194fd9bb2c302840e8da88c4e88df810ce387cc544209ec67656bd1d - * a1e9920c7b1aad69448bb58455c9ae4e9cd926911b30d6b5843ff3d306d56 - * 54a41dc20e2de4eb174ec5ac3e6e70849de5d5f9166961207e2d8b31014cf - * 35f801de8372881ae1ba79e58942e5bef0a7e40f46387bf775c54b1d15a14 - * 40e84beb39cd9e931f5638234ea730ed81d6fca1d7cea9e8ffb171f6ca228 - * 56264a36a2a783fd7ac39361a6598ed3a565d58acf1f5759bd294e5f53131 - * bc8e4ee3750794df727b29b1f5788ae14e6a1d1a5b26c2947ed46f49e8377 - * 3292d7dd5650580faebf85fd126ac98d98f47cf895abdc7ba048bd1a - * - * NOTE: The Blum moduli associated with 1 <= newn < 12 are subject - * to having their Blum moduli factored, depending in their size, - * by small PCs in a reasonable to large supercomputers/highly - * parallel processors over a long time. Their value lies in their - * speed relative the the default Blum generator. As of Jan 1996, - * the Blum moduli associated with 12 <= newn < 20 appear to - * be well beyond the scope of hardware and algorithms. - * See the section titled 'FOR THE PARANOID' for more details. - * - * seed > 0, 0 < newn <= 20: - * ------------------------ - * Use the same pre-defined Blum moduli 'n' noted above but use 'seed' - * to find a different quadratic residue 'r'. - * - * While not as efficient, this call is equivalent to: - * - * srandom(0, newn); - * srandom(seed); - * - * seed < 0, 0 < newn <= 20: - * ------------------------ - * Use the same pre-defined Blum moduli 'n' noted above but use '-seed' - * to compute a different quadratic residue 'r'. - * - * This call has the same effect as: - * - * srandom(0, newn) - * - * followed by the setting of the quadratic residue 'r' as follows: - * - * r = pmod(seed, 2, n) - * - * where 'n' is the Blum moduli generated by 'srandom(0,newn)' and - * 'r' is the new quadratic residue. - * - * NOTE: Because no checking on 'seed' is performed, it is recommended - * that 'seed' be selected as follows: - * - * binsize = highbit(n)+1; - * seed = -rand(1<= n=p*q. - * - * The use of the above range insures that the quadratic residue is - * large, but not too large. We want to avoid residues that are - * near 0 or that are near 'n'. Such residues are trivial or - * semi-trivial. Applying the same restriction to the square - * of the initial residue avoid initial residues near 'sqrt(n)'. - * Such residues are trivial or semi-trivial as well. - * - * Lower bound 2^(binsize*4/5) (4/5 the size of the smallest power of 2 >= n) - * is used because it avoids initial quadratic residues near 0, n^1/4, n^1/2, - * n^1/3, n^2/3 and n^3/4. For a trivial example, take the trivial case of - * selecting a quadratic residue of 1, 0 or n-1. Repeated squarings produce - * poor results. Similar but far less drastic results come from an - * initial selection that is near n^1/2 or other small fractional power. - * While the above initial quadratic residue range range allows for - * powers of n such as n^3/7, n^5/6, these powers are more complex and - * produce less obvious patterns when squared mod n. - * - * The upper bound of 2^(binsize-2) allows one to avoid initial quadratic - * residues near 'n'. Since n could be as small as 2^(binsize-1)+1, we - * must use the next lower power of 2: 2^(binsize-2) to be sure that we - * avoid initial quadratic residues near n. - * - * Taking some care to select a good initial residue helps eliminate cheap - * search attacks. It is true that a subsequent residue could be one of the - * residues that we would first avoid. However such an occurrence will - * happen after the generator is well underway and any such seed information - * has been lost. - * - * The size of Blum modulus 'n=p*q' was taken to be > 2^1024, or 1025 bits - * (309 digits) long. As if Jan 1996, the upper reach of the state of - * the art for factoring general numbers was around 2^512. We selected - * 2^1024 because it was twice that size and would hopefully remain well - * beyond the reach of Number Theory and CPU power for some time. - * - * Not being able to factor 'n=p*q' into 'p' and 'q' does not directly - * improve the quality Blum generator. On the other hand, it does - * improve the security of it. - * - * The number of bits produced each cycle for a given Blum modulus 'n' - * is int(log2(log2(n))). Thus for 2^1024 <= n < 2^2048, 10 bits are - * produced. For optimal performance, we use a Blum modulus that is - * slightly larger than 2^(2^x) to produce 'x' bits at a time. - * - * The lengths of the two Blum probable primes 'p' and 'q' used to make up - * the default Blum modulus 'n=p*q' differ slightly to avoid certain - * factorization attacks that work on numbers that are a perfect square, - * or where the two primes are nearly the same. I elected to have the - * sizes differ by up to 6% of the product size to avoid such attacks. - * Clearly one does not want the size of the two factors to differ - * by a large percentage: p=3 and q large would result in a easy - * to factor Blum modulus. Thus we select sizes that differ by - * up to 6% but not (significantly) greater than 6%. - * - * Again, the ability (or lack thereof) to factor 'n=p*q' does not - * directly relate to the strength of the Blum generator. We - * selected n=p*q > 2^1024 mainly because 1024 was a power of 2. - * Secondly 1024 the first power of 2 beyond 512 which bit size at - * or near the general factor limit a of Jan 1996. - * - * Using the '6% rule' above, a Blum modulus n=p*q > 2^1024 would have two - * Blum factors p > 2^482 and q > 2^542. This is because 482+542 = 1024. - * The difference 542-482 is ~5.86% of 1024, and is the largest difference - * that is < 6%. - * - * The default Blum modulus is the product of two Blum probable primes - * that were selected by the Rand Book of Random Numbers. Using the '6% rule', - * a default Blum modulus n=p*q > 2^1024 would be satisfied if p were - * 146 decimal digits and q were 164 decimal digits in length. We restate - * the sizes in decimal digits because the Rand Book of Random Numbers is a - * book of decimal digits. Using the first 146 rand digits as a - * starting search point for 'p', and the next 164 digits for a starting - * search point for 'q'. - * - * (* - * * setup the search points (lines split for readability) - * *) - * ip = 10097325337652013586346735487680959091173929274945 - * 37542048056489474296248052403720636104020082291665 - * 0842268953196450930323209025601595334764350803; - * iq = 36069901902529093767071538311311658867674397044362 - * 76591280799970801573614764032366539895116877121717 - * 68336606574717340727685036697361706581339885111992 - * 91703106010805; - * - * (* - * * find the first Blum prime - * *) - * fp = int((ip-1)/2); - * do { - * fp = nextcand(fp+2, 25, 0, 3, 4); - * p = 2*fp+1; - * } while (ptest(p, 25) == 0); - * - * (* - * * find the 2nd Blum prime - * *) - * fq = int((iq-1)/2); - * do { - * fq = nextcand(fq+2, 25, 0, 3, 4); - * q = 2*fq+1; - * } while (ptest(q, 25) == 0); - * - * The above script produces the Blum probable primes and initial quadratic - * residue (line wrapped for readability): - * - * p = 0x33c08d08248479497fe557b0e013b1beb51957cb441840f95d199e40fa9 - * 19faee2444d687775cb391bc703d710bd05f0cb0670b0bd49430ec8f9393e - * 7 - * - * q = 0xa05970f94cdf85f9773f7772636d591c0575bf5873299b4f48f873529f8 - * 85e91577802c65d629e809e797d130254afb7b1e8a4d7afe4f18facec41c2 - * 7f2bcfa1496e53a7 - * - * These Blum primes were found after 43m 56s of CPU time on a 150 Mhz IP22 - * R4400 version 5.0 processor. The first Blum prime 'p' was 411284 higher - * than the initial search value 'ip'. The second Blum prime 'q' was 87282 - * higher than the initial starting 'iq'. - * - * The product of the two Blum primes results in a 1026 bit Blum modulus of: - * - * n = 0x206a6cecc22e947050ffcf5eb53742e0a85433800fcaab4452df182bccf - * 72b874f3abaf118b29d64a859cd9c1465796a1cdf061f9bf3374443da6e1c - * fc63b7a7bd90dad9a3853642820ab4664a82ae1951779f3d1af9a70bedfd4 - * abcd89cdc200cbb917c1f7881fc900163d7a84f5e8e53d5bc5918590c15a4 - * 45430bbee7b60b1 - * - * The selection if the initial quadratic residue comes from the next - * unused digits of the Rand Book of Random Numbers. Now the two initial - * search values 'ip' and 'iq' used above needed the first 146 digits and - * the next 164 digits. Thus we will skip the first 146+164=310 digits - * and begin to build in initial search value for a quadratic residue (most - * significant digit first) from the Rand Book of Numbers digits until we - * have a value that is within the range: - * - * [2^(binsize*4/5), 2^(binsize-2)) - * - * where 2^(binsize-1) < n=p*q <= 2^binsize. Here, binsize is the - * smallest power of 2 >= n=p*q. Using this method, we arrive at an - * initial search value for the quadratic residue (wrapped for readability): - * - * ir = 45571824063530342614867990743923403097328526977602 - * 02051656926866574818730538524718623885796357332135 - * 05325470489055357548284682870983491256247379645753 - * 03529647783580834282609352034435273884359852017767 - * 14905686072210940558609709343350500739981180505431 - * 39808277325072568248294052420152775678518345299634 - * 06288980 - * - * using the next 308 digits from the Rand Book of Random Numbers. The - * (310+309)th digit results in an 'ir' that is outside the range noted above. - * - * Using pmod(ir, 2, n), we arrive at the initial quadratic residue of the - * default Blum generator: - * - * r = 0x1455b0e84ea73df591501002a7ff7855ef114f4ab34114f7e78208179a7 - * 8b722591126b68629b8e840ef5408f7d46db41b438fba4bfd69a6fa7635ab - * fbbfde64a198d62cfab4f03f43fb1f402c63202c7beb0b023034f27c6729b - * 672fc0ac85e14c610137e7766c67f1ea9cf75e0d60339e254065642e37b7f - * 4b9462d0687e467 - * - * In the above process, we selected primes of the form: - * - * 2*x + 1 x is also prime - * - * because Blum generators with modulus 'n=p*q' have a period: - * - * lambda(n) = lcm(factors of p-1 & q-1) - * - * since 'p' and 'q' are both odd, 'p-1' and 'q-1' have 2 as - * a factor. The calc script above ensures that '(p-1)/2' and - * '(q-1)/2' are probable prime, thus maximizing the period - * of the default generator to: - * - * lambda(n) = lcm(2,2,fp,fq) = 2*fp*fq = ~2*(p/2)*(q/2) = ~n/2 - * - * The process above resulted in a default generator Blum modulus n > 2^1024 - * with period of at least 2^1023 bits. To be exact, the period of the - * default Blum generator is: - * - * 0x9edee4226e56e1ba24e6b20180648967ae10bba409a1a1975e95c9c4be0dc9b7 - * 4af2d44bd15a117f6a108d043418c88957f4a3e2c10c3267b44332c7445b6a0c - * dcdc2ebefec6f8fa48aff8c9867769c4bfa790acba7e7aaa4b90bc2bff5ba65f - * 9e652919cfc51edd706b52c884cf56e8fbd378c1f561c651a9f7000180481e0d2 - * - * which is approximately: - * - * ~1.785 * 10^309 - * - * This period is more than long enough for computationally tractable tasks. - * - **** + ****************************************************************************** * * FOR THE PARANOID: * @@ -1117,135 +355,6 @@ * it. No extra security is gained or reduced by using the randreseed64() * process. The meaning of seeds are exchanged, but not lost or favored * (used by more than one input seed). - * - * One could take issue with the above script that produced a 1028 bit - * Blum modulus. As far as I know, 310 digits (1028 bits) is beyond the - * state of the art of Number Theory and Computation as of 01 Jan 96. - * It is possible in the future that 310 digit products of two primes could - * come within reach of factoring in the next few years, but so what? - * If you are truly paranoid, why would you want to use the default seed, - * which is well known? - * - * If all the above fails to pacify the truly paranoid, then one may - * select your own modulus and initial quadratic residue by calling: - * - * srandom(s, n); - * - * Of course, you will need to select a correct Blum modulus 'n' as the - * product of two Blum primes (both 3 mod 4) and with a long period (where - * lcm(factors of one less than the two Blum primes) is large) and an - * initial quadratic residue 's' that is hard to guess (a large value - * from the range [n^(4/5), n/2) selected at random. - * - * A simple way to seed the generator would be to: - * - * config("srandom", 0); - * srandom(s, nextcand(ip,25,0,3,4)*nextcand(iq,25,0,3,4)) - * - * where 'ip' and 'iq' are large integers that are unlikely to be 'guessed' - * and where they are selected randomly from the [2^(binsize*4/5), - * 2^(binsize-2)) where 2^(binsize-1) < n=p*q <= 2^binsize. - * - * Of course you can increase the '25' value if 1 of 4^25 odds of a - * non-prime are too probable for you. The '0' means don't skip any - * tests* and the final '3,4' means to select only Blum candidates. - * The config("srandom", 0) call turns off srandom checks on the 'n'' - * argument. This is OK to do in the above case because the nextcand() - * calls ensure proper Blum prime selection. - * - * The problem with the above call is that the period of the Blum generator - * could be small if 'p' and 'q' have lots of small prime factors in common. - * - * A better way to do seed the Blum generator yourself is to use the - * seedrandom(seed1, seed2, size [,tests]) function from "seedrandom.cal" - * with the args: - * - * seed1 - seed rand() to search for 'p', select from [2^64, 2^308) - * seed2 - seed rand() to search for 'q', select from [2^64, 2^308) - * size - minimum bit size of the Blum modulus 'n=p*q' - * tests - optional arg for number of pseudo prime tests (default is 25) - * - * The seedrandom() function ensures that the Blum generator produced - * has a maximal period. - * - * The following call will seed the Blum generator to an identical state - * produced by srandom(0): - * - * seedrandom(10097325337652013586346735487680959091173929274945, - * 37542048056489474296248052403720636104020082291665, - * 1024) - * - * The seedrandom() function in seedrandom.cal makes use of the rand() - * additive 55 generator. If you object to using rand(), you could - * substitute your own generator (by rewriting the function). - * - * Last, one could use some external random source to select starting - * search points for 'p', 'q' and the quadratic residue. One way to - * do this is: - * - * fp = int((ip-1)/2); - * do { - * fp = nextcand(fp+2, tests, 0, 3, 4); - * p = 2*fp+1; - * } while (ptest(p, tests) == 0); - * fq = int((iq-1)/2); - * do { - * fq = nextcand(fq+2, tests, 0, 3, 4); - * q = 2*fq+1; - * } while (ptest(q, tests) == 0); - * srandom(pmod(ir,2,p*q), p*q); - * - * where 'tests' is the number of pseudo prime tests that a candidate must - * pass before being considered a probable prime (must be >0, perhaps 25), and - * where 'ip' is the initial search location for the Blum prime 'p', and - * where 'iq' is the initial search location for the Blum prime 'q', and - * where 'ir' is the initial Blum quadratic residue generator. The 'ir' - * value should be a random value in the range [2^(binsize*4/5), 2^(binsize-2)) - * where 2^(binsize-1) < n=p*q <= 2^binsize. - * - * Your external generator would need to generate 'ip', 'iq' and 'ir'. - * While any value for 'ip' and 'iq will do (provided that their product - * is large enough to meet your modulus needs), 'ir' should be selected - * to avoid values near 0 or near 'n' (or ip*iq). - * - * The Blum moduli used with the pre-defined generators (via the call - * srandom(seed, 0 0, n == NULL: - * - * Seed the an internal additive 55 shuffle generator, and use it - * to produce an initial quadratic residue in the range: - * - * [2^(binsize*4/5), 2^(binsize-2)) - * - * where 2^(binsize-1) < n <= 2^binsize and 'n' is the current Blum - * modulus. Here, binsize is the smallest power of 2 >= n. - * - * The follow calc script produces an equivalent effect: - * - * cur_state = srand(seed); - * binsize = highbit(n)+1; (* n is the current Blum modulus *) - * r = pmod(rand(1<= 1007: - * - * If 'n' passes the tests (if applicable) specified by the "srandom" - * config value, it becomes the Blum modulus. Any internally buffered - * random bits are flushed. - * - * The initial quadratic residue 'r', is selected as if the following - * was executed: - * - * (* set Blum modulus to newn if allowed by "srandom" config value *) - * (* and then set the initial quadratic residue by the next call *) - * srandom(n % 2^309); - * - * The first srand() call seeds the additive 55 shuffle generator - * with the lower 309 bits of n. In actual practice, calc uses - * an independent internal rand() state value. - * - * seed > 0, n >= 1007: - * - * If 'n' passes the tests (if applicable) specified by the "srandom" - * config value, it becomes the Blum modulus. Once the Blum modulus - * is set, seed is used to seed an internal Additive 55 generator - * state which in turn is used to set the initial quadratic residue. - * - * While not as efficient, this call is equivalent to: - * - * srandom(0, n); - * srandom(seed); - * - * seed < 0, n >= NULL: - * - * Reserved for future use. - * - * any seed, 20 < n < 1007: - * - * Reserved for future use. - * - * any seed, n < 0: - * - * Reserved for future use. - * - * seed == 0, 0 < n <= 20: - * - * Seed with one of the predefined Blum moduli. (see the comments - * near the top under the section 'INITIALIZATION AND SEEDS') - * - * seed > 0, 0 < n <= 20: - * - * Use the same pre-defined Blum moduli 'n' noted above but use 'seed' - * to find a different quadratic residue 'r'. - * - * While not as efficient, this call is equivalent to: - * - * srandom(0, n); - * srandom(seed); - * - * seed < 0, 0 < n <= 20: - * - * Use the same pre-defined Blum moduli 'n' noted above but use '-seed' - * to compute a different quadratic residue 'r'. - * - * This call has the same effect as: - * - * srandom(0, n) - * - * followed by the setting of the quadratic residue 'r' as follows: - * - * r = pmod(seed, 2, n) - * - * where 'n' is the Blum moduli generated by 'srandom(0,newn)' and - * 'r' is the new quadratic residue. - * - * given: - * pseed - seed of the generator or NULL - * n - ptr to n (Blum modulus), or NULL - * - * returns: - * previous Blum state - */ -/*XXX - use them*/ -/*ARGSUSED*/ -RANDOM * -zsrandom(CONST ZVALUE seed, CONST ZVALUE *n) -{ - RANDOM *ret; /* previous Blum state */ - - /* - * initialize state if first call - */ - if (!blum.seeded) { - blum = init_blum; - zcopy(*(init_blum.n), blum.n); - zcopy(*(init_blum.r), blum.r); - blum.seeded = 1; - } - - /* - * save the current state to return later - */ - ret = (RANDOM *)malloc(sizeof(RANDOM)); - if (ret == NULL) { - math_error("cannot allocate RANDOM state"); - /*NOTREACHED*/ - } - /* move the ZVALUES over to ret */ - *ret = blum; - - - /* XXX - finish this function */ - - /* - * return the previous state - */ - return ret; -} - - /* * zsetrand - set the a55 generator state * @@ -2589,60 +1024,6 @@ zsetrand(CONST RAND *state) } -/* - * zsetrandom - set the Blum generator state - * - * given: - * state - the state to copy - * - * returns: - * previous RANDOM state - */ -RANDOM * -zsetrandom(CONST RANDOM *state) -{ - RANDOM *ret; /* previous Blum state */ - - /* - * initialize state if first call - */ - if (!blum.seeded) { - blum = init_blum; - zcopy(*(init_blum.n), blum.n); - zcopy(*(init_blum.r), blum.r); - blum.seeded = 1; - } - - /* - * save the current state to return later - */ - ret = (RANDOM *)malloc(sizeof(RANDOM)); - if (ret == NULL) { - math_error("cannot allocate RANDOM state"); - /*NOTREACHED*/ - } - /* move the ZVALUES over to ret */ - *ret = blum; - - /* - * load the new state - */ - if (state != NULL) { - blum.seeded = 0; /* avoid being caught while copying */ - blum.bits = state->bits; - blum.buffer = state->buffer; - zcopy(*(state->n), blum.n); - zcopy(*(state->r), blum.r); - blum.seeded = 1; - } - - /* - * return the previous state - */ - return ret; -} - - /* * slotcp - copy up to 64 bits from a 64 bit array of FULLs to some HALFs * @@ -2915,7 +1296,7 @@ slotcp64(BITSTR *bitstr, FULL *src) /* - * zrandskip - skip s bits + * zrandskip - skip s a55 bits * * given: * count - number of bits to be skipped @@ -3041,6 +1422,10 @@ zrandskip(long cnt) /* * zrand - crank the a55 generator for some bits * + * We will load the ZVALUE with random bits starting from the + * most significant and ending with the lowest bit in the + * least significant HALF. + * * given: * count - number of bits required * res - where to place the random bits as ZVALUE @@ -3048,7 +1433,6 @@ zrandskip(long cnt) void zrand(long cnt, ZVALUE *res) { - long hlen; /* length of ZVALUE in HALFs */ BITSTR dest; /* destination bit string */ int trans; /* bits transfered */ int indx; /* shuffle entry index */ @@ -3082,17 +1466,16 @@ zrand(long cnt, ZVALUE *res) /* * allocate storage */ - hlen = (cnt+BASEB-1)/BASEB; - res->len = (LEN)hlen; - res->v = alloc((LEN)hlen); - memset(res->v, 0, hlen*sizeof(HALF)); + res->len = (LEN)((cnt+BASEB-1)/BASEB); + res->v = alloc((LEN)((cnt+BASEB-1)/BASEB)); /* * dest bit string */ dest.len = (int)cnt; - dest.loc = res->v + (hlen-1); + dest.loc = res->v + (((cnt+BASEB-1)/BASEB)-1); dest.bit = (int)((cnt-1) % BASEB); + memset(res->v, 0, (LEN)((cnt+BASEB-1)/BASEB)*sizeof(HALF)); /* * load from buffer first @@ -3223,7 +1606,7 @@ zrand(long cnt, ZVALUE *res) /* - * zrandrange - generate a random value in the range [low, high) + * zrandrange - generate an a55 random value in the range [low, high) * * given: * low - low value of range @@ -3287,7 +1670,7 @@ zrandrange(CONST ZVALUE low, CONST ZVALUE high, ZVALUE *res) /* - * irand - generate a random long in the range [0, s) + * irand - generate an a55 random long in the range [0, s) * * given: * s - limit of the range @@ -3347,51 +1730,6 @@ randcopy(CONST RAND *state) } -/* - * randomcopy - make a copy of a Blum state - * - * given: - * state - the state to copy - * - * returns: - * a malloced copy of the state - */ -RANDOM * -randomcopy(CONST RANDOM *state) -{ - RANDOM *ret; /* return copy of state */ - - /* - * malloc state - */ - ret = (RANDOM *)malloc(sizeof(RANDOM)); - if (ret == NULL) { - math_error("can't allocate RANDOM state"); - /*NOTREACHED*/ - } - - /* - * clone data - */ - *ret = *state; - if (state->r->v == NULL) { - ret->r->v = NULL; - } else { - zcopy(*(state->r), ret->r); - } - if (state->n->v == NULL) { - ret->n->v = NULL; - } else { - zcopy(*(state->n), ret->n); - } - - /* - * return copy - */ - return ret; -} - - /* * randfree - free an a55 state * @@ -3406,25 +1744,6 @@ randfree(RAND *state) } -/* - * randomfree - free a Blum state - * - * given: - * state - the state to free - */ -void -randomfree(RANDOM *state) -{ - /* free the values */ - state->seeded = 0; - zfree(*state->n); - zfree(*state->r); - - /* free it */ - free(state); -} - - /* * randcmp - compare two a55 states * @@ -3444,19 +1763,14 @@ randcmp(CONST RAND *s1, CONST RAND *s2) if (!s1->seeded) { if (!s2->seeded) { /* uninitialized == uninitialized */ - return TRUE; + return FALSE; } else { /* uninitialized only equals default state */ return randcmp(s2, &init_a55); } } else if (!s2->seeded) { - if (!s1->seeded) { - /* uninitialized == uninitialized */ - return TRUE; - } else { - /* uninitialized only equals default state */ - return randcmp(s1, &init_a55); - } + /* uninitialized only equals default state */ + return randcmp(s1, &init_a55); } /* compare states */ @@ -3464,70 +1778,6 @@ randcmp(CONST RAND *s1, CONST RAND *s2) } -/* - * randomcmp - compare two Blum states - * - * given: - * s1 - first state to compare - * s2 - second state to compare - * - * return: - * TRUE if states differ - */ -BOOL -randomcmp(CONST RANDOM *s1, CONST RANDOM *s2) -{ - /* - * assume uninitialized state == the default seeded state - */ - if (!s1->seeded) { - if (!s2->seeded) { - /* uninitialized == uninitialized */ - return TRUE; - } else { - /* uninitialized only equals default state */ - return randomcmp(s2, &post_init_blum); - } - } else if (!s2->seeded) { - /* uninitialized only equals default state */ - return randomcmp(s1, &post_init_blum); - } - - /* - * compare operating mask parameters - */ - if ((s1->loglogn != s2->loglogn) || (s1->mask != s2->mask)) { - return FALSE; - } - - /* - * compare bit buffer - */ - if ((s1->bits != s2->bits) || (s1->buffer != s2->buffer)) { - return FALSE; - } - - /* - * compare quadratic residues - */ - if (!zcmp(*(s1->r), *(s2->r))) { - return FALSE; - } - - /* - * compare moduli - */ - if (!zcmp(*(s1->n), *(s2->n))) { - return FALSE; - } - - /* - * they are equal - */ - return TRUE; -} - - /* * randprint - print an a55 state * @@ -3541,18 +1791,3 @@ randprint(CONST RAND *state, int flags) { math_str("RAND state"); } - - -/* - * randomprint - print a Blum state - * - * given: - * state - state to print - * flags - print flags passed from printvalue() in value.c - */ -/*ARGSUSED*/ -void -randomprint(CONST RANDOM *state, int flags) -{ - math_str("RANDOM state"); -} diff --git a/zrand.h b/zrand.h index abe7f1a..f675dd9 100644 --- a/zrand.h +++ b/zrand.h @@ -1,5 +1,5 @@ /* - * Copyright (c) 1996 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, @@ -35,35 +35,19 @@ * * chongo was here /\../\ */ - /* - * random number generator - see random.c for details + * random number generator - see zrand.c for details */ -#if !defined(ZRAND_H) -#define ZRAND_H + +#if !defined(__ZRAND_H__) +#define __ZRAND_H__ #include "value.h" #include "have_const.h" -/* - * BITSTR - string of bits within an array of HALFs - * - * This typedef records a location of a bit in an array of HALFs. - * Bit 0 in a HALF is assumed to be the least significant bit in that HALF. - * - * The most significant bit is found at (loc,bit). Bits of lesser - * significance may be found in previous bits and HALFs. - */ -typedef struct { - HALF *loc; /* half address of most significant bit */ - int bit; /* bit position within half of most significant bit */ - int len; /* length of string in bits */ -} BITSTR; - - /* * a55 generator defines * @@ -99,9 +83,9 @@ typedef struct { * * SLEN - length in FULLs of an additive 55 slot * - * SVAL(x,y) - form a 64 bit hex slot entry in the additive 55 table - * x: up to 8 hex digits without the leading 0x (upper half) - * y: up to 8 hex digits without the leading 0x (lower half) + * SVAL(a,b) - form a 64 bit hex slot entry in the additive 55 table + * a: up to 8 hex digits without the leading 0x (upper half) + * b: up to 8 hex digits without the leading 0x (lower half) * * NOTE: Due to a SunOS cc bug, don't put spaces in the SVAL call! * @@ -113,12 +97,6 @@ typedef struct { * * NOTE: Due to a SunOS cc bug, don't put spaces in the SHVAL call! * - * HVAL(x,y) - form an array of HALFs given 8 hex digits - * x: up to 4 hex digits without the leading 0x (upper half) - * y: up to 4 hex digits without the leading 0x (lower half) - * - * NOTE: Due to a SunOS cc bug, don't put spaces in the HVAL call! - * * SLOAD(s,i,z) - load table slot i from additive 55 state s with zvalue z * s: type RAND * i: type int, s.slot[i] slot index @@ -165,13 +143,11 @@ typedef struct { # define SLEN 1 /* a 64 bit slot can be held in a FULL */ # if defined(__STDC__) && __STDC__ != 0 -# define SVAL(x,y) (FULL)U(0x ## x ## y) +# define SVAL(a,b) (FULL)U(0x ## a ## b) # define SHVAL(a,b,c,d) (HALF)0x ## c ## d, (HALF)0x ## a ## b -# define HVAL(x,y) (HALF)(0x ## x ## y) # else -# define SVAL(x,y) (FULL)U(0x/**/x/**/y) +# define SVAL(a,b) (FULL)U(0x/**/a/**/b) # define SHVAL(a,b,c,d) (HALF)0x/**/c/**/d,(HALF)0x/**/a/**/b -# define HVAL(x,y) (HALF)(0x/**/x/**/y) # endif #define SLOAD(s,i,z) ((s).slot[i] = ztofull(z)) #define SADD(s,k,j) ((s).slot[k] += (s).slot[j]) @@ -191,18 +167,15 @@ typedef struct { # define SLEN 2 /* a 64 bit slot needs 2 FULLs */ # if defined(__STDC__) && __STDC__ != 0 -# define SVAL(x,y) (FULL)(0x ## y), (FULL)(0x ## x) -# define SHVAL(a,b,c,d) (HALF)0x ## d, (HALF)0x ## c, \ - (HALF)0x ## b, (HALF)0x ## a -# define HVAL(x,y) (HALF)(0x ## y), (HALF)(0x ## x) +# define SVAL(a,b) (FULL)0x##b, (FULL)0x##a +# define SHVAL(a,b,c,d) (HALF)0x##d, (HALF)0x##c, \ + (HALF)0x##b, (HALF)0x##a # else /* NOTE: Due to a SunOS cc bug, don't put spaces in the SVAL call! */ -# define SVAL(x,y) (FULL)(0x/**/y), (FULL)(0x/**/x) +# define SVAL(a,b) (FULL)0x/**/b, (FULL)0x/**/a /* NOTE: Due to a SunOS cc bug, don't put spaces in the SHVAL call! */ # define SHVAL(a,b,c,d) (HALF)0x/**/d, (HALF)0x/**/c, \ (HALF)0x/**/b, (HALF)0x/**/a - /* NOTE: Due to a SunOS cc bug, don't put spaces in the HVAL call! */ -# define HVAL(x,y) (HALF)(0x/**/y), (HALF)(0x/**/x) # endif #define SLOAD(s,i,z) {(s).slot[(i)<<1] = ztofull(z); \ (s).slot[1+((i)<<1)] = \ @@ -243,7 +216,7 @@ typedef struct { #else - /\../\ FULL_BITS is assumed to be SBITS or 2*SBITS /\../\ !!! + /\../\ FULL_BITS must be 32 or 64 /\../\ !!! #endif @@ -264,44 +237,6 @@ struct rand { }; -/* - * Blum generator state - * - * The size of the buffer implies that a turn of the quadratic residue crank - * will never yield more than the number of bits in a FULL. At worst - * this implies that a turn can yield no more than 32 bits. This implies that - * the lower bound on the largest modulus supported is 2^32 bits long. - */ -struct random { - int seeded; /* 1 => state has been seeded */ - int bits; /* number of unused bits in buffer */ - int loglogn; /* int(log2(log2(n))), bits produced per turn */ - HALF buffer; /* unused random bits from previous call */ - HALF mask; /* mask for the log2(log2(n)) lower bits of r */ - ZVALUE *n; /* Blum modulus */ - ZVALUE *r; /* Blum quadratic residue */ -}; - - -/* - * Blum constants - */ -#define BLUM_PREGEN 20 /* number of non-default predefined Blum generators */ - - -/* - * Blum random config constants - */ -#define BLUM_CFG_MIN BLUM_CFG_NOCHECK -#define BLUM_CFG_NOCHECK 0 /* no checks are performed */ -#define BLUM_CFG_1MOD4 1 /* require 1 mod 4 */ -#define BLUM_CFG_1MOD4_PTEST0 2 /* require 1 mod 4 and ptest(n,0) */ -#define BLUM_CFG_1MOD4_PTEST1 3 /* require 1 mod 4 and ptest(n,1) */ -#define BLUM_CFG_1MOD4_PTEST25 4 /* require 1 mod 4 and ptest(n,25) */ -#define BLUM_CFG_MAX BLUM_CFG_1MOD4_PTEST25 -#define BLUM_CFG_DEFAULT BLUM_CFG_1MOD4_PTEST1 /* default config value */ - - /* * a55 generator function declarations */ @@ -317,14 +252,4 @@ extern BOOL randcmp(CONST RAND *s1, CONST RAND *s2); extern void randprint(CONST RAND *state, int flags); -/* - * Blum generator function declarations - */ -extern RANDOM *zsrandom(CONST ZVALUE seed, CONST ZVALUE *newn); -extern RANDOM *zsetrandom(CONST RANDOM *state); -extern RANDOM *randomcopy(CONST RANDOM *random); -extern void randomfree(RANDOM *random); -extern BOOL randomcmp(CONST RANDOM *s1, CONST RANDOM *s2); -extern void randomprint(CONST RANDOM *state, int flags); - -#endif /* ZRAND_H */ +#endif /* !__ZRAND_H__ */ diff --git a/zrandom.c b/zrandom.c new file mode 100644 index 0000000..c401b44 --- /dev/null +++ b/zrandom.c @@ -0,0 +1,2498 @@ +/* + * 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, + * provided that the above copyright, this permission notice and text + * this comment, 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. + * + * Prior to calc 2.9.3t9, these routines existed as a calc library called + * cryrand.cal. They have been rewritten in C for performance as well + * as to make them available directly from libcalc.a. + * + * Comments, suggestions, bug fixes and questions about these routines + * are welcome. Send EMail to the address given below. + * + * Happy bit twiddling, + * + * Landon Curt Noll + * + * chongo@toad.com + * ...!{pyramid,sun,uunet}!hoptoad!chongo + * + * chongo was here /\../\ + */ + +/* + * AN OVERVIEW OF THE FUNCTIONS: + * + * This module contains a Blum-Blum-Shub generator: + * + * We refer to this generator as the Blum generator. + * + * This generator is described in the papers: + * + * Blum, Blum, and Shub, "Comparison of Two Pseudorandom Number + * Generators", in Chaum, D. et. al., "Advances in Cryptology: + * Proceedings Crypto 82", pp. 61-79, Plenum Press, 1983. + * + * Blum, Blum, and Shub, "A Simple Unpredictable Pseudo-Random + * Number Generator", SIAM Journal of Computing, v. 15, n. 2, + * 1986, pp. 364-383. + * + * U. V. Vazirani and V. V. Vazirani, "Trapdoor Pseudo-Random + * Number Generators with Applications to Protocol Design", + * Proceedings of the 24th IEEE Symposium on the Foundations + * of Computer Science, 1983, pp. 23-30. + * + * U. V. Vazirani and V. V. Vazirani, "Efficient and Secure + * Pseudo-Random Number Generation", Proceedings of the 24th + * IEEE Symposium on the Foundations of Computer Science, + * 1984, pp. 458-463. + * + * U. V. Vazirani and V. V. Vazirani, "Efficient and Secure + * Pseudo-Random Number Generation", Advances in Cryptology - + * Proceedings of CRYPTO '84, Berlin: Springer-Verlag, 1985, + * pp. 193-202. + * + * Sciences 28, pp. 270-299. + * + * Bruce Schneier, "Applied Cryptography", John Wiley & Sons, + * 1st edition (1994), pp 365-366. + * + * This generator is considered 'strong' in that it passes all + * polynomial-time statistical tests. The sequences produced + * are random in an absolutely precise way. There is absolutely + * no better way to predict the sequence than by tossing a coin + * (as with TRULY random numbers) EVEN IF YOU KNOW THE MODULUS! + * Furthermore, having a large chunk of output from the sequence + * does not help. The BITS THAT FOLLOW OR PRECEDE A SEQUENCE + * ARE UNPREDICTABLE! + * + * Of course the Blum modulus should have a long period. The default + * Blum modulus as well as the compiled in Blum moduli have very long + * periods. When using your own Blum modulus, a little care is needed + * to avoid generators with very short periods. (see below) + * + * To compromise the generator, an adversary must either factor the + * modulus or perform an exhaustive search just to determine the next + * (or previous) bit. If we make the modulus hard to factor + * (such as the product of two large well chosen primes) breaking + * the sequence could be intractable for todays computers and methods. + * + ****************************************************************************** + * + * GOALS: + * + * The goals of this package are: + * + * all magic numbers are explained + * + * I distrust systems with constants (magic numbers) and tables + * that have no justification (e.g., DES). I believe that I have + * done my best to justify all of the magic numbers used. + * + * full documentation + * + * You have this source file, plus background publications, + * what more could you ask? + * + * large selection of seeds + * + * Seeds are not limited to a small number of bits. A seed + * may be of any size. + * + * the strength of the generators may be tuned to meet the need + * + * By using the appropriate seed and other arguments, one may + * increase the strength of the generator to suit the need of + * the application. One does not have just a few levels. + * + * Even though I have done my best to implement a good system, you still + * must use these routines your own risk. + * + * Share and enjoy! :-) + */ + +/* + * ON THE GENERATOR: + * + * The Blum generator is the best generator in this package. It + * produces a cryptographically strong pseudo-random bit sequence. + * Internally, a fixed number of bits are generated after each + * generator iteration. Any unused bits are saved for the next call + * to the generator. The Blum generator is not too slow, though + * seeding the generator via srandom(seed,plen,qlen) can be slow. + * Shortcuts and pre-defined generators have been provided for this reason. + * Use of Blum should be more than acceptable for many applications. + * + * The Blum generator as the following calc interfaces: + * + * random(min, max) (where min < max) + * + * Print a Blum generator random value over interval [min,max). + * + * random() + * + * Same as random(0, 2^64). Print 64 bits. + * + * random(lim) (where 0 > lim) + * + * Same as random(0, lim). + * + * randombit(x) (where x > 0) + * + * Same as random(0, 2^x). Print x bits. + * + * randombit(skip) (where skip < 0) + * + * Skip skip random bits and return the bit skip count (-skip). + */ + +/* + * INITIALIZATION AND SEEDS: + * + * All generators come already seeded with precomputed initial constants. + * Thus, it is not required to seed a generator before using it. + * + * The Blum generator may be initialized and seeded via srandom(). + * + * Using a seed of '0' will reload generators with their initial states. + * + * srandom(0) restore Blum generator to the initial state + * + * The above single arg calls are fairly fast. + * + * The call: + * + * srandom(seed, newn) + * + * is fast when the config value "srandom" is 0, 1 or 2. + * + * Optimal seed range for the Blum generator: + * + * There is no limit on the size of a seed. On the other hand, + * in most cases the seed is taken modulo the Blum modulus. + * Using a seed that is too small (except for 0) results in + * an internal generator be used to increase its size. + * + * It is faster to use seeds that are in the half open internal + * [sqrt(n), n) where n is the Blum modulus. + * + * The default Blum modulus is 260 bits long, so when using a the + * single arg call, a seed of between 128 and 256 bits is reasonable. + * + ****************************************************************************** + * + * srandom(seed) + * + * We attempt to set the quadratic residue and possibly the Blum modulus. + * + * Any internally buffered random bits are flushed. + * + * The Blum modulus is only set if seed == 0. + * + * The initial quadratic residue is set according to the seed + * arg as defined below. + * + * seed >= 2^32: + * ------------- + * Use seed to compute a new quadratic residue for use with + * the current Blum modulus. We will successively square mod Blum + * modulus until we get a smaller value (modulus wrap). + * + * The follow calc script produces an equivalent effect: + * + * n = default_modulus; (* n is the new Blum modulus *) + * r = seed; + * do { + * last_r = r; + * r = pmod(last_r, 2, n); + * } while (r > last_r); (* r is the new quadratic residue *) + * + * NOTE: The Blum modulus is not set by this call. + * + * 0 < seed < 2^32: + * ---------------- + * Reserved for future use. + * + * seed == 0: + * ---------- + * Restore the initial state and modulus of the Blum generator. + * After this call, the Blum generator is restored to its initial + * state after calc started. + * + * The Blum prime factors of the modulus have been disclosed (see + * "SOURCE OF MAGIC NUMBERS" below). If you want to use moduli that + * have not been disclosed, use srandom(seed, newn) with the + * appropriate args as noted below. + * + * The follow calc script produces an equivalent effect: + * + * n = default_modulus; (* as used by the initial state *) + * r = default_residue; (* as used by the initial state *) + * + * NOTE: The Blum modulus is changed by this call. + * + * seed < 0: + * --------- + * Reserved for future use. + * + ****************************************************************************** + * + * srandom(seed, newn) + * + * We attempt to set the Blum modulus and quadratic residue. + * Any internally buffered random bits are flushed. + * + * If newn == 1 mod 4, then we will assume that it is the + * product of two Blum primes (primes == 3 mod 4) and use it + * as the Blum modulus. + * + * The new quadratic residue is set according to the seed + * arg as defined below. + * + * seed >= 2^32, newn >= 2^32: + * --------------------------- + * Assuming that 'newn' == 3 mod 4, then we will use it as + * the Blum modulus. + * + * We will use the seed arg to compute a new quadratic residue. + * We will successively square it mod Blum modulus until we get + * a smaller value (modulus wrap). + * + * The follow calc script produces an equivalent effect: + * + * if (newn % 4 == 1) { + * n = newn; (* n is the new Blum modulus *) + * r = seed; + * do { + * last_r = r; + * r = pmod(last_r, 2, n); + * } while (r > last_r); (* r is the new quadratic residue *) + * } else { + * quit "newn (2nd arg) must be 3 mod 4"; + * } + * + * 0 < seed < 2^32, newn >= 2^32: + * ------------------------------ + * Reserved for future use. + * + * seed == 0, newn >= 2^32: + * ------------------------ + * Assuming that 'newn' == 3 mod 4, then we will use it as + * the Blum modulus. + * + * The initial quadratic residue will be as if the default initial + * quadratic residue arg was given. + * + * The follow calc script produces an equivalent effect: + * + * srandom(default_residue, newn) + * + * or in other words: + * + * if (newn % 4 == 1) { + * n = newn; (* n is the new Blum modulus *) + * r = default_residue; (* as used by the initial state *) + * do { + * last_r = r; + * r = pmod(last_r, 2, n); + * } while (r > last_r); (* r is the new quadratic residue *) + * } else { + * quit "newn (2nd arg) must be 3 mod 4"; + * } + * + * seed < 0, newn >= 2^32: + * ----------------------- + * Reserved for future use. + * + * any seed, 20 < newn < 1007: + * --------------------------- + * Reserved for future use. + * + * seed >= 2^32, 0 < newn <= 20: + * ----------------------------- + * Set the Blum modulus to one of the the pre-defined Blum moduli. + * See below for the values of these pre-defined Blum moduli and how + * they were computed. + * + * We will use the seed arg to compute a new quadratic residue. + * We will successively square it mod Blum modulus until we get + * a smaller value (modulus wrap). + * + * The follow calc script produces an equivalent effect: + * + * n = n[newn]; (* n is new Blum modulus, see below *) + * r = seed; + * do { + * last_r = r; + * r = pmod(last_r, 2, n); + * } while (r > last_r); (* r is the new quadratic residue *) + * + * 0 < seed < 2^32, 0 < newn <= 20: + * -------------------------------- + * Reserved for future use. + * + * seed == 0, 0 < newn <= 20: + * -------------------------- + * Set the Blum modulus to one of the the pre-defined Blum moduli. + * The new quadratic residue will also be set to one of + * the pre-defined quadratic residues. + * + * The follow calc script produces an equivalent effect: + * + * srandom(r[newn], n[newn]) + * + * or in other words: + * + * n = n[newn]; (* n is the new Blum modulus, see below *) + * r = r[newn]; (* r is the new quadratic residue *) + * + * The pre-defined Blum moduli was computed by searching for Blum + * primes (primes == 3 mod 4) starting from new values that + * were selected by lavarand, a hardware random number generator. + * See the URL: + * + * http://lavarand.sgi.com + * XXX - This URL is not available on 17Feb97 ... but will be soon. + * + * for an explination of how the lavarand random number generator works. + * + * For a given newn, we select a given bit length. For 0 < newn <= 20, + * the bit length selected was by: + * + * bitlen = 2^(int((newn-1)/4)+7) + small_random_value; + * + * where small_random_value is also generated by lavarand. For + * 1 <= newn <= 16, small_random_value is a random value in [0,40). + * For 17 < newn <= 20, small_random_value is a random value in [0,120). + * Given two random integers generated by lavarand, we used the following + * to compute Blum primes: + * + * (* find the first Blum prime *) + * fp = int((ip-1)/2); (* ip was generated by lavarand *) + * do { + * fp = nextcand(fp+2, 25, 0, 3, 4); + * p = 2*fp+1; + * } while (ptest(p, 25) == 0); + * + * (* find the 2nd Blum prime *) + * fq = int((iq-1)/2); (* iq was generated by lavarand *) + * do { + * fq = nextcand(fq+2, 25, 0, 3, 4); + * q = 2*fq+1; + * } while (ptest(q, 25) == 0); + * + * (* compute the Blum modulus *) + * n[newn] = p * q; + * + * The pre-defined quadratic residues was also generated by lavarand. + * The value produced by lavarand was squared mod the Blum moduli + * that was previously computed. + * + * The purpose of these pre-defined Blum moduli is to provide users with + * an easy way to use a generator where the individual Blum primes used + * are not well known. True, these values are in some way "MAGIC", on + * the other hand that is their purpose! If this bothers you, don't + * use them. See the section "FOR THE PARANOID" below for details. + * + * The value 'newn' determines which pre-defined generator is used. + * For a given 'newn' the Blum modulus 'n[newn]' (product of 2 Blum + * (primes) and new quadratic residue 'r[newn]' is set as follows: + * + * newn == 1: (Blum modulus bit length 130) + * n[ 1] = 0x5049440736fe328caf0db722d83de9361 + * r[ 1] = 0xb226980f11d952e74e5dbb01a4cc42ec + * + * newn == 2: (Blum modulus bit length 137) + * n[ 2] = 0x2c5348a2555dd374a18eb286ea9353443f1 + * r[ 2] = 0x40f3d643446cd710e3e893616b21e3a218 + * + * newn == 3: (Blum modulus bit length 147) + * n[ 3] = 0x9cfd959d6ce4e3a81f1e0f2ca661f11d001f1 + * r[ 3] = 0xfae5b44d9b64ff5cea4f3e142de2a0d7d76a + * + * newn == 4: (Blum modulus bit length 157) + * n[ 4] = 0x3070f9245c894ed75df12a1a2decc680dfcc0751 + * r[ 4] = 0x20c2d8131b2bdca2c0af8aa220ddba4b984570 + * + * newn == 5: (Blum modulus bit length 257) + * n[ 5] = 0x2109b1822db81a85b38f75aac680bc2fa5d3fe1118769a0108b99e5e799 + * 166ef1 + * r[ 5] = 0x5e9b890eae33b792e821a9605f5df6db234f7b7d1e70aeed0e6c77c859e + * 2efa9 + * + * newn == 6: (Blum modulus bit length 259) + * n[ 6] = 0xa7bfd9d7d9ada2c79f2dbf2185c6440263a38db775ee732dad85557f1e1 + * ddf431 + * r[ 6] = 0x5e94a02f88667154e097aedece1c925ce1f3495d2c98eccfc5dc2e80c94 + * 04daf + * + * newn == 7: (Blum modulus bit length 286) + * n[ 7] = 0x43d87de8f2399ef237801cd5628643fcff569d6b0dcf53ce52882e7f602 + * f9125cf9ec751 + * r[ 7] = 0x13522d1ee014c7bfbe90767acced049d876aefcf18d4dd64f0b58c3992d + * 2e5098d25e6 + * + * newn == 8: (Blum modulus bit length 294) + * n[ 8] = 0x5847126ca7eb4699b7f13c9ce7bdc91fed5bdbd2f99ad4a6c2b59cd9f0b + * c42e66a26742f11 + * r[ 8] = 0x853016dca3269116b7e661fa3d344f9a28e9c9475597b4b8a35da929aae + * 95f3a489dc674 + * + * newn == 9: (Blum modulus bit length 533) + * n[ 9] = 0x39e8be52322fd3218d923814e81b003d267bb0562157a3c1797b4f4a867 + * 52a84d895c3e08eb61c36a6ff096061c6fd0fdece0d62b16b66b980f95112 + * 745db4ab27e3d1 + * r[ 9] = 0xb458f8ad1e6bbab915bfc01508864b787343bc42a8aa82d9d2880107e3f + * d8357c0bd02de3222796b2545e5ab7d81309a89baedaa5d9e8e59f959601e + * f2b87d4ed20d + * + * newn == 10: (Blum modulus bit length 537) + * n[10] = 0x25f2435c9055666c23ef596882d7f98bd1448bf23b50e88250d3cc952c8 + * 1b3ba524a02fd38582de74511c4008d4957302abe36c6092ce222ef9c73cc + * 3cdc363b7e64b89 + * r[10] = 0x66bb7e47b20e0c18401468787e2b707ca81ec9250df8cfc24b5ffbaaf2c + * f3008ed8b408d075d56f62c669fadc4f1751baf950d145f40ce23442aee59 + * 4f5ad494cfc482 + * + * newn == 11: (Blum modulus bit length 542) + * n[11] = 0x497864de82bdb3094217d56b874ecd7769a791ea5ec5446757f3f9b6286 + * e58704499daa2dd37a74925873cfa68f27533920ee1a9a729cf522014dab2 + * 2e1a530c546ee069 + * r[11] = 0x8684881cb5e630264a4465ae3af8b69ce3163f806549a7732339eea2c54 + * d5c590f47fbcedfa07c1ef5628134d918fee5333fed9c094d65461d88b13a + * 0aded356e38b04 + * + * newn == 12: (Blum modulus bit length 549) + * n[12] = 0x3457582ab3c0ccb15f08b8911665b18ca92bb7c2a12b4a1a66ee4251da1 + * 90b15934c94e315a1bf41e048c7c7ce812fdd25d653416557d3f09887efad + * 2b7f66d151f14c7b99 + * r[12] = 0xdf719bd1f648ed935870babd55490137758ca3b20add520da4c5e8cdcbf + * c4333a13f72a10b604eb7eeb07c573dd2c0208e736fe56ed081aa9488fbc4 + * 5227dd68e207b4a0 + * + * newn == 13: (Blum modulus bit length 1048) + * n[13] = 0x1517c19166b7dd21b5af734ed03d833daf66d82959a553563f4345bd439 + * 510a7bda8ee0cb6bf6a94286bfd66e49e25678c1ee99ceec891da8b18e843 + * 7575113aaf83c638c07137fdd3a76c3a49322a11b5a1a84c32d99cbb2b056 + * 671589917ed14cc7f1b5915f6495dd1892b4ed7417d79a63cc8aaa503a208 + * e3420cca200323314fc49 + * r[13] = 0xd42e8e9a560d1263fa648b04f6a69b706d2bc4918c3317ddd162cb4be7a + * 5e3bbdd1564a4aadae9fd9f00548f730d5a68dc146f05216fe509f0b8f404 + * 902692de080bbeda0a11f445ff063935ce78a67445eae5c9cea5a8f6b9883 + * faeda1bbe5f1ad3ef6409600e2f67b92ed007aba432b567cc26cf3e965e20 + * 722407bfe46b7736f5 + * + * newn == 14: (Blum modulus bit length 1054) + * n[14] = 0x5e56a00e93c6f4e87479ac07b9d983d01f564618b314b4bfec7931eee85 + * eb909179161e23e78d32110560b22956b22f3bc7e4a034b0586e463fd40c6 + * f01a33e30ede912acb86a0c1e03483c45f289a271d14bd52792d0a076fdfe + * fe32159054b217092237f0767434b3db112fee83005b33f925bacb3185cc4 + * 409a1abdef8c0fc116af01 + * r[14] = 0xf7aa7cb67335096ef0c5d09b18f15415b9a564b609913f75f627fc6b0c5 + * b686c86563fe86134c5a0ea19d243350dfc6b9936ba1512abafb81a0a6856 + * c9ae7816bf2073c0fb58d8138352b261a704b3ce64d69dee6339010186b98 + * 3677c84167d4973444194649ad6d71f8fa8f1f1c313edfbbbb6b1b220913c + * c8ea47a4db680ff9f190 + * + * newn == 15: (Blum modulus bit length 1055) + * n[15] = 0x97dd840b9edfbcdb02c46c175ba81ca845352ebe470be6075326a26770c + * ab84bfc0f2e82aa95aac14f40de42a0590445b902c2b8ebb916753e72ab86 + * c3278cccc1a783b3e962d81b80df03e4380a8fa08b0d86ed0caa515c196a5 + * 30e49c558ddb53082310b1d0c7aee6f92b619798624ffe6c337299bc51ff5 + * d2c721061e7597c8d97079 + * r[15] = 0xb8220703b8c75869ab99f9b50025daa8d77ca6df8cef423ede521f55b1c + * 25d74fbf6d6cc31f5ef45e3b29660ef43797f226860a4aa1023dbe522b1fe + * 6224d01eb77dee9ad97e8970e4a9e28e7391a6a70557fa0e46eca78866241 + * ba3c126fc0c5469f8a2f65c33db95d1749d3f0381f401b9201e6abd43d98d + * b92e808f0aaa6c3e2110 + * + * newn == 16: (Blum modulus bit length 1062) + * n[16] = 0x456e348549b82fbb12b56f84c39f544cb89e43536ae8b2b497d426512c7 + * f3c9cc2311e0503928284391959e379587bc173e6bc51ba51c856ba557fee + * 8dd69cee4bd40845bd34691046534d967e40fe15b6d7cf61e30e283c05be9 + * 93c44b6a2ea8ade0f5578bd3f618336d9731fed1f1c5996a5828d4ca857ac + * 2dc9bd36184183f6d84346e1 + * r[16] = 0xb0d7dcb19fb27a07973e921a4a4b6dcd7895ae8fced828de8a81a3dbf25 + * 24def719225404bfd4977a1508c4bac0f3bc356e9d83b9404b5bf86f6d19f + * f75645dffc9c5cc153a41772670a5e1ae87a9521416e117a0c0d415fb15d2 + * 454809bad45d6972f1ab367137e55ad0560d29ada9a2bcda8f4a70fbe04a1 + * abe4a570605db87b4e8830 + * + * newn == 17: (Blum modulus bit length 2062) + * n[17] = 0x6177813aeac0ffa3040b33be3c0f96e0faf97ca54266bfedd7be68494f7 + * 6a7a91144598bf28b3a5a9dc35a6c9f58d0e5fb19839814bc9d456bff7f29 + * 953bdac7cafd66e2fc30531b8d544d2720b97025e22b1c71fa0b2eb9a499d + * 49484615d07af7a3c23b568531e9b8507543362027ec5ebe0209b4647b7ff + * 54be530e9ef50aa819c8ff11f6d7d0a00b25e88f2e6e9de4a7747022b949a + * b2c2e1ab0876e2f1177105718c60196f6c3ac0bde26e6cd4e5b8a20e9f0f6 + * 0974f0b3868ff772ab2ceaf77f328d7244c9ad30e11a2700a120a314aff74 + * c7f14396e2a39cc14a9fa6922ca0fce40304166b249b574ffd9cbb927f766 + * c9b150e970a8d1edc24ebf72b72051 + * r[17] = 0x53720b6eaf3bc3b8adf1dd665324c2d2fc5b2a62f32920c4e167537284d + * a802fc106be4b0399caf97519486f31e0fa45a3a677c6cb265c5551ba4a51 + * 68a7ce3c29731a4e9345eac052ee1b84b7b3a82f906a67aaf7b35949fd7fc + * 2f9f4fbc8c18689694c8d30810fff31ebee99b1cf029a33bd736750e7fe0a + * 56f7e1d2a9b5321b5117fe9a10e46bf43c896e4a33faebd584f7431e7edbe + * bd1703ccee5771b44f0c149888af1a4264cb9cf2e0294ea7719ed6fda1b09 + * fa6e016c039aeb6d02a03281bcea8c278dd2a807eacae6e52ade048f58f2e + * b5193f4ffb9dd68467bc6f8e9d14286bfef09b0aec414c9dadfbf5c46d945 + * d147b52aa1e0cbd625800522b41dac + * + * newn == 18: (Blum modulus bit length 2074) + * n[18] = 0x68f2a38fb61b42af07cb724fec0c7c65378efcbafb3514e268d7ee38e21 + * a5680de03f4e63e1e52bde1218f689900be4e5407950539b9d28e9730e8e6 + * ad6438008aa956b259cd965f3a9d02e1711e6b344b033de6425625b6346d2 + * ca62e41605e8eae0a7e2f45c25119ef9eece4d3b18369e753419d94118d51 + * 803842f4de5956b8349e6a0a330145aa4cd1a72afd4ef9db5d8233068e691 + * 18ff4b93bcc67859f211886bb660033f8170640c6e3d61471c3b7dd62c595 + * b156d77f317dc272d6b7e7f4fdc20ed82f172fe29776f3bddf697fb673c70 + * defd6476198a408642ed62081447886a625812ac6576310f23036a7cd3c93 + * 1c96f7df128ad4ed841351b18c8b78629 + * r[18] = 0x4735e921f1ac6c3f0d5cda84cd835d75358be8966b99ff5e5d36bdb4be1 + * 2c5e1df70ac249c0540a99113a8962778dc75dac65af9f3ab4672b4c575c4 + * 9926f7f3f306fd122ac033961d042c416c3aa43b13ef51b764d505bb1f369 + * ac7340f8913ddd812e9e75e8fde8c98700e1d3353da18f255e7303db3bcbb + * eda4bc5b8d472fbc9697f952cfc243c6f32f3f1bb4541e73ca03f5109df80 + * 37219a06430e88a6e94be870f8d36dbcc381a1c449c357753a535aa5666db + * 92af2aaf1f50a3ddde95024d9161548c263973665a909bd325441a3c18fc7 + * 0502f2c9a1c944adda164e84a8f3f0230ff2aef8304b5af333077e04920db + * a179158f6a2b3afb78df2ef9735ea3c63 + * + * newn == 19: (Blum modulus bit length 2133) + * n[19] = 0x230d7ab23bb9e8d6788b252ad6534bdde276540721c3152e410ad4244de + * b0df28f4a6de063ba1e51d7cd1736c3d8410e2516b4eb903b8d9206b92026 + * 64cacbd0425c516833770d118bd5011f3de57e8f607684088255bf7da7530 + * 56bf373715ed9a7ab85f698b965593fe2b674225fa0a02ebd87402ffb3d97 + * 172acadaa841664c361f7c11b2af47a472512ee815c970af831f95b737c34 + * 2508e4c23f3148f3cdf622744c1dcfb69a43fd535e55eebcdc992ee62f2b5 + * 2c94ac02e0921884fe275b3a528bdb14167b7dec3f3f390cd5a82d80c6c30 + * 6624cc7a7814fb567cd4d687eede573358f43adfcf1e32f4ee7a2dc4af029 + * 6435ade8099bf0001d4ae0c7d204df490239c12d6b659a79 + * r[19] = 0x8f1725f21e245e4fc17982196605b999518b4e21f65126fa6fa759332c8 + * e27d80158b7537da39d001cc62b83bbef0713b1e82f8293dad522993f86d1 + * 761015414b2900e74fa23f3eaaa55b31cffd2e801fefb0ac73fd99b5d0cf9 + * a635c3f4c73d8892d36ad053fc17a423cdcbcf07967a8608c7735e287d784 + * ae089b3ddea9f2d2bb5d43d2ee25be346832e8dd186fc7a88d82847c03d1c + * 05ee52c1f2a51a85f733338547fdbab657cb64b43d44d41148eb32ea68c7e + * 66a8d47806f460cd6573b6ca1dd3eeaf1ce8db9621f1e121d2bb4a1878621 + * dd2dbdd7b5390ab06a5dcd9307d6662eb4248dff2ee263ef2ab778e77724a + * 14c62406967daa0d9ad4445064483193d53a5b7698ef473 + * + * newn == 20: (Blum modulus bit length 2166) + * n[20] = 0x4fd2b820e0d8b13322e890dddc63a0267e5b3a648b03276066a3f356d79 + * 660c67704c1be6803b8e7590ee8a962c8331a05778d010e9ba10804d661f3 + * 354be1932f90babb741bd4302a07a92c42253fd4921864729fb0f0b1e0a42 + * d66b6777893195abd2ee2141925624bf71ad7328360135c565064ee502773 + * 6f42a78b988f47407ba4f7996892ffdc5cf9e7ab78ac95734dbf4e3a3def1 + * 615b5b4341cfbf6c3d0a61b75f4974080bbac03ee9de55221302b40da0c50 + * ded31d28a2f04921a532b3a486ae36e0bb5273e811d119adf90299a74e623 + * 3ccce7069676db00a3e8ce255a82fd9748b26546b98c8f4430a8db2a4b230 + * fa365c51e0985801abba4bbcf3727f7c8765cc914d262fcec3c1d081 + * r[20] = 0x46ef0184445feaa3099293ee960da14b0f8b046fa9f608241bc08ddeef1 + * 7ee49194fd9bb2c302840e8da88c4e88df810ce387cc544209ec67656bd1d + * a1e9920c7b1aad69448bb58455c9ae4e9cd926911b30d6b5843ff3d306d56 + * 54a41dc20e2de4eb174ec5ac3e6e70849de5d5f9166961207e2d8b31014cf + * 35f801de8372881ae1ba79e58942e5bef0a7e40f46387bf775c54b1d15a14 + * 40e84beb39cd9e931f5638234ea730ed81d6fca1d7cea9e8ffb171f6ca228 + * 56264a36a2a783fd7ac39361a6598ed3a565d58acf1f5759bd294e5f53131 + * bc8e4ee3750794df727b29b1f5788ae14e6a1d1a5b26c2947ed46f49e8377 + * 3292d7dd5650580faebf85fd126ac98d98f47cf895abdc7ba048bd1a + * + * NOTE: The Blum moduli associated with 1 <= newn < 9 are subject + * to having their Blum moduli factored, depending in their size, + * by small PCs in a reasonable to large supercomputers/highly + * parallel processors over a long time. Their value lies in their + * speed relative the the default Blum generator. As of Jan 1997, + * the Blum moduli associated with 13 <= newn < 20 appear to + * be well beyond the scope of hardware and algorithms, + * and 9 <= newn < 12 might be factorable with extreme difficulty. + * + * The following table may be useful as a guide for how easy it + * is to factor the modulus: + * + * 1 <= newn <= 4 PC using ECM in a short amount of time + * 5 <= newn <= 8 Workstation using MPQS in a short amount of time + * 8 <= newn <= 12 High end supercomputer or high parallel processor + * using state of the art factoring over a long time + * 12 <= newn <= 16 Beyond Feb 1997 systems and factoring methods + * 17 <= newn <= 20 Well beyond Feb 1997 systems and factoring methods + * + * See the section titled 'FOR THE PARANOID' for more details. + * + * seed < 0, 0 < newn <= 20: + * ------------------------- + * Reserved for future use. + * + ****************************************************************************** + * + * srandom(seed, ip, iq, trials) + * + * We attempt to set the Blum modulus and quadratic residue. + * Any internally buffered random bits are flushed. + * + * Use the ip and iq args as starting points for Blum primes. + * The trials arg determines how many ptest cycles are performed + * on each candidate. + * + * The new quadratic residue is set according to the seed + * arg as defined below. + * + * seed >= 2^32, ip >= 2^16, iq >= 2^16: + * ------------------------------------- + * Set the Blum modulus by searching from the ip and iq search points. + * + * We will use the seed arg to compute a new quadratic residue. + * We will successively square it mod Blum modulus until we get + * a smaller value (modulus wrap). + * + * The follow calc script produces an equivalent effect: + * + * p = nextcand(ip-2, trials, 0, 3, 4); (* find the 1st Blum prime *) + * q = nextcand(iq-2, trials, 0, 3, 4); (* find the 2nd Blum prime *) + * n = p * q; (* n is the new Blum modulus *) + * r = seed; + * do { + * last_r = r; + * r = pmod(last_r, 2, n); + * } while (r > last_r); (* r is the new quadratic residue *) + * srandom(r, n); + * + * any seed, ip <= 2^16 or iq <= 2^16: + * ----------------------------------- + * Reserved for future use. + * + * 0 < seed < 2^32, any ip, any iq: + * -------------------------------- + * Reserved for future use. + * + * seed == 0, ip > 2^16, iq > 2^16: + * -------------------------------- + * Set the Blum modulus by searching from the ip and iq search points. + * If trials is omitted, 1 is assumed. + * + * The initial quadratic residue will be as if the default initial + * quadratic residue arg was given. + * + * The follow calc script produces an equivalent effect: + * + * srandom(default_residue, ip, iq, trials) + * + * or in other words: + * + * (* trials, if omitted, is assumed to be 1 *) + * p = nextcand(ip-2, trials, 0, 3, 4); (* find the 1st Blum prime *) + * q = nextcand(iq-2, trials, 0, 3, 4); (* find the 2nd Blum prime *) + * n = p * q; (* n is the new Blum modulus *) + * r = default_residue; (* as used by the initial state *) + * do { + * last_r = r; + * r = pmod(last_r, 2, n); + * } while (r > last_r); (* r is the new quadratic residue *) + * + * seed < 0, any ip, any iq: + * ------------------------- + * Reserved for future use. + * + ****************************************************************************** + * + * srandom() + * + * Return current Blum generator state. This call does not alter + * the generator state. + * + ****************************************************************************** + * + * srandom(state) + * + * Restore the Blum state and return the previous state. Note that + * the argument state is a random state value (israndom(state) is true). + * Any internally buffered random bits are restored. + * + * The states of the Blum generators can be saved by calling the seed + * function with no arguments, and later restored by calling the seed + * functions with that same return value. + * + * random_state = srandom(); + * ... generate random bits ... + * prev_random_state = srandom(random_state); + * ... generate the same random bits ... + * srandom() == prev_random_state; (* is true *) + * + * Saving the state just after seeding a generator and restoring it later + * as a very fast way to reseed a generator. + */ + +/* + * TRUTH IN ADVERTISING: + * + * When the call: + * + * srandom(seed, nextcand(ip,25,0,3,4)*nextcand(iq,25,0,3,4)) + * + * probable primes from nextcand are used. We use the word + * 'probable' because of an extremely extremely small chance that a + * composite (a non-prime) may be returned. + * + * We use the builtin function nextcand in its 5 arg form: + * + * nextcand(value, 25, 0, 3, 4) + * + * The odds that a number returned by the above call is not prime is + * less than 1 in 4^25. For our purposes, this is sufficient as the + * chance of returning a composite is much smaller than the chance that + * a hardware glitch will cause nextcand() to return a bogus result. + * + * Another "truth in advertising" issue is the use of the term + * 'pseudo-random'. All deterministic generators are pseudo random. + * This is opposed to true random generators based on some special + * physical device. + * + * Even though Blum generator is 'pseudo-random', there is no statistical + * test, which runs in polynomial time, that can distinguish the Blum + * generator from a truly random source. See the comment under + * the "Blum-Blum-Shub generator" section above. + * + * A final "truth in advertising" issue deals with how the magic numbers + * found in this library were generated. Detains can be found in the + * various functions, while a overview can be found in the "SOURCE FOR + * MAGIC NUMBERS" section below. + */ + +/* + * SOURCE OF MAGIC NUMBERS: + * + * When seeding the Blum generator, we disallow seeds < 2^32 in an + * effort to avoid trivial seed values such as 0, 1 or other small values. + * The 2^32 lower bound limit was also selected because it provides a + * large reserved value space for special seeds. Currently the + * [1,2^32) seed range is reserved for future use. + * + *** + * + * When using the 2 arg srandom(seed, newn), we require newn > 2^32 + * to avoid trivial Blum moduli. The 2^32 lower bound limit was also + * selected because it provides a large reserved value space for special + * moduli. Currently the [21,2^32) newn range is reserved for future use. + * + * When using the 3 or 4 arg srandom(seed, ip, iq [, trials]) form, + * we require ip>2^16 and ip>2^16. This ensures that the resulting + * Blum modulus is > 2^32. + * + *** + * + * Taking some care to select a good initial residue helps eliminate cheap + * search attacks. It is true that a subsequent residue could be one of the + * residues that we would first avoid. However such an occurrence will + * happen after the generator is well underway and any such seed information + * has been lost. + * + * In an effort to avoid trivial seed values, we force the seed arg + * to srandom() to be > 2^32. We then square this value mod the + * Blum modulus until it is less than the previous value. This ensures + * that the previous seed value is large enough that its square is > Blum + * modulus, and this the square mod Blum modulus is non-trivial. + * + *** + * + * The size of default Blum modulus 'n=p*q' was taken to be > 2^259, or + * 260 bits (79 digits) long. A modulus > 2^256 will generate 8 bits + * per crank of the generator. The period of this generator is long + * enough to be reasonable, and the modulus is small enough to be fast. + * + * The default Blum modulus is not a secure modulus because it can + * be factored with ease. As if Feb 1997, the upper reach of the + * state of the art for factoring general numbers was around 2^512. + * Clearly factoring a 260 bit number if well within the reach of even + * a low life Pentium. + * + * The fact that the default modulus can be factored with ease is + * not a drawback. Afterall, if we are going to keep to the goal + * of disclosing the source magic numbers, we need to disclose how + * the Blum Modulus was produced ... including its factors. Knowing + * the facotrs of the Blum modulus does not reduce its quality, + * only the ability for someone to determine where you are in the + * sequence. But heck, the default seed is well known anyway so + * there is no real loss if the factors are also known. + * + *** + * + * The default Blum modulus is the product of two Blum probable primes + * that were selected by the Rand Book of Random Numbers. Using the '6% rule', + * a default Blum modulus n=p*q > 2^256 would be satisfied if p were + * 38 decimal digits and q were 42 decimal digits in length. We restate + * the sizes in decimal digits because the Rand Book of Random Numbers is a + * book of decimal digits. Using the first 38 rand digits as a + * starting search point for 'p', and the next 42 digits for a starting + * search point for 'q'. + * + * (* + * * setup the search points (lines split for readability) + * *) + * ip = 10097325337652013586346735487680959091; + * iq = 173929274945375420480564894742962480524037; + * + * (* + * * find the first Blum prime + * *) + * fp = int((ip-1)/2); + * do { + * fp = nextcand(fp+2, 25, 0, 3, 4); + * p = 2*fp+1; + * } while (ptest(p, 25) == 0); + * + * (* + * * find the 2nd Blum prime + * *) + * fq = int((iq-1)/2); + * do { + * fq = nextcand(fq+2, 25, 0, 3, 4); + * q = 2*fq+1; + * } while (ptest(q, 25) == 0); + * + * The above script produces the Blum probable primes and initial quadratic + * residue (line wrapped for readability): + * + * p= 0x798ac934c7a3318ad446190f3474e57 + * + * q= 0x1ff21d7e1dd7d5965e224d485d84c3ef44f + * + * These Blum primes were found after 1.81s of CPU time on a 195 Mhz IP28 + * R10000 version 2.5 processor. The first Blum prime 'p' was 31716 higher + * than the initial search value 'ip'. The second Blum prime 'q' was 18762 + * higher than the initial starting 'iq'. + * + * The product of the two Blum primes results in a 260 bit Blum modulus of: + * + * n = 0xf2ac1903156af9e373d78613ed0e8d30284f34b644a9027d9ba55a689d6be18d9 + * + * The selection if the initial quadratic residue comes from the next + * unused digits of the Rand Book of Random Numbers. Now the two initial + * search values 'ip' and 'iq' used above needed the first 38 digits and + * the next 42 digits. Thus we will skip the first 38+42=80 digits + * and begin to build in initial search value for a quadratic residue (most + * significant digit first) from the Rand Book of Numbers digits until we + * have a value whose square mod n > 4th power mod n. In other words, we + * need to build ir up from new Rand Book of Random Numbers digits until + * we find a value in which srandom(ir), for the Blum Modulus 'n' produces + * an initial quadratic residue on the first loop. + * + * Clearly we need to find an ir that is > sqrt(n). The first ir: + * + * ir = 2063610402008229166508422689531964509303 + * + * fails the single loop criteria. So we add the next digit: + * + * ir = 20636104020082291665084226895319645093032 + * + * Here we find that: + * + * pmod(ir,2,n) > pmod(pmod(ir,2,n),2,n) + * + * Thus, for thw Blum modulus 'n', the method outlined for srandom(ir) yields + * the initial quadratic residue of: + * + * r = 0x748b6d882ff4b074e2f1e93a8627d626506c73ca5a62546c90f23fd7ed3e7b11e + * + *** + * + * In the above process of finding the Blum primes used in the default + * Blum modulus, we selected primes of the form: + * + * 2*x + 1 x is also prime + * + * because Blum generators with modulus 'n=p*q' have a period: + * + * lambda(n) = lcm(factors of p-1 & q-1) + * + * since 'p' and 'q' are both odd, 'p-1' and 'q-1' have 2 as + * a factor. The calc script above ensures that '(p-1)/2' and + * '(q-1)/2' are probable prime, thus maximizing the period + * of the default generator to: + * + * lambda(n) = lcm(2,2,fp,fq) = 2*fp*fq = ~2*(p/2)*(q/2) = ~n/2 + * + * The process above resulted in a default generator Blum modulus n > 2^259 + * with period of at least 2^258 bits. To be exact, the period of the + * default Blum generator is: + * + * 0x79560c818ab57cf1b9ebc309f68746881adc15e79c05e476f741e5f904b9beb1a + * + * which is approximately: + * + * ~8.781 * 10^77 + * + * This period is more than long enough for computationally tractable tasks. + * + *** + * + * The 20 builtin generators, on the other hand, were selected + * with more care. While the lower order 20 generators have + * factorable generators, the higher order are likely to be + * be beyond the reach for a while. + * + * The lengths of the two Blum probable primes 'p' and 'q' used to make up + * the 20 Blum modului 'n=p*q' differ slightly to avoid certain + * factorization attacks that work on numbers that are a perfect square, + * or where the two primes are nearly the same. I elected to have the + * sizes differ by up to 6% of the product size to avoid such attacks. + * Clearly one does not want the size of the two factors to differ + * by a large percentage: p=3 and q large would result in a easy + * to factor Blum modulus. Thus we select sizes that differ by + * up to 6% but not (significantly) greater than 6%. + * + * Using the '6% rule' above, a Blum modulus n=p*q > 2^1024 would have two + * Blum factors p > 2^482 and q > 2^542. This is because 482+542 = 1024. + * The difference 542-482 is ~5.86% of 1024, and is the largest difference + * that is < 6%. + * + ****************************************************************************** + * + * FOR THE PARANOID: + * + * The truly paranoid might suggest that my claims in the MAGIC NUMBERS + * section are a lie intended to entrap people. Well they are not, but + * you need not take my word for it. + * + *** + * + * One could take issue with the above script that produced a 260 bit + * Blum modulus. So if that bothers you, then seed your generator + * with your own Blum modulus and initial quadratic residue. And + * if you are truly paranoid, why would you want to use the default seed, + * which is well known? + * + *** + * + * If all the above fails to pacify the truly paranoid, then one may + * select your own modulus and initial quadratic residue by calling: + * + * srandom(r, n); + * + * Of course, you will need to select a correct Blum modulus 'n' as the + * product of two Blum primes (both 3 mod 4) and with a long period (where + * lcm(factors of one less than the two Blum primes) is large) and an + * initial quadratic residue 'r' that is hard to guess selected at random. + * + * A simple way to seed the generator would be to: + * + * srandom(ir, ip, iq, 25) + * + * where 'ip', 'iq' and 'ir' are large integers that are unlikely to be + * 'guessed' and where numbers around the size of iq*ir are beyond + * the current reach of the best factoring methods on the fastest + * SGI/Cray supercomuters. + * + * Of course you can increase the '25' value if 1 of 4^25 odds of a + * non-prime are too probable for you. + * + * The problem with the above call is that the period of the Blum generator + * could be small if 'p' and 'q' have lots of small prime factors in common. + * + * A better way to do seed the Blum generator yourself is to use the + * seedrandom(seed1, seed2, size [,tests]) function from "seedrandom.cal" + * with the args: + * + * seed1 - seed rand() to search for 'p', select from [2^64, 2^308) + * seed2 - seed rand() to search for 'q', select from [2^64, 2^308) + * size - minimum bit size of the Blum modulus 'n=p*q' + * tests - optional arg for number of pseudo prime tests (default is 25) + * + * Last, one could use some external random source to select starting + * search points for 'p', 'q' and the quadratic residue. One way to + * do this is: + * + * fp = int((ip-1)/2); + * do { + * fp = nextcand(fp+2, tests, 0, 3, 4); + * p = 2*fp+1; + * } while (ptest(p, tests) == 0); + * fq = int((iq-1)/2); + * do { + * fq = nextcand(fq+2, tests, 0, 3, 4); + * q = 2*fq+1; + * } while (ptest(q, tests) == 0); + * srandom(pmod(ir,2,p*q), p*q); + * + * where 'tests' is the number of pseudo prime tests that a candidate must + * pass before being considered a probable prime (must be >0, perhaps 25), and + * where 'ip' is the initial search location for the Blum prime 'p', and + * where 'iq' is the initial search location for the Blum prime 'q', and + * where 'ir' is the initial Blum quadratic residue generator. The 'ir' + * value should be a random value in the range [2^(binsize*4/5), 2^(binsize-2)) + * where 2^(binsize-1) < n=p*q <= 2^binsize. + * + * Your external generator would need to generate 'ip', 'iq' and 'ir'. + * While any value for 'ip' and 'iq will do (provided that their product + * is large enough to meet your modulus needs), 'ir' should be selected + * to avoid values near 0 or near 'n' (or ip*iq). + * + *** + * + * The Blum moduli used with the pre-defined generators (via the call + * srandom(seed, 0malloc return previous Blum state, FALSE=>return NULL + * + * returns: + * previous Blum state + */ +RANDOM * +zsrandom1(CONST ZVALUE seed, BOOL need_ret) +{ + RANDOM *ret; /* previous Blum state */ + ZVALUE r; /* quadratic residue */ + ZVALUE last_r; /* previous quadratic residue */ + RANDOM *p_blum; /* malloced RANDOM by randomcopy() */ + + /* + * initialize state if first call + */ + if (!blum.seeded) { + p_blum = randomcopy(&init_blum); + blum = *p_blum; + free(p_blum); + } + + /* + * save the current state to return later, if need_ret says so + */ + if (need_ret) { + ret = randomcopy(&blum); + } else { + ret = NULL; + } + + /* + * srandom(seed == 0) + * + * If the init arg is TRUE, then restore the initial state and + * modulus of the Blum generator. After this call, the Blum + * generator is restored to its initial state after calc started. + */ + if (ziszero(seed)) { + + /* set to the default generator state */ + zfree(blum.n); + zfree(blum.r); + blum = *randomcopy(&init_blum); + + /* + * srandom(seed >= 2^32) + * srandom(seed >= 2^32, newn) + * + * Use seed to compute a new quadratic residue for use with + * the current Blum modulus. We will successively square mod Blum + * modulus until we get a smaller value (modulus wrap). + * + * The Blum modulus will not be changed. + */ + } else if (!zisneg(seed) && zge32b(seed)) { + + /* + * square the seed mod the Blum modulus until we wrap + */ + zcopy(seed, &r); + last_r.v = NULL; + do { + /* free temp storage */ + if (last_r.v != NULL) { + zfree(last_r); + } + + /* + * last_r = r; + * r = pmod(last_r, 2, n); + */ + last_r = r; + zsquaremod(last_r, blum.n, &r); + } while (zrel(r, last_r) > 0); + zfree(blum.r); + blum.r = r; + /* free temp storage */ + zfree(last_r); + + /* + * reserved seed + */ + } else { + math_error("srandom seed must be 0 or >= 2^32"); + /*NOTREACHED*/ + } + + /* + * flush the queued up bits + */ + blum.bits = 0; + blum.buffer = 0; + + /* + * return the previous state + */ + return ret; +} + + +/* + * zsrandom2 - seed the Blum generator 2 arg style + * + * We will seed the Blum generator according 2 argument + * function description described at the top of this file. + * In particular: + * + * given: + * pseed - seed of the generator + * newn - ptr to proposed new n (Blum modulus) + * + * returns: + * previous Blum state + */ +RANDOM * +zsrandom2(CONST ZVALUE seed, CONST ZVALUE newn) +{ + RANDOM *ret; /* previous Blum state */ + HALF set; /* pre-defined set to use */ + FULL nlen; /* length of newn in bits */ + RANDOM *p_blum; /* malloced RANDOM by randomcopy() */ + + /* + * initialize state if first call + */ + if (!blum.seeded) { + p_blum = randomcopy(&init_blum); + blum = *p_blum; + free(p_blum); + } + + /* + * save the current state to return later + */ + ret = randomcopy(&blum); + + /* + * srandom(seed, 0 < newn <= 20) + * + * Set the Blum modulus to one of the the pre-defined Blum moduli. + * The new quadratic residue will also be set to one of + * the pre-defined quadratic residues. + */ + if (!zisneg(newn) && !zge32b(newn)) { + + /* + * preset moduli only if small newn + */ + if (ziszero(newn)) { + math_error("srandom newn == 0 reserved for future use"); + /*NOTREACHED*/ + } + set = z1tol(newn); + if (!zistiny(newn) || set > BLUM_PREGEN) { + math_error("srandom small newn must be [1,20]"); + /*NOTREACHED*/ + } + zfree(blum.n); + zcopy(random_pregen[set-1].n, &blum.n); + blum.loglogn = random_pregen[set-1].loglogn; + blum.mask = random_pregen[set-1].mask; + + /* + * reset initial seed as well if seed is 0 + */ + if (ziszero(seed)) { + zfree(blum.r); + zcopy(random_pregen[set-1].r, &blum.r); + + /* + * Otherwise non-zero seeds are processed as 1 arg calls + */ + } else { + zsrandom1(seed, FALSE); + } + + /* + * srandom(seed, newn >= 2^32) + * + * Assuming that 'newn' == 3 mod 4, then we will use it as + * the Blum modulus. + * + * We will use the seed arg to compute a new quadratic residue. + * We will successively square it mod Blum modulus until we get + * a smaller value (modulus wrap). + */ + } else if (!zisneg(newn)) { + + /* + * Blum modulus must be 1 mod 4 + */ + if (newn.v[0] % 4 != 1) { + math_error("srandom large newn must be 1 mod 4"); + /*NOTREACHED*/ + } + + /* + * For correct Blum moduli, hope they are a product + * of two primes. + */ + /* load modulus */ + zfree(blum.n); + zcopy(newn, &blum.n); + + /* + * setup loglogn and mask + * + * If the length if excessive, reduce it down + * so that loglogn is at most BASEB-1. + */ + nlen = (FULL)zhighbit(newn); + blum.loglogn = BASEB-1; + if (nlen > 0 && nlen <= TOPHALF) { + for (blum.loglogn=BASEB-1; + ((FULL)1< nlen && blum.loglogn > 1; + --blum.loglogn) { + } + } + blum.mask = ((HALF)1 << blum.loglogn)-1; + + /* + * use default initial seed if seed is 0 and process + * as if this value is given as a 1 arg call + */ + if (ziszero(seed)) { + (void) zsrandom1(z_rdefault, FALSE); + + /* + * Otherwise non-zero seeds are processed as 1 arg calls + */ + } else { + (void) zsrandom1(seed, FALSE); + } + + /* + * reserved newn + */ + } else { + math_error("srandom newn must be [1,20] or >= 2^32"); + /*NOTREACHED*/ + } + + /* + * flush the queued up bits + */ + blum.bits = 0; + blum.buffer = 0; + + /* + * return the previous state + */ + return ret; +} + + +/* + * zsrandom4 - seed the Blum generator 4 arg style + * + * We will seed the Blum generator according 2 argument + * function description described at the top of this file. + * In particular: + * + * given: + * pseed - seed of the generator + * ip - initial p search point + * iq - initial q search point + * trials - number of ptests to perform per candidate prime + * + * returns: + * previous Blum state + */ +RANDOM * +zsrandom4(CONST ZVALUE seed, CONST ZVALUE ip, CONST ZVALUE iq, long trials) +{ + RANDOM *ret; /* previous Blum state */ + FULL nlen; /* length of n=p*q in bits */ + ZVALUE p; /* 1st Blum prime */ + ZVALUE q; /* 2nd Blum prime */ + RANDOM *p_blum; /* malloced RANDOM by randomcopy() */ + + /* + * initialize state if first call + */ + if (!blum.seeded) { + p_blum = randomcopy(&init_blum); + blum = *p_blum; + free(p_blum); + } + + /* + * save the current state to return later + */ + ret = randomcopy(&blum); + + /* + * search the 'p' and 'q' Blum prime (3 mod 4) candidates + */ + if (!znextcand(ip, trials, _zero_, zconst[3], zconst[4], &p)) { + math_error("failed to find 1st Blum prime"); + /*NOTREACHED*/ + } + if (!znextcand(iq, trials, _zero_, zconst[3], zconst[4], &q)) { + math_error("failed to find 2nd Blum prime"); + /*NOTREACHED*/ + } + + /* + * form the Blum modulus + */ + zfree(blum.n); + zmul(p, q, &blum.n); + /* free temp storage */ + zfree(p); + zfree(q); + + /* + * form the loglogn and mask + */ + nlen = (FULL)zhighbit(blum.n); + blum.loglogn = BASEB-1; + if (nlen > 0 && nlen <= TOPHALF) { + for (blum.loglogn=BASEB-1; + ((FULL)1< nlen && blum.loglogn > 1; + --blum.loglogn) { + } + } + blum.mask = ((HALF)1 << blum.loglogn)-1; + + /* + * use default initial seed if seed is 0 and process + * as if this value is given as a 1 arg call + */ + if (ziszero(seed)) { + (void) zsrandom1(z_rdefault, FALSE); + + /* + * Otherwise non-zero seeds are processed as 1 arg calls + */ + } else { + (void) zsrandom1(seed, FALSE); + } + + /* + * flush the queued up bits + */ + blum.bits = 0; + blum.buffer = 0; + + /* + * return the previous state + */ + return ret; +} + + +/* + * zsetrandom - set the Blum generator state + * + * given: + * state - the state to copy + * + * In particular: + * + * zsetrandom(pseed) is called by: srandom() and srandom(state) + * + * returns: + * previous RANDOM state + */ +RANDOM * +zsetrandom(CONST RANDOM *state) +{ + RANDOM *ret; /* previous Blum state */ + RANDOM *p_blum; /* malloced RANDOM by randomcopy() */ + + /* + * initialize state if first call + */ + if (!blum.seeded) { + p_blum = randomcopy(&init_blum); + blum = *p_blum; + free(p_blum); + } + + /* + * save the current state to return later + */ + ret = randomcopy(&blum); + + /* + * load the new state + */ + if (state != NULL) { + p_blum = randomcopy(state); + blum = *p_blum; + free(p_blum); + } + + /* + * return the previous state + */ + return ret; +} + + +/* + * zrandomskip - skip s bits via the Blum-Blum-Shub generator + * + * given: + * count - number of bits to be skipped + */ +void +zrandomskip(long cnt) +{ + ZVALUE new_r; /* new quadratic residue */ + long loglogn; /* blum.loglogn */ + RANDOM *p_blum; /* malloced RANDOM by randomcopy() */ + + /* + * initialize state if first call + */ + if (!blum.seeded) { + p_blum = randomcopy(&init_blum); + blum = *p_blum; + free(p_blum); + } + loglogn = (long)blum.loglogn; + + /* + * skip required bits in the buffer + */ + if (blum.bits > 0) { + + /* + * depending in if we have too few or too many in the buffer + */ + if (blum.bits <= cnt) { + + /* too few - just toss the buffer bits */ + cnt -= blum.bits; + blum.bits = 0; + blum.buffer = 0; + + } else { + + /* buffer contains more bits than we need to toss */ + blum.buffer >>= cnt; + blum.bits -= cnt; + return; /* skip need satisfied */ + } + } + + /* + * skip loglogn bits at a time + */ + while (cnt >= loglogn) { + + /* turn the Blum-Blum-Shub crank */ + zsquaremod(blum.r, blum.n, &new_r); + zfree(blum.r); + blum.r = new_r; + cnt -= blum.loglogn; + } + + /* + * skip the final bits + */ + if (cnt > 0) { + + /* turn the Blum-Blum-Shub crank */ + zsquaremod(blum.r, blum.n, &new_r); + zfree(blum.r); + blum.r = new_r; + + /* fill the buffer with the unused bits */ + blum.bits = loglogn - cnt; + blum.buffer = (blum.r.v[0] & lowhalf[blum.bits]); + } + return; +} + + +/* + * zrandom - crank the Blum-Blum-Shub generator for some bits + * + * We will load the ZVALUE with random bits starting from the + * most significant and ending with the lowest bit in the + * least significant HALF. + * + * given: + * count - number of bits required + * res - where to place the random bits as ZVALUE + */ +void +zrandom(long cnt, ZVALUE *res) +{ + BITSTR dest; /* destination bit string */ + int loglogn; /* blum.loglogn */ + HALF mask; /* mask for bottom loglogn bits */ + ZVALUE new_r; /* new quadratic residue */ + RANDOM *p_blum; /* malloced RANDOM by randomcopy() */ + int t; /* temp shift value */ + + /* + * firewall + */ + if (cnt <= 0) { + if (cnt == 0) { + /* zero length random number is always 0 */ + itoz(0, res); + return; + } else { + math_error("negative zrandom bit count"); + /*NOTREACHED*/ + } +#if LONG_BITS > 32 + } else if (cnt > (1L<<31)) { + math_error("huge random count in internal zrandom function"); + /*NOTREACHED*/ +#endif + } + + /* + * initialize state if first call + */ + if (!blum.seeded) { + p_blum = randomcopy(&init_blum); + blum = *p_blum; + free(p_blum); + } + loglogn = blum.loglogn; + mask = blum.mask; + + /* + * allocate storage + */ + res->len = (LEN)((cnt+BASEB-1)/BASEB); + res->v = alloc((LEN)((cnt+BASEB-1)/BASEB)); + + /* + * dest bit string + */ + dest.len = (int)cnt; + dest.loc = res->v + (((cnt+BASEB-1)/BASEB)-1); + dest.bit = (int)((cnt-1) % BASEB); + *dest.loc = 0; + + /* + * load from buffer first + */ + if (blum.bits > 0) { + + /* + * If we need only part of the buffer, use + * the top bits and keep the bottom in place. + * If we need extactly all of the buffer, + * process it as a partial buffer fill. + */ + if (dest.len <= blum.bits) { + + /* load part of the buffer */ + *dest.loc = (blum.buffer >> (blum.bits-dest.len)); + + /* update buffer */ + blum.buffer &= ((1 << (blum.bits-dest.len))-1); + blum.bits -= dest.len; + + /* cleanup */ + res->sign = 0; + ztrim(res); + + /* we are done now */ + return; + } + + /* + * Otherwise we need all of the buffer and then some ... + * + * dest.len > blum.bits + * + * NOTE: We use = instead of |= as this will ensure that + * bit bits above dest.bit are set to 0. + */ + if (dest.bit >= blum.bits) { + /* copy all of buffer into upper element */ + *dest.loc = (blum.buffer << (dest.bit+1-blum.bits)); + dest.bit -= blum.bits; + } else { + /* copy buffer into upper and next element */ + t = blum.bits-(dest.bit+1); + *dest.loc-- = (blum.buffer >> t); + dest.bit = BASEB-t-1; + *dest.loc = ((blum.buffer&lowhalf[t]) << (dest.bit+1)); + } + dest.len -= blum.bits; + } + + /* + * Crank the generator up until, but not including, the + * time when we will write into the least significant bit. + * + * In this loop we know that we have exactly blum.loglogn bits + * to load. + */ + while (dest.len > loglogn) { + + /* + * turn the Blum-Blum-Shub crank + */ + zsquaremod(blum.r, blum.n, &new_r); + zfree(blum.r); + blum.r = new_r; + /* peal off the bottom loglogn bits */ + blum.buffer = (blum.r.v[0] & mask); + + /* + * load the loglogn bits into dest.loc starting at bit dest.bit + */ + if (dest.bit >= loglogn) { + /* copy all of buffer into upper element */ + *dest.loc |= (blum.buffer << (dest.bit+1-loglogn)); + dest.bit -= loglogn; + } else { + /* copy buffer into upper and next element */ + t = loglogn-(dest.bit+1); + *dest.loc-- |= (blum.buffer >> t); + dest.bit = BASEB-t-1; + *dest.loc = ((blum.buffer&lowhalf[t]) << (dest.bit+1)); + } + dest.len -= loglogn; + } + + /* + * We have a full or less than a full crank (loglogn bits) left + * to generate and load into the least significant bits. + * + * If we have any bits left over, we will save them in the + * buffer for use by the next call. + */ + /* turn the Blum-Blum-Shub crank */ + zsquaremod(blum.r, blum.n, &new_r); + zfree(blum.r); + blum.r = new_r; + /* peal off the bottom loglogn bits */ + blum.buffer = (blum.r.v[0] & mask); + blum.bits = loglogn; + + /* + * load dest.len bits into the lowest order bits + */ + *dest.loc |= (blum.buffer >> (loglogn - dest.len)); + + /* + * leave any unused bits in the buffer for next time + */ + blum.buffer &= lowhalf[loglogn - dest.len]; + blum.bits -= dest.len; + + /* + * cleanup + */ + res->sign = 0; + ztrim(res); +} + + +/* + * zrandomrange - generate a Blum-Blum-Shub random value in [low, high) + * + * given: + * low - low value of range + * high - beyond end of range + * res - where to place the random bits as ZVALUE + */ +void +zrandomrange(CONST ZVALUE low, CONST ZVALUE high, ZVALUE *res) +{ + ZVALUE range; /* high-low */ + ZVALUE rval; /* random value [0, 2^bitlen) */ + ZVALUE rangem1; /* range - 1 */ + long bitlen; /* smallest power of 2 >= diff */ + + /* + * firewall + */ + if (zrel(low, high) >= 0) { + math_error("srand low range >= high range"); + /*NOTREACHED*/ + } + + /* + * determine the size of the random number needed + */ + zsub(high, low, &range); + if (zisone(range)) { + zfree(range); + *res = low; + return; + } + zsub(range, _one_, &rangem1); + bitlen = 1+zhighbit(rangem1); + zfree(rangem1); + + /* + * generate a random value between [0, diff) + * + * We will not fall into the trap of thinking that we can simply take + * a value mod 'range'. Consider the case where 'range' is '80' + * and we are given pseudo-random numbers [0,100). If we took them + * mod 80, then the numbers [0,20) would be produced more frequently + * because the numbers [81,100) mod 80 wrap back into [0,20). + */ + rval.v = NULL; + do { + if (rval.v != NULL) { + zfree(rval); + } + zrandom(bitlen, &rval); + } while (zrel(rval, range) >= 0); + + /* + * add in low value to produce the range [0+low, diff+low) + * which is the range [low, high) + */ + zadd(rval, low, res); + zfree(rval); + zfree(range); +} + + +/* + * irandom - generate a Blum-Blum-Shub random long in the range [0, s) + * + * given: + * s - limit of the range + * + * returns: + * random long in the range [0, s) + */ +long +irandom(long s) +{ + ZVALUE z1, z2; + long res; + + if (s <= 0) { + math_error("Non-positive argument for irandom()"); + /*NOTREACHED*/ + } + if (s == 1) + return 0; + itoz(s, &z1); + zrandomrange(_zero_, z1, &z2); + res = ztoi(z2); + zfree(z1); + zfree(z2); + return res; +} + + +/* + * randomcopy - make a copy of a Blum state + * + * given: + * state - the state to copy + * + * returns: + * a malloced copy of the state + */ +RANDOM * +randomcopy(CONST RANDOM *state) +{ + RANDOM *ret; /* return copy of state */ + + /* + * malloc state + */ + ret = (RANDOM *)malloc(sizeof(RANDOM)); + if (ret == NULL) { + math_error("can't allocate RANDOM state"); + /*NOTREACHED*/ + } + + /* + * clone data + */ + *ret = *state; + if (state->r.v == NULL) { + ret->r.v = NULL; + } else { + zcopy(state->r, &ret->r); + } + if (state->n.v == NULL) { + ret->n.v = NULL; + } else { + zcopy(state->n, &ret->n); + } + + /* + * return copy + */ + return ret; +} + + +/* + * randomfree - free a Blum state + * + * given: + * state - the state to free + */ +void +randomfree(RANDOM *state) +{ + /* avoid free of the pre-defined states */ + if (state == &init_blum) { + return; + } + if (state >= random_pregen && state < random_pregen+BLUM_PREGEN) { + return; + } + + /* free the values */ + state->seeded = 0; + zfree(state->n); + zfree(state->r); + + /* free it if it is not pre-defined */ + if (state != &blum) { + free(state); + } +} + + +/* + * randomcmp - compare two Blum states + * + * given: + * s1 - first state to compare + * s2 - second state to compare + * + * return: + * TRUE if states differ + */ +BOOL +randomcmp(CONST RANDOM *s1, CONST RANDOM *s2) +{ + /* + * assume uninitialized state == the default seeded state + */ + if (!s1->seeded) { + if (!s2->seeded) { + /* uninitialized == uninitialized */ + return FALSE; + } else { + /* uninitialized only equals default state */ + return randomcmp(s2, &init_blum); + } + } else if (!s2->seeded) { + /* uninitialized only equals default state */ + return randomcmp(s1, &init_blum); + } + + /* + * compare operating mask parameters + */ + if ((s1->loglogn != s2->loglogn) || (s1->mask != s2->mask)) { + return TRUE; + } + + /* + * compare bit buffer + */ + if ((s1->bits != s2->bits) || (s1->buffer != s2->buffer)) { + return TRUE; + } + + /* + * compare quadratic residues and moduli + */ + return (zcmp(s1->r, s2->r) && zcmp(s1->n, s2->n)); +} + + +/* + * randomprint - print a Blum state + * + * given: + * state - state to print + * flags - print flags passed from printvalue() in value.c + */ +/*ARGSUSED*/ +void +randomprint(CONST RANDOM *state, int flags) +{ + math_str("RANDOM state"); +} + + +/* + * random_libcalc_cleanup - cleanup code for final libcalc_call_me_last() call + * + * This call is needed only by libcalc_call_me_last() to help clean up any + * unneeded storage. + * + * Do not call this function directly! Let libcalc_call_me_last() do it. + */ +void +random_libcalc_cleanup(void) +{ + /* free if we are seeded now */ + if (blum.seeded) { + randomfree(&blum); + } + return; +} diff --git a/zrandom.h b/zrandom.h new file mode 100644 index 0000000..85f4f86 --- /dev/null +++ b/zrandom.h @@ -0,0 +1,100 @@ +/* + * 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, + * provided that the above copyright, this permission notice and text + * this comment, 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. + * + * Prior to calc 2.9.3t9, these routines existed as a calc library called + * cryrand.cal. They have been rewritten in C for performance as well + * as to make them available directly from libcalc.a. + * + * Comments, suggestions, bug fixes and questions about these routines + * are welcome. Send EMail to the address given below. + * + * Happy bit twiddling, + * + * Landon Curt Noll + * + * chongo@toad.com + * ...!{pyramid,sun,uunet}!hoptoad!chongo + * + * chongo was here /\../\ + */ +/* + * random number generator - see zrandom.c for details + */ + + +#if !defined(__ZRANDOM_H__) +#define __ZRANDOM_H__ + + +#include "value.h" +#include "have_const.h" + + +/* + * Blum generator state + * + * The size of the buffer implies that a turn of the quadratic residue crank + * will never yield as many at the than the number of bits in a HALF. At + * most this implies that a turn can yield no more than 15 bits when BASEB==16 + * or 31 bits when BASEB==32. Should we deal with a excessively large + * Blum modulus (>=2^16 bits long for BASEB==16, >=2^32 bits for BASEB==32) + * the higher order random bits will be tossed. This is not a loss as + * regular sub-segments of the sequence are just as random. It only means + * that excessively large Blum modulus values waste CPU time. + */ +struct random { + int seeded; /* 1 => state has been seeded */ + int bits; /* number of unused bits in buffer */ + int loglogn; /* int(log2(log2(n))), bits produced per turn */ + HALF buffer; /* unused random bits from previous call */ + HALF mask; /* mask for the log2(log2(n)) lower bits of r */ + ZVALUE n; /* Blum modulus */ + ZVALUE r; /* Blum quadratic residue */ +}; + + +/* + * Blum constants + */ +#define BLUM_PREGEN 20 /* number of non-default predefined Blum generators */ + + +/* + * Blum generator function declarations + */ +extern RANDOM *zsrandom1(CONST ZVALUE seed, BOOL need_ret); +extern RANDOM *zsrandom2(CONST ZVALUE seed, CONST ZVALUE newn); +extern RANDOM *zsrandom4(CONST ZVALUE seed, + CONST ZVALUE ip, CONST ZVALUE iq, long trials); +extern RANDOM *zsetrandom(CONST RANDOM *state); +extern void zrandomskip(long count); +extern void zrandom(long count, ZVALUE *res); +extern void zrandom(long count, ZVALUE *res); +extern void zrandomrange(CONST ZVALUE low, CONST ZVALUE beyond, ZVALUE *res); +extern long irandom(long s); +extern RANDOM *randomcopy(CONST RANDOM *random); +extern void randomfree(RANDOM *random); +extern BOOL randomcmp(CONST RANDOM *s1, CONST RANDOM *s2); +extern void randomprint(CONST RANDOM *state, int flags); +extern void random_libcalc_cleanup(void); + + +#endif /* !__ZRANDOM_H__ */