/***************************************************************************** hp41c.c HP41C calculator emulator v1.4 Harold Z. Bencowitz Beaumont, Texas 24-sep-86 ****************************************************************************** description: hp41c is a program to emulate the Hewlett-Packard 41C series of hand-held programmable calculators. it requires a vt100 or vt200 series terminal. it has been tested on rt11 v5.3 and tsx+ v6.01. the major design goal was to make an exactly identical user interface for those features included. to operate the "calculator" follow directions in the HP41C owners handbook. the keyboard mapping is given on screen when the program is run. many features of the hp41c are not supported, primarily programming and functions which are only useful from programs. features supported: display control functions ie <-, CLX, EEX, FIX, ENTER, and CHS; all mathematical functions available from the keyboard (without XEQ) namely: add, subtract, multiply, divide, 1/x, x**2, SQRT, y**x, ln, e**x, log, and 10**x; OCT and DEC (decimal/octal conversions (both from keypad and XEQ); rotate stack down (RDN); trig functions (SIN, COS, TAN, ASIN, ACOS, ATAN); nonvolatile memory (if program is named sy:hp41c.sav); degree/radian/grad mode switching for trig functions; STO and RCL (store and recall from memory); storage register arithmetic, direct storage in stack registers; XEQ commands D-R, DEC, DEG, RAD, FRC, GRAD, INT, CLRG, OCT, PI, MOD, CLST, R-D. features not supported: alpha mode (including AON, AOFF, ASHF, ASTO, AVIEW, CLA), user defined keys (user mode), indirect memory access, last x, LN1+X, accumulations (CLsum, sum+, sum-, sumREG, mean, sum, SD), BEEP, TONE, VIEW, ADV, SIZE, COPY, ON, OFF, rotate up, programming (including numerous functions such as R/S, pack, catalog, sst, bst, CLP, DEL, DSE, END, all flag instructions, GTO, GTO., GTO.., ISG, LBL, PROMPT, PSE, RTN, STOP, and all comparisons), and some xeq commands including: ABS, ENG, SCI, FACT, HMS, HMS+, HMS-, HR, LASTX, %, %CH, P-R, R-P, RND, SIGN (some of these are only useful from programs). operating instructions: remember that the HP41C uses reverse polish notation. to operate the "calculator" follow directions in the HP41C owners handbook. almost all operations are the same when supported although many HP41C features are not supported. the mapping of the terminal keyboard to the "calculator" is explained on screen. the set of functions on the right are those activated by pressing the gold key prior to the specific key. almost all "calculator" functions are operated from the keypad. in addition four keys are used which are F17-F20 on a vt200 and UP-RIGHT (arrows) on a vt100. in addition the delete key on each terminal turns the program off (control C is not disabled but it should be avoided, otherwise the vt200 will be left with the cursor off and the current data will not be written to disk). only these keys are active and others are ignored. the functions available through the XEQ command are listed on the far left of the screen. XEQ does not require turning alpha mode on as the HP41C does. pressing XEQ automatically enables alpha mode. to terminate an alpha string press "." on the keypad. during alpha mode only A-Z (lowercase converted to upper), "-", keypad comma (<- function), and keypad period (terminate alpha mode) are active. possible additions: accumulator functions (+ACC, -ACC, mean, SDEV, and clear acc), and some of the following functions using XEQ: ABS, CLD, ENG, SCI, FACT, HMS, HMS+, HMS-, HR, LASTX, %, %CH, P-R, R^, R-P, RND. differences/limitations: uses standard PDP11 double floats in which the permissible size of a number is ~1.7e-38 to ~1.7e38 whereas the HP41C allows 9.9...e-99 to 9.9...e99. the program will not allow any value outside the range 1.0e-37 to 1.0e37. the program deals with out of range entries (NOT out of range results) differently than the HP41C. it displays an error message and remains in active mode allowing revision of the entered number, whereas the HP41C merely truncates the number to 0. or 9.9...e99 and tries to use it. PDP11 double floats have more decimal places accuracy than the HP41C. this is corrected for in the software. however occasionally this difference will result in a slightly different result than the HP41C (eg 1.123 - 1, then the result - .123 = a very small number rather than zero). DEC and OCT functions are available through keyboard commands as well as XEQ. XEQ does not require turning alpha mode off and on as the HP41C does. pressing XEQ automatically enables alpha mode. to terminate an alpha string press "." on the keypad. the trig functions may give slightly different results (7-10th decimal place). some trig functions may occasionally give very small answers instead of 0. (eg. tan of 720 degrees) or vice versa (sine of -1.236e-20). no other differences are known. revision history: v1.0 completed 24-jun-86 includes all display control keys includes + - / * and 1/x v1.1 completed 14-jul-86 keys added to displayed map, error in vt100 active, "shift" display, cutoff, x**2, sqrt, y**x, ln, e**x, log, 10**x, oct, dec v1.2 completed 18-jul-86 RDN, DEG/RAD/GRAD mode switching, STO, RCL, delete from anywhere to stop v1.3 completed 21-jul-86 XEQ (RAD, DEC, DEG, GRAD, CLST, CLRG, OCT, PI), storage in stack nonvolatile memory (write to disk) v1.4 completed 24-sep-86 fix bugs in k_oct and k_dec; set_inactive() created, improved general purpose isint(); SIN, COS, TAN, ASIN, ACOS, ATAN; XEQ: INT, FRC, MOD. vtttid() modified to allow vt132 and vt100 with printer port. installation/building: included: hp41c.sav, hp41c.h, hp41c.c, vt.obj, hclib.obj, hp41c.end, and hp41c.doc (included in hp41c.c also). to install: copy hp41c.sav to sy:. it will run from other locations but error messages will appear whenever the program is run or stopped if it cannot read/write from sy:hp41c.sav. the source module hp41c.c must be compiled and linked with library modules from hclib (my own c function library), clib (whitesmith's c function library), vt (my video terminal library), and syslib. after compilation and linking, the size of hp41c.sav must equal the number of blocks defined by BLOCK below. if not, change BLOCK and recompile. otherwise, append hp41c.end to hp41.sav to make the final hp41c.sav. definition: active mode means that entry is one key at a time prompted by '_' (if not in the far right character position) where entries can be edited with <-. inactive mode numbers cannot be edited. implementation notes: there is one source file hp41c.c and a header file hp41c.h. the video terminal library vt.obj, my library hclib.obj, and Whitesmith's clib.obj are also required. the program queries the terminal for type. it will not run unless the identification indicates a vt100 series or vt200 (in 7 bit mode only) series terminal. the following are differences between vt100 and vt200 implementations: 1) downloadable character sets on the vt200 allow the display to place the decimal point "between" two numbers rather than as a separate character and 2) the cursor is turned off on a vt200. the program uses special terminal mode and thus requires running in singlechar mode with TSX+ (done automatically) and changes the keypad and cursor control (arrow) keys to application mode. all keyboard input is captured and undefined keys are ignored. control-C is not disabled. the active display is defined by adc[], expdc[3], adc_sign, adc_dec, adc_dec, adc_dot, exp_flag, exp_sign, and exp_end. this is explained in comments in active(). the calculator stack is in extern double stack[3] (T, Z, and Y are in [2], [1], and [0] respectively) and x_value (X). dis_fix is the number of decimal places to display as entered by FIX. note that this is different from automatic variable fix. act_flag is YES if the display is in active mode. err_flag is YES if an error message is displayed (set NO by display(), set YES by derror(), only used by k_clc). lift_stack if YES means that the next time the display changes from inactive to active, the x value will be pushed onto the stack. this is explained in appendix C of the HP41C manual. stack lift is disabled by ENTER and CLX. it is not changed by <-. CHS and EEX do not change it during active mode; at other times they enable stack lift. all other operations enable stack lift. to use non-volatile memory, ie read/write data to disk, append 2 blocks to the compiled and linked *.sav image. the first word of the two blocks must be CALCODE. BLOCK, the starting block number to read must be equal to the length of the original *.sav file in blocks. the easiest way to do this is to append hp41c.end. this feature is turned off at compilation if NVMEM is undefined. *****************************************************************************/ #include #include #include #define VERSION "v1.4" #define CHAN 14 #define FILENAME "sy:hp41c.sav" #define NVMEM 1 /* turn read/write to disk on/off */ #define BLOCK 77 char adc[13] = { '0', 0 }, expdc[3] = { 0 }; int angle_mode = DEGREE; int dis_fix = 2, act_flag = NO, err_flag = NO, vt100 = NO; int adc_sign = POSITIVE, adc_dec = 0, adc_end = 0, adc_dot = NO; int exp_flag = NO, exp_sign = POSITIVE, exp_end = -1, lift_stack = NO; double stack[3] = { 0.0, 0.0, 0.0 }, x_value = { 0.0 }; double memory[100] = { 0.0 }; _main() { register int i; int calcode, open_flag = NO; int dis_stack(), vtdot(), process(), vtclr(), bigbox(), display(); int delay(), istsx(), call_emt(), enter(), hread(), hopen(); int vtmova(), vttxt(), vtttid(), vtesc(), vtmode(); unsigned int ijob; union { char c[1028]; int i[512]; double d[128]; } buffer; /* * read data from disk */ #ifdef NVMEM vtmode(8); vtmova(24, 1); if(hopen(CHAN, FILENAME) >= 0) errfmt("hp41c, main - unable to open disk file %p",FILENAME); else { if(hread(CHAN, buffer.i, 512, BLOCK) >= 0) errfmt("hp41c, main - unable to read disk file %p",FILENAME); else { calcode = buffer.i[0]; if(calcode != CALCODE) errfmt("hp41c, main - bad read of disk file %p",FILENAME); else { open_flag = YES; dis_fix = buffer.i[1]; angle_mode = buffer.i[2]; lift_stack = buffer.i[3]; err_flag = buffer.i[4]; act_flag = buffer.i[5]; adc_sign = buffer.i[10]; adc_dec = buffer.i[11]; adc_end = buffer.i[12]; adc_dot = buffer.i[13]; exp_flag = buffer.i[14]; exp_sign = buffer.i[15]; exp_end = buffer.i[16]; for(i = 0; i < 13; i++) adc[i] = buffer.c[100 + i]; for(i = 0; i < 3; i++) expdc[i] = buffer.c[113 + i]; x_value = buffer.d[24]; for(i = 0; i < 3; i++) stack[i] = buffer.d[25 + i]; for(i = 0; i < 100; i++) memory[i] = buffer.d[28 + i]; } } } if(!open_flag) delay(2); vtmode(0); #endif /* * set TSX singlechar mode, find terminal type */ if(istsx()) /* if running TSX+ */ i = call_emt(0152, 0, 'S'); /* set singlechar mode */ if(i < 0) { errfmt("\nhp41c, main - unable to set singlechar mode\n"); exit(); } i = vtttid(); if(i >= 100 && i <= 132) vt100 = YES; else if(i != 200) { errfmt("\nhp41c, main - illegal terminal type, not vt100 or vt200\n"); exit(); } /* * terminal to special mode, keypad & arrows to application mode */ ijob = JSW; JSW = ijob | 010000; vtesc("="); /* keypad application mode */ vtesc("[?1h"); /* arrow key application mode */ if(!vt100) { vtdot(); /* download character set */ vtesc("[?25l"); /* turn cursor off */ } /* * initialize screen, large box representing calculator display */ vtclr(2); /* clear screen */ bigbox(); /* box around display */ dis_stack(); /* display the calculator stack */ display(); /* display the current x_value */ #ifdef NVMEM if(open_flag) { if(angle_mode == RADIAN || angle_mode == GRAD) { vtmode(8); if(angle_mode == RADIAN) vttxt(5, 33, "rad "); else vttxt(5, 33, "grad"); vtmode(0); if(vt100) vthome(); } } #endif /* * await keyboard input */ while(enter(&process)) /* respond to keyboard input */ ; /* * write data to disk */ #ifdef NVMEM if(open_flag) { buffer.i[0] = CALCODE; buffer.i[1] = dis_fix; buffer.i[2] = angle_mode; buffer.i[3] = lift_stack; buffer.i[4] = err_flag; buffer.i[5] = act_flag; buffer.i[10] = adc_sign; buffer.i[11] = adc_dec; buffer.i[12] = adc_end; buffer.i[13] = adc_dot; buffer.i[14] = exp_flag; buffer.i[15] = exp_sign; buffer.i[16] = exp_end; for(i = 0; i < 13; i++) buffer.c[100 + i] = adc[i]; for(i = 0; i < 3; i++) buffer.c[113 + i] = expdc[i]; buffer.d[24] = x_value; for(i = 0; i < 3; i++) buffer.d[25 + i] = stack[i]; for(i = 0; i < 100; i++) buffer.d[28 + i] = memory[i]; if(hwrite(CHAN, buffer.i, 512, BLOCK) > 0) { vtmode(8); vtmova(24, 1); errfmt("hp41c, main - unable to write to disk file 1 %p",FILENAME); vtmode(0); delay(3); } else hclose(CHAN); } else { vtmode(8); vtmova(24, 1); errfmt("hp41c, main - unable to write to disk file 2 %p",FILENAME); vtmode(0); delay(3); } #endif /* * reset terminal and JSW */ JSW = ijob; /* reset JSW */ vtesc(">"); /* keypad numeric mode */ vtesc("[?1l"); /* arrow key movement mode */ if(!vt100) vtesc("[?25h"); /* turn cursor on */ vtclr(2); /* clear screen */ } /****************************************************************************/ int vtesc(s) /* output string s to STDERR preceded by . */ char *s; { putstr(STDERR, "", s, NULL); } /****************************************************************************/ int bigbox() /* create a large reverse video box to simulates the calculator LCD display. also display the program version number and facsimiles of the keypad to show the mapping of the calculator keys to the keypad. */ { static char top[] = "lqqqqwqqqqwqqqqwqqqqk"; static char bottom[] = "mqqqqvqqqqvqqqqvqqqqj"; static char grid[] = "tqqqqnqqqqnqqqqnqqqqu"; int bc = 27, bw = 32, sxp = 9, syp = 0; int vttxt(), vtgrid(), vtdcs(), vtdouble(), vtmbox(), vtmode(); int vtmova(); /* * make display one character wider for vt100 mode */ if(vt100) { bw = 34; bc++; } /* * make display box */ vtmode(8); /* reverse video */ vtmbox(1, 25, bw, ' '); vtmbox(2, 25, bw, ' '); vtdouble(3, 13, 0, " "); vtdouble(3, bc, 0, " "); vtmbox(5, 25, bw, ' '); vtmbox(6, 25, bw, ' '); vtmbox(7, 25, bw, ' '); /* * display version number */ vtmode(0); vtmova(1, 77); putstr(STDERR, VERSION, NULL); /* * grid to display keyboard mapping */ vttxt(12, 18, "press DELETE to exit"); vtmode(8); /* make bar to signify gold keys */ vttxt(12, 45, " "); vtmode(0); vtdcs(0, '0'); /* special line drawing character set */ vttxt( 9, 18, top, NULL); vttxt(11, 18, bottom, NULL); vttxt(13, 18, top, NULL); vttxt(15, 18, grid, NULL); vttxt(17, 18, grid, NULL); vttxt(19, 18, grid, NULL); vttxt(21, 18, grid, NULL); vttxt(23, 18, bottom, NULL); vttxt( 9, 45, top, NULL); vttxt(11, 45, bottom, NULL); vttxt(13, 45, top, NULL); vttxt(15, 45, grid, NULL); vttxt(17, 45, grid, NULL); vttxt(19, 45, grid, NULL); vttxt(21, 45, grid, NULL); vttxt(23, 45, bottom, NULL); /* * fill in grid with text */ vttxt(10, 18, "x + x - x * x / x xY**XxX**2xT**XxE**Xx"); vttxt(14, 18, "xGOLDx EEXx XEQx FIXx xaaaaxSQRTx LOGx LN x"); vttxt(16, 18, "x 7 x 8 x 9 x CHSx x SINx COSx TANx 1/Xx"); vttxt(18, 18, "x 4 x 5 x 6 x <= x xASINxACOSxATANx CLXx"); vttxt(20, 18, "x 1 x 2 x 3 x x x OCTx DECxaaaax x"); vttxt(22, 18, "x 0 x . x x x STO x RDNx x"); vttxt(21, 34, "ENTR"); vttxt(21, 61, " RCL"); /* * reset to normal character set */ vtdcs(0, 'B'); /* * list XEQ commands */ vttxt(sxp++, syp, "CLRG"); vttxt(sxp++, syp, "CLST"); vttxt(sxp++, syp, "D-R"); vttxt(sxp++, syp, "DEC"); vttxt(sxp++, syp, "DEG"); vttxt(sxp++, syp, "FRC"); vttxt(sxp++, syp, "GRAD"); vttxt(sxp++, syp, "INT"); vttxt(sxp++, syp, "MOD"); vttxt(sxp++, syp, "OCT"); vttxt(sxp++, syp, "PI"); vttxt(sxp++, syp, "R-D"); vttxt(sxp++, syp, "RAD"); } /****************************************************************************/ double r2(x, fix) /* rounds double x to fix decimal places. NOTE a major limitation: this will not work correctly with very small or very large numbers requiring scientific notation. eg 1.5678e24 fix 2 will return 1.5678e24 not 1.5700e24. */ double x; int fix; { register int i, k, j; int nchar1, da[50]; double dlog10(), power(), factor, sign = 1.; /* * get sign, add .5, reduce to < 1 */ if(x < 0) { /* get sign */ sign = -sign; x = -x; } x += 0.5 / power(10., fix); /* add .5 */ nchar1 = 1 + (int) dlog10(x); /* number of places left of decimal */ x = x / power(10., nchar1); /* reduce to < 1 and > .09, eg .123 */ /* * peel off a digit at a time, store in da */ k = nchar1 + fix; for(i = 0; i < k; i++) { x *= 10.; j = (int) x; da[i] = j; x -= (double) j; } /* * rebuild the number from the digits */ x = 0.; factor = 1. / power(10., fix); for(--k; k >= 0; k--) { x += factor * da[k]; factor *= 10; } /* * finish */ return(sign * x); } /****************************************************************************/ int snotat(x, exp, fix, s1, s2) /* prepare output strings for a number in scientific notation, called by inactive only. 1 <= x < 10. exp is the exponent. fix is the number of right decimal places. s1 and s2 are the resulting strings. s0 has already been done. */ char *s1, *s2; int exp, fix; double x; { register int i, k; double xt, fudge; /* * first two characters */ s1[0] = '0' + (int) x; /* sign already set */ s1[1] = '\0'; /* * do s2 up to the exponential */ i = 0; if(fix != 0) { xt = x - (int) x; fudge = 0.00000000000001; for( ; i < fix; i++) { xt *= 10.; fudge *= 10.; k = (int) (xt + fudge); s2[i] = '0' + k; xt -= (double) k; } } for( ; i < 7; i++) /* pad up to the exponential */ s2[i] = ' '; /* * do the exponential part of s2 */ if(exp < 0) { /* exponent sign */ s2[7] = '-'; exp = -exp; } else s2[7] = ' '; if(exp >= 10) { /* 1st digit of exp */ i = exp / 10; s2[8] = '0' + i; } else { i = 0; s2[8] = '0'; } s2[9] = '0' + (exp - (10 * i)); /* 2nd digit of exp */ s2[10] = '\0'; } /****************************************************************************/ int inactive(s0, s1, s2, fix) /* process the inactive display. takes the value of x_value and converts it to strings s0, s1, and s2 for output to the display. */ char *s0, *s1, *s2; int fix; { register int i, k, nchar1; int nchar2, exp; int snotat(); double x, xt, fudge; double dlog10(), r2(), power(); extern double x_value; /* * */ x = x_value; /* * special case for zero */ if(x == 0.) { s0[0] = ' '; s0[1] = '\0'; s1[0] = '0'; s1[1] = '\0'; for(i = 0; i < fix; i++) /* no test for fix > 9 */ s2[i] = '0'; for(; i < 10; i++) s2[i] = ' '; s2[10] = '\0'; return(NO); } /* * set up s0 */ if(x < 0.) { s0[0] = '-'; /* get the sign */ x = -x; /* absolute value */ } else s0[0] = ' '; s0[1] = '\0'; /* * round off to fix decimal places */ xt = r2(x, fix); /* * size the part left of the decimal, call snotat if too big */ if(x < 1.) nchar1 = 1; /* the character is a '0' */ else { nchar1 = 1 + (int) (dlog10(xt) + .0000000000001); if(nchar1 > 10) { /* too big */ x /= power(10., nchar1 -1); /* needs scientific notation*/ exp = nchar1 - 1; if((x = r2(x, fix)) >= 10.) { x /= 10.; exp++; } snotat(x, exp, fix, s1, s2); return(YES); } } /* * cut off right if too long */ if(nchar1 + fix > 10) { fix = 10 - nchar1; xt = r2(x, fix); } /* * size part to right, too small to include any digits? */ if(xt < 1. / power(10., fix)) { /* too small */ exp = 1 - (int) dlog10(x); /* needs scientific notation */ x *= power(10., exp); if((x = r2(x, fix)) >= 10.) { x /= 10.; exp--; } snotat(x, -exp, fix, s1, s2); return(YES); } /* * process left of decimal */ fudge = 0.00000000000001; /* absolutely necessary! */ if(xt < 1.) { s1[0] = '0'; s1[1] = '\0'; } else { xt /= power(10., nchar1); for(i = 0; i < nchar1; i++) { xt *= 10.; fudge *= 10.; k = (int) (xt + fudge); s1[i] = '0' + k; xt -= (double) k; } s1[nchar1] = '\0'; } /* * process right of decimal */ if(fix != 0) { for(nchar2 = 0; nchar2 < fix; nchar2++) { if(xt == 0.) s2[nchar2] = '0'; else { xt *= 10.; fudge *= 10.; k = (int) (xt + fudge); s2[nchar2] = '0' + k; xt -= (double) k; } } s2[nchar2] = '\0'; } else { nchar2 = 0; s2[0] = '\0'; } /* * pad right side */ k = 12; /* size of display */ if(vt100 && !fix) /* one larger in vt100 mode */ k++; k -= 1 + nchar1 + nchar2; /* length of display - (1+nc1+nc2) */ if(k > 0) { for(i = 0; i < k; i++) s2[nchar2++] = ' '; s2[nchar2] = '\0'; } /* * output */ return(NO); } /****************************************************************************/ int vtdot() /* enter VT220 codes for characters '0' - '9' and '-' each altered to include a trailing period. also loaded is a space with a trailing dot into the '.' loaction. */ { static char sz[]=";;;;;;;;;;;;OOOOOOO?/???????K;????????/???????K;????????/????????;"; static char sa[]="wCAAACw?/?@AAA@?K;?GC}????/?AABAA?K;CaaQQQK?/BAAAAAAK;"; static char sb[]="AAAQYUa?/@AAAAA@K;_ogc}__?/????B??K;]QIIIIq?/@AAAAA@K;"; static char sc[]="wcQQQQ_?/@AAAAA@K;AAAaQIE?/??B????K;kQQQQQk?/@AAAAA@K;"; static char sd[]="KQQQQI{?/?AAAA@?K;"; static char s1[] = "P1;1;1;0;0;0\( @"; /* $P1;1;1;0;0;0\( @ */ static char s2[] = "\\"; /* $\\ */ putstr(STDERR, s1, sz, sa, sb, sc, sd, s2, NULL); } /****************************************************************************/ int display() /* output the display. gets the value from active() or inactive(). it creates a string ss of the output, including escape sequences, with is output by vtdouble(). if not in vt100 mode, the decimal point is done by using the downloaded character set for the character immediately prior to the decimal point. */ { char cd; static char sdcs[] = "( @"; /* $( @ */ static char sbcs[] = "(B"; /* $(B */ char s0[3], s1[13], s2[13], ss[30]; register int i, k = 0, snflag; int vthome(), vtdouble(), active(), inactive(), copstr(); extern int adc_dec, act_flag, dis_fix, adc_dot, err_flag; /* * get display character strings */ if(act_flag == NO) snflag = inactive(s0, s1, s2, dis_fix); else snflag = active(s0, s1, s2); /* * make output string * special case of active starting with a decimal point * then the other case */ if(act_flag && adc_dot && adc_dec == -1) { if(vt100) { /* active mode leading '.' */ s0[1] = '.'; s0[2] = '\0'; k += copstr(ss, s0, k); } else { if(s0[0] == ' ') s0[0] = '.'; k += copstr(ss, sdcs, k); /* special character set on */ k += copstr(ss, s0, k); k += copstr(ss, sbcs, k); /* special character set off*/ } k += copstr(ss, s1, k); } else { k += copstr(ss, s0, k); if(vt100) { /* output s1 */ k += copstr(ss, s1, k); if((!act_flag&&(dis_fix != 0 || snflag))||(act_flag && adc_dot)) ss[k++] = '.'; } else if((!act_flag&&dis_fix==0&&!snflag)||(act_flag && !adc_dot)) k += copstr(ss, s1, k); /* no decimal point */ else { for(i = 0; s1[i] != '\0'; i++) ; cd = s1[i - 1]; /* take last chaacter of s1 */ s1[i - 1] = '\0'; /* shorten s0 */ k += copstr(ss, s1, k); k += copstr(ss, sdcs, k); /* special character set on */ ss[k++] = cd; /* special decimal character*/ k += copstr(ss, sbcs, k); /* special character set off*/ } } k += copstr(ss, s2, k); /* s2 */ ss[k] = '\0'; /* terminate ss */ /* * send output to terminal */ vtdouble(3, 15, 0, ss); err_flag = NO; /* reset error flag used by k_clc */ if(vt100) /* park cursor at home */ vthome(); /* no cursor-off on vt100 */ } /****************************************************************************/ int copstr(sout, sin, n) /* copy string sin into string sout starting at location n in sout. */ char *sout, *sin; register int n; { register int i; for(i = 0; sin[i] != '\0'; i++) sout[n++] = sin[i]; return(i); } /*************************************************************************/ int active(s0, s1, s2) /* process the active display into output strings s0, s1, and s2. the digits are stored as ascii in the array adc[]. adc_sign contains tne sign of the active display (0 negative, 1 positive). adc_dec and adc_end are the array indexes of the character before the true decimal place and the last character respectively. these values start at -1 and are -1 if the first numeric character is right of the decimal point. adc_dot is set to YES if a decimal point is to be displayed. expdc is a string with the exponent (excluding the sign). exp_sign indicates the sign of the exponent. exp_flag indicates whether an exponent is in use. exp_end is the array index of the last character used in expdc (-1, 0, or 1). */ char *s0, *s1, *s2; { register int i, k, j; int tl = 0, padd, len_s1, spaces = 12; extern char adc[], expdc[]; extern int adc_sign, adc_end, adc_dec, adc_dot, exp_flag, exp_sign; extern int exp_end; /* * create s0 */ if(adc_sign == NEGATIVE) /* create s0 */ s0[0] = '-'; /* 0 negative, 1 positive */ else s0[0] = ' '; s0[1] = '\0'; /* * create s1 */ for(i = 0; i <= adc_dec; i++) /* create s1 */ s1[i] = adc[i]; s1[i] = '\0'; len_s1 = i; /* * create numeric part of s2 */ for(k = 0; i <= adc_end; i++) /* create s2 */ s2[k++] = adc[i]; /* * pad s2 up to exponent */ if(vt100) { /* adjust for vt100, 13 characters */ spaces++; if(adc_dot) /* if decimal place used */ tl++; } if(!exp_flag) { if(!vt100) { if(1 + len_s1 + k + tl < spaces - 1) s2[k++] = '_'; } else { if(tl) { if(1 + len_s1 + k + tl < spaces - 1) s2[k++] = '_'; } else { if(1 + len_s1 + k + tl < spaces - 2) s2[k++] = '_'; } } padd = spaces - (1 + len_s1 + k + tl); } else { /* cut off if too long for exponent */ j = (spaces - 3) - (1 + len_s1 + k + tl); if(j < 0) k += j; padd = (spaces - 3) - (1 + len_s1 + k + tl); } for(i = 0; i < padd; i++) s2[k++] = ' '; /* * add exponent to s2 */ if(exp_flag) { if(exp_sign == NEGATIVE) s2[k++] = '-'; else s2[k++] = ' '; for(i = 0; i <= exp_end; i++) s2[k++] = expdc[i]; if((1 + len_s1 + k + tl) < spaces) s2[k++] = '_'; if((1 + len_s1 + k + tl) < spaces) s2[k++] = ' '; } /* * finish */ s2[k] = '\0'; return(exp_flag); } /****************************************************************************/ int hclose(chan) /* close file number chan. returns: 3 created duplicate files. emt call is to .close */ int chan; { int emt(); if(emt(0374, 03000 + chan) < 0) return(EMTERR); /* 3 */ return(-1); /* success! */ } /****************************************************************************/ int hopen(chan, name) /* opens file chan for buffered block output. returns the error: 0 channel already open, 1 channel not found on device. emt call is to .lookup */ int chan; char *name; /* ASCII */ { int emt375(), name_rad50[4]; ftor50(name, name_rad50); if(emt375(0400 + chan, name_rad50) < 0) return(EMTERR); /* 0 or 1 */ return(-1); /* success! */ } /****************************************************************************/ int hread(chan, p, n, b) /* read #n 16-bit words to buffer p from block number #b of file chan. returns: 0 attempted read past end of file, 1 hardware error, 2 channel not open. emt call is to .readw */ int chan, *p, n, b; { int emt375(); if(emt375(04000 + chan, b, p, n, 0) < 0) return(EMTERR); /* 0, 1, or 2 */ return(-1); /* success! */ } /****************************************************************************/ int hwrite(chan, p, n, b) /* write #n 16-bit words from buffer p to block number #b of file chan. returns: 0 attempted write past end of file, 1 hardware error, 2 channel not open. emt call is to .writw */ int chan, *p, n, b; { int emt375(); if(emt375(04400 + chan, b, p, n, 0) < 0) return(EMTERR); /* 0, 1, or 2 */ return(-1); /* success! */ } /****************************************************************************/ double actox() /* convert active display into double and load into x_value. tests for size of the number and signals an error for out of range */ { register int i; int derror(); double logexp, factor = 1., x = 0.; double power(), dlog10(); extern char adc[], expdc[]; extern int adc_sign, adc_end, adc_dec, exp_flag, exp_sign, exp_end; extern double x_value; /* * left of the decimal place */ for(i = adc_dec; i >=0 ; i--) { x += factor * (adc[i] - '0'); factor *= 10.; } /* * right of the decimal place */ factor = 0.1; for(i = adc_dec + 1; i <= adc_end; i++) { x += factor * (adc[i] - '0'); factor /= 10.; } /* * scientific notation exponent */ if(exp_flag) { i = 0.; if(exp_end == 0) i = expdc[0] - '0'; else if(exp_end == 1) i = (expdc[1] - '0') + 10 * (expdc[0] - '0'); logexp = (double) i; /* test for number out of range */ if(exp_sign == NEGATIVE) logexp = -logexp; if(abs(logexp + dlog10(x)) > MAXLOG) /* not possible for x=0. */ derror(OUTRANGE); if(exp_sign == POSITIVE) factor = power(10., i); else factor = 1. / power(10., i); x *= factor; } if(adc_sign == NEGATIVE) x = -x; return(x); } /****************************************************************************/ int key() /* get input from one keyboard key. returns code value. */ { char c, cc[2], cget(); int code; /* * */ if((c = cget()) != ESCAPE) switch (c) { case '\177': code = DELETE; break; default: return(ERROR); } else if((c = cget()) == 'O') { /* SS3 introducer */ c = cget(); switch (c) { case 'A': /* arrows */ code = UP; break; case 'B': code = DOWN; break; case 'C': code = RIGHT; break; case 'D': code = LEFT; break; case 'p': /* keypad */ code = ZERO; break; case 'q': code = ONE; break; case 'r': code = TWO; break; case 's': code = THREE; break; case 't': code = FOUR; break; case 'u': code = FIVE; break; case 'v': code = SIX; break; case 'w': code = SEVEN; break; case 'x': code = EIGHT; break; case 'y': code = NINE; break; case 'm': code = MINUS; break; case 'l': code = COMMA; break; case 'n': code = DOT; break; case 'M': code = ENTER; break; case 'P': code = PF1; break; case 'Q': code = PF2; break; case 'R': code = PF3; break; case 'S': code = PF4; break; default: return(ERROR); } } else if(c == '[') { /* CSI introducer */ cc[0] = cget(); if((cc[1] = cget()) == '~') /* editing keys */ switch (cc[0]) { case '1': /* editing keys (VT200) */ code = FIND; break; case '2': code = INSERT; break; case '3': code = REMOVE; break; case '4': code = SELECT; break; case '5': code = PREVIOUS; break; case '6': code = NEXT; break; default: return(ERROR); } else { /* function keys */ c = cget(); if(cc[0] == '1') { switch (cc[1]) { case '7': /* function keys */ code = F6; break; case '8': code = F7; break; case '9': code = F8; break; default: return(ERROR); } } else if(cc[0] == '2') { switch (cc[1]) { case '0': code = F9; break; case '1': code = F10; break; case '3': code = F11; break; case '4': code = F12; break; case '5': code = F13; break; case '6': code = F14; break; case '8': code = F15; break; case '9': code = F16; break; default: return(ERROR); } } else if(cc[0] == '3') { switch (cc[1]) { case '1': code = F17; break; case '2': code = F18; break; case '3': code = F19; break; case '4': code = F20; break; default: return(ERROR); } } } } return(code); } /****************************************************************************/ int set_active() /* switch to active mode, initialize the active display. */ { int push(); extern int lift_stack, act_flag, adc_end, adc_dec, adc_dot, exp_flag; extern int adc_sign, exp_sign, exp_end; act_flag = YES; adc_dec = -1; adc_end = -1; adc_sign = POSITIVE; adc_dot = NO; exp_flag = NO; exp_sign = POSITIVE; exp_end = -1; if(lift_stack) /* most times will push x onto stack */ push(); } /****************************************************************************/ int k_0to9(number) /* process keyboard entry of 0123...9 */ int number; { int set_active(), display(); extern char adc[], expdc[]; extern int lift_stack, act_flag, adc_end, adc_dec, adc_dot; extern int exp_flag, exp_end; if(!act_flag) /* set to active mode */ set_active(); lift_stack = YES; if(exp_flag) { if(exp_end < 1) { expdc[++exp_end] = '0' + number; display(); } } else if(adc_end < 9) { adc[++adc_end] = '0' + number; if(!adc_dot) adc_dec++; display(); } } /****************************************************************************/ int k_dot() /* process keyboard entry of decimal point */ { int set_active(), display(); extern int lift_stack, adc_dot, act_flag, exp_flag; if(!act_flag) set_active(); lift_stack = YES; if(!adc_dot && !exp_flag) { adc_dot = YES; display(); } } /****************************************************************************/ int k_chs() /* process keyboard entry of '-' (CHS) */ { int display(); double actox(); extern int lift_stack, adc_sign, act_flag, exp_flag, exp_sign; extern double x_value; if(!act_flag) { /* inactive */ lift_stack = YES; if(x_value != 0.) { x_value = -x_value; } display(); return; } /* * active */ if(exp_flag) { /* exponential */ if(exp_sign == POSITIVE) exp_sign = NEGATIVE; else exp_sign = POSITIVE; display(); } else if(actox() != 0.) { /* not exponential */ if(adc_sign == POSITIVE) /* inactive if x_values == 0. */ adc_sign = NEGATIVE; else adc_sign = POSITIVE; display(); } } /****************************************************************************/ int k_clc() /* process keyboard entry of <- */ { int display(), k_clx(); double actox(); extern int act_flag, adc_end, adc_dec, adc_dot, exp_flag; extern int exp_end, exp_sign, adc_sign, err_flag; /* * inactive */ if(!act_flag) { if(err_flag) display(); else k_clx(); return; } /* * active */ if(exp_flag) { /* in exponent */ if(exp_end > -1) exp_end--; else if(exp_sign == NEGATIVE) exp_sign = POSITIVE; else exp_flag = NO; } else { /* in mantissa */ if(adc_end == adc_dec) { if(adc_end == 0 && !adc_dot) k_clx(); else if(adc_end == -1) k_clx(); else if(adc_dot) adc_dot = NO; else { adc_end--; adc_dec--; } } else adc_end--; if(actox() == 0. && adc_sign == NEGATIVE) adc_sign = POSITIVE; } display(); } /****************************************************************************/ int k_enter() /* process ENTER */ { int display(), push(); double actox(); extern int lift_stack, act_flag; extern double x_value; lift_stack = NO; if(act_flag) { x_value = actox(); act_flag = NO; } push(); display(); } /****************************************************************************/ int k_clx() /* process CLX */ { int display(); extern int act_flag, lift_stack; extern double x_value; lift_stack = NO; x_value = 0.; act_flag = NO; display(); } /****************************************************************************/ int k_fix() /* process fix */ { int code = 0; int set_inactive(), key(), vthome(), vtdouble(), display(); extern int dis_fix; set_inactive(); vtdouble(3, 15, 0, "FIX _ "); if(vt100) { vtdouble(3, 27, 0, " "); vthome(); } while(code < ZERO || (code > NINE && !COMMA)) { code = key(); if(code == DELETE) leave(NO); } if(code != COMMA) /* <= */ dis_fix = code - 32; display(); } /****************************************************************************/ int k_eex() /* process EEX */ { int set_active(), display(); double actox(); extern char adc[]; extern int act_flag, adc_end, adc_dec, exp_flag, lift_stack; if(!act_flag || (act_flag && actox() == 0.)) { /* special case */ if(!act_flag) { set_active(); lift_stack = YES; } adc[0] = '1'; adc_end = adc_dec = 0; } else if(adc_end >= 8 && adc_end == adc_dec) return; exp_flag = YES; display(); } /****************************************************************************/ double pop() /* pop the calculator stack. */ { int dis_stack(); double temp; extern double x_value, stack[]; temp = stack[0]; stack[0] = stack[1]; stack[1] = stack[2]; dis_stack(); return(temp); } /****************************************************************************/ int push() /* push the contents of x_value onto the stack. */ { int dis_stack(); extern double x_value, stack[]; stack[2] = stack[1]; stack[1] = stack[0]; stack[0] = x_value; dis_stack(); } /****************************************************************************/ int dis_stack() /* display the stack */ { int sxp = 5, syp = 67; int vtmova(); extern double stack[]; vtmova(sxp, syp); errfmt("T %+ 12.5d", stack[2]); vtmova(sxp+1, syp); errfmt("Z %+ 12.5d", stack[1]); vtmova(sxp+2, syp); errfmt("Y %+ 12.5d", stack[0]); } /****************************************************************************/ int k_add() /* process add */ { int derror(), display(), set_inactive(); double temp; double cutoff(), pop(); extern double x_value, stack[]; set_inactive(); temp = stack[0]; if(gsign(x_value) == gsign(temp)) if(abs(x_value) > MAXVALUE - abs(temp)) derror(OUTRANGE); x_value += pop(); x_value = cutoff(x_value); display(); } /****************************************************************************/ int k_subt() /* process subtract */ { int derror(), display(), set_inactive(); double temp; double cutoff(), pop(); extern double x_value, stack[]; set_inactive(); temp = stack[0]; if(gsign(x_value) != gsign(temp)) if(abs(x_value) > MAXVALUE - abs(temp)) derror(OUTRANGE); x_value = pop() - x_value; x_value = cutoff(x_value); display(); } /****************************************************************************/ int k_mult() /* process multiply */ { int derror(), display(), set_inactive(); double prodlog, temp; double cutoff(), dlog10(), pop(); extern double x_value, stack[]; set_inactive(); temp = stack[0]; if(temp != 0. && x_value != 0.) { prodlog = dlog10(abs(x_value)) + dlog10(abs(temp)); if(abs(prodlog) > MAXLOG) derror(OUTRANGE); } x_value *= pop(); x_value = cutoff(x_value); display(); } /****************************************************************************/ int derror(code) /* error condition, display note and leave */ int code; { int leave(), vthome(), vtdouble(); extern int err_flag; if(code == DATAERROR) vtdouble(3, 15, 0, "DATA ERROR "); else if(code == OUTRANGE) vtdouble(3, 15, 0, "OUT OF RANGE"); else if(code == NONEX) vtdouble(3, 15, 0, "NONEXISTENT "); if(vt100) { vtdouble(3, 27, 0, " "); vthome(); } err_flag = YES; leave(YES); /* back to process */ } /****************************************************************************/ int k_div() /* process divide */ { int derror(), display(), set_inactive(); double temp, quolog; double cutoff(), dlog10(), pop(); extern double x_value; set_inactive(); if(x_value == 0.0) derror(DATAERROR); temp = pop(); if(temp != 0.) { quolog = dlog10(abs(temp)) - dlog10(abs(x_value)); if(abs(quolog) > MAXLOG) x_value = 0.; else x_value = temp / x_value; } else x_value = 0.; x_value = cutoff(x_value); display(); } /****************************************************************************/ int k_recip() /* process reciprocal */ { int derror(), display(), set_inactive(); double cutoff(); extern double x_value; set_inactive(); if(x_value == 0.) derror(DATAERROR); x_value = 1. / x_value; x_value = cutoff(x_value); display(); } /****************************************************************************/ int k_sqrt() /* process square root */ { int derror(), display(), set_inactive(); double cutoff(), dsqrt(); extern double x_value; set_inactive(); if(x_value < 0.) derror(DATAERROR); if(x_value != 0.) { /* if 0. leave unchanged */ x_value = dsqrt(x_value); x_value = cutoff(x_value); } display(); } /****************************************************************************/ int k_x2() /* process square (x**2) */ { int derror(), display(), set_inactive(); double prodlog; double cutoff(), dlog10(); extern double x_value; set_inactive(); if(x_value != 0.) { prodlog = 2 * dlog10(abs(x_value)); if(abs(prodlog) > MAXLOG) derror(OUTRANGE); else x_value *= x_value; } x_value = cutoff(x_value); display(); } /****************************************************************************/ int k_ex() /* process e**x */ { int derror(), display(), set_inactive(); double cutoff(), dexp(); extern double x_value; set_inactive(); if(abs(x_value) > MAXLN) derror(OUTRANGE); x_value = dexp(x_value); x_value = cutoff(x_value); display(); } /****************************************************************************/ int k_ln() /* process natural logs */ { int derror(), display(), set_inactive(); double cutoff(), dloge(); extern double x_value; set_inactive(); if(x_value <= 0.) derror(DATAERROR); x_value = dloge(x_value); x_value = cutoff(x_value); display(); } /****************************************************************************/ int k_log() /* process base 10 logs */ { int derror(), display(), set_inactive(); double cutoff(), dlog10(); extern double x_value; set_inactive(); if(x_value <= 0.) derror(DATAERROR); x_value = dlog10(x_value); x_value = cutoff(x_value); display(); } /****************************************************************************/ int k_10x() /* process 10**x */ { int derror(), display(), set_inactive(); double temp, prodlog; double cutoff(), dlog10(), dexp(); extern double x_value; set_inactive(); /* test for (x * 2.3) out of range */ if(x_value == 0.) x_value = 1; else { prodlog = dlog10(abs(x_value)) + dlog10(2.302585092994046); if(abs(prodlog) > MAXLOG) derror(OUTRANGE); temp = x_value * 2.302585092994046; /* test for temp out of range for dexp() */ if(abs(temp) > MAXLN) derror(OUTRANGE); x_value = dexp(x_value * 2.302585092994046); x_value = cutoff(x_value); } display(); } /****************************************************************************/ double isint(x, n) /* test a double for a fractional part. if n = NO, returns x if integer or 0 if not. the value must be tested for == 0 before calling this routine. uses a simpler method for values <= MAXLONG. assumes that any abs(x) which is > 1e12 must b an integer. if n is YES it returns the integer part if not an integer. */ double x; int n; { register int i, j, exp; int da[15]; double sign = 1., factor = 1., fudge = 0.000000000001; double power(), dlog10(); if(x < 0.) { sign = -1; x = -x; } if(x < 1.) return(0.); /* if(x < MAXLONG) { /* if x <= MAXLOG, do it the easy way ll = (long) (x + fudge); new_x = (double) ll; y = abs(new_x - x); vtmova(9, 0); if(y < 1.e-11 || n == YES) return(sign * new_x); else return(0.); } */ if(x > 1.e12) return(sign * x); exp = (int) dlog10(x); x /= power(10., exp + 1); for(i = 0; i < exp + 1; i++) { x *= 10.; fudge *= 5.; j = (int) (x + fudge); da[i] = j; x -= (double) j; } if(x > 1.e-6 && n == NO) return(0.); else { x = 0.; for(i--; i >= 0; i--) { x += factor * (double) da[i]; factor *= 10.; } return(x * sign); } } /****************************************************************************/ int k_yx() /* process y to x power (y**x) */ { int signy; int derror(), display(), set_inactive(); double xint, y, prodlog, temp; double isint(), pop(), cutoff(), dlog10(), dloge(), dexp(); extern double stack[], x_value; /* * */ set_inactive(); y = stack[0]; /* get y value */ /* * deal with special cases */ if(y == 0.) { if(x_value < 0) derror(DATAERROR); /* this is for HP compatibility */ else x_value = 0.; } else if(y == 1.) x_value = 1.; else if(x_value == 0.) x_value = 1.; /* * begin main portion of subroutine */ else { if(y < 0) { /* get y sign, abs(y) */ signy = NEGATIVE; y = -y; } else signy = POSITIVE; temp = dloge(y); /* test for (temp * x) out of range, x_value and temp checked for 0 above */ prodlog = dlog10(abs(x_value)) + dlog10(abs(temp)); if(abs(prodlog) > MAXLOG) derror(OUTRANGE); temp *= x_value; /* calculate ln of result */ xint = isint(x_value, NO); /* test temp for too large or too small in dexp() */ if(abs(temp) > MAXLN) derror(OUTRANGE); /* test for negative y with fractional x */ else if(signy == NEGATIVE && xint == 0.) derror(DATAERROR); else { temp = dexp(temp); /* calculate result */ prodlog = pop(); /* throw away, adjust stack */ } if(xint > MAXLONG) /* too big for (long) below */ derror(OUTRANGE); if(signy == NEGATIVE && (((long) abs(xint)) % 2 == 1)) x_value = -temp; /* negative? */ else x_value = temp; } /* * finish */ x_value = cutoff(x_value); display(); } /****************************************************************************/ double cutoff(x) /* limit x to 9 decimal places accuracy. for HP41C compatibility. */ double x; { register int i, k, j; int da[11], exp; double x1, factor, sign = 1.; double power(), dlog10(); if(x == 0) return(0.); if(x < 0) { sign = -1.; x = -x; } x1 = x; exp = (int) dlog10(x); if(x1 < 1.) x *= power(10., abs(exp)); else if(exp >= 0) x /= power(10., exp + 1); factor = 5. / power(10., CUTPLACES + 1); /**/ x += factor; /**/ /* * peel off a digit at a time, store in da */ k = CUTPLACES; /**/ for(i = 0; i < k; i++) { x *= 10.; j = (int) x; da[i] = j; x -= (double) j; } /* * rebuild the number from the digits */ x = 0.; factor = 1.e-CUTPLACES; /**/ for(--k; k >= 0; k--) { x += factor * (double) da[k]; factor *= 10.; } if(x1 < 1.) x /= power(10., abs(exp)); else if(exp >= 0) x *= power(10., 1 + exp); return(x * sign); } /****************************************************************************/ int k_oct() /* process decimal to octal conversion */ { register int i, k, n; int sign = 1, da[12]; int derror(), display(), set_inactive(); double x, pow8, factor = 1.; double power(), isint(); extern double x_value; /* * */ set_inactive(); /* * sign */ x = x_value; if(x < 0) { sign = -1; x = -x; } /* * test for size and if "integer" */ if(x >= 1073741824.) /* dec(7777777777) */ derror(DATAERROR); if(x == 0.) { display(); return; } if(isint(x, NO) == 0.) /* is it an integer? */ derror(DATAERROR); if(x <= 7.) { /* is it zero or < 8 */ display(); return; } /* * collect the digits */ for(n = 1; (x - power(8., n)) >= 0; n++) ; n--; for(i = n; i >= 0; i--) { pow8 = power(8., i); k = (int) (x / pow8 + 1.0e-12); da[i] = k; x -= k * pow8; } for(x = 0., i = 0; i <= n; i++) { x += da[i] * factor; factor *= 10.; } x_value = x * sign; display(); } /****************************************************************************/ int k_dec() /* process octal to decimal conversion */ { register int i, k, n; int sign = 1, da[12]; int derror(), set_inactive(); double x, fudge = .000000000001, factor = 1.; double dlog10(), power(), isint(); extern double x_value; /* * */ set_inactive(); /* * sign */ x = x_value; if(x < 0) { sign = -1; x = -x; } /* * test for size and if "integer" */ if(x > 7777777777.) /* maximum */ derror(DATAERROR); if(x == 0.) { display(); return; } if(isint(x, NO) == 0.) /* is it an integer? */ derror(DATAERROR); if(x <= 7.) { display(); return; } /* * collect the digits */ n = 1 + (int) (fudge + dlog10(x)); x /= power(10., n); for(i = 0; i < n; i++) { x *= 10.; k = (int) (x + fudge); if(k > 7) derror(DATAERROR); da[i] = k; x -= (double) k; fudge *= 10.; } x = 0.; for(i = n - 1; i >= 0; i--) { x += da[i] * factor; factor *= 8.; } x_value = x * sign; display(); } /****************************************************************************/ int k_rdn() /* rotate stack down */ { int dis_stack(), display(), set_inactive(); double temp; extern double x_value, stack[]; set_inactive(); temp = stack[0]; stack[0] = stack[1]; stack[1] = stack[2]; stack[2] = x_value; x_value = temp; dis_stack(); display(); } /****************************************************************************/ int k_sto() /* store in memory */ { static char s[] = "STO __ "; int flag, index, code, code2, position = 0; int dis_stack(), leave(), key(), akey(), vtdouble(), vthome(); int derror(), display(), set_inactive(); double temp, log; double cutoff(), dlog10(); extern double x_value, stack[], memory[]; /* * set inactive */ set_inactive(); /* * get index (storage unit number) */ s[2] = 'O'; s[4] = s[5] = '_'; flag = 0; while(position == 0 || position == 1) { lone: vtdouble(3, 15, 0, s); if(vt100) { vtdouble(3, 27, 0, " "); vthome(); } code = key(); if(code >= ZERO && code <= NINE) { s[position + 4] = (code - 32) + '0'; position++; if(position >= 2) { vtdouble(3, 15, 0, s); if(vt100) vthome(); break; } } else if(code == COMMA) { position--; if(position < 0) { display(); return; } else if(position == 0) { s[4] = '_'; goto lone; } } else if(code == DOT && position == 0) { /* store in stack */ vtdouble(3, 15, 0, "STO ST _ "); if(vt100) vthome(); while(code2!='T'&&(code2<'X'||code2>'Z')&&code2!=DELETE&&code2!=COMMA) code2 = akey(); if(code2 == COMMA) { display(); return; } else if(code2 == DELETE) leave(NO); else { if(code2 == 'Y') stack[0] = x_value; else if(code2 == 'Z') stack[1] = x_value; else if(code2 == 'T') stack[2] = x_value; dis_stack(); display(); return; } } else if(!vt100 && (code==F17||code==F18|| code==F19|| code==F20)) { if(position == 1 || flag > 0) goto lone; else { flag = code - F17 + 1; /* flag 1, 2, 3, or 4 for + - * / */ if(code == F17) s[2] = '+'; if(code == F18) s[2] = '-'; if(code == F19) s[2] = '*'; if(code == F20) s[2] = '/'; } } else if(vt100 && (code==UP||code==DOWN||code==LEFT||code==RIGHT)) { if(position == 1 || flag > 0) goto lone; else { flag = code - UP + 1; /* flag 1, 2, 3, or 4 for + - * / */ if(code == UP) s[2] = '+'; if(code == DOWN) s[2] = '-'; if(code == LEFT) s[2] = '*'; if(code == RIGHT) s[2] = '/'; } } else if(code == ENTER || code == MINUS || code==GOLD) goto lone; else if(code == PF2 || code == PF3 || code == PF4) goto lone; else if(code == DOT && position == 1) goto lone; else if(code == DELETE) leave(NO); else { display(); return; } } index = 10 * (s[4] - '0') + (s[5] - '0'); /* * place in memory, finish */ if(flag == 0) /* add */ memory[index] = x_value; else if(flag == 1) { temp = memory[index]; if(gsign(x_value) == gsign(temp)) if(abs(x_value) > MAXVALUE - abs(temp)) derror(OUTRANGE); memory[index] = cutoff(x_value + temp); } else if(flag == 2) { /* subtract */ temp = memory[index]; if(gsign(x_value) != gsign(temp)) if(abs(x_value) > MAXVALUE - abs(temp)) derror(OUTRANGE); memory[index] = cutoff(temp - x_value); } else if(flag == 3) { /* multiply */ temp = memory[index]; if(temp != 0. && x_value != 0.) { log = dlog10(abs(x_value)) + dlog10(abs(temp)); if(abs(log) > MAXLOG) derror(OUTRANGE); } memory[index] = cutoff(x_value * temp); } else if(flag == 4) { /* divide */ if(x_value == 0.0) derror(DATAERROR); temp = memory[index]; if(temp != 0.) { log = dlog10(abs(temp)) - dlog10(abs(x_value)); if(abs(log) > MAXLOG) memory[index] = 0.; else memory[index] = cutoff(temp / x_value); } else memory[index] = 0.; } display(); } /****************************************************************************/ int k_rcl() /* recall from memory */ { static char s[] = "RCL __ "; int index, code, position = 0; int push(), display(), key(), vtdouble(), vthome(); double actox(); extern int vt100, act_flag, lift_stack; extern double x_value, memory[]; /* * get x_value, set inactive, push stack */ if(act_flag) { x_value = actox(); act_flag = NO; } if(lift_stack) push(); /* * get index (storage unit number) */ s[4] = s[5] = '_'; while(position == 0 || position == 1) { lone: vtdouble(3, 15, 0, s); if(vt100) { vtdouble(3, 27, 0, " "); vthome(); } code = key(); if(code >= ZERO && code <= NINE) { s[position + 4] = (code - 32) + '0'; position++; if(position >= 2) { vtdouble(3, 15, 0, s); if(vt100) vthome(); break; } } else if(code == COMMA) { position--; if(position < 0) { display(); return; } else if(position == 0) { s[4] = '_'; goto lone; } } else if(!vt100 && (code==F17|| code==F18|| code==F19 || code==F20)) goto lone; else if(vt100 && (code==UP|| code==DOWN||code==LEFT|| code==RIGHT)) goto lone; else if(code == ENTER || code == MINUS || code==GOLD || code==DOT) goto lone; else if(code == PF2 || code == PF3 || code == PF4) goto lone; else if(code == DELETE) leave(NO); else { display(); return; } } index = 10 * (s[4] - '0') + (s[5] - '0'); /* * get value, finish */ lift_stack = YES; x_value = memory[index]; display(); } /****************************************************************************/ int akey() /* get input from one keyboard key. returns code value. accepts A-Z, a-z (converted to upper case), keypad comma, and keypad dot. */ { char c, cc[2], cget(); int code; /* * */ if((c = cget()) != ESCAPE) { if(c >= 'A' && c <= 'Z') return(c); else if(c >= 'a' && c <= 'z') return(c - 32); else if(c == '-') return(c); else if(c == '\177') return(DELETE); else return(ERROR); } else if((c = cget()) == 'O') { /* SS3 introducer */ c = cget(); switch (c) { case 'l': code = COMMA; break; case 'n': code = DOT; break; default: return(ERROR); } } return(code); } /****************************************************************************/ int k_xeq() /* execute commands */ { char s1[14]; static char s[] = "XEQ _ "; register int i, code, position = 0; int k; int cmpstr(), display(), akey(); int vtmode(), vttxt(), vtdouble(), vthome(); int k_oct(), k_dec(); int x_pi(), x_clrg(), x_clst(), x_rad(), x_deg(), x_grad(); int x_mod(), x_int(), x_frc(), x_dr(), x_rd(); double actox(); extern int vt100, lift_stack, act_flag; extern double x_value; /* * get x_value, set inactive */ if(act_flag) { x_value = actox(); act_flag = NO; } /* * get command string */ s[4] = '_'; for(i = 5; i <= 11; i++) s[i] = ' '; vtmode(8); vttxt(5, 45, "alpha"); vtmode(0); while(position >= 0) { lone: vtdouble(3, 15, 0, s); if(vt100) { vtdouble(3, 27, 0, " "); vthome(); } code = akey(); if((code >= 'A' && code <= 'Z') || code == '-') { if(position >= 7) goto lone; s[position + 4] = code; position++; s[position + 4] = '_'; } else if(code == COMMA) { s[position + 4] = ' '; position--; if(position < 0) { vtmode(8); vttxt(5, 45, " "); vtmode(0); display(); return; } s[position + 4] = '_'; } else if(code == DELETE) leave(NO); else if(code == DOT) { /* finished */ vtmode(8); vttxt(5, 45, " "); vtmode(0); break; } else goto lone; } /* * get instruction string */ for(k = 0, i = 4; s[i] != '\0' && s[i] != '_'; ) s1[k++] = s[i++]; s1[k] = '\0'; /* * check for valid commands */ if(cmpstr(s1, "CLRG")) x_clrg(); else if(cmpstr(s1, "CLST")) x_clst(); else if(cmpstr(s1, "D-R")) x_dr(); else if(cmpstr(s1, "DEC")) k_dec(); else if(cmpstr(s1, "DEG")) x_deg(); else if(cmpstr(s1, "FRC")) x_frc(); else if(cmpstr(s1, "GRAD")) x_grad(); else if(cmpstr(s1, "INT")) x_int(); else if(cmpstr(s1, "MOD")) x_mod(); else if(cmpstr(s1, "OCT")) k_oct(); else if(cmpstr(s1, "PI")) x_pi(); else if(cmpstr(s1, "R-D")) x_rd(); else if(cmpstr(s1, "RAD")) x_rad(); else derror(NONEX); /* * finish */ lift_stack = YES; display(); } /****************************************************************************/ int x_clrg() /* clear memory registers */ { register int i; extern double memory[]; for(i = 0; i < 100; i++) memory[i] = 0.; } /****************************************************************************/ int x_clst() /* clear stack */ { register int i; int dis_stack(); extern double x_value, stack[]; x_value = 0.; for(i = 0; i < 3; i++) stack[i] = 0.; dis_stack(); } /****************************************************************************/ int x_pi() /* move pi (3.14 etc) to x register */ { int push(); double cutoff(); extern int lift_stack; extern double x_value; if(lift_stack) push(); x_value = cutoff(PIE); } /****************************************************************************/ int x_deg() /* change to degree (for angles) mode. */ { int vthome(), vttxt(), vtmode(); extern int vt100, angle_mode; angle_mode = DEGREE; vtmode(8); vttxt(5, 33, " "); if(vt100) vthome(); vtmode(0); } /****************************************************************************/ int x_rad() /* change to radian (for angles) mode. */ { int vthome(), vttxt(), vtmode(); extern int vt100, angle_mode; angle_mode = RADIAN; vtmode(8); vttxt(5, 33, "rad "); if(vt100) vthome(); vtmode(0); } /****************************************************************************/ int x_grad() /* change to grad (for angles) mode. */ { int vthome(), vttxt(), vtmode(); extern int vt100, angle_mode; angle_mode = GRAD; vtmode(8); vttxt(5, 33, "grad"); if(vt100) vthome(); vtmode(0); } /****************************************************************************/ int x_int() /* integer */ { int display(), set_inactive(); double isint(); extern double x_value; set_inactive(); if(x_value == 0.) { display(); return; } x_value = isint(x_value, YES); display(); } /****************************************************************************/ int x_frc() /* fractional part */ { int display(), set_inactive(); double x, int_part; double cutoff(), isint(); extern double x_value; set_inactive(); x = abs(x_value); if(x == 0. || x < 1 || x > 1.e12) { if(x > 1.e12) x_value = 0.; display(); return; } int_part = isint(x_value, YES); x_value -= int_part; x_value = cutoff(x_value); display(); } /****************************************************************************/ int x_mod() /* modulus */ { int display(), set_inactive(); double y, temp; double pop(), cutoff(), isint(); extern double x_value; set_inactive(); y = pop(); if(x_value == 0.) { x_value = y; display(); return; } temp = y / x_value; if(temp < 0) { if(isint(temp, NO) == 0.) temp = isint(temp, YES) - 1.; else temp = isint(temp, YES); } else temp = isint(temp, YES); x_value = y - (x_value * temp); x_value = cutoff(x_value); display(); } /****************************************************************************/ int x_dr() /* convert an angle in degrees to radians */ { int display(), set_inactive(); double cutoff(), dtor(); extern double x_value; set_inactive(); if(x_value == 0.) { display(); return; } x_value = cutoff(dtor(x_value)); display(); } /****************************************************************************/ int x_rd() /* convert an angle in radians to degrees */ { int display(), set_inactive(); double r_to_d(), cutoff(); extern double x_value; set_inactive(); x_value = r_to_d(x_value); x_value = cutoff(x_value); display(); } /****************************************************************************/ double r_to_d(x) /* convert an angle in radians to degrees */ double x; { int derror(); double prodlog; double dlog10(); if(x == 0.) return(0.); prodlog = dlog10(abs(x)) + dlog10(57.295779513); if(abs(prodlog) > MAXLOG) derror(OUTRANGE); return(x * 57.295779513); } /****************************************************************************/ double r_to_g(x) /* convert an angle in radians to grads */ double x; { int derror(); double quodlog; double dlog10(); if(x == 0.) return(0.); x = r_to_d(x); quodlog = dlog10(abs(x)) - dlog10(.9); if(abs(quodlog) > MAXLOG) derror(OUTRANGE); return(x / .9); } /****************************************************************************/ int k_sin() /* process sine of x */ { int i; int derror(), display(), set_inactive(); double x, x1, t, dint; double power(), dlog10(), cutoff(), isint(), gtor(); double dtor(), dsin(); extern int angle_mode; extern double x_value; /* * */ set_inactive(); x = x_value; if(x == 0.) { x_value = 0.; display(); return; } if(abs(x) >= 1.e12) { /* the calculator does this! */ i = (int) (dlog10(abs(x)) + 1.e-12); i -= 11; x /= power(10., i); } /* * convert to radians */ if(angle_mode == DEGREE) x = dtor(x); else if(angle_mode == GRAD) x = gtor(x); /* * decrease angle to <= 2 PIE */ if(abs(x) > 2. * PIE) { t = x / (2. * PIE); dint = isint(t, YES); x -= 2. * PIE * dint; } x1 = x; /* * get sine */ x = dsin(x); /* * force very small values of sine to zero */ if(x1 != 0. && x != 0.) { if(abs(x) < 1.e-11 && abs(x / x1) < 1.e-11) x = 0.; } /* * finish */ x_value = cutoff(x); display(); } /****************************************************************************/ int k_tan() /* process tangent of x */ { int i; int derror(), display(), set_inactive(); double x, x1, t, dint; double power(), dlog10(), cutoff(), isint(), gtor(); double dtor(), dcos(), dsin(); extern int angle_mode; extern double x_value; /* * */ set_inactive(); x = x_value; if(x == 0.) { x_value = 0.; display(); return; } if(abs(x) >= 1.e12) { /* the calculator does this! */ i = (int) (dlog10(abs(x)) + 1.e-12); i -= 11; x /= power(10., i); } /* * convert to radians */ if(angle_mode == DEGREE) x = dtor(x); else if(angle_mode == GRAD) x = gtor(x); /* * decrease angle to -PIE / 2 < x <= PIE / 2 */ if(abs(x) > PIE / 2.) { t = x / (PIE); dint = isint(t, YES); x -= PIE * dint; } /* * get tangent */ x1 = dcos(x); /* if(1 - abs(x1) < 1.e-15) x_value = 0.; */ if(abs(x1) < 1.e-15) derror(OUTRANGE); else { x = dsin(x) / x1; x_value = cutoff(x); } /* * finish */ display(); } /****************************************************************************/ int k_cos() /* process cosine of x */ { int i; int derror(), display(), set_inactive(); double x, x1, t, dint; double power(), dlog10(), cutoff(), isint(), gtor(); double dtor(), dcos(); extern int angle_mode; extern double x_value; /* * */ set_inactive(); x = x_value; if(x == 0.) { x_value = 1.; display(); return; } if(abs(x) >= 1.e12) { /* the calculator does this! */ i = (int) (dlog10(abs(x)) + 1.e-12); i -= 11; x /= power(10., i); } /* * convert to radians */ if(angle_mode == DEGREE) x = dtor(x); else if(angle_mode == GRAD) x = gtor(x); /* * decrease angle to <= 2 PIE */ if(abs(x) > 2. * PIE) { t = x / (2. * PIE); dint = isint(t, YES); x -= 2. * PIE * dint; } x1 = x; /* * get cosine */ x = dcos(x); /* * force very small values of sine to zero */ if(x1 != 0. && x != 0.) { if(abs(x) < 1.e-11 && abs(x / x1) < 1.e-11) x = 0.; } /* * finish */ x_value = cutoff(x); display(); } /****************************************************************************/ double dtor(x) /* convert degrees to radians */ double x; { int derror(); double prodlog, dlog10(); if(x == 0.) return(0.); prodlog = dlog10(abs(x)) + dlog10(PIE / 180.); if(abs(prodlog) > MAXLOG) derror(OUTRANGE); return(x * PIE / 180.); } /****************************************************************************/ double gtor(x) /* convert grads to radians */ double x; { int derror(); double prolog; double dtor(), dlog10(); if(x == 0.) return(0.); prolog = dlog10(abs(x)) + dlog10(.9); if(abs(prolog) > MAXLOG) derror(OUTRANGE); return(dtor(x * .9)); } /****************************************************************************/ int k_atan() /* process arc tangent of x */ { int display(), set_inactive(); double x; double r_to_d(), r_to_g(), darctan(), cutoff(); extern int angle_mode; extern double x_value; /* * */ set_inactive(); /* * get arc tangent */ x = darctan(x_value); /* * convert angle to degrees or grads */ if(angle_mode == DEGREE) x = r_to_d(x); else if(angle_mode == GRAD) x = r_to_g(x); /* * finish */ x_value = cutoff(x); display(); } /****************************************************************************/ int k_asin() /* process arc sine of x */ { int derror(), display(), set_inactive(); double prolog, t, x; double dsqrt(), r_to_d(), r_to_g(), darctan(), cutoff(); double dlog10(); extern int angle_mode; extern double x_value; /* * */ set_inactive(); /* * convert */ if(x_value > 1. || x_value < -1.) derror(DATAERROR); else if(x_value == 0.) { display(); return; } else if(abs(x_value) == 1.) { x = PIE / 2.; if(x_value < 0) x = -x; } else { x = x_value; prolog = 2. * dlog10(abs(x)); if(abs(prolog) > MAXLOG) derror(OUTRANGE); t = 1. - (x * x); x /= dsqrt(t); /* * get arc tangent */ x = darctan(x); } /* * convert angle to degrees or grads */ if(angle_mode == DEGREE) x = r_to_d(x); else if(angle_mode == GRAD) x = r_to_g(x); /* * finish */ x_value = cutoff(x); display(); } /****************************************************************************/ int k_acos() /* process arc cosine of x */ { int derror(), display(), set_inactive(); double prolog, t, x; double dsqrt(), r_to_d(), r_to_g(), darctan(), cutoff(); double dlog10(); extern int angle_mode; extern double x_value; /* * */ set_inactive(); /* * convert */ if(abs(x_value) > 1.) derror(DATAERROR); else if(x_value == 1.) x = 0.; else if(x_value + 1. < 1.e-12) /* x_value == -1. */ x = PIE; else if(abs(x_value) < 1.e-10) x = PIE / 2.; else { x = x_value; prolog = 2. * dlog10(abs(x)); if(abs(prolog) > MAXLOG) derror(OUTRANGE); t = 1. - (x * x); x /= dsqrt(t); /* * get arc tangent */ x = darctan(x); x = PIE / 2. - x; } /* * convert angle to degrees or grads */ if(angle_mode == DEGREE) x = r_to_d(x); else if(angle_mode == GRAD) x = r_to_g(x); /* * finish */ x_value = cutoff(x); display(); } /****************************************************************************/ int set_inactive() /* change to inactive display status */ { extern int lift_stack, act_flag; double actox(); extern double x_value; /* * */ lift_stack = YES; if(act_flag) { x_value = actox(); act_flag = NO; } } /****************************************************************************/ int process() /* process keyboard input by calling a subroutine. uses key() to get key. */ { int code; int vthome(), vttxt(), vtmode(); int key(), k_clx(), k_0to9(), k_dot(), k_chs(), k_enter(), k_clc(); int k_fix(), k_eex(), k_add(), k_subt(), k_mult(), k_div(), k_recip(); int k_oct(), k_dec(), k_sqrt(), k_log(), k_ln(), k_sin(), k_cos(); int k_tan(), k_asin(), k_acos(), k_atan(), k_yx(), k_x2(), k_10x(); int k_sto(), k_rcl(), k_rdn(), k_ex(); /* * */ FOREVER { code = key(); if(code == GOLD) { vtmode(8); vttxt(5, 38, "shift"); if(vt100) vthome(); code = key(); vttxt(5, 38, " "); if(vt100) vthome(); vtmode(0); if(code == ZERO) k_sto(); else if(code == ONE) k_oct(); else if(code == TWO) k_dec(); else if(code == FOUR) k_asin(); else if(code == FIVE) k_acos(); else if(code == SIX) k_atan(); else if(code == SEVEN) k_sin(); else if(code == EIGHT) k_cos(); else if(code == NINE) k_tan(); else if(code == PF2) k_sqrt(); else if(code == PF3) k_log(); else if(code == PF4) k_ln(); else if(code == DOT) k_rdn(); else if(code == COMMA) k_clx(); else if(code == MINUS) k_recip(); else if(code == ENTER) k_rcl(); else if(code == DELETE) leave(NO); else if(vt100) { if(code == UP) k_yx(); else if(code == DOWN) k_x2(); else if(code == LEFT) k_10x(); else if(code == RIGHT) k_ex(); } else { if(code == F17) k_yx(); else if(code == F18) k_x2(); else if(code == F19) k_10x(); else if(code == F20) k_ex(); } } else if(code >= ZERO && code <= NINE) k_0to9(code - 32); else if(code == DOT) k_dot(); else if(code == MINUS) k_chs(); else if(code == ENTER) k_enter(); else if(code == COMMA) k_clc(); else if(code == PF2) k_eex(); else if(code == PF3) k_xeq(); else if(code == PF4) k_fix(); else if(code == DELETE) leave(NO); else if(vt100) { if(code == UP) k_add(); else if(code == DOWN) k_subt(); else if(code == LEFT) k_mult(); else if(code == RIGHT) k_div(); } else { if(code == F17) k_add(); else if(code == F18) k_subt(); else if(code == F19) k_mult(); else if(code == F20) k_div(); } } }