! System process -- interpret and execute packets
! Wait for something to arrive on the file system service queue.
! Remove it, interpret the command letter and call the file system
! with the appropriate parameters.

%option "-nocheck-nostack-noline"

%include "Config.Inc"

%include "System:Common"
%include "System:Utility.Inc"
%include "System:Schedule.Inc"
%include "System:Errors.Inc"

%include "Inc:Util.Imp"

%ownrecord(common fm)%name common
%externalrecord(common fm)%mapspec common area

%externalintegerspec ether context

%externalpredicatespec NAKed(%integer ether context)


! Filestore error messages.  Convert the error code into a textual
! form, substituting culprit fields as appropriate.

%constinteger bad          errc  =  1
%constinteger context      errc  =  2
%constinteger not          errc  =  3
%constinteger implemented  errc  =  4
%constinteger illegal      errc  =  5
%constinteger Xno          errc  =  6
%constinteger param        errc  =  7
%constinteger error        errc  =  8
%constinteger no           errc  =  9
%constinteger protocol     errc  = 10
%constinteger Uno          errc  = 11
%constinteger logged       errc  = 12
%constinteger on           errc  = 13
%constinteger file         errc  = 14
%constinteger in           errc  = 15
%constinteger use          errc  = 16
%constinteger found        errc  = 17
%constinteger owner        errc  = 18
%constinteger authority    errc  = 19
%constinteger quota        errc  = 20
%constinteger slot         errc  = 21
%constinteger extent       errc  = 22
%constinteger for          errc  = 23
%constinteger disc         errc  = 24
%constinteger full         errc  = 25
%constinteger system       errc  = 26
%constinteger down         errc  = 27
%constinteger exists       errc  = 28
%constinteger protected    errc  = 29
%constinteger user         errc  = 30
%constinteger operation    errc  = 31
%constinteger buffer       errc  = 32
%constinteger size         errc  = 33
%constinteger directory    errc  = 34
%constinteger corrupt      errc  = 35
%constinteger refcount     errc  = 36
%constinteger negative     errc  = 37
%constinteger partition    errc  = 38
%constinteger data         errc  = 39
%constinteger address      errc  = 40
%constinteger logins       errc  = 41
%constinteger are          errc  = 42
%constinteger disabled     errc  = 43
%constinteger writeable    errc  = 44
%constinteger empty        errc  = 45
%constinteger process      errc  = 46
%constinteger conflicting  errc  = 47
%constinteger access       errc  = 48

%constinteger last         errc  = access errc

%constinteger culprit      errc  = 255

%conststring(15)%array text(1 : last errc) =
      "bad", "context", "not", "implemented", "illegal",
      "Xno", "param", "error", "no", "protocol", "Uno",
      "logged", "on", "file", "in", "use", "found", "owner",
      "authority", "quota", "slot", "extent", "for", "disc",
      "full", "system", "down", "exists", "protected", "user",
      "operation", "buffer", "size", "directory", "corrupt",
      "refcount", "negative", "partition", "data", "address",
      "logins", "are", "disabled", "writeable", "empty", "process",
      "conflicting", "access"

