Many FPU improvements

src/inc/fpu.plh

@@ -1,5 +1,11 @@
 import fpu
 //
+// FPU register type
+//
+struc t_fpureg
+    byte[10] _regdata
+end
+//
 // RPN Register indeces
 //
 const X_REG = 0
@@ -7,10 +13,41 @@ const Y_REG = 1
 const Z_REG = 2
 const T_REG = 3
 //
+// Comparison results
+//
+const FPUCMPGT = $4040      // Greater Than
+const FPUCMPLT = $8080      // Less Than
+const FPUCMPEQ = $0002      // EQual
+const FPUCMPUN = $0101      // UNordered
+//
+// Exceptions
+//
+const FPUINVALID = $01
+const FPUUFLOW   = $02
+const FPUOFLOW   = $04
+const FPUDIVZER  = $08
+const FPUINEXACT = $10
+//
+// FP type
+//
+const FPUSNAN    = $00FC    // -4: signaling NAN
+const FPUQNAN    = $00FD    // -3: quiet NAN
+const FPUINF     = $00FE    // -2: infinite
+const FPUZERO    = $00FF    // -1: zero
+const FPUNORM    = $0000    //  0: normal
+const FPUDENORM  = $0001    //  1: denormal
+const FPUNEG     = $8000
+//
 // FPU API
 //
 struc t_fpu
     word reset
+    word getEnv
+    word setEnv
+    word testExept
+    word setExcept
+    word enterProc
+    word exitProc
     word constPi
     word constE
     word pushInt
@@ -34,26 +71,46 @@ struc t_fpu
     word storExt
     word storStr
     word shiftUp
-    word shiftDown
+    word shiftDown // dropX
     word rotateUp
     word rotateDown
-    word dup
+    word dupX
-    word swap
+    word swapXY
-    word clear
+    word clearX
-    word add
+    word addXY
-    word sub
+    word subXY
-    word mul
+    word mulXY
-    word div
+    word divXY
-    word rem
+    word remXY
-    word neg
+    word negX
-    word abs
+    word absX
-    word trunc
+    word typeX
-    word round
+    word cmpXY
-    word sqrt
+    word logbX
-    word square
+    word scalebXInt
-    word cos
+    word truncX
-    word sin
+    word roundX
-    word tan
+    word sqrtX
+    word squareX
+    word cosX
+    word sinX
+    word tanX
+    word atanX
+    word log2X
+    word log21X
+    word lnX
+    word ln1X
+    word pow2X
+    word pow21X
+    word powEX
+    word powE1X
+    word powE21X
+    word powXInt
+    word powXY
+    word compXY
+    word annuityXY
+    word randNum
 end
+const dropX = shiftDown // Alias dropX and shiftDown
 word fpu
 end

src/libsrc/fpstr.pla

@@ -124,7 +124,8 @@ export def str2ext(str, ext)
         decrec.sig = 1
         decrec.sig.1 = '0'
     fin
-    return sane:fpOp2(FFEXT|FOD2B, ext, @decrec)
+    sane:zpSave()
+    return sane:zpRestore(sane:fpOp2(FFEXT|FOD2B, ext, @decrec))
 end
 //
 // Convert extended FP to string using , return string
@@ -138,7 +139,8 @@ export def ext2str(ext, str, intdigits, fracdigits, format)
     numdigits = intdigits + fracdigits
     decform:style  = format & $01
     decform:digits = decform:style ?? fracdigits :: numdigits
-    sane:fpOp3(FFEXT|FOB2D, @decrec, ext, @decform)
+    sane:zpSave()
+    sane:zpRestore(sane:fpOp3(FFEXT|FOB2D, @decrec, ext, @decform))
     ^(str+1) = decrec.sgn ?? '-' :: ' '
     if decrec.sig.1 == 'I'
         ^(str+2) = 'I'

src/libsrc/fpu.pla

@@ -7,24 +7,38 @@ include "inc/fpstr.plh"
 //
 // External interface to FPU library
 //
-predef reset, constPi, constE
+predef reset, getEnv, setEnv, testExcept, setExcept, enterProc, exitProc
+predef constPi, constE
 predef pushInt, pushSgl, pushDbl, pushExt, pushStr
 predef pullInt, pullSgl, pullDbl, pullExt, pullStr
 predef loadInt, loadSgl, loadDbl, loadExt, loadStr
 predef storInt, storSgl, storDbl, storExt, storStr
 predef shiftUp, shiftDown, rotateUp, rotateDown, dup, swap, clear
 predef add, sub, mul, div, rem
-predef        neg, abs, trunc, round, sqrt, square
+predef neg, abs, type, cmp, logb, scalb, trunc, round, sqrt, squared
-predef        cos, sin, tan
+predef cos, sin, tan, atan
-export word fpu = @reset, @constPi, @constE
+predef log2X, log21X, lnX, ln1X, pow2X, pow21X, powEX, powE1X, powE21X, powXInt, powXY
+predef compXY, annuityXY, randNum
+//
+// FP6502 functions
+//
+export word fpu = @reset
+word = @setEnv, @getEnv, @testExcept, @setExcept, @enterProc, @exitProc
+word = @constPi, @constE
 word = @pushInt, @pushSgl, @pushDbl, @pushExt, @pushStr
 word = @pullInt, @pullSgl, @pullDbl, @pullExt, @pullStr
 word = @loadInt, @loadSgl, @loadDbl, @loadExt, @loadStr
 word = @storInt, @storSgl, @storDbl, @storExt, @storStr
 word = @shiftUp, @shiftDown, @rotateUp, @rotateDown, @dup, @swap, @clear
 word = @add, @sub, @mul, @div, @rem
