6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2025-03-30 23:31:27 +00:00
Code Issues Projects Releases Wiki Activity

Enable strict parameter/return count checking

Browse Source
This commit is contained in:
David Schmenk 2017-12-13 14:40:31 -08:00
parent bdff511c8f
commit f79b94ba96
36 changed files with 1481 additions and 1703 deletions

4
src/inc/args.plh

@ -1,3 +1,3 @@
import args
predef argFirst, argNext
end
predef argFirst, argNext(str)
end

2
src/inc/memmgr.plh

@ -6,7 +6,7 @@ import memmgr
//
// Memory routines
//
predef hmemNew(size), hmemLock(hmem), hmemUnlock(hmem)#0, hmemRef(hmem), hmemDel(hmem), hmemFre(lptr)
predef hmemNew(size), hmemLock(hmem), hmemUnlock(hmem)#0, hmemRef(hmem)#0, hmemDel(hmem)#0, hmemFre(lptr)
//
// Max size of a memory block
//

3
src/inc/spiport.plh

@ -2,5 +2,6 @@ import spiport
const SPI_SLAVE_READY = '@'
const SPI_SLAVE_ERROR = '!'
const SPI_SLAVE_BUSY = $FF
predef spiXferByte, spiSend, spiRecv, spiWriteBuf, spiReadBuf, spiDelay, spiReady
predef spiXferByte(outbyte), spiSend(data), spiRecv, spiWriteBuf(buf, len), spiReadBuf(buf, len)
predef spiDelay(time), spiReady
end

130
src/libsrc/conio.pla

@ -38,8 +38,8 @@ end
//
// Predefined functions.
//
predef a2keypressed,a2home,a2gotoxy,a2viewport,a2texttype
predef a2textmode,a2grmode,a2grcolor,a2grplot
predef a2keypressed,a2home,a2gotoxy(x,y),a2viewport(left, top, width, height),a2texttype(type)
predef a2textmode(cols),a2grmode(mix),a2grcolor(color),a2grplot(x,y)
//
// Screen row address arrays.
//
@ -82,64 +82,64 @@ word = @a2grplot
// Native routines.
//
asm equates
!SOURCE "vmsrc/plvmzp.inc"
!SOURCE "vmsrc/plvmzp.inc"
end
//
// def grscrn(rowaddrs)
//
asm a2grscrn
GRSCRN = $26
GRSCRNL = GRSCRN
GRSCRNH = GRSCRNL+1
LDA ESTKL,X
STA GRSCRNL
LDA ESTKH,X
STA GRSCRNH
RTS
asm a2grscrn(rowaddrs)
GRSCRN = $26
GRSCRNL = GRSCRN
GRSCRNH = GRSCRNL+1
LDA ESTKL,X
STA GRSCRNL
LDA ESTKH,X
STA GRSCRNH
RTS
end
//
// def grcolor(color)
//
asm a2grcolor
GRCLR = $30
LDA #$0F
AND ESTKL,X
STA GRCLR
ASL
ASL
ASL
ASL
ORA GRCLR
STA GRCLR
RTS
asm a2grcolor(color)
GRCLR = $30
LDA #$0F
AND ESTKL,X
STA GRCLR
ASL
ASL
ASL
ASL
ORA GRCLR
STA GRCLR
RTS
end
//
// def grplot(x, y)
//
asm a2grplot
STY IPY
LDA ESTKL,X
AND #$FE
CMP ESTKL,X
TAY
LDA (GRSCRN),Y
STA DSTL
INY
LDA (GRSCRN),Y
STA DSTH
LDY ESTKL+1,X
LDA (DST),Y
EOR GRCLR
STA TMPL
LDA #$FF
ADC #$00
EOR #$0F
AND TMPL
EOR GRCLR
STA (DST),Y
LDY IPY
INX
RTS
asm a2grplot(x, y)
STY IPY
LDA ESTKL,X
AND #$FE
CMP ESTKL,X
TAY
LDA (GRSCRN),Y
STA DSTL
INY
LDA (GRSCRN),Y
STA DSTH
LDY ESTKL+1,X
LDA (DST),Y
EOR GRCLR
STA TMPL
LDA #$FF
ADC #$00
EOR #$0F
AND TMPL
EOR GRCLR
STA (DST),Y
LDY IPY
INX
RTS
end
//
// Apple 1 routines.
@ -152,6 +152,7 @@ def a1home
for l = 0 to 23
putln
next
return 0
end
def a1gotoxy(x, y)
curshpos = x
@ -159,14 +160,18 @@ def a1gotoxy(x, y)
putln
while x
putc(' ')
x = x - 1
x = x - 1
loop
return 0
end
def a1viewport(left, top, width, height)
return 0
end
def a1texttype(type)
return 0
end
def a1textmode(columns)
return 0
end
def a1grmode(mix)
return 0 // not supported
@ -191,9 +196,9 @@ end
def a2viewport(left, top, width, height)
if !width or !height
left = 0
top = 0
width = 40
height = 24
top = 0
width = 40
height = 24
fin
^$20 = left
^$21 = width
@ -203,6 +208,7 @@ def a2viewport(left, top, width, height)
end
def a2texttype(type)
^$32 = type
return 0
end
def a2textmode(columns)
call($FB39, 0, 0, 0, 0) // textmode()
@ -246,7 +252,8 @@ end
def a3home
curshpos = 0
cursvpos = 0
return putc(28)
putc(28)
return 0
end
def a3gotoxy(x, y)
curshpos = x
@ -254,17 +261,18 @@ def a3gotoxy(x, y)
putc(24)
putc(x)
putc(25)
return putc(y)
putc(y)
return 0
end
def a3viewport(left, top, width, height)
if !width or !height
//
// Reset the full-screen viewport
//
// Reset the full-screen viewport
//
left = 0
top = 0
width = textcols
height = 24
top = 0
width = textcols
height = 24
fin
putc(1) // Reset viewport
putc(26)
@ -278,6 +286,7 @@ def a3viewport(left, top, width, height)
return a3gotoxy(0, 0)
end
def a3texttype(type)
return 0
end
def a3textmode(columns)
puts(@textbwmode)
@ -286,7 +295,8 @@ def a3textmode(columns)
else
a3viewport(0, 0, 40, 24)
fin
return putc(28)
putc(28)
return 0
end
def a3grmode(mix)
byte i

3
src/libsrc/dhcp.pla

@ -101,7 +101,7 @@ byte[] endDHCP
// for i = 0 to 2
// puti(ipptr->[i]); putc('.')
// next
// return puti(ipptr->[i])
// puti(ipptr->[i])
//end
//def dumpbytes(buf, len)
// word i
@ -185,6 +185,7 @@ def recvDHCP(remip, remport, pkt, len, param)
//dumpdhcp(pkt)
wend
fin
return 0
end
//
// Get the local hardware address into the DHCP packet

14
src/libsrc/etherip.pla

@ -174,7 +174,7 @@ end
//
// Swap bytes in word
//
asm swab
asm swab(val)
LDA ESTKL,X
LDY ESTKH,X
STA ESTKH,X
@ -185,7 +185,7 @@ end
// 1'S COMPLIMENT SUM BE format
// sum1(PREVSUM, BUF, LEN)
//
asm sum1
asm sum1(prevsum, buf, len)
LDY #$00
LDA ESTKL+1,X
STA SRCL
@ -300,6 +300,7 @@ def etherSendIP(ipdst, proto, seglist, size)
size = size - seglist=>seg_len
seglist = seglist + t_segment
loop
return 0
end
//
// Send UDP datagram
@ -351,6 +352,7 @@ def etherOpenUDP(localport, callback, param)
fin
port = port + t_notify
next
return 0
end
//
// Clear notify on UDP port
@ -377,21 +379,25 @@ end
// Open TCP socket in SERVER mode
//
def etherListenTCP(lclport, callback, param)
return 0
end
//
// Open TCP socket in CLIENT mode
//
def etherConnectTCP(remip, remport, lclport, callback, param)
return 0
end
//
// Write to TCP socket
//
def etherSendTCP(wiz, data, len)
return 0
end
//
// Close TCP socket
//
def etherCloseTCP(wiz)
return 0
end
//
// Update notify callback
@ -549,11 +555,12 @@ def etherServiceIP
wend
heaprelease(rxpacket)
fin
return 0
end
//
// Initialize the driver interface
//
export def setEtherDriver(MAC, getlen, readframe, setlen, writeframe)
export def setEtherDriver(MAC, getlen, readframe, setlen, writeframe)#0
memcpy(@myMAC, MAC, MAC_SIZE)
memcpy(@localha, MAC, MAC_SIZE)
getFrameLen = getlen
@ -570,6 +577,7 @@ def setEtherIP(newIP, newNetmask, newGateway)
if newGateway; memcpy(@gateway, newGateway, IP4ADR_SIZE); fin
subnet:0 = netmask:0 & gateway:0
subnet:2 = netmask:2 & gateway:2
return 0
end
//
// Get the interface hardware address

15
src/libsrc/fiber.pla

@ -135,6 +135,7 @@ export def fbrInit(numPool)
else
return -1
fin
return 0
end
//
// Stop fiber and return it to FREE pool
@ -160,6 +161,7 @@ export def fbrStop(fid)
return fbrLoad(fbrVMState[fbrRunning])
fin
fin
return 0
end
//
// Stop current fiber
@ -168,7 +170,7 @@ export def fbrExit
//
// Stop running fiber
//
fbrStop(fbrRunning)
return fbrStop(fbrRunning)
end
//
// Start a fiber RUNning
@ -228,11 +230,12 @@ export def fbrYield
fbrRunning = fbrNext[fbrRunning]
return fbrSwap(fbrVMState[prev], fbrVMState[fbrRunning])
fin
return 0
end
//
// HALT current fiber and await a RESUME
//
export def fbrHalt
export def fbrHalt#0
byte i
//
@ -250,13 +253,13 @@ export def fbrHalt
fbrNext[i] = fbrNext[fbrRunning]
i = fbrRunning
fbrRunning = fbrNext[fbrRunning]
return fbrSwap(fbrVMState[i], fbrVMState[fbrRunning])
fbrSwap(fbrVMState[i], fbrVMState[fbrRunning])
fin
end
//
// Restore HALTed fiber to RUN list
//
export def fbrResume(fid)
export def fbrResume(fid)#0
if fbrState[fid] == FIBER_HALT
//
// Insert HALTed fiber back into RUN list
@ -271,7 +274,7 @@ end
// Test Fiber library
//
def puth(h)
def puth(h)#0
putc('$')
putc(valstr[(h >> 12) & $0F])
putc(valstr[(h >> 8) & $0F])
@ -279,7 +282,7 @@ def puth(h)
putc(valstr[ h & $0F])
end
def fbrTest(fid, param)
def fbrTest(fid, param)#0
byte i
for i = 1 to param

8
src/libsrc/fileio.pla

@ -37,9 +37,9 @@ struc t_fileio
word readblock
word writeblock
end
predef a2getpfx, a23setpfx, a2getfileinfo, a23geteof, a2open, a23close
predef a23read, a2write, a2create, a23destroy
predef a23newline, a2readblock, a2writeblock
predef a2getpfx(path), a23setpfx(path), a2getfileinfo(path, fileinfo), a23geteof(refnum), a2open(path), a23close(refnum)
predef a23read(refnum, buf, len), a2write(refnum, buf, len), a2create(path, type, aux), a23destroy(path)
predef a23newline(refnum, emask, nlchar), a2readblock(unit, buf, block), a2writeblock(unit, buf, block)
//
// Exported function table.
//
@ -159,7 +159,7 @@ def a23close(refnum)
end
def a1read(refnum, buf, len)
*CFFA1Dest = buf
perr = syscall($22) // This reads the entire file from CFFA
perr = syscall($22, 0) // This reads the entire file from CFFA
return perr
end
def a23read(refnum, buf, len)

22
src/libsrc/fpu.pla

@ -7,18 +7,18 @@ include "inc/fpstr.plh"
//
// External interface to FPU library
//
predef reset, getEnv, setEnv, testExcept, setExcept, enterProc, exitProc
predef reset, getEnv, setEnv(env), testExcept(except), setExcept(except), enterProc(pEnv), exitProc(env)
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 pushInt(pInt), pushSgl(pSgl), pushDbl(pDbl), pushExt(pExt), pushStr(pStr)
predef pullInt(pInt), pullSgl(pSgl), pullDbl(pDbl), pullExt(pExt), pullStr(pStr,intdigits,fracdigits,format)
predef loadInt(pInt,reg), loadSgl(pSgl,reg), loadDbl(pDbl,reg), loadExt(pExt,reg), loadStr(pStr,reg)
predef storInt(pInt,reg), storSgl(pSgl,reg), storDbl(pDbl,reg), storExt(pExt,reg), storStr(pStr,intdigits,fracdigits,format,reg)
predef shiftUp, shiftDown, rotateUp, rotateDown, dup, swap, clear
predef add, sub, mul, div, rem
predef neg, abs, type, cmp, logb, scalb, trunc, round, sqrt, squared
predef neg, abs, type, cmp, logb, scalb(scale), trunc, round, sqrt, squared
predef cos, sin, tan, atan
predef log2X, log21X, lnX, ln1X, pow2X, pow21X, powEX, powE1X, powE21X, powXInt, powXY
predef compXY, annuityXY, randNum
predef log2X, log21X, lnX, ln1X, pow2X, pow21X, powEX, powE1X, powE21X, powXInt(powInt), powXY
predef compXY, annuityXY, randNum(pSeed)
//
// FP6502 functions
//
@ -81,17 +81,21 @@ end
//
def rotateUp
stackRegs[0], stackRegs[1], stackRegs[2], stackRegs[3] = stackRegs[3], stackRegs[0], stackRegs[1], stackRegs[2]
return 0
end
def rotateDown
stackRegs[0], stackRegs[1], stackRegs[2], stackRegs[3] = stackRegs[1], stackRegs[2], stackRegs[3], stackRegs[0]
return 0
end
def shiftUp
stackRegs[0], stackRegs[1], stackRegs[2], stackRegs[3] = stackRegs[3], stackRegs[0], stackRegs[1], stackRegs[2]
memcpy(stackRegs[0], stackRegs[1], t_extended)
return 0
end
def shiftDown // drop
stackRegs[0], stackRegs[1], stackRegs[2], stackRegs[3] = stackRegs[1], stackRegs[2], stackRegs[3], stackRegs[0]
memcpy(stackRegs[3], stackRegs[2], t_extended)
return 0
end
def _drop(passthru) // Internal version with passthru
stackRegs[0], stackRegs[1], stackRegs[2], stackRegs[3] = stackRegs[1], stackRegs[2], stackRegs[3], stackRegs[0]
@ -100,6 +104,7 @@ def _drop(passthru) // Internal version with passthru
end
def swap
stackRegs[0], stackRegs[1] = stackRegs[1], stackRegs[0]
return 0
end
def _swap(passthru) // Internal version with passthru
stackRegs[0], stackRegs[1] = stackRegs[1], stackRegs[0]
@ -108,6 +113,7 @@ 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)
return 0
end
def clear
word zero

164
src/libsrc/inet.pla

