mirror of
https://github.com/dschmenk/PLASMA.git
synced 2024-06-02 10:41:35 +00:00
85710bbfdf
II-ism from PLFORTH
511 lines
11 KiB
Plaintext
511 lines
11 KiB
Plaintext
include "inc/cmdsys.plh"
|
|
include "inc/fileio.plh"
|
|
//
|
|
// CFFA1 addresses.
|
|
//
|
|
const CFFA1Dest = $00
|
|
const CFFA1FileName = $02
|
|
const CFFA1OldName = $04
|
|
const CFFA1FileType = $06
|
|
const CFFA1AuxType = $07
|
|
const CFFA1FileSize = $09
|
|
const CFFA1EntryPtr = $0B
|
|
//
|
|
// SOS access modes
|
|
//
|
|
const O_READ = 1
|
|
const O_WRITE = 2
|
|
const O_READ_WRITE = 3
|
|
//
|
|
// System I/O buffer for PLASMA. Used when loading modules, free otherwise
|
|
//
|
|
const sysbuf = $0800
|
|
//
|
|
// External interface
|
|
//
|
|
predef a2getpfx(path), a2setpfx(path), a2getfileinfo(path, fileinfo), a2setfileinfo(path, fileinfo), a23geteof(refnum)#2, a23seteof(refnum, eofl, eofh), a2iobufs(iobufs), a2open(path), a2close(refnum)
|
|
predef a23read(refnum, buf, len), a2write(refnum, buf, len), a2create(path, type, aux), a23destroy(path), a23rename(path, newpath)
|
|
predef a2newline(refnum, emask, nlchar), a2online(unit, buf), a2readblock(unit, buf, block), a2writeblock(unit, buf, block)
|
|
//
|
|
// Exported function table.
|
|
//
|
|
word fileio[]
|
|
word = @a2getpfx, @a2setpfx, @a2getfileinfo, @a2setfileinfo, @a23geteof, @a23seteof, @a2iobufs, @a2open, @a2close
|
|
word = @a23read, @a2write, @a2create, @a23destroy, @a23rename
|
|
word = @a2newline, @a2online, @a2readblock, @a2writeblock
|
|
//
|
|
// SOS/ProDOS error code
|
|
//
|
|
export byte perr
|
|
//
|
|
// I/O buffers
|
|
//
|
|
const MAX_IOBUFS = 4
|
|
byte iobuf_ref[MAX_IOBUFS]
|
|
word iobuf_addr[MAX_IOBUFS] = sysbuf
|
|
//
|
|
// ProDOS/SOS routines
|
|
//
|
|
def a1getpfx(path)
|
|
^path = 0
|
|
return path
|
|
end
|
|
def a2getpfx(path)
|
|
byte params[3]
|
|
|
|
^path = 0
|
|
params.0 = 1
|
|
params:1 = path
|
|
perr = syscall($C7, @params)
|
|
return path
|
|
end
|
|
def a3getpfx(path)
|
|
byte params[4]
|
|
|
|
params.0 = 2
|
|
params:1 = path
|
|
params.3 = 64
|
|
perr = syscall($C7, @params)
|
|
return path
|
|
end
|
|
def a1setpfx(path)
|
|
return path
|
|
end
|
|
def a2setpfx(path)
|
|
byte params[3]
|
|
|
|
params.0 = 1
|
|
params:1 = path
|
|
perr = syscall($C6, @params)
|
|
return path
|
|
end
|
|
def a3setpfx(path)
|
|
byte params[6]
|
|
byte fileinfo[2]
|
|
char fullpath[65]
|
|
|
|
if ^path and ^(path + 1) <> '/' and ^(path + 1) <> '.'
|
|
a3getpfx(@fullpath)
|
|
strcat(@fullpath, path)
|
|
path = @fullpath
|
|
fin
|
|
params.0 = 3
|
|
params:1 = path
|
|
params:3 = @fileinfo
|
|
params.5 = 2
|
|
if not syscall($C4, @params) and (fileinfo.1 == $00 or fileinfo.1 == $0F) // Make sure it's a directory
|
|
params.0 = 1
|
|
params:1 = path
|
|
syscall($C6, @params)
|
|
else
|
|
a3getpfx(path) // Get current path
|
|
fin
|
|
return path
|
|
end
|
|
def a1getfileinfo(path, fileinfo)
|
|
perr = $01
|
|
return perr
|
|
end
|
|
def a2getfileinfo(path, fileinfo)
|
|
byte params[18]
|
|
|
|
params.0 = 10
|
|
params:1 = path
|
|
perr = syscall($C4, @params)
|
|
memcpy(fileinfo, @params + 3, 15)
|
|
return perr
|
|
end
|
|
def a3getfileinfo(path, fileinfo)
|
|
byte params[6]
|
|
|
|
params.0 = 3
|
|
params:1 = path
|
|
params:3 = fileinfo
|
|
params.5 = 15
|
|
perr = syscall($C4, @params)
|
|
return perr
|
|
end
|
|
def a1setfileinfo(path, fileinfo)
|
|
perr = $01
|
|
return perr
|
|
end
|
|
def a2setfileinfo(path, fileinfo)
|
|
byte params[14]
|
|
|
|
params.0 = 7
|
|
params:1 = path
|
|
memcpy(@params + 3, fileinfo, 11)
|
|
perr = syscall($C3, @params)
|
|
return perr
|
|
end
|
|
def a3setfileinfo(path, fileinfo)
|
|
byte params[6]
|
|
|
|
params.0 = 3
|
|
params:1 = path
|
|
params:3 = fileinfo
|
|
params.5 = 15
|
|
perr = syscall($C3, @params)
|
|
return perr
|
|
end
|
|
def a1geteof(refnum)#2
|
|
return 0, 0
|
|
end
|
|
def a23geteof(refnum)#2
|
|
byte params[5]
|
|
|
|
params.0 = 2
|
|
params.1 = refnum
|
|
params:2 = 0
|
|
params.4 = 0
|
|
syscall($D1, @params)
|
|
return params:2, params.4
|
|
end
|
|
def a1seteof(refnum, eofl, eofh)
|
|
return 0
|
|
end
|
|
def a23seteof(refnum, eofl, eofh)
|
|
byte params[5]
|
|
|
|
params.0 = 2
|
|
params.1 = refnum
|
|
params:2 = eofl
|
|
params.4 = eofh
|
|
syscall($D0, @params)
|
|
return params:2
|
|
end
|
|
def a1open(path)
|
|
*CFFA1FileName = path
|
|
return 0
|
|
end
|
|
def a2iobufs(iobufs)
|
|
byte i
|
|
word freebuf, bufaddr
|
|
|
|
if iobufs > MAX_IOBUFS
|
|
iobufs = MAX_IOBUFS
|
|
fin
|
|
if iobufs
|
|
iobufs-- // Subtract off system I/O buffer
|
|
if iobufs
|
|
bufaddr = heapallocalign(1024 * iobufs, 8, @freebuf)
|
|
for i = 1 to MAX_IOBUFS-1
|
|
if not iobuf_addr[i]
|
|
iobuf_addr[i] = bufaddr
|
|
bufaddr = bufaddr + 1024
|
|
iobufs--
|
|
if not iobufs
|
|
return freebuf
|
|
fin
|
|
fin
|
|
next
|
|
return freebuf
|
|
fin
|
|
else
|
|
for i = 1 to MAX_IOBUFS-1
|
|
iobuf_addr[i] = 0 // Free I/O buffers if 0 passed in
|
|
next
|
|
fin
|
|
return 0
|
|
end
|
|
def a13iobufs(iobufs)
|
|
return 0
|
|
end
|
|
def a2open(path)
|
|
byte i, params[6]
|
|
|
|
for i = MAX_IOBUFS-1 downto 0
|
|
if iobuf_addr[i] and not iobuf_ref[i]
|
|
params.0 = 3
|
|
params:1 = path
|
|
params:3 = iobuf_addr[i]
|
|
params.5 = 0
|
|
perr = syscall($C8, @params)
|
|
iobuf_ref[i] = params.5
|
|
return params.5
|
|
fin
|
|
next
|
|
return 0
|
|
end
|
|
def a3open(path)
|
|
byte params[7]
|
|
|
|
params.0 = 4
|
|
params:1 = path
|
|
params.3 = 0
|
|
params:4 = 0
|
|
params.6 = 0
|
|
perr = syscall($C8, @params)
|
|
return params.3
|
|
end
|
|
def a1close(refnum)
|
|
return perr
|
|
end
|
|
def a2close(refnum)
|
|
byte i, params[2]
|
|
|
|
for i = MAX_IOBUFS-1 downto 0
|
|
if refnum == iobuf_ref[i]
|
|
iobuf_ref[i] = 0
|
|
params.0 = 1
|
|
params.1 = refnum
|
|
perr = syscall($CC, @params)
|
|
return perr
|
|
fin
|
|
next
|
|
perr = $45
|
|
return perr
|
|
end
|
|
def a3close(refnum)
|
|
byte params[2]
|
|
|
|
params.0 = 1
|
|
params.1 = refnum
|
|
perr = syscall($CC, @params)
|
|
return perr
|
|
end
|
|
def a1read(refnum, buf, len)
|
|
*CFFA1Dest = buf
|
|
perr = syscall($22, 0) // This reads the entire file from CFFA
|
|
return perr
|
|
end
|
|
def a23read(refnum, buf, len)
|
|
byte params[8]
|
|
|
|
params.0 = 4
|
|
params.1 = refnum
|
|
params:2 = buf
|
|
params:4 = len
|
|
params:6 = 0
|
|
perr = syscall($CA, @params)
|
|
return params:6
|
|
end
|
|
def a1write(refnum, buf, len)
|
|
return perr
|
|
end
|
|
def a2write(refnum, buf, len)
|
|
byte params[8]
|
|
|
|
params.0 = 4
|
|
params.1 = refnum
|
|
params:2 = buf
|
|
params:4 = len
|
|
params:6 = 0
|
|
perr = syscall($CB, @params)
|
|
return params:6
|
|
end
|
|
def a3write(refnum, buff, len)
|
|
byte params[6]
|
|
|
|
params.0 = 3
|
|
params.1 = refnum
|
|
params:2 = buff
|
|
params:4 = len
|
|
perr = syscall($CB, @params)
|
|
return perr ?? 0 :: len
|
|
end
|
|
def a1create(path, type, aux)
|
|
return perr
|
|
end
|
|
def a2create(path, type, aux)
|
|
byte params[12]
|
|
|
|
params.0 = 7
|
|
params:1 = path
|
|
params.3 = $C3
|
|
params.4 = type
|
|
params:5 = aux
|
|
params.7 = type == $0F ?? $0D :: $01
|
|
params:8 = 0
|
|
params:10 = 0
|
|
perr = syscall($C0, @params)
|
|
return perr
|
|
end
|
|
def a3create(path, type, aux)
|
|
byte params[6]
|
|
byte options[4]
|
|
|
|
params.0 = 3
|
|
params:1 = path
|
|
params:3 = @options
|
|
params.5 = 4
|
|
options.0 = type
|
|
options:1 = aux
|
|
options.3 = type == $0F ?? $0D :: $01
|
|
perr = syscall($C0, @params)
|
|
return perr
|
|
end
|
|
def a1destroy(path)
|
|
perr = $01
|
|
return perr
|
|
end
|
|
def a23destroy(path)
|
|
byte params[3]
|
|
|
|
params.0 = 1
|
|
params:1 = path
|
|
perr = syscall($C1, @params)
|
|
return perr
|
|
end
|
|
def a1rename(oldpath, newpath)
|
|
perr = $01
|
|
return perr
|
|
end
|
|
def a23rename(path, newpath)
|
|
byte params[5]
|
|
|
|
params.0 = 2
|
|
params:1 = path
|
|
params:3 = newpath
|
|
perr = syscall($C2, @params)
|
|
return perr
|
|
end
|
|
def a1newline(refnum, emask, nlchar)
|
|
return perr
|
|
end
|
|
def a2newline(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
|
|
def a3newline(refnum, emask, nlchar)
|
|
byte params[4]
|
|
|
|
params.0 = 3
|
|
params.1 = refnum
|
|
params.2 = emask ?? $FF :: $00
|
|
params.3 = nlchar
|
|
perr = syscall($C9, @params)
|
|
return perr
|
|
end
|
|
def a1online(unit, buf)
|
|
perr = $27 // IOERR
|
|
return perr
|
|
end
|
|
def a2online(unit, buf)
|
|
byte params[4]
|
|
|
|
params.0 = 2
|
|
params.1 = unit
|
|
params:2 = buf
|
|
perr = syscall($C5, @params)
|
|
return perr
|
|
end
|
|
def a3volume(unit, volname)
|
|
byte devname[17]
|
|
byte info[11]
|
|
byte params[9]
|
|
|
|
^volname = 0
|
|
params.0 = 4
|
|
params.1 = unit
|
|
params:2 = @devname
|
|
params:4 = @info
|
|
params.6 = 11
|
|
if syscall($85, @params) == 0
|
|
params.0 = 4
|
|
params:1 = @devname
|
|
params:3 = volname
|
|
params:5 = 0
|
|
params:7 = 0
|
|
return syscall($C5, @params)
|
|
fin
|
|
return -1
|
|
end
|
|
def a3online(unit, buf)
|
|
byte info[11]
|
|
byte volname[17]
|
|
byte i
|
|
|
|
if unit == 0
|
|
for i = $01 to $0F
|
|
if a3volume(i, buf) == 0
|
|
^buf = ^buf | (i << 4)
|
|
fin
|
|
buf = buf + 16
|
|
next
|
|
else
|
|
return a3volume(unit, buf)
|
|
fin
|
|
return 0
|
|
end
|
|
def a13readblock(unit, buf, block)
|
|
perr = $27 // IOERR
|
|
return perr
|
|
end
|
|
def a2readblock(unit, buf, block)
|
|
byte params[6]
|
|
|
|
params.0 = 3
|
|
params.1 = unit
|
|
params:2 = buf
|
|
params:4 = block
|
|
perr = syscall($80, @params)
|
|
return perr
|
|
end
|
|
def a13writeblock(unit, buf, block)
|
|
perr = $27 // IOERR
|
|
return perr
|
|
end
|
|
def a2writeblock(unit, buf, block)
|
|
byte params[6]
|
|
|
|
params.0 = 3
|
|
params.1 = unit
|
|
params:2 = buf
|
|
params:4 = block
|
|
perr = syscall($81, @params)
|
|
return perr
|
|
end
|
|
//
|
|
// Machine specific initialization.
|
|
//
|
|
when MACHID & MACHID_MODEL
|
|
is MACHID_III
|
|
fileio:getpfx = @a3getpfx
|
|
fileio:setpfx = @a3setpfx
|
|
fileio:getfileinfo = @a3getfileinfo
|
|
fileio:setfileinfo = @a3setfileinfo
|
|
fileio:iobufalloc = @a13iobufs
|
|
fileio:open = @a3open
|
|
fileio:close = @a3close
|
|
fileio:write = @a3write
|
|
fileio:create = @a3create
|
|
fileio:newline = @a3newline
|
|
fileio:online = @a3online
|
|
fileio:readblock = @a13readblock
|
|
fileio:writeblock = @a13writeblock
|
|
break
|
|
is MACHID_I
|
|
fileio:getpfx = @a1getpfx
|
|
fileio:setpfx = @a1setpfx
|
|
fileio:getfileinfo = @a1getfileinfo
|
|
fileio:setfileinfo = @a1setfileinfo
|
|
fileio:geteof = @a1geteof
|
|
fileio:seteof = @a1seteof
|
|
fileio:iobufalloc = @a13iobufs
|
|
fileio:open = @a1open
|
|
fileio:close = @a1close
|
|
fileio:read = @a1read
|
|
fileio:write = @a1write
|
|
fileio:create = @a1create
|
|
fileio:destroy = @a1destroy
|
|
fileio:rename = @a1rename
|
|
fileio:newline = @a1newline
|
|
fileio:online = @a1online
|
|
fileio:readblock = @a13readblock
|
|
fileio:writeblock = @a13writeblock
|
|
break
|
|
otherwise // Apple ][
|
|
wend
|
|
//
|
|
// Keep module in memory
|
|
//
|
|
return modkeep
|
|
done
|