-word = @neg, @abs, @trunc, @round, @sqrt, @square
+word = @neg, @abs, @type, @cmp
-word = @cos, @sin, @tan
+word = @logb, @scalb, @trunc, @round, @sqrt, @squared
+//
+// ELEMS6502 functions
+//
+word = @cos, @sin, @tan, @atan
+word = @log2X, log21X, @lnX, @ln1X, @pow2X, @pow21X, @powEX, @powE1X, @powE21X, @powXInt, @powXY
+word = @compXY, @annuityXY, @randNum
 //
 // Useful constants
 //
@@ -36,6 +50,33 @@ byte ext_e[t_extended]  = $9B,$4A,$BB,$A2,$5B,$54,$F8,$AD,$00,$40
 byte stack[t_extended*4]
 word stackRegs[4]
 //
+// Environment access
+//
+def setEnv(env)
+    sane:zpSave()
+    return sane:zpRestore(sane:fpOp1(FOSETENV, env))
+end
+def getEnv
+    sane:zpSave()
+    return sane:zpRestore(sane:fpOp0(FOGETENV))
+end
+def testExcept(except)
+    sane:zpSave()
+    return sane:zpRestore(sane:fpOp1(FOTESTXCP, except))
+end
+def setExcept(except)
+    sane:zpSave()
+    return sane:zpRestore(sane:fpOp1(FOSETXCP, except))
+end
+def enterProc(pEnv)
+    sane:zpSave()
+    return sane:zpRestore(sane:fpOp1(FOPROCENTRY, pEnv))
+end
+def exitProc(env)
+    sane:zpSave()
+    return sane:zpRestore(sane:fpOp1(FOPROCEXIT, env))
+end
+//
 // Stack manipulation routines
 //
 def rotateUp
@@ -46,24 +87,33 @@ def rotateDown
 end
 def shiftUp
     stackRegs[0], stackRegs[1], stackRegs[2], stackRegs[3] = stackRegs[3], stackRegs[0], stackRegs[1], stackRegs[2]
-    memset(stackRegs[0], 0, t_extended)
+    memcpy(stackRegs[0], stackRegs[1], t_extended)
 end
-def shiftDown
+def shiftDown // drop
     stackRegs[0], stackRegs[1], stackRegs[2], stackRegs[3] = stackRegs[1], stackRegs[2], stackRegs[3], stackRegs[0]
-    memset(stackRegs[3], 0, t_extended)
+    memcpy(stackRegs[3], stackRegs[2], t_extended)
+end
+def _drop(passthru) // Internal version with passthru
+    stackRegs[0], stackRegs[1], stackRegs[2], stackRegs[3] = stackRegs[1], stackRegs[2], stackRegs[3], stackRegs[0]
+    memcpy(stackRegs[3], stackRegs[2], t_extended)
+    return passthru
+end
+def swap
+    stackRegs[0], stackRegs[1] = stackRegs[1], stackRegs[0]
+end
+def _swap(passthru) // Internal version with passthru
+    stackRegs[0], stackRegs[1] = stackRegs[1], stackRegs[0]
+    return passthru
 end
 def dup
     stackRegs[0], stackRegs[1], stackRegs[2], stackRegs[3] = stackRegs[3], stackRegs[0], stackRegs[1], stackRegs[2]
     memcpy(stackRegs[0], stackRegs[1], t_extended)
 end
-def swap
-    byte temp[t_extended]
-    memcpy(temp,         stackRegs[1], t_extended)
-    memcpy(stackRegs[1], stackRegs[0], t_extended)
-    memcpy(stackRegs[0], temp,         t_extended)
-end
 def clear
-    memset(stackRegs[0], 0, t_extended)
+    word zero
+    zero = 0
+    sane:zpSave()
+    return sane:zpRestore(sane:fpOp2(FFINT|FOZ2X, stackRegs[0], @zero))
 end
 //
 // Stack access
@@ -71,193 +121,221 @@ end
 def pushInt(pInt)
     stackRegs[0], stackRegs[1], stackRegs[2], stackRegs[3] = stackRegs[3], stackRegs[0], stackRegs[1], stackRegs[2]
     sane:zpSave()
-    sane:fpOp2(FFINT|FOZ2X, stackRegs[0], pInt)
+    return sane:zpRestore(sane:fpOp2(FFINT|FOZ2X, stackRegs[0], pInt))
-    return sane:zpRestore()
 end
 def pullInt(pInt)
     sane:zpSave()
-    sane:fpOp2(FFINT|FOX2Z, pInt, stackRegs[0])
+    return _drop(sane:zpRestore(sane:fpOp2(FFINT|FOX2Z, pInt, stackRegs[0])))
-    sane:zpRestore()
-    return shiftDown
 end
 def loadInt(pInt, reg)
     sane:zpSave()
