{      6-Nov-81
{  MOUSES Standard command library       A. Culloch   Sep-81
{
!!!!%option  "NODECODE"
{
%const %string(3) version = "1.3"
{
{
{        OBEY(parm)  command/report
{        COPY  in1, in2, in3 / out
{        FILES
{        DELETE filespec
{        RENAME filespec/filespec
{        PURGE
{        LET   symbol = ...     or  LET?
{        LIB   Object filespec
{        BECOME  Username
{        ENTRIES Object filespec/out
{        OPTION(opt1, opt2, ...)  Objfilespec
{        ANALYSE  filespec/out
{        OFFER  filespec/queue:
{        SET  opt1, opt2, opt3, ...
{        STATE  or  STATE(SYSTEM)  or STATE(QUEUES)  or STATE(DISCS)
{
{  Some commands use the separate 'wildcard' processor module:
{
%include  "SysInc:Command.inc"

%record %format Filespec(%string(7) Unit, Owner, %string(15) File,
                         %string(3) Ext,
                         %short %integer Volatile, Nil)

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

%routine %spec              Sort(%record(FD fm)%arrayname T, %integer Lo, Hi)
%routine %spec              Wild Spec(%string(31) spec)
%record(Filespec) %fn %spec Next filespec
%record(Filespec) %fn %spec Split(%string(31) Filename)
%string(31)       %fn %spec Filename (%record(Filespec)%name F)
%routine %spec              For each(%record(Commandfm)%name C,
                                     %routine X(%record(Commandfm)%name CC))
%routine %spec              Mask(%record(Filespec)%name f,
                                 %record(filespec) mask)
%own %record(Command fm) C

{Subsystem entries}

%include "SysInc:Direct.inc"
%externalroutinespec  Parse Parameter(%record(Commandfm)%name  C, %integer  option,
                                          %string(127)  Parm)
%external %string(7)               %spec  SS Version %alias "$VERSION"
%external %string(17)              %spec  Console Int
%external %string(17)              %spec  Command Prompt
%external %string(15)              %spec  Error file
%external %string(7)               %spec  Search owner
%external %string(72)          %fn %spec  ItoS (%integer I, Places)
%external %integer             %fn %spec  StoI(%string(31) s)
%external %integer             %fn %spec  In type
%external %integer             %fn %spec  Out type
%external %predicate               %spec  Exists(%string(31) Filename)
%external %routine                 %spec  Rename File(%string(31) old, new)
%external %routine %spec      Pack (%string(31) file, %record(Filefm)%name F)
%external %routine %spec    Unpack (%record(Filefm)%name F, %string(*)%name ff)
%external %routine %spec   Console (%string(63) Message)
%external %routine %spec      Echo (%integer on off)
                                    %const %integer off = 0, on = 1
%external %routine %spec  To Upper (%string(*)%name S)
%external %routine %spec  To Lower (%string(*)%name S)
%external %routine %spec  Open All (%record(Command fm)%name C)
%external %routine %spec Close All (%integer how)
%external %routine %spec Read Line (%string(*)%name S)
%external %routine %spec  Del File (%record(file fm)%name F, %integer quiet)
%external %routine %spec      Phex (%integer X, Places)
%external %routine %spec   Open DA (%integer chan, RW, %string(31) Filename)
%external %routine %spec   Read DA (%integer chan, block num, %name buffer)
%external %routine %spec  Write DA (%integer chan, block num, %name buffer)
%external %routine %spec  Close DA (%integer chan)

%external %routine %spec Xobey %alias "$OBEY"(%string(31) f,t, %string(63) p)

%constant %integer   IO error = 9
%constant %string(2)        x = "X "
%constant %integer  To Potter = 22,      {SVC:Message-> Central Queuing Agency}
                      Set TTY = 29,      {Set console parameters}
                    Disc read = 101,     {Physical disc I/O}
                   Disc Write = 102,
                  Disc Status = 108,
                     max unit = 12

!File system disc block formats

%record %format extent  (%short length,  {# of contiguous blocks in extent}
                         %short base)    {disc addr of first block}
%record %format spine   (%short extents, {# of extents in file}
                         %byte  access permissions,
                                check,   {should always be '?'}
                         %integer blocks,{# of blocks in file}
                         %record(extent) %array extent (1:126))

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


%routine To mixed(%string(*)%name S)
   %byte %name C
   %return %if S = ""
   To lower(S)
   C == Char no(S, 1)
   C =  C - 'a' + 'A' %if 'a' <= C <= 'z'
%end

%routine Failure(%string(63) extra)
   %string(63) S = "*"
   To mixed(Command_command)             {Which command blew up?}
   %if event_message = "" %start
      event_message = "event ".ItoS(event_event,0).",".        %c
                               ItoS(event_sub,  0)
   %finish
   S = S.Command_command." "
   extra = extra." " %if extra # "" %and char no(extra, length(extra)) # ' '
   S = S.extra."fails - ".event_message
   Console(S)
%end

%routine TT set(%integer parm, val)
   %record(parm fm) P
   P_p1 = parm
   P_p2 = 0                              {My terminal}
   P_p3 = val
   SVC(Set tty, P)
%end

%routine Number (%integer N, Places, %string(31) Text)
   %if N = 0 %then print string("No") %else Write(N, Places)
   Space
   Length(Text) = Length(Text) - 1 %if N = 1
   Print string(Text)
%end

%routine  PRINT THEN PAD(%integer  width, %string(63)  s)
   print string(s)
   spaces(width - length(s))
%end

%routine  PAD THEN PRINT(%integer  width, %string(63)  s)
   spaces(width - length(s))
   print string(s)
%end

%routine Director(%integer Dact, %record(Parmfm)%name P)
   P_Dact = Dact
   SVC(To Director, P)
   Event_message = P_text %and %signal 11 %if P_p6 # 0
%end

%routine Squeeze(%string(*)%name S)
   %string(63) T = ""
   %integer    j
   %for j = 1, 1, length(S) %cycle
      T = T.to string(char no(S,j)) %if char no(S,j) # ' '
   %repeat
   S = T
%end

%integer %function Look up(%string(63) s, %string(*)%array %name Table,
                           %integer low, high {bounds on TABLE})
   %integer j
   %for j = low, 1, high %cycle
      %result = j %if table(j) = s
   %repeat
   %result = 0                           {not found}
%end

%string(8) %function Access(%integer mask)
   %integer k = 1, j
   %string(8) s = ""
   %result = "None" %if  mask     = 0
   %result = "All"  %if ~mask&255 = 0
   %for j = 0, 1, 7 %cycle
      s = s . to string('A' + j) %if mask&1<<j # 0
   %repeat
   %result = s
%end

%integer %function Access bits(%string(31) s)
   %integer mask = 0, j, sym
   To upper(s)
   %result = -1 %if s = "ALL"
   %result =  0 %if s = "NONE"
   %for j = 1, 1, length(s) %cycle
      sym = char no(s, j)
      %if 'A' <= sym <= 'H' %start
         mask = mask ! 1<<(sym-'A')
      %else %if sym # ' '
         Event_message = "invalid access code ".s
         %signal 11
      %finish
   %repeat
   %result = mask
%end

%predicate  privileged
   %record(parmfm)  p
   p_p1 = 0;  svc(14,p)
   %true %if p_p4 < 0
   %false
%end

%external %routine OBEY (%string(63) Parm)
   %on 9 %start
      Console("*end*".event_message)
      %return
   %finish
   parse parameter(C,0,parm)
   Xobey(C_in1, C_out1, C_Parameter)
%end

%external %routine COPY (%string(63) Parm)
   %routine Copy(%record(Command fm)%name C)
      %external %integer %function %spec READ SYMBOL %alias "#READSYMFN"
      %external %routine %spec  READ BLOCK(%integer  key, block no, %name buff)
      %external %routine %spec WRITE BLOCK(%integer  key, block no, %name buff)
      %external %routine %spec SEEK OUTPUT(%integer  file addr)
      %constinteger  block size=512
      %integer       max = 6      {inspired guesswork = ad hockery!!}
      %integer Stream
      %on * %start
         Failure("") %and %return 
      %else
         %if C_in1 = "" = C_out1 %start
            Event_message = "dubious input and output"
            %signal 11
         %finish
         Open output(1, C_out1)
         Select output(1)
         Console(sNL.C_in1 ." on ".Date." at ".Time. sNL) %if C_Modifier = '?'
         open input(1,C_in1);  select input(1)
         stream = 1
      %finish

      %if C_in1 = "" = C_in2 %and intype > 0 %and outtype > 0 %start
         {Special to copy a single file quickly}
         %begin
            %recordformat  bfm(%byteintegerarray  a(1:block size))
            %record(bfm)%array  b(0:max-1)
            %integer  inkey = intype, outkey = outtype
            %integer  k,d, n = 0
            %on %event 10 %start      {end-of-file from READ BLOCK}
               -> COMPLETE
            %finish
            %cycle
               d = 0
               %cycle
                  read block(inkey, n+d, B(d))
                  d = d+1
               %repeat %until d = max+1
               write block(outkey, n+k, B(k)) %for k = 0,1,d
               n = n+d
            %repeat
         COMPLETE:
            write block(outkey, n+k, B(k)) %for k = 0,1,d-1
            seek output( (n+d)*blocksize - 1)
         %end
      %else
         {General case}
         %begin
            %on %event IO error %start
               -> OUTPUT COMPLETE %if stream = 3
               stream = stream+1
               open input( stream, c_in(stream) )
               select input(stream)
            %finish
            %cycle
               print symbol(readsymbol)
            %repeat
         OUTPUT COMPLETE:
         %end
      %finish

      Close All(0)
   %end
   Prompt("Copy:")
   parse parameter(C,0,parm)
   For each(C, Copy)
%end

%external %routine PURGE
   %record(parm fm) P
   %on * %start
      Failure("")
   %else
      Director(Direct Purge, P)
      Number(P_p1, 0, "files")
      Print string(" deleted")
   %finish
%end

%external %routine OFFER(%string(63) parm)
   %routine send(%record(Command fm)%name C)
      %systemroutinespec  offer (%string(31) file name, %integer  copies, mode,
                                 %string(7)  destination)
      %on * %start
         Failure(C_in1);  %return
      %finish
      offer(C_in1, 1, 0, C_out1)
   %end
   parse parameter(C,0,parm)
   For each(C, Send)
%end

%const %integer set min = -19,  set max = 10
%const %string(9) %array Set words(set min:set max) =
   "PASSWORD",
   "WILD",
   "ERASE",
   "TABS",
   "free"(4),
   "TRACE",   {1024}
   "QUICK",   {512}
   "s-256",   {256 unused}
   "s-128",   {128 unused}
   "XDUMP",   {64}
   "s-32",    {32 unused}
   "s-16",    {16 unused}
   "s-8",     {8  unused}
   "VERIFY",  {4}
   "DUMP",    {2}
   "MONITOR", {1}
   "eh?",
   "TIME", "TIMELIMIT",
   "WIDTH",
   "TAB",
   "SPEED",
   "PAGE",
   "SEARCH",
   "PROMPT",
   "ERRORFILE",
   "STACK"

%external %routine SET    (%string(63) parm)
   %switch                Set(set min : set max)
   %const %integer        On = -1, off = 0, Set tty = 29
   %integer               what, on off, bit, j, here
   %string(63)            S, val, t, tt
   %system %integer %spec Options, Default time, Default Stack,
                          Wild Monitor
   %record(Parm fm)       P, Q
   %on * %start
      %if Event_event = 3 %start         {Symbol in data, from StoI}
         Event_Message = """".to string(Event_extra).""" in number?"
      %finish
      Failure("")
      %return
   %finish

   parm = parm.","
   %while parm -> s.(",").parm %cycle
      val = "" %unless s -> s.("=").val
      Squeeze(s)
      To upper(s)                        {Keyword part}
      tt = ""  %unless s -> s.(":").tt
      On off = on
      %if s -> t.("NO").s %start
         %if t = "" %then on off = off %else on off = on %and s = t.s
      %finish
      what = look up(S, set words, set min, set max)
      %if what < 0 %and val # "" %start  {SET (no)opt}
         Console(" = ?");  %return
      %finish

      -> Set(what)

      Set(*):     Event_message = s." not understood"
                  %Signal 11

      {*********  -ve WHAT:  Set X  or  Set No X  ***********************}

      Set(-1):    {Set Monitor}
      Set(-2):    {Set Dump}
      Set(-3):    {Set Verify}
      Set(-7):    {Set XDump}
      Set(-10):   {Set Quick}
      Set(-11):   {Set Trace}
                  Bit = 1<<(-what-1)
                  %if on off = off %then options = options & (~Bit) %c
                                   %else options = options !   Bit
                  %continue

      Set(-16):   {Set tabs}
                  TT set(6, on off)
                  %continue

      Set(-17):   {Set Erase}
                  TT set(3, on off)
                  %continue

      Set(-18):   {Set Wild}
                  Wild Monitor = on off
                  %continue

      Set(-19):   {Set Password}
                  Echo(1)
                  Q_p1 = 0;  Director(Direct Identify, Q)
                  %unless privileged %start   {so OPER can help forgetful users}
                     Prompt("Old password:")
                     Read line(val)
                     Pack(val.":", P_file)
                     Q_p3 = P_file_owner
                     Q_Dact = Direct Become
                     SVC (To Director, Q)
                     %return %if Q_p6 # 0
                  %finish
                  Prompt("New password:")
                  Read line(val)
                  Pack(val.":", P_file)
                  P_p3 = P_file_owner
                  Director(Direct Pass, P)
                  Console("New password set")
                  %continue

      {*********************  +ve WHAT:  Set X = ...  ***********************}

      Set(1):     {Set time=N}
      Set(2):     {Set timelimit=N}
                  Default time = StoI(val)
                  %continue

      Set(3):     {Set width=N}
                  j = StoI(val);  j = 80 %if j < 0
                  TT set(1, j)
                  %continue

      Set(4):     {Set tab=N+N+... }
                  here = 0
                  val  = val."+"
                  %for j = 0, 1, 9 %cycle
                     %if val -> t.("+").val %start
                        here = here + StoI(t)
                     %else
                        here = here + 3
                     %finish
                     Byte integer(Addr(P_p3)+j) = here
                  %repeat
                  P_p1 = 5;  P_p2 = 0;  SVC(Set TTY, P)
                  %continue

      Set(5):     {Set speed:tt# = N}
                  P_p1 = 7;  P_p3 = StoI(val)
                  P_p2 = 0;  P_p2 = StoI(t) %if t # ""
                  SVC(Set tty, P)
                  %continue

      Set(6):     {Set page=N}
                  TT set(2, StoI(val))
                  %continue

      Set(7):     {Set search=owner}
                  %if val # "" %and char no(val, length(val)) = ':' %start
                     length(val)  = length(val) - 1
                  %finish
                  val = val.":" %if val # ""
                  Search owner = val
                  %continue

      Set(8):     {Set prompt=...}
                  length(val) = 17 %if length(val) > 17
                  Command prompt = val
                  %continue

      Set(9):     {Set Error file = filename}
                  length(val) = 15 %if length(val) > 15
                  Error file  = val
                  %continue

      Set(10):    {Set Stack=N}
                  Default Stack = StoI(val)
                  %continue

   %repeat
%end

%external %routine PERMIT(%string(63) Parm)
   %record(Command fm) C 
   %integer            Access mask

   %routine Permit (%record(Command fm)%name C)
      %record(Parm fm) P
      %integer         Dact
      %on * %start
         Failure(C_in1);  %return
      %finish
      Dact = Direct Daccess
      %if C_modifier = 0 %start          {Default: set file access}
         Pack(C_in1, P_file)
         Dact = Direct Faccess
      %finish
      P_p6 = Access mask
      Director(Dact, P)
   %end

   parse parameter(C,0,parm)
   Access mask = Access bits(C_parameter)
   For each(C, Permit)
%end

%external %routine DELETE(%string(63) parm)
   %routine Delete(%string(*)%name SS)
      %record(Filespec) F
      %record(Parm fm)  P
      %string(31)       S = SS                    {**COMPILER NASTY**}
      %on * %start
         Failure(S);  %return
      %finish
      String(Addr(P_Sact)) = S;  SVC(17, P)       {Pack filename}
      %if P_file_owner = 0 %start                 {Simple filename}
         Del file(P_file, -1)
         Console(S." deleted")
      %else
         Wild spec(S)
         %cycle
            F = Next filespec
            %exit %if F_Nil # 0
            S = Filename(F)
            Pack(S, P_file)
            Del file(P_file, -1)
            P_file_unit = 0;  P_file_owner = 0
            Unpack(P_file, S)
            Console (S." deleted")
         %repeat
      %finish
   %end
   %string(63) S
   Parm = Parm.","
   Delete(S) %while Parm -> S.(",").Parm
%end

%external %routine Xpack %alias "#PACK"(%string(63) File)
   %record(Parm fm) P
   String(Addr(P_Sact)) = File;  SVC(17, P)
   Phex(P_file_unit,8);  Space;  Phex(P_file_owner,8);  Space
   Phex(P_file_N1,  8);  Space;  Phex(P_file_N2,   8);  Newline
%end

%external %routine  BECOME (%string(63) parm)
   %record(parm fm) P
   %byte %name      C
   %string(63)      Pass
   %integer         Ppass = 0, who
   %Label           OK
   %on * %start
      Failure("");  %return
   %finish
   %if parm # "" %start
      %unless parm -> parm.(",").pass %start
         -> OK %if Privileged
         Echo (off)
         Prompt ("Pass:")
         Read line (pass)
         Echo (on)
      %finish
      Pack(pass.":", P_file)
      Ppass = P_file_owner
OK:   %if parm # "" %and char no(parm,length(parm)) = ':' %start
         length(parm) = length(parm) - 1
      %finish
   %finish
   parm = parm.":"
   Pack (parm, P_file)
   who = P_file_owner
   P_p3 = Ppass;  P_p6 = 0
   Director(Direct Become, P)
   To lower (parm)
   c == char no(parm,1)
   c = c - 'a' + 'A' %if 'a' <= c <= 'z'
   parm = "Command: " %if who = 0
   Command prompt = parm
%end

%external %routine RENAME(%string(63) parm)
   %routine Rename (%record(Command fm)%name C)
      %record(File fm) F
      %on * %start
         Failure(C_in1."/".C_out1);  %return
      %finish
      Pack(C_in1, F)
      F_unit = 0;  F_owner = 0
      Unpack(F, C_in1)
      Rename file(C_in1, C_out1)
      Console(C_in1." renamed ".C_out1)
   %end
   %record(Command fm) C 
   parse parameter(C,0,parm)
   For each(C, Rename)
%end

%external %routine LET(%string(63) parm)
   %systembytearrayspec Alias Text(0:255)
   %systemintegerspec   Alias Limit;     !one past last used addr
   %systemroutinespec   Let(%string(63) old, new)
   %externalroutinespec Alias (%string(*)%name it)
   %byte %integer %name B, Last == byte integer(alias limit)
   %integer             J, k
   %string(63)          New
   %if parm -> parm.("=").new %start
      %if parm = "" %start
         Console("Let what= ?");  %return
      %finish
      To upper(parm)
      Let(parm, new)
   %else %if parm = "" %or char no(parm, 1) = '?'
      j = 0
      b == alias text(0)
      %while b ## last %cycle
         %for k = 1,1,b %cycle
            b == b ++ 1
            Print symbol (b)
         %repeat
         b == b ++ 1;              !to next length byte
         %if j = 0 %start;         !toggle thru table: <sym><translation>
            Print string (" = ");  ! pairs. (Both terminated by 0's).
         %else;                    !..after <trans>..
            Newline
         %finish
         j = ~j;                   !toggle j
      %repeat
   %else;                          !LET x   i.e. show X
      New = parm
      To upper(new);  Alias(new)
      Print string(parm." = ".new)
      Newline
   %finish
%end

%external %routine LIB(%string(63) param)
   %systemintegerspec             Lib limit
   %recordformat                  Libfm(%integer when, %string(27) name)
   %systemrecord(libfm)%arrayspec Lib(1:7)
   %integer                       J, Insert, Old, New, Show
   %string(63)                    F
   %record(file fm)               Pfile
   %routine show lib
      %integer j
      %if lib limit = 0 %start
         Print string("No entries");  newline
      %else
         %for j = 1, 1, lib limit %cycle
            Spaces(3);  Print string(Lib(j)_name);  newline
         %repeat
      %finish
   %end
   %on * %start
      Failure("");  %return
   %finish
   To upper(Param)
   %if Param = "" %start
      Show lib
   %else
      Squeeze(Param)
      Param = Param.","
      %cycle
         Param -> F.(",").Param
         Show = 0
         %if F # "" %and char no(F, length(F)) = '?' %start
            Show = 1;  length(F) = length(F) - 1
         %finish
         %if F # "" %start
            %if F = ".NONE" %start
               Lib limit = 0
            %else
               Insert = 1;  Insert = 0 %if F -> ("-").F
               Pack (F, Pfile)                 {Check validity of name}
               Unpack(Pfile, F)                {Standard string form}
               New = 0;  Old = 0
               %while Old # Lib Limit %cycle
                  Old = Old+1
                  %if Lib(Old)_Name # F %start
                     New = New+1
                     Lib(New) = Lib(Old)
                  %finish
               %repeat
               %if Insert # 0 %start
                  %if New = 7 %start
                     Event_message = "Library list full"
                     %signal 11
                  %finish
                  New = New+1
                  Lib(New)_When = 0
                  Lib(New)_Name = F
               %finish
               Lib Limit = New
            %finish
         %finish
         Show lib %if show # 0
      %repeat %until Param = ""
   %finish
%end

%external %routine OPTION(%string(63) parm)
   %constant %integer decode = 1,               {Object file option masks}
                      open   = 2,
                      stack  = 8,
                      priv   = 16,
                      upper  = 32,
                      spacesx= 64
   %string(63)        s, t, val
   %integer           j, k, write flag = 0,
                      on off
   %constant %integer on = 0, off = -1,
                      last option  =  7,
                      first option = -2
   %constant %string(6) %array options(first option : last option) =
      "STACK=", "TIME=",
      "Zero",
      "DECODE", "OPEN", "unused", "STACK", "PRIV", "UPPER",
      "SPACES"

   %recordformat blockfm(%shortinteger code size, gla size, 
                                       pad1, pad2, pad3,
                                       time, flags, stack, 
                         %shortintegerarray a(1:248))
   %record(blockfm) block
   %record(Command fm) C
   %on * %start
      Failure("");  %return
   %finish

   parse parameter(C,0,parm)
   Parm = C_Parameter
   To upper(parm)
   C_in1 = C_in1.".exe" %unless C_in1 -> (".")
   Open DA(1, 1, C_in1)
   Read DA(1, 0, Block)
   Squeeze(parm)

   %if parm = "" %or parm = "?" %start
      S = "Options set: "
      S = S."upper case, "    %if Block_flags&upper # 0
      S = S. "remove spaces, " %if Block_flags&spacesx # 0
      %routine No(%integer x, %string(63) what)
         S = S. "no " %if x # 0
         S = S . what
      %end
      No(Block_flags&decode, "decode, ")
      No(Block_flags&open, "open, ") %if Block_flags&decode = 0 {otherwise irrelevant}
      No(Block_flags&priv, "priv, ")
      No(Block_flags&stack, "stack")
      S = S . snl
      print string(S)

      %routine pretty(%string(31) S, %integer value)
         pad then print(10,S)
         Space;  Print symbol('=')
         %if value = 0 %start
            print string(" current default")
         %else
            Write ( |value|, 1 )
            %if value < 0 %then print string(" absolute")
         %finish
         Newline
      %end

      Pretty("Stack",   Block_stack)
      Pretty("Code",    Block_Code Size<<9)
      Pretty("GLA",     Block_GLA  Size<<9)
   %else
      write flag = 1
      parm = parm.","
      %while parm -> s.(",").parm %cycle
         On off = on
         %if s -> t.("NO").s %start
            %if t = "" %then on off = off %else s = t."NO".s
         %finish
         %if s -> s.("=").val %then s = s."=" %else val = ""
         j = Look up(s, Options, first option, last option)
         %if j < 0 %start
            Event_message  = val." not a number"   {just in case}
            k              = StoI(val)
            %if j = -1 %start
               Block_Time  = k
            %else
               Block_Stack = k
               Block_flags <- Block_flags & (\stack)
            %finish
         %else %if j = 0
            Event_message = s." not understood"
            %signal 11
         %else
            j = 1<<(j - 1)
            Block_flags <- Block_flags & (~j)
            Block_flags <- Block_flags ! j    %unless on off = on
                                              {Bits SET for NOxxx - yech}
         %finish
      %repeat
   %finish
   Write DA(1, 0, Block) %if write flag # 0
   Close DA(1)
%end

%external %routine ENTRIES(%string(63) parm)
   %constinteger h = X'FFFF'
   %string(63) file, output
   %recordformat  pgmfm(%integer  limit,stack,gla,code base,ep,code,   %c
                                                %shortinteger  options)
   %record(parmfm) p, q
   %recordformat loadfm(%integer code, gla, specs, defs, when, file)
   %recordformat textfm(%integer n1, n2)
   %recordformat specfm(%integer gla, code, ep)
   %recordformat hdfm(%shortinteger base, n)
   %recordformat headfm(%shortinteger pure size, gla size, code disp, %C
                                      lit disp, registers, mainep, %C
                        %record(hdfm) reloc, defs, specs, ldiag, vdiag)
   %recordformat deffm(%shortinteger link, ep, %integer n1, n2)
   %ownrecord(headfm)%name head
   %record(specfm)%name spec
   %record(deffm)%name def
   %record(textfm)%name sp
   %integer base, code, gla, specs, defs
   %system %routine %spec Unpack Spec(%record(Textfm)%name T)  {into..}
   %system %string(15) %spec Spec id
   %record(textfm) txt
!!!!!!   %integer max = (free space - 1024) >> 4
   %CONSTINTEGER MAX=200
   %record(fdfm) %array slots(1:max)
   %integer used = 0, j, col
   %on * %start
      Failure("");  %return
   %finish
   parse parameter(C,0,parm)
   Open output(1, C_out1);  Select output(1)
   file = C_in1
   file = file.".exe" %unless file -> (".")
   string(addr(p_sact)) = file
   svc(10, p)
   %if p_p1 # 0 %start
      Event_message = "Cannot load ".file
      %signal 11
   %finish
   code = p_p2;  base = code-16
   gla = p_p3
   %if shortinteger(base+4) # X'4321' %start
      Event_message = file." is an old format file"
      %signal 11
   %finish
   Select output(1)
   head == record(code)
   code  = code+head_code disp&H*2
   specs = head_specs_n
   defs  = head_defs_n
   %if defs # 0 %start
      Print string("External entry points:");  newline
      %cycle
         def == record(base+2*defs+16)
         used = used + 1
         %if used > max %start
            Event_message = "too many entries"
            %signal 11
         %finish
         txt_n1 = def_n1;  txt_n2 = def_n2
         Unpack spec(txt)
         Slots(used)_name = Spec Id
         defs = def_link&h
      %repeat %until defs = 0
      Sort(slots,1,used) %if command_modifier = 0
      col = 0
      Spaces (4)
      %for j = 1,1,used %cycle
         print then pad(14,slots(j)_name)
         col = col + 1
         newline %and spaces(4) %if col&3 = 0
      %repeat
   %finish
%end

%external %routine STATE(%string(63) parm)
   %record(parm fm) P, Q, R
   %string(63)      x
   %byte %name      last
   %integer         others, hours, secs, j, k, prot, unit no, sym, priv
   %integer  exclam
   %record(zerofm)  block
   %record(spine)   free
   %integerfn  checkword      {compute zero block checksum}
      %integer  j,k=0
      k = k + integer(j) %for j = addr(BLOCK),4,addr(BLOCK)+512-4
      %result = 1-k
   %end
   %routine  read block(%integer  unit num, block num, %record(*)%name buffer)
      %record(parmfm) p
      p_p1 = block num&x'FFFF'
      p_p2 = addr(buffer)
      p_p3 = unit num      
      p_p4 = 0             {into my VM}
      svc(DISC READ,p)
   %end

   %on * %start
      Failure("");  %return
   %finish

   To upper(parm)
   Squeeze(parm)
   %if length(parm) >= 2 %start
      exclam = charno(parm,length(parm))
      %if exclam = '!' %or exclam = '?' %start
         length(parm) = length(parm)-1
      %else
         exclam = 0
      %finish
      length(parm) = length(parm)-1 %if charno(parm,length(parm)) = 'S'
   %finish
   %if parm = "" %or parm = "SYSTEM" %start
      SVC (28,R)                         {System information}
      SVC (19,P)                         {General information}
      Print string ("Mouses ".string(addr(P_p6)).                       %c
                    ":  CXE ".SS Version."/".version." on ".DATE.   %c
                    " at ".TIME.snl)
      others = P_p2 - 1
      %if parm # "" %start
         Write (R_p1>>1, 0)
         Print string ("KB of user store, swopping from unit")
         Write (R_p2, 1)
         hours = P_p1//(60*60)      {seconds => hours}
         %if hours # 0 %start
            Print symbol (',')
            Number(hours, 1, "hours")
            Print string (" since startup")
         %finish
         Print string ("

 Process         Store Console    CPU Level Prio Debt
")
         %for j = 4, 1, 32 %cycle
            P_p1 = j;  SVC (14,P)
            %if P_p6 >= 0 %start
               Q_file_unit = P_p1;  Q_file_owner = P_p2
               Q_file_N1   = 0;     Q_file_N2    = 0
               Unpack (Q_file, x)
               length(x) = length(x) - 1
               k = 1
               k = k + 1 %while char no(x,k) # '_'
               Write (j,2)
               Spaces (6-k)
               Print string (x)
               P_p3 = P_p3+1 %if P_p3&1 # 0 {round up odd figures}
               Write (P_p3>>1, k-length(x)+11)
               k = P_p6>>16;  P_p6 = P_p6&x'FFFF'  {P_p6: Debt<<16+console}
               %if P_p6 = 0 %then spaces(6) %else write(P_p6,5)
               Print (P_p5/1000, 7, 1)
               Write (P_p4&7, 3)         {Contingency level}
               Write (P_p4<<1>>9, 5)     {Queue}
               Write (k, 3)              {Debt}
               Print string ("  privileged") %if P_p4 < 0
               Newline
            %finish
         %repeat
         Newline
         %return
      %finish
      P_p1 = 0;  SVC(14,P)               {Get user specific info}
      priv = P_p4
      P_file_unit = P_p1;  P_file_owner = P_p2
      P_file_N1= 0;        P_file_N2 = 0
      Unpack (P_file, x)
      length(x) = length(x) - 1
      Print string ("User: ".x)
      Q_p1 = 0                           {Myself}
      Director(Direct Identify, Q)
      %if P_file_unit # Q_file_unit %or P_file_owner # Q_file_owner %start
         Print string (" alias ")
         Unpack (Q_file, x)
         length(x) = length(x) - 1
         Print string (x)
      %finish
      Print string (", logged on console");  write (P_p6,1)
      Secs = P_p5//1000
      %if secs # 0 %start
         Print symbol(',')
         Number(secs, 1, "CPU seconds")
         Print string (" used")
      %finish
      Newline
      Print string ("Process")
      P_p1 = 0 {me}
      Write (P_dsno&63, 1)
      Print string (" (privileged)") %if priv>>31 # 0
      Print symbol (',')
      Write (others, 1)
      Print string (" other processes")
   %else %if parm = "DISC"
      Print string ("
  Unit")
      %if exclam # 0 %then print string( %c
      "     S/W  H/W   Initialised   " )
      %if exclam = '!' %then print string(" Lost   Free   Used   Label")
      Newline
      SVC (28,Q)                         {Get sys info}
      %for unit no = 1,1,max unit %cycle
         %if unit no = Q_p2 %start
            Write (unit no, 2);  print string (" *swop*");  newline
            %continue
         %finish
         P_p1 = unit no;  P_dact = 40
         SVC (To Director, P)            {Get name of disc on unit}
         prot = P_p2
         %if exclam = 0 %start           {Just name & prot status}
            %continue %if P_p6 # 0 %or   {Unit not loaded}
                          P_P1 = 0       {Temp fix}
            Write (unit no, 2);  space
            P_file_owner = 0;  P_file_N1 = 0;  P_file_N2 = 0
            Unpack (P_file, x)
            length(x) = length(x) - 1
            Print string (x)
            %if prot # 0 %start
               Spaces (7 - length(x))
               Print string ("protected")
            %finish
         %else
            Write (unit no, 2);  space
            Read block (unit no, 0, block)
            %if P_p6 = 0 %and P_P1 # 0 %start         {Online OK}
               print then pad(7, block_disc id)
               %if prot # 0 %then print string("prot") %else spaces(4)
               P_p3 = unit no;  SVC (Disc status, P)
               %if P_p6&4 # 0 %then print string(" prot") %else spaces(5)
               %if checkword # 0 %start
                  Print string (" *foreign disc*")
               %else                     {Standard MOUSES disc}
                  pad then print(12, block_initialisation date)
                  %if exclam = '?' %start
                     Print string (block_description);  newline
                     %continue
                  %finish
                  Read block (unit no, block_free list, free)
                  Write (free_extents, 8){Lost blocks}
                  k = 0                  {count free blocks
                  %for j = 1,1,126 %cycle{by summing sizes of free extents
                     k = k + free_extent(j)_length&x'FFFF'
                  %repeat
                  Write (k, 6)
                  Write (block_tracks*block_blocks per cylinder {disc size} %c
                         - k {free}                                         %c
                         - free_extents {lost},  6)
                  Spaces (3)
                  %for k = 1,1,4 %cycle
                     sym = block_vol id>>(3*8)
                     %if sym = 0 %then space %else print symbol(sym)
                     block_vol id = block_vol id<<8
                  %repeat
                  Space;  Print string (block_description)
               %finish
            %finish
         %finish
         Newline
      %repeat
   %else %if parm = "QUEUE"
      %begin                             {Show potter's queue entries}
         %record %format entry fm (%record(file fm) label, actual,
                                   %integer queue, date, time,
                                   %short %integer priority, mode)
         %record %format block fm (%integer %array spare(1:8),
                                   %record(entry fm) %array e(0:9))
         {Potter's queue is a file of blocks of entries}
         %const %integer queue = 1       {DA channel for queue file}

         %record(entry fm) %map entry(%integer N)
            %integer block no = N//10, offset = rem(N,10)
            %own %integer last block = -1
            %own %record(block fm) block
            Read DA (queue, block no, block) %if block no # last block
            last block = block no
            %result == block_e(offset)
         %end

         %record(file fm) f
         %record(entry fm)%name e
         %integer first = 1, count
         %string(63) x
         %integer j

         Open DA (queue, 0, "POTTER:QUEUE")
         Count = 0
         %for j = 1,1,255 %cycle
            e == entry(j)
            %if e_queue # 0 %start       {Valid entry}
               count = count + 1
               %if first # 0 %start
                  Print string ("
Queue   Label                     Actual                     Date        Size
")
                  first = 0
               %finish
               f = 0;  f_owner = e_queue
               Unpack (f, x);  print then pad(8,x)
               Unpack (e_label, x);  print then pad(26,x)
               Unpack (e_actual, x);  print then pad(26,x)
               P_p1 = e_date
               SVC (13, P)               {unpack date}
               pad then print(10,p_text)
               P_file = e_actual
               P_dact = 18               {get status}
               SVC (To Director, P)
               Print (P_p2/2, 5, 1);  print string("Kb")
               Newline
            %finish
         %repeat
         Number(Count,0, "files")
         Print string(" queued")
         Newline
      %end
   %else
      Print string (parm."?")
   %finish
   Newline
%end

%external %routine FILES(%string(63) parm)
   %string(15) %array File(1:42)
   %string(15) %name  Sn
   %string(63)        S
   %integer           N = 0, rows, cols, j, k
   %string(7)         Last owner, last unit
   %record(Filespec)  F
   %record(Parm fm)   P
   %record(Commandfm) C 
   %on * %start
      Failure("");  %return
   %finish
   parse parameter(C,0,parm)
   Open output(1, C_out1);  Select output(1)
   F = Split(C_in1)
   F_file = "*" %if F_file = ""
   F_ext  = "*" %if F_ext  = ""
   Wild spec(Filename(F))
   F = Next filespec
   Last owner = F_owner
   Last unit  = F_unit
   %cycle
      %if F_Nil # 0 %or F_owner # last owner %start
         Number(N, 0, "files")
         Print string(" owned by ".last owner) %if last owner # ""
         Newline
         %if N # 0 %start
            %if C_Modifier # 0 %start    { Files! } 
               Print string("
      Filename        Size   Access   Last used
")
               %for j = 1, 1, N %cycle
                  Sn == File(j)
                  print then pad(17, Sn)
                  S = Last unit."_".last owner.":".Sn
                  Squeeze(S)
                  Pack(S, P_file)
                  Director(Direct Status, P)
                  Write(P_p2, 5)
                  S = "(".ItoS(P_p3,0).")"
                  print then pad(6, s)
                  S = Access(P_p4);  print then pad(9, s)
                  P_p1 = P_p5;  SVC(13, P)  {Unpack date}
                  Print string(P_text)
                  Newline
               %repeat
            %else
               Cols = 4
               Cols = N %if N < cols
               Rows = N//Cols
               Rows = Rows+1 %if Cols*Rows < N
               %for j = 1, 1, rows %cycle
                  k = j
                  %while k <= N %cycle
                     Sn == File(k)
                     k   = k + rows
                     print then pad(17, Sn)
                  %repeat
                  Newline
               %repeat
            %finish
         %finish
         N = 0
         %exit %if F_Nil # 0
         Last unit  = F_unit
         Last owner = F_owner
      %finish
      N = N + 1
      F_unit = "";  F_owner = ""
      To mixed(F_file);  To lower(F_ext)
      F_file = " ".F_file %while length(F_file) < 10
      File(N) = Filename(F)
      F = Next Filespec
   %repeat
%end


{*****************************************************************************
{
{        Wildcard processing module            A. Culloch   Sep-81
{
{*****************************************************************************


{Director formats}


%record %format file    (%integer name1, name2,
                         %short   Spine block, Day)
%record %format Dir fm  (%short   Files,
                         %byte    Access rights,  Check,
                         %short   Unused,
                         %byte    Spare, Access permissions,
                         %record(file) %array File(1:42))
%record %format user    (%integer Name, Password,
                         %short   Dir block, Spare)
%record %format userlist(%short   Users, Spare1,
                         %integer Spare2,
                         %record(user) %array user(1:42))


%external %record(Filespec) %function SPLIT(%string(31) s)
   %record(Filespec) F = 0
   To upper(s)
   %if s # "" %and char no(s, length(s)) = '#' %start
      F_Volatile = '#'
      length(s) = length(s) - 1
   %finish
   %if s -> ("_") %then s -> f_unit.("_").s
   %if s -> (":") %then s -> f_owner.(":").s
   %if s -> s.(".").f_ext %start; %finish
   F_file = s
   Squeeze(F_unit);  Squeeze(F_owner);  Squeeze(F_file);  Squeeze(F_ext)
   %result = F
%end

%external %string(31) %function FILENAME (%record(Filespec)%name F)
   %string(31) s = ""
   s = s.F_unit."_"     %if F_unit     # ""
   s = s.F_owner.":"    %if F_owner    # "" %or F_unit # ""
   s = s.F_file
   s = s.".".F_ext      %if F_ext      # ""
   s = s."#"            %if F_Volatile # 0
   %result = s
%end

%external %routine MASK(%record(Filespec)%name x, %record(Filespec) y)
   x_unit   =  y_unit   %if y_unit  # "*"
   x_owner  =  y_owner  %if y_owner # "*"
   x_file   =  y_file   %if y_file  # "*"
   x_ext    =  y_ext    %if y_ext   # "*"
%end

%external %record(dir fm) Dir
%system %integer wild monitor = 0
%own %integer dir pos, dir lim
%own %record(fd fm) %array sorted dir(1:42)
%own %record(user list) catalog
%own %integer cat pos, cat lim
%own %integer unit no, one off, required unit no
%own %record(Filespec) Spec
%own %string(31) Current dir

%system %routine sort(%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
         Sort(p,u, b);  b = l
      %else
         Sort(p,a, l);  a = u
      %finish
   %repeat
%end

%routine set dir(%integer unit, owner)
   %record(Filespec)   F
   %record(file) %name Slot
   %record(Fd fm)%name S
   %record(parm fm)    P
   %integer            j

   P_file_unit  = unit
   P_file_owner = owner
   P_file_N1    = 0
   P_file_N2    = 0
   Unpack(P_file, Current dir)
   Current Dir  = ":" %if Current Dir = ""
   F            = Split(Current Dir."*.*")
   Mask(Spec, F)
   P_dact       = Direct Files
   P_p6         = Addr(Dir)
   SVC (To Director, P)                  {Read directory block}
   %if P_p6 # 0 %start
      Dir pos = 42 %and %return %if one off = 0
      Event_message = P_text
      %signal 11
   %finish
   P_file_unit  = 0
   P_file_owner = 0

   dir pos = 0
   dir lim = 0
   %for j = 1, 1, 42 %cycle
      slot == dir_file(j)
      %if slot_name2 # 0 %start
         dir lim   = dir lim + 1
         S        == Sorted dir(dir lim)
         S_pos     = j
         P_file_N1 = slot_name1
         P_file_N2 = slot_name2
         Unpack(P_file, S_name)
      %finish
   %repeat

   Sort(sorted dir, 1, dir lim)
%end

%external %routine WILD SPEC (%string(31) parm)
   %record(filespec) fff
   %record(file fm) F
   %record(parm fm) P
   Required unit no = -1
   Spec    = Split(parm)
   Cat pos = 42
   Dir pos = 0
   Dir lim = 0
   Unit no = 0
   one off = 0
   %if spec_owner # "*" %start
      one off = 1
      Pack(Spec_unit."_".spec_owner.":", F)
      Set Dir(F_unit, F_owner)
      %if F_owner = 0 %start             {Defaulted - must find out who we are}
         P_dact = Direct Identify
         P_p1   = 0
         SVC (To Director, P)
         Unpack(P_file, Current dir)
      %finish
!!!      Mask(Spec, Split(Current dir))
      fff = split(current dir."*.*")
      mask(spec, fff)
   %else
      Spec_unit = "*" %if Spec_unit = ""
      %if Spec_unit # "*" %start
         Pack(Spec_unit."_:", P_file)
         P_Dact = Direct Find unit
         SVC (To Director, P)
         P_p1 = 0 %if P_p6 # 0
         Required unit no = P_p1
      %finish
   %finish
%end

%external %predicate MATCHES(%record(Filespec)%name F1, F2)
   %predicate match(%string(*)%name S1, S2)
      %true %if S1 = S2 %or S1 = "*" %or S2 = "*"
      %false
   %end
   %true %if match(F1_unit,   F2_unit)  %and
             match(F1_owner,  F2_owner) %and
             match(F1_file,   F2_file)  %and
             match(F1_ext,    F2_ext)
   %false
%end

%external %record(Filespec) %function NEXT FILESPEC
   %own %integer    Unit
   %record(Filespec)F
   %record(parm fm) P
   %integer         User
   %label           New dir
New dir:
   %cycle
      F_unit  = Spec_unit
      F_owner = Spec_owner
      F_Nil   = 1                        {In case of early return}
      Dir pos = Dir pos + 1
      %if dir pos > dir lim %start
         %result = F %if one off # 0
         %cycle
            cat pos = cat pos+1
            %if cat pos > 42 %start
               %cycle
                  unit no = unit no + 1
                  %result = F %if unit no > max unit %or
                                  unit no = required unit no + 1
                  P_p1    = unit no
                  P_p6    = Addr(Catalog)
                  P_Dact  = Direct Catalog
                  SVC (To Director, P)
               %repeat %until P_p6 = 0   {Valid unit number}
               P_p1    = unit no
               P_Dact  = Direct Unit name
               SVC (To Director, P)
               P_p1 = 0 %if P_p6 # 0
               unit    = P_p1
               cat pos = 0
               %continue
            %finish
            user = catalog_user(cat pos)_name
            %if user # 0 %start
               Set dir(unit, user)
               -> New dir
            %finish
         %repeat
      %finish
      F = Split(Current dir . Sorted dir(dir pos)_name)
      Console(Filename(F)) %if wild monitor # 0
      F_Nil = 0
      %result = F %if matches(F, Spec)
   %repeat
%end

%external %routine FOR EACH(%record(Command fm)%name C,
                            %routine Do Something(%record(Command fm)%name CC))
   %integer            J, k = 0, wild
   %string(31)%name    Sn
   %string(31)         S
   %record(Command fm) CC
   %record(Filespec)   W, base, overlay

   %for j = 1, 1, 3 %cycle
      Sn == C_in(j)
      k   = k + 1 %and wild = j %if Sn -> ("*")
   %repeat
   Wild Spec(C_in(wild)) %if k # 0

   %cycle
      CC = C
      %if k # 0 %start
         W = Next filespec
         %exit %if W_file = ""
         CC_in(wild) = Filename(W)
         W_unit = "";  W_owner = ""
         S = Filename(W)
      %finish
      %for j = 1, 1, 3 %cycle
         S  =  CC_in(j) %if k = 0
         Sn == CC_out(j)
         %if Sn # "" %start
            overlay = Split(Sn)
            base    = Split(S)
            Mask(base, overlay)
            Sn = Filename(base)
         %finish
      %repeat
      Do Something(CC)
   %repeat %until k = 0
%end


%end %of %file
