!  File  NMOUSE:NAMER

! Namer

%option "-nons-nodiag-low"
%include "mouse.inc"

! This module manages process-local tables for both logical names
! and command symbols.  There is also a global mode, in which 
! requests are passed to another process for handling there.

! This scheme replaces the old "dictionary" package.

! The tables themselves are linear linked lists hung off
! a hash table.  Each entry is a pair of heap strings.
! Although nothing is sorted, procedures are available
! for scanning the whole table "in order", so that every
! entry is visited.  To guarantee the proper operation of
! this scanning scheme, no entries should be added or
! removed during the scan.

%systemintegerfnspec stringdiff(%string(255)s,t)

%constinteger hashmax=31  {2^n-1}
%recordformat entry fm(%record(entry fm)%name next,
                       %string(*)%name key,info)
%recordformat table fm(%record(entry fm)%namearray list(0:hashmax))

%integerfn hash(%string(*)%name s)
%bytename b==length(s)
%integer i=b,n=0
  %cycle
    %exitif i=0
    n = (n>>4&1+n<<1) {5 bit field rotated left 1} !! b[i]
    i = i-1
  %repeat
  %result = n&hashmax
%end

%record(entry fm)%map find(%string(*)%name key,%record(entry fm)%name e)
! Locate the cell containing KEY in the list E, NIL if not there.
  %cycle
    %exitif e==nil %or stringdiff(e_key,key)=0
    e == e_next
  %repeat
  %result == e
%end

