v14i042: pac - the ultimate UNIX calculator, part 4 of 5
Istvan Mohos
istvan at hhb.UUCP
Sat Aug 4 09:20:21 AEST 1990
Posting-number: Volume 14, Issue 42
Submitted-by: istvan at hhb.UUCP (Istvan Mohos)
Archive-name: pac/part04
==============================CUT HERE==============================
#!/bin/sh
# This is part 04 of a multipart archive
if touch 2>&1 | fgrep '[-amc]' > /dev/null
then TOUCH=touch
else TOUCH=true
fi
# ============= help.c ==============
echo "x - extracting help.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > help.c &&
X/* help.c */
X/**********************************************************************
X* File Name : help.c
X* Function : overlay stack window with help list
X* Author : Istvan Mohos, 1987
X***********************************************************************/
X
X#include "defs.h"
X#include "toktab.h"
X
Xchar *hlist[] = {
X"! factorial of n: 2*3*4*...n",
X"# comment from here to EOL ",
X"\' sum ASCII bytes of nextok ",
X"; separator btw. statements ",
X"? abbreviation for help ",
X"X literal 16 ",
X"\\ most recent result ",
X"amass atomic mass unit, grams ",
X"and binary bit-wise AND ",
X"arct a(x) bc arctangent func. ",
X"astro astronomical unit, km ",
X"at abbreviation for autotime ",
X"atto * .000 000 000 000 000 001",
X"au abbreviation for autoconv ",
X"auto pac_err: defeat bc keyword",
X"autoconv on/off continuous convert ",
X"autotime turn clock on/off at start",
X"avogadro molecules per gram mole ",
X"boltzmann constant [k] ergs/Kelvin ",
X"break pac_err: defeat bc keyword",
X"bye exit program; same as TAB ",
X"chroma 440 * chroma: Bflat from A",
X"clr clear stack cell nextok ",
X"cm use comma to format number",
X"comma use comma to format number",
X"cos c(x) bc cosine function ",
X"define pac_err: defeat bc keyword",
X"dontsave don't write vars to .pacrc",
X"dp same as precision ",
X"ds abbreviation for dontsave ",
X"dup duplicate stk cell nextok ",
X"earthmass mass of earth in kg ",
X"earthrad radius of earth in meters ",
X"echarge electron charge [e] esu ",
X"emass electron mass at rest, g ",
X"euler Euler-Mascheroni constant ",
X"exa *1,000,000,000,000,000,000",
X"exit exit program; same as ^E ",
X"exp e(x) bc exponential func. ",
X"faraday constant [F] C/kmole ",
X"femto * .000 000 000 000 001 ",
X"fix show fixed decimal point ",
X"fo abbreviation for format ",
X"for pac_err: defeat bc keyword",
X"format commas/spaces in result ",
X"g acceleration at sea m/s2 ",
X"gas constant [Ro] erg/g mole K",
X"giga * 1,000,000,000 ",
X"gravity constant [G] N m2/kg2 ",
X"h value of stack cell h ",
X"hardform verbose/terse/xt filedump ",
X"heat mechanical equiv [J] J/cal",
X"help briefly explain next token",
X"hf abbreviation for hardform ",
X"i value of stack cell i ",
X"ib abbreviation for ibase ",
X"ibase input radix (2 through 16)",
X"if pac_err: defeat bc keyword",
X"init pac to default parameters ",
X"j value of stack cell j ",
X"ju abbreviation for justify ",
X"justify left/right/fix display ",
X"k value of stack cell k ",
X"kilo * 1000 ",
X"l value of stack cell l ",
X"le abbreviation for left ",
X"left ju le; print to left side ",
X"length pac_err: defeat bc keyword",
X"light velocity [c] km/s ",
X"lightyear distance covered/year km ",
X"log l(x) bc log function ",
X"m value of stack cell m ",
X"mega * 1,000,000 ",
X"micro * .000 001 ",
X"milli * .001 ",
X"mod integer mod, unlike bc % ",
X"mohos clear to nextok, pactrace ",
X"moonmass lunar mass in kg ",
X"moonrad radius of moon in meters ",
X"n value of stack cell n ",
X"nano * .000 000 001 ",
X"natural Naperian log base [e] ",
X"nmass neutron mass at rest, g ",
X"not bitwise, field nextok wide",
X"o value of stack cell o ",
X"ob abbreviation of obase ",
X"obase output radix (2 thru 16) ",
X"off disable capability ",
X"on enable capability ",
X"or binary, bit-wise OR ",
X"p value of stack cell p ",
X"parallax solar, in seconds of arc ",
X"parsec (parallax + sec2) in km ",
X"pd percent diff (pdiff) ",
X"pdelta percent diff (pdiff) ",
X"pdiff % diff of curtok to nextok",
X"pe percent equal (pequal) ",
X"pequal curtok% = nextok; total? ",
X"peta * 1,000,000,000,000,000 ",
X"pi 3.1415... (32 hex digits) ",
X"pico * .000 000 000 001 ",
X"planck constant [h] erg sec ",
X"pll stk cell nextok to curres ",
X"pm percent minus (pminus) ",
X"pmass proton mass at rest, g ",
X"pminus subtract nextok percent ",
X"po percent of (pof) ",
X"pof what is curtok% of nextok ",
X"pop discard stack cell nextok ",
X"pp percent plus (pplus) ",
X"pplus add nextok percent ",
X"pr abbreviation of precision ",
X"precision digits used past dp (0-32)",
X"psh curres to stk cell nextok ",
X"pv percent versus (pversus) ",
X"pversus curtok = 100 %, nextok ? %",
X"q value of stack cell q ",
X"quit exit program; same as ^E ",
X"r value of stack cell r ",
X"ri abbreviation of right ",
X"right right justify result ",
X"rydberg constant per meter ",
X"s value of stack cell s ",
X"sb abbreviation of staybase ",
X"scale alias of precision ",
X"sin s(x) bc sine function ",
X"sound air speed @ 15 Celsius m/s",
X"sp use space to format number",
X"space use space to format number",
X"sqrt sqrt(x) bc square root ",
X"st abbreviation of 'stack on'",
X"stack save last 16 results ",
X"staybase make next radix permanent ",
X"stefan Stefan-Boltzmann J/m2 K4 s",
X"sto store curres in stack cell",
X"sunmass solar mass kg ",
X"sunrad radius of sun in meters ",
X"swp swap curres, stack nextok ",
X"t value of stack cell t ",
X"te abbreviation of terse ",
X"tera * 1,000,000,000,000 ",
X"terse hardcopy file format ",
X"to convert curres to nextok ",
X"tomoon distance from earth, km ",
X"tosun distance from earth, km ",
X"tw abbreviation of twoscomp ",
X"twoscomp bitwise, field nextok wide",
X"u value of stack cell u ",
X"v value of stack cell v ",
X"ver abbreviation of verbose ",
X"verbose hardcopy file format ",
X"w value of stack cell w ",
X"while pac_err: defeat bc keyword",
X"wien displacement constant cm K",
X"x the number 16 ",
X"xor curres xor-ed with nextok ",
X"xt abbreviation of xterse ",
X"xterse hardcopy file format ",
X};
X
X#define HCENTER 6
X#define TOFIT (STACKDEEP - HCENTER)
X
Xshow_help(cursel)
Xint cursel;
X{
X register ri;
X static int tophelp;
X static char *fid = "show_help";
X
X _TR
X if (cursel < HCENTER)
X tophelp = 0;
X else if (cursel >= LISTSIZE - TOFIT)
X tophelp = LISTSIZE - STACKDEEP;
X else
X tophelp = cursel - HCENTER + 1;
X
X for (ri = 0; ri < STACKDEEP; ri++) {
X mvaddstr(ri + STACKTOP, STACKLEFT, hlist[ri + tophelp]);
X }
X
X standout();
X for (ri = 0; ri < STACKDEEP; ri++) {
X mvaddch(ri + STACKTOP, LBOUND, ' ');
X }
X mvaddstr(STACKTOP + cursel - tophelp, STACKLEFT, hlist[cursel]);
X standend();
XTR_
X}
X
SHAR_EOF
$TOUCH -am 0221163890 help.c &&
chmod 0644 help.c ||
echo "restore of help.c failed"
set `wc -c help.c`;Wc_c=$1
if test "$Wc_c" != "7333"; then
echo original size 7333, current size $Wc_c
fi
# ============= ierror.c ==============
echo "x - extracting ierror.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ierror.c &&
X/* ierror.c */
X/**********************************************************************
X* Function : perror, writes into global string buffer "ierbuf"
X* Author : Istvan Mohos, 1987
X***********************************************************************/
X
X#include <stdio.h>
Xextern int errno, sys_nerr;
Xextern char *sys_errlist[];
Xextern char ierbuf[];
X
Xierror(ustr, badnum)
Xchar *ustr;
Xint badnum;
X{
X register char *cp = NULL;
X
X if (errno > 0 && errno < sys_nerr) {
X badnum = errno;
X cp = sys_errlist[errno];
X }
X
X if (ustr != (char *)NULL)
X if (cp != (char *)NULL)
X sprintf(ierbuf, "%s: %s", cp, ustr);
X else
X strcpy(ierbuf, ustr);
X else
X if (cp != (char *)NULL)
X sprintf(ierbuf, "%s:", cp);
X else
X *ierbuf = '\0';
X
X errno = 0;
X return(badnum);
X}
SHAR_EOF
$TOUCH -am 0221163890 ierror.c &&
chmod 0644 ierror.c ||
echo "restore of ierror.c failed"
set `wc -c ierror.c`;Wc_c=$1
if test "$Wc_c" != "871"; then
echo original size 871, current size $Wc_c
fi
# ============= interpret.c ==============
echo "x - extracting interpret.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > interpret.c &&
X/* interpret.c */
X/**********************************************************************
X* File Name : interpret.c
X* Function : pac calculator input tokenizer
X* Author : Istvan Mohos, 1987
X***********************************************************************/
X
X#include "defs.h"
X#include "toktab.h"
X#define INTERMAP
X#include "maps.h"
X#undef INTERMAP
X
X#define HIDE_RES Hide = 1; rh = Stack; Stack = DISA; \
X prec = Precision; Precision = 32; show_result(1); \
X Hide = 0; Stack = rh; Precision = prec
X#define RECOVER conv_bc(sr->cell, ZERO, 1, 0); addto_ubuf(Convbuf)
X
Xinterpret(source)
Xchar *source;
X{
X char *eye, *nxeye;
X char *ip, itemp[LINEMAX];
X char stacbuf[PIPEMAX];
X int ri, rh, prec;
X int cur_cnt = 0;
X int type, value, nex_type;
X int first; /* so conversion can refer to Mainbuf */
X int conv_flag; /* to show that TO has taken place */
X char c_val;
X static char onechar[2];
X static struct stk_cell *sr = &Stk[0];
X static char *fid = "interpret";
X
X _TR
X
X#ifdef TOX
X static char Tk[100];
X char *tk = &Tk[0];
X#endif
X
X
X /* transfer raw characters from user window to Spreadbuf,
X insert spaces between all but contiguous alphanumeric characters
X to prepare for pactok */
X fill_spreadbuf(source);
X
X /* strip spaces and commas, null terminate tokens */
X place_pointers();
X *Ubuf = '\0';
X *Controlbuf = '\0';
X first = TRUE;
X conv_flag = FALSE;
X
X while ((eye = Tokp[++cur_cnt]) != ZERO) {
X type = lookup(eye);
X
X if ((nxeye = Tokp[cur_cnt + 1]) != ZERO)
X nex_type = lookup(nxeye);
X else
X nex_type = -1;
X
X#ifdef TOX
X sprintf(tk, "%d,", type);
X tk = Tk + strlen(Tk);
X#endif
X
X switch(type) {
X
X default:
X case NOTINLIST:
X upcase(eye);
X addto_ubuf(eye);
X break;
X
X case IB:
X case IBASE:
X show_result(1);
X
X /* ZERO pointer: no more tokens
X Convbuf returned: next token not in preferred list
X in either case, leave right side alone */
X
X if ((eye = substivar(-1, Tokp[++cur_cnt], 10))
X == ZERO || eye == Convbuf) {
X --cur_cnt;
X Ibase = IB_DFLT;
X }
X else {
X conv_bc(eye, ZERO, Ibase, 10);
X Ibase = atoi(Convbuf);
X if (Ibase > 16 || Ibase < 2)
X Ibase = IB_DFLT;
X }
X sprintf(Mop, "ibase=A;ibase=%d\n",Ibase);
X addto_controlbuf(Mop);
X show_result(0);
X break;
X
X case OB:
X case OBASE:
X show_result(1);
X if ((eye = substivar(-1, Tokp[++cur_cnt], 10))
X == ZERO || eye == Convbuf) {
X --cur_cnt;
X Obase = OB_DFLT;
X }
X else {
X conv_bc(eye, ZERO, Ibase, 10);
X Obase = atoi(Convbuf);
X if (Obase > 16 || Obase < 2)
X Obase = OB_DFLT;
X }
X sprintf(Mop, "ibase=A;obase=%d;ibase=%d\n", Obase, Ibase);
X addto_controlbuf(Mop);
X show_result(0);
X break;
X
X case TE:
X case TERSE:
X case VER:
X case VERBOSE:
X case XT:
X case XTERSE:
X show_result(1);
X if (type == TE || type == TERSE)
X Hf = FTER;
X else if (type == VER || type == VERBOSE)
X Hf = FVER;
X else
X Hf = FXTER;
X show_result(0);
X break;
X
X case FIX:
X case RIGHT:
X case RI:
X case LE:
X case LEFT:
X case CM:
X case COMMA:
X case SP:
X case SPACE:
X show_result(1);
X if (type == FIX)
X Justify = JF;
X else if (type == RIGHT || type == RI)
X Justify = JR;
X else if (type == LE || type == LEFT)
X Justify = JL;
X else if (type == CM || type == COMMA)
X Separator = ',', Format = COMMA_;
X else if (type == SP || type == SPACE)
X Separator = ' ', Format = SPACE_;
X show_result(0);
X break;
X
X case QUESTION:
X case HELP:
X if (nex_type == -1)
X show_help(HELP);
X else {
X ++cur_cnt;
X show_help(nex_type);
X }
X break;
X
X case TO:
X if (!first) {
X HIDE_RES;
X }
X RECOVER;
X eye = Tokp[++cur_cnt];
X if (eye == ZERO)
X --cur_cnt;
X else if ((ri = conv_id(eye)) != -1)
X Convsel = ri;
X else
X --cur_cnt;
X Do_conv = conv_flag = TRUE;
X HIDE_RES;
X show_result(0);
X RECOVER;
X break;
X
X case AND:
X case OR:
X case XOR:
X if (!first) {
X HIDE_RES;
X }
X /* resolve left side; convert it to base 2 */
X conv_bc(sr->cell, ZERO, 1, 2);
X strcpy(itemp, Convbuf);
X
X if ((eye = substivar(-1, Tokp[++cur_cnt], 2))
X == ZERO || eye == Convbuf)
X --cur_cnt, eye = itemp;
X else if (eye == Tokp[cur_cnt]) {
X /* nextok is a digit string */
X conv_bc(eye, ZERO, -1, 2);
X eye = Convbuf;
X }
X if ((ip = bitwise(type, itemp, eye, &ri)) == ZERO) {
X pac_err("conversion range");
X TR_
X return;
X }
X conv_bc(ip, ZERO, 1, 0);
X addto_ubuf(Convbuf);
X HIDE_RES;
X RECOVER;
X break;
X
X case TW:
X case TWOSCOMP:
X case NOT:
X if (type == TWOSCOMP)
X type = TW;
X if (!first) {
X HIDE_RES;
X }
X /* resolve left side; convert it to base 2 */
X conv_bc(sr->cell, ZERO, 1, 2);
X strcpy(itemp, Convbuf);
X
X if ((eye = substivar(-1, Tokp[++cur_cnt], 10))
X == ZERO || eye == Convbuf) {
X --cur_cnt;
X /* reuse previous result */
X conv_bc(sr->cell, ZERO, 1, 10);
X eye = Convbuf;
X }
X else if (eye == Tokp[cur_cnt]) {
X /* nextok is a digit string */
X conv_bc(eye, ZERO, -1, 10);
X eye = Convbuf;
X }
X if ((ip = bitwise(type, itemp, eye, &ri)) == ZERO) {
X pac_err("conversion range");
X TR_
X return;
X }
X if (ri)
X addto_ubuf("-");
X conv_bc(ip, ZERO, 1, 0);
X addto_ubuf(Convbuf);
X if (type == TW)
X addto_ubuf((ri) ? "-1" : "+1");
X HIDE_RES;
X RECOVER;
X break;
X
X case MOD:
X if (!first) {
X HIDE_RES;
X }
X ri = Precision;
X sprintf(Mop,"ibase=A;scale=0;ibase=%d\n", Ibase);
X addto_controlbuf(Mop);
X show_result(0);
X conv_bc(sr->cell, ZERO, 1, 0);
X addto_ubuf(Convbuf);
X addto_ubuf("\%");
X if ((eye = substivar(-1, Tokp[++cur_cnt], 0))
X == ZERO || eye == Convbuf) {
X --cur_cnt;
X eye = Convbuf;
X }
X addto_ubuf(eye);
X HIDE_RES;
X sprintf(Mop,"ibase=A;scale=%d;ibase=%d\n",ri, Ibase);
X addto_controlbuf(Mop);
X show_result(0);
X RECOVER;
X break;
X
X case BANG:
X if (!first) {
X HIDE_RES;
X }
X /* resolve left side; convert it to base 10 */
X conv_bc(sr->cell, ZERO, 1, 10);
X value = atoi(Convbuf);
X if (value < 0)
X value = 0;
X else if (value > 35)
X value = 35;
X conv_bc(factab[value], ZERO, 1, 0);
X addto_ubuf(Convbuf);
X HIDE_RES;
X RECOVER;
X break;
X
X case JUSTIFY:
X case JU:
X eye = Tokp[++cur_cnt];
X if (eye == ZERO) {
X show_result(1);
X Justify = JUS_DFLT;
X show_result(0);
X }
X --cur_cnt;
X break;
X
X case HF:
X case HARDFORM:
X eye = Tokp[++cur_cnt];
X if (eye == ZERO) {
X show_result(1);
X Hf = HF_DFLT;
X show_result(0);
X }
X --cur_cnt;
X break;
X
X case SHARP: /* comment start */
X (conv_flag || Autoconv == ENA) ? (O_conv = TRUE)
X : (O_conv = FALSE);
X show_result(2);
X TR_
X return;
X
X case SEMI:
X show_result(1);
X first = 2;
X break;
X
X case STACK:
X case ST:
X case SB:
X case STAYBASE:
X case AUTOTIME:
X case AT:
X ip = stacbuf;
X ri = 0;
X show_result(1);
X eye = Tokp[++cur_cnt];
X if (eye == ZERO) {
X --cur_cnt;
X if (type == STACK || type == ST)
X (Stack == ENA) ? (ri = 1) : (Stack = ENA);
X else if (type == STAYBASE || type == SB)
X Staybase = ENA;
X else if (type == AUTOTIME || type == AT)
X Autotime = ENA;
X show_result(0);
X }
X else {
X value = lookup(eye);
X if (value == ON)
X value = ENA;
X else if (value == OFF)
X value = DISA;
X else {
X --cur_cnt;
X value = ENA;
X }
X if (type == STACK || type == ST) {
X if (value == ENA && Stack == ENA)
X ri = 1;
X Stack = value;
X }
X else if (type == STAYBASE || type == SB)
X Staybase = value;
X else if (type == AUTOTIME || type == AT)
X Autotime = value;
X show_result(0);
X }
X if (Hc != -1 && ri) {
X save_stack(ip, 1);
X ri = strlen(stacbuf);
X if ((write(Hc, stacbuf, ri)) != ri)
X fatal("hardcopy stack write");
X }
X break;
X
X case FORMAT:
X case FO:
X show_result(1);
X eye = Tokp[++cur_cnt];
X if (eye == ZERO) {
X --cur_cnt;
X Format = FORM_DFLT;
X (FORM_DFLT == COMMA_) ? (Separator = '.')
X : (Separator = ' ');
X }
X else {
X value = lookup(eye);
X switch (value) {
X case CM:
X case COMMA:
X Separator = ',';
X Format = COMMA_;
X break;
X default:
X --cur_cnt;
X Format = FORM_DFLT;
X (FORM_DFLT == COMMA_) ? (Separator = '.')
X : (Separator = ' ');
X break;
X case SP:
X case SPACE:
X Separator = ' ';
X Format = SPACE_;
X break;
X case OFF:
X Separator = ' ';
X Format = DISA;
X break;
X }
X }
X show_result(0);
X break;
X
X case PR:
X case PRECISION:
X case SCALE:
X case DP:
X show_result(1);
X /* get right side literal for input */
X if ((eye = substivar(-1, Tokp[++cur_cnt], 10))
X == ZERO || eye == Convbuf) {
X --cur_cnt;
X Precision = PREC_DFLT;
X }
X else {
X Precision = atoi(eye);
X if (Precision < 0 || Precision > 32)
X Precision = PREC_DFLT;
X }
X sprintf(Mop,"ibase=A;scale=%d;ibase=%d\n",Precision, Ibase);
X addto_controlbuf(Mop);
X show_result(0);
X break;
X
X case PP: /* PercentPlus */
X case PPLUS:
X case PM: /* PercentMinus */
X case PMINUS:
X case PD: /* PercentDelta */
X case PDELTA:
X case PDIFF:
X case PV: /* PercentVersus */
X case PVERSUS:
X case PO: /* PercentOf */
X case POF:
X case PE: /* PercentEqual */
X case PEQUAL:
X if (!first) {
X HIDE_RES;
X }
X conv_bc(sr->cell, ZERO, 1, 0); /* left side is input */
X
X /* get right side literal for input */
X if ((eye = substivar(-1, Tokp[++cur_cnt], 0))
X == ZERO || eye == Convbuf) {
X --cur_cnt;
X eye = Convbuf;
X }
X ip = itemp;
X switch (type) {
X case PP:
X case PPLUS:
X sprintf(ip, "%s+(%s*%s/%s)",
X Convbuf,Convbuf,eye,hundred[Ibase]);
X break;
X case PM:
X case PMINUS:
X sprintf(ip, "%s-(%s*%s/%s)",
X Convbuf,Convbuf,eye,hundred[Ibase]);
X break;
X case PV:
X case PVERSUS:
X sprintf(ip, "%s*%s/%s",
X eye,hundred[Ibase],Convbuf);
X break;
X case PD:
X case PDELTA:
X case PDIFF:
X sprintf(ip, "(%s*(%s-%s))/%s",
X hundred[Ibase],eye,Convbuf,Convbuf);
X break;
X case PO:
X case POF:
X sprintf(ip, "(%s*%s/%s)",
X eye,Convbuf,hundred[Ibase]);
X break;
X case PE:
X case PEQUAL:
X sprintf(ip, "(%s*%s/%s)",
X eye,hundred[Ibase],Convbuf);
X break;
X }
X addto_ubuf(ip);
X break;
X
X case LOG:
X *onechar = *eye;
X addto_ubuf(onechar);
X break;
X
X case SQRT:
X addto_ubuf(eye);
X break;
X
X case INIT_:
X show_result(1);
X pacinit();
X sprintf(Mop, "ibase=A;obase=%d;ibase=%d\n", Obase, Ibase);
X addto_controlbuf(Mop);
X show_result(0);
X break;
X
X case DONTSAVE:
X case DS:
X Dontsave = 1;
X break;
X
X /* copy accum into chosen stack cell, or onto top of stack.
X Other cells are not disturbed */
X case STO:
X show_result(1);
X if (nxeye == ZERO || strlen(nxeye) > 1 ||
X (strlen(nxeye) == 1 && (*nxeye < 'h' || *nxeye > 'w')))
X c_val = 'h';
X else {
X c_val = *nxeye;
X ++cur_cnt;
X }
X stack_reg(c_val - 'g', 0);
X break;
X
X case IF:
X case WHILE:
X case FOR:
X case BREAK:
X case DEFINE:
X case LENGTH:
X pac_err("unimplemented key");
X TR_
X return;
X
X case QUIT:
X case EXIT:
X go_away(ZERO, 0);
X
X case BYE:
X clearstack(0);
X Amt = Rate = Years = 0.;
X go_away("I", 0);
X
X /* value = sum of bytes' ascii values of next token are
X substituted (in current Ibase) in input to bc */
X case TICK:
X value = 0;
X if ((eye = Tokp[++cur_cnt]) == ZERO)
X --cur_cnt;
X else
X while (*eye)
X value += *eye++;
X sprintf(Mop, "%c %d",Base_str[10], value);
X conv_bc(Mop, ZERO, 1, 0);
X addto_ubuf(Convbuf);
X break;
X
X case BACKSLASH:
X RECOVER;
X break;
X
X case KILO:
X case ATTO:
X case FEMTO:
X case GIGA:
X case MEGA:
X case MICRO:
X case MILLI:
X case NANO:
X case PICO:
X case TERA:
X case PETA:
X case EXA:
X if (first) {
X RECOVER;
X }
X addto_ubuf("*");
X addto_ubuf(substivar(type, ZERO, Ibase));
X break;
X
X case X_LOWER:
X case X_UPPER:
X sprintf(itemp, "%s", sixteen[Ibase]);
X addto_ubuf(itemp);
X break;
X
X /* shift Stack down from named register (or top, if no arg);
X bottom gets lost. Copy accum into named element.
X works independently (in addition to) stack effect */
X case PSH:
X show_result(1);
X if (nxeye == ZERO || strlen(nxeye) > 1 ||
X (strlen(nxeye) == 1 && (*nxeye < 'h' || *nxeye > 'w'))) {
X pushstack(1);
X stack_reg(1, 0);
X }
X else {
X pushstack(*nxeye - 'g');
X stack_reg(*nxeye - 'g', 0);
X ++cur_cnt;
X }
X break;
X
X /* Move stack element (or top, if no arg) into accum, move up
X all elements below it. Move 0 into bottom location */
X case PLL:
X show_result(1);
X if (nxeye == ZERO || strlen(nxeye) > 1 ||
X (strlen(nxeye) == 1 && (*nxeye < 'h' || *nxeye > 'w'))) {
X onereg(1);
X popstack(1);
X }
X else {
X onereg(*nxeye - 'g');
X popstack(*nxeye - 'g');
X ++cur_cnt;
X }
X conv_bc(Onebuf, ZERO, 1, 0);
X addto_ubuf(Convbuf);
X HIDE_RES;
X break;
X
X /* Swap accum and stacktop (no args), or accum and cell (1 arg),
X other registers remain intact */
X case SWP:
X show_result(1);
X if (nxeye == ZERO || strlen(nxeye) > 1 ||
X (strlen(nxeye) == 1 && (*nxeye < 'h' || *nxeye > 'w'))) {
X onereg(1);
X stack_reg(1, 0);
X }
X else {
X onereg(*nxeye - 'g');
X stack_reg(*nxeye - 'g', 0);
X ++cur_cnt;
X }
X conv_bc(Onebuf, ZERO, 1, 0);
X addto_ubuf(Convbuf);
X HIDE_RES;
X break;
X
X /* Discard top of stack, (no args) or named stack cell (1 arg);
X move up lower locations. Move 0 into bottom location */
X case POP:
X show_result(1);
X if (nxeye == ZERO || strlen(nxeye) > 1 ||
X (strlen(nxeye) == 1 && (*nxeye < 'h' || *nxeye > 'w')))
X popstack(1);
X else {
X popstack(*nxeye - 'g');
X ++cur_cnt;
X }
X break;
X
X case MOHOS:
X#ifdef TRACE
X if (first) {
X Trace = !Trace;
X if (Trace && Tf == NULL) {
X Tlev = 18; /* pop 2 off 20 maxdeep tabs */
X if ((Tf = fopen("pactrace", "w")) == NULL)
X go_away("bad trace file", 1);
X }
X if (!Trace && Tf != NULL) {
X fclose(Tf);
X Tf = NULL;
X }
X }
X#endif
X *Ubuf = '\0';
X *Controlbuf = '\0';
X first = TRUE;
X conv_flag = FALSE;
X break;
X
X case PI:
X case ASTRO:
X case AMASS:
X case AVOGADRO:
X case BOLTZMANN:
X case ECHARGE:
X case CHROMA:
X case EMASS:
X case EULER:
X case FARADAY:
X case G_:
X case GAS:
X case GRAVITY:
X case HEAT:
X case LIGHT:
X case LIGHTYEAR:
X case MOONMASS:
X case SUNMASS:
X case EARTHMASS:
X case NATURAL:
X case NMASS:
X case PARSEC:
X case PARALLAX:
X case PLANCK:
X case PMASS:
X case MOONRAD:
X case SUNRAD:
X case EARTHRAD:
X case RYDBERG:
X case SOUND:
X case STEFAN:
X case TOMOON:
X case TOSUN:
X case WIEN:
X addto_ubuf(substivar(type, ZERO, Ibase));
X break;
X
X case H_:
X case I_:
X case J_:
X case K_:
X case L_:
X case M_:
X case N_:
X case O_:
X case P_:
X case Q_:
X case R_:
X case S_:
X case T_:
X case U_:
X case V_:
X case W_:
X conv_bc((char *)find(*eye - 'g'), ZERO, 1, 0);
X addto_ubuf(Convbuf);
X break;
X
X case SIN:
X case COS:
X case EXP:
X case ARCT:
X if (Ibase != 10) {
X pac_err("active in 10 base only");
X TR_
X return;
X }
X *onechar = *eye;
X addto_ubuf(onechar);
X break;
X
X /* Put 0 into a specific stack cell, or into
X all cells including accum */
X case CLR:
X if (nxeye == ZERO || strlen(nxeye) > 1 ||
X (strlen(nxeye) == 1 && (*nxeye < 'h' || *nxeye > 'w'))) {
X clearstack(0);
X addto_ubuf(";0;");
X }
X else {
X clearstack(*nxeye - 'g');
X ++cur_cnt;
X }
X show_result(1);
X break;
X
X /* Values below named cell (or top) move down, bottom gets lost,
X named cell is copied into cell below */
X case DUP:
X show_result(1);
X if (nxeye == ZERO || strlen(nxeye) > 1 ||
X (strlen(nxeye) == 1 && (*nxeye < 'h' || *nxeye > 'w'))) {
X stack_reg('w' - 'g', 0); /* copy it into W first */
X pushstack(1);
X }
X else {
X stack_reg('w' - 'g', *nxeye - 'g');
X pushstack(*nxeye - 'g');
X ++cur_cnt;
X }
X break;
X
X /* Turn continuous conversion on/off */
X case AU:
X case AUTO:
X case AUTOCONV:
X show_result(1);
X Do_conv = TRUE;
X eye = Tokp[++cur_cnt];
X if (eye == ZERO) {
X --cur_cnt;
X Autoconv = ENA;
X show_result(0);
X break;
X }
X value = lookup(eye);
X if (value != ON && value != OFF) {
X --cur_cnt;
X Autoconv = ENA;
X }
X else if (value == ON)
X Autoconv = ENA;
X else {
X Autoconv = DISA;
X Do_conv = FALSE;
X }
X show_result(0);
X break;
X
X }
X (first == 2) ? (first = TRUE) : (first = FALSE);
X /* FALSE after evaluating the first token */
X }
X (conv_flag || Autoconv == ENA) ? (O_conv = TRUE) : (O_conv = FALSE);
X show_result(2);
X
X#ifdef TOX
X clear_wline(BOT, ULEFT, RBOUND, 1, 1);
X standout();
X mvaddstr(BOT, ULEFT, Tk);
X standend();
X pfresh();
X sleep(5);
X move(CY, CX);
X#endif
X
X TR_
X}
X
SHAR_EOF
$TOUCH -am 0221163890 interpret.c &&
chmod 0644 interpret.c ||
echo "restore of interpret.c failed"
set `wc -c interpret.c`;Wc_c=$1
if test "$Wc_c" != "23768"; then
echo original size 23768, current size $Wc_c
fi
# ============= ledit.c ==============
echo "x - extracting ledit.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ledit.c &&
X/* ledit.c */
X/**********************************************************************
X* File Name : ledit.c
X* Function : line (window) editor of pac
X* Author : Istvan Mohos, 1987
X***********************************************************************/
X
X#include "defs.h"
X
Xledit(retbuf,Map,line_y,lbound,rbound,video,stripspace,intact)
Xchar *retbuf, *Map;
Xint line_y, lbound, rbound, video, stripspace, intact;
X{
X char c;
X register int ri;
X int rj;
X int lchar, rchar;
X int tbound, bbound;
X int control = 1, retval = 0, first = 1;
X int insert = 0;
X char *rp;
X static char *fid = "ledit";
X
X _TR
X
X if (line_y) {
X CY = tbound = bbound = line_y;
X CX = lbound;
X }
X else {
X /* calculator window */
X CY = tbound = UTOP;
X bbound = UBOT;
X CX = ULEFT;
X }
X
X move(CY, CX);
X pfresh();
X
X while(control) {
X c = fgetc(stdin) & 127;
X if (c == 10 || c == 13)
X break;
X if (c == 17 || c == 19)
X continue;
X if (!intact && first && c > 31) {
X standout();
X mvaddstr(MSG, MSGLEFT, Sp34); /* clear any error messages */
X standend();
X first = 0;
X if (line_y)
X clear_wline(tbound, lbound, rbound, video, 1);
X else
X clear_wline(UTOP, lbound, rbound, video, 3);
X }
X
X if (video)
X standout();
X switch(*(Map+c)) {
X
X default: /* do nothing */
X case 0:
X break;
X
X case 1: /* exit */
X go_away(ZERO, 0);
X
X case 2: /* addch */
X if (insert) {
X for (rj = bbound; rj >= CY + 1; rj--) {
X for (ri = rbound; ri >= lbound + 1; ri--)
X mvaddch(rj, ri, stdscr->_y[rj][ri - 1]);
X mvaddch(rj, ri, stdscr->_y[rj - 1][rbound]);
X }
X for (ri = rbound; ri >= CX + 1; ri--)
X mvaddch(CY, ri, stdscr->_y[CY][ri - 1]);
X }
X mvaddch(CY,CX,c);
X if(++CX > rbound)
X if (++CY <= bbound)
X CX = lbound;
X else {
X --CY;
X --CX;
X }
X move(CY,CX);
X break;
X
X case 21: /* ignore to EOL */
X while((c = fgetc(stdin) & 127) != 10 && c != 13);
X ungetc(c, stdin);
X break;
X
X case 3: /* move left */
X if (--CX < lbound)
X ++CX;
X move(CY, CX);
X break;
X
X case 4: /* move right */
X if (++CX > rbound)
X --CX;
X move(CY, CX);
X break;
X
X case 13: /* move up */
X if (--CY < tbound)
X ++CY;
X move(CY, CX);
X break;
X
X case 14: /* move down */
X if (++CY > bbound)
X --CY;
X move(CY, CX);
X break;
X
X case 15: /* move down and left */
X if (++CY <= bbound)
X CX = lbound;
X else
X --CY;
X move(CY, CX);
X break;
X
X case 7: /* clear; exit */
X clearstack(0);
X Amt = Rate = Years = 0.;
X go_away("I", 0);
X
X case 8: /* wants parent to pop */
X retval = 1;
X control = 0;
X break;
X
X case 9: /* wants parent to push */
X retval = 2;
X control = 0;
X break;
X
X /* give back last c, read buffer */
X case 12:
X retval = c;
X control = 0;
X break;
X
X /* give back last c, skip buffer */
X case 17:
X pfresh();
X TR_
X return(c);
X
X case 10: /* fill to eol with spaces */
X for (ri = CX; ri <= rbound; ri++)
X addch(' ');
X for (rj = tbound + 1; rj <= bbound; rj++) {
X move(rj, lbound);
X for (ri = CX; ri <= rbound; ri++)
X addch(' ');
X }
X move(CY,CX);
X break;
X
X /* curr line: delete char and move 1 pos to left */
X case 11:
X for (ri = CX + 1; ri <= rbound; ri++)
X addch(stdscr->_y[CY][ri]);
X addch(' ');
X if (--CX < lbound)
X ++CX;
X move(CY,CX);
X break;
X
X /* across lines: delete char and move 1 pos to left */
X case 16:
X for (ri = CX + 1; ri <= rbound; ri++)
X addch(stdscr->_y[CY][ri]);
X for (rj = CY + 1; rj <= bbound; rj++) {
X addch(stdscr->_y[rj][lbound]);
X move(rj, lbound);
X for (ri = lbound + 1; ri <= rbound; ri++)
X addch(stdscr->_y[rj][ri]);
X }
X addch(' ');
X if (--CX < lbound)
X ++CX;
X move(CY,CX);
X break;
X
X case 18 :
X clearok(curscr, TRUE);
X break; /* ^R redraw */
X
X case 19 :
X insert = 1;
X break;
X
X case 20 :
X insert = 0;
X break;
X }
X standend();
X pfresh();
X }
X
X rp = retbuf;
X if (stripspace) { /* single line implementation only */
X /* find first non-space from the left */
X for (ri = lbound; ri <= rbound; ri++)
X if ((stdscr->_y[CY][ri] & 127) > 32)
X break;
X if ((lchar = ri) > rbound) {
X *rp = '\0';
X pfresh();
X TR_
X return(retval);
X }
X
X /* find first non-space from the right */
X for (ri = rbound; ri >= lbound; ri--)
X if ((stdscr->_y[CY][ri] & 127) > 32)
X break;
X rchar = ri;
X
X /* give back everything in between */
X for (ri = lchar; ri <= rchar; ri++)
X *rp++ = stdscr->_y[CY][ri] & 127;
X }
X else
X for (rj = tbound; rj <= bbound; rj++)
X for (ri = lbound; ri <= rbound; ri++)
X *rp++ = stdscr->_y[rj][ri] & 127;
X *rp = '\0';
X pfresh();
X
X if (Trace && Tf != NULL)
X fprintf(Tf, "[%s]\n", retbuf);
X TR_
X return(retval);
X}
X
SHAR_EOF
$TOUCH -am 0221163890 ledit.c &&
chmod 0644 ledit.c ||
echo "restore of ledit.c failed"
set `wc -c ledit.c`;Wc_c=$1
if test "$Wc_c" != "6967"; then
echo original size 6967, current size $Wc_c
fi
# ============= onlay.c ==============
echo "x - extracting onlay.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > onlay.c &&
X/* onlay.c */
X/**********************************************************************
X* File Name : onlay.c
X* Function : draw initial pac screen
X* Author : Istvan Mohos, 1987
X***********************************************************************/
X
X#define SO standout()
X#define SE standend()
X#define uw 48
X#define re 78
X#define se 58
X#define sp " "
X
X#include "defs.h"
X
Xonlay()
X{
X register int i = TOP + 1, j = LBOUND;
X static char *fid = "onlay";
X
X _TR
X mvaddstr(UTOP, ATOIX, "^A asc");
X mvaddstr(UTOP + 1, ATOIX, "^D dec");
X mvaddstr(UTOP + 2, ATOIX, "^O oct");
X mvaddstr(UTOP + 3, ATOIX, "^X hex");
X
X SO;
X mvaddstr(TOP, j, " ");
X mvaddstr(TOP, ULEFT, Titlq[0]);
X SE;SO;
X mvaddstr(i,j,sp);mvaddstr(i,uw,sp);mvaddstr(i,se,sp);mvaddstr(i++,re,sp);SE;SO;
X mvaddstr(i,j,sp);mvaddstr(i,uw,sp);mvaddstr(i,se,sp);mvaddstr(i++,re,sp);SE;SO;
X mvaddstr(i,j,sp);mvaddstr(i,uw,sp);mvaddstr(i,se,sp);mvaddstr(i++,re,sp);SE;SO;
X mvaddstr(i,j,sp);mvaddstr(i,uw,sp);mvaddstr(i,se,sp);mvaddstr(i++,re,sp);SE;SO;
X mvaddstr(i,j, " LOAN ");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);SE;SO;
X
X SO; mvaddstr(STATY - 1, STATMSG - 1, " GLOBALS "); SE;
X
X i = STACKTOP;
X SO;
X mvaddstr(i,j,"h");SE;addstr(" 0");SO;mvaddstr(i,40,"amt");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i,j,"i");SE;addstr(" 0");SO;mvaddstr(i,40," % ");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i,j,"j");SE;addstr(" 0");SO;mvaddstr(i,40,"yrs");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i,j,"k");SE;addstr(" 0");SO;mvaddstr(i,40,"pay");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i,j,"l");SE;addstr(" 0");SO;mvaddstr(i,40,"^B ");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i,j,"m");SE;addstr(" 0");SO;mvaddstr(i,40," ");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i,j,"n");SE;addstr(" 0");SO;mvaddstr(i,40,"[le");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i,j,"o");SE;addstr(" 0");SO;mvaddstr(i,40,"]ri");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i,j,"p");SE;addstr(" 0");SO;mvaddstr(i,40,"{up");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i,j,"q");SE;addstr(" 0");SO;mvaddstr(i,40,"}dn");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i,j,"r");SE;addstr(" 0");SO;mvaddstr(i,40,"|cr");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i,j,"s");SE;addstr(" 0");SO;mvaddstr(i,40,"^Cl");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i,j,"t");SE;addstr(" 0");SO;mvaddstr(i,40," BS");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i,j,"u");SE;addstr(" 0");SO;mvaddstr(i,40,"DEL");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i,j,"v");SE;addstr(" 0");SO;mvaddstr(i,40,">im");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i,j,"w");SE;addstr(" 0");SO;mvaddstr(i,40,"<ei");
X mvaddstr(i,se,sp);mvaddstr(i++,re,sp);
X mvaddstr(i, j, " ");
X mvaddstr(i, ULEFT, Basq[0]); SE;
XTR_
X}
X
Xupdate()
X{
X register int ri;
X int pyp, pxp;
X static char *fid = "update";
X
X _TR
X CYX;
X for (ri = TREQ; --ri >= 0;) {
X if (Titlq[ri] != ZERO) {
X standout();
X mvaddstr(TOP, ULEFT, Titlq[ri]);
X break;
X }
X }
X
X for (ri = BREQ; --ri >= 0;) {
X if (Basq[ri] != ZERO) {
X mvaddstr(BOT, ULEFT, Basq[ri]);
X standend();
X break;
X }
X }
X
X PYX;
XTR_
X}
SHAR_EOF
$TOUCH -am 0221163890 onlay.c &&
chmod 0644 onlay.c ||
echo "restore of onlay.c failed"
set `wc -c onlay.c`;Wc_c=$1
if test "$Wc_c" != "3586"; then
echo original size 3586, current size $Wc_c
fi
echo "End of part 4, continue with part 5"
exit 0
More information about the Comp.sources.misc
mailing list