Source Code 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / unix / volume26 / calc / part03 < prev next >

Wrap

Text File | 1992-05-09 | 51.3 KB | 1,847 lines

Newsgroups: comp.sources.unix From: dbell@pdact.pd.necisa.oz.au (David I. Bell) Subject: v26i029: CALC - An arbitrary precision C-like calculator, Part03/21 Sender: unix-sources-moderator@pa.dec.com Approved: vixie@pa.dec.com Submitted-By: dbell@pdact.pd.necisa.oz.au (David I. Bell) Posting-Number: Volume 26, Issue 29 Archive-Name: calc/part03 #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh <file", e.g.. If this archive is complete, you # will see the following message at the end: # "End of archive 3 (of 21)." # Contents: calc.1 config.c help/obj lib/ellip.cal lib/surd.cal # opcodes.h string.c token.h # Wrapped by dbell@elm on Tue Feb 25 15:20:56 1992 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'calc.1' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'calc.1'\" else echo shar: Extracting \"'calc.1'\" $6494 characters$ sed "s/^X//" >'calc.1' <<'END_OF_FILE' X.\" X.\" Copyright (c) 1992 David I. Bell and Landon Curt Noll X.\" Permission is granted to use, distribute, or modify this source, X.\" provided that this copyright notice remains intact. X.\" X.\" calculator by David I. Bell X.\" man page by Landon Noll X.TH calc 1 "^..^" "22jun91" X.SH NAME X\f4calc\f1 \- arbitrary precision calculator X.SH SYNOPSIS X\f4calc\fP X[ X\f4\-h\fP X] [ X\f4\-q\fP X] [ X.I calc_cmd X\&.\|.\|. X] X.SH DESCRIPTION X\& X.br XCALC COMMAND LINE X.PP X.TP X\f4 \-h\f1 XPrint a help message. XThis option implies \f4 \-q\f1. XThis is equivalent to the calc command \f4help help\fP. X.TP X\f4 \-q\f1 XDisable the use of the \f4$CALCRC\f1 startup library scripts. X.PP XWithout \f4calc_cmd\fPs, \f4calc\fP operates interactively. XIf one or more \f4calc_cmd\fPs are given on the command line, X\f4calc\fP will execute them and exit. X.PP XNormally on startup, \f4calc\fP attempts to execute a collection Xof library scripts. XThe environment variable \f4$CALCRC\f1 (if non-existent then Xa compiled in value) contains a \f4:\fP separated list of Xstartup library scripts. XNo error conditions are produced if these startup library scripts Xare not found. X.PP XFilenames are subject to ``~'' expansion (see below). XThe environment variable \f4$CALCPATH\fP (if non-existent then Xa compiled in value) contains a \f4:\fP separated list of search Xdirectories. XIf a file does not begin with \f4/\fP, \f4~\fP or \f4./\fP, Xthen it is searched for under each directory listed in the \f4$CALCPATH\fP. XIt is an error if no such readable file is found. X.PP XFor more information use the following calc commands: X.PP X.in 1.0i Xhelp usage X.br Xhelp help X.br Xhelp environment X.in -1.0i X.PP XOVERVIEW X.PP X\f4Calc\fP is arbitrary precision arithmetic system that uses Xa C-like language. X\f4Calc\fP is useful as a calculator, an algorithm prototyped Xand as a mathematical research tool. XMore importantly, \f4calc\fP provides one with a machine Xindependent means of computation. X.PP XA rich set of builtin functions is provided. XA number of library scripts are also provided because they are Xuseful and to serve as examples of the \f4calc\fP language. X.PP XOne may further extend \f4calc\fP permits further thru to Xuse of calc library scripts. XWritten in the same C-like language, library scripts may be Xread in and executed during a \f4calc\fP session. X.PP XInternally calc represents numeric values as fractions reduced to their Xlowest terms. XThe numerators and denominators of these factions may grow to Xarbitrarily large values. XNumeric values read in are automatically converted into rationals. XThe user need not be aware of this internal representation. X.PP XFor more information use the following calc commands: X.PP X.in 1.0i Xhelp intro X.br Xhelp builtin X.br Xhelp stdlib X.br Xhelp define X.br Xshow builtins X.br Xshow functions X.in -1.0i X.PP XDATA TYPES X.PP XFundamental builtin data types include integers, real numbers, Xrational numbers, complex numbers and strings. X.PP XBy use of an object, one may define an arbitrarily complex Xdata types. XOne may define how such objects behave a wide range of Xoperations such as addition, subtraction, Xmultiplication, division, negation, squaring, modulus, Xrounding, exponentiation, equality, comparison, printing Xand so on. X.PP XFor more information use the following calc commands: X.PP X.in 1.0i Xhelp types X.br Xhelp obj X.br Xshow objfuncs X.in -1.0i X.PP XVARIABLES X.PP XVariables in \f4calc\fP are typeless. XIn other words, the fundamental type of a variable is determined by its content. XBefore variable is assigned a value is of type ``null''. X.PP XThe scope of a variable may be global, or only a local to a procedure. XValues may be grouped together in a matrix, or into a Xa list that permits stack and queue style operations. X.PP XFor more information use the following calc commands: X.PP X.in 1.0i Xhelp variable X.br Xhelp mat X.br Xhelp list X.br Xshow globals X.in -1.0i X.PP XINPUT/OUTPUT X.PP XA leading ``0x'' implies a hexadecimal value, Xa leading ``0b'' implies a binary value, Xand a ``0'' followed by a digit implies an octal value. XComplex numbers are indicated by a trailing ``i'' such as in ``3+4i''. XStrings may be delimited by either a pair of single or double quotes. XBy default, \f4calc\fP prints values as if they were floating point numbers. XOne may change the default to print values in a number of modes Xincluding fractions, integers and exponentials. X.PP XA number of stdio-like file I/O operations are provided. XOne may open, read, write, seek and close files. XFilenames are subject to ``\~'' expansion to home directories Xin a way similar to that of the Korn or C-Shell. X.PP XFor example: X.PP X.in 1.0i X~/.calcrc X.br X~chongo/lib/fft_multiply.cal X.in -1.0i X.PP XFor more information use the following calc command: X.PP X.in 1.0i Xhelp file X.in -1.0i X.PP XCALC LANGUAGE X.PP XThe \f4calc\fP language is a C-like language. XThe language includes commands such as variable declarations, Xexpressions, tests, labels, loops, file operations, function calls. XThese commands are very similar to their counterparts in C. X.PP XThe language also include a number of commands particular Xto \f4calc\fP itself. XThese include commands such as function definition, help, Xreading in library scripts, dump files to a file, error notification, Xconfiguration control and status. X.PP XFor more information use the following calc command: X.PP X.in 1.0i Xhelp command X.br Xhelp statement X.br Xhelp expression X.br Xhelp operator X.br Xhelp config X.in -1.0i X.PP X.SH FILES X.PD 0 X.TP 20 X${LIBDIR} Xlibrary scripts shipped with calc X.br X.sp X.TP 20 X${LIBDIR}/help Xhelp files X.br X.sp XTypically ${LIBDIR} is /usr/local/lib/calc X.sp X.SH CREDIT XWritten by David I. Bell. X.sp XThanks for suggestions and encouragement from Peter Miller, XNeil Justusson, and Landon Noll. X.sp XPortions of this program are derived from an earlier set of Xpublic domain arbitrarily precision routines which was posted Xto the net around 1984. By now, there is almost no recognizable Xcode left from that original source. X.sp XMost of this source and binary is: X.sp X.PP X.in 1.0i XCopyright (c) 1992 David I. Bell X.sp X.in -1.0i X.PP XSome files are a copyrighted David I. Bell and Landon Noll. X.sp XPermission is granted to use, distribute, or modify this source, Xprovided that this copyright notice remains intact. X.sp XSend calc comments, suggestions, bug fixes, enhancements Xand interesting calc scripts that you would like you see included Xin future distributions to: X.sp X.PP X.in 1.0i Xdbell@pdact.pd.necisa.oz.au\ \ and\ \ chongo@toad.com X.sp X.in -1.0i X.PP X.sp XEnjoy! END_OF_FILE if test 6494 -ne `wc -c <'calc.1'`; then echo shar: \"'calc.1'\" unpacked with wrong size! fi # end of 'calc.1' fi if test -f 'config.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'config.c'\" else echo shar: Extracting \"'config.c'\" $5811 characters$ sed "s/^X//" >'config.c' <<'END_OF_FILE' X/* X * Copyright (c) 1992 David I. Bell X * Permission is granted to use, distribute, or modify this source, X * provided that this copyright notice remains intact. X * X * Configuration routines. X */ X X#include "calc.h" X X X/* X * Configuration parameter name and type. X */ Xtypedef struct { X char *name; /* name of configuration string */ X int type; /* type for configuration */ X} CONFIG; X X X/* X * Table of configuration types that can be set or read. X */ Xstatic CONFIG configs[] = { X "trace", CONFIG_TRACE, X "display", CONFIG_DISPLAY, X "epsilon", CONFIG_EPSILON, X "mode", CONFIG_MODE, X "maxprint", CONFIG_MAXPRINT, X "mul2", CONFIG_MUL2, X "sq2", CONFIG_SQ2, X "pow2", CONFIG_POW2, X "redc2", CONFIG_REDC2, X NULL, 0 X}; X X X/* X * Possible output modes. X */ Xstatic CONFIG modes[] = { X "frac", MODE_FRAC, X "decimal", MODE_FRAC, X "dec", MODE_FRAC, X "int", MODE_INT, X "real", MODE_REAL, X "exp", MODE_EXP, X "hexadecimal", MODE_HEX, X "hex", MODE_HEX, X "octal", MODE_OCTAL, X "oct", MODE_OCTAL, X "binary", MODE_BINARY, X "bin", MODE_BINARY, X NULL, 0 X}; X X X/* X * Given a string value which represents a configuration name, return X * the configuration type for that string. Returns negative type if X * the string is unknown. X */ Xconfigtype(name) X char *name; /* configuration name */ X{ X CONFIG *cp; /* current config pointer */ X X for (cp = configs; cp->name; cp++) { X if (strcmp(cp->name, name) == 0) X return cp->type; X } X return -1; X} X X X/* X * Given the name of a mode, convert it to the internal format. X * Returns -1 if the string is unknown. X */ Xstatic Xmodetype(name) X char *name; /* mode name */ X{ X CONFIG *cp; /* current config pointer */ X X for (cp = modes; cp->name; cp++) { X if (strcmp(cp->name, name) == 0) X return cp->type; X } X return -1; X} X X X/* X * Given the mode type, convert it to a string representing that mode. X * Where there are multiple strings representing the same mode, the first X * one in the table is used. Returns NULL if the node type is unknown. X * The returned string cannot be modified. X */ Xstatic char * Xmodename(type) X{ X CONFIG *cp; /* current config pointer */ X X for (cp = modes; cp->name; cp++) { X if (type == cp->type) X return cp->name; X } X return NULL; X} X X X/* X * Set the specified configuration type to the specified value. X * An error is generated if the type number or value is illegal. X */ Xvoid Xsetconfig(type, vp) X VALUE *vp; X{ X NUMBER *q; X long temp; X X switch (type) { X case CONFIG_TRACE: X if (vp->v_type != V_NUM) X error("Non-numeric for trace"); X q = vp->v_num; X temp = qtoi(q); X if (qisfrac(q) || !istiny(q->num) || X ((unsigned long) temp > TRACE_MAX)) X error("Bad trace value"); X traceflags = (FLAG)temp; X break; X X case CONFIG_DISPLAY: X if (vp->v_type != V_NUM) X error("Non-numeric for display"); X q = vp->v_num; X temp = qtoi(q); X if (qisfrac(q) || qisneg(q) || !istiny(q->num)) X temp = -1; X setdigits(temp); X break; X X case CONFIG_MODE: X if (vp->v_type != V_STR) X error("Non-string for mode"); X temp = modetype(vp->v_str); X if (temp < 0) X error("Unknown mode \"%s\"", vp->v_str); X setmode((int) temp); X break; X X case CONFIG_EPSILON: X if (vp->v_type != V_NUM) X error("Non-numeric for epsilon"); X setepsilon(vp->v_num); X break; X X case CONFIG_MAXPRINT: X if (vp->v_type != V_NUM) X error("Non-numeric for maxprint"); X q = vp->v_num; X temp = qtoi(q); X if (qisfrac(q) || qisneg(q) || !istiny(q->num)) X temp = -1; X if (temp < 0) X error("Maxprint value is out of range"); X maxprint = temp; X break; X X case CONFIG_MUL2: X if (vp->v_type != V_NUM) X error("Non-numeric for mul2"); X q = vp->v_num; X temp = qtoi(q); X if (qisfrac(q) || qisneg(q)) X temp = -1; X if (temp == 0) X temp = MUL_ALG2; X if (temp < 2) X error("Illegal mul2 value"); X _mul2_ = temp; X break; X X case CONFIG_SQ2: X if (vp->v_type != V_NUM) X error("Non-numeric for sq2"); X q = vp->v_num; X temp = qtoi(q); X if (qisfrac(q) || qisneg(q)) X temp = -1; X if (temp == 0) X temp = SQ_ALG2; X if (temp < 2) X error("Illegal sq2 value"); X _sq2_ = temp; X break; X X case CONFIG_POW2: X if (vp->v_type != V_NUM) X error("Non-numeric for pow2"); X q = vp->v_num; X temp = qtoi(q); X if (qisfrac(q) || qisneg(q)) X temp = -1; X if (temp == 0) X temp = POW_ALG2; X if (temp < 1) X error("Illegal pow2 value"); X _pow2_ = temp; X break; X X case CONFIG_REDC2: X if (vp->v_type != V_NUM) X error("Non-numeric for redc2"); X q = vp->v_num; X temp = qtoi(q); X if (qisfrac(q) || qisneg(q)) X temp = -1; X if (temp == 0) X temp = REDC_ALG2; X if (temp < 1) X error("Illegal redc2 value"); X _redc2_ = temp; X break; X X default: X error("Setting illegal config parameter"); X } X} X X X/* X * Get the current value of the specified configuration type. X * An error is generated if the type number is illegal. X */ Xvoid Xgetconfig(type, vp) X VALUE *vp; X{ X switch (type) { X case CONFIG_TRACE: X vp->v_type = V_NUM; X vp->v_num = itoq((long) traceflags); X break; X X case CONFIG_DISPLAY: X vp->v_type = V_NUM; X vp->v_num = itoq(_outdigits_); X break; X X case CONFIG_MODE: X vp->v_type = V_STR; X vp->v_subtype = V_STRLITERAL; X vp->v_str = modename(_outmode_); X break; X X case CONFIG_EPSILON: X vp->v_type = V_NUM; X vp->v_num = qlink(_epsilon_); X break; X X case CONFIG_MAXPRINT: X vp->v_type = V_NUM; X vp->v_num = itoq(maxprint); X break; X X case CONFIG_MUL2: X vp->v_type = V_NUM; X vp->v_num = itoq(_mul2_); X break; X X case CONFIG_SQ2: X vp->v_type = V_NUM; X vp->v_num = itoq(_sq2_); X break; X X case CONFIG_POW2: X vp->v_type = V_NUM; X vp->v_num = itoq(_pow2_); X break; X X case CONFIG_REDC2: X vp->v_type = V_NUM; X vp->v_num = itoq(_redc2_); X break; X X default: X error("Getting illegal config parameter"); X } X} X X/* END CODE */ END_OF_FILE if test 5811 -ne `wc -c <'config.c'`; then echo shar: \"'config.c'\" unpacked with wrong size! fi # end of 'config.c' fi if test -f 'help/obj' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'help/obj'\" else echo shar: Extracting \"'help/obj'\" $6682 characters$ sed "s/^X//" >'help/obj' <<'END_OF_FILE' XUsing objects X X Objects are user-defined types which are associated with user- X defined functions to manipulate them. Object types are defined X similarly to structures in C, and consist of one or more elements. X The advantage of an object is that the user-defined routines are X automatically called by the calculator for various operations, X such as addition, multiplication, and printing. Thus they can be X manipulated by the user as if they were just another kind of number. X X An example object type is "surd", which represents numbers of the form X X a + b*sqrt(D), X X where D is a fixed integer, and 'a' and 'b' are arbitrary rational X numbers. Addition, subtraction, multiplication, and division can be X performed on such numbers, and the result can be put unambiguously X into the same form. (Complex numbers are an example of surds, where X D is -1.) X X The "obj" statement defines either an object type or an actual X variable of that type. When defining the object type, the names of X its elements are specified inside of a pair of braces. To define X the surd object type, the following could be used: X X obj surd {a, b}; X X Here a and b are the element names for the two components of the X surd object. X X When an object is created, the elements are all defined with null X values. A user-defined routine should be provided which will place X useful values in the elements. For example, for an object of type X 'surd', a function called 'surd' can be defined to set the two X components as follows: X X define surd(a, b) X { X local x; X X obj surd x; X x.a = a; X x.b = b; X return x; X } X X When an operation is attempted for an object, user functions with X particular names are automatically called to perform the operation. X These names are created by concatenating the object type name and X the operation name together with an underscore. For example, when X multiplying two objects of type surd, the function "surd_mul" is X called. X X The user function is called with the necessary arguments for that X operation. For example, for "surd_mul", there are two arguments, X which are the two numbers. The order of the arguments is always X the order of the binary operands. If only one of the operands to X a binary operator is an object, then the user function for that X object type is still called. If the two operands are of different X object types, then the user function that is called is the one for X the first operand. X X The above rules mean that for full generality, user functions X should detect that one of their arguments is not of its own object X type by using the 'istype' function, and then handle these cases X specially. In this way, users can mix normal numbers with object X types. (Functions which only have one operand don't have to worry X about this.) The following example of "surd_mul" demonstrates how X to handle regular numbers when used together with surds: X X define surd_mul(a, b) X { X local x; X X obj surd x; X if (!istype(a, x)) { X /* a not of type surd */ X x.a = b.a * a; X x.b = b.b * a; X } else if (!istype(b, x)) { X /* b not of type surd */ X x.a = a.a * b; X x.b = a.b * b; X } else { X /* both are surds */ X x.a = a.a * b.a + D * a.b * b.b; X x.b = a.a * b.b + a.b * b.a; X } X if (x.b == 0) X return x.a; /* normal number */ X return x; /* return surd */ X } X X In order to print the value of an object nicely, a user defined X routine can be provided. For small amounts of output, the print X routine should not print a newline. Also, it is most convenient X if the printed object looks like the call to the creation routine. X For output to be correctly collected within nested output calls, X output should only go to stdout. This means use the 'print' X statement, the 'printf' function, or the 'fprintf' function with X 'files(1)' as the output file. For example, for the "surd" object: X X define surd_print(a) X { X print "surd(" : a.a : "," : a.b : ")" : ; X } X X It is not necessary to provide routines for all possible operations X for an object, if those operations can be defaulted or do not make X sense for the object. The calculator will attempt meaningful X defaults for many operations if they are not defined. For example, X if 'surd_square' is not defined to square a number, then 'surd_mul' X will be called to perform the squaring. When a default is not X possible, then an error will be generated. X X Please note: Arguments to object functions are always passed by X reference (as if an '&' was specified for each variable in the call). X Therefore, the function should not modify the parameters, but should X copy them into local variables before modifying them. This is done X in order to make object calls quicker in general. X X The double-bracket operator can be used to reference the elements X of any object in a generic manner. When this is done, index 0 X corresponds to the first element name, index 1 to the second name, X and so on. The 'size' function will return the number of elements X in an object. X X The following is a list of the operations possible for objects. X The 'xx' in each function name is replaced with the actual object X type name. This table is displayed by the 'show objfuncs' command. X X Name Args Comments X X xx_print 1 print value, default prints elements X xx_one 1 multiplicative identity, default is 1 X xx_test 1 logical test (false,true => 0,1), X default tests elements X xx_add 2 X xx_sub 2 subtraction, default adds negative X xx_neg 1 negative X xx_mul 2 X xx_div 2 non-integral division, default multiplies X by inverse X xx_inv 1 multiplicative inverse X xx_abs 2 absolute value within given error X xx_norm 1 square of absolute value X xx_conj 1 conjugate X xx_pow 2 integer power, default does multiply, X square, inverse X xx_sgn 1 sign of value (-1, 0, 1) X xx_cmp 2 equality (equal,non-equal => 0,1), X default tests elements X xx_rel 2 inequality (less,equal,greater => -1,0,1) X xx_quo 2 integer quotient X xx_mod 2 remainder of division X xx_int 1 integer part X xx_frac 1 fractional part X xx_inc 1 increment, default adds 1 X xx_dec 1 decrement, default subtracts 1 X xx_square 1 default multiplies by itself X xx_scale 2 multiply by power of 2 X xx_shift 2 shift left by n bits (right if negative) X xx_round 2 round to given number of decimal places X xx_bround 2 round to given number of binary places X xx_root 3 root of value within given error X xx_sqrt 2 square root within given error X X X Also see the library files: X X dms.cal X mod.cal X poly.cal X quat.cal X surd.cal END_OF_FILE if test 6682 -ne `wc -c <'help/obj'`; then echo shar: \"'help/obj'\" unpacked with wrong size! fi # end of 'help/obj' fi if test -f 'lib/ellip.cal' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'lib/ellip.cal'\" else echo shar: Extracting \"'lib/ellip.cal'\" $5027 characters$ sed "s/^X//" >'lib/ellip.cal' <<'END_OF_FILE' X/* X * Copyright (c) 1992 David I. Bell X * Permission is granted to use, distribute, or modify this source, X * provided that this copyright notice remains intact. X * X * Attempt to factor numbers using elliptic functions. X * y^2 = x^3 + a*x + b (mod N). X * X * Many points (x,y) (mod N) are found that solve the above equation, X * starting from a trivial solution and 'multiplying' that point together X * to generate high powers of the point, looking for such a point whose X * order contains a common factor with N. The order of the group of points X * varies almost randomly within a certain interval for each choice of a X * and b, and thus each choice provides an independent opportunity to X * factor N. To generate a trivial solution, a is chosen and then b is X * selected so that (1,1) is a solution. The multiplication is done using X * the basic fact that the equation is a cubic, and so if a line hits the X * curve in two rational points, then the third intersection point must X * also be rational. Thus by drawing lines between known rational points X * the number of rational solutions can be made very large. When modular X * arithmetic is used, solving for the third point requires the taking of a X * modular inverse (instead of division), and if this fails, then the GCD X * of the failing value and N provides a factor of N. This description is X * only an approximation, read "A Course in Number Theory and Cryptography" X * by Neal Koblitz for a good explanation. X * X * factor(iN, ia, B, force) X * iN is the number to be factored. X * ia is the initial value of a in the equation, and each successive X * value of a is an independent attempt at factoring (default 1). X * B is the limit of the primes that make up the high power that the X * point is raised to for each factoring attempt (default 100). X * force is a flag to attempt to factor numbers even if they are X * thought to already be prime (default FALSE). X * X * Making B larger makes the power the point being raised to contain more X * prime factors, thus increasing the chance that the order of the point X * will be made up of those factors. The higher B is then, the greater X * the chance that any individual attempt will find a factor. However, X * a higher B also slows down the number of independent functions being X * examined. The order of the point for any particular function might X * contain a large prime and so won't succeed even for a really large B, X * whereas the next function might have an order which is quickly found. X * So you want to trade off the depth of a particular search with the X * number of searches made. For example, for factoring 30 digits, I make X * B be about 1000 (probably still too small). X * X * If you have lots of machines available, then you can run parallel X * factoring attempts for the same number by giving different starting X * values of ia for each machine (e.g. 1000, 2000, 3000). X * X * The output as the function is running is (occasionally) the value of a X * when a new function is started, the prime that is being included in the X * high power being calculated, and the current point which is the result X * of the powers so far. X * X * If a factor is found, it is returned and is also saved in the global X * variable f. The number being factored is also saved in the global X * variable N. X */ X Xobj point {x, y}; Xglobal N; /* number to factor */ Xglobal a; /* first coefficient */ Xglobal b; /* second coefficient */ Xglobal f; /* found factor */ X X Xdefine factor(iN, ia, B, force) X{ X local C, x, p; X X if (!force && ptest(iN, 50)) X return 1; X if (isnull(B)) X B = 100; X if (isnull(ia)) X ia = 1; X obj point x; X a = ia; X b = -ia; X N = iN; X C = isqrt(N); X C = 2 * C + 2 * isqrt(C) + 1; X f = 0; X while (f == 0) { X print "A =", a; X x.x = 1; X x.y = 1; X print 2, x; X x = x ^ (2 ^ (highbit(C) + 1)); X for (p = 3; ((p < B) && (f == 0)); p += 2) { X if (!ptest(p, 1)) X continue; X print p, x; X x = x ^ (p ^ ((highbit(C) // highbit(p)) + 1)); X } X a++; X b--; X } X return f; X} X X Xdefine point_print(p) X{ X print "(" : p.x : "," : p.y : ")" :; X} X X Xdefine point_mul(p1, p2) X{ X local r, m; X X if (p2 == 1) X return p1; X if (p1 == p2) X return point_square(&p1); X obj point r; X m = (minv(p2.x - p1.x, N) * (p2.y - p1.y)) % N; X if (m == 0) { X if (f == 0) X f = gcd(p2.x - p1.x, N); X r.x = 1; X r.y = 1; X return r; X } X r.x = (m^2 - p1.x - p2.x) % N; X r.y = ((m * (p1.x - r.x)) - p1.y) % N; X return r; X} X X Xdefine point_square(p) X{ X local r, m; X X obj point r; X m = ((3 * p.x^2 + a) * minv(p.y << 1, N)) % N; X if (m == 0) { X if (f == 0) X f = gcd(p.y << 1, N); X r.x = 1; X r.y = 1; X return r; X } X r.x = (m^2 - p.x - p.x) % N; X r.y = ((m * (p.x - r.x)) - p.y) % N; X return r; X} X X Xdefine point_pow(p, pow) X{ X local bit, r, t; X X r = 1; X if (isodd(pow)) X r = p; X t = p; X for (bit = 2; ((bit <= pow) && (f == 0)); bit <<= 1) { X t = point_square(&t); X if (bit & pow) X r = point_mul(&t, &r); X } X return r; X} X Xglobal lib_debug; Xif (!isnum(lib_debug) || lib_debug>0) print "factor(N, I, B, force) defined"; END_OF_FILE if test 5027 -ne `wc -c <'lib/ellip.cal'`; then echo shar: \"'lib/ellip.cal'\" unpacked with wrong size! fi # end of 'lib/ellip.cal' fi if test -f 'lib/surd.cal' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'lib/surd.cal'\" else echo shar: Extracting \"'lib/surd.cal'\" $5041 characters$ sed "s/^X//" >'lib/surd.cal' <<'END_OF_FILE' X/* X * Copyright (c) 1992 David I. Bell X * Permission is granted to use, distribute, or modify this source, X * provided that this copyright notice remains intact. X * X * Calculate using quadratic surds of the form: a + b * sqrt(D). X */ X Xobj surd {a, b}; /* definition of the surd object */ X Xglobal surd_type; /* type of surd (value of D) */ Xglobal surd__; /* example surd for testing against */ X Xsurd_type = -1; /* default */ Xobj surd surd__; /* set object */ X X Xdefine surd(a,b) X{ X local x; X X obj surd x; X x.a = a; X x.b = b; X return x; X} X X Xdefine surd_print(a) X{ X print "surd(" : a.a : ", " : a.b : ")" :; X} X X Xdefine surd_conj(a) X{ X local x; X X obj surd x; X x.a = a.a; X x.b = -a.b; X return x; X} X X Xdefine surd_norm(a) X{ X return a.a^2 + abs(surd_type) * a.b^2; X} X X Xdefine surd_value(a, xepsilon) X{ X local epsilon; X X epsilon = xepsilon; X if (isnull(epsilon)) X epsilon = epsilon(); X return a.a + a.b * sqrt(surd_type, epsilon); X} X Xdefine surd_add(a, b) X{ X local x; X X obj surd x; X if (!istype(b, x)) { X x.a = a.a + b; X x.b = a.b; X return x; X } X if (!istype(a, x)) { X x.a = a + b.a; X x.b = b.b; X return x; X } X x.a = a.a + b.a; X x.b = a.b + b.b; X if (x.b) X return x; X return x.a; X} X X Xdefine surd_sub(a, b) X{ X local x; X X obj surd x; X if (!istype(b, x)) { X x.a = a.a - b; X x.b = a.b; X return x; X } X if (!istype(a, x)) { X x.a = a - b.a; X x.b = -b.b; X return x; X } X x.a = a.a - b.a; X x.b = a.b - b.b; X if (x.b) X return x; X return x.a; X} X X Xdefine surd_inc(a) X{ X local x; X X x = a; X x.a++; X return x; X} X X Xdefine surd_dec(a) X{ X local x; X X x = a; X x.a--; X return x; X} X X Xdefine surd_neg(a) X{ X local x; X X obj surd x; X x.a = -a.a; X x.b = -a.b; X return x; X} X X Xdefine surd_mul(a, b) X{ X local x; X X obj surd x; X if (!istype(b, x)) { X x.a = a.a * b; X x.b = a.b * b; X } else if (!istype(a, x)) { X x.a = b.a * a; X x.b = b.b * a; X } else { X x.a = a.a * b.a + surd_type * a.b * b.b; X x.b = a.a * b.b + a.b * b.a; X } X if (x.b) X return x; X return x.a; X} X X Xdefine surd_square(a) X{ X local x; X X obj surd x; X x.a = a.a^2 + a.b^2 * surd_type; X x.b = a.a * a.b * 2; X if (x.b) X return x; X return x.a; X} X X Xdefine surd_scale(a, b) X{ X local x; X X obj surd x; X x.a = scale(a.a, b); X x.b = scale(a.b, b); X return x; X} X X Xdefine surd_shift(a, b) X{ X local x; X X obj surd x; X x.a = a.a << b; X x.b = a.b << b; X if (x.b) X return x; X return x.a; X} X X Xdefine surd_div(a, b) X{ X local x, y; X X if ((a == 0) && b) X return 0; X obj surd x; X if (!istype(b, x)) { X x.a = a.a / b; X x.b = a.b / b; X return x; X } X y = b; X y.b = -b.b; X return (a * y) / (b.a^2 - surd_type * b.b^2); X} X X Xdefine surd_inv(a) X{ X return 1 / a; X} X X Xdefine surd_sgn(a) X{ X if (surd_type < 0) X quit "Taking sign of complex surd"; X if (a.a == 0) X return sgn(a.b); X if (a.b == 0) X return sgn(a.a); X if ((a.a > 0) && (a.b > 0)) X return 1; X if ((a.a < 0) && (a.b < 0)) X return -1; X return sgn(a.a^2 - a.b^2 * surd_type) * sgn(a.a); X} X X Xdefine surd_cmp(a, b) X{ X if (!istype(a, surd__)) X return ((b.b != 0) || (a != b.a)); X if (!istype(b, surd__)) X return ((a.b != 0) || (b != a.a)); X return ((a.a != b.a) || (a.b != b.b)); X} X X Xdefine surd_rel(a, b) X{ X local x, y; X X if (surd_type < 0) X quit "Relative comparison of complex surds"; X if (!istype(a, surd__)) { X x = a - b.a; X y = -b.b; X } else if (!istype(b, surd__)) { X x = a.a - b; X y = a.b; X } else { X x = a.a - b.a; X y = a.b - b.b; X } X if (y == 0) X return sgn(x); X if (x == 0) X return sgn(y); X if ((x < 0) && (y < 0)) X return -1; X if ((x > 0) && (y > 0)) X return 1; X return sgn(x^2 - y^2 * surd_type) * sgn(x); X} X Xglobal lib_debug; Xif (!isnum(lib_debug) || lib_debug>0) print "obj surd {a, b} defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd(a, b) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_print(a) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_conj(a) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_norm(a) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_value(a, xepsilon) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_add(a, b) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_sub(a, b) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_inc(a) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_dec(a) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_neg(a) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_mul(a, b) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_square(a) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_scale(a, b) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_shift(a, b) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_div(a, b) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_inv(a) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_sgn(a) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_cmp(a, b) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_rel(a, b) defined" Xif (!isnum(lib_debug) || lib_debug>0) print "surd_type defined" Xif (!isnum(lib_debug) || lib_debug>0) print "set surd_type as needed" END_OF_FILE if test 5041 -ne `wc -c <'lib/surd.cal'`; then echo shar: \"'lib/surd.cal'\" unpacked with wrong size! fi # end of 'lib/surd.cal' fi if test -f 'opcodes.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'opcodes.h'\" else echo shar: Extracting \"'opcodes.h'\" $5948 characters$ sed "s/^X//" >'opcodes.h' <<'END_OF_FILE' X/* X * Copyright (c) 1992 David I. Bell X * Permission is granted to use, distribute, or modify this source, X * provided that this copyright notice remains intact. X */ X X X/* X * Opcodes X */ X#define OP_NOP 0L /* no operation */ X#define OP_LOCALADDR 1L /* load address of local variable */ X#define OP_GLOBALADDR 2L /* load address of global variable */ X#define OP_PARAMADDR 3L /* load address of paramater variable */ X#define OP_LOCALVALUE 4L /* load value of local variable */ X#define OP_GLOBALVALUE 5L /* load value of global variable */ X#define OP_PARAMVALUE 6L /* load value of paramater variable */ X#define OP_NUMBER 7L /* load constant real numeric value */ X#define OP_INDEXADDR 8L /* load array index address */ X#define OP_INDEXVALUE 9L /* load array value */ X#define OP_ASSIGN 10L /* assign value to variable */ X#define OP_ADD 11L /* add top two values */ X#define OP_SUB 12L /* subtract top two values */ X#define OP_MUL 13L /* multiply top two values */ X#define OP_DIV 14L /* divide top two values */ X#define OP_MOD 15L /* take mod of top two values */ X#define OP_SAVE 16L /* save value for later use */ X#define OP_NEGATE 17L /* negate top value */ X#define OP_INVERT 18L /* invert top value */ X#define OP_INT 19L /* take integer part of top value */ X#define OP_FRAC 20L /* take fraction part of top value */ X#define OP_NUMERATOR 21L /* take numerator of top value */ X#define OP_DENOMINATOR 22L /* take denominator of top value */ X#define OP_DUPLICATE 23L /* duplicate top value on stack */ X#define OP_POP 24L /* pop top value from stack */ X#define OP_RETURN 25L /* return value of function */ X#define OP_JUMPEQ 26L /* jump if top value is zero */ X#define OP_JUMPNE 27L /* jump if top value is nonzero */ X#define OP_JUMP 28L /* jump unconditionally */ X#define OP_USERCALL 29L /* call a user-defined function */ X#define OP_GETVALUE 30L /* convert address to value */ X#define OP_EQ 31L /* test top two elements for equality */ X#define OP_NE 32L /* test top two elements for inequality */ X#define OP_LE 33L /* test top two elements for <= */ X#define OP_GE 34L /* test top two elements for >= */ X#define OP_LT 35L /* test top two elements for < */ X#define OP_GT 36L /* test top two elements for > */ X#define OP_PREINC 37L /* add one to variable (++x) */ X#define OP_PREDEC 38L /* subtract one from variable (--x) */ X#define OP_POSTINC 39L /* add one to variable (x++) */ X#define OP_POSTDEC 40L /* subtract one from variable (x--) */ X#define OP_DEBUG 41L /* debugging point */ X#define OP_PRINT 42L /* print value */ X#define OP_ASSIGNPOP 43L /* assign to variable and remove it */ X#define OP_ZERO 44L /* put zero on the stack */ X#define OP_ONE 45L /* put one on the stack */ X#define OP_PRINTEOL 46L /* print end of line */ X#define OP_PRINTSPACE 47L /* print a space */ X#define OP_PRINTSTRING 48L /* print constant string */ X#define OP_DUPVALUE 49L /* duplicate value of top value */ X#define OP_OLDVALUE 50L /* old calculation value */ X#define OP_QUO 51L /* integer quotient of top two values */ X#define OP_POWER 52L /* number raised to a power */ X#define OP_QUIT 53L /* quit program */ X#define OP_CALL 54L /* call built-in routine */ X#define OP_GETEPSILON 55L /* get allowed error for calculations */ X#define OP_AND 56L /* arithmetic and */ X#define OP_OR 57L /* arithmetic or */ X#define OP_NOT 58L /* logical not */ X#define OP_ABS 59L /* absolute value */ X#define OP_SGN 60L /* sign of number */ X#define OP_ISINT 61L /* whether top value is integer */ X#define OP_CONDORJUMP 62L /* conditional or jump */ X#define OP_CONDANDJUMP 63L /* conditional and jump */ X#define OP_SQUARE 64L /* square top value */ X#define OP_STRING 65L /* load constant string value */ X#define OP_ISNUM 66L /* whether top value is a number */ X#define OP_UNDEF 67L /* load undefined value on stack */ X#define OP_ISNULL 68L /* whether variable is the null value */ X#define OP_ARGVALUE 69L /* load value of argument (parameter) n */ X#define OP_MATINIT 70L /* initialize matrix */ X#define OP_ISMAT 71L /* whether variable is a matrix */ X#define OP_ISSTR 72L /* whether variable is a string */ X#define OP_GETCONFIG 73L /* get value of configuration parameter */ X#define OP_LEFTSHIFT 74L /* left shift of integer */ X#define OP_RIGHTSHIFT 75L /* right shift of integer */ X#define OP_CASEJUMP 76L /* test case and jump if not matched */ X#define OP_ISODD 77L /* whether value is an odd integer */ X#define OP_ISEVEN 78L /* whether value is even integer */ X#define OP_FIADDR 79L /* 'fast index' matrix value address */ X#define OP_FIVALUE 80L /* 'fast index' matrix value */ X#define OP_ISREAL 81L /* test value for real number */ X#define OP_IMAGINARY 82L /* load imaginary numeric constant */ X#define OP_RE 83L /* real part of complex number */ X#define OP_IM 84L /* imaginary part of complex number */ X#define OP_CONJUGATE 85L /* complex conjugate of complex number */ X#define OP_OBJINIT 86L /* initialize object */ X#define OP_ISOBJ 87L /* whether value is an object */ X#define OP_NORM 88L /* norm of value (square of abs) */ X#define OP_ELEMADDR 89L /* address of element of object */ X#define OP_ELEMVALUE 90L /* value of element of object */ X#define OP_ISTYPE 91L /* whether two values are the same type */ X#define OP_SCALE 92L /* scale value by a power of two */ X#define OP_ISLIST 93L /* whether value is a list */ X#define OP_SWAP 94L /* swap values of two variables */ X#define OP_ISSIMPLE 95L /* whether value is a simple type */ X#define OP_CMP 96L /* compare values returning -1, 0, or 1 */ X#define OP_QUOMOD 97L /* calculate quotient and remainder */ X#define OP_SETCONFIG 98L /* set configuration parameter */ X#define OP_SETEPSILON 99L /* set allowed error for calculations */ X#define OP_PRINTRESULT 100L /* print result of top-level expression */ X#define OP_ISFILE 101L /* whether value is a file */ X#define MAX_OPCODE 101L /* highest legal opcode */ X X/* X * function declarations - most to keep lint happy X */ Xextern void updateoldvalue(); X X/* END CODE */ END_OF_FILE if test 5948 -ne `wc -c <'opcodes.h'`; then echo shar: \"'opcodes.h'\" unpacked with wrong size! fi # end of 'opcodes.h' fi if test -f 'string.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'string.c'\" else echo shar: Extracting \"'string.c'\" $6676 characters$ sed "s/^X//" >'string.c' <<'END_OF_FILE' X/* X * Copyright (c) 1992 David I. Bell X * Permission is granted to use, distribute, or modify this source, X * provided that this copyright notice remains intact. X * X * String list routines. X */ X X#include "calc.h" X#include "string.h" X X#define STR_TABLECHUNK 100 /* how often to reallocate string table */ X#define STR_CHUNK 2000 /* size of string storage allocation */ X#define STR_UNIQUE 100 /* size of string to allocate separately */ X X Xstatic char *chartable; /* single character string table */ X Xstatic struct { X long l_count; /* count of strings in table */ X long l_maxcount; /* maximum strings storable in table */ X long l_avail; /* characters available in current string */ X char *l_alloc; /* next available string storage */ X char **l_table; /* current string table */ X} literals; X X X/* X * Initialize or reinitialize a string header for use. X */ Xvoid Xinitstr(hp) X register STRINGHEAD *hp; /* structure to be inited */ X{ X if (hp->h_list == NULL) { X hp->h_list = (char *)malloc(2000); X hp->h_avail = 2000; X hp->h_used = 0; X } X hp->h_avail += hp->h_used; X hp->h_used = 0; X hp->h_count = 0; X hp->h_list[0] = '\0'; X hp->h_list[1] = '\0'; X} X X X/* X * Copy a string to the end of a list of strings, and return the address X * of the copied string. Returns NULL if the string could not be copied. X * No checks are made to see if the string is already in the list. X * The string cannot be null or have imbedded nulls. X */ Xchar * Xaddstr(hp, str) X register STRINGHEAD *hp; /* header of string storage */ X char *str; /* string to be added */ X{ X char *retstr; /* returned string pointer */ X char *list; /* string list */ X long newsize; /* new size of string list */ X long len; /* length of current string */ X X if ((str == NULL) || (*str == '\0')) X return NULL; X len = strlen(str) + 1; X if (hp->h_avail <= len) { X newsize = len + 2000 + hp->h_used + hp->h_avail; X list = (char *)realloc(hp->h_list, newsize); X if (list == NULL) X return NULL; X hp->h_list = list; X hp->h_avail = newsize - hp->h_used; X } X retstr = hp->h_list + hp->h_used; X hp->h_used += len; X hp->h_avail -= len; X hp->h_count++; X strcpy(retstr, str); X retstr[len] = '\0'; X return retstr; X} X X X/* X * Return a null-terminated string which consists of a single character. X * The table is initialized on the first call. X */ Xchar * Xcharstr(ch) X{ X char *cp; X int i; X X if (chartable == NULL) { X cp = (char *)malloc(512); X if (cp == NULL) X error("Cannot allocate character table"); X for (i = 0; i < 256; i++) { X *cp++ = (char)i; X *cp++ = '\0'; X } X chartable = cp - 512; X } X return &chartable[(ch & 0xff) * 2]; X} X X X/* X * Find a string with the specified name and return its number in the X * string list. The first string is numbered zero. Minus one is returned X * if the string is not found. X */ Xlong Xfindstr(hp, str) X STRINGHEAD *hp; /* header of string storage */ X register char *str; /* string to be added */ X{ X register char *test; /* string being tested */ X long len; /* length of string being found */ X long testlen; /* length of test string */ X long index; /* index of string */ X X if ((hp->h_count <= 0) || (str == NULL)) X return -1; X len = strlen(str); X test = hp->h_list; X index = 0; X while (*test) { X testlen = strlen(test); X if ((testlen == len) && (*test == *str) && (strcmp(test, str) == 0)) X return index; X test += (testlen + 1); X index++; X } X return -1; X} X X X/* X * Return the name of a string with the given index. X * If the index is illegal, a pointer to an empty string is returned. X */ Xchar * Xnamestr(hp, n) X STRINGHEAD *hp; /* header of string storage */ X long n; X{ X register char *str; /* current string */ X X if ((unsigned long)n >= hp->h_count) X return ""; X str = hp->h_list; X while (*str) { X if (--n < 0) X return str; X str += (strlen(str) + 1); X } X return ""; X} X X X/* X * Useful routine to return the index of one string within another one X * which has the format: "str1\0str2\0str3\0...strn\0\0". Index starts X * at one for the first string. Returns zero if the string being checked X * is not contained in the formatted string. X */ Xlong Xstringindex(format, test) X register char *format; /* string formatted into substrings */ X char *test; /* string to be found in formatted string */ X{ X long index; /* found index */ X long len; /* length of current piece of string */ X long testlen; /* length of test string */ X X testlen = strlen(test); X index = 1; X while (*format) { X len = strlen(format); X if ((len == testlen) && (*format == *test) && X (strcmp(format, test) == 0)) X return index; X format += (len + 1); X index++; X } X return 0; X} X X X/* X * Add a possibly new literal string to the literal string pool. X * Returns the new string address which is guaranteed to be always valid. X * Duplicate strings will repeatedly return the same address. X */ Xchar * Xaddliteral(str) X char *str; X{ X register char **table; /* table of strings */ X char *newstr; /* newly allocated string */ X long count; /* number of strings */ X long len; /* length of string to allocate */ X X len = strlen(str); X if (len <= 1) X return charstr(*str); X /* X * See if the string is already in the table. X */ X table = literals.l_table; X count = literals.l_count; X while (count-- > 0) { X if ((str[0] == table[0][0]) && (str[1] == table[0][1]) && X (strcmp(str, table[0]) == 0)) X return table[0]; X table++; X } X /* X * Make the table of string pointers larger if necessary. X */ X if (literals.l_count >= literals.l_maxcount) { X count = literals.l_maxcount + STR_TABLECHUNK; X if (literals.l_maxcount) X table = (char **) realloc(literals.l_table, count * sizeof(char *)); X else X table = (char **) malloc(count * sizeof(char *)); X if (table == NULL) X error("Cannot allocate string literal table"); X literals.l_table = table; X literals.l_maxcount = count; X } X table = literals.l_table; X /* X * If the new string is very long, allocate it manually. X */ X len = (len + 2) & ~1; /* add room for null and round up to word */ X if (len >= STR_UNIQUE) { X newstr = (char *)malloc(len); X if (newstr == NULL) X error("Cannot allocate large literal string"); X strcpy(newstr, str); X table[literals.l_count++] = newstr; X return newstr; X } X /* X * If the remaining space in the allocate string is too small, X * then allocate a new one. X */ X if (literals.l_avail < len) { X newstr = (char *)malloc(STR_CHUNK); X if (newstr == NULL) X error("Cannot allocate new literal string"); X literals.l_alloc = newstr; X literals.l_avail = STR_CHUNK; X } X /* X * Allocate the new string from the allocate string. X */ X newstr = literals.l_alloc; X literals.l_avail -= len; X literals.l_alloc += len; X table[literals.l_count++] = newstr; X strcpy(newstr, str); X return newstr; X} X X/* END CODE */ END_OF_FILE if test 6676 -ne `wc -c <'string.c'`; then echo shar: \"'string.c'\" unpacked with wrong size! fi # end of 'string.c' fi if test -f 'token.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'token.h'\" else echo shar: Extracting \"'token.h'\" $4911 characters$ sed "s/^X//" >'token.h' <<'END_OF_FILE' X/* X * Copyright (c) 1992 David I. Bell X * Permission is granted to use, distribute, or modify this source, X * provided that this copyright notice remains intact. X */ X X X/* X * Token types X */ X#define T_NULL 0 /* null token */ X#define T_LEFTPAREN 1 /* left parenthesis "(" */ X#define T_RIGHTPAREN 2 /* right parenthesis ")" */ X#define T_LEFTBRACE 3 /* left brace "{" */ X#define T_RIGHTBRACE 4 /* right brace "}" */ X#define T_SEMICOLON 5 /* end of statement ";" */ X#define T_EOF 6 /* end of file */ X#define T_COLON 7 /* label character ":" */ X#define T_ASSIGN 8 /* assignment "=" */ X#define T_PLUS 9 /* plus sign "+" */ X#define T_MINUS 10 /* minus sign "-" */ X#define T_MULT 11 /* multiply sign "*" */ X#define T_DIV 12 /* divide sign "/" */ X#define T_MOD 13 /* modulo sign "%" */ X#define T_POWER 14 /* power sign "^" or "**" */ X#define T_EQ 15 /* equality "==" */ X#define T_NE 16 /* notequal "!=" */ X#define T_LT 17 /* less than "<" */ X#define T_GT 18 /* greater than ">" */ X#define T_LE 19 /* less than or equals "<=" */ X#define T_GE 20 /* greater than or equals ">=" */ X#define T_LEFTBRACKET 21 /* left bracket "[" */ X#define T_RIGHTBRACKET 22 /* right bracket "]" */ X#define T_SYMBOL 23 /* symbol name */ X#define T_STRING 24 /* string value (double quotes) */ X#define T_NUMBER 25 /* numeric real constant */ X#define T_PLUSEQUALS 26 /* plus equals "+=" */ X#define T_MINUSEQUALS 27 /* minus equals "-=" */ X#define T_MULTEQUALS 28 /* multiply equals "*=" */ X#define T_DIVEQUALS 29 /* divide equals "/=" */ X#define T_MODEQUALS 30 /* modulo equals "%=" */ X#define T_PLUSPLUS 31 /* plusplus "++" */ X#define T_MINUSMINUS 32 /* minusminus "--" */ X#define T_COMMA 33 /* comma "," */ X#define T_ANDAND 34 /* logical and "&&" */ X#define T_OROR 35 /* logical or "||" */ X#define T_OLDVALUE 36 /* old value from previous calculation */ X#define T_SLASHSLASH 37 /* integer divide "//" */ X#define T_NEWLINE 38 /* newline character */ X#define T_SLASHSLASHEQUALS 39 /* integer divide equals "//=" */ X#define T_AND 40 /* arithmetic and "&" */ X#define T_OR 41 /* arithmetic or "|" */ X#define T_NOT 42 /* logical not "!" */ X#define T_LEFTSHIFT 43 /* left shift "<<" */ X#define T_RIGHTSHIFT 44 /* right shift ">>" */ X#define T_ANDEQUALS 45 /* and equals "&=" */ X#define T_OREQUALS 46 /* or equals "|= */ X#define T_LSHIFTEQUALS 47 /* left shift equals "<<=" */ X#define T_RSHIFTEQUALS 48 /* right shift equals ">>= */ X#define T_POWEREQUALS 49 /* power equals "^=" or "**=" */ X#define T_PERIOD 50 /* period "." */ X#define T_IMAGINARY 51 /* numeric imaginary constant */ X#define T_AMPERSAND 52 /* ampersand "&" */ X#define T_QUESTIONMARK 53 /* question mark "?" */ X X X/* X * Keyword tokens X */ X#define T_IF 101 /* if keyword */ X#define T_ELSE 102 /* else keyword */ X#define T_WHILE 103 /* while keyword */ X#define T_CONTINUE 104 /* continue keyword */ X#define T_BREAK 105 /* break keyword */ X#define T_GOTO 106 /* goto keyword */ X#define T_RETURN 107 /* return keyword */ X#define T_LOCAL 108 /* local keyword */ X#define T_GLOBAL 109 /* global keyword */ X#define T_PRINT 110 /* print keyword */ X#define T_DO 111 /* do keyword */ X#define T_FOR 112 /* for keyword */ X#define T_SWITCH 113 /* switch keyword */ X#define T_CASE 114 /* case keyword */ X#define T_DEFAULT 115 /* default keyword */ X#define T_QUIT 116 /* quit keyword */ X#define T_DEFINE 117 /* define keyword */ X#define T_READ 118 /* read keyword */ X#define T_SHOW 119 /* show keyword */ X#define T_HELP 120 /* help keyword */ X#define T_WRITE 121 /* write keyword */ X#define T_MAT 122 /* mat keyword */ X#define T_OBJ 123 /* obj keyword */ X X X#define iskeyword(n) ((n) > 100) /* TRUE if token is a keyword */ X X X/* X * Flags returned describing results of expression parsing. X */ X#define EXPR_RVALUE 0x0001 /* result is an rvalue */ X#define EXPR_CONST 0x0002 /* result is constant */ X#define EXPR_ASSIGN 0x0004 /* result is an assignment */ X X#define isrvalue(n) ((n) & EXPR_RVALUE) /* TRUE if expression is rvalue */ X#define islvalue(n) (((n) & EXPR_RVALUE) == 0) /* TRUE if expr is lvalue */ X#define isconst(n) ((n) & EXPR_CONST) /* TRUE if expr is constant */ X#define isassign(n) ((n) & EXPR_ASSIGN) /* TRUE if expr is an assignment */ X X X/* X * Flags for modes for tokenizing. X */ X#define TM_DEFAULT 0x0 /* normal mode */ X#define TM_NEWLINES 0x1 /* treat any newline as a token */ X#define TM_ALLSYMS 0x2 /* treat almost everything as a symbol */ X X Xextern long errorcount; /* number of errors found */ X Xextern char *tokenstring(); Xextern long tokennumber(); Xextern void inittokens(); /* initialize all token information */ Xextern void tokenmode(); Xextern int gettoken(); Xextern void rescantoken(); X X#ifdef VARARGS Xextern void scanerror(); X#else X# ifdef __STDC__ Xextern void scanerror(int, char *, ...); X# else Xextern void scanerror(); X# endif X#endif X X/* END CODE */ END_OF_FILE if test 4911 -ne `wc -c <'token.h'`; then echo shar: \"'token.h'\" unpacked with wrong size! fi # end of 'token.h' fi echo shar: End of archive 3 $of 21$. cp /dev/null ark3isdone MISSING="" for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 21 archives. rm -f ark[1-9]isdone ark[1-9][0-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0