{ 1976-spec Filestore filing system }

{ Presents a collection of file operations corresponding to
{ the filestore remote commands.

! PRV$V_CMKRNL    00000000           
! PRV$V_CMEXEC    00000001           
! PRV$V_LOG_IO    00000007           
! PRV$V_PHY_IO    00000016           

%constinteger cmkrnl bit = x'00'
%constinteger log IO bit = x'07'
%constinteger phy IO bit = x'16'

%constinteger required privileges = (1 << cmkrnl bit) %c
                                  ! (1 << log IO bit) %c
                                  ! (1 << phy IO bit)

%externalrecord(quad fm)%spec previous privileges %alias "OWNPRIV"
%ownrecord(quad fm) current privileges = 0
%externalintegerspec previous UIC %alias "OWNUIC"
%owninteger current UIC = 0

{ Miscellaneous }

%routine stamp(%record(stamp fm)%name s)
   time stamp(s_date, s_time)
%end

%routine pad(%integer desired)
   %integername bytes
      bytes == common_buffer_bytes
      common_buffer_b(bytes) = ' ' %and bytes = bytes + 1 %while bytes < desired
%end

%routine add text(%string(255) s)
   %integer i, j
      j = common_buffer_bytes
      %if s # "" %start
         %for i = 1, 1, length(s) %cycle
            common_buffer_b(j) = charno(s, i)
            j = j + 1
         %repeat
      %finish
      common_buffer_bytes = j
%end


{ Filename munging -- converts ':'-form filenames into "[]"-form }

%string(255)%fn munge filename(%string(255) original filename)
   %string(255) new filename
   %integer i, ch, last colon = 0, first colon = 0, colons = 0
      %result = "" %if original filename = ""
      %for i = 1, 1, length(original filename) %cycle
         ch = charno(original filename, i)
         %result = original filename %if ch = '[' %or ch = ']' %c
                                     %or ch = '<' %or ch = '>' %c
                                     %or ch = ';'
         colons = colons + 1 %and last colon = i %if ch = ':'
      %repeat
      %result = original filename %if colons = 1 %or last colon = 0;  ! Default-relative
      new filename = ""
      %for i = 1, 1, length(original filename) %cycle
         ch = charno(original filename, i)
         %if ch = ':' %start
            %if first colon = 0 %start
               new filename = new filename . ":["
               first colon = i
            %else %if i = last colon
               new filename = new filename . "]"
            %else
               new filename = new filename . "."
            %finish
         %else
            new filename = new filename . to string(ch)
         %finish
      %repeat
      %result = new filename
%end


{ RMS interface procedures }

%integerfn do fab(%integerfn it(%record(fab fm)%name f),
                  %record(fab fm)%name f, %record(Uno info fm)%name Uno info)
   %integer status, x
      disable ether interrupts
      status = alias(Uno info_UIC, Uno info_privileges)
      %signal 13, status %if status & 1 = 0
      current UIC = Uno info_UIC;  current privileges = Uno info_privileges
      x = it(f)
      status = self
      %signal 13, status %if status & 1 = 0
      current UIC = previous UIC;  current privileges = previous privileges
      enable ether interrupts
      %result = x
%end

%integerfn do 2fab(%integerfn it(%record(fab fm)%name f1,
                                 %integer i, j,
                                 %record(fab fm)%name f2),
                   %record(fab fm)%name f1, f2,
                   %record(Uno info fm)%name Uno info)
   %integer status, x
      disable ether interrupts
      status = alias(Uno info_UIC, Uno info_privileges)
      %signal 13, status %if status & 1 = 0
      current UIC = Uno info_UIC;  current privileges = Uno info_privileges
      x = it(f1, 0, 0, f2)
      status = self
      %signal 13, status %if status & 1 = 0
      current UIC = previous UIC;  current privileges = previous privileges
      enable ether interrupts
      %result = x
%end

%constinteger read   mode = 0
%constinteger write  mode = 1
%constinteger modify mode = 2
%constintegerarray file modes(0 : 2) =
   fab get ! fab bro, fab put ! fab bro, fab put ! fab get ! fab bio

%integerfn open file(%record(Xno info fm)%name Xno info,
                     %string(255) file name, %integer mode)
   %record(Uno info fm)%name Uno info
   %record(fab fm)%name f
   %record(rab fm)%name r
   %record(nam fm)%name n
   %record(xabfhc fm)%name xf
   %integer status
   %string(255) a, b
      file name = a . "]" . b %if file name -> a . ("]:") . b
      Uno info == common_Uno(Xno info_Uno)
      %if diags & fsys diags # 0 %start
         pdate
         printstring("Open file """);  printstring(filename)
         printstring(""" in directory """)
         printstring(Uno info_d directory)
         printstring(""", mode ");  write(mode, 0)
         newline
      %finish
      f ==  Xno info_f;   f  = 0
      r ==  Xno info_r;   r  = 0
      n ==  Xno info_n;   n  = 0
      xf == Xno info_xf;  xf = 0
      f_bid = fab bid;  f_bln = fab bln
      f_fna = addr(file name) + 1;  f_fns = length(file name)
      f_dna = addr(Uno info_d directory) + 1
      f_dns = length(Uno info_d directory)
      f_fac = file modes(mode)
      f_fop = fab sqo %if mode # modify mode
      %if mode = write mode %start
         f_org = fab seq
         f_rat = fab cr
         f_rfm = fab stmlf
         f_shr = fab nil
      %else
         f_shr = fab shr get
      %finish
      f_rtv = 255
      f_nam == n;  f_xab == xf
      n_bid = nam bid;  n_bln = nam bln
      n_rsa = addr(Xno info_filename) + 1;  n_rss = 255
      Xno info_filename = ""
      xf_cod = xabfhc cod;  xf_bln = xabfhc bln
      %if mode = write mode %then status = do fab(create, f, Uno info) %c
                            %else status = do fab(open, f, Uno info)
      e1 = status %and %result = RMS error %if status & 1 = 0
      Xno info_mode = mode
      r_bid = rab bid;  r_bln = rab bln
      r_fab == f
      %if mode = read mode %start
         %if f_rfm = fab udf %or f_rfm = fab stmlf %or %c
               (f_rfm = fab fix %and f_mrs = 512) %start
            r_rop = rab bio
         %else
            Xno info_flags = Xno info_flags ! no block read
         %finish
      %else
         r_rop = rab bio
      %finish
      status = connect(r)
      e1 = status %and %result = RMS error %if status & 1 = 0
      Xno info_last block moved = -1
      length(Xno info_filename) = n_rsl
      pdate
      %if mode = read mode %start
         printstring("Reading ")
      %else %if mode = write mode
         printstring("Writing ")
      %else
         printstring("Modifying ")
      %finish
      printstring(Xno info_file name)
      newline
      %result = success
%end

%integerfn set last block(%record(Xno info fm)%name Xno info)
   %record(fib fm) fib = 0
   %ownrecord(atr fm) a, t = 0
   %record(fat fm) fat = 0
   %record(IOSB fm) IOSB
   %record(desc fm) d
   %integer status, chan = 0
      %if diags & fsys diags # 0 %start
         pdate
         printstring("Set last byte to ")
         write(Xno info_last byte, 0)
         printstring(", device is ")
         printstring(Xno info_n_dvi)
         newline
      %finish
      d_l = length(Xno info_n_dvi)
      d_a = addr(Xno info_n_dvi) + 1
      status = assign(d, chan, 0, 0)
      %if status & 1 = 0 %start
         !%if diags & fsys diags # 0 %start
            pdate
            printstring("Assign fails ");  phex(status)
            printstring(", device was ");  printstring(Xno info_n_dvi)
            newline
         !%finish
         e1 = status
         %result = RMS error
      %finish
      %if diags & fsys diags # 0 %start
         pdate
         printstring("Channel ");  write(chan, 0)
         printstring(" assigned to ");  printstring(Xno info_n_dvi)
         newline
      %finish
      d_l = fib size;  d_a = addr(fib)
      fib_fid = Xno info_n_fid
      a_type = atr c recattr;  a_size = atr s recattr
      a_addr = addr(fat)
      status = QIOW(0, chan, IO access, IOSB, 0, 0,
                    addr(d), 0, 0, 0, addr(a), 0)
      %if status & 1 = 0 %start
         %if diags & fsys diags # 0 %start
            pdate
            printstring("Acccess QIOW fails ")
            phex(status);  newline
         %finish
         e1 = status
         %result = RMS error
      %finish
      %if IOSB_status & 1 = 0 %start
         %if diags & fsys diags # 0 %start
            pdate
            printstring("Acccess IO fails ")
            phex(IOSB_status);  newline
         %finish
         e1 = IOSB_status
         %result = RMS error
      %finish
      %if diags & fsys diags # 0 %start
         pdate
         printstring("File characteristics obtained")
         newline
      %finish
      Xno info_blocks = Xno info_blocks + 1 %if Xno info_last byte = 0
      fat_ffbyte = Xno info_last byte
      fat_efblkh = shortinteger(addr(Xno info_blocks) + 2)
      fat_efblkl = shortinteger(addr(Xno info_blocks)    )
      status = QIOW(0, chan, IO modify, IOSB, 0, 0,
                    addr(d), 0, 0, 0, addr(a), 0)
      %if status & 1 = 0 %start
         %if diags & fsys diags # 0 %start
            pdate
            printstring("Modify QIOW fails ")
            phex(status);  newline
         %finish
         e1 = status
         %result = RMS error
      %finish
      %if IOSB_status & 1 = 0 %start
         %if diags & fsys diags # 0 %start
            pdate
            printstring("Modify IO fails ")
            phex(IOSB_status);  newline
         %finish
         e1 = IOSB_status
         %result = RMS error
      %finish
      %if diags & fsys diags # 0 %start
         pdate
         printstring("File characteristics modified")
         newline
      %finish
      status = dassgn(chan)
      %if status & 1 = 0 %start
         %if diags & fsys diags # 0 %start
            pdate
            printstring("Dassgn fails ");  phex(status)
            newline
         %finish
         e1 = status
         %result = RMS error
      %finish
      %result = success
%end

%integerfn close file(%record(Xno info fm)%name Xno info)
   %integer status, x
      %if diags & fsys diags # 0 %start
         pdate
         printstring("Close file, blocks = ")
         write(Xno info_blocks, 0)
         printstring(", bytes in last = ")
         write(Xno info_last byte, 0)
         newline
      %finish
      status = close(Xno info_f)
      e1 = status %and %result = RMS error %if status & 1 = 0
      %if Xno info_mode = write mode %start
         x = set last block(Xno info)
         %result = x %if x # success
      %finish
      Xno info_f_ifi = 0
      Xno info_r_isi = 0
      Xno info_Uno = -1
      %result = success
%end

%integerfn next record symbol(%record(Xno info fm)%name Xno info,
                              %integername symbol)
   %record(rab fm)%name r
   %integer status
      r == Xno info_r
      %if Xno info_next rb = 0 %start
         { Must read a new record }
         !D %if diags & fsys diags # 0 %start
         !D    pdate
         !D    printstring("Must read a new record")
         !D    newline
         !D %finish
         r_ubf = addr(Xno info_rbuff(1))
         r_usz = 512
         status = get(r)
         symbol = -1 %and %result = success %if status = RMS eof
         e1 = status %and %result = RMS error %if status & 1 = 0
         !D %if diags & fsys diags # 0 %start
         !D    pdate
         !D    printstring("Successful read, length is ")
         !D    write(r_rsz, 0)
         !D    newline
         !D %finish
         Xno info_next rb = 1
      %finish
      %if Xno info_next rb > r_rsz %start
         symbol = nl
         Xno info_next rb = 0
      %else
         symbol = Xno info_rbuff(Xno info_next rb)
         Xno info_next rb = Xno info_next rb + 1
      %finish
      %result = success
%end

%integerfn fill next block(%record(Xno info fm)%name Xno info,
                           %integername bytes)
   %integer i, sym, x
      %if diags & fsys diags # 0 %start
         pdate
         printstring("Fill next block")
         newline
      %finish
      %result = illegal operation %if Xno info_mode # read mode
      %for i = 0, 1, 511 %cycle
         x = next record symbol(Xno info, sym)
         %result = x %if x # success
         !D %if diags & fsys diags # 0 %start
         !D    pdate
         !D    printstring("Symbol is");  write(sym, 3)
         !D    printstring(", byte is");  write(i, 3)
         !D    newline
         !D %finish
         %if sym < 0 %start
            bytes = i
            Xno info_remaining = 0
            %result = success
         %else
            common_buffer_b(i) = sym
         %finish
      %repeat
      bytes = 512
      %result = success
%end

%integerfn get block(%record(Xno info fm)%name Xno info, %integername bytes)
   %record(rab fm)%name r
   %integer status
      %result = fill next block(Xno info, bytes) %c
          %if Xno info_flags & no block read # 0
      %if diags & fsys diags # 0 %start
         pdate
         printstring("Get block");  newline
      %finish
      r == Xno info_r
      r_ubf = addr(common_buffer_b(0))
      r_usz = 512
      status = read block(r)
      e1 = status %and %result = RMS error %if status & 1 = 0
      Xno info_remaining = Xno info_remaining - 1
      %if Xno info_remaining > 0 %then bytes = 512 %c
                                 %else bytes = Xno info_xf_ffb
      %result = success
%end

%integerfn put block(%record(Xno info fm)%name Xno info)
   %record(rab fm)%name r
   %integer status
      r == Xno info_r
      r_rbf = addr(common_buffer_b(0))
      r_rsz = 512
      status = write block(r)
      e1 = status %and %result = RMS error %if status & 1 = 0
      Xno info_blocks = Xno info_blocks + 1
      %result = success
%end


{ File system procedures }

%integerfn allocate Uno
   %record(Uno info fm)%name Uno info
   %integer i
      %for i = 1, 1, Unos %cycle
         Uno info == common_Uno(i)
         %if Uno info_l user = "" %start
            Uno info_l user = "~~"
            Uno info_F position = -1
            stamp(Uno info_logon stamp)
            Uno info_active stamp = Uno info_logon stamp
            Uno info_Xno active stamp = 0
            %result = i
         %finish
      %repeat
      %result = no Uno
%end

%integerfn validate Uno(%integer Uno, zero status)
   %record(Uno info fm)%name Uno info
      %if Uno = 0 %start
         { Anon }
         %result = zero status %if zero status # success
         Uno info == common_Uno(0)
      %else
         %result = illegal Uno %unless 0 < Uno <= Unos
         Uno info == common_Uno(Uno)
         %result = illegal Uno %if Uno info_l user = ""  { Not in use }
         %result = bad context %if Uno info_context # ether context
      %finish
      stamp(Uno info_active stamp)
      %result = success
%end

%integerfn allocate Xno
   %record(Xno info fm)%name Xno info
   %integer i
      %for i = 1, 1, Xnos %cycle
         Xno info == common_Xno(i)
         %if Xno info_Uno < 0 %start
            Xno info_Uno = Unos + 1  { Invalid, but +ve }
            Xno info_context   = ether context
            Xno info_flags     = 0
            Xno info_remaining = -1
            Xno info_last byte = 0
            Xno info_blocks    = 0
            Xno info_next rb   = 0
            stamp(Xno info_opened stamp)
            Xno info_active stamp = Xno info_opened stamp
            %result = i
         %finish
      %repeat
      %result = -1
%end

%integerfn validate Xno(%integer Xno)
   %record(Xno info fm)%name Xno info
      %result = illegal Xno %unless 0 < Xno <= Xnos
      Xno info == common_Xno(Xno)
      %result = illegal Xno %unless 0 <= Xno info_Uno <= Unos  { Not in use }
      %result = bad context %if Xno info_context # ether context
      stamp(Xno info_active stamp)
      stamp(common_Uno(Xno info_Uno)_Xno active stamp)
      %result = success
%end

%routine FSx initialise file system
   %record(Uno info fm)%name anon Uno
   %integer i
      common_Xno(i)_Uno = -1 %for i = 1, 1, Xnos
      { Now log on ANON permanently, to avoid special cases elsewhere }
      anon Uno == common_Uno(0)
      anon Uno_l user      = "ANON"
      anon Uno_l directory = "ANON:"
      anon Uno_d directory = "ANON:"
      anon Uno_F position  = -1
      anon Uno_context     = 0
      anon Uno_UIC         = x'00FF00FF'  { [377,377] }
      anon Uno_privileges_low  = required privileges
      anon Uno_privileges_high = 0
      stamp(anon Uno_logon stamp)
      anon Uno_active stamp = anon Uno_logon stamp
      anon Uno_Xno active stamp = 0
      common_monitor = 0
      pdate
      printstring("File system initialised")
      newline
%end

%integerfn VFS logon(%string(255) username, password, %integername Uno)
   %record(Uno info fm)%name Uno info
   %integer x
      upper(username)
      upper(password)
      Uno = allocate Uno
      %result = no Uno %if Uno < 0
      Uno info == common_Uno(Uno)
      Uno info_context = ether context
      %if diags & fsys diags # 0 %start
         pdate
         printstring("User ");  printstring(username)
         newline
      %finish
      x = UAF user locate(username)
      %if x & 1 = 0 %start
         Uno info_l user = ""
         %result = unknown user
      %finish
      x = UAF unlock
      %if check password(password) %start
         Uno info_l user = username
         Uno info_l directory = UAF dev . UAF dir
         Uno info_d directory = Uno info_l directory
         Uno info_UIC = UAF UIC
         Uno info_privileges = UAF priv
         Uno info_privileges_low = Uno info_privileges_low ! required privileges
         common_monitor_logons = common_monitor_logons + 1
         %result = success
      %else
         common_monitor_error ops = common_monitor_error ops + 1
         Uno info_l user = ""
         %result = no authority
      %finish
%end

%integerfnspec VFS Uclose(%integer Xno)

%integerfn VFS logoff(%integer Uno)
   %record(Uno info fm)%name Uno info
   %record(Xno info fm)%name Xno info
   %integer x, i
      %if diags & fsys diags # 0 %start
         pdate
         printstring("Logoff ");  write(Uno, 0)
         newline
      %finish
      x = validate Uno(Uno, not logged on)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      %for i = 1, 1, Xnos %cycle
         Xno info == common_Xno(i)
         x = VFS Uclose(i) %if Xno info_Uno = Uno  { File in use }
         !! %result = file in use %if Xno info_Uno = Uno
      %repeat
      Uno info_l user = ""
      %result = success
%end

%integerfn VFS delete(%integer Uno, %string(255) filename)
   %record(fab fm) f = 0
   %record(nam fm) n = 0
   %record(Uno info fm)%name Uno info
   %integer x
      x = validate Uno(Uno, success)
      %result = x %if x # success
      filename = munge filename(filename)
      Uno info == common_Uno(Uno)
      f_bid = fab bid;  f_bln = fab bln
      f_fna = addr(filename) + 1;  f_fns = length(filename)
      f_dna = addr(Uno info_d directory) + 1
      f_dns = length(Uno info_d directory)
      f_nam == n
      n_bid = nam bid;  n_bln = nam bln
      x = do fab(erase, f, Uno info)
      e1 = x %and %result = RMS error %if x & 1 = 0
      %result = success
%end

%integerfn VFS rename(%integer Uno, %string(255) from, to)
   %result = not implemented
%end

%integerfn VFS permit(%integer Uno, %string(255) filename, permissions)
   %result = not implemented
%end

%integerfn VFS finfo(%integer Uno, %string(255) directory,
                     %integer file number,
                     %integername bytes)
   %string(255) file, dir, default
   %record(Uno info fm)%name Uno info
   %record(fab fm)%name f
   %record(nam fm)%name n
   %record(xabdat fm)%name xd
   %record(xabpro fm)%name xp
   %record(xabfhc fm)%name xf
   %integer x, status
      %if diags & fsys diags # 0 %start
         pdate
         printstring("Finfo: directory """)
         printstring(directory)
         printstring(""", file number ")
         write(file number, 0)
         newline
      %finish
      x = validate Uno(Uno, success)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      common_buffer_bytes = 0
      f  == Uno info_f;   n  == Uno info_n
      xd == Uno info_xd;  xp == Uno info_xp
      xf == Uno info_xf
      %if file number = 0 %or file number # Uno info_F position %c
                          %or "" # directory # Uno info_F directory %start
         %if directory = "" %start
            Uno info_F directory = Uno info_D directory
         %else
            Uno info_F directory = directory
         %finish
         %if diags & fsys diags # 0 %start
            pdate
            printstring("Must parse, directory is """)
            printstring(Uno info_F directory)
            print symbol('"')
            newline
         %finish
         default = Uno info_D directory . "*.*;*"
         f = 0;  n = 0;  xd = 0;  xp = 0;  xf = 0
         f_bid = fab bid;  f_bln = fab bln
         f_dna = addr(default) + 1;  f_dns = length(default)
         f_fna = addr(Uno info_F directory) + 1
         f_fns = length(Uno info_F directory)
         f_fop = fab nam
         f_nam == n;  f_xab == xd
         n_bid = nam bid;  n_bln = nam bln
         n_esa = addr(Uno info_F es) + 1;  n_ess = 255
         n_rsa = addr(Uno info_F rs) + 1;  n_rss = 255
         xd_cod = xabdat cod;  xd_bln = xabdat bln
         xd_nxt == xp
         xp_cod = xabpro cod;  xp_bln = xabpro bln
         xp_nxt == xf
         xf_cod = xabfhc cod;  xf_bln = xabfhc bln
         x = do fab(parse, f, Uno info)
         %if x & 1 = 0 %start
            Uno info_F position = -1
            e1 = x
            %result = RMS error
         %finish
         length(Uno info_F es) = n_esl
         %if diags & fsys diags # 0 %start
            pdate
            printstring("Parse done, wild spec is """)
            printstring(Uno info_F es)
            print symbol('"')
            newline
         %finish
         %if file number = 0 %start
            add text(Uno info_F es)
            add text(" at ")
            add text(time)
            add text(" on ")
            add text(date)
            bytes = common_buffer_bytes
            Uno info_F position = 1
            %result = success
         %finish
         Uno info_F position = -1
         %result = not implemented
      %finish
      x = do fab(search, f, Uno info)
      %if x = RMS fnf %or x = RMS nmf %start
         bytes = 0
         Uno info_F position = -1
         %result = success
      %else %if x & 1 = 0
         e1 = x
         Uno info_F position = -1
         %result = RMS error
      %finish
      Uno info_F position = Uno info_F position + 1
      length(Uno info_F rs) = n_rsl
      %if diags & fsys diags # 0 %start
         pdate
         printstring("Next file is """)
         printstring(Uno info_F rs)
         newline
      %finish
      Uno info_F rs -> dir .(">"). file %c
         %unless Uno info_F rs -> dir .("]"). file
      add text(file)
      pad(20)
      status = do fab(open, f, Uno info)
      %if status & 1 = 0 %start
         add text(sysmess(status))
      %else
         add text(protection(xp_pro))
         pad(45)
         %if xd_rvn <= 1 %then add text(date and time(xd_cdt)) %c
                         %else add text(date and time(xd_rdt))
         add text("  ")
         x = xf_ebk;  x = x - 1 %if xf_ffb = 0
         add text(itos(x, -5))
         add text("/")
         add text(itos(xf_hbk, 0))
         status = close(f)
      %finish
      bytes = common_buffer_bytes
      %result = success
%end

!N %integerfn VFS pass(%integer Uno, %string(255) password)
!N    %result = not implemented
!N %end
!N 
!N %integerfn VFS quote(%integer Uno, %string(255) password)
!N    %result = not implemented
!N %end

%integerfn VFS setdir(%integer Uno, %string(255) new default)
   %record(Uno info fm)%name Uno info
   %integer x
      %if diags & fsys diags # 0 %start
         pdate
         printstring("SetDir """)
         printstring(new default)
         print symbol('"')
         newline
      %finish
      x = validate Uno(Uno, not logged on)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      %if new default = "" %start
         Uno info_d directory = Uno info_l directory
      %else
         Uno info_d directory = new default
      %finish
      %result = success
%end

%integerfn VFS openr(%integer Uno, %string(255) filename,
                     %integername Xno, block count, pad count)
   %record(Uno info fm)%name Uno info
   %record(Xno info fm)%name Xno info
   %integer x
      %if diags & fsys diags # 0 %start
         pdate
         printstring("OpenR ");  printstring(filename)
         newline
      %finish
      %result = param error %if filename = ""
      x = validate Uno(Uno, success)
      %result = x %if x # success
      filename = munge filename(filename)
      Uno info == common_Uno(Uno)
      Xno = allocate Xno
      %result = no Xno %if Xno < 0
      Xno info == common_Xno(Xno)
      Xno info_Uno = Uno
      x = open file(Xno info, filename, read mode)
      %if x # success %start  
         Xno info_Uno = -1
         %result = x
      %finish
      %if Xno info_flags & no block read # 0 %start
         block count = Xno info_xf_ebk
         pad count = 0
         Xno info_remaining = infinity
      %else
         pad count = (512 - Xno info_xf_ffb) & 511
         block count = Xno info_xf_ebk
         block count = block count - 1 %if pad count = 0
         Xno info_remaining = block count
      %finish
      Xno info_total blocks = Xno info_remaining
      %result = success
%end

%integerfn VFS openw(%integer Uno, %string(255) filename,
                     %integer block count, %integername Xno)
   %record(Uno info fm)%name Uno info
   %record(Xno info fm)%name Xno info
   %integer x
      %if diags & fsys diags # 0 %start
         pdate
         printstring("OpenW ");  printstring(filename)
         newline
      %finish
      %result = param error %if filename = ""
      x = validate Uno(Uno, success)
      %result = x %if x # success
      filename = munge filename(filename)
      Uno info == common_Uno(Uno)
      Xno = allocate Xno
      %result = no Xno %if Xno < 0
      Xno info == common_Xno(Xno)
      Xno info_Uno = Uno
      Xno info_remaining = 0
      x = open file(Xno info, filename, write mode)
      %if x # success %start  
         Xno info_Uno = -1
         %result = x
      %finish
      %result = success
%end

%integerfn VFS openmod(%integer Uno, %string(255) filename,
                       %integername Xno, block count, pad count)
!N %record(Uno info fm)%name Uno info
!N %record(Xno info fm)%name Xno info
!N %integer x
!N    %if diags & fsys diags # 0 %start
!N       pdate
!N       printstring("OpenMod ");  printstring(filename)
!N       newline
!N    %finish
!N    %result = param error %if filename = ""
!N    x = validate Uno(Uno, success)
!N    %result = x %if x # success
!N    Uno info == common_Uno(Uno)
!N    Xno = allocate Xno
!N    %result = no Xno %if Xno < 0
!N    Xno info == common_Xno(Xno)
!N    Xno info_Uno = Uno
!N    x = open file(Xno info, filename, modify mode)
!<<<  handle errors properly here!
!N    pad count = 512 - Xno info_xf_ffb
!N    block count = Xno info_xf_ebk
!N    Xno info_remaining = block count
!N    %result = success
      %result = not implemented
%end

%integerfn VFS reset(%integer Xno, block number)
   %record(Xno info fm)%name Xno info
   %integer x
      %result = not implemented %if block number # 0
      x = validate Xno(Xno)
      %result = x %if x # success
      Xno info == common_Xno(Xno)
      x = rewind(Xno info_r)
      e1 = x %and %result = RMS error %if x & 1 = 0
      Xno info_next rb = 0
      Xno info_remaining = Xno info_total blocks
      Xno info_last block moved = -1
      %result = success
%end

%integerfn VFS close(%integer Xno)
   %integer x
      x = validate Xno(Xno)
      %result = x %if x # success
      %result = close file(common_Xno(Xno))
%end

%integerfn VFS Uclose(%integer Xno)
   %record(Xno info fm)%name Xno info
   %record(fab fm)%name f
   %integer x, status
      x = validate Xno(Xno)
      %result = x %if x # success
      Xno info == common_Xno(Xno)
      %result = close file(Xno info) %if Xno info_mode # write mode
      f == Xno info_f
      f_fop = fab dlt
      status = close(f)
      Xno info = 0;  Xno info_Uno = -1
      %result = success
%end

%routine VFSx Uclose all
   %integer i, x
      x = VFS Uclose(i) %for i = 1, 1, Xnos
%end

%integerfn VFS readsq(%integer Xno, %integername bytes)
   %record(Xno info fm)%name Xno info
   %integer x
      %if diags & fsys diags # 0 %start
         pdate
         printstring("ReadSQ ");  write(Xno, 0)
         newline
      %finish
      x = validate Xno(Xno)
      %result = x %if x # success
      Xno info == common_Xno(Xno)
      %result = illegal operation %if Xno info_mode = write mode
      %if Xno info_remaining <= 0 %start
         bytes = 0
         common_buffer_bytes = 0
         %result = success
      %finish
      x = get block(Xno info, bytes)
      %result = x %if x # success
      bytes = 512 %if bytes = 0
      common_buffer_bytes = bytes
      %if diags & fsys diags # 0 %start
         pdate
         printstring("ReadSQ successful, bytes = ")
         write(bytes, 0)
         x = bytes - 4;  x = 0 %if x < 0
         printstring(", last bytes are ")
         phex(integer(addr(common_buffer_b(x))))
         newline
      %finish
      Xno info_last block moved = Xno info_last block moved + 1
      %result = success
%end

%integerfn VFS writesq(%integer Xno, %integer bytes)
   %record(Xno info fm)%name Xno info
   %integer x
      %if diags & fsys diags # 0 %start
         pdate
         printstring("WriteSQ ");  write(Xno, 0)
         printstring(", ");  write(bytes, 0)
         newline
      %finish
      %result = param error %unless 0 <= bytes <= 512
      x = validate Xno(Xno)
      %result = x %if x # success
      Xno info == common_Xno(Xno)
      %result = illegal operation %if Xno info_mode = read mode
      %if bytes & 511 = 0 %start
         %result = protocol error %if Xno info_flags & Xno last block # 0
      %else
         Xno info_flags = Xno info_flags ! Xno last block
         Xno info_last byte = bytes
      %finish
      Xno info_last block moved = Xno info_last block moved + 1;  ! Assume success
      %result = put block(Xno info)
%end


%integerfn VFS readda(%integer Xno, block number,
                      %integername bytes)
   %record(Xno info fm)%name Xno info
   %integer x
      %if diags & fsys diags # 0 %start
         pdate
         printstring("ReadSQ ");  write(Xno, 0)
         newline
      %finish
      x = validate Xno(Xno)
      %result = x %if x # success
      Xno info == common_Xno(Xno)
      %result = illegal operation %if Xno info_mode = write mode
      %result = not implemented %if block number # Xno info_last block moved + 1
      %result = VFS readsq(Xno, bytes)
%end

%integerfn VFS writeda(%integer Xno, block number, bytes)
   %record(Xno info fm)%name Xno info
   %integer x
      %if diags & fsys diags # 0 %start
         pdate
         printstring("WriteSQ ");  write(Xno, 0)
         newline
      %finish
      x = validate Xno(Xno)
      %result = x %if x # success
      Xno info == common_Xno(Xno)
      %result = illegal operation %if Xno info_mode = read mode
      %result = not implemented %if block number # Xno info_last block moved + 1
      %result = VFS writesq(Xno, bytes)
%end

%integerfn VFS readback(%integer Xno, %integername bytes)
   %result = not implemented
%end

%integerfn VFS general(%integer Uno, case,
                       %string(255) sp2,
                       %integername bytes)
   %short date, time
   %string(31) d, t
   %integer x
      x = validate Uno(Uno, success)
      %result = x %if x # success
      %if case = 0 %start
         { Date and time }
         time stamp(date, time)
         d = unpack date(date)
         t = unpack time(time)
         common_buffer_bytes = 0
         add text(d)
         add text("  ")
         add text(t)
         bytes = common_buffer_bytes
         %result = success
      %else
         %result = not implemented
      %finish
%end

%externalroutine FSx clear context(%integer context)
%end

%routine VFSx clear context
   %record(Xno info fm)%name Xno info
   %record(Uno info fm)%name Uno info
   %integer i, x
      ! printstring("Clear context ");  write(context, 0)
      ! newline
      %for i = 1, 1, Xnos %cycle
         Xno info == common_Xno(i)
         %if Xno info_Uno >= 0 %and Xno info_context = ether context %start
            ! printstring("UClosing ");  write(i, 0)
            ! newline
            x = VFS uclose(i)
         %finish
      %repeat
      %for i = 1, 1, Unos %cycle
         Uno info == common_Uno(i)
         %if Uno info_l user # "" %and Uno info_context = ether context %start
            ! printstring("Logging off ");  write(i, 0)
            ! newline
            x = VFS logoff(i)
         %finish
      %repeat
%end

%end %of %file