From 236854afe30b15e8d20d2c13453ec5f2aae82ef5 Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Tue, 3 Jun 2014 14:34:35 -0700 Subject: [PATCH] Add Apple 1 PLASMA and cleanup Apple /// PLASMA --- src/a1cmd.pla | 1082 ++++++++++++++++++++++++++++++++++++++++++++++++ src/makefile | 9 +- src/plvm01.s | 971 +++++++++++++++++++++++++++++++++++++++++++ src/plvm02.s | 4 +- src/plvm03.s | 10 +- src/soscmd.pla | 74 ++-- 6 files changed, 2100 insertions(+), 50 deletions(-) create mode 100644 src/a1cmd.pla create mode 100644 src/plvm01.s diff --git a/src/a1cmd.pla b/src/a1cmd.pla new file mode 100644 index 0000000..1fcbfea --- /dev/null +++ b/src/a1cmd.pla @@ -0,0 +1,1082 @@ +const MODADDR = $1000 +; +; ROMCALL return register structure. +; +const acc = 0 +const xreg = 1 +const yreg = 2 +const preg = 3 +; +; SOS flags +; +const O_READ = 1 +const O_WRITE = 2 +const O_READ_WRITE = 3 +; +; Pedefined functions. +; +predef home, gotoxy, viewport, crout, cout, prstr, cin, rdstr +predef syscall +predef markheap, allocheap, allocalignheap, releaseheap, availheap +predef memset, memcpy, xmemcpy +predef uword_isgt, uword_isge, uword_islt, uword_isle +predef execmod +; +; Standard Library exported functions. +; +byte stdlibstr[] = "STDLIB" +byte clsstr[] = "CLS" +byte gotoxystr[] = "GOTOXY" +byte viewstr[] = "VIEWPORT" +byte putcstr[] = "PUTC" +byte putsstr[] = "PUTS" +byte getcstr[] = "GETC" +byte getsstr[] = "GETS" +byte sysstr[] = "SYSCALL" +byte hpmarkstr[] = "HEAPMARK" +byte hpalignstr[] = "HEAPALLOCALIGN" +byte hpallocstr[] = "HEAPALLOC" +byte hprelstr[] = "HEAPRELEASE" +byte hpavailstr[] = "HEAPAVAIL" +byte memsetstr[] = "MEMSET" +byte memcpystr[] = "MEMCPY" +byte uisgtstr[] = "ISUGT" +byte uisgestr[] = "ISUGE" +byte uisltstr[] = "ISULT" +byte uislestr[] = "ISULE" +byte execstr[] = "EXEC" +word exports[] = @clsstr, @home +word = @gotoxystr, @gotoxy +word = @viewstr, @viewport +word = @putcstr, @cout +word = @putsstr, @prstr +word = @getcstr, @cin +word = @getsstr, @rdstr +word = @sysstr, @syscall +word = @hpmarkstr, @markheap +word = @hpallocstr,@allocheap +word = @hpalignstr,@allocalignheap +word = @hprelstr, @releaseheap +word = @memsetstr, @memset +word = @memcpystr, @memcpy +word = @uisgtstr, @uword_isgt +word = @uisgestr, @uword_isge +word = @uisltstr, @uword_islt +word = @uislestr, @uword_isle +word = @execstr, @execmod +word = 0 +word stdlibsym = @exports +; +; String pool. +; +byte console[] = ".CONSOLE" +byte version[] = "PLASMA 0.9\n" +byte freestr[] = "MEM FREE:$" +byte errorstr[] = "ERR:$" +byte okstr[] = "OK" +byte huhstr[] = "?\n" +byte prefix[128] = "" +byte hexchar[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F' +; +; System variable. +; +word systemflags = 0 +word heap +word symtbl, lastsym +word perr +word cmdptr +; +; CALL SOS +; SYSCALL(CMD, PARAMS) +; +asm syscall + RTS +end +; +; SET MEMORY TO VALUE +; MEMSET(ADDR, SIZE, VALUE) +; +asm memset + LDY #$00 + LDA ESTKL+2,X + STA DSTL + LDA ESTKH+2,X + STA DSTH + INC ESTKL+1,X + INC ESTKH+1,X +SETMLP DEC ESTKL+1,X + BNE + + DEC ESTKH+1,X + BEQ SETMEX ++ LDA ESTKL,X + STA (DST),Y + INY + BNE + + INC DSTH ++ DEC ESTKL+1,X + BNE + + DEC ESTKH+1,X + BEQ SETMEX ++ LDA ESTKH,X + STA (DST),Y + INY + BNE SETMLP + INC DSTH + BNE SETMLP +SETMEX INX + INX + RTS +end +; +; COPY MEMORY +; MEMCPY(DSTADDR, SRCADDR, SIZE) +; +asm memcpy + LDY #$00 + LDA ESTKL,X + BNE + + LDA ESTKH,X + BEQ CPYMEX ++ LDA ESTKL+2,X + STA DSTL + LDA ESTKH+2,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + CMP DSTH + BCC REVCPY + BNE FORCPY + LDA SRCL + CMP DSTL + BCS FORCPY +REVCPY ; REVERSE DIRECTION COPY +; CLC + LDA ESTKL,X + ADC DSTL + STA DSTL + LDA ESTKH,X + ADC DSTH + STA DSTH + CLC + LDA ESTKL,X + ADC SRCL + STA SRCL + LDA ESTKH,X + ADC SRCH + STA SRCH + INC ESTKH,X +REVCPYLP + LDA DSTL + BNE + + DEC DSTH ++ DEC DSTL + LDA SRCL + BNE + + DEC SRCH ++ DEC SRCL + LDA (SRC),Y + STA (DST),Y + DEC ESTKL,X + BNE REVCPYLP + DEC ESTKH,X + BNE REVCPYLP + BEQ CPYMEX +FORCPY INC ESTKH,X +FORCPYLP + LDA (SRC),Y + STA (DST),Y + INC DSTL + BNE + + INC DSTH ++ INC SRCL + BNE + + INC SRCH ++ DEC ESTKL,X + BNE FORCPYLP + DEC ESTKH,X + BNE FORCPYLP +CPYMEX INX + INX + RTS +end +; +; COPY FROM MAIN MEM TO EXT MEM. +; +; MEMXCPY(DIR, EXT, DST, SRC, SIZE) +; DIR = 0 : COPY FROM MAIN TO EXT +; DIR = 1 : COPY FROM EXT TO MAIN +; +asm memxcpy + RTS +end +; +; Unsigned word comparisons. +; +asm uword_isge + LDY #$00 + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X ++ BCC + + DEY ++ STY ESTKL+1,X + STY ESTKH+1,X + INX + RTS +end +asm uword_isle + LDY #$00 + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X ++ BCC + + DEY ++ STY ESTKL+1,X + STY ESTKH+1,X + INX + RTS +end +asm uword_isgt + LDY #$FF + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X ++ BCC + + INY ++ STY ESTKL+1,X + STY ESTKH+1,X + INX + RTS +end +asm uword_islt + LDY #$FF + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X ++ BCC + + INY ++ STY ESTKL+1,X + STY ESTKH+1,X + INX + RTS +end +; +; Addresses of internal routines. +; +asm interp + DEX + LDA #IINTERP + STA ESTKH,X + RTS +end +; +; A DCI string is one that has the high bit set for every character except the last. +; More efficient than C or Pascal strings. +; +;def dcitos(dci, str) +; byte len, c +; len = 0 +; repeat +; c = (dci).[len] +; len = len + 1 +; (str).[len] = c & $7F +; until !(c & $80) +; ^str = len +; return len +;end +asm dcitos + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + LDY #$00 +- LDA (SRC),Y + INY + PHA + AND #$7F + STA (DST),Y + PLA + BMI - + TYA + LDY #$00 + STA (DST),Y + INX + STA ESTKL,X + STY ESTKH,X + RTS +end +;def stodci(str, dci) +; byte len, c +; len = ^str +; if len == 0 +; return +; fin +; c = toupper((str).[len]) & $7F +; len = len - 1 +; (dci).[len] = c +; while len +; c = toupper((str).[len]) | $80 +; len = len - 1 +; (dci).[len] = c +; loop +; return ^str +;end +asm stodci + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + INX + LDY #$00 + LDA (SRC),Y + BEQ ++ + TAY + LDA (SRC),Y + JSR TOUPR + BNE + +- LDA (SRC),Y + JSR TOUPR + ORA #$80 ++ DEY + STA (DST),Y + BNE - + LDA (SRC),Y +++ STA ESTKL,X + STY ESTKH,X + RTS +end +asm toupper + LDA ESTKL,X +TOUPR AND #$7F + CMP #'a' + BCC + + CMP #'z'+1 + BCS + + SEC + SBC #$20 ++ STA ESTKL,X + RTS +end +; +; Module symbols are entered into the symbol table +; pre-pended with a '#' to differentiate them +; from normal symbols. +; +;def modtosym(mod, dci) +; byte len, c +; (dci).0 = '#'|$80 +; len = 0 +; repeat +; c = (mod).[len] +; len = len + 1 +; (dci).[len] = c +; until !(c & $80) +; return dci +;end +asm modtosym + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + LDA ESTKL,X + STA ESTKL+1,X + STA DSTL + LDA ESTKH,X + STA ESTKH+1,X + STA DSTH + INX + LDY #$00 + LDA #'#'+$80 + STA (DST),Y +- LDA (SRC),Y + INY + STA (DST),Y + AND #$80 + BMI - + RTS +end +; +; Lookup routines. +; +;def lookuptbl(dci, tbl) +; word match +; while ^tbl +; match = dci +; while ^tbl == ^match +; if !(^tbl & $80) +; return (tbl):1 +; fin +; tbl = tbl + 1 +; match = match + 1 +; loop +; while (^tbl & $80) +; tbl = tbl + 1 +; loop +; tbl = tbl + 3 +; loop +; return 0 +asm lookuptbl + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + LDY #$00 +- LDA (DST),Y + BEQ + + CMP (SRC),Y + BNE ++ + INY + AND #$80 + BMI - + LDA (DST),Y + PHA + INY + LDA (DST),Y + TAY + PLA ++ INX + STA ESTKL,X + STY ESTKH,X + RTS +++ LDY #$00 +-- LDA (DST),Y + INC DSTL + BNE ++ + INC DSTH +++ AND #$80 + BMI -- + LDA #$02 + CLC + ADC DSTL + STA DSTL + TYA + ADC DSTH + STA DSTH + BNE - +end +; +; CONSOLE I/O +; +def cout(ch) + if ch == $0D + ch = $0A0D + else + fin +end +def cin + byte ch + return ch +end +def prstr(str) + if (str).[^str] == $0D + cout($0A) + fin +end +def rdstr(prompt) + cout(prompt) + if (heap).[^heap] == $0D + ^heap = ^heap - 1 + fin + cout($0D) + return heap +end +def home + return cout(28) +end +def gotoxy(x, y) +end +def viewport(left, top, width, height) +end +def crout + return cout($0D) +end +def prbyte(v) + cout(hexchar[(v >> 4) & $0F]) + return cout(hexchar[v & $0F]) +end +def prword(v) + prbyte(v >> 8) + return prbyte(v) +end +; +; CFFA1 routines +; FILE I/O +; +def getpfx(path) + byte params[4] + + ^path = 0 + params.0 = 2 + params:1 = path + params.3 = 128 + perr = syscall($C7, @params) + return path +end +def setpfx(path) + byte params[3] + + params.0 = 1 + params:1 = path + perr = syscall($C6, @params) + return path +end +def volume(devname, volname, ttlblks, freblks) + byte params[9] + + params.0 = 4 + params:1 = devname + params:3 = volname + params:5 = 0 + params:7 = 0 + perr = syscall($C5, @params) + *ttlblks = params:5 + *freblks = params:7 + return perr +end +def open(path, access) + byte params[7] + + params.0 = 4 + params:1 = path + params.3 = 0 + params:4 = @access + params.6 = 1 + perr = syscall($C8, @params) + return params.3 +end +def close(refnum) + byte params[2] + + params.0 = 1 + params.1 = refnum + perr = syscall($CC, @params) + return perr +end +def newline(refnum, set, char) + byte params[4] + + params.0 = 1 + params.1 = refnum + params.2 = set + params.3 = char + perr = syscall($C9, @params) + return perr +end +def read(refnum, buff, len) + byte params[8] + + params.0 = 4 + params.1 = refnum + params:2 = buff + params:4 = len + params:6 = 0 + perr = syscall($CA, @params) + return params:6 +end +def write(refnum, buff, len) + byte params[6] + + params.0 = 3 + params.1 = refnum + params:2 = buff + params:4 = len + perr = syscall($CB, @params) + return perr +end +; +; Heap routines. +; +def availheap + byte fp + return @fp - heap +end +def allocheap(size) + word addr + addr = heap + heap = heap + size + if uword_isge(heap, @addr) + return 0 + fin + return addr +end +def allocalignheap(size, pow2, freeaddr) + word align, addr + if freeaddr + *freeaddr = heap + fin + align = (1 << pow2) - 1 + addr = (heap | align) + 1 + heap = addr + size + if uword_isge(heap, @addr) + return 0 + fin + return addr +end +def markheap + return heap; +end +def releaseheap(newheap) + heap = newheap; + return @newheap - heap; +end +; +; DCI table routines, +; +;def dumptbl(tbl) +; byte len +; +; while ^tbl +; len = 0 +; while ^tbl & $80 +; cout(^tbl) +; tbl = tbl + 1 +; len = len + 1 +; loop +; cout(^tbl) +; tbl = tbl + 1 +; cout(':') +; while len < 15 +; cout(' ') +; len = len + 1 +; loop +; cout('$') +; prword(*tbl) +; crout +; tbl = tbl + 2 +; loop +;end +def addtbl(dci, val, last) + while ^dci & $80 + ^*last = ^dci + *last = *last + 1 + dci = dci + 1 + loop + ^*last = ^dci + *last = *last + 1 + **last = val + *last = *last + 2 + ^*last = 0 +end +; +; Symbol table routines. +; +def lookupsym(sym) + return lookuptbl(sym, symtbl) +end +def addsym(sym, addr) + return addtbl(sym, addr, @lastsym); +end +; +; Module routines. +; +def lookupmod(mod) + byte dci[17] + return lookuptbl(modtosym(mod, @dci), symtbl) +end +def addmod(mod, addr) + byte dci[17] + return addtbl(modtosym(mod, @dci), addr, @lastsym) +end +def lookupextern(esd, index) + word sym + byte str[16] + while ^esd + sym = esd + esd = esd + dcitos(esd, @str) + if (esd).0 & $10 and (esd).1 == index + return lookupsym(sym) + fin + esd = esd + 3 + loop + prbyte(index) + cout('?') + crout + return 0 +end +def adddef(addr, deflast) + word defentry + defentry = *deflast + *deflast = defentry + 5 + (defentry).0 = $20 + (defentry):1 = interp + (defentry):3 = addr + (defentry).4 = 0 ; null out next entry + return defentry +end +def lookupdef(addr, deftbl) + while (deftbl).0 == $20 + if (deftbl):3 == addr + ;prword(addr) + ;cout('>') + ;prword(deftbl) + ;crout + return deftbl + fin + deftbl = deftbl + 5 + loop + return 0 +end +def loadmod(mod) + word refnum, rdlen, modsize, bytecode, defofst, defcnt, init, fixup + word addr, modaddr, modfix, modend + word deftbl, deflast + word moddep, rld, esd, sym + byte str[16], filename[32] + byte header[128] + ; + ; Read the RELocatable module header (first 128 bytes) + ; + dcitos(mod, @filename) + refnum = open(@filename, O_READ) + if refnum > 0 + rdlen = read(refnum, @header, 128) + modsize = header:0 + moddep = @header.1 + defofst = modsize + init = 0 + if rdlen > 4 and header:2 == $DA7E ; DAVE = magic number :-) + ; + ; This is an EXTended RELocatable (data+bytecode) module. + ; + systemflags = header:4 | systemflags + defofst = header:6 + defcnt = header:8 + init = header:10 + moddep = @header.12 + ; + ; Load module dependencies. + ; + while ^moddep + if !lookupmod(moddep) + if refnum + close(refnum) + refnum = 0 + fin + if loadmod(moddep) < 0 + return perr + fin + fin + moddep = moddep + dcitos(moddep, @str) + loop + ; + ; Init def table. + ; + deftbl = allocheap(defcnt * 5 + 1) + deflast = deftbl + ^deflast = 0 + if !refnum + ; + ; Reset read pointer. + ; + refnum = open(@filename) + rdlen = read(refnum, @header, 128) + fin + fin + ; + ; Alloc heap space for relocated module (data + bytecode). + ; + moddep = moddep + 1 + modfix = moddep - @header.2 ; Adjust to skip header + modsize = modsize - modfix + rdlen = rdlen - modfix - 2 + modaddr = allocheap(modsize) + memcpy(modaddr, moddep, rdlen) + ; + ; Read in remainder of module into memory for fixups. + ; + addr = modaddr; + repeat + addr = addr + rdlen + rdlen = read(refnum, addr, 4096) + until rdlen <= 0 + close(refnum) + ; + ; Apply all fixups and symbol import/export. + ; + modfix = modaddr - modfix + bytecode = defofst + modfix - MODADDR + modend = modaddr + modsize + rld = modend ; Re-Locatable Directory + esd = rld ; Extern+Entry Symbol Directory + while ^esd ; Scan to end of ESD + esd = esd + 4 + loop + esd = esd + 1 + ; + ; Run through the Re-Location Dictionary. + ; + while ^rld + if ^rld == $02 + ; + ; This is a bytcode def entry - add it to the def directory. + ; + adddef((rld):1 - defofst + bytecode, @deflast) + else + addr = (rld):1 + modfix + if uword_isge(addr, modaddr) ; Skip fixups to header + ;if uword_isge(addr, modend) + ; cout('<') + ; prword((rld):1) + ; cout('>') + ; prword(rld) + ; crout + ;fin + if ^rld & $80 ; WORD sized fixup. + fixup = *addr + else ; BYTE sized fixup. + fixup = ^addr + fin + if ^rld & $10 ; EXTERN reference. + fixup = fixup + lookupextern(esd, (rld).3) + else ; INTERN fixup. + fixup = fixup + modfix - MODADDR + if uword_isge(fixup, bytecode) + ; + ; Bytecode address - replace with call def directory. + ; + fixup = lookupdef(fixup - bytecode + bytecode, deftbl) + fin + fin + if ^rld & $80 ; WORD sized fixup. + *addr = fixup + else ; BYTE sized fixup. + ^addr = fixup + fin + fin + fin + rld = rld + 4 + loop + ; + ; Run through the External/Entry Symbol Directory. + ; + while ^esd + sym = esd + esd = esd + dcitos(esd, @str) + if ^esd & $08 + ; + ; EXPORT symbol - add it to the global symbol table. + ; + addr = (esd):1 + modfix - MODADDR + if uword_isge(addr, bytecode) + ; + ; Use the def directory address for bytecode. + ; + addr = lookupdef(addr - bytecode + bytecode, deftbl) + fin + addsym(sym, addr) + fin + esd = esd + 3 + loop + ; + ; Free up end-of-module main memory. + ; + releaseheap(modend) + else + perr = perr | 0x100 + return -perr + fin + ; + ; Call init routine if it exists. + ; + if init + return adddef(init - defofst + bytecode, @deflast)() + fin + return 0 +end +; +; Command mode +; +def volumes +end +def catalog(optpath) + byte path[64] + byte refnum + byte firstblk + byte entrylen, entriesblk + byte i, type, len + word entry, filecnt + + if ^optpath + memcpy(@path, optpath, ^optpath + 1) + else + getpfx(@path) + prstr(@path) + crout() + fin + refnum = open(@path, O_READ) + if perr + return perr + fin + firstblk = 1 + repeat + if read(refnum, heap, 512) == 512 + entry = heap + 4 + if firstblk + entrylen = (heap).$23 + entriesblk = (heap).$24 + filecnt = (heap):$25 + entry = entry + entrylen + fin + for i = firstblk to entriesblk + type = ^entry + if type <> 0 + len = type & $0F + ^entry = len + prstr(entry) + if type & $F0 == $D0 ; Is it a directory? + cout('/') + len = len + 1 + elsif (entry).$10 == $FF + cout('-') + len = len + 1 + elsif (entry).$10 == $FE + cout('+') + len = len + 1 + fin + for len = 19 - len downto 0 + cout(' ') + next + filecnt = filecnt - 1 + fin + entry = entry + entrylen + next + firstblk = 0 + else + filecnt = 0 + fin + until filecnt == 0 + close(refnum) + crout() + return 0 +end +def stripchars(strptr) + while ^strptr and ^(strptr + 1) <> ' ' + memcpy(strptr + 1, strptr + 2, ^strptr) + ^strptr = ^strptr - 1 + loop + return ^strptr +end +def stripspaces(strptr) + while ^strptr and ^(strptr + ^strptr) <= ' ' + ^strptr = ^strptr - 1 + loop + while ^strptr and ^(strptr + 1) <= ' ' + memcpy(strptr + 1, strptr + 2, ^strptr) + ^strptr = ^strptr - 1 + loop +end +def striptrail(strptr) + byte i + + for i = 1 to ^strptr + if (strptr)[i] == ' ' + ^strptr = i - 1 + return + fin + next +end +def parsecmd(strptr) + byte cmd + + cmd = 0 + stripspaces(strptr) + if ^strptr + cmd = ^(strptr + 1) + memcpy(strptr + 1, strptr + 2, ^strptr) + ^strptr = ^strptr - 1 + fin + stripspaces(strptr) + return cmd +end +def execmod(modfile) + byte moddci[17] + word saveheap, savesym, saveflags + + if stodci(modfile, @moddci) + saveheap = heap + savesym = lastsym + saveflags = systemflags + ^lastsym = 0 + perr = loadmod(@moddci) + systemflags = saveflags + lastsym = savesym + heap = saveheap + fin +end + +; +; Get heap start +; +heap = *$0006 +; +; Print some startup info. +; +prstr(@version) +prstr(@freestr) +prword(availheap) +crout +; +; Init symbol table. +; +symtbl = allocheap($200) +lastsym = symtbl +^lastsym = 0 +stodci(@stdlibstr, heap) +addmod(heap, 1) +while *stdlibsym + stodci((stdlibsym):0, heap) + addsym(heap, (stdlibsym):2) + stdlibsym = stdlibsym + 4 +loop +; +; Handle commands. +; +while 1 + prstr(getpfx(@prefix)) + cmdptr = rdstr($BA) + if ^cmdptr + when toupper(parsecmd(cmdptr)) + is 'Q' + ; reboot() + is 'C' + catalog(cmdptr) + is 'P' + setpfx(cmdptr) + is 'V' + volumes() + is '+' + execmod(cmdptr) + otherwise + prstr(@huhstr) + wend + if perr + prstr(@errorstr) + prbyte(perr) + perr = 0 + else + prstr(@okstr) + fin + crout() + fin +loop +done diff --git a/src/makefile b/src/makefile index b204b4f..83b61ef 100755 --- a/src/makefile +++ b/src/makefile @@ -2,6 +2,7 @@ AFLAGS = -o $@ LFLAGS = -C default.cfg PLVM = plvm +PLVM01 = A1PLASMA\#060280 PLVM02 = PLASMA.SYSTEM\#FF2000 PLVM03 = SOS.INTERP\#050000 CMD = CMD\#FF2000 @@ -25,7 +26,7 @@ TXTTYPE = .TXT #SYSTYPE = \#ff2000 #TXTTYPE = \#040000 -all: $(PLASM) $(PLVM) $(PLVM02) $(PLVM03) $(CMD) $(ROD) $(HGR1) +all: $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM03) $(CMD) $(ROD) $(HGR1) clean: -rm *.o *~ *.a *.SYM $(CMD) *\#FE1000 $(ROD) $(HGR1) $(PLASM) $(PLVM) @@ -36,6 +37,12 @@ $(PLASM): $(OBJS) $(INCS) $(PLVM): plvm.c cc plvm.c -o $(PLVM) +a1cmd.a: a1cmd.pla $(PLASM) + ./$(PLASM) -A < a1cmd.pla > a1cmd.a + +$(PLVM01): plvm01.s a1cmd.a + acme -o $(PLVM01) -l PLVM01.SYM plvm01.s + cmdexec.a: cmdexec.pla $(PLASM) ./$(PLASM) -A < cmdexec.pla > cmdexec.a diff --git a/src/plvm01.s b/src/plvm01.s new file mode 100644 index 0000000..eadab61 --- /dev/null +++ b/src/plvm01.s @@ -0,0 +1,971 @@ +;********************************************************** +;* +;* APPLE1+CFFA1 PLASMA INTERPETER +;* +;* SYSTEM ROUTINES AND LOCATIONS +;* +;********************************************************** +; +; HARDWARE REGISTERS +; +;* +;* VM ZERO PAGE LOCATIONS +;* +ESTKSZ = $20 +ESTK = $C0 +ESTKL = ESTK +ESTKH = ESTK+ESTKSZ/2 +VMZP = ESTK+ESTKSZ +IFP = VMZP +IFPL = IFP +IFPH = IFP+1 +IP = IFP+2 +IPL = IP +IPH = IP+1 +IPY = IP+2 +TMP = IP+3 +TMPL = TMP +TMPH = TMP+1 +NPARMS = TMPL +FRMSZ = TMPH +DVSIGN = TMP+2 +ESP = TMP+2 +SRC = $06 +SRCL = SRC +SRCH = SRC+1 +DST = SRC+2 +DSTL = DST +DSTH = DST+1 +;* +;* INTERPRETER INSTRUCTION POINTER INCREMENT MACRO +;* + !MACRO INC_IP { + INY + BNE *+4 + INC IPH + } +;* +;* INTERPRETER HEADER+INITIALIZATION +;* + *= $0280 +SEGBEGIN LDA #$00 ; INIT FRAME POINTER + STA IFPL + LDA #$80 + STA IFPH + LDA #SEGEND + STA SRCH + LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX + !SOURCE "a1cmd.a" +;* +;* SYSTEM INTERPRETER ENTRYPOINT +;* +INTERP PLA + STA IPL + PLA + STA IPH + LDY #$01 + BNE FETCHOP +;* +;* ENTER INTO USER BYTECODE INTERPRETER +;* +IINTERP PLA + STA TMPL + PLA + STA TMPH + LDY #$02 + LDA (TMP),Y + STA IPH + DEY + LDA (TMP),Y + STA IPL + DEY + BEQ FETCHOP +;* +;* INTERP BYTECODE +;* +NEXTOPH INC IPH + BNE FETCHOP +DROP INX +NEXTOP INY + BEQ NEXTOPH +FETCHOP LDA (IP),Y + STA *+4 + JMP (OPTBL) +;* +;* INTERNAL DIVIDE ALGORITHM +;* +_NEG LDA #$00 + SEC + SBC ESTKL,X + STA ESTKL,X + LDA #$00 + SBC ESTKH,X + STA ESTKH,X + RTS +_DIV STY IPY + LDA ESTKH,X + AND #$80 + STA DVSIGN + BPL _DIV1 + JSR _NEG + INC DVSIGN +_DIV1 LDA ESTKH+1,X + BPL _DIV2 + INX + JSR _NEG + DEX + INC DVSIGN + BNE _DIV3 +_DIV2 ORA ESTKL+1,X ; DVDNDL + BNE _DIV3 + STA TMPL + STA TMPH + RTS +_DIV3 LDY #$11 ; #BITS+1 + LDA #$00 + STA TMPL ; REMNDRL + STA TMPH ; REMNDRH +_DIV4 ASL ESTKL+1,X ; DVDNDL + ROL ESTKH+1,X ; DVDNDH + DEY + BCC _DIV4 + STY ESTKL-1,X +_DIV5 ROL TMPL ; REMNDRL + ROL TMPH ; REMNDRH + LDA TMPL ; REMNDRL + SEC + SBC ESTKL,X ; DVSRL + TAY + LDA TMPH ; REMNDRH + SBC ESTKH,X ; DVSRH + BCC _DIV6 + STA TMPH ; REMNDRH + STY TMPL ; REMNDRL +_DIV6 ROL ESTKL+1,X ; DVDNDL + ROL ESTKH+1,X ; DVDNDH + DEC ESTKL-1,X + BNE _DIV5 + LDY IPY + RTS +;* +;* OPCODE TABLE +;* + !ALIGN 255,0 +OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E + !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E + !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,SWAP ; 20 22 24 26 28 2A 2C 2E + !WORD DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E + !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E + !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 50 52 54 56 58 5A 5C 5E + !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E + !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E +;* +;* MUL TOS-1 BY TOS +;* +MUL STY IPY + LDY #$00 + STY TMPL ; PRODL + STY TMPH ; PRODH + LDY #$10 +MUL1 LSR ESTKH,X ; MULTPLRH + ROR ESTKL,X ; MULTPLRL + BCC MUL2 + LDA ESTKL+1,X ; MULTPLNDL + CLC + ADC TMPL ; PRODL + STA TMPL + LDA ESTKH+1,X ; MULTPLNDH + ADC TMPH ; PRODH + STA TMPH +MUL2 ASL ESTKL+1,X ; MULTPLNDL + ROL ESTKH+1,X ; MULTPLNDH + DEY + BNE MUL1 + INX + LDA TMPL ; PRODL + STA ESTKL,X + LDA TMPH ; PRODH + STA ESTKH,X + LDY IPY + JMP NEXTOP +;* +;* NEGATE TOS +;* +NEG LDA #$00 + SEC + SBC ESTKL,X + STA ESTKL,X + LDA #$00 + SBC ESTKH,X + STA ESTKH,X + JMP NEXTOP +;* +;* DIV TOS-1 BY TOS +;* +DIV JSR _DIV + INX + LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1 + BCS NEG + JMP NEXTOP +;* +;* MOD TOS-1 BY TOS +;* +MOD JSR _DIV + INX + LDA TMPL ; REMNDRL + STA ESTKL,X + LDA TMPH ; REMNDRH + STA ESTKH,X + LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND + BMI NEG + JMP NEXTOP +;* +;* ADD TOS TO TOS-1 +;* +ADD LDA ESTKL,X + CLC + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + INX + JMP NEXTOP +;* +;* SUB TOS FROM TOS-1 +;* +SUB LDA ESTKL+1,X + SEC + SBC ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + SBC ESTKH,X + STA ESTKH+1,X + INX + JMP NEXTOP +; +;* +;* SHIFT TOS-1 LEFT BY 1, ADD TO TOS-1 +;* +IDXW LDA ESTKL,X + ASL + ROL ESTKH,X + CLC + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + INX + JMP NEXTOP +;* +;* INCREMENT TOS +;* +INCR INC ESTKL,X + BNE INCR1 + INC ESTKH,X +INCR1 JMP NEXTOP +;* +;* DECREMENT TOS +;* +DECR LDA ESTKL,X + BNE DECR1 + DEC ESTKH,X +DECR1 DEC ESTKL,X + JMP NEXTOP +;* +;* BITWISE COMPLIMENT TOS +;* +COMP LDA #$FF + EOR ESTKL,X + STA ESTKL,X + LDA #$FF + EOR ESTKH,X + STA ESTKH,X + JMP NEXTOP +;* +;* BITWISE AND TOS TO TOS-1 +;* +BAND LDA ESTKL+1,X + AND ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + AND ESTKH,X + STA ESTKH+1,X + INX + JMP NEXTOP +;* +;* INCLUSIVE OR TOS TO TOS-1 +;* +IOR LDA ESTKL+1,X + ORA ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + ORA ESTKH,X + STA ESTKH+1,X + INX + JMP NEXTOP +;* +;* EXLUSIVE OR TOS TO TOS-1 +;* +XOR LDA ESTKL+1,X + EOR ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + EOR ESTKH,X + STA ESTKH+1,X + INX + JMP NEXTOP +;* +;* SHIFT TOS-1 LEFT BY TOS +;* +SHL STY IPY + LDA ESTKL,X + CMP #$08 + BCC SHL1 + LDY ESTKL+1,X + STY ESTKH+1,X + LDY #$00 + STY ESTKL+1,X + SBC #$08 +SHL1 TAY + BEQ SHL3 +SHL2 ASL ESTKL+1,X + ROL ESTKH+1,X + DEY + BNE SHL2 +SHL3 INX + LDY IPY + JMP NEXTOP +;* +;* SHIFT TOS-1 RIGHT BY TOS +;* +SHR STY IPY + LDA ESTKL,X + CMP #$08 + BCC SHR2 + LDY ESTKH+1,X + STY ESTKL+1,X + CPY #$80 + LDY #$00 + BCC SHR1 + DEY +SHR1 STY ESTKH+1,X + SEC + SBC #$08 +SHR2 TAY + BEQ SHR4 + LDA ESTKH+1,X +SHR3 CMP #$80 + ROR + ROR ESTKL+1,X + DEY + BNE SHR3 + STA ESTKH+1,X +SHR4 INX + LDY IPY + JMP NEXTOP +;* +;* LOGICAL NOT +;* +LNOT LDA ESTKL,X + ORA ESTKH,X + BEQ LNOT1 + LDA #$FF +LNOT1 EOR #$FF + STA ESTKL,X + STA ESTKH,X + JMP NEXTOP +;* +;* LOGICAL AND +;* +LAND LDA ESTKL,X + ORA ESTKH,X + BEQ LAND1 + LDA ESTKL+1,X + ORA ESTKH+1,X + BEQ LAND1 + LDA #$FF +LAND1 STA ESTKL+1,X + STA ESTKH+1,X + INX + JMP NEXTOP +;* +;* LOGICAL OR +;* +LOR LDA ESTKL,X + ORA ESTKH,X + ORA ESTKL+1,X + ORA ESTKH+1,X + BEQ LOR1 + LDA #$FF +LOR1 STA ESTKL+1,X + STA ESTKH+1,X + INX + JMP NEXTOP +;* +;* SWAP TOS WITH TOS-1 +;* +SWAP STY IPY + LDA ESTKL,X + LDY ESTKL+1,X + STA ESTKL+1,X + STY ESTKL,X + LDA ESTKH,X + LDY ESTKH+1,X + STA ESTKH+1,X + STY ESTKH,X + LDY IPY + JMP NEXTOP +;* +;* DUPLICATE TOS +;* +DUP DEX + LDA ESTKL+1,X + STA ESTKL,X + LDA ESTKH+1,X + STA ESTKH,X + JMP NEXTOP +;* +;* PUSH FROM EVAL STACK TO CALL STACK +;* +PUSH LDA ESTKL,X + PHA + LDA ESTKH,X + PHA + INX + JMP NEXTOP +;* +;* PULL FROM CALL STACK TO EVAL STACK +;* +PULL DEX + PLA + STA ESTKH,X + PLA + STA ESTKL,X + JMP NEXTOP +;* +;* CONSTANT +;* +ZERO DEX + LDA #$00 + STA ESTKL,X + STA ESTKH,X + JMP NEXTOP +CB DEX + +INC_IP + LDA (IP),Y + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +;* +;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP) +;* +LA = * +CW DEX + +INC_IP + LDA (IP),Y + STA ESTKL,X + +INC_IP + LDA (IP),Y + STA ESTKH,X + JMP NEXTOP +;* +;* LOAD VALUE FROM ADDRESS TAG +;* +LB LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + STY IPY + LDY #$00 + LDA (TMP),Y + STA ESTKL,X + STY ESTKH,X + LDY IPY + JMP NEXTOP +LW LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + STY IPY + LDY #$00 + LDA (TMP),Y + STA ESTKL,X + INY + LDA (TMP),Y + STA ESTKH,X + LDY IPY + JMP NEXTOP +;* +;* LOAD ADDRESS OF LOCAL FRAME OFFSET +;* +LLA +INC_IP + LDA (IP),Y + DEX + CLC + ADC IFPL + STA ESTKL,X + LDA #$00 + ADC IFPH + STA ESTKH,X + JMP NEXTOP +;* +;* LOAD VALUE FROM LOCAL FRAME OFFSET +;* +LLB +INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + LDA (IFP),Y + STA ESTKL,X + LDA #$00 + STA ESTKH,X + LDY IPY + JMP NEXTOP +LLW +INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + LDA (IFP),Y + STA ESTKL,X + INY + LDA (IFP),Y + STA ESTKH,X + LDY IPY + JMP NEXTOP +;* +;* LOAD VALUE FROM ABSOLUTE ADDRESS +;* +LAB +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA (TMP),Y + DEX + STA ESTKL,X + STY ESTKH,X + LDY IPY + JMP NEXTOP +LAW +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA (TMP),Y + DEX + STA ESTKL,X + INY + LDA (TMP),Y + STA ESTKH,X + LDY IPY + JMP NEXTOP +;* +;* STORE VALUE TO ADDRESS +;* +SB LDA ESTKL+1,X + STA TMPL + LDA ESTKH+1,X + STA TMPH + LDA ESTKL,X + STY IPY + LDY #$00 + STA (TMP),Y + INX + INX + LDY IPY + JMP NEXTOP +SW LDA ESTKL+1,X + STA TMPL + LDA ESTKH+1,X + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + INY + LDA ESTKH,X + STA (TMP),Y + INX + INX + LDY IPY + JMP NEXTOP +;* +;* STORE VALUE TO LOCAL FRAME OFFSET +;* +SLB +INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + INX + LDY IPY + JMP NEXTOP +SLW +INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + INY + LDA ESTKH,X + STA (IFP),Y + INX + LDY IPY + JMP NEXTOP +;* +;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK +;* +DLB +INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + LDY IPY + JMP NEXTOP +DLW +INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + INY + LDA ESTKH,X + STA (IFP),Y + LDY IPY + JMP NEXTOP +;* +;* STORE VALUE TO ABSOLUTE ADDRESS +;* +SAB +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + LDA ESTKL,X + STY IPY + LDY #$00 + STA (TMP),Y + INX + LDY IPY + JMP NEXTOP +SAW +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + INY + LDA ESTKH,X + STA (TMP),Y + INX + LDY IPY + JMP NEXTOP +;* +;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK +;* +DAB +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + LDY IPY + JMP NEXTOP +DAW +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + INY + LDA ESTKH,X + STA (TMP),Y + LDY IPY + JMP NEXTOP +;* +;* COMPARES +;* +ISEQ STY IPY + LDY #$00 + LDA ESTKL,X + CMP ESTKL+1,X + BNE ISEQ1 + LDA ESTKH,X + CMP ESTKH+1,X + BNE ISEQ1 + DEY +ISEQ1 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOP +ISNE STY IPY + LDY #$FF + LDA ESTKL,X + CMP ESTKL+1,X + BNE ISNE1 + LDA ESTKH,X + CMP ESTKH+1,X + BNE ISNE1 + INY +ISNE1 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOP +ISGE STY IPY + LDY #$00 + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVC ISGE1 + EOR #$80 +ISGE1 BMI ISGE2 + DEY +ISGE2 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOP +ISGT STY IPY + LDY #$00 + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVC ISGT1 + EOR #$80 +ISGT1 BPL ISGT2 + DEY +ISGT2 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOP +ISLE STY IPY + LDY #$00 + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVC ISLE1 + EOR #$80 +ISLE1 BMI ISLE2 + DEY +ISLE2 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOP +ISLT STY IPY + LDY #$00 + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVC ISLT1 + EOR #$80 +ISLT1 BPL ISLT2 + DEY +ISLT2 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOP +;* +;* BRANCHES +;* +BRTRU INX + LDA ESTKH-1,X + ORA ESTKL-1,X + BNE BRNCH +NOBRNCH +INC_IP + +INC_IP + JMP NEXTOP +BRFLS INX + LDA ESTKH-1,X + ORA ESTKL-1,X + BNE NOBRNCH +BRNCH LDA IPH + STA TMPH + LDA IPL + +INC_IP + CLC + ADC (IP),Y + STA TMPL + LDA TMPH + +INC_IP + ADC (IP),Y + STA IPH + LDA TMPL + STA IPL + DEY + DEY + JMP NEXTOP +BREQ INX + LDA ESTKL-1,X + CMP ESTKL,X + BNE NOBRNCH + LDA ESTKL-1,X + CMP ESTKL,X + BEQ BRNCH + BNE NOBRNCH +BRNE INX + LDA ESTKL-1,X + CMP ESTKL,X + BNE BRNCH + LDA ESTKL-1,X + CMP ESTKL,X + BEQ NOBRNCH + BNE BRNCH +BRGT INX + LDA ESTKL-1,X + CMP ESTKL,X + LDA ESTKH-1,X + SBC ESTKH,X + BMI BRNCH + BPL NOBRNCH +BRLT INX + LDA ESTKL,X + CMP ESTKL-1,X + LDA ESTKH,X + SBC ESTKH-1,X + BMI BRNCH + BPL NOBRNCH +IBRNCH LDA IPL + CLC + ADC ESTKL,X + STA IPL + LDA IPH + ADC ESTKH,X + STA IPH + INX + JMP NEXTOP +;* +;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE) +;* +CALL +INC_IP + LDA (IP),Y + STA CALLADR+1 + +INC_IP + LDA (IP),Y + STA CALLADR+2 + LDA IPH + PHA + LDA IPL + PHA + TYA + PHA +CALLADR JSR $FFFF + PLA + TAY + PLA + STA IPL + PLA + STA IPH + JMP NEXTOP +;* +;* INDIRECT CALL TO ADDRESS (NATIVE CODE) +;* +ICAL LDA ESTKL,X + STA ICALADR+1 + LDA ESTKH,X + STA ICALADR+2 + INX + LDA IPH + PHA + LDA IPL + PHA + TYA + PHA +ICALADR JSR $FFFF + PLA + TAY + PLA + STA IPL + PLA + STA IPH + JMP NEXTOP +;* +;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT +;* +ENTER +INC_IP + LDA (IP),Y + STA FRMSZ + +INC_IP + LDA (IP),Y + STA NPARMS + STY IPY + LDA IFPL + PHA + SEC + SBC FRMSZ + STA IFPL + LDA IFPH + PHA + SBC #$00 + STA IFPH + LDY #$01 + PLA + STA (IFP),Y + DEY + PLA + STA (IFP),Y + LDA NPARMS + BEQ ENTER5 + ASL + TAY + INY +ENTER4 LDA ESTKH,X + STA (IFP),Y + DEY + LDA ESTKL,X + STA (IFP),Y + DEY + INX + DEC NPARMS + BNE ENTER4 +ENTER5 LDY IPY + JMP NEXTOP +;* +;* LEAVE FUNCTION +;* +LEAVE LDY #$01 + LDA (IFP),Y + DEY + PHA + LDA (IFP),Y + STA IFPL + PLA + STA IFPH +RET RTS +SEGEND = * diff --git a/src/plvm02.s b/src/plvm02.s index 58ee6ca..f5afd54 100644 --- a/src/plvm02.s +++ b/src/plvm02.s @@ -1,6 +1,8 @@ ;********************************************************** ;* -;* SYSTEM ROUTINES AND LOCATIONS +;* APPLE ][ 64K/128K PLASMA INTERPETER +;* +;* SYSTEM ROUTINES AND LOCATIONS ;* ;********************************************************** ;* diff --git a/src/plvm03.s b/src/plvm03.s index 592b439..1e79175 100644 --- a/src/plvm03.s +++ b/src/plvm03.s @@ -1,6 +1,8 @@ ;********************************************************** ;* -;* SYSTEM ROUTINES AND LOCATIONS +;* APPLE /// PLASMA INTERPETER +;* +;* SYSTEM ROUTINES AND LOCATIONS ;* ;********************************************************** ; @@ -68,7 +70,7 @@ DSTX = XPAGE+DSTH !WORD SEGEND-SEGSTART +SOS $40, SEGREQ ; ALLOCATE SEG 1 AND MAP IT - BNE FAIL + BNE PRHEX LDA #$01 STA MEMBANK LDA #$00 ; CLEAR ALL EXTENDED POINTERS @@ -115,8 +117,7 @@ INTERP LDY #$00 STA IPL PLA STA IPH - INY ; MAP BANK $01 - STY MEMBANK + INY BNE FETCHOP ;* ;* ENTER INTO USER BYTECODE INTERPRETER @@ -134,7 +135,6 @@ XINTERP PLA DEY LDA (TMP),Y STA IPL - STY MEMBANK ; MAP BANK $01 DEY BEQ FETCHOP ;* diff --git a/src/soscmd.pla b/src/soscmd.pla index 3f8c53f..7170f98 100644 --- a/src/soscmd.pla +++ b/src/soscmd.pla @@ -902,9 +902,9 @@ def lookupdef(addr, deftbl) fin deftbl = deftbl + 6 loop - prword(addr) - cout('?') - crout + ;prword(addr) + ;cout('?') + ;crout return 0 end def loadmod(mod) @@ -920,7 +920,7 @@ def loadmod(mod) dcitos(mod, @filename) refnum = open(@filename, O_READ) if refnum > 0 - newline(refnum, 0, $0D) + ;newline(refnum, 0, $0D) rdlen = read(refnum, @header, 128) modsize = header:0 moddep = @header.1 @@ -940,12 +940,9 @@ def loadmod(mod) ; while ^moddep if !lookupmod(moddep) - ;close(refnum) - ;refnum = 0 if loadmod(moddep) < 0 return perr fin - cout('!') fin moddep = moddep + dcitos(moddep, @str) loop @@ -955,13 +952,6 @@ def loadmod(mod) deftbl = allocheap(defcnt * 6 + 1) deflast = deftbl ^deflast = 0 - if !refnum - ; - ; Reset read pointer. - ; - ;refnum = open(@filename, O_READ) - ;rdlen = read(refnum, @header, 128) - fin fin ; ; Alloc heap space for relocated module (data + bytecode). @@ -1028,37 +1018,37 @@ def loadmod(mod) else ; BYTE sized fixup. fixup = ^addr fin - if uword_isge(fixup, modend) - cout('<') - cout('<') - prword(*addr);fixup) - cout('@') - prword(addr) - cout('>') - cout('>') - prword(^rld) - crout - fin +; if uword_isge(fixup, modend) +; cout('<') +; cout('<') +; prword(*addr);fixup) +; cout('@') +; prword(addr) +; cout('>') +; cout('>') +; prword(^rld) +; crout +; fin if ^rld & $10 ; EXTERN reference. fixup = fixup + lookupextern(esd, (rld).3) else ; INTERN fixup. fixup = fixup + modfix - MODADDR - if uword_isge(fixup, modend) - prword(@(modaddr).$62) - cout('=') - prword((modaddr).$62) - crout - cout('<') - cout('<') - cout('<') - prword(fixup) - cout('>') - cout('>') - cout('>') - prword(rld) - cin - crout - fin +; if uword_isge(fixup, modend) +; prword(@(modaddr).$62) +; cout('=') +; prword((modaddr).$62) +; crout +; cout('<') +; cout('<') +; cout('<') +; prword(fixup) +; cout('>') +; cout('>') +; cout('>') +; prword(rld) +; cin +; crout +; fin if uword_isge(fixup, bytecode) ; ; Bytecode address - replace with call def directory. @@ -1114,8 +1104,6 @@ def loadmod(mod) ; Call init routine if it exists. ; if init - cout('>') - cin return adddef(defext, init - defofst + defaddr, @deflast)() fin return 0