Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/unix/volume26/calc/part02

Text File | 1992-05-09 | 54.1 KB | 2,129 lines

Newsgroups: comp.sources.unix
From: [e-mail] (David I. Bell)
Subject: v26i028: CALC - An arbitrary precision C-like calculator, Part02/21
Sender: [e-mail]
Approved: [e-mail]

Submitted-By: [e-mail] (David I. Bell)
Posting-Number: Volume 26, Issue 28
Archive-Name: calc/part02

#! /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 2 (of 21)."
# Contents:  alloc.h calc.c const.c help/command help/config
#   help/define help/mat help/types label.c lib/README lib/mod.cal
#   lib/poly.cal lib/quat.cal
# Wrapped by dbell@elm on Tue Feb 25 15:20:55 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'alloc.h' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'alloc.h'\"
else
echo shar: Extracting \"'alloc.h'\" \(2686 characters\)
sed "s/^X//" >'alloc.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 * Allocator definitions (fast malloc and free)
X */
X
X#if defined(UNIX_MALLOC)
X
X#include "have_malloc.h"
X#ifdef HAVE_MALLOC_H
X# include <malloc.h>
X#else
X# if defined(__STDC__)
X   extern void *malloc();
X   extern void *realloc();
X   extern void free();
X# else
X   extern char *malloc();
X   extern char *realloc();
X   extern void free();
X# endif
X#endif
X
X#include "have_string.h"
X
X#ifdef HAVE_STRING_H
X# include <string.h>
X
X#else
X
X# ifdef OLD_BSD
Xextern void bcopy();
Xextern void bfill();
Xextern char *index();
X# else /* OLD_BSD */
Xextern void memcpy();
Xextern void memset();
X#  if defined(__STDC__)
Xextern void *strchr();
X#  else
Xextern char *strchr();
X#  endif
X# endif /* OLD_BSD */
Xextern void strcpy();
Xextern void strncpy();
Xextern void strcat();
Xextern int strcmp();
Xextern long strlen();    /* should be size_t, but old systems don't have it */
X
X#endif
X
X#ifdef OLD_BSD
X#undef memcpy
X#define memcpy(s1, s2, n) bcopy(s2, s1, n)
X#undef memset
X#define memset(s, c, n) bfill(s, n, c)
X#undef strchr
X#define strchr(s, c) index(s, c)
X#endif
X
X#ifdef VSPRINTF
X/*
X * XXX - hack aleart
X *
X * Systems that do not have vsprintf() need something.  In some cases
X * the sprintf function will deal correctly with the va_alist 3rd arg.
X * Hope for the best!
X */
X#define vsprintf sprintf
X#endif
X
Xextern void exit();
X
X#define mem_alloc malloc
X#define mem_realloc realloc
X#define mem_free free
X
X#else /*UNIX_MALLOC*/
X
X#define malloc(a) mem_alloc((long) a)
X#define realloc(a,b) mem_realloc((char *) a, (long) b)
X#define free(a) mem_free((char *) a)
Xextern char *mem_alloc();
Xextern char *mem_realloc();
Xextern int mem_free();        /* MUST be int even though no return value */
X
X#endif /*UNIX_MALLOC*/
X
X
X/*
X * An item to be placed on a free list.
X * These items are overlayed on top of the actual item being managed.
X * Therefore, the managed items must be at least this size!
X * Also, all items on a single free list must be the same size.
X */
Xstruct free_item {
X    struct free_item *next;            /* next item on free list */
X};
Xtypedef struct free_item FREEITEM;
X
X
X/*
X * The actual free list header.
X */
Xtypedef struct {
X    long        itemsize;    /* size of an item being managed */
X    long        maxfree;    /* maximum number of free items */
X    long        curfree;    /* current number of free items */
X    FREEITEM    *freelist;    /* the free list */
X} FREELIST;
X
X#if defined(__STDC__)
Xtypedef void ALLOCITEM;
X#else
Xtypedef char ALLOCITEM;
X#endif
Xextern ALLOCITEM * allocitem( /* FREELIST * */ );
Xextern void freeitem( /* FREELIST *, char * */ );
Xextern void mem_stats();
X
X/* END CODE */
END_OF_FILE
if test 2686 -ne `wc -c <'alloc.h'`; then
    echo shar: \"'alloc.h'\" unpacked with wrong size!