-    sane:fpOp2(FFINT|FOZ2X, stackRegs[reg & $03], pInt)
+    return sane:zpRestore(sane:fpOp2(FFINT|FOZ2X, stackRegs[reg & $03], pInt))
-    return sane:zpRestore()
 end
 def storInt(pInt, reg)
     sane:zpSave()
-    sane:fpOp2(FFINT|FOX2Z, pInt, stackRegs[reg & $03])
+    return sane:zpRestore(sane:fpOp2(FFINT|FOX2Z, pInt, stackRegs[reg & $03]))
-    return sane:zpRestore()
 end
 def pushSgl(pSgl)
     stackRegs[0], stackRegs[1], stackRegs[2], stackRegs[3] = stackRegs[3], stackRegs[0], stackRegs[1], stackRegs[2]
     sane:zpSave()
-    sane:fpOp2(FFSGL|FOZ2X, stackRegs[0], pSgl)
+    return sane:zpRestore(sane:fpOp2(FFSGL|FOZ2X, stackRegs[0], pSgl))
-    return sane:zpRestore()
 end
 def pullSgl(pSgl)
     sane:zpSave()
-    sane:fpOp2(FFSGL|FOX2Z, pSgl, stackRegs[0])
+    return _drop(sane:zpRestore(sane:fpOp2(FFSGL|FOX2Z, pSgl, stackRegs[0])))
-    sane:zpRestore()
-    return shiftDown
 end
 def loadSgl(pSgl, reg)
     sane:zpSave()
-    sane:fpOp2(FFSGL|FOZ2X, stackRegs[reg & $03], pSgl)
+    return sane:zpRestore(sane:fpOp2(FFSGL|FOZ2X, stackRegs[reg & $03], pSgl))
-    return sane:zpRestore()
 end
 def storSgl(pSgl, reg)
     sane:zpSave()
-    sane:fpOp2(FFSGL|FOX2Z, pSgl, stackRegs[reg & $03])
+    return sane:zpRestore(sane:fpOp2(FFSGL|FOX2Z, pSgl, stackRegs[reg & $03]))
-    return sane:zpRestore()
 end
 def pushDbl(pDbl)
     stackRegs[0], stackRegs[1], stackRegs[2], stackRegs[3] = stackRegs[3], stackRegs[0], stackRegs[1], stackRegs[2]
     sane:zpSave()
-    sane:fpOp2(FFDBL|FOZ2X, stackRegs[0], pDbl)
+    return sane:zpRestore(sane:fpOp2(FFDBL|FOZ2X, stackRegs[0], pDbl))
-    return sane:zpRestore()
 end
 def pullDbl(pDbl)
     sane:zpSave()
-    sane:fpOp2(FFDBL|FOX2Z, pDbl, stackRegs[0])
+    return _drop(sane:zpRestore(sane:fpOp2(FFDBL|FOX2Z, pDbl, stackRegs[0])))
-    sane:zpRestore()
-    return shiftDown
 end
 def loadDbl(pDbl, reg)
     sane:zpSave()
-    sane:fpOp2(FFDBL|FOZ2X, stackRegs[reg & $03], pDbl)
+    return sane:zpRestore(sane:fpOp2(FFDBL|FOZ2X, stackRegs[reg & $03], pDbl))
-    return sane:zpRestore()
 end
 def storDbl(pDbl, reg)
     sane:zpSave()
-    sane:fpOp2(FFDBL|FOX2Z, pDbl, stackRegs[reg & $03])
+    return sane:zpRestore(sane:fpOp2(FFDBL|FOX2Z, pDbl, stackRegs[reg & $03]))
-    return sane:zpRestore()
 end
 def pushExt(pExt)
     stackRegs[0], stackRegs[1], stackRegs[2], stackRegs[3] = stackRegs[3], stackRegs[0], stackRegs[1], stackRegs[2]
     sane:zpSave()
-    sane:fpOp2(FFEXT|FOZ2X, stackRegs[0], pExt)
+    return sane:zpRestore(sane:fpOp2(FFEXT|FOZ2X, stackRegs[0], pExt))
-    return sane:zpRestore()
 end
 def pullExt(pExt)
     sane:zpSave()
-    sane:fpOp2(FFEXT|FOX2Z, pExt, stackRegs[0])
+    return _drop(sane:zpRestore(sane:fpOp2(FFEXT|FOX2Z, pExt, stackRegs[0])))
-    sane:zpRestore()
-    return shiftDown
 end
 def loadExt(pExt, reg)
     sane:zpSave()
-    sane:fpOp2(FFEXT|FOZ2X, stackRegs[reg & $03], pExt)
+    return sane:zpRestore(sane:fpOp2(FFEXT|FOZ2X, stackRegs[reg & $03], pExt))
-    return sane:zpRestore()
 end
 def storExt(pExt, reg)
     sane:zpSave()
-    sane:fpOp2(FFEXT|FOX2Z, pExt, stackRegs[reg & $03])
+    return sane:zpRestore(sane:fpOp2(FFEXT|FOX2Z, pExt, stackRegs[reg & $03]))
-    return sane:zpRestore()
 end
 def pushStr(pStr)
     stackRegs[0], stackRegs[1], stackRegs[2], stackRegs[3] = stackRegs[3], stackRegs[0], stackRegs[1], stackRegs[2]