%constbytearray error text(1 : 4 * last error) =
{ 1}  bad errc, context errc, 0, 0,
{ 2}  not errc, implemented errc, 0, 0,
{ 3}  illegal errc, Xno errc, 0, 0,
{ 4}  param errc, error errc, culprit errc, 0,
{ 5}  no errc, Xno errc, 0, 0,
{ 6}  protocol errc, error errc, 0, 0,
{ 7}  illegal errc, Uno errc, 0, 0,
{ 8}  not errc, logged errc, on errc, 0,
{ 9}  directory errc, culprit errc, corrupt errc, 0,
{10}  file errc, culprit errc, in errc, use errc,
{11}  file errc, culprit errc, not errc, found errc,
{12}  owner errc, culprit errc, not errc, found errc,
{13}  no errc, authority errc, 0, 0,
{14}  no errc, quota errc, for errc, culprit errc,
{15}  no errc, slot errc, for errc, culprit errc,
{16}  no errc, extent errc, for errc, culprit errc,
{17}  disc errc, full errc, 0, 0,
{18}  system errc, down errc, 0, 0,
{19}  file errc, culprit errc, exists errc, 0,
{20}  partition errc, corrupt errc, 0, 0,
{21}  disc errc, error errc, 0, 0,
{22}  illegal errc, operation errc, 0, 0,
{23}  no errc, buffer errc, 0, 0,
{24}  user errc, culprit errc, exists errc, 0,
{25}  no errc, Uno errc, 0, 0,
{26}  refcount errc, negative errc, 0, 0,
{27}  size errc, error errc, culprit errc, 0,
{28}  data errc, address errc, error errc, 0,
{29}  directory errc, address errc, error errc, 0,
{30}  logins errc, are errc, disabled errc, 0,
{31}  file errc, system errc, not errc, writeable errc,
{32}  directory errc, culprit errc, in errc, use errc,
{33}  directory errc, culprit errc, not errc, empty errc,
{34}  no errc, system errc, process errc, 0,
{35}  conflicting errc, access errc, for errc, culprit errc

%externalinteger err d     = 0
%externalinteger err n1    = 0
%externalinteger err n2    = 0
%externalinteger err pling = 0

! Command letters, defined in the document defining the filestore protocol