fi
# end of 'alloc.h'
fi
if test -f 'calc.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'calc.c'\"
else
echo shar: Extracting \"'calc.c'\" \(4905 characters\)
sed "s/^X//" >'calc.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 * Arbitrary precision calculator.
X */
X
X#include <signal.h>
X#include <pwd.h>
X#include <sys/types.h>
X
X#include "calc.h"
X#include "func.h"
X#include "opcodes.h"
X#include "config.h"
X#include "token.h"
X#include "symbol.h"
X
X/*
X * Common definitions
X */
Xlong maxprint;        /* number of elements to print */
Xint abortlevel;        /* current level of aborts */
XBOOL inputwait;        /* TRUE if in a terminal input wait */
Xjmp_buf jmpbuf;        /* for errors */
X
Xstatic int q_flag = FALSE;    /* TRUE => don't execute rc files */
X
Xchar *calcpath;        /* $CALCPATH or default */
Xchar *calcrc;        /* $CALCRC or default */
Xchar *home;        /* $HOME or default */
Xstatic char *pager;    /* $PAGER or default */
Xchar *shell;        /* $SHELL or default */
X
Xstatic void intint();    /* interrupt routine */
Xvoid givehelp();
Xstatic void initenv();    /* initialize/default special environment vars */
X
Xextern struct passwd *getpwuid();
Xextern char *getenv();
Xextern uid_t geteuid();
X
X/*
X * Top level calculator routine.
X */
Xmain(argc, argv)
X    char **argv;
X{
X    char *str;        /* current option string or expression */
X    char cmdbuf[MAXCMD+1];    /* command line expression */
X
X    initenv();
X    argc--;
X    argv++;
X    while ((argc > 0) && (**argv == '-')) {
X        for (str = &argv[0][1]; *str; str++) switch (*str) {
X            case 'h':
X                givehelp(DEFAULTCALCHELP);
X                exit(0);
X                break;
X            case 'q':
X                q_flag = TRUE;
X                break;
X            default:
X                printf("Unknown option\n");
X                exit(1);
X        }
X        argc--;
X        argv++;
X    }
X    str = cmdbuf;
X    *str = '\0';
X    while (--argc >= 0) {
X        *str++ = ' ';
X        strcpy(str, *argv++);
X        str += strlen(str);
X        str[0] = '\n';
X        str[1] = '\0';
X    }
X    str = cmdbuf;
X    if (*str == '\0') {
X        str = NULL;
X        printf("C-style arbitrary precision calculator.\n");
X        version(stdout);
X        printf("[Type \"exit\" to exit, or \"help\" for help.]\n\n");
X    }
X    if (setjmp(jmpbuf) == 0) {
X        initmasks();
X        inittokens();
X        initglobals();
X        initfunctions();
X        initstack();
X        resetinput();
X        cleardiversions();
X        setfp(stdout);
X        setmode(MODE_INITIAL);
X        setdigits(DISPLAY_DEFAULT);
X        maxprint = MAXPRINT_DEFAULT;
X        _epsilon_ = atoq(EPSILON_DEFAULT);
X        _epsilonprec_ = qprecision(_epsilon_);
X        if (str) {
X            if (q_flag == FALSE) {
X                runrcfiles();
X                q_flag = TRUE;
X            }
X            (void) openstring(str);
X            getcommands();
X            exit(0);
X        }
X    }
X    if (str)
X        exit(1);
X    abortlevel = 0;
X    _math_abort_ = FALSE;
X    inputwait = FALSE;
X    (void) signal(SIGINT, intint);
X    cleardiversions();
X    setfp(stdout);
X    resetinput();
X    if (q_flag == FALSE) {
X        runrcfiles();
X        q_flag = TRUE;
X    }
X    (void) openterminal();
X    getcommands();
X    exit(0);
X    /*NOTREACHED*/
X}
X
X
X/*
X * initenv - obtain $CALCPATH, $CALCRC, $HOME, $PAGER and $SHELL values
X *
X * If $CALCPATH, $CALCRC, $PAGER or $SHELL do not exist, use the default
X * values.  If $PAGER or $SHELL is an empty string, also use a default value.
X * If $HOME does not exist, or is empty, use the home directory
X * information from the password file.
X */
Xstatic void
Xinitenv()
X{
X    struct passwd *ent;        /* our password entry */
X
X    /* determine the $CALCPATH value */
X    calcpath = getenv(CALCPATH);
X    if (calcpath == NULL)
X        calcpath = DEFAULTCALCPATH;
X
X    /* determine the $CALCRC value */
X    calcrc = getenv(CALCRC);
X    if (calcrc == NULL) {
X        calcrc = DEFAULTCALCRC;
X    }
X
X    /* determine the $HOME value */
X    home = getenv(HOME);
X    if (home == NULL || home[0] == '\0') {
X        ent = getpwuid(geteuid());
X        if (ent == NULL) {
X            /* just assume . is home if all else fails */
X            home = ".";
X        }
X        home = (char *)malloc(strlen(ent->pw_dir)+1);
X        strcpy(home, ent->pw_dir);
X    }
X
X    /* determine the $PAGER value */
X    pager = getenv(PAGER);
X    if (pager == NULL || *pager == '\0') {
X        pager = DEFAULTCALCPAGER;
X    }
X
X    /* determine the $SHELL value */
X    shell = getenv(SHELL);
X    if (shell == NULL)
X        shell = DEFAULTSHELL;
X}
X
Xvoid
Xgivehelp(type)
X    char *type;        /* the type of help to give, NULL => index */
X{
X    char *helpcmd;        /* what to execute to print help */
X
X    /* catch the case where we just print the index */
X    if (type == NULL) {
X        type = DEFAULTCALCHELP;        /* the help index file */
X    }
X
X    /* form the help command name */
X    helpcmd = (char *)malloc(
X        sizeof("if [ ! -d \"")+sizeof(HELPDIR)+1+strlen(type)+
X        sizeof("\" ];then ")+
X        strlen(pager)+1+1+sizeof(HELPDIR)+1+strlen(type)+1+1+
X        sizeof(";else echo no such help;fi"));
X    sprintf(helpcmd,
X        "if [ -r \"%s/%s\" ];then %s \"%s/%s\";else echo no such help;fi",
X        HELPDIR, type, pager, HELPDIR, type);
X
X    /* execute the help command */
X    system(helpcmd);
X    free(helpcmd);
X}
X
X
X/*
X * Interrupt routine.
X */
X/*ARGSUSED*/
Xstatic void
Xintint(arg)
X    int arg;    /* to keep ANSI C happy */
X{
X    (void) signal(SIGINT, intint);
X    if (inputwait || (++abortlevel >= ABORT_NOW))
X        error("\nABORT");
X    if (abortlevel >= ABORT_MATH)
X        _math_abort_ = TRUE;
X    printf("\n[Abort level %d]\n", abortlevel);
X}
X
X/* END CODE */
END_OF_FILE
if test 4905 -ne `wc -c <'calc.c'`; then
    echo shar: \"'calc.c'\" unpacked with wrong size!
fi
# end of 'calc.c'
fi
if test -f 'const.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'const.c'\"
else
echo shar: Extracting \"'const.c'\" \(2709 characters\)
sed "s/^X//" >'const.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 * Constant number storage module.
X */
X
X#include "calc.h"
X
X#define CONSTALLOCSIZE 400    /* number of constants to allocate */
X
X
Xstatic long constcount;        /* number of constants defined */
Xstatic long constavail;        /* number of constants available */
Xstatic NUMBER **consttable;    /* table of constants */
X
X
X/*
X * Read in a constant number and add it to the table of constant numbers,
X * creating a new entry if necessary.  The incoming number is a string
X * value which must have a correct format, otherwise an undefined number
X * will result.  Returns the index of the number in the constant table.
X * Returns zero if the number could not be saved.
X */
Xlong
Xaddnumber(str)
X    char *str;        /* string representation of number */
X{
X    NUMBER *q;
X
X    q = atoq(str);
X    if (q == NULL)
X        return 0;
X    return addqconstant(q);
X}
X
X
X/*
X * Add a particular number to the constant table.
X * Returns the index of the number in the constant table, or zero
X * if the number could not be saved.  The incoming number if freed
X * if it is already in the table.
X */
Xlong
Xaddqconstant(q)
X    register NUMBER *q;    /* number to be added */
X{
X    register NUMBER **tp;    /* pointer to current number */
X    register NUMBER *t;    /* number being tested */
X    long index;        /* index into constant table */
X    long numlen;        /* numerator length */
X    long denlen;        /* denominator length */
X    HALF numlow;        /* bottom value of numerator */
X    HALF denlow;        /* bottom value of denominator */
X
X    numlen = q->num.len;
X    denlen = q->den.len;
X    numlow = q->num.v[0];
X    denlow = q->den.v[0];
X    tp = &consttable[1];
X    for (index = 1; index <= constcount; index++) {
X        t = *tp++;
X        if ((numlen != t->num.len) || (numlow != t->num.v[0]))
X            continue;
X        if ((denlen != t->den.len) || (denlow != t->den.v[0]))
X            continue;
X        if (q->num.sign != t->num.sign)
X            continue;
X        if (qcmp(q, t) == 0) {
X            qfree(q);
X            return index;
X        }
X    }
X    if (constavail <= 0) {
X        if (consttable == NULL) {
X            tp = (NUMBER **)
X                malloc(sizeof(NUMBER *) * (CONSTALLOCSIZE + 1));
X            *tp = NULL;
X        } else
X            tp = (NUMBER **) realloc((char *) consttable,
X            sizeof(NUMBER *) * (constcount+CONSTALLOCSIZE + 1));
X        if (tp == NULL)
X            return 0;
X        consttable = tp;
X        constavail = CONSTALLOCSIZE;
X    }
X    constavail--;
X    constcount++;
X    consttable[constcount] = q;
X    return constcount;
X}
X
X
X/*
X * Return the value of a constant number given its index.
X * Returns address of the number, or NULL if the index is illegal.
X */
XNUMBER *
Xconstvalue(index)
X    long index;
X{
X    if ((index <= 0) || (index > constcount))
X        return NULL;
X    return consttable[index];
X}
X
X/* END CODE */
END_OF_FILE
if test 2709 -ne `wc -c <'const.c'`; then
    echo shar: \"'const.c'\" unpacked with wrong size!
