Compare commits

...

8 Commits

Author SHA1 Message Date
Landon Curt Noll
2c9b160dc5 Release calc version 2.11.0t10.4 2017-05-21 15:38:35 -07:00
Landon Curt Noll
fbd3a79eba Release calc version 2.11.0t10.3.1 2017-05-21 15:38:35 -07:00
Landon Curt Noll
025b5e58d6 Release calc version 2.11.0t10.3 2017-05-21 15:38:35 -07:00
Landon Curt Noll
160f4102ab Release calc version 2.11.0t10.2 2017-05-21 15:38:34 -07:00
Landon Curt Noll
306e031f03 Release calc version 2.11.0t10.1.4 2017-05-21 15:38:34 -07:00
Landon Curt Noll
6cfe9696ce Release calc version 2.11.0t10.1.3 2017-05-21 15:38:34 -07:00
Landon Curt Noll
97ed812cb9 Release calc version 2.11.0t10.1.2 2017-05-21 15:38:34 -07:00
Landon Curt Noll
6254c4a14c Release calc version 2.11.0t10.1.1 2017-05-21 15:38:34 -07:00
62 changed files with 2075 additions and 851 deletions

28
BUGS
View File

@@ -38,18 +38,12 @@ then it may be time to send in a bug report. You can send bug reports to:
When you send your report, please include the following information:
* a description of the problem
* the version of calc you are using (if you cannot get calc
it to run, then send us the 4 #define lines from version.c)
* if you modified calc from an official patch, send me the mods you made
* the type of system you were using
* the type of compiler you were using
* any compiler warnings or errors that you saw
* cd to the calc source directory, and type:
make debug > debug.out 2>&1 (sh, ksh, bash users)
@@ -112,12 +106,30 @@ Known bugs:
=-=
Other items of note:
Problems with known work-a-rounds:
* There is a bug in gcc-2.95 that causes calc, when compiled with -O2,
to fail the regression test. The work-a-round is to compile with -O
or to use gcc-2.96 or later.
* Solaris cc somtimes barfs while compiling zrand.c. In particular, calc
barfs on on the SVAL macro. The work-a-round is to use the Solaric cc
Makefile set sets -DFORCE_STDC. I.e,:
CCWARN=
CCOPT= ${DEBUG} ${NO_SHARED}
CCMISC= -DFORCE_STDC
#
CFLAGS= ${CCWARN} ${CCOPT} ${CCMISC}
ICFLAGS= ${CCWARN} ${CCMISC}
#
LCFLAGS=
LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED}
ILDFLAGS=
#
LCC= cc
CC= ${PURIFY} ${LCC}
* There is a bug in some versions of the Dec/Compaq cc for the Alpha
where the following:
@@ -156,4 +168,4 @@ Other items of note:
* The sparcv9 support for 64 bit Solaris under gcc-2.96 is able
to compile calc, but calc dumps core very early on in startup.
It is said that sparcv9 support in gcc-2.96 is very unofficial.
There is no work-a-round for this compile problem.
There is no work-a-round for this compiler problem.

94
CHANGES
View File

@@ -11,6 +11,100 @@ The following are the changes from calc version 2.11.0t10 to date:
used in combination with the GNU-readline facility, will prevent
it from saving empty lines.
Minor typos fixed in regress.cal
Added 8500 test serise and test8500.cal to perform more extensive
tests on // and % with various rounding modes.
The 'unused value ignored' messages now start with Line 999: instead
of just 999:.
Fixed the long standing issue first reported by Saber-C in the
domul() function in zmil.c thanks to a patch by Ernest Bowen
<ernie@turing.une.edu.au>.
Added zero dimensional matrices. A zero dimensional matrix is defined as:
mat A[] or A = mat[]
Updated the help/mat file to reflect the current status of matrices
including zero dimensional matrices.
Added indices() builtin function as written by Ernest Bowen
<ernie@turing.une.edu.au> developed from an idea of Klaus Seistrup
<klaus@seistrup.dk>. See help/indices for details.
Fixed a number of insure warnings as reported by Michel van der List
<vanderlistmj@sbphrd.com>.
Fixed a number of help file typos discovered by Klaus Alexander
Seistrup <klaus@seistrup.dk>.
Removed REGRESS_CAL as a Makefile variable.
Added calcliblist and calcliblistfmt utility Makefile rules to allow
one to print the list of distribution files that are used (but not
built) to form either the libcalc.a or the libcustcalc.a library.
Added a patch from Randall.Gray@marine.csiro.au to make ^D terminate,
but *only* if the line it is on is completely empty. Removed lib/altbind
and removed the CALCBINDINGS Makefile variable.
A new config("ctrl_d") value controls how the ``delete_char'', which
by default is bound to ^D (Control D), will or will not exit calc:
config("ctrl_d", "virgin_eof")
If ^D is the only character that has been typed on a line,
then calc will exit. Otherwise ^D will act according to the
calc binding, which by default is a Emacs-style delete-char.
This is the default mode.
config("ctrl_d", "never_eof")
The ^D never exits calc and only acts according calc binding,
which by default is a Emacs-style delete-char.
Emacs purists may want to set this in their ~/.calcrc startup file.
config("ctrl_d", "empty_eof")
The ^D always exits calc if typed on an empty line. This
condition occurs when ^D either the first character typed,
or when all other characters on the line have been removed
(say by deleting them).
Users who always want to exit when ^D is typed at the beginning
of a line may want to set this in their ~/.calcrc startup file.
Note that config("ctrl_d") apples to the character bound to each
and every ``delete_char''. So if an alternate binding it setup,
then those char(s) will have this functionality.
Updated help/config and help/mode, improved the readability and
fixed a few typos. Documented modes, block formats and block bases
("mode", "blkfmt" & "blkbase") that were previously left off out of
the documentation.
The config("blkbase") and config("blkfmt") values return strings
instead of returning integers. One cannot use integers to set
these values, so returning integers was useless.
The following config values return "on" or "off" strings:
tilde tab leadzero fullzero blkverbose verbose_quit
These config values can still be set with same boolean strings
("on", "off", "true", "false", "t", ...) as well as via the
numerical values 0 (for "off") and non-0 (for "on"), however.
Applied the dangling name fix from Ernest Bowen <ernie@turing.une.edu.au>.
Show func prints function on order of their indices, and with
config("lib_debug") & 4 == 4 some more details about the functions
are displayed.
The following are the changes from calc version 2.11.0t8.9.1 to 2.11.0t9.4.5:

View File

@@ -19,11 +19,6 @@ Installing calc in 4 easy steps:
As shipped the Makefile assumes 'more'. On your system
you may find 'less' to be a better pager.
The CALCBINDINGS is matter of personal taste. As shipped
the Makefile assumes a default quasi-emacs-like command
line editor. Changing CALCBINDINGS= altbind will cause ^D
to end calc in a fashion similar to that of the bc(1) command.
Set TOPDIR to be the place under which help files, calc,
include files and calc libs are to be installed. As shipped
the Makefile assumes a TOPDIR of /usr/local/lib.

View File

@@ -402,23 +402,11 @@ CALCPATH= .:./lib:~/lib:${LIBDIR}:${CUSTOMLIBDIR}
#
CALCRC= ${LIBDIR}/startup:~/.calcrc
# If the $CALCBINDINGS environment variable is not defined, then the following
# file will be used for the command line and edit history key bindings.
# The $CALCPATH will be used to search for this file.
#
# ${LIBDIR}/bindings uses ^D for editing
# ${LIBDIR}/altbind uses ^D for EOF
#
# NOTE: This facility is disabled if USE_READLINE is set to -DUSE_READLINE.
#
CALCBINDINGS= bindings
#CALCBINDINGS= altbind
# Determine of the GNU-readline facility will be used instead of the
# built-in CALCBINDINGS above.
# built-in calc binding method.
#
# USE_READLINE= Do not use GNU-readline, use CALCBINDINGS
# USE_READLINE= -DUSE_READLINE Use GNU-readline, do not use CALCBINDINGS
# USE_READLINE= Do not use GNU-readline, use calc bindings
# USE_READLINE= -DUSE_READLINE Use GNU-readline, do not use calc bindings
#
# NOTE: If you select the 'USE_READLINE= -DUSE_READLINE' mode, you must set:
#
@@ -957,15 +945,6 @@ UTIL_PROGS= align32 fposval have_uid_t longlong have_const \
have_ustat have_getsid have_getpgid \
have_gettime have_getprid ver_calc have_strdup
# These files are required by the regress.cal regression test.
#
REGRESS_CAL= ./lib/lucas_chk.cal ./lib/natnumset.cal ./lib/surd.cal \
./lib/test1700.cal ./lib/test2300.cal ./lib/test2600.cal \
./lib/test2700.cal ./lib/test3100.cal ./lib/test3300.cal \
./lib/test3400.cal ./lib/test3500.cal ./lib/test4000.cal \
./lib/test4100.cal ./lib/test4600.cal ./lib/test5100.cal \
./lib/test5200.cal
# The complete list of makefile vars passed down to custom/Makefile.
#
CUSTOM_PASSDOWN= Q="${Q}" \
@@ -1057,7 +1036,12 @@ C_SRC= ${LIBSRC} ${CALCSRC} ${UTIL_C_SRC}
# These files are found (but not built) in the distribution
#
DISTLIST= ${C_SRC} ${H_SRC} ${MAKE_FILE} BUGS CHANGES LIBRARY README \
calc.man lint.sed HOWTO.INSTALL ${UTIL_MISC_SRC}
calc.man lint.sed HOWTO.INSTALL ${UTIL_MISC_SRC}
# These files are used to make (but not built) a calc .a library
#
CALCLIBLIST= ${LIBSRC} ${UTIL_C_SRC} ${LIB_H_SRC} ${MAKE_FILE} \
${UTIL_MISC_SRC} BUGS CHANGES LIBRARY
# complete list of .o files
#
@@ -1074,7 +1058,7 @@ PROGS= calc ${UTIL_PROGS}
# complete list of targets
#
TARGETS= ${CALC_LIBS} custom/.all calc sample/sample \
lib/.all help/.all help/builtin calc.1
lib/.all help/.all help/builtin calc.1
###
@@ -1098,8 +1082,7 @@ calc.1: calc.man ${MAKE_FILE}
-rm -f calc.1
${SED} -e 's:$${LIBDIR}:${LIBDIR}:g' \
-e 's,$${CALCPATH},${CALCPATH},g' \
-e 's,$${CALCRC},${CALCRC},g' \
-e 's,$${CALCBINDINGS},${CALCBINDINGS},g' < calc.man > calc.1
-e 's,$${CALCRC},${CALCRC},g' < calc.man > calc.1
##
#
@@ -1114,8 +1097,7 @@ custom.o: custom.c ${MAKE_FILE}
${CC} ${CFLAGS} ${ALLOW_CUSTOM} -c custom.c
hist.o: hist.c ${MAKE_FILE}
${CC} ${CFLAGS} ${TERMCONTROL} ${USE_READLINE} ${READLINE_INCLUDE} \
-c hist.c
${CC} ${CFLAGS} ${TERMCONTROL} ${USE_READLINE} ${READLINE_INCLUDE} -c hist.c
func.o: func.c ${MAKE_FILE}
${CC} ${CFLAGS} ${ALLOW_CUSTOM} -c func.c
@@ -1164,11 +1146,6 @@ conf.h: ${MAKE_FILE}
${Q}echo '#define DEFAULTCALCRC "${CALCRC}"' >> conf.h
${Q}echo '#endif /* DEFAULTCALCRC */' >> conf.h
${Q}echo '' >> conf.h
${Q}echo '/* the default key bindings file */' >> conf.h
${Q}echo '#ifndef DEFAULTCALCBINDINGS' >> conf.h
${Q}echo '#define DEFAULTCALCBINDINGS "${CALCBINDINGS}"' >> conf.h
${Q}echo '#endif /* DEFAULTCALCBINDINGS */' >> conf.h
${Q}echo '' >> conf.h
${Q}echo '/* the location of the help directory */' >> conf.h
${Q}echo '#ifndef HELPDIR' >> conf.h
${Q}echo '#define HELPDIR "${HELPDIR}"' >> conf.h
@@ -2560,17 +2537,29 @@ distlist: ${DISTLIST}
${Q}(for i in ${DISTLIST}; do \
echo $$i; \
done; \
(cd help; ${MAKE} ${HELP_PASSDOWN} distlist); \
(cd lib; ${MAKE} ${LIB_PASSDOWN} distlist); \
(cd custom; ${MAKE} ${CUSTOM_PASSDOWN} distlist); \
(cd sample; ${MAKE} ${SAMPLE_PASSDOWN} distlist)) | ${SORT}
(cd help; ${MAKE} ${HELP_PASSDOWN} $@); \
(cd lib; ${MAKE} ${LIB_PASSDOWN} $@); \
(cd custom; ${MAKE} ${CUSTOM_PASSDOWN} $@); \
(cd sample; ${MAKE} ${SAMPLE_PASSDOWN} $@)) | ${SORT}
distdir:
${Q}(echo .; \
(cd help; ${MAKE} ${HELP_PASSDOWN} distdir); \
(cd lib; ${MAKE} ${LIB_PASSDOWN} distdir); \
(cd custom; ${MAKE} ${CUSTOM_PASSDOWN} distdir); \
(cd sample; ${MAKE} ${SAMPLE_PASSDOWN} distdir)) | ${SORT}
(cd help; ${MAKE} ${HELP_PASSDOWN} $@); \
(cd lib; ${MAKE} ${LIB_PASSDOWN} $@); \
(cd custom; ${MAKE} ${CUSTOM_PASSDOWN} $@); \
(cd sample; ${MAKE} ${SAMPLE_PASSDOWN} $@)) | ${SORT}
calcliblist:
${Q}(for i in ${CALCLIBLIST}; do \
echo $$i; \
done; \
(cd help; ${MAKE} ${HELP_PASSDOWN} $@); \
(cd lib; ${MAKE} ${LIB_PASSDOWN} $@); \
(cd custom; ${MAKE} ${CUSTOM_PASSDOWN} $@); \
(cd sample; ${MAKE} ${SAMPLE_PASSDOWN} $@)) | ${SORT}
calcliblistfmt:
${Q}${MAKE} calcliblist | ${FMT} -64 | ${SED} -e 's/^/ /'
##
#
@@ -2584,10 +2573,10 @@ distdir:
#
##
check: all ./lib/regress.cal ${REGRESS_CAL}
check: all ./lib/regress.cal
${CALC_ENV} ./calc -d -q read regress
chk: ./lib/regress.cal ${REGRESS_CAL}
chk: ./lib/regress.cal
${V} echo '=-=-=-=-= start of $@ rule =-=-=-=-='
${CALC_ENV} ./calc -d -q read regress 2>&1 | ${AWK} -f check.awk
${V} echo '=-=-=-=-= end of $@ rule =-=-=-=-='
@@ -2645,7 +2634,6 @@ env:
@echo "MANMAKE=${MANMAKE}"; echo ""
@echo "CALCPATH=${CALCPATH}"; echo ""
@echo "CALCRC=${CALCRC}"; echo ""
@echo "CALCBINDINGS=${CALCBINDINGS}"; echo ""
@echo "CALCPAGER=${CALCPAGER}"; echo ""
@echo "DEBUG=${DEBUG}"; echo ""
@echo "NO_SHARED=${NO_SHARED}"; echo ""
@@ -2691,7 +2679,6 @@ env:
@echo "UTIL_TMP=${UTIL_TMP}"; echo ""
@echo "UTIL_PROGS=${UTIL_PROGS}"; echo ""
@echo "LIB_H_SRC=${LIB_H_SRC}"; echo ""
@echo "REGRESS_CAL=${REGRESS_CAL}"; echo ""
@echo "CUSTOM_PASSDOWN=${CUSTOM_PASSDOWN}"; echo ""
@echo "SAMPLE_PASSDOWN=${SAMPLE_PASSDOWN}"; echo ""
@echo "HELP_PASSDOWN=${HELP_PASSDOWN}"; echo ""
@@ -2958,6 +2945,7 @@ install: calc libcalc.a ${LIB_H_SRC} ${BUILD_H_SRC} calc.1
-rm -f ${LIBDIR}/libcalcerr.a libcalcerr.a
-rm -f ${LIBDIR}/calc_errno.h calc_errno.h ${INCDIRCALC}/calc_errno.h
-rm -f calc_errno.c calc_errno.o calc_errno
-rm -f ${LIBDIR}/altbind ${HELPDIR}/altbind
${V} echo '=-=-=-=-= end of $@ rule =-=-=-=-='
##

88
addop.c
View File