-    sane:zpSave()
+    return str2ext(pStr, stackRegs[0])
-    str2ext(pStr, stackRegs[0])
-    return sane:zpRestore()
 end
 def pullStr(pStr, intdigits, fracdigits, format)
-    sane:zpSave()
+    return _drop(ext2str(stackRegs[0], pStr, intdigits, fracdigits, format))
-    ext2str(stackRegs[0], pStr, intdigits, fracdigits, format)
-    sane:zpRestore()
-    return shiftDown
 end
 def loadStr(pStr, reg)
-    sane:zpSave()
+    return str2ext(pStr, stackRegs[reg])
-    str2ext(pStr, stackRegs[reg])
-    return sane:zpRestore()
 end
 def storStr(pStr, intdigits, fracdigits, format, reg)
-    sane:zpSave()
+    return ext2str(stackRegs[reg], pStr, intdigits, fracdigits, format)
-    ext2str(stackRegs[reg], pStr, intdigits, fracdigits, format)
-    return sane:zpRestore()
 end
 //
 // Basic math operations
 //
 def add
     sane:zpSave()
-    sane:fpOp2(FFEXT|FOADD, stackRegs[1], stackRegs[0])
+    return _drop(sane:zpRestore(sane:fpOp2(FFEXT|FOADD, stackRegs[1], stackRegs[0])))
-    sane:zpRestore()
-    return shiftDown
 end
 def sub
     sane:zpSave()
-    sane:fpOp2(FFEXT|FOSUB, stackRegs[1], stackRegs[0])
+    return _drop(sane:zpRestore(sane:fpOp2(FFEXT|FOSUB, stackRegs[1], stackRegs[0])))
-    sane:zpRestore()
-    return shiftDown
 end
 def mul
     sane:zpSave()
-    sane:fpOp2(FFEXT|FOMUL, stackRegs[1], stackRegs[0])
+    return _drop(sane:zpRestore(sane:fpOp2(FFEXT|FOMUL, stackRegs[1], stackRegs[0])))
-    sane:zpRestore()
-    return shiftDown
 end
 def div
     sane:zpSave()
-    sane:fpOp2(FFEXT|FODIV, stackRegs[1], stackRegs[0])
+    return _drop(sane:zpRestore(sane:fpOp2(FFEXT|FODIV, stackRegs[1], stackRegs[0])))
-    sane:zpRestore()
-    return shiftDown
 end
 def rem
     sane:zpSave()
-    sane:fpOp2(FFEXT|FOREM, stackRegs[1], stackRegs[0])
+    return _drop(sane:zpRestore(sane:fpOp2(FFEXT|FOREM, stackRegs[1], stackRegs[0])))
-    sane:zpRestore()
-    return shiftDown
 end
-def neg#1
+def neg
     sane:zpSave()
-    sane:fpOp1(FFEXT|FONEG, stackRegs[0])
+    return sane:zpRestore(sane:fpOp1(FFEXT|FONEG, stackRegs[0]))
-    return sane:zpRestore()
 end
 def abs
     sane:zpSave()
-    sane:fpOp1(FFEXT|FOABS, stackRegs[0])
+    return sane:zpRestore(sane:fpOp1(FFEXT|FOABS, stackRegs[0]))
-    return sane:zpRestore()
+end
+def type
+    sane:zpSave()
+    return sane:zpRestore(sane:fpOp1(FFEXT|FOCLASS, stackRegs[0]))
+end
+def cmp
+    sane:zpSave()
+    return sane:zpRestore(sane:fpOp2(FFEXT|FOCMP, stackRegs[1], stackRegs[0]))
 end
 def trunc
     sane:zpSave()
-    sane:fpOp1(FFEXT|FOTTI, stackRegs[0])
+    return sane:zpRestore(sane:fpOp1(FFEXT|FOTTI, stackRegs[0]))
-    return sane:zpRestore()
 end
 def round
     sane:zpSave()
-    sane:fpOp1(FFEXT|FORTI, stackRegs[0])
+    return sane:zpRestore(sane:fpOp1(FFEXT|FORTI, stackRegs[0]))
-    return sane:zpRestore()
 end
 def sqrt
     sane:zpSave()
-    sane:fpOp1(FFEXT|FOSQRT, stackRegs[0])
+    return sane:zpRestore(sane:fpOp1(FFEXT|FOSQRT, stackRegs[0]))
-    return sane:zpRestore()
 end
-def square
+def squared
     sane:zpSave()
-    sane:fpOp2(FFEXT|FOMUL, stackRegs[0], stackRegs[0])
+    return sane:zpRestore(sane:fpOp2(FFEXT|FOMUL, stackRegs[0], stackRegs[0]))
-    return sane:zpRestore()
+end
+def logb
+    sane:zpSave()
+    return sane:zpRestore(sane:fpOp1(FFEXT|FOLOGB, stackRegs[0]))
+end
+def scalb(scale)
+    sane:zpSave()
+    return sane:zpRestore(sane:fpOp2(FFEXT|FOSCALB, stackRegs[0], scale))
 end
 //
 // Elems operations
 //
 def cos
     sane:zpSave()
