mirror of
https://github.com/dschmenk/PLASMA.git
synced 2025-04-05 03:37:43 +00:00
SANE working!
This commit is contained in:
David Schmenk
parent
c9b05f20d1
commit
7a8b754794
135
src/inc/sane.plh
Normal file
135
src/inc/sane.plh
Normal file
@ -0,0 +1,135 @@
|
||||
import sane
|
||||
//-----------------------------------------------------------
|
||||
// Operation code masks.
|
||||
//-----------------------------------------------------------
|
||||
const FOADD = $0000 // add
|
||||
const FOSUB = $0002 // subtract
|
||||
const FOMUL = $0004 // multiply
|
||||
const FODIV = $0006 // divide
|
||||
const FOCMP = $0008 // compare, no exception from unordered
|
||||
const FOCPX = $000A // compare, signal invalid if unordered
|
||||
const FOREM = $000C // remainder
|
||||
const FOZ2X = $000E // convert to extended
|
||||
const FOX2Z = $0010 // convert from extended
|
||||
const FOSQRT = $0012 // square root
|
||||
const FORTI = $0014 // round to integral value
|
||||
const FOTTI = $0016 // truncate to integral value
|
||||
const FOSCALB = $0018 // binary scale
|
||||
const FOLOGB = $001A // binary log
|
||||
const FOCLASS = $001C // classify
|
||||
const FONEXT = $001E // next-after
|
||||
//
|
||||
const FOSETENV = $0001 // set environment
|
||||
const FOGETENV = $0003 // get environment
|
||||
const FOSETHV = $0005 // set halt vector
|
||||
const FOGETHV = $0007 // get halt vector
|
||||
const FOD2B = $0009 // convert decimal to binary
|
||||
const FOB2D = $000B // convert binary to decimal
|
||||
const FONEG = $000D // negate
|
||||
const FOABS = $000F // absolute value
|
||||
const FOCPYSGN = $0011 // copy sign
|
||||
// UNDEFINED = $0013
|
||||
const FOSETXCP = $0015 // set exception
|
||||
const FOPROCENTRY = $0017 // procedure-entry
|
||||
const FOPROCEXIT = $0019 // procedure-exit
|
||||
const FOTESTXCP = $001B // test exception
|
||||
// UNDEFINED = $001D
|
||||
// UNDEFINED = $001F
|
||||
//-----------------------------------------------------------
|
||||
// Operand format masks.
|
||||
//-----------------------------------------------------------
|
||||
const FFEXT = $0000 // extended -- 80-bit float
|
||||
const FFDBL = $0100 // double -- 64-bit float
|
||||
const FFSGL = $0200 // single -- 32-bit float
|
||||
// UNDEFINED = $0300
|
||||
const FFINT = $0400 // integer -- 16-bit integer
|
||||
const FFCOMP = $0500 // comp -- 64-bit integer
|
||||
// UNDEFINED = $0600
|
||||
// UNDEFINED = $0700
|
||||
//-----------------------------------------------------------
|
||||
// Class.
|
||||
//-----------------------------------------------------------
|
||||
const FCSNAN = $FC // -4: signaling NAN
|
||||
const FCQNAN = $FD // -3: quiet NAN
|
||||
const FCINF = $FE // -2: infinite
|
||||
const FCZERO = $FF // -1: zero
|
||||
const FCNORM = $00 // 0: normal
|
||||
const FCDENORM = $01 // 1: denormal
|
||||
//-----------------------------------------------------------
|
||||
// Exceptions.
|
||||
//-----------------------------------------------------------
|
||||
const FBINVALID = $01
|
||||
const FBUFLOW = $02
|
||||
const FBOFLOW = $04
|
||||
const FBDIVZER = $08
|
||||
const FBINEXACT = $10
|
||||
//-----------------------------------------------------------
|
||||
// Elementary function operation code masks.
|
||||
//-----------------------------------------------------------
|
||||
const FOLNX = $0000 // base-e log
|
||||
const FOLOG2X = $0002 // base-2 log
|
||||
const FOLN1X = $0004 // ln (1 + x)
|
||||
const FOLOG21X = $0006 // log2 (1 + x)
|
||||
const FOEXPX = $0008 // base-e exponential
|
||||
const FOEXP2X = $000A // base-2 exponential
|
||||
const FOEXP1X = $000C // exp (x) - 1
|
||||
const FOEXP21X = $000E // exp2 (x) - 1
|
||||
const FOXPWRI = $0010 // integer exponentiation
|
||||
const FOXPWRY = $0012 // general exponentiation
|
||||
const FOCOMPND = $0014 // compound
|
||||
const FOANNUIT = $0016 // annuity
|
||||
const FOATANX = $0018 // arctangent
|
||||
const FOSINX = $001A // sine
|
||||
const FOCOSX = $001C // cosine
|
||||
const FOTANX = $001E // tangent
|
||||
const FORANDX = $0020 // random
|
||||
//-----------------------------------------------------------
|
||||
// NaN error codes.
|
||||
//-----------------------------------------------------------
|
||||
const NANSQRT = 1 // Invalid square root such as sqrt(-1).
|
||||
const NANADD = 2 // Invalid addition such as +INF - +INF.
|
||||
const NANDIV = 4 // Invalid division such as 0/0.
|
||||
const NANMUL = 8 // Invalid multiply such as 0 * INF.
|
||||
const NANREM = 9 // Invalid remainder or mod such as x REM 0.
|
||||
const NANASCBIN = 17 // Attempt to convert invalid ASCII string.
|
||||
const NANCOMP = 20 // Result of converting comp NaN to floating.
|
||||
const NANZERO = 21 // Attempt to create a NaN with a zero code.
|
||||
const NANTRIG = 33 // Invalid argument to trig routine.
|
||||
const NANINVTRIG = 34 // Invalid argument to inverse trig routine.
|
||||
const NANLOG = 36 // Invalid argument to log routine.
|
||||
const NANPOWER = 37 // Invalid argument to x^i or x^y routine.
|
||||
const NANFINAN = 38 // Invalid argument to financial function.
|
||||
const NANINIT = 255 // Uninitialized storage.
|
||||
//-----------------------------------------------------------
|
||||
//
|
||||
// Data types
|
||||
//
|
||||
struc t_single
|
||||
byte[3] s_mantissa
|
||||
byte s_exponent
|
||||
end
|
||||
struc t_double
|
||||
byte[6] d_mantissa
|
||||
word d_exponent
|
||||
end
|
||||
struc t_extended
|
||||
byte[8] x_mantissa
|
||||
word x_exponent
|
||||
end
|
||||
struc t_bigint
|
||||
byte[8] l_int
|
||||
end
|
||||
//
|
||||
// SANE PLASMA interface
|
||||
//
|
||||
struc t_sane
|
||||
word fpInit
|
||||
word fpOp1
|
||||
word fpOp2
|
||||
word elOp1
|
||||
word elOp2
|
||||
word zpSave
|
||||
word zpRestore
|
||||
end
|
||||
word sane
|
||||
end
|
||||
@ -12,17 +12,21 @@ struc t_codefile
|
||||
word[16] textaddr
|
||||
word[16] seginfo
|
||||
end
|
||||
|
||||
export word[64] sane
|
||||
byte ref
|
||||
word pcode, fp6502, elems, preloc
|
||||
|
||||
asm equates
|
||||
!SOURCE "vmsrc/plvmzp.inc"
|
||||
end
|
||||
//
|
||||
// External interface to SANE libraries
|
||||
//
|
||||
predef fpInit(), uninit0(), uninit1(op, dst), uninit2(op, dst, src)
|
||||
export word[7] sane = @fpInit, @uninit1, @uninit2, @uninit1, @uninit2, @uninit0, @uninit0
|
||||
//
|
||||
// Pointer to FP6502 entry
|
||||
//
|
||||
word fp6502, fpzpsave
|
||||
//
|
||||
// PLASMA <-> SANE interface routines
|
||||
//
|
||||
asm equates
|
||||
!SOURCE "vmsrc/plvmzp.inc"
|
||||
end
|
||||
asm fpOp1(op, dst)#1
|
||||
LDA ESTKH,X
|
||||
PHA
|
||||
@ -43,7 +47,7 @@ asm fixupFP1
|
||||
STY ESTKH,X
|
||||
RTS
|
||||
end
|
||||
asm fpOp2(op1, dst, src)#1
|
||||
asm fpOp2(op, dst, src)#1
|
||||
LDA ESTKH,X
|
||||
PHA
|
||||
LDA ESTKL,X
|
||||
@ -68,154 +72,274 @@ asm fixupFP2
|
||||
STY ESTKH,X
|
||||
RTS
|
||||
end
|
||||
def prbyte(h)#0
|
||||
putc('$')
|
||||
call($FDDA, h, 0, 0, 0)
|
||||
asm elemsOp1(op, dst)#1
|
||||
LDA ESTKH,X
|
||||
PHA
|
||||
LDA ESTKL,X
|
||||
PHA
|
||||
LDA ESTKH+1,X
|
||||
PHA
|
||||
LDA ESTKL+1,X
|
||||
PHA
|
||||
INX
|
||||
STX ESP
|
||||
end
|
||||
asm fixupEL1
|
||||
JSR $FFFF
|
||||
TXA
|
||||
LDX ESP
|
||||
STA ESTKL,X
|
||||
STY ESTKH,X
|
||||
RTS
|
||||
end
|
||||
asm elemsOp2(op, dst, src)#1
|
||||
LDA ESTKH,X
|
||||
PHA
|
||||
LDA ESTKL,X
|
||||
PHA
|
||||
LDA ESTKH+1,X
|
||||
PHA
|
||||
LDA ESTKL+1,X
|
||||
PHA
|
||||
LDA ESTKH+2,X
|
||||
PHA
|
||||
LDA ESTKL+2,X
|
||||
PHA
|
||||
INX
|
||||
INX
|
||||
STX ESP
|
||||
end
|
||||
asm fixupEL2
|
||||
JSR $FFFF
|
||||
TXA
|
||||
LDX ESP
|
||||
STA ESTKL,X
|
||||
STY ESTKH,X
|
||||
RTS
|
||||
end
|
||||
asm zpSave#1
|
||||
LDY #$33
|
||||
- LDA $00,Y
|
||||
end
|
||||
asm fixupZPS
|
||||
STA $FFFF,Y
|
||||
DEY
|
||||
BPL -
|
||||
DEX
|
||||
RTS
|
||||
end
|
||||
asm zpRestore#1
|
||||
LDY #$33
|
||||
end
|
||||
asm fixupZPR
|
||||
- LDA $FFFF,Y
|
||||
STA $00,Y
|
||||
DEY
|
||||
BPL -
|
||||
end
|
||||
asm nopZP#1
|
||||
DEX
|
||||
RTS
|
||||
end
|
||||
//
|
||||
// Utility test routines
|
||||
//
|
||||
//def prbyte(h)#0
|
||||
// putc('$')
|
||||
// call($FDDA, h, 0, 0, 0)
|
||||
//end
|
||||
def prword(h)#0
|
||||
putc('$')
|
||||
call($F941, h >> 8, h, 0, 0)
|
||||
end
|
||||
def print(i)#0
|
||||
byte numstr[7]
|
||||
byte place, sign
|
||||
//def putname(pchr)#0
|
||||
// byte c
|
||||
//
|
||||
// for c = 0 to 7
|
||||
// putc(pchr->[c])
|
||||
// next
|
||||
//end
|
||||
//def putln#0
|
||||
// putc('\n')
|
||||
//end
|
||||
//def dumpheader(phdr)#0
|
||||
// byte i
|
||||
//
|
||||
// puts("Seg Info\n")
|
||||
// for i = 0 to 15
|
||||
// if (phdr + i * t_diskinfo)=>codelen
|
||||
// prword((phdr + i * t_diskinfo)=>codelen)
|
||||
// putc(':')
|
||||
// prword((phdr + i * t_diskinfo)=>codeaddr)
|
||||
// putc('=')
|
||||
// putname(phdr + i * 8 + segname)
|
||||
// putc(',')
|
||||
// prword((phdr + segkind)=>[i])
|
||||
// putc(',')
|
||||
// prword((phdr + textaddr)=>[i])
|
||||
// putc(',')
|
||||
// prword((phdr + seginfo)=>[i])
|
||||
// putln
|
||||
// fin
|
||||
// next
|
||||
// putname(phdr + $01F4); putln
|
||||
//end
|
||||
//
|
||||
// Fix-up external references and local relocations
|
||||
//
|
||||
def fixup(base, list)
|
||||
word len
|
||||
byte listcnt
|
||||
|
||||
place = 6
|
||||
if i < 0
|
||||
sign = 1
|
||||
i = -i
|
||||
else
|
||||
sign = 0
|
||||
//puts("Reloc = "); prword(list); putln
|
||||
if *list <> $0101
|
||||
//puts("Reloc table not found!\n")
|
||||
return list
|
||||
fin
|
||||
while i >= 10
|
||||
numstr[place] = i % 10 + '0'
|
||||
i = i / 10
|
||||
place = place - 1
|
||||
list = list - 10
|
||||
//
|
||||
// External reference fixup (only have fp6502 in our case)
|
||||
//
|
||||
len = *list
|
||||
list = list - 2
|
||||
//puts("Extern list len = "); prword(len); putln; getc
|
||||
while len
|
||||
//puts(" *"); prword(list - *list); putln
|
||||
*(list - *list) = fp6502
|
||||
list = list - 2
|
||||
len--
|
||||
loop
|
||||
numstr[place] = i + '0'
|
||||
place = place - 1
|
||||
if sign
|
||||
numstr[place] = '-'
|
||||
place = place - 1
|
||||
fin
|
||||
numstr[place] = 6 - place
|
||||
puts(@numstr[place])
|
||||
end
|
||||
def putname(pchr)#0
|
||||
byte c
|
||||
|
||||
for c = 0 to 7
|
||||
putc(pchr->[c])
|
||||
next
|
||||
end
|
||||
def putln#0
|
||||
putc('\n')
|
||||
end
|
||||
def dumpheader(phdr)#0
|
||||
byte i
|
||||
|
||||
puts("Seg Info\n")
|
||||
for i = 0 to 15
|
||||
if (phdr + i * t_diskinfo)=>codelen
|
||||
prword((phdr + i * t_diskinfo)=>codelen)
|
||||
putc(':')
|
||||
prword((phdr + i * t_diskinfo)=>codeaddr)
|
||||
putc('=')
|
||||
putname(phdr + i * 8 + segname)
|
||||
putc(',')
|
||||
prword((phdr + segkind)=>[i])
|
||||
putc(',')
|
||||
prword((phdr + textaddr)=>[i])
|
||||
putc(',')
|
||||
prword((phdr + seginfo)=>[i])
|
||||
putln
|
||||
fin
|
||||
next
|
||||
putname(phdr + $01F4); putln
|
||||
end
|
||||
def reloc(base, prel, ofst)
|
||||
word listsz, list, len
|
||||
|
||||
list = prel
|
||||
while prel->1 == 1
|
||||
prel = prel - 2
|
||||
listsz = *prel
|
||||
while listsz
|
||||
prel = prel - 2
|
||||
if *prel
|
||||
list = base + *prel - ofst
|
||||
len = *list
|
||||
list = list - 2
|
||||
puts("Reloc list len = "); prword(len); putln
|
||||
while len
|
||||
*(list - *list) = *(list - *list) + base
|
||||
list = list - 2
|
||||
len--
|
||||
loop
|
||||
fin
|
||||
listsz--
|
||||
loop
|
||||
//
|
||||
// Internal relocation
|
||||
//
|
||||
len = *list
|
||||
list = list - 2
|
||||
//puts("Reloc list len = "); prword(len); putln; getc
|
||||
while len
|
||||
//puts(" *"); prword(list - *list); putln
|
||||
*(list - *list) = *(list - *list) + base
|
||||
list = list - 2
|
||||
len--
|
||||
loop
|
||||
return list
|
||||
end
|
||||
def fixup(base, pli, preloc)
|
||||
byte fixups
|
||||
word basend
|
||||
|
||||
puts("LinkInfo "); prword(pli); putc(':'); putln
|
||||
basend = preloc
|
||||
while ^pli
|
||||
putname(pli); putc(':')
|
||||
prword(pli=>8); putc(' ')
|
||||
prword(pli=>10); putc(' ')
|
||||
prword(pli=>12); putc(' ')
|
||||
prword(pli=>14); putln
|
||||
fixups = 0
|
||||
if pli=>8 == $0002
|
||||
fixups = pli=>12
|
||||
elsif pli=>8 == $0006 and pli=>10 == $0001
|
||||
basend = reloc(base, preloc, pli=>12)
|
||||
fin
|
||||
pli = pli + 16
|
||||
while fixups
|
||||
*(base + *pli) = fp6502
|
||||
pli = pli + 2
|
||||
fixups--
|
||||
loop
|
||||
loop
|
||||
end
|
||||
//
|
||||
// Linker Information that we don't need
|
||||
//
|
||||
//def resolve(base, pli)
|
||||
// byte fixups
|
||||
// word basend
|
||||
//
|
||||
// puts("LinkInfo "); prword(pli); putc(':'); putln
|
||||
// basend = preloc
|
||||
// while ^pli
|
||||
// putname(pli); putc(':')
|
||||
// prword(pli=>8); putc(' ')
|
||||
// prword(pli=>10); putc(' ')
|
||||
// prword(pli=>12); putc(' ')
|
||||
// prword(pli=>14); putln
|
||||
// fixups = 0
|
||||
// if pli=>8 == $0002
|
||||
// fixups = pli=>12
|
||||
// fin
|
||||
// pli = pli + 16
|
||||
// while fixups
|
||||
// *(base + *pli) = fp6502
|
||||
// pli = pli + 2
|
||||
// fixups--
|
||||
// loop
|
||||
// loop
|
||||
//end
|
||||
//
|
||||
// Load Pascal CODE file
|
||||
//
|
||||
def loadcode(codefile)
|
||||
byte ref
|
||||
word pcode, preloc, pli
|
||||
word pcode, seglen
|
||||
|
||||
puts(codefile); puts(":\n")
|
||||
//puts(codefile); puts(":\n")
|
||||
pcode = 0
|
||||
ref = open(codefile, sysbuf)
|
||||
if ref
|
||||
pcode = heapmark
|
||||
read(ref, pcode, 512)
|
||||
dumpheader(pcode)
|
||||
putname(pcode + segname + 8); putc('='); prword(pcode); putln
|
||||
preloc = (pcode + t_diskinfo)=>codeaddr
|
||||
read(ref, pcode, heapavail)
|
||||
//dumpheader(pcode)
|
||||
//putname(pcode + segname + 8); putc('='); prword(pcode); putln
|
||||
seglen = read(ref, pcode, (pcode + t_diskinfo)=>codeaddr)
|
||||
close(ref)
|
||||
pli = pcode + (preloc | 511) + 1
|
||||
preloc = pcode + preloc - 2
|
||||
puts("Reloc = "); prword(preloc); putln
|
||||
heaprelease(fixup(pcode, pli, preloc)) // Set heap to beginning of relocation list
|
||||
heaprelease(fixup(pcode, pcode + seglen - 2)) // Set heap to beginning of relocation list
|
||||
fin
|
||||
return pcode
|
||||
end
|
||||
fp6502 = loadcode("FP6502.CODE")
|
||||
if !fp6502
|
||||
puts("SANE library not found.\n")
|
||||
//
|
||||
// Load ELEMS6502 library
|
||||
//
|
||||
def loadElems
|
||||
word elems
|
||||
|
||||
elems = loadcode("ELEMS.CODE")
|
||||
if !elems
|
||||
puts("ELEMS library not found.\n")
|
||||
return 0
|
||||
fin
|
||||
(@fixupEL1)=>1 = elems
|
||||
(@fixupEL2)=>1 = elems
|
||||
sane[3] = @elemsOp1
|
||||
sane[4] = @elemsOp2
|
||||
return 1
|
||||
end
|
||||
//
|
||||
// Don't load ELEMS6502 until referenced
|
||||
//
|
||||
def elemsLoad1(op, dst)#1
|
||||
if loadElems
|
||||
return elemsOp1(op, dst)
|
||||
fin
|
||||
return -1
|
||||
fin
|
||||
elems = loadcode("ELEMS.CODE")
|
||||
if !elems
|
||||
puts("ELEMS library not found.\n")
|
||||
end
|
||||
def elemsLoad2(op, src, dst)#1
|
||||
if loadElems
|
||||
return elemsOp2(op, src, dst)
|
||||
fin
|
||||
return -1
|
||||
fin
|
||||
call(-151, 0, 0, 0, 0)
|
||||
return 0
|
||||
end
|
||||
//
|
||||
// Load SANE library and fixup function pointers
|
||||
//
|
||||
def fpInit()
|
||||
fp6502 = loadcode("FP6502.CODE")
|
||||
if !fp6502
|
||||
puts("SANE library not found.\n")
|
||||
return -1
|
||||
fin
|
||||
fpzpsave = heapalloc($0033)
|
||||
//
|
||||
// Fixup calls in interface routines
|
||||
//
|
||||
(@fixupFP1)=>1 = fp6502
|
||||
(@fixupFP2)=>1 = fp6502
|
||||
(@fixupZPS)=>1 = fpzpsave
|
||||
(@fixupZPR)=>1 = fpzpsave
|
||||
sane[1] = @fpOp1
|
||||
sane[2] = @fpOp2
|
||||
sane[3] = @elemsLoad1
|
||||
sane[4] = @elemsLoad2
|
||||
sane[5] = @zpSave
|
||||
sane[6] = @zpRestore
|
||||
end
|
||||
//
|
||||
// Uninitialized placeholders of API
|
||||
//
|
||||
def uninit0()
|
||||
puts("SANE not initialized\n")
|
||||
return -1
|
||||
end
|
||||
def uninit1(op, dst)
|
||||
puts("SANE not initialized\n")
|
||||
return -1
|
||||
end
|
||||
def uninit2(op, dst, src)
|
||||
puts("SANE not initialized\n")
|
||||
return -1
|
||||
end
|
||||
done
|
||||
|
||||
@ -19,6 +19,7 @@ FATWDSK = FATWRITEDSK\#FE1000
|
||||
FATRDSK = FATREADDSK\#FE1000
|
||||
FILEIO = FILEIO\#FE1000
|
||||
SANE = SANE\#FE1000
|
||||
SANITY = SANITY\#FE1000
|
||||
WIZNET = WIZNET\#FE1000
|
||||
UTHERNET2= UTHERNET2\#FE1000
|
||||
UTHERNET= UTHERNET\#FE1000
|
||||
@ -63,7 +64,7 @@ TXTTYPE = .TXT
|
||||
#SYSTYPE = \#FF2000
|
||||
#TXTTYPE = \#040000
|
||||
|
||||
all: $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM03) $(CMD) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(SB) $(MON) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(ROGUEIO) $(HGR1) $(TONE) $(DGR) $(DGRTEST) $(FILEIO) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE)
|
||||
all: $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM03) $(CMD) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(SB) $(MON) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(ROGUEIO) $(HGR1) $(TONE) $(DGR) $(DGRTEST) $(FILEIO) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE) $(SANITY)
|
||||
|
||||
clean:
|
||||
-rm *FE1000 *FF2000 $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM03)
|
||||
@ -180,6 +181,10 @@ $(SANE): libsrc/sane.pla $(PLVM02) $(PLASM)
|
||||
./$(PLASM) -AMO < libsrc/sane.pla > libsrc/sane.a
|
||||
acme --setpc 4094 -o $(SANE) libsrc/sane.a
|
||||
|
||||
$(SANITY): samplesrc/sanity.pla $(PLVM02) $(PLASM)
|
||||
./$(PLASM) -AMO < samplesrc/sanity.pla > samplesrc/sanity.a
|
||||
acme --setpc 4094 -o $(SANITY) samplesrc/sanity.a
|
||||
|
||||
$(TONE): libsrc/tone.pla $(PLVM02) $(PLASM)
|
||||
./$(PLASM) -AMO < libsrc/tone.pla > libsrc/tone.a
|
||||
acme --setpc 4094 -o $(TONE) libsrc/tone.a
|
||||
|
||||
33
src/samplesrc/sanity.pla
Normal file
33
src/samplesrc/sanity.pla
Normal file
@ -0,0 +1,33 @@
|
||||
//
|
||||
// SANE library test program
|
||||
//
|
||||
include "inc/cmdsys.plh"
|
||||
include "inc/sane.plh"
|
||||
//
|
||||
// Test values
|
||||
//
|
||||
word iA, iB, iC
|
||||
byte xT[t_extended]
|
||||
|
||||
def puti(i)
|
||||
if i < 0; putc('-'); i = -i; fin
|
||||
if i < 10
|
||||
putc(i + '0')
|
||||
else
|
||||
puti(i / 10)
|
||||
putc(i % 10 + '0')
|
||||
fin
|
||||
end
|
||||
|
||||
iA = 3
|
||||
iB = 4
|
||||
iC = -1
|
||||
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')
|
||||
done
|
||||
Loading…
x
Reference in New Issue
Block a user