@ -50,7 +50,8 @@ const DNS_ANSWER = 2
byte stateDNS
def iNetSetDNS(ipptr)
return memcpy(@dns, ipptr, 4)
memcpy(@dns, ipptr, 4)
return 0
end
//def putb(hexb)
@ -64,11 +65,11 @@ end
//
// for i = 0 to len - 1
// putb(buf->[i])
// if i & 7 == 7
// putln
// else
// putc(' ')
// fin
// if i & 7 == 7
// putln
// else
// putc(' ')
// fin
// next
//end
//def putip(ipptr)
@ -86,14 +87,14 @@ def parseIP(ipstr, ipaddr)
endstr = ipstr + ^ipstr
for i = 0 to 3
ipstr = ipstr + 1
ipstr = ipstr + 1
while ^ipstr >= '0' and ^ipstr <= '9' and ipstr <= endstr
ipaddr->[i] = ipaddr->[i] * 10 + ^ipstr - '0'
ipstr = ipstr + 1
loop
if ^ipstr <> '.' and ipstr < endstr
return 0
fin
ipaddr->[i] = ipaddr->[i] * 10 + ^ipstr - '0'
ipstr = ipstr + 1
loop
if ^ipstr <> '.' and ipstr < endstr
return 0
fin
next
return i == 3
end
@ -104,11 +105,11 @@ def parseDomain(domstr, msgptr)
l = 0
for i = 1 to ^domstr
if domstr->[i] == '.'
msgptr->[l] = i - l - 1
l = i
else
msgptr->[i] = domstr->[i]
fin
msgptr->[l] = i - l - 1
l = i
else
msgptr->[i] = domstr->[i]
fin
next
msgptr->[l] = i - l - 1
msgptr = msgptr + i
@ -123,40 +124,41 @@ def recvDNS(remip, remport, pkt, len, ipaddr)
if pkt=>dnsID == $BEEF
q = pkt->dnsQdCount.1
r = pkt->dnsAnCount.1 + pkt->dnsNsCount.1 + pkt->dnsArCount.1
resptr = pkt + t_dnshdr
while q
while ^resptr
resptr = pkt + t_dnshdr
while q
while ^resptr
//puts(resptr); putc('.')
resptr = resptr + ^resptr + 1
loop
resptr = resptr + 1
//putln; dumpbytes(resptr, 4); putln
resptr = resptr + 4
q--
loop
while r
//dumpbytes(resptr, 40); putln
if ^resptr & $C0 == $C0
resptr = resptr + 2
else
while ^resptr
loop
resptr = resptr + 1
//putln; dumpbytes(resptr, 4); putln
resptr = resptr + 4
q--
loop
while r
//dumpbytes(resptr, 40); putln
if ^resptr & $C0 == $C0
resptr = resptr + 2
else
while ^resptr
//puts(resptr); putc('.')
resptr = resptr + ^resptr + 1
loop
resptr = resptr + 1
fin
if resptr->1 == 1 and resptr->3 == 1 and resptr->9 == 4
ipaddr=>0 = resptr=>10
ipaddr=>2 = resptr=>12
fin
//putln; dumpbytes(resptr, 10); putc(':'); putln
resptr = resptr + 8
//dumpbytes(resptr + 2, ^(resptr + 1))
resptr = resptr + 2 + ^(resptr + 1); putln
r = r - 1
loop
loop
resptr = resptr + 1
fin
if resptr->1 == 1 and resptr->3 == 1 and resptr->9 == 4
ipaddr=>0 = resptr=>10
ipaddr=>2 = resptr=>12
fin
//putln; dumpbytes(resptr, 10); putc(':'); putln
resptr = resptr + 8
//dumpbytes(resptr + 2, ^(resptr + 1))
resptr = resptr + 2 + ^(resptr + 1); putln
r = r - 1
loop
fin
stateDNS = DNS_ANSWER
return 0
end
def iNetResolve(namestr, ipaddr)
@ -167,38 +169,38 @@ def iNetResolve(namestr, ipaddr)
ipaddr=>2 = 0
if not parseIP(namestr, ipaddr)
//
// Query Domain Name Server for address
//
dnspkt = heapmark // Use heap as working DNS query packet
msgptr = dnspkt
msgptr=>dnsID = $BEEF
msgptr=>dnsCode = $0001 // RD (Recursion Desired)
msgptr=>dnsQdCount = $0100 // BE count = 1
msgptr=>dnsAnCount = 0
msgptr=>dnsNsCount = 0
msgptr=>dnsArCount = 0
msgptr = parseDomain(namestr, msgptr + t_dnshdr)
msgptr=>0 = $0100 // BE TYPE = Address
msgptr=>2 = $0100 // BE CLASS = INternet
msglen = msgptr - dnspkt + 4
heapalloc(msglen)
//
// Prepare to receive DNS answer from server
//
portDNS = iNet:openUDP(3999, @recvDNS, ipaddr)
//
// Service IP
//
stateDNS = DNS_QUERY
iNet:sendUDP(portDNS, @dns, 53, dnspkt, msglen)
for timeout = 1 to 1000
iNet:serviceIP()
if stateDNS == DNS_ANSWER
break
fin
next
iNet:closeUDP(portDNS)
heaprelease(dnspkt)
// Query Domain Name Server for address
//
dnspkt = heapmark // Use heap as working DNS query packet
msgptr = dnspkt
msgptr=>dnsID = $BEEF
msgptr=>dnsCode = $0001 // RD (Recursion Desired)
msgptr=>dnsQdCount = $0100 // BE count = 1
msgptr=>dnsAnCount = 0
msgptr=>dnsNsCount = 0
msgptr=>dnsArCount = 0
msgptr = parseDomain(namestr, msgptr + t_dnshdr)
msgptr=>0 = $0100 // BE TYPE = Address
msgptr=>2 = $0100 // BE CLASS = INternet
msglen = msgptr - dnspkt + 4
heapalloc(msglen)
//
// Prepare to receive DNS answer from server
//
portDNS = iNet:openUDP(3999, @recvDNS, ipaddr)
//
// Service IP
//
stateDNS = DNS_QUERY
iNet:sendUDP(portDNS, @dns, 53, dnspkt, msglen)
for timeout = 1 to 1000
iNet:serviceIP()
if stateDNS == DNS_ANSWER
break
fin
next
iNet:closeUDP(portDNS)
heaprelease(dnspkt)
fin
return ipaddr=>0 <> 0 or ipaddr=>2 <> 0
end
@ -209,10 +211,10 @@ export def iNetInit
//
while ^driver
//puts(driver);putln
if modexec(driver) >= 0
if modexec(driver) >= 0
break
fin
driver = driver + ^driver + 1
fin
driver = driver + ^driver + 1
loop
if !^driver
return 0

12
src/libsrc/memmgr.pla

@ -156,7 +156,7 @@ def unfre(freblk, freprv, size)
fin
return freblk
end
def addfre(freblk)
def addfre(freblk)#0
word srch
//freblk=>fresiz = freblk=>blksiz
@ -318,6 +318,7 @@ def findexact(size)
prev = srch
srch = srch=>frenxt
loop
return 0
end
def findbest(size)
word srch, prev
@ -332,6 +333,7 @@ def findbest(size)
prev = srch
srch = srch=>frenxt
loop
return 0
end
def findblk(size)
word addr
@ -567,6 +569,7 @@ export def hmemNew(size)
fin
next
next
return 0
end
//
// Lock memory block in place
@ -587,6 +590,7 @@ export def hmemLock(hmem)
//putc('L');putc(' ');puth(hmem);putc('@');puth(memblk);putln
return memblk + t_memblk
wend
return 0
end
//
// Unlock memory block
@ -612,7 +616,7 @@ end
//
// Increment reference count
//
export def hmemRef(hmem)
export def hmemRef(hmem)#0
word memblk
memblk = hpgtbl:[hmem.lsb, hmem.msb]
@ -629,7 +633,7 @@ end
//
// Decrement reference count
//
export def hmemDel(hmem)
export def hmemDel(hmem)#0
byte ref
word memblk
@ -640,7 +644,7 @@ export def hmemDel(hmem)
is HMEM_LOCKED
is HMEM_MOVEABLE
memblk = memblk & HMEM_ADDR
if not memblk; return 0; fin
if not memblk; return; fin
ref = memblk->blkref - 1
if ref == 0
//

2
src/libsrc/sane.pla

@ -869,7 +869,7 @@ def fpInit()
//
sane[9]()
sane[3]($0001, $0000)
sane[10](0)
return sane[10](0)
end
//
// Uninitialized placeholders of API

18
src/libsrc/sdfat.pla

@ -4,8 +4,9 @@ include "inc/spiport.plh"
//
// FAT I/O object
//
predef cwd, chdir, mkdir, rmdir, rename, remove, exists, openFirst, openNext, open
predef close, read, write, sync, rewind, seek, seekOfs, pos
predef cwd(pathname), chdir(path), mkdir(path), rmdir(path), rename(newpath), remove, exists(path)
predef openFirst(filename), openNext(filename), open(path, mode)
predef close, read(buf, len), write(buf, len), sync, rewind, seek, seekOfs, pos
predef size, truncate, isDir, isFile
//
// SD card FAT filesystem interface
@ -37,18 +38,23 @@ def chdir(path)
end
def mkdir(path)
return 0
end
def rmdir(path)
return 0
end
def rename(newpath)
return 0
end
def remove
return 0
end
def exists(path)
return 0
end
def openDir(cmd, filename)
@ -113,24 +119,31 @@ def write(buf, len)
end
def sync
return 0
end
def rewind
return 0
end
def seek
return 0
end
def seekOfs
return 0
end
def pos
return 0
end
def size
return 0
end
def truncate
return 0
end
def isDir
@ -139,6 +152,7 @@ def isDir
end
def isFile
return 0
end
//

214
src/libsrc/tone.pla

@ -1,114 +1,116 @@
export asm tone(pitch, duration)
!SOURCE "vmsrc/plvmzp.inc"
DEX
LDA ESTKL+1,X
STA ESTKL,X
LDA ESTKH+1,X
STA ESTKH,X
LDA #$00
STA ESTKL+1,X
STA ESTKH+1,X
!SOURCE "vmsrc/plvmzp.inc"
DEX
LDA ESTKL+1,X
STA ESTKL,X
LDA ESTKH+1,X
STA ESTKH,X
LDA #$00
STA ESTKL+1,X
STA ESTKH+1,X
end
export asm tone2(pitch1, pitch2, duration)
STX ESP
LDY ESTKH,X
LDA ESTKL,X
BEQ +
INY
+ STA DSTL
STY DSTH
LDY ESTKL+1,X
STY TMPL
LDA ESTKL+2,X
export asm tone2(pitch1, pitch2, duration)#0
STX ESP
LDY ESTKH,X
LDA ESTKL,X
BEQ +
INY
+ STA DSTL
STY DSTH
LDY ESTKL+1,X
STY TMPL
LDA ESTKL+2,X
TAX
CMP TMPL
BNE +
LDX #$00
+ STX TMPH
LDA #$00
PHP
SEI
- CLC
-- DEY
BNE +
LDY TMPL
BEQ ++ ; SILENCE
STA $C030
BNE +++
+ NOP
NOP
++ NOP
NOP
NOP
+++ DEX
BNE +
LDX TMPH
BEQ ++ ; SILENCE
STA $C030
BNE +++
+ NOP
NOP
++ NOP
NOP
NOP
+++ ADC #$01
BNE --
DEC DSTL
BNE -
DEC DSTH
BNE -
PLP
LDX ESP
INX
INX
RTS
CMP TMPL
BNE +
LDX #$00
+ STX TMPH
LDA #$00
PHP
SEI
- CLC
-- DEY
BNE +
LDY TMPL
BEQ ++ ; SILENCE
STA $C030
BNE +++
+ NOP
NOP
++ NOP
NOP
NOP
+++ DEX
BNE +
LDX TMPH
BEQ ++ ; SILENCE
STA $C030
BNE +++
+ NOP
NOP
++ NOP
NOP
NOP
+++ ADC #$01
BNE --
DEC DSTL
BNE -
DEC DSTH
BNE -
PLP
LDX ESP
INX
INX
INX
RTS
end
export asm tonePWM(sample, speed, len)
STX ESP
LDY ESTKH,X
LDA ESTKL,X
BEQ +
INY
+ STY DSTH
STA DSTL
LDA ESTKL+2,X
STA SRCL
LDA ESTKH+2,X
STA SRCH
LDY ESTKL+1,X
INY
STY TMPL
LDY #$00
PHP
SEI
- LDA (SRC),Y
SEC
-- LDX TMPL
--- DEX
BNE ---
SBC #$01
BCS --
LDA $C030
INY
BNE +
INC SRCH
+ DEC DSTL
BNE -
DEC DSTH
BNE -
PLP
LDX ESP
INX
INX
RTS
export asm tonePWM(sample, speed, len)#0
STX ESP
LDY ESTKH,X
LDA ESTKL,X
BEQ +
INY
+ STY DSTH
STA DSTL
LDA ESTKL+2,X
STA SRCL
LDA ESTKH+2,X
STA SRCH
LDY ESTKL+1,X
INY
STY TMPL
LDY #$00
PHP
SEI
- LDA (SRC),Y
SEC
-- LDX TMPL
--- DEX
BNE ---
SBC #$01
BCS --
LDA $C030
INY
BNE +
INC SRCH
+ DEC DSTL
BNE -
DEC DSTH
BNE -
PLP
LDX ESP
INX
INX
INX
RTS
++
end
def toneTest
byte t
for t = 2 to 128
tone2(t, t >> 1, 10)
tone(t, 50)
next
def toneTest#0
byte t
for t = 2 to 128
tone2(t, t >> 1, 10)
tone(t, 50)
next
end
toneTest()
done
done

9
src/libsrc/uthernet.pla

@ -6,7 +6,7 @@ include "inc/cmdsys.plh"
// Include dependency on S/W IP stack
//
import etherip
predef setEtherDriver
predef setEtherDriver(MAC, getlen, readframe, setlen, writeframe)#0
end
//
// Uthernet register offsets
@ -42,7 +42,7 @@ end
//
// Uthernet I/O functions
//
asm _pokeiow
asm _pokeiow(val)
LDA ESTKL,X
end
asm _pokeiowl
@ -87,7 +87,7 @@ end
// WRITE FRAME DATA INTO I/O SPACE
// pokefrm(BUF, LEN)
//
asm pokefrm
asm pokefrm(buf, len)
LDY #$00
LDA ESTKL+1,X
STA SRCL
@ -126,7 +126,7 @@ end
// READ FRAME DATA FROM I/O SPACE
// peekfrm(BUF, LEN)
//
asm peekfrm
asm peekfrm(buf, len)
LDY #$00
LDA ESTKL+1,X
STA DSTL
@ -190,6 +190,7 @@ def pokefrmlen(len)
pokeiow(txcmd, $C0)
pokeiow(txlen, len)
repeat; until peekpreg($0138) & $0100
return 0
end
//
// Return the length of awaiting packet, 0 otherwise

520
src/libsrc/uthernet2.pla