-    sane:elOp1(FFEXT|FOCOSX, stackRegs[0])
+    return sane:zpRestore(sane:elOp1(FFEXT|FOCOSX, stackRegs[0]))
-    return sane:zpRestore()
 end
 def sin
     sane:zpSave()
-    sane:elOp1(FFEXT|FOSINX, stackRegs[0])
+    return sane:zpRestore(sane:elOp1(FFEXT|FOSINX, stackRegs[0]))
-    return sane:zpRestore()
 end
 def tan
     sane:zpSave()
-    sane:elOp1(FFEXT|FOTANX, stackRegs[0])
+    return sane:zpRestore(sane:elOp1(FFEXT|FOTANX, stackRegs[0]))
-    return sane:zpRestore()
+end
+def atan
+    sane:zpSave()
+    return sane:zpRestore(sane:elOp1(FFEXT|FOATANX, stackRegs[0]))
+end
+def log2X
+    sane:zpSave()
+    return sane:zpRestore(sane:elOp1(FFEXT|FOLOG2X, stackRegs[0]))
+end
+def log21X
+    sane:zpSave()
+    return sane:zpRestore(sane:elOp1(FFEXT|FOLOG21X, stackRegs[0]))
+end
+def lnX
+    sane:zpSave()
+    return sane:zpRestore(sane:elOp1(FFEXT|FOLNX, stackRegs[0]))
+end
+def ln1X
+    sane:zpSave()
+    return sane:zpRestore(sane:elOp1(FFEXT|FOLN1X, stackRegs[0]))
+end
+def pow2X
+    sane:zpSave()
+    return sane:zpRestore(sane:elOp1(FFEXT|FOEXP2X, stackRegs[0]))
+end
+def pow21X
+    sane:zpSave()
+    return sane:zpRestore(sane:elOp1(FFEXT|FOEXP21X, stackRegs[0]))
+end
+def powEX
+    sane:zpSave()
+    return sane:zpRestore(sane:elOp1(FFEXT|FOEXPX, stackRegs[0]))
+end
+def powE1X
+    sane:zpSave()
+    return sane:zpRestore(sane:elOp1(FFEXT|FOEXP1X, stackRegs[0]))
+end
+def powE21X
+    sane:zpSave()
+    return sane:zpRestore(sane:elOp1(FFEXT|FOEXP21X, stackRegs[0]))
+    end
+def powXInt(powInt)
+    sane:zpSave()
+    return sane:zpRestore(sane:elOp2(FFEXT|FOXPWRI, stackRegs[0], powInt))
+end
+def powXY
+    sane:zpSave()
+    return sane:zpRestore(_drop(_swap(sane:elOp2(FFEXT|FOXPWRY, stackRegs[0], stackRegs[1]))))
+end
+def compXY
+    sane:zpSave()
+    return sane:zpRestore(_drop(_swap(sane:elOp2(FFEXT|FOCOMPND, stackRegs[0], stackRegs[1]))))
+end
+def annuityXY
+    sane:zpSave()
+    return sane:zpRestore(_drop(_swap(sane:elOp2(FFEXT|FOANNUIT, stackRegs[0], stackRegs[1]))))
+end
+def randNum(pSeed)
+    sane:zpSave()
+    return sane:zpRestore(sane:elOp1(FFEXT|FORANDX, pSeed))
 end
 //
 // Push useful constants
@@ -282,57 +360,6 @@ def reset
         stackRegs[i] = @stack[i * t_extended]
         sane:fpOp2(FFINT|FOZ2X, stackRegs[i], @zero)
     next
-    return sane:zpRestore()
+    return sane:zpRestore(0)
 end
 done
-//
-// Test code
-//
-def dumpStack#0
-    byte r
-    byte regStr[16]
-
-    for r = 3 downto 0
-        storStr(@regStr, 6, 4, 1, r)
-        puts("  "); puti(r); putc(':'); puts(@regStr); putln
-    next
-end
-def dumpExt#0
-    byte i
-
-    for i = 0 to t_extended-1
-        putc('$')
-        call($FDDA, stackRegs.[0, i], 0, 0, 0)
-        putc(' ')
-    next
-    putln
-end
-//
-// Run through some test cases
-//
-reset
-dumpStack
-puts("Push 2.0\n")
-pushStr("2.0")
-dumpStack
-puts("Push 4.0\n")
-pushStr("4.0")
-dumpStack
-puts("Add\n")
-add
-dumpStack
-puts("Square\n")
-square
-dumpStack
-puts("Sqrt\n")
-sqrt
-dumpStack
-pushStr("2.71828182845904523536028747")
-dumpExt
-constE
-dumpExt
-pushStr("3.14159265358979323846264338")
-dumpExt
-constPi
-dumpExt
-done

src/libsrc/sane.pla

@@ -509,10 +509,12 @@ asm fixupZPS
         STA     $FFFF,Y
         DEY
         BPL     -
+end
+asm zpNopSave
         DEX
         RTS
 end
-asm zpRestore#1
+asm zpRestore(passthru)#1
         LDY     #$33
 end
 asm fixupZPR
@@ -521,8 +523,7 @@ asm fixupZPR
         DEY
         BPL     -
 end
-asm zpNop#1
+asm zpNopRestore(passthru)#1
-        DEX
         RTS
 end
 asm auxmove(dst, src, len)#0
