%include "moose:mouse.inc"
%option "-low-nocheck-nodiag-noline-nostack"
%include "sys:fsconsts.inc"
%include "sys:ether.inc"

%recordformat fsreqfm(%record(messagefm) msg,
                      %Integerarray i(1:4))

!                         _^]\[ZYXWVUTSRQPONMLKJIHGFEDCBA@
%constinteger allowed = 2_01111111101111111111111111111111,
              simple  = 2_01001000011110111011110100111111,
              writer  = 2_00000010100000000000000000000000,
              reader  = 2_00110001000001000100001011000000,
              z       = 2_00000100000000000000000000000000
%conststring(31)bad = "Bad filestore command"

%owninteger command letter=0, command bit=0
%Owninteger uno=0, rdte, lsap

%Recordformat Connfm (%Integer rdte,
                      %Integer lsap, rsap,
                      %Record(connfm)%name next)

%Ownrecord(connfm)%name conns

%ownrecord(mailboxfm)      mbox
%ownrecord(semaphorefm)    sem

%ownbytearray   pbuffer (0:1023)
%ownbyteinteger pbytes

%Routine initialise
   %Record(dictfm)%name m
   %integer i

   putstring ("Filestore process. Version of 17/7/86");putsym(10)

   setup semaphore (sem)
   setup mailbox (mbox, sem)

   ether start
   conns == NIL

   m == poa_logdict
   m == m_alt %while m_alt ## Nil
   i = Make Entry ("FS_REQUESTS",m)
   %If i = 0 %start
      putstring ("Filestore process failed to create mailbox");putsym(10)
      %Stop
   %Finish
   integer (i) = addr(mbox)
%End

%routine error(%string(255)%name s)
%bytename b
  %string(255) p
  p = substring(s,3,length(s))
  %if charno(p,length(p))= nl %then length(p)=length(p)-1
  %signal 3,3,charno(s,2)-'0',p
%end

%predicate okok(%integer mask)
  %falseif commandbit&mask=0
  %true
%end

%predicate ok(%integer cl)
  %falseunless cl>='@'
  commandletter = cl&95
  commandbit = 1<<(cl&31)
  %trueif okok(allowed)
  %false
%end

%Routine fc(%string(255)%name command,response,
                    %integer port,%integername bytes,%bytename buffer)

!Perform a filestore interchange, i.e. send the command line in COMMAND,
!followed by the BYTES-byte data at BUFFER (if the command is of the
!write-kind), then read a response, putting the response line part of it
!into RESPONSE, and the rest (if the command is of the read-kind) into
!the BUFFER, setting BYTES accordingly.
!In the read case, BYTES is both an input (which tells us how big the
!buffer is) and an output (which tells the caller how big the data-part
!of the packet was).
!The Z-command (read whole file) is a special case, and here we send the
!command and receive the response and as many packets as the filestore
!sends us.

%bytearray buf(0:531)
%integer linelength,size

  %routine append(%integer ch)
    command = command.tostring(ch)
  %end

  %routine phex(%integer n)
!Append HD-hex number to command line
    phex(n>>4) %and n = n&15 %if n>>6#0
    append(n+'0')
  %end

  %routine move(%integer bytes,%bytename from,to)
  %label x,y
    *subq #1,d0
    *ble y
  x:*move.b (a0)+,(a1)+
    *dbra d0,x
  y:
  %end

  %routine scan
    linelength = 0
    linelength = linelength+1 %until linelength=80 %or buf(linelength-1)=nl
  %end

  !putstring("FC")
  %signal 3,4,0,bad %unless ok(charno(command,1))
  length(command) = length(command)-1 %if charno(command,length(command))=nl
  append(',') %and phex(bytes) %if commandbit&writer#0
  append(nl)
  %if commandbit&writer#0 %start
    bytes = 0 %if bytes<0
    bytes = 512 %if bytes>512
    move(length(command),charno(command,1),buf(0))
    move(bytes,buffer,buf(length(command)))
    ethertransmitblock(port,length(command)+bytes,buf(0))
    etherreceiveblock(port,532,size,buf(0))
    scan
    length(response) = linelength
    move(linelength,buf(0),charno(response,1))
  %else
    ethertransmitblock(port,length(command),charno(command,1))
    etherreceiveblock(port,532,size,buf(0))
    scan
    length(response) = linelength
    move(length(response),buf(0),charno(response,1))
    !putstring("Response=".response);putsym(10)
    %if commandbit&reader#0 %start
      size = size-linelength
      size = 0 %if size<0
      size = bytes %if size>bytes
      bytes = size
      move(size,buf(linelength),buffer)
    %elseif commandbit&z#0
      %returnif charno(response,1)='-'; !Error response
      size = 0
      %cycle
        etherreceiveblock(port,bytes,linelength,buffer)
        bytes = bytes-linelength; size = size+linelength
        buffer == byteinteger(addr(buffer)+linelength)
      %repeatuntil linelength#512;      !Keep going till we get an
      bytes = size;                     !incomplete (possibly empty) block.
    %finish
  %finish
%end

%externalintegerfn fcomm(%Integer lsap, %integer cn,%string(255)s)
!Backward compatible.  Perform a filestore interchange with a non-read,
!non-write command.  CN contains the command letter (<<8) and the
!reference number digit (user number of transaction number), S contains
!the parameters if any.  The result is the numeric filestore response,
!unless there is an error response, in which case we bomb out.
  cn = cn+uno+'0' %if cn&255=0;  !Frig: substitute logged-on user number
  %signal 3,4,0,bad %unless ok(cn>>8) %and okok(simple)
  uno = 0 %if commandletter='M'; !Forget user number if logging off
  s = tostring(cn>>8).tostring(cn).s
  fc(s,s,lsap,integer(0),byteinteger(0))
  error (s) %if charno(s,1)='-'
!  %signal 3,4,charno(s,2)-'0',substring(s,3,length(s)) %if charno(s,1)='-'
  cn = charno(s,1)-'0'
  uno = cn %if commandletter = 'L'; !Remember user number if logging on
  %result = cn
%end

%externalroutine fcommw(%Integer lsap,%integer cn,%string(255)s,
                        %bytename buffer,%integer size)
!Backward compatible filestore interchange, write-command.
  %signal 3,4,0,bad %unless ok(cn>>8) %and okok(writer)
  s = tostring(cn>>8).tostring(cn).s
  fc(s,s,lsap,size,buffer)
!  %signal 3,4,charno(s,2)-'0',substring(s,3,length(s)) %if charno(s,1)='-'
   error(s) %if charno (s,1) = '-'
%end

%externalintegerfn fcommr(%integer lsap,%integer cn,%string(255)s,
                          %bytename buffer,%integer max)
!Backward compatible filestore interchange, read-command.
  cn = cn+uno+'0' %if cn&255=0
  %signal 3,4,0,bad %unless ok(cn>>8) %and okok(reader)
  s = tostring(cn>>8).tostring(cn).s
!  PUTSTRING("LSAP=");putlong(lsap);putsym(10)
  !putstring("<<".s);putsym(10)
  fc(s,s,lsap,max,buffer)
  !putstring(">>".s);putsym(10)
!  %signal 3,4,charno(s,2)-'0',substring(s,3,length(s)) %if charno(s,1)='-'
  error(s) %if charno(s,1) = '-'
  %result = max
%end

%Integerfn Get Lsap (%Integer rdte)
   %Record(connfm)%name c, p==NIL, nc
   %Integer bytes, lsap, rsap

   c == conns
   %While c ## NIL %cycle
      %result = c_lsap %if c_rdte = rdte
      p == c; c==c_next
   %Repeat

   lsap = ether allocate port
   ether open port (lsap, rdte, 0)
   pbuffer(0) = 2
   ether transmit block (lsap, 1, pbuffer(0))
   pbuffer(0) = 12
   ether transmit block (lsap, 1, pbuffer(0))
   ether receive block (lsap, 512, bytes, pbuffer(0))
   %If pbuffer(0) = '-' %start
      %signal 3, 4, 0, "Filestore refused to give a port"
   %Finish
   rsap = pbuffer(0)-'0'
   ether close port (lsap)
   ether open port (lsap, rdte, rsap)
   nc == new (nc); nc = 0
   nc_next == NIL
   nc_lsap = lsap
   nc_rsap = rsap
   nc_rdte = rdte
   %if conns == NIL %start
      conns == nc
   %Else
      p_next == nc
   %finish
   %Result = lsap
%End

%string(9)%fn itohmd(%Integer x)
%string(9) s=""
   %routine put(%Integer n)
      put(n>>4) %and n=n&15 %if n>>6#0
      s=s.tostring(n+'0')
   %end
   put(x)
   %result = s
%End

%Routine logon  (%Record(fsreqfm)%name r)
   %Record(passfm)%name pass
   %integer pos=1
   %String(255) fn

   %integerfn hex
      %integer n=0,k
      %cycle
         %result = n %if pos >= length(fn); pos=pos+1
         k = charno (fn,pos-1)-'0'
         %result = n %if k < 0
         n = n<<4+k
      %Repeat
   %End
         
   pass == record(r_i(4))
   rdte = r_i(3)
   lsap = get lsap (rdte)
   fn = "L0".pass_owner.",".pass_password
   fc (fn,fn,lsap,nil,nil)
   error(fn) %if charno(fn,1)='-'
   uno = hex
   r_i(1) = 1
   r_i(2) = uno+rdte<<8
%End

%Routine logoff (%Record(fsreqfm)%name r)
   putstring("Logoff request")
%End

%Routine open file (%Record(fsreqfm)%name r)
   %integer pos=1,xno,blocks,pad
   %String(255) fn 

   %integerfn hex
      %integer n=0,k
      %cycle
         %result = n %if pos >= length(fn); pos=pos+1
         k = charno (fn,pos-1)-'0'
         %result = n %if k < 0
         n = n<<4+k
      %Repeat
   %End

   uno = r_i(3)
   rdte = uno >> 8
   lsap = get lsap (rdte)
   uno = uno & 255
   fn = "S".itohmd(uno).string(r_i(4))
   fc (fn,fn,lsap,nil,nil)
   error(fn) %if charno(fn,1)='-'
   xno = hex; blocks=hex; pad=hex
   r_i(1) = 1
   r_i(2) = xno+rdte<<8
   r_i(3) = blocks<<9-pad
%End

%Routine create file (%Record(fsreqfm)%name r)
   %Integer p

   !putstring("create file request")
   uno = r_i(3)
   rdte = uno >> 8
   lsap = get lsap (rdte)
   uno = uno & 255
   p = fcomm (lsap,'T0'+uno,string(r_i(4)))
   r_i(1) = 1
   r_i(2) = p+rdte<<8
%End

%Routine read file (%Record(fsreqfm)%name r)
   %Record(blockfm)%name bl
   %bytename buff
   %Integer xno
   %Integer max=0, total=0, this

   bl == record(r_i(3))
   xno = bl_token
   lsap = get lsap (xno>>8)   
   xno = xno & 255
   buff == byteinteger(bl_buffer)
   !putstring("RF");putsym(10)
   %cycle
!      putstring("Pos=");putlong(bl_position>>9);putsym(10)
      this = fcommr (lsap,'R0'+xno,itohmd(bl_position>>9),buff,512)
      %exitif this = 0
      max = this %if this > max
      %exitif this < max
      buff == buff[this]
      total=total+this
      bl_position = bl_position + this
 !     putstring("tot=");putlong(total);putstring(" amo=");putlong(bl_amount)
 !     putsym(10)
   %Repeatuntil total=bl_amount %or this < 512 {Catch VAX}
   r_I(1) = 1
   r_i(2) = total
%End

%Routine write file (%Record(fsreqfm)%name r)
   %record(blockfm)%name bl
   %bytename buff
   %Integer xno, this, total=0

   !putstring("write file request")
   bl == record(r_i(3))
   xno = bl_token
   lsap = get lsap (xno>>8)
   xno = xno&255
   buff == byteinteger(bl_buffer)
   %Cycle
      this = bl_amount - total
      this = 512 %if this > 512
      fcommw (lsap,'W0'+xno,itohmd(bl_position>>9),buff,this)
      bl_position = bl_position + this
      buff == buff[this]
      total = total+this
   %Repeatuntil total=bl_amount
   r_i(1) = 1
   r_i(2) = total
%End

%Routine close file (%Record(fsreqfm)%name r)
   %integer xno,p

   xno = r_i(3)
   lsap = get lsap (xno>>8)
   xno = xno & 255
   p = fcomm (lsap,'K0'+xno,"") %unless xno=0
   r_i(1) = 1
%End

%Routine delete file (%Record(fsreqfm)%name r)
%End

%Routine copy file (%Record(fsreqfm)%name r)
%End

%Routine rename file (%Record(fsreqfm)%name r)
%End

%Routine Handle Request (%Record(fsreqfm)%name r)
   %Constinteger last = 10
   %Switch sw(1:last)

   %on 3 %start
      r_i(1) = 0
      string(r_i(2))=event_message
      %Return
   %Finish
            
   -> bum %unless 1 <= r_i(1) <= last
   -> sw(r_i(1))

sw(fs logon):        logon(r)       ; %Return
sw(fs logoff):       logoff(r)      ; %Return
sw(fs open file):    open file(r)   ; %Return
sw(fs create file):  create file(r) ; %Return
sw(fs read file):    read file(r)   ; %Return
sw(fs write file):   write file(r)  ; %Return
sw(fs close file):   close file(r)  ; %Return
sw(fs delete file):  delete file(r) ; %Return
sw(fs copy file):    copy file(r)   ; %Return
sw(fs rename file):  rename file(r) ; %Return

bum:  r_i(1) = 0
      string(r_i(2)) = "Bad function code"
      %Return
%End

%Begin
   %Record(fsreqfm)%name req

   initialise

   %cycle
!!      putstring("FP Snore");putsym(10)
      req == receive message (mbox)
!!      putstring("FP Alarm");putsym(10)
      handle request (req)
      send message (req,req_msg_reply,nil)
   %repeat

%Endofprogram