fi
# end of 'const.c'
fi
if test -f 'help/command' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'help/command'\"
else
echo shar: Extracting \"'help/command'\" \(2740 characters\)
sed "s/^X//" >'help/command' <<'END_OF_FILE'
XCommand sequence
X
X    This is a sequence of any the following command formats, where
X    each command is terminated by a semicolon or newline.  Long command
X    lines can be extended by using a back-slash followed by a newline
X    character.  When this is done, the prompt shows a double angle
X    bracket to indicate that the line is still in progress.  Certain
X    cases will automatically prompt for more input in a similar manner,
X    even without the back-slash.  The most common case for this is when
X    a function is being defined, but is not yet completed.
X
X    Each command sequence terminates only on an end of file.  In
X    addition, commands can consist of expression sequences, which are
X    described in the next section.
X
X
X    NOTE: Calc commands are in lower case.   UPPER case is used below
X          for emphasis only, and should be considered in lower case.
X
X
X    DEFINE function(params) { body }
X    DEFINE function(params) = expression
X        This first form defines a full function which can consist
X        of declarations followed by many statements which implement
X        the function.
X
X        The second form defines a simple function which calculates
X        the specified expression value from the specified parameters.
X        The expression cannot be a statement.  However, the comma
X        and question mark operators can be useful.  Examples of
X        simple functions are:
X
X            define sumcubes(a, b) = a^3 + b^3;
X            define pimod(a) = a % pi();
X
X    HELP
X        This displays a general help message.
X
X    READ filename
X        This reads definitions from the specified filename.
X        The name can be quoted if desired.  The calculator
X        uses the CALCPATH environment variable to search
X        through the specified directories for the filename,
X        similarly to the use of the PATH environment variable.
X        If CALCPATH is not defined, then a default path of
X        ":/usr/lib/calc" is used (that is, the current directory
X        followed by a general calc library directory).  The
X        ".cal" extension is defaulted for input files, so that
X        if "filename" is not found, then "filename.cal" is then
X        searched for.  The contents of the filename are command
X        sequences which can consist of expressions to evaluate
X        or functions to define, just like at the top level
X        command level.
X
X    WRITE filename
X        This writes the values of all global variables to the
X        specified filename, in such a way that the file can be
X        later read in order to recreate the variable values.
X        For speed reasons, values are written as hex fractions.
X        This command currently only saves simple types, so that
X        matrices, lists, and objects are not saved.  Function
X        definitions are also not saved.
X
X    QUIT
X        This leaves the calculator, when given as a top-level
X        command.
X
X
X    Also see the help topic:
X
X        statement       flow control and declaration statements
END_OF_FILE
if test 2740 -ne `wc -c <'help/command'`; then
    echo shar: \"'help/command'\" unpacked with wrong size!
fi
# end of 'help/command'
fi
if test -f 'help/config' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'help/config'\"
else
echo shar: Extracting \"'help/config'\" \(4426 characters\)
sed "s/^X//" >'help/config' <<'END_OF_FILE'
XConfiguration parameters
X
X    Configuration parameters affect how the calculator performs certain
X    operations, and affects all future calculations.  These parameters
X    affect the accuracy of calculations, the displayed format of results,
X    and which algorithms are used for calculations.  The parameters are
X    read or set using the "config" built-in function.  The following
X    parameters can be specified:
X
X        "trace"        turns tracing on or off (for debugging).
X        "display"    sets number of digits in prints.
X        "epsilon"    sets error value for transcendentals.
X        "maxprint"    sets maximum number of elements printed.
X        "mode"        sets printout mode.
X        "mul2"        sets size for alternative multiply.
X        "sq2"        sets size for alternative squaring.
X        "pow2"        sets size for alternate powering.
X        "redc2"        sets size for alternate REDC.
X
X    The use of the trace flag is for debugging, and its meaning may
X    change in the future.  A value of 1 causes the calculator to print
X    its internal opcodes as it executes functions.  A value of zero
X    disables tracing again.
X
X    Display specifies how many digits after the decimal point should
X    be printed when printing real or exponential numbers.  The initial
X    display value is 20.  This parameter does not affect the accuracy
X    of a calculation, since it only has meaning when printing results.
X
X    Epsilon specifies the required precision of calculations by
X    setting the maximum allowed error for transcendental functions.
X    The error is an absolute error value for many functions, but
X    for some functions it is a relative error.  The initial value
X    is 1e-20.  Functions which require an epsilon value accept an
X    optional argument which overrides this default epsilon value for
X    that single call.  The built-in function "epsilon" also can be
X    used to read or set this value, and is provided for ease of use.
X
X    Mode specifies how numbers should be printed.  Mode is a string
X    value indicating the printout method.  The initial mode is "real".
X    Possible modes are:
X
X        "frac"        decimal fractions
X        "int"        decimal integer
X        "real"        decimal floating point
X        "exp"        decimal exponential
X        "hex"        hex fractions
X        "oct"        octal fractions
X        "bin"        binary fractions
X
X    Maxprint specifies the maximum number of elements to be displayed
X    when a matrix or list is printed.  The initial value is 16 elements.
X
X    Mul2 and sq2 specify the sizes of numbers at which calc switches
X    from its first to its second algorithm for multiplying and squaring.
X    The first algorithm is the usual method of cross multiplying, which
X    runs in a time of O(N^2).  The second method is a recursive and
X    complicated method which runs in a time of O(N^1.585).  The argument
X    for these parameters is the number of binary words at which the
X    second algorithm begins to be used.  The minimum value is 2, and
X    the maximum value is very large.  If 2 is used, then the recursive
X    algorithm is used all the way down to single digits, which becomes
X    slow since the recursion overhead is high.  If a number such as
X    1000000 is used, then the recursive algorithm is never used, causing
X    calculations for large numbers to slow down.  For a typical example
X    on a 386, the two algorithms are about equal in speed for a value
X    of 20, which is about 100 decimal digits.  A value of zero resets
X    the parameter back to its default value.  Usually there is no need
X    to change these parameters.
X
X    Pow2 specifies the sizes of numbers at which calc switches from
X    its first to its second algorithm for calculating powers modulo
X    another number.  The first algorithm for calculating modular powers
X    is by repeated squaring and multiplying and dividing by the modulus.
X    The second method uses the REDC algorithm given by Peter Montgomery
X    which avoids divisions.  The argument for pow2 is the size of the
X    modulus at which the second algorithm begins to be used.
X
X    Redc2 specifies the sizes of numbers at which calc switches from
X    its first to its second algorithm when using the REDC algorithm.
X    The first algorithm performs a multiply and a modular reduction
X    together in one loop which runs in O(N^2).  The second algorithm
X    does the REDC calculation using three multiplies, and runs in
X    O(N^1.585).  The argument for redc2 is the size of the modulus at
X    which the second algorithm begins to be used.
X
X    Examples of setting some parameters are:
X
X        config("mode", "exp");        exponential output
X        config("display", 50);        50 digits of output
X        epsilon(epsilon() / 8);        3 bits more accuracy
END_OF_FILE
if test 4426 -ne `wc -c <'help/config'`; then
    echo shar: \"'help/config'\" unpacked with wrong size!
