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

Release calc version 2.10.3t5.45

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

14
BUGS
View File

@@ -10,7 +10,8 @@ If that does not help, cd to the calc source directory and try:
Look at the end of the output, it should say something like:
9999: passed all tests /\../\
9998: passed all tests /\../\
9999: Ending regression tests
If it does not, then something is really broken!
@@ -79,16 +80,11 @@ of a context diff patch) to:
Known problems or mis-features:
* In calc2.10.2t3, when scan() reads characters from stdin, they
are not echoed. This also happens with fgets(files(0)) and
fgetline(files(0)). Reports indicate that this did not happen in
calc.2.10.1t20 but did in 2.10.2t0.
* Many of LIBRARY, LIMITS and SEE ALSO sections of help files
* Many of and SEE ALSO sections of help files
for builtins are either inconsistent or missing information.
* The functions filepos2z() and z2filepos() do not work (or
worse do not compile) when FILEPOS is 64 bits long.
* Many of the LIBRARY sections are incorrect now that libcalc.a
contains most of the calc system.
* There is some places in the source with obscure variable names
and not much in the way of comments. We need some major cleanup

2071
CHANGES
View File

File diff suppressed because it is too large Load Diff

29
LIBRARY
View File

@@ -10,13 +10,19 @@ precision arithmetic with integers, rational numbers, or complex numbers.
There are also many numeric functions such as factorial and gcd, along
with some transcendental functions such as sin and exp.
Take a look at the sample sub-directory. It contains a few simple
examples of how to use libcalc.a that might be helpful to look at
after you have read this file.
------------------
FIRST THINGS FIRST
------------------
*******************************************************************************
* You MUST call libcalc_call_me_first() prior to using libcalc lib functions! *
*******************************************************************************
...............................................................................
. .
. You MUST call libcalc_call_me_first() prior to using libcalc lib functions! .
. .
...............................................................................
The function libcalc_call_me_first() takes no args and returns void. You
need call libcalc_call_me_first() only once.
@@ -98,7 +104,11 @@ For example:
...
if ((error = setjmp(calc_jmp_buf)) != 0) {
/* handle error */
/* reinitialize calc after a longjmp */
reinitialize();
/* report the error */
printf("Ouch: %s\n", calc_error);
}
calc_jmp = 1;
@@ -434,3 +444,14 @@ for equality. The ccmp function returns TRUE if two complex numbers differ.
There are three predefined values for complex numbers. You should clink
them when you want to use them. They are _czero_, _cone_, and _conei_.
These have the values 0, 1, and i.
----------------
LAST THINGS LAST
----------------
If you wish, when you are all doen you can call libcalc_call_me_last()
to free a small amount of storage associated with the libcalc_call_me_first()
call. This is not required, but is does bring things to a closure.
The function libcalc_call_me_last() takes no args and returns void. You
need call libcalc_call_me_last() only once.

1314
Makefile
View File

File diff suppressed because it is too large Load Diff

4
README
View File

@@ -1,10 +1,10 @@
# Copyright (c) 1994 David I. Bell
# Copyright (c) 1997 David I. Bell
# Permission is granted to use, distribute, or modify this source,
# provided that this copyright notice remains intact.
#
# Arbitrary precision calculator.
I am allowing this calculator to be freely distributed for personal uses.
I am allowing this calculator to be freely distributed for your enjoyment.
Like all multi-precision programs, you should not depend absolutely on
its results, since bugs in such programs can be insidious and only rarely
show up.

358
addop.c
View File

