diff --git a/src/makefile b/src/makefile index 559ac20..dce4ea5 100755 --- a/src/makefile +++ b/src/makefile @@ -126,7 +126,7 @@ $(ED): toolsrc/ed.pla $(PLVM02) $(PLASM) toolsrc/ed.pla acme --setpc 8192 -o $(ED) toolsrc/ed.a $(SB): toolsrc/sb.pla $(PLVM02) $(PLASM) toolsrc/sb.pla - ./$(PLASM) -AO < toolsrc/sb.pla > toolsrc/sb.a + ./$(PLASM) -AOW < toolsrc/sb.pla > toolsrc/sb.a acme --setpc 8192 -o $(SB) toolsrc/sb.a $(ARGS): libsrc/args.pla $(PLVM02) $(PLASM) diff --git a/src/toolsrc/sb.pla b/src/toolsrc/sb.pla index 3fbcb95..1e2a522 100644 --- a/src/toolsrc/sb.pla +++ b/src/toolsrc/sb.pla @@ -2,7 +2,7 @@ // Global constants // const FALSE = 0 -const TRUE = 1 +const TRUE = !FALSE // // Hardware constants // @@ -106,7 +106,7 @@ word keyin, cursrow, scrntop, cursptr // // Predeclared functions // -predef cmdmode(clrscrn) +predef cmdmode(clrscrn)#0 // // Compiler variables // @@ -516,7 +516,7 @@ end // MEMSET(ADDR, VALUE, SIZE) // With optimizations from Peter Ferrie // -asm memset(addr, val, size) +asm memset(addr, val, size)#0 LDA ESTKL+2,X STA DSTL LDA ESTKH+2,X @@ -542,6 +542,7 @@ SETMLPH STA (DST),Y LDA ESTKH+1,X BCS SETMLPH SETMEX INX + INX INX RTS end @@ -549,31 +550,32 @@ end // COPY MEMORY // MEMCPY(DSTADDR, SRCADDR, SIZE) // -asm memcpy(dst, src, size) +asm memcpy(dst, src, size)#0 INX INX - LDA ESTKL-2,X - ORA ESTKH-2,X + INX + LDA ESTKL-3,X + ORA ESTKH-3,X BEQ CPYMEX - LDA ESTKL-1,X - CMP ESTKL,X - LDA ESTKH-1,X - SBC ESTKH,X + LDA ESTKL-2,X + CMP ESTKL-1,X + LDA ESTKH-2,X + SBC ESTKH-1,X BCC REVCPY ; ; FORWARD COPY ; - LDA ESTKL,X - STA DSTL - LDA ESTKH,X - STA DSTH LDA ESTKL-1,X - STA SRCL + STA DSTL LDA ESTKH-1,X + STA DSTH + LDA ESTKL-2,X + STA SRCL + LDA ESTKH-2,X STA SRCH - LDY ESTKL-2,X + LDY ESTKL-3,X BEQ FORCPYLP - INC ESTKH-2,X + INC ESTKH-3,X LDY #$00 FORCPYLP LDA (SRC),Y STA (DST),Y @@ -581,34 +583,34 @@ FORCPYLP LDA (SRC),Y BNE + INC DSTH INC SRCH -+ DEC ESTKL-2,X ++ DEC ESTKL-3,X BNE FORCPYLP - DEC ESTKH-2,X + DEC ESTKH-3,X BNE FORCPYLP RTS ; ; REVERSE COPY ; REVCPY ;CLC - LDA ESTKL-2,X - ADC ESTKL,X + LDA ESTKL-3,X + ADC ESTKL-1,X STA DSTL - LDA ESTKH-2,X - ADC ESTKH,X + LDA ESTKH-3,X + ADC ESTKH-1,X STA DSTH CLC - LDA ESTKL-2,X - ADC ESTKL-1,X + LDA ESTKL-3,X + ADC ESTKL-2,X STA SRCL - LDA ESTKH-2,X - ADC ESTKH-1,X + LDA ESTKH-3,X + ADC ESTKH-2,X STA SRCH DEC DSTH DEC SRCH LDY #$FF - LDA ESTKL-2,X + LDA ESTKL-3,X BEQ REVCPYLP - INC ESTKH-2,X + INC ESTKH-3,X REVCPYLP LDA (SRC),Y STA (DST),Y DEY @@ -616,9 +618,9 @@ REVCPYLP LDA (SRC),Y BNE + DEC DSTH DEC SRCH -+ DEC ESTKL-2,X ++ DEC ESTKL-3,X BNE REVCPYLP - DEC ESTKH-2,X + DEC ESTKH-3,X BNE REVCPYLP CPYMEX RTS end @@ -626,8 +628,9 @@ end // CHAR OUT // COUT(CHAR) // -asm cout(char) +asm cout(char)#0 LDA ESTKL,X + INX COUT1 BIT $BF98 BMI + JSR TOUPR @@ -656,12 +659,13 @@ end // PRINT STRING // PRSTR(STR) // -asm prstr(pstr) +asm prstr(pstr)#0 LDY #$00 LDA ESTKL,X STA SRCL LDA ESTKH,X STA SRCH + INX LDA (SRC),Y STA TMP BEQ ++ @@ -699,7 +703,7 @@ end // // EXIT // -asm exit +asm exit#0 JSR $BF00 !BYTE $65 !WORD EXITTBL @@ -726,11 +730,12 @@ TOUPR AND #$7F + STA ESTKL,X RTS end -asm clrhibit(strptr) +asm clrhibit(strptr)#0 LDA ESTKL,X STA SRCL LDA ESTKH,X STA SRCH + INX LDY #$00 LDA (SRC),Y BEQ + @@ -742,11 +747,12 @@ CLHILP LDA (SRC),Y BNE CLHILP + RTS end -asm sethibit(strptr) +asm sethibit(strptr)#0 LDA ESTKL,X STA SRCL LDA ESTKH,X STA SRCH + INX LDY #$00 LDA (SRC),Y BEQ + @@ -758,16 +764,17 @@ STHILP LDA (SRC),Y BNE STHILP + RTS end -asm cpyln(srcstr, dststr) +asm cpyln(srcstr, dststr)#0 LDA ESTKL,X STA DSTL LDA ESTKH,X STA DSTH - INX + INX LDA ESTKL,X STA SRCL LDA ESTKH,X STA SRCH + INX LDY #$00 LDA (SRC),Y TAY @@ -786,7 +793,7 @@ CPLNLP LDA (SRC),Y BNE CPLNLP LDA (SRC),Y ++ STA (DST),Y - RTS + RTS end // //def skipspace(scanptr) @@ -896,12 +903,12 @@ end // // Runtime routines // -def home - return call($FC58, 0, 0, 0, 0) +def home#0 + call($FC58, 0, 0, 0, 0) end -def gotoxy(x, y) +def gotoxy(x, y)#0 ^$24 = x + ^$20 - return call($FB5B, y + ^$22, 0, 0, 0) + call($FB5B, y + ^$22, 0, 0, 0) end // // ProDOS routines @@ -1002,16 +1009,16 @@ end // //===================================== -def crout +def crout#0 cout($0D) end -def bell - return call($FBDD, 0, 0, 0, 0) +def bell#0 + call($FBDD, 0, 0, 0, 0) end // // Memory management routines // -def strcpy(dststr, srcstr) +def strcpy(dststr, srcstr)#0 byte strlen strlen = ^srcstr @@ -1067,7 +1074,7 @@ def heapalloc(size) prstr(@outofmem) return 0 end -def freestr(strptr) +def freestr(strptr)#0 byte mask, ofst if strptr and strptr <> @nullstr @@ -1097,9 +1104,7 @@ def newstr(strptr) fin return @nullstr end -def inittxtbuf - word i - +def inittxtbuf#0 memset(strheapmap, 0, strheapmsz) memset(strlinbuf, @nullstr, maxfill * 2) numlines = 1 @@ -1122,7 +1127,7 @@ def caseconv(chr) fin return chr end -def strupper(strptr) +def strupper(strptr)#0 byte i, chr for i = ^strptr downto 1 @@ -1132,7 +1137,7 @@ def strupper(strptr) fin next end -def strlower(strptr) +def strlower(strptr)#0 byte i, chr for i = ^strptr downto 1 @@ -1142,7 +1147,7 @@ def strlower(strptr) fin next end -def txtupper +def txtupper#0 word i, strptr flags = flags | uppercase @@ -1150,7 +1155,7 @@ def txtupper strupper(strlinbuf:[i]) next end -def txtlower +def txtlower#0 word i, strptr flags = flags & ~uppercase @@ -1158,15 +1163,15 @@ def txtlower strlower(strlinbuf:[i]) next end -def prbyte(h) +def prbyte(h)#0 cout('$') - return call($FDDA, h, 0, 0, 0) + call($FDDA, h, 0, 0, 0) end -def prword(h) +def prword(h)#0 cout('$') - return call($F941, h >> 8, h, 0, 0) + call($F941, h >> 8, h, 0, 0) end -def print(i) +def print(i)#0 byte numstr[7] byte place, sign @@ -1180,25 +1185,25 @@ def print(i) while i >= 10 numstr[place] = i % 10 + '0' i = i / 10 - place = place - 1 + place-- loop numstr[place] = i + '0' - place = place - 1 + place-- if sign numstr[place] = '-' - place = place - 1 + place-- fin numstr[place] = 6 - place - return prstr(@numstr[place]) + prstr(@numstr[place]) end -def nametostr(namestr, len, strptr) +def nametostr(namestr, len, strptr)#0 ^strptr = len - return memcpy(strptr + 1, namestr, len) + memcpy(strptr + 1, namestr, len) end // // File routines // -def readtxt(filename) +def readtxt(filename)#0 byte txtbuf[81], refnum, i, j refnum = open(filename, iobuffer) @@ -1214,17 +1219,17 @@ 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++ + fin fin if refnum; close(refnum); fin end -def writetxt(filename) +def writetxt(filename)#0 byte txtbuf[81], refnum byte j, chr word i, strptr @@ -1244,20 +1249,20 @@ def writetxt(filename) // for i = 0 to numlines - 1 cpyln(strlinbuf:[i], @txtbuf) - txtbuf = txtbuf + 1 + txtbuf++ txtbuf[txtbuf] = $0D write(refnum, @txtbuf + 1, txtbuf) if !(i & $0F); cout('.'); fin next - return close(refnum) + close(refnum) end // // Screen routines // -def clrscrn - return call($FC58, 0, 0, 0, 0) +def clrscrn#0 + call($FC58, 0, 0, 0, 0) end -def drawrow(row, ofst, strptr) +def drawrow(row, ofst, strptr)#0 byte numchars word scrnptr @@ -1272,35 +1277,31 @@ def drawrow(row, ofst, strptr) else memset(scrnptr + numchars, $A0A0, 40 - numchars) fin - return memcpy(scrnptr, strptr + ofst + 1, numchars) + memcpy(scrnptr, strptr + ofst + 1, numchars) end -def drawscrn(toprow, ofst) +def drawscrn(toprow, ofst)#0 byte row, numchars word strptr, scrnptr 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] + numchars = ofst >= ^strptr ?? 0 :: ^strptr - ofst + if numchars >= 40 numchars = 40 - else - memset(scrnptr + numchars, $A0A0, 40 - numchars) + else + memset(scrnptr + numchars, $A0A0, 40 - numchars) fin - memcpy(scrnptr, strptr + ofst + 1, numchars) + memcpy(scrnptr, strptr + ofst + 1, numchars) next end -def cursoff +def cursoff#0 if flags & showcurs ^cursptr = underchr flags = flags & ~showcurs fin end -def curson +def curson#0 if !(flags & showcurs) cursptr = txtscrn[cursy] + cursx underchr = ^cursptr @@ -1308,22 +1309,22 @@ def curson flags = flags | showcurs fin end -def cursflash +def cursflash#0 if flags & showcurs if flash == 0 ^cursptr = curschr elsif flash == 128 ^cursptr = underchr fin - flash = flash + 1 + flash++ fin end -def redraw +def redraw#0 cursoff drawscrn(scrntop, scrnleft) curson end -def curshome +def curshome#0 cursoff cursrow = 0 curscol = 0 @@ -1332,9 +1333,9 @@ def curshome scrnleft = 0 scrntop = 0 drawscrn(scrntop, scrnleft) - return curson + curson end -def cursend +def cursend#0 cursoff if numlines > 23 cursrow = numlines - 1 @@ -1349,14 +1350,14 @@ def cursend cursx = 0 scrnleft = 0 drawscrn(scrntop, scrnleft) - return curson + curson end -def cursup +def cursup#0 if cursrow > 0 cursoff - cursrow = cursrow - 1 + cursrow-- if cursy > 0 - cursy = cursy - 1 + cursy-- else scrntop = cursrow drawscrn(scrntop, scrnleft) @@ -1364,19 +1365,19 @@ def cursup curson fin end -def pgup +def pgup#0 byte i for i = pgjmp downto 0 cursup next end -def cursdown +def cursdown#0 if cursrow < numlines - 1 cursoff - cursrow = cursrow + 1 + cursrow++ if cursy < 23 - cursy = cursy + 1 + cursy++ else scrntop = cursrow - 23 drawscrn(scrntop, scrnleft) @@ -1384,19 +1385,19 @@ def cursdown curson fin end -def pgdown +def pgdown#0 byte i for i = pgjmp downto 0 cursdown next end -def cursleft +def cursleft#0 if curscol > 0 cursoff - curscol = curscol - 1 + curscol-- if cursx > 0 - cursx = cursx - 1 + cursx-- else scrnleft = curscol drawscrn(scrntop, scrnleft) @@ -1404,19 +1405,19 @@ def cursleft curson fin end -def pgleft +def pgleft#0 byte i for i = 7 downto 0 cursleft next end -def cursright +def cursright#0 if curscol < 80 cursoff - curscol = curscol + 1 + curscol++ if cursx < 39 - cursx = cursx + 1 + cursx++ else scrnleft = curscol - 39 drawscrn(scrntop, scrnleft) @@ -1424,7 +1425,7 @@ def cursright curson fin end -def pgright +def pgright#0 byte i for i = 7 downto 0 @@ -1443,22 +1444,17 @@ 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 @@ -1475,37 +1471,42 @@ def keyin2 fin until key >= 128 ^keystrobe - if key == keyctrln - key = $DB // [ - elsif key == keyctrlp - key = $DF // _ - elsif key == keyctrlb - key = $FC // | - elsif key == keyctrly - key = $FE // ~ -// elsif key == keyarrowleft -// if ^pushbttn3 < 128 -// key = $FF -// fin - elsif key >= $C0 and flags < shiftlock - if ^pushbttn3 < 128 - if key == $C0 - key = $D0 // P - elsif key == $DD - key = $CD // M - elsif key == $DE - key = $CE // N + when key + is keyctrln + key = $DB; break // [ + is keyctrlp + key = $DF; break // _ + is keyctrlb + key = $FC; break // | + is keyctrly + key = $FE; break // ~ +// is keyarrowleft +// if ^pushbttn3 < 128 +// key = $FF +// fin +// break + otherwise + if key >= $C0 and flags < shiftlock + if ^pushbttn3 < 128 + when key + is $C0 + key = $D0; break // P + is $DD + key = $CD; break // M + is $DE + key = $CE; break // N + wend + else + key = key | $E0 + fin fin - else - key = key | $E0 - fin - fin + wend return key end // // Printer routines // -def printtxt(slot) +def printtxt(slot)#0 byte txtbuf[80] word i, scrncsw @@ -1522,38 +1523,38 @@ def openline(row) if numlines < maxlines memcpy(@strlinbuf:[row + 1], @strlinbuf:[row], (numlines - row) * 2) strlinbuf:[row] = @nullstr - numlines = numlines + 1 + numlines++ flags = flags | changed return 1 fin bell return 0 end -def cutline +def cutline#0 freestr(cutbuf) cutbuf = strlinbuf:[cursrow] memcpy(@strlinbuf:[cursrow], @strlinbuf:[cursrow + 1], (numlines - cursrow) * 2) if numlines > 1 - numlines = numlines - 1 + numlines-- fin flags = flags | changed if cursrow == numlines cursup fin - return redraw + redraw end -def pasteline +def pasteline#0 if cutbuf and numlines < maxlines memcpy(@strlinbuf:[cursrow + 1], @strlinbuf:[cursrow], (numlines - cursrow) * 2) strlinbuf:[cursrow] = newstr(cutbuf) - numlines = numlines + 1 + numlines++ flags = flags | changed redraw else bell fin end -def joinline +def joinline#0 byte joinstr[80], joinlen if cursrow < numlines - 1 @@ -1565,7 +1566,7 @@ def joinline freestr(strlinbuf:[cursrow]) strlinbuf:[cursrow] = newstr(@joinstr) freestr(strlinbuf:[cursrow + 1]) - numlines = numlines - 1 + numlines-- memcpy(@strlinbuf:[cursrow + 1], @strlinbuf:[cursrow + 2], (numlines - cursrow) * 2) flags = flags | changed redraw @@ -1574,7 +1575,7 @@ def joinline fin fin end -def splitline +def splitline#0 byte splitstr[80], splitlen if openline(cursrow + 1) @@ -1628,15 +1629,15 @@ def editline(key) if curscol > 0 if curscol <= editstr memcpy(@editstr[curscol], @editstr[curscol + 1], editstr - curscol) - editstr = editstr - 1 + editstr-- fin - curscol = curscol - 1 + curscol-- cursoff if cursx > 0 - cursx = cursx - 1 + cursx-- drawrow(cursy, scrnleft, @editstr) else - scrnleft = scrnleft - 1 + scrnleft-- drawscrn(scrntop, scrnleft) fin curson @@ -1653,23 +1654,21 @@ def editline(key) memcpy(@editstr[curscol + 1], @editstr[curscol], editstr - curscol) fin else - curscol = curscol - 1 - cursx = cursx - 1 - key = editstr[curscol] + curscol-- + cursx-- + key = editstr[curscol] bell fin - else - if curscol > editstr - editstr = curscol - fin + elsif curscol > editstr + editstr = curscol fin editstr[curscol] = caseconv(key) cursoff if cursx <= 39 drawrow(cursy, scrnleft, @editstr) else - scrnleft = scrnleft + 1 - cursx = 39 + scrnleft++ + cursx = 39 drawscrn(scrntop, scrnleft) fin curson @@ -1680,7 +1679,7 @@ def editline(key) if curscol < editstr strcpy(undoline, @editstr) memcpy(@editstr[curscol + 1], @editstr[curscol + 2], editstr - curscol) - editstr = editstr - 1 + editstr-- cursoff drawrow(cursy, scrnleft, @editstr) curson @@ -1702,7 +1701,7 @@ def editline(key) fin return key end -def editmode +def editmode#0 repeat when editline(keyin()) is keyarrowup @@ -1730,29 +1729,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++ + 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 +1762,7 @@ def editmode flags = flags | insmode curschr = '+' fin - break + break is keyctrlc if flags & uppercase txtlower @@ -1771,19 +1770,19 @@ def editmode txtupper fin redraw - break + break is keyescape cursoff cmdmode(TRUE) redraw - break + break wend until FALSE end // // Command mode // -def prfiles(optpath) +def prfiles(optpath)#0 byte path[64] byte refnum byte firstblk @@ -1799,8 +1798,8 @@ def prfiles(optpath) crout fin refnum = open(@path, iobuffer) - if perr - return perr + if !refnum + return fin firstblk = 1 repeat @@ -1836,12 +1835,11 @@ def prfiles(optpath) until filecnt == 0 close(refnum) crout - return 0 end -def striplead(strptr, chr) +def striplead(strptr, chr)#0 while ^strptr and ^(strptr + 1) == chr memcpy(strptr + 1, strptr + 2, ^strptr) - ^strptr = ^strptr - 1 + ^strptr-- loop end def parsecmd(strptr) @@ -1852,7 +1850,7 @@ def parsecmd(strptr) if ^strptr cmd = ^(strptr + 1) memcpy(strptr + 1, strptr + 2, ^strptr) - ^strptr = ^strptr - 1 + ^strptr-- fin if ^strptr striplead(strptr, ' ') @@ -1870,12 +1868,12 @@ def chkchng fin return TRUE end -def quit +def quit#0 if chkchng exit fin end -def cmdmode(clearscr) +def cmdmode(clearscr)#0 byte slot word cmdptr @@ -1891,18 +1889,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 +1908,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 +1920,7 @@ def cmdmode(clearscr) slot = 1 fin printtxt(slot) - break + break is 'Q' quit is 'E' @@ -1932,9 +1930,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 +1944,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('?') @@ -2004,23 +2002,23 @@ def ctag_new ctag_tbl:[codetag] = 0 // Unresolved, nothing to update yet return codetag | IS_CTAG end -def ctag_resolve(ctag) +def ctag_resolve(ctag)#0 word updtptr, nextptr ctag = ctag & MASK_CTAG // Better be a ctag! - if ctag_tbl:[ctag] & IS_RESOLVED; return parse_err(@dup_id); fin + if ctag_tbl:[ctag] & IS_RESOLVED;parse_err(@dup_id); return; fin updtptr = ctag_tbl:[ctag] & MASK_CTAG while updtptr // // 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 @@ -2028,23 +2026,23 @@ end // // Emit data/bytecode // -def emit_byte(bval) +def emit_byte(bval)#0 ^codeptr = bval codeptr = codeptr + 1 end -def emit_word(wval) +def emit_word(wval)#0 *codeptr = wval codeptr = codeptr + 2 end -def emit_fill(size) +def emit_fill(size)#0 memset(codeptr, 0, size) codeptr = codeptr + size end -def emit_op(op) +def emit_op(op)#0 lastop = op - return emit_byte(op) + emit_byte(op) end -def emit_addr(tag) +def emit_addr(tag)#0 word updtptr if tag & IS_CTAG @@ -2063,7 +2061,7 @@ def emit_addr(tag) emit_word(tag + codebuff) fin end -def emit_reladdr(tag) +def emit_reladdr(tag)#0 word updtptr if tag & IS_CTAG @@ -2082,8 +2080,8 @@ def emit_reladdr(tag) emit_word(tag - (codeptr - codebuff)) fin end -def emit_iddata(value, size, namestr) - return emit_fill(size) +def emit_iddata(value, size, namestr)#0 + emit_fill(size) end def emit_data(vartype, consttype, constval, constsize) byte i @@ -2117,7 +2115,7 @@ def emit_data(vartype, consttype, constval, constsize) fin return size end -def emit_const(cval) +def emit_const(cval)#0 if cval == 0 emit_op($00) elsif cval > 0 and cval < 256 @@ -2128,106 +2126,126 @@ def emit_const(cval) emit_word(cval) fin end -def emit_constr(str, size) +def emit_constr(str, size)#0 emit_op($2E) - return emit_data(0, STR_TYPE, str, size) + emit_data(0, STR_TYPE, str, size) end -def emit_lb - return emit_op($60) +def emit_lb#0 + emit_op($60) end -def emit_lw - return emit_op($62) +def emit_lw#0 + emit_op($62) end -def emit_llb(offset) +def emit_llb(offset)#0 emit_op($64) - return emit_byte(offset) + emit_byte(offset) end -def emit_llw(offset) +def emit_llw(offset)#0 emit_op($66) - return emit_byte(offset) + emit_byte(offset) end -def emit_lab(tag, offset) - if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin - emit_op($68) - return emit_addr(tag+offset) +def emit_lab(tag, offset)#0 + if tag & IS_CTAG and offset + parse_err(@no_ctag_offst) + else + emit_op($68) + emit_addr(tag+offset) + fin end -def emit_law(tag, offset) - if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin - emit_op($6A) - return emit_addr(tag+offset) +def emit_law(tag, offset)#0 + if tag & IS_CTAG and offset + parse_err(@no_ctag_offst) + else + emit_op($6A) + emit_addr(tag+offset) + fin end -def emit_sb - return emit_op($70) +def emit_sb#0 + emit_op($70) end -def emit_sw - return emit_op($72) +def emit_sw#0 + emit_op($72) end -def emit_slb(offset) +def emit_slb(offset)#0 emit_op($74) - return emit_byte(offset) + emit_byte(offset) end -def emit_slw(offset) +def emit_slw(offset)#0 emit_op($76) - return emit_byte(offset) + emit_byte(offset) end -def emit_dup - return emit_op($32) +def emit_dup#0 + parse_err("No DUP op!") end -def emit_dlb(offset) +def emit_dlb(offset)#0 emit_op($6C) - return emit_byte(offset) + emit_byte(offset) end -def emit_dlw(offset) +def emit_dlw(offset)#0 emit_op($6E) - return emit_byte(offset) + emit_byte(offset) end -def emit_sab(tag, offset) - if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin - emit_op($78) - return emit_addr(tag+offset) +def emit_sab(tag, offset)#0 + if tag & IS_CTAG and offset + parse_err(@no_ctag_offst) + else + emit_op($78) + emit_addr(tag+offset) + fin end -def emit_saw(tag, offset) - if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin - emit_op($7A) - return emit_addr(tag+offset) +def emit_saw(tag, offset)#0 + if tag & IS_CTAG and offset + parse_err(@no_ctag_offst) + else + emit_op($7A) + emit_addr(tag+offset) + fin end -def emit_dab(tag, offset) - if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin - emit_op($7C) - return emit_addr(tag+offset) +def emit_dab(tag, offset)#0 + if tag & IS_CTAG and offset + parse_err(@no_ctag_offst) + else + emit_op($7C) + emit_addr(tag+offset) + fin end -def emit_daw(tag, offset) - if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin - emit_op($7E) - return emit_addr(tag+offset) +def emit_daw(tag, offset)#0 + if tag & IS_CTAG and offset + parse_err(@no_ctag_offst) + else + emit_op($7E) + emit_addr(tag+offset) + fin end -def emit_call(tag) +def emit_call(tag)#0 emit_op($54) - return emit_addr(tag) + emit_addr(tag) end -def emit_ical - return emit_op($56) +def emit_ical#0 + emit_op($56) end -def emit_push - emit_op($34) +def emit_push#0 + parse_err("Function call too complex") end -def emit_pull - emit_op($36) +def emit_pull#0 end -def emit_localaddr(offset) +def emit_localaddr(offset)#0 emit_op($28) - return emit_byte(offset) + emit_byte(offset) end -def emit_globaladdr(tag, offset) - if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin - emit_op($26) - return emit_addr(tag+offset) +def emit_globaladdr(tag, offset)#0 + if tag & IS_CTAG and offset + parse_err(@no_ctag_offst) + else + emit_op($26) + emit_addr(tag+offset) + fin end -def emit_indexbyte - return emit_op($02) +def emit_indexbyte#0 + emit_op($02) end -def emit_indexword - return emit_op($1E) +def emit_indexword#0 + emit_op($1E) end def emit_unaryop(op) when op @@ -2332,41 +2350,41 @@ def emit_binaryop(op) wend return TRUE end -def emit_brtru(tag) +def emit_brtru(tag)#0 emit_op($4E) - return emit_reladdr(tag) + emit_reladdr(tag) end -def emit_brfls(tag) +def emit_brfls(tag)#0 emit_op($4C) - return emit_reladdr(tag) + emit_reladdr(tag) end -def emit_brgt(tag) +def emit_brgt(tag)#0 emit_op($38) - return emit_reladdr(tag) + emit_reladdr(tag) end -def emit_brlt(tag) +def emit_brlt(tag)#0 emit_op($3A) - return emit_reladdr(tag) + emit_reladdr(tag) end -def emit_brne(tag) +def emit_brne(tag)#0 emit_op($3E) - return emit_reladdr(tag) + emit_reladdr(tag) end -def emit_branch(tag) +def emit_branch(tag)#0 emit_op($50) - return emit_reladdr(tag) + emit_reladdr(tag) end -def emit_drop - return emit_op($30) +def emit_drop#0 + emit_op($30) end -def emit_leave +def emit_leave#0 if framesize emit_op($5A) else emit_op($5C) fin end -def emit_enter(cparams) +def emit_enter(cparams)#0 emit_byte(emit_enter.[0]) emit_byte(emit_enter.[1]) emit_byte(emit_enter.[2]) @@ -2398,7 +2416,7 @@ def idmatch(nameptr, len, idptr, idcnt) loop return 0 end -def dumpsym(idptr, idcnt) +def dumpsym(idptr, idcnt)#0 while idcnt prword(idptr=>idval) cout(' ') @@ -2469,7 +2487,7 @@ def iddata_add(namestr, len, type, size) datasize = datasize + size return TRUE end -def iddata_size(type, varsize, initsize) +def iddata_size(type, varsize, initsize)#0 if varsize > initsize datasize = datasize + varsize emit_data(0, 0, 0, varsize - initsize) @@ -2496,7 +2514,7 @@ end def idconst_add(namestr, len, value) return idglobal_add(namestr, len, CONST_TYPE, value) end -def idglobal_init +def idglobal_init#0 word ctag lineno = 0 @@ -2581,7 +2599,7 @@ def idglobal_init // datasize = codeptr - codebuff end -def idlocal_init +def idlocal_init#0 locals = 0 framesize = 0 lastlocal = idlocal_tbl @@ -2589,18 +2607,14 @@ end // // Alebraic op to stack op // -def push_op(op, prec) +def push_op(op, prec)#0 opsp = opsp + 1 - if opsp == 16 - return parse_err(@estk_overflw) - fin + if opsp == 16; parse_err(@estk_overflw); return; fin opstack[opsp] = op precstack[opsp] = prec end def pop_op - if opsp < 0 - return parse_err(@estk_underflw) - fin + if opsp < 0; return parse_err(@estk_underflw); fin opsp = opsp - 1 return opstack[opsp + 1] end @@ -2616,19 +2630,15 @@ def tos_op_prec(tos) fin return precstack[opsp] end -def push_val(value, size, type) +def push_val(value, size, type)#0 valsp = valsp + 1 - if valsp == 16 - return parse_err(@estk_overflw) - fin + if valsp == 16; parse_err(@estk_overflw); return; fin valstack[valsp] = value sizestack[valsp] = size typestack[valsp] = type end def pop_val(valptr, sizeptr, typeptr) - if valsp < 0 - return parse_err(@estk_underflw) - fin + if valsp < 0; return parse_err(@estk_underflw); fin *valptr = valstack[valsp] ^sizeptr = sizestack[valsp] ^typeptr = typestack[valsp] @@ -2842,7 +2852,7 @@ def scan tknlen = scanptr - tknptr return token end -def rewind(ptr) +def rewind(ptr)#0 scanptr = ptr end def lookahead @@ -3270,19 +3280,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 +3301,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 +3342,7 @@ def parse_value(rvalue) fin fin fin - emit_val = 1; + emit_val = 1; else if ref_offset <> 0 emit_const(ref_offset) @@ -3389,7 +3399,7 @@ def parse_value(rvalue) ref_offset = 0 emit_val = TRUE fin - fin + fin break wend loop @@ -3399,13 +3409,13 @@ def parse_value(rvalue) emit_op($02) ref_offset = 0 fin - if deref - if ref_type & BPTR_TYPE - emit_lb - elsif ref_type & WPTR_TYPE - emit_lw - fin + if deref + if ref_type & BPTR_TYPE + emit_lb + elsif ref_type & WPTR_TYPE + emit_lw fin + fin else // emit_val if deref if ref_type & CONST_TYPE @@ -3527,7 +3537,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 +3556,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 +3575,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 +3644,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 +3655,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 +3717,7 @@ def parse_stmnt emit_const(0) fin emit_leave - break + break is EOL_TKN return TRUE is ELSE_TKN @@ -4057,28 +4067,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