! Filestore Module
option "-low-nocheck-nodiag-noline-nostack"
include "moose:mouse.inc"
Include "sys:ether.inc"
Include "fsconsts.inc"
recordformat fsreqfm(record (messagefm) msg,
Integerarray i(1:4))
systemintegerfnspec stoi (String (*) s)
RecordFormat ownerfm (Integer uno, Record (ownerfm)name next)
constinteger buffersize = 512
Ownrecord (ownerfm)name owner list
ownrecord (fsreqfm)name rep ;! Belong to FS Process
ownrecord (mailboxfm)name ombox ;! " " "
ownrecord (fsreqfm) req
ownrecord (mailboxfm) imbox
Ownrecord (semaphorefm) sem
Ownstring (255) errmess=""
owninteger initialised = 0
Routine Transact
Integer i
req_i(2) = addr(errmess)
send message (req, ombox, imbox)
rep == receive message (imbox)
i = rep_i(1)
Signal 3,i,0,errmess If i # fs success
End
integerfn Translate Addr (String (*)name s)
integer lives = 9
on 4 start
Signal 3,0,0,"Bad filestore name"
Finish
Cycle
lives = lives - 1
Repeatuntil not translatelogicalname (s) or lives = 0
Signal 3,0,0,"Translation looping" if lives = 0
result = stoi (s)
End
Routine Split Filename (String (*)name infile, outfile, fsaddr,
Integername fsrdte)
unless split(infile,nil,outfile) Start ; Finish
Unless split(outfile,nil,outfile) start ; finish
fsaddr = "FS_DEFAULT" unless outfile -> fsaddr.("::").outfile
fsrdte = translate addr (fsaddr)
End
routine initialise
Integer bytes,i,t
return unless initialised = 0
setup semaphore (sem)
setup mailbox (imbox, sem)
setup message (req, sizeof(req))
t = Find Entry ("FS_REQUESTS", poa_logdict)
Signal 3,0,0,"Failed to find FS_REQUESTS" if t =0
ombox == record(integer(t))
ownerlist==nil
initialised = 1
End
integerfn Determine Uno (integer rdte)
record (ownerfm)name own
own == ownerlist
while own ## NIL cycle
! putstring("=>");putlong(own_uno)
Result = own_uno if own_uno>>8 = rdte
own == own_next
repeat
Result = rdte<<8
End
ExternalRoutine Logon To Filestore (String (127) fsaddr,user,password)
Integer rdte
Record (ownerfm)name own,p==NIL,no
Record (passfm) pass=0
signal 3,4,0,"Invalid username" If user=""
fsaddr="FS_DEFAULT" if fsaddr=""
rdte = translate addr (fsaddr)
own == owner list
While own ## NIL cycle
Signal 3,4,0,"Still logged onto filestore" If own_uno>>8=rdte
p==own; own==own_next
Repeat
pass_owner=user; pass_password=password
req_i(1) = fs logon
req_i(3) = rdte
req_i(4) = addr(pass)
transact
no == new(no) ; no=0
no_next == NIL
no_uno = rep_i(2)
if owner list == NIL start
owner list == no
Else
p_next == no
Finish
End
Routine Access File (Integer uno, String (255) s, integer mode,
integername token, size)
!putstring("*AF*")
if mode = input mode start
!putstring("Access file")
req_i(1) = fs open file
req_i(3) = uno
req_i(4) = addr(s)
transact
!putstring("Fs spoke");
token = rep_i(2)
size = rep_i(3)
!putstring("File opened. Token = ");putlong(rep_i(2));putsym(10)
Else
! putstring("Create file")
size = 0
req_i(1) = fs create file
req_i(3) = uno
req_i(4) = addr(s)
transact
token = rep_i(2)
Finish
End
Routine Deaccessfile (integer token)
req_i(1) = fs close file
req_i(3) = token
transact
!! putstring("File deaccessed");putsym(10)
End
Integerfn Read Block (integer token, position, amount, bytename buf)
Record (blockfm) bl
bl_token = token
bl_amount = amount
bl_buffer = addr(buf)
bl_position = position
req_i(1) = fs read file
req_i(3) = addr(bl)
transact
!!Putstring("Read Block completed");putsym(10)
Result = rep_i(2)
End
Integerfn Write Block (Integer token, position, amount, bytename buf)
Record (blockfm) bl
bl_token = token
bl_position = position
bl_amount = amount
bl_buffer = addr(buf)
req_i(1) = fs write file
req_i(3) = addr(bl)
transact
result = rep_i(2)
End
externalrecord (scb fm)map xopen alias "r_open" -
(integer mode, string (255)file)
record (scb fm)name scb
integer x,fsrdte,uno
string (127) fsaddr
routine refresh(record (scb fm)name scb)
integer amount,diff{,offset,pos}
signal 9,,,"End of file" if scb_p>=scb_fl
{ offset = rem(scb_p-scb_fs,scb_bl-scb_bs)}
{ pos = scb_p-offset; dif = scb_bs-pos}
diff = scb_bs-scb_p+rem(scb_p-scb_fs,scb_bl-scb_bs)
scb_fs = scb_fs+diff
scb_fl = scb_fl+diff
scb_p = scb_p+diff
amount = scb_fl-scb_bs {rest of file}
amount = scb_bl-scb_bs if scb_fl>scb_bl {if it fits}
scb_l = scb_p+readblock(scb_b,scb_p-scb_fs,amount,byteinteger(scb_p))
end
routine flush(record (scb fm)name scb,integer sym)
integer dump
scb_fl = scb_p if scb_p>scb_fl
scb_p = scb_bl if scb_p<scb_fl
dump = writeblock(scb_b,scb_bs-scb_fs,scb_p-scb_bs,byteinteger(scb_bs))
if scb_p=scb_bl start
scb_fs = scb_fs-buffersize; scb_fl = scb_fl-buffersize
finish
scb_p = scb_bs; scb_l = scb_bl
byteinteger(scb_p) = sym and scb_p = scb_p+1 unless sym<0
end
routine closin(record (scb fm)name scb)
integer x
x = scb_b; scb_b = 0
heapput(scb_a) unless scb_a=0
deaccessfile(x)
heapput(scb_bs); scb_bs = 0
!!putstring("File closed");putsym(10)
end
routine closout(record (scb fm)name scb,integer mode)
integer x
flush(scb,-1)
x = scb_b; scb_b = 0
deaccessfile(x) ;!%if mode=0 {??}
heapput(scb_bs); scb_bs = 0
end
routine setin(record (scb fm)name scb,integer pos)
scb_p = scb_fs+pos
scb_l = scb_p unless scb_bs<=scb_p<=scb_l
end
routine setout(record (scb fm)name scb,integer pos)
flush(scb,-1) unless scb_p=scb_bs
signal 2,,,"writing off end of file" if scb_fs+pos-scb_fl>0
scb_p = scb_fs+pos
refresh(scb)
scb_p = scb_fs+pos
scb_l = scb_bl
end
routine service(record (scb fm)name scb,integer op,parm)
switch sw(0:7)
returnif scb_b=0
->sw(op&7)
sw(serclosin): closin(scb); return
sw(serclosout): closout(scb,0); return
sw(serprompt): return
sw(serdropout): closout(scb,1); return
sw(sersetin): setin(scb,parm); return
sw(sersetout): setout(scb,parm); return
sw(serrefresh): refresh(scb); return
sw(serflush): flush(scb,parm)
end
!!putstring("Filename=");putstring(file);putsym(10)
!!putstring ("FS Open file, gla = ");putlong(a4);putsym(10)
initialise if initialised = 0
scb == new scb(file)
unless split(scb_filename,nil,file) start ; finish
unless split(file,nil,file) start ; finish
fsaddr = "FS_DEFAULT" unless file -> fsaddr.("::").file
fs rdte = translate addr (fsaddr)
uno = determine uno (fs rdte)
scb_mode = mode
scb_gla = a4
*lea service,a0; *move.l a0,x
scb_serpc = x
if mode=inputmode start
*lea refresh,a0; *move.l a0,x
scb_fastpc = x
accessfile(uno,file,inputmode,scb_b,scb_fl)
else
*lea flush,a0; *move.l a0,x
scb_fastpc = x
accessfile(uno,file,outputmode,scb_b,scb_fl)
scb_fl = 0
finish
scb_bs = heapget(buffersize)
scb_bl = scb_bs+buffersize
scb_fs = scb_bs
scb_fl = scb_bs+scb_fl
scb_p = scb_bs
scb_l = scb_bl
scb_l = scb_bs if mode=inputmode
result == scb
end