!TITLE Technical manual
!*******************************************************************************
!*                                                                             *
!*  chat - an EMAS utility to allow users to chat to each other using the 2900.*
!*                                                                             *
!*              Copyright (c) 1982 by James Darby at UKC.                      *
!*              Assembler routines by R.D.Eager   at UKC.                      *
!*                                                                             *
!*                          Version 2.35                                       *
!*                                                                             *
!*                                                                             *
!*******************************************************************************

!< Introduction

!This  is  the source code of the EMAS chat utility. It allows users to hold an
!interactive conference on several terminals on an EMAS 2900  system. Its  main
!features are :-

!      1) Low OCP overhead.
!            The utility uses any a small amount of OCP time.
!            This is obtained by use of the d delay call in Director when the
!            program is waiting for input.

!      2) max chatters (see below) people max in one chat.
!            Up to max chatters (see below) people can be chatting away at once.

!      3) Ease of use.
!            Chatters may be as passive or active as they please.

!      4) Fun for all the family.
!            Great for annoying operators and operations supervisors.

!      5) "Available in easy to swallow capsules" .........

!>

!     We  are  using the external routine nc for this version of chat in order
!     that there is no confusion with the release version.

%external %routine nc(%string(255) who)

!< Constants used

!     Max message descriptors is the number of message descriptors in the chat
!     file. After this is reached most of the routines cycle round to the first.

!     Max chatters is the maximun number of chatters allowed at once.

!     Max commands is the number of the commands the program has.

!     Chat file size is the size of the chatting file created.

!     Decline is a pseudo type used for the tell user routines.
!     Invite is the same as decline, but performs a different function

!     Number of system processes is what it says it is.

%constant %integer max message descriptors = 50,
                   max chatters            = 10,
                   max commands            = 8,
                   chat file size          = 8192,
                   decline                 = 1,
                   invite                  = 2,
                   number of system processes = 4

!     This %constant %long %integer is the mask for the normal interrupts.
!     i.e. A, C, Q, W, X, Y and a, c, q, w, x, y.
!     Note that this includes the operator ST log off command, this is perhaps
!     a bit naughty to trap, but we must if we are to stop the program from
!     crashing if someone is forced off the system. It does not stop the XST
!     however (nothing can).

%constant %long %integer interrupt mask = X'0382000A0382000A'


!     These constants are used to help psuedo boolean variable values

%constant %integer           true = 1,
                             false= 0

!     This constant string holds the list of commands.
!     Note that they are in lower case, but we convert upper into them.

%constant %string(max commands)  command string ="cdiruvw?"

!     This %constant %string %array holds the error messages from cheak name.

%constant %string(25) %array fail reason (1:4) = %c
      "Talking to yourself ?????",
      "Invalid user name.",
      "User not known.",
      "User not logged in."

!>

!*******************************************************************************
!*
!*      Record formats used by the program.
!*
!*******************************************************************************

!< Record formats used.
!< Connect report format
!     This is the format of the %record returned by connect to indicate various
!     information about how the file was connected (assuming it was).

%record %format connect report format(%integer conad, file type,
                                       data start, data end)

!>
!< Descriptor format
!     This  is  the  format of a single entry in the message area.  The integer
!     contains the number of the chatter who transmited the  message, and  the
!     string the message itself.

%record %format descriptor format    (%integer from,
                                      %string(123) text)

!>
!< Head format
!     This is the format of the heading record in the message area. The first
!     four integers are numbers that must be common to all the chatters and are
!     locked by the fourth which is the semaphore.

%record %format  head format    (%integer current top, users,
                                  close, semaphore,
                                  %string(31) %array names (0:max chatters),
                                  %string(6) %array real names (0:max chatters))

!>
!< Message area format
!     This is the format of the entire message area. It consists of the header
!     record followed by the array of message descriptors.

%record %format message area format  (%record (head format) head,
                                      %record (descriptor format) %array %c
                                       descriptor(1:max message descriptors) )

!>
!< it f
!     This highly YUCH format is that used by the communications software to
!     control the console of the user.

%record %format it f (%integer in base, in length, in pointer, out base,
                              out length, out pointer, out busy, om waiting,
                              intt waiting, jn base, jn cur, last free,
                              spare 5, spare 6, spare 7)

!>
!< io stat f
!     Again this is a format concerned with the i/o system. This is simpler in
!     that it just contains the current position of read data in T#IT and any
!     multi-character interrupts that have occured.

%record %format io stat f (%integer in pos, %string(15) int mess)

!>
!< procs format

!     This is the format of the information returned by the system call d procs.
!     It has tonnes on gumf on whats happening to a process.

%record %format procs format ( %string(6) user,
                               %byte      incarnation, catagory, snzt, run q,
                               %integer actw0, lstad, lamtx, stack, status)

!>
!< comf
!     This is the format of the common data area in EMAS. This table is stored
!     at location X'80C00000' (ie in the public segment).

%record %format comf  (%integer ocptype, ipldev, sblks, sepgs, ndiscs,
         dlvnaddr, gpctabsize, gpca, sfctabsize, sfca, sfck, dirsite,
         dcodeda, suplvn, tojday, date0, date1, date2,
         time0, time1, time2, epagesize, users, cattad, servaad,
         %byteinteger nsacs, resv1, sacport1, sacport0,
         nocps, resv2, ocpport1, ocpport0,
         %integer itint, contypea, gpcconfa, fpcconfa, sfcconfa,
         blkaddr, ration, smacs, trans, %longinteger kmon,
         %integer ditaddr, smacpos, supvsn, pstva, secsfrmn, secstocd,
         sync1dest, sync2dest, asyncdest, maxprocs, inspersec, elaphead,
         commsreca, storeaad, procaad, sfcctad, drumtad, tslice, feps,
         maxcbt, performad, sp1, sp2, sp3, sp4, sp5, sp6,
         lstl, lstb, pstl, pstb, hkeys, hoot, sim, clkx, clky, clkz,
         hbit, slaveoff, inhssr, sdr1, sdr2, sdr3,
         sdr4, sesr, hoffbit, blockzbit, blkshift, blksize, end)