@@ -1,11 +1,12 @@
/*
* Copyright (c) 1995 David I. Bell
* Copyright (c) 1997 David I. Bell
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*
* Add opcodes to a function being compiled.
*/
#include <stdio.h>
#include "calc.h"
#include "opcodes.h"
#include "string.h"
@@ -22,6 +23,7 @@
static long maxopcodes; /* number of opcodes available */
static long newindex; /* index of new function */
static long oldop; /* previous opcode */
static long oldoldop; /* opcode before previous opcode */
static long debugline; /* line number of latest debug opcode */
static long funccount; /* number of functions */
static long funcavail; /* available number of functions */
@@ -61,20 +63,25 @@ showfunctions(void)
{
FUNC **fpp; /* pointer into function table */
FUNC *fp; /* current function */
long count;
if (funccount == 0) {
printf("No user functions defined.\n");
return;
count = 0;
if (funccount > 0) {
for (fpp = &functions[funccount - 1]; fpp >= functions; fpp--) {
fp = *fpp;
if (fp == NULL)
continue;
if (count++ == 0) {
printf("Name Arguments\n---- ---------\n");
}
printf("%-12s %-2d\n", fp->f_name, fp->f_paramcount);
}
}
printf("Name Arguments\n");
printf("---- ---------\n");
for (fpp = &functions[funccount - 1]; fpp >= functions; fpp--) {
fp = *fpp;
if (fp == NULL)
continue;
printf("%-12s %-2d\n", fp->f_name, fp->f_paramcount);
if (count > 0) {
printf("\nNumber: %ld\n", count);
} else {
printf("No user functions defined\n");
}
printf("\n");
}
@@ -112,6 +119,7 @@ beginfunc(char *name, BOOL newflag)
initlocals();
initlabels();
oldop = OP_NOP;
oldoldop = OP_NOP;
debugline = 0;
errorcount = 0;
}
@@ -128,8 +136,13 @@ endfunc(void)
register FUNC *fp; /* function just finished */
unsigned long size; /* size of just created function */
if (oldop != OP_RETURN) {
addop(OP_UNDEF);
addop(OP_RETURN);
}
checklabels();
if (errorcount) {
freefunc(curfunc);
printf("\"%s\": %ld error%s\n", curfunc->f_name, errorcount,
((errorcount == 1) ? "" : "s"));
return;
@@ -151,13 +164,15 @@ endfunc(void)
}
}
if (functions[newindex]) {
freenumbers(functions[newindex]);
free(functions[newindex]);
fprintf(stderr, "**** %s() has been redefined\n", fp->f_name);
if (inputisterminal() || conf->lib_debug >= 0)
printf("%s() redefined\n", fp->f_name);
}
else if (inputisterminal() || conf->lib_debug >= 0)
printf("%s() defined\n", fp->f_name);
functions[newindex] = fp;
objuncache();
if (inputisterminal())
printf("\"%s\" defined\n", fp->f_name);
}
@@ -195,6 +210,83 @@ adduserfunc(char *name)
return index;
}
/*
* Remove user defined function
*/
void
rmuserfunc(char *name)
{
long index; /* index of function */
index = findstr(&funcnames, name);
if (index < 0) {
printf("%s() has never been defined\n",
name);
return;
}
if (functions[index] == NULL)
return;
freenumbers(functions[index]);
free(functions[index]);
if (!inputisterminal() && conf->lib_debug >= 0)
printf("%s() undefined\n", name);
functions[index] = NULL;
}
/*
* Free memory used to store function and its constants
*/
void
freefunc(FUNC *fp)
{
long i;
if (fp == NULL)
return;
if (conf->traceflags & TRACE_FNCODES) {
printf("Freeing function \"%s\"\n", fp->f_name);
dumpnames = FALSE;
for (i = 0; i < fp->f_opcodecount; ) {
printf("%ld: ", i);
i += dumpop(&fp->f_opcodes[i]);
}
}
freenumbers(fp);
if (fp != functemplate)
free(fp);
}
void
rmalluserfunc(void)
{
FUNC **fpp;
for (fpp = functions; fpp < &functions[funccount]; fpp++) {
if (*fpp) {
freefunc(*fpp);
*fpp = NULL;
}
}
}
/*
* get index of defined user function with specified name, or -1 if there
* is none or if it has been undefined
*/
long
getuserfunc(char *name)
{
long index;
index = findstr(&funcnames, name);
if (index >= 0 && functions[index] != NULL)
return index;
return -1L;
}
/*
* Clear any optimization that may be done for the next opcode.
@@ -204,6 +296,7 @@ void
clearopt(void)
{
oldop = OP_NOP;
oldoldop = OP_NOP;
debugline = 0;
}
@@ -253,10 +346,17 @@ void
addop(long op)
{
register FUNC *fp; /* current function */
NUMBER *q;
NUMBER *q, *q1, *q2;
unsigned long count;
BOOL cut;
int diff;
fp = curfunc;
if ((fp->f_opcodecount + 5) >= maxopcodes) {
count = fp->f_opcodecount;
cut = TRUE;
diff = 2;
q = NULL;
if ((count + 5) >= maxopcodes) {
maxopcodes += OPCODEALLOCSIZE;
fp = (FUNC *) malloc(funcsize(maxopcodes));
if (fp == NULL) {
@@ -269,73 +369,169 @@ addop(long op)
free(curfunc);
curfunc = fp;
}
/*
* Check the current opcode against the previous opcode and try to
* slightly optimize the code depending on the various combinations.
*/
if (op == OP_GETVALUE) {
switch (oldop) {
switch (op) {
case OP_GETVALUE:
switch (oldop) {
case OP_NUMBER:
case OP_ZERO:
case OP_ONE:
case OP_IMAGINARY:
case OP_GETEPSILON:
case OP_SETEPSILON:
case OP_STRING:
case OP_UNDEF:
case OP_GETCONFIG:
case OP_SETCONFIG:
return;
case OP_DUPLICATE:
diff = 1;
oldop = OP_DUPVALUE;
break;
case OP_FIADDR:
diff = 1;
oldop = OP_FIVALUE;
break;
case OP_GLOBALADDR:
diff = 1 + PTR_SIZE;
oldop = OP_GLOBALVALUE;
break;
case OP_LOCALADDR:
oldop = OP_LOCALVALUE;
break;
case OP_PARAMADDR:
oldop = OP_PARAMVALUE;
break;
case OP_ELEMADDR:
oldop = OP_ELEMVALUE;
break;
default:
cut = FALSE;
case OP_NUMBER: case OP_ZERO: case OP_ONE: case OP_IMAGINARY:
case OP_GETEPSILON: case OP_SETEPSILON: case OP_STRING:
case OP_UNDEF: case OP_GETCONFIG: case OP_SETCONFIG:
return;
case OP_DUPLICATE:
fp->f_opcodes[fp->f_opcodecount - 1] = OP_DUPVALUE;
oldop = OP_DUPVALUE;
return;
case OP_FIADDR:
fp->f_opcodes[fp->f_opcodecount - 1] = OP_FIVALUE;
oldop = OP_FIVALUE;
return;
case OP_GLOBALADDR:
fp->f_opcodes[fp->f_opcodecount - 2] = OP_GLOBALVALUE;
oldop = OP_GLOBALVALUE;
return;
case OP_LOCALADDR:
fp->f_opcodes[fp->f_opcodecount - 2] = OP_LOCALVALUE;
oldop = OP_LOCALVALUE;
return;
case OP_PARAMADDR:
fp->f_opcodes[fp->f_opcodecount - 2] = OP_PARAMVALUE;
oldop = OP_PARAMVALUE;
return;
case OP_ELEMADDR:
fp->f_opcodes[fp->f_opcodecount - 2] = OP_ELEMVALUE;
oldop = OP_ELEMVALUE;
return;
}
}
if (cut) {
fp->f_opcodes[count - diff] = oldop;
return;
}
break;
case OP_POP:
switch (oldop) {
case OP_ASSIGN:
fp->f_opcodes[count-1] = OP_ASSIGNPOP;
oldop = OP_ASSIGNPOP;
return;
case OP_NUMBER:
case OP_IMAGINARY:
q = constvalue(fp->f_opcodes[count-1]);
qfree(q);
break;
case OP_STRING:
sfree(findstring((long)fp->f_opcodes[count-1]));
break;
case OP_LOCALADDR:
case OP_PARAMADDR:
break;
case OP_GLOBALADDR:
diff = 1 + PTR_SIZE;
break;
default:
cut = FALSE;
}
if (cut) {
fp->f_opcodecount -= diff;
oldop = OP_NOP;
oldoldop = OP_NOP;
fprintf(stderr, "%ld: unused value ignored\n",
linenumber());
return;
}
break;
case OP_NEGATE:
if (oldop == OP_NUMBER) {
q = constvalue(fp->f_opcodes[count-1]);
fp->f_opcodes[count-1] = addqconstant(qneg(q));
qfree(q);
return;
}
}
if ((op == OP_NEGATE) && (oldop == OP_NUMBER)) {
q = constvalue(fp->f_opcodes[fp->f_opcodecount - 1]);
fp->f_opcodes[fp->f_opcodecount - 1] = addqconstant(qneg(q));
oldop = OP_NUMBER;
return;
}
if ((op == OP_POWER) && (oldop == OP_NUMBER)) {
if (qcmpi(constvalue(fp->f_opcodes[fp->f_opcodecount - 1]), 2L) == 0) {
fp->f_opcodecount--;
fp->f_opcodes[fp->f_opcodecount - 1] = OP_SQUARE;
oldop = OP_SQUARE;
return;
if (oldop == OP_NUMBER) {
if (oldoldop == OP_NUMBER) {
q1 = constvalue(fp->f_opcodes[count - 3]);
q2 = constvalue(fp->f_opcodes[count - 1]);
switch (op) {
case OP_DIV:
if (qiszero(q2)) {
cut = FALSE;
break;
}
q = qqdiv(q1,q2);
break;
case OP_MUL:
q = qmul(q1,q2);
break;
case OP_ADD:
q = qqadd(q1,q2);
break;
case OP_SUB:
q = qsub(q1,q2);
break;
case OP_POWER:
if (qisfrac(q2) || qisneg(q2))
cut = FALSE;
else
q = qpowi(q1,q2);
break;
default:
cut = FALSE;
}
if (cut) {
qfree(q1);
qfree(q2);
fp->f_opcodes[count - 3] = addqconstant(q);
fp->f_opcodecount -= 2;
oldoldop = OP_NOP;
return;
}
} else if (op != OP_NUMBER) {
q = constvalue(fp->f_opcodes[count - 1]);
if (op == OP_POWER) {
if (qcmpi(q, 2L) == 0) {
fp->f_opcodecount--;
fp->f_opcodes[count - 2] = OP_SQUARE;
qfree(q);
oldop = OP_SQUARE;
return;
}
if (qcmpi(q, 4L) == 0) {
fp->f_opcodes[count - 2] = OP_SQUARE;
fp->f_opcodes[count - 1] = OP_SQUARE;
qfree(q);
oldop = OP_SQUARE;
return;
}
}
if (qiszero(q)) {
qfree(q);
fp->f_opcodes[count - 2] = OP_ZERO;
fp->f_opcodecount--;
}
else if (qisone(q)) {
qfree(q);
fp->f_opcodes[count - 2] = OP_ONE;
fp->f_opcodecount--;
}
}
if (qcmpi(constvalue(fp->f_opcodes[fp->f_opcodecount - 1]), 4L) == 0) {
fp->f_opcodes[fp->f_opcodecount - 2] = OP_SQUARE;
fp->f_opcodes[fp->f_opcodecount - 1] = OP_SQUARE;
oldop = OP_SQUARE;
return;
}
}
if ((op == OP_POP) && (oldop == OP_ASSIGN)) { /* optimize */
fp->f_opcodes[fp->f_opcodecount - 1] = OP_ASSIGNPOP;
oldop = OP_ASSIGNPOP;
return;
}
/*
* No optimization possible, so store the opcode.
*/
fp->f_opcodes[fp->f_opcodecount] = op;
fp->f_opcodecount++;
oldoldop = oldop;
oldop = op;
}
@@ -347,24 +543,7 @@ addop(long op)
void
addopone(long op, long arg)
{
NUMBER *q;
switch (op) {
case OP_NUMBER:
q = constvalue(arg);
if (q == NULL)
break;
if (qiszero(q)) {
addop(OP_ZERO);
return;
}
if (qisone(q)) {
addop(OP_ONE);
return;
}
break;
case OP_DEBUG:
if (op == OP_DEBUG) {
if ((conf->traceflags & TRACE_NODEBUG) || (arg == debugline))
return;
debugline = arg;
@@ -372,7 +551,6 @@ addopone(long op, long arg)
curfunc->f_opcodes[curfunc->f_opcodecount - 1] = arg;
return;
}
break;
}
addop(op);
curfunc->f_opcodes[curfunc->f_opcodecount] = arg;

22
alloc.h
View File

@@ -1,16 +1,18 @@
/*
* Copyright (c) 1995 David I. Bell
* Copyright (c) 1997 David I. Bell
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*/
#if !defined(ALLOC_H)
#define ALLOC_H
#if !defined(__ALLOC_H__)
#define __ALLOC_H__
#include "have_malloc.h"
#include "have_newstr.h"
#include "have_string.h"
#include "have_memmv.h"
#ifdef HAVE_MALLOC_H
# include <malloc.h>
@@ -37,7 +39,7 @@ extern void *memset();
# if defined(__STDC__) && __STDC__ != 0
extern size_t strlen();
# else
extern long strlen(); /* should be size_t, but old systems don't have it */
extern long strlen();
# endif
# else /* HAVE_NEWSTR */
extern void bcopy();
@@ -61,4 +63,14 @@ extern int strcmp();
#define strchr(s, c) index(s, c)
#endif /* HAVE_NEWSTR */
#endif /* !ALLOC_H */
#if !defined(HAVE_MEMMOVE)
# undef CALC_SIZE_T
# if defined(__STDC__) && __STDC__ != 0
# define CALC_SIZE_T size_t
# else
# define CALC_SIZE_T long
# endif
extern void *memmove(void *s1, const void *s2, CALC_SIZE_T n);
#endif
#endif /* !__ALLOC_H__ */

68
assocfunc.c
View File

@@ -91,6 +91,7 @@ associndex(ASSOC *ap, BOOL create, long dim, VALUE *indices)
ep->e_dim = dim;
ep->e_hash = hash;
ep->e_value.v_type = V_NULL;
ep->e_value.v_subtype = V_NOSUBTYPE;
for (i = 0; i < dim; i++)
copyvalue(&indices[i], &ep->e_indices[i]);
ep->e_next = *listhead;
@@ -105,47 +106,62 @@ associndex(ASSOC *ap, BOOL create, long dim, VALUE *indices)
/*
* Search an association for the specified value starting at the
* specified index. Returns the element number (zero based) of the
* found value, or -1 if the value was not found.
* specified index. Returns 0 and stores index if value found,
* otherwise returns 1.
*/
long
assocsearch(ASSOC *ap, VALUE *vp, long index)
int
assocsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index)
{
ASSOCELEM *ep;
if (index < 0)
index = 0;
while (TRUE) {
ep = elemindex(ap, index);
if (ep == NULL)
return -1;
if (!comparevalue(&ep->e_value, vp))
return index;
index++;
if (i < 0 || j > ap->a_count) {
math_error("This should not happen in assocsearch");
/*NOTREACHED*/
}
while (i < j) {
ep = elemindex(ap, i);
if (ep == NULL) {
math_error("This should not happen in assocsearch");
/*NOTREACHED*/
}
if (acceptvalue(&ep->e_value, vp)) {
utoz(i, index);
return 0;
}
i++;
}
return 1;
}
/*
* Search an association backwards for the specified value starting at the
* specified index. Returns the element number (zero based) of the
* found value, or -1 if the value was not found.
* specified index. Returns 0 and stores the index if the value is
* found; otherwise returns 1.
*/
long
assocrsearch(ASSOC *ap, VALUE *vp, long index)
int
assocrsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index)
{
ASSOCELEM *ep;
if (index >= ap->a_count)
index = ap->a_count - 1;
while (TRUE) {
ep = elemindex(ap, index);
if (ep == NULL)
return -1;
if (!comparevalue(&ep->e_value, vp))
return index;
index--;
if (i < 0 || j > ap->a_count) {
math_error("This should not happen in assocsearch");
/*NOTREACHED*/
}
j--;
while (j >= i) {
ep = elemindex(ap, j);
if (ep == NULL) {
math_error("This should not happen in assocsearch");
/*NOTREACHED*/
}
if (acceptvalue(&ep->e_value, vp)) {
utoz(j, index);
return 0;
}
j--;
}
return 1;
}

1077
blkcpy.c Normal file
View File

File diff suppressed because it is too large Load Diff

39
blkcpy.h Normal file
View File

@@ -0,0 +1,39 @@
/*
* Copyright (c) 1997 David I. Bell
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*
* Definitions of general values and related routines used by the calculator.
*/
#if !defined(__BLKCPY_H__)
#define __BLKCPY_H__
/*
* the main copy gateway function
*/
extern int copystod(VALUE *, long, long, VALUE *, long);
/*
* specific copy functions
*/
extern int copyblk2blk(BLOCK *, long, long, BLOCK *, long, BOOL);
extern int copyblk2file(BLOCK *, long, long, FILEID, long);
extern int copyblk2mat(BLOCK *, long, long, MATRIX *, long);
extern int copyblk2num(BLOCK *, long, long, NUMBER *, long, NUMBER **);
extern int copyblk2str(BLOCK *, long, long, STRING *, long);
extern int copyfile2blk(FILEID, long, long, BLOCK *, long, BOOL);
extern int copylist2list(LIST *, long, long, LIST *, long);
extern int copylist2mat(LIST *, long, long, MATRIX *, long);
extern int copymat2blk(MATRIX *, long, long, BLOCK *, long, BOOL);
extern int copymat2list(MATRIX *, long, long, LIST *, long);
extern int copymat2mat(MATRIX *, long, long, MATRIX *, long);
extern int copynum2blk(NUMBER *, long, long, BLOCK *, long, BOOL);
extern int copyostr2blk(char *, long, long, BLOCK *, long, BOOL);
extern int copyostr2str(char *, long, long, STRING *, long);
extern int copystr2blk(STRING *, long, long, BLOCK *, long, BOOL);
extern int copystr2file(STRING *, long, long, FILEID, long);
extern int copystr2str(STRING *, long, long, STRING *, long);
#endif /* !__BLKCPY_H__ */

755
block.c Normal file
View File

@@ -0,0 +1,755 @@
/*
* block - fixed, dynamic, fifo and circular memory blocks
*/
/*
* Copyright (c) 1997 by Landon Curt Noll. All Rights Reserved.
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted,
* provided that the above copyright, this permission notice and text
* this comment, and the disclaimer below appear in all of the following:
*
* supporting documentation
* source copies
* source works derived from this source
* binaries derived from this source or from derived source
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*
* Comments, suggestions, bug fixes and questions about these routines
* are welcome. Send EMail to the address given below.
*
* Happy bit twiddling,
*
* Landon Curt Noll
*
* chongo@toad.com
* ...!{pyramid,sun,uunet}!hoptoad!chongo
*
* chongo was here /\../\
*/
#include <stdio.h>
#include "value.h"
#include "zmath.h"
#include "config.h"
#include "block.h"
#include "nametype.h"
#include "string.h"
#include "calcerr.h"
#define NBLOCKCHUNK 16
static long nblockcount = 0;
static long maxnblockcount = 0;
static STRINGHEAD nblocknames;
static NBLOCK **nblocks;
/* forward declarations */
static void blkchk(BLOCK*);
/*
* blkalloc - allocate a block
*
* given:
* len - initial memory length of the block
* type - BLK_TYPE_XXX
* chunk - allocation chunk size
*
* returns:
* pointer to a newly allocated BLOCK
*/
BLOCK *
blkalloc(int len, int chunk)
{
BLOCK *new; /* new block allocated */
/*
* firewall
*/
if (len < 0)
len = 0;
if (chunk <= 0)
chunk = BLK_CHUNKSIZE;
/*
* allocate BLOCK
*/
new = (BLOCK *)malloc(sizeof(BLOCK));
if (new == NULL) {
math_error("cannot allocate block");
/*NOTREACHED*/
}
/*
* initialize BLOCK
*/
new->blkchunk = chunk;
new->maxsize = ((len+chunk)/chunk)*chunk;
new->data = (USB8*)malloc(new->maxsize);
if (new->data == NULL) {
math_error("cannot allocate block data storage");
/*NOTREACHED*/
}
memset(new->data, 0, new->maxsize);
new->datalen = len;
/*
* return BLOCK
*/
if (conf->calc_debug > 0) {
blkchk(new);
}
return new;
}
/*
* blk_free - free a block
*
* NOTE: THIS IS NOT THE CALC blktrunc() BUILTIN FUNCTION!! This
* is what is called to free block storage.
*
* given:
* blk - the block to free
*/
void
blk_free(BLOCK *blk)
{
/* free if non-NULL */
if (blk != NULL) {
/* free data storage */
if (blk->data != NULL) {
free(blk->data);
}
/* free the block */
free(blk);
}
return;
}
/*
* blkchk - check the sanity of a block
*
* These checks should never fail if calc is working correctly. During
* debug time, we plan to call this function often. Once we are satisfied,
* we will normally call this code only in a few places.
*
* This function is normally called whenever the following builtins are called:
*
* alloc(), realloc(), free()
*
* unless the "calc_debug" is set to -1. If "calc_debug" is > 0, then
* most blk builtins will call this function.
*
* given:
* blk - the BLOCK to check
*
* returns:
* if all is ok, otherwise math_error() is called and this
* function does not return
*/
static void
blkchk(BLOCK *blk)
{
/*
* firewall - general sanity check
*/
if (conf->calc_debug == -1) {
/* do nothing when debugging is disabled */
return;
}
if (blk == NULL) {
math_error("internal: blk ptr is NULL");
/*NOTREACHED*/
}
/*
* pointers must not be NULL
*/
if (blk->data == NULL) {
math_error("internal: blk->data ptr is NULL");
/*NOTREACHED*/
}
/*
* check data lengths
*/
if (blk->datalen < 0) {
math_error("internal: blk->datalen < 0");
/*NOTREACHED*/
}
/*
* check the datalen and datalen2 values
*/
if (blk->datalen < 0) {
math_error("internal: blk->datalen < 0");
/*NOTREACHED*/
}
return;
}
/*
* blkrealloc - reallocate a block
*
* Reallocation of a block can change several aspects of a block.
*
* It can change the much data it holds or can hold.
*
* It can change the memory footprint (in terms of
* how much storage is malloced for current or future use).
*
* It can change the chunk size used to grow malloced size
* as the data size grows.
*
* Each of the len and chunksize may be kept the same.
*
* given:
* blk - old BLOCK to reallocate
* newlen - how much data the block holds
* newchunk - allocation chunk size (<0 ==> no change, 0 == default)
*/
BLOCK *
blkrealloc(BLOCK *blk, int newlen, int newchunk)
{
USB8 *new; /* realloced storage */
int newmax; /* new maximum stoage size */
/*
* firewall
*/
if (conf->calc_debug != -1) {
blkchk(blk);
}
/*
* process args
*/
/* newlen < 0 means do not change the length */
if (newlen < 0) {
newlen = blk->datalen;
}
/* newchunk <= 0 means do not change the chunk size */
if (newchunk < 0) {
newchunk = blk->blkchunk;
} else if (newchunk == 0) {
newchunk = BLK_CHUNKSIZE;
}
/*
* reallocate storage if we have a different allocation size
*/
newmax = ((newlen+newchunk)/newchunk)*newchunk;
if (newmax != blk->maxsize) {
/* reallocate new storage */
new = (USB8*)realloc(blk->data, newmax);
if (new == NULL) {
math_error("cannot reallocate block storage");
/*NOTREACHED*/
}
/* clear any new storage */
if (newmax > blk->maxsize) {
memset(new + blk->maxsize, 0, (newmax - blk->maxsize));
}
blk->maxsize = newmax;
/* restore the data pointers */
blk->data = new;
}
/*
* deal the case of a newlen == 0 early and return
*/
if (newlen == 0) {
/*
* setup the empty buffer
*
* We know that newtype is not circular since we force
* newlen to be at least 1 (because circular blocks
* always have at least one unused octet).
*/
if (blk->datalen < blk->maxsize) {
memset(blk->data, 0, blk->datalen);
} else {
memset(blk->data, 0, blk->maxsize);
}
blk->datalen = 0;
if (conf->calc_debug > 0) {
blkchk(blk);
}
return blk;
}
/*
* Set the data length
*
* We also know that the new block is not empty since we have
* already dealth with that case above.
*
* After this section of code, limit and datalen will be
* correct in terms of the new type.
*/
if (newlen > blk->datalen) {
/* there is new storage, clear it */
memset(blk->data + blk->datalen, 0, newlen-blk->datalen);
/* growing storage for blocks grows the data */
blk->datalen = newlen;
} else if (newlen <= blk->datalen) {
/* the block will be full */
blk->datalen = newlen;
}
/*
* return realloced type
*/
if (conf->calc_debug > 0) {
blkchk(blk);
}
return blk;
}
/*
* blktrunc - truncate a BLOCK down to a minimal fixed block
*
* NOTE: THIS IS NOT THE INTERNAL CALC FREE FUNCTION!! This
* is what blktrunc() builtin calls to reduce storage of a block
* down to an absolute minimum.
*
* This actually forms a zero length fixed block with a chunk of 1.
*
* given:
* blk - the BLOCK to shrink
*
* returns:
* pointer to a newly allocated BLOCK
*/
void
blktrunc(BLOCK *blk)
{
/*
* firewall
*/
if (conf->calc_debug != -1) {
blkchk(blk);
}
/*
* free the old storage
*/
free(blk->data);
/*
* setup as a zero length fixed block
*/
blk->blkchunk = 1;
blk->maxsize = 1;
blk->datalen = 0;
blk->data = (USB8*)malloc(1);
if (blk->data == NULL) {
math_error("cannot allocate truncated block storage");
/*NOTREACHED*/
}
blk->data[0] = (USB8)0;
if (conf->calc_debug > 0) {
blkchk(blk);
}
return;
}
/*
* blk_copy - copy a block
*
* given:
* blk - the block to copy
*
* returns:
* pointer to copy of blk
*/
BLOCK *
blk_copy(BLOCK *blk)
{
BLOCK *new; /* copy of blk */
/*
* malloc new block
*/
new = (BLOCK *)malloc(sizeof(BLOCK));
if (new == NULL) {
math_error("blk_copy: cannot malloc BLOCK");
/*NOTREACHED*/
}
/*
* duplicate most of the block
*/
*new = *blk;
/*
* duplicate block data
*/
new->data = (USB8 *)malloc(blk->maxsize);
if (new->data == NULL) {
math_error("blk_copy: cannot duplicate block data");
/*NOTREACHED*/
}
memcpy(new->data, blk->data, blk->maxsize);
return new;
}
/*
* blk_cmp - compare blocks
*
* given:
* a first BLOCK
* b second BLOCK
*
* returns:
* TRUE => BLOCKs are different
* FALSE => BLOCKs are the same
*/
int
blk_cmp(BLOCK *a, BLOCK *b)
{
/*
* firewall and quick check
*/
if (a == b) {
/* pointers to the same object */
return FALSE;
}
if (a == NULL || b == NULL) {
/* one pointer is NULL, so they differ */
return TRUE;
}
/*
* compare lengths
*/
if (a->datalen != b->datalen) {
/* different lengths are different */
return TRUE;
}
/*
* compare the section
*
* We have the same lengths and types, so compare the data sections.
*/
if (memcmp(a->data, b->data, a->datalen) != 0) {
/* different sections are different */
return TRUE;
}
/*
* the blocks are the same
*/
return FALSE;
}
/*
* Print chunksize, maxsize, datalen on line line and if datalen > 0,
* up to * 30 octets on the following line, with ... if datalen exceeds 30.
*/
/*ARGSUSED*/
void
blk_print(BLOCK *blk)
{
long i;
BOOL havetail;
USB8 *ptr;
/* XXX - use the config parameters for better print control */
printf("chunksize = %d, maxsize = %d, datalen = %d\n\t",
(int)blk->blkchunk, (int)blk->maxsize, (int)blk->datalen);
i = blk->datalen;
havetail = (i > 30);
if (havetail)
i = 30;
ptr = blk->data;
while (i-- > 0)
printf("%02x", *ptr++);
if (havetail)
printf("...");
}
/*
* Routine to print id and name of a named block and details of its
* block component.
*/
void
nblock_print(NBLOCK *nblk)
{
BLOCK *blk;
/* XXX - use the config parameters for better print control */
blk = nblk->blk;
printf("block %d: %s\n\t", nblk->id, nblk->name);
if (blk->data == NULL) {
printf("chunksize = %d, maxsize = %d, datalen = %d\n\t",
(int)blk->blkchunk, (int)blk->maxsize, (int)blk->datalen);
printf("NULL");
}
else
blk_print(blk);
}
/*
* realloc a named block specified by its id. The new datalen and
* chunksize are specified by len >= 0 and chunk > 0. If len < 0
* or chunk <= 0, these values used are the current datalen and
* chunksize, so there is no point in calling this unless len >= 0
* and/or chunk > 0.
* No reallocation occurs if the new maxsize is equal to the old maxsize.
*/
NBLOCK *
reallocnblock(int id, int len, int chunk)
{
BLOCK *blk;
int newsize;
int oldsize;
USB8* newdata;
/* Fire wall */
if (id < 0 || id >= nblockcount) {
math_error("Bad id in call to reallocnblock");
/*NOTREACHED*/
}
blk = nblocks[id]->blk;
if (len < 0)
len = blk->datalen;
if (chunk < 0)
chunk = blk->blkchunk;
else if (chunk == 0)
chunk = BLK_CHUNKSIZE;
newsize = (1 + len/chunk) * chunk;
oldsize = blk->maxsize;
newdata = blk->data;
if (newdata == NULL) {
newdata = malloc(newsize);
if (newdata == NULL) {
math_error("Allocation failed");
/*NOTREACHED*/
}
}
else if (newsize != oldsize) {
newdata = realloc(blk->data, newsize);
if (newdata == NULL) {
math_error("Reallocation failed");
/*NOTREACHED*/
}
}
memset(newdata + len, 0, newsize - len);
blk->maxsize = newsize;
blk->datalen = len;
blk->blkchunk = chunk;
blk->data = newdata;
return nblocks[id];
}
/*
* Create and return a new namedblock with specified name, len and
* chunksize.
*/
NBLOCK *
createnblock(char *name, int len, int chunk)
{
NBLOCK *res;
char *newname;
if (nblockcount >= maxnblockcount) {
if (maxnblockcount <= 0) {
maxnblockcount = NBLOCKCHUNK;
nblocks = (NBLOCK **)malloc(NBLOCKCHUNK *
sizeof(NBLOCK *));
if (nblocks == NULL) {
maxnblockcount = 0;
math_error("unable to malloc new named blocks");
/*NOTREACHED*/
}
} else {
maxnblockcount += NBLOCKCHUNK;
nblocks = (NBLOCK **)realloc(nblocks, maxnblockcount *
sizeof(NBLOCK *));
if (nblocks == NULL) {
maxnblockcount = 0;
math_error("cannot malloc more named blocks");
/*NOTREACHED*/
}
}
}
if (nblockcount == 0)
initstr(&nblocknames);
if (findstr(&nblocknames, name) >= 0) {
math_error("Named block already exists!!!");
/*NOTREACHED*/
}
newname = addstr(&nblocknames, name);
if (newname == NULL) {
math_error("Block name allocation failed");
/*NOTREACHED*/
}
res = (NBLOCK *) malloc(sizeof(NBLOCK));
if (res == NULL) {
math_error("Named block allocation failed");
/*NOTREACHED*/
}
nblocks[nblockcount] = res;
res->name = newname;
res->subtype = V_NOSUBTYPE;
res->id = nblockcount++;
res->blk = blkalloc(len, chunk);
return res;
}
/*
* find a named block
*/
int
findnblockid(char * name)
{
return findstr(&nblocknames, name);
}
/*
* free data block for named block with specified id
*/
int
removenblock(int id)
{
NBLOCK *nblk;
if (id < 0 || id >= nblockcount)
return E_BLKFREE3;
nblk = nblocks[id];
if (nblk->blk->data == NULL)
return 0;
if (nblk->subtype & V_NOREALLOC)
return E_BLKFREE5;
free(nblk->blk->data);
nblk->blk->data = NULL;
nblk->blk->maxsize = 0;
nblk->blk->datalen = 0;
return 0;
}
/*
* count number of current unfreed named blocks
*/
int
countnblocks(void)
{
int n;
int id;
for (n = 0, id = 0; id < nblockcount; id++) {
if (nblocks[id]->blk->data != NULL)
n++;
}
return n;
}
/*
* display id and name for each unfreed named block
*/
void
shownblocks(void)
{
int id;
if (countnblocks() == 0) {
printf("No unfreed named blocks\n\n");
return;
}
printf(" id name\n");
printf("---- -----\n");
for (id = 0; id < nblockcount; id++) {
if (nblocks[id]->blk->data != NULL)
printf("%3d %s\n", id, nblocks[id]->name);
}
printf("\n");
}
/*
* Return pointer to nblock with specified id, NULL if never created.
* The memory for the nblock found may have been freed.
*/
NBLOCK *
findnblock(int id)
{
if (id < 0 || id >= nblockcount)
return NULL;
return nblocks[id];
}
/*
* Create a new block with specified newlen and new chunksize and copy
* min(newlen, oldlen) octets to the new block. The old block is
* not changed.
*/
BLOCK *
copyrealloc(BLOCK *blk, int newlen, int newchunk)
{
BLOCK * newblk;
int oldlen;
oldlen = blk->datalen;
if (newlen < 0) /* retain length */
newlen = oldlen;
if (newchunk < 0) /* retain chunksize */
newchunk = blk->blkchunk;
else if (newchunk == 0) /* use default chunksize */
newchunk = BLK_CHUNKSIZE;
newblk = blkalloc(newlen, newchunk);
if (newlen < oldlen)
oldlen = newlen;
if (newlen > 0)
memcpy(newblk->data, blk->data, oldlen);
return newblk;
}

230
block.h Normal file
View File

@@ -0,0 +1,230 @@
/*
* block - fixed, dynamic, fifo and circular memory blocks
*/
/*
* Copyright (c) 1997 by Landon Curt Noll. All Rights Reserved.
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted,
* provided that the above copyright, this permission notice and text
* this comment, and the disclaimer below appear in all of the following:
*
* supporting documentation
* source copies
* source works derived from this source
* binaries derived from this source or from derived source
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*
* Comments, suggestions, bug fixes and questions about these routines
* are welcome. Send EMail to the address given below.
*
* Happy bit twiddling,
*
* Landon Curt Noll
*
* chongo@toad.com
* ...!{pyramid,sun,uunet}!hoptoad!chongo
*
* chongo was here /\../\
*/
#if !defined(__BLOCK_H__)
#define __BLOCK_H__
/*
* block - the basic block structure
*
* A block comes is one of several types. At the moment, only fixed
* types are defined.
*
***
*
* Block functions and operations:
*
* x[i]
* (i-1)th octet
*
* blk(len [, blkchunk])
* unnamed block
* len > 0
* blkchunk defaults to BLK_CHUNKSIZE
*
* blk(name, [len [, blkchunk]])
* named block
* len > 0
* blkchunk defaults to BLK_CHUNKSIZE
*
* blkfree(x)
* Reduce storage down to 0 octetes.
*
* size(x)
* The length of data stored in the block.
*
* sizeof(x) == blk->maxsize
* Allocation size in memory
*
* isblk(x)
* returns 0 is x is not a BLOCK, 1 if x is an
* unnamed block, 2 if x is a named BLOCK
*
* blkread(x, size, count, fd [, offset])
* blkwrite(x, size, count, fd [, offset])
* returns number of items written
* offset is restricted in value by block type
*
* blkset(x, val, length [, offset])
* only the lower octet of val is used
* offset is restricted in value by block type
*
* blkchr(x, val, length [, offset])
* only the lower octet of val is used
* offset is restricted in value by block type
*
* blkcpy(dest, src, length [, dest_offset [, src_offset]])
* 0 <= length <= blksize(x)
* offset's are restricted in value by block type
* dest may not == src
*
* blkmove(dest, src, length [, dest_offset [, src_offset]])
* 0 <= length <= blksize(x)
* offset's are restricted in value by block type
* overlapping moves are handeled correctly
*
* blkccpy(dest, src, stopval, length [, dest_offset [, src_offset]])
* 0 <= length <= blksize(x)
* offset's are restricted in value by block type
*
* blkcmp(dest, src, length [, dest_offset [, src_offset]])
* 0 <= length <= blksize(x)
* offset's are restricted in value by block type
*
* blkswap(x, a, b)
* swaps groups of 'a' octets within each 'b' octets
* b == a is a noop
* b = a*k for some integer k >= 1
*
* scatter(src, dest1, dest2 [, dest3 ] ...)
* copy sucessive octets from src into dest1, dest2, ...
* restarting with dest1 after end of list
* stops at end of src
*
* gather(dest, src1, src2 [, src3 ] ...)
* copy first octet from src1, src2, ...
* copy next octet from src1, src2, ...
* ...
* copy last octet from src1, src2, ...
* copy 0 when there is no more data from a given source
*
* blkseek(x, offset, {"in","out"})
* some seeks may not be allowed by block type
*
* config("blkmaxprint", count)
* number of octets of a block to print, 0 means all
*
* config("blkverbose", boolean)
* TRUE => print all lines, FALSE => skip dup lines
*
* config("blkbase", "base")
* output block base = { "hex", "octal", "char", "binary", "raw" }
* binary is base 2, raw is just octet values
*
* config("blkfmt", "style")
* style of output = {
* "line", lines in blkbase with no spaces between octets
* "string", as one long line with no spaces between octets
* "od_style", position, spaces between octets
* "hd_style"} position, spaces between octets, chars on end
*/
struct block {
LEN blkchunk; /* allocation chunk size */
LEN maxsize; /* octets actually malloced for this block */
LEN datalen; /* octets of data held this block */
USB8 *data; /* pointer to the 1st octet of the allocated data */
};
typedef struct block BLOCK;
struct nblock {
char *name;
int subtype;
int id;
BLOCK *blk;
};
typedef struct nblock NBLOCK;
/*
* block debug
*/
extern int blk_debug; /* 0 => debug off */
/*
* block defaults
*/
#define BLK_CHUNKSIZE 256 /* default allocation chunk size for blocks */
#define BLK_DEF_MAXPRINT 256 /* default octets to print */
#define BLK_BASE_HEX 0 /* output octets in a block in hex */
#define BLK_BASE_OCT 1 /* output octets in a block in octal */
#define BLK_BASE_CHAR 2 /* output octets in a block in characters */
#define BLK_BASE_BINARY 3 /* output octets in a block in base 2 chars */
#define BLK_BASE_RAW 4 /* output octets in a block in raw binary */
#define BLK_FMT_HD_STYLE 0 /* output in base with chars on end of line */
#define BLK_FMT_LINE 1 /* output is lines of up to 79 chars */
#define BLK_FMT_STRING 2 /* output is one long string */
#define BLK_FMT_OD_STYLE 3 /* output in base with chars */
/*
* block macros
*/
/* length of data stored in a block */
#define blklen(blk) ((blk)->datalen)
/* block footpint in memory */
#define blksizeof(blk) ((blk)->maxsize)
/* block allocation chunk size */
#define blkchunk(blk) ((blk)->blkchunk)
/*
* OCTET - what the INDEXADDR produces from a blk[offset]
*/
typedef USB8 OCTET;
/*
* external functions
*/
extern BLOCK *blkalloc(int, int);
extern void blk_free(BLOCK*);
extern BLOCK *blkrealloc(BLOCK*, int, int);
extern void blktrunc(BLOCK*);
extern BLOCK *blk_copy(BLOCK*);
extern int blk_cmp(BLOCK*, BLOCK*);
extern void blk_print(BLOCK*);
extern void nblock_print(NBLOCK *);
extern NBLOCK *createnblock(char *, int, int);
extern NBLOCK *reallocnblock(int, int, int);
extern int removenblock(int);
extern int findnblockid(char *);
extern NBLOCK *findnblock(int);
extern BLOCK *copyrealloc(BLOCK*, int, int);
extern int countnblocks(void);
extern void shownblocks(void);
#endif /* !__BLOCK_H__ */

8
byteswap.c
View File

@@ -39,6 +39,7 @@
HALF *
swap_b8_in_HALFs(HALF *dest, HALF *src, LEN len)
{
HALF *ret;
LEN i;
/*
@@ -47,6 +48,7 @@ swap_b8_in_HALFs(HALF *dest, HALF *src, LEN len)
if (dest == NULL) {
dest = alloc(len);
}
ret = dest;
/*
* swap the array
@@ -58,7 +60,7 @@ swap_b8_in_HALFs(HALF *dest, HALF *src, LEN len)
/*
* return the result
*/
return dest;
return ret;
}
@@ -272,6 +274,7 @@ swap_b8_in_COMPLEX(COMPLEX *dest, COMPLEX *src, BOOL all)
HALF *
swap_b16_in_HALFs(HALF *dest, HALF *src, LEN len)
{
HALF *ret;
LEN i;
/*
@@ -280,6 +283,7 @@ swap_b16_in_HALFs(HALF *dest, HALF *src, LEN len)
if (dest == NULL) {
dest = alloc(len);
}
ret = dest;
/*
* swap the array
@@ -291,7 +295,7 @@ swap_b16_in_HALFs(HALF *dest, HALF *src, LEN len)
/*
* return the result
*/
return dest;
return ret;
}

11
byteswap.h
View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 1995 by Landon Curt Noll. All Rights Reserved.
* Copyright (c) 1997 by Landon Curt Noll. All Rights Reserved.
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted,
@@ -20,8 +20,10 @@
* PERFORMANCE OF THIS SOFTWARE.
*/
#if !defined(BYTESWAP_H)
#define BYTESWAP_H
#if !defined(__BYTESWAP_H__)
#define __BYTESWAP_H__
#include "longbits.h"
@@ -163,4 +165,5 @@
#endif /* LONG_BITS == 64 */
#endif /* !BYTESWAP_H */
#endif /* !__BYTESWAP_H__ */

344
calc.c
View File

@@ -1,14 +1,17 @@
/*
* Copyright (c) 1995 David I. Bell
* Copyright (c) 1997 David I. Bell
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*
* Arbitrary precision calculator.
*/
#include <stdio.h>
#include <signal.h>
#include <pwd.h>
#include <sys/types.h>
#include <ctype.h>
#include <setjmp.h>
#define CALC_C
#include "calc.h"
@@ -19,6 +22,10 @@
#include "token.h"
#include "symbol.h"
#include "have_uid_t.h"
#include "have_const.h"
#include "custom.h"
#include "math_error.h"
#include "args.h"
#include "have_unistd.h"
#if defined(HAVE_UNISTD_H)
@@ -30,69 +37,32 @@
#include <stdlib.h>
#endif
/*
* in case we do not have certain .h files
*/
#if !defined(HAVE_STDLIB_H) && !defined(HAVE_UNISTD_H)
#if !defined(HAVE_UID_T) && !defined(_UID_T)
typedef unsigned short uid_t;
#endif
extern char *getenv();
extern uid_t geteuid();
#endif
/*
* Common definitions
* external and static definitions
*/
int abortlevel; /* current level of aborts */
BOOL inputwait; /* TRUE if in a terminal input wait */
jmp_buf jmpbuf; /* for errors */
int start_done = FALSE; /* TRUE => start up processing finished */
extern int abortlevel; /* current level of aborts */
extern BOOL inputwait; /* TRUE if in a terminal input wait */
extern jmp_buf jmpbuf; /* for errors */
extern int isatty(int tty); /* TRUE if fd is a tty */
static int p_flag = FALSE; /* TRUE => pipe mode */
static int q_flag = FALSE; /* TRUE => don't execute rc files */
static int u_flag = FALSE; /* TRUE => unbuffer stdin and stdout */
extern int p_flag; /* TRUE => pipe mode */
extern int q_flag; /* TRUE => don't execute rc files */
extern int u_flag; /* TRUE => unbuffer stdin and stdout */
extern char *pager; /* $PAGER or default */
extern int stdin_tty; /* TRUE if stdin is a tty */
extern char *program; /* our name */
extern char cmdbuf[]; /* command line expression */
extern char *version(void); /* return version string */
/*
* global permissions
* forward static functions
*/
int allow_read = TRUE; /* FALSE => may not open any files for reading */
int allow_write = TRUE; /* FALSE => may not open any files for writing */
int allow_exec = TRUE; /* FALSE => may not execute any commands */
char *calcpath; /* $CALCPATH or default */
char *calcrc; /* $CALCRC or default */
char *calcbindings; /* $CALCBINDINGS or default */
char *home; /* $HOME or default */
static char *pager; /* $PAGER or default */
char *shell; /* $SHELL or default */
int stdin_tty = TRUE; /* TRUE if stdin is a tty */
int post_init = FALSE; /* TRUE setjmp for math_error is readready */
/*
* some help topics are symbols, so we alias them to nice filenames
*/
static struct help_alias {
char *topic;
char *filename;
} halias[] = {
{"=", "assign"},
{"%", "mod"},
{"//", "quo"},
{NULL, NULL}
};
NUMBER *epsilon_default; /* default allowed error for float calcs */
static void intint(int arg); /* interrupt routine */
static void initenv(void); /* initialize environment vars */
extern void file_init(void);
extern void zio_init(void);
char cmdbuf[MAXCMD+1]; /* command line expression */
/*
* Top level calculator routine.
@@ -108,13 +78,34 @@ main(int argc, char **argv)
/*
* parse args
*/
program = argv[0];
argc--;
argv++;
while ((argc > 0) && (**argv == '-')) {
for (str = &argv[0][1]; *str; str++) switch (*str) {
case 'C':
#if defined(CUSTOM)
allow_custom = TRUE;
break;
#else
fprintf(stderr,
"Calc was built with custom functions "
"disabled, -C usage is disallowed\n");
/*
* we are too early in processing to call
* libcalc_call_me_last() - nothing to cleanup
*/
exit(1);
#endif /* CUSTOM */
case 'e':
no_env = TRUE;
break;
case 'h':
want_defhelp = 1;
break;
case 'i':
ign_errmax = TRUE;
break;
case 'm':
if (argv[0][2]) {
p = &argv[0][2];
@@ -124,16 +115,29 @@ main(int argc, char **argv)
argv++;
} else {
fprintf(stderr, "-m requires an arg\n");
/*
* we are too early in processing to
* call libcalc_call_me_last()
* nothing to cleanup
*/
exit(1);
}
if (p[1] != '\0' || *p < '0' || *p > '7') {
fprintf(stderr, "unknown -m arg\n");
/*
* we are too early in processing to
* call libcalc_call_me_last()
* nothing to cleanup
*/
exit(1);
}
allow_read = (((*p-'0') & 04) > 0);
allow_write = (((*p-'0') & 02) > 0);
allow_exec = (((*p-'0') & 01) > 0);
break;
case 'n':
new_std = TRUE;
break;
case 'p':
p_flag = TRUE;
break;
@@ -144,21 +148,37 @@ main(int argc, char **argv)
u_flag = TRUE;
break;
case 'v':
version(stdout);
printf("%s (version %s)\n",
CALC_TITLE, version());
/*
* we are too early in processing to call
* libcalc_call_me_last() - nothing to cleanup
*/
exit(0);
default:
fprintf(stderr, "Unknown option\n");
fprintf(stderr,
"usage: %s [-C] [-e] [-h] [-i] [-m mode] [-n] [-p]\n",
program);
fprintf(stderr, "\t[-q] [-u] [calc_cmd ...]\n");
/*
* we are too early in processing to call
* libcalc_call_me_last() - nothing to cleanup
*/
exit(1);
}
argc--;
argv++;
}
cmdbuf[0] = '\0';
str = cmdbuf;
*str = '\0';
while (--argc >= 0) {
i = (long)strlen(*argv);
if (str+1+i+2 >= cmdbuf+MAXCMD) {
if (i+3 >= MAXCMD) {
fprintf(stderr, "command in arg list too long\n");
/*
* we are too early in processing to call
* libcalc_call_me_last() - nothing to cleanup
*/
exit(1);
}
*str++ = ' ';
@@ -181,12 +201,11 @@ main(int argc, char **argv)
* initialize
*/
libcalc_call_me_first();
hash_init();
file_init();
initenv();
resetinput();
stdin_tty = TRUE; /* assume internactive default */
conf->tab_ok = TRUE; /* assume internactive default */
if (want_defhelp) {
givehelp(DEFAULTCALCHELP);
libcalc_call_me_last();
exit(0);
}
@@ -197,10 +216,7 @@ main(int argc, char **argv)
/*
* check for pipe mode and/or non-tty stdin
*/
if (p_flag) {
stdin_tty = FALSE; /* stdin not a tty in pipe mode */
conf->tab_ok = FALSE; /* config("tab",0) if pipe mode */
} else {
if (!p_flag) {
stdin_tty = isatty(0); /* assume stdin is on fd 0 */
}
@@ -213,11 +229,9 @@ main(int argc, char **argv)
* if tty, setup bindings
*/
if (stdin_tty) {
version(stdout);
printf("%s (version %s)\n", CALC_TITLE, version());
printf("[%s]\n\n",
"Type \"exit\" to exit, or \"help\" for help.");
}
if (stdin_tty) {
switch (hist_init(calcbindings)) {
case HIST_NOFILE:
fprintf(stderr,
@@ -232,13 +246,6 @@ main(int argc, char **argv)
break;
}
}
} else {
/*
* process args, not stdin
*/
stdin_tty = FALSE; /* stdin not a tty in arg mode */
conf->tab_ok = FALSE; /* config("tab",0) if pipe mode */
}
/*
@@ -249,17 +256,12 @@ main(int argc, char **argv)
/*
* reset/initialize the computing environment
*/
post_init = TRUE; /* jmpbuf is ready for math_error() */
inittokens();
initglobals();
initfunctions();
initstack();
resetinput();
math_cleardiversions();
math_setfp(stdout);
math_setmode(MODE_INITIAL);
math_setdigits((long)DISPLAY_DEFAULT);
conf->maxprint = MAXPRINT_DEFAULT;
if (post_init) {
initialize();
} else {
/* initialize already done, jmpbuf is ready */
post_init = TRUE;
}
/*
* if arg mode or non-tty mode, just do the work and be gone
@@ -275,149 +277,35 @@ main(int argc, char **argv)
(void) openterminal();
start_done = TRUE;
getcommands(FALSE);
libcalc_call_me_last();
exit(0);
}
}
start_done = TRUE;
/*
* if in arg mode, we should not get here
*/
if (str)
/* if in arg mode, we should not get here */
if (str) {
libcalc_call_me_last();
exit(1);
}
/*
* process commands (from stdin, not the command line)
* process commands
*/
abortlevel = 0;
_math_abort_ = FALSE;
inputwait = FALSE;
(void) signal(SIGINT, intint);
math_cleardiversions();
math_setfp(stdout);
resetscopes();
resetinput();
if (q_flag == FALSE && allow_read) {
q_flag = TRUE;
runrcfiles();
if (!start_done) {
reinitialize();
}
(void) openterminal();
(void) signal(SIGINT, intint);
start_done = TRUE;
getcommands(TRUE);
/*
* all done
*/
libcalc_call_me_last();
exit(0);
/*NOTREACHED*/
}
/*
* initenv - obtain $CALCPATH, $CALCRC, $CALCBINDINGS, $HOME, $PAGER
* and $SHELL values
*
* If $CALCPATH, $CALCRC, $CALCBINDINGS, $PAGER or $SHELL do not exist,
* use the default values. If $PAGER or $SHELL is an empty string, also
* use a default value. If $HOME does not exist, or is empty, use the home
* directory information from the password file.
*/
static void
initenv(void)
{
struct passwd *ent; /* our password entry */
/* determine the $CALCPATH value */
calcpath = getenv(CALCPATH);
if (calcpath == NULL)
calcpath = DEFAULTCALCPATH;
/* determine the $CALCRC value */
calcrc = getenv(CALCRC);
if (calcrc == NULL) {
calcrc = DEFAULTCALCRC;
}
/* determine the $CALCBINDINGS value */
calcbindings = getenv(CALCBINDINGS);
if (calcbindings == NULL) {
calcbindings = DEFAULTCALCBINDINGS;
}
/* determine the $HOME value */
home = getenv(HOME);
if (home == NULL || home[0] == '\0') {
ent = (struct passwd *)getpwuid(geteuid());
if (ent == NULL) {
/* just assume . is home if all else fails */
home = ".";
}
home = (char *)malloc(strlen(ent->pw_dir)+1);
strcpy(home, ent->pw_dir);
}
/* determine the $PAGER value */
pager = getenv(PAGER);
if (pager == NULL || *pager == '\0') {
pager = DEFAULTCALCPAGER;
}
/* determine the $SHELL value */
shell = getenv(SHELL);
if (shell == NULL)
shell = DEFAULTSHELL;
}
/*
* givehelp - display a help file
*
* given:
* type the type of help to give, NULL => index
*/
void
givehelp(char *type)
{
struct help_alias *p; /* help alias being considered */
char *helpcmd; /* what to execute to print help */
/*
* check permissions to see if we are allowed to help
*/
if (!allow_exec || !allow_read) {
fprintf(stderr,
"sorry, help is only allowed with -m mode 5 or 7\n");
return;
}
/* catch the case where we just print the index */
if (type == NULL) {
type = DEFAULTCALCHELP; /* the help index file */
}
/* alias the type of help, if needed */
for (p=halias; p->topic; ++p) {
if (strcmp(type, p->topic) == 0) {
type = p->filename;
break;
}
}
/* form the help command name */
helpcmd = (char *)malloc(
sizeof("if [ ! -d \"")+sizeof(HELPDIR)+1+strlen(type)+
sizeof("\" ];then ")+
strlen(pager)+1+1+sizeof(HELPDIR)+1+strlen(type)+1+1+
sizeof(";else echo no such help;fi"));
sprintf(helpcmd,
"if [ -r \"%s/%s\" ];then %s \"%s/%s\";else echo no such help;fi",
HELPDIR, type, pager, HELPDIR, type);
/* execute the help command */
system(helpcmd);
free(helpcmd);
}
/*
* Interrupt routine.
*
@@ -438,4 +326,34 @@ intint(int arg)
printf("\n[Abort level %d]\n", abortlevel);
}
/* END CODE */
/*
* Routine called on any runtime error, to complain about it (with possible
* arguments), and then longjump back to the top level command scanner.
*/
void
math_error(char *fmt, ...)
{
va_list ap;
char buf[MAXERROR+1];
if (funcname && (*funcname != '*'))
fprintf(stderr, "\"%s\": ", funcname);
if (funcline && ((funcname && (*funcname != '*')) || !inputisterminal()))
fprintf(stderr, "line %ld: ", funcline);
va_start(ap, fmt);
vsprintf(buf, fmt, ap);
va_end(ap);
fprintf(stderr, "%s\n", buf);
funcname = NULL;
if (post_init) {
longjmp(jmpbuf, 1);
} else {
fprintf(stderr, "no jmpbuf jumpback point - ABORTING!!!\n");
/*
* don't call libcalc_call_me_last() -- we might loop
* and besides ... this is an unusual internal error case
*/
exit(3);
}
}

56
calc.h
View File

@@ -1,17 +1,16 @@
/*
* Copyright (c) 1995 David I. Bell
* Copyright (c) 1997 David I. Bell
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*
* Definitions for calculator program.
*/
#ifndef CALC_H
#define CALC_H
#if !defined(__CALC_H__)
#define __CALC_H__
#include <stdio.h>
#include <setjmp.h>
#include "value.h"
@@ -94,20 +93,23 @@ extern int flushall(void);
extern int idfputstr(FILEID id, char *str);
extern int rewindid(FILEID id);
extern void rewindall(void);
extern long filesize(FILEID id);
extern ZVALUE zfilesize(FILEID id);
extern void showfiles(void);
extern int fscanfid(FILEID id, char *fmt, int count, VALUE **vals);
extern int scanfstr(char *str, char *fmt, int count, VALUE **vals);
extern long ftellid(FILEID id);
extern long fseekid(FILEID id, long offset, int whence);
extern int ftellid(FILEID id, ZVALUE *res);
extern int fseekid(FILEID id, ZVALUE offset, int whence);
extern int isattyid(FILEID id);
long fsearch(FILEID id, char *str, long pos);
long frsearch(FILEID id, char *str, long pos);
extern int fsearch(FILEID id, char *str, ZVALUE start, ZVALUE end, ZVALUE *res);
extern int frsearch(FILEID id, char *str, ZVALUE first, ZVALUE last, ZVALUE *res);
extern void showconstants(void);
extern void freeconstant(unsigned long);
extern void freestringconstant(long);
extern void trimconstants(void);
/*
* Input routines.
*/
extern FILE *f_open(char *name, char *mode);
extern int openstring(char *str);
extern int openterminal(void);
extern int opensearchfile(char *name, char *pathlist, char *exten, int reopen_ok);
@@ -121,7 +123,6 @@ extern char *inputname(void);
extern long linenumber(void);
extern void runrcfiles(void);
extern void closeinput(void);
extern FILE *curstream(void);
/*
@@ -131,11 +132,18 @@ extern NUMBER *constvalue(unsigned long index);
extern long addnumber(char *str);
extern long addqconstant(NUMBER *q);
extern void initstack(void);
extern void version(FILE *stream);
extern void getcommands(BOOL toplevel);
extern void givehelp(char *type);
extern void hash_init(void);
extern void libcalc_call_me_first(void);
extern void libcalc_call_me_last(void);
extern void showerrors(void);
/*
* Initialization
*/
extern void initialize(void);
extern void reinitialize(void);
/*
@@ -144,7 +152,6 @@ extern void libcalc_call_me_first(void);
extern int abortlevel; /* current level of aborts */
extern BOOL inputwait; /* TRUE if in a terminal input wait */
extern VALUE *stack; /* execution stack */
extern jmp_buf jmpbuf; /* for errors */
extern int start_done; /* TRUE => start up processing finished */
extern int dumpnames; /* TRUE => dump names rather than indices */
@@ -153,6 +160,11 @@ extern char *calcrc; /* $CALCRC or default */
extern char *calcbindings; /* $CALCBINDINGS or default */
extern char *home; /* $HOME or default */
extern char *shell; /* $SHELL or default */
extern char *program; /* our name (argv[0]) */
extern int no_env; /* TRUE (-e) => ignore env vars on startup */
extern int ign_errmax; /* TRUE (-i) => ignore when errcount exceeds errmax */
extern int new_std; /* TRUE (-n) => use newstd configuration */
extern int allow_read; /* FALSE => may not open any files for reading */
extern int allow_write; /* FALSE => may not open any files for writing */
@@ -160,6 +172,16 @@ extern int allow_exec; /* FALSE => may not execute any commands */
extern int post_init; /* TRUE => setjmp for math_error is ready */
#endif
/* END CODE */
/*
* calc version information
*/
#define CALC_TITLE "C-style arbitrary precision calculator"
extern int calc_major_ver;
extern int calc_minor_ver;
extern int calc_major_patch;
extern char *calc_minor_patch;
extern char *version(void); /* return version string */
#endif /* !__CALC_H__ */

6
calc.man
View File

@@ -317,7 +317,7 @@ A :-separated list of directories used to search for
scripts filenames that do not begin with /, ./ or ~.
.br
.sp
Default value: .:./lib:~/lib:${LIBDIR}
Default value: ${CALCPATH}
.br
.sp
.TP 5
@@ -327,7 +327,7 @@ line), calc searches for files along this :-separated
environment variable.
.br
.sp
Default value: ${LIBDIR}/startup:~/.calcrc
Default value: ${CALCRC}
.br
.sp
.TP 5
@@ -338,7 +338,7 @@ key bindings from the filename specified
by this environment variable.
.br
.sp
Default value: ${LIBDIR}/bindings
Default value: ${CALCBINDINGS}
.sp
.SH CREDIT
\&

151
calcerr.tbl
View File

@@ -120,16 +120,22 @@ E_UNGETC1 Non-file argument for ungetc
E_UNGETC2 File not open for reading for ungetc
E_UNGETC3 Bad second argument or other error for ungetc
E_BIGEXP Exponent too big in scanning
E_ISATTY1 Non-file argument for isatty
E_ISATTY2 File not open for isatty
E_ISATTY1 E_ISATTY1 is no longer used
E_ISATTY2 E_ISATTY2 is no longer used
E_ACCESS1 Non-string first argument for access
E_ACCESS2 Bad second argument for access
E_SEARCH1 Bad first argument for search
E_SEARCH2 Bad second argument for search
E_SEARCH3 Bad third argument for search
E_SEARCH4 Bad fourth argument for search
E_SEARCH5 Cannot find fsize or fpos for search
E_SEARCH6 File not readable for search
E_RSEARCH1 Bad first argument for rsearch
E_RSEARCH2 Bad second argument for rsearch
E_RSEARCH3 Bad third argument for rsearch
E_RSEARCH4 Bad fourth argument for rsearch
E_RSEARCH5 Cannot find fsize or fpos for rsearch
E_RSEARCH6 File not readable for rsearch
E_FOPEN3 Too many open files
E_REWIND2 Attempt to rewind a file that is not open
E_STRERROR1 Bad argument type for strerror
@@ -148,7 +154,7 @@ E_MATFILL1 Non-variable first argument for matfill
E_MATFILL2 Non-matrix first argument-value for matfill
E_MATDIM Non-matrix argument for matdim
E_MATSUM Non-matrix argument for matsum
E_ISIDENT Non-matrix argument for isident
E_ISIDENT E_ISIDENT is no longer used
E_MATTRANS1 Non-matrix argument for mattrans
E_MATTRANS2 Non-two-dimensional matrix for mattrans
E_DET1 Non-matrix argument for det
@@ -191,3 +197,142 @@ E_RM2 Unable to remove a file
E_RDPERM Operation allowed because calc mode disallows read operations
E_WRPERM Operation allowed because calc mode disallows write operations
E_EXPERM Operation allowed because calc mode disallows exec operations
E_MIN Unordered arguments for min
E_MAX Unordered arguments for max
E_LISTMIN Unordered items for minimum of list
E_LISTMAX Unordered items for maximum of list
E_SIZE Size undefined for argument type
E_NO_C_ARG Calc must be run with a -C argument to use custom function
E_NO_CUSTOM Calc was built with custom functions disabled
E_UNK_CUSTOM Custom function unknown, try: show custom
E_BLK1 Non-integral length for block
E_BLK2 Negative or too-large length for block
E_BLK3 Non-integral chunksize for block
E_BLK4 Negative or too-large chunksize for block
E_BLKFREE1 Named block does not exist for blkfree
E_BLKFREE2 Non-integral id specification for blkfree
E_BLKFREE3 Block with specified id does not exist
E_BLKFREE4 Block already freed
E_BLKFREE5 No-realloc protection prevents blkfree
E_BLOCKS1 Non-integer argument for blocks
E_BLOCKS2 Non-allocated index number for blocks
E_COPY1 Non-integer or negative source index for copy
E_COPY2 Source index too large for copy
E_COPY3 E_COPY3 is no longer used
E_COPY4 Non-integer or negative number for copy
E_COPY5 Number too large for copy
E_COPY6 Non-integer or negative destination index for copy
E_COPY7 Destination index too large for copy
E_COPY8 Freed block source for copy
E_COPY9 Unsuitable source type for copy
E_COPY10 Freed block destinction for copy
E_COPY11 Unsuitable destination type for copy
E_COPY12 Incompatible source and destination for copy
E_COPY13 No-copy-from source variable
E_COPY14 No-copy-to destination variable
E_COPY15 No-copy-from source named block
E_COPY16 No-copy-to destination named block
E_COPY17 No-relocation destination for copy
E_COPYF1 File not open for copy
E_COPYF2 fseek or fsize failure for copy
E_COPYF3 fwrite error for copy
E_COPYF4 fread error for copy
E_PROTECT1 Non-variable first argument for protect
E_PROTECT2 Non-integer second argument for protect
E_PROTECT3 Out-of-range second argument for protect
E_MATFILL3 No-copy-to destination for matfill
E_MATFILL4 No-assign-from source for matfill
E_MATTRACE1 Non-matrix argument for mattrace
E_MATTRACE2 Non-two-dimensional argument for mattrace
E_MATTRACE3 Non-square argument for mattrace
E_TAN1 Bad epsilon for tan
E_TAN2 Bad argument for tan
E_COT1 Bad epsilon for cot
E_COT2 Bad argument for cot
E_SEC1 Bad epsilon for sec
E_SEC2 Bad argument for sec
E_CSC1 Bad epsilon for csc
E_CSC2 Bad argument for csc
E_SINH1 Bad epsilon for sinh
E_SINH2 Bad argument for sinh
E_COSH1 Bad epsilon for cosh
E_COSH2 Bad argument for cosh
E_TANH1 Bad epsilon for tanh
E_TANH2 Bad argument for tanh
E_COTH1 Bad epsilon for coth
E_COTH2 Bad argument for coth
E_SECH1 Bad epsilon for sech
E_SECH2 Bad argument for sech
E_CSCH1 Bad epsilon for csch
E_CSCH2 Bad argument for csch
E_ASIN1 Bad epsilon for asin
E_ASIN2 Bad argument for asin
E_ACOS1 Bad epsilon for acos
E_ACOS2 Bad argument for acos
E_ATAN1 Bad epsilon for atan
E_ATAN2 Bad argument for atan
E_ACOT1 Bad epsilon for acot
E_ACOT2 Bad argument for acot
E_ASEC1 Bad epsilon for asec
E_ASEC2 Bad argument for asec
E_ACSC1 Bad epsilon for acsc
E_ACSC2 Bad argument for acsc
E_ASINH1 Bad epsilon for asin
E_ASINH2 Bad argument for asinh
E_ACOSH1 Bad epsilon for acosh
E_ACOSH2 Bad argument for acosh
E_ATANH1 Bad epsilon for atanh
E_ATANH2 Bad argument for atanh
E_ACOTH1 Bad epsilon for acoth
E_ACOTH2 Bad argument for acoth
E_ASECH1 Bad epsilon for asech
E_ASECH2 Bad argument for asech
E_ACSCH1 Bad epsilon for acsch
E_ACSCH2 Bad argument for acsch
E_GD1 Bad epsilon for gd
E_GD2 Bad argument for gd
E_AGD1 Bad epsilon for agd
E_AGD2 Bad argument for agd
E_LOGINF Log of zero or infinity
E_STRADD String addition failure
E_STRMUL String multiplication failure
E_STRNEG String reversal failure
E_STRSUB String subtraction failure
E_BIT1 Bad argument type for bit
E_BIT2 Index too large for bit
E_SETBIT1 Non-integer second argument for setbit
E_SETBIT2 Out-of-range index for setbit
E_SETBIT3 Non-string first argument for setbit
E_OR Bad argument for or
E_AND Bad argument for and
E_STROR Allocation failure for string or
E_STRAND Allocation failure for string and
E_XOR Bad argument for xorvalue
E_COMP Bad argument for comp
E_STRDIFF Allocation failure for string diff
E_STRCOMP Allocation failure for string comp
E_SEG1 Bad first argument for segment
E_SEG2 Bad second argument for segment
E_SEG3 Bad third argument for segment
E_STRSEG Failure for string segment
E_HIGHBIT1 Bad argument type for highbit
E_HIGHBIT2 Non-integer argument for highbit
E_LOWBIT1 Bad argument type for lowbit
E_LOWBIT2 Non-integer argument for lowbit
E_CONTENT Bad argument type for unary hash op
E_HASHOP Bad argument type for binary hash op
E_HEAD1 Bad first argument for head
E_HEAD2 Bad second argument for head
E_STRHEAD Failure for strhead
E_TAIL1 Bad first argument for tail
E_TAIL2 Bad second argument for tail
E_STRTAIL Failure for strtail
E_STRSHIFT Failure for strshift
E_STRCMP Non-string argument for strcmp
E_STRNCMP Bad argument type for strncmp
E_XOR1 Varying types of argument for xor
E_XOR2 Bad argument type for xor
E_STRCPY Bad argument type for strcpy
E_STRNCPY Bad argument type for strncpy
E_BACKSLASH Bad argument type for unary backslash
E_SETMINUS Bad argument type for setminus

3
check.awk
View File

@@ -29,7 +29,7 @@ NF == 0 {
next;
}
$1 ~ /^[0-9]/ {
$1 ~ /^[0-9]+:/ {
if (error > 0) {
if (havebuf2) {
print buf2;
@@ -71,4 +71,5 @@ END {
if (error > 0 && havebuf0) {
print buf0;
}
exit (error > 0);
}

28
cmath.h
View File

@@ -1,13 +1,15 @@
/*
* Copyright (c) 1993 David I. Bell
* Copyright (c) 1997 David I. Bell
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*
* Data structure declarations for extended precision complex arithmetic.
*/
#ifndef CMATH_H
#define CMATH_H
#if !defined(__CMATH_H__)
#define __CMATH_H__
#include "qmath.h"
@@ -73,8 +75,25 @@ extern COMPLEX *cexp(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *cln(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *ccos(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *csin(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *ccosh(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *csinh(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *cpolar(NUMBER *q1, NUMBER *q2, NUMBER *epsilon);
extern COMPLEX *crel(COMPLEX *c1, COMPLEX *c2);
extern COMPLEX *casin(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *cacos(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *catan(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *cacot(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *casec(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *cacsc(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *casinh(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *cacosh(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *catanh(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *cacoth(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *casech(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *cacsch(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *cgd(COMPLEX *c, NUMBER *epsilon);
extern COMPLEX *cagd(COMPLEX *c, NUMBER *epsilon);
/*
@@ -108,6 +127,5 @@ extern COMPLEX *swap_HALF_in_COMPLEX(COMPLEX *dest, COMPLEX *src, BOOL all);
*/
extern COMPLEX _czero_, _cone_, _conei_;
#endif
/* END CODE */
#endif /* !__CMATH_H__ */

876
codegen.c
View File

File diff suppressed because it is too large Load Diff

415
comfunc.c
View File

@@ -125,10 +125,12 @@ csqrt(COMPLEX *c, NUMBER *epsilon, long R)
if (cisreal(c)) {
r = comalloc();
if (!qisneg(c->real)) {
qfree(r->real);
r->real = qsqrt(c->real, epsilon, R);
return r;
}
ntmp = qneg(c->real);
qfree(r->imag);
r->imag = qsqrt(ntmp, epsilon, R);
qfree(ntmp);
return r;
@@ -160,7 +162,7 @@ csqrt(COMPLEX *c, NUMBER *epsilon, long R)
return clink(&_czero_);
}
aes = qscale(c->imag, -1);
v = qdiv(aes, u);
v = qqdiv(aes, u);
qfree(aes);
r = comalloc();
r->real = u;
@@ -170,8 +172,8 @@ csqrt(COMPLEX *c, NUMBER *epsilon, long R)
#endif
imsign = c->imag->num.sign;
es = qsquare(epsilon);
aes = qdiv(c->real, es);
bes = qdiv(c->imag, es);
aes = qqdiv(c->real, es);
bes = qqdiv(c->imag, es);
qfree(es);
zgcd(aes->den, bes->den, &g);
zequo(bes->den, g, &tmp1);
@@ -217,12 +219,14 @@ csqrt(COMPLEX *c, NUMBER *epsilon, long R)
r = comalloc();
qtemp = *aes;
qtemp.num.sign = sign;
qfree(r->real);
r->real = qmul(&qtemp, epsilon);
qfree(aes);
bes = qscale(r->real, 1);
qtemp = *bes;
qtemp.num.sign = sign ^ imsign;
r->imag = qdiv(c->imag, &qtemp);
qfree(r->imag);
r->imag = qqdiv(c->imag, &qtemp);
qfree(bes);
return r;
}
@@ -272,12 +276,14 @@ csqrt(COMPLEX *c, NUMBER *epsilon, long R)
r = comalloc();
qtemp = *aes;
qtemp.num.sign = sign;
qfree(r->real);
r->real = qmul(&qtemp, epsilon);
qfree(aes);
bes = qscale(r->real, 1);
qtemp = *bes;
qtemp.num.sign = sign ^ imsign;
r->imag = qdiv(c->imag, &qtemp);
qfree(r->imag);
r->imag = qqdiv(c->imag, &qtemp);
qfree(bes);
return r;
}
@@ -355,10 +361,10 @@ csqrt(COMPLEX *c, NUMBER *epsilon, long R)
return clink(&_czero_);
}
r = comalloc();
if (!qiszero(u))
r->real = u;
if (!qiszero(v))
r->imag = v;
qfree(r->real);
qfree(r->imag);
r->real = u;
r->imag = v;
return r;
}
@@ -384,6 +390,7 @@ croot(COMPLEX *c, NUMBER *q, NUMBER *epsilon)
return csqrt(c, epsilon, 24L);
if (cisreal(c) && !qisneg(c->real)) {
r = comalloc();
qfree(r->real);
r->real = qroot(c->real, q, epsilon);
return r;
}
@@ -412,7 +419,7 @@ croot(COMPLEX *c, NUMBER *q, NUMBER *epsilon)
epsilon2 = qbitvalue(n - m - 4);
tmp1 = qatan2(c->imag, c->real, epsilon2);
qfree(epsilon2);
tmp2 = qdiv(tmp1, q);
tmp2 = qqdiv(tmp1, q);
qfree(tmp1);
r = cpolar(root, tmp2, epsilon);
qfree(root);
@@ -437,8 +444,9 @@ cexp(COMPLEX *c, NUMBER *epsilon)
math_error("Zero epsilon for cexp");
/*NOTREACHED*/
}
r = comalloc();
if (cisreal(c)) {
r = comalloc();
qfree(r->real);
r->real = qexp(c->real, epsilon);
return r;
}
@@ -458,11 +466,14 @@ cexp(COMPLEX *c, NUMBER *epsilon)
qsincos(c->imag, k - n + 2, &sin, &cos);
tmp2 = qmul(tmp1, cos);
qfree(cos);
r = comalloc();
qfree(r->real);
r->real = qmappr(tmp2, epsilon, 24L);
qfree(tmp2);
tmp2 = qmul(tmp1, sin);
qfree(tmp1);
qfree(sin);
qfree(r->imag);
r->imag = qmappr(tmp2, epsilon, 24L);
qfree(tmp2);
return r;
@@ -488,6 +499,7 @@ cln(COMPLEX *c, NUMBER *epsilon)
return clink(&_czero_);
r = comalloc();
if (cisreal(c) && !qisneg(c->real)) {
qfree(r->real);
r->real = qln(c->real, epsilon);
return r;
}
@@ -500,8 +512,10 @@ cln(COMPLEX *c, NUMBER *epsilon)
tmp1 = qln(a2b2, epsilon1);
qfree(a2b2);
qfree(epsilon1);
qfree(r->real);
r->real = qscale(tmp1, -1L);
qfree(tmp1);
qfree(r->imag);
r->imag = qatan2(c->imag, c->real, epsilon);
return r;
}
@@ -526,6 +540,8 @@ ccos(COMPLEX *c, NUMBER *epsilon)
}
n = qilog2(epsilon);
ctmp1 = comalloc();
qfree(ctmp1->real);
qfree(ctmp1->imag);
neg = qisneg(c->imag);
ctmp1->real = neg ? qneg(c->imag) : qlink(c->imag);
ctmp1->imag = neg ? qlink(c->real) : qneg(c->real);
@@ -544,7 +560,9 @@ ccos(COMPLEX *c, NUMBER *epsilon)
ctmp1 = cscale(ctmp3, -1);
comfree(ctmp3);
r = comalloc();
qfree(r->real);
r->real = qmappr(ctmp1->real, epsilon, 24L);
qfree(r->imag);
r->imag = qmappr(ctmp1->imag, epsilon, 24L);
comfree(ctmp1);
return r;
@@ -573,6 +591,8 @@ csin(COMPLEX *c, NUMBER *epsilon)
n = qilog2(epsilon);
ctmp1 = comalloc();
neg = qisneg(c->imag);
qfree(ctmp1->real);
qfree(ctmp1->imag);
ctmp1->real = neg ? qneg(c->imag) : qlink(c->imag);
ctmp1->imag = neg ? qlink(c->real) : qneg(c->real);
epsilon1 = qbitvalue(n - 2);
@@ -591,9 +611,11 @@ csin(COMPLEX *c, NUMBER *epsilon)
comfree(ctmp3);
r = comalloc();
qtmp = neg ? qlink(ctmp1->imag) : qneg(ctmp1->imag);
qfree(r->real);
r->real = qmappr(qtmp, epsilon, 24L);
qfree(qtmp);
qtmp = neg ? qneg(ctmp1->real) : qlink(ctmp1->real);
qfree(r->imag);
r->imag = qmappr(qtmp, epsilon, 24L);
qfree(qtmp);
comfree(ctmp1);
@@ -601,6 +623,364 @@ csin(COMPLEX *c, NUMBER *epsilon)
}
COMPLEX *
ccosh(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2, *tmp3;
tmp1 = cexp(c, epsilon);
tmp2 = cneg(c);
tmp3 = cexp(tmp2, epsilon);
comfree(tmp2);
tmp2 = cadd(tmp1, tmp3);
comfree(tmp1);
comfree(tmp3);
tmp1 = cscale(tmp2, -1);
comfree(tmp2);
return tmp1;
}
COMPLEX *
csinh(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2, *tmp3;
tmp1 = cexp(c, epsilon);
tmp2 = cneg(c);
tmp3 = cexp(tmp2, epsilon);
comfree(tmp2);
tmp2 = csub(tmp1, tmp3);
comfree(tmp1);
comfree(tmp3);
tmp1 = cscale(tmp2, -1);
comfree(tmp2);
return tmp1;
}
COMPLEX *
casin(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2;
tmp1 = cmul(&_conei_, c);
tmp2 = casinh(tmp1, epsilon);
comfree(tmp1);
tmp1 = cdiv(tmp2, &_conei_);
comfree(tmp2);
return tmp1;
}
COMPLEX *
cacos(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2;
tmp1 = csquare(c);
tmp2 = csub(&_cone_, tmp1);
comfree(tmp1);
tmp1 = csqrt(tmp2, epsilon, 24);
comfree(tmp2);
tmp2 = cmul(&_conei_, tmp1);
comfree(tmp1);
tmp1 = cadd(c, tmp2);
comfree(tmp2);
tmp2 = cln(tmp1, epsilon);
comfree(tmp1);
tmp1 = cdiv(tmp2, &_conei_);
comfree(tmp2);
return tmp1;
}
COMPLEX *
casinh(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2, *tmp3;
BOOL neg;
neg = qisneg(c->real);
tmp1 = neg ? cneg(c) : clink(c);
tmp2 = csquare(tmp1);
tmp3 = cadd(&_cone_, tmp2);
comfree(tmp2);
tmp2 = csqrt(tmp3, epsilon, 24);
comfree(tmp3);
tmp3 = cadd(tmp2, tmp1);
comfree(tmp1);
comfree(tmp2);
tmp1 = cln(tmp3, epsilon);
comfree(tmp3);
if (neg) {
tmp2 = cneg(tmp1);
comfree(tmp1);
return tmp2;
}
return tmp1;
}
COMPLEX *
cacosh(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2;
tmp1 = csquare(c);
tmp2 = csub(tmp1, &_cone_);
comfree(tmp1);
tmp1 = csqrt(tmp2, epsilon, 24);
comfree(tmp2);
tmp2 = cadd(c, tmp1);
comfree(tmp1);
tmp1 = cln(tmp2, epsilon);
comfree(tmp2);
return tmp1;
}
COMPLEX *
catan(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2, *tmp3;
if (qiszero(c->real) && qisunit(c->imag))
return NULL;
tmp1 = csub(&_conei_, c);
tmp2 = cadd(&_conei_, c);
tmp3 = cdiv(tmp1, tmp2);
comfree(tmp1);
comfree(tmp2);
tmp1 = cln(tmp3, epsilon);
comfree(tmp3);
tmp2 = cscale(tmp1, -1);
comfree(tmp1);
tmp1 = cdiv(tmp2, &_conei_);
comfree(tmp2);
return tmp1;
}
COMPLEX *
cacot(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2, *tmp3;
if (qiszero(c->real) && qisunit(c->imag))
return NULL;
tmp1 = cadd(c, &_conei_);
tmp2 = csub(c, &_conei_);
tmp3 = cdiv(tmp1, tmp2);
comfree(tmp1);
comfree(tmp2);
tmp1 = cln(tmp3, epsilon);
comfree(tmp3);
tmp2 = cscale(tmp1, -1);
comfree(tmp1);
tmp1 = cdiv(tmp2, &_conei_);
comfree(tmp2);
return tmp1;
}
COMPLEX *
casec(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2;
tmp1 = cinv(c);
tmp2 = cacos(tmp1, epsilon);
comfree(tmp1);
return tmp2;
}
COMPLEX *
cacsc(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2;
tmp1 = cinv(c);
tmp2 = casin(tmp1, epsilon);
comfree(tmp1);
return tmp2;
}
COMPLEX *
catanh(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2, *tmp3;
if (qiszero(c->imag) && qisunit(c->real))
return NULL;
tmp1 = cadd(&_cone_, c);
tmp2 = csub(&_cone_, c);
tmp3 = cdiv(tmp1, tmp2);
comfree(tmp1);
comfree(tmp2);
tmp1 = cln(tmp3, epsilon);
comfree(tmp3);
tmp2 = cscale(tmp1, -1);
comfree(tmp1);
return tmp2;
}
COMPLEX *
cacoth(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2, *tmp3;
if (qiszero(c->imag) && qisunit(c->real))
return NULL;
tmp1 = cadd(c, &_cone_);
tmp2 = csub(c, &_cone_);
tmp3 = cdiv(tmp1, tmp2);
comfree(tmp1);
comfree(tmp2);
tmp1 = cln(tmp3, epsilon);
comfree(tmp3);
tmp2 = cscale(tmp1, -1);
comfree(tmp1);
return tmp2;
}
COMPLEX *
casech(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2;
tmp1 = cinv(c);
tmp2 = cacosh(tmp1, epsilon);
comfree(tmp1);
return tmp2;
}
COMPLEX *
cacsch(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2;
tmp1 = cinv(c);
tmp2 = casinh(tmp1, epsilon);
comfree(tmp1);
return tmp2;
}
COMPLEX *
cgd(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2, *tmp3;
NUMBER *q1, *q2;
NUMBER *sin, *cos;
NUMBER *eps;
int n, n1;
BOOL neg;
if (cisreal(c)) {
q1 = qscale(c->real, -1);
eps = qscale(epsilon, -1);
q2 = qtanh(q1, eps);
qfree(q1);
q1 = qatan(q2, eps);
qfree(eps);
qfree(q2);
tmp1 = comalloc();
qfree(tmp1->real);
tmp1->real = qscale(q1, 1);
qfree(q1);
return tmp1;
}
if (qiszero(c->real)) {
n = - qilog2(epsilon);
qsincos(c->imag, n + 8, &sin, &cos);
if (qiszero(cos) || (n1 = -qilog2(cos)) > n) {
qfree(sin);
qfree(cos);
return NULL;
}
neg = qisneg(sin);
q1 = neg ? qsub(&_qone_, sin) : qqadd(&_qone_, sin);
qfree(sin);
if (n1 > 8) {
qfree(q1);
qfree(cos);
qsincos(c->imag, n + n1, &sin, &cos);
q1 = neg ? qsub(&_qone_, sin) : qqadd(&_qone_, sin);
qfree(sin);
}
q2 = qqdiv(q1, cos);
qfree(q1);
q1 = qln(q2, epsilon);
qfree(q2);
if (neg) {
q2 = qneg(q1);
qfree(q1);
q1 = q2;
}
tmp1 = comalloc();
qfree(tmp1->imag);
tmp1->imag = q1;
if (qisneg(cos)) {
qfree(tmp1->real);
q1 = qpi(epsilon);
if (qisneg(c->imag)) {
q2 = qneg(q1);
qfree(q1);
q1 = q2;
}
tmp1->real = q1;
}
qfree(cos);
return tmp1;
}
neg = qisneg(c->real);
tmp1 = neg ? cneg(c) : clink(c);
tmp2 = cexp(tmp1, epsilon);
comfree(tmp1);
tmp1 = cmul(&_conei_, tmp2);
tmp3 = cadd(&_conei_, tmp2);
comfree(tmp2);
tmp2 = cadd(tmp1, &_cone_);
comfree(tmp1);
if (ciszero(tmp2) || ciszero(tmp3)) {
comfree(tmp2);
comfree(tmp3);
return NULL;
}
tmp1 = cdiv(tmp2, tmp3);
comfree(tmp2);
comfree(tmp3);
tmp2 = cln(tmp1, epsilon);
comfree(tmp1);
tmp1 = cdiv(tmp2, &_conei_);
comfree(tmp2);
if (neg) {
tmp2 = cneg(tmp1);
comfree(tmp1);
return tmp2;
}
return tmp1;
}
COMPLEX *
cagd(COMPLEX *c, NUMBER *epsilon)
{
COMPLEX *tmp1, *tmp2;
tmp1 = cmul(&_conei_, c);
tmp2 = cgd(tmp1, epsilon);
comfree(tmp1);
if (tmp2 == NULL)
return NULL;
tmp1 = cdiv(tmp2, &_conei_);
comfree(tmp2);
return tmp1;
}
/*
* Convert a number from polar coordinates to normal complex number form
* within the specified accuracy. This produces the value:
@@ -625,16 +1005,19 @@ cpolar(NUMBER *q1, NUMBER *q2, NUMBER *epsilon)
return qlink(&_czero_);
r = comalloc();
if (qiszero(q2)) {
qfree(r->real);
r->real = qlink(q1);
return r;
}
qsincos(q2, m - n + 2, &sin, &cos);
tmp = qmul(q1, cos);
qfree(cos);
qfree(r->real);
r->real = qmappr(tmp, epsilon, 24L);
qfree(tmp);
tmp = qmul(q1, sin);
qfree(sin);
qfree(r->imag);
r->imag = qmappr(tmp, epsilon, 24L);
qfree(tmp);
return r;
@@ -666,12 +1049,12 @@ cpower(COMPLEX *c1, COMPLEX *c2, NUMBER *epsilon)
n = qilog2(epsilon);
m1 = m2 = -1000000;
k1 = k2 = 0;
qtmp1 = qsquare(c1->real);
qtmp2 = qsquare(c1->imag);
a2b2 = qqadd(qtmp1, qtmp2);
qfree(qtmp1);
qfree(qtmp2);
if (!qiszero(c2->real)) {
qtmp1 = qsquare(c1->real);
qtmp2 = qsquare(c1->imag);
a2b2 = qqadd(qtmp1, qtmp2);
qfree(qtmp1);
qfree(qtmp2);
m1 = qilog2(c2->real);
epsilon1 = qbitvalue(-m1 - 1);
qtmp1 = qln(a2b2, epsilon1);

102
commath.c
View File

@@ -29,10 +29,14 @@ cadd(COMPLEX *c1, COMPLEX *c2)
if (ciszero(c2))
return clink(c1);
r = comalloc();
if (!qiszero(c1->real) || !qiszero(c2->real))
if (!qiszero(c1->real) || !qiszero(c2->real)) {
qfree(r->real);
r->real = qqadd(c1->real, c2->real);
if (!qiszero(c1->imag) || !qiszero(c2->imag))
}
if (!qiszero(c1->imag) || !qiszero(c2->imag)) {
qfree(r->imag);
r->imag = qqadd(c1->imag, c2->imag);
}
return r;
}
@@ -50,10 +54,14 @@ csub(COMPLEX *c1, COMPLEX *c2)
if (ciszero(c2))
return clink(c1);
r = comalloc();
if (!qiszero(c1->real) || !qiszero(c2->real))
if (!qiszero(c1->real) || !qiszero(c2->real)) {
qfree(r->real);
r->real = qsub(c1->real, c2->real);
if (!qiszero(c1->imag) || !qiszero(c2->imag))
}
if (!qiszero(c1->imag) || !qiszero(c2->imag)) {
qfree(r->imag);
r->imag = qsub(c1->imag, c2->imag);
}
return r;
}
@@ -95,7 +103,9 @@ cmul(COMPLEX *c1, COMPLEX *c2)
q2 = qmul(c1->real, c2->real);
q3 = qmul(c1->imag, c2->imag);
q4 = qqadd(q2, q3);
qfree(r->real);
r->real = qsub(q2, q3);
qfree(r->imag);
r->imag = qsub(q1, q4);
qfree(q1);
qfree(q2);
@@ -122,10 +132,12 @@ csquare(COMPLEX *c)
return clink(&_cnegone_);
r = comalloc();
if (cisreal(c)) {
qfree(r->real);
r->real = qsquare(c->real);
return r;
}
if (cisimag(c)) {
qfree(r->real);
q1 = qsquare(c->imag);
r->real = qneg(q1);
qfree(q1);
@@ -133,9 +145,11 @@ csquare(COMPLEX *c)
}
q1 = qsquare(c->real);
q2 = qsquare(c->imag);
qfree(r->real);
r->real = qsub(q1, q2);
qfree(q1);
qfree(q2);
qfree(r->imag);
q1 = qmul(c->real, c->imag);
r->imag = qscale(q1, 1L);
qfree(q1);
@@ -160,26 +174,32 @@ cdiv(COMPLEX *c1, COMPLEX *c2)
return clink(&_cone_);
r = comalloc();
if (cisreal(c1) && cisreal(c2)) {
r->real = qdiv(c1->real, c2->real);
qfree(r->real);
r->real = qqdiv(c1->real, c2->real);
return r;
}
if (cisimag(c1) && cisimag(c2)) {
r->real = qdiv(c1->imag, c2->imag);
qfree(r->real);
r->real = qqdiv(c1->imag, c2->imag);
return r;
}
if (cisimag(c1) && cisreal(c2)) {
r->imag = qdiv(c1->imag, c2->real);
qfree(r->imag);
r->imag = qqdiv(c1->imag, c2->real);
return r;
}
if (cisreal(c1) && cisimag(c2)) {
q1 = qdiv(c1->real, c2->imag);
qfree(r->imag);
q1 = qqdiv(c1->real, c2->imag);
r->imag = qneg(q1);
qfree(q1);
return r;
}
if (cisreal(c2)) {
r->real = qdiv(c1->real, c2->real);
r->imag = qdiv(c1->imag, c2->real);
qfree(r->real);
qfree(r->imag);
r->real = qqdiv(c1->real, c2->real);
r->imag = qqdiv(c1->imag, c2->real);
return r;
}
q1 = qsquare(c2->real);
@@ -192,14 +212,16 @@ cdiv(COMPLEX *c1, COMPLEX *c2)
q3 = qqadd(q1, q2);
qfree(q1);
qfree(q2);
r->real = qdiv(q3, den);
qfree(r->real);
r->real = qqdiv(q3, den);
qfree(q3);
q1 = qmul(c1->real, c2->imag);
q2 = qmul(c1->imag, c2->real);
q3 = qsub(q2, q1);
qfree(q1);
qfree(q2);
r->imag = qdiv(q3, den);
qfree(r->imag);
r->imag = qqdiv(q3, den);
qfree(q3);
qfree(den);
return r;
@@ -221,11 +243,13 @@ cinv(COMPLEX *c)
}
r = comalloc();
if (cisreal(c)) {
qfree(r->real);
r->real = qinv(c->real);
return r;
}
if (cisimag(c)) {
q1 = qinv(c->imag);
qfree(r->imag);
r->imag = qneg(q1);
qfree(q1);
return r;
@@ -235,8 +259,10 @@ cinv(COMPLEX *c)
den = qqadd(q1, q2);
qfree(q1);
qfree(q2);
r->real = qdiv(c->real, den);
q1 = qdiv(c->imag, den);
qfree(r->real);
r->real = qqdiv(c->real, den);
q1 = qqdiv(c->imag, den);
qfree(r->imag);
r->imag = qneg(q1);
qfree(q1);
qfree(den);
@@ -255,10 +281,14 @@ cneg(COMPLEX *c)
if (ciszero(c))
return clink(&_czero_);
r = comalloc();
if (!qiszero(c->real))
if (!qiszero(c->real)) {
qfree(r->real);
r->real = qneg(c->real);
if (!qiszero(c->imag))
}
if (!qiszero(c->imag)) {
qfree(r->imag);
r->imag = qneg(c->imag);
}
return r;
}
@@ -275,7 +305,9 @@ cint(COMPLEX *c)
if (cisint(c))
return clink(c);
r = comalloc();
qfree(r->real);
r->real = qint(c->real);
qfree(r->imag);
r->imag = qint(c->imag);
return r;
}
@@ -293,7 +325,9 @@ cfrac(COMPLEX *c)
if (cisint(c))
return clink(&_czero_);
r = comalloc();
qfree(r->real);
r->real = qfrac(c->real);
qfree(r->imag);
r->imag = qfrac(c->imag);
return r;
}
@@ -311,8 +345,11 @@ cconj(COMPLEX *c)
if (cisreal(c))
return clink(c);
r = comalloc();
if (!qiszero(c->real))
if (!qiszero(c->real)) {
qfree(r->real);
r->real = qlink(c->real);
}
qfree(r->imag);
r->imag = qneg(c->imag);
return r;
}
@@ -329,8 +366,10 @@ creal(COMPLEX *c)
if (cisreal(c))
return clink(c);
r = comalloc();
if (!qiszero(c->real))
if (!qiszero(c->real)) {
qfree(r->real);
r->real = qlink(c->real);
}
return r;
}
@@ -346,6 +385,7 @@ cimag(COMPLEX *c)
if (cisreal(c))
return clink(&_czero_);
r = comalloc();
qfree(r->real);
r->real = qlink(c->imag);
return r;
}
@@ -362,6 +402,8 @@ caddq(COMPLEX *c, NUMBER *q)
if (qiszero(q))
return clink(c);
r = comalloc();
qfree(r->real);
qfree(r->imag);
r->real = qqadd(c->real, q);
r->imag = qlink(c->imag);
return r;
@@ -379,6 +421,8 @@ csubq(COMPLEX *c, NUMBER *q)
if (qiszero(q))
return clink(c);
r = comalloc();
qfree(r->real);
qfree(r->imag);
r->real = qsub(c->real, q);
r->imag = qlink(c->imag);
return r;
@@ -397,6 +441,8 @@ cshift(COMPLEX *c, long n)
if (ciszero(c) || (n == 0))
return clink(c);
r = comalloc();
qfree(r->real);
qfree(r->imag);
r->real = qshift(c->real, n);
r->imag = qshift(c->imag, n);
return r;
@@ -414,6 +460,8 @@ cscale(COMPLEX *c, long n)
if (ciszero(c) || (n == 0))
return clink(c);
r = comalloc();
qfree(r->real);
qfree(r->imag);
r->real = qscale(c->real, n);
r->imag = qscale(c->imag, n);
return r;
@@ -435,6 +483,8 @@ cmulq(COMPLEX *c, NUMBER *q)
if (qisnegone(q))
return cneg(c);
r = comalloc();
qfree(r->real);
qfree(r->imag);
r->real = qmul(c->real, q);
r->imag = qmul(c->imag, q);
return r;
@@ -458,8 +508,10 @@ cdivq(COMPLEX *c, NUMBER *q)
if (qisnegone(q))
return cneg(c);
r = comalloc();
r->real = qdiv(c->real, q);
r->imag = qdiv(c->imag, q);
qfree(r->real);
qfree(r->imag);
r->real = qqdiv(c->real, q);
r->imag = qqdiv(c->imag, q);
return r;
}
@@ -477,10 +529,10 @@ qqtoc(NUMBER *q1, NUMBER *q2)
if (qiszero(q1) && qiszero(q2))
return clink(&_czero_);
r = comalloc();
if (!qiszero(q1))
r->real = qlink(q1);
if (!qiszero(q2))
r->imag = qlink(q2);
qfree(r->real);
qfree(r->imag);
r->real = qlink(q1);
r->imag = qlink(q2);
return r;
}
@@ -512,6 +564,8 @@ crel(COMPLEX *c1, COMPLEX *c2)
COMPLEX *c;
c = comalloc();
qfree(c->real);
qfree(c->imag);
c->real = itoq((long) qrel(c1->real, c2->real));
c->imag = itoq((long) qrel(c1->imag, c2->imag));

305
config.c
View File

@@ -1,14 +1,19 @@
/*
* Copyright (c) 1995 David I. Bell
* Copyright (c) 1997 David I. Bell
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*
* Configuration routines.
*/
#include <stdio.h>
#include "calc.h"
#include "token.h"
#include "zrand.h"
#include "block.h"
#include "nametype.h"
#include "config.h"
#include "string.h"
/*
@@ -39,10 +44,17 @@ NAMETYPE configs[] = {
{"round", CONFIG_ROUND},
{"leadzero", CONFIG_LEADZERO},
{"fullzero", CONFIG_FULLZERO},
{"maxerr", CONFIG_MAXERR},
{"maxscan", CONFIG_MAXSCAN},
{"maxerr", CONFIG_MAXSCAN}, /* old name for maxscan */
{"prompt", CONFIG_PROMPT},
{"more", CONFIG_MORE},
{"random", CONFIG_RANDOM},
{"blkmaxprint", CONFIG_BLKMAXPRINT},
{"blkverbose", CONFIG_BLKVERBOSE},
{"blkbase", CONFIG_BLKBASE},
{"blkfmt", CONFIG_BLKFMT},
{"lib_debug", CONFIG_LIB_DEBUG},
{"calc_debug", CONFIG_CALC_DEBUG},
{"user_debug", CONFIG_USER_DEBUG},
{NULL, 0}
};
@@ -74,10 +86,16 @@ CONFIG oldstd = { /* backward compatible standard configuration */
24, /* round()/bround() default rounding mode */
FALSE, /* ok to print leading 0 before decimal pt */
0, /* ok to print trailing 0's */
MAXERRORCOUNT, /* max errors before abort */
MAXSCANCOUNT, /* max scan errors before abort */
PROMPT1, /* normal prompt */
PROMPT2, /* prompt when inside multi-line input */
3 /* require 1 mod 4 and to pass ptest(newn,1) */
BLK_DEF_MAXPRINT, /* number of octets of a block to print */
FALSE, /* skip duplicate block output lines */
BLK_BASE_HEX, /* block octet print base */
BLK_FMT_HD_STYLE, /* block output format */
0, /* calc library debug level */
0, /* internal calc debug level */
0 /* user defined debug level */
};
CONFIG newstd = { /* new non-backward compatible configuration */
MODE_INITIAL, /* current output mode */
@@ -103,10 +121,16 @@ CONFIG newstd = { /* new non-backward compatible configuration */
24, /* round()/bround() default rounding mode */
TRUE, /* ok to print leading 0 before decimal pt */
1, /* ok to print trailing 0's */
MAXERRORCOUNT, /* max errors before abort */
MAXSCANCOUNT, /* max scan errors before abort */
"; ", /* normal prompt */
";; ", /* prompt when inside multi-line input */
3 /* require 1 mod 4 and to pass ptest(newn,1) */
BLK_DEF_MAXPRINT, /* number of octets of a block to print */
FALSE, /* skip duplicate block output lines */
BLK_BASE_HEX, /* block octet print base */
BLK_FMT_HD_STYLE, /* block output format */
0, /* calc library debug level */
0, /* internal calc debug level */
0 /* user defined debug level */
};
CONFIG *conf = NULL; /* loaded in at startup - current configuration */
@@ -153,10 +177,49 @@ static NAMETYPE truth[] = {
};
/*
* Possible block base output modes
*/
static NAMETYPE blk_base[] = {
{"hexadecimal", BLK_BASE_HEX},
{"hex", BLK_BASE_HEX},
{"octal", BLK_BASE_OCT},
{"oct", BLK_BASE_OCT},
{"character", BLK_BASE_CHAR},
{"char", BLK_BASE_CHAR},
{"binary", BLK_BASE_BINARY},
{"bin", BLK_BASE_BINARY},
{"raw", BLK_BASE_RAW},
{"none", BLK_BASE_RAW},
{NULL, 0}
};
/*
* Possible block output formats
*/
static NAMETYPE blk_fmt[] = {
{"line", BLK_FMT_LINE},
{"lines", BLK_FMT_LINE},
{"str", BLK_FMT_STRING},
{"string", BLK_FMT_STRING},
{"strings", BLK_FMT_STRING},
{"od", BLK_FMT_OD_STYLE},
{"odstyle", BLK_FMT_OD_STYLE},
{"od_style", BLK_FMT_OD_STYLE},
{"hd", BLK_FMT_HD_STYLE},
{"hdstyle", BLK_FMT_HD_STYLE},
{"hd_style", BLK_FMT_HD_STYLE},
{NULL, 0}
};
/*
* declate static functions
*/
static int modetype(char *name);
static int blkbase(char *name);
static int blkfmt(char *name);
static int truthtype(char *name);
static char *modename(int type);
@@ -202,6 +265,46 @@ modetype(char *name)
}
/*
* Given the name of a block output base, convert it to the internal format.
* Returns -1 if the string is unknown.
*
* given:
* name mode name
*/
static int
blkbase(char *name)
{
NAMETYPE *cp; /* current config pointer */
for (cp = blk_base; cp->name; cp++) {
if (strcmp(cp->name, name) == 0)
return cp->type;
}
return -1;
}
/*
* Given the name of a block output format, convert it to the internal format.
* Returns -1 if the string is unknown.
*
* given:
* name mode name
*/
static int
blkfmt(char *name)
{
NAMETYPE *cp; /* current config pointer */
for (cp = blk_fmt; cp->name; cp++) {
if (strcmp(cp->name, name) == 0)
return cp->type;
}
return -1;
}
/*
* Given the name of a truth value, convert it to a BOOL or -1.
* Returns -1 if the string is unknown.
@@ -257,9 +360,9 @@ setconfig(int type, VALUE *vp)
case CONFIG_ALL:
newconf = NULL; /* firewall */
if (vp->v_type == V_STR) {
if (strcmp(vp->v_str, "oldstd") == 0) {
if (strcmp(vp->v_str->s_str, "oldstd") == 0) {
newconf = &oldstd;
} else if (strcmp(vp->v_str, "newstd") == 0) {
} else if (strcmp(vp->v_str->s_str, "newstd") == 0) {
newconf = &newstd;
} else {
math_error("CONFIG alias not oldstd or newstd");
@@ -311,7 +414,7 @@ setconfig(int type, VALUE *vp)
math_error("Non-string for mode");
/*NOTREACHED*/
}
temp = modetype(vp->v_str);
temp = modetype(vp->v_str->s_str);
if (temp < 0) {
math_error("Unknown mode \"%s\"", vp->v_str);
/*NOTREACHED*/
@@ -415,15 +518,14 @@ setconfig(int type, VALUE *vp)
conf->redc2 = (int)temp;
break;
case CONFIG_TILDE:
if (vp->v_type == V_NUM) {
q = vp->v_num;
conf->tilde_ok = !qiszero(q);
} else if (vp->v_type == V_STR) {
temp = truthtype(vp->v_str);
temp = truthtype(vp->v_str->s_str);
if (temp < 0) {
math_error("Illegal truth value");
math_error("Illegal truth value for tilde");
/*NOTREACHED*/
}
conf->tilde_ok = (int)temp;
@@ -435,9 +537,9 @@ setconfig(int type, VALUE *vp)
q = vp->v_num;
conf->tab_ok = !qiszero(q);
} else if (vp->v_type == V_STR) {
temp = truthtype(vp->v_str);
temp = truthtype(vp->v_str->s_str);
if (temp < 0) {
math_error("Illegal truth value");
math_error("Illegal truth value for tab");
/*NOTREACHED*/
}
conf->tab_ok = (int)temp;
@@ -575,9 +677,9 @@ setconfig(int type, VALUE *vp)
q = vp->v_num;
conf->leadzero = !qiszero(q);
} else if (vp->v_type == V_STR) {
temp = truthtype(vp->v_str);
temp = truthtype(vp->v_str->s_str);
if (temp < 0) { {
math_error("Illegal truth value");
math_error("Illegal truth value for leadzero");
/*NOTREACHED*/
}
}
@@ -590,9 +692,9 @@ setconfig(int type, VALUE *vp)
q = vp->v_num;
conf->fullzero = !qiszero(q);
} else if (vp->v_type == V_STR) {
temp = truthtype(vp->v_str);
temp = truthtype(vp->v_str->s_str);
if (temp < 0) { {
math_error("Illegal truth value");
math_error("Illegal truth value for fullzero");
/*NOTREACHED*/
}
}
@@ -600,9 +702,9 @@ setconfig(int type, VALUE *vp)
}
break;
case CONFIG_MAXERR:
case CONFIG_MAXSCAN:
if (vp->v_type != V_NUM) {
math_error("Non-numeric for maxerr");
math_error("Non-numeric for maxscancount");
/*NOTREACHED*/
}
q = vp->v_num;
@@ -610,10 +712,10 @@ setconfig(int type, VALUE *vp)
if (qisfrac(q) || qisneg(q) || !zistiny(q->num))
temp = -1;
if (temp < 0) {
math_error("Maxerr value is out of range");
math_error("Maxscan value is out of range");
/*NOTREACHED*/
}
conf->maxerrorcount = temp;
conf->maxscancount = temp;
break;
case CONFIG_PROMPT:
@@ -621,12 +723,12 @@ setconfig(int type, VALUE *vp)
math_error("Non-string for prompt");
/*NOTREACHED*/
}
p = (char *)malloc(strlen(vp->v_str) + 1);
p = (char *)malloc(vp->v_str->s_len + 1);
if (p == NULL) {
math_error("Cannot duplicate new prompt");
/*NOTREACHED*/
}
strcpy(p, vp->v_str);
strcpy(p, vp->v_str->s_str);
free(conf->prompt1);
conf->prompt1 = p;
break;
@@ -636,30 +738,114 @@ setconfig(int type, VALUE *vp)
math_error("Non-string for more prompt");
/*NOTREACHED*/
}
p = (char *)malloc(strlen(vp->v_str) + 1);
p = (char *)malloc(vp->v_str->s_len + 1);
if (p == NULL) {
math_error("Cannot duplicate new more prompt");
/*NOTREACHED*/
}
strcpy(p, vp->v_str);
strcpy(p, vp->v_str->s_str);
free(conf->prompt2);
conf->prompt2 = p;
break;
case CONFIG_RANDOM:
case CONFIG_BLKMAXPRINT:
if (vp->v_type != V_NUM) {
math_error("Non-numeric for random config value");
math_error("Non-numeric for blkmaxprint");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q) || !zistiny(q->num))
temp = -1;
if (temp < BLUM_CFG_MIN || temp > BLUM_CFG_MAX) {
math_error("Random config value is out of range");
if (temp < 0) {
math_error("Blkmaxprint value is out of range");
/*NOTREACHED*/
}
conf->random = temp;
conf->blkmaxprint = temp;
break;
case CONFIG_BLKVERBOSE:
if (vp->v_type == V_NUM) {
q = vp->v_num;
conf->blkverbose = !qiszero(q);
} else if (vp->v_type == V_STR) {
temp = truthtype(vp->v_str->s_str);
if (temp < 0) {
math_error("Illegal truth value for blkverbose");
/*NOTREACHED*/
}
conf->blkverbose = (int)temp;
}
break;
case CONFIG_BLKBASE:
if (vp->v_type != V_STR) {
math_error("Non-string for blkbase");
/*NOTREACHED*/
}
temp = blkbase(vp->v_str->s_str);
if (temp < 0) {
math_error("Unknown mode \"%s\" for blkbase",
vp->v_str->s_str);
/*NOTREACHED*/
}
conf->blkbase = temp;
break;
case CONFIG_BLKFMT:
if (vp->v_type != V_STR) {
math_error("Non-string for blkfmt");
/*NOTREACHED*/
}
temp = blkfmt(vp->v_str->s_str);
if (temp < 0) {
math_error("Unknown mode \"%s\" for blkfmt",
vp->v_str->s_str);
/*NOTREACHED*/
}
conf->blkfmt = temp;
break;
case CONFIG_LIB_DEBUG:
if (vp->v_type != V_NUM) {
math_error("Non numeric for lib_debug");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || !zistiny(q->num)) {
math_error("Illegal lib_debug parameter value");
/*NOTREACHED*/
}
conf->lib_debug = temp;
break;
case CONFIG_CALC_DEBUG:
if (vp->v_type != V_NUM) {
math_error("Non numeric for calc_debug");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || !zistiny(q->num)) {
math_error("Illegal calc_debug parameter value");
/*NOTREACHED*/
}
conf->calc_debug = temp;
break;
case CONFIG_USER_DEBUG:
if (vp->v_type != V_NUM) {
math_error("Non numeric for user_debug");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || !zistiny(q->num)) {
math_error("Illegal user_debug parameter value");
/*NOTREACHED*/
}
conf->user_debug = temp;
break;
default:
@@ -676,7 +862,7 @@ setconfig(int type, VALUE *vp)
* src copy this configuration
*
* returns:
* prointer to the configuration copy
* pointer to the configuration copy
*/
CONFIG *
config_copy(CONFIG *src)
@@ -747,7 +933,7 @@ config_free(CONFIG *cfg)
}
/*
* free prointer values
* free pointer values
*/
if (cfg->epsilon != NULL) {
qfree(cfg->epsilon);
@@ -812,8 +998,7 @@ config_value(CONFIG *cfg, int type, VALUE *vp)
case CONFIG_MODE:
vp->v_type = V_STR;
vp->v_subtype = V_STRLITERAL;
vp->v_str = modename(cfg->outmode);
vp->v_str = makenewstring(modename(cfg->outmode));
return;
case CONFIG_EPSILON:
@@ -892,24 +1077,46 @@ config_value(CONFIG *cfg, int type, VALUE *vp)
i = cfg->fullzero;
break;
case CONFIG_MAXERR:
i = cfg->maxerrorcount;
case CONFIG_MAXSCAN:
i = cfg->maxscancount;
break;
case CONFIG_PROMPT:
vp->v_type = V_STR;
vp->v_subtype = V_STRLITERAL;
vp->v_str = cfg->prompt1;
vp->v_str = makenewstring(cfg->prompt1);
return;
case CONFIG_MORE:
vp->v_type = V_STR;
vp->v_subtype = V_STRLITERAL;
vp->v_str = cfg->prompt2;
vp->v_str = makenewstring(cfg->prompt2);
return;
case CONFIG_RANDOM:
i = cfg->random;
case CONFIG_BLKMAXPRINT:
i = cfg->blkmaxprint;
break;
case CONFIG_BLKVERBOSE:
i = cfg->blkverbose;
break;
case CONFIG_BLKBASE:
i = cfg->blkbase;
break;
case CONFIG_BLKFMT:
i = cfg->blkfmt;
break;
case CONFIG_LIB_DEBUG:
i = cfg->lib_debug;
break;
case CONFIG_CALC_DEBUG:
i = cfg->calc_debug;
break;
case CONFIG_USER_DEBUG:
i = cfg->user_debug;
break;
default:
@@ -978,8 +1185,14 @@ config_cmp(CONFIG *cfg1, CONFIG *cfg2)
cfg1->round != cfg2->round ||
cfg1->leadzero != cfg2->leadzero ||
cfg1->fullzero != cfg2->fullzero ||
cfg1->maxerrorcount != cfg2->maxerrorcount ||
cfg1->maxscancount != cfg2->maxscancount ||
strcmp(cfg1->prompt1, cfg2->prompt1) != 0 ||
strcmp(cfg1->prompt2, cfg2->prompt2) != 0 ||
cfg1->random != cfg2->random;
cfg1->blkmaxprint != cfg2->blkmaxprint ||
cfg1->blkverbose != cfg2->blkverbose ||
cfg1->blkbase != cfg2->blkbase ||
cfg1->blkfmt != cfg2->blkfmt ||
cfg1->lib_debug != cfg2->lib_debug ||
cfg1->calc_debug != cfg2->calc_debug ||
cfg1->user_debug != cfg2->user_debug;
}

50
config.h
View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 1995 by Landon Curt Noll. All Rights Reserved.
* Copyright (c) 1997 by Landon Curt Noll. All Rights Reserved.
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted,
@@ -36,9 +36,12 @@
* chongo was here /\../\
*/
#if !defined(CONFIG_H)
#define CONFIG_H
#if !defined(__CONFIG_H__)
#define __CONFIG_H__
#include "nametype.h"
#include "qmath.h"
@@ -69,10 +72,16 @@
#define CONFIG_ROUND 20
#define CONFIG_LEADZERO 21
#define CONFIG_FULLZERO 22
#define CONFIG_MAXERR 23
#define CONFIG_MAXSCAN 23
#define CONFIG_PROMPT 24
#define CONFIG_MORE 25
#define CONFIG_RANDOM 26
#define CONFIG_BLKMAXPRINT 26
#define CONFIG_BLKVERBOSE 27
#define CONFIG_BLKBASE 28
#define CONFIG_BLKFMT 29
#define CONFIG_LIB_DEBUG 30
#define CONFIG_CALC_DEBUG 31
#define CONFIG_USER_DEBUG 32
/*
@@ -84,11 +93,19 @@
#define NEW_EPSILON_DEFAULT "1e-10" /* newstd EPSILON_DEFAULT */
#define NEW_EPSILONPREC_DEFAULT 34 /* 34 ==> 2^-34 <= 1e-10 < 2^-33 */
#define MAXPRINT_DEFAULT 16 /* default number of elements printed */
#define MAXERRORCOUNT 20 /* default max errors before an abort */
#define MAXSCANCOUNT 20 /* default max scan errors before an abort */
#define ERRMAX 20 /* default errmax value */
/*
* configuration object
*
* If you add elements to this structure, you need to also update:
*
* quickhash.c - config_hash()
* hash.c - hash_value()
* config.c - setconfig(), config_value(), config_cmp()
*/
struct config {
int outmode; /* current output mode */
@@ -113,11 +130,17 @@ struct config {
long outround; /* output default rounding mode */
long round; /* round()/bround() default rounding mode */
int leadzero; /* ok to print leading 0 before decimal pt */
int fullzero; /* ok to print trailing 0's -- XXX ??? */
long maxerrorcount; /* max errors before abort */
int fullzero; /* ok to print trailing 0's */
long maxscancount; /* max scan errors before abort */
char *prompt1; /* normal prompt */
char *prompt2; /* prompt when inside multi-line input */
int random; /* random mode */
int blkmaxprint; /* octets of a block to print, 0 => all */
int blkverbose; /* TRUE => print all lines if a block */
int blkbase; /* block output base */
int blkfmt; /* block output style */
int lib_debug; /* library debug: <0 none, 0 default, >0 more */
int calc_debug; /* internal debug: <0 none, 0 default,>0 more */
int user_debug; /* user defined debug value: 0 default */
};
typedef struct config CONFIG;
@@ -131,13 +154,14 @@ extern CONFIG newstd; /* new non-backward compatible configuration */
/*
* configuration functions
* configuration externals
*/
extern CONFIG *config_copy(CONFIG *src);
extern void config_free(CONFIG *cfg);
extern void config_print(CONFIG *cfg);
extern BOOL config_cmp(CONFIG *cfg1, CONFIG *cfg2);
extern int configtype(char *name);
extern int configtype(char*);
extern void config_print(CONFIG*);
extern BOOL config_cmp(CONFIG*, CONFIG*);
#endif
#endif /* !__CONFIG_H__ */

167
const.c
View File

@@ -1,27 +1,44 @@
/*
* Copyright (c) 1993 David I. Bell
* Copyright (c) 1997 David I. Bell
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*
* Constant number storage module.
*/
#include <stdio.h>
#include "calc.h"
#include "qmath.h"
#define CONSTALLOCSIZE 400 /* number of constants to allocate */
static long constcount; /* number of constants defined */
static long constavail; /* number of constants available */
static NUMBER **consttable; /* table of constants */
void
initconstants(void)
{
int i;
consttable = (NUMBER **) malloc(sizeof(NUMBER *) * CONSTALLOCSIZE);
if (consttable == NULL) {
math_error("Unable to allocate constant table");
/*NOTREACHED*/
}
for (i = 0; i < 8; i++)
consttable[i] = initnumbs[i];
constcount = 8;
constavail = CONSTALLOCSIZE - 8;
}
/*
* Read in a constant number and add it to the table of constant numbers,
* Read in a literal real number and add it to the table of constant numbers,
* creating a new entry if necessary. The incoming number is a string
* value which must have a correct format, otherwise an undefined number
* will result. Returns the index of the number in the constant table.
* Returns zero if the number could not be saved.
* value which must have a correct format.
* Returns the index of the number in the constant table.
*
* given:
* str string representation of number
@@ -32,8 +49,6 @@ addnumber(char *str)
NUMBER *q;
q = str2q(str);
if (q == NULL)
return 0;
return addqconstant(q);
}
@@ -59,14 +74,53 @@ addqconstant(NUMBER *q)
long denlen; /* denominator length */
HALF numlow; /* bottom value of numerator */
HALF denlow; /* bottom value of denominator */
long first; /* first non-null position found */
BOOL havefirst;
if (constavail <= 0) {
if (consttable == NULL) {
initconstants();
} else {
tp = (NUMBER **) realloc((char *) consttable,
sizeof(NUMBER *) * (constcount + CONSTALLOCSIZE));
if (tp == NULL) {
math_error("Unable to reallocate const table");
/*NOTREACHED*/
}
consttable = tp;
constavail = CONSTALLOCSIZE;
}
}
numlen = q->num.len;
denlen = q->den.len;
numlow = q->num.v[0];
denlow = q->den.v[0];
tp = &consttable[1];
for (index = 1; index <= constcount; index++) {
t = *tp++;
first = 0;
havefirst = FALSE;
tp = consttable;
for (index = 0; index < constcount; index++, tp++) {
t = *tp;
if (t->links == 0) {
if (!havefirst) {
havefirst = TRUE;
first = index;
}
continue;
}
if (q == t) {
if (q->links == 1) {
if (havefirst) {
*tp = consttable[first];
consttable[first] = q;
} else {
havefirst = TRUE;
first = index;
}
continue;
}
return index;
}
if ((numlen != t->num.len) || (numlow != t->num.v[0]))
continue;
if ((denlen != t->den.len) || (denlow != t->den.v[0]))
@@ -74,40 +128,95 @@ addqconstant(NUMBER *q)
if (q->num.sign != t->num.sign)
continue;
if (qcmp(q, t) == 0) {
t->links++;
qfree(q);
return index;
}
}
if (constavail <= 0) {
if (consttable == NULL) {
tp = (NUMBER **)
malloc(sizeof(NUMBER *) * (CONSTALLOCSIZE + 1));
*tp = NULL;
} else
tp = (NUMBER **) realloc((char *) consttable,
sizeof(NUMBER *) * (constcount+CONSTALLOCSIZE + 1));
if (tp == NULL)
return 0;
consttable = tp;
constavail = CONSTALLOCSIZE;
if (havefirst) {
consttable[first] = q;
return first;
}
constavail--;
constcount++;
consttable[constcount] = q;
return constcount;
consttable[constcount++] = q;
return index;
}
/*
* Return the value of a constant number given its index.
* Returns address of the number, or NULL if the index is illegal.
* Returns address of the number, or NULL if the index is illegal
* or points to freed position.
*/
NUMBER *
constvalue(unsigned long index)
{
if ((index <= 0) || (index > constcount))
return NULL;
if (index >= constcount) {
math_error("Bad index value for constvalue");
/*NOTREACHED*/
}
if (consttable[index]->links == 0) {
math_error("Constvalue has been freed!!!");
/*NOTREACHED*/
}
return consttable[index];
}
void
freeconstant(unsigned long index)
{
NUMBER *q;
if (index >= constcount) {
math_error("Bad index value for freeconst");
/*NOTREACHED*/
}
q = consttable[index];
if (q->links == 0) {
math_error("Attempting to free freed const location");
/*NOTREACHED*/
}
qfree(q);
if (index == constcount - 1) {
trimconstants();
}
}
void
trimconstants(void)
{
NUMBER **qp;
qp = &consttable[constcount];
while (constcount > 0 && (*--qp)->links == 0) {
constcount--;
constavail++;
}
}
void
showconstants(void)
{
long index;
NUMBER **qp;
long count;
qp = consttable;
count = 0;
for (index = 0; index < constcount; index++, qp++) {
if ((*qp)->links) {
if (!count) {
printf("\n Index Links Value\n");
}
count++;
printf("\n%8ld%8ld ", index, (*qp)->links);
fitprint(*qp, 40);
}
}
printf("\n\nNumber = %ld\n", count);
}
/* END CODE */

220
custom.c Normal file
View File

@@ -0,0 +1,220 @@
/*
* Copyright (c) 1997 by Landon Curt Noll. All Rights Reserved.
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted,
* provided that the above copyright, this permission notice and text
* this comment, and the disclaimer below appear in all of the following:
*
* supporting documentation
* source copies
* source works derived from this source
* binaries derived from this source or from derived source
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*
* Comments, suggestions, bug fixes and questions about these routines
* are welcome. Send EMail to the address given below.
*
* Happy bit twiddling,
*
* Landon Curt Noll
*
* chongo@toad.com
* ...!{pyramid,sun,uunet}!hoptoad!chongo
*
* chongo was here /\../\
*/
/* these include files are needed regardless of CUSTOM */
#include "have_const.h"
#include "value.h"
#include "custom.h"
#if defined(CUSTOM)
#include <stdio.h>
#include "calc.h"
#include "have_string.h"
#ifdef HAVE_STRING_H
# include <string.h>
#endif
#else /* CUSTOM */
#include "config.h"
#endif /* CUSTOM */
int allow_custom = FALSE; /* TRUE => custom builtins allowed */
/*
* custom - custom callout function
*/
/*ARGSUSED*/
VALUE
custom(char *name, int count, VALUE **vals)
{
#if defined(CUSTOM)
CONST struct custom *p; /* current function */
/*
* search the custom interface table for a function
*/
for (p = cust; p->name != NULL; ++p) {
/* look for the first match */
if (strcmp(name, p->name) == 0) {
/* arg count check */
if (count < p->minargs) {
math_error("Too few arguments for custom "
"function \"%s\"", p->name);
/*NOTREACHED*/
}
if (count > p->maxargs) {
math_error("Too many arguments for custom "
"function \"%s\"", p->name);
/*NOTREACHED*/
}
/* call the custom function */
return p->func(name, count, vals);
}
}
/*
* no such custom function
*/
return error_value(E_UNK_CUSTOM);
#else /* CUSTOM */
fprintf(stderr,
"%sCalc was built with custom functions disabled\n",
(conf->tab_ok ? "\t" : ""));
return error_value(E_NO_CUSTOM);
#endif /* CUSTOM */
}
/*
* showcustom - display the names and brief descriptins of custom functions
*/
/*ARGSUSED*/
void
showcustom(void)
{
#if defined(CUSTOM)
CONST struct custom *p; /* current function */
/*
* disable custom functions unless -C was given
*/
if (!allow_custom) {
fprintf(stderr,
"%sCalc must be run with a -C argument to "
"show custom functions\n",
(conf->tab_ok ? "\t" : ""));
return;
}
/*
* print header
*/
printf("\nName\tArgs\tDescription\n\n");
for (p = cust; p->name != NULL; ++p) {
printf("%-9s ", p->name);
if (p->maxargs == MAX_CUSTOM_ARGS)
printf("%d+ ", p->minargs);
else if (p->minargs == p->maxargs)
printf("%-6d", p->minargs);
else
printf("%d-%-4d", p->minargs, p->maxargs);
printf("%s\n", p->desc);
}
printf("\n");
#else /* CUSTOM */
fprintf(stderr,
"%sCalc was built with custom functions disabled\n",
(conf->tab_ok ? "\t" : ""));
#endif /* CUSTOM */
}
/*
* customhelp - standard help interface to a custom function
*
* This function assumes that a help file with the same name as
* the custom function has been installed by the custom/Makefile
* (as listed in the CUSTOM_HELP makefile variable) under the
* CUSTOMHELPDIR == HELPDIR/custhelp directory.
*
* The help command first does a search in HELPDIR and later
* in CUSTOMHELPDIR. If a custom help file has the same name
* as a file under HELPDIR then help will display the HELPDIR
* file and NOT the custom file. This function will ignore
* and HELPDIR file and work directly with the custom help file.
*
* given:
* name name of the custom help file to directly access
*/
/*ARGSUSED*/
void
customhelp(char *name)
{
#if defined(CUSTOM)
char *customname; /* a string of the form: custom/name */
/*
* firewall
*/
if (name == NULL) {
name = "help";
}
/*
* form the custom help name
*/
customname = (char *)malloc(sizeof("custhelp")+strlen(name)+1);
if (customname == NULL) {
math_error("bad malloc of customname");
/*NOTREACHED*/
}
sprintf(customname, "custhelp/%s", name);
/*
* give help directly to the custom file
*/
givehelp(customname);
/*
* all done
*/
free(customname);
#else /* CUSTOM */
fprintf(stderr,
"%sCalc was built with custom functions disabled\n",
(conf->tab_ok ? "\t" : ""));
#endif /* CUSTOM */
}

89
custom.h Normal file
View File

@@ -0,0 +1,89 @@
/*
* Copyright (c) 1997 by Landon Curt Noll. All Rights Reserved.
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted,
* provided that the above copyright, this permission notice and text
* this comment, and the disclaimer below appear in all of the following:
*
* supporting documentation
* source copies
* source works derived from this source
* binaries derived from this source or from derived source
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*
* Prior to calc 2.9.3t9, these routines existed as a calc library called
* cryrand.cal. They have been rewritten in C for performance as well
* as to make them available directly from libcalc.a.
*
* Comments, suggestions, bug fixes and questions about these routines
* are welcome. Send EMail to the address given below.
*
* Happy bit twiddling,
*
* Landon Curt Noll
*
* chongo@toad.com
* ...!{pyramid,sun,uunet}!hoptoad!chongo
*
* chongo was here /\../\
*/
/*
* Be careful what you put in this file, upper .c files include
* this file even when CUSTOM is not defined (ALLOW_CUSTOM is empty).
*
* Don't include anything, let the including .c file bring in:
*
* have_const.h
* value.h
*
* before they include this file.
*
* Keep this file down to a minimum. Don't put custom builtin funcion
* stuff in this file!
*/
#if !defined(CUSTOM_H)
#define CUSTOM_H
/*
* arg count definitons
*/
#define MAX_CUSTOM_ARGS 100 /* maximum number of custom arguments */
/*
* custom function interface
*/
struct custom {
char *name; /* name of the custom builtin */
char *desc; /* very brief description of custom builtin */
short minargs; /* minimum number of arguments */
short maxargs; /* maximum number of arguments */
VALUE (*func)(char *name, int argc, VALUE **argv); /* custom func */
};
/*
* external declarations
*
* These are the required interfaces. The dummy.c stubs these interfaces too.
*/
extern VALUE custom(char*, int, VALUE**); /* master custom interface */
extern int allow_custom; /* TRUE => custom builtins allowed */
extern void showcustom(void); /* print custom functions */
extern void customhelp(char *); /* direct custom help */
extern CONST struct custom cust[]; /* custom interface table */
#endif /* !CUSTOM_H */

51
custom/CUSTOM_CAL Normal file
View File

@@ -0,0 +1,51 @@
#
# Copyright (c) 1997 Landon Curt Noll
#
# Permission to use, copy, modify, and distribute this software and
# its documentation for any purpose and without fee is hereby granted,
# provided that the above copyright, this permission notice and text
# this comment, and the disclaimer below appear in all of the following:
#
# supporting documentation
# source copies
# source works derived from this source
# binaries derived from this source or from derived source
#
# LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
# EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
# USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
# OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
# PERFORMANCE OF THIS SOFTWARE.
#
# chongo was here /\../\ chongo@toad.com
The following custom calc library files are provided because they serve
as examples of how use the custom interface. The custom interface
allows for machine dependent and/or non-portable code to be added as
builtins to the calc program. A few example custom functions and
library files are shipped with calc to provide you with examples.
By default, the custom builtin returns an error. Calc have been
built with:
ALLOW_CUSTOM= -DCUSTOM
in the top level Makefile (this is the shipped default) and calc
must be invoked with a -C argument:
calc -C
when it is run.
See the ../lib/README or "help stdlib" for information about
calc library standards and guidelines.
=-=
halflen.cal
halflen(num)
Calculate the length of a numeric value in HALF's.

606
custom/HOW_TO_ADD Normal file
View File

@@ -0,0 +1,606 @@
Guidelines for adding custom functions
Step 0: Determine if is should it be done?
The main focus for calc is to provide a portable platform for
multi-precision calculations in a C-like environment. You should
consider implementing algorithms in the calc language as a first
choice. Sometimes an algorithm requires use of special hardware, a
non-portable OS or pre-compiled C library. In these cases a custom
interface may be needed.
The custom function interface is intended to make is easy for
programmers to add functionality that would be otherwise
un-suitable for general distribution. Functions that are
non-portable (machine, hardware or OS dependent) or highly
specialized are possible candidates for custom functions.
So before you go to step 1, ask yourself:
+ Can I implement this as a calc library script?
If Yes, write the script and be done with it.
If No, continue to the next question ...
+ Does it require the use of non-portable features,
OS specific support or special hardware?
If No, write it as a regular builtin function.
If Yes, continue to step 1 ...
Step 1: Do some background work
First ... read this file ALL THE WAY THROUGH before implementing
anything in Steps 2 and beyond!
If you are not familiar with calc internals, we recommend that
you look at some examples of custom functions. Check out
the following source files:
../custom.c
custom.h
custtbl.c
c_*.[ch]
../help/custom
You would be well advised to look at a more recent calc source
such as one available in from the calc alpha test archive.
See the following for more details:
../help/archive
Step 2: Name your custom function
We suggest that you pick a name that does not conflict with
one of the builtin names. It makes it easier to get help
via the help interface and avoid confusion down the road.
You should avoid picking a name that matches a file or
directory name under ${HELPDIR} as well. Not all help
files are associated with builtin function names.
For purposes of this file, we will use the name 'curds'
as our example custom function name.
Step 3: Document your custom function
No this step is NOT out of order. We recommend that you write the
help file associated with your new custom function EARLY. By
experience we have found that the small amount of effort made to
write "how the custom function will be used" into a help file pays
off in a big way when it comes to coding. Often the effort of
writing a help file will clarify fuzzy aspects of your design.
Besides, unless you write the help file first, it will likely never
be written later on. :-(
OK ... we will stop preaching now ...
[[ From now on we will give filenames relative to the custom directory ]]
Take a look at one of the example custom help files:
devnull
argv
help
sysinfo
You can save time by using one of the custom help files
as a template. Copy one of these files to your own help file:
cp sysinfo curds
and edit it accordingly.
Step 4: Write your test code
No this step is NOT out of order either. We recommend that you
write a simple calc script that will call your custom function and
check the results.
This script will be useful while you are debugging your code. In
addition, if you wish to submit your code for distribution, this
test code will be an import part of your submission. Your test
code will also service as additional for your custom function.
Coops ... we said we would stop preaching, sorry about that ...
You can use one of the following as a template:
argv.cal
halflen.cal
Copy one of these to your own file:
cp halflen.cal curds.cal
and exit it accordingly. In particular you will want to:
remove our header disclaimer (or put your own on)
change the name from halflen() to curds()
change the comment from 'halflen - determine the length ...' to
'curds - brief description about ...'
change the print statement near the very bottom from:
print "halflen(num) defined";
to:
print "curds( ... args description here ...) defined";
Step 5: Write your custom function
By convention, the files we ship that contain custom function
interface code in filenames of the form:
c_*.c
We suggest that you use filenames of the form:
u_*.c
to avoid filename conflicts.
We recommend that you use one of the c_*.c files as a template.
Copy an appropriate file to your file:
cp c_argv.c u_curds.c
Before you edit it, you should note that there are several important
features of this file.
a) All of the code in the file is found between #if ... #endif:
/*
* only comments and blank lines at the top
*/
#if defined(CUSTOM)
... all code, #includes, #defines etc.
#endif /* CUSTOM */
This allows this code to 'go away' when the upper Makefile
disables the custom code (because ALLOW_CUSTOM no longer
has the -DCUSTOM define).
b) The function type must be:
/*ARGSUSED*/
VALUE
u_curds(char *name, int count, VALUE **vals)
The /*ARGSUSED*/ may be needed if you do not make use
of all 3 function parameters.
The 3 args are passed in by the custom interface
and have the following meaning:
name The name of the custom function that
was called. In particular, this is the first
string arg that was given to the custom()
builtin. This is the equivalent of argv[0] for
main() in C programming.
The same code can be used for multiple custom
functions by processing off of this value.
count This is the number of additional args that
was given to the custom() builtin. Note
that count does NOT include the name arg.
This is similar to argc except that count
is one less than the main() argc interface.
For example, a call of:
custom("curds", a, b, c)
would cause count to be passed as 3.
vals This is a pointer to an array of VALUEs.
This is the equivalent of argv+1 for
main() in C programming. The difference
here is that vals[0] refers to the 1st
parameter AFTER the same.
For example, a call of:
custom("curds", a, b, c)
would cause vals to point to the following array:
vals[0] points to a
vals[1] points to b
vals[2] points to c
c) The return value is the function must be a VALUE.
The typical way to form a VALUE to return is by declaring
the following local variable:
VALUE result; /* what we will return */
d) You will need to include:
#if defined(CUSTOM)
/* any #include <foobar.h> here */
#include "../have_const.h"
#include "../value.h"
#include "custom.h"
Typically these will be included just below any system
includes and just below the #if defined(CUSTOM) line.
To better understand the VALUE type, read:
../value.h
The VALUE is a union of major value types found inside calc.
The v_type VALUE element determines which union element is
being used. Assume that we have:
VALUE *vp;
Then the value is determined according to v_type:
vp->v_type the value is which is a type defined in
---------- ------------ ---------- ---------------
V_NULL (none) n/a n/a
V_INT vp->v_int long n/a
V_NUM vp->v_num NUMBER * ../qmath.h
V_COM vp->v_com COMPLEX * ../cmath.h
V_ADDR vp->v_addr VALUE * ../value.h
V_STR vp->v_str char * n/a
V_MAT vp->v_mat MATRIX * ../value.h
V_LIST vp->v_list LIST * ../value.h
V_ASSOC vp->v_assoc ASSOC * ../value.h
V_OBJ vp->v_obj OBJECT * ../value.h
V_FILE vp->v_file FILEID ../value.h
V_RAND vp->v_rand RAND * ../zrand.h
V_RANDOM vp->v_random RANDOM * ../zrandom.h
V_CONFIG vp->v_config CONFIG * ../config.h
V_HASH vp->v_hash HASH * ../hash.h
V_BLOCK vp->v_block BLOCK * ../block.h
The V_OCTET is under review and should not be used at this time.
There are a number of macros that may be used to determine
information about the numerical values (ZVALUE, NUMBER and COMPLEX).
you might also want to read the following to understand
some of the numerical types of ZVALUE, NUMBER and COMPLEX:
../zmath.h
../qmath.h
../cmath.h
While we cannot go into full detail here are some cookbook
code for manipulating VALUEs. For these examples assume
that we will manipulate the return value:
VALUE result; /* what we will return */
To return NULL:
result.v_type = V_NULL;
return result;
To return a long you need to convert it to a NUMBER:
long variable;
result.v_type = V_NUM;
result.v_num = itoq(variable); /* see ../qmath.c */
return result;
To return a FULL you need to convert it to a NUMBER:
FULL variable;
result.v_type = V_NUM;
result.v_num = utoq(variable); /* see ../qmath.c */
return result;
To convert a ZVALUE to a NUMBER*:
ZVALUE variable;
result.v_type = V_NUM;
result.v_num = qalloc(); /* see ../qmath.c */
result.v_num->num = variable;
return result;
To convert a small NUMBER* into a long:
NUMBER *num;
long variable;
variable = qtoi(num);
To obtain a ZVALUE from a NUMBER*, extract the numerator:
NUMBER *num;
ZVALUE z_variable;
if (qisint(num)) {
z_variable = num->num;
}
To be sure that the value will fit, use the ZVALUE test macros:
ZVALUE z_num;
long variable;
unsigned long u_variable;
FULL f_variable;
short very_tiny_variable;
if (zgtmaxlong(z_num)) { /* see ../zmath.h */
variable = ztolong(z_num);
}
if (zgtmaxulong(z_num)) {
u_variable = ztoulong(z_num);
}
if (zgtmaxufull(z_num)) {
f_variable = ztofull(z_num);
}
if (zistiny(z_num)) {
very_tiny_variable = z1tol(z_num);
}
Step 6: Register the function in the custom interface table
To allow the custom() builtin to transfer control to your function,
you need to add an entry into the CONST struct custom cust table
found in custtbl.c:
/*
* custom interface table
*
* The order of the elements in struct custom are:
*
* { "xyz", "brief description of the xyz custom function",
* minimum_args, maximum_args, c_xyz },
*
* where:
*
* minimum_args an int >= 0
* maximum_args an int >= minimum_args and <= MAX_CUSTOM_ARGS
*
* Use MAX_CUSTOM_ARGS for maximum_args is the maximum number of args
* is potentially 'unlimited'.
*
* If the brief description cannot fit on the same line as the name
* without wrapping on a 80 col window, the description is probably
* too long and will not look nice in the show custom output.
*/
CONST struct custom cust[] = {
#if defined(CUSTOM)
/*
* add your own custom functions here
*
* We suggest that you sort the entries below by name
* so that show custom will produce a nice sorted list.
*/
{ "argv", "information about its args, returns arg count",
0, MAX_CUSTOM_ARGS, c_argv },
{ "devnull", "does nothing",
0, MAX_CUSTOM_ARGS, c_devnull },
{ "help", "help for custom functions",
1, 1, c_help },
{ "sysinfo", "return a calc #define value",
0, 1, c_sysinfo },
#endif /* CUSTOM */
/*
* This must be at the end of this table!!!
*/
{NULL, NULL,
0, 0, NULL}
};
The definition of struct custom may be found in custom.h.
It is important that your entry be placed inside the:
#if defined(CUSTOM) ... #endif /* CUSTOM */
lines so that when the custom interface is disabled by the upper
level Makefile, one does not have unsatisfied symbols.
The brief description should be brief so that 'show custom' looks well
formatted. If the brief description cannot fit on the same line as
the name without wrapping on a 80 col window, the description is
probably too long and will not look nice in the show custom output.
The minargs places a lower bound on the number of args that
must be supplied to the interface. This does NOT count
the name argument given to custom(). So if minargs is 2:
custom("curds") /* call blocked at high level interface */
custom("curds", a) /* call blocked at high level interface */
custom("curds", a, b) /* call passed down to "curds" interface */
The maxargs sets a limit on the number of args that may be passed.
If minargs == maxargs, then the call requires a fixed number of
argument. There is a upper limit on the number of args. If
one wants an effectively unlimited upper bound, use MAX_CUSTOM_ARGS.
Note that one must have:
0 <= minargs <= maxargs <= MAX_CUSTOM_ARGS
To allow the curds function to take at least 2 args and up
to 5 args, one would add the following entry to cust[]:
{ "curds", "brief description about curds interface",
2, 5, u_curds },
It is recommended that the cust[] remain in alphabetical order,
so one would place it before the "devnull" and after "argv".
Last, you must forward declare the u_curds near the top of the file:
#if defined(CUSTOM)
/*
* add your forward custom function declarations here
*
* Declare custom functions as follows:
*
* extern VALUE c_xyz(char*, int, VALUE**);
*
* We suggest that you sort the entries below by name.
*/
extern VALUE c_argv(char*, int, VALUE**);
extern VALUE c_devnull(char*, int, VALUE**);
extern VALUE c_help(char*, int, VALUE**);
extern VALUE c_sysinfo(char*, int, VALUE**);
For u_curds we would add the line:
extern VALUE u_curds(char*, int, VALUE**);
Step 7: Add the required information to the Makefile
The calc test script, curds.cal, should be added to the
CUSTOM_CALC_FILES Makefile variable:
CUSTOM_CALC_FILES= argv.cal halflen.cal curds.cal
The help file, curds, should be added to the CUSTOM_HELP
Makefile variable:
CUSTOM_HELP= argv devnull help sysinfo curds
If you needed to create any .h files to support u_curds.c, these
files should be added to the CUSTOM_H_SRC Makefile variable:
CUSTOM_H_SRC= u_curds.h otherfile.h
Your u_curds.c file MUST be added to the CUSTOM_SRC Makefile variable:
CUSTOM_SRC= c_argv.c c_devnull.c c_help.c c_sysinfo.c u_curds.c
and so must the associated .o file:
CUSTOM_OBJ= c_argv.o c_devnull.o c_help.o c_sysinfo.o u_curds.o
Step 8: Compile and link in your code
If your calc was not previously setup to compile custom code,
you should set it up now. The upper level Makefile (and
the custom Makefile) should have the following Makefile
variable defined:
ALLOW_CUSTOM= -DCUSTOM
It is recommended that you build your code from the top level
Makefile. It saves having to sync the other Makefile values.
To try and build the new libcustcalc.a that contains u_curds.c:
(cd ..; make custom/libcustcalc.a)
Fix any compile and syntax errors as needed. :-)
Once libcustcalc.a successfully builds, compile calc:
cd ..
make calc
And check to be sure that the regression test suite still
works without errors:
make check
Step 9: Add the Make dependency tools
You should probably add the dependency lines to the bottom of
the Makefile. Given the required include files, you will at least
have the following entries placed at the bottom of the Makefile:
u_curds.o: ../alloc.h
u_curds.o: ../block.h
u_curds.o: ../byteswap.h
u_curds.o: ../calcerr.h
u_curds.o: ../cmath.h
u_curds.o: ../config.h
u_curds.o: ../endian_calc.h
u_curds.o: ../hash.h
u_curds.o: ../have_const.h
u_curds.o: ../have_malloc.h
u_curds.o: ../have_newstr.h
u_curds.o: ../have_stdlib.h
u_curds.o: ../have_string.h
u_curds.o: ../longbits.h
u_curds.o: ../nametype.h
u_curds.o: ../qmath.h
u_curds.o: ../shs.h
u_curds.o: ../value.h
u_curds.o: ../zmath.h
u_curds.o: u_curds.c
u_curds.o: ../custom.h
If you have the makedepend tool from the X11 development environment
(by Todd Brunhoff, Tektronix, Inc. and MIT Project Athena), you can
use the following to update your dependencies:
# cd to the top level calc directory if you are not there already
rm -f Makefile.bak custom/Makefile.bak
make depend
diff -c Makefile.bak Makefile # look at the changes
diff -c custom/Makefile.bak custom/Makefile # look at the changes
rm -f Makefile.bak custom/Makefile.bak # cleanup
Step 10: Test
Now that you have built calc with your new custom function, test it:
./calc -C # run the new calc with the -C arg
And then try out our test suite:
C-style arbitrary precision calculator (version 2.10.3t5.1)
[Type "exit" to exit, or "help" for help.]
> read custom/curds.cal
curds(a, b, [c, d, e]) defined
> custom("curds", 2, 3, 4)
Step 11: Install
Once you are satisfied that everything works, install the new code:
# cd to the top level calc directory if you are not there already
make install
Although calc does not run setuid, you may need to be root to install
the directories into which calc installs may be write protected.

649
custom/Makefile Normal file
View File

@@ -0,0 +1,649 @@
#
# custom - makefile for calc custom routines
#
# Copyright (c) 1997 Landon Curt Noll
#
# Permission to use, copy, modify, and distribute this software and
# its documentation for any purpose and without fee is hereby granted,
# provided that the above copyright, this permission notice and text
# this comment, and the disclaimer below appear in all of the following:
#
# supporting documentation
# source copies
# source works derived from this source
# binaries derived from this source or from derived source
#
# LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
# EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
# USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
# OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
# PERFORMANCE OF THIS SOFTWARE.
#
# Comments, suggestions, bug fixes and questions about these routines
# are welcome. Send EMail to the address given below.
#
# Happy bit twiddling,
#
# Landon Curt Noll
#
# chongo@toad.com
# ...!{pyramid,sun,uunet}!hoptoad!chongo
#
# chongo was here /\../\
##############################################################################
#-=-=-=-=-=-=-=-=- You may want to change some values below -=-=-=-=-=-=-=-=-#
##############################################################################
# The custom calc library files to install
#
# Put your custom calc library files here.
#
CUSTOM_CALC_FILES= argv.cal halflen.cal
# The custom help files to install
#
# Put your custom help files here.
#
CUSTOM_HELP= argv devnull help sysinfo
# Any .h files that are needed by programs that use libcustcalc.a
#
# Put any .h files that you add which might be useful to other
# programs here.
#
CUSTOM_H_SRC=
# Any .c files that are needed to build libcustcalc.a.
# Don't put ${REQUIRED_SRC} files in this list.
#
# There MUST be a .c in CUSTOM_SRC for every .o in CUSTOM_OBJ.
#
# Put your custom .c files here.
#
CUSTOM_SRC= c_argv.c c_devnull.c c_help.c c_sysinfo.c
# Any .o files that are needed by program that use libcustcalc.a.
# Don't put ${REQUIRED_OBJ} files in this list.
#
# There MUST be a .c in CUSTOM_SRC for every .o in CUSTOM_OBJ.
#
# Put your custom .o files here.
#
CUSTOM_OBJ= c_argv.o c_devnull.o c_help.o c_sysinfo.o
##############################################################################
#-=-=-=-=-=-=- Defaults in case you want to build from this dir -=-=-=-=-=-=-#
##############################################################################
# Normally, the upper level makefile will set these values. We provide
# a default here just in case you want to build from this directory.
#
# Makefile debug
#
# Q=@ do not echo internal makefile actions (quiet mode)
# Q= echo internal makefile actions (debug / verbose mode)
#
#Q=
Q=@
# Normally, the upper level makefile will set these values. We provide
# a default here just in case you want to build from this directory.
#
# where to install things
#
# ${TOPDIR} is the directory under which the calc directory will be placed.
# ${LIBDIR} is where the *.cal, *.h, *.a, bindings and help dir are installed.
# ${HELPDIR} is where the help directory is installed.
# ${CUSTOMLIBDIR} is where custom lib files are installed.
# ${CUSTOMHELPDIR} is where custom help files are installed.
#
TOPDIR= /usr/local/lib
#TOPDIR= /usr/lib
#TOPDIR= /usr/libdata
#TOPDIR= /usr/contrib/lib
#
LIBDIR= ${TOPDIR}/calc
HELPDIR= ${LIBDIR}/help
CUSTOMLIBDIR= ${LIBDIR}/custom
CUSTOMHELPDIR= ${HELPDIR}/custhelp
# Normally, the upper level makefile will set these values. We provide
# a default here just in case you want to build from this directory.
#
# Debug/Optimize options for ${CC}
#
DEBUG= -O
#DEBUG= -O -g
#DEBUG= -O -g3
#DEBUG= -O1
#DEBUG= -O1 -g
#DEBUG= -O1 -g3
#DEBUG= -O2
#DEBUG= -O2 -g
#DEBUG= -O2 -g3
#DEBUG= -O2 -ipa
#DEBUG= -O2 -g3 -ipa
#DEBUG= -O3
#DEBUG= -O3 -g
#DEBUG= -O3 -g3
#DEBUG= -O3 -ipa
#DEBUG= -O3 -g3 -ipa
#DEBUG= -g
#DEBUG= -g3
#DEBUG= -gx
#DEBUG= -WM,-g
#DEBUG=
# Normally, the upper level makefile will set these values. We provide
# a default here just in case you want to build from this directory.
#
# On systems that have dynamic shared libs, you may want want to disable them
# for faster calc startup.
#
# System type NO_SHARED recommendation
#
# BSD NO_SHARED=
# SYSV NO_SHARED= -dn
# IRIX NO_SHARED= -non_shared
# disable NO_SHARED=
#
# If in doubt, use NO_SHARED=
#
NO_SHARED=
#NO_SHARED= -dn
#NO_SHARED= -non_shared
# Normally, the upper level makefile will set these values. We provide
# a default here just in case you want to build from this directory.
#
# Some systems require one to use ranlib to add a symbol table to
# a *.a library. Set RANLIB to the utility that performs this action.
# Set RANLIB to : if your system does not need such a utility.
#
#RANLIB=ranlib
RANLIB=:
# Normally, the upper level makefile will set these values. We provide
# a default here just in case you want to build from this directory.
#
# Normally certain files depend on the Makefile. If the Makefile is
# changed, then certain steps should be redone. If MAKE_FILE is
# set to Makefile, then these files will depend on Makefile. If
# MAKE_FILE is empty, they they wont.
#
# If in doubt, set MAKE_FILE to Makefile
#
MAKE_FILE= Makefile
#MAKE_FILE=
# Normally, the upper level makefile will set these values. We provide
# a default here just in case you want to build from this directory.
#
# If you do not wish to use purify, leave PURIFY commented out.
#
# If in doubt, leave PURIFY commented out.
#
#PURIFY= purify -logfile=pure.out
#PURIFY= purify
# Normally, the upper level makefile will set these values. We provide
# a default here just in case you want to build from this directory.
#
# By default, custom builtin functions may only be executed if calc
# is given the -C option. This is because custom builtin functions
# may invoke non-standard or non-portable code. One may completely
# disable custom builtin functions by not compiling any of code
#
# ALLOW_CUSTOM= -DCUSTOM # allow custom only if -C is given
# ALLOW_CUSTOM= # disable custom even if -C is given
#
# If in doubt, use ALLOW_CUSTOM= -DCUSTOM
#
ALLOW_CUSTOM= -DCUSTOM
#ALLOW_CUSTOM=
###
#
# Normally, the upper level makefile will set these values. We provide
# a default here just in case you want to build from this directory.
#
# Select your compiler type by commenting out one of the cc sets below:
#
# CCOPT are flags given to ${CC} for optimization
# CCWARN are flags given to ${CC} for warning message control
# CCMISC are misc flags given to ${CC}
#
# CFLAGS are all flags given to ${CC} [[often includes CCOPT, CCWARN, CCMISC]]
# ICFLAGS are given to ${CC} for intermediate progs
#
# LCFLAGS are CC-style flags for ${LINT}
# LDFLAGS are flags given to ${CC} for linking .o files
# ILDFLAGS are flags given to ${CC} for linking .o files for intermediate progs
#
# CC is how the the C compiler is invoked
#
###
#
# common cc set
#
CCWARN=
CCOPT= ${DEBUG} ${NO_SHARED}
CCMISC=
#
CFLAGS= ${CCWARN} ${CCOPT} ${CCMISC} ${ALLOW_CUSTOM}
ICFLAGS= ${CCWARN} ${CCMISC}
#
LCFLAGS=
LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED}
ILDFLAGS=
#
CC= ${PURIFY} cc
##############################################################################
#-=-=-=-=-=-=-=-=- Be careful if you change something below -=-=-=-=-=-=-=-=-#
##############################################################################
# These .c files are required for the main custom interface and
# for the custom support functions.
#
# There MUST be a .c for every .o in REQUIRED_OBJ.
#
REQUIRED_SRC= custtbl.c
# These .o files correspond to the .c files in REQUIRED_SRC
#
# There MUST be a .o for every .c in REQUIRED_SRC.
#
REQUIRED_OBJ= custtbl.o
# These .h files are installed under ${CUSTOMLIBDIR} by the install rule.
#
INSTALL_H_SRC= ${CUSTOM_H_SRC}
# These .c files are used to form libcustcalc.a.
#
CUSTCALC_SRC= ${REQUIRED_SRC} ${CUSTOM_SRC}
# These .o files are used to form libcustcalc.a.
#
CUSTCALC_OBJ= ${REQUIRED_OBJ} ${CUSTOM_OBJ}
# These .c files are used to build the dependency list
#
C_SRC= ${REQUIRED_SRC} ${CUSTOM_SRC}
# These .h files are used to build the dependecy list
#
H_SRC= ${CUSTOM_H_SRC}
# These files are found (but not built) in the distribution
#
# The CUSTOM_CAL and HOW_TO_ADD are files distributed from this
# directory but are installed as help files from the help/Makefile.
#
DISTLIST= ${CUSTCALC_SRC} ${CUSTOM_CALC_FILES} ${CUSTOM_HELP} \
${INSTALL_H_SRC} CUSTOM_CAL HOW_TO_ADD ${MAKE_FILE}
# complete list of targets
#
TARGETS= libcustcalc.a ${CUSTCALC_OBJ}
# required vars
#
SHELL = /bin/sh
SED= sed
MAKEDEPEND= makedepend
SORT= sort
##
#
# Standard rules and targets
#
##
all: ${TARGETS} ${INSTALL_H_SRC} ${CUSTOM_CALC_FILES} \
${CUSTOM_HELP} ${MAKE_FILE} .all
libcustcalc.a: ${CUSTCALC_OBJ} ${MAKE_FILE} ../Makefile
-rm -f libcustcalc.a
ar qc libcustcalc.a ${CUSTCALC_OBJ}
${RANLIB} libcustcalc.a
##
#
# used by the upper level Makefile
#
##
# to determine of we have done all
#
.all:
rm -f .all
touch .all
##
#
# File list generation. You can ignore this section.
#
#
# We will form the names of source files as if they were in a
# sub-directory called calc/lib.
#
# NOTE: Due to bogus shells found on one common system we must have
# an non-emoty else clause for every if condition. *sigh*
#
##
distlist: ${DISTLIST}
${Q}for i in ${DISTLIST}; do \
echo calc/custom/$$i; \
done
# The bsdi distribution has generated files as well as distributed files.
#
bsdilist: ${DISTLIST}
${Q}for i in ${DISTLIST}; do \
echo calc/custom/$$i; \
done
##
#
# Home grown make dependency rules. Your system make not support
# or have the needed tools. You can ignore this section.
#
# We will form a skelaton tree of *.c files containing only #include "foo.h"
# lines and .h files containing the same lines surrounded by multiple include
# prevention lines. This allows us to build a static depend list that will
# satisfy all possible cpp symbol definition combinations.
#
##
depend:
${Q}if [ -f Makefile.bak ]; then \
echo "Makefile.bak exists, remove or move it out of the way"; \
exit 1; \
else \
true; \
fi
${Q}echo forming custom/skel
-${Q}rm -rf skel
${Q}mkdir skel
${Q}mkdir skel/custom
-${Q}for i in ${C_SRC}; do \
${SED} -n '/^#[ ]*include[ ]*"/p' \
"$$i" > "skel/custom/$$i"; \
done
-${Q}for i in /dev/null ${H_SRC}; do \
if [ "$$i" = "/dev/null" ]; then \
continue; \
fi; \
tag="`echo $$i | ${SED} 's/[\.+,:]/_/g'`"; \
echo "#ifndef $$tag" > "skel/custom/$$i"; \
echo "#define $$tag" >> "skel/custom/$$i"; \
${SED} -n '/^#[ ]*include[ ]*"/p' "$$i" \
>> "skel/custom/$$i"; \
echo '#endif /* '"$$tag"' */' >> "skel/custom/$$i"; \
done
${Q}(cd ..; ${MAKE} hsrc)
${Q}for i in `cd ..; ${MAKE} h_list`; do \
tag="`echo $$i | ${SED} 's/[\.+,:]/_/g'`"; \
echo "#ifndef $$tag" > "skel/$$i"; \
echo "#define $$tag" >> "skel/$$i"; \
${SED} -n '/^#[ ]*include[ ]*"/p' "../$$i" \
>> "skel/$$i"; \
echo '#endif /* '"$$tag"' */' >> "skel/$$i"; \
done
-${Q}rm -f skel/custom/makedep.out
${Q}echo custom/skel formed
${Q}echo forming custom dependency list
${Q}echo "# DO NOT DELETE THIS LINE -- make depend depends on it." > \
skel/custom/makedep.out
${Q}cd skel/custom; ${MAKEDEPEND} -w 1 -m -f makedep.out ${C_SRC}
-${Q}for i in ${C_SRC}; do \
echo "$$i" | \
${SED} 's/^\(.*\)\.c/\1.o: \1.c/' \
>> skel/custom/makedep.out; \
done
${Q}echo custom dependency list formed
${Q}echo forming new custom/Makefile
-${Q}rm -f Makefile.bak
${Q}mv Makefile Makefile.bak
${Q}${SED} -n '1,/^# DO NOT DELETE THIS LINE/p' Makefile.bak > Makefile
${Q}echo "" >> Makefile
${Q}${SED} -n '3,$$p' skel/custom/makedep.out | ${SORT} -u >> Makefile
-${Q}rm -rf skel
-${Q}if cmp -s Makefile.bak Makefile; then \
echo 'custom Makefile was already up to date'; \
mv -f Makefile.bak Makefile; \
else \
rm -f Makefile.tmp; \
mv Makefile Makefile.tmp; \
sccs edit Makefile; \
mv Makefile.tmp Makefile; \
echo new 'custom Makefile formed -- you need to check it in'; \
fi
##
#
# Utility rules
#
##
clean:
-rm -f ${CUSTCALC_OBJ}
clobber:
-rm -f ${TARGETS}
rm -f .all Makefile.tmp
install: all
-${Q}if [ ! -d ${TOPDIR} ]; then \
echo mkdir ${TOPDIR}; \
mkdir ${TOPDIR}; \
else \
true; \
fi
-${Q}if [ ! -d ${LIBDIR} ]; then \
echo mkdir ${LIBDIR}; \
mkdir ${LIBDIR}; \
else \
true; \
fi
-${Q}if [ ! -d ${HELPDIR} ]; then \
echo mkdir ${HELPDIR}; \
mkdir ${HELPDIR}; \
else \
true; \
fi
-${Q}if [ ! -d ${CUSTOMLIBDIR} ]; then \
echo mkdir ${CUSTOMLIBDIR}; \
mkdir ${CUSTOMLIBDIR}; \
else \
true; \
fi
-${Q}if [ ! -d ${CUSTOMHELPDIR} ]; then \
echo mkdir ${CUSTOMHELPDIR}; \
mkdir ${CUSTOMHELPDIR}; \
else \
true; \
fi
${Q}for i in ${INSTALL_H_SRC}; do \
echo rm -f ${CUSTOMLIBDIR}/$$i; \
rm -f ${CUSTOMLIBDIR}/$$i; \
echo cp $$i ${CUSTOMLIBDIR}; \
cp $$i ${CUSTOMLIBDIR}; \
echo chmod 0444 ${CUSTOMLIBDIR}/$$i; \
chmod 0444 ${CUSTOMLIBDIR}/$$i; \
done
${Q}for i in ${CUSTOM_CALC_FILES}; do \
echo rm -f ${CUSTOMLIBDIR}/$$i; \
rm -f ${CUSTOMLIBDIR}/$$i; \
echo cp $$i ${CUSTOMLIBDIR}; \
cp $$i ${CUSTOMLIBDIR}; \
echo chmod 0444 ${CUSTOMLIBDIR}/$$i; \
chmod 0444 ${CUSTOMLIBDIR}/$$i; \
done
${Q}for i in ${CUSTOM_HELP}; do \
echo rm -f ${CUSTOMHELPDIR}/$$i; \
rm -f ${CUSTOMHELPDIR}/$$i; \
echo cp $$i ${CUSTOMHELPDIR}; \
cp $$i ${CUSTOMHELPDIR}; \
echo chmod 0444 ${CUSTOMHELPDIR}/$$i; \
chmod 0444 ${CUSTOMHELPDIR}/$$i; \
done
-${Q}if [ ! -z ${ALLOW_CUSTOM} ]; then \
echo "rm -f ${CUSTOMLIBDIR}/libcustcalc.a"; \
rm -f ${CUSTOMLIBDIR}/libcustcalc.a; \
echo "cp libcustcalc.a ${CUSTOMLIBDIR}/libcustcalc.a"; \
cp libcustcalc.a ${CUSTOMLIBDIR}/libcustcalc.a; \
echo "chmod 0644 ${CUSTOMLIBDIR}/libcustcalc.a"; \
chmod 0644 ${CUSTOMLIBDIR}/libcustcalc.a; \
echo "${RANLIB} ${CUSTOMLIBDIR}/libcustcalc.a"; \
${RANLIB} ${CUSTOMLIBDIR}/libcustcalc.a; \
fi
##
#
# make depend stuff
#
##
# DO NOT DELETE THIS LINE
c_argv.o: ../alloc.h
c_argv.o: ../block.h
c_argv.o: ../byteswap.h
c_argv.o: ../calc.h
c_argv.o: ../calcerr.h
c_argv.o: ../cmath.h
c_argv.o: ../config.h
c_argv.o: ../custom.h
c_argv.o: ../endian_calc.h
c_argv.o: ../hash.h
c_argv.o: ../have_const.h
c_argv.o: ../have_malloc.h
c_argv.o: ../have_memmv.h
c_argv.o: ../have_newstr.h
c_argv.o: ../have_stdlib.h
c_argv.o: ../have_string.h
c_argv.o: ../longbits.h
c_argv.o: ../md5.h
c_argv.o: ../nametype.h
c_argv.o: ../qmath.h
c_argv.o: ../shs.h
c_argv.o: ../shs1.h
c_argv.o: ../string.h
c_argv.o: ../value.h
c_argv.o: ../zmath.h
c_argv.o: c_argv.c
c_devnull.o: ../alloc.h
c_devnull.o: ../block.h
c_devnull.o: ../byteswap.h
c_devnull.o: ../calcerr.h
c_devnull.o: ../cmath.h
c_devnull.o: ../config.h
c_devnull.o: ../custom.h
c_devnull.o: ../endian_calc.h
c_devnull.o: ../hash.h
c_devnull.o: ../have_const.h
c_devnull.o: ../have_malloc.h
c_devnull.o: ../have_memmv.h
c_devnull.o: ../have_newstr.h
c_devnull.o: ../have_stdlib.h
c_devnull.o: ../have_string.h
c_devnull.o: ../longbits.h
c_devnull.o: ../md5.h
c_devnull.o: ../nametype.h
c_devnull.o: ../qmath.h
c_devnull.o: ../shs.h
c_devnull.o: ../shs1.h
c_devnull.o: ../string.h
c_devnull.o: ../value.h
c_devnull.o: ../zmath.h
c_devnull.o: c_devnull.c
c_help.o: ../alloc.h
c_help.o: ../block.h
c_help.o: ../byteswap.h
c_help.o: ../calcerr.h
c_help.o: ../cmath.h
c_help.o: ../config.h
c_help.o: ../custom.h
c_help.o: ../endian_calc.h
c_help.o: ../hash.h
c_help.o: ../have_const.h
c_help.o: ../have_malloc.h
c_help.o: ../have_memmv.h
c_help.o: ../have_newstr.h
c_help.o: ../have_stdlib.h
c_help.o: ../have_string.h
c_help.o: ../longbits.h
c_help.o: ../md5.h
c_help.o: ../nametype.h
c_help.o: ../qmath.h
c_help.o: ../shs.h
c_help.o: ../shs1.h
c_help.o: ../string.h
c_help.o: ../value.h
c_help.o: ../zmath.h
c_help.o: c_help.c
c_sysinfo.o: ../alloc.h
c_sysinfo.o: ../block.h
c_sysinfo.o: ../byteswap.h
c_sysinfo.o: ../calc.h
c_sysinfo.o: ../calcerr.h
c_sysinfo.o: ../cmath.h
c_sysinfo.o: ../conf.h
c_sysinfo.o: ../config.h
c_sysinfo.o: ../custom.h
c_sysinfo.o: ../endian_calc.h
c_sysinfo.o: ../fposval.h
c_sysinfo.o: ../hash.h
c_sysinfo.o: ../have_const.h
c_sysinfo.o: ../have_malloc.h
c_sysinfo.o: ../have_memmv.h
c_sysinfo.o: ../have_newstr.h
c_sysinfo.o: ../have_stdlib.h
c_sysinfo.o: ../have_string.h
c_sysinfo.o: ../hist.h
c_sysinfo.o: ../longbits.h
c_sysinfo.o: ../longlong.h
c_sysinfo.o: ../md5.h
c_sysinfo.o: ../nametype.h
c_sysinfo.o: ../prime.h
c_sysinfo.o: ../qmath.h
c_sysinfo.o: ../shs.h
c_sysinfo.o: ../shs1.h
c_sysinfo.o: ../string.h
c_sysinfo.o: ../value.h
c_sysinfo.o: ../zmath.h
c_sysinfo.o: ../zrand.h
c_sysinfo.o: ../zrandom.h
c_sysinfo.o: c_sysinfo.c
custtbl.o: ../alloc.h
custtbl.o: ../block.h
custtbl.o: ../byteswap.h
custtbl.o: ../calcerr.h
custtbl.o: ../cmath.h
custtbl.o: ../config.h
custtbl.o: ../custom.h
custtbl.o: ../endian_calc.h
custtbl.o: ../hash.h
custtbl.o: ../have_const.h
custtbl.o: ../have_malloc.h
custtbl.o: ../have_memmv.h
custtbl.o: ../have_newstr.h
custtbl.o: ../have_stdlib.h
custtbl.o: ../have_string.h
custtbl.o: ../longbits.h
custtbl.o: ../md5.h
custtbl.o: ../nametype.h
custtbl.o: ../qmath.h
custtbl.o: ../shs.h
custtbl.o: ../shs1.h
custtbl.o: ../string.h
custtbl.o: ../value.h
custtbl.o: ../zmath.h
custtbl.o: custtbl.c

41
custom/argv Normal file
View File

@@ -0,0 +1,41 @@
NAME
argv - displays information about its args
SYNOPSIS
custom("argv" [, arg ...])
TYPES
arg any
return int
DESCRIPTION
This custom function will, for each arg given print:
arg number
arg type
number of elements (size())
memory size (sizeof())
The number of args passed, not counting the initial "argv" name
arg is returned.
EXAMPLE
> foo=5^713; bar=17; baz=list(2,3,4);
> custom("argv", foo, bar, baz, 3+4.5i, pi())
arg[0] rational_value size=1 sizeof=272
arg[1] rational_value size=1 sizeof=68
arg[2] list size=3 sizeof=256
arg[3] complex_value size=1 sizeof=140
arg[4] rational_value size=1 sizeof=84
5
LIMITS
calc must be built with ALLOW_CUSTOM= -DCUSTOM
calc must be executed with a -C arg.
LIBRARY
none
SEE ALSO
custom

44
custom/argv.cal Normal file
View File

@@ -0,0 +1,44 @@
/*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted.
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*
* chongo was here /\../\ chongo@toad.com
*/
/*
* argv - print information about various args
*
* This file is part of the custom sample calc files.
*
* NOTE: You must use a calc that was compiled with ALLOW_CUSTOM= -DCUSTOM
* and run with a -C arg.
*/
define argv()
{
local i; /* arg number */
local junk; /* throw away value */
/*
* process each arg passed to us
*/
for (i = 1; i <= param(0); ++i) {
/*
* This won't really work because all the arg numbers
* will be reported as arg[0] ... but what the heck
* this is only a demo!
*/
junk = custom("argv", param(i));
}
return i-1;
}
if (config("lib_debug") >= 0) {
print "argv(var, ...) defined";
}

162
custom/c_argv.c Normal file
View File

@@ -0,0 +1,162 @@
/*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted.
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*
* Comments, suggestions, bug fixes and questions about these routines
* are welcome. Send EMail to the address given below.
*
* Happy bit twiddling,
*
* Landon Curt Noll
*
* chongo@toad.com
* ...!{pyramid,sun,uunet}!hoptoad!chongo
*
* chongo was here /\../\
*/
#if defined(CUSTOM)
#include <stdio.h>
#include "../have_const.h"
#include "../value.h"
#include "../custom.h"
#include "../config.h"
#include "../calc.h"
/*
* c_argv - a custom function display info about its args
*
* given:
* vals[i] and arg to display information about
*
* returns:
* count
*/
/*ARGSUSED*/
VALUE
c_argv(char *name, int count, VALUE **vals)
{
VALUE result; /* what we will return */
ZVALUE zfilelen; /* length of a file as a ZVALUE */
NUMBER *filelen; /* pointer to length of a file as a NUMER */
char *type; /* the name of the arg type */
int i;
/*
* print info on each arg
*/
for (i=0; i < count; ++i) {
/*
* print arg number with leading tab as configured
*/
printf("%sarg[%d]", (conf->tab_ok ? "\t" : ""), i);
/*
* print the arg type
*/
switch (vals[i]->v_type) {
case V_NULL: /* null value */
type = "null";
break;
case V_INT: /* normal integer */
type = "int";
break;
case V_NUM: /* number */
type = "rational_value";
break;
case V_COM: /* complex number */
type = "complex_value";
break;
case V_ADDR: /* address of variable value */
type = "address";
break;
case V_STR: /* address of string */
type = "string";
break;
case V_MAT: /* address of matrix structure */
type = "matrix";
break;
case V_LIST: /* address of list structure */
type = "list";
break;
case V_ASSOC: /* address of association structure */
type = "assoc";
break;
case V_OBJ: /* address of object structure */
type = "ocject";
break;
case V_FILE: /* opened file id */
type = "file";
break;
case V_RAND: /* address of additive 55 random state */
type = "rand_state";
break;
case V_RANDOM: /* address of Blum random state */
type = "random_state";
break;
case V_CONFIG: /* configuration state */
type = "config_state";
break;
case V_HASH: /* hash state */
type = "hash_state";
break;
case V_BLOCK: /* memory block */
type = "octet_block";
break;
#if 0
/* XXX - V_OCTET is subject to change */
case V_OCTET: /* octet (unsigned char) */
type = "octet";
break;
#endif
default:
type = "unknown";
break;
}
printf("\t%-16s", type);
/*
* print size and sizeof information
*
* We have to treat files in a special way
* because their length can be very long.
*/
if (vals[i]->v_type == V_FILE) {
/* get the file length */
if (getsize(vals[i]->v_file, &zfilelen) == 0) {
filelen = qalloc();
filelen->num = zfilelen;
qprintfd(filelen, 0L);
qfree(filelen);
} else {
/* getsize error */
printf("\tsize=unknown");
}
printf("\tsizeof=%ld\n", lsizeof(vals[i]));
} else {
printf("\tsize=%ld\tsizeof=%ld\n",
elm_count(vals[i]), lsizeof(vals[i]));
}
}
/*
* return count
*/
result.v_type = V_NUM;
result.v_num = itoq(count);
return result;
}
#endif /* CUSTOM */

53
custom/c_devnull.c Normal file
View File

@@ -0,0 +1,53 @@
/*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted.
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*
* Comments, suggestions, bug fixes and questions about these routines
* are welcome. Send EMail to the address given below.
*
* Happy bit twiddling,
*
* Landon Curt Noll
*
* chongo@toad.com
* ...!{pyramid,sun,uunet}!hoptoad!chongo
*
* chongo was here /\../\
*/
#if defined(CUSTOM)
#include "../have_const.h"
#include "../value.h"
#include "../custom.h"
/*
* c_devnull - a custom function that does nothing
*
* This custom function does nothing. It is useful as a test hook
* for looking at the general interface.
*/
/*ARGSUSED*/
VALUE
c_devnull(char *name, int count, VALUE **vals)
{
VALUE result; /* what we will return */
/*
* return NULL
*/
result.v_type = V_NULL;
return result;
}
#endif /* CUSTOM */

77
custom/c_help.c Normal file
View File

@@ -0,0 +1,77 @@
/*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted.
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*
* Comments, suggestions, bug fixes and questions about these routines
* are welcome. Send EMail to the address given below.
*
* Happy bit twiddling,
*
* Landon Curt Noll
*
* chongo@toad.com
* ...!{pyramid,sun,uunet}!hoptoad!chongo
*
* chongo was here /\../\
*/
#if defined(CUSTOM)
#include "../have_const.h"
#include "../value.h"
#include "../custom.h"
/*
* c_help - custom help function
*
* This function assumes that a help file with the same name as
* the custom function has been installed by the custom/Makefile
* (as listed in the CUSTOM_HELP makefile variable) under the
* CUSTOMHELPDIR == HELPDIR/custhelp directory.
*
* The help command first does a search in HELPDIR and later
* in CUSTOMHELPDIR. If a custom help file has the same name
* as a file under HELPDIR then help will display the HELPDIR
* file and NOT the custom file. This function will ignore
* and HELPDIR file and work directly with the custom help file.
*
* given:
* vals[0] name of the custom help file to directly access
*/
/*ARGSUSED*/
VALUE
c_help(char *name, int count, VALUE **vals)
{
VALUE result; /* what we will return */
/*
* parse args
*/
if (vals[0]->v_type != V_STR) {
math_error("custom help arg 1 must be a string");
/*NOTREACHED*/
}
/*
* give the help
*/
customhelp((char *)vals[0]->v_str);
/*
* return NULL
*/
result.v_type = V_NULL;
return result;
}
#endif /* CUSTOM */

366
custom/c_sysinfo.c Normal file
View File

@@ -0,0 +1,366 @@
/*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted.
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*
* Comments, suggestions, bug fixes and questions about these routines
* are welcome. Send EMail to the address given below.
*
* Happy bit twiddling,
*
* Landon Curt Noll
*
* chongo@toad.com
* ...!{pyramid,sun,uunet}!hoptoad!chongo
*
* chongo was here /\../\
*/
#if defined(CUSTOM)
#include <stdio.h>
#include <ctype.h>
#include "../have_const.h"
#include "../value.h"
#include "../custom.h"
#include "../config.h"
#include "../calc.h"
#include "../longbits.h"
#include "../longlong.h"
#include "../block.h"
#include "../calcerr.h"
#include "../conf.h"
#include "../endian_calc.h"
#include "../fposval.h"
#include "../hist.h"
#include "../prime.h"
#include "../zrand.h"
#include "../zrandom.h"
/*
* sys_info - names and values of selected #defines
*/
struct infoname {
char *name; /* name of #define converted to all UPPER_CASE */
char *meaning; /* brief explanation of the #define */
char *str; /* non-NULL ==> value of #define is a string */
FULL nmbr; /* if str==NULL ==> value fo #define as a FULL */
};
static struct infoname sys_info[] = {
{"A55", "slots in an additive 55 table", NULL, (FULL)A55},
{"BASE", "base for calculations", NULL, (FULL)BASE},
{"BASE1", "one less than base", NULL, (FULL)BASE},
{"BASEB", "bits in the calculation base", NULL, (FULL)BASEB},
{"BASEDIG", "number of digits in base", NULL, (FULL)BASEDIG},
{"BIG_ENDIAN", "Most Significant Byte first symbol", NULL, (FULL)BIG_ENDIAN},
{"BLK_CHUNKSIZE", "default allocation chunk size for blocks", NULL, (FULL)BLK_CHUNKSIZE},
{"BLK_DEF_MAXPRINT", "default block octets to print", NULL, (FULL)BLK_DEF_MAXPRINT},
{"BLUM_PREGEN", "non-default predefined Blum generators", NULL, (FULL)BLUM_PREGEN},
{"BOOL_B64", "if we have 64 bit type (TRUE or FALSE)", NULL, (FULL)BOOL_B64},
{"CALCEXT", "extension for files read in", CALCEXT, (FULL)0},
{"CALC_BYTE_ORDER", "Byte order (LITTLE_ENDIAN or BIG_ENDIAN)", NULL, (FULL)CALC_BYTE_ORDER},
{"CUSTOMHELPDIR", "location of the custom help directory", CUSTOMHELPDIR, (FULL)0},
{"DEFAULTCALCBINDINGS", "default key bindings file", DEFAULTCALCBINDINGS, (FULL)0},
{"DEFAULTCALCHELP", "help file that -h prints", DEFAULTCALCHELP, (FULL)0},
{"DEFAULTCALCPAGER", "default pager", DEFAULTCALCPAGER, (FULL)0},
{"DEFAULTCALCPATH", "default :-separated search path", DEFAULTCALCPATH, (FULL)0},
{"DEFAULTCALCRC", "default :-separated startup file list", DEFAULTCALCRC, (FULL)0},
{"DEFAULTSHELL", "default shell to use", DEFAULTSHELL, (FULL)0},
{"DEV_BITS", "device number size in bits", NULL, (FULL)DEV_BITS},
{"DISPLAY_DEFAULT", "default digits for float display", NULL, (FULL)DISPLAY_DEFAULT},
{"ECHO", "where the echo command is located", ECHO, (FULL)0},
{"EPSILONPREC_DEFAULT", "2^-EPSILON_DEFAULT <= EPSILON_DEFAULT", NULL, (FULL)EPSILONPREC_DEFAULT},
{"EPSILON_DEFAULT", "allowed error for float calculations", EPSILON_DEFAULT, (FULL)0},
{"ERRMAX", "default errmax value", NULL, (FULL)ERRMAX},
{"E_USERDEF", "base of user defined errors", NULL, (FULL)E_USERDEF},
{"E__BASE", "calc errors start above here", NULL, (FULL)E__BASE},
{"E__COUNT", "number of calc errors", NULL, (FULL)E__COUNT},
{"E__HIGHEST", "highest calc error", NULL, (FULL)E__HIGHEST},
{"FALSE", "boolean false", NULL, (FULL)FALSE},
{"FILEPOS_BITS", "file position size in bits", NULL, (FULL)FILEPOS_BITS},
{"FULL_BITS", "bits in a FULL", NULL, (FULL)FULL_BITS},
{"HELPDIR", "location of the help directory", HELPDIR, (FULL)0},
{"HIST_BINDING_FILE", "Default binding file", HIST_BINDING_FILE, (FULL)0},
{"HIST_SIZE", "Default history size", NULL, (FULL)HIST_SIZE},
{"INIT_J", "initial 1st walking a55 table index", NULL, (FULL)INIT_J},
{"INIT_K", "initial 2nd walking a55 table index", NULL, (FULL)INIT_K},
{"INODE_BITS", "inode number size in bits", NULL, (FULL)INODE_BITS},
{"LITTLE_ENDIAN", "Least Significant Byte first symbol", NULL, (FULL)LITTLE_ENDIAN},
{"LONGLONG_BITS", "length of a long long, or 0", NULL, (FULL)LONGLONG_BITS},
{"LONG_BITS", "bit length of a long", NULL, (FULL)LONG_BITS},
{"MAP_POPCNT", "number of odd primes in pr_map", NULL, (FULL)MAP_POPCNT},
{"MAXCMD", "max length of command invocation", NULL, (FULL)MAXCMD},
{"MAXDIM", "max number of dimensions in matrices", NULL, (FULL)MAXDIM},
{"MAXERROR", "max length of error message string", NULL, (FULL)MAXERROR},
{"MAXFILES", "max number of opened files", NULL, (FULL)MAXFILES},
{"MAXFULL", "largest SFULL value", NULL, (FULL)MAXFULL},
{"MAXHALF", "largest SHALF value", NULL, (FULL)MAXHALF},
{"MAXINDICES", "max number of indices for objects", NULL, (FULL)MAXINDICES},
{"MAXLABELS", "max number of user labels in function", NULL, (FULL)MAXLABELS},
{"MAXLEN", "longest storage size allowed", NULL, (FULL)MAXLEN},
{"MAXLONG", "largest long val", NULL, (FULL)MAXLONG},
{"MAXOBJECTS", "max number of object types", NULL, (FULL)MAXOBJECTS},
{"MAXPRINT_DEFAULT", "default number of elements printed", NULL, (FULL)MAXPRINT_DEFAULT},
{"MAXREDC", "number of entries in REDC cache", NULL, (FULL)MAXREDC},
{"MAXSCANCOUNT", "default max scan errors before an abort", NULL, (FULL)MAXSCANCOUNT},
{"MAXSTACK", "max depth of evaluation stack", NULL, (FULL)MAXSTACK},
{"MAXSTRING", "max size of string constant", NULL, (FULL)MAXSTRING},
{"MAXUFULL", "largest FULL value", NULL, (FULL)MAXUFULL},
{"MAXULONG", "largest unsigned long val", NULL, (FULL)MAXULONG},
{"MAX_MAP_PRIME", "larest prime in pr_map", NULL, (FULL)MAX_MAP_PRIME},
{"MAX_MAP_VAL", "larest bit in pr_map", NULL, (FULL)MAX_MAP_VAL},
{"MAX_PFACT_VAL", "max x, for which pfact(x) is a long", NULL, (FULL)MAX_PFACT_VAL},
{"MAX_SM_PRIME", "larest 32 bit prime", NULL, (FULL)MAX_SM_PRIME},
{"MAX_SM_VAL", "larest 32 bit value", NULL, (FULL)MAX_SM_VAL},
{"MUL_ALG2", "default size for alternative multiply", NULL, (FULL)MUL_ALG2},
{"NEW_EPSILONPREC_DEFAULT", "2^-EPSILON_DEFAULT <= EPSILON_DEFAULT", NULL, (FULL)NEW_EPSILONPREC_DEFAULT},
{"NEW_EPSILON_DEFAULT", "newstd EPSILON_DEFAULT", NEW_EPSILON_DEFAULT, (FULL)0},
{"NXT_MAP_PRIME", "smallest odd prime not in pr_map", NULL, (FULL)NXT_MAP_PRIME},
{"NXT_PFACT_VAL", "next prime for higher pfact values", NULL, (FULL)NXT_PFACT_VAL},
{"OFF_T_BITS", "file offset size in bits", NULL, (FULL)OFF_T_BITS},
{"PATHSIZE", "max length of path name", NULL, (FULL)PATHSIZE},
{"PATHSIZE", "max length of path name", NULL, (FULL)PATHSIZE},
{"PIX_32B", "max pix() value", NULL, (FULL)PIX_32B},
{"POW_ALG2", "default size for using REDC for powers", NULL, (FULL)POW_ALG2},
{"REDC_ALG2", "default size using alternative REDC alg", NULL, (FULL)REDC_ALG2},
{"SBITS", "size of additive or shuffle entry in bits", NULL, (FULL)SBITS},
{"SBYTES", "size of additive or shuffle entry in bytes", NULL, (FULL)SBYTES},
{"SCNT", "length of additive 55 table in FULLs", NULL, (FULL)SCNT},
{"SEEDXORBITS", "low bits of a55 seed devoted to xor", NULL, (FULL)SEEDXORBITS},
{"SHALFS", "size of additive or shuffle entry in HALFs", NULL, (FULL)SHALFS},
{"SHUFCNT", "size of shuffle table in entries", NULL, (FULL)SHUFCNT},
{"SHUFLEN", "length of shuffle table in FULLs", NULL, (FULL)SHUFLEN},
{"SHUFMASK", "mask for shuffle table entry selection", NULL, (FULL)SHUFMASK},
{"SHUFPOW", "power of 2 size of the shuffle table", NULL, (FULL)SHUFPOW},
{"SLEN", "number of FULLs in a shuffle table entry", NULL, (FULL)SLEN},
{"SQ_ALG2", "default size for alternative squaring", NULL, (FULL)SQ_ALG2},
{"SYMBOLSIZE", "max symbol name size", NULL, (FULL)SYMBOLSIZE},
{"TEN_MAX", "10^(2^TEN_MAX): largest base10 conversion const", NULL, (FULL)TEN_MAX},
{"TOPFULL", "highest bit in FULL", NULL, (FULL)TOPFULL},
{"TOPHALF", "highest bit in a HALF", NULL, (FULL)TOPHALF},
{"TOPLONG", "top long bit", NULL, (FULL)TOPLONG},
{"TRUE", "boolean true", NULL, (FULL)TRUE},
{"USUAL_ELEMENTS", "usual number of elements for objects", NULL, (FULL)USUAL_ELEMENTS},
/* must be last */
{NULL, NULL, NULL, (FULL)0}
};
/*
* forward declarations
*/
static void dump_name_meaning(void); /* custom("sysinfo", 0) */
static void dump_name_value(void); /* custom("sysinfo", 1) */
static void dump_mening_value(void); /* custom("sysinfo", 2) */
/*
* c_sysinfo - return a calc #define value
*
* given:
* vals[0] if given, name of #define to print
* otherwise a list of #defines are printed
*
* returns:
* value of #define if given (int or string)
* null if no #define arg was given
*/
/*ARGSUSED*/
VALUE
c_sysinfo(char *name, int count, VALUE **vals)
{
VALUE result; /* what we will return */
struct infoname *p; /* current infoname */
char *buf; /* upper case value of vals[0] */
char *q; /* to upper case converter */
char *r; /* to upper case converter */
/*
* we will return NULL if a value was not found
*/
result.v_type = V_NULL;
/*
* case 0: if no args, then dump the table with no values
*/
if (count == 0) {
/* dump the entire table */
dump_name_meaning();
/*
* case 1: numeric arg is given
*/
} else if (vals[0]->v_type == V_NUM) {
/* firewall - must be a tiny non-negative integer */
if (qisneg(vals[0]->v_num) ||
qisfrac(vals[0]->v_num) ||
zge31b(vals[0]->v_num->num)) {
math_error("sysinfo: arg must be string, 0, 1 or 2");
/*NOTREACHED*/
}
/*
* select action based on numeric value of arg
*/
switch (z1tol(vals[0]->v_num->num)) {
case 0: /* print all infonames and meanings */
dump_name_meaning();
break;
case 1: /* print all infonames and values */
dump_name_value();
break;
case 2: /* print all values and meanings */
dump_mening_value();
break;
default:
math_error("sysinfo: arg must be string, 0, 1 or 2");
/*NOTREACHED*/
}
/*
* case 2: string arg is given
*
* The string is taken to be the infoname we want to print.
*/
} else if (vals[0]->v_type == V_STR) {
/* convert vals[0] to upper case string */
buf = (char *)malloc(strlen((char *)vals[0]->v_str)+1);
for (q = (char *)vals[0]->v_str, r = buf; *q; ++q, ++r) {
if (isascii(*q) && islower(*q)) {
*r = *q - 'a' + 'A';
} else {
*r = *q;
}
}
*r = '\0';
/* search the table for the infoname */
for (p = sys_info; p->name != NULL; ++p) {
if (strcmp(p->name, buf) == 0) {
/* found the infoname */
if (p->str == NULL) {
/* return value as integer */
result.v_type = V_NUM;
result.v_num = utoq( p->nmbr);
} else {
/* return value as string */
result.v_type = V_STR;
result.v_subtype = V_NOSUBTYPE;
result.v_str = (STRING *)p->str;
}
/* return found infotype as value */
break;
}
}
/*
* bad arg given
*/
} else {
math_error("sysinfo: arg must be string, 0, 1 or 2");
/*NOTREACHED*/
}
/*
* return what we found or didn't find
*/
return result;
}
/*
* dump_name_meaning - print all infonames and meanings
*/
static void
dump_name_meaning(void)
{
struct infoname *p; /* current infoname */
/* dump the entire table */
for (p = sys_info; p->name != NULL; ++p) {
printf("%s%-23s\t%s\n",
(conf->tab_ok ? "\t" : ""), p->name, p->meaning);
}
}
/*
* dump_name_value - print all infonames and values
*/
static void
dump_name_value(void)
{
struct infoname *p; /* current infoname */
/* dump the entire table */
for (p = sys_info; p->name != NULL; ++p) {
if (p->str == NULL) {
#if LONG_BITS == FULL_BITS || FULL_BITS == 32 || !defined(HAVE_LONGLONG)
printf("%s%-23s\t%-8lu\t(0x%lx)\n",
(conf->tab_ok ? "\t" : ""), p->name,
(unsigned long)p->nmbr,
(unsigned long)p->nmbr);
#else
printf("%s%-23s\t%-8llu\t(0x%llx)\n",
(conf->tab_ok ? "\t" : ""), p->name,
(unsigned long long)p->nmbr,
(unsigned long long)p->nmbr);
#endif
} else {
printf("%s%-23s\t\"%s\"\n",
(conf->tab_ok ? "\t" : ""), p->name, p->str);
}
}
}
/*
* dump_mening_value - print all values and meanings
*/
static void
dump_mening_value(void)
{
struct infoname *p; /* current infoname */
/* dump the entire table */
for (p = sys_info; p->name != NULL; ++p) {
if (p->str == NULL) {
#if LONG_BITS == FULL_BITS || FULL_BITS == 32 || !defined(HAVE_LONGLONG)
printf("%s%-36.36s\t%-8lu\t(0x%lx)\n",
(conf->tab_ok ? "\t" : ""), p->meaning,
(unsigned long)p->nmbr,
(unsigned long)p->nmbr);
#else
printf("%s%-36.36s\t%-8llu\t(0x%llx)\n",
(conf->tab_ok ? "\t" : ""), p->meaning,
(unsigned long long)p->nmbr,
(unsigned long long)p->nmbr);
#endif
} else {
printf("%s%-36.36s\t\"%s\"\n",
(conf->tab_ok ? "\t" : ""), p->meaning, p->str);
}
}
}
#endif /* CUSTOM */

119
custom/custtbl.c Normal file
View File

@@ -0,0 +1,119 @@
/*
* Copyright (c) 1997 by Landon Curt Noll. All Rights Reserved.
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted,
* provided that the above copyright, this permission notice and text
* this comment, and the disclaimer below appear in all of the following:
*
* supporting documentation
* source copies
* source works derived from this source
* binaries derived from this source or from derived source
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*
* Comments, suggestions, bug fixes and questions about these routines
* are welcome. Send EMail to the address given below.
*
* Happy bit twiddling,
*
* Landon Curt Noll
*
* chongo@toad.com
* ...!{pyramid,sun,uunet}!hoptoad!chongo
*
* chongo was here /\../\
*/
#include "../have_const.h"
#include "../value.h"
#include "../custom.h"
/*
* NOTE: See the file CUSTOM for instructions on how to add
* custom functions.
*/
#if defined(CUSTOM)
/*
* add your forward custom function declaractions here
*
* Declare custom functions as follows:
*
* extern VALUE c_xyz(char*, int, VALUE**);
*
* We suggest that you sort the entries below by name.
*/
extern VALUE c_argv(char*, int, VALUE**);
extern VALUE c_devnull(char*, int, VALUE**);
extern VALUE c_help(char*, int, VALUE**);
extern VALUE c_sysinfo(char*, int, VALUE**);
#endif /* CUSTOM */
/*
* custom interface table
*
* The order of the elements in struct custom are:
*
* { "xyz", "brief description of the xyz custom function",
* minimum_args, maximum_args, c_xyz },
*
* where:
*
* minimum_args an int >= 0
* maximum_args an int >= minimum_args and <= MAX_CUSTOM_ARGS
*
* Use MAX_CUSTOM_ARGS for maximum_args is the maximum number of args
* is potentially 'unlimited'.
*
* If the brief description cannot fit on the same line as the name
* without wrapping on a 80 col window, the description is probably
* too long and will not look nice in the show custom output.
*/
CONST struct custom cust[] = {
#if defined(CUSTOM)
/*
* add your own custom functions here
*
* We suggest that you sort the entries below by name
* so that show custom will produce a nice sorted list.
*/
{ "argv", "information about its args, returns arg count",
0, MAX_CUSTOM_ARGS, c_argv },
{ "devnull", "does nothing",
0, MAX_CUSTOM_ARGS, c_devnull },
{ "help", "help for custom functions",
1, 1, c_help },
{ "sysinfo", "return a calc #define value",
0, 1, c_sysinfo },
#endif /* CUSTOM */
/*
* This must be at the end of this table!!!
*/
{NULL, NULL,
0, 0, NULL}
};

27
custom/devnull Normal file
View File

@@ -0,0 +1,27 @@
NAME
devnull - does nothing
SYNOPSIS
custom("devnull" [, arg ...])
TYPES
arg any
return null
DESCRIPTION
This custom function does nothing. It is intented for testing
of the general custom interface.
EXAMPLE
> custom("devnull", foo, bar, baz, 3+4.5i, pi())
LIMITS
calc must be built with ALLOW_CUSTOM= -DCUSTOM
calc must be executed with a -C arg.
LIBRARY
none
SEE ALSO
custom

53
custom/halflen.cal Normal file
View File

@@ -0,0 +1,53 @@
/*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted.
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*
* chongo was here /\../\ chongo@toad.com
*/
/*
* halflen - determine the length of numeric value in HALFs
*
* This file is part of the custom sample calc files.
*
* NOTE: You must use a calc that was compiled with ALLOW_CUSTOM= -DCUSTOM
* and run with a -C arg.
*/
define halflen(num)
{
local baseb = custom("sysinfo","BASEB"); /* bit len of a HALF */
/*
* firewall
*/
if (!isnum(num)) {
return newerror("halflen only works on numeric values");
}
/*
* determine the HALF length of a numeric value
*/
if (num == 0) {
/* consider 0 to be 1 HALF long */
return 1;
} else if (isint(num)) {
return (highbit(num)+baseb-1)/baseb;
} else if (isreal(num)) {
return halflen(num(num)) + halflen(den(num));
} else if (isnum(num)) {
return halflen(re(num)) + halflen(im(num));
} else {
return newerror("halflen only works on numeric values");
}
}
if (config("lib_debug") >= 0) {
print "halflen(num) defined";
}

28
custom/help Normal file
View File

@@ -0,0 +1,28 @@
NAME
help - help for custom functions
SYNOPSIS
custom("help", name)
TYPES
name string
return null
DESCRIPTION
This custom function will display the help for the builtin function
named by the name argument.
EXAMPLE
> custom("help", "custom_cal")
... output the same as is produced by help custhelp/custom_cal ...
LIMITS
calc must be built with ALLOW_CUSTOM= -DCUSTOM
calc must be executed with a -C arg.
LIBRARY
none
SEE ALSO
custom

54
custom/sysinfo Normal file
View File

@@ -0,0 +1,54 @@
NAME
sysinfo - return a calc #define value
SYNOPSIS
custom("sysinfo" [, infoname]);
TYPES
infoname string or int
return int, string or null
DESCRIPTION
This custom function will return the value certain selected #defile
values. The infoname arg must be a string that matches the given
#define name. For conveience, the case infoname does not matter,
so "baseb" and "BASEB" refer to the same #define value.
The return value is either an integer or a string depending on
the type of #define selected. If infoname is unknown, NULL is returned.
If no infoname is given then a list of infonames and meanings
are printed. In this case, null is returned.
If infoname is a number, then it is interpreted as follows:
0 print all infonames and meanings (same as no infoname)
1 print all infonames and values
2 print all infoname meanings and values
EXAMPLE
> custom("sysinfo", "baseb")
32
> custom("sysinfo")
... a list of infonames and meanings are printed ...
> custom("sysinfo", 0)
... a list of infonames and meanings are printed ...
> custom("sysinfo", 1)
... a list of infonames and values are printed ...
> custom("sysinfo", 2)
... a list of infoname meanings and values are printed ...
LIMITS
calc must be built with ALLOW_CUSTOM= -DCUSTOM
calc must be executed with a -C arg.
LIBRARY
none
SEE ALSO
custom

7
endian.c
View File

@@ -66,12 +66,13 @@ main(void)
/* Determine byte order */
if (intp[0] == 0x12364859) {
/* Most Significant Byte first */
printf("#define BYTE_ORDER\tBIG_ENDIAN\n");
printf("#define CALC_BYTE_ORDER\tBIG_ENDIAN\n");
} else if (intp[0] == 0x59483612) {
/* Least Significant Byte first */
printf("#define BYTE_ORDER\tLITTLE_ENDIAN\n");
printf("#define CALC_BYTE_ORDER\tLITTLE_ENDIAN\n");
} else {
fprintf(stderr, "Unknown int Byte Order, set BYTE_ORDER in Makefile\n");
fprintf(stderr,
"Unknown int Byte Order, set CALC_BYTE_ORDER in Makefile\n");
exit(1);
}
exit(0);

667
file.c
View File

File diff suppressed because it is too large Load Diff

13
file.h
View File

@@ -1,11 +1,16 @@
/*
* Copyright (c) 1996 David I. Bell
* Copyright (c) 1997 David I. Bell
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*
* File I/O routines callable by users.
*/
#if !defined(__FILE_H__)
#define __FILE_H__
#include "have_fpos.h"
@@ -56,5 +61,11 @@ typedef struct {
/*
* external functions
*/
extern FILEIO * findid(FILEID id, int mode);
extern int fgetposid(FILEID id, FILEPOS *ptr);
extern int fsetposid(FILEID id, FILEPOS *ptr);
extern int get_open_siz(FILE *fp, ZVALUE *res);
extern char* findfname(FILEID);
#endif /* !__FILE_H__ */

61
fposval.c
View File

@@ -14,8 +14,8 @@
*
* FILEPOS_BITS length in bits of the type FILEPOS
* SWAP_HALF_IN_FILEPOS will copy/swap FILEPOS into an HALF array
* STSIZE_BITS length in bits of the st_size stat element
* SWAP_HALF_IN_STSIZE will copy/swap st_size into an HALF array
* OFF_T_BITS length in bits of the st_size stat element
* SWAP_HALF_IN_OFF_T will copy/swap st_size into an HALF array
* DEV_BITS length in bits of the st_dev stat element
* SWAP_HALF_IN_DEV will copy/swap st_dev into an HALF array
* INODE_BITS length in bits of the st_ino stat element
@@ -55,6 +55,8 @@
#include <sys/stat.h>
#include "have_fpos.h"
#include "endian_calc.h"
#include "have_offscl.h"
#include "have_posscl.h"
char *program; /* our name */
@@ -78,7 +80,7 @@ main(int argc, char **argv)
fileposlen = sizeof(FILEPOS)*8;
printf("#undef FILEPOS_BITS\n");
printf("#define FILEPOS_BITS %d\n", fileposlen);
#if BYTE_ORDER == BIG_ENDIAN
#if CALC_BYTE_ORDER == BIG_ENDIAN
/*
* Big Endian
*/
@@ -93,49 +95,64 @@ main(int argc, char **argv)
program, fileposlen);
exit(1);
}
#else /* BYTE_ORDER == BIG_ENDIAN */
#else /* CALC_BYTE_ORDER == BIG_ENDIAN */
/*
* Little Endian
*
*/
#if defined(HAVE_FILEPOS_SCALAR)
printf("#define SWAP_HALF_IN_FILEPOS(dest, src)\t\t%s\n",
"(*(dest) = *(src))");
#else /* HAVE_FILEPOS_SCALAR */
/*
* Normally a "(*(dest) = *(src))" would do, but on some
* systems, a FILEPOS is not a scalar hince we must memcpy.
* systems a FILEPOS is not a scalar hince we must memcpy.
*/
printf("#define SWAP_HALF_IN_FILEPOS(dest, src)\t%s%d%s\n",
"memcpy((void *)(dest), (void *)(src), sizeof(",fileposlen,"))");
#endif /* BYTE_ORDER == BIG_ENDIAN */
#endif /* HAVE_FILEPOS_SCALAR */
#endif /* CALC_BYTE_ORDER == BIG_ENDIAN */
putchar('\n');
/*
* print the stat file size information
*/
stsizelen = sizeof(buf.st_size)*8;
printf("#undef STSIZE_BITS\n");
printf("#define STSIZE_BITS %d\n", stsizelen);
#if BYTE_ORDER == BIG_ENDIAN
printf("#undef OFF_T_BITS\n");
printf("#define OFF_T_BITS %d\n", stsizelen);
#if CALC_BYTE_ORDER == BIG_ENDIAN
/*
* Big Endian
*/
if (stsizelen == 64) {
printf("#define SWAP_HALF_IN_STSIZE(dest, src)\t\t%s\n",
printf("#define SWAP_HALF_IN_OFF_T(dest, src)\t\t%s\n",
"SWAP_HALF_IN_B64(dest, src)");
} else if (stsizelen == 32) {
printf("#define SWAP_HALF_IN_STSIZE(dest, src)\t\t%s\n",
printf("#define SWAP_HALF_IN_OFF_T(dest, src)\t\t%s\n",
"SWAP_HALF_IN_B32(dest, src)");
} else {
fprintf(stderr, "%s: unexpected st_size bit size: %d\n",
program, stsizelen);
exit(2);
}
#else /* BYTE_ORDER == BIG_ENDIAN */
#else /* CALC_BYTE_ORDER == BIG_ENDIAN */
/*
* Little Endian
*
* Normally a "(*(dest) = *(src))" would do, but on some
* systems, a STSIZE is not a scalar hince we must memcpy.
* systems an off_t is not a scalar hince we must memcpy.
*/
printf("#define SWAP_HALF_IN_STSIZE(dest, src)\t%s%d%s\n",
#if defined(HAVE_OFF_T_SCALAR)
printf("#define SWAP_HALF_IN_OFF_T(dest, src)\t\t%s\n",
"(*(dest) = *(src))");
#else /* HAVE_OFF_T_SCALAR */
/*
* Normally a "(*(dest) = *(src))" would do, but on some
* systems, a off_t is not a scalar hince we must memcpy.
*/
printf("#define SWAP_HALF_IN_OFF_T(dest, src)\t%s%d%s\n",
"memcpy((void *)(dest), (void *)(src), sizeof(",stsizelen,"))");
#endif /* BYTE_ORDER == BIG_ENDIAN */
#endif /* HAVE_OFF_T_SCALAR */
#endif /* CALC_BYTE_ORDER == BIG_ENDIAN */
putchar('\n');
/*
@@ -144,7 +161,7 @@ main(int argc, char **argv)
devlen = sizeof(buf.st_dev)*8;
printf("#undef DEV_BITS\n");
printf("#define DEV_BITS %d\n", devlen);
#if BYTE_ORDER == BIG_ENDIAN
#if CALC_BYTE_ORDER == BIG_ENDIAN
/*
* Big Endian
*/
@@ -162,7 +179,7 @@ main(int argc, char **argv)
program, devlen);
exit(3);
}
#else /* BYTE_ORDER == BIG_ENDIAN */
#else /* CALC_BYTE_ORDER == BIG_ENDIAN */
/*
* Little Endian
*
@@ -171,7 +188,7 @@ main(int argc, char **argv)
*/
printf("#define SWAP_HALF_IN_DEV(dest, src)\t%s%d%s\n",
"memcpy((void *)(dest), (void *)(src), sizeof(",devlen,"))");
#endif /* BYTE_ORDER == BIG_ENDIAN */
#endif /* CALC_BYTE_ORDER == BIG_ENDIAN */
putchar('\n');
/*
@@ -180,7 +197,7 @@ main(int argc, char **argv)
inodelen = sizeof(buf.st_ino)*8;
printf("#undef INODE_BITS\n");
printf("#define INODE_BITS %d\n", inodelen);
#if BYTE_ORDER == BIG_ENDIAN
#if CALC_BYTE_ORDER == BIG_ENDIAN
/*
* Big Endian
*/
@@ -198,7 +215,7 @@ main(int argc, char **argv)
program, inodelen);
exit(4);
}
#else /* BYTE_ORDER == BIG_ENDIAN */
#else /* CALC_BYTE_ORDER == BIG_ENDIAN */
/*
* Little Endian
*
@@ -207,6 +224,6 @@ main(int argc, char **argv)
*/
printf("#define SWAP_HALF_IN_INODE(dest, src)\t%s%d%s\n",
"memcpy((void *)(dest), (void *)(src), sizeof(",inodelen,"))");
#endif /* BYTE_ORDER == BIG_ENDIAN */
#endif /* CALC_BYTE_ORDER == BIG_ENDIAN */
exit(0);
}

3864
func.c
View File

File diff suppressed because it is too large Load Diff

15
func.h
View File

@@ -1,12 +1,13 @@
/*
* Copyright (c) 1993 David I. Bell
* Copyright (c) 1997 David I. Bell
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*/
#ifndef FUNC_H
#define FUNC_H
#if !defined(__FUNC_H__)
#define __FUNC_H__
#include "calc.h"
#include "label.h"
@@ -53,6 +54,9 @@ extern FUNC *findfunc(long index);
extern char *namefunc(long index);
extern BOOL evaluate(BOOL nestflag);
extern long adduserfunc(char *name);
extern void rmuserfunc(char *name);
extern void rmalluserfunc(void);
extern long getuserfunc(char *name);
extern void beginfunc(char *name, BOOL newflag);
extern int builtinopcode(long index);
extern char *builtinname(long index);
@@ -74,7 +78,8 @@ extern void clearopt(void);
extern void updateoldvalue(FUNC *fp);
extern void calculate(FUNC *fp, int argcount);
extern VALUE builtinfunc(long index, int argcount, VALUE *stck);
extern void freenumbers(FUNC *);
extern void freefunc(FUNC *);
#endif
/* END CODE */
#endif /* !__FUNC_H__ */

973
hash.c
View File

File diff suppressed because it is too large Load Diff

110
hash.h
View File

@@ -1,6 +1,5 @@
/* XXX - this code is currently not really used, but it will be soon */
/*
* Copyright (c) 1995 by Landon Curt Noll. All Rights Reserved.
* Copyright (c) 1997 by Landon Curt Noll. All Rights Reserved.
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted,
@@ -21,30 +20,107 @@
* PERFORMANCE OF THIS SOFTWARE.
*/
#if !defined(HASH_H)
#define HASH_H
#if !defined(__HASH_H__)
#define __HASH_H__
#include "shs.h"
#include "shs1.h"
#include "md5.h"
#include "zmath.h"
/* MAX_CHUNKSIZE is the largest chunksize of any hash */
#define MAX_CHUNKSIZE (SHS1_CHUNKSIZE)
/* max size of debugging strings in xyz_print() functions */
#define DEBUG_SIZE 127
/*
* hashstate - state of a hash system
*
* Hashing some types of values requires a checkpoint (chkpt function call)
* to be performed, which pads buffered data with 0's and performs an
* update. The checkpoint thus causes the value to start on a new hash
* block boundary with no buffered data.
*
* Some data types (strings, BLOCKs and OCTETs) do not require a
* checkpoint as long as the previous value hashed was a string,
* BLOCK or OCTET.
*/
struct hashstate {
int type; /* hash type (see XYZ_HASH_TYPE below) */
BOOL prevstr; /* TRUE=>previous value hashed was a string */
union {
SHS_INFO hh_shs; /* old Secure Hash Standard */
} h_union;
};
typedef struct hashstate HASH;
/* For ease in referencing */
#define h_shs h_union.hh_shs
struct hashstate {
int hashtype; /* XYZ_HASH_TYPE debug value */
BOOL bytes; /* TRUE => reading bytes rather than words */
void (*update)(HASH*, USB8*, USB32); /* update arbitrary length */
void (*chkpt)(HASH*); /* checkpoint a state */
void (*note)(int, HASH*); /* note a special value */
void (*type)(int, HASH*); /* note a VALUE type */
ZVALUE (*final)(HASH*); /* complete hash state */
int (*cmp)(HASH*,HASH*); /* compare to states, TRUE => a!=b */
void (*print)(HASH*); /* print the value of a hash */
int base; /* XYZ_BASE special hash value */
int chunksize; /* XYZ_CHUNKSIZE input chunk size */
int unionsize; /* h_union element size */
union { /* hash dependent states */
USB8 data[1]; /* used by hash_value to hash below */
SHS_INFO h_shs; /* old SHS/SHA internal state */
SHS1_INFO h_shs1; /* new SHS-1/SHA-1 internal state */
MD5_CTX h_md5; /* MD5 internal state */
} h_union;
};
/*
* what to xor to digest value when hashing special values
*
* IMPORTANT: To avoid overlap due to the HASH_XYZ macros below, the
* XYZ_BASE values should be unique random hex values
* that end in 00 (i.e., 0 mod 256).
*/
#define SHS_BASE 0x12face00 /* old SHS / SHA */
#define SHS1_BASE 0x23cafe00 /* new SHS-1 / SHA-1 */
#define MD5_BASE 0x34feed00 /* MD5 */
/*
* XYZ_HASH_TYPE - hash types
*
* we support these hash types - must start with 0
* we support these hash types
*/
#define SHS_HASH_TYPE 0
#define HASH_TYPE_MAX 0 /* must be number of XYZ_HASH_TYPE values */
#define SHS_HASH_TYPE 1
#define SHS1_HASH_TYPE 2
#define MD5_HASH_TYPE 3
#endif /* !HASH_H */
/*
* Note a special value given the base value
*/
#define HASH_NEG(base) (1+base) /* note a negative value */
#define HASH_COMPLEX(base) (2+base) /* note a complex value */
#define HASH_DIV(base) (4+base) /* note a division by a value */
#define HASH_ZERO(base) (8+base) /* note a zero numeric value */
#define HASH_ZVALUE(base) (16+base) /* note a ZVALUE */
/*
* external functions
*/
extern HASH* hash_init(int, HASH*);
extern void hash_free(HASH*);
extern HASH* hash_copy(HASH*);
extern int hash_cmp(HASH*, HASH*);
extern void hash_print(HASH*);
extern ZVALUE hash_final(HASH*);
extern HASH* hash_long(int, long, HASH*);
extern HASH* hash_zvalue(int, ZVALUE, HASH*);
extern HASH* hash_number(int, void*, HASH*);
extern HASH* hash_complex(int, void*, HASH*);
extern HASH* hash_str(int, char*, HASH*);
extern HASH* hash_usb8(int, USB8*, int, HASH*);
extern HASH* hash_value(int, void*, HASH*);
#endif /* !__HASH_H__ */

2
have_const.c
View File

@@ -40,6 +40,8 @@
* chongo was here /\../\
*/
#include <stdio.h>
MAIN
main(void)
{

58
have_memmv.c Normal file
View File

@@ -0,0 +1,58 @@
/*
* have_memmv - Determine if we memmove()
*
* usage:
* have_newstr
*
* Not all systems with memcpy() have memmove() functions, so this may not
* compile on your system.
*
* This prog outputs several defines:
*
* HAVE_MEMMOVE
* defined ==> use memmove()
* undefined ==> use internal slow memmove() instead
*/
/*
* Copyright (c) 1997 by Landon Curt Noll. All Rights Reserved.
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted,
* provided that the above copyright, this permission notice and text
* this comment, and the disclaimer below appear in all of the following:
*
* supporting documentation
* source copies
* source works derived from this source
* binaries derived from this source or from derived source
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*
* chongo was here /\../\
*/
#include <stdio.h>
#define MOVELEN 3
char src[] = "chongo was here";
char dest[MOVELEN+1];
MAIN
main(void)
{
#if defined(HAVE_NO_MEMMOVE)
printf("#undef HAVE_MEMMOVE /* no */\n");
#else /* HAVE_NO_MEMMOVE */
(void) memmove(dest, src, MOVELEN);
printf("#define HAVE_MEMMOVE /* yes */\n");
#endif /* HAVE_NO_MEMMOVE */
exit(0);
}

2
have_newstr.c
View File

@@ -39,6 +39,8 @@
* chongo was here /\../\
*/
#include <stdio.h>
#define MOVELEN 3
char src[] = "chongo was here";

83
have_offscl.c Normal file
View File

@@ -0,0 +1,83 @@
/*
* have_offscl - determine if have a scalar off_t element
*
* usage:
* have_offscl
*
* On some systems, off_t is a scalar value on which one can perform
* arithmetic operations, assignments and comparisons. On some systems
* off_t is some sort of union or struct which must be converted into
* a ZVALUE in order to perform arithmetic operations, assignments and
* comparisons.
*
*
* This prog outputs several defines:
*
* HAVE_OFF_T_SCALAR
* defined ==> ok to perform arithmetic ops, = and comparisons
* undefined ==> convert to ZVALUE first
*/
/*
* Copyright (c) 1996 by Landon Curt Noll. All Rights Reserved.
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted,
* provided that the above copyright, this permission notice and text
* this comment, and the disclaimer below appear in all of the following:
*
* supporting documentation
* source copies
* source works derived from this source
* binaries derived from this source or from derived source
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*
* chongo was here /\../\
*/
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
MAIN
main(void)
{
#if !defined(OFF_T_NON_SCALAR)
off_t value; /* an off_t to perform arithmatic on */
off_t value2; /* an off_t to perform arithmatic on */
/*
* do some math opts on an off_t
*/
value = (off_t)getpid();
value2 = (off_t)-1;
if (value > (off_t)1) {
--value;
}
if (value <= (off_t)getppid()) {
--value;
}
if (value == value2) {
value += value2;
}
value <<= 1;
if (!value) {
printf("/* something for the off_t to do */\n");
}
/*
* report off_t as a scalar
*/
printf("#undef HAVE_OFF_T_SCALAR\n");
printf("#define HAVE_OFF_T_SCALAR /* off_t is a simple value */\n");
#else
printf("#undef HAVE_OFF_T_SCALAR /* off_t is not a simple value */\n");
#endif
exit(0);
}

84
have_posscl.c Normal file
View File

@@ -0,0 +1,84 @@
/*
* have_posscl - determine if have a scalar FILEPOS element
*
* usage:
* have_posscl
*
* On some systems, FILEPOS is a scalar value on which one can perform
* arithmetic operations, assignments and comparisons. On some systems
* FILEPOS is some sort of union or struct which must be converted into
* a ZVALUE in order to perform arithmetic operations, assignments and
* comparisons.
*
*
* This prog outputs several defines:
*
* HAVE_FILEPOS_SCALAR
* defined ==> ok to perform arithmetic ops, = and comparisons
* undefined ==> convert to ZVALUE first
*/
/*
* Copyright (c) 1996 by Landon Curt Noll. All Rights Reserved.
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby granted,
* provided that the above copyright, this permission notice and text
* this comment, and the disclaimer below appear in all of the following:
*
* supporting documentation
* source copies
* source works derived from this source
* binaries derived from this source or from derived source
*
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*
* chongo was here /\../\
*/
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
#include "have_fpos.h"
MAIN
main(void)
{
#if !defined(FILEPOS_NON_SCALAR)
FILEPOS value; /* an FILEPOS to perform arithmatic on */
FILEPOS value2; /* an FILEPOS to perform arithmatic on */
/*
* do some math opts on an FILEPOS
*/
value = (FILEPOS)getpid();
value2 = (FILEPOS)-1;
if (value > (FILEPOS)1) {
--value;
}
if (value <= (FILEPOS)getppid()) {
--value;
}
if (value == value2) {
value += value2;
}
value <<= 1;
if (!value) {
printf("/* something for the FILEPOS to do */\n");
}
/*
* report FILEPOS as a scalar
*/
printf("#undef HAVE_FILEPOS_SCALAR\n");
printf("#define HAVE_FILEPOS_SCALAR /* FILEPOS is a simple value */\n");
#else
printf("#undef HAVE_FILEPOS_SCALAR /* FILEPOS is not a simple value */\n");
#endif
exit(0);
}

2
have_uid_t.c
View File

@@ -36,6 +36,8 @@
* chongo was here /\../\
*/
#include <stdio.h>
#if !defined(HAVE_NO_UID_T)
#include "have_unistd.h"
#if defined(HAVE_UNISTD_H)

133
help.c Normal file
View File

@@ -0,0 +1,133 @@
/*
* Copyright (c) 1997 David I. Bell
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*
* Arbitrary precision calculator.
*/
#include <stdio.h>
#include <ctype.h>
#include "calc.h"
#include "conf.h"
#include "have_unistd.h"
#if defined(HAVE_UNISTD_H)
#include <unistd.h>
#endif
/*
* some help topics are symbols, so we alias them to nice filenames
*/
static struct help_alias {
char *topic;
char *filename;
} halias[] = {
{"=", "address"},
{"->", "arrow"},
{"=", "assign"},
{"*", "dereference"},
{".", "oldvalue"},
{"%", "mod"},
{"//", "quo"},
{NULL, NULL}
};
/*
* external values
*/
extern char *pager; /* $PAGER or default */
/*
* givehelp - display a help file
*
* given:
* type the type of help to give, NULL => index
*/
void
givehelp(char *type)
{
struct help_alias *p; /* help alias being considered */
char *helpcmd; /* what to execute to print help */
char *c;
/*
* check permissions to see if we are allowed to help
*/
if (!allow_exec || !allow_read) {
fprintf(stderr,
"sorry, help is only allowed with -m mode 5 or 7\n");
return;
}
/* catch the case where we just print the index */
if (type == NULL) {
type = DEFAULTCALCHELP; /* the help index file */
}
/* alias the type of help, if needed */
for (p=halias; p->topic; ++p) {
if (strcmp(type, p->topic) == 0) {
type = p->filename;
break;
}
}
/*
* sanity check on name
*/
/* look for /. or a leading . */
if (strstr(type, "/.") != NULL || type[0] == '.') {
fprintf(stderr, "bad help name\n");
return;
}
/* look for chars that could be shell meta chars */
for (c = type; *c; ++c) {
switch ((int)*c) {
case '+':
case ',':
case '-':
case '.':
case '/':
case '_':
break;
default:
if (!isascii((int)*c) || !isalnum((int)*c)) {
fprintf(stderr, "bogus char in help name\n");
return;
}
break;
}
}
/* form the help command name */
helpcmd = (char *)malloc(
sizeof("if [ ! -r \"")+sizeof(HELPDIR)+1+strlen(type)+
sizeof("\" ];then ")+
strlen(pager)+1+1+sizeof(HELPDIR)+1+strlen(type)+1+1+
sizeof("elif [ ! -r \"")+sizeof(CUSTOMHELPDIR)+1+strlen(type)+
sizeof("\" ];then ")+
strlen(pager)+1+1+sizeof(CUSTOMHELPDIR)+1+strlen(type)+1+1+
sizeof(";else ")+sizeof(ECHO)+
sizeof("echo no such help, try: help help;fi")+1);
sprintf(helpcmd,
"if [ -r \"%s/%s\" ];then %s \"%s/%s\";"
"elif [ -r \"%s/%s\" ];then %s \"%s/%s\";"
"else %s no such help, try: help help;fi",
HELPDIR, type, pager, HELPDIR, type,
CUSTOMHELPDIR, type, pager, CUSTOMHELPDIR, type, ECHO);
if (conf->calc_debug > 0) {
printf("%s\n", helpcmd);
sleep(3);
}
/* execute the help command */
system(helpcmd);
free(helpcmd);
}

239
help/Makefile
View File

@@ -43,47 +43,96 @@ FMT= fmt
CMP= cmp
CAT= cat
# Standard help files
# Standard and Builtin help files
#
# The obj.file is special and is not listed here.
#
STD_HELP_FILES1= intro overview help command config \
define environment expression file history interrupt mat
STD_HELP_FILES2= operator statement types usage variable
STD_HELP_FILES3= todo credit
STD_HELP_FILES= ${STD_HELP_FILES1} ${STD_HELP_FILES2} ${STD_HELP_FILES3}
SYMBOL_HELP= assign
STD_HELP_FILES_1= intro overview help
STD_HELP_FILES_2= assoc
# These two lists are prodiced by the detaillist and missinglist rules
# when no WARNINGS are detected.
BLT_HELP_FILES_3= builtin
STD_HELP_FILES_4= command config custom define environment expression
BLT_HELP_FILES_5= errorcodes
STD_HELP_FILES_6= file history interrupt list mat
# beacuse obj is built special (due to confusion with it as
# a symlink for some built environments, we treat obj specially
# and call it obj.file
#
DETAIL_HELP= abs access acos acosh acot acoth acsc acsch append appr archive \
arg asec asech asin asinh assoc atan atan2 atanh avg base bround \
btrunc ceil cfappr cfsim char cmdbuf cmp comb conj cos cosh cot coth \
count cp csc csch ctime delete den det digit digits dp epsilon errno \
SPECIAL_HELP_7= obj.file
STD_HELP_FILES_8= operator statement
BLT_HELP_FILES_9= stdlib
STD_HELP_FILES_10= types usage unexpected variable
BLT_HELP_FILES_11= altbind bindings custom_cal libcalc new_custom stdlib
STD_HELP_FILES_12= archive
BLT_HELP_FILES_13= bugs changes
STD_HELP_FILES_14= contrib credit todo
# These files are used in the following order to construct full
#
FULL_HELP_FILES= ${STD_HELP_FILES_1} ${STD_HELP_FILES_2} \
${BLT_HELP_FILES_3} ${STD_HELP_FILES_4} \
${BLT_HELP_FILES_5} ${STD_HELP_FILES_6} \
${SPECIAL_HELP_7} ${STD_HELP_FILES_8} \
${BLT_HELP_FILES_9} ${STD_HELP_FILES_10} \
${BLT_HELP_FILES_11} ${STD_HELP_FILES_12} \
${BLT_HELP_FILES_13} ${STD_HELP_FILES_14}
# These full files are those who are not built or constrcuted
#
STD_HELP_FILES= ${STD_HELP_FILES_1} ${STD_HELP_FILES_2} \
${STD_HELP_FILES_4} ${STD_HELP_FILES_6} \
${STD_HELP_FILES_8} ${STD_HELP_FILES_10} \
${STD_HELP_FILES_12} ${STD_HELP_FILES_14}
# These full files are those who are built by this Makefile
#
# Note that ${SPECIAL_HELP_7} is not included in this list
# because of problems with its name.
#
BLT_HELP_FILES= ${BLT_HELP_FILES_3} ${BLT_HELP_FILES_5} \
${BLT_HELP_FILES_9} \
${BLT_HELP_FILES_11} ${BLT_HELP_FILES_13}
# This list is prodiced by the detaillist rule when no WARNINGS are detected.
#
DETAIL_HELP= abs access acos acosh acot acoth acsc acsch address agd append \
appr arg arrow asec asech asin asinh assign atan atan2 atanh avg base \
bit blk blkcpy blkfree blocks bround btrunc ceil cfappr cfsim char \
cmdbuf cmp comb conj cos cosh cot coth count cp csc csch ctime delete \
den dereference det digit digits dp epsilon errcount errmax errno \
error eval exp fact factor fclose fcnt feof ferror fflush fgetc \
fgetfield fgetline fgets fgetstr fib files floor fopen forall fprintf \
fputc fputs fputstr frac frem freopen fscan fscanf fseek fsize ftell \
gcd gcdrem getenv hash head highbit hmean hypot ilog ilog10 ilog2 im \
insert int inverse iroot isassoc isatty isconfig iserror iseven \
isfile ishash isident isint islist ismat ismult isnull isnum isobj \
isodd isprime isqrt isrand israndom isreal isrel isset issimple issq \
isstr istype jacobi join lcm lcmfact lfactor list ln lowbit ltol \
makelist matdim matfill matmax matmin matsum mattrans max meq min \
minv mmin mne mod modify near newerror nextcand nextprime norm null \
num ord param perm pfact pi pix places pmod polar poly pop power \
prevcand prevprime printf prompt ptest push putenv quo quomod rand \
randbit randperm rcin rcmul rcout rcpow rcsq re rm remove reverse \
rewind root round rsearch runtime scale scan scanf search sec sech \
segment select sgn sin sinh size sizeof sort sqrt srand ssq str \
strcat strerror strlen strpos strprintf strscan strscanf substr swap \
system tail tan tanh time trunc xor
fputc fputs fputstr frac free freeglobals freeredc freestatics frem \
freopen fscan fscanf fseek fsize ftell gcd gcdrem gd getenv hash head \
highbit hmean hnrmod hypot ilog ilog10 ilog2 im insert int inverse \
iroot isassoc isatty isblk isconfig isdefined iserror iseven isfile \
ishash isident isint islist ismat ismult isnull isnum isobj isobjtype \
isodd isprime isptr isqrt isrand israndom isreal isrel issimple issq \
isstr istype jacobi join lcm lcmfact lfactor ln lowbit ltol makelist \
matdim matfill matmax matmin matsum mattrace mattrans max md5 memsize \
meq min minv mmin mne mod modify name near newerror nextcand \
nextprime norm null num oldvalue ord param perm pfact pi pix places \
pmod polar poly pop popcnt power prevcand prevprime printf prompt \
protect ptest push putenv quo quomod rand randbit random randombit \
randperm rcin rcmul rcout rcpow rcsq re remove reverse rewind rm root \
round rsearch runtime saveval scale scan scanf search sec sech \
segment select sgn sha sha1 sin sinh size sizeof sort sqrt srand \
srandom ssq str strcat strerror strlen strpos strprintf strscan \
strscanf substr sum swap system tail tan tanh test time trunc xor
# Help files that are constructed from other sources
# This list is of files that are clones of DETAIL_HELP files. They are
# built from DETAIL_HELP files.
#
# The obj.file is special and is not listed here.
#
BUILT_HELP_FILES= bindings altbind changes libcalc stdlib bugs errorcodes
DETAIL_CLONE= copy
# Singular files
#
@@ -94,12 +143,12 @@ SINGULAR_FILES= binding bug change errorcode type
# These files are found (but not built) in the distribution
#
DISTLIST= ${STD_HELP_FILES} ${DETAIL_HELP} ${SYMBOL_HELP} ${MAKE_FILE} \
DISTLIST= ${STD_HELP_FILES} ${DETAIL_HELP} ${MAKE_FILE} \
obj.file builtin.top builtin.end funclist.sed \
errorcodes.hdr errorcodes.sed
all: ${STD_HELP_FILES} obj.file ${BUILT_HELP_FILES} full \
${DETAIL_HELP} ${SINGULAR_FILES} builtin .all
all: ${FULL_HELP_FILES} full ${DETAIL_HELP} ${DETAIL_CLONE} \
${SINGULAR_FILES} calc .all
# used by the upper level Makefile to determine of we have done all
#
@@ -111,9 +160,9 @@ all: ${STD_HELP_FILES} obj.file ${BUILT_HELP_FILES} full \
touch .all
bindings: ../lib/bindings
rm -f bindings
cp ../lib/bindings bindings
chmod 0444 bindings
rm -f $@
cp ../lib/bindings $@
chmod 0444 $@
-@if [ -z "${Q}" ]; then \
echo ''; \
echo '=-=-= skipping the cat of help/$@ =-=-='; \
@@ -123,9 +172,9 @@ bindings: ../lib/bindings
fi
altbind: ../lib/altbind
rm -f altbind
cp ../lib/altbind altbind
chmod 0444 altbind
rm -f $@
cp ../lib/altbind $@
chmod 0444 $@
-@if [ -z "${Q}" ]; then \
echo ''; \
echo '=-=-= skipping the cat of help/$@ =-=-='; \
@@ -135,9 +184,9 @@ altbind: ../lib/altbind
fi
stdlib: ../lib/README
rm -f stdlib
cp ../lib/README stdlib
chmod 0444 stdlib
rm -f $@
cp ../lib/README $@
chmod 0444 $@
-@if [ -z "${Q}" ]; then \
echo ''; \
echo '=-=-= skipping the cat of help/$@ =-=-='; \
@@ -147,9 +196,9 @@ stdlib: ../lib/README
fi
changes: ../CHANGES
rm -f changes
cp ../CHANGES changes
chmod 0444 changes
rm -f $@
cp ../CHANGES $@
chmod 0444 $@
-@if [ -z "${Q}" ]; then \
echo ''; \
echo '=-=-= skipping the cat of help/$@ =-=-='; \
@@ -159,9 +208,9 @@ changes: ../CHANGES
fi
libcalc: ../LIBRARY
rm -f libcalc
${SED} -e 's:$${LIBDIR}:${LIBDIR}:g' < ../LIBRARY > libcalc
chmod 0444 libcalc
rm -f $@
${SED} -e 's:$${LIBDIR}:${LIBDIR}:g' < ../LIBRARY > $@
chmod 0444 $@
-@if [ -z "${Q}" ]; then \
echo ''; \
echo '=-=-= skipping the cat of help/$@ =-=-='; \
@@ -171,9 +220,9 @@ libcalc: ../LIBRARY
fi
bugs: ../BUGS
rm -f bugs
cp ../BUGS bugs
chmod 0444 bugs
rm -f $@
cp ../BUGS $@
chmod 0444 $@
-@if [ -z "${Q}" ]; then \
echo ''; \
echo '=-=-= skipping the cat of help/$@ =-=-='; \
@@ -183,10 +232,10 @@ bugs: ../BUGS
fi
errorcodes: ../calcerr.h errorcodes.hdr errorcodes.sed
rm -f errorcodes
${CAT} errorcodes.hdr > errorcodes
${SED} -n -f errorcodes.sed < ../calcerr.h >> errorcodes
chmod 0444 errorcodes
rm -f $@
${CAT} errorcodes.hdr > $@
${SED} -n -f errorcodes.sed < ../calcerr.h >> $@
chmod 0444 $@
-@if [ -z "${Q}" ]; then \
echo ''; \
echo '=-=-= skipping the cat of help/$@ =-=-='; \
@@ -195,11 +244,58 @@ errorcodes: ../calcerr.h errorcodes.hdr errorcodes.sed
true; \
fi
full: ${STD_HELP_FILES} ${BUILT_HELP_FILES} ${MAKE_FILE}
calc: usage
rm -f $@
cp usage $@
chmod 0444 $@
-@if [ -z "${Q}" ]; then \
echo ''; \
echo '=-=-= skipping the cat of help/$@ =-=-='; \
echo ''; \
else \
true; \
fi
custom_cal: ../custom/CUSTOM_CAL
rm -f $@
cp usage $@
chmod 0444 $@
-@if [ -z "${Q}" ]; then \
echo ''; \
echo '=-=-= skipping the cat of help/$@ =-=-='; \
echo ''; \
else \
true; \
fi
new_custom: ../custom/HOW_TO_ADD
rm -f $@
cp usage $@
chmod 0444 $@
-@if [ -z "${Q}" ]; then \
echo ''; \
echo '=-=-= skipping the cat of help/$@ =-=-='; \
echo ''; \
else \
true; \
fi
copy: blkcpy
rm -f $@
cp usage $@
chmod 0444 $@
-@if [ -z "${Q}" ]; then \
echo ''; \
echo '=-=-= skipping the cat of help/$@ =-=-='; \
echo ''; \
else \
true; \
fi
full: ${FULL_HELP_FILES} ${MAKE_FILE}
${Q}echo "forming full"
-${Q}rm -f full
-${Q}for i in ${STD_HELP_FILES1} obj.file ${STD_HELP_FILES2} \
${BUILT_HELP_FILES} ${STD_HELP_FILES3}; do \
-${Q}rm -f $@
-${Q}for i in ${FULL_HELP_FILES}; do \
if [ Xintro != X"$$i" ]; then \
echo " "; \
else \
@@ -215,7 +311,7 @@ full: ${STD_HELP_FILES} ${BUILT_HELP_FILES} ${MAKE_FILE}
echo "*************"; \
echo ""; \
cat $$i; \
done > full
done > $@
${Q}echo "full formed"
-@if [ -z "${Q}" ]; then \
echo ''; \
@@ -302,8 +398,8 @@ distlist: ${DISTLIST}
# The bsdi distribution has generated files as well as distributed files.
#
bsdilist: ${DISTLIST} ${BUILT_HELP_FILES}
${Q}for i in ${DISTLIST} ${BUILT_HELP_FILES}; do \
bsdilist: ${DISTLIST} ${BLT_HELP_FILES}
${Q}for i in ${DISTLIST} ${BLT_HELP_FILES}; do \
echo calc/help/$$i; \
done | ${SORT}
@@ -333,8 +429,9 @@ clean:
rm -f obj mkbuiltin funclist.c funclist.o funclist
clobber:
rm -f ${BUILT_HELP_FILES} full builtin .all
rm -f obj mkbuiltin funclist.c funclist.o funclist ${SINGULAR_FILES}
rm -f ${BLT_HELP_FILES} full .all calc
rm -f obj mkbuiltin funclist.c funclist.o funclist
rm -f ${SINGULAR_FILES} ${DETAIL_CLONE}
install: all
-${Q}if [ ! -d ${TOPDIR} ]; then \
@@ -355,8 +452,8 @@ install: all
else \
true; \
fi
${Q}for i in ${STD_HELP_FILES} ${BUILT_HELP_FILES} builtin \
full ${DETAIL_HELP} ${SINGULAR_FILES} ${SYMBOL_HELP}; do \
${Q}for i in ${STD_HELP_FILES} ${BLT_HELP_FILES} builtin \
full ${DETAIL_HELP} ${SINGULAR_FILES}; do \
echo rm -f ${HELPDIR}/$$i; \
rm -f ${HELPDIR}/$$i; \
echo cp $$i ${HELPDIR}; \
@@ -367,3 +464,5 @@ install: all
rm -f ${HELPDIR}/obj
cp obj.file ${HELPDIR}/obj
chmod 0444 ${HELPDIR}/obj
# remove dead files
-@rm -f rmblk block

16
help/abs
View File

@@ -15,14 +15,18 @@ TYPES
eps ignored if x is real, nonzero real for complex x,
defaults to epsilon().
return real
return non-negative real
DESCRIPTION
If x is real, returns x if x is positive or zero, -x if x is negative.
If x is real, returns the absolute value of x, i.e. x if x >= 0,
-x if x < 0.
For complex x, returns the multiple of eps nearest or next to nearest
to the absolute value of x. The result usually has error less in
absolute value than abs(eps), but should not exceed 0.75 * abs(eps).
For complex x with zero real part, returns the absolute value of im(x).
For other complex x, returns the multiple of eps nearest to the absolute
value of x, or in the case of two equally near nearest values, the
the nearest even multiple of eps. In particular, with eps = 10^-n,
the result will be the absolute value correct to n decimal places.
EXAMPLE
> print abs(3.4), abs(-3.4)
@@ -35,7 +39,7 @@ LIMITS
none
LIBRARY
none
NUMBER *qqabs(NUMBER *x)
SEE ALSO
cmp, epsilon, hypot, norm, near, obj

27
help/access
View File

@@ -20,27 +20,30 @@ DESCRIPTION
'w' or bit 1 for writing, 'x' or bit 0 for execution.
EXAMPLE
The system error-numbers and messages may differ for different
implementations
> !rm -f junk
> access("junk")
Error 10002 XXX This number will probably be changed
System error 2
> strerror(.)
"No such file or directory"
> f = fopen("junk", "w")
> access("junk")
> fputs(f, "Now is the time");
> freopen(f, "r");
> fputs(f, "Alpha")
> fclose(f)
> !chmod u-w junk
> fgets(f)
"Now is the time"
> access("junk", "w")
Error 10013 XXX
> freopen(f, "w")
Error 10013 XXX
System error 13
> strerror(.)
"Permission denied"
LIMITS
none - XXX - is this correct?
There may be implementation-dependent limits inherited from the
system call "access" used by this function.
LIBRARY
none - XXX - is this correct?
none
SEE ALSO
errno, fclose, feof, ferror, fflush, fgetc, fgetline, fgets, files, fopen,
fprintf, fputc, fputs, fseek, fsize, ftell, isfile, printf, prompt
fopen, fclose, isfile, files

4
help/acos
View File

@@ -21,9 +21,7 @@ EXAMPLE
1.0472 1.0471975512 1.047197551196598 1.04719755119659774615
LIMITS
unlike sin and cos, x must be real
abs(x) <= 1
eps > 0
none
LIBRARY
NUMBER *qacos(NUMBER *x, NUMBER *eps)

11
help/acosh
View File

@@ -11,19 +11,20 @@ TYPES
return nonnegative real
DESCRIPTION
Returns the cosh of x to a multiple of eps with error less in
Returns the acosh of x to a multiple of eps with error less in
absolute value than .75 * eps.
acosh(x) = ln(x + sqrt(x^2 - 1)) is the nonnegative real number v
for which cosh(v) = x.
acosh(x) is the nonnegative real number v for which cosh(v) = x.
It is given by
acosh(x) = ln(x + sqrt(x^2 - 1))
EXAMPLE
> print acosh(2, 1e-5), acosh(2, 1e-10), acosh(2, 1e-15), acosh(2, 1e-20)
1.31696 1.3169578969 1.316957896924817 1.31695789692481670862
LIMITS
unlike sin and cos, x must be real
eps > 0
none
LIBRARY
NUMBER *qacosh(NUMBER *x, NUMBER *eps)

3
help/acot
View File

@@ -21,8 +21,7 @@ EXAMPLE
.46365 .463647609 .463647609000806 .46364760900080611621
LIMITS
unlike sin and cos, x must be real
eps > 0
none
LIBRARY
NUMBER *qacot(NUMBER *x, NUMBER *eps)

9
help/acoth
View File

@@ -14,17 +14,16 @@ DESCRIPTION
Returns the acoth of x to a multiple of eps with error less in
absolute value than .75 * eps.
acoth(x) = ln((x + 1)/(x - 1))/2 is the real number v for which
coth(v) = x.
acoth(x) is the real number v for which coth(v) = x.
It is given by
acoth(x) = ln((x + 1)/(x - 1))/2
EXAMPLE
> print acoth(2, 1e-5), acoth(2, 1e-10), acoth(2, 1e-15), acoth(2, 1e-20)
.54931 .5493061443 .549306144334055 .5493061443340548457
LIMITS
unlike sin and cos, x must be real
abs(x) > 1
eps > 0
none
LIBRARY
NUMBER *qacoth(NUMBER *x, NUMBER *eps)

4
help/acsc
View File

@@ -21,9 +21,7 @@ EXAMPLE
.5236 .5235987756 .523598775598299 .52359877559829887308
LIMITS
unlike sin and cos, x must be real
abs(x) >= 1
eps > 0
none
LIBRARY
NUMBER *qacsc(NUMBER *x, NUMBER *eps)

10
help/acsch
View File

@@ -14,17 +14,17 @@ DESCRIPTION
Returns the acsch of x to a multiple of eps with error less in
absolute value than .75 * eps.
acsch(x) = ln((1 + sqrt(1 + x^2))/x) is the real number v for
which csch(v) = x.
acsch(x) is the real number v for which csch(v) = x. It is given by
acsch(x) = ln((1 + sqrt(1 + x^2))/x)
EXAMPLE
> print acsch(2, 1e-5), acsch(2, 1e-10), acsch(2, 1e-15), acsch(2, 1e-20)
.48121 .4812118251 .481211825059603 .4812118250596034475
LIMITS
unlike sin and cos, x must be real
x != 0
eps > 0
none
LIBRARY
NUMBER *qacsch(NUMBER *x, NUMBER *eps)

161
help/address Normal file
View File

@@ -0,0 +1,161 @@
NAME
& - address operator
SYNOPSIS
&X
TYPES
X expression specifying an octet, lvalue, string or number
return pointer
DESCRIPTION
&X returns the address at which information for determining the current
value of X is stored. After an assignment as in p = &X, the
value of X is accessible by *p so long as the connection between p
and the value is not broken by relocation of the information or by the
value ceasing to exist. Use of an address after the connection
is broken is unwise since the calculator may use that address for other
purposes; the consequences of attempting to write data to, or
otherwise accessing, such a vacated address may be catastrophic.
An octet is normally expressed by B[i] where B is a block and
0 <= i < sizeof(B). &B[i] then returns the address at which this
octet is located until the block is freed or relocated. Freeing
of an unnamed block B occurs when a new value is assigned to B or
when B ceases to exist; a named block B is freed by blkfree(B().
A block is relocated when an operation like copying to B requires
a change of sizeof(B).
An lvalue may be expressed by an identifier for a variable, or by
such an identifier followed by one or more qualifiers compatible with
the type of values associated with the variable and earlier qualifiers.
If an identifier A specifies a global or static variable, the address
&A is permanently associated with that variable. For a local variable
or function parameter A, the association of the variable with &A
is limited to each occasion when the function is called. If X specifies a
component or element of a matrix or object, connection of
&X with that component or element depends only on the continued existence
of the matrix or object. For example, after
> mat A[3]
the addresses &A[0], &A[1], &A[2] locate the three elements
of the matrix specified by A until another value is assigned to A, etc.
Note one difference from C in that &A[0] is not the same as A.
An element of a list has a fixed address while the list exists and
the element is not removed by pop(), remove(), or delete(); the index
of the element changes if an element is pushed onto the list, or if
earlier elements are popped or deleted.
Elements of an association have fixed addresses so long as the association
exists. If A[a,b,...] has not been defined for the association A,
&A[a,b,...] returns the constant address of a particular null value.
Some other special values have fixed addresses; e.g. the old value (.).
Some arithmetic operations are defined for addresses but these should
be used only for octets or components of a matrix or object where the
results refer to octets in the same block or existing components of the
same matrix or object. For example, immediately after
> mat A[10]
> p = &A[5]
it is permitted to use expressions like p + 4, p - 5, p++ .
Strings defined literally have fixed addresses, e.g., after
> p = &"abc"
> A = "abc"
The address &*A of the value of A will be equal to p.
Except in cases like strcat(A, "") when *A identified with a literal
string as above, definitions of string values using strcat() or substr()
will copy the relevant strings to newly allocated addresses which will
be useable only while the variables retain these defined values.
For example,
> B = C = strcat("a", "bc");
&*B and &*C will be different. If p is defined by p = &*B, p should
not be used after a mew value is assigned to B, or B ceases to exist,
etc.
When compilation of a function encounters for the first time a particular
literal number or the result of simple arithmetic operations (like +, -, *,
or /) on literal numbers, that number is assigned to a particular
address which is then used for later similar occurrences of that number
so long as the number remains associated with at least one function or
lvalue. For example, after
> x = 27;
> y = 3 * 9;
> define f(a) = 27 + a;
the three occurrences of 27 have the same address which may be displayed
by any of &27, &*x, &*y and &f(0). If x and y are assigned
other values and f is redefined or undefined and the 27 has not been
stored elsewhere (e.g. as the "old value" or in another function
definition or as an element in an association), the address assigned at
the first occurrence of 27 will be freed and calc may later use it for
another number.
When a function returns a number value, that number value is usually
placed at a newly allocated address, even if an equal number is stored
elsewhere. For example calls to f(a), as defined above, with the same
non-zero value for a will be assigned to different addresses as can be
seen from printing &*A, &*B, &*C after
> A = f(2); B = f(2); C = f(2);
(the case of f(0) is exceptional since 27 + 0 simply copies the 27
rather than creating a new number value). Here it is clearly more
efficient to use
> A = B = C = f(2);
which, not only performs the addition n f() only once, but stores the
number values for A, B and C at the same address.
Whether a value V is a pointer and if so, its type, is indicated by the
value returned by isptr(V): 1, 2, 3, 4 for octet-, value-, string-
and number-pointer respectively, and 0 otherwise.
The output when addresses are printed consists of a description (o_ptr,
v_ptr, s_ptr, n_ptr) followed by : and the address printed in
%p format.
Iteration of & is not permitted; &&X causes a "non-variable operand"
scan error.
EXAMPLE
Addresses for particular systems may differ from those displayed here.
> mat A[3]
> B = blk()
> print &A, &A[0], &A[1]
v-ptr: 1400470d0 v-ptr: 140044b70 v-ptr: 140044b80
> print &B, &B[0], &B[1]
v-ptr: 140047130 o-ptr: 140044d00 o-ptr: 140044d01
> a = A[0] = 27
> print &*a, &*A[0]. &27
n_ptr: 14003a850 n_ptr: 14003a850 n_ptr: 14003a850
> a = A[0] = "abc"
> print &*a, &*A[0], &"abc"
s_ptr: 14004cae0 s_ptr: 14004cae0 s_ptr: 14004cae0
LIMITS
none
LIBRARY
none
SEE ALSO
dereference, isptr

57
help/agd Normal file
View File

@@ -0,0 +1,57 @@
NAME
agd - inverse gudermannian function
SYNOPSIS
agd(z [,eps])
TYPES
z number (real or complex)
eps nonzero real, defaults to epsilon()
return number or infinite error value
DESCRIPTION
Calculate the inverse gudermannian of z to a nultiple of eps with
errors in real and imaginary parts less in absolute value than .75 * eps,
or an error value if z is very close to one of the one of the branch
points of agd(z)..
agd(z) is usually defined initially for real z with abs(z) < pi/2 by
one of the formulae
agd(z) = ln(sec(z) + tan(z))
= 2 * atanh(tan(z/2))
= asinh(tan(z)),
or as the integral from 0 to z of (1/cos(t))dt. For complex z, the
principal branch, approximated by gd(z, eps), has cuts along the real
axis outside -pi/2 < z < pi/2.
If z = x + i * y and abs(x) < pi/2, agd(z) is given by
agd(z) = atanh(sin(x)/cosh(y)) + i * atan(sinh(y)/cos(x)>
EXAMPLE
> print agd(1, 1e-5), agd(1, 1e-10), agd(1, 1e-15)
1.22619 1.2261911709 1.226191170883517
> print agd(2, 1e-5), agd(2, 1e-10)
1.52345-3.14159i 1.5234524436-3.1415926536i
> print agd(5, 1e-5), agd(5, 1e-10), agd(5, 1e-15)
-1.93237 -1.9323667197 -1.932366719745925
> print agd(1+2i, 1e-5), agd(1+2i, 1e-10)
.22751+1.42291i .2275106584+1.4229114625i
LIMITS
none
LIBRARY
COMPLEX *cagd(COMPLEX *x, NUMBER *eps)
SEE ALSO
gd, exp, ln, sin, sinh, etc.

14
help/appr
View File

@@ -22,7 +22,7 @@ DESCRIPTION
there is no "approximation" - the result represents x exactly.
In the following it is assumed y is nonzero and x is not a multiple of y.
For Real x:
For real x:
appr(x,y,z) is either the nearest multiple of y greater
than x or the nearest multiple of y less than x. Thus, if
@@ -45,9 +45,9 @@ DESCRIPTION
z = 3 round away from zero, sgn(r) = -sgn(x)
z = 4 round down
z = 4 round down, r > 0
z = 5 round up
z = 5 round up, r < 0
z = 6 round towards or from zero according as y is positive or
negative, sgn(r) = sgn(x/y)
@@ -82,7 +82,9 @@ DESCRIPTION
appr(x,y,z) returns the matrix or list indexed in the same way as x,
in which each element t has been replaced by appr(t,y,z).
XXX - complex x needs to be documented
Complex x:
Returns appr(re(x), y, z) + appr(im(x), y, z) * 1i
PROPERTIES
If appr(x,y,z) != x, then abs(x - appr(x,y,z)) < abs(y).
@@ -134,6 +136,10 @@ EXAMPLES
> print appr(-.44,-.1,15),appr(.44,-.1,15),appr(5.7,-1,15),appr(-5.7,-1,15)
-.4 .5 5 -6
> x = sqrt(7-3i, 1e-20)
> print appr(x,1e-5,0), appr(x,1e-5,1), appr(x,1e-5,2), appr(x,1e-6,3)
2.70331-.55488i 2.70332-.55487i 2.70331-.55487i 2.70332-.55488i
LIMITS
none

8
help/archive
View File

@@ -22,4 +22,10 @@ Where to get the the latest versions of calc
where "address" is your EMail address and "your_full_name"
is your full name.
Landon Curt Noll <chongo@toad.com> /\oo/\
See:
http://prime.corp.sgi.com/csp/ioccc/noll/noll.html#calc
for details.
Landon Curt Noll <chongo@toad.com> /\oo/\

2
help/arg
View File

@@ -13,7 +13,7 @@ TYPES
DESCRIPTION
Returns the argument of x to the nearest or next to nearest multiple of
eps; the error will be less in absolute value than 0.75 * abs(eps),
but usually less than 0.5 * abs(eps). By default, acc is epsilon().
but usually less than 0.5 * abs(eps).
EXAMPLE
> print arg(2), arg(2+3i, 1e-5), arg(2+3i, 1e-10), arg(2+3i, 1e-20)

51
help/arrow Normal file
View File

@@ -0,0 +1,51 @@
SYMBOL and NAME
-> - arrow operator
SYNOPSIS
p -> X
TYPES
p pointer to an lvalue
X identifier
return lvalue
DESCRIPTION
p->X returns the same as (*p).X. Thus the current value of *p is
to be an object of a type for which X identifies one element.
p->X then returns the lvalue corresponding to that element of of the
value of *p.
The expression *p.X will cause a runtime error since this is
interpreted as *(p.X) in which p is expected to be an object of
an appropriate type.
Spaces or tabs on either side of -> are optional.
EXAMPLES
> obj pair {one, two}
> obj pair A, B
> p = &A
> p->one = 1; p->two = 2
> A
obj pair {1, 2}
> A->two = &B
> p->two->one = 3; p->two->two = 4
> *p->ptwo
obj pair {3, 4}
> B = {5,6}
> *p->two
obj pair {5, 6}
LIMITS
none
LIBRARY
none
SEE ALSO
address, dereference, isptr, dot

4
help/asec
View File

@@ -21,9 +21,7 @@ EXAMPLE
1.0472 1.0471975512 1.047197551196598 1.04719755119659774615
LIMITS
unlike sin and cos, x must be real
abs(x) >= 1
eps > 0
none
LIBRARY
NUMBER *qasec(NUMBER *x, NUMBER *eps)

9
help/asech
View File

@@ -14,17 +14,16 @@ DESCRIPTION
Returns the asech of x to a multiple of eps with error less in
absolute value than .75 * eps.
asech(x) = ln((1 + sqrt(1 - x^2))/x) is the real number v for which
sech(v) = x.
asech(x) is the real number v for which sech(v) = x. It is given by
asech(x) = ln((1 + sqrt(1 - x^2))/x)
EXAMPLE
> print asech(.5,1e-5), asech(.5,1e-10), asech(.5,1e-15), asech(.5,1e-20)
1.31696 1.3169578969 1.316957896924817 1.31695789692481670862
LIMITS
unlike sin and cos, x must be real
0 < x <= 1
eps > 0
none
LIBRARY
NUMBER *qasech(NUMBER *x, NUMBER *eps)

4
help/asin
View File

@@ -21,9 +21,7 @@ EXAMPLE
.5236 .5235987756 .523598775598299 .52359877559829887308
LIMITS
unlike sin and cos, x must be real
abs(x) <= 1
eps > 0
none
LIBRARY
NUMBER *qasin(NUMBER *q, NUMBER *epsilon)

8
help/asinh
View File

@@ -14,16 +14,16 @@ DESCRIPTION
Returns the asinh of x to a multiple of eps with error less in
absolute value than .75 * eps.
asinh(x) = ln(x + sqrt(1 + x^2)) is the real number v for which
sinh(v) = x.
asinh(x) is the real number v for which sinh(v) = x. It is given by
asinh(x) = ln(x + sqrt(1 + x^2))
EXAMPLE
> print asinh(2, 1e-5), asinh(2, 1e-10), asinh(2, 1e-15), asinh(2, 1e-20)
1.44363 1.4436354752 1.44363547517881 1.44363547517881034249
LIMITS
unlike sin and cos, x must be real
eps > 0
none
LIBRARY
NUMBER *qasinh(NUMBER *x, NUMBER *eps)

97
help/assign
View File

@@ -3,22 +3,111 @@ NAME
SYNOPSIS
a = b
a = {e_1, e_2, ...[ { ... } ] }
TYPES
a lvalue
b expression
a lvalue, current value a structure in { } case
return lvalue
b expression
e_0, e_1, ... expressions, blanks, or initializer lists
return lvalue (a)
DESCRIPTION
Here an lvalue is either a simple variable specified by an identifier,
or an element of an existing structure specified by one or more
qualifiers following an identifier.
An initializer list is a comma-separated list enclosed in braces as in
{e_0, e_1, ... }
where each e_i is an expression, blank or initializer list.
a = b evaluates b, assigns its value to a, and returns a.
a = {e_0, e_1, ... } where the e_i are expressions or blanks,
requires the current value of a to be a matrix, list
or object with at least as many elements as listed e_i. Each non-blank
e_i is evaluated and its value is assigned to a[[i]]; elements a[[i]]
corresponding to blank e_i are unchanged.
If, in a = {e_0, e_1, ...}, e_i is an initializer list, as in
{e_i_0, e_1_1, ...}, the corresponding a[[i]] is to be a matrix, list
or object with at least as many elements as listed e_i_j. Depending on
whether e_i_j is an expression, blank, or initializer list, one, no, or
possibly more than one assignment, is made to a[[i]][[j]] or, if
relevant and possible, its elements.
In simple assignments, = associates from right to left so that, for
example,
a = b = c
has the effect of a = (b = c) and results in assigning the value of c
to both a and b. The expression (a = b) = c is acceptable, but has the
effect of a = b; a = c; in which the first assignment is superseded by
the second.
In initializations, = { ...} associates from left to right so that,
for example,
a = {e_0, ... } = {v_0, ...}
first assigns e_0, ... to the elements of a, and then assigns v_0, ...
to the result.
If there are side effects in the evaluations involved in executing a = b,
it should be noted that the order of evaluations is: first the address
for a, then the value of b, and finally the assignment. For example if
A is a matrix and i = 0, then the assignment in A[i++] = A[i] is
that of A[0] = A[1].
If, in execution of a = b, a is changed by the evaluation of b, the
value of b may be stored in an unintended or inaccessible location. For
example,
mat A[2]= {1,2};
A[0] = (A = 3);
results in the value 3 being stored not only as the new value for A
but also at the now unnamed location earlier used for A[0].
EXAMPLE
> b = 3+1
> a = b
> print a, b
4 4
> obj point {x,y}
> mat A[3] = {1, list(2,3), obj point = {4,5}}
> A[1][[0]] = 6; A[2].x = 7
> print A[1]
list (2 elements, 2 nonzero):
[[0]] = 6
[[1]] = 3
> print A[2]
obj point {7, 5}
> A = {A[2], , {9,10}}
> print A[0]
obj point {7, 5}
> print A[2]
obj point {9, 10}
> A = {, {2}}
print A[1]
list (2 elements, 2 nonzero):
[[0]] = 2
[[1]] = 3
LIMITS
none
@@ -26,4 +115,4 @@ LIBRARY
none
SEE ALSO
XXX - fill in
swap, quomod

57
help/assoc
View File

@@ -8,38 +8,34 @@ TYPES
return association
DESCRIPTION
This functions returns an empty association array.
This function returns an empty association array.
Associations are special values that act like matrices, except
that they are more general (and slower) than normal matrices.
Unlike matrices, associations can be indexed by arbitrary values.
For example, if 'val' was an association, you could do the following:
After A = assoc(), elements can be added to the association by
assignments of the forms
val['hello'] = 11;
val[4.5] = val['hello'];
print val[9/2];
A[a_1] = v_1
A[a_1, a_2] = v_2
A[a_1, a_2, a_3] = v_3
A[a_1, a_2, a_3, a_4] = v_4
and 11 would be printed.
There are no restrictions on the values of the "indices" a_i or
the "values" v_i.
Associations are created by the 'assoc' function. It takes no
arguments, and simply returns an empty association. You can then
insert elements into the association by indexing the returned value
as shown above.
After the above assignments, so long as no new values have been
assigned to A[a_i], etc., the expressions A[a_1], A[a_1, a_2], etc.
will return the values v_1, v_2, ...
Associations are multi-dimensional. You can index them using one to
four dimensions as desired, and the elements with different numbers
of dimensions will remain separated. For example, 'val[3]' and
'val[3,0]' can both be used in the same association and will be
distinct elements.
Until A[a_1], A[a_1, a_2], ... are defined as described above, these
expressions return the null value.
When references are made to undefined elements of an association,
a null value is simply returned. Therefore no bounds errors can
occur when indexing an association. Assignments of a null value
Thus associations act like matrices except that different elements
may have different numbers (between 1 and 4 inclusive) of indices,
and these indices need not be integers in specified ranges.
Assignments of a null value
to an element of an association does not delete the element, but
a later reference to that element will return the null value as if
the element was undefined. Elements with null values are implicitly
created on certain other operations which require an address to be
taken, such as the += operator and using & in a function call.
the element is undefined.
The elements of an association are stored in a hash table for
quick access. The index values are hashed to select the correct
@@ -65,9 +61,18 @@ DESCRIPTION
and are illegal.
EXAMPLE
> print assoc()
> A = assoc(); print A
assoc (0 elements):
assoc (0 elements):
> A["zero"] = 0; A["one"] = 1; A["two"] = 2; A["three"] = 3;
> A["smallest", "prime"] = 2;
> print A
assoc (5 elements);
["two"] = 2
["three"] = 3
["one"] = 1
["zero"] = 0
["smallest","prime"] = 2
LIMITS
none

3
help/atan
View File

@@ -21,8 +21,7 @@ EXAMPLE
1.10715 1.1071487178 1.107148717794091 1.10714871779409050302
LIMITS
unlike sin and cos, x must be real
eps > 0
none
LIBRARY
NUMBER *qatan(NUMBER *x, NUMBER *eps)

21
help/atan2
View File

@@ -2,32 +2,33 @@ NAME
atan2 - angle to point
SYNOPSIS
atan2(y, x, [,acc])
atan2(y, x, [,eps])
TYPES
y real
x real
acc real
eps nonzero real, defaults to epsilon()
return real
DESCRIPTION
Return the angle which is determined by the point (x,y). This
function computes the arctangent of y/x in the range [-pi, pi].
The value acc specifies the accuracy of the result. By default, acc
is epsilon().
If x and y are not both zero, atan2(y, x, eps) returns, as a multiple of
eps with error less than abs(eps), the angle t such that
-pi < t <= pi and x = r * cos(t), y = r * sin(t), where
r > 0. Usually the error does not exceed abs(eps)/2.
Note that by convention, y is the first argument.
Note that by convention, y is the first argument; if x > 0,
atan2(y, x) = atan(y/x).
To conform to the 4.3BSD ANSI/IEEE 754-1985 math lib, atan2(0,0) is
defined to return 0.
To conform to the 4.3BSD ANSI/IEEE 754-1985 math lib, atan2(0,0)
returns 0.
EXAMPLE
> print atan2(0,0), atan2(1,sqrt(3)), atan2(17,53,1e-100)
0 ~.52359877559829887307 ~.31038740713235146535
LIMITS
acc > 0
none
LIBRARY
NUMBER *qatan2(NUMBER *y, *x, *acc)

8
help/atanh
View File

@@ -14,16 +14,16 @@ DESCRIPTION
Returns the atanh of x to a multiple of eps with error less in
absolute value than .75 * eps.
atanh(x) = ln((1 + x)/(1 - x))/2 is the real number v for whichi
tanh(v) = x.
atanh(x) is the real number v for which tanh(v) = x. It is given by
atanh(x) = ln((1 + x)/(1 - x))/2
EXAMPLE
> print atanh(.5,1e-5), atanh(.5,1e-10), atanh(.5,1e-15), atanh(.5,1e-20)
.54931 .5493061443 .549306144334055 .5493061443340548457
LIMITS
unlike sin and cos, x must be real
eps > 0
none
LIBRARY
NUMBER *qatanh(NUMBER *x, NUMBER *eps)

2
help/base
View File

@@ -11,7 +11,7 @@ TYPES
DESCRIPTION
The base function allows one to specify how numbers should be
printer. The base function provides a numeric shorthand to the
printed. The base function provides a numeric shorthand to the
config("mode") interface. With no args, base() will return the
current mode. With 1 arg, base(val) will set the mode according to
the arg and return the previous mode.

43
help/bit Normal file
View File

@@ -0,0 +1,43 @@
NAME
bit - whether a given binary bit is set in a value
SYNOPSIS
bit(x, y)
TYPES
x real
y int
return int
DESCRIPTION
Determine if the binary bit y is set in x. If:
x
int(---) mod 2 == 1
2^y
return 1, otherwise return 0.
EXAMPLE
> print bit(9,0), bit(9,1), bit(9,2), bit(9,3)
1 0 0 1
> print bit(9,4), bit(0,0), bit(9,-1)
0 0 0
> print bit(1.25, -2), bit(1.25, -1), bit(1.25, 0)
1 0 1
> p = pi()
> print bit(p, 1), bit(p, -2), bit(p, -3)
1 0 1
LIMITS
-2^31 < y < 2^31
LIBRARY
BOOL qbit(NUMBER *x, long y)
SEE ALSO
highbit, lowbit, digit

219
help/blk Normal file
View File

@@ -0,0 +1,219 @@
NAME
blk - generate or modify block values
SYNOPSIS
blk([len, chunk]);
blk(val [, len, chunk]);
TYPES
len null or integer
chunk null or integer
val non-null string, block, or named block
return block or named block
DESCRIPTION
With only integer arguments, blk(len, chunk) attempts to
allocate a block of memory consisting of N octets (unsigned 8-bit
bytes). Allocation is always done in multiples of chunk
octets, so the actual allocation size of len rounded up
to the next multiple of chunk.
The default value for len is 0. The default value for chunk is 256.
If the allocation is successful, blk(len, chunk) returns a value B, say,
for which the octets in the block may be referenced by B[0], B[1],
... , B[len-1], these all initially having zero value.
The octets B[i] for i >= len always have zero value. If B[i] with
some i >= len is referenced, len is increased by 1. For example:
B[i] = x
has an effect like that of two operations on a file stream fs:
fseek(fs, pos);
fputc(fs, x).
Similarly:
x = B[i]
is like:
fseek(fs, pos);
x = fgetc(fs).
The value of chunk is stored as the "chunksize" for B.
The size(B) builtin returns the current len for the block; sizeof(B)
returns its maxsize; memsize(B) returns maxsize + overhead for any block
value. Also size(B) is analogous to the length of a file stream in that
if size(B) < sizeof(B):
B[size(B)] = x
will append one octet to B and increment size(B).
The builtin test(B) returns 1 or 0 according as at least one octet
is zero or all octets are zero. If B1 and B2 are blocks, they are
considered equal (B1 == B2) if they have the same length and the
same data, i.e. B1[i] == B2[i] for 0 <= i < len. Chunksizes
and maxsizes are ignored.
The output for print B occupies two lines, the first line giving
the chunksize, number of octets allocated (len rounded up to the
next chunk) and len, and the second line up to 30 octets of data.
If the datalen is zero, the second line is blank. If the datalen
exceeds 30, this indicated by a trailing "...".
If a block value B created by B = blk(len, chunk) is assigned to
another variable by C = B, a new block of the same structure as B
is created to become the value of C, and the octets in B are copied
to this new block. A block with possibly different length or
chunksize is created by C = blk(B, newlen, newchunk), only the first
min(len, newlen) octets being copied from B; later octets are
assigned zero value. If omitted, newlen and newchunk default to
the current datalen and chunk-size for B. The curent datalen,
chunksize and number of allocated octets for B may be changed by:
B = blk(B, newlen, newchunk).
No data is lost if newlen is greater than or equal to the old
size(B).
The memory block allocated by blk(len, chunk) is freed at or before
termination of the statement in which this occurred, the memory
allocated in B = blk(len, chunk) is freed when B is assigned another
value.
With a string str as its first argument, blk(str [, len, chunk])
when called for the first time creates a block with str as its
name. Here there no restriction on the characters used in str;
thus the string may include white space or characters normally used
for punctuation or operators. Any subsequent call to blk(str, ...)
with the same str will refer to the same named block.
A named block is assigned length and chunksize and consequent
maximum size in the same way as unnamed blocks. A major difference
is that in assignments, a named block is not copied. Thus, if a
block A has been created by:
A = blk("foo")
any subsequent:
B = A
or:
B = blk("foo")
will give a second variable B referring to the same block as A.
Either A[i] = x or B[i] = x may then be used to assign a value
to an octet in the book. Its length or chunksize may be changed by
instructions like:
blk(A, len, chunk);
A = blk(A, len, chunk);
null(blk(A, len, chunk)).
These have the same effect on A; when working interactively, the
last two avoid printing of the new value for A.
Named blocks are assigned index numbers 0, 1, 2, ..., in the order
of their creation. The block with index id is returned by blocks(id).
With no argument, blocks() returns the number of current unfreed
named blocks. A named block may be used
The memory allocated to a named block is freed by the blkfree()
function with argument the named block, its name, or its id number.
The block remains in existence but with a null data pointer,
its length and size being reduced to zero. A new block of memory
may be allocated to it, with possibly new length and chunksize by:
blk(val [, len, chunk])
where val is either the named block or its name.
The printing output for a named block is in three lines, the first
line displaying its id number and name, the other two as for an
unnamed block, except that "NULL" is printed if the memory has been
freed.
The identifying numbers and names of the current named blocks are
displayed by:
show blocks
If A and B are named blocks, A == B will be true only if they refer
to the same block of memory. Thus, blocks with the same data and
datalen will be considered unequal if they have different names.
If A is a named block, str(A) returns the name of the block.
Values may be assigned to the early octets of a named or unnamed
block by use of = { } initialization as for matrices.
EXAMPLE
> B = blk(15,10)
> B[7] = 0xff
> B
chunksize = 10, maxsize = 20, datalen = 15
00000000000000ff00000000000000
> B[18] = 127
> B
chunksize = 10, maxsize = 20, datalen = 18
00000000000000ff0000000000000000007f
> B[20] = 2
Index out of bounds for block
> print size(B), sizeof(B)
18 20
> B = blk(B, 100, 20)
> B
chunksize = 20, maxsize = 120, datalen = 100
00000000000000ff0000000000000000007f000000000000000000000000...
> C = blk(B, 10} = {1,2,3}
> C
chunksize = 20, maxsize = 20, datalen = 10
01020300000000ff0000
> A1 = blk("alpha")
> A1
block 0: alpha
chunksize = 256, maxsize = 256, datalen = 0
> A1[7] = 0xff
> A2 = A1
> A2[17] = 127
> A1
block 0: alpha
chunksize = 256, maxsize = 256, datalen = 18
00000000000000ff0000000000000000007f
> A1 = blk(A1, 1000)
> A1
block 0: alpha
chunksize = 256, maxsize = 1024, datalen = 1000
00000000000000ff0000000000000000007f000000000000000000000000...
> A1 = blk(A1, , 16)
> A1
block 0: alpha
chunksize = 16, maxsize = 1008, datalen = 1000
00000000000000ff0000000000000000007f000000000000000000000000...
LIMITS
0 <= len < 2^31
1 <= chunk < 2^31
LIBRARY
XXX
SEE ALSO
blocks, blkfree

192
help/blkcpy Normal file
View File

@@ -0,0 +1,192 @@
NAME
blkcpy, copy - copy items from a structure to a structure
SYNOPSIS
blkcpy(dst, src [, num [, dsi [, ssi]]]
copy(src, dest [, [ssi [, num [, dsi]]])
TYPES
src block, file, string, matrix, or list
dest block, file, matrix or list - compatible with src
ssi nonnegative integer, defaults to zero
num nonnegative integer, defaults to maximum possible
dsi nonnegative integer, defaults to datalen for a block, filepos
for a file, zero for other structures
return null if successful, error value otherwise
DESCRIPTION
A call to:
blkcpy(dst, src, num, dsi, ssi)
attempts to copy 'num' consecutive items (octets or values) starting
from the source item 'src' with index 'ssi'. By default, 'num'
is the maximum possible and 'ssi' is 0.
A call to:
copy(src, dst, ssi, num, dsi)
does the same thing, but with a different arg order.
A copy fails if ssi or num is too large for the number of items in
the source, if sdi is too large for the number of positions
available in the destination, or, in cases involving a file stream,
if the file is not open in the required mode. The source and
destination need not be of the same type, e.g. when a block is
copied to a matrix the octets are converted to numbers.
The following pairs of source-type, destination-type are permitted:
block to
int
block
matrix
file
matrix to
block
matrix
list
string to
block
file
list to
list
matrix
file to
block
int to
block
In the above table, int refers to integer values. However if a
rational value is supplied, only the numerator is copied.
Each copied octet or value replaces the octet or value in the
corresponding place in the destination structure. When copying values
to values, the new values are stored in a buffer, the old values are
removed, and the new values copied from the buffer to the destination.
This permits movement of data within one matrix or list, and copying
of an element of structure to the structure.
Except for copying to files or blocks, the destination is already to have
sufficient memory allocated for the copying. For example, to copy
a matrix M of size 100 to a newly created list, one may use:
L = makelist(100);
copy(M, L);
or:
L = makelist(100);
blkcpy(L, M);
For copying from a block B (named or unnamed), the total number of octets
available for copying is taken to the the datalen for that block,
so that num can be at most size(B) - ssi.
For copying to a block B (named or unnamed), reallocation will be
required if dsi + num > sizeof(B). (This will not be permitted if
protect(B) has bit 4 set.)
For copying from a file stream fs, num can be at most size(fs) - ssi.
For copying from a string str, the string is taken to include the
terminating '\0', so the total number of octets available is
strlen(str) + 1 and num can be at most strlen(str) + 1 - ssi.
If num <= strlen(str) - ssi, the '\0' is not copied.
For copying from or to a matrix M, the total number of values in
M is size(M), so in the source case, num <= size(M) - ssi, and
in the destination case, num <= size(M) - dsi. The indices ssi
and dsi refer to the double-bracket method of indexing, i.e. the
matrix is as if its elements were indexed 0, 1, ..., size(M) - 1.
EXAMPLE
> A = blk() = {1,2,3,4}
> B = blk()
> blkcpy(B,A)
> B
chunksize = 256, maxsize = 256, datalen = 4
01020304
>
> blkcpy(B,A)
> B
chunksize = 256, maxsize = 256, datalen = 8
0102030401020304
> blkcpy(B, A, 2, 10)
> B
chunksize = 256, maxsize = 256, datalen = 12
010203040102030400000102
> blkcpy(B,32767)
> B
chunksize = 256, maxsize = 256, datalen = 16
010203040102030400000102ff7f0000
> mat M[2,2]
> blkcpy(M, A)
> M
mat [2,2] (4 elements, 4 nonzero):
[0,0] = 1
[0,1] = 2
[1,0] = 3
[1,1] = 4
> blkcpy(M, A, 2, 2)
> M
mat [2,2] (4 elements, 4 nonzero):
[0,0] = 1
[0,1] = 2
[1,0] = 1
[1,1] = 2
> A = blk() = {1,2,3,4}
> B = blk()
> copy(A,B)
> B
chunksize = 256, maxsize = 256, datalen = 4
01020304
> copy(A,B)
> B
chunksize = 256, maxsize = 256, datalen = 8
0102030401020304
> copy(A,B,1,2)
> B
chunksize = 256, maxsize = 256, datalen = 10
01020304010203040203
> mat M[2,2]
> copy(A,M)
> M
mat [2,2] (4 elements, 4 nonzero):
[0,0] = 1
[0,1] = 2
[1,0] = 3
[1,1] = 4
> copy(A,M,2)
> M
mat [2,2] (4 elements, 4 nonzero):
[0,0] = 3
[0,1] = 4
[1,0] = 3
[1,1] = 4
> copy(A,M,0,2,2)
> M
mat [2,2] (4 elements, 4 nonzero):
[0,0] = 3
[0,1] = 4
[1,0] = 1
[1,1] = 2
LIMITS
none
LIBRARY
none
SEE ALSO
blk, mat, file, list, str

58
help/blkfree Normal file
View File

@@ -0,0 +1,58 @@
NAME
blkfree - free memory allocated to named block
SYNOPSIS
blkfree(val)
TYPES
val named block, string, or integer
return null value
DESCRIPTION
If val is a named block, or the name of a named block, or the
identifying index for a named block, blkfree(val) frees the
memory block allocated to this named block. The block remains
in existence with the same name, identifying index, and chunksize,
but its size and maxsize becomes zero and the pointer for the start
of its data block null.
A new block of memory may be allocated to a freed block B by
blk(B [, len, chunk]), len defaulting to zero and chunk to the
chunksize when the block was freed.
EXAMPLE
> B1 = blk("foo")
> B2 = blk("Second block")
show blocks
id name
---- -----
0 foo
1 Second block
> blkfree(B1)
> show blocks
id name
---- -----
1 Second block
> B1
block 0: foo
chunksize = 256, maxsize = 0, datalen = 0
NULL
> blk(B1); B[7] = 5
> B1
block 0: foo
chunksize = 256, maxsize = 256, datalen = 8
0000000000000005
LIMITS
none
LIBRARY
none
SEE ALSO
blk, blocks

43
help/blocks Normal file
View File

@@ -0,0 +1,43 @@
NAME
blocks - return a named file or number of unfreed named blocks
SYNOPSIS
blocks([id])
TYPES
id non-negative integer
return named block or null value
DESCRIPTION
With no argument blocks() returns the number of blocks that have
been created but not freed by the blkfree function.
With argument id less than the number of named blocks that have been
created, blocks(id) returns the named block with identifying index id.
These indices 0, 1, 2, ... are assigned to named blocks in the order
of their creation.
EXAMPLE
> A = blk("alpha")
> B = blk("beta") = {1,2,3}
> blocks()
2
> blocks(1)
block 1: beta
chunksize = 256, maxsize = 256, datalen = 3
010203
> blocks(2)
Error 10211
> strerror()
"Non-allocated index number for blocks"
LIMITS
none
LIBRARY
none
SEE ALSO
blk, blkfree

20
help/btrunc
View File

@@ -2,19 +2,24 @@ NAME
btrunc - truncate a value to a number of binary places
SYNOPSIS
btrunc(x [,j])
btrunc(x [,plcs])
TYPES
x real
j int
plcs integer, defaults to zero
return real
DESCRIPTION
Truncate x to j binary places. If j is omitted, 0 places is assumed.
Specifying zero places makes the result identical to int().
Truncate x to plcs binary places, rounding if necessary towards zero,
i.e. btrunc(x, plcs) is a multiple of 2^-plcs and the remainder
x - btrunc(x, plcs) is either zero or has the same sign as x and
absolute value less than 2^-plcs. Here plcs may be positive, zero or
negative.
Truncation of a non-integer prodcues values nearer to zero.
Except that it is defined only for real x, btrunc(x, plcs) is equivalent
to bround(x, plcs, 2). btrunc(x,0) and btrunc(x) are equivalent to
int(x).
EXAMPLE
> print btrunc(pi()), btrunc(pi(), 10)
@@ -26,8 +31,11 @@ EXAMPLE
> print btrunc(-3.3), btrunc(-3.7), btrunc(-3.3, 2), btrunc(-3.7, 2)
-3 -3 -3.25 -3.5
> print btrunc(55.123, -4), btrunc(-55.123, -4)
48 -48
LIMITS
0 <= j < 2^31
abs(j) < 2^31
LIBRARY
NUMBER *qbtrunc(NUMBER *x, *j)

4
help/builtin.end
View File

@@ -35,10 +35,10 @@
the user. For example, x=eval(prompt("Number: ")) sets x to the
value input by the user.
The digit and isset functions return individual digits of a number,
The digit and bit functions return individual digits of a number,
either in base 10 or in base 2, where the lowest digit of a number
is at digit position 0. For example, digit(5678, 3) is 5, and
isset(0b1000100, 2) is 1. Negative digit positions indicate places
bit(0b1000100, 2) is 1. Negative digit positions indicate places
to the right of the decimal or binary point, so that for example,
digit(3.456, -1) is 4.

7
help/cmdbuf
View File

@@ -13,8 +13,11 @@ DESCRIPTION
this function will return an empty string.
EXAMPLE
> cmdbuf("")
""
% calc "print cmdbuf(); a = 3; print a^2;"
print cmdbuf(); a = 3; print a^2;
9
%
LIMITS
none

105
help/cmp
View File

@@ -1,71 +1,95 @@
NAME
cmp - compare two values
cmp - compare two values of certain simple or object types
SYNOPSIS
cmp(x, y)
TYPES
If x is an object of type xx or x is not an object and y is an object
of type xx, the funcion xx_cmp has to have been defined; any
If x is an object of type xx, or x is not an object and y is an object
of type xx, the function xx_rel has to have been defined; any
further conditions on x and y, and the type of the returned
value depends on the definition of xx_cmp.
value depends on the definition of xx_rel.
For non-object x and y:
x number or string
y same as x
x any
y any
return -1, 0, 1 (real & string)
-1, 0, 1, -1+1i, 1i, 1+1i, -1-1i, -1i or 1-1i (complex)
return if x and y are both real: -1, 0, or 1
if x and y are both numbers but not both real:
-1, 0, 1, -1+1i, 1i, 1+1i, -1-1i, -1i, or 1-1i
if x and y are both strings: -1, 0, or 1
all other cases: the null value
DESCRIPTION
Compare two values and return a value based on their relationship.
Comparison by type is indicated below. Where more than one test is
indicated, tests are performed in the order listed. If the test is
inconclusive, the next test is performed. If all tests are
inconclusive, the values are considered equivalent.
real (returns -1, 0, or 1)
the greater number is greater
x and y both real: cmp(x, y) = sgn(x - y), i.e. -1, 0, or 1
according as x < y, x == y, or x > y
complex (returns -1, 0, 1, -1+1i, 1i, 1+1i, -1-1i, -1i or 1-1i)
sgn(re(x) - re(y)) + sgn(im(x) - im(y)) * 1i
x and y both numbers, at least one being complex:
cmp(x,y) = sgn(re(x) - re(y)) + sgn(im(x) - im(y)) * 1i
string (returns -1, 0, or 1)
the string with the greater first different character is greater
the longer string is greater
x and y both strings: successive characters are compared until either
different characters are encountered or at least one string is
completed. If the comparison ends because of different characters,
cmp(x,y) = 1 or -1 according as the greater character is in x or y.
If all characters compared in both strings are equal, then
cmp(x,y) = -1, 0 or 1 according as the length of x is less than,
equal to, or greater than the length of y. (This comparison
is performed via the strcmp() libc function.)
object (depends on xx_cmp)
the greater object as defined by xx_cmp is greater
objects: comparisons of objects are usually intended for some total or
partial ordering and appropriate definitions of cmp(a,b) may
make use of comparison of numerical or string components.
definitions using comparison of numbers or strings are usually
appropriate. For example, after
String comparison is performed via the strcmp() libc function.
obj point {x,y};
Note that this function is not a substitution for equality. The ==
operator always takes epsilon() into account when comparing numeric
values. For example:
if points with real components are to be partially ordered by their
euclidean distance from the origin, an appropriate point_rel
function may be that given by
> cmp(1, 1+epsilon()/2)
-1
> 1 == 1+epsilon()/2
0
define point_rel(a,b) = sgn(a.x^2 + a.y^2 - b.x^2 - b.y^2);
It should be noted epsilon() is used when comparing complex values.
A total "lexicographic" ordering is that given by:
Properties of cmp(a,b) for real or complex a and b are:
define point_rel(a,b) {
if (a.y != b.y)
return sgn(a.y - b.y);
return (a.x - b.x);
}
cmp(a + c, b + c) = cmp(a,b)
A comparison function that compares points analogously to
cmp(a,b) for real and complex numbers is that given by
define point_rel(P1, P2) {
return obj point = {sgn(P1.x-P2.x), sgn(P1.y-P2.y)};
}
The range of this function is the set of nine points with zero
or unit components.
Some properties of cmp(a,b) for real or complex a and b are:
cmp(a + c, b + c) = cmp(a, b)
cmp(a, b) == 0 if and only if a == b
cmp(b, a) = -cmp(a,b)
cmp(b, a) = -cmp(a, b)
if c is real or pure imaginary, cmp(c * a, c * b) = c * cmp(a,b)
cmp(a,b) == cmp(b,c) if and only if b is "between" a and c
Then a function that defines "b is between a and c" in an often useful
sense is
The numbers between 2 + 3i and 4 + 5i are those with real part between
2 and 4, imaginary part between 3 and 5; the numbers between 2 + 3i
and 4 + 3i are those with real part between 2 and 4, imaginary part = 3.
define between(a,b,c) = (cmp(a,b) == cmp(b,c)).
For example, in this sense, 3 + 4i is between 1 + 5i and 4 + 2i.
Note that using cmp to compare non-object values of different types,
for example, cmp(2, "2"), returns the null value.
EXAMPLE
> print cmp(3,4), cmp(4,3), cmp(4,4), cmp("a","b"), cmp("abcd","abc")
@@ -84,7 +108,8 @@ LIMITS
none
LIBRARY
none
FLAG qrel(NUMBER *q1, NUMBER *q2)
FLAG zrel(ZVALUE z1, ZVALUE z2)
SEE ALSO
abs, epsilon, sgn
sgn, test, operator

8
help/comb
View File

@@ -5,10 +5,10 @@ SYNOPSIS
comb(x, y)
TYPES
x int
y int
x integer
y integer
return int
return integer
DESCRIPTION
Return the combinatorial number C(x,y) which is defined as:
@@ -33,7 +33,7 @@ LIMITS
x-y < 2^24
LIBRARY
void zcomb(NUMBER x, y, *ret)
void zcomb(ZVALUE x, ZVALUE y, ZVALUE *res)
SEE ALSO
fact, perm

135
help/config
View File

@@ -33,9 +33,16 @@ Configuration parameters
"outround" sets rounding mode for printing of numbers
"leadzero" enables/disables printing of 0 as in 0.5
"fullzero" enables/disables padding zeros as in .5000
"maxerr" maximum number of scan errors before abort
"maxscan" maximum number of scan errors before abort
"prompt" default interactive prompt
"more" default interactive multi-line input prompt
"blkmaxprint" number of block octets to print, 0 means all
"blkverbose" TRUE=>print all lines, FALSE=>skip duplicates
"blkbase" block output base
"blkfmt" block output format
"lib_debug" calc library script debug level
"calc_debug" internal calc debug level
"user_debug" user defined debug level
The "all" config value allows one to save/restore the configuration
@@ -90,6 +97,8 @@ Configuration parameters
8: the opcodes for a new functions are displayed when the function
is successfully defined.
See also lib_debug, calc_debug and user_debug below for more debug levels.
The "display" parameter specifies the maximum number of digits after
the decimal point to be printed in real or exponential mode in
normal unformatted printing (print, strprint, fprint) or in
@@ -128,7 +137,6 @@ Configuration parameters
"oct" octal fractions
"bin" binary fractions
The "maxprint" parameter specifies the maximum number of elements to
be displayed when a matrix or list is printed. The initial value is 16.
@@ -172,7 +180,7 @@ Configuration parameters
Config ("tab") controls the printing of a tab before results
automatically displayed when working interactively. It does not
affect the printing by the functions print, printf, etc. The inital
affect the printing by the functions print, printf, etc. The initial
"tab" value is 1.
The "quomod", "quo", "mod", "sqrt", "appr", "cfappr", "cfsim", and
@@ -232,11 +240,11 @@ Configuration parameters
parameter is 0, so that, for example, if config("display") >= 2,
5/4 will print in "real" mode as 1.25.
The maxerr value controls how many scan errors are allowed
The maxscan value controls how many scan errors are allowed
before the compiling phase of a computation is aborted. The initial
value of "maxerr" is 20. Setting maxerr to 0 disables this feature.
value of "maxscan" is 20. Setting maxscan to 0 disables this feature.
The default prompt when in teractive mode is "> ". One may change
The default prompt when in interactive mode is "> ". One may change
this prompt to a more cut-and-paste friendly prompt by:
config("prompt", "; ")
@@ -250,6 +258,121 @@ Configuration parameters
config("more", ";; ")
The "blkmaxprint" config value limits the number of octets to print
for a block. A "blkmaxprint" of 0 means to print all octets of a
block, regardless of size.
The default is to print only the first 256 octets.
The "blkverbose" determines if all lines, including duplicates
should be printed. If TRUE, then all lines are printed. If false,
duplicate lines are skipped and only a "*" is printed in a style
similar to od. This config value has not meaning if "blkfmt" is "str".
The default value for "blkverbose" is FALSE: duplicate lines are
not printed.
The "blkbase" determines the base in which octets of a block
are printed. Possible values are:
"hexadecimal" Octets printed in 2 digit hex
"hex"
"octal" Octets printed in 3 digit octal
"oct"
"character" Octets printed as chars with non-printing
"char" chars as \123 or \n, \t, \r
"binary" Octets printed as 0 or 1 chars
"bin"
"raw" Octets printed as is, i.e. raw binary
"none"
The default "blkbase" is "hex".
The "blkfmt" determines for format of how block are printed:
"line" print in lines of up to 79 chars + newline
"lines"
"str" print as one long string
"string"
"strings"
"od" print in od-like format, with leading offset,
"odstyle" followed by octets in the given base
"od_style"
"hd" print in hex dump format, with leading offset,
"hdstyle" followed by octets in the given base, followed
"hd_style" by chars or '.' if no-printable or blank
The default "blkfmt" is "hd".
With regards to "lib_debug", "calc_debug" and "user_debug":
higher absolute values result in more detailed debugging and
more verbose debug messages. The default value is 0 in which
a very amount of debugging will be performed with nil messages.
The -1 value is reserved for no debugging or messages. Any
value <-1 will perform debugging silently (presumably collecting
data to be displayed at a later time). Values >0 result in a
greater degree of debugging and more verbose messages.
The "lib_debug" is reserved by convention for calc library scripts.
This config parameter takes the place of the lib_debug global variable.
By convention, "lib_debug" has the following meanings:
<-1 no debug messages are printed though some internal
debug actions and information may be collected
-1 no debug messages are printed, no debug actions will be taken
0 only usage message regarding each important object are
printed at the time of the read (default)
>0 messages regarding each important object are
printed at the time of the read in addition
to other debug messages
The "calc_debug" is reserved by convention for internal calc routines.
The output of "calc_debug" will change from release to release.
Generally this value is used by calc wizards and by the regress.cal
routine (make check). By convention, "calc_debug" has the following
meanings:
<-1 reserved for future use
-1 no debug messages are printed, no debug actions will be taken
0 very little, if any debugging is performed (and then mostly
in alpha test code). The only output is as a result of
internal fatal errors (typically either math_error() or
exit() will be called). (default)
>0 a greater degree of debugging is performed and more
verbose messages are printed (regress.cal uses 1).
The "user_debug" is provided for use by users. Calc ignores this value
other than to set it to 0 by default (for both "oldstd" and "newstd").
No calc code or shipped library will change this value other than
during startup or during a config("all", xyz) call.
The following is suggested as a convention for use of "user_debug".
These are only suggestions: feel free to use it as you like:
<-1 no debug messages are printed though some internal
debug actions and information may be collected
-1 no debug messages are printed, no debug actions will be taken
0 very little, if any debugging is performed. The only output
are from fatal errors. (default)
>0 a greater degree of debugging is performed and more
verbose messages are printed
The following are synonyms for true:
"on" "yes" "y" "true" "t" "1" any non-zero number

6
help/conj
View File

@@ -14,6 +14,7 @@ TYPES
return real, complex, or matrix
DESCRIPTION
For real x, conj(x) returns x.
For complex x, conj(x) returns re(x) - im(x) * 1i.
@@ -21,6 +22,11 @@ DESCRIPTION
For matrix x, conj(x) returns a matrix of the same structure as x
in which each element t of x has been replaced by conj(t).
For xx objects, xx_conj(a) may return any type of value, but
for the properties usually expected of conjugates, xx_conj(a)
would return an xx object in which each number component is the
conjugate of the corresponding component of a.
EXAMPLE
> print conj(3), conj(3 + 4i)
3 3-4i

48
help/contrib Normal file
View File

@@ -0,0 +1,48 @@
We welcome and encourage you to send us:
* calc scripts
* any builtin functions that you have modified or written
* custom functions that you have modified or written
* any other source code modifications
Prior to doing so, you should consider trying your changes on the most
recent alpha test code. To obtain the most recent code, look under
http://reality.sgi.com/chongo/calc/
You should also consider joining the calc testing group by sending a
request to:
calc-tester-request@postofc.corp.sgi.com
Your message body (not the subject) should consist of:
subscribe calc-tester address
end
name your_full_name
where "address" is your EMail address and "your_full_name"
is your full name.
In order to consider integrating your code, we need:
* help files (documentation)
* CHANGES text (brief description of what it does)
* regress.cal test (to test non-custom code)
* your source code and/or source code changes (:-))
The best way to send us new code, if your changes are small, is
via a patch (diff -c from the latest alpha code to your code).
If your change is large, you should send entire files (either
as a diff -c /dev/null your-file patch, or as a uuencoded and
gziped (or compressed) tar file).
You should send submissions to:
calc-tester@postofc.corp.sgi.com
Thanks for considering submitting code to calc. Calc is a collective
work by a number of people. It would not be what it is today without
your efforts and submissions!
Landon Curt Noll <chongo@toad.com> /\oo/\

2
help/cos
View File

@@ -26,7 +26,7 @@ EXAMPLE
.5 0 -1
LIMITS
eps > 0
none
LIBRARY
NUMBER *qcos(NUMBER *x, NUMBER *eps)

3
help/cosh
View File

@@ -21,8 +21,7 @@ EXAMPLE
1.54308 1.5430806348 1.543080634815244 1.54308063481524377848
LIMITS
unlike sin and cos, x must be real
eps > 0
none
LIBRARY
NUMBER *qcosh(NUMBER *x, NUMBER *eps)

6
help/cot
View File

@@ -19,12 +19,10 @@ EXAMPLE
.64209 .6420926159 .642092615934331 .64209261593433070301
LIMITS
unlike sin and cos, x must be real
x != 0
eps > 0
none
LIBRARY
NUMBER *qcot(NUMBER *x, *eps)
NUMBER *qcot(NUMBER *x, NUMBER *eps)
SEE ALSO
sin, cos, tan, sec, csc, epsilon

4
help/coth
View File

@@ -21,9 +21,7 @@ EXAMPLE
1.31304 1.3130352855 1.313035285499331 1.31303528549933130364
LIMITS
unlike sin and cos, x must be real
x != 0
eps > 0
none
LIBRARY
NUMBER *qcoth(NUMBER *x, NUMBER *eps)

4
help/count
View File

@@ -8,7 +8,7 @@ TYPES
x list or matrix
y string
return int
return integer
DESCRIPTION
For count(x, y), y is to be the name of a user-defined function;
@@ -28,4 +28,4 @@ LIBRARY
none
SEE ALSO
XXX - fill in
select, modify

Some files were not shown because too many files have changed in this diff Show More