@ -180,19 +180,19 @@ end
//
// Local network parameters
//
const MAX_WIZ_CHANNELS = 4
const MAX_WIZ_CHANNELS = 4
//
// Channel protocols
//
const WIZ_PROTO_CLOSED = 0
const WIZ_PROTO_TCP = 1
const WIZ_PROTO_UDP = 2
const WIZ_PROTO_IP = 3
const WIZ_PROTO_RAW = 4
const WIZ_PROTO_UDP = 2
const WIZ_PROTO_IP = 3
const WIZ_PROTO_RAW = 4
//
// State transistions
//
const TCP_STATE_CLOSED = 0
const TCP_STATE_CLOSED = 0
const TCP_STATE_CLOSING = 1
const TCP_STATE_LISTEN = 2
const TCP_STATE_CONNECT = 3
@ -221,17 +221,17 @@ export word hookICMP
// Defines for ASM routines
//
asm equates
!SOURCE "vmsrc/plvmzp.inc"
!SOURCE "vmsrc/plvmzp.inc"
end
//
// Swap bytes in word
//
asm swab
LDA ESTKL,X
LDY ESTKH,X
STA ESTKH,X
STY ESTKL,X
RTS
asm swab(val)
LDA ESTKL,X
LDY ESTKH,X
STA ESTKH,X
STY ESTKL,X
RTS
end
//
// Wiznet I/O functions
@ -239,109 +239,109 @@ end
// POKE WORD TO I/O SPACE
// Note: Big Endian format
//
asm _pokeiow
LDA ESTKH,X
asm _pokeiow(val)
LDA ESTKH,X
end
asm _pokeiowl
STA $C000
LDA ESTKL,X
STA $C000
LDA ESTKL,X
end
asm _pokeiowh
STA $C000
RTS
STA $C000
RTS
end
//
// POKE BYTE TO I/O SPACE
//
asm _pokeio
LDA ESTKL,X
asm _pokeio(val)
LDA ESTKL,X
end
asm _pokeiol
STA $C000
RTS
STA $C000
RTS
end
//
// PEEK BYTE FROM I/O SPACE
//
asm _peekio
DEX
DEX
end
asm _peekiol
LDA $C000
STA ESTKL,X
LDA #$00
STA ESTKH,X
RTS
LDA $C000
STA ESTKL,X
LDA #$00
STA ESTKH,X
RTS
end
//
// PEEK WORD FROM I/O SPACE
// Note: Big Endian format
//
asm _peekiow
DEX
DEX
end
asm _peekiowl
LDA $C000
STA ESTKH,X
LDA $C000
STA ESTKH,X
end
asm _peekiowh
LDA $C000
STA ESTKL,X
RTS
LDA $C000
STA ESTKL,X
RTS
end
//
// WRITE DATA INTO I/O SPACE
// pokedata(BUF, LEN)
//
asm pokedata
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
STA SRCH
LDY ESTKL,X
BEQ POKELP
LDY #$00
INC ESTKH,X
POKELP LDA (SRC),Y
asm pokedata(buf, len)
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
STA SRCH
LDY ESTKL,X
BEQ POKELP
LDY #$00
INC ESTKH,X
POKELP LDA (SRC),Y
end
asm _pokedata
STA $C000
INY
BNE +
INC SRCH
+ DEC ESTKL,X
BNE POKELP
DEC ESTKH,X
BNE POKELP
INX
RTS
STA $C000
INY
BNE +
INC SRCH
+ DEC ESTKL,X
BNE POKELP
DEC ESTKH,X
BNE POKELP
INX
RTS
end
//
// READ DATA FROM I/O SPACE
// peekdata(BUF, LEN)
//
asm peekdata
LDA ESTKL+1,X
STA DSTL
LDA ESTKH+1,X
STA DSTH
LDY ESTKL,X
BEQ PEEKLP
LDY #$00
INC ESTKH,X
asm peekdata(buf, len)
LDA ESTKL+1,X
STA DSTL
LDA ESTKH+1,X
STA DSTH
LDY ESTKL,X
BEQ PEEKLP
LDY #$00
INC ESTKH,X
end
asm _peekdata
PEEKLP LDA $C000
STA (DST),Y
INY
BNE +
INC DSTH
+ DEC ESTKL,X
BNE PEEKLP
DEC ESTKH,X
BNE PEEKLP
INX
RTS
PEEKLP LDA $C000
STA (DST),Y
INY
BNE +
INC DSTH
+ DEC ESTKL,X
BNE PEEKLP
DEC ESTKH,X
BNE PEEKLP
INX
RTS
end
def pokeiow(io, data)
_pokeiowl.1 = io
@ -428,6 +428,7 @@ def wizSendUDP(wiz, ipdst, portdst, data, len)
//
pokeregw(wizregs + WIZ_SnTXWR, txwr + len)
pokereg(wizregs + WIZ_SnCR, $20) // SEND
return 0
end
//
// Open UDP channel and set datagram received callback
@ -444,8 +445,8 @@ def wizOpenUDP(localport, callback, param)
for i = 1 to MAX_WIZ_CHANNELS
if wiz->channel_proto == IP_PROTO_UDP and wiz=>channel_lclport == localport
break
fin
wiz = wiz + t_channel
fin
wiz = wiz + t_channel
next
if i > MAX_WIZ_CHANNELS
//
@ -455,8 +456,8 @@ def wizOpenUDP(localport, callback, param)
for i = 1 to MAX_WIZ_CHANNELS
if !wiz->channel_proto
break
fin
wiz = wiz + t_channel
fin
wiz = wiz + t_channel
next
if i > MAX_WIZ_CHANNELS
return 0
@ -479,14 +480,14 @@ end
//
def wizCloseUDP(wiz)
if isuge(wiz, @wizChannel) and isult(wiz, @wizChannel + MAX_WIZ_CHANNELS * t_channel)
//
// Clear notiications on this port
//
//
// Clear notiications on this port
//
if wiz->channel_proto == WIZ_PROTO_UDP
wiz->channel_proto = WIZ_PROTO_CLOSED
pokereg(wiz=>channel_regs + WIZ_SnCR, $10) // CLOSE
return 0
fin
return 0
fin
fin
//
// Invalid port
@ -507,8 +508,8 @@ def wizListenTCP(lclport, callback, param)
for i = 1 to MAX_WIZ_CHANNELS
if wiz->channel_proto == WIZ_PROTO_TCP and wiz->channel_state == TCP_STATE_LISTEN and wiz=>channel_lclport == lclport
break
fin
wiz = wiz + t_channel
fin
wiz = wiz + t_channel
next
if i > MAX_WIZ_CHANNELS
//
@ -518,8 +519,8 @@ def wizListenTCP(lclport, callback, param)
for i = 1 to MAX_WIZ_CHANNELS
if !wiz->channel_proto
break
fin
wiz = wiz + t_channel
fin
wiz = wiz + t_channel
next
if i > MAX_WIZ_CHANNELS
return 0
@ -557,8 +558,8 @@ def wizConnectTCP(remip, remport, lclport, callback, param)
for i = 1 to MAX_WIZ_CHANNELS
if wiz->channel_proto == WIZ_PROTO_TCP and wiz->channel_state == TCP_STATE_CONNECT and wiz=>channel_lclport == lclport
break
fin
wiz = wiz + t_channel
fin
wiz = wiz + t_channel
next
if i > MAX_WIZ_CHANNELS
//
@ -568,8 +569,8 @@ def wizConnectTCP(remip, remport, lclport, callback, param)
for i = 1 to MAX_WIZ_CHANNELS
if !wiz->channel_proto
break
fin
wiz = wiz + t_channel
fin
wiz = wiz + t_channel
next
if i > MAX_WIZ_CHANNELS
return 0
@ -626,20 +627,21 @@ def wizSendTCP(wiz, data, len)
//
pokeregw(wizregs + WIZ_SnTXWR, txwr + len)
pokereg(wizregs + WIZ_SnCR, $20) // SEND
return wiz
end
//
// Close TCP socket
//
def wizCloseTCP(wiz)
if isuge(wiz, @wizChannel) and isult(wiz, @wizChannel + MAX_WIZ_CHANNELS * t_channel)
//
// Clear notiications on this port
//
//
// Clear notiications on this port
//
if wiz->channel_proto == WIZ_PROTO_TCP
pokereg(wiz=>channel_regs + WIZ_SnCR, $10) // CLOSE
wiz->channel_proto = WIZ_PROTO_CLOSED
return 0
fin
pokereg(wiz=>channel_regs + WIZ_SnCR, $10) // CLOSE
wiz->channel_proto = WIZ_PROTO_CLOSED
return 0
fin
fin
//
// Invalid port
@ -652,10 +654,10 @@ end
def wizSetCallback(wiz, callback)
if wiz->channel_proto == WIZ_PROTO_UDP or wiz->channel_proto == WIZ_PROTO_TCP
//
// Update callback on this port
//
wiz=>channel_recv_func = callback
return 0
// Update callback on this port
//
wiz=>channel_recv_func = callback
return 0
fin
//
// Invalid port
@ -668,10 +670,10 @@ end
def wizSetParam(wiz, param)
if wiz->channel_proto == WIZ_PROTO_UDP or wiz->channel_proto == WIZ_PROTO_TCP
//
// Update param on this port
//
wiz=>channel_recv_parm = param
return 0
// Update param on this port
//
wiz=>channel_recv_parm = param
return 0
fin
//
// Invalid port
@ -689,121 +691,122 @@ def wizServiceIP
if ir
wiz = @wizChannel
for i = 0 to 3
//
// Socket activity
//
//
// Socket activity
//
if ir & (1 << i)
wizregs = wiz=>channel_regs
wizdata = wiz=>channel_rxmem
sir = peekreg(wizregs + WIZ_SnIR)
pokereg(wiz=>channel_regs + WIZ_SnIR, sir) // Clear SnIR
when wiz->channel_proto
wizdata = wiz=>channel_rxmem
sir = peekreg(wizregs + WIZ_SnIR)
pokereg(wiz=>channel_regs + WIZ_SnIR, sir) // Clear SnIR
when wiz->channel_proto
is WIZ_PROTO_UDP
if sir & $04
//
// Receive UDP packet
//
rxlen = peekregw(wizregs + WIZ_SnRSR)
rxrr = peekregw(wizregs + WIZ_SnRXRD)
rxwr = rxrr & WIZ_RXMASK
rxpkt = heapalloc(rxlen)
if rxwr + rxlen >= WIZ_RXSIZE
splitlen = WIZ_RXSIZE - rxwr
peekregs(wizdata + rxwr, rxpkt, splitlen)
peekregs(wizdata, rxpkt + splitlen, rxlen - splitlen)
else
peekregs(wizdata + rxwr, rxpkt, rxlen)
fin
pokeregw(wizregs + WIZ_SnRXRD, rxrr + rxlen)
pokereg(wizregs + WIZ_SnCR, $40) // RECV
wiz=>channel_recv_func(rxpkt,swab(rxpkt=>4),rxpkt+8,rxlen-8,wiz=>channel_recv_parm)
heaprelease(rxpkt)
// Receive UDP packet
//
rxlen = peekregw(wizregs + WIZ_SnRSR)
rxrr = peekregw(wizregs + WIZ_SnRXRD)
rxwr = rxrr & WIZ_RXMASK
rxpkt = heapalloc(rxlen)
if rxwr + rxlen >= WIZ_RXSIZE
splitlen = WIZ_RXSIZE - rxwr
peekregs(wizdata + rxwr, rxpkt, splitlen)
peekregs(wizdata, rxpkt + splitlen, rxlen - splitlen)
else
peekregs(wizdata + rxwr, rxpkt, rxlen)
fin
pokeregw(wizregs + WIZ_SnRXRD, rxrr + rxlen)
pokereg(wizregs + WIZ_SnCR, $40) // RECV
wiz=>channel_recv_func(rxpkt,swab(rxpkt=>4),rxpkt+8,rxlen-8,wiz=>channel_recv_parm)
heaprelease(rxpkt)
fin
break
is WIZ_PROTO_TCP
if sir & $01
//
// Connect TCP socket
//
when wiz->channel_state
is TCP_STATE_LISTEN
peekregs(wiz=>channel_regs + WIZ_SnDIPR, @wiz=>channel_remip, IP4ADR_SIZE)
wiz=>channel_remport = peekregw(wiz=>channel_regs + WIZ_SnDPORT)
is TCP_STATE_CONNECT
wiz->channel_state = TCP_STATE_OPEN
wend
fin
if sir & $04
//
// Receive TCP packet
//
if wiz->channel_state == TCP_STATE_OPEN
rxlen = peekregw(wizregs + WIZ_SnRSR)
rxrr = peekregw(wizregs + WIZ_SnRXRD)
rxwr = rxrr & WIZ_RXMASK
rxpkt = heapalloc(rxlen)
if rxwr + rxlen > WIZ_RXSIZE
splitlen = WIZ_RXSIZE - rxwr
peekregs(wizdata + rxwr, rxpkt, splitlen)
peekregs(wizdata, rxpkt + splitlen, rxlen - splitlen)
else
peekregs(wizdata + rxwr, rxpkt, rxlen)
fin
pokeregw(wizregs + WIZ_SnRXRD, rxrr + rxlen)
pokereg(wizregs + WIZ_SnCR, $40) // RECV
wiz=>channel_recv_func(@wiz=>channel_remip,wiz=>channel_remport,wiz=>channel_lclport,rxpkt,rxlen,wiz=>channel_recv_parm)
heaprelease(rxpkt)
fin
break
is WIZ_PROTO_TCP
if sir & $01
//
// Connect TCP socket
//
when wiz->channel_state
is TCP_STATE_LISTEN
peekregs(wiz=>channel_regs + WIZ_SnDIPR, @wiz=>channel_remip, IP4ADR_SIZE)
wiz=>channel_remport = peekregw(wiz=>channel_regs + WIZ_SnDPORT)
is TCP_STATE_CONNECT
wiz->channel_state = TCP_STATE_OPEN
wend
fin
if sir & $02
//
// Close TCP socket
//
if wiz->channel_state == TCP_STATE_OPEN // Notify callback w/ len = 0
wiz=>channel_recv_func(@wiz=>channel_remip,wiz=>channel_remport,0,wiz=>channel_lclport,0,wiz=>channel_recv_parm)
fin
wiz->channel_state = TCP_STATE_CLOSED
pokereg(wiz=>channel_regs + WIZ_SnCR, $10) // CLOSE
fin
if sir & $08
//
// Timeout on TCP socket
//
when wiz->channel_state
is TCP_STATE_OPEN
wiz->channel_state = TCP_STATE_CLOSING
wiz=>channel_recv_func(@wiz=>channel_remip,wiz=>channel_remport,wiz=>channel_lclport,0,0,wiz=>channel_recv_parm)
break
is TCP_STATE_CONNECT
wiz=>channel_recv_func(@wiz=>channel_remip,wiz=>channel_remport,wiz=>channel_lclport,0,0,wiz=>channel_recv_parm)
is TCP_STATE_CLOSING
wiz->channel_state = TCP_STATE_CLOSED
pokereg(wiz=>channel_regs + WIZ_SnCR, $10) // CLOSE
wend
fin
if sir & $04
//
// Receive TCP packet
//
if wiz->channel_state == TCP_STATE_OPEN
rxlen = peekregw(wizregs + WIZ_SnRSR)
rxrr = peekregw(wizregs + WIZ_SnRXRD)
rxwr = rxrr & WIZ_RXMASK
rxpkt = heapalloc(rxlen)
if rxwr + rxlen > WIZ_RXSIZE
splitlen = WIZ_RXSIZE - rxwr
peekregs(wizdata + rxwr, rxpkt, splitlen)
peekregs(wizdata, rxpkt + splitlen, rxlen - splitlen)
else
peekregs(wizdata + rxwr, rxpkt, rxlen)
fin
pokeregw(wizregs + WIZ_SnRXRD, rxrr + rxlen)
pokereg(wizregs + WIZ_SnCR, $40) // RECV
wiz=>channel_recv_func(@wiz=>channel_remip,wiz=>channel_remport,wiz=>channel_lclport,rxpkt,rxlen,wiz=>channel_recv_parm)
heaprelease(rxpkt)
fin
fin
if sir & $02
//
// Close TCP socket
//
if wiz->channel_state == TCP_STATE_OPEN // Notify callback w/ len = 0
wiz=>channel_recv_func(@wiz=>channel_remip,wiz=>channel_remport,0,wiz=>channel_lclport,0,wiz=>channel_recv_parm)
fin
wiz->channel_state = TCP_STATE_CLOSED
pokereg(wiz=>channel_regs + WIZ_SnCR, $10) // CLOSE
fin
if sir & $08
//
// Timeout on TCP socket
//
when wiz->channel_state
is TCP_STATE_OPEN
wiz->channel_state = TCP_STATE_CLOSING
wiz=>channel_recv_func(@wiz=>channel_remip,wiz=>channel_remport,wiz=>channel_lclport,0,0,wiz=>channel_recv_parm)
break
is TCP_STATE_CONNECT
wiz=>channel_recv_func(@wiz=>channel_remip,wiz=>channel_remport,wiz=>channel_lclport,0,0,wiz=>channel_recv_parm)
is TCP_STATE_CLOSING
wiz->channel_state = TCP_STATE_CLOSED
pokereg(wiz=>channel_regs + WIZ_SnCR, $10) // CLOSE
wend
fin
wend
fin
wiz = wiz + t_channel
next
if ir & $80
//
// IP conflict
//
pokereg(WIZ_IR, $80)
fin
if ir & $40
//
// Destination unreachable
//
pokereg(WIZ_IR, $40)
fin
if ir & $20
//
// PPOE connection close
//
pokereg(WIZ_IR, $20)
fin
if ir & $80
//
// IP conflict
//
pokereg(WIZ_IR, $80)
fin
if ir & $40
//
// Destination unreachable
//
pokereg(WIZ_IR, $40)
fin
if ir & $20
//
// PPOE connection close
//
pokereg(WIZ_IR, $20)
fin
fin
return 0
end
//
// Set the local IP addresses
@ -811,16 +814,17 @@ end
def setWizIP(newIP, newSubnet, newGateway)
if newIP
localip:0 = newIP=>0; localip:2 = newIP=>2
pokeregs(WIZ_SIPR, newIP, IP4ADR_SIZE)
pokeregs(WIZ_SIPR, newIP, IP4ADR_SIZE)
fin
if newSubnet
subnet:0 = newSubnet=>0; subnet:2 = newSubnet=>2
pokeregs(WIZ_SUBR, newSubnet, IP4ADR_SIZE)
pokeregs(WIZ_SUBR, newSubnet, IP4ADR_SIZE)
fin
if newGateway
gateway:0 = newGateway=>0; gateway:2 = newGateway=>2
pokeregs(WIZ_GWR, newGateway, IP4ADR_SIZE)
gateway:0 = newGateway=>0; gateway:2 = newGateway=>2
pokeregs(WIZ_GWR, newGateway, IP4ADR_SIZE)
fin
return 0
end
//
// Get the interface hardware address
@ -838,39 +842,39 @@ for slot = $90 to $F0 step $10
regdata = peekio(slot)
if (regdata & $E4) == $00
pokeio(slot, $03) // Try setting auto-increment indirect I/F
if peekio(slot) == $03
saveidx = peekiow(slot + 1)
peekio(slot + 3) // Dummy read to data register should increment index
if peekiow(slot + 1) == saveidx + 1
//
// Good chance this is it
//
pokeio(slot, $80) // RESET
regidx = slot + 1
regdata = slot + 3
_pokedata.1 = regdata
_peekdata.1 = regdata
pokeio(slot, $03) // Auto-increment indirect I/F + enable ping
//
// The following looks redundant, but it sets up the peek/poke locations
// for peekreg(s)/pokereg(s)
//
pokeiow(regidx, WIZ_MR)
if peekio(slot) == $03
saveidx = peekiow(slot + 1)
peekio(slot + 3) // Dummy read to data register should increment index
if peekiow(slot + 1) == saveidx + 1
//
// Good chance this is it
//
pokeio(slot, $80) // RESET
regidx = slot + 1
regdata = slot + 3
_pokedata.1 = regdata
_peekdata.1 = regdata
pokeio(slot, $03) // Auto-increment indirect I/F + enable ping
//
// The following looks redundant, but it sets up the peek/poke locations
// for peekreg(s)/pokereg(s)
//
pokeiow(regidx, WIZ_MR)
pokeio(regdata, $03) // Auto-increment indirect I/F + enable ping
peekio(regdata)
//
// Initialize common registers
//
pokeregs(WIZ_SHAR, @wizMAC, 6) // MAC addr
//
// Initialize common registers
//
pokeregs(WIZ_SHAR, @wizMAC, 6) // MAC addr
pokeregw(WIZ_RTR, 5000) // Timeout period to 500ms
pokereg(WIZ_RMSR, $55) // 2K Rx memory/channel
pokereg(WIZ_TMSR, $55) // 2K Tx memory/channel
//
// Print settings
//
puts("Found Uthernet II in slot #")
putc('0' + ((slot - $80) >> 4))
putln
//
// Print settings
//
puts("Found Uthernet II in slot #")
putc('0' + ((slot - $80) >> 4))
putln
//
// Fill channel structure
//
@ -881,25 +885,25 @@ for slot = $90 to $F0 step $10
saveidx=>channel_rxmem = WIZ_RXMEM + (WIZ_RXSIZE * slot)
saveidx = saveidx + t_channel
next
//
// Fill in Net class
//
iNet:serviceIP = @wizServiceIP
iNet:openUDP = @wizOpenUDP
iNet:sendUDP = @wizSendUDP
iNet:closeUDP = @wizCloseUDP
iNet:listenTCP = @wizListenTCP
iNet:connectTCP = @wizConnectTCP
iNet:sendTCP = @wizSendTCP
iNet:closeTCP = @wizCloseTCP
iNet:setInterfaceIP = @setWizIP
iNet:getInterfaceHA = @getWizHA
iNet:setCallback = @wizSetCallback
iNet:setParam = @wizSetParam
//
// Fill in Net class
//
iNet:serviceIP = @wizServiceIP
iNet:openUDP = @wizOpenUDP
iNet:sendUDP = @wizSendUDP
iNet:closeUDP = @wizCloseUDP
iNet:listenTCP = @wizListenTCP
iNet:connectTCP = @wizConnectTCP
iNet:sendTCP = @wizSendTCP
iNet:closeTCP = @wizCloseTCP
iNet:setInterfaceIP = @setWizIP
iNet:getInterfaceHA = @getWizHA
iNet:setCallback = @wizSetCallback
iNet:setParam = @wizSetParam
return modkeep
fin
fin
fin
pokeio(slot, regdata) // Restore register
pokeio(slot, regdata) // Restore register
fin
next
//