!>
!>
!*******************************************************************************
!*
!*      References in Subsystem and Director.
!*
!*******************************************************************************

!< References in Subsystem
!< Connect
!     This is the Subsystem call to connect a file.

%system %routine %spec connect (%string(31) file, %integer mode, hole, protection,
                                %record (connect report format) %name report,
                                %integer %name flag)

!>
!< set ss inhibit
!     This subsystem call disables interrupts for a short while.....

%system %routine %spec set ss inhibit

!>
!< allow interrupts
!     This system call allows interrupts again

%system %routine %spec allow interrupts

!>
!< out file
!     This Subsystem call sets up a file for output. If the file exists then that
!     is used, else as in this program it is created.

%system %routine %spec out file (%string(31) file name,
                                 %integer size, hole, protection,
                                 %integer %name conaddr, flag)

!>
!< destroy
!     This is the %system version of destroy. It is used by the chat leader to
!     destroy the file SS#CHAT at the end of a chatting session.

%system %routine %spec destroy(%string(31) file, %integer %name flag)

!>
!< reroute contingency
!     This is the reroute contingency specification. Look in the Subsystem
!     documentation to find out compleate details. In short it allows us to
!     trap interrupts and to act on them.

%system %routine %spec reroute contingency (%integer ep, class,
                                            %long %integer mask,
                                            %routine on trap,
                                            %integer %name flag)

!>
!< signal
!     This is the signal routine in the Subsystem. See Subsystem documentation
!     for further details. In short it allows us to signal an event to the error
!     handler in the Subsystem.

%system %routine %spec signal             (%integer ep, p1, p2,
                                           %integer %name flag)


!>
!< console
!     This is a highly PUTRON routine that performs about 10000000000 different
!     functions. We use it to find the address of it and io stat.

%system %routine %spec console(%integer ep, %integer %name start, length)

!>
!< disconnect
!     This call is used to disconnect a connected file. We use it to disconnect
!     the leader SS#CHAT file when non-leaders leave the chat.

%system %routine %spec disconnect (%string(255) file, %integer %name flag)

!>
!< permit
!     This call is used by the chat leader to permit the SS#CHAT file to everyone
!     so that they can chat into it.

%system %routine %spec permit (%string(31) file, %string(6) user,
                               %integer mode, %integer %name flag)

!>
!< uc translate
!     This call simply translates from lower to upper case all the bytes from
!     address for length bytes.

%system %routine %spec uc translate (%integer address, length)

!>
!< failure message
!     This string function allows us to pick up the appropriate failure message
!     from the subsystem.

%system %string(255) %function %spec failure message(%integer failure code)

!>
!< terminate
!     This call flushes the output buffer to the console.

%external %routine %spec terminate

!>
!< Prompt
!     This just sets up the prompt for the user.

%external %routine %spec prompt(%string(255) p)

!>
!< set return code
!     This sets the return code in the subsystem for the chat program.

%external %routine %spec set return code (%integer code)

!>
!< d delay
!     Good ol' d delay !!!    This delays its arguments number of seconds before
!     returning. N.B. No OCP time is used.

%external %integer %function %spec ddelay(%integer n)

!>
!< uinfi
!     This is the general purpose information function.

%external %integer %function %spec uinfi(%integer n)

!>
!< call
!     This revolting routine is supposed to allow user program to call other
!     subsystem commands. It is so fragile that I have had to de-impliment the
!     subsystem escape!!!

%external %integer %function %spec d fsys(%string(6) user, %integer %name fsys)

!>
!< d fsys
!     This rather natty director call allows us to find out what disc pack a user
!     is on. Speeds up d message and connect a lot!!!

!%external %routine %spec call (%string(31) command, %string(255) param)

!>
!< d message
!     This  is the routine called by TELL. It sends the bytes from address of length
!     bytes to user on fsys. The action is the sort of action wanted.

%external %integer %function %spec d message(%string(255) user,
                                             %integer %name length,
                                             %integer action, fsys, address)

!>
!< unifi
!     This is the string general info function.

%external %string(255) %function %spec uinfs(%integer n)

!>
!< d procs

!     This supervisor call allows us to access the names of all processes on the
!     system. It also gives lotsa uvver gunk.

%external %integer %function %spec d procs (%integer %name max processes,
                                      %integer address)
!>
!>
!********************************************************************************
!*
!*      Now we have the definition of all the variables and constants.
!*
!********************************************************************************

!< Global variables used.
!     The global variables used are:-

!     %integers:

!        flag           : General purpose flag, often return by system calls.
!        conaddr        : Connecting address of files.
!        last look      : Last message looked at.
!        our semaphore  : Have we got the semaphore ?
!        my top         : Top message looked at.
!        me             : My number on the chat.
!        fsys           : File system of someone (usually chat leader).
!        input since -
!        last print     : Any input since we last did some output?

!     %strings:

!        my message(255)   : The line the user last typed.
!        last from(31)     :  Name of person from whom last mesage came.

!PAGE
!     %records:

!        message area   : Used to hold messages. Defined as %name and mapped.
!        io stat        : I/O status in communications package. Very complex.
!        it             : Interactive terminal. Used to hold pointers for user.
!        connect report : Return by connect to give connecting information.

