!******************************
!*  file system handler       *
!*   fsys1s/fsys1y            *
!*  date: 30.Jun.81           *
!******************************

! STACK = 240, STREAMS = 0
!*w.s.c. 25th august 1976
!*b.g.  27.mar.78

!*this handler is the file system utility to replace the
!*existing one in deimos to permit a file system to be
!*created on the ampex 9500 disc as well as the rk05's.

!*it is a conceptual copy of the rk05 file system handler
!*except that a buffer pool is used for block descriptors
!*and directory blocks.

!*the code is shared by 3 system slots,4 for the rk05's,
!*and 9,15 for the ampex disc.the ampex disc is logically
!*divided into two,units 2&3.
!* a further disc is catered for in slot 28

!*the clock is used to write blocks back every 10secs
!*(block descriptor blocks).directory blocks are always
!*written back as soon as possible after a change.

!*tuneable parameters

!*     nbuf=number of buffers in pool-1(must be>0)

!*     secs::length of time between inspecting buffer
!*          pool for writing back to disc.

!*the following facilities are offered

!*     examine a file
!*     get next block of a file
!*     destroy a file
!*     create a file
!*     append a block to a file
!*     rename a file
!*     rename a temporary file

!*stack=300     streams=0

!**********************************************************
!**********************************************************

control  x'4001'
include  "deimosperm"