76
src/makefile

@ -122,7 +122,7 @@ test: samplesrc/test.pla samplesrc/testlib.pla $(PLVM) $(PLASM)
./$(PLVM) TEST
$(ED): toolsrc/ed.pla $(PLVM02) $(PLASM) toolsrc/ed.pla
./$(PLASM) -AO < toolsrc/ed.pla > toolsrc/ed.a
./$(PLASM) -AOW < toolsrc/ed.pla > toolsrc/ed.a
acme --setpc 8192 -o $(ED) toolsrc/ed.a
$(SB): toolsrc/sb.pla $(PLVM02) $(PLASM) toolsrc/sb.pla
@ -130,23 +130,23 @@ $(SB): toolsrc/sb.pla $(PLVM02) $(PLASM) toolsrc/sb.pla
acme --setpc 8192 -o $(SB) toolsrc/sb.a
$(ARGS): libsrc/args.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/args.pla > libsrc/args.a
./$(PLASM) -AMOW < libsrc/args.pla > libsrc/args.a
acme --setpc 4094 -o $(ARGS) libsrc/args.a
$(MEMMGR): libsrc/memmgr.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/memmgr.pla > libsrc/memmgr.a
./$(PLASM) -AMOW < libsrc/memmgr.pla > libsrc/memmgr.a
acme --setpc 4094 -o $(MEMMGR) libsrc/memmgr.a
$(MEMTEST): samplesrc/memtest.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/memtest.pla > samplesrc/memtest.a
./$(PLASM) -AMOW < samplesrc/memtest.pla > samplesrc/memtest.a
acme --setpc 4094 -o $(MEMTEST) samplesrc/memtest.a
$(FIBER): libsrc/fiber.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/fiber.pla > libsrc/fiber.a
./$(PLASM) -AMOW < libsrc/fiber.pla > libsrc/fiber.a
acme --setpc 4094 -o $(FIBER) libsrc/fiber.a
$(MON): samplesrc/mon.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/mon.pla > samplesrc/mon.a
./$(PLASM) -AMOW < samplesrc/mon.pla > samplesrc/mon.a
acme --setpc 4094 -o $(MON) samplesrc/mon.a
$(ROD): samplesrc/rod.pla $(PLVM02) $(PLASM)
@ -154,128 +154,128 @@ $(ROD): samplesrc/rod.pla $(PLVM02) $(PLASM)
acme --setpc 4094 -o $(ROD) samplesrc/rod.a
$(SIEVE): samplesrc/sieve.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/sieve.pla > samplesrc/sieve.a
./$(PLASM) -AMOW < samplesrc/sieve.pla > samplesrc/sieve.a
acme --setpc 4094 -o $(SIEVE) samplesrc/sieve.a
$(UTHERNET): libsrc/uthernet.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/uthernet.pla > libsrc/uthernet.a
./$(PLASM) -AMOW < libsrc/uthernet.pla > libsrc/uthernet.a
acme --setpc 4094 -o $(UTHERNET) libsrc/uthernet.a
$(UTHERNET2): libsrc/uthernet2.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/uthernet2.pla > libsrc/uthernet2.a
./$(PLASM) -AMOW < libsrc/uthernet2.pla > libsrc/uthernet2.a
acme --setpc 4094 -o $(UTHERNET2) libsrc/uthernet2.a
$(ETHERIP): libsrc/etherip.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/etherip.pla > libsrc/etherip.a
./$(PLASM) -AMOW < libsrc/etherip.pla > libsrc/etherip.a
acme --setpc 4094 -o $(ETHERIP) libsrc/etherip.a
$(INET): libsrc/inet.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/inet.pla > libsrc/inet.a
./$(PLASM) -AMOW < libsrc/inet.pla > libsrc/inet.a
acme --setpc 4094 -o $(INET) libsrc/inet.a
$(DHCP): libsrc/dhcp.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/dhcp.pla > libsrc/dhcp.a
./$(PLASM) -AMOW < libsrc/dhcp.pla > libsrc/dhcp.a
acme --setpc 4094 -o $(DHCP) libsrc/dhcp.a
$(HTTPD): samplesrc/httpd.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/httpd.pla > samplesrc/httpd.a
./$(PLASM) -AMOW < samplesrc/httpd.pla > samplesrc/httpd.a
acme --setpc 4094 -o $(HTTPD) samplesrc/httpd.a
$(FILEIO): libsrc/fileio.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/fileio.pla > libsrc/fileio.a
./$(PLASM) -AMOW < libsrc/fileio.pla > libsrc/fileio.a
acme --setpc 4094 -o $(FILEIO) libsrc/fileio.a
$(CONIO): libsrc/conio.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/conio.pla > libsrc/conio.a
./$(PLASM) -AMOW < libsrc/conio.pla > libsrc/conio.a
acme --setpc 4094 -o $(CONIO) libsrc/conio.a
$(SANE): libsrc/sane.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/sane.pla > libsrc/sane.a
./$(PLASM) -AMOW < libsrc/sane.pla > libsrc/sane.a
acme --setpc 4094 -o $(SANE) libsrc/sane.a
$(FPSTR): libsrc/fpstr.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/fpstr.pla > libsrc/fpstr.a
./$(PLASM) -AMOW < libsrc/fpstr.pla > libsrc/fpstr.a
acme --setpc 4094 -o $(FPSTR) libsrc/fpstr.a
$(FPU): libsrc/fpu.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/fpu.pla > libsrc/fpu.a
./$(PLASM) -AMOW < libsrc/fpu.pla > libsrc/fpu.a
acme --setpc 4094 -o $(FPU) libsrc/fpu.a
$(SANITY): samplesrc/sanity.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/sanity.pla > samplesrc/sanity.a
./$(PLASM) -AMOW < samplesrc/sanity.pla > samplesrc/sanity.a
acme --setpc 4094 -o $(SANITY) samplesrc/sanity.a
$(RPNCALC): samplesrc/rpncalc.pla libsrc/fpu.pla inc/fpu.plh libsrc/fpstr.pla inc/fpstr.plh libsrc/conio.pla inc/conio.plh $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/rpncalc.pla > samplesrc/rpncalc.a
./$(PLASM) -AMOW < samplesrc/rpncalc.pla > samplesrc/rpncalc.a
acme --setpc 4094 -o $(RPNCALC) samplesrc/rpncalc.a
$(TONE): libsrc/tone.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/tone.pla > libsrc/tone.a
./$(PLASM) -AMOW < libsrc/tone.pla > libsrc/tone.a
acme --setpc 4094 -o $(TONE) libsrc/tone.a
$(FATCAT): samplesrc/fatcat.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/fatcat.pla > samplesrc/fatcat.a
./$(PLASM) -AMOW < samplesrc/fatcat.pla > samplesrc/fatcat.a
acme --setpc 4094 -o $(FATCAT) samplesrc/fatcat.a
$(FATGET): samplesrc/fatget.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/fatget.pla > samplesrc/fatget.a
./$(PLASM) -AMOW < samplesrc/fatget.pla > samplesrc/fatget.a
acme --setpc 4094 -o $(FATGET) samplesrc/fatget.a
$(FATPUT): samplesrc/fatput.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/fatput.pla > samplesrc/fatput.a
./$(PLASM) -AMOW < samplesrc/fatput.pla > samplesrc/fatput.a
acme --setpc 4094 -o $(FATPUT) samplesrc/fatput.a
$(FATWDSK): samplesrc/fatwritedsk.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/fatwritedsk.pla > samplesrc/fatwritedsk.a
./$(PLASM) -AMOW < samplesrc/fatwritedsk.pla > samplesrc/fatwritedsk.a
acme --setpc 4094 -o $(FATWDSK) samplesrc/fatwritedsk.a
$(FATRDSK): samplesrc/fatreaddsk.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/fatreaddsk.pla > samplesrc/fatreaddsk.a
./$(PLASM) -AMOW < samplesrc/fatreaddsk.pla > samplesrc/fatreaddsk.a
acme --setpc 4094 -o $(FATRDSK) samplesrc/fatreaddsk.a
$(SDFAT): libsrc/sdfat.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/sdfat.pla > libsrc/sdfat.a
./$(PLASM) -AMOW < libsrc/sdfat.pla > libsrc/sdfat.a
acme --setpc 4094 -o $(SDFAT) libsrc/sdfat.a
$(SPIPORT): libsrc/spiport.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/spiport.pla > libsrc/spiport.a
./$(PLASM) -AMOW < libsrc/spiport.pla > libsrc/spiport.a
acme --setpc 4094 -o $(SPIPORT) libsrc/spiport.a
$(PORTIO): libsrc/portio.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/portio.pla > libsrc/portio.a
./$(PLASM) -AMOW < libsrc/portio.pla > libsrc/portio.a
acme --setpc 4094 -o $(PORTIO) libsrc/portio.a
$(DGR): libsrc/dgr.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/dgr.pla > libsrc/dgr.a
./$(PLASM) -AMOW < libsrc/dgr.pla > libsrc/dgr.a
acme --setpc 4094 -o $(DGR) libsrc/dgr.a
$(DGRTEST): samplesrc/dgrtest.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/dgrtest.pla > samplesrc/dgrtest.a
./$(PLASM) -AMOW < samplesrc/dgrtest.pla > samplesrc/dgrtest.a
acme --setpc 4094 -o $(DGRTEST) samplesrc/dgrtest.a
$(ROGUE): samplesrc/rogue.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/rogue.pla > samplesrc/rogue.a
./$(PLASM) -AMOW < samplesrc/rogue.pla > samplesrc/rogue.a
acme --setpc 4094 -o $(ROGUE) samplesrc/rogue.a
$(ROGUEIO): samplesrc/rogue.io.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/rogue.io.pla > samplesrc/rogue.io.a
./$(PLASM) -AMOW < samplesrc/rogue.io.pla > samplesrc/rogue.io.a
acme --setpc 4094 -o $(ROGUEIO) samplesrc/rogue.io.a
$(ROGUECOMBAT): samplesrc/rogue.combat.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/rogue.combat.pla > samplesrc/rogue.combat.a
./$(PLASM) -AMOW < samplesrc/rogue.combat.pla > samplesrc/rogue.combat.a
acme --setpc 4094 -o $(ROGUECOMBAT) samplesrc/rogue.combat.a
$(ROGUEMAP): samplesrc/rogue.map.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/rogue.map.pla > samplesrc/rogue.map.a
./$(PLASM) -AMOW < samplesrc/rogue.map.pla > samplesrc/rogue.map.a
acme --setpc 4094 -o $(ROGUEMAP) samplesrc/rogue.map.a
$(HGR1): samplesrc/hgr1.pla samplesrc/hgr1test.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/hgr1test.pla > samplesrc/hgr1test.a
./$(PLASM) -AMOW < samplesrc/hgr1test.pla > samplesrc/hgr1test.a
acme --setpc 4094 -o $(HGR1TEST) samplesrc/hgr1test.a
./$(PLASM) -AMO < samplesrc/hgr1.pla > samplesrc/hgr1.a
./$(PLASM) -AMOW < samplesrc/hgr1.pla > samplesrc/hgr1.a
acme --setpc 4094 -o $(HGR1) samplesrc/hgr1.a
hello: samplesrc/hello.pla $(PLVM) $(PLASM)
./$(PLASM) -AMO < samplesrc/hello.pla > samplesrc/hello.a
./$(PLASM) -AMOW < samplesrc/hello.pla > samplesrc/hello.a
acme --setpc 4094 -o $(HELLO) samplesrc/hello.a
./$(PLVM) HELLO