!>
%own %integer flag, conaddr, lastlook, my top, me, fsys, our semaphore,
              input since last print
%string(255) my message
%string(31) last from
%record (message area format) %name message area
%record (iostatf) %name io stat
%record (itf)     %name it
%record (connect report format) connect report

!     This string array holds the various error messages for the chat program.
!     These are purely internal ones and have nothing to do with the Subsystem.


!*******************************************************************************
!*
!*      Now here comes all the plebian service routines.
!*
!*******************************************************************************

!< Plebian service routines

!  These routines are just simple routines  called  by  the  main  body  of  the
!     program.

!< in string

%routine in string(%string(255) %name input)

!     In this routine we read in a string into the %name passed as parameter.

!     Local variables.

!     %integer:

!        ch    :  used to hold the ascii value of the character just read.

%integer ch

!PAGE
!     This %on %event block picks up any end-of-input and forces the routine to
!     exit with "*" as the result. (This is the string used to indicate the end
!     of chat.) Note however that if we are the chat leader then we force the
!     ~c command. This closes down the chat.

      %on %event 9 %start
         %if me = 1 %then input = "~c" %else input ="*"
         %return
      %finish

!PAGE
!     First clear the input line to an empty one.

      input = ""

!     Now loop round inputting characters and adding them to the end of the line
!     being input. The loop is ended when the new line is found. Note that the
!     new line is NOT added onto the end of the string.

      %cycle
         read symbol(ch)
         input = input.to string(ch) %unless ch = nl
      %repeat %until ch = nl

!     And thats all there is ..........

%end


!>
!< print line
%routine print line (%string(255) line)

!     This routine is really very simple, all it does it to print out the string
!     followed by a new line.

      print string(line)
      new line
%end


!>
!< get name
%string(32) %function get name

!     This  routine gets the name of the user. It first calls uinfs(7) which is
!     the systems idea of what the users name  is. If  this  returns  with  the
!     blanket  name "Course" then the job number is used instead. This is found
!     by calling uinfs(1). This is very boring  so  the  ~r  command  has  been
!     included.

!     Local variables:-

!     %string(32)

!        system name  : Holds the name as its thought out.

%string(32) system name

      system name = uinfs(7)
      %if system name = "Course" %then system name = uinfs(1)
      %result = system name

%end


!>
!< fail
%routine fail(%integer fail no)


!     This routine is called when there is some failure in the chat program.
!     It prints out the apppropiate error message and the halts the program.
!     Note:  This is liable to be a very serious fault, but hasn't happened yet.

!     The code at this point attempts to tidy up as best as possible.
!     This is not allways going to work, but one can but try.

!     Local variables:-

!     %integer

!        users address  : Is used to hold the address of the users field in the
!                         message area.

%integer users address
!>
      new line
      print line (" chat fails - ".failure message(fail no))
      print line ("Please inform system management. Via SUGGESTION.")
      set return code(fail no)

!     Now we deal with the chat file. First check to see if we are the chat
!     leader.

      %if me = 1 %then %start

!        Ok. So we are. Set close flag before exiting.
!        This will get any remaining people off.

         message area_head_close = true

      %finish %else %start

!        If we are not the leader then all we need to do is to leave, decrementing
!        the number of users.

         users address = addr(message area_head_users)
         *LXN _USERS ADDRESS
         *TDEC_(%XNB+0)

!        Then remove our name from the list.

         length(message area_head_names(me)) = 0

!        Finally we disconnect the chat file.

         disconnect (who.".SS#CHAT", flag)

      %finish

      %stop
%end


!>
!*******************************************************************************
!*
!*    These are the indivisable routines used by the program.
!*
!*******************************************************************************

!     Here are the lock/unlock routines.
!     Try to understand them at your own risk.

!     We do not use the full versions of wait and signal (Dijkstra) because EMAS
!     does not support them at user level. Instead we use good 'ole fashion lock
!     unlock primatives. We perform a busy wait until we claim the semaphore.
!     Unfortunatly we cannot use the d pon, d poff mechanism because of the fact
!     that they can only be accessed by privalaged users. This is a pain, but
!     no real disaster.

!     First we have the semaphore failure routine. Note that if the semaphore
!     fails then it is highly lightly to domino.

%routine semaphore fail

!     All we do is print out some error warning, plus a request to inform the
!     system management.

      print line ("**Semaphore time out.")
      print line ("Please inform system management. Via SUGGESTION.")

!     Also we set the close flag and disconnect the file. We close the chat
!     anyway in the hope that we can stop the domino effect.

      message area_head_close = true
      disconnect(who.".SS#CHAT", flag)

!     Finally leave

      %stop
%end


%routine lock(%integer semaphore address)

!     This is the data lock routine. We use the 2900 instruction TDEC and INCT
!     to manipulate the semaphore. We perform a busy wait for 1000 cycles, then
!     we d delay for 1 sec. This is repeated 5 times (ie 5 seconds), if after
!     this time we still do not have the semaphore, then we cause a time-out.
!     This is likely to be a VERY VERY serious error, but it has never happened
!     at UKC. We use the variable "our semaphore" to indicate if we currently have
!     the semaphore under our control. This is needed for the interrupt handler
!     so that it can relinquish the semaphore if an interrupt exit occurs.

!     Local variables:

!     %integer:

!        counter 1  :  Used for countdown from 1000 in waiting.
!        counter 2  :  Used for countdown from 5 in d delaying.

%integer counter 1, counter 2

!     This locks the critical data. the parameter is the addesss of the semaphore.
!     First inhibit interrupts

      set ss inhibit

!     set up the counters. We perform a d delay(1) every 1000 times for 5 times.
!     If the semaphore is not claimed by then then we time out. This could cause
!     big trouble. But if the semaphore is duff we are in trouble anyway.

      counter 1 = 1000
      counter 2 = 5