%constinteger FC logon     = 'L'       { 0  : ownername, password     : Uno
%constinteger FC logoff    = 'M'       { Uno:                         :
%constinteger FC delete    = 'D'       { Uno: filename                :
%constinteger FC rename    = 'B'       { Uno: filename, filename      :
%constinteger FC permit    = 'E'       { Uno: filename, permissions   :
%constinteger FC finfo     = 'F'       { Uno: ownername, file-number  : packet
%constinteger FC ninfo     = 'N'       { Uno: filename                : packet
%constinteger FC general   = 'G'       { Uno:                         : packet
%constinteger FC pass      = 'P'       { Uno: password, username      :
%constinteger FC quote     = 'Q'       { Uno: password                :
%constinteger FC setdir    = 'J'       { Uno: ownername               :
%constinteger FC copyfile  = 'O'       { Uno: filename, filename      :
%constinteger FC readfile  = 'Z'       { Uno: filename                : ...file
%constinteger FC openr     = 'S'       { Uno: filename                : Xno
%constinteger FC openw     = 'T'       { Uno: filename                : Xno
%constinteger FC openmod   = 'A'       { Uno: filename                : Xno
%constinteger FC reset     = 'U'       { Xno: block-number            :
%constinteger FC close     = 'K'       { Xno:                         :
%constinteger FC uclose    = 'H'       { Xno:                         :
%constinteger FC readsq    = 'X'       { Xno:                         : packet
%constinteger FC writesq   = 'Y'       { Xno: ...packet               :
%constinteger FC readda    = 'R'       { Xno: block-number            : packet
%constinteger FC writeda   = 'W'       { Xno: block-number, ...packet :
%constinteger FC readback  = 'I'       { Xno:                         : packet
%constinteger FC dchange   = 'C'       { Uno: filename, date          :
%constinteger FC fcomm     = ']'       { Uno: system command          : packet
%constinteger FC new owner = '['       { Uno: <p>ownername, quota     :
%constinteger FC owners    = '\'       { Uno: partition number        : packet
%constinteger FC new quota = '^'       { Uno: ownername, delta        :
%constinteger FC control   = '`'       { Uno: option, parameter       :

%constinteger first FC = '@'
%constinteger last  FC = '`'


! Specs for file system procedures.  Those beginning with FS correspond
! with externally-defined operations.  Those beginning FSx are for
! internal consumption only.

%externalroutinespec   FSx initialise file system
%externalintegerfnspec FSx clone Uno(%integer Uno, context)

%externalintegerfnspec FS new owner(%integer Uno, %string(255) s owner,
                                    %integer quota)
%externalintegerfnspec FS change quota(%integer Uno, %string(255) s owner,
                                       %integer delta)
%externalintegerfnspec FS partition(%integer Uno, partition,
                                    %integername bytes, %record(buffer fm)%name b)
%externalintegerfnspec FS logon(%string(255) ownername,
                                %string(255) password, %integername Uno)
%externalintegerfnspec FS logoff(%integer Uno)
%externalintegerfnspec FS delete(%integer Uno, %string(255) filename)
%externalintegerfnspec FS rename(%integer Uno, %string(255) from, to)
%externalintegerfnspec FS permit(%integer Uno, %string(255) filename, permissions)
%externalintegerfnspec FS finfo(%integer Uno, %string(255) ownername,
                                %integer file number,
                                %integername bytes,
                                %record(buffer fm)%name b)
%externalintegerfnspec FS ninfo(%integer Uno, %string(255) filename,
                                %integername bytes, %record(buffer fm)%name b)
%externalintegerfnspec FS pass(%integer Uno, %string(255) password,
                                %string(255) username)
%externalintegerfnspec FS quote(%integer Uno, %string(255) password)
%externalintegerfnspec FS setdir(%integer Uno, %string(255) ownername)
%externalintegerfnspec FS openr(%integer Uno, %string(255) filename,
                                %integername Xno, block count, pad count)
%externalintegerfnspec FS openw(%integer Uno, %string(255) filename,
                                %integer block count,
                                %integername Xno)
%externalintegerfnspec FS openmod(%integer Uno, %string(255) filename,
                                  %integername Xno, block count, pad count)
%externalintegerfnspec FS reset(%integer Xno, block number)
%externalintegerfnspec FS close(%integer Xno)
%externalintegerfnspec FS Uclose(%integer Xno)
%externalintegerfnspec FS readsq(%integer Xno, %integername bytes,
                                 %record(buffer fm)%name buffer)
%externalintegerfnspec FS writesq(%integer Xno, %integer bytes,
                                  %record(buffer fm)%name buffer)
%externalintegerfnspec FS readda(%integer Xno, block number,
                                 %integername bytes,
                                 %record(buffer fm)%name buffer)
%externalintegerfnspec FS writeda(%integer Xno, block number, bytes,
                                  %record(buffer fm)%name buffer)
%externalintegerfnspec FS readback(%integer Xno, %integername bytes,
                                   %record(buffer fm)%name buffer)
%externalintegerfnspec FS dchange(%integer Uno, %string(255) file,
                                  %string(255) date and time)
%externalintegerfnspec FS general(%integer Uno, case,
                                  %string(255) sp2,
                                  %integername bytes,
                                  %record(buffer fm)%name buffer)
%externalintegerfnspec FS control(%integer Uno, case,
                                  %string(255) sp2)

%externalroutinespec FSx clear context(%integer context)


! Buffer queueing and dequeueing.  Dequeue from the file system
! service queue, enqueue on the the ether TX queue and kick the
! TX server processes.

%externalroutinespec enqueue ether request(%integer request)

%routine dequeue process request(%integername request)
   %record(buffer fm)%name buffer
      ! Wait until something arrives
      wait for(proc request) %while common_proc request queue = 0
      iof
      request = common_proc request queue
      buffer == common_buffer(request)
      common_proc request queue = buffer_link
      ion
      ! Something more on the queue?  Kick the next process if so.
      kick(proc request) %if common_proc request queue # 0
%end


! We want a limit on the number of internal copy operations allowed
%owninteger internal count = internal limit


%ownbytearray proc last(1 : procs) = '?'(*)

%externalroutine show proc last
   %integer i
      printstring("PLast:")
      %for i = 1, 1, procs %cycle
         space
         print symbol(proc last(i))
      %repeat
      newline
%end


! Main interpretive code.....

%externalroutine proc main entry
   %record(buffer fm)%name op
   %switch action(first FC - 1 : last FC)
   %string(255) command line
   %string(255) sp1, sp2
   %integer current context, proc sync
   %integer err d x, err n1 x, err n2 x, err pling x
   %integer request buffer, request letter, UXno, i, us, bc, pc, j, k
   %integer X1, X2, count
   %label done, idle, error response, OK done, s done, copy error

!X %routine show protocol error
!X    ! Diagnostic -- print a helpful message on the console
!X    pdate
!X    printstring("*** Protocol error: context ");  write(current context, 0)
!X    printstring(", text was """)
!X    printstring(command line)
!X    printstring(""", plus ")
!X    %if op_bytes = 1 %start
!X       print symbol('''')
!X       pxb(op_b(0))
!X       printstring("' data")
!X    %else
!X       write(op_bytes, 0)
!X       printstring(" bytes of data")
!X    %finish
!X    newline
!X    %if length(command line) + op_bytes + 1 # op_ether bytes %start
!X       printstring("*** Ether packet size was ")
!X       write(op_ether bytes, 0)
!X       newline
!X    %finish
!X %end

   %string(255)%fn set error(%integer code)
      ! Translate an error code into textual form
      %integer i, m, c, x, first = 0
      %string(255) s, t
         ! First or second param as culprit?
         c = code ! 16_FFFF0000
         ! Not a known error code
         %result = "-1 Unknown error" %unless -last error <= c < 0
         s = "-" . tostring('0' - c)
         m = 4 * (- c)
         %for i = m - 3, 1, m %cycle
            x = error text(i)
            %if x = culprit errc %start
               ! Get culprit
               code = (\ code) & 16_FFFF0000;  ! Flip culprit, lose error
               %if code & p1 error = 0 %start
                  s = s . " " . sp1
               %else %if code & p2 error = 0
                  s = s . " " . sp2
               %else %if code & xs error = 0
                  s = s . " "
                  s = s . unpack(err d, 0) . ":" %if err d # 0
                  s = s . unpack(err n1, err n2) %if err n1 # 0
                  s = s . "!" %if err pling # 0
               %finish
            %else %if x # 0
               ! No culprit
               t = text(x)
               ! Upper-case the first letter of the text
               charno(t, 1) = charno(t, 1) - 'a' + 'A' %if first = 0
               s = s . " " . t
            %finish
            first = 1
         %repeat
         err d = 0;  err pling = 0
         err n1 = 0;  err n2 = 0
         %result = s
   %end

      common == common area
      us = common_proc counter + 1
      common_proc counter = us
      proc sync = proc request + us
      ! Initialise the file system if we're the first started
      FSx initialise file system %if us = 1

idle: 
      ! Top of the interpretive loop.  Wait for something to happen
      dequeue process request(request buffer)
      op == common_buffer(request buffer)
      %if op_bytes < 0 %start
         ! Special -- port being deallocated, so clear it down
         ! printstring("Dequeue clear request")
         ! newline
         FSx clear context(op_context)
         release buffer(request buffer)
         -> idle
      %finish
      command line = op_text
      current context = op_context
      ether context = current context
      %if common_diags & proc diags # 0 %start
         pdate
         printstring("Dequeue buffer "); write(request buffer, 0)
{}space; phex(addr(op))
         printstring(": text """)
         sp1 = command line;  zap login(sp1);  printstring(sp1)
         printstring(""", context ");  write(current context, 0)
         newline
      %finish
      %if length(command line) < 2 %start
         ! Must have at least command and UXno
         !X show protocol error
         op_error = protocol error
         sp1 = "";  sp2 = ""
         -> error response
      %finish
      ! Length OK, get command letter and Uno/Xno
      request letter = charno(command line, 1)
      request letter = request letter - 'a' + 'A' %c
         %if 'a' <= request letter <= 'z'
      UXno = charno(command line, 2) - '0'
      %if op_bytes # 0 %start
         ! Data supplied -- is it acceptable?
         %if request letter # FC writesq %and request letter # FC writeda %start
            !X show protocol error
            op_error = protocol error
            sp1 = "";  sp2 = ""
            -> error response
         %finish
      %else
         ! No data supplied -- should there have been?
         %if request letter = FC writesq %or request letter = FC writeda %start
            !X show protocol error
            op_error = protocol error
            sp1 = "";  sp2 = ""
            -> error response
         %finish
      %finish
      ! Split off any parameters there may be...
      %if length(command line) >= 3 %start
         sp1 = substring(command line, 3, length(command line))
         sp2 = "" %unless sp1 -> sp1 .(","). sp2
         length(sp1) = 63 %if length(sp1) > 63
         length(sp2) = 63 %if length(sp2) > 63
      %else
         sp1 = "";  sp2 = ""
      %finish
      ! All OK, so switch on command (it it is valid)
      proc last(us) = request letter
      -> action(request letter) %if first FC <= request letter <= last FC

action(*):
      op_error = not implemented
error response:
      ! Error responses come through here.  Set textual response and reply.
      op_bytes = 0
      op_text = set error(op_error)
      %if common_diags & proc diags # 0 %start
         pdate
         printstring("Error response: ")
         printstring(op_text)
         newline
      %finish
      -> done


      ! The following code checks the parameters supplied for each command
      ! letter, and if OK calls the file system to perform the command.

action(FC logon):
      op_error = protocol error %and -> error response %if sp1 = ""
      op_error = illegal Uno %and -> error response %unless UXno = 0
      op_error = FS logon(sp1, sp2, UXno)
      -> error response %if op_error # success
      op_text = HDX1(UXno)
      op_bytes = 0
      -> done

action(FC logoff):
      %if sp1 # "" %or sp2 # "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS logoff(UXno)
      -> error response %if op_error # success
      op_bytes = 0
      -> OK done

action(FC delete):
      %if sp2 # "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS delete(UXno, sp1)
      -> error response %if op_error # success
      op_bytes = 0
      -> OK done

action(FC rename):
      %if sp1 = "" %or sp2 = "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS rename(UXno, sp1, sp2)
      -> error response %if op_error # success
      op_bytes = 0
      -> OK done

action(FC dchange):
      ! Change date of file -- not in filestore document.
      %if sp1 = "" %or sp2 = "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS dchange(UXno, sp1, sp2)
      -> error response %if op_error # success
      op_bytes = 0
      -> OK done

action(FC permit):
      %if sp2 = "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS permit(UXno, sp1, sp2)
      -> error response %if op_error # success
      op_bytes = 0
      -> OK done

action(FC finfo):
      op_error = FS finfo(UXno, sp1, HDX to I(sp2), i, op)
      -> error response %if op_error # success
      op_text = HDX2(i)
      -> done

action(FC ninfo):
      %if sp1 = "" %or sp2 # "" %start
         op_error = protocol error
         -> error response
      %finish
      op_error = FS ninfo(UXno, sp1, i, op)
      -> error response %if op_error # success
      op_text = HDX2(i)
      -> done

action(FC general):
      op_error = FS general(UXno, HDX to I(sp1), sp2, i, op)
      -> error response %if op_error # success
      op_text = HDX2(i)
      -> done

action(FC pass):
      op_error = FS pass(UXno, sp1, sp2)
      -> error response %if op_error # success
      op_bytes = 0
      -> OK done

action(FC quote):
      %if sp2 # "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS quote(UXno, sp1)
      -> error response %if op_error # success
      op_bytes = 0
      -> OK done

action(FC setdir):
      %if sp2 # "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS setdir(UXno, sp1)
      -> error response %if op_error # success
      op_bytes = 0
      -> OK done

action(FC copyfile):
      ! Internal file copy.  Clone the Uno supplied, giving the new
      ! copy an internal context so that the copy operation won't be
      ! zapped if the user logs off.  Open the files and read and write
      ! blocks until the copy is completed.  NB this is a block-at-a-time
      ! copy -- we could optimise for head movement by buffering internally.
      ! However we %do open the output file with the input file size
      ! specified as the initial allocation, so that internal copy
      ! operations will make the file as contiguous as possible.
      %if sp1 = "" %or sp2 = "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = no process %and -> error response %if internal count = 0
      internal count = internal count - 1
      ! Clone the Uno for the copy.
      UXno = FSx clone Uno(UXno, -2)
      %if UXno < success %start
         internal count = internal count + 1
         op_error = UXno
         -> error response
      %finish
      ether context = -2
      ! Open the input file
      j = FS openr(UXno, sp1, X1, bc, pc)
      %if j # success %start
         internal count = internal count + 1
         ether context = -2
         k = FS logoff(UXno)
         op_error = j
         -> error response
      %finish
      %if common_diags & proc diags # 0 %start
         pdate
         printstring(sp1);  printstring(" opened as source")
         newline
      %finish
      ether context = -2
      ! Open the output file
      j = FS openw(UXno, sp2, bc, X2)
      %if j # success %start
         err d x = err d
         err n1 x = err n1;  err n2 x = err n2
         err pling x = err pling
         internal count = internal count + 1
         ether context = -2
         k = FS uclose(X1)
         ether context = -2
         k = FS logoff(UXno)
         err d = err d x
         err n1 = err n1 x;  err n2 = err n2 x
         err pling = err pling x
         {??} j = (j ! (\ p1 error)) & p2 error %if j & (\ p1 error) = 0
         op_error = j
         -> error response
      %finish
      %if common_diags & proc diags # 0 %start
         pdate
         printstring(sp2);  printstring(" opened as destination")
         newline
      %finish
      op_text = snl
      ! All OK so far, so return success to the user and carry on
      ! with the copy on a purely internal basis.
      enqueue ether request(request buffer)
      request buffer = claim buffer
      op == common_buffer(request buffer)
      op_context = -2
      %for i = 1, 1, bc %cycle
         ! For each block in the input file, read it and write
         ! it to the output file.
         ether context = -2
         j = FS readsq(X1, k, op)
         -> copy error %if j # success
         %if common_diags & proc diags # 0 %start
            pdate
            printstring("Block ");  write(i, 0)
            printstring(" read")
            newline
         %finish
         ether context = -2
         j = FS writesq(X2, k, op)
         -> copy error %if j # success
         %if common_diags & proc diags # 0 %start
            pdate
            printstring("Block ");  write(i, 0)
            printstring(" written")
            newline
         %finish
      %repeat
      ether context = -2
      ! Copy complete, close the input file...
      j = FS close(X1)
      %if common_diags & proc diags # 0 %start
         pdate
         printstring("Close source file, status = ")
         write(j, 0)
         newline
      %finish
      ether context = -2
      ! ...and the output file.
      j = FS close(X2)
      %if common_diags & proc diags # 0 %start
         pdate
         printstring("Close destination file, status = ")
         write(j, 0)
         newline
      %finish
      %if j # success %start
         ether context = -2
         ! Close failed, try Uclosing it
         j = FS Uclose(X2)
         printstring("Copyfile: UClose")
         newline
      %finish
      ether context = -2
      ! All done, log off our cloned pseudo-user
      j = FS logoff(UXno)
      %if common_diags & proc diags # 0 %start
         pdate
         printstring("Pseudo-user logged off")
         newline
      %finish
      release buffer(request buffer)
      internal count = internal count + 1
      -> idle

copy error:
      ! Copy failed, Uclose everything and log off.
      internal count = internal count + 1
      %if common_diags & proc diags # 0 %start
         pdate
         printstring("Copy error")
         newline
      %finish
      ether context = -2
      j = FS uclose(X1)
      %if common_diags & proc diags # 0 %start
         pdate
         printstring("X1 closed")
         newline
      %finish
      ether context = -2
      j = FS uclose(X2)
      %if common_diags & proc diags # 0 %start
         pdate
         printstring("X2 closed")
         newline
      %finish
      ether context = -2
      j = FS logoff(UXno)
      %if common_diags & proc diags # 0 %start
         pdate
         printstring("Pseudo-user logged off")
         newline
      %finish
      release buffer(request buffer)
      ! Finished.  Nothing to send, so just go and get another buffer.
      -> idle

action(FC readfile):
      ! Throw an entire file at a client with no protocol.
      %if sp2 # "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      ! Open the file
      op_error = FS openr(UXno, sp1, UXno, bc, pc)
      -> error response %if op_error # success
      %if common_diags & proc diags # 0 %start
         pdate
         printstring("File opened -- Xno = ");  write(UXno, 0)
         printstring(", blocks = ");  write(bc, 0)
         printstring(" (");  write(512 - pc, 0)
         printstring(" byte");  print symbol('s') %if pc # 511
         printstring(" in last)")
         newline
      %finish
      ! Open OK, so first packet contains block and pad counts
      op_text = HDX4(bc) . "," . HDX2(pc) . snl
      op_bytes = 0
      j = 999
      i = 0
      %cycle
         ! Round and round until the file has all been sent
         op_sync = proc sync %if j >= 512
         ! Not the last packet, so request notification when this
         ! buffer has been ACKed by the other end (flow control).
         enqueue ether request(request buffer)
         %if common_diags & proc diags # 0 %start
            pdate
            printstring("Block ");  write(i, 0)
            printstring(" queued (")
            write(op_bytes, 0);  printstring(" byte")
            print symbol('s') %if op_bytes # 1
            print symbol(')')
            newline
         %finish
         %exit %if j < 512;  !<<<<<<<<<<<<<<<<<<<<< the file has all gone
         request buffer = claim buffer
         op == common_buffer(request buffer)
         op_text = ""
         op_context = current context
         ether context = current context
         ! Read the next block in the file (don't wait for ACK yet, as
         ! this results in more parallelism in the system).
         k = FS readsq(UXno, j, op)
         i = i + 1
         %if k # success %start
            %if common_diags & proc diags # 0 %start
               pdate
               printstring("Readfile: read error ");  write(k, 0)
               newline
            %finish
rf fail:    ether context = current context
            ! Block read failed, Uclose the file
            k = FS Uclose(UXno)
            release buffer(request buffer)
            !! %if k # success %start
            !!    pdate
            !!    printstring("*** Readfile (1) failed to close file: ")
            !!    write(k, 0)
            !!    newline
            !! %finish
            -> idle
         %else %if common_diags & proc diags # 0
            pdate
            printstring("Block ");  write(i, 0)
            printstring(" read")
            newline
         %finish
         ! Block read OK, now wait for the ACK for the previous one.
         wait for(proc sync)
         %if NAKed(current context) %start
            ! Wasn't an ACK, was a NAK.  Chop the transfer.
            %if common_diags & proc diags # 0 %start
               pdate
               printstring("Readfile: NAK")
               newline
            %finish
            -> rf fail
         %finish
         %if common_diags & proc diags # 0 %start
            pdate
            printstring("Synchronised")
            newline
         %finish
      %repeat
      ether context = current context
      ! All gone, close the file
      k = FS close(UXno)
      %if k # success %start
      !! pdate
      !! printstring("*** Readfile (2) failed to close file: ")
      !! write(k, 0)
      !! newline
      %else %if common_diags & proc diags # 0
         pdate
         printstring("File closed")
         newline
      %finish
      ! Finished.  Nothing to send, so just go and get another buffer.
      -> idle

action(FC openr):
      %if sp2 # "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS openr(UXno, sp1, UXno, bc, pc)
      -> error response %if op_error # success
      op_text = HDX1(UXno) . "," . HDX4(bc) . "," . HDX2(pc)
      op_bytes = 0
      -> done

action(FC openw):
      op_error = FS openw(UXno, sp1, HDX to I(sp2), UXno)
      -> error response %if op_error # success
      op_text = HDX1(UXno)
      op_bytes = 0
      -> done

action(FC openmod):
      %if sp2 # "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS openmod(UXno, sp1, UXno, bc, pc)
      -> error response %if op_error # success
      op_text = HDX1(UXno) . "," . HDX4(bc) . "," . HDX2(pc)
      op_bytes = 0
      -> done

action(FC reset):
      %if sp2 # "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS reset(UXno, HDX to I(sp1))
      -> error response %if op_error # success
      op_bytes = 0
      -> OK done

action(FC close):
      %if sp1 # "" %or sp2 # "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS close(UXno)
      -> error response %if op_error # success
      op_bytes = 0
      -> OK done

action(FC uclose):
      %if sp1 # "" %or sp2 # "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS uclose(UXno)
      -> error response %if op_error # success
      op_bytes = 0
      -> OK done

action(FC readsq):
      %if sp2 # "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      %if sp1 = "" %then count = 0 %c
                   %else count = HDX to I(sp1) - 1
      op_error = param error & p1 error %and -> error response %if count < 0
      op_error = FS readsq(UXno, i, op)
      -> error response %if op_error # success
      op_text = HDX2(i)
      %while count > 0 %and i = 512 %cycle
         op_sync = proc sync
         op_context = current context
         op_text = op_text.snl
         enqueue ether request(request buffer)
         request buffer = claim buffer
         op == common_buffer(request buffer)
         ether context = current context
         op_error = FS readsq(UXno, i, op)
         wait for(proc sync)
         %if NAKed(current context) %start
            release buffer(request buffer)
            -> idle
         %finish
         -> error response %if op_error # success
         count = count - 1
         op_text = HDX2(i)
      %repeat
      op_context = current context
      op_sync = 0
      -> done

action(FC writesq):
      %if sp2 # "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS writesq(UXno, HDX to I(sp1), op)
      -> error response %if op_error # success
      op_bytes = 0
      -> OK done

action(FC readda):
      %if sp2 # "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS readda(UXno, HDX to I(sp1), i, op)
      -> error response %if op_error # success
      op_text = HDX2(i)
      -> done

action(FC writeda):
      op_error = FS writeda(UXno, HDX to I(sp1), HDX to I(sp2), op)
      -> error response %if op_error # success
      op_bytes = 0
      -> OK done

action(FC readback):
      %if sp1 # "" %or sp2 # "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS readback(UXno, i, op)
      -> error response %if op_error # success
      op_text = HDX2(i)
      -> done


      ! Admin commands now...

action(FC new owner):
      %if sp1 = "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS new owner(UXno, sp1, HDX to I(sp2))
      -> error response %if op_error # success
      -> OK done

action(FC new quota):
      %if sp1 = "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS change quota(UXno, sp1, HDX to I(sp2))
      -> error response %if op_error # success
      -> OK done

action(FC owners):
      %if sp2 # "" %start
         !X show protocol error
         op_error = protocol error
         -> error response
      %finish
      op_error = FS partition(UXno, HDX to I(sp1), i, op)
      -> error response %if op_error # success
      op_text = HDX2(i)
      -> done

action(FC fcomm):
action(FC control):
      op_error = FS control(UXno, HDX to I(sp1), sp2)
      -> error response %if op_error # success
      -> OK done


      ! A command has been executed, so we send the buffer back to
      ! the port it came from.  (Usually it will be the same buffer
      ! as we received the request in....)

OK done:
      ! Successful completion, with a null response
      op_text = snl
      -> s done

done:
      ! Textual response, add the NL to the end
      op_text = op_text . snl

s done:
      %if op_error = success %start
         common_monitor_OK ops = common_monitor_OK ops + 1
      %else
         common_monitor_error ops = common_monitor_error ops + 1
      %finish
      ! Send the buffer on its way....
      enqueue ether request(request buffer)
      ! ...and go round for another one.
      -> idle

%end

%end %of %file
