Source Code 1994 March

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

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

Wrap

Text File | 1992-05-09 | 52.7 KB | 1,686 lines

Newsgroups: comp.sources.unix From: dbell@pdact.pd.necisa.oz.au (David I. Bell) Subject: v26i032: CALC - An arbitrary precision C-like calculator, Part06/21 Sender: unix-sources-moderator@pa.dec.com Approved: vixie@pa.dec.com Submitted-By: dbell@pdact.pd.necisa.oz.au (David I. Bell) Posting-Number: Volume 26, Issue 32 Archive-Name: calc/part06 #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh <file", e.g.. If this archive is complete, you # will see the following message at the end: # "End of archive 6 (of 21)." # Contents: Makefile calc.h help/builtin token.c # Wrapped by dbell@elm on Tue Feb 25 15:21:01 1992 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'Makefile' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'Makefile'\" else echo shar: Extracting \"'Makefile'\" $13308 characters$ sed "s/^X//" >'Makefile' <<'END_OF_FILE' X# X# Copyright (c) 1992 David I. Bell and Landon Curt Noll X# Permission is granted to use, distribute, or modify this source, X# provided that this copyright notice remains intact. X# X# Arbitrary precision calculator. X# X# calculator by David I. Bell X# makefile by Landon Curt Noll X X############################################################################## X#-=-=-=-=-=-=-=-=- You may want to change some values below -=-=-=-=-=-=-=-=-# X############################################################################## X X# Determine the type of varargs that you want to use X# X# VARARG value meaning X# ------------ ------- X# (nothing) let the makefile guess at what you need X# STDARG you have ANSI C and /usr/include/stdarg.h X# VARARGS you have /usr/include/varargs.h X# SIMULATE_STDARG use simulated ./stdarg.h X# X# Try defining VARARG to be nothing. The makefile will look for the X# needed .h files, trying for stdarg.h first. X# XVARARG= X#VARARG= STDARG X#VARARG= VARARGS X#VARARG= SIMULATE_STDARG X X# If your system does not have a vsprintf() function, you could be in trouble. X# X# vsprintf(stream, format, ap) X# X# This function works like sprintf except that the 3rd arg is a va_list X# strarg (or varargs) list. X# X# If you have vsprintf, then define VSPRINTF to be an empty string. X# Some old BSD systems do not have vsprintf(). If you do not have vsprintf() X# then define VSPRINTF to be -DVSPRINTF and hope for the best. X# XVSPRINTF= X#VSPRINTF= -DVSPRINTF X X# Determine the byte order of your machine X# X# Big Endian: -DBIG_ENDIAN Amdahl, 68000, Pyramid, Mips, ... X# Little Endian: -DLITTLE_ENDIAN Vax, 32000, 386, 486, ... X# XENDIAN= -DBIG_ENDIAN X#ENDIAN= -DLITTLE_ENDIAN X X# Determine whether to use the standard UNIX malloc or the alternative one X# included with the calculator. On some machines, the alternative malloc X# may be faster. It also can help to debug malloc problems. Define X# -DUNIX_MALLOC to use the standard UNIX malloc routines. X# X# If in doubt, use the MALLOC= -DUNIX_MALLOC line. X# XMALLOC= -DUNIX_MALLOC X#MALLOC= X X# where to install binary files X# XBINDIR= /usr/local/bin X X# where to install the lib/*.calc files X# XLIBDIR= /usr/local/lib/calc X X# where to install help files X# X# The ${LIBDIR}/help is where the help files will be installed. X# XHELPDIR= ${LIBDIR}/help X X# where man pages are installed X# XMANDIR=/usr/local/man/man1 X#MANDIR=/usr/man/man1 X#MANDIR=/usr/share/man/man1 X#MANDIR=/usr/man/u_man/man1 X X# If the $CALCPATH environment variable is not defined, then the following X# path will be search for calc lib routines. X# XCALCPATH= .:./lib:~/lib:${LIBDIR} X X# If the $CALCRC environment variable is not defined, then the following X# path will be search for calc lib routines. X# XCALCRC= ${LIBDIR}/startup:~/.calcrc X X# If $PAGER is not set, use this program to display a help file X# X#CALCPAGER= less XCALCPAGER= more X#CALCPAGER= pg X#CALCPAGER= cat X X# Compile debug options X# X# Select -O, or empty string, if you don't want to debug XDEBUG= -O X#DEBUG= -g X#DEBUG= -gx X#DEBUG= -WM,-g X#DEBUG= X X# On systems that have dynamic shared libs, you want want to disable them X# for faster calc startup. X# XNO_SHARED= X#NO_SHARED= -dn X X# Some systems (System V based mostly) allow 'mkdir -p' to make a directory X# and any needed parent directories. If you system has 'mkdir -p', then X# leave the definition below, otherwise define MKDIR to be just 'mkdir' X# or simply ensure that ${LIBDIR}, ${BINDIR} and ${HELPDIR} exist before X# you do an install. X# XMKDIR=mkdir -p X#MKDIR=mkdir X X# If you are running an an classic BSD system, then you may not have X# the following functions: X# X# memcpy() strchr() memset() X# X# If you do not have these functions, define OLD_BSD to be -DOLD_BSD, X# otherwise define OLD_BSD to be an empty string. X# X# BSD-like systems such an SunOS 4.x have these functions and thus don't X# need OLD_BSD. If you don't know, try using the empty string and if X# you get complaints, try -DOLD_BSD. X# X#OLD_BSD= -DOLD_BSD XOLD_BSD= X X############################################################################## X#-=-=-=-=-=-=-=-=- Be careful if you change something below -=-=-=-=-=-=-=-=-# X############################################################################## X X# standard utilities used during make X# XSHELL= /bin/sh XMAKE= make XLINT= lint XCC= cc XCTAGS= ctags X X# -b: ignore break; that are not reachable X# -s: print lint problems one per line X# -F: produce full path names for files X# XLINTFLAGS= -b -s -F X#LINTFLAGS= X X# the calc source files X# XCALCSRC= addop.c alloc.c calc.c codegen.c comfunc.c commath.c config.c \ X const.c file.c func.c input.c io.c label.c listfunc.c matfunc.c obj.c \ X opcodes.c qfunc.c qmath.c qmod.c qtrans.c string.c symbol.c token.c \ X value.c version.c zfunc.c zmath.c zmod.c zmul.c X X# we build these .o files for calc X# XCALCOBJS= addop.o alloc.o calc.o codegen.o comfunc.o commath.o config.o \ X const.o file.o func.o input.o io.o label.o listfunc.o matfunc.o obj.o \ X opcodes.o qfunc.o qmath.o qmod.o qtrans.o string.o symbol.o token.o \ X value.o version.o zfunc.o zmath.o zmod.o zmul.o X X# we build these .h files during the make X# XBUILD_H_SRC= config.h have_malloc.h have_stdlib.h have_string.h args.h X X# The code program is not part of the calc distribution, don't worry X# if you do not have it. X# XCODEOBJS= code.o io_code.o qfunc.o qmath_code.o zfunc.o zmath.o zmul.o zmod.o X X# we build these .c files during the make X# XBUILD_CODE_SRC= io_code.c qmath_code.c X XCFLAGS= ${DEBUG} ${MALLOC} ${ENDIAN} ${OLD_BSD} ${VSPRINTF} X Xall: calc X Xcalc: ${CALCOBJS} X ${CC} ${CFLAGS} ${CALCOBJS} -o calc ${NO_SHARED} X Xconfig.h: Makefile X rm -f config.h X @echo ' forming config.h' X @echo '/*' > config.h X @echo ' * DO NOT EDIT -- generated by the Makefile' >> config.h X @echo ' */' >> config.h X @echo '' >> config.h X @echo '/* the default :-separated search path */' >> config.h X @echo '#ifndef DEFAULTCALCPATH' >> config.h X @echo '#define DEFAULTCALCPATH "${CALCPATH}"' >> config.h X @echo '#endif /* DEFAULTCALCPATH */' >> config.h X @echo '' >> config.h X @echo '/* the default :-separated startup file list */' >> config.h X @echo '#ifndef DEFAULTCALCRC' >> config.h X @echo '#define DEFAULTCALCRC "${CALCRC}"' >> config.h X @echo '#endif /* DEFAULTCALCRC */' >> config.h X @echo '' >> config.h X @echo '/* the location of the help directory */' >> config.h X @echo '#ifndef HELPDIR' >> config.h X @echo '#define HELPDIR "${HELPDIR}"' >> config.h X @echo '#endif /* HELPDIR */' >> config.h X @echo '' >> config.h X @echo '/* the default pager to use */' >> config.h X @echo '#ifndef DEFAULTCALCPAGER' >> config.h X @echo '#define DEFAULTCALCPAGER "${CALCPAGER}"' >> config.h X @echo '#endif /* DEFAULTCALCPAGER */' >> config.h X @echo ' config.h formed' X Xhave_malloc.h: Makefile X rm -f have_malloc.h X @echo ' forming have_malloc.h' X @echo '/*' > have_malloc.h X @echo ' * DO NOT EDIT -- generated by the Makefile' >> have_malloc.h X @echo ' */' >> have_malloc.h X @echo '' >> have_malloc.h X @echo '/* do we have /usr/include/malloc.h? */' > have_malloc.h X -@if [ -r /usr/include/malloc.h ]; then \ X echo '#define HAVE_MALLOC_H /* yes */' >> have_malloc.h; \ X else \ X echo '#undef HAVE_MALLOC_H /* no */' >> have_malloc.h; \ X fi X @echo ' have_malloc.h formed' X Xhave_stdlib.h: Makefile X rm -f have_stdlib.h X @echo ' forming have_stdlib.h' X @echo '/*' > have_stdlib.h X @echo ' * DO NOT EDIT -- generated by the Makefile' >> have_stdlib.h X @echo ' */' >> have_stdlib.h X @echo '' >> have_stdlib.h X @echo '/* do we have /usr/include/stdlib.h? */' > have_stdlib.h X -@if [ -r /usr/include/stdlib.h ]; then \ X echo '#define HAVE_STDLIB_H /* yes */' >> have_stdlib.h; \ X else \ X echo '#undef HAVE_STDLIB_H /* no */' >> have_stdlib.h; \ X fi X @echo ' have_stdlib.h formed' X Xhave_string.h: Makefile X rm -f have_string.h X @echo ' forming have_string.h' X @echo '/*' > have_string.h X @echo ' * DO NOT EDIT -- generated by the Makefile' >> have_string.h X @echo ' */' >> have_string.h X @echo '' >> have_string.h X @echo '/* do we have /usr/include/string.h? */' > have_string.h X -@if [ -r /usr/include/string.h ]; then \ X echo '#define HAVE_STRING_H /* yes */' >> have_string.h; \ X else \ X echo '#undef HAVE_STRING_H /* no */' >> have_string.h; \ X fi X @echo ' have_string.h formed' X Xargs.h: Makefile X rm -f args.h X @echo ' forming args.h' X @echo '/*' > args.h X @echo ' * DO NOT EDIT -- generated by the Makefile' >> args.h X @echo ' */' >> args.h X @echo '' >> args.h X @echo '/* what sort of variable args do we have? */' > args.h X -@if [ ! -z "${VARARG}" ]; then \ X echo '#define ${VARARG}' >> args.h; \ X elif [ -r /usr/include/stdarg.h ]; then \ X echo '#define STDARG' >> args.h; \ X elif [ -r /usr/include/varargs.h ]; then \ X echo '#define VARARGS' >> args.h; \ X else \ X echo '#define SIMULATE_STDARG' >> args.h; \ X fi X @echo ' args.h formed' X Xhelp/full: help/Makefile X cd help; ${MAKE} -f Makefile HELPDIR=${HELPDIR} full X Xlint: ${BUILD_H_SRC} ${CALCSRC} lint.sed X ${LINT} ${LINTFLAGS} ${CFLAGS} ${CALCSRC} | sed -f lint.sed X Xtags: ${CALCSRC} X ${CTAGS} ${CALCSRC} X Xclean: X rm -f ${CALCOBJS} ${CODEOBJS} X cd help; ${MAKE} -f Makefile clean X Xclobber: X rm -f ${CALCOBJS} ${CODEOBJS} X rm -f tags calc code ${BUILD_CODE_SRC} X rm -f ${BUILD_H_SRC} X cd help; ${MAKE} -f Makefile clobber X Xinstall: all calc.1 X -@if [ ! -d ${LIBDIR} ]; then \ X echo " ${MKDIR} ${LIBDIR}"; \ X ${MKDIR} ${LIBDIR}; \ X fi X -@if [ ! -d ${HELPDIR} ]; then \ X echo " ${MKDIR} ${HELPDIR}"; \ X ${MKDIR} ${HELPDIR}; \ X fi X -@if [ ! -d ${BINDIR} ]; then \ X echo " ${MKDIR} ${BINDIR}"; \ X ${MKDIR} ${BINDIR}; \ X fi X chmod 0755 calc X cp calc ${BINDIR} X cd help; ${MAKE} -f Makefile HELPDIR=${HELPDIR} install X cd lib; ${MAKE} -f Makefile LIBDIR=${LIBDIR} install X -chmod 0444 calc.1 X -cp calc.1 ${MANDIR} X @# The code program is not part of the calc distribution, don't worry X @# if you do not have it. X -@if [ -f code ]; then \ X echo " chmod +x code"; \ X chmod +x code; \ X echo " cp code ${BINDIR}"; \ X cp code ${BINDIR}; \ X fi X X# The code program is not part of the calc distribution, don't worry X# if you do not have it. X# Xcode: ${CODEOBJS} X ${CC} ${CFLAGS} ${CODEOBJS} -o code ${NO_SHARED} Xio_code.o: calc.h math.h alloc.h have_string.h have_stdlib.h have_malloc.h \ X func.h opcodes.h config.h token.h symbol.h io_code.c X ${CC} ${CFLAGS} -DCODE io_code.c -c Xqmath_code.o: calc.h math.h alloc.h have_string.h have_stdlib.h have_malloc.h \ X func.h opcodes.h config.h token.h symbol.h qmath_code.c X ${CC} ${CFLAGS} -DCODE qmath_code.c -c Xio_code.c: io.c X rm -f io_code.c X cp io.c io_code.c Xqmath_code.c: qmath.c X rm -f qmath_code.c X cp qmath.c qmath_code.c Xcode.o: stdarg.h args.h math.h have_malloc.h Makefile X ${CC} ${CFLAGS} -DCODE code.c -c X X# make depend stuff X# Xaddop.o: calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h opcodes.h string.h func.h token.h label.h symbol.h Xalloc.o: alloc.h have_string.h have_stdlib.h Xcalc.o: calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h func.h opcodes.h config.h token.h symbol.h Xcodegen.o: calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h token.h symbol.h label.h opcodes.h string.h \ X func.h config.h Xcomfunc.o: calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h Xcommath.o: math.h alloc.h have_string.h have_stdlib.h have_malloc.h Xconfig.o: calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h Xconst.o: calc.h math.h alloc.h have_string.h have_stdlib.h have_malloc.h Xfile.o: stdarg.h args.h calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h have_string.h Xfunc.o: calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h opcodes.h token.h func.h string.h Xinput.o: calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h config.h func.h Xio.o: stdarg.h args.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h Makefile Xlabel.o: calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h token.h label.h string.h opcodes.h func.h Xlistfunc.o: calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h Xmatfunc.o: calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h Xobj.o: calc.h math.h alloc.h have_string.h have_stdlib.h have_malloc.h \ X opcodes.h func.h symbol.h string.h Xopcodes.o: stdarg.h args.h calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h have_string.h opcodes.h func.h symbol.h Makefile Xqfunc.o: math.h alloc.h have_string.h have_stdlib.h have_malloc.h Xqmath.o: math.h alloc.h have_string.h have_stdlib.h have_malloc.h Xqmod.o: math.h alloc.h have_string.h have_stdlib.h have_malloc.h Xqtrans.o: math.h alloc.h have_string.h have_stdlib.h have_malloc.h Xstring.o: calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h string.h Xsymbol.o: calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h token.h symbol.h string.h opcodes.h func.h Xtoken.o: stdarg.h args.h calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h have_string.h token.h string.h Makefile Xvalue.o: calc.h math.h alloc.h have_string.h have_stdlib.h \ X have_malloc.h opcodes.h func.h symbol.h Xzfunc.o: math.h alloc.h have_string.h have_stdlib.h have_malloc.h Xzmath.o: math.h alloc.h have_string.h have_stdlib.h have_malloc.h Xzmod.o: math.h alloc.h have_string.h have_stdlib.h have_malloc.h Xzmul.o: math.h alloc.h have_string.h have_stdlib.h have_malloc.h END_OF_FILE if test 13308 -ne `wc -c <'Makefile'`; then echo shar: \"'Makefile'\" unpacked with wrong size! fi # end of 'Makefile' fi if test -f 'calc.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'calc.h'\" else echo shar: Extracting \"'calc.h'\" $11561 characters$ sed "s/^X//" >'calc.h' <<'END_OF_FILE' X/* X * Copyright (c) 1992 David I. Bell X * Permission is granted to use, distribute, or modify this source, X * provided that this copyright notice remains intact. X * X * Definitions for calculator program. X */ X X#include <stdio.h> X#include <setjmp.h> X#include "math.h" X X X/* X * Configuration definitions X */ X#define CALCPATH "CALCPATH" /* environment variable for files */ X#define CALCRC "CALCRC" /* environment variable for startup */ X#define HOME "HOME" /* environment variable for home dir */ X#define PAGER "PAGER" /* environment variable for help */ X#define SHELL "SHELL" /* environment variable for shell */ X#define DEFAULTCALCHELP "help" /* help file that -h prints */ X#define DEFAULTSHELL "sh" /* default shell to use */ X#define CALCEXT ".cal" /* extension for files read in */ X#define PATHSIZE 1024 /* maximum length of path name */ X#define HOMECHAR '~' /* char which indicates home directory */ X#define DOTCHAR '.' /* char which indicates current directory */ X#define PATHCHAR '/' /* char which separates path components */ X#define LISTCHAR ':' /* char which separates paths in a list */ X#define MAXCMD 1024 /* maximum length of command invocation */ X#define MAXERROR 512 /* maximum length of error message string */ X X#define SYMBOLSIZE 256 /* maximum symbol name size */ X#define MAXINDICES 20 /* maximum number of indices for objects */ X#define MAXLABELS 100 /* maximum number of user labels in function */ X#define MAXOBJECTS 10 /* maximum number of object types */ X#define MAXDIM 4 /* maximum number of dimensions in matrices */ X#define MAXSTRING 1024 /* maximum size of string constant */ X#define MAXSTACK 1000 /* maximum depth of evaluation stack */ X#define MAXFILES 20 /* maximum number of opened files */ X#define PROMPT1 "> " /* normal prompt */ X#define PROMPT2 ">> " /* prompt when inside multi-line input */ X X X#define TRACE_NORMAL 0x00 /* normal trace flags */ X#define TRACE_OPCODES 0x01 /* trace every opcode */ X#define TRACE_NODEBUG 0x02 /* suppress debugging opcodes */ X#define TRACE_MAX 0x03 /* maximum value for trace flag */ X X#define DISPLAY_DEFAULT 20 /* default digits for float display */ X#define EPSILON_DEFAULT "1e-20" /* allowed error for float calculations */ X#define MAXPRINT_DEFAULT 16 /* default number of elements printed */ X#define USUAL_ELEMENTS 4 /* usual number of elements for object */ X X#define ABORT_NONE 0 /* abort not needed yet */ X#define ABORT_STATEMENT 1 /* abort on statement boundary */ X#define ABORT_OPCODE 2 /* abort on any opcode boundary */ X#define ABORT_MATH 3 /* abort on any math operation */ X#define ABORT_NOW 4 /* abort right away */ X X#define CONFIG_MODE 1 /* types of configuration parameters */ X#define CONFIG_DISPLAY 2 X#define CONFIG_EPSILON 3 X#define CONFIG_TRACE 4 X#define CONFIG_MAXPRINT 5 X#define CONFIG_MUL2 6 X#define CONFIG_SQ2 7 X#define CONFIG_POW2 8 X#define CONFIG_REDC2 9 X X X/* X * Flags to modify results from the printvalue routine. X * These flags are OR'd together. X */ X#define PRINT_NORMAL 0x00 /* print in normal manner */ X#define PRINT_SHORT 0x01 /* print in short format (no elements) */ X#define PRINT_UNAMBIG 0x02 /* print in non-ambiguous manner */ X X X/* X * Definition of values of various types. X */ Xtypedef struct value VALUE; Xtypedef struct object OBJECT; Xtypedef struct matrix MATRIX; Xtypedef struct list LIST; Xtypedef long FILEID; X X Xstruct value { X short v_type; /* type of value */ X short v_subtype; /* other data related to some types */ X union { X long vv_int; /* small integer value */ X FILEID vv_file; /* id of opened file */ X NUMBER *vv_num; /* arbitrary sized numeric value */ X COMPLEX *vv_com; /* complex number */ X VALUE *vv_addr; /* address of variable value */ X MATRIX *vv_mat; /* address of matrix */ X LIST *vv_list; /* address of list */ X OBJECT *vv_obj; /* address of object */ X char *vv_str; /* string value */ X } v_union; X}; X X X/* X * For ease in referencing X */ X#define v_int v_union.vv_int X#define v_file v_union.vv_file X#define v_num v_union.vv_num X#define v_com v_union.vv_com X#define v_addr v_union.vv_addr X#define v_str v_union.vv_str X#define v_mat v_union.vv_mat X#define v_list v_union.vv_list X#define v_obj v_union.vv_obj X#define v_valid v_union.vv_int X X X/* X * Value types. X */ X#define V_NULL 0 /* null value */ X#define V_INT 1 /* normal integer */ X#define V_NUM 2 /* number */ X#define V_COM 3 /* complex number */ X#define V_ADDR 4 /* address of variable value */ X#define V_STR 5 /* address of string */ X#define V_MAT 6 /* address of matrix structure */ X#define V_LIST 7 /* address of list structure */ X#define V_OBJ 8 /* address of object structure */ X#define V_FILE 9 /* opened file id */ X#define V_MAX 9 /* highest legal value */ X X#define V_STRLITERAL 0 /* string subtype for literal str */ X#define V_STRALLOC 1 /* string subtype for allocated str */ X X#define TWOVAL(a,b) ((a) * (V_MAX+1) + (b)) /* for switch of two values */ X X X/* X * Structure of a matrix. X */ Xstruct matrix { X long m_dim; /* dimension of matrix */ X long m_size; /* total number of elements */ X long m_min[MAXDIM]; /* minimum bound for indices */ X long m_max[MAXDIM]; /* maximum bound for indices */ X VALUE m_table[1]; /* actually varying length table */ X}; X X#define matsize(n) (sizeof(MATRIX) - sizeof(VALUE) + ((n) * sizeof(VALUE))) X X X/* X * List definitions. X * An individual list element. X */ Xtypedef struct listelem LISTELEM; Xstruct listelem { X LISTELEM *e_next; /* next element in list (or NULL) */ X LISTELEM *e_prev; /* previous element in list (or NULL) */ X VALUE e_value; /* value of this element */ X}; X X X/* X * Structure for a list of elements. X */ Xstruct list { X LISTELEM *l_first; /* first list element (or NULL) */ X LISTELEM *l_last; /* last list element (or NULL) */ X LISTELEM *l_cache; /* cached list element (or NULL) */ X long l_cacheindex; /* index of cached element (or undefined) */ X long l_count; /* total number of elements in the list */ X}; X Xextern void insertlistfirst(), insertlistlast(), insertlistmiddle(); Xextern void removelistfirst(), removelistlast(), removelistmiddle(); Xextern void listfree(), listprint(); Xextern long listsearch(), listrsearch(); Xextern BOOL listcmp(); Xextern VALUE *listindex(); Xextern LIST *listalloc(), *listcopy(); X X X/* X * Object actions. X */ X#define OBJ_PRINT 0 /* print the value */ X#define OBJ_ONE 1 /* create the multiplicative identity */ X#define OBJ_TEST 2 /* test a value for "zero" */ X#define OBJ_ADD 3 /* add two values */ X#define OBJ_SUB 4 /* subtrace one value from another */ X#define OBJ_NEG 5 /* negate a value */ X#define OBJ_MUL 6 /* multiply two values */ X#define OBJ_DIV 7 /* divide one value by another */ X#define OBJ_INV 8 /* invert a value */ X#define OBJ_ABS 9 /* take absolute value of value */ X#define OBJ_NORM 10 /* take the norm of a value */ X#define OBJ_CONJ 11 /* take the conjugate of a value */ X#define OBJ_POW 12 /* take the power function */ X#define OBJ_SGN 13 /* return the sign of a value */ X#define OBJ_CMP 14 /* compare two values for equality */ X#define OBJ_REL 15 /* compare two values for inequality */ X#define OBJ_QUO 16 /* integer quotient of values */ X#define OBJ_MOD 17 /* remainder of division of values */ X#define OBJ_INT 18 /* integer part of */ X#define OBJ_FRAC 19 /* fractional part of */ X#define OBJ_INC 20 /* increment by one */ X#define OBJ_DEC 21 /* decrement by one */ X#define OBJ_SQUARE 22 /* square value */ X#define OBJ_SCALE 23 /* scale by power of two */ X#define OBJ_SHIFT 24 /* shift left (or right) by number of bits */ X#define OBJ_ROUND 25 /* round to specified decimal places */ X#define OBJ_BROUND 26 /* round to specified binary places */ X#define OBJ_ROOT 27 /* take nth root of value */ X#define OBJ_SQRT 28 /* take square root of value */ X#define OBJ_MAXFUNC 28 /* highest function */ X X X/* X * Definition of an object type. X * This is actually a varying sized structure. X */ Xtypedef struct { X char *name; /* name of object */ X int count; /* number of elements defined */ X int actions[OBJ_MAXFUNC+1]; /* function indices for actions */ X int elements[1]; /* element indexes (MUST BE LAST) */ X} OBJECTACTIONS; X X#define objectactionsize(elements) \ X (sizeof(OBJECTACTIONS) + ((elements) - 1) * sizeof(int)) X X X/* X * Structure of an object. X * This is actually a varying sized structure. X * However, there are always at least USUAL_ELEMENTS values in the object. X */ Xstruct object { X OBJECTACTIONS *o_actions; /* action table for this object */ X VALUE o_table[USUAL_ELEMENTS]; /* object values (MUST BE LAST) */ X}; X X#define objectsize(elements) \ X (sizeof(OBJECT) + ((elements) - USUAL_ELEMENTS) * sizeof(VALUE)) X X X/* X * File ids corresponding to standard in, out, error, and when not in use. X */ X#define FILEID_STDIN 0 X#define FILEID_STDOUT 1 X#define FILEID_STDERR 2 X#define FILEID_NONE -1 X X X/* X * Common definitions X */ Xextern long maxprint; /* number of elements to print */ Xextern int abortlevel; /* current level of aborts */ Xextern BOOL inputwait; /* TRUE if in a terminal input wait */ Xextern FLAG traceflags; /* tracing flags */ Xextern VALUE *stack; /* execution stack */ Xextern jmp_buf jmpbuf; /* for errors */ X Xextern char *calcpath; /* $CALCPATH or default */ Xextern char *calcrc; /* $CALCRC or default */ Xextern char *home; /* $HOME or default */ Xextern char *shell; /* $SHELL or default */ X X/* X * Functions. X */ Xextern MATRIX *matadd(), *matsub(), *matmul(), *matneg(); Xextern MATRIX *matalloc(), *matcopy(), *matsquare(), *matinv(); Xextern MATRIX *matscale(), *matmulval(), *matpowi(), *matconj(), *matquoval(); Xextern MATRIX *matmodval(), *matint(), *matfrac(), *matround(), *matbround(); Xextern MATRIX *mattrans(), *matcross(), *matshift(); Xextern BOOL mattest(), matcmp(); Xextern long matsearch(), matrsearch(); Xextern VALUE matdet(), matdot(); Xextern void matfill(), matfree(), matprint(); X X#if 0 Xextern BOOL matisident(); X#endif X Xextern OBJECT *objcopy(), *objalloc(); Xextern VALUE objcall(); Xextern void objfree(); Xextern void objuncache(); Xextern int addelement(); Xextern int defineobject(); Xextern int checkobject(); Xextern void showobjfuncs(); Xextern int findelement(); Xextern int objoffset(); X Xextern void freevalue(), copyvalue(), negvalue(), addvalue(), subvalue(); Xextern void mulvalue(), squarevalue(), invertvalue(), roundvalue(); Xextern void broundvalue(), intvalue(), fracvalue(), incvalue(), decvalue(); Xextern void conjvalue(), sqrtvalue(), rootvalue(), absvalue(), normvalue(); Xextern void shiftvalue(), scalevalue(), powivalue(), powervalue(); Xextern void divvalue(), quovalue(), modvalue(), printvalue(); Xextern BOOL testvalue(), comparevalue(); Xextern FLAG relvalue(); X Xextern FILEID openid(), indexid(); Xextern BOOL validid(), errorid(), eofid(), closeid(); Xextern int getcharid(); Xextern void idprintf(), printid(), flushid(), readid(); X Xextern FILE *f_open(); Xextern int openstring(); Xextern int openterminal(); Xextern int opensearchfile(); Xextern int nextchar(); Xextern void reread(); X Xextern VALUE builtinfunc(); Xextern NUMBER *constvalue(); Xextern long addnumber(), addqconstant(); Xextern long linenumber(); Xextern char *builtinname(); Xextern char *inputname(); Xextern BOOL inputisterminal(); Xextern void resetinput(); Xextern char *nextline(); Xextern void calculate(); Xextern void initstack(); Xextern int dumpop(); Xextern void version(); /* print version string */ Xextern void runrcfiles(); Xextern void getcommands(); Xextern void givehelp(); Xextern void setprompt(); X Xextern void getconfig(); Xextern void setconfig(); Xextern int configtype(); X X#ifdef VARARGS Xvoid error(); X#else X# ifdef __STDC__ Xvoid error(char *, ...); X# else Xvoid error(); X# endif X#endif X X X/* END CODE */ END_OF_FILE if test 11561 -ne `wc -c <'calc.h'`; then echo shar: \"'calc.h'\" unpacked with wrong size! fi # end of 'calc.h' fi if test -f 'help/builtin' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'help/builtin'\" else echo shar: Extracting \"'help/builtin'\" $12708 characters$ sed "s/^X//" >'help/builtin' <<'END_OF_FILE' XBuiltin functions X X There is a large number of built-in functions. Many of the X functions work on several types of arguments, whereas some only X work for the correct types (e.g., numbers or strings). In the X following description, this is indicated by whether or not the X description refers to values or numbers. This display is generated X by the 'show builtins' command. X X Name Args Description X X abs 1-2 absolute value within accuracy b X acos 1-2 arccosine of a within accuracy b X acosh 1-2 hyperbolic arccosine of a within accuracy b X append 2 append value to end of list X appr 1-2 approximate a with simpler fraction to within b X arg 1-2 argument (the angle) of complex number X asin 1-2 arcsine of a within accuracy b X asinh 1-2 hyperbolic arcsine of a within accuracy b X atan 1-2 arctangent of a within accuracy b X atan2 2-3 angle to point (b,a) within accuracy c X atanh 1-2 hyperbolic arctangent of a within accuracy b X avg 1+ arithmetic mean of values X bround 1-2 round value a to b number of binary places X btrunc 1-2 truncate a to b number of binary places X ceil 1 smallest integer greater than or equal to number X cfappr 1-2 approximate a within accuracy b using X continued fractions X cfsim 1 simplify number using continued fractions X char 1 character corresponding to integer value X cmp 2 compare values returning -1, 0, or 1 X comb 2 combinatorial number a!/b!(a-b)! X config 1-2 set or read configuration value X conj 1 complex conjugate of value X cos 1-2 cosine of value a within accuracy b X cosh 1-2 hyperbolic cosine of a within accuracy b X cp 2 cross product of two vectors X delete 2 delete element from list a at position b X den 1 denominator of fraction X det 1 determinant of matrix X digit 2 digit at specified decimal place of number X digits 1 number of digits in number X dp 2 dot product of two vectors X epsilon 0-1 set or read allowed error for real calculations X eval 1 evaluate expression from string to value X exp 1-2 exponential of value a within accuracy b X fcnt 2 count of times one number divides another X fib 1 Fibonacci number F(n) X frem 2 number with all occurrence of factor removed X fact 1 factorial X fclose 1 close file X feof 1 whether EOF reached for file X ferror 1 whether error occurred for file X fflush 1 flush output to file X fgetc 1 read next char from file X fgetline 1 read next line from file X files 0-1 return opened file or max number of opened files X floor 1 greatest integer less than or equal to number X fopen 2 open file name a in mode b X fprintf 2+ print formatted output to opened file X frac 1 fractional part of value X gcd 1+ greatest common divisor X gcdrem 2 a divided repeatedly by gcd with b X highbit 1 high bit number in base 2 representation X hmean 1+ harmonic mean of values X hypot 2-3 hypotenuse of right triangle within accuracy c X ilog 2 integral log of one number with another X ilog10 1 integral log of a number base 10 X ilog2 1 integral log of a number base 2 X im 1 imaginary part of complex number X insert 3 insert value c into list a at position b X int 1 integer part of value X inverse 1 multiplicative inverse of value X iroot 2 integer b'th root of a X iseven 1 whether a value is an even integer X isfile 1 whether a value is a file X isint 1 whether a value is an integer X islist 1 whether a value is a list X ismat 1 whether a value is a matrix X ismult 2 whether a is a multiple of b X isnull 1 whether a value is the null value X isnum 1 whether a value is a number X isobj 1 whether a value is an object X isodd 1 whether a value is an odd integer X isqrt 1 integer part of square root X isreal 1 whether a value is a real number X isset 2 whether bit b of abs(a) (in base 2) is set X isstr 1 whether a value is a string X isrel 2 whether two numbers are relatively prime X issimple 1 whether value is a simple type X issq 1 whether or not number is a square X istype 2 whether the type of a is same as the type of b X jacobi 2 -1 => a is not quadratic residue mod b X 1 => b is composite, or a is quad residue of b X lcm 1+ least common multiple X lcmfact 1 lcm of all integers up till number X lfactor 2 lowest prime factor of a in first b primes X list 0+ create list of specified values X ln 1-2 natural logarithm of value a within accuracy b X lowbit 1 low bit number in base 2 representation X ltol 1-2 leg-to-leg of unit right triangle X (sqrt(1 - a^2)) X matdim 1 number of dimensions of matrix X matfill 2-3 fill matrix with value b (value c on diagonal) X matmax 2 maximum index of matrix a dim b X matmin 2 minimum index of matrix a dim b X mattrans 1 transpose of matrix X max 1+ maximum value X meq 3 whether a and b are equal modulo c X min 1+ minimum value X minv 2 inverse of a modulo b X mmin 2 a mod b value with smallest abs value X mne 3 whether a and b are not equal modulo c X near 2-3 sign of (abs(a-b) - c) X norm 1 norm of a value (square of absolute value) X null 0 null value X num 1 numerator of fraction X ord 1 integer corresponding to character value X param 1 value of parameter n (or parameter count if X n is zero) X perm 2 permutation number a!/(a-b)! X pfact 1 product of primes up till number X pi 0-1 value of pi accurate to within epsilon X places 1 places after decimal point (-1 if infinite) X pmod 3 mod of a power (a ^ b (mod c)) X polar 2-3 complex value of polar coordinate X (a * exp(b*1i)) X poly 2+ (a1,a2,...,an,x) = a1*x^n+a2*x^(n-1)+...+an X pop 1 pop value from front of list X power 2-3 value a raised to the power b within accuracy c X ptest 2 probabilistic primality test X printf 1+ print formatted output to stdout X prompt 1 prompt for input line using value a X push 2 push value onto front of list X quomod 4 set c and d to quotient and remainder of a divided by b X rcin 2 convert normal number a to REDC number mod b X rcmul 3 multiply REDC numbers a and b mod c X rcout 2 convert REDC number a mod b to normal number X rcpow 3 raise REDC number a to power b mod c X rcsq 2 square REDC number a mod b X re 1 real part of complex number X remove 1 remove value from end of list X root 2-3 value a taken to the b'th root within accuracy c X round 1-2 round value a to b number of decimal places X rsearch 2-3 reverse search matrix or list for value b X starting at index c X runtime 0 user mode cpu time in seconds X scale 2 scale value up or down by a power of two X search 2-3 search matrix or list for value b starting at X index c X sgn 1 sign of value (-1, 0, 1) X sin 1-2 sine of value a within accuracy b X sinh 1-2 hyperbolic sine of a within accuracy b X size 1 total number of elements in value X sqrt 1-2 square root of value a within accuracy b X ssq 1+ sum of squares of values X str 1 simple value converted to string X strcat 1+ concatenate strings together X strlen 1 length of string X strprintf 1+ return formatted output as a string X substr 3 substring of a from position b for c chars X swap 2 swap values of variables a and b X (can be dangerous) X tan 1-2 tangent of a within accuracy b X tanh 1-2 hyperbolic tangent of a within accuracy b X trunc 1-2 truncate a to b number of decimal places X xor 1+ logical xor X X X The config function sets or reads the value of a configuration X parameter. The first argument is a string which names the parameter X to be set or read. If only one argument is given, then the current X value of the named parameter is returned. If two arguments are given, X then the named parameter is set to the value of the second argument, X and the old value of the parameter is returned. Therefore you can X change a parameter and restore its old value later. The possible X parameters are explained in the next section. X X The scale function multiplies or divides a number by a power of 2. X This is used for fractional calculations, unlike the << and >> X operators, which are only defined for integers. For example, X scale(6, -3) is 3/4. X X The quomod function is used to obtain both the quotient and remainder X of a division in one operation. The first two arguments a and b are X the numbers to be divided. The last two arguments c and d are two X variables which will be assigned the quotient and remainder. For X nonnegative arguments, the results are equivalent to computing a//b X and a%b. If a is negative and the remainder is nonzero, then the X quotient will be one less than a//b. This makes the following three X properties always hold: The quotient c is always an integer. The X remainder d is always 0 <= d < b. The equation a = b * c + d always X holds. This function returns 0 if there is no remainder, and 1 if X there is a remainder. For examples, quomod(10, 3, x, y) sets x to 3, X y to 1, and returns the value 1, and quomod(-4, 3.14159, x, y) sets x X to -2, y to 2.28318, and returns the value 1. X X The eval function accepts a string argument and evaluates the X expression represented by the string and returns its value. X The expression can include function calls and variable references. X For example, eval("fact(3) + 7") returns 13. When combined with X the prompt function, this allows the calculator to read values from X the user. For example, x=eval(prompt("Number: ")) sets x to the X value input by the user. X X The digit and isset functions return individual digits of a number, X either in base 10 or in base 2, where the lowest digit of a number X is at digit position 0. For example, digit(5678, 3) is 5, and X isset(0b1000100, 2) is 1. Negative digit positions indicate places X to the right of the decimal or binary point, so that for example, X digit(3.456, -1) is 4. X X The ptest function is a primality testing function. The first X argument is the suspected prime to be tested. The second argument X is an iteration count. The function returns 0 if the number is X definitely not prime, and 1 is the number is probably prime. The X chance of a number which is probably prime being actually composite X is less than 1/4 raised to the power of the iteration count. For X example, for a random number p, ptest(p, 10) incorrectly returns 1 X less than once in every million numbers, and you will probably never X find a number where ptest(p, 20) gives the wrong answer. X X The functions rcin, rcmul, rcout, rcpow, and rcsq are used to X perform modular arithmetic calculations for large odd numbers X faster than the usual methods. To do this, you first use the X rcin function to convert all input values into numbers which are X in a format called REDC format. Then you use rcmul, rcsq, and X rcpow to multiply such numbers together to produce results also X in REDC format. Finally, you use rcout to convert a number in X REDC format back to a normal number. The addition, subtraction, X negation, and equality comparison between REDC numbers are done X using the normal modular methods. For example, to calculate the X value 13 * 17 + 1 (mod 11), you could use: X X p = 11; X t1 = rcin(13, p); X t2 = rcin(17, p); X t3 = rcin(1, p); X t4 = rcmul(t1, t2, p); X t5 = (t4 + t3) % p; X answer = rcout(t5, p); X X The swap function exchanges the values of two variables without X performing copies. For example, after: X X x = 17; X y = 19; X swap(x, y); X X then x is 19 and y is 17. This function should not be used to X swap a value which is contained within another one. If this is X done, then some memory will be lost. For example, the following X should not be done: X X mat x[5]; X swap(x, x[0]); END_OF_FILE if test 12708 -ne `wc -c <'help/builtin'`; then echo shar: \"'help/builtin'\" unpacked with wrong size! fi # end of 'help/builtin' fi if test -f 'token.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'token.c'\" else echo shar: Extracting \"'token.c'\" $12074 characters$ sed "s/^X//" >'token.c' <<'END_OF_FILE' X/* X * Copyright (c) 1992 David I. Bell X * Permission is granted to use, distribute, or modify this source, X * provided that this copyright notice remains intact. X * X * Read input file characters into tokens X */ X X#include "stdarg.h" X#include "calc.h" X#include "token.h" X#include "string.h" X X X#define isletter(ch) ((((ch) >= 'a') && ((ch) <= 'z')) || \ X (((ch) >= 'A') && ((ch) <= 'Z'))) X#define isdigit(ch) (((ch) >= '0') && ((ch) <= '9')) X#define issymbol(ch) (isletter(ch) || isdigit(ch) || ((ch) == '_')) X X X/* X * Current token. X */ Xstatic struct { X short t_type; /* type of token */ X char *t_str; /* string value or symbol name */ X long t_numindex; /* index of numeric value */ X} curtoken; X X Xstatic BOOL rescan; /* TRUE to reread current token */ Xstatic BOOL newlines; /* TRUE to return newlines as tokens */ Xstatic BOOL allsyms; /* TRUE if always want a symbol token */ Xstatic STRINGHEAD strings; /* list of constant strings */ Xstatic char *numbuf; /* buffer for numeric tokens */ Xstatic long numbufsize; /* current size of numeric buffer */ X Xlong errorcount; /* number of compilation errors */ X X X/* X * Table of keywords X */ Xstruct keyword { X char *k_name; /* keyword name */ X int k_token; /* token number */ X}; X Xstatic struct keyword keywords[] = { X "if", T_IF, X "else", T_ELSE, X "for", T_FOR, X "while", T_WHILE, X "do", T_DO, X "continue", T_CONTINUE, X "break", T_BREAK, X "goto", T_GOTO, X "return", T_RETURN, X "local", T_LOCAL, X "global", T_GLOBAL, X "print", T_PRINT, X "switch", T_SWITCH, X "case", T_CASE, X "default", T_DEFAULT, X "quit", T_QUIT, X "exit", T_QUIT, X "define", T_DEFINE, X "read", T_READ, X "show", T_SHOW, X "help", T_HELP, X "write", T_WRITE, X "mat", T_MAT, X "obj", T_OBJ, X NULL, 0 X}; X X Xstatic void eatcomment(), eatstring(); Xstatic int eatsymbol(), eatnumber(); X X X/* X * Initialize all token information. X */ Xvoid Xinittokens() X{ X initstr(&strings); X newlines = FALSE; X allsyms = FALSE; X rescan = FALSE; X setprompt(PROMPT1); X} X X Xvoid Xtokenmode(flag) X{ X newlines = FALSE; X allsyms = FALSE; X if (flag & TM_NEWLINES) X newlines = TRUE; X if (flag & TM_ALLSYMS) X allsyms = TRUE; X setprompt(newlines ? PROMPT1 : PROMPT2); X} X X X/* X * Routine to read in the next token from the input stream. X * The type of token is returned as a value. If the token is a string or X * symbol name, information is saved so that the value can be retrieved. X */ Xint Xgettoken() X{ X int ch; /* current input character */ X int type; /* token type */ X X if (rescan) { /* rescanning */ X rescan = FALSE; X return curtoken.t_type; X } X curtoken.t_str = NULL; X curtoken.t_numindex = 0; X type = T_NULL; X while (type == T_NULL) { X ch = nextchar(); X if (allsyms && ((ch!=' ') && (ch!=';') && (ch!='"') && (ch!='\n'))) { X reread(); X type = eatsymbol(); X break; X } X switch (ch) { X case ' ': X case '\t': X case '\0': X break; X case '\n': X if (newlines) X type = T_NEWLINE; X break; X case EOF: type = T_EOF; break; X case '{': type = T_LEFTBRACE; break; X case '}': type = T_RIGHTBRACE; break; X case '(': type = T_LEFTPAREN; break; X case ')': type = T_RIGHTPAREN; break; X case '[': type = T_LEFTBRACKET; break; X case ']': type = T_RIGHTBRACKET; break; X case ';': type = T_SEMICOLON; break; X case ':': type = T_COLON; break; X case ',': type = T_COMMA; break; X case '?': type = T_QUESTIONMARK; break; X case '"': X case '\'': X type = T_STRING; X eatstring(ch); X break; X case '^': X switch (nextchar()) { X case '=': type = T_POWEREQUALS; break; X default: type = T_POWER; reread(); X } X break; X case '=': X switch (nextchar()) { X case '=': type = T_EQ; break; X default: type = T_ASSIGN; reread(); X } X break; X case '+': X switch (nextchar()) { X case '+': type = T_PLUSPLUS; break; X case '=': type = T_PLUSEQUALS; break; X default: type = T_PLUS; reread(); X } X break; X case '-': X switch (nextchar()) { X case '-': type = T_MINUSMINUS; break; X case '=': type = T_MINUSEQUALS; break; X default: type = T_MINUS; reread(); X } X break; X case '*': X switch (nextchar()) { X case '=': type = T_MULTEQUALS; break; X case '*': X switch (nextchar()) { X case '=': type = T_POWEREQUALS; break; X default: type = T_POWER; reread(); X } X break; X default: type = T_MULT; reread(); X } X break; X case '/': X switch (nextchar()) { X case '/': X switch (nextchar()) { X case '=': type = T_SLASHSLASHEQUALS; break; X default: reread(); type = T_SLASHSLASH; break; X } X break; X case '=': type = T_DIVEQUALS; break; X case '*': eatcomment(); break; X default: type = T_DIV; reread(); X } X break; X case '%': X switch (nextchar()) { X case '=': type = T_MODEQUALS; break; X default: type = T_MOD; reread(); X } X break; X case '<': X switch (nextchar()) { X case '=': type = T_LE; break; X case '<': X switch (nextchar()) { X case '=': type = T_LSHIFTEQUALS; break; X default: reread(); type = T_LEFTSHIFT; break; X } X break; X default: type = T_LT; reread(); X } X break; X case '>': X switch (nextchar()) { X case '=': type = T_GE; break; X case '>': X switch (nextchar()) { X case '=': type = T_RSHIFTEQUALS; break; X default: reread(); type = T_RIGHTSHIFT; break; X } X break; X default: type = T_GT; reread(); X } X break; X case '&': X switch (nextchar()) { X case '&': type = T_ANDAND; break; X case '=': type = T_ANDEQUALS; break; X default: type = T_AND; reread(); break; X } X break; X case '|': X switch (nextchar()) { X case '|': type = T_OROR; break; X case '=': type = T_OREQUALS; break; X default: type = T_OR; reread(); break; X } X break; X case '!': X switch (nextchar()) { X case '=': type = T_NE; break; X default: type = T_NOT; reread(); break; X } X break; X case '\\': X switch (nextchar()) { X case '\n': setprompt(PROMPT2); break; X default: scanerror(T_NULL, "Unknown token character '%c'", ch); X } X break; X default: X if (isletter(ch)) { X reread(); X type = eatsymbol(); X break; X } X if (isdigit(ch) || (ch == '.')) { X reread(); X type = eatnumber(); X break; X } X scanerror(T_NULL, "Unknown token character '%c'", ch); X } X } X curtoken.t_type = (short)type; X return type; X} X X X/* X * Continue to eat up a comment string. X * The leading slash-asterisk has just been scanned at this point. X */ Xstatic void Xeatcomment() X{ X int ch; X X for (;;) { X ch = nextchar(); X if (ch == '*') { X ch = nextchar(); X if (ch == '/') X return; X reread(); X } X if ((ch == EOF) || (ch == '\0') || X (newlines && (ch == '\n') && inputisterminal())) { X reread(); X scanerror(T_NULL, "Unterminated comment"); X return; X } X } X} X X X/* X * Read in a string and add it to the literal string pool. X * The leading single or double quote has been read in at this point. X */ Xstatic void Xeatstring(quotechar) X{ X register char *cp; /* current character address */ X int ch; /* current character */ X char buf[MAXSTRING+1]; /* buffer for string */ X X cp = buf; X for (;;) { X ch = nextchar(); X switch (ch) { X case '\0': X case EOF: X case '\n': X reread(); X scanerror(T_NULL, "Unterminated string constant"); X *cp = '\0'; X curtoken.t_str = addliteral(buf); X return; X X case '\\': X ch = nextchar(); X switch (ch) { X case 'n': ch = '\n'; break; X case 'r': ch = '\r'; break; X case 't': ch = '\t'; break; X case 'b': ch = '\b'; break; X case 'f': ch = '\f'; break; X case '\n': X setprompt(PROMPT2); X continue; X case EOF: X reread(); X continue; X } X *cp++ = (char)ch; X break; X X case '"': X case '\'': X if (ch == quotechar) { X *cp = '\0'; X curtoken.t_str = addliteral(buf); X return; X } X /* fall into default case */ X X default: X *cp++ = (char)ch; X } X } X} X X X/* X * Read in a symbol name which may or may not be a keyword. X * If allsyms is set, keywords are not looked up and almost all chars X * will be accepted for the symbol. Returns the type of symbol found. X */ Xstatic int Xeatsymbol() X{ X register struct keyword *kp; /* pointer to current keyword */ X register char *cp; /* current character pointer */ X int ch; /* current character */ X int cc; /* character count */ X static char buf[SYMBOLSIZE+1]; /* temporary buffer */ X X cp = buf; X cc = SYMBOLSIZE; X if (allsyms) { X for (;;) { X ch = nextchar(); X if ((ch == ' ') || (ch == ';') || (ch == '\n')) X break; X if (cc-- > 0) X *cp++ = (char)ch; X } X reread(); X *cp = '\0'; X if (cc < 0) X scanerror(T_NULL, "Symbol too long"); X curtoken.t_str = buf; X return T_SYMBOL; X } X for (;;) { X ch = nextchar(); X if (!issymbol(ch)) X break; X if (cc-- > 0) X *cp++ = (char)ch; X } X reread(); X *cp = '\0'; X if (cc < 0) X scanerror(T_NULL, "Symbol too long"); X for (kp = keywords; kp->k_name; kp++) X if (strcmp(kp->k_name, buf) == 0) X return kp->k_token; X curtoken.t_str = buf; X return T_SYMBOL; X} X X X/* X * Read in and remember a possibly numeric constant value. X * The constant is inserted into a constant table so further uses X * of the same constant will not take more memory. This can also X * return just a period, which is used for element accesses and for X * the old numeric value. X */ Xstatic int Xeatnumber() X{ X register char *cp; /* current character pointer */ X long len; /* parsed size of number */ X long res; /* result of parsing number */ X X if (numbufsize == 0) { X numbuf = (char *)malloc(128+1); X if (numbuf == NULL) X error("Cannot allocate number buffer"); X numbufsize = 128; X } X cp = numbuf; X len = 0; X for (;;) { X if (len >= numbufsize) { X cp = (char *)realloc(numbuf, numbufsize + 1001); X if (cp == NULL) X error("Cannot reallocate number buffer"); X numbuf = cp; X numbufsize += 1000; X cp = &numbuf[len]; X } X *cp = nextchar(); X *(++cp) = '\0'; X if ((numbuf[0] == '.') && isletter(numbuf[1])) { X reread(); X return T_PERIOD; X } X res = qparse(numbuf, QPF_IMAG); X if (res < 0) { X reread(); X scanerror(T_NULL, "Badly formatted number"); X curtoken.t_numindex = addnumber("0"); X return T_NUMBER; X } X if (res != ++len) X break; X } X cp[-1] = '\0'; X reread(); X if ((numbuf[0] == '.') && (numbuf[1] == '\0')) { X curtoken.t_numindex = 0; X return T_OLDVALUE; X } X cp -= 2; X res = T_NUMBER; X if ((*cp == 'i') || (*cp == 'I')) { X *cp = '\0'; X res = T_IMAGINARY; X } X curtoken.t_numindex = addnumber(numbuf); X return res; X} X X X/* X * Return the string value of the current token. X */ Xchar * Xtokenstring() X{ X return curtoken.t_str; X} X X X/* X * Return the constant index of a numeric token. X */ Xlong Xtokennumber() X{ X return curtoken.t_numindex; X} X X X/* X * Push back the token just read so that it will be seen again. X */ Xvoid Xrescantoken() X{ X rescan = TRUE; X} X X X/* X * Describe an error message. X * Then skip to the next specified token (or one more powerful). X */ X#ifdef VARARGS X# define VA_ALIST skip, fmt, va_alist X# define VA_DCL int skip; char *fmt; va_dcl X#else X# ifdef __STDC__ X# define VA_ALIST int skip, char *fmt, ... X# define VA_DCL X# else X# define VA_ALIST skip, fmt X# define VA_DCL int skip; char *fmt; X# endif X#endif X/*VARARGS*/ Xvoid Xscanerror(VA_ALIST) X VA_DCL X{ X va_list ap; X char *name; /* name of file with error */ X char buf[MAXERROR+1]; X X errorcount++; X name = inputname(); X if (name) X fprintf(stderr, "\"%s\", line %ld: ", name, linenumber()); X#ifdef VARARGS X va_start(ap); X#else X va_start(ap, fmt); X#endif X vsprintf(buf, fmt, ap); X va_end(ap); X fprintf(stderr, "%s\n", buf); X switch (skip) { X case T_NULL: X return; X case T_COMMA: X rescan = TRUE; X for (;;) { X switch (gettoken()) { X case T_NEWLINE: X case T_SEMICOLON: X case T_LEFTBRACE: X case T_RIGHTBRACE: X case T_EOF: X case T_COMMA: X rescan = TRUE; X return; X } X } X default: X fprintf(stderr, "Unknown skip token for scanerror\n"); X /* fall into semicolon case */ X /*FALLTHRU*/ X case T_SEMICOLON: X rescan = TRUE; X for (;;) switch (gettoken()) { X case T_NEWLINE: X case T_SEMICOLON: X case T_LEFTBRACE: X case T_RIGHTBRACE: X case T_EOF: X rescan = TRUE; X return; X } X } X} X X/* END CODE */ END_OF_FILE if test 12074 -ne `wc -c <'token.c'`; then echo shar: \"'token.c'\" unpacked with wrong size! fi # end of 'token.c' fi echo shar: End of archive 6 $of 21$. cp /dev/null ark6isdone MISSING="" for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 21 archives. rm -f ark[1-9]isdone ark[1-9][0-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0