@@ -579,7 +580,7 @@ end
 // Default HALT handler
 //
 def fpDefaultHalt(pstatus)
-    sane[10]() // zpRestore
+    sane[10](0) // zpRestore
     puts("SANE Exception="); puti(pstatus->8); puts("!\n")
     sane[9]() // zpSave
     return pstatus=>4
@@ -789,8 +790,8 @@ def fpInit()
             sane[3]  = @xfpOp1
             sane[4]  = @xfpOp2
             sane[5]  = @xfpOp3
-            sane[9]  = @zpNop
+            sane[9]  = @zpNopSave
-            sane[10] = @zpNop
+            sane[10] = @zpNopRestore
             //
             // Install AUX HALT handler
             //
@@ -816,8 +817,7 @@ def fpInit()
             // Install MAIN HALT handler
             //
             zpSave()
-            fpOp1($0005, @fpHalt)
+            zpRestore(fpOp1($0005, @fpHalt))
-            zpRestore()
         fin
         sane[6] = @elemsLoad1
         sane[7] = @elemsLoad2
@@ -830,7 +830,7 @@ def fpInit()
     //
     sane[9]()
     sane[3]($0001, $0000)
-    sane[10]()
+    sane[10](0)
 end
 //
 // Uninitialized placeholders of API

src/samplesrc/rpncalc.pla

@@ -2,12 +2,11 @@
 // Desktop RPN calculator
 //
 include "inc/cmdsys.plh"
-include "inc/sane.plh"
 include "inc/fpstr.plh"
 include "inc/fpu.plh"
 include "inc/conio.plh"
 const displayWidth = 16
-const inputLen = displayWidth
+const inputLen = displayWidth+1
 const ZEROSTR = $3001
 //
 // Keypad structure
@@ -24,20 +23,21 @@ struc t_keyinput
 end
 predef delKey#0, cmdKey#0, dropKey#0
 predef digitKey#0, pointKey#0, opKey#0
-predef enterKey#0, chsKey#0, memKey#0
+predef enterKey#0, copyKey#0, chsKey#0, memKey#0
 predef elemsKey#0
 //
 // Current input
 //
-byte inputStr[inputLen+1] = ""
+byte inputStr[32] = ""
 //
 // Display format state
 //
 byte displayFix = 6
+byte displayInt = displayWidth - 8 //  - displayFix - 2
 //
 // Store/load memory
 //
-byte memory[10*t_extended]
+byte memory[10*t_fpureg]
 //
 // Key values
 //
@@ -75,8 +75,8 @@ byte[t_keypad]        = '0',  3, 16, "[0]"
 word                  = @digitKey
 byte[t_keypad]        = '.',  7, 16, "[.]"
 word                  = @pointKey
-byte[t_keypad]        = ';', 11, 16, "[;]"
+byte[t_keypad]        = 'X', 11, 16, "[X]"
-word                  = @chsKey
+word                  = @copyKey
 byte[t_keypad]        = '+', 15, 16, "[+]"
 word                  = @opKey
 byte[t_keypad]        = $0D,  3, 18, "[ENTER]"
@@ -87,13 +87,23 @@ byte[t_keypad]        = '>', 15, 18, "[>]"
 word                  = @memKey
 byte[t_keypad]        = 'R', 3, 20, "[SQ(R)]"
 word                  = @opKey
-byte[t_keypad]        = '^', 11, 20, "[X(^)2]"
+byte[t_keypad]        = 'H', 11, 20, "[C(H)S]"
-word                  = @opKey
+word                  = @chsKey
 byte[t_keypad]        = 'C', 22, 14, "[(C)OS]"
 word                  = @elemsKey
-byte[t_keypad]        = 'S',  30, 14, "[(S)IN]"
+byte[t_keypad]        = 'S', 22, 16, "[(S)IN]"
 word                  = @elemsKey
-byte[t_keypad]        = 'T',  22, 16, "[(T)AN]"
+byte[t_keypad]        = 'T', 22, 18, "[(T)AN]"
+word                  = @elemsKey
+byte[t_keypad]        = 'A', 22, 20, "[(A)TN]"
+word                  = @elemsKey
+byte[t_keypad]        = '^', 30, 14, "[X(^)Y]"
+word                  = @elemsKey
+byte[t_keypad]        = 'L', 30, 16, "[(L)G2]"
+word                  = @elemsKey
+byte[t_keypad]        = 'E', 30, 18, "[(E)^X]"
+word                  = @elemsKey
+byte[t_keypad]        = 'N', 30, 20, "[L(N)X]"
 word                  = @elemsKey
 byte                  = 0
 //
@@ -136,7 +146,7 @@ def showStack#0
     byte strFP[displayWidth+1]
 
     for s = 0 to 3
-        fpu:storStr(@strFP, displayWidth - displayFix - 2, displayFix, FPSTR_FIXED, s)
+        fpu:storStr(@strFP, displayInt, displayFix, FPSTR_FIXED, s)
         conio:gotoxy(4, 5 - s)
         repc(displayWidth - strFP - 1, ' ')
         puts(@strFP)
@@ -147,9 +157,7 @@ def showMem#0
     byte strFP[displayWidth+1]
 
     for m = 0 to 9