!     Now try and claim

TRY AGAIN:
      *LXN _(%LNB+5)
      *INCT_(%XNB+0)
      *JCC _8, <GOT IT>
      *JCC _4, <NOT GOT>
      *J   _<ERROR>
NOT GOT:
      *TDEC_(%XNB+0)

!     Decrement counter 1 for use in inner 1000 loop.

      counter 1 = counter 1 - 1

!     Now if we have reached zero then we d delay if counter 2 non-zero else the
!     semaphore must have timed out. In which case we are in the fertiliser.

      %if counter 1 = 0 %then %start
         %if counter 2 = 0 %then semaphore fail
         counter 1 = 1000
         counter 2 = counter 2 - 1
         flag = d delay(1)
      %finish

!     And try again

      *J   _<TRY AGAIN>

GOT IT:

!     We now have the semaphore. Set flag to show so, allow interrupts, then exit.

      our semaphore = true
      allow interrupts
      %return

ERROR:

!     If we arrive here then we are in V serious trouble with the semaphore.
!                                     *** PUN geddit?

      print line("**Semaphore error.")
      print line("Please inform system management. Via SUGGESTION.")
      set return code (1000)
      allow interrupts
      %stop

%end


%routine un lock(%integer semaphore address)

!     This unlocks the critical data.
!     But first we inhibit the interrupts.

      set ss inhibit

      *LXN _(%LNB+5)
      *TDEC_(%XNB+0)

!     Mark flag as showing we do not have control of semaphore

      our semaphore = false

!     Finally allow interrupts and exit.

      allow interrupts

%end


%routine on trap relinquish semaphore(%integer semaphore address)

!     This unlocks the critical data for the on trap routine.
!     Because of this there is not interrupt inhibit.
!     We use a simple TDEC instruction to decrement the semaphore.

      *LXN _(%LNB+5)
      *TDEC_(%XNB+0)

%end


%routine send message (%string(255) %name message)

!     This routine enters the message passed as %name into the message area.
!     The current highest is held in message area_head_current top.
!     Note it cycles round when max message descriptors is exceeded.

%integer next one

!     Lock critical data area.

      lock (addr(message area_head_semaphore))

!     Also inhibit the interrupt system.

      set ss inhibit

!     Now work out the new value of current top, and keep a copy in next one.

      next one = message area_head_current top + 1
      %if next one > max message descriptors %then next one = 1  ;! Cycle round
      message area_head_current top = next one

!     Now enter message.

      message area_descriptor(next one)_from = me
      message area_descriptor(next one)_text = message

!     Now we can allow interrupts

      allow interrupts

!     Unlock critical data.

      unlock (addr(message area_head_semaphore))

%end


%routine decrement users

!     This routine decrements the number of users the program thinks it has.
!     It also set up the null name in the name area so that any old messages
!     will not be printed..

!     Lock critical data area.

      lock (addr(message area_head_semaphore))

!     Inhibit interrupts for a while.

      set ss inhibit

      message area_head_users = message area_head_users - 1
      message area_head_names(me) = ""

!     Now we can allow interrupts again.

      allow interrupts

!     Now unlock the critical data.

      un lock (addr(message area_head_semaphore))

%end


%routine on trap decrement users

!     Here we must decrement the number of users.
!     This routine is only called from the "on trap" routine. Hence the lack of
!     semaphores and interrupt inhibits. These are not needed as we are using a
!     TDEC instruction anyway. The name is Zapped by putting a zero in the
!     length byte. This should be fast enough. I could code it in assembler, but
!     I can't be bothered. Also I don't think I need to.

%integer users address

!     Find out address of users value in shared data area.

      users address = addr(message area_head_users)

!     and decrement it using TDEC.

      *LXN _users address
      *TDEC_(%XNB+0)

!     Now we set our name to null by setting the length to zero.

      length(message area_head_names(me)) = 0

%end


%integer %function attempt join

!     In this routine we attempt to join a chat, we do this by first locking
!     the data area to stop anyone else from interfering with us. Then we check
!     on the number of chatters in the chat. If this is the maximun, then we
!     cannot join. We then return with false. If however we can join then we put
!     our name into the header and return true.
%integer answer

!     This function attempts to join us into a chat.

!     First lock the critical data.

      lock(addr(message area_head_semaphore))

!     Also inhibit any interrupts.

      set ss inhibit

!     Now test for number of users
      %if message area_head_users = max chatters %then %start

!        Oh dear too many people in chat.

         answer = false

!     On the other hand we may be in Ok. (This is far more likely).

      %finish %else %start

!        Ok. Increment number of users

         message area_head_users = message area_head_users + 1

!        and find a unique identifier for me. This must end as there cannot be
!        to many entries in the table.

         me = 1
         %cycle
            %if message area_head_names(me) = "" %then %exit
            me = me + 1
         %repeat

!        Fill in entry so no one else can get it.

         message area_head_names(me)      = get name
         message area_head_real names(me) = uinfs(1)

!        Now return with Ok value.

         answer = true

      %finish

!     Now return with the answer (not 42 unfortunatly).

!     First re-allow interrupts.

      allow interrupts

!     Then unlock the data and return.

      un lock (addr(message area_head_semaphore))
      %result = answer

%end


!*******************************************************************************
!*
!*    General service routines.
!*
!*******************************************************************************

!< General service routines
!< send to user
%routine send to user (%string(255) %name chatter,
                          %integer what message)

!     This routine sends an invitation to another user to join into the chat.
!     It call a straight forward version of d message.
!     Note: It requires fsys to have been found and the name validated.
!           Both of these can be done by calling check name before.