fi
# end of 'help/config'
fi
if test -f 'help/define' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'help/define'\"
else
echo shar: Extracting \"'help/define'\" \(2679 characters\)
sed "s/^X//" >'help/define' <<'END_OF_FILE'
XFunction definitions
X
X    Function definitions are introduced by the 'define' keyword.
X    Other than this, the basic structure of a function is like in C.
X    That is, parameters are specified for the function within parenthesis,
X    the function body is introduced by a left brace, variables are
X    declared for the function, statements implementing the function
X    follow, and the function is ended with a right brace.
X
X    There are some subtle differences, however.  The types of parameters
X    and variables are not defined at compile time, but instead are typed
X    at runtime.  Thus there is no definitions needed to distinguish
X    between integers, fractions, complex numbers, matrices, and so on.
X    Thus when declaring parameters for a function, only the name of
X    the parameter is needed.  Thus there are never any declarations
X    between the function parameter list and the body of the function.
X
X    For example, the following function computes a factorial:
X
X        define factorial(n)
X        {
X            local    ans;
X
X            ans = 1;
X            while (n > 1)
X                ans *= n--;
X            return ans;
X        }
X
X    If a function is very simple and just returns a value, then the
X    function can be defined in shortened manner by using an equals sign
X    in place of the left brace.  In this case, the function declaration
X    is terminated by a newline character, and its value is the specified
X    expression.  Statements such as 'if' are not allowed.  An optional
X    semicolon ending the expression is allowed.  As an example, the
X    average of two numbers could be defined as:
X
X        define average(a, b) = (a + b) / 2;
X
X    Functions can be defined which can be very complex.  These can be
X    defined on the command line if desired, but editing of partial
X    functions is not possible past a single line.  If an error is made
X    on a previous line, then the function must be finished (with probable
X    errors) and reentered from the beginning.  Thus for complicated
X    functions, it is best to use an editor to create the function in a
X    file, and then enter the calculator and read in the file containing
X    the definition.
X
X    The parameters of a function can be referenced by name, as in
X    normal C usage, or by using the 'param' function.  This function
X    returns the specified parameter of the function it is in, where
X    the parameters are numbered starting from 1.  The total number
X    of parameters to the function is returned by using 'param(0)'.
X    Using this function allows you to implement varargs-like routines
X    which can handle any number of calling parameters.  For example:
X
X        define sc()
X        {
X            local s, i;
X
X            s = 0;
X            for (i = 1; i <= param(0); i++)
X                s += param(i)^3;
X            return s;
X        }
X
X    defines a function which returns the sum of the cubes of all it's
X    parameters.
END_OF_FILE
if test 2679 -ne `wc -c <'help/define'`; then
    echo shar: \"'help/define'\" unpacked with wrong size!
fi
# end of 'help/define'
fi
if test -f 'help/mat' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'help/mat'\"
else
echo shar: Extracting \"'help/mat'\" \(4259 characters\)
sed "s/^X//" >'help/mat' <<'END_OF_FILE'
XUsing matrices
X
X    Matrices can have from 1 to 4 dimensions, and are indexed by a
X    normal-sized integer.  The lower and upper bounds of a matrix can
X    be specified at runtime.  The elements of a matrix are defaulted
X    to zeroes, but can be assigned to be of any type.  Thus matrices
X    can hold complex numbers, strings, objects, etc.  Matrices are
X    stored in memory as an array so that random access to the elements
X    is easy.
X
X    Matrices are normally indexed using square brackets.  If the matrix
X    is multi-dimensional, then an element can be indexed either by
X    using multiple pairs of square brackets (as in C), or else by
X    separating the indexes by commas.  Thus the following two statements
X    reference the same matrix element:
X
X        x = name[3][5];
X        x = name[3,5];
X
X    The double-square bracket operator can be used on any matrix to
X    make references to the elements easy and efficient.  This operator
X    bypasses the normal indexing mechanism, and treats the array as if
X    it was one-dimensional and with a lower bound of zero.  In this
X    indexing mode, elements correspond to the normal indexing mode where
X    the rightmost index increases most frequently.  For example, when
X    using double-square bracket indexing on a two-dimensional matrix,
X    increasing indexes will reference the matrix elements left to right,
X    row by row.  Thus in the following example, 'x' and 'y' are copied
X    from the same matrix element:
X
X        mat m[1:2, 1:3];
X        x = m[2,1];
X        y = m[[3]];
X
X    There are functions which return information about a matrix.
X    The 'size' functions returns the total number of elements.
X    The 'matdim', 'matmin', and 'matmax' functions return the number
X    of dimensions of a matrix, and the lower and upper index bounds
X    for a dimension of a matrix.  For square matrices, the 'det'
X    function calculates the determinant of the matrix.
X
X    Some functions return matrices as their results.  These    functions
X    do not affect the original matrix argument, but instead return
X    new matrices.  For example, the 'mattrans' function returns the
X    transpose of a matrix, and 'inverse' returns the inverse of a
X    matrix.  So to invert a matrix called 'x', you could use:
X
X        x = inverse(x);
X
X    The 'matfill' function fills all elements of a matrix with the
X    specified value, and optionally fills the diagonal elements of a
X    square matrix with a different value.  For example:
X
X        matfill(x,1);
X
X    will fill any matrix with ones, and:
X
X        matfill(x, 0, 1);
X
X    will create an identity matrix out of any square matrix.  Note that
X    unlike most matrix functions, this function does not return a matrix
X    value, but manipulates the matrix argument itself.
X
X    Matrices can be multiplied by numbers, which multiplies each element
X    by the number.  Matrices can also be negated, conjugated, shifted,
X    rounded, truncated, fraction'ed, and modulo'ed.  Each of these
X    operations is applied to each element.
X
X    Matrices can be added or multiplied together if the operation is
X    legal.  Note that even if the dimensions of matrices are compatible,
X    operations can still fail because of mismatched lower bounds.  The
X    lower bounds of two matrices must either match, or else one of them
X    must have a lower bound of zero.  Thus the following code:
X
X        mat x[3:3];
X        mat y[4:4];
X        z = x + y;
X
X    fails because the calculator does not have a way of knowing what
X    the bounds should be on the resulting matrix.  If the bounds match,
X    then the resulting matrix has the same bounds.  If exactly one of
X    the lower bounds is zero, then the resulting matrix will have the
X    nonzero lower bounds.  Thus means that the bounds of a matrix are
X    preserved when operated on by matrices with lower bounds of zero.
X    For example:
X
X        mat x[3:7];
X        mat y[5];
X        z = x + y;
X
X    will succeed and assign the variable 'z' a matrix whose
X    bounds are 3-7.
X
X    Vectors are matrices of only a single dimension.  The 'dp' and 'cp'
X    functions calculate the dot product and cross product of a vector
X    (cross product is only defined for vectors of size 3).
X
X    Matrices can be searched for particular values by using the 'search'
X    and 'rsearch' functions.  They return the element number of the
X    found value (zero based), or null if the value does not exist in the
X    matrix.  Using the element number in double-bracket indexing will
X    then refer to the found element.
END_OF_FILE
if test 4259 -ne `wc -c <'help/mat'`; then
    echo shar: \"'help/mat'\" unpacked with wrong size!
