#include "exec/types.h" #include "proto/dos.h" #include "math.h" #include "string.h" #include "stdio.h" #include "hp11/amiga/amiga.h" #include "hp11/hp11.h" #include "hp11/io.h" #include "hp11/support.h" #include "hp11/ins.h" #include "hp11/codes.h" #define FOREVER() for(;;) /* Declare the modules variables */ BOOL enabled, entering, overflow; BOOL expo, decpt; char strx[13], expx[4]; /* Function addresses */ HP11Function insfunc[KCOMPLEX] = { Sqrt, Exp, Exp10, ExpYX, Invert, DoCHS, Divide, SIN, COS, TAN, DoEEX, Times, RunStart, Rdn, ExgXY, ENTER, Minus, DoPoint, SigmaPlus, Plus, Pi, XleY, ExgXInd, ToRect, ExgXI, DSE, ISG, XgtY, PSE, ClearSigma, ClearReg, Random, DoPerm, ToHMS, ToRAD, XneY, FRAC, Fact, Estimate, LinearRegression, XeqY, Sqr, LN, LOG, Percent, DeltaPercent, ABS, DEG, RAD, GRAD, Xlt0, ArcSIN, ArcCOS, ArcTAN, ToPolar, Xgt0, RTN, Rup, RND, CLX, LSTX, DoComb, ToH, ToDEG, Xne0, INT, Mean, SDev, SigmaSub, Xeq0, STORandom, RCLSigma, HypSIN, HypCOS, HypTAN, ArcHypSIN, ArcHypCOS, ArcHypTAN }; /* Various functions used to conserve code space. Could be macros or simply instructions */ void DISABLE() { enabled = FALSE; entering = FALSE; } void ENABLE() { enabled = TRUE; entering = FALSE; } void LisX(void) { L = X; } void XisY(void) { X = Y; } void YisX(void) { Y = X; } void YisZ(void) { Y = Z; } void ZisY(void) { Z = Y; } void ZisT(void) { Z = T; } void TisZ(void) { T = Z; } /* Check r against HP11 limits */ double Check(r) double r; { if (fabs(r) > MAXHP11) { r = MAXHP11 * sign(r); overflow = TRUE; /* Overflow has occured */ } else if (fabs(r) < MINHP11) r = 0.0; return(r); } void Drop(void) /* Drop stack & save X in L */ { ENABLE(); LisX(); XisY(); YisZ(); ZisT(); /* L = X(); X = Y; Y = Z; Z = T; */ } void Enter(void) /* Move stack up */ { TisZ(); ZisY(); YisX(); /* T = Z; Z = Y; Y = X; */ } void Lift(void) /* lift stack if enabled, ENABLE stack */ { if (enabled) Enter(); ENABLE(); } void SaveX(void) /* Frequent: L = X; ENABLE(); (most simple instructions eg sin do this) */ { LisX(); ENABLE(); } /* Convert x from current trig setting to radians */ double from(double x) { switch (Angles) { case deg:return(FDEG(x)); case rad:return(x); case grad:return(FGRAD(x)); } } /* Convert radian value to current trig setting */ double toa(double x) { switch (Angles) { case deg:return(TDEG(x)); case rad:return(x); case grad:return(TGRAD(x)); } } /* Used by statistical formulae (terminology from HP11 doc) */ double M(void) { return(R[0] * R[2] - R[1] * R[1]); } #define N() (R[0] * R[4] - R[3] * R[3]) /* used only once */ double P(void) { return(R[0] * R[5] - R[1] * R[3]); } double *Reg(int n) /* Return address of register n */ { if (n == OI) return(&I); else if (n == OIND_R) /* indirection */ if (I >= 0.0 && I < 20.0) return(R + (int)I); else return(NULL); /* Unknown reg */ else return(R + n); } /* Convert current input value to real, return false if fails (no exponent) */ void StdVal(void) { X = atof(strx); } /* Convert current input value to real, return false if fails (exponent) */ void ExpoVal(void) { char buf[80]; /* buf = strx + "E" + expx, with leading blanks stripped from expx */ strcat(strcat(strcpy(buf,strx),"E"), stpblk(expx)); X = atof(buf); } /* Act on key to modify current input value */ void EnterNum(key) register int key; { register int lens; if (!entering) { /* No current digit entry */ if (enabled) Enter(); /* lift stack ? */ entering = enabled = TRUE; /* stack enabled, number being entered */ expo = decpt = FALSE; /* No dec point or exponent */ strx[0] = ' '; strx[1] = '\0'; /* nb string empty (leading space for sign) */ } lens = strlen(strx); /* Current string length */ if (key >= KFIG + 0 && key <= KFIG + 9) /* Add digit */ if (expo) { /* to exponent */ expx[1] = expx[2]; expx[2] = key - KFIG + '0'; } else { strx[lens] = key - KFIG + '0'; strx[lens + 1] = '\0'; strx[scrpos(strx, 11) + 1] = '\0'; /* Cut string at end of hp11 screen pos ==> prevent display overflow */ } else switch (key) { case -IBACK: /* back-arrow, actions are passed as negative numbers to distinguish them from instructions */ if (expo) /* Correct exponent */ if (strcmp(expx, "-00") == 0) strcpy(expx, " 00"); else if (strcmp(expx, " 00") == 0) expo = FALSE; /* delete exponent */ else { expx[2] = expx[1]; expx[1] = '0'; } else /* no exponent */ if (lens == 2) { CLX(); return; } /* end of digit entry, must not evaluate current entry ==> exit */ else { if (strx[lens - 1] == '.') decpt = FALSE; strx[lens - 1] = '\0'; /* cut last char from str by moving eos mark */ } break; case KCHS: if (expo) { /* change exponent sign */ expx[0] = (expx[0] == '-') ? ' ' : '-'; } else { /* change number sign */ strx[0] = (strx[0] == '-') ? ' ' : '-'; } break; case KPOINT: if (!expo && !decpt) { decpt = TRUE; if (lens == 1) { strcpy(strx, " 0"); lens = 2; } /* if no digit entered, add a 0 */ strx[lens] = '.'; strx[lens + 1] = '\0'; strx[scrpos(strx, 11) + 1] = '\0'; } break; case KEEX: if (!expo) { expo = TRUE; strcpy(expx, " 00"); if (lens == 1) strcpy(strx, " 1"); /* if no digit entered, add a 1 */ } } if (expo) ExpoVal(); else StdVal(); } void ExpYX() /* y^x */ { double t; errno = 0; /* set return code to 0 */ t = pow(Y, X); if (errno != 0) Error('0'); /* Check math library return code */ else { Y = t; Drop(); } } void CHS(void) { ENABLE(); X = -X; } void DoCHS() { if (entering) EnterNum(KCHS); else CHS(); } void DoEEX() { EnterNum(KEEX); } void DoPoint() { EnterNum(KPOINT); } void Rdn() { double t; ENABLE(); t = X; XisY(); YisZ(); ZisT(); T = t; /* t = X; X = Y; Y = Z; Z = T; T = t; */ } void ExgXY() /* Exchange X & Y */ { double t; ENABLE(); t = X; XisY(); Y = t; /* t = X; X = Y; Y = t; */ } void ClearReg() { int i; NEUTRAL(); for (i = 0; i < 20; i++) R[i] = 0.0; I = 0; } void Estimate() /* Statistics: estimate y from given x */ { double tm = M(), tr, ty, tp = P(); /* temporary results */ tr = tm * N(); ty = R[0] * tm; if (tr < 0.0 || ty == 0.0) Error('2'); /* Stat error */ else { Enter(); /* always lifts stack */ SaveX(); X = (tm * R[3] + tp * (R[0] * X - R[1])) / ty; /* estimate */ Y = tp / sqrt(tr); /* Correlation coefficient */ } } void LinearRegression() { double tm = M(), tp = P(); if (tm == 0.0 || R[0] == 0.0) Error('2'); else { Lift(); /* Lift stack twice */ Enter(); Y = tp / tm; X = (tm * R[3] - tp * R[1]) / (R[0] * tm); } } void Rup() { double t; ENABLE(); t = T; TisZ(); ZisY(); YisX(); X = t; /* t = T; T = Z; Z = Y; Y = X; X = t; */ } void SDev() { double tx, ty, td; td = R[0] * (R[0] - 1.0); if (td == 0.0) Error('2'); else { tx = M() / td; ty = N() / td; if (tx < 0.0 || ty < 0.0) Error('2'); else { Lift(); Enter(); X = sqrt(tx); Y = sqrt(ty); } } } void FIX(n) int n; { NEUTRAL(); Mode = fix; Digits = n; minfix = pow(10.0, (double)-Digits); } void SCI(n) int n; { NEUTRAL(); Mode = sci; Digits = n; } void ENG(n) int n; { NEUTRAL(); Mode = eng; Digits = n; } void ExgXI() /* Exchange X with I */ { double t; ENABLE(); t = I; I = X; X = t; } void ExgXInd() /* Exchange X with (i) */ { double t, *ptr; if (!(ptr = Reg(OIND_R))) Error('3'); /* get address of pointed register if exists */ else { ENABLE(); t = *ptr; *ptr = X; X = t; } } void STO(n, type) int n; enum StoTypes type; { double val; register double *ptr; if (ptr = Reg(n)) { /* Valid register */ switch (type) { case sto: val = X; break; case add: val = *ptr + X; break; case sub: val = *ptr - X; break; case mul: val = *ptr * X; break; case div: if (X == 0.0) { Error('0'); return; /* exit if error */ } else val = *ptr / X; break; } if (fabs(val) > MAXHP11) Error('1'); /* Register overflow */ else { *ptr = val; ENABLE(); } } else Error('3'); } void RCL(n) int n; { double *ptr; if (ptr = Reg(n)) { Lift(); X = *ptr; } else Error('3'); } void GTOLine(n) /* move to line n */ int n; { if (n >= 0 && n <= lastIns) PC = n; else Error('4'); } void ProgramEntry() /* Enter a program */ { register int i; WORD code; register int inprog = TRUE; RelKey(); ENABLE(); do { DisplayLine(); DispPRGM(TRUE); /* Program display */ switch (ReadKey(&code)) { case Instruction: /* Save it */ if (lastIns == MAXPROG) Error('4'); /* Memory full */ else { for (i = lastIns; i > PC; i--) Prog[i + 1] = Prog[i]; /* Move program up */ lastIns++; Prog[++PC] = code; /* store instruction */ retCnt = 0; /* Empty return stack */ }; break; case Action: /* Act on it */ if (code >= IGTO_LINE) GTOLine(code - IGTO_LINE); else switch (code) { case ION: on = inprog = !RelKey(); break; /* Allow user to change his mind */ case IP_R: case IRESET: inprog = FALSE; break; /* exit program mode */ case IMEM: MEM(); break; case IBACK: /* delete line */ if (PC != 0) { for (i = PC; i < lastIns; i++) Prog[i] = Prog[i + 1]; /* del line */ lastIns--; PC--; retCnt = 0; /* empty stack when prog changed */ } break; case ISST: if (PC++ == lastIns) PC = 0; break; case IBST: if (PC-- == 0) PC = lastIns; break; case IUSER: USER(); break; case ICLR_PRGM: lastIns = PC = 0; break; } break; } RelKey(); } while (inprog); } void GTOLBL(int n) { register int i; if (n > 14) Error('4'); else { /* Do a circular search from current line */ for (i = PC + 1; i <= lastIns; i++) /* Search from current line */ if (Prog[i] == KLBL + n) { PC = i; return; /* found, exit */ } for (i = 1; i < PC; i++) /* If that fails, search from start */ if (Prog[i] == KLBL + n) { PC = i; return; } Error('4'); } } void GTO(n) int n; { if (n == OIND_G) /* Indirection */ if (I >= 0.0) GTOLBL((int)I); /* gto label if I >= 0 */ else GTOLine(-(int)I); /* gto line -I if i < 0 */ else GTOLBL(n); if (!error) { /* success */ ENABLE(); if (running) PC--; /* Execute label instruction (even though useless), must decrement PC in run mode because incremented after end ins */ else retCnt = 0; /* in normal mode, GTO clears return stack */ } } void BreakupI(int *limit, int *step) /* From I deduce loop limit & step. I is stored as nnnnn.lllss with nnnnn as the loop count, lll the limit & ss the step. If ss == 0, the step is taken as 1 */ { double t; t = frac(I) * 1000.0; *limit = (int)t; *step = (int)(100.0 * (t - *limit)); if (*step == 0) *step = 1; } void DSE() { int limit, step; ENABLE(); BreakupI(&limit, &step); I -= step; skip = (I <= limit); } void ISG() { int limit, step; ENABLE(); BreakupI(&limit, &step); I += step; skip = (I > limit); } void SF(n) int n; { ENABLE(); Flags |= (1 << n); } void CF(n) int n; { ENABLE(); Flags &= ~(1 << n); } void Set(n) /* Is flag n set ? */ int n; { ENABLE(); skip = !(Flags & (1 << n)); } void PSE() { BOOL oldrun = running; NEUTRAL(); running = FALSE; Disp(); Wait50(50); running = oldrun; } void RTN() { ENABLE(); if (!running || retCnt == 0) { /* In normal mode RTN sets PC to 0 & clears the return stack. In run mode, if the stack is empty, it also sets PC to 0 & then it interrupts the program */ running = FALSE; PC = 0; retCnt = 0; } else /* Return from subroutine */ PC = retStack[--retCnt]; } void GSB(n) int n; { if (retCnt == MAXSTACK) Error('5'); /* Stack full */ else { if (running) { retStack[retCnt++] = PC; /* Save PC */ GTO(n); /* Jump to prog line */ if (error) retCnt--; /* If this fails, reclaim stack space */ } else { /* in normal mode, GSB = GTO + R/S */ retCnt = 0; GTO(n); running = !error; } } } void HP11ColdReset() /* ColdReset HP11 (Menu option: New) */ { Display(" Pr Error"); DEG(); FIX(4); PC = lastIns = 0; running = User = comma = FALSE; Flags = retCnt = 0; ClearSigma(); L = 0.0; ClearReg(); GetKey(); } void MEM() /* Display available memory */ { char mem[20]; NEUTRAL(); sprintf(mem, " P-%-4dr- .9", MAXPROG - lastIns); /* There are always all the register hence the r- .9, %-4d left justifies the number of lines in a 4 character field */ Display(mem); RelKey(); } void PREFIX() /* Display digits of number in x */ { char *disp, buf[20]; int dec, sign; NEUTRAL(); if (X != 0.0) { disp = ecvt(X, 10, &dec, &sign); /* The ideal library function for this */ buf[0] = ' '; strcpy(buf + 1, disp); Display(buf); } else Display(" 0000000000"); RelKey(); } void RND() { double fx, tx; char buf[20]; SaveX(); switch (Mode) { case fix: fx = modf(X, &tx); X = tx + trunc(fx / minfix + 0.5) * minfix; break; case sci: case eng: sprintf(buf, "%0.*e", Digits, X); X = atof(buf); break; } } void Sqrt() { if (X < 0.0) Error('0'); else { SaveX(); X = sqrt(X); } } void Exp() /* e^x */ { SaveX(); X = exp(X); } void Exp10() /* 10^x */ { SaveX(); X = pow(10.0, X); } void Invert() /* 1/x */ { if (X == 0.0) Error('0'); else { SaveX(); X = 1.0 / X; } } void Divide() { if (X == 0.0) Error('0'); else { Y = Y / X; Drop(); } } void SIN() { SaveX(); X = sin(from(X)); } void COS() { SaveX(); X = cos(from(X)); } void TAN() { SaveX(); X = tan(from(X)); } void Times() { Y = Y * X; Drop(); } void ENTER() { DISABLE(); Enter(); } void Minus() { Y = Y - X; Drop(); } void SigmaPlus() /* Accumulate statistics */ { R[0] += 1.0; R[1] = Check(R[1] + X); R[2] = Check(R[2] + X * X); R[3] = Check(R[3] + Y); R[4] = Check(R[4] + Y * Y); R[5] = Check(R[5] + X * Y); DISABLE(); LisX(); X = R[0]; } void Plus() { Y = Y + X; Drop(); } void Pi() { Lift(); X = PI; } void ToRect() { SaveX(); Rect(X, from(Y), &X, &Y); } void ClearSigma() /* Clear statistics */ { NEUTRAL(); /* Doesn't really matter, could be anything (but the HP11 doc says neutral so it will be neutral ... */ X = Y = Z = T = R[0] = R[1] = R[2] = R[3] = R[4] = R[5] = 0.0; } void Random() /* Random number generator. This isn't the same as the HP11 one, for I don't know what the HP11 uses. */ { Lift(); X = drand48(); } void DoPerm() /* P y,x */ { if (X <= Y && X > 0.0) { Y = Perm((int)Y, (int)X); Drop(); } else Error('0'); } void ToHMS() { SaveX(); X = hms(X); } void ToRAD() { SaveX(); X = FDEG(X); } void FRAC() { SaveX(); X = frac(X); } void Fact() /* gamma/factorial function */ { SaveX(); if (X > MAXFACT) X = MAXHP11; else if (X >= 0 && X == trunc(X)) X = factorial((int)X); else X = gamma(1.0 + X); } void Sqr() { SaveX(); X = X * X; } void LN() { if (X <= 0.0) Error('0'); else { SaveX(); X = log(X); } } void LOG() { if (X <= 0.0) Error('0'); else { SaveX(); X = log10(X); } } void Percent() { /* doesn't drop stack */ SaveX(); X = X * Y / 100.0; } void DeltaPercent() /* Percentage of difference between x & y */ { if (Y == 0.0) Error('0'); else { SaveX(); X = 100.0 * (X - Y) / Y; } } void ABS() { SaveX(); X = fabs(X); } void DEG() { NEUTRAL(); Angles = deg; } void RAD() { NEUTRAL(); Angles = rad; } void GRAD() { NEUTRAL(); Angles = grad; } void ArcSIN() { if (fabs(X) > 1.0) Error('0'); else { SaveX(); X = toa(asin(X)); } } void ArcCOS() { if (fabs(X) > 1.0) Error('0'); else { SaveX(); X = toa(acos(X)); } } void ArcTAN() { SaveX(); X = toa(atan(X)); } void ToPolar() { SaveX(); Polar(X, Y, &X, &Y); Y = toa(Y); } void CLX() { X = 0.0; DISABLE(); } void LSTX() { Lift(); X = L; } void DoComb() /* C y,x */ { if (X <= Y && X > 0.0) { Y = Comb((int)Y, (int)X); Drop(); } else Error('0'); } void ToH() { SaveX(); X = hr(X); } void ToDEG() { SaveX(); X = TDEG(X); } void INT() { SaveX(); X = trunc(X); } void Mean() { if (R[0] == 0.0) Error('2'); else { Lift(); Enter(); X = R[1] / R[0]; Y = R[3] / R[0]; } } void SigmaSub() /* Correct error in statistics accumulation */ { R[0] -= 1.0; R[1] = Check(R[1] - X); R[2] = Check(R[2] - X * X); R[3] = Check(R[3] - Y); R[4] = Check(R[4] - Y * Y); R[5] = Check(R[5] - X * Y); DISABLE(); LisX(); X = R[0]; } void HypSIN() { SaveX(); X = sinh(X); } void HypCOS() { SaveX(); X = cosh(X); } void HypTAN() { SaveX(); X = tanh(X); } void ArcHypSIN() { SaveX(); X = asinh(X); } void ArcHypCOS() { if (fabs(X) < 1.0) Error('0'); else { SaveX(); X = acosh(X); } } void ArcHypTAN() { if (fabs(X) > 1.0) Error('0'); else { SaveX(); X = atanh(X); } } void STORandom() /* Set random generator seed */ { ENABLE(); srand48((long)X); /* Use integer part of seed, something better could be used */ } void RCLSigma() /* Recall accumulated x & y totals */ { Lift(); Enter(); X = R[1]; Y = R[3]; } void USER() /* Toggle user mode */ { NEUTRAL(); User = !User; } void RunStart() /* Should be called RunStop ! */ { NEUTRAL(); if (running) running = FALSE; /* Stop */ else { /* Run */ if (lastIns != 0) { /* if a program to run */ running = TRUE; if (PC == 0) PC = 1; /* skip first line */ } DisplayLine(); /* Display first line */ RelKey(); } } void XleY() { ENABLE(); skip = (X > Y); /* skip if condition fails */ } void Xlt0() { ENABLE(); skip = (X >= 0.0); } void XgtY() { ENABLE(); skip = (X <= Y); } void Xgt0() { ENABLE(); skip = (X <= 0.0); } void XneY() { ENABLE(); skip = (X == Y); } void Xne0() { ENABLE(); skip = (X == 0.0); } void XeqY() { ENABLE(); skip = (X != Y); } void Xeq0() { ENABLE(); skip = (X != 0.0); } void SST() /* Single step a program */ { if (lastIns == 0) { /* No program to single step through */ DisplayLine(); RelKey(); } else { if (PC == 0) PC = 1; /* skip line 0 */ DisplayLine(); RelKey(); running = TRUE; /* Pretend line is being run */ ExecIns(Prog[PC]); /* Exec ins */ if (!error && !overflow) { /* idem main loop */ if (skip) PC++; PC++; while (PC > lastIns) { RTN(); PC++; } } running = FALSE; } } void BST() /* move back one line (but don't correct its effect) */ { if (PC == 0) PC = lastIns; else PC--; DisplayLine(); RelKey(); }