6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2025-04-09 16:40:38 +00:00
Code Issues Projects Releases Wiki Activity

Lots of library updates and FORTH bugfixes importing existing libraries

Browse Source
This commit is contained in:
David Schmenk 2024-01-04 14:24:45 -08:00
parent 2d4417c698
commit 1db7cd16ee
32 changed files with 225 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/libsrc/apple/conio.pla
View File

@ -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

3
src/libsrc/apple/dgrlib.pla
View File

@ -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

3
src/libsrc/apple/fileio.pla
View File

@ -479,5 +479,8 @@ when MACHID & MACHID_MODEL
break
otherwise // Apple ][
wend
//
// Keep module in memory
//
return modkeep
done

3
src/libsrc/apple/grafix.pla
View File

@ -171,5 +171,8 @@ params:4 = 0
params.6 = 0
syscall($C8, @params)
gfxref = params.3
//
// Keep module in memory
//
return modkeep
done

3
src/libsrc/apple/grlib.pla
View File

@ -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

4
src/libsrc/apple/hgrfont.pla
View File

@ -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

3
src/libsrc/apple/hgrlib.pla
View File

@ -1307,5 +1307,8 @@ _scanBLTB:8 = @hgrOrPlot
_scanBLTC:1 = @hgrColor
_scanBLTD:1 = @hgrPlot
_scanBLTD:8 = @hgrOrPlot
//
// Keep module in memory
//
return modkeep
done

3
src/libsrc/apple/hgrsprite.pla
View File

@ -362,5 +362,8 @@ _scanMaskA:1 = @hgrColor
_scanMaskB:1 = @hgrPlot
_scanMaskC:1 = @hgrColor
_scanMaskD:1 = @hgrPlot
//
// Keep module in memory
//
return modkeep
done

3
src/libsrc/apple/hgrtile.pla
View File

@ -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

4
src/libsrc/apple/joybuzz.pla
View File

@ -58,6 +58,8 @@ GC1DLY NOP ; TIMING
BUZZDLY BNE + ; TIMING
+ BNE GC0READ
end
//
// Keep module in memory
//
return modkeep
done

3
src/libsrc/apple/mouse.pla
View File

@ -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

9
src/libsrc/apple/portio.pla
View File

@ -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

8
src/libsrc/apple/shrlib.pla
View File

@ -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

4
src/libsrc/apple/sndseq.pla
View File

@ -867,7 +867,9 @@ if mbSlot < 0
spkrOctave0[instr] = mbOctave0[instr]/NOTEDIV
next
fin
//
// Keep module in memory
//
done
////////////////////////////////////////////////////////////////////////////////

18
src/libsrc/apple/spiport.pla
View File

@ -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

3
src/libsrc/apple/uthernet.pla
View File

@ -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

3
src/libsrc/apple/uthernet2.pla
View File

@ -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

4
src/libsrc/etherip.pla
View File

@ -602,4 +602,8 @@ iNet:setInterfaceIP = @setEtherIP
iNet:getInterfaceHA = @getEtherHA
iNet:setCallback = @etherSetCallback
iNet:setParam = @etherSetParam
//
// Keep module in memory
//
return modkeep
done

6
src/libsrc/fpstr.pla
View File

@ -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

4
src/libsrc/fpu.pla
View File

@ -369,6 +369,8 @@ def reset
next
return sane:restoreZP(0)
end
//
// Keep module in memory
//
return modkeep
done

4
src/libsrc/inet.pla
View File

@ -204,4 +204,8 @@ end
//
iNet:initIP = @iNetInit
iNet:setDNS = @iNetSetDNS
//
// Keep module in memory
//
return modkeep
done

4
src/libsrc/int32.pla
View File

@ -677,7 +677,9 @@ export def puti32(i32ptr)#0
puts(i32tos(i32ptr, @i32str))
end
//
// Keep module in memory
//
return modkeep
done

3
src/libsrc/lines.pla
View File

@ -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

4
src/libsrc/sane.pla
View File

@ -896,4 +896,8 @@ end
def uninit3(op, dst, src, src2)
return uninit
end
//
// Keep module in memory
//
return modkeep
done

2
src/mkrel
View File

@ -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

2
src/scripts/bounce.4th
View File

@ -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
View 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 )

2
src/scripts/grlib.4th
View File

@ -1,4 +1,4 @@
LOADMOD" GRLIB"
" GRLIB" LOADMOD" "
LOOKUP GRPLOT PLASMA GRPLOT
LOOKUP GRHLIN PLASMA GRHLIN

2
src/scripts/hgrlib.4th
View File

@ -1,4 +1,4 @@
LOADMOD" HGRLIB"
" HGRLIB" LOADMOD" "
LOOKUP HGRPLOT PLASMA HGRPLOT
LOOKUP HGRORPLOT PLASMA HGRORPLOT

4
src/scripts/hrbounce.4th
View File

@ -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
View 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 ;

12
src/toolsrc/plforth.pla
View File

@ -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