begin 

     !*********************************************************
     !*************     data areas &declarations     **********
     !*********************************************************


     !*system slots/disc

     constinteger  max drives = 4

     constbyteintegerarray  serv(0:max drives) = 3, 3, 8, 14, 28
     constbytearray  myser(0:max drives) = 4, 4, 9, 15, 29

     !*directory block areas/disc
     ownintegerarray  dirblk(0:max drives)

     !*block descriptor base/disc
     ownbyteintegerarray  blklst(0:max drives)

     !*free block start/disc
     ownintegerarray  fblock(0:max drives)

     ownintegerarray  first free(0:max drives)

     !*top of disc
     ownintegerarray  lastbl(0:max drives)

     !*request types

     constinteger  examine = 0
     constinteger  get next = 1
     constinteger  destroy = 2
     constinteger  create = 3
     constinteger  append = 4
     constinteger  rename = 5
     constinteger  rename temp = 6
     constinteger  rename fsys = 7
     constinteger  dir blk no = 8
     constinteger  report unit = 10
     constinteger  report unit2 = 11

     !*system constants

     constinteger  dread = 0, dwrite = 1
                                       !modes
     constinteger  clock int = 0
     constinteger  my seg = 4, msa = k'100000'

     !*system slots

     constinteger  rkser = 4
     constinteger  amp1ser = 9
     constinteger  amp2ser = 15
     constinteger  rkbser = 29

     switch  request(0:dir blk no)

     integer  id, seg, i, bk, no, nosave, pr, exit, seg2
     owninteger  drive, fno

     !*message formats

     recordformat  pf(byteinteger  service, reply, (integer  a,  c 
     (integer  b or  integername  xa2), integer  c or  c 
      byte  a1, a2, b1, b2, c1, c2))

     record  (pf)p, px

     !*disc buffer pool

     constinteger  secs = 5;           !buffer write back time
     constinteger  nbuf = 3;           !number of buffers-1(must be>0)

     recordformat  xf(integer  x)
     recordformat  bf(integer  drive, block, wrm, record  (xf) c 
       array  blk(0:255))
     !*wrm is a write marker to say that block has been
     !*altered and must be written back to disc.
     ownrecord  (bf) array  b(0:nbuf)
     owninteger  blast = 0;            !last buffer used in pool
     ownrecord  (bf) name  bx;         !points to current buffer record

    ownintegerarray  dum(0:20);         ! compiler fault in GLA length

     !*formats for block descriptors and directory blocks

     recordformat  blkf(integer  pr, next)
                                       !block descriptor

     recordformat  n1f((byteintegerarray  name(0:5) or  integer  a, b, c))
                                       ! two forms of the file name

     recordformat  inff(byteinteger  unit, fsys, record  (n1f)n)
                                       ! file descriptor

     recordformat  filef(record  (n1f)n, integer  first, pr)
                                       !directory entry

     ownrecord  (blkf) arrayname  blka
     record  (filef) arrayname  fa
     ownrecord  (filef) name  f
     record  (blkf) name  blk
     record  (blkf)save blk
     record  (inff) name  inf, inf2
     record  (inff)g

     !***********************************************
     !* e v e n t s 
    
       on  event  15 start ;        ! disc i/o fail
         if  px_service = 0 then  -> restart; ! in timer section
         -> reply
      finish 

     !**********************************************

     !****************************************************************
     !******************************************************************

     !*routine da

     !*calls disc handler to read in a block
     !* nb:  this routine assumes that bx points to the block descriptor


     routine  da(integer  mode)
        record  (pf)p

        p_c = bx_block;               ! compiler error forces this
        p_service = serv(bx_drive)
        p_reply = id
        if  bx_drive = 1 then  p_c = p_c!k'020000'
        p_a = mode
        if  mode # d read then  bx_wrm = 0
                                       ! clear the write marker
        p_xa2 == bx_blk(0)_x
        ponoff(p)
        if  p_a # 0 thensignal  15, 15
     end 

     !*******************************************************

     !*record map load

     !*loads requested block into core if it is not already there
     !*and returns a pointer to the start of the record bx
     !*which is set up to current entry in the buffer pool
     !*drive is assumed to be set up.   ********
     !* the routine also sets up global bx as a side effect

     record  (bf) map  load(integer  block)
        integer  i, temp

        !*check if block already in pool

        cycle  i = nbuf, -1, 0
           bx == b(i)
           if  bx_drive = drive and  bx_block = block start 
              result  == bx
           finish 
        repeat 

        !*block not in pool

        bx == b(blast)
        blast = blast+1
        if  blast > nbuf then  blast = 0
        if  bx_wrm # 0 start ;         !write back old block
           da(dwrite)
        finish 
        bx_drive = drive
        bx_block = block
        da(dread);                     !read in new block
        result  == bx
     end 

     !************************************************************


     !*record map exam 

     !*to read in correct directory block
     !*and find required entry

     record  (filef) map  exam(record  (inff) name  inf)
        integer  n, j, k, hit, t

        record  (n1f) name  file
        record  (n1f) name  info

        record  (filef) name  f

        !*set up drive number,0,1 rk05
                                       !2,3 ampex

        drive = inf_unit
        info == inf_n;                 ! point to name part

        !*set up directory block for scan

        t = dirblk(drive)
        n = t+inf_fsys;                ! map to users directory
        cycle ;         ! system occupies 3 blocks
           fa == load(n)_blk

           !*look for match

           cycle  j = 0, 1, 50
              fno = j;                 ! global for create
              f == fa(j);              ! point to target entry
              if  f_n_a = info_a and  f_n_b = info_b and  f_n_c = c 
                info_c thenresult  == f
           repeat 
           n = n+1
        repeat  until  n > t+2
        result  == null
     end 

     !******************************************************************

     !*record map get block

     !*returns pointer to correct block descriptor
     !*after calling load to read it into core

     record  (blkf) map  get block(integer  block no)
        blka == load(block no >> 7+blklst(drive))_blk
                                       !block desc block
        result  == blka(block no&k'177')
                                       ! offset into block
     end 

     !**********************************************************

     !*integer function appendb

     !*returns next free block number


     integerfn  appendb(integer  last)
        integer  wrap

        wrap = 0
        cycle 
           last = last+1
           if  last = lastbl(drive) start 
              if  wrap = 1 thenresult  = 0
              wrap = wrap+1
              last = fblock(drive)
           finish 
           blk == get block(last)
           if  blk_pr = 0 thenresult  = last
        repeat 
     end 

      routine  rewrite dir
         integer  i
         cycle  i = nbuf, -1, 0
            if  b(i)_wrm # 0 start 
               bx == b(i)
               da(dwrite)
            finish 
         repeat 
      end 

      routine  do report unit(integer  type)
         integer  i, j

         i = p_a2
         if  serv(i) # p_reply then  return ;   ! enforce a check

         if  type = report unit start 
            fblock(i) = p_b; first free(i) = p_b
            lastbl(i) = p_c
         finish  else  start 
            dirblk(i) = p_b
            blklst(i) = p_c
            linkin(myser(i))
         finish 
      end 


     !*****************************************************************

     !*************************************************************
     !*************************************************************


     !*main control loop

     !*link to system slots
     linkin(rkser)
     id = getid
     alarm(secs*50);                   !set clock for secs seconds

