!******************************
!*  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