-        sane:zpSave()
+        ext2str(@memory[m*t_fpureg], @strFP, displayInt, displayFix, FPSTR_FIXED)
-        ext2str(@memory[m*t_extended], @strFP, displayWidth - displayFix - 2, displayFix, FPSTR_FIXED)
-        sane:zpRestore()
         conio:gotoxy(23, 2 + m)
         repc(displayWidth - strFP - 1, ' ')
         puts(@strFP)
@@ -215,15 +223,15 @@ def initState#0
     // Fill memory
     //
     for m = 2 to 9
-        fpu:storExt(@memory[m*t_extended], X_REG)
+        fpu:storExt(@memory[m*t_fpureg], X_REG)
     next
     //
     // Put some useful constants in there
     //
     fpu:constPi()
-    fpu:pullExt(@memory[0*t_extended])
+    fpu:pullExt(@memory[0*t_fpureg])
     fpu:constE()
-    fpu:pullExt(@memory[1*t_extended])
+    fpu:pullExt(@memory[1*t_fpureg])
 end
 //
 // Keypress input handlers
@@ -232,13 +240,13 @@ def delKey(pkey)#0
     if inputStr
         inputStr--
     fin
-    if inputStr == 1 and inputStr.1 == '-'
+    if inputStr:0 == 1 | ('-' << 8) //inputStr == 1 and inputStr.1 == '-'
         inputStr--
     fin
     showInput
 end
 def dropKey(pkey)#0
-    fpu:pullStr(@inputStr, , displayWidth - displayFix - 1, displayFix, FPSTR_STRIP|FPSTR_FLOAT)
+    fpu:pullStr(@inputStr, displayInt, displayFix, FPSTR_STRIP|FPSTR_FLOAT)
     if inputStr.1 == ' '
         inputStr--
         memcpy(@inputStr.1, @inputStr.2, inputStr)
@@ -246,6 +254,14 @@ def dropKey(pkey)#0
     showInput
     showStack
 end
+def copyKey(pkey)#0
+    fpu:storStr(@inputStr, displayInt, displayFix, FPSTR_STRIP|FPSTR_FLOAT, X_REG)
+    if inputStr.1 == ' '
+        inputStr--
+        memcpy(@inputStr.1, @inputStr.2, inputStr)
+    fin
+    showInput
+end
 def digitKey(pkey)#0
     if inputStr < inputLen
         if inputStr:0 <> ZEROSTR
@@ -278,7 +294,7 @@ def pointKey(pkey)#0
     showInput
 end
 def chsKey(pkey)#0
-    if inputStr and inputStr:0 <> ZEROSTR
+    if inputStr
         if inputStr.1 <> '-'
             memcpy(@inputStr.2, @inputStr.1, inputStr)
             inputStr++
@@ -300,22 +316,19 @@ def opKey(pkey)#0
     updateInput
     when ^pkey
         is '+'
-            fpu:add()
+            fpu:addXY()
             break
         is '-'
-            fpu:sub()
+            fpu:subXY()
             break
         is '*'
-            fpu:mul()
+            fpu:mulXY()
             break
         is '/'
-            fpu:div()
+            fpu:divXY()
-            break
-        is '^'
-            fpu:square()
             break
         is 'R'
-            fpu:sqrt()
+            fpu:sqrtX()
             break
     wend
     showStack
@@ -328,10 +341,10 @@ def memKey(pkey)#0
     clearStatus
     if r >= 0 and r <= 9
         if ^pkey == '<'
-            fpu:pushExt(@memory[r*t_extended])
+            fpu:pushExt(@memory[r*t_fpureg])
             showStack
         else
-            fpu:storExt(@memory[r*t_extended], X_REG)
+            fpu:storExt(@memory[r*t_fpureg], X_REG)
             showMem
         fin
     fin
@@ -340,13 +353,28 @@ def elemsKey(pkey)#0
     updateInput
     when ^pkey
         is 'C'
-            fpu:cos()
+            fpu:cosX()
             break
         is 'S'
-            fpu:sin()
+            fpu:sinX()
             break
         is 'T'
-            fpu:tan()
+            fpu:tanX()
+            break
+        is 'A'
+            fpu:atanX()
+            break
+        is '^'
+            fpu:powXY()
+            break
+        is 'L'
+            fpu:log2X()
+            break
+        is 'E'
+            fpu:powEX()
+            break
+        is 'N'
+            fpu:lnX()
             break
     wend
     showStack
@@ -355,10 +383,18 @@ end
 // Command line handler
 //
 def cmdKey(pkey)#0
-    word cmdLine
+//    word cmdLine
 
-    showStatus("Command")
+//    showStatus("Command")
-    cmdLine = gets(':'|$80)
+//    cmdLine = gets(':'|$80)
+    word d
+
+    showStatus("Press 1-9 for fix point digits:")
+    d = getc - '0'
+    if d >= 1 and d <= 9
+        displayFix = d
+        displayInt = displayWidth - displayFix - 2
+    fin
     clearStatus
     //
     // Do something
@@ -400,6 +436,7 @@ initInput
 showStack
 showMem
 showInput
+showStatus("Version 0.5")
 inputKey
 conio:gotoxy(0, 22)
 done

