page%swap@Sun.COM (Bob Page) (11/13/89)
Submitted-by: dg3i+@andrew.cmu.edu (David Gay)
Posting-number: Volume 89, Issue 200
Archive-name: applications/hp11.3
# This is a shell archive.
# Remove anything above and including the cut line.
# Then run the rest of the file through 'sh'.
# Unpacked files will be owned by you and have default permissions.
#----cut here-----cut here-----cut here-----cut here----#
#!/bin/sh
# shar: SHell ARchive
# Run the following text through 'sh' to create:
# ins.c
# ins.h
# io.c
# io.h
# kbd.c
# kbd.h
# lmkdebug
# lmkfile
# o/dummy
# od/dummy
# prog_codes.c
# prog_codes.h
# support.c
# support.h
# This is archive 3 of a 3-part kit.
# This archive created: Sun Nov 12 17:33:21 1989
echo "extracting ins.c"
sed 's/^X//' << \SHAR_EOF > ins.c
X#include "exec/types.h"
X#include "proto/dos.h"
X
X#include "math.h"
X#include "string.h"
X#include "stdio.h"
X
X#include "hp11/amiga/amiga.h"
X#include "hp11/hp11.h"
X#include "hp11/io.h"
X#include "hp11/support.h"
X#include "hp11/ins.h"
X#include "hp11/codes.h"
X
X#define FOREVER() for(;;)
X
X/* Declare the modules variables */
XBOOL enabled, entering, overflow;
X
XBOOL expo, decpt;
Xchar strx[13], expx[4];
X
X/* Function addresses */
XHP11Function insfunc[KCOMPLEX] =
X{
X Sqrt,
X Exp,
X Exp10,
X ExpYX,
X Invert,
X DoCHS,
X Divide,
X SIN,
X COS,
X TAN,
X DoEEX,
X Times,
X RunStart,
X Rdn,
X ExgXY,
X ENTER,
X Minus,
X DoPoint,
X SigmaPlus,
X Plus,
X
X Pi,
X XleY,
X ExgXInd,
X ToRect,
X ExgXI,
X DSE,
X ISG,
X XgtY,
X PSE,
X ClearSigma,
X ClearReg,
X Random,
X DoPerm,
X ToHMS,
X ToRAD,
X XneY,
X FRAC,
X Fact,
X Estimate,
X LinearRegression,
X XeqY,
X
X Sqr,
X LN,
X LOG,
X Percent,
X DeltaPercent,
X ABS,
X DEG,
X RAD,
X GRAD,
X Xlt0,
X ArcSIN,
X ArcCOS,
X ArcTAN,
X ToPolar,
X Xgt0,
X RTN,
X Rup,
X RND,
X CLX,
X LSTX,
X DoComb,
X ToH,
X ToDEG,
X Xne0,
X INT,
X Mean,
X SDev,
X SigmaSub,
X Xeq0,
X
X STORandom,
X RCLSigma,
X
X HypSIN,
X HypCOS,
X HypTAN,
X
X ArcHypSIN,
X ArcHypCOS,
X ArcHypTAN
X};
X
X/* Various functions used to conserve code space. Could be macros or simply
X instructions */
Xvoid DISABLE() { enabled = FALSE; entering = FALSE; }
X
Xvoid ENABLE() { enabled = TRUE; entering = FALSE; }
X
Xvoid LisX(void)
X{
X L = X;
X}
X
Xvoid XisY(void)
X{
X X = Y;
X}
X
Xvoid YisX(void)
X{
X Y = X;
X}
X
Xvoid YisZ(void)
X{
X Y = Z;
X}
X
Xvoid ZisY(void)
X{
X Z = Y;
X}
X
Xvoid ZisT(void)
X{
X Z = T;
X}
X
Xvoid TisZ(void)
X{
X T = Z;
X}
X
X/* Check r against HP11 limits */
Xdouble Check(r)
Xdouble r;
X{
X if (fabs(r) > MAXHP11) {
X r = MAXHP11 * sign(r);
X overflow = TRUE; /* Overflow has occured */
X }
X else if (fabs(r) < MINHP11) r = 0.0;
X
X return(r);
X}
X
Xvoid Drop(void) /* Drop stack & save X in L */
X{
X ENABLE();
X LisX(); XisY(); YisZ(); ZisT();
X/* L = X(); X = Y; Y = Z; Z = T; */
X}
X
Xvoid Enter(void) /* Move stack up */
X{
X TisZ(); ZisY(); YisX();
X/* T = Z; Z = Y; Y = X; */
X}
X
Xvoid Lift(void) /* lift stack if enabled, ENABLE stack */
X{
X if (enabled) Enter();
X ENABLE();
X}
X
Xvoid SaveX(void) /* Frequent: L = X; ENABLE(); (most simple instructions eg sin do this) */
X{
X LisX();
X ENABLE();
X}
X
X/* Convert x from current trig setting to radians */
Xdouble from(double x)
X{
X switch (Angles) {
X case deg:return(FDEG(x));
X case rad:return(x);
X case grad:return(FGRAD(x));
X }
X}
X
X/* Convert radian value to current trig setting */
Xdouble toa(double x)
X{
X switch (Angles) {
X case deg:return(TDEG(x));
X case rad:return(x);
X case grad:return(TGRAD(x));
X }
X}
X
X/* Used by statistical formulae (terminology from HP11 doc) */
Xdouble M(void) { return(R[0] * R[2] - R[1] * R[1]); }
X#define N() (R[0] * R[4] - R[3] * R[3]) /* used only once */
Xdouble P(void) { return(R[0] * R[5] - R[1] * R[3]); }
X
Xdouble *Reg(int n) /* Return address of register n */
X{
X if (n == OI) return(&I);
X else if (n == OIND_R) /* indirection */
X if (I >= 0.0 && I < 20.0) return(R + (int)I);
X else return(NULL); /* Unknown reg */
X else return(R + n);
X}
X
X/* Convert current input value to real, return false if fails (no exponent) */
Xvoid StdVal(void)
X{
X X = atof(strx);
X}
X
X/* Convert current input value to real, return false if fails (exponent) */
Xvoid ExpoVal(void)
X{
X char buf[80];
X
X /* buf = strx + "E" + expx, with leading blanks stripped from expx */
X strcat(strcat(strcpy(buf,strx),"E"), stpblk(expx));
X
X X = atof(buf);
X}
X
X/* Act on key to modify current input value */
Xvoid EnterNum(key)
Xregister int key;
X{
X register int lens;
X
X if (!entering) { /* No current digit entry */
X if (enabled) Enter(); /* lift stack ? */
X entering = enabled = TRUE; /* stack enabled, number being entered */
X expo = decpt = FALSE; /* No dec point or exponent */
X strx[0] = ' '; strx[1] = '\0'; /* nb string empty (leading space for sign) */
X }
X
X lens = strlen(strx); /* Current string length */
X if (key >= KFIG + 0 && key <= KFIG + 9) /* Add digit */
X if (expo) { /* to exponent */
X expx[1] = expx[2]; expx[2] = key - KFIG + '0';
X }
X else {
X strx[lens] = key - KFIG + '0'; strx[lens + 1] = '\0';
X strx[scrpos(strx, 11) + 1] = '\0'; /* Cut string at end of hp11 screen pos
X ==> prevent display overflow */
X }
X else
X switch (key) {
X case -IBACK: /* back-arrow, actions are passed as negative numbers to
X distinguish them from instructions */
X if (expo) /* Correct exponent */
X if (strcmp(expx, "-00") == 0) strcpy(expx, " 00");
X else if (strcmp(expx, " 00") == 0) expo = FALSE; /* delete exponent */
X else {
X expx[2] = expx[1]; expx[1] = '0';
X }
X else /* no exponent */
X if (lens == 2) { CLX(); return; } /* end of digit entry,
X must not evaluate current entry ==> exit */
X else {
X if (strx[lens - 1] == '.') decpt = FALSE;
X strx[lens - 1] = '\0'; /* cut last char from str by moving eos mark */
X }
X break;
X case KCHS:
X if (expo) { /* change exponent sign */
X expx[0] = (expx[0] == '-') ? ' ' : '-';
X }
X else { /* change number sign */
X strx[0] = (strx[0] == '-') ? ' ' : '-';
X }
X break;
X case KPOINT:
X if (!expo && !decpt) {
X decpt = TRUE;
X
X if (lens == 1) { strcpy(strx, " 0"); lens = 2; } /* if no digit entered, add a 0 */
X strx[lens] = '.'; strx[lens + 1] = '\0';
X strx[scrpos(strx, 11) + 1] = '\0';
X }
X break;
X case KEEX:
X if (!expo) {
X expo = TRUE;
X strcpy(expx, " 00");
X if (lens == 1) strcpy(strx, " 1"); /* if no digit entered, add a 1 */
X }
X }
X if (expo) ExpoVal();
X else StdVal();
X}
X
Xvoid ExpYX() /* y^x */
X{
X double t;
X
X errno = 0; /* set return code to 0 */
X t = pow(Y, X);
X if (errno != 0) Error('0'); /* Check math library return code */
X else {
X Y = t;
X Drop();
X }
X}
X
Xvoid CHS(void)
X{
X ENABLE();
X X = -X;
X}
X
Xvoid DoCHS()
X{
X if (entering) EnterNum(KCHS);
X else CHS();
X}
X
Xvoid DoEEX()
X{
X EnterNum(KEEX);
X}
X
Xvoid DoPoint()
X{
X EnterNum(KPOINT);
X}
X
Xvoid Rdn()
X{
X double t;
X
X ENABLE();
X t = X; XisY(); YisZ(); ZisT(); T = t;
X/* t = X; X = Y; Y = Z; Z = T; T = t; */
X}
X
Xvoid ExgXY() /* Exchange X & Y */
X{
X double t;
X
X ENABLE();
X t = X; XisY(); Y = t;
X/* t = X; X = Y; Y = t; */
X}
X
Xvoid ClearReg()
X{
X int i;
X
X NEUTRAL();
X for (i = 0; i < 20; i++) R[i] = 0.0;
X I = 0;
X}
X
Xvoid Estimate() /* Statistics: estimate y from given x */
X{
X double tm = M(), tr, ty, tp = P(); /* temporary results */
X
X tr = tm * N();
X ty = R[0] * tm;
X
X if (tr < 0.0 || ty == 0.0) Error('2'); /* Stat error */
X else {
X Enter(); /* always lifts stack */
X SaveX();
X
X X = (tm * R[3] + tp * (R[0] * X - R[1])) / ty; /* estimate */
X Y = tp / sqrt(tr); /* Correlation coefficient */
X }
X}
X
Xvoid LinearRegression()
X{
X double tm = M(), tp = P();
X
X if (tm == 0.0 || R[0] == 0.0) Error('2');
X else {
X Lift(); /* Lift stack twice */
X Enter();
X
X Y = tp / tm;
X X = (tm * R[3] - tp * R[1]) / (R[0] * tm);
X }
X}
X
Xvoid Rup()
X{
X double t;
X
X ENABLE();
X t = T; TisZ(); ZisY(); YisX(); X = t;
X/* t = T; T = Z; Z = Y; Y = X; X = t; */
X}
X
Xvoid SDev()
X{
X double tx, ty, td;
X
X td = R[0] * (R[0] - 1.0);
X
X if (td == 0.0) Error('2');
X else {
X tx = M() / td;
X ty = N() / td;
X
X if (tx < 0.0 || ty < 0.0) Error('2');
X else {
X Lift();
X Enter();
X
X X = sqrt(tx); Y = sqrt(ty);
X }
X }
X}
X
Xvoid FIX(n)
Xint n;
X{
X NEUTRAL();
X Mode = fix; Digits = n;
X minfix = pow(10.0, (double)-Digits);
X}
X
Xvoid SCI(n)
Xint n;
X{
X NEUTRAL();
X Mode = sci; Digits = n;
X}
X
Xvoid ENG(n)
Xint n;
X{
X NEUTRAL();
X Mode = eng; Digits = n;
X}
X
Xvoid ExgXI() /* Exchange X with I */
X{
X double t;
X
X ENABLE();
X t = I; I = X; X = t;
X}
X
Xvoid ExgXInd() /* Exchange X with (i) */
X{
X double t, *ptr;
X
X if (!(ptr = Reg(OIND_R))) Error('3'); /* get address of pointed register if exists */
X else {
X ENABLE();
X t = *ptr; *ptr = X; X = t;
X }
X}
X
Xvoid STO(n, type)
Xint n;
Xenum StoTypes type;
X{
X double val;
X register double *ptr;
X
X if (ptr = Reg(n)) { /* Valid register */
X
X switch (type) {
X case sto: val = X; break;
X case add: val = *ptr + X; break;
X case sub: val = *ptr - X; break;
X case mul: val = *ptr * X; break;
X case div: if (X == 0.0) {
X Error('0');
X return; /* exit if error */
X }
X else val = *ptr / X; break;
X }
X
X if (fabs(val) > MAXHP11) Error('1'); /* Register overflow */
X else {
X *ptr = val;
X ENABLE();
X }
X }
X else Error('3');
X}
X
Xvoid RCL(n)
Xint n;
X{
X double *ptr;
X
X if (ptr = Reg(n)) {
X Lift();
X X = *ptr;
X }
X else Error('3');
X}
X
Xvoid GTOLine(n) /* move to line n */
Xint n;
X{
X if (n >= 0 && n <= lastIns) PC = n;
X else Error('4');
X}
X
Xvoid ProgramEntry() /* Enter a program */
X{
X register int i;
X WORD code;
X register int inprog = TRUE;
X
X RelKey();
X
X ENABLE();
X
X do {
X DisplayLine(); DispPRGM(TRUE); /* Program display */
X
X switch (ReadKey(&code)) {
X case Instruction: /* Save it */
X if (lastIns == MAXPROG) Error('4'); /* Memory full */
X else {
X for (i = lastIns; i > PC; i--) Prog[i + 1] = Prog[i]; /* Move program up */
X lastIns++;
X Prog[++PC] = code; /* store instruction */
X retCnt = 0; /* Empty return stack */
X };
X break;
X case Action: /* Act on it */
X if (code >= IGTO_LINE) GTOLine(code - IGTO_LINE);
X else switch (code) {
X case ION: on = inprog = !RelKey(); break; /* Allow user to change his mind */
X case IP_R: case IRESET: inprog = FALSE; break; /* exit program mode */
X case IMEM: MEM(); break;
X case IBACK: /* delete line */
X if (PC != 0) {
X for (i = PC; i < lastIns; i++) Prog[i] = Prog[i + 1]; /* del line */
X lastIns--;
X PC--;
X retCnt = 0; /* empty stack when prog changed */
X }
X break;
X case ISST: if (PC++ == lastIns) PC = 0; break;
X case IBST: if (PC-- == 0) PC = lastIns; break;
X case IUSER: USER(); break;
X case ICLR_PRGM: lastIns = PC = 0; break;
X }
X break;
X }
X RelKey();
X } while (inprog);
X}
X
Xvoid GTOLBL(int n)
X{
X register int i;
X
X if (n > 14) Error('4');
X else { /* Do a circular search from current line */
X for (i = PC + 1; i <= lastIns; i++) /* Search from current line */
X if (Prog[i] == KLBL + n) {
X PC = i; return; /* found, exit */
X }
X for (i = 1; i < PC; i++) /* If that fails, search from start */
X if (Prog[i] == KLBL + n) {
X PC = i; return;
X }
X Error('4');
X }
X}
X
Xvoid GTO(n)
Xint n;
X{
X if (n == OIND_G) /* Indirection */
X if (I >= 0.0) GTOLBL((int)I); /* gto label if I >= 0 */
X else GTOLine(-(int)I); /* gto line -I if i < 0 */
X else GTOLBL(n);
X if (!error) { /* success */
X ENABLE();
X if (running) PC--; /* Execute label instruction (even though useless),
X must decrement PC in run mode because incremented after end ins */
X else retCnt = 0; /* in normal mode, GTO clears return stack */
X }
X}
X
Xvoid BreakupI(int *limit, int *step) /* From I deduce loop limit & step.
X I is stored as nnnnn.lllss with nnnnn as the loop count, lll the limit &
X ss the step. If ss == 0, the step is taken as 1 */
X{
X double t;
X
X t = frac(I) * 1000.0;
X *limit = (int)t;
X *step = (int)(100.0 * (t - *limit));
X if (*step == 0) *step = 1;
X}
X
Xvoid DSE()
X{
X int limit, step;
X
X ENABLE();
X BreakupI(&limit, &step);
X I -= step;
X
X skip = (I <= limit);
X}
X
Xvoid ISG()
X{
X int limit, step;
X
X ENABLE();
X BreakupI(&limit, &step);
X I += step;
X
X skip = (I > limit);
X}
X
Xvoid SF(n)
Xint n;
X{
X ENABLE();
X Flags |= (1 << n);
X}
X
Xvoid CF(n)
Xint n;
X{
X ENABLE();
X Flags &= ~(1 << n);
X}
X
Xvoid Set(n) /* Is flag n set ? */
Xint n;
X{
X ENABLE();
X skip = !(Flags & (1 << n));
X}
X
Xvoid PSE()
X{
X BOOL oldrun = running;
X
X NEUTRAL();
X running = FALSE;
X Disp();
X Wait50(50);
X running = oldrun;
X}
X
Xvoid RTN()
X{
X ENABLE();
X if (!running || retCnt == 0) { /* In normal mode RTN sets PC to 0 &
X clears the return stack. In run mode, if the stack is empty, it also
X sets PC to 0 & then it interrupts the program */
X running = FALSE;
X PC = 0; retCnt = 0;
X }
X else /* Return from subroutine */
X PC = retStack[--retCnt];
X}
X
Xvoid GSB(n)
Xint n;
X{
X if (retCnt == MAXSTACK) Error('5'); /* Stack full */
X else {
X if (running) {
X retStack[retCnt++] = PC; /* Save PC */
X GTO(n); /* Jump to prog line */
X if (error) retCnt--; /* If this fails, reclaim stack space */
X }
X else { /* in normal mode, GSB = GTO + R/S */
X retCnt = 0;
X GTO(n);
X running = !error;
X }
X }
X}
X
Xvoid HP11ColdReset() /* ColdReset HP11 (Menu option: New) */
X{
X Display(" Pr Error");
X
X DEG();
X FIX(4);
X PC = lastIns = 0;
X running = User = comma = FALSE;
X Flags = retCnt = 0;
X ClearSigma(); L = 0.0;
X ClearReg();
X
X GetKey();
X}
X
Xvoid MEM() /* Display available memory */
X{
X char mem[20];
X
X NEUTRAL();
X sprintf(mem, " P-%-4dr- .9", MAXPROG - lastIns);
X /* There are always all the register hence the r- .9, %-4d left justifies the number
X of lines in a 4 character field */
X Display(mem);
X RelKey();
X}
X
Xvoid PREFIX() /* Display digits of number in x */
X{
X char *disp, buf[20];
X int dec, sign;
X
X NEUTRAL();
X
X if (X != 0.0) {
X disp = ecvt(X, 10, &dec, &sign); /* The ideal library function for this */
X buf[0] = ' '; strcpy(buf + 1, disp);
X Display(buf);
X }
X else Display(" 0000000000");
X
X RelKey();
X}
X
Xvoid RND()
X{
X double fx, tx;
X char buf[20];
X
X SaveX();
X
X switch (Mode) {
X case fix:
X fx = modf(X, &tx);
X X = tx + trunc(fx / minfix + 0.5) * minfix;
X break;
X case sci: case eng:
X sprintf(buf, "%0.*e", Digits, X);
X X = atof(buf);
X break;
X }
X}
X
Xvoid Sqrt()
X{
X if (X < 0.0) Error('0');
X else {
X SaveX(); X = sqrt(X);
X }
X}
X
Xvoid Exp() /* e^x */
X{
X SaveX(); X = exp(X);
X}
X
Xvoid Exp10() /* 10^x */
X{
X SaveX(); X = pow(10.0, X);
X}
X
Xvoid Invert() /* 1/x */
X{
X if (X == 0.0) Error('0');
X else {
X SaveX(); X = 1.0 / X;
X }
X}
X
Xvoid Divide()
X{
X if (X == 0.0) Error('0');
X else {
X Y = Y / X;
X Drop();
X }
X}
X
Xvoid SIN()
X{
X SaveX(); X = sin(from(X));
X}
X
Xvoid COS()
X{
X SaveX(); X = cos(from(X));
X}
X
Xvoid TAN()
X{
X SaveX(); X = tan(from(X));
X}
X
Xvoid Times()
X{
X Y = Y * X;
X Drop();
X}
X
Xvoid ENTER()
X{
X DISABLE();
X Enter();
X}
X
Xvoid Minus()
X{
X Y = Y - X;
X Drop();
X}
X
Xvoid SigmaPlus() /* Accumulate statistics */
X{
X R[0] += 1.0;
X R[1] = Check(R[1] + X);
X R[2] = Check(R[2] + X * X);
X R[3] = Check(R[3] + Y);
X R[4] = Check(R[4] + Y * Y);
X R[5] = Check(R[5] + X * Y);
X
X DISABLE();
X LisX(); X = R[0];
X}
X
Xvoid Plus()
X{
X Y = Y + X;
X Drop();
X}
X
Xvoid Pi()
X{
X Lift();
X X = PI;
X}
X
X
Xvoid ToRect()
X{
X SaveX();
X Rect(X, from(Y), &X, &Y);
X}
X
Xvoid ClearSigma() /* Clear statistics */
X{
X NEUTRAL(); /* Doesn't really matter, could be anything (but the HP11 doc says
X neutral so it will be neutral ... */
X X = Y = Z = T = R[0] = R[1] = R[2] = R[3] = R[4] = R[5] = 0.0;
X}
X
Xvoid Random() /* Random number generator. This isn't the same as the HP11 one, for I
X don't know what the HP11 uses. */
X{
X Lift();
X X = drand48();
X}
X
Xvoid DoPerm() /* P y,x */
X{
X if (X <= Y && X > 0.0) {
X Y = Perm((int)Y, (int)X);
X Drop();
X }
X else Error('0');
X}
X
Xvoid ToHMS()
X{
X SaveX(); X = hms(X);
X}
X
Xvoid ToRAD()
X{
X SaveX(); X = FDEG(X);
X}
X
Xvoid FRAC()
X{
X SaveX(); X = frac(X);
X}
X
Xvoid Fact() /* gamma/factorial function */
X{
X SaveX();
X if (X > MAXFACT) X = MAXHP11;
X else if (X >= 0 && X == trunc(X)) X = factorial((int)X);
X else X = gamma(1.0 + X);
X}
X
Xvoid Sqr()
X{
X SaveX(); X = X * X;
X}
X
Xvoid LN()
X{
X if (X <= 0.0) Error('0');
X else {
X SaveX(); X = log(X);
X }
X}
X
Xvoid LOG()
X{
X if (X <= 0.0) Error('0');
X else {
X SaveX(); X = log10(X);
X }
X}
X
Xvoid Percent()
X{
X /* doesn't drop stack */
X SaveX(); X = X * Y / 100.0;
X}
X
Xvoid DeltaPercent() /* Percentage of difference between x & y */
X{
X if (Y == 0.0) Error('0');
X else {
X SaveX(); X = 100.0 * (X - Y) / Y;
X }
X}
X
Xvoid ABS()
X{
X SaveX(); X = fabs(X);
X}
X
X
Xvoid DEG()
X{
X NEUTRAL();
X Angles = deg;
X}
X
Xvoid RAD()
X{
X NEUTRAL();
X Angles = rad;
X}
X
Xvoid GRAD()
X{
X NEUTRAL();
X Angles = grad;
X}
X
Xvoid ArcSIN()
X{
X if (fabs(X) > 1.0) Error('0');
X else {
X SaveX(); X = toa(asin(X));
X }
X}
X
Xvoid ArcCOS()
X{
X if (fabs(X) > 1.0) Error('0');
X else {
X SaveX(); X = toa(acos(X));
X }
X}
X
Xvoid ArcTAN()
X{
X SaveX(); X = toa(atan(X));
X}
X
Xvoid ToPolar()
X{
X SaveX();
X Polar(X, Y, &X, &Y);
X Y = toa(Y);
X}
X
Xvoid CLX()
X{
X X = 0.0;
X DISABLE();
X}
X
Xvoid LSTX()
X{
X Lift();
X X = L;
X}
X
Xvoid DoComb() /* C y,x */
X{
X if (X <= Y && X > 0.0) {
X Y = Comb((int)Y, (int)X);
X Drop();
X }
X else Error('0');
X}
X
Xvoid ToH()
X{
X SaveX(); X = hr(X);
X}
X
Xvoid ToDEG()
X{
X SaveX(); X = TDEG(X);
X}
X
Xvoid INT()
X{
X SaveX(); X = trunc(X);
X}
X
Xvoid Mean()
X{
X if (R[0] == 0.0) Error('2');
X else {
X Lift();
X Enter();
X
X X = R[1] / R[0];
X Y = R[3] / R[0];
X }
X}
X
Xvoid SigmaSub() /* Correct error in statistics accumulation */
X{
X R[0] -= 1.0;
X R[1] = Check(R[1] - X);
X R[2] = Check(R[2] - X * X);
X R[3] = Check(R[3] - Y);
X R[4] = Check(R[4] - Y * Y);
X R[5] = Check(R[5] - X * Y);
X
X DISABLE();
X LisX(); X = R[0];
X}
X
Xvoid HypSIN()
X{
X SaveX(); X = sinh(X);
X}
X
Xvoid HypCOS()
X{
X SaveX(); X = cosh(X);
X}
X
Xvoid HypTAN()
X{
X SaveX(); X = tanh(X);
X}
X
Xvoid ArcHypSIN()
X{
X SaveX(); X = asinh(X);
X}
X
Xvoid ArcHypCOS()
X{
X if (fabs(X) < 1.0) Error('0');
X else {
X SaveX(); X = acosh(X);
X }
X}
X
Xvoid ArcHypTAN()
X{
X if (fabs(X) > 1.0) Error('0');
X else {
X SaveX(); X = atanh(X);
X }
X}
X
Xvoid STORandom() /* Set random generator seed */
X{
X ENABLE();
X srand48((long)X);
X /* Use integer part of seed, something better could be used */
X}
X
Xvoid RCLSigma() /* Recall accumulated x & y totals */
X{
X Lift();
X Enter();
X
X X = R[1]; Y = R[3];
X}
X
Xvoid USER() /* Toggle user mode */
X{
X NEUTRAL();
X User = !User;
X}
X
Xvoid RunStart() /* Should be called RunStop ! */
X{
X NEUTRAL();
X if (running) running = FALSE; /* Stop */
X else { /* Run */
X if (lastIns != 0) { /* if a program to run */
X running = TRUE;
X if (PC == 0) PC = 1; /* skip first line */
X }
X
X DisplayLine(); /* Display first line */
X RelKey();
X }
X}
X
Xvoid XleY()
X{
X ENABLE();
X skip = (X > Y); /* skip if condition fails */
X}
X
Xvoid Xlt0()
X{
X ENABLE();
X skip = (X >= 0.0);
X}
X
Xvoid XgtY()
X{
X ENABLE();
X skip = (X <= Y);
X}
X
Xvoid Xgt0()
X{
X ENABLE();
X skip = (X <= 0.0);
X}
X
Xvoid XneY()
X{
X ENABLE();
X skip = (X == Y);
X}
X
Xvoid Xne0()
X{
X ENABLE();
X skip = (X == 0.0);
X}
X
Xvoid XeqY()
X{
X ENABLE();
X skip = (X != Y);
X}
X
Xvoid Xeq0()
X{
X ENABLE();
X skip = (X != 0.0);
X}
X
Xvoid SST() /* Single step a program */
X{
X if (lastIns == 0) { /* No program to single step through */
X DisplayLine();
X RelKey();
X }
X else {
X if (PC == 0) PC = 1; /* skip line 0 */
X
X DisplayLine();
X RelKey();
X
X running = TRUE; /* Pretend line is being run */
X ExecIns(Prog[PC]); /* Exec ins */
X if (!error && !overflow) { /* idem main loop */
X if (skip) PC++;
X PC++;
X while (PC > lastIns) {
X RTN();
X PC++;
X }
X }
X running = FALSE;
X
X }
X}
X
Xvoid BST() /* move back one line (but don't correct its effect) */
X{
X if (PC == 0) PC = lastIns;
X else PC--;
X
X DisplayLine();
X RelKey();
X}
X
X
SHAR_EOF
echo "extracting ins.h"
sed 's/^X//' << \SHAR_EOF > ins.h
X/* HP11 numeric limits */
X#define MAXHP11 9.999999999E99
X#define MINHP11 1E-99
X#define MAXFACT 69.95757445
X
X/* The different type of sto operations. The order must reflect the ordering of
X instruction codes in code.h */
Xenum StoTypes {sto, add, sub, mul, div};
X
Xextern BOOL enabled, entering, overflow; /* Various flags related to the instructions */
X
X/* Current entry value, used during number entry */
Xextern BOOL expo, decpt; /* expo true for an exponent present, decpt true for decimal point */
Xextern char strx[13], expx[4];
X
Xtypedef void (*HP11Function)(void);
X
Xextern HP11Function insfunc[];
X
X/* Function declarations */
X/* ===================== */
Xdouble Check(double); /* Check the argument for HP11 limits (1e-99 --> 1e100),
X return adjusted value if out of limits */
Xvoid DISABLE(void); /* Disable stack */
Xvoid ENABLE(void); /* Enable stack */
Xvoid Enter(void); /* Do an "Enter" */
X#define NEUTRAL() { entering = FALSE; } /* Neutral operation, simply end
X number entry */
X
X/* Instructions */
Xvoid FIX(int); /* set display mode to FIX n */
Xvoid SCI(int);
Xvoid ENG(int);
Xvoid STO(int, enum StoTypes); /* Sto in reg n (0 <= n <= 21, with 20 = I, 21 = (i)),
X with desired operation */
Xvoid RCL(int); /* RCl, n same as for sto */
Xvoid EnterNum(int); /* Add keycode to current number */
Xvoid GTO(int); /* Goto label n (n = 0 to 9, A to E (10 to 14) or I (15) : indirection */
Xvoid SF(int), CF(int), Set(int);
Xvoid GSB(int); /* Call subprogram n (cf GTO) */
Xvoid GTOLine(int); /* Jump to line in prog */
X
X#ifdef ABS
X#undef ABS
X#endif
X
Xvoid Sqrt(void), Exp(void), Exp10(void), ExpYX(void), Invert(void),
X Divide(void), SIN(void), COS(void), TAN(void), Times(void), Rdn(void),
X ExgXY(void), ENTER(void), Minus(void), SigmaPlus(void), Plus(void),
X Pi(void), ToRect(void), ClearSigma(void), ClearReg(void), Random(void),
X DoPerm(void), ToHMS(void), ToRAD(void), FRAC(void), Fact(void),
X Estimate(void), LinearRegression(void), Sqr(void), LN(void), LOG(void),
X Percent(void), DeltaPercent(void), ABS(void), DEG(void), RAD(void),
X GRAD(void), ArcSIN(void), ArcCOS(void), ArcTAN(void), ToPolar(void),
X Rup(void), CLX(void), LSTX(void), DoComb(void), ToH(void), ToDEG(void),
X INT(void), Mean(void), SDev(void), SigmaSub(void), HypSIN(void),
X HypCOS(void), HypTAN(void), ArcHypSIN(void), ArcHypCOS(void),
X ArcHypTAN(void), ExgXI(void), STORandom(void), RCLSigma(void), USER(void),
X ProgarmEntry(void), RunStart(void), XleY(void), Xlt0(void),
X DSE(void), ISG(void), XgtY(void), Xgt0(void), PSE(void), XneY(void),
X Xne0(void), XeqY(void), Xeq0(void), RTN(void), SST(void), BST(void),
X HP11ColdReset(void), MEM(void), PREFIX(void), RND(void), DoCHS(void),
X DoPoint(void), DoEEX(void), ExgXInd(void), ProgramEntry(void);
X
SHAR_EOF
echo "extracting io.c"
sed 's/^X//' << \SHAR_EOF > io.c
X#include "exec/types.h"
X
X#include "stdlib.h"
X#include "stdio.h"
X#include <math.h>
X#include "string.h"
X
X#include "hp11/hp11.h"
X#include "hp11/amiga/amiga.h"
X#include "hp11/ins.h"
X#include "hp11/io.h"
X#include "hp11/kbd.h"
X#include "hp11/codes.h"
X#include "hp11/prog_codes.h"
X
X#define MAXRUN 4 /* Length of time running is displayed */
X
X#define FOREVER for (;;)
X
Xint comma;
X
Xstatic char *stpich(char *p, int c) /* insert character c at front of string p */
X{
X movmem(p, p + 1, strlen(p) + 1);
X *p = c;
X
X return(p);
X}
X
Xint GetKey() /* Read a key & wait for its release */
X{
X int key;
X
X key = PollKey(TRUE);
X RelKey();
X
X return(key);
X}
X
Xenum KeyTypes ReadKey(code) /* Read a complete key sequence, & return
X its type, intrsuction or action. */
Xregister WORD *code;
X{
X register struct Key *curtkey;
X register int key, offset;
X register BOOL noKey; /* if an invalid sequence is returned, don't read a new key,
X reuse the one which caused the error. This is set to false when that happens */
X register enum KeyTypes ret;
X
X noKey = TRUE; /* no key read */
X
X FOREVER {
X offset = 0; /* f or g not pressed */
X
X FOREVER { /* This loop reads a key from the main, f or g shifted keyboards.
X Further refinements (eg sto) are done algorithmically, to save space */
X if (noKey) key = PollKey(TRUE); /* obtain next key */
X Dispf(FALSE); Dispg(FALSE);
X noKey = TRUE;
X if (key == 31) { /* f pressed, toggle its status */
X offset = (offset == NUMKEYS) ? 0 : (Dispf(TRUE), NUMKEYS);
X RelKey();
X }
X else if (key == 32) { /* g */
X offset = (offset == NUMKEYS + NUMKEYS) ? 0 : (Dispg(TRUE), NUMKEYS + NUMKEYS);
X RelKey();
X }
X else break;/* got a key, exit from loop */
X }
X if (User && key < 5) offset ^= NUMKEYS; /* Toggle f for first five keys. This
X doesn't affect g because the bit patterns are exclusive (42 & 84 = 0) */
X
X Dispf(FALSE); Dispg(FALSE);
X
X curtkey = mainKbd + offset + key; /* find address of (eventually shifted) key */
X
X switch (curtkey->Sort) {
X case Action:
X *code = curtkey->Act;
X return(Action);
X case Instruction:
X *code = curtkey->Code;
X return(Instruction);
X case Prefix: /* Key is a prefix, execute corresponding routine */
X RelKey();
X ret = (*(curtkey->Suffix))(code);
X if (ret != Invalid) return(ret); /* if successful */
X
X key = *code; /* else, invalid keycode returnedin code field for reuse */
X noKey = FALSE; /* a key is already available */
X break;
X case Invalid: /* An inavlid f or g sequence was entered, retry it with
X the f or g prefix stripped. Therefore all obtainable main keyboard sequences
X must exist, otherwise the program enters an infinite loop retrying constantly
X the same nonexistent keycode */
X key %= NUMKEYS;
X noKey = FALSE;
X break;
X }
X }
X}
X
X/* Return position n on the liquid cristal display in string t */
Xint scrpos(t, n)
Xchar *t;
Xregister int n;
X{
X register char *s = t;
X register int pos;
X
X pos = 0;
X while (pos <= n && *s) { /* go on till end of string or beyond position n on display */
X if (*s != '.' && *s != ',') pos++; /* . & , take no space on the display */
X s++;
X }
X return((int)((s - t) - 1 - (pos - n))); /* pos - n is there to take care of the overshoot. If
X n is beyond the end of the string, the position returned may well be wildly beyond the
X actual end of the string */
X}
X
X/* Return the length taken up on the screen by the string */
Xint scrlen(s)
Xregister char *s;
X{
X register int cnt = 0;
X
X while (*s) {
X if (*s != '.' && *s != ',') cnt++; /* . & , take no space on the display */
X s++;
X }
X
X return(cnt);
X}
X
X/* format string s in hp11 display format (without exponent) so that it takes
X n spaces in the display. s isn't modified */
Xstatic char *CvtStd(char *s, int n)
X{
X static char buf[20];
X register char *p;
X register int i, nb;
X register int digit_separator = comma ? '.' : ','; /* separator according to current setting */
X
X strcpy(buf, s); /* copy string to safe work buffer */
X
X if ((p = strchr(buf, '.')) == NULL) { /* find position of . */
X p = buf + strlen(buf);
X if (!entering) *p = comma ? ',' : '.';
X *(p + 1) = '\0';
X }
X else if (comma) *p = ','; /* Replace . by , if necessary */
X
X while ((p -= 3) - buf > 1) /* Add , (or .) to string every 3 digits */
X stpich(p, digit_separator);
X
X nb = n - scrlen(buf);
X for (i = 1; i <= nb; i++) strcat(buf, " "); /* pad with spaces to required screen length */
X buf[scrpos(buf, n) + 1] = '\0'; /* cut at n characters */
X
X return(buf);
X}
X
X/* format string s in hp11 display format (with exponent) */
Xstatic char *CvtExpo(char *s, char *e)
X{
X if (strlen(e) > 3) { /* deal with roundoff towards 1e100 when nb too big */
X e = " 99"; /* exponent is 99 */
X strncpy(s + 1, "9.999999999", strlen(s + 1)); /* mantissa is enough 9's */
X }
X
X return(strcat(CvtStd(s, 8), e));
X}
X
X/* convert x to scientific format with n digits. Returns it in a static buffer (from CvtStd) */
Xstatic char *Scient(double x, int n)
X{
X char buf[20];
X register char *pe;
X
X sprintf(buf, "% .*E", n, x); /* Scientific format with n digits */
X pe = strchr(buf, 'E'); /* split string into mantissa & exponent */
X *pe++ = '\0';
X /* if (*pe == '+') *pe = ' '; A + is displayed as a space by the Display routine anyway */
X
X return(CvtExpo(buf, pe));
X}
X
X/* Convert x to fix n format */
Xstatic char *Fixed(double x, int n)
X{
X char buf[80];
X
X sprintf(buf, "% .*f", n, x);
X
X return(CvtStd(buf, 11));
X}
X
X/* Eng n format */
Xstatic char *Engin(double x, int n)
X{
X char expbuf[10], buf[80];
X register char *pe;
X double mantissa;
X register int exponent, dif;
X
X sprintf(buf, "%.*E", n, x); /* print enough digits */
X *(pe = strchr(buf, 'E')) = '\0';
X mantissa = atof(buf); /* get mantissa & exponent */
X exponent = atoi(pe + 1);
X
X /* Round exponent down to a multiple of 3 */
X dif = exponent % 3;
X if (dif < 0) dif += 3;
X exponent -= dif; /* calculate new exponent & mantissa */
X mantissa *= pow(10.0, (double)dif);
X
X /* Convert them to string */
X sprintf(buf, "% .*f", (n - dif > 0) ? n - dif : 0, mantissa);
X sprintf(expbuf, "%c%02d", (exponent < 0) ? '-' : ' ', iabs(exponent)); /* pad exponent with 0's, hence %02d not %2d */
X
X return(CvtExpo(buf, expbuf));
X}
X
X/* Display current trig mode */
Xstatic void DispAngle(void)
X{
X switch (Angles) {
X case grad:DispG(TRUE);
X case rad:DispRAD(TRUE);
X case deg:break;
X }
X}
X
X/* Display current x value in normal mode, running in run mode */
Xvoid Disp()
X{
X static int runcnt = MAXRUN;
X static BOOL runon;
X
X if (running) { /* Flash running on and off every MAXRUN calls */
X if (fast) { /* Display Running only once in fast mode */
X if (!runon) {
X Display(" Running");
X runon = TRUE; /* Running displayed */
X }
X }
X else if (runcnt-- == 0) Display("");
X else if (runcnt <= -MAXRUN) {
X runcnt = MAXRUN;
X Display(" Running");
X }
X }
X else {
X runon = FALSE; /* Running not displayed */
X if (entering) /* Display number entry strings */
X if (expo) Display(CvtExpo(strx, expx)); /* with exponent */
X else Display(CvtStd(strx, 11));
X else
X Display(NbStr(X));
X
X DispAngle();
X if (User) DispUSER(TRUE);
X }
X}
X
Xchar *NbStr(x)
Xdouble x;
X{
X switch (Mode) { /* Display x according to display mode */
X case fix:if ((fabs(X) >= minfix / 2.0 || X == 0.0) && fabs(X) < 1E10) {
X /* Number can be displayed in fix mode */
X return(Fixed(X, Digits));
X }
X /* fall through for call to Scient */
X case sci:return(Scient(X, Digits));
X case eng:return(Engin(X, Digits));
X }
X}
X
X/* Display Error n, & wait for a key to be pressed */
Xvoid Error(n)
Xint n;
X{
X register char *buf;
X
X entering = FALSE; /* end of digit entry */
X error = TRUE; /* an error has occured */
X buf = " Error ";
X buf[8] = n; buf[9] ='\0';
X
X if (!running) RelKey();
X Display(buf);
X GetKey();
X
X}
X
X/* Display current program line */
Xvoid DisplayLine()
X{
X register int c1 = keycodes[Prog[PC]].c1, c2 = keycodes[Prog[PC]].c2,
X c3 = keycodes[Prog[PC]].c3;
X char _buf[20], _insbuf[20];
X register char *buf = _buf, *insbuf = _insbuf;
X register int point = comma ? ',' : '.'; /* separator according to current setting */
X
X sprintf(buf, " %03d-", PC); /* prepare program line */
X
X /* Prepare instruction buffer */
X if (PC == 0) insbuf[0] = '\0'; /* nothing at line 0 */
X else switch (keycodes[Prog[PC]].Type) { /* there are 6 methods for displaying a line */
X case ONECODE: sprintf(insbuf, "%6d", c1); break; /* nn eg SIN or 9 */
X case TWOCODE: sprintf(insbuf, "%3d%3d", c1, c2); break; /* nn nn eg g LOG */
X case TWOCODE_9: sprintf(insbuf, "%4d%2d", c1, c2); break; /* nn n eg STO 5*/
X case TWOCODE_PT: sprintf(insbuf, "%4d %c%1d", c1, point, c2); break; /* nn .n eg RCL .6 */
X case THREECODE: sprintf(insbuf, "%2d,%2d,%2d", c1, c2, c3); break; /* nn,nn,nn eg f HYP SIN */
X case THREECODE_PT: sprintf(insbuf, "%2d,%2d, %c%1d", c1, c2, point, c3); break; /* nn,nn, .n eg STO + .0 */
X }
X
X Display(strcat(buf, insbuf));
X
X DispAngle();
X if (User) DispUSER(TRUE);
X}
X
SHAR_EOF
echo "extracting io.h"
sed 's/^X//' << \SHAR_EOF > io.h
Xextern int comma; /* The current comma setting : true if decimal point is a comma,
X false if it is a point */
X
Xenum KeyTypes ReadKey(WORD *); /* Read a complete key sequence */
Xvoid Disp(void); /* Display the current value of X register */
Xvoid Error(int); /* Display Error n */
Xint GetKey(void); /* Read a key from the HP11 (waiting for its release) */
Xint scrpos(char *, int); /* Return position n on the liquid cristal display in string t */
Xint scrlen(char *); /* Return the length taken up on the screen by the string */
Xvoid DisplayLine(void); /* Display current program line */
Xchar *NbStr(double); /* Convert number into string according to current mode */
SHAR_EOF
echo "extracting kbd.c"
sed 's/^X//' << \SHAR_EOF > kbd.c
X#include "exec/types.h"
X#include "hp11/hp11.h"
X#include "hp11/kbd.h"
X#include "hp11/codes.h"
X#include "hp11/io.h"
X
X/* Macros to initialise one field of the keyboard structure to a particular type.
X This simpilfies (& clarifies) this initialisation. */
X#define CODE(code) {Instruction, (Decoder)(code) }
X#define ACT(act) {Action, (Decoder)(act) }
X#define PREFIX(adr) {Prefix, (adr) }
X#define INVALID() {Invalid, NULL }
X
X/* Often used macros which return their agument signaling that it is an instruction,
X action or error */
X#define RETINS(val) { *code = (val); return(Instruction); }
X#define RETACT(val) { *code = (val); return(Action); }
X#define RETERR(key) { *code = (key); return(Invalid); }
X
X/* Keys which can follow GTO (or GSB). A -1 indicates am invalid sequence, otherwise
X the value is the offset to add to KGTO to obtain the corresponding instruction.
X IGTO_LINE is different and valid only for GTO, it indicates a GTO .nnn action */
Xstatic BYTE gto_decode[NUMKEYS] = {
X 10, 11, 12, 13, 14, -1, 7, 8, 9, -1,
X -1, -1, -1, -1, OIND_G, -1, 4, 5, 6, -1,
X -1, -1, -1, -1, -1, -1, 1, 2, 3, -1,
X -1, -1, -1, -1, -1, -1, 0, IGTO_LINE, -1, -1,
X -1, -1
X};
X
X/* For STO & RCL, cf above */
Xstatic BYTE sto_decode[NUMKEYS] = {
X -1, -1, -1, -1, -1, -1, 7, 8, 9, ODIV,
X -1, -1, -1, OIND_R, OI, -1, 4, 5, 6, OMUL,
X -1, -1, -1, -1, -1, KRANDOM, 1, 2, 3, OSUB,
X -1, -1, -1, -1, -1, -1, 0, KPOINT, KSIGMA_PLUS, OPLUS,
X -1, -1
X};
X
X/* Functions which take a numeric argument only (eg eng) can use the numbers
X from gto_decode, considering as invalid what isn't a number between 1 & 10 */
X#define nb_decode gto_decode
X
X/* Read 3 digits for GTO .nnn & return the value in line. If something other than
X a number is entered, return the keycode of the first incorrect code & FALSE */
Xstatic BOOL GetLine(short *line)
X{
X register int cnt = 0, key;
X register int dec;
X
X *line = 0;
X
X do {
X key = GetKey(); dec = nb_decode[key]; /* Get numeric value */
X if (dec >= 0 && dec <= 9) { /* It is a digit */
X cnt++;
X *line = *line * 10 + dec;
X }
X else { /* error */
X *line = key;
X return(FALSE);
X }
X } while (cnt < 3);
X
X /* 3 digits reads */
X return(TRUE);
X}
X
X/* Decoder routine for FIX, SCI, ENG, SF, CF, Set. code returns the
X instruction/action/keycode, start is the offset for the instruction being
X decoded (eg KFIX), max is the maximum value which can be accepted (eg 1 for SF).
X For SCI & ENG, a number beyond their max (7) is treated as if it was the max
X value (So if you type 'f SCI 8' you will get 'f SCI 7' */
Xstatic enum KeyTypes NBDec(short *code, int start, int max)
X{
X register int key, dec;
X
X key = GetKey(); dec = nb_decode[key];
X
X if (dec >= 0 && dec <= 9) { /* Is a digit */
X if (dec <= max) RETINS(start + dec) /* valid ins */
X else if (start == KSCI || start == KENG) RETINS(start + max)
X /* Special treatment for SCI & ENG */
X }
X RETERR(key);
X}
X
X/* Decoding for HYP & ArcHYP */
Xstatic enum KeyTypes HypDec(short *code, int start)
X{
X int key;
X
X key = GetKey();
X if (key >= 12 /* SIN */ && key <= 14 /* TAN */) RETINS(start + key - 12)
X else RETERR(key);
X}
X
X/* Decoding for GTO, GSB & LBL */
Xstatic enum KeyTypes JMPDec(short *code, int start)
X{
X register int key, dec;
X short val;
X
X key = GetKey(); dec = gto_decode[key];
X
X if (dec >= 0 && dec <= 15) RETINS(start + dec); /* 0 to 9, A to E */
X switch (dec) {
X case IGTO_LINE: if (start == KGTO) /* GTO .nnn */
X if (GetLine(&val)) RETACT(IGTO_LINE + val)
X else RETERR(val);
X case OIND_G: if (start != KLBL) RETINS(start + OIND_G); /* GTO/GSB I */
X }
X RETERR(key);
X}
X
X/* Decoding for STO & RCL, deals with all possible STO's */
Xstatic enum KeyTypes REGDec(short *code, int start)
X{
X register int dec, key, oldoff, offset = 0;
X
X do {
X key = GetKey();
X dec = sto_decode[key];
X oldoff = offset;
X
X if ((dec >= 0 && dec <= 9) /* 0 to 9 end an instruction */
X || /* I & (i) end an instruction if no . was typed before. This
X is visible if the offset (ignoring + - * /) is 10 */
X ((offset % OPLUS) != 10 && (dec == OI || dec == OIND_R)))
X RETINS(start + offset + dec);
X switch (dec) { /* Special cases & offsets */
X case KRANDOM: if (offset == 0 && start == KSTO) RETINS(KSTO_RANDOM); /* STO Random */
X case KSIGMA_PLUS: if (offset == 0 && start == KRCL) RETINS(KRCL_SIGMA); /* Recall stats */
X case KPOINT: if ((offset % OPLUS) == 0) offset += 10; /* Only one . allowed */
X case OPLUS: case ODIV: case OMUL: case OSUB: /* + - * / only if none yet */
X if (offset == 0 && start == KSTO) offset = dec;
X }
X } while (offset != oldoff);
X /* if offset not changed then there was an error (the loop is repeated when
X the offset changes) */
X RETERR(key);
X}
X
X/* Decoding for prefixes */
X/* --------------------- */
Xstatic enum KeyTypes FIXDec(short *code)
X{
X return(NBDec(code, KFIX, 9));
X}
X
Xstatic enum KeyTypes SCIDec(short *code)
X{
X return(NBDec(code, KSCI, 7));
X}
X
Xstatic enum KeyTypes ENGDec(short *code)
X{
X return(NBDec(code, KENG, 7));
X}
X
Xstatic enum KeyTypes SFDec(short *code)
X{
X return(NBDec(code, KFLAGS + OSF, 1));
X}
X
Xstatic enum KeyTypes SETDec(short *code)
X{
X return(NBDec(code, KFLAGS + OSET, 1));
X}
X
Xstatic enum KeyTypes CFDec(short *code)
X{
X return(NBDec(code, KFLAGS + OCF, 1));
X}
X
Xstatic enum KeyTypes HYPDec(short *code)
X{
X return(HypDec(code, KHYP));
X}
X
Xstatic enum KeyTypes ARCHYPDec(short *code)
X{
X return(HypDec(code, KARCHYP));
X}
X
Xstatic enum KeyTypes LBLDec(short *code)
X{
X return(JMPDec(code, KLBL));
X}
X
Xstatic enum KeyTypes GTODec(short *code)
X{
X return(JMPDec(code, KGTO));
X}
X
Xstatic enum KeyTypes GSBDec(short *code)
X{
X return(JMPDec(code, KGSB));
X}
X
Xstatic enum KeyTypes STODec(short *code)
X{
X return(REGDec(code, KSTO));
X}
X
Xstatic enum KeyTypes RCLDec(short *code)
X{
X return(REGDec(code, KRCL));
X}
X
X/* The main kbd, f & g */
X/* ------------------- */
Xstruct Key mainKbd[3 * NUMKEYS] = {
X/* First the main keyboard (unshifted). All the keys which can be entered
X MUST not be INVALID(), otherwise the program enters an infinite loop */
X CODE(KSQRT),
X CODE(KEXP),
X CODE(KEXP10),
X CODE(KEXP_YX),
X CODE(KINV),
X CODE(KCHS),
X CODE(KFIG + 7),
X CODE(KFIG + 8),
X CODE(KFIG + 9),
X CODE(KDIV),
X ACT(ISST),
X PREFIX(GTODec),
X CODE(KTRIG + OSIN),
X CODE(KTRIG + OCOS),
X CODE(KTRIG + OTAN),
X CODE(KEEX),
X CODE(KFIG + 4),
X CODE(KFIG + 5),
X CODE(KFIG + 6),
X CODE(KMUL),
X CODE(KR_S),
X PREFIX(GSBDec),
X CODE(KRDN),
X CODE(KEXG_XY),
X ACT(IBACK),
X CODE(KENTER),
X CODE(KFIG + 1),
X CODE(KFIG + 2),
X CODE(KFIG + 3),
X CODE(KSUB),
X ACT(ION),
X INVALID(), /* Never tested : f */
X INVALID(), /* Never tested : g */
X PREFIX(STODec),
X PREFIX(RCLDec),
X INVALID(), /* This key does not exist : it is hidden by ENTER */
X CODE(KFIG + 0),
X CODE(KPOINT),
X CODE(KSIGMA_PLUS),
X CODE(KPLUS),
X ACT(IRESET), /* These 2 are pseudo-keys */
X ACT(IDISPLAY),
X/* now f codes, which can be INVALID() */
X CODE(KGSB + OA),
X CODE(KGSB + OB),
X CODE(KGSB + OC),
X CODE(KGSB + OD),
X CODE(KGSB + OE),
X CODE(KPI),
X PREFIX(FIXDec),
X PREFIX(SCIDec),
X PREFIX(ENGDec),
X CODE(KX_LE_Y),
X PREFIX(LBLDec),
X PREFIX(HYPDec),
X CODE(KEXG_X_IND),
X CODE(KRCL + OIND_R),
X CODE(KRCL + OI),
X CODE(KRECT),
X CODE(KEXG_XI),
X CODE(KDSE),
X CODE(KISG),
X CODE(KX_GT_Y),
X CODE(KPSE),
X CODE(KCLR_SIGMA),
X ACT(ICLR_PRGM),
X CODE(KCLR_REG),
X ACT(ICLR_PREFIX),
X CODE(KRANDOM),
X CODE(KPERM),
X CODE(KHMS),
X CODE(KTO_RAD),
X CODE(KX_NE_Y),
X INVALID(), INVALID(), INVALID(), /* ON, f & g */
X CODE(KFRAC),
X ACT(IUSER),
X INVALID(), /* dosen't exist */
X CODE(KFACT),
X CODE(KESTIMATE),
X CODE(KLR),
X CODE(KX_EQ_Y),
X INVALID(), INVALID(),
X/* finally, g codes */
X CODE(KSQR),
X CODE(KLN),
X CODE(KLOG),
X CODE(KPERC),
X CODE(KDELTA_PERC),
X CODE(KABS),
X CODE(KDEG),
X CODE(KRAD),
X CODE(KGRD),
X CODE(KX_LT_0),
X ACT(IBST),
X PREFIX(ARCHYPDec),
X CODE(KARC + OSIN),
X CODE(KARC + OCOS),
X CODE(KARC + OTAN),
X CODE(KPOLAR),
X PREFIX(SFDec),
X PREFIX(CFDec),
X PREFIX(SETDec),
X CODE(KX_GT_0),
X ACT(IP_R),
X CODE(KRTN),
X CODE(KRUP),
X CODE(KRND),
X CODE(KCLX),
X CODE(KLSTX),
X CODE(KCOMB),
X CODE(KHR),
X CODE(KTO_DEG),
X CODE(KX_NE_0),
X INVALID(), INVALID(), INVALID(),
X CODE(KINT),
X ACT(IMEM),
X INVALID(),
X CODE(KMEAN),
X CODE(KSDEV),
X CODE(KSIGMA_SUB),
X CODE(KX_EQ_0),
X INVALID(), INVALID()
X};
X
SHAR_EOF
echo "extracting kbd.h"
sed 's/^X//' << \SHAR_EOF > kbd.h
X/* Define type Decoder which is a function with a short * argument and which
X return an enum KeyTypes. These functions do the keyboard decoding for prefixes */
Xtypedef enum KeyTypes (*Decoder)(short *);
X
X/* One key of the keyboard structure : */
Xstruct Key {
X enum KeyTypes Sort; /* The type of key */
X union { /* Different data for each type */
X Decoder suffix; /* Prefix ==> decoder function */
X LONG act; /* Action number */
X LONG code; /* Instruction number */
X } Data;
X};
X
X/* These defines are done to simplify access to the components */
X#define Act Data.act
X#define Code Data.code
X#define Suffix Data.suffix
X
Xextern struct Key mainKbd[3 * NUMKEYS]; /* The main, f & g key sequences */
SHAR_EOF
echo "extracting lmkdebug"
sed 's/^X//' << \SHAR_EOF > lmkdebug
XFLAGS = -v -cf -rr -ilcc: -d5
XFLAGS2 = -Hinclude:small.sym $(FLAGS)
XOBJ = od/
X
X.c.o:
X lc $(FLAGS) -o$(OBJ) $*
X
Xhp11: $(OBJ)hp11.o $(OBJ)io.o $(OBJ)ins.o $(OBJ)kbd.o $(OBJ)prog_codes.o \
X $(OBJ)support.o $(OBJ)indic.o $(OBJ)chip.o $(OBJ)menus.o $(OBJ)icon.o \
X $(OBJ)amiga.o $(OBJ)chars.o
X blink with hp11.debug
X
X$(OBJ)hp11.o: hp11.c hp11.h amiga/amiga.h io.h support.h ins.h codes.h
X
X$(OBJ)io.o: io.c hp11.h amiga/amiga.h ins.h io.h kbd.h codes.h prog_codes.h
X
X$(OBJ)ins.o: ins.c amiga/amiga.h hp11.h io.h support.h ins.h codes.h
X
X$(OBJ)kbd.o: kbd.c hp11.h kbd.h codes.h io.h
X
X$(OBJ)prog_codes.o: prog_codes.c prog_codes.h
X
X$(OBJ)support.o: support.c support.h
X
X$(OBJ)chars.o: amiga/chars.c
X lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)indic.o: amiga/indic.c
X lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)chip.o: amiga/chip.c
X lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)menus.o: amiga/menus.c hp11.h io.h ins.h amiga/menus.h amiga/internal.h amiga/cbio.h
X lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)icon.o: amiga/icon.c
X# Should be same as other amiga routines, but there is a bug ...
X
X$(OBJ)amiga.o: amiga/amiga.c hp11.h amiga/internal.h amiga/amiga.h amiga/menus.h
X lc $(FLAGS2) -o$(OBJ) $*
X
SHAR_EOF
echo "extracting lmkfile"
sed 's/^X//' << \SHAR_EOF > lmkfile
XFLAGS = -v -cf -m1s -O -ilcc: -rr
XFLAGS2 = $(FLAGS)
XOBJ = o/
X
X.c.o:
X lc $(FLAGS) -o$(OBJ) $*
X
Xhp11: $(OBJ)hp11.o $(OBJ)io.o $(OBJ)ins.o $(OBJ)kbd.o $(OBJ)prog_codes.o \
X $(OBJ)support.o $(OBJ)indic.o $(OBJ)chip.o $(OBJ)menus.o $(OBJ)icon.o \
X $(OBJ)amiga.o $(OBJ)chars.o
X blink with hp11.lnk
X
X$(OBJ)hp11.o: hp11.c hp11.h amiga/amiga.h io.h support.h ins.h codes.h
X
X$(OBJ)io.o: io.c hp11.h amiga/amiga.h ins.h io.h kbd.h codes.h prog_codes.h
X
X$(OBJ)ins.o: ins.c amiga/amiga.h hp11.h io.h support.h ins.h codes.h
X
X$(OBJ)kbd.o: kbd.c hp11.h kbd.h codes.h io.h
X
X$(OBJ)prog_codes.o: prog_codes.c prog_codes.h
X
X$(OBJ)support.o: support.c support.h
X
X$(OBJ)chars.o: amiga/chars.c
X lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)indic.o: amiga/indic.c
X lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)chip.o: amiga/chip.c
X lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)menus.o: amiga/menus.c hp11.h io.h ins.h amiga/menus.h amiga/internal.h amiga/cbio.h
X lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)icon.o: amiga/icon.c
X# Should be same as other amiga routines, but there is a bug ...
X
X$(OBJ)amiga.o: amiga/amiga.c hp11.h amiga/internal.h amiga/amiga.h amiga/menus.h
X lc $(FLAGS2) -o$(OBJ) $*
X
SHAR_EOF
if `test ! -d o`
then
mkdir o
echo "mkdir o"
fi
echo "extracting o/dummy"
sed 's/^X//' << \SHAR_EOF > o/dummy
SHAR_EOF
if `test ! -d od`
then
mkdir od
echo "mkdir od"
fi
echo "extracting od/dummy"
sed 's/^X//' << \SHAR_EOF > od/dummy
SHAR_EOF
echo "extracting prog_codes.c"
sed 's/^X//' << \SHAR_EOF > prog_codes.c
X/* The actual codes used */
X#include "exec/types.h"
X
X#include "hp11/prog_codes.h"
X
X/* To decode an instruction, you use its code (from codes.h). Therefore,
X if these are changed, you must change these keycodes as well */
Xstruct KeyCode keycodes[] = {
X {ONECODE, 11},
X {ONECODE, 12},
X {ONECODE, 13},
X {ONECODE, 14},
X {ONECODE, 15},
X {ONECODE, 16},
X {ONECODE, 10},
X {ONECODE, 23},
X {ONECODE, 24},
X {ONECODE, 25},
X {ONECODE, 26},
X {ONECODE, 20},
X {ONECODE, 31},
X {ONECODE, 33},
X {ONECODE, 34},
X {ONECODE, 36},
X {ONECODE, 30},
X {ONECODE, 48},
X {ONECODE, 49},
X {ONECODE, 40},
X/* f codes */
X {TWOCODE, 42, 16},
X {TWOCODE, 42, 10},
X {TWOCODE, 42, 23},
X {TWOCODE, 42, 26},
X {TWOCODE_9, 42, 4},
X {TWOCODE_9, 42, 5},
X {TWOCODE_9, 42, 6},
X {TWOCODE, 42, 20},
X {TWOCODE, 42, 31},
X {TWOCODE, 42, 32},
X {TWOCODE, 42, 34},
X {TWOCODE, 42, 36},
X {TWOCODE_9, 42, 1},
X {TWOCODE_9, 42, 2},
X {TWOCODE_9, 42, 3},
X {TWOCODE, 42, 30},
X {TWOCODE, 42, 44},
X {TWOCODE_9, 42,0},
X {TWOCODE, 42, 48},
X {TWOCODE, 42, 49},
X {TWOCODE, 42, 40},
X/* g codes */
X {TWOCODE, 43, 11},
X {TWOCODE, 43, 12},
X {TWOCODE, 43, 13},
X {TWOCODE, 43, 14},
X {TWOCODE, 43, 15},
X {TWOCODE, 43, 16},
X {TWOCODE_9, 43, 7},
X {TWOCODE_9, 43, 8},
X {TWOCODE_9, 43, 9},
X {TWOCODE, 43, 10},
X {TWOCODE, 43, 23},
X {TWOCODE, 43, 24},
X {TWOCODE, 43, 25},
X {TWOCODE, 43, 26},
X {TWOCODE, 43, 20},
X {TWOCODE, 43, 32},
X {TWOCODE, 43, 33},
X {TWOCODE, 43, 34},
X {TWOCODE, 43, 35},
X {TWOCODE, 43, 36},
X {TWOCODE_9, 43, 1},
X {TWOCODE_9, 43, 2},
X {TWOCODE_9, 43, 3},
X {TWOCODE, 43, 30},
X {TWOCODE, 43, 44},
X {TWOCODE_9, 43, 0},
X {TWOCODE, 43, 48},
X {TWOCODE, 43, 49},
X {TWOCODE, 43, 40},
X/* Miscellaneous */
X {TWOCODE, 45, 36},
X {TWOCODE, 45, 49},
X/* ARC */
X {THREECODE, 42, 22, 23},
X {THREECODE, 42, 22, 24},
X {THREECODE, 42, 22, 25},
X {THREECODE, 43, 22, 23},
X {THREECODE, 43, 22, 24},
X {THREECODE, 43, 22, 25},
X/* Flags */
X {THREECODE, 43, 4, 0},
X {THREECODE, 43, 4, 1},
X {THREECODE, 43, 5, 0},
X {THREECODE, 43, 5, 1},
X {THREECODE, 43, 6, 0},
X {THREECODE, 43, 6, 1},
X/* Figures */
X {ONECODE, 0},
X {ONECODE, 1},
X {ONECODE, 2},
X {ONECODE, 3},
X {ONECODE, 4},
X {ONECODE, 5},
X {ONECODE, 6},
X {ONECODE, 7},
X {ONECODE, 8},
X {ONECODE, 9},
X/* FIX, SCI, ENG */
X {THREECODE, 42, 7, 0},
X {THREECODE, 42, 7, 1},
X {THREECODE, 42, 7, 2},
X {THREECODE, 42, 7, 3},
X {THREECODE, 42, 7, 4},
X {THREECODE, 42, 7, 5},
X {THREECODE, 42, 7, 6},
X {THREECODE, 42, 7, 7},
X {THREECODE, 42, 7, 8},
X {THREECODE, 42, 7, 9},
X
X {THREECODE, 42, 8, 0},
X {THREECODE, 42, 8, 1},
X {THREECODE, 42, 8, 2},
X {THREECODE, 42, 8, 3},
X {THREECODE, 42, 8, 4},
X {THREECODE, 42, 8, 5},
X {THREECODE, 42, 8, 6},
X {THREECODE, 42, 8, 7},
X
X {THREECODE, 42, 9, 0},
X {THREECODE, 42, 9, 1},
X {THREECODE, 42, 9, 2},
X {THREECODE, 42, 9, 3},
X {THREECODE, 42, 9, 4},
X {THREECODE, 42, 9, 5},
X {THREECODE, 42, 9, 6},
X {THREECODE, 42, 9, 7},
X/* LBL, GTO, GSB */
X {THREECODE, 42, 21, 0},
X {THREECODE, 42, 21, 1},
X {THREECODE, 42, 21, 2},
X {THREECODE, 42, 21, 3},
X {THREECODE, 42, 21, 4},
X {THREECODE, 42, 21, 5},
X {THREECODE, 42, 21, 6},
X {THREECODE, 42, 21, 7},
X {THREECODE, 42, 21, 8},
X {THREECODE, 42, 21, 9},
X {THREECODE, 42, 21, 11},
X {THREECODE, 42, 21, 12},
X {THREECODE, 42, 21, 13},
X {THREECODE, 42, 21, 14},
X {THREECODE, 42, 21, 15},
X
X {TWOCODE_9, 22, 0},
X {TWOCODE_9, 22, 1},
X {TWOCODE_9, 22, 2},
X {TWOCODE_9, 22, 3},
X {TWOCODE_9, 22, 4},
X {TWOCODE_9, 22, 5},
X {TWOCODE_9, 22, 6},
X {TWOCODE_9, 22, 7},
X {TWOCODE_9, 22, 8},
X {TWOCODE_9, 22, 9},
X {TWOCODE, 22, 11},
X {TWOCODE, 22, 12},
X {TWOCODE, 22, 13},
X {TWOCODE, 22, 14},
X {TWOCODE, 22, 15},
X {TWOCODE, 22, 25},
X
X {TWOCODE_9, 32, 0},
X {TWOCODE_9, 32, 1},
X {TWOCODE_9, 32, 2},
X {TWOCODE_9, 32, 3},
X {TWOCODE_9, 32, 4},
X {TWOCODE_9, 32, 5},
X {TWOCODE_9, 32, 6},
X {TWOCODE_9, 32, 7},
X {TWOCODE_9, 32, 8},
X {TWOCODE_9, 32, 9},
X {TWOCODE, 32, 11},
X {TWOCODE, 32, 12},
X {TWOCODE, 32, 13},
X {TWOCODE, 32, 14},
X {TWOCODE, 32, 15},
X {TWOCODE, 32, 25},
X/* STO, STO +, STO -, STO *, STO / */
X {TWOCODE_9, 44, 0},
X {TWOCODE_9, 44, 1},
X {TWOCODE_9, 44, 2},
X {TWOCODE_9, 44, 3},
X {TWOCODE_9, 44, 4},
X {TWOCODE_9, 44, 5},
X {TWOCODE_9, 44, 6},
X {TWOCODE_9, 44, 7},
X {TWOCODE_9, 44, 8},
X {TWOCODE_9, 44, 9},
X {TWOCODE_PT, 44, 0},
X {TWOCODE_PT, 44, 1},
X {TWOCODE_PT, 44, 2},
X {TWOCODE_PT, 44, 3},
X {TWOCODE_PT, 44, 4},
X {TWOCODE_PT, 44, 5},
X {TWOCODE_PT, 44, 6},
X {TWOCODE_PT, 44, 7},
X {TWOCODE_PT, 44, 8},
X {TWOCODE_PT, 44, 9},
X {TWOCODE, 44, 25},
X {TWOCODE, 44, 24},
X
X {THREECODE, 44, 40, 0},
X {THREECODE, 44, 40, 1},
X {THREECODE, 44, 40, 2},
X {THREECODE, 44, 40, 3},
X {THREECODE, 44, 40, 4},
X {THREECODE, 44, 40, 5},
X {THREECODE, 44, 40, 6},
X {THREECODE, 44, 40, 7},
X {THREECODE, 44, 40, 8},
X {THREECODE, 44, 40, 9},
X {THREECODE_PT, 44, 40, 0},
X {THREECODE_PT, 44, 40, 1},
X {THREECODE_PT, 44, 40, 2},
X {THREECODE_PT, 44, 40, 3},
X {THREECODE_PT, 44, 40, 4},
X {THREECODE_PT, 44, 40, 5},
X {THREECODE_PT, 44, 40, 6},
X {THREECODE_PT, 44, 40, 7},
X {THREECODE_PT, 44, 40, 8},
X {THREECODE_PT, 44, 40, 9},
X {THREECODE, 44, 40, 25},
X {THREECODE, 44, 40, 24},
X
X {THREECODE, 44, 30, 0},
X {THREECODE, 44, 30, 1},
X {THREECODE, 44, 30, 2},
X {THREECODE, 44, 30, 3},
X {THREECODE, 44, 30, 4},
X {THREECODE, 44, 30, 5},
X {THREECODE, 44, 30, 6},
X {THREECODE, 44, 30, 7},
X {THREECODE, 44, 30, 8},
X {THREECODE, 44, 30, 9},
X {THREECODE_PT, 44, 30, 0},
X {THREECODE_PT, 44, 30, 1},
X {THREECODE_PT, 44, 30, 2},
X {THREECODE_PT, 44, 30, 3},
X {THREECODE_PT, 44, 30, 4},
X {THREECODE_PT, 44, 30, 5},
X {THREECODE_PT, 44, 30, 6},
X {THREECODE_PT, 44, 30, 7},
X {THREECODE_PT, 44, 30, 8},
X {THREECODE_PT, 44, 30, 9},
X {THREECODE, 44, 30, 25},
X {THREECODE, 44, 30, 24},
X
X {THREECODE, 44, 20, 0},
X {THREECODE, 44, 20, 1},
X {THREECODE, 44, 20, 2},
X {THREECODE, 44, 20, 3},
X {THREECODE, 44, 20, 4},
X {THREECODE, 44, 20, 5},
X {THREECODE, 44, 20, 6},
X {THREECODE, 44, 20, 7},
X {THREECODE, 44, 20, 8},
X {THREECODE, 44, 20, 9},
X {THREECODE_PT, 44, 20, 0},
X {THREECODE_PT, 44, 20, 1},
X {THREECODE_PT, 44, 20, 2},
X {THREECODE_PT, 44, 20, 3},
X {THREECODE_PT, 44, 20, 4},
X {THREECODE_PT, 44, 20, 5},
X {THREECODE_PT, 44, 20, 6},
X {THREECODE_PT, 44, 20, 7},
X {THREECODE_PT, 44, 20, 8},
X {THREECODE_PT, 44, 20, 9},
X {THREECODE, 44, 20, 25},
X {THREECODE, 44, 20, 24},
X
X {THREECODE, 44, 10, 0},
X {THREECODE, 44, 10, 1},
X {THREECODE, 44, 10, 2},
X {THREECODE, 44, 10, 3},
X {THREECODE, 44, 10, 4},
X {THREECODE, 44, 10, 5},
X {THREECODE, 44, 10, 6},
X {THREECODE, 44, 10, 7},
X {THREECODE, 44, 10, 8},
X {THREECODE, 44, 10, 9},
X {THREECODE_PT, 44, 10, 0},
X {THREECODE_PT, 44, 10, 1},
X {THREECODE_PT, 44, 10, 2},
X {THREECODE_PT, 44, 10, 3},
X {THREECODE_PT, 44, 10, 4},
X {THREECODE_PT, 44, 10, 5},
X {THREECODE_PT, 44, 10, 6},
X {THREECODE_PT, 44, 10, 7},
X {THREECODE_PT, 44, 10, 8},
X {THREECODE_PT, 44, 10, 9},
X {THREECODE, 44, 10, 25},
X {THREECODE, 44, 10, 24},
X
X/* RCL */
X {TWOCODE_9, 45, 0},
X {TWOCODE_9, 45, 1},
X {TWOCODE_9, 45, 2},
X {TWOCODE_9, 45, 3},
X {TWOCODE_9, 45, 4},
X {TWOCODE_9, 45, 5},
X {TWOCODE_9, 45, 6},
X {TWOCODE_9, 45, 7},
X {TWOCODE_9, 45, 8},
X {TWOCODE_9, 45, 9},
X {TWOCODE_PT, 45, 0},
X {TWOCODE_PT, 45, 1},
X {TWOCODE_PT, 45, 2},
X {TWOCODE_PT, 45, 3},
X {TWOCODE_PT, 45, 4},
X {TWOCODE_PT, 45, 5},
X {TWOCODE_PT, 45, 6},
X {TWOCODE_PT, 45, 7},
X {TWOCODE_PT, 45, 8},
X {TWOCODE_PT, 45, 9},
X {TWOCODE, 45, 25},
X {TWOCODE, 45, 24},
X};
SHAR_EOF
echo "extracting prog_codes.h"
sed 's/^X//' << \SHAR_EOF > prog_codes.h
X/* There are 6 different ways in which program lines are displayed. cf io.c */
X#define ONECODE 0
X#define TWOCODE 1
X#define TWOCODE_9 2
X#define TWOCODE_PT 3
X#define THREECODE 4
X#define THREECODE_PT 5
X
Xstruct KeyCode {
X BYTE Type; /* The display method */
X BYTE c1, c2, c3; /* The codes to display */
X};
X
X/* This array is indexed by the instruction code (from codes.h). Therefore, if
X that file is changed, the codes must also be changed. */
Xextern struct KeyCode keycodes[];
SHAR_EOF
echo "extracting support.c"
sed 's/^X//' << \SHAR_EOF > support.c
X#include "math.h"
X
X#include "hp11/support.h"
X
Xdouble sign(r)
Xdouble r;
X{
X if (r < 0.0) return(-1.0);
X else if (r == 0.0) return (0.0);
X else return(1.0);
X}
X
Xvoid Rect(r, phi, x, y)
Xdouble r, phi, *x, *y;
X{
X *x = r * cos(phi);
X *y = r * sin(phi);
X}
X
Xvoid Polar(x, y, r, phi)
Xdouble x, y, *r, *phi;
X{
X *r = sqrt(x * x + y * y);
X *phi = atan2(y, x);
X}
X
Xdouble stirling(n)
Xdouble n;
X{
X double y = 1 / (12 * n);
X
X return (pow(n / E, n) * sqrt(2 * PI * n) * (1 + y * (1 + y * (0.5 - y * (4.6333333333333333 + y * 4.7583333333333333)))));
X}
X
Xdouble gamma(x)
Xdouble x;
X{
X double fx, tx, res, i;
X
X if (x >= 15.0) return(stirling(x - 1));
X else {
X if ((fx = modf(x, &tx)) < 0) { tx -= 1.0; fx += 1.0; } /* give real int & frac */
X
X if (fx == 0 && tx < 0) return(-HUGE);
X if (tx < -200) return(0.0); /* Underflow */
X
X res = stirling(fx + 14.0);
X for (i = 14.0; i >= tx; i -= 1.0) res /= i + fx;
X
X return(res);
X }
X}
X
Xdouble factorial(x)
Xint x;
X{
X double r = 1.0;
X
X if (x > 250) r = HUGE; /* Certainly too big */
X else for (; x > 0; x--) r *= x;
X
X return(r);
X}
X
Xdouble Perm(x, y)
Xint x, y;
X{
X double i, res = 1.0, lim = x - y;
X
X for (i = x; i > lim; i -= 1.0) res *= i;
X
X return(res);
X}
X
Xdouble Comb(x, y)
Xint x,y;
X{
X double i, lim = y, res = Perm(x, y);
X
X for (i = 1; i <= lim; i += 1.0) res /= i;
X
X return(res);
X}
X
Xdouble hr(x)
Xdouble x;
X{
X double h, m, s;
X
X /* f = modf(x, &i) returns the frcational part of x in f and the integral part in i (all double) */
X m = 100.0 * modf(x, &h);
X s = 100.0 * modf(m, &m);
X
X return(h + m / 60.0 + s / 3600.0);
X}
X
Xdouble hms(x)
Xdouble x;
X{
X double h, m, s;
X
X m = 60.0 * modf(x, &h);
X s = 60.0 * modf(m, &m);
X
X return(h + m / 100.0 + s / 10000.0);
X}
X
Xdouble trunc(x)
Xdouble x;
X{
X modf(x, &x);
X return(x);
X}
X
Xdouble frac(x)
Xdouble x;
X{
X return(modf(x, &x));
X}
X
Xdouble asinh(x)
Xdouble x;
X{
X return(log(x + sqrt(x * x + 1)));
X}
X
Xdouble acosh(x)
Xdouble x;
X{
X if (x < 1.0) return(0.0);
X else return(log(x + sqrt(x * x -1)));
X}
X
Xdouble atanh(x)
Xdouble x;
X{
X if (x > 1.0) return(0.0);
X else return(log((1.0 + x) / (1.0 - x)) / 2.0);
X}
SHAR_EOF
echo "extracting support.h"
sed 's/^X//' << \SHAR_EOF > support.h
X/* Support routines for the HP11, but not HP11 specific */
X
X/* Macros to convert to/from grad's/degrees from/to radians */
X#define TDEG(x) (x) * (180.0 / PI)
X#define FDEG(x) (x) * (PI / 180.0)
X#define TGRAD(x) (x) * (200.0 / PI)
X#define FGRAD(x) (x) * (PI / 200.0)
X#define E 2.718281828
X
Xdouble sign(double); /* return the sign of the number */
Xvoid Rect(double, double, double *, double *); /* Convert from Polar to Rectangular */
Xvoid Polar(double, double, double *, double *); /* Convert from Rectangular to Polar */
Xdouble Perm(int, int); /* Compute the permutation of y items taken x at a time (ordered) */
Xdouble Comb(int, int); /* Compute the combination of y items taken x at a time (unorderd) */
Xdouble hr(double); /* Convert to decimal hours */
Xdouble hms(double); /* Convert from decimal hours to hh.mmss */
Xdouble trunc(double); /* Truncate double, returning a double */
Xdouble frac(double); /* Take the fractional part of a double */
Xdouble factorial(int); /* Compute the factorial */
Xdouble gamma(double); /* Compute the gamma function */
Xdouble stirling(double); /* Stirling's approximation */
X/* Hyperbolic reciprocal functions (the others are in the library) */
Xdouble asinh(double), acosh(double), atanh(double);
SHAR_EOF
echo "End of archive 3 (of 3)"
# if you want to concatenate archives, remove anything after this line
exit