
                  !###############################
                  !# Standard subsystem commands #
                  !###############################

%include "SysInc:command.inc"

%external %string(31)  %spec Command prompt
%external %integer %fn %spec SET STREAMS (%record(command fm)%name command,
                                      %string(*)%name input line,
                                      %integer start pos)
%external %routine %spec Open All    (%record(command fm)%name command)
%external %routine %spec Echo        (%integer on off)
                                      %const %integer off = 1
%external %routine %spec To upper    (%string(*)%name s)
%external %routine %spec To lower    (%string(*)%name s)
%external %routine %spec Pack        (%string(31) f, %record(filefm)%name x)
%external %routine %spec Unpack      (%record(filefm)%name x,%string(*)%name s)

%string(8) %fn access (%integer access)
   %string(8) res
   %short s
   %integer j
   res = ""
   %for j = 'A',1,'H' %cycle
      s = ' '
      s = j %if access&1 # 0
      res = res . to string (s)
      access = access>>1
   %repeat
   %result = res
%end

%external %predicate PRIVILEGED
   %record(parm fm) P
   P_p1 = 0;  SVC(14,P)
   %true %if P_p4 < 0
   %false
%end

%external %routine READ LINE (%string(*)%name s)
   %integer sym
   s = ""
   %cycle
      Read symbol (sym)
      %exit %if sym = NL
      s = s . to string(sym)
   %repeat
%end

%external %routine BECOME (%string(63) parm)
   %record(parm fm) P
   %byte %name c
   %string(63) pass
   %integer Ppass = 0, who
   %Label OK
   %unless parm = "" %or parm -> parm.(",").pass %start
      -> OK %if privileged
      Echo (off)
      Prompt ("Pass:")
      Read line (pass)
      Pack (pass.":", P_file)
      Ppass = P_file_owner
   %finish
OK:%if parm # "" %and char no(parm,length(parm)) = ':' %start
      length(parm) = length(parm) - 1
   %finish
   parm = parm.":"
   Pack (parm, P_file)
   who = P_file_owner
   P_p3 = Ppass;  P_p6 = 0
   P_dact = 27
   SVC (20, P)
   %if P_p6 # 0 %start
      Print string ("*Become fails -- ".P_text)
      Newline
   %else
      To lower (parm)
      c == char no(parm,1)
      c = c - 'a' + 'A' %if 'a' <= c <= 'z'
      parm = "Command:" %if who = 0
      Command prompt = parm
   %finish
%end

%external %routine COPY (%string(63) parm)
   %integer str = 0, sym
   %on 9 %start                      {End of input}
      %return %if str = 3
   %else
      %if Set streams(command,parm,0) # 0 %start
         Print string (parm)
         Print symbol ('?')
         Newline
         %return
      %finish
      %if command_in1 = "" %and command_out1 = "" %start
         Print string ("*Copy fails -- dubious input and output")
         Newline
         %return
      %finish
      Open All (command)
   %finish
   str = str + 1
   Select input (str)
   %cycle
      Read symbol (sym)
      Print symbol(sym)
   %repeat
%end

%external %routine FILES (%string(63) parm)
!
! MOUSES 'Files' program
! A.D. Culloch
!
! Altered: March 81 - wildcard processing
!
!
%const %integer to director = 20;         ! SVC numbers.
%const %integer unpack date = 13
%const %integer get dir = 17;             ! Director call nos.
%const %integer file status = 18
!                                           System record formats..
%record %format file fm  (%integer name1, name2,
                          %short %integer spine, day    %or
                          %integer name, pass,
                          %short   dir block, spare)
%record %format dir fm   (%short %integer mark,
                          %byte %integer rights, check,
                          %short %integer chain,
                          %byte %integer spare, perms,
                          %record(file fm) %array f(1:42))
!
!   Prog builds table of unpacked filenames as follows.
!
%record %format fd fm    (%string(13) name, %byteinteger p)
   %const %integer H = 16_FFFF
   %const %integer dollar bit = 1<<30, hash bit = 1<<31
   %const %integer max unit = 12;      !till Director will say dynamically
   %const %integer Pack error = 10;    !event#
   %const %integer non zero = 1
   %shortinteger flag, dollar, hash, star = 0
   %string(63)%name mess == Event_message
   %record(parm fm) P,Q
   %record(dir fm) D
   %record(fd fm) %array fd(1:42)
   %routine %spec Show files (%integer unit,user)

   %routine qsort(%record(fd fm) %array %name p, %integer a, b)
      %record(fdfm) dump
      %integer l, u
      %while a < b %cycle
         l = a;  u = b
         dump = p(u);  ->find

up:      l = l+1;  ->found %if l = u
find:    ->up %unless p(l)_name > dump_name
         p(u) = p(l)
down:    u = u-1;  ->found %if l = u
         ->down %unless p(u)_name < dump_name
         p(l) = p(u)
         ->up

found:   p(u) = dump
         l = l-1;  u = u+1
         %if l-a > b-l %start
            qsort(p,u, b);  b = l
         %else
            qsort(p,a, l);  a = u
         %finish
      %repeat
   %end

   %integer total = 0, j,k,m, ex, ifid, iext
   %integer unit, user
   %integer blocks, extents;               ! Statistics on disc use.
   %integer pos, files
   %string(*) %name id, fn
   %string(63) junk
   %string(8) acc
   %string(63) fid,ext
   %string(13) f
   %string(8) last; ! .EXT
   %record(fd fm) %name slot
   %record(file fm)%name u
   %integer exclam = 0, disc
   parm = parm.junk %while parm -> parm.(" ").junk
   to upper (parm)
   %if parm # "" %start
      exclam = char no (parm,length(parm))
      %if exclam = '!' %or exclam = '?' %then length(parm) = length(parm)-1 %c
                                        %else exclam = 0
   %finish
   !
   !   Read directory block.
   !
   unit = 0;  user = 0;               ! Default to requesting process.
   %if parm -> f . (":") . parm %start
      %if f = "*" %start;             ! all discs, all users
         star = non zero
         %for j = 1,1,max unit %cycle
            P_p1 = j;  P_dact = 1;    ! name of disc j
            SVC (To Director,P)
            disc = P_p1
            %continue %if P_p6 # 0 %or disc = 0;   !not loaded?
            P_p1 = j;  P_dact = 20;   ! read catalog block
            P_p6 = addr(D);  SVC (To Director,P)
            %continue %if P_p6 # 0
            %for k = 1,1,42 %cycle
               u == D_f(k);     ! kth user slot
               %continue %if u_name = 0
               Show files (disc,u_name)
            %repeat
         %repeat
      %else
         %begin
            %on %event pack error %start
               print string ("*".event_message)
               newline
            %finish
            Pack (f.":",P_file)
            Show Files (P_p1,P_p2)
            %stop
         %end
      %finish
      %if total > 0 %start
         newline;  print symbol ('(')
         write (total,0)
         print string (" files total)")
         newline
      %finish
   %finish
   Show files (0,0) %if total = 0
   %if total = 0 %start
      print string ("No files")
      newline
   %finish
   
   %routine Show files (%integer {packed} unit, user)
      %record(dir fm) D
      %record(parm fm) P
      %string(63) f, junk
      %integer j,k
      %on Pack error %start
         print string ("*" . event_message)
         newline
         %return
      %finish
      files = 0
      P_p1 = unit;  P_p2 = user;  P_dact = get dir;  P_p6 = addr(D)
      SVC (to director,P)
      %if P_p6 # 0 %start
         %return %if P_p6 = -3 {access restricted} %and star # 0
         print string ("*Files fails -- ".P_text);  newline
         %return
      %finish
      !
      !   Pack filename with "wild" '*' fields represented
      !   by zeros. 
      !
      parm = parm . "." %unless parm -> (".")
      parm -> fid . (".") . ext
      dollar = 0;  hash = 0
      ifid = 0;  iext = 0
      dollar = 1 %if fid -> ("$") . fid
      hash   = 1 %if (fid -> fid . ("#") . junk %or
                      ext -> ext . ("#") . junk) %and junk = ""
      Pack(fid,P_file) %and ifid=P_p3 %and iext=iext!(P_p4&(\H)) %if fid # "*"
      Pack (".".ext,P_file) %and iext = iext ! (P_p4&H) %if ext # "*"
      !
      !   Build table (FD) of directory entries
      !   which match the wildcard specification
      !   in parameter (PARM) - default "" is *.*
      !
      %for j = 1,1,42 %cycle
         %if D_f(j)_name2 # 0 %start;    ! Dir. entry in use?
            P_p1 = 0;  P_p2 = 0;  P_p3 = D_f(j)_name1;  P_p4 = D_f(j)_name2
            %continue %unless ifid = iext = 0 {*.*} %or
                              (ifid = 0 = iext>>16 {*.IMP} %and P_p4&H=iext&H) %or
                              (iext&H = 0 {X.*} %and P_p3=ifid %and
                                                     P_p4>>16 = iext>>16) %or
                              (ifid = P_p3 %and iext = P_p4)
            %continue %if (hash # 0 %and P_p3&hash bit = 0) %or
                          (dollar#0 %and P_p3&dollar bit=0)
            Unpack (record(addr(P_p1)),f)
            files = files + 1
            to lower (f)
            %if 'a' <= char no (f,1) <= 'z' %start
               char no (f,1) = char no (f,1) - 'a' + 'A'
            %finish
            fd(files)_name = f
            fd(files)_p = j;             ! actual directory slot
         %finish
      %repeat
      total = total+files
      !
      Qsort (fd,1,files)
      !
      !   Display the information.
      !
      %routine show(%integer n)
         %integer m
         %string(31) file
         %return %if n > files
         flag = 1
         m = 1
         file = fd(n)_name
         m = m+1 %while m <= length(file) %and charno(file, m) # '.'
         file = file." " %while length(file)-m < 4
         spaces(16-length(file))
         printstring(file)
      %end
      !
      %return %if files = 0
      write (files,0);  print string (" file")
      print symbol ('s') %unless files = 1
      %unless unit = user = 0 %start
         print string (" owned by ")
         P_p1 = unit;  P_p2 = user;  P_p3 = 0;  P_p4 = 0
         unpack (record(addr(P_p1)),junk)
         print string (junk)
      %finish
      newline
      %if exclam = '?' %start;   ! FILES?
         last = ""; ! Prev filename.
         %for j = 1,1,files %cycle
            id == fd(j)_name
            %for k = length(id),-1,0 %cycle
               %if k = 0 %start; ! no .EXT
                  k = length(id) + 1
                  %exit
               %finish
               %exit %if char no (id,k) = '.'
            %repeat
            %if substring(id,1,k-1) # last %start
               last = substring(id,1,k-1)
               new line
               id = id."." %if k > length(id)
               id = id." " %while length(id) - k < 3
               spaces (14 - length(id))
               print string (id)
               %continue
            %finish
            spaces (6 - (length(id) - k))
            print string (substring(id,k,length(id))); ! .EXT
         %repeat
         newline
      %else %if exclam = 0;     ! FILES
         ex = (files+3)>>2
         %for j = 1,1,ex %cycle;        ! Rows.
            flag = 0
            show(j);  show(j+ex);  show(j+ex+ex);  show(j+ex+ex+ex)
            newline %if flag # 0
         %repeat
      %else;                             ! FILES!
         print string ("
Filename              created   permissions  flags    blocks(extents)
")
         blocks = 0;  extents = 0
         %for j = 1,1,files %cycle
            slot == fd(j)
            print string (slot_name);  spaces (20 - length(slot_name))
            P_p1 = unit;  P_p2 = user
            P_p3 = D_f(slot_p)_name1
            P_p4 = D_f(slot_p)_name2
            P_dact = file status
            SVC (to director,P)
            %if P_p6 # 0 %start
               print string (P_text)
               newline
               %continue
            %finish
            Q_p1 = P_p5 & (\(3<<14));    ! Date file last used.
            SVC (unpack date,Q)
            print string (Q_text)
            spaces (12 - length(Q_text))
            acc = access(P_p4);          ! File access permissions.
            print string (acc)
            spaces (15 - length(acc))
            %if P_p5&X'4000' # 0 %then print symbol ('a') %else space
            %if P_p5&X'8000' # 0 %then print symbol ('u') %else space
            write (P_p2,11);              ! Blocks.
            blocks = blocks + P_p2
            print symbol ('(')
            write (P_p3,0);              ! Extents.
            extents = extents + P_p3
            print symbol (')')
            newline
         %repeat
         newline
         print string ("Access rights: ".access(D_rights).    %c
                       ",  directory permissions: ".access(D_perms))
         newline
         write (blocks,0); print string (" blocks in")
         write (extents,1);print string (" extents")
         newlines (2)
      %finish
      newline
   %end;   !Show files
%end {of FILES}

%external %routine PURGE (%string(63) parm)
   %record(parmfm) p
   p_dact = 16;  svc(20, p)
   %if p_p6 # 0 %start
      printstring("Purge fails -- ")
      printstring(string(addr(p_p1)))
   %else %if p_p1 = 0
      printstring("No files deleted")
   %else
      write(p_p1, 1);  printstring(" file")
      printsymbol('s') %if p_p1 # 1
      printstring(" deleted")
   %finish
   newline
%end

%external %routine RENAME (%string(63) parm)
   %string(63) in1, out1
   To upper (parm)
   parm = parm.in1 %while parm -> parm.(" ").in1
   %unless parm -> in1.("/").out1 %start
      Print string ("*Form is  RENAME oldname/newname")
      Newline
      %return
   %finish

   %record %format slot fm      (%integer name1, name2,   {packed filenames}
                                 %short   spine block,    {disc addr of spine}
                                 %short   day)            {usage/archive inf}
   %record %format directory    (%short   files,          {dir slots in use}
                                 %byte    access rights,  {of owner}
                                 %byte    check,          {'?'}
                                 %short   spare, %byte spare2,
                                 %byte    access permissions,
                                 %record(slot fm)%array f(1:42))
   %record(directory) D
   %const %integer H = 16_FFFF, To Director = 20, files = {dact} 17
   %const %integer pack fail = {event} 10
   %record %format pack file (%integer unit,name,name1,name2)
   %integer j, iin1, iout1, iinext, ioutext
   %record(slot fm)%name f
   %record(parmfm) P
   %string(15) in ext, out ext

   %routine rename (%record(parm fm) P)
      %const %integer rename = 15;       !Director DACT, SVC#
      %record(filefm) f1, f2
      %string(31) fn1, fn2
      f1 = record(addr(P_p1));  f1_unit = 0;  f1_owner = 0
      f2 = record(addr(P_p3));  f2_unit = 0;  f2_owner = 0
      unpack (f1,fn1);  unpack (f2,fn2)
      P_dact = rename;  SVC (To Director,P)
      %if P_p6 = 0 %start
         print string (fn1 . " renamed " . fn2)
      %else
         print string ("*cannot rename " . fn1 . " as " . fn2 . %c
                       " -- " . P_text)
      %finish
      newline
   %end

   %routine hashfile (%string(63)%name s);         !FRED# -> FRED.#  ?
      %return %if s -> (".")
      %if char no (s,length(s)) = '#' %start
         length(s) = length(s) - 1
         s = s . ".#"
      %finish
   %end

   %on %event pack fail %start
      print string ("*rename fails -- " . event_message)
      newline
      %stop
   %finish

   P_dact = files;  P_p1 = 0;  P_p2 = 0;  P_p6 = addr(D)
   SVC (to Director,P);                 !Read our directory block
   %if P_p6 # 0 %start
      print string ("*Rename fails -- " . P_text)
      newline
      %stop
   %finish
   %if in1 = "*.*" %or out1 = "*.*" %start
      %stop %if in1 = out1;             !RENAME *.*/*.*?
Bad Wild:
      print string ("Incorrect wildcard usage")
      newline
      %stop
   %finish
   hashfile (in1);  hashfile (out1)
   in1 = in1."." %unless in1 -> (".")
   out1=out1."." %unless out1-> (".")
   in1  -> in1 . (".") . in ext;        !Peel off extensions
   out1 -> out1. (".") . out ext
   %if in1 = "*" %start;                !RENAME *.IMP/*.OLD
      ->Bad Wild %unless out1 = "*" %and outext # "*"
      Pack (".".out ext, P_file);  ioutext = P_p4
      Pack (".".in ext, P_file);   iin ext = P_p4
      %for j = 1,1,42 %cycle
         f == D_f(j)
         %continue %if f_name2 = 0 %or iinext&H # f_name2&H
         P_p3 = f_name1;  P_p4 = f_name2
         P_p5 = P_p3;     P_p6 = (P_p4&(\H)) ! ioutext&H
         Rename (P)
      %repeat
   %else %if in ext = "*";              !RENAME FRED.*/JIM.*
      ->Bad Wild %unless out ext = "*" %and out1 # "*"
      Pack (in1,P_file)
      iin1 = P_p3;  iinext = P_p4
      Pack (out1,P_file)
      iout1 = P_p3; ioutext= P_p4
      %for j = 1,1,42 %cycle
         f == D_f(j)
         %continue %if f_name2 = 0 %or f_name1 # iin1 %or
                                       f_name2>>16 # iinext>>16
         P_p3 = f_name1;  P_p4 = f_name2
         P_p5 = iout1;    P_p6 = (ioutext&(\H)) ! f_name2&H
         Rename (P)
      %repeat
   %else;                               !RENAME FRED.IMP/JIM.IMP
      out1 = in1 %if out1 = "*"
      out ext = in ext %if out ext = "*";  !RENAME FRED.IMP/*.XXX etc
      Pack (in1.".".in ext,P_file)
      iin1 = P_p3;  iinext = P_p4
      Pack (out1.".".outext,P_file)
      P_p5 = P_p3;  P_p6 = P_p4
      P_p3 = iin1;  P_p4 = iinext
      Rename (P)
   %finish
%end                                     {RENAME}

%external %routine DELETE (%string(63) parm)
   %string(63) xparm
   parm = xparm.parm %while parm -> xparm.(" ").parm
   To upper (parm)

   !file system formats
   %record %format file fm   (%integer name1, name2,   {packed filename}
                              %short   spine block,    {disc addr of spine}
                              %short   day)            {last used/archive inf}
   %record %format directory (%short files,            {no of slots in use}
                              %byte  access rights,    {rights of dir's owner}
                              %byte  check,            {'?'}
                              %short spare, %byte spare2,
                              %byte  access permissions, {who can see dir?}
                              %record(file fm) %array file(1:42))
   %record(directory) D
   parm = parm . ","
   %string(63) file, extn
   %record(parm fm) P
   %integer fx;                           !index in D
   %record(file fm)%name f;               !points to corr. file slot
   %const %integer H = 16_FFFF;           !Halfword mask for extension
   %const %integer delete = 14, files = 17;!Director DACTs

   %routine To Director (%record(parm fm) P);!P is request to Director
      %const %integer To Director = 20;   !SVC number
      %string(63) filename
      UNPACK (record(addr(P_p1)),filename)
      SVC (To Director,P)
      %if P_p6 = 0 %start;                !OK
         print string (filename." deleted")
      %else
         print string ("*cannot delete " . filename . " -- " . P_text)
      %finish
      newline
   %end

   P_dact = files;  P_p1 = 0;  P_p2 = 0;  P_p6 = addr(D)
   SVC (20,P)
   %if P_p6 # 0 %start
      print string ("FILES fails -- " . P_text)
      newline
      %stop
   %finish
   %while parm -> file . (",") . parm %cycle;   !pick off file ids
      %continue %if file = ""
      %begin
         %const %integer PACK fails = 10
         %on %event PACK fails %start
            print string ("*" . event_message)
            newline
            %return
         %finish
         file = file . "." %unless file -> (".");  !make extn explicit
         file -> file . (".") . extn;     !split filename
         %if extn = "*" %start;           !FRED.*
            %if file {also} = "*" %start
               print string ("*.* -- No!")
               newline
               %return;                   !to peel off next file id
            %finish
            PACK (file,P_file);  P_dact = delete
            %for fx = 1,1,42 %cycle
               f == D_file (fx)
               %if f_name2 # 0 %and
                   f_name1 = P_p3 %and 
                   f_name2&(\H) = P_p4&(\H) %start
                  P_p4 = (P_p4&(\H)) ! f_name2&H
                  To Director (P);                !dump success/fail message
               %finish
            %repeat
         %else %if file = "*";            !*.EXE
            PACK (".".extn,P_file);  P_dact = delete
            %for fx = 1,1,42 %cycle
               f ==  D_file(fx)
               %if f_name2#0 %and f_name2&H = P_p4&H %start; !extensions match
                  P_p3 = f_name1
                  P_p4 = (P_p4&H) ! (f_name2&(\H))
                  To Director (P)
               %finish
            %repeat
         %else;                          !plain FRED.IMP
            file = file . "." . extn %if extn # ""
            PACK (file,P_file)
            P_dact = delete
            To Director (P)
         %finish
      %end
   %repeat
%end

%external %routine ANALYSE (%string(63) filename)
   %routine single(%integer n, %string(23) s)
      write(n, 3)
      printstring(s)
      printsymbol('s') %unless n = 1
      spaces(2)
   %end
   %record(parmfm) p
   %record(file fm) f
   %integer j
   %on 10 %start
      Print string("*".EVENT_message);  newline
      %return
   %finish
   Pack (filename,P_file)
   P_dact = 18
   SVC (20, p)
   %if p_p6 # 0 %start
      Print string (string(addr(P_p1)));  newline
      %return
   %finish
   printstring(filename)
   single(p_p2, " block")
   single(p_p3, " extent")
   printstring("  Access: ".access(P_p4))
   printstring("   Created:")
   p_p1 = p_p5;  svc(13, p)
   printstring(string(addr(p_p1)))
   newline
%end

%external %routine STATE (%string(63) parm)
   %record(parmfm) p
   %string(15) who, version
   %integer unit, owner, console, priv, users, process
   %integer svcs, pons
   %routine show access(%integer N)
      Print string (access(N))
   %end
   svc(19, p)
   users = p_p2
   version = string(addr(p_p6))
   p_p1 = 0;  svc(14, p)
   process = p_dsno&31
   unit = p_p1
   owner = p_p2
   priv = p_p4>>31
   console = p_p6
   p_p3 = 0;    p_p4 = 0
   svc(18, p)
   who = string(addr(p_sact))
   printstring("Mouses V");  printstring(version);  space
   printstring(who)
   printstring(" console");  write(console, 1)
   printstring(", process");  write(process, 1)
   printstring(" *privileged*") %if priv # 0
   %if users > 1 %start
      printsymbol(',')
      write(users-1, 1)
      printstring(" other user")
      printsymbol('s') %unless users = 2
   %finish
   newline
   p_dact = 26;  p_p1 = 0;  p_p2 = 0;  svc(20, p)
   %if p_p6 = 0 %start
      printstring("User access:".access(P_p1))
      printstring("   Directory access:".access(P_p2))
      newline
   %finish
%end

%external %routine Z (%string(63) parm)   {V200 clear screen}
   %constinteger ESC = 27, NUL = 0
   %integer j
   print symbol (ESC);  print symbol ('v')
   print symbol (NUL) %for j = 1,1,20
%end

%end %of %file
