!Temporary direct-access package till new subsystem arrives.

%const %integer to director = 20         {SVC#}
%const %integer status = 18              {DACTs for DIRECTOR calls}
%const %integer create = 2
%const %integer extend file = 3
%const %integer open DA file = 6
%const %integer DA read = 9
%const %integer DA write = 10
%const %integer close = 11
%const %integer delete = 14
%const %integer rename = 15
%const %integer pack filename = 17       {SVC#s}
%const %integer unpack filename = 18
%const %integer max chan = 5

!Event name
%const %integer DA error = 12;           !signalled on invalid read blk#.

{system message block format}

%record %format parm fm (%short dsno, dact, ssno, sact,
                         %integer p1,p2,p3,p4,p5,p6)

%own %integer %array key (0:max chan) = 0(*) {DIRECTOR key for each open file}

%external %integer %function SIZE OF (%real d1,d2)
   %integer dum1,dum2
   %result = integer(addr(d2))>>4
%end

%routine check (%integer chan)
   %unless 0 <= chan <= max chan %start
      select output (0)
      print string ("Invalid DA channel no. ")
      write (chan,0);  newline
      %monitor;  %stop
   %finish
%end

%external %routine test (%record(parm fm)%name P)
   %if P_p6 # 0 %start
      select output (0)
      print string ("DA i/o fails -- " . string(addr(P_p1)))
      newline
      %monitor;  %stop
   %finish
%end

%external %string(15) %fn ITOS (%integer x)
   %integer n = | x |
   %string(15) s = ""
   %cycle
      s = to string (rem(n,10)+'0') . s
      n = n // 10
   %repeat %until n = 0
   s = "-" . s %if x < 0
   %result = s
%end

%external %integer %fn STOI (%string(15) s)
   %byte %name b
   %integer j, n = 0, sign = 1
   %for j = 1,1,length(s) %cycle
      b == char no (s,j)
      %continue %if b <= ' '
      %if b = '-' %then sign = -sign %else %if '0' <= b <= '9' %start
         n = 10*n + (b-'0')
      %finish %else %signal 15
   %repeat
   %result = sign*n
%end

%external %record(parm fm) %fn packed (%string(25) file name)
   %record(parm fm) P = 0
   string(addr(P_sact)) = file name
   SVC (pack filename,P)
   test (P)
   %result = P
%end

%recordformat packfm (%integer disc,user,n1,n2)
%external %record(pack fm) %function PACK (%string(31) filename)
   %record(parm fm) P = packed (filename)
   %record(pack fm) r
   r_disc = P_p1
   r_user = P_p2
   r_n1   = P_p3
   r_n2   = P_p4
   %result = r
%end

   %external %string(31) %fn unpacked (%integer disc,user,n1,n2)
      %record(parm fm) P
      P_p1 = disc;  P_p2 = user;  P_p3 = n1;  P_p4 = n2
      SVC (unpack filename,P)
      %result = string(addr(P_sact))
   %end

%external %routine DELETE FILE (%string(25) file name)
   %record(parm fm) P = packed (file name)
   P_dact = delete
   SVC (to director,P)
   test (P)
%end

%external %routine RENAME FILE (%string(25) old name, new name)
   %record(parm fm) P = packed (old name),
                    Q = packed (new name)
   P_p5 = Q_p3;  P_p6 = Q_p4
   P_dact = rename
   SVC (to director,P)
   test (P)
%end

%external %routine CREATE FILE (%string(25) file name, %integer init size)
   %record(parm fm) P = packed (file name)
   init size = 1 %if init size <= 0;     !DIRECTOR doesnt like empty files
   P_dact = create;  P_p5 = init size
   SVC (to director,P)
   comreg (0) = 0                        { => CREATE FILE failed }
   comreg (0) = 1 %if P_p6 = 0           {success => new file created}
%end

%external %routine OPEN DA (%integer chan, %string(25) filename)
   %record(parm fm) P = 0
   P = packed (filename)
   P_dact = open DA file
   SVC (to director,P)
   %if P_p6 # 0 %start
      select output (0)
      print string ("*open DA fails -- " . string(addr(P_p1)))
      newline
      %monitor
   %finish
   check (chan)
   key(chan) = P_p5
%end

   %external %predicate EXISTS (%string(25) filename)
      %record(parmfm) P = packed (filename)
      P_dact = status;  SVC (to director,P)
      %true %if P_p6 = 0
      %false
   %end

%external %routine extend DA (%integer chan, extent)
   %record(parm fm) P = 0
   check (chan)
   P_p5 = key(chan);  P_p6 = extent
   P_dact = extend file
   SVC (to director,P)
   test (P)
%end

%external %routine read DA (%integer chan, block no, %record(*)%name buffer)
   %record(parm fm) P = 0
   check (chan)
   P_p4 = addr (buffer);  P_p5 = key(chan);  P_p6 = block no
   P_dact = DA read
   SVC (to director,P)
   %signal DA error %unless P_p6 = 0
%end

%external %routine write DA (%integer chan, block no, %record(*)%name buffer)
   %record(parm fm) P = 0
   check (chan)
   P_p4 = addr (buffer);  P_p5 = key(chan);  P_p6 = block no
   P_dact = DA write
   SVC (to director,P)
   test (P)
%end

%external %routine close DA (%integer chan)
   %record(parm fm) P = 0
   %return %if key(chan) = 0
   P_p5 = key(chan);  P_dact = close
   SVC (to director,P);  test (P)
   key(chan) = 0
%end


%end %of %file