fi
# end of 'help/mat'
fi
if test -f 'help/types' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'help/types'\"
else
echo shar: Extracting \"'help/types'\" \(3769 characters\)
sed "s/^X//" >'help/types' <<'END_OF_FILE'
XBuiltin types
X
X    The calculator has the following built-in types.
X
X    null value
X        This is the undefined value type.  The function 'null'
X        returns this value.  Functions which do not explicitly
X        return a value return this type.  If a function is called
X        with fewer parameters than it is defined for, then the
X        missing parameters have the null type.  Defining a
X        new variable initializes it to the null type.  The null
X        value is false if used in an IF test.
X
X    rational numbers
X        This is the basic data type of the calculator.
X        These are fractions whose numerators and denominators
X        can be arbitrarily large.  The fractions are always
X        in lowest terms.  Integers have a denominator of 1.
X        The numerator of the number contains the sign, so that
X        the denominator is always positive.  When a number is
X        entered in floating point or exponential notation, it is
X        immediately converted to the appropriate fractional value.
X        Printing a value as a floating point or exponential value
X        involves a conversion from the fractional representation.
X
X        Numbers are stored in binary format, so that in general,
X        bit tests and shifts are quicker than multiplies and divides.
X        Similarly, entering or displaying of numbers in binary,
X        octal, or hex formats is quicker than in decimal.  The
X        sign of a number does not affect the bit representation
X        of a number.
X
X    complex numbers
X        Complex numbers are composed of real and imaginary parts,
X        which are both fractions as defined above.  An integer which
X        is followed by an 'i' character is a pure imaginary number.
X        Complex numbers such as "2+3i" when typed in, are processed
X        as the sum of a real and pure imaginary number, resulting
X        in the desired complex number.  Therefore, parenthesis are
X        sometimes necessary to avoid confusion, as in the two values:
X
X            1+2i ^2        (which is -3)
X            (1+2i) ^2    (which is -3+4i)
X
X        Similar care is required when entering fractional complex
X        numbers.  Note the differences below:
X
X            3/4i        (which is -(3/4)i)
X            3i/4        (which is (3/4)i)
X
X        The imaginary unit itself is input using "1i".
X
X    strings
X        Strings are a sequence of zero or more characters.
X        They are input using either of the single or double
X        quote characters.  The quote mark which starts the
X        string also ends it.  Various special characters can
X        also be inserted using back-slash.  Example strings:
X
X            "hello\n"
X            "that's all"
X            'lots of """"'
X            'a'
X            ""
X
X        There is no distinction between single character and
X        multi-character strings.  The 'str' and 'ord' functions
X        will convert between a single character string and its
X        numeric value.  The 'str' and 'eval' functions will
X        convert between longer strings and the corresponding
X        numeric value (if legal).  The 'strcat', 'strlen', and
X        'substr' functions are also useful.
X
X    matrices
X        These are one to four dimensional matrices, whose minimum
X        and maximum bounds can be specified at runtime.  Unlike C,
X        the minimum bounds of a matrix do not have to start at 0.
X        The elements of a matrix can be of any type.  There are
X        several built-in functions for matrices.  Matrices are
X        created using the 'mat' statement.
X
X
X    lists
X        These are a sequence of values, which are linked together
X        so that elements can be easily be inserted or removed
X        anywhere in the list.  The values can be of any type.
X        Lists are created using the 'list' function.
X
X    files
X        These are text files opened using stdio.  Files may be opened
X        for sequential reading, writing, or appending.  Opening a
X        file using the 'fopen' function returns a value which can
X        then be used to perform I/O to that file.  File values can
X        be copied by normal assignments between variables, or by
X        using the result of the 'files' function.  Such copies are
X        indistinguishable from each other.
END_OF_FILE
if test 3769 -ne `wc -c <'help/types'`; then
    echo shar: \"'help/types'\" unpacked with wrong size!
fi
# end of 'help/types'
fi
if test -f 'label.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'label.c'\"
else
echo shar: Extracting \"'label.c'\" \(3751 characters\)
sed "s/^X//" >'label.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 * Label handling routines.
X */
X
X#include "calc.h"
X#include "token.h"
X#include "label.h"
X#include "string.h"
X#include "opcodes.h"
X#include "func.h"
X
Xstatic long labelcount;            /* number of user labels defined */
Xstatic STRINGHEAD labelnames;        /* list of user label names */
Xstatic LABEL labels[MAXLABELS];        /* list of user labels */
X
X
X/*
X * Initialize the table of labels for a function.
X */
Xvoid
Xinitlabels()
X{
X    labelcount = 0;
X    initstr(&labelnames);
X}
X
X
X/*
X * Define a user named label to have the offset of the next opcode.
X */
Xvoid
Xdefinelabel(name)
X    char *name;            /* label name */
X{
X    register LABEL *lp;        /* current label */
X    long i;                /* current label index */
X
X    i = findstr(&labelnames, name);
X    if (i >= 0) {
X        lp = &labels[i];
X        if (lp->l_offset) {
X            scanerror(T_NULL, "Label \"%s\" is multiply defined",
X                name);
X            return;
X        }
X        setlabel(lp);
X        return;
X    }
X    if (labelcount >= MAXLABELS) {
X        scanerror(T_NULL, "Too many labels in use");
X        return;
X    }
X    lp = &labels[labelcount++];
X    lp->l_chain = 0;
X    lp->l_offset = curfunc->f_opcodecount;
X    lp->l_name = addstr(&labelnames, name);
X    clearopt();
X}
X
X
X/*
X * Add the offset corresponding to the specified user label name to the
X * opcode table for a function. If the label is not yet defined, then a
X * chain of undefined offsets is built using the offset value, and it
X * will be fixed up when the label is defined.
X */
Xvoid
Xaddlabel(name)
X    char *name;            /* user symbol name */
X{
X    register LABEL *lp;        /* current label */
X    long i;                /* counter */
X
X    for (i = labelcount, lp = labels; --i >= 0; lp++) {
X        if (strcmp(name, lp->l_name))
X            continue;
X        uselabel(lp);
X        return;
X    }
X    if (labelcount >= MAXLABELS) {
X        scanerror(T_NULL, "Too many labels in use");
X        return;
X    }
X    lp = &labels[labelcount++];
X    lp->l_offset = 0;
X    lp->l_chain = curfunc->f_opcodecount;
X    lp->l_name = addstr(&labelnames, name);
X    addop(0);
X}
X
X
X/*
X * Check to make sure that all labels are defined.
X */
Xvoid
Xchecklabels()
X{
X    register LABEL *lp;        /* label being checked */
X    long i;                /* counter */
X
X    for (i = labelcount, lp = labels; --i >= 0; lp++) {
X        if (lp->l_offset > 0)
X            continue;
X        scanerror(T_NULL, "Label \"%s\" was never defined",
X            lp->l_name);
X    }
X}
X
X
X/*
X * Clear an internal label for use.
X */
Xvoid
Xclearlabel(lp)
X    register LABEL *lp;    /* label being cleared */
X{
X    lp->l_offset = 0;
X    lp->l_chain = 0;
X    lp->l_name = NULL;
X}
X
X
X/*
X * Set any label to have the value of the next opcode in the current
X * function being defined.  If there were forward references to it,
X * all such references are patched up.
X */
Xvoid
Xsetlabel(lp)
X    register LABEL *lp;    /* label being set */
X{
X    register FUNC *fp;    /* current function */
X    long curfix;        /* offset of current location being fixed */
X    long nextfix;        /* offset of next location to fix up */
X    long offset;        /* offset of this label */
X
X    fp = curfunc;
X    offset = fp->f_opcodecount;
X    nextfix = lp->l_chain;
X    while (nextfix > 0) {
X        curfix = nextfix;
X        nextfix = fp->f_opcodes[curfix];
X        fp->f_opcodes[curfix] = offset;
X    }
X    lp->l_chain = 0;
X    lp->l_offset = offset;
X    clearopt();
X}
X
X
X/*
X * Use the specified label at the current location in the function
X * being compiled.  This adds one word to the current function being
X * compiled.  If the label is not yet defined, a patch chain is built
X * so the reference can be fixed when the label is defined.
X */
Xvoid
Xuselabel(lp)
X    register LABEL *lp;        /* label being used */
X{
X    long offset;            /* offset being added */
X
X    offset = curfunc->f_opcodecount;
X    if (lp->l_offset > 0) {
X        addop(lp->l_offset);
X        return;
X    }
X    addop(lp->l_chain);
X    lp->l_chain = offset;
X}
X
X/* END CODE */
END_OF_FILE
if test 3751 -ne `wc -c <'label.c'`; then
    echo shar: \"'label.c'\" unpacked with wrong size!
