From 5f6a5088d703e72bfa544f620fa46811453c46bd Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Sat, 21 Jun 2014 20:45:44 -0700 Subject: [PATCH] Another optimization for inner interp loop, SOS quit, and begin conio library --- src/libsrc/conio.pla | 295 ++++++++++++++++++++++++++++++++++++++++++ src/samplesrc/rod.pla | 127 ++++++++++++------ src/vmsrc/plvm01.s | 4 +- src/vmsrc/plvm02.s | 6 +- src/vmsrc/plvm03.s | 46 +++---- src/vmsrc/plvmzp.inc | 17 ++- src/vmsrc/soscmd.pla | 17 ++- 7 files changed, 439 insertions(+), 73 deletions(-) create mode 100644 src/libsrc/conio.pla diff --git a/src/libsrc/conio.pla b/src/libsrc/conio.pla new file mode 100644 index 0000000..55b647e --- /dev/null +++ b/src/libsrc/conio.pla @@ -0,0 +1,295 @@ +import STDLIB + predef syscall, call, memset, getc, putc, puts, modaddr + byte MACHID +end +; +; Handy constants. +; +const FALSE = 0 +const TRUE = !FALSE +const FULLMODE = 0 +const MIXMODE = 1 +; +; Apple II hardware constants. +; +const speaker = $C030 +const showgraphics = $C050 +const showtext = $C051 +const showfull = $C052 +const showmix = $C053 +const showpage1 = $C054 +const showpage2 = $C055 +const showlores = $C056 +const showhires = $C057 +const keyboard = $C000 +const keystrobe = $C010 +const hgr1 = $2000 +const hgr2 = $4000 +const page1 = 0 +const page2 = 1 +; +; Predefined functions. +; +predef a2keypressed, a2gotoxy, a2grmixmode, a2textmode +; +; String pool. +; +byte stdlib[] = "STDLIB" +; +; Screen row address arrays. +; +word txt1scrn[] = $0400,$0480,$0500,$0580,$0600,$0680,$0700,$0780 +word = $0428,$04A8,$0528,$05A8,$0628,$06A8,$0728,$07A8 +word = $0450,$04D0,$0550,$05D0,$0650,$06D0,$0750,$07D0 +word txt2scrn[] = $0800,$0880,$0900,$0980,$0A00,$0A80,$0B00,$0B80 +word = $0828,$08A8,$0928,$09A8,$0A28,$0AA8,$0B28,$0BA8 +word = $0850,$08D0,$0950,$09D0,$0A50,$0AD0,$0B50,$0BD0 +; +; Apple 3 console codes. +; +byte textbwmode[] = 2, 16, 0 +byte textclrmode[] = 2, 16, 1 +byte grcharset[] = 1, 0, $7F, $7F, $7F, $7F, $00, $00, $00, $00 +byte devcons +; +; Exported function table. +; +export word conio[] +; +; Function pointers. +; +word = @a2reset +word = @a2keypressed +word = @a2home +word = @a2gotoxy +word = @a2viewport +word = @a2texttype +word = @a2textmode +word = @a2grmixmode +word = @grcolor +word = @grplot +; +; Native routines. +; +asm equates + !SOURCE "vmsrc/plvmzp.inc" +end +; +; def grscrn(rowaddrs) +; +asm grscrn +GRSCRN = $26 +GRSCRNL = GRSCRN +GRSCRNH = GRSCRNL+1 + LDA ESTKL,X + STA GRSCRNL + LDA ESTKH,X + STA GRSCRNH + RTS +end +; +; def grcolor(color) +; +asm grcolor +GRCLR = $30 + LDA #$0F + AND ESTKL,X + STA ESTKL,X + ASL + ASL + ASL + ASL + ORA ESTKL,X + STA GRCLR + RTS +end +; +; def grplot(x, y) +; +asm grplot + STY IPY + LDA ESTKL,X + AND #$FE + TAY + LDA (GRSCRN),Y + STA DSTL + INY + LDA (GRSCRN),Y + STA DSTH + LDY ESTKL+1,X + LDA GRCLR + LSR ESTKL,X + BCS + + AND #$0F + STA TMPL + LDA #$F0 + BCC ++ ++ AND #$F0 + STA TMPL + LDA #$0F +++ AND (DST),Y + ORA TMPL + STA (DST),Y + LDY IPY + INX + RTS +end +; +; Apple 1 routines. +; +def a1keypressed + return ^$D011 >= 128 +end +def a1gotoxy(x, y) +end +def a1viewport(left, top, width, height) +end +def a1texttype(type) +end +def a1textmode(columns) +end +def a1grmode(mix) + return 0 ; not supported +end +; +; Apple II routines. +; +def a2keypressed + return ^keyboard >= 128 +end +def a2gotoxy(x, y) + ^$24 = x + ^$20 + return call($FB5B, y + ^$22, 0, 0, 0) +end +def a2viewport(left, top, width, height) + if !width or !height + left = 0 + top = 0 + width = 40 + height = 24 + fin + ^$20 = left + ^$21 = width + ^$22 = top + ^$23 = height + top - 1 + return a2gotoxy(0, 0) +end +def a2texttype(type) +end +def a2textmode(columns) + call($FB39, 0, 0, 0, 0) ;textmode() + return call($FC58, 0, 0, 0, 0) ;home() +end +def a2grmode(mix) + call($FB2F, 0, 0, 0, 0) ;initmode() + call($FB40, 0, 0, 0, 0) ;grmode() + if !mix + ^showfull + fin + call($FC58, 0, 0, 0, 0) ;home() + return grscrn(@txt1scrn) ; point to lo-res screen +end +; +; Apple III routines. +; +def dev_control(devnum, code, list) + byte params[5] + + params.0 = 3 + params.1 = devnum + params.2 = code + params:3 = list + return syscall($83, @params) +end +def dev_status(devnum, code, list) + byte params[5] + + params.0 = 3 + params.1 = devnum + params.2 = code + params:3 = list + return syscall($82, @params) +end +def a3keypressed + byte count + dev_status(devcons, 5, @count) + return count +end +def a3home + return cout(28) +end +def a3gotoxy(x, y) + putc(24) + putc(x) + putc(25) + return putc(y) +end +def a3viewport(left, top, width, height) + if !width or !height + ; + ; Reset the full-screen viewport + ; + left = 0 + top = 0 + width = 80 + height = 24 + fin + putc(1) ; Reset viewport + putc(26) + putc(left) + putc(top) + putc(2) + putc(26) + putc(left + width - 1) + putc(top + height - 1) + putc(3) + return a3gotoxy(0, 0) +end +def a3texttype(type) +end +def a3textmode(columns) + puts(@textbwmode) + a3viewport(0, 0, 40, 24) + return putc(28) +end +def a3grmode(mix) + byte i + if mix + mix = 19 + else + mix = 23 + fin + puts(@textclrmode) + dev_control(devcons, 17, @grcharset) + a3viewport(0, 20, 40, 4) + for i = 0 to mix + memset(txt1scrn[i], 40, $0000) ; text screen + memset(txt2scrn[i], 40, $0000) ; color screen + next + return grscrn(@txt2scrn) ; point to color screen +end +; +; Machine specific initialization. +; +when MACHID & $C8 + is $08 ; Apple 1 + conio:reset = @a1reset + conio:keypressed = @a1keypressed + conio:home = @a1home + conio:gotoxy = @a1gotoxy + conio:viewport = @a1viewport + conio:texttype = @a1texttype + conio:textmode = @a1textmode + conio:grmixmode = @a1grmixmode + is $C0 ; Apple /// + conio:reset = @a3reset + conio:keypressed = @a3keypressed + conio:home = @a3home + conio:gotoxy = @a3gotoxy + conio:viewport = @a3viewport + conio:texttype = @a3texttype + conio:textmode = @a3textmode + conio:grmixmode = @a3grmixmode + devcons = modaddr(@stdlib).5 ; devcons variable from STDLIB + otherwise ; Apple ][ +wend diff --git a/src/samplesrc/rod.pla b/src/samplesrc/rod.pla index 757fd7f..6451aa1 100644 --- a/src/samplesrc/rod.pla +++ b/src/samplesrc/rod.pla @@ -7,6 +7,8 @@ end ; const FALSE=0 const TRUE=!FALSE +const FULLMODE=0 +const MIXMODE=1 ; ; Apple II hardware constants. ; @@ -28,7 +30,7 @@ const page2 = 1 ; ; Predefined functions. ; -predef a2keypressed, a2gotoxy, a2grmixmode, a2textmode, a2grcolor, a2grplot +predef a2keypressed, a2gotoxy, a2grmode, a2textmode ; ; String data. ; @@ -40,10 +42,10 @@ byte stdlib[] = "STDLIB" ; ; Screen row address arrays. ; -word txtscrn[] = $0400,$0480,$0500,$0580,$0600,$0680,$0700,$0780 +word txt1scrn[] = $0400,$0480,$0500,$0580,$0600,$0680,$0700,$0780 word = $0428,$04A8,$0528,$05A8,$0628,$06A8,$0728,$07A8 word = $0450,$04D0,$0550,$05D0,$0650,$06D0,$0750,$07D0 -word clrscrn[] = $0800,$0880,$0900,$0980,$0A00,$0A80,$0B00,$0B80 +word txt2scrn[] = $0800,$0880,$0900,$0980,$0A00,$0A80,$0B00,$0B80 word = $0828,$08A8,$0928,$09A8,$0A28,$0AA8,$0B28,$0BA8 word = $0850,$08D0,$0950,$09D0,$0A50,$0AD0,$0B50,$0BD0 ; @@ -52,17 +54,80 @@ word = $0850,$08D0,$0950,$09D0,$0A50,$0AD0,$0B50,$0BD0 byte textbwmode[] = 2, 16, 0 byte textclrmode[] = 2, 16, 1 byte grcharset[] = 1, 0, $7F, $7F, $7F, $7F, $00, $00, $00, $00 -byte grfullcolor byte devcons ; ; Function pointers. ; word keypressed = @a2keypressed word gotoxy = @a2gotoxy -word grmixmode = @a2grmixmode +word grmode = @a2grmode word textmode = @a2textmode -word grcolor = @a2grcolor -word grplot = @a2grplot +; +; Common routines. +; +asm equates + !SOURCE "vmsrc/plvmzp.inc" +end +; +; def grscrn(rowaddrs) +; +asm grscrn +GRSCRN = $26 +GRSCRNL = GRSCRN +GRSCRNH = GRSCRNL+1 + LDA ESTKL,X + STA GRSCRNL + LDA ESTKH,X + STA GRSCRNH + RTS +end +; +; def grcolor(color) +; +asm grcolor +GRCLR = $30 + LDA #$0F + AND ESTKL,X + STA ESTKL,X + ASL + ASL + ASL + ASL + ORA ESTKL,X + STA GRCLR + RTS +end +; +; def grplot(x, y) +; +asm grplot + STY IPY + LDA ESTKL,X + AND #$FE + TAY + LDA (GRSCRN),Y + STA DSTL + INY + LDA (GRSCRN),Y + STA DSTH + LDY ESTKL+1,X + LDA GRCLR + LSR ESTKL,X + BCS + + AND #$0F + STA TMPL + LDA #$F0 + BCC ++ ++ AND #$F0 + STA TMPL + LDA #$0F +++ AND (DST),Y + ORA TMPL + STA (DST),Y + LDY IPY + INX + RTS +end ; ; Apple II routines. ; @@ -76,21 +141,19 @@ def a2gotoxy(x, y) ^$24 = x + ^$20 return call($FB5B, y + ^$22, 0, 0, 0) end -def a2grmixmode +def a2grmode(mix) call($FB2F, 0, 0, 0, 0) ;initmode() call($FB40, 0, 0, 0, 0) ;grmode() - return call($FC58, 0, 0, 0, 0) ;home() + if !mix + ^showfull + fin + call($FC58, 0, 0, 0, 0) ;home() + return grscrn(@txt1scrn) ; point to lo-res screen end def a2textmode call($FB39, 0, 0, 0, 0) ;textmode() return call($FC58, 0, 0, 0, 0) ;home() end -def a2grcolor(color) - return call($F864, color, 0, 0, 0) -end -def a2grplot(x, y) - return call($F800, y, 0, x, 0) -end ; ; Apple III routines. ; @@ -138,33 +201,27 @@ def a3viewport(left, top, width, height) putc(3) return a3gotoxy(0, 0) end -def a3grmixmode +def a3grmode(mix) byte i + if mix + mix = 19 + else + mix = 23 + fin puts(@textclrmode) dev_control(devcons, 17, @grcharset) - for i = 0 to 19 - memset(txtscrn[i], 40, $0000) - memset(clrscrn[i], 40, $0000) + a3viewport(0, 20, 40, 4) + for i = 0 to mix + memset(txt1scrn[i], 40, $0000) ; text screen + memset(txt2scrn[i], 40, $0000) ; color screen next - return a3viewport(0, 20, 40, 4) + return grscrn(@txt2scrn) ; point to color screen end def a3textmode puts(@textbwmode) a3viewport(0, 0, 40, 24) return putc(28) end -def a3grcolor(color) - grfullcolor = (color & $0F) | (color << 4) -end -def a3grplot(x, y) - word blockaddr - blockaddr = clrscrn[y >> 1] + x - if y & 1 - ^blockaddr = (^blockaddr & $0F) | (grfullcolor & $F0) - else - ^blockaddr = (^blockaddr & $F0) | (grfullcolor & $0F) - fin -end ; ; Rod's Colors. ; @@ -205,10 +262,8 @@ when MACHID & $C8 is $C0 ; Apple /// keypressed = @a3keypressed gotoxy = @a3gotoxy - grmixmode = @a3grmixmode + grmode = @a3grmode textmode = @a3textmode - grcolor = @a3grcolor - grplot = @a3grplot if modaddr(@stdlib):0 == $0010 devcons = modaddr(@stdlib).5 ; devcons variable from STDLIB else @@ -217,7 +272,7 @@ when MACHID & $C8 fin otherwise ; Apple ][ wend -grmixmode() +grmode(MIXMODE) gotoxy(11, 1) puts(@exitmsg) rod diff --git a/src/vmsrc/plvm01.s b/src/vmsrc/plvm01.s index a412f5b..5bace08 100644 --- a/src/vmsrc/plvm01.s +++ b/src/vmsrc/plvm01.s @@ -923,7 +923,7 @@ LEAVE LDY #$01 RET RTS A1CMD !SOURCE "vmsrc/a1cmd.a" SEGEND = * -VMINIT LDY #$0E ; INSTALL PAGE 0 FETCHOP ROUTINE +VMINIT LDY #$0F ; INSTALL PAGE 0 FETCHOP ROUTINE - LDA PAGE0,Y STA DROP,Y DEY @@ -946,7 +946,7 @@ PAGE0 = * INX ; DROP INY ; NEXTOP BEQ NEXTOPH -FETCHOP LDA (IP),Y + LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4 STA OPIDX JMP (OPTBL) NEXTOPH INC IPH diff --git a/src/vmsrc/plvm02.s b/src/vmsrc/plvm02.s index 79fbc5f..541eb19 100644 --- a/src/vmsrc/plvm02.s +++ b/src/vmsrc/plvm02.s @@ -247,7 +247,7 @@ CMDEXEC = * ; ; INSTALL PAGE 0 FETCHOP ROUTINE ; - LDY #$0E + LDY #$0F - LDA PAGE0,Y STA DROP,Y DEY @@ -319,9 +319,9 @@ PAGE0 = * INX ; DROP @ $EF INY ; NEXTOP @ $F0 BEQ NEXTOPH -FETCHOP LDA (IP),Y + LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4 STA OPIDX - JMP (OPTBL) + JMP (OPTBL) ; OPIDX AND OPPAGE MAP OVER OPTBL NEXTOPH INC IPH BNE FETCHOP } diff --git a/src/vmsrc/plvm03.s b/src/vmsrc/plvm03.s index 6eadafe..e6099aa 100644 --- a/src/vmsrc/plvm03.s +++ b/src/vmsrc/plvm03.s @@ -50,7 +50,7 @@ DSTX = XPAGE+DSTH BNE PRHEX LDA #$01 STA MEMBANK - LDY #$0E ; INSTALL PAGE 0 FETCHOP ROUTINE + LDY #$0F ; INSTALL PAGE 0 FETCHOP ROUTINE LDA #$00 - LDX PAGE0,Y STX DROP,Y @@ -67,25 +67,6 @@ DSTX = XPAGE+DSTH STA IFPH LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX JMP SOSCMD -SEGREQ !BYTE 4 - !WORD $2001 - !WORD $9F01 - !BYTE $10 - !BYTE $00 -PAGE0 = * - !PSEUDOPC $00EF { -;* -;* INTERP BYTECODE INNER LOOP -;* - INX ; DROP - INY ; NEXTOP - BEQ NEXTOPH -FETCHOP LDA (IP),Y - STA OPIDX - JMP (OPTBL) -NEXTOPH INC IPH - BNE FETCHOP -} PRHEX PHA LSR LSR @@ -105,15 +86,34 @@ PRHEX PHA ADC #6 + STA $880 FAIL RTS +SEGREQ !BYTE 4 + !WORD $2001 + !WORD $9F01 + !BYTE $10 + !BYTE $00 +PAGE0 = * + !PSEUDOPC $00EF { +;* +;* INTERP BYTECODE INNER LOOP +;* + INX ; DROP + INY ; NEXTOP + BEQ NEXTOPH + LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4 + STA OPIDX + JMP (OPTBL) +NEXTOPH INC IPH + BNE FETCHOP +} ;* ;* SYSTEM INTERPRETER ENTRYPOINT ;* -INTERP LDY #$00 - STY IPX - PLA +INTERP PLA STA IPL PLA STA IPH + LDY #$00 + STY IPX INY JMP FETCHOP ;* diff --git a/src/vmsrc/plvmzp.inc b/src/vmsrc/plvmzp.inc index 9667f31..c7461fd 100644 --- a/src/vmsrc/plvmzp.inc +++ b/src/vmsrc/plvmzp.inc @@ -17,11 +17,12 @@ VMZP = ESTK+ESTKSZ IFP = VMZP IFPL = IFP IFPH = IFP+1 -IP = IFP+2 -IPL = IP -IPH = IP+1 -IPY = IP+2 -TMP = IP+3 +;IP = IFP+2 ; MOVED TO OVERLAY NEXTOP +;IPL = IP +;IPH = IP+1 +;IPY = IP+2 +IPY = IFP+2 +TMP = IPY+1 TMPL = TMP TMPH = TMP+1 NPARMS = TMPL @@ -30,5 +31,9 @@ DVSIGN = TMP+2 ESP = TMP+2 DROP = $EF NEXTOP = $F0 -OPIDX = NEXTOP+8 +FETCHOP = NEXTOP+3 +IP = FETCHOP+1 +IPL = IP +IPH = IPL+1 +OPIDX = FETCHOP+6 OPPAGE = OPIDX+1 diff --git a/src/vmsrc/soscmd.pla b/src/vmsrc/soscmd.pla index 378ca4f..6e57889 100644 --- a/src/vmsrc/soscmd.pla +++ b/src/vmsrc/soscmd.pla @@ -733,6 +733,17 @@ def seg_release(segnum) perr = syscall($45, @params) return perr end +; +; Other SOS calls. +; +def quit + byte params[1] + + close(0) + params.0 = 0 + perr = syscall($65, @params) +end + ; ; CONSOLE I/O ; @@ -839,7 +850,6 @@ def addsym(sym, addr) xpokeb(symtbl.0, lastsym + 2, addr.1) xpokeb(symtbl.0, lastsym + 3, 0) lastsym = lastsym + 3 -; return addtbl(sym, addr, symtbl.0, @lastsym) end ; ; Module routines. @@ -1263,15 +1273,16 @@ while 1 if ^cmdptr when toupper(parsecmd(cmdptr)) is 'Q' - ; reboot() + quit is 'C' catalog(cmdptr) is 'P' setpfx(cmdptr) is 'V' - volumes() + volumes is '+' execmod(cmdptr) + write(refcons, @textmode, 3) otherwise prstr(@huhstr) wend