! 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