restart:
     cycle 
        p_service = 0
        poff(p)

        !*if clock tick check if buffer pool needs writing

        if  p_reply = clock int start 

           alarm(secs*50)
           px_service = 0;           ! for event 15 handling

           rewrite dir
           continue 
        finish 

        !*not a clock tick--request for service

        if  report unit <= p_a1 <= report unit 2 then  c 
          do report unit(p_a1) and  continue 

        px_service = p_reply
        px_reply = p_service
        px_b = p_b

        !*get callers block

         no = 0

        seg = p_b >> 13
        if  seg = 0 then  -> reply;    ! reject it
        i = map virt(p_reply, seg, my seg)
        if  i = 0 then  -> reply
        inf == record(msa+(p_b&k'17777'));  inf2 == inf
        if  dirblk(inf_unit) = 0 then  -> reply;  ! disc not present

        -> request(p_a)

        !*
        !**
        !***** examine file
        !**
        !*

request(examine):

        !*p_b has address of descriptor
        !*examine finds the file entry in the directory block
        !*and returns the first block's number in the file
        !*to the caller.

        no = 0
        f == exam(inf)
        unless  f == null then  no = f_first
        if  drive = 1 and  no # 0 then  no = no!k'020000'
        -> reply

write dir: da(dwrite);                    !put directory block back
         rewrite dir;                     ! put list blocks back

reply:  i = map virt(0, -1, myseg);        !release segment
        px_a = no
        pon(px)
        continue 

        !*
        !**
        !***** get next
        !**
        !*

request(get next):

        !*p_b=file descriptor,p_c=last block
        !*get next is given a block of a file and returns
        !*the next block in the file by looking at the link in
        !*the block descriptor.it also reads the block decriptor
        !*entry for the next block to check the protect code.

        drive = inf_unit
        bk = p_c
        if  drive = 1 then  bk = bk&k'17777'
        blk == get block(bk);          !get previous block
        pr = blk_pr;  no = blk_next
        if  no # 0 start 
           blk == get block(no)
           if  blk_pr # pr then  no =- 1 elsestart 
              !! no = -1  is a protect code error
              if  drive = 1 then  no = no!k'020000'
           finish 
        finish 
        -> reply

        !*
        !**
        !***** destroy
        !**
        !*

request(destroy):

        !*destroy removes the file's name from the directory
        !*block and goes down the block descriptor entries for
        !*that file setting all the links and protect codes to
        !*zero(checking the protect codes as it goes.)

        exit = 0;                      !take normal exit
destf:  
        no = 1;               ! file does not exist
        f == exam(inf)
        unless  f == null start 
           no = 0
           bk = f_first;  pr = f_pr

           f = 0;                      ! delete name etc
           f_pr = pr;                  ! restore "pr"

           da(dwrite);                 !write block back immediately
           cycle 
                                       !delete all links and pr
              blk == get block(bk)
              if  blk_pr # pr start 
                 no =- 1;              !corrupt file!!!
                 exit 
              finish 
              if  fblock(drive) <= bk < first free(drive) then  c 
                first free(drive) = bk
              bk = blk_next
              blk = 0;                 ! zero pr and next
              bx_wrm = bx_wrm+1
           repeat  until  bk = 0
        finish 
        -> write dir if  exit = 0
        -> ren tmp;                    !back to rename temp

        !*
        !**
        !***** create file
        !**
        !*