4
src/samplesrc/fatcat.pla

@ -6,7 +6,7 @@ word arg
byte[64] cwd
byte[64] pathname
def fatCat(path)
def fatCat(path)#0
byte filename[32]
sdFAT:dirSet(path)
@ -46,4 +46,4 @@ if ^arg
else
fatCat(@cwd)
fin
done
done

22
src/samplesrc/fatget.pla

@ -11,7 +11,7 @@ byte protype
word proaux
word arg
def putByte(val)
def putByte(val)#0
byte c
c = ((val >> 4) & $0F) + '0'
if c > '9'
@ -22,29 +22,22 @@ def putByte(val)
if c > '9'
c = c + 7
fin
return putc(c)
putc(c)
end
def putWord(val)
def putWord(val)#0
putByte(val.1)
return putByte(val.0)
end
def charUpper(c)
if c >= 'a' and c <= 'z'
return c - LOWER_DIFF
fin
return c
putByte(val.0)
end
def hexByte(hexChars)
byte lo, hi
lo = charUpper(^(hexChars + 1)) - '0'
lo = toupper(^(hexChars + 1)) - '0'
if lo > 9
lo = lo - 7
fin
hi = charUpper(^hexChars) - '0'
hi = toupper(^hexChars) - '0'
if hi > 9
hi = hi - 7
fin
@ -55,7 +48,7 @@ def hexWord(hexChars)
return (hexByte(hexChars) << 8) | hexByte(hexChars + 2)
end
def mkProName(fatName, proName, proType, proAux)
def mkProName(fatName, proName, proType, proAux)#0
byte n, l
^proType = $02 // default to BIN
@ -169,6 +162,7 @@ def fatCopyFrom(src, dst, type, aux)
fin
fileio:close(ref)
heaprelease(freeAddr)
return 0
end
arg = argNext(argFirst)

9
src/samplesrc/fatput.pla

@ -9,7 +9,7 @@ const LOWER_DIFF = 'a' - 'A'
word arg
byte[24] fatName
def putByte(val)
def putByte(val)#0
byte c
c = ((val >> 4) & $0F) + '0'
if c > '9'
@ -20,10 +20,10 @@ def putByte(val)
if c > '9'
c = c + 7
fin
return putc(c)
putc(c)
end
def hexChars(cptr, b)
def hexChars(cptr, b)#0
byte h
h = ((b >> 4) & $0F) + '0'
@ -68,7 +68,9 @@ def mkFatName(proName, fatName)
// Error getting info on file
//
puts("Error reading "); puts(proName); putln
return -1
fin
return 0
end
def getYN(prompt)
@ -134,6 +136,7 @@ def fatCopyTo(src, dst)
fin
fileio:close(ref)
heaprelease(freeAddr)
return 0
end
arg = argNext(argFirst)

17
src/samplesrc/fatreaddsk.pla

@ -23,7 +23,7 @@ byte order
//
byte[] secOrder = $0,$E,$D,$C,$B,$A,$9,$8,$7,$6,$5,$4,$3,$2,$1,$F
def putb(b)
def putb(b)#0
byte c
c = ((b >> 4) & $0F) + '0'
if c > '9'
@ -34,14 +34,7 @@ def putb(b)
if c > '9'
c = c + 7
fin
return putc(c)
end
def charUpper(c)
if c >= 'a' and c <= 'z'
return c - LOWER_DIFF
fin
return c
putc(c)
end
def getYN(prompt)
@ -53,7 +46,7 @@ def getYN(prompt)
return yn == 'Y' or yn == 'y'
end
def trkSecToBlk(bufSec, bufBlk)
def trkSecToBlk(bufSec, bufBlk)#0
byte sector
for sector = 0 to 15
@ -130,8 +123,10 @@ def fatReadImage(src, drv, order)
sdFAT:fileClose()
else
puts("Error opening image file:"); puts(src); putln
return -1
fin
heaprelease(freeAddr)
return 0
end
arg = argNext(argFirst)
@ -158,7 +153,7 @@ if ^arg
// Figure sector ordering from filename
//
puts("\nUsing ")
if charUpper(^(image + ^image)) == 'O' and charUpper(^(image + ^image - 1)) == 'P'
if toupper(^(image + ^image)) == 'O' and toupper(^(image + ^image - 1)) == 'P'
order = ORDER_PRODOS
puts("ProDOS")
else

17
src/samplesrc/fatwritedsk.pla

@ -24,7 +24,7 @@ byte order
//
byte[] secOrder = $0,$E,$D,$C,$B,$A,$9,$8,$7,$6,$5,$4,$3,$2,$1,$F
def putb(b)
def putb(b)#0
byte c
c = ((b >> 4) & $0F) + '0'
if c > '9'
@ -35,14 +35,7 @@ def putb(b)
if c > '9'
c = c + 7
fin
return putc(c)
end
def charUpper(c)
if c >= 'a' and c <= 'z'
return c - LOWER_DIFF
fin
return c
putc(c)
end
def getYN(prompt)
@ -54,7 +47,7 @@ def getYN(prompt)
return yn == 'Y' or yn == 'y'
end
def trkSecToBlk(bufSec, bufBlk)
def trkSecToBlk(bufSec, bufBlk)#0
byte sector
for sector = 0 to 15
@ -132,8 +125,10 @@ def fatWriteImage(src, drv, order)
sdFAT:fileClose()
else
puts("Error opening image file:"); puts(src); putln
return -1
fin
heaprelease(freeAddr)
return 0
end
arg = argNext(argFirst)
@ -160,7 +155,7 @@ if ^arg
// Figure sector ordering from filename
//
puts("\nUsing ")
if charUpper(^(image + ^image)) == 'O' and charUpper(^(image + ^image - 1)) == 'P'
if toupper(^(image + ^image)) == 'O' and toupper(^(image + ^image - 1)) == 'P'
order = ORDER_PRODOS
puts("ProDOS")
else

113
src/samplesrc/hgr1test.pla

@ -52,63 +52,64 @@ word testval
//
// def draw_scan(d8p8, scanptr)
//
asm draw_scan
!SOURCE "vmsrc/plvmzp.inc"
WFIXL = $80
WFIXH = $81
WINT = $82
PIX = $83
LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
LDA ESTKL+1,X
STA WFIXL
STA WFIXH
LDA ESTKH+1,X
LSR
STA WINT
ROR WFIXH
ROR WFIXL
LDA #$FF
SEC
SBC WFIXL
STA WFIXL
LDA #$FF
SBC WFIXH
STA WFIXH
LDA #$FF
SBC WINT
STA WINT
LDY #$01
STY PIX
DEY
- EOR ESTKH+1,X
LSR
BCC +
LDA PIX
ORA (TMP),Y
STA (TMP),Y
+ ASL PIX
BPL +
SEC
ROL PIX
INY
CPY #36
BEQ ++
+ LDA ESTKL+1,X
ADC WFIXL
STA WFIXL
LDA ESTKH+1,X
ADC WFIXH
STA WFIXH
BCC -
INC WINT
BCS -
++ INX
RTS
asm draw_scan(d8p8, scanptr)#0
!SOURCE "vmsrc/plvmzp.inc"
WFIXL = $80
WFIXH = $81
WINT = $82
PIX = $83
LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
LDA ESTKL+1,X
STA WFIXL
STA WFIXH
LDA ESTKH+1,X
LSR
STA WINT
ROR WFIXH
ROR WFIXL
LDA #$FF
SEC
SBC WFIXL
STA WFIXL
LDA #$FF
SBC WFIXH
STA WFIXH
LDA #$FF
SBC WINT
STA WINT
LDY #$01
STY PIX
DEY
- EOR ESTKH+1,X
LSR
BCC +
LDA PIX
ORA (TMP),Y
STA (TMP),Y
+ ASL PIX
BPL +
SEC
ROL PIX
INY
CPY #36
BEQ ++
+ LDA ESTKL+1,X
ADC WFIXL
STA WFIXL
LDA ESTKH+1,X
ADC WFIXH
STA WFIXH
BCC -
INC WINT
BCS -
++ INX
INX
RTS
end
def draw_ground(page)
def draw_ground(page)#0
byte ip
for ip = 1 to view_height

19
src/samplesrc/httpd.pla

@ -40,21 +40,21 @@ byte mimeOctetStream = "application/octet-stream"
//
// DEBUG
//
def putb(hexb)
return call($FDDA, hexb, 0, 0, 0)
def putb(hexb)#0
call($FDDA, hexb, 0, 0, 0)
end
def puth(hex)
return call($F941, hex >> 8, hex, 0, 0)
def puth(hex)#0
call($F941, hex >> 8, hex, 0, 0)
end
def putip(ipptr)
def putip(ipptr)#0
byte i
for i = 0 to 2
puti(ipptr->[i]); putc('.')
next
return puti(ipptr->[i])
puti(ipptr->[i])
end
def dumpbytes(buf, len)
def dumpbytes(buf, len)#0
word i
for i = 0 to len - 1
@ -66,7 +66,7 @@ def dumpbytes(buf, len)
fin
next
end
def dumpchars(buf, len)
def dumpchars(buf, len)#0
word i
len = len - 1
@ -96,7 +96,7 @@ end
//
// Send the file contents
//
def sendFile(fd, socket, len)
def sendFile(fd, socket, len)#0
while isuge(len, 1024)
fileio:read(fd, filebuff, 1024)
len = len - 1024
@ -196,6 +196,7 @@ def servHTTP(remip, remport, lclport, data, len, param)
fin
fin
socketHTTP = iNet:closeTCP(socketHTTP)
return 0
end
if !iNet:initIP()

6
src/samplesrc/memtest.pla

@ -1,9 +1,5 @@
include "inc/cmdsys.plh"
import memmgr
predef sweep, brk, sbrk
predef hmemNew, hmemLock, hmemUnlock, hmemRef, hmemDel, hmemFre
const MAX_MEMBLK_SIZE = $2000
end
include "inc/memmgr.plh"
word a, b, c, d, e, memptr
word memfre, memlrgst

18
src/samplesrc/rod.pla

@ -234,15 +234,15 @@ def rod#0
color = (j * 3) / (i + 3) + i * w / 12
fmi = 40 - i
fmk = 40 - k
grcolor(color)#0
grplot(i, k)#0
grplot(k, i)#0
grplot(fmi, fmk)#0
grplot(fmk, fmi)#0
grplot(k, fmi)#0
grplot(fmi, k)#0
grplot(i, fmk)#0
grplot(fmk, i)#0
grcolor(color)
grplot(i, k)
grplot(k, i)
grplot(fmi, fmk)
grplot(fmk, fmi)
grplot(k, fmi)
grplot(fmi, k)
grplot(i, fmk)
grplot(fmk, i)
if keypressed()#1
return
fin

22
src/samplesrc/rogue.combat.pla

@ -1,9 +1,11 @@
include "inc/cmdsys.plh"
import ROGUEMAP
predef puti, toupper, moveplayer
import rogueio
word rnd, getkb, home, gotoxy, tone
end
import roguemap
predef moveplayer
end
struc t_pos
byte xpos
@ -125,7 +127,7 @@ export word entities = 0
// Combat Return 1 if running away, 0 if end of fight
//
def win
def win#0
tone(30, 15)
tone(5, 15)
tone(5, 15)
@ -180,18 +182,18 @@ export def fight(player, enemy)
p_atck = 100
fin
player->skill = p_atck
//
// Unlink dead enemy from entities list
//
//
// Unlink dead enemy from entities list
//
if enemy == entities
entities = enemy=>next_other
fin
if enemy=>next_other
if enemy=>next_other
enemy=>next_other=>prev_other = enemy=>prev_other
fin
if enemy=>prev_other
fin
if enemy=>prev_other
enemy=>prev_other=>next_other = enemy=>next_other
fin
fin
fin
if player->health > e_atck
player->health = player->health - e_atck

19
src/samplesrc/rogue.io.pla

@ -65,6 +65,7 @@ def a2tone(duration, delay)
next
duration = duration - 1
loop
return 0
end
def a3tone(duration, pitch)
@ -74,6 +75,7 @@ def a3tone(duration, pitch)
^ENV_REG = env | $C0
a2tone(duration, pitch)
^ENV_REG = env
return 0
end
//
@ -94,8 +96,8 @@ def a2close(refnum)
byte params[2]
if iobuff
heaprelease(iobuff)
iobuff = 0
heaprelease(iobuff)
iobuff = 0
fin
params.0 = 1
params.1 = refnum
@ -192,14 +194,16 @@ def a3getkb
end
def a3home
return putc(28)
putc(28)
return 0
end
def a3gotoxy(ch, cv)
putc(24)
putc(ch)
putc(25)
return putc(cv)
putc(cv)
return 0
end
//
@ -215,13 +219,6 @@ def a2gotoxy(x, y)
return call($FB5B, y + ^$22, 0, 0, 0)
end
export def toupper(c)
if c >= 'a' and c <= 'z'
c = c - $20
fin
return c
end
//
// Set machine specific routines
//

333
src/samplesrc/rogue.map.pla

