mirror of
https://github.com/dschmenk/PLASMA.git
synced 2025-04-05 03:37:43 +00:00
Lots of library updates and FORTH bugfixes importing existing libraries
This commit is contained in:
parent
2d4417c698
commit
1db7cd16ee
@ -403,5 +403,8 @@ when MACHID & MACHID_MODEL
|
||||
break
|
||||
otherwise // MACHID_II puts("Found MACHID_MODEL = $"); putb(MACHID & MACHID_MODEL); putln
|
||||
wend
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -607,5 +607,8 @@ dgrTile:1 = @drawbuff
|
||||
dgrTile:6 = @drawbuff+1
|
||||
// Put read AUX mem routine in scary location
|
||||
memcpy($0100, @auxRead, 9)
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -479,5 +479,8 @@ when MACHID & MACHID_MODEL
|
||||
break
|
||||
otherwise // Apple ][
|
||||
wend
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -171,5 +171,8 @@ params:4 = 0
|
||||
params.6 = 0
|
||||
syscall($C8, @params)
|
||||
gfxref = params.3
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -513,5 +513,8 @@ grBLT:1 = @drawbuff
|
||||
grBLT:6 = @drawbuff+1
|
||||
grTile:1 = @drawbuff
|
||||
grTile:6 = @drawbuff+1
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -138,6 +138,8 @@ byte = $00,$2C,$1A,$00,$00,$00,$00,$00,$00,$2A,$14,$2A,$14,$2A,$00,$00
|
||||
export def hgrPutStr(x, y, strptr)#0
|
||||
tileDrawStr(x, y, strptr + 1, ^strptr, @hgrFont + 1024) // Offset into regular char
|
||||
end
|
||||
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -1307,5 +1307,8 @@ _scanBLTB:8 = @hgrOrPlot
|
||||
_scanBLTC:1 = @hgrColor
|
||||
_scanBLTD:1 = @hgrPlot
|
||||
_scanBLTD:8 = @hgrOrPlot
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -362,5 +362,8 @@ _scanMaskA:1 = @hgrColor
|
||||
_scanMaskB:1 = @hgrPlot
|
||||
_scanMaskC:1 = @hgrColor
|
||||
_scanMaskD:1 = @hgrPlot
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -431,6 +431,9 @@ _tileDSb:28 = @_tileDSc.28
|
||||
_tileDSb:33 = @_tileDSc.34
|
||||
_tileDSb:38 = @_tileDSc.40
|
||||
_tileDSb:43 = @_tileDSc.46
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
||||
|
@ -58,6 +58,8 @@ GC1DLY NOP ; TIMING
|
||||
BUZZDLY BNE + ; TIMING
|
||||
+ BNE GC0READ
|
||||
end
|
||||
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -206,6 +206,9 @@ for rom = $C100 to $C700 step $0100
|
||||
updateMouse:5 = rom + rom->$14 // readMouseFW
|
||||
readMouse.1 = index
|
||||
call(rom + rom->$19, $00, slot, page, $04) // initMouseFW
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
fin
|
||||
next
|
||||
|
@ -20,29 +20,26 @@ const WAIT = $FCA8
|
||||
export def digitalRead(pin)
|
||||
return FLAG0[pin&3] > 127
|
||||
end
|
||||
|
||||
export def portRead
|
||||
return (^FLAG0>>7)&1|(^FLAG1>>6)&2|(^FLAG2>>5)&4|(^FLAG3>>4)&8
|
||||
end
|
||||
|
||||
export def digitalWrite(pin, val)#0
|
||||
ANN0[((pin&3)<<1)+(val&1)]
|
||||
end
|
||||
|
||||
export def portWrite(val)#0
|
||||
ANN0[val&1]
|
||||
ANN1[(val>>1)&1]
|
||||
ANN2[(val>>2)&1]
|
||||
ANN3[(val>>3)&1]
|
||||
end
|
||||
|
||||
export def analogRead(pin)
|
||||
return call(PREAD,0,pin&3,0,0).2
|
||||
end
|
||||
|
||||
export def delay(time)#0
|
||||
call(WAIT,time,0,0,0)
|
||||
end
|
||||
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -38,7 +38,7 @@ GBASH = $27
|
||||
GBASE = GBASL
|
||||
GCLR = $30
|
||||
STORE80DIS = $C000
|
||||
STORE80EN = $C001
|
||||
STORE80EN = $C001
|
||||
MAINWRT = $C004
|
||||
AUXWRT = $C005
|
||||
VIDCTL = $C029
|
||||
@ -138,7 +138,7 @@ end
|
||||
export def shrPalette(pal, rgbptr)#0
|
||||
word palptr
|
||||
byte i
|
||||
|
||||
|
||||
palptr = palbuf + pal * 32
|
||||
for i = 0 to 31
|
||||
shrPoke(palptr + i, ^(rgbptr + i))
|
||||
@ -175,7 +175,9 @@ export def shrMode(mode)#0
|
||||
^an3off
|
||||
call($FC58, 0, 0, 0, 0) // home()
|
||||
end
|
||||
|
||||
// Put read AUX mem routine in scary location
|
||||
memcpy($0100, @auxRead, 9)
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
done
|
||||
|
@ -867,7 +867,9 @@ if mbSlot < 0
|
||||
spkrOctave0[instr] = mbOctave0[instr]/NOTEDIV
|
||||
next
|
||||
fin
|
||||
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
done
|
||||
|
||||
////////////////////////////////////////////////////////////////////////////////
|
||||
|
@ -5,14 +5,12 @@ include "inc/cmdsys.plh"
|
||||
const SPI_SLAVE_READY = '@'
|
||||
const SPI_SLAVE_ERROR = '!'
|
||||
const SPI_SLAVE_BUSY = $FF
|
||||
|
||||
word spiReadWriteByte, spiWriteBytes, spiReadBytes
|
||||
|
||||
asm spiInc
|
||||
!SOURCE "vmsrc/plvmzp.inc"
|
||||
!CPU 65C02
|
||||
end
|
||||
|
||||
asm spiXferByteStd(outbyte)
|
||||
PHP ; DISABLE INTS
|
||||
SEI
|
||||
@ -80,7 +78,6 @@ asm spiXferByteStd(outbyte)
|
||||
PLP
|
||||
RTS
|
||||
end
|
||||
|
||||
asm spiXferByteGS(outbyte)
|
||||
PHP ; DISABLE INTS
|
||||
SEI
|
||||
@ -211,7 +208,6 @@ asm spiReadBytesStd(buf, len)
|
||||
PLP
|
||||
RTS
|
||||
end
|
||||
|
||||
asm spiReadBytesGS(buf, len)
|
||||
PHP ; DISABLE INTS
|
||||
SEI
|
||||
@ -275,7 +271,6 @@ asm spiReadBytesGS(buf, len)
|
||||
PLP
|
||||
RTS
|
||||
end
|
||||
|
||||
asm spiWriteBytesStd(buf, len)
|
||||
PHP ; DISABLE INTS
|
||||
SEI
|
||||
@ -348,7 +343,6 @@ asm spiWriteBytesStd(buf, len)
|
||||
PLP
|
||||
RTS
|
||||
end
|
||||
|
||||
asm spiWriteBytesGS(buf, len)
|
||||
PHP ; DISABLE INTS
|
||||
SEI
|
||||
@ -393,15 +387,12 @@ asm spiWriteBytesGS(buf, len)
|
||||
PLP
|
||||
RTS
|
||||
end
|
||||
|
||||
export def spiXferByte(outbyte)
|
||||
return (spiReadWriteByte)(outbyte)
|
||||
end
|
||||
|
||||
export def spiDelay(time)
|
||||
return call($FCA8, time, 0, 0, 0) // DELAY
|
||||
end
|
||||
|
||||
export def spiSend(data)
|
||||
byte timeout, status
|
||||
|
||||
@ -415,23 +406,19 @@ export def spiSend(data)
|
||||
putc(status);putc('0'+data/10);putc('0'+data%10)
|
||||
return status
|
||||
end
|
||||
|
||||
export def spiRecv
|
||||
return spiSend(0)
|
||||
end
|
||||
|
||||
export def spiWriteBuf(buf, len)
|
||||
spiSend(13) // CMD_BUF_WRITE
|
||||
spiSend(len >> 8); spiSend(len)
|
||||
return (spiWriteBytes)(buf, len)
|
||||
end
|
||||
|
||||
export def spiReadBuf(buf, len)
|
||||
spiSend(12) // CMD_BUF_READ
|
||||
spiSend(len >> 8); spiSend(len)
|
||||
return (spiReadBytes)(buf, len)
|
||||
end
|
||||
|
||||
export def spiReady
|
||||
byte timeout
|
||||
|
||||
@ -442,13 +429,11 @@ export def spiReady
|
||||
loop
|
||||
return timeout
|
||||
end
|
||||
|
||||
export def spiReset
|
||||
^$C05B // DISABLE SLAVE SELECT
|
||||
^$C05D // CLOCK RAISE (GS ONLY)
|
||||
return spiReady
|
||||
end
|
||||
|
||||
if call($FE1F, 0, 0, 0, 1).3 & 1 // GS ID ROUTINE
|
||||
spiReadWriteByte = @spiXferByteStd
|
||||
spiReadBytes = @spiReadBytesStd
|
||||
@ -458,5 +443,8 @@ else
|
||||
spiReadBytes = @spiReadBytesGS
|
||||
spiWriteBytes = @spiWriteBytesGS
|
||||
fin
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return spiReset <> 0
|
||||
done
|
||||
|
@ -243,6 +243,9 @@ for slot = $90 to $F0 step $10
|
||||
//
|
||||
puts("Found Uthernet I in slot #"); putc('0' + ((slot - $80) >> 4)); putln
|
||||
setEtherDriver(@utherMAC, @peekfrmlen, @peekfrm, @pokefrmlen, @pokefrm)
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
fin
|
||||
fin
|
||||
|
@ -909,6 +909,9 @@ for slot = $90 to $F0 step $10
|
||||
iNet:getInterfaceHA = @getWizHA
|
||||
iNet:setCallback = @wizSetCallback
|
||||
iNet:setParam = @wizSetParam
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
fin
|
||||
fin
|
||||
|
@ -602,4 +602,8 @@ iNet:setInterfaceIP = @setEtherIP
|
||||
iNet:getInterfaceHA = @getEtherHA
|
||||
iNet:setCallback = @etherSetCallback
|
||||
iNet:setParam = @etherSetParam
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -63,7 +63,7 @@ export def str2ext(str, ext)
|
||||
// Parse decimal point
|
||||
//
|
||||
i++
|
||||
if !decrec:exp
|
||||
if !decrec.sig
|
||||
//
|
||||
// Skip leading zeros
|
||||
//
|
||||
@ -270,6 +270,8 @@ export def ext2str(ext, str, intdigits, fracdigits, format)
|
||||
^str = istr - str
|
||||
return str
|
||||
end
|
||||
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -369,6 +369,8 @@ def reset
|
||||
next
|
||||
return sane:restoreZP(0)
|
||||
end
|
||||
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -204,4 +204,8 @@ end
|
||||
//
|
||||
iNet:initIP = @iNetInit
|
||||
iNet:setDNS = @iNetSetDNS
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -677,7 +677,9 @@ export def puti32(i32ptr)#0
|
||||
|
||||
puts(i32tos(i32ptr, @i32str))
|
||||
end
|
||||
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
||||
|
@ -503,5 +503,8 @@ _vlineB:6 = @err
|
||||
_vlineB:9 = @err
|
||||
_vlineB:13 = @err.1
|
||||
_vlineB:16 = @err.1
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -896,4 +896,8 @@ end
|
||||
def uninit3(op, dst, src, src2)
|
||||
return uninit
|
||||
end
|
||||
//
|
||||
// Keep module in memory
|
||||
//
|
||||
return modkeep
|
||||
done
|
||||
|
@ -210,6 +210,8 @@ mkdir prodos/scripts
|
||||
cp scripts/plasma.4th prodos/scripts/PLASMA.4TH.TXT
|
||||
cp scripts/grlib.4th prodos/scripts/GRLIB.4TH.TXT
|
||||
cp scripts/hgrlib.4th prodos/scripts/HGRLIB.4TH.TXT
|
||||
cp scripts/int32.4th prodos/scripts/INT32.4TH.TXT
|
||||
cp scripts/fpu.4th prodos/scripts/FPU.4TH.TXT
|
||||
cp scripts/bounce.4th prodos/scripts/BOUNCE.4TH.TXT
|
||||
cp scripts/hrbounce.4th prodos/scripts/HRBOUNCE.4TH.TXT
|
||||
|
||||
|
@ -1,5 +1,6 @@
|
||||
: ?PLASMA
|
||||
" IFACE" FIND
|
||||
SWAP DROP
|
||||
0= IF
|
||||
" PLASMA.4TH" SRC
|
||||
THEN
|
||||
@ -9,6 +10,7 @@
|
||||
|
||||
: ?GRLIB
|
||||
" GRLIB" FIND
|
||||
SWAP DROP
|
||||
0= IF
|
||||
" GRLIB.4TH" SRC
|
||||
THEN
|
||||
|
88
src/scripts/fpu.4th
Normal file
88
src/scripts/fpu.4th
Normal file
@ -0,0 +1,88 @@
|
||||
" SANE" LOADMOD" "
|
||||
" FPSTR" LOADMOD" "
|
||||
" FPU" LOADMOD" "
|
||||
|
||||
0 VARIABLE FPERR
|
||||
|
||||
LOOKUP FPU CONSTANT FPULIB
|
||||
FPULIB 0 IFACE PLASMA _FPRESET : FPRESET _FPRESET FPERR ! ;
|
||||
FPULIB 1 IFACE PLASMA _FPGETENV : FPGETENV _FPGETENV FPERR ! ;
|
||||
FPULIB 2 IFACE PLASMA _FPSETENV : FPSETENV _FPSETENV FPERR ! ;
|
||||
FPULIB 3 IFACE PLASMA _FPTESTEXEPT : FPTESTECEPT _FPTESTEXEPT FPERR ! ;
|
||||
FPULIB 4 IFACE PLASMA _FPSETEXCEPT : FPSETEXCEPT _FPSETEXCEPT FPERR ! ;
|
||||
FPULIB 5 IFACE PLASMA _FPENTERPROC : FPENTERPROC _FPENTERPROC FPERR ! ;
|
||||
FPULIB 6 IFACE PLASMA _FPEXITPROC : FPEXITPROC _FPEXITPROC FPERR ! ;
|
||||
FPULIB 7 IFACE PLASMA _FPCONSTPI : FPCONSTPI _FPCONSTPI FPERR ! ;
|
||||
FPULIB 8 IFACE PLASMA _FPCONSTE : FPCONSTE _FPCONSTE FPERR ! ;
|
||||
FPULIB 9 IFACE PLASMA _FPINT@ : FPINT@ _FPINT@ FPERR ! ;
|
||||
FPULIB 10 IFACE PLASMA _FPSGL@ : FPSGL@ _FPSGL@ FPERR ! ;
|
||||
FPULIB 11 IFACE PLASMA _FPDBL@ : FPDBL@ _FPDBL@ FPERR ! ;
|
||||
FPULIB 12 IFACE PLASMA _FPEXT@ : FPEXT@ _FPEXT@ FPERR ! ;
|
||||
FPULIB 13 IFACE PLASMA _FPSTR@ : FPSTR@ _FPSTR@ FPERR ! ;
|
||||
FPULIB 14 IFACE PLASMA _FPINT! : FPINT! _FPINT! FPERR ! ;
|
||||
FPULIB 15 IFACE PLASMA _FPSGL! : FPSGL! _FPSGL! FPERR ! ;
|
||||
FPULIB 16 IFACE PLASMA _FPDBL! : FPDBL! _FPDBL! FPERR ! ;
|
||||
FPULIB 17 IFACE PLASMA _FPEXT! : FPEXT! _FPEXT! FPERR ! ;
|
||||
FPULIB 18 IFACE PLASMA _FPSTR! : FPSTR! _FPSTR! FPERR ! ;
|
||||
FPULIB 19 IFACE PLASMA _FPINTLOD : FPINTLOD _FPINTLOD FPERR ! ;
|
||||
FPULIB 20 IFACE PLASMA _FPSGLLOD : FPSGLLOD _FPSGLLOD FPERR ! ;
|
||||
FPULIB 21 IFACE PLASMA _FPDBLLOD : FPDBLLOD _FPDBLLOD FPERR ! ;
|
||||
FPULIB 22 IFACE PLASMA _FPEXTLOD : FPEXTLOD _FPEXTLOD FPERR ! ;
|
||||
FPULIB 23 IFACE PLASMA _FPSTRLOD : FPSTRLOD _FPSTRLOD FPERR ! ;
|
||||
FPULIB 24 IFACE PLASMA _FPINTSTOR : FPINTSTOR _FPINTSTOR FPERR ! ;
|
||||
FPULIB 25 IFACE PLASMA _FPSGLSTOR : FPSGLSTOR _FPSGLSTOR FPERR ! ;
|
||||
FPULIB 26 IFACE PLASMA _FPDBLSTOR : FPDBLSTOR _FPDBLSTOR FPERR ! ;
|
||||
FPULIB 27 IFACE PLASMA _FPEXTSTOR : FPEXTSTOR _FPEXTSTOR FPERR ! ;
|
||||
FPULIB 28 IFACE PLASMA _FPSTRSTOR : FPSTRSTOR _FPSTRSTOR FPERR ! ;
|
||||
FPULIB 29 IFACE PLASMA _FPSHIFTUP : FPSHIFTUP _FPSHIFTUP FPERR ! ;
|
||||
FPULIB 30 IFACE PLASMA _FPSHIFTDOWN : FPSHIFTDOWN _FPSHIFTDOWN FPERR ! ;
|
||||
: FPDROP _FPSHIFTDOWN FPERR ! ;
|
||||
FPULIB 31 IFACE PLASMA _FPROTATEUP : FPROTATEUP _FPROTATEUP FPERR ! ;
|
||||
FPULIB 32 IFACE PLASMA _FPROTATEDOWN : FPROTATEDOWN _FPROTATEDOWN FPERR ! ;
|
||||
FPULIB 33 IFACE PLASMA _FPDUP : FPDUP _FPDUP FPERR ! ;
|
||||
FPULIB 34 IFACE PLASMA _FPSWAP : FPSWAP _FPSWAP FPERR ! ;
|
||||
FPULIB 35 IFACE PLASMA _FPCLEAR : FPCLEAR _FPCLEAR FPERR ! ;
|
||||
FPULIB 36 IFACE PLASMA _FP+ : FP+ _FP+ FPERR ! ;
|
||||
FPULIB 37 IFACE PLASMA _FP- : FP- _FP- FPERR ! ;
|
||||
FPULIB 38 IFACE PLASMA _FP* : FP* _FP* FPERR ! ;
|
||||
FPULIB 39 IFACE PLASMA _FP/ : FP/ _FP/ FPERR ! ;
|
||||
FPULIB 40 IFACE PLASMA _FPREM : FPREM _FPREM FPERR ! ;
|
||||
FPULIB 41 IFACE PLASMA _FPNEG : FPNEG _FPNEG FPERR ! ;
|
||||
FPULIB 42 IFACE PLASMA _FPABS : FPABS _FPABS FPERR ! ;
|
||||
FPULIB 43 IFACE PLASMA _FPTYPE : FPTYPE _FPTYPE FPERR ! ;
|
||||
FPULIB 44 IFACE PLASMA _FPCMP : FPCMP _FPCMP FPERR ! ;
|
||||
FPULIB 45 IFACE PLASMA _FPLOGB : FPLOGB _FPLOGB FPERR ! ;
|
||||
FPULIB 46 IFACE PLASMA _FPSCALEBINT : FPSCALEBINT _FPSCALEBINT FPERR ! ;
|
||||
FPULIB 47 IFACE PLASMA _FPTRUNC : FPTRUNC _FPTRUNC FPERR ! ;
|
||||
FPULIB 48 IFACE PLASMA _FPROUND : FPROUND _FPROUND FPERR ! ;
|
||||
FPULIB 49 IFACE PLASMA _FPSQRT : FPSQRT _FPSQRT FPERR ! ;
|
||||
FPULIB 50 IFACE PLASMA _FPSQUARE : FPSQUARE _FPSQUARE FPERR ! ;
|
||||
FPULIB 51 IFACE PLASMA _FPCOS : FPCOS _FPCOS FPERR ! ;
|
||||
FPULIB 52 IFACE PLASMA _FPSIN : FPSIN _FPSIN FPERR ! ;
|
||||
FPULIB 53 IFACE PLASMA _FPTAN : FPTAN _FPTAN FPERR ! ;
|
||||
FPULIB 54 IFACE PLASMA _FPATAN : FPATAN _FPATAN FPERR ! ;
|
||||
FPULIB 55 IFACE PLASMA _FPLOG2 : FPLOG2 _FPLOG2 FPERR ! ;
|
||||
FPULIB 56 IFACE PLASMA _FPLOG21 : FPLOG21 _FPLOG21 FPERR ! ;
|
||||
FPULIB 57 IFACE PLASMA _FPLN : FPLN _FPLN FPERR ! ;
|
||||
FPULIB 58 IFACE PLASMA _FPLN1 : FPLN1 _FPLN1 FPERR ! ;
|
||||
FPULIB 59 IFACE PLASMA _FPPOW2 : FPPOW2 _FPPOW2 FPERR ! ;
|
||||
FPULIB 60 IFACE PLASMA _FPPOW21 : FPPOW21 _FPPOW21 FPERR ! ;
|
||||
FPULIB 61 IFACE PLASMA _FPPOWE : FPPOWE _FPPOWE FPERR ! ;
|
||||
FPULIB 62 IFACE PLASMA _FPPOWE1 : FPPOWE1 _FPPOWE1 FPERR ! ;
|
||||
FPULIB 63 IFACE PLASMA _FPPOWE21 : FPPOWE21 _FPPOWE21 FPERR ! ;
|
||||
FPULIB 64 IFACE PLASMA _FPPOWINT : FPPOWINT _FPPOWINT FPERR ! ;
|
||||
FPULIB 65 IFACE PLASMA _FPPOW : FPPOW _FPPOW FPERR ! ;
|
||||
FPULIB 66 IFACE PLASMA _FPCOMP : FPCOMP _FPCOMP FPERR ! ;
|
||||
FPULIB 67 IFACE PLASMA _FPANNUITY : FPANNUITY _FPANNUITY FPERR ! ;
|
||||
FPULIB 68 IFACE PLASMA _FPRANDNUM : FPRANDNUM _FPRANDNUM FPERR ! ;
|
||||
|
||||
1 CONSTANT FPSTR.FIXED ( Fixed count of fractional digits )
|
||||
0 CONSTANT FPSTR.FLOAT ( Floating count of fractional digits )
|
||||
2 CONSTANT FPSTR.STRIP ( Strip trailing fractional zeros )
|
||||
4 CONSTANT FPSTR.EXP ( Force exponential format )
|
||||
8 CONSTANT FPSTR.FLEX ( Flexible switch to EXP format if over/underflow )
|
||||
|
||||
: FP. HERE 4 4 FPSTR.FLOAT FPSTR! HERE (.") ;
|
||||
|
||||
FPRESET ( Load SANE code and set up libraries )
|
||||
|
@ -1,4 +1,4 @@
|
||||
LOADMOD" GRLIB"
|
||||
" GRLIB" LOADMOD" "
|
||||
|
||||
LOOKUP GRPLOT PLASMA GRPLOT
|
||||
LOOKUP GRHLIN PLASMA GRHLIN
|
||||
|
@ -1,4 +1,4 @@
|
||||
LOADMOD" HGRLIB"
|
||||
" HGRLIB" LOADMOD" "
|
||||
|
||||
LOOKUP HGRPLOT PLASMA HGRPLOT
|
||||
LOOKUP HGRORPLOT PLASMA HGRORPLOT
|
||||
|
@ -1,5 +1,6 @@
|
||||
: ?PLASMA
|
||||
" IFACE" FIND
|
||||
SWAP DROP
|
||||
0= IF
|
||||
" PLASMA.4TH" SRC
|
||||
THEN
|
||||
@ -11,6 +12,7 @@ $6000 HERE - ALLOT ( Reserve HGR2 screen )
|
||||
|
||||
: ?HGRLIB
|
||||
" HGRLIB" FIND
|
||||
SWAP DROP
|
||||
0= IF
|
||||
" HGRLIB.4TH" SRC
|
||||
THEN
|
||||
@ -57,4 +59,4 @@ $6000 HERE - ALLOT ( Reserve HGR2 screen )
|
||||
0 HGRMODE DROP
|
||||
;
|
||||
|
||||
( BOUNCE)
|
||||
BOUNCE
|
||||
|
45
src/scripts/int32.4th
Normal file
45
src/scripts/int32.4th
Normal file
@ -0,0 +1,45 @@
|
||||
" INT32" LOADMOD" "
|
||||
|
||||
LOOKUP ZERO32 PLASMA ZERO32 ( -- )
|
||||
LOOKUP ZEXT16TO32 PLASMA ZEXT32 ( -- )
|
||||
LOOKUP NEG32 PLASMA NEG32 ( -- )
|
||||
LOOKUP LOAD32 PLASMA LOAD32 ( i32ptr -- )
|
||||
LOOKUP LOADI16 PLASMA LOAD16 ( imm16 -- )
|
||||
LOOKUP STORE32 PLASMA STORE32 ( i32ptr -- )
|
||||
LOOKUP ADD32 PLASMA ADD32 ( i32ptr -- )
|
||||
LOOKUP ADDI16 PLASMA ADD16 ( imm16 -- )
|
||||
LOOKUP SUB32 PLASMA SUB32 ( i32ptr -- )
|
||||
LOOKUP SUBI16 PLASMA SUB16 ( imm16 -- )
|
||||
LOOKUP SHL32 PLASMA SHL32 ( imm8 -- )
|
||||
LOOKUP SHR32 PLASMA SHR32 ( imm8 -- )
|
||||
LOOKUP MUL32 PLASMA MUL32 ( i32ptr -- )
|
||||
LOOKUP MULI16 PLASMA MUL16 ( imm16 -- )
|
||||
LOOKUP DIV32 PLASMA DIV32 ( i32ptr -- rem32 )
|
||||
LOOKUP DIVI16 PLASMA DIV16 ( imm16 -- rem32 )
|
||||
LOOKUP ISEQ32 PLASMA ISEQ32 ( i32ptr -- f)
|
||||
LOOKUP ISEQI16 PLASMA ISEQ16 ( imm16 -- f)
|
||||
LOOKUP IDGE32 PLASMA ISGE32 ( i32ptr -- f)
|
||||
LOOKUP ISGEI16 PLASMA ISGE16 ( imm16 -- f)
|
||||
LOOKUP ISLE32 PLASMA ISLE32 ( i32ptr -- f)
|
||||
LOOKUP ISLEI16 PLASMA ISLE16 ( imm16 -- f)
|
||||
LOOKUP ISGT32 PLASMA ISGT32 ( i32ptr -- f)
|
||||
LOOKUP ISGTI16 PLASMA ISGT16 ( imm16 -- f)
|
||||
LOOKUP ISLT32 PLASMA ISLT32 ( i32ptr -- f)
|
||||
LOOKUP ISLTI16 PLASMA ISLT16 ( imm16 -- f )
|
||||
LOOKUP I32TOS PLASMA I32TOS ( i32ptr strptr -- strptr )
|
||||
LOOKUP PUTI32 PLASMA PUTI32 ( i32ptr -- )
|
||||
|
||||
: DVAR CREATE 4 ALLOT ;
|
||||
DVAR _DOP1
|
||||
DVAR _DOP2
|
||||
: D@ DUP @ SWAP 2+ @ ;
|
||||
: D! DUP ROT SWAP 2+ ! ! ;
|
||||
: D+ _DOP2 D! _DOP1 D! _DOP1 LOAD32 _DOP2 ADD32 _DOP1 STORE32 _DOP1 D@ ;
|
||||
: D- _DOP2 D! _DOP1 D! _DOP1 LOAD32 _DOP2 SUB32 _DOP1 STORE32 _DOP1 D@ ;
|
||||
: D* _DOP2 D! _DOP1 D! _DOP1 LOAD32 _DOP2 MUL32 _DOP1 STORE32 _DOP1 D@ ;
|
||||
: D/ _DOP2 D! _DOP1 D! _DOP1 LOAD32 _DOP2 DIV32 _DOP1 STORE32 _DOP1 D@ ;
|
||||
: D< _DOP2 D! _DOP1 D! _DOP1 LOAD32 _DOP2 ISLT32 ;
|
||||
: D> _DOP2 D! _DOP1 D! _DOP1 LOAD32 _DOP2 ISGT32 ;
|
||||
: D= _DOP2 D! _DOP1 D! _DOP1 LOAD32 _DOP2 ISEQ32 ;
|
||||
: D0= OR 0= ;
|
||||
: D. _DOP1 D! _DOP1 PUTI32 SPACE ;
|
@ -706,7 +706,9 @@ def filein#0
|
||||
repeat
|
||||
len = fileio:read(inref[srclevel-1], inbufptr, INBUF_SIZE-1)
|
||||
if len
|
||||
len-- // Remove trailing carriage return
|
||||
if ^(inbufptr + len - 1) == $0D
|
||||
len-- // Remove trailing carriage return
|
||||
fin
|
||||
^(inbufptr + len) = 0 // NULL terminate
|
||||
inptr = inbufptr
|
||||
else
|
||||
@ -934,6 +936,7 @@ def warmstart#0
|
||||
if state & comp_flag // Undo compilation state
|
||||
heaprelease(vlist)
|
||||
vlist = *_lfa_(vlist)
|
||||
buildhashtbl
|
||||
fin
|
||||
state = 0
|
||||
while srclevel
|
||||
@ -1239,11 +1242,11 @@ def newdict#0
|
||||
bldptr = bldptr + 2
|
||||
*bldptr = bldptr + 2 // Point CFA to PFA
|
||||
heapalloc(bldptr - vlist + 2)
|
||||
addhash(vlist)
|
||||
end
|
||||
def _plasma_(a)#0
|
||||
newdict
|
||||
*(_cfa_(vlist)) = a // PLASMA code address
|
||||
addhash(vlist)
|
||||
end
|
||||
def _var_(a)#0
|
||||
newdict
|
||||
@ -1253,7 +1256,6 @@ def _var_(a)#0
|
||||
pfillw(heapmark + 3) // Poiner to variable in PFA
|
||||
pfillb($5C) // RET
|
||||
pfillw(a) // Variable storage
|
||||
addhash(vlist)
|
||||
end
|
||||
def _const_(a)#0
|
||||
newdict
|
||||
@ -1262,7 +1264,6 @@ def _const_(a)#0
|
||||
pfillb($2C) // CONSTANT WORD
|
||||
pfillw(a)
|
||||
pfillb($5C) // RET
|
||||
addhash(vlist)
|
||||
end
|
||||
def _create_#0
|
||||
newdict
|
||||
@ -1289,7 +1290,6 @@ def _itcdoes_(a)#0
|
||||
^(_ffa_(vlist)) = itc_flag
|
||||
*(_cfa_(vlist)) = @_dodoes_
|
||||
*(_pfa_(vlist)) = a // Fill in DOES code address
|
||||
addhash(vlist)
|
||||
end
|
||||
def _pbcdoes_(a)#0
|
||||
//
|
||||
@ -1298,7 +1298,6 @@ def _pbcdoes_(a)#0
|
||||
^(_pfa_(vlist) + 6) = $54 // CALL DOES> directly
|
||||
*(_pfa_(vlist) + 7) = a
|
||||
^(_pfa_(vlist) + 9) = $5C // RET
|
||||
addhash(vlist)
|
||||
end
|
||||
def _does_#0
|
||||
if state & comp_itc_flag
|
||||
@ -1355,7 +1354,6 @@ end
|
||||
def _semi_#0
|
||||
_exit_
|
||||
state = state & ~comp_flag
|
||||
addhash(vlist)
|
||||
end
|
||||
def _forcecomp_#0
|
||||
word dentry
|
||||
|
Loading…
x
Reference in New Issue
Block a user