%routine define(%string(255)%name key,info,%record(table fm)%name table)
! Add an entry for (KEY,INFO) into TABLE.
! Or, if INFO="", delete entry for (KEY,*) from TABLE.
%integer h
%record(entry fm)%name l,e
  h = hash(key)
  l == table_list(h)
  e == find(key,l)
  %if e==nil %start   {Not there - add a new cell}
    %returnif info="" {unless request was to delete}
    e == new(e); e_next == l
    e_key == newstring(key); e_info == newstring(info)
    table_list(h) == e
  %elseif info=""     {it's there and we want to get rid of it}
    dispose(e_info); dispose(e_key)
    %if e==l %then table_list(h) == e_next %elsestart
      l == l_next %while l_next##e
      l_next == e_next
      dispose(e)
    %finish
  %elseunless e_info=info  {it's there and we want to change it}
    dispose(e_info); e_info == newstring(info)
  %finish
%end

%predicate translated(%string(255)%name key,info,%record(table fm)%name table)
! If (KEY,*) is in TABLE, copy * into INFO and return TRUE.
! Otherwise leave INFO unchanged and return FALSE.
%integer h
%record(entry fm)%name e
  h = hash(key)
  e == find(key,table_list(h))
  info = e_info %andtrueunless e==nil
  %false
%end

%routine next(%string(*)%name key,info,%record(table fm)%name table)
! If (KEY,*) is in TABLE, return in (KEY,INFO) whatever is in the
! next entry in the table.  Otherwise, or if there are no more entries,
! return ("","").  If KEY="" to start with, return the first entry.
%integer h
%record(entry fm)%name e
  %if key="" %start
    h = 0; e == nil
  %else
    h = hash(key); e == find(key,table_list(h))
  %finish
  e == e_next %unless e==nil       {next entry on same list, if any}
  %unless e==nil %start            {yes, there it is}
    key = e_key; info = e_info
    %return
  %finish
  %while h<hashmax %cycle
    h = h+1; e == table_list(h)    {onto next list}
    %unless e==nil %start          {first element}
      key = e_key; info = e_info
      %return
    %finish
  %repeat
  key = ""; info = ""              {no more}
%end

%ownrecord(table fm)%name -
  logical name table == nil,
  command symbol table == nil

! User interface starts here
! NB Case standardisation is the responsibiliy of the caller

%externalroutine define local logical name(%string(255)key,info)
%record(table fm)%name l == logical name table
  %if l==nil %start
    l == new(l)
    l = 0
    logical name table == l
  %finish
  define(key,info,l)
%end

%externalroutine define local command symbol(%string(255)key,info)
%record(table fm)%name c == command symbol table
  %if c==nil %start
    c == new(c); c = 0; command symbol table == c
  %finish
  define(key,info,c)
%end

%externalpredicate translated local logical name(%string(*)%name s)
  %falseif logical name table==nil
  %trueif translated(s,s,logical name table)
  %false
%end

%externalpredicate translated local command symbol(%string(*)%name s)
  %falseif command symbol table==nil
  %trueif translated(s,s,command symbol table)
  %false
%end

%externalroutine next local logical name(%string(*)%name key,info)
  %if logical name table==nil %start
    key = ""; info = ""
  %else
    next(key,info,logical name table)
  %finish
%end

%externalroutine next local command symbol(%string(*)%name key,info)
  %if command symbol table==nil %start
    key = ""; info = ""
  %else
    next(key,info,command symbol table)
  %finish
%end

%conststring mailbox name = "Name manager"
%ownrecord(mailbox fm)%name -
  name manager requests == nil,
  name manager replies
%recordformat f(%integer op,%string(255)key,info)

%routine call name manager(%integername op,%string(*)%name key,info)
! Passes a request to the name manager process and waits for reply
%record(message fm)%name me
%record(f)%name r
  me == acquire message buffer
  r == record(addr(me_data))
  r_op = op; r_key = key; r_info = info
  %if name manager requests==nil %start
    name manager requests == lookup mailbox(mailbox name)
    name manager replies == create mailbox("",create semaphore("",0))
  %finish
  me_reply == name manager replies
  send message(me,name manager requests)
  me == receive message(name manager replies)
  r == record(addr(me_data))
  key = r_key; info = r_info; op = r_op
  return message buffer(me)
%end

%externalroutine define global logical name(%string(255)key,info)
%integer n=1
  call name manager(n,key,info)
%end

%externalroutine define global command symbol(%string(255)key,info)
%integer n=2
  call name manager(n,key,info)
%end

%externalpredicate translated global logical name(%string(*)%name s)
%integer n=3
  call name manager(n,s,s)
  %trueunless n=0; %false
%end

%externalpredicate translated global command symbol(%string(*)%name s)
%integer n=4
  call name manager(n,s,s)
  %trueunless n=0; %false
%end

%externalroutine next global logical name(%string(*)%name key,info)
%integer n=5
  call name manager(n,key,info)
%end

%externalroutine next global command symbol(%string(*)%name key,info)
%integer n=6
  call name manager(n,key,info)
%end

%externalpredicate translated logical name(%string(*)%name s)
  %trueif translated local logical name(s)
  %trueif translated global logical name(s)
  %false
%end

%externalpredicate translated command symbol(%string(*)%name s)
  %trueif translated local command symbol(s)
  %trueif translated global command symbol(s)
  %false
%end

%externalstring(255)%fn translate logical name(%string(255)key)
  %result = key %if translated logical name(key)
  %result = key
%end

%externalstring(255)%fn translate command symbol(%string(255)key)
  %result = key %if translated command symbol(key)
  %result = key
%end

%externalinteger default   name mode = 'G'
%externalinteger default symbol mode = 'L'

%externalroutine define logical name(%string(255)k,e)
  %if default name mode & 95 = 'L' -
  %then define local logical name(k,e) -
  %else define global logical name(k,e)
%end

%externalroutine define command symbol(%string(255)k,e)
  %if default symbol mode & 95 = 'L' -
  %then define local command symbol(k,e) -
  %else define global command symbol(k,e)
%end

%externalroutine STANDARDISE FILENAME (%string(*)%name name)

! Rules:
! Names begining with the separator ':' are deemed already standardised.
! Names which have a leading (or sole) component which is a logical
! name are subject to substitution of that logical name up to a maximum
! iteration limit.
! Once logical name translation fails, a default prefix is applied.
! That prefix is the current directory in the case of one-component
! names, or the current filestore in the case of multi-component names.
! If the name (whether single or multi component) begins with '^', we
! apply a shortened prefix, consisting of the current directory with
! one trailing component removed for every '^' removeable from the
! front of the name.

%string(255)prefix,fore,aft
%integer lives=9
%bytename p==length(prefix),f==length(fore),n==length(name)

  %predicate splits(%string(*)%name source,fore,aft)
! True if SOURCE -> FORE.(":").AFT
! But then if AFT begins with a colon, transfer it to the end of FORE.
! This temporary feature allows us to cope with the old "::" notation,
! which requires additional logical names to be defined.  Example:
! Normally a file on filestore B might be referred to as B:L:X.MOB,
! with logical name B defined as :F:015; to accept B::L:X.MOB we also
! require B: to be defined as :F:015.
  %bytename f == length(fore), a == length(aft)
    %falseunless source -> fore.(":").aft
    %if a#0 %and a[1]=':' %start
      f = f+1; f[f] = ':'; aft = substring(aft,2,a)
    %finish
    %true
  %end

  %predicate starts(%integer k)
! True iff NAME starts with character K.
    %falseif n=0; %trueif n[1]=k; %false
  %end

  %routine shorten prefix
! Strip a trailing component off string PREFIX.
! If (vax) it ends in *.x] turn it into *]
! If (vax) it ends in *[x] (no dot in the []), turn it into *[x.-]
! If it ends in *x:y: or *x:y turn it into *x:
  %integer vax
    %if p[p]=']' %start
      vax = p
      %cycle
        vax = vax-1
        %if p[vax]='[' %start
          p[p] ='.'; p[p+1] = '-'; p[p+2] = ']'; vax = p+2
          %exit
        %finish
        %if p[vax]='.' %start
          p[vax] = ']'
          %exit
        %finish
      %repeatuntil vax=0 %or p[vax]=':'
      p = vax
    %else
      p = 1 %if p=0
      p = p-1 %until p=0 %or p[p]=':'
    %finish
  %end

  %routine apply prefix
    %returnif p=0
    %if ':'#p[p]#']' %start
      p = p+1; p[p] = ':'
    %finish
    name = prefix.name
  %end

  %signal 3,3,,"Null file name" %if n=0  {"" no longer allowed}
  %if starts(':') %start
    name = ":T" %if n=1                  {":" defaults to ":T"}
    %return
  %finish
  %while lives>0 %andnot starts(':') %cycle
    lives = lives-1
    prefix = ""
    %if starts('^') %start                      {up a level}
      prefix = translate logical name(".")
      %cycle
        name = substring(name,2,n)
        shorten prefix
      %repeatuntilnot starts('^')
    %elseif splits(name,fore,aft)
      %if translated logical name(fore) %start  {log:*}
        name = aft; prefix = fore
      %else                                     {dir:*}
        prefix = translate logical name("Current_Filestore")
      %finish
    %elseunless translated logical name(name)
      prefix = translate logical name(".")
    %finish
    apply prefix
  %repeat
  %unless n>1 %and n[1]=':' %start
    name = "Standardise file name fails: ".name
    %signal 3,3,,name
  %finish
%end

! Name manager process starts here

%begin
{{%integer i,p
%record(mailbox fm)%name b
%record(message fm)%name m
%record(f)%name r
%switch s(1:6)

  b == create mailbox(mailbox name,create semaphore("",0))
  become process(15000)
  default   name mode = 'L'
  default symbol mode = 'L'

  %cycle
    m == receive message(b)
    r == record(addr(m_data))
    ->s(r_op) %if 1<=r_op<=6
    r_op = -1; ->end
s(1): define local logical name(r_key,r_info);   ->end
s(2): define local command symbol(r_key,r_info); ->end
s(3): r_info = r_key
      r_op = 0 %unless translated local logical name(r_info)
      ->end
s(4): r_info = r_key
      r_op = 0 %unless translatedlocal command symbol(r_info)
      ->end
s(5): next local logical name(r_key,r_info); ->end
s(6): next local command symbol(r_key,r_info)
end:
    send message(m,m_reply)
  %repeat
%end