fi
# end of 'label.c'
fi
if test -f 'lib/README' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lib/README'\"
else
echo shar: Extracting \"'lib/README'\" \(4595 characters\)
sed "s/^X//" >'lib/README' <<'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
XThe following calc library files are provided because they serve as
Xexamples of how use the calc language, and because the authors thought
Xthem to be useful!
X
XIf you write something that you think is useful, please send it to:
X
X    [e-mail]     {uunet,pyramid}!pdact.pd.necisa.oz.au!dbell
X    [e-mail]                 {uunet,pyramid,sun}!hoptoad!chongo
X
XBy convention, a lib file just defines functions, objects and variales.
X(The regression test is an exception.)  Also by convention, the a usage
Xmessage regarding each important object and function is printed at
Xthe time of the read.  This message printing may be disabled by assigning
Xthe global value  lib_debug  to a numeric value > 0.
X
X
Xbernoulli.cal
X
X    B(n)
X    Calculate the nth Bernoulli number.
X
X
Xbigprime.cal
X
X    bigprime(a, m, p)
X
X    A prime test, base a, on p*2^x+1 for even x>m.
X
X
Xdeg.cal
X
X    dms(deg, min, sec)
X    dms_add(a, b)
X    dms_neg(a)
X    dms_sub(a, b)
X    dms_mul(a, b)
X    dms_print(a)
X
X    Calculate in degrees, minutes, and seconds.
X
X
Xellip.cal
X
X    factor(iN, ia, B, force)
X
X    Attempt to factor using the elliptic functions: y^2 = x^3 + a*x + b.
X
X
Xlucas.cal
X
X    lucas(h, n)
X
X    Perform a primality test of h*2^n-1, with 1<=h<2*n.
X
X
Xlucas_chk.cal
X
X    lucas_chk(high_n)
X
X    Test all primes of the form h*2^n-1, with 1<=h<200 and n <= high_n.
X    Requires lucas.cal to be loaded.  The highest useful high_n is 1000.
X
X
Xlucas_tbl.cal
X
X    Lucasian criteria for primality tables.
X
X
Xmersenne.cal
X
X    mersenne(p)
X
X    Perform a primality test of 2^p-1, for prime p>1.
X
X
Xmod.cal
X
X    mod(a)
X    mod_print(a)
X    mod_one()
X    mod_cmp(a, b)
X    mod_rel(a, b)
X    mod_add(a, b)
X    mod_sub(a, b)
X    mod_neg(a)
X    mod_mul(a, b)
X    mod_square(a)
X    mod_inc(a)
X    mod_dec(a)
X    mod_inv(a)
X    mod_div(a, b)
X    mod_pow(a, b)
X
X    Routines to handle numbers modulo a specified number.
X
X
Xnextprim.cal
X
X    nextprime(n, tries)
X
X    Function to find the next prime (probably).
X
X
Xpell.cal
X
X    pellx(D)
X    pell(D)
X
X    Solve Pell's equation; Returns the solution X to: X^2 - D * Y^2 = 1.
X    Type the solution to pells equation for a particular D.
X
X
Xpi.cal
X
X    qpi(epsilon)
X
X    Calculate pi within the specified epsilon using the quartic convergence
X    iteration.
X
X
Xpollard.cal
X
X    factor(N, N, ai, af)
X
X    Factor using Pollard's p-1 method.
X
X
Xpoly.cal
X
X    pol()
X    poly_print(a)
X    poly_add(a, b)
X    poly_neg(a)
X    poly_sub(a, b)
X    poly_mul(a, b)
X    poly_div(a, b)
X    ev(a, x)
X
X    Calculate with polynomials of one variable
X
X
Xpsqrt.cal
X
X    psqrt(u, p)
X
X    Calculate square roots modulo a prime
X
X
Xquat.cal
X
X    quat(a, b, c, d)
X    quat_print(a)
X    quat_norm(a)
X    quat_abs(a, e)
X    quat_conj(a)
X    quat_add(a, b)
X    quat_sub(a, b)
X    quat_inc(a)
X    quat_dec(a)
X    quat_neg(a)
X    quat_mul(a, b)
X    quat_div(a, b)
X    quat_inv(a)
X    quat_scale(a, b)
X    quat_shift(a, b)
X
X    Calculate using quaternions of the form: a + bi + cj + dk.  In these
X    functions, quaternians are manipulated in the form: s + v, where
X    s is a scalar and v is a vector of size 3.
X
X
Xregress.cal
X
X    Test the correct execution of the calculator by reading this library file.
X    Errors are reported with '****' mssages, or worse.  :-)
X
X
Xsolve.cal
X
X    solve(low, high, epsilon)
X
X    Solve the equation f(x) = 0 to within the desired error value for x.
X    The function 'f' must be defined outside of this routine, and the low
X    and high values are guesses which must produce values with opposite signs.
X
X
Xsumsq.cal
X
X    ss(p)
X
X    Determine the unique two positive integers whose squares sum to the
X    specified prime.  This is always possible for all primes of the form
X    4N+1, and always impossible for primes of the form 4N-1.
X
X
Xsurd.cal
X
X    surd(a, b)
X    surd_print(a)
X    surd_conj(a)
X    surd_norm(a)
X    surd_value(a, xepsilon)
X    surd_add(a, b)
X    surd_sub(a, b)
X    surd_inc(a)
X    surd_dec(a)
X    surd_neg(a)
X    surd_mul(a, b)
X    surd_square(a)
X    surd_scale(a, b)
X    surd_shift(a, b)
X    surd_div(a, b)
X    surd_inv(a)
X    surd_sgn(a)
X    surd_cmp(a, b)
X    surd_rel(a, b)
X
X    Calculate using quadratic surds of the form: a + b * sqrt(D).
X
X
Xunitfrac.cal
X
X    unitfrac(x)
X
X    Represent a fraction as sum of distinct unit fractions.
X
X
Xvarargs.cal
X
X    sc(a, b, ...)
X
X    Example program to use 'varargs'.  Program to sum the cubes of all
X    the specified numbers.
END_OF_FILE
if test 4595 -ne `wc -c <'lib/README'`; then
    echo shar: \"'lib/README'\" unpacked with wrong size!