@@ -22,6 +22,7 @@
static long maxopcodes; /* number of opcodes available */
static long newindex; /* index of new function */
static char *newname; /* name of new function */
static long oldop; /* previous opcode */
static long oldoldop; /* opcode before previous opcode */
static long debugline; /* line number of latest debug opcode */
@@ -61,26 +62,49 @@ initfunctions(void)
void
showfunctions(void)
{
FUNC **fpp; /* pointer into function table */
FUNC *fp; /* current function */
long count;
long index;
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");
if (conf->lib_debug & LIBDBG_FUNC_INFO)
math_str("Index\tName \tArgs\tOpcodes\n"
"-----\t------ \t---- \t------\n");
else
math_str("Name\tArguments\n"
"----\t---------\n");
for (index = 0; index < funccount; index++) {
fp = functions[index];
if (conf->lib_debug & LIBDBG_FUNC_INFO) {
math_fmt("%5ld\t%-12s\t", index,
namestr(&funcnames,index));
if (fp) {
count++;
math_fmt("%-5d\t%-5ld\n",
fp->f_paramcount, fp->f_opcodecount);
} else {
math_str("null\t0\n");
}
} else {
if (fp == NULL)
continue;
count++;
math_fmt("%-12s\t%-2d\n", namestr(&funcnames,
index), fp->f_paramcount);
}
printf("%-12s %-2d\n", fp->f_name, fp->f_paramcount);
}
}
if (count > 0) {
printf("\nNumber: %ld\n", count);
if (conf->lib_debug & LIBDBG_FUNC_INFO) {
math_fmt("\nNumber non-null: %ld\n", count);
math_fmt("Number null: %ld\n", funccount - count);
math_fmt("Total number: %ld\n", funccount);
} else {
printf("No user functions defined\n");
if (count > 0)
math_fmt("\nNumber: %ld\n", count);
else
math_str("No user functions defined\n");
}
}
@@ -115,7 +139,8 @@ beginfunc(char *name, BOOL newflag)
fp->f_opcodecount = 0;
fp->f_savedvalue.v_type = V_NULL;
fp->f_savedvalue.v_subtype = V_NOSUBTYPE;
fp->f_name = namestr(&funcnames, newindex);
newname = namestr(&funcnames, newindex);
fp->f_name = newname;
curfunc = fp;
initlocals();
initlabels();
@@ -142,10 +167,11 @@ endfunc(void)
addop(OP_UNDEF);
addop(OP_RETURN);
}
checklabels();
if (errorcount) {
freefunc(curfunc);
printf("\"%s\": %ld error%s\n", curfunc->f_name, errorcount,
printf("\"%s\": %ld error%s\n", newname, errorcount,
((errorcount == 1) ? "" : "s"));
return;
}
@@ -167,7 +193,7 @@ endfunc(void)
}
if ((inputisterminal() && conf->lib_debug & LIBDBG_STDIN_FUNC) ||
(!inputisterminal() && conf->lib_debug & LIBDBG_FILE_FUNC)) {
printf("%s(", fp->f_name);
printf("%s(", newname);
for (index = 0; index < fp->f_paramcount; index++) {
if (index)
putchar(',');
@@ -231,7 +257,7 @@ rmuserfunc(char *name)
index = findstr(&funcnames, name);
if (index < 0) {
printf("%s() has never been defined\n",
fprintf(stderr, "%s() has never been defined\n",
name);
return;
}
@@ -252,12 +278,25 @@ rmuserfunc(char *name)
void
freefunc(FUNC *fp)
{
long index;
long i;
if (fp == NULL)
return;
if (fp == curfunc) {
index = newindex;
} else {
for (index = 0; index < funccount; index++) {
if (functions[index] == fp)
break;
}
if (index == funccount) {
math_error("Bad call to freefunc!!!");
/*NOTREACHED*/
}
}
if (conf->traceflags & TRACE_FNCODES) {
printf("Freeing function \"%s\"\n", fp->f_name);
printf("Freeing function \"%s\"\n",namestr(&funcnames,index));
dumpnames = FALSE;
for (i = 0; i < fp->f_opcodecount; ) {
printf("%ld: ", i);
@@ -273,12 +312,14 @@ freefunc(FUNC *fp)
void
rmalluserfunc(void)
{
FUNC **fpp;
FUNC *fp;
long index;
for (fpp = functions; fpp < &functions[funccount]; fpp++) {
if (*fpp) {
freefunc(*fpp);
*fpp = NULL;
for (index = 0; index < funccount; index++) {
fp = functions[index];
if (fp) {
freefunc(fp);
functions[index] = NULL;
}
}
}
@@ -462,7 +503,8 @@ addop(long op)
fp->f_opcodecount -= diff;
oldop = OP_NOP;
oldoldop = OP_NOP;
fprintf(stderr, "%ld: unused value ignored\n",
fprintf(stderr,
"Line %ld: unused value ignored\n",
linenumber());
return;
}

View File

@@ -47,8 +47,8 @@ associndex(ASSOC *ap, BOOL create, long dim, VALUE *indices)
QCKHASH hash;
int i;
if (dim <= 0) {
math_error("No dimensions for indexing association");
if (dim < 0) {
math_error("Negative dimension for indexing association");
/*NOTREACHED*/
}
@@ -217,6 +217,27 @@ assocfindex(ASSOC *ap, long index)
}
/*
* Returns the list of indices for an association element with specified
* double-bracket index.
*/
LIST *
associndices(ASSOC *ap, long index)
{
ASSOCELEM *ep;
LIST *lp;
int i;
ep = elemindex(ap, index);
if (ep == NULL)
return NULL;
lp = listalloc();
for (i = 0; i < ep->e_dim; i++)
insertlistlast(lp, &ep->e_indices[i]);
return lp;
}
/*
* Compare two associations to see if they are identical.
* Returns TRUE if they are different.

3
calc.h
View File

@@ -22,10 +22,11 @@
*/
#define CALCPATH "CALCPATH" /* environment variable for files */
#define CALCRC "CALCRC" /* environment variable for startup */
#define CALCBINDINGS "CALCBINDINGS" /* environment variable for hist bindings */
#define CALCBINDINGS "CALCBINDINGS" /* env variable for hist bindings */
#define HOME "HOME" /* environment variable for home dir */
#define PAGER "PAGER" /* environment variable for help */
#define SHELL "SHELL" /* environment variable for shell */
#define DEFAULTCALCBINDINGS "bindings" /* default calc bindings file */
#define DEFAULTCALCHELP "help" /* help file that -h prints */
#define DEFAULTSHELL "sh" /* default shell to use */
#define CALCEXT ".cal" /* extension for files read in */

View File

@@ -555,9 +555,10 @@ line, or \fI\-m\fP disallows opening files for reading),
reads
key bindings from the filename specified
by this environment variable.
.br
The key binding file is searched for along the $CALCPATH list
of directories.
.sp
Default value: ${CALCBINDINGS}
Default value: binding
.sp
This variable is not used if calc was compiled with GNU-readline support.
In that case, the standard readline mechanisms (see readline(3)) are used.

View File

@@ -336,3 +336,5 @@ 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
E_INDICES1 Bad first argument type for indices
E_INDICES2 Bad second argument for indices

111
codegen.c
View File

@@ -1135,6 +1135,21 @@ getonematrix(int symtype)
}
rescantoken();
if (gettoken() == T_LEFTPAREN) {
if (isrvalue(getexprlist())) {
scanerror(T_SEMICOLON, "Lvalue expected");
return;
}
if (gettoken() != T_RIGHTPAREN) {
scanerror(T_SEMICOLON, "Missing right parenthesis");
return;
}
getonematrix(symtype);
addop(OP_ASSIGN);
return;
}
rescantoken();
if (gettoken() != T_LEFTBRACKET) {
rescantoken();
scanerror(T_SEMICOLON, "Left-bracket expected");
@@ -1150,23 +1165,32 @@ getonematrix(int symtype)
* will patch the correct value back into the opcode.
*/
if (gettoken() == T_RIGHTBRACKET) {
clearopt();
patchpc = curfunc->f_opcodecount + 1;
addopone(OP_NUMBER, (long) -1);
clearopt();
addop(OP_ZERO);
addopone(OP_MATCREATE, dim);
addop(OP_ZERO);
addop(OP_INITFILL);
count = 0;
if (gettoken() == T_ASSIGN)
if (gettoken() == T_ASSIGN) {
clearopt();
patchpc = curfunc->f_opcodecount + 1;
addopone(OP_NUMBER, (long) -1);
clearopt();
addop(OP_ZERO);
addopone(OP_MATCREATE, dim);
addop(OP_ZERO);
addop(OP_INITFILL);
count = 0;
count = getinitlist();
else
index = addqconstant(itoq(count));
if (index < 0)
math_error("Cannot allocate constant");
curfunc->f_opcodes[patchpc] = index;
return;
}
rescantoken();
addopone(OP_MATCREATE, 0);
if (gettoken() == T_LEFTBRACKET) {
creatematrix();
} else {
rescantoken();
index = addqconstant(itoq(count));
if (index < 0)
math_error("Cannot allocate constant");
curfunc->f_opcodes[patchpc] = index;
addop(OP_ZERO);
}
addop(OP_INITFILL);
return;
}
@@ -1186,41 +1210,45 @@ creatematrix(void)
{
long dim;
dim = 1;
dim = 0;
while (TRUE) {
for (;;) {
if (gettoken() == T_RIGHTBRACKET) {
addopone(OP_MATCREATE, dim);
if (gettoken() == T_LEFTBRACKET) {
creatematrix();
} else {
rescantoken();
addop(OP_ZERO);
}
addop(OP_INITFILL);
return;
}
rescantoken();
if (++dim > MAXDIM) {
scanerror(T_SEMICOLON, "Only %ld dimensions allowed", MAXDIM);
return;
}
(void) getopassignment();
switch (gettoken()) {
case T_RIGHTBRACKET:
case T_COMMA:
rescantoken();
case T_COMMA:
addop(OP_ONE);
addop(OP_SUB);
addop(OP_ZERO);
break;
case T_COLON:
(void) getopassignment();
break;
switch(gettoken()) {
case T_RIGHTBRACKET:
rescantoken();
case T_COMMA:
continue;
}
/*FALLTHRU*/
default:
rescantoken();
}
switch (gettoken()) {
case T_RIGHTBRACKET:
addopone(OP_MATCREATE, dim);
if (gettoken() == T_LEFTBRACKET) {
creatematrix();
} else {
rescantoken();
addop(OP_ZERO);
}
addop(OP_INITFILL);
return;
case T_COMMA:
if (++dim <= MAXDIM)
break;
scanerror(T_SEMICOLON, "Only %ld dimensions allowed", MAXDIM);
return;
default:
scanerror(T_SEMICOLON, "Illegal matrix definition");
return;
}
@@ -2191,8 +2219,14 @@ getmatargs(void)
* finds that the element will be referenced for writing, then
* it will call writeindexop to change the flag in the opcode.
*/
dim = 1;
dim = 0;
if (gettoken() == T_RIGHTBRACKET) {
addoptwo(OP_INDEXADDR, (long) dim, (long) FALSE);
return;
}
rescantoken();
for (;;) {
++dim;
(void) getopassignment();
switch (gettoken()) {
case T_RIGHTBRACKET:
@@ -2200,7 +2234,6 @@ getmatargs(void)
(long) FALSE);
return;
case T_COMMA:
dim++;
break;
default:
rescantoken();

319
config.c
View File

@@ -56,6 +56,8 @@ NAMETYPE configs[] = {
{"calc_debug", CONFIG_CALC_DEBUG},
{"user_debug", CONFIG_USER_DEBUG},
{"verbose_quit",CONFIG_VERBOSE_QUIT},
{"ctrl_d", CONFIG_CTRL_D},
{"ctrl-d", CONFIG_CTRL_D}, /* alias for ctrl_d */
{NULL, 0}
};
@@ -97,7 +99,8 @@ CONFIG oldstd = { /* backward compatible standard configuration */
0, /* internal calc debug level */
3, /* calc library debug level */
0, /* user defined debug level */
TRUE /* print Quit or abort executed messages */
TRUE, /* print Quit or abort executed messages */
CTRL_D_VIRGIN /* ^D only exits on virgin lines */
};
CONFIG newstd = { /* new non-backward compatible configuration */
MODE_INITIAL, /* current output mode */
@@ -133,7 +136,8 @@ CONFIG newstd = { /* new non-backward compatible configuration */
0, /* internal calc debug level */
3, /* calc library debug level */
0, /* user defined debug level */
TRUE /* print Quit or abort executed messages */
TRUE, /* print Quit or abort executed messages */
CTRL_D_VIRGIN /* ^D only exits on virgin lines */
};
CONFIG *conf = NULL; /* loaded in at startup - current configuration */
@@ -142,11 +146,15 @@ CONFIG *conf = NULL; /* loaded in at startup - current configuration */
* Possible output modes.
*/
static NAMETYPE modes[] = {
{"fraction", MODE_FRAC},
{"frac", MODE_FRAC},
{"decimal", MODE_FRAC},
{"dec", MODE_FRAC},
{"integer", MODE_INT},
{"int", MODE_INT},
{"real", MODE_REAL},
{"float", MODE_REAL},
{"default", MODE_INITIAL}, /* MODE_REAL */
{"scientific", MODE_EXP},
{"sci", MODE_EXP},
{"exp", MODE_EXP},
{"hexadecimal", MODE_HEX},
{"hex", MODE_HEX},
@@ -158,34 +166,13 @@ static NAMETYPE modes[] = {
};
/*
* Possible binary config state values
*/
static NAMETYPE truth[] = {
{"y", TRUE},
{"n", FALSE},
{"yes", TRUE},
{"no", FALSE},
{"set", TRUE},
{"unset", FALSE},
{"on", TRUE},
{"off", FALSE},
{"true", TRUE},
{"false", FALSE},
{"t", TRUE},
{"f", FALSE},
{"1", TRUE},
{"0", FALSE},
{NULL, 0}
};
/*
* Possible block base output modes
*/
static NAMETYPE blk_base[] = {
{"hexadecimal", BLK_BASE_HEX},
{"hex", BLK_BASE_HEX},
{"default", BLK_BASE_HEX},
{"octal", BLK_BASE_OCT},
{"oct", BLK_BASE_OCT},
{"character", BLK_BASE_CHAR},
@@ -202,17 +189,60 @@ static NAMETYPE blk_base[] = {
* Possible block output formats
*/
static NAMETYPE blk_fmt[] = {
{"line", BLK_FMT_LINE},
{"lines", BLK_FMT_LINE},
{"str", BLK_FMT_STRING},
{"string", BLK_FMT_STRING},
{"line", BLK_FMT_LINE},
{"strings", BLK_FMT_STRING},
{"od", BLK_FMT_OD_STYLE},
{"odstyle", BLK_FMT_OD_STYLE},
{"string", BLK_FMT_STRING},
{"str", BLK_FMT_STRING},
{"od_style", BLK_FMT_OD_STYLE},
{"hd", BLK_FMT_HD_STYLE},
{"hdstyle", BLK_FMT_HD_STYLE},
{"odstyle", BLK_FMT_OD_STYLE},
{"od", BLK_FMT_OD_STYLE},
{"hd_style", BLK_FMT_HD_STYLE},
{"hdstyle", BLK_FMT_HD_STYLE},
{"hd", BLK_FMT_HD_STYLE},
{"default", BLK_FMT_HD_STYLE},
{NULL, 0}
};
/*
* Possible ctrl_d styles
*/
static NAMETYPE ctrl_d[] = {
{"virgin_eof", CTRL_D_VIRGIN},
{"virgineof", CTRL_D_VIRGIN},
{"virgin", CTRL_D_VIRGIN},
{"default", CTRL_D_VIRGIN},
{"never_eof", CTRL_D_EMACS},
{"nevereof", CTRL_D_EMACS},
{"never", CTRL_D_EMACS},
{"empty_eof", CTRL_D_EOF},
{"emptyeof", CTRL_D_EOF},
{"empty", CTRL_D_EOF},
{NULL, 0}
};
/*
* Possible binary config state values
*/
#define TRUE_STRING "on"
#define FALSE_STRING "off"
static NAMETYPE truth[] = {
{TRUE_STRING, TRUE},
{"true", TRUE},
{"t", TRUE},
{"yes", TRUE},
{"y", TRUE},
{"set", TRUE},
{"1", TRUE},
{FALSE_STRING, FALSE},
{"false", FALSE},
{"f", FALSE},
{"no", FALSE},
{"n", FALSE},
{"unset", FALSE},
{"0", FALSE},
{NULL, 0}
};
@@ -220,11 +250,8 @@ static NAMETYPE blk_fmt[] = {
/*
* 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);
static long lookup_long(NAMETYPE *set, char *name);
static char *lookup_name(NAMETYPE *set, long val);
/*
@@ -249,18 +276,21 @@ configtype(char *name)
/*
* Given the name of a mode, convert it to the internal format.
* Returns -1 if the string is unknown.
* lookup_long - given a name and a NAMETYPE, return the int
*
* given:
* name mode name
* set the NAMESET array of name/int pairs
* name mode name
*
* returns:
* numeric value of the name or -1 if not found
*/
static int
modetype(char *name)
static long
lookup_long(NAMETYPE *set, char *name)
{
NAMETYPE *cp; /* current config pointer */
for (cp = modes; cp->name; cp++) {
for (cp = set; cp->name; cp++) {
if (strcmp(cp->name, name) == 0)
return cp->type;
}
@@ -269,78 +299,22 @@ modetype(char *name)
/*
* Given the name of a block output base, convert it to the internal format.
* Returns -1 if the string is unknown.
* lookup_name - given numeric value and a NAMETYPE, return the name
*
* 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.
* set the NAMESET array of name/int pairs
* val numeric value to lookup
*
* 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.
*
* given:
* name mode name
*/
static int
truthtype(char *name)
{
NAMETYPE *cp; /* current config pointer */
for (cp = truth; cp->name; cp++) {
if (strcmp(cp->name, name) == 0)
return cp->type;
}
return -1;
}
/*
* Given the mode type, convert it to a string representing that mode.
* Where there are multiple strings representing the same mode, the first
* one in the table is used. Returns NULL if the node type is unknown.
* The returned string cannot be modified.
* returns:
* name of the value found of NULL
*/
static char *
modename(int type)
lookup_name(NAMETYPE *set, long val)
{
NAMETYPE *cp; /* current config pointer */
for (cp = modes; cp->name; cp++) {
if (type == cp->type)
for (cp = set; cp->name; cp++) {
if (val == cp->type)
return cp->name;
}
return NULL;
@@ -417,7 +391,7 @@ setconfig(int type, VALUE *vp)
math_error("Non-string for mode");
/*NOTREACHED*/
}
temp = modetype(vp->v_str->s_str);
temp = lookup_long(modes, vp->v_str->s_str);
if (temp < 0) {
math_error("Unknown mode \"%s\"", vp->v_str);
/*NOTREACHED*/
@@ -526,7 +500,7 @@ setconfig(int type, VALUE *vp)
q = vp->v_num;
conf->tilde_ok = !qiszero(q);
} else if (vp->v_type == V_STR) {
temp = truthtype(vp->v_str->s_str);
temp = lookup_long(truth, vp->v_str->s_str);
if (temp < 0) {
math_error("Illegal truth value for tilde");
/*NOTREACHED*/
@@ -540,7 +514,7 @@ 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->s_str);
temp = lookup_long(truth, vp->v_str->s_str);
if (temp < 0) {
math_error("Illegal truth value for tab");
/*NOTREACHED*/
@@ -680,7 +654,7 @@ 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->s_str);
temp = lookup_long(truth, vp->v_str->s_str);
if (temp < 0) { {
math_error("Illegal truth value for leadzero");
/*NOTREACHED*/
@@ -695,7 +669,7 @@ 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->s_str);
temp = lookup_long(truth, vp->v_str->s_str);
if (temp < 0) { {
math_error("Illegal truth value for fullzero");
/*NOTREACHED*/
@@ -772,7 +746,7 @@ setconfig(int type, VALUE *vp)
q = vp->v_num;
conf->blkverbose = !qiszero(q);
} else if (vp->v_type == V_STR) {
temp = truthtype(vp->v_str->s_str);
temp = lookup_long(truth, vp->v_str->s_str);
if (temp < 0) {
math_error("Illegal truth value for blkverbose");
/*NOTREACHED*/
@@ -786,7 +760,7 @@ setconfig(int type, VALUE *vp)
math_error("Non-string for blkbase");
/*NOTREACHED*/
}
temp = blkbase(vp->v_str->s_str);
temp = lookup_long(blk_base, vp->v_str->s_str);
if (temp < 0) {
math_error("Unknown mode \"%s\" for blkbase",
vp->v_str->s_str);
@@ -800,7 +774,7 @@ setconfig(int type, VALUE *vp)
math_error("Non-string for blkfmt");
/*NOTREACHED*/
}
temp = blkfmt(vp->v_str->s_str);
temp = lookup_long(blk_fmt, vp->v_str->s_str);
if (temp < 0) {
math_error("Unknown mode \"%s\" for blkfmt",
vp->v_str->s_str);
@@ -856,9 +830,9 @@ setconfig(int type, VALUE *vp)
q = vp->v_num;
conf->verbose_quit = !qiszero(q);
} else if (vp->v_type == V_STR) {
temp = truthtype(vp->v_str->s_str);
temp = lookup_long(truth, vp->v_str->s_str);
if (temp < 0) {
math_error("Illegal truth value"
math_error("Illegal truth value "
"for verbose_quit");
/*NOTREACHED*/
}
@@ -866,6 +840,20 @@ setconfig(int type, VALUE *vp)
}
break;
case CONFIG_CTRL_D:
if (vp->v_type != V_STR) {
math_error("Non-string for ctrl_d");
/*NOTREACHED*/
}
temp = lookup_long(ctrl_d, vp->v_str->s_str);
if (temp < 0) {
math_error("Unknown mode \"%s\" for ctrl_d",
vp->v_str->s_str);
/*NOTREACHED*/
}
conf->ctrl_d = temp;
break;
default:
math_error("Setting illegal config parameter");
/*NOTREACHED*/
@@ -986,6 +974,7 @@ void
config_value(CONFIG *cfg, int type, VALUE *vp)
{
long i=0;
char *p;
/*
* firewall
@@ -1017,7 +1006,12 @@ config_value(CONFIG *cfg, int type, VALUE *vp)
case CONFIG_MODE:
vp->v_type = V_STR;
vp->v_str = makenewstring(modename(cfg->outmode));
p = lookup_name(modes, cfg->outmode);
if (p == NULL) {
math_error("invalid output mode: %d", cfg->outmode);
/*NOTREACHED*/
}
vp->v_str = makenewstring(p);
return;
case CONFIG_EPSILON:
@@ -1045,12 +1039,22 @@ config_value(CONFIG *cfg, int type, VALUE *vp)
break;
case CONFIG_TILDE:
i = cfg->tilde_ok;
break;
vp->v_type = V_STR;
if (cfg->tilde_ok) {
vp->v_str = makenewstring(TRUE_STRING);
} else {
vp->v_str = makenewstring(FALSE_STRING);
}
return;
case CONFIG_TAB:
i = cfg->tab_ok;
break;
vp->v_type = V_STR;
if (cfg->tab_ok) {
vp->v_str = makenewstring(TRUE_STRING);
} else {
vp->v_str = makenewstring(FALSE_STRING);
}
return;
case CONFIG_QUOMOD:
i = cfg->quomod;
@@ -1089,12 +1093,22 @@ config_value(CONFIG *cfg, int type, VALUE *vp)
break;
case CONFIG_LEADZERO:
i = cfg->leadzero;
break;
vp->v_type = V_STR;
if (cfg->leadzero) {
vp->v_str = makenewstring(TRUE_STRING);
} else {
vp->v_str = makenewstring(FALSE_STRING);
}
return;
case CONFIG_FULLZERO:
i = cfg->fullzero;
break;
vp->v_type = V_STR;
if (cfg->fullzero) {
vp->v_str = makenewstring(TRUE_STRING);
} else {
vp->v_str = makenewstring(FALSE_STRING);
}
return;
case CONFIG_MAXSCAN:
i = cfg->maxscancount;
@@ -1115,16 +1129,33 @@ config_value(CONFIG *cfg, int type, VALUE *vp)
break;
case CONFIG_BLKVERBOSE:
i = cfg->blkverbose;
break;
vp->v_type = V_STR;
if (cfg->blkverbose) {
vp->v_str = makenewstring(TRUE_STRING);
} else {
vp->v_str = makenewstring(FALSE_STRING);
}
return;
case CONFIG_BLKBASE:
i = cfg->blkbase;
break;
vp->v_type = V_STR;
p = lookup_name(blk_base, cfg->blkbase);
if (p == NULL) {
math_error("invalid block base: %d", cfg->blkbase);
/*NOTREACHED*/
}
vp->v_str = makenewstring(p);
return;
case CONFIG_BLKFMT:
i = cfg->blkfmt;
break;
vp->v_type = V_STR;
p = lookup_name(blk_fmt, cfg->blkfmt);
if (p == NULL) {
math_error("invalid block format: %d", cfg->blkfmt);
/*NOTREACHED*/
}
vp->v_str = makenewstring(p);
return;
case CONFIG_CALC_DEBUG:
i = cfg->calc_debug;
@@ -1139,8 +1170,23 @@ config_value(CONFIG *cfg, int type, VALUE *vp)
break;
case CONFIG_VERBOSE_QUIT:
i = cfg->verbose_quit;
break;
vp->v_type = V_STR;
if (cfg->verbose_quit) {
vp->v_str = makenewstring(TRUE_STRING);
} else {
vp->v_str = makenewstring(FALSE_STRING);
}
return;
case CONFIG_CTRL_D:
vp->v_type = V_STR;
p = lookup_name(ctrl_d, cfg->ctrl_d);
if (p == NULL) {
math_error("invalid Control-D: %d", cfg->ctrl_d);
/*NOTREACHED*/
}
vp->v_str = makenewstring(p);
return;
default:
math_error("Getting illegal CONFIG element");
@@ -1218,5 +1264,6 @@ config_cmp(CONFIG *cfg1, CONFIG *cfg2)
cfg1->calc_debug != cfg2->calc_debug ||
cfg1->lib_debug != cfg2->lib_debug ||
cfg1->user_debug != cfg2->user_debug ||
cfg1->verbose_quit != cfg2->verbose_quit;
cfg1->verbose_quit != cfg2->verbose_quit ||
cfg1->ctrl_d != cfg2->ctrl_d;
}

View File

@@ -81,6 +81,7 @@
#define CONFIG_CALC_DEBUG 31
#define CONFIG_USER_DEBUG 32
#define CONFIG_VERBOSE_QUIT 33
#define CONFIG_CTRL_D 34
/*
@@ -102,7 +103,9 @@
*
* quickhash.c - config_hash()
* hash.c - hash_value()
* config.c - setconfig(), config_value(), config_cmp()
* config.c - configs[], oldstd, newstd, setconfig(),
* config_value(), config_cmp()
* config.h - CONFIG_XYZ_SYMBOL (see above)
*/
struct config {
int outmode; /* current output mode */
@@ -139,6 +142,7 @@ struct config {
long lib_debug; /* library debug, see LIB_DEBUG_XXX below */
long user_debug; /* user defined debug value: 0 default */
BOOL verbose_quit; /* TRUE => print Quit or abort executed msg */
int ctrl_d; /* see CTRL_D_xyz below */
};
typedef struct config CONFIG;
@@ -148,7 +152,8 @@ typedef struct config CONFIG;
*/
#define LIBDBG_STDIN_FUNC (0x00000001) /* interactive func define debug */
#define LIBDBG_FILE_FUNC (0x00000002) /* file read func define debug */
#define LIBDBG_MASK (0x00000003)
#define LIBDBG_FUNC_INFO (0x00000004) /* print extra info for show func */
#define LIBDBG_MASK (0x00000007)
/*
@@ -162,6 +167,13 @@ typedef struct config CONFIG;
#define CALCDBG_RUNSTATE (0x00000020) /* report run_state changes */
#define CALCDBG_MASK (0x0000003f)
/*
* ctrl-d meanings
*/
#define CTRL_D_VIRGIN (0) /* ^D only exits on virgin command lines */
#define CTRL_D_EMACS (1) /* ^D never exits, emacs binding meaning only */
#define CTRL_D_EOF (2) /* ^D always exits at start of line */
/*
* global configuration states and aliases

View File

@@ -285,6 +285,10 @@ H_SRC= ${CUSTOM_H_SRC}
DISTLIST= ${CUSTCALC_SRC} ${CUSTOM_CALC_FILES} ${CUSTOM_HELP} \
${INSTALL_H_SRC} CUSTOM_CAL HOW_TO_ADD ${MAKE_FILE}
# These files are used to make (but not built) a calc .a library
#
CALCLIBLIST= ${CUSTCALC_SRC} ${INSTALL_H_SRC} ${MAKE_FILE} HOW_TO_ADD
# complete list of targets
#
TARGETS= libcustcalc.a ${CUSTCALC_OBJ}
@@ -352,6 +356,13 @@ distlist: ${DISTLIST}
distdir:
${Q}echo custom
calcliblist: ${CALCLIBLIST}
${Q}for i in ${CALCLIBLIST} /dev/null; do \
if [ X"$$i" != X"/dev/null" ]; then \
echo custom/$$i; \
fi; \
done
##
#
# Home grown make dependency rules. Your system make not support

50
func.c
View File

@@ -91,6 +91,8 @@ extern CONST char *error_table[E__COUNT+2]; /* calc coded error messages */
extern void matrandperm(MATRIX *M);
extern void listrandperm(LIST *lp);
extern int idungetc(FILEID id, int ch);
extern LIST* associndices(ASSOC *ap, long index);
extern LIST* matindices(MATRIX *mp, long index);
extern int stoponerror;
@@ -3558,7 +3560,7 @@ f_mattrans(VALUE *vp)
if (vp->v_type != V_MAT)
return error_value(E_MATTRANS1);
if (vp->v_mat->m_dim != 2)
if (vp->v_mat->m_dim > 2)
return error_value(E_MATTRANS2);
result.v_type = V_MAT;
result.v_mat = mattrans(vp->v_mat);
@@ -3569,15 +3571,8 @@ f_mattrans(VALUE *vp)
static VALUE
f_det(VALUE *vp)
{
MATRIX *m;
if (vp->v_type != V_MAT)
return error_value(E_DET1);
m = vp->v_mat;
if (m->m_dim != 2)
return error_value(E_DET2);
if ((m->m_max[0] - m->m_min[0]) != (m->m_max[1] - m->m_min[1]))
return error_value(E_DET3);
return matdet(vp->v_mat);
}
@@ -4464,6 +4459,36 @@ f_assoc(int count, VALUE **vals)
}
static VALUE
f_indices(VALUE *v1, VALUE *v2)
{
VALUE result;
LIST *lp;
if (v2->v_type != V_NUM || zge31b(v2->v_num->num))
return error_value(E_INDICES2);
switch (v1->v_type) {
case V_ASSOC:
lp = associndices(v1->v_assoc, qtoi(v2->v_num));
break;
case V_MAT:
lp = matindices(v1->v_mat, qtoi(v2->v_num));
break;
default:
return error_value(E_INDICES1);
}
result.v_type = V_NULL;
result.v_subtype = V_NOSUBTYPE;
if (lp) {
result.v_type = V_LIST;
result.v_list = lp;
}
return result;
}
static VALUE
f_listinsert(int count, VALUE **vals)
{
@@ -6756,17 +6781,16 @@ f_blk(int count, VALUE **vals)
int chunk; /* block chunk size */
VALUE result;
int id;
VALUE *vp;
VALUE *vp = NULL;
int type;
/* initialize VALUE */
result.v_type = V_BLOCK;
result.v_subtype = V_NOSUBTYPE;
vp = *vals;
type = 0;
result.v_subtype = V_NOSUBTYPE;
type = V_NULL;
if (count > 0) {
vp = *vals;
type = vp->v_type;
if (type == V_STR || type == V_NBLOCK || type == V_BLOCK) {
vals++;
@@ -7552,6 +7576,8 @@ static CONST struct builtin builtins[] = {
"integral log of a number base 2"},
{"im", 1, 1, 0, OP_IM, 0, 0,
"imaginary part of complex number"},
{"indices", 2, 2, 0, OP_NOP, 0, f_indices,
"indices of a specified assoc or mat value"},
{"inputlevel", 0, 0, 0, OP_NOP, 0, f_inputlevel,
"current input depth"},
{"insert", 2, IN, FA, OP_NOP, 0, f_listinsert,

72
hash.c
View File

@@ -39,6 +39,15 @@ extern void shs1_init_state(HASH*);
extern void MD5_init_state(HASH*);
/*
* hash_long can deal with BOOL's, int's, FLAGS's and LEN's
*/
#define hash_bool(type, val, state) (hash_long((type), (long)(val), (state)))
#define hash_int(type, val, state) (hash_long((type), (long)(val), (state)))
#define hash_flag(type, val, state) (hash_long((type), (long)(val), (state)))
#define hash_len(type, val, state) (hash_long((type), (long)(val), (state)))
/*
* hash_setup - setup the hash state for a given hash
*/
@@ -257,6 +266,9 @@ hash_final(HASH *state)
* This function will hash a long value as if it were a 64 bit value.
* The input is a long. If a long is smaller than 64 bits, we will
* hash a final 32 bits of zeros.
*
* This function is OK to hash BOOL's, unslogned long's, unsigned int's
* signed int's as well as FLAG's and LEN's.
*/
HASH *
hash_long(int type, long longval, HASH *state)
@@ -734,11 +746,10 @@ hash_value(int type, void *v, HASH *state)
(state->type)(value->v_type, state);
/* hash as if we have a 64 bit value */
state = hash_long(type, (long)value->v_int, state);
state = hash_int(type, value->v_int, state);
break;
case V_NUM:
/* hash this type */
state = hash_number(type, value->v_num, state);
break;
@@ -884,12 +895,12 @@ hash_value(int type, void *v, HASH *state)
(state->type)(value->v_type, state);
/* hash the RAND state */
state = hash_long(type, (long)value->v_rand->seeded, state);
state = hash_long(type, (long)value->v_rand->bits, state);
state = hash_int(type, value->v_rand->seeded, state);
state = hash_int(type, value->v_rand->bits, state);
(state->update)(state,
(USB8 *)value->v_rand->buffer, SLEN*FULL_BITS/8);
state = hash_long(type, (long)value->v_rand->j, state);
state = hash_long(type, (long)value->v_rand->k, state);
state = hash_int(type, value->v_rand->j, state);
state = hash_int(type, value->v_rand->k, state);
(state->update)(state,
(USB8 *)value->v_rand->slot, SCNT*FULL_BITS/8);
(state->update)(state,
@@ -903,8 +914,8 @@ hash_value(int type, void *v, HASH *state)
(state->type)(value->v_type, state);
/* hash the RANDOM state */
state = hash_long(type, (long)value->v_random->seeded, state);
state = hash_long(type, (long)value->v_random->bits, state);
state = hash_int(type, value->v_random->seeded, state);
state = hash_int(type, value->v_random->bits, state);
(state->update)(state,
(USB8 *)&(value->v_random->buffer), BASEB/8);
state = hash_zvalue(type, value->v_random->r, state);
@@ -918,20 +929,19 @@ hash_value(int type, void *v, HASH *state)
(state->type)(value->v_type, state);
/* hash the CONFIG state */
state = hash_long(type, (long)value->v_config->outmode, state);
state = hash_int(type, value->v_config->outmode, state);
state = hash_long(type,(long)value->v_config->outdigits, state);
state = hash_number(type, value->v_config->epsilon, state);
state = hash_long(type,
(long)value->v_config->epsilonprec, state);
state = hash_long(type,
(long)value->v_config->traceflags, state);
state = hash_flag(type, value->v_config->traceflags, state);
state = hash_long(type, (long)value->v_config->maxprint, state);
state = hash_long(type, (long)value->v_config->mul2, state);
state = hash_long(type, (long)value->v_config->sq2, state);
state = hash_long(type, (long)value->v_config->pow2, state);
state = hash_long(type, (long)value->v_config->redc2, state);
state = hash_long(type, (long)value->v_config->tilde_ok, state);
state = hash_long(type, (long)value->v_config->tab_ok, state);
state = hash_len(type, value->v_config->mul2, state);
state = hash_len(type, value->v_config->sq2, state);
state = hash_len(type, value->v_config->pow2, state);
state = hash_len(type, value->v_config->redc2, state);
state = hash_bool(type, value->v_config->tilde_ok, state);
state = hash_bool(type, value->v_config->tab_ok, state);
state = hash_long(type, (long)value->v_config->quomod, state);
state = hash_long(type, (long)value->v_config->quo, state);
state = hash_long(type, (long)value->v_config->mod, state);
@@ -941,28 +951,26 @@ hash_value(int type, void *v, HASH *state)
state = hash_long(type, (long)value->v_config->cfsim, state);
state = hash_long(type, (long)value->v_config->outround, state);
state = hash_long(type, (long)value->v_config->round, state);
state = hash_long(type, (long)value->v_config->leadzero, state);
state = hash_long(type, (long)value->v_config->fullzero, state);
state = hash_bool(type, value->v_config->leadzero, state);
state = hash_bool(type, value->v_config->fullzero, state);
state = hash_long(type,
(long)value->v_config->maxscancount, state);
state = hash_str(type, value->v_config->prompt1, state);
state->bytes = FALSE; /* as if just read words */
state = hash_str(type, value->v_config->prompt2, state);
state->bytes = FALSE; /* as if just read words */
state = hash_long(type,
(long)value->v_config->blkmaxprint, state);
state = hash_long(type,
(long)value->v_config->blkverbose, state);
state = hash_long(type,
(long)value->v_config->blkbase, state);
state = hash_long(type,
(long)value->v_config->blkfmt, state);
state = hash_int(type, value->v_config->blkmaxprint, state);
state = hash_bool(type, value->v_config->blkverbose, state);
state = hash_int(type, value->v_config->blkbase, state);
state = hash_int(type, value->v_config->blkfmt, state);
state = hash_long(type,
(long)value->v_config->lib_debug, state);
state = hash_long(type,
(long)value->v_config->calc_debug, state);
state = hash_long(type,
(long)value->v_config->user_debug, state);
state = hash_bool(type, value->v_config->verbose_quit, state);
state = hash_int(type, value->v_config->ctrl_d, state);
break;
case V_HASH:
@@ -971,11 +979,11 @@ hash_value(int type, void *v, HASH *state)
(state->type)(value->v_type, state);
/* hash the HASH state */
state = hash_long(type, (long)value->v_hash->type, state);
state = hash_long(type, (long)value->v_hash->bytes,state);
state = hash_long(type, (long)value->v_hash->base, state);
state = hash_long(type, (long)value->v_hash->chunksize, state);
state = hash_long(type, (long)value->v_hash->unionsize, state);
state = hash_int(type, value->v_hash->type, state);
state = hash_bool(type, value->v_hash->bytes,state);
state = hash_int(type, value->v_hash->base, state);
state = hash_int(type, value->v_hash->chunksize, state);
state = hash_int(type, value->v_hash->unionsize, state);
(state->update)(state,
value->v_hash->h_union.data, state->unionsize);
state->bytes = FALSE; /* as if reading words */

View File

@@ -67,7 +67,7 @@ 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
BLT_HELP_FILES_11= bindings custom_cal libcalc new_custom stdlib
STD_HELP_FILES_12= archive
@@ -104,16 +104,16 @@ BLT_HELP_FILES= ${BLT_HELP_FILES_3} ${BLT_HELP_FILES_5} \
# 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 calclevel 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 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 inputlevel insert int inverse iroot isassoc isatty isblk \
appr arg arrow asec asech asin asinh assign atan atan2 atanh avg base \
bit blk blkcpy blkfree blocks bround btrunc calclevel 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 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 indices inputlevel 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 \
@@ -147,6 +147,10 @@ DISTLIST= ${STD_HELP_FILES} ${DETAIL_HELP} ${MAKE_FILE} \
obj.file builtin.top builtin.end funclist.sed \
errorcodes.hdr errorcodes.sed
# These files are used to make (but not built) a calc .a library
#
CALCLIBLIST=
all: ${FULL_HELP_FILES} full ${DETAIL_HELP} ${DETAIL_CLONE} \
${SINGULAR_FILES} calc .all
@@ -171,18 +175,6 @@ bindings: ../lib/bindings
true; \
fi
altbind: ../lib/altbind
rm -f $@
cp ../lib/altbind $@
chmod 0444 $@
-@if [ -z "${Q}" ]; then \
echo ''; \
echo '=-=-= skipping the cat of help/$@ =-=-='; \
echo ''; \
else \
true; \
fi
stdlib: ../lib/README
rm -f $@
cp ../lib/README $@
@@ -395,6 +387,13 @@ distlist: ${DISTLIST}
distdir:
${Q}echo help
calcliblist:
${Q}for i in ${CALCLIBLIST} /dev/null; do \
if [ X"$$i" != X"/dev/null" ]; then \
echo help/$$i; \
fi; \
done
# The BSDI cdrom makefile expects all help files to be pre-built. This rule
# creats these fils so that the release can be shipped off to BSDI. You can
# ignore this rule.

View File

@@ -18,19 +18,46 @@ DESCRIPTION
The following convention is used to declare modes:
base config
value string
base equivalent
config("mode")'s
2 "binary" binary fractions
8 "octal" octal fractions
10 "real" decimal floating point
16 "hex" hexadecimal fractions
-10 "int" decimal integer
1/3 "frac" decimal fractions
1e20 "exp" decimal exponential
2 "binary" base 2 fractions
"bin"
For convenience, any non-integer value is assumed to mean "frac",
and any integer >= 2^64 is assumed to mean "exp".
8 "octal" base 8 fractions
"oct"
10 "real" base 10 floating point
"float"
"default"
-10 "integer" base 10 integers
"int"
16 "hexadecimal" base 16 fractions
"hex"
1/3 "fraction" base 10 fractions
"frac"
1e20 "scientific" base 10 scientific notation
"sci"
"exp"
For convenience, any non-integer value is assumed to mean base 10
fractions and any integer >= 2^64 is assumed to mean base 10
scientific notation.
These base() calls have the same meaning as config("mode", "fraction"):
base(1/3) base(0.1415) base(16/37)
These base() calls have the same meaning as config("mode", "scientific"):
base(1e20) base(2^64) base(2^8191-1)
However the base() function will only return one of the base values
lised in the table above.
EXAMPLE
> base()

View File

@@ -74,7 +74,7 @@ DESCRIPTION
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,
the current datalen and chunk-size for B. The current datalen,
chunksize and number of allocated octets for B may be changed by:
B = blk(B, newlen, newchunk).

View File

@@ -44,7 +44,7 @@ Configuration parameters
"lib_debug" controls library script debug information
"user_debug" for user defined debug information
"verbose_quit" TRUE=>print message on empty quit or abort
"ctrl_d" The interactive meaning of ^D (Control D)
The "all" config value allows one to save/restore the configuration
set of values. The return of:
@@ -82,6 +82,43 @@ Configuration parameters
startup files; newstd may also be established by invoking calc
with the flag -n.
The following are synonyms for true:
"on"
"true"
"t"
"yes"
"y"
"set"
"1"
any non-zero number
The following are synonyms for false:
"off"
"false"
"f"
"no"
"n"
"unset"
"0"
the number zero (0)
Examples of setting some parameters are:
config("mode", "exp"); exponential output
config("display", 50); 50 digits of output
epsilon(epsilon() / 8); 3 bits more accuracy
config("tilde", 0) disable roundoff tilde printing
config("tab", "off") disable leading tab printing
Detailed config descriptions
=-=
config("trace", bitflag)
When nonzero, the "trace" parameter activates one or more features
that may be useful for debugging. These features correspond to
powers of 2 which contribute additively to config("trace"):
@@ -101,6 +138,10 @@ Configuration parameters
See also lib_debug, calc_debug and user_debug below for more debug levels.
=-=
config("display", int)
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
@@ -112,6 +153,11 @@ Configuration parameters
display up to d decimal places, the type of rounding to be used is
controlled by config("outround").
=-=
config("epsilon", real)
epsilon(real)
The "epsilon" parameter specifies the default accuracy for the
calculation of functions for which exact values are not possible or
not desired. For most functions, the
@@ -130,22 +176,58 @@ Configuration parameters
For the transcendental functions and the functions sqrt() and
appr(), the calculated value is always a multiple of epsilon.
=-=
config("mode", "mode_string")
The "mode" parameter is a string specifying the mode for printing of
numbers by the unformatted print functions, and the default
("%d" specifier) for formatted print functions. The initial mode
is "real". The available modes are:
"frac" decimal fractions
"int" decimal integer
"real" decimal floating point
"exp" decimal exponential
"hex" hex fractions
"oct" octal fractions
"bin" binary fractions
config("mode") meaning equivalent
string base() call
"binary" base 2 fractions base(2)
"bin"
"octal" base 8 fractions base(8)
"oct"
"real" base 10 floating point base(10)
"float"
"default"
"integer" base 10 integer base(-10)
"int"
"hexadecimal" base 16 fractions base(16)
"hex"
"fraction" base 10 fractions base(1/3)
"frac"
"scientific" base 10 scientific notation base(1e20)
"sci"
"exp"
Where multiple strings are given, the first string listed is what
config("mode") will return.
The default "mode" is "real".
=-=
config("maxprint", int)
The "maxprint" parameter specifies the maximum number of elements to
be displayed when a matrix or list is printed. The initial value is 16.
=-=
config("mul2", int)
config("sq2", int)
Mul2 and sq2 specify the sizes of numbers at which calc switches
from its first to its second algorithm for multiplying and squaring.
The first algorithm is the usual method of cross multiplying, which
@@ -163,6 +245,10 @@ Configuration parameters
the parameter back to its default value. Usually there is no need
to change these parameters.
=-=
config("pow2", int)
Pow2 specifies the sizes of numbers at which calc switches from
its first to its second algorithm for calculating powers modulo
another number. The first algorithm for calculating modular powers
@@ -171,6 +257,10 @@ Configuration parameters
which avoids divisions. The argument for pow2 is the size of the
modulus at which the second algorithm begins to be used.
=-=
config("redc2", int)
Redc2 specifies the sizes of numbers at which calc switches from
its first to its second algorithm when using the REDC algorithm.
The first algorithm performs a multiply and a modular reduction
@@ -179,16 +269,36 @@ Configuration parameters
O(N^1.585). The argument for redc2 is the size of the modulus at
which the second algorithm begins to be used.
=-=
config("tilde", boolean)
Config("tilde") controls whether or not a leading tilde ('~') is
printed to indicate that a number has not been printed exactly
because the number of decimal digits required would exceed the
specified maximum number. The initial "tilde" value is 1.
=-=
config("tab", boolean)
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 initial
"tab" value is 1.
=-=
config("quomod", bitflag)
config("quo", bitflag)
config("mod", bitflag)
config("sqrt", bitflag)
config("appr", bitflag)
config("cfappr", bitflag)
config("cfsim", bitflag)
config("outround", bitflag)
config("round", bitflag)
The "quomod", "quo", "mod", "sqrt", "appr", "cfappr", "cfsim", and
"round" control the way in which any necessary rounding occurs.
Rounding occurs when for some reason, a calculated or displayed
@@ -234,11 +344,19 @@ Configuration parameters
by the various kinds of printing to the output: bits 0, 1, 3 and 4
are used in the same way as for the functions round and bround.
=-=
config("leadzero", bool)
The "leadzero" parameter controls whether or not a 0 is printed
before the decimal point in non-zero fractions with absolute value
less than 1, e.g. whether 1/2 is printed as 0.5 or .5. The
initial value is 0, corresponding to the printing .5.
=-=
config("fullzero", bool)
The "fullzero" parameter controls whether or not in decimal floating-
point printing, the digits are padded with zeros to reach the
number of digits specified by config("display") or by a precision
@@ -246,10 +364,18 @@ Configuration parameters
parameter is 0, so that, for example, if config("display") >= 2,
5/4 will print in "real" mode as 1.25.
=-=
config("maxscan", int)
The maxscan value controls how many scan errors are allowed
before the compiling phase of a computation is aborted. The initial
value of "maxscan" is 20. Setting maxscan to 0 disables this feature.
=-=
config("prompt", str)
The default prompt when in interactive mode is "> ". One may change
this prompt to a more cut-and-paste friendly prompt by:
@@ -259,17 +385,29 @@ Configuration parameters
cut/copy an input line and paste it directly into input. The
leading ';' will be ignored.
=-=
config("more", str)
When inside multi-line input, the more prompt is used. One may
change it by:
config("more", ";; ")
=-=
config("blkmaxprint", int)
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.
=-=
config("blkverbose", bool)
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
@@ -278,11 +416,16 @@ Configuration parameters
The default value for "blkverbose" is FALSE: duplicate lines are
not printed.
=-=
config("blkbase", "blkbase_string")
The "blkbase" determines the base in which octets of a block
are printed. Possible values are:
"hexadecimal" Octets printed in 2 digit hex
"hex"
"default"
"octal" Octets printed in 3 digit octal
"oct"
@@ -296,26 +439,41 @@ Configuration parameters
"raw" Octets printed as is, i.e. raw binary
"none"
The default "blkbase" is "hex".
Where multiple strings are given, the first string listed is what
config("blkbase") will return.
The default "blkbase" is "hexadecimal".
=-=
config("blkfmt", "blkfmt_string")
The "blkfmt" determines for format of how block are printed:
"line" print in lines of up to 79 chars + newline
"lines"
"lines" print in lines of up to 79 chars + newline
"line"
"str" print as one long string
"strings" print as one long string
"string"
"strings"
"str"
"od" print in od-like format, with leading offset,
"od_style" print in od-like format, with leading offset,
"odstyle" followed by octets in the given base
"od_style"
"od"
"hd" print in hex dump format, with leading offset,
"hd_style" 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
"hd" by chars or '.' if no-printable or blank
"default"
The default "blkfmt" is "hd".
Where multiple strings are given, the first string listed is what
config("blkfmt") will return.
The default "blkfmt" is "hd_style".
=-=
config("calc_debug", bitflag)
The "calc_debug" is intended for controlling internal calc routines
that test its operation, or collect or display information that
@@ -352,6 +510,10 @@ Configuration parameters
By default, "calc_debug" is 0. The initial value may be overridden
by the -D command line option.
=-=
config("lib_debug", bitflag)
The "lib_debug" parameter is intended for controlling the possible
display of special information relating to functions, objects, and
other structures created by instructions in calc scripts.
@@ -369,6 +531,9 @@ Configuration parameters
the reading of a file, a message saying what has been done
is displayed.
2 Show func will display more information about a functions
arguments as well as more argument sdummary information.
The value for config("lib_debug") in both oldstd and newstd is 3,
but if calc is invoked with the -d flag, its initial value is zero.
Thus, if calc is started without the -d flag, until config("lib_debug")
@@ -378,6 +543,10 @@ Configuration parameters
By default, "lib_debug" is 3. The -d flag changes this default to 0.
The initial value may be overridden by the -D command line option.
=-=
config("user_debug", int)
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 should change this value. Users
@@ -391,26 +560,44 @@ Configuration parameters
By default, "user_debug" is 0. The initial value may be overridden
by the -D command line option.
=-=
config("verbose_quit", bool)
The "verbose_quit" controls the print of the message:
Quit or abort executed
when a non-interactive quit or abort without an argument is encounted.
when a non-interactive quit or abort without an argument is encountered.
A quit of abort without an argument does not display a message when
invoked at the interactive level.
The following are synonyms for true:
=-=
"on" "yes" "y" "true" "t" "1" any non-zero number
config("ctrl_d", "ctrl_d_string")
The following are synonyms for false:
The "ctrl_d" controls the interactive meaning of ^D (Control D):
"off" "no" "n" "false" "f" "0" the number zero (0)
"virgin_eof" If ^D is the only character that has been typed
"virgineof" on a line, then calc will exit. Otherwise ^D
"virgin" will act according to the calc binding, which
"default" by default is a Emacs-style delete-char.
Examples of setting some parameters are:
"never_eof" The ^D never exits calc and only acts according
"nevereof" calc binding, which by default is a Emacs-style
"never" delete-char.
config("mode", "exp"); exponential output
config("display", 50); 50 digits of output
epsilon(epsilon() / 8); 3 bits more accuracy
config("tilde", 0) disable roundoff tilde printing
config("tab", "off") disable leading tab printing
"empty_eof" The ^D always exits calc if typed on an empty line.
"emptyeof" This condition occurs when ^D either the first
"empty" character typed, or when all other characters on
the line have been removed (say by deleting them).
Where multiple strings are given, the first string listed is what
config("ctrl_d") will return.
Note that config("ctrl_d") actually controls each and every character
that is bound to ``delete_char''. By default, ``delete_char'' is
Control D. Any character(s) bound to ``delete_char'' will cause calc
to exit (or not exit) as directed by config("ctrl_d").
The default "ctrl_d" is "virgin_eof".

View File

@@ -48,8 +48,6 @@ Environment variables
Typically compiled in value is:
bindings
or:
altbind (bindings where ^D means exit)
The bindings file is searched along the CALCPATH. Unlike
the READ command, a .cal extension is not added.

View File

@@ -20,7 +20,7 @@ DESCRIPTION
Standard input, standard output and standard error are always opened
and cannot be closed.
The truth value of an closed file is FALSE.
The truth value of a closed file is FALSE.
The fclose function returns the numeric value of errno if
there had been an error using the file, or the null value if

View File

@@ -23,7 +23,7 @@ EXAMPLE
0
LIMITS
fd must be associaed with an open file
fd must be associated with an open file
LIBRARY
none

View File

@@ -10,7 +10,7 @@ TYPES
return nil
DESCRIPTION
This function forces and buffered output to the file associated with fd.
This function forces a buffered output to the file associated with fd.
EXAMPLE
> fd = fopen("/tmp/file", "w")
@@ -18,7 +18,7 @@ EXAMPLE
> fflush(fd)
LIMITS
fd must be associaed with an open file
fd must be associated with an open file
LIBRARY
none

View File

@@ -25,7 +25,7 @@ EXAMPLE
"c"
LIMITS
fd must be associaed with an open file
fd must be associated with an open file
LIBRARY
none

View File

@@ -41,7 +41,7 @@ EXAMPLE
123
LIMITS
fd must be associaed with an open file
fd must be associated with an open file
LIBRARY
none

View File

@@ -14,7 +14,7 @@ DESCRIPTION
the open file associated with fd. Unlike fgetline, the trailing
newline is included in the return string.
If a line is read, is returned, otherwise (EOF or ERROR) nil is returned.
If a line is read, it is returned, otherwise (EOF or ERROR) nil is returned.
EXAMPLE
> fd = fopen("/tmp/newfile", "w")
@@ -30,7 +30,7 @@ EXAMPLE
"chongo was here"
LIMITS
fd must be associaed with an open file
fd must be associated with an open file
LIBRARY
none

View File

@@ -14,7 +14,7 @@ DESCRIPTION
If the stream cannot be read, an error value is returned.
Otherwise the function retrurns the string of characters from the
Otherwise the function returns the string of characters from the
current file position to the first null character ('\0') (the file
position for further reading then being immediately after the '\0'),
or if no null character is encountered, the string of characters to

View File

@@ -10,7 +10,7 @@ TYPES
return files, int or null
DESCRIPTION
This function, then given the argument fnum, will use it as an
This function, when given the argument fnum, will use it as an
index into an internal table of open file and return a file value.
If that entry in the table is not in use, then the null value is
returned instead. When no args are given, the maximum number of

View File

@@ -13,7 +13,7 @@ TYPES
DESCRIPTION
This function opens the file named filename. A file can be
opened for either reading, writing, or appending. The mode
is controlled by the mode flag as folllows:
is controlled by the mode flag as follows:
"r" reading
"w" writing

View File

@@ -11,7 +11,7 @@ TYPES
return null value
DESCRIPTION
In forall(x,y), y is to the the name of a function; that function
In forall(x,y), y is the name of a function; that function
is performed in succession for all elements of x. This is similar
to modify(x, y) but x is not changed.

View File

@@ -22,7 +22,7 @@ EXAMPLE
"c"
LIMITS
fd must be associaed with an open file
fd must be associated with an open file
LIBRARY
none

View File

@@ -22,7 +22,7 @@ EXAMPLE
"chongo was here"
LIMITS
fd must be associaed with an open file
fd must be associated with an open file
LIBRARY
none

View File

@@ -1,5 +1,5 @@
NAME
freeglobals - free memory used for values of global variabls
freeglobals - free memory used for values of global variables
SYNOPSIS
freeglobals()

View File

@@ -16,7 +16,7 @@ DESCRIPTION
Otherwise, until the terminating null character of fmt is encountered
or end-of-file for fs is reached, characters other than '%' and white
space are read from fmt and compared with the corresponding chracters
space are read from fmt and compared with the corresponding characters
read from fs. If the characters match, the reading continues. If they
do not match, an integer value is returned and the file position for
fs is the position of the non-matching character. If white space
@@ -72,7 +72,7 @@ DESCRIPTION
might be taken to suggest a number like +2345; 'r' might suggest
a representation like -27/49; 'e' might suggest a representation like
1.24e-7; 'f' might suggest a representation like 27.145. However, there
is no test that the the result conforms to the specifier. Whatever
is no test that the result conforms to the specifier. Whatever
the specifier in these cases, the result depends on the characters read
until a space or other exceptional character is read. The
characters read may include one or more occurrences of +, -, * as

View File

@@ -20,7 +20,7 @@ EXAMPLE
784
LIMITS
fd must be associaed with an open file
fd must be associated with an open file
LIBRARY
none

View File

@@ -30,7 +30,6 @@ following topics:
usage how to invoke the calc command
variable variables and variable declarations
altbind alternative input & history character bindings
bindings input & history character bindings
custom_cal information about custom calc library files
libcalc using the arbitrary precision routines in a C program

58
help/indices Normal file
View File

@@ -0,0 +1,58 @@
NAME
indices - indices for specified matrix or association element
SYNOPSIS
indices(V, index)
TYPES
V matrix or association
index integer
return list with up to 4 elements
DESCRIPTION
For 0 <= index < size(V), indices(V, index) returns list(i_0, i_1, ...)
for which V[i_0, i_1, ...] is the same lvalue as V[[index]].
For other values of index, a null value is returned.
This function can be useful for determining those elements for which
the indices satisfy some condition. This is particularly so for
associations since these have no simple relation between the
double-bracket index and the single-bracket indices, which may be
non-integer numbers or strings or other types of value. The
information provided by indices() is often required after the use
of search() or rsearch() which, when successful, return the
double-bracket index of the item found.
EXAMPLE
> mat M[2,3,1:5]
> indices(M, 11)
list (3 elements, 2 nonzero):
[[0]] = 0
[[1]] = 2
[[2]] = 2
> A = assoc();
> A["cat", "dog"] = "fight";
> A[2,3,5,7] = "primes";
> A["square", 3] = 9
> indices(A, search(A, "primes"))
list (4 elements, 4 nonzero):
[[0]] = 2
[[1]] = 3
[[2]] = 5
[[3]] = 7
LIMITS
abs(index) < 2^31
LIBRARY
LIST* associndices(ASSOC *ap, long index)
LIST* matindices(MATRIX *mp, long index)
SEE ALSO
assoc, mat

457
help/mat
View File

@@ -1,102 +1,397 @@
Using matrices
NAME
mat - keyword to create a matrix value
Matrices can have from 1 to 4 dimensions, and are indexed by a
normal-sized integer. The lower and upper bounds of a matrix can
be specified at runtime. The elements of a matrix are defaulted
to zeroes, but can be assigned to be of any type. Thus matrices
can hold complex numbers, strings, objects, etc. Matrices are
stored in memory as an array so that random access to the elements
is easy.
SYNOPSIS
mat [index-range-list] [ = {value_0. ...} ]
mat [] [= {value_0, ...}]
mat variable_1 ... [index-range-list] [ = {value_0, ...} ]
mat variable_1 ... [] [ = {value_0, ...} ]
Matrices are normally indexed using square brackets. If the matrix
is multi-dimensional, then an element can be indexed either by
using multiple pairs of square brackets (as in C), or else by
separating the indexes by commas. Thus the following two statements
reference the same matrix element:
mat [index-range-list_1[index-ranges-list_2] ... [ = { { ...} ...} ]
x = name[3][5];
x = name[3,5];
decl id_1 id_2 ... [index-range-list] ...
The double-square bracket operator can be used on any matrix to
make references to the elements easy and efficient. This operator
bypasses the normal indexing mechanism, and treats the array as if
it was one-dimensional and with a lower bound of zero. In this
indexing mode, elements correspond to the normal indexing mode where
the rightmost index increases most frequently. For example, when
using double-square bracket indexing on a two-dimensional matrix,
increasing indexes will reference the matrix elements left to right,
row by row. Thus in the following example, 'x' and 'y' are copied
from the same matrix element:
TYPES
index-range-list range_1 [, range_2, ...] up to 4 ranges
range_1, ... integer, or integer_1 : integer_2
value, value_1, ... any
variable_1 ... lvalue
decl declarator = global, static or local
id_1, ... identifier
mat m[1:2, 1:3];
x = m[2,1];
y = m[[3]];
DESCRIPTION
The expression mat [index-range-list] returns a matrix value.
This may be assigned to one or more lvalues A, B, ... by either
There are functions which return information about a matrix.
The 'size' functions returns the total number of elements.
The 'matdim', 'matmin', and 'matmax' functions return the number
of dimensions of a matrix, and the lower and upper index bounds
for a dimension of a matrix. For square matrices, the 'det'
function calculates the determinant of the matrix.
mat A B ... [index-range-list]
Some functions return matrices as their results. These functions
do not affect the original matrix argument, but instead return
new matrices. For example, the 'mattrans' function returns the
transpose of a matrix, and 'inverse' returns the inverse of a
matrix. So to invert a matrix called 'x', you could use:
or
x = inverse(x);
A = B = ... = mat[index-range-list]
The 'matfill' function fills all elements of a matrix with the
specified value, and optionally fills the diagonal elements of a
square matrix with a different value. For example:
If a variable is specified by an expression that is not a symbol with
possibly object element specifiers, the expression should be enclosed
in parentheses. For example, parentheses are required in
mat (A[2]) [3] and mat (*p) [3] but mat P.x [3] is acceptable.
matfill(x,1);
When an index-range is specified as integer_1 : integer_2, where
integer_1 and integer_2 are expressions which evaluate to integers,
the index-range consists of all integers from the minimum of the
two integers to the maximum of the two integers. For example,
mat[2:5, 0:4] and mat[5:2, 4:0] return the same matrix value.
will fill any matrix with ones, and:
If an index-range is an expression which evaluates to an integer,
the range is as if specified by 0 : integer - 1. For example,
mat[4] and mat[0:3] return the same 4-element matrix; mat[-2] and
mat[-3:0] return the same 4-element matrix.
matfill(x, 0, 1);
If the variable A has a matrix value, then for integer indices
i_1, i_2, ..., equal in number to the number of ranges specified at
its creation, and such that each index is in the corresponding range,
the matrix element associated with those index list is given as an
lvalue by the expressions A[i_1, i_2, ...].
will create an identity matrix out of any square matrix. Note that
unlike most matrix functions, this function does not return a matrix
value, but manipulates the matrix argument itself.
The elements of the matrix are stored internally as a linear array
in which locations are arranged in order of increasing indices.
For example, in order of location, the six element of A = mat [2,3]
are
Matrices can be multiplied by numbers, which multiplies each element
by the number. Matrices can also be negated, conjugated, shifted,
rounded, truncated, fractioned, and modulo'ed. Each of these
operations is applied to each element.
A[0,0], A[0,1], A[0,2], A[1,0], A[1,,1], A[1,2].
Matrices can be added or multiplied together if the operation is
legal. Note that even if the dimensions of matrices are compatible,
operations can still fail because of mismatched lower bounds. The
lower bounds of two matrices must either match, or else one of them
must have a lower bound of zero. Thus the following code:
These elements may also be specified using the double-bracket operator
with a single integer index as in A[[0]], A[[1]], ..., A[[5]].
If p is assigned the value &A[0.0], the address of A[[i]] for 0 <= i < 6
is p + i as long as A exists and a new value is not assigned to A.
mat x[3:3];
mat y[4:4];
z = x + y;
When a matrix is created, each element is initially assigned the
value zero. Other values may be assigned then or later using the
"= {...}" assignment operation. Thus
fails because the calculator does not have a way of knowing what
the bounds should be on the resulting matrix. If the bounds match,
then the resulting matrix has the same bounds. If exactly one of
the lower bounds is zero, then the resulting matrix will have the
nonzero lower bounds. Thus means that the bounds of a matrix are
preserved when operated on by matrices with lower bounds of zero.
For example:
A = {value_0, value_1, ...}
mat x[3:7];
mat y[5];
z = x + y;
assigns the values value_0, value_1, ... to the elements A[[0]],
A[[1]], ... Any blank "value" is passed over. For example,
will succeed and assign the variable 'z' a matrix whose
bounds are 3-7.
A = {1, , 2}
Vectors are matrices of only a single dimension. The 'dp' and 'cp'
functions calculate the dot product and cross product of a vector
(cross product is only defined for vectors of size 3).
will assign the value 1 to A[[0]], 2 to A[[2]] and leave all other
elements unchanged. Values may also be assigned to elements by
simple assignments, as in A[0,0] = 1, A[0,2] = 2;
Matrices can be searched for particular values by using the 'search'
and 'rsearch' functions. They return the element number of the
found value (zero based), or null if the value does not exist in the
matrix. Using the element number in double-bracket indexing will
then refer to the found element.
If the index-range is left blank but an initializer list is specified
as in
mat A[] = {1, 2 }
B = mat[] = {1, , 3, }
the matrix created is one-dimensional. If the list contains a
positive number n of values or blanks, the result is as if the
range were specified by [n], i.e. the range of indices is from
0 to n - 1. In the above examples, A is of size 2 with A[0] = 1
and A[1] = 2; B is of size 4 with B[0] = 1, B[1] = B[3] = 0,
B[2] = 3. The specification mat[] = { } creates the same as mat[1].
If the index-range is left blank and no initializer list is specified,
as in mat C[] or C = mat[], the matrix assigned to C has zero
dimension; this has one element C[]. To assign a value using "= { ...}"
at the same time as creating C, parentheses are required as in
(mat[]) = {value} or (mat C[]) = {value}. Later a value may be
assigned to C[] by C[] = value or C = {value}.
The value assigned at any time to any element of a matrix can be of
any type - number, string, list, matrix, object of previously specified
type, etc. For some matrix operations there are of course conditions
that elements may have to satisfy: for example, addition of matrices
requires that addition of corresponding elements be possible.
If an element of a matrix is a structure for which indices or an
object element specifier is required, an element of that structure is
referred to by appropriate uses of [ ] or ., and so on if an element
of that element is required. For example, one may have an expressions
like
A[1,2][3].alpha[2];
if A[1,2][3].alpha is a list with at least three elements, A[1,2][3] is
an object of a type like obj {alpha, beta}, A[1,2] is a matrix of
type mat[4] and A is a mat[2,3] matrix. When an element of a matrix
is a matrix and the total number of indices does not exceed 4, the
indices can be combined into one list, e.g. the A[1,2][3] in the
above example can be shortened to A[1,2,3]. (Unlike C, A[1,2] cannot
be expressed as A[1][2].)
The function ismat(V) returns 1 if V is a matrix, 0 otherwise.
isident(V) returns 1 if V is a square matrix with diagonal elements 1,
off-diagonal elements zero, or a zero- or one-dimensional matrix with
every element 1; otherwise zero is returned. Thus isident(V) = 1
indicates that for V * A and A * V where A is any matrix of
for which either product is defined and the elements of A are real
or complex numbers, that product will equal A.
If V is matrix-valued, test(V) returns 0 if every element of V tests
as zero; otherwise 1 is returned.
The dimension of a matrix A, i.e. the number of index-ranges in the
initial creation of the matrix, is returned by the function matdim(A).
For 1 <= i <= matdim(A), the minimum and maximum values for the i-th
index range are returned by matmin(A, i) and matmax(A,i), respectively.
The total number of elements in the matrix is returned by size(A).
The sum of the elements in the matrix is returned by matsum(A).
The default method of printing matrices is to give a line of information
about the matrix, and to list on separate lines up to 15 elements,
the indices and either the value (for numbers, strings, objects) or
some descriptive information for lists or matrices, etc.
Numbers are displayed in the current number-printing mode.
The maximum number of elements to be printed can be assigned
any nonnegative integer value m by config("maxprint", m).
Users may define another method of printing matrices by defining a
function mat_print(M); for example, for a not too big 2-dimensional
matrix A it is a common practice to use a loop like:
for (i = matmin(A,1); i <= matmax(A,1); i++) {
for (j = matmin(A,2); j <= matmax(A,2); j++)
printf("%8d", A[i,j];
print;
}
The default printing may be restored by
undefine mat_print;
The keyword "mat" followed by two or more index-range-lists returns a
matrix with indices specified by the first list, whose elements are
matrices as determined by the later index-range-lists. For
example mat[2][3] is a 2-element matrix, each of whose elements has
as its value a 3-element matrix. Values may be assigned to the
elements of the innermost matrices by nested = {...} operations as in
mat [2][3] = {{1,2,3},{4,5,6}}
An example of the use of mat with a declarator is
global mat A B [2,3], C [4]
This creates, if they do not already exist, three global variables with
names A, B, C, and assigns to A and B the value mat[2,3] and to C mat[4].
Some operations are defined for matrices.
A == B
Returns 1 if A and B are of the same "shape" and "corresponding"
elements are equal; otherwise 0 is returned. Being of the same
shape means they have the same dimension d, and for each i <= d,
matmax(A,i) - matmin(A,i) == matmax(B,i) - matmin(B,i),
One consequence of being the same shape is that the matrices will
have the same size. Elements "correspond" if they have the same
double-bracket indices; thus A == B implies that A[[i]] == B[[i]]
for 0 <= i < size(A) == size(B).
A + B
A - B
These are defined A and B have the same shape, the element
with double-bracket index j being evaluated by A[[j]] + B[[j]] and
A[[j]] - B[[j]], respectively. The index-ranges for the results
are those for the matrix A.
A[i,j]
If A is two-dimensional, it is customary to speak of the indices
i, j in A[i,j] as referring to rows and columns; the number of
rows is matmax(A,1) - matmin(A,1) + 1; the number of columns if
matmax(A,2) - matmin(A,2) + 1. A matrix is said to be square
if it is two-dimensional and the number of rows is equal to the
number of columns.
A * B
Multiplication is defined provided certain conditions by the
dimensions and shapes of A and B are satisfied. If both have
dimension 2 and the column-index-list for A is the same as
the row-index-list for B, C = A * B is defined in the usual
way so that for i in the row-index-list of A and j in the
column-index-list for B,
C[i,j] = Sum A[i,k] * B[k,j]
the sum being over k in the column-index-list of A. The same
formula is used so long as the number of columns in A is the same
as the number of rows in B and k is taken to refer to the offset
from matmin(A,2) and matmin(B,1), respectively, for A and B.
If the multiplications and additions required cannot be performed,
an execution error may occur or the result for C may contain
one or more error-values as elements.
If A or B has dimension zero, the result for A * B is simply
that of multiplying the elements of the other matrix on the
left by A[] or on the right by B[].
If both A and B have dimension 1, A * B is defined if A and B
have the same size; the result has the same index-list as A
and each element is the product of corresponding elements of
A and B. If A and B have the same index-list, this multiplication
is consistent with multiplication of 2D matrices if A and B are
taken to represent 2D matrices for which the off-diagonal elements
are zero and the diagonal elements are those of A and B.
the real and complex numbers.
If A is of dimension 1 and B is of dimension 2, A * B is defined
if the number of rows in B is the same as the size of A. The
result has the same index-lists as B; each row of B is multiplied
on the left by the corresponding element of A.
If A is of dimension 2 and B is of dimension 1, A * B is defined
if number of columns in A is the same as the size of A. The
result has the same index-lists as A; each column of A is
multiplied on the right by the corresponding element of B.
The algebra of additions and multiplications involving both one-
and two-dimensional matrices is particularly simple when all the
elements are real or complex numbers and all the index-lists are
the same, as occurs, for example, if for some positive integer n,
all the matrices start as mat [n] or mat [n,n].
det(A)
If A is a square, det(A) is evaluated by an algorithm that returns
the determinant of A if the elements of A are real or complex
numbers, and if such an A is non-singular, inverse(A) returns
the inverse of A indexed in the same way as A. For matrix A of
dimension 0 or 1, det(A) is defined as the product of the elements
of A in the order in which they occur in A, inverse(A) returns
a matrix indexed in the same way as A with each element inverted.
The following functions are defined to return matrices with the same
index-ranges as A and the specified operations performed on all
elements of A. Here num is an arbitrary complex number (nonzero
when it is a divisor), int an integer, rnd a rounding-type
specifier integer, real a real number.
num * A
A * num
A / num
- A
conj(A)
A << int, A >> int
scale(A, int)
round(A, int, rnd)
bround(A, int, rnd)
appr(A, real, rnd)
int(A)
frac(A)
A // real
A % real
A ^ int
If A and B are one-dimensional of the same size dp(A, B) returns
their dot-product, i.e. the sum of the products of corresponding
elements.
If A and B are one-dimension and of size 3, cp(A, B) returns their
cross-product.
randperm(A) returns a matrix indexed the same as A in which the elements
of A have been randomly permuted.
sort(A) returns a matrix indexed the same as A in which the elements
of A have been sorted.
If A is an lvalue whose current value is a matrix, matfill(A, v)
assigns the value v to every element of A, and if also, A is
square, matfill(A, v1, v2) assigns v1 to the off-diagonal elements,
v2 to the diagonal elements. To create and assign to A the unit
n * n matrix, one may use matfill(mat A[n,n], 0, 1).
For a square matrix A, mattrace(A) returns the trace of A, i.e. the
sum of the diagonal elements. For zero- or one-dimensional A,
mattrace(A) returns the sum of the elements of A.
For a two-dimensional matrix A, mattrans(A) returns the transpose
of A, i.e. if A is mat[m,n], it returns a mat[n,m] matrix with
[i,j] element equal to A[j,i]. For zero- or one-dimensional A,
mattrace(A) returns a matrix with the same value as A.
The functions search(A, value, start, end]) and
rsearch(A, value, start, end]) return the first or last index i
for which A[[i]] == value and start <= i < end, or if there is
no such index, the null value. For further information on default
values and the use of an "accept" function, see the help files for
search and rsearch.
reverse(A) returns a matrix with the same index-lists as A but the
elements in reversed order.
The copy and blkcpy functions may be used to copy data to a matrix from
a matrix or list, or from a matrix to a list. In copying from a
matrix to a matrix the matrices need not have the same dimension;
in effect they are treated as linear arrays.
EXAMPLE
> obj point {x,y}
> mat A[5] = {1, 2+3i, "ab", mat[2] = {4,5}. obj point = {6,7}}
> A
mat [5] (5 elements, 5 nonzero):
[0] = 1
[1] = 2+3i
[2] = "ab"
[3] = mat [2] (2 elements, 2 nonzero)
[4] = obj point {6, 7}
> print A[0], A[1], A[2], A[3][0], A[4].x
1 2+3i ab 4 6
> define point_add(a,b) = obj point = {a.x + b.x, a.y + b.y}
point_add(a,b) defined
> mat [B] = {8, , "cd", mat[2] = {9,10}, obj point = {11,12}}
> A + B
mat [5] (5 elements, 5 nonzero):
[0] = 9
[1] = 2+3i
[2] = "abcd"
[3] = mat [2] (2 elements, 2 nonzero)
[4] = obj point {17, 19}
> mat C[2,2] = {1,2,3,4}
> C^10
mat [2,2] (4 elements, 4 nonzero):
[0,0] = 4783807
[0,1] = 6972050
[1,0] = 10458075
[1,1] = 15241882
> C^-10
mat [2,2] (4 elements, 4 nonzero):
[0,0] = 14884.650390625
[0,1] = -6808.642578125
[1,0] = -10212.9638671875
[1,1] = 4671.6865234375
> mat A[4] = {1,2,3,4}, A * reverse(A);
mat [4] (4 elements, 4 nonzero):
[0] = 4
[1] = 6
[2] = 6
[3] = 4
LIMITS
The theoretical upper bound for the absolute values of indices is
2^31 - 1, but the size of matrices that can be handled in practice will
be limited by the availability of memory and what is an acceptable
runtime. For example, although it may take only a fraction of a
second to invert a 10 * 10 matrix, it will probably take about 1000
times as long to invert a 100 * 100 matrix.
LIBRARY
n/a
SEE ALSO
ismat, matdim, matmax, matmin, mattrans, mattrace, matsum, det, inverse,
isident, test, config, search, rsearch, reverse, copy, blkcpy, dp, cp,
randperm, sort

View File

@@ -39,7 +39,6 @@ Very High priority items:
overview overview of calc
assoc using associations
command top level commands
config configuration parameters
define how to define functions
environment how environment variables effect calc
errorcodes calc generated error codes
@@ -48,7 +47,6 @@ Very High priority items:
history command history
interrupt how interrupts are handled
list using lists
mat using matrices
obj user defined data types
operator math, relational, logic and variable access ...
statement flow control and declaration statements

View File

@@ -11,7 +11,7 @@ Calc Enhancement Wish List:
The following items are in the calc wish list. Programs like this
can be extended and improved forever.
Calc bug repoers, however, should be sent to:
Calc bug reports, however, should be sent to:
calc-bugs at postofc dot corp dot sgi dot com

49
hist.c
View File

@@ -76,6 +76,7 @@ static struct {
int linelen;
int histcount;
int curhist;
BOOL virgin_line; /* 1 => never typed chars, 0 => chars typed */
} HS;
@@ -250,9 +251,15 @@ static void insert_string(char *str, int len);
int
hist_getline(char *prompt, char *buf, int len)
{
/*
* initialize if we have not already done so
*/
if (!inited)
(void) hist_init(calcbindings);
/*
* establish the beginning of a line condition
*/
HS.prompt = prompt;
HS.bufsize = len - 2;
HS.buf = buf;
@@ -260,19 +267,38 @@ hist_getline(char *prompt, char *buf, int len)
HS.end = buf;
HS.mark = NULL;
HS.linelen = -1;
HS.virgin_line = TRUE;
/*
* prep the I/O
*/
fputs(prompt, stdout);
fflush(stdout);
/*
* special case: non-interactive editing
*/
if (!canedit) {
if (fgets(buf, len, stdin) == NULL)
return 0;
return strlen(buf);
}
while (HS.linelen < 0)
/*
* get the line
*/
while (HS.linelen < 0) {
/* get the next char */
read_key();
/* chars typed, no longer virgin */
HS.virgin_line = FALSE;
}
/*
* return the line
*/
return HS.linelen;
}
@@ -292,12 +318,18 @@ hist_init(char *filename)
{
TTYSTRUCT newtty;
/*
* prevent multiple initializations
*/
if (inited) {
if (conf->calc_debug & CALCDBG_TTY)
printf("DEBUG: inited already set in hist_init\n");
return HIST_INITED;
}
/*
* setup
*/
inited = 1;
canedit = 0;
if (conf->calc_debug & CALCDBG_TTY)
@@ -984,6 +1016,21 @@ forward_kill_char(void)
static void
delete_char(void)
{
/*
* quit delete_char (usually ^D) is at start of line and we are allowed
*
* We exit of start of line and config("ctrl_d", "empty") or
* if config("ctrl_d", "virgin") and we have never typed on the line.
*/
if ((HS.end == HS.buf) &&
(conf->ctrl_d == CTRL_D_EOF ||
(conf->ctrl_d == CTRL_D_VIRGIN && HS.virgin_line == TRUE))) {
quit_calc();
}
/*
* normal case: just forward_kill_char
*/
if (HS.end > HS.buf)
forward_kill_char();
}

View File

@@ -39,17 +39,22 @@ CALC_FILES= README bigprime.cal deg.cal ellip.cal lucas.cal lucas_chk.cal \
lucas_tbl.cal mersenne.cal mod.cal pell.cal pi.cal pix.cal \
pollard.cal poly.cal psqrt.cal quat.cal regress.cal solve.cal \
sumsq.cal surd.cal unitfrac.cal varargs.cal chrem.cal mfactor.cal \
bindings altbind randmprime.cal test1700.cal randrun.cal \
bindings randmprime.cal test1700.cal randrun.cal \
randbitrun.cal bernoulli.cal test2300.cal test2600.cal \
test2700.cal test3100.cal test3300.cal test3400.cal prompt.cal \
test3500.cal seedrandom.cal test4000.cal test4100.cal test4600.cal \
beer.cal hello.cal test5100.cal test5200.cal randombitrun.cal \
randomrun.cal xx_print.cal natnumset.cal qtime.cal test8400.cal
randomrun.cal xx_print.cal natnumset.cal qtime.cal test8400.cal \
test8500.cal
# These files are found (but not built) in the distribution
#
DISTLIST= ${CALC_FILES} ${MAKE_FILE}
# These files are used to make (but not built) a calc .a library
#
CALCLIBLIST=
all: ${CALC_FILES} ${MAKE_FILE} .all
# used by the upper level Makefile to determine of we have done all
@@ -79,6 +84,13 @@ distlist: ${DISTLIST}
distdir:
${Q}echo lib
calcliblist:
${Q}for i in ${CALCLIBLIST} /dev/null; do \
if [ X"$$i" != X"/dev/null" ]; then \
echo lib/$$i; \
fi; \
done
clean:
clobber:

View File

@@ -2,11 +2,11 @@ To load a library, try:
read filename
You to not need to add the .cal extension to the filename. Calc
You do not need to add the .cal extension to the filename. Calc
will search along the $CALCPATH (see ``help environment'').
Normally a library will simply define some functions. By default,
most libraries will print out a short message when thei are read.
most libraries will print out a short message when they are read.
For example:
> read lucas
@@ -360,7 +360,7 @@ randbitrun.cal
randbitrun([run_cnt])
Using randbit(1) to generate a sequence of random bits, determine if
the number and kength of identical bits runs match what is expected.
the number and length of identical bits runs match what is expected.
By default, run_cnt is to test the next 65536 random values.
This tests the a55 generator.
@@ -416,7 +416,7 @@ randrun.cal
regress.cal
Test the correct execution of the calculator by reading this library file.
Errors are reported with '****' mssages, or worse. :-)
Errors are reported with '****' messages, or worse. :-)
seedrandom.cal

View File

@@ -1,49 +0,0 @@
# Alternate key bindings for calc line editing functions
#
# NOTE: This facility is ignored if calc was compiled with GNU-readline.
# In that case, the standard readline mechanisms (see readline(3))
# are used in place of those found below.
map base-map
default insert-char
^@ set-mark
^A start-of-line
^B backward-char
^D quit
^E end-of-line
^F forward-char
^H backward-kill-char
^J new-line
^K kill-line
^L refresh-line
^M new-line
^N forward-history
^O save-line
^P backward-history
^R reverse-search
^T swap-chars
^U flush-input
^V quote-char
^W kill-region
^Y yank
^? delete-char
^[ ignore-char esc-map
map esc-map
default ignore-char base-map
G start-of-line
H backward-history
P forward-history
K backward-char
M forward-char
O end-of-line
S delete-char
g goto-line
s backward-word
t forward-word
d forward-kill-word
u uppercase-word
l lowercase-word
h list-history
^[ flush-input
[ arrow-key

View File

@@ -159,9 +159,9 @@ define mod_inv(a)
define mod_div(a, b)
{
local c, x, y;
obj mod x, y;
local c;
local obj mod x;
local obj mod y;
if (isnum(a))
a = lmod(a);
if (isnum(b))

View File

@@ -471,8 +471,9 @@ define plist(s) {
define deg(a) = size(a.p) - 1;
define polydiv(a,b) {
local q, r, d, u, i, m, n, sa, sb, sq;
obj poly q, r;
local d, u, i, m, n, sa, sb, sq;
local obj poly q;
local obj poly r;
sa=findlist(a); sb = findlist(b); sq = list();
m=size(sa)-1; n=size(sb)-1;
if (n<0) quit "Zero divisor";

View File

@@ -385,10 +385,10 @@ define test_config()
'516: config("pow2") == 40');
vrfy(config("redc2") == 50,
'517: config("redc2") == 50');
vrfy(config("tilde") == 1,
'518: config("tilde") == 1');
vrfy(config("tab") == 1,
'519: config("tab") == 1');
vrfy(config("tilde") == "on",
'518: config("tilde") == "on"');
vrfy(config("tab") == "on",
'519: config("tab") == "on"');
vrfy(config("quomod") == 0,
'520: config("quomod") == 0');
vrfy(config("quo") == 2,
@@ -407,10 +407,10 @@ define test_config()
'527: config("outround") == 2');
vrfy(config("round") == 24,
'528: config("round") == 24');
vrfy(config("leadzero") == 0,
'529: config("leadzero") == 0');
vrfy(config("fullzero") == 0,
'530: config("fullzero") == 0');
vrfy(config("leadzero") == "off",
'529: config("leadzero") == "off"');
vrfy(config("fullzero") == "off",
'530: config("fullzero") == "off"');
vrfy(config("maxscan") == 20,
'531: config("maxscan") == 20');
vrfy(config("prompt") == "> ",
@@ -426,10 +426,10 @@ define test_config()
vrfy(config("quo", 0) == 2, '536: config("quo", 0) == 2');
vrfy(config("outround", 24) == 2,
'537: config("outround", 24) == 2');
vrfy(config("leadzero", "y") == 0,
'538: config("leadzero", "y") == 0');
vrfy(config("fullzero", 1) == 0,
'539: config("fullzero", 1) == 0');
vrfy(config("leadzero","y") == "off",
'538: config("leadzero","y") == "off"');
vrfy(config("fullzero", 1) == "off",
'539: config("fullzero", 1) == "off"');
vrfy(config("prompt", "; ") == "> ",
'540: config("prompt", "; ") == "> "');
vrfy(config("more", ";; ") == ">> ",
@@ -441,14 +441,14 @@ define test_config()
'543: config("all",callcfg) == newcfg');
vrfy(config("display",2) == 20,
'544: config("display",2) == 20');
vrfy(config("fullzero",1) == 0,
'545: config("fullzero",1) == 0');
vrfy(config("fullzero",1) == "off",
'545: config("fullzero",1) == "off"');
vrfy(strprintf("%d %d %d", 0, 1, 2) == ".00 1.00 2.00",
'546: strprintf("%d %d %d", 0, 1, 2) == ".00 1.00 2.00"');
vrfy(config("display",20) == 2,
'547: config("display",20) == 2');
vrfy(config("fullzero",0) == 1,
'548: config("fullzero",0) == 1');
vrfy(config("fullzero",0) == "on",
'548: config("fullzero",0) == "on"');
vrfy(strprintf("%d %d %d", 0, 1, 2) == "0 1 2",
'549: strprintf("%d %d %d", 0, 1, 2) == "0 1 2"');
@@ -1582,12 +1582,12 @@ define test_mode()
tmp = config("mode", "int");
print '1604: tmp = config("mode", "int")';
vrfy(tmp == "frac", '1605: tmp == "frac"');
vrfy(tmp == "fraction", '1605: tmp == "fraction"');
vrfy(base() == -10, '1606: base() == -10');
tmp = config("mode", "real");
print '1607: tmp = config("mode", "real")';
vrfy(tmp == "int", '1608: tmp == "int"');
vrfy(tmp == "integer", '1608: tmp == "integer"');
vrfy(base() == 10, '1609: base() == 10');
tmp = config("mode", "exp");
@@ -1597,7 +1597,7 @@ define test_mode()
tmp = config("mode", "hex");
print '1613: tmp = config("mode", "hex")';
vrfy(tmp == "exp", '1614: tmp == "exp"');
vrfy(tmp == "scientific", '1614: tmp == "scientific"');
vrfy(base() == 16, '1615: base() == 16');
tmp = config("mode", "oct");
@@ -1616,11 +1616,13 @@ define test_mode()
tmp = base(1/3);
print '1624: tmp = base(1/3)';
vrfy(config("mode") == "frac", '1625: config("mode") == "frac"');
vrfy(config("mode") == "fraction",
'1625: config("mode") == "fraction"');
tmp = base(-10);
print '1626: tmp = base(-10)';
vrfy(config("mode") == "int", '1627: config("mode") == "int"');
vrfy(config("mode") == "integer",
'1627: config("mode") == "integer"');
tmp = base(10);
print '1628: tmp = base(10)';
@@ -1628,7 +1630,8 @@ define test_mode()
tmp = base(1e20);
print '1630: tmp = base(1e20)';
vrfy(config("mode") == "exp", '1631: config("mode") == "exp"');
vrfy(config("mode") == "scientific",
'1631: config("mode") == "scientific"');
tmp = base(16);
print '1632: tmp = base(16)';
@@ -2705,11 +2708,11 @@ define test_matobj()
B[0,0] = res(2);
print '3106: B[0,0] = res(2)';
B[0,1] = res(3);
print '3107: B[0,1] = res(2)';
print '3107: B[0,1] = res(3)';
B[1,0] = res(5);
print '3108: B[1,0] = res(2)';
print '3108: B[1,0] = res(5)';
B[1,1] = res(7);
print '3109: B[1,1] = res(2)';
print '3109: B[1,1] = res(7)';
print '3110: md = 0';
md = 0;
vrfy(det(B) == res(-1), '3111: det(B) == res(-1)');
@@ -3048,8 +3051,8 @@ define test_error()
print '3712: e9999 = error(9999)';
vrfy(errno() == 9999, '3713: errno() == 9999');
vrfy(error() == e9999, '3714: error() == e9999');
vrfy(strerror() == "Unknown error 9999",
'3715: strerror() == "Unknown error 9999"');
vrfy(substr(strerror(), strpos(strerror(),"9999"), 4) == "9999",
'3715: substr(strerror(), strpos(strerror(),"9999"), 4) == "9999"');
x = newerror("Alpha");
print '3716: x = newerror("Alpha")';
n = iserror(x);
@@ -3060,17 +3063,21 @@ define test_error()
vrfy(errno(9999) == n, '3721: errno() == n');
vrfy(errno() == 9999, '3722: errno() == 9999');
vrfy(error() == e9999, '3723: error() == e9999');
vrfy(strerror() == "Unknown error 9999",
'3724: strerror() == "Unknown error 9999"');
vrfy(substr(strerror(), strpos(strerror(),"9999"), 4) == "9999",
'3724: substr(strerror(), strpos(strerror(),"9999"), 4) == "9999"');
a = 1/0;
print '3725: a = 1/0';
vrfy(strerror() == "Division by zero",
'3726: strerror() == "Division by zero"');
n = 8191;
print '3727: n = 8191';
vrfy(substr(strerror(8191),strpos(strerror(n),"8191"), 4) == "8191",
'3728: substr(strerror(n),strpos(strerror(n),"8191"),4) == "8191"');
/* errmax and errcount should be bumped up the 148 errors above */
vrfy(errcount() == ecnt, '3727: errcount() == ecnt');
vrfy(errcount() == ecnt, '3729: errcount() == ecnt');
print '3728: Ending test_error';
print '3730: Ending test_error';
}
print '054: parsed test_error()';
@@ -7387,8 +7394,8 @@ X5800 = obj xy5800 = {1,2};
print '5864: X5800 = obj xy5800 = {1,2}';
vrfy(X5800 == (obj xy5800 = {1,2}),
'5865: X5800 == (obj xy5800 = {1,2})');
define f5800(a8500 = mat[2] = {3,4}) = 5 * a8500;
print '5866: define f5800(a8500 = mat[2] = {3,4}) = 5 * a8500;'
define f5800(a5800 = mat[2] = {3,4}) = 5 * a5800;
print '5866: define f5800(a5800 = mat[2] = {3,4}) = 5 * a5800;'
vrfy(f5800() == (mat[] = {15,20}),'5867: f5800() == (mat[] = {15,20})');
print '5868: End of 5800 sequence';
@@ -7491,6 +7498,15 @@ vrfy(test8400() == 64434, '8405: test8400() == 64434');
print '8406: Ending test_quit';
/*
* test_divmod - psuedo-random tests on the // and % with various rounding modes
*/
print;
print '8500: Starting test_divmod'
read -once "test8500";
/* 85xx: Ending test_divmod is printed by test8500.cal */
/*
* read various calc libs
*

242
lib/test8500.cal Normal file
View File

@@ -0,0 +1,242 @@
/*
* Copyright (c) 1996 Ernest Bowen and Landon Curt Noll
* Permission is granted to use, distribute, or modify this source,
* provided that this copyright notice remains intact.
*
* By: Ernest Bowen and Landon Curt Noll
* ernie@neumann.une.edu.au and http://reality.sgi.com/chongo/
*
* This library is used by the 8500 series of the regress.cal test suite.
*/
/*
* Tests of // and % operators
*/
global err_8500; /* divmod_8500 error count */
global L_8500; /* list of problem values */
global ver_8500; /* test verbosity - see setting comment near bottom */
global old_seed_8500; /* old srand() seed */
/*
* save the config state so that we can change it and restore later
*/
global cfg_8500 = config("all");
/*
* onetest_8500 - perform one division / remainder test
*
* Returns:
* 0 = test was successful
* >0 = test error indicator
*/
define onetest_8500(a,b,rnd) {
local q, r, s, S;
/*
* set a random rounding mode
*/
config("quo", rnd), config("mod", rnd);
/*
* perform the division and mod
*/
q = a // b;
r = a % b;
/*
* verify the fundamental math
*/
if (a != q * b + r)
return 1;
/*
* determine if the rounding worked
*/
if (b) {
if (rnd & 16)
s = sgn(abs(r) - abs(b)/2);
else
s = sgn(abs(r) - abs(b));
if (s < 0 || r == 0)
return 0;
if (s > 0)
return 2;
if (((rnd & 16) && s == 0) || !(rnd & 16)) {
S = sgn(r) * sgn(b); /* This is sgn(a/b) - a//b */
switch (rnd & 15) {
case 0: return (S < 0) ? 3 : 0;
case 1: return (S > 0) ? 4 : 0;
case 2: return (S != sgn(a)*sgn(b)) ? 5 : 0;
case 3: return (S != -sgn(a)*sgn(b)) ? 6 : 0;
break;
case 4: return (S != sgn(b)) ? 7 : 0;
case 5: return (S != -sgn(b)) ? 8 : 0;
case 6: return (S != sgn(a)) ? 9 : 0;
case 7: return (S != -sgn(a)) ? 10 : 0;
case 8: return (isodd(q)) ? 11 : 0;
case 9: return (iseven(q)) ? 12 : 0;
case 10: return (iseven(q) != (a/b > 0)) ? 13:0;
case 11: return (isodd(q) != (a/b > 0)) ? 14:0;
case 12: return (iseven(q) != (b > 0)) ? 15 : 0;
case 13: return (isodd(q) != (b > 0)) ? 16 : 0;
case 14: return (iseven(q) != (a > 0)) ? 17 : 0;
case 15: return (isodd(q) != (a > 0)) ? 18 : 0;
}
}
}
/*
* all is well
*/
return 0;
}
/*
* divmod_8500 - perform a bunch of pseudo-random // and % test
*
* divmod_8500(N, M1, M2) will perform N tests with randomly chosen integers
* a, b with abs(a) < M1, abs(b) < M2, which with 50% probability are
* converted to a = (2 * a + 1) * b, b = 2 * b (to give case where
* a / b is an integer + 1/2).
*
* N defaults to 10, M1 to 2^128, M2 to 2^64
*
* The testnum, if > 0, is used while printing a failure or success.
*
* The rounding parameter is randomly chosen.
*
* After a run of divmod_8500 the a, b, rnd values which gave failure are
* stored in the list L_8500. L_8500[0], L_8500[1], L_8500[2] are a, b, rnd for the first
* test, etc.
*/
define divmod_8500(N = 10, M1 = 2^128, M2 = 2^64, testnum = 0)
{
local a, b, i, v, rnd;
local errmsg; /* error message to display */
/*
* firewall
*/
if (!isint(M1) || M1 < 2)
quit "Bad second arg for dtest";
if (!isint(M2) || M2 < 2)
quit "Bad third arg for dtest";
/*
* test setup
*/
err_8500 = 0;
L_8500 = list();
/*
* perform the random results
*/
for (i = 0; i < N; i++) {
/*
* randomly select two values in the range controlled by M1,M2
*/
a = rand(-M1+1, M1);
b = rand(-M2+1, M2);
if (rand(2)) {
a = (2 * a + 1) * b;
b *= 2;
}
/*
* seelect one of the 32 rounding modes at random
*/
rnd = rand(32);
/*
* ver_8500 pre-test reporting
*/
if (ver_8500 > 1)
printf("Test %d: a = %d, b = %d, rnd = %d\n",
i, a, b, rnd);
/*
* perform the actual test
*/
v = onetest_8500(a, b, rnd);
/*
* individual test analysis
*/
if (v != 0) {
err_8500++;
if (ver_8500 != 0) {
if (testnum > 0) {
errmsg = strprintf(
"Failure %d on test %d", v, i);
prob(errmsg);
} else {
printf("Failure %d on test %d", v, i);
}
}
append(L_8500, a, b, rnd);
}
}
/*
* report in the results
*/
if (err_8500) {
if (testnum > 0) {
errmsg = strprintf(
"%d: divmod_8500(%d,,,%d): %d failures",
testnum, N, testnum, err_8500);
prob(errmsg);
} else {
printf("%s failure%s", err_8500,
(err_8500 > 1) ? "s" : "");
}
} else {
if (testnum > 0) {
errmsg = strprintf("%d: divmod_8500(%d,,,%d)",
testnum, N, testnum);
vrfy(err_8500 == 0, errmsg);
} else {
print "No failure";
}
}
}
/*
* ver_8500 != 0 displays failures; ver_8500 > 1 displays all numbers tested
*/
ver_8500 = 0;
print '8501: ver_8500 = 0';
old_seed_8500 = srand(31^61);
print '8502: old_seed_8500 = srand(31^61)';
/*
* do the tests
*/
divmod_8500(250, 2^128, 2^1, 8503);
divmod_8500(250, 2^128, 2^64, 8504);
divmod_8500(250, 2^256, 2^64, 8505);
divmod_8500(250, 2^1024, 2^64, 8506);
divmod_8500(250, 2^1024, 2^128, 8507);
divmod_8500(250, 2^16384, 2^1024, 8508);
divmod_8500(1000, 2^128, 2^64, 8509);
/*
* restore state
*/
config("all", cfg_8500),;
print '8510: config("all", cfg_8500),';
srand(old_seed_8500),;
print '8511: srand(old_seed_8500),';
/*
* finished with 8500 tests
*/
print '8512: Ending test_divmod';

277
matfunc.c
View File

@@ -44,7 +44,8 @@ matadd(MATRIX *m1, MATRIX *m2)
max1 = m1->m_max[dim];
min2 = m2->m_min[dim];
max2 = m2->m_max[dim];
if ((min1 && min2 && (min1 != min2)) || ((max1-min1) != (max2-min2))) {
if ((min1 && min2 && (min1 != min2)) ||
((max1-min1) != (max2-min2))) {
math_error("Incompatible matrix bounds for add");
/*NOTREACHED*/
}
@@ -85,7 +86,8 @@ matsub(MATRIX *m1, MATRIX *m2)
max1 = m1->m_max[dim];
min2 = m2->m_min[dim];
max2 = m2->m_max[dim];
if ((min1 && min2 && (min1 != min2)) || ((max1-min1) != (max2-min2))) {
if ((min1 && min2 && (min1 != min2)) ||
((max1-min1) != (max2-min2))) {
math_error("Incompatible matrix bounds for sub");
/*NOTREACHED*/
}
@@ -131,15 +133,89 @@ matmul(MATRIX *m1, MATRIX *m2)
{
register MATRIX *res;
long i1, i2, max1, max2, index, maxindex;
VALUE *v1, *v2;
VALUE *v1, *v2, *vres;
VALUE sum, tmp1, tmp2;
if (m1->m_dim == 0) {
i2 = m2->m_size;
v2 = m2->m_table;
res = matalloc(i2);
*res = *m2;
vres = res->m_table;
while (i2-- > 0)
mulvalue(m1->m_table, v2++, vres++);
return res;
}
if (m2->m_dim == 0) {
i1 = m1->m_size;
v1 = m1->m_table;
res = matalloc(i1);
*res = *m1;
vres = res->m_table;
while (i1-- > 0)
mulvalue(v1++, m2->m_table, vres++);
return res;
}
if (m1->m_dim == 1 && m2->m_dim == 1) {
if (m1->m_max[0]-m1->m_min[0] != m2->m_max[0]-m2->m_min[0]) {
math_error("Incompatible bounds for 1D * 1D matmul");
/*NOTREACHED*/
}
res = matalloc(m1->m_size);
*res = *m1;
v1 = m1->m_table;
v2 = m2->m_table;
vres = res->m_table;
for (index = m1->m_size; index > 0; index--)
mulvalue(v1++, v2++, vres++);
return res;
}
if (m1->m_dim == 1 && m2->m_dim == 2) {
if (m1->m_max[0]-m1->m_min[0] != m2->m_max[0]-m2->m_min[0]) {
math_error("Incompatible bounds for 1D * 2D matmul");
/*NOTREACHED*/
}
res = matalloc(m2->m_size);
*res = *m2;
i1 = m1->m_max[0] - m1->m_min[0] + 1;
max2 = m2->m_max[1] - m2->m_min[1] + 1;
v1 = m1->m_table;
v2 = m2->m_table;
vres = res->m_table;
while (i1-- > 0) {
i2 = max2;
while (i2-- > 0)
mulvalue(v1, v2++, vres++);
v1++;
}
return res;
}
if (m1->m_dim == 2 && m2->m_dim == 1) {
if (m1->m_max[1]-m1->m_min[1] != m2->m_max[0]-m2->m_min[0]) {
math_error("Incompatible bounds for 2D * 1D matmul");
/*NOTREACHED*/
}
res = matalloc(m1->m_size);
*res = *m1;
i1 = m1->m_max[0] - m1->m_min[0] + 1;
max1 = m1->m_max[1] - m1->m_min[1] + 1;
v1 = m1->m_table;
vres = res->m_table;
while (i1-- > 0) {
v2 = m2->m_table;
i2 = max1;
while (i2-- > 0)
mulvalue(v1++, v2++, vres++);
}
return res;
}
if ((m1->m_dim != 2) || (m2->m_dim != 2)) {
math_error("Matrix dimension must be two for mul");
math_error("Matrix dimensions not compatible for mul");
/*NOTREACHED*/
}
if ((m1->m_max[1] - m1->m_min[1]) != (m2->m_max[0] - m2->m_min[0])) {
math_error("Incompatible bounds for matrix mul");
if ((m1->m_max[1]-m1->m_min[1]) != (m2->m_max[0]-m2->m_min[0])) {
math_error("Incompatible bounds for 2D * 2D matrix mul");
/*NOTREACHED*/
}
max1 = (m1->m_max[0] - m1->m_min[0] + 1);
@@ -164,7 +240,8 @@ matmul(MATRIX *m1, MATRIX *m2)
freevalue(&sum);
sum = tmp2;
v1++;
v2 += max2;
if (index+1 < maxindex)
v2 += max2;
}
index = (i1 * max2) + i2;
res->m_table[index] = sum;
@@ -185,8 +262,17 @@ matsquare(MATRIX *m)
VALUE *v1, *v2;
VALUE sum, tmp1, tmp2;
if (m->m_dim < 2) {
res = matalloc(m->m_size);
*res = *m;
v1 = m->m_table;
v2 = res->m_table;
for (index = m->m_size; index > 0; index--)
squarevalue(v1++, v2++);
return res;
}
if (m->m_dim != 2) {
math_error("Matrix dimension must be two for square");
math_error("Matrix dimension exceeds two for square");
/*NOTREACHED*/
}
if ((m->m_max[0] - m->m_min[0]) != (m->m_max[1] - m->m_min[1])) {
@@ -224,7 +310,8 @@ matsquare(MATRIX *m)
/*
* Compute the result of raising a square matrix to an integer power.
* Compute the result of raising a matrix to an integer power if
* dimension <= 2 and for dimension == 2, the matrix is square.
* Negative powers mean the positive power of the inverse.
* Note: This calculation could someday be improved for large powers
* by using the characteristic polynomial of the matrix.
@@ -240,12 +327,13 @@ matpowi(MATRIX *m, NUMBER *q)
long power; /* power to raise to */
FULL bit; /* current bit value */
if (m->m_dim != 2) {
math_error("Matrix dimension must be two for power");
if (m->m_dim > 2) {
math_error("Matrix dimension greater than 2 for power");
/*NOTREACHED*/
}
if ((m->m_max[0] - m->m_min[0]) != (m->m_max[1] - m->m_min[1])) {
math_error("Raising non-square matrix to a power");
if (m->m_dim == 2 && (m->m_max[0] - m->m_min[0] !=
m->m_max[1] - m->m_min[1])) {
math_error("Raising non-square 2D matrix to a power");
/*NOTREACHED*/
}
if (qisfrac(q)) {
@@ -544,6 +632,10 @@ mattrace(MATRIX *m)
VALUE tmp;
long i, j;
if (m->m_dim < 2) {
matsum(m, &sum);
return sum;
}
if (m->m_dim != 2)
return error_value(E_MATTRACE2);
i = (m->m_max[0] - m->m_min[0] + 1);
@@ -574,6 +666,8 @@ mattrans(MATRIX *m)
long row, col; /* current row and column */
MATRIX *res;
if (m->m_dim < 2)
return matcopy(m);
res = matalloc(m->m_size);
res->m_dim = 2;
res->m_min[0] = m->m_min[1];
@@ -742,13 +836,15 @@ matindex(MATRIX *mp, BOOL create, long dim, VALUE *indices)
long offset; /* current offset into array */
int i; /* loop counter */
if (dim <= 0) {
math_error("Bad dimension %ld for matrix", dim);
if (dim < 0) {
math_error("Negative dimension %ld for matrix", dim);
/*NOTREACHED*/
}
for (;;) {
if (dim < mp->m_dim) {
math_error("Indexing a %ldd matrix as a %ldd matrix", mp->m_dim, dim);
math_error(
"Indexing a %ldd matrix as a %ldd matrix",
mp->m_dim, dim);
/*NOTREACHED*/
}
offset = 0;
@@ -763,7 +859,8 @@ matindex(MATRIX *mp, BOOL create, long dim, VALUE *indices)
/*NOTREACHED*/
}
index = qtoi(q);
if (zge31b(q->num) || (index < mp->m_min[i]) || (index > mp->m_max[i])) {
if (zge31b(q->num) || (index < mp->m_min[i]) ||
(index > mp->m_max[i])) {
math_error("Index out of bounds for matrix");
/*NOTREACHED*/
}
@@ -785,6 +882,36 @@ matindex(MATRIX *mp, BOOL create, long dim, VALUE *indices)
}
/*
* Returns the list of indices for a matrix element with specified
* double-bracket index.
*/
LIST *
matindices(MATRIX *mp, long index)
{
LIST *lp;
int j;
long d;
VALUE val;
if (index < 0 || index >= mp->m_size)
return NULL;
lp = listalloc();
val.v_type = V_NUM;
j = mp->m_dim;
while (--j >= 0) {
d = mp->m_max[j] - mp->m_min[j] + 1;
val.v_num = itoq(index % d + mp->m_min[j]);
insertlistfirst(lp, &val);
qfree(val.v_num);
index /= d;
}
return lp;
}
/*
* Search a matrix for the specified value, starting with the specified index.
* Returns 0 and stores index if value found; otherwise returns 1.
@@ -898,7 +1025,8 @@ matident(MATRIX *m)
MATRIX *res; /* resulting matrix */
if (m->m_dim != 2) {
math_error("Matrix dimension must be two for setting to identity");
math_error(
"Matrix dimension must be two for setting to identity");
/*NOTREACHED*/
}
if ((m->m_max[0] - m->m_min[0]) != (m->m_max[1] - m->m_min[1])) {
@@ -912,7 +1040,8 @@ matident(MATRIX *m)
for (row = 0; row < rows; row++) {
for (col = 0; col < rows; col++) {
val->v_type = V_NUM;
val->v_num = ((row == col) ? qlink(&_qone_) : qlink(&_qzero_));
val->v_num = ((row == col) ? qlink(&_qone_) :
qlink(&_qzero_));
val++;
}
}
@@ -934,11 +1063,21 @@ matinv(MATRIX *m)
long cur; /* current row being worked on */
long row, col; /* temp row and column values */
VALUE *val; /* current value in matrix*/
VALUE *vres; /* current value in result for dim < 2 */
VALUE mulval; /* value to multiply rows by */
VALUE tmpval; /* temporary value */
if (m->m_dim < 2) {
res = matalloc(m->m_size);
*res = *m;
val = m->m_table;
vres = res->m_table;
for (cur = m->m_size; cur > 0; cur--)
invertvalue(val++, vres++);
return res;
}
if (m->m_dim != 2) {
math_error("Matrix dimension must be two for inverse");
math_error("Matrix dimension exceeds two for inverse");
/*NOTREACHED*/
}
if ((m->m_max[0] - m->m_min[0]) != (m->m_max[1] - m->m_min[1])) {
@@ -994,26 +1133,30 @@ matinv(MATRIX *m)
matswaprow(res, row, cur);
}
/*
* Now for every other nonzero entry in the current column, subtract
* the appropriate multiple of the current row to force that entry
* to become zero.
* Now for every other nonzero entry in the current column,
* subtract the appropriate multiple of the current row to
* force that entry to become zero.
*/
val = &m->m_table[cur];
/* ignore Saber-C warning #26 - storing bad pointer in val */
/* ok to ignore on name matinv`val */
for (row = 0; row < rows; row++, val += rows) {
if ((row == cur) || (testvalue(val) == 0))
for (row = 0; row < rows; row++) {
if ((row == cur) || (testvalue(val) == 0)) {
if (row+1 < rows)
val += rows;
continue;
}
mulvalue(val, &mulval, &tmpval);
matsubrow(m, row, cur, &tmpval);
matsubrow(res, row, cur, &tmpval);
freevalue(&tmpval);
if (row+1 < rows)
val += rows;
}
freevalue(&mulval);
}
/*
* Now the original matrix has nonzero entries only on its main diagonal.
* Scale the rows of the result matrix by the inverse of those entries.
* Now the original matrix has nonzero entries only on its main
* diagonal. Scale the rows of the result matrix by the inverse
* of those entries.
*/
val = m->m_table;
for (row = 0; row < rows; row++) {
@@ -1022,7 +1165,8 @@ matinv(MATRIX *m)
matmulrow(res, row, &mulval);
freevalue(&mulval);
}
val += (rows + 1);
if (row+1 < rows)
val += (rows + 1);
}
matfree(m);
return res;
@@ -1044,6 +1188,24 @@ matdet(MATRIX *m)
VALUE tmp1, tmp2, tmp3;
BOOL neg; /* whether to negate determinant */
if (m->m_dim < 2) {
vp = m->m_table;
i = m->m_size;
copyvalue(vp, &tmp1);
while (--i > 0) {
mulvalue(&tmp1, ++vp, &tmp2);
freevalue(&tmp1);
tmp1 = tmp2;
}
return tmp1;
}
if (m->m_dim != 2)
return error_value(E_DET2);
if ((m->m_max[0] - m->m_min[0]) != (m->m_max[1] - m->m_min[1]))
return error_value(E_DET3);
/*
* Loop over each row, and eliminate all lower entries in the
* corresponding column by using row operations. Copy the original
@@ -1113,7 +1275,8 @@ matdet(MATRIX *m)
}
}
div = pivot;
pivot += n + 1;
if (k > 0)
pivot += n + 1;
}
if (neg)
negvalue(div, &tmp1);
@@ -1298,7 +1461,8 @@ matalloc(long size)
m = (MATRIX *) malloc(matsize(size));
if (m == NULL) {
math_error("Cannot get memory to allocate matrix of size %d", size);
math_error("Cannot get memory to allocate matrix of size %d",
size);
/*NOTREACHED*/
}
m->m_size = size;
@@ -1384,7 +1548,8 @@ matcmp(MATRIX *m1, MATRIX *m2)
if ((m1->m_dim != m2->m_dim) || (m1->m_size != m2->m_size))
return TRUE;
for (i = 0; i < m1->m_dim; i++) {
if ((m1->m_max[i] - m1->m_min[i]) != (m2->m_max[i] - m2->m_min[i]))
if ((m1->m_max[i] - m1->m_min[i]) !=
(m2->m_max[i] - m2->m_min[i]))
return TRUE;
}
v1 = m1->m_table;
@@ -1509,10 +1674,20 @@ matisident(MATRIX *m)
register VALUE *val; /* current value */
long row, col; /* row and column numbers */
val = m->m_table;
if (m->m_dim == 0) {
return (val->v_type == V_NUM && qisone(val->v_num));
}
if (m->m_dim == 1) {
for (row = m->m_min[0]; row <= m->m_max[0]; row++, val++) {
if (val->v_type != V_NUM || !qisone(val->v_num))
return FALSE;
}
return TRUE;
}
if ((m->m_dim != 2) ||
((m->m_max[0] - m->m_min[0]) != (m->m_max[1] - m->m_min[1])))
return FALSE;
val = m->m_table;
for (row = m->m_min[0]; row <= m->m_max[0]; row++) {
/*
* We could use col = m->m_min[1]; col < m->m_max[1]
@@ -1558,15 +1733,22 @@ matprint(MATRIX *m, long max_print)
fullsize *= (m->m_max[i] - m->m_min[i] + 1);
}
msg = ((max_print > 0) ? "\nmat [" : "mat [");
for (i = 0; i < dim; i++) {
if (m->m_min[i])
math_fmt("%s%ld:%ld", msg, m->m_min[i], m->m_max[i]);
else
math_fmt("%s%ld", msg, m->m_max[i] + 1);
msg = ",";
if (dim) {
for (i = 0; i < dim; i++) {
if (m->m_min[i]) {
math_fmt("%s%ld:%ld", msg,
m->m_min[i], m->m_max[i]);
} else {
math_fmt("%s%ld", msg, m->m_max[i] + 1);
}
msg = ",";
}
} else {
math_str("mat [");
}
if (max_print > fullsize)
if (max_print > fullsize) {
max_print = fullsize;
}
vp = m->m_table;
count = 0;
for (index = 0; index < fullsize; index++) {
@@ -1588,10 +1770,15 @@ matprint(MATRIX *m, long max_print)
for (index = 0; index < max_print; index++) {
msg = " [";
j = index;
for (i = 0; i < dim; i++) {
math_fmt("%s%ld", msg, m->m_min[i] + (j / sizes[i]));
j %= sizes[i];
msg = ",";
if (dim) {
for (i = 0; i < dim; i++) {
math_fmt("%s%ld", msg,
m->m_min[i] + (j / sizes[i]));
j %= sizes[i];
msg = ",";
}
} else {
math_str(msg);
}
math_str("] = ");
printvalue(vp++, PRINT_SHORT | PRINT_UNAMBIG);

View File

@@ -44,7 +44,7 @@
*/
typedef struct {
char *name; /* name of configuration string */
int type; /* type for configuration */
long type; /* type for configuration */
} NAMETYPE;

View File

@@ -320,7 +320,7 @@ o_matcreate(FUNC *fp, long dim)
long tmp; /* temporary */
long size; /* size of matrix */
if ((dim <= 0) || (dim > MAXDIM)) {
if ((dim < 0) || (dim > MAXDIM)) {
math_error("Bad dimension %ld for matrix", dim);
/*NOTREACHED*/
}
@@ -489,8 +489,8 @@ o_indexaddr(FUNC *fp, long dim, long writeflag)
BLOCK *blk;
flag = (writeflag != 0);
if (dim <= 0) {
math_error("Zero or negative dimensions for indexing");
if (dim < 0) {
math_error("Negative dimension for indexing");
/*NOTREACHED*/
}
val = &stack[-dim];

6
qmod.c
View File

@@ -327,7 +327,7 @@ qfindredc(NUMBER *q)
/*
* First try for an exact pointer match in the table.
*/
for (rcp = redc_cache; rcp < &redc_cache[MAXREDC]; rcp++) {
for (rcp = redc_cache; rcp <= &redc_cache[MAXREDC-1]; rcp++) {
if (q == rcp->rnum) {
rcp->age = ++redc_age;
return rcp->redc;
@@ -337,7 +337,7 @@ qfindredc(NUMBER *q)
/*
* Search the table again looking for a value which matches.
*/
for (rcp = redc_cache; rcp < &redc_cache[MAXREDC]; rcp++) {
for (rcp = redc_cache; rcp <= &redc_cache[MAXREDC-1]; rcp++) {
if (rcp->age && (qcmp(q, rcp->rnum) == 0)) {
rcp->age = ++redc_age;
return rcp->redc;
@@ -355,7 +355,7 @@ qfindredc(NUMBER *q)
}
bestrcp = NULL;
for (rcp = redc_cache; rcp < &redc_cache[MAXREDC]; rcp++) {
for (rcp = redc_cache; rcp <= &redc_cache[MAXREDC-1]; rcp++) {
if ((bestrcp == NULL) || (rcp->age < bestrcp->age))
bestrcp = rcp;
}

View File

@@ -271,12 +271,14 @@ mathash(MATRIX *m, QCKHASH val)
* hash 10 more elements if they exist
*/
i = 16;
vp = &m->m_table[16];
skip = (m->m_size / 11) + 1;
while (i < m->m_size) {
val = hashvalue(vp, val);
i += skip;
vp += skip;
if (i < m->m_size) {
vp = (VALUE *)&m->m_table[i];
skip = (m->m_size / 11) + 1;
while (i < m->m_size) {
val = hashvalue(vp, val);
i += skip;
vp += skip;
}
}
return val;
}
@@ -408,6 +410,7 @@ config_hash(CONFIG *cfg, QCKHASH val)
value = (((value>>5) | (value<<27)) ^ (USB32)cfg->lib_debug);
value = (((value>>5) | (value<<27)) ^ (USB32)cfg->user_debug);
value = (((value>>5) | (value<<27)) ^ (USB32)cfg->verbose_quit);
value = (((value>>5) | (value<<27)) ^ (USB32)cfg->ctrl_d);
/*
* hash the built up scalar

View File

@@ -263,6 +263,10 @@ H_SRC= ${SAMPLE_H_SRC}
#
DISTLIST= ${C_SRC} ${H_SRC} ${MAKE_FILE} README_SAMPLE
# These files are used to make (but not built) a calc .a library
#
CALCLIBLIST= ${C_SRC} ${H_SRC} ${MAKE_FILE} README_SAMPLE
# complete list of targets
#
TARGETS= many_random test_random
@@ -327,6 +331,13 @@ distlist: ${DISTLIST}
distdir:
${Q}echo sample
calcliblist:
${Q}for i in ${CALCLIBLIST} /dev/null; do \
if [ X"$$i" != X"/dev/null" ]; then \
echo sample/$$i; \
fi; \
done
##
#
# Home grown make dependency rules. Your system make not support

View File

@@ -584,8 +584,20 @@ stringsegment(STRING *s1, long n1, long n2)
s->s_str = c;
c1 = s1->s_str + n1;
if (n1 >= n2) {
while (len-- > 0)
/*
* We prevent the c1 pointer from walking behind s1_s_str
* by stopping one short of the end and running the loop one
* more time.
*
* We could stop the loop with just len-- > 0, but stopping
* short and running the loop one last time manually helps make
* code checkers such as insure happy.
*/
while (len-- > 1) {
*c++ = *c1--;
}
/* run the loop manually one last time */
*c++ = *c1;
} else {
while (len-- > 0)
*c++ = *c1++;
@@ -1074,9 +1086,8 @@ makenewstring(char *str)
s = stralloc();
s->s_str = c;
s->s_len = len;
while (len-- > 0)
*c++ = *str++;
*c = '\0';
memcpy(c, str, len);
c[len] = '\0';
return s;
}
@@ -1085,7 +1096,7 @@ STRING *
stringcopy (STRING *s1)
{
STRING *s;
char *c, *c1;
char *c;
long len;
len = s1->s_len;
@@ -1099,10 +1110,8 @@ stringcopy (STRING *s1)
s = stralloc();
s->s_len = len;
s->s_str = c;
c1 = s1->s_str;
while (len-- > 0)
*c++ = *c1++;
*c = '\0';
memcpy(c, s1->s_str, len);
c[len] = '\0';
return s;
}

View File

@@ -2827,7 +2827,8 @@ config_print(CONFIG *cfg)
for (cp = configs; cp->name; cp++) {
/* skip if special all or duplicate maxerr value */
if (cp->type == CONFIG_ALL || strcmp(cp->name, "maxerr") == 0)
if (cp->type == CONFIG_ALL || strcmp(cp->name, "maxerr") == 0 ||
strcmp(cp->name, "ctrl-d") == 0)
continue;
/* print tab if allowed */

View File

@@ -18,7 +18,7 @@ static char *program;
#define MAJOR_VER 2 /* major version */
#define MINOR_VER 11 /* minor version */
#define MAJOR_PATCH 0 /* patch level or 0 if no patch */
#define MINOR_PATCH "10.1" /* test number or empty string if no patch */
#define MINOR_PATCH "10.4" /* test number or empty string if no patch */
/*
* calc version constants

38
zio.c
View File

@@ -394,7 +394,7 @@ zprintb(ZVALUE z, long width)
didprint = 0;
PUTSTR("0b");
while (len-- >= 0) {
val = *hp--;
val = ((len >= 0) ? *hp-- : *hp);
mask = ((HALF)1 << (BASEB - 1));
while (mask) {
ch = '0' + ((mask & val) != 0);
@@ -481,15 +481,17 @@ zprinto(ZVALUE z, long width)
break;
}
len -= rem;
hp -= rem;
while (len > 0) { /* finish in groups of 3 words */
PRINTF4("%08lo%08lo%08lo%08lo",
(PRINT) ((hp[0]) >> 8),
(PRINT) (((hp[0] & 0xff) << 16) + (hp[-1] >> 16)),
(PRINT) (((hp[-1] & 0xffff) << 8) + (hp[-2] >> 24)),
(PRINT) (hp[-2] & 0xffffff));
hp -= 3;
len -= 3;
if (len > 0) {
hp -= rem;
while (len > 0) { /* finish in groups of 3 words */
PRINTF4("%08lo%08lo%08lo%08lo",
(PRINT) ((hp[0]) >> 8),
(PRINT) (((hp[0] & 0xff) << 16) + (hp[-1] >> 16)),
(PRINT) (((hp[-1] & 0xffff) << 8) + (hp[-2] >> 24)),
(PRINT) (hp[-2] & 0xffffff));
hp -= 3;
len -= 3;
}
}
#else
switch (rem) { /* handle odd amounts first */
@@ -513,13 +515,15 @@ zprinto(ZVALUE z, long width)
PRINTF1("0%lo", num2);
}
len -= rem;
hp -= rem;
while (len > 0) { /* finish in groups of 3 halfwords */
PRINTF2("%08lo%08lo",
((((FULL) hp[0]) << 8) + (((FULL) hp[-1]) >> 8)),
((((FULL) (hp[-1] & 0xff)) << 16) + ((FULL) hp[-2])));
hp -= 3;
len -= 3;
if (len > 0) {
hp -= rem;
while (len > 0) { /* finish in groups of 3 halfwords */
PRINTF2("%08lo%08lo",
((((FULL) hp[0]) << 8) + (((FULL) hp[-1]) >> 8)),
((((FULL) (hp[-1] & 0xff))<<16) + ((FULL) hp[-2])));
hp -= 3;
len -= 3;
}
}
#endif
}

129
zmath.c
View File

@@ -436,12 +436,10 @@ zsub(ZVALUE z1, ZVALUE z2, ZVALUE *res)
len1 = z1.len;
len2 = z2.len;
if (len1 == len2) {
h1 = z1.v + len1 - 1;
h2 = z2.v + len2 - 1;
while ((len1 > 0) && ((FULL)*h1 == (FULL)*h2)) {
h1 = z1.v + len1;
h2 = z2.v + len2;
while ((len1 > 0) && ((FULL)*--h1 == (FULL)*--h2)) {
len1--;
h1--;
h2--;
}
if (len1 == 0) {
*res = _zero_;
@@ -633,10 +631,12 @@ zdiv(ZVALUE z1, ZVALUE z2, ZVALUE *quo, ZVALUE *rem, long rnd)
A[m + 1] = 0;
len = m - n + 1; /* quotient length will be len or len +/- 1 */
a1 = A + n; /* start of digits for quotient */
b0 = B - 1;
b0 = B;
p = n;
while (!*++b0) /* b0: working start for divisor */
p--;
while (!*b0) { /* b0: working start for divisor */
++b0;
--p;
}
if (p == 1) {
u = *b0;
if (u == 1) {
@@ -893,10 +893,12 @@ zequo(ZVALUE z1, ZVALUE z2, ZVALUE *res)
math_error("Bad call to zequo");
/*NOTREACHED*/
}
B = z2.v - 1;
B = z2.v;
o = 0;
while (!*++B)
o++;
while (!*B) {
++B;
++o;
}
m = z1.len - o;
n = z2.len - o;
len = m - n + 1; /* Maximum length of quotient */
@@ -1047,12 +1049,12 @@ zdivi(ZVALUE z, long n, ZVALUE *res)
dest.sign = z.sign;
dest.len = len;
dest.v = alloc(len);
h1 = z.v + len - 1;
sd = dest.v + len - 1;
h1 = z.v + len;
sd = dest.v + len;
val = 0;
while (len--) {
val = ((val << BASEB) + ((FULL) *h1--));
*sd-- = (HALF)(val / n);
val = ((val << BASEB) + ((FULL) *--h1));
*--sd = (HALF)(val / n);
val %= n;
}
zquicktrim(dest);
@@ -1111,10 +1113,10 @@ zmodi(ZVALUE z, long n)
* The modulus is by a small number, so we can do this quickly.
*/
len = z.len;
h1 = z.v + len - 1;
h1 = z.v + len;
val = 0;
while (len--)
val = ((val << BASEB) + ((FULL) *h1--)) % n;
while (len-- > 0)
val = ((val << BASEB) + ((FULL) *--h1)) % n;
if (val && z.sign)
val = n - val;
return (long)val;
@@ -1618,15 +1620,14 @@ ztest(ZVALUE z)
/*
* Compare two numbers to see which is larger.
* Returns -1 if first number is smaller, 0 if they are equal, and 1 if
* first number is larger. This is the same result as ztest(z2-z1).
* Return the sign of z1 - z2, i.e. 1 if the first integer is greater,
* 0 if they are equal, -1 otherwise.
*/
FLAG
zrel(ZVALUE z1, ZVALUE z2)
{
register HALF *h1, *h2;
register FULL len1, len2;
HALF *h1, *h2;
LEN len;
int sign;
sign = 1;
@@ -1636,66 +1637,47 @@ zrel(ZVALUE z1, ZVALUE z2)
return -1;
if (z2.sign)
sign = -1;
len1 = z1.len;
len2 = z2.len;
h1 = z1.v + z1.len - 1;
h2 = z2.v + z2.len - 1;
while (len1 > len2) {
if (*h1--)
return sign;
len1--;
}
while (len2 > len1) {
if (*h2--)
return -sign;
len2--;
}
while (len1--) {
if (*h1-- != *h2--)
if (z1.len != z2.len)
return (z1.len > z2.len) ? sign : -sign;
len = z1.len;
h1 = z1.v + len;
h2 = z2.v + len;
while (len > 0) {
if (*--h1 != *--h2)
break;
len--;
}
if ((len1 = *++h1) > (len2 = *++h2))
return sign;
if (len1 < len2)
return -sign;
if (len > 0)
return (*h1 > *h2) ? sign : -sign;
return 0;
}
/*
* Compare the absolute value two numbers to see which is larger.
* Returns -1 if first number is smaller, 0 if they are equal, and 1 if
* first number is larger. This is the same result as ztest(abs(z2)-abs(z1))
* or zrel(abs(z1), abs(z2)).
* Return the sign of abs(z1) - abs(z2), i.e. 1 if the first integer
* has greater absolute value, 0 is they have equal absolute value,
* -1 otherwise.
*/
FLAG
zabsrel(ZVALUE z1, ZVALUE z2)
{
register HALF *h1, *h2;
register FULL len1, len2;
HALF *h1, *h2;
LEN len;
len1 = z1.len;
len2 = z2.len;
h1 = z1.v + z1.len - 1;
h2 = z2.v + z2.len - 1;
while (len1 > len2) {
if (*h1--)
return 1;
len1--;
}
while (len2 > len1) {
if (*h2--)
return -1;
len2--;
}
while (len1--) {
if (*h1-- != *h2--)
if (z1.len != z2.len)
return (z1.len > z2.len) ? 1 : -1;
len = z1.len;
h1 = z1.v + len;
h2 = z2.v + len;
while (len > 0) {
if (*--h1 != *--h2)
break;
len--;
}
if ((len1 = *++h1) > (len2 = *++h2))
return 1;
if (len1 < len2)
return -1;
if (len > 0)
return (*h1 > *h2) ? 1 : -1;
return 0;
}
@@ -1715,8 +1697,8 @@ zcmp(ZVALUE z1, ZVALUE z2)
len = z1.len;
h1 = z1.v;
h2 = z2.v;
while (len-- > 0) {
if (*h1++ != *h2++)
while (--len > 0) {
if (*++h1 != *++h2)
return TRUE;
}
return FALSE;
@@ -1804,13 +1786,12 @@ zshiftr(ZVALUE z, long n)
}
if (n) {
len = z.len;
h = z.v + len - 1;
h = z.v + len;
mask = 0;
while (len--) {
maskt = (((FULL) *h) << (BASEB - n)) & BASE1;
maskt = (((FULL) *--h) << (BASEB - n)) & BASE1;
*h = ((*h >> n) | (HALF)mask);
mask = maskt;
--h;
}
}
}

40
zmod.c
View File

@@ -543,7 +543,7 @@ zpowermod(ZVALUE z1, ZVALUE z2, ZVALUE z3, ZVALUE *res)
}
/* zzz */
for (pp = &lowpowers[2]; pp < &lowpowers[POWNUMS]; pp++) {
for (pp = &lowpowers[2]; pp <= &lowpowers[POWNUMS-1]; pp++) {
pp->len = 0;
pp->v = NULL;
}
@@ -558,16 +558,17 @@ zpowermod(ZVALUE z1, ZVALUE z2, ZVALUE z3, ZVALUE *res)
curshift -= POWBITS;
/*
* Calculate the result by examining the power POWBITS bits at a time,
* and use the table of low powers at each iteration.
* Calculate the result by examining the power POWBITS bits at
* a time, and use the table of low powers at each iteration.
*/
for (;;) {
curpow = (curhalf >> curshift) & (POWNUMS - 1);
pp = &lowpowers[curpow];
/*
* If the small power is not yet saved in the table, then
* calculate it and remember it in the table for future use.
* If the small power is not yet saved in the table,
* then calculate it and remember it in the table for
* future use.
*/
if (pp->v == NULL) {
if (curpow & 0x1)
@@ -575,10 +576,13 @@ zpowermod(ZVALUE z1, ZVALUE z2, ZVALUE z3, ZVALUE *res)
else
modpow = _one_;
for (curbit = 0x2; curbit <= curpow; curbit *= 2) {
for (curbit = 0x2;
curbit <= curpow;
curbit *= 2) {
pp = &lowpowers[curbit];
if (pp->v == NULL) {
zsquare(lowpowers[curbit/2], &temp);
zsquare(lowpowers[curbit/2],
&temp);
zmod5(&temp);
zcopy(temp, pp);
zfree(temp);
@@ -599,8 +603,8 @@ zpowermod(ZVALUE z1, ZVALUE z2, ZVALUE z3, ZVALUE *res)
}
/*
* If the power is nonzero, then accumulate the small power
* into the result.
* If the power is nonzero, then accumulate the small
* power into the result.
*/
if (curpow) {
zmul(ans, *pp, &temp);
@@ -611,20 +615,20 @@ zpowermod(ZVALUE z1, ZVALUE z2, ZVALUE z3, ZVALUE *res)
}
/*
* Select the next POWBITS bits of the power, if there is
* any more to generate.
* Select the next POWBITS bits of the power, if
* there is any more to generate.
*/
curshift -= POWBITS;
if (curshift < 0) {
if (hp-- == z2.v)
if (hp == z2.v)
break;
curhalf = *hp;
curhalf = *--hp;
curshift = BASEB - POWBITS;
}
/*
* Square the result POWBITS times to make room for the next
* chunk of bits.
* Square the result POWBITS times to make room for
* the next chunk of bits.
*/
for (i = 0; i < POWBITS; i++) {
zsquare(ans, &temp);
@@ -635,7 +639,7 @@ zpowermod(ZVALUE z1, ZVALUE z2, ZVALUE z3, ZVALUE *res)
}
}
for (pp = &lowpowers[2]; pp < &lowpowers[POWNUMS]; pp++) {
for (pp = &lowpowers[2]; pp <= &lowpowers[POWNUMS-1]; pp++) {
if (pp->v != NULL)
freeh(pp->v);
}
@@ -669,7 +673,7 @@ zpowermod(ZVALUE z1, ZVALUE z2, ZVALUE z3, ZVALUE *res)
* Modulus or power is small enough to perform the power raising
* directly. Initialize the table of powers.
*/
for (pp = &lowpowers[2]; pp < &lowpowers[POWNUMS]; pp++) {
for (pp = &lowpowers[2]; pp <= &lowpowers[POWNUMS-1]; pp++) {
pp->len = 0;
pp->v = NULL;
}
@@ -757,7 +761,7 @@ zpowermod(ZVALUE z1, ZVALUE z2, ZVALUE z3, ZVALUE *res)
}
}
for (pp = &lowpowers[2]; pp < &lowpowers[POWNUMS]; pp++) {
for (pp = &lowpowers[2]; pp <= &lowpowers[POWNUMS-1]; pp++) {
if (pp->v != NULL)
freeh(pp->v);
}

101
zmul.c
View File

@@ -279,106 +279,7 @@ domul(HALF *v1, LEN size1, HALF *v2, LEN size2, HALF *ans)
*/
baseA = v1 + shift;
baseB = v1;
/*
* XXX - is this still an issue?
*
* Saber-C Version 3.1 says:
*
* W#26, Storing a bad pointer into auto variable dmul`baseC.
*
* This warning is issued during the regression test #026
* (read cryrand).
*
* Saver-C claims that v2+shift is past the end of allocated
* memory for v2.
*
* This warning may be triggered by executing the following code:
*
* a = 0xffff0000ffffffff00000000ffff0000000000000000ffff;
* config("mul2", 2);
* pmod(3,a-1,a);
*
* [[ NOTE: The above code no longer invokes this code. ]]
*
* When this code is executed, shift == 6 and v2 is 3 shorts
* long (size2 == 2). This baseC points 3 shorts beyond the
* allocated end of v2.
*
* The stack was as follows: [[NOTE: line numbers may have changed]]
*
* domul(v1=0x2d93d8, size1=12,
* v2=0x2ded30, size2=2, ans=0x2ee8a8) at "zmul.c":313
* zmul(z1=0x2ee928, z2=0x2ee92c, res=0x16d8c0) at "zmul.c":73
* zpowermod(z1=0x2ee828, z2=0x2ee82c,
* z3=0x2ee830, res=0x57bfe4) at "zmod.c":666
* qpowermod(q1=0x57bf90, q2=0x57bfc8, q3=0x57bf3c) at "qfunc.c":78
* builtinfunc(...) at "func.c":400
* o_call(...) at "opcodes.c":2094
* calculate(...) at "opcodes.c":288
* evaluate(...) at "codegen.c":170
* getcommands(...) at "codegen.c":109
* main(...) at "calc.c":167
*
* The final domul() call point is the next executable line below.
*
****
*
* The insure tool also reports a problem at this position:
*
* [zmul.c:319] **COPY_BAD_RANGE**
* >> baseC = v2 + shift;
*
* Copying pointer which is out-of-range: v2 + shift
*
* [[NOTE: line numbers may have changed]]
*
* Pointer : 0x1400919cc
* Actual block : 0x140090c80 thru 0x140090def (368 bytes,92 elements)
* hp, allocated at:
* malloc()
* alloc() zmath.c, 221
* zmul() zmul.c, 73
* ztenpow() zfunc.c, 441
* str2q() qio.c, 537
* addnumber() const.c, 52
* eatnumber() token.c, 594
* gettoken() token.c, 319
* getcallargs() codegen.c, 2358
*
* Stack trace where the error occurred:
* domul() zmul.c, 319
* zmul() zmul.c, 74
* ztenpow() zfunc.c, 441
* str2q() qio.c, 537
* addnumber() const.c, 52
* eatnumber() token.c, 594
* gettoken() token.c, 319
* getcallargs() codegen.c, 2358
* getidexpr() codegen.c, 1998
* getterm() codegen.c, 1936
* getincdecexpr() codegen.c, 1820
* getreference() codegen.c, 1804
* getshiftexpr() codegen.c, 1758
* getandexpr() codegen.c, 1704
* getorexpr() codegen.c, 1682
* getproduct() codegen.c, 1654
* getsum() codegen.c, 1626
* getrelation() codegen.c, 1585
* getandcond() codegen.c, 1556
* getorcond() codegen.c, 1532
* getaltcond() codegen.c, 1499
* getassignment() codegen.c, 1442
* getopassignment() codegen.c, 1352
* getexprlist() codegen.c, 1318
* getstatement() codegen.c, 921
* evaluate() codegen.c, 219
* getcommands() codegen.c, 165
* main() calc.c, 321
*
* The final domul() call point is the next executable line below.
*/
/* ok to ignore on name domul`baseC */
baseC = v2 + shift;
baseC = v2 + ((shift <= size2) ? shift : size2);
baseD = v2;
baseAB = ans;
baseDC = ans + shift;

View File

@@ -1724,7 +1724,7 @@ randcopy(CONST RAND *state)
math_error("can't allocate RAND state");
/*NOTREACHED*/
}
*ret = *state;
memcpy(ret, state, sizeof(RAND));
/*
* return copy