@ -8,7 +8,6 @@ import rogueio
const O_WRITE = 2
const O_READ_WRITE = 3
predef puti, toupper
word rnd, getkb, home, gotoxy, tone, open, read, close, newline
end
@ -200,7 +199,7 @@ export def getmaptile(xmap, ymap)
return ^(map + (ymap << rowshift) + xmap)
end
export def setmaptile(xmap, ymap, tile)
export def setmaptile(xmap, ymap, tile)#0
word imap
imap = (ymap << rowshift) + xmap
@ -210,7 +209,7 @@ export def setmaptile(xmap, ymap, tile)
fin
end
export def updtmaptile(xmap, ymap, tile)
export def updtmaptile(xmap, ymap, tile)#0
word imap
imap = (ymap << rowshift) + xmap
@ -224,7 +223,7 @@ end
// Light torches in map
//
export def lighttorches
export def lighttorches#0
word imap, tmap
byte xmap, ymap, xt, yt
@ -233,11 +232,11 @@ export def lighttorches
imap = (ymap << rowshift) + xmap
if ^(map + imap) & MAP_TILE == TORCH_TILE
for yt = ymap - 1 to ymap + 1
for xt = xmap - 1 to xmap + 1
for xt = xmap - 1 to xmap + 1
tmap = (yt << rowshift) + xt
^(map + tmap) = ^(map + tmap) | LIT_TILE
next
next
^(map + tmap) = ^(map + tmap) | LIT_TILE
next
next
fin
next
if not (ymap & 7)
@ -306,96 +305,96 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
occluded = 1
when o & 7
is 0
//
// Run through lit octant beam points
//
//
// Run through lit octant beam points
//
for l = 1 to dbeam[lightdist]
//
// Check parent visiblity
//
//
// Check parent visiblity
//
if vispix[vbeam[l]]
imap = ((yorg - ybeam[l]) << rowshift) + xorg + xbeam[l]
tile = ^(map + imap)
if tile & OPAQUE_TILE
//
// The view stops here
//
//
// The view stops here
//
vispix[l] = 0
else
//
// This tile is transparent
//
//
// This tile is transparent
//
vispix[l] = 1
//
// Check adjacent tile for opaqueness - improves wall display
//
//
// Check adjacent tile for opaqueness - improves wall display
//
adjtile = ^(map + imap + 1) & INV_TILE
if adjtile & OPAQUE_TILE
^(viewmap + imap + 1) = adjtile | VIEWED_TILE
screen.[ycentr-ybeam[l], xcentr+xbeam[l]+1] = adjtile
fin
fin
fin
//
// Update view
//
//
// Update view
//
^(viewmap + imap) = tile | VIEWED_TILE
if tile <> PIT_TILE
if tile <> PIT_TILE
screen.[ycentr-ybeam[l], xcentr+xbeam[l]] = tile & INV_TILE
fin
fin
else
vispix[l] = 0
fin
next
//
// Run through visible octant beam points
//
//
// Run through visible octant beam points
//
for l = l to dbeam[viewdist]
//
// Check parent visiblity
//
//
// Check parent visiblity
//
if vispix[vbeam[l]]
imap = ((yorg - ybeam[l]) << rowshift) + xorg + xbeam[l]
tile = ^(map + imap)
if tile & OPAQUE_TILE
//
// The view stops here
//
//
// The view stops here
//
vispix[l] = 0
else
//
// This tile is transparent
//
//
// This tile is transparent
//
vispix[l] = 1
occluded = 0
occluded = 0
fin
//
// If the tile is in light, update view
//
if tile & LIT_TILE
//
// If the tile is in light, update view
//
if tile & LIT_TILE
^(viewmap + imap) = tile | VIEWED_TILE
screen.[ycentr-ybeam[l], xcentr+xbeam[l]] = tile & INV_TILE
darkness = 0
fin
fin
else
vispix[l] = 0
fin
//
// Advance beam distance
//
if l == dbeam[dist]
if occluded
//
// Beam fully occluded
//
break
fin
//
// Update distance
//
//
// Advance beam distance
//
if l == dbeam[dist]
if occluded
//
// Beam fully occluded
//
break
fin
//
// Update distance
//
occluded = 1
dist = dist + 1
fin
next
fin
next
break
is 1
for l = 1 to dbeam[lightdist]
@ -410,12 +409,12 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
if adjtile & OPAQUE_TILE
^(viewmap + imap - mapcols) = adjtile | VIEWED_TILE
screen.[ycentr-xbeam[l]-1, xcentr+ybeam[l]] = adjtile
fin
fin
fin
^(viewmap + imap) = tile | VIEWED_TILE
if tile <> PIT_TILE
if tile <> PIT_TILE
screen.[ycentr-xbeam[l], xcentr+ybeam[l]] = tile & INV_TILE
fin
fin
else
vispix[l] = 0
fin
@ -428,24 +427,24 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
vispix[l] = 0
else
vispix[l] = 1
occluded = 0
occluded = 0
fin
if tile & LIT_TILE
if tile & LIT_TILE
^(viewmap + imap) = tile | VIEWED_TILE
screen.[ycentr-xbeam[l], xcentr+ybeam[l]] = tile & INV_TILE
darkness = 0
fin
fin
else
vispix[l] = 0
fin
if l == dbeam[dist]
if occluded
break
fin
if l == dbeam[dist]
if occluded
break
fin
occluded = 1
dist = dist + 1
fin
next
fin
next
break
is 2
for l = 1 to dbeam[lightdist]
@ -455,17 +454,17 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
if tile & OPAQUE_TILE
vispix[l] = 0
else
vispix[l] = 1
adjtile = ^(map + imap + mapcols) & INV_TILE
vispix[l] = 1
adjtile = ^(map + imap + mapcols) & INV_TILE
if adjtile & OPAQUE_TILE
^(viewmap + imap + mapcols) = adjtile | VIEWED_TILE
screen.[ycentr+xbeam[l]+1, xcentr+ybeam[l]] = adjtile
fin
fin
fin
^(viewmap + imap) = tile | VIEWED_TILE
if tile <> PIT_TILE
if tile <> PIT_TILE
screen.[ycentr+xbeam[l], xcentr+ybeam[l]] = tile & INV_TILE
fin
fin
else
vispix[l] = 0
fin
@ -477,25 +476,25 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
if tile & OPAQUE_TILE
vispix[l] = 0
else
vispix[l] = 1
occluded = 0
fin
if tile & LIT_TILE
vispix[l] = 1
occluded = 0
fin
if tile & LIT_TILE
^(viewmap + imap) = tile | VIEWED_TILE
screen.[ycentr+xbeam[l], xcentr+ybeam[l]] = tile & INV_TILE
darkness = 0
fin
fin
else
vispix[l] = 0
fin
if l == dbeam[dist]
if occluded
break
fin
if l == dbeam[dist]
if occluded
break
fin
occluded = 1
dist = dist + 1
fin
next
fin
next
break
is 3
for l = 1 to dbeam[lightdist]
@ -505,17 +504,17 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
if tile & OPAQUE_TILE
vispix[l] = 0
else
vispix[l] = 1
adjtile = ^(map + imap + 1) & INV_TILE
vispix[l] = 1
adjtile = ^(map + imap + 1) & INV_TILE
if adjtile & OPAQUE_TILE
^(viewmap + imap + 1) = adjtile | VIEWED_TILE
screen.[ycentr+ybeam[l], xcentr+xbeam[l]+1] = adjtile
fin
fin
^(viewmap + imap) = tile | VIEWED_TILE
if tile <> PIT_TILE
if tile <> PIT_TILE
screen.[ycentr+ybeam[l], xcentr+xbeam[l]] = tile & INV_TILE
fin
fin
else
vispix[l] = 0
fin
@ -527,25 +526,25 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
if tile & OPAQUE_TILE
vispix[l] = 0
else
vispix[l] = 1
occluded = 0
fin
if tile & LIT_TILE
vispix[l] = 1
occluded = 0
fin
if tile & LIT_TILE
^(viewmap + imap) = tile | VIEWED_TILE
screen.[ycentr+ybeam[l], xcentr+xbeam[l]] = tile & INV_TILE
darkness = 0
fin
fin
else
vispix[l] = 0
fin
if l == dbeam[dist]
if occluded
break
fin
if l == dbeam[dist]
if occluded
break
fin
occluded = 1
dist = dist + 1
fin
next
fin
next
break
is 4
for l = 1 to dbeam[lightdist]
@ -555,17 +554,17 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
if tile & OPAQUE_TILE
vispix[l] = 0
else
vispix[l] = 1
adjtile = ^(map + imap - 1) & INV_TILE
vispix[l] = 1
adjtile = ^(map + imap - 1) & INV_TILE
if adjtile & OPAQUE_TILE
^(viewmap + imap - 1) = adjtile | VIEWED_TILE
screen.[ycentr+ybeam[l], xcentr-xbeam[l]-1] = adjtile
fin
fin
^(viewmap + imap) = tile | VIEWED_TILE
if tile <> PIT_TILE
if tile <> PIT_TILE
screen.[ycentr+ybeam[l], xcentr-xbeam[l]] = tile & INV_TILE
fin
fin
else
vispix[l] = 0
fin
@ -577,25 +576,25 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
if tile & OPAQUE_TILE
vispix[l] = 0
else
vispix[l] = 1
occluded = 0
fin
if tile & LIT_TILE
vispix[l] = 1
occluded = 0
fin
if tile & LIT_TILE
^(viewmap + imap) = tile | VIEWED_TILE
screen.[ycentr+ybeam[l], xcentr-xbeam[l]] = tile & INV_TILE
darkness = 0
fin
fin
else
vispix[l] = 0
fin
if l == dbeam[dist]
if occluded
break
fin
if l == dbeam[dist]
if occluded
break
fin
occluded = 1
dist = dist + 1
fin
next
fin
next
break
is 5
for l = 1 to dbeam[lightdist]
@ -605,17 +604,17 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
if tile & OPAQUE_TILE
vispix[l] = 0
else
vispix[l] = 1
adjtile = ^(map + imap + mapcols) & INV_TILE
vispix[l] = 1
adjtile = ^(map + imap + mapcols) & INV_TILE
if adjtile & OPAQUE_TILE
^(viewmap + imap + mapcols) = adjtile | VIEWED_TILE
screen.[ycentr+xbeam[l]+1, xcentr-ybeam[l]] = adjtile
fin
fin
^(viewmap + imap) = tile | VIEWED_TILE
if tile <> PIT_TILE
if tile <> PIT_TILE
screen.[ycentr+xbeam[l], xcentr-ybeam[l]] = tile & INV_TILE
fin
fin
else
vispix[l] = 0
fin
@ -627,26 +626,26 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
if tile & OPAQUE_TILE
vispix[l] = 0
else
vispix[l] = 1
occluded = 0
fin
if tile & LIT_TILE
vispix[l] = 1
occluded = 0
fin
if tile & LIT_TILE
^(viewmap + imap) = tile | VIEWED_TILE
screen.[ycentr+xbeam[l], xcentr-ybeam[l]] = tile & INV_TILE
darkness = 0
fin
fin
else
vispix[l] = 0
fin
if l == dbeam[dist]
if occluded
break
fin
if l == dbeam[dist]
if occluded
break
fin
occluded = 1
dist = dist + 1
fin
next
break
fin
next
break
is 6
for l = 1 to dbeam[lightdist]
if vispix[vbeam[l]]
@ -655,17 +654,17 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
if tile & OPAQUE_TILE
vispix[l] = 0
else
vispix[l] = 1
adjtile = ^(map + imap - mapcols) & INV_TILE
vispix[l] = 1
adjtile = ^(map + imap - mapcols) & INV_TILE
if adjtile & OPAQUE_TILE
^(viewmap + imap - mapcols) = adjtile | VIEWED_TILE
screen.[ycentr-xbeam[l]-1, xcentr-ybeam[l]] = adjtile
fin
fin
^(viewmap + imap) = tile | VIEWED_TILE
if tile <> PIT_TILE
if tile <> PIT_TILE
screen.[ycentr-xbeam[l], xcentr-ybeam[l]] = tile & INV_TILE
fin
fin
else
vispix[l] = 0
fin
@ -677,25 +676,25 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
if tile & OPAQUE_TILE
vispix[l] = 0
else
vispix[l] = 1
occluded = 0
fin
if tile & LIT_TILE
vispix[l] = 1
occluded = 0
fin
if tile & LIT_TILE
^(viewmap + imap) = tile | VIEWED_TILE
screen.[ycentr-xbeam[l], xcentr-ybeam[l]] = tile & INV_TILE
darkness = 0
fin
fin
else
vispix[l] = 0
fin
if l == dbeam[dist]
if occluded
break
fin
if l == dbeam[dist]
if occluded
break
fin
occluded = 1
dist = dist + 1
fin
next
fin
next
break
is 7
for l = 1 to dbeam[lightdist]
@ -705,17 +704,17 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
if tile & OPAQUE_TILE
vispix[l] = 0
else
vispix[l] = 1
adjtile = ^(map + imap - 1) & INV_TILE
vispix[l] = 1
adjtile = ^(map + imap - 1) & INV_TILE
if adjtile & OPAQUE_TILE
^(viewmap + imap - 1) = adjtile | VIEWED_TILE
screen.[ycentr-ybeam[l], xcentr-xbeam[l]-1] = adjtile
fin
fin
^(viewmap + imap) = tile | VIEWED_TILE
if tile <> PIT_TILE
if tile <> PIT_TILE
screen.[ycentr-ybeam[l], xcentr-xbeam[l]] = tile & INV_TILE
fin
fin
else
vispix[l] = 0
fin
@ -727,25 +726,25 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
if tile & OPAQUE_TILE
vispix[l] = 0
else
vispix[l] = 1
occluded = 0
fin
if tile & LIT_TILE
vispix[l] = 1
occluded = 0
fin
if tile & LIT_TILE
^(viewmap + imap) = tile | VIEWED_TILE
screen.[ycentr-ybeam[l], xcentr-xbeam[l]] = tile & INV_TILE
darkness = 0
fin
fin
else
vispix[l] = 0
fin
if l == dbeam[dist]
if occluded
break
fin
if l == dbeam[dist]
if occluded
break
fin
occluded = 1
dist = dist + 1
fin
next
fin
next
break
wend
next
@ -756,7 +755,7 @@ end
// Draw other entities
//
export def drawvisentity(xofst, yofst, tile)
export def drawvisentity(xofst, yofst, tile)#0
if screen.[ycentr+yofst, xcentr+xofst] < $80
screen.[ycentr+yofst, xcentr+xofst] = tile
fin

152
src/samplesrc/rogue.pla