request(create):

        !*a file is created  by finding an empty slot in the directory
        !*block and copying the name into it.a free block is then found
        !*and is deemed to be the first block of the file.a link to
        !*this block is set up and the protect code calculated and
        !*inserted into the block descriptor.

        drive = inf_unit
        nosave = 0
        nosave = appendb(first free(drive))
        if  nosave # 0 start 
           g_fsys = inf_fsys
           g_unit = inf_unit
           f == exam(g);               !find empty slot
           unless  f == null start 
              no = nosave
              f_n = inf_n;             ! copy name
              bx_wrm = bx_wrm+1
              f_pr = ((f_pr+k'010000')&k'170000')!inf_fsys << 6!fno
              f_pr = k'010000' if  f_pr = 0
                                       ! in case of zero pr
              f_first = no
              pr = f_pr
              da(d write);             !put directory block back
              blk == get block(no);    !get block descriptor back
              blk_pr = pr
              bx_wrm = bx_wrm+1
              first free(drive) = no
              if  drive = 1 then  no = no!k'020000'
           finish 
        finish 
        -> reply

        !*
        !**
        !***** append block
        !**
        !*

request(append):

        !*to append a block to a file the current last block
        !*descriptor entry is inspected for the protect code.
        !*the next free block's descriptor is then
        !*updated with this code and a link to this block
        !*is inserted in the last descriptor entry.

        drive = inf_unit
        bk = p_c;                     !get last block
         if  drive = 1 then  bk = bk&k'17777'
        blk == get block(bk);          !get last block
        pr = blk_pr
        no = appendb(bk);              !get new last block
        if  no # 0 start 
           blk_next = 0
           blk_pr = pr
           bx_wrm = bx_wrm+1
           first free(drive) = no
           blk == get block(bk);       !get previuos last block to
                                       ! insert link
           blk_next = no
           if  drive = 1 then  no = no!k'020000'
           bx_wrm = bx_wrm+1
        finish 
        -> reply

        !*
        !**
        !***** rename file
        !**
        !*

request(rename):
request(rename fsys):                  ! files in different fsys

        !*p_bhas existing,p_c has new file descriptor
        !*if the new file does not already exist then the old
        !*file name in the directory block is replaced by
        !*the new.

        no =- 1
        seg2 = p_c >> 13
        if  seg2 = seg start 
           inf2 == record(msa+(p_c&k'17777'))
           if  inf_unit = inf2_unit start 
              if  p_a = rename fsys start 
                 g_fsys = inf2_fsys
                 g_unit = inf2_unit
                 f == exam(g)
                 unless  f == null start 

                    f == exam(inf);     ! get existing file
                    unless  f == null start ; ! doesn't exist
                       bk = f_first;  pr = f_pr
                       f = 0;         ! zero name record
                       bx_wrm = bx_wrm+1
                       da(d write)
                       f == exam(g);        ! get empty slot again
                       f_n = inf2_n;        ! copy name
                       f_first = bk;  f_pr = pr
                       !! bx_wrm = bx_wrm+1 (write dir writes back)
                       no = 0
                    finish 
                 finish 
              else 

                 f == exam(inf2);            !check new file does not exist
                 if  f == null start 
                    f == exam(inf)
                    if  f == null then  no = 1 elsestart 
                       f_n = inf2_n;         ! copy name
                       !! bx_wrm = bx_wrm+1 (write dir writes back)
                       no = 0
                    finish 
                 finish 
              finish 
           finish 
        finish 
        -> write dir

        !*
        !**
        !***** rename temporary file
        !**
        !*

request(rename temp):

        !*this renames a temporary file in the sense that it removes
        !*the temp file marker and destroys the file.

        exit = 1;                      !special exit form directory
        inf_n_name(0) = inf_n_name(0)&x'ff7f'
                                       !remove temp marker
        -> destf

ren tmp:
        inf_n_name(0) = inf_n_name(0)!x'0080'
                                       !put back marker
        f == exam(inf)
        if  f == null then  no =- 1 elsestart 
           f_n_name(0) = f_n_name(0)&x'ff7f'
                                       !not temp now
           !! bx_wrm = bx_wrm+1 (write dir writes back)
           no = 0
        finish 
        -> write dir


request(dir blk no):                ! give block no of directory
        no = dirblk(inf_unit)+inf_fsys
        -> reply

     repeat 
endofprogram 
                                       !not temp now
request(dir blk no):                ! give block no of directory