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