diff --git a/src/inc/args.plh b/src/inc/args.plh index 8c0c3ce..ad91f5b 100644 --- a/src/inc/args.plh +++ b/src/inc/args.plh @@ -1,3 +1,3 @@ import args - predef argFirst, argNext -end \ No newline at end of file + predef argFirst, argNext(str) +end diff --git a/src/inc/memmgr.plh b/src/inc/memmgr.plh index 295ca53..7e0bf64 100644 --- a/src/inc/memmgr.plh +++ b/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 // diff --git a/src/inc/spiport.plh b/src/inc/spiport.plh index 6469034..2488f82 100644 --- a/src/inc/spiport.plh +++ b/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 diff --git a/src/libsrc/conio.pla b/src/libsrc/conio.pla index bd821a2..7954d3f 100644 --- a/src/libsrc/conio.pla +++ b/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 diff --git a/src/libsrc/dhcp.pla b/src/libsrc/dhcp.pla index c8ec99c..69f0ecf 100644 --- a/src/libsrc/dhcp.pla +++ b/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 diff --git a/src/libsrc/etherip.pla b/src/libsrc/etherip.pla index 8d1b81a..39432e8 100644 --- a/src/libsrc/etherip.pla +++ b/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 diff --git a/src/libsrc/fiber.pla b/src/libsrc/fiber.pla index c9d3573..7637643 100644 --- a/src/libsrc/fiber.pla +++ b/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 diff --git a/src/libsrc/fileio.pla b/src/libsrc/fileio.pla index c837286..4765fcd 100644 --- a/src/libsrc/fileio.pla +++ b/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) diff --git a/src/libsrc/fpu.pla b/src/libsrc/fpu.pla index 5aeeaf1..937886c 100644 --- a/src/libsrc/fpu.pla +++ b/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 diff --git a/src/libsrc/inet.pla b/src/libsrc/inet.pla index 52a2557..db3eea6 100644 --- a/src/libsrc/inet.pla +++ b/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 diff --git a/src/libsrc/memmgr.pla b/src/libsrc/memmgr.pla index 180d2a0..3242992 100755 --- a/src/libsrc/memmgr.pla +++ b/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 // diff --git a/src/libsrc/sane.pla b/src/libsrc/sane.pla index 64cec16..51f3bee 100644 --- a/src/libsrc/sane.pla +++ b/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 diff --git a/src/libsrc/sdfat.pla b/src/libsrc/sdfat.pla index 9c1d68d..9878fec 100644 --- a/src/libsrc/sdfat.pla +++ b/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 // diff --git a/src/libsrc/tone.pla b/src/libsrc/tone.pla index e95133f..db8b34d 100644 --- a/src/libsrc/tone.pla +++ b/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 \ No newline at end of file +done diff --git a/src/libsrc/uthernet.pla b/src/libsrc/uthernet.pla index 7d73522..4b5e067 100644 --- a/src/libsrc/uthernet.pla +++ b/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 diff --git a/src/libsrc/uthernet2.pla b/src/libsrc/uthernet2.pla index ac86394..fc63e82 100644 --- a/src/libsrc/uthernet2.pla +++ b/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 // diff --git a/src/makefile b/src/makefile index 24c1d57..559ac20 100755 --- a/src/makefile +++ b/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 diff --git a/src/samplesrc/fatcat.pla b/src/samplesrc/fatcat.pla index 4d944e2..c32c11d 100644 --- a/src/samplesrc/fatcat.pla +++ b/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 \ No newline at end of file +done diff --git a/src/samplesrc/fatget.pla b/src/samplesrc/fatget.pla index 02b7630..7984eab 100644 --- a/src/samplesrc/fatget.pla +++ b/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) diff --git a/src/samplesrc/fatput.pla b/src/samplesrc/fatput.pla index 7c86261..e91511e 100644 --- a/src/samplesrc/fatput.pla +++ b/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) diff --git a/src/samplesrc/fatreaddsk.pla b/src/samplesrc/fatreaddsk.pla index 0cda2a6..f8e4b3b 100644 --- a/src/samplesrc/fatreaddsk.pla +++ b/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 diff --git a/src/samplesrc/fatwritedsk.pla b/src/samplesrc/fatwritedsk.pla index d6e29b4..24bc513 100644 --- a/src/samplesrc/fatwritedsk.pla +++ b/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 diff --git a/src/samplesrc/hgr1test.pla b/src/samplesrc/hgr1test.pla index 6c19402..33e43b1 100644 --- a/src/samplesrc/hgr1test.pla +++ b/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 diff --git a/src/samplesrc/httpd.pla b/src/samplesrc/httpd.pla index 9c30870..b76d63d 100644 --- a/src/samplesrc/httpd.pla +++ b/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() diff --git a/src/samplesrc/memtest.pla b/src/samplesrc/memtest.pla index ec68a50..87eafec 100644 --- a/src/samplesrc/memtest.pla +++ b/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 diff --git a/src/samplesrc/rod.pla b/src/samplesrc/rod.pla index f312710..9c873d4 100644 --- a/src/samplesrc/rod.pla +++ b/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 diff --git a/src/samplesrc/rogue.combat.pla b/src/samplesrc/rogue.combat.pla index d2c3fef..e305891 100644 --- a/src/samplesrc/rogue.combat.pla +++ b/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 diff --git a/src/samplesrc/rogue.io.pla b/src/samplesrc/rogue.io.pla index 1764b0c..4a51aeb 100644 --- a/src/samplesrc/rogue.io.pla +++ b/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 // diff --git a/src/samplesrc/rogue.map.pla b/src/samplesrc/rogue.map.pla index 6794daf..88829b0 100644 --- a/src/samplesrc/rogue.map.pla +++ b/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 diff --git a/src/samplesrc/rogue.pla b/src/samplesrc/rogue.pla index 02780fc..3051bcd 100755 --- a/src/samplesrc/rogue.pla +++ b/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 diff --git a/src/samplesrc/rpncalc.pla b/src/samplesrc/rpncalc.pla index cc2bec4..5fc6e8a 100644 --- a/src/samplesrc/rpncalc.pla +++ b/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 diff --git a/src/samplesrc/sieve.pla b/src/samplesrc/sieve.pla index 3498962..2d298b7 100644 --- a/src/samplesrc/sieve.pla +++ b/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 diff --git a/src/samplesrc/test.pla b/src/samplesrc/test.pla index ae16008..d430e29 100755 --- a/src/samplesrc/test.pla +++ b/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 diff --git a/src/toolsrc/parse.c b/src/toolsrc/parse.c index 4f439b9..9e81e00 100755 --- a/src/toolsrc/parse.c +++ b/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); diff --git a/src/toolsrc/sb.pla b/src/toolsrc/sb.pla index 34a76e6..3fbcb95 100644 --- a/src/toolsrc/sb.pla +++ b/src/toolsrc/sb.pla @@ -77,7 +77,7 @@ const shiftlock = 128 // // Argument buffer (must be first declared variables) // -word signature = $EEEE // buffer signature +word signature = $EEEE // buffer signature byte = 32 // buffer length byte[32] argbuff = "" // buffer // @@ -106,7 +106,7 @@ word keyin, cursrow, scrntop, cursptr // // Predeclared functions // -predef cmdmode +predef cmdmode(clrscrn) // // Compiler variables // @@ -391,38 +391,38 @@ byte prevstmnt = 0 word retfunc_tag = 0 word break_tag = 0 word cont_tag = 0 -predef parse_constexpr, parse_expr, parse_module +predef parse_constexpr(str,val), parse_expr, parse_module // // ASM utility functions // // Defines for ASM routines // asm equates -INTERP = $03D0 -LCRDEN = $C080 -LCWTEN = $C081 -ROMEN = $C082 -LCRWEN = $C083 -LCBNK2 = $00 -LCBNK1 = $08 - !SOURCE "vmsrc/plvmzp.inc" +INTERP = $03D0 +LCRDEN = $C080 +LCWTEN = $C081 +ROMEN = $C082 +LCRWEN = $C083 +LCBNK2 = $00 +LCBNK1 = $08 + !SOURCE "vmsrc/plvmzp.inc" end // // SAVE VM STATE // asm save_vmstate - LDA $03F2 - STA VMRESET - LDA $03F3 - STA VMRESET+1 - LDA $03F4 - STA VMRESET+2 - LDA #RESETENTRY - STA $03F3 - EOR #$A5 - STA $03F4 + LDA $03F2 + STA VMRESET + LDA $03F3 + STA VMRESET+1 + LDA $03F4 + STA VMRESET+2 + LDA #RESETENTRY + STA $03F3 + EOR #$A5 + STA $03F4 DEX RTS end @@ -431,29 +431,29 @@ end // asm restore_vmstate RESETENTRY - LDA VMRESET - STA $03F2 - LDA VMRESET+1 - STA $03F3 - LDA VMRESET+2 - STA $03F4 - LDX #$00 - STX IFPL - LDA #$BF - STA IFPH - LDX #$FE + LDA VMRESET + STA $03F2 + LDA VMRESET+1 + STA $03F3 + LDA VMRESET+2 + STA $03F4 + LDX #$00 + STX IFPL + LDA #$BF + STA IFPH + LDX #$FE TXS - LDX #ESTKSZ/2 - BIT ROMEN - JMP $2000 -VMRESET !FILL 3 + LDX #ESTKSZ/2 + BIT ROMEN + JMP $2000 +VMRESET !FILL 3 end // // CALL 6502 ROUTINE // CALL(ADDR, AREG, XREG, YREG, STATUS) // -asm call -REGVALS = SRC +asm call(addr, areg, xreg, yreg, status) +REGVALS = SRC PHP LDA ESTKL+4,X STA TMPL @@ -490,174 +490,174 @@ REGVALS = SRC STY ESTKH,X PLP RTS -JMPTMP JMP (TMP) +JMPTMP JMP (TMP) end // // CALL PRODOS // SYSCALL(CMD, PARAMS) // -asm syscall - LDA ESTKL,X - LDY ESTKH,X - STA PARAMS - STY PARAMS+1 +asm syscall(cmd, params) + LDA ESTKL,X + LDY ESTKH,X + STA PARAMS + STY PARAMS+1 INX - LDA ESTKL,X - STA CMD - JSR $BF00 -CMD: !BYTE 00 -PARAMS: !WORD 0000 - LDY #$00 - STA ESTKL,X - STY ESTKH,X + LDA ESTKL,X + STA CMD + JSR $BF00 +CMD: !BYTE 00 +PARAMS: !WORD 0000 + LDY #$00 + STA ESTKL,X + STY ESTKH,X RTS end // SET MEMORY TO VALUE // MEMSET(ADDR, VALUE, SIZE) // With optimizations from Peter Ferrie // -asm memset - LDA ESTKL+2,X +asm memset(addr, val, size) + LDA ESTKL+2,X STA DSTL LDA ESTKH+2,X STA DSTH LDY ESTKL,X - BEQ + + BEQ + INC ESTKH,X LDY #$00 -+ LDA ESTKH,X - BEQ SETMEX -SETMLPL CLC - LDA ESTKL+1,X -SETMLPH STA (DST),Y - DEC ESTKL,X - BNE + - DEC ESTKH,X - BEQ SETMEX -+ INY - BNE + - INC DSTH -+ BCS SETMLPL - SEC - LDA ESTKH+1,X - BCS SETMLPH -SETMEX INX - INX - RTS ++ LDA ESTKH,X + BEQ SETMEX +SETMLPL CLC + LDA ESTKL+1,X +SETMLPH STA (DST),Y + DEC ESTKL,X + BNE + + DEC ESTKH,X + BEQ SETMEX ++ INY + BNE + + INC DSTH ++ BCS SETMLPL + SEC + LDA ESTKH+1,X + BCS SETMLPH +SETMEX INX + INX + RTS end // // COPY MEMORY // MEMCPY(DSTADDR, SRCADDR, SIZE) // -asm memcpy - INX +asm memcpy(dst, src, size) INX - LDA ESTKL-2,X - ORA ESTKH-2,X - BEQ CPYMEX - LDA ESTKL-1,X - CMP ESTKL,X - LDA ESTKH-1,X - SBC ESTKH,X - BCC REVCPY + INX + LDA ESTKL-2,X + ORA ESTKH-2,X + BEQ CPYMEX + LDA ESTKL-1,X + CMP ESTKL,X + LDA ESTKH-1,X + SBC ESTKH,X + BCC REVCPY ; ; FORWARD COPY ; - LDA ESTKL,X - STA DSTL - LDA ESTKH,X - STA DSTH - LDA ESTKL-1,X - STA SRCL - LDA ESTKH-1,X - STA SRCH - LDY ESTKL-2,X - BEQ FORCPYLP - INC ESTKH-2,X - LDY #$00 -FORCPYLP LDA (SRC),Y - STA (DST),Y + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL-1,X + STA SRCL + LDA ESTKH-1,X + STA SRCH + LDY ESTKL-2,X + BEQ FORCPYLP + INC ESTKH-2,X + LDY #$00 +FORCPYLP LDA (SRC),Y + STA (DST),Y INY - BNE + - INC DSTH - INC SRCH -+ DEC ESTKL-2,X - BNE FORCPYLP - DEC ESTKH-2,X - BNE FORCPYLP + BNE + + INC DSTH + INC SRCH ++ DEC ESTKL-2,X + BNE FORCPYLP + DEC ESTKH-2,X + BNE FORCPYLP RTS ; ; REVERSE COPY ; -REVCPY ;CLC - LDA ESTKL-2,X - ADC ESTKL,X - STA DSTL - LDA ESTKH-2,X - ADC ESTKH,X - STA DSTH +REVCPY ;CLC + LDA ESTKL-2,X + ADC ESTKL,X + STA DSTL + LDA ESTKH-2,X + ADC ESTKH,X + STA DSTH CLC - LDA ESTKL-2,X - ADC ESTKL-1,X - STA SRCL - LDA ESTKH-2,X - ADC ESTKH-1,X - STA SRCH - DEC DSTH - DEC SRCH - LDY #$FF - LDA ESTKL-2,X - BEQ REVCPYLP - INC ESTKH-2,X -REVCPYLP LDA (SRC),Y - STA (DST),Y + LDA ESTKL-2,X + ADC ESTKL-1,X + STA SRCL + LDA ESTKH-2,X + ADC ESTKH-1,X + STA SRCH + DEC DSTH + DEC SRCH + LDY #$FF + LDA ESTKL-2,X + BEQ REVCPYLP + INC ESTKH-2,X +REVCPYLP LDA (SRC),Y + STA (DST),Y DEY - CPY #$FF - BNE + - DEC DSTH - DEC SRCH -+ DEC ESTKL-2,X - BNE REVCPYLP - DEC ESTKH-2,X - BNE REVCPYLP -CPYMEX RTS + CPY #$FF + BNE + + DEC DSTH + DEC SRCH ++ DEC ESTKL-2,X + BNE REVCPYLP + DEC ESTKH-2,X + BNE REVCPYLP +CPYMEX RTS end // // CHAR OUT // COUT(CHAR) // -asm cout - LDA ESTKL,X -COUT1 BIT $BF98 - BMI + - JSR TOUPR -+ ORA #$80 - BIT ROMEN - JSR $FDED - BIT LCRDEN+LCBNK2 +asm cout(char) + LDA ESTKL,X +COUT1 BIT $BF98 + BMI + + JSR TOUPR ++ ORA #$80 + BIT ROMEN + JSR $FDED + BIT LCRDEN+LCBNK2 RTS end // // CHAR IN // RDKEY() // -asm cin - BIT ROMEN - JSR $FD0C - BIT LCRDEN+LCBNK2 +asm cin() + BIT ROMEN + JSR $FD0C + BIT LCRDEN+LCBNK2 DEX - LDY #$00 - AND #$7F - STA ESTKL,X - STY ESTKH,X + LDY #$00 + AND #$7F + STA ESTKL,X + STY ESTKH,X RTS end // // PRINT STRING // PRSTR(STR) // -asm prstr - LDY #$00 +asm prstr(pstr) + LDY #$00 LDA ESTKL,X STA SRCL LDA ESTKH,X @@ -665,24 +665,24 @@ asm prstr LDA (SRC),Y STA TMP BEQ ++ -- INY - LDA (SRC),Y - JSR COUT1 - CPY TMP - BNE - -++ RTS +- INY + LDA (SRC),Y + JSR COUT1 + CPY TMP + BNE - +++ RTS end // // READ STRING // STR = RDSTR(PROMPTCHAR) // -asm rdstr +asm rdstr(prompt) LDA ESTKL,X STA $33 STX ESP BIT ROMEN JSR $FD6A - BIT LCRDEN+LCBNK2 + BIT LCRDEN+LCBNK2 STX $01FF - LDA $01FF,X AND #$7F @@ -694,18 +694,18 @@ asm rdstr STA ESTKL,X LDA #$01 STA ESTKH,X - RTS + RTS end // // EXIT // asm exit - JSR $BF00 - !BYTE $65 - !WORD EXITTBL + JSR $BF00 + !BYTE $65 + !WORD EXITTBL EXITTBL: - !BYTE 4 - !BYTE 0 + !BYTE 4 + !BYTE 0 end //def toupper_11(c) // if c >= 'a' @@ -715,16 +715,16 @@ end // fin // return c //end -asm toupper +asm toupper(char) LDA ESTKL,X -TOUPR AND #$7F +TOUPR AND #$7F CMP #'z'+1 BCS + CMP #'a' BCC + SBC #$20 + STA ESTKL,X - RTS + RTS end asm clrhibit(strptr) LDA ESTKL,X @@ -740,7 +740,7 @@ CLHILP LDA (SRC),Y STA (SRC),Y DEY BNE CLHILP -+ RTS ++ RTS end asm sethibit(strptr) LDA ESTKL,X @@ -756,14 +756,14 @@ STHILP LDA (SRC),Y STA (SRC),Y DEY BNE STHILP -+ RTS ++ RTS end asm cpyln(srcstr, dststr) LDA ESTKL,X STA DSTL LDA ESTKH,X STA DSTH - INX + INX LDA ESTKL,X STA SRCL LDA ESTKH,X @@ -786,7 +786,7 @@ CPLNLP LDA (SRC),Y BNE CPLNLP LDA (SRC),Y ++ STA (DST),Y - RTS + RTS end // //def skipspace(scanptr) @@ -796,21 +796,21 @@ end // return scanptr //end asm skipspace(scanptr) - LDA #$00 - STA SRCL + LDA #$00 + STA SRCL LDA ESTKH,X STA SRCH LDY ESTKL,X -- LDA (SRC),Y - CMP #' ' - BNE + +- LDA (SRC),Y + CMP #' ' + BNE + INY - BNE - - INC SRCH - BNE - -+ STY ESTKL,X - LDA SRCH - STA ESTKH,X + BNE - + INC SRCH + BNE - ++ STY ESTKL,X + LDA SRCH + STA ESTKH,X RTS end //def isalpha(c) @@ -823,7 +823,7 @@ end // fin // return FALSE //end -asm isalpha +asm isalpha(char) LDY #$00 LDA ESTKL,X CMP #'_' @@ -835,7 +835,7 @@ asm isalpha CMP #'a' BCC ISALRET CMP #'z'+1 - BCS ISALRET + BCS ISALRET ISALTRU DEY ISALRET STY ESTKL,X STY ESTKH,X @@ -847,7 +847,7 @@ end // fin // return FALSE //end -asm isnum +asm isnum(char) LDY #$00 LDA ESTKL,X CMP #'0' @@ -871,7 +871,7 @@ end // fin // return FALSE //end -asm isalphanum +asm isalphanum(char) LDY #$00 LDA ESTKL,X CMP #'_' @@ -879,15 +879,15 @@ asm isalphanum CMP #'0' BCC ISANRET CMP #'9'+1 - BCC ISANTRU + BCC ISANTRU CMP #'A' BCC ISANRET CMP #'Z'+1 - BCC ISANTRU + BCC ISANTRU CMP #'a' BCC ISANRET CMP #'z'+1 - BCS ISANRET + BCS ISANRET ISANTRU DEY ISANRET STY ESTKL,X STY ESTKH,X @@ -1214,13 +1214,13 @@ def readtxt(filename) fin if !(numlines & $0F); cout('.'); fin until txtbuf == 0 or numlines == maxlines - // - // Make sure there is a blank line at the end of the buffer - // - if numlines < maxlines and strlinbuf:[numlines - 1] <> @nullstr - strlinbuf:[numlines] = @nullstr - numlines = numlines + 1 - fin + // + // Make sure there is a blank line at the end of the buffer + // + if numlines < maxlines and strlinbuf:[numlines - 1] <> @nullstr + strlinbuf:[numlines] = @nullstr + numlines = numlines + 1 + fin fin if refnum; close(refnum); fin end @@ -1280,18 +1280,18 @@ def drawscrn(toprow, ofst) for row = 0 to 23 strptr = strlinbuf:[toprow + row] - scrnptr = txtscrn[row] - if ofst >= ^strptr - numchars = 0 - else - numchars = ^strptr - ofst - fin - if numchars >= 40 + scrnptr = txtscrn[row] + if ofst >= ^strptr + numchars = 0 + else + numchars = ^strptr - ofst + fin + if numchars >= 40 numchars = 40 - else - memset(scrnptr + numchars, $A0A0, 40 - numchars) - fin - memcpy(scrnptr, strptr + ofst + 1, numchars) + else + memset(scrnptr + numchars, $A0A0, 40 - numchars) + fin + memcpy(scrnptr, strptr + ofst + 1, numchars) next end def cursoff @@ -1443,22 +1443,22 @@ def keyin2e ^keystrobe if ^$C062 & 128 // Closed Apple pressed when key - is keyarrowleft - key = keyctrla - break - is keyarrowright - key = keyctrls - break - is keyarrowup - key = keyctrlw - break - is keyarrowdown - key = keyctrlz - break - is keyenter - key = keyctrlf - break - wend + is keyarrowleft + key = keyctrla + break + is keyarrowright + key = keyctrls + break + is keyarrowup + key = keyctrlw + break + is keyarrowdown + key = keyctrlz + break + is keyenter + key = keyctrlf + break + wend fin return key end @@ -1730,29 +1730,29 @@ def editmode is keyctrlv pasteline; break is keyctrlf - if numlines < maxlines and cursrow == numlines - 1 + if numlines < maxlines and cursrow == numlines - 1 strlinbuf:[numlines] = @nullstr - numlines = numlines + 1 - fin - cursdown + numlines = numlines + 1 + fin + cursdown is keyctrlo openline(cursrow) - curscol = 0 - cursx = 0 - scrnleft = 0 + curscol = 0 + cursx = 0 + scrnleft = 0 redraw - break + break is keyenter if flags & insmode splitline else cursdown - curscol = 0 - cursx = 0 - scrnleft = 0 - redraw + curscol = 0 + cursx = 0 + scrnleft = 0 + redraw fin - break + break is keyctrlt joinline; break is keyctrli @@ -1763,7 +1763,7 @@ def editmode flags = flags | insmode curschr = '+' fin - break + break is keyctrlc if flags & uppercase txtlower @@ -1771,12 +1771,12 @@ def editmode txtupper fin redraw - break + break is keyescape cursoff cmdmode(TRUE) redraw - break + break wend until FALSE end @@ -1891,18 +1891,18 @@ def cmdmode(clearscr) is 'A' readtxt(cmdptr) flags = flags | changed - break + break is 'R' if chkchng inittxtbuf - numlines = 0 - entrypoint = 0 + numlines = 0 + entrypoint = 0 strcpy(@txtfile, cmdptr) readtxt(@txtfile) - if numlines == 0; numlines = 1; fin + if numlines == 0; numlines = 1; fin flags = flags & ~changed fin - break + break is 'W' if ^cmdptr strcpy(@txtfile, cmdptr) @@ -1910,7 +1910,7 @@ def cmdmode(clearscr) writetxt(@txtfile) if flags & changed; entrypoint = 0; fin flags = flags & ~changed - break + break is 'C' prfiles(cmdptr); break is 'P' @@ -1922,7 +1922,7 @@ def cmdmode(clearscr) slot = 1 fin printtxt(slot) - break + break is 'Q' quit is 'E' @@ -1932,9 +1932,9 @@ def cmdmode(clearscr) if chkchng inittxtbuf strcpy(@txtfile, @untitled) - entrypoint = 0 + entrypoint = 0 fin - break + break is 'X' if flags & changed or !entrypoint parse_module @@ -1946,18 +1946,18 @@ def cmdmode(clearscr) curscol = parserrpos scrnleft = curscol & $FFE0 cursx = curscol - scrnleft - entrypoint = 0 - else - crout + entrypoint = 0 + else + crout fin fin if entrypoint - save_vmstate + save_vmstate entrypoint() - restore_vmstate - fin + restore_vmstate + fin crout - break + break otherwise bell cout('?') @@ -2014,13 +2014,13 @@ def ctag_resolve(ctag) // // Update list of addresses needing resolution // - updtptr = updtptr + codebuff + updtptr = updtptr + codebuff nextptr = *updtptr & MASK_CTAG - if *updtptr & IS_RELATIVE - *updtptr = codeptr - updtptr - else + if *updtptr & IS_RELATIVE + *updtptr = codeptr - updtptr + else *updtptr = codeptr - fin + fin updtptr = nextptr loop ctag_tbl:[ctag] = (codeptr - codebuff) | IS_RESOLVED @@ -2050,12 +2050,12 @@ def emit_addr(tag) if tag & IS_CTAG tag = tag & MASK_CTAG if ctag_tbl:[tag] & IS_RESOLVED - updtptr = (ctag_tbl:[tag] & MASK_CTAG) + codebuff - else + updtptr = (ctag_tbl:[tag] & MASK_CTAG) + codebuff + else // // Add to list of tags needing resolution // - updtptr = ctag_tbl:[tag] & MASK_CTAG + updtptr = ctag_tbl:[tag] & MASK_CTAG ctag_tbl:[tag] = codeptr - codebuff fin emit_word(updtptr) @@ -2069,12 +2069,12 @@ def emit_reladdr(tag) if tag & IS_CTAG tag = tag & MASK_CTAG if ctag_tbl:[tag] & IS_RESOLVED - updtptr = ((ctag_tbl:[tag] & MASK_CTAG) + codebuff) - codeptr - else + updtptr = ((ctag_tbl:[tag] & MASK_CTAG) + codebuff) - codeptr + else // // Add to list of tags needing resolution // - updtptr = ctag_tbl:[tag] | IS_RELATIVE + updtptr = ctag_tbl:[tag] | IS_RELATIVE ctag_tbl:[tag] = codeptr - codebuff fin emit_word(updtptr) @@ -2108,11 +2108,11 @@ def emit_data(vartype, consttype, constval, constsize) emit_byte(constval) else size = 2 - if consttype == CONSTADDR_TYPE - emit_addr(constval) - else + if consttype == CONSTADDR_TYPE + emit_addr(constval) + else emit_word(constval) - fin + fin fin fin return size @@ -2264,7 +2264,7 @@ def emit_binaryop(op) else emit_op($06) fin - break + break is DIV_TKN // // Replace DIV 2 with SHR 1 @@ -2276,7 +2276,7 @@ def emit_binaryop(op) else emit_op($08) fin - break + break is MOD_TKN emit_op($0A); break is ADD_TKN @@ -2289,7 +2289,7 @@ def emit_binaryop(op) else emit_op($02) fin - break + break is SUB_TKN // // Replace SUB 1 with DECR @@ -2300,7 +2300,7 @@ def emit_binaryop(op) else emit_op($04) fin - break + break is SHL_TKN emit_op($1A); break is SHR_TKN @@ -2702,7 +2702,7 @@ def scan token = DIV_TKN scanptr = scanptr + 1 fin - break + break is '=' if ^(scanptr + 1) == '=' token = EQ_TKN @@ -2714,7 +2714,7 @@ def scan token = SET_TKN scanptr = scanptr + 1 fin - break + break is '-' if ^(scanptr + 1) == '>' token = PTRB_TKN @@ -2726,7 +2726,7 @@ def scan token = SUB_TKN scanptr = scanptr + 1 fin - break + break is '+' if ^(scanptr + 1) == '+' token = INC_TKN @@ -2735,8 +2735,8 @@ def scan token = ADD_TKN scanptr = scanptr + 1 fin - break - is '>' + break + is '>' if ^(scanptr + 1) == '>' token = SHR_TKN scanptr = scanptr + 2 @@ -2747,7 +2747,7 @@ def scan token = GT_TKN scanptr = scanptr + 1 fin - break + break is '<' if ^(scanptr + 1) == '<' token = SHL_TKN @@ -2762,39 +2762,39 @@ def scan token = LT_TKN scanptr = scanptr + 1 fin - break - is '$' - // - // Hexadecimal constant - // - token = INT_TKN - constval = 0 - repeat + break + is '$' + // + // Hexadecimal constant + // + token = INT_TKN + constval = 0 + repeat scanptr = scanptr + 1 - if ^scanptr >= '0' and ^scanptr <= '9' + if ^scanptr >= '0' and ^scanptr <= '9' constval = (constval << 4) + ^scanptr - '0' - elsif ^scanptr >= 'A' and ^scanptr <= 'F' + elsif ^scanptr >= 'A' and ^scanptr <= 'F' constval = (constval << 4) + ^scanptr - '7'// 'A'-10 elsif ^scanptr >= 'a' and ^scanptr <= 'f' constval = (constval << 4) + ^scanptr - 'W'// 'a'-10 - else + else break fin until !^scanptr - break + break is $27 // ' - // - // Character constant - // - token = CHR_TKN - if ^(scanptr + 1) <> $5C // \ - constval = ^(scanptr + 1) - if ^(scanptr + 2) <> $27 // ' + // + // Character constant + // + token = CHR_TKN + if ^(scanptr + 1) <> $5C // \ + constval = ^(scanptr + 1) + if ^(scanptr + 2) <> $27 // ' return parse_err(@bad_cnst) fin - scanptr = scanptr + 3 - else - when ^(scanptr + 2) + scanptr = scanptr + 3 + else + when ^(scanptr + 2) is 'n' constval = $0D; break is 'r' @@ -2809,28 +2809,28 @@ def scan fin scanptr = scanptr + 4 fin - break - is '"' - // - // String constant - // - token = STR_TKN - scanptr = scanptr + 1 - constval = scanptr - while ^scanptr and ^scanptr <> '"' - scanptr = scanptr + 1 - loop - if !^scanptr - return parse_err(@bad_cnst) - fin - scanptr = scanptr + 1 - break - is 0 - is ';' - if token <> EOF_TKN - token = EOL_TKN - fin - break + break + is '"' + // + // String constant + // + token = STR_TKN + scanptr = scanptr + 1 + constval = scanptr + while ^scanptr and ^scanptr <> '"' + scanptr = scanptr + 1 + loop + if !^scanptr + return parse_err(@bad_cnst) + fin + scanptr = scanptr + 1 + break + is 0 + is ';' + if token <> EOF_TKN + token = EOL_TKN + fin + break otherwise // // Simple single character tokens @@ -2877,8 +2877,8 @@ def nextln //crout scan else - ^instr = 0 - ^inbuff = 0 + ^instr = 0 + ^inbuff = 0 token = DONE_TKN fin fin @@ -2900,19 +2900,19 @@ def calc_binaryop(op) when op is MUL_TKN val1 = val1 * val2 - break + break is DIV_TKN val1 = val1 / val2 - break + break is MOD_TKN val1 = val1 % val2 break is ADD_TKN val1 = val1 + val2 - break + break is SUB_TKN val1 = val1 - val2 - break + break is SHL_TKN val1 = val1 << val2 break @@ -2964,7 +2964,7 @@ def parse_constval when token is SUB_TKN mod = mod | 1; break - is ALT_COMP_TKN + is ALT_COMP_TKN is COMP_TKN mod = mod | 2; break is LOGIC_NOT_TKN @@ -3003,11 +3003,11 @@ def parse_constval if !idptr; return parse_err(@bad_cnst); fin type = idptr->idtype if type & ADDR_TYPE - if mod <> 8; return parse_err(@bad_cnst); fin + if mod <> 8; return parse_err(@bad_cnst); fin type = CONSTADDR_TYPE fin value = idptr=>idval - break + break otherwise return 0 wend @@ -3125,7 +3125,7 @@ def parse_value(rvalue) while !parse_term when token is ADD_TKN - break + break is BPTR_TKN if deref push_op(token, 0) @@ -3175,14 +3175,14 @@ def parse_value(rvalue) // type = type | WORD_TYPE emit_val = TRUE break - is STR_TKN - // - // Special case - // - emit_constr(constval, tknlen - 1) - scan - return WORD_TYPE - break + is STR_TKN + // + // Special case + // + emit_constr(constval, tknlen - 1) + scan + return WORD_TYPE + break otherwise return 0 wend @@ -3196,16 +3196,16 @@ def parse_value(rvalue) is NEG_TKN pop_op value = -value - break + break is ALT_COMP_TKN is COMP_TKN pop_op value = ~value - break + break is LOGIC_NOT_TKN pop_op value = !value - break + break otherwise cparams = FALSE wend @@ -3270,19 +3270,19 @@ def parse_value(rvalue) break is OPEN_BRACKET_TKN // - // Array of arrays - // - if !emit_val - if type & CONST_TYPE - emit_const(value) + // Array of arrays + // + if !emit_val + if type & CONST_TYPE + emit_const(value) elsif type & ADDR_TYPE - if type & LOCAL_TYPE - emit_localaddr(value + ref_offset) + if type & LOCAL_TYPE + emit_localaddr(value + ref_offset) else - emit_globaladdr(value, ref_offset) + emit_globaladdr(value, ref_offset) fin ref_offset = 0 - fin + fin emit_val = TRUE else if ref_offset <> 0 @@ -3291,21 +3291,21 @@ def parse_value(rvalue) ref_offset = 0 fin fin - while parse_expr - if token <> COMMA_TKN - break + while parse_expr + if token <> COMMA_TKN + break fin - emit_indexword - emit_lw + emit_indexword + emit_lw loop - if token <> CLOSE_BRACKET_TKN - return parse_err(@no_close_bracket) + if token <> CLOSE_BRACKET_TKN + return parse_err(@no_close_bracket) fin - if ref_type & (WPTR_TYPE | WORD_TYPE) - emit_indexword + if ref_type & (WPTR_TYPE | WORD_TYPE) + emit_indexword ref_type = WPTR_TYPE else - emit_indexbyte + emit_indexbyte ref_type = BPTR_TYPE fin break @@ -3332,7 +3332,7 @@ def parse_value(rvalue) fin fin fin - emit_val = 1; + emit_val = 1; else if ref_offset <> 0 emit_const(ref_offset) @@ -3389,16 +3389,16 @@ def parse_value(rvalue) ref_offset = 0 emit_val = TRUE fin - fin + fin break wend loop if emit_val if ref_offset <> 0 - emit_const(ref_offset) - emit_op($02) - ref_offset = 0 - fin + emit_const(ref_offset) + emit_op($02) + ref_offset = 0 + fin if deref if ref_type & BPTR_TYPE emit_lb @@ -3527,7 +3527,7 @@ def parse_stmnt ctag_resolve(tag_endif) fin if token <> FIN_TKN; return parse_err(@no_fin); fin - break + break is WHILE_TKN tag_while = ctag_new tag_wend = ctag_new @@ -3546,7 +3546,7 @@ def parse_stmnt ctag_resolve(tag_wend) break_tag = tag_prevbrk cont_tag = tag_prevcnt - break + break is REPEAT_TKN tag_repeat = ctag_new tag_prevbrk = break_tag @@ -3565,7 +3565,7 @@ def parse_stmnt emit_brfls(tag_repeat) ctag_resolve(break_tag) break_tag = tag_prevbrk - break + break is FOR_TKN stack_loop = stack_loop + 1 tag_for = ctag_new @@ -3634,7 +3634,7 @@ def parse_stmnt emit_drop break_tag = tag_prevbrk stack_loop = stack_loop - 1 - break + break is CASE_TKN stack_loop = stack_loop + 1 tag_prevbrk = break_tag @@ -3645,58 +3645,58 @@ def parse_stmnt nextln while token <> ENDCASE_TKN when token - is OF_TKN + is OF_TKN if !parse_expr; return parse_err(@bad_stmnt); fin - emit_brne(tag_choice) - ctag_resolve(tag_of) - while parse_stmnt + emit_brne(tag_choice) + ctag_resolve(tag_of) + while parse_stmnt nextln - loop - tag_of = ctag_new - if prevstmnt <> BREAK_TKN // Fall through to next OF if no break + loop + tag_of = ctag_new + if prevstmnt <> BREAK_TKN // Fall through to next OF if no break emit_branch(tag_of) - fin - ctag_resolve(tag_choice) - tag_choice = ctag_new - break + fin + ctag_resolve(tag_choice) + tag_choice = ctag_new + break is DEFAULT_TKN ctag_resolve(tag_of) - tag_of = 0 - scan - while parse_stmnt + tag_of = 0 + scan + while parse_stmnt nextln - loop - if token <> ENDCASE_TKN; return parse_err(@bad_stmnt); fin - break - is EOL_TKN + loop + if token <> ENDCASE_TKN; return parse_err(@bad_stmnt); fin + break + is EOL_TKN nextln - break + break otherwise return parse_err(@bad_stmnt) - wend + wend loop if (tag_of) ctag_resolve(tag_of) - fin + fin ctag_resolve(break_tag) emit_drop break_tag = tag_prevbrk stack_loop = stack_loop - 1 - break + break is BREAK_TKN if break_tag emit_branch(break_tag) else return parse_err(@bad_stmnt) fin - break + break is CONT_TKN if cont_tag emit_branch(cont_tag) else return parse_err(@bad_stmnt) fin - break + break is RETURN_TKN if infunc for i = 1 to stack_loop @@ -3707,7 +3707,7 @@ def parse_stmnt emit_const(0) fin emit_leave - break + break is EOL_TKN return TRUE is ELSE_TKN @@ -3896,12 +3896,12 @@ def parse_struc struclen = 0 if scan == ID_TKN struclen = tknlen - if struclen > 16 - struclen = 16 - fin - for idlen = 0 to struclen - strucid[idlen] = ^(tknptr + idlen) - next + if struclen > 16 + struclen = 16 + fin + for idlen = 0 to struclen + strucid[idlen] = ^(tknptr + idlen) + next fin offset = 0 while nextln == BYTE_TKN or token == WORD_TKN @@ -3931,10 +3931,10 @@ def parse_struc fin if type & WORD_TYPE size = size * 2 - fin + fin if idlen idconst_add(idstr, idlen, offset) - fin + fin offset = offset + size until token <> COMMA_TKN if token <> EOL_TKN; return FALSE; fin @@ -3962,7 +3962,7 @@ def parse_vars return parse_err(@bad_cnst) fin idconst_add(idptr, idlen, value) - break + break is STRUC_TKN if !parse_struc; parse_err(@bad_struc); fin break @@ -3978,7 +3978,7 @@ def parse_vars return FALSE fin until token <> COMMA_TKN - break + break is PREDEF_TKN repeat if scan == ID_TKN @@ -3987,7 +3987,7 @@ def parse_vars return parse_err(@bad_decl) fin until scan <> COMMA_TKN - break + break is EOL_TKN break otherwise @@ -4057,28 +4057,28 @@ def parse_module while parse_defs nextln loop - framesize = 0 - entrypoint = codeptr - emit_enter(0) - prevstmnt = 0 + framesize = 0 + entrypoint = codeptr + emit_enter(0) + prevstmnt = 0 if token <> DONE_TKN while parse_stmnt nextln loop fin - if prevstmnt <> RETURN_TKN - emit_const(0) - emit_leave - fin - if not parserr + if prevstmnt <> RETURN_TKN + emit_const(0) + emit_leave + fin + if not parserr //dumpsym(idglobal_tbl, globals) //prstr(@entrypt_str) //prword(entrypoint) - prstr(@bytes_compiled_str) - prword(codeptr - codebuff) + prstr(@bytes_compiled_str) + prword(codeptr - codebuff) crout keyin() - fin + fin return not parserr fin return FALSE diff --git a/src/vmsrc/a1cmd.pla b/src/vmsrc/a1cmd.pla index a353bd6..91ea541 100755 --- a/src/vmsrc/a1cmd.pla +++ b/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)