!           If fsys and name are not Ok then the d message call is likely to
!           complain in very strong terms. In this case we print out the system
!           error mesage (using failure message).

!     Local variables:

!     %integer:

!        len        :  Used to hold the length of the message.
!        mesg addr  :  Used to hold the address of the message.

!     %string(80):

!        intro      :  Holds the message.

!>
%string(80) intro
%integer len, mesg addr

         %if what message = invite %then %c
            intro = "Hello. How about a chat? Please reply to ".message area_head_real names(1)
         %if what message = decline %then %c
            intro = "Sorry. I am chatting already. The leader is ".message area_head_real names(1)
         len =length(intro)
         mesg addr = addr(intro) + 1
         flag = d message(chatter, len, 1, fsys, mesg addr)
         %if flag # 0 %then %start
            print string ("Cannot send message to ".chatter." - ")
            print line   (failure message(flag+500))
         %finish %else %c
            print line (chatter . " has been told.")
%end


!< test for logged on

!     This  function tests for a user being logged on forground on the system.
!     It does this by calling the highly obnoxious director call d  procs. One
!     of the many "features" of this routine is that it insists on providing a
!     result for process 0. This can NEVER exist!!!!
!>

%integer %function test for logged on(%string(6) who, %integer max process number)


!     Local varibles

!     %integer

!        pointer  :  points to the current process being examined.


%record (procs format) %array processes(0:max process number-1)
%integer pointer

      flag = d procs (max process number, addr(processes(0)))

!     Now fail if director returned an error message

      fail(flag+500) %unless flag = 0

!     Look through list for the name of the person we want to talk to.

      %for pointer = number ofsystem processes + 1, 1, max process number - 1  %cycle
         %if processes(pointer)_user = who %and %c
             processes(pointer)_status & 4 =0 %then %exit
      %repeat

!     Check to see if the person is the last in the list (we assume a failure

      %if pointer = max process number -1 %and %c
          processes(pointer)_user = who %then %c
          pointer = -1

!     Now we can %return the result and exit

      %if pointer = max process number -1 %then %result = false %else %result = true

%end

!< check name
%integer %function check name (%string(255) %name name)

!     This routine checks a users name and fills in fsys.
!     It will give a non-zero %result if there is an error.
!     These %results are :-

!        1) Attempt to talk to self.
!        2) Invalid user name.
!        3) User not known.
!        4) User not logged in.

!     Local variables.

!     %integer:

!        max processes  :  Holds systems max number of processes.

!PAGE
!     %string(255)

!        first part   :  Tempary string storage.
!        second part  :     "       "      "

!     %record(comf)

!        com  :  Common data area in EMAS.


!>
%string(255) first part, second part
%integer max processes
%record(comf) %name com

!     First remove spaces

      name = first part.second part %while name -> first part.(" ").second part

!     Now check to see if user name is not 6 chars long.
!     This is needed before calling d message

      %if  length(name) # 6 %then %result = 2

!     Now translate to upper case

      uc translate ( addr(name)+1, length(name))

!     Next check to see if user is trying to chat to himself.

      %if name=uinfs(1) %then %result = 1

!     Now we check to see if the user is valid and which fsys he is on.
!     The call of d message with action = 2 just gives the fsys of the user if
!     he or she exists. Otherwise we give a result of 3. The dummy variables
!     or just ignored.

      fsys  = -1
      flag = d fsys(name, fsys)
      %if flag # 0  %then %result = 3

!     Here  we  check to see if the person we want to chat to has a forground
!     process running. We call the %integer %function test for logged on with
!     parameters name and max processes. This returns true for on  and  false
!     for off.

      com == record(X'80C00000')
      max processes = com_maxprocs
      flag = test for logged on (name, max processes)
      %if flag = false %then %result = 4

      %result = 0
%end


%routine end chat

!< end chat
!     Here is the routine called when a user trys to end his connection to chat.
!>
!     The response of the routine is almost totally dependent on wether or not
!     we are the chat leader. So first we test for this.

      %if me = 1 %then %start

!     Ok. So we are the chat leader. Fisrt test to see if anyone else is using
!     this particular chat.

         %if message area_head_users <> 1 %then %start

!           If there are others still chating then we mustn't just sneak off as this
!           could cause at least 1000000000000000 different sorts of hell. Instead
!           inform the user of the ill of his ways.
!           Also set a null message so that it won't cause any trouble later.

            print line("Chat leader cannot exit while others still chatting.")
            print line("Use ~c to close chat.")
            my message = ""
            %return
         %finish %else %start

!        Now if there are no other users we can shut down ok. Making sure that
!        the file SS#CHAT is destroyed.

            destroy("SS#CHAT", flag)
            %if flag <> 0 %then fail(flag)
         %finish

      %finish %else %start

!        Here we are only one of the people using the chat. So we can just leave.
!        decrementing the number of users as we go.

         my message = "Leaving chat."
         send message(my message)

!        Allow 2 seconds for message to be displayed.

         flag = d delay(2)
         decrement users
         disconnect (who.".SS#CHAT", flag)
         fail(flag) %unless flag=0
      %finish

      print line ("Thank you for using chat.")
      set return code(0)
      %stop
%end


%routine print messages
!< print messages

!     This routine prints out any new messages that may have occured. It also
!     removes the user from the chat system if the close flag has been set.

!     Local variables:

!     %integer:

!        from       :  Used to hold the number from whom the message came.

!>
%integer from

!     First pick up the current message top, if this alters while we are printing
!     out the messages then we will have to wait until next time round to get
!     them. This is no real drawback.

      my top = message area_head_current top

!     Now we loop round looking at all the unseen messages.

      %while last look <> my top %cycle