fi
# end of 'lib/README'
fi
if test -f 'lib/mod.cal' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lib/mod.cal'\"
else
echo shar: Extracting \"'lib/mod.cal'\" \(3593 characters\)
sed "s/^X//" >'lib/mod.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 * Routines to handle numbers modulo a specified number.
X *    a (mod N)
X */
X
Xobj mod {a};            /* definition of the object */
X
Xglobal mod_value;        /* modulus value (value of N) */
X
X
Xdefine mod(a)
X{
X    local x;
X
X    obj mod x;
X    if (!isreal(a) || !isint(a))
X        quit "Bad argument for mod function";
X    x.a = a % mod_value;
X    return x;
X}
X
X
Xdefine mod_print(a)
X{
X    if (digits(mod_value) <= 20)
X        print a.a, "(mod", mod_value : ")" :;
X    else
X        print a.a, "(mod N)" :;
X}
X
X
Xdefine mod_one()
X{
X    return mod(1);
X}
X
X
Xdefine mod_cmp(a, b)
X{
X    if (isnum(a))
X        return (a % mod_value) != b.a;
X    if (isnum(b))
X        return (b % mod_value) != a.a;
X    return a.a != b.a;
X}
X
X
Xdefine mod_rel(a, b)
X{
X    if (isnum(a))
X        a = mod(a);
X    if (isnum(b))
X        b = mod(b);
X    if (a.a < b.a)
X        return -1;
X    return a.a != b.a;
X}
X
X
Xdefine mod_add(a, b)
X{
X    local x;
X
X    obj mod x;
X    if (isnum(b)) {
X        if (!isint(b))
X            quit "Adding non-integer";
X        x.a = (a.a + b) % mod_value;
X        return x;
X    }
X    if (isnum(a)) {
X        if (!isint(a))
X            quit "Adding non-integer";
X        x.a = (a + b.a) % mod_value;
X        return x;
X    }
X    x.a = (a.a + b.a) % mod_value;
X    return x;
X}
X
X
Xdefine mod_sub(a, b)
X{
X    return a + (-b);
X}
X
X
Xdefine mod_neg(a)
X{
X    local x;
X
X    obj mod x;
X    x.a = mod_value - a.a;
X    return x;
X}
X
X
Xdefine mod_mul(a, b)
X{
X    local x;
X
X    obj mod x;
X    if (isnum(b)) {
X        if (!isint(b))
X            quit "Multiplying by non-integer";
X        x.a = (a.a * b) % mod_value;
X        return x;
X    }
X    if (isnum(a)) {
X        if (!isint(a))
X            quit "Multiplying by non-integer";
X        x.a = (a * b.a) % mod_value;
X        return x;
X    }
X    x.a = (a.a * b.a) % mod_value;
X    return x;
X}
X
X
Xdefine mod_square(a)
X{
X    local x;
X
X    obj mod x;
X    x.a = a.a^2 % mod_value;
X    return x;
X}
X
X
Xdefine mod_inc(a)
X{
X    local x;
X
X    x = a;
X    if (++x.a == mod_value)
X        x.a = 0;
X    return x;
X}
X
X
Xdefine mod_dec(a)
X{
X    local x;
X
X    x = a;
X    if (--x.a < 0)
X        x.a = mod_value - 1;
X    return x;
X}
X
X
Xdefine mod_inv(a)
X{
X    local x;
X
X    obj mod x;
X    x.a = minv(a.a, mod_value);
X    return x;
X}
X
X
Xdefine mod_div(a, b)
X{
X    local c, x, y;
X
X    obj mod x, y;
X    if (isnum(a))
X        a = mod(a);
X    if (isnum(b))
X        b = mod(b);
X    c = gcd(a.a, b.a);
X    x.a = a.a / c;
X    y.a = b.a / c;
X    return x * inverse(y);
X}
X
X
Xdefine mod_pow(a, b)
X{
X    local x, y, z;
X
X    obj mod x;
X    y = a;
X    z = b;
X    if (b < 0) {
X        y = inverse(a);
X        z = -b;
X    }
X    x.a = pmod(y.a, z, mod_value);
X    return x;
X}
X
X
Xmod_value = 100;        /* default */
X
Xglobal lib_debug;
Xif (!isnum(lib_debug) || lib_debug>0) print "obj mod {a} defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "mod(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "mod_print(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "mod_one(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "mod_cmp(a, b) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "mod_rel(a, b) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "mod_add(a, b) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "mod_sub(a, b) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "mod_mod(a, b) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "mod_square(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "mod_inc(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "mod_dec(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "mod_inv(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "mod_div(a, b) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "mod_pow(a, b) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "mod_value defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "set mod_value as needed"
END_OF_FILE
if test 3593 -ne `wc -c <'lib/mod.cal'`; then
    echo shar: \"'lib/mod.cal'\" unpacked with wrong size!
fi
# end of 'lib/mod.cal'
fi
if test -f 'lib/poly.cal' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lib/poly.cal'\"
else
echo shar: Extracting \"'lib/poly.cal'\" \(3619 characters\)
sed "s/^X//" >'lib/poly.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 with polynomials of one variable.
X */
X
Xobj poly {deg, coef};
X
X
Xdefine pol()
X{
X    local x, d, i;
X
X    d = param(0) - 1;
X    if (d < 0)
X        quit "No coefficients for pol";
X    if (d == 0)
X        return param(1);
X    obj poly x;
X    x.deg = d;
X    mat x.coef[d+1];
X    for (i = 0; i <= d; i++)
X        x.coef[d-i] = param(i+1);
X    return x;
X}
X
X
Xdefine poly_print(a)
X{
X    local i, n;
X
X    for (i = a.deg; i >= 0; i--) {
X        n = a.coef[i];
X        if (n == 0)
X            continue;
X        if (i == a.deg) {
X            if (isreal(n) && (n < 0)) {
X                print "- " : ;
X                n = abs(n);
X            }
X        } else {
X            if (!isreal(n) || (n > 0))
X                print " + " : ;
X            else {
X                print " - " : ;
X                n = abs(n);
X            }
X        }
X        if ((n != 1) && (i > 0)) {
X            if (isreal(n))
X                print n : "*" : ;
X            else
X                print "(" : n : ")*" : ;
X        }
X        switch (i) {
X            case 0:
X                if (isreal(n))
X                    print n : ;
X                else
X                    print "(" : n : ")" : ;
X                break;
X            case 1:
X                print "X" : ;
X                break;
X            default:
X                print "X^" : i : ;
X        }
X    }
X}
X
X
Xdefine poly_add(a, b)
X{
X    local x, d;
X
X    if (isnum(b)) {
X        x = a;
X        x.coef[0] += b;
X        return x;
X    }
X    if (isnum(a)) {
X        x = b;
X        x.coef[0] += a;
X        return x;
X    }
X    if (a.deg == b.deg) {
X        d = a.deg;
X        while (a.coef[d] == -b.coef[d])
X            if (--d <= 0)
X                return a.coef[0] + b.coef[0];
X    }
X    d = max(a.deg, b.deg);
X    obj poly x;
X    x.deg = d;
X    mat x.coef[d+1];
X    while (d >= 0) {
X        if (d > a.deg)
X            x.coef[d] = b.coef[d];
X        else if (d > b.deg)
X            x.coef[d] = a.coef[d];
X        else
X            x.coef[d] = a.coef[d] + b.coef[d];
X        d--;
X    }
X    return x;
X}
X
X
Xdefine poly_neg(a)
X{
X    local x, i;
X
X    x = a;
X    for (i = x.deg; i >= 0; i--)
X        x.coef[i] = -x.coef[i];
X    return x;
X}
X
X
Xdefine poly_sub(a, b)
X{
X    return a + (-b);
X}
X
X
Xdefine poly_mul(a, b)
X{
X    local x, i, j;
X
X    if (isnum(b)) {
X        if (b == 0)
X            return 0;
X        if (b == 1)
X            return a;
X        if (b == -1)
X            return -a;
X        x = a;
X        for (i = x.deg; i >= 0; i--)
X            x.coef[i] *= b;
X        return x;
X    }
X    if (isnum(a)) {
X        if (a == 0)
X            return 0;
X        if (a == 1)
X            return a;
X        if (a == -1)
X            return -a;
X        x = b;
X        for (i = x.deg; i >= 0; i--)
X            x.coef[i] *= a;
X        return x;
X    }
X    obj poly x;
X    x.deg = a.deg + b.deg;
X    mat x.coef[x.deg+1];
X    for (i = a.deg; i >= 0; i--)
X        for (j = b.deg; j >= 0; j--)
X            x.coef[i+j] += a.coef[i] * b.coef[j];
X    return x;
X}
X
X
Xdefine poly_div(a, b)
X{
X    local i, x;
X
X    if (!isnum(b))
X        quit "Only division by numbers currently allowed";
X    if (b == 0)
X        quit "Division by zero";
X    if (b == 1)
X        return a;
X    if (b == -1)
X        return -a;
X    x = a;
X    for (i = x.deg; i >= 0; i--)
X        x.coef[i] /= b;
X    return x;
X}
X
X
Xdefine ev(a, x)
X{
X    local i, r;
X
X    obj poly r;
X    if (!istype(a, r))
X        quit "Evaluating non-polynomial";
X    i = a.deg;
X    r = a.coef[i];
X    while (--i >= 0)
X        r = r * x + a.coef[i];
X    return r;
X}
X
Xglobal lib_debug;
Xif (!isnum(lib_debug) || lib_debug>0) print "obj poly {deg, coef} defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "pol() defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "poly_print(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "poly_add(a, b) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "poly_neg(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "poly_sub(a, b) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "poly_mul(a, b) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "poly_div(a, b) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "ev(a, x) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "Use pol() to make polynomials (high coefficient first)"
Xif (!isnum(lib_debug) || lib_debug>0) print "Use ev(a, x) to evaluate them"
END_OF_FILE
if test 3619 -ne `wc -c <'lib/poly.cal'`; then
    echo shar: \"'lib/poly.cal'\" unpacked with wrong size!
fi
# end of 'lib/poly.cal'
fi
if test -f 'lib/quat.cal' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lib/quat.cal'\"
else
echo shar: Extracting \"'lib/quat.cal'\" \(3577 characters\)
sed "s/^X//" >'lib/quat.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 * Routines to handle quaternions of the form:
X *    a + bi + cj + dk
X *
X * Note: In this module, quaternians are manipulated in the form:
X *    s + v
X * Where s is a scalar and v is a vector of size 3.
X */
X
Xobj quat {s, v};        /* definition of the quaternion object */
X
X
Xdefine quat(a,b,c,d)
X{
X    local x;
X
X    obj quat x;
X    x.s = isnull(a) ? 0 : a;
X    mat x.v[3];
X    x.v[0] = isnull(b) ? 0 : b;
X    x.v[1] = isnull(c) ? 0 : c;
X    x.v[2] = isnull(d) ? 0 : d;
X    return x;
X}
X
X
Xdefine quat_print(a)
X{
X    print "quat(" : a.s : ", " : a.v[0] : ", " : a.v[1] : ", " : a.v[2] : ")" :;
X}
X
X
Xdefine quat_norm(a)
X{
X    return a.s^2 + dp(a.v, a.v);
X}
X
X
Xdefine quat_abs(a, e)
X{
X    return sqrt(a.s^2 + dp(a.v, a.v), e);
X}
X
X
Xdefine quat_conj(a)
X{
X    local    x;
X
X    obj quat x;
X    x.s = a.s;
X    x.v = -a.v;
X    return x;
X}
X
X
Xdefine quat_add(a, b)
X{
X    local x;
X
X    obj quat x;
X    if (!istype(b, x)) {
X        x.s = a.s + b;
X        x.v = a.v;
X        return x;
X    }
X    if (!istype(a, x)) {
X        x.s = a + b.s;
X        x.v = b.v;
X        return x;
X    }
X    x.s = a.s + b.s;
X    x.v = a.v + b.v;
X    if (x.v)
X        return x;
X    return x.s;
X}
X
X
Xdefine quat_sub(a, b)
X{
X    local x;
X
X    obj quat x;
X    if (!istype(b, x)) {
X        x.s = a.s - b;
X        x.v = a.v;
X        return x;
X    }
X    if (!istype(a, x)) {
X        x.s = a - b.s;
X        x.v = -b.v;
X        return x;
X    }
X    x.s = a.s - b.s;
X    x.v = a.v - b.v;
X    if (x.v)
X        return x;
X    return x.s;
X}
X
X
Xdefine quat_inc(a)
X{
X    local    x;
X
X    x = a;
X    x.s++;
X    return x;
X}
X
X
Xdefine quat_dec(a)
X{
X    local    x;
X
X    x = a;
X    x.s--;
X    return x;
X}
X
X
Xdefine quat_neg(a)
X{
X    local    x;
X
X    obj quat x;
X    x.s = -a.s;
X    x.v = -a.v;
X    return x;
X}
X
X
Xdefine quat_mul(a, b)
X{
X    local x;
X
X    obj quat x;
X    if (!istype(b, x)) {
X        x.s = a.s * b;
X        x.v = a.v * b;
X    } else if (!istype(a, x)) {
X        x.s = b.s * a;
X        x.v = b.v * a;
X    } else {
X        x.s = a.s * b.s - dp(a.v, b.v);
X        x.v = a.s * b.v + b.s * a.v + cp(a.v, b.v);
X    }
X    if (x.v)
X        return x;
X    return x.s;
X}
X
X
Xdefine quat_div(a, b)
X{
X    local    x;
X
X    obj quat x;
X    if (!istype(b, x)) {
X        x.s = a.s / b;
X        x.v = a.v / b;
X        return x;
X    }
X    return a * quat_inv(b);
X}
X
X
Xdefine quat_inv(a)
X{
X    local    x, q2;
X
X    obj quat x;
X    q2 = a.s^2 + dp(a.v, a.v);
X    x.s = a.s / q2;
X    x.v = a.v / (-q2);
X    return x;
X}
X
X
Xdefine quat_scale(a, b)
X{
X    local    x;
X
X    obj quat x;
X    x.s = scale(a.s, b);
X    x.v = scale(a.v, b);
X    return x;
X}
X
X
Xdefine quat_shift(a, b)
X{
X    local    x;
X
X    obj quat x;
X    x.s = a.s << b;
X    x.v = a.v << b;
X    if (x.v)
X        return x;
X    return x.s;
X}
X
Xglobal lib_debug;
Xif (!isnum(lib_debug) || lib_debug>0) print "obj quat {s, v} defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "quat(a, b, c, d) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "quat_print(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "quat_norm(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "quat_abs(a, e) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "quat_conj(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "quat_add(a, e) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "quat_sub(a, e) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "quat_inc(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "quat_dec(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "quat_neg(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "quat_mul(a, b) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "quat_div(a, b) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "quat_inv(a) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "quat_scale(a, b) defined"
Xif (!isnum(lib_debug) || lib_debug>0) print "quat_shift(a, b) defined"
END_OF_FILE
if test 3577 -ne `wc -c <'lib/quat.cal'`; then
    echo shar: \"'lib/quat.cal'\" unpacked with wrong size!
fi
# end of 'lib/quat.cal'
fi
echo shar: End of archive 2 \(of 21\).
cp /dev/null ark2isdone
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