@ -29,16 +29,18 @@ import roguemap
const INV_TILE = $3F
const MAP_TILE = $7F
predef loadmap, getmaptile, setmaptile, updtmaptile, lighttorches, drawmap, drawvisentity
predef loadmap(level), getmaptile(xmap, ymap), setmaptile(xmap, ymap, tile)#0
predef updtmaptile(xmap, ymap, tile)#0, lighttorches#0
predef drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
predef drawvisentity(xofst, yofst, tile)#0
end
import roguecombat
predef fight
predef fight(player, enemy)
word entity, entities
end
import rogueio
predef puti, toupper
word rnd, getkb, home, gotoxy, tone
end
@ -100,7 +102,7 @@ byte = 0 // key
byte = 0 // raft
byte[16] = "Player"
predef moveplayer
predef moveplayer(dir)#0
//
// Other monsters
@ -156,16 +158,16 @@ end
// Sound functions
//
def ouch
def ouch#0
tone(128,5)
end
def gotit
def gotit#0
tone(10,8)
tone(80,2)
end
def fall
def fall#0
byte i
for i = 0 to 10
@ -173,7 +175,7 @@ def fall
next
end
def drown
def drown#0
word i
tone(10,20)
@ -188,7 +190,7 @@ def drown
tone(10,3)
end
def groan
def groan#0
byte i
for i = 0 to 5
@ -200,7 +202,7 @@ end
// Update status line
//
def status
def status#0
gotoxy(0, statusline)
puts(@helthstr)
puti(player.health)
@ -223,15 +225,15 @@ def status
fin
end
def clearstatus
return memset($07D0, $A0A0, 40)
def clearstatus#0
memset($07D0, $A0A0, 40)
end
//
// Move player, check for obstacles
//
def moveplayer(dir)
def moveplayer(dir)#0
byte xmove, ymove
xmove = player.xpos + dir * xdir[player.angle]
@ -274,7 +276,7 @@ end
// Find other entities in map and put in database
//
def findentities
def findentities#0
word newother
byte xmap, ymap, what
@ -291,33 +293,33 @@ def findentities
player.angle = 4
fin
break
is 'R' // Rogue
what = what + 1
is 'Z' // Zombie
what = what + 1
is 'R' // Rogue
what = what + 1
is 'Z' // Zombie
what = what + 1
is 'O' // Ogre
what = what + 1
what = what + 1
is 'T' // Thief
newother = heapalloc(t_other)
newother->xpos = xmap
newother->ypos = ymap
newother->kind = what
newother->tileid = ^(entity[what] + 1) // First character of name string
newother->power = ^(entity[what] + ^entity[what] + 1)
newother->life = 100
//
// Insert into head of entities list
//
newother=>prev_other = 0
newother=>next_other = entities
if entities
entities=>prev_other = newother
fin
entities = newother
//
// Clear entity from map, replace with floor
//
setmaptile(xmap, ymap, FLOOR_TILE)
newother = heapalloc(t_other)
newother->xpos = xmap
newother->ypos = ymap
newother->kind = what
newother->tileid = ^(entity[what] + 1) // First character of name string
newother->power = ^(entity[what] + ^entity[what] + 1)
newother->life = 100
//
// Insert into head of entities list
//
newother=>prev_other = 0
newother=>next_other = entities
if entities
entities=>prev_other = newother
fin
entities = newother
//
// Clear entity from map, replace with floor
//
setmaptile(xmap, ymap, FLOOR_TILE)
wend
next
if not (ymap & 7)
@ -330,7 +332,7 @@ end
// Draw other entities on map if visible
//
def drawentities
def drawentities#0
word other, xofst, yofst
other = entities
@ -404,7 +406,7 @@ def lineofsight(x1, y1, x2, y2)
return TRUE
end
def moveentities(playerisvis)
def moveentities(playerisvis)#0
byte xmove, ymove
word other
@ -444,7 +446,7 @@ def moveentities(playerisvis)
if player.energy > RUN_ENERGY
moveplayer(1)
fin
return moveplayer(1)
moveplayer(1)
fin
return
fin
@ -526,11 +528,11 @@ def play
fin
is DOOR_TILE
updtmaptile(player.xpos + xdir[player.angle], player.ypos + ydir[player.angle], FLOOR_TILE)
break
is ENTER_TILE
break
is EXIT_TILE
return FALSE
break
is ENTER_TILE
break
is EXIT_TILE
return FALSE
wend
break
is $0D // Return
@ -538,47 +540,47 @@ def play
is KEY_TILE
player.key = 1
updtmaptile(player.xpos, player.ypos, FLOOR_TILE)
gotit
break
gotit
break
is RAFT_TILE
player.raft = 1
updtmaptile(player.xpos, player.ypos, FLOOR_TILE)
gotit
break
gotit
break
is GOLD_TILE
player.gold = player.gold + 1
updtmaptile(player.xpos, player.ypos, FLOOR_TILE)
gotit
gotit
break
is TORCH_TILE
if player.oil < 1000
if player.oil < 1000
player:oil = player:oil + TORCH_OIL
if player:oil > 1000
player:oil = 1000
fin
if player:oil > 1000
player:oil = 1000
fin
setmaptile(player.xpos, player.ypos, FLOOR_TILE)
for yt = player.ypos - 1 to player.ypos + 1
for xt = player.xpos - 1 to player.xpos + 1
setmaptile(xt, yt, getmaptile(xt, yt) & MAP_TILE)
next
next
gotit
fin
for xt = player.xpos - 1 to player.xpos + 1
setmaptile(xt, yt, getmaptile(xt, yt) & MAP_TILE)
next
next
gotit
fin
break
is FOOD_TILE
if player.health < 100 or player.energy < 100
player.health = player.health + MANA/2
if player.health > 100
player.health = 100
fin
if player.health < 100 or player.energy < 100
player.health = player.health + MANA/2
if player.health > 100
player.health = 100
fin
player.energy = player.energy + MANA
if player.energy > 100
player.energy = 100
fin
updtmaptile(player.xpos, player.ypos, FLOOR_TILE)
player.fov = 1
gotit
fin
if player.energy > 100
player.energy = 100
fin
updtmaptile(player.xpos, player.ypos, FLOOR_TILE)
player.fov = 1
gotit
fin
break
wend
break
@ -603,7 +605,7 @@ def play
puts(@quitstr)
if toupper(getkb()) == 'Y'
player.health = 0
return FALSE
return FALSE
fin
wend
if player.energy and player.health < 100

12
src/samplesrc/rpncalc.pla

@ -21,10 +21,10 @@ struc t_keyinput
byte keyinfo[t_keypad]
word phandler
end
predef delKey#0, cmdKey#0, dropKey#0, clearKey#0
predef digitKey#0, pointKey#0, opKey#0
predef enterKey#0, copyKey#0, chsKey#0, memKey#0
predef elemsKey#0
predef delKey(pkey)#0, cmdKey(pkey)#0, dropKey(pkey)#0, clearKey(pkey)#0
predef digitKey(pkey)#0, pointKey(pkey)#0, opKey(pkey)#0
predef enterKey(pkey)#0, copyKey(pkey)#0, chsKey(pkey)#0, memKey(pkey)#0
predef elemsKey(pkey)#0
//
// Current input
//
@ -117,7 +117,7 @@ def repc(rep, c)#0
rep--
loop
end
def rect(x, y, width, height, frame, title)
def rect(x, y, width, height, frame, title)#0
byte i
conio:gotoxy(x + 1, y)
@ -413,7 +413,7 @@ end
//
// Keypress handler
//
def inputKey
def inputKey#0
byte inkey
word pkeys

4
src/samplesrc/sieve.pla

@ -10,8 +10,8 @@ byte iter
word prime, i, k, count
byte strPrimes[] = " primes.\n"
def beep
return putc(7)
def beep#0
putc(7)
end
beep

2
src/samplesrc/test.pla

@ -122,7 +122,7 @@ export def main(range)#0
puti(lambda(2,3));putln
end
def dummy(zz)#0
def dummy(zz)#2
puts("dummy func"); putln
return 0
end

326
src/toolsrc/parse.c