!        increment "last look"ed at message descriptor.

         last look = last look + 1

!        Cycle round if we have gone round the end.

         %if last look > max message descriptors %then last look = 1

!        Find out who the message came from, number that is

         from = message area_descriptor(last look)_from

!        if it wasn't us then print out the message someone else has typed.

         %unless from = me %then %start

!           Test to see if we have a new name.

            %if last from # message area_head_names(from) %or %c
                input since last print = true %then %start

!              We are now  printing out messages from a different chatter,
!              so put out a new line and print the persons name.

               new line
               print line ("    |".message area_head_names(from).":")
            %finish

!           print out message text.

            print line ("    |".message area_descriptor(last look)_text)

!           Now set last from to current from.

            last from  = message area_head_names(from)

!           Update input since last print variable.

            input since last print = false

            %finish

!     and %cycle round for the rest of the messages.

      %repeat

!     Finally check to see if if the chat leader has closed the chat.

      %if message area_head_close = true %then %start

!        If so then we must leave.

         new lines(2)
         print line ("Chat close by leader.")
         end chat
      %finish
%end

!>

!*******************************************************************************
!*
!*    These routines are called as commands by the user.
!*
!*******************************************************************************

!< User command routines
!< subsystem

!     This  has  been  removed  in the current version due to yucky bits in the
!     subsystem. It just prints an error message.
!>

%routine subsystem

!%string(255) my command, params

      print line("Sorry - shell escape not yet implimented")
      %return

!*******************************************************************************

!     The following is commented out due to the lousey Subsystem escape not
!     doing what it should.

!!     In this routine we are able to call a command from within chat.
!!     It uses the Subsystem routine call

!!     Fisrt check the length of the message.

!      %if length (my message) <2 %then %start
!         print line ("What command?")
!         my message = ""
!         %return
!      %finish

!!     Next we convert to upper case.

!!     Now we know we have a command we can split it up into the command proper
!!     and the parameters.

!      my message = sub string(my message, 2, length(my message))
!      %unless my message -> my command.(" ").params %then %start
!         my command = my message
!         params  = ""
!      %finish

!!     Now we check the length of the command

!      %if length(my command) > 31 %then %start
!         print line ("Commands length too long")
!         %return
!      %finish

!!     Now we call the Subsystem.

!      call (my command, params)

!!     And return

%end


%routine close chat
!< close chat

!     This routine is used by the chat leader to close down the chat if he wants
!     to go away and do something less boring. First check if we are in fact
!     the chat leader as otherwise this is not a very fair thing to do.

!     Local variables:

!     %integer

!        time  :  Holds the time left (in seconds) for the chatters to leave.

!>
%integer time

      %if me <> 1 %then print line ("Only the chat leader can close the chat.") %else %start

!        Ok. If we get here then we must be the chat leader so lets set the end
!        of chat flag .....

         message area_head_close = true
         print string ("Waiting for users to clear chat..")

!         ... and wait for all the users to clear the chat.

         time = 10
         %while message area_head_users <> 1 %and time # 0 %cycle
            flag = ddelay(1)
            print symbol ('.')
            terminate
            time = time - 1
         %repeat

!        If that close didn't work Ok (ie we were timed out) then moan.

         %if time = 0 %then %start
             print line("Failed to clear chat properly.")
             print line("Please inform system management via SUGGESTION.")
         %finish

         new line
         destroy("SS#CHAT", flag)

         %if flag # 0 %then %start
            print line ("Failed to destroy SS#CHAT file.")
            print line (" Please report to system management via SUGGESTION.")
         %finish

!        Now we just print the exit message and leave the program

         print line ("Chat closed.")
         print line ("Thank you for using chat.")
         %stop

      %finish
%end


%routine rename
!< rename

!     This  is  the rename routine (much abused by operators and others).  It's
!     function is to allow us to change out name. This is, to put it  mildly,
!     open to abuse.

!     Local variables:

!     %integer:

!        new length  :  Holds length of new name user attempts to enter.

!     %string(255):

!        new name    :  Holds actual attempt at new name.

!>
%integer new length
%string(255) new name

!     First get length of new name ...

      new length = length(my message) - 2

!     ... and see if it is too short i.e. no name was provided.

      %if new length < 1 %then %start

!        If so then moan, and exit.

         print line ("New name too short - No new name provided")
         %return

      %finish

!     Now extract the name from the string.

         new name = sub string(my message, 3, new length+2)

!        and test to see if it is too long

         %if new length > 34 %then %start

!            If name is too long, then we must moan about it.

             print line ("Name length too long!")
             print line ("New name not set.")

         %finish %else %start

!        If not too long then change name.

            message area_head_names(me) = new name
            print line ("New name ".new name." set.")
         %finish
%end


%routine who is on

!< who is on

!     This routine prints out the names of those currently in the chat.
!     Note that when someone leaves the system the name is prefixed with a star
!     and so we should not print these out.

!     Local variables:

!     %integer:

!        counter    :  Holds current pointer in name area.
!        user count :  Holds current total of users.

!     %string(255):

!        name       :  Holds name of current user being looked at.

!>
%integer counter, user count
%string(255) name
      user count = 0
      new lines(3)
      print string ("Leader : ")
      %for counter = 1, 1, max chatters %cycle

!     Pick up name from name area.

         name = message area_head_names(counter)

!        If the name actually exists then print it and increment user count.

         %unless name = "" %then %start
            print string ( message area_head_real names(counter) . " : ")
            print line (name)
            user count = user count + 1
         %finish

!     and continue.

      %repeat

!     Now all we do is print out the number of users we counted.

      print string ("Number of users =")
      write (user count, 0)
      new lines(3)
%end


