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

Merge branch 'master' of https://github.com/dschmenk/PLASMA

Browse Source
This commit is contained in:
David Schmenk 2017-08-30 19:34:49 -07:00
commit 1fab7ab632
15 changed files with 618 additions and 328 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
README.md
View File

@ -465,7 +465,7 @@ keyin = @keyin2plus // address-of keyin2plus function
key = keyin()
```
Lambda functions are anonymous functions that can be used to return a value (or multiple values). They can be used as function pointers to routines that need a quick and dirty expression. They are written an '&' (a poor man's lambda symbol) followed by parameters in parentheses, and the resultant expression. There are no local variables allowed.
Lambda functions are anonymous functions that can be used to return a value (or multiple values). They can be used as function pointers to routines that need a quick and dirty expression. They are written as '&' (a poor man's lambda symbol) followed by parameters in parentheses, and the resultant expression. There are no local variables allowed.
```
word result
@ -493,7 +493,7 @@ if ^pushbttn3 < 128
key = $CE // N
fin
else
key = key | $E0
key = key | $E0
fin
```
@ -503,7 +503,7 @@ The `when`/`is`/`otherwise`/`wend` statement is similar to the `if`/`elsif`/`els
when keypressed
is keyarrowup
cursup
breaking
break
is keyarrowdown
cursdown
break

12
src/inc/cmdsys.plh
View File

@ -36,10 +36,10 @@ import cmdsys
//
// CMD exported functions
//
predef putc, putln, puts, getc, gets
predef call, syscall
predef heapmark, heapallocalign, heapalloc, heaprelease, heapavail
predef memset, memcpy
predef isugt, isuge, isult, isule
predef modload, modexec, modaddr
predef putc(c)#0, putln()#0, puts(s)#0, getc()#1, gets(p)#1
predef call(addr,areg,xreg,yreg,status)#1, syscall(cmd,params)#1
predef heapmark()#1, heapallocalign(size, pow2, freeaddr), heapalloc(size)#1, heaprelease(newheap)#1, heapavail()#1
predef memset(addr,value,size)#0, memcpy(dst,src,size)#0
predef isugt(a,b)#1, isuge(a,b)#1, isult(a,b)#1, isule(a,b)#1
predef modload(mod)#1, modexec(modfile)#1, modaddr(str)#1
end

4
src/inc/testlib.plh
View File

@ -1,6 +1,6 @@
import testlib
predef puti
word print
predef puti(i)#0
word print(s)#0
const dec = 0
const hex = 2
const newln = 4

10
src/makefile
View File

@ -83,20 +83,20 @@ $(PLVM): vmsrc/plvm.c
cc vmsrc/plvm.c -o $(PLVM)
vmsrc/a1cmd.a: vmsrc/a1cmd.pla $(PLASM)
./$(PLASM) -AO < vmsrc/a1cmd.pla > vmsrc/a1cmd.a
./$(PLASM) -AOW < vmsrc/a1cmd.pla > vmsrc/a1cmd.a
$(PLVM01): vmsrc/plvm01.s vmsrc/a1cmd.a
acme -o $(PLVM01) -l vmsrc/plvm01.sym vmsrc/plvm01.s
$(CMD): vmsrc/cmd.pla vmsrc/cmdstub.s $(PLVM02) $(PLASM)
./$(PLASM) -AO < vmsrc/cmd.pla > vmsrc/cmd.a
./$(PLASM) -AOW < vmsrc/cmd.pla > vmsrc/cmd.a
acme --setpc 8192 -o $(CMD) vmsrc/cmdstub.s
$(PLVM02): vmsrc/plvm02.s
acme -o $(PLVM02) -l vmsrc/plvm02.sym vmsrc/plvm02.s
vmsrc/soscmd.a: vmsrc/soscmd.pla $(PLASM)
./$(PLASM) -AO < vmsrc/soscmd.pla > vmsrc/soscmd.a
./$(PLASM) -AOW < vmsrc/soscmd.pla > vmsrc/soscmd.a
$(PLVM03): vmsrc/plvm03.s vmsrc/soscmd.a
acme -o $(PLVM03) -l vmsrc/plvm03.sym vmsrc/plvm03.s
@ -105,9 +105,9 @@ $(PLVM03): vmsrc/plvm03.s vmsrc/soscmd.a
# Sample code
#
test: samplesrc/test.pla samplesrc/testlib.pla $(PLVM) $(PLASM)
./$(PLASM) -AMO < samplesrc/test.pla > samplesrc/test.a
./$(PLASM) -AMOW < samplesrc/test.pla > samplesrc/test.a
acme --setpc 4094 -o $(TEST) samplesrc/test.a
./$(PLASM) -AMO < samplesrc/testlib.pla > samplesrc/testlib.a
./$(PLASM) -AMOW < samplesrc/testlib.pla > samplesrc/testlib.a
acme --setpc 4094 -o $(TESTLIB) samplesrc/testlib.a
./$(PLVM) TEST

18
src/samplesrc/test.pla
View File

@ -35,20 +35,20 @@ word ptr
//
// Define functions.
//
def tens(start)
def tens(start)#0
word i, pptr
i = start
pptr = @print
repeat
print:hex(i)
print:hex(i)#0
print:str(" ")
pptr=>dec(i)
pptr=>dec(i)#0
print:newln()
i = i / 10
until i == 0
end
def ascii
def ascii#0
byte i
i = 32
while i < 128
@ -56,7 +56,7 @@ def ascii
i = i + 1
loop
end
def nums(range)
def nums(range)#0
word i
byte j
for i = range downto -range step range/10
@ -81,7 +81,7 @@ def printfunc(a, b, lambda)#0
puti(lambda(a,b))
putln
end
export def main(range)
export def main(range)#0
byte a
word lambda
@ -121,6 +121,12 @@ export def main(range)
lambda = &(x,y) x * y
puti(lambda(2,3));putln
end
def dummy(zz)#0
puts("dummy func"); putln
return 0
end
puti(array[0]);putc(' ')
puti(array[1]);putc(' ')
puti(array[2]);putc(' ')

6
src/samplesrc/testlib.pla
View File

