diff --git a/src/inc/memmgr.plh b/src/inc/memmgr.plh
index 752b016..295ca53 100644
--- a/src/inc/memmgr.plh
+++ b/src/inc/memmgr.plh
@@ -2,13 +2,13 @@ import memmgr
//
// Utility routine
//
- predef sweep, brk, sbrk
+ predef sweep#0, brk(addr), sbrk(size)
//
// Memory routines
//
- predef hmemNew, hmemLock, hmemUnlock, hmemRef, hmemDel, hmemFre
+ predef hmemNew(size), hmemLock(hmem), hmemUnlock(hmem)#0, hmemRef(hmem), hmemDel(hmem), hmemFre(lptr)
//
// Max size of a memory block
//
const MAX_MEMBLK_SIZE = $2000
-end
\ No newline at end of file
+end
diff --git a/src/libsrc/conio.pla b/src/libsrc/conio.pla
index dc55d61..4aa7bc9 100644
--- a/src/libsrc/conio.pla
+++ b/src/libsrc/conio.pla
@@ -1,7 +1,4 @@
-import STDLIB
- predef syscall, call, memset, getc, putc, puts, modaddr
- byte MACHID
-end
+include "inc/cmdsys.plh"
//
// Handy constants.
//
@@ -200,7 +197,7 @@ def a2writeln(string, start, fill)
end
def a2textmode(columns)
call($FB39, 0, 0, 0, 0) // textmode()
- return a2home
+ return a2home
end
def a2grmode(mix)
call($FB2F, 0, 0, 0, 0) // initmode()
@@ -216,7 +213,7 @@ end
//
def dev_control(devnum, code, list)
byte params[5]
-
+
params.0 = 3
params.1 = devnum
params.2 = code
@@ -225,7 +222,7 @@ def dev_control(devnum, code, list)
end
def dev_status(devnum, code, list)
byte params[5]
-
+
params.0 = 3
params.1 = devnum
params.2 = code
diff --git a/src/libsrc/dgr.pla b/src/libsrc/dgr.pla
index 23bfeca..087bef4 100755
--- a/src/libsrc/dgr.pla
+++ b/src/libsrc/dgr.pla
@@ -1,18 +1,4 @@
-import cmdsys
- predef puts, memset, memcpy, heapmark, heapalloc, heaprelease, call
- byte MACHID
- //
- // System flags: memory allocator screen holes.
- //
- const restxt1 = $0001
- const restxt2 = $0002
- const resxtxt1 = $0004
- const resxtxt2 = $0008
- const reshgr1 = $0010
- const reshgr2 = $0020
- const resxhgr1 = $0040
- const resxhgr2 = $0080
-end
+include "inc/cmdsys.plh"
sysflags $000F // Reserve all text pages
//
// Apple II hardware constants.
diff --git a/src/libsrc/dhcp.pla b/src/libsrc/dhcp.pla
index 3ce3d89..529299c 100644
--- a/src/libsrc/dhcp.pla
+++ b/src/libsrc/dhcp.pla
@@ -1,12 +1,7 @@
//
// DHCP
//
-import cmdsys
- predef syscall, call, getc, gets, putc, puts, putln
- predef memset, memcpy, modaddr, modexec
- predef heapmark, heapallocalign, heapalloc, heaprelease
- byte MACHID
-end
+include "inc/cmdsys.plh"
//
// Net object
//
@@ -136,7 +131,7 @@ def puti(i)
end
def putip(ipptr)
byte i
-
+
for i = 0 to 2
puti(ipptr->[i]); putc('.')
next
@@ -144,7 +139,7 @@ def putip(ipptr)
end
def dumpbytes(buf, len)
word i
-
+
for i = 0 to len - 1
putb(buf->[i])
if i & 15 == 15
@@ -168,7 +163,7 @@ def dumpdhcp(pkt)
end
def parseopts(opts, match)
byte i
-
+
i = 0
while opts->[i] <> $FF and i < 64
while !opts->[i] and i < 64
@@ -183,7 +178,7 @@ def parseopts(opts, match)
end
def recvDHCP(remip, remport, pkt, len, param)
word servopts, maskopts, gwopts, dnsopts
-
+
//putip(remip);putc(':');puti(remport);putln
//dumpdhcp(pkt)
if pkt=>dhcp_xid:0 == $0201 and pkt=>dhcp_xid:2 == $0403
diff --git a/src/libsrc/etherip.pla b/src/libsrc/etherip.pla
index 48f8698..500e22c 100644
--- a/src/libsrc/etherip.pla
+++ b/src/libsrc/etherip.pla
@@ -1,15 +1,4 @@
-import cmdsys
- predef syscall, call, getc, gets, putc, puts, putln
- predef isugt, isuge, isult, isule
- predef memset, memcpy, modaddr, modexec
- predef heapmark, heapallocalign, heapalloc, heaprelease, heapavail
- byte MACHID
- //
- // Module don't free memory
- //
- const modkeep = $2000
- const modinitkeep = $4000
-end
+include "inc/cmdsys.plh"
//
// Net object
//
@@ -244,7 +233,7 @@ CHKLP LDA (SRC),Y
STA ESTKH+2,X
PLA
ADC ESTKL+2,X
- STA ESTKL+2,X
+ STA ESTKL+2,X
INY
BNE +
INC SRCH
@@ -268,7 +257,7 @@ def etherSendIP(ipdst, proto, seglist, size)
byte[t_iphdr] hdr
byte retry
word timeout
-
+
hdr.ip_vers_hlen = $45
hdr.ip_service = 0
hdr:ip_length = swab(t_iphdr + size)
@@ -340,7 +329,7 @@ end
def etherSendUDP(port, ipdst, portdst, data, len)
word[8] seglist // list of data and header segments
byte[t_udphdr] hdr
-
+
hdr:udp_src = swab(port=>notify_port)
hdr:udp_dst = swab(portdst)
hdr:udp_len = swab(t_udphdr + len)
@@ -391,7 +380,7 @@ end
def etherCloseUDP(port)
word port
byte i
-
+
if isuge(port, @portsUDP) and isult(port, @portsUDP + MAX_UDP_NOTIFIES * t_notify)
//
// Clear notiications on this port
diff --git a/src/libsrc/fiber.pla b/src/libsrc/fiber.pla
index 02c7bc6..a4312b4 100644
--- a/src/libsrc/fiber.pla
+++ b/src/libsrc/fiber.pla
@@ -1,13 +1,7 @@
//
// Cooperative multi-threading (fiber) scheduler
//
-import cmdsys
- predef syscall, call, getc, gets, putc, puts, putln
- predef memset, memcpy, modaddr, modexec
- predef heapmark, heapallocalign, heapalloc, heaprelease
- predef isugt, isuge, isult, isule
- byte MACHID
-end
+include "inc/cmdsys.plh"
//
// Maximum number of fibers
//
diff --git a/src/libsrc/memmgr.pla b/src/libsrc/memmgr.pla
index a0d6191..3464bc5 100644
--- a/src/libsrc/memmgr.pla
+++ b/src/libsrc/memmgr.pla
@@ -1,14 +1,9 @@
//
// Handle based swapping memory manager
//
-import cmdsys
- predef syscall, call, getc, gets, putc, puts, putln
- predef memset, memcpy, modaddr, modexec
- predef heapmark, heapallocalign, heapalloc, heaprelease
- predef isugt, isuge, isult, isule
- byte MACHID
-end
-const iobuffer = $0800
+include "inc/cmdsys.plh"
+include "inc/fileio.plh"
+
struc t_initdata
word volptr
word freeblks
@@ -88,7 +83,7 @@ word frelst // Free list
byte sweeppg, sweepen
byte[64] swapvol = "/" // Swap volume
byte swapdir = "/SWAP/"
-byte hexchar = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
+byte hexchar = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
//
// DEBUG
//
@@ -109,11 +104,11 @@ byte hexchar = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
//
// Fill block filename
//
-def strcharadd(str, char)
+def strcharadd(str, char)#0
^str = ^str + 1
str->.[^str] = char
end
-def swapfile(filestr, hmem)
+def swapfile(filestr, hmem)#0
memcpy(filestr, @swapvol, swapvol + 1)
strcharadd(filestr, 'H')
strcharadd(filestr, hexchar[(hmem >> 12) & $0F])
@@ -121,78 +116,6 @@ def swapfile(filestr, hmem)
strcharadd(filestr, hexchar[(hmem >> 4) & $0F])
strcharadd(filestr, hexchar[ hmem & $0F])
end
-def open(path)
- byte params[6]
-
- params.0 = 3
- params:1 = path
- params:3 = iobuffer
- params.5 = 0
- syscall($C8, @params)
- return params.5
-end
-def close(refnum)
- byte params[2]
-
- params.0 = 1
- params.1 = refnum
- return syscall($CC, @params)
-end
-def read(refnum, buff, len)
- byte params[8]
-
- params.0 = 4
- params.1 = refnum
- params:2 = buff
- params:4 = len
- params:6 = 0
- syscall($CA, @params)
- return params:6
-end
-def write(refnum, buff, len)
- byte params[8]
-
- params.0 = 4
- params.1 = refnum
- params:2 = buff
- params:4 = len
- params:6 = 0
- syscall($CB, @params)
- return params:6
-end
-def get_info(path, infoptr)
- byte params[18]
-
- memset(@params, 0, 18)
- params.0 = 10
- params:1 = path
- syscall($C4, @params)
- return memcpy(infoptr, @params.3, 15)
-end
-def create(path, access, type, aux)
- byte params[12], kind
-
- kind = $01
- if type == $0F
- kind = $0D
- fin
- params.0 = 7
- params:1 = path
- params.3 = access
- params.4 = type
- params:5 = aux
- params.7 = kind
- params:8 = 0
- params:10 = 0
- return syscall($C0, @params)
-end
-def destroy(path)
- byte params[12]
-
- params.0 = 1
- params:1 = path
- return syscall($C1, @params)
-end
//
// Find exact/best free memory match
//
@@ -209,7 +132,7 @@ def unlink(freblk, freprv)
end
def unfre(freblk, freprv, size)
word shrink
-
+
if freblk=>fresiz == size
//
// Unlink free block
@@ -234,32 +157,32 @@ def unfre(freblk, freprv, size)
end
def addfre(freblk)
word srch
-
+
//freblk=>fresiz = freblk=>blksiz
if frelst and frelst < freblk
srch = frelst
while srch=>frenxt
if srch=>frenxt > freblk
- //
- // Insert into list
- //
- freblk=>frenxt = srch=>frenxt
- srch=>frenxt = freblk
+ //
+ // Insert into list
+ //
+ freblk=>frenxt = srch=>frenxt
+ srch=>frenxt = freblk
return
- fin
+ fin
srch = srch=>frenxt
loop
- //
- // Add to end of list
- //
- freblk=>frenxt = 0
- srch=>frenxt = freblk
+ //
+ // Add to end of list
+ //
+ freblk=>frenxt = 0
+ srch=>frenxt = freblk
else
//
- // Add to beginning of list
- //
+ // Add to beginning of list
+ //
freblk=>frenxt = frelst
- frelst = freblk
+ frelst = freblk
fin
end
//
@@ -267,58 +190,58 @@ end
//
def coallesce
word srch, combined
-
+
combined = 0
srch = frelst
while srch and srch=>frenxt
if srch + srch=>fresiz == srch=>frenxt
- //
- // Combine adjacent free space
- //
- //putc('C');putc(' ');puth(srch);putc('+');puth(srch=>frenxt);putc(' ')
+ //
+ // Combine adjacent free space
+ //
+ //putc('C');putc(' ');puth(srch);putc('+');puth(srch=>frenxt);putc(' ')
srch=>fresiz = srch=>fresiz + srch=>frenxt=>fresiz
- srch=>frenxt = srch=>frenxt=>frenxt
+ srch=>frenxt = srch=>frenxt=>frenxt
combined = 1
else
srch = srch=>frenxt
- fin
+ fin
loop
return combined
end
def compact
word page, entry, memblk, moveblk, size, srch, prev
byte moved
-
+
moved = 0
for page = PG_TBL_SIZE - 1 downto 0
if hpgtbl[page]
for entry = 255 downto 0
- if hpgtbl:[page, entry].lsb & HMEM_STATE == HMEM_MOVEABLE
+ if hpgtbl:[page, entry].lsb & HMEM_STATE == HMEM_MOVEABLE
memblk = hpgtbl:[page, entry]
- size = memblk=>blksiz
- moveblk = 0
- prev = 0
+ size = memblk=>blksiz
+ moveblk = 0
+ prev = 0
srch = frelst
- while srch and srch < memblk
+ while srch and srch < memblk
if srch=>fresiz >= size
- moveblk = unfre(srch, prev, size)
- break
- fin
- prev = srch
- srch = srch=>frenxt
- loop
- if moveblk
- //putc('M');putc(' ');puth(moveblk);putc('=');puth(memblk);putc(' ')
- memcpy(moveblk, memblk, size)
- hpgtbl:[page, entry] = moveblk
- addfre(memblk)
- moved = 1
- fin
- fin
+ moveblk = unfre(srch, prev, size)
+ break
+ fin
+ prev = srch
+ srch = srch=>frenxt
+ loop
+ if moveblk
+ //putc('M');putc(' ');puth(moveblk);putc('=');puth(memblk);putc(' ')
+ memcpy(moveblk, memblk, size)
+ hpgtbl:[page, entry] = moveblk
+ addfre(memblk)
+ moved = 1
+ fin
+ fin
next
else
break
- fin
+ fin
next
if moved
coallesce
@@ -333,40 +256,40 @@ def swapout(accessed)
byte ref
word page, entry, memblk, hmem, size
byte swapped
-
+
swapped = 0
for page = PG_TBL_SIZE - 1 downto 0
if hpgtbl[page]
for entry = 255 downto 0
- if hpgtbl:[page, entry].lsb & HMEM_STATE == HMEM_MOVEABLE
+ if hpgtbl:[page, entry].lsb & HMEM_STATE == HMEM_MOVEABLE
memblk = hpgtbl:[page, entry]
- if not (memblk->blklok & accessed)
- //
- // Swap this block out
- //
+ if not (memblk->blklok & accessed)
+ //
+ // Swap this block out
+ //
size = memblk=>blksiz
- hmem.lsb = page
- hmem.msb = entry
- swapfile(@filename, hmem)
- create(@filename, $C3, $00, size) // embed size in aux type
+ hmem.lsb = page
+ hmem.msb = entry
+ swapfile(@filename, hmem)
+ create(@filename, $C3, $00, size) // embed size in aux type
//puts(@swapoutstr);puts(@filename);putc('@');puth(memblk);putc(':');puth(size);putln
- ref = open(@filename)
- if ref
- //
- // Write it out
- //
- if write(ref, memblk, size) == size
- //
- // Zero size in page table flags swapin to read from disk
- //
- hpgtbl:[page, entry] = HMEM_SWAPPED
- addfre(memblk)
- swapped = 1
- fin
- close(ref)
- fin
- fin
- fin
+ ref = open(@filename)
+ if ref
+ //
+ // Write it out
+ //
+ if write(ref, memblk, size) == size
+ //
+ // Zero size in page table flags swapin to read from disk
+ //
+ hpgtbl:[page, entry] = HMEM_SWAPPED
+ addfre(memblk)
+ swapped = 1
+ fin
+ close(ref)
+ fin
+ fin
+ fin
next
else
break
@@ -389,46 +312,46 @@ def findexact(size)
while srch
if srch=>fresiz == size
//putc('E')
- return unlink(srch, prev)
- fin
- prev = srch
+ return unlink(srch, prev)
+ fin
+ prev = srch
srch = srch=>frenxt
loop
end
def findbest(size)
word srch, prev
-
+
prev = 0
srch = frelst
while srch
if srch=>fresiz >= size
//putc('B')
- return unfre(srch, prev, size)
- fin
- prev = srch
+ return unfre(srch, prev, size)
+ fin
+ prev = srch
srch = srch=>frenxt
loop
end
def findblk(size)
word addr
-
+
if size > MAX_BLK_SIZE; return 0; fin
addr = findexact(size)
if !addr
coallesce
- addr = findexact(size)
- if !addr
- compact
- addr = findbest(size)
- if !addr
- swapout(HMEM_ACCESSED)
- addr = findbest(size)
- if !addr
- swapout(0)
- addr = findbest(size)
- fin
- fin
- fin
+ addr = findexact(size)
+ if !addr
+ compact
+ addr = findbest(size)
+ if !addr
+ swapout(HMEM_ACCESSED)
+ addr = findbest(size)
+ if !addr
+ swapout(0)
+ addr = findbest(size)
+ fin
+ fin
+ fin
fin
//
// Fill in the block
@@ -436,8 +359,8 @@ def findblk(size)
//puts(@getblkstr);puth(addr);putc(':');puth(size);putln
if addr
addr=>blksiz = size
- addr->blkref = 1
- addr->blklok = 0
+ addr->blkref = 1
+ addr->blklok = 0
fin
return addr
end
@@ -449,33 +372,33 @@ def swapin(hmem)
byte[15] info
byte ref
word memblk, size
-
+
size = hpgtbl:[hmem.lsb, hmem.msb] & HMEM_SIZE
if size
//
- // This was just uninitialized memory, don't bother reading from file
- //
+ // This was just uninitialized memory, don't bother reading from file
+ //
memblk = findblk(size)
else
//
- // Swap this block back in
- //
- swapfile(@filename, hmem)
- get_info(@filename, @info)
- size = info:2 // Size encoded in aux type
+ // Swap this block back in
+ //
+ swapfile(@filename, hmem)
+ get_info(@filename, @info)
+ size = info:2 // Size encoded in aux type
memblk = findblk(size)
- //puts(@swapinstr);puts(@filename);putc('@');puth(memblk);putc(':');puth(size);putln
- if memblk
- //
- // Read it in
- //
- ref = open(@filename)
- if ref
- read(ref, memblk, size)
- close(ref)
- destroy(@filename)
- fin
- fin
+ //puts(@swapinstr);puts(@filename);putc('@');puth(memblk);putc(':');puth(size);putln
+ if memblk
+ //
+ // Read it in
+ //
+ ref = open(@filename)
+ if ref
+ read(ref, memblk, size)
+ close(ref)
+ destroy(@filename)
+ fin
+ fin
fin
if memblk
hpgtbl:[hmem.lsb, hmem.msb] = memblk
@@ -485,29 +408,29 @@ end
//
// Incrementally clear the ACCESSED BIT
//
-export def sweep
+export def sweep#0
word memblk
-
+
if hpgtbl[sweeppg]
memblk = hpgtbl:[sweeppg, sweepen]
- when memblk.lsb & HMEM_STATE
- is HMEM_MOVEABLE
- is HMEM_LOCKED
- memblk = memblk & HMEM_ADDR
- if memblk->blklok & HMEM_ACCESSED
- memblk->blklok = memblk->blklok & $7F
- fin
- wend
- if sweepen == 255
- sweepen = 0
- if sweeppg == 0
- sweeppg = PG_TBL_SIZE - 1
- else
- sweeppg = sweeppg - 1
- fin
- else
- sweepen = sweepen + 1
- fin
+ when memblk.lsb & HMEM_STATE
+ is HMEM_MOVEABLE
+ is HMEM_LOCKED
+ memblk = memblk & HMEM_ADDR
+ if memblk->blklok & HMEM_ACCESSED
+ memblk->blklok = memblk->blklok & $7F
+ fin
+ wend
+ if sweepen == 255
+ sweepen = 0
+ if sweeppg == 0
+ sweeppg = PG_TBL_SIZE - 1
+ else
+ sweeppg = sweeppg - 1
+ fin
+ else
+ sweepen = sweepen + 1
+ fin
else
sweeppg = PG_TBL_SIZE - 1
fin
@@ -517,7 +440,7 @@ end
//
export def brk(addr)
word heapalign, brkblk, brksiz, srch
-
+
//
// Check if addr is too high or low
//
@@ -525,44 +448,44 @@ export def brk(addr)
if isule(addr, heapmark); return 0; fin
if not pooladdr
//
- // Allocate the memory pool
- //
+ // Allocate the memory pool
+ //
heapalign = (heapmark | MIN_BLK_MASK) + 1
- brksiz = addr - heapalign
- if isult(brksiz, MAX_BLK_SIZE); return 0; fin // Not enough heap
- poolsize = addr - heapmark
- pooladdr = heapalloc(poolsize)
- if pooladdr
- frelst = heapalign
- frelst=>fresiz = brksiz
- frelst=>frenxt = 0
+ brksiz = addr - heapalign
+ if isult(brksiz, MAX_BLK_SIZE); return 0; fin // Not enough heap
+ poolsize = addr - heapmark
+ pooladdr = heapalloc(poolsize)
+ if pooladdr
+ frelst = heapalign
+ frelst=>fresiz = brksiz
+ frelst=>frenxt = 0
+ else
+ poolsize = 0
+ fin
else
- poolsize = 0
- fin
- else
//
- // Can we extend the memory pool?
- //
- if pooladdr + poolsize == heapmark
- brksiz = addr - heapmark
+ // Can we extend the memory pool?
+ //
+ if pooladdr + poolsize == heapmark
+ brksiz = addr - heapmark
brkblk = heapalloc(brksiz)
if brkblk
- //
- // Add block to end of free list
- //
+ //
+ // Add block to end of free list
+ //
poolsize = poolsize + brksiz
- brkblk=>fresiz = brksiz
- brkblk=>frenxt = 0
- if frelst
- srch = frelst
- while srch=>frenxt; srch = srch=>frenxt; loop
- srch=>frenxt = brkblk
- else
- frelst = brkblk
- fin
+ brkblk=>fresiz = brksiz
+ brkblk=>frenxt = 0
+ if frelst
+ srch = frelst
+ while srch=>frenxt; srch = srch=>frenxt; loop
+ srch=>frenxt = brkblk
+ else
+ frelst = brkblk
+ fin
coallesce // combine adjacent free space
- fin
- fin
+ fin
+ fin
fin
return poolsize
end
@@ -575,7 +498,7 @@ end
//
export def hmemFre(lptr)
word srch, free, largest
-
+
coallesce
while compact; loop
free = 0
@@ -599,7 +522,7 @@ end
//
export def hmemNew(size)
word page, entry, hnew, memblk
-
+
//
// First, find a free handle
//
@@ -609,33 +532,33 @@ export def hmemNew(size)
// Allocate a new page table
//
hpgtbl[page] = heapalloc(PG_SIZE)
- memset(hpgtbl[page], HMEM_AVAIL, PG_SIZE)
+ memset(hpgtbl[page], HMEM_AVAIL, PG_SIZE)
//puts(@allocpgstr);puth(hpgtbl[page]);putln
- //
- // Check if we need to allocate the memory pool
- //
- if not pooladdr
- //
- // Allocate 3/4 of available heap on 128K machine, 1/2 on 64K machine
- //
- poolsize = ((@page - heapmark) >> 1) & $7FFF
- if MACHID & $30 == $30
- poolsize = poolsize + (poolsize >> 1)
- fin
+ //
+ // Check if we need to allocate the memory pool
+ //
+ if not pooladdr
+ //
+ // Allocate 3/4 of available heap on 128K machine, 1/2 on 64K machine
+ //
+ poolsize = ((@page - heapmark) >> 1) & $7FFF
+ if MACHID & $30 == $30
+ poolsize = poolsize + (poolsize >> 1)
+ fin
if isult(poolsize, MAX_BLK_SIZE)
poolsize = MAX_BLK_SIZE
fin
- sbrk(poolsize)
- fin
+ sbrk(poolsize)
+ fin
fin
for entry = 255 downto 0
if hpgtbl:[page, entry].lsb == HMEM_AVAIL
//
// Reserve handle as swapped out block
- // Nonzero size will flag swapin to not read from disk
+ // Nonzero size will flag swapin to not read from disk
//
//putc('N');putc(' ');putb(entry);putb(page);putc('@')
- size = ((size + t_memblk) | MIN_BLK_MASK) + 1
+ size = ((size + t_memblk) | MIN_BLK_MASK) + 1
hpgtbl:[page, entry] = size | HMEM_SWAPPED
hnew.lsb = page
hnew.msb = entry
@@ -649,39 +572,39 @@ end
//
export def hmemLock(hmem)
word memblk
-
+
memblk = hpgtbl:[hmem.lsb, hmem.msb]
when memblk.lsb & HMEM_STATE
is HMEM_SWAPPED
- memblk = swapin(hmem)
- if not memblk; return 0; fin
- is HMEM_MOVEABLE
- hpgtbl:[hmem.lsb, hmem.msb] = memblk | HMEM_LOCKED
+ memblk = swapin(hmem)
+ if not memblk; return 0; fin
+ is HMEM_MOVEABLE
+ hpgtbl:[hmem.lsb, hmem.msb] = memblk | HMEM_LOCKED
is HMEM_LOCKED
- memblk = memblk & HMEM_ADDR
- memblk->blklok = (memblk->blklok + 1) | HMEM_ACCESSED
+ memblk = memblk & HMEM_ADDR
+ memblk->blklok = (memblk->blklok + 1) | HMEM_ACCESSED
//putc('L');putc(' ');puth(hmem);putc('@');puth(memblk);putln
- return memblk + t_memblk
+ return memblk + t_memblk
wend
end
//
// Unlock memory block
//
-export def hmemUnlock(hmem)
+export def hmemUnlock(hmem)#0
byte lock
word memblk
-
+
memblk = hpgtbl:[hmem.lsb, hmem.msb]
if memblk.lsb & HMEM_STATE == HMEM_LOCKED
memblk = memblk & HMEM_ADDR
- lock = memblk->blklok - 1
- if lock == HMEM_ACCESSED
- //
- // Block is now moveable
- //
- hpgtbl:[hmem.lsb, hmem.msb] = memblk
- fin
- memblk->blklok = lock
+ lock = memblk->blklok - 1
+ if lock == HMEM_ACCESSED
+ //
+ // Block is now moveable
+ //
+ hpgtbl:[hmem.lsb, hmem.msb] = memblk
+ fin
+ memblk->blklok = lock
//putc('U');putc(' ');puth(hmem);putln
fin
end
@@ -690,16 +613,16 @@ end
//
export def hmemRef(hmem)
word memblk
-
+
memblk = hpgtbl:[hmem.lsb, hmem.msb]
when memblk.lsb & HMEM_STATE
is HMEM_SWAPPED
- memblk = swapin(hmem)
+ memblk = swapin(hmem)
is HMEM_LOCKED
- is HMEM_MOVEABLE
- memblk = memblk & HMEM_ADDR
- if not memblk; return 0; fin
- memblk->blkref = memblk->blkref + 1
+ is HMEM_MOVEABLE
+ memblk = memblk & HMEM_ADDR
+ if not memblk; return; fin
+ memblk->blkref = memblk->blkref + 1
wend
end
//
@@ -708,26 +631,26 @@ end
export def hmemDel(hmem)
byte ref
word memblk
-
+
memblk = hpgtbl:[hmem.lsb, hmem.msb]
when memblk & HMEM_STATE
is HMEM_SWAPPED
memblk = swapin(hmem)
is HMEM_LOCKED
- is HMEM_MOVEABLE
- memblk = memblk & HMEM_ADDR
- if not memblk; return 0; fin
- ref = memblk->blkref - 1
- if ref == 0
- //
- // No more references, free block
- //
- hpgtbl:[hmem.lsb, hmem.msb] = HMEM_AVAIL
- addfre(memblk)
- else
- memblk->blkref = ref
- fin
- break
+ is HMEM_MOVEABLE
+ memblk = memblk & HMEM_ADDR
+ if not memblk; return 0; fin
+ ref = memblk->blkref - 1
+ if ref == 0
+ //
+ // No more references, free block
+ //
+ hpgtbl:[hmem.lsb, hmem.msb] = HMEM_AVAIL
+ addfre(memblk)
+ else
+ memblk->blkref = ref
+ fin
+ break
wend
end
//
@@ -738,7 +661,7 @@ end
initdata = heapmark // Use data at top of heap for initialization
initdata=>volparms.0 = 2
initdata=>volparms.1 = 0
-initdata=>volparms:2 = iobuffer
+initdata=>volparms:2 = sysbuf
syscall($C5, @initdata=>volparms)
initdata=>volptr = iobuffer
initdata=>ramfree = 0
@@ -749,16 +672,16 @@ for sweepen = 0 to 15
memcpy(@swapvol + 2, initdata=>volptr + 1, ^initdata=>volptr)
swapvol = ^initdata=>volptr + 1
get_info(@swapvol, @initdata->volinfo)
- initdata=>freeblks = initdata=>volinfo:2 - initdata=>volinfo:5
- if initdata=>volptr:1 == $522F and initdata=>volptr:3 == $4D41 // '/RAM'
- if isugt(initdata=>freeblks, initdata=>ramfree)
- initdata=>ramvol = initdata=>volptr
- initdata=>ramfree = initdata=>freeblks
- fin
- elsif isugt(initdata=>freeblks, initdata=>bestfree)
- initdata=>bestvol = initdata=>volptr
- initdata=>bestfree = initdata=>freeblks
- fin
+ initdata=>freeblks = initdata=>volinfo:2 - initdata=>volinfo:5
+ if initdata=>volptr:1 == $522F and initdata=>volptr:3 == $4D41 // '/RAM'
+ if isugt(initdata=>freeblks, initdata=>ramfree)
+ initdata=>ramvol = initdata=>volptr
+ initdata=>ramfree = initdata=>freeblks
+ fin
+ elsif isugt(initdata=>freeblks, initdata=>bestfree)
+ initdata=>bestvol = initdata=>volptr
+ initdata=>bestfree = initdata=>freeblks
+ fin
fin
initdata=>volptr = initdata=>volptr + 16
next
@@ -780,27 +703,27 @@ initdata->swapstrlen = swapvol
repeat
if read(initdata->catref, @initdata->catalog, 512) == 512
initdata=>catentry = @initdata->catalog.4
- if initdata->firstblk
- initdata->entrylen = initdata->catalog.$23
- initdata->entriesblk = initdata->catalog.$24
- initdata=>filecnt = initdata=>catalog:$25
- initdata=>catentry = initdata=>catentry + initdata->entrylen
+ if initdata->firstblk
+ initdata->entrylen = initdata->catalog.$23
+ initdata->entriesblk = initdata->catalog.$24
+ initdata=>filecnt = initdata=>catalog:$25
+ initdata=>catentry = initdata=>catentry + initdata->entrylen
fin
- for sweepen = initdata->firstblk to initdata->entriesblk
- ^initdata=>catentry = ^initdata=>catentry & $0F
- if ^initdata=>catentry
+ for sweepen = initdata->firstblk to initdata->entriesblk
+ ^initdata=>catentry = ^initdata=>catentry & $0F
+ if ^initdata=>catentry
memcpy(@swapvol + swapvol + 1, initdata=>catentry + 1, ^initdata=>catentry)
swapvol = swapvol + ^initdata=>catentry
- destroy(@swapvol)
+ destroy(@swapvol)
swapvol = initdata->swapstrlen
- fin
- initdata=>catentry = initdata=>catentry + initdata->entrylen
+ fin
+ initdata=>catentry = initdata=>catentry + initdata->entrylen
next
- initdata->firstblk = 0
+ initdata->firstblk = 0
else
initdata->filecnt = 0
fin
until !initdata->filecnt
close(initdata->catref)
//puts(@swapvol); putln
-done
\ No newline at end of file
+done
diff --git a/src/libsrc/portio.pla b/src/libsrc/portio.pla
index 57088e6..23e4d4e 100644
--- a/src/libsrc/portio.pla
+++ b/src/libsrc/portio.pla
@@ -1,13 +1,7 @@
//
// Game port I/O library based on the wiring library
//
-import cmdsys
- predef syscall, call, getc, gets, putc, puts, putln
- predef memset, memcpy, modaddr, modexec
- predef heapmark, heapallocalign, heapalloc, heaprelease
- predef isugt, isuge, isult, isule
- byte MACHID
-end
+include "inc/cmdsys.plh"
const ANN0 = $C058
const ANN1 = $C05A
diff --git a/src/libsrc/sdfat.pla b/src/libsrc/sdfat.pla
index 2f6fd7d..9c1d68d 100644
--- a/src/libsrc/sdfat.pla
+++ b/src/libsrc/sdfat.pla
@@ -1,7 +1,5 @@
+include "inc/cmdsys.plh"
include "inc/spiport.plh"
-import cmdsys
- predef call, putc, puts, putln
-end
//
// FAT I/O object
@@ -21,7 +19,7 @@ word[] = @size, @truncate, @isDir, @isFile
//
def cwd(pathname)
byte namelen
-
+
namelen = 0
spiSend(15) // CWD
namelen = spiRecv
@@ -55,7 +53,7 @@ end
def openDir(cmd, filename)
byte namelen
-
+
namelen = 0
spiSend(cmd)
namelen = spiRecv
@@ -148,4 +146,4 @@ end
//
spiSend(14) // SDINIT
return spiReady <> 0 // Is Arduino READY?
-done
\ No newline at end of file
+done
diff --git a/src/libsrc/spiport.pla b/src/libsrc/spiport.pla
index 405034f..7129cd2 100644
--- a/src/libsrc/spiport.pla
+++ b/src/libsrc/spiport.pla
@@ -1,6 +1,4 @@
-import cmdsys
- predef call, putc, puts, putln
-end
+include "inc/cmdsys.plh"
//
// Bit banged spi over gameport
//
diff --git a/src/libsrc/uthernet.pla b/src/libsrc/uthernet.pla
index 4d22a1f..6340c2e 100644
--- a/src/libsrc/uthernet.pla
+++ b/src/libsrc/uthernet.pla
@@ -1,13 +1,7 @@
//
// Original Uthernet ethernet card based on Cirrus Logic cs8900a
//
-import cmdsys
- predef syscall, call, getc, gets, putc, puts, putln
- predef isugt, isuge, isult, isule
- predef memset, memcpy, modaddr, modexec
- predef heapmark, heapallocalign, heapalloc, heaprelease, heapavail
- byte MACHID
-end
+include "inc/cmdsys.plh"
//
// Include dependency on S/W IP stack
//
diff --git a/src/libsrc/uthernet2.pla b/src/libsrc/uthernet2.pla
index c6316e8..a201c30 100644
--- a/src/libsrc/uthernet2.pla
+++ b/src/libsrc/uthernet2.pla
@@ -4,13 +4,7 @@
// TCP/IP is built into hardware, so no dependencies on the software
// layers, like the Uthernet
//
-import cmdsys
- predef syscall, call, getc, gets, putc, puts, putln
- predef isugt, isuge, isult, isule
- predef memset, memcpy, modaddr, modexec
- predef heapmark, heapallocalign, heapalloc, heaprelease, heapavail
- byte MACHID
-end
+include "inc/cmdsys.plh"
//
// Net object
//
@@ -417,7 +411,7 @@ def pokeregw(reg, dataw)
end
def peekregw(reg)
word dataw
-
+
_pokeiow(reg)
dataw.1 = _peekio()
_pokeiow(reg + 1)
@@ -429,7 +423,7 @@ end
//
def wizSendUDP(wiz, ipdst, portdst, data, len)
word wizregs, wizdata, txrr, txwr, splitlen
-
+
wizregs = wiz=>channel_regs
wizdata = wiz=>channel_txmem
if !ipdst
@@ -633,7 +627,7 @@ end
//
def wizSendTCP(wiz, data, len)
word wizregs, wizdata, txrr, txwr, splitlen
-
+
if wiz->channel_state <> TCP_STATE_OPEN; return -1; fin
wizregs = wiz=>channel_regs
wizdata = wiz=>channel_txmem
@@ -717,7 +711,7 @@ end
def wizServiceIP
word wiz, wizregs, wizdata, rxlen, rxrr, rxwr, rxpkt, splitlen
byte ir, i, sir
-
+
ir = peekreg(WIZ_IR)
if ir
wiz = @wizChannel
diff --git a/src/libsrc/wiznet.pla b/src/libsrc/wiznet.pla
index bff544e..7260104 100644
--- a/src/libsrc/wiznet.pla
+++ b/src/libsrc/wiznet.pla
@@ -4,13 +4,7 @@
// TCP/IP is built into hardware, so no dependencies on the software
// layers, like the Uthernet
//
-import cmdsys
- predef syscall, call, getc, gets, putc, puts, putln
- predef isugt, isuge, isult, isule
- predef memset, memcpy, modaddr, modexec
- predef heapmark, heapallocalign, heapalloc, heaprelease, heapavail
- byte MACHID
-end
+include "inc/cmdsys.plh"
//
// Net object
//
@@ -426,7 +420,7 @@ def pokeregw(reg, dataw)
end
def peekregw(reg)
word dataw
-
+
_pokeiow(reg)
dataw.1 = _peekio()
_pokeiow(reg + 1)
@@ -456,7 +450,7 @@ def puti(i)
end
def putip(ipptr)
byte i
-
+
for i = 0 to 2
puti(ipptr->[i]); putc('.')
next
@@ -467,7 +461,7 @@ end
//
def wizSendUDP(wiz, ipdst, portdst, data, len)
word wizregs, wizdata, txrr, txwr, splitlen
-
+
wizregs = wiz=>channel_regs
wizdata = wiz=>channel_txmem
if !ipdst
@@ -678,7 +672,7 @@ end
//
def wizSendTCP(wiz, data, len)
word wizregs, wizdata, txrr, txwr, splitlen
-
+
if wiz->channel_state <> TCP_STATE_OPEN; return -1; fin
//putc('W');puti(len);putc(':')
wizregs = wiz=>channel_regs
@@ -715,7 +709,7 @@ def wizCloseTCP(wiz)
//
// Clear notiications on this port
//
- if wiz->channel_proto == WIZ_PROTO_TCP and (wiz->channel_state == TCP_STATE_OPEN or wiz->channel_state == TCP_STATE_CLOSING)
+ if wiz->channel_proto == WIZ_PROTO_TCP and (wiz->channel_state == TCP_STATE_OPEN or wiz->channel_state == TCP_STATE_CLOSING)
wiz->channel_state = TCP_STATE_CLOSING
pokereg(wiz=>channel_regs + WIZ_SnCR, $08) // DISCON
repeat
@@ -768,7 +762,7 @@ end
def wizServiceIP
word wiz, wizregs, wizdata, rxlen, rxrr, rxwr, rxpkt, splitlen
byte ir, i, sir
-
+
ir = peekreg(WIZ_IR)
if ir and ir <> $FF // Ignore spurious read of IR
//putc('I');putb(ir)
@@ -868,7 +862,7 @@ def wizServiceIP
// Write TCP socket OK
//
//fin
- break
+ break
is WIZ_PROTO_UDP
//putc('U');putb(sir)
if sir & $04
@@ -911,7 +905,7 @@ def wizServiceIP
//
pokereg(WIZ_IR, ir)
fin
- fin
+ fin
end
//
// Set the local IP addresses
diff --git a/src/mockingboard/seqplay.pla b/src/mockingboard/seqplay.pla
index c192206..a72f3ee 100755
--- a/src/mockingboard/seqplay.pla
+++ b/src/mockingboard/seqplay.pla
@@ -93,9 +93,6 @@ word[5] arpeggioDuration = DUR16TH, DUR16TH, DUR16TH/2, DUR16TH/3, DUR16TH/4
//
word arg
word ref
-asm defs
- !SOURCE "../vmsrc/plvmzp.inc"
-end
///////////////////////////////////////////////////////////////////////////////
//
// Emulators are broken - they only activate the MockingBoard's 6522 Timer1
@@ -105,6 +102,9 @@ end
// disabled. NO INTERRUPTS ARE HANDLED WHEN PLAYING MUSIC! The previous state
// is restored between playing sequences.
//
+asm vmincs
+ !SOURCE "../vmsrc/plvmzp.inc"
+end
asm getStatusReg#1
PHP
PLA
diff --git a/src/samplesrc/hello.pla b/src/samplesrc/hello.pla
index 61c3725..bb39d48 100644
--- a/src/samplesrc/hello.pla
+++ b/src/samplesrc/hello.pla
@@ -1,6 +1,4 @@
-import cmdsys
- predef puts
-end
+include "inc/cmdsys.plh"
puts("Hello, world.\n")
done
diff --git a/src/samplesrc/hgr1.pla b/src/samplesrc/hgr1.pla
index c16fed3..d8d4ea4 100644
--- a/src/samplesrc/hgr1.pla
+++ b/src/samplesrc/hgr1.pla
@@ -1,17 +1,4 @@
-import cmdsys
- predef memset
- //
- // System flags: memory allocator screen holes.
- //
- const restxt1 = $0001
- const restxt2 = $0002
- const resxtxt1 = $0004
- const resxtxt2 = $0008
- const reshgr1 = $0010
- const reshgr2 = $0020
- const resxhgr1 = $0040
- const resxhgr2 = $0080
-end
+include "inc/cmdsys.plh"
sysflags reshgr1 // Reserve HGR page 1
@@ -20,4 +7,4 @@ memset($2000, 0, $2000) // Clear HGR page 1
^$C052
^$C057
^$C050
-done
\ No newline at end of file
+done
diff --git a/src/samplesrc/hgr1test.pla b/src/samplesrc/hgr1test.pla
index 278a437..6c19402 100644
--- a/src/samplesrc/hgr1test.pla
+++ b/src/samplesrc/hgr1test.pla
@@ -1,8 +1,4 @@
-import cmdsys
- predef memset, memcpy, heapalloc, heapmark, heaprelease
- predef puts, putc, gets, getc
- predef isugt, isuge, isult, isule
-end
+include "inc/cmdsys.plh"
import HGR1
end
diff --git a/src/samplesrc/httpd.pla b/src/samplesrc/httpd.pla
index f8b236a..edaa382 100644
--- a/src/samplesrc/httpd.pla
+++ b/src/samplesrc/httpd.pla
@@ -8,13 +8,7 @@
// - check for binary files and set Content-Type accordingly
// still todo: output base filename for Content-Disposition header
//
-import cmdsys
- predef syscall, call, getc, gets, putc, puts, putln
- predef memset, memcpy, modaddr, modexec
- predef isugt, isuge, isult, isule
- predef heapmark, heapallocalign, heapalloc, heaprelease
- byte MACHID
-end
+include "inc/cmdsys.plh"
//
// Net object
//
@@ -116,7 +110,7 @@ def read(refnum, buff, len)
end
def get_eof(refnum)
byte params[5]
-
+
params.0 = 2
params.1 = refnum
params:2 = 0
@@ -125,7 +119,7 @@ def get_eof(refnum)
return params:2
end
def get_file_info(path)
-
+
fileInfo.0 = 10 // param count
fileInfo:1 = path // path name
@@ -155,7 +149,7 @@ def puti(i)
end
def putip(ipptr)
byte i
-
+
for i = 0 to 2
puti(ipptr->[i]); putc('.')
next
@@ -163,7 +157,7 @@ def putip(ipptr)
end
def dumpbytes(buf, len)
word i
-
+
for i = 0 to len - 1
putb(buf->[i])
if i & 15 == 15
@@ -175,7 +169,7 @@ def dumpbytes(buf, len)
end
def dumpchars(buf, len)
word i
-
+
len = len - 1
for i = 0 to len
putc(buf->[i])
@@ -194,7 +188,7 @@ def itos(dst, i)
if i < 0; ^dst = '-'; i = -i; dst = dst + 1; fin
if i < 10
^dst = i + '0'
- else
+ else
dst = itos(dst, i / 10)
^dst = i % 10 + '0'
fin
@@ -247,7 +241,7 @@ def servHTTP(remip, remport, lclport, data, len, param)
url->1 = url->0 - 1
url = url + 1
fin
- fin
+ fin
strcat(@filename, @prefix, url)
puts("GET:"); puts(@filename);putln
//
@@ -271,7 +265,7 @@ def servHTTP(remip, remport, lclport, data, len, param)
//
//puts(@mimeTextHtml) // debug
strcat(@okhdr, @okhdr, @httpContentType)
- strcat(@okhdr, @okhdr, @mimeTextHtml)
+ strcat(@okhdr, @okhdr, @mimeTextHtml)
else
//
// send as binary attachment
@@ -285,7 +279,7 @@ def servHTTP(remip, remport, lclport, data, len, param)
//
strcat(@okhdr, @okhdr, @httpContentAttach)
// todo: get the base filename...
- fin
+ fin
strcat(@okhdr, @okhdr, @httpEnd)
//dumpchars(@okhdr + 1, okhdr) // debug
iNet:sendTCP(socketHTTP, @okhdr + 1, okhdr) // send HTTP response header to client
@@ -313,8 +307,8 @@ getpfx(@prefix)
//
// Alloc aligned file/io buffers
//
-filebuff = heapallocalign(1024, 8, 0)
-iobuff = heapallocalign(1024, 8, 0)
+filebuff = heapallocalign(1024, 8, 0)
+iobuff = heapallocalign(1024, 8, 0)
//
// Service IP
//
@@ -329,4 +323,4 @@ repeat
until ^$C000 > 127
^$C010
-done
\ No newline at end of file
+done
diff --git a/src/samplesrc/memtest.pla b/src/samplesrc/memtest.pla
index e055a73..238a634 100644
--- a/src/samplesrc/memtest.pla
+++ b/src/samplesrc/memtest.pla
@@ -1,10 +1,4 @@
-import cmdsys
- predef syscall, call, memset, getc, gets, putc, puts, putln
- predef memset, memcpy, modaddr, modexec
- predef heapmark, heapallocalign, heapalloc, heaprelease
- predef isugt, isuge, isult, isule
- byte MACHID
-end
+include "inc/cmdsys.plh"
import memmgr
predef sweep, brk, sbrk
predef hmemNew, hmemLock, hmemUnlock, hmemRef, hmemDel, hmemFre
@@ -76,4 +70,4 @@ if memptr; puth(e); putc('='); puth(*memptr); putln; fin
hmemUnlock(e)
hmemDel(e)
memfre=hmemFre(@memlrgst);puth(memfre); putc(' '); puth(memlrgst); putln
-done
\ No newline at end of file
+done
diff --git a/src/samplesrc/mon.pla b/src/samplesrc/mon.pla
index 3b49838..d3bf2b9 100644
--- a/src/samplesrc/mon.pla
+++ b/src/samplesrc/mon.pla
@@ -1,10 +1,4 @@
-import cmdsys
- predef syscall, call, memset, getc, gets, putc, puts, putln
- predef memset, memcpy, modaddr, modexec
- predef heapmark, heapallocalign, heapalloc, heaprelease
- predef isugt, isuge, isult, isule
- byte MACHID
-end
+include "inc/cmdsys.plh"
byte bye = $20, $00, $BF, $65
word paramsptr
byte[7] params = 4
@@ -22,4 +16,4 @@ paramsptr = @params
// Call into monitor
//
call(-151, 0, 0, 0, 0)
-done
\ No newline at end of file
+done
diff --git a/src/samplesrc/rod.pla b/src/samplesrc/rod.pla
index 3582751..ab357e6 100644
--- a/src/samplesrc/rod.pla
+++ b/src/samplesrc/rod.pla
@@ -1,7 +1,4 @@
-import cmdsys
- predef syscall(f,p)#1, call(adr,a,x,y,p)#1, memset(d,s,l)#1, getc#1, putc(c)#1, puts(s)#1, modaddr(a)#1
- byte MACHID
-end
+include "inc/cmdsys.plh"
//
// Handy constants.
//
diff --git a/src/samplesrc/rogue.combat.pla b/src/samplesrc/rogue.combat.pla
index 5af63cf..d2c3fef 100644
--- a/src/samplesrc/rogue.combat.pla
+++ b/src/samplesrc/rogue.combat.pla
@@ -1,9 +1,4 @@
-import cmdsys
- predef syscall, call, memset, getc, putc, puts, putln
- predef memset, memcpy
- predef heapmark, heapallocalign, heapalloc, heaprelease, heapavail
- byte MACHID
-end
+include "inc/cmdsys.plh"
import ROGUEMAP
predef puti, toupper, moveplayer
diff --git a/src/samplesrc/rogue.io.pla b/src/samplesrc/rogue.io.pla
index e9f2e4f..006c1d3 100644
--- a/src/samplesrc/rogue.io.pla
+++ b/src/samplesrc/rogue.io.pla
@@ -1,9 +1,4 @@
-import cmdsys
- predef syscall, call, getc, putc, puts, putln
- predef memset, memcpy, modaddr
- predef heapmark, heapallocalign, heapalloc, heaprelease, heapavail
- byte MACHID
-end
+include "inc/cmdsys.plh"
const modkeep = $2000
const modinitkeep = $4000
@@ -279,4 +274,4 @@ while ^titlestr
titlestr = titlestr + ^titlestr + 1
loop
-done
\ No newline at end of file
+done
diff --git a/src/samplesrc/rogue.map.pla b/src/samplesrc/rogue.map.pla
index 774a62e..6794daf 100644
--- a/src/samplesrc/rogue.map.pla
+++ b/src/samplesrc/rogue.map.pla
@@ -1,12 +1,7 @@
//
// Map module
//
-import cmdsys
- predef syscall, call, getc, putc, puts, putln
- predef memset, memcpy, modaddr
- predef heapmark, heapallocalign, heapalloc, heaprelease, heapavail
- byte MACHID
-end
+include "inc/cmdsys.plh"
import rogueio
const O_READ = 1
@@ -767,4 +762,4 @@ export def drawvisentity(xofst, yofst, tile)
fin
end
-done
\ No newline at end of file
+done
diff --git a/src/samplesrc/rogue.pla b/src/samplesrc/rogue.pla
index be37d78..02780fc 100755
--- a/src/samplesrc/rogue.pla
+++ b/src/samplesrc/rogue.pla
@@ -1,9 +1,4 @@
-import cmdsys
- predef syscall, call, memset, getc, gets, putc, puts, putln
- predef memset, memcpy
- predef heapmark, heapallocalign, heapalloc, heaprelease, heapavail
- byte MACHID
-end
+include "inc/cmdsys.plh"
import roguemap
const xcentr = 20
@@ -238,7 +233,7 @@ end
def moveplayer(dir)
byte xmove, ymove
-
+
xmove = player.xpos + dir * xdir[player.angle]
ymove = player.ypos + dir * ydir[player.angle]
when getmaptile(xmove, ymove) & MAP_TILE
@@ -666,4 +661,3 @@ else
fin
puts(@againstr)
done
-
diff --git a/src/samplesrc/sieve.pla b/src/samplesrc/sieve.pla
index 7eee507..364563f 100644
--- a/src/samplesrc/sieve.pla
+++ b/src/samplesrc/sieve.pla
@@ -1,7 +1,4 @@
-import cmdsys
- predef syscall, call, memset, getc, putc, puts, putln
- byte MACHID
-end
+include "inc/cmdsys.plh"
const FALSE = 0
const TRUE = !FALSE
@@ -48,4 +45,4 @@ beep
beep
puti(count)
puts(@strPrimes)
-done
\ No newline at end of file
+done
diff --git a/src/toolsrc/ed.pla b/src/toolsrc/ed.pla
index ed8ab61..eb7a518 100755
--- a/src/toolsrc/ed.pla
+++ b/src/toolsrc/ed.pla
@@ -1,26 +1,24 @@
+//=====================================
//
-// Global constants
+// Text Editor
//
-const false = 0
-const true = 1
+//=====================================
+
+include "inc/cmdsys.plh"
+include "inc/args.plh"
+include "inc/fileio.plh"
//
// Hardware constants
//
const csw = $0036
-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 pushbttn1 = $C061
const pushbttn2 = $C062
const pushbttn3 = $C063
const keyboard = $C000
const keystrobe = $C010
+//
+// ASCII key values
+//
const keyenter = $8D
const keyspace = $A0
const keyarrowup = $8B
@@ -50,21 +48,16 @@ const keyctrlw = $97
const keyctrlx = $98
const keyctrlz = $9A
const keydelete = $FF
+//
+// Input buffer
+//
const getbuff = $01FF
//
// Data and text buffer constants
//
-const machid = $BF98
const maxlines = 1500
const maxfill = 1524
-const iobuffer = $0800
-const databuff = $0C00
-const strlinbuf = $1000
-const strheapmap = $1F00
-const strheapmsz = 224 // $E0 = 28K is memory@16 bytes per bit map, 128 bytes per 8 bit map, 1K bytes per 8 byte map
const maxlnlen = 79
-const strheap = $4800
-const strheasz = $7000
const pgjmp = 16
const changed = 1
const insmode = 2
@@ -72,12 +65,6 @@ const showcurs = 4
const uppercase = 8
const shiftlock = 128
//
-// Argument buffer
-//
-word = $EEEE
-byte = 32 // buffer length
-byte[32] argbuff = ""
-//
// Text screen row address array
//
word txtscrn = $0400,$0480,$0500,$0580,$0600,$0680,$0700,$0780
@@ -87,13 +74,12 @@ word = $0450,$04D0,$0550,$05D0,$0650,$06D0,$0750,$07D0
// Editor variables
//
byte nullstr = ""
-byte version = "PLASMA ][ EDITOR VERSION 0.9 "
-byte errorstr = "ERROR: $"
-byte okstr = "OK"
-byte outofmem = "OUT OF MEMORY!"
-byte losechng = "LOSE CHANGES TO FILE (Y/N)?"
-byte untitled = "UNTITLED"
-byte[64] txtfile = "UNTITLED.PLA"
+byte[64] txtfile = "UNTITLED"
+word strlinbuf = $1000
+word strpoolmap = $1F00
+word strpoolmsz = 224 // $E0 = 28K is memory@16 bytes per bit map, 128 bytes per 8 bit map, 1K bytes per 8 byte map
+word strpool = $4800
+word strpoolsz = $7000
byte flags = 0
byte flash = 0
word numlines = 0
@@ -110,267 +96,9 @@ predef cmdmode
// Defines for ASM routines
//
asm equates
-INTERP = $03D0
-LCRDEN = $C080
-LCWTEN = $C081
-ROMEN = $C082
-LCRWEN = $C083
-LCBNK2 = $00
-LCBNK1 = $08
!SOURCE "vmsrc/plvmzp.inc"
end
-//
-// CALL 6502 ROUTINE
-// CALL(ADDR, AREG, XREG, YREG, STATUS)
-//
-asm call
-REGVALS = SRC
- PHP
- LDA ESTKL+4,X
- STA TMPL
- LDA ESTKH+4,X
- STA TMPH
- LDA ESTKL,X
- PHA
- LDA ESTKL+1,X
- TAY
- LDA ESTKL+3,X
- PHA
- LDA ESTKL+2,X
- INX
- INX
- INX
- INX
- STX ESP
- TAX
- PLA
- BIT ROMEN
- PLP
- JSR JMPTMP
- PHP
- BIT LCRDEN+LCBNK2
- STA REGVALS+0
- STX REGVALS+1
- STY REGVALS+2
- PLA
- STA REGVALS+3
- LDX ESP
- LDA #<REGVALS
- LDY #>REGVALS
- STA ESTKL,X
- STY ESTKH,X
- PLP
- RTS
-JMPTMP JMP (TMP)
-end
-//
-// CALL PRODOS
-// SYSCALL(CMD, PARAMS)
-//
-asm syscall
- LDA ESTKL,X
- LDY ESTKH,X
- STA PARAMS
- STY PARAMS+1
- INX
- LDA ESTKL,X
- STA CMD
- JSR $BF00
-CMD: !BYTE 00
-PARAMS: !WORD 0000
- LDY #$00
- STA ESTKL,X
- STY ESTKH,X
- RTS
-end
-// SET MEMORY TO VALUE
-// MEMSET(ADDR, SIZE, VALUE)
-// With optimizations from Peter Ferrie
-//
-asm memset
- LDY #$00
- LDA ESTKL+2,X
- STA DSTL
- LDA ESTKH+2,X
- STA DSTH
- INC ESTKL+1,X
- INC ESTKH+1,X
-SETMLPL CLC
- LDA ESTKL,X
-SETMLPH DEC ESTKL+1,X
- BNE +
- DEC ESTKH+1,X
- BEQ SETMEX
-+ STA (DST),Y
- INY
- BNE +
- INC DSTH
-+ BCS SETMLPL
- SEC
- LDA ESTKH,X
- BCS SETMLPH
-SETMEX INX
- INX
- RTS
-end
-//
-// COPY MEMORY
-// MEMCPY(DSTADDR, SRCADDR, SIZE)
-//
-asm memcpy
- INX
- INX
- LDA ESTKL-2,X
- ORA ESTKH-2,X
- BEQ CPYMEX
- LDA ESTKL-1,X
- CMP ESTKL,X
- LDA ESTKH-1,X
- SBC ESTKH,X
- BCC REVCPY
-;
-; FORWARD COPY
-;
- LDA ESTKL,X
- STA DSTL
- LDA ESTKH,X
- STA DSTH
- LDA ESTKL-1,X
- STA SRCL
- LDA ESTKH-1,X
- STA SRCH
- INC ESTKH-2,X
- LDY #$00
-FORCPYLP LDA (SRC),Y
- STA (DST),Y
- INY
- BNE +
- INC DSTH
- INC SRCH
-+ DEC ESTKL-2,X
- BNE FORCPYLP
- DEC ESTKH-2,X
- BNE FORCPYLP
- RTS
-;
-; REVERSE COPY
-;
-REVCPY ;CLC
- LDA ESTKL-2,X
- ADC ESTKL,X
- STA DSTL
- LDA ESTKH-2,X
- ADC ESTKH,X
- STA DSTH
- CLC
- LDA ESTKL-2,X
- ADC ESTKL-1,X
- STA SRCL
- LDA ESTKH-2,X
- ADC ESTKH-1,X
- STA SRCH
- INC ESTKH-2,X
- DEC DSTH
- DEC SRCH
- LDY #$FF
-REVCPYLP LDA (SRC),Y
- STA (DST),Y
- DEY
- CPY #$FF
- BNE +
- DEC DSTH
- DEC SRCH
-+ DEC ESTKL-2,X
- BNE REVCPYLP
- DEC ESTKH-2,X
- BNE REVCPYLP
-CPYMEX RTS
-end
-//
-// CHAR OUT
-// COUT(CHAR)
-//
-asm cout
- LDA ESTKL,X
- ORA #$80
- BIT ROMEN
- JSR $FDED
- BIT LCRDEN+LCBNK2
- RTS
-end
-//
-// CHAR IN
-// RDKEY()
-//
-asm cin
- BIT ROMEN
- JSR $FD0C
- BIT LCRDEN+LCBNK2
- DEX
- LDY #$00
- STA ESTKL,X
- STY ESTKH,X
- RTS
-end
-//
-// PRINT STRING
-// PRSTR(STR)
-//
-asm prstr
- LDY #$00
- LDA ESTKL,X
- STA SRCL
- LDA ESTKH,X
- STA SRCH
- LDA (SRC),Y
- STA TMP
- BEQ ++
- BIT ROMEN
-- INY
- LDA (SRC),Y
- ORA #$80
- JSR $FDED
- CPY TMP
- BNE -
- BIT LCRDEN+LCBNK2
-++ RTS
-end
-//
-// READ STRING
-// STR = RDSTR(PROMPTCHAR)
-//
-asm rdstr
- LDA ESTKL,X
- STA $33
- STX ESP
- BIT ROMEN
- JSR $FD6A
- BIT LCRDEN+LCBNK2
- STX $01FF
-- LDA $01FF,X
- AND #$7F
- STA $01FF,X
- DEX
- BPL -
- LDX ESP
- LDA #$FF
- STA ESTKL,X
- LDA #$01
- STA ESTKH,X
- RTS
-end
-//
-// EXIT
-//
-asm exit
- JSR $BF00
- !BYTE $65
- !WORD EXITTBL
-EXITTBL:
- !BYTE 4
- !BYTE 0
-end
-//def toupper_11(c)
+//def toupper(c)
// if c >= 'a'
// if c <= 'z'
// return c - $20
@@ -380,7 +108,7 @@ end
//end
asm toupper
LDA ESTKL,X
- AND #$7F
+ AND #$7F
CMP #'a'
BCC +
CMP #'z'+1
@@ -388,7 +116,7 @@ asm toupper
SEC
SBC #$20
+ STA ESTKL,X
- RTS
+ RTS
end
asm clrhibit(strptr)
LDA ESTKL,X
@@ -404,7 +132,7 @@ CLHILP LDA (SRC),Y
STA (SRC),Y
DEY
BNE CLHILP
-+ RTS
++ RTS
end
asm sethibit(strptr)
LDA ESTKL,X
@@ -420,14 +148,14 @@ STHILP LDA (SRC),Y
STA (SRC),Y
DEY
BNE STHILP
-+ RTS
++ RTS
end
asm cpyln(srcstr, dststr)
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
STA DSTH
- INX
+ INX
LDA ESTKL,X
STA SRCL
LDA ESTKH,X
@@ -450,112 +178,14 @@ CPLNLP LDA (SRC),Y
BNE CPLNLP
LDA (SRC),Y
++ STA (DST),Y
- RTS
+ RTS
end
-//
-// ProDOS routines
-//
-def getpfx(path)
- byte params[3]
-
- ^path = 0
- params.0 = 1
- params:1 = path
- 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 open(path, buff)
- byte params[6]
-
- params.0 = 3
- params:1 = path
- params:3 = buff
- params.5 = 0
- perr = syscall($C8, @params)
- return params.5
-end
-def close(refnum)
- byte params[2]
-
- params.0 = 1
- params.1 = refnum
- perr = syscall($CC, @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[8]
-
- params.0 = 4
- params.1 = refnum
- params:2 = buff
- params:4 = len
- params:6 = 0
- perr = syscall($CB, @params)
- return params:6
-end
-def create(path, access, type, aux)
- byte params[12]
-
- params.0 = 7
- params:1 = path
- params.3 = access
- params.4 = type
- params:5 = aux
- params.7 = $1
- params:8 = 0
- params:10 = 0
- perr = syscall($C0, @params)
- return perr
-end
-def destroy(path)
- byte params[12]
-
- params.0 = 1
- params:1 = path
- perr = syscall($C1, @params)
- return perr
-end
-def newline(refnum, emask, nlchar)
- byte params[4]
-
- params.0 = 3
- params.1 = refnum
- params.2 = emask
- params.3 = nlchar
- perr = syscall($C9, @params)
- return perr
-end
-
-//=====================================
-//
-// Editor
-//
-//=====================================
def crout
cout($0D)
end
def bell
- return call($FBDD, 0, 0, 0, 0)
+ cout($07)
end
//
// Memory management routines
@@ -565,58 +195,12 @@ def strcpy(dststr, srcstr)
strlen = ^srcstr
while (srcstr).[strlen] == $8D or (srcstr).[strlen] == $A0
- strlen = strlen - 1
+ strlen--
loop
^dststr = strlen
memcpy(dststr + 1, srcstr + 1, strlen)
end
-def heapaddr(ofst, mask)
- word addr
-
- addr = (ofst << 7) + strheap
- while !(mask & 1)
- addr = addr + 16
- mask = mask >> 1
- loop
- return addr
-end
-def sizemask(size)
- if size <= 16
- return $01
- elsif size <= 32
- return $03
- elsif size <= 48
- return $07
- elsif size <= 64
- return $0F
- elsif size <= 80
- return $1F
- fin
- return 0
-end
-def heapalloc(size)
- byte szmask, i
- word mapmask
-
- szmask = sizemask(size)
- for i = strheapmsz - 1 downto 0
- if strheapmap.[i] <> $FF
- mapmask = szmask
- repeat
- if strheapmap.[i] & mapmask
- mapmask = mapmask << 1
- else
- strheapmap.[i] = strheapmap.[i] | mapmask
- return heapaddr(i, mapmask)
- fin
- until mapmask & $100
- fin
- next
- bell()
- prstr(@outofmem)
- return 0
-end
-def freestr(strptr)
+def delstr(strptr)
byte mask, ofst
if strptr and strptr <> @nullstr
@@ -624,7 +208,7 @@ def freestr(strptr)
ofst = (strptr - strheap) >> 4
mask = mask << (ofst & $07)
ofst = ofst >> 3
- strheapmap.[ofst] = strheapmap.[ofst] & ~mask
+ strpoolmap->[ofst] = strpoolmap->[ofst] & ~mask
fin
end
def newstr(strptr)
@@ -638,7 +222,7 @@ def newstr(strptr)
if strlen == 0
return @nullstr
fin
- newptr = heapalloc(strlen + 1)
+ newptr = strpoolalloc(strlen + 1)
if newptr
memcpy(newptr, strptr, strlen + 1)
^newptr = strlen
@@ -646,10 +230,16 @@ def newstr(strptr)
fin
return @nullstr
end
-def inittxtbuf
+def inittxtbuf#0
word i
- memset(strheapmap, strheapmsz, 0)
+ strlinbuf = $1000
+ strpoolmap = $1F00
+ strpoolmsz = 224 // $E0 = 28K is memory@16 bytes per bit map, 128 bytes per 8 bit map, 1K bytes per 8 byte map
+ strpool = $4800
+ strpoolsz = $7000
+
+ memset(strpoolmap, strheapmsz, 0)
memset(strlinbuf, maxfill * 2, @nullstr)
numlines = 1
cursrow = 0
@@ -671,7 +261,7 @@ def caseconv(chr)
fin
return chr
end
-def strupper(strptr)
+def strupper(strptr)#0
byte i, chr
for i = ^strptr downto 1
@@ -681,7 +271,7 @@ def strupper(strptr)
fin
next
end
-def strlower(strptr)
+def strlower(strptr)#0
byte i, chr
for i = ^strptr downto 1
@@ -691,7 +281,7 @@ def strlower(strptr)
fin
next
end
-def txtupper
+def txtupper#0
word i, strptr
flags = flags | uppercase
@@ -699,7 +289,7 @@ def txtupper
strupper(strlinbuf:[i])
next
end
-def txtlower
+def txtlower#0
word i, strptr
flags = flags & ~uppercase
@@ -707,15 +297,15 @@ def txtlower
strlower(strlinbuf:[i])
next
end
-def prbyte(h)
+def prbyte(h)#0
cout('$')
- return call($FDDA, h, 0, 0, 0)
+ call($FDDA, h, 0, 0, 0)
end
-def prword(h)
+def prword(h)#0
cout('$')
- return call($F941, h >> 8, h, 0, 0)
+ call($F941, h >> 8, h, 0, 0)
end
-def print(i)
+def print(i)#0
byte numstr[7]
byte place, sign
@@ -738,19 +328,19 @@ def print(i)
place = place - 1
fin
numstr[place] = 6 - place
- return prstr(@numstr[place])
+ puts(@numstr[place])
end
-def nametostr(namestr, len, strptr)
+def nametostr(namestr, len, strptr)#0
^strptr = len
- return memcpy(strptr + 1, namestr, len)
+ memcpy(strptr + 1, namestr, len)
end
//
// File routines
//
-def readtxt(filename)
+def readtxt(filename)#0
byte txtbuf[81], refnum, i, j
- refnum = open(filename, iobuffer)
+ refnum = open(filename, sysbuf)
if refnum
newline(refnum, $7F, $0D)
repeat
@@ -764,23 +354,23 @@ def readtxt(filename)
if !(numlines & $0F); cout('.'); fin
until txtbuf == 0 or numlines == maxlines
close(refnum)
- //
- // Make sure there is a blank line at the end of the buffer
- //
- if numlines < maxlines and strlinbuf:[numlines - 1] <> @nullstr
- strlinbuf:[numlines] = @nullstr
- numlines = numlines + 1
- fin
+ //
+ // Make sure there is a blank line at the end of the buffer
+ //
+ if numlines < maxlines and strlinbuf:[numlines - 1] <> @nullstr
+ strlinbuf:[numlines] = @nullstr
+ numlines = numlines + 1
+ fin
fin
end
-def writetxt(filename)
+def writetxt(filename)#0
byte txtbuf[81], refnum
byte j, chr
word i, strptr
destroy(filename)
create(filename, $C3, $04, $00) // full access, TXT file
- refnum = open(filename, iobuffer)
+ refnum = open(filename, sysbuf)
if refnum == 0
return
fin
@@ -798,15 +388,15 @@ def writetxt(filename)
write(refnum, @txtbuf + 1, txtbuf)
if !(i & $0F); cout('.'); fin
next
- return close(refnum)
+ close(refnum)
end
//
// Screen routines
//
-def clrscrn
- return call($FC58, 0, 0, 0, 0)
+def clrscrn@0
+ call($FC58, 0, 0, 0, 0)
end
-def drawrow(row, ofst, strptr)
+def drawrow(row, ofst, strptr)#0
byte numchars
word scrnptr
@@ -821,49 +411,49 @@ def drawrow(row, ofst, strptr)
else
memset(scrnptr + numchars, 40 - numchars, $A0A0)
fin
- return memcpy(scrnptr, strptr + ofst + 1, numchars)
+ memcpy(scrnptr, strptr + ofst + 1, numchars)
end
-def drawscrn(toprow, ofst)
+def drawscrn(toprow, ofst)#0
byte row, numchars
word strptr, scrnptr
if ofst
for row = 0 to 23
strptr = strlinbuf:[toprow + row]
- scrnptr = txtscrn[row]
- if ofst >= ^strptr
- numchars = 0
- else
+ scrnptr = txtscrn[row]
+ if ofst >= ^strptr
+ numchars = 0
+ else
numchars = ^strptr - ofst
- fin
- if numchars >= 40
+ fin
+ if numchars >= 40
numchars = 40
- else
- memset(scrnptr + numchars, 40 - numchars, $A0A0)
+ else
+ memset(scrnptr + numchars, 40 - numchars, $A0A0)
fin
- memcpy(scrnptr, strptr + ofst + 1, numchars)
+ memcpy(scrnptr, strptr + ofst + 1, numchars)
next
else
for row = 0 to 23
strptr = strlinbuf:[toprow + row]
- scrnptr = txtscrn[row]
- numchars = ^strptr
- if numchars >= 40
+ scrnptr = txtscrn[row]
+ numchars = ^strptr
+ if numchars >= 40
numchars = 40
- else
- memset(scrnptr + numchars, 40 - numchars, $A0A0)
+ else
+ memset(scrnptr + numchars, 40 - numchars, $A0A0)
fin
- memcpy(scrnptr, strptr + 1, numchars)
+ memcpy(scrnptr, strptr + 1, numchars)
next
fin
end
-def cursoff
+def cursoff#0
if flags & showcurs
^cursptr = underchr
flags = flags & ~showcurs
fin
end
-def curson
+def curson#0
if !(flags & showcurs)
cursptr = txtscrn[cursy] + cursx
underchr = ^cursptr
@@ -871,22 +461,22 @@ def curson
flags = flags | showcurs
fin
end
-def cursflash
+def cursflash#0
if flags & showcurs
if flash == 0
^cursptr = curschr
elsif flash == 128
^cursptr = underchr
fin
- flash = flash + 1
+ flash++
fin
end
-def redraw
+def redraw#0
cursoff
drawscrn(scrntop, scrnleft)
curson
end
-def curshome
+def curshome#0
cursoff
cursrow = 0
curscol = 0
@@ -895,9 +485,9 @@ def curshome
scrnleft = 0
scrntop = 0
drawscrn(scrntop, scrnleft)
- return curson
+ curson
end
-def cursend
+def cursend#0
cursoff
if numlines > 23
cursrow = numlines - 1
@@ -912,9 +502,9 @@ def cursend
cursx = 0
scrnleft = 0
drawscrn(scrntop, scrnleft)
- return curson
+ curson
end
-def cursup
+def cursup#0
if cursrow > 0
cursoff
cursrow = cursrow - 1
@@ -927,14 +517,14 @@ def cursup
curson
fin
end
-def pgup
+def pgup#0
byte i
for i = pgjmp downto 0
cursup
next
end
-def cursdown
+def cursdown#0
if cursrow < numlines - 1
cursoff
cursrow = cursrow + 1
@@ -947,14 +537,14 @@ def cursdown
curson
fin
end
-def pgdown
+def pgdown#0
byte i
for i = pgjmp downto 0
cursdown
next
end
-def cursleft
+def cursleft#0
if curscol > 0
cursoff
curscol = curscol - 1
@@ -967,14 +557,14 @@ def cursleft
curson
fin
end
-def pgleft
+def pgleft#0
byte i
for i = 7 downto 0
cursleft
next
end
-def cursright
+def cursright#0
if curscol < 80
cursoff
curscol = curscol + 1
@@ -987,7 +577,7 @@ def cursright
curson
fin
end
-def pgright
+def pgright#0
byte i
for i = 7 downto 0
@@ -1044,18 +634,18 @@ end
//
// Printer routines
//
-def printtxt(slot)
+def printtxt(slot)#0
byte txtbuf[80]
word i, scrncsw
- scrncsw = *(csw)
- *(csw) = $C000 | (slot << 8)
+ scrncsw = *csw
+ *csw = $C000 | (slot << 8)
for i = 0 to numlines - 1
cpyln(strlinbuf:[i], @txtbuf)
- prstr(@txtbuf)
+ puts(@txtbuf)
crout
next
- *(csw) = scrncsw
+ *csw = scrncsw
end
def openline(row)
if numlines < maxlines
@@ -1063,12 +653,12 @@ def openline(row)
strlinbuf:[row] = @nullstr
numlines = numlines + 1
flags = flags | changed
- return 1
+ return TRUE
fin
bell
- return 0
+ return FALSE
end
-def cutline
+def cutline#0
freestr(cutbuf)
cutbuf = strlinbuf:[cursrow]
memcpy(@strlinbuf:[cursrow], @strlinbuf:[cursrow + 1], (numlines - cursrow) * 2)
@@ -1079,9 +669,9 @@ def cutline
if cursrow == numlines
cursup
fin
- return redraw
+ redraw
end
-def pasteline
+def pasteline#0
if cutbuf and numlines < maxlines
memcpy(@strlinbuf:[cursrow + 1], @strlinbuf:[cursrow], (numlines - cursrow) * 2)
strlinbuf:[cursrow] = newstr(cutbuf)
@@ -1092,7 +682,7 @@ def pasteline
bell
fin
end
-def joinline
+def joinline#0
byte joinstr[80], joinlen
if cursrow < numlines - 1
@@ -1113,7 +703,7 @@ def joinline
fin
fin
end
-def splitline
+def splitline#0
byte splitstr[80], splitlen
if openline(cursrow + 1)
@@ -1141,15 +731,15 @@ def splitline
end
def editkey(key)
if key >= keyspace
- return true
+ return TRUE
elsif key == keydelete
- return true
+ return TRUE
elsif key == keyctrld
- return true
+ return TRUE
elsif key == keyctrlr
- return true
+ return TRUE
fin
- return false
+ return FALSE
end
def editline(key)
byte editstr[80]
@@ -1241,7 +831,7 @@ def editline(key)
fin
return key
end
-def editmode
+def editmode#0
repeat
when editline(keyin())
is keyarrowup
@@ -1269,15 +859,15 @@ def editmode
is keyctrlv
pasteline; break
is keyctrlf
- if numlines < maxlines and cursrow == numlines - 1
+ if numlines < maxlines and cursrow == numlines - 1
strlinbuf:[numlines] = @nullstr
- numlines = numlines + 1
- fin
- cursdown
+ numlines = numlines + 1
+ fin
+ cursdown
is keyctrlo
openline(cursrow)
redraw
- break
+ break
is keyenter
if flags & insmode
splitline
@@ -1286,7 +876,7 @@ def editmode
cursdown
redraw
fin
- break
+ break
is keyctrlt
joinline; break
is keyctrli
@@ -1297,7 +887,7 @@ def editmode
flags = flags | insmode
curschr = '+'
fin
- break
+ break
is keyctrlc
if flags & uppercase
txtlower
@@ -1305,12 +895,12 @@ def editmode
txtupper
fin
redraw
- break
+ break
is keyescape
cursoff
cmdmode
redraw
- break
+ break
wend
until false
end
@@ -1329,10 +919,10 @@ def prfiles(optpath)
strcpy(@path, optpath)
else
getpfx(@path)
- prstr(@path)
+ puts(@path)
crout
fin
- refnum = open(@path, iobuffer)
+ refnum = open(@path, sysbuf)
if perr
return perr
fin
@@ -1351,7 +941,7 @@ def prfiles(optpath)
if type <> 0
len = type & $0F
^entry = len
- prstr(entry)
+ puts(entry)
if type & $F0 == $D0 // Is it a directory?
cout('/')
len = len + 1
@@ -1372,7 +962,7 @@ def prfiles(optpath)
crout
return 0
end
-def striplead(strptr, chr)
+def striplead(strptr, chr)#0
while ^strptr and ^(strptr + 1) == chr
memcpy(strptr + 1, strptr + 2, ^strptr)
^strptr = ^strptr - 1
@@ -1395,16 +985,16 @@ def parsecmd(strptr)
end
def chkchng
if flags & changed
- prstr(@losechng)
+ puts("LOSE CHANGES TO FILE (Y/N)?")
if toupper(keyin()) == 'N'
crout
- return false
+ return FALSE
fin
crout
fin
- return true
+ return TRUE
end
-def quit
+def quit#0
if chkchng
exit
fin
@@ -1414,26 +1004,26 @@ def cmdmode
word cmdptr
clrscrn
- prstr(@version)
+ puts("PLASMA ][ EDITOR VERSION 0.99")
crout
- while true
- prstr(@txtfile)
+ while TRUE
+ puts(@txtfile)
cmdptr = rdstr($BA)
when toupper(parsecmd(cmdptr))
is 'A'
readtxt(cmdptr)
flags = flags | changed
- break
+ break
is 'R'
if chkchng
inittxtbuf
- numlines = 0
+ numlines = 0
strcpy(@txtfile, cmdptr)
readtxt(@txtfile)
- if numlines == 0; numlines = 1; fin
+ if numlines == 0; numlines = 1; fin
flags = flags & ~changed
fin
- break
+ break
is 'W'
if ^cmdptr
strcpy(@txtfile, cmdptr)
@@ -1441,7 +1031,7 @@ def cmdmode
writetxt(@txtfile)
//if flags & changed; fin
flags = flags & ~changed
- break
+ break
is 'C'
prfiles(cmdptr); break
is 'P'
@@ -1453,7 +1043,7 @@ def cmdmode
slot = 1
fin
printtxt(slot)
- break
+ break
is 'Q'
quit
is 'E'
@@ -1462,19 +1052,19 @@ def cmdmode
is 'N'
if chkchng
inittxtbuf
- strcpy(@txtfile, @untitled)
+ strcpy(@txtfile, "UNTITLED")
fin
- break
+ break
otherwise
bell
cout('?')
crout
wend
if perr
- prstr(@errorstr)
+ puts("ERROR: $")
call($FDDA, perr, 0, 0, 0)
else
- prstr(@okstr)
+ puts("OK")
fin
crout
loop
@@ -1482,7 +1072,7 @@ end
//
// Init editor
//
-if !(^machid & $80)
+if !(^MACHID & $80)
flags = uppercase | shiftlock
keyin = @keyin2
else
@@ -1491,7 +1081,7 @@ fin
inittxtbuf
if argbuff
strcpy(@txtfile, @argbuff)
- prstr(@txtfile)
+ puts(@txtfile)
numlines = 0
readtxt(@txtfile)
fin
diff --git a/src/vmsrc/a1cmd.pla b/src/vmsrc/a1cmd.pla
index c096631..b972255 100755
--- a/src/vmsrc/a1cmd.pla
+++ b/src/vmsrc/a1cmd.pla
@@ -79,6 +79,7 @@ byte hpmarkstr[] = "HEAPMARK"
byte hpalignstr[] = "HEAPALLOCALIGN"
byte hpallocstr[] = "HEAPALLOC"
byte hprelstr[] = "HEAPRELEASE"
+byte hpavlstr[] = "HEAPAVAIL"
byte memsetstr[] = "MEMSET"
byte memcpystr[] = "MEMCPY"
byte uisgtstr[] = "ISUGT"
@@ -100,6 +101,7 @@ word = @hpmarkstr, @markheap
word = @hpallocstr,@allocheap
word = @hpalignstr,@allocalignheap
word = @hprelstr, @releaseheap
+word = @hpavlstr, @availheap
word = @memsetstr, @memset
word = @memcpystr, @memcpy
word = @uisgtstr, @uword_isgt
diff --git a/src/vmsrc/cmd.pla b/src/vmsrc/cmd.pla
index 61d1ff4..9b08b7d 100755
--- a/src/vmsrc/cmd.pla
+++ b/src/vmsrc/cmd.pla
@@ -26,7 +26,7 @@ const modinitkeep = $4000
//
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 markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr)#1, 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
@@ -103,26 +103,26 @@ word syslibsym = @exports
// SYSCALL(CMD, PARAMS)
//
asm syscall(cmd,params)#1
- LDA ESTKL,X
- LDY ESTKH,X
- STA PARAMS
- STY PARAMS+1
- INX
- LDA ESTKL,X
- STA CMD
- JSR $BF00
+ LDA ESTKL,X
+ LDY ESTKH,X
+ STA PARAMS
+ STY PARAMS+1
+ INX
+ LDA ESTKL,X
+ STA CMD
+ JSR $BF00
CMD: !BYTE 00
PARAMS: !WORD 0000
- LDY #$00
- STA ESTKL,X
- STY ESTKH,X
- RTS
+ LDY #$00
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
end
//
// CALL 6502 ROUTINE
// CALL(ADDR, AREG, XREG, YREG, STATUS)
//
-asm call(addr,areg,xreg,yreg,sstatus)#1
+asm call(addr,areg,xreg,yreg,status)#1
REGVALS = SRC
PHP
LDA ESTKL+4,X
@@ -166,23 +166,23 @@ end
// CALL LOADED SYSTEM PROGRAM
//
asm exec()#0
- LDX #$00
- STX IFPL
- LDA #$BF
- STA IFPH
- LDX #$FE
- TXS
- LDX #ESTKSZ/2
- BIT ROMEN
- JMP $2000
+ LDX #$00
+ STX IFPL
+ LDA #$BF
+ STA IFPH
+ LDX #$FE
+ TXS
+ LDX #ESTKSZ/2
+ BIT ROMEN
+ JMP $2000
end
//
// EXIT
//
asm reboot()#0
- BIT ROMEN
- DEC $03F4 ; INVALIDATE POWER-UP BYTE
- JMP ($FFFC) ; RESET
+ BIT ROMEN
+ DEC $03F4 ; INVALIDATE POWER-UP BYTE
+ JMP ($FFFC) ; RESET
end
//
// SET MEMORY TO VALUE
@@ -190,112 +190,112 @@ end
// With optimizations from Peter Ferrie
//
asm memset(addr,value,size)#0
- LDA ESTKL+2,X
- STA DSTL
- LDA ESTKH+2,X
- STA DSTH
- LDY ESTKL,X
- BEQ +
- INC ESTKH,X
- LDY #$00
-+ LDA ESTKH,X
- BEQ SETMEX
+ LDA ESTKL+2,X
+ STA DSTL
+ LDA ESTKH+2,X
+ STA DSTH
+ LDY ESTKL,X
+ BEQ +
+ INC ESTKH,X
+ LDY #$00
++ LDA ESTKH,X
+ BEQ SETMEX
SETMLPL CLC
- LDA ESTKL+1,X
+ LDA ESTKL+1,X
SETMLPH STA (DST),Y
- DEC ESTKL,X
- BEQ ++
-- INY
- BEQ +
--- BCS SETMLPL
- SEC
- LDA ESTKH+1,X
- BCS SETMLPH
-+ INC DSTH
- BNE --
-++ DEC ESTKH,X
- BNE -
+ DEC ESTKL,X
+ BEQ ++
+- INY
+ BEQ +
+-- BCS SETMLPL
+ SEC
+ LDA ESTKH+1,X
+ BCS SETMLPH
++ INC DSTH
+ BNE --
+++ DEC ESTKH,X
+ BNE -
SETMEX INX
- INX
- INX
- RTS
+ INX
+ INX
+ RTS
end
//
// COPY MEMORY
// MEMCPY(DSTADDR, SRCADDR, SIZE)
//
asm memcpy(dst,src,size)#0
- INX
- INX
- INX
- LDA ESTKL-3,X
- ORA ESTKH-3,X
- BEQ CPYMEX
- LDA ESTKL-2,X
- CMP ESTKL-1,X
- LDA ESTKH-2,X
- SBC ESTKH-1,X
- BCC REVCPY
+ INX
+ INX
+ INX
+ LDA ESTKL-3,X
+ ORA ESTKH-3,X
+ BEQ CPYMEX
+ LDA ESTKL-2,X
+ CMP ESTKL-1,X
+ LDA ESTKH-2,X
+ SBC ESTKH-1,X
+ BCC REVCPY
;
; FORWARD COPY
;
- LDA ESTKL-1,X
- STA DSTL
- LDA ESTKH-1,X
- STA DSTH
- LDA ESTKL-2,X
- STA SRCL
- LDA ESTKH-2,X
- STA SRCH
- LDY ESTKL-3,X
- BEQ FORCPYLP
- INC ESTKH-3,X
- LDY #$00
+ LDA ESTKL-1,X
+ STA DSTL
+ LDA ESTKH-1,X
+ STA DSTH
+ LDA ESTKL-2,X
+ STA SRCL
+ LDA ESTKH-2,X
+ STA SRCH
+ LDY ESTKL-3,X
+ BEQ FORCPYLP
+ INC ESTKH-3,X
+ LDY #$00
FORCPYLP LDA (SRC),Y
- STA (DST),Y
- INY
- BNE +
- INC DSTH
- INC SRCH
-+ DEC ESTKL-3,X
- BNE FORCPYLP
- DEC ESTKH-3,X
- BNE FORCPYLP
- RTS
+ STA (DST),Y
+ INY
+ BNE +
+ INC DSTH
+ INC SRCH
++ DEC ESTKL-3,X
+ BNE FORCPYLP
+ DEC ESTKH-3,X
+ BNE FORCPYLP
+ RTS
;
; REVERSE COPY
;
REVCPY ;CLC
- LDA ESTKL-3,X
- ADC ESTKL-1,X
- STA DSTL
- LDA ESTKH-3,X
- ADC ESTKH-1,X
- STA DSTH
- CLC
- LDA ESTKL-3,X
- ADC ESTKL-2,X
- STA SRCL
- LDA ESTKH-3,X
- ADC ESTKH-2,X
- STA SRCH
- DEC DSTH
- DEC SRCH
- LDY #$FF
- LDA ESTKL-3,X
- BEQ REVCPYLP
- INC ESTKH-3,X
+ LDA ESTKL-3,X
+ ADC ESTKL-1,X
+ STA DSTL
+ LDA ESTKH-3,X
+ ADC ESTKH-1,X
+ STA DSTH
+ CLC
+ LDA ESTKL-3,X
+ ADC ESTKL-2,X
+ STA SRCL
+ LDA ESTKH-3,X
+ ADC ESTKH-2,X
+ STA SRCH
+ DEC DSTH
+ DEC SRCH
+ LDY #$FF
+ LDA ESTKL-3,X
+ BEQ REVCPYLP
+ INC ESTKH-3,X
REVCPYLP LDA (SRC),Y
- STA (DST),Y
- DEY
- CPY #$FF
- BNE +
- DEC DSTH
- DEC SRCH
-+ DEC ESTKL-3,X
- BNE REVCPYLP
- DEC ESTKH-3,X
- BNE REVCPYLP
+ STA (DST),Y
+ DEY
+ CPY #$FF
+ BNE +
+ DEC DSTH
+ DEC SRCH
++ DEC ESTKL-3,X
+ BNE REVCPYLP
+ DEC ESTKH-3,X
+ BNE REVCPYLP
CPYMEX RTS
end
//
@@ -304,34 +304,34 @@ end
// MEMXCPY(DST, SRC, SIZE)
//
asm memxcpy(dst,src,size)#0
- LDA ESTKL+1,X
- STA $3C
- CLC
- ADC ESTKL,X
- STA $3E
- LDA ESTKH+1,X
- STA $3D
- ADC ESTKH,X
- STA $3F
- LDA ESTKL+2,X
- STA $42
- LDA ESTKH+2,X
- STA $43
- STX ESP
- BIT ROMEN
- SEC
- JSR $C311
- BIT LCRDEN+LCBNK2
- LDX ESP
- INX
- INX
- INX
- RTS
+ LDA ESTKL+1,X
+ STA $3C
+ CLC
+ ADC ESTKL,X
+ STA $3E
+ LDA ESTKH+1,X
+ STA $3D
+ ADC ESTKH,X
+ STA $3F
+ LDA ESTKL+2,X
+ STA $42
+ LDA ESTKH+2,X
+ STA $43
+ STX ESP
+ BIT ROMEN
+ SEC
+ JSR $C311
+ BIT LCRDEN+LCBNK2
+ LDX ESP
+ INX
+ INX
+ INX
+ RTS
end
asm crout()#0
- DEX
- LDA #$0D
- BNE +
+ DEX
+ LDA #$0D
+ BNE +
; FALL THROUGH TO COUT
end
//
@@ -339,161 +339,161 @@ end
// COUT(CHAR)
//
asm cout(c)#0
- LDA ESTKL,X
- BIT $BF98
- BMI +
- JSR TOUPR
-+ ORA #$80
- BIT ROMEN
- JSR $FDED
- BIT LCRDEN+LCBNK2
- INX
- RTS
+ LDA ESTKL,X
+ BIT $BF98
+ BMI +
+ JSR TOUPR
++ ORA #$80
+ BIT ROMEN
+ JSR $FDED
+ BIT LCRDEN+LCBNK2
+ INX
+ RTS
end
//
// CHAR IN
// RDKEY()
//
asm cin()#1
- BIT ROMEN
- JSR $FD0C
- BIT LCRDEN+LCBNK2
- DEX
- LDY #$00
- AND #$7F
- STA ESTKL,X
- STY ESTKH,X
- RTS
+ BIT ROMEN
+ JSR $FD0C
+ BIT LCRDEN+LCBNK2
+ DEX
+ LDY #$00
+ AND #$7F
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
end
//
// PRINT STRING
// PRSTR(STR)
//
asm prstr(s)#0
- LDY #$00
- LDA ESTKL,X
- STA SRCL
- LDA ESTKH,X
- STA SRCH
- LDA (SRC),Y
- BEQ ++
- STA TMP
- BIT ROMEN
-- INY
- LDA (SRC),Y
- BIT $BF98
- BMI +
- JSR TOUPR
-+ ORA #$80
- JSR $FDED
- CPY TMP
- BNE -
- BIT LCRDEN+LCBNK2
-++ INX
- RTS
+ LDY #$00
+ LDA ESTKL,X
+ STA SRCL
+ LDA ESTKH,X
+ STA SRCH
+ LDA (SRC),Y
+ BEQ ++
+ STA TMP
+ BIT ROMEN
+- INY
+ LDA (SRC),Y
+ BIT $BF98
+ BMI +
+ JSR TOUPR
++ ORA #$80
+ JSR $FDED
+ CPY TMP
+ BNE -
+ BIT LCRDEN+LCBNK2
+++ INX
+ RTS
end
//
// PRINT BYTE
//
asm prbyte(b)#0
- LDA ESTKL,X
- STX ESP
- BIT ROMEN
- JSR $FDDA
- LDX ESP
- BIT LCRDEN+LCBNK2
- INX
- RTS
+ LDA ESTKL,X
+ STX ESP
+ BIT ROMEN
+ JSR $FDDA
+ LDX ESP
+ BIT LCRDEN+LCBNK2
+ INX
+ RTS
end
//
// PRINT WORD
//
asm prword(w)#0
- STX ESP
- TXA
- TAY
- LDA ESTKH,Y
- LDX ESTKL,Y
- BIT ROMEN
- JSR $F941
- LDX ESP
- BIT LCRDEN+LCBNK2
- INX
- RTS
+ STX ESP
+ TXA
+ TAY
+ LDA ESTKH,Y
+ LDX ESTKL,Y
+ BIT ROMEN
+ JSR $F941
+ LDX ESP
+ BIT LCRDEN+LCBNK2
+ INX
+ RTS
end
//
// READ STRING
// STR = RDSTR(PROMPTCHAR)
//
asm rdstr(p)#1
- LDA ESTKL,X
- STA $33
- STX ESP
- BIT ROMEN
- JSR $FD6A
- STX $01FF
-- LDA $01FF,X
- AND #$7F
- STA $01FF,X
- DEX
- BPL -
- TXA
- LDX ESP
- STA ESTKL,X
- LDA #$01
- STA ESTKH,X
- BIT LCRDEN+LCBNK2
- RTS
+ LDA ESTKL,X
+ STA $33
+ STX ESP
+ BIT ROMEN
+ JSR $FD6A
+ STX $01FF
+- LDA $01FF,X
+ AND #$7F
+ STA $01FF,X
+ DEX
+ BPL -
+ TXA
+ LDX ESP
+ STA ESTKL,X
+ LDA #$01
+ STA ESTKH,X
+ BIT LCRDEN+LCBNK2
+ RTS
end
asm uword_isge(a,b)#1
- LDA ESTKL+1,X
- CMP ESTKL,X
- LDA ESTKH+1,X
- SBC ESTKH,X
- LDA #$FF
- ADC #$00
- EOR #$FF
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ LDA #$FF
+ ADC #$00
+ EOR #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
asm uword_isle(a,b)#1
- LDA ESTKL,X
- CMP ESTKL+1,X
- LDA ESTKH,X
- SBC ESTKH+1,X
- LDA #$FF
- ADC #$00
- EOR #$FF
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ LDA #$FF
+ ADC #$00
+ EOR #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
asm uword_isgt(a,b)#1
- LDA ESTKL,X
- CMP ESTKL+1,X
- LDA ESTKH,X
- SBC ESTKH+1,X
- LDA #$FF
- ADC #$00
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ LDA #$FF
+ ADC #$00
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
asm uword_islt(a,b)#1
- LDA ESTKL+1,X
- CMP ESTKL,X
- LDA ESTKH+1,X
- SBC ESTKH,X
- LDA #$FF
- ADC #$00
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ LDA #$FF
+ ADC #$00
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
//
// Utility routines.
@@ -513,28 +513,28 @@ end
// return len
//end
asm dcitos(dci, str)#1
- 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
- CMP #$80
- AND #$7F
- INY
- STA (DST),Y
- BCS -
- TYA
- LDY #$00
- STA (DST),Y
- INX
- STA ESTKL,X
- STY ESTKH,X
- RTS
+ 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
+ CMP #$80
+ AND #$7F
+ INY
+ STA (DST),Y
+ BCS -
+ TYA
+ LDY #$00
+ STA (DST),Y
+ INX
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
end
//def stodci(str, dci)
// byte len, c
@@ -553,43 +553,43 @@ end
// return ^str
//end
asm stodci(str,dci)#1
- 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
+ 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(c)#1
- LDA ESTKL,X
-TOUPR AND #$7F
- CMP #'a'
- BCC +
- CMP #'z'+1
- BCS +
- SBC #$1F
-+ STA ESTKL,X
- RTS
+ LDA ESTKL,X
+TOUPR AND #$7F
+ CMP #'a'
+ BCC +
+ CMP #'z'+1
+ BCS +
+ SBC #$1F
++ STA ESTKL,X
+ RTS
end
//
// Module symbols are entered into the symbol table
@@ -608,25 +608,25 @@ end
// return dci
//end
asm modtosym(mod,dci)#1
- 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
- ASL
- LDA (SRC),Y
- INY
- BCS -
- RTS
+ 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
+ ASL
+ LDA (SRC),Y
+ INY
+ BCS -
+ RTS
end
//
// Lookup routines.
@@ -649,46 +649,46 @@ end
// loop
// return 0
asm lookuptbl(dci, tbl)#1
- 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
- ASL
- BCS -
- 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
- BEQ +
---- ASL
- BCS --
- LDA #$02
- ADC DSTL
- STA DSTL
- BCC -
- INC DSTH
- BCS -
-+ INC DSTH
- BNE ---
+ 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
+ ASL
+ BCS -
+ 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
+ BEQ +
+--- ASL
+ BCS --
+ LDA #$02
+ ADC DSTL
+ STA DSTL
+ BCC -
+ INC DSTH
+ BCS -
++ INC DSTH
+ BNE ---
end
//
// ProDOS routines
@@ -752,15 +752,15 @@ def allocheap(size)#1
heap = heap + size
if systemflags & reshgr1
if uword_islt(addr, $4000) and uword_isgt(heap, $2000)
- addr = $4000
- heap = addr + size
- fin
+ addr = $4000
+ heap = addr + size
+ fin
fin
if systemflags & reshgr2
if uword_islt(addr, $6000) and uword_isgt(heap, $4000)
- addr = $6000
- heap = addr + size
- fin
+ addr = $6000
+ heap = addr + size
+ fin
fin
if uword_isge(heap, @addr)
return 0
@@ -793,27 +793,27 @@ def allocxheap(size)#1
xheap = xheap + size
if systemflags & restxt1
if uword_isle(xaddr, $0800) and uword_isgt(xheap, $0400)
- xaddr = $0800
- xheap = xaddr + size
- fin
+ xaddr = $0800
+ xheap = xaddr + size
+ fin
fin
if systemflags & restxt2
if uword_isle(xaddr, $0C00) and uword_isgt(xheap, $0800)
- xaddr = $0C00
- xheap = xaddr + size
- fin
+ xaddr = $0C00
+ xheap = xaddr + size
+ fin
fin
if systemflags & resxhgr1
if uword_isle(xaddr, $4000) and uword_isgt(xheap, $2000)
- xaddr = $4000
- xheap = xaddr + size
- fin
+ xaddr = $4000
+ xheap = xaddr + size
+ fin
fin
if systemflags & resxhgr2
if uword_isle(xaddr, $6000) and uword_isgt(xheap, $4000)
- xaddr = $6000
- xheap = xaddr + size
- fin
+ xaddr = $6000
+ xheap = xaddr + size
+ fin
fin
if uword_isge(xheap, $BF00)
return 0
@@ -861,12 +861,12 @@ def lookupextern(esd, index)#1
esd = esd + dcitos(esd, @str)
if esd->0 & $10 and esd->1 == index
addr = lookupsym(sym)
- if !addr
+ if !addr
perr = $81
- cout('?')
- prstr(@str)
- crout
- fin
+ cout('?')
+ prstr(@str)
+ crout
+ fin
return addr
fin
esd = esd + 3
@@ -1108,12 +1108,12 @@ def volumes()#0
strbuf = databuff
for i = 0 to 15
^strbuf = ^strbuf & $0F
- if ^strbuf
- cout('/')
- prstr(strbuf)
- crout()
- fin
- strbuf = strbuf + 16
+ if ^strbuf
+ cout('/')
+ prstr(strbuf)
+ crout()
+ fin
+ strbuf = strbuf + 16
next
end
def catalog(optpath)#1
@@ -1154,12 +1154,12 @@ def catalog(optpath)#1
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
+ elsif entry->$10 == $FF
+ cout('-')
+ len = len + 1
+ elsif entry->$10 == $FE
+ cout('+')
+ len = len + 1
fin
for len = 19 - len downto 0
cout(' ')
@@ -1198,9 +1198,9 @@ def striptrail(strptr)#1
for i = 1 to ^strptr
if ^(strptr + i) <= ' '
- ^strptr = i - 1
- return strptr
- fin
+ ^strptr = i - 1
+ return strptr
+ fin
next
return strptr
end
@@ -1236,23 +1236,23 @@ def execsys(sysfile)#0
if ^sysfile
memcpy($280, sysfile, ^sysfile + 1)
- striptrail(sysfile)
- refnum = open(sysfile, iobuffer)
- if refnum
- len = read(refnum, databuff, $FFFF)
- resetmemfiles()
- if len
- memcpy(sysfile, $280, ^$280 + 1)
- if stripchars(sysfile) and ^$2000 == $4C and *$2003 == $EEEE
- stripspaces(sysfile)
- if ^$2005 >= ^sysfile + 1
- memcpy($2006, sysfile, ^sysfile + 1)
+ striptrail(sysfile)
+ refnum = open(sysfile, iobuffer)
+ if refnum
+ len = read(refnum, databuff, $FFFF)
+ resetmemfiles()
+ if len
+ memcpy(sysfile, $280, ^$280 + 1)
+ if stripchars(sysfile) and ^$2000 == $4C and *$2003 == $EEEE
+ stripspaces(sysfile)
+ if ^$2005 >= ^sysfile + 1
+ memcpy($2006, sysfile, ^sysfile + 1)
+ fin
+ fin
+ striptrail($280)
+ exec()
fin
fin
- striptrail($280)
- exec()
- fin
- fin
fin
end
def execmod(modfile)#1
@@ -1262,16 +1262,16 @@ def execmod(modfile)#1
perr = 1
if stodci(modfile, @moddci)
saveheap = heap
- savexheap = xheap
- savesym = lastsym
- saveflags = systemflags
- if loadmod(@moddci) < modkeep
- lastsym = savesym
- xheap = savexheap
- heap = saveheap
- fin
- ^lastsym = 0
- systemflags = saveflags
+ savexheap = xheap
+ savesym = lastsym
+ saveflags = systemflags
+ if loadmod(@moddci) < modkeep
+ lastsym = savesym
+ xheap = savexheap
+ heap = saveheap
+ fin
+ ^lastsym = 0
+ systemflags = saveflags
fin
return -perr
end
@@ -1314,34 +1314,34 @@ while 1
if cmdln
when toupper(parsecmd(@cmdln))
is 'Q'
- reboot()
- break
- is 'C'
- catalog(@cmdln)
- break
- is 'P'
- setpfx(@cmdln)
- break
- is 'V'
- volumes()
- break
- is '-'
- execsys(@cmdln)
- break
- is '+'
- execmod(striptrail(@cmdln))
- break
- otherwise
- cout('?')
+ reboot()
+ break
+ is 'C'
+ catalog(@cmdln)
+ break
+ is 'P'
+ setpfx(@cmdln)
+ break
+ is 'V'
+ volumes()
+ break
+ is '-'
+ execsys(@cmdln)
+ break
+ is '+'
+ execmod(striptrail(@cmdln))
+ break
+ otherwise
+ cout('?')
wend
if perr
prstr("ERR:$")
- prbyte(perr)
- perr = 0
+ prbyte(perr)
+ perr = 0
else
prstr("OK")
fin
- crout()
+ crout()
fin
prstr(getpfx(@prefix))
memcpy(@cmdln, rdstr($BA), 128)
diff --git a/src/vmsrc/plvm02.s b/src/vmsrc/plvm02.s
index 94c1569..7278cf2 100755
--- a/src/vmsrc/plvm02.s
+++ b/src/vmsrc/plvm02.s
@@ -63,7 +63,7 @@ INTERP = $03D0
;*
;* DISCONNECT /RAM
;*
- SEI ; DISABLE /RAM
+ ;SEI ; DISABLE /RAM
LDA MACHID
AND #$30
CMP #$30
@@ -92,7 +92,7 @@ RAMEXIT LDA NODEV
LDA NODEV+1
STA RAMSLOT+1
DEC DEVCNT
-RAMDONE CLI
+RAMDONE ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE
;*
;* MOVE VM INTO LANGUAGE CARD
;*
@@ -250,7 +250,7 @@ IINTRPX PLA
STA IFPH
LDA #>OPXTBL
STA OPPAGE
- SEI
+ ;SEI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE
STA ALTRDON
!IF SELFMODIFY {
BIT LCRWEN+LCBNK2
@@ -1463,9 +1463,9 @@ CALLX +INC_IP
TYA
PHA
STA ALTRDOFF
- CLI
+ ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE
JSR JMPTMP
- SEI
+ ;SEI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE
STA ALTRDON
PLA
TAY
@@ -1521,9 +1521,9 @@ ICALX LDA ESTKL,X
TYA
PHA
STA ALTRDOFF
- CLI
+ ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE
JSR JMPTMP
- SEI
+ ;SEI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE
STA ALTRDON
PLA
TAY
@@ -1576,7 +1576,7 @@ ENTER INY
;* LEAVE FUNCTION
;*
LEAVEX STA ALTRDOFF
- CLI
+ ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE
LEAVE PLA ; DEALLOCATE POOL + FRAME
CLC
ADC IFPL
@@ -1591,7 +1591,7 @@ LEAVE PLA ; DEALLOCATE POOL + FRAME
RTS
;
RETX STA ALTRDOFF
- CLI
+ ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE
RET LDA IFPL ; DEALLOCATE POOL
STA PPL
LDA IFPH
diff --git a/src/vmsrc/soscmd.pla b/src/vmsrc/soscmd.pla
index 007d218..2bcdfa7 100755
--- a/src/vmsrc/soscmd.pla
+++ b/src/vmsrc/soscmd.pla
@@ -74,6 +74,7 @@ byte hpmarkstr[] = "HEAPMARK"
byte hpalignstr[] = "HEAPALLOCALIGN"
byte hpallocstr[] = "HEAPALLOC"
byte hprelstr[] = "HEAPRELEASE"
+byte hpavlstr[] = "HEAPAVAIL"
byte memsetstr[] = "MEMSET"
byte memcpystr[] = "MEMCPY"
byte uisgtstr[] = "ISUGT"
@@ -96,6 +97,7 @@ word = @hpmarkstr, @markheap
word = @hpallocstr,@allocheap
word = @hpalignstr,@allocalignheap
word = @hprelstr, @releaseheap
+word = @hpavlstr, @availheap
word = @memsetstr, @memset
word = @memcpystr, @memcpy
word = @uisgtstr, @uword_isgt