%routine tell user(%integer what message)

!< tell user

!     This routine is for sending messages to a  user  who  is  not  currently
!     using  the  chat  program. It  can either be used to invite a new person
!     into the chat decline an offer to chat while he is not a leader. In  the
!     latter  case  we  provide  the name of our leader so that the person can
!     enter into a chat with them.

!     Local variable:

!     %string(255)

!        who to  :  Job number of the person to whom we want to send our message.

!>

%string(255) who to

!     Test for null name.

      %if length (my message) < 8 %then %start
         print line ("Invalid user name. Not told")
         %return
      %finish

!     Now remove header and move into who.

      who to = sub string (my message, 3, length(my message))

!     Next test name.

      flag = check name (who to)

!     If name was wrong then error.

      %if flag # 0 %then %start
         print line ( fail reason(flag) . " Not told.")
         %return
      %finish

!     Now every things Ok we can invite the person.

      send to user (who to, what message)

!     And that's it!!!!!!

%end


%routine twiddle commands
!< twiddle commands

!     This is the command interpreter. All we do is to resolve the command into a
!     string containing all the command letters. We then take the length of the
!     string remaining on the left to give us a value of the command we have
!     just been asked to run.

!     Local variables:

!     %string(255) remaining part  :  Holds the remaining part of the string
!                                     after resolution.

!>

%string(255) remaining part
%string(1) command
%switch commands(1:max commands)
       %if length(my message) = 1 %then %start

!        If we have a null name just return with some abusive comment.

         print line ("That was rather pointless..........")
         %return
      %finish

!     Now extract command.

      command = sub string(my message, 2, 2)

!     Now convert to lower case if needed.

      %if 'A' <=byte integer(addr(command)+1) <= 'Z' %then %c
          byte integer(addr(command)+1) = byte integer(addr(command)+1) +32

!     Attempt to resolve into command string. If not then error.

      %unless command string -> remaining part . (command) %start

!        We have an error command not known.

         print line ("Command ~".command." not known. Try ~? for help")
         %return
      %finish

!     Now we switch into the command handler

      -> Commands (length(remaining part)+1)


Commands(1):

!     This is the close chat command.

      close chat
      %return

Commands(2):

!     The is the decline command.

      tell user(decline)
      %return

Commands(3):

!     This is the invite command.
      tell user(invite)
      %return

Commands(4):

!     This is the rename command.

      rename
      %return

Commands(5):

!     This is the users command. All we do is to print out the number of users
!     as help in the message area head.

      print string ("Current number of people in this chat = ")
      write (message area_head_users, 0)
      new line
      %return

Commands(6):

!     This is the version command.

      print line("Chat version 2.35")
      new line
      print line ("Written 23/05/82 by James Darby at UKC.")
      print line ("Copyright (c) 1982 by James Darby.")
      new lines(3)

      %return

Commands(7):

!     This is the who command.

      who is on
      %return

Commands(8):

!     This is the enquire command.
!     This routine prints out the command list. This is definately plebian.

      print line ("~c - Close chat. (leader only) .")
      print line ("~d - Decline invitation.")
      print line ("~i - invite a new user to join.")
      print line ("~r - this allows a user to rename themself in the name list.")
      print line ("~u - This prints out the number of users.")
      print line ("~w - This prints out who the current users are.")
      print line ("~? - Produces this list.")
      print line ("*  - This allows one of the chatters to leave.")
      print line ("!<command> - escape to subsystem.")



%end

!>
%routine on trap (%integer class, subclass)
!< Master control routines
!< on trap

!     This is the ultra hairy interrupt routine.

!     Local variables:

!     %integer:

!        time  :  Holds limit on delay time.

!>
%integer time

!     Initialise flag.

      flag = 0

!     Translate sub class to upper case if needed.

      %if 'a' <= sub class <= 'z' %then sub class = sub class + 'A' - 'a'

!     Kill output if the interrupt is not INT:y (comms failure). The reason for
!     not killing on y is that it will hang on the comms system.

      console (7, flag, flag) %unless sub class = 'Y'

!     Kill input if INT:c

      %if subclass = 'C' %then console(8, flag, flag)

!     Relinquish the semaphore if we have it.

      %if our semaphore = true %then %c
         on trap relinquish semaphore(addr(message area_head_semaphore))

!     Now we deal with the chat file. Test to see if we are the chat leader ...

      %if me = 1 %then %start

!        If we are then set the close flag.

         message area_head_close = true

!        Now wait for the others to clear the chat. We will sleep for 1 second
!        then do a busy wait for them to clear.

         time = 5
         %while time # 0 %cycle
            %exit %if message area_head_users = 1
            flag = d delay(1)
            time = time - 1
         %repeat

!        If we ran out of time, notify leader.

         %if time = 0 %and sub class # 'Y' %then %start
            print line ("All users failed to clear on interrupt exit.")
            print line ("Please report to system management via SUGGESTION.")
         %finish

!           Ok. That's got everyone off. Destroy the file.

            destroy("SS#CHAT", flag)

!        If file was not destroyed Ok then say so.

         %if flag # 0 %then %start
            print string ("Failed to destroy SS#CHAT file - ")
            print line   (failure message(flag))
         %finish

!        and thats it for the chat leader.

      %finish %else %start

!        Now we deal with an ordinary chatter.
!        First we decrement the number of people.

         on trap decrement users

!        Then disconnect the chat file.

         disconnect(who.".SS#CHAT", flag)

!        and thats it for non-leaders as well.

      %finish

!     Finally we let the Subsytem deal with the rest of the problem.

      signal (3, class, subclass, flag)

%end

%routine set up

!< set up

!     In this routine we set up the chat file and inform the other user of our
!     wish for a chat if we are initiating the chat.