@ -49,20 +49,14 @@ int opsptr = -1;
void push_op(t_token op, int prec)
{
if (++opsptr == 16)
{
parse_error("Stack overflow\n");
return;
}
parse_error("Stack overflow");
opstack[opsptr] = op;
precstack[opsptr] = prec;
}
t_token pop_op(void)
{
if (opsptr < 0)
{
parse_error("Stack underflow\n");
return (0);
}
parse_error("Stack underflow");
return opstack[opsptr--];
}
t_token tos_op(void)
@ -80,10 +74,7 @@ int valptr = -1;
void push_val(long value, int size, int type)
{
if (++valptr == 16)
{
parse_error("Stack overflow\n");
return;
}
parse_error("Stack overflow");
valstack[valptr] = value;
sizestack[valptr] = size;
typestack[valptr] = type;
@ -91,10 +82,7 @@ void push_val(long value, int size, int type)
int pop_val(long *value, int *size, int *type)
{
if (valptr < 0)
{
parse_error("Stack underflow\n");
return (-1);
}
parse_error("Stack underflow");
*value = valstack[valptr];
*size = sizestack[valptr];
*type = typestack[valptr];
@ -111,10 +99,7 @@ int calc_op(t_token op)
return 0;
pop_val(&val1, &size1, &type1);
if (type1 != CONST_TYPE || type2 != CONST_TYPE)
{
parse_error("Bad constant operand");
return (0);
}
switch (op)
{
case MUL_TOKEN:
@ -170,15 +155,9 @@ int parse_constterm(long *value, int *size)
break;
case OPEN_PAREN_TOKEN:
if (!(type = parse_constexpr(value, size)))
{
parse_error("Bad expression in parenthesis");
return (0);
}
if (scantoken != CLOSE_PAREN_TOKEN)
{
parse_error("Missing closing parenthesis");
return (0);
}
break;
default:
/*
@ -232,10 +211,7 @@ int parse_constval(void)
value = constval;
type = STRING_TYPE;
if (mod)
{
parse_error("Invalid string modifiers");
return (0);
}
break;
case CHAR_TOKEN:
size = 1;
@ -295,10 +271,7 @@ int parse_constexpr(long *value, int *size)
matchop = 2;
if (binary_ops_precedence[i] >= tos_op_prec(optos))
if (!calc_op(pop_op()))
{
parse_error(": Invalid binary operation");
return (0);
}
parse_error("Invalid binary operation");
push_op(scantoken, binary_ops_precedence[i]);
break;
}
@ -307,16 +280,10 @@ int parse_constexpr(long *value, int *size)
if (matchop == 0 && prevmatch == 0)
return (0);
if (matchop == 0 && prevmatch == 2)
{
parse_error("Missing operand");
return (0);
}
while (optos < opsptr)
if (!calc_op(pop_op()))
{
parse_error(": Invalid binary operation");
return (0);
}
parse_error("Invalid binary operation");
pop_val(value, size, &type);
return (type);
}
@ -391,10 +358,7 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
else if (scantoken == AT_TOKEN)
{
if (deref-- == 0)
{
parse_error("Invalid ADDRESS-OF op");
return (NULL);
}
}
else if (scantoken == BPTR_TOKEN || scantoken == WPTR_TOKEN)
{
@ -407,10 +371,7 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
else if (scantoken == NEG_TOKEN || scantoken == COMP_TOKEN || scantoken == LOGIC_NOT_TOKEN)
{
if (!rvalue)
{
parse_error("Invalid op for LVALUE");
return (NULL);
}
uopseq = gen_uop(uopseq, scantoken);
}
else
@ -464,15 +425,9 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
else if (scantoken == OPEN_PAREN_TOKEN)
{
if (!(valseq = parse_expr(NULL, stackdepth)))
{
parse_error("Bad expression in parenthesis");
return (NULL);
}
if (scantoken != CLOSE_PAREN_TOKEN)
{
parse_error("Missing closing parenthesis");
return (NULL);
}
}
else
return (NULL);
@ -488,25 +443,21 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
*/
valseq = cat_seq(parse_list(NULL, &value), valseq);
if (scantoken != CLOSE_PAREN_TOKEN)
{
parse_error("Missing function call closing parenthesis");
return (NULL);
}
if (scan() == POUND_TOKEN)
{
/*
* Override return vals count
* Set function pointer return vals count - can't do this to regular function call
*/
if (type & FUNC_TYPE)
parse_error("Overriding function return count");
if (!parse_const(&cfnvals))
{
parse_error("Invalid def return value count");
return (0);
}
}
else
scan_rewind(tokenstr);
if ((type & FUNC_TYPE) && (cfnparms != value))
parse_warn("Parameter count mismatch");
parse_error("Parameter count mismatch");
if (stackdepth)
*stackdepth = cfnvals + cfnparms - value;
if (type & (VAR_TYPE | PTR_TYPE)) //!(type & (FUNC_TYPE | CONST_TYPE)))
@ -544,10 +495,7 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
valseq = gen_lw(valseq);
}
if (scantoken != CLOSE_BRACKET_TOKEN)
{
parse_error("Missing closing bracket");
return (NULL);
}
if (type & (WPTR_TYPE | WORD_TYPE))
{
valseq = gen_idxw(valseq);
@ -585,10 +533,7 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
if (!parse_const(&const_offset))
{
if (scantoken == EOL_TOKEN || scantoken == CLOSE_PAREN_TOKEN)
{
parse_error("Syntax");
return (NULL);
}
/*
* Setting type override for following operations
*/
@ -624,10 +569,7 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
if (!parse_const(&const_offset))
{
if (scantoken == EOL_TOKEN || scantoken == CLOSE_PAREN_TOKEN)
{
parse_error("Syntax");
return (NULL);
}
/*
* Setting type override for following operations
*/
@ -736,10 +678,7 @@ t_opseq *parse_expr(t_opseq *codeseq, int *stackdepth)
}
} while (matchop == 2);
if (matchop == 0 && prevmatch == 2)
{
parse_error("Missing operand");
return (NULL);
}
while (optos < opsptr)
{
codeseq = gen_op(codeseq, pop_op());
@ -761,10 +700,7 @@ t_opseq *parse_expr(t_opseq *codeseq, int *stackdepth)
codeseq = gen_brfls(codeseq, tag_else);
codeseq = parse_expr(codeseq, &stackdepth1);
if (scantoken != TRIELSE_TOKEN)
{
parse_error("Missing '::' in ternary op");
return (NULL);
}
codeseq = gen_brnch(codeseq, tag_endtri);
codeseq = gen_codetag(codeseq, tag_else);
codeseq = parse_expr(codeseq, stackdepth);
@ -804,10 +740,7 @@ t_opseq *parse_set(t_opseq *codeseq)
}
rseq = parse_list(NULL, &rparms);
if (lparms > rparms)
{
parse_error("Set value list underflow");
return (NULL);
}
if ((lparms != rparms) && (rparms - lparms != 1))
codeseq = gen_pushexp(codeseq);
codeseq = cat_seq(codeseq, rseq);
@ -838,10 +771,7 @@ int parse_stmnt(void)
{
case IF_TOKEN:
if (!(seq = parse_expr(NULL, NULL)))
{
parse_error("Bad expression");
return (0);
}
tag_else = tag_new(BRANCH_TYPE);
tag_endif = tag_new(BRANCH_TYPE);
seq = gen_brfls(seq, tag_else);
@ -855,10 +785,7 @@ int parse_stmnt(void)
emit_brnch(tag_endif);
emit_codetag(tag_else);
if (!(seq = parse_expr(NULL, NULL)))
{
parse_error("Bad expression");
return (0);
}
tag_else = tag_new(BRANCH_TYPE);
seq = gen_brfls(seq, tag_else);
emit_seq(seq);
@ -877,10 +804,7 @@ int parse_stmnt(void)
emit_codetag(tag_endif);
}
if (scantoken != FIN_TOKEN)
{
parse_error("Missing IF/FIN");
return (0);
}
break;
case WHILE_TOKEN:
tag_while = tag_new(BRANCH_TYPE);
@ -891,18 +815,12 @@ int parse_stmnt(void)
break_tag = tag_wend;
emit_codetag(tag_while);
if (!(seq = parse_expr(NULL, NULL)))
{
parse_error("Bad expression");
return (0);
}
seq = gen_brfls(seq, tag_wend);
emit_seq(seq);
while (parse_stmnt()) next_line();
if (scantoken != LOOP_TOKEN)
{
parse_error("Missing WHILE/END");
return (0);
}
emit_brnch(tag_while);
emit_codetag(tag_wend);
break_tag = tag_prevbrk;
@ -918,17 +836,11 @@ int parse_stmnt(void)
scan();
while (parse_stmnt()) next_line();
if (scantoken != UNTIL_TOKEN)
{
parse_error("Missing REPEAT/UNTIL");
return (0);
}
emit_codetag(cont_tag);
cont_tag = tag_prevcnt;
if (!(seq = parse_expr(NULL, NULL)))
{
parse_error("Bad expression");
return (0);
}
seq = gen_brfls(seq, tag_repeat);
emit_seq(seq);
emit_codetag(break_tag);
@ -942,22 +854,13 @@ int parse_stmnt(void)
tag_prevcnt = cont_tag;
cont_tag = tag_for;
if (scan() != ID_TOKEN)
{
parse_error("Missing FOR variable");
return (0);
}
type = id_type(tokenstr, tokenlen);
addr = id_tag(tokenstr, tokenlen);
if (scan() != SET_TOKEN)
{
parse_error("Missing FOR =");
return (0);
}
if (!emit_seq(parse_expr(NULL, NULL)))
{
parse_error("Bad FOR expression");
return (0);
}
emit_codetag(tag_for);
if (type & LOCAL_TYPE)
type & BYTE_TYPE ? emit_dlb(addr) : emit_dlw(addr);
@ -968,33 +871,21 @@ int parse_stmnt(void)
else if (scantoken == DOWNTO_TOKEN)
step = -1;
else
{
parse_error("Missing FOR TO");
return (0);
}
if (!emit_seq(parse_expr(NULL, NULL)))
{
parse_error("Bad FOR TO expression");
return (0);
}
step > 0 ? emit_brgt(break_tag) : emit_brlt(break_tag);
if (scantoken == STEP_TOKEN)
{
if (!emit_seq(parse_expr(NULL, NULL)))
{
parse_error("Bad FOR STEP expression");
return (0);
}
emit_op(step > 0 ? ADD_TOKEN : SUB_TOKEN);
}
else
emit_unaryop(step > 0 ? INC_TOKEN : DEC_TOKEN);
while (parse_stmnt()) next_line();
if (scantoken != NEXT_TOKEN)
{
parse_error("Missing FOR/NEXT ");
return (0);
}
parse_error("Missing FOR/NEXT");
emit_brnch(tag_for);
cont_tag = tag_prevcnt;
emit_codetag(break_tag);
@ -1009,20 +900,14 @@ int parse_stmnt(void)
tag_choice = tag_new(BRANCH_TYPE);
tag_of = tag_new(BRANCH_TYPE);
if (!emit_seq(parse_expr(NULL, NULL)))
{
parse_error("Bad CASE expression");
return (0);
}
next_line();
while (scantoken != ENDCASE_TOKEN)
{
if (scantoken == OF_TOKEN)
{
if (!emit_seq(parse_expr(NULL, NULL)))
{
parse_error("Bad CASE OF expression");
return (0);
}
emit_brne(tag_choice);
emit_codetag(tag_of);
while (parse_stmnt()) next_line();
@ -1039,20 +924,12 @@ int parse_stmnt(void)
scan();
while (parse_stmnt()) next_line();
if (scantoken != ENDCASE_TOKEN)
{
parse_error("Bad CASE DEFAULT clause");
return (0);
}
}
else if (scantoken == EOL_TOKEN)
{
next_line();
}
else
{
parse_error("Bad CASE clause");
return (0);
}
}
if (tag_of)
emit_codetag(tag_of);
@ -1065,19 +942,13 @@ int parse_stmnt(void)
if (cont_tag)
emit_brnch(cont_tag);
else
{
parse_error("CONTINUE without loop");
return (0);
}
break;
case BREAK_TOKEN:
if (break_tag)
emit_brnch(break_tag);
else
{
parse_error("BREAK without loop");
return (0);
}
break;
case RETURN_TOKEN:
if (infunc)
@ -1087,10 +958,14 @@ int parse_stmnt(void)
emit_drop();
cfnvals = 0;
emit_seq(parse_list(NULL, &cfnvals));
if (cfnvals != infuncvals)
parse_warn("Inconsistent return value count");
while (cfnvals++ < infuncvals)
emit_const(0);
if (cfnvals > infuncvals)
parse_error("Too many return values");
if (cfnvals < infuncvals)
{
parse_warn("Too few return values");
while (cfnvals++ < infuncvals)
emit_const(0);
}
emit_leave();
}
else
@ -1145,24 +1020,13 @@ int parse_stmnt(void)
emit_seq(rseq);
}
else
{
parse_error("Invalid LVALUE");
return (0);
}
}
else
{
parse_error("Syntax error");
return (0);
}
}
}
if (scan() != EOL_TOKEN /*&& scantoken != COMMENT_TOKEN*/)
{
parse_error("Extraneous characters");
return (0);
}
return (1);
return (scan() == EOL_TOKEN);
}
int parse_var(int type)
{
@ -1176,10 +1040,7 @@ int parse_var(int type)
size = 0;
parse_constexpr(&size, &constsize);
if (scantoken != CLOSE_BRACKET_TOKEN)
{
parse_error("Missing closing bracket");
return (0);
}
scan();
}
if (scantoken == ID_TOKEN)
@ -1191,10 +1052,7 @@ int parse_var(int type)
size = 0;
parse_constexpr(&size, &constsize);
if (scantoken != CLOSE_BRACKET_TOKEN)
{
parse_error("Missing closing bracket");
return (0);
}
scan();
}
}
@ -1203,10 +1061,7 @@ int parse_var(int type)
if (scantoken == SET_TOKEN)
{
if (type & (EXTERN_TYPE | LOCAL_TYPE))
{
parse_error("Cannot initiallize local/external variables");
return (0);
}
if (idlen)
idglobal_add(idstr, idlen, type, 0);
if ((consttype = parse_constexpr(&constval, &constsize)))
@ -1220,19 +1075,13 @@ int parse_var(int type)
if ((consttype = parse_constexpr(&constval, &constsize)))
arraysize += emit_data(type, consttype, constval, constsize);
else
{
parse_error("Bad array declaration");
return (0);
}
}
if (size > arraysize)
idglobal_size(PTR_TYPE, size, arraysize);
}
else
{
parse_error("Bad variable initializer");
return (0);
}
}
else if (idlen)
id_add(idstr, idlen, type, size);
@ -1263,10 +1112,7 @@ int parse_struc(void)
size = 0;
parse_constexpr(&size, &constsize);
if (scantoken != CLOSE_BRACKET_TOKEN)
{
parse_error("Missing closing bracket");
return (0);
}
scan();
}
do {
@ -1280,10 +1126,7 @@ int parse_struc(void)
size = 0;
parse_constexpr(&size, &constsize);
if (scantoken != CLOSE_BRACKET_TOKEN)
{
parse_error("Missing closing bracket");
return (0);
}
scan();
}
}
@ -1293,12 +1136,9 @@ int parse_struc(void)
idconst_add(idstr, idlen, offset);
offset += size;
} while (scantoken == COMMA_TOKEN);
if (scantoken != EOL_TOKEN /*&& scantoken != COMMENT_TOKEN*/)
return (0);
}
if (struclen)
idconst_add(strucid, struclen, offset);
//return (scantoken == END_TOKEN);
if (scantoken != END_TOKEN)
return (0);
scan();
@ -1315,50 +1155,29 @@ int parse_vars(int type)
{
case SYSFLAGS_TOKEN:
if (type & (EXTERN_TYPE | LOCAL_TYPE))
{
parse_error("sysflags must be global");
return (0);
}
if (!parse_constexpr(&value, &size))
{
parse_error("Bad constant");
return (0);
}
emit_sysflags(value);
break;
case CONST_TOKEN:
if (scan() != ID_TOKEN)
{
parse_error("Missing variable");
return (0);
}
idstr = tokenstr;
idlen = tokenlen;
if (scan() != SET_TOKEN)
{
parse_error("Bad LValue");
return (0);
}
if (!parse_constexpr(&value, &size))
{
parse_error("Bad constant");
return (0);
}
idconst_add(idstr, idlen, value);
break;
case STRUC_TOKEN:
if (!parse_struc())
{
parse_error("Bad structure definition");
return (0);
}
break;
case EXPORT_TOKEN:
if (type & (EXTERN_TYPE | LOCAL_TYPE))
{
parse_error("Cannot export local/imported variables");
return (0);
}
type = EXPORT_TYPE;
idstr = tokenstr;
if (scan() != BYTE_TOKEN && scantoken != WORD_TOKEN)
@ -1406,19 +1225,13 @@ int parse_vars(int type)
}
} while (scantoken == COMMA_TOKEN);
if (scantoken != CLOSE_PAREN_TOKEN)
{
parse_error("Bad function parameter list");
return (0);
}
scan();
}
if (scantoken == POUND_TOKEN)
{
if (!parse_const(&cfnvals))
{
parse_error("Invalid def return value count");
return (0);
}
scan();
}
type |= funcparms_type(cfnparms) | funcvals_type(cfnvals);
@ -1443,40 +1256,26 @@ int parse_vars(int type)
}
} while (scantoken == COMMA_TOKEN);
if (scantoken != CLOSE_PAREN_TOKEN)
{
parse_error("Bad function parameter list");
return (0);
}
scan();
}
if (scantoken == POUND_TOKEN)
{
if (!parse_const(&cfnvals))
{
parse_error("Invalid def return value count");
return (0);
}
scan();
}
type |= funcparms_type(cfnparms) | funcvals_type(cfnvals);
idfunc_add(idstr, idlen, type, tag_new(type));
}
else
{
parse_error("Bad function pre-declaration");
return (0);
}
//scan();
}
}
else
{
parse_error("Bad function pre-declaration");
return (0);
}
case EOL_TOKEN:
//case COMMENT_TOKEN:
return (1);
break;
default:
return (0);
}
@ -1487,25 +1286,15 @@ int parse_mods(void)
if (scantoken == IMPORT_TOKEN)
{
if (scan() != ID_TOKEN)
{
parse_error("Bad import definition");
return (0);
}
emit_moddep(tokenstr, tokenlen);
scan();
while (parse_vars(EXTERN_TYPE)) next_line();
if (scantoken != END_TOKEN)
{
parse_error("Syntax error");
return (0);
}
if (scan() != EOL_TOKEN /*&& scantoken != COMMENT_TOKEN*/)
{
parse_error("Extraneous characters");
return (0);
}
parse_error("Missing END");
return (scan() == EOL_TOKEN);
}
if (scantoken == EOL_TOKEN /*|| scantoken == COMMENT_TOKEN*/)
if (scantoken == EOL_TOKEN)
return (1);
emit_moddep(0, 0);
return (0);
@ -1517,10 +1306,7 @@ int parse_lambda(void)
char *expr;
if (!infunc)
{
parse_error("Lambda functions only allowed inside definitions");
return (0);
}
idlocal_save();
/*
* Parse parameters and return value count
@ -1538,16 +1324,10 @@ int parse_lambda(void)
}
} while (scantoken == COMMA_TOKEN);
if (scantoken != CLOSE_PAREN_TOKEN)
{
parse_error("Bad function parameter list");
return (0);
}
}
else
{
parse_error("Missing parameter list in lambda function");
return (0);
}
expr = scanpos;
if (scan_lookahead() == OPEN_PAREN_TOKEN)
{
@ -1557,10 +1337,7 @@ int parse_lambda(void)
scan();
lambda_seq[lambda_cnt] = parse_list(NULL, NULL);
if (scantoken != CLOSE_PAREN_TOKEN)
{
parse_error("Missing closing lambda function parenthesis");
return (0);
}
}
else
{
@ -1592,19 +1369,13 @@ int parse_defs(void)
if (scantoken == EXPORT_TOKEN)
{
if (scan() != DEF_TOKEN && scantoken != ASM_TOKEN)
{
parse_error("Bad export definition");
return 0;
}
type = EXPORT_TYPE;
}
if (scantoken == DEF_TOKEN)
{
if (scan() != ID_TOKEN)
{
parse_error("Missing function name");
return (0);
}
emit_bytecode_seg();
lambda_cnt = 0;
bytecode = 1;
@ -1630,19 +1401,13 @@ int parse_defs(void)
}
} while (scantoken == COMMA_TOKEN);
if (scantoken != CLOSE_PAREN_TOKEN)
{
parse_error("Bad function parameter list");
return (0);
}
scan();
}
if (scantoken == POUND_TOKEN)
{
if (!parse_const(&infuncvals))
{
parse_error("Invalid def return value count");
return (0);
}
scan();
}
type |= funcparms_type(cfnparms) | funcvals_type(infuncvals);
@ -1650,12 +1415,9 @@ int parse_defs(void)
{
pretype = id_type(idstr, idlen);
if (!(pretype & PREDEF_TYPE))
{
parse_error("Mismatch function type");
return (0);
}
if ((pretype & FUNC_PARMVALS) != (type & FUNC_PARMVALS))
parse_warn("Mismatch function params/return values");
parse_error("Mismatch function params/return values");
emit_idfunc(id_tag(idstr, idlen), PREDEF_TYPE, idstr, 0);
func_tag = tag_new(type);
idfunc_set(idstr, idlen, type, func_tag); // Override any predef type & tag
@ -1678,19 +1440,12 @@ int parse_defs(void)
while (parse_stmnt()) next_line();
infunc = 0;
if (scantoken != END_TOKEN)
{
parse_error("Syntax error");
return (0);
}
if (scan() != EOL_TOKEN /*&& scantoken != COMMENT_TOKEN*/)
{
parse_error("Extraneous characters");
return (0);
}
parse_error("Missing END");
scan();
if (prevstmnt != RETURN_TOKEN)
{
if (infuncvals)
parse_warn("Inconsistent return value count");
parse_warn("No return values");
for (cfnvals = 0; cfnvals < infuncvals; cfnvals++)
emit_const(0);
emit_leave();
@ -1702,15 +1457,9 @@ int parse_defs(void)
else if (scantoken == ASM_TOKEN)
{
if (scan() != ID_TOKEN)
{
parse_error("Missing function name");
return (0);
}
if (bytecode)
{
parse_error("ASM code only allowed before DEF code");
return (0);
}
cfnparms = 0;
infuncvals = 1; // Defaut to one return value for compatibility
infunc = 1;
@ -1730,19 +1479,13 @@ int parse_defs(void)
}
while (scantoken == COMMA_TOKEN);
if (scantoken != CLOSE_PAREN_TOKEN)
{
parse_error("Bad function parameter list");
return (0);
}
scan();
}
if (scantoken == POUND_TOKEN)
{
if (!parse_const(&infuncvals))
{
parse_error("Invalid def return value count");
return (0);
}
scan();
}
type |= funcparms_type(cfnparms) | funcvals_type(infuncvals);
@ -1750,12 +1493,9 @@ int parse_defs(void)
{
pretype = id_type(idstr, idlen);
if (!(pretype & PREDEF_TYPE))
{
parse_error("Mismatch function type");
return (0);
}
if ((pretype & FUNC_PARMVALS) != (type & FUNC_PARMVALS))
parse_warn("Mismatch function params/return values");
parse_error("Mismatch function params/return values");
emit_idfunc(id_tag(idstr, idlen), PREDEF_TYPE, idstr, 0);
func_tag = tag_new(type);
idfunc_set(idstr, idlen, type, func_tag); // Override any predef type & tag
@ -1771,8 +1511,6 @@ int parse_defs(void)
idstr[idlen] = c;
do
{
///if (scantoken == EOL_TOKEN /*|| scantoken == COMMENT_TOKEN*/)
//next_line();
if (scantoken != END_TOKEN && scantoken != EOL_TOKEN)
{
scantoken = EOL_TOKEN;
@ -1783,9 +1521,7 @@ int parse_defs(void)
scan();
return (1);
}
if (scantoken == EOL_TOKEN /*|| scantoken == COMMENT_TOKEN*/)
return (1);
return (0);
return (scantoken == EOL_TOKEN);
}
int parse_module(void)
{
@ -1804,7 +1540,7 @@ int parse_module(void)
prevstmnt = 0;
while (parse_stmnt()) next_line();
if (scantoken != DONE_TOKEN)
parse_error("Missing DONE statement");
parse_error("Missing DONE");
if (prevstmnt != RETURN_TOKEN)
{
emit_const(0);

856
src/toolsrc/sb.pla

File diff suppressed because it is too large Load Diff

17
src/vmsrc/a1cmd.pla

@ -30,7 +30,7 @@ const CFFAEntryPtr = $0B
//
// Pedefined functions.
//
predef syscall(cmd)#1, call(addr,areg,xreg,yreg,status)#1
predef syscall(cmd,null)#1, call(addr,areg,xreg,yreg,status)#1
predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, cin()#1, rdstr(p)#1, toupper(c)#1
predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr), releaseheap(newheap)#1, availheap()#1
predef memset(addr,value,size)#0, memcpy(dst,src,size)#0
@ -123,14 +123,15 @@ word = 0
word syslibsym = @exports
//
// CALL CFFA1 API ENTRYPOINT
// SYSCALL(CMD)
// SYSCALL(CMD, 0)
//
asm syscall(cmd)#1
asm syscall(cmd, null)#1
LDA ESTKL,X
STX ESP
TAX
JSR $900C
LDX ESP
INX
LDY #$00
STA ESTKL,X
STY ESTKH,X
@ -679,22 +680,22 @@ end
// FILE I/O
//
//def opendir
// perr = syscall($10)
// perr = syscall($10, 0)
// return perr
//end
//def readdir
// perr = syscall($12)
// perr = syscall($12, 0)
// return *CFFAEntryPtr
//end
def finddirentry(filename)#1
*CFFAFileName = filename
perr = syscall($14)
perr = syscall($14, 0)
return *CFFAEntryPtr
end
def readfile(filename, buffer)#1
*CFFADest = buffer
*CFFAFileName = filename
perr = syscall($22)
perr = syscall($22, 0)
return perr
end
//
@ -1074,7 +1075,7 @@ while 1
is 'Q'
quit
is 'M'
syscall($02)
syscall($02, 0)
break
is '+'
execmod(cmdptr)