src/samplesrc/sanity.pla

@@ -138,7 +138,8 @@ def str2ext(str, ext)
         decrec.sig.1 = '0'
     fin
     //putc(decrec.sgn ?? '-' :: '+'); puts(@decrec.sig); putc('e'); puti(decrec:exp); putln
-    return sane:fpOp2(FFEXT|FOD2B, ext, @decrec)
+    sane:zpSave()
+    return sane:zpRestore(sane:fpOp2(FFEXT|FOD2B, ext, @decrec))
 end
 def ext2str(ext, str, intdigits, fracdigits, format)
     byte d, i, sigdigits, numdigits
@@ -149,7 +150,8 @@ def ext2str(ext, str, intdigits, fracdigits, format)
     numdigits = intdigits + fracdigits
     decform:style  = format & $01
     decform:digits = decform:style ?? fracdigits :: numdigits
-    sane:fpOp3(FFEXT|FOB2D, @decrec, ext, @decform)
+    sane:zpSave()
+    sane:zpRestore(sane:fpOp3(FFEXT|FOB2D, @decrec, ext, @decform))
     ^(str+1) = decrec.sgn ?? '-' :: ' '
     if decrec.sig.1 == 'I'
         ^(str+2) = 'I'
@@ -183,10 +185,8 @@ def ext2str(ext, str, intdigits, fracdigits, format)
             decrec:exp++
         loop
     fin
-    //sane:zpRestore()
     //puts("sigdigits: "); puti(sigdigits); putln
     //putc(decrec.sgn ?? '-' :: '+'); puts(@decrec.sig); putc('e'); puti(decrec:exp); putln
-    //sane:zpSave()
     //if sigdigits - decrec:exp > numdigits or decrec:exp > 0 or format & $04
     if -decrec:exp > numdigits or decrec:exp > 0 or format & $04
         //
@@ -268,18 +268,18 @@ def divstri(strNum, denom, format)#0
     //
     // Convert string to and from SANE
     //
-    sane:zpSave()
     str2ext(strNum, @xResult)
+    sane:zpSave()
     sane:fpOp2(FFINT|FODIV, @xResult, @denom) // Div int denom into ext Result
+    sane:zpRestore(0)
     ext2str(@xResult, @strResult, 6, 4, format)//format & $05 ?? 1 :: 6, 4, format)
-    sane:zpRestore()
     puts(strNum); putc('/'); puti(denom); putc('='); puts(@strResult); putln
 end
 //
 // My custom SANE exception handler
 //
 def myException(pstatus)
-    sane:zpRestore()
+    sane:zpRestore(0)
     puts("Floating point exception:")
     if pstatus->8 & FBINVALID; puts(" INVALID"); fin
     if pstatus->8 & FBUFLOW;   puts(" UNDERFLOW"); fin
@@ -302,25 +302,25 @@ sane:zpSave()
 sane:fpOp2(FFINT|FOZ2X, @xT, @iA) // Convert int A to ext T
 sane:fpOp2(FFINT|FOADD, @xT, @iB) // Add int B to ext T
 sane:fpOp2(FFINT|FOX2Z, @iC, @xT) // Convert ext T to int C
-sane:zpRestore()
+sane:zpRestore(0)
 puti(iA); putc('+'); puti(iB); putc('='); puti(iC); putc('\n')
 sane:zpSave()
 sane:fpOp2(FFINT|FOZ2X, @xT, @iA) // Convert int A to ext T
 sane:fpOp2(FFINT|FOSUB, @xT, @iB) // Sub int B from ext T
 sane:fpOp2(FFINT|FOX2Z, @iC, @xT) // Convert ext T to int C
-sane:zpRestore()
+sane:zpRestore(0)
 puti(iA); putc('-'); puti(iB); putc('='); puti(iC); putc('\n')
 sane:zpSave()
 sane:fpOp2(FFINT|FOZ2X, @xT, @iA) // Convert int A to ext T
 sane:fpOp2(FFINT|FOMUL, @xT, @iB) // Mul int B by ext T
 sane:fpOp2(FFINT|FOX2Z, @iC, @xT) // Convert ext T to int C
-sane:zpRestore()
+sane:zpRestore(0)
 puti(iA); putc('*'); puti(iB); putc('='); puti(iC); putc('\n')
 sane:zpSave()
 sane:fpOp2(FFINT|FOZ2X, @xT, @iA) // Convert int A to ext T
 sane:fpOp2(FFINT|FODIV, @xT, @iB) // Div int B into ext T
 sane:fpOp2(FFINT|FOX2Z, @iC, @xT) // Convert ext T to int C
-sane:zpRestore()
+sane:zpRestore(0)
 puti(iA); putc('/'); puti(iB); putc('='); puti(iC); putc('\n')
 //
 // Hook custom HALT exception handler and divide by zero :-)
@@ -330,7 +330,7 @@ sane:zpSave()
 sane:fpHalt = @myException
 fpEnv = sane:fpOp0(FOGETENV)
 sane:fpOp1(FOSETENV, fpEnv | FBINVALID | FBUFLOW | FBOFLOW | FBDIVZER | FBINEXACT)
-sane:zpRestore()
+sane:zpRestore(0)
 //
 // String conversion tests
 //