mirror of
https://github.com/dschmenk/PLASMA.git
synced 2025-08-07 02:26:23 +00:00
329 lines
8.1 KiB
Plaintext
329 lines
8.1 KiB
Plaintext
//
|
|
// SANE library test program
|
|
//
|
|
include "inc/cmdsys.plh"
|
|
include "inc/sane.plh"
|
|
struc t_decrecord
|
|
word sgn
|
|
word exp
|
|
byte sig[29]
|
|
end
|
|
struc t_decformat
|
|
word style
|
|
word digits
|
|
end
|
|
//
|
|
// Test values
|
|
//
|
|
word iA, iB, iC, zero, fpEnv
|
|
byte xT[t_extended]
|
|
byte strNum = "-100.25"
|
|
byte strA[16]
|
|
//
|
|
// Parse string into decrecord
|
|
//
|
|
def str2ext(str, ext)
|
|
byte i, s, d
|
|
byte decrec[t_decrecord]
|
|
word sgnadj, expadj
|
|
|
|
decrec:sgn = 0
|
|
decrec:exp = 0
|
|
decrec.sig = 0
|
|
s = 1
|
|
i = 1
|
|
//
|
|
// Skip whitespace
|
|
//
|
|
while ^(str+i) <= ' ' and i <= ^str; i++; loop
|
|
//
|
|
// Check for sign
|
|
//
|
|
if ^(str+i) == '-'
|
|
decrec:sgn = 1
|
|
i++
|
|
elsif ^(str+i) == '+'
|
|
i++
|
|
fin
|
|
//
|
|
// Skip leading zeros
|
|
//
|
|
while i <= ^str and ^(str+i) == '0'
|
|
i++
|
|
loop
|
|
//
|
|
// Parse number
|
|
//
|
|
while i <= ^str
|
|
d = toupper(^(str+i))
|
|
if d >= '0' and d <= '9'
|
|
//
|
|
// Parse digit
|
|
//
|
|
decrec.sig[s] = ^(str+i)
|
|
decrec:sig++
|
|
s++
|
|
elsif d == '.'
|
|
//
|
|
// Parse decimal point
|
|
//
|
|
i++
|
|
while i <= ^str
|
|
d = toupper(^(str+i))
|
|
if d >= '0' and d <= '9'
|
|
decrec.sig[s] = ^(str+i)
|
|
decrec.sig++
|
|
decrec:exp--
|
|
s++
|
|
elsif d == 'E'
|
|
i--
|
|
break
|
|
else
|
|
i = ^str
|
|
fin
|
|
i++
|
|
loop
|
|
elsif d == 'E'
|
|
//
|
|
// Parse exponent
|
|
//
|
|
i++
|
|
expadj = 0
|
|
sgnadj = 1
|
|
if ^(str+i) == '-'
|
|
sgnadj = -1
|
|
i++
|
|
elsif ^(str+i) == '+'
|
|
i++
|
|
fin
|
|
while i <= ^str
|
|
d = ^(str+i)
|
|
i++
|
|
if d >= '0' and d <= '9'
|
|
expadj = expadj * 10 + (d - '0')
|
|
else
|
|
i = ^str
|
|
fin
|
|
loop
|
|
decrec:exp = decrec:exp + (sgnadj * expadj)
|
|
else
|
|
i = ^str
|
|
fin
|
|
i++
|
|
loop
|
|
//
|
|
// Strip leading zeros from sig
|
|
//
|
|
while decrec.sig > 1 and decrec.sig.1 == '0'
|
|
decrec.sig--
|
|
if decrec:exp < 0
|
|
decrec:exp--
|
|
fin
|
|
memcpy(@decrec.sig.1, @decrec.sig.2, decrec.sig)
|
|
loop
|
|
//
|
|
// Check for zero
|
|
//
|
|
if !decrec.sig
|
|
decrec.sig = 1
|
|
decrec.sig.1 = '0'
|
|
fin
|
|
//putc(decrec.sgn ?? '-' :: '+'); puts(@decrec.sig); putc('e'); puti(decrec:exp); putln
|
|
return sane:fpOp2(FFEXT|FOD2B, ext, @decrec)
|
|
end
|
|
def ext2str(ext, str, numdigits, expformat)
|
|
byte d, i, sigdigits
|
|
word dp, tens
|
|
byte decform[t_decformat]
|
|
byte decrec[t_decrecord]
|
|
|
|
decform:style = 0
|
|
decform:digits = numdigits
|
|
sane:fpOp3(FFEXT|FOB2D, @decrec, ext, @decform)
|
|
^(str+1) = decrec.sgn ?? '-' :: ' '
|
|
if decrec.sig.1 == 'I'
|
|
^(str+2) = 'I'
|
|
^(str+3) = 'n'
|
|
^(str+4) = 'f'
|
|
^str = 4
|
|
return str
|
|
fin
|
|
if decrec.sig.1 == 'N'
|
|
^(str+2) = 'N'
|
|
^(str+3) = 'a'
|
|
^(str+4) = 'N'
|
|
^str = 4
|
|
return str
|
|
fin
|
|
if decrec.sig.1 == '0'
|
|
decrec:exp = -decrec.sig
|
|
fin
|
|
dp = decrec.sig + decrec:exp
|
|
sigdigits = decrec.sig
|
|
//putc(decrec.sgn ?? '-' :: '+'); puts(@decrec.sig); putc('e'); puti(decrec:exp); putln
|
|
if decrec:exp < 0
|
|
//
|
|
// Strip off trailing fractional zeros
|
|
//
|
|
while sigdigits > dp and decrec.sig[sigdigits] == '0'
|
|
sigdigits--
|
|
loop
|
|
fin
|
|
//puts("sigdigits: "); puti(sigdigits); putln
|
|
if (decrec:exp + (decrec.sig - sigdigits)) < -numdigits or decrec:exp > 0 or expformat
|
|
//
|
|
// Convert to exponential format
|
|
//
|
|
^(str+2) = decrec.sig.1
|
|
^(str+3) = '.'
|
|
i = 3
|
|
for d = 2 to decrec.sig
|
|
i++
|
|
^(str+i) = decrec.sig[d]
|
|
next
|
|
//
|
|
// Copy over all significant digits
|
|
//
|
|
if ^(str+i) == '.'; i--; fin
|
|
i++
|
|
^(str+i) = 'E'
|
|
i++
|
|
dp--
|
|
if dp < 0
|
|
^(str+i) = '-'
|
|
dp = -dp
|
|
else
|
|
^(str+i) = '+'
|
|
if dp == 0
|
|
i++
|
|
^(str+i) = '0'
|
|
fin
|
|
fin
|
|
//
|
|
// Pretty output the exponent (preceding zero for values less than 10)
|
|
d = 0
|
|
tens = 10000
|
|
while dp
|
|
d = d or tens <= 10
|
|
if dp >= tens or d
|
|
d = 1
|
|
i++
|
|
^(str+i) = (dp / tens) + '0'
|
|
fin
|
|
dp = dp % tens
|
|
tens = tens / 10
|
|
if !tens; break; fin
|
|
loop
|
|
//puts("DP=");puti(dp);puts(" digits="); puti(decrec.sig); puts(" exp="); puti(decrec:exp); putln
|
|
else
|
|
//
|
|
// Convert as floating point
|
|
//
|
|
//puts("DP=");puti(dp);puts(" digits="); puti(decrec.sig); puts(" exp="); puti(decrec:exp); putln
|
|
i = 1
|
|
if dp <= 0
|
|
*(str+2) = '0'|('.'<<8)
|
|
i = 3
|
|
while dp < 0
|
|
dp++
|
|
i++
|
|
^(str+i) = '0'
|
|
loop
|
|
fin
|
|
for d = 1 to sigdigits
|
|
i++
|
|
^(str+i) = decrec.sig[d]
|
|
if d == dp
|
|
i++
|
|
^(str+i) = '.'
|
|
fin
|
|
next
|
|
if ^(str+i) == '.'; i--; fin
|
|
fin
|
|
^str = i
|
|
return str
|
|
end
|
|
def divstri(strNum, denom, expformat)#0
|
|
byte strResult[20]
|
|
byte xResult[t_extended]
|
|
|
|
//
|
|
// Convert string to and from SANE
|
|
//
|
|
sane:zpSave()
|
|
str2ext(strNum, @xResult)
|
|
sane:fpOp2(FFINT|FODIV, @xResult, @denom) // Div int denom into ext Result
|
|
ext2str(@xResult, @strResult, 6, expformat)
|
|
sane:zpRestore()
|
|
puts(strNum); putc('/'); puti(denom); putc('='); puts(@strResult); putln
|
|
end
|
|
//
|
|
// My custom SANE exception handler
|
|
//
|
|
def myException(pstatus)
|
|
sane:zpRestore()
|
|
puts("Floating point exception:")
|
|
if pstatus->8 & FBINVALID; puts(" INVALID"); fin
|
|
if pstatus->8 & FBUFLOW; puts(" UNDERFLOW"); fin
|
|
if pstatus->8 & FBOFLOW; puts(" OVERFLOW"); fin
|
|
if pstatus->8 & FBDIVZER; puts(" DIV_BY_ZERO"); fin
|
|
if pstatus->8 & FBINEXACT; puts(" INEXACT"); fin
|
|
putln
|
|
sane:zpSave()
|
|
return pstatus=>4
|
|
end
|
|
|
|
|
|
iA = 3
|
|
iB = 4
|
|
iC = -1
|
|
zero = 0
|
|
puts("SANE sanity test...\n")
|
|
sane.fpInit()
|
|
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()
|
|
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()
|
|
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()
|
|
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()
|
|
puti(iA); putc('/'); puti(iB); putc('='); puti(iC); putc('\n')
|
|
//
|
|
// Hook custom HALT exception handler and divide by zero :-)
|
|
// Enable all exceptions
|
|
//
|
|
sane:zpSave()
|
|
sane:fpHalt = @myException
|
|
fpEnv = sane:fpOp0(FOGETENV)
|
|
sane:fpOp1(FOSETENV, fpEnv | FBINVALID | FBUFLOW | FBOFLOW | FBDIVZER | FBINEXACT)
|
|
sane:zpRestore()
|
|
//
|
|
// String conversion tests
|
|
//
|
|
divstri("-3", 0, 0)
|
|
divstri("3", 0, 0)
|
|
divstri("-100.5", 4, 0)
|
|
divstri("00.5", 2, 0)
|
|
divstri(".5", 10, 0)
|
|
divstri("800000", 2, 0)
|
|
divstri("800000", 2, 1)
|
|
divstri("1e+2", 2, 0)
|
|
divstri("-1e-2", 2, 0)
|
|
done
|