@ -5,21 +5,21 @@ include "inc/cmdsys.plh"
//
// Module data.
//
predef puti, puth
predef puti(i)#0, puth(h)#0
export word print[] = @puti, @puth, @putln, @puts, @putc
byte valstr[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
byte loadstr[] = "testlib loaded!"
//
// Define functions.
//
def puth(h)
def puth(h)#0
putc('$')
putc(valstr[(h >> 12) & $0F])
putc(valstr[(h >> 8) & $0F])
putc(valstr[(h >> 4) & $0F])
putc(valstr[ h & $0F])
end
export def puti(i)
export def puti(i)#0
if i < 0; putc('-'); i = -i; fin
if i < 10
putc(i + '0')

21
src/toolsrc/parse.c
View File

@ -584,6 +584,11 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
type = (scantoken == PTRB_TOKEN) ? BPTR_TYPE : WPTR_TYPE;
if (!parse_const(&const_offset))
{
if (scantoken == EOL_TOKEN || scantoken == CLOSE_PAREN_TOKEN)
{
parse_error("Syntax");
return (NULL);
}
/*
* Setting type override for following operations
*/
@ -618,6 +623,11 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
: ((scantoken == DOT_TOKEN) ? BPTR_TYPE : WPTR_TYPE);
if (!parse_const(&const_offset))
{
if (scantoken == EOL_TOKEN || scantoken == CLOSE_PAREN_TOKEN)
{
parse_error("Syntax");
return (NULL);
}
/*
* Setting type override for following operations
*/
@ -1485,7 +1495,6 @@ int parse_lambda(void)
* Parse parameters and return value count
*/
cfnparms = 0;
func_tag = tag_new(DEF_TYPE);
if (scan() == OPEN_PAREN_TOKEN)
{
do
@ -1527,13 +1536,19 @@ int parse_lambda(void)
lambda_seq[lambda_cnt] = parse_expr(NULL, NULL);
scan_rewind(tokenstr);
}
lambda_cparams[lambda_cnt] = cfnparms;
lambda_tag[lambda_cnt] = func_tag;
sprintf(lambda_id[lambda_cnt], "_LAMBDA%04d", lambda_num++);
if (idglobal_lookup(lambda_id[lambda_cnt], strlen(lambda_id[lambda_cnt])) >= 0)
{
func_tag = lambda_tag[lambda_cnt];
idfunc_set(lambda_id[lambda_cnt], strlen(lambda_id[lambda_cnt]), DEF_TYPE | funcparms_type(cfnparms), func_tag); // Override any predef type & tag
}
else
{
func_tag = tag_new(DEF_TYPE);
lambda_tag[lambda_cnt] = func_tag;
lambda_cparams[lambda_cnt] = cfnparms;
idfunc_add(lambda_id[lambda_cnt], strlen(lambda_id[lambda_cnt]), DEF_TYPE | funcparms_type(cfnparms), func_tag);
}
lambda_cnt++;
idlocal_restore();
return (func_tag);

158
src/vmsrc/a1cmd.pla
View File

@ -30,12 +30,12 @@ const CFFAEntryPtr = $0B
//
// Pedefined functions.
//
predef crout, cout, prstr, cin, rdstr
predef syscall, call
predef markheap, allocheap, allocalignheap, releaseheap, availheap
predef memset, memcpy
predef uword_isgt, uword_isge, uword_islt, uword_isle
predef loadmod, execmod, lookupstrmod
predef syscall(cmd)#1, call(addr,areg,xreg,yreg,status)#1
predef crout()#0, cout(c)#0, prstr(s)#0, cin()#1, rdstr(p)#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
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1
predef loadmod(mod)#1, execmod(modfile)#1, lookupstrmod(str)#1
//
// System variables.
//
@ -117,7 +117,7 @@ word syslibsym = @exports
// CALL CFFA1 API ENTRYPOINT
// SYSCALL(CMD)
//
asm syscall
asm syscall(cmd)#1
LDA ESTKL,X
STX ESP
TAX
@ -132,7 +132,7 @@ end
// CALL 6502 ROUTINE
// CALL(ADDR, AREG, XREG, YREG, STATUS)
//
asm call
asm call(addr,areg,xreg,yreg,sstatus)#1
PHP
LDA ESTKL+4,X
STA CALL6502+1
@ -172,7 +172,7 @@ end
//
// QUIT TO MONITOR
//
asm quit
asm quit()#0
JMP $9000
end
//
@ -180,7 +180,7 @@ end
// MEMSET(ADDR, VALUE, SIZE)
// With optimizations from Peter Ferrie
//
asm memset
asm memset(addr,value,size)#0
LDA ESTKL+2,X
STA DSTL
LDA ESTKH+2,X
@ -207,6 +207,7 @@ SETMLPH STA (DST),Y
++ DEC ESTKH,X
BNE -
SETMEX INX
INX
INX
RTS
end
@ -214,31 +215,32 @@ end
// COPY MEMORY
// MEMCPY(DSTADDR, SRCADDR, SIZE)
//
asm memcpy
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
@ -246,34 +248,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
LDA ESTKL-3,X
ADC ESTKL,X
STA DSTL
LDA ESTKH-2,X
LDA ESTKH-3,X
ADC ESTKH,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
@ -281,16 +283,16 @@ 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
//
// Unsigned word comparisons.
//
asm uword_isge
asm uword_isge(a,b)#1
LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
@ -303,7 +305,7 @@ asm uword_isge
INX
RTS
end
asm uword_isle
asm uword_isle(a,b)#1
LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
@ -316,7 +318,7 @@ asm uword_isle
INX
RTS
end
asm uword_isgt
asm uword_isgt(a,b)#1
LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
@ -328,7 +330,7 @@ asm uword_isgt
INX
RTS
end
asm uword_islt
asm uword_islt(a,b)#1
LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
@ -343,7 +345,7 @@ end
//
// Addresses of internal routines.
//
asm interp
asm interp()#1
DEX
LDA #<IINTERP
STA ESTKL,X
@ -366,7 +368,7 @@ end
// ^str = len
// return len
//end
asm dcitos
asm dcitos(dci, str)#1
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
@ -406,7 +408,7 @@ end
// loop
// return ^str
//end
asm stodci
asm stodci(str, dci)#1
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
@ -434,7 +436,7 @@ asm stodci
STY ESTKH,X
RTS
end
asm toupper
asm toupper(c)#1
LDA ESTKL,X
TOUPR AND #$7F
CMP #'a'
@ -461,7 +463,7 @@ end
// until !(c & $80)
// return dci
//end
asm modtosym
asm modtosym(mod, dci)#1
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
@ -502,7 +504,7 @@ end
// tbl = tbl + 3
// loop
// return 0
asm lookuptbl
asm lookuptbl(dci, tbl)#1
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
@ -547,13 +549,13 @@ end
//
// CONSOLE I/O
//
asm cout
asm cout(c)#0
LDA ESTKL,X
JSR TOUPR
ORA #$80
JMP $FFEF
end
asm cin
asm cin()#1
DEX
- LDA $D011
BPL -
@ -564,10 +566,10 @@ asm cin
STA ESTKH,X
RTS
end
def crout
return cout($0D)
def crout()#0
cout($0D)
end
def prstr(str)
def prstr(str)#0
byte i
i = 1
while i <= ^str
@ -575,7 +577,7 @@ def prstr(str)
i = i + 1
loop
end
def rdstr(prompt)
def rdstr(prompt)#1
byte ch, maxlen
maxlen = 0
inbuff.0 = 0
@ -627,13 +629,13 @@ def rdstr(prompt)
cout($0D)
return inbuff
end
def prbyte(v)
def prbyte(v)#0
cout(hexchar[(v >> 4) & $0F])
return cout(hexchar[v & $0F])
cout(hexchar[v & $0F])
end
def prword(v)
def prword(v)#0
prbyte(v >> 8)
return prbyte(v)
prbyte(v)
end
//
// CFFA1 routines
@ -647,12 +649,12 @@ end
// perr = syscall($12)
// return *CFFAEntryPtr
//end
def finddirentry(filename)
def finddirentry(filename)#1
*CFFAFileName = filename
perr = syscall($14)
return *CFFAEntryPtr
end
def readfile(filename, buffer)
def readfile(filename, buffer)#1
*CFFADest = buffer
*CFFAFileName = filename
perr = syscall($22)
@ -661,11 +663,11 @@ end
//
// Heap routines.
//
def availheap
def availheap()#1
byte fp
return @fp - heap
end
def allocheap(size)
def allocheap(size)#1
word addr
addr = heap
heap = heap + size
@ -674,7 +676,7 @@ def allocheap(size)
fin
return addr
end
def allocalignheap(size, pow2, freeaddr)
def allocalignheap(size, pow2, freeaddr)#1
word align, addr
if freeaddr
*freeaddr = heap
@ -687,20 +689,20 @@ def allocalignheap(size, pow2, freeaddr)
fin
return addr
end
def markheap
def markheap()#1
return heap
end
def releaseheap(newheap)
def releaseheap(newheap)#1
heap = newheap
return @newheap - heap
end
//
// Symbol table routines.
//
def lookupsym(sym)
def lookupsym(sym)#1
return lookuptbl(sym, symtbl)
end
def addsym(sym, addr)
def addsym(sym, addr)#0
while ^sym & $80
^lastsym = ^sym
lastsym = lastsym + 1
@ -714,20 +716,20 @@ end
//
// Module routines.
//
def lookupmod(mod)
def lookupmod(mod)#1
byte dci[17]
return lookuptbl(modtosym(mod, @dci), symtbl)
end
def lookupstrmod(str)
def lookupstrmod(str)#1
byte mod[17]
stodci(str, @mod)
return lookupmod(@mod)
end
def addmod(mod, addr)
def addmod(mod, addr)#0
byte dci[17]
return addsym(modtosym(mod, @dci), addr)
addsym(modtosym(mod, @dci), addr)
end
def lookupextern(esd, index)
def lookupextern(esd, index)#1
word sym, addr
byte str[16]
while ^esd
@ -747,7 +749,7 @@ def lookupextern(esd, index)
loop
return 0
end
def adddef(addr, deflast)
def adddef(addr, deflast)#1
word defentry
defentry = *deflast
*deflast = defentry + 5
@ -757,7 +759,7 @@ def adddef(addr, deflast)
defentry->5 = 0 // null out next entry
return defentry
end
def lookupdef(addr, deftbl)
def lookupdef(addr, deftbl)#1
while deftbl->0 == $20
if deftbl=>3 == addr
return deftbl
@ -766,7 +768,7 @@ def lookupdef(addr, deftbl)
loop
return 0
end
def loadmod(mod)
def loadmod(mod)#1
word rdlen, modsize, bytecode, defofst, defcnt, init, fixup
word addr, modaddr, modfix, modend
word deftbl, deflast
@ -929,14 +931,14 @@ end
//
// Command mode
//
def stripchars(strptr)
def stripchars(strptr)#1
while ^strptr and ^(strptr + 1) <> ' '
memcpy(strptr + 1, strptr + 2, ^strptr)
^strptr = ^strptr - 1
loop
return ^strptr
end
def stripspaces(strptr)
def stripspaces(strptr)#0
while ^strptr and ^(strptr + ^strptr) <= ' '
^strptr = ^strptr - 1
loop
@ -945,7 +947,7 @@ def stripspaces(strptr)
^strptr = ^strptr - 1
loop
end
def striptrail(strptr)
def striptrail(strptr)#0
byte i
for i = 1 to ^strptr
@ -955,7 +957,7 @@ def striptrail(strptr)
fin
next
end
def parsecmd(strptr)
def parsecmd(strptr)#1
byte cmd
cmd = 0
@ -968,7 +970,7 @@ def parsecmd(strptr)
stripspaces(strptr)
return cmd
end
def execmod(modfile)
def execmod(modfile)#1
byte moddci[17]
word saveheap, savesym, saveflags

181
src/vmsrc/cmd.pla
View File

@ -24,12 +24,12 @@ const modinitkeep = $4000
//
// Pedefined functions.
//
predef syscall, call
predef crout, cout, prstr, cin, rdstr
predef markheap, allocheap, allocalignheap, releaseheap, availheap
predef memset, memcpy
predef uword_isgt, uword_isge, uword_islt, uword_isle
predef loadmod, execmod, lookupstrmod
predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1
predef crout()#0, cout(c)#0, prstr(s)#0, cin()#1, rdstr(p)#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
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1
predef loadmod(mod)#1, execmod(modfile)#1, lookupstrmod(str)#1
//
// System variable.
//
@ -100,7 +100,7 @@ word syslibsym = @exports
// CALL PRODOS
// SYSCALL(CMD, PARAMS)
//
asm syscall
asm syscall(cmd,params)#1
LDA ESTKL,X
LDY ESTKH,X
STA PARAMS
@ -120,7 +120,7 @@ end
// CALL 6502 ROUTINE
// CALL(ADDR, AREG, XREG, YREG, STATUS)
//
asm call
asm call(addr,areg,xreg,yreg,sstatus)#1
REGVALS = SRC
PHP
LDA ESTKL+4,X
@ -137,7 +137,7 @@ REGVALS = SRC
INX
INX
INX
INX
INX
STX ESP
TAX
PLA
@ -163,7 +163,7 @@ end
//
// CALL LOADED SYSTEM PROGRAM
//
asm exec
asm exec()#0
LDX #$00
STX IFPL
LDA #$BF
@ -177,7 +177,7 @@ end
//
// EXIT
//
asm reboot
asm reboot()#0
BIT ROMEN
DEC $03F4 ; INVALIDATE POWER-UP BYTE
JMP ($FFFC) ; RESET
@ -187,7 +187,7 @@ end
// MEMSET(ADDR, VALUE, SIZE)
// With optimizations from Peter Ferrie
//
asm memset
asm memset(addr,value,size)#0
LDA ESTKL+2,X
STA DSTL
LDA ESTKH+2,X
@ -214,6 +214,7 @@ SETMLPH STA (DST),Y
++ DEC ESTKH,X
BNE -
SETMEX INX
INX
INX
RTS
end
@ -221,31 +222,32 @@ end
// COPY MEMORY
// MEMCPY(DSTADDR, SRCADDR, SIZE)
//
asm memcpy
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
@ -253,34 +255,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
@ -288,9 +290,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
@ -299,7 +301,7 @@ end
//
// MEMXCPY(DST, SRC, SIZE)
//
asm memxcpy
asm memxcpy(dst,src,size)#0
LDA ESTKL+1,X
STA $3C
CLC
@ -321,9 +323,10 @@ asm memxcpy
LDX ESP
INX
INX
INX
RTS
end
asm crout
asm crout()#0
DEX
LDA #$0D
BNE +
@ -333,7 +336,7 @@ end
// CHAR OUT
// COUT(CHAR)
//
asm cout
asm cout(c)#0
LDA ESTKL,X
BIT $BF98
BMI +
@ -342,13 +345,14 @@ asm cout
BIT ROMEN
JSR $FDED
BIT LCRDEN+LCBNK2
INX
RTS
end
//
// CHAR IN
// RDKEY()
//
asm cin
asm cin()#1
BIT ROMEN
JSR $FD0C
BIT LCRDEN+LCBNK2
@ -363,7 +367,7 @@ end
// PRINT STRING
// PRSTR(STR)
//
asm prstr
asm prstr(s)#0
LDY #$00
LDA ESTKL,X
STA SRCL
@ -383,24 +387,26 @@ asm prstr
CPY TMP
BNE -
BIT LCRDEN+LCBNK2
++ RTS
++ INX
RTS
end
//
// PRINT BYTE
//
asm prbyte
asm prbyte(b)#0
LDA ESTKL,X
STX ESP
BIT ROMEN
JSR $FDDA
LDX ESP
BIT LCRDEN+LCBNK2
INX
RTS
end
//
// PRINT WORD
//
asm prword
asm prword(w)#0
STX ESP
TXA
TAY
@ -410,13 +416,14 @@ asm prword
JSR $F941
LDX ESP
BIT LCRDEN+LCBNK2
INX
RTS
end
//
// READ STRING
// STR = RDSTR(PROMPTCHAR)
//
asm rdstr
asm rdstr(p)#1
LDA ESTKL,X
STA $33
STX ESP
@ -436,7 +443,7 @@ asm rdstr
BIT LCRDEN+LCBNK2
RTS
end
asm uword_isge
asm uword_isge(a,b)#1
LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
@ -449,7 +456,7 @@ asm uword_isge
INX
RTS
end
asm uword_isle
asm uword_isle(a,b)#1
LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
@ -462,7 +469,7 @@ asm uword_isle
INX
RTS
end
asm uword_isgt
asm uword_isgt(a,b)#1
LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
@ -474,7 +481,7 @@ asm uword_isgt
INX
RTS
end
asm uword_islt
asm uword_islt(a,b)#1
LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
@ -503,7 +510,7 @@ end
// ^str = len
// return len
//end
asm dcitos
asm dcitos(dci, str)#1
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
@ -543,7 +550,7 @@ end
// loop
// return ^str
//end
asm stodci
asm stodci(str,dci)#1
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
@ -571,7 +578,7 @@ asm stodci
STY ESTKH,X
RTS
end
asm toupper
asm toupper(c)#1
LDA ESTKL,X
TOUPR AND #$7F
CMP #'a'
@ -598,7 +605,7 @@ end
// until !(c & $80)
// return dci
//end
asm modtosym
asm modtosym(mod,dci)#1
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
@ -639,7 +646,7 @@ end
// tbl = tbl + 3
// loop
// return 0
asm lookuptbl
asm lookuptbl(dci, tbl)#1
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
@ -684,7 +691,7 @@ end
//
// ProDOS routines
//
def getpfx(path)
def getpfx(path)#1
byte params[3]
^path = 0
@ -693,7 +700,7 @@ def getpfx(path)
perr = syscall($C7, @params)
return path
end
def setpfx(path)
def setpfx(path)#1
byte params[3]
params.0 = 1
@ -701,7 +708,7 @@ def setpfx(path)
perr = syscall($C6, @params)
return path
end
def open(path, buff)
def open(path, buff)#1
byte params[6]
params.0 = 3
@ -711,7 +718,7 @@ def open(path, buff)
perr = syscall($C8, @params)
return params.5
end
def close(refnum)
def close(refnum)#1
byte params[2]
params.0 = 1
@ -719,7 +726,7 @@ def close(refnum)
perr = syscall($CC, @params)
return perr
end
def read(refnum, buff, len)
def read(refnum, buff, len)#1
byte params[8]
params.0 = 4
@ -733,11 +740,11 @@ end
//
// Heap routines.
//
def availheap
def availheap()#1
byte fp
return @fp - heap
end
def allocheap(size)
def allocheap(size)#1
word addr
addr = heap
heap = heap + size
@ -771,14 +778,14 @@ def allocalignheap(size, pow2, freeaddr)
fin
return addr
end
def markheap
def markheap()#1
return heap
end
def releaseheap(newheap)
def releaseheap(newheap)#1
heap = newheap
return @newheap - heap
end
def allocxheap(size)
def allocxheap(size)#1
word xaddr
xaddr = xheap
xheap = xheap + size
@ -814,10 +821,10 @@ end
//
// Symbol table routines.
//
def lookupsym(sym)
def lookupsym(sym)#1
return lookuptbl(sym, symtbl)
end
def addsym(sym, addr)
def addsym(sym, addr)#0
while ^sym & $80
^lastsym = ^sym
lastsym = lastsym + 1
@ -831,20 +838,20 @@ end
//
// Module routines.
//
def lookupmod(mod)
def lookupmod(mod)#1
byte dci[17]
return lookuptbl(modtosym(mod, @dci), symtbl)
end
def lookupstrmod(str)
def lookupstrmod(str)#1
byte mod[17]
stodci(str, @mod)
return lookupmod(@mod)
end
def addmod(mod, addr)
def addmod(mod, addr)#0
byte dci[17]
return addsym(modtosym(mod, @dci), addr)
addsym(modtosym(mod, @dci), addr)
end
def lookupextern(esd, index)
def lookupextern(esd, index)#1
word sym, addr
byte str[16]
while ^esd
@ -864,7 +871,7 @@ def lookupextern(esd, index)
loop
return 0
end
def adddef(bank, addr, deflast)
def adddef(bank, addr, deflast)#1
word defentry
defentry = *deflast
*deflast = defentry + 5
@ -878,7 +885,7 @@ def adddef(bank, addr, deflast)
defentry->5 = 0 // NULL out next entry
return defentry
end
def lookupdef(addr, deftbl)
def lookupdef(addr, deftbl)#1
while deftbl->0 == $20
if deftbl=>3 == addr
return deftbl
@ -887,7 +894,7 @@ def lookupdef(addr, deftbl)
loop
return 0
end
def loadmod(mod)
def loadmod(mod)#1
word refnum, rdlen, modsize, bytecode, defofst, defcnt, init, fixup
word addr, defaddr, modaddr, modfix, modend
word deftbl, deflast
@ -1087,7 +1094,7 @@ end
//
// Command mode
//
def volumes
def volumes()#0
byte params[4]
word strbuf
byte i
@ -1107,7 +1114,7 @@ def volumes
strbuf = strbuf + 16
next
end
def catalog(optpath)
def catalog(optpath)#1
byte path[64]
byte refnum
byte firstblk
@ -1168,14 +1175,14 @@ def catalog(optpath)
crout()
return 0
end
def stripchars(strptr)
def stripchars(strptr)#1
while ^strptr and ^(strptr + 1) > ' '
memcpy(strptr + 1, strptr + 2, ^strptr)
^strptr = ^strptr - 1
loop
return ^strptr
end
def stripspaces(strptr)
def stripspaces(strptr)#0
while ^strptr and ^(strptr + ^strptr) <= ' '
^strptr = ^strptr - 1
loop
@ -1184,7 +1191,7 @@ def stripspaces(strptr)
^strptr = ^strptr - 1
loop
end
def striptrail(strptr)
def striptrail(strptr)#1
byte i
for i = 1 to ^strptr
@ -1195,7 +1202,7 @@ def striptrail(strptr)
next
return strptr
end
def parsecmd(strptr)
def parsecmd(strptr)#1
byte cmd
cmd = 0
@ -1208,7 +1215,7 @@ def parsecmd(strptr)
stripspaces(strptr)
return cmd
end
def resetmemfiles
def resetmemfiles()#0
//
// Close all files
//
@ -1221,7 +1228,7 @@ def resetmemfiles
^$BF58 = $CF
^$BF6F = $01
end
def execsys(sysfile)
def execsys(sysfile)#0
byte refnum
word len
@ -1246,7 +1253,7 @@ def execsys(sysfile)
fin
fin
end
def execmod(modfile)
def execmod(modfile)#1
byte moddci[17]
word saveheap, savexheap, savesym, saveflags

4
src/vmsrc/plvm.c
View File

@ -457,12 +457,10 @@ void call(uword pc)
if (c == 0x0D)
c = '\n';
putchar(c);
PUSH(0);
break;
case 4: // LIBRARY STDLIB::PUTS
s = POP;
i = mem_data[s++];
PUSH(i);
while (i--)
{
c = mem_data[s++];
@ -479,7 +477,6 @@ void call(uword pc)
c = '\n';
putchar(c);
}
PUSH(0);
break;
case 6: // LIBRARY STDLIB::GETC
PUSH(getchar());
@ -495,7 +492,6 @@ void call(uword pc)
case 8: // LIBRARY STDLIB::PUTNL
putchar('\n');
fflush(stdout);
PUSH(0);
break;
default:
printf("\nBad call code:$%02X\n", mem_data[pc - 1]);

67
src/vmsrc/plvm01.s
View File

@ -5,6 +5,7 @@
;* SYSTEM ROUTINES AND LOCATIONS
;*
;**********************************************************
SELFMODIFY = 1
;*
;* VM ZERO PAGE LOCATIONS
;*
@ -441,6 +442,17 @@ CS DEX
;*
;* LOAD VALUE FROM ADDRESS TAG
;*
!IF SELFMODIFY {
LB LDA ESTKL,X
STA LBLDA+1
LDA ESTKH,X
STA LBLDA+2
LBLDA LDA $FFFF
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
} ELSE {
LB LDA ESTKL,X
STA TMPL
LDA ESTKH,X
@ -452,6 +464,7 @@ LB LDA ESTKL,X
STY ESTKH,X
LDY IPY
JMP NEXTOP
}
LW LDA ESTKL,X
STA TMPL
LDA ESTKH,X
@ -507,6 +520,20 @@ LLW +INC_IP
;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS
;*
!IF SELFMODIFY {
LAB +INC_IP
LDA (IP),Y
STA LABLDA+1
+INC_IP
LDA (IP),Y
STA LABLDA+2
LABLDA LDA $FFFF
DEX
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
} ELSE {
LAB +INC_IP
LDA (IP),Y
STA TMPL
@ -521,6 +548,7 @@ LAB +INC_IP
STY ESTKH,X
LDY IPY
JMP NEXTOP
}
LAW +INC_IP
LDA (IP),Y
STA TMPL
@ -540,6 +568,18 @@ LAW +INC_IP
;*
;* STORE VALUE TO ADDRESS
;*
!IF SELFMODIFY {
SB LDA ESTKL,X
STA SBSTA+1
LDA ESTKH,X
STA SBSTA+2
LDA ESTKL+1,X
SBSTA STA $FFFF
INX
; INX
; JMP NEXTOP
JMP DROP
} ELSE {
SB LDA ESTKL,X
STA TMPL
LDA ESTKH,X
@ -553,6 +593,7 @@ SB LDA ESTKL,X
; INX
; JMP NEXTOP
JMP DROP
}
SW LDA ESTKL,X
STA TMPL
LDA ESTKH,X
@ -620,6 +661,19 @@ DLW +INC_IP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS
;*
!IF SELFMODIFY {
SAB +INC_IP
LDA (IP),Y
STA SABSTA+1
+INC_IP
LDA (IP),Y
STA SABSTA+2
LDA ESTKL,X
SABSTA STA $FFFF
; INX
; JMP NEXTOP
JMP DROP
} ELSE {
SAB +INC_IP
LDA (IP),Y
STA TMPL
@ -634,6 +688,7 @@ SAB +INC_IP
; INX
; JMP NEXTOP
JMP DROP
}
SAW +INC_IP
LDA (IP),Y
STA TMPL
@ -654,6 +709,17 @@ SAW +INC_IP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
;*
!IF SELFMODIFY {
DAB +INC_IP
LDA (IP),Y
STA DABSTA+1
+INC_IP
LDA (IP),Y
STA DABSTA+2
LDA ESTKL,X
DABSTA STA $FFFF
JMP NEXTOP
} ELSE {
DAB +INC_IP
LDA (IP),Y
STA TMPL
@ -666,6 +732,7 @@ DAB +INC_IP
STA (TMP),Y
LDY IPY
JMP NEXTOP
}
DAW +INC_IP
LDA (IP),Y
STA TMPL

128
src/vmsrc/plvm02.s
View File

@ -5,6 +5,7 @@
;* SYSTEM ROUTINES AND LOCATIONS
;*
;**********************************************************
SELFMODIFY = 0
;*
;* MONITOR SPECIAL LOCATIONS
;*
@ -195,9 +196,13 @@ DINTRP PLA
LDA PPH
STA IFPH
LDY #$00
!IF SELFMODIFY {
BEQ +
} ELSE {
LDA #>OPTBL
STA OPPAGE
JMP FETCHOP
}
IINTRP PLA
STA TMPL
PLA
@ -217,8 +222,12 @@ IINTRP PLA
STA IFPL
LDA PPH
STA IFPH
LDA #>OPTBL
+ LDA #>OPTBL
STA OPPAGE
!IF SELFMODIFY {
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
JMP FETCHOP
IINTRPX PLA
STA TMPL
@ -243,6 +252,10 @@ IINTRPX PLA
STA OPPAGE
SEI
STA ALTRDON
!IF SELFMODIFY {
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
JMP FETCHOP
;************************************************************
;* *
@ -844,6 +857,17 @@ _CEXSX LDA (IP),Y ; SKIP TO NEXT OP ADDR AFTER STRING
;*
;* LOAD VALUE FROM ADDRESS TAG
;*
!IF SELFMODIFY {
LB LDA ESTKL,X
STA LBLDA+1
LDA ESTKH,X
STA LBLDA+2
LBLDA LDA $FFFF
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
} ELSE {
LB LDA ESTKL,X
STA TMPL
LDA ESTKH,X
@ -855,6 +879,7 @@ LB LDA ESTKL,X
STY ESTKH,X
LDY IPY
JMP NEXTOP
}
LW LDA ESTKL,X
STA TMPL
LDA ESTKH,X
@ -869,6 +894,19 @@ LW LDA ESTKL,X
LDY IPY
JMP NEXTOP
;
!IF SELFMODIFY {
LBX LDA ESTKL,X
STA LBXLDA+1
LDA ESTKH,X
STA LBXLDA+2
STA ALTRDOFF
LBXLDA LDA $FFFF
STA ESTKL,X
LDA #$00
STA ESTKH,X
STA ALTRDON
JMP NEXTOP
} ELSE {
LBX LDA ESTKL,X
STA TMPL
LDA ESTKH,X
@ -882,6 +920,7 @@ LBX LDA ESTKL,X
LDY IPY
STA ALTRDON
JMP NEXTOP
}
LWX LDA ESTKL,X
STA TMPL
LDA ESTKH,X
@ -967,6 +1006,20 @@ LLWX +INC_IP
;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS
;*
!IF SELFMODIFY {
LAB +INC_IP
LDA (IP),Y
STA LABLDA+1
+INC_IP
LDA (IP),Y
STA LABLDA+2
LABLDA LDA $FFFF
DEX
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
} ELSE {
LAB +INC_IP
LDA (IP),Y
STA TMPL
@ -981,6 +1034,7 @@ LAB +INC_IP
STY ESTKH,X
LDY IPY
JMP NEXTOP
}
LAW +INC_IP
LDA (IP),Y
STA TMPL
@ -998,6 +1052,22 @@ LAW +INC_IP
LDY IPY
JMP NEXTOP
;
!IF SELFMODIFY {
LABX +INC_IP
LDA (IP),Y
STA LABXLDA+1
+INC_IP
LDA (IP),Y
STA LABXLDA+2
STA ALTRDOFF
LABXLDA LDA $FFFF
DEX
STA ESTKL,X
LDA #$00
STA ESTKH,X
STA ALTRDON
JMP NEXTOP
} ELSE {
LABX +INC_IP
LDA (IP),Y
STA TMPL
@ -1014,6 +1084,7 @@ LABX +INC_IP
STA ALTRDON
LDY IPY
JMP NEXTOP
}
LAWX +INC_IP
LDA (IP),Y
STA TMPL
@ -1035,6 +1106,18 @@ LAWX +INC_IP
;*
;* STORE VALUE TO ADDRESS
;*
!IF SELFMODIFY {
SB LDA ESTKL,X
STA SBSTA+1
LDA ESTKH,X
STA SBSTA+2
LDA ESTKL+1,X
SBSTA STA $FFFF
INX
; INX
; JMP NEXTOP
JMP DROP
} ELSE {
SB LDA ESTKL,X
STA TMPL
LDA ESTKH,X
@ -1048,6 +1131,7 @@ SB LDA ESTKL,X
; INX
; JMP NEXTOP
JMP DROP
}
SW LDA ESTKL,X
STA TMPL
LDA ESTKH,X
@ -1115,6 +1199,19 @@ DLW +INC_IP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS
;*
!IF SELFMODIFY {
SAB +INC_IP
LDA (IP),Y
STA SABSTA+1
+INC_IP
LDA (IP),Y
STA SABSTA+2
LDA ESTKL,X
SABSTA STA $FFFF
; INX
; JMP NEXTOP
JMP DROP
} ELSE {
SAB +INC_IP
LDA (IP),Y
STA TMPL
@ -1129,6 +1226,7 @@ SAB +INC_IP
; INX
; JMP NEXTOP
JMP DROP
}
SAW +INC_IP
LDA (IP),Y
STA TMPL
@ -1149,6 +1247,17 @@ SAW +INC_IP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
;*
!IF SELFMODIFY {
DAB +INC_IP
LDA (IP),Y
STA DABSTA+1
+INC_IP
LDA (IP),Y
STA DABSTA+2
LDA ESTKL,X
DABSTA STA $FFFF
JMP NEXTOP
} ELSE {
DAB +INC_IP
LDA (IP),Y
STA TMPL
@ -1161,6 +1270,7 @@ DAB +INC_IP
STA (TMP),Y
LDY IPY
JMP NEXTOP
}
DAW +INC_IP
LDA (IP),Y
STA TMPL
@ -1334,6 +1444,10 @@ CALL +INC_IP
STA IPH
LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
!IF SELFMODIFY {
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
JMP NEXTOP
;
CALLX +INC_IP
@ -1361,6 +1475,10 @@ CALLX +INC_IP
STA IPH
LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
!IF SELFMODIFY {
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
JMP NEXTOP
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
@ -1385,6 +1503,10 @@ ICAL LDA ESTKL,X
STA IPH
LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
!IF SELFMODIFY {
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
JMP NEXTOP
;
ICALX LDA ESTKL,X
@ -1411,6 +1533,10 @@ ICALX LDA ESTKL,X
STA IPH
LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
!IF SELFMODIFY {
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
JMP NEXTOP
;*
;* JUMP INDIRECT TRHOUGH TMP

67
src/vmsrc/plvm03.s
View File

@ -5,6 +5,7 @@
;* SYSTEM ROUTINES AND LOCATIONS
;*
;**********************************************************
SELFMODIFY = 1
;
; HARDWARE REGISTERS
;
@ -598,6 +599,17 @@ _CEXS LDA (IP),Y ; SKIP TO NEXT OP ADDR AFTER STRING
;*
;* LOAD VALUE FROM ADDRESS TAG
;*
!IF SELFMODIFY {
LB LDA ESTKL,X
STA LBLDA+1
LDA ESTKH,X
STA LBLDA+2
LBLDA LDA $FFFF
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
} ELSE {
LB LDA ESTKL,X
STA TMPL
LDA ESTKH,X
@ -609,6 +621,7 @@ LB LDA ESTKL,X
STY ESTKH,X
LDY IPY
JMP NEXTOP
}
LW LDA ESTKL,X
STA TMPL
LDA ESTKH,X
@ -664,6 +677,20 @@ LLW +INC_IP
;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS
;*
!IF SELFMODIFY {
LAB +INC_IP
LDA (IP),Y
STA LABLDA+1
+INC_IP
LDA (IP),Y
STA LABLDA+2
LABLDA LDA $FFFF
DEX
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
} ELSE {
LAB +INC_IP
LDA (IP),Y
STA TMPL
@ -678,6 +705,7 @@ LAB +INC_IP
STY ESTKH,X
LDY IPY
JMP NEXTOP
}
LAW +INC_IP
LDA (IP),Y
STA TMPL
@ -697,6 +725,18 @@ LAW +INC_IP
;*
;* STORE VALUE TO ADDRESS
;*
!IF SELFMODIFY {
SB LDA ESTKL,X
STA SBSTA+1
LDA ESTKH,X
STA SBSTA+2
LDA ESTKL+1,X
SBSTA STA $FFFF
INX
; INX
; JMP NEXTOP
JMP DROP
} ELSE {
SB LDA ESTKL,X
STA TMPL
LDA ESTKH,X
@ -710,6 +750,7 @@ SB LDA ESTKL,X
; INX
; JMP NEXTOP
JMP DROP
}
SW LDA ESTKL,X
STA TMPL
LDA ESTKH,X
@ -777,6 +818,19 @@ DLW +INC_IP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS
;*
!IF SELFMODIFY {
SAB +INC_IP
LDA (IP),Y
STA SABSTA+1
+INC_IP
LDA (IP),Y
STA SABSTA+2
LDA ESTKL,X
SABSTA STA $FFFF
; INX
; JMP NEXTOP
JMP DROP
} ELSE {
SAB +INC_IP
LDA (IP),Y
STA TMPL
@ -791,6 +845,7 @@ SAB +INC_IP
; INX
; JMP NEXTOP
JMP DROP
}
SAW +INC_IP
LDA (IP),Y
STA TMPL
@ -811,6 +866,17 @@ SAW +INC_IP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
;*
!IF SELFMODIFY {
DAB +INC_IP
LDA (IP),Y
STA DABSTA+1
+INC_IP
LDA (IP),Y
STA DABSTA+2
LDA ESTKL,X
DABSTA STA $FFFF
JMP NEXTOP
} ELSE {
DAB +INC_IP
LDA (IP),Y
STA TMPL
@ -823,6 +889,7 @@ DAB +INC_IP
STA (TMP),Y
LDY IPY
JMP NEXTOP
}
DAW +INC_IP
LDA (IP),Y
STA TMPL

70
src/vmsrc/plvmzp.inc
View File

@ -1,41 +1,41 @@
;**********************************************************
;*
;* VM ZERO PAGE LOCATIONS
;* VM ZERO PAGE LOCATIONS
;*
;**********************************************************
SRC = $06
SRCL = SRC
SRCH = SRC+1
DST = SRC+2
DSTL = DST
DSTH = DST+1
ESTKSZ = $20
XSTK = $A0
XSTKL = XSTK
XSTKH = XSTK+ESTKSZ/2
ESTK = $C0
ESTKL = ESTK
ESTKH = ESTK+ESTKSZ/2
VMZP = ESTK+ESTKSZ
ESP = VMZP
DVSIGN = VMZP
IFP = ESP+1
IFPL = IFP
IFPH = IFP+1
SRC = $06
SRCL = SRC
SRCH = SRC+1
DST = SRC+2
DSTL = DST
DSTH = DST+1
ESTKSZ = $20
XSTK = $A0
XSTKL = XSTK
XSTKH = XSTK+ESTKSZ/2
ESTK = $C0
ESTKL = ESTK
ESTKH = ESTK+ESTKSZ/2
VMZP = ESTK+ESTKSZ
ESP = VMZP
DVSIGN = VMZP
IFP = ESP+1
IFPL = IFP
IFPH = IFP+1
PP = IFP+2
PPL = PP
PPH = PP+1
IPY = PP+2
TMP = IPY+1
TMPL = TMP
TMPH = TMP+1
NPARMS = TMPL
FRMSZ = TMPH
DROP = $EF
NEXTOP = $F0
PPL = PP
PPH = PP+1
IPY = PP+2
TMP = IPY+1
TMPL = TMP
TMPH = TMP+1
NPARMS = TMPL
FRMSZ = TMPH
DROP = $EF
NEXTOP = $F0
FETCHOP = NEXTOP+3
IP = FETCHOP+1
IPL = IP
IPH = IPL+1
OPIDX = FETCHOP+6
OPPAGE = OPIDX+1
IP = FETCHOP+1
IPL = IP
IPH = IPL+1
OPIDX = FETCHOP+6
OPPAGE = OPIDX+1

194
src/vmsrc/soscmd.pla
View File

@ -25,12 +25,12 @@ const O_READ_WRITE = 3
//
// Pedefined functions.
//
predef crout, cout, prstr, cin, rdstr
predef syscall, call
predef markheap, allocheap, allocalignheap, releaseheap, availheap
predef memset, memcpy
predef uword_isgt, uword_isge, uword_islt, uword_isle
predef loadmod, execmod, lookupstrmod
predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1
predef crout()#0, cout(c)#0, prstr(s)#0, cin()#1, rdstr(p)#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
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1
predef loadmod(mod)#1, execmod(modfile)#1, lookupstrmod(str)#1
//
// System variables.
//
@ -113,7 +113,7 @@ word syslibsym = @exports
// CALL SOS
// SYSCALL(CMD, PARAMS)
//
asm syscall
asm syscall(cmd,params)#1
LDA ESTKL,X
LDY ESTKH,X
STA PARAMS
@ -133,7 +133,7 @@ end
// CALL 6502 ROUTINE
// CALL(AREG, XREG, YREG, STATUS, ADDR)
//
asm call
asm call(addr,areg,xreg,yreg,sstatus)#1
REGVALS = SRC
PHP
LDA ESTKL,X
@ -176,7 +176,7 @@ end
// MEMSET(ADDR, VALUE, SIZE)
// With optimizations from Peter Ferrie
//
asm memset
asm memset(addr,value,size)#0
LDA ESTKL+2,X
STA DSTL
LDA ESTKH+2,X
@ -203,6 +203,7 @@ SETMLPH STA (DST),Y
++ DEC ESTKH,X
BNE -
SETMEX INX
INX
INX
RTS
end
@ -210,31 +211,32 @@ end
// COPY MEMORY
// MEMCPY(DSTADDR, SRCADDR, SIZE)
//
asm memcpy
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
LDA ESTKL-2,X
STA DSTL
LDA ESTKH,X
LDA ESTKH-2,X
STA DSTH
LDA ESTKL-1,X
LDA ESTKL-2,X
STA SRCL
LDA ESTKH-1,X
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
@ -242,34 +244,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
@ -277,9 +279,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
@ -288,7 +290,7 @@ end
//
// MEMXCPY(DSTSEG, SRC, SIZE)
//
asm memxcpy
asm memxcpy(dst,src,size)#0
LDA ESTKL,X
ORA ESTKH,X
BEQ CPYXMEX
@ -320,6 +322,7 @@ CPYXLP LDA (SRC),Y
LDA #$00
STA DSTX
CPYXMEX INX
INX
INX
RTS
end
@ -328,7 +331,7 @@ end
//
// XPOKEB(SEG, DST, BYTEVAL)
//
asm xpokeb
asm xpokeb(seg, dst, byteval)#0
LDA ESTKL+1,X
STA DSTL
LDA ESTKH+1,X
@ -345,12 +348,13 @@ asm xpokeb
STY DSTX
INX
INX
INX
RTS
end
//
// Unsigned word comparisons.
//
asm uword_isge
asm uword_isge(a,b)#1
LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
@ -363,7 +367,7 @@ asm uword_isge
INX
RTS
end
asm uword_isle
asm uword_isle(a,b)#1
LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
@ -376,7 +380,7 @@ asm uword_isle
INX
RTS
end
asm uword_isgt
asm uword_isgt(a,b)#1
LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
@ -388,7 +392,7 @@ asm uword_isgt
INX
RTS
end
asm uword_islt
asm uword_islt(a,b)#1
LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
@ -403,7 +407,7 @@ end
//
// Addresses of internal routines.
//
asm interp
asm interp()#1
DEX
LDA #<XINTERP
STA ESTKL,X
@ -426,7 +430,7 @@ end
// ^str = len
// return len
//end
asm dcitos
asm dcitos(dci, str)#1
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
@ -466,7 +470,7 @@ end
// loop
// return ^str
//end
asm stodci
asm stodci(str, dci)#1
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
@ -494,7 +498,7 @@ asm stodci
STY ESTKH,X
RTS
end
asm toupper
asm toupper(c)#1
LDA ESTKL,X
TOUPR AND #$7F
CMP #'a'
@ -521,7 +525,7 @@ end
// until !(c & $80)
// return dci
//end
asm modtosym
asm modtosym(mod, dci)#1
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
@ -562,7 +566,7 @@ end
// tbl = tbl + 3
// loop
// return 0
asm lookuptbl
asm lookuptbl(dci, tbl)#1
LDY #$00
STY DSTL
LDA ESTKH,X
@ -615,7 +619,7 @@ end
// SOS routines
// FILE I/O
//
def getpfx(path)
def getpfx(path)#1
byte params[4]
^path = 0
@ -625,7 +629,7 @@ def getpfx(path)
perr = syscall($C7, @params)
return path
end
def setpfx(path)
def setpfx(path)#1
byte params[3]
params.0 = 1
@ -633,7 +637,7 @@ def setpfx(path)
perr = syscall($C6, @params)
return path
end
def volume(devname, volname, ttlblks, freblks)
def volume(devname, volname, ttlblks, freblks)#1
byte params[9]
params.0 = 4
@ -646,7 +650,7 @@ def volume(devname, volname, ttlblks, freblks)
*freblks = params:7
return perr
end
def open(path, access)
def open(path, access)#1
byte params[7]
params.0 = 4
@ -657,7 +661,7 @@ def open(path, access)
perr = syscall($C8, @params)
return params.3
end
def close(refnum)
def close(refnum)#1
byte params[2]
params.0 = 1
@ -665,7 +669,7 @@ def close(refnum)
perr = syscall($CC, @params)
return perr
end
def read(refnum, buff, len)
def read(refnum, buff, len)#1
byte params[8]
params.0 = 4
@ -676,7 +680,7 @@ def read(refnum, buff, len)
perr = syscall($CA, @params)
return params:6
end
def write(refnum, buff, len)
def write(refnum, buff, len)#1
byte params[6]
params.0 = 3
@ -689,7 +693,7 @@ end
//
// DEVICE I/O
//
def dev_control(devnum, code, list)
def dev_control(devnum, code, list)#1
byte params[5]
params.0 = 3
@ -699,7 +703,7 @@ def dev_control(devnum, code, list)
perr = syscall($83, @params)
return perr
end
def dev_getnum(name)
def dev_getnum(name)#1
byte params[4]
params.0 = 2
@ -708,7 +712,7 @@ def dev_getnum(name)
perr = syscall($84, @params)
return params.3
end
def dev_info(devnum, name, list, listlen)
def dev_info(devnum, name, list, listlen)#1
byte params[7]
params.0 = 4
@ -722,7 +726,7 @@ end
//
// MEMORY CALLS
//
def seg_request(base, limit, id)
def seg_request(base, limit, id)#1
byte params[7]
params.0 = 4
@ -733,7 +737,7 @@ def seg_request(base, limit, id)
perr = syscall($40, @params)
return params.6
end
def seg_find(search, base, limit, pages, id)
def seg_find(search, base, limit, pages, id)#1
byte params[10]
params.0 = 6
@ -748,7 +752,7 @@ def seg_find(search, base, limit, pages, id)
*limit = params:7
return params.9
end
def seg_release(segnum)
def seg_release(segnum)#1
byte params[2]
params.0 = 1
@ -759,7 +763,7 @@ end
//
// Other SOS calls.
//
def quit
def quit()#0
byte params[1]
close(0)
@ -770,7 +774,7 @@ end
//
// CONSOLE I/O
//
def init_cons
def init_cons()#0
byte nlmode[2]
if !refcons
refcons = open(@console, O_READ_WRITE)
@ -781,7 +785,7 @@ def init_cons
nlmode.1 = $0D
dev_control(devcons, $02, @nlmode)
end
def cout(ch)
def cout(ch)#0
if ch == $0D
ch = $0A0D
write(refcons, @ch, 2)
@ -789,18 +793,18 @@ def cout(ch)
write(refcons, @ch, 1)
fin
end
def cin
def cin()#1
byte ch
read(refcons, @ch, 1)
return ch & $7F
end
def prstr(str)
def prstr(str)#0
write(refcons, str + 1, ^str)
if str->[^str] == $0D
cout($0A)
fin
end
def rdstr(prompt)
def rdstr(prompt)#1
cout(prompt)
^heap = read(refcons, heap + 1, 128)
if heap->[^heap] == $0D
@ -809,25 +813,25 @@ def rdstr(prompt)
cout($0D)
return heap
end
def crout
return cout($0D)
def crout()#0
cout($0D)
end
def prbyte(v)
def prbyte(v)#0
cout(hexchar[(v >> 4) & $0F])
return cout(hexchar[v & $0F])
cout(hexchar[v & $0F])
end
def prword(v)
def prword(v)#0
prbyte(v >> 8)
return prbyte(v)
prbyte(v)
end
//
// Heap routines.
//
def availheap
def availheap()#1
byte fp
return @fp - heap
end
def allocheap(size)
def allocheap(size)#1
word addr
addr = heap
heap = heap + size
@ -836,7 +840,7 @@ def allocheap(size)
fin
return addr
end
def allocalignheap(size, pow2, freeaddr)
def allocalignheap(size, pow2, freeaddr)#1
word align, addr
if freeaddr
*freeaddr = heap
@ -849,20 +853,20 @@ def allocalignheap(size, pow2, freeaddr)
fin
return addr
end
def markheap
def markheap()#1
return heap
end
def releaseheap(newheap)
def releaseheap(newheap)#1
heap = newheap
return @newheap - heap
end
//
// Symbol table routines.
//
def lookupsym(sym)
def lookupsym(sym)#1
return lookuptbl(sym, symtbl)
end
def addsym(sym, addr)
def addsym(sym, addr)#0
while ^sym & $80
xpokeb(symtbl.0, lastsym, ^sym)
lastsym = lastsym + 1
@ -877,20 +881,20 @@ end
//
// Module routines.
//
def lookupmod(mod)
def lookupmod(mod)#1
byte dci[17]
return lookuptbl(modtosym(mod, @dci), symtbl)
end
def lookupstrmod(str)
def lookupstrmod(str)#1
byte mod[17]
stodci(str, @mod)
return lookupmod(@mod)
end
def addmod(mod, addr)
def addmod(mod, addr)#0
byte dci[17]
return addsym(modtosym(mod, @dci), addr)
addsym(modtosym(mod, @dci), addr)
end
def lookupextern(esd, index)
def lookupextern(esd, index)#1
word sym, addr
byte str[16]
while ^esd
@ -910,7 +914,7 @@ def lookupextern(esd, index)
loop
return 0
end
def adddef(ext, addr, deflast)
def adddef(ext, addr, deflast)#1
word defentry
defentry = *deflast
*deflast = defentry + 6
@ -920,7 +924,7 @@ def adddef(ext, addr, deflast)
defentry=>5 = ext // ext is byte, so this nulls out next entry
return defentry
end
def lookupdef(addr, deftbl)
def lookupdef(addr, deftbl)#1
while deftbl->0 == $20
if deftbl=>3 == addr
return deftbl
@ -929,7 +933,7 @@ def lookupdef(addr, deftbl)
loop
return 0
end
def loadmod(mod)
def loadmod(mod)#1
word refnum, rdlen, modsize, bytecode, defofst, defcnt, init, fixup
word addr, defaddr, modaddr, modfix, modend
word deftbl, deflast, codeseg
@ -1121,7 +1125,7 @@ end
//
// Command mode
//
def volumes
def volumes()#0
byte info[11]
byte devname[17]
byte volname[17]
@ -1141,7 +1145,7 @@ def volumes
next
perr = 0
end
def catalog(optpath)
def catalog(optpath)#1
byte path[64]
byte refnum
byte firstblk
@ -1202,14 +1206,14 @@ def catalog(optpath)
crout()
return 0
end
def stripchars(strptr)
def stripchars(strptr)#1
while ^strptr and ^(strptr + 1) <> ' '
memcpy(strptr + 1, strptr + 2, ^strptr)
^strptr = ^strptr - 1
loop
return ^strptr
end
def stripspaces(strptr)
def stripspaces(strptr)#0
while ^strptr and ^(strptr + ^strptr) <= ' '
^strptr = ^strptr - 1
loop
@ -1218,7 +1222,7 @@ def stripspaces(strptr)
^strptr = ^strptr - 1
loop
end
def striptrail(strptr)
def striptrail(strptr)#0
byte i
for i = 1 to ^strptr
@ -1228,7 +1232,7 @@ def striptrail(strptr)
fin
next
end
def parsecmd(strptr)
def parsecmd(strptr)#1
byte cmd
cmd = 0
@ -1241,7 +1245,7 @@ def parsecmd(strptr)
stripspaces(strptr)
return cmd
end
def execmod(modfile)
def execmod(modfile)#1
byte moddci[17]
word saveheap, savesym, saveflags