!     Local variables:

!        %integer:

!        a io stat    :  Address of io status recored.
!        a it buffer  :  Address of io file (T#IT).
!        counter      :  Used by leader to point to entries to be cleared.

!>
%integer aitbuffer, aiostat, counter

!     Now test to see if the program is being run in forground, but not obey.

      %if uinfi(2) # 1 %then %start
        new line
        print line ("chat fails - Can only be run foreground interactive.")
        %stop
      %finish

!     Now check the name to see if valid.

      flag = check name (who)
      %if flag # 0 %then %start
            new line
            print line ("chat fails - ".fail reason(flag))
            %stop
      %finish

!     Now we map it and io stat where they should be.

      console (13, aitbuffer, aiostat)
      io stat == record(aiostat)
      it      == record(aitbuffer)

!     Also set up the null prompt.

      prompt (to string(13))

!     Now we reroute the interupts to our own interrupt handler.
!     "God have mercy on this program".

      reroute contingency (3, 65, interrupt mask, on trap, flag)
      fail(500+flag) %if flag # 0

!     Now test to see if the user has a SS#CHAT file into which we can talk.
!     If he doesn't this connect will fail.

      connect(who.".SS#CHAT", 523, 0, 0, connect report, flag)

      %if flag = 0 %then %start

!        We have now sucessfully connected the SS#CHAT file all that needs to be
!        done is to map the message area onto it.

     message area  == record(connect report_conad)

!        And set up our name and number in the control information.
!        But first we check to see if too many people are in this chat already,
!        this is highly unlikely with a max of 36 but we had better be safe.

         %if attempt join = false %then %start

   !        Joined failed. Too many users.

            print line ("Sorry. Too many people in that chat already.")

   !        Now disconnect the SS#CHAT file and return to Subsystem.

            disconnect (who.".SS#CHAT", flag)
            %stop

         %finish %else %start

!           set the program's idea of the last message we looked at.

            last look = message area_head_current top

!           Put out an all terminal that we have joined.

            my message = "Just joined in."

            send message(my message)

         %finish

      %finish %else %start

!        Here the other users SS#CHAT does not exist so we must create one and
!        set it up so the other one can connect and map it.

!        First we create the SS#CHAT file and connect and permit it.

         out file( "SS#CHAT", chat file size, 0, 0, conaddr, flag)
         fail (flag) %unless flag = 0
         permit("SS#CHAT", "", 3, flag)
         fail(flag) %unless flag = 0
         connect("SS#CHAT", 523, 0, 0, connect report, flag)
         message area  == record(connect report_conad)

!        As we are the chat leader then we initialise the file.
!        We must set up the current to message descriptor, the number of users
!        my name and the error case name, also the close flag and the top user
!        have to be initialised. Last look is also set up. This is the last
!        message descriptor looked at by us.
!        Also in version 13 and above we initialise the semaphore guarding the
!        critical data areas.

         message area_head_current top = 1
         message area_head_users = 1
         message area_head_names(1) = get name
         message area_head_real names(1) = uinfs(1)
         message area_head_names(0) = "**ERROR:"
         message area_head_close = 0
         message area_head_semaphore = -1
         last look = 1
         me = 1

!        Initialise the names to nulls ........

         %for counter = 2, 1, max chatters %cycle
            message area_head_names(counter) = ""
         %repeat

!        Now we let the other user know we want to chat.

         send to user (who, invite)

      %finish

!     set up input since last print variable.

      input since last print = true

!     also set up last from variable so that we print out the name first time.

      last from = ""

      print line ("Chat. Type ~? for help (* to exit).")
%end



%routine main loop

!< main loop
!     This is the main loop of the program. In it we test for input and act
!     accordinly. We also test to see if any new messages have arrived and if
!     so we print them.

!>
%cycle

!     First we test for any new input by comparing the input buffer pointers for
!     the terminal and the actual input point.

      %while io stat_in pos # it_in pointer %cycle

!     O.K. We have some input, read it in.

         in string (my message)

!        Now test for what it might be, first a request to leave the chat.

         %if my message = "*" %then end chat

!        Next test for a null message. If so then we can ignore it.

         %unless length(my message)=0 %then %start

!        Test for command...

            %if sub string(my message, 1, 1) = "~" %then twiddle commands %else %c
                                                                  %c
{           ... and for the sub system escape....              }  %c
                                                                  %c
            %if sub string(my message, 1, 1) = "!" %then subsystem %else %start


!                 ... other wise lets send it.

                  send message (my message)
            %finish
         %finish

!     As we have had some input, update input since last print variable.

      input since last print = true

      %repeat

!     Now print out any new messages.

      print messages

!     Wait for 1 second ...

      flag = d delay(1)

!     ... and cycle round.

%repeat
%end


!*******************************************************************************
!*
!*      Now here the fun starts - the main routine.
!*
!*******************************************************************************

      set up
      main loop
%end


!>
!< User's comments

!If  you  have  any  comments about chat or its documentation then please let me
!know by typing them below. If you don't know how to use EMAS mail then  if  you
!could say so I will TELL the answer back.
!MAIL mal101, Chat tech users comments

!Thank you.
!>
%external %routine chat(%string(255) who)
print string ("Aha!!!! You are using an old version of chat!!!!!!"); new line
print string ("Please do the following :-"); new line
print string("OPTION REMOVEDIR=MAL101.HOOPEDIR"); new line
print string("Or if that fails REMOVE MAT609.CHAT_OBJECT");NEW LINE
PRINT STRING("INSERT UKCLIB.CHAT"); new line
NEW LINES(3)
PRINT STRING("TA!!!"); new line
%END
%end %of %program