!Operator command library,  ADC

!!!! %option  "NODECODE, STACK=10"


%include "sysinc:parmfm.inc"
%include "sysinc:command.inc"
%include "sysinc:direct.inc"

%record %format FD fm   (%string(15) name, %short %integer P)

!File system disc block formats

%record %format user fm (%integer name, password,
                         %short   dir block,      {disc addr of user dir}
                         %short   spare)
%record %format userlist(%short   users, spare1,  {# of users on unit}
                         %integer spare2,
                         %record(user fm) %array user (1:42))

!Block zero on every logical disc

%record %format zero fm (%integer vol id,         {m'VOLN'}
                         %string(7) disc id,      {"SVOL"}
                         %integer   free list,    {free blocks spine}
                                    user list,    {user catalog}
                                    defective list,{bad blocks list}
                         %integer   system area,  {start of system image}
                                    system size,  {N contiguous blocks}
                         %string(11)initialisation date,
                         %integer   tracks,       {physical disc info}
                                    blocks per cylinder,
                                    heads,
                         %integer   initialised,  {=0 => Disc WIPED O.K.}
                         %integer   copied,
                         %integer   checksum,     {sum(blockzero)-1 = 0}
                         %string(187) description,{of logical disc contents}
                         %integer marked,   {V2.00+: Disc INITIALISED O.K.}
                         %byte %array spare (1:252))

%const %string(31) Batch initiator =     "SPOOL:INIT.ABS"
%const %integer max unit    = 12         {Largest disc unit no. in system}

%const %integer Disc read   = 101
%const %integer Pon         = 115
%const %integer Pon off     = 116

%const %integer System lock = x'9E4'     {Magic store loc. Poke -1 to open sys.}
%const %integer System pass = x'9E8'     {Magic pass to any account}
%const %integer System time = x'9C0'     {Counts up time of day}
%const %integer System date = x'9C4'     {Knows todays date}
%const %integer Poff monitor= x'9D0'     {Switch supervisor monitoring on/off}
%const %integer Proc monitor= x'9C8'     {Log messages to/from one process}

%external %integer %fn %spec StoI (%string(31) s)
%external %routine     %spec Phex (%integer number, places)
%external %routine     %spec Read Line (%string(*)%name L)
%externalroutinespec  parse parameter(%record(Commandfm)%name  C,
                                          %integer  option, %string(127) parm)
%external %routine     %spec Unpack(%record(file fm)%name f, %string(*)%name s)
%external %routine     %spec Break Output
%system   %routine     %spec Sort(%record(FD fm)%arrayname A, %integer L, H)
%external %routine     %spec To upper (%string(*)%name s)
%external %routine     %spec Pack (%string(63) s, %record(filefm)%name f)
%external %routine     %spec Echo (%integer on off)
                             %const %integer on = 0, off = 1

%conststring(2)  x = "X "

%const %integer Symbol in Data = 3       {IMP-77 event number}
%const %integer Faulty Filename= 10

%integer %fn int (%string(31) s)
   %on symbol in data %start             {S contains a non-number}
      Print string ("""".s.""" ") %if s # ""
      Print string ("not a valid number")
      Newline
      %stop
   %finish
   %result = 0 %if s = ""
   %if s -> ("x").s %or s -> ("X").s %start
      %if s -> ("'").s %start
         length(s) = length(s) - 1 %if char no(s,length(s)) = '''' {as well}
      %finish
      s = "16_".s
   %finish
   %result = StoI(s)
%end

%routine  split up(%string(63)%name  parm)
   parse parameter(command,0,parm)
%end

%routine  pack user(%string(63) unit, %record(filefm)%name  r)
   pack (unit.":", r)
%end

%routine  check parm(%integer  mask)
   %integer  k
   %constinteger  total streams = 6
   %for k = 1,1,total streams %cycle
      %if mask&1 # 0 %and command_io(k) = "" %start
         print string("Parameter missing??")
         newline
         %stop
      %else %if mask&1 = 0 %and command_io(k) # ""
         print string(command_io(k)." ?")
         newline
         %stop
      %finish
      mask = mask>>1
   %repeat
%end

%routine nobody (%string(63) who)
   Print string (who." not logged on")
   %stop
%end

%integer %fn my process
   %record(parm fm) P
   SVC (28,P)                            {Get general info}
   %result = P_dsno&63                   {Process no. of our process}
%end

%integer %fn processes                   {Max process slot}
   %record(parm fm) P
   SVC (28,P)
   %result = P_p4
%end

%routine Director (%integer dact, %record(parm fm)%name P)
   P_dact = dact
   SVC (To Director,P)
   %if P_p6 # 0 %start
      Print string (P_text)
      Newline
   %finish
%end

%integer %fn User (%string(63) who)
   !String username => Process no.
   %record(parm fm) P
   To upper (who)
   %result = -1 %if who = ""      {ERROR}
   %result = 0 %if who = ".ALL"
   who = who.":" %unless char no(who,length(who)) = ':'
   Pack (who,P_file)
   %result = -1 %if P_file_owner < 0     {Invalid username?}
   SVC (5,P)                             {Find process}
   %result = P_p1&63
%end

%integer %function start (%string(27) proc)
   %const %integer Oper id = 1 007 883
   %record(parm fm) P
   Pack (proc,P_file)
   %result = 0 %if P_file_owner <= 0
   P_p6 = 1<<31                          {Privileged}
   P_p5 = P_p4;  P_p4 = P_p3;  P_p3 = oper id
   SVC (109,P)                           {Start process}
   %result = P_p3 %if P_p6 = 0
   %result = 0
%end

%routine Set word (%integer where, new val)
   %record(parm fm) P
   P_p1 = where;  P_p2 = new val;  SVC(118,P)
%end

%integer %fn Sys word (%integer where)
   %record(parm fm) P
   P_p1 = where;  SVC(117,P)             {Pick word up from real store}
   %result = P_p2
%end

{Kill off nominated user process(es):   }
{   KILL fred                           }
{   KILL .ALL                           }
%external %routine KILL (%string(63) parm)
   %record(parm fm) P
   %integer me = my process, j
   split up(parm)
   check parm(1);  parm = command_in1
   SVC(1,P) {Die!} %if parm = ""
   P_p1 = user(parm)
   %if P_p1 <= 0 %start                  { <0:error, 0:.ALL }
      %if P_p1 = 0 %start
         %for j = 4,1,processes %cycle
            P_p1 = j
            SVC(126,P) %if j # me
         %repeat
      %else
         Nobody (parm)
      %finish
   %finish %else SVC(126,P)              { KILL fred }
%end

{Give privilege to or remove it from the nominated process}
{   PRIV  user,ON                                         }
{   PRIV  user
%external %routine PRIV (%string(63) parm)
   %record(parm fm) P
   %string(63) what
   split up(parm)
   command_in2 = " " %if command_in2 = ""
   check parm(1+2);  parm = command_in1;  what = command_in2
   %if parm -> parm.(" ").what %start; %finish
   P_p1 = user(parm)
   Nobody(parm) %if P_p1 <= 0
   P_p2 = 0
   P_p2 = 1 %if what = "ON"
   SVC (124,P)
%end

%routine shutdown(%integer  delay)
   {Close system after DELAY minutes, sending warnings to users}
   %record(parm fm) P
   P_sact = 1                            {Nonzero to wait for reply}
   P_dsno = x'43';  P_dact = 7;  P_p1 = delay
   SVC (Pon off,P)
%end                                     {Ignores reply}

{Enable logins and make system generally available}
{   OPEN                                          }
%external %routine OPEN                  {Enable logins}
   Set word (system lock,0)
   shutdown(1 000 000)      { a very large number of minutes!! }
%end

{Disable further logins and, IFF a parameter is specified, start the}
{      shutdown sequence using that number of minutes               }
{   CLOSE                  : prevent further logins                 }
{   CLOSE  n               : stop logins and initiate shutdown      }
%external %routine CLOSE (%string(63) parm)
   %integer  k = -1
   split up(parm)
   %if command_in1 # "" %start
      k = int(command_in1);  command_in1 = ""
      check parm(0)
      k = 0 %if k < 0
   %finish
   Set word (system lock,-1)
   %if k >= 0 %start
      shutdown(k)
      print string("System closing in"); write(k,1); print string("minutes - ")
   %finish
   print string("Further log-ons inhibited")
   newline
%end

{Send a text message to all users currently logged on}
{   BROADCAST  text                                  }
%external %routine BROADCAST (%string(63) text)
   %record(parm fm) P
   P_text = text;  SVC(113,P)
%end

{Set global password so that knowledgable users can log on even though}
{the system is nominally CLOSEd                                       }
{   PASS   password                                                   }
%external %routine PASS (%string(63) parm)
   %record(parm fm) P
   %const %integer impossible pass = -2
   %integer j
   %if parm = "" %start
      Echo (off)
      Prompt ("Pass:")
      Read line(parm)
      Echo (on)
      Set word(system pass, impossible pass) %and %return %if parm = ""
   %finish
   Pack (parm.":",P_file)
   j = P_file_owner
   %if j <= 0 %start
      Print string ("Invalid password - ignored")
      Newline
      %return
   %finish
   Set word (system pass, j)
%end

%integer %fn unit (%string(63) id)
   %record(parm fm) P
   %if id = "" %start
      Print string ("Disc name?")
      Newline
      %stop
   %finish
   %if char no(id,1) = '#' %start        {Disc unit number #n}
      P_p1 = int(sub string(id,2,length(id)))
   %else
      Pack (id."_:",P_file)
      P_dact = 45                        {Find unit}
      SVC (To Director,P)
      %if P_p6 # 0 %start
         Print string (id." not loaded");  newline
         %stop
      %finish
   %finish
   %result = P_p1
%end

%integer %fn find unit (%string(63) which)
   %byte %array block(1:512)
   %record(parm fm) P
   %integer unit no
   To upper (which)
   %for unit no = 1,1,max unit %cycle
      P_p1 = 0;  P_p2 = addr(block(1));  P_p3 = unit no;  P_p4 = 0 {my process}
      SVC (Disc read,P)
      %result = unit no %if P_p1 = 0 %and string(addr(block(5))) = which
   %repeat
   %result = -1
%end

{Reboot system from nominated disc drive expressed either as the logical drive}
{number or the disc pack identifier                                            }
{   RESTART  #1         : . . . from logical DRIVE #1                           }
{   RESTART  SYS8       : . . . from the pack labelled SYS8                     }
%external %routine RESTART (%string(63) disc)
   %record(parm fm) P
   split up(disc)
   check parm(1)
   %if char no(disc,1) = '#' %then P_p1 = unit(disc) %c
                             %else P_p1 = find unit(disc)
   %unless 0 < p_p1 <= 4 %start
      print string("You can't reboot from unit #");  write(p_p1,0)
      newline
      %return
   %finish
   P_p2 = 2                              {Magic no. put in x'7E' by supervisor}
   SVC (123,P)                           {Reboot supervisor}
%end

{Make the pack on the nominated disc drive accessible to the file system}
{drive being referred to as above                                       }
{   LOAD  #1                                                            }
{   LOAD  SYS8                                                          }
{The converse operation is UNLOAD with identical conventions            }
%external %routine LOAD (%string(63) disc)
   %record(parm fm) P
   split up(disc)
   check parm(1)
   %if char no(disc,1) = '#' %then P_p1 = unit(disc) %c
                             %else P_p1 = find unit(disc)
   %if P_p1 <= 0 %start
      Print string (disc." not on-line")
      Newline
      %stop
   %finish
   Director (38,P)
%end

%external %routine UNLOAD (%string(63) disc)
   %record(parmfm)  p
   split up(disc);  check parm(1)
   p_p1 = unit(disc)
   director(39,p)
%end


%routine  set protection(%integer  on off, %string(63)%name  disc)
   %record(parmfm)  p
   split up(disc);  check parm(1)
   p_p1 = unit(disc)
   p_p2 = on off      {1=protected, 0=at risk}
   director(44,p)
%end
%external %routine PROTECT (%string(63) disc)
   set protection(1, disc)
%end
%external %routine HAZARD (%string(63) disc)
   set protection(0, disc)
%end

{List all processes either on a nominated disc unit or on all physically}
{accessible discs whether LOADed or not                                 }
%external %routine CATALOG (%string(63) parm)
   %routine %spec   Cat (%integer unit, flag)
   %const %integer  user list block = 301
   %const %integer  disc read = {SVC} 101
   %byte %name      L == length(parm)
   %integer         exclam = 0,  U,  swap unit
   %record(zero fm) Z
   %record(parm fm) P

   %predicate unloaded(%integer  unit no)
      %record(parmfm)  p
      p_p1 = unit no
      director(Direct Unitname, P)
      %true %if p_p6 # 0                 {unit not loaded}  %c
                  %or p_p1 = 0 {TEMP FRIG}
      %false
   %end
   %predicate  faulty checksum(%record(zerofm)%name  z)
      %integername  p == integer(addr(Z)), end == p++128
      %integer      total = -1
      %cycle
         total = total+p
         p == p ++ 1
      %repeat %until p == end
      %true %if total # 0
      %false
   %end

   SVC (28, P);  Swap unit = P_p2

   split up(parm);  check parm(1)
   L = L - 1 %while parm # "" %and char no(parm, L) <= ' '
   exclam = 1 %and L = L - 1   %if char no(parm, L)  = '!'

   %if char no(parm, 1) = '*' %start
      %for U = 1, 1, max unit %cycle
         %if U # swap unit %start
            P_p1 = 0;  P_p2 = Addr(Z);  P_p3 = U;  P_p4 = 0
            SVC (Disc read, P)
            Cat(U, exclam) %and newline %if P_p1 = 0
         %finish
      %repeat
   %else
      Cat (unit(parm), exclam)
   %finish

   %routine CAT (%integer unit number, exclam)
      %const %integer       user list block = 301
      %record(userlist)     Ulist
      %record(user fm)%name u
      %record(zero fm)      Z
      %record(FD fm) %array FD(1:42)
      %record(FD fm) %name  FDp
      %integer              j, k, col, dir
      %record(parm fm)      P
      %record(file fm)      f

      P_p1 = 0;  P_p2 = addr(Z);  P_p3 = unit number;  P_p4 = 0
      SVC (Disc read, P)
      %if faulty checksum(z) %start
         print string("*foreign disc* : unit #")
         write(unit number,0);  newlines(2)
         %return
      %finish
      Print string (Z_Disc id.": unit #")
      Write (unit number, 0)
      print string("  *unloaded*") %if unloaded(unit number)
      newline

      P_p1 = user list block;  P_p2 = addr(Ulist)
      P_p3 = unit number;      P_p4 = 0
      SVC (Disc read, P)

      k = 0
      %for j = 1, 1, 42 %cycle
         u == Ulist_user(j)
         %if u_name # 0 %start
            k = k + 1
            FDp == FD(k)
            FDp_p = j
            F = 0;  F_owner = u_name
            Unpack (F, FDp_name)
            length(FDp_name) = length(FDp_name) - 1
         %finish
      %repeat

      Sort (FD, 1, k) %if exclam = 0
      Col = 0
      %if exclam # 0 %then print string ("     User   Directory block
")
      %for j = 1, 1, k %cycle
         FDp == FD(j)
         Spaces(9 - length(FDp_name))
         Print string(FDp_name)
         %if exclam # 0 %start
            dir = Ulist_user(FDp_p)_dir block
            Write (dir, 5);  Spaces(2)
            Print string("x'");  Phex(dir, 5);  Print symbol('''')
            newline
         %else
            col = col+1
            newline %if col&7 = 0
         %finish
      %repeat
      Break Output
      Write(k, 1);  print string(" users")
      Newline
   %end
%end

%external %routine POFFMON (%string(63) parm)
   {Cause supervisor to log all events matching a mask}
   Set word (Poff monitor,int(parm))
%end

%external %routine PROCMON (%string(63) parm)
   Set word (Proc monitor,int(parm))
%end

%external %routine TIMEis (%string(63) parm)
   %const %byte %array limit(1:3) = 23, 59, 59
   %integer time = 0, j, k
   %string(63) x
   parm = parm.":::"
   %for j = 1,1,3 %cycle                 { hh:mm:ss }
      parm -> x.(":").parm
      k = int(x)
      %unless 0 <= k <= limit(j) %start
         Print string ("Bad time")
         Newline
         %return
      %finish
      time = 60*time + k
   %repeat
   Set word(system time,time)
%end

%external %routine DATEis (%string(63) parm)
   %record(parm fm) P
   split up(parm)
   p_text = command_in1
   %if command_in2 # "" %start
      parm = command_in2
      command_in2 = ""
   %finish
   check parm(1)
   SVC (34,P)                            {String date -> packed date in P_p1*}
   %if P_p1 = 0 %start
      Print string ("Bad date")
      Newline
      %return
   %finish
   Set word(system date,P_p1)
   Time is (parm) %unless Parm = ""
%end

%external %routine SEGS (%string(63) who)
   %const %string(15) %array flag(1:4) = {AMT flags}
      "Swopped-out", "New", "Shared", "Resident"
   %integer process = user(who)
   %record(parm fm) P
   %integer j,k,m
   Nobody(who) %if process <= 0 %and who # ""
   Print string ("
 Seg          AMT  Size  Users  Flags
")
   %for j = 0,1,15 %cycle
      P_p1 = j;  P_p2 = process;  SVC(11,P)
      %if P_p2 # 0 %start                {Segment connected?}
         Write (j,3)
         Space;  Phex(P_p2,8)
         Write (P_p3,3)
         P_p4 = P_p2 %and P_p5 = 0 %and P_p6 = 1 %if P_p3 = 0
         Write (P_p5,5)
         Write (P_p6,4)
         Spaces (3)
         m = 1
         %for k = 1,1,4 %cycle
            Space %and print string(flag(k)) %if P_p4&m # 0
            m = m<<1
         %repeat
         Newline
      %finish
   %repeat
   Newline
%end

%external %routine REPRIME
   %record(parm fm) P
   P_dact = 10;  SVC(22,P)               {Re-initialise POTTER}
%end

%external %routine QUEUE (%string(63) parm)
   %record(parm fm) P
   Pack (parm.":",P_file)
   P_p1 = P_file_owner
   P_dact = 12
   SVC (22,P)                            {Create a new queue in POTTER}
   %if P_p6 # 0 %start
      Print string ("*Cannot create """.parm.""" queue -- ".P_text)
      Newline
   %finish
%end

%external %routine INIT (%string(63) parm)
   { INIT queue current max }
   %integer init proc
   %record(parm fm) P
   %string(63) x
   split up(parm);  check parm(1+2+4)
   P_p3 = user(command_in1)                     {Queue-ID is a fake username}
   P_p4 = int(command_in2)
   P_p5 = int(command_in3)
   init proc = Start(batch initiator)
   %if init proc > 0 %start              {OK}
      P_dsno = init proc
      P_dact = 3
      P_ssno = 0
      SVC (Pon,P)
   %finish
%end

%external %routine LIMIT (%string(63) parm)
   {Set current limit on number of batch processes}
   %record(parm fm) P
   %integer init proc = user("INIT")
   %if init proc <= 0 %start
      Print string ("Batch system down")
      Newline
      %return
   %finish
   P_p1 = int(parm)
   P_dsno = init proc ! 64
   P_dact = 3                            {???????}
   P_ssno = 0
   SVC (Pon,P)
%end

%external %routine SPOOLER (%string(63) parm)
   {Send a command to one of POTTER's spoolers}
   %const %integer last command = 5
   %const %string(15) %array spooler command(1:last command) =
      "PAUSE", "CONTINUE", "RESTART", "CANCEL", "STOP"
   %string(63) queue id
   %record(parm fm) P
   %integer j
   %on %event 10 %start   {to catch faulty queue names}
      print string("Invalid queue name ".queue id.snl)
      %return
   %finish
   split up(parm);  check parm(1+2)
   queue id = command_in1; parm = command_in2
   pack user(queue id, p_file)
   p_p1 = file_owner         {get Q-id into right field}
   To upper (parm)
   %for j = 1,1,last command %cycle
      %if spooler command(j) = parm %start
         P_p2 = j
         P_dact = 13
         SVC (22,P)
         %if P_p6 # 0 %start
            Print string (P_text)
            Newline
         %finish
         %exit
      %finish
      %if j = last command %start
         Print string (parm)
         Print symbol ('?')
         Newline
         %return
      %finish
   %repeat
%end

{Creation, deletion and renaming of user processes}
{ $CREATE   user-name   password                  }
{ $DELETE   user-name                             }
{ $RENAME   user-name   new-name                  }
%routine  life and death(%integer op, %string(63)%name  parm)
   %record(parmfm)  user, parm2
   split up(parm)
   %if op = 0 {$DELETE} %start
      check parm(1)
      parm2_file_owner = 0      {to avoid 'unassigned' problem below}
   %else %if op = 1 {$CREATE}
      check parm(1+2)
      pack user(command_in2, parm2_file)
   %else
      check parm(1+8)
      pack user(command_out1,parm2_file)
   %finish
   pack user(command_in1, user_file)
   %if user_file_unit = 0 %start
FAULTY UNIT:
      print string("Faulty unit name?")
      newline
      %return
   %finish
   %if op = 2 {$RENAME} %start
      -> FAULTY UNIT %if parm2_file_unit=0 %or parm2_file_unit#user_file_unit
      user_P4 = parm2_file_owner
      op = Direct P Rename
   %else
      user_P3 = parm2_file_owner   {Password:- irrelevant for $DELETE}
      %if op = 0 %then op = Direct P Delete %else op = Direct P Create
   %finish
   director(op, user)
%end

%systemroutine  CREATE (%string(63)  parm)
   life and death(1,parm)
%end
%systemroutine  DELETE (%string(63)  parm)
   life and death(0,parm)
%end
%systemroutine  RENAME (%string(63)  parm)
   life and